cdc:nos2.source:opl.opl871:deck:extract
Deck EXTRACT
Library Member Format: MODIFY
Source
Seq # *Modification Id* Act ----------------------------+ 00001 M00S00001.extract +++| IDENT EXTRACT 00002 M00S00002.extract +++| ENTRY EXTRACT 00003 M00S00003.extract +++| ENTRY INSERT 00004 M00S00004.extract +++| SYSCOM B1 00005 M00S00005.extract +++|*COMMENT EXTRACT/INSERT - BIT MANIPULATION ROUTINE.
| Line S00006 Modification History | |
|---|---|
M01 (Removed by) | 281l803 |
Seq # *Modification Id* Act ----------------------------+ 00006 M01S00006.281l803 ---| COMMENT COPYRIGHT CONTROL DATA CORPORATION. 1979.
| Line S00001 Modification History | |
|---|---|
M01 (Added by) | 281l803 |
Seq # *Modification Id* Act ----------------------------+ 00007 M01S00001.281l803 +++| COMMENT COPYRIGHT CONTROL DATA SYSTEMS INC. 1992. 00008 M00S00007.extract +++| TITLE EXTRACT/INSERT - BIT MANIPULATION ROUTINE. 00009 M00S00008.extract +++| SPACE 4 00010 M00S00009.extract +++|***** EXTRACT/INSERT - BIT MANIPULATION ROUTINE. 00011 M00S00010.extract +++|* 00012 M00S00011.extract +++|* W. E. MARTIN. 78/10/30. 00013 M00S00012.extract +++| EXTRACT SPACE 4,45 00014 M00S00013.extract +++|*** EXTRACT/INSERT - BIT MANIPULATION ROUTINE. 00015 M00S00014.extract +++|* 00016 M00S00015.extract +++|* EXTRACT/INSERT SUPPORTS THE COBOL TASK WRITER FOR THE 00017 M00S00016.extract +++|* SITUATIONS WHERE BIT-ORIENTED OPERATIONS SUCH AS *TARO* AND 00018 M00S00017.extract +++|* *TSIM* MONITOR REQUESTS ARE DESIRED. THE BASIC OPERATION 00019 M00S00018.extract +++|* PROVIDED IS TO RIGHT-JUSTIFY THE FIELD SPECIFIED IN THE 00020 M00S00019.extract +++|* ARGUMENTS, SO THAT MORE TRADITIONAL *COBOL* ARITHMETIC CAN 00021 M00S00020.extract +++|* BE PERFORMED. ALTHOUGH THIS ROUTINE MAY BE ENTERED FROM 00022 M00S00021.extract +++|* *FTN*, IT-S USE IS INTENDED TO AID THE *COBOL* PROGRAMMER WHO 00023 M00S00022.extract +++|* FINDS THAT THE *STRING/UNSTRING* FUNCTIONS DO NOT PERFORM THE 00024 M00S00023.extract +++|* NECESSARY OPERATIONS SATISFACTORILY, OR THAT HIS DATA DOES 00025 M00S00024.extract +++|* NOT LEND ITSELF TO COMPUTATIONAL-4 MAPPING. 00026 M00S00025.extract +++|* 00027 M00S00026.extract +++|* THE VALUE FIELDS OF THE PARAMETER LIST ARE CHECKED FOR 00028 M00S00027.extract +++|* EXISTENCE AND SIZE. IF ANY ARGUMENTS ARE MISSING OR LARGER 00029 M00S00028.extract +++|* THAN THE WORD SIZE, THEN THE TASK IS ABORTED. 00030 M00S00029.extract +++|* 00031 M00S00030.extract +++|* COBOL CALL - 00032 M00S00031.extract +++|* 00033 M00S00032.extract +++|* ENTER EXTRACT USING SOURCE, DESTINATION, LOC1, LOC2. 00034 M00S00033.extract +++|* 00035 M00S00034.extract +++|* FTN CALL - 00036 M00S00035.extract +++|* 00037 M00S00036.extract +++|* CALL EXTRACT ( SOURCE, DESTINATION, LOC1, LOC2) 00038 M00S00037.extract +++|* 00039 M00S00038.extract +++|* WHERE - SOURCE = SOURCE FIELD TO HAVE BITS EXTRACTED FROM. 00040 M00S00039.extract +++|* MAY BE ANY DATA TYPE, BUT MUST BEGIN ON A WORD 00041 M00S00040.extract +++|* BOUNDARY. 00042 M00S00041.extract +++|* 00043 M00S00042.extract +++|* THE REMAINING ITEMS MUST BE COMPUTATIONAL-1 00044 M00S00043.extract +++|* OR INTEGER. 00045 M00S00044.extract +++|* 00046 M00S00045.extract +++|* DESTINATION = DATA-NAME TO RETURN THE EXTRACTED 00047 M00S00046.extract +++|* BITS. 00048 M00S00047.extract +++|* 00049 M00S00048.extract +++|* LOC1 = BEGINNING BIT POSITION IN THE SOURCE FIELD. 00050 M00S00049.extract +++|* 00051 M00S00050.extract +++|* LOC2 = LENGTH OF BIT STRING TO EXTRACT FROM SOURCE. 00052 M00S00051.extract +++|* 00053 M00S00052.extract +++|* USES A - 0, 1, 2, 6. 00054 M00S00053.extract +++|* X - 0, 1, 2, 6, 7. 00055 M00S00054.extract +++|* B - 1, 4. 00056 M00S00055.extract +++|* 00057 M00S00056.extract +++|* CALLS VVA. 00058 M00S00057.extract +++|* 00059 M00S00058.extract +++|* MACROS ARGERR. 00060 M00S00059.extract +++| SPACE 4 00061 M00S00060.extract +++|* COMMON TEXTS. 00062 M00S00061.extract +++| 00063 M00S00062.extract +++| 00064 M00S00063.extract +++|*CALL COMCMAC 00065 M00S00064.extract +++|*CALL COMKMAC 00066 M00S00065.extract +++| SPACE 4 00067 M00S00066.extract +++| VFD 42/0LEXTRACT,18/EXTRACT 00068 M00S00067.extract +++| 00069 M00S00068.extract +++| EXT2 SA1 EXTA RESTORE THE (A0) 00070 M00S00069.extract +++| SA0 X1+ 00071 M00S00070.extract +++| 00072 M00S00071.extract +++| EXTRACT SUBR ENTRY/EXIT 00073 M00S00072.extract +++| SX6 A0+ SAVE (A0) 00074 M00S00073.extract +++| SB1 1 00075 M00S00074.extract +++| ZR X1,EXT1 IF NO ARGUMENTS - ABORT TASK 00076 M00S00075.extract +++| SA6 EXTA 00077 M00S00076.extract +++| SA2 X1+ READ SOURCE FIELD 00078 M00S00077.extract +++| 00079 M00S00078.extract +++|* DETERMINE VALIDITY OF ARGUMENTS. 00080 M00S00079.extract +++| 00081 M00S00080.extract +++| RJ VVA VERIFY VALIDITY OF ARGUMENTS 00082 M00S00081.extract +++| NE B4,EXT1 IF ERROR IN ARGUMENTS - ABORT TASK 00083 M00S00082.extract +++| 00084 M00S00083.extract +++|* EXTRACT SPECIFIED FIELD. 00085 M00S00084.extract +++| 00086 M00S00085.extract +++| SX1 59 00087 M00S00086.extract +++| SB4 X5-1 ADJUSTED BIT STRING LENGTH 00088 M00S00087.extract +++| MX7 1 00089 M00S00088.extract +++| AX7 B4 (X7) = MASK 00090 M00S00089.extract +++| SB4 X4+1 SHIFT COUNT FOR MASK 00091 M00S00090.extract +++| LX7 B4 POSITION MASK 00092 M00S00091.extract +++| BX6 X7*X2 00093 M00S00092.extract +++| IX1 X1-X4 COMPUTE SHIFT COUNT 00094 M00S00093.extract +++| IX1 X1+X5 00095 M00S00094.extract +++| SB4 X1 SHIFT COUNT TO RIGHT JUSTIFY 00096 M00S00095.extract +++| LX6 B4 00097 M00S00096.extract +++| SA6 X3 00098 M00S00097.extract +++| EQ EXT2 RESTORE (A0) AND RETURN 00099 M00S00098.extract +++| 00100 M00S00099.extract +++|* PROCESS PARAMETER ERROR. 00101 M00S00100.extract +++| 00102 M00S00101.extract +++| EXT1 SA1 EXTRACT READ *RJ* ADDRESS 00103 M00S00102.extract +++| MX0 30 00104 M00S00103.extract +++| LX1 30 00105 M00S00104.extract +++| SA1 X1-1 00106 M00S00105.extract +++| BX6 -X0*X6 00107 M00S00106.extract +++| SA6 EXTA 00108 M00S00107.extract +++| ARGERR A6 EXIT TO EXECUTIVE 00109 M00S00108.extract +++| 00110 M00S00109.extract +++| EXTA CON 0 STORAGE FOR (A0) 00111 M00S00110.extract +++| INSERT SPACE 4,35 00112 M00S00111.extract +++|*** INSERT - INSERT BITS INTO A WORD. 00113 M00S00112.extract +++|* INSERT IS INTENDED TO PROVIDE A COMPANION CAPABILITY FOR 00114 M00S00113.extract +++|* THE EXTRACT ROUTINE, BY MOVING USER-SPECIFIED BIT STRINGS 00115 M00S00114.extract +++|* TO ARBITRARY POSITIONS WITHIN A GIVEN WORD. THIS THEN 00116 M00S00115.extract +++|* ALLOWS THE COBOL PROGRAMMER THE ABILITY TO TEST AND SET 00117 M00S00116.extract +++|* BITS WHICH OTHERWISE WOULD REQUIRE CUMBERSOME ARITHMETIC 00118 M00S00117.extract +++|* OPERATIONS. 00119 M00S00118.extract +++|* 00120 M00S00119.extract +++|* COBOL ENTRY - 00121 M00S00120.extract +++|* 00122 M00S00121.extract +++|* ENTER INSERT USING SOURCE, DESTINATION, LOC3, LOC4. 00123 M00S00122.extract +++|* 00124 M00S00123.extract +++|* FTN ENTRY - 00125 M00S00124.extract +++|* 00126 M00S00125.extract +++|* CALL INSERT ( SOURCE, DESTINATION, LOC3, LOC4) 00127 M00S00126.extract +++|* 00128 M00S00127.extract +++|* WHERE - SOURCE = SOURCE FIELD TO HAVE BITS EXTRACTED FROM. 00129 M00S00128.extract +++|* THIS ITEM MAY BE ANY DATA TYPE, BUT MUST BEGIN ON A 00130 M00S00129.extract +++|* WORD BOUNDARY. 00131 M00S00130.extract +++|* 00132 M00S00131.extract +++|* THE REMAINING ITEMS MUST BE COMPUTATIONAL-1 00133 M00S00132.extract +++|* OR INTEGER. 00134 M00S00133.extract +++|* 00135 M00S00134.extract +++|* DESTINATION = DATA-NAME TO RETURN THE EXTRACTED 00136 M00S00135.extract +++|* BITS. 00137 M00S00136.extract +++|* 00138 M00S00137.extract +++|* LOC3 = BEGINING BIT POSITION IN THE DESTINATION 00139 M00S00138.extract +++|* FIELD - MAYBE COMPUTATIONAL-1 OR INTEGER. 00140 M00S00139.extract +++|* 00141 M00S00140.extract +++|* LOC4 = LENGTH OF BIT STRING IN SOURCE WORD - MAY BE 00142 M00S00141.extract +++|* COMPUTATIONAL-1 OR INTEGER. 00143 M00S00142.extract +++|* 00144 M00S00143.extract +++|* USES A - 0, 1, 2, 3, 6. 00145 M00S00144.extract +++|* X - 1, 2, 3, 6, 7. 00146 M00S00145.extract +++|* B - 1, 2, 3, 4. 00147 M00S00146.extract +++|* 00148 M00S00147.extract +++|* CALLS VVA. 00149 M00S00148.extract +++|* 00150 M00S00149.extract +++|* MACROS ARGERR. 00151 M00S00150.extract +++| 00152 M00S00151.extract +++| 00153 M00S00152.extract +++| VFD 42/0LINSERT,18/INSERT 00154 M00S00153.extract +++| 00155 M00S00154.extract +++| INT2 SA1 INTA RESTORE (A0) 00156 M00S00155.extract +++| SA0 X1+ 00157 M00S00156.extract +++| 00158 M00S00157.extract +++| INSERT SUBR ENTRY/EXIT 00159 M00S00158.extract +++| SX6 A0+ SAVE (A0) 00160 M00S00159.extract +++| SB1 1 00161 M00S00160.extract +++| ZR X1,INT1 IF NO ARGUMENTS - ABORT TASK 00162 M00S00161.extract +++| SA6 INTA 00163 M00S00162.extract +++| SA2 X1+ READ SOURCE FIELD 00164 M00S00163.extract +++| 00165 M00S00164.extract +++|* DETERMINE VALIDITY OF ARGUMENTS. 00166 M00S00165.extract +++| 00167 M00S00166.extract +++| RJ VVA VERIFY VALIDITY OF ARGUMENTS 00168 M00S00167.extract +++| NE B4,INT1 IF ERROR IN ARGUMENTS - ABORT TASK 00169 M00S00168.extract +++| SA3 X3+ READ DESTINATION FIELD 00170 M00S00169.extract +++| 00171 M00S00170.extract +++|* INSERT SOURCE FIELD INTO DESTINATION FIELD. 00172 M00S00171.extract +++| 00173 M00S00172.extract +++| SB4 X5-1 (B4) = LENGTH OF MASK 00174 M00S00173.extract +++| MX7 1 00175 M00S00174.extract +++| AX7 B4 00176 M00S00175.extract +++| SB2 B4+B1 00177 M00S00176.extract +++| LX7 B2 POSITION MASK TO EXTRACT SOURCE FIELD 00178 M00S00177.extract +++| BX2 X7*X2 EXTRACT VALUE 00179 M00S00178.extract +++| SB3 X4 (B3) = BEGINNING BIT POSITION 00180 M00S00179.extract +++| SB3 B3-B4 00181 M00S00180.extract +++| LX7 B3 POSITION MASK 00182 M00S00181.extract +++| LX2 B3 00183 M00S00182.extract +++| BX6 -X7*X3 00184 M00S00183.extract +++| BX6 X2+X6 00185 M00S00184.extract +++| SA6 A3 00186 M00S00185.extract +++| EQ INT2 RESTORE (A0) AND RETURN 00187 M00S00186.extract +++| 00188 M00S00187.extract +++|* PROCESS PARAMETER ERROR. 00189 M00S00188.extract +++| 00190 M00S00189.extract +++| INT1 SA1 INSERT READ *RJ* ADDRESS 00191 M00S00190.extract +++| MX0 30 00192 M00S00191.extract +++| LX1 30 00193 M00S00192.extract +++| SA2 X1-1 READ TRACEBACK WORD 00194 M00S00193.extract +++| BX6 -X0*X6 00195 M00S00194.extract +++| SA6 INTA 00196 M00S00195.extract +++| ARGERR A6 EXIT TO EXECUTIVE 00197 M00S00196.extract +++| 00198 M00S00197.extract +++| INTA CON 0 STORAGE FOR (A0) 00199 M00S00198.extract +++| VVA SPACE 4,15 00200 M00S00199.extract +++|** VVA - VERIFY VALIDITY OF ARGUMENTS. 00201 M00S00200.extract +++|* 00202 M00S00201.extract +++|* ENTRY (A1) = FWA OF LIST OF ARGUMENT ADDRESSES. 00203 M00S00202.extract +++|* 00204 M00S00203.extract +++|* EXIT (X3) = ADDRESS OF DESTINATION FIELD. 00205 M00S00204.extract +++|* (X4) = BEGINNING BIT POSITION ARGUMENT. 00206 M00S00205.extract +++|* (X5) = LENGTH ARGUMENT. 00207 M00S00206.extract +++|* (B4) = 0, IF NO ERROR. 00208 M00S00207.extract +++|* .NE. 0, IF ERROR IN ARGUMENT. 00209 M00S00208.extract +++|* 00210 M00S00209.extract +++|* USES X - 1, 3, 4, 5, 6, 7. 00211 M00S00210.extract +++|* A - 3, 4, 5. 00212 M00S00211.extract +++|* B - 3, 4. 00213 M00S00212.extract +++| 00214 M00S00213.extract +++| 00215 M00S00214.extract +++| VVA SUBR ENTRY/EXIT 00216 M00S00215.extract +++| SA3 A1+B1 ADDRESS OF DESTINATION FIELD 00217 M00S00216.extract +++| SA4 A3+B1 ADDRESS OF BEGINNING BIT POSITION FIELD 00218 M00S00217.extract +++| SA5 A4+B1 ADDRESS OF BIT STRING LENGTH FIELD 00219 M00S00218.extract +++| SB4 B1 SET ERROR FLAG 00220 M00S00219.extract +++| ZR X3,VVAX IF NO DESTINATION ARGUMENT 00221 M00S00220.extract +++| ZR X4,VVAX IF NO BEGINNING BIT POSTION ARGUMENT 00222 M00S00221.extract +++| ZR X5,VVAX IF NO LENGTH ARGUMENT 00223 M00S00222.extract +++| SA4 X4 READ BEGINNING BIT POSITION 00224 M00S00223.extract +++| SA5 X5 READ LENGTH 00225 M00S00224.extract +++| SX6 B1 00226 M00S00225.extract +++| IX6 X5-X6 00227 M00S00226.extract +++| SX1 59 00228 M00S00227.extract +++| NG X4,VVAX IF RANGE ERROR (BIT POSITION .LT. 0) 00229 M00S00228.extract +++| NG X6,VVAX IF RANGE ERROR (LENGTH .LT. 1) 00230 M00S00229.extract +++| IX7 X1-X5 00231 M00S00230.extract +++| IX6 X1-X4 00232 M00S00231.extract +++| NG X7,VVAX IF RANGE ERROR (LENGTH .GT. 59) 00233 M00S00232.extract +++| NG X6,VVAX IF RANGE ERROR (BIT POSITION .GT. 59) 00234 M00S00233.extract +++| IX6 X5-X4 00235 M00S00234.extract +++| SB3 X6 00236 M00S00235.extract +++| GT B3,B1,VVAX IF RANGE ERROR 00237 M00S00236.extract +++| SB4 B0+ CLEAR ERROR FLAG 00238 M00S00237.extract +++| EQ VVAX RETURN 00239 M00S00238.extract +++| 00240 M00S00239.extract +++| SPACE 4 00241 M00S00240.extract +++| END
cdc/nos2.source/opl.opl871/deck/extract.txt · Last modified: (external edit)