|
DataMuseum.dkPresents historical artifacts from the history of: IBM System/3 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about IBM System/3 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 12700 (0x319c)
Types: s3xseg
Names: »SXRF32«
└─⟦811594a0b⟧ Bits:30009185 5702-sc1.V16.pgm
└─⟦8223a6838⟧
└─⟦this⟧ »SXRF32«
└─⟦990ba7470⟧ Bits:30009182 5702-PP1
└─⟦efad88270⟧
└─⟦this⟧ »SXRF32«
H C 014 XRF32 0000
F* 0010
F****************************************************** 0020
F* 5798-NKG COPYRIGHT IBM CORP. 1977. REFER TO * 0030
F* INSTRUCTIONS ON COPYRIGHT NOTICE FORM NO. 120-2083* 0040
F****************************************************** 0050
F* 0060
F******************************************************************* 0070
F* THIS PROGRAM IS UTILIZED TO CONVERT FIELD NAMES TO A STANDARD * 0080
F* FIELD NAME LIST. IT PERFORMS THE FOLLOWING FUNCTIONS- * 0090
F* 1. CONVERTS FIELD NAMES THAT APPEAR IN THE CONVERSION FILE * 0100
F* WHERE THE FROM FIELD (COL 1-6) IS DIFFERENT FROM THE * 0110
F* TO FIELD (COL 13-18). THIS CONVERSION TAKES PLACE ON * 0120
F* THE FOLLOWING SPECIFICATIONS. * 0130
F* EXTENSION * 0140
F* INPUT * 0150
F* CALCULATION * 0160
F* OUTPUT * 0170
F* 2. PRINTS ALL CODE LINES BEING CHANGED. * 0180
F* 3. IF A NAME FIELD IS CONVERTED THE NEW NAME IS PRINTED * 0190
F* DIRECTLY BENEATH THE OLD NAME ON THE LISTING AND * 0200
F* REPLACES IT IN THE SOURCE PROGRAM. * 0210
F* 4. FLAGS THE LINE IF THE REPLACEMENT NAME/S/ EXCEED THE * 0220
F* ALLOWABLE LENGTH OF THE FIELD, I.E. 6 OR 10 CHARACTERS.* 0230
F* 5. AT EOJ PRINTS A LISTING OF PROGRAMS THAT HAD CHANGES * 0240
F* MADE TO THEM, I.E. THE ONES THAT REQUIRE RECOMPILATION.* 0250
F* 6. PRINTING THE CHANGE LISTING IS DONE IF U1 IS ON. * 0260
F* ACTUALLY CONVERTING THE CODE IN THE FILE 'PROGRAMS' IS * 0270
F* DONE ONLY IF U1 AND U8 ARE ON. * 0280
F* REPLNAM IS CREATED BY XRF16 AND REPLACEMENT NAMES ARE * 0290
F* INSERTED BY XRF30 OR XRF31. * 0300
F******************************************************************* 0310
F* 0320
FPROGRAMSUP F1920 96 DISK40 0330
FREPLNAM IC F 18R12AI 1 DISK40 64 0340
FPRINTER O F 132 OF PRINTER 0350
E CODES 15 15 5 0360
E LEGIT 29 29 1 0370
E HLDI 10 1 0380
E HLDO 10 1 0390
E CHEK 6 1 0400
E PROG 300 6 0410
E IND 6 2 0420
IPROGRAMSNS 88 1 C/ 4 CC 5 CO 0430
I OR 25 1 C/ 4 CL 5 CO 0440
I OR 97 7 C* 0450
I OR 7 C/ 0460
I OR 32 C* 0470
I OR 1 C* 2NC* 0480
I OR 1 C/ 0490
I OR 10 1 C* 2 C* 0500
I NS 01 6 CH 0510
I/COPY R1,AUX088 0520
I PROGRML1 0530
I 1 96 DATA96 0540
I NS 03 6 CE 7 C 27NC 0550
I/COPY R1,AUX092 0560
I TAB2 16 0570
I 1 96 DATA96 0580
I NS 04 6 CI 7 C 53NC 0590
I/COPY R1,AUX094 0600
I 1 96 DATA96 0610
I NS 06 6 CC 0620
I/COPY R1,AUX096 0630
I FACTC1 16 0640
I FACTC2 17 0650
I FACT3 18 0660
I 1 96 DATA96 0670
I NS 07 6 CO 7 C 32NC 0680
I/COPY R1,AUX098 0690
I 1 96 DATA96 0700
I NS 95 0710
IREPLNAM NS 0720
I/COPY R1,AUX078 0730
C********************* INDICATOR USAGE ************** 0740
C* U1 ON MEANS TO PRINT A REPLACEMENT TRANSACTION 0750
C* LISTING. 0760
C* U1 & U8 BOTH SWITCHES ON MEANS TO ACTUALLY UPDATE 0770
C* THE PROGRAM IN THE FILE 'PROGRAMS' WITH 0780
C* REPLACEMENT NAMES. 0790
C* 01 THIS IS AN 'H' SPEC. 0800
C* 03 THIS IS AN 'E' SPEC WITH AT LEAST ONE NAME. 0810
C* 04 'I' SPEC WITH A DATA NAME. 0820
C* 06 'C' SPEC 0830
C* 10 '**' CARD AT START OF A TABLE 0840
C* 11 1ST NAME FIELD IN CARD HAS A CHANGE 0850
C* 12 2ND NAME FIELD IN CARD HAS A CHANGE 0860
C* 13 3RD NAME FIELD IN CARD HAS A CHANGE 0870
C* 14 MEANS THERE IS A NAME CHANGE TO THIS PAR- 0880
C* TICULAR FIELD NAME. COULD BE TO THE ONLY 0890
C* NAME IN THE FACTOR AND/OR THE INDEX VARIABLE 0900
C* NAME, IF ONE IS PRESENT. 0910
C* 15 PER THE OP CODE IN THIS 'C' SPEC IT CONTAINS 0920
C* NO DATA NAMES. 0930
C* 19 MEANS THIS IS A LEGITIMATE DATA NAME 0940
C* 22 MEANS THERE IS A CHANGE IN THIS PROGRAM. 0950
C* 23 MEANS THERE IS A NAME CHANGE IN THIS RECORD 0960
C* 24 MEANS THERE IS A CHANGE IN THIS FIELD 0970
C* 25 THIS IS A // LOAD OR TABLE CARDS 0980
C* 28-29 USED TO CONTROL LR TIME PRINTING OF THE LIST 0990
C* OF CHANGED PROGRAMS. 1000
C* 40 MEANS THIS IS THE FIRST CHANGE IN THIS 1010
C* PROGRAM. 1020
C* 41 CONTROLS PRINTING HEADINGS WITH 40 1030
C* 51 A COMMA WAS FOUND IN THE FIELD-I.E. WE'RE 1040
C* LOOKING AT A 'NAME,INDEX' SITUATION. 1050
C* 52 COMMON COMPARE INDICATOR. 1060
C* 60 MEANS THE COMBINED FIELD NAME AND VARIABLE 1070
C* NAME AFTER REPLACEMENT EXCEED THE ALLOWABLE 1080
C* NUMBER OF CHARACTERS FOR THIS PARTICULAR 1090
C* FIELD. 1100
C* 61 FIRST DATA NAME FIELD IN THE RECORD ENDED 1110
C* UP WITH OVER 6 OR 10 CHARACTERS, WHICHEVER 1120
C* IS APPROPRIATE FOR THIS SPEC TYPE. 1130
C* 62 SAME AS 61 FOR SECOND FIELD. 1140
C* 63 SAME AS 61 FOR THIRD FIELD. 1150
C* 64 MEANS THERE WAS A 60 ERROR CONDITION SOME- 1160
C* WHERE IN THIS PROGRAM. PRINT THE ERROR 1170
C* MESSAGE AT THE END OF THE PROGRAM. 1180
C* 88 THIS IS A // COPY RECORD, I.E. THE START OF 1190
C* A NEW PROGRAM OR PROCEDURE IN THE FILE. 1200
C* 95 INPUT CATCH-ALL 1210
C* 96 THE DATA FIELD NAME WAS FOUND IN REPLNAM 1220
C* AND THE RECORD CONTAINED A REPLACEMENT NAME 1230
C* 97 EXTRANEOUS SPEC TYPES, PROCEDURES, ETC 1240
C****************************************************** MAIN LINE 1250
C L1 SETOF 64 1260
C 01 MOVE PROGRM PRGSAV 6 1270
C EXSR DETCLR 1280
C 88 EXSR NEWJOB 1290
C 10 SETON 25 1300
C 88 1310
COR 25 1320
COR 95 1330
COR 97 GOTO END 1340
C 03 EXSR ECARD 1350
C 04 EXSR ICARD 1360
C* SEE IF THIS OPCODE ALLOWS FOR FIELD NAMES. 1370
C 06 OPCODE LOKUPCODES 15 1380
C 06N15 EXSR CCARD 1390
C 07 EXSR OCARD 1400
C END TAG 1410
C 61 1420
COR 62 1430
COR 63 SETON 60 1440
C* SEE IF THIS PROGRAM NAME SHOULD BE ADDED TO THE 1450
C* TABLE OF PROGRAMS HAVING NAME CHANGES IN THEM - 1460
C* I.E. NEEDING RECOMPILATION. 1470
CL1 EXSR ADDNAM 1480
CLR U1 EXSR PRLIST 1490
C****************************************************** 1500
CLR MOVE '5798-NKG'COIBM 8 * 1510
CLR MOVE 'COPYRIGH'COIBM * 1520
CLR MOVE 'T IBM CO'COIBM * 1530
CLR MOVE 'RP. 1977'COIBM * 1540
C****************************************************** DETCLR 1550
CSR DETCLR BEGSR 1560
CSR SETOF 111213 1570
CSR SETOF 234060 1580
CSR SETOF 616263 1590
CSR MOVEABLNK10 HLDI 1600
CSR ENDSR 1610
C****************************************************** NEWJOB 1620
CSR NEWJOB BEGSR 1630
CSR SETOF 232541 1640
CSR ENDSR 1650
C****************************************************** ECARD 1660
CSR ECARD BEGSR 1670
CSR MOVEATAB1 HLDI 1680
CSR EXSR INDEXS 1690
CSR 24 SETON 11 1700
CSR 24 MOVEAHLDO TAB1 1710
CSR 60 SETON 61 1720
CSRN16 MOVEATAB2 HLDI 1730
CSRN16 EXSR INDEXS 1740
CSRN16 24 SETON 12 1750
CSRN16 24 MOVEAHLDO TAB2 1760
CSR 60 SETON 62 1770
CSR ENDSR 1780
C****************************************************** ICARD 1790
CSR ICARD BEGSR 1800
CSR MOVEAFACT1 HLDI 1810
CSR EXSR INDEXS 1820
CSR 24 SETON 11 1830
CSR 24 MOVEAHLDO FACT1 1840
CSR 60 SETON 61 1850
CSR ENDSR 1860
C****************************************************** CCARD 1870
CSR CCARD BEGSR 1880
C* 30 CONTROLS CHECKING 10 COLUMNS -INSTEAD OF THE 1890
C* USUAL 6- IN FACTORS 1 AND 2 OF A 'C' SPEC. 1900
CSR SETON 30 1910
CSRN16 MOVEAFACTC1 HLDI 1920
CSRN16 EXSR INDEXS 1930
CSRN16 24 SETON 11 1940
CSRN16 24 MOVEAHLDO FACTC1 1950
CSR 60 SETON 61 1960
C* SKIP FACTORS 2 AND 3 ON A CHAIN SPEC. 1970
CSR OPCODE COMP 'CHAIN' 26 1980
CSR 26 SETOF 1718 1990
CSRN17 MOVEAFACTC2 HLDI 2000
CSRN17 EXSR INDEXS 2010
CSRN17 24 SETON 12 2020
CSRN17 24 MOVEAHLDO FACTC2 2030
CSR 60 SETON 62 2040
CSR SETOF 30 2050
CSRN18 MOVEAFACT3 HLDI 2060
CSRN18 EXSR INDEXS 2070
CSRN18 24 SETON 13 2080
CSRN18 24 MOVEAHLDO FACT3 2090
CSR 60 SETON 63 2100
CSR ENDSR 2110
C****************************************************** OCARD 2120
CSR OCARD BEGSR 2130
CSR MOVEAFACT1 HLDI 2140
CSR EXSR INDEXS 2150
CSR 24 SETON 11 2160
CSR 24 MOVEAHLDO FACT1 2170
CSR 60 SETON 61 2180
CSR ENDSR 2190
C****************************************************** INDEXS 2200
CSR INDEXS BEGSR 2210
CSR EXSR SETUP 2220
CSR HLDI,1 LOKUPLEGIT 19 2230
C* QUIT IF IT DOESN'T START WITH A LEGITIMATE CHARACTER 2240
CSRN19 GOTO ENDCHG 2250
C* GET THE FIELD NAME AND CHECK IT FOR A COMMA. 2260
CSR MOVEAHLDI,1 CHEK,1 2270
CSR ',' LOKUPHLDI,A 51 2280
CSR 51 A ADD 1 A 2290
CSR ',' LOKUPCHEK,C 52 2300
C* CLEAR OUT THE COMMA ONWARDS, LEAVING JUST THE FIELD NAME 2310
CSR 52 MOVEABLNK10 CHEK,C 2320
C* SEE IF THE NAME IS TO BE REPLACED. 2330
CSR EXSR REPLAC 2340
C* ADD TO THE CHARACTER COUNTER TO CHECK FOR REPLACE- 2350
C* MENTS THAT ARE TOO LARGE. 2360
CSR EXSR TOOLNG 2370
CSR MOVEABLNK10 HLDO 2380
CSR MOVEACHEK,1 HLDO,1 2390
C* WHETHER OR NOT THE NAME IS TO BE REPLACED, WE'RE 2400
C* DONE IF THERE WASN'T A COMMA. 2410
CSRN51 GOTO ENDCHG 2420
C* PUT THE COMMA IN THE OUTPUT HOLD ARRAY AND GET IT 2430
C* READY FOR THE INDEX TO GO IN. 2440
CSR ' ' LOKUPHLDO,B 52 2450
CSR MOVE ',' HLDO,B 2460
CSR 1 ADD B B 2470
C* NOW GET THE INCOMING INDEX, NAME OR CONSTANT AND 2480
C* CHECK IT. 2490
CSR MOVEABLNK10 CHEK,1 2500
CSR MOVEAHLDI,A CHEK,1 2510
CSR CHEK,1 LOKUPLEGIT 19 2520
C* CHECK FOR REPLACEMENT IF IT'S A NAME. 2530
CSR 19 EXSR REPLAC 2540
CSR 1 ADD F F 2550
CSR EXSR TOOLNG 2560
C* MOVE THE NUMBER, ORIGINAL NAME, OR REPLACEMENT NAME 2570
C* TO THE OUTPUT HOLD ARRAY. 2580
CSR MOVEACHEK,1 HLDO,B 2590
CSR ENDCHG TAG 2600
CSR 24 EXSR PRTSET 2610
CSR MOVEABLNK10 HLDI 2620
CSR ENDSR 2630
C****************************************************** SETUP 2640
CSR SETUP BEGSR 2650
CSR SETOF 142460 2660
CSR MOVE ' ' BLNK10 10 2670
CSR MOVEABLNK10 CHEK 2680
CSR Z-ADD1 A 20 2690
CSR Z-ADD1 B 20 2700
CSR Z-ADD1 C 20 2710
CSR Z-ADD0 F 20 2720
CSR ENDSR 2730
C****************************************************** TOOLNG 2740
C* SEE IF THE REPLACEMENT NAME/S/ HAVE MADE THE NAME 2750
C* IN THE FIELD TOO LONG. 2760
CSR TOOLNG BEGSR 2770
CSR Z-ADD1 C 2780
CSR ' ' LOKUPCHEK,C 52 2790
CSR C SUB 1 C 2800
CSR C ADD F F 2810
CSRN52 6 ADD F F 2820
CSR 30 F COMP 10 60 2830
CSRN30 F COMP 6 60 2840
CSR 60 SETON 64 2850
CSR ENDSR 2860
C****************************************************** PRTSET 2870
C* CONTROLS PAGE HEADING PRINTING ONCE ONLY AT THE TIME 2880
C* OF THE FIRST CHANGE ENCOUNTERED FOR IT. 2890
CSR PRTSET BEGSR 2900
CSRN41 SETON 40 2910
CSR SETON 41 2920
CSR ENDSR 2930
C****************************************************** REPLAC 2940
CSR REPLAC BEGSR 2950
CSR SETOF 14 2960
CSR MOVEACHEK OLDNAM 6 2970
CSR MOVELOLDNAM KEY 12 2980
CSR MOVE PRGSAV KEY 2990
CSR MOVE BLNK10 REPLNM 3000
CSR KEY CHAINREPLNAM 96 3010
CSRN96 REPLNM COMP ' ' 96 3020
CSRN96 SETON 14 3030
CSR 14 MOVEABLNK10 CHEK,1 3040
CSR 14 MOVEAREPLNM CHEK,1 3050
CSR 14 SETON 222324 3060
CSR ENDSR 3070
C****************************************************** ADDNAM 3080
CSR ADDNAM BEGSR 3090
CSR 22 1 ADD G G 30 3100
CSR 22 MOVE PRGSAV PROG,G 3110
CSR SETOF 22 3120
CSR ENDSR 3130
C****************************************************** PRLIST 3140
CSR PRLIST BEGSR 3150
CSR SETON 2831 3160
CSR Z-ADD0 E 30 3170
CSR LOOP2 TAG 3180
CSR 1 ADD E E 3190
CSR E COMP G 29 3200
CSRN29 EXCPT 3210
CSRN29 SETOF 28 3220
CSRN29 GOTO LOOP2 3230
CSR ENDSR 3240
C****************************************************** 3250
OPROGRAMSD 23 U1 U8 3260
O 04 11 FACT1 58 3270
O 06 11 FACTC1 27 3280
O 06 12 FACTC2 42 3290
O 06 13 FACT3 48 3300
O 07 11 FACT1 37 3310
O 03 11 TAB1 32 3320
O 03 12 TAB2 51 3330
OPRINTER H 202 40 U1 3340
O OR OF 3350
O UDATE Y 8 3360
O 18 'XRF32' 3370
O 45 'FIELD NAME CONVERSION' 3380
O 49 'FOR' 3390
O PRGSAV 56 3400
O D 11 23 U1 3410
O DATA96 96 3420
O D 1 23 U1 3430
O 04 11 FACT1 58 3440
O 06 11 FACTC1 27 3450
O 06 12 FACTC2 42 3460
O 06 13 FACT3 48 3470
O 07 11 FACT1 37 3480
O 03 11 TAB1 32 3490
O 03 12 TAB2 51 3500
O 60 106 '**********' 3510
O D 1 60 U1 3520
O 03 11 61 32 '******' 3530
O 03 12 62 51 '******' 3540
O 04 11 61 58 '******' 3550
O 06 11 61 27 '**********' 3560
O 06 12 62 42 '**********' 3570
O 06 13 63 48 '******' 3580
O 07 11 61 37 '******' 3590
O T 31 L1 U1 64 3600
O 10 '**********' 3610
O 98 '**********' 3620
O T 1 L1 U1 64 3630
O 1 '*' 3640
O 29 'ERRORS IN THIS PROGRAM.' 3650
O 53 ' REPLACEMENT NAME/S/ EX' 3660
O 77 'CEEDED PERMISSABLE LENGT' 3670
O 93 'H OF NAME FIELD.' 3680
O 98 '*' 3690
O T 1 L1 U1 64 3700
O 10 '**********' 3710
O 98 '**********' 3720
O E 101 28 3730
O 17 'PROGRAMS MODIFIED' 3740
O E 2 28 3750
O 17 '*****************' 3760
O E 1 31 3770
O PROG,E 10 3780
** CODES ARRAY OF OPCODES THAT HAVE NO FIELDS IN THE CARD 3780
GOTO BEGSRTAG ENDSREXSR SETONSETOFEXIT EXCPTFORCEREAD 3790
** LEGIT ARRAY OF LEGITIMATE START CHARACTERS FOR FIELDS. 3790
ABCDEFGHIJKLMNOPQRSTUVWXYZ#$@ 3800