program conferexe(output);

(* ---------------------------------------------------------------

                 ---  C O N F E R E N C E  ---

   ---------------------------------------------------------------

   CONFEREXE is a multi_terminal TALK program. It runs as a detached
   process under VAX/VMS. Conferexe runs via ASTs, there is an AST entry 
   from a timer, one AST entry for each input channel and one AST 
   entry for each output channel. The one image runs all I/O to all 
   terminals in the conference. The paged process is suspended, its 
   terminal type is queried to determine if it is a VT52, the terminal 
   is made shared (Via USR$SHARE) and fullduplex , then the user is 
   paged for a single character (Y/N) response. 

   ---------------------------------------------------------------
                   A S T - S E Q U E N C E 

       ------>-------
     /                \
    |              member_find - Recursive call to find a process who's 
    |                  |         usrname matchs the member to page. 
    |                  V
    |              member_page - Start to page the prospective member
    |                  |         and set his mode to full duplex.
    |                  V
    ^              member_page_2 - Print the prompt message to the 
    |                  |         prospective member.
    |                  V
    |              member_repage - Check the prompt answer and repage if 
    |              /   |         timed out on the read.
    ^        --<--     V
    |       /     member_enter  - If Yes answer then print the header
    |      |       /   |         else clear the members process.
    |      V      /    |
    |   member_leave   |
    |      |           V
    |      ^       member_print  - Print the members names. 
    |      |        /     \  
    |      |       /       \
    |       \     /       char_out - Output the members and other members
     \       \   /                   buffers, the time and errors.
       --<-- char_in 
                - Input the single character and put in the input queue.
                  Declare a CHAR_OUT AST for each channel that is not 
                  writeing out. Also input a new member name and declare 
                  a new ast at member_find to start the new member sequence.

                                                                     *)
(* *)
const 
    cntl_a          =  01 ;    cntl_c         =   03 ;
    cntl_u          =  21 ;    cntl_y         =   25 ;
    lf              =  10 ;    cr             =   13 ;
    esc             =  27 ;    del            =  127 ;
    cntl_p          =  16 ;

    dt$_vt52        =  64 ;    dt$_vt100      =   96 ;

    io$_readprompt  =  55 ;    io$_readlblk   =   33 ;
    io$_writelblk   =  32 ;    io$_ttyreadall =   58 ;
    io$_setmode     =  35 ;    io$_sensemode  =   39 ;
    io$m_canctrlo   =  64 ;    io$m_noformat  =  256 ;
    io$m_noecho     =  64 ;    io$m_cvtlow    =  256 ;
    io$m_purge      =2048 ;    io$m_timed     =  128 ;
    io$m_now        =  64 ;

    jpi$_pid        = 793 ;    jpi$_prcnam    =  796 ;
    jpi$_username   = 514 ;    jpi$_terminal  =  797 ;

    ss$_normal      =   1 ;    ss$_nopriv     =   36 ;
    ss$_suspended   = 932 ;    ss$_nomoreproc = 2472 ;
    ss$_timeout     = 556 ;

    tt$v_halfdup    =  20 ;    tt$v_passall   =    0 ;
    tt$v_nobrdcst   =  17 ;

    save_mode_size  =   8 ;    my_name_offset =    5 ;

    out_row_time    =   0 ;    out_col_time   =   50 ;
    out_row_title   =   1 ;    out_col_title  =   25 ;
    out_row_prompt  =  23 ;    out_col_prompt =    0 ;
    out_row_page    =  22 ;    out_col_page   =    0 ;
    out_row_error   =  23 ;    out_col_error  =    0 ;

    out_line_size   =  50 ;    out_row_offset =    4 ;
    chr_row_offset  =  32 ;    chr_col_offset =   32 ;
    short_size      =  12 ;    line_size      =   80 ;
    max_members     =  10 ;    time_out_prompt=   15 ;
    error_length    =  30 ;    time_out_count =    5 ;

    no_space        = '!!No space for new member!!   ';
    no_member       = '!!Unable to page              ';
    no_terminal     = '!!Wrong terminal type for     ';
    no_response     = '!!No response from page of    ';
    no_join         = '!!Member declines to join!!   ';
    no_assign       = '!!Unable to assign channel!!  ';
    no_priv         = '!!No privilege for operation!!';
    no_duplicate    = '!!No duplicate members allowed';
    sys$input_name  = 'SYS$INPUT                     ';

(* *)
type 
    mode_type      = record 
      term_class   : char ;
      term_type    : char ;
      page1,page2  : char ;
      term_char    : packed set of 0..23;
      term_page    : char 
      end;
      
    exit_type      = record 
      f_link       : integer  ;
      ext_adr      : integer  ;
      ap_reg       : integer  ;
      rsn_val      : ^integer 
      end;

    time_type      = array [1..2] of integer ;
    iosb_type      = array [1..2] of integer ;
    short_buffer   = array [1..short_size] of char ;
    line_buffer    = array [1..line_size] of char ;
    line_pointer   = ^line_buffer ;
    packed_buffer  = packed array [1..12] of char ;
    error_type     = packed array [1..error_length] of char ;

    short          = record
        length     : integer ;
        buffer     : ^short_buffer 
        end;

    string         = record 
       length      : integer ;
       buffer      : ^line_buffer 
       end;

    pid_type       = record 
      length       : integer ;
      jpi_pid      : ^integer
      end;

    jpi_list       = record 
       prcname     : short ; prcname_len : ^integer ;
       usrname     : short ; usrname_len : ^integer ;
       terminal    : short ; term_length : ^integer ;
       pid         : pid_type ; pid_len  : ^integer ;
       terminator  : integer
       end;

    instate_type   = (free , inconf , paging);
(* *)
    member_type    = record 
       pid         : integer  ;
       member_name : short_buffer ;
       save_mode   : mode_type ;
       host        : integer  ;
       jpi         : jpi_list ;
       wait_count  : integer  ;
       skip_page   : boolean  ;
       page_index  : 0..max_members ;
       in_channel  : integer  ;
       in_char     : char     ;
       inqueue     : string   ;
       in_iosb     : iosb_type;
       out_channel : integer  ;
       error       : string   ;
       out_buf     : string   ;
       out_iosb    : iosb_type;
       top         : integer  ;
       line_count  : packed array [1..max_members] of 0..out_line_size;
       bottom      : packed array [1..max_members] of 0..line_size;
       others      : packed array [1..max_members] of instate_type;
       outstate    : (writeing,notwriteing);
       instate     : instate_type
       end;

var 
     time_out       : packed array [1..max_members] of boolean ;
     my_name        : short_buffer ;
     my_pid         : integer ;
     member         : array [1..max_members] of member_type ;  
     numbers        : array [1..max_members] of integer     ;
     delay_packed   : packed_buffer ;
     delay_string   : string        ;
     exitblk        : exit_type     ;
     page_buffer    : string        ;        (* join page request buffer *)
     sys$input      : short         ;        (* input mail box name      *)
     sys$input_chan : integer       ;        (* mail box channel         *)
     sys$input_iosb : iosb_type     ;        (* mail box status blk      *)
     join_buffer    : short_buffer  ;        (* buffer for join page     *)
     real$input     : short         ;        (* translated input name    *)
(* *)
procedure lib$stop  (%immed   condit  : integer   ); extern ;

procedure lib$sys_asctim 
                    (var      out_len : integer   ;
                     var      dst_str : string    ); extern ;

function sys$assign (var      devname : short     ;
                     var      channel : integer   ;
                     %immed   acmode  : integer   ;
                     %immed   mbxnam  : integer   ): integer ; extern ;

function sys$bintim (var      timbuf  : string    ;
                     var      timadr  : time_type ): integer ; extern ;

function sys$brdcst (var      msgbuf  : string    ;
                     var      devnam  : short     ): integer ; extern ;

function sys$cancel (%immed   channel : integer   ): integer ; extern ;

function sys$dassgn (%immed   channel : integer   ): integer ; extern ;

function sys$dclast (%immed procedure abc         ;
                              astprm  : integer   ;
                     %immed   acmode  : integer   ): integer ; extern ;

function sys$getjpi (%immed   efn     : integer   ;
                     var      pidadr  : integer   ;
                     %immed   prcnam  : integer   ;
                     var      itmlst  : jpi_list  ;
                     %immed   iosb    : integer   ;
                     %immed   procedure abc       ;
                              astprm  : integer   ): integer ; extern ;

procedure sys$hiber ; extern ;

function sys$qio    (%immed   efn     : integer   ;
                     %immed   channel : integer   ;
                     %immed   func    : integer   ;
                     var      iosb    : iosb_type ;
                     %immed   procedure abc       ;
                              astprm  : integer   ;
                     var      bufadr  : char      ;
                     %immed   bufsiz  : integer   ;
                     %immed   p3,p4   : integer   ;
                     %immed   p5      : line_pointer;
                     %immed   p6      : integer   ): integer ; extern ;

function sys$qiow   (%immed   efn     : integer   ;
                     %immed   channel : integer   ;
                     %immed   func    : integer   ;
                     var      iosb    : iosb_type ;
                     %immed   procabc : integer   ;(* no ast for wait io*)
                              astprm  : integer   ;
                     var      bufadr  : char      ;
                     %immed   bufsiz  : integer   ;
                     %immed   p3,p4   : integer   ;
                     %immed   p5      : line_pointer;
                     %immed   p6      : integer   ): integer ; extern ;

function sys$resume (var      pidadr  : integer   ;
                     %immed   prcnam  : integer   ): integer ; extern ;

function sys$setimr (%immed   efn     : integer   ;
                     var      daytim  : time_type ;
                     %immed   procedure abc       ;
                              astprm  : integer   ;
                     %immed   reqidt  : integer   ): integer ; extern ;

