|
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: 6604 (0x19cc)
Types: s3xseg
Names: »SXRF60«
└─⟦811594a0b⟧ Bits:30009185 5702-sc1.V16.pgm
└─⟦8223a6838⟧
└─⟦this⟧ »SXRF60«
└─⟦990ba7470⟧ Bits:30009182 5702-PP1
└─⟦efad88270⟧
└─⟦this⟧ »SXRF60«
H C 012 XRF60 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* GENERATE QUERY FACILITY INPUT TABLE CARDS FROM 0070
F* RECDESGN LOADED BY XRF OR XRF41 AND UPDATED 0080
F* BY XRF43. 0090
F* 0100
FCARDIN IP F 96 MFCU1 0110
FRECDESGNISE F 960 96 DISK40 0120
FQERYTABLO F 96 96 MFCU2 0130
FPRINTER O F 132 OF PRINTER 0140
E NM 6 1 0150
E QT1 15 1 0160
IRECDESGNNS 01 1 CA 0170
I/COPY R1,AUX050 0180
I NS 02 1 CB 0190
I/COPY R1,AUX052 0200
I NS 03 1 CC 0210
I/COPY R1,AUX054 0220
I FLDNM 07
I QTITLE 08
I NS 04 1 C* 0230
I/COPY R1,AUX056 0240
I NS 05 0250
ICARDIN NS 06 0260
I 1 8 FILEDO 0270
C****************************************************** MAIN LINE 0280
C* SEE WHICH FILES TO PROCESS 0290
C 06 EXSR LODFIL 0300
C N13 MOVEL'ALL 'FILE,1 0310
C 01 EXSR CHKFIL 0320
C* PREVENT PROCESSING ALL RECORDS ASSOCIATED WITH A 0330
C* FILE WHICH ISN'T TO BE PROCESSED. 0340
C N21 SETOF 010203 0350
C N21 SETOF 04 0360
C* CONVERT RECORD DESIGN AID FORMATS TO QUERY FORMATS 0370
C 03N07 EXSR FORMAT 0380
C* 0390
C* CONVERT RDA EDIT CODE TO QUERY EDIT CODE 0400
C 03N07 EXSR EDIT 0410
C* 0420
C* CALCULATE REPORT HEADING PRINT POSITIONS 0430
C 03N07 EXSR HEDING 0440
C* 0450
C* CALCULATE DATA FIELD PRINT POSITIONS 0460
C 03N07 EXSR FLDPOS 0470
C* 0480
C* WHICH IS LONGER-DATA OR HEADING? 0490
C 03N07 EXSR PRPOS 0500
C* SET UP TO OUTPUT A NON-ARRAY FIELD RECORD. 0510
C 03N07 NOELE COMP 0 10 0520
C 03 10N07 Z-ADDFLDST BEGIN 30 0530
C 03 10N07 Z-ADDFLDEND STOP 30 0540
C 03 10N07 0550
COR 04 EXCPT 0560
C* DEVELOP FIELD NAME AND POSITIONS FOR ARRAY ELEMENTS. 0570
C 03N10N07 EXSR SIZIT 0580
C****************************************************** 0590
CLR MOVE '5798-NKG'COIBM 8 * 0600
CLR MOVE 'COPYRIGH'COIBM * 0610
CLR MOVE 'T IBM CO'COIBM * 0620
CLR MOVE 'RP. 1977'COIBM * 0630
C****************************************************** FORMAT 0640
CSR FORMAT BEGSR 0650
CSR PB COMP 'C' 17 0660
CSR 17 MOVE 'B' PB 0670
CSR PB COMP 'A' 10 0680
CSRN10 PB COMP 'L' 10 0690
CSR 10 MOVE 'C' PB 0700
CSR PB COMP 'N' 11 0710
CSRN11 PB COMP 'O' 11 0720
CSR 11 MOVE 'U' PB 0730
CSR PB COMP 'Q' 16 0740
CSR 16 MOVE 'P' PB 0750
CSR ENDSR 0760
C/COPY R1,AUX016 0770
C/COPY R1,AUX017 0780
C****************************************************** EDIT 0790
CSR EDIT BEGSR 0800
CSR SETOF 12 0810
CSR DECPS COMP '0' 10 0820
CSR 10 EDIT COMP 'Y' 11 0830
CSR 10 11 MOVE 'K' DECPS 0840
CSR 10 EDIT COMP 'N' 12 0850
CSR 10 12 MOVE 'J' DECPS 0860
CSR ENDSR 0870
C****************************************************** HEDING 0880
CSR HEDING BEGSR 0890
CSR 08 MOVELFLDNM QTITLE
CSR MOVEAQTITLE QT1 0900
CSR Z-ADD16 A 20 0910
CSR LOOPH TAG 0920
CSR A SUB 1 A 0930
CSR A COMP 0 1010 0940
CSRN10 QT1,A COMP ' ' 11 0950
CSRN10 11 GOTO LOOPH 0960
CSR Z-ADDA PRPOS 0970
CSR ENDSR 0980
C****************************************************** FLDPOS 0990
CSR FLDPOS BEGSR 1000
CSR Z-ADD0 FPOS 30 1010
CSR PB COMP 'C' 10 1020
CSR 10 EXSR CHAR 1030
CSRN10 EXSR NUM 1040
CSR ENDSR 1050
C****************************************************** CHAR 1060
CSR CHAR BEGSR 1070
CSR Z-ADDFLDLN FPOS 1080
CSR ENDSR 1090
C****************************************************** NUM 1100
CSR NUM BEGSR 1110
CSR DECPS COMP 'J' 10 1120
CSR 10 1 ADD FLDLN FPOS - SIGN ONLY 1130
CSR DECPS COMP 'K' 11 1140
CSR 11 2 ADD FLDLN FPOS DATE EDIT / / 1150
C* ADD IN NUMBER OF COMMAS AND PERIODS 1160
CSRN10N11 EXSR COMAS 1170
CSR ENDSR 1180
C****************************************************** COMAS 1190
CSR COMAS BEGSR 1200
C* CALCULATE PRINTED SIZE OF THE NUMBER WITH -. & ,, 1210
CSR FLDLN ADD 2 FPOS - AND . 1220
CSR FLDLN SUB 2 WHOLE 20 1230
CSR WHOLE DIV 3 WHOLE 1240
CSR MVR ANS 10 1250
CSR ANS COMP 0 10 1260
CSR 10 WHOLE SUB 1 WHOLE 1270
CSR WHOLE ADD FPOS FPOS 1280
CSR ENDSR 1290
C****************************************************** PRPOS 1300
CSR PRPOS BEGSR 1310
C* WHICH IS LARGER, PRINTED DATA FIELD OR IT'S HEADING 1320
CSR PRPOS COMP FPOS 10 1330
CSR 10 Z-ADDFPOS PRPOS 20 1340
CSR ENDSR 1350
C****************************************************** SIZIT 1360
CSR SIZIT BEGSR 1370
C* GENERATE UNIQUE NAME FOR EACH ELEMENT OF AN ARRAY. 1380
CSR Z-ADD0 C 30 1390
CSR Z-ADDFLDST BEGIN 30 1400
CSR FLDEND SUB FLDST LENGTH 30 1410
CSR LENGTH ADD 1 LENGTH 1420
CSR LENGTH DIV NOELE LENGTH 1430
CSR BEGIN SUB LENGTH BEGIN 1440
CSR FLDST SUB 1 STOP 30 1450
C* HOW BIG IS ARRAY 1460
CSR NOELE COMP 9 1111 1470
CSR NOELE COMP 99 1212 1480
CSR NOELE COMP 999 1818 1490
CSR 11 Z-ADD1 B 20 1500
CSR 12N11 Z-ADD2 B 1510
CSR 18N12 Z-ADD3 B 1520
CSR MOVEAFLDNM NM 1530
C* FIND END OF ARRAY NAME,I.E. WHERE TO ATTACH INDEX 1540
C* SUFFIX TO NAME. 1550
CSR EXSR NMLONG 1560
CSR LOOPNM TAG 1570
CSR 1 ADD C C 1580
CSR MOVE C C1 1 1590
CSR MOVE C C2 2 1600
CSR MOVE C C3 3 1610
CSR 11 MOVEAC1 NM,E 1620
CSR 12N11 MOVEAC2 NM,E 1630
CSR 18N12 MOVEAC3 NM,E 1640
CSR MOVEANM FLDNM 1650
CSR BEGIN ADD LENGTH BEGIN 1660
CSR STOP ADD LENGTH STOP 1670
CSR EXCPT 1680
CSR C COMP NOELE 15 1690
CSRN15 GOTO LOOPNM 1700
CSR ENDSR 1710
C****************************************************** NMLONG 1720
CSR NMLONG BEGSR 1730
C* FIND WHERE TO TACK THE INDEX SUFFIX ONTO THE NAME. 1740
C* TRUNCATE ORIGINAL ARRAY NAME, IF NECESSARY. 1750
CSR Z-ADD0 E 10 1760
CSR LOOP TAG 1770
CSR 1 ADD E E 1780
CSR NM,E COMP ' ' 14 1790
C* ADD THE SIZE OF THE INDEX SUFFIX (B) TO WHERE WE 1800
C* ARE NOW ANDSEE IF WE'RE UP TO POSITION 6 OR LESS. 1810
CSR B ADD E F 10 1820
C* IF A BLANK, I.E. END OF NAME, HASN'T BEEN FOUND 1830
C* SEE UF WE'RE UP TO 6 CHARACTERS. 1840
CSR F SUB 1 F 1850
CSRN14 F COMP 6 14 1860
CSRN14 GOTO LOOP 1870
C* FALL THROUGH WHEN A BLANK IS FOUND OR THE GENERATED 1880
C* NAME IS UP TO 6 CHARACTERS. 1890
CSR ENDSR 1900
C****************************************************** 1910
OQERYTABLE 03 1920
O/COPY R1,AUX073 1930
O *PRINT
OPRINTER H 202 01 21 1940
O OR OF 1950
O UDATE Y 8 1960
O 39 'QUERY FACILITY DICTIONAR' 1970
O 49 'Y FOR FILE' 1980
O FILNM 58 1990
O H 2 01 21 2000
O OR OF 2010
O 9 'DATA NAME' 2020
O 16 'SIZE' 2030
O 23 'NO DEC' 2040
O 35 'PRINT POS' 2050
O 55 'REPORT HEADING' 2060
O 71 'DESCRIPTION' 2070
O EF 1 03 2080
O FLDNM 6 2090
O FLDLN Z 16 2100
O QTITLE 56 2110
O PRPOS Z 31 2120
O FLDDS B 90 2130
O DECPS 21 2140
O E 1 04 2150
O FLDDS B 90 2160