[comp.os.vms] BOSS 2.4 3/4

KARNEY%PPC.MFENET@NMFECC.ARPA (07/19/88)

+-+-+-+ Beginning of part 3 +-+-+-+
Xinstead these messages will be sent directly to the terminal.
X
XREVISION HISTORY:
X
XVersion 1.0.  August 22, 1987
XVersion 1.1.  August 27, 1987
X    Add BOSS$ID, BOSS$SWITCH, BOSS$STUFF.
XVersion 1.2.  September 30, 1987
X    Stop PHY_IO being inherited by subprocesses.
XVersion 1.3.  March 17, 1988
X  C-b buffer output
X  C-p proceed (output comes through regardless)
X  C-o suppress output (but save the last write)
X  C-s hang output
XVersion 1.4.  March 23, 1988
X  Make BOSS$SWITCH switching set output flag to s (for synchronism)
X  Default output flag is b
XVersion 1.5.  April 5, 1988
X  Fix exceeded quota problem that occurs when buflen > sysgen's maxbuf.
XVersion 1.6.  April 7, 1988
X  Fix failure to detect failure of LIB$SPAWN (e.g., when over quota).
X  Add C-t to make next process created as a top-level process.
XVersion 1.7.  June 5, 1988
X  Use separate command C-\ C-n a to create a process.
X  C-\ C-t a does this at top-level.
X  Cleaned up input routine.
XVersion 1.8.  June 7, 1988
X  Accept command line args:
X    /COMMAND_CHARACTER=char - set control character
X    /START_PROCESS=list - start up specified jobs
X    /STUFF_STRING=list - and stuff their input buffers
X    /OUTPUT_FLAGS=list - and set output flags accordingly
X    /BEGIN_PROMPT=string - part of prompt appearing before id letter
X    /END_PROMPT=string - part of prompt appearing after id letter
X    /DEFAULT_OUTPUT_FLAG=char - set default output flag
X    /SWITCH_CREATE - switching to nonexistent process creates it
XVersion 1.9.  June 8, 1988
X  Trap broadcasts to BOSS and send them on to the current process.
XVersion 2.0.  June 9, 1988
X  Add /DELETE_CHAR=char to specify a character to be interchanged with DEL.
XVersion 2.1.  June 10, 1988
X  Support selected terminal types via BOSS$TERM logical name.
XVersion 2.2.  June 26, 1988
X  Convert for new pseudo TTY drivers.
X  Change TPA to TWA; ignore SS$_DATAOVERUN; use GETDVI to get unit number
XVersion 2.3.  June 30, 1988
X  C-s (to stop output) hangs process when new PTY (TWA) drivers are used
X  with VMS 4.7.  Make BOSS try both TWA and TPA, so it works with both new
X  and old PTY drivers.
XVersion 2.4.  July 4, 1988
X  BOSS/FLOW_CONTROL to permit flow-control at BOSS level rather than
X  subprocess level.  To make this work, need to change C-s command to C-w.
XStill to do:
X  Make /FLOW_CONTROL work with Emacs by checking the device characteristics
X  of the pseudo TTY.  (Not sure how best to do this: Could do this with
X  setmode ast, or else check terminal setting, or else let user set a
X  per-process flag.)
X  C-l toggle output to log file sys$scratch:boss-x.log
X  C-a append to log file?
X
X*/
X
X#define VERSION`009`009"2.4"
X
X#include DESCRIP
X#include IODEF
X#include TTDEF
X#include TT2DEF
X#include JPIDEF
X#include LNMDEF
X#include PRVDEF
X#include PSLDEF
X#include SSDEF
X#include STSDEF
X#include DVIDEF
X
X#include stdio
X#include climsgdef
X
X#define  ttchrlen       12
X#define  tpdevlen       15
X#define  mbsiz          40
X#define  ttmbsiz       256
X#define  maxsiz         80
X#define  ttmaxsiz      256
X#define  imagelen       80
X#define  linesz        512
X#define  bufsize      4096`009/* Size of output buffers */
X#define  maxbuf       1200`009/* Should be less than SYSGEN MAXBUF */
X`009`009`009`009/* 1200 is in fact the minimum setting */
X#define  nproc           8      /* Number of process allowed */
X#define  nalph          26      /* Number of possible names */
X
X#define  bad(j)         !((j) & 1)
X#define  check(a)       if (bad(st = (a))) LIB$SIGNAL(st)
X
X#define NORMAL 0
X#define SWITCH 0
X#define PENDING 1
X#define CREATE 2
X#define TOP 3
X#define END 4
X
X#define BRK$C_DEVICE      1
X#define BRK$C_USER16      47
X
Xstruct CHARBLK {
X  unsigned char class, ttype;
X  unsigned short pgwid;
X  unsigned ttchr : 24;
X  unsigned char pglen;
X  unsigned int xchar;
X};
X
Xstruct IOSBBLK {
X  unsigned short stats, tmoff, tmntr, tmsiz;
X};
X
Xtypedef struct DVIBLK {
X`009unsigned short`009len, code;
X`009char`009* buffp;
X`009long`009* lenp;
X`009long`009terminate;
X`009} DVIBLK;
X
Xint
X  py_chn[nproc], py_mb_chn[nproc], tt_chn, tt_mb_chn,
X  pid[nproc], st, cur, count[nproc], buflen[nproc],
X  procno[nalph], priv[2], privs[2],
X  no_phy_io, no_oper, brkthru, ctlchar, init;
X
Xstatic char
X  *clr, *bos, *ceol, *ceoln,
X  *retval, ctlchar_str[4], prompt_begin[30], prompt_end[30],
X  switch_create, flow_control, delete_char,
X  stuff_buf[256], buf[256],image[imagelen],
X  finaltp[nproc][tpdevlen],
X  py_mb[nproc][mbsiz], tt_mb[ttmbsiz],
X  input_char, tpline[nproc][linesz], buffer[nproc][bufsize],
X  blocked[nproc], mode[nproc], pmode[nproc], defmode,
X  name[nproc], py_post[nproc], proc_type[nproc],
X  enable_hangup[nproc], input_state = 0, oboss_id = 0,
X  super_ac_mode = PSL$C_SUPER;
X
Xextern int BOSS_CLD();
X
Xstruct CHARBLK tt_chr, tt_sav_chr;
Xstruct IOSBBLK tiosb, tiosbmb, piosb[nproc], miosb[nproc];
X
Xstatic short trnlnm_string_len;
Xstatic char trnlnm_string[81];
X
Xstruct ITEM_LST {
X`009unsigned short len, code; char *addr; short *retlen;
X  } trnlnm_item = {80, LNM$_STRING, &trnlnm_string, &trnlnm_string_len};
X
Xquit()                         /* This is done upon exiting, by exit handler */
X{
X  int i,j;
X  char id[2];
X
X  $DESCRIPTOR(d_boss_id,"BOSS$ID");
X  $DESCRIPTOR(d_id, id);
X  if (oboss_id != 0) {`009`009/* Restore BOSS$ID */
X    id[0] = oboss_id;
X    j = LIB$SET_LOGICAL(&d_boss_id,&d_id,0,0,0);
X  }
X
X  for (i = 0; i < nproc; i++) {
X    if (name[i]) {
X      j = SYS$DELMBX(py_mb_chn[i]);
X      if (bad(j))
X        printf("[SYS$DELMBX pseudo-mbx deletion failed]\n");
X    }
X  }
X  j = SYS$QIOW(0,tt_chn,IO$_SETMODE,0,0,0,&tt_sav_chr,ttchrlen,0,0,0,0);
X  if (bad(j)) printf("[SYS$QIO /setmode/ failed]\n");
X  printf("\nEnd BOSS\n");
X}
X
Xmb_srv(n)`009`009`009/* AST for mailbox message on top-level */
X`009`009`009`009/* process completion */
X     int n;
X{
X  if (proc_type[n] == TOP) {
X    if (enable_hangup[n]) comp_srv(n);
X    else {
X      enable_hangup[n] = 1;
X      check(SYS$QIO(0,py_mb_chn[n],IO$_READVBLK,&miosb[n],&mb_srv,n,
X`009`009    &py_mb[n],mbsiz,0,0,0,0));
X    }
X  }
X}
X
X
Xcomp_srv(n)                     /* AST for completion of processes */
X     int n;
X{
X  int j;
X
X  j = SYS$DELMBX(py_mb_chn[n]);
X  if (name[n]) procno[name[n] - 'A'] = -1;
X  name[n] = '\0';
X  if (cur == n) {
X    cur = -1;
X    input_state = PENDING;
X  }
X}
X
Xint low_lib_spawn(n,pty_io,pid,name)
X                           /* Spawns subprocess to speaks to pseudo terminal */
Xchar *pty_io, name;
Xint  n, *pid;
X{
X  int flg = 1, len, val;
X  char proc[20],prompt[50],id[2];
X  $DESCRIPTOR(d_pty_io, pty_io); /* PTY name + number */
X  $DESCRIPTOR(d_proc, proc);   /* Process name */
X  $DESCRIPTOR(d_prompt, prompt); /* Prompt */
X  $DESCRIPTOR(d_boss_id,"BOSS$ID");
X  $DESCRIPTOR(d_id, id); /* The id */
X  d_pty_io.dsc$w_length = strlen(pty_io);
X  strcpy(proc,getenv("TT"));
X  len = strlen(proc);
X  if (proc[len-1] == ':') proc[--len] = '\0';
X  strcat(proc,"-A");
X  len = strlen(proc);
X  proc[len-1] = name;
X  d_proc.dsc$w_length= len;
X  if (proc[0] == '_') {
X    d_proc.dsc$w_length--;
X    d_proc.dsc$a_pointer++;
X  }
X  sprintf(prompt,"%s%c%s",prompt_begin,name,prompt_end);
X  d_prompt.dsc$w_length = strlen(prompt);
X  id[0] = name;
X  check(LIB$SET_LOGICAL(&d_boss_id,&d_id,0,0,0));
X  val = LIB$SPAWN(0,&d_pty_io,&d_pty_io,&flg,&d_proc,pid,0,0,
X                &comp_srv,n,&d_prompt,0);
X  check(LIB$DELETE_LOGICAL(&d_boss_id,0));
X  return(val);
X}
X
Xpy_srv(n)                       /* AST reads on pseudo terminal */
Xint n;
X{
X  int j;
X  py_post[n] = 0;
X  check(piosb[n].stats);        /* Check status */
X  count[n] = piosb[n].tmoff + piosb[n].tmsiz; /* How much was read */
X  if (n == cur || mode[n] == 'p') term_out(n);
X`009`009`009`009/* Write the stuff to the terminal */
X  else if (mode[n] == 'w') {
X    blocked[n] = 1;
X  }
X  else if (mode[n] == 'o') {
X    blocked[n] = 1;
X    check(SYS$QIO(0,py_chn[n],IO$_READVBLK,&piosb[n],&py_srv,n,
X`009`009  &tpline[n],linesz,0,0,0,0)); /* Queue next AST */
X    py_post[n] = 1;
X    }
X  else if (mode[n] == 'b') {
X    if (count[n]+buflen[n] < bufsize) {
X      for (j = 0; j < count[n]; j++) buffer[n][buflen[n]++] = tpline[n][j];
X      check(SYS$QIO(0,py_chn[n],IO$_READVBLK,&piosb[n],&py_srv,n,
X`009`009    &tpline[n],linesz,0,0,0,0)); /* Queue next AST */
X      py_post[n] = 1;
X      blocked[n] = 0;
X    }
X    else {
X      py_post[n] = 0;
X      blocked[n] = 1;
X    }
X  }
X}
X
Xterm_out(n)
Xint n;
X{
X  int j;
X  char nname;
X  $DESCRIPTOR(d_boss_switch,"BOSS$SWITCH");
X  $DESCRIPTOR(d_boss_stuff,"BOSS$STUFF");
X  $DESCRIPTOR(d_lnm_job,"LNM$JOB");
X  if (buflen[n] > 0) {
X    j = 0;
X    while (j < buflen[n]) {
X      check(SYS$QIOW(1,tt_chn,IO$_WRITEVBLK,&tiosb,0,0,&buffer[n][j],
X`009`009     (buflen[n] - j < maxbuf) ? buflen[n] - j : maxbuf,
X`009`009     0,0,0,0));
X      j += maxbuf;
X    }
X    buflen[n] = 0;
X    if (blocked[n]) {
X      check(SYS$QIOW(1,tt_chn,IO$_WRITEVBLK,&tiosb,0,0,
X`009`009    &tpline[n],count[n],0,0,0,0));
X    }
X  }
X  else {
X    check(SYS$QIOW(1,tt_chn,IO$_WRITEVBLK,&tiosb,0,0,
X`009`009  &tpline[n],count[n],0,0,0,0));
X  }
X  j = SYS$TRNLNM(0,&d_lnm_job,&d_boss_switch,&super_ac_mode,&trnlnm_item);
X  if (!bad(j) && trnlnm_string_len == 1) {
X    j = LIB$DELETE_LOGICAL(&d_boss_switch,&d_lnm_job);
X    nname = toupper(trnlnm_string[0]);
X    j = SYS$TRNLNM(0,&d_lnm_job,&d_boss_stuff,&super_ac_mode,&trnlnm_item);
X    if (!bad(j)) {
X      j = LIB$DELETE_LOGICAL(&d_boss_stuff,&d_lnm_job);
X      trnlnm_string[trnlnm_string_len] = '\0';
X    } else {
X      trnlnm_string[0] = '\0';
X    }
X    if (nname >= 'A' && nname <= 'Z') {
X      mode[n] = 'w';
X      mov_to(nname, 0, trnlnm_string, CREATE);
X    }
X  }
X  if (py_post[n] == 0) {
X    check(SYS$QIO(0,py_chn[n],IO$_READVBLK,&piosb[n],&py_srv,n,
X`009`009  &tpline[n],linesz,0,0,0,0)); /* Queue next AST */
X    py_post[n] = 1;
X    }
X  blocked[n] = 0;
X}
X
Xint count_processes()
X{
X  int j, i = 0;
X
X  for (j = 0; j < nproc; j++) if (name[j] > 0) i++;
X  return(i);
X}
X
Xdiag()
X{
X  char bufa[8];
X  int j;
X
X  if (count_processes()) {
X    sprintf(buf,"%s[Processes:",bos);
X    for (j = 0; j < nproc; j++) {
X      if (name[j] > 0) {
X        if (j == cur) sprintf(bufa," %c%c*",name[j],mode[j]);
X        else if (blocked[j]) sprintf(bufa," %c%c+",name[j],mode[j]);
X`009else if (buflen[j] > 0) sprintf(bufa," %c%c-",name[j],mode[j]);
X        else sprintf(bufa," %c%c",name[j],mode[j]);
X        strcat(buf,bufa);
X      }
X    }
X    strcat(buf,"] ");
X    strcat(buf,ceoln);
X  }
X  else sprintf(buf,"%s[No processes] %s",bos,ceoln);
X  term_msg(buf);
X}
X
Xint next_slot()
X{
X  int j = 0;
X  while ((j < nproc) && name[j]) j++;
X  return (j == nproc) ? -1 : j;
X}
X
Xterm_msg(msg)
Xchar *msg;
X{
X  check(SYS$QIOW(0,tt_chn,IO$_WRITEVBLK,0,0,0,msg,strlen(msg),0,0,0,0));
X}
X
Xchar *get_image(pid)           /* Get the image name for a process */
X     int pid;
X{
X  int j, item;
X  short len;
X  char *ptr, *ptra;
X  $DESCRIPTOR(d_image,image);
X  ptr = &image;
X  if (pid == 0) strcpy(image,"<TOP>");
X  else {
X    item = JPI$_IMAGNAME;
X    j = LIB$GETJPI(&item,&pid,0,0,&d_image,&len);
X    if (bad(j)) strcpy(image,"<UNKNOWN>");
X    else {
X      image[len]='\0';
X      if (len == 0) {
X`009item = JPI$_CLINAME;
X`009j = LIB$GETJPI(&item,&pid,0,0,&d_image,&len);
X`009if (bad(j)) strcpy(image,"<UNKNOWN>");
X`009else image[len]='\0';
X      }
X      else {
X`009if ((ptr = strrchr(image,']'))) ptr++;
X`009else ptr = &image;
X`009if (ptra = strchr(ptr,'.')) *ptra = '\0';
X      }
X    }
X  }
X  return(ptr);
X}
X
Xint mov_to(nname, clear, string, proc_mode) /* Switch to process */
X     /* string is stuffed into input */
X     /* proc_mode says whether to create process */
Xchar nname, *string;
Xint clear,proc_mode;
X{
X  int ncur,len,j;
X  char *prefix;
X  prefix = clear ? clr : bos;
X  len = strlen(string);
X  if ((cur >= 0) && (name[cur] == nname)) { /* Redundant move */
X    mode[cur] = pmode[cur];
X    if (len == 0) {
X      sprintf(buf,"%s[Already in process %c%c, %s]%s",
X`009      prefix,nname,mode[cur],get_image(pid[cur]),ceoln);
X      term_msg(buf);
X    }
X    j = 1;
X  }
X  else if ((ncur = procno[nname-'A']) >= 0) { /* Existing proc */
X    cur = ncur;
X    mode[cur] = pmode[cur];
X    sprintf(buf,"%s[Switch to process %c%c, %s]%s",
X`009    prefix,name[cur],mode[cur],get_image(pid[cur]),ceoln);
X    term_msg(buf);
X    if (blocked[cur] || buflen[cur] > 0) term_out(cur);
X    j = 1;
X  }
X  else if (proc_mode == SWITCH) {
X    sprintf(buf,
X`009    "%s[Process %c nonexisent\007 (type %s C-n %c to create it)]%s",
X`009    bos,nname,ctlchar_str,clear ? nname : tolower(nname),ceoln);
X    term_msg(buf);
X    len = 0;
X    j = 0;
X  }
X  else if ((ncur = next_slot()) < 0) {
X    if (cur >= 0)
X      sprintf(buf,"%s[No process slots left--still in %c%c]%s",
X`009      bos,name[cur],mode[cur],ceoln);
X    else sprintf(buf,"%s[No process slots left]%s",bos,ceoln);
X    term_msg(buf);
X    len = 0;
X    j = 0;
X  }
X  else {
X    if (proc_mode == CREATE)
X      sprintf(buf,"%s[Starting subprocess %c...%s",prefix,nname,ceol);
X    else if (proc_mode == TOP)
X      sprintf(buf,"%s[Starting top-level process %c...%s",prefix,nname,ceol);
X    term_msg(buf);
X    j = fire_up(ncur,nname,proc_mode);
X    if (bad(j)) {
X      if (cur >= 0)
X`009sprintf(buf,"failed!!\007--still in %c%c]%s",
X`009`009name[cur],mode[cur],ceoln);
X      else
X`009sprintf(buf,"failed!!\007]%s",ceoln);
X      term_msg(buf);
X      len = 0;
X    } else {
X      sprintf(buf,"done; now in process %c%c, %s]%s\r",
X`009      nname,mode[ncur],get_image(pid[ncur]),ceol);
X      term_msg(buf);
X      cur = ncur;
X      if (blocked[cur]) term_out(cur);
X    }
X  }
X  if (len > 0) {
X    check(SYS$QIOW(0,py_chn[cur],IO$_WRITEVBLK,&tiosb,0,0,
X                   string,len,0,0,0,0));
X    if (tiosb.stats != SS$_DATAOVERUN) check(tiosb.stats);
X  }
X  return(j);
X}
X
Xprint_help()
X{
X  if (ctlchar < 040)
X    sprintf(buf,"%sBOSS commands are preceded by %s (control-%c).  \
XThe commands are:%s",bos,ctlchar_str,tolower(ctlchar+0100),ceoln);
X  else
X    sprintf(buf,"%sBOSS commands are preceded by %s.  \
XThe commands are:%s",bos,ctlchar_str,ceoln);
X  term_msg(buf);
X  sprintf(buf,"\r    C-h     This message%s",ceoln);
X  term_msg(buf);
X  sprintf(buf,"\r    C-z     Quit%s",ceoln);
X  term_msg(buf);
X  sprintf(buf,"\r    a       Switch to process A (similarly for a thru z)%s",
X`009  ceoln);
X  term_msg(buf);
X  sprintf(buf,"\r    A       Clear screen and switch to process A%s",ceoln);
X  term_msg(buf);
X  sprintf(buf,"\r    C-n a   Create new process A as a subprocess%s",ceoln);
X  term_msg(buf);
X  sprintf(buf,"\r    C-t a   Create process A at top level%s",ceoln);
X  term_msg(buf);
X  sprintf(buf,"\r    ?       List processes (* means current, \
X+/- means waiting for output)%s",ceoln);
X  term_msg(buf);
X  sprintf(buf,"\r    C-b     Buffer output for this process%s",ceoln);
X  term_msg(buf);
X  sprintf(buf,"\r    C-o     Discard output for this process%s",ceoln);
X  term_msg(buf);
X  sprintf(buf,"\r    C-p     Print output from this process%s",ceoln);
X  term_msg(buf);
X  sprintf(buf,"\r    C-w     Stop output from this process%s",ceoln);
X  term_msg(buf);
X  sprintf(buf,"\r    %-3s     Send command character to current process%s",
X`009  ctlchar_str,ceoln);
X  term_msg(buf);
X  sprintf(buf,"\rType HELP BOSS for more information.%s",ceoln);
X  term_msg(buf);
X}
X
Xtt_srv()                        /* AST: Read on real terminal */
X{
X  int i;
X  char post, nname, nmode, *desc;
X
X  check(tiosb.stats);
X                                /* Read everything typed right away */
X  if (input_char == 0177) input_char = delete_char;
X  else if (input_char == delete_char) input_char = 0177;
X  if (input_state == NORMAL && cur < 0) input_state = PENDING;
X  switch (input_state) {
X  case NORMAL:
X    if (input_char == ctlchar) input_state = PENDING;
X    else {
X      check(SYS$QIOW(0,py_chn[cur],IO$_WRITEVBLK,&tiosb,0,0,
X`009`009     &input_char,1,0,0,0,0));
X      if (tiosb.stats != SS$_DATAOVERUN) check(tiosb.stats);
X    }
X    break;
X  case PENDING:
X    if (input_char == ctlchar) {
X      if (cur >=0) {
X`009check(SYS$QIOW(0,py_chn[cur],IO$_WRITEVBLK,&tiosb,0,0,
X`009`009       &input_char,1,0,0,0,0));
-+-+-+-+-+ End of part 3 +-+-+-+-+-