function sys$suspnd (var      pidadr  : integer   ;
                     %immed   prcnam  : integer   ): integer ; extern ;

function sys$trnlog (var      lognam  : short     ;
                     var      rsllen  : integer   ;
                     var      rslbuf  : short     ;
                     var      table   : integer   ;
                     var      acmode  : integer   ;
                     %immed   dsbmsk  : integer   ): integer ; extern ;

function sys$wake   (var      pidadr  : integer   ;
                     %immed   prcnam  : integer   ): integer ; extern ;

function usr$exit   (%immed   procedure abc       ;
                     var      extblk  : exit_type ): integer ; extern ;

function usr$share  (var      devnam  : short     ;
                     %immed   shrflg  : integer   ;
                     %immed   pidnew  : integer   ): integer ; extern ; 

procedure char_in (number : integer) ; forward ;

procedure dummy ; (* dummy ast entry point *)
begin end; 

function upper (ch:char) : char ; 
begin 
  if (ch >= 'a') and (ch <= 'z') then 
    upper := chr (ord(ch)+ord('A')-ord('a'))
  else 
    upper := ch ;
  end;
 
function s_match (var s1,s2:short_buffer): boolean ;
var i:integer; 
begin 
  s_match := true ;
  for i := 1 to short_size do 
    if (s1[i]<>s2[i]) then s_match := false;
  end;
(* *)
procedure clr_string (var str:string);
var i : integer ;
begin 
  str.length := 0;
  for i := 1 to line_size do str.buffer^[i] := ' ';
  end;

procedure clr_short(var str:short);
var i : integer ;
begin 
  str.length := 0;
  for i := 1 to short_size do str.buffer^[i] := ' ';
  end;

procedure clr_short_add (var str:short; ps:error_type);
var i : integer ;
begin 
  clr_short (str);
  i := 1;
  while (i <= short_size) and (ps[i] <> ' ') do begin 
    str.buffer^[i] := ps[i]; 
    i := i + 1;
    end; 
  str.length := i-1;
  end; 

procedure clr_jpi(var jpi:jpi_list);
begin 
  clr_short(jpi.prcname) ; clr_short(jpi.usrname); clr_short(jpi.terminal);
  jpi.prcname.length := short_size + (jpi$_prcnam*65536);
  jpi.usrname.length := short_size + (jpi$_username*65536);
  jpi.terminal.length:= short_size + (jpi$_terminal*65536);
  jpi.pid.length     :=          4 + (jpi$_pid*65536);
  jpi.prcname_len^ := 0;
  jpi.usrname_len^ := 0;
  jpi.term_length^ := 0;
  jpi.terminator := 0;
  end;

procedure new_jpi (var jpi : jpi_list);
begin 
  new (jpi.prcname.buffer) ; new(jpi.usrname.buffer);
  new (jpi.prcname_len)    ; new(jpi.usrname_len)   ;
  new (jpi.terminal.buffer); new(jpi.term_length)   ;
  new (jpi.pid.jpi_pid)    ; jpi.pid_len := nil     ;
  clr_jpi (jpi);
  end;

procedure write_short (var str:short);
var i : integer ;
begin 
  for i := 1 to str.length do write (str.buffer^[i]);
  end;
(* *)
procedure clr_member (var number:integer);
var i,j:integer ;
begin 
  with member[number] do begin
    instate := free ;
    outstate:= notwriteing ;
    clr_string (inqueue);
    clr_string (out_buf);
    clr_string (error);
    top        := 0;
    page_index := 0;
    host       := 1;
    pid        := 0;
    skip_page  := false ;
    clr_jpi   (jpi);
    for j := 1 to max_members do begin
      others[j]     := free ;
      bottom[j]     := 0; 
      line_count[j] := 1;
      end;
    end;
  end;
(* *)
procedure add_char_out (var s:string ; c:char);
begin 
  s.buffer^[s.length+1] := c;
  s.length := s.length + 1;
  end; 

procedure add_clr_screen (var s:string);
begin 
  add_char_out ( s , chr(esc));
  add_char_out ( s , 'v');
  end;

procedure add_del_char (var s:string);
begin 
  s.buffer^[s.length+1] := chr(esc);
  s.buffer^[s.length+2] := 'O';
  s.length := s.length + 2;
  end; 

procedure add_del_line (var s:string);
begin 
  s.buffer^[s.length+1] := chr(esc);
  s.buffer^[s.length+2] := 'x';
  s.length := s.length + 2;
  end;

procedure add_packed (var s:string; sh:packed_buffer);
var i:integer ;
begin 
  for i := 1 to 12 do 
    s.buffer^[i + s.length] := sh[i]; 
  s.length := s.length + 12 ;
  end;

procedure add_position (var s:string; row,col : integer);
begin 
  s.buffer^[s.length+1] := chr(esc); 
  s.buffer^[s.length+2] := 'Y';
  s.buffer^[s.length+3] := chr (row + chr_row_offset);
  s.buffer^[s.length+4] := chr (col + chr_col_offset);
  s.length := s.length + 4;
  end; 

procedure add_short (var s:string; sh:short_buffer; justify:boolean);
var i,j : integer ;
begin 
  j := short_size ;
  while (j>1) and (sh[j] = ' ') and (justify) do j := j - 1;
  for i := 1 to j do add_char_out ( s , sh[i]);
  if (justify) then add_char_out ( s , ' ');
  end;
(* *)
procedure add_error (number:integer; error_string:error_type);
var i,j : integer ;
begin 
  if (number > 0) then begin clr_string (member[number].error);
    j := error_length ;
    while (j > 1) and (error_string[j] = ' ') do j := j - 1;
    for i := 1 to j do add_char_out (member[number].error , error_string[i]);
    add_char_out ( member[number].error , ' ');
    end;
 end;

procedure add_string (var s1,s2:string); 
var i,j:integer ;
begin 
  j := s2.length ; 
  while (j > 1) and (s2.buffer^[j] = ' ') do j := j - 1;
  for i := 1 to j do add_char_out ( s1 , s2.buffer^[i]);
  add_char_out ( s1 , ' ');
  end;
    
procedure add_queue (number:integer; ch:char);
begin 
  with member[number] do begin 
    if (top >= line_size) then top := 1 
    else                      top := top + 1;
    if (inqueue.length < line_size) then 
      inqueue.length := inqueue.length+1;
    inqueue.buffer^[top] := ch ;
    end;
  end;

procedure add_member (var s:string; n:integer; var to_big:boolean);
begin 
  case member[n].instate of 
    paging  : begin 
      to_big := ((s.length+7+short_size) >= (line_size));
      if not to_big then begin
         add_position ( s , n + out_row_offset , 1);
         add_packed( s , 'Paging.....>');
         add_del_line ( s );
         end;
      end;
    inconf  : begin 
      to_big := ((s.length+5+short_size) >= (line_size));
      if not to_big then begin
         add_position ( s , n + out_row_offset , 1);
         add_short ( s , member[n].member_name , false) ;
         s.buffer^[s.length] := '>' ;
         end;
      end;
    free    : begin 
      to_big := ((s.length+7+short_size) >= (line_size));
      if not to_big then begin
         add_position ( s , n + out_row_offset , 1);
         add_packed( s , '...........>');
         add_del_line ( s );
         end;
      end;
    end;
  end; 
(* *)
function broadcast ( number : integer ): integer ;
var status : integer ;
begin 
  with member[number] do begin
    clr_string (out_buf); 
    add_position (out_buf , out_row_page , out_col_page );
    add_packed   (out_buf , 'Conference  '); 
    out_buf.length := out_buf.length - 1;
    add_short    (out_buf , my_name , true);
    add_packed   (out_buf , 'Pageing     ');
    out_buf.length := out_buf.length - 4;
    add_short  (out_buf , member_name , true);
    add_packed   ( out_buf , '         ');
    status := sys$brdcst (out_buf , jpi.terminal);
    broadcast := status ;
    end;
  end;

function read_prompt ( number:integer ; procedure abc ) : integer ;
var status : integer ;
begin
  with member[number] do begin
    clr_string (out_buf); 
    add_position (out_buf , out_row_prompt, out_col_prompt);
    add_packed (out_buf , 'Conference  '); 
    out_buf.length := out_buf.length - 1;
    add_short  (out_buf , my_name , true);
    add_packed (out_buf , 'Pageing, wil');
    add_packed (out_buf , 'l you join ?');
    add_packed (out_buf , '(Y/N)    ');
    status := sys$qio ( 0 , in_channel , io$_readprompt + io$m_purge 
        + io$m_timed , in_iosb , abc , numbers[number], in_char , 
        1 , time_out_prompt , 0 , out_buf.buffer , out_buf.length);
    read_prompt := status ;
    end;
  end;

function write_buffer (number : integer; procedure abc): integer ;
var status : integer ;
begin 
  with member[number] do begin
    status := sys$qio (0 , out_channel , io$_writelblk+io$m_noformat ,
         out_iosb , abc , numbers[number] , out_buf.buffer^[1] ,
         out_buf.length , 0 , 0 , nil , 0);
    write_buffer := status ;
    end;
  end;
(* *)
procedure leave_conf (number : integer);
var i,status : integer;
begin
  with member[number] do begin 
    for i := 1 to short_size do write(member_name[i]);
    writeln (' Leaving conference.');
    status := sys$cancel (in_channel); 
    status := sys$cancel (out_channel);
    status := sys$qiow   (0 , in_channel , io$_setmode , in_iosb , 
              0 , number , save_mode.term_class , save_mode_size ,
              0 , 0 , nil , 0);
    status := sys$dassgn (in_channel);
    status := sys$dassgn (out_channel);
    status := usr$share  (jpi.terminal , 0 , pid);
    status := sys$resume(pid,0); 
    clr_member (number);
    end;
  end; 

procedure member_leave (number : integer); (* ast member leave *)
var i,j,status : integer ;
begin 
  leave_conf (number);
  j := 0;

  for i := 1 to max_members do 
    if (member[i].instate = inconf) then j := j + 1;

  if (j <= 0) then begin 
    for i := 1 to max_members do 
      if (member[i].instate <> free) then 
         leave_conf(i);
    status := sys$wake (my_pid , 0);
    end;
  end;


procedure ast_exit ;
var i : integer ;
begin 
  for i := 1 to max_members do 
    if (member[i].instate <> free) then 
      member_leave (i) ;
  end;
(* *)
procedure char_out(number : integer) ;
var i,j,status : integer ;

  function fit (i:integer): boolean ;
  begin 
    fit := ((member[number].out_buf.length ) < (line_size-i-4));
    end; 

  procedure char_out_lf ;
  begin 
    with member[number] do 
      if fit(6) then begin 
        line_count[i] := 1;
        add_position ( out_buf , i+out_row_offset , 1+short_size);
        add_del_line ( out_buf );
        bottom[i] := j;
        end;
    end; 

  procedure char_out_del ;
  begin 
    with member[number] do 
      if fit (6) then begin 
        if (line_count[i] > 1) then line_count[i] := line_count[i]-1;
        add_position(out_buf,i+out_row_offset, line_count[i]+short_size);
        add_char_out (out_buf , ' ');
        bottom[i] := j;
        end; 
    end;

  procedure char_out_time ;
  begin 
    if not time_out[number] then 
      with member[number] do begin 
        add_position (out_buf , out_row_time , out_col_time);
        for i := 1 to 20 do add_char_out (out_buf , delay_string.buffer^[i]);
        time_out[number] := true ;
        end;
    end;

  procedure char_out_member ; 
  var to_big : boolean ; i:integer ;
  begin 
    with member[number] do 
      for i := 1 to max_members do 
        if (others[i] <> member[i].instate) then begin
          add_member (out_buf , i , to_big); 
          if not to_big then others[i] := member[i].instate;
          if (others[i] = free) then begin 
            bottom[i] := 0;
            line_count[i] := 1;
            end;
          end;
     end;

procedure char_out_error ; 
begin 
  if (member[number].error.length > 0) then begin 
    add_position(member[number].out_buf , out_row_error , out_col_error);
    add_string  (member[number].out_buf , member[number].error );
    add_del_line(member[number].out_buf );
    clr_string  (member[number].error );
    end;
  end;
(* *)
begin (* char_out *)
  with member[number] do begin 
    outstate := writeing ;
    clr_string (out_buf);
    char_out_error  ;
    char_out_time   ;
    char_out_member ;
    i := 1; 
    repeat 
      if (bottom[i] >= line_size) then 
        j := 1
      else     
        j := bottom[i] + 1;
      if (member[i].instate<>free) and (member[i].top<>bottom[i]) and 
        (member[i].top<>0) then 
        if (member[i].inqueue.buffer^[j] = chr(del)) then 
          char_out_del 
        else if (member[i].inqueue.buffer^[j] = chr(cntl_u)) or 
          (member[i].inqueue.buffer^[j] = chr (lf)) then 
          char_out_lf 
        else if (line_count[i] < out_line_size) then begin
          if fit (6) then begin 
            add_position(out_buf,i+out_row_offset, line_count[i]+short_size);
            add_char_out (out_buf , member[i].inqueue.buffer^[j]);
            line_count[i] := line_count[i] + 1;
            bottom[i] := j;
            end; 
          end
        else if fit(11) then begin
          add_position (out_buf , i+out_row_offset , short_size+1);
          add_del_char (out_buf );
          add_position (out_buf,i+out_row_offset,line_count[i]-1+short_size);
          add_char_out (out_buf , member[i].inqueue.buffer^[j]);
          bottom[i] := j;
          end;
      i := i + 1;
      until (i > max_members);
    if (out_buf.length <= 0) then 
      outstate := notwriteing
    else begin 
      if (page_index > 0) then add_position (out_buf , 
          page_index+out_row_offset , line_count[page_index]+short_size)
      else add_position (out_buf , number+out_row_offset , 
          line_count[number]+short_size);
      status := write_buffer ( number , char_out );
      if not odd(status) then member_leave (number);
      end;
    end; 
  end; 
(* *)
procedure member_print (number : integer); (* ast of print member names *)
var status : integer ; to_big : boolean ;
begin 
  with member[number] do begin 
    status := sys$suspnd (pid , 0);
    clr_string (out_buf);
    to_big := false ;
    while (wait_count <= max_members) and (not to_big) do begin
      add_member (out_buf , wait_count , to_big);
      if not to_big then wait_count := wait_count + 1;
      end;
    if (wait_count > max_members) then begin 
      status := write_buffer ( number , char_out );
      char_in (number);
      end
    else 
      status := write_buffer ( number , member_print );
    end; 
  end;

procedure member_enter (number : integer);
var i,status : integer ;
begin 
  with member[number] do begin 
    status := sys$suspnd (pid , 0);
    for i := 1 to short_size do write(member_name[i]); 
    writeln (' Entering the conference.');
    instate := inconf ;
    in_char := ' ';
    add_queue (number , chr(lf));
    outstate := writeing ;
    clr_string (out_buf);
    add_clr_screen ( out_buf ); 
    add_position ( out_buf , out_row_title , out_col_title );
    add_packed   ( out_buf , 'CONFERENCE  ');
    out_buf.length := out_buf.length - 1;
    add_short    ( out_buf , my_name , true );
    wait_count := 1 ;
    status := write_buffer ( number , member_print );
    if not odd(status) then member_leave(number);
    end; 
  end;
(* *)
procedure member_repage (number : integer); 
label 1;
var status:integer; 
begin 
  with member[number] do 
    if ((in_iosb[1] mod 65536) = ss$_timeout) 
    and (wait_count <= time_out_count) then begin 
      wait_count := wait_count + 1;
      status := broadcast ( number);
      status := read_prompt ( number , member_repage );
      if not odd(status) then goto 1;
      end
    else if (in_char <> 'Y') and (in_char <> 'y') then begin 
      1:
      add_error ( host , no_join );
      add_short (member[host].error , member_name , true);
      member_leave (number);
      end
    else 
      member_enter (number);
  end;
(* *)
procedure member_page_2 (number : integer); (* ast start page of member *)
label 1,10;
var i,status:integer; 
begin 
  with member[number] do begin 
    if skip_page then 
       member_enter (number)
    else begin
       wait_count := 1; 
       in_char := ' ';
       status := read_prompt ( number , member_repage );
       if not odd(status) then goto 1;
       goto 10;
       1 : add_error (host , no_priv );
           add_short (member[host].error , member_name , true);
           member_leave ( number);
       10:
       end;
    end;
  end; 

procedure member_page (number : integer); 
label 1,2,3;
var i,status:integer; new_mode : mode_type ;
begin 
  with member[number] do begin 
    for i := 1 to short_size do write (member_name[i]);
    writeln (' Being paged.');
    if (save_mode.term_type = chr (dt$_vt52)) then begin 
      status := sys$suspnd (pid , 0);
      if not odd(status) then goto 2; 
      status := broadcast ( number );
      if not odd(status) then goto 2;
      new_mode := save_mode ;
      new_mode.term_char := new_mode.term_char - [tt$v_halfdup] + 
         [tt$v_passall , tt$v_nobrdcst] ;
      status := sys$qio (0 , in_channel , io$_setmode , in_iosb , 
         member_page_2 , numbers[number] , new_mode.term_class , 
         save_mode_size , 0 , 0 , nil , 0);
      if not odd(status) then goto 1;
      end
    else begin
      1:add_error (host , no_terminal);
        goto 3;
      2:add_error (host , no_priv);
      3:add_short (member[host].error , member_name , true);
        member_leave(number);
      end;
    end;
  end;

(* *)
procedure member_find (number : integer); (* ast find the paged member *)
label 1,10;
var i,status : integer ;

 function matchnames (s1,s2 : short_buffer): boolean ; 
 var i:integer ;
 begin matchnames := true ;
   for i := 1 to short_size do 
     if (s1[i]=chr(0)) then s1[i] := ' ';
   for i := 1 to short_size do 
     if (s1[i] <> s2[i]) then matchnames := false ;
   end; 

begin with member[number] do 
    if (instate = paging) then begin 
      if matchnames (jpi.prcname.buffer^ , member_name ) then begin 
        pid := jpi.pid.jpi_pid^ ;
        jpi.terminal.length := jpi.term_length^;
        jpi.usrname.length  := jpi.usrname_len^;
        jpi.prcname.length  := jpi.prcname_len^;
        status := usr$share  (jpi.terminal , 1 , 0);
        if not odd(status) then goto 1;
        status := sys$assign (jpi.terminal , in_channel , 0 , 0);
        if not odd(status) then goto 1;
        status := sys$assign (jpi.terminal , out_channel , 0 , 0);
        if not odd(status) then goto 1;
        status := sys$qio ( 0 , in_channel , io$_sensemode , in_iosb , 
          member_page , numbers[number] , save_mode.term_class , 
          save_mode_size , 0 , 0 , nil , 0);
        if not odd(status) then lib$stop(status);
        end
      else begin 
        repeat 
          clr_jpi (jpi);
        status := sys$getjpi (0 ,pid, 0 ,jpi, 0 ,member_find, numbers[number]);
          until ((status <> ss$_nopriv) and (status <> ss$_suspended));
        if (status = ss$_nomoreproc) then begin
          writeln ('Member not found ');
          add_error (host , no_member);
          add_short (member[host].error , member_name , true);
          clr_member (number);
          end
        else if not odd(status) then lib$stop(status) ;
      end;
      goto 10;
     1:write ('Unable to assign to member terminal');
       write_short (jpi.prcname); write_short (jpi.terminal); writeln;
       add_error (host , no_assign);
       add_short (member[host].error , member_name , true);
       member_leave ( number );
     10:
    end;
  end;
(* *)
procedure char_in (*number : integer*) ;
var i,status : integer ;

  procedure char_in_add ;
  var i:integer; 
  begin with member[number] do begin
      i := 1 ;
      while (i<max_members) and (member[i].instate <> free) do i:=i+1;
      if (member[i].instate = free) then begin 
        member[i].instate := paging ;
        page_index := i;
        clr_string (member[page_index].inqueue);
        end 
      else 
        add_error (number , no_space);
      end;
    end;

  procedure char_in_exit ;
  begin  
    with member[number] do begin 
      if (page_index > 0) then clr_member(page_index);
      instate := free ;
      status := sys$cancel (in_channel); 
      status := sys$cancel (out_channel);
      clr_string (out_buf);
      add_clr_screen (out_buf);
      status := write_buffer ( number , member_leave );
      end;
    end; 

  procedure char_del_page ;
  var i:integer; 
  begin 
    for i := 1 to max_members do 
      if (member[i].instate = paging) then 
         member_leave (i);
    end;
(* *)
  procedure char_in_page ; 
  var i,j,status:integer ; ch:char; all_ready_on:boolean ;
  begin 
    with member[number] do begin
      if (in_char = chr(cntl_u)) then begin 
          clr_member (page_index);
          page_index := 0;
          end 
  
     else if (in_char = chr(cr)) or (in_char = ' ') then begin 
          add_queue (page_index , ' ');
          for i := 1 to short_size do 
              member[page_index].member_name[i] := ' ';
          i := 1;
          for j := 1 to member[page_index].inqueue.length do begin 
              ch := upper (member[page_index].inqueue.buffer^[j]);
              if (ch >= 'A') and (ch <='Z') then begin 
                member[page_index].member_name[i] := ch ;
                i := i + 1;
                end 
              else if (ch = chr(del)) then begin 
                if (i > 1) then i := i - 1;
                member[page_index].member_name[i] := ' ' ;
                end;
              end;
 
           all_ready_on := false ;
           for i := 1 to max_members do 
             if (i<>page_index) then 
                if s_match(member[i].member_name , 
                 member[page_index].member_name) then
                 all_ready_on := true ;

           if all_ready_on then begin 
             add_error (number , no_duplicate);
             clr_member (page_index);
             page_index := 0;
             end
           else begin 
             member[page_index].pid := -1;
             clr_jpi (member[page_index].jpi);
             member[page_index].host := number ;
             status := sys$dclast(member_find ,numbers[page_index] , 0);
             page_index := 0;
             end;
           end 
 
       else begin
           add_queue (page_index , in_char);
           end;
       end;
    end;
(* *)
begin (* char_in *)
  with member[number] do begin 
    if (instate = inconf) then  
      if (in_char = chr(cntl_y)) or (in_char = chr(cntl_c)) then 
        char_in_exit 

      else begin
        if (page_index > 0) then 
          char_in_page

        else if (in_char = chr(cntl_a)) then 
          char_in_add

        else if (in_char = chr(cntl_p)) then 
          char_del_page

        else if (in_char = chr(13)) then begin 
          add_queue (number , ' '); add_queue (number , '.');
          add_queue (number , '.'); add_queue (number , '.');
          add_queue (number , ' ');
          end

        else
          add_queue (number , in_char);
        for i := 1 to max_members do 
          if (member[i].instate=inconf) then 
            if (member[i].outstate=notwriteing) then 
              char_out (i);

        status := sys$qio ( 0 , in_channel , io$_ttyreadall+io$m_noecho , 
          in_iosb , char_in , numbers[number] , in_char ,1 ,0 ,0 ,nil ,0); 
        if not odd(status) then member_leave(number); 

        end;
    end;
  end; 
(* *)
procedure ast_timer; 
var timbuf : time_type ; i,j,status:integer; 
 
  function inc_time (var old:packed_buffer; index,max:integer):boolean ;
  begin 
    old[index] := succ(old[index]);
    if (ord (old[index]) >= (ord('0')+max+1)) then begin 
      old[index] := '0';
      inc_time := true ;
      end
    else 
      inc_time := false ;
    end;

