	character*6 function vaxport(chemport)
	IMPLICIT INTEGER (A-Z)
	integer chemport
c  return VAX port name given Chem switch port number
c  ???  should consider returning 'node::port:'
c procedure:
C  on first pass build table by asking Micom about all PHAST:: ports
c  look up Micom calling channel number via chem switch port in PORTLIST.DAT
c  look up Micom called channel number in array
c  look up VAX port name in MICOMLIST.DAT ?   else return '_NONE:'

	INCLUDE '($IODEF)/NOLIST'
	INCLUDE '($SSDEF)/NOLIST'

	PARAMETER ( PRMFLG = 1 )
	PARAMETER ( MAX_VAX_PORTS = 32 )  ! max chem switch ports

	LOGICAL PASS_ONE/.TRUE./  ! initial value makes act like DATA statement
				  ! so value lasts between calls
	INTEGER*4 EXIT_STATUS,DESBLK(4)
	CHARACTER*4 PORT_LINE_TABLE(0:31) /32*'NONE'/
			! each VAX resource class MICOM channel
			! is numbered from 1/73 to 1/104 (MAX_VAX_PORTS of them)
			! table contains chem switch access group
			! Micom shelf/channel indexed by
			! the VAX resource class Micom channel 
			! it is connected to (shelf always 1)
	CHARACTER PID_MBX*14, COMMAND*80
 	CHARACTER*30 PORT_NAME(MAX_VAX_PORTS)
	CHARACTER*7 TEMP
	CHARACTER*30 USER_CIRC, LOCATION
	CHARACTER*40 CHARACTERISTICS
	character*5 calling_chan, called_chan
	character*5 dummy
	character*4 flag

	INTEGER*2 PID_MBX_IOSB(4)
	CHARACTER PID_MBX_BUF*80
	COMMON/PID_MBX/PID_MBX_CHAN,PID_MBX_IOSB,PID_MBX_BUF

	COMMON/CTRL_MASK/OLDMASK

	EXTERNAL EXIT_HANDLER


d	print '(a,z2)', ' chemport=',chemport
	if(chemport.lt.0 .or. chemport.ge.MAX_VAX_PORTS) then ! bad chemport
		vaxport = '_NONE:'
		return
	endif

C Ask MICOM for channel status to determine PHAST:: connections BUT..
C only on the first pass.  On the first pass build a table to
C match port names with terminal line number
	IF(.NOT.PASS_ONE) GOTO 1000
	PASS_ONE = .FALSE.
d	print *,' pass one in VAXPORT'
C
C Setup descriptor block for declaring exit handler
	DESBLK(2) = %LOC(EXIT_HANDLER)
	DESBLK(3) = 1
	DESBLK(4) = %LOC(EXIT_STATUS)

C Declare an exit handler
	ISTAT = SYS$DCLEXH(%REF(DESBLK))
	IF (ISTAT .NE. SS$_NORMAL) CALL EXIT(ISTAT)

C Create the return mailbox name from the PID
	WRITE(PID_MBX,'(6HMICOM_,Z8.8)') PID()

C Create the return mailbox
	ISTAT = SYS$CREMBX(%VAL(PRMFLG),PID_MBX_CHAN,,,,,PID_MBX)
	IF (ISTAT .NE. SS$_NORMAL) CALL EXIT(ISTAT)

C Assign a channel to the detached process mailbox
	ISTAT = SYS$ASSIGN('MICOM_MBX',MICOM_MBX_CHAN,,)
	IF (ISTAT .NE. SS$_NORMAL) CALL EXIT(ISTAT)

C Open debug output file ??? why
D	OPEN(UNIT=2,FILE='SYS$OUTPUT',TYPE='NEW',carriagecontrol='list')

C Set the old control mask
	CALL LIB$DISABLE_CTRL('02000000'X,OLDMASK)

c characteristics indexed by Micom calling line number (to get chem port)
	open(10, file='switch$dir:micomlist.dat', status='OLD',
	1	recordtype='fixed', access='keyed',
	1	organization='indexed', form='unformatted',
	1	key=(1:5:character),READONLY,shared)

C MICOMPORT file to match VAX ports to MICOM ports
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)

C Send port status command to MICOM  asking about Chem switch Micom calling chan
	COMMAND = 'SHOW CH 1/25:56'
	LEN = 15

C Send MICOM command to detached process mailbox
	ISTAT = SYS$QIOW(,%VAL(MICOM_MBX_CHAN),%VAL(IO$_WRITEVBLK),
	1 MICOM_MBX_IOSB,,,%REF(COMMAND),%VAL(LEN),,,,)
	IF (ISTAT .NE. SS$_NORMAL) CALL EXIT(ISTAT)

C Read MICOM reply lines from PID mailbox
	DO WHILE (.TRUE.)
	   ISTAT = SYS$QIOW(,%VAL(PID_MBX_CHAN),%VAL(IO$_READVBLK),
	1 PID_MBX_IOSB,,,%REF(PID_MBX_BUF),%VAL(80),,,,)
	   IF (ISTAT .NE. SS$_NORMAL) CALL EXIT(ISTAT)

C Look for end of file (end of response message)
	   IF (PID_MBX_IOSB(1) .EQ. SS$_ENDOFFILE) GOTO 100
C	   WRITE(2,'(19H PID_MBX_IOSB(2) = ,I2)')PID_MBX_IOSB(2)
D 	   WRITE(2,'(1H ,A)')PID_MBX_BUF(1:PID_MBX_IOSB(2))

c---------+---------+---------+---------+---------+---------+---------+---------+
c         1         2         3         4         5         6         7         8
c12345678901234567890123456789012345678901234567890123456789012345678901234567890
c---------+---------+---------+---------+---------+---------+---------+---------+
c  01/026  PG=17 AG=26   DG=NONE CONN  9600 TTJ1     CALLING   01/074  
C If the port is connected add the shelf/chan number to the table
	   FLAG = PID_MBX_BUF(33:36)
d	   print *,'flag=',flag
	   IF( PID_MBX_IOSB(2).LT.5 ) GOTO 400 ! ignore blank lines
c  Character position depends only on reply lines containing a resource name
	   IF(  (FLAG.EQ.'NRDY').OR.
	1       (FLAG.EQ.'IDLE').OR.
	1	(FLAG.EQ.'OOS ')  ) THEN   ! chem disconnectable
		FLAG='IDLE'
	   ENDIF
	   IF( FLAG.NE.'CONN' .AND. FLAG.NE.'IDLE' ) THEN
	       PRINT *,'FLAG=',FLAG
               FLAG='NONE'
	   ENDIF
	      CALLING_CHAN = PID_MBX_BUF(4:8)
	      CALLED_CHAN = PID_MBX_BUF(64:68)
c  but have to check whether on PHAST::   ???
c  ???  should probably allow non-phast and network-disconnect  ???
	      if(  ( (called_chan.lt.'1/073') .or.
	1	     (called_chan.gt.'1/104') ) .and.
	1	   ( FLAG.eq.'CONN' )            ) then  ! not on PHAST::
		print *, ' not on PHAST:: ',CALLED_CHAN
	        FLAG='NONE'
	      endif
d	      print *,'calling_chan,called_chan=',calling_chan,called_chan

c  translate Micom calling channel to Chem switch port #
	      READ(10, KEY=CALLING_CHAN ,ERR=496)
	1	                  CHARACTERISTICS, user_circ, LOCATION
497	      CONTINUE

c      by finding 'switch' in the location field
d	      write(6,*) CHARACTERISTICS, USER_CIRC, USER_LOC
	      swloc = index( USER_CIRC, 'sw:' )
	      if( swloc.le.0) then	! not on chem switch, must be some mistake
		print *,' Micom channel ',calling_chan,' not on Chem switch ?'
		print *,' so ignored'
		GOTO 400
	      endif
c  convert from ascii hex to binary   to use as index into table
c  tens hex should always be a digit since ports only up to 1F
c	      print*,'swloc=',swloc
	      dig10 = ichar(user_circ(swloc+3:swloc+3)) - 48
	      dig1  = ichar(user_circ(swloc+4:swloc+4))
	      if( dig1.ge.65) then  ! its a letter
		dig1 = dig1-55	! A hex=10 decimal
	      else	! digit
		dig1 = dig1-48
	      end if
d	      print *, user_circ(swloc+3:swloc+4)
	      SWITCH_PORT = dig10*16 + dig1
d	      print *,'port=',SWITCH_PORT

c  now find VAX port name for called channel & make table
	      IF( FLAG.EQ.'CONN' ) THEN
	        read(12,key=CALLED_CHAN,err=493)
	1		 dummy,PORT_LINE_TABLE(SWITCH_PORT)
494		CONTINUE
	      ELSE
		PORT_LINE_TABLE(SWITCH_PORT) = FLAG
	      ENDIF
d	      print *,'switch_port,port_line_table=',
d	1			switch_port,port_line_table(switch_port)
400	      continue
	ENDDO

100	CONTINUE
	close(10)
	close(12)
D	DO I=0,MAX_VAX_PORTS-1
D	TYPE *,'PORT',I,' CONNECTED TO VAX PORT ',PORT_LINE_TABLE(I)
D	ENDDO

1000	CONTINUE

C OK, PORT_LINE_TABLE contains VAX port vs. Chem switch port
c  so simply index into the table to get desired VAX port name

	vaxport = '_'//port_line_table(chemport)//':'

	return

493	continue
	write(6,*),'error reading MICOMPORT.DAT entry for ',called_chan
	goto 494

496	continue
	write(6,*),'error reading MICOMLIST.DAT entry for ',calling_chan
	user_circ = ' '  ! don't let it try to disconnect
	goto 497



	end	

	SUBROUTINE EXIT_HANDLER(ISTAT)
	IMPLICIT INTEGER (A-Z)
	INCLUDE '($SSDEF)/NOLIST'
	INTEGER*2 PID_MBX_IOSB(4)
	CHARACTER PID_MBX_BUF*80
	
	COMMON/PID_MBX/PID_MBX_CHAN,PID_MBX_IOSB,PID_MBX_BUF
	COMMON/CTRL_MASK/OLDMASK

C Delete the permanent mailbox 
	IF (PID_MBX_CHAN .NE. 0) THEN !a mailbox exists so delete it
	    STATUS = SYS$DELMBX(%VAL(PID_MBX_CHAN))
	    IF(STATUS.NE.SS$_NORMAL) CALL LIB$STOP(%VAL(STATUS))
	ENDIF
C Reset CTRL-Y
	CALL LIB$ENABLE_CTRL(OLDMASK)
	
C Call the condition handler for istat
	CALL EXIT(ISTAT)
	END
