IDENT EXTRACT ENTRY EXTRACT ENTRY INSERT SYSCOM B1 *COMMENT EXTRACT/INSERT - BIT MANIPULATION ROUTINE. COMMENT COPYRIGHT CONTROL DATA SYSTEMS INC. 1992. TITLE EXTRACT/INSERT - BIT MANIPULATION ROUTINE. SPACE 4 ***** EXTRACT/INSERT - BIT MANIPULATION ROUTINE. * * W. E. MARTIN. 78/10/30. EXTRACT SPACE 4,45 *** EXTRACT/INSERT - BIT MANIPULATION ROUTINE. * * EXTRACT/INSERT SUPPORTS THE COBOL TASK WRITER FOR THE * SITUATIONS WHERE BIT-ORIENTED OPERATIONS SUCH AS *TARO* AND * *TSIM* MONITOR REQUESTS ARE DESIRED. THE BASIC OPERATION * PROVIDED IS TO RIGHT-JUSTIFY THE FIELD SPECIFIED IN THE * ARGUMENTS, SO THAT MORE TRADITIONAL *COBOL* ARITHMETIC CAN * BE PERFORMED. ALTHOUGH THIS ROUTINE MAY BE ENTERED FROM * *FTN*, IT-S USE IS INTENDED TO AID THE *COBOL* PROGRAMMER WHO * FINDS THAT THE *STRING/UNSTRING* FUNCTIONS DO NOT PERFORM THE * NECESSARY OPERATIONS SATISFACTORILY, OR THAT HIS DATA DOES * NOT LEND ITSELF TO COMPUTATIONAL-4 MAPPING. * * THE VALUE FIELDS OF THE PARAMETER LIST ARE CHECKED FOR * EXISTENCE AND SIZE. IF ANY ARGUMENTS ARE MISSING OR LARGER * THAN THE WORD SIZE, THEN THE TASK IS ABORTED. * * COBOL CALL - * * ENTER EXTRACT USING SOURCE, DESTINATION, LOC1, LOC2. * * FTN CALL - * * CALL EXTRACT ( SOURCE, DESTINATION, LOC1, LOC2) * * WHERE - SOURCE = SOURCE FIELD TO HAVE BITS EXTRACTED FROM. * MAY BE ANY DATA TYPE, BUT MUST BEGIN ON A WORD * BOUNDARY. * * THE REMAINING ITEMS MUST BE COMPUTATIONAL-1 * OR INTEGER. * * DESTINATION = DATA-NAME TO RETURN THE EXTRACTED * BITS. * * LOC1 = BEGINNING BIT POSITION IN THE SOURCE FIELD. * * LOC2 = LENGTH OF BIT STRING TO EXTRACT FROM SOURCE. * * USES A - 0, 1, 2, 6. * X - 0, 1, 2, 6, 7. * B - 1, 4. * * CALLS VVA. * * MACROS ARGERR. SPACE 4 * COMMON TEXTS. *CALL COMCMAC *CALL COMKMAC SPACE 4 VFD 42/0LEXTRACT,18/EXTRACT EXT2 SA1 EXTA RESTORE THE (A0) SA0 X1+ EXTRACT SUBR ENTRY/EXIT SX6 A0+ SAVE (A0) SB1 1 ZR X1,EXT1 IF NO ARGUMENTS - ABORT TASK SA6 EXTA SA2 X1+ READ SOURCE FIELD * DETERMINE VALIDITY OF ARGUMENTS. RJ VVA VERIFY VALIDITY OF ARGUMENTS NE B4,EXT1 IF ERROR IN ARGUMENTS - ABORT TASK * EXTRACT SPECIFIED FIELD. SX1 59 SB4 X5-1 ADJUSTED BIT STRING LENGTH MX7 1 AX7 B4 (X7) = MASK SB4 X4+1 SHIFT COUNT FOR MASK LX7 B4 POSITION MASK BX6 X7*X2 IX1 X1-X4 COMPUTE SHIFT COUNT IX1 X1+X5 SB4 X1 SHIFT COUNT TO RIGHT JUSTIFY LX6 B4 SA6 X3 EQ EXT2 RESTORE (A0) AND RETURN * PROCESS PARAMETER ERROR. EXT1 SA1 EXTRACT READ *RJ* ADDRESS MX0 30 LX1 30 SA1 X1-1 BX6 -X0*X6 SA6 EXTA ARGERR A6 EXIT TO EXECUTIVE EXTA CON 0 STORAGE FOR (A0) INSERT SPACE 4,35 *** INSERT - INSERT BITS INTO A WORD. * INSERT IS INTENDED TO PROVIDE A COMPANION CAPABILITY FOR * THE EXTRACT ROUTINE, BY MOVING USER-SPECIFIED BIT STRINGS * TO ARBITRARY POSITIONS WITHIN A GIVEN WORD. THIS THEN * ALLOWS THE COBOL PROGRAMMER THE ABILITY TO TEST AND SET * BITS WHICH OTHERWISE WOULD REQUIRE CUMBERSOME ARITHMETIC * OPERATIONS. * * COBOL ENTRY - * * ENTER INSERT USING SOURCE, DESTINATION, LOC3, LOC4. * * FTN ENTRY - * * CALL INSERT ( SOURCE, DESTINATION, LOC3, LOC4) * * WHERE - SOURCE = SOURCE FIELD TO HAVE BITS EXTRACTED FROM. * THIS ITEM MAY BE ANY DATA TYPE, BUT MUST BEGIN ON A * WORD BOUNDARY. * * THE REMAINING ITEMS MUST BE COMPUTATIONAL-1 * OR INTEGER. * * DESTINATION = DATA-NAME TO RETURN THE EXTRACTED * BITS. * * LOC3 = BEGINING BIT POSITION IN THE DESTINATION * FIELD - MAYBE COMPUTATIONAL-1 OR INTEGER. * * LOC4 = LENGTH OF BIT STRING IN SOURCE WORD - MAY BE * COMPUTATIONAL-1 OR INTEGER. * * USES A - 0, 1, 2, 3, 6. * X - 1, 2, 3, 6, 7. * B - 1, 2, 3, 4. * * CALLS VVA. * * MACROS ARGERR. VFD 42/0LINSERT,18/INSERT INT2 SA1 INTA RESTORE (A0) SA0 X1+ INSERT SUBR ENTRY/EXIT SX6 A0+ SAVE (A0) SB1 1 ZR X1,INT1 IF NO ARGUMENTS - ABORT TASK SA6 INTA SA2 X1+ READ SOURCE FIELD * DETERMINE VALIDITY OF ARGUMENTS. RJ VVA VERIFY VALIDITY OF ARGUMENTS NE B4,INT1 IF ERROR IN ARGUMENTS - ABORT TASK SA3 X3+ READ DESTINATION FIELD * INSERT SOURCE FIELD INTO DESTINATION FIELD. SB4 X5-1 (B4) = LENGTH OF MASK MX7 1 AX7 B4 SB2 B4+B1 LX7 B2 POSITION MASK TO EXTRACT SOURCE FIELD BX2 X7*X2 EXTRACT VALUE SB3 X4 (B3) = BEGINNING BIT POSITION SB3 B3-B4 LX7 B3 POSITION MASK LX2 B3 BX6 -X7*X3 BX6 X2+X6 SA6 A3 EQ INT2 RESTORE (A0) AND RETURN * PROCESS PARAMETER ERROR. INT1 SA1 INSERT READ *RJ* ADDRESS MX0 30 LX1 30 SA2 X1-1 READ TRACEBACK WORD BX6 -X0*X6 SA6 INTA ARGERR A6 EXIT TO EXECUTIVE INTA CON 0 STORAGE FOR (A0) VVA SPACE 4,15 ** VVA - VERIFY VALIDITY OF ARGUMENTS. * * ENTRY (A1) = FWA OF LIST OF ARGUMENT ADDRESSES. * * EXIT (X3) = ADDRESS OF DESTINATION FIELD. * (X4) = BEGINNING BIT POSITION ARGUMENT. * (X5) = LENGTH ARGUMENT. * (B4) = 0, IF NO ERROR. * .NE. 0, IF ERROR IN ARGUMENT. * * USES X - 1, 3, 4, 5, 6, 7. * A - 3, 4, 5. * B - 3, 4. VVA SUBR ENTRY/EXIT SA3 A1+B1 ADDRESS OF DESTINATION FIELD SA4 A3+B1 ADDRESS OF BEGINNING BIT POSITION FIELD SA5 A4+B1 ADDRESS OF BIT STRING LENGTH FIELD SB4 B1 SET ERROR FLAG ZR X3,VVAX IF NO DESTINATION ARGUMENT ZR X4,VVAX IF NO BEGINNING BIT POSTION ARGUMENT ZR X5,VVAX IF NO LENGTH ARGUMENT SA4 X4 READ BEGINNING BIT POSITION SA5 X5 READ LENGTH SX6 B1 IX6 X5-X6 SX1 59 NG X4,VVAX IF RANGE ERROR (BIT POSITION .LT. 0) NG X6,VVAX IF RANGE ERROR (LENGTH .LT. 1) IX7 X1-X5 IX6 X1-X4 NG X7,VVAX IF RANGE ERROR (LENGTH .GT. 59) NG X6,VVAX IF RANGE ERROR (BIT POSITION .GT. 59) IX6 X5-X4 SB3 X6 GT B3,B1,VVAX IF RANGE ERROR SB4 B0+ CLEAR ERROR FLAG EQ VVAX RETURN SPACE 4 END