Trailing-Edge
-
PDP-10 Archives
-
BB-W661B-BM_1984
-
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: