SUBROUTINE PACK (ALIN,BLIN) 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: Pack the INTEGER array ALIN into the array BLIN C with the right side of the byte ending with a C BLANK, in case there are an odd number of 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 R ALIN - Array to be packed C W BLIN - Packed array to be returned to the user C C **************************************************************** C C Messages generated by this module : None C C **************************************************************** C C Subroutines called directly : IAND, IOR, ISHFT C C **************************************************************** C C Files referenced : None C C **************************************************************** C C Local variable definitions : C C ACOUNT - Index pointer into ALIN C BCOUNT - Index pointer into BLIN C LEFT - Symbolic constant for LEFT byte C RIGHT - Symbolic constant for RIGHT byte C WHICHS - Indicator for left/right side to be processed C C **************************************************************** C C Commons referenced : KERPAR local common 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), BLIN(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/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 DATA LEFT /0/, RIGHT /1/ C C **************************************************************** C C Code starts here : C WHICHS = LEFT ACOUNT = 1 BCOUNT = 1 C BLIN(1) = 4Z2020 IF (ALIN(ACOUNT) .EQ. LF) GO TO 40 C C-----> Pack the output line, until LF char is reached. C 10 CONTINUE IF (WHICHS .NE. LEFT) GO TO 20 BLIN(BCOUNT) = IOR (ISHFT (ALIN(ACOUNT),8),4Z0020) WHICHS = RIGHT GO TO 30 20 CONTINUE BLIN(BCOUNT) = IOR (IAND (BLIN(BCOUNT),4ZFF00),ALIN(ACOUNT)) BCOUNT = BCOUNT + 1 WHICHS = LEFT 30 CONTINUE ACOUNT = ACOUNT + 1 IF (ALIN(ACOUNT) .NE. LF) GO TO 10 40 CONTINUE RETURN END