	PROGRAM FREELINES
C  disconnects Chem switch connection with prejudice if Micom not connected
c  or if connected to PHAST but not logged in.

C  needs privilege PRMMBX to talk to CONTROL
C  note: can not spawn since DCL not present as run from CONTROL

c flow of program:
c  ask Chem switch for port status
c  loop:  for each Chem switch reply line
c	use routine VAXPORT to find corresponding VAX port
c		VAXPORT: talks to Micom on 1st call & builds table
c		    returns PHAST:: port or if not connected returns _IDLE:
c                   or if connected to something else returns _NONE:
c       if IDLE, disconnect (without warning)  this cleans up Micom timeouts
c       if PHAST port, ask GETDVI if not owned then disconnect (with warning)

c  Random notes:
C  MAY BE ABLE TO GET BY WITHOUT FREELINES SINCE MICOM HAS TIMEOUT !! ??
C  When Micom times out, drops DTR to VAX regardless of login status.
C     Can drop DSR to Chem switch, but Chem switch can't detect it, so
C     Chem switch has to be told by PHAST:: to disconnect.  This requires
C     PHAST to watch for Micom timeout disconnects via STATUS LOG port.
C     Micom disconnects happen without CHEM warning !    Could re-connect
C     terminal to a PHAST:: port to broadcast Chem disconnection message.


	IMPLICIT INTEGER (A-Z)

	PARAMETER (MAX_PORT=31)		! highest port number in decimal

	CHARACTER TIMEBUF*8, DATEBUF*9
	CHARACTER*1 BELL
	CHARACTER*4 VAXTERM
	CHARACTER*6 TT_NAME, VAXPORT
	CHARACTER*15 MBX_NAME
	CHARACTER*40 COMMAND
	INTEGER*4 TIMEOUTVAL(2)
	INTEGER*4 STATUS
	DATA TIMEOUTVAL(1), TIMEOUTVAL(2)/-30 000 000 0, -1/	! 30 sec
	INTEGER*2 DVILIST(14), IOSB(4)
	EQUIVALENCE (DVILIST(3), PID_BUF_ADRS)
	equivalence (dvilist(9), pid_buf_adrs_prim)

	COMMON /CHANS/ CHAN1, CHAN2

	EXTERNAL TIMEOUT_AST, IO$_WRITEVBLK, IO$_READVBLK,
	1 DVI$_PID, DVI$C_SECONDARY
C
	BELL=CHAR(7)
C
C WRITE A MESSAGE TO INDICATE THE PROGRAM WAS RUN
	call date(datebuf)
	call time(timebuf)
	WRITE(6,*) 'FREELINES EXECUTION START ',timebuf,' ',datebuf
C
C SET UP THE ITEM LIST FOR USE BY GETDVI SYS SERVICE
	DVILIST(1)= 4			!BUFFER LENGTH
	DVILIST(2)= %LOC(DVI$_PID) .OR.
	1	    %LOC(DVI$C_SECONDARY) !ITEM SPECIFIER (PID OF MAILBOX OWNER)?
	PID_BUF_ADRS= %LOC(OWNER_PID)	!ADDRESS OF BUFFER
	DVILIST(7)= 4
	DVILIST(8)= %LOC(DVI$_PID)	! primary owner PID
	PID_BUF_ADRS_PRIM= %LOC(PRIM_OWNER_PID)	! another buffer address
C
C CHEM SWITCH PORTS (TO MICOM calling channels)
	OPEN(UNIT=4, FILE='SWITCH:PORTLIST.DAT',
	1	ACCESS='DIRECT', STATUS='OLD', RECORDTYPE='FIXED',
	2	READONLY, SHARED)
C
C OPEN A CHANNEL TO THE SWITCH CONTROL MBX
	STATUS= SYS$ASSIGN('SWITCH_CONTROL_MBX', CHAN1,,)
	IF (.NOT. STATUS) THEN
		WRITE(6,*) 'ERR- FAILED TO OPEN SWITCH CONTROL MBX'
		CALL PUTMSG(STATUS)
		GOTO 500
	ENDIF
C
C CREATE A MBX FOR RECEIVING MESSAGES FROM THE SWITCH
	WRITE(MBX_NAME, 1000) PID()
	STATUS= SYS$CREMBX(%VAL(1), CHAN2,, %val(2000),,, MBX_NAME)
	IF (.NOT. STATUS) THEN
		WRITE(6,*) 'ERR- FAILED TO CREATE REPLY MBX'
		CALL PUTMSG(STATUS)
		GOTO 500
	ENDIF
