|
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: 9906 (0x26b2)
Types: s3xseg
Names: »SXRF43«
└─⟦811594a0b⟧ Bits:30009185 5702-sc1.V16.pgm
└─⟦8223a6838⟧
└─⟦this⟧ »SXRF43«
└─⟦990ba7470⟧ Bits:30009182 5702-PP1
└─⟦efad88270⟧
└─⟦this⟧ »SXRF43«
H C 014 XRF43 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: * 0080
F* 1. READS A FILE OF FILE/RECORD/FIELD DESCRIPTORS * 0090
F* PRODUCED BY XRF40 OR 41. * 0100
F* 2. PRODUCES THE RECORD LAYOUT. * 0110
F* 3. OUTPUTS A FILE OF THE RECORD INPUT SPECS * 0120
F* 'SRCEINSP' FOR $MAINT TO PUT INTO THE SOURCE * 0130
F* LIBRARY. * 0140
F* 4. OUTPUTS A FILE OF THE RECORD OUTPUT SPECS * 0150
F* -SORCEOUT-IF A BOOK NAME IS GIVEN, FOR $MAINT * 0160
F* TO PUT INTO THE SOURCE LIBRARY. * 0170
F* 5. OUTPUTS THE FILE OUTPSN (ON U2) TO BE USED BY * 0180
F* XRF50 TO CORRECT OUTPUT POSITION OF DISK * 0190
F* FIELDS IN SOURCE PROGRAMS. * 0200
F* 6. PRINTS QUERY TITLES ON THE RECORD LAYOUT-ON U1* 0210
F* 7. OUTPUTS THE FILE DICTFILE TO BE USED BY XRF19 * 0220
F* TO PRODUCE THE I/O DATA DICTIONARY. * 0230
F* 8. UPDATES THE INPUT FILE RECDESGN WITH THE CALC-* 0240
F* ULATED START-END POSITION OF THE FIELD FOR USE* 0250
F* BY INTERFACE PROGRAMS. * 0260
F* 9. PROCESSES UP TO 5 SELECTED FILES OR ALL FILES.* 0270
F*********************************************************** 0280
FCARDIN IP F 192 96 MFCU1 0290
FRECDESGNUSE F 192 96 DISK40 0300
FPRINTER O F 132 132 OF PRINTER 0310
FSRCEINSPO F 192 96 DISK 0320
FSORCEOUTO F 192 96 DISK 0330
FOUTPSN UC F 19 19R14AI 1 DISK40 A U2 0340
FDICTFILEO F 240 60 DISK 0350
FFILEDICTO F 192 96 DISK 0360
IRECDESGNNS 01 1 CA 0370
I/COPY R1,AUX050 0380
I PKGDS 07 0390
I 1 96 DATA96L1 0400
I NS 02 1 CB 0410
I/COPY R1,AUX052 0420
I RECNM 11 0430
I RECOUT 10 0440
I 1 96 DATA96L1 0450
I NS 03 1 CC 0460
I/COPY R1,AUX054 0470
I FLDNM 76 0480
I FLDLN 78 0490
I PB 86 0500
I OFSTA 74 0510
I NOELE 85 0520
I NS 04 1 C* 0530
I/COPY R1,AUX056 0540
I NS 09 0550
ICARDIN NS 12 0560
I 1 8 FILEDO 0570
IOUTPSN NS 0580
C L1 SETOF 08 0590
C 12 EXSR LODFIL 0600
C N13 MOVEL'ALL 'FILE,1 0610
C 01 EXSR CHKFIL 0620
C N21 SETOF 010203 0630
C N21 SETOF 04 0640
C EXSR DETINT 0650
C 02 EXSR RECCLR 0660
C 03 EXSR FLDREC 0670
C 04 1 ADD SEQNR SEQNR 0680
CL1 08 EXSR L1PROC 0690
C* 0700
C****************************************************** 0710
CLR MOVE '5798-NKG'COIBM 8 * 0720
CLR MOVE 'COPYRIGH'COIBM * 0730
CLR MOVE 'T IBM CO'COIBM * 0740
CLR MOVE 'RP. 1977'COIBM * 0750
C/COPY R1,AUX016 0760
C/COPY R1,AUX017 0770
C****************************************************** DETINT 0780
C* INITIALIZE FIELDS AND INIDCATORS AT DETAIL TIME 0790
CSR DETINT BEGSR 0800
CSR SETOF 778081 0810
CSR SETOF 828387 0820
CSR SETOF 8499 0830
CSR WRK04 SUB WRK04 WRK04 40 0840
CSR ENDSR 0850
C****************************************************** RECCLR 0860
C* INITIALIZE FIELDS AND INDICATORS AFTER L1 BREAK 0870
C* I.E. FOR A NEW RECORD TYPE. 0880
CSR RECCLR BEGSR 0890
CSRN07 MOVE PKGDS TITLE 28 0900
CSR WRK06 SUB WRK06 WRK06 40 0910
CSR WRK09 SUB WRK09 WRK09 0920
CSR WRK02 SUB WRK02 WRK02 30 0930
CSR MOVE 0001 WRK01 0940
CSR MOVE 0001 FROM 40 0950
CSR ENDSR 0960
C****************************************************** FLDREC 0970
C* PROCESS A 'C' OR FIELD DESCRIPTOR RECORD 0980
CSR FLDREC BEGSR 0990
CSR SETON 08 1000
C* CONTROLS SEQUENCE NUMBERING OF MULTIPLE '*' CARDS. 1010
CSR Z-ADD0 SEQNR 20 1020
CSR EXSR LENGTH 1030
CSR EXSR CKOFST 1040
CSR EXSR DECPOS 1050
CSRN76 EXSR OUTCHK 1060
CSR ENDSR 1070
C****************************************************** LENGTH 1080
C* TEST FOR DATA FORMAT AND COMPUTE LENGTH 1090
CSR LENGTH BEGSR 1100
CSR PB COMP 'B' 80 1110
CSRN80 PB COMP 'C' 80 1120
CSR PB COMP 'N' 81 1130
CSRN81 PB COMP 'O' 81 1140
CSR PB COMP 'P' 82 1150
CSRN82 PB COMP 'Q' 82 1160
CSR PB COMP 'A' 83 1170
CSRN83 PB COMP 'L' 83 1180
CSR 80 EXSR BINARY 1190
CSR 81 EXSR NUM 1200
CSR 82 EXSR PACK 1210
CSR 83 EXSR ALFA 1220
CSRN80N81N82 1230
CANN83 SETON 86 1240
CSR 81 1250
COR 82 FLDLN COMP 15 87 1260
CSR 83 FLDLN COMP 256 87 1270
CSR 84 FLDLN COMP 9 87 1280
CSR 85 EXSR ARRAY 1290
CSR ENDSR 1300
C****************************************************** NUM 1310
C* COMPUTE STRAIGHT NUMERIC FIELD BYTE LENGTH 1320
CSR NUM BEGSR 1330
CSR MOVE FLDLN WRK04 1340
CSR ENDSR 1350
C****************************************************** PACK 1360
C* COMPUTE PACKED FIELD BYTE LENGTH 1370
CSR PACK BEGSR 1380
CSR FLDLN ADD 2 WRK07 30 1390
CSR WRK07 DIV 2 WRK04 1400
CSR ENDSR 1410
C****************************************************** ALFA 1420
C* COMPUTE ALPHA FIELD BYTE LENGTH 1430
CSR ALFA BEGSR 1440
CSR MOVE FLDLN WRK04 1450
CSR ENDSR 1460
C****************************************************** BINARY 1470
C* COMPUTE BINARY FIELD LENGTH 1480
CSR BINARY BEGSR 1490
CSR FLDLN COMP 4 84 1500
CSR MOVE 2 WRK04 1510
CSR 84 MOVE 4 WRK04 1520
CSR ENDSR 1530
C****************************************************** ARRAY 1540
C* COMPUTE BYTE LENGTH OF AN ARRAY 1550
CSR ARRAY BEGSR 1560
CSR NOELE MULT WRK04 WRK04 1570
CSR ENDSR 1580
C****************************************************** CKOFST 1590
C* COMPUTE OFFSET, IF REQUIRED 1600
CSR CKOFST BEGSR 1610
CSR 78 1620
COR 86 1630
COR 87 WRK04 SUB WRK04 WRK04 1640
CSR 74 EXSR NOOFST 1650
CSRN74 EXSR OFFSET 1660
CSR ENDSR 1670
C****************************************************** NOOFST 1680
C* COMPUTE FROM AND TO WITH NO OFFSET 1690
CSR NOOFST BEGSR 1700
CSR WRK02 ADD WRK01 WRK01 40 1710
CSR MOVE WRK01 FROM 1720
CSR MOVE WRK04 WRK02 1730
CSR WRK06 ADD WRK02 WRK06 1740
CSR MOVE WRK06 TO 40 1750
CSR ENDSR 1760
C****************************************************** OFFSET 1770
C* COMPUTE FROM AND TO IF THERE IS OFFSET 1780
CSR OFFSET BEGSR 1790
CSR OFSET ADD WRK01 WRK08 40 1800
CSR MOVE WRK08 FROM 1810
CSR WRK04 ADD WRK08 WRK09 40 1820
CSR WRK09 SUB 1 WRK09 1830
CSR MOVE WRK09 TO 1840
CSR ENDSR 1850
C****************************************************** DECPOS 1860
C* DETERMINE IF DEC POSITIONS ARE REQUIRED 1870
CSR DECPOS BEGSR 1880
CSR 83 DECPS COMP ' ' 7777 1890
CSR 80 1900
COR 81 1910
COR 82 DECPS COMP '0' 77 1920
CSR ENDSR 1930
C****************************************************** OUTCHK 1940
C* SEE IF THIS FIELD HAS ALREADY BEEN WRITTEN TO OUTPSN 1950
CSR OUTCHK BEGSR 1960
CSR MOVELFILNM KEYOUT 14 1970
CSR MOVE FLDNM KEYOUT 1980
CSR KEYOUT CHAINOUTPSN 99 1990
CSR ENDSR 2000
C****************************************************** L1PROC 2010
C* L1 PROCESSING. COMPUTE LENGTH AVAILABLE, IF ANY 2020
CSR L1PROC BEGSR 2030
CSR WRK09 COMP WRK06 73 2040
CSR RECLN SUB WRK06 WRK05 40 79 2050
CSR 73 RECLN SUB WRK09 WRK05 79 2060
CSR WRK06 ADD 1 WRK01 2070
CSR 73 WRK09 ADD 1 WRK01 2080
CSR ENDSR 2090
C****************************************************** 2100
OPRINTER H 203 02 2110
O OR OFN02 2120
O TITLE 63 2130
O H 2 02 2140
O OR OFN02 2150
O 60 'R E C O R D L I S T I N' 2160
O 62 'G' 2170
O H 1 02 2180
O OR OFN02 2190
O 16 'RECORD I-' 2200
O RECNM 22 2210
O 37 'RECORD DESCR-' 2220
O RECDS 67 2230
O 77 '***KEY***' 2240
O H 1 02 2250
O OR OFN02 2260
O 16 'O-' 2270
O RECOUT 22 2280
O 37 'FILE DESCR---' 2290
O FILDS 67 2300
O 73 '*POS-' 2310
O KEYST Z 77 2320
O H 1 02 2330
O OR OFN02 2340
O 14 'FILE---' 2350
O FILNM 22 2360
O 30 'MEDIA-' 2370
O DEVICE 37 2380
O 42 'RECL-' 2390
O RECLN Z 46 2400
O 54 'TYPE-' 2410
O FILTP 57 2420
O 62 'SEQ-' 2430
O SEQ 65 2440
O 73 '*LEN-' 2450
O KEYLN Z 77 2460
O H 1 02 2470
O OR OFN02 2480
O 31 '------------------------' 2490
O 55 '------------------------' 2500
O 73 '------------------' 2510
O U1 88 '-----------------' 2520
O H 1 02 2530
O OR OFN02 2540
O 12 'FIELD' 2550
O 34 'FMT POSITION NO NO' 2560
O 40 'FLD' 2570
O 51 'FIELD' 2580
O U1 80 'QUERY' 2590
O H 1 02 2600
O OR OFN02 2610
O 11 'NAME' 2620
O 40 'FROM TO BYTE ELEM LTH' 2630
O 54 'DESCRIPTION' 2640
O U1 80 'TITLE' 2650
O H 1 02 2660
O OR OFN02 2670
O 31 '------------------------' 2680
O 55 '------------------------' 2690
O 73 '------------------' 2700
O U1 88 '-----------------' 2710
O D 1 03 2720
O FLDNM 13 2730
O PB 15 2740
O 86 15 '-' 2750
O FROM Z 21 2760
O 78 21 ' ' 2770
O 86 21 ' ' 2780
O 87 21 ' ' 2790
O TO Z 25 2800
O 78 25 ' ' 2810
O 86 25 ' ' 2820
O 87 25 ' ' 2830
O N74 27 'Y' 2840
O WRK04 Z 29 2850
O 78 29 ' ' 2860
O 86 29 ' ' 2870
O 87 29 ' ' 2880
O NOELE Z 35 2890
O FLDLN Z 40 2900
O 78 40 '-------' 2910
O N83 41 ',' 2920
O DECPS 42 2930
O 78 43 '1' 2940
O 86 45 '1' 2950
O 87 46 '4' 2960
O FLDDS 73 2970
O U1 QTITLE 90 2980
O D 1 04 2990
O FLDDS 73 3000
O T 1 L1 08 21 3010
O WRK05 L 41 3020
O 67 '---- BYTES AVAILABLE ---' 3030
O T 2 L1 79 08 3040
O AND 21 3050
O 28 'COMPUTED RECORD LENGTH' 3060
O 51 'LONGER THAN STATED REC' 3070
O 61 'ORD LENGTH' 3080
OSRCEINSPD 02N11 3090
O 23 '// COPY LIBRARY-S,NAME-' 3100
O RECNM 29 3110
O D 02N11 3120
O 7 'I*' 3130
O RECDS 39 3140
O D 03N11N76 3150
O 6 'I' 3160
O N81N83 PB 43 3170
O FROM Z 47 3180
O TO Z 51 3190
O N85 DECPS 52 3200
O FLDNM 58 3210
O T L1 08N11 3220
O AND 21 3230
O 7 '// CEND' 3240
OSORCEOUTD 02N10 3250
O 23 '// COPY LIBRARY-S,NAME-' 3260
O RECOUT 29 3270
O D 02N10 3280
O 7 'O*' 3290
O RECDS 39 3300
O D 03N76N10 3310
O 6 'O' 3320
O N81N83 PB 44 3330
O TO Z 43 3340
O FLDNM 37 3350
O T L1 08N10 3360
O AND 21 3370
O 7 '// CEND' 3380
OOUTPSN DADD 03 99 U2 3390
O FILNM 8 3400
O FLDNM 14 3410
O TO 18 3420
O N81N83 PB 19 3430
ODICTFILED 03 3440
O OR 04 3450
O FLDNM 6 3460
O FILNM 14 3470
O RECNM 20 3480
O SEQNR 22 3490
O 03 NOELE 26 3500
O 03 FLDLN 29 3510
O 03 DECPS 30 3520
O FLDDS 60 3530
ORECDESGND 02 3540
O OR 03 3550
O OR 04 3560
O FILNM 9 3570
O 03 FROM 80 3580
O TO 84 3590
OFILEDICTD 01 3600
O OR 02 3610
O DATA96 96 3620