Google
 

Trailing-Edge - PDP-10 Archives - BB-W661A-BM_1983 - tools/svcrcv.for
There is 1 other file named svcrcv.for in the archive. Click here to see a list.
C Copyright (c) 1982, 1983 by
C DIGITAL EQUIPMENT CORPORATION, Maynard, Massachusetts 01754
C
C This software is furnished under a license and may be used and  copied
C only  in  accordance  with  the  terms  of  such  license and with the
C inclusion of the above copyright notice.  This software or  any  other
C copies  thereof may not be provided or otherwise made available to any
C other person.  No title to and ownership of  the  software  is  hereby
C transferred.
C
C The information in this software is subject to change  without  notice
C and  should  not  be  construed  as  a commitment by Digital Equipment
C Corporation.
C
C Digital assumes no responsibility for the use or  reliability  of  its
C software on equipment which is not supplied by Digital.

      PROGRAM SVCRCV

C Storage declarations
C
      EXTERNAL IDLE, X25AIC, X25RCD, X25RPS, X25TPA, X25WIC
      INTEGER CSTATE, NSTATE, PORT, RESULT, IBYTE, CAUSE, DIAGNO
      LOGICAL IAVAIL
      DIMENSION WORKSP(172)

C Declare self to be available to receive an incoming call
C
      CSTATE = 0
      CALL X25WIC ('SRV:.EXAMPLE', WORKSP, PORT, RESULT)
      IF (RESULT .NE. 0) CALL ABORT (PORT, RESULT, CSTATE)

C Check port state and wait for port state to become CALLED, then
C proceed and accept the incoming call
C
      CSTATE = 3
      NSTATE = ISTAT (PORT, CSTATE)
      IF (NSTATE .NE. 4) CALL ABORT (PORT, RESULT, NSTATE)

C Accept incoming call unconditionally
C
      CSTATE = 4
      CALL X25AIC (PORT, 0, 0, 0, 0, 0, RESULT)
      IF (RESULT .NE. 0) CALL ABORT (PORT, RESULT, CSTATE)
      CSTATE = 5

C Check only interrupt available flag, ignore other indicators
C
100   CALL X25RPS (PORT, 0, 0, 0, 0, 0, IAVAIL, 0, RESULT)

C Check if we have detected the interrupt byte
C
      IF (RESULT .NE. 0) CALL ABORT (PORT, RESULT, CSTATE)
      IF (IAVAIL .EQ. .TRUE.) GOTO 110

C Idle process for 1 second before checking the circuit status again
C
      CALL IDLE (1)
      GOTO 100

C Read interrupt message
C
110   CALL X25RIM (PORT, IBYTE, RESULT)
      IF (RESULT .NE. 0) CALL ABORT (PORT, RESULT, CSTATE)

C Display the received interrupt byte in octal
C
      WRITE (5,1100) IBYTE
1100  FORMAT (/,' Received interrupt byte "',O3,/)

C Read data and perform conversion for display
C
      CALL RCVCON (PORT)

C Confirm interrupt that we received to confirm end of data reception
C
      CALL X25CIM (PORT, RESULT)
      IF (RESULT .NE. 0) CALL ABORT (PORT, RESULT, CSTATE)

C Wait until port is cleared. If port state becomes anything else,
C go ahead and terminate port access anyway.
C
      NSTATE = ISTAT (PORT, CSTATE)
      IF (NSTATE .NE. 9) GOTO 200

C Read clear cause and diagnostic, ignore the data and facilities
C
      CALL X25RCD (PORT, CAUSE, DIAGNO, 0, 0, 0, 0, RESULT)
      WRITE (5,1110) CAUSE, DIAGNO
1110  FORMAT (' Port is cleared, cause "',O3,', diagnostic "',O3)

C Terminate port access and program
C
200   CALL X25TPA (PORT, RESULT)

      STOP
      END
      SUBROUTINE RCVCON (PORT)

C+
C DESCRIPTION   Read and display received data.
C
C PARAMETERS    PORT    Port number
C-

      EXTERNAL X25RDM

      INTEGER PORT, QBIT, CNVRSN, RESULT, LENGTH, REMLEN
      LOGICAL MBIT

      INTEGER BUFFER(512)
      INTEGER IBUF(512)
      REAL XBUF(512)
      EQUIVALENCE (XBUF(1), BUFFER(1)), (IBUF(1), BUFFER(1))

C Wait for protocol data byte
C
100   CALL WTDATA (PORT)

C Set length of the receiving buffer and read protocol byte
C
      LENGTH = 512
      CALL X25RDM (PORT, 4, BUFFER, LENGTH, QBIT, MBIT, RESULT)
      IF (RESULT .NE. 0) CALL ABORT (PORT, RESULT, 5)

C Ignore null string
C
      IF (LENGTH .LE. 0) GOTO 100