C
C QUEUE A TIMER AST REQUEST IN CASE WE GET HUNG UP WAITING FOR
C SWITCH_CONTROL I/O AT SOME POINT
	CALL LIB$GET_EF(EF1)
	STATUS= SYS$SETIMR(%VAL(EF1), TIMEOUTVAL, TIMEOUT_AST, %VAL(1))
	IF (.NOT. STATUS) THEN
		WRITE(6,*) 'ERR- FAILED TO QUEUE TIMER AST REQUEST'
		CALL PUTMSG(STATUS)
		GOTO 500
	ENDIF
C
C SEND A SHOW P_STATUS COMMAND TO SWITCH_CONTROL TO LEARN THE STATUS
C OF EACH SWITCH PORT
	WRITE(COMMAND, 1010)
	STATUS= SYS$QIOW(, %VAL(CHAN1), IO$_WRITEVBLK, IOSB,,,
	1 %REF(COMMAND), %VAL(16),,,,)
	IF (.NOT. STATUS .OR. .NOT. IOSB(1)) THEN
		WRITE(6,*) 'ERR- QIOW WRITE TO SWITCH_CONTROL FAILED'
		CALL PUTMSG(STATUS)
		CALL PUTMSG(IOSB(1))
		GOTO 500
	ENDIF
C
C THE MBX SHOULD RECEIVE AN ENTRY FOR EACH SWITCH PORT
C READ EACH ONE
	DO 100 I=0, MAX_PORT
		STATUS= SYS$QIOW(, %VAL(CHAN2), IO$_READVBLK, IOSB,,,
	1				%REF(COMMAND), %VAL(40),,,,)
		IF (.NOT. STATUS .OR. .NOT. IOSB(1)) THEN
			WRITE(6,*) 'QIOW READ FROM SWITCH_CONTROL FAILED'
			CALL PUTMSG(STATUS)
			CALL PUTMSG(IOSB(1))
			GOTO 500
		ENDIF
C
C DECODE THE RECORD FOR THE MAILBOX WITH AN INTERNAL READ
		READ(COMMAND,1020) PORT, PORT_STATUS
C
C IF THE STATUS IS 'FF'X THEN THE PORT IS NOT CONNECTED, SO JUST SKIP IT
		IF (PORT_STATUS .EQ. 'FF'X) GOTO 100
C
C  ????? SHOULD NEVER DISCONNECT CHEM SWITCH PORTS IF POSSIBLY BEING USED ?????
C  ?????  i.e. should only disconnect if connected to PHAST:: & not logged in ????

C FIND OUT VAX PORT NAME
c ask Micom and consult several files about VAX port
c conceal it all in a character function beware ports already disconnected by
c Micom.  All values returned by TT_NAME have leading _ and trailing : .
		TT_NAME = VAXPORT(PORT)

c  handle non-PHAST:: connections and completely disconnected
		IF(TT_NAME.EQ.'_NONE:') then
			write(6,'(A,Z2,A)') ' chem port ',PORT,
	1			' not connected to PHAST::'
			goto 100	! skip this Chem port but warn manager
		ENDIF

		IF(TT_NAME.EQ.'_IDLE:') then
			write(6,'(A,Z2,A,Z2)')
	1			' Micom disconnected chem port ',PORT,
	1			'.  Disconnecting Chem terminal ',PORT_STATUS
			goto 200	! disconnect Chem terminal too (without warn)
		ENDIF

c  for future use in case VAXPORT returns non-PHAST::  ???
		IF(TT_NAME(2:2).NE.'T') then
			write(6,'(A,A,A)') ' Connected but not to PHAST:: ',
	1			TT_NAME,' should eventually network disconnect'
			goto 100
		ENDIF

C CALL THE GETDVI SYS SERVICE TO FIND OUT IF THE PORT IS OWNED BY A 
C PROCESS
		STATUS= SYS$GETDVI(,, TT_NAME, DVILIST, IOSB,,,)
		IF (.NOT. STATUS) THEN
			WRITE(6,*) 'ERROR- CALL TO SYS$GETDVI FAILED'
			CALL PUTMSG(STATUS)
			CALL PUTMSG(IOSB(1))
			GOTO 500
		ENDIF
C
C WAIT FOR COMPLETION
		STATUS=SYS$WAITFR(%VAL(0))
		IF( .NOT.STATUS ) THEN
			WRITE(6,*) 'ERROR- BAD STATUS FROM SYS$WAITFR'
			CALL PUTMSG(STATUS)
			GOTO 500
		ENDIF
		IF( .NOT.IOSB(1) ) THEN
			WRITE(6,*) 'ERROR- BAD STATUS FROM SYS$GETDVI'
			CALL PUTMSG(IOSB(1))
			GOTO 500
		ENDIF
C
c		print *,' OWNER_PID =',owner_pid,'PRIM_OWNER_PID =',
c	1		PRIM_OWNER_PID
C
		IF( OWNER_PID.NE.0 .OR. PRIM_OWNER_PID.NE.0 ) GOTO 100
