	PROGRAM TERMINALS
C  displays connected terminals on all chem and micom switch ports
c  if 'connected' whether logged into a computer or not
C  needs PRMMBX privilege to talk to switches
C
c	14-jun-86 jjb  added MICOM stuff
c	21-sep-85 mge  modified to reformat information and to standardize
c		       with LOCATE.
c
c  ask Chem switch for port status keep only connections (build array)
c  ask Micom for calling channels, build table of calling and
c      table of called in order keeping only connections (& resource name?)
c  loop1:  go through Chem switch ports
c      get Micom calling channel accessed via switch port
c      look up Micom called channel in Micom connection table
c      remove from Micom connection table so next loop2 not waste time
c      get VAX port accessed via Micom called channel
c      get Chem switch terminal location & route
c      output
c
c  loop2:  go through Micom connection tables   (skipping Chem switch ports)
c      get computer & port accessed via Micom called channel
c      get Micom calling channel location & route
c      output
c
	IMPLICIT INTEGER (A-Z)
	parameter maxswitchport='1f'x
	parameter maxmicom=200	! maximum Micom Connections we can keep track of
	CHARACTER*15 MBX_NAME
	CHARACTER*40 COMMAND, CHARACTERISTICS
	CHARACTER*30 CIRCUIT, LOCATION
	CHARACTER*4 TERMINAL
	CHARACTER*5 CALLING_CHAN, CALLED_CHAN, dummy
        CHARACTER*5 MICOM_CALLING(maxmicom), MICOM_CALLED(maxmicom)
	INTEGER chemstatus(0:maxswitchport)
	INTEGER micom_connections  ! number of actual micom connections
	INTEGER*2 IOSB(4)
	EXTERNAL IO$_WRITEVBLK, IO$_READVBLK, TIMEOUT_AST
	COMMON /CHANS/ CHAN1, CHAN2

	print *,'Port     Micom   Chem  Wire                          ',
	1		'     Terminal'
	print *,'name   to  from  p  t  route                         ',
	1		'location, owner, type'

C open the file of terminal characteristics accessed by chem switch terminal
	OPEN(3, FILE= 'SWITCH$DIR:SWITCHTERM.DAT',
	1 ACCESS='DIRECT', STATUS= 'OLD', RECORDTYPE= 'FIXED', 
	2 READONLY, SHARED)

C  MICOM channels 1/73:1/104 accessed by chem SWITCH PORTS 00-1F
	open(4, file='SWITCH$DIR:portlist.dat', status='old',
	1 recordtype='fixed', RECL=3, access='direct',readonly,shared)

C  PHAST:: ports (at least) indexed by Micom called channel
	open(12, file='switch$dir:micomport.dat', status='OLD',
	1	recordtype='fixed', access='keyed',
	1	organization='indexed', form='unformatted',
	1	key=(1:5:character),READONLY,shared)

d	print *,' starting to talk to Chem Switch'

C OPEN A CHANNEL TO THE SWITCH CONTROL program's MBX
	STATUS= SYS$ASSIGN('SWITCH_CONTROL_MBX', CHAN1,,)
	IF (.NOT. STATUS) THEN
		WRITE(6,*) 'ERR- NO SWITCH CONTROL MBX'
		CALL EXIT(STATUS)
	ENDIF
C
C DISABLE CTRL-Y'S
	CALL LIB$DISABLE_CTRL('02000000'X, OLDMASK)
C 
C CREATE A MBX FOR RECEIVING MESSAGES FROM THE CONTROL program
	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 process to answer
	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 TERMINAL
C NUMBERS ON THE Chem SWITCH
C  write the format 1010 into array COMMAND
	WRITE(COMMAND, 1010)
C  send the array to switch
	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
	J = 0
	DO I=0, maxswitchport
C WAIT FOR THE REPLY (read it into array COMMAND)
	  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   read chem port # & status from returned COMMAND array
	  READ(COMMAND,1020) CHEMPORT, CHEMSTATUS(CHEMPORT)
1020	  FORMAT(6X, Z2, 8X, Z2)
d	  if(chemstatus(chemport).ne.'ff'x) then
d	    print '(a,2z2.2)',' chemport, chemstatus(chemport)=',
d	1	chemport, chemstatus(chemport)
d	  endif

	ENDDO	! reply-reading loop

d	print *,' done reading from Chem switch.'
c    talk to Micom and build connection tables

	call micom_show_ch(micom_calling,micom_called,micom_connections)
d	print *,' done reading from Micom.'
d	print '(1x,a,1x,a)',
d	1	(micom_calling(i),micom_called(i),i=1,micom_connections)

C  LOOP1:   go through Chem switch ports

	do chemport=0,maxswitchport

