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