Google
 

Trailing-Edge - PDP-10 Archives - BB-W661A-BM_1983 - tools/psircv.for
There is 1 other file named psircv.for in the archive. Click here to see a list.
C Copyright (c) 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.

C++
C FACILITY:
C	
C       TOPS-20 PSI Version 1.0
C
C ABSTRACT:
C
C       This program is one of a pair of programs which transfer files
C       from one TOPS-20 to another over a Public Packet Switching Network,
C       using switched virtual circuit.
C
C       The "slave" PSIRCV receives files from the "master" program PSISND
C       and write them to the destination directories.
C
C ENVIRONMENT:
C
C       X.25 Gateway Access FORTRAN Interface, User mode.
C
C AUTHOR:
C
C	Son VoBa,	DATE: 27-Jan-1983
C--

      PROGRAM PSIRCV

C Storage declarations
C
      EXTERNAL IDLE, X25AIC, X25RCD, X25RDM, X25RPS, X25TPA, X25WIC
      INTEGER CSTATE, NSTATE, PORT, QBIT, RESULT, LENGTH, FILESZ
      INTEGER WORKSP(172), BUFFER(256), FILBUF(2)
      DOUBLE PRECISION FILNAM
      EQUIVALENCE (FILBUF(1), FILNAM)
      LOGICAL MBIT

C Declare self to be available to receive an incoming call
C
100   CSTATE = 0
      CALL X25WIC ('SRV:.PSINFT', 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 Wait for protocol packet
C
150   CALL WTDATA (PORT)

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

C Ignore null string and non-control packets
C
      IF (LENGTH .LE. 0) GOTO 150
      IF (QBIT .NE. 1) GOTO 150

C Check if this is the end of data reception
C
      IF (BUFFER(1) .EQ. 0) GOTO 300

C Got the file name
C
      FILESZ = 0
      FILBUF(1) = BUFFER(1)
      FILBUF(2) = BUFFER(2)
      OPEN (UNIT=1,DEVICE='DSK',FILE=FILNAM,MODE='IMAGE',ERR=300)

C Read data from the network
C
200   CALL WTDATA (PORT)
210   LENGTH = 256
      CALL X25RDM (PORT, 0, BUFFER, LENGTH, QBIT, MBIT, RESULT)
      IF (RESULT .EQ. 3) GOTO 300
      IF (RESULT .NE. 0) GOTO 200
      FILESZ = FILESZ + LENGTH
      DO 220 I = 1,LENGTH
      WRITE (1) BUFFER(I)
220   CONTINUE
      IF (MBIT .EQ. .TRUE.) GOTO 210

      WRITE (5,2100) FILESZ, (FILBUF(I),I=1,2)
2100  FORMAT (' Received ',I5,' words of file ',2A5)
      CLOSE (UNIT=1)
      GOTO 150

C Terminate virtual circuit and wait for the next one
C
300   CALL X25TPA (PORT)
      GOTO 100

      STOP
      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, PSTATE
      LOGICAL DAVAIL

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

C Check if we have detected the incoming data
C
      IF (RESULT .NE. 0 .OR. PSTATE .NE. 5) 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
C Local Modes:
C Mode:FORTRAN
C Auto Save Mode:2
C End: