Google
 

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