|
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: 3556 (0xde4)
Types: s3xseg
Names: »SXRF14«
└─⟦811594a0b⟧ Bits:30009185 5702-sc1.V16.pgm
└─⟦8223a6838⟧
└─⟦this⟧ »SXRF14«
└─⟦990ba7470⟧ Bits:30009182 5702-PP1
└─⟦efad88270⟧
└─⟦this⟧ »SXRF14«
H C 014 XRF14 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* BUILD FILE OF FIELD NAMES WITH SIZE FOR SORT AT 0070
F* XRF15 AND PRINTING THE GLOSSARY AT XRF16. 0080
F* 0090
FSORCDECKIP F2520 84 DISK40 0100
FREFFILE IC F 12R12AI 1 DISK40 0110
FFIELDS O F2544 24 DISK40 0120
E EXT 99 6 0130
E CHEK 6 1 0140
E IND 6 2 0150
ISORCDECKNS 01 6 CE 75NC 0160
I/COPY R1,AUX138 0170
I TAB2 21 0180
I NS 02 6 CI 75NC 0190
I/COPY R1,AUX140 0200
I NS 03 6 CC 43NC 75NC 0210
I/COPY R1,AUX142 0220
I NS 04 6 CH 75NC 0230
I/COPY R1,AUX088 0240
I NS 0250
IREFFILE NS 0260
C****************************************************** MAIN LINE 0270
C 04 A SUB A A 20 0280
C 04 GOTO END 0290
C* BUILD AN ARRAY OF UP TO 99 NAMES DEFINED IN EXTENSION SPECS. 0300
C 01 EXSR ARRBLD 0310
C* ON AN 'I' OR 'C' SPEC SEE IF THE FIELD NAME WAS 0320
C* PREVIOUSLY DEFINED IN AN 'E' SPEC. 0330
C 02 0340
COR 03 EXSR CKENAM 0350
C* 12 ON MEANS THIS IS A NEW FIELD DEFINITION, NOT 0360
C* PREVIOUSLY SEEN IN THE 'E' SPECS. IN THE CASE OF 0370
C* INPUT SPECS -02- SEE IF IT'S COPIED IN AND IF IT'S 0380
C* REFERENCED ELSEWHERE IN THE PROGRAM. 0390
C 02 12 EXSR REF 0400
C* THIS IS A HARD-CODED OR COPIED BUT REFERENCED, 'I' 0410
C* SPEC. CALCULATE IT'S LENGTH. 0420
C 02 12N99 EXSR LENGTH 0430
C N01 Z-ADD0 NOELE 0440
C 02 12N99 0450
COR 03 12 EXCPT 0460
C END TAG 0470
C* 0480
C****************************************************** 0490
CLR MOVE '5798-NKG'COIBM 8 * 0500
CLR MOVE 'COPYRIGH'COIBM * 0510
CLR MOVE 'T IBM CO'COIBM * 0520
CLR MOVE 'RP. 1977'COIBM * 0530
C****************************************************** 0540
C* 0550
C****************************************************** ARRBLD 0560
C* BUILD AN ARRAY OF FIELD NAMES DEFINED IN 'E' SPECS. 0570
C* 'E' SPECS ARE TREATED AS DEFINED, WHETHER COPIED 0580
C* IN OR NOT, WHETHER REFERENCED ELSEWHERE OR NOT, 0590
C* SINCE THEY ARE TREATED THIS WAY BY THE COMPILER. 0600
CSR ARRBLD BEGSR 0610
CSR 1 ADD A A 0620
CSR MOVE TAB1 EXT,A 0630
CSR MOVE TAB1 FIELD 6 0640
CSR EXCPT 0650
CSRN21 1 ADD A A 0660
CSRN21 MOVE TAB2 EXT,A 0670
CSRN21 MOVE TAB2 FIELD 0680
CSRN21 MOVE LONGA LONG 0690
CSRN21 MOVE DECPS2 DECPS 0700
CSRN21 EXCPT 0710
CSR ENDSR 0720
C****************************************************** CKENAM 0730
C* ROUTINE TO CHECK INPUT AND CALC SPEC RESULT FIELD 0740
C* NAMES AGAINST ARRAY OF NAMES DEFINED IN EXTENSION 0750
C* SPECS TO INSURE AGAINST DERIVING A SECOND, INCORRECT 0760
C* DEFINITION OF THE FIELD'S CHARACTERISTICS. 0770
CSR CKENAM BEGSR 0780
CSR 02 MOVE FACT1 FIELD 0790
CSR 03 MOVE FACT3 FIELD 0800
CSR MOVEAFIELD CHEK 0810
CSR SETOF 08 0820
CSR SETON 12 0830
C* PRESENCE OF A COMMA SAYS THE FIELD IS AN ARRAY 0840
C* ELEMENT--SKIP IT. 0850
CSR ',' LOKUPCHEK 07 0860
CSR Z-ADD1 B 20 0870
C* IS THE FIELD NAME IN THE EXT ARRAY WITHIN THE 0880
C* RANGE PUT THERE FOR THIS PROGRAM. 0890
CSRN07 FIELD LOKUPEXT,B 08 0900
CSR 08N07 B COMP A 0808 0910
CSR 07 0920
COR 08 SETOF 12 0930
CSR ENDSR 0940
C***************************************************** REF 0950
CSR REF BEGSR 0960
CSR COPY COMP 'C' 09 0970
CSR 09 MOVELPROGRM KEY 12 0980
CSR 09 MOVE FIELD KEY 0990
CSR 09 KEY CHAINREFFILE 99 1000
CSRN09 SETOF 99 1010
CSR ENDSR 1020
C/COPY R1,AUX010 1030
C/COPY R1,AUX011 1040
C****************************************************** 1050
OFIELDS E 1060
O/COPY R1,AUX065 1070