Trailing-Edge
-
PDP-10 Archives
-
BB-W661A-BM_1983
-
tools/svcxmi.for
There is 1 other file named svcxmi.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 SVCXMI
C Storage declarations
C
EXTERNAL IDLE, X25CSC, X25ISC, X25SDM, X25SIM, X25TPA
INTEGER CSTATE, NSTATE, PORT, RESULT, IBYTE, LENGTH
INTEGER DTE(4), BUFFER(256), IBUF(256), FILBUF(2)
REAL NUMBER, XBUF(256)
DOUBLE PRECISION FILNAM
EQUIVALENCE (FILBUF(1), FILNAM)
EQUIVALENCE (IBUF(1), BUFFER(1)), (XBUF(1), BUFFER(1))
DIMENSION WORKSP(172)
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
CSTATE = 0
CALL X25ISC (8HTELENET , 'X25-GATE ', DTE,
$ 0, 0, 0, 0, 0, 0, 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
NSTATE = ISTAT (PORT, CSTATE)
IF (NSTATE .NE. 5) CALL ABORT (PORT, 0, NSTATE)
C Send an interrupt to indicate start of transmission. The remote end
C will confirm this interrupt after it receives all data successfully
C
200 CSTATE = 5
WRITE (5,2000)
2000 FORMAT (' Interrupt byte (octal): ',$)
READ (5,2010) IBYTE
2010 FORMAT (O3)
CALL X25SIM (PORT, IBYTE, RESULT)
IF (RESULT .NE. 0) CALL ABORT (PORT, RESULT, CSTATE)
C Send protocol byte to SVCRCV to indicate data conversion mode
C
CALL X25SDM (PORT, 4, 5, 1, 0, .FALSE., RESULT)
IF (RESULT .NE. 0) CALL ABORT (PORT, RESULT, CSTATE)
C Read input data from terminal using A1 format descriptor
C
300 WRITE (5,3000)
3000 FORMAT (' Text string: ',$)
READ (5,3010,ERR=300) LENGTH, (BUFFER(I),I=1,256)
3010 FORMAT (Q,256A1)
C Do not attempt to send null string
C
IF (LENGTH .LE. 0) GOTO 300
C Send the text string in A1 format to SVCRCV.
C
CALL X25SDM (PORT, 5, BUFFER, LENGTH, 0, .FALSE., RESULT)
IF (RESULT .NE. 0) CALL ABORT (PORT, RESULT, CSTATE)
C Read file name
C
400 WRITE (5,4000)
4000 FORMAT (' File name: ',$)
READ (5,4010) (FILBUF(I),I=1,2)
4010 FORMAT (2A5)
C Open input file
C
OPEN (UNIT=1,DEVICE='DSK',FILE=FILNAM,ACCESS='SEQIN',ERR=440)
C Send protocol byte to SVCRCV to indicate data conversion mode
C
CALL X25SDM (PORT, 4, 9, 1, 0, .FALSE., RESULT)
IF (RESULT .NE. 0) GOTO 440
C Send the first 20 lines of the file to SVCRCV.
C
DO 420 M = 1,20
READ (1,4020,END=430,ERR=430) LENGTH, (BUFFER(I),I=1,256)
4020 FORMAT (Q,256A5)
IF (LENGTH .LE. 0) GOTO 410
CALL X25SDM (PORT, 9, BUFFER, LENGTH, 0, .TRUE., RESULT)
IF (RESULT .NE. 0) GOTO 440
C Follow each line with apair of <CR><LF> in the rightmost 16 bits
C
410 CALL X25SDM (PORT, 3, "6412, 1, 0, .TRUE., RESULT)
IF (RESULT .NE. 0) GOTO 440
420 CONTINUE
C Flush the buffered data to SVCRCV by calling X25SDM with 0 length
C
430 CALL X25SDM (PORT, 9, BUFFER, 0, 0, .FALSE., RESULT)
C Close input file
C
440 CLOSE (UNIT=1)
IF (RESULT .NE. 0) CALL ABORT (PORT, RESULT, CSTATE)
C Initialize first 2 Fibonacci numbers
C
IBUF(1) = 0
IBUF(2) = 1
C Calculate the next 23 Fibonacci numbers
C
DO 500 I = 3,25
IBUF(I) = IBUF(I-1) + IBUF(I-2)
500 CONTINUE
C Send the sequence to the receiving program
C
CALL X25SDM (PORT, 4, 9, 1, 0, .FALSE., RESULT)
IF (RESULT .NE. 0) CALL ABORT (PORT, RESULT, CSTATE)
CALL X25SDM (PORT, 9, 'The first 25 Fibonacci numbers', 30,
$ 0, .FALSE., RESULT)
IF (RESULT .NE. 0) CALL ABORT (PORT, RESULT, CSTATE)
C Send protocol byte to SVCRCV to indicate data conversion mode
C
CALL X25SDM (PORT, 4, 3, 1, 0, .FALSE., RESULT)
C Send 10 copies of the set of Fibonacci numbers
C
DO 510 I = 1,10
CALL X25SDM (PORT, 3, IBUF, 25, 0, .TRUE., RESULT)
IF (RESULT .NE. 0) CALL ABORT (PORT, RESULT, CSTATE)
510 CONTINUE
C Flush the buffered data to SVCRCV by calling X25SDM with 0 length
C
CALL X25SDM (PORT, 3, IBUF, 0, 0, .FALSE., RESULT)
IF (RESULT .NE. 0) CALL ABORT (PORT, RESULT, CSTATE)
C Calculate the first 128 square roots
C
NUMBER = 1.0
DO 600 I = 1,256,2
XBUF(I) = NUMBER
XBUF(I+1) = SQRT (NUMBER)
NUMBER = NUMBER + 1.0
600 CONTINUE
C Send the identification string
C
CALL X25SDM (PORT, 4, 9, 1, 0, .FALSE., RESULT)
IF (RESULT .NE. 0) CALL ABORT (PORT, RESULT, CSTATE)
CALL X25SDM (PORT, 9, 30HNumbers and their Square Roots, 30,
$ 0, .FALSE., RESULT)
IF (RESULT .NE. 0) CALL ABORT (PORT, RESULT, CSTATE)
C Send data array
C
CALL X25SDM (PORT, 4, 0, 1, 0, .FALSE., RESULT)
IF (RESULT .NE. 0) CALL ABORT (PORT, RESULT, CSTATE)
CALL X25SDM (PORT, 0, XBUF, 256, 0, .FALSE., RESULT)
IF (RESULT .NE. 0) CALL ABORT (PORT, RESULT, CSTATE)
C Send control-Z to indicate end of data transmission
C
CALL X25SDM (PORT, 4, "32, 1, 0, .FALSE., RESULT)
IF (RESULT .NE. 0) CALL ABORT (PORT, RESULT, CSTATE)
C Wait for confirmation of the interrupt we sent at the beginning
C
CALL WTCFRM (PORT, 300)
C Clear virtual circuit and close port
C
CALL X25CSC (PORT, "252, 0, 0, 0, 0, 0, RESULT)
IF (RESULT .NE. 0) CALL ABORT (PORT, RESULT, CSTATE)
CSTATE = 8
C Wait until clear request is confirmed
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
SUBROUTINE WTCFRM (PORT, WAIT)
C+
C DESCRIPTION Wait for interrupt confirmation within certain period.
C After that, return, so we do not wait forever.
C
C PARAMETERS PORT Port number
C WAIT Amount of time in seconds to wait before return.
C-
EXTERNAL X25RPS, IDLE
INTEGER PORT, WAIT, RESULT
LOGICAL PENDNG
C Read port status
C
DO 100 I = 1,WAIT
CALL X25RPS (PORT, 0, 0, 0, PENDNG, 0, 0, 0, RESULT)
C Check if the transmitted interrupt has been confirmed - if so, return
C
IF (RESULT .NE. 0) CALL ABORT (PORT, RESULT, 5)
IF (PENDNG .EQ. .FALSE.) RETURN
C Idle process for 1 second before checking the circuit status again
C
CALL IDLE (1)
100 CONTINUE
RETURN
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