Google
 

Trailing-Edge - PDP-10 Archives - BB-W661A-BM_1983 - tools/psisnd.for
There is 1 other file named psisnd.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
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 PSISND

C Storage declarations
C
      EXTERNAL IDLE, X25CSC, X25ISC, X25SDM, X25SIM, X25TPA
      INTEGER CSTATE, NSTATE, PORT, RESULT, LENGTH, INDX
      INTEGER WORKSP(172), BUFFER(256), DTE(4), FILBUF(4)
      DOUBLE PRECISION SOURCE, DESTIN
      EQUIVALENCE (FILBUF(1), SOURCE), (FILBUF(3), DESTIN)
      LOGICAL MBIT

C Prompt for remote DTE address
C
100   WRITE (5,1000)
1000  FORMAT (' DTE address: ',$)
      READ (5,1010) LENGTH, (DTE(I),I=1,4)
1010  FORMAT (Q,4A5)
      IF (LENGTH .LE. 0) GOTO 100

C Initiate the virtual circuit to the network
C
110   CSTATE = 0
      BUFFER(1) = "34000000000
      CALL X25ISC (8HTELENET , 0, DTE,
     $             0, 0, 0, 0, BUFFER, 1, WORKSP, PORT, RESULT)
      IF (RESULT .NE. 0) CALL ABORT (PORT, RESULT, CSTATE)
      CSTATE = 2

C Check port state and wait for port state to become RUNNING
C
      WRITE (5,1120)
1120  FORMAT (' Calling ...',$)
      NSTATE = ISTAT (PORT, CSTATE)
      IF (NSTATE .EQ. 5) GOTO 200
      WRITE (5,1130) NSTATE
1130  FORMAT ('  Failed, state is ',I1)
      CALL X25TPA (PORT)
      GOTO 110

200   WRITE (5,2000) 7
2000  FORMAT (1X,R1,' Running')
      CSTATE = 5

C Read file names
C
400   WRITE (5,4000)
4000  FORMAT (/,' From file: ',$)
      READ (5,4010) LENGTH, (FILBUF(I),I=1,2)
4010  FORMAT (Q,2A5)
      IF (LENGTH .LE. 0) GOTO 600
410   WRITE (5,4110)
4110  FORMAT (' To file:   ',$)
      READ (5,4120) LENGTH, (FILBUF(I),I=3,4)
4120  FORMAT (Q,2A5)
      IF (LENGTH .LE. 0) GOTO 410

C Open input file
C
      OPEN (UNIT=1,DEVICE='DSK',FILE=SOURCE,MODE='IMAGE',ERR=400)

C Send output file name
C
      CALL X25SDM (PORT, 9, FILBUF(3), LENGTH, 1, .FALSE., RESULT)
      IF (RESULT .NE. 0) GOTO 550

      INDX = 1
      LENGTH = 0
500   DO 510 I = INDX,256
      READ (1,END=520) BUFFER(I)
      LENGTH = LENGTH + 1
510   CONTINUE
      CALL X25SDM (PORT, 0, BUFFER, LENGTH-1, 0, .TRUE., RESULT)
      IF (RESULT .NE. 0) GOTO 550
      BUFFER(1) = BUFFER(LENGTH)
      INDX = 2
      LENGTH = 1
      GOTO 500
520   CALL X25SDM (PORT, 0, BUFFER, LENGTH, 0, .FALSE., RESULT)

C Close input file
C
550   CLOSE (UNIT=1)
      IF (RESULT .NE. 0) CALL ABORT (PORT, RESULT, CSTATE)
      GOTO 400

C Indicate end of data transmission
C
600   BUFFER(1) = 0
      CALL X25SDM (PORT, 9, BUFFER, 5, 1, .FALSE., RESULT)
      IF (RESULT .NE. 0) CALL ABORT (PORT, RESULT, CSTATE)

C Wait until the circuit goes away
C
      CSTATE = ISTAT (PORT, CSTATE)

C Terminate port access
C
      CALL X25TPA (PORT, RESULT)

      STOP
      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: