      PROGRAM SETPROCNAME

c  DAVID DELEY  June, 1986
c  The program is called in the following way:
c
c    $ setproc := $sys$manager:setprocname
c    $ setproc "NAME" "EXTENCHAR"
c
c  The program sets the process name to NAME
c  On error the program sets the process name to {NAME}{EXTENCHAR}2  etc
c  Examples:
c
c    $ setproc "sysDAVID"  "#@xx"
c      sets process name to sysDAVID
c                        or sysDAVID#@xx2
c                        or sysDAVID#@xx3
c                           .
c                           .
c                           .
c
c    $ setproc "David Deley"  "_"
c      sets process name to David Deley
c                        or David Deley_2
c                        or David Deley_3
c                           .
c                           .
c                           .
c
c
c  The quotes around NAME and EXTENCHAR are optional.
c  The quotes are necessary if lowercase letters are desired.
c  If EXTENCHAR is not specified or if "" is specified for EXTENCHAR
c   then no character is used between NAME and 2.

      INCLUDE '($SSDEF)'

      INTEGER SYS$SETPRN, STATUS, NAMELENGTH, LINELENGTH, P_LEN(8),
     *        EXTENCHAR_LEN
      CHARACTER*15 PROCNAME
      CHARACTER*14 EXTENCHAR
      CHARACTER*72 LINE, P(8)
      EQUIVALENCE (P(1),PROCNAME)
      EQUIVALENCE (P(2),EXTENCHAR)
      EQUIVALENCE (P_LEN(1),NAMELENGTH)
      EQUIVALENCE (P_LEN(2),EXTENCHAR_LEN)

      STATUS = LIB$GET_FOREIGN (LINE,,LINELENGTH)
      IF (STATUS .NE. SS$_NORMAL) CALL SYS$EXIT(%VAL(STATUS))
      CALL PARSE_LINE( LINE, LINELENGTH, P, P_LEN)

      IF (NAMELENGTH .GT. 15) NAMELENGTH = 15
      IF (EXTENCHAR_LEN .GT. 14) EXTENCHAR_LEN = 14
      STATUS = SYS$SETPRN( PROCNAME(1:NAMELENGTH) )
      IF (STATUS .EQ. SS$_NORMAL) CALL SYS$EXIT(%VAL(SS$_NORMAL))

      IF (NAMELENGTH .GE. ( 15 - (EXTENCHAR_LEN+1) ))
     *     NAMELENGTH = ( 15 - (EXTENCHAR_LEN+1) )
      PROCNAME(NAMELENGTH+1:NAMELENGTH+EXTENCHAR_LEN) = EXTENCHAR
      NAMELENGTH = NAMELENGTH + EXTENCHAR_LEN

      PROCNAME(NAMELENGTH+1:NAMELENGTH+1) = '2'
      STATUS = SYS$SETPRN( PROCNAME(1:NAMELENGTH+1) )
      IF (STATUS .EQ. SS$_NORMAL) CALL SYS$EXIT(%VAL(SS$_NORMAL))

      PROCNAME(NAMELENGTH+1:NAMELENGTH+1) = '3'
      STATUS = SYS$SETPRN( PROCNAME(1:NAMELENGTH+1) )
      IF (STATUS .EQ. SS$_NORMAL) CALL SYS$EXIT(%VAL(SS$_NORMAL))

      PROCNAME(NAMELENGTH+1:NAMELENGTH+1) = '4'
      STATUS = SYS$SETPRN( PROCNAME(1:NAMELENGTH+1) )
      IF (STATUS .EQ. SS$_NORMAL) CALL SYS$EXIT(%VAL(SS$_NORMAL))

      PROCNAME(NAMELENGTH+1:NAMELENGTH+1) = '5'
      STATUS = SYS$SETPRN( PROCNAME(1:NAMELENGTH+1) )
      IF (STATUS .EQ. SS$_NORMAL) CALL SYS$EXIT(%VAL(SS$_NORMAL))

      PROCNAME(NAMELENGTH+1:NAMELENGTH+1) = '6'
      STATUS = SYS$SETPRN( PROCNAME(1:NAMELENGTH+1) )
      IF (STATUS .EQ. SS$_NORMAL) CALL SYS$EXIT(%VAL(SS$_NORMAL))

      PROCNAME(NAMELENGTH+1:NAMELENGTH+1) = '7'
      STATUS = SYS$SETPRN( PROCNAME(1:NAMELENGTH+1) )
      IF (STATUS .EQ. SS$_NORMAL) CALL SYS$EXIT(%VAL(SS$_NORMAL))

      PROCNAME(NAMELENGTH+1:NAMELENGTH+1) = '8'
      STATUS = SYS$SETPRN( PROCNAME(1:NAMELENGTH+1) )
      IF (STATUS .EQ. SS$_NORMAL) CALL SYS$EXIT(%VAL(SS$_NORMAL))

      PROCNAME(NAMELENGTH+1:NAMELENGTH+1) = '9'
      STATUS = SYS$SETPRN( PROCNAME(1:NAMELENGTH+1) )
      IF (STATUS .EQ. SS$_NORMAL) CALL SYS$EXIT(%VAL(SS$_NORMAL))
	
	STOP 'Error setting process name'
	END

C	----------------------------------------------------------------

	SUBROUTINE PARSE_LINE( LINE, LINE_LEN, P, P_LEN )
	INTEGER*4	LINE_LEN		! Length of line to parse
	INTEGER*4	P_LEN(8)		! Length of each word in P
	INTEGER*4	I,J,K
	CHARACTER	LINE*(*)		! Line to parse
	CHARACTER*72	P(8)			! One word from LINE in each P(k)

	! Clean out P array.
	DO N = 1,8
	  P(N) = ' '
	ENDDO

	! Initialize loop
	I = 1
	J = 1
	K = 1

1	CONTINUE
	! Parse line for word
	! Search for first non-blank character
	DO WHILE ( LINE(J:J) .EQ. ' ' )
	  J = J + 1
	  IF ( J .GT. LINE_LEN ) RETURN
	ENDDO

	! make P(K)(I:I) = LINE(J:J)
	IF ( LINE(J:J) .EQ. '"' ) THEN
	    J = J + 1
10	    IF ( J .GT. LINE_LEN ) RETURN
	    IF ( LINE(J:J+1) .EQ. '" ' ) GOTO 20
	    P(K)(I:I) = LINE(J:J)
	    P_LEN(K) = I
	    I = I + 1
	    J = J + 1
	    IF ( I .LT. 72 ) GOTO 10
	ELSE
11	    IF ( J .GT. LINE_LEN ) RETURN
	    IF ( LINE(J:J) .EQ. ' ' ) GOTO 20
	    P(K)(I:I) = LINE(J:J)
	    P_LEN(K) = I
	    I = I + 1
	    J = J + 1
	    IF ( I .LT. 72 ) GOTO 11
	ENDIF
20	J = J + 1	! Next character in LINE
	K = K + 1	! Next subscript of P(k)
	I = 1		! First character of P(k)
	IF ( K .GT. 8 ) RETURN
	GOTO 1		! AND GET NEXT WORD INTO P(K+1)

	END
