|
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: 4572 (0x11dc)
Types: s3xseg
Names: »SXRF03«
└─⟦811594a0b⟧ Bits:30009185 5702-sc1.V16.pgm
└─⟦8223a6838⟧
└─⟦this⟧ »SXRF03«
└─⟦990ba7470⟧ Bits:30009182 5702-PP1
└─⟦efad88270⟧
└─⟦this⟧ »SXRF03«
H C 014 XRF03 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* READS THROUGH THE FILE OF COMPLETE SOURCE PROGRAMS 0070
F* READING HARD-CODE 'E', 'I', 'C', AND 'O' SPECS 0080
F* AND ALL COPIED IN SPECS-EXCEPT 'I'- TO BUILD A 0090
F* FILE OF TRULY REFERENCED FIELD NAMES. 0100
F* USED BY XRF11, 13, 14, 18 TO DETERMINE IF COPIED 0110
F* IN INPUT FIELD NAMES ARE TRULY REFERENCED IN A PROGRAM. 0120
F****************************************************** 0130
F* 0140
FPROGRAMSIP F 960 96 DISK40 0150
FREFFILE O F 252 12 12AI 1 DISK40 U 0160
FSLIBRFILIC F 92R12AI 81 DISK40 U1 0170
E CODES 15 15 5 0180
E LEGIT 29 29 1 0190
E FLD 500 6 0200
E IND 6 2 0210
IPROGRAMSNS 01 1 C/ 7 CY 0220
I OR 97 7 C* 0230
I OR 1 C* 2NC* 0240
I OR 03 1 C* 2 C* 0250
I OR 1 C/ 2 C/ 0260
I NS 04 6 CE 27NC 0270
I/COPY R1,AUX092 0280
I TAB2 21 0290
I NS 05 6 CI 53NC 0300
I/COPY R1,AUX094 0310
I NS 06 6 CC 0320
I/COPY R1,AUX096 0330
I FACTC1 21 0340
I FACTC2 22 0350
I FACT3 23 0360
I NS 07 6 CO 32NC 32NC* 0370
I/COPY R1,AUX098 0380
I NS 08 6 CH 0390
I/COPY R1,AUX088 0400
I NS 09 7 C/ 8 CC 0410
I/COPY R1,AUX086 0420
I NS 10 0430
ISLIBRFILNS 97 7 C* 0440
I NS 04 6 CE 27NC 0450
I/COPY R1,AUX092 0460
I TAB2 21 0470
I NS 06 6 CC 0480
I/COPY R1,AUX096 0490
I FACTC1 21 0500
I FACTC2 22 0510
I FACT3 23 0520
I NS 07 6 CO 32NC 32NC* 0530
I/COPY R1,AUX098 0540
I NS 10 0550
C****************************************************** MAIN LINE 0560
C* GET SET UP FOR THE NEXT PROGRAM. 0570
C 01 EXSR JOBCLR 0580
C 08 MOVE PROGRM PRGSAV 6 0590
C* BYPASS ** AND // CARDS AND ALL AFTER THEM - I.E. 0600
C* COMP TIME TABLES AND NON-PROGRAMS. 0610
C 03 SETON 20 0620
C* PROCESS RECORDS AS APPROPRIATE 0630
C N09N20 EXSR GETTYP 0640
C 09N20 U1 EXSR COPI 0650
C* 0660
C****************************************************** 0670
CLR MOVE '5798- 'COIBM 8 * 0680
CLR MOVE 'COPYRIGH'COIBM * 0690
CLR MOVE 'T IBM CO'COIBM * 0700
CLR MOVE 'RP. 1973'COIBM * 0710
CLR MOVE ',1977' COIBM * 0720
C****************************************************** JOBCLR 0730
CSR JOBCLR BEGSR 0740
C* CLEAR FLD ARRAY OF FIELD NAMES AT START OF SOURCE PROGRAM. 0750
C* USED TO AVOID PUTTING OUT DUPLICATE RECORDS IN 0760
C* REFFILE. 0770
CSR SETOF 20 0780
CSR A SUB A A 30 0790
CSR LOOP TAG 0800
CSR 1 ADD A A 0810
CSR A COMP 500 17 0820
CSRN17 FLD,A COMP ' ' 25 0830
CSRN17 MOVE ' ' FLD,A 0840
CSRN17N25 GOTO LOOP 0850
CSR A SUB A A 0860
CSR LINE SUB LINE LINE 72 0870
CSR ENDSR 0880
C****************************************************** GETTYP 0890
CSR GETTYP BEGSR 0900
CSR 04 EXSR ECARD 0910
C* NOTE - COPIED IN INPUT SPECS FROM SLIBRFIL ARE NOT 0920
C* PROCESSED AS THEY DO NOT CONSTITUTE A TRUE REFERENCE 0930
C* TO THE FIELD NAME. 0940
CSR 05 EXSR ICARD 0950
CSR 06 EXSR CCARD 0960
CSR 07 EXSR OCARD 0970
CSR ENDSR 0980
C/COPY R1,AUX004 0990
C****************************************************** ECARD 1000
CSR ECARD BEGSR 1010
CSR MOVE TAB1 FLDIND 1020
CSR EXSR DOIT 1030
CSRN21 MOVE TAB2 FLDIND 1040
CSRN21 EXSR DOIT 1050
CSR ENDSR 1060
C****************************************************** ICARD 1070
CSR ICARD BEGSR 1080
CSR MOVEAFACT1 HOLDI 1090
CSR EXSR COMMAS 1100
CSR ENDSR 1110
C****************************************************** CCARD 1120
CSR CCARD BEGSR 1130
CSR SETON 24 1140
C* SEE IF THIS OPCODE HAS TRUE FIELD NAMES 1150
CSR OPCODE LOKUPCODES 11 1160
CSR 11 GOTO ENDC 1170
CSRN21 MOVEAFACTC1 HOLDI 1180
CSRN21 EXSR COMMAS 1190
CSRN22 MOVEAFACTC2 HOLDI 1200
CSRN22 EXSR COMMAS 1210
CSR SETOF 24 1220
CSRN23 MOVEAFACT3 HOLDI 1230
CSRN23 EXSR COMMAS 1240
CSR ENDC ENDSR 1250
C****************************************************** OCARD 1260
CSR OCARD BEGSR 1270
CSR MOVEAFACT1 HOLDI 1280
CSR EXSR COMMAS 1290
CSR ENDSR 1300
C/COPY R1,AUX005 1310
C****************************************************** DOIT 1320
C* ADD THIS FIELD TO THE FLD ARRAY AND OUTPUT IT TO 1330
C* THE REFFILE IF IT IS THE FIRST OCCURRENCE OF IT. 1340
CSR DOIT BEGSR 1350
CSR FLDIND LOKUPFLD 25 1360
CSRN25 1 ADD A A 1370
CSRN25 MOVE FLDIND FLD,A 1380
CSRN25 MOVE PRGSAV PROGRM 1390
CSRN25 EXCPT 1400
CSR ENDSR 1410
C****************************************************** 1420
OREFFILE E 1430
O/COPY R1,AUX077 1440
** CODES ARRAY OF OPCODES THAT HAVE NO FIELDS IN THE CARD 1440
GOTO BEGSRTAG ENDSREXSR SETONSETOFEXIT EXCPTFORCEREAD 1450
** LEGIT ARRAY OF LEGITIMATE START CHARACTERS FOR FIELDS. 1450
ABCDEFGHIJKLMNOPQRSTUVWXYZ#$@ 1460