|
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: 6096 (0x17d0)
Types: s3xseg
Names: »SXRF23«
└─⟦811594a0b⟧ Bits:30009185 5702-sc1.V16.pgm
└─⟦8223a6838⟧
└─⟦this⟧ »SXRF23«
└─⟦990ba7470⟧ Bits:30009182 5702-PP1
└─⟦efad88270⟧
└─⟦this⟧ »SXRF23«
H C 012 XRF23 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 INPUTS A SINGLE RPG PROGRAM, FETCHES ANY * 0080
F* CODE TO BE '/COPY'ED IN FROM SLIBRFIL, AND OUTPUTS THE * 0090
F* FILE XREFFILE FOR SORTING BY XRF24 AND THE FIELD/IND * 0100
F* XREF BY XRF25. SLIBRFIL IS ACCESSED ONLY IF U1 IS ON. * 0110
F*********************************************************** 0120
F* 0130
FRPGIN IPE F 480 96 DISK 0140
FSLIBRFILIC F 92R12AI 81 DISK40 U1 0150
FXREFFILEO F2548 91 DISK40 0160
E LEGIT 29 29 1 0170
E IND 6 2 0180
I***INDICATOR USAGE******************************* 0190
I* 01-10 INPUT IDENTIFYING INDICATORS * 0200
I* 01 'H' SPEC * 0210
I* 02 'F' SPEC W/ FILE NAME * 0220
I* 03 'E' SPEC W/ TABLE/ARRAY NAME * 0230
I* 04 'I' SPEC--ANY KIND * 0240
I* 06 'C' SPEC * 0250
I* 07 'O' SPEC EXCPT * IN 7 OR 32 * 0260
I* 09 AUTO /COPY IN RECORD * 0270
I* 10 START OF COMP TIME TABLE/ARRAY * 0280
I* 11-99 CALCULATION INDICATORS * 0290
I* 11 READING THROUGH TABLE/ARRAY * 0300
I* 13 DENOTES RECORD OUTPUT TO XREFFILE * 0310
I* BECAUSE OF AN INDICATOR VS. A FIELD* 0320
I* NAME. * 0330
I* 15 ',' FOUND IN A FIELD NAME * 0340
I* 16-17 CONTROLS 1ST RECORD TO FILE 'DECK' * 0350
I* 18 LOOP CONTROL * 0360
I* 20-23 INPUT RESULTING INDICATORS * 0370
I* 24 SCANNING FACTOR 1 OR 2 OF 'C' SPEC * 0380
I* FOR FIELD NAMES. CONTROLS LOOP SIZE* 0390
I* 88 // COPY OR // CEND * 0400
I* 97 COMMENT RECORD * 0410
I* 99 NO RECORD FOUND ON CHAIN TO SLIBRFIL * 0420
I* END OF BOOK OR BOOK NOT PRESENT. * 0430
I************************************************* 0440
I* 0450
IRPGIN NS 97 7 C* 0460
I OR 1 C* 2NC* 0470
I OR 10 1 C* 2 C* 0480
I NS 88 1 C/ 4 CC 0490
I OR 09 7 C/ 8 CC 9 CO 0500
I/COPY R1,AUX086 0510
I 81 96 DATA16 0520
I NS 01 6 CH 0530
I/COPY R1,AUX088 0540
I PROGRM 20 0550
I 81 96 DATA16 0560
I NS 02 6 CF 7NC 0570
I/COPY R1,AUX090 0580
I OF 21 0590
I U1U8 22 0600
I 81 96 DATA16 0610
I NS 03 6 CE 27NC 0620
I/COPY R1,AUX092 0630
I TAB2 21 0640
I 81 96 DATA16 0650
I NS 04 6 CI 0660
I/COPY R1,AUX094 0670
I IDIND 21 0680
I FACT1 22 0690
I 81 96 DATA16 0700
I NS 06 6 CC 0710
I/COPY R1,AUX096 0720
I FACTC1 21 0730
I FACTC2 22 0740
I FACT3 23 0750
I 81 96 DATA16 0760
I NS 07 6 CO 0770
I/COPY R1,AUX098 0780
I FACT1 21 0790
I 81 96 DATA16 0800
I NS 0810
I 1 80 DATA80 0820
I 81 96 DATA16 0830
ISLIBRFILNS 97 7 C* 0840
I NS 02 6 CF 7NC 0850
I/COPY R1,AUX090 0860
I OF 21 0870
I U1U8 22 0880
I NS 03 6 CE 27NC 0890
I/COPY R1,AUX092 0900
I TAB2 21 0910
I NS 04 6 CI 0920
I/COPY R1,AUX094 0930
I IDIND 21 0940
I FACT1 22 0950
I NS 06 6 CC 0960
I/COPY R1,AUX096 0970
I FACTC1 21 0980
I FACTC2 22 0990
I FACT3 23 1000
I NS 07 6 CO 1010
I/COPY R1,AUX098 1020
I FACT1 21 1030
I NS 1040
I 1 80 DATA80 1050
C****************************************************** MAIN LINE 1060
C* BYPASS COMPILE TIME TABLE/ARRAYS. 1070
C 10 SETON 11 1080
C 11 GOTO ENDMAN 1090
C N01N88 10 ADD LINE LINE 72 1100
C 09 U1 EXSR COPI 1110
C MOVE '00' LINE 1120
C N09N88N97 EXSR GETTYP 1130
C ENDMAN TAG 1140
C* 1150
C****************************************************** 1160
CLR MOVE '5798-NKG'COIBM 8 * 1170
CLR MOVE 'COPYRIGH'COIBM * 1180
CLR MOVE 'T IBM CO'COIBM * 1190
CLR MOVE 'RP. 1977'COIBM * 1200
C****************************************************** 1210
C/COPY R1,AUX004 1220
C****************************************************** GETTYP 1230
CSR GETTYP BEGSR 1240
CSR 01 EXSR HCARD 1250
CSR 02 EXSR FCARD 1260
CSR 03 EXSR ECARD 1270
CSR 04 EXSR ICARD 1280
CSR 06 EXSR CCARD 1290
CSR 07N21 EXSR OCARD 1300
CSR 04 21 1310
COR 06 1320
COR 07 EXSR INDIC 1330
CSR ENDSR 1340
C***************************************************** HCARD 1350
CSR HCARD BEGSR 1360
CSR 20 MOVE 'RPGOBJ' DATA80 1370
CSR EXCPT 1380
CSR ENDSR 1390
C***************************************************** FCARD 1400
CSR FCARD BEGSR 1410
CSRN21 MOVE '9' RECCD 1 1420
CSRN21 MOVELOF FLDIND 6 1430
CSRN21 EXCPT 1440
CSRN22 MOVE '9' RECCD 1450
CSRN22 MOVELU1U8 FLDIND 1460
CSRN22 EXCPT 1470
CSR ENDSR 1480
C****************************************************** ECARD 1490
CSR ECARD BEGSR 1500
CSR MOVE TAB1 FLDIND 1510
CSR EXCPT 1520
CSRN21 MOVE TAB2 FLDIND 1530
CSRN21 EXCPT 1540
CSR ENDSR 1550
C****************************************************** ICARD 1560
CSR ICARD BEGSR 1570
CSRN21 MOVELIDIND FLDIND 1580
CSRN21 MOVE '9' RECCD 1590
CSRN21 EXCPT 1600
CSRN22 MOVEAFACT1 HOLDI 1610
CSRN22 EXSR COMMAS 1620
CSR ENDSR 1630
C***************************************************** CCARD 1640
CSR CCARD BEGSR 1650
CSR SETON 24 1660
C* INDICATOR 24 CAUSES CHECKING 10 POSITIONS 1670
C* IN FACTOR 1 OR 2 IN 'C' SPEC VS. 6 POSITIONS 1680
C* IN 'I', 'O' SPECS AND FACTOR 3 IN 'C' SPEC. 1690
CSRN21 MOVEAFACTC1 HOLDI 1700
CSRN21 EXSR COMMAS 1710
CSRN22 MOVEAFACTC2 HOLDI 1720
CSRN22 EXSR COMMAS 1730
CSR SETOF 24 1740
CSRN23 MOVEAFACT3 HOLDI 1750
CSRN23 EXSR COMMAS 1760
CSR ENDSR 1770
C***************************************************** OCARD 1780
CSR OCARD BEGSR 1790
CSR MOVEAFACT1 HOLDI 1800
CSR EXSR COMMAS 1810
CSR ENDSR 1820
C/COPY R1,AUX005 1830
C****************************************************** DOIT 1840
CSR DOIT BEGSR 1850
CSR EXCPT 1860
CSR ENDSR 1870
C***************************************************** INDIC 1880
C* SCAN 3 REMAINING INDICATOR POSITIONS IN 1890
C* 'O' SPECS AND 6 IN 'I' AND 'C' SPECS FOR 1900
C* PRESENCE OF AN INDICATOR. OUTPUT 1 RECORD 1910
C* FOR EACH FOUND. 1920
CSR INDIC BEGSR 1930
CSR A SUB A A 10 1940
CSR LOOPA TAG 1950
CSR 1 ADD A A 1960
CSR 07 A COMP 3 18 1970
CSRN07 A COMP 6 18 1980
CSRN18 IND,A COMP ' ' 13 1990
CSRN18 13 MOVE '9' RECCD 2000
CSRN18 13 MOVELIND,A FLDIND 2010
CSRN18 13 EXCPT 2020
CSRN18 GOTO LOOPA 2030
CSR ENDSR 2040
C****************************************************** 2050
OXREFFILEE 2060
O RECCD B 1 2070
O FLDIND B 7 2080
O LINE 11P 2090
O DATA80 91 2100
O 09 16 'C' 2110
** LEGIT ARRAY OF LEGITIMATE START CHARACTERS FOR FIELDS. 2110
ABCDEFGHIJKLMNOPQRSTUVWXYZ#$@ 2120