C
C PID IS ZERO so THE PORT IS NOT ACTUALLY OWNED BY A
C PROCESS. THIS MEANS WE HAVE FOUND A CONNECTED TERMINAL THAT IS NOT
C ACTUALLY IN USE on this computer.
C  would be nice if we could avoid disconnecting the requesting port ???? !

C SEND A MESSAGE TO TERMINAL TELLING THEM TO TURN OFF AT LEAST 30 SECONDS
		OPEN(7,FILE=TT_NAME,STATUS='NEW')
		WRITE(7,1025) bell,bell
1025		FORMAT( a,' PPLLEEAASSEE TURN OFF YOUR TERMINAL WHEN UNUSED.'/
	1	' YOU ARE LOGGED OUT BUT YOUR TERMINAL IS TURNED ON.'/
	1	' You are being disconnected "with prejudice".'/
	1	' To connect, turn off this terminal at least 30 seconds.'/
	1	' See HELP SWITCH.'/
	1	' This has been a message from SWITCH_CONTROL.',a)
		CLOSE(7)
C
200	continue   ! comes here to disconnect chem since micom disconnected
C SEND A MESSAGE TO SWITCH_CONTROL REQUESTING THAT THE TERMINAL BE
C DISCONNECTED 'WITH PREJUDICE' SO THAT IT WILL NOT BE RECONNECTED
C UNTIL IT IS TURNED OFF AND BACK ON.
C FIRST FORMAT THE COMMAND
		WRITE(COMMAND, 1030) PORT_STATUS
C WRITE IT OUT FOR THE RECORD
		WRITE(6,*) COMMAND,TT_NAME
C
C AND THEN SEND IT
		STATUS= SYS$QIOW(, %VAL(CHAN1), IO$_WRITEVBLK, IOSB,,,
	1			%REF(COMMAND), %VAL(16),,,,)
		IF (.NOT. STATUS .OR. .NOT. IOSB(1)) THEN
			WRITE(6,*) 'ERR- QIOW WRITE TO SWITCH_CONTROL FAILED'
			CALL PUTMSG(STATUS)
			CALL PUTMSG(IOSB(1))
			GOTO 500
		ENDIF
C
C END OF DO LOOP
100	CONTINUE
C  success termination
C
C DELETE THE OUTPUT MAILBOX AND CANCEL THE TIMER AST
400	STATUS= SYS$DELMBX(%VAL(CHAN2))
	IF (.NOT. STATUS) THEN
		WRITE(6,*) 'ERR- FAILED TO DELETE REPLY MBX'
		CALL PUTMSG(STATUS)
	ENDIF
	CALL SYS$CANTIM(%VAL(1))
C
C AND QUIT, WERE ALL DONE
	CALL EXIT

C  error status exit
500	CONTINUE
C Note: input and output files must be specified since SYS$INPUT and SYS$OUTPUT
C	are not terminals
	CALL LIB$SPAWN(
	1	   '$ MAIL/SUBJ=" FREELINES failed !!!" NLA0: MANAGER',
	1	   'NLA0:','NLA0:')
	goto 400
C
1000	FORMAT('SWITCH_', Z8.8)
1010	FORMAT('SHOW P_STATUS')
1020	FORMAT(6X, Z2, 8X, Z2)
1030	FORMAT('DIS_PREJUDICE', 1X, Z2.2)
	END
C
C FUNCTION SUBROUTINE TO DETERMINE CURRENT PROCESS' PID
	INTEGER FUNCTION PID
	IMPLICIT INTEGER (A-Z)
	INTEGER*2 IOSB(4), ITMLST(8)
	EQUIVALENCE (ITMLST(3), BUFADR), (ITMLST(5), RLADR),
	1 (ITMLST(7), LSTEND)
	EXTERNAL JPI$_PID
	ITMLST(1)= 4
	ITMLST(2)= %LOC(JPI$_PID)
	BUFADR= %LOC(PIDBUF)
	RLADR= 0
	LSTEND= 0
	CALL LIB$GET_EF(EF)
	STATUS= SYS$GETJPI(%VAL(EF),,, ITMLST, IOSB,,)
	IF (.NOT. STATUS) CALL EXIT(STATUS)
	CALL SYS$WAITFR(%VAL(EF))
	IF (.NOT. IOSB(1)) CALL EXIT(IOSB(1))
	PID= PIDBUF
	CALL LIB$FREE_EF(EF)
	RETURN
	END
C
C
C TIMER AST ROUTINE
	SUBROUTINE TIMEOUT_AST
	IMPLICIT INTEGER (A-Z)
	COMMON /CHANS/ CHAN1, CHAN2
	CALL SYS$CANCEL(%VAL(CHAN1))
	CALL SYS$CANCEL(%VAL(CHAN2))
	RETURN
	END
