	PROGRAM SYMBIONT
C
C
	IMPLICIT		INTEGER(A-Z)
	EXTERNAL		NETWRITE_GATE
	EXTERNAL		PSM$K_OUTPUT
	CHARACTER*255		OLD_FUNCDESC
	LOGICAL*1		START_OF_TASK_FLAG, NODE_IS_DOWN
	COMMON /EVENT_FLAGS/ 	START_OF_TASK_FLAG, NODE_IS_DOWN
	COMMON /PARAMS/		OLD_FUNCDESC
	STREAMS			= 1
	BUFSIZ			= 512
	START_OF_TASK_FLAG 	= .FALSE.
	NODE_IS_DOWN		= .FALSE.
	CODE 			= %LOC(PSM$K_OUTPUT)

C
C	Replace Dec's Write routine with our own.
C
	CALL PSM$REPLACE(CODE,NETWRITE_GATE)

	CALL PSM$PRINT(STREAMS, BUFSIZ)
	END


C
C	Start of our own homebrewed symbiont output routine.
C


	INTEGER*4  		FUNCTION NETWRITE(REQUEST_ID, WORK_AREA, FUNC, 
	2			FUNCDESC, FUNCARG)

	IMPLICIT		NONE

	INTEGER*4		SYMB_OPEN, SYMB_TASK
	INTEGER*4		REQUEST_ID,
	2			WORK_AREA,
	3			FUNC,
	4			FUNCARG

	CHARACTER*(*)		FUNCDESC

	INTEGER			NETLINK
	COMMON /EVENT_FLAGS/ 	START_OF_TASK_FLAG, NODE_IS_DOWN
	COMMON /PARAMS/		OLD_FUNCDESC
	CHARACTER*255		OLD_FUNCDESC
	LOGICAL*1		START_OF_TASK_FLAG, NODE_IS_DOWN

	PARAMETER		(NETLINK = 15)
C
C Declare External symbols.
C
	EXTERNAL	PSM$K_OPEN, PSM$K_WRITE, PSM$K_WRITE_NOFORMAT,
	2		PSM$K_CANCEL, PSM$K_CLOSE, PSM$K_START_STREAM,
	3		PSM$K_START_TASK, PSM$K_RESUME_TASK, 
	4		PSM$K_RESET_STREAM, PSM$K_STOP_STREAM, 
	5		PSM$K_PAUSE_TASK, 
	6		PSM$K_STOP_TASK, SS$_NORMAL, PSM$_FUNNOTSUP,
	7		PSM$_PENDING

C
C Declare External Routines.
C


	NETWRITE = %LOC(PSM$_FUNNOTSUP)


	IF (FUNC .EQ. %LOC(PSM$K_OPEN)) THEN
		NETWRITE= SYMB_OPEN(NETLINK,FUNCARG,FUNCDESC)
	ENDIF


	IF (FUNC .EQ. %LOC(PSM$K_WRITE)) THEN
		CALL SYMB_WRITE(NETLINK,'W',FUNCDESC)
		NETWRITE= (%LOC(SS$_NORMAL))
	ENDIF


	IF (FUNC .EQ. %LOC(PSM$K_WRITE_NOFORMAT)) THEN
		CALL SYMB_WRITE(NETLINK,'N',FUNCDESC)
		NETWRITE= (%LOC(SS$_NORMAL))
	ENDIF


	IF (FUNC .EQ. %LOC(PSM$K_CANCEL)) THEN
		NETWRITE= (%LOC(SS$_NORMAL))
	ENDIF


	IF (FUNC .EQ. %LOC(PSM$K_CLOSE)) THEN
		CALL SYMB_CLOSE(NETLINK)
		NETWRITE= (%LOC(SS$_NORMAL))
	ENDIF


	IF (FUNC .EQ. %LOC(PSM$K_START_TASK)) THEN
		IF (START_OF_TASK_FLAG) THEN
			NETWRITE = SYMB_TASK(NETLINK,'E')
		ENDIF
		START_OF_TASK_FLAG = .TRUE.
		NETWRITE= SYMB_TASK(NETLINK,'B')
	ENDIF

	RETURN
	END