c  clean up output strings in case incomplete info avail
	    called_chan = ' '
	    terminal = ' '

	    CHEMTERM = CHEMSTATUS(CHEMPORT)
d	    print '(a,z3,z3)',' chemterm,chemport=',chemterm,chemport

C if the port status is not in range then not connected, ignore
	    IF( CHEMTERM.LT.0 .OR. CHEMTERM.GE.128) GOTO 470
	    chemterm_on = chemterm_on + 1
c      get Micom calling channel accessed via chem port
	    READ( 4'CHEMPORT+1, err=485 ) CALLING_CHAN
d	    print *,' calling_chan=',calling_chan
c      get Micom called channel by searching table
	    do i=1,micom_connections
		IF(MICOM_CALLING(i).EQ.CALLING_CHAN) GOTO 450
	    enddo
d	    print *,' calling_chan=',calling_chan,' not found'
	    goto 480   ! chem-only output

450	    CONTINUE
	    CALLED_CHAN=MICOM_CALLED(i)  ! i = array position for connection
d	    print *,' called_chan=',called_chan
c      remove from Micom connection table so next loop2 not waste time
	    MICOM_CALLING(i) = ' '
	    MICOM_CALLED(i) = ' '

c      get VAX port accessed via Micom called channel
	    read(12,key=CALLED_CHAN, err=597) dummy, TERMINAL
d	    print *,' terminal=',terminal
598	    continue

480	continue	! chem-only output comes here
c      get Chem terminal location & route (ignore characteristics)
	    READ(3'CHEMTERM+1, ERR=490) CHARACTERISTICS,
	1					CIRCUIT, LOCATION

c  now have all important information about one Chem switch connection.
c  display it
	    WRITE(6,1050) TERMINAL, CALLED_CHAN, CALLING_CHAN,
	1		CHEMPORT, CHEMTERM, CIRCUIT, LOCATION
1050	FORMAT(' ', A4, 1X, A5, 1X, A5, 1X,  Z2.2, '-', Z2.2,
	1			1X, A30, A25)


470	    CONTINUE
	ENDDO

c
	print '(a,i2)',' Chem switch terminals turned on = ',chemterm_on

C  Micom Calling channels characteristics
	open(10, file='switch$dir:micomlist.dat', status='old',
	1	recordtype='fixed', recl=28, access='keyed',
	1	organization='indexed', form='unformatted',
	1	key=(1:5:character), readonly  )

c  LOOP2:  go through Micom connection tables   (skipping Chem switch ports)
	DO i = 1, micom_connections

		CALLED_CHAN = MICOM_CALLED(i)
		if(called_chan.eq.' ') goto 300  ! ignore Chem since done
		CALLING_CHAN = MICOM_CALLING(i)

c      get computer port accessed via Micom called channel
	    read(12,key=CALLED_CHAN,err=497) dummy, TERMINAL
d	    print *,' terminal=',terminal
498	continue

c      get Micom calling channel location & route (ignore characteristics)
	    read(10,key=CALLING_CHAN, err=495) dummy, characteristics,
	1		circuit, location
496	    continue

c      output
c  now have all important information about one Micom switch connection.
c  display it
	    WRITE(6,1090) TERMINAL, CALLED_CHAN, CALLING_CHAN,
	1		 CIRCUIT, LOCATION
1090	    FORMAT( ' ', A4, 1X, A5, 1X, A5, 1X, '     '
	1			1X, A30, A25 )

300	    CONTINUE	! comes here to ignore already-done Chem ports
	ENDDO

c  exit
	goto 500	

c  error reading micomlist.dat
495	circuit = '? no entry for'
	location = 'this calling chan ?'
	GOTO 496

c  error reading micomport.dat
497	terminal = '????'
	GOTO 498
597	terminal = '????'
	goto 598

485	WRITE(6,'(a,z2)') 'ERROR READING PORTLIST FILE ',CHEMPORT
	GOTO 500

490	WRITE(6,'(a,z2)') 'ERROR READING SWITCHTERM FILE ',CHEMTERM

500	STATUS= SYS$DELMBX(%VAL(CHAN2))
	CALL SYS$CANTIM(%VAL(1))
	CALL LIB$ENABLE_CTRL(OLDMASK)
	CALL EXIT

1000	FORMAT('SWITCH_', Z8.8)
1010	FORMAT('SHOW P_STATUS')

	END


	SUBROUTINE TIMEOUT_AST
C TIMER AST ROUTINE
	IMPLICIT INTEGER (A-Z)
	COMMON /CHANS/ CHAN1, CHAN2
	CALL SYS$CANCEL(%VAL(CHAN1))
	CALL SYS$CANCEL(%VAL(CHAN2))
	RETURN
	END
C
C
C FUNCTION SUBROUTINE TO DETERMINE 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
