home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
kermit.columbia.edu
/
kermit.columbia.edu.tar
/
kermit.columbia.edu
/
modcomp
/
rpack.
< prev
next >
Wrap
Text File
|
1987-01-25
|
7KB
|
207 lines
INTEGER FUNCTION RPACK (LEN,NUM,XDATA)
C
C ****************************************************************
C
C KERMIT for the MODCOMP MAXIV operating system
C
C Compliments of:
C
C SETPOINT, Inc.
C 10245 Brecksville Rd.
C Brecksville, Ohio 44141
C
C
C KERMIT is a copyrighted protocol of Columbia Univ. The authors
C of this version hereby grant permission to copy this software
C provided that it is not used for an explicitly commercial
C purpose and that proper credit be given. SETPOINT, Inc. makes
C no warranty whatsoever regarding the accuracy of this package
C and will assume no liability resulting from it's use.
C
C ****************************************************************
C
C Abstract: Read a packet from the other Kermit.
C
C MODIFICATION HISTORY
C
C BY DATE REASON PROGRAMS AFFECTED
C
C
C ****************************************************************
C
C Author: BOB BORGESON Version: A.0 Date: Oct-86
C
C Calling Parameters:
C
C W LEN - LENGTH OF PACKET
C W NUM - PACKET SEQUENCE NUMBER
C W XDATA - THE PACKET
C
C ****************************************************************
C
C Messages generated by this module : None
C
C ****************************************************************
C
C Subroutines called directly : GETLIN, UNCHAR
C
C ****************************************************************
C
C Files referenced : None
C
C ****************************************************************
C
C Local variable definitions :
C
C CHKSUM - CALCULATED VALUE OF CHECKSUM
C GAPTRY - # OF TIMES WE'VE LOOKED FOR PACKET STARTING WIT SOH
C MGAPTRY - MAXIMUM ALLOWED VALUE OF GAPTRY
C XTYPE - CODE FOR TYPE OF PACKET
C
C ****************************************************************
C
C Commons referenced : KER, KERPAR
C
C ****************************************************************
C
C (*$END.DOCUMENT*)
C
C ****************************************************************
C * *
C * D I M E N S I O N S T A T E M E N T S *
C * *
C ****************************************************************
C
IMPLICIT INTEGER (A-Z)
INTEGER*2 XDATA(1), BUFFER(132)
C
C ****************************************************************
C * *
C * T Y P E S T A T E M E N T S *
C * *
C ****************************************************************
C
C
C ****************************************************************
C * *
C * C O M M O N S T A T E M E N T S *
C * *
C ****************************************************************
C
INCLUDE USL/KERCOM
INCLUDE USL/KERPMC
C
C ****************************************************************
C * *
C * E Q U I V A L E N C E S T A T E M E N T S *
C * *
C ****************************************************************
C
C
C ****************************************************************
C * *
C * D A T A S T A T E M E N T S *
C * *
C ****************************************************************
C
C
C ****************************************************************
C
C Code starts here :
C
C !THIS IS THE INPUT CHANNEL TO READ
C !A PACKET FROM
CH=4
GAPTRY=1
MGAPTRY=2
CHKSUM=0
C
C READ ME A PACKET THAT BEGINS WITH A SOH AND ENDS WITH MYEOL
C
100 CONTINUE
C
IF(GAPTRY.GT.MGAPTRY)GO TO 9000
C !GET A PACKET WITHOUT WAITING
C !FOR A PROMPT
IF(IBMON .NE. YES)STATUS=GETLIN(BUFFER,CH)
C
C IF TIMEOUT, LOOP
C
IF(STATUS .EQ. BAD)GO TO 1000
C
COUNT=1
C
C SKIPS ALL OTHER CHARACTERS UNTIL WE SEE ONE WITH A SOH IN IT
C
200 CONTINUE
C
IF((BUFFER(COUNT).EQ.SOH).OR.(BUFFER(COUNT).EQ.EOS))GO TO 300
C !WAIT FOR A SOH OR EOS
COUNT=COUNT+1
GO TO 200
300 CONTINUE
C !WE GOT THE SOH
IF(BUFFER(COUNT).NE.SOH)GO TO 1000
C
C WE GOT A LINE THAT BEGINS WITH A SOH
C
K=COUNT+1
CHKSUM=BUFFER(K)
C !GET THE LENGTH OF THE PACKET
LEN=UNCHAR(BUFFER(K))-3
K=K+1
CHKSUM=CHKSUM+BUFFER(K)
C !GET THE SEQUENCE NUMBER OF
C !THE FRAME PACKET
NUM=UNCHAR(BUFFER(K))
K=K+1
C !GET THE DATA TYPE
XTYPE=BUFFER(K)
CHKSUM=CHKSUM+BUFFER(K)
K=K+1
C
C GET THE DATA
C
C ZERO OUT THE XDATA ARRAY
DO 400 I=1,132
XDATA(I)=0
400 CONTINUE
IF (LEN .LT. 1) GO TO 510
DO 500 J=1,LEN
XDATA(J)=BUFFER(K)
CHKSUM=CHKSUM+BUFFER(K)
K=K+1
COUNT=J
500 CONTINUE
510 CONTINUE
C
XDATA(COUNT+1)=EOS
T=BUFFER(K)
C
C CALCULATE THE CHECKSUM OF THE INCOMING PACKET
C
TV1=IAND(CHKSUM,192)
TV2=TV1/64
TV3=CHKSUM+TV2
CHKSUM=IAND(TV3,63)
C
C DOES THE CHECKSUM MATCH?
C
IF(CHKSUM.EQ.UNCHAR(T))GO TO 600
C !BAD CHECKSUM
RPACK=BAD
RETURN
600 CONTINUE
RPACK=XTYPE
RETURN
1000 CONTINUE
C
C WE GOT THE EOS, THE PACKET HAS NO SOH, READ ANOTHER ONE
C
GAPTRY=GAPTRY+1
GO TO 100
9000 CONTINUE
RPACK=BAD
RETURN
END