From:	CSBVAX::MRGATE!/ADMD=/PRMD=BITNET/O=FHCRCVAX/PN=JOE/@US@SMTP 24-AUG-1988 17:04
To:	ARISIA::EVERHART
Subj:	status part 7 of 7


Received: from UWAVM.ACS.WASHINGTON.EDU by uwavm.acs.washington.edu ; Wed, 24 Aug 88 13:14:04 PDT
Received: from UWAVM.ACS.WASHINGTON.EDU by UWAVM.ACS.WASHINGTON.EDU (Mailer
 X1.24) with BSMTP id 7571; Wed, 24 Aug 88 13:13:59 PDT
P1-Message-Id: US**EDU;UWAVM.ACS.WASHINGTON.EDU:LUoVce1U
Date:         Wed, 24 Aug 88 13:08-0700
X400-Trace:   US**EDU; arrival Wed, 24 Aug 88 13:08-0700 action Relayed
X400-Trace:   US**EDU; arrival Wed, 24 Aug 88 13:13-0700 action Relayed
From:         Joe Meadows</ADMD=/PRMD=BITNET/O=FHCRCVAX/PN=JOE/@US>
Subject:      status part 7 of 7
To:           <Everhart%Arisia.decnet@GE-CRD.ARPA>
Message-Id:   <UWAVM.ACS.WASHINGTON.EDU:LUoVce1U*>
X-VMS-To: @SYS$LOGIN:GLENN.EVERHART