C
C
C
C

	INTEGER*4 FUNCTION SYMB_OPEN(NETLINK,FUNCARG,FUNCDESC)

	EXTERNAL  		RMS$_ACC,RMS$_CRE,SYS$TRNLNM, LNM$_STRING,
	1			SS$_UNREACHABLE,SS$_NORMAL,RMS$_DNR
	INTEGER*4		SYS$TRNLNM,RMS$_CRE
	INTEGER*2 		SHORT_LIST(8)
	INTEGER*4 		LONG_LIST (4)

	COMMON /PARAMS/		OLD_FUNCDESC
	COMMON /EVENT_FLAGS/	START_OF_TASK_FLAG, NODE_IS_DOWN

	LOGICAL*1		START_OF_TASK_FLAG, NODE_IS_DOWN
	CHARACTER*255		OLD_FUNCDESC
	CHARACTER*255 		EQUIV_NAME,NODE_NAME
	INTEGER*4  		EQUIV_LEN,NODE_LEN

	EQUIVALENCE 		(LONG_LIST , SHORT_LIST)

	INTEGER 		NETLINK
	INTEGER*4		FUNCARG
	INTEGER*2		START
	CHARACTER*(*)		FUNCDESC
	
	INTEGER*4		STATUS, OPENERR, FNUM, RMSSTS, RMSSTV,
	1			IUNIT, CONDVAL
	CHARACTER*80		TASK,DEVICE

C
C	Set up Item List for all to SYS$TRNLNM.
C


	SHORT_LIST(1)		= 255			! Buffer Size
	SHORT_LIST(2)		= %LOC(LNM$_STRING)	! Translate Name
	LONG_LIST(2)		= %LOC(EQUIV_NAME)	! Store Here
	LONG_LIST(3)		= %LOC(EQUIV_LEN)	! Return Length
	LONG_LIST(4)		= 0			! Null Terminate List

	
C	TASK = 'Node"PrivedAccount Pass"::"TASK=PRSERVERV1"'

C
C	Need to send PRSERVER the Node name the print request will be 
C	coming on.  This is to generate meaningfull process names on 
C	the remote node.  Node name is translated from SYS$NODE and returned
C	in EQUIV_NAME.
C

	STATUS 	= SYS$TRNLNM(,'LNM$SYSTEM','SYS$NODE',,LONG_LIST)
	NODE_NAME = EQUIV_NAME(1:EQUIV_LEN)
	NODE_LEN = EQUIV_LEN

C
C	Parse out the node name for request and the device name.
C	If there is no node name, default to the current node SYS$NODE,
C	which is still stored in EQUIV_NAME.
C


	START = INDEX(FUNCDESC,'||')

C
C	If there is no node name, FUNCDESC will contain the device name.
C	Otherwise FUNCDESC will be of the form NODE||DEVICE:.
C

	IF (START .EQ. 0) THEN
		DEVICE			= FUNCDESC
	ELSE
		EQUIV_NAME		= FUNCDESC(1:(START-1))
		EQUIV_LEN  		= LEN(FUNCDESC)
		DEVICE 	   		= FUNCDESC(START+2:EQUIV_LEN)
	ENDIF


	TASK = EQUIV_NAME(1:(EQUIV_LEN-2))//'"Prived Account Password"'
	2				    //'::"TASK=PRSERVERV1"'
C
C	Request Network Connection on logical unit NETLINK.
C
	OPEN (UNIT=NETLINK,
	2     FILE=TASK,
	3     STATUS = 'OLD',IOSTAT=OPENERR)

C
C	Check completion status of the open.  For all conditions except 
C	RMS$_CRE,...ACC (Create Failed), simply return that status.  If it is
C	RMS$_CRE, check and see if there is also the status SS$_UNREACHABLE,
C	saying the node is unreahable, ie down.

	IF (OPENERR .NE. 0) THEN
		CALL ERRSNS(FNUM,RMSSTS,RMSSTV,IUNIT,CONDVAL)
		IF ((RMSSTS .NE. %LOC(RMS$_CRE)).AND.
	1		 (RMSSTS .NE. %LOC (RMS$_ACC)).AND.
	2	         (RMSSTS .NE. %LOC(RMS$_DNR))) THEN
			 SYMB_OPEN = RMSSTS
			 RETURN
		ELSE
			IF ((RMSSTV .NE. %LOC(SS$_UNREACHABLE)).AND.
	1	(RMSSTS .NE. %LOC(RMS$_DNR))) THEN
				SYMB_OPEN = RMSSTV
				RETURN
			END IF
		END IF

		NODE_IS_DOWN	=	.TRUE.
		OLD_FUNCDESC	=	FUNCDESC
		FUNCARG		=	0		! If node is down assume
							! upper/lower printer.

		SYMB_OPEN 	=	%LOC(SS$_NORMAL)
		RETURN

	END IF
	
