cdc:nos2.source:opl.opl871:deck:extract
Deck EXTRACT
1 Modification
Source
Seq # *Modification Id* Act ----------------------------+ 00001 M01S00001.extract +++| IDENT EXTRACT 00002 M01S00002.extract +++| ENTRY EXTRACT 00003 M01S00003.extract +++| ENTRY INSERT 00004 M01S00004.extract +++| SYSCOM B1 00005 M01S00005.extract +++|*COMMENT EXTRACT/INSERT - BIT MANIPULATION ROUTINE.
| Line S00006 Modification History | |
|---|---|
M01 (Added by) | extract |
M02 (Updated by) | 281l803 |
Seq # *Modification Id* Act ----------------------------+ 00006 M02S00006.281l803 ---| COMMENT COPYRIGHT CONTROL DATA CORPORATION. 1979. 00007 M01S00001.281l803 +++| COMMENT COPYRIGHT CONTROL DATA SYSTEMS INC. 1992. 00008 M01S00007.extract +++| TITLE EXTRACT/INSERT - BIT MANIPULATION ROUTINE. 00009 M01S00008.extract +++| SPACE 4 00010 M01S00009.extract +++|***** EXTRACT/INSERT - BIT MANIPULATION ROUTINE. 00011 M01S00010.extract +++|* 00012 M01S00011.extract +++|* W. E. MARTIN. 78/10/30. 00013 M01S00012.extract +++| EXTRACT SPACE 4,45 00014 M01S00013.extract +++|*** EXTRACT/INSERT - BIT MANIPULATION ROUTINE. 00015 M01S00014.extract +++|* 00016 M01S00015.extract +++|* EXTRACT/INSERT SUPPORTS THE COBOL TASK WRITER FOR THE 00017 M01S00016.extract +++|* SITUATIONS WHERE BIT-ORIENTED OPERATIONS SUCH AS *TARO* AND 00018 M01S00017.extract +++|* *TSIM* MONITOR REQUESTS ARE DESIRED. THE BASIC OPERATION 00019 M01S00018.extract +++|* PROVIDED IS TO RIGHT-JUSTIFY THE FIELD SPECIFIED IN THE 00020 M01S00019.extract +++|* ARGUMENTS, SO THAT MORE TRADITIONAL *COBOL* ARITHMETIC CAN 00021 M01S00020.extract +++|* BE PERFORMED. ALTHOUGH THIS ROUTINE MAY BE ENTERED FROM 00022 M01S00021.extract +++|* *FTN*, IT-S USE IS INTENDED TO AID THE *COBOL* PROGRAMMER WHO 00023 M01S00022.extract +++|* FINDS THAT THE *STRING/UNSTRING* FUNCTIONS DO NOT PERFORM THE 00024 M01S00023.extract +++|* NECESSARY OPERATIONS SATISFACTORILY, OR THAT HIS DATA DOES 00025 M01S00024.extract +++|* NOT LEND ITSELF TO COMPUTATIONAL-4 MAPPING. 00026 M01S00025.extract +++|* 00027 M01S00026.extract +++|* THE VALUE FIELDS OF THE PARAMETER LIST ARE CHECKED FOR 00028 M01S00027.extract +++|* EXISTENCE AND SIZE. IF ANY ARGUMENTS ARE MISSING OR LARGER 00029 M01S00028.extract +++|* THAN THE WORD SIZE, THEN THE TASK IS ABORTED. 00030 M01S00029.extract +++|* 00031 M01S00030.extract +++|* COBOL CALL - 00032 M01S00031.extract +++|* 00033 M01S00032.extract +++|* ENTER EXTRACT USING SOURCE, DESTINATION, LOC1, LOC2. 00034 M01S00033.extract +++|* 00035 M01S00034.extract +++|* FTN CALL - 00036 M01S00035.extract +++|* 00037 M01S00036.extract +++|* CALL EXTRACT ( SOURCE, DESTINATION, LOC1, LOC2) 00038 M01S00037.extract +++|* 00039 M01S00038.extract +++|* WHERE - SOURCE = SOURCE FIELD TO HAVE BITS EXTRACTED FROM. 00040 M01S00039.extract +++|* MAY BE ANY DATA TYPE, BUT MUST BEGIN ON A WORD 00041 M01S00040.extract +++|* BOUNDARY. 00042 M01S00041.extract +++|* 00043 M01S00042.extract +++|* THE REMAINING ITEMS MUST BE COMPUTATIONAL-1 00044 M01S00043.extract +++|* OR INTEGER. 00045 M01S00044.extract +++|* 00046 M01S00045.extract +++|* DESTINATION = DATA-NAME TO RETURN THE EXTRACTED 00047 M01S00046.extract +++|* BITS. 00048 M01S00047.extract +++|* 00049 M01S00048.extract +++|* LOC1 = BEGINNING BIT POSITION IN THE SOURCE FIELD. 00050 M01S00049.extract +++|* 00051 M01S00050.extract +++|* LOC2 = LENGTH OF BIT STRING TO EXTRACT FROM SOURCE. 00052 M01S00051.extract +++|* 00053 M01S00052.extract +++|* USES A - 0, 1, 2, 6. 00054 M01S00053.extract +++|* X - 0, 1, 2, 6, 7. 00055 M01S00054.extract +++|* B - 1, 4. 00056 M01S00055.extract +++|* 00057 M01S00056.extract +++|* CALLS VVA. 00058 M01S00057.extract +++|* 00059 M01S00058.extract +++|* MACROS ARGERR. 00060 M01S00059.extract +++| SPACE 4 00061 M01S00060.extract +++|* COMMON TEXTS. 00062 M01S00061.extract +++| 00063 M01S00062.extract +++| 00064 M01S00063.extract +++|*CALL COMCMAC 00065 M01S00064.extract +++|*CALL COMKMAC 00066 M01S00065.extract +++| SPACE 4 00067 M01S00066.extract +++| VFD 42/0LEXTRACT,18/EXTRACT 00068 M01S00067.extract +++| 00069 M01S00068.extract +++| EXT2 SA1 EXTA RESTORE THE (A0) 00070 M01S00069.extract +++| SA0 X1+ 00071 M01S00070.extract +++| 00072 M01S00071.extract +++| EXTRACT SUBR ENTRY/EXIT 00073 M01S00072.extract +++| SX6 A0+ SAVE (A0) 00074 M01S00073.extract +++| SB1 1 00075 M01S00074.extract +++| ZR X1,EXT1 IF NO ARGUMENTS - ABORT TASK 00076 M01S00075.extract +++| SA6 EXTA 00077 M01S00076.extract +++| SA2 X1+ READ SOURCE FIELD 00078 M01S00077.extract +++| 00079 M01S00078.extract +++|* DETERMINE VALIDITY OF ARGUMENTS. 00080 M01S00079.extract +++| 00081 M01S00080.extract +++| RJ VVA VERIFY VALIDITY OF ARGUMENTS 00082 M01S00081.extract +++| NE B4,EXT1 IF ERROR IN ARGUMENTS - ABORT TASK 00083 M01S00082.extract +++| 00084 M01S00083.extract +++|* EXTRACT SPECIFIED FIELD. 00085 M01S00084.extract +++| 00086 M01S00085.extract +++| SX1 59 00087 M01S00086.extract +++| SB4 X5-1 ADJUSTED BIT STRING LENGTH 00088 M01S00087.extract +++| MX7 1 00089 M01S00088.extract +++| AX7 B4 (X7) = MASK 00090 M01S00089.extract +++| SB4 X4+1 SHIFT COUNT FOR MASK 00091 M01S00090.extract +++| LX7 B4 POSITION MASK 00092 M01S00091.extract +++| BX6 X7*X2 00093 M01S00092.extract +++| IX1 X1-X4 COMPUTE SHIFT COUNT 00094 M01S00093.extract +++| IX1 X1+X5 00095 M01S00094.extract +++| SB4 X1 SHIFT COUNT TO RIGHT JUSTIFY 00096 M01S00095.extract +++| LX6 B4 00097 M01S00096.extract +++| SA6 X3 00098 M01S00097.extract +++| EQ EXT2 RESTORE (A0) AND RETURN 00099 M01S00098.extract +++| 00100 M01S00099.extract +++|* PROCESS PARAMETER ERROR. 00101 M01S00100.extract +++| 00102 M01S00101.extract +++| EXT1 SA1 EXTRACT READ *RJ* ADDRESS 00103 M01S00102.extract +++| MX0 30 00104 M01S00103.extract +++| LX1 30 00105 M01S00104.extract +++| SA1 X1-1 00106 M01S00105.extract +++| BX6 -X0*X6 00107 M01S00106.extract +++| SA6 EXTA 00108 M01S00107.extract +++| ARGERR A6 EXIT TO EXECUTIVE 00109 M01S00108.extract +++| 00110 M01S00109.extract +++| EXTA CON 0 STORAGE FOR (A0) 00111 M01S00110.extract +++| INSERT SPACE 4,35 00112 M01S00111.extract +++|*** INSERT - INSERT BITS INTO A WORD. 00113 M01S00112.extract +++|* INSERT IS INTENDED TO PROVIDE A COMPANION CAPABILITY FOR 00114 M01S00113.extract +++|* THE EXTRACT ROUTINE, BY MOVING USER-SPECIFIED BIT STRINGS 00115 M01S00114.extract +++|* TO ARBITRARY POSITIONS WITHIN A GIVEN WORD. THIS THEN 00116 M01S00115.extract +++|* ALLOWS THE COBOL PROGRAMMER THE ABILITY TO TEST AND SET 00117 M01S00116.extract +++|* BITS WHICH OTHERWISE WOULD REQUIRE CUMBERSOME ARITHMETIC 00118 M01S00117.extract +++|* OPERATIONS. 00119 M01S00118.extract +++|* 00120 M01S00119.extract +++|* COBOL ENTRY - 00121 M01S00120.extract +++|* 00122 M01S00121.extract +++|* ENTER INSERT USING SOURCE, DESTINATION, LOC3, LOC4. 00123 M01S00122.extract +++|* 00124 M01S00123.extract +++|* FTN ENTRY - 00125 M01S00124.extract +++|* 00126 M01S00125.extract +++|* CALL INSERT ( SOURCE, DESTINATION, LOC3, LOC4) 00127 M01S00126.extract +++|* 00128 M01S00127.extract +++|* WHERE - SOURCE = SOURCE FIELD TO HAVE BITS EXTRACTED FROM. 00129 M01S00128.extract +++|* THIS ITEM MAY BE ANY DATA TYPE, BUT MUST BEGIN ON A 00130 M01S00129.extract +++|* WORD BOUNDARY. 00131 M01S00130.extract +++|* 00132 M01S00131.extract +++|* THE REMAINING ITEMS MUST BE COMPUTATIONAL-1 00133 M01S00132.extract +++|* OR INTEGER. 00134 M01S00133.extract +++|* 00135 M01S00134.extract +++|* DESTINATION = DATA-NAME TO RETURN THE EXTRACTED 00136 M01S00135.extract +++|* BITS. 00137 M01S00136.extract +++|* 00138 M01S00137.extract +++|* LOC3 = BEGINING BIT POSITION IN THE DESTINATION 00139 M01S00138.extract +++|* FIELD - MAYBE COMPUTATIONAL-1 OR INTEGER. 00140 M01S00139.extract +++|* 00141 M01S00140.extract +++|* LOC4 = LENGTH OF BIT STRING IN SOURCE WORD - MAY BE 00142 M01S00141.extract +++|* COMPUTATIONAL-1 OR INTEGER. 00143 M01S00142.extract +++|* 00144 M01S00143.extract +++|* USES A - 0, 1, 2, 3, 6. 00145 M01S00144.extract +++|* X - 1, 2, 3, 6, 7. 00146 M01S00145.extract +++|* B - 1, 2, 3, 4. 00147 M01S00146.extract +++|* 00148 M01S00147.extract +++|* CALLS VVA. 00149 M01S00148.extract +++|* 00150 M01S00149.extract +++|* MACROS ARGERR. 00151 M01S00150.extract +++| 00152 M01S00151.extract +++| 00153 M01S00152.extract +++| VFD 42/0LINSERT,18/INSERT 00154 M01S00153.extract +++| 00155 M01S00154.extract +++| INT2 SA1 INTA RESTORE (A0) 00156 M01S00155.extract +++| SA0 X1+ 00157 M01S00156.extract +++| 00158 M01S00157.extract +++| INSERT SUBR ENTRY/EXIT 00159 M01S00158.extract +++| SX6 A0+ SAVE (A0) 00160 M01S00159.extract +++| SB1 1 00161 M01S00160.extract +++| ZR X1,INT1 IF NO ARGUMENTS - ABORT TASK 00162 M01S00161.extract +++| SA6 INTA 00163 M01S00162.extract +++| SA2 X1+ READ SOURCE FIELD 00164 M01S00163.extract +++| 00165 M01S00164.extract +++|* DETERMINE VALIDITY OF ARGUMENTS. 00166 M01S00165.extract +++| 00167 M01S00166.extract +++| RJ VVA VERIFY VALIDITY OF ARGUMENTS 00168 M01S00167.extract +++| NE B4,INT1 IF ERROR IN ARGUMENTS - ABORT TASK 00169 M01S00168.extract +++| SA3 X3+ READ DESTINATION FIELD 00170 M01S00169.extract +++| 00171 M01S00170.extract +++|* INSERT SOURCE FIELD INTO DESTINATION FIELD. 00172 M01S00171.extract +++| 00173 M01S00172.extract +++| SB4 X5-1 (B4) = LENGTH OF MASK 00174 M01S00173.extract +++| MX7 1 00175 M01S00174.extract +++| AX7 B4 00176 M01S00175.extract +++| SB2 B4+B1 00177 M01S00176.extract +++| LX7 B2 POSITION MASK TO EXTRACT SOURCE FIELD 00178 M01S00177.extract +++| BX2 X7*X2 EXTRACT VALUE 00179 M01S00178.extract +++| SB3 X4 (B3) = BEGINNING BIT POSITION 00180 M01S00179.extract +++| SB3 B3-B4 00181 M01S00180.extract +++| LX7 B3 POSITION MASK 00182 M01S00181.extract +++| LX2 B3 00183 M01S00182.extract +++| BX6 -X7*X3 00184 M01S00183.extract +++| BX6 X2+X6 00185 M01S00184.extract +++| SA6 A3 00186 M01S00185.extract +++| EQ INT2 RESTORE (A0) AND RETURN 00187 M01S00186.extract +++| 00188 M01S00187.extract +++|* PROCESS PARAMETER ERROR. 00189 M01S00188.extract +++| 00190 M01S00189.extract +++| INT1 SA1 INSERT READ *RJ* ADDRESS 00191 M01S00190.extract +++| MX0 30 00192 M01S00191.extract +++| LX1 30 00193 M01S00192.extract +++| SA2 X1-1 READ TRACEBACK WORD 00194 M01S00193.extract +++| BX6 -X0*X6 00195 M01S00194.extract +++| SA6 INTA 00196 M01S00195.extract +++| ARGERR A6 EXIT TO EXECUTIVE 00197 M01S00196.extract +++| 00198 M01S00197.extract +++| INTA CON 0 STORAGE FOR (A0) 00199 M01S00198.extract +++| VVA SPACE 4,15 00200 M01S00199.extract +++|** VVA - VERIFY VALIDITY OF ARGUMENTS. 00201 M01S00200.extract +++|* 00202 M01S00201.extract +++|* ENTRY (A1) = FWA OF LIST OF ARGUMENT ADDRESSES. 00203 M01S00202.extract +++|* 00204 M01S00203.extract +++|* EXIT (X3) = ADDRESS OF DESTINATION FIELD. 00205 M01S00204.extract +++|* (X4) = BEGINNING BIT POSITION ARGUMENT. 00206 M01S00205.extract +++|* (X5) = LENGTH ARGUMENT. 00207 M01S00206.extract +++|* (B4) = 0, IF NO ERROR. 00208 M01S00207.extract +++|* .NE. 0, IF ERROR IN ARGUMENT. 00209 M01S00208.extract +++|* 00210 M01S00209.extract +++|* USES X - 1, 3, 4, 5, 6, 7. 00211 M01S00210.extract +++|* A - 3, 4, 5. 00212 M01S00211.extract +++|* B - 3, 4. 00213 M01S00212.extract +++| 00214 M01S00213.extract +++| 00215 M01S00214.extract +++| VVA SUBR ENTRY/EXIT 00216 M01S00215.extract +++| SA3 A1+B1 ADDRESS OF DESTINATION FIELD 00217 M01S00216.extract +++| SA4 A3+B1 ADDRESS OF BEGINNING BIT POSITION FIELD 00218 M01S00217.extract +++| SA5 A4+B1 ADDRESS OF BIT STRING LENGTH FIELD 00219 M01S00218.extract +++| SB4 B1 SET ERROR FLAG 00220 M01S00219.extract +++| ZR X3,VVAX IF NO DESTINATION ARGUMENT 00221 M01S00220.extract +++| ZR X4,VVAX IF NO BEGINNING BIT POSTION ARGUMENT 00222 M01S00221.extract +++| ZR X5,VVAX IF NO LENGTH ARGUMENT 00223 M01S00222.extract +++| SA4 X4 READ BEGINNING BIT POSITION 00224 M01S00223.extract +++| SA5 X5 READ LENGTH 00225 M01S00224.extract +++| SX6 B1 00226 M01S00225.extract +++| IX6 X5-X6 00227 M01S00226.extract +++| SX1 59 00228 M01S00227.extract +++| NG X4,VVAX IF RANGE ERROR (BIT POSITION .LT. 0) 00229 M01S00228.extract +++| NG X6,VVAX IF RANGE ERROR (LENGTH .LT. 1) 00230 M01S00229.extract +++| IX7 X1-X5 00231 M01S00230.extract +++| IX6 X1-X4 00232 M01S00231.extract +++| NG X7,VVAX IF RANGE ERROR (LENGTH .GT. 59) 00233 M01S00232.extract +++| NG X6,VVAX IF RANGE ERROR (BIT POSITION .GT. 59) 00234 M01S00233.extract +++| IX6 X5-X4 00235 M01S00234.extract +++| SB3 X6 00236 M01S00235.extract +++| GT B3,B1,VVAX IF RANGE ERROR 00237 M01S00236.extract +++| SB4 B0+ CLEAR ERROR FLAG 00238 M01S00237.extract +++| EQ VVAX RETURN 00239 M01S00238.extract +++| 00240 M01S00239.extract +++| SPACE 4 00241 M01S00240.extract +++| END
cdc/nos2.source/opl.opl871/deck/extract.txt · Last modified: by 127.0.0.1