|
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: 3048 (0xbe8)
Types: s3xseg
Names: »SXRF51«
└─⟦811594a0b⟧ Bits:30009185 5702-sc1.V16.pgm
└─⟦8223a6838⟧
└─⟦this⟧ »SXRF51«
└─⟦990ba7470⟧ Bits:30009182 5702-PP1
└─⟦efad88270⟧
└─⟦this⟧ »SXRF51«
H C 12 XRF51 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* THIS PROGRAM IS RUN AFTER XRF50 INITIALIZES THE FILE. 0070
F* 0080
F* THIS PROGRAM CREATES THE IDXDESGN AND DIRDESGN FILES FROM 0090
F* THE RECDESGN FILE. 0100
F* 0110
FRECDESGNIP 96 DISK40 0120
FIDXDESGNIC 96R 8AI 2 DISK40 A 0130
FDIRDESGNUC 96R DISK40 0140
FPRINT O 132 PRINTER 0150
IRECDESGNAA 01 1 CA 0160
I OR 02 1 CB 0170
I OR 1 CC 0180
I OR 1 C* 0190
I OR 05 0200
I 1 96 DETLBC 0210
I 2 9 FILNM L1 0220
I AB ** 0230
I 1 1 NXTCD 0240
I 2 9 NINES 0250
IIDXDESGNBB 06 0260
IDIRDESGNCC 07 1 CH 0270
I OR 08 0280
I 91 960RRNO 07 0290
C* PUT 'A' RECORDS IN THE IDXDESGN FILE. 0300
C* PUT 'B','C' AND '*' RECORDS IN THE DIRDESGN FILE. 0310
C* 0320
C 09 SETON 14 0330
C N09 EXSR FIRST 0340
C 01 GOTO RECA 0350
C 05 0360
COR 12 GOTO END 0370
C GOTO RECB 0380
C* 0390
C RECA TAG 0400
C* 0410
C SETOF 12 SETOF BYPASS 0420
C FILNM CHAINIDXDESGN 11 N/F ENABLE WRTE 0430
C 06 SETON 11 BYPASS DUP REC. 0440
C NL1 SETOF 11 NO 'A' RECORD 0450
C NL1 SETON 12 0460
C 11 EXCPT 0470
C GOTO END 0480
C* 0490
C RECB TAG 0500
C* 0510
C RRNO CHAINDIRDESGN 98 98 FILE FULL 0520
C RRNO ADD 1 RRNO 0530
C 98 SETON LR 0540
C L1 SETOF 08 MISSING A REC. 0550
C L1 RRNO SUB 1 RRNO RESTORE RRNO 0560
C 08 NXTCD COMP 'A' 13 NEXT IS A REC. 0570
C 08 NINES COMP '99999999' 15 E.O.F. 0580
C 08 EXCPT 0590
C* 0600
C END TAG 0610
C* 0620
CLR RRNO SUB 1 RRNOH 60 0630
CLR 1 CHAINDIRDESGN 99 REPLACE RRNO 0640
CLR EXCPT 0650
C* 0660
C****************************************************** 0670
CLR MOVE '5798-NKG'COIBM 8 0680
CLR MOVE 'COPYRIGH'COIBM 0690
CLR MOVE 'T IBM CO'COIBM 0700
CLR MOVE 'RP. 1977'COIBM 0710
C****************************************************** 0720
C* THIS ROUTINE CHECKS THAT FILES ARE INITIALIZED. 0730
C* 0740
CSR FIRST BEGSR 0750
CSR 1 CHAINDIRDESGN 10 0760
CSR 07 RRNO COMP 000001 09 GOOD FILES 0770
CSR 07 09 RRNO ADD 1 RRNO 0780
CSRN09 SETON LR05 BAD FILES,BYPASS 0790
CSRN09 SETOF 01 0800
CSR ENDSR 0810
OPRINT D 2 01 06 0820
O DETLBC 96 0830
O 113 'DUPLICATE RECORD' 0840
O D 01 98 0850
O 21 'DIRDESGN FILE IS FULL' 0860
O D 2 L1 02 0870
O DETLBC 96 0880
O 113 'NO A TYPE RECORD' 0890
O D 201 07N14 0900
O 46 'BUILDING IDXDESGN AND' 0910
O 60 'DIRFILE FILE' 0920
O T 3 LRN09 0930
O 21 'FILES NOT INITIALIZED' 0940
OIDXDESGNEADD 01 11 0950
O DETLBC 96 0960
O RRNO 15 0970
ODIRDESGNE 02 08 0980
O DETLBC 96 0990
O RRNO 96 1000
O 13 96 '000000' 1010
O 15 96 '000000' 1020
O E LR 09 1030
O RRNOH 96 1040