C
C	Send node name to PRSERVER on node EQUIV_NAME .
C
	WRITE (UNIT=NETLINK,
	2      FMT = '(A)') NODE_NAME(1:NODE_LEN-2)

C
C	Get Status from PRSERVER.
C
	READ (UNIT=NETLINK,
	2     FMT = '(Z8)',
	3     IOSTAT = IOSTAT) STATUS

C
C	Send Device Name to PRSERVER on node.
C
	WRITE (UNIT=NETLINK,
	2      FMT = '(A)') DEVICE

C
C	Get Status from PRSERVER.
C
	READ (UNIT=NETLINK,
	2     FMT = '(Z8)',
	3     IOSTAT = IOSTAT) STATUS
C
C	Get device status from PRSERVER.
C
	READ (UNIT=NETLINK,
	2     FMT = '(Z8)',
	3     IOSTAT = IOSTAT) FUNCARG
	SYMB_OPEN = %LOC(SS$_NORMAL)
	NODE_IS_DOWN = .FALSE.
	RETURN
	END

C
C
C
C
C	
	INTEGER*4 FUNCTION SYMB_TASK(NETLINK,REQUEST)

	INTEGER	NETLINK

C
C	Declare external routines.
C

	INTEGER*4	LIB$WAIT
	EXTERNAL	LIB$WAIT,SS$_NORMAL

	CHARACTER*1	REQUEST
	
	INTEGER *4	STATUS, IOSTAT, DUMMY_ARG

	CHARACTER*255		OLD_FUNCDESC
	LOGICAL*1		START_OF_TASK_FLAG, NODE_IS_DOWN

	COMMON /EVENT_FLAGS/ 	START_OF_TASK_FLAG, NODE_IS_DOWN
	COMMON /PARAMS/		OLD_FUNCDESC

C
C	Remember to check and see if the remote printing node was up
C	when the queue was started.  If it was not, go ahead and create
C	the network link and set everything up bye calling SYMB_OPEN.
C	If when SYMB_OPEN returns, NODE_IS_DOWN is set to .FALSE., 
C	the go ahead and start the task.  Otherwise, wait 1 minute
C	and try again.
C


  10	IF (NODE_IS_DOWN) THEN
		STATUS = SYMB_OPEN(NETLINK, DUMMY_ARG, OLD_FUNCDESC)
		IF (NODE_IS_DOWN) THEN
			CALL LIB$WAIT(60.0)
			GO TO 10
		END IF
	ENDIF

C
C	Yeah, the remote node is up, continue on.
C



C
C	Send Start of Task Command 'B'.
C
	WRITE(NETLINK,
	2     FMT = '(A1)') REQUEST

C
C	Get Status from PRSERVER.
C
	
	READ (UNIT=NETLINK,
	2     FMT = '(Z8)',
	3     IOSTAT = IOSTAT) STATUS
	
	SYMB_TASK = %LOC(SS$_NORMAL)
	RETURN
	END


	SUBROUTINE SYMB_WRITE(NETLINK,REQUEST,FUNCDESC)

	INTEGER		NETLINK
	CHARACTER*1	REQUEST
	CHARACTER*(*)	FUNCDESC

	INTEGER*4	STATUS, IOSTAT

C
C	Send Formatted Write command and buffer to PRSERVER.
C
	WRITE(NETLINK,10) REQUEST,FUNCDESC
  10	FORMAT(A1,A)

	READ (UNIT=NETLINK,
	2     FMT = '(Z8)',
	3     IOSTAT = IOSTAT) STATUS
C
C	There will be no status returned from WRITE requests, since the
C	only possible one will be a timeout message, which we don't have to 
C	worry about.
C

	RETURN
	END



	SUBROUTINE SYMB_CLOSE(NETLINK)

	INTEGER		NETLINK

	CLOSE (NETLINK)
	RETURN
	END