begin 
  lib$sys_asctim (i,delay_string);
  if inc_time (delay_packed , 7 , 5) then 
    if inc_time (delay_packed , 5 , 9) then 
      if inc_time (delay_packed , 4 , 5) then 
        if inc_time (delay_packed , 2 , 9) then begin
          if inc_time (delay_packed , 1 , 2) then begin end;
          end
        else if (delay_packed = '24:00:00.00 ') then 
          delay_packed := '00:00:00.00 ';
  delay_string.length := 12 ;
  add_packed (delay_string , delay_packed);
  status := sys$bintim(delay_string , timbuf);
  status := sys$setimr (0 , timbuf , ast_timer , 0 , 0);
  for i := 1 to max_members do time_out[i] := false ;
  for i := 1 to max_members do 
    if (member[i].instate = inconf) and (member[i].outstate<>writeing) then 
      status := sys$dclast(char_out , numbers[i] , 0);

  for i := 1 to short_size do join_buffer[i] := ' ';
  status := sys$qiow (0 , sys$input_chan , io$_readlblk+io$m_now  , 
         sys$input_iosb , 0   , numbers[1] , page_buffer.buffer^[1],
         line_size , 0 , 0 , nil , 0);
  
  if ((sys$input_iosb[1] mod 65536) = ss$_normal) then begin
     for i := 1 to max_members do 
       if (member[i].instate = inconf) then begin 
           member[i].error.length := (sys$input_iosb[1] div 65536);
           for j := 1 to member[i].error.length do 
              member[i].error.buffer^[j] := page_buffer.buffer^[j];
           end;
     for i := 1 to short_size do write(join_buffer[i]);
     writeln (' Paged the conference.');
     end;

  end;
(* *)
function translate (s1:short; var s2:short): integer ; 
var status , i , table , rslen , acmode : integer ;
begin 
  repeat 
    s2.length := short_size;
    status := sys$trnlog (s1 , rslen , s2 , table , acmode , 0);
    s2.length := rslen ;
    if (s2.buffer^[1]=chr(esc)) and (s2.buffer^[2]=chr(0)) then begin
      for i := 5 to s2.length do 
         s2.buffer^[i-4] := s2.buffer^[i];
      s2.length := s2.length - 4;
      end;
    write_short (s2); writeln (' :Translated logical name.');
    s1.length := s2.length ;
    for i := 1 to s1.length do 
      s1.buffer^[i] := s2.buffer^[i];
    until (status <> ss$_normal);
  translate := status;
  end;
(* *)
procedure initilize ;
var i,j,status:integer ; jpi : jpi_list ;
begin 
  new (page_buffer.buffer);
  clr_string (page_buffer);

  new (sys$input.buffer);
  clr_short_add (sys$input , sys$input_name);

  new (real$input.buffer);
  status := translate (sys$input , real$input);
  if not (odd(status)) then lib$stop(status);

  status := sys$assign (real$input , sys$input_chan , 0 , 0);
  if not (odd(status)) then lib$stop(status);
  for i := 1 to max_members do begin
    numbers [i] := i     ;         (* pseudo constants for ast parameters *)
    time_out[i] := false ;         (* screen has output time              *)
    end;

  for i := 1 to max_members do     (* initilize member information        *)
    with member[i] do begin 
      new (inqueue.buffer );
      new (out_buf.buffer );
      new (error.buffer   );
      new_jpi (jpi);
      clr_jpi (jpi);
      clr_member (i);
      end; 

  new_jpi (jpi);
  my_pid := 0;
  status := sys$getjpi (0 , my_pid , 0 , jpi , 0 , dummy , 0);
  if not odd (status) then lib$stop(status);
  jpi.prcname.length := jpi.prcname_len^ ;
  jpi.usrname.length := jpi.usrname_len^ ;
  jpi.terminal.length:= jpi.term_length^ ;
  if (jpi.prcname.length >= (short_size + my_name_offset)) then 
     jpi.prcname.length := (short_size + my_name_offset);
  for i := my_name_offset+1 to jpi.prcname.length do 
    my_name[i] := jpi.prcname.buffer^[i]; 
  my_pid  := jpi.pid.jpi_pid^;

  new (exitblk.rsn_val);
  status := usr$exit ( ast_exit , exitblk);
  if not odd(status) then lib$stop(status);

  with member[1] do begin 
    instate   := paging  ;
    skip_page := true    ;

    for i := 1 to short_size do join_buffer[i] := ' ';
    status    := sys$qiow (0 , sys$input_chan , io$_readlblk , 
              sys$input_iosb , 0              , 0            , 
              page_buffer.buffer^[1] , short_size     , 0 , 0 , nil , 0);
    if not (odd(status)) then lib$stop (status); 

    pid := -1;
    for i := 1 to short_size do member_name[i] := page_buffer.buffer^[i];

    write ((sys$input_iosb[1] div 65536):1,' ',
           (sys$input_iosb[2] mod 65536):1,' ');
    for i := 1 to short_size do write (member_name[i]);
    writeln (' Was the conference host.');

    status := sys$dclast (member_find , numbers[1] , 0);
    if not (odd(status)) then lib$stop (status);
    end;

  new (delay_string.buffer);
  delay_string.length := 80;
  lib$sys_asctim (i , delay_string);
  delay_packed := '00:00:00.00 ';
  for i := 1 to 7 do 
    delay_packed[i] := delay_string.buffer^[i+12];
  ast_timer ;

  end; 
(* *)
begin 
  initilize ;
  sys$hiber ;
  writeln ('Normal exit from TALKER ');
  end.