home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
kermit.columbia.edu
/
kermit.columbia.edu.tar
/
kermit.columbia.edu
/
modcomp
/
getlin.
< prev
next >
Wrap
Text File
|
1987-01-25
|
8KB
|
279 lines
INTEGER FUNCTION GETLIN (ALIN,CH)
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 line from the specified UFT and unpack the
C bytes.
C
C MODIFICATION HISTORY
C
C BY DATE REASON PROGRAMS AFFECTED
C
C ****************************************************************
C
C Author: Rick Burke Version: A.0 Date: Aug-86
C
C Calling Parameters:
C
C W ALIN - Line of input data to return to caller
C Each word contains 1 byte of data, right
C justified in the word.
C R CH - UFT number to use for the read;
C 2 = user's terminal
C
C ****************************************************************
C
C Messages generated by this module : None
C
C ****************************************************************
C
C Subroutines called directly : IAND, ISHFT, READ4, WAIT
C
C ****************************************************************
C
C Files referenced : None
C
C ****************************************************************
C
C Local variable definitions :
C
C ACOUNT - Index counter for ALIN array.
C BCOUNT - Index counter for BLIN array.
C I - Index variable
C LEFT - Flag to indicate that the left byte should be
C processed
C MAXTRY - # OF TIMES TO WAIT BEFORE TIMEOUT
C MLEFT - Mask to extract the left byte of a word
C MRIGHT - Mask to extract the right byte of a word
C NSCH - UFT # FOR BINARY READ
C RIGHT - Flag to indicate that the right byte should be
C processed
C TRYTIM - MAGNITUDE OF WAIT
C TRYUNT - TIME UNIT FOR WAIT (SECONDS,TICKS, ETC)
C TV1 - Temporary variable
C TV2 - Temporary variable
C WHICHS - Flag for which byte to extract
C BLIN(132) - Input line read from I/O device which is to
C be unpacked
C LEOL - OUR EOL CHAR SHIFTED TO MSB
C UEOL - BIT MASK CHOSEN TO SEARCH FOR EOL
C OLDCHN - STORAGE FOR OLD READ #
C IPNT - POINTER TO WORD WHERE WE EXPECT EOL
C NTFLO - # OF CHAR TO FOLLOW (SECOND BYTE OF PACKET)
C TIMED - FLAG FOR READ HAS TIMED OUT (IF = 1)
C
C ****************************************************************
C
C Commons referenced : KERPAR and UFTTBL local commons
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 ALIN(1)
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
C
INCLUDE USL/KERPMC
C
INCLUDE USL/UFTTBC
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
DATA MLEFT /ZFF00/, MRIGHT /Z00FF/
> , TRYTIM / 200 /
> , TRYUNT/ 1 / , NSCH / 10 /
C
C ****************************************************************
C
C Code starts here :
C
C-----> Initialize the line buffers.
C
DO 10 I=1,132
ALIN(I) = 0
10 CONTINUE
C
C-----> Initialize some local variables.
C
LEFT = 1
RIGHT = 2
WHICHS = LEFT
ACOUNT = 1
BCOUNT = 1
LEOL = ISHFT(EOL,8)
TIMED = 0
C
C----> ALL INPUT IS ON UFT 4
C
UFT = 4
C
C-----> Get the input line and check for an EOF event.
C
DO 1000 I = 1,20
C
C-----> IF NO CHARACTERS HAVE BEEN READ , LOOP
C
IF(IAND(IUFT(1,UFT),8) .NE. 0)GO TO 950
C
C-----> GET # OF CHARACTERS TO FOLLOW IN PACKET + EOL
C
NTFLO = UNCHAR(IAND(BLIN(1,CURCHN),MRIGHT)) + 1
IF(NTFLO .EQ. -31)GO TO 950
C
C-----> CHOOSE BITMASK TO LOOK FOR EOL
C
UEOL = LEOL
IF(MOD(NTFLO,2).EQ.0)UEOL = EOL
C
C-----> CALCULATE WHICH WORD EOL SHOULD BE IN
C
IPNT = (NTFLO + 1) / 2 + 1
C
IF(IAND(BLIN(IPNT,CURCHN),UEOL) .EQ. UEOL)GO TO 15
C
C-----> PACKET IS NOT THERE (OR NOT COMPLETE) SO WAIT
C
950 CONTINUE
C
CALL WAIT(TRYTIM,TRYUNT,IND)
C
1000 CONTINUE
C
C-----> WE HAVE TIMED OUT
C
GETLIN = BAD
TIMED = 1
GO TO 1800
C
15 CONTINUE
C
C-----> GOT A PACKET !!!
C
C
C IF (IAND (IUFT(1,UFT),4Z0020) .NE. 0) GO TO 100
C
C-----> START NEW READ, TERMINATE OLD, AND UNPACK
C
C
1800 CONTINUE
C
IF(CURCHN .NE. 1)GO TO 2000
C
DO 1900 I = 132
C
BLIN(I,2) = 0
C
1900 CONTINUE
C
CALL TERMIN (IUFT(1,UFT),.FALSE.)
CALL READ4(IUFT(1,UFT),BLIN(1,2),132,.FALSE.)
OLDCHN = CURCHN
CURCHN = 2
IF(TIMED .EQ. 1)RETURN
GO TO 20
C
2000 CONTINUE
C
DO 2100 I = 1,132
C
BLIN(I,1) = 0
C
2100 CONTINUE
CALL TERMIN (IUFT(1,UFT),.FALSE.)
CALL READ4(IUFT(1,UFT),BLIN(1,1),132,.FALSE.)
OLDCHN = CURCHN
CURCHN = 1
IF(TIMED .EQ. 1)RETURN
C
C-----> Unpack the input line.
C
20 CONTINUE
IF (WHICHS .NE. RIGHT) GO TO 40
C
C-----> Move a char in the right byte of BLIN to a word in ALIN,
C-----> unless we are finished processing the input line.
C
TV1 = IAND (BLIN(BCOUNT,OLDCHN),MRIGHT)
IF (TV1 .NE. 0) GO TO 30
ALIN(ACOUNT) = LF
ALIN(ACOUNT+1) = EOS
GETLIN = OK
RETURN
30 CONTINUE
ALIN(ACOUNT) = TV1
ACOUNT = ACOUNT + 1
BCOUNT = BCOUNT + 1
WHICHS = LEFT
40 CONTINUE
C
C-----> Move a char in the left byte of BLIN to a word in ALIN,
C-----> unless we are finished processing the input line.
C
TV1 = IAND (BLIN(BCOUNT,OLDCHN),MLEFT)
TV2 = ISHFT (TV1,-8)
IF (TV2 .NE. 0) GO TO 50
ALIN(ACOUNT) = LF
ALIN(ACOUNT+1) = EOS
GETLIN = OK
RETURN
50 CONTINUE
ALIN(ACOUNT) = TV2
WHICHS = RIGHT
ACOUNT = ACOUNT + 1
60 CONTINUE
GO TO 20
100 CONTINUE
GETLIN = EOF
RETURN
END