+-+-+-+ Beginning of part 7 +-+-+-+
X  str$copy_dx(&ncbdesc,&node); /* move it to a dynamic string */
X  /* add in rest of the network connect block */
X  status = str$append(&ncbdesc,&task);
X  if (!(status & 1)) return(status);
X
X  status = sys$assign(&dev_desc,&(link->chan),0,0);
X  if (!(status & 1)) return(status);
X
X  /* (asynch) request a logical link to the remote task */
X  status = sys$qio(0,link->chan,IO$_ACCESS,&(link->iosb),
X`009`0090,0,0,&ncbdesc,0,0,0,0);
X  if (!(status & 1)) return(status);
X
X  link->linked = 0;
X}
X
X/* index = find_read_links(link,maxlinks)
X   this routine just checks all the iosb's of each link until it
X   finds a non-zero one (assumes that when SYS$QIO is finished it will
X   write an iosb, always has, always should..)
X*/
Xfind_ready_link(links,maxlinks)
X  struct NodeLink links[];
X  int maxlinks;
X{
X  int i,linksremaining,linkindx = -1;
X  float onesecond = 0.1;
X
X  /* any remaining ? */
X  linksremaining = 0;
X  for (i = 0; i < maxlinks; ++i)
X    if (links[i].linked == 0) linksremaining = -1;
X
X  while (linksremaining && (linkindx == -1)) {
X    i = 0;
X    while(links[i].iosb.status == 0) {
X      ++i;
X      if (i == maxlinks) {
X        i = 0;
X        lib$wait(&onesecond);
X      };
X    };
X    links[i].linked = -1;
X
X    /* found a ready link, let's just be sure it went okay.. */
X    if (!(links[i].iosb.status & 1))
X    {
X      printf("Node %.*s is not responding\n",
X`009`009links[i].length,links[i].nodename);
X      links[i].iosb.status = 0;
X      /* try to find a different link */
X      linksremaining = 0;
X      for (i = 0; i < maxlinks; ++i)
X        if (links[i].linked == 0) linksremaining = -1;
X    } else {
X      linkindx = i;
X    } /* end of else from if (links[i].iosb.satus) */
X  } /* end of while (linksremaining) */
X  return(linkindx); /* -1 or next connected link */
X}
X
Xparse_and_send(cmd,cmdstring,link)
X  char cmd;
X  char *cmdstring;
X  struct NodeLink *link;
X{
X  static struct dsc$descriptor command = {1,DSC$K_DTYPE_T,DSC$K_CLASS_S,0};
X  static struct dsc$descriptor string = {0,DSC$K_DTYPE_T,DSC$K_CLASS_D,0};
X  int status;
X
X  command.dsc$a_pointer = &cmd;
X  if (cli_present(cmdstring)) { /* get the string */
X    while ((status = cli_next_qual(cmdstring)) & 1) {
X      while ((status = cli_get_value(cmdstring,&string)) & 1) {
X        if ((cmd == SELECT) || (cmd == REJECT))
X        {
X          str$upcase(&string, &string);
X        }
X        str$prefix(&string,&command);
X        status = sys$qiow(0,link->chan,IO$_WRITEVBLK,&(link->iosb),0,0,
X`009`009`009string.dsc$a_pointer,string.dsc$w_length,0,0,0,0);
X        if (!(status & 1)) return(status);
X        if (!(link->iosb.status & 1)) return(link->iosb.status);
X        link->iosb.status = 0;
X      };
X    };
X    return(1);
X  } else {
X    return(0);
X  };
X}
X
Xrequest_info(cmd,link)
X  char cmd;
X  struct NodeLink *link;
X{
X  int status,cont;
X  unsigned char buff[256];
X
X  status = sys$qiow(0,link->chan,IO$_WRITEVBLK,&(link->iosb),0,0,
X`009`009&cmd,1,0,0,0,0);
X  if (!(status & 1))
X  {
X    print_str("Error communicating with server\n",-1);
X    return(status);
X  }
X  if (!(link->iosb.status & 1))
X  {
X    print_str("Error communicating with server\n",-1);
X    return(link->iosb.status);
X  }
X  link->iosb.status = 0;
X  cont = -1;
X  while (cont) {
X    status = sys$qiow(0,link->chan,IO$_READVBLK,&(link->iosb),0,0,
X`009`009buff,255,0,0,0,0);
X    if (!(status & 1))
X    {
X      print_str("Error communicating with server\n",-1);
X      return(status);
X    }
X    if (!(link->iosb.status & 1))
X    {
X      print_str("Error communicating with server\n",-1);
X      return(link->iosb.status);
X    }
X    link->iosb.status = 0;
X    if (buff[0] == 0)
X      cont = 0;
X    else
X    {
X      print_str(&buff[1],buff[0] - 1);
X    };
X  };
X  return(1);
X}
X
Xprint_str(msg,len)
X  char *msg;
X  int len;
X{
X  if (len == -1) len=strlen(msg);
X  if (cont_sw)
X  {
X    /* print using curses, carriage control is imbedded in string */
X    msg[len] = '\0';
X    print_window(msg);
X  }
X  else
X    printf("%.*s",len,msg);
X}
X
Xget_cluster_node(nodename,length)
X  char nodename[];
X  int *length;
X{
X  long int status = 1;
X  long int iosb[2];
X  static long int csid = -1;
X  static struct {
X    short int BufferLength;
X    short int ItemCode;
X    long int BufferAddress;
X    long int ReturnLengthAddress;
X  } ItemList[]={15,SYI$_NODENAME,0,0,0,0,0,0};
X
X  ItemList[0].BufferAddress = nodename;
X  ItemList[0].ReturnLengthAddress = length;
X
X  status=sys$getsyiw(0,&csid,0,&ItemList,iosb,0,0);
X  if (status & 1)
X    status = iosb[0];
X
X  return(status);
X}
X$EOD
X$ create/log STATUS.CLD
X$DECK
Xdefine verb status
X  image exe$dir:status
X  parameter p1, label = Node, value(list)
X  qualifier header, value(list)
X  qualifier display, value(list)
X  qualifier select, value(list)
X  qualifier reject, value(list)
X  qualifier sort, value(list)
X  qualifier cluster
X  qualifier continuous
X  qualifier interval, value(type=$number)
X$EOD
X$ create/log STATUS.COM
X$DECK
X$ priv = f$setprv("all")
X$ run/detached/prio=9/process="Status Server"-
X`009/output=server.log -
X`009/priv=(tmpmbx,netmbx,sysnam,share,world,cmkrnl,readall,exquota) -
X`009exe$dir:server.exe
X$ priv = f$setprv(priv)
X$EOD
X$ create/log STATUS.HLP
X$DECK
X! This help file is really more intended as a guideline. It isn't really
X! ready for human (er, user) consumption. But, here it is anyway..
X1 STATUS
X
X  STATUS is a program for displaying information about processes.
XIt can be set up to look just like SHOW SYSTEM, SHOW USERS, or any
Xof a number of different but similar utilities.
X
X  Its versatility comes with a price. You have to tell STATUS exactly
Xwhat you want to see, and how. Usually you will just create a command
Xprocedure, or a symbol definition, that contains a version of the
Xcommand that you like to use.
X! Here you might want to mention any such symbols that you create
X! for your users. You migt want to add a subtopic that further explains
X! the symbol(s) you have created for them.
X! For examples, see WHO.COM and SHOW*.COM
X
X  By default STATUS displays information about the node you are currently
Xon, however, if the "Status Server" is up and running on other machines
Xin you cluster, or DECnet, then you can get information about those machines.
XIf you specify /CLUSTER you should get info about every node in your
XVAXCluster. You may also just specify a list of node names, and info on
Xeach node requested will be displayed.
X
X  By itself, STATUS will do nothing. You need to tell it what to display
Xby using the /HEADER and /DISPLAY qualifiers. You may use the /SELECT
Xand /REJECT qualifiers to restrict which processes you get info on.
X
X  STATUS can show a continuous display by using the /CONTINUOUS
Xqualifier, or by using the /INTERVAL qualifier.
X2 Examples
X  This will display something similar to SHOW USERS:
X
X  STATUS/SELECT=TERMINAL="%*" -
X`009/HEADER = "          VAX/VMS Interactive Users" -
X`009/HEADER = "           %time" -
X`009/HEADER = "    Total number of interactive users = %ijobcnt" -
X`009/HEADER = " " -
X`009/HEADER = " Username     Process Name      PID     Terminal" -
X`009/DISPLAY= " %12username %15prcnam %pid  %14terminal %where"
X
X  If you had a symbol, such as "SU" which equated to the above,
Xyou could then say things like "SU/CLUSTER", "SU NodeX", "SU/CONT".
X
X2 Items
X3 GETJPI
X`009ACCOUNT, APTCNT, ASTACT, ASTCNT, ASTEN, ASTLM, AUTHPRI,
X`009AUTHPRIV, BIOCNT, BIOLM, BUFIO, BYTCNT, BYTLM, CLINAME,
X`009CPULIM, CPUTIM, CREPRC_FLAGS, CURPRIV, DFPFC, DFWSCNT,
X`009DIOCNT, DIOLM, DIRIO, EFCS, EFCU, EFWM, ENQCNT, ENQLM,
X`009FILCNT, FILLM, FREP0VA, FREP1VA, FREPTECNT, GPGCNT, GRP,
X`009IMAGECOUNT, IMAGNAME, IMAGPRIV, JOBPRCCNT, JOBTYPE,
X`009LOGINTIM, MASTER_PID, MAXDETACH, MAXJOBS, MEM, MODE, MSGMASK,
X`009OWNER, PAGEFLTS, PAGFILCNT, PAGFILLOC, PGFLQUOTA, PHDFLAGS,
X`009PID, PPGCNT, PRCCNT, PRCLM, PRCNAM, PRI, PRIB, PROC_INDEX,
X`009PROCPRIV, SHRFILLM, SITESPEC, STATE, STS, SWPFILLOC,
X`009TABLENAME, TERMINAL, TMBU, TQCNT, TQLM, UAF_FLAGS, UIC,
X`009USERNAME, VIRTPEAK, VOLUMES, WSAUTH, WSAUTHEXT, WSEXTENT,
X`009WSPEAK, WSQUOTA, WSSIZE
X3 GETSYI
X`009BOOTTIME, CLUSTER_FSYSID, CLUSTER_FTIME, CPU,
X`009MAXPROCESSCNT, NODENAME, NODE_AREA, NODE_CSID,
X`009NODE_HWTYPE, NODE_HWVERS, NODE_NUMBER, NODE_QUORUM,
X`009NODE_SWINCARN, NODE_SWTYPE, NODE_SWVERS, NODE_SYSTEMID,
X`009NODE_VOTES, PHYSICALPAGES, SCSNODE, SCSSYSTEMID,
X`009SCSSYSTEMIDH, SID, VERSION
X3 Other
X`009BJOBCNT`009`009Number of batch processes
X`009DEVICES`009`009Devices allocated to process
X`009ELAPSED`009`009Time since process logged in
X`009IDLECPU`009`009Time since process CPUTIM last changed
X`009IDLETERMINAL`009Time since last terminal I/O if terminal supports it
X`009IJOBCNT`009`009Number of interactive processes
X`009IMAGE`009`009Short form of image name
X`009IO`009`009Process DIRIO + BUFIO (GETJPI items)
X`009IPID`009`009Internal PID
X`009NJOBCNT`009`009Number of network processes
X`009PAGES`009`009Process PPGCNT + GPGCNT (GETJPI items)
X`009PHYSICAL`009Physical terminal name
X`009PROCCNT`009`009Number of total processes
X`009TIME`009`009Current time
X`009TYPE`009`009Type of process
X`009UPTIME`009`009Time since system booted
X`009WHERE`009`009Location of terminal (if supported)
X2 Qualifiers
X/HEADER
X`009This specifies what to display as a header. You may have multiple
Xheader lines by specifying /HEADER multiple times. Any JPI information
Xdisplayed in the header line is taken from the "Status Server" process.
X
X`009The qualifiers /HEADER and /DISPLAY work the same way. See
Xthe /DISPLAY qualifier for more information.
X
X/DISPLAY
X`009This specifies what to display about each process. You may have
Xmultiple display lines by specifying /DISPLAY multiple times. You specify
Xwhat you want displayed by passing a quoted string, which contains text
Xand item specifiers. An item specifier has one of the following formats:
X
X`009%<itemname>
X`009%<length><itemname>
X`009%<length><trim><itemname>
X
XThe <length> field specifies the maximum length of the field. The length
Xmay start with a "-" forcing right justification, a "." meaning center
Xjustified, or a "+" or nothing meaning left justified. A length of
Xzero ("0") is the same as not specifying a length. If the field is longer
Xthan the length than it will be truncated, depending on the justification.
XIf left justified, it truncates the right side, if left, vice versa, if
Xcentered, then it truncates evenly on both sides.
X
XThe <trim> field specifies how many characters to cut off of the field.
XIf positive it cuts off leading characters, if negative it cuts off
Xtrailing characters. Note that the trim can start with a ".", which is
Xsimply ignored. Trimming occurs before padding/trimming caused by the
Xjustification.
X
X`009For a complicated example, imagine we want to display the
Xprocess login time, we could use "%logintim" but that would give us
Xsomething like " 1-JAN-1988  9:45:32.21", we could simple trim off the
Xdate by using "%0.12", by specifying a length of 8, we can force the
Xtrailing 3 bytes to disappear, so that "%8.12logintim" does what we want.
XNote that we can also say "%-8-3logintim", which works just the opposite
Xof the above, but accomplishes the same thing, it first trims the last
X3 chars, than right justifies the remaining into an 8 byte field, thus
Xtrimming off the leading date.
X
X/SELECT
X`009This sets up a criteria for selecting a process. If not specified,
Xall process will be selected (unless specifically rejected by /REJECT).
XFor instance, to display any batch jobs, network jobs, local jobs, and
Xinteractive jobs, you could use the command:
X`009/SELECT=(TYPE=B*,JOBTYPE="N*,L*",MODE=I*)
XYou may wildcard the string (as above), as well as provide a list of
Xitems (as above).
X/REJECT
X`009This sets up a criteria for rejecting a process. For example
Xif you don't want to see any processes that in the the "hibernate"
Xstate, you would use /REJECT=STATE=HIB. You may wildcard the string
Xas well, and provide a list of items.
X/CLUSTER
X  Causes each node currently active in the cluster to be displayed. Note
Xthat the "Status Server" must be running on each machine for this to work
Xwell. If a node isn't running the server, it will time out after several
Xseconds with no harm done, just a possible waste of some time.
X/CONTINUOUS
X  Defaults to a 2 second update, unless /INTERVAL specifies something
Xelse.  This puts the display into a continuous update mode. To exit,
Xyou must hit ^C. Note that if you have requested that mutiple nodes by
Xdisplayed, this will cause it to move on to the next node. This will exit
Xthe program when you hit ^C after displaying the last node you requested
Xinfo on.
X/INTERVAL
X  /INTERVAL=n`009(where 'n' is in seconds).
X  Determines how frequently to update the screen. This puts the display
Xinto a continuous update mode. To exit, you must hit ^C. Note that if
Xyou have requested that mutiple nodes by displayed, this will cause it
Xto move on to the next node. This will exit the program when you hit ^C
Xafter displayig the last node you requested info on.
X$EOD
X$ create/log TELNET.C
X$DECK
X#include iodef
X#include descrip
X#include dvidef
X#include dcdef
X
X#include "globals.h" /* for itmlst */
X
X#define TCP$INFO IO$_MODIFY
X#define GETHST IO$_SKIPFILE
X
Xstruct tcp_info {
X  unsigned char ForeignHostSize;
X  unsigned char LocalHostSize;
X  char ForeignHost[128];
X  long int ForeignPort;
X  short int unused;
X  char LocalHost[128];
X  long int LocalPort;
X  unsigned long int LocalAddress;
X  unsigned long int ForeignAddress;
X};
X
Xstruct gethst_info {
X  unsigned long int NameLen;
X  char Name[128];
X};
X
X
XGet_TELNET_Destination(pid,where)
X  int pid;
X  char *where;
X{
X  static struct DevInfo {
X    long int pid;
X    short int len;
X    char name[64];
X  } devinfo[20];
X  struct dsc$descriptor dev = {0,0,0,0};
X  static int devinfosize = sizeof(struct DevInfo);
X  static int class = DC$_REALTIME, devinfocnt = 20;
X  int status, i, indx, chan, notfound;
X  struct tcp_info info;
X  struct gethst_info host;
X  short int iosb[4];
X
X  where[0] = '\0';
X  /* find all devices owned by this PID */
X  status = devices(&class, &pid, &devinfocnt, &devinfosize, devinfo);
X  if (status & 1) {
X    i = 0;
X    notfound = -1;
X    while (notfound && devinfo[i].len) {
X      if (devinfo[i].name[0] == '_' &&
X          devinfo[i].name[1] == 'I' &&
X          devinfo[i].name[2] == 'P')
X      {
X        dev.dsc$w_length = devinfo[i].len;
X        dev.dsc$a_pointer = devinfo[i].name;
X        notfound = 0;
X      }
X      else
X        ++i;
X    };
X    if (notfound) return(0);
X
X    status = sys$assign(&dev, &chan, 0, 0);
X    if (!(status & 1)) return(status);
X
X    status = sys$qiow(0,chan,TCP$INFO,iosb,0,0,&info,sizeof(info),0,0,0,0);
X    sys$dassgn(chan);
X    if (!(status & 1)) return(status);
X    if (!(iosb[0] & 1)) return(iosb[0]);
X
X    sprintf(where,"%.*s",info.ForeignHostSize, info.ForeignHost);
X    return(1);
X  };
X
X  /* otherwise, some kind of error.. */
X  return(0);
X}
X$EOD
X$ create/log TERMINAL.MAR
X$DECK
X`009.Title`009TERM_Info - Get information about a terminal
X`009.Ident`009/V01.001/
X`009.Enable`009SUP
X`009.Default Displacement,Word
X`009.Subtitle Introduction
X;+
X;
X; ----- TERM_Info:  Get information about a terminal;
X;
X; Facility:
X;
X;`009VAX/VMS system programming
X;
X; Abstract:
X;
X;`009This module provides a routine which can be called from any
X;`009VAX native  language to obtain information about a specific
X;`009terminal.
X;
X; Environment:
X;
X;`009VAX/VMS native mode, VMS V4.2 or later, CMKRNL privilege.
X;
X; Version:`009V01.001
X; Date:`009`00912-Apr-1988
X;
X;
X; Modifications:
X;
X;
X;-
X
X`009.Page
X`009.Subtitle Local definitions
X
X`009.Library "SYS$LIBRARY:LIB"
X`009`009;Get special macros from here
X`009.Link`009"SYS$SYSTEM:SYS.STB"/Selective_Search
X`009`009;Ease the link process a bit
X
X`009.NoCross`009;Save a tree
X
X`009$DCDEF`009`009`009`009;Device class & type definitions
X`009$DDBDEF`009`009`009`009;Device data block offsets
X`009$SSDEF`009`009`009`009;System service codes
X`009$TTYUCBDEF`009`009`009;Terminal UCB offsets
X`009$UCBDEF`009`009`009`009;UCB offsets
X
X`009.Cross`009`009`009`009;Turn CREF back on
X
X
X`009.Page
X`009.Subtitle`009TERMINFO`009- Get information about a terminal
X
X;+
X;
X; ----- TERM_INFO:  Get information about a terminal
X;
X;
X; The calling program must have  CMKRNL privilege and  must be linked
X; with SYS.STB.
X;
X; Call sequence:
X;
X;  status.wlv = TERM_INFO (terminal.rt.dx, term_info_structure.m?.r)
X;  term_info_structure :
X;`009.long`009ucb$l_duetim
X;`009.long`009ucb$l_pid
X;`009.word`009ucb$w_wrtt_link
XINFO_SIZE = 10
X;
X; Inputs:
X;
X;`0094(AP)`009- Address of a descriptor of the device name.
X;
X; Outputs:
X;
X;`0098(AP)`009- Address of a term_info structure.
X;
X;`009R0`009- SS$_NOPRIV:`009 No CMKRNL privilege.
X;`009`009- SS$_ACCVIO:`009 One of the arguments is not accessible.
X;`009`009- SS$_NOSUCHDEV: The specified device can't be found.
X;`009`009- SS$_IVDEVNAM:`009 The specified device isn't a terminal.
X;`009`009- SS$_NORMAL:`009 Success.
X;
X;-
X
X`009.Psect`009TERM_INFO`009EXE,RD,NOWRT,PIC,SHR,PAGE
X
X`009.Entry`009TERM_INFO,^M<>`009`009; Entry here
X
X`009$CMKRNL_S ROUTIN=B^20$,-`009; Do this
X`009`009ARGLST=(AP)`009`009;   in kernel mode
X
X10$:`009RET`009`009`009`009; Done, status in R0
X
X; Here in kernel mode to do all of the actual work.
X
X20$:`009.Word`009^M<R2,R3,R4,R5,R6,R7,R8,R9,R10,R11>
X`009`009;Here in kernel mode to get some info
X
X; First, check to see if we can read the argument list.
X
X`009MOVL`009#SS$_ACCVIO,R0`009`009; Presume we can't
X`009IFNORD`009#<3*4>,(AP),10$`009`009; Probe the argument list
X
X; Check the number of arguments
X
X`009MOVL`009#SS$_INSFARG,R0`009`009; Presume we have too few arguments
X`009CMPB`009#2,(AP)`009`009`009; Do we have enough arguments?
X`009BNEQ`00910$`009`009`009; If NEQ no, it's wrong somehow
X`009
X; Check to see if we can write the term_info structure.
X`009
X`009MOVL`009#SS$_ACCVIO,R0`009`009; Presume we can't
X`009IFNOWRT`009#INFO_SIZE,@8(AP),10$`009; Probe the term_info structure
X`009MOVL`0098(AP),R10`009`009; save the address of term_info struct.
X
X; See if we can read the device name descriptor.
X
X`009MOVL`0094(AP),R1`009`009; Address the device name descriptor
X`009JSB`009G^EXE$PROBER_DSC`009; Probe the descriptor
X`009BLBC`009R0,10$`009`009`009; Sigh.
X`009MOVQ`009R1,-(SP)`009`009; Save copy of the probed descriptor
X`009MOVL`009SP,R11`009`009`009; Remember where it is
X`009CLRW`0092(R11)`009`009`009; Never mind the type and class info
X
X; Ok.  Now go hunt down the device the user told us was a terminal
X
X`009MOVL`009G^SCH$GL_CURPCB,R4`009; Get my PCB address
X`009JSB`009G^SCH$IOLOCKR`009`009; Lock the I/O database mutex
X`009MOVL`009R11,R1`009`009`009; Address the device name descriptor
X`009JSB`009G^IOC$SEARCHDEV`009`009; Go search for the device.
X`009BLBC`009R0,30$`009`009`009; We lose.
X
X; Now check to see if it's really a terminal.
X`009MOVL`009#SS$_IVDEVNAM,R0`009; Presume it isn't a terminal
X       `009CMPB`009#DC$_TERM,UCB$B_DEVCLASS(R1)`009; Is it a terminal?
X`009BNEQ`00930$`009`009`009; If NEQ no.
X
X; okay, we have this device UCB in R1, let's change it so that the
X; physical UCB is in R1, and the logical UCB is in R2, note that
X; these may well be the same thing, only if the terminal is redirected
X; will there be any differene.
X`009MOVL`009UCB$L_TL_PHYUCB(R1),R2
X`009BEQL`00921$
X`009MOVL`009R2,R1`009; okay, store the physical UCB in R1...
X
X21$:`009; Let's get R2 pointing to logical UCB if there is one, else physical
X    `009MOVL`009R1,R2`009; assume it's not redirected
X`009BBC`009#DEV$V_RED,UCB$L_DEVCHAR2(R1),22$
X`009MOVL`009UCB$L_TT_LOGUCB(R1),R2
X`009BNEQ`00922$
X`009MOVL`009R1,R2`009; this should never occur
X
X22$:`009CLRW`009R3`009`009`009; clear the link number
X`009BBC`009#DEV$V_RTT,UCB$L_DEVCHAR2(R1),25$
X`009MOVW`009UCB$W_RTT_LINK(R1),R3`009; get the link number
X
X25$:`009MOVL`009UCB$L_DUETIM(R1),R0`009; get duetim
X`009BEQL`00926$`009`009`009; if zero, save it as zero...
X`009SUBL3`009R0,G^EXE$GL_ABSTIM,R0`009; save duetim
X26$:`009MOVL`009R0,(R10)+
X
X27$:`009MOVL`009UCB$L_PID(R2),R0`009; Get internal PID
X   `009JSB`009G^EXE$IPID_TO_EPID`009; Convert to extended PID
X`009MOVL`009R0,(R10)+`009`009; Save external PID
X`009MOVW`009R3,(R10)+`009`009; save rtt_link
X
X`009MOVL`009#SS$_NORMAL,R0`009`009; Success!
X`009MOVL`009G^SCH$GL_CURPCB,R4`009; Get my PCB address again
X
X30$:`009PUSHL`009R0`009`009`009; Save the return status
X`009JSB`009G^SCH$IOUNLOCK`009`009; Unlock the I/O database mutex
X`009SETIPL`009#0`009`009`009; Drop back down from IPL$_ASTDEL
X`009POPL`009R0`009`009`009; Restore the return status
X`009RET`009`009`009`009; Back to user mode
X
X`009.End
X$EOD
X$ create/log TERMINALS.FDL
X$DECK
XFILE
X`009NAME`009`009`009"sys$system:status_terminals.location"
X`009ORGANIZATION`009`009indexed
X
XRECORD
X`009CARRIAGE_CONTROL`009carriage_return
X`009FORMAT`009`009`009variable
X
XKEY 0
X`009SEG0_LENGTH`009`00924`009! can be changed, w/o affecting code
X`009SEG0_POSITION`009`0090
X`009TYPE`009`009`009string
X$EOD
X$ create/log WHO.COM
X$DECK
X$ who :== "status" -
X    "/select=(type=b*,jobtype=""n*,l*"",mode=i*)" -
V    "/header=""VAX/%node_swtype %node_swvers  on node %nodename %20time   Upti
m
Xe %13uptime""" -
V    "/header=""       %proccnt Processes, %ijobcnt Interactive, %bjobcnt Batch
Xjob(s)""" -
V    "/header=""T Location     Username     Pid   Pri  Cpu Time IdleTime State
P
Xgflts Image""" -
V    "/display=""%1typ %12where %12usernam %-4pid %-2pri/%2prib %-8-3cputim %-8
-
X3idlecpu %5state %-6pageflts %10image"""
X$ what :== "status"-
X    "/header=""`009VAX/VMS Process Info for node %nodename"""-
X    "/header=""`009`009booted on %11boottime"""-
X    "/header=""`009        %20time"""-
V    "/header=""`009%proccnt processes, %ijobcnt Interactive, %bjobcnt Batch &
%
Xnjobcnt Network"""-
V    "/header=""T Location     Username     Pid  Prio  Cpu Time State cnt Image
X      """-
V    "/display=""%1typ %12where %12usern %-4pid %-2pri/%2prib %-8-3cputim %5sta
t
Xe %3imagec %12image"""
X$ mem :== "status"-
X    "/select=(type=b*,jobtype=n*,jobtype=l*,mode=i*)"-
X    "/header=""`009VAX/VMS Process Info for node %nodename"""-
X    "/header=""`009`009booted on %11boottime"""-
X    "/header=""`009        %20time"""-
V    "/header=""`009%proccnt processes, %ijobcnt Interactive, %bjobcnt Batch jo
b
X(s)"""-
V    "/header=""T Location     Username     Pid   Pri  Pages WSSiz Pgflts Image
"
X""-
V    "/display=""%1typ %12where %12usernam %-4pid %-2pri/%2prib %-5pages %-5wss
i
Xze %-6pageflts %12image"""
X$ ws :== "status"-
X    "/select=(type=b*,jobtype=n*,jobtype=l*,mode=i*)"-
X    "/header=""`009VAX/VMS Process Info for node %nodename"""-
X    "/header=""`009`009booted on %11boottime"""-
X    "/header=""`009        %20time"""-
V    "/header=""`009%proccnt processes, %ijobcnt Interactive, %bjobcnt Batch jo
b
X(s)"""-
V    "/header=""T Username     Pid  State Cpu Time Pages WSSiz Pgflts WSQuo WSE
x
Xt VirtP WSPea"""-
V    "/display=""%1typ %12usernam %-4pid %5state %-8-3cputim %-5pages %-5wssize
X%-6pageflts %-5wsquota %-5wsextent %-5virtpeak %-5wspeak"""
X  $ io :== "status"-
X    "/select=(type=b*,jobtype=n*,jobtype=l*,mode=i*)"-
X    "/header=""`009VAX/VMS Process Info for node %nodename"""-
X    "/header=""`009`009booted on %11boottime"""-
X    "/header=""`009        %20time"""-
V    "/header=""`009%proccnt processes, %ijobcnt Interactive, %bjobcnt Batch jo
b
X(s)"""-
V    "/header=""T Location     Username     Pid  Que CPU Time Pgflts DirI/O Buf
I
X/O Image"""-
V    "/display=""%1typ %12where %12usernam %-4pid %3state %-8-3cputim %-6pagefl
t
Xs %-6dirio %-6bufio %image"""
X$ whof :== "status"-
X    "/select=(type=b*,jobtype=n*,jobtype=l*,mode=i*)"-
X    "/header=""`009VAX/VMS Process Info for node %nodename"""-
X    "/header=""`009`009booted on %11boottime"""-
X    "/header=""`009        %20time"""-
V    "/header=""`009%proccnt processes, %ijobcnt Interactive, %bjobcnt Batch jo
b
X(s)"""-
V    "/header=""T Location     Username     Pid   Pri  Cpu Time    IdleTime Sta
t
Xe cnt Image"""-
V    "/display=""%1typ %12where %12usernam %-4pid %-2pri/%2prib %-11cputim %-8-
3
Xidlecpu %5state %-3imagec %image"""
X$EOD
X$ create/log WHO.FDL
X$DECK
XFILE
X`009NAME`009`009`009"sys$system:status_who.names"
X`009ORGANIZATION`009`009indexed
X
XRECORD
X`009CARRIAGE_CONTROL`009carriage_return
X`009FORMAT`009`009`009variable
X
XKEY 0
X`009SEG0_LENGTH`009`00912`009! can be changed, w/o affecting code
X`009SEG0_POSITION`009`0090
X`009TYPE`009`009`009string
X$EOD
X$ create/log WINDOW.C
X$DECK
X#include descrip
X#include signal
X
X#define SMG$_EOF 1213442
X
Xint *hitaddr;
Xstatic struct {
X  unsigned init : 1;
X  unsigned msg : 1;
X  int pb;
X  int kb;
X  int kt;
X  int rows;
X  int cols;
X  int input;
X} screen;
X
Xstatic struct Window {
X  int vd;
X  int rows;
X  int cols;
X} std_window;
X
X
Xcall(status)
X  int status;
X{
X  if (!(status & 1)) lib$signal(status);
X};
X
Xbroadcast_message(astarg, r0, r1, pc, psl)
X  int *astarg, *r0, *r1, *pc, *psl;
X{
X  screen.msg = 1;
X
X  sys$wake(0,0); /* wake it up, in case it is asleep! */
X
X  smg$cancel_input(&screen.kb);
X
X  return(1);
X}
X
Xmessage_waiting()
X{
X  return(screen.msg);
X}
X
Xrepaint_screen(astarg, r0, r1, pc, psl)
X  int *astarg, *r0, *r1, *pc, *psl;
X{
X  smg$repaint_screen(&screen.pb);
X}
X
Xcreate_window(window, length, width, row, col)
X  struct Window *window;
X  int length, width;
X{
X  int N0 = 0, N1 = 1, N3 = 3, N22 = 22, N24 = 24;
X  int mask, nlen;
X
X  if (window == 0)
X  {
X    window = calloc(1,sizeof(struct Window));
X  };
X
X  if (window->vd)
X  {
X    call(smg$delete_virtual_display(&(window->vd)));
X  };
X
X  if (!(screen.init))
X  {
X    call(smg$create_pasteboard(&screen.pb, 0, &screen.rows, &screen.cols));
X    call(smg$create_virtual_keyboard(&screen.kb));
X    call(smg$set_keypad_mode(&screen.kb, &N0));
X    call(smg$set_broadcast_trapping(&screen.pb, &broadcast_message));
X    mask = (1 << ('R' - '@')) | (1 << ('W' - '@'));
X    call(smg$set_out_of_band_asts(&screen.pb,&mask,&repaint_screen,
X`009`009&screen.pb));
X    screen.init = 1;
X  }
X
X  if (length == 0) length = screen.rows;
X  if (width == 0) width = screen.cols;
X
X  call(smg$create_virtual_display(&length, &width, &(window->vd)));
X
X  if ((length != screen.rows) || (width != screen.cols))
X    call(smg$change_pbd_characteristics(&screen.pb,&width,&screen.cols,
X`009`009`009`009`009&screen.rows,&screen.rows));
X
X  call(smg$paste_virtual_display(&(window->vd), &screen.pb, &row, &col));
X}
X
Xwrite_text(window,text)
X  struct Window *window;
X  char *text;
X{
X  int N0 = 0, N1 = 1;
X  struct dsc$descriptor text_dsc = {strlen(text),0,0,text};
X
X  call(smg$put_line(&(window->vd), &text_dsc,0,0,0,&N1));
X  /* call(smg$erase_line(&(window->vd))); */
X  /* call(smg$set_cursor_rel(&(window->vd),&N1)); */
X}
X
Xset_cursor(window,row,column)
X  struct Window *window;
X  int row, column;
X{
X  call(smg$set_cursor_abs(&(window->vd),&row,&column));
X}
X
X
Xinit_screen()
X{
X  create_window(&std_window, 0, 0, 1, 1);
X
X  return(1);
X}
X
Xdelete_screen()
X{
X  set_cursor(&std_window,screen.rows - 1,1);
X  return(1);
X}
X
Xgoto_top()
X{
X  int row,col;
X
X  row = smg$cursor_row(&std_window.vd);
X  col = smg$cursor_column(&std_window.vd);
X  call(smg$erase_display(&std_window.vd,&row,&col));
X  set_cursor(&std_window,1,1);
X
X  return(1);
X}
X
Xprint_window(text)
X  char *text;
X{
X  char *newline, *ptr;
X  /* look through the text for "\n", if present, cut it up into chunks */
X
X  hide_display();
X
X  ptr = text;
X  newline = strchr(ptr,'\n');
X  while (newline)
X  {
X    *newline = '\0';
X    write_text(&std_window,ptr);
X    ptr = ++newline;
X    newline = strchr(ptr,'\n');
X  }
X  if ((strlen(ptr) != 0) || (ptr == text))
X    write_text(&std_window,ptr);
X
X  show_display();
X  return(1);
X}
X
Xint ctrl_c_hit()
X{
X  smg$repaint_screen(&screen.pb);
X  *hitaddr = 1;
X  sys$wake(0,0); /* wake it up, in case it is asleep! */
X  return(1);
X}
X
Xon_ctrl_c(hit)
X  int *hit;
X{
X  *hit = 0;
X  hitaddr = hit;
X
X  signal(SIGINT,&ctrl_c_hit);
X  return(1);
X}
X
Xhide_display()
X{
X  call(smg$begin_pasteboard_update(&screen.pb));
X}
X
Xshow_display()
X{
X  call(smg$end_pasteboard_update(&screen.pb));
X}
X
Xdisplay_messages()
X{
X  int status;
X  $DESCRIPTOR(null,"\0");
X  static struct dsc$descriptor string = {0,DSC$K_DTYPE_T,DSC$K_CLASS_D,0};
X
X  while (screen.msg)
X  {
X    call(smg$ring_bell(&std_window.vd));
X    while ((status = smg$get_broadcast_message(&screen.pb, &string)) == 1)
X    {
X      str$append(&string,&null);
X      print_window(string.dsc$a_pointer);
X    }
X    call(smg$ring_bell(&std_window.vd));
X    screen.msg = 0;
X    hibernate(5);
X  }
X}
X
Xhibernate(n)
X  int n;
X{
X  sleep(n);
X  sys$canwak(0,0); /* in case there are any pending WAKEs left... */
X}
X$EOD
$ GOSUB UNPACK_FILE
$ EXIT
-+-+-+-+-+ End of part 7 +-+-+-+-+-
