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