C Check if this is the end of data reception
C
      IF (BUFFER(1) .EQ. "32) RETURN

C Record the data conversion code
C
      CNVRSN = BUFFER(1)

C Initialize buffer length
C
      REMLEN = 512

C Wait for actual data buffer
C
150   CALL WTDATA (PORT)

C Calculate the starting address of the receiving buffer
C
      I = 512 - REMLEN + 1
      LENGTH = REMLEN

C Read data record
C
      CALL X25RDM (PORT, CNVRSN, BUFFER(I), LENGTH, QBIT, MBIT, RESULT)
      IF (RESULT .NE. 0) CALL ABORT (PORT, RESULT, 5)
      IF (LENGTH .LE. 0) GOTO 100

C Dispatch processing code
C
      GOTO (200,200,200,200,200,500,500,500,500,500) (CNVRSN+1)

C Calculate the remaining length of the receiving buffer
C
200   REMLEN = REMLEN - LENGTH

C If there are more data to read, go back and continue reading using
C the same conversion format, otherwise display received data at the
C controlling terminal
C
      IF (MBIT .EQ. .TRUE.) GOTO 150
      LENGTH = 512 - REMLEN
      GOTO (210,220,220,220,220) (CNVRSN + 1)

C Binary data: 36 bits
C
210   DO 212 I = 1,LENGTH,2
      WRITE (5,2100) XBUF(I), XBUF(I+1)
2100  FORMAT (' ',F10.6,' ',F10.6)
212   CONTINUE
      GOTO 100

C Binary data: high 32 bits, low 32 bits, low 16 bits and low 8 bits
C
220   DO 222 I = 1,LENGTH
      WRITE (5,2200) IBUF(I)
2200  FORMAT (I10)
222   CONTINUE
      GOTO 100

C Calculate the remaining length of the receiving buffer
C
500   ITEMP1 = CNVRSN - 5 + 1
      ITEMP2 = MOD (LENGTH, ITEMP1)
      REMLEN = REMLEN - ((LENGTH / ITEMP1) + ITEMP2)

C If there are more data to read, go back and continue reading using
C the same conversion format, otherwise display received data at the
C controlling terminal
C
      IF (MBIT .EQ. .TRUE.) GOTO 150
      LENGTH = 512 - REMLEN
      GOTO (510,520,530,540,550) ITEMP1

C ASCII data in A1 format
C
510   WRITE (5,5100) (IBUF(I),I=1,LENGTH)
5100  FORMAT (1H ,512A1,$)
      GOTO 100

C ASCII data in A2 format
C
520   WRITE (5,5200) (IBUF(I),I=1,LENGTH)
5200  FORMAT (1H ,512A2,$)
      GOTO 100

C ASCII data in A3 format
C
530   WRITE (5,5300) (IBUF(I),I=1,LENGTH)
5300  FORMAT (1H ,512A3,$)
      GOTO 100

C ASCII data in A4 format
C
540   WRITE (5,5400) (IBUF(I),I=1,LENGTH)
5400  FORMAT (1H ,512A4,$)
      GOTO 100

C ASCII data in A5 format
C
550   WRITE (5,5500) (IBUF(I),I=1,LENGTH)
5500  FORMAT (1H ,512A5,$)
      GOTO 100
      END
      SUBROUTINE WTDATA (PORT)

C+
C DESCRIPTION   Read port status and wait for incoming data indication
C
C PARAMETERS    PORT    Port number
C-

      EXTERNAL IDLE, X25RPS

      INTEGER PORT, RESULT
      LOGICAL DAVAIL

C Check only data available flag, ignore other indicators
C
100   CALL X25RPS (PORT, 0, 0, 0, 0, DAVAIL, 0, 0, RESULT)

C Check if we have detected the incoming data
C
      IF (RESULT .NE. 0) CALL ABORT (PORT, RESULT, 5)
      IF (DAVAIL .EQ. .TRUE.) RETURN

C Idle process for 1 second before checking the circuit status again
C
      CALL IDLE (1)
      GOTO 100
      END
      SUBROUTINE ABORT (PORT, CODE, STATE)

C+
C DESCRIPTION	Terminate communication and abort the process.
C
C PARAMETERS	PORT	Port number.
C		CODE	Error code.
C		STATE	Current port state.
C
C-

      EXTERNAL X25TPA
      INTEGER PORT, CODE, STATE

      WRITE (5,1000) CODE, STATE
1000  FORMAT (/,' * ERROR #',I2,', current port state ',I2,' *',/)

      CALL X25TPA (PORT, 0)

      STOP
      END
      INTEGER FUNCTION ISTAT (PORT, STATE)

C+
C DESCRIPTION   Read port status.
C
C PARAMETERS    PORT    Port number.
C               STATE   Current port state.
C
C RETURN        New port state when it is changed; or ERROR port state 
C               if failed to read port status.
C-

      EXTERNAL X25RPS, IDLE
      INTEGER PORT, STATE, PSTATE, RESULT

C Check only port state, ignore other indicators
C
100   CALL X25RPS (PORT, 0, PSTATE, 0, 0, 0, 0, 0, RESULT)

C If failed to read port status, return port state ERROR
C
      IF (RESULT .EQ. 0) GOTO 200
      ISTAT = 10
      RETURN

C If the port state has changed, return the new port state
C
200   IF (PSTATE .NE. STATE) GOTO 300

C Otherwise, idle the process for 5 seconds before checking
C the port state again
C
      CALL IDLE (5)
      GOTO 100

C Return new port state
C
300   ISTAT = PSTATE
      RETURN
      END