-+-+-+-+-+-+-+-+ START OF PART 2 -+-+-+-+-+-+-+-+
Xcmain()`09/* Start of main routine.  If it isn't main() don't need vaxcrtl
V  */
X  `7B
X  long ss_status;`09`09`09/* System service status returned */
X  unsigned long our_pid;`09`09/* This process's PID`09`09  */
X  unsigned long node_pid;`09`09/* Node pid (upper 4 hex digits)  */
X  unsigned long pid;`09`09`09/* Target process pid`09`09  */
X  int wait_count;`09`09`09/* Loop counter for image clear   */
X  float wait_time = 1.0;`09`09/* Counter wait time per iteration*/
X  float max_wait;`09`09`09/* Variable for max time to wait  */
X  long parse_quals();`09`09`09/* Parses command line qualifiers */
X
X  get_our_pid(&our_pid);`09`09/* Get our own Process ID`09  */
X  node_pid = our_pid & 0xFFFF0000;`09/* Get cluster id PID part `09  */
X  parse_quals();`09`09`09/* Parse command line qualifiers  */
X  check_status(ots$cvt_tz_l(&idval_desc,&pid));`09 /* Convert PID to long
V   */
X  if ((pid > 0) && (pid < 0x10000)) pid += node_pid; /* Fill short PID    */
X  if (NODELPRC) `7B
X    check_status(sys$forcex(&pid,0,SS$_NORMAL));`20
X    `7D
X  else `7B
X    if ((!NOW) && (pid != 0)) `7B
X      wait_count = 0;
X      get_imagename(pid);
X      check_status(sys$forcex(&pid,0,SS$_NORMAL));`20
X      check_status(get_imagename(pid));
X      if (PATIENCE)`20
X          max_wait = PATIENCE_WAIT;
X        else`20
X          max_wait = MAX_WAIT_COUNT;
X      do `7B
X        lib$wait(&wait_time);
X        if (++wait_count >=max_wait) exit (SS$_ABORT);
X        check_status(get_imagename(pid));
X        `7D while (imagename.dsc$w_length > 0 );
X      `7D /* endif not /NOW and PID isn't zero */
X    ss_status = sys$delprc(&pid,0);`09
X    `7D`20
X  exit(ss_status); `20
X  `7D
X
X
X/*
X * get imagename     Return the image name of the given PID
X *
X */
Xlong get_imagename(the_pid)
Xunsigned long the_pid;`09`09`09`09 /* Target process's ID     */
X  `7B
X  $DESCRIPTOR(asctim,"0 00:00:00.10");
X  ITEMLIST itemlist`5B2`5D;`09`09`09`09 /* System service item list*/
X  unsigned long bintim`5B2`5D;`09`09`09 /* Binary time             */
X  unsigned long max_wait;
X  unsigned long ef_value;
X  unsigned long count = 0;
X  itemlist`5B0`5D.buflen = MAXFILESPECLEN;`09`09 /* Buffer length `09    */
X  itemlist`5B0`5D.bufaddr = imagename.dsc$a_pointer; /* Buffer address `09
V    */
X  itemlist`5B0`5D.retlen = &imagename.dsc$w_length;  /* Return length of str
Ving */
X  itemlist`5B0`5D.itemcode = JPI$_IMAGNAME;`09`09 /* Item requested
V          */
X  itemlist`5B1`5D.end = 0;`09`09`09`09 /* End of itemlist`09    */
X  check_status(sys$Bintim(&asctim,&bintim));
X  check_status(lib$get_ef(&event_flag));`09 /* Get an event flag       */
X  check_status(lib$get_ef(&wait_flag));`09`09 /* Get an event flag       */
X  sys$clref(event_flag);             `09`09 /* Clear it                */
X  sys$clref(wait_flag);             `09`09 /* Clear it                */
X  check_status(sys$getjpi(event_flag,&the_pid,0,itemlist,0,0,0));
X  if (PATIENCE)`20
X    max_wait = PATIENCE_WAIT;
X  else`20
X    max_wait = MAX_WAIT_COUNT;
X  do `7B
X    sav_stat=sys$readef(event_flag,&ef_value);
X    if (sav_stat ==SS$_WASCLR) `7B
X      check_status(sys$setimr(wait_flag,&bintim,0L,0L,0L));
X      check_status(sys$waitfr(wait_flag));
X      `7D
X    else
X      if (sav_stat !=SS$_WASSET)
X        check_status(sav_stat);
X    `7D while (( ++count < max_wait) && sav_stat ==SS$_WASCLR);
X  return(SS$_NORMAL);
X  `7D
X
X/*
X * get_our_pid         Get this current process' onw process ID.
X *
X */
Xget_our_pid(the_pid)
Xlong *the_pid;`09`09`09`09`09/* The PID`09           */
X  `7B
X  ITEMLIST itemlist`5B2`5D;`09`09`09`09/* System service item list*/
X  long ourpid;`09`09`09`09`09/* Our pid (generic)`09   */
X  itemlist`5B0`5D.buflen = sizeof (*the_pid);`09/* Buffer length`09   */
X  itemlist`5B0`5D.bufaddr = the_pid;`09`09/* Buffer address`09   */
X  itemlist`5B0`5D.retlen = (short *)NULL;`09`09/* Who cares how long it is*/
X  itemlist`5B0`5D.itemcode = JPI$_PID;`09`09/* Item requested`09   */
X  itemlist`5B1`5D.end = 0;`09`09`09`09/* End of itemlist`09   */
X  ourpid = 0;`09`09`09`09`09/* Initialize generic pid  */
X  check_status(sys$getjpiw(0,&ourpid,0,itemlist,0,0,0)); /* Get it */
X  `7D
X
X
X/*
X * parse_quals       Parse command line qualifiers and set boolean flags
X *
X */
Xparse_quals()`09`09
X  `7B
X  long cli_status;`09`09`09`09/* Status from CLI$ routines */
X  /* See what the /IDENTIFICATION= qualifier gave us */
X  check_status(cli$get_value(&id_desc,&idval_desc,&idval_desc.dsc$w_length))
V;
X  /* Set NOW or PATIENCE depending on the qualifier's existence:    */
X  cli_status = cli$present(&dm_desc);
X  if ((cli_status == CLI$_PRESENT) `7C`7C (cli_status == CLI$_LOCPRES))`20
X    NOW = TRUE;`20
X  else
X    NOW = FALSE;
X  cli_status = cli$present(&pt_desc);
X  if ((cli_status == CLI$_PRESENT) `7C`7C (cli_status == CLI$_LOCPRES))`20
X    PATIENCE = TRUE;`20
X  else
X    PATIENCE = FALSE;
X  cli_status = cli$present(&fx_desc);
X  if ((cli_status == CLI$_PRESENT) `7C`7C (cli_status == CLI$_LOCPRES))`20
X    NODELPRC = TRUE;`20
X  else
X    NODELPRC = FALSE;
X  `7D
X
X
X/*
X * substr(b,a)     Search for substring b inside of string a  `20
X *
X */
Xint substr(b,a)
Xlong *a;
Xlong *b;
X  `7B
X  long index;
X  long substr_index;
X  return(str$find_first_substring(a,&index,&substr_index,b));
X  `7D
$ CALL UNPACK STOP_ID.C;3 456448949
$ create 'f'
X!*************************************STOP**********************************
V****
Xdefine syntax STOP_QUEUE_MANAGER
X   image QUEMAN
X   noparameters
Xdefine syntax STOP_QUEUE
X   image QUEMAN
X   parameter P1 , prompt="Queue"
X      value (required)
Xdefine syntax STOP_ENTRY
X   image QUEMAN
X   parameter P1
Xdefine syntax STOP_CPU
X   image SMPUTIL
X   parameter P1 , label=CPU_LIST
X      value (list,type=$number)
X   qualifier ALL
X   qualifier FOREVER
X   qualifier OVERRIDE_CHECKS
X   disallow (ALL and CPU_LIST)
Xdefine syntax STOP_ID
X   image STOP_ID
Xdefine verb STOP
X   cliroutine STOP , cliflags (nostatus)
X   parameter P1 , prompt="Process"
X      value (type=$process)
X   qualifier MANAGER , syntax=STOP_QUEUE_MANAGER
X      nonnegatable
X   qualifier ABORT , syntax=STOP_QUEUE
X      nonnegatable
X   qualifier NEXT , syntax=STOP_QUEUE
X      nonnegatable
X   qualifier IDENTIFICATION , syntax=STOP_ID
X      nonnegatable
X      value (required)
X   qualifier NOW , syntax=STOP_ID
X     nonnegatable `20
X   qualifier PATIENCE , syntax=STOP_ID
X     nonnegatable
X   qualifier NODELPRC , syntax=STOP_ID
X     nonnegatable
X   disallow ((not IDENTIFICATION) and (NOW or PATIENCE or NODELPRC))
X   disallow (any2(NOW,PATIENCE,NODELPRC))
X   qualifier REQUEUE , syntax=STOP_QUEUE
X      nonnegatable
X      value
X   qualifier PRIORITY , syntax=STOP_QUEUE
X      nonnegatable
X      value (required)
X   qualifier HOLD , syntax=STOP_QUEUE
X   qualifier ENTRY , syntax=STOP_ENTRY
X      nonnegatable
X      value (required,list,type=$number)
X   qualifier CPU , syntax=STOP_CPU
X      nonnegatable
X   qualifier QUEUE , syntax=STOP_QUEUE
X      nonnegatable
X   qualifier RESET , syntax=STOP_QUEUE
X      nonnegatable
X   disallow any2(REQUEUE,MANAGER,ABORT,NEXT,RESET,IDENTIFICATION,CPU)
X   disallow any2(ENTRY,MANAGER,ABORT,NEXT,RESET,IDENTIFICATION,CPU)
X   disallow ((IDENTIFICATION or CPU) and QUEUE)
X   disallow ((PRIORITY or HOLD) and not REQUEUE)
$ CALL UNPACK STOP_VERB_NEW.CLD;1 2002484620
$ create 'f'
X!*************************************STOP**********************************
V****
Xdefine syntax STOP_QUEUE_MANAGER
X   image QUEMAN
X   noparameters
Xdefine syntax STOP_QUEUE
X   image QUEMAN
X   parameter P1 , prompt="Queue"
X      value (required)
Xdefine syntax STOP_ENTRY
X   image QUEMAN
X   parameter P1
Xdefine syntax STOP_CPU
X   image SMPUTIL
X   parameter P1 , label=CPU_LIST
X      value (list,type=$number)
X   qualifier ALL
X   qualifier FOREVER
X   qualifier OVERRIDE_CHECKS
X   disallow (ALL and CPU_LIST)
Xdefine verb STOP
X   cliroutine STOP , cliflags (nostatus)
X   parameter P1 , prompt="Process"
X      value (type=$process)
X   qualifier MANAGER , syntax=STOP_QUEUE_MANAGER
X      nonnegatable
X   qualifier ABORT , syntax=STOP_QUEUE
X      nonnegatable
X   qualifier NEXT , syntax=STOP_QUEUE
X      nonnegatable
X   qualifier IDENTIFICATION
X      nonnegatable
X      value (required)
X   qualifier REQUEUE , syntax=STOP_QUEUE
X      nonnegatable
X      value
X   qualifier PRIORITY , syntax=STOP_QUEUE
X      nonnegatable
X      value (required)
X   qualifier HOLD , syntax=STOP_QUEUE
X   qualifier ENTRY , syntax=STOP_ENTRY
X      nonnegatable
X      value (required,list,type=$number)
X   qualifier CPU , syntax=STOP_CPU
X      nonnegatable
X   qualifier QUEUE , syntax=STOP_QUEUE
X      nonnegatable
X   qualifier RESET , syntax=STOP_QUEUE
X      nonnegatable
X   disallow any2(REQUEUE,MANAGER,ABORT,NEXT,RESET,IDENTIFICATION,CPU)
X   disallow any2(ENTRY,MANAGER,ABORT,NEXT,RESET,IDENTIFICATION,CPU)
X   disallow ((IDENTIFICATION or CPU) and QUEUE)
X   disallow ((PRIORITY or HOLD) and not REQUEUE)
$ CALL UNPACK STOP_VERB_ORIGINAL.CLD;1 705527063
$ create 'f'
X-   19
Xdefine syntax STOP_ID
X   image STOP_ID
X-   30,   32
X   qualifier IDENTIFICATION , syntax=STOP_ID
X      nonnegatable
X      value (required)
X   qualifier NOW , syntax=STOP_ID
X     nonnegatable `20
X   qualifier PATIENCE , syntax=STOP_ID
X     nonnegatable
X   qualifier NODELPRC , syntax=STOP_ID
X     nonnegatable
X   disallow ((not IDENTIFICATION) and (NOW or PATIENCE or NODELPRC))
X   disallow (any2(NOW,PATIENCE,NODELPRC))
X/
$ CALL UNPACK STOP_VERB_UPDATE.DIF;1 1296181687
$ v=f$verify(v)
$ EXIT