./ ADD SSI=01010723,NAME=IKFCBL00,SOURCE=0 *$MODULE IKFCBL00 00020021 PH00 TITLE 'IKFCBL00' 00040021 PRINT ON,GEN,DATA 00060021 * 00080021 * 00100021 *TITLE: 00120021 * 00140021 * 'IKFCBL00' 00160021 * 00180021 *STATUS: 00200021 * 00220021 * CHANGE LEVEL 000 00240021 * 00260021 *FUNCTION/OPERATION : ACTS AS THE INTERFACE BETWEEN COMPILER AND TH 00280021 * OPERATING SYSTEM. HANDLES I/O CONTROL. PERFORMS PROCESSING AF 00300021 * EACH OF THE OTHER PHASES. RECEIVES CONTROL FROM OPERATING SYST 00320021 * AND, AT THE END OF COMPILATION, RETURNS CONTROL TO IT. MANIPUL 00340021 * TABLES AND PROVIDES (COMMON) A COMMUNICATION AREA. 00360021 * 00380021 *ENTRY POINTS 00400021 * 00420021 * 'IKFCBL00' 00440021 * 00460021 * 00480021 *INTERNAL INPUT: 00500021 * 00520021 * 00540021 * THE CALLING SEQUENCES FROM THE PHASES, EXCEPT FOR TAMER ROUTINE 00560021 * CALLS. THE CALLING SEQUENCE ARE: 00580021 * 00600021 * L REGISTER,A=(COS) BALR 0,REGISTER DC X'XY' 00620021 * X = FUNCTION PHASE WANTED Y = DATA SET SPECIFIED 00640021 * 00660021 *EXTERNAL INPUT: 00680021 * 00700021 * THE PARAMETERS FROM THE EXEC CONTROL CARD OR FROM THE CALL, LIN 00720021 * ATTACN, OR XCTL MACRO. 00740021 * 00760021 *OUTPUT 00780021 * 00800021 * NO OUTPUT 00820021 * 00840021 *EXTERNAL ROUTINES 00860021 * 00880021 * NONE 00900021 * 00920021 *EXITS-NORMAL: 00940021 * 00960021 * RETURN TO OPERATING SYSTEM BY RETURN MACRO 00980021 * 01000021 *EXITS-ERROR: 01020021 * RETURN MACRO, STOP COMPILATION AND PRINT REASON FOR TERMINATION 01040021 * 01060021 *TABLE/WORK AREAS: 01080021 * 01100021 * NOT REQUIRE ANY TABLE AREA. SMALL WORK AREAS START AT 'FORMAT' 01120021 * SCATTERED ALL OVER IN PHASE 00. 01140021 * 01160021 *ATTRIBUTES: 01180021 * 01200021 * NOT REUSABLE. 01220021 * 01240021 * 01260021 *NOTES: 01280021 * 01300021 * GENERAL ORGANIZATION: 01320021 * 1. EQU'S 01340021 * 2. TAMER-ACCESS CONSTANTS, AND TAMER ADCONS 01360021 * 3. COMMON TABLE SECTION 01380021 * 4. WORK AREA 01400021 * 5. BUFFER INITIALIZATION 01420021 * 6. SUBROUTINES 01440021 * 7. INTERLUDE PROCESSOR 01460021 * 8. LINKAGE PACKAGE 01480021 * 9. PHASE 00 INITIALIZATION AND CONTROLLER 01500021 * 10. TAMER MANAGEMENT ROUTINES 01520021 * 11. DATA -- TAMER ROUTIMES 01540021 * 12. CONSTANTS -- TESTING 01560021 * 01580021 * 01600021 * REGISTERS USAGE 01620021 * 01640021 * 0 WORK REGISTER 01660021 * 1 WORK REGISTER 01680021 * 2 WHERE TO PUT FROM ON ANY PUT (WRITE) 01700021 * 3 LENGTH FOR PUTN (WRITE) 01720021 * 4 WORK REGISTER 01740021 * 5 BASE REGISTER 01760021 * 6 POINTS TO BUFFER CONTROL BLOCK FOR LOGICAL I-O 01780021 * 7 POINTS TO BUFFER CONTROL BLOCK FOR PHYSICAL I-O 01800021 * 8 RETURN ADDRESS LESS 1 (LINKAGE PARAMETERS) 01820021 * 9 TO FILE POINTERS (POINT) FOR THIS OS 01840021 * 10 FILE NUMBER X 4 01860021 * 11 LINKAGE 01880021 * 12 LINKAGE 01900021 * 13 FOR LINK/RETURN OR FOR I-O REQUEST 01920021 * 14 LINKAGE, WORK REGISTER 01940021 * 15 LINKAGE, WORK REGISTER 01960021 * 01980021 * 02000021 * ERROR PROCESSING: 02020021 * IF AN ERROR THAT STOPS COMPILATION OCCURS, PHASE 00 ISSUES A 02040021 * RETURN MACRO TO RETURN TO THE OPERATING SUSTEM. WHEN PHASE 6 H 02060021 * FINISHED ITS PROCESSING, PHASE 00 PUTS A CODE INTO REGISTER 15 02080021 * INDICATING THE HIGHEST SOURCE PROGRAM ERROR SEVERITY LEVEL AND 02100021 * RETURNS TO THE OPERATING SYSTEM. 02120021 * 02140021 * 02160021 IKFCBL00 START 02180021 ENTRY START 02200021 * 02220021 R0 EQU 0 02240021 R1 EQU 1 02260021 R2 EQU 2 02280021 R3 EQU 3 02300021 R4 EQU 4 02320021 R5 EQU 5 02340021 R6 EQU 6 02360021 R7 EQU 7 02380021 R8 EQU 8 02400021 R9 EQU 9 02420021 R10 EQU 10 02440021 R11 EQU 11 02460021 R12 EQU 12 02480021 R13 EQU 13 02500021 R14 EQU 14 02520021 R15 EQU 15 02540021 PXOSTB EQU * 02560021 COS STM R14,R12,DX12(R13) 02580021 COSAA BALR R5,R0 ESTABLISH ADDRESSABILITY 02600021 USING *,R5 POINT TO SAVE AREA IN COS 02620021 USING TRMNATE,R4 02640021 CASAB B GO BRANCH AROUND CONSTANTS 02660021 * ACCESS- TAMER CONSTANTS AND WORK AREA 02680021 * 02700021 * FOLLOWING IS THE TAMER CONSTANT AREA. TIBS AND TAMMS ASSEMB 02720021 * HERE ARE ACCESSIBLE TO ACCESS, AND TO THE PHASE PROGRAMMER. 02740021 * 02760021 * AND CONSTANTS AREA 02780021 * TIB20 RESERVED FOR THE DICOT TABLE 02800021 DS 0F 02820021 TIB0 DC 2F'0' TABLE INFORMATION BLOCK NO 0 02840021 TIB1 DC 2F'0' TABLE INFORMATION BLOCK NO 1 02860021 TIB2 DC 2F'0' TABLE INFORMATION BLOCK NO 2 02880021 TIB3 DC 2F'0' TABLE INFORMATION BLOCK NO 3 02900021 TIB4 DC 2F'0' TABLE INFORMATION BLOCK NO 4 02920021 TIB5 DC 2F'0' TABLE INFORMATION BLOCK NO 5 02940021 TIB6 DC 2F'0' TABLE INFORMATION BLOCK NO 6 02960021 TIB7 DC 2F'0' TABLE INFORMATION BLOCK NO 7 02980021 TIB8 DC 2F'0' TABLE INFORMATION BLOCK NO 8 03000021 TIB9 DC 2F'0' TABLE INFORMATION BLOCK NO 9 03020021 TIB10 DC 2F'0' TABLE INFORMATION BLOCK NO 10 03040021 TIB11 DC 2F'0' TABLE INFORMATION BLOCK NO 11 03060021 TIB12 DC 2F'0' TABLE INFORMATION BLOCK NO 12 03080021 TIB13 DC 2F'0' TABLE INFORMATION BLOCK NO 13 03100021 TIB14 DC 2F'0' TABLE INFORMATION BLOCK NO 14 03120021 TIB15 DC 2F'0' TABLE INFORMATION BLOCK NO 15 03140021 TIB16 DC 2F'0' TABLE INFORMATION BLOCK NO 16 03160021 TIB17 DC 2F'0' TABLE INFORMATION BLOCK NO 17 03180021 TIB18 DC 2F'0' TABLE INFORMATION BLOCK NO 18 03200021 TIB19 DC 2F'0' TABLE INFORMATION BLOCK NO 19 03220021 TIB20 DC 2F'0' TABLE INFORMATION BLOCK NO 20 03240021 * 03260021 * TIBS 21 THROUGH 30 HAVE BEEN ADDED AS ------------------- 03280021 * EXTENSIONS TO THE PRESENT TIB AREA %TIBS 1 THROUGH 19, IN- 03300021 * CLUSIVE< IN THE BASIC TAMER PACKAGE. 03320021 * 03340021 * AS BEFORE TIB20 IS RESERVED,REPEAT RESERVED, FOR ACCESS. 03360021 * 03380021 TIB21 DC 2F'0' TABLE INFORMATION BLOCK NO 21 03400021 TIB22 DC 2F'0' TABLE INFORMATION BLOCK NO 22 03420021 TIB23 DC 2F'0' TABLE INFORMATION BLOCK NO 23 03440021 TIB24 DC 2F'0' TABLE INFORMATION BLOCK NO 24 03460021 TIB25 DC 2F'0' TABLE INFORMATION BLOCK NO 25 03480021 TIB26 DC 2F'0' TABLE INFORMATION BLOCK NO 26 03500021 TIB27 DC 2F'0' TABLE INFORMATION BLOCK NO 27 03520021 TIB28 DC 2F'0' TABLE INFORMATION BLOCK NO 28 03540021 TIB29 DC 2F'0' TABLE INFORMATION BLOCK NO 29 03560021 TIB30 DC 2F'0' TABLE INFORMATION BLOCK NO 30 03580021 TIB31 DC 2F'0' TABLE INFORMATION BLOCK NO 31 03600021 TIB32 DC 2F'0' TABLE INFORMATION BLOCK NO 32 03620021 TIB33 DC 2F'0' TABLE INFORMATION BLOCK NO 33 03640021 TIB34 DC 2F'0' TABLE INFORMATION BLOCK NO 34 03660021 TIB35 DC 2F'0' TABLE INFORMATION BLOCK NO 35 03680021 * 03700021 * THE FOLLOWING ARE TAMER ADCONS FOR THE VARIOUS ROUTINE NAMES 03720021 * 03740021 * 03760021 APRIME DC A(PRIME) TAMER ADDRESS CONSTANT 03780021 AINSRT DC A(INSERT) TAMER ADDRESS CONSTANT 03800021 ADSTAT DC A(STATIC) TAMER ADDRESS CONSTANT 03820021 RELADD DC A(TABREL) TAMER ADDRESS CONSTANT 03840021 TAMNAD DC A(TAMEIN) TAMER ADDRESS CONSTANT 03860021 ACCESW DC X'00' ACCESS INITIALIZATION SWITCH. 03880021 AMAINF DC AL3(0) TAMER ADDRESS CONSTANT 03900021 ALSTAM DC A(DICSPC) TAMER ADDRESS CONSTANT 03920021 * 03940021 DS 0F 03960021 LOCCTR DC XL4'080' STARTING LOCATION 03980021 LOCCTR1 DC F'0' * 04000021 PROGID DC CL8' ' PROGRAM-ID FROM IDENTIFICATION D 04020021 LABELS DC H'0' CONTAINS LABEL INFORMATION 04040021 SEGCNTR DC H'0' * 04060021 PNCTR DC H'0' FOR ASSIGNING PB NO.S TO PR0L NM 04080021 GNCTR DC H'0' FOR ASSIGNING GN NO.S TO GEN PRO 04100021 DCBCTR DC H'0' ASSIGNS ID NO TO DCB'S 04120021 VIRCTR DC H'1' ASSIGNS ID NO TO VIRTUALS 04140021 LTLCTR DC H'0' ASSIGNS ID NO TO LITERALS 04160021 WCMAX DC H'0' LARGEST WORK AREA FOR LIBR SUB 04180021 TSMAX DC H'0' TEMP STORAGE SIZE FOR ARITHM. 04200021 TS2MAX DC H'0' TEMP STORAGE SIZE FOR NON-ARITHM 04220021 ODOCTR DC H'0' NO OF Q-ROUTINES 04240021 CKPCTR DC H'0' NO OF CHECKPOINT REQUESTS 04260021 INDCTR DC H'0' AVAILABLE 04280021 SBLOMX DC H'0' AVAILABLE 04300021 VLCOMX DC H'0' AVAILABLE 04320021 SBLIMX DC H'0' NO OF 2NDARY BASE LOCATORS 04340021 VLCIMX DC H'0' NO OF VARIABLE LENGTH CELLS 04360021 SBLCTR DC H'0' CNTR FOR ASSIGNING SBL'S 04380021 VLCCTR DC H'0' USED TO DETERMINE VLCOMX & VLCIM 04400021 BLLCTR DC H'0' ASSIGNS ID NO TO LNK SECT BL'S 04420021 SEQERR DC H'0' NO OF OUT-OF-SEQUENCE CARDS 04440021 SWITCH DC H'0' * 04460021 SWTRCE EQU X'80' 04480021 SPILLQ EQU X'10' 04500021 MQVAR EQU X'04' 04520021 SWLIST EQU X'02' 04540021 MQFILE EQU X'01' 04560021 * 04580021 * SECOND BYTE OF SWITCH 04600021 * 04620021 SORTRTN EQU X'20' 04640021 RERUN EQU X'10' 04660021 DSOU EQU X'08' 04680021 NOFITSW EQU X'04' 04700021 DOPH7 EQU X'02' 04720021 RDERRFIL EQU X'01' 04740021 DICND2 DS F TO REPLACE DICTPT 04760021 DICND1 DS F INSERT AFTER DICND2 04780021 DATE DC CL15'THIS MSG = DATE' AFTER DICND1 04800021 WSDEF DC XL7'0' END OF DATA ATEXT EL FOR WK STOR 04820021 ERRSEV DC X'00' SEVERITY CODE 04840021 RETCDE EQU ERRSEV 04860021 PHZSW DC X'00' OPTIONS SWITCH 04880021 LIST EQU X'80' SOURCE(OS) 04900021 LISTX EQU X'40' PMAP 04920021 DECK EQU X'20' 04940021 LINK EQU X'10' LOAD 04960021 SEQ EQU X'08' 04980021 FLAGW EQU X'04' 05000021 LIBR EQU X'02' 05020021 ZWB EQU X'01' 05040021 PHZSW1 DC X'00' VARIOUS COMPILATION OPTIONS 05060021 XREF EQU X'80' 05080021 CLIST EQU X'40' 05100021 SYM EQU X'20' DMAP 05120021 PDT EQU X'10' 05140021 APOST EQU X'04' 05160021 SUPMAP EQU X'02' 05180021 TRUNC EQU X'01' 05200021 PHZSW2 DC X'00' MORE COMPILATION OPTIONS 05220021 STAT EQU X'80' 05240021 NO6A EQU X'02' PH6 SETS FOR PH7 IF PH6A BYPASSED 05260021 DICADR DC F'0' MOVED TO COMMON PORTION 05280021 DLSVAL DC F'0' ACCESS RTN COMMUNICATION CELL 05300021 DICPTR DC X'0' ACCESS RTN COMMUNICATION CELL 05320021 DCPTR DC 3X'0' ACCESS RTN COMMUNICATION CELL 05340021 RPTSAV DC H'0' REPOET SAVE AREA CELL 05360021 DYNAM DC X'00' PH6 EXEC TIME LOADED SUBROUTINE SWITCH 05380021 DC X'00' AVAILABLE 05400021 LCSECT DC F'0' USED BY PH6 05420021 PH7LOD DC A(0) USED BY PH6 05440021 RGNCTR DC H'0' COUNT OF UNIQUE GN'S 05460021 ERF4SW DC X'0' USED BY PH6/PH7 05480021 PTYNO DC X'0' PRIORITY NO OF CURRENT SEGMENT 05500021 COMMAD DC C',.' USED BY PH1 05520021 PHZSW3 DC X'00' OPTION SWITCH 05540021 VERBR EQU X'01' LISTING A-TEXT 05560021 PHZSW4 DC X'00' RESERVED FOR ADDITIONAL OPTIONS 05580021 AMOVDC DC A(MOVDIC) TAMER ADDRESS CONSTANT 05600021 SDSIZ DC F'0' BIGGEST FD IN PGM 05620021 SEGLMT DC X'32' * 05640021 DTFNUM DC X'0' NO OF DTF 05660021 CURSGN DC C'$' USED BY PH1 05680021 PH1BYTE DC X'00' PH1/PH2 COMMUNICATION CELL 05700021 BASINSQ EQU X'08' 05720021 INIBIT EQU X'04' 05740021 UPSIBT EQU X'01' 05760021 EOPPH1 EQU X'02' 05780021 BASIS EQU X'20' 05800021 DECBCT DC H'0' * 05820021 INDEXS DC H'0' # INDEX NAMES DEFNED IN S.A.'S 05840021 INDEX1 DC H'0' # INDEX NAMES DEFNED IN IN-LINE FILES 05860021 CYCTOTAL DC H'0' TOTAL # CYCLES FOR THIS PROGRAM 05880021 IOPTRCTR DC H'0' # I/O POINTERS FOR APPLY-WRITE-ONLY 05900021 TS3MAX DC 1H'0' USED BY PH6 05920021 TS4MAX DC 1H'0' USED BY PH6 05940021 BUFSIZE DC F'0' USED FOR STATISTICS 05960021 CORESIZE DC F'0' USED FOR STATISTICS 05980021 CNTLINE DC H'0' USED FOR STATISTICS 06000021 CURCRD DC H'0' CURRENT CARD NO SET BY PH4 06020021 SPACING DC X'00' USED FOR STATISTICS 06040021 PDTCHR DC X'0' * 06060021 DS H * 06080021 BASINS DS F * 06100021 DS F * 06120021 * 06140021 DS 0F 06160021 AGETALL DC A(GETALL) TAMER ADDRESS CONSTANT 06180021 DC F'0' * 06200021 RPDNUM DC H'0' AVAILABLE 06220021 CYCNUM DC H'1' AVAILABLE 06240021 IDENTL DS F REL. LOC 1ST INSTR IN OBJ MODULE 06260021 BLCTR DC H'0' ID NO ASSIGNED TO BL'S 06280021 VNCTR DC H'0' ASSIGNING VN NUMBERS 06300021 ONCTR DC H'0' ASSIGNING ID NO'S TO ON CTL CELL 06320021 PFMCTR DC H'0' ASSIGNING ID NO'S TO PERFORM CEL 06340021 PSVCTR DC H'0' ASSIGNING ID NO'S TO PERF SV CEL 06360021 XSACTR DC H'1' LOC WITHIN EXHIBIT OR SOLT SAVE 06380021 XSWCTR DC H'0' TO REPLACE XSALOC 06400021 RELLOC DS F DISP OF TGT/SGT FROM BEG OF OBJM 06420021 GTLNG DS H LNGT OF TGT SPECIFIED IN RELLOC 06440021 RPILOC DS H AVAILABLE 06460021 VNILOC DS H DISP OF VNI FIELDS IN PGT 06480021 VNLOC DS H VN FIELDS IN TGT OR SGT 06500021 SUBCTR DC H'0' ASSIGNING ID'S TO SOBSCR. REFS 06520021 PARMAX DC H'0' MOVED TO COMTBL SINCE NEED IN RPD NE 0 06540021 BLSVAL DC H'0' AVAILABLE 06560021 BLSLOC DC H'0' AVAILABLE 06580021 CMTBSW DC H'0' AVAILABLE 06600021 * BIT 0 1#HOLD IN THIS SECTION 06620021 SA2CTR DC H'0' SET IF OPT 2 OF USE SPECIFIED 06640021 SA3CTR DC H'0' SET IF OPT 5 OF USE SPECIFIED 06660021 BLSEND DC H'0' AVAILABLE 06680021 INDEX DC F'0' NO OF INDEX NAMES 06700021 INDEX0 DC H'0' # INDEX NAMAVAILABLE 06720021 DS 6F AVAILABLE 06740021 ******************************************************************* 06760021 DX0 EQU 0 06780021 DX1 EQU 1 06800021 NX1 EQU 1 06820021 DX2 EQU 2 06840021 NX2 EQU 2 06860021 NX3 EQU 3 06880021 DX4 EQU 4 06900021 NX4 EQU 4 06920021 DX5 EQU 5 06940021 NX5 EQU 5 06960021 DX6 EQU 6 06980021 NX6 EQU 6 07000021 DX8 EQU 8 07020021 NX8 EQU 8 07040021 DX9 EQU 9 07060021 NX9 EQU 9 07080021 DX12 EQU 12 07100021 NX12 EQU 12 07120021 DX13 EQU 13 07140021 DX14 EQU 14 07160021 DX16 EQU 16 07180021 NX18 EQU 18 07200021 NX19 EQU 19 07220021 DX24 EQU 24 07240021 NX24 EQU 24 07260021 DX25 EQU 25 07280021 DX27 EQU 27 07300021 DX28 EQU 28 07320021 NX28 EQU 28 07340021 DX33 EQU 33 07360021 DX48 EQU 48 07380021 DX50 EQU 50 07400021 DX56 EQU 56 07420021 DX62 EQU 62 07440021 DX65 EQU 65 07460021 NX70 EQU 70 07480021 DX82 EQU 82 07500021 NX86 EQU 86 07520021 DX89 EQU 89 07540021 DX121 EQU 121 07560021 DX256 EQU 256 07580021 DX512 EQU 512 07600021 DX1568 EQU 1568 07620021 XX0 EQU X'00' 07640021 XX06 EQU X'06' 07660021 XXF0 EQU X'F0' 07680021 XXFF EQU X'FF' 07700021 XX00 EQU X'00' 07720021 XX80 EQU X'80' 07740021 XX20 EQU X'20' 07760021 XXF1 EQU X'F1' 07780021 XX0F EQU X'0F' 07800021 XX40 EQU X'40' 07820021 XX60 EQU X'60' 07840021 XXF2 EQU X'F2' 07860021 XX01 EQU X'01' 07880021 XX10 EQU X'10' 07900021 XX7F EQU X'7F' 07920021 XX03 EQU X'03' 07940021 XX02 EQU X'02' 07960021 XXBF EQU X'BF' 07980021 XX0D EQU X'0D' 08000021 XX0E EQU X'0E' 08020021 XXFB EQU X'FB' 08040021 XC0 EQU C'0' 08060021 XCB EQU C'B' 08080021 LX0 EQU 0 08100021 LX1 EQU 1 08120021 LX2 EQU 2 08140021 LX3 EQU 3 08160021 LX4 EQU 4 08180021 LX6 EQU 6 08200021 LX8 EQU 8 08220021 LX10 EQU 10 08240021 LX12 EQU 12 08260021 LX16 EQU 16 08280021 LX24 EQU 24 08300021 LX64 EQU 64 08320021 LX77 EQU 77 08340021 LX119 EQU 119 08360021 LX256 EQU 256 08380021 EJECT 08400021 SAVER13 DS F ADDR OF CALLING PHASE'S REG SAVE 08420021 ZEROES DC F'0' FULLWORD CONSTANT OF ZEROES 08440021 DC F'511' MASK FOR TURNING OFF 23 HI BITS 08460021 ADD DC A(READ) X=0 08480021 DC A(WRITE) PUTN X=1 08500021 DC A(WRITEA) PUT X=2 08520021 DC A(EXITR) OPEN X=3 08540021 DC A(EXITR) OPEN X=4 08560021 DC A(EXITR) CLOSE X=5 08580021 DC A(CLOSET) TEMP CLOSE X=6 08600021 DC A(READ) SYSIN X=7 08620021 DC A(WOUT) SYSOUT X=8 08640021 DC A(SEGPNT) X=9 08660021 DC A(LINKB) X=A LOAD NEXT PHASE 08680021 DC A(EOJ) END JOB X=B 08700021 DC A(SEGNOTE) X=C 08720021 DC A(EJECT) X=D 08740021 DC A(WGO1) X=E, F ILLEGAL EXTERNAL 08760021 DC A(CLOSER) X=F 08780021 SINGBUF DC X'00' SINGLE BUFFER SWITCH 08800021 SPECIAL DC X'00' SPECIAL USE SWITCH (PRIME INPUT 08820021 DC C'IKFCBL00' USED FOR IDENTIFICATION 08840021 DC C'B' * 08860021 DC X'1C' * 08880021 DS 0H 08900021 * 08920021 * 08940021 * 08960021 * 08980021 * 09000021 POINT DC H'0' FILE USING NO. BUFF 09020021 DC X'00' UT1 1 FIRST 0 LEFT 09040021 DC X'00' 1 ALT. 0 HAND 09060021 DC X'02' UT2 2 2 NIBBLE 09080021 DC X'03' 2 3 USED TO 09100021 DC X'F4' UT3 3 4 PRIME 09120021 DC X'05' 3 5 BUFFER 09140021 DC X'F1' UT4 4 1 ON 09160021 DC X'01' 4 0 READ 09180021 DC X'F9' SYSIN 5 PRIME 6A1 OR 09200021 DC X'0A' 5 6A2 WR 09220021 DC X'F7' SYSOUT 6 09240021 DC X'08' 6 6A4 ON 09260021 DC X'0D' SYSPNCH 7 0 CL 09280021 DC X'0E' 7 0 09300021 DC X'0F' SYSLIN(GO) 8 09320021 DC X'00' 8 0 09340021 DC X'FB' USLIB 9 6A 5 PRIME 09360021 DC X'0C' 9 09380021 * AT INIT0 TIME WE BRING IN PHASE 1. THE BUFFER 09400021 * POINTERS ARE INITIALIZED AND THE LRECL'S ARE ALREADY INITIALIZED 09420021 * AS WELL AS THE BLKSIZES,THEREFORE WE ARE READY TO OPEN T 09440021 * FILES. BETWEEN THE OTHER PHASES WE CHANGE THE POINTERS F 09460021 * BUFFER SWAPPING AND NECESSARILY OPEN AND CLOSE FILES. 09480021 * 09500021 POINTM2 DC X'0101' BUFFER ALLOCATION CONSTANT 09520021 POINTM3 DC X'0106' BUFFER ALLOCATION CONSTANT 09540021 POINTM4 DC X'010602030505' BUFFER ALLOCATION CONSTANT 09560021 POINTM50 DC X'0406020305050101' BUFFER ALLOCATION CONSTANT 09580021 POINTM5 DC X'04030202' BUFFER ALLOCATION CONSTANT 09600021 POINTMX DC X'0505' ALTERNATE POINT VALUES 09620021 POINTSEG DC X'0404020205050103' * 09640021 * 09660021 * 09680021 * 09700021 * 09720021 * 09740021 * 09760021 * 09780021 * 09800021 * 09820021 * 09840021 * 09860021 * 09880021 * 09900021 EJECTSW DC X'00' 'FF' MEANS TAKE A NEW PAGE 09920021 MASKPG DC X'402020202021' EDITS PAGE NUMBER 09940021 DS 0D 09960021 OVERFLOD DC A(OVERFLO) ADDRESS OF HEADER LINE 09980021 OVERFLO DC H'4' HEADER CONSTANT 10000021 DC CL4' ' HEADER CONSTANT 10020021 PAGE DC X'00001C' PAGE CONSTANT 10040021 SIXTY DC X'060C' LINE COUNT LIMIT 10060021 BLANK DC C' ' CARRIAGE CONTROL 10080021 * 10100021 * 10120021 *FORMAT BCB 10140021 * BYTE 1 X'00' 10160021 * 10180021 * 10200021 * 10220021 * 10240021 * 10260021 * BYTES 2-4 ADDRESS OF BUFFER 10280021 * 10300021 * BYTES 5-6 BYTES USED FOR PUT & GET SO FAR 10320021 * 10340021 * BYTES 7-8 LENGTH OF BUFFER 10360021 * 10380021 * CORE MAP 10400021 * BCTLS 18D 10420021 * BUF 1F AMOUNT OF CORE LEFT FOR GET MAINS 10440021 * 2F START OF TAMER - SIZE USED 10460021 DS 0D 10480021 BUFX DC A(OVERFLOD) ADDRESS OF ADDRESS OF HEADER LIN 10500021 DC A(DATE) ADDRESS OF DATE 10520021 BUFCNLS DC 15D'0' BCB 1044 10540021 CORELEFT DS 1F BUFFER CONTROL BLOCKS 10560021 TAMAREA DS 1F START TAMER AREA 10580021 TAMLL DS 1F END OF TAMER SET BY PHASE02 10600021 NOLIB DS CL1 SWITCH FOR OK LIBRARY OPEN 10620021 LIBSIZE DC H'400' BLKSIZE FOR LIB - SET IN PH01 10640021 INBUF DS H SYSIN BUFFER SIZE - SET IN PH01 10660021 * 10680021 LIBNAME DC CL8' ' SAVE AREA FOR COPY/BASIS RTN 10700021 CURNAME DC CL8'0' SAVE AREA FOR COPY/BASIS RTN 10720021 LIBRAR DC H'36' FILE NUMBER VALUE 10740021 PUNCHER DC H'28' FILE NUMBER VALUE 10760021 PRINTER DC H'24' FILE NUMBER VALUE 10780021 OFF DC X'0F0F' MASK FOR POINT TABLE 10800021 EIGHTY DC H'80' USED IN READB ROUTINE 10820021 PRINTBUF DC C'1' CONTROL CH FOR PRINTER 10840021 LINECNT DC X'0000000C' PROGRAM LISTING LINE COUNT 10860021 ONE DC X'1C' USED TO ADJUST PAGE AND LINECNT 10880021 SWITCHD EQU X'182' 10900021 SKIP DC C'1' EJECT VALUE FOR CARRIAGE CTL 10920021 PZERO DC X'0C' PACKED ZERO CONSTANT 10940021 BASSW DC X'00' SET IF BASIS REQUEST 10960021 * 10980021 * 11000021 * 11020021 * 11040021 MYSAVE DC 1F'0' PH00 SAVE AREA 11060021 DS F SAVE AREA IN OS 11080021 DC A(SAVEPHSE) ADDR OF PHASE SAVE AREA 11100021 DS 15F REG SAVE AREA 11120021 SAVEPHSE DS 18F FOR PHASE USE 11140021 * 11160021 * 11180021 * 11200021 * 11220021 * 11240021 LINKNAME DC CL8'IKFCBL01' USED BY LINK MACRO 11260021 DC CL2'01' VARIABLE PORTION OF LINK CONSTAN 11280021 DC CL2'10' VARIABLE PORTION OF LINK CONSTAN 11300021 DC CL2'1B' VARIABLE PORTION OF LINK CONSTAN 11320021 DC CL2'20' VARIABLE PORTION OF LINK CONSTAN 11340021 DC CL2'30' VARIABLE PORTION OF LINK CONSTAN 11360021 DC CL2'40' VARIABLE PORTION OF LINK CONSTAN 11380021 DC CL2'50' VARIABLE PORTION OF LINK CONSTAN 11400021 DC CL2'51' VARIABLE PORTION OF LINK CONSTAN 11420021 DC CL2'60' VARIABLE PORTION OF LINK CONSTAN 11440021 DC CL2'6A' VARIABLE PORTION OF LINK CONSTAN 11460021 DC CL2'70' VARIABLE PORTION OF LINK CONSTAN 11480021 DC X'FF' INDICATE END OF LINKNAMES 9330 11500021 LINKCNT DC H'0' VALUE CORRESPONDS TO CURRENT PMS 11520021 PHASW DC X'00' PHASW FOR USE BY TAMER 11540021 RETOK DC X'00' 'FF' MEANS END COMPILATION 11560021 LIBADD DC A(LIB) @ LIB DCB 11580021 GO ST R13,SAVER13 11600021 LA R13,MYSAVE 11620021 N R3,ZEROES+NX4 11640021 GOSYSGO LM R6,R7,ZEROES 11660021 LR R8,R0 11680021 CLI DX0(R8),XX06 11700021 BE EXIT1 OSDUMPS DUMMY CALL 11720021 IC R6,DX0(R8) PICK UP LINKAGE PARAM 11740021 SRDL R6,DX4 6 HAS ACTION CODEX4 11760021 SLL R6,DX2 AT THIS TIME 11780021 SRL R7,DX27 FILE TIMES 2 (HALF WORD 11800021 L R11,ADD(R6) 11820021 TM DX0(R8),LNKRQST1 STEP 1 OF CHECK FOR X = 'A' 11840021 BNZ GSYSG1 NOT LOAD NEXT PHASE 11860021 TM DX0(R8),LNKRQST2 FINAL STEP OF CHECK FOR X = 'A' 11880021 BNO GSYSG1 X DOES NOT = 'A' 11900021 BR R11 IT DOES, GO RIGHT TO LINK ROUTIN 11920021 * 11940021 * 11960021 * AT THE END OF THIS ROUTINE SINGLE BUFFER WILL BE SET,SPECIAL 11980021 * WILL BE SET, REG6 POINTS TO BCB 1 , 7 TO BCB2 , 8 TO PA 12000021 * LIST 9 TO POINTER (FOR BUFFER SWITCH) 10 HAS FILE NOX4 12020021 GSYSG1 LA R9,POINT(R7) 12040021 MVC SINGBUF(LX2),ZEROES 12060021 LR R10,R7 12080021 SLL R10,DX1 12100021 TM DX0(R9),XXF0 12120021 BZ GOA1 NOT FIRST I/O 12140021 OI SPECIAL,XXFF 12160021 GOA1 IC R6,DX0(R9) 12180021 IC R7,DX1(R9) 12200021 SLDL R6,DX28 12220021 SRL R6,DX25 12240021 SRL R7,DX25 12260021 CR R6,R7 12280021 BNE GOA2 DOUBLE BUFFERED 12300021 OI SINGBUF,XXFF SINGLE BUFFER 12320021 GOA2 LA R6,BUFCNLS-NX8(R6) 12340021 LA R7,BUFCNLS-NX8(R7) 12360021 BR R11 GO TO X PARAMETER ROUTINE 12380021 GETDECBA LR R1,R10 12400021 SH R1,FOUR 12420021 MH R1,FIVE 12440021 A R1,ADECB 12460021 BR R15 RETURN TO NEXT SEQUENTIAL INSTR 12480021 FOUR DC H'4' USED IN GETDECBA ROUTINE 12500021 FIVE DC H'5' USED IN GETDECBA ROUTINE 12520021 ADECB DC A(DECBDS1) @ FIRST DECB 12540021 * REG POINTS TO 12560021 * 6 FIRST BUFFER AREA 10= FILE NOX4 12580021 * 7 SECOND 12600021 * 8 PARAM LINK FROM PHASE (RETURN AD-2) 12620021 * 9 POINTERS FOR FILE POINTERS TO BCB'S FOR SWITCHING 12640021 * 5 BASE REGISTER 12660021 READ CH R10,LIBRAR 12680021 BE READLIB MUST READ FROM LIBRARY 12700021 READD TM SPECIAL,XXFF 12720021 BZ READB NOT FIRST READ 12740021 * PRIMING NECESSARY 12760021 READSING BAL R11,READER READ FIRST 12780021 BAL R11,CHECKER THEN CHECK 12800021 TM SINGBUF,XXFF 12820021 BO EXIT SINGLE BUFFERED-SO EXIT 12840021 * 12860021 LA R11,EXIT 12880021 B READER DOUBLE BUFFERED-MUST READ AGAIN 12900021 * 12920021 * 12940021 * COPY BASIS ROUTINE 12960021 * 12980021 * SAVE AREAS FOR ROTOTIONAL RETURN TO BASIS LIBRARY 13000021 PREREG6 DS F R6 SAVEAREA 13020021 PREREG7 DS F R7 SAVEAREA 13040021 PREPOINT DS CL2 ALTERNATE POINT FIELD 13060021 PRELEN DS CL2 LENGTH FIELD 13080021 PREHLD DS CL16 PREVIOUS DCB STATUS FOR NOTE 13100021 BASISN DC CL8' ' VALUE PASSED BY CALLING PHASE 13120021 PRENAME DC CL8' ' OUS MEMBER NAME 13140021 LIBHLD DS CL16 STORAGE FIELD FOR LIB DCB INFO 13160021 EODADD DC A(ENDIN1) @ EOD ROUTINE 13180021 ADRLIBF DC A(RLIBF) @ READ FROM LIBRARY ROUTINE 13200021 CTRMNT DC A(TRMNATE) @ ABNORMAL END COMPILATION RTNE 13220021 * NOTICE THAT WE FOURCE A NOTE AND POINT AS REQUIRED 13240021 READLIB TM NOLIB,XXFF 13260021 BO RLIBD LIBRARY NOT OPENED SUCCESSFULLY 13280021 CLC CURNAME,DX1(R8) 13300021 BE READDA CONTINUE SAME MEMBER 13320021 TM SPECIAL,XXFF 13340021 BO RLIBA FIRST READ FROM LIBRARY 13360021 CLC PRENAME,DX1(R8) 13380021 BNE RLIBB NEW MEMBER -COPY OPTION 13400021 OI BASSW,XXFF SET SWITCH FOR RETURN TO BASIS LI 13420021 B RLIBA GO FIND MEMBER 13440021 * NOTICE THAT NO CHECK IS NECESSARY BECAUSEE ARE REVERTING TO A 13460021 * PREVIOUS MEMBER THEN A COPY IS COMPLETE AND WE RETURN TO THE B 13480021 READNOTE L R1,LIBADD 13500021 MVC DX4(LX16,R1),PREHLD 13520021 NOTE (1) 13540021 ST R1,READSAV 13560021 LA R0,READSAV 13580021 L R1,LIBADD 13600021 POINT (1),(0) 13620021 L R7,PREREG6 13640021 L R6,PREREG7 13660021 MVC DX6(LX2,R7),LIBSIZE 13680021 MVC DX6(LX2,R6),LIBSIZE 13700021 BAL R11,READER MUST READ 13720021 BAL R11,CHECKER REPRIME 13740021 BAL R11,READER MUST READ 13760021 MVC POINT+NX18(LX2),PREPOINT 13780021 MVC DX4(LX2,R6),PRELEN 13800021 NI BASSW,XX00 TURN OFF SWITCH 13820021 READDA LA R8,DX8(R8) 13840021 B READB GO DEBLOCK 13860021 * 13880021 RLIBB CLC CURNAME,BASISN 13900021 BNE RLIBA NOT READING FROM BASIS DONT SAVE 13920021 MVC PRELEN,DX4(R6) LOGICAL LENGTH USED 13940021 MVC PRENAME,CURNAME 13960021 STM R6,R7,PREREG6 13980021 MVC PREPOINT,POINT+NX18 14000021 MVC PREHLD,LIBHLD LAST CHECK STATUS 14020021 L R11,LIBADD 14040021 MVC DX33(LX3,R11),ADRLIBF+NX1 14060021 BAL R11,CHECKER ISSUE OUTSTANDING CHECK CHANGE EODAD 14080021 MVI COPYCHK,XXFF 14100021 RLIBF L R1,LIBADD 14120021 MVC DX33(LX3,R1),EODADD+NX1 14140021 RLIBA MVC LIBNAME,DX1(R8) 14160021 LR R4,R8 14180021 LA R0,DX1(R8) 14200021 L R1,LIBADD 14220021 FIND (1),(0),D 14240021 B *+4(R15) BRANCH WRT FIND RETURN CODE 14260021 B RLIBGO SUCCESSFUL FIND 14280021 LA R8,DX4(R8) 14300021 LA R8,DX4(R8) I O ERROR 14320021 RLIBC LA R8,DX12(R8) 14340021 CLI DX9(R4),XCB 14360021 BNE EXITR RETURN TO PH1 ONLY ON COPY 14380021 NOREADL L PR4,CTRMNT 14400021 B NOLIBRY UNSUCCESSFUL FIND 14420021 RLIBD LR R4,R8 14440021 BC UNCOND,RLIBC CHECK IF COPY 14460021 RLIBGO MVC CURNAME,LIBNAME 14480021 MVI COPYCHK,XX00 14500021 TM BASSW,XXFF IS THIS A RETURN TO BASIS LIBRAR 14520021 BO READNOTE BRANCH IF 14540021 TM PH1BYTE,BASIS 14560021 BZ RLIBGOA BASIS BIT ALREADY OFF 14580021 MVC BASISN,DX1(R8) 14600021 NI PH1BYTE,XXFF-BASIS 14620021 * NB NB NB NB NB NB NB NB NB NB NB NB NB NB NB NB NB NB NB NB NB 14640021 * PHASE ONE MUST TURN OFF BASIS SWITCH IF FIRST CARD IS NOT 14660021 * A BASIS STATEMENT 14680021 RLIBGOA OI SPECIAL,XXFF 14700021 MVC DX6(LX2,R7),LIBSIZE 14720021 MVC DX6(LX2,R6),LIBSIZE 14740021 LA R8,DX8(R8) 14760021 B READD PREPARE TO DO A READ 14780021 * 14800021 * 14820021 READSAV DS F SAVE AREA FOR R1 - MACRO USAGE 14840021 WCOMM TM SPECIAL,XXFF FIRST I-O THIS PHASE 14860021 BO WRTAAA NOT NEED TO ISSUE CHECK 14880021 BAL R11,CHECKER MUST CHECK FIRST 14900021 WRTAA BAL R11,WRITER THEN WRITE 14920021 BR R12 GO TO NEXT I/O PROCESSING RTNE 14940021 WRTAAA BAL R11,CHECKERB FIRST I/O-SKIP CHECK MACRO 14960021 B WRTAA NOW WRITE 14980021 CHECKER BAL R15,GETDECBA GET @ DECB 15000021 ST R1,READSAV 15020021 CHECK (1) 15040021 L R1,READSAV 15060021 TM DX5(R1),XX80 WAS IT A REA 15080021 BZ CHECKERB NOT A READ 15100021 CH R10,UTILITY 15120021 BL CHECKERB UTILITY FILE SO BRANCH 15140021 CH R10,LIBRAR 15160021 BNE CHECKERD NOT LIBRARY FILE SO BRANCH 15180021 CLI COPYCHK,XXFF 15200021 BNE CHECKERA CHECK MUST BE ISSUED SO BRANCH 15220021 MVI COPYCHK,XX00 15240021 BR R11 RETURN TO NEXT SEQUENTIAL INSTR 15260021 CHECKERA L R15,LIBADD 15280021 MVC LIBHLD,DX4(R15) 15300021 CHECKERD L R1,DX16(R1) ADDRESS OF IOB 15320021 LH R15,DX6(R7) LENGTH OF BUFFER 15340021 SH R15,DX14(R1) RESIDUAL BYTE COUNT FROM CSW 15360021 STH R15,DX6(R7) DATA READ IN 15380021 CHECKERB LH R15,DX0(R9) 15400021 STC R15,DX0(R9) 15420021 SRL R15,DX8 15440021 STC R15,DX1(R9) 15460021 XR R6,R7 15480021 XR R7,R6 15500021 XR R6,R7 15520021 CHECKERC MVC DX4(LX2,R6),ZEROES 15540021 MVC DX4(LX2,R7),ZEROES 15560021 CH R10,SUT1 15580021 BCR R7,R11 NOT SYSUT1 SO BRANCH 15600021 TM SEGNTSW,XXFF 15620021 BM SEGNOTE1 CHK LAST WRITE PREVIOUS SEG ISSUED 15640021 BO SEGNOTE2 CHK FIRST WRITE PREVIOUS SEG ISSUED 15660021 BR R11 RETURN TO NEXT SEQUENTIAL INSTR 15680021 MOVE MVC DX0(LX0,R1),DX0(R2) 15700021 IOCOM BAL R15,GETDECBA ON RETURN R1 = DECB ADDRESS 15720021 MVC DX12(LX4,R1),DX0(R7) ADDRESS OF AREA 15740021 L R15,DX8(R1) DCB ADDRESS 15760021 CH R10,SUT1 15780021 BNE SNOTUT1 NOT SYSUT1 SO BRANCH 15800021 TM STRUNCSW,XXFF TRUNCATED WRITE OF SYSUT1? 15820021 BO NSYSN SKIP NEXT INSTRUCTIONS 15840021 MVC DX6(LX2,R1),DX6(R7) 15860021 MVC DX82(LX2,R15),DX6(R7) 15880021 B NSYSN SKIP SNOTUT1 ROUTINE 15900021 SNOTUT1 DS 0H 15920021 CH R10,SYSN IF SYSIN, RESET BLKSIZE (CONCAT DS) 15940021 BNE NSYSN NOT SYSIN 15960021 MVC DX6(LX2,R7),INBUF SIZE SET BY PH00 RESTORED IN DCB 15980021 NSYSN MVC DX62(LX2,R15),DX6(R7) BLOCK SIZE 16000021 TM CLOSE,XXFF 16020021 BZ IOCOMA LEAVE DCB ALONE 16040021 MVC DX62(LX2,R15),CLOSEH 16060021 NI CLOSE,XX00 16080021 IOCOMA L R15,DX48(R0,R15) ADDRESS OF READ/WRITE MODULE 16100021 NC DX0(LX2,R9),OFF 16120021 BR R14 RETURN TO NEXT SEQUENTIAL INSTR 16140021 READER BAL R14,IOCOM GET @ DECB,ETC 16160021 MVI DX5(R1),XX80 16180021 BALR BALR R14,R15 BRANCH TO READ/WRITE MODULE 16200021 BR R11 RETURN TO NEXT SEQUENTIAL INSTR 16220021 WRITER BAL R14,IOCOM GET @ DECB,ETC 16240021 MVI DX5(R1),XX20 16260021 B BALR BRANCH TO READ/WRITE MODULE 16280021 * 16300021 * 16320021 * 16340021 READB CH R10,UTILITY 16360021 BL READC UTILITY FILE 16380021 * SYSIN BLOCKED 16400021 * NO 16420021 LH R1,DX4(R6) 16440021 AH R1,EIGHTY 16460021 CH R1,DX6(R6) 16480021 BE READC BRANCH AROUND EXIT 16500021 * 16520021 STH R1,DX4(R6) 16540021 * 16560021 B EXIT SINGLE BUFFER 16580021 * 16600021 READC TM SINGBUF,XXFF 16620021 BO READSING SINGLE BUFFER READ 16640021 * 16660021 READC1 BAL R11,CHECKER MUST CHECK 16680021 READC2 BAL R11,READER THEN READ 16700021 EXIT L R0,DX0(R6) 16720021 AH R0,DX4(R6) CC DOES NOT EQUAL 0 16740021 * 16760021 EXIT1 LR R1,R8 16780021 LA R1,DX0(R1) 16800021 * 16820021 * 16840021 EXIT2 L R13,SAVER13 CC EQUALS 0 16860021 LM R14,R15,DX12(R13) 16880021 MVC DX12(LX4,R13),SAVEPHSE+NX12 16900021 LM R2,R12,DX28(R13) 16920021 BC R15,DX2(R1) RETURN TO CALLING PHASE 16940021 ENDIN1 XC CURNAME(LX8),CURNAME ZERO CURNAME 16960021 ENDIN CR R1,R1 16980021 B EXIT1 PREPARE TO RETURN TO CALLING PH 17000021 * 17020021 * 17040021 * 17060021 * 17080021 WRITEA SR R3,R3 IC TEXT WRITER 17100021 IC R3,DX0(R2) 17120021 SRA R3,DX6 17140021 LA R3,DX1(R3) 17160021 BC R7,WRITE SHORT FORM 17180021 IC R3,DX1(R2) LONG FORM 17200021 LA R3,DX2(R3) 17220021 * 17240021 WRITE CH R10,PRINTER IS IT PRINTER 17260021 BE WRITPRNH YES 17280021 CH R10,PUNCHER IS IT PUNCH 17300021 BE WRITPCH YES 17320021 WRITE1 LH R4,DX4(R6) USED BYTES UTILITY 17340021 AR R4,R3 THIS WRITE 17360021 CH R4,DX6(R6) 17380021 BNL WRITE1A WILL NOT FIT 17400021 L R1,DX0(R6) 17420021 AH R1,DX4(R6) 17440021 STH R4,DX4(R6) STORE UPDATED LENGTH 17460021 BCTR R3,R0 GET INTERNAL LENGTH 17480021 EX R3,MOVE MOVE DATA 17500021 BC UNCOND,EXIT1 PREPARE TO RETURN TO CALLING PH 17520021 * 17540021 * 17560021 * 17580021 * 17600021 * 17620021 * 17640021 * 17660021 * 17680021 WRITE1A L R1,DX0(R6) 17700021 AH R1,DX4(R6) 17720021 MVI DX0(R1),XXFF 17740021 TM SINGBUF,XXFF 17760021 BO WSINGLE SINGLE BUFFERED 17780021 LA R12,WRITE1 17800021 B WCOMM DOUBLE BUFFERED 17820021 WSINGLE BAL R11,WRITER MUST WRITE 17840021 LA R11,WRITE1 17860021 B CHECKER THEN CHECK 17880021 WRITPRIN TM PHZSW,LIST 17900021 BZ EXITR SOURCE LISTING NOT REQUESTED 17920021 TM PRINTBUF,XXF1 17940021 BO EJECTC GO EJECT PAGE 17960021 TM PRINTSW,XXFF 17980021 BO WPRINA * 18000021 WPRINB LA R14,EXITR WILL FIT EXIT 18020021 LA R12,WPRINB RETRY ADDRESS 18040021 B UNITCOM BR TO PUT REC IN BUF IF POSSIBL 18060021 WRITPRNH TM HDRSW,XXFF WAS IDENT PRINTED 18080021 BNO WRITPRIN YES BRANCH 18100021 NI HDRSW,XXF0 SET MIXED SWITCH 18120021 WPRINA NI PRINTSW,XX00 18140021 LA R3,DX1(R3) 18160021 BCTR R2,R0 POINT TO CARR CONTROL POSITION 18180021 MVC WPRINHLD,DX0(R2) 18200021 MVC DX0(LX1,R2),PRINTBUF 18220021 WPRINC LA R14,WPRIND 18240021 LA R12,WPRINC 18260021 B UNITCOM BR TO PUT REC IN BUF IF POSSIBL 18280021 WPRIND MVC PRINTBUF,BLANK 18300021 MVC DX0(LX1,R2),WPRINHLD 18320021 EXITEJ TM EJECTSW,XXFF 18340021 BZ EXITR NO NEED TO GO TO WOUT 18360021 NI EJECTSW,XX0F 18380021 B WOUT MUST PAD RECORD WITH BLANKS 18400021 * 18420021 WRITPCH TM PHZSW,DECK 18440021 BO WPNCH * 18460021 * DECK IS REQUESTED 18480021 WRITPCHA TM PHZSW,LINK 18500021 BO WGO LOAD MODULE REQUESTED 18520021 B EXITR RETURN NOW TO CALLING PHASE 18540021 WPNCH LA R14,WRITPCHA WILL FIT EXIT 18560021 LA R12,WPNCH RESTART ADDRESS AFTER WRITING BUFFER 18580021 B UNITCOM ANALYSIS ROUTINE 18600021 WGO ST R8,READSAV PICK UP PIINTERS FOR SYSLIN FILE 18620021 BAL R0,GOSYSGO * 18640021 DC X'E8' INTERNAL CALL TO COS 18660021 HDRSW DC X'FF' USED IN PRINT ROUTINE 18680021 WGO1 L R8,READSAV 18700021 TM PHZSW,DECK 18720021 BZ WGO1A NO DECK DO NOT RESTORE LENGTH 18740021 LA R3,DX1(R3) 18760021 WGO1A LA R12,WGO1A 18780021 LA R14,EXITR MOVE DONE 18800021 B UNITCOM BR TO PUT REC IN BUF IF POSSIBL 18820021 WPRINHLD DC X'00' SAVE AREA FOR 1ST CH OF PRINT LI 18840021 PRINTSW DC X'FF' 'FF' MEANS PRINTLINE 18860021 WOUT OI PRINTSW,XXFF 18880021 TM PHZSW,LIST 18900021 BZ EXITR RETURN NOW TO CALLING PHASE 18920021 LH R2,DX4(R6) 18940021 SR R3,R3 18960021 WOUTA LA R3,DX121(R3) 18980021 CR R2,R3 19000021 BH WOUTA MUST INCREMENT R3 19020021 STH R3,DX4(R6) 19040021 SR R3,R2 19060021 BZ WOUT6 NO NEED TO PAD WITH BLANKS 19080021 A R2,DX0(R6) 19100021 MVI DX0(R2),XX40 19120021 BCTR R3,R0 ADJUST LENGTH FOR WOUTB 19140021 BCTR R3,R0 * 19160021 LTR R3,R3 19180021 BC R12,WOUT6 NO NEED TO PAD 19200021 STC R3,WOUTB+NX1 19220021 WOUTB MVC DX1(LX0,R2),DX0(R2) 19240021 WOUT6 TM EJECTSW,XXFF 19260021 BM EJECTA DON'T EJECT YET 19280021 AP LINECNT,ONE 19300021 CLI PRINTBUF,XC0 19320021 BE WOUT6A SPACE=2 19340021 CLI PRINTBUF,XX60 19360021 BNE WOUT6B NOT SPACE=3 19380021 AP LINECNT,ONE 19400021 WOUT6A AP LINECNT,ONE 19420021 WOUT6B CP LINECNT,SIXTY 19440021 BNL EJECTR1 PREPARE TO EJECT 44678 19460021 NI MAXLINES,XX00 LINECNT < MAXIMUM 44678 19480021 B EXITR RETURN TO CALLING PHASE 19500021 * 19520021 * 19540021 * 19560021 EJECTA NI EJECTSW,XX00 19580021 LM R2,R3,SAVEPHSE 19600021 MVI PRINTBUF,XX60 19620021 TM EJRETURN,XXFF WPRINA CALLED FROM EJECT? 19640021 BO EJECTD YES-THEN RETURN THERE 19660021 B WRITPRIN CONTINUE WRITE PROCESSING 19680021 EJECTC TM HDRSW,XXFF TEST IF IDENT 19700021 BZ EJECTB BRANCH IF NO 19720021 NI HDRSW,XX00 ZERO SWITCH 19740021 MVI PRINTBUF,XC0 SET DOUBLE SPACE 19760021 AP LINECNT,ONE 19780021 B EJECTCC DON'T CLEAR LINECNT 19800021 EJECTB SP LINECNT,LINECNT 19820021 EJECTCC STM R2,R3,SAVEPHSE STORE REG 2 + 3 19840021 L R2,OVERFLOD 19860021 LH R3,DX0(R2) 19880021 MVC DX0(LX6,R2),MASKPG 19900021 ED DX0(LX6,R2),PAGE 19920021 AP PAGE,ONE 19940021 STH R3,DX0(R2) 19960021 LA R2,DX2(R2) 19980021 OI EJECTSW,XXFF 20000021 B WPRINA CONTINUE WRITE PROCESSING 20020021 * 20040021 * 20060021 * 20080021 EJECT CLI LINKCNT+NX1,LSWPH2 ARE WE PAST PHASE1B 20100021 BH EJECTE YES NO NEED TO GO THRU THIS CODE 20120021 CLI PRINTBUF,XXF1 EJECT IMPENDING? 20140021 BNE EJECTE NO-THEN CONTINUE 20160021 B EJECTG TEST FOR EJECT AT END-OF-PAGE 44678 20180021 EJECTF OI EJRETURN,XXFF SIGNAL-RETURN CONTR-L-EJECTD 44678 20200021 B EJECTCC BRANCH TO WRITE HEADING(CC=F1) 20220021 EJECTD NI EJRETURN,XX00 20240021 EJECTE CLI DX1(R8),EJCTQ EJECT REQUEST FROM X'86'? 20260021 BE EJECTR YES 20280021 CLI DX1(R8),SKIP1Q WANT TO SKIP ONE LINE 20300021 BE SKP1 YES 20320021 CLI DX1(R8),SKIP2Q NO, WANT TO SKIP TWO LINES 20340021 BE SKP2 YES 20360021 CLI DX1(R8),SKIP3Q NO, WANT TO SKIP THREE LINES 20380021 BE SKP3 YES 20400021 B EJECTR INVALID REQUEST BUT AT LEAST EJE 20420021 SKP1 MVI SKIPCC,SKPCC1Q PUT A BLANK IN CARRIAGE CONTROL 20440021 B SKP5 CONTINUE 20460021 SKP2 MVI SKIPCC,SKPCC2Q PUT A ZERO IN CARRIAGE CONTROL 20480021 SKP4 AP LINECNT,ONE RECONCILE LINECOUNT 20500021 B SKP5 CONTINE 20520021 SKP3 MVI SKIPCC,SKPCC3Q PUT A DASH IN CARRIAGE CONTROL 20540021 AP LINECNT,ONE RECONCILE LINECNT 20560021 B SKP4 GO TO ADD ONE MORE TO LINECNT 20580021 SKP5 AP LINECNT,ONE 20600021 SKP51 LH R2,DX4(R6) GET BYTE COUNT FROM BCB 3817 20620021 LA R2,DX121(R2) 20640021 LH R3,DX6(R6) R3 = LENGTH OF BUFFER 20660021 CR R2,R3 20680021 BH SKP6 NOT ENOUGH ROOM IN BUFF WRITE FI 20700021 L R3,DX0(R6) R3 = ADDRESS OF BUFFER 20720021 AH R3,DX4(R6) ADD BYTES USED SO FAR 20740021 MVC DX0(LX1,R3),SKIPCC NEW CARRIAGE CONTROL IN IST POSI 20760021 MVI DX1(R3),XX40 PROPAGATE A BLANK 20780021 MVC DX2(LX119,R3),DX1(R3) 20800021 STH R2,DX4(R6) 20820021 TM EJECTSW,XXFF WERE WE ALREADY SUPPOSED TO EJEC 20840021 BM EJECTA YES GO THERE 20860021 CP LINECNT,SIXTY WILL WE HAVE TO EJECT NOW 20880021 BNL EJECTR YES GO THERE 20900021 B EXITR ELSE RETURN TO CALLING PHASE 20920021 SKP6 LA R12,SKP51 SAVE RETURN ADDRESS 3817 20940021 B WCOMM CHECK / WRITE / RETURN 20960021 EJECTR SP LINECNT,LINECNT CLEAR LINECNT 20980021 MVC PRINTBUF(LX1),SKIP SET UP EJECT CHARACTER 21000021 B EXITR RETURN TO CALLING PHASE 21020021 EJECTR1 OI MAXLINES,XXFF INDICATE FORCED EJECT (EOP) 44678 21040021 B EJECTR PREPARE TO EJECT 44678 21060021 EJECTG TM MAXLINES,XXFF END-OF-PAGE EJECT? 44678 21080021 BNO EJECTF NO 44678 21100021 NI MAXLINES,XX00 TURN OFF SWITCH 44678 21120021 CLI DX1(R8),EJCTQ 'EJECT' AT END-OF-PAGE? 44678 21140021 BNE EJECTF NO-CONTINUE 44678 21160021 B EJECTR BYPASS FORCED EJECT 44678 21180021 COPYCHK DC X'00' X'00' MEANS CHK ISSUED FOR COPY 21200021 SKPCC1Q EQU C' ' 21220021 SKPCC2Q EQU C'0' 21240021 SKPCC3Q EQU C'-' 21260021 EJCTQ EQU X'00' 21280021 SKIP1Q EQU X'01' 21300021 SKIP2Q EQU X'02' 21320021 SKIP3Q EQU X'03' 21340021 MAXLINES DC X'00' MAX LINES/PAGE CONDITION SW 44678 21360021 SKIPCC DS C CARRIAGE CONTROL FOR SKIP 21380021 EJRETURN DC X'00' RETURN CONTROL TO EJECTD IF ON 21400021 * 21420021 * 21440021 * 21460021 * 21480021 * 21500021 * 21520021 * 21540021 * 21560021 * 21580021 * 21600021 * 21620021 * 21640021 * 21660021 * 21680021 * 21700021 * 21720021 * 21740021 * 21760021 * 21780021 SYSN DC H'20' SYSIN FILE NUMBER 21800021 * 21820021 UNITCOM LH R4,DX4(R6) 21840021 AR R4,R3 TESTS TO SEE IF A FIELD 21860021 CH R4,DX6(R6) WILL FIT AND IF IT DOES 21880021 BC R2,WCOMM WILL NOT FIT IT MOVES AND UPDATES 21900021 BCTR R3,R0 BUFFER CONTROL BLOCK 21920021 L R1,DX0(R6) WHERE TO IF NOT IT EXITS TO REG 15 21940021 AH R1,DX4(R6) IF YES IT EXITS TO REG 14 21960021 STH R4,DX4(R6) UPDATE LENGTH 21980021 EX R3,MOVE 22000021 BR R14 CONTINUE WRITE PROCESSING 22020021 * 22040021 * 22060021 * 22080021 * 22100021 * 22120021 * 22140021 * 22160021 * 22180021 * 22200021 * 22220021 * 22240021 * 22260021 * 22280021 * 22300021 EXITR TM PHZSW,LIST 22320021 BZ EXIT RETURN TO CALLING PHASE 22340021 CP LINECNT,PZERO 22360021 B EXIT1 PAGE 22380021 * 22400021 * 22420021 * 22440021 * 22460021 * 22480021 * 22500021 * 22520021 DS 0F 22540021 SEGSAVE DC F'1' REL. LOC OF SEG. RECORD 22560021 ADS1 DC A(DS1) @ SYSUT1 DCB 22580021 APCBSPT DC A(PCBSPT) @ COBOL SPACE PARAMETERS 22600021 ADECB1 DC A(DECBDS1) @ SYSUT1 DECB 22620021 SEGRECL DC H'0' RECORD LENGTH OF PUT FOR SEG 22640021 SUT1 DC H'4' Y PARAMETER VALUE FOR SYSUT1 22660021 SEGNTSW DC X'00' 3 WAY SEGMENTATION SWITCH 22680021 STRUNCSW DC X'00' INDICATES TRUNCATED WRITE IN SEG 22700021 PTYSAVE DC X'0' SAVE PLACE FOR PRIORITY NUMBER OF 22720021 * THE SEGMENT JUST NOTED 22740021 NOTSEG EQU X'FF' 22760021 CHECKSW DC X'0' TELLS SEGNOTE2 IF A SWRITE WAS DONE 22780021 ONSWITCH EQU X'FF' 22800021 OFFSWTCH EQU X'00' 22820021 * ENTER SEGNOTE.PH5 HAS ENCOUNTERED A SEGMENT CONTROL BREAK.LAST 22840021 * RECORD OF PREVIOUS SEGMENT HAS BEEN PUT. 22860021 SEGNOTE DS 0H 22880021 L R1,DX0(R6) A(BUFFER) 22900021 AH R1,DX4(R6) LENGTH 22920021 MVI DX0(R1),XXFF DELIMITER 22940021 LH R4,DX4(R6) 22960021 LA R4,DX1(R4) NEW LENGTH 22980021 STH R4,SEGRECL SAVE FOR TRUNCATED WRITE 23000021 TM SPECIAL,XXFF 23020021 BO SFIRSTW FIRST I/O THIS PHASE 23040021 BAL R11,CHECKER CHECK PREVIOUS PHYSICAL WRITE 23060021 B SEGNOTE0 BRANCH AROUND NEXT INSTRUCTION 23080021 SFIRSTW DS 0H 23100021 BAL R11,CHECKERB SWITCH BCB POINTERS 23120021 SEGNOTE0 DS 0H 23140021 OI STRUNCSW,XXFF INDICATES TRUNCATED WRITE TO IOCO 23160021 L R1,ADECB1 23180021 MVC DX6(LX2,R1),SEGRECL 23200021 L R1,ADS1 23220021 MVC DX82(LX2,R1),SEGRECL 23240021 BAL R11,WRITER WRITE LAST BLOCK OF PREVIOUS SEGMENT 23260021 NI STRUNCSW,XX00 DCBRECL WILL BE RESTORED 23280021 MVI CHECKSW,ONSWITCH SET IT ON 23300021 BAL R11,CHECKERC UPDATE BCB'S 23320021 MVI SEGNTSW,XXF0 SEGNOTE1 WILL BE ENTERED FROM CHECKER 23340021 MVI CHECKSW,OFFSWTCH SET IT OFF 23360021 TM DX1(R8),ONSWITCH LAST C1 CALL FROM PHASE5? 23380021 BNO EXIT1 NO - RETURN TO PHASE5 23400021 CLC PTYNO,PTYSAVE 23420021 BE SEGNOT00 LEAVE SEGNTSW ALONE 23440021 MVI SEGNTSW,ONSWITCH 23460021 SEGNOT00 BAL R11,CHECKER OWE A CHECK OR A CHECK/NOTE 23480021 MVI SEGNTSW,OFFSWTCH ALL THRU WITH THIS SWITCH 23500021 MVC PURGER,PURGER+NX1 DONT PURGE UT1 23520021 B EXIT1 LAST RETURN TO PHASE5 23540021 * SEGNOTE1 ENTERED AFTER CHECK OF LAST WRITE PREVIOUS SEGMENT 23560021 SEGNOTE1 DS 0H 23580021 OI SEGNTSW,XXFF 23600021 BR R11 RETURN TO NEXT SEQUENTIAL INSTR 23620021 * SEGNOTE2 ENTERED AFTER CHECK OF FIRST WRITE OF SEGMENT 23640021 SEGNOTE2 DS 0H 23660021 CLI CHECKSW,ONSWITCH DO WE HAVE TO CHECK PRIOR TO NOTE? 23680021 BNE SEGNT2A NO - M THAT IT JUST NOTE 23700021 BAL R15,GETDECBA START SETUP FOR CHECK MACRO 23720021 ST R1,READSAV 23740021 CHECK (1) 23760021 L R1,READSAV END SETUP FOR CHECK MACRO 23780021 SEGNT2A ST R1,READSAV START SETUP FOR NOTE MACRO 23800021 * KEEP IT NEAT ETC 23820021 L R1,ADS1 23840021 NOTE (1) 23860021 ST R1,SEGSAVE TO BE RETURNED TO PH5 23880021 L R1,READSAV 23900021 MVC PTYSAVE,PTYNO SAVE PRIORITY NO 23920021 NI SEGNTSW,XX00 23940021 BR R11 RETURN TO WRITE NEXT BLOCK 23960021 * ENTER SEGPNT . THERE HAS BEEN A PREVIOUS READ ON SYSUT1 23980021 SEGPNT DS 0H 24000021 ST R1,SEGSAVE 24020021 L R1,ADS1 SET UP FOR SYSUT1 POINT 24040021 POINT (1),SEGSAVE POINT TO FIRST SEGMENT 24060021 BAL R11,READER READ 24080021 BAL R11,CHECKER CHECK SEGMENT AND TURN OFF SPECI 24100021 B EXIT RETURN TO CALLING PHASE 24120021 * 24140021 UTILITY DC H'17' HILIMIT Y VALUE FOR UTILITY FILE 24160021 * S 24180021 * 24200021 *THIS ROUTINE CLOSES OUT PUT FILES AND CHECKS PUTS 24220021 *TRUNCATION WILL OCCUR FOR UNIT RECORD TYPE OUTPUT FILES TO THE 24240021 *CURRENT LENGTH (SEE WRITER) 24260021 CLOSER EQU * 24280021 TM DX0(R8),XXFF TEST IF COMMON ROUTINE 24300021 BO COMRTN BRANCH IF YES 24320021 MVC CLOSEH,DX4(R6) 24340021 CH R10,UTILITY 24360021 BH CLOSERB NOT A UTILITY 24380021 L R14,DX0(R6) 24400021 AH R14,DX4(R6) 24420021 MVI DX0(R14),XXFF 24440021 CLOSERB TM SPECIAL,XXFF 24460021 BO CLOSERAA FIRST I/O THIS PHASE 24480021 TM SINGBUF,XXFF 24500021 BO CLOSERA SINGLE BUFFER 24520021 BAL R11,CHECKER MUST ISSUE CHECK 24540021 CLOSERA CLC CLOSEH,ZEROES 24560021 * IF FILE IS F2, BETWEEN PHASES 5 + 6, WRITE FF 24580021 * IF EMPTY BUFFER. 24600021 BNE CLOSEZ LENGTH TRUNCATED WRITE NOT ZERO 24620021 CLI LINKCNT+NX1,LSWPH01 PHASE 01 24640021 BE CLOSEZ YES - LAST WRITE UTILITY 24660021 CLI LINKCNT+NX1,LSWPH7 24680021 BNE CLOSERX NOT LAST PHASE 24700021 CLI PURGEB,XXF2 24720021 BNE CLOSERX NOT FIRST I/O BUF2 THIS PHASE 24740021 CLOSEZ EQU * 24760021 CH R10,UTILITY 24780021 BL CLOSERD UTILITY FILE 24800021 OI CLOSE,XXFF 24820021 CLOSERD BAL R11,WRITER WRITE 24840021 BAL R11,CHECKER THEN CHECK 24860021 L PR4,CTRMNT 24880021 CLOSERX CLI DX1(R8),EXTCALL 24900021 BE EXIT1 CALLED FROM ANOTHER PHASE 24920021 BC UNCOND,DX2(R8) INTERNAL CALL DON'T RESTORE REG 24940021 CLOSERAA BAL R11,CHECKERB SWITCH BCB POINTERS 24960021 B CLOSERA CONTINUE CLOSE PROCESSING 24980021 * 25000021 CLOSEH DS H LENGTH OF TRUNCATED WRITE 25020021 CLOSE DC X'00' 'FF' MEANS LAST WRITE ON UTILITY 25040021 * 25060021 CLOSET DS 0H 25080021 L PR4,CTRMNT 25100021 B CLOSOK CONTINUE TCLOSE PROCESSING 25120021 * 25140021 COMRTN DS 0H 25160021 * THIS ROUTINE IS TO BE USED FOR ASYNCHRONOUS PROCESSING 25180021 * ONLY CODING HAS BEEN REMOVED 29 JULY 1968 25200021 B EXIT1 RETURN TO CALLING PHASE 25220021 SYAA SYNADAF ACSMETH=BPAM I/O ERROR EXIT FOR SYSLIB 25240021 BC UNCOND,SYAC * 25260021 SYAB SYNADAF ACSMETH=BSAM I/O ERROR EXIT FOR ALL OTHER FILES 25280021 SYAC LA R2,SYNMSG 25300021 MVC DX14(LX77,R2),DX50(R1) MOVE MESSAGE TO WORK AREA 25320021 SYNADRLS 25340021 WTO MF=(E,(2)) 25360021 L PR4,CTRMNT 25380021 OI SKPRSW,XXFF SET SWITHC TO SKIP PRINTER 25400021 XC FLSHBUF,FLSHBUF 25420021 BC UNCOND,TRMNATE ABNORMAL TERMINATION OF JOB 25440021 SYNMSG DC H'91' MESSAGE LENGTH 25460021 DC X'8000' * 25480021 DC CL87'IKF0003I-D' 25500021 DC X'04004020' * 25520021 * 25540021 LINKBAZ L R8,SPIEAD 25560021 L R2,DX0(R8) 25580021 SPM R2 25600021 SPIE MF=(E,(8)) 25620021 MVC LAST+NX3(LX1),RETCDE 25640021 TM RETOK,XXFF 25660021 BZ LASTB PREPARE TO RETURN TO CALLING PH 25680021 L R13,MYSAVE+NX4 25700021 B LASTC PREPARE TO RETURN TO SUPERVISOR 25720021 LASTB LA R13,SAVEPHSE 25740021 OI RETOK,XX0F 25760021 LASTC LM R14,R12,DX12(R13) 25780021 LAST LA R15,DX0 25800021 BR R14 BRANCH TO SUPVR OR CALLING PH 25820021 EOJ CLI LINKCNT+NX1,LSWPH01 25840021 BNE PH6OR7 NO, IT MUST BE 6 OR 7 25860021 MVI PH01SW,XX01 25880021 MVI RETCDE,XX10 SET RETURN CODE TO TERMINATE 25900021 TM PHZSW,LIST WAS ERROR ON PRINTER 25920021 BO PROK NO, BRANCH 25940021 XC ENDBUF,ENDBUF DO NOT FLUSH PRINT BUFFER 25960021 PROK MVC PURGER(LX3),ENDBUF MOVE CODE TO FLUSH OUT PRINT BUFF 25980021 PH6OR7 CLI LINKCNT+NX1,LSWPH6A 26000021 BNE SETPH7SW NOT XREF 26020021 MVC PURGER,PURGER+NX1 26040021 SETPH7SW MVI LINKCNT+NX1,LSWPH7 26060021 B LINKB PREPARE TO END COMPILATION 26080021 RELSPACA DC A(RELSPACE) TAMER ADDRESS CONSTANT 26100021 ENDBUF DC X'00F600' CONSTANT TO FORCE FLUSH PRINT BU 26120021 PH01SW DC X'00' '01' MEANS ABANDONED IN PH01 26140021 * 26160021 * 26180021 * 26200021 *LINKAGE PACKAGE TO BRING IN PHASES 26220021 * 26240021 * 26260021 * 26280021 * 26300021 LINKA LH R2,LINKCNT 26320021 LA R2,LINKNAME(R2) 26340021 MVC LINKNAME+NX6(LX2),DX8(R2) 26360021 NI RETOK,XX00 26380021 LH R2,LINKCNT 26400021 LA R2,DX2(R2) 26420021 STH R2,LINKCNT 26440021 SRL R2,DX1 CALCULATE PHASW FOR TAMER. 26460021 STC R2,PHASW 26480021 CLI LINKCNT+NX1,LSWPH1B ABOUT TO LINK PHASE1B? 26500021 BE LINKPH1 YES, LEAVE BUFFERS ALONE 26520021 LA R15,POINT+NX2 26540021 LA R14,DX9 26560021 LINKAZ IC R6,DX0(R15) 26580021 SLL R6,DX28 26600021 SRL R6,DX25 26620021 LA R6,BUFCNLS-NX8(R6) 26640021 CLC DX4(LX2,R6),ZEROES 26660021 BNE LINKAZB SKIP NEXT INSTRUCTION 26680021 OI DX0(R15),XXF0 26700021 LINKAZB LA R15,DX2(R15) 26720021 BCT R14,LINKAZ CONTINUE ALTERING POINT FIELD 26740021 CLI LINKCNT+NX1,LSWPH2 26760021 BE LINKTM BRANCH IF YES 26780021 CLI LINKCNT+NX1,LSWPH3 26800021 BNE LINKPH BRANCH IF NO 26820021 LINKTM L R15,ATAMIN YES 26840021 BALR R14,R15 GO TO TAMIN 26860021 LINKPH TM HDRSW,XXFF 26880021 BNZ LINKPH1 LEAVE PRINTBUF,LINECNT ALONE 26900021 MVI PRINTBUF,XXF1 SET SKIP 26920021 SP LINECNT,LINECNT CLEAR LINE COUNT 26940021 LINKPH1 LA R13,SAVEPHSE 26960021 LINK EPLOC=LINKNAME,PARAM=(COS,BUFCNLS,INTO,DS1,BUFX,PHZSW, X26980021 ERRSEV,SEGSAVE,APCBSPT,LINKNAME+10,DECBLIB) 40329 27000021 LINKBA DS 0H 27020021 TM RETOK,XXFF 27040021 BC R12,LINKBAZ MUST ISSUE SPIE 27060021 PURGE MVC PURGER,PURGER+NX1 27080021 TM PURGER,XXFF 27100021 L PR4,CTRMNT 27120021 BZ INTERLUD PURGE COMPLETE 27140021 MVC PURGEB,PURGER 27160021 BAL R0,GOSYSGO FLUSH BUFFERS 27180021 PURGEB DC X'00' SLACK BYTE FOR PURGE CALL 27200021 B PURGE BRANCH TO SHIFT PURGE FIELD 27220021 PGR DS 0XL29 PURGE STRING 27240021 DC X'00' FIRST BYTE 27260021 DC X'00' AFTER PH01 27280021 DC X'00' AFTER PH1A 27300021 DC X'F3F600' AFTER PH1B 27320021 DC X'F2F400' AFTER PH2 27340021 DC X'F1F3F4F600' AFTER PH3 27360021 DC X'F100' AFTER PH4 27380021 DC X'F200' AFTER PH50 27400021 DC X'F1F3F400' AFTER PH51 27420021 DC X'F3F6F7F800' AFTER PH6 NO XREF 27440021 DC X'F600' AFTER PH7 27460021 PURGER EQU PGR PURGE STRING 27480021 LINKB CLC LINKCNT,ZEROES 27500021 BE LINKA MUST LINK TO PHASE01 27520021 OI RETOK,XXFF 27540021 L R3,TBASWGNE 27560021 NI DX0(R3),SPACASK 27580021 CLI LINKCNT+NX1,LSWPH1A 27600021 BE LINKR RETURNING FROM PHASE1A 27620021 CLI LINKCNT+NX1,LSWPH2 27640021 BE LINKR RETURNING FROM PHASE2 27660021 CLI LINKCNT+NX1,LSWPH4 27680021 BE LINKR RETURNING FROM PHASE4 27700021 CLI LINKCNT+NX1,LSWPH50 27720021 BE LINKR RETURNING FROM PHASE5 27740021 CLI LINKCNT+NX1,LSWPH51 27760021 BE LINKR RETURNING FROM PHASE51 27780021 CLI LINKCNT+NX1,LSWPH6 27800021 BE LNKB RETURNING FROM PHASE6 27820021 CLI LINKCNT+NX1,LSWPH7 27840021 BE LINKR RETURNING FROM PHASE7 27860021 LINKT L R15,ATAMOP 27880021 BALR R14,R15 GO TO TAMEOP. 27900021 LINKR LA R13,SAVEPHSE LOAD R13 REG SAV AREA 27920021 ST R13,SAVER13 SET CURRENT SAVE AREA 27940021 RETURN (14,12) 27960021 LNKB TM PHZSW1,XREF 27980021 BNO LINKT NO PH6A- GO THROUGH TAMEOP 28000021 BC UNCOND,LINKR ELSE GO TO LINKR 28020021 ATAMIN DC A(TAMEIN) TAMER ADDRESS CONSTANT 28040021 ATAMOP DC A(TAMEOP) TAMER ADDRESS CONSTANT 28060021 TBASWGNE DC A(TBSWGENE) TAMER ADDRESS CONSTANT 28080021 ARLDIC EQU ATAMOP 28100021 * 28120021 SPIEAD DC A(0) USED WITH SPIE MACRO 28140021 * 28160021 IKFPATCH DS 0F PATCH AREA 28180021 B IKFPATCH EASES BRANCH ADDRESS CODING 28200021 DC 6F'0' 28220021 * 28240021 PH0SECT2 CSECT 28260021 DS 2F X 28280021 DC A(PRINTBUF) X 28300021 DS F X 28320021 DS1 DCB DSORG=PS,MACRF=(RP,WP),DDNAME=SYSUT1,DEVD=DA,RECFM=U, X28340021 LRECL=001,BLKSIZE=0,NCP=1,EODAD=ENDIN,SYNAD=SYAB, X28360021 KEYLEN=0 28380021 DS2 DCB DSORG=PS,MACRF=(R,W),DDNAME=SYSUT2,DEVD=DA,RECFM=FS, X28400021 LRECL=001,BLKSIZE=0,NCP=1,EODAD=ENDIN,SYNAD=SYAB 28420021 DS3 DCB DSORG=PS,MACRF=(R,W),DDNAME=SYSUT3,DEVD=DA,RECFM=FS, X28440021 LRECL=001,BLKSIZE=0,NCP=1,EODAD=ENDIN,SYNAD=SYAB 28460021 DS4 DCB DSORG=PS,MACRF=(R,W),DDNAME=SYSUT4,DEVD=DA,RECFM=FS, X28480021 LRECL=001,BLKSIZE=0,NCP=1,EODAD=ENDIN,SYNAD=SYAB 28500021 SPILL DCB DSORG=PS,MACRF=(R,W),DDNAME=SYSUT1,DEVD=DA,RECFM=F, X28520021 LRECL=512,BLKSIZE=512,NCP=1,SYNAD=SYAB 28540021 IN DCB DSORG=PS,MACRF=(R),DDNAME=SYSIN,DEVD=DA,RECFM=FB, X28560021 LRECL=80,BLKSIZE=0,NCP=1,EODAD=ENDIN,SYNAD=SYAB 28580021 OUT DCB DSORG=PS,MACRF=(W),DDNAME=SYSPRINT,DEVD=DA,RECFM=FBA, X28600021 LRECL=121,BLKSIZE=0,NCP=1,SYNAD=SYAB 28620021 LIB DCB DSORG=PO,MACRF=(R),DDNAME=SYSLIB,DEVD=DA, X28640021 LRECL=80,BLKSIZE=0,NCP=1,EODAD=ENDIN1,SYNAD=SYAA 28660021 PCH DCB DSORG=PS,MACRF=(W),DDNAME=SYSPUNCH,DEVD=DA,RECFM=FB, X28680021 LRECL=80,BLKSIZE=0,NCP=1,SYNAD=SYAB 28700021 GOF DCB DSORG=PS,MACRF=(W),DDNAME=SYSLIN,DEVD=DA,RECFM=FB, X28720021 LRECL=80,BLKSIZE=0,NCP=1,SYNAD=SYAB 28740021 * 28760021 SYATBL DS 80C TABLE OF DD NAMES CREATED BY PHASE 01 28780021 * 28800021 * FORMAT OF DECB'S 28820021 * DC F'0' ECB 28840021 * DC X'00' TYPE 28860021 * DC X'80' TYPE 28880021 * DC AL2(0) 28900021 * DC A(DCB) DCB ADDRESS 28920021 * DC A(AREO) I-O AREA 28940021 * DC A(0) POINTRRS TO I-O STATUS BLOCK 28960021 DECBDS1 DC 2F'0' X 28980021 DC A(DS1) X 29000021 DC 2A(0) X 29020021 DECBDS2 DC 2F'0' X 29040021 DC A(DS2) X 29060021 DC 2A(0) X 29080021 DECBDS3 DC 2F'0' X 29100021 DC A(DS3) X 29120021 DC 2A(0) X 29140021 DECBDS4 DC 2F'0' X 29160021 DC A(DS4) X 29180021 DC 2A(0) X 29200021 DECBSIN DC 2F'0' X 29220021 DC A(IN) X 29240021 DC 2A(0) X 29260021 DECBSOU DC 2F'0' X 29280021 DC A(OUT) X 29300021 DC 2A(0) X 29320021 DECBSPH DC 2F'0' X 29340021 DC A(PCH) X 29360021 DC 2A(0) X 29380021 DECBSGO DC 2F'0' X 29400021 DC A(GOF) X 29420021 DC 2A(0) X 29440021 DECBLIB DC 2F'0' X 29460021 DC A(LIB) X 29480021 DC 2A(0) X 29500021 * 29520021 * 29540021 DS 0F AREA ALIGNMENT FOR RECORDING GET MAINS 29560021 EJECT 29580021 START SAVE (14,12) 29600021 BALR R4,R0 ESTABLISH ADDRESSABILITY 29620021 USING *,R4 29640021 L R6,SVRTER 29660021 ST R13,DX0(R6) 29680021 L R6,BXAD 29700021 ST R1,DX0(R6) 29720021 L R6,DX0(R1) 29740021 L R7,BFAD PICK UP EXECUTE PARAMS 29760021 LA R3,DX1 29780021 AH R3,DX0(R6) 29800021 EX R3,MPARM 29820021 L R5,ADCOS 29840021 LA R5,DX6(R5) 29860021 SPIE 29880021 ST R1,SPIEAD 29900021 L R1,COSAD 29920021 BALR R0,R1 PREPARE TO LINK TO PHASE01 29940021 DC X'A1' LINK TO NEXT PHASE 29960021 BXAD DC A(CORELEFT) X 29980021 BFAD DC A(BUFCNLS) X 30000021 COSAD DC A(COSAA) X 30020021 MPARM MVC DX0(LX0,R7),DX0(R6) 30040021 SVRTER DC A(MYSAVE+4) SYSTEM'S R13 SAVE AREA 30060021 * 30080021 DS 0F 30100021 USING *,R4 30120021 TRMNATE L PR12,ADCOS LOAD ADDRESS OF COS 30140021 LA PR5,DX6(PR12) LOAD BASE REGISTER 30160021 L R13,SAVER13 30180021 TM SKPRSW,XXFF DID IO ERROR OCCURR 30200021 BO SKPRNT YES SKIP PRINTING 30220021 OI PHZSW,LIST SET PRINT SWITCH 30240021 MVI PRINTBUF,XXF1 SET CHARACTER TO EJECT PAGE 30260021 OI LIST2,XX80 SET BIT TO OPEN PRINTER 30280021 LA R1,LIST2 OPEN PRINTER ONLY 30300021 SVC 19 OPEN PRINTER 30320021 NI LIST2,XX7F TURN OFF DELIMITER BIT 30340021 BALR R0,R12 GO TO PUT 30360021 DC X'16' PUT RECORD 30380021 BALR R0,R12 GO TO PRINT 30400021 DC X'86' WRITE RECORD 30420021 L R15,TBAPR ADDRESSIBILITY 30440021 USING PH0TBST2,15 30460021 TM TBERCD,XXFF 30480021 BO SKPRNT NO ABEND DESIRED 30500021 LA R3,LX1 30520021 LA R2,BLANK 30540021 BALR R0,R12 DUMMY PRINT TO UNBUFFER 30560021 DC X'16' 30580021 ABEND DX16,DUMP QUIT FOR THIS TASK 30600021 TBAPR DC A(TBPRIMEB) 30620021 DROP 15 30640021 SKPRNT MVC PURGER(LX3),FLSHBUF MOVE CODE TO FLUSH OUT PRINT BUF 30660021 MVI LINKCNT+NX1,LSWPH7 30680021 MVI RETCDE,XX10 SET RETURN CODE TO 16 30700021 B LINKB TERMINATE RUN 30720021 INTERLUD DS 0H 30740021 L PR4,CTRMNT 30760021 LH R2,LINKCNT 30780021 SLL R2,DX1 30800021 L R2,PHASAD(R2) 30820021 BR R2 GO TO CORRECT INT ROUTINE 30840021 INT1A DS 0H 30860021 B LINKA GO IMMEDIATELY TO LINKA 30880021 INT1B OI LIST1,XX80 30900021 LA R1,LIST1 30920021 SVC 23 TEMPORARY CLOSE 30940021 OI LIST5,XX80 30960021 LA R1,LIST5 30980021 SVC 23 TEMPORARY CLOSE 31000021 NI LIST5,XX7F 31020021 MVI POINT+NX9,XX06 UT4 31040021 MVI BLANK,XX40 31060021 B LINKA NOW GO TO LINKA 31080021 INT2 TM PHZSW,LIST 31100021 BZ INTMAP 31120021 OI SWITCH+DX1,DSOU SOURCE BIT FOR PH6 STATISTICS 31140021 INTMAP OI PHZSW,LIST 31160021 LA R1,LIST3 31180021 SVC 23 31200021 MVC POINT+NX8(LX2),POINTM2 31220021 B LINKA NOW GO TO LINKA 31240021 INT3 LA R1,LIST3 31260021 SVC 23 31280021 OI INTO,XX80 31300021 LA R1,INTO 31320021 SVC 19 OPEN SYSUT1 OUTPUT 31340021 MVC POINT+NX2(LX2),POINTM3 ALLOCATE BUFFERS 31360021 LA R1,LIST2+NX4 31380021 SVC 20 PERMANENT CLOSE 31400021 B LINKA NOW GO TO LINKA 31420021 INT4 DS 0H 31440021 OI INTO,XX80 TCLOSE SYSUT1,SYSUT3 31460021 LA R1,LIST6 31480021 SVC 23 TCLOSE 31500021 MVC POINT+NX2(LX6),POINTM4 31520021 B LINKA NOW GO TO LINKA 31540021 INT50 DS 0H 31560021 OI LIST22,XX80 31580021 LA R1,LIST11 31600021 SVC 23 TCLOSE SYSUT1,SYSUT2 31620021 MVC POINT+NX2(LX8),POINTM50 ALLOCATE BUFFERS FOR PH51 31640021 B LINKA GO LINK PHASE51 31660021 INT51 DS 0H SAME AS OLD INT5 (BEFORE SPLIT PH51) 31680021 INT5 DS 0H 31700021 NI INTO,XX7F TURN OFF LIST DELIMITER 31720021 LA R1,INTO 31740021 SVC 23 TCLOSE SYSUT1-4 31760021 OI LIST4+NX4,XX80 31780021 LA R1,LIST4 31800021 SVC 19 31820021 NI LIST4+NX4,XX7F 31840021 MVC POINT+NX2(LX4),POINTM5 31860021 TM PHZSW1,XREF 31880021 BZ NOX NO XREF- LEAVE PURGER ALONE 31900021 MVC PURGER+NX1(LX10),ALTPURGE 31920021 NOX DS 0H 31940021 CLI SEGLMT,NOTSEG IS PROGRAM SEGMENTED 31960021 BE LINKA NO GET NEXT PHASE 31980021 MVC POINT+NX2(LX8),POINTSEG 32000021 B LINKA GET PHASE 6 32020021 INT6 DS 0H 32040021 TM PHZSW1,XREF IS XREF ON 32060021 BO PREINT6X USER HAS REQUESTED 6A 32080021 BYPASS6A LH R2,LINKCNT BYPASS 6A - INCREMENT LINKCNT BY 2 32100021 LA R2,DX2(R2) 32120021 STH R2,LINKCNT 32140021 OI PHZSW,LIST SET PRINT SWITCH TO PRINT ERRORS 32160021 OI LIST6,XX80 32180021 LA R1,LIST6 32200021 SVC 23 32220021 NI LIST6,XX7F 32240021 MVI POINT+NX5,XX03 32260021 B LINKA NOW GO TO LINKA 32280021 PREINT6X TM PHZSW2,NO6A 32300021 BO BYPASS6A DISASTER CONDITION - MUST BYPASS 6A 32320021 *ALTERNATE PH6 INTERLUDE, TCLOSE SYSUT1-3, BUFFERS - UT1,2,2,1,3,PR 32340021 INT6X OI LIST5,XX80 32360021 LA R1,LIST6 32380021 SVC 23 32400021 NI LIST5,XX7F 32420021 MVC POINT+NX6(LX2),POINTMX 32440021 OI LIST7,XX80 CLOSE SYSUT2 IF XREF 54404 32460021 LA R1,LIST7 IN EFFECT TO FREE 54404 32480021 SVC 14 CONTROL BLOCK AREA (IOB) 54404 32500021 B LINKA NOW GO TO LINKA 32520021 INT6A OI PHZSW,LIST 32540021 MVI POINT+NX5,XX03 32560021 *DEL 32580021 *DEL 32600021 *DEL 32620021 B LINKA NOW GO TO LINKA 32640021 INT7 DS 0H 32660021 NI LIST1,XX7F 32680021 NI LIST3,XX7F 32700021 NI LIST5,XX7F TURN OFF DELIMITER 43123 32720021 NI INTO,XX7F TURN OFF DELIMITER BIT 32740021 NI LIST2,XX7F TURN OFF DELIMITER 43123 32760021 NI LIST2+DX4,XX7F TURN OFF DELIMITER 43123 32780021 NI LIST2+DX8,XX7F TURN OFF DELIMITER 43123 32800021 OI LIST2+DX12,XX80 END OF LIST 43123 32820021 LA R1,INTO SETUP FOR PERMANENT CLOSE 32840021 SVC 20 32860021 CLI PH01SW,XX01 32880021 BE SKIPFRMN SKIP RELSPACE 32900021 L R15,RELSPACA 32920021 BALR R14,R15 GO TO RELSPACE ROUTINE 32940021 SKIPFRMN EQU * 32960021 L R0,CORELEFT 32980021 L R1,TAMAREA 33000021 SR R0,R1 33020021 FREEMAIN R,LV=(0),A=(1) 33040021 B LINKBAZ MUST ISSUE SPIE 33060021 ALTPURGE DC X'F1F2F3F6F7F80000F600' ALTERNATE PURGER CT 33080021 CLOSOK DS 0H 33100021 SRL R10,DX2 GET ACTUAL VALUE OF FILE NUMBER 33120021 STC R10,YVALUE 33140021 SLL R10,DX2 33160021 CLI YVALUE,XX01 33180021 BNE CLOSET1 NOT SYSUT1 33200021 MVC TLIST+NX1(LX3),INTO+NX1 T CLOSING UT1 33220021 B CLOSET4 SYSUT1 SO SKIP TO CLOSET4 33240021 CLOSET1 CLI YVALUE,XX02 33260021 BNE CLOSET2 NOT SYSUT2 33280021 MVC TLIST+NX1(LX3),LIST3+NX1 T CLOSING UT2 33300021 B CLOSET4 SYSUT2 SO SKIP TO CLOSET4 33320021 CLOSET2 CLI YVALUE,XX03 33340021 BNE CLOSET3 NOT SYSUT3 33360021 MVC TLIST+NX1(LX3),LIST1+NX1 T CLOSING UT3 33380021 B CLOSET4 SYSUT3 SO SKIP TO CLOSET4 33400021 CLOSET3 MVC TLIST+NX1(LX3),LIST5+NX1 T CLOSING UT4 33420021 CLOSET4 DS 0H 33440021 TM DX1(R8),XX01 33460021 BZ XREAD BIT OFF SO SKIP NEXT INSTRS 33480021 OI YVALUE,XXF0 33500021 ST R8,X8SAV 33520021 BAL R0,GOSYSGO PURGE FILES 33540021 YVALUE DC X'00' FILE NUMBER 33560021 L R8,X8SAV 33580021 XREAD DS 0H 33600021 LA R1,TLIST 33620021 SVC 23 33640021 BAL R11,CHECKERC SWITCH BCB POINTERS 33660021 SRL R10,DX1 33680021 LA R10,POINT(R10) 33700021 OI DX0(R10),XXF0 33720021 B EXIT1 RETURN TO CALLING PHASE 33740021 X8SAV DS F SAVE AREA FOR R8 33760021 PHASAD DC A(LINKA) TABLE OF INTERLUDE ADDRESSES 33780021 DC A(LINKA) X 33800021 DC A(INT1A) X 33820021 DC A(INT1B) X 33840021 DC A(INT2) X 33860021 DC A(INT3) X 33880021 DC A(INT4) X 33900021 DC A(INT50) X 33920021 DC A(INT51) X 33940021 DC A(INT6) LIST OF DCB'S FOR OPEN/CLOSE 33960021 DC A(INT6A) X 33980021 DC A(INT7) X 34000021 CNOP 0,4 34020021 LIST11 DC X'17' X 34040021 DC AL3(DS1) X 34060021 LIST22 DC X'17' X 34080021 DC AL3(DS2) X 34100021 TLIST DC X'97' X 34120021 DC AL3(0) X 34140021 LIST7 DC X'17' X 34160021 DC AL3(DS2) X 34180021 LIST6 DC X'17' X 34200021 DC AL3(DS3) X 34220021 INTO DC X'17' X 34240021 DC AL3(DS1) X 34260021 LIST5 DC X'17' X 34280021 DC AL3(DS4) X 34300021 LIST3 DC X'17' X 34320021 DC AL3(DS2) X 34340021 LIST1 DC X'17' X 34360021 DC AL3(DS3) X 34380021 LIST4 DC X'3F' X 34400021 DC AL3(GOF) X 34420021 DC X'3F' X 34440021 DC AL3(PCH) X 34460021 LIST2 DC X'3F' X 34480021 DC AL3(OUT) X 34500021 DC X'00' X 34520021 DC AL3(IN) X 34540021 DC X'30' X 34560021 DC AL3(LIB) X 34580021 DC X'9F' X 34600021 DC AL3(SPILL) X 34620021 NOLIBRY LA R2,MESSLIB LOAD ADDRESS OF MESSAGE 34640021 LA R3,DX89 34660021 L R13,SAVER13 34680021 B TRMNATE GO TO TERMINATE RUN 34700021 * 34720021 MESSLIB DC C'IKF0002I-D INVALID BASIS LIBRARY NAME OR LIB ' 34740021 DC C'OPTION NOT SPECIFIED. COMPILATION ABANDONED.' 34760021 ADCOS DC A(COS) X 34780021 ADSYAT DC A(SYATBL) X 34800021 FLSHBUF DC X'00F600' CONSTANT TO FLUSH PRINT BUFFER 34820021 SKPRSW DC X'00' X 34840021 LSWPH01 EQU X'2' 34860021 LSWPH1A EQU X'4' 34880021 LSWPH1B EQU X'6' 34900021 LSWPH2 EQU X'8' 34920021 LSWPH3 EQU X'A' 34940021 LSWPH4 EQU X'C' 34960021 LSWPH50 EQU X'E' 34980021 LSWPH51 EQU X'10' 35000021 LSWPH6 EQU X'12' 35020021 LSWPH6A EQU X'14' 35040021 LSWPH7 EQU X'16' 35060021 LNKRQST1 EQU X'50' 35080021 LNKRQST2 EQU X'A0' 35100021 EXTCALL EQU X'CC' 35120021 DROP R4 35140021 DROP R5 35160021 EJECT 35180021 SPACE 5 35200021 PH0TBST1 CSECT 35220021 * 35240021 ****** ** 35260021 * 35280021 * 35300021 * TABLE - HANDLING ROUTINES 35320021 * BASE REGISTERS 35340021 * R15 INSTRUCTION AREAS 35360021 * R11 INSTRUCTION AREAS 35380021 * R12 DATA AREAS 35400021 * 35420021 * 35440021 ****** ** 35460021 * EXTERNAL CALL TO TABLE HANDLER. 35480021 * 35500021 * 35520021 USING TBDATA,R12 35540021 USING TBCOMMN,R11 35560021 USING *,R15 35580021 SPACE 2 35600021 PRIME STM R0,R15,TBSAV1 35620021 BAL R14,TBINITRG INITIALIZE BASE REGISTERS 35640021 BR R15 GO TO TBPRIMEB 35660021 SPACE 2 35680021 USING *,R15 35700021 INSERT STM R0,R15,TBSAV1 35720021 BAL R14,TBINITRG INITIALIZE BASE REGISTERS 35740021 L R14,TBAINSTA 35760021 BR R14 GO TO TBINSERT 35780021 SPACE 2 35800021 USING *,R15 35820021 TABREL STM R0,R15,TBSAV1 35840021 BAL R14,TBINITRG INITIALIZE BASE REGISTERS 35860021 L R14,TBATABRL 35880021 BR R14 GO TO TBTABREL 35900021 SPACE 2 35920021 USING *,R15 35940021 TAMEIN STM R0,R15,TBSAV1 35960021 BAL R14,TBINITRG INITIALIZE BASE REGISTERS 35980021 L R14,TBATAMEN 36000021 BR R14 GO TO TBTAMEIN 36020021 SPACE 2 36040021 USING *,R15 36060021 STATIC STM R0,R15,TBSAV1 36080021 BAL R14,TBINITRG INITIALIZE BASE REGISTERS 36100021 L R14,TBASTATC 36120021 BR R14 GO TO TBSTATIC 36140021 SPACE 2 36160021 USING *,R15 36180021 DICSPC STM R0,R15,TBSAV1 36200021 BAL R14,TBINITRG INITIALIZE BASE REGISTERS 36220021 L R14,TBADICSP 36240021 BR R14 GO TO TBDICSPC 36260021 SPACE 2 36280021 USING *,R15 36300021 MOVDIC STM R0,R15,TBSAV1 36320021 BAL R14,TBINITRG INITIALIZE BASE REGISTERS 36340021 L R14,TBAMOVDI 36360021 BR R14 GO TO TBMOVDIC 36380021 SPACE 2 36400021 USING *,R15 36420021 RELDIC EQU * 36440021 TAMEOP STM R0,R15,TBSAV1 36460021 BAL R14,TBINITRG INITIALIZE BASE REGISTERS 36480021 L R14,TBATAMEP 36500021 BR R14 GO TO TBTAMEOP 36520021 SPACE 3 36540021 USING *,R15 36560021 RELSPACE STM R0,R15,TBSAV1 36580021 BAL R14,TBINITRG INITIALIZE BASE REGISTERS 36600021 L R14,TBRELSPA 36620021 BR R14 GO TO TBRELSPC 36640021 * 36660021 USING *,R15 36680021 GETALL STM R0,R15,TBSAV1 PHASE 6 & 6A CALL FOR ALL AVAIL SPAC 36700021 * 36720021 BAL R14,TBINITRG INITIALIZE BASE REGISTERS 36740021 L R14,TBAGTALL 36760021 BR R14 GO TO TBGETALL 36780021 SPACE 5 36800021 ****** THIS ROUTINE INITIALIZES BASE REGISTERS ** 36820021 SPACE 36840021 TBINITRG BALR R15,R0 ESTABLISH ADDRESSABILITY 36860021 USING *,R15 36880021 L R12,TBADATA 36900021 L R11,TBACOMMN 36920021 L R15,TBAPRIME 36940021 BR R14 RETURN TO NEXT SEQUENTIAL INSTR 36960021 TBSAV1 DS 16F REGISTER SAVEAREA 36980021 TBADATA DC A(TBDATA) X 37000021 TBACOMMN DC A(TBCOMMN) X 37020021 SPACE 3 37040021 USING TBPRIMEB,R15 37060021 EJECT 37080021 * COMMON SUBROUTINE AREA. 37100021 * 37120021 TBCOMMN EQU * 37140021 SPACE 5 37160021 ****** ** 37180021 * THIS ROUTINE WILL WRITE OUT A SECTION OF THE DICTIONARY 37200021 * IT IS CALLED BY TBSPILL. 37220021 * INPUT - R9 POINTS TO START ADDRESS OF SECTION TO BE 37240021 * SPILLED. 37260021 * OUTPUT - ENTRY IN DICOT TABLE IS MODIFIED 37280021 ****** ** 37300021 TBWRITE STM R14,R7,TYWSAVR 37320021 L R5,TYSPLAD PUT DCB ADD IN R5 37340021 LR R6,R9 37360021 BAL R14,TBGETDIC GET ENTRY IN DICOT TABLE 37380021 TM DX0(R7),TBUPDATE IS U FLAG ON IN DICOT TABLE 37400021 BO TYXD YES GO TO ISSUE XDAP 37420021 WRITE TYDECB,SF,(R5),(R9) ISSUE WRITE MACRO 37440021 CHECK TYDECB 37460021 L R15,TBAPRIME 37480021 MVC DX4(LX8,R7),DX5(R5) 37500021 B TYSETF X 37520021 TYXDAP1 LA R4,DX4(R7) 37540021 NI TYXECB,XXBF 37560021 TYXDAP XDAP TYXECB,WI,(R5),(R9),512,,(R4) 37580021 WAIT 1,ECB=TYXECB 37600021 SPACE 37620021 * RESTORE BASE REGISTER AFTER SVC 37640021 L R15,TBAPRIME 37660021 BCR R15,R2 X 37680021 TYXD L R2,TBAPHASW 37700021 * IS IT PHASE 3, IF NOT BRANCH 37720021 CLI DX0(R2),TAM3Q 37740021 BNE TYXD1 NOT EQUAL TO X'05' 37760021 * IF SECT UNCHANGED SINCE LAS WRIT 37780021 * OUT, DON'T WRITE AGAIN 37800021 TM DX0(R7),TBFLWRTR 37820021 BZ TYSETF SKIP NEXT 2 INSTRUCTIONS 37840021 TYXD1 MVI TYXDAP+NX19,XX0D 37860021 BAL R2,TYXDAP1 MUST ISSUE XDAP 37880021 TYSETF MVI DX0(R7),TBSPILD+TBUPDATE 37900021 * 37920021 LM R14,R7,TYWSAVR 37940021 BR R14 RETURN TO NEXT SEQUENTIAL INSTR 37960021 SPACE 37980021 ****** ** 38000021 * THIS ROUTINE WILL READ BACK A SECTION OF THE DICTIONARY 38020021 * IT IS CALLED BY TBMDVDIC AND TBTAMEIN 38040021 * INPUT - R9 HAS ADDRESS IN CORE INTO WHICH SECTION 38060021 * SHOULD BE READ. R7 HAS POINTER TO DICOT TABLE 38080021 * OUTPUT - ENTRY IN DICOT TABLE IS MODIFIED 38100021 ****** ** 38120021 SPACE 38140021 TBREADIC STM R14,R7,TYWSAVR 38160021 L R5,TYSPLAD GET DCB ADDRESS 38180021 * 38200021 MVI TYXDAP+NX19,XX0E 38220021 BAL R2,TYXDAP1 MUST ISSUE XDAP 38240021 ST R9,DX0(R7) STORE CORE ADD IN DICOT TABLE 38260021 MVI DX0(R7),TBIN+TBUPDATE 38280021 L R2,TBAPHASW GET NXT PHASE NO IN R2 38300021 CLI DX0(R2),XX03 IS THIS PHASE 2 38320021 BNE TBRNP2 RESTORE REGISTERS AND RETURN 38340021 OI DX0(R7),XX10 TURN ON BIT 3 OF DICT SIG 38360021 TBRNP2 EQU * 38380021 LM R14,R7,TYWSAVR 38400021 BR R14 RETURN TO CALLING ROUTINE 38420021 SPACE 5 38440021 * 38460021 * TBTAMEOP - INTERPHASE INITIALIZATION ROUTINE. 38480021 * 38500021 * 38520021 SPACE 5 38540021 TBRELSPC EQU * 46147 38560021 L R7,TBSPACGT ANY COBOL SPACE 46147 38580021 LTR R7,R7 GOTTEN 46147 38600021 BZ TBTAMENX NO, FREE MFA ONLY 46147 38620021 LA R8,GETTABLE POINT TO GET TABLE 46147 38640021 TBREL1 C R8,AGETEND LOOKED AT WHOLE TABLE 46147 38660021 BE TBRELEND EXIT 46147 38680021 LM R0,R1,DX0(R8) SET UP TO FREE 46147 38700021 LTR R0,R0 HAS ANY BEEN GOTTEN 46147 38720021 BZ TBREL2 FOR THIS ENTRY, NO 46147 38740021 FREEMAIN R,LV=(0),A=(1) GIVE IT BACK 46147 38760021 TBREL2 LA R8,DX8(R8) LOOK AT NEXT ENTRY 46147 38780021 BC UNCOND,TBREL1 UNTIL FINISHED 46147 38800021 TBRELEND L R15,TBTAMNXA A(TBTAMENX) 46147 38820021 BR R15 X 46147 38840021 TBTAMNXA DC A(TBTAMENX) ENSURE R15 AFTER FREEMAIN 46147 38860021 *DEL 38880021 *DEL 38900021 *DEL 38920021 *DEL 38940021 *DEL 38960021 *DEL 38980021 *DEL 39000021 *DEL 39020021 *DEL 39040021 *DEL 39060021 *DEL 39080021 TBTAMEOP EQU * 39100021 * 39120021 * 39140021 L R10,TBAPHASW 39160021 * 39180021 * 39200021 * 39220021 * 39240021 * 39260021 * 39280021 TBINTP01 CLI DX0(R10),TAM3Q 39300021 BNE TBINTP04 NOT EQUAL TO X'05' 39320021 OI TBSWGENE,TBFLNODC 39340021 LA R4,TBMASTAM RELEASE DICTIONARY SPACE 39360021 TBINTP0X L R5,TBDBEGAR(R4) 39380021 L R6,TBDSTADD(R4) 39400021 L R7,TBDLENG(R4) 39420021 SR R6,R5 39440021 SR R7,R6 39460021 ST R7,TBDCLENG(R4) 39480021 C R4,TBLASMTM 39500021 BE TBINTP04 R4=@LAST MASTAM USED SO FAR 39520021 LA R4,TBMSTMLG(R4) 39540021 BC UNCOND,TBINTP0X LOOP THROUGH UNTIL EQUAL 39560021 TBINTP04 SR R5,R5 39580021 IC R5,DX0(R10) 39600021 STC R5,TBPHZNO 39620021 CLI TBPHZNO,TAM6Q 39640021 BE TBINTP03 TBPHZNO = X'08' 39660021 AH R5,TBCOM001 39680021 SLL R5,DX2 39700021 L R6,PCBSPT(R5) 39720021 TBINTP05 L R7,TBSPACGT 39740021 SR R6,R7 39760021 LTR R6,R6 39780021 BNM TBTAMENX RESTORE REGISTERS AND BRANCH 39800021 LPR R7,R6 39820021 ST R7,FREEMANE 39840021 OI TBSWGENE,TBSPASKD 39860021 * 39880021 * HAVE TO GIVE SOME BACK 39900021 TBINTP02 BAL R14,TBPACKGN PACK ALL TABLES IN ALL MASTAMS 39920021 LA R4,TBMASTAM POINT R4 TO 1ST MASTAM 39940021 LA R5,DX56(R4) POINT R5 TO 3RD MASTAM 39960021 L R5,DX0(R5) 39980021 LTR R5,R5 IS IT BEING USED 40000021 BNZ TBERR4 YES - WE CAN'T HANDLE THIS 40020021 * ABANDON COMPILATION 40040021 BC UNCOND,TBINTP20 MUST ALTER TBLSUM,ETC 40060021 TBINTP03 L R6,CBSPH7 40080021 BC UNCOND,TBINTP05 GO IMMEDIATELY TO TBINTP05 40100021 TBINTP09 L R6,TBSPACGT 40120021 SR R6,R0 40140021 LTR R6,R6 40160021 BNZ TBINTP10 LEAVE TBSWGENE ALONE 40180021 NI TBSWGENE,SPACASK 40200021 TBINTP10 ST R6,TBSPACGT 40220021 LA R8,GETTABLE 40240021 FREELOOK C R1,DX4(R8) 40260021 BE FREEHIT R8 = @ GETEND 40280021 C R8,AGETEND 40300021 BE TBERR1 R8 = AGETEND 40320021 LA R8,DX8(R8) 40340021 BC UNCOND,FREELOOK LOOP THROUGH UNTIL EQUAL 40360021 * 58329 40380021 FREESV DC 4F'0' SAVE REGS. DESTROYED BY FREEMN 58329 40400021 * 58329 40420021 FREEHIT LR R5,R0 40440021 C R5,DX0(R8) 40460021 BE FREEHIT1 R5 = GETTABLE ENTRY 40480021 BL TBINTP13 R5 < GETTABLE ENTRY 40500021 L R0,DX0(R8) ENTRY LENGTH INTO R0 40520021 LA R14,FREEHIT2 40540021 BC UNCOND,TBINTP11 MUST ISSUE FREEMAIN 40560021 FREEHIT2 SR R5,R0 40580021 AR R1,R0 40600021 LR R0,R5 40620021 LA R8,GETTABLE 40640021 BC UNCOND,FREELOOK LOOP THROUGH FREELOOK--->EQUAL 40660021 TBINTP11 STM R14,R1,FREESV R14-R1 FREEMAIN SAVE 58329 40680021 FREEMAIN R,LV=(0),A=(1) 58329 40700021 LM R14,R1,FREESV RESTORE AFTER FREEMAIN 58329 40720021 CLI GETSW,XXFF 40740021 BE TBINTP15 DON'T ZERO OUT 40760021 XC DX0(LX8,R8),DX0(R8) 40780021 TBINTP15 L R15,TBAPRIME 40800021 BR R14 RETURN TO NEXT SEQUENTIAL INSTR 40820021 FREEHIT1 LA R14,TBINTP12 40840021 BC UNCOND,TBINTP11 MUST ISSUE FREEMAIN 40860021 TBINTP13 LA R14,TBINTP12 40880021 L R6,DX0(R8) 40900021 SR R6,R5 40920021 ST R6,DX0(R8) 40940021 L R6,DX4(R8) 40960021 AR R6,R5 40980021 ST R6,DX4(R8) 41000021 MVI GETSW,XXFF 41020021 BC UNCOND,TBINTP11 MUST ISSUE FREEMAIN 41040021 TBINTP12 XC TBWCHWAY,TBWCHWAY 41060021 XC GETSW,GETSW 41080021 XC TBLSUM,TBLSUM 41100021 XC FREEMANE,FREEMANE 41120021 XC DCTLNGTH,DCTLNGTH 41140021 CLI TBPHZNO,TAM3Q 41160021 BH TBTAMEOP TBPHZNO > X'05' 5084 41180021 L R10,TBATIB30 41200021 L R10,DX0(R10) 41220021 L R9,TBACCSW 41240021 MVC DX1(LX3,R9),DX1(R10) 41260021 BC UNCOND,TBTAMEOP X 5084 41280021 * TOTAL TABLES TOO LARGE FOR MFA 41300021 * 41320021 TBINTP20 LA R4,TBMASTAM 41340021 TBINTP21 BAL R14,TBTBLSUM ALTER TBLSUM 41360021 CLI TBPHZNO,TAM2Q 41380021 BH TBINTP22 TBPHZNO > X'04' 41400021 BAL R14,TBDICTSP GET COBOL SPACE 41420021 TBINTP22 L R9,FREEMANE 41440021 LR R7,R9 41460021 L R8,TBLSUM 41480021 AR R9,R8 41500021 A R9,DCTLNGTH 41520021 C R9,FREEMANE 41540021 BE TBINTP30 X 41560021 * WILL IT ALL FIT IN 41580021 L R6,TBDLENG(R4) THIS MASTAM AREA? 41600021 CR R6,R9 41620021 BL TBINTP24 NO - IS THERE ANOTHER MASTAM 41640021 L R10,TBDBEGAR(R4) THEY WILL FIT 41660021 L R5,TBATAMAR 41680021 L R5,DX0(R5) 41700021 CR R10,R5 41720021 BE TBINTP26 R10 = TAMAREA 41740021 BNH TBINTPA 50784 41760021 AR R10,R6 CURRENT AREA ABOVE MAIN TAMAREA50784 41780021 B TBINTPB R6 = ENTIRE LENGTH 50784 41800021 TBINTPA EQU * 50784 41820021 LR R9,R10 SAVE ORIGIN 50784 41840021 AR R10,R6 R6 = ENTIRE LENGTH 41860021 CR R10,R5 50784 41880021 BNH TBINTPB CURRENT AREA BELOW MAIN TAMAREA50784 41900021 AR R9,R7 MASTAM BEGIN + NEEDED SPACE 50784 41920021 CR R9,R5 CHECK OVERLAP OF MAIN TAMAREA 50784 41940021 BH TBINTP26 PROTECT MAIN TAMAREA 50784 41960021 TBINTPB EQU * 50784 41980021 ST R10,TBENDADR THIS IS THE HI ADDR IN AREA 42000021 S R10,DCTLNGTH 42020021 L R9,TBDSTADD(R4) 42040021 BAL R14,TBMOVDON MOVE TABLES TO HICORE 42060021 SR R10,R8 42080021 LR R9,R10 FIRST BYTE OF TABLES 42100021 L R10,TBDBEGAR(R4) 42120021 AR R10,R7 R10 = NEW START ADDRESS 42140021 LR R5,R10 42160021 CR R10,R9 42180021 BE TBINTP23 SKIP TBMOVUP 42200021 BAL R14,TBMOVUP MOVE TABLE TO LOW ADDRESSES 42220021 TBINTP23 L R6,TBDBEGAR(R4) 42240021 LR R1,R6 SET UP FOR FREEMAIN 42260021 SR R5,R6 42280021 ST R5,SHIFTVAL 42300021 ST R10,TBDBEGAR(R4) 42320021 L R0,FREEMANE SET UP FOR FREEMAIN 42340021 L R6,TBENDADR 42360021 SR R6,R10 42380021 ST R6,TBDLENG(R4) 42400021 SR R6,R8 R8 = LENGTH OF TABLES 42420021 S R6,DCTLNGTH 42440021 ST R6,TBDCLENG(R4) 42460021 AR R10,R8 42480021 ST R10,TBDSTADD(R4) 42500021 L R9,SHIFTVAL 42520021 L R5,TBDFSTAM(R4) 42540021 BAL R14,TBTAMSH UPDATE TAM TABLE @'S-->HIGHCORE 42560021 BC UNCOND,TBINTP09 FREEMAIN AND EXIT 42580021 * NO FIT - CAN WE SPILL DICTIONARY 42600021 TBINTP24 CLI TBPHZNO,TAM3Q 42620021 BL TBINTP50 TRY TO SPILL 42640021 * MAYBE THERE'S ANOTHER MASTAM 42660021 TBINTP26 LR R5,R4 42680021 LA R4,TBMSTMLG(R4) 42700021 L R6,TBDBEGAR(R4) 42720021 LTR R6,R6 42740021 BNZ TBINTP21 LOOKING AT 2ND MASTAM TRY AGAIN 42760021 LA R6,TBMASTAM ADDR OF 1ST MASTAM 43972 42780021 CR R5,R6 IS IT THE 1ST MASTAM 43972 42800021 BE TBERR4 THERE WAS ONLY 1 - NO HOPE 42820021 BC UNCOND,TBINTP40 X 42840021 * NO TABLES AND NO DICTIONARY HERE 42860021 TBINTP30 L R1,TBDBEGAR(R4) 42880021 L R0,FREEMANE SET UP FOR FREEMANE 42900021 LA R7,TBMASTAM 42920021 CR R7,R4 42940021 BE TBINTP32 @TBMASTAM = R4 42960021 ST R7,TBLASMTM 42980021 L R0,TBDLENG(R4) 43000021 XC DX0(TBMSTMLG,R4),DX0(R4) CLEAR 2ND MASTAM 43020021 BC UNCOND,TBINTP09 NOW GO TO TBINTP09 43040021 TBINTP32 L R5,TBATAMAR 43060021 L R5,DX0(R5) 43080021 CR R5,R1 43100021 BE TBINTP26 TAMAREA = R1 43120021 BL TBINTPC MAIN TAMAREA OVERLAP IMPOSSIBLE50784 43140021 LR R7,R1 CURRENT TAMER AREA 50784 43160021 AR R7,R0 +LENGTH TO BE FREED 50784 43180021 CR R7,R5 CHECK FOR MAIN TAMAREA OVERLAP 50784 43200021 BH TBINTP26 EXISTS, TRY NEXT MASTAM 50784 43220021 TBINTPC EQU * 50784 43240021 L R7,FREEMANE 43260021 C R7,TBDLENG(R4) 43280021 BL TBINTP33 FREEMANE LESS 43300021 LA R4,TBMSTMLG(R4) 43320021 BC UNCOND,TBINTP21 PREPARE TO ALTER TBLSUM,ETC 43340021 TBINTP33 L R6,TBDBEGAR(R4) 43360021 AR R6,R7 43380021 ST R6,TBDBEGAR(R4) 43400021 ST R6,TBDSTADD(R4) 43420021 L R6,TBDLENG(R4) 43440021 SR R6,R7 43460021 ST R6,TBDLENG(R4) 43480021 ST R6,TBDCLENG(R4) 43500021 BC UNCOND,TBINTP09 PREPARE TO LOOP THRU FREELOOK 43520021 TBINTP50 L R6,TBDNSECT(R4) 43540021 CH R6,TBCON003 43560021 BL TBINTP26 R6 < DECIMAL '03' 43580021 BAL R14,TBSPILL PREPARE TO SPILL LAST DICT SECT 43600021 BC UNCOND,TBINTP21 MUST ALTER TBLSUM,ETC 43620021 TBINTP40 LA R4,TBMASTAM 43640021 LA R6,TBMSTMLG(R4) 43660021 L R5,TBDCLENG(R4) 43680021 L R8,DCTLNGTH ARE THERE ANY DICT SECTS. 45083 43700021 LTR R8,R8 IN THE SECOND MASTAM 45083 43720021 BNZ TBERR4 YES WE CANT COMPILE 45083 43740021 L R8,TBLSUM 43760021 CR R5,R8 43780021 BL TBERR4 R5 < TBLSUM 43800021 L R10,TBDSTADD(R4) 43820021 L R9,TBDBEGAR(R6) 43840021 BAL R14,TBMOVDON MOVE TABLE TOWARDS HIGH CORE 43860021 L R7,TBDBEGAR(R4) 43880021 SR R7,R9 43900021 ST R7,SHIFTVAL 43920021 LR R9,R7 43940021 L R5,TBDFSTAM(R6) 43960021 LR R4,R6 43980021 BAL R14,TBTAMSH UPDATE TAM TABLE ADDRESSES 44000021 LA R4,TBMASTAM 44020021 AR R10,R8 R10 STILL HAS OLD STADDR IN 1ST MSTM 44040021 ST R10,TBDSTADD(R4) 44060021 L R10,TBDSTADD(R6) 44080021 SR R10,R8 44100021 ST R10,TBDSTADD(R6) 44120021 L R10,TBDCLENG(R4) 44140021 SR R10,R8 44160021 ST R10,TBDCLENG(R4) 44180021 L R10,TBDCLENG(R6) 44200021 AR R10,R8 44220021 ST R10,TBDCLENG(R6) 44240021 LR R4,R6 44260021 BC UNCOND,TBINTP21 MUST ALTER TBLSUM,ETC 44280021 TBCHKDIC BC UNCOND,TBERR4 SHOULDN'T BE HERE ANY MORE 44300021 TBTBLSUM L R6,TBDBEGAR(R4) 44320021 L R7,TBDSTADD(R4) 44340021 SR R7,R6 44360021 ST R7,TBLSUM 44380021 BR R14 RETURN TO NEXT SEQUENTIAL INSTR 44400021 TBDICTSP L R6,TBLSUM 44420021 L R7,TBDCLENG(R4) 44440021 AR R6,R7 44460021 L R7,TBDLENG(R4) 44480021 SR R7,R6 44500021 ST R7,DCTLNGTH 44520021 BR R14 RETURN TO NEXT SEQUENTIAL INSTR 44540021 SPACE 5 44560021 SPACE 5 44580021 * TBGETSPC - ASK FOR COBOL SPACE = SPACE NOT OCCUPIED BY A 44600021 * PHASE SMALLER THAN PH5. 44620021 * R1 IS DESTROYED BY THIS ROUTINE. 44640021 * 44660021 SPACE 5 44680021 TBGETSPC STM R5,R10,TBSAV3 44700021 ST R14,TBSAV314 44720021 TM TBSWGENE,TBSPASKD 44740021 BO TBGETXIT X 44760021 L R10,TBAPHASW 44780021 SR R5,R5 44800021 IC R5,DX0(R10) 44820021 CLI DX0(R10),LONGPHS 44840021 BE TBGETXIT THIS IS LONGEST PHASE 44860021 SH R5,TBCON002 44880021 SLL R5,DX2 44900021 L R6,PCBSPT(R5) 44920021 L R7,TBSPACGT 44940021 ST R6,TBSPACGT 44960021 SR R6,R7 44980021 LTR R6,R6 45000021 BZ TBGET01 45020021 MVC GETTABLE(LX24),GETTABLE+NX8 45040021 ST R6,GETTABLE+NX24 45060021 LR R0,R6 45080021 GETMAIN R,LV=(0) 45100021 L R15,TBAPRIME 45120021 ST R1,GETTABLE+NX28 45140021 LR R0,R6 45160021 * 45180021 * TEST IF NEW AREA IS CONTIGUOUS TO AN OLD ONE. 45200021 * 45220021 LA R6,TBMASTAM GET FIRST MASTAM. 45240021 LR R9,R1 45260021 AR R9,R0 45280021 TBGET06 C R9,TBDBEGAR(R6) 45300021 BE TBGET05 LOW CORE CONTIGUITY. 45320021 L R10,TBDBEGAR(R6) 45340021 A R10,TBDLENG(R6) 45360021 CR R1,R10 45380021 BE TBGET55 HIGH CORE CONTIGUITY. 45400021 C R6,TBLASMTM 45420021 BE TBGET07 NO CONTIGUITY AT ALL. 45440021 LA R6,TBMSTMLG(R6) 45460021 B TBGET06 TRY NEXT AREA. 45480021 SPACE 2 45500021 * NO CONTIGUITY - SET A NEW MASTAM. 45520021 * 45540021 * 45560021 TBGET07 LA R6,TBMSTMLG(R6) 45580021 ST R6,TBLASMTM 45600021 BAL R14,TBGET77 UPDATE MASTAM 45620021 ST R1,TBDSTADD(R6) 45640021 MVC TBDFSTAM(LX4,R6),TBNEXTAM 45660021 MVC TBDLSTAM(LX4,R6),TBNEXTAM 45680021 * 45700021 * 45720021 TBGET01 OI TBSWGENE,TBSPASKD 45740021 TBGETXIT LM R5,R10,TBSAV3 RETURN 45760021 L R14,TBSAV314 45780021 OI TBSWGENE,TBSPASKD 45800021 BR R14 RETURN TO NEXT SEQUENTIAL INSTR 45820021 SPACE 2 45840021 TBGET05 LR R10,R1 MOVE TABLE TOWARDS LOW CORE 45860021 L R9,TBDBEGAR(R6) 45880021 L R8,TBDSTADD(R6) 45900021 SR R8,R9 45920021 BAL R14,TBMOVUP MOVE TABLE TOWARDS LOW @'S 45940021 LR R10,R4 45960021 LR R4,R6 45980021 L R5,TBDFSTAM(R4) 46000021 LR R9,R0 46020021 BAL R14,TBTAMSL UPDATE TAM'S 46040021 LR R4,R10 46060021 L R9,TBDSTADD(R6) UPDATE MASTAM'S. 46080021 SR R9,R0 46100021 ST R9,TBDSTADD(R6) 46120021 BAL R14,TBGET77 UPDATE MASTAM 46140021 * UPDATE HASH TABLE ADDRESS IF NEEDED 46160021 * 46180021 L R10,TBAPHASW 46200021 CLI DX0(R10),TAM3Q 46220021 BH TBGETXIT > X'05' 46240021 L R10,TBATIB30 46260021 L R10,DX0(R10) R10 HAS HASH TAM ADDR. 46280021 L R9,TBACCSW 46300021 MVC DX1(LX3,R9),DX1(R10) 46320021 B TBGETXIT RETURN 46340021 SPACE 5 46360021 SPACE 2 46380021 TBGET55 TM TBSWGENE,TBFLNODC 46400021 BZ TBGET07 DICT. DONT MOVE IT .CREATE 46420021 * NEW TAM. 46440021 BAL R14,TBGET78 UPDATE MASTAM 46460021 B TBGETXIT RETURN 46480021 EJECT 46500021 * UPDATE MASTAM 46520021 TBGET77 ST R1,TBDBEGAR(R6) 46540021 TBGET78 L R9,TBDLENG(R6) 46560021 AR R9,R0 46580021 ST R9,TBDLENG(R6) 46600021 L R9,TBDCLENG(R6) 46620021 AR R9,R0 46640021 ST R9,TBDCLENG(R6) 46660021 BR R14 RETURN TO NEXT SEQUENTIAL INSTR 46680021 * 46700021 * PHASE 6 & 6A CALL FOR ALL AVAILABLE SPACE 46720021 * 46740021 TBGETALL DS 0H 46760021 TM TBSWGENE,TBSPASKD 46780021 BO TBGTAL10 YES - BYPASS GETMAIN 46800021 BAL R14,TBGETSPC ASK FOR COBOL SPACE 46820021 TBGTAL10 BAL R14,TBPACKGN PACK ALL MASTAMS 46840021 LA R4,TBMASTAM 46860021 C R4,TBLASMTM 46880021 BE TBGTAL21 ONLY 1 MASTAM 46900021 LA R5,TBMSTMLG(R4) 46920021 C R5,TBLASMTM 46940021 BNE TBERR4 R5 NOT EQUAL TO TBLASMTM 46960021 L R0,TBDCLENG(R5) THERE ARE TWO MASTAMS 46980021 BC UNCOND,TBGTAL00 X 47000021 TBGTAL21 BAL R14,TBTIBUP UPDATE TIBS ONCE MORE ANYWAY 47020021 TBGTAL20 L R5,TBDSTADD(R4) 47040021 L R6,TBASAV1 47060021 ST R5,DX0(R6) START ADDR IN R0 47080021 L R5,TBDCLENG(R4) 47100021 ST R5,DX4(R6) LENGTH OF AREA INTO R1 47120021 BC UNCOND,TBTAMENX RETURN TO CALLING PHASE 47140021 SPACE 5 47160021 * 47180021 * TBGETDIC -GET ENTRY IN DICOT TABLE OF A SECTION WHOSE AD 47200021 * IN CORE IS IN R6. R7 WILL HAVE DICOT ENTRY ADD 47220021 * IN RETURN 47240021 * 47260021 * 47280021 TBGETDIC STM R5,R10,TBSAV8 47300021 L R5,TBATIB20 GET TIB ADDR. 47320021 L R5,DX0(R5) GET TAM ADDR. 47340021 L R8,DX0(R5) GET TABLE ADDR. 47360021 LA R8,DX0(R8) X 47380021 LH R7,DX4(R5) GET TABLE END 47400021 AR R7,R8 X 47420021 TBGETD01 L R9,DX0(R8) GET ADDRESS OF SECTION AT T 47440021 LA R9,DX0(R9) ENTRY 47460021 * IS SECT IN CORE 47480021 TM DX0(R8),TBIN 47500021 BZ TBGETD00 NOT A VALID ADDRESS. 47520021 * IS THIS THE SECT WE ARE LOOKING 47540021 * IF YES,RETURN. IF NO,GET NEXT EN 47560021 CR R9,R6 47580021 BE TBGETEX R9 = @ DICOT TABLE ENTRY 47600021 TBGETD00 LA R8,DX12(R8) 47620021 CR R8,R7 47640021 BE TBERR1 PREPARE TO SEND OUT WARNING 47660021 B TBGETD01 LOOP THROUGH AGAIN 47680021 TBGETEX LR R0,R8 47700021 LM R5,R10,TBSAV8 47720021 LR R7,R0 R7 HAS DICOT ENTRY ADDR. 47740021 BR R14 RETURN TO NEXT SEQUENTIAL INSTR 47760021 TBGTAL00 C R0,TBDCLENG(R4) R0 = AVAILABLE SPACE IN 2ND MASTAM 47780021 BL TBGTAL20 AVAIL SPACE IN 2ND MASTAM LESS 47800021 LR R4,R5 47820021 BC UNCOND,TBGTAL20 GO TO TBGTAL20 WITH NEW R4 47840021 SPACE 5 47860021 * 47880021 * TBMOVUP -MOVE TABLE TOWARDS LOW ADDRESSES 47900021 * R10 = NEW START ADDRESS. 47920021 * R9 = OLD START ADDRESS. 47940021 * R8 = LENGTH OF BLOCK TO BE MOVED. 47960021 * TBMOVDON - MOVE TABLE TOWARDS HIGTH CORE. 47980021 * R10 = NEW ENDING 48000021 * R9 = OLD ENDING 48020021 * R8 = LENGTH 48040021 * 48060021 * 48080021 TBMOVUP STM R5,R10,TBSAV5 48100021 CR R9,R10 48120021 BE TBMOVOUT OLD START = NEW START 48140021 TBMOV00 CH R8,TBCON256 48160021 BL TBMOV01 LENGTH BLOCK <256 48180021 MVC DX0(LX256,R10),DX0(R9) 48200021 SH R8,TBCON256 48220021 AH R10,TBCON256 48240021 AH R9,TBCON256 48260021 B TBMOV00 LOOP THROUGH AGAIN 48280021 TBMOV01 LTR R8,R8 48300021 BE TBMOVOUT ALL MOVING DONE 48320021 BCTR R8,R0 MODIFY LENGTH FOR EXEC 48340021 EX R8,TBMOVEX 48360021 TBMOVOUT LM R5,R10,TBSAV5 48380021 BR R14 RETURN TO NEXT SEQUENTIAL INSTR 48400021 SPACE 3 48420021 TBMOVDON STM R5,R10,TBSAV5 48440021 CR R9,R10 48460021 BE TBMOVOUT OLD ENDING = NEW ENDING 48480021 LR R6,R10 48500021 SR R6,R9 48520021 CH R6,TBCON256 48540021 BNL TBMOV03 R6 > OR = 256 48560021 TBMOV07 LR R5,R6 48580021 BCTR R5,R0 SET UP R5 FOR EXEC 48600021 TBMOV05 CR R8,R6 48620021 BNH TBMOV04 LENGTH < OR = R6 48640021 TBMOV06 SR R10,R6 48660021 SR R9,R6 48680021 EX R5,TBMOVEX 48700021 SR R8,R6 48720021 B TBMOV05 LOOP THROUG AGAIN 48740021 TBMOV04 SR R10,R8 48760021 SR R9,R8 48780021 B TBMOV01 PREPARE TO DO A MOVE IF NECESSA 48800021 TBMOV03 LA R6,DX256 48820021 B TBMOV07 GO TO TBMOV07 WITH NEW R6 48840021 TBMOVEX MVC DX0(LX0,R10),DX0(R9) 48860021 SPACE 5 48880021 * 48900021 * TBSPILL - SPILL A SECTION FROM DICTIONARY. 48920021 * 48940021 * 48960021 TBSPILL STM R5,R10,TBSAV7 48980021 ST R14,TBSAV714 49000021 LR R10,R2 49020021 * SAVE R2, WHICH HAS AMT CORE NEED 49040021 OI TBSW1,TBSPILLF 49060021 L R9,TBDBEGAR(R4) 49080021 A R9,TBDLENG(R4) END OF DICT. 49100021 L R6,TBDSTADD(R4) 49120021 A R6,TBDCLENG(R4) BEG. OF DICT. 49140021 L R7,TBDNSECT(R4) 49160021 SH R9,TBCON512 TRY TO DUMP LAST SECTION. 49180021 C R9,TBCURSTN IS IT THE SECTION BEING BUI 49200021 BNE TBSP41 R9 NOT @ CURRENT DICT SECTION 49220021 CH R7,TBCON002 49240021 * IS THIS THE ONLY SECTION,YES BRA 49260021 * IF NOT SPILL NEXT-TO-LAST SECTIO 49280021 BL TBSP40 X 49300021 SH R9,TBCON512 49320021 TBSP41 BAL R14,TBWRITE BR TO WRITE OUT DICT SECTION 49340021 ST R9,TBTEMP 49360021 CH R7,TBCON002 49380021 BL TBSP42 R7 < 2 49400021 C R6,TBCURSTN 49420021 BNE TBSP443 R6 NOT = @ CURRENT DICT SECTION 49440021 TBSP44 ST R9,TBCURSTN UPDATE CURENT SECTION IF NEEDED. 49460021 TBSP443 EQU * 49480021 CR R6,R9 49500021 BE TBSP42 EQUAL SKIP NEXT INSTRUCTIONS 49520021 MVC DX0(LX256,R9),DX0(R6) 49540021 MVC DX256(LX256,R9),DX256(R6) 49560021 BAL R14,TBGETDIC GET DICOT TABLE ENTRY 49580021 MVC DX1(LX3,R7),TBTEMP+NX1 49600021 * BRANCH TO UPDATE MASTAMS 49620021 TBSP42 LH R2,TBCOM512 49640021 BAL R14,TBINS78 UPDATE MASTAM 49660021 * 49680021 LH R8,TBCOM001 49700021 BAL R14,TBDIC100 UPDATE NB OF DICT SECTION 49720021 TM TBSWGENE,TBFLDICT 49740021 BO TBSP46 DON'T GO TO TBACCINT 49760021 BAL R14,TBACCINT X 49780021 TBSP46 EQU * 49800021 LR R2,R10 49820021 LM R5,R10,TBSAV7 49840021 L R14,TBSAV714 49860021 BR R14 RESTORE R14 AND BRANCH 49880021 SPACE 2 49900021 * TRY OTHER MASTAMS FOR SECTION TO SPILL 49920021 TBSP40 LA R5,TBMASTAM 49940021 TBSP45 CR R5,R4 49960021 BE TBSP43 R4 =@TBMASTAM 49980021 L R14,TBDNSECT(R4) 50000021 LTR R14,R14 50020021 BE TBSP43 R14 = 0 50040021 L R9,TBDBEGAR(R5) 50060021 A R9,TBDLENG(R5) 50080021 SH R9,TBCON512 50100021 BAL R14,TBWRITE WRITE OUT DICT SECTION 50120021 ST R9,TBTEMP 50140021 B TBSP44 BR TO UPDATE CURR SECT IF NECES 50160021 TBSP43 LA R5,TBMSTMLG(R5) 50180021 C R5,TBLASMTM 50200021 BH TBERR1 MUST SEND OUT MESSAGE 50220021 B TBSP45 TRY OTHER MASTAMS-SECT TO SPILL 50240021 SPACE 5 50260021 * 50280021 * 50300021 TBACCINT STM R5,R10,TBSAV5 50320021 L R9,TBAPHASW 50340021 CLI DX0(R9),TAM3Q 50360021 BE TBACCINX PHZSW = X'05' 50380021 L R10,TBADICAD 50400021 L R8,DX0(R10) DICADR 50420021 L R6,DX4(R10) DLSVAL 50440021 SR R6,R8 50460021 L R7,TBCURSTN 50480021 AH R7,TBCON512 50500021 ST R7,DX4(R10) 50520021 SR R7,R6 50540021 ST R7,DX0(R10) 50560021 TBACCINX EQU * 50580021 LM R5,R10,TBSAV5 50600021 BR 14 RETURN TO NEXT SEQUENTIAL INSTR 50620021 SPACE 5 50640021 * TBPACKTB - ROUTINE WHICH PACKS TABLE (NO FREE SPACE BETW 50660021 * TABLES) WHITHIN A MASTAM WHOSE ADDRESS IS IN R 50680021 * -IF TBFULLPK SWITCH IS ON ONLY SPACE FOR ONE M 50700021 * ENTRY WILL BE LEFT IN EACH TABLE. 50720021 SPACE 5 50740021 TBPACKTB STM R5,R10,TBSAV3 50760021 ST R14,TBSAV314 50780021 L R5,TBDFSTAM(R4) LOAD FIRST TAM ADDR. 50800021 TBPK005 C R5,TBDLSTAM(R4) 50820021 BE TBPACKEN END OF PACKING. 50840021 LA R6,TBTAMLG(R5) GET NEXT TAM ADDR. 50860021 L R10,DX0(R5) 50880021 LA R10,DX0(R10) START OF TABLE. 50900021 TM DX0(R5),TBFLFREE 50920021 BO TBPK000 FREE AREA. 50940021 TM DX0(R5),TBFLPRIM 50960021 BO TBPK001 PRIMED TABLE. 50980021 AH R10,DX4(R5) STATIC TABLE 51000021 LR R9,R10 51020021 AH R10,TBCONS03 GET END OF TABLE AND 51040021 N R10,TBMASK00 UPDATE FREE BYTES LEFT. 51060021 SR R9,R10 51080021 LCR R9,R9 51100021 STH R9,DX6(R5) 51120021 B TBPK002 BRANCH AROUND NEXT ROUTINE 51140021 TBPK001 AH R10,DX6(R5) GET END OF TABLE 51160021 TM TBSWGENE,TBFULLPK FULL PACK. 51180021 BZ TBPK002 NO 51200021 L R7,DX8(R5) 51220021 BAL R14,TBENTLG SPACE ONLY FOR ONE MORE ENT 51240021 L R9,DX0(R5) 51260021 LA R9,DX0(R9) 51280021 LR R14,R9 51300021 AR R9,R7 51320021 AH R9,DX4(R5) 51340021 AH R9,TBCONS03 51360021 N R9,TBMASK00 51380021 CR R9,R10 51400021 BH TBPK002 R9 > R10 51420021 LR R10,R9 51440021 SR R9,R14 51460021 STH R9,DX6(R5) 51480021 TBPK002 LA R5,TBTAMLG(R5) 51500021 SPACE 2 51520021 * NOW TEST IF NEXT TAM IS A FREE AREA. 51540021 * 51560021 TBPK000 EQU * 51580021 C R6,TBDLSTAM(R4) 51600021 BE TBPK003 MASTAM- YES 51620021 TM DX0(R6),TBFLFREE 51640021 BZ TBPK004 NOT A FREE AREA. 51660021 LA R6,TBTAMLG(R6) TRY NEXT TAM. 51680021 B TBPK000 LOOP BACK 51700021 TBPK004 L R9,DX0(R6) 51720021 LA R9,DX0(R9) 51740021 BAL R14,TBLASTBY GET LAST BYTE OF LAST TABLE 51760021 SR R8,R9 51780021 BAL R14,TBMOVEUP GET RID OF INTERSPACE IF AN 51800021 TBPK006 BAL R14,TBTAMUP PACKING-->MUST MOVE TAM 51820021 SR R9,R10 51840021 BAL R14,TBTAMSL UPDATE TAM'S DUE TO SHIFT O 51860021 B TBPK005 TABLES. 51880021 SPACE 2 51900021 * ONLY FREE AREAS LEFT AT THE END OF MFA. UPDATE MASTAM AND 51920021 * TAM'S 51940021 * 51960021 TBPK003 L R9,TBDSTADD(R4) 51980021 SR R9,R10 52000021 ST R10,TBDSTADD(R4) 52020021 A R9,TBDCLENG(R4) 52040021 ST R9,TBDCLENG(R4) 52060021 B TBPK006 PACKING-->MUST MOVE,UPDATE TAM 52080021 TBPACKEN BAL R14,TBTIBUP TAM MOVED-->MUST UPDATE TIB 52100021 NI TBSWGENE,XXFB RESET FULLPACK 52120021 L R14,TBSAV314 52140021 LM R5,R10,TBSAV3 52160021 BR 14 RETURN TO NEXT SEQUENTIAL INSTR 52180021 SPACE 5 52200021 * 52220021 * TBENTLG -GET ENTRY LENGTH FOR A TABLE WHOSE TIB ADDR.IS 52240021 * GIVEN IN R7 . ENTRY LENGTH IS SENT BACK IN R7. 52260021 * 52280021 SPACE 2 52300021 TBENTLG L R7,DX0(R7) 52320021 SRL R7,DX24 IF LENGTH =0 SET IT EQUAL 52340021 LTR R7,R7 TO 256. 52360021 BCR R7,R14 R7 NOT ZERO 52380021 LA R7,DX256 52400021 BR 14 RETURN TO NEXT SEQUENTIAL INSTR 52420021 SPACE 5 52440021 * 52460021 * TBTIBUP -UPDATE TIB DUE TO A MOVING OF THE TAM'S. 52480021 * 52500021 SPACE 2 52520021 TBTIBUP LA R9,TBTAM 52540021 TBTIBU1 C R9,TBNEXTAM LAST TAM. 52560021 BCR R8,R14 YES- EXIT 52580021 TM DX0(R9),TBFLPRIM+TBFLSTAT 52600021 BZ TBTIBU0 SKIP NEXT INSTRUCTIONS 52620021 L R10,DX8(R9) GET TIB ADDR. 52640021 ST R9,TBTEMP 52660021 MVC DX1(LX3,R10),TBTEMP+NX1 MOVE TAM ADDR TO TIB. 52680021 TBTIBU0 LA R9,TBTAMLG(R9) 52700021 B TBTIBU1 LOOP BACK 52720021 SPACE 5 52740021 * 52760021 * TBLASTBY GET ADDRESS OF LAST BYTE OF LAST TABLE IN A MAS 52780021 * WHOSE ADDRESS IS GIVEN IN R4 52800021 * 52820021 SPACE 2 52840021 TBLASTBY L R7,TBDLSTAM(R4) 52860021 TBLAST00 SH R7,TBCON012 52880021 TM DX0(R7),TBFLFREE 52900021 BO TBLAST00 IF ON THEN REPEAT 52920021 L R8,DX0(R7) 52940021 LA R8,DX0(R8) START OF LAST TABLE 52960021 AH R8,DX6(R7) FOR PRIME ADD NUMBER OF BY 52980021 TM DX0(R7),TBFLPRIM ASSIGNED 53000021 BCR R1,R14 RETURN IF ONES 53020021 AH R8,DX4(R7) 53040021 BR R14 NOW RETURN WITH MODIFIED R8 53060021 SPACE 5 53080021 * 53100021 * TBTAMUP - MOVE TAM DUE TO PACKING.R5 POINTS TO WHERE SHIF 53120021 * END-R6 POINTS TO WHERE IT STARTS . R4 HAS SHIFTED MASTAM. 53140021 SPACE 2 53160021 TBTAMUP STM R5,R10,TBSAV4 53180021 ST R14,TBSAV414 53200021 CR R5,R6 NO SHIFT NECESSARY. 53220021 BCR R8,R14 R5 = R6 53240021 LR R10,R5 53260021 LR R9,R6 53280021 L R8,TBNEXTAM 53300021 SR R8,R6 53320021 BAL R14,TBMOVUP MOVE TABLE TOWARDS LOW @'S 53340021 SR R9,R10 53360021 LR R5,R4 53380021 BAL R14,TBMASUPL UPDATE MASTAM. 53400021 TBTAMEX L R14,TBSAV414 53420021 TBTAMSX LM R5,R10,TBSAV4 53440021 BR R14 RETURN TO NEXT SEQUENTIAL INSTR 53460021 SPACE 5 53480021 * 53500021 * TBTAMSL UPDATE TABLE ADDRESSES IN TAM'S DUE TO A SHI 53520021 * OF TABLES TOWARDS LOW CORE. 53540021 * R5 POINTS TO FIRST TAM TO BE UPDATED 53560021 * R4 POINTS TO MASTAM. 53580021 * R9 HAS VALUE OF SHIFT 53600021 * TBTAMSH SAME THING FOR A SHIFT TOWARDS HIGH CORE. 53620021 * 53640021 SPACE 2 53660021 TBTAMSL STM R5,R10,TBSAV4 53680021 LA R6,DX0 53700021 B TBTAMS00 SKIP NEXT INSTRUCTIONS 53720021 TBTAMSH STM R5,R10,TBSAV4 53740021 LA R6,DX2 53760021 TBTAMS00 C R5,TBDLSTAM(R4) 53780021 BE TBTAMSX PREPARE TO RETURN TO NXT SEQ IN 53800021 L R7,DX0(R5) 53820021 LA R7,DX0(R7) GET OLD ADDRESS. 53840021 EX R0,TBTAMSAS(R6) UPDATE IT. 53860021 ST R7,TBTEMP 53880021 MVC DX1(LX3,R5),TBTEMP+NX1 53900021 LA R5,TBTAMLG(R5) 53920021 B TBTAMS00 LOOP BACK 53940021 SPACE 2 53960021 TBTAMSAS SR R7,R9 53980021 AR R7,R9 54000021 SPACE 5 54020021 * 54040021 * TBINSTAM -ADD A TAM AT THE END OF THE TAM AREA ASSIGNED 54060021 * A MASTAM. R4 HAS ADDR. OF MASTAM 54080021 * R5 - - WHERE TAM SHOULD BE INSER 54100021 * 54120021 * 54140021 SPACE 2 54160021 TBINSTAM STM R5,R10,TBSAV2 54180021 ST R14,TBSAV214 54200021 TBINS01 L R10,TBNEXTAM 54220021 LR R9,R10 54240021 C R10,TBAENTM 54260021 BL TBINS00 R10 < @TBENDTAM 54280021 BAL R14,TBPACKGN NO TAM'S LEFT -PACK ALL MAS 54300021 B TBINS01 LOOP BACK 54320021 TBINS00 L R5,TBDLSTAM(R4) 54340021 LR R8,R9 54360021 SR R8,R5 54380021 LA R10,TBTAMLG(R10) 54400021 BAL R14,TBMOVDON MOVE TAM'S DOWN 1 . 54420021 LA R9,TBTAMLG 54440021 LR R10,R5 54460021 LR R5,R4 54480021 BAL R14,TBMASUPH UPDATE TAM. 54500021 LR R5,R10 54520021 LM R6,R10,TBSAV2+NX4 54540021 L R14,TBSAV214 54560021 BR R14 RETURN TO NEXT SEQUENTIAL INSTR 54580021 SPACE 5 54600021 * 54620021 * TBMASUPH UPDATE TAM'S AND MASTAM'S DUE TO A SHIFT OF TAM 54640021 * HIGH CORE. 54660021 * TBMASUPL SAME THING FOR SHIFT TO LOW CORE. 54680021 * 54700021 SPACE 2 54720021 TBMASUPH LA R6,DX2 54740021 B TBMASU00 LEAVE R6 AS IS 54760021 TBMASUPL LA R6,DX0 54780021 TBMASU00 L R7,TBNEXTAM UPDATE TBNEXTAM. 54800021 EX R0,TBTAMSAS(R6) 54820021 ST R7,TBNEXTAM 54840021 TBMAS01 L R7,TBDLSTAM(R5) UPDATE FIRST MASTAM (THE ON 54860021 EX R0,TBTAMSAS(R6) WHERE SHIFT OCCURED) 54880021 ST R7,TBDLSTAM(R5) 54900021 C R5,TBLASMTM 54920021 BCR R8,R14 BRANCH IF EQUAL 54940021 LA R5,TBMSTMLG(R5) UPDATE OTHER MASTAMS. 54960021 L R7,TBDFSTAM(R5) 54980021 EX R0,TBTAMSAS(R6) 55000021 ST R7,TBDFSTAM(R5) 55020021 B TBMAS01 LOOP BACK 55040021 SPACE 5 55060021 * 55080021 * TBPACKGN -PACK ALL MASTAM'S. 55100021 * 55120021 SPACE 2 55140021 TBPACKGN ST R4,TBSAV64 55160021 ST R14,TBSAV614 55180021 LA R4,TBMASTAM 55200021 TBPK11 BAL R14,TBPACKTB BRANCH TO PACK TABLE 55220021 C R4,TBLASMTM 55240021 BE TBPK10 PREPARE TO RETURN 55260021 LA R4,TBMSTMLG(R4) 55280021 B TBPK11 LOOP BACK 55300021 TBPK10 L R14,TBSAV614 55320021 L R4,TBSAV64 55340021 BR R14 RETURN TO NEXT SEQUENTIAL INSTR 55360021 SPACE 5 55380021 * ENTRY POINT FOR INTERNAL CALL TO PRIME 55400021 TBPRIMEC STM R6,R10,TBSAV2 55420021 ST R14,TBSAV214 55440021 B TBPRIM00 X 55460021 PH0TBST2 CSECT 55480021 EJECT 55500021 USING *,15 55520021 TBPRIMEB EQU * 55540021 L R3,DX0(R1) GET TIB ADDRESS. 55560021 LA R3,DX0(R3) RELOCATE IT IF NOT DONE YET 55580021 C R3,TBACOS X 55600021 BNL TBPRIM01 X 55620021 A R3,TBACOS X 55640021 ST R3,TBTEMP X 55660021 MVC DX1(LX3,R1),TBTEMP+NX1 X 55680021 TBPRIM01 MVC DX0(LX1,R3),DX0(R1) MOVE ENTRY LENGTH. 55700021 MVC DX4(LX4,R3),DX4(R1) MOVE E AND G PARAMETERS. 55720021 LH R2,DX4(R1) 55740021 AH R2,TBCON003 55760021 N R2,TBMASK00 R2 HAS AMOUNT OF CORE WANTE 55780021 LA R4,TBMASTAM 55800021 TBPRIM00 ST R4,TBCCMSTM SAVE ADDR. OF STARTING MAST 55820021 LA R10,TBPRIM05 LOAD TRANSFER REGISTERS FOR 55840021 LA R9,TBPRIM06 TEST ROUTINE. 55860021 TBPRIM05 C R2,TBDCLENG(R4) R2 HAS AMOUNT OF CORE WANTE 55880021 BH TBPRIM02 AM'T WANTED IS GREATER 55900021 TM TBSWGENE,TBFLINST+TBFLDICT 55920021 BZ TBPRIM03 BR TO GET NEW TAM,ETC 55940021 * EXIT FOR INSERT OR DISCP WHEN ENOUGH SPACE IN MFA. 55960021 * 55980021 TBPRIM13 LM R6,R10,TBSAV2 56000021 L R14,TBSAV214 56020021 BR R14 RETURN TO NEXT SEQUENTIAL INSTR 56040021 SPACE 2 56060021 * 56080021 * TEST IF EVERY MASTAM HAS BEEN SCANNED STARTING WHITH THE ONE WH 56100021 * ADDRESS IS IN TBCCMSTM. R10 AND R9 ARE SET BY CALLER. 56120021 * 56140021 * 56160021 TBPRIM02 C R4,TBLASMTM 56180021 BE TBPRIM04 LAST MASTAM 56200021 LA R4,TBMSTMLG(R4) 56220021 TBPRIM07 C R4,TBCCMSTM ARE WE BACK WITH FIRST ONE. 56240021 BCR R7,R10 NO- TEST NEXT MASTAM. 56260021 BR R9 YES-GO TO NEXT STEP. 56280021 TBPRIM04 LA R4,TBMASTAM 56300021 B TBPRIM07 X 56320021 SPACE 2 56340021 * NOW TRY TO FIND A BIG ENOUGH FREE AREA (TFA) 56360021 * 56380021 * 56400021 TBPRIM06 L R10,TBAPHASW 56420021 LR R7,R2 56440021 CLI DX0(R10),TAM2Q 56460021 BNE TBPRIM66 PHZSW NOT EQUAL X'04' 56480021 TM TBSWGENE,TBFLDICT 56500021 BZ TBPRIM66 SKIP NEXT INSTRUCTIONS 56520021 CLI TBDISW,XX01 56540021 BE TBPRIM22 BR TO TRY TO SPILL DICT SECTION 56560021 TBPRIM66 LA R10,TBPRIM09 56580021 LA R9,TBPRIM14 NEXT STEP ADDRESS. 56600021 TBPRIM09 L R5,TBDFSTAM(R4) 56620021 TBPRIM99 C R5,TBDLSTAM(R4) 56640021 BE TBPRIM02 NO MORE TAM - TRY NEXT MAST 56660021 TM DX0(R5),TBFLFREE 56680021 BO TBPRIM08 DON'T GO TO TBPRIM99 56700021 TBPRIM10 LA R5,TBTAMLG(R5) 56720021 B TBPRIM99 LOOP BACK 56740021 TBPRIM08 L R6,DX4(R5) 56760021 CR R6,R2 56780021 BL TBPRIM10 NOT BIG ENOUGH 56800021 TM TBSWGENE,TBFLDICT 56820021 BO TBPRIM11 FOR DICT CALL- PACK TABLE. 56840021 TM TBSWGENE,TBFLINST 56860021 BZ TBPRIM12 DON'T RETURN YET 56880021 TBPRIM35 LM R6,R10,TBSAV2 RETURN FOR INSERT WHEN SPAC 56900021 L R14,TBSAV214 IS FOUND IN TFA. 56920021 B 4(R14) X 56940021 SPACE 2 56960021 TBPRIM12 MVI DX0(R5),TBFLPRIM 56980021 * 57000021 ST R5,TBTEMP 57020021 MVC DX1(LX3,R3),TBTEMP+NX1 57040021 ST R2,DX4(R5) UPDATE TIB AND TAM FOR NEW 57060021 ST R3,DX8(R5) TABLE. 57080021 B TBTAMENX NOW PREPARE TO RETURN 57100021 SPACE 2 57120021 TBPRIM03 EQU * 57140021 BAL R14,TBINSTAM GET A NEW TAM 57160021 MVC DX0(LX4,R5),TBDSTADD(R4) 57180021 BAL R14,TBTIBUP UPDATE TIB 57200021 BAL R14,TBINS88 UPDATE MASTAM 57220021 B TBPRIM12 UPDATE TIB,TAM AND RETURN 57240021 SPACE 2 57260021 TBPRIM11 BAL R14,TBPACKTB BRANCH TO PACK TABLE 57280021 B TBPRIM13 PREPARE TO RETURN 57300021 SPACE 2 57320021 * THE NEXT STEP IS TO PACK THE TABLES AND TRY STEP1 AGAIN. 57340021 * 57360021 * 57380021 TBPRIM14 LA R10,TBPRIM15 57400021 LA R9,TBPRIM16 57420021 TBPRIM15 BAL R14,TBPACKTB BRANCH TO PACK TABLE 57440021 B TBPRIM05 X 57460021 SPACE 2 57480021 * THE NEXT STEP IS TO ASK FOR COBOL SPACE IF ANY IS LEFT. 57500021 * 57520021 * 57540021 TBPRIM16 DS 0H 57560021 TM TBSWGENE,TBSPASKD 57580021 BO TBPRIM17 X 57600021 BAL R14,TBGETSPC BR TO ASK FOR COBOL SPACE 57620021 LA R10,TBPRIM05 57640021 LA R9,TBPRIM17 57660021 BR R10 GO TO TBPRIM05 57680021 SPACE 2 57700021 * THE NEXT STEP IS TO LEAVE SPACE FOR ONLY ONE MORE ENTRY IN EA 57720021 * PRIMED TABLE AND TO PACK THOSE TRUNCATED TABLE. FROM NOW ON FOR 57740021 * PRIME AND INSERT SPACE WILL BE GIVEN ON AN ENTRY BASIS. 57760021 * 57780021 * 57800021 TBPRIM17 LR R7,R2 57820021 LA R9,TBPRIM20 57840021 LA R10,TBPRIM18 57860021 TM TBSWGENE,TBFLDICT 57880021 BO TBPRIM18 SKIP OVER NEXT INSTRUCTIONS 57900021 LR R7,R3 GET ENTRY LENGTH. 57920021 BAL R14,TBENTLG BRANCH TO GET ENTRY LENGTH 57940021 AH R7,TBCON003 57960021 N R7,TBMASK00 57980021 TM TBSWGENE,TBFLINST 58000021 BZ TBPRIM18 SKIP NEXT INSTRUCITONS 58020021 LA R10,TBPRIM05 58040021 L R5,DX0(R3) 58060021 LH R2,DX6(R5) 58080021 AR R2,R7 58100021 TBPRIM18 C R7,TBDCLENG(R4) 58120021 BH TBPRIM02 BR TO TEST EVERY MASTAM SCANNED 58140021 TBPRIM31 LR R2,R7 58160021 TBPRIM36 TM TBSWGENE,TBFLINST+TBFLDICT 58180021 BZ TBPRIM03 GET NEW TAM,UPDATE TIB,MASTAM 58200021 TM TBSWGENE,TBFLDICT 58220021 BO TBPRIM13 BRANCH TO RETURN 58240021 LM R6,R10,TBSAV2 58260021 L R14,TBSAV214 58280021 B 8(R14) RETURN 58300021 SPACE 2 58320021 * FULLPACK 58340021 * 58360021 * 58380021 TBPRIM20 LA R9,TBPRIM22 58400021 LA R10,TBPRIM21 58420021 TM TBSWGENE,TBFLINST 58440021 BZ TBPRIM21 LEAVE R10 ALONE 58460021 LA R10,TBPRIM23 58480021 TBPRIM21 OI TBSWGENE,TBFULLPK 58500021 BAL R14,TBPACKTB BRANCH TO PACK TABLE 58520021 B TBPRIM18 X 58540021 TBPRIM23 OI TBSWGENE,TBFULLPK 58560021 BAL R14,TBPACKTB BRANCH TO PACK TABLE 58580021 B TBPRIM05 X 58600021 SPACE 2 58620021 * NO LUCK - TRY TO SPILL DICTIONARY SECTION 58640021 * 58660021 * 58680021 TBPRIM22 TM TBSWGENE,TBFLNODC 58700021 BO TBABEND SEND WARNING AND END COMP. 58720021 L R6,TBSECTN 58740021 CH R6,TBCON003 58760021 BL TBABEND SEND WARNING AND END COMP. 58780021 * 58800021 * TRY TO SPILL ONE SECTION FROM CURRENT MASTAM. 58820021 * 58840021 L R6,TBDNSECT(R4) 58860021 LTR R6,R6 58880021 BZ TBPRIM30 X 58900021 BAL R14,TBSPILL BR TO SPILL DICT SECTION 58920021 B TBPRIM31 X 58940021 TBPRIM30 LA R10,TBPRIM32 58960021 LA R9,TBABEND 58980021 B TBPRIM02 BR TO TEST EVERY MASTAM SCANNED 59000021 TBPRIM32 TM TBSWGENE,TBFLINST 59020021 BO TBPRIM33 X 59040021 LR R2,R7 59060021 TBPRIM33 SR R1,R1 59080021 L R0,TBDCLENG(R4) 59100021 TBPRIM37 EQU * 59120021 LA R1,DX1(R1) 59140021 AH R0,TBCON512 59160021 CR R0,R2 59180021 BL TBPRIM37 X 59200021 C R1,TBDNSECT(R4) 59220021 BH TBPRIM02 BR TO TEST EVERY MASTAM SCANNED 59240021 L R6,TBSECTN 59260021 SR R6,R1 59280021 CH R6,TBCON003 59300021 BL TBABEND SEND WARNING AND END COMP 59320021 TBPRIM34 BAL R14,TBSPILL BR TO SPILL DICT SECTION 59340021 BCT R1,TBPRIM34 X 59360021 TM TBSWGENE,TBFLINST 59380021 BO TBPRIM13 RETURN TO NEXT SEQUENTIAL INSTR 59400021 B TBPRIM36 X 59420021 TBABEND LA R2,TBMESS1 59440021 LA R3,TBMESS1L 59460021 TBERRLG L R4,TBATRMNT 59480021 BR R4 BRANCH TO TRMNATE 59500021 SPACE 2 59520021 SPACE 5 59540021 * TBSTATIC - INDICATES THAT A PRIMED TABLE WILL NOT GROW AN 59560021 * - MORE 59580021 * STATIC CALCULATES THE AMOUNT OF UNUSED TABLE AREA AND STOR 59600021 * IT IN THE TAMM IN PLACE OF THE SIZE OF THE ENTIRE TABLE 59620021 * THESTATIC CODE IS X'02' IN THE TOP BYTE OF THE TAMM 59640021 TBSTATIC L R2,DX0(R1) LOAD TAMM ADD INTO R2 59660021 TM DX0(R2),TBFLPRIM 59680021 BZ TBERR1 PREPARE TO TERMINATE 59700021 LH R3,DX6(R2) LOAD TAMM ADDR INTO R2 59720021 SH R3,DX4(R2) SUBTRACT BYTES USED 59740021 STH R3,DX6(R2) STORE NO OF FREE BYTES AVAILABLE 59760021 * FLAG TABLE AS STATIC 59780021 MVI DX0(R2),TBFLSTAT 59800021 B TBTAMENX BRANCH TO RETURN 59820021 SPACE 5 59840021 ****** ** 59860021 * TBTABREL 59880021 * TABREL IS CALLED WHEN A PHASE IS FINISHED WITH A TABLE 59900021 * THE SPACE IS THEN RELEASED FOR USE BY OTHER TABLES 59920021 * THE TIB CAN NOW BE REUSED FOR ANOTHER TABLE. THE TAMM IS S 59940021 * TO X'02' TO INDICATE THAT THE TABLE IT POINTS TO IS FREE. 59960021 * THE LENGTH OF THE TABLE IS STORED IN THE SECOND FULL WORD 59980021 * THE TAMM 60000021 ****** ** 60020021 TBTABREL L R2,DX0(R1) GET TAMM ADDRESS 60040021 LH R3,DX6(R2) 60060021 TM DX0(R2),TBFLPRIM 60080021 BO TYCONT X 60100021 AH R3,DX4(R2) GET LENGTH OF TABLE IF STATIC 60120021 TYCONT EQU * 60140021 ST R3,DX4(R2) STORE FREE LENGTH IN TAMM 60160021 MVI DX0(R2),TBFLFREE 60180021 XC DX0(LX4,R1),DX0(R1) SET TAMM ADDRESS IN TIB TO ZERO 60200021 B TBTAMENX BRANCH TO RETURN 60220021 SPACE 5 60240021 ****** ** 60260021 * TBINSERT 60280021 * INSERT IS CALLED WHEN ONE OF THE PHASES NEEDS TO MAKE AN 60300021 * ENTRY INTO THE TABLE 60320021 * 60340021 * IF THERE IS ROOM LEFT IN THE TABLE INSERT WILL RETURN 60360021 * NORMALLY. OTHERWISE IT WILL CALL PRIME TO FIND A LARGER 60380021 * AREA FOR THE TABLE. 60400021 * 60420021 * INSERT CALLING PARAMETERS 60440021 * R15 ADDRESS OF INSERT 60460021 * R14 RETURN LINKAGE 60480021 * R1 ADDRESS OF TIB 60500021 * R0 CAN CONTAIN ENTRY LENGTH IF NOT ALREADY IN TIB 60520021 * 60540021 * INSERT RETURN PARAMETERS 60560021 * R2 ADDRESS WHERE NEW ENTRY CAN BE MADE 60580021 * R3 DISPLACEMENT FROM BEGINNING OF TABLE OF NEW ENT 60600021 ****** ** 60620021 TBINSERT LR R3,R1 60640021 OI TBSWGENE,TBFLINST 60660021 L R2,DX0(R3) 60680021 LR R6,R2 60700021 SRL R2,DX24 60720021 * IS ENTRY LENGTH IN TIB 60740021 LTR R2,R2 60760021 BNE TBINSE00 X 60780021 * IF NOT, IS ENTRY LENGTH IN R0 60800021 LTR R0,R0 60820021 BE TBINSEXT NO ENTRY LENGTH GIVEN. 60840021 LR R2,R0 60860021 TBINSE00 EQU * 60880021 TM DX0(R6),TBFLPRIM 60900021 BZ TBERR1 SEND OUT WARNING AND END COMP. 60920021 LH R7,DX4(R6) 60940021 AR R7,R2 60960021 CH R7,DX6(R6) 60980021 BNH TBINSEXT ENOUGH ROOM :OK 61000021 LR R7,R2 SAVE ENTRY LENGTH 61020021 * TABLE NEED TO GROW - GROW IS ALWAYS SET TO 256 BYTES. 61040021 * 61060021 LH R2,DX6(R6) 61080021 AH R2,TBCON256 61100021 CH R2,TB32767 61120021 BH TBERR3 SEND OUT WARNING AND END COMP. 61140021 LA R4,TBMASTAM 61160021 LA R6,DX0(R6) 61180021 TBINSE02 L R5,TBDLSTAM(R4) 61200021 CR R6,R5 61220021 BL TBINSE01 R4 HAS MASTAM TO WHICH TABL 61240021 C R4,TBLASMTM BELONG. 61260021 BE TBERR1 SEND OUT WARNING AND END COMP. 61280021 LA R4,TBMSTMLG(R4) 61300021 B TBINSE02 LOOP THROUGH AGAIN 61320021 SPACE 2 61340021 TBINSE01 BAL R14,TBPRIMEC INTERNAL CALL TO PRIME 61360021 * RETURN FROM PRIME IF MFA WAS FOU 61380021 B TBINS04 X 61400021 B TBINS05 INSERT NEW TAMM --> MOVE TO MFA 61420021 * RETURN FROM PRIME IF TFA WAS FOU 61440021 SPACE 2 61460021 * ENOUGH SPACE IN MFA FOR ONE ENTRY. 61480021 * GET ADD OF TAMM IN R6 61500021 BAL R14,TBINS90 X 61520021 L R8,DX0(R6) 61540021 LA R8,DX0(R8) 61560021 * R8 HAS ADD OF END OF TABLE 61580021 AH R8,DX6(R6) 61600021 L R9,TBDSTADD(R4) 61620021 LR R10,R9 61640021 AR R10,R2 61660021 SR R8,R9 61680021 LCR R8,R8 61700021 * R8 NOW HAS LENGTH TABLE MUST MOV 61720021 BAL R14,TBMOVDON BR TO MOVE TABLE TOWARDS HICORE 61740021 LA R5,TBTAMLG(R6) 61760021 SR R9,R10 61780021 LCR R9,R9 61800021 * GO TO UPDATE TAMMS AFFCTED BY SH 61820021 BAL R14,TBTAMSH HICORE SHIFT-->UPDTE TAM TBL @S 61840021 * GO TO UPDATE MASTAMS 61860021 BAL R14,TBINS88 UPDATE MASTAM 61880021 LH R1,DX6(R6) 61900021 AR R2,R1 61920021 BAL R14,TBINS89 SET UP RETURN REGS FROM INSERT 61940021 * UPDATE TAMM AND SET UP R2 AND R3 61960021 * RETURN TO PHASE 61980021 * 62000021 TBINXIT L R15,TBASAV1 EXIT 62020021 XI TBSWGENE,TBFLINST 62040021 LM R0,R1,DX0(R15) 62060021 LM R4,R15,DX16(R15) 62080021 BR R14 RETURN 62100021 SPACE 2 62120021 * PRIME RETURNS ADD OF NEW TAMM IN 62140021 TBINS05 L R10,DX0(R5) 62160021 LA R10,DX0(R10) 62180021 BAL R14,TBINS90 X 62200021 * R6 HAS ADD OF OLD TAMM 62220021 L R9,DX0(R6) 62240021 LA R9,DX0(R9) 62260021 LH R8,DX4(R6) 62280021 BAL R14,TBMOVUP BR TO MOVE TBL TOWARDS LOW CORE 62300021 * MOVE TABLE TO TFA 62320021 MVC DX4(LX8,R5),DX4(R6) 62340021 * UPDATE NEW TAMM 62360021 XR R6,R5 62380021 XR R5,R6 62400021 XR R6,R5 62420021 BAL R14,TBINS89 SET UP RETURN REGS FROM INSERT 62440021 MVI DX0(R6),TBFLPRIM 62460021 MVI DX0(R5),TBFLFREE 62480021 XC DX4(LX2,R5),DX4(R5) 62500021 BAL R14,TBTIBUP TAM MOVED-->UPDATE TIB 62520021 B TBINXIT PREPARE TO RETURN TO CALLING PH 62540021 SPACE 2 62560021 * INSERT NEW TAMM BEFORE MOVING TA 62580021 * TO MFA 62600021 TBINS04 EQU * 62620021 BAL R14,TBINS90 X 62640021 LH R9,DX6(R6) TABLE LENGTH 62660021 L R8,DX0(R6) TABLE ADDRESS 62680021 LA R8,DX0(R8) CLEAR H.O. BYTE 62700021 AR R9,R8 TABLE END 62720021 C R9,TBDSTADD(R4) 62740021 BNE TBINS03 X 62760021 ** LAST TABLE - DO NOT MOVE IT 62780021 LA R2,DX256 ADD GROWTH FACTOR TO MASTAM, 62800021 BAL R14,TBINS88 UPDATE TABLE END 62820021 LH R2,DX6(R6) 62840021 AH R2,TBCON256 NEW TABLE SIZE 62860021 BAL R14,TBINS89 SET UP RETURN REGS FORM INSERT 62880021 BC UNCOND,TBINXIT PREPARE TO RETURN TO CALLING PH 62900021 TBINS03 DS 0H 62920021 BAL R14,TBINSTAM BRANCH TO ADD A TAM 62940021 MVC DX0(LX4,R5),TBDSTADD(R4) 62960021 BAL R14,TBINS88 BRANCH TO UPDATE MASTAM 62980021 BAL R14,TBTIBUP BRANCH TO UPDATE TIB 63000021 LA R14,TBINS05 63020021 TBINS90 EQU * 63040021 L R6,DX0(R3) 63060021 LA R6,DX0(R6) 63080021 BR R14 RETURN TO NEXT SEQUENTIAL INSTR 63100021 * GIVEN ADDR OF TIB IN R3, PUT ADD 63120021 * TAMM IN R6 63140021 SPACE 2 63160021 TBINSEXT LR R7,R2 63180021 BAL R14,TBINS89A X 63200021 B TBINXIT PREPARE TO RETURN TO CALLING PH 63220021 SPACE 5 63240021 * UPDATES MASTAM 63260021 TBINS88 L R9,TBDSTADD(R4) 63280021 AR R9,R2 63300021 ST R9,TBDSTADD(R4) 63320021 TBINS78 L R9,TBDCLENG(R4) 63340021 SR R9,R2 63360021 ST R9,TBDCLENG(R4) 63380021 BR R14 RETURN TO NEXT SEQUENTIAL INSTR 63400021 SPACE 2 63420021 * SETS UP RETURN REGS FROM INSERT 63440021 TBINS89 STH R2,DX6(R6) 63460021 TBINS89A LH R2,DX4(R6) 63480021 LR R3,R2 63500021 LR R0,R2 63520021 AR R0,R7 63540021 STH R0,DX4(R6) 63560021 L R1,DX0(R6) 63580021 LA R1,DX0(R1) 63600021 AR R2,R1 63620021 BR R14 RETURN TO NEXT SEQUENTIAL INSTR 63640021 EJECT 63660021 ****** ** 63680021 * 63700021 * TAMEIN - INITIALIZE TABLE HANDLER. 63720021 * PHASE1 - SET UP FIRST MASTAM AND HASH TABLE TAMM 63740021 * PHASE1 CALLS TAMEIN 63760021 * 63780021 * PHASE2 - NO PROCESSING 63800021 * PHASE0 CALLS TAMEIN 63820021 * 63840021 * PHASE3 - IF NO SECTIONS HAVE BEEN SPILLED, RETURN 63860021 * OTHERWISE, TRY TO GET SPACE TO READ IN AS MANY OF 63880021 * SPILLED SECTIONS AS POSSIBLE. 63900021 * PHASE0 CALLS TAMEIN 63920021 * 63940021 * PHASE4 - DOES NOT CALL TAMEIN 63960021 * 63980021 * PHASE5 - DOES NOT CALL TAMEIN 64000021 * 64020021 * PHASE6 - NO PROCESSING - RETURN 64040021 * PHASE6 CALLS TAMEIN 64060021 ****** ** 64080021 * 64100021 TBTAMEIN L R2,TBAPHASW 64120021 * GREATER THAN PHASE3, RETURN 64140021 CLI DX0(R2),TAM3Q 64160021 BH TBTAMENX BR TO RESTORE REGS AND RETURN 64180021 CLI DX0(R2),TAM1Q 64200021 BH TBAMEN00 X 64220021 LA R4,TBMASTAM PH1 INIT. OF TABLE HANDLER. 64240021 * R6 HAS BEGINNING OF TABLE AREA 64260021 L R9,TBATAMAR 64280021 * R7 HAS END OF TABLE AREA 64300021 LM R6,R7,DX0(R9) 64320021 SR R7,R6 64340021 STM R6,R7,DX0(R4) 64360021 * SET UP FIRST MASTAM 64380021 ****** ** 64400021 STM R6,R7,TBDSTADD(R4) 64420021 MVC TBTAM(LX12),TBHASH PRIME HASH.TABLE 64440021 BAL R14,TBTIBUP BRANCH TO UPDATE TIB 64460021 MVC TBTAM+NX1(LX3),TBMASTAM+NX1 64480021 L R9,TBACCSW 64500021 MVC DX1(LX3,R9),TBMASTAM+NX1 64520021 LA R2,DX1568 64540021 BAL R14,TBINS88 BRANCH TO UPDATE MASTAM 64560021 B TBTAMENX BR TO RESTORE REGS AND RETURN 64580021 SPACE 2 64600021 TBAMEN00 CLI DX0(R2),TAM2Q 64620021 BE TBTAMENX BR TO RESTORE REGS AND RETURN 64640021 SPACE 2 64660021 TBAMEN01 TM TBSW1,TBSPILLF 64680021 BZ TBTAMENX BR TO RESTORE REGS AND RETURN 64700021 XC TBCURSTN(LX4),TBCURSTN 64720021 BAL R14,TBGETSPC GET ADDITIONAL SPACE AND 64740021 * READ BACK IN CORE AS MANY 64760021 * SECTION OF THE DICTION. AS 64780021 * POSSIBLE 64800021 L R3,TBATIB20 64820021 L R3,DX0(R3) 64840021 L R5,DX0(R3) 64860021 LA R5,DX0(R5) 64880021 LR R6,R5 64900021 AH R5,DX4(R3) 64920021 LA R4,TBMASTAM 64940021 TBAMEN03 SH R5,TBCON012 64960021 TBAMEN04 CR R5,R6 64980021 BL TBTAMENX BR TO RESTORE REGS AND RETURN 65000021 TM DX0(R5),TBIN 65020021 BO TBAMEN03 X 65040021 LA R2,DX512 65060021 TBAMEN05 C R2,TBDCLENG(R4) 65080021 BNH TBAMEN06 X 65100021 C R4,TBLASMTM 65120021 BE TBTAMENW SPILL HAS OCCURRED 65140021 LA R4,TBMSTMLG(R4) 65160021 B TBAMEN05 X 65180021 * 65200021 * 65220021 SPACE 2 65240021 TBAMEN06 LR R7,R5 65260021 L R9,TBDSTADD(R4) 65280021 A R9,TBDCLENG(R4) 65300021 SH R9,TBCON512 65320021 BAL R14,TBREADIC BR TO READ BACK DICT SECTION 65340021 BAL R14,TBINS78 UPDATE MASTAM 65360021 BAL R14,TBDIC300 UPDATE NB. OF DICT SECTION 65380021 B TBAMEN03 X 65400021 * TURN ON SPILL BIT FOR STATISTICS 65420021 TBTAMENW ST R8,TBSAVER SAVE CONTENTS OF R8 65440021 L R8,TBACOS LOAD ADDRESS OF COS 65460021 OI SWITCHD(R8),SPILLQ TURN ON SPILL BIT 65480021 TBTAMEN1 L R8,TBSAVER RESTORE R8 65500021 SPACE 2 65520021 TBTAMENX L R15,TBASAV1 65540021 LM R0,R15,DX0(R15) 65560021 BR R14 RETURN 65580021 * 65600021 SPACE 5 65620021 * TBDICSP -ASK A NEW DICTIONARY SECTION. 65640021 * RETURNS IN R1 ADDR OF BEGINNING OF NEW DICTIONARY SECT 65660021 * AND IN R2 ADDR OF END OF NEW DICT SECTION. 65680021 ****** ** 65700021 * 65720021 * 65740021 TBDICSPC MVI TBDISW,XX00 65760021 L R9,TBATIB20 65780021 L R10,DX0(R9) 65800021 LH R2,DX6(R10) 65820021 SH R2,DX4(R10) 65840021 CH R2,TBCON012 65860021 BNL TBDICSP0 ASK-A-NEW-DICT-SECT PROCESSING 65880021 L R6,TBASAV1 65900021 MVC TBSAVD(LX64),DX0(R6) 65920021 LR R1,R9 65940021 L R15,TBINNST 65960021 BALR R14,R15 BRANCH AND LINK TO INSERT 65980021 MVC DX0(LX64,R6),TBSAVD 66000021 L R15,TBAPRIME 66020021 L R10,DX0(R9) 66040021 LH R2,DX4(R10) 66060021 SH R2,TBCON012 66080021 STH R2,DX4(R10) 66100021 * IF DICOT TABLE MUST GROW INSERT W 66120021 * BE CALLED BEFORE DICT SECTION IS 66140021 * UP, IN CASE A SECT WILL HAVE TO 66160021 * SPILLED WHEN DICOT TABLE GROWS. 66180021 TBDICSP0 OI TBSWGENE,TBFLDICT 66200021 LA R2,DX512 66220021 LA R4,TBMASTAM 66240021 BAL R14,TBPRIMEC ENTRY PT FOR INT CALL TO PRIME 66260021 BAL R14,TBINS78 UPDATE MASTAM 66280021 L R1,TBDSTADD(R4) 66300021 A R1,TBDCLENG(R4) 66320021 LR R2,R1 66340021 AH R2,TBCON512 66360021 XI TBSWGENE,TBFLDICT 66380021 LA R14,TBDIC200 66400021 TBDIC300 LA R8,DX1 66420021 TBDIC100 EQU * UPDATES NO. OF DICT SECT. 66440021 L R9,TBDNSECT(R4) 66460021 AR R9,R8 66480021 ST R9,TBDNSECT(R4) 66500021 L R9,TBSECTN 66520021 AR R9,R8 66540021 ST R9,TBSECTN 66560021 BR R14 RETURN 66580021 TBDIC200 CLI TBDISW,XX00 66600021 BNE TBMOVDI0 X 66620021 ST R1,TBCURSTN 66640021 L R15,TBASAV1 66660021 L R0,DX0(R15) 66680021 LM R3,R15,DX12(R15) 66700021 BR R14 RETURN 66720021 SPACE 5 66740021 * 66760021 * TBMOVDIC READ BACK A SECTION WHOSE ENTRY ADDRESS IN DICO 66780021 * IS IN R3. 66800021 * 66820021 * 66840021 TBDICOTX L R5,TBATIB20 GET STARTING ADDRESS OF DICOT 66860021 L R5,DX0(R5) 66880021 L R5,DX0(R5) 66900021 LA R5,DX0(R5) 66920021 BR R14 RETURN 66940021 TBMOVDIC BAL R14,TBDICOTX GET STARTING @ OF DICOT 66960021 SR R3,R5 66980021 MVI TBDISW,XX01 67000021 B TBDICSP0 GET THE SPACE TO READ IN (IN R1 67020021 SPACE 2 67040021 TBMOVDI0 BAL R14,TBACCINT INITIALIZE ACCESS CELLS IN COMMO 67060021 BAL R14,TBDICOTX GET STARTING @ OF DICOT 67080021 AR R3,R5 GET POINTER IN DICOT 67100021 LR R9,R1 67120021 LR R7,R3 67140021 BAL R14,TBREADIC BR TO READ BACK DICT SECTION 67160021 * 67180021 * 67200021 L R15,TBASAV1 67220021 LM R0,R2,DX0(R15) 67240021 LM R4,R15,DX16(R15) 67260021 BR R14 RETURN 67280021 TBERR1 MVI TBERCD,DX0 ABEND EVENTUALLY 67300021 B TBERR 67320021 TBERR3 MVI TBERCD,DX4 ABEND EVENTUALLY 67340021 B TBERR 67360021 TBERR4 MVI TBERCD,DX8 ABEND EVENTUALLY 67380021 TBERR STM R0,R15,TBERRG SAVE ALL REGISTERS FOR DUMP 67400021 SR R2,R2 67420021 IC R2,TBERCD 67440021 L R3,TBERL(R2) PICK UP MESSAGE LENGTH 67460021 L R2,TBERMSG(R2) POINT TO MESSAGE 67480021 B TBERRLG 67500021 TBERMSG DC A(TBMESS2) 67520021 DC A(TBMESS3) 67540021 DC A(TBMESS4) 67560021 TBERL DC A(TBMESS2L) 67580021 DC A(TBMESS3L) 67600021 DC A(TBMESS4L) 67620021 TBERCD DC X'FF' 67640021 ORG TBDICOTX 16 WORDS ON WORD 67660021 TBERRG DS 16F BOUNDARY FOR ABEND REGISTERS 67680021 EJECT 67700021 * 67720021 TBDATA CSECT 67740021 DS 0F 67760021 * THE FOLLOWING EIGHT CARDS MUST BE KEPT TOGETHER. DO NOT INSERT 67780021 * ANYTHING HERE. 67800021 TBMASTAM DC 1F'0' BEG.OF AREA. 67820021 DC 1F'0' LENGTH OF AREA 67840021 DC 1F'0' CURRENT FIRST FREE BYTE FOR TABLE. 67860021 DC 1F'0' REMAINING LENGTH. 67880021 DC A(TBTAM) FIRST TAM FOR THIS MASTAM. 67900021 DC A(TBTAM+TBTAMLG) NEXT TAM TO BE FOR THIS MASTAM. 67920021 DC 1F'0' NUMBER OF DICT. SECTION IN THIS MASTAM. 67940021 DC 14F'0' 2 OTHER MASTAMS 9330 67960021 TBENMSTM EQU * 67980021 SPACE 2 68000021 TBTAM DC 864X'0' D 68020021 TBENDTAM EQU * 68040021 SPACE 2 68060021 TBNEXTAM DC A(TBTAM+TBTAMLG) NEXT AVAL. TAM .(INIT. FOR PH10). 68080021 TYSPLAD DC A(SPILL) X 68100021 TBLASMTM DC A(TBMASTAM) LAST MASTAM USED SO FAR. 68120021 TBCURSTN DC A(0) CURENT DICT. SECTION. 68140021 TBSECTN DC 1F'0' DICT. SECT. LEFT IN CORE. 68160021 TBTEMP DC 1F'0' 68180021 TBSAV2 DS 6F TAMER RTN REG SAVE AREAS 68200021 TBSAV214 DS 1F X 68220021 TBSAV3 DS 6F X 68240021 TBSAV314 DS F X 68260021 TBSAV4 DS 6F X 68280021 TBSAV414 DS 1F X 68300021 TBSAV5 DS 6F X 68320021 TBSAV6 DS 6F X 68340021 TBSAV614 DS 1F X 68360021 TBSAV7 DS 6F X 68380021 TBSAV714 DS 1F X 68400021 TBSAV8 DS 6F X 68420021 TYWSAVR DS 10F X 68440021 TBACCSW DC A(ACCESW) X 68460021 TBAPHASW DC A(PHASW) X 68480021 TBATABRL DC A(TBTABREL) X 68500021 TBATAMEN DC A(TBTAMEIN) X 68520021 TBAINSTA DC A(TBINSERT) X 68540021 TBASTATC DC A(TBSTATIC) X 68560021 TBADICSP DC A(TBDICSPC) X 68580021 TBAPRIME DC A(TBPRIMEB) X 68600021 TBRELSPA DC A(TBRELSPC) X 68620021 TBAENTM DC A(TBENDTAM) X 68640021 TBAMOVDI DC A(TBMOVDIC) X 68660021 TBATAMEP DC A(TBTAMEOP) X 68680021 TBATAMAR DC A(TAMAREA) X 68700021 TBATIB20 DC A(TIB20) DICOT TABLE TIB. 68720021 TBASAV1 DC A(TBSAV1) X 68740021 TBAGTALL DC A(TBGETALL) TAMER ADDRESS FOR PHASES 6 & 6A 68760021 TBADICAD DC A(DICADR) X 68780021 * 68800021 TBACOS DC A(COS) X 68820021 TBSAVER DS 1F SAVE AREA FOR A REGISTER 68840021 * * * * * * * * * * * 68860021 * COBOL SPACE TABLE 68880021 * KEEP THE FOLLOWING 10 CARDS TOGETHER 68900021 * 68920021 * * * * * * * * * * * 68940021 DS 0F 68960021 PCBSPT DC 10F'0' COBOL CONSTANTS 68980021 CBSPH7 DC XL4'3D78' COBOL SPACE PH70 CONSTANT 69000021 TBCCMSTM DS 1F CURRENT MASTAM 69020021 TBSPACGT DC F'0' 69040021 GETTABLE DC 8F'0' 69060021 GETEND EQU * 69080021 FREEMANE DC F'0' 69100021 SHIFTVAL DC F'0' 69120021 TBENDADR DC F'0' 69140021 TBLSUM DC F'0' 69160021 DCTLNGTH DC F'0' 69180021 DS 0F 69200021 TBMASK00 DC X'FFFFFFFC' 69220021 TBHASH DC X'02' PRIMES HASH TABLE 69240021 DC AL3(0) PRIMES HASH TABLE 69260021 DC H'1568' PRIMES HASH TABLE 69280021 DC H'0' PRIMES HASH TABLE 69300021 TBATIB30 DC A(TIB30) X 69320021 AGETEND DC A(GETEND) 69340021 SPACE 5 69360021 TBCON012 DC H'12' X 69380021 TBCOM001 DC H'-1' X 69400021 TBCON002 DC H'2' X 69420021 TBCON003 DC H'03' X 69440021 TBCOM512 DC H'-512' X 69460021 TBCON256 DC H'256' X 69480021 DS 0F 69500021 DS 0F 69520021 TBNEWLG1 DC H'0' 69540021 TAM1Q EQU X'02' 69560021 TAM2Q EQU X'04' 69580021 LONGPHS EQU TAM2Q 69600021 TAM3Q EQU X'05' 69620021 TAM4Q EQU X'06' 69640021 TAM5Q EQU X'07' 69660021 TAM6Q EQU X'09' 69680021 * 69700021 TBCON512 DC H'512' X 69720021 TBPHZNO DC X'00' 69740021 SPACE 2 69760021 TBSWGENE DC X'00' X 69780021 TBDISW DC X'00' X 69800021 TBSW1 DC X'00' X 69820021 GETSW DC X'00' 69840021 TBMESS1 DC C'IKF0001I-D SIZE PARAMETER TOO SMALL FOR THIS PROGRAM' 69860021 TBMESS1L EQU *-TBMESS1 69880021 TBMESS2 DC C'IKF0020I-D COMPILER ERROR - COMPILATION WILL NOT BE COMPX69900021 LETE' 69920021 TBMESS2L EQU *-TBMESS2 69940021 TBATRMNT DC A(TRMNATE) X 69960021 TBMESS3 DC C'IKF0010I-D A TABLE HAS EXCEEDED THE MAXIMUM PERMISSIBLEX69980021 SIZE.COMPILATION ABANDONED.' 70000021 TBMESS3L EQU *-TBMESS3 70020021 TBMESS4 DC C'IKF0030I-D FRAGMENTED CORE. RUN IN LARGER SIZE REGION. X70040021 COMPILATION ABANDONED.' 70060021 TBMESS4L EQU *-TBMESS4 70080021 TBNODIC EQU X'06' 70100021 EJECT 70120021 TBFLFREE EQU X'01' 70140021 TBFLPRIM EQU X'04' 70160021 TBFLSTAT EQU X'02' 70180021 SPACE 5 70200021 TBSPILLF EQU X'01' 70220021 TBFLINST EQU X'08' CALL FROM INSERT 70240021 TBFLDICT EQU X'10' CALL FROM DICT. 70260021 TBFLSPH1 EQU X'20' PH1 SPACE ASSIGNED. 70280021 TBFLSPH2 EQU X'40' PH2 SPACE ASSIGNED. 70300021 TBFLSPH3 EQU X'80' PH3 SPACE ASSIGNED. 70320021 TBFLNODC EQU X'01' NO DICT. 70340021 TBFULLPK EQU X'04' FULL PACK. 70360021 TBSPASKD EQU X'02' SPACE ALREADY ASKED. 70380021 UNCOND EQU 15 70400021 SPACE 5 70420021 SPACASK EQU X'FD' 70440021 SPACE 3 70460021 TBDBEGAR EQU 0 DISPLACT. IN MASTAM 70480021 TBDLENG EQU 4 70500021 TBDSTADD EQU 8 70520021 TBDCLENG EQU 12 70540021 TBDFSTAM EQU 16 70560021 TBDLSTAM EQU 20 70580021 TBDNSECT EQU 24 70600021 SPACE 5 70620021 TBTAMLG EQU 12 70640021 TBMSTMLG EQU 28 70660021 SPACE 5 70680021 TBSPILD EQU X'80' 70700021 TBFLWRTR EQU X'10' 70720021 TBIN EQU 64 70740021 TBUPDATE EQU 32 70760021 TYINOFF EQU 191 70780021 TYSPLOFF EQU 127 70800021 TYSUOFF EQU X'A0' 70820021 SPACE 10 70840021 TBSAV64 EQU TBSAV6 70860021 TBOUST EQU TBTAMENX 70880021 TBMOVEUP EQU TBMOVUP 70900021 PR12 EQU 12 70920021 PR5 EQU 5 70940021 PR4 EQU 4 70960021 TAMARA EQU TBATAMAR 70980021 TBCONS03 EQU TBCON003 71000021 TBSAVD DS 16F DICT RTN SAVE REGISTER AREA 71020021 TBINNST DC A(INSERT) X 71040021 TB32767 DC H'32767' X 71060021 TBTAGSW DC X'00' 71080021 TBWCHWAY DC X'00' 71100021 EJECT 71120021 SPACE 5 71140021 ****** HASH TABLE---USED BY ACCESS---STORED NOW AT END OF TAMER ** 71160021 DS 0F 71180021 END START 71200021 ./ ADD SSI=01010723,NAME=IKFCBL1B,SOURCE=0 *$MODULE PHASE1B 00010021 IHBCOB 00020021 PH1B TITLE 'IKFCBL1B' 00030021 SDDEF1 CSECT 00040021 USING COS,R1 00050021 ENTRY PH1B 00060021 BEGPHB DS 0H 00070021 DC C'IKFCBL1B' PHASE NAME 00080021 DC C'B' BUILD 00090021 DC X'1C' NUMBER IN HEX 00100021 * 00110021 * 00120021 * 00130021 * 00140021 * PATCH AREA IS DEFINED AS 'PATCH3' IN CSECT IKF103 00150021 * 00160021 * 00170021 * 00180021 * 00190021 * 00200021 *=3 00210021 * 00220021 * 00230021 *TITLE 00240021 * 00250021 * 'IKFCBL1B' 00260021 * 00270021 *STATUS: 00280021 * 00290021 * CHANGE LEVEL 000 00300021 * 00310021 *FUNCTION/OPERATION: 00320021 * 00330021 * PHASE 1'S GENERAL FUNCTION: 00340021 * ENCODES THE ENTIRE SOURCE PROGRAM INTO INTERNAL COMPILER TEXT. 00350021 * PRODUCES P0 TEXT FROM THE PROCEDURE DIVISION. PRODUCES OUTPUT 00360021 * LISTING AND/OR A-TEXT LISTING IF AN OBJECT MODULE LISTING IS 00370021 * REQUIRED. CREATES DICTIONARY ENTRIES FOR PROCEDURE NAMES. 00380021 * 00390021 * THE FUNCTION/OPERATION OF ACCESS: 00400021 * CONTROLS ALL REFERENCES TO THE DICTIONARY INCLUDING THE SPILLIN 00410021 * AND RETRIEVING OF SECTIONS OF THE DICTIONARY FROM DISKS, ETC. 00420021 * PHASE 1 USES ACCESS TO MAKE ENTRIES FOR PROCEDURE NAMES. 00430021 * 00440021 *ENTRY POINTS: 00450021 * 00460021 * PH1B 00470021 * 00480021 *INPUT: 00490021 * 00500021 * SYSIN - SOURCE PROGRAM (IF NOLIB IN EFFECT) 00510021 * SYSUT4 - SOURCE PROGRAM (IF LIB IN EFFECT) 00520021 * 00530021 *OUTPUT: 00540021 * 00550021 * SYSUT2 PROC. IC TEXT (P0) AND E TEXT IN PROC. DIV. 00560021 * LISTING A-TEXT. 00570021 * SYSPRINT SOURCE PROGRAM LISTING (IF NOLIB IN EFFECT) 00580021 * 00590021 *EXTERNAL ROUTINES: 00600021 * 00610021 * PHASE 00 LINK TO I-O AND INTERPHASE COMMON REGION 00620021 * PRIME ASSIGN AN AREA IN A TABLE REGION TO INDIVIDUAL T 00630021 * INSERT GET ROOM FOR AN ENTRY TO BE MADE IN A TABLE 00640021 * TABREL RELEASE TABLE, FREE AREA IF NO LONGER NEEDED. 00650021 * STATIC NOTE NO NEW ENTRY TO BE MADE, RELEASE UNUSED ARE 00660021 * 00670021 *EXITS- NORMAL: 00680021 * 00690021 * VIA PHASE 00 TO PHASE 2 00700021 * 00710021 * CALLING SEQUENCE: 00720021 * L JH,COSADR BALR 0,JH DC X'A0' 00730021 * 00740021 *EXITS-ERROR 00750021 * 00760021 * NONE 00770021 * 00780021 *TABLES/WORK AREAS COMTBL, QLTABL, APPTBL,PNTABL, PNQTBL, PIOTBL, 00790021 * CKPTBL, OD2TBL, FNTBL, RCDTBL, SPNTBL, RNMTBL, RWRTBL, ROUTBL, 00800021 * DETTBL, DICOT, TOTTBL, UPSTBL. 00810021 * 148 BYTES ARE RESERVED UNDER R13 AND WORK AREAS START AT DIVCOD 00820021 * PH1B IS PASSED THE P1BTBL WHICH CONTAINS INFORMATION NECESSARY 00830021 * CONTINUE PROCESSING THE SOURCE PROGRAM. IF PH1A HITS EOF ON INP 00840021 * THE EOPPH1 BIT IN PH1BYTE IN COMMON IS SET ON AND PH1B WILL 00850021 * RELEASE THE APPROPRIATE TABLES AND EXIT TO PHASE 00. 00860021 * TABLES ARE DESCRIBED IN PLM AND LISTING. 00870021 * 00880021 *ATTRIBUTES: 00890021 * 00900021 * NOT REUSABLE 00910021 * 00920021 *NOTES: GENERAL ORGANIZATION:- 00930021 * 00940021 * 1. EQU'S 00950021 * 2. ACCESS ROUTINES - MEMORY ALLOCATION, CONTROL DICTIONARY, ETC 00960021 * 3. PHASE 1B HOUSEKEEPING, INITIALIZE ACCESS, PRIME TABLES. 00970021 * 4. ERROR MESSAGES 00980021 * 5. WORK AREAS, COMMON WORK AND SAVE AREAS 00990021 * 6. REPORT WRITER TAMER ADCONS AND CONSTANTS 01000021 * 7. COBOL WORD TABLE 01010021 * 8. COMMON ROUTINES 01020021 * 9. GETDLM ROUTINE 01030021 * 10. UNIT LEVEL SCAN 01040021 * 11. PROCEDURE DIVISION SCAN 01050021 * 12. END OF JOB ROUTINE 01060021 * 13. PROCESS REPORT VERBS 01070021 * 01080021 * 01090021 * REGISTERS USAGE OF PHASE 1 (EXCLUDING ACCESS) 01100021 * 01110021 * 0 WORK REGISTER 01120021 * 1 WORK REGISTER 01130021 * 2 WORK REGISTER 01140021 * 3 WORK REGISTER 01150021 * 4 WORK REGISTER 01160021 * 5 WORK REGISTER 01170021 * 6 WORK REGISTER 01180021 * 7 WORK REGISTER 01190021 * 8 BASE REGISTER IN DATA DIV. ELSE WORK REGISTER. 01200021 * 9 BASE REGISTER 01210021 * 10 BASE REGISTER 01220021 * 11 BASE REGISTER 01230021 * 12 BASE REGISTER 01240021 * 13 GLOBAL TABLE BASE, NEVER TOUCHED, ALSO PHASE 1'S BASE REG. 01250021 * 14 LINK REGISTER, CALL REGISTER FOR SUBROUTINE 01260021 * 15 BASE REGISTER FOR INTERFACE AND INFREQUENT SUBROUTINES 01270021 * 01280021 * GENERAL CONSIDERATIONS IN ACCESS PROCESSING 01290021 * ACCESS HANDLES ON ERROR CONDITION, ALMOST NO EXCEPTION - PUT CO 01300021 * IN REGISTER 15. IF A SUCCESSFUL OUTPUT REGISTER 15 SET TO 0, O 01310021 * WISE SET TO 4 IF NAME IS NOT FOUND, SET TO 8 IF NAME IS DUPLICA 01320021 * DEFINED, SET TO 12 IF NAME REFERENCED BY ACCESS WAS ELEMENTART 01330021 * 01340021 * THE CONVENTION OF HANDLING GOOD OUTPUT, ACCESS ALWAYS USES REG. 01350021 * FOR STARTING ADDRESS OF ENTRY'S ATTRIBUTES, REG. 3 FOR DICTIONA 01360021 * POINTER OF ENTRY, AND REG. 15 SET TO ZERO, REG. 1 CONTAINS THE 01370021 * DICTIONARY POINTER OF THE NEXT ENTRY. REG. 0 AND 1 ARE NOT REST 01380021 * ON EXIT. 01390021 * 01400021 * CALLING SEQUENCE FOR CALL ACCESS ROUTINES: 01410021 * L 1,=A(PARAM) L 15,=A(ROUTINE'S NAME) L 14,15 01420021 * WHERE PARAM HAS THE FOLLOWING FORMAT ON A WORD BOUNDARY: 01430021 * // CODE/ADDR OF BCD NAME/ATTRIBUTE COUNT/ATTRIBUTE'S ADDRESS// 01440021 * 01450021 * 01460021 * 01470021 EJECT 01480021 ACCESS 1 01490021 * 01500021 * 01510021 NUMVRB EQU DATE+4-COS 01520021 NUMCDS EQU DATE+8-COS 01530021 PRIME EQU APRIME-COS 01540021 INSERT EQU AINSRT-COS 01550021 STATIC EQU ADSTAT-COS 01560021 TABREL EQU RELADD-COS 01570021 TAMEIN EQU TAMNAD-COS 01580021 CKPTCT EQU CKPCTR-COS 01590021 SBLOMA EQU SBLOMX-COS 01600021 VLCOMA EQU VLCOMX-COS 01610021 SBLIMA EQU SBLIMX-COS 01620021 VLCIMA EQU VLCIMX-COS 01630021 RPTSV1 EQU RPTSAV-COS 01640021 CMTLNG EQU 68 LENGTH OF COMTBL ENTRY 01650021 * 01660021 * FOLLOWING ARE REGISTER EQUATES FOR TAMER. 01670021 * 01680021 * 01690021 ****** GENERAL REGISTER SYMBOLIC EQU'S ****** 01700021 * 01710021 JA EQU 1 01720021 JB EQU 2 01730021 JC EQU 3 01740021 JD EQU 4 01750021 JE EQU 5 01760021 JF EQU 6 01770021 JG EQU 7 01780021 JH EQU 8 01790021 JJ EQU 9 01800021 JK EQU 10 01810021 JL EQU 11 01820021 JM EQU 12 01830021 JN EQU 13 01840021 JP EQU 14 01850021 JQ EQU 15 01860021 JR EQU 0 01870021 * 01880021 R0 EQU 0 01890021 R1 EQU 1 01900021 R2 EQU 2 01910021 R3 EQU 3 01920021 R4 EQU 4 01930021 R5 EQU 5 01940021 R6 EQU 6 01950021 R7 EQU 7 01960021 R8 EQU 8 01970021 R9 EQU 9 01980021 R10 EQU 10 01990021 R11 EQU 11 02000021 R12 EQU 12 02010021 R13 EQU 13 02020021 R14 EQU 14 02030021 R15 EQU 15 02040021 * 02050021 FJR EQU 0 02060021 FJB EQU 2 02070021 FJD EQU 4 02080021 FJF EQU 6 02090021 * 02100021 * STANDARD EQUATES FOR BC INSTRUCTIONS 02110021 * 02120021 UNCOND EQU 15 02130021 HI EQU 2 02140021 LO EQU 4 02150021 EQ EQU 8 02160021 EQUAL EQU 8 02170021 NOTHI EQU 13 02180021 NOTLO EQU 11 02190021 NOTEQ EQU 7 02200021 OV EQU 1 02210021 POS EQU 2 02220021 NEG EQU 4 02230021 ZERO EQU 8 02240021 NOTOV EQU 14 02250021 NOTPOS EQU 13 02260021 NOTNEG EQU 11 02270021 NOTZER EQU 7 02280021 ONES EQU 1 02290021 MIXED EQU 4 02300021 NOTONE EQU 14 02310021 NOTMXD EQU 11 02320021 NOP EQU 0 02330021 * 02340021 WORKA EQU 72 19F - WORKAREA FOR FLOPNT RTN 02350021 WORKA2 EQU 80 02360021 WORKA3 EQU 88 02370021 WORKB EQU 96 02380021 SVREG2 EQU 128 02390021 SYGNSW EQU 136 02400021 FLTEXP EQU 137 02410021 MANDEC EQU 138 02420021 MANINT EQU 140 02430021 MANLEN EQU 142 02440021 TOTLNG EQU 144 02450021 RESDEC EQU 146 02460021 * 02470021 * 02480021 EJECT 02490021 *=1 ENTRY TO PHASE 1 - HOUSEKEEPING ID 02500021 IKF101 CSECT 02510021 PH1B DS 0H 02520021 IKFCBL1B EQU PH1B 02530021 DUMTST STM JP,JM,DX12(JN) SAVE REGISTERS IN PH0 SAVE AREA 02540021 CNOP 0,4 02550021 LR JB,JN SAVE ADDR OF PH0 SAVE AREA IN R2 02560021 BALR JQ,JR LOAD BASE REGISTER 02570021 BC R15,DX8(JQ) BRANCH AROUND ADCON 02580021 DC A(PH1SAV) BEGINNING OF RESERVE AREA 02590021 L JN,DX4(JQ) SET R13 TO ADDR OF PHASE SAVE AREA 02600021 ST JP,DX12(JN) SAVE SYSTEM RETURN ADR IN PHASE SV AR 02610021 ST JB,DX4(JN) PUT PTR TO PH0 SV AREA IN PHASE SV A 02620021 ST JN,DX8(JB) PUT PTR TO PHASE SV AREA IN PH0 SV A 02630021 *=2 BASE REG ASSIGN + LOAD FOR COMMON ROUTINES AND AREAS 02640021 USING PH1SAV,JN 02650021 USING IDDIV1,JM 02660021 USING GETWD,JL 02670021 USING COBWRD,JK 02680021 BC UNCOND,DX148(JN) BRANCH AROUND SAVE AREA 02690021 * 02700021 * THE FOLLOWING 148 BYTES ARE RESERVED AREA UNDER REG13 02710021 * 02720021 * * * * D O N O T D I S T U R B * * * 02730021 * 02740021 PH1SAV DS 0D 02750021 DS 37F 18F - SAVE AREA FOR PH0 02760021 * WORKA EQU 72 8 19F - WORK AREA FOR FLOPNT RTN 02770021 * WORKA2 EQU 80 8 02780021 * WORKA3 EQU 88 8 02790021 * WO-KB EQU 96 32 02800021 * SVREG2 EQU 128 8 02810021 * SYGNSW EQU 136 1 02820021 * FLTEXP EQU 137 1 02830021 * MANDEC EQU 138 2 02840021 * MANINT EQU 140 2 02850021 * MANLEN EQU 142 2 02860021 * TOTLNG EQU 144 2 02870021 * RESDEC EQU 146 2 02880021 * 02890021 L JM,HSKP1 02900021 L JL,HSKP2 02910021 L JK,ACBW 02920021 L JQ,GETADR SET-UP BASE REGS 02930021 L JJ,GTD1 FOR GET-WORD AND GET-CARD R 02940021 STM JA,JQ,SAVREG ROUTINES 02950021 * 02960021 L JA,DX0(JA) GET COS ADDR FROM CONTROL 02970021 ST JA,COSADR STORE COS ADDR 02980021 L JB,ACCADR GET ADDR IN ACCESS OF DPAR 02990021 ST JA,DX0(JB) STORE COS ADDR IN DPARST 03000021 MVC ADPRIM(LX20),APRIME 03010021 BAL JP,NORPRC PRIME TABLES 03020021 * 03030021 *=2 INITIALIZE ACCESS 03040021 L JQ,ADINAC INITIALIZE ACCESS 03050021 BALR JP,JQ INITIALZE ACCESS 03060021 L JB,COSADR 03070021 * L JA,PARAPP 03080021 * AR JA,JB 03090021 * ST JA,PARAPP 03100021 L JA,PARPIO 03110021 AR JA,JB 03120021 ST JA,PARPIO 03130021 L JA,PARCKP 03140021 AR JA,JB 03150021 ST JA,PARCKP 03160021 L JA,PAROD2 03170021 AR JA,JB 03180021 ST JA,PAROD2 03190021 L JA,PARFNT 03200021 AR JA,JB 03210021 ST JA,PARFNT 03220021 L JA,PARRCD 03230021 AR JA,JB 03240021 ST JA,PARRCD 03250021 L JA,PARSPN 03260021 AR JA,JB 03270021 ST JA,PARSPN 03280021 L JA,PARTOT 03290021 AR JA,JB 03300021 ST JA,PARTOT 03310021 L JA,RNMTB 03320021 AR JA,JB 03330021 ST JA,RNMTB 03340021 L JA,RWRTB 03350021 AR JA,JB 03360021 ST JA,RWRTB 03370021 L JA,ROUTB 03380021 AR JA,JB 03390021 ST JA,ROUTB 03400021 L JA,DETTB 03410021 AR JA,JB 03420021 ST JA,DETTB 03430021 L JA,PARQLT 03440021 AR JA,JB 03450021 ST JA,PARQLT 03460021 USING PDSCN,JQ 03470021 USING EXHSVB,JJ 03480021 L JQ,PRODIV ADDR OF PDSCN 03490021 TM PH1BYTE-COS(JB),EOPPH1 IS IT EOP 03500021 BO PRGEND NO CARDS TO BE PROCESSED IN 03510021 DROP JJ 03520021 DROP JQ 03530021 L JA,PARP1B 03540021 AR JA,JB 03550021 ST JA,PARP1B 03560021 BAL JP,TBLNIT GET ADDR OF TBL 03570021 LR JB,JA 03580021 L JQ,GETADR 03590021 USING UNLVSN,JQ 03600021 MVC SVCPCK(LX123),DX2(JB) 03610021 MVC SIDMOV(LX88),DX125(JB) 03620021 MVC SOCMSW(LX2),DX213(JB) 03630021 MVC SVF4PTR(LX4),DX329(JB) GET FILE 4 PTR 03640021 MVC RPTWSW(LX1),DX337(JB) 03650021 NI RPTWSW,XX01 03660021 MVC TOTUSD(LX1),DX338(JB) 03670021 NI TOTUSD,XX80 03680021 MVC TEMPSW(LX2),DX339(JB) 03690021 MVC REPSW(LX4),DX341(JB) RESTORE COPYR SWS FOR 1B 03700021 MVC COMWK2(LX80),DX345(JB) RESTORE DBL BUF IN COPYR 03710021 * NOTE BYTES 425 THRU 426 ARE NOT USED 03720021 * 03730021 * NOTE BYTES 427 THRU 432 ARE NOT USED 03740021 * 03750021 MVC TWOTRE(LX2),DX433(JB) RESTORE 2 BYTES IN COL 72 03760021 MVC FRGNSW(LX1),DX435(JB) RESTORE FOREIGN SW 03770021 TM FRGNSW,XX01 TEST FRGNSW 03780021 BZ *+8 BRANCH IF ZERO 03790021 MVI KDECML,XX6B MOVE A COMMA 03800021 MVC SAVREG+NX16(LX12),SETREG SET UP REGS FOR GETWD 03810021 LA JA,SIDEWK+NX7 ADDR OF SIDWK +7 03820021 ST JA,FINDSV INITIALIZE FINDSV 03830021 TM RPTWSW,XX01 WAS THERE A REPORT SECTION 03840021 BC ZERO,PH1BBB NO...CONTINUE 03850021 MVC LCTRKN(LX12),UBLNK YES..REMOVE LINE-COUNTER 03860021 MVC PCTRKN(LX12),UBLNK PAGE-COUNTER 03870021 MVC PTSWKN(LX12),UBLNK PRINT-SWITCH FROM CWT 03880021 PH1BBB DS 0H 03890021 * 03900021 *** SET UP FOR DOUBLE QUOTE 03910021 * 03920021 L R1,COSADR DSECT BASE 03930021 TM PHZSW1,APOST SINGLE QUOTE 03940021 BC NOTZER,RSTRJQ YES - SKIP DOUBLE INIT 03950021 MVI TBQUT1,XX07 NO SET TRT TAB FOR 03960021 MVI TBQUT2,XX03 DOUBLE & SINGLE QUOTE 03970021 MVI KQUOTE+NX1,XX7F MOVE BLANK+DOUBLE QUOTES 03980021 MVI QUOCON+NX1,XX7F SINGLE TO DOUBLE QUOTES 9638 03990021 MVI QUOSCN+NX1,XX7F SINGLE TO DOUBLE QUOTES 9638 04000021 MVI SNGLQ2,XX7F 04010021 MVI SNGLQT,XX7F SINGLE TO DOUBLE 04020021 RSTRJQ DS 0H 04030021 DROP JQ 04040021 L JQ,ADTREL 04050021 L JA,PARP1B 04060021 BALR JP,JQ RELEASE P1B TABLE 04070021 * 04080021 *=2 SETUP AND TEST OF FIRST CARD READ ID 04090021 * 04100021 MVC DIVNM(LX10),PRO9 04110021 ** BAL 14,CHNGQT -QUOTE 04120021 ** BAL 14,CHGFOR -DEC COMMA 04130021 L JQ,COSADR COS ADDRESS 04140021 L JA,ADPB12 ADDRESS OF START OF PH1B 04150021 BALR R0,JQ LINK TO PHASE 00 04160021 DC X'06' READ 04170021 * 04180021 L JQ,SVREG+NX56 LOAD CALLER INTO R15 04190021 * 04200021 BASYES MVC NXTGCN(LX2),TEMPSW RESTORE GCN 04210021 BAL JP,GETWD SET UP NEXT CELL 04220021 MVC NXTGCN(LX2),TEMPSW RESTORE GCN 04230021 BAL JP,GETWD -GETWD (SET UP CUR CELL) 04240021 BAL JP,GETDLM -GETDLM 04250021 BCR UNCOND,JQ -EXIT TO DIVISION IN EFFEC 04260021 * 04270021 EJECT 04280021 NORPRC ST JP,SV1F01 04290021 L JQ,ADPRIM 04300021 LA JA,PARPNM PNTABL 04310021 BALR JP,JQ PRIME 04320021 LA JA,PARPQN PNQTBL 04330021 BALR JP,JQ PRIME 04340021 LA JA,USDECL USETBL 43521 04350021 BALR JP,JQ PRIME 43521 04360021 L JQ,PRODIV SET BASE REG VALUES 04370021 L JJ,PRODV1 04380021 STM JA,JQ,SVREG 04390021 ST JQ,LNKR15 SET-UP LINK REG15 AREA 04400021 L JP,SV1F01 RESTORE LINK REG 04410021 BCR UNCOND,JP -RETURN 04420021 *=1 EQUATES 04430021 * 04440021 ****** DATA AREA FOR PHASE 1 ****** 04450021 * 04460021 * 04470021 *=2 SWITCHES ID ENV DATA PR 04480021 * 04490021 * BIT 0 04500021 * BIT 1 04510021 * BIT 2 04520021 LINKSW DS 0F BIT 3 10 EF 04530021 MSG4SW DS 0F BIT 4 08 F7 04540021 MSG1SW DS 0F BIT 5 04 FB 04550021 NAMDSW DS 0F BIT 6 02 FD 04560021 CFGSW DS 0F BIT 7 01 FE 04570021 SWBYTS DC 5F'0' 20 BYTES FOR SWITCHES 04580021 IOSW EQU SWBYTS+1 BIT 0 04590021 SCHSW EQU SWBYTS+1 BIT 1 04600021 RCMDSW EQU SWBYTS+1 BIT 2 20 DF 04610021 RCDSW EQU SWBYTS+1 BIT 3 04620021 BLKSW EQU SWBYTS+1 BIT 4 04630021 LBLSW EQU SWBYTS+1 BIT 5 04640021 DATASW EQU SWBYTS+1 BIT 6 04650021 RPTSW EQU SWBYTS+1 BIT 7 04660021 * 04670021 FDMSW EQU SWBYTS+2 BIT 0 04680021 QUALSW EQU SWBYTS+2 BIT 1 04690021 INSRSW EQU SWBYTS+2 BIT 2 04700021 OD2SW EQU SWBYTS+2 BIT 3 04710021 DHDRSW EQU SWBYTS+2 BIT 4 08 F7 04720021 PRDSW EQU SWBYTS+2 BIT 5 04 FB 04730021 FSTLHN EQU SWBYTS+2 BIT 6 02 FD 04740021 PLHNSW EQU SWBYTS+2 BIT 7 01 FE 04750021 * 04760021 DSQLSW EQU SWBYTS+3 BIT 0 80 7F 04770021 QLPNSW EQU SWBYTS+3 BIT 1 40 BF 04780021 LCRDSW EQU SWBYTS+3 BIT 2 20 DF 04790021 DEBGSW EQU SWBYTS+3 BIT 3 10 EF 04800021 MSGPSW EQU SWBYTS+3 BIT 4 08 F7 STOPS ERROR MSGS 04810021 REWRSW EQU SWBYTS+3 BIT 5 04 FB 04820021 DATCSW EQU SWBYTS+3 BIT 6 02 FD 04830021 RPTWSW EQU SWBYTS+3 BIT 7 01 FE 04840021 * 04850021 SOCMSW EQU SWBYTS+4 BIT 0 80 7F 04860021 COPYSW EQU SWBYTS+4 BIT 1 40 BF COPY-LIBRARY IN ACTION 04870021 BASISW EQU SWBYTS+4 BIT 2 20 DF IN BASIS LIBRARY 04880021 BGNDSW EQU SWBYTS+4 BIT 3 10 EF BEGIN AND ENDING 04890021 DEBEOS EQU SWBYTS+4 BIT 4 08 F7 STOPS EOSGEN ON DEBUG 04900021 DEBULS EQU SWBYTS+4 BIT 5 04 FB STOPS ULSCAN FOR *DEBU 04910021 FXCDSW EQU SWBYTS+4 BIT 6 02 FD INDICATES 1ST CARD REA 04920021 CPYXSW EQU SWBYTS+4 BIT 7 01 FE COPY STATEMENT FOUND 04930021 * 04940021 INDLSW EQU SWBYTS+5 BIT 0 80 7F LOOK FOR INSERT/DELETE 04950021 INSTSW EQU SWBYTS+5 BIT 1 40 BF CARDS TO BE INSERTED 04960021 INDERR EQU SWBYTS+5 BIT 2 20 DF INS/DEL ERROR MSG WENT 04970021 INOWSW EQU SWBYTS+5 BIT 3 10 EF INSERT IN PROGRESS 04980021 DELSW1 EQU SWBYTS+5 BIT 4 08 F7 DELETE CARD 04990021 DELSW2 EQU SWBYTS+5 BIT 5 04 FB DELETE THRU CARD 05000021 DELSW3 EQU SWBYTS+5 BIT 6 02 FD DELETE THRU IN PROGRES 05010021 CPYCSW EQU SWBYTS+5 BIT 7 01 FE COPY CHECK FROM CUR CE 05020021 * 05030021 SYSISW EQU SWBYTS+6 BIT 0 80 7F SYSIN 05040021 SYSOSW EQU SWBYTS+6 BIT 1 40 BF SYSOUT 05050021 SYSPSW EQU SWBYTS+6 BIT 2 20 DF SYSPUNCH 05060021 SYSCSW EQU SWBYTS+6 BIT 3 10 EF CONSOLE 05070021 DUPMSG EQU SWBYTS+6 BIT 4 08 F7 SP-NAMES DUP MSG 05080021 FD01SW EQU SWBYTS+6 BIT 5 04 FB FD WAS LAST FILE-SCT L 05090021 NOTESW EQU SWBYTS+6 BIT 6 02 FD IN A NOTE IN P.D. 05100021 REDFSW EQU SWBYTS+6 BIT 7 01 FE NOT 1ST TIME THRU LEVE 05110021 * 05120021 NOLHSW EQU SWBYTS+7 BIT 0 80 7F NOT PRECEDED BY LHN-NO 05130021 IOCSW EQU SWBYTS+7 BIT 1 40 BF I-O-CONTROL 05140021 LCDXSW EQU SWBYTS+7 BIT 2 20 DF LAST CARD DURING INS/D 05150021 RPORSW EQU SWBYTS+7 BIT 3 10 EF REPORTS CLAUSE 05160021 DMSGSW EQU SWBYTS+7 BIT 4 08 F7 MSG FOR DELETE CARD 05170021 SELNSW EQU SWBYTS+7 BIT 5 04 FB MSGS FOR SELECT 05180021 RWLTSW EQU SWBYTS+7 BIT 6 02 FD IN RW IN DATA DIV ONLY 05190021 FRGNSW EQU SWBYTS+7 BIT 7 01 FE DECIMAL IS COMMA 05200021 * 05210021 FRESW EQU SWBYTS+8 BIT 0 80 7F FREE VERB 05220021 ORGSW EQU SWBYTS+8 BIT 1 40 BF ORGAN 05230021 RESSW EQU SWBYTS+8 BIT 2 20 DF RESERVE 05240021 FLTSW EQU SWBYTS+8 BIT 3 10 EF FILE-LIMIT 05250021 DUMUSE EQU SWBYTS+8 BIT 4 08 F7 SECTION-NAME FOR USE V 05260021 VALXW EQU SWBYTS+8 BIT 5 04 FB VALUE CLAUSE 05270021 LSTWSW EQU SWBYTS+8 BIT 6 02 FD LAST WORD ON CARD SW 05280021 EOFSW EQU SWBYTS+8 BIT 7 01 FE END OF SOURCE FILE 05290021 TOTUSD EQU SWBYTS+9 BIT 0 80 7F TOTALED SPEC'D 05300021 UNARSW EQU SWBYTS+9 BIT 1 40 BF UNARY PRECEDES IDENTIF 05310021 ENTSW EQU SWBYTS+9 BIT 2 20 DF ENTRY VERB GENERATED 05320021 USEPDL EQU SWBYTS+9 BIT 3 10 EF USE IN PD FOR LABELS 05330021 USEPDE EQU SWBYTS+9 BIT 4 08 F7 USE IN PD FOR ERROR 05340021 SRTSW EQU SWBYTS+9 BIT 5 04 FB SORT SW 05350021 CRSGSW EQU SWBYTS+9 BIT 6 02 FD CURRENCY SIGN SW 05360021 * 05370021 REPSW EQU SWBYTS+11 BIT 4 08 F7 REPLACING IN COPY CL 05380021 DDQSW EQU SWBYTS+8 BIT 7 01 FE QUAL NM IN DATA DIV 05390021 BYSW EQU SWBYTS+11 BIT 5 04 FB BY IN COPY CLAUSE 05400021 WD1SW EQU SWBYTS+11 BIT 6 02 FD OBJECT OF REPLACE-COPY 05410021 WD2SW EQU SWBYTS+11 BIT 7 01 FE OBJECT OF BY IN COPY 05420021 CDSURP EQU SWBYTS+12 BIT 0 80 7F SURPRESS GTCARD CALL 05430021 BUF2SW EQU SWBYTS+12 BIT 1 40 BF 2 TEMP BUFF FOR COP RE 05440021 BUF3SW EQU SWBYTS+12 BIT 2 20 DF 3 BUF FOR COPY REPLACI 05450021 BUF4SW EQU SWBYTS+12 BIT 3 10 EF MORE THAN 3 WK BUF NEE 05460021 CONTSW EQU SWBYTS+12 BIT 4 08 F7 CONTINUATION ON NXT CD 05470021 CPERSW EQU SWBYTS+12 BIT 5 04 FB NO MEMBER IN COPY LIB 05480021 CPYQSW EQU SWBYTS+12 BIT 6 02 FD COPY IN 01 05490021 REPQSW EQU SWBYTS+12 BIT 7 01 FE QUALIFIED WD REPLACING 05500021 CON2SW EQU SWBYTS+13 BIT 0 80 7F USASIA CONTINUATION 05510021 NWCDSW EQU SWBYTS+13 BIT 1 40 BF CONTINUATION OF WD RTN 05520021 SKCDSW EQU SWBYTS+13 BIT 2 20 DF SKIP CARD GET IN GETWD 05530021 GTRTSW EQU SWBYTS+13 BIT 3 10 EF GETWD CALLED BY GTCD 05540021 LASTSW EQU SWBYTS+13 BIT 4 08 F7 LAST WD PROC FOR COPYR 05550021 CRCDSW EQU SWBYTS+13 BIT 5 04 FB COPY WD NOT ENT RECTBL 05560021 MVLASW EQU SWBYTS+13 BIT 6 02 FD LAST CARD HIT IN COPY 05570021 DBRDSW EQU SWBYTS+13 BIT 7 01 FE DOUBLE BUFFER IN COP R 05580021 CNRDSW EQU SWBYTS+14 BIT 0 80 7F SKIP READ AT END OF CO 05590021 SURPSW EQU SWBYTS+14 BIT 1 40 BF SUPPRESS COPY LIB 05600021 BUF5SW EQU SWBYTS+14 BIT 2 20 DF 4 WK AREA FOR COPYR 05610021 PRIDSW EQU SWBYTS+14 BIT 3 10 EF PROG-ID SW 05620021 LASTSEG EQU SWBYTS+14 BIT 4 08 F7 LAST SEGM IN PROC DIV 8035 05630021 CMNTCDSW EQU SWBYTS+14 BIT 6 02 FD DELETING COMMENT CARD 05640021 *REPORT WRITER SWITCHES 05650021 RWSWB DC F'0' RW SWITCHES FOR PROC DIV 05660021 INITSW EQU RWSWB 80 -- 7F 05670021 GENSW1 EQU RWSWB 40 05680021 FRSTRD EQU GENSW1 40 USED AS FIRST RD 05690021 GENSW2 EQU RWSWB 20 05700021 * 05710021 QLRTSW DC X'00' QUALIFIED-NAME ROUTINE SWIT 05720021 AMARSW DC X'00' BIT0-STD WD, 1-BCD NAME, 2-INT-NUM-LIT, O-DECLA 05730021 PICTSW DC X'0' PICT SW 05740021 SIGNSW DC X'00' FLO-PT NUMBER SIGN SWITCH 05750021 DECSW DC X'00' MUST FOLLOW SIGNSW 05760021 RCDSW1 DC X'00' BIT 7 ON IF IN WRITE VERB 05770021 TEMPSW DC 3X'00' AREA FOR WRITE VERB 05780021 * 05790021 VRPNSW DC X'00' 40 IF PN FOUND IN PN PNQ TBL 05800021 DISPJH DC H'0' USED IN SEARCH OF PN/PNQ TBL 05810021 EOTCP DC H'0' MUST FOLLOW DISPJH 05820021 EOTPN DC H'0' POINTER TO END OF PN TBL (SRCH) 05830021 PNMVS DC 8F'0' MOVE PN OR PNQ FOR ACCESS 05840021 ADPNMV DC AL4(PNMVS) ADDR OF BCD (PNMVS) 05850021 * 05860021 * SIGNIFICANT NAMES. FIRST BYTE CONTAINS COUNT OF CHARS IN NAME. 05870021 * 05880021 DIVCOD DC X'0F' CODE TO TEST WHICH DIVISION IS IN EFFECT 05890021 DC X'23' ERROR PROCESS IN LATER PHASE 05900021 DIVNM DS CL31 NAME OF CURRENT DIVISION 05910021 DC X'23' ERROR PROCESS IN LATER PHASE 05920021 SECTNM DS CL31 NAME OF CURRENT SECTION 05930021 DC X'23' ERROR PROCESS IN LATER PHASE 05940021 PARNM DS CL31 NAME OF CURRENT PARAGRAPH 05950021 DC X'23' ERROR PROCESS IN LATER PHASE 05960021 CLSNM DS CL31 NAME OF CURRENT CLAUSE 05970021 DC X'23' ERROR PROCESS IN LATER PHASE 05980021 VERBNM DS CL31 NAME OF CURRENT VERB 05990021 * 06000021 HSKP1 DC A(IDDIV1) ***MUST BE IN PH1SAV USING*** 06010021 * 06020021 *=2 E-TEXT MESSAGE PARAM ID ENV DATA PR 06030021 * 06040021 MSGDEF DC X'000600' ERROR MESSAGE 06050021 MSGNUM DC X'0000' MSG NUMBER 06060021 MSGGCN DC X'0000' GEN SEQ NUMBER 06070021 MSGSP DC X'01' SEVERITY - PHASE NUMBER 06080021 EPARNN DC X'0000' E-TEXT PARAM 06090021 EPARAM DC X'0000' -PARAM 06100021 DS CL120 CONTINUED 06110021 SECPAR DC 2XL16'0' SECOND PARAM 06120021 * 06130021 *=2 INPUT-RECORD WORK AREA FOR LISTING 06140021 * 06150021 COMWK2 DS CL80 DOUBLE BUF AREA IN COP REPL 06160021 SVCINC DC X'001C' FOR GCN 06170021 DS 0D ALIGN OF SVCPCK FOLLOWING 06180021 SVCPCK DC X'000000000000000C' DW FOR PACK OF GCN 06190021 SVCUPK DC D'0' DW FOR UNPACK OF GCN 06200021 SVCGCN EQU SVCUPK+3 START OF 5 DIGIT GCN 06210021 SVCTYP DC X'404040' 3 BLANKS BETWEEN NUMBERS 06220021 SVCCRD DC 5CL16' ' START OF 80 CHAR RECORD 06230021 COMMOV EQU SVCTYP+1 06240021 COMWRK EQU SVCTYP+3 06250021 SVCERR DC C'*ERROR NO.' ERROR NUMBER 06260021 DC C' , *' ** 06270021 SVCSEQ DC XL6'00' SAVED SEQ NUMBER 06280021 UBLNK DC C' ' 16 BLANKS 06290021 TWOTRE DC X'4040' SAVE AREA TO RESTORE PRINT 06300021 * 06310021 *=2 FNTBL WORK AREA DATA 06320021 * 06330021 FNWA DC XL17'0' FN WORK AREA 06340021 FNWFN DS CL32 N'1' FN '30' 06350021 FNPIOT EQU 0 PIOTBL PTR 06360021 FNRPDN EQU 2 RPD NO 06370021 FNAPPT EQU 4 APPTBL PTR 06380021 FNGNSE EQU 6 GN FOR STANDARD ERROR 06390021 FNGNHL EQU 8 GN FOR HEADER LABELS 06400021 FNGNTL EQU 10 GN FOR TRAILER LABELS 06410021 FNGNEV EQU 12 GN FOR END OF VOLUME LABELS 06420021 FNGNBV EQU 14 GN FOR BEG.OF VOLUME LABELS 06430021 FNFLG1 EQU FNWA+16 SWITCH 06440021 FNFL1 EQU 16 FLAG1 06450021 FNACR EQU X'80' 1 ACCESS RANDOM 06460021 FNMSF EQU X'40' 1 MASS STORAGE FILE 06470021 FNLRS EQU X'20' 1 LABEL RECORDS STANDARD 06480021 FNLRO EQU X'10' 1 LABEL RECORDS OMITTED 06490021 FNBEF EQU X'08' 1 BEFORE IN USE 06500021 FNAFT EQU X'04' 1 AFTER IN USE 06510021 FNRDP EQU X'02' 1 RECORD PROTECT 06520021 FNPMR EQU X'01' 1 PROC MODE RANDOM 06530021 FNWFND EQU 17 06540021 ENVSIZ EQU 86 06550021 FNSIZ EQU 48 SIZE OF FNTBL 06560021 PIOSIZ EQU 3 06570021 * THESE EQUATES ARE USED TO OR INTO PIOTBL 06580021 PIOFL1 EQU 0 06590021 PIOOIN EQU X'80' OPEN INPUT 06600021 PIOOOT EQU X'40' OPEN OUTPUT 06610021 PIOOIO EQU X'20' OPEN I-O 06620021 PIOCNR EQU X'10' CLOSE NO REWIND-OS 06630021 PIOWAV EQU X'08' WRITE AFTER ADV 06640021 PIOCWL EQU X'04' CLOSE WITH LOCK 06650021 PIOCLS EQU X'02' CLOSE 06660021 PIOREW EQU X'01' REWRITE 06670021 PIOFL2 EQU 1 06680021 PIORER EQU X'80' RERUN 06690021 PIOOIR EQU X'40' OPEN INPUT REVERSED 06700021 PIOFRE EQU X'20' READ 06710021 PIOWBA EQU X'10' WRITE BEFORE ADV 06720021 PIOUSG EQU X'08' USING 06730021 PIOGVG EQU X'04' GIVING 06740021 PIOUSE EQU X'02' USE 06750021 PIOWAP EQU X'01' WRITE AFTER POSITIONING 06760021 PIOFL3 EQU 2 06770021 PIONST EQU X'80' BEFORE IN USE 06780021 PIOONR EQU X'40' OPEN NO REWIND 06790021 PIOWRT EQU X'20' WRITE 06800021 PIOUSF EQU X'10' USE ON FILENAME 06810021 PIOSTR EQU X'08' START 06820021 PIOINV EQU X'04' INVALID KEY 06830021 * 06840021 *=2 PARAM'S AND WORK AREA FOR PROC DIV PR 06850021 * 06860021 ***** PARAMETER FOR 'ENTNAM' ACCESS ROUTINE ***** 06870021 * 06880021 DS 0F 06890021 NAMCOD DC X'0' * LHN CODE - SECT 4,PARA 0 06900021 DC AL3(LCBCD) * ADDRESS OF LHN(BCD NAME) 06910021 DC X'06' * ATTRIBUTES COUNT 06920021 DC AL3(LCATRB) * ADDRESS OF ATTRIBUTES 06930021 * 06940021 ***** PARAMETER FOR 'ENTDEL' ACCESS ROUTINE ***** 06950021 * 06960021 SCTPTR DC F'0' * POINTER TO LAST SECTION NAME 06970021 DELPTR DC F'0' * POINTER TO NEW SECTION NAME 06980021 * 06990021 ***** PARAMETER FOR 'LATGRP' ACCESS ROUTINE ***** 07000021 * 07010021 DS 0F 07020021 GRPBCD DC X'0C' * CODE FOR LATGRP 07030021 DC AL3(0) * ADDRESS OF BCD NAME TO BE LOCATE 07040021 GRPPTR DC F'0' * PTR TO SECTION IN WHICH TO LOOK 07050021 * 07060021 ***** PARAMETER FOR 'LATRNM' ACCESS ROUTINE ***** 07070021 * 07080021 RNMBCD DC F'0' * ADDRESS OF BCD NAME TO BE LOCATE 07090021 * * * * WORK AREA FOR LOCATTRIB * * * * 07100021 LOCNAM DC 8F'0' WORK AREA 07110021 * * * * * 07120021 ***** PARAMETER FOR 'LDELNM' ACCESS ROUTINE ***** 07130021 * 07140021 DS 0F 07150021 LNMBCD DC X'10' PARAM. OF 07160021 DC AL3(0) ADD OF QUALIFIER 07170021 * 07180021 ***** LHN WORK AREA FOR ENTRY INTO DICTIONARY ***** 07190021 * 07200021 STEV23 DC F'35' 00000023 07210021 SLBCD EQU STEV23+3 ADDR OF '23' 07220021 LCBCD DC 8F'0' * BCD NAME FOR ACCESS //N/NAME 07230021 DC X'00' FILLER FOR BOUNDRY ADJ 07240021 LCATRB DC X'00' * COUNT - MAJOR 4 BITS EACH 07250021 LCCHAR DC H'0' * S,T,P,A,G,E,-,- * B,U,X,D,K,L,M, 07260021 * B-REF*D U-DEF*D X-DUMM D-DECL K-ERR L-LAB M-RAND N-RE 07270021 LCNUM DC H'0' * LHN NUMBER 07280021 LCRPD DC X'00' * RPD NUMBER 07290021 LCPTY DC X'00' * PRIORITY NO 07300021 DC X'0000' * SECTION NUMBER OF NEXT SECTION 07310021 * 07320021 ***** PROCEDURE NAME WORK AREA FOR ENTRY TO'PNTABL OR PNQTBL' * 07330021 * 07340021 PNBC DC F'0' COUNT AREA 07350021 PNBCT EQU PNBC+3 TOTAL COUNT 07360021 PNBCDN DC 8F'0' * BCD NAME //N/NAME// 07370021 PNCHAR DC H'0' * S,T,P,A,G,E,-,- * B,U,X,D,K,L,M, 07380021 * B-REF*D U-DEF*D X-DUMM D-DECL K-ERR L-LAB M-RAND N-RE 07390021 PNOLD DC X'00' NEW/OLD CODE 07400021 PNQLCD DC X'22' QUALIFIER CODE 07410021 PNBCDQ DC 8F'0' * BCD NAME QUALIFIER //N/NA 07420021 PNBCNN DC AL3(PNBCDN) ADDR OF PN BCD 07430021 PNBCQN DC AL3(PNBCDQ) ADDR OF QUALIFIER BCD 07440021 LOCNAMAD DC AL3(LOCNAM) 07450021 * 07460021 ***** PROCEDURE DIVISION FILE 4 TEXT ***** 07470021 * 07480021 PRF4CD DC X'37' LISTING A-TEXT CODE 07490021 PRF4NU DC X'00' N FIELD X'00' IF A PN 07500021 PRF4NM DC 3CL10'0' FILE 4 PD TEXT BCD NAME 07510021 ***** PROCEDURE DIVISION FILE 2 TEXT FOR SEQ NUMBER ***** 07520021 * 07530021 CRDGCN DC X'810000' GCN TEXT FOR FILE 2 07540021 ADPB12 DC A(BEGPHB) 07550021 * EXECUTE INSTRUCTION FOR MOVE UP OF CONSTANTS AND PN QUAL 07560021 PNQMV MVC DX0(LX0,JC),PNCHAR MOVE 07570021 PNMVD MVC PNMVS(LX0),DX0(JP) MOVE BCD TO FULL WORD 07580021 EJECT 07590021 * 07600021 *=1 COMMON WORK AND SAVE AREAS ID ENV DATA PR 07610021 * 07620021 SVREG DS 15F CALLING ROUTINE SAVE REGISTERS 07630021 SAVREG DS 15F ULSCN ROUTINE REG SAVE 07640021 SV1F01 DS F LINK REG SAVE 07650021 SV1F02 DS F LINK REG SAVE 07660021 SV1F03 DS F LINK REG SAVE 07670021 SV4F04 DS 4F LINK REG SAVE 07680021 SV1F05 DS F LINK REG SAVE 07690021 SV1F06 DS F LINK REG SAVE 07700021 SV1F07 DS F LINK REG SAVE 07710021 SV1F08 DS F LINK REG SAVE 07720021 SV1F09 DS F LINK REG SAVE 07730021 SV1F10 DS F LINK REG SAVE 07740021 SV1F11 DS F LINK REG SAVE 07750021 SV1F12 DS F LINK REG SAVE 07760021 SV3F12 DS 3F SAVE REG. 1-3 ERROR MSG. 07770021 SV1F14 DS F LINK REG SAVE 07780021 JPSAVE DS F SAVE XR JP FOR ROUTS USED B 07790021 JPUBRS DS F LINK REG SAVE 07800021 PUTNSV DS F RW PUTN JP SAVE AREA 07810021 GDLRSV DS 3F GET DELIM 3 REG SAVE AREA 07820021 QUOTSV DS 2F SAVE REGS FOR QUOTE(GETWD) 07830021 GETCSV DS F SAVE LINK REG FOR GETCRD 07840021 NBLPTR DS F ADDR OF GETWD WORD IN BUFFE 07850021 SKCTAD DS F ADDR PAST CONTINUATION 07860021 SV1REG DS F SAVE AREA FOR 1 REGISTER 9015 07870021 LASTWD DS XL68'0' SAVE AREA FOR LASTWD ON CARD9610 07880021 * 07890021 SVRPRG DS F ADDR OF COPYWD IN BUFFER 07900021 CPYSAV DS 8F COP RTN SAVE AREA 07910021 * 07920021 FINDSV DS F DELETE CARD POINTER SAVE 07930021 SVREAD DS F LINK REG SAVE FOR (READI) 07940021 GNSQNO DC H'0' GEN SQ NUM 07950021 * 07960021 VALNLT DC D'0' DOUBLEWORD SAVE FOR VAL NUM 07970021 GDLWKA DS D DOUBLEWORD WORK AREA GETDLM 07980021 WORKDA DC D'0' DOUBLEWORD WORK AREA 'A' 07990021 REGWOK DC F'0' FULLWORD REGISTER WORK AREA 08000021 REGWEK DC F'0' FOR FLT-PT-RTN 08010021 WORKFB DC F'0' FULLWORD 08020021 WORKHC DC H'0' HALFWORD 08030021 * 08040021 ETYPE DS CL10 PARAGRAPH OR VERB IN EFFECT 08050021 SMECTR DC X'00' SAME COUNTER 08060021 APTRSV DS F APPSCN SAVE SIZE AND ADDRES 08070021 RPOSAV DC F'0' POINTER-SIZE OF SAVED RPT-N 08080021 SCHPTR DC F'0' SIZE + PTR OF SCHENV 'FIND' 08090021 SVCALP DS F SAVE AREA FOR R15 AS BASE REG. 08100021 ADPROM DC A(PDSCN) ADDR OF PN AND QN SCAN 08110021 LOOKUP DC F'0' SEARCHPNTABL SAVE AREA 08120021 SEADDR DC F'0' SEARCH PNTABL SAVE AREA 08130021 ABSADD DC F'0' TAMER ABSOLUTE ADDRESS SAVE 08140021 SAVSIZ DC H'0' SIZE OF LAST TAMER ENTRY 08150021 PONTER DC H'0' POINTER OF LAST TAMER ENTRY 08160021 PIOCOD DC F'0' PIOTBL CODE WORK AREA 08170021 SCHSAV DC H'0' SAVE ADJ FACTOR FOR SEARCH 08180021 GENENT DC X'81' GENERATE CARD 08190021 ENTCDN DC X'0000' CARD NO 08200021 DC X'442C' ENTRY VERB 08210021 DC X'3408' ALPHA LIT 08220021 ENTLIT DS 8C PROGID 08230021 GENGO DC X'4411' TO 08240021 DC X'549B' TO 08250021 GODEF DC X'AA' IDENTIFYING NUMBER 08260021 GOPN DC X'0000' FROM COMMON - GNCTR 08270021 F4ENTCD DC X'37' LISTING A-TEXT CODE 08280021 F4ENT DC X'05' ENTRY A-TEXT 08290021 DC C'ENTRY' ENTRY 08300021 F4GOCD DC X'37' LISTING A-TEXT CODE 08310021 F4GO DC X'02' GO A-TEXT 08320021 DC C'GO' GO 08330021 USEFL1 DS 1X USEFLAG 08340021 USETOT EQU X'80' TOTALED AREA DN 08350021 USEF2 EQU X'40' USE ON MULTIPLE FILENAMES 08360021 USEAF EQU X'20' AFTER 08370021 USEBF EQU X'10' BEFORE 08380021 USERU EQU X'08' REEL/UNIT 08390021 USEFL EQU X'04' FILE 08400021 USEBG EQU X'02' BEGINNING 08410021 USEEN EQU X'01' ENDING 08420021 INGNBF DC 4H'0' INPUT GN TBL FOR BEFORE 08430021 INBOFB EQU INGNBF BOF 08440021 INEOFB EQU INGNBF+2 EOF 08450021 INEOVB EQU INGNBF+4 EOV 08460021 INBOVB EQU INGNBF+6 BOV 08470021 OUGNBF DC 4H'0' OUTPUT GN TBL FOR BEFORE 08480021 OUBOFB EQU OUGNBF BOF 08490021 OUEOFB EQU OUGNBF+2 EOF 08500021 OUEOVB EQU OUGNBF+4 EOV 08510021 OUBOVB EQU OUGNBF+6 BOV 08520021 IOGNBF DC 4H'0' I-O GN TBL FOR BEFORE 08530021 IOBOFB EQU IOGNBF BOF 08540021 IOEOFB EQU IOGNBF+2 EOF 08550021 IOEOVB EQU IOGNBF+4 EOV 08560021 IOBOVB EQU IOGNBF+6 BOV 08570021 INGNAF DC 4H'0' INPUT GN TBL FOR AFTER 08580021 INBOFA EQU INGNAF BOF 08590021 INEOFA EQU INGNAF+2 EOF 08600021 INEOVA EQU INGNAF+4 EOV 08610021 INBOVA EQU INGNAF+6 BOV 08620021 OUGNAF DC 4H'0' OUTPUT TBL FOR AFTER 08630021 OUBOFA EQU OUGNAF BOF 08640021 OUEOFA EQU OUGNAF+2 EOF 08650021 OUEOVA EQU OUGNAF+4 EOV 08660021 OUBOVA EQU OUGNAF+6 BOV 08670021 IOGNAF DC 4H'0' I-O TBL FOR AFTER 08680021 IOBOFA EQU IOGNAF BOF 08690021 IOEOFA EQU IOGNAF+2 EOF 08700021 IOEOVA EQU IOGNAF+4 EOV 08710021 IOBOVA EQU IOGNAF+6 BOV 08720021 RWGCNS DS H RW-ROUT GCN ACCUMULATOR 08730021 INSTER DC H'0' INPUT STANDARD ERROR GN 08740021 OUSTER DC H'0' OUTPUT STANDARD ERROR GN 08750021 IOSTER DC H'0' I-O STANDARD ERROR GN 08760021 OPNSTR DC X'260A' GN HEADER 08770021 OPNGNS DC 5H'0' OPEN SW 08780021 OPNSTE EQU OPNGNS STE 08790021 OPNBOF EQU OPNGNS+2 BOF 08800021 OPNEOF EQU OPNGNS+4 EOF 08810021 OPNEOV EQU OPNGNS+6 EOV 08820021 OPNBOV EQU OPNGNS+8 BOV 08830021 FRHWZ DC 5H'00' USE VERB FLAG 08840021 BCDGEN DC X'23' AREA FOR GEN- 08850021 DS CL31 -OUT OF BCD-NAME 08860021 DECSIZ DC X'00000100' COMMUNICATION AREA 1 08870021 TOTSIZ EQU DECSIZ+1 FOR FLOATING- 2 08880021 FLPWK DS CL22 POINT ROUTINE 3 08890021 LNKR15 DS F STORE AREA FOR LINK REG15 08900021 EJECT 08910021 INTCNT DS H LITERALS COUNT FIELD 08920021 DECCNT DS H DEC. COUNT FIELD 08930021 ZERWRD DC F'0' ZERO CONSTANT 08940021 UNPWRK DS CL3 LITERAL UNPWRK AREA 08950021 UNPSUB DS CL15 WORK AREA 08960021 UNPEND DS CL1 WORK AREA 08970021 PAKWRK DS CL2 WORK AREA 08980021 PAKSUB DS CL8 WORK AREA 08990021 PAKEND DS CL1 WORK AREA 09000021 WRK2 DS CL2 WORK AREA 09010021 WRK3 DS CL3 WORK AREA 09020021 SAVER8 DS F WORK AREA 09030021 REGWRK DC F'0' WORK AREA 09040021 * 09050021 X2311 EQU 14 09060021 X2321 EQU 16 09070021 X2314 EQU 15 09080021 * 51903 09090021 PNTAB L JC,DX0(JF) ADDR OF TAM 51903 09100021 L JG,DX0(JC) ADDR OF TABLE 51903 09110021 LA JG,DX0(JG) CLEAR HIGH ORDER BYTE 51903 09120021 AH JG,EOTCP GET PROPER ENTRY 51903 09130021 BR JP RETURN 51903 09140021 * 51903 09150021 PNQMOVUP STM R6,R7,PNQSAV SAVE REGISTERS 51903 09160021 LR R6,R7 R6 = ADDR DELETED ENTRY 51903 09170021 AR R7,R5 R7 = ADDR NEXT ENTRY 51903 09180021 BCTR R4,R0 REMAINING LENGTH -1 (EX) 51903 09190021 EX R4,PNQMVC ADJUST TABLE 51903 09200021 LA R4,DX1(R4) RESTORE COUNT 51903 09210021 L R6,PNQCON ADDR TIB 06 51903 09220021 L R6,DX0(R6) ADDR TAMM 51903 09230021 STH R4,DX4(R6) ADJUST DISP IN TAMM 51903 09240021 STH R4,EOTPN ADJUST TOTAL LENGTH 51903 09250021 LM R6,R7,PNQSAV RESTORE REGISTERS 51903 09260021 BR JP RETURN 51903 09270021 * 51903 09280021 PNQMVC MVC DX0(LX0,R6),DX0(R7) OVERLAY DELETED ENTRY 51903 09290021 PNQSAV DC 2F'0' SAVEAREA 51903 09300021 * 51903 09310021 EJECT 09320021 *=1 ERROR MESSAGES 09330021 * 09340021 * ERROR MSG NUMBER TABLE 09350021 DS 0F START MSGS ON FULL WORD 09360021 * 09370021 *=E 1 NUM-LIT NOT RECOG AS LEV-NUM,BECAUSE '-' ILLEGAL AS USE 09380021 MSG1 BAL JQ,PARMN BRANCH AND LINK 09390021 DS 2F 09400021 *=E 04 INVALID WORD '-'. SKIP TO NEXT LEVEL, SECTION, DIVISION 09410021 MSG4 BAL JQ,PARMC BRANCH AND LINK 09420021 DS F MISSING MSG 09430021 *=E 06 06 DECLARATIVES SECTION WITHOUT 'USE' SENTENCE. CONTINUING 09440021 MSG6 BAL JQ,WRTMSG BRANCH AND LINK 09450021 *=E 7 '--' NOT PRECEDED BY A SPACE. ASSUME SPACE. 09460021 MSG7 BAL JQ,PARMN BRANCH AND LINK 09470021 *=E 8 RIGHT PAREN SHOULD NOT BE PRECEDED BY A SPACE. 09480021 MSG8 BAL JQ,WRNMSG BRANCH AND LINK 09490021 *=E 9 'INCLUDE' SHOULD BE PRECEDED BY PROC-NAM. IGNORED. 09500021 MSG9 BAL JQ,WRTMSG BRANCH AND LINK 09510021 *=E 10 LEFT PAREN SHOULD NOT BE FOLLOWED BY A SPACE. 09520021 MSG10 BAL JQ,WRNMSG BRANCH AND LINK 09530021 DS 4F MISSING MSG 09540021 *=E 0F 15 '-' INVALID AS EXTERNAL-NAME. IGNORED. 09550021 MSG15 BAL JQ,PARMC BRANCH AND LINK 09560021 DS F MISSING MSG 09570021 *=E 11 17 INVALID WORD IN '-' CLAUSE. SKIPPING TO NEXT CLAUSE. 09580021 MSG17 BAL JQ,PARM1C BRANCH AND LINK 09590021 *=E 12 18 COPY LIBRARY NOT FOUND/NO LIBR IN EFFECT 09600021 MSG18 BAL JQ,WRTMSG BRANCH AND LINK 09610021 *=E 13 19 COPY CLAUSE IGNORED DUE TO NO LIBRARY NAME. 09620021 MSG19 BAL JQ,WRTMSG BRANCH AND LINK 09630021 *=E 20 '-' SHOULD BE A PROC-NAME FOLLOWING DEBUG NEXT CARD 09640021 MSG20 BAL JQ,PARMC BRANCH AND LINK 09650021 *=E 21 '-' DOES NOT BELONG ON DEBUG CARD NEXT CARD 09660021 MSG21 BAL JQ,PARMC BRANCH AND LINK 09670021 *=E 22 PERIOD DOES NOT BELONG ON DEBUG CARD DELETED 09680021 MSG22 BAL JQ,PARMC BRANCH AND LINK 09690021 *=E 17 23 INVALID FILE-NAME. USE IGNORED. 09700021 MSG23 BAL JQ,WRTMSG BRANCH AND LINK 09710021 *=E 18 24 UNDEFINED FILE-NAME. USE IGNORED. 09720021 MSG24 BAL JQ,WRTMSG BRANCH AND LINK 09730021 DS 2F MISSING MSG. 09740021 *=E 27 FILE WITH TOTALED AREA CLAUSE AND NON STANDARD LABELS 09750021 *=E MUST NOT BE OPENED OUTPUT. 09760021 MSG27 BAL JQ,WRTMSG BRANCH AND LINK 09770021 DS 3F DISPLACEMENT 09780021 *=E 1F 31 USE SENTENCE NOT PRECEEDED BY SECTION-NAME. ASSUME ONE. 09790021 MSG31 BAL JQ,WRTMSG BRANCH AND LINK 09800021 *=E 20 32 '-' INCORRECTLY USED IN USE SENTENCE. SENTENCE IGNORED. 09810021 MSG32 BAL JQ,PARMC BRANCH AND LINK 09820021 DS 2F DISPLACEMENT 09830021 *=E 23 35 SECTION-NAME NOT DEFINED IN APPLY-4 CLAUSE. USE R-P IGN 09840021 MSG35 BAL JQ,WRTMSG BRANCH AND LINK 09850021 DS 3F 09860021 *=E 27 39 DATA-NAME IN '-' CLAUSE SHOULD BE UNQUAL. USING LOW NAM 09870021 MSG39 BAL JQ,PARM4 BRANCH AND LINK 09880021 DS 3F DISPLACEMENT 09890021 *=E 2B 43 END OF SENTENCE SHOULD PRECEDE '-'. ASSUMED PRESENT. 09900021 MSG43 BAL JQ,PARMN1 BRANCH AND LINK 06793 09910021 DS 2F DISPLACEMENT 09920021 *=E 46 MEMBER NOT FOUND IN LIBRARY. IGNORING COPY. 09930021 MSG46 BAL JQ,WRTMSG BRANCH AND LINK 09940021 *=E 47 LIBRARY NOT FOUND ON SYSTEM. IGNORING COPY. 09950021 MSG47 BAL JQ,WRTMSG BRANCH AND LINK 09960021 *=E 48 LIBRARY MEMBER HAS BAD TRACK. IGNORING REST OF COPY. 09970021 MSG48 BAL JQ,WRTMSG BRANCH AND LINK 09980021 DS 2F DISPLACEMENT 09990021 *=E 33 51 NO DATA-NAME IN USE SENTENCE. SENTENCE IGNORED. 10000021 MSG51 BAL JQ,WRTMSG BRANCH AND LINK 10010021 *=E 34 52 '-' ILLEGALLY USED IN USE SENT. END SENT,RESCAN AT RECO 10020021 MSG52 BAL JQ,PARMC BRANCH AND LINK 10030021 DS F 10040021 *=E 54 OPERAND IN INITIATE NOT FOUND OR ILLEGAL. IGNORED 10050021 MSG54 BAL JQ,WRTMSG BRANCH AND LINK 10060021 DS 5F DISPLACEMENT 10070021 *=E 60 INVALID WORD IN RW VERB CLAUSE. IGNORED. 10080021 MSG60 BAL JQ,WRTMSG BRANCH AND LINK 10090021 DS F DISPLACEMENT 10100021 *=E 62 WORD INVALID AS BCD NAME. 10110021 MSG62 BAL JQ,WRTMSG BRANCH AND LINK 10120021 DS 5F DISPLACEMENT 10130021 *=E 68 OPND FOR GENERATE NOT FOUND. CLAUSE DROPPED. 10140021 MSG68 BAL JQ,WRTMSG BRANCH AND LINK 10150021 DS F DISPLACEMENT 10160021 *=E 46 70 FLOAT-POINT LIT MANTISSA EXC 16 DIG. TRUNC TO 16. 10170021 MSG70 BAL JQ,WRNMSG BRANCH AND LINK 10180021 *=E 47 71 FLOAT-POINT LIT EXPONT EXC 2 DIG. TRUNC TO 2. RESCAN AT 10190021 MSG71 BAL JQ,WRNMSG BRANCH AND LINK 10200021 *=E 48 72 FLOAT-POINT LIT EXPONT FOLL BY NONBLANK. RESCAN AT NONB 10210021 MSG72 BAL JQ,WRNMSG BRANCH AND LINK 10220021 *=E 49 73 FLT PNT LIT'E'FOLLOWED BY INVALID,CALC LIT,RESCAN AT 'E 10230021 MSG73 BAL JQ,WRNMSG BRANCH AND LINK 10240021 *=E 4A 74 FLT PNT LIT SIGN FOLLOWED BY INVALID,CALC LIT,RESCAN AT 10250021 MSG74 BAL JQ,WRNMSG BRANCH AND LINK 10260021 *=E 4B 75 FLT PNT LIT EXCEEDS LIM,ASSUME MAX OR MIN ON 'E' SIGN. 10270021 MSG75 BAL JQ,WRNMSG BRANCH AND LINK 10280021 *=E 4C 76 ALPHAMERIC-LIT EXCEEDS 120 CHAR. TRUNCATED TO 120. 10290021 MSG76 BAL JQ,WRNMSG BRANCH AND LINK 10300021 *=E 4D 77 ALPHAMERIC-LIT CONTINUED IN A-MARGIN. ASSUMMED B-MARGIN 10310021 MSG77 BAL JQ,WRNMSG BRANCH AND LINK 10320021 *=E 4E 78 ALPHA-LIT CONTINUED WITH MISSING HYPHEN OR QUOTE. ASSUM 10330021 MSG78 BAL JQ,WRNMSG BRANCH AND LINK 10340021 *=E 4F 79 ALPHAMERIC-LIT HAS ZERO LENGTH. ASSUME 1 BLANK CHAR. 10350021 MSG79 BAL JQ,WRNMSG BRANCH AND LINK 10360021 *=E 50 80 PERIOD PRECEEDED BY BLANK. ASSUMED EOS. 10370021 MSG80 BAL JQ,WRNMSG BRANCH AND LINK 10380021 *=E 51 81 PERIOD NOT FOLLOWED BY BLANK. ASSUMED EOS. 10390021 MSG81 BAL JQ,WRNMSG BRANCH AND LINK 10400021 *=E 52 82 NUM-LIT EXCEEDS 18 DIGITS. TRUNCATED TO 18 DIGITS. 10410021 MSG82 BAL JQ,WRNMSG BRANCH AND LINK 10420021 *=E 53 83 ILLEGAL CHARACTER, SCAN RESUMED AT NEXT VALID CHARACTER 10430021 MSG83 BAL JQ,WRNMSG BRANCH AND LINK 10440021 *=E 54 84 COMMA SHOULD NOT BE PRECEEDED BY BLANK. ASSUMED OK. 10450021 MSG84 BAL JQ,WRNMSG BRANCH AND LINK 10460021 *=E 85 WORD OR PICTURE EXCEEDS 30 CHAR. TRUNCATED TO 30 CHAR. 10470021 MSG85 BAL JQ,WRNMSG BRANCH AND LINK 10480021 *=E 56 86 '-' SHOULD BE IN A-MARGIN. 10490021 MSG86 BAL JQ,PARMN2 BRANCH AND LINK 1491 10500021 *=E 57 87 '-' SHOULD NOT BE IN A-MARGIN. 10510021 MSG87 BAL JQ,PARMN BRANCH AND LINK 10520021 *=E 88 NO INS/DEL NUMBER. PASSING CARDS TO BE INSERTED. 10530021 MSG88 BAL JQ,PARMID BRANCH AND LINK 10540021 *=E 89 INSERT DEL NUMBER OUT OF SEQ. NEXT INS/DEL NUMBER. 10550021 MSG89 BAL JQ,PARMID BRANCH AND LINK 10560021 *=E 90 DELETE THRU NUMBER OUT OF SEQ. NEXT INS/DEL NUMBER. 10570021 MSG90 BAL JQ,PARMID BRANCH AND LINK 10580021 *=E 5B 91 '-' IN A-MARGIN NOT VALID AS PN. ASSUME B-MARGIN. 10590021 MSG91 BAL JQ,PARMC BRANCH AND LINK 10600021 *=E 5C 92 DECLARATIVES NOT FOLLOWING PROCEDURE DIVISION. IGNORED. 10610021 MSG92 BAL JQ,WRTMSG BRANCH AND LINK 10620021 *=E 5D 93 NO DECLARATIVES SECTION. END DECLARATIVES IGNORED. 10630021 MSG93 BAL JQ,WRTMSG BRANCH AND LINK 10640021 DS F DISPLACEMENT 10650021 *=E 5F 95 WORD SECTION OR DIVISION MISSING. ASSUMED PRESENT. 10660021 MSG95 BAL JQ,WRNMSG BRANCH AND LINK 10670021 DS 2F DISPLACEMENT 10680021 *=E 4E 98 ALPHM-LIT NOT CONT WITH HYPHEN + QUOTE.END LIT ON LAST 10690021 MSG98 BAL JQ,WRTMSG BRANCH AND LINK 10700021 *=E 63 99 '-' IS INVALID AS USED. IGNORED. 10710021 MSG99 BAL JQ,PARMN BRANCH AND LINK 10720021 DS 6F DISPLACEMENT 10730021 *=E 106 OPND FOR TERMINATE NOT FOUND OR ILLEG. OPND DROPPED. 10740021 MSG106 BAL JQ,WRTMSG BRANCH AND LINK 10750021 DS F DISPLACEMENT 10760021 *=E 108 '-' IS NOT A POSITIVE INTEGRAL NUMBER. ASSUMING 1. 10770021 MSG108 BAL JQ,PARMN BRANCH AND LINK 10780021 DS 4F DISPLACEMENT 10790021 *=E 113 EXPECT 6 DIG-SEQ-NUM.SKIP TO NEXT INS/DEL NUMBER. 10800021 MSG113 BAL JQ,PARMID BRANCH AND LINK 10810021 *=E 114 EXTRANEOUS COMMA / HYPHEN ON DEL CD. IGNOREING IT. 10820021 MSG114 BAL JQ,PARMID BRANCH AND LINK 10830021 *=E 115 NO BLANK COMMA OR HYPHEN FOLLOW SEQ-NUM. ASSUME BLANK 10840021 MSG115 BAL JQ,PARMID BRANCH AND LINK 10850021 *=E 116 EXPECT 6 DIG-SEQ-NUM AFTER HYPHEN.IGNORE DEL FROM THRU 10860021 MSG116 BAL JQ,PARMID BRANCH AND LINK 10870021 *=E 117 DELETE NUM GREATER THAN LAST SEQ-NUM.STOP INS/DEL. 10880021 MSG117 BAL JQ,PARMID BRANCH AND LINK 10890021 *=E 118 INSERT NUM GREATER THAN THAN LAST SEQ-NUM.STOP INS/DEL 10900021 MSG118 BAL JQ,PARMID BRANCH AND LINK 10910021 *=E 119 '-' FEATURE NOT YET IMPLEMENTED. 10920021 MSG119 BAL JQ,PARMC BRANCH AND LINK 10930021 *=E 120 COMMA NOT FOLLOWED BY BLANK. ASSUME SPACE. 10940021 MSG120 BAL JQ,WRNMSG BRANCH AND LINK 10950021 DS 5F 10960021 *=E 126 '-' FILE-NAME SPECIFIED IN BOTH RERUN AND USING OR GIVING 10970021 *=E OPTION . RERUN IGNORED. 10980021 MSG126 BAL JQ,PARMC BRANCH AND LINK 10990021 DS 4F DISPLACEMENT 11000021 *=E 131 INVALID PRIORITY NO. ZERO ASSUMED. 11010021 MSG131 BAL JQ,WRNMSG BRANCH AND LINK 11020021 DS F DISPLACEMENT 11030021 *=E 133 MORE THAN 1 USE ON STANDARD ERROR SPEC'D FOR SAME FILE 11040021 *=E OPEN OPTION. 11050021 MSG133 BAL JQ,WRTMSG BRANCH AND LINK 11060021 *=E 134 USE SPECIFIED FOR FILE WITHLABEL RECORDS OMITTED OR 11070021 * STANDARD. SENTENCE IGNORED. 11080021 MSG134 BAL JQ,PARMC BRANCH AND LINK 11090021 DS 4F MSGS IN PH1A 11100021 *=E DUPLICATE SECTION NAME 11110021 MSG139 BAL JQ,PARM2 GIVE MESSAGE 11120021 *=E NUMERIC LITERAL EXCEEDS 32K 11130021 MSG140 BAL JQ,PARMC GIVE MESSAGE 11140021 DS F MESSAGE IN PH1A 11150021 *=E 142 USE SPECIFIED FOR FILE AND FOR OPEN 11160021 *=E OPTION. USE FOR OPEN OPTION IGNORED FOR THIS FILE. 11170021 MSG142 BAL JQ,PARMC BRANCH AND LINK 11180021 *=E 143 USE STATEMETS IMPLY BOTH STAND AND NON STAND LABELS. 11190021 *=E USE STATEMENTS IGNORED. 11200021 MSG143 BAL JQ,WRTMSG BRANCH AND LINK 11210021 *=E 144 POSITIONING AND ADVANCING OPTIONS 11220021 *=E ILLEGALLY USED FOR ONE FILE. 11230021 MSG144 BAL JQ,WRTMSG BRANCH AND LINK 11240021 DS F DISP 11250021 *=E 146 READ FOR ILLEGAL AS USED. READ FOR UPDATE ASSUMED. 11260021 MSG146 BAL JQ,WRNMSG BRANCH AND LINK 11270021 DS 3F FILL AREA FOR THREE MSGS 7075 11280021 *=E 150 PARAGRAPH NAME BEGINS IN COLUMN 7 7075 11290021 MSG150 BAL JQ,PARMC GIVE MESSAGE 7075 11300021 DS 2F FILL AREA 7075 11310021 *=E 153 TOTALED AREA ILLEGALLY SPEC'D FOR FILE WITH NON-ST LAB 11320021 MSG153 BAL JQ,PARMC BRANCH AND LINK 11330021 *=E 154 TWO DIFFERENT LABEL PROCEDURES FOR EOF AND EOV FOR 11340021 *=E BEFORE OPTION. EOV LABEL PROCEDURE IGNORED. 11350021 MSG154 BAL JQ,WRTMSG BRANCH AND LINK 11360021 DS 3F DISP 11370021 *=E 158 '-' IN ENTRY STATEMENT IS SAME AS PROG-ID. '-' IGNORED 11380021 MSG158 BAL JQ,PARMC BRANCH AND LINK 11390021 DS F DISP 11400021 *=E 160 CONTINUATION OF WORD FOUND IN A MARGIN. 11410021 MSG160 BAL JQ,WRTMSG WRITE MESSAGE 11420021 EJECT 11430021 * 11440021 * PARAM LOADING ROUTINS 11450021 * 11460021 PARMC MVC EPARAM(LX122),CURCOD 11470021 CLI CURCOD,XX32 NUM-LIT 11480021 BC NOTEQ,WRTMSG NO-WRTMSG 11490021 MVI EPARAM,XX23 SET UP 11500021 MVC EPARAM(LX32),SECTNM-NX1 11510021 BC UNCOND,WRTMSG WRITE MESSAGE 11520021 * 11530021 PARMN TM CPYXSW,XX01 CPYXSW SET? 11540021 BO PARMN1 YES - PARMN1 11550021 CLC VERBNM(LX5),CALWD CALL VERB? 11560021 BC EQ,PARMN1 YES - PARMN1 11570021 CLC VERBNM(LX6),ENTWD ENTRY VERB? 11580021 BC EQ,PARMN1 YES - PARMN1 11590021 PARMN2 MVC EPARAM(LX122),NXTCOD SET UP MSG PARAMETER 1491 11600021 CLI NXTCOD,XX32 NUM-LIT 11610021 BC NOTEQ,WRNMSG NO-WRNMSG 11620021 MVI EPARAM,XX23 SET UP 11630021 MVC EPARAM+NX1(LX20),NXTCNT IN BCD 11640021 BC UNCOND,WRNMSG WRITE MESSAGE 11650021 PARMN1 MVC EPARAM(LX122),CURCOD SET UP MSG PARAMETER 11660021 CLI CURCOD,XX32 NUM-LIT 11670021 BC NOTEQ,WRTMSG NO - WRTMSG 11680021 MVI EPARAM,XX23 SET UP 11690021 MVC EPARAM+NX1(LX20),CURCNT IN BCD 11700021 BC UNCOND,WRTMSG WRITE MESSAGE 11710021 * 11720021 PARM1C MVC SECPAR(LX32),CLSNM-NX1 11730021 BC UNCOND,PARMC GET PARMS 11740021 * 11750021 PARM2 MVI EPARAM,XX23 ERROR PROCESS LATER PHASE 11760021 MVC EPARAM+NX1(LX31),CURCNT DUPLICATE SECTION NAME 11770021 BC UNCOND,WRTMSG WRITE MESSAGE 11780021 * 11790021 PARM3 MVC EPARAM(LX32),PARNM-NX1 11800021 BC UNCOND,WRTMSG WRITE MESSAGE 11810021 * 11820021 PARM4 MVC EPARAM(LX32),CLSNM-NX1 11830021 BC UNCOND,WRTMSG WRITE MESSAGE 11840021 * 11850021 PARMID MVC EPARAM(LX2),CARDCN SET UP CARD IMAGE 11860021 MVC EPARAM+NX2(LX80),SIDEWK FROM SIDEWK 11870021 BC UNCOND,WRDMSG -WRDMSG 11880021 * 11890021 SEVLST DC X'00' TRANSLATE TABLE (MESSAGES) 11900021 * 11910021 * 1 2 3 4 5 6 7 8 910111213141516 11920021 DC X'11010121212101012101112121012121' MSGS 1 - 16 11930021 * 11940021 * 17181920212223242526272829303132 11950021 DC X'21212121210121211101012121211121' MSGS 17 - 32 11960021 * 11970021 * 33343536373839404142434445464748 11980021 DC X'01212111212101212121010121212121' MSGS 33 - 48 11990021 * 12000021 * 49505152535455565758596061626364 12010021 DC X'21212121212121212121212121212121' MSGS 49 - 64 12020021 * 12030021 * 65666768697071727374757677787980 12040021 DC X'21212121211111111111111111011101' MSGS 65 - 80 12050021 * 12060021 * 81828384858687888990919293949596 12070021 DC X'01111101110101212121012121210121' MSGS 81 -96 12080021 * 12090021 * 979899 0 1 2 3 4 5 6 7 8 9101112 12100021 DC X'21212111210121210121112121010121' MSGS 97 - 112 12110021 * 12120021 * 13141516171819202122232425262728 12130021 DC X'21112121212121010101012121210101' MSGS 113 - 128 12140021 * 12150021 * 29303132333435363738394041424344 12160021 DC X'11210121010101210101212101010101' MSGS 129 - 144 47935 12170021 * 12180021 * 45464748495051525354555657585960 12190021 DC X'01010101010101010101010101010101' 12200021 * 12210021 * 61626364656667686970717273747576 12220021 DC X'01212121212101010121210101212101' MSGS 161 - 176 12230021 * 12240021 * 77787980818283848586878889909192 12250021 DC X'01212101010101010101010101010101' MSGS 177 - 192 12260021 EJECT 12270021 * 12280021 * GCN LOADING FOR NEXT-WORD 12290021 * 12300021 WRNMSG MVC MSGGCN(LX2),NXTGCN GCN TO MSG-TEXT 12310021 BC UNCOND,WRTRSV -WRTRSV 12320021 * GCN LOADING FOR INSERT / DELETE 12330021 WRDMSG MVC MSGGCN(LX2),HWZERO ZERO GCN FOR INS/DEL 12340021 BC UNCOND,WRTRSV -WRTRSV 12350021 * GCN LOADING FOR CUR-WORD 12360021 WRTMSG MVC MSGGCN(LX2),CURGCN GCN TO MSG-TEXT 12370021 * CALC MSG NUMBER AND LOAD MSGNUM 12380021 WRTRSV STM JA,JC,SV3F12 SAVE REG 12390021 TM NOTESW,XX02 NOTESW 'ON' 12400021 BC ONES,WRTXTA YES-WRTXTA 12410021 LA JA,MSG1 ADDR OF START OF MSGS 12420021 LA JQ,DX0(JQ) CLEAR HI ORDER BYTE 12430021 SR JQ,JA GET DISPLACEMENT 12440021 SRL JQ,DX2(JR) DIVIDE BY 4 12450021 STC JQ,MSGNUM+NX1 STORE MSG-NUM IN MSG-TEXT 12460021 LA JA,SEVLST ADDR OF SEVLST 12470021 IC JC,DX0(JQ,JA) GET SEVERITY CODE 12480021 STC JC,MSGSP STORE SEVERITY IN MSG-TEXT 12490021 * WRITE OF ERROR MSG 12500021 L JC,COSADR WRITE OUT 12510021 LA JB,MSGDEF MSG ON 12520021 BALR JR,JC FILE 12530021 WRERR1 DC X'22' FILE XX 12540021 * SET UP OF PARAM LENGTH 12550021 WRTSEC CLI EPARAM,XX00 PARAM PRESENT 12560021 BC EQ,WRTEXT NO-WRTEXT 12570021 CLI EPARAM,XXB9 CODE FOR INVALID WORD 12580021 BC NOTEQ,WRTADR NO-WRTADR 12590021 MVC EPARAM(LX2),EPARAM+NX1 MOVE CODE OVER ONE 12600021 WRTADR LA JB,EPARAM ADDR OF EPARAM 12610021 XR JA,JA CLEAR REG 12620021 CLI EPARAM,XXA2 QUALIFIED NAME ? 12630021 BNE *+8 NO - SKIP 12640021 MVI EPARAM,XX22 PH 7 WILL RECOGNIZE AS '22' 12650021 IC JA,DX0(JB) GET IC-TEXT CODE 12660021 SRL JA,DX6(JR) SHIFT RIGHT 6 12670021 LTR JA,JA TEST IF ZERO 12680021 BC NOTZER,WRTADJ NO-WRTADJ 12690021 IC JA,DX1(JB) GET IC-TEXT 'N' 12700021 LA JA,DX1(JA) ADJ LENGTH FOR 'N' 12710021 WRTADJ LA JA,DX1(JA) ADJ LENGTH FOR CODE 12720021 STC JA,EPARNN+NX1 STORE IN PARAM 'N' FIELD 12730021 * WRITE OF PARAM 12740021 LA JB,EPARNN WRITE OUT 12750021 BALR JR,JC PARAM ON 12760021 WRERR2 DC X'22' FILE XX 12770021 * LOAD OF SECOND PARAM TO FIRST 12780021 MVC EPARAM(LX32),SECPAR MOVE SECOND PARAM TO FIRST 12790021 MVI SECPAR,XX00 ZERO SECPAR 12800021 BC UNCOND,WRTSEC -WRTSEC 12810021 * EXIT FROM ERROR MSG ROUTINE 12820021 WRTEXT LM JA,JC,SV3F12 RESTORE REGS 12830021 WRTXTA L JQ,LNKR15 RESTORE BASE REG15 12840021 BCR UNCOND,JP -RETURN 12850021 * 12860021 SAVJQ1 DS F SAVE JQ ( R15 ) 12870021 ADUMGN DC AL4(DUMGN) ADDR OF DUMGN 12880021 EJECT 12890021 IKF102 CSECT 12900021 * 12910021 *=2 COMMON CONSTANT AREA ID ENV DATA PR 12920021 * 12930021 IDDIV1 EQU * 12940021 DS CL15 OF CURRENT DATE 12950021 PRODV1 DC A(EXHSVB) ADDR OF EXHIBIT VERB SCAN 12960021 HSKP2 DC A(GETWD) ADDR OF GETWD 12970021 HSKP3 DC A(GETDLM) ADDR OF GETDLM 12980021 GTD1 DC A(LETTER) ADDR OF LETTER SCAN 12990021 ACBW DC A(COBWRD) ADDR OF COBOL WORD TABLE 13000021 PRODIV DC A(PDSCN) ADDR OF PRO DIV 13010021 GETADR DC A(UNLVSN) ADDR OF UNIT LEVEL SCAN 13020021 ADCON1 DC AL4(VARPQ) PHASE 1B 13030021 * 13040021 SV1F13 DS 15F SAVE FOR CALLING COPY 13050021 GTWDSV DS 15F SAVE AREA FOR GETWD REGS 13060021 GTCDSV DS 15F SAVE FOR GTCD REGS 13070021 SAVECD DS CL80 SAVE AREA FOR CARD RESTORE 13080021 * 13090021 HWZERO DC H'0' HALFWORD OF ZEROS 13100021 HWONE DC H'1' HALFWORD OF +1 13110021 H1 EQU HWONE 13120021 HWTWO DC H'2' HALFWORD OF 2 13130021 H2 EQU HWTWO 13140021 HWTHRE DC H'3' HALFWORD OF +3 13150021 HWFOUR DC H'4' HALFWORD OF '4' 13160021 H5 DC H'5' 13170021 HW65 DC H'65' HALF WORD OF 66 13180021 HW8 DC H'8' HALFWORD OF EIGHT 13190021 CON32K DC H'32767' MAX SIZE FOR HALFWORD 9015 13200021 CINCON DC C' IN ' CONSTANT OF 'IN' 13210021 SVCURR DS CL181 SAVE AREA FOR CURENT CELLS 13220021 FDSAVE DS CL31 SAVE FD 13230021 F1 DC F'1' FULLWORD CONSTANT OF 00000001 13240021 ALLFF DC F'-1' FULLWORD CONSTANT OF -1 13250021 K2 DC F'2' FULLWORD CONSTANT OF 00000002 13260021 K7 DC F'7' FULLWORD CONSTANT OF 00000007 13270021 K16 DC F'16' FULLWORD CONSTANT OF 16 13280021 K17 DC F'17' FULLWORD CONSTANT OF 17 13290021 K18 DC F'18' FULLWORD CONSTANT OF 18 13300021 K30 DC F'30' FULLWORD CONSTANT OF 30 13310021 FWCONS DC F'48' FULLWORD OF 00000030 13320021 K120 DC F'120' FULWORD OF 120 13330021 NU255 DC F'255' FULLWORD WITH 255 13340021 TWOP24 DC F'16777216' TWO TO THE 24TH POWER 13350021 TNPW9 DC F'1000000000' TEN TO THE 9TH POWER 13360021 FLTONE DC D'1' DOUBLEWORD CONSTANT OF 1 13370021 EOPPHX DC X'00' ZERO CONSTANT 13380021 SNGLQ2 DC X'7D' QUOTE 13390021 TOTCOT DC H'2' CONSTANT OF 2 13400021 TOTCT EQU TOTCOT+1 13410021 TOTPTR DS 1H DISPLACEMENT 13420021 * 13430021 * TABLES 13440021 * 13450021 PLSTBL DC E'7.2E11' TABLES 13460021 DC E'7.2E43' USE 13470021 DC E'7.2E59' TO 13480021 DC E'7.2E67' CONVERT 13490021 DC E'7.2E71' EIGHTEEN 13500021 DC E'7.2E73' BYTES 13510021 DC E'7.2E74' EXTERNAL 13520021 * 13530021 NEGTBL DC E'5.4E-15' DECIMAL 13540021 DC E'5.4E-47' NUMBERS 13550021 DC E'5.4E-63' INTO 13560021 DC E'5.4E-71' DOUBLE 13570021 DC E'5.4E-75' PRECISION 13580021 DC E'5.4E-77' NUMBERS 13590021 DC E'5.4E-78' ******* 13600021 * 13610021 PWRTBL DC D'1E64' POWER 13620021 DC D'1E32' TABLE 13630021 DC D'1E16' USE 13640021 DC D'1E8' IN 13650021 DC D'1E4' CONVERTING 13660021 DC D'1E2' TO 13670021 DC D'1E1' DOUBLE PRECISION 13680021 * 13690021 TBLEND DC A(PWRTBL+56) 13700021 * 13710021 **************** 13720021 * 13730021 * TRT TABLE - SCANNING TO NON-DIGIT 13740021 * 13750021 NONLDH EQU * SCAN TO NON LETTER DIGIT HY 13760021 UDIGT DC 5X'040404040404040404040404040404' 13770021 DC X'03' PERIOD 13780021 DC 2X'04040404040404040404' 13790021 TBHYPN DC X'02' MINUS SIGN 13800021 DC 6X'04040404040404040404040404040404' 13810021 MSKLT1 DC X'010101010101010101' LETTERS 13820021 DC X'04040404040404' 13830021 MSKLT2 DC X'010101010101010101' LETTERS 13840021 DC X'0404040404040404' 13850021 MSKLT3 DC X'0101010101010101' LETTERS 13860021 DC X'040404040404' 13870021 DC X'00000000000000000000' 13880021 DC X'040404040404' 13890021 **************** 13900021 * 13910021 *** TRT TABLE SCANNING TO NON-BLAND ********** 13920021 * 13930021 * 13940021 UNONB DC 4X'07070707070707070707070707070707' ILLEGAL CHARACTER 13950021 DC X'00' BLANK 13960021 DC X'07070707070707070707' 13970021 DC X'04' PERIOD 13980021 DC X'06' LESS THAN SIGN 13990021 DC X'06' LEFT PAREN 14000021 DC X'05' PLUS SIGN 14010021 DC X'070707070707070707070707' 14020021 DC X'07' DOLLAR SIGN-ILLEGAL 14030021 DC X'06' ASTERISK 14040021 DC X'06' RIGHT PAREN 14050021 DC X'08' SEMI-COLON 14060021 DC X'07' 14070021 DC X'05' MINUS SIGN 14080021 DC X'06' SLASH 14090021 DC X'070707070707070707' 14100021 DC X'08' COMMA 14110021 DC X'0707' 14120021 DC X'06' GREATER THAN SIGN 14130021 DC X'0707070707070707070707070707' 14140021 TBQUT1 DC X'03' QUOTE 14150021 DC X'06' EQUAL SIGN 14160021 TBQUT2 DC X'07' DOUBLE QUOTE 14170021 DC 13X'0707070707' 14180021 LETMSK DC X'010101010101010101' LETTERS 14190021 DC X'07070707070707' 14200021 DC X'010101010101010101' LETTERS 14210021 DC X'0707070707070707' 14220021 DC X'0101010101010101' LETTERS 14230021 DC X'070707070707' 14240021 DC X'02020202020202020202' DIGITS 14250021 DC X'070707070707' 14260021 * 14270021 DS 0D 14280021 MAXFLT DC X'7FFFFFFFFFFFFFFF' 14290021 KHYPHN EQU X'60' HYPHEN 14300021 KQUOTE DC X'407D' BLANK-QUOTE FOR COL 73+74 14310021 INKON DC C'IN ' CONSTANT OF 'IN' 14320021 OFKON DC C'OF ' CONSTANT OF 'OF' 14330021 KDECML DC X'4B6B' CONSTANT FOR PERIOD-COMA 14340021 EOPCON DC X'42FF1E' CONSTANT FOR EOP 14350021 REPCON DC X'54D604' CONSTANT FOR REPORT NOT AS 14360021 PROCON DC X'549902' CONSTANT FOR'PROCEDURE'IN P 14370021 ERRCOD DC X'B90000' ERROR CODE CELL (PROC DIV) 14380021 EOSCON DC X'4406' CONSTANT FOR 'PERIOD' 14390021 ENDLCD DC X'420842' CONSTANT FOR 'END-DECLAR' 14400021 INLONE DC X'0301001C' INT-NUM-LIT OF ONE FOR 14410021 DEBSCT DC X'4209' CONSTANT FOR DEBUG SECTION 14420021 BUGCON DC X'00000000000005' 1-USED FOR DEBUG FOLLOWED BY 14430021 DEBKON DC CL6'DEBUG ' 2-CONSTANT OF 'DEBUG AND 0335 14440021 DC CL1' ' MUST FOLLOW DEBKON 8922 14450021 DEBCON DC X'443B02' 3-CONSTANT FOR '*DEBUG' 14460021 CARDCN DC X'2348' CONST FOR WRITE OF INS/DEL CD 14470021 INTNL4 DC X'32050400' CONSTANT FOR 'INTEG NUM LIT 14480021 INSKON DC C'INSERT ' CONSTANT OF 'INSERT' 41557 14490021 DELKON DC C'DELETE ' CONSTANT OF 'DELETE' 41557 14500021 DUMCON DC X'05035C0000' CONSTANT OF 0503*0000' 14510021 DICTRTN DC X'00' RET CODE FROM LOC ATTRIB 7453 14520021 CPARAG DC AL1(10) CONSTANT OF '10PARAGRAPH' 14530021 DC C'PARAGRAPH' PARAGRAPH 14540021 CSENTE DC AL1(8) CONSTANT OF '8SENTENCE' 14550021 DC C'SENTENCE' SENTENCE 14560021 CCLAUS DC AL1(6) CONSTANT OF '6CLAUSE' 14570021 DC C'CLAUSE' CLAUSE 14580021 PRO9 DC AL1(9) CONSTANT OF '9PROCEDURE' 14590021 DC C'PROCEDURE' PROCEDURE 14600021 * 14610021 * CURRENT WORD INFORMATION 14620021 DS 0F 14630021 CURNUM DC C'000000' SEQUENCE NUMBER 14640021 CURCNT DS CL1 COUNT FIELD 14650021 CURWD DS CL30 WORD 14660021 CURSW DS CL1 CURSW 14670021 CURGCN DC H'0' GENERATED CARD NUMBER 14680021 CURCOD DS CL1 CURRENT CODE 14690021 CURN DS CL1 IDENTIFY BYTE 14700021 CURDCD DS 0CL1 CURDCD EQU CURBCD FIRST BYTE 14710021 CURBCD DS CL120 CURRENT BCD 14720021 CURXNL DS CL19 EXTERNAL-NUM-LIT IN BCD W/SI 14730021 * NEXT WORD INFORMATION 14740021 DS 0H 14750021 NXTNUM DC C'000000' NEXT SEQUENCE NUMBER 14760021 NXTCNT DS CL1 NEXT COUNT 14770021 NXTWD DS CL30 NEXT WORD 14780021 NXTSW DC X'00' 80-BCD,08-INL,04-NONBLK,02-LHNP,01-A-M 14790021 NXTGCN DC H'0' GENERATED CARD NUMBER 14800021 NXTCOD DC CL1'0' NEXT CODE 14810021 NXTN DS CL1 NXTN 14820021 NXTBCD DS CL120 BCD 14830021 * 14840021 * THESE EQUATES ARE USED FOR IMPLEMENTOR NAME SCAN IN THE 14850021 * SELECT SENTENCE SCAN 14860021 * 14870021 CURLIT EQU CURXNL+1 14880021 NNN EQU CURBCD+3 14890021 BCDP EQU CURBCD+7 14900021 * 14910021 EJECT 14920021 * 14930021 *=2 TAMER ADCONS AND CONSTANTS ID ENV DATA PR 14940021 * 14950021 COSADR DC A(0) ADDR OF COS 14960021 ACCADR DC A(DPARST) ADDR OF COS FOR ACCESS 14970021 * 14980021 ADPRIM DC A(PRIME) PRIME 14990021 ADSERT DC A(INSERT) INSERT 15000021 ADSTAC DC A(STATIC) TAMER SUBROUTINE 15010021 ADTREL DC A(TABREL) TABREL 15020021 ADTAMN DC A(TAMEIN) TAMEIN 15030021 ADINAC DC A(INTACC) INTACC 15040021 ENNMCN DC A(ENTNAM) ENTNAM 15050021 ENDLCN DC A(ENTDEL) ENTDEL 15060021 LATGCN DC A(LATGRP) LATGRP 15070021 LATRCN DC A(LATRNM) LATRNM 15080021 LDELCN DC A(LDELNM) LDELNM 15090021 LATPCN DC A(LATRPT) LATRPT 15100021 * 15110021 DS 0F 15120021 P1BTBL EQU TIB2-COS 15130021 P1BCON EQU * 15140021 PARP1B DC X'00' PASSES INFO 15150021 DC AL3(P1BTBL) FROM PH1A TO PH1B 15160021 QLTABL EQU TIB1-COS 15170021 QLTCON EQU * 15180021 PARQLT DC X'00' PARAM FOR QLTABL 15190021 DC AL3(QLTABL) STORE QUALIFIED NAMES (TBLE) 15200021 DC X'00640020' 100 BYTES 15210021 *APPTBL EQU TIB4-COS 15220021 *APPCON EQU * 15230021 *PARAPP DC X'00' PARAM FOR APPTBL 15240021 * DC AL3(APPTBL) APPTBL 15250021 PNTABL EQU TIB5-COS 15260021 PNTCON EQU * 15270021 PARPNM DC X'00' PARAM FOR PNTBL 15280021 DC AL3(PNTABL) PROCEDURE NAME TABLE 15290021 DC X'0E100024' 3600 BYTES 100 ENTRIES 15300021 PNQTBL EQU TIB6-COS 15310021 PNQCON EQU * 15320021 PARPQN DC X'00' PARAM FOR PNQTBL 15330021 DC AL3(PNQTBL) QUALIFIED PROCEDURE NAME TABLE 15340021 DC X'0D480044' 3400 BYTES 50 ENTRIES 15350021 PIOTBL EQU TIB7-COS 15360021 PIOCON EQU * 15370021 PARPIO DC X'00' STORE I/O INFO 15380021 DC AL3(PIOTBL) FROM PROCEDURE DI 15390021 CKPTBL EQU TIB8-COS 15400021 CKPCON EQU * 15410021 PARCKP DC X'0C' PARAM FOR CKPTBL 15420021 DC AL3(CKPTBL) CHECKPOINT TABLE 15430021 OD2TBL EQU TIB9-COS 15440021 OD2CON EQU * 15450021 PAROD2 DC X'00' STORE OBJECT OF 15460021 DC AL3(OD2TBL) OCCURS-DEPENDING 15470021 FNTBL EQU TIB10-COS 15480021 FNTCON EQU * 15490021 PARFNT DC X'00' 15500021 DC AL3(FNTBL) ENVIRON. DIV INFOR FOR 15510021 RCDTBL EQU TIB11-COS PROCEDURE DIV (FI 15520021 RCDCON EQU * 15530021 PARRCD DC X'00' STORE 01 LEVEL REC NAME 15540021 DC AL3(RCDTBL) IN FD 15550021 SPNTBL EQU TIB21-COS 15560021 SPNCON EQU * 15570021 PARSPN DC X'00' 15580021 DC AL3(SPNTBL) SPECIAL-NAME INFO 15590021 * 15600021 USETBL EQU TIB26-COS 43521 15610021 USDCON EQU * 43521 15620021 USDECL DC X'03' USE DECLARATIVE INFORMATION 43521 15630021 DC AL3(USETBL) FOR PHASE51 43521 15640021 DC X'00200020' X 43521 15650021 * 43521 15660021 TOTTBL EQU TIB32-COS 15670021 TOTCON EQU * 15680021 PARTOT DC X'00' TOTALED OPTIONS INFO 15690021 DC AL3(TOTTBL) FOR PH1B AND PH20 15700021 CALWD DC AL1(4) CONSTANT OF '4CALL' 15710021 DC C'CALL' CONSTANT OF 'CALL' 15720021 ENTWD DC AL1(5) CONSTANT OF '5ENTRY' 15730021 DC C'ENTRY' CONSTANT OF 'ENTRY' 15740021 EJECT 15750021 * 15760021 *=1 REPORT WRITER TAMER ADCONS AND CONSTANTS 15770021 * 15780021 DS 0F ALIGNMENT 15790021 RNMTBL EQU TIB12-COS 15800021 RNMCON EQU * 15810021 RNMTB DC X'00' STORE DATA NAME OF REPORT GROUP 15820021 DC AL3(RNMTBL) RNMTBL 15830021 RWRTBL EQU TIB13-COS 15840021 RWRCON EQU * 15850021 RWRTB DC X'00' STORE INFO ON REPORT NAME 15860021 DC AL3(RWRTBL) RWRTBL 15870021 ROUTBL EQU TIB16-COS 15880021 ROUCON EQU * 15890021 ROUTB DC X'00' ROUTBL 15900021 DC AL3(ROUTBL) FOR OVFLO,PAGE,ETC. ROUTINE 15910021 DETTBL EQU TIB17-COS 15920021 DETCON EQU * 15930021 DETTB DC X'00' DETTBL 15940021 DC AL3(DETTBL) FOR DETAIL ROUTINES 15950021 EJECT 15960021 *=2 REPORT WRITER CONSTANTS 15970021 * AND WORK AREAS 15980021 *CURRENT RD 15990021 CURRD DC 2XL16'0' REPORT WRITER 16000021 CURRDN EQU CURRD+2 REPORT WRITER 16010021 RDADR DC F'0' ADR OF CUR RD ENTRY 16020021 DETADR DC F'0' REPORT WRITER 16030021 DRWDSP DS 0H RD-NAME DISP IN RWTBL FOR D 16040021 DC X'0000' REPORT WRITER 16050021 RRWDSP DS 0H REPORT WRITER 16060021 DC X'0000' REPORT WRITER 16070021 * 16080021 *TABLE ENTRY MUST STAY TOGETHER 16090021 RWDN DC 2XL16'0' DATA-NM FOLL LVL *30 FOR 01 16100021 RWDN1 EQU RWDN+2 30 CHARS FOR DETAIL-NM TBL 16110021 RWDNPR DC X'0000' PAR NAME 16120021 ORGFLG DC X'00' 00 = NO SVE 16130021 *SPECIAL REPORT WRITER VERBS 16140021 *RCALL DC X'444F' 16150021 RORG DC X'445C' OVERLAY 16160021 RRORG DC X'445D' OLAY RESET 16170021 RNOP DC X'4433' NOP 16180021 *GENERATED NAMES FOR STANDARD ROUTINES 16190021 **** GNRH THRU GNRET MUST REMAIN IN THIS ORDER 16200021 * 16210021 GNRH DC X'0000' REPORT WRITER 16220021 GNRF DC X'0000' REPORT WRITER 16230021 GNPH DC X'0000' REPORT WRITER 16240021 GNPF DC X'0000' REPORT WRITER 16250021 GNFRST DC X'0000' REPORT WRITER 16260021 GNLAST DC X'0000' REPORT WRITER 16270021 GNWR DC X'0000' REPORT WRITER 16280021 GNWRT1 DC X'0000' GN FOR SKIP TO NEW PAGE 16290021 GNWRT2 DC X'0000' GN FOR LAST PART OF WRT-ROUT 16300021 GNCTLB DC X'0000' REPORT WRITER 16310021 GNROL DC X'0000' REPORT WRITER 16320021 GNRST DC X'0000' REPORT WRITER 16330021 GNRST1 DC X'0000' REPORT WRITER 16340021 GNCSUM DC X'0000' REPORT WRITER 16350021 GNUSUM DC X'0000' REPORT WRITER 16360021 GNCHF DC X'0000' REPORT WRITER 16370021 GNCFF DC X'0000' REPORT WRITER 16380021 GNPH1 DC X'0000' PH ENTRY FROM RH 16390021 GNROL1 DC X'0000' ENTRY FOR LAST CTL BRK 16400021 GNINT DC X'0000' GN FOR INT-ROUT 16410021 GNALS DC X'0000' GN FOR ALS-ROUT 16420021 GNRLS DC X'0000' GN FOR RLS-ROUT 16430021 GNSAV DC X'0000' GN FOR SAV-ROUT 16440021 GNRET DC X'0000' GN FOR RET-ROUT 16450021 * 16460021 DS 0H 16470021 DC X'00' REPORT WRITER 16480021 GPTID DC X'88' USED TO GEN G.NNNN AT DEF 16490021 GPTID1 DC X'0000' 16500021 * REPORT CALL AREA 16510021 PUTCT3 DC X'05' REPORT WRITER 16520021 RCALL DC X'444F' REPORT WRITER 16530021 DC X'AA' REPORT WRITER 16540021 RCGN DC X'0000' REPORT WRITER 16550021 * REPORT GO AREA REPORT WRITER 16560021 PUTCT4 DC X'07' REPORT WRITER 16570021 GOGEN DC X'4411' REPORT WRITER 16580021 DC X'549B' REPORT WRITER 16590021 GOGNA DC X'AA' REPORT WRITER 16600021 GOGN DC X'0000' REPORT WRITER 16610021 * 16620021 SIDMOV DC X'C940' CARD IDENT FOR 16630021 SIDEWK DS CL80 INSER0 CARD WORKAREA 16640021 NMCRD4 DC 3H'0' NUMBER OF NEW MAIKN CARD 16650021 PSA DS F STORE FOR R15 (COPY) 16660021 PSAVE DS F SAVE AREA 16670021 ADUNLV EQU GETADR 16680021 PTYSV DC X'00' PRIORITY DIFFER 16690021 PTYSEG DC X'00' BIT 7 ON IF 2 PTY'S DIFFER 16700021 DECSEG EQU PTYSEG BIT 6 ON IF IN DECL 16710021 NXASUM DC H'0' SIZE OF LAST SUMTBL ENTRY 16720021 ***** THESE SAVEAREAS ARE FOR CALLING SUBRTNS 16730021 SVCAL1 DS 1F VARPQ 16740021 * 16750021 *** THESE RTNS ARE CALLING SEQUENCES FOR RTNS THAT WILL USE R15( 16760021 **** AS THE BASE REGISTER. 16770021 ************************** 16780021 VARPN ST JQ,SVCAL1 CALL VARPQ 16790021 L JQ,ADCON1 PHASE 1B 16800021 ST JQ,LNKR15 STORE AREA 16810021 BCR UNCOND,JQ BRANCH TO R15 16820021 ******************** 16830021 ************** 16840021 CQLFNM ST JQ,SVCALP SAVE R15 16850021 L JQ,ADPROM ADDR OF PN & QN SCAN 16860021 ST JQ,LNKR15 SAVE IN KINK REG AREA 16870021 USING PDSCN,JQ 16880021 B CQLFAQ QUAL NM SCAN FOR COPYR 16890021 DROP JQ 16900021 EJECT 16910021 IKF103 CSECT 16920021 * 16930021 ********** 16940021 * 16950021 * PATCH AREA 16960021 * 16970021 PATCH3 DC 40F'0' PATCH AREA FOR 1B 16980021 * 16990021 * 17000021 ********** 17010021 *=1 COMMON ROUTINES 17020021 * 17030021 * CALLING ROUTINE FOR GET-WORD 17040021 * 17050021 GETWD STM JA,JQ,SVREG SAVE CALLING ROUTINES REGS 17060021 LM JA,JQ,SAVREG SETUP GETWD REGS 17070021 ST JQ,LNKR15 SET-UP LINK REG15 AREA 17080021 L JQ,GETADR 17090021 USING UNLVSN,JQ 17100021 BC UNCOND,GTWORD -GTWORD 17110021 DROP JQ 17120021 WRDEXT STM JA,JQ,SAVREG SAVE GETWD REGS 17130021 LM JA,JQ,SVREG RESTORE CALLING ROUTINES RE 17140021 ST JQ,LNKR15 SET-UP LINK REG15 AREA 17150021 BCR UNCOND,JP -RETURN 17160021 * 17170021 * CALLING ROUTINE FOR GET-CARD (EXTERNAL FROM GET-WORD) 17180021 * 17190021 GETCRD STM JA,JQ,SVREG 17200021 LM JA,JQ,SAVREG 17210021 ST JQ,LNKR15 SET-UP LINK REG15 AREA 17220021 L JQ,GETADR 17230021 USING UNLVSN,JQ 17240021 BAL JP,GTCARD -GTCARD 17250021 DROP JQ 17260021 BC UNCOND,WRDEXT -WRDEXT 17270021 * 17280021 * 17290021 ***** CHECK DIVISION NAME ***** 17300021 * 17310021 CHKDIV ST JP,SV1F11 SAVE LINK REG 17320021 MVC DIVNM(LX31),CURCNT SAVE DIVISION NAME 17330021 BC UNCOND,CHKGET -CHKGET 17340021 * 17350021 ***** EXIT FROM COMMON ROUTINES ***** 17360021 * 17370021 CHKGOT BAL JP,GETWD -GETWD 17380021 CHKEXT L JP,SV1F11 RESTORE LINK REG 17390021 BCR UNCOND,JP -RETURN 17400021 * 17410021 * 17420021 ***** CHECK SECTION NAME IN PROCEDURE DIVISION ***** 17430021 * 17440021 CHKSKT ST JP,SV1F11 SAVE LINK REG 17450021 MVC SECTNM(LX31),CURCNT SAVE SECTION NAME 17460021 BAL JP,GETWD -GETWD 'SECTION' 17470021 MVI LCPTY,XX00 INIT PRIORITY 17480021 CLC NXTCOD(LX2),EOSCON IS THERE A PTY ON SN 17490021 BC EQ,CHKGET NO 17500021 BAL JP,GETWD YES 17510021 CLI CURCOD,XX32 IS IT A NUMLIT 17520021 BC NOTEQ,PTYERR NO 17530021 CLI CURN+NX2,XX00 DIGITS BELOW DECIMAL 5107 17540021 BNE PTYERR YES GIVE MESSAGE 5107 17550021 CLI CURN+NX1,XX02 IS PTY LESS THAN 100 17560021 BC HI,PTYERR NO 17570021 BAL JP,CNVBIN YES, 17580021 STC JB,LCPTY STORE BINARY VALUE 17590021 CLI LCPTY,XX00 17600021 BC NOTEQ,CHKDEC IN DECLARATIVES 17610021 CHKPTY L JA,COSADR 17620021 CLC LCPTY(LX1),SEGLMT IS PTY GRTER THAN SEGLMT 17630021 BNL PTYHI YES 17640021 CHKZER MVI LCPTY,XX00 NO MAKE PTY 0 17650021 BC UNCOND,CHKGET ANY MORE 17660021 PTYHI CLC LCPTY(LX1),PTYSV DO ANY 2 PTYS DIFFER 17670021 BC EQ,CHKGET NO 17680021 MVC PTYSV(LX1),LCPTY YES SAVE NEW PTY 17690021 OI PTYSEG,XX01 TURN SEGMENTATION BIT ON 17700021 BC UNCOND,CHKGET ANY MORE 17710021 CHKDEC TM DECSEG,XX02 17720021 BC ONES,PTYERR IN DECL FLAG ERROR 17730021 BC UNCOND,CHKPTY CHECK PRIORITY 17740021 PTYERR BAL JP,MSG131 MSG131-INVALID PTY 0 ASSUM 17750021 B CHKZER MAKE PTY ZERO 17760021 * 17770021 ***** CHECK PARAGRAPH NAME ***** 17780021 * 17790021 CHKPAR ST JP,SV1F11 SAVE LINK REG 17800021 MVC PARNM(LX31),CURCNT SAVE PARAGRAPH NAME 17810021 MVC ETYPE(LX10),CPARAG INDICATE PARAGRAPH IN EFFEC 17820021 BC UNCOND,CHKGET ANY MORE 17830021 * 17840021 * 17850021 ***** GET NEXT WORD + CHECK EOS ***** 17860021 * 17870021 CHKEOS ST JP,SV1F11 SAVE LINK REG 17880021 CHKGET BAL JP,GETWD -GETWD 17890021 BC UNCOND,CHKEO2 -CHKEO2 17900021 EOSTST ST JP,SV1F11 SAVE LINK REG 17910021 CHKEO2 CLC CURCOD(LX2),EOSCON EOS 17920021 BC NOTEQ,CHKEO1 NO-CHKEO1 17930021 BC UNCOND,CHKGOT -CHKGOT 17940021 CHKEO1 BAL JP,MSG43 -MSG43 17950021 BC UNCOND,CHKEXT -CHKEXT 17960021 * 17970021 ***** CHECK VERB NAME ***** 17980021 * 17990021 CHKVRB MVC VERBNM(LX31),CURCNT SAVE VERB NAME 18000021 MVC ETYPE(LX10),CSENTE INDICATE VERB IN EFFECT 18010021 BCR UNCOND,JP -RETURN 18020021 * 18030021 * 18040021 ****** CHECK FOR ****** 18050021 * 18060021 CHKFOR ST JP,SV1F11 SAVE LINK REG 18070021 CLC NXTCOD(LX2),FORCON 18080021 BC NOTEQ,CHKEXT ALL THROUGH 18090021 BC UNCOND,CHKGOT GET NEXT THEN EXIT 18100021 * 18110021 * 18120021 ***** CHECK ON ***** 18130021 * 18140021 CHKON ST JP,SV1F11 SAVE LINK REG 18150021 CLC NXTCOD(LX2),ONCON 18160021 BC NOTEQ,CHKEXT ALL THROUGH 18170021 BC UNCOND,CHKGOT GET NEXT THEN EXIT 18180021 * 18190021 ***** GENERATE DIV OR SECT HEADER ***** 18200021 * 18210021 GENER1 STM JR,JC,SV4F04 SAVE LINK REGS 18220021 L JA,COSADR GENERATE 18230021 LR JB,JP DIVISION OR SECTION 18240021 BALR JR,JA HEADER 18250021 DC X'23' ON FILE 3 18260021 LM JR,JC,SV4F04 RESTORE LINK REGS 18270021 BC UNCOND,DX2(JP) -RETURN-JP+2 18280021 * 18290021 * 18300021 ***** CHECK FOR VALID EXTERNAL-NAME ***** 18310021 * 18320021 EXTNA3 ST JP,SV1F11 18330021 CLI CURCOD,XX34 IS IT ALPHALT(CALL ENTRY) 18340021 BNE ERMSGA NO 18350021 B EXTNA4 CHECK LENGTH 18360021 EXTNAM ST JP,SV1F11 SAVE LINK REG 18370021 TM CURSW,XX08 INT NUM LIT 18380021 BZ EXTNA5 NO 18390021 MVC CURN(LX31),CURCNT MAKE NUM LIT INTO BCD FORM 18400021 B EXTNA6 CHECK LENGTH 18410021 EXTNA5 CLI CURCOD,XX23 BCD NAME 18420021 BNE ERMSGA NO 18430021 EXTNA6 MVI CURCOD,XX34 18440021 EXTNA4 CLI CURN,XX08 LENGTH GREATER THAN 8 18450021 BC NOTHI,ELENOK NO 18460021 MVI CURN,XX08 18470021 ELENOK CLI CURBCD,XXF9 IS 1ST CHAR GREATER THAN 9 18480021 BH EXTNA1 YES 18490021 CLI CURBCD,XXF0 IS 1ST CHAR LESS THAN 0 18500021 BL EXTNA1 YES 18510021 BE EXTNA2 ZERO 18520021 NI CURBCD,XXCF MAKE FIRST CHAR A LETTER 18530021 B EXTNA1 BRANCH AROUND 18540021 EXTNA2 MVI CURBCD,XXD1 MAKE FIRST CHAR = J 18550021 EXTNA1 XR JB,JB 18560021 TRT CURBCD(LX1),UNONB STARTS WITH LETTER 18570021 BCT JB,ERMSGA NO-ERMSGA (IF LETTER,JB HA 18580021 EXTHYP DS 0H 18590021 IC JB,CURN GET SIZE 18600021 BCTR JB,JR REDUCE SIZE FOR 'EX' 18610021 BAL JP,NOLDI (SET UP TBL FOR NON L-D) 18620021 EX JB,EXTRTS TEST FOR LEGAL CHARACTERS 18630021 BAL JP,NOLDO (RESET TBL) 18640021 BC ZERO,EXTNOH YES - BLNKRTN 18650021 CLI DX0(R1),XX60 NO - HYPHEN ? 18660021 BNE ERMSGA NO - ERROR 18670021 MVI DX0(R1),XXF0 YES - TO ZERO 18680021 B EXTHYP RESCAN 18690021 EXTNOH DS 0H 18700021 BAL JP,BLNKRT -BLNKRT (SET UP WITH BLANK 18710021 L JP,SV1F11 RESTORE LINK REG 18720021 BCR UNCOND,JP -RETURN 18730021 ERMSGA BAL JP,MSG99 MSG99 - INVALID AS USED 18740021 L JP,SV1F11 RESTORE LINK REG 18750021 BC UNCOND,DX4(JP) -RETURN+4 18760021 EXTRTS TRT CURBCD(LX0),NONLDH 'EX' TEST FOR LEGAL CHARACT 18770021 * 18780021 ***** CHECK FOR COPY LIBRARY-NAME ***** 18790021 * 18800021 * 18810021 * 18820021 CPYCUR STM R1,R15,SV1F13 SAVE CALLING REGS 18830021 CLC CURCOD(LX2),COPYCN CURRENT IS COPY ? 18840021 BC NOTEQ,COPYNO NO-COPYNO 18850021 OI CPYCSW,XX01 SET 'ON' CPYCSW 18860021 * 18870021 CPYCKA NI CPYXSW,XXFE INITIALIZE CPYXSW 18880021 CPYCKB1 TM SKCDSW,XX20 IS CARD SAVED 18890021 BNO CPYCKB NO 18900021 MVC COMWRK+NX74(LX2),IDCOPY RESTORE COPY STMT ID 18910021 CPYCKB NI NWCDSW,XXBF SET NEW CD SW OFF 18920021 CLC COMWRK+NX74(LX2),BADCOPY GOOD COPY 18930021 BE CPERR NO - GET NEXT CLAUSE 18940021 CLC COMWRK+NX74(LX2),COPYCON COPY STATEMENT 18950021 BNE CPYCKD NO 18960021 OI CPYXSW,XX01 SET ON CPYXSW 18970021 BAL JP,CPYLST GET NEXT CARD 18980021 B CPYCKB1 CONTINUE SCAN 08009 18990021 * 19000021 CPYCKD TM CPYXSW,XX01 GOOD COPY 19010021 BNO CPYCKC NO - ISSUE DIAGNOSTIC 19020021 CLC COMWRK+NX74(LX2),NOCPYMEM NO COPY MEMBER FOUND 19030021 BNE CPYCKE RETURN 19040021 OI CPERSW,XX04 INDICATE NO MEMBER FOUND 19050021 BAL JP,CPYLST BYPASS DUMMY, GET NEXT REC 05338 19060021 B CPYCKE RETURN 19070021 * 19080021 CPYLST ST JP,SVRPRG SAVE LINK REGISTER 19090021 TM SKCDSW,XX20 IS CARD SAVED 19100021 BNO CPYLST1 NO - GETCARD 19110021 BAL JP,GETWD GET LAST WORD 19120021 B CPYLST2 RETURN 19130021 CPYLST1 BAL JP,GETCRD GET NEXT CARD 19140021 LA R7,COMWRK+NX73 AVOID GETTING LAST-WORD-SAVED 19150021 ST R7,NBLPTR IF CARD FOLLOWING COPY IS BLANK 19160021 CPYLST2 TM LCRDSW,XX20 LAST CD SET ON 19170021 BO CNXCL WRAP UP 19180021 L JP,SVRPRG RESTORE LINK REGISTER 19190021 BR JP RETURN 19200021 * 19210021 CPERR BAL JP,CPYLST GET NEXT CARD 19220021 BAL JP,GETWD GET A WORD 19230021 CNXCL BAL JP,GETWD GET WORD 19240021 TM CURCOD,XX30 MAJOR IS ZERO ? 19250021 BC ZERO,COPYNO EXIT 1923 19260021 B CNXCL GET WORD UNTIL NEW CLAUSE 1923 19270021 * 19280021 CPYCKC BAL JP,MSG18 -MSG18 19290021 B CNXCL SCAN TO NEXT CLAUSE 19300021 CPYCKE NI NXTSW,XXFB SET 'OFF' NONBLANK SW 19310021 BAL JP,GETWD -GETWD 19320021 MVC CURCOD(LX2),EOSCON SET UP EOS IN CURCOD 19330021 TM CPYCSW,XX01 CPYCSW 'ON' (FOR CUR CELL L 19340021 BC ZERO,CPYCKF NO-CPYCKF 19350021 NI CPYCSW,XXFE SET 'OFF' CPYCSW 19360021 BAL JP,GETWD -GETWD (LOAD CUR CELL) 19370021 * 19380021 CPYCKF LM R1,R15,SV1F13 RESTORE CALLING REGS 19390021 BCR UNCOND,JP -RETURN 19400021 COPYNO NI CPYXSW,XXFE SET 'OFF' CPYXSW 19410021 NI CPYCSW,XXFE SET CPYCSW OFF 19420021 B CPYCKF EXIT 19430021 * THE FOLLOWING CONSTANTS ARE PASSED TO 19440021 * PHASE 1 IN COLUMNS 74 - 75 OF THE CARD IMAGE. 19450021 COPYCON DC CL2'CO' PRE-PROCESSOR COPY 19460021 BADCOPY DC C'CP' BAD COPY INDICATOR 19470021 NOCPYMEM DC C'CN' NO COPY MEMBER FOUND 19480021 IDCOPY DS CL2 SAVE FOR COPY STMT ID 19490021 INCLCK EQU CPYCUR 19500021 * 19510021 * 19520021 * 19530021 ***** CHANGE UDIGT TBL TO NONLDH AND BACK AGAIN 19540021 * 19550021 NOLDHI NI TBHYPN,XX00 SET MINUS TO '0' 19560021 NOLDI XC MSKLT1(LX9),MSKLT1 SET LETTERS TO '0' 19570021 XC MSKLT2(LX9),MSKLT2 SET LETTERS TO '0' 19580021 XC MSKLT3(LX8),MSKLT3 19590021 BCR UNCOND,JP -RETURN 19600021 * 19610021 NOLDHO MVI TBHYPN,XX02 RESTORE MINUS TO '2' 19620021 NOLDO MVC MSKLT1(LX9),LETMSK RESTORE LETTERS TO '1' 19630021 MVC MSKLT2(LX9),LETMSK RESTORE LETTERS TO '1' 19640021 MVC MSKLT3(LX8),LETMSK RESTORE LETTERS TO '1' 19650021 BCR UNCOND,JP -RETURN 19660021 * 43521 19670021 USAREA DC XL3'00' USE DECLARATIVE WORKAREA 43521 19680021 USESAV DC 5F'0' USE DECLARATIVE SAVEAREA 43521 19690021 USEJP DC F'0' X 43521 19700021 * 43521 19710021 * 19720021 EJECT 19730021 * 19740021 ****** C-CALL INSERT FOR SPECIFIED TAMER TABLE 19750021 * 19760021 MVSERT LR JA,JB ADDR OF TABLE 19770021 MVSRT2 L JQ,ADSERT ADDR OF INSERT 19780021 MVI DX0(JA),XX00 SET TIB 'N' TO '0' 19790021 TM OD2SW,XX10 TEST IF OD2 19800021 BC ZERO,MVSERA NO-MVSERA 19810021 LA JD,DX2(JD) ADJ SIZE FOR COUNT HW 19820021 MVSERA LR JR,JD SIZE OF ENTRY TO REG JR 19830021 ST JP,REGWOK SAVE RETURN REG 19840021 BALR JP,JQ CALL INSERT TO TAMMER 19850021 L JP,REGWOK RESTORE RETURN REG 19860021 L JQ,SVREG+NX56 RESTORE REG 15 19870021 LA JB,DX0(JB) CLEARS HI-ORDER BYTE 19880021 ST JB,ABSADD SAV ABSOLUTE ADDR OF ENTRY 19890021 STH JC,PONTER SAVE POINTER (SIZE) OF ENTR 19900021 MVQLMV TM OD2SW,XX10 TEST IF OD2 19910021 BC ZERO,MVQLMT NO-MVQLMT 19920021 MVC DX0(LX2,JB),SAVSIZ PUT QUAL-NAMES SIZE IN TABL 19930021 LA JB,DX2(JB) ADJ ADDR PAST COUNT HW 19940021 STH JD,SAVSIZ SAVE ADJ SIZE 19950021 SH JD,HWTWO REDUCE SIZE FOR COUNT HW 19960021 MVQLMT EQU * 19970021 * 19980021 ****** E-MOVE ANY SIZE AREA TO ANY OTHER AREA 19990021 * 20000021 MVSTOR C JD,NU255 MORE THAN 255 BYTES TO MOVE 20010021 BC NOTHI,MVTXMV NO-MVTXMV 20020021 MVC DX0(LX255,JB),DX0(JG) MOVE 255 BYTES TO OUTPUT AR 20030021 AL JG,NU255 INCREASE 'FROM' ADDR BY 255 20040021 AL JB,NU255 INCREASE 'TO' ADDR BY 255 20050021 S JD,NU255 REDUCE SIZE BY 255 20060021 BC UNCOND,MVSTOR -MVSTOR 20070021 MVTXMV BCTR JD,JR REDUCE SIZE FOR EXECUTE MO 20080021 EX JD,TXMOVE EXECUTE MOVE TO OUTPUT 20090021 MVEXIT NI OD2SW,XX8F SET'OFF' QUAL INSR OD2SW 20100021 BCR UNCOND,JP -RETURN 20110021 MVEREX NI OD2SW,XX8F SET'OFF' QUAL INSR OD2SW 20120021 BC UNCOND,DX4(JP) -RETURN +4 'ERROR' 20130021 * 20140021 ****** F-EXECUTE 'MOVE' INSTRUCTION 20150021 * 20160021 TXMOVE MVC DX0(LX0,JB),DX0(JG) 'EXECUTE MOVE' INSTRUCTION 20170021 * 20180021 EJECT 20190021 * 20200021 ****** CONVERT INTEGRAL NUMERIC LITERAL TO BINARY ****** 20210021 * 20220021 CNVBIN SLR JA,JA CLEAR REG 20230021 IC JA,CURN N TO REG 20240021 SH JA,HWTHRE ADJUST FOR 2ND LENGTH 20250021 O JA,FWCONS ADJUST FOR FIRST LENGTH 20260021 EX JA,ROPUT MODIFY LGNTH 20270021 CVB JB,WORKDA CONVERT TO BINARY 20280021 BCR UNCOND,JP RETURN TO CALLER 20290021 ROPUT ZAP WORKDA,CURBCD+NX2(LX0) LITERAL TO WORKA 20300021 EJECT 20310021 * 20320021 ***** SEARCH OF ANY CONSTANT ENTRY SIZE TAMER TABLE ***** 20330021 * 20340021 * ADDR OF NAME TO BE LOOKED UP MUST BE IN REG JG 20350021 * NAME IS IN FORM OF N/NAME - ONLY'NAME'IS COMPARED 20360021 * REG USED JB JC JD JE JF 20370021 * REG JB HAS ADDR OF ENTRY START ON EXIT 20380021 * 20390021 SCHTOT L JF,TOTCON TOTTBL TIB TO 20400021 LA JE,DX34 SIZE OF ENTRY 20410021 SR JD,JD DISP OF FNTBL PTR 20420021 B SCHSCN SEARCH TABLE 20430021 * 20440021 SCHFNT L JF,FNTCON FNTBL TIB FN 20450021 LA JE,FNSIZ SIZE OF ENTRY 48 20460021 LA JD,FNWFND DISP OF FN IN ENTRY 16 20470021 BC UNCOND,SCHSCN -SCHSCN 20480021 * 20490021 SCHRCT L JF,RCDCON RCDTBL TIB RC 20500021 LA JE,DX34(JR) SIZE OF ENTRY 3 20510021 LA JD,DX2(JR) DISPL OF RECORD-NAME 0 20520021 BC UNCOND,SCHSCN -SCHSCN 20530021 * 20540021 *SCHAPT L JF,APPCON APPTBL TIB 20550021 * LA JE,66 SIZE OF ENTRY 20560021 * LA JD,4 DISP OF SN IN ENTRY 20570021 * B SCHSCN 20580021 * 20590021 SCHSPN CLI CURCOD,XX23 BCD NAME 20600021 BE SCHSP2 YES 20610021 NI SCHSW,XXBF NAME NOT FOUND 20620021 BR JP RETURN TO CALLER 20630021 SCHSP2 LA JD,DX3 DISP OF MNEMONIC NAME 20640021 SCHSP1 L JF,SPNCON SPNTBL 20650021 LA JE,DX34 SIZE OF ENTRY 20660021 B SCHSCN SEARCH TABLE 20670021 SCHSPT SR JD,JD DISP OF WORD IN ENTRY 20680021 B SCHSP1 SET UP FOR ZERO DISP 20690021 ***** SEARCH SCAN ***** 20700021 * 20710021 SCHSCN DS 0H 20720021 L JF,DX0(JF) ADDR OF TAMM 20730021 L JB,DX0(JF) ADDR OF START OF TABLE 20740021 LA JB,DX0(JD,JB) ADDR OF FIELD IN ENTRY 20750021 LH JF,DX4(JF) SIZE OF TABLE 20760021 LTR JF,JF IS TABLE EMPTY 20770021 BC ZERO,SCHZER YES-SCHZER 20780021 STH JD,SCHSAV SAVE ADJ FACTOR 20790021 SR JC,JC CLEAR REG 20800021 SR JD,JD CLEAR REG 20810021 SCHCM1 IC JD,DX0(JG) SIZE OF NAME 20820021 SCHCM2 STH JD,SCHPTR SAVE SIZE 20830021 SCHCOM EX JD,SCHCMP NAMES EQUAL 20840021 BC NOTEQ,SCHNXT NO-SCHNXT 20850021 TM RCDSW1,XX01 IS RCDTBL BEING SEARCHED 20860021 BC ONES,CHKFN YES 20870021 RCDNQL OI SCHSW,XX40 YES SET SWITCH ON 20880021 STH JC,SCHPTR+NX2 SAVE DISPLACEMENT 20890021 BC UNCOND,SCHEXT -SCHEXT 20900021 SCHCMP CLC DX0(LX0,JB),DX0(JG) COMPARE OF'NAME''EX' 20910021 SCHNXT LA JB,DX0(JE,JB) GET NEXT ADDRESS 20920021 LA JC,DX0(JE,JC) ACCUMULATE SIZE 20930021 CR JC,JF SIZE EQUAL-END OF TABLE 20940021 BC LO,SCHCOM NO-SCHCOM 20950021 SCHZER NI SCHSW,XXBF NAME NOT FOUND - SWITCH 'OF 20960021 SCHEXT SH JB,SCHSAV ADJ ADDR TO START OF ENTRY 20970021 BCR UNCOND,JP -EXIT 20980021 * THIS RTN CHECKS IF THE FOUND RECORD NAME IN THE RCDTBL 20990021 * IS QUALIFIED BY THE FILE NAME USED IN THIS PARTICULAR WRITE. 21000021 CHKFN CLI CURCOD,XXA2 IS RCD QUALIFIED 21010021 BC NOTEQ,RCDNQL NO 21020021 ST JP,SV1F11 21030021 LR JA,JB 21040021 SH JA,SCHSAV SET ENTRY ADDR TO FN PTR 21050021 LH JA,DX0(JA) FNTBL PTR 21060021 L JP,FNTCON FNTBL TIB 21070021 L JP,DX0(JP) FNTBL TAMM 21080021 L JP,DX0(JP) FNTBL ADDR 21090021 LA JP,FNWFND(JA,JP) ADDR OF FN IN FNTBL ENTRY 21100021 IC JA,FDSAVE GET LENGTH OF FILE NAME 21110021 EX JA,CMPFN COMPARE FILE NAME OF QUAL RCD 21120021 L JP,SV1F11 21130021 BC EQ,RCDNQL TO FILE OF FOUND RCD NAME 21140021 BC UNCOND,SCHNXT NO CONTINUE SEARCH IN RCDTBL 21150021 CMPFN CLC DX0(LX0,JP),FDSAVE 21160021 * 21170021 ***** BLNKRT - SET UP CURBCD W/BLANKS IN CURWD ***** 21180021 * 21190021 BLNKRT MVI CURWD,XX40 SET CURWD (30 BYTES) 21200021 MVC CURWD+NX1(LX29),CURWD TO BLANKS 21210021 IC JD,CURN GET LENGTH OF WORD 21220021 LA JB,CURCNT GET ADDR OF CURCNT 21230021 LA JG,CURN GET ADDR OF CURN 21240021 EX JD,TXMOVE EX - MOVE NAME TO BLANK FIE 21250021 BCR UNCOND,JP -RETURN 21260021 * 21270021 ***** GENA-B-R PUT ON FILE TWO ***** 21280021 * 21290021 GENA LA JF,CURCOD ADDR OF CURCOD TO BE PUT 21300021 GENB STM JR,JC,SV4F04 SAVE REG 21310021 L JA,COSADR ADDR OF COS 21320021 LR JB,JF PUT TO 21330021 BALR JR,JA FILE 21340021 DC X'22' TWO 21350021 LM JR,JC,SV4F04 RESTORE REG 21360021 BCR UNCOND,JP -RETURN 21370021 * 21380021 * 21390021 * 21400021 * 21410021 *GENERATE UNIQUE GN FOR PROCEDURE NAME 21420021 * 21430021 GNGN L JA,COSADR 21440021 LH JC,GNCTR 21450021 LA JC,DX1(JC) 21460021 STH JC,GNCTR 21470021 STH JC,GPTID1 21480021 BCR UNCOND,JP RETURN TO CALLER 21490021 * 21500021 *REPORT CALL G.NNNN 21510021 * G.NNN IS IN RCGN - ROUTINE GENERATES RPT-CALL G.NNN ON FILE-2 21520021 GNRCLL ST JP,JPSAVE 21530021 LA JB,RCALL 21540021 XR JC,JC 21550021 IC JC,PUTCT3 21560021 GNRCL1 DS 0H 21570021 BAL JP,RPTN WRITE P0-TEXT 21580021 L JP,JPSAVE 21590021 BCR UNCOND,JP RETURN TO CALLER 21600021 * 21610021 * 21620021 *RPTN RW PUTN 21630021 RPTN ST JP,PUTNSV 21640021 * 21650021 L JA,COSADR 21660021 BALR JR,JA CALL COS 21670021 DC X'12' WRITE ON FILE 2 21680021 L JP,PUTNSV 21690021 BCR UNCOND,JP RETURN TO CALLER 21700021 * 21710021 *ROUTINE TO LOCATE START AND END OF TABLE 21720021 TBLNIT DS 0H 21730021 L JA,DX0(JA) TAMM 21740021 LH JB,DX4(JA) DISPL OF TBL 21750021 L JA,DX0(JA) START OF TABLE 21760021 LA JA,DX0(JA) CLEAR HI-ORDER BYTE 21770021 LTR JB,JB TEST IF TBL EMPTY 21780021 *** CALLING ROUTINE MUST TEST FOR CONDITION ZERO ON RETURN 21790021 BCR UNCOND,JP RETURN TO CALLER 21800021 EJECT 21810021 IKF104 CSECT 21820021 * 21830021 *=1 COBOL WORD TABLE ID ENV DATA PR 21840021 * 21850021 COBWRD DC C'AT' ENCODE 21860021 DC X'547002' AT 21870021 DC C'BY' ENCODE 21880021 BYCON DC X'547F0A' BY 21890021 DC C'CF' ENCODE 21900021 DC X'54F804' CF 21910021 DC C'CH' ENCODE 21920021 DC X'54F604' CH 21930021 DC C'DE' ENCODE 21940021 DC X'54EA04' DE SAME AS 'DETAIL' 21950021 DC C'FD' ENCODE 21960021 DC X'433884' FD 21970021 DC C'GO' ENCODE 21980021 DC X'441102' GO 21990021 IDKON DC C'ID' ENCODE 22000021 IDCON DC X'42F111' ID SAME AS 'IDENTIFI 22010021 DC C'IF' ENCODE 22020021 IFCON DC X'440702' IF 22030021 DC C'IN' ENCODE 22040021 INCON DC X'54A40C' IN SAME AS 'OF' 22050021 ISKON DC C'IS' ENCODE 22060021 ISCON DC X'549C0E' IS SAME AS 'ARE' 22070021 DC C'NO' ENCODE 22080021 NOCON DC X'549E0A' NO 22090021 DC C'OF' ENCODE 22100021 OFCON DC X'54A40C' OF SMAE AS 'IN' 22110021 DC C'ON' ENCODE 22120021 ONCON DC X'542B0E' ON 442B DEBUG ON 22130021 DC C'OR' ENCODE 22140021 DC X'545E02' OR 22150021 DC C'PF' ENCODE 22160021 DC X'54FA04' PF 22170021 DC C'PH' ENCODE 22180021 DC X'54F404' PH 22190021 DC C'RD' ENCODE 22200021 DC X'433484' RD 22210021 DC C'RF' ENCODE 22220021 DC X'540E04' RF 22230021 DC C'RH' ENCODE 22240021 DC X'54F304' RH 22250021 DC C'SD' ENCODE 22260021 DC X'433684' SD 22270021 DC C'TO' ENCODE 22280021 TOCON DC X'549B0E' TO 22290021 DC C'UP' ENCODE 22300021 DC X'543A02' UP 22310021 *** 22320021 *** 22330021 *** 22340021 COB3 DC C'ADD' ENCODE 22350021 ADDCN DC X'440002' ADD 22360021 DC C'ALL' ENCODE 22370021 ALLCON DC X'547902' ALL 22380021 DC C'AND' ENCODE 22390021 DC X'545D02' AND 22400021 DC C'ARE' ENCODE 22410021 ARECON DC X'549C0E' ARE 22420021 DC C'C01' ENCODE 22430021 C01CON DC X'550108' C01 22440021 DC C'C02' ENCODE 22450021 DC X'550208' C02 22460021 DC C'C03' ENCODE 22470021 DC X'550308' C03 22480021 DC C'C04' ENCODE 22490021 DC X'550408' C04 22500021 DC C'C05' ENCODE 22510021 DC X'550508' C05 22520021 DC C'C06' ENCODE 22530021 DC X'550608' C06 22540021 DC C'C07' ENCODE 22550021 DC X'550708' C07 22560021 DC C'C08' ENCODE 22570021 DC X'550808' C08 22580021 DC C'C09' ENCODE 22590021 DC X'550908' C09 22600021 DC C'C10' ENCODE 22610021 DC X'550A08' C10 22620021 DC C'C11' ENCODE 22630021 DC X'550B08' C11 22640021 DC C'C12' ENCODE 22650021 DC X'550C08' C12 22660021 DC C'CSP' ENCODE 22670021 DC X'550008' CSP 22680021 DC C'S01' ENCODE 22690021 DC X'550D08' S01 22700021 DC C'S02' ENCODE 22710021 DC X'550E08' S02 22720021 DC C'END' ENCODE 22730021 ENDCD DC X'54A10A' END 22740021 DC C'EOP' ENCODE 22750021 DC X'545A02' EOP- SAME AS END-OF-PAGE 22760021 DC C'FOR' ENCODE 22770021 FORCON DC X'54A30A' FOR 22780021 DC C'I-O' ENCODE 22790021 DC X'546B02' I-O 22800021 DC C'KEY' ENCODE 22810021 KEYCON DC X'549F0A' KEY 22820021 DC C'NOT' ENCODE 22830021 NOTCON DC X'545C02' NOT 22840021 DC C'OFF' ENCODE 22850021 OFFCON DC X'543808' OFF 22860021 DC C'PIC' ENCODE 22870021 DC X'54D804' SAME AS PICTURE-PIC 22880021 DC C'RUN' ENCODE 22890021 RUNCDE DC X'548502' RUN 9833 22900021 DC C'SET' ENCODE 22910021 DC X'446102' SET 22920021 DC C'SUM' ENCODE 22930021 DC X'54FF04' SUM 22940021 DC C'USE' ENCODE 22950021 USECON DC X'443102' USE 22960021 **** 22970021 **** 22980021 **** 22990021 COB4 DC C'AREA' ENCODE 23000021 AREACN DC X'54BF08' AREA SAME AS 'AREAS' 23010021 DC C'CALL' ENCODE 23020021 DC X'442D02' CALL 23030021 DC C'CODE' ENCODE 23040021 DC X'54E504' CODE 23050021 DC C'COMP' ENCODE 23060021 DC X'54DE04' SAME AS COMPUTATIONAL-COMP 23070021 DC C'COPY' ENCODE 23080021 COPYCN DC X'44F50E' COPY 23090021 DC C'CORR' ENCODE 23100021 DC X'547A02' SAME AS CORRESPONDING 23110021 DC C'DATA' ENCODE 23120021 DATACD DC X'42011C' DATA 540104 IN DATA DI 23130021 DC C'DISP' ENCODE 23140021 DC X'544C02' DISP 23150021 DC C'DOWN' ENCODE 23160021 DC X'543B02' DOWN 23170021 DC C'ELSE' ENCODE 23180021 ELSCON DC X'440802' ELSE SAME AS OTHERWISE 23190021 DC C'EXIT' ENCODE 23200021 DC X'443202' EXIT 23210021 DC C'FILE' ENCODE 23220021 FILECD DC X'543C02' FILE 23230021 DC C'FROM' ENCODE 23240021 FROMCN DC X'549D0E' FROM 23250021 DC C'INTO' ENCODE 23260021 DC X'546F02' INTO 23270021 DC C'JUST' ENCODE 23280021 DC X'54DB04' SAME AS JUSTIFIED-JUST 23290021 DC C'LAST' ENCODE 23300021 DC X'54EB04' LAST 23310021 DC C'LEFT' ENCODE 23320021 LFTCON DC X'54E404' LEFT 23330021 DC C'LESS' ENCODE 23340021 LESCON DC X'500A02' LESS 23350021 LNCON DC C'LINE' ENCODE 23360021 LINCON DC X'549504' LINE SAME AS LINES 23370021 DC C'LOCK' ENCODE 23380021 DC X'547602' LOCK 23390021 DC C'MODE' ENCODE 23400021 MODECN DC X'541504' MODE 23410021 DC C'MOVE' ENCODE 23420021 MOVECN DC X'441D02' MOVE 23430021 DC C'NEXT' ENCODE 23440021 DC X'549706' NEXT 23450021 DC C'NOTE' ENCODE 23460021 DC X'44F702' NOTE 23470021 DC C'OPEN' ENCODE 23480021 DC X'442102' OPEN 23490021 PGCON DC C'PAGE' ENCODE 23500021 DC X'54E604' PAGE 23510021 DC C'PLUS' ENCODE 23520021 DC X'54F004' PLUS 23530021 DC C'READ' ENCODE 23540021 DC X'442002' READ 23550021 DC C'REEL' ENCODE 23560021 REELCN DC X'54170A' REEL 23570021 DC C'SAME' ENCODE 23580021 DC X'44F308' SAME 23590021 DC C'SEEK' ENCODE 23600021 DC X'446302' SEEK 23610021 DC C'SIGN' ENCODE 23620021 SGNCON DC X'54AB08' SIGN 23630021 DC C'SIZE' ENCODE 23640021 DC X'54830A' SIZE 23650021 DC C'SORT' ENCODE 23660021 SORCON DC X'443602' SORT 23670021 STOPCN DC C'STOP' ENCODE 9833 23680021 DC X'441002' STOP 23690021 DC C'SYNC' ENCODE 23700021 DC X'543704' SYNC-SAME AS SYNCHRONIZED 23710021 DC C'TAPE' ENCODE 23720021 DC X'544008' TAPE 23730021 DC C'THAN' ENCODE 23740021 THNCON DC X'545302' THAN 23750021 DC C'THEN' ENCODE 23760021 DC X'545002' THEN 23770021 DC C'THRU' ENCODE 23780021 THRUCN DC X'548706' THRU 23790021 DC C'TYPE' ENCODE 23800021 DC X'54EF04' TYPE 23810021 DC C'UNIT' ENCODE 23820021 UNTCON DC X'54A20A' UNIT SAME AS 'UNITS' 23830021 DC C'UPON' ENCODE 23840021 UPONCN DC X'549806' UPON 23850021 DC C'WHEN' ENCODE 23860021 WHNCON DC X'54E206' WHEN 23870021 DC C'WITH' ENCODE 23880021 DC X'546C02' WITH 23890021 DC C'ZERO' ENCODE 23900021 ZECON DC X'75F006' ZERO SAME AS 'ZEROS-ES' 23910021 ***** 23920021 ***** 23930021 ***** 23940021 COB5 DC C'AFTER' ENCODE 23950021 AFTCON DC X'547202' AFTER 23960021 DC C'ALTER' ENCODE 23970021 DC X'441C02' ALTER 23980021 DC C'APPLY' ENCODE 23990021 DC X'44F408' APPLY 24000021 DC C'AREAS' ENCODE 24010021 DC X'54BF08' AREAS SAME AS 'AREA' 24020021 DC C'BASIS' NOT ALLOWED AS A 24030021 DC X'54B700' USER-NAME 24040021 DC C'BLANK' ENCODE 24050021 BLNKCN DC X'54D904' BLANK 24060021 DC C'BLOCK' ENCODE 24070021 DC X'54CC04' BLOCK 24080021 DC C'CLOSE' ENCODE 24090021 DC X'442202' CLOSE 24100021 DC C'COBOL' ENCODE 24110021 DC X'548A02' COBOL 24120021 DC C'COMMA' ENCODE 24130021 COMMCN DC X'541208' COMMA 24140021 DC C'DEBUG' NOT ALLOWED AS A 24150021 DC X'54B800' USER-NAME 24160021 EJCON DC C'EJECT' ENCODE 24170021 DC X'540500' EJECT 24180021 DC C'ENTER' ENCODE 24190021 DC X'442E02' ENTER 24200021 DC C'ENTRY' ENCODE 24210021 DC X'442C02' ENTRY 24220021 DC C'EQUAL' ENCODE 24230021 EQCON DC X'500602' EQUAL 24240021 DC C'ERROR' ENCODE 24250021 DC X'548402' ERROR 24260021 DC C'EVERY' ENCODE 24270021 EVYCON DC X'549A0A' EVERY 24280021 DC C'FINAL' ENCODE 24290021 DC X'54E704' FINAL 24300021 DC C'FIRST' ENCODE 24310021 DC X'549606' FIRST 24320021 DC C'GROUP' ENCODE 24330021 DC X'54EE04' GROUP 24340021 DC C'INDEX' ENCODE 24350021 DC X'543204' INDEX 24360021 DC C'INPUT' ENCODE 24370021 DC X'546602' INPUT 24380021 DC C'LABEL' ENCODE 24390021 DC X'54D106' LABEL SAME AS 'LABELS' 24400021 DC C'LEAVE' ENCODE 24410021 DC X'544A02' LEAVE 24420021 DC C'LIMIT' ENCODE 24430021 DC X'545F04' LIMIT SAME AS LIMITS 24440021 DC C'LINES' ENCODE 24450021 DC X'549506' LINES SAME AS 'LINE' 24460021 DC C'NAMED' ENCODE 24470021 NAMCON DC X'549002' NAMED 24480021 DC C'QUOTE' ENCODE 24490021 QUOCON DC X'757D06' QUOTE SAME AS QUOTES 9638 24500021 DC C'READY' ENCODE 24510021 DC X'442902' READY 24520021 DC C'RERUN' ENCODE 24530021 DC X'44F208' RERUN 24540021 DC C'RESET' ENCODE 24550021 RSETCD DC X'442806' RESET 24560021 DC C'RIGHT' ENCODE 24570021 RITCON DC X'54E304' RIGHT 24580021 SK1CON DC C'SKIP1' ENCODE 24590021 DC X'540200' SKIP1 24600021 SK2CON DC C'SKIP2' ENCODE 24610021 DC X'540300' SKIP2 24620021 SK3CON DC C'SKIP3' ENCODE 24630021 DC X'540400' SKIP3 24640021 DC C'SPACE' ENCODE 24650021 SPCCON DC X'754006' SPACE SAME AS 'SPACES' 24660021 DC C'SYSIN' ENCODE 24670021 DC X'54180A' SYSIN 24680021 DC C'START' ENCODE 24690021 DC X'446402' START 24700021 DC C'TALLY' ENCODE 24710021 TALCON DC X'790502' TALLY 24720021 DC C'TIMES' ENCODE 24730021 TIMCON DC X'549306' TIMES 24740021 DC C'TRACE' ENCODE 24750021 DC X'548E02' TRACE 24760021 DC C'TRACK' TRACK 24770021 DC X'54C408' ENCODE 24780021 DC C'UNTIL' ENCODE 24790021 DC X'547D02' UNTIL 24800021 DC C'USAGE' ENCODE 24810021 DC X'54DD04' USAGE 24820021 DC C'USING' ENCODE 24830021 USICON DC X'548902' USING 24840021 DC C'VALUE' ENCODE 24850021 DC X'54CA04' VALUE 24860021 DC C'WORDS' ENCODE 24870021 DC X'543608' WORDS 24880021 DC C'WRITE' ENCODE 24890021 WRCON DC X'442302' WRITE 24900021 DC C'ZEROS' ENCODE 24910021 DC X'75F006' ZEROS SAME AS 'ZERO-S-E 24920021 ****** 24930021 ******* 24940021 COB6 DC C'ACCEPT' ENCODE 24950021 DC X'442502' ACCEPT 24960021 DC C'ACCESS' ENCODE 24970021 DC X'54B208' ACCESS 24980021 DC C'ACTUAL' ENCODE 24990021 DC X'54B608' ACTUAL 25000021 DC C'ASSIGN' ENCODE 25010021 ASGNCN DC X'54B108' ASSIGN 25020021 DC C'AUTHOR' ENCODE 25030021 DC X'42F341' AUTHOR 25040021 DC C'BEFORE' ENCODE 25050021 BEFCON DC X'546902' BEFORE 25060021 DC C'COLUMN' ENCODE 25070021 DC X'54FC04' COLUMN 25080021 DC C'COMP-1' ENCODE 25090021 DC X'54DF04' COMP-1-SAME AS COMPUTATIONA 25100021 DC C'COMP-2' ENCODE 25110021 DC X'54E004' COMP-2-SAME AS COMPUTATIONA 25120021 DC C'COMP-3' ENCODE 25130021 DC X'54E104' COMP-3-SAME AS COMPUTATIONA 25140021 DC C'DELETE' NOT ALLOWED AS A 25150021 DC X'54B900' USER NAME 25160021 DC C'DETAIL' ENCODE 25170021 DC X'54EA04' DETAIL SAME AS 'DE' 25180021 DC C'DIVIDE' ENCODE 25190021 DC X'440302' DIVIDE 25200021 DC C'ENDING' ENCODE 25210021 DC X'546202' ENDING 25220021 DC C'FILLER' ENCODE 25230021 DC X'54AF04' FILLER 25240021 DC C'GIVING' ENCODE 25250021 DC X'548102' GIVING 25260021 DC C'GOBACK' ENCODE 25270021 DC X'447302' GOBACK 25280021 DC C'INSERT' NOT ALLOWED AS A 25290021 DC X'54BB00' USER-NAME 25300021 DC C'LIMITS' ENCODE 25310021 DC X'545F04' LIMITS SAME AS LIMIT 25320021 DC C'MEMORY' ENCODE 25330021 DC X'543508' MEMORY 25340021 DC C'NUMBER' ENCODE 25350021 DC X'544400' NUMBER 25360021 DC C'OCCURS' ENCODE 25370021 DC X'54DA04' OCCURS 25380021 DC C'OUTPUT' ENCODE 25390021 DC X'546402' OUTPUT 25400021 DC C'QUOTES' ENCODE 25410021 QUOSCN DC X'757D06' QUOTES SAME AS QUOTE 9638 25420021 DC C'RANDOM' ENCODE 25430021 RANDCN DC X'54670A' RANDOM 25440021 DC C'RECORD' ENCODE 25450021 RECCON DC X'54CD0E' RECORD 25460021 DC C'REPORT' ENCODE 25470021 REPTCD DC X'420524' REPORT 54D604 IN RPT SCT 25480021 DC C'REREAD' ENCODE 25490021 DC X'544B02' REREAD 25500021 DC C'RETURN' ENCODE 25510021 DC X'442A02' RETURN 25520021 DC C'REWIND' ENCODE 25530021 DC X'546D02' REWIND 25540021 DC C'SEARCH' ENCODE 25550021 SEACON DC X'445E02' SEARCH 25560021 DC C'SELECT' ENCODE 25570021 DC X'44F108' SELECT 25580021 DC C'SOURCE' ENCODE 25590021 DC X'54FE04' SOURCE 25600021 DC C'SPACES' ENCODE 25610021 DC X'754006' SPACES SAME AS 'SPACE' 25620021 DC C'STATUS' ENCODE 25630021 DC X'543300' NOT ALLOWED AS A USER-NAME 25640021 DC C'SYSIPT' ENCODE 25650021 DC X'54180A' SYSIPT 25660021 DC C'SYSLST' ENCODE 25670021 DC X'54190A' SYSLST 25680021 DC C'SYSOUT' 25690021 DC X'54190A' SYSOUT 25700021 DC C'SYSPCH' ENCODE 25710021 DC X'54770A' SYSPCH 25720021 DC C'TRACKS' 25730021 TRKCON DC X'54C408' TRACKS 25740021 DC C'VALUES' 25750021 DC X'54CA04' VALUES-SAME AS VALUE 25760021 DC C'ZEROES' ENCODE 25770021 DC X'75F006' ZEROES SAME AS 'ZERO-S' 25780021 ******* ENCODE 25790021 ******* 25800021 COB7 DC C'CHANGED' ENCODE 25810021 CHGCON DC X'548F02' CHANGED 25820021 DC C'ADDRESS' ENCODE 25830021 DC X'544200' ADDRESS 25840021 DC C'COMPUTE' ENCODE 25850021 DC X'440402' COMPUTE 25860021 DC C'CONSOLE' ENCODE 25870021 DC X'54780A' CONSOLE 25880021 DC C'CONTROL' ENCODE 25890021 DC X'54D004' CONTROL SAME AS 'CONTROLS 25900021 DC C'DISPLAY' ENCODE 25910021 DISPCD DC X'442606' DISPLAY 25920021 DC C'EXAMINE' ENCODE 25930021 DC X'441E02' EXAMINE 25940021 DC C'EXHIBIT' ENCODE 25950021 DC X'442702' EXHIBIT 25960021 DC C'FOOTING' ENCODE 25970021 DC X'54EC04' FOOTING 25980021 DC C'GREATER' ENCODE 25990021 GRTCON DC X'500802' GREATER 26000021 DC C'HEADING' ENCODE 26010021 DC X'54E904' HEADING 26020021 DC C'INDEXED' ENCODE 26030021 DC X'54BC08' INDEXED 26040021 DC C'INVALID' ENCODE 26050021 INVCON DC X'547102' INVALID 26060021 DC C'LEADING' ENCODE 26070021 DC X'547C02' LEADING 26080021 DC C'LINKAGE' ENCODE 26090021 LINKCD DC X'549102' LINKAGE 26100021 DC C'MODULES' ENCODE 26110021 DC X'543408' MODULES 26120021 DC C'NOMINAL' ENCODE 26130021 DC X'54B508' NOMINAL 26140021 DC C'NUMERIC' ENCODE 26150021 DC X'545602' NUMERIC 26160021 DC C'OMITTED' ENCODE 26170021 OMTCON DC X'54D404' OMITTED 26180021 DC C'PERFORM' ENCODE 26190021 DC X'443802' PERFORM 26200021 DC C'PICTURE' ENCODE 26210021 PICTCD DC X'54D804' PICTURE 26220021 DC C'PROCEED' ENCODE 26230021 PRCDCN DC X'548602' PROCEED 26240021 DC C'PROGRAM' ENCODE 26250021 DC X'540D02' PROGRAM 26260021 DC C'RECORDS' ENCODE 26270021 RCDSCO DC X'54CF04' RECORDS 26280021 DC C'RELEASE' ENCODE 26290021 DC X'443702' RELEASE 26300021 DC C'REMARKS' ENCODE 26310021 DC X'42FE41' REMARKS 26320021 DC C'RENAMES' ENCODE 26330021 DC X'543904' RENAMES 26340021 DC C'REPORTS' ENCODE 26350021 REPTCN DC X'54D604' REPORTS SAME AS'REPORT'IN 26360021 DC C'RESERVE' ENCODE 26370021 DC X'54B408' RESERVE 26380021 DC C'REWRITE' ENCODE 26390021 DC X'442402' REWRITE 26400021 DC C'ROUNDED' ENCODE 26410021 DC X'548202' ROUNDED 26420021 SCTKON DC C'SECTION' ENCODE 26430021 SCTCON DC X'54A50E' SECTION 26440021 DC C'THROUGH' ENCODE 26450021 DC X'548702' THROUGH-SAME AS THRU 26460021 DC C'TOTALED' ENCODE 26470021 TODCON DC X'541104' TOTALED 26480021 DC C'VARYING' ENCODE 26490021 DC X'548802' VARYING 26500021 ******** 26510021 ******** 26520021 ******** 26530021 COB8 DC C'CONTAINS' ENCODE 26540021 CONTCN DC X'54D304' CONTAINS 26550021 DC C'CONTROLS' ENCODE 26560021 DC X'54D004' CONTROLS SAME AS 'CONTROL' 26570021 DC C'CURRENCY' ENCODE 26580021 DC X'543008' CURRENCY 26590021 DIVKON DC C'DIVISION' ENCODE 26600021 DIVCON DC X'54A70F' DIVISION 26610021 DC C'GENERATE' ENCODE 26620021 DC X'443402' GENERATE 26630021 DC C'INDICATE' ENCODE 26640021 DC X'54FD04' INDICATE 26650021 DC C'INITIATE' ENCODE 26660021 DC X'443302' INITIATE 26670021 DC C'MULTIPLY' ENCODE 26680021 DC X'440202' MULTIPLY 26690021 DC C'NEGATIVE' ENCODE 26700021 DC X'545802' NEGATIVE 26710021 DC C'OPTIONAL' ENCODE 26720021 OPTCON DC X'543D08' OPTIONAL 26730021 DC C'MULTIPLE' ENCODE 26740021 MULCON DC X'54AD08' MULTIPLE 26750021 DC C'POSITION' ENCODE 26760021 DC X'543F08' POSITION 26770021 DC C'POSITIVE' ENCODE 26780021 DC X'545702' POSITIVE 26790021 DC C'REVERSED' ENCODE 26800021 DC X'546E02' REVERSED 26810021 DC C'SECURITY' ENCODE 26820021 DC X'42F041' SECURITY 26830021 DC C'SENTENCE' ENCODE 26840021 DC X'54FB02' SENTENCE 26850021 DC C'STANDARD' ENCODE 26860021 STDCON DC X'54D506' STANDARD 26870021 DC C'SUBTRACT' ENCODE 26880021 DC X'440102' SUBTRACT 26890021 DC C'SUPPRESS' ENCODE 26900021 SURPCN DC X'54070F' SUPPRESS 26910021 DC C'SYSPUNCH' ENCODE 26920021 DC X'54770A' SYSPUNCH 26930021 DC C'TOTALING' ENCODE 26940021 TOGCON DC X'541004' TOTALING 26950021 DC C'TALLYING' 26960021 DC X'547B02' TALLYING 26970021 ********* 26980021 ********* 26990021 COB9 DC C'ADVANCING' ENCODE 27000021 ADVCON DC X'547302' ADVANCING 27010021 DC C'ALTERNATE' ENCODE 27020021 DC X'54BE08' ALTERNATE 27030021 DC C'ASCENDING' ENCODE 27040021 DC X'548D02' ASCENDING 27050021 DC C'BEGINNING' ENCODE 27060021 DC X'546102' BEGINNING 27070021 DC C'CYL-INDEX' ENCODE 27080021 DC X'545108' CYL-INDEX 27090021 DC C'DEPENDING' ENCODE 27100021 DEPNCN DC X'549406' DEPENDING 27110021 DC C'JUSTIFIED' ENCODE 27120021 DC X'54DB04' JUSTIFIED 27130021 DC C'LOW-VALUE' ENCODE 27140021 DC X'750006' LOW-VALUE SAME AS 'LOW-VALU 27150021 DC C'OTHERWISE' ENCODE 27160021 DC X'440802' OTHERWISE SAME AS 'ELSE' 27170021 DC C'PROCEDURE' ENCODE 27180021 PROCCD DC X'42061E' PROCEDURE 549902 IN 'PD' 27190021 DC C'RECORDING' ENCODE 27200021 DC X'541604' RECORDING 27210021 DC C'REDEFINES' ENCODE 27220021 DC X'54D704' REDEFINES 27230021 DC C'REMAINDER' ENCODE 27240021 DC X'543E02' REMAINDER 27250021 DC C'REPLACING' ENCODE 27260021 REPCN DC X'547E02' REPLACING 27270021 DC C'REPORTING' ENCODE 27280021 DC X'546A02' REPORTING 27290021 DC C'TERMINATE' ENCODE 27300021 DC X'443502' TERMINATE 27310021 DC C'TRANSFORM' ENCODE 27320021 DC X'441F02' TRANSFORM 27330021 ********** 27340021 ********** 27350021 COB10 DC C'ALPHABETIC' ENCODE 27360021 DC X'545502' ALPHABETIC 27370021 DC C'CHARACTERS' ENCODE 27380021 CHARCN DC X'54920E' CHARACTERS 27390021 DC C'CORE-INDEX' ENCODE 27400021 DC X'540C08' CORE-INDEX 27410021 DC C'DESCENDING' ENCODE 27420021 DC X'548C02' DESCENDING 27430021 DC C'DISPLAY-ST' ENCODE 27440021 DC X'54F204' DISPLAY-ST 27450021 DC C'FILE-LIMIT' ENCODE 27460021 DC X'541408' FILE-LIMIT 27470021 DC C'HIGH-VALUE' ENCODE 27480021 DC X'75FF06' HIGH-VALUE SAME AS 'HIGH-VAL 27490021 DC C'LOW-VALUES' ENCODE 27500021 DC X'750006' LOW-VALUES SAME AS 'LOW-VALU 27510021 DC C'NSTD-REELS' ENCODE 27520021 DC X'540602' NSTD-REELS 27530021 DC C'PROCESSING' ENCODE 27540021 DC X'546808' PROC DIV ONLY 27550021 DC C'PROGRAM-ID' ENCODE 27560021 DC X'42F241' PROGRAM-ID 27570021 DC C'SEQUENTIAL' ENCODE 27580021 DC X'54BA08' SEQUENTIAL 27590021 DC C'TRACK-AREA' ENCODE 27600021 DC X'541A08' TRACK-AREA 27610021 DC C'WRITE-ONLY' ENCODE 27620021 DC X'540F08' WRITE-ONLY 27630021 *********** 27640021 *********** 27650021 COB11 DC C'CLOCK-UNITS' ENCODE 27660021 DC X'54C100' NOT ALLOWED AS A USER-NAME 27670021 DC C'ENVIRONMENT' ENCODE 27680021 ENVRCN DC X'42F418' ENVIRONMENT 27690021 DC C'END-OF-PAGE' ENCODE 27700021 DC X'545A02' END-OF-PAGE- SAME AS EOP 27710021 DC C'FILE-LIMITS' ENCODE 27720021 DC X'541408' FILE-LIMITS-SAME AS FILE-LI 27730021 DC C'HIGH-VALUES' ENCODE 27740021 DC X'75FF06' HIGH-VALUES SAME AS 'HIGH-VAL 27750021 DC C'I-O-CONTROL' ENCODE 27760021 DC X'42FA48' I-O-CONTROL 27770021 DC C'MORE-LABELS' ENCODE 27780021 DC X'546302' MORE-LABELS 27790021 DC C'POSITIONING' 27800021 POSCON DC X'54DC02' POSITIONING 27810021 DC C'TRACK-LIMIT' ENCODE 27820021 DC X'541C08' TRACK-LIMIT 27830021 *** 27840021 *** 27850021 COB12 DC C'DATE-WRITTEN' ENCODE 27860021 DC X'42FC41' DATE-WRITTEN 27870021 DC C'CYL-OVERFLOW' ENCODE 27880021 DC X'544F08' CYL-OVERFLOW 27890021 DECLKN DC C'DECLARATIVES' ENCODE 27900021 DECLCD DC X'420742' DECLARATIVES 27910021 DC C'FILE-CONTROL' ENCODE 27920021 DC X'42F948' FILE-CONTROL 27930021 DC C'INPUT-OUTPUT' ENCODE 27940021 DC X'42F828' INPUT-OUTPUT 27950021 DC C'INSTALLATION' ENCODE 27960021 DC X'42FD41' INSTALLATION 27970021 LCTRKN DC C'LINE-COUNTER' ENCODE 27980021 DC X'790102' LINE-COUNTER 27990021 DC C'MASTER-INDEX' ENCODE 28000021 DC X'544E08' MASTER-INDEX 28010021 PCTRKN DC C'PAGE-COUNTER' ENCODE 28020021 DC X'790202' PAGE-COUNTER 28030021 PTSWKN DC C'PRINT-SWITCH' ENCODE 28040021 PSCON DC X'54CB02' PRINT-SWITCH 28050021 DC C'SYNCHRONIZED' ENCODE 28060021 DC X'543704' SYNCHRONIZED 28070021 DC C'WRITE-VERIFY' ENCODE 28080021 DC X'545208' WRITE-VERIFY 28090021 **** 28100021 **** 28110021 COB13 DC C'COMPUTATIONAL' ENCODE 28120021 DC X'54DE04' COMPUTATIONAL 28130021 DC C'CONFIGURATION' ENCODE 28140021 DC X'42F528' CONFIGURATION 28150021 DC C'CORRESPONDING' ENCODE 28160021 DC X'547A02' CORRESPONDING 28170021 DC C'DATE-COMPILED' ENCODE 28180021 DATECN DC X'420F41' DATE-COMPILED 28190021 DC C'DECIMAL-POINT' ENCODE 28200021 DC X'541308' DECIMAL-POINT 28210021 DC C'SEGMENT-LIMIT' ENCODE 28220021 SEGTCN DC X'446208' SEGMENT-LIMIT 28230021 DC C'SPECIAL-NAMES' ENCODE 28240021 DC X'42FB48' SPECIAL-NAMES 28250021 **** 28260021 **** 28270021 COB14 DC C'IDENTIFICATION' ENCODE 28280021 DC X'42F111' IDENTIFICATION 28290021 DC C'REORG-CRITERIA' ENCODE 28300021 DC X'542508' REORG-CRITERIA 28310021 ***** 28320021 ***** 28330021 COB15 DC C'COMPUTATIONAL-1' ENCODE 28340021 DC X'54DF04' COMPUTATIONAL-1 28350021 DC C'COMPUTATIONAL-2' ENCODE 28360021 DC X'54E004' COMPUTATIONAL-2 28370021 DC C'COMPUTATIONAL-3' ENCODE 28380021 DC X'54E104' COMPUTATIONAL-3 28390021 DC C'EXTENDED-SEARCH' ENCODE 28400021 DC X'544D08' EXTENDED-SEARCH 28410021 DC C'OBJECT-COMPUTER' ENCODE 28420021 DC X'42F748' OBJECT-COMPUTER 28430021 DC C'SOURCE-COMPUTER' ENCODE 28440021 DC X'42F648' SOURCE-COMPUTER 28450021 DC C'RECORD-OVERFLOW' ENCODE 28460021 DC X'545408' RECORD-OVERFLOW 28470021 DC C'WORKING-STORAGE' ENCODE 28480021 WRKSCD DC X'420324' WORKING-STORAGE 28490021 TBEND DC C'END' END OF COBOL WORDS 28500021 EJECT 28510021 *=2 TRT AND SPECIAL CHARACTER TABLES 28520021 * 28530021 * TABLE FOR LOCATIONG ADDRESS OF PROPER LENGTH COBOL WORD 28540021 * 28550021 ADTAB DC F'2' COBOL WORD TABLE BY LENGTH 28560021 DC A(COBWRD) COBOL WORD TABLE BY LENGTH 28570021 DC F'3' COBOL WORD TABLE BY LENGTH 28580021 DC A(COB3) 28590021 DC F'4' COBOL WORD TABLE BY LENGTH 28600021 DC A(COB4) 28610021 DC F'5' COBOL WORD TABLE BY LENGTH 28620021 DC A(COB5) 28630021 DC F'6' COBOL WORD TABLE BY LENGTH 28640021 DC A(COB6) COBOL WORD TABLE BY LENGTH 28650021 DC F'7' COBOL WORD TABLE BY LENGTH 28660021 DC A(COB7) COBOL WORD TABLE BY LENGTH 28670021 DC F'8' COBOL WORD TABLE BY LENGTH 28680021 DC A(COB8) COBOL WORD TABLE BY LENGTH 28690021 DC F'9' COBOL WORD TABLE BY LENGTH 28700021 DC A(COB9) COBOL WORD TABLE BY LENGTH 28710021 DC F'10' COBOL WORD TABLE BY LENGTH 28720021 DC A(COB10) COBOL WORD TABLE BY LENGTH 28730021 DC F'11' COBOL WORD TABLE BY LENGTH 28740021 DC A(COB11) COBOL WORD TABLE BY LENGTH 28750021 DC F'12' COBOL WORD TABLE BY LENGTH 28760021 DC A(COB12) COBOL WORD TABLE BY LENGTH 28770021 DC F'13' COBOL WORD TABLE BY LENGTH 28780021 DC A(COB13) COBOL WORD TABLE BY LENGTH 28790021 DC F'14' COBOL WORD TABLE BY LENGTH 28800021 DC A(COB14) COBOL WORD TABLE BY LENGTH 28810021 DC F'15' COBOL WORD TABLE BY LENGTH 28820021 DC A(COB15) COBOL WORD TABLE BY LENGTH 28830021 DC F'0' COBOL WORD TABLE BY LENGTH 28840021 DC A(TBEND) COBOL WORD TABLE BY LENGTH 28850021 EJECT 28860021 * 28870021 * SPECIAL CHARACTER TABLE 28880021 * 28890021 SPTBAD DC A(SPCTBL+24) ADDR OF LAST ITEM IN TABLE 28900021 * 28910021 SPCTBL DC X'7E' EQUAL 28920021 DC X'5006' ENCODE 28930021 DC X'5C' ASTERISK 28940021 DC X'5302' ENCODE 28950021 DC X'4D' LEFT PARENTHESIS 28960021 LPREN DC X'5200' ENCODE 28970021 DC X'5D' RIGHT PARENTHESIS 28980021 RPREN DC X'5201' ENCODE 28990021 DC X'61' SLASH 29000021 DC X'5303' ENCODE 29010021 DC X'4C' LESS THAN 29020021 DC X'500A' ENCODE 29030021 DC X'6E' GREATER THAN 29040021 DC X'5008' ENCODE 29050021 DC X'4E' PLUS 29060021 PLUSCD DC X'5300' ENCODE 29070021 DC X'60' MINUS 29080021 MINCD DC X'5301' ENCODE 29090021 * * * * * 29100021 EXPOKD DC X'5C5C' ** 'EXPONENTIATE' 29110021 EXPOCD DC X'5304' ENCODE 29120021 EJECT 29130021 * 29140021 *=1 GETDLM ROUTINE ID ENV DATA PR 29150021 * 29160021 GETDLM STM JP,JR,GDLRSV SAVE REGS 29170021 CLC CURCOD(LX2),EOSCON EOS 29180021 BC NOTEQ,GDL1 NO 29190021 BAL JP,GETWD GETWD 29200021 GDL1 NI MSG4SW,XXF3 SET 'OFF' MSG4SW + MSG1SW 29210021 BC UNCOND,GDLMAJ MAJOR 29220021 SKIP STM JP,JQ,GDLRSV SAVE REGS 29230021 OI MSG4SW,XX08 SET MSG4SW ON 29240021 BC UNCOND,GDLMAJ MAJOR 29250021 SKIPGT STM JP,JR,GDLRSV SAVE REGS 29260021 OI MSG4SW,XX08 SET 'ON' MSG4 SW 29270021 GDLGET BAL JP,GETWD GETWD 29280021 GDLMAJ TM CURCOD,XX30 MAJOR IS O 29290021 BNZ GDLMST NO 29300021 CLC CURCOD(LX2),EOSCON EOS 29310021 BC EQ,GDLGET YES 29320021 B GDL9 NO 29330021 GDLMST TM MSG4SW,XX08 TEST MSG4SW 29340021 BC ONES,GDLGET SWITCH ON 29350021 OI MSG4SW,XX08 SET MSG4SW ON 29360021 TM MSG1SW,XX04 MSG1SW 'ON' 29370021 BC ONES,GDLMS1 YES-GDLMS1 29380021 BAL JP,MSG4 MSG4 29390021 BC UNCOND,GDLGET GET NEXT WORD 29400021 GDLMS1 BAL JP,MSG1 MSG1 29410021 BC UNCOND,GDLGET -GDLGET 29420021 GDL9 LM JP,JR,GDLRSV 29430021 USING EXHSVB,JJ 29440021 CLI CURN,XXFF EOP 29450021 BE PROEND ALL OVER 29460021 DROP JJ 29470021 GDLXIT LM JP,JR,GDLRSV RESTORE REGS 29480021 BCR UNCOND,JP RETURN TO CALLER 29490021 EJECT 29500021 IKF105 CSECT 29510021 *=1 UNIT LEVEL SCAN 29520021 USING UNLVSN,JQ 29530021 USING LETTER,JJ 29540021 * 29550021 * UNIT LEVEL SCAN INITIALIZATION 29560021 * 29570021 * 29580021 * INITIALIZATION ROUTINE TO CONVERT SINGLE STROKE QUOTE MARK X'7D' 29590021 * TO DOUBLE STROKE QUOTE MARK X'7F' IN PHASE 1 29600021 * 29610021 UNLVSN DS 0H START OF UNIT LEVEL SCAN 29620021 *CHNGQT MVI TBQUT1+2,X'03' 29630021 * MVI TBQUT1,X'07' 29640021 * MVI SNGLQT,X'7F' 29650021 * BCR UNCOND,R14 29660021 SNGLQT DC X'7D' SINGLE QUOTE 29670021 * 29680021 * 29690021 * UNIT LEVEL SCAN OF SOURCE CARD 29700021 * 29710021 * 29720021 * IF LAST WORD WAS A NUM LIT, SAVE IT IN EXTERNAL FORM 'BCD W/SIGN' 29730021 * 29740021 GETWD2 OI GTRTSW,XX10 SET GET CD RETURN SW ON 29750021 STM R1,R15,GTCDSV SAVE GET CD REGS 29760021 LM R1,R15,GTWDSV RESTORE GETWD REGD 29770021 GTWORD MVC CURNUM(LX162),NXTNUM NXTFLD TO CUR-FLD 29780021 CLI NXTCOD,XX32 LAST WORD WAS NUM LIT 29790021 BC NOTEQ,ULSC1 NO-ULSC1 29800021 TM RWLTSW,XX02 IN RPT SCT 29810021 BC ZERO,NORPWT NO-NORPWT 29820021 TM CURSW,XX08 INT-NUM-LIT 29830021 BC ONES,NORPWT YES-NORPWT 29840021 TM VALXW,XX04 VALUE CLAUSE 29850021 BC ONES,NORPWT YES-NORPWT 29860021 BAL JP,MSG108 -MSG108 29870021 MVC CURN(LX4),INLONE MAKE INL OF ONE 29880021 NORPWT L R2,VALNLT ADDR OF UNPWKW 'FROM' 29890021 LA R1,CURXNL+NX1 ADDR OF CURXNL 'TO' 29900021 L R8,VALNLT+NX4 SIZE OF FIELD 29910021 STC R8,CURXNL STORE SIZE 29920021 EX R8,NLMOVE EX MOVE OF NUM LIT 29930021 * 29940021 * IF '*DEBUG' IS SET UP IN NXTCOD LEAVE UNIT LEVEL SCAN 29950021 * 29960021 ULSC1 TM DEBULS,XX04 *DEBUG 29970021 BC ZERO,ULSC12 NO-ULSC12 29980021 NI DEBULS,XXFB SET 'OFF' DEBULS 29990021 BC UNCOND,ULSOUT -ULSOUT 30000021 * 30010021 ULSC12 TM LCRDSW,XX20 ALL CARDS ARE READ 30020021 BC ONES,ULSOUT YES-ULSOUT 30030021 TM DBRDSW,XX01 DOUBLE BUFF FOR COPYR ? 30040021 BC NOTZER,ULSCR0 YES - SKIP LAST WD SAVE 30050021 TM SWBYTS+NX13,XX60 SKIP LASTWD SAVE 30060021 BM ULSCRG YES- SCAN CD 30070021 OI NWCDSW,XX40 SET NEW CD SW ON 30080021 BCTR R7,R0 ADDR OF COL 73 30090021 ULSGLS BCTR R7,R0 COL 72 30100021 CR R7,R5 IS CARD BLANK 8111 30110021 BL ULS13A YES-GO SKIP CARD 2689 30120021 CLI DX0(R7),XX40 BLANK ? 30130021 BE ULSGLS YES - TRY AGAIN 30140021 CLI DX0(R7),XX4B WD ENDING WITH PERIOD ? 30150021 BE ULSCR0 YES - DON'T SAVE IT 30160021 CLI DX0(R7),XX6B COMMA 30170021 BE ULSCR0 YES - DON'T SAVE LAST WD 30180021 OI LSTWSW,XX02 POSSIBLE LAST WORD SW 30190021 LA R4,DX1(R7) SAVE END ADDR 30200021 B ULSG2A SKIP DECREMENT 30210021 ULSGL2 BCTR R7,R0 NXT LOCATION AFTER NON-BLK 30220021 ULSG2A CLI DX0(R7),XX40 BLANK ? 30230021 BE ULSCR1 YES - BEGIN SAVE WD RT 30240021 CLC DX0(LX1,R7),SNGLQT QUOTE HIT 30250021 BNE ULSGL2 NO CONTINUE LOOP 30260021 B ULSCR0 YES - RESTORE COL74 IN R7 30270021 ULSCR1 LA R7,DX1(R7) BEGINNING ADDR 30280021 CR R7,R6 LAST WD IN A-MARGIN ? 30290021 BL ULSCR0 YES - NORMAL PROCESS 30300021 CLC DX0(LX8,R7),DIVKON DIVISION LAST WD ? 30310021 BE ULSCR0 YES - LEAVE ON CARD 30320021 CLC DX0(LX7,R7),SCTKON SECTION LAST WD 30330021 BE ULSCR0 YES - LEAVE ON CARD 30340021 SR R4,R7 DISPLACEMENT 30350021 STC R4,LASTWD STORE SIZE 30360021 BCTR R4,R0 SUBTRACT 1 FOR EX INSTR. 9610 30370021 EX R4,MVLSWD EX INSTR. TO SAVE LAST WORD 9610 30380021 B ULSCRG SKIP INST. 30390021 MVLSWD MVC LASTWD+NX1(DX0),DX0(R7) SAVE LAST WORD 9610 30400021 ULSCR0 L R7,SETREG+NX8 R7 SET TO COL 74 30410021 * 30420021 * SCAN TO NEXT UNIT ON CARD 30430021 * 30440021 ULSCRG SR R2,R2 ZERO REG 30450021 SR R1,R1 CLEAR REG 30460021 TRT DX0(LX80,R5),UNONB SCAN TO NON-BLANK 30470021 ST R1,NBLPTR SAVE ADDR 30480021 LR R5,R1 SAVE ADDR OF NON-BLANK 30490021 CR R1,R7 IS IT IN COL-74 30500021 BC LO,ULSC1A NO-ULSC1A 30510021 TM CDSURP,XX80 CARD SURPRESS SW ON 30520021 BC ZERO,ULS13A NO - CONTINUE 30530021 NI CDSURP,XX7F SET SW OFF 30540021 B ULSOUT RETURN TO CALLING 30550021 ULS13A NI NWCDSW,XXBF SET NEW CD SW OFF 30560021 TM SKCDSW,XX20 SW ON 30570021 BC ZERO,ULSC13 NO - GTCARD 30580021 NI SKCDSW,XXDF YES - SET SW OFF 30590021 LM R5,R7,SETREG SET UP REGS FOR NEW CD SCN 30600021 MVC COMWRK(LX80),SAVECD RESTORE CARD 30610021 TM CON2SW,XX80 CONTINUE SW ON 30620021 BC ZERO,ULSC14 NO - SCAN CD 30630021 NI CON2SW,XX7F YES- SET SW OFF 30640021 L R5,SKCTAD YES - NEXT POSITION ON CD 30650021 B ULSC14 RESET NON-BLANK SW 30660021 ULS13B NI SWBYTS+NX13,XX1F SET OFF CON2SW, NWCDSW, SKC 30670021 ULSC13 MVC IDCOPY(LX2),COMWRK+NX74 SAVE POSSIBLE COPY STMT ID 30680021 BAL R14,GTCARD -GTCARD 30690021 TM MSGPSW,XX08 COMMENTS IN ID DIV 30700021 BC NOTZER,ULSC14 YES - SKIP IF AREA A BLANK 30710021 C R7,NBLPTR COL 74 HIT 30720021 BE ULSC14 YES - ALPHA LITERAL OR A-MA 30730021 BCTR R5,R0 SET POINTER TO COL 7 30740021 CLI DX0(R5),XX60 HYPEN IN COL 7 30750021 BNE STSKSW NO - SKIP SW SET 30760021 OI CON2SW,XX80 YES - SET CONTINUE SWITCH O 30770021 STSKSW OI SKCDSW,XX20 SET SKIP CD SW ON 30780021 LA R5,DX1(R5) SET R5 BACK TO COL 8 30790021 MVC SAVECD(LX80),COMWRK SAVE CARD 30800021 MVI COMWRK,XX40 BLANK OUT 30810021 MVC COMWRK+NX1(LX79),COMWRK COMWRK AREA 30820021 MVC COMWRK+NX72(LX2),KQUOTE DELIMIT FOR TRT 2689 30830021 SR R4,R4 CLEAR REG 30840021 IC R4,LASTWD SIZE OF SAVED WD 30850021 BCTR R4,R0 REDUCE LAST WD SIZE BY 1 30860021 EX R4,LSTCRD MOVE IT TO COL 12 OF COMWRK 30870021 TM CON2SW,XX80 CONTINUE SW ON ? 30880021 BC ZERO,ULSC14 NO - SCAN PHONEY CARD 30890021 TRT SAVECD+NX7(LX81),UNONB SCAN TO FIRST WD ON CD 30900021 LA R2,SAVECD+NX11 ADDR OF COL 12 30910021 CR R1,R2 IN A-MARGIN 30920021 BNL COL74T NO - SKIP MSG 30930021 BAL JP,MSG160 CONT WD IN A-MARGIN 30940021 CDBLAK NI CON2SW,XX7F SET OFF CONTINUE SW 30950021 B ULSC14 BEGIN NEW SCAN OF PHONEY CD 30960021 * 30970021 COMPWD MVC DX0(LX0,R2),DX0(R3) CONT WD TO COMWRK 30980021 LSTCRD MVC DX0(LX0,R6),LASTWD+NX1 LASTWD TO COMWRK 30990021 * 31000021 COL74T LA R2,SAVECD+NX73 ADDR OF COL 74 IN CD SAVE 31010021 CR R1,R2 COL 74 HIT ? 31020021 BNL CDBLAK YES - CARD IS BLANK 31030021 LR R3,R1 SAVE ADDR 31040021 BAL JP,NOLDHI SET UP TABLE FOR NON D,L,H 31050021 TRT DX0(LX80,R1),NONLDH SCAN TO NON DIGIT, LETTER, 31060021 BAL JP,NOLDHO RESET 31070021 LR R0,R1 END OF CONTINUATION 31080021 SR R1,R3 SIZE OF CONTINUATION 31090021 LA R2,DX1(R4,R6) ENDING ADDR OF CONTINUED WD 31100021 LR JP,R2 JP=ADDR COMWRK RECEIV.FLD 31110021 AR JP,R1 JP=END ADDR RECEIVING FLD 31120021 LA JP,DX1(JP) SETREG+1 IS 1 GT A(COL73) 31130021 C JP,SETREG+NX8 END SPILL OVER COMWRK? 31140021 BL COL74U NO-CONTINUE 31150021 S JP,SETREG+NX8 JP=AM'T EXCESS 31160021 SR R1,JP ADJUST LENGTH 31170021 MVC COMWRK+NX72(LX2),KQUOTE DELIMIT FOR TRT 31180021 COL74U EX R1,COMPWD MOVE CONT. TO COMWRK 31190021 LA R2,SAVECD BEGIN ADDR 31200021 SR R0,R2 DISPLACE IN WORK 31210021 LA R2,COMWRK+NX1 COMWRK ADDR 31220021 AR R2,R0 POINTER TO NXT POSITION ON 31230021 ST R2,SKCTAD SAVE PTR 31240021 ULSC14 NI CURSW,XXFB RESET NON-BLANK SW 31250021 BC UNCOND,ULSC1 -ULSC1 31260021 ULSC1A NI NXTSW,XX00 RESET SWITCHES IN NXTSW 31270021 CR R1,R6 IS WORD IN A-MARGIN 31280021 BC NOTLO,ULSC1B NO-ULSC1B 31290021 OI NXTSW,XX01 SET A-MARGIN SW 'ON' 31300021 B ULSC2A CONTINUE 31310021 ULSC1B TM MSGPSW,XX08 MSGPSW 'ON' 31320021 BC ONES,ULS13B NO - ULS13B 31330021 * 31340021 ULSC2A SLA R2,DX2 MULT CODE FROM UNONB TABLE BY 4 31350021 BC UNCOND,TRNSFR-NX4(R2) -BR TO APPROPRIATE ROUTINE 31360021 * 31370021 BC UNCOND,ULSC1 LINKAGE BACK TO SCAN 31380021 TRNSFR BC UNCOND,LETTER THIS 31390021 BC UNCOND,DIGIT IS 31400021 BC UNCOND,QUOTE A 31410021 BC UNCOND,PERIOD PERIOD SCAN RTN 31420021 BC UNCOND,SIGN SIGN SCAN RTN 31430021 BC UNCOND,SPECL SPEC CHAR SCAN RTN 31440021 BC UNCOND,ILLEGL ILLEGAL CHAR SCAN RTN 31450021 BC UNCOND,COMMA COMMA SCAN RTN 31460021 NLMOVE MVC DX0(LX0,R1),DX0(R2) EX-MOVE 31470021 EJECT 31480021 * 31490021 * GET NEXT CARD 31500021 * 31510021 GTCMCD1 NI CMNTCDSW,XXFD TURN OFF DELETING A COMMENT CARD SW 31520021 BC UNCOND,GTCMCD CONTINUE PROCESSING 31530021 GTCARD ST JP,GETCSV SAVE LINK REG 31540021 GTCMCD L R8,COSADR ADDR OF COS 31550021 TM EOFSW,XX01 END OF SOURCE FILE 31560021 BO REDLC2 YES - FILL NEXT 31570021 NI CURSW,XXFB RESET NONBLANK SW 31580021 TM DATCSW,XX02 DATE-COMP SW 'ON' 31590021 BC ONES,GTLAST YES-GTLAST 31600021 MVC SVCCRD+NX72(LX2),TWOTRE RESTORE 2 BYTES 31610021 TM FXCDSW,XX02 IS IT FIRST CARD 31620021 BO GTLAST YES 31630021 LR R1,R8 PHZSW1 ADDRESSABILITY 31640021 TM PHZSW,LIBR BASIS/COPY? 31650021 BO GTLAST SOURCE WRITTEN BY PRE-PR 31660021 * CARD TO PRINT AREA 31670021 LA R2,SVCGCN ADDR OF CARD 31680021 LA R3,DX88(JR) SIZE 31690021 BALR R0,R8 CARD TO 31700021 DC X'16' PRINT 31710021 * PRINT CARD 31720021 BALR R0,R8 PRINT 31730021 DC X'86' CARD 31740021 * 31750021 * 31760021 GTLAST DS 0H 31770021 L R8,COSADR ADDRESS OF COS 31780021 LR R1,R8 PHZSW1 ADDRESSABILITY 31790021 TM LCDXSW,XX20 NO MORE CARDS 31800021 BC ONES,REDLCD YES 31810021 TM PHZSW,LIBR BASIS/COPY? 31820021 BZ REGRED NO 31830021 TM FXCDSW,XX02 IS IT FIRST CARD 31840021 BNO GTLAST2 NO - GET RECORD PTR 31850021 GTLAST1 BALR R0,R8 READ INPUT FROM FILE 4 31860021 DC X'04' X 31870021 BZ REDLCD LAST CARD READ 31880021 LR R4,R0 R4 = ADDR RECORD 31890021 ST R4,SVF4PTR SAVE RECORD PTR 31900021 GTLAST2 L R4,SVF4PTR GET RECORD PTR 31910021 CLI DX0(R4),XXFF END OF BUFFER FILE 4 31920021 BE GTLAST1 READ FILE 4 31930021 MVC COMWRK(LX80),DX0(R4) MOVE TO WORKAREA 31940021 NI LSTWSW,XXFD NOT LAST SW OFF 31950021 LA R4,LX80(R4) POINT NEXT LOGICAL RECORD 31960021 ST R4,SVF4PTR SAVE RECORD PTR 31970021 MVC NXTGCN(LX2),COMWRK+XX4E INT SEQ NUMBER 31980021 LH R1,NXTGCN GET GCN FROM NXTGCN 31990021 CVD R1,SVCPCK FOR SOURCE STATISTICS 32000021 SR R1,R1 CLEAR REG1 FOR TRT 32010021 TRT COMWRK(LX80),UNONB SCAN TO NON BLANK 32020021 CLC DX0(LX6,R1),DEBKON IS IT DEBUG 32030021 BE REGRD1A PROCESS DEBUG CARD 32040021 B REGRED6A WRAP UP 32050021 * 32060021 SVF4PTR DS F FILE 4 RECORD PTR 32070021 * 32080021 * 32090021 * READ SYSIN CARD - NO BASIS LIBRARY 32100021 * 32110021 REGRED BALR R0,R8 READ CARD 32120021 DC X'75' FROM SYSIN 32130021 BC NOTZER,REGRD1 NOT LAST CARD - REGRD1 32140021 * 32150021 REDLCD TM LSTWSW,XX02 POSSIBLE LAST WORD ? 32160021 BNO REDLC2 SET LCRDSW ON 32170021 OI NWCDSW,XX40 SKIP LASTWD SAVE 32180021 L R7,SETREG+NX8 COL 74 SET 32190021 ST R7,NBLPTR SAVE IT 32200021 OI EOFSW,XX01 SET OFF 32210021 MVC COMWRK+NX72,KQUOTE STOPPER FOR LAST CARD 341 32220021 B REG7RT EXIT TO GETWD 32230021 REDLC2 DS 0H 32240021 OI LCRDSW,XX20 LAST CD SET ON 32250021 MVC NXTCOD(LX3),EOPCON SETUP EOPCON IN NEXT 32260021 MVI NXTSW,XX01 SET 'ON' NXTSW 32270021 MVC NXTGCN(LX2),HWZERO ZERO NXTGCN 32280021 BC UNCOND,ULSOUT -ULSOUT 32290021 * 32300021 REGRD1 LR R4,R0 ADDR OF CARD IN BUFFER 32310021 NI LSTWSW,XXFD NOT LAST SW OFF 32320021 MVC MAINWK(LX80),DX0(R4) CARD TO MAINWK 32330021 MVC COMWRK(LX80),DX0(R4) 32340021 TM FXCDSW,XX02 FIRST CARD READ 32350021 BC ONES,REGR5A YES-REGR5A 32360021 BAL JP,SKPEJT CHECK FOR SKIP OR EJECT 32370021 SR R1,R1 CLEAR R1 FOR TRT 8922 32380021 TRT COMWRK(LX80),UNONB SCAN TO NON BLANK 32390021 CLC DX0(LX6,R1),DEBKON IS IT DEBUG? 0335 32400021 BC NOTEQ,REGRD2 NO-REGRD2 32410021 REGRD1A OI DEBEOS,XX0C SET ON DEBEOS AND DEBULS 32420021 ST R5,DEBR5 SAVE REGISTER 5 8922 32430021 L R5,ADEBRTN BASE REG FOR DEBRTN 8922 32440021 BALR JP,R5 DEBUG COL INDEP RTNE 8922 32450021 L R5,DEBR5 RESTORE REGISTER 5 8922 32460021 MVC MAINWK(LX80),COMWRK 8922 32470021 MVC NXTNUM(LX12),BUGCON BLANK SEQ-NUM, CNT+WORD TO N 32480021 MVI NXTSW,XX00 RESET NXTSW 32490021 MVC NXTCOD(LX3),DEBCON CODE TO NXTCOD 32500021 L R1,COSADR ADDRESS OF COS 32510021 TM PHZSW,LIBR INPUT FROM PREPROCESSOR 32520021 BO REGRED6A YES - RETURN 32530021 MVC NMLST5(LX6),NMCRD4 SET UP LAST SEQ-NUM 32540021 MVC NMCRD4(LX6),UBLNK MAKE SEQ-NUM BLANK 32550021 B REGRD4 -REGRD4 32560021 * 32570021 REGRD2 MVC NMLST5(LX6),NMCRD4 SET UP LAST SEQ-NUM 32580021 MVC NMCRD4(LX6),DX0(R4) SET UP NEW SEQ-NUM 32590021 * 32600021 * 32610021 REGRD4 CLC NMCRD4(LX6),UBLNK SEQ-NUM BLANK 32620021 BC EQ,REGR5A YES-REGR5A 32630021 CLC NMCRD4(LX6),SVCSEQ IN SEQUENCE 32640021 BC HI,REGRD5 YES-REGRD5 32650021 L R2,COSADR ADDR OF COS 32660021 TM PHZSW-COS(R2),SEQ 32670021 BC ZERO,REGRD5 NO 32680021 LH R1,SEQERR-COS(R2) 32690021 LA R1,DX1(R1) COUNT OF 32700021 STH R1,SEQERR-COS(R2) 32710021 MVC MAIMOV(LX2),EXPOKD PUT SEQ ERROR SYMBOL IN LINE 32720021 REGRD5 MVC SVCSEQ(LX6),NMCRD4 SAVE NEW SEQUENCE NUMBER 32730021 REGR5A MVC COMMOV(LX82),MAIMOV MAIMOV TO COMMOV 32740021 MVC MAIMOV(LX2),UBLNK CLEAR SEQ-ERR SYMBOL 32750021 REGR5B DS 0H 32760021 BAL JP,SKPEJT CK FOR SKIP OR EJECT 32770021 L JP,GETCSV 32780021 * 32790021 REGRD6 AP SVCPCK+NX4(LX4),SVCINC INCREASE GEN-NUM 32800021 UNPK SVCUPK(LX8),SVCPCK+NX4(LX4) SET-UP GEN IN SAVE AREA 32810021 OI SVCUPK+NX7,XXF0 GET RID OF SIGN 32820021 CVB R1,SVCPCK CONVERT TO BINARY 32830021 STH R1,NXTGCN STORE GCN IN NXTGCN 32840021 REGRED6A MVC TWOTRE(LX2),SVCCRD+NX72 SAVE 2 BYTES 32850021 REGRD7 MVC COMWRK+NX72(LX2),KQUOTE BLANK + QUOTE TO COL 73 + 7 32860021 LM R5,R7,SETREG SET UP REG FOR COL 8-12-74 32870021 STM R1,R7,SAVREG SET-UP SAVE AREA FOR NEW CA 32880021 TM REPSW,XX08 REPLACING OPTION ? 32890021 BC NOTZER,DX0(JP) YES - RETURN TO POINT OF CA 32900021 TM CMNTCDSW,XX02 DELETING A COMMENT CARD 32910021 BO GTCMCD1 YES GET NEXT CARD 32920021 REG7RT L JP,GETCSV RESTORE LINK REG 32930021 BCR UNCOND,JP -RETURN 32940021 * 8922 32950021 * 8922 32960021 DEBR5 DC F'0' R5 SAVE AREA 8922 32970021 ADEBRTN DC A(DEBRTN) DEBUG COLUMN INDEP. 8922 32980021 * 32990021 *** THIS ROUTINE CHECKS FOR SKIP1, SKIP2, SKIP3 33000021 *** EJECT, OR '*'(COMMENTS) IN COL 7. 33010021 * 33020021 SKPEJT NI CMNTCDSW,XXFD AVOID LOSS OF PREVIOUS 33030021 CLI COMWRK+NX6,XX5C ASTERISK IN COL 7 33040021 BNE SKPTRT NO - CK FOR SKP - EJECT 33050021 OI CMNTCDSW,XX02 TURN ON DELETING A CARD SW 33060021 B DX0(JP) RETURN TO CALLING ROUTINE 33070021 SKPTRT DS 0H 33080021 LA R5,COMWRK+NX72 SET COL 73 LIMIT 33090021 TRT COMWRK+NX7(LX80),UNONB SCAN TO NON BLANK 33100021 CR R1,R5 PAST COL 73 33110021 BNL DX0(JP) BLANK CARD 33120021 LR R3,R1 SAVE BEGIN ADDR 33130021 LA R1,DX5(R1) SKIPN OR EJECT LENGTH 33140021 TRT DX0(LX80,R1),UNONB SCAN TO NON BLANK 33150021 CR R1,R5 CARD BLANK ? 33160021 BL 0(JP) NO - RETURN TO CALLING 33170021 CLC DX0(LX5,R3),EJCON EJECT HIT ? 33180021 BE PEJECT YES - CALL TO EJECT 33190021 CLC DX0(LX5,R3),SK1CON SKIP1 HIT 33200021 BE PSKIP1 YES - CALL TO SKIP 1 LINE 33210021 CLC DX0(LX5,R3),SK2CON SKIP2 HIT 33220021 BE PSKIP2 YES - CALL TO SKIP 2 LINES 33230021 CLC DX0(LX5,R3),SK3CON SKIP3 HIT 33240021 BNE 0(JP) NO -RETURN TO CALLING 33250021 * 33260021 ST JP,SKEJSAVE SAVE RETURN REGISTER 46150 33270021 BAL JP,TESTLIST CHECK FOR NOSOURCE 46150 33280021 L JP,SKEJSAVE RESTORE JP 46150 33290021 BALR R0,R8 SKIP 33300021 DC X'D603' 3 LINES 33310021 B GTLAST GET ANOTHER CARD 33320021 * 33330021 PSKIP2 ST JP,SKEJSAVE SAVE RETURN REGISTER 46150 33340021 BAL JP,TESTLIST CHECK FOR NOSOURCE 46150 33350021 L JP,SKEJSAVE RESTORE JP 46150 33360021 BALR R0,R8 SKIP 46150 33370021 DC X'D602' 2 LINES 33380021 B GTLAST GET ANOTHER CARD 33390021 * 33400021 PSKIP1 ST JP,SKEJSAVE SAVE RETURN REGISTER 46150 33410021 BAL JP,TESTLIST CHECK FOR NOSOURCE 46150 33420021 L JP,SKEJSAVE RESTORE JP 46150 33430021 BALR R0,R8 SKIP 46150 33440021 DC X'D601' 1 LINES 33450021 B GTLAST GET ANOTHER CARD 33460021 * 33470021 PEJECT ST JP,SKEJSAVE SAVE RETURN REGISTER 46150 33480021 BAL JP,TESTLIST CHECK FOR NOSOURCE 46150 33490021 L JP,SKEJSAVE RESTORE JP 46150 33500021 BALR R0,R8 EJECT 46150 33510021 DC X'D600' PAGE 33520021 B GTLAST GET ANOTHER CARD 33530021 ***** 46150 33540021 TESTLIST LR R8,R1 SAVE R1 46150 33550021 L R1,COSADR SET UP COMMON ADDRESSABILITY 46150 33560021 TM PHZSW,LIST NOSOURCE? 46150 33570021 LR R1,R8 RESTORE R1 46150 33580021 L R8,COSADR RESTORE R8 46150 33590021 BCR ONES,JP SOURCE - HONOR SK/EJ REQUEST 46150 33600021 L JP,SKEJSAVE RESTORE JP 46150 33610021 B GTLAST NOSOURCE - GET ANOTHER CARD 46150 33620021 * 46150 33630021 SKEJSAVE DC F'0' SAVEAREA FOR JP 46150 33640021 ***** 46150 33650021 * 33660021 * 33670021 SETREG DC A(COMWRK+7) ADDR OF COL 8 33680021 DC A(COMWRK+11) ADDR OF COL 12 33690021 DC A(COMWRK+73) ADDR OF COL 74 33700021 SIDEND DC A(SIDEWK+73) ADDR OF CCOL 74 33710021 * 33720021 NMLST5 DC 3H'0' NUMBER OF OLD MAIN CARD 33730021 * 33740021 * 33750021 MAIMOV DC X'4040' CARD IDENT FOR 33760021 MAINWK DS CL80 MAIN CARD WORK AREA 33770021 * 33780021 * 33790021 EJECT 33800021 * 33810021 * ROUTINE TO CONVERT EXTERNAL FLOATING POINT NUMBER TO 33820021 * INTERNAL PLOATING POINT 33830021 * 33840021 * 33850021 FLOPNT LA R4,FLPWK ADDR OF FLPWK 33860021 ST R5,REGWRK SAVE PTR TO START OF WORD 33870021 ST R3,REGWOK SAVE PTR TO DECIMAL 33880021 ST R1,REGWEK SAVE PTR TO 'E' 33890021 MVI DX0(R4),XX4E SET UP 1ST PLUS SIGN 33900021 TM SIGNSW,XX01 HAS FLO-PT-NUM A SIGN 33910021 BC ZERO,FLPNTA NO-FLPNTA 33920021 MVC DX0(LX1,R4),DX0(R5) PUT MANTIS SIGN IN FLPWK 33930021 LA R5,DX1(R5) MOVE PTR PAST SIGN OF WORD 33940021 FLPNTA LA R4,DX1(R4) MOVE PTR PAST SIGN OF FLPWK 33950021 SR R1,R5 CALC LENGTH OF MANTIS W/O S 33960021 CL R1,K17 IS MANTIS GREATER THAN 16 33970021 BC NOTHI,FLPTA1 NO-FLPTA1 33980021 BAL R14,MSG70 -MSG70 33990021 IC R1,K17+NX3 SET SIZE TO 16 34000021 FLPTA1 EX R1,FLOMOV PUT MANTIS IN FLPWK 34010021 AR R4,R1 MOVE PTR PAST MANTIS IN FLP 34020021 L R1,REGWEK PTR TO 'E' 34030021 MVI DX0(R4),XX4E SET UP 2ND PLUS SIGN 34040021 SR R1,R3 CALC NUMBER- 34050021 BCTR R1,JR OF DECIMALS 34060021 STC R1,DECSIZ STORE IN DECSIZ 34070021 L R1,REGWEK PTR TO 'E' 34080021 TRT DX1(LX1,R1),UDIGT IS CHAR AFTER 'E' A DIGIT 34090021 BC EQ,FLPNTD YES-FLPNTD 34100021 CLI DX0(R1),XX4E IS IT A PLUSSIGN 34110021 BC EQ,FLPNTC YES-FLPNTC 34120021 CLI DX0(R1),XX60 IS IT A MINUS SIGN 34130021 BC EQ,FLPNTB YES-FLPNTB 34140021 BAL JP,MSG73 -MSG73 34150021 SH R1,HWTWO SET PTR IN FRONT OF 'E' 34160021 FLPTA2 L R3,REGWOK SET PTR TO DECIMAL 34170021 CR R1,R3 IS PTR R1 AT DECIMAL 34180021 BC EQ,FLPTA3 YES-FLPTA3 34190021 LA R1,DX1(R1) MOVE PTR PAST LAST DIGIT 34200021 FLPTA3 L R5,REGWRK SET PTR TO START OF LITERAL 34210021 BC UNCOND,NUMLIT -NUMLIT 34220021 * 34230021 FLOMOV MVC DX0(LX0,R4),DX0(R5) 34240021 * 34250021 FLPNTB MVI DX0(R4),XX60 PUT EXP SIGN IN FLPWK 34260021 FLPNTC TRT DX1(LX1,R1),UDIGT IS CHAR AFTER SIGN A DIGIT 34270021 BC EQ,FLPNTD YES-FLPNTD 34280021 BAL JP,MSG74 -MSG74 34290021 SH R1,HWTHRE SET PTR IN FRONT OF 'E' 34300021 BC UNCOND,FLPTA2 -FLPTA2 34310021 * 34320021 FLPNTD LA R4,DX1(R4) MOVE PTR PAST SIGN OF WORK 34330021 LA R1,DX1(R1) MOVE PTR TO 1ST EXP DIG WD 34340021 ST R1,REGWEK SAVE PTR TO 1ST EXP DIG WO 34350021 TRT DX0(LX80,R1),UDIGT SCAN TO NON-DIGIT 34360021 CLI DX0(R1),XX40 NON-DIGIT IS A BLANK 34370021 BC EQ,FLPTD1 YES-FLPTD1 34380021 CLI DX0(R1),XX4B NON-DIGIT IS A PERIOD 34390021 BC EQ,FLPTD1 YES-FLPTD1 34400021 CLI DX0(R1),XX6B NON-DIGIT IS A COMMA 34410021 BC EQ,FLPTD1 YES-FLPTD1 34420021 CLI DX0(R1),XX5D NON-DIGIT IS A RIGHT PAREN 34430021 BC EQ,FLPTD1 YES-FLPTD1 34440021 BAL R14,MSG72 -MSG72 34450021 FLPTD1 LR R3,R1 CALC NUMBER 34460021 L R1,REGWEK OF DIGITS 34470021 SR R3,R1 IN EXP 34480021 CL R3,K2 SIZE EQUALS--- 34490021 BC EQ,FLPNTE 2-FLPNTE 34500021 BC LO,FLPNTF 1-FLPNTF 34510021 BAL JP,MSG71 -MSG71 34520021 * 34530021 FLPNTE MVC DX0(LX2,R4),DX0(R1) PUT 2 DIGIT EXP IN FLPWK 34540021 LA R1,DX2(R1) MOVE PTR PAST 2ND DIGIT WO 34550021 BC UNCOND,FLPNTG -FLPNTG 34560021 * 34570021 FLPNTF MVI DX0(R4),XX00 MOVE IN BYTE OF ZERO 34580021 MVC DX1(LX1,R4),DX0(R1) FOLLOWED BY 1 DIG EXP FLP 34590021 LA R1,DX1(R1) MOVE PTR PAST EXP DIG WORD 34600021 * 34610021 FLPNTG LA R4,DX2(R4) MOVE PTR PAST EXP DIG IN FL 34620021 LA R3,FLPWK ADDR OF START OF WORK 34630021 SR R4,R3 CALC SIZE OF FL-PT-NUM 34640021 STC R4,TOTSIZ STORE IN TOTSIZ 34650021 L R5,REGWRK RESTORE PTR TO START OF WOR 34660021 STM R1,R8,SAVREG SAVE REGS 1-8 34670021 TM NOTESW,XX02 IS NOTE SW ON 10 34680021 BC ONES,EXITC YES 10 34690021 LA R6,DECSIZ ADDR OF PARAM 34700021 * 34710021 * THIS ROUTINE CONVERTS AN EXTERNAL FLOATING POINT NUMBER INTO 34720021 * AN INTERNAL FLOATING POINT NO IN FPREG 0 - DBL PRFC 34730021 * REGISTER USAGE IS AS FOLLOWS 34740021 * R0 - BINARY INTERMEDIATE 34750021 * R1 - OR FINAL RESULT 34760021 * R2 - EFP EXPONENT 34770021 * R3 - POINTER TO EFP NO 34780021 * R4 - WORK FOR LENGTHS OF EXECUTED MOVES 34790021 * R5 - POINTER TO WORKB 34800021 * R6 - POINTER TO WORKA 34810021 * R7 - WORK 34820021 * R8 - WORK 34830021 * R9 - WORK 34840021 * 34850021 * 34860021 * IT IS ESSENTIALLY IDENTICAL TO OBJECT-TIME SUBROUTINE IHDFEFIF 34870021 * CODING FROM 'SR 8,8' TO EXITA1 IS FROM EFIF 34880021 * EXITA1 EXITB EDBI 34890021 * EXITB TOOBIG BIIF 34900021 * 34910021 * 34920021 * INITIALIZATION ROUTINE TO DEVELOP FLOATING POINT PARAMFIERS 34930021 * 34940021 SR JH,JH CLEAR WORK REG 34950021 IC JH,DX0(JF) MANTISSA DECIMALS 34960021 STH JH,MANDEC(JN) STORE 34970021 IC JH,DX1(JF) TOTAL EFP LENGTH 34980021 STH JH,TOTLNG(JN) STORE 34990021 SH JH,H5 SUBTR 5 FROM TOT LENGTH 35000021 TM DX2(JF),XX01 TEST REAL DEC PT 35010021 BC R1,*+NX8 REAL PT 35020021 LA JH,DX1(JH) IMPLIFD - ADD 1 BACK IN 35030021 STH JH,MANLEN(JN) STORE MANTISSA LENGTH 35040021 SH JH,MANDEC(JN) SUBTR NO. OF DECIMALS 35050021 STH JH,MANINT(JN) STORE NO. OF INTEGERS 35060021 IC JH,DX3(JF) DECIMALS IN ID OR BI NO. 35070021 STH JH,RESDEC(JN) STORE RESULT DECIMALS 35080021 * 35090021 * ROUTINE TO MOVE EFP MANTISSA TO WORKB - 16 BYTES 35100021 * 35110021 LR JH,JC SAVE POINTER-TO EFP 35120021 LA JC,DX1(JC) PNTR TO FIRST DIG OF MANT 35130021 LA JE,WORKB+NX16(JN) PNTR TO BYTE AFTER WORKB 35140021 SH JE,MANLEN(JN) SUBTR MANT LENGTH 35150021 LR JG,JE SAVE POINTER TO WORKB MANT 35160021 TM DX2(JF),XX01 TEST FOR REAL DEC PT. 35170021 BC R1,REALDC YES 35180021 SUBMV LH JD,MANLEN(JN) NO - LOAD MANLEN 35190021 BCTR JD,JR SUBTR 1 TO EX 35200021 MOVE EX JD,MVTOB MOVE MANT TO WORKB 35210021 BC R15,RESTOR GO CONVERT EXP 35220021 REALDC CLC DX0(LX1,JC),KDECML IS FIRST CHAR A DEC PT 35230021 BC R7,INDEC NO - DEC PT IS IMBEDDED 35240021 MOVESB LA JC,DX1(JC) MV PNTR PAST DEC PNT. 35250021 BC R15,SUBMV GO MOVE 35260021 INDEC LH JD,MANINT(JN) LOAD NO. OF INTEGERS 35270021 LTR JD,JD 35280021 BC R8,HERE IF ZERO - GO TEST FOR DECIMAL 35290021 BCTR JD,JR SUBTR 1 TO EX 35300021 EX JD,MVTOB MOVE MANT TO WORKB 35310021 HERE CLI MANDEC+NX1(JN),XX00 TEST ZERO DECIMALS 35320021 BC R8,RESTOR YES 35330021 AH JE,MANINT(JN) INCR WORKB POINTER 35340021 LH JD,MANDEC(JN) LOAD NO OF DECIMALS 35350021 AH JC,MANINT(JN) INCREMENT EFP POINTER 35360021 LA JC,DX1(JC) TO DECIMAL PART 35370021 BCTR JD,JR SUBTR 1 TO EX 35380021 BC R15,MOVE GO MOVE DEC PART 35390021 * 35400021 MVTOA MVC DX0(LX0,R6),DX0(JE) MOVE FROM B TO A 35410021 MVTOB MVC DX0(LX0,JE),DX0(JC) MOVE EFP MANT OT WORKB 35420021 * 35430021 RESTOR LR JC,JH RESTORE POINTER TO EFP MANT SIGN 35440021 LR JE,JG RESTORE POINTER TO FIRST BYTE IN WO 35450021 * 35460021 * ROUTINE TO CONVERT EFP EXPONENT TO SIGNED INTEGER IN GP REG 2 35470021 * 35480021 AH JH,TOTLNG(JN) POINT TO BYTE AFTER EFP 35490021 SH JH,H2 POINT TO FIRST DIG OF EXP. 35500021 PACK WORKA(LX8,JN),DX0(LX2,JH) PACK EXP 35510021 BCTR JH,JR POINT TO SIGN 35520021 NI WORKA+NX7(JN),XXFC MAKE SIGN POS 35530021 CVB JB,WORKA(JN) CONV EXP TO BIN 35540021 CLI DX0(JH),XX60 TEST FOR NEG 35550021 BC R7,EXITA POS - EXITA 35560021 LNR JB,JB MAKE NEG 35570021 * 35580021 EXITA SH JB,MANDEC(JN) SUBTR MANT DECIMALS FROM EXP 35590021 LA JF,WORKA+NX18(JN) LOAD ADDR OF WORKA END 35600021 SH JF,MANLEN(JN) POINT TO FIRST DIGIT OF MANT IN WORK 35610021 LH JD,MANLEN(JN) LOAD LENGTH TO EXECUTE MOVE TO WORKA 35620021 BCTR JD,JR SUBTR 1 TO EX 35630021 MVI WORKA(JN),XXF0 INIT WORKA A 35640021 MVC WORKA+NX1(LX17,JN),WORKA(JN) TO ZERO 35650021 EX JD,MVTOA MOVE MANT OT WORKA 35660021 NI WORKA+NX17(JN),XXCF MAKE SIGN PLUS 35670021 CLI DX0(JC),XX60 TEST FOR ACTUAL MINUS 35680021 BC R7,EXITA1 NO - PLUS - EXITA 35690021 OI WORKA+NX17(JN),XX10 NEG 35700021 * 35710021 * THIS ROUTINE CONVERTS AN 18 BYTE EXTERNAL DECIMAL NUMBER INTO A 35720021 * DOUBLE PRECISION BINARY NUMBER IN REGS 0,1. THE DEC FIELD STARTS 35730021 * THE DECIMAL FIELD STARTS IN WORKA(13) 35740021 * 35750021 EXITA1 PACK WORKA3(LX8,JN),WORKA2+NX1(LX9,JN) PACK LO-ORD 9 DIGITS 35760021 PACK WORKA2(LX8,JN),WORKA(LX9,JN) PACK HI-ORD 9 DIGS 35770021 MVN WORKA2+NX7(LX1,JN),WORKA3+NX7(JN) MOVE SIGN TO HI-ORD FI 35780021 COMMON ST JB,SVREG2(JN) SAVE REG2 35790021 CVB JA,WORKA2(JN) CONV HI-ORD 9 DIGS 35800021 CVB JB,WORKA3(JN) CONV LO-ORD 9 DIGS 35810021 M JR,TNPW9 MULT HI-ORD 9 DIGS BY 10 **9 IN REGS 35820021 LTR JB,JB IF 9 TRAILING ZEROES, ALL DONE 35830021 BC ZERO,EXITB FINISHED - RESTORE REG 2 35840021 ALR JA,JB ADD IN LO-ORD 9 DIGS 35850021 BC R12,*+NX8 NO CARRY OUT 35860021 AH JR,H1 CARRY OUT - ADD 1 TO HI-ORDER 35870021 TM WORKA3+NX7(JN),XX01 IS SIGN MINUS 35880021 BC R14,EXITB NO - ALL DONE 35890021 SH JR,H1 NEG - SUBTR 1 35900021 EXITB L JB,SVREG2(JN) RESTORE REG 2 35910021 * 35920021 * THIS CONVERTS THE BINARY NUMBER IN REGISTERS 0-1 TO A DOUBLE- 35930021 * PRECISION FLOATING-POINT NUMBER IN FLOATING-POINT REGISTER 0 35940021 * 35950021 * 35960021 NI SYGNSW(JN),XX00 SET MANT SW SIGN POS 35970021 MVI FLTEXP(JN),XX4E INITIALIZE EXP TO ZERO 35980021 LTR JR,JR TEST MANTISSA SIGN 35990021 BC R10,POSMAN POSITIVE 36000021 OI SYGNSW(JN),XX01 SET MANTISSA SW NEGATIVE 36010021 X JR,ALLFF NEG - INVERT MANTISSA HI-ORD 36020021 X JA,ALLFF INVERT LO-ORD 36030021 AL JA,F1 ADD 1 36040021 BC R12,POSMAN NO CARRY 36050021 AL JR,F1 CARRY - ADD 1 TO HI-ORD 36060021 POSMAN C JR,TWOP24 COMP TO 2 ** 24 36070021 BC R4,STORE 8 HI BITS ARE CLEAR 36080021 SRDL JR,DX4 SHIFT RIGHT 4 BITS 36090021 MVI FLTEXP(JN),XX4F MAKE EXP 1 36100021 C JR,TWOP24 COMP AGAIN 36110021 BC R4,STORE 8 HI BITS ARE CLEAR 36120021 SRDL JR,DX4 SHIFT RIGHT 4 BITS 36130021 MVI FLTEXP(JN),XX50 MAKE EXP 2 36140021 STORE STM JR,JA,WORKA(JN) STORE BINARY DBL WORD 36150021 MVC WORKA(LX1,JN),FLTEXP(JN) INSERT FLT PNT EXP 36160021 LD FJR,WORKA(JN) LOAD UNNORMALIZED FLT PT NO. 36170021 MD FJR,FLTONE MULT BY 1 TO NORMALIZE 36180021 LTDR FJR,FJR TEST FOR 0 VALUE 36190021 BC R8,EXITC IF 0, EXITC 36200021 LTR JR,JB SHIFT EXP TO R0, TEST SIGN 36210021 BC R4,EXPNEG GO TO NEG EXP RT 36220021 LA JA,PLSTBL POSITIVE -LOAD POINTER TO TEST TAB 36230021 LA JB,PWRTBL LOAD POINTER TO POWER-OF-10 TABLE 36240021 SLL JR,DX25 PREPARE FOR MULT LOOP 36250021 PLLOOP ALR JR,JR ADD EXP TO ITSELF - IF NO CARRY, 36260021 BC R12,NOMULT THAT BIT NOT ON - DON'T MULTIPLY 36270021 CE FJR,DX0(JA) TEST FOR TOO BIG 36280021 BC R2,TOOBIG YEP, TOO BIG 36290021 MD FJR,DX0(JB) MULT BY APPROPRIATE POWER-OF-10 36300021 NOMULT LA JA,DX4(JA) INCREMENT TABLE 36310021 LA JB,DX8(JB) POINTERS 36320021 C JB,TBLEND TEST 7 TIMES THRU LOOP 36330021 BC R7,PLLOOP NO - REPEAT 36340021 BC R15,FINAL YES - GO TO FINISH UP SIGN 36350021 EXPNEG LA JA,NEGTBL ADDR OF TABLE FOR NEG EXPONS 36360021 LA JB,PWRTBL ADDR OF POWER-OF-10 TABLE 36370021 LPR JR,JR MAKE REG POS 36380021 SLL JR,DX25 PREP TO DIVIDE 36390021 NGLOOP ALR JR,JR ADD EXP TO ITSELF - IF NO CARRY 36400021 BC R12,NODIV THAT BIT NOT ON - DON'T DIVIDE 36410021 CE FJR,DX0(JA) TEST FOR TOO SMALL 36420021 BC R4,TOOWEE YEP, TOO SMALL 36430021 DD FJR,DX0(JB) DIVIDE BY APPROP POWER-OF-10 36440021 NODIV LA JA,DX4(JA) INCREMENT TABLE 36450021 LA JB,DX8(JB) POINTERS 36460021 C JB,TBLEND TEST END OF TABLE 36470021 BC R7,NGLOOP NO - REPEAT 36480021 FINAL TM SYGNSW(JN),XX01 TEST MANTISSA SIGN 36490021 BC R8,EXITC POS - EXITC 36500021 LNDR FJR,FJR NEG - CONVERT 36510021 BC R15,EXITC EXITC 36520021 TOOWEE SDR FJR,FJR SET FP RESULT TO ZERO 36530021 BC R15,EXITC1 -EXITC1 36540021 TOOBIG LD FJR,MAXFLT SET FP RESULT TO MAX SIZE 36550021 * 36560021 EXITC1 BAL R14,MSG75 -MSG75 36570021 EXITC MVI NXTCOD,XX33 SET CODE 36580021 MVI NXTN,XX08 SET N TO 8 36590021 STD FJR,WORKA(JN) SET DBL PREC FP-NUM 36600021 MVC NXTBCD(LX8),WORKA(JN) IN NXTBCD 36610021 LM R1,R8,SAVREG RESTORE REGS 1-8 36620021 BC UNCOND,EXIT -EXIT 36630021 * 36640021 EJECT 36650021 IKF106 CSECT 36660021 * 36670021 * CHARACTER IS A LETTER 36680021 * 36690021 LETTER BAL JP,NOLDHI (SET UP TBL FOR NON L-D-H) 36700021 TRT DX0(LX80,R1),NONLDH SCAN TO NON-LETTER,DIGIT,HY 36710021 BAL JP,NOLDHO (RESET TBL) 36720021 LETHYP BCTR R1,JR SET POINTER BACK ONE 36730021 TM GTRTSW,XX10 CALLED BY COPY REPLACING 36740021 BC NOTZER,LTHYSK YES - DON'T CK FOR HYPHEN 36750021 CLI DX0(R1),KHYPHN IS IT AN ENDING HYPHEN 36760021 BC EQ,LETHYP YES-LETHYP 36770021 LTHYSK LA R1,DX1(R1) SET PTR PAST WD 36780021 LR R8,R1 COMPUTE 36790021 SR R8,R5 LENGTH 36800021 BC UNCOND,QLRTNE -QLRTNE (TEST FOR OF/IN) 36810021 * 36820021 * CHARACTER IS A DIGIT 36830021 * 36840021 DIGIT XR R2,R2 CLEAR REG 36850021 TRT DX0(LX80,R5),UDIGT SCAN TO NON-DIGIT 36860021 SLA R2,DX2 MULTI CHAR-CODE BY 4 36870021 BC UNCOND,DIGBR-NX4(R2) -ROUTINE FOR NON-DIGIT 36880021 DIGBR BC UNCOND,LETTER -LETTER 36890021 BC UNCOND,DIGHYP -HYPHEN 36900021 BC UNCOND,DIGDEC -DECIMAL 36910021 BC UNCOND,DIGCOM -COMMA 36920021 * 36930021 DIGHYP LR R3,R1 SAVE PTR TO HYPHEN 36940021 MVI UDIGT+NX96,XX00 ELIMINATE HYPHEN FROM TABLE 36950021 XR R2,R2 CLEAR REG 36960021 TRT DX0(LX80,R1),UDIGT SCAN TO NON (DIGIT OR HYPHE 36970021 MVI UDIGT+NX96,XX02 REPLACE HYPHEN IN TABLE 36980021 BCT R2,*+NX8 IS IT A LETTER 36990021 BC UNCOND,LETTER YES-LETTER (ASSUME A WO 37000021 LA R2,DX1(R3) POSITION AFTER HYPHEN 37010021 CR R2,R1 OK 37020021 BC NOTEQ,LETTER YES-LETTER 37030021 DIGNUM LR R1,R3 RESTORE PTR TO HYPHEN 37040021 BC UNCOND,NUMLIT -NUMLIT 37050021 * 37060021 DIGDEC TM FRGNSW,XX01 FRGNSW 'ON' 37070021 BO NUMLIT YES..FOREIGN CURRENCY 37080021 DIGPER LR R3,R1 SAVE PTR TO PERIOD 37090021 OI DECSW,XX01 SET 'ON' DECSW 37100021 TRT DX1(LX1,R1),UDIGT IS CHAR AFTER PERIOD A DIGI 37110021 BC ZERO,DGSCN2 YES-DGSCN2 37120021 NI DECSW,XX00 SET 'OFF' DECSW 37130021 CLI DX0(R1),XXC5 IS CHAR AFTER PERIOD LETTER 37140021 BC EQ,FLOPNT YES-FLOPNT (FLOAT-POINT 37150021 DIGXIT BCTR R1,JR SET PTR BACK ONE 37160021 BC UNCOND,NUMLIT -NUMLIT (NUM-LITERAL 37170021 * 37180021 DIGCOM TM FRGNSW,XX01 FRGNSW 'ON' 37190021 BC ZERO,NUMLIT NO FOREIGN CURRENCY 37200021 CLI DX0(R1),XX40 IS NEXT CH A BLANK 37210021 BC EQ,NUMLIT YES - NUMLIT 37220021 BC UNCOND,DIGPER CHECK NUMBER 37230021 * 37240021 DGSCN2 TRT DX1(LX80,R1),UDIGT SCAN TO NON-DIGIT 37250021 CLI DX0(R1),XXC5 IS NON-DIGIT A LETTER 'E' 37260021 BC EQ,FLOPNT YES-FLOPNT (FLOAT-POINT 37270021 BC UNCOND,NUMLIT -NUMLIT (NUM-LITERAL 37280021 EJECT 37290021 * 37300021 * ROUTINE FOR A QUOTE SIGN -- ALPHAMERIC LITERAL 37310021 * 37320021 QUOTE SR R3,R3 CLEAR REG 37330021 MVI NXTCOD,XX34 CODE AS ALPHMERIC LIT 37340021 LA R4,NXTBCD SET UP REG TO STORE LIT 37350021 XC QUOTCARD,QUOTCARD RE-INITIALIZE SWITCH 51354 37360021 QUSCAN LA R1,DX1(R1) STEP REG TO NEXT CHARATER 37370021 TM NOTESW,XX02 NOTESW 'ON' 37380021 BC ONES,EXIT5C YES-EXIT5C 37390021 CLC DX0(LX1,R1),SNGLQT IS IT A QUOTE 37400021 BNE QUSCAN NO - CONTINEU LOOP 37410021 QUSN1B LR R8,R1 ADDR OF ENDING QUOTE 37420021 SR R8,R5 SIZE FROM QUOTE THRU QUOTE 37430021 STC R8,NXTN SAVE SIZE FOR COPY REPLACIN 37440021 BCTR R8,JR ADJ TO ACTUAL SIZE 37450021 CR R1,R7 TEST IF COL 74 37460021 BC NOTLO,QUCNLT YES-QUCNLT 37470021 AR R3,R8 SAVE SIZE 37480021 CLI QUOTCARD,XXFF SWITCH ON? 51354 37490021 BE QLSTWD1 YES 51354 37500021 QUCN0 BAL JP,QZ120 -QZ120 SIZE NOT OVER 120 51354 37510021 BAL JP,QZERO -QZERO SIZE GREATER THAN 37520021 * 37530021 QUCN1 CH R8,HWZERO LENGTH OF CONTINUATION IS Z 37540021 BC EQ,QUCN1A YES-QUCN1A 37550021 TM GTRTSW,XX10 GTWD CALLED BY GTCARD 37560021 BC NOTZER,CPREXT YES - EXIT 37570021 BCTR R8,JR REDUCE LENGTH FOR 'EX' 37580021 EX R8,MOVLIT LIT TO BCD FIELD 37590021 QUCN1A STC R3,NXTN SIZE TO N FIELD 37600021 CPREXT LA R1,DX1(R1) MOVE PTR PAST LAST QUOTE 37610021 BC UNCOND,EXIT5 -EXIT5 37620021 * 37630021 * ROUTINE FOR LIT THAT CONTINUES ON NEXT CARD 37640021 QUCNLT BCTR R8,JR ADJ FOR COL 73 37650021 AR R3,R8 SAVE SIZE 37660021 BAL JP,QZ120 -QZ120 SIZE NOT OVER 120 37670021 LTR R3,R3 LENGTH IS ZERO 37680021 BC ZERO,QCNLT1 YES-QCNLT1 37690021 TM GTRTSW,XX10 GETWD CALLED BY GETCD 37700021 BC ZERO,QUGTCD NO - CALL GTCD 37710021 STC R3,NXTN SAVE SIZE FOR GTCARD 37720021 B EXIT5C EXIT VIA EXIT5C 37730021 QUGTCD BCTR R8,JR LENGTH - 1 FOR EX 37740021 EX R8,MOVLIT LIT TO BCD FIELD 37750021 LA R4,DX1(R8,R4) INCREMENT PTR TO BCD FIELD 37760021 QCNLT1 STM R3,R4,QUOTSV SAVE REGS 37770021 BAL R14,GTCARD -GTCARD 37780021 MVI QUOTCARD,XXFF NEW CARD GOTTEN 51354 37790021 MVI NXTCOD,XX34 YES - SET CODE TO ALPHA LIT 37800021 LM R3,R4,QUOTSV RESTORE REGS 37810021 * 37820021 * CONTINUED LITERAL CHECK FOR CONTINUATION HYPHEN AND QUOTE 37830021 BCTR R5,JR ADDR OF COL 7 37840021 TRT DX1(LX80,R5),UNONB SCAN TO NON-BLANK 37850021 CLC DX0(LX1,R1),SNGLQT QUOTE 37860021 BNE QUSNAD NO - CK IF CONTINUATION CARD 37870021 QUSN1C CR R1,R7 ADDR COL 74? 50174 37880021 BL QUSN2C NO 50174 37890021 BAL JP,MSG78 YES-BLANK CARD/ASSUME 50174 37900021 LR R1,R6 OPEN QUOTE IN COLUMN 12 50174 37910021 B QUSNAB CONTINUE 50174 37920021 QUSN2C CLI DX0(R5),XX60 HYPHEN IN COLUMN 7? 50174 37930021 BC EQ,QUSNAB YES-QUSNAB 37940021 QUSNAA BAL JP,MSG78 -MSG78 37950021 QUSNAB LR R5,R1 SET R5 TO QUOTE 37960021 QUSNAC CR R1,R6 IN A-MARGIN 37970021 BC NOTLO,QUSCAN NO-QUSCAN 37980021 BAL JP,MSG77 -MSG77 37990021 BC UNCOND,QUSCAN -QUSCAN 38000021 * 38010021 QUSNAD CLI DX0(R5),XX60 HYPHEN COL 7 38020021 BC EQ,QUSNAE YES-QUSNAE 38030021 BAL JP,MSG98 -MSG98 38040021 BAL JP,QZERO -QZERO 38050021 STC R3,NXTN STORE SIZE 38060021 BC UNCOND,EXIT5 -EXIT5 38070021 * 38080021 QUSNAE BAL JP,MSG78 -MSG78 38090021 LR R5,R1 SET R5 TO NON-BLANK 38100021 BCTR R5,JR MOVE PTR TO QUOTE POSITION 38110021 BC UNCOND,QUSNAC -QUSNAC 38120021 * 38130021 * ROUTINE TO TEST IF LIT IS OVER 120 CHARACTERS 38140021 QZ120 C R3,K120 OVER 120 CHARACTERS 38150021 BCR NOTHI,JP NO-RETURN 38160021 BAL JP,MSG76 -MSG76 38170021 SR R3,R8 SUBTRACT LAST LENGTH 38180021 L R8,K120 CALC DIFFERENCE BETWEEN 38190021 SR R8,R3 PREVIOUS LENGTH AND 120 38200021 L R3,K120 SET LENGTH TO 120 38210021 CR R1,R7 IS IT COL 74 38220021 BC LO,QUCN1 NO-QUCN1 38230021 BCT R1,QUCN1 -QUCN1 MOVE PTR BACK ONE 38240021 * 38250021 * ROUTINE TO TEST IF LIT IS ZERO LENGTH 38260021 QZERO LTR R3,R3 SIZE IS ZERO 38270021 BCR NOTZER,JP NO-RETURN 38280021 BAL JP,MSG79 -MSG79 38290021 MVI NXTBCD,XX40 PUT BLANK IN FIELD 38300021 LA R3,DX1(R3) SET SIZE TO 1 38310021 BC UNCOND,QUCN1A -QUCN1A 38320021 * 38330021 * 51354 38340021 QLSTWD1 STM R1,R3,QLSTWDSV SAVE REGISTERS 51354 38350021 LR R3,R1 R3 = @ END QUOTE 51354 38360021 LA R3,DX2(R3) SKIP QT/BLANK OR PD,ETC 51354 38370021 TRT DX0(LX80,R3),UNONB SCAN TO NEXT NON-BLANK 51354 38380021 CR R1,R7 COLUMN 74? 51354 38390021 BE QLSTRETN YES- REST OF CARD BLANK 51354 38400021 LR R2,R7 SCAN LEFT 51354 38410021 QLSTWD2 BCTR R2,R0 FROM COLUMN 74 51354 38420021 CLI DX0(R2),XX40 POSITION BLANK? 51354 38430021 BE QLSTWD2 YES-SCAN TO NON-BLANK 51354 38440021 CLI DX0(R2),XX4B DOES LAST WORD END W/PD? 51354 38450021 BE QLSTRETN YES-NEXT CARD NOT CONT. 51354 38460021 CLI DX0(R2),XX6B DOES LAST WORD END W/COMMA? 38470021 BE QLSTRETN YES-NEXT CARD NOT CONT. 51354 38480021 CLI DX0(R2),XX7D DOES LAST WORD END W/QUOTE? 38490021 BE QLSTRETN YES-NEXT CARD NOT CONT. 51354 38500021 NI NWCDSW,XXBF POSSIBLE CONT./NEXT CARD 51354 38510021 QLSTRETN XC QUOTCARD,QUOTCARD RE-INITIALIZE SWITCH 51354 38520021 LM R1,R3,QLSTWDSV RESTORE REGISTERS 51354 38530021 B QUCN0 RETURN 51354 38540021 * 51354 38550021 QLSTWDSV DC 3F'0' SAVE AREA 51354 38560021 QUOTCARD DC X'00' NEW CARD/THIS ROUTINE 51354 38570021 * 51354 38580021 MOVLIT MVC DX0(LX0,R4),DX1(R5) EX MOVE FOR LIT 38590021 EJECT 38600021 * 38610021 * ROUTINE FOR A PERIOD 38620021 * 38630021 PERIOD TM FRGNSW,XX01 FRGNSW 'ON' 38640021 BC ZERO,DIGAFT NO-DIGAFT 38650021 LA R1,DX1(R1) SET PTR TO POS AFTER PERIOD 38660021 BC UNCOND,TSTAFT -TSTAFT 38670021 DIGAFT TRT DX1(LX1,R1),UDIGT IS NEXT A DIGIT 38680021 BC EQ,DIGPER YES-DIGPER 38690021 TSTAFT CLI DX0(R1),XX40 IS POSITION AFTER PERIOD BLANK 38700021 BC EQ,EOSENT YES BRANCH TO END OF SENT ROUT 38710021 BAL JP,MSG81 ERR MESS- PERIOD NOT FOLLOWED BY BLAN 38720021 EOSENT MVC NXTCOD(LX2),EOSCON MOVE EOS CODE 38730021 TM CURSW,XX04 IS POSITION BEFORE PERIOD B 38740021 BC ONES,EXIT5C NO-EXIT5C 38750021 BAL R14,MSG80 -MSG80 38760021 BC UNCOND,EXIT5C -EXIT5C 38770021 * 38780021 * 38790021 * ROUTINE FOR PLUS OR MINUS SIGN 38800021 * 38810021 SIGN OI SIGNSW,XX01 SET 'ON' SIGNSW 38820021 TRT DX1(LX1,R1),UDIGT DIGIT FOLLOWING SIGN 38830021 BC ZERO,SIGNC YES-SIGNC 38840021 CLC DX0(LX1,R1),KDECML PERIOD FOLLOWING SIGN 38850021 BNE SIGNLT NO - LETTER FOLLOWS ? 38860021 TRT DX1(LX1,R1),UDIGT DIGIT FOLLOWIN PERIOD 38870021 BC ZERO,DIGPER YES-DIGPER 38880021 BCTR R1,JR (SET PTR BACK TO PERIOD) 38890021 * 38900021 * 38910021 SIGNLT DS 0H 38920021 OI UNARSW,XX40 SET ON UNARY SW 38930021 SIGNA CLI DX0(R5),XX60 MINUS SIGN 38940021 BC EQ,SIGNB YES-SIGNB 38950021 MVC NXTCOD(LX2),PLUSCD CODE AS PLUS SIGN 38960021 BC UNCOND,EXIT -EXIT 38970021 SIGNB MVC NXTCOD(LX2),MINCD CODE AS MINUS SIGN 38980021 BC UNCOND,EXIT -EXIT 38990021 * 39000021 SIGNC TRT DX1(LX80,R1),UDIGT SCAN TO NON-DIGIT 39010021 CLC DX0(LX1,R1),KDECML PERIOD FOLLOWING LAST DIGIT 39020021 BC EQ,DIGPER YES-DIGPER 39030021 BC UNCOND,NUMLIT -NUMLIT 39040021 EJECT 39050021 * 39060021 * GENERAL ROUTINE FOR NUMERIC LITERALS -- ROUTINE IS ENTERED FROM 39070021 * SIGN, PERIOD, AND DIGIT ROUTINES. A SWITCH IS SET IF THERE IS A 39080021 * SIGN OR A DECIMAL. R5 POINTS TO THE FIRST CHARACTER, R3 POINTS 39090021 * THE DECIMAL, AND R1 POINTS TO THE CHARACTER AFTER THE LITERAL 39100021 * 39110021 NUMLIT ST R5,REGWRK SAVE R5 39120021 LR R8,R1 GET TOTAL 39130021 SR R8,R5 LIT SIZE 39140021 STC R8,NXTCNT STORE IN NXTCNT 39150021 MVC NXTWD(LX18),DX0(R5) STORE LIT IN NXTWD 39160021 TM SIGNSW,XX01 SIGNED LIT 39170021 BC NOTONE,NUMLTA NO-NUMLTA 39180021 LA R5,DX1(R5) MOVE R5 PTR 39190021 BCTR R8,JR REDUCE SIXE 39200021 NUMLTA TM DECSW,XX01 IS THERE DEC 39210021 BC NOTONE,*+NX6 NO 39220021 BCTR R8,JR YES - SUBTRACT 1 FROM LENGTH 39230021 CL R8,K18 COMP TO 18 39240021 BC NOTHI,*+NX12 LENGTH IS OK 39250021 BAL JP,MSG82 -MSG82 39260021 LA R8,DX18 LIT TOO LONG, TRUNCATE TO 18 39270021 ST R8,SAVER8 SAVE LITERAL LENGTH 39280021 MVI UNPWRK,XX00 SET 18 BYTE WORK AREA TO ZERO 39290021 MVC UNPWRK+NX1(LX17),UNPWRK AREA TO ZERO 39300021 MVC INTCNT(LX4),ZERWRD CLEAR COUNTERS 39310021 LA R4,UNPEND SET UP R4 TO POINT TO 39320021 SR R4,R8 1ST POS OF WORK AREA 39330021 ST R4,VALNLT SAVE R4 FOR VALUE CLAUSE 39340021 ST R8,VALNLT+NX4 SAVE R8 FOR VALUE CLAUSE 39350021 TM DECSW,XX01 TEST DECIMAL AGAIN 39360021 BC ONES,NLTDEC YES 39370021 STH R8,INTCNT SAVE NO OF INTS 39380021 EX R8,MVPAK1 NO - ONLY INTEGERS - MV TO WORK AREA 39390021 BC UNCOND,LITCOM GO TO COMMON ROUTINE 39400021 MVPAK1 MVC DX0(LX0,R4),DX0(R5) 39410021 MVPAK2 MVC DX0(LX0,R4),DX0(R3) 39420021 * 39430021 * ROUTINE FOR NUMERIC LIT WITH DECIMALS 39440021 * 39450021 NLTDEC SR R2,R2 39460021 INTLP1 CR R5,R3 IS POINTER AT DEC YET 39470021 BC EQ,SAVINT YES 39480021 MVC DX0(LX1,R4),DX0(R5) NO - MV 1 DIG TO WORK 39490021 LA R2,DX1(R2) ADD 1 TO INT COUNT 39500021 LA R5,DX1(R5) ADD 1 TO POINTER 39510021 LA R4,DX1(R4) ADD 1 TO WORK AREA PNTR 39520021 BCT R8,INTLP1 TEST 18 CHARS MOVED 39530021 STH R2,INTCNT 39540021 BC UNCOND,LITCOM YES GO TO COMMON ROUTINE 39550021 SAVINT STH R2,INTCNT SAVE INTEGER COUNT 39560021 SR R2,R2 CLEAR FOR DEC COUNT 39570021 DECLP1 LA R5,DX1(R5) MV POINTER PAST DEC 39580021 CR R5,R1 TEST END OF LIT 39590021 BC EQ,SAVDEC YES 39600021 MVC DX0(LX1,R4),DX0(R5) NO - MV 1 DIG TO WORK 39610021 LA R2,DX1(R2) ADD 1 TO DEC COUNT 39620021 LA R4,DX1(R4) ADD 1 TO WORK AREA PNTR 39630021 BCT R8,DECLP1 TEST 18 CHARS MOVED 39640021 SAVDEC STH R2,DECCNT SAVE DEC COUNT 39650021 LITCOM L R8,SAVER8 RESTORE LENGTH OF LIT 39660021 PACK PAKSUB,UNPSUB PACK RIGHT MOST 15 DIGS 39670021 PACK WRK2,UNPWRK PACK LEFT 3 DIGS 39680021 MVO WRK3,WRK2 ELIM SIGN 39690021 MVC PAKWRK(LX2),WRK3 AND SHIFT 4 BITS 39700021 L R5,REGWRK RSTORE R5 39710021 TM SIGNSW,XX01 TEST SIGN 39720021 BC NOTONE,NLTPH1 NO SIGN 39730021 CLI DX0(R5),XX4E IS IT A + 39740021 BC EQ,NLTPLS YES 39750021 NI PAKEND-NX1,XXFD NO - MAKE SIGN MINUS 39760021 NI UNPEND-NX1,XXDF SET SIGN IN BCD TO MINUS 39770021 BC UNCOND,*+NX12 GO ADD 1 FOR PACKED BYTES 39780021 NLTPLS NI UNPEND-NX1,XXCF SET SIGN IN BCD TO + 39790021 NLTPLU NI PAKEND-NX1,XXFC MAKE SIGN + 39800021 SRA R8,DX1 DIV LIT LENGTH BY 2 39810021 LA R8,DX1(R8) ADD 1 GIVING NO OF PACKED BYTES 39820021 LA R3,PAKEND SET POINTER TO FIRST 39830021 SR R3,R8 PACKED BYTE 39840021 LA R4,NXTBCD+NX2 LOAD STARTING ADD FOR PACKED DEC 39850021 EX R8,MVPAK2 MV PACKED DEC TO COMM CELL 39860021 LA R8,DX2(R8) DEVELOP NEXTN AND 39870021 STC R8,NXTN STORE SIZE IN NXTN 39880021 MVI NXTCOD,XX32 STOR CODE FOR NUM LIT 39890021 MVC NXTN+NX1(LX1),INTCNT+NX1 STORE NO OF INTS 39900021 MVC NXTN+NX2(LX1),DECCNT+NX1 STORE NO OF DECS 39910021 LR R8,R1 PUT BCD 39920021 SR R8,R5 FORM 39930021 STC R8,NXTCNT IN NEXT 39940021 MVC NXTWD(LX20),DX0(R5) WORD 39950021 TM DECSW,XX01 IS THERE A DECIMAL 39960021 BC ONES,TWDBNT YES-TWDBNT 39970021 TM SIGNSW,XX01 IS THERE A SIGN 39980021 BC ONES,TWDBNT YES-TWDBNT 39990021 INLCKC OI AMARSW,XX04 UNSIGNED NUM-LIT W/O DEC 40000021 OI NXTSW,XX08 SET SW FOR NUM LIT 40010021 BC UNCOND,TWDBNT -TWDBNT 40020021 * 40030021 NLTPH1 NI PAKEND-NX1,XXFF MAKE SIGN 'F' 40040021 B NLTPLU+LX4 GO BACK TO DIV LIT LENGTH BY 2 40050021 EJECT 40060021 * 40070021 * SPECIAL CHARACTER ROUTINE 40080021 * 40090021 SPECL LA R4,SPCTBL TABL ADDRESS TO REG 40100021 L R3,SPTBAD PUT TABLE END IN REGISTER 40110021 LA R2,DX3 SET UP FOR 3 BYTE INDESING 40120021 CLC DX0(LX2,R1),EXPOKD IS IT A DOUBLE ASTERISK 40130021 BC NOTEQ,SPLOOP NO-SPLOOP 40140021 MVC NXTCOD(LX2),EXPOCD CODE AS 'EXPONENTIATE' 40150021 LA R1,DX2(R1) ADD 2 TO POINTER 40160021 BC UNCOND,EXIT -EXIT 40170021 SPLOOP CLC DX0(LX1,R4),DX0(R1) COMP CHAR TO TABL CHAR 40180021 BC EQ,SPHIT YES - GO TO SAVE CODE NUM 40190021 BXLE R4,R2,SPLOOP LOW OR EQUAL - COMP CHAR 40200021 SPHIT MVC NXTCOD(LX2),DX1(R4) SAVE CODE 40210021 LA R1,DX1(R1) ADD 1 TO POINTER 40220021 BC UNCOND,EXIT GET ENDING ADDR 40230021 * 40240021 * ROUTINE FOR ILLEGAL CHARACTER 40250021 * 40260021 ILLEGL TM NOTESW,XX02 NOTE VERB? 0654 40270021 BC ONES,ILLEG1 YES - ILLEG1 0654 40280021 CLI CURCOD,XX44 44 WORD? 0654 40290021 BC NOTEQ,WMSG83 NO - WMSG83 0654 40300021 CLI CURN,XXF7 NOTE VERB? 0654 40310021 BC EQ,ILLEG1 YES - ILLEG1 0654 40320021 WMSG83 BAL JP,MSG83 ERR MESS - ILLEGAL CHAR 0654 40330021 ILLEG1 LA R1,DX1(R1) ADD1 40340021 SR R2,R2 CLEAR R2 40350021 TRT DX0(LX1,R1),UNONB TEST NEXT CHARACTER 40360021 BC ZERO,ILLEG2 BLANK 40370021 C R2,K7 IS IT ILLEGAL 40380021 BC EQ,ILLEG1 YES - REPEAT LOOP 40390021 ILLEG2 LR R5,R1 ANY LEGAL CHAR 40400021 BC UNCOND,ULSC1 GO TO RESUME SCAZ 40410021 * 40420021 * ROUTINE FOR A COMMA 40430021 * 40440021 COMMA TM FRGNSW,XX01 IS IT A FOREIGN LANG 40450021 BC ZERO,COMPRE NO-COMPRE 40460021 TRT DX1(LX1,R1),UDIGT NEXT CHAR IS A DIGIT 40470021 BC ZERO,DIGPER YES-DIGPER 40480021 BCTR R1,JR SUBTRACT 1 FROM R1 40490021 COMPRE BCTR R1,JR SET PTR BACK ONE 40500021 CLI DX0(R1),XX40 BLANK BEFORE COMMA 40510021 BC NOTEQ,COMEX NO-COMEX 40520021 BAL JP,MSG84 -MSG84 40530021 COMEX LA R1,DX2(R1) SET PTR PAST COMMA 40540021 LR R5,R1 SET POINTER 40550021 COMFOL CLI DX0(R1),XX40 BLANK FOLLOWING COMMA 40560021 BC EQ,ULSC14 YES-ULSC14 40570021 BAL JP,MSG120 -MSG120 40580021 BC UNCOND,ULSC14 -ULSC14 40590021 EJECT 40600021 * 40610021 * SUBROUTINE TO TEST FOR A COBOL WORD 40620021 * 40630021 TSTCOB SR R3,R3 40640021 C R8,K16 IS WORD LENGTH 40650021 BC NOTLO,BCDNAM BDTWEEN 40660021 C R8,K2 2 AND 40670021 BC LO,BCDNAM 15 40680021 ADLOOP C R8,ADTAB(R3) IF YES 40690021 BC EQ,MOVAD WHICH 40700021 LA R3,DX8(R3) LENGTH 40710021 BC UNCOND,ADLOOP RESEARCH FOR CORRECT LENGTH 40720021 MOVAD L R4,ADTAB+NX4(R3) LOAD ADDR OF VRST WORD THAT LENGTH 40730021 L R2,ADTAB+NX12(R3) ADDR OF FIRST WORD OF NEXT LENGTH 40740021 LR R3,R8 TRANSFER LENGTH TO WORK REG 40750021 BCTR R3,JR SUBRRACT 1 FOR EXECUTE COMPARE 40760021 TBLOOP EX R3,COMP 40770021 BC EQ,WRDHIT WORD FOUND 40780021 BC UNCOND,NOHIT GO TO NO HIT FOUND RTN 40790021 * 40800021 COMP CLC DX0(LX0,R5),DX0(R4) COMP THIS UNIT TO TABLWORD 40810021 * 40820021 NOHIT AR R4,R8 ADD WORD LENGTH TO TABL POINTER 40830021 LA R4,DX3(R4) ADD 3 40840021 CR R4,R2 TEST FOR END OF TABLE 40850021 BC EQ,BCDNAM END OF TABLE 40860021 BC UNCOND,TBLOOP RESEARCH TABLE 40870021 WRDHIT AR R4,R8 ADD WORD LENGTH TO TABLE POINTER 40880021 MVC NXTCOD(LX3),DX0(R4) MOVE CODE 40890021 BC UNCOND,CHKIDD CK IF PROC DIV DECLARATIVES 40900021 * 40910021 ***** ROUTINE FOR BCD-NAME ***** 40920021 * 40930021 BCDNAM MVI NXTCOD,XX23 CODE AS BCD-NAME 40940021 C R8,K30 OVER 30 CHARACTERS 40950021 BC NOTHI,BCDSTN NO-BCDSTN 40960021 L R8,K30 SET SIZE TO 30 40970021 BCDSTN STC R8,NXTN STORE SIZE IN 'N' 40980021 XC NXTBCD(LX120),NXTBCD CLEAR AREA 40990021 LA R3,NXTBCD ADDR OF NXTBCD 41000021 BCTR R8,JR ADJ SIZE FOR 'EX' 41010021 EX R8,MVNAM NAME TO NXTBC 41020021 OI AMARSW,XX02 SET SW FOR BCDNAME 41030021 OI NXTSW,XX80 SET NXTSW FOR BCD-NAME 41040021 BC UNCOND,TWDBNT -TWDBNT 41050021 * 41060021 MVNAM MVC DX0(LX0,R3),DX0(R5) 41070021 EJECT 41080021 * IF IN PROCEDURE DIV 41090021 ***** CHECK IF 'DECLARATIVES FOLLOWS END' CODE AS 'END-DECLAR' 41100021 * WHEN IN A-MARGIN AND PASS WORD 'DECLARATIVES' 41110021 CHKIDD EQU * 41120021 TM NOTESW,XX02 NOTESW 'ON' 41130021 BC ZERO,CHKPDV NO-CHKPDV 41140021 TM NXTSW,XX01 IN A-MARGIN 41150021 BC ZERO,EXIT NO-EXIT 41160021 NI NOTESW,XXFD SET 'OFF' NOTESW 41170021 CHKPDV IC R3,DIVCOD OK FOR DIVISION 41180021 EX R3,DVXTST OK FOR DIVISION 41190021 BC ZERO,TWDM98 NO-TWDM98 41200021 WRDDCL CLC NXTCOD(LX3),ENDCD WORD IS 'END' 41210021 BC NOTEQ,TWDANT -TWDANT 41220021 ST R1,REGWRK SAVE R1 41230021 LR R3,R1 LOAD R1 TO R3 41240021 TRT DX0(LX80,R3),UNONB SCAN TO NONBLANK 41250021 CLC DX0(LX12,R1),DECLKN WORD IS 'DECLARATIVES' 41260021 BC EQ,ENDPAS YES-ENDPAS 41270021 L R1,REGWRK RESTORE R1 41280021 TM NXTSW,XX01 IN A-MARGIN 41290021 BC ZERO,EXIT NO-EXIT 41300021 BAL JP,MSG87 -MSG87 'SHOULD NOT BE IN A-MARGI 41310021 BC UNCOND,EXIT -EXIT 41320021 ENDPAS LA R1,DX12(R1) SET R1 TO PASS DECLARATIVES 41330021 MVC NXTCOD(LX3),ENDLCD CODE AS END-DECLARATIVES 41340021 TM NXTSW,XX01 IN A-MARGIN 41350021 BC ONES,EXIT YES-EXIT 41360021 BAL JP,MSG86 -MSG86 'WORD SHOULD BE IN A-MARG 41370021 BC UNCOND,EXIT -EXIT 41380021 * 41390021 TWDANT CLI NXTCOD,XX42 CODE IS '42' 41400021 BC EQ,TWDIVN YES-TWDIVN 41410021 CLI NXTCOD,XX43 CODE IS '43' 41420021 BC NOTEQ,TWDBNT NO-TWDBNT 41430021 TWDIVN TM NXTBCD,XX30 DIV OR SECT HEADER 41440021 BC NOTZER,TWDCHK YES-TWDCHK 41450021 TM NXTSW,XX01 IN A-MARGIN 41460021 BC ONES,EXIT YES-EXIT 41470021 BAL JP,MSG86 -MSG86 'SHOULD BE IN A-MARGIN' 41480021 BC UNCOND,EXIT -EXIT 41490021 * 41500021 TWDCHK ST R1,REGWRK SAVE R1 41510021 TRT DX0(LX80,R1),UNONB SCAN TO NON-BLANK 41520021 TM NXTBCD,XX20 SECTION HEADER 41530021 BC ONES,TWDSCT YES-TWDSCT 41540021 CLC DX0(LX8,R1),DIVKON WORD IS DIVISION 41550021 BC NOTEQ,TWDAMG NO-TWDAMG 41560021 LA R1,DX8(R1) SET R1 TO PASS DIVISION 41570021 BC UNCOND,TWDMRG -TWDMRG 41580021 TWDSCT CLC DX0(LX7,R1),SCTKON WORD IS SECTION 41590021 BC NOTEQ,TWDRPT NO-TWDRPT 41600021 LA R1,DX7(R1) SET R1 TO PASS SECTION 41610021 TWDMRG TM NXTSW,XX01 IN A-MARGIN 41620021 BC ONES,EXIT1 YES-EXIT1 41630021 BAL JP,MSG86 -MSG86 'SHOULD BE IN A-MARGIN' 41640021 BC UNCOND,EXIT1 -EXIT1 41650021 TWDRPT CLC NXTCOD(LX2),REPTCD WORD IS 'REPORT' (SCT) 41660021 BC NOTEQ,TWDAMG NO-TWDAMG 41670021 MVC NXTCOD(LX3),REPCON CHANGE CODE TO PLAIN'REPORT 41680021 L R1,REGWRK RESTORE REG 41690021 BC UNCOND,TWDBNT -TWDBNT 41700021 TWDAMG TM NXTSW,XX01 IN A-MARGIN 41710021 BC ZERO,TWDM99 NO-TWDM99 41720021 BAL JP,MSG95 -MSG95 'WORD SECT OR DIV MISSING 41730021 L R1,REGWRK RESTORE R1 41740021 BC UNCOND,EXIT -EXIT 41750021 DVXTST TM NXTBCD,XX00 'EX' TEST OK FOR DIV 41760021 * 41770021 ***** INVALID WORD -WRONG DIVISION OR USE- ***** 41780021 * 41790021 TWDM99 BAL JP,MSG99 -MSG99 'WORD INVALID AS USED' 41800021 L R1,REGWRK RESTORE REG 41810021 LR R5,R1 TO SCAN 41820021 BC UNCOND,ULSC1 NEXT WORD 41830021 * 41840021 TWDM98 DS 0H 41850021 MVC ERRCOD+NX1(LX2),NXTCOD COBOL WORD CODE TO ERROR CE 41860021 MVC NXTCOD(LX3),ERRCOD ERROR CODE TO NEXT CELL 41870021 BC UNCOND,EXIT -EXIT 41880021 * 41890021 ***** TEST IF WORD IS IN A-MARGIN AND BELONGS THERE ***** 41900021 * 41910021 TWDBNT TM NXTSW,XX01 IN A-MARGIN 41920021 BC ZERO,EXIT NO-EXIT 41930021 CLI DIVNM,XX09 ARE WE IN PROC DIVISION 41940021 BC EQUAL,TWDBCD YES - GO CHECK WORD 41950021 TWDM87 BAL R14,MSG87 -MSG87 (WORD ILLEGAL IN A-M 41960021 BC UNCOND,EXIT -EXIT 41970021 * IN PROCEDURE DIVISION CHECK THE FOLLOWING 41980021 TWDBCD CLI NXTCOD,XX23 BCD-NAME 41990021 BC EQ,EXIT YES-EXIT 42000021 CLC NXTCOD(LX2),EOSCON EOS 42010021 BC EQ,EXIT YES-EXIT 42020021 CLC NXTCOD(LX2),SCTCON SECTION 42030021 BC EQ,EXIT YES-EXIT 42040021 * IN DATA + PROCEDURE DIVISION CHECK THE FOLLOWING 42050021 TWDNLT TM NXTSW,XX08 INTEGRAL-NUMERIC-LITERAL 42060021 BC ZERO,TWDM87 NO-TWDM87 42070021 BC UNCOND,EXIT YES-EXIT 42080021 * 42090021 EJECT 42100021 * 42110021 ***** QUALIFIED NAME ROUTINE ***** 42120021 * 42130021 QLRTNE CLC DX0(LX3,R5),OFKON WORD IS 'OF' 42140021 BC EQ,QLROFA YES-QLROFA 42150021 CLC DX0(LX3,R5),INKON WORD IS 'IN' 42160021 BC NOTEQ,TSTCOB NO-TSTCOB 42170021 * CHECK IF FIRST 'OF/IN' OR TWO 'OF/IN'S IN A ROW 42180021 QLROFA CLI QLRTSW,XX01 IS 'OF/IN' EXPECTED 42190021 BC EQ,QLROFB YES-QLROFB (NOT THE FIRS 42200021 BC HI,QLRERR TWO 'OF/IN' IN A ROW-QLRER 42210021 TM CURSW,XX88 CUR-WD BCD-NAME OR INT-NUM- 42220021 BC ZERO,QLRCOD NO-QLRCOD 42230021 QLROFB OI QLRTSW,XX02 SET QLRTSW TO '3' 42240021 LR R5,R1 SET PTR PAST WORD 'OF-IN' 42250021 BC UNCOND,ULSC1 -ULSC1 42260021 * CHECK FOR BCD-NAME OR INT-NUM-LIT AND PUT IN QLTABL 42270021 QLRWRD CLI QLRTSW,XX02 WAS LAST WORD 'OF/IN' 42280021 BC LO,QLREND NO-QLREND 42290021 BC EQ,QLRWDA YES-QLRWDA (FIRST ONE) 42300021 TM NXTSW,XX88 NXT-WD BCD-NAME OR INT-NUM- 42310021 BC ZERO,QLRERR NO-QLRERR 42320021 BC UNCOND,QLRWDB YES-QLRWDB 42330021 QLRWDA TM NXTSW,XX88 NXT-WD BCD-NAME OR INT-NUM- 42340021 BC ZERO,QLRERR NO-QLRERR 42350021 MVI CURCOD,XXA2 CURCOD TO 'A2' 42360021 L R4,QLTCON ADDR OF TIB 42370021 L R4,DX0(R4) ADDR OF TAMM 42380021 MVC DX4(LX2,R4),HWTWO SET DISPLACEMENT TO '2' 42390021 L R4,DX0(R4) ADDR OF TABLE 42400021 MVI DX0(R4),XX35 SET UP 42410021 MVI DX1(R4),XX00 3500 42420021 LA R4,CURCNT ADDR OF CURCNT 42430021 BAL R14,QLTAME -QLTAME (ENTER CURWD+CNT) 42440021 QLRWDB LA R4,NXTCNT ADDR OF NXTCNT 42450021 QLRWSK TM NXTSW,XX04 BLANK FOLLOW END OF Q-NAME 42460021 BC ZERO,*+NX8 YES-*+8 42470021 OI CURSW,XX04 NO-MAKE IT NONBLANK 42480021 BAL R14,QLTAME -QLTAME (ENTER NXTWD+CNT) 42490021 LR R5,R1 SET PTR PAST WORD 42500021 MVI QLRTSW,XX01 SET QLRTSW TO '1' 42510021 MVC FDSAVE(LX31),NXTCNT SAVE FD NAME FOR QUAL WRITE 42520021 BC UNCOND,ULSC1 -ULSC1 42530021 * 42540021 QLTAME STM R1,R15,SAVREG SAVE REGS 42550021 XR R5,R5 CLEAR REG 42560021 IC R5,DX0(R4) GET 'N' 42570021 LA R0,DX1(R5) ADJ BY ONE 42580021 L R1,QLTCON CALL 42590021 L R15,ADSERT INSERT 42600021 BALR R14,R15 QLTABL 42610021 L R15,SAVREG+NX56 RESTORE REG 15 42620021 EX R5,QLRMOV STORE 'WORD' IN QLTABL 42630021 AR R2,R5 ADJ TABLE ADDR 42640021 STC R5,DX0(R2) PUT 'CNT' IN QLTABL 42650021 LM R1,R15,SAVREG RESTORE REGS 42660021 BCR UNCOND,R14 -RETURN 42670021 QLRMOV MVC DX0(LX0,R2),DX1(R4) EX-MOVE 42680021 * EXIT ROUTINE TO END QUALIFIED NAME 42690021 QLRERR BCTR R5,R0 POINTER TO START - 1 42700021 LR R1,R5 POINTER TO START - 1 42710021 BCTR R5,R0 POINTER TO START - 2 42720021 BC UNCOND,QLRC1D -QLRC1D 42730021 QLRCOD EQU * 42740021 QLRC1D MVI QLRTSW,XX00 RESET QLRTSW 42750021 MVC NXTCOD(LX3),OFCON CODE NXTCOD AS 'OF/IN' (NOT 42760021 MVI QLRTSW,XX00 RESET QLRTSW 42770021 BC UNCOND,CHKIDD CK ID DECLARATIVES 42780021 QLREND MVI QLRTSW,XX00 RESET QLRTSW 42790021 BC UNCOND,EXIT5D GO SET A-MARGIN SWITCH 42800021 EJECT 42810021 * 42820021 * COMMON EXIT ROUTINE 42830021 * 42840021 * CALCULATE LENGTH AND MSG BCD-NAME 42850021 EXIT LR R8,R1 ENDING ADDR 42860021 BC UNCOND,EXIT1A -EXIT1A 42870021 EXIT1 L R8,REGWRK ENDING ADDR 42880021 EXIT1A SR R8,R5 COMPUTE SIZE 42890021 C R8,K30 OVER 30 CHARACTERS 42900021 BC NOTHI,EXIT2 NO-EXIT2 42910021 CLI NXTCOD,XX23 BCD-NAME 42920021 BC NOTEQ,EXIT1B NO-EXIT1B 42930021 BAL R14,MSG85 -MSG85 42940021 EXIT1B L R8,K30 MAKE SIZE 30 42950021 * SET UP OF NXTCNT AND NXTWD 42960021 EXIT2 XC NXTWD(LX30),NXTWD CLEAR NXTWD 42970021 STC R8,NXTCNT STORE SIZE 42980021 BCTR R8,JR ADJ SIZE FOR 'EX' 42990021 LA R3,NXTWD ADDR OF NXTWD 43000021 EX R8,STUNIT STORE WORD 43010021 * ENTRY FROM ALPHAMERIC AND QUALIFIED WORD ROUTINES 43020021 * CHECK POS AFTER UNIT, QUAL ROUTINE AND RESET SWITCH 43030021 EXIT5 CLC NXTCOD(LX2),LPREN LEFT PAREN 43040021 BC NOTEQ,EXIT5A NO-EXIT5A 43050021 CLI DX0(R1),XX40 POSITION AFTER IS BLANK 43060021 BC NOTEQ,EXIT5B NO-EXIT5B 43070021 CLI DX1(R1),XX60 MINUS SIGN AFTER BLANK 43080021 BE EXIT5B YES - NO MSG 43090021 CLI DX1(R1),XX4E PLUS SIGN AFTER BLANK 43100021 BE EXIT5B YES - NO MSG 43110021 BAL R14,MSG10 -MSG10 43120021 BC UNCOND,EXIT5B -EXIT5B 43130021 * 43140021 EXIT5A CLI DX0(R1),XX40 POSITION AFTER IS BLANK 43150021 BC EQ,EXIT51 YES-EXIT51 43160021 TM UNARSW,XX40 UNARY SIGN ? 43170021 BC NOTZER,*+NX8 YES - SKIP NXTSW SET 43180021 OI NXTSW,XX04 SET 'ON' NXTSW FOR NON-BLAN 43190021 NI UNARSW,XXBF SET UNARY SW OFF 43200021 * 43210021 EXIT51 CLC NXTCOD(LX2),RPREN RIGHT PATEN 43220021 BC NOTEQ,EXIT5B NO-EXIT5B 43230021 TM CURSW,XX04 POSITION BEFORE IS BLANK 43240021 BC ONES,EXIT5C NO-EXIT5C 43250021 BAL R14,MSG8 -MSG8 43260021 BC UNCOND,EXIT5C -EXIT5C 43270021 * 43280021 EXIT5B TM CURSW,XX04 POSITION BEFORE IS BLANK 43290021 BC ZERO,EXIT5C YES-EXIT5C 43300021 BAL R14,MSG7 -MSG7 43310021 * 43320021 EXIT5C MVC SIGNSW(LX2),HWZERO RESET SIGN + DEC SWITCHES 43330021 NI UNARSW,XXBF 43340021 TM QLRTSW,XX03 IN QUAL-NAME ROUTINE 43350021 BC NOTZER,QLRWRD YES-QLRWRD 43360021 EXIT5D NI AMARSW,XX00 RESET AMARSW 43370021 LR R5,R1 SET PTR TO POSITION AFTER U 43380021 * 43390021 * 43400021 ULSOUT EQU * 43410021 TM GTRTSW,XX10 SHOULD GETCD GET CONTROL 43420021 BC ZERO,WRDEXT NO - EXIT 43430021 STM R1,R15,GTWDSV SAVE GETWD REGS 43440021 LM R1,R15,GTCDSV YES - RESTORE GETCD REGS 43450021 NI GTRTSW,XXEF SET SW OFF 43460021 BR JP GET CARD RTN 43470021 * 43480021 STUNIT MVC DX0(LX0,R3),DX0(R5) 43490021 * 43500021 EJECT 43510021 IKF107 CSECT 43520021 *=1 PROCEDURE DIVISION SCAN 43530021 USING PDSCN,JQ 43540021 USING EXHSVB,JJ 43550021 * 43560021 ***************************************** 43570021 ***** PROCEDURE DIVISION SCAN ***** 43580021 ***************************************** 43590021 PDSCN MVI DIVCOD,XX02 SET DIVCOD TO '02' 43600021 XC TEMPSW(LX3),TEMPSW 43610021 BAL JP,GENA -GENA 43620021 MVC CRDGCN+NX1(LX2),CURGCN GCN 43630021 LA JF,CRDGCN ADDR OF CARD NUMBER TEXT 43640021 BAL JP,GENB -GENB 43650021 BAL JP,DUMGEN -DUMGEN 43660021 PDEOS CLC NXTCOD(LX2),EOSCON IS IT EOS 43670021 BNE PDUSIN NO 43680021 BAL JP,CHKDIV CK DIV NAME RTN 43690021 B PDDCL MOVE PROC NAME CONSTANT FOR PD 43700021 PDENT2 L JA,COSADR WRITE 43710021 BALR JR,JA P1 TEXT 43720021 DC X'12' ON FILE 2 43730021 BR JP RETURN 43740021 PDENT4 L JA,COSADR WRITE 43750021 TM PHZSW3,VERBR LISTING A-TEXT OPTION 43760021 BNO DX0(JP) NO - RETURN 43770021 BALR JR,JA A TEXT 43780021 DC X'12' ON FILE 2 43790021 BR JP RETURN 43800021 PDUSIN MVC DIVNM(LX31),CURCNT MOVE PROCEDURE TO DVIISION N 43810021 BAL JP,GETWD GET NEXT WORD 43820021 CLC CURCOD(LX2),USICON IS IT USING 43830021 BNE PDDCL NO 43840021 LA JB,GENENT 43850021 MVC ENTCDN(LX2),CURGCN EN OUT CARDNO 43860021 OI ENTCDN,XX80 43870021 L R1,COSADR ENTRY VERB CODE 43880021 MVC ENTLIT(LX8),PROGID PROGRAM-ID 43890021 LA JC,DX15 43900021 BAL JP,PDENT2 WRITE ON FILE 2 RTN 43910021 LA JC,DX7 LENGTH OF LISTING A-TEXT 43920021 LA JB,F4ENTCD ADDR OF ENTRY A-TEXT 43930021 BAL JP,PDENT4 WRITE ON FILE 4 RTN 43940021 OI SRTSW,XX04 43950021 PDUSI2 BAL JP,CHKOUT CK IF QUAL-BCD-NAME 43960021 CLC CURCOD(LX2),EOSCON EOS 43970021 BNE PDUSI2 NO 43980021 BAL JP,CHKOUT CK IF QUAL-BCD-NAME 43990021 NI SRTSW,XXFB 44000021 CLC CURCOD(LX2),DECLCD IS IT DECLARATIVES 44010021 BNE PDDCL NO 44020021 LA JB,GENENT GEN OUT 44030021 LA JC,DX3 CARD 44040021 BAL JP,PDENT2 WRITE ON FILE 2 RTN 44050021 BAL JP,GNGN BUMP GNCTR 44060021 MVC GOPN(LX2),GPTID1 MOVE GN NUM 44070021 LA JB,GENGO 44080021 LA JC,DX7 EN OUT GO TO GN 44090021 BAL JP,PDENT2 WRITE ON FILE 2 RTN 44100021 LA JC,DX4 GEN OUT GO A-TEXT 44110021 LA JB,F4GOCD ADDR OF ENTRY A-TEXT 44120021 BAL JP,PDENT4 WRITE ON FILE 4 RTN 44130021 OI ENTSW,XX20 TURN ON ENTRY VERB SW 44140021 PDDCL MVC PROCCD(LX3),PROCON CWT FOR PROCEDURE 44150021 CLI CURCOD,XX42 CRITICAL PROG BREAK 44160021 BC NOTEQ,DELIM NO-DELIM 44170021 CLI CURN,XX07 DECLARATIVES 44180021 BC EQ,CHKDCL -CHKDCL 44190021 BC UNCOND,DELIM -DELIM 44200021 * 44210021 ***** TEST FOR MAJOR=0 AND VERB 'ON' ***** 44220021 * 44230021 MAJTST TM CURCOD,XX30 MAJOR IS '0' 44240021 BCR ZERO,JP YES-RETURN-JP 44250021 CLC CURCOD(LX2),ONCON IS WORD =ON' 44260021 BC NOTEQ,DX4(JP) NO-RETURN + 4 44270021 CLI NXTCOD,XX32 FOLLOWED BY NUM LIT 44280021 BC NOTEQ,DX4(JP) NO-RETURN + 4 44290021 MVI CURCOD,XX44 MAKE WORD VERB 'ON' 44300021 BCR UNCOND,JP -RETURN JP 44310021 EJECT 44320021 * 44330021 ***** CHECK DECLARATIVES ***** 44340021 * 44350021 CHKDCL BAL JP,GENA -GENA PUT OUT DECLARATIVES 44360021 BAL JP,CHKEOS -CHKEOS 44370021 OI LCCHAR+NX1,XX10 SET D TO 1 (IN DECL) 44380021 OI DECSEG,XX02 TURN ON IF IN DECL. 44390021 OI IOSW,XX80 USE SHOULD FOLLOW SW 44400021 BC UNCOND,DELIM -DELIM 44410021 * 44420021 ***** DECLARATIVES SCAN ***** 44430021 * 44440021 * SN - CHECK FOR USE 44450021 DCLSN MVI LCRPD,XX00 SET RPD-NUM TO '0' 44460021 CLC CURCOD(LX2),USECON USE 44470021 BC NOTEQ,DCLMSG NO-DCLMSG 44480021 BC UNCOND,USEGEN YES-USEGEN 44490021 * PN - CHECK FOR USE 44500021 DCLPN CLC CURCOD(LX2),USECON USE 44510021 BC NOTEQ,DCLOUT NO-DCLOUT 44520021 OI LCCHAR,XX40 MAKE PN INTO SN (T-1) 44530021 MVI LCRPD,XX00 SET RPD-NUM TO '0' 44540021 BC UNCOND,USEMSG -USEMSG 44550021 * EXIT FROM DECLARATIVES SCAN - NO-USE 44560021 DCLMSG BAL JP,MSG6 -MSG6 44570021 NI IOSW,XX7F SET OFF 1ST USE ERR SW 44580021 DCLOUT TM IOSW,XX80 USE S/B IN DECLARATIVES 44590021 BO DCLMSG YES - MSG 44600021 BAL JP,DICENT -DICENT 44610021 BC UNCOND,DELIM -DELIM 44620021 * 44630021 ***** USE VERB ***** 44640021 * 44650021 USESVB OI DUMUSE,XX08 SET ON DUMUSE 44660021 BAL JP,DUMGEN -DUMGEN 44670021 NI DUMUSE,XXF7 SET OFF DUMUSE 44680021 USEMSG BAL JP,MSG31 -MSG31 44690021 USEGEN BAL JP,GENSEQ -GENSEQ 44700021 NI IOSW,XX7F 44710021 BAL JP,GENA -GENA 'USE' 44720021 NI LCCHAR+NX1,XXF0 RESET 'USE' CHAR BITS 44730021 NI PRDSW,XXFB SET PRDSW 'OFF' 44740021 XC USEFL1(LX1),USEFL1 44750021 BAL JP,GETWD -GETWD 44760021 CLI CURCOD,XX54 COBOL WORD 44770021 BC NOTEQ,USERRA NO-USERRA 44780021 CLI CURN,XX69 BEFORE 44790021 BNE USEFR NO - COMP TO - FOR 44800021 OI USEFL1,USEBF TURN ON BEFORE BIT 44810021 B USAENT GO TO PUT ON FILE 2 44820021 USEFR CLI CURN,XXA3 FOR 44830021 BC EQ,USAENT YES-USAENT 44840021 CLI CURN,XX72 AFTER 44850021 BC NOTEQ,USBENT NO-USBENT 44860021 OI USEFL1,USEAF TURN AFTER BIT ON 44870021 USAENT BAL JP,GENA -GENA 44880021 BAL JP,GETWD -GETWD 44890021 CLI CURCOD,XX54 COBOL WORD 44900021 BC NOTEQ,USERRA NO-USERRA 44910021 USBENT CLI CURN,XX6A REPORTING 44920021 BC EQ,USFENT YES-USFENT 44930021 * CLI CURN,X'67' RANDOM 44940021 * BE USGENT YES 44950021 CLI CURN,XXD5 STANDARD 44960021 BC NOTEQ,USDENT NO-USDENT 44970021 TM USEFL1,USEBF+USEAF BEFORE OR AFTER SPECIFIED 44980021 BZ USERRA NOO 44990021 USCENT BAL JP,GENA -GENA 45000021 BAL JP,GETWD -GETWD 45010021 CLI CURCOD,XX54 COBOL WORD 45020021 BC NOTEQ,USERRA NO-USERRA 45030021 USDENT CLI CURN,XX84 ERROR 45040021 BC EQ,USHENT YES-USHENT 45050021 CLI CURN,XX61 BEGINNING 45060021 BC EQ,USJENT YES-USJENT 45070021 CLI CURN,XX62 ENDING 45080021 BC NOTEQ,USJNT2 NO-USJNT2 45090021 OI USEFL1,USEEN ENDING BIT ON 45100021 B USJNT1 PUT ON FILE 2 45110021 USEENT TM CURSW,XX01 IN A-MARGIN 45120021 BC ONES,USERRA YES-USERRA 45130021 BAL JP,MAJTST IS MAJOR-0 45140021 BC UNCOND,USERRA YES-USERRA 45150021 BC UNCOND,USJNT1 NO-USJNT1 45160021 USJENT OI USEFL1,USEBG BEGINNING BIT ON 45170021 USJNT1 BAL JP,GENA -GENA 45180021 BAL JP,CHKON -CHKON 45190021 BAL JP,GETWD -GETWD 45200021 USJNT2 EQU * 45210021 USJNT3 CLI CURCOD,XX54 COBOL WORD 45220021 BC NOTEQ,USEENT NO-USEENT 45230021 CLI CURN,XX3C FILE 45240021 BNE USERLU NO 45250021 OI USEFL1,USEFL TURN ON FILE BIT 45260021 B USJNT1 PUT ON FILE 2 45270021 USERLU CLI CURN,XX17 REEL 45280021 BE USERL YES 45290021 CLI CURN,XXA2 UNIT 45300021 BNE USJNT4 NO 45310021 USERL OI USEFL1,USERU TURN ON REEL/UNIT BIT 45320021 B USJNT1 PUT ON FILE 2 45330021 USJNT4 CLI CURN,XXD1 LABEL 45340021 BNE USERRA NO 45350021 BAL JP,GENA PUT CODE ON FILE TWO 45360021 BAL JP,GETWD GET NEXT WORD 45370021 CLI CURN,XX99 PROCEDURE 45380021 BNE USERRA NO 45390021 BAL JP,GENA PUT ON FILE TWO 45400021 BAL JP,CHKON CHKON 45410021 BAL JP,GETWD GET NEXT WORD 45420021 CLI CURCOD,XX23 BCD FILE NAME 45430021 BE USEFLG YES 45440021 CLI CURCOD,XX54 COBOL WORD 45450021 BNE USERRA NO 45460021 CLI CURN,XX64 OUTPUT 45470021 BE USEOUT YES 45480021 CLI CURN,XX66 INPUT 45490021 BE USEINP YES 45500021 CLI CURN,XX6B I-O 45510021 BNE USERRA NO 45520021 TM USEFL1,USEBF YES IS IT BEFORE 45530021 BO USIOBF YES 45540021 CLC IOGNBF(LX8),FRHWZ NO ANY BEFOR GN'S IN I-O TB 45550021 BNE ERRMX YES 45560021 LA JH,IOGNAF ADDR OF GN TBL FOR I-O AFTE 45570021 B SETGN MOVE GN OR GN'S 45580021 USIOBF CLC IOGNAF(LX8),FRHWZ ANY AFTER GN'S IN I-O TBL 45590021 BNE ERRMX YES 45600021 LA JH,IOGNBF ADDR OF GN TBL FOR I-O BEFO 45610021 B SETGN MOVE GN OR GN'S 45620021 USEOUT TM USEFL1,USEBF IS IT BEFORE 45630021 BO USOUBF YES 45640021 CLC OUGNBF(LX8),FRHWZ AFTER ANY BEF GN'S IN OUTPU 45650021 BNE ERRMX YES 45660021 LA JH,OUGNAF ADDR OF GN TBL FOR OUTPUT A 45670021 B SETGN MOVE GN OR GNS 45680021 USOUBF TM TOTUSD,XX80 WAS TOTALED SPEC'D IN PROGRA 45690021 BZ USOUB1 NO 45700021 BAL JP,MSG27 MSG INVALID OPEN 45710021 USOUB1 CLC OUGNAF(LX8),FRHWZ ANY AFTER GN'S IN OUTPUT TBL 45720021 BNE ERRMX YES 45730021 LA JH,OUGNBF ADDR OF GN TBL FOR OUTPUT B 45740021 B SETGN MOVE GN OR GN'S 45750021 USEINP TM USEFL1,USEBF IS IT BEFORE 45760021 BO USINBF YES 45770021 CLC INGNBF(LX8),FRHWZ ANY BEF GN'S IN INPUT TBL 45780021 BNE ERRMX YES 45790021 LA JH,INGNAF ADDR OF GN TBL FOR INPUT AF 45800021 B SETGN MOVE GN OR GN'S 45810021 USINBF CLC INGNAF(LX8),FRHWZ ANY AFTER GN'S IN INPUT TBL 45820021 BNE ERRMX YES 45830021 LA JH,INGNBF ADDR OF GN TBL FOR INPUT BE 45840021 B SETGN MOVE GN OR GN'S 45850021 USEFLG LA JG,CURN 45860021 BAL JP,SCHFNT SEARCH FNTBL 45870021 TM SCHSW,XX40 FOUND 45880021 BZ USKKNT NO 45890021 TM FNFL1(JB),FNLRS+FNLRO ARE LABELS OMITTED OR STAND 45900021 BM ERRUSF YES 45910021 TM USEFL1,USEBF IS IT BEFORE 45920021 BO USFLBF YES - CK AFTER BIT 45930021 TM FNFL1(JB),FNBEF 45940021 BO ERRMX ERR MSG 143 45950021 OI FNFL1(JB),FNAFT TURN ON AFTER BIT IN FNTBL 45960021 USFLST LA JH,FNGNHL(JB) ADDR OF GN TBL IN FNTBL 45970021 LH JC,FNPIOT(JB) PIO POINTER 45980021 BAL JP,SETPIO GET PIO ENTRY 45990021 OI PIOFL3(JE),PIOUSF TURN ON USE ON FILENAME BIT 46000021 TM USEFL1,USEBF BEFORE ? 46010021 BZ *+8 NO 46020021 OI PIOFL3(JE),PIONST YES, SET ON IN PIOTBL 46030021 *********** ************* 46040021 MVC TOTPTR(LX2),SCHPTR+NX2 STORE DISP 46050021 OI USEFL1,USETOT CHECK FOR TOTALED AREA 46060021 USFLS1 B SETGN MOVE GN OR GN'S 46070021 USFLBF TM FNFL1(JB),FNAFT IS AFTER BIT ON IN FNTBL 46080021 BO ERRMX YES 46090021 OI FNFL1(JB),FNBEF TURN ON BEFORE BIT IN FNTBL 46100021 B USFLST GET GN FROM FNTBL 46110021 * 46120021 * JH POINTS TO GNTBL FOR OPEN OPTION BEFORE OR OPEN OPTION AFTER 46130021 * IF FILENAME IS SPECIFIED JH POINTS TO FNTBL ENTRY. 46140021 * 46150021 SETGN LA JP,USKKNT 46160021 TM USEFL1,USEBG BEGINNING 46170021 BZ ENCHK NO 46180021 TM USEFL1,USEFL FILE 46190021 BZ BGRLU NO 46200021 BGRLF1 CLC DX0(LX2,JH),FRHWZ IS BOF IN TBL 0 46210021 BNE ERRUA NO 46220021 BGRLF MVC DX0(LX2,JH),LCNUM YES MOVE BOF 46230021 BR JP GO TO CK FIRST FILE RTN 46240021 BGRLU CLC DX6(LX2,JH),FRHWZ IS BOV IN TBL 0 46250021 BNE ERRUA NO 46260021 BGRLU1 MVC DX6(LX2,JH),LCNUM YES MOVE BOV 46270021 TM USEFL1,USERU REEL/UNIT 46280021 BZ BGRLF1 NO 46290021 BR JP RETURN 46300021 ENCHK TM USEFL1,USEEN ENDING 46310021 BZ BGEDCK NO 46320021 TM USEFL1,USEFL FILE 46330021 BZ EDRLU NO 46340021 EDRLF1 CLC DX2(LX2,JH),FRHWZ IS EOF IN TBL 0 46350021 BNE ERRUA NO 46360021 EDRLF MVC DX2(LX2,JH),LCNUM YES MOVE EOF 46370021 BR JP GO TO CK FIRST FILE RTN 46380021 EDRLU CLC DX4(LX2,JH),FRHWZ IS EOV IN TBL 0 46390021 BNE ERRUA NO 46400021 EDRLU1 MVC DX4(LX2,JH),LCNUM YES MOVE EOV 46410021 TM USEFL1,USERU REEL/UNIT 46420021 BZ EDRLF1 NO 46430021 BR JP GO TO CK FIRST FILE RTN 46440021 BGEDCK TM USEFL1,USEFL FILE 46450021 BZ BGEDRU NO 46460021 BGEBF EX JR,EDRLF1 EX IS EOF IN TBL 0 46470021 BNE ERRUA NO 46480021 EX JR,EDRLF MOVE EOF 46490021 B BGRLF1 GO CHECK FOR BEGIN OF FILE 46500021 BGEDRU EX JR,BGRLU EX IS BOV IN TBL 0 46510021 BNE ERRUA NO 46520021 EX JR,BGRLU1 MOVE BOV 46530021 EX JR,EDRLU EX IS EOV IN TBL 0 46540021 BNE ERRUA NO 46550021 EX JR,EDRLU1 MOVE EOV 46560021 TM USEFL1,USERU REEL/UNIT 46570021 BZ BGEBF NO 46580021 BR JP CK 1ST FILE RTN 46590021 USKKNT TM USEFL1,USEF2 FIRST FILE 46600021 BO USLENT NO 46610021 OI USEFL1,USEF2 TURN ON MULTIPLE FILE SW 46620021 OI LCCHAR+NX1,XX04 SET L TO 1 LABEL-USE 46630021 OI USEPDL,XX10 46640021 BAL JP,DICENT -DICENT 46650021 USLENT BAL JP,GENA -GENA 46660021 TM USEFL1,USETOT SEARCH TOTTBL 46670021 BZ USFLS2 NO 46680021 LA JG,TOTCT ADDR TO SEARCH TOTTBL 46690021 BAL JP,SCHTOT SEARCH ON DISP 46700021 TM SCHSW,XX40 FOUND 46710021 BZ USFLS2 NO 46720021 TM USEFL1,USEBF IS IT BEFORE 46730021 BO TOTMSG YES-ERROR 46740021 USFLS2 BAL JP,GETWD GET NEXT WORD 46750021 CLI CURCOD,XX23 BCD FILENAME 46760021 BE USEFLG YES 43521 46770021 LA JP,VRBENT SET UP JP 43521 46780021 USFLS3 STM JR,JD,USESAV SAVE R0 - R4 43521 46790021 ST JP,USEJP SAVE JP 43521 46800021 LR JD,JQ SAVE BASE REGISTER 43521 46810021 L JA,COSADR ADDRESS COS 43521 46820021 MVC USAREA(LX2),PNCTR PN NUMBER 43521 46830021 MVC USAREA+NX2(LX1),USEFL1 ATTRIBUTES 43521 46840021 L JA,USDCON USETBL 43521 46850021 L JQ,ADSERT INSERT 43521 46860021 BALR JP,JQ X 43521 46870021 LR JQ,JD RESTORE BASE REGISTER 43521 46880021 MVC DX0(LX3,JB),USAREA INSERT ENTRY 43521 46890021 LM JR,JD,USESAV RESTORE R0 - R4 43521 46900021 L JP,USEJP RESTORE JP 43521 46910021 BR JP CONTINUE 43521 46920021 * 43521 46930021 * USE FOR RANDOM PROCESSING 46940021 *USGENT LA JG,LCBCD ADDR OF SN 46950021 * BAL JP,SCHAPT SEARCH APPTBL 46960021 * TM SCHSW,XH40' NAME FOUND 46970021 * BO USGGNT YES 46980021 * BAL JP,MSG35 NO - ERRMSG 46990021 * B USGGXT 47000021 *USGGNT MVC LCRPD(1),1(JB) PUT RPDNUM IN DICT WORK ENTR 47010021 *USGGXT OI LCCHAR+1,X'02' SET M TO 1 (RANDOM-USE) 47020021 * BAL JP,DICENT ENTER IN DICT 47030021 * B VRBGEN 47040021 * USE AFTER STANDARD ERROR PROCEDURE ON FILE-NAME 47050021 USHENT EQU * 47060021 USHHNT BAL JP,GENA -GENA 47070021 BAL JP,GETWD -GETWD 47080021 CLC CURCOD(LX2),PROCCD PROCEDURE 47090021 BNE USERRA PUT OUT INCORRECT USAGE MSG. 47100021 BAL JP,GENA PUT OUT ON FILE 2 47110021 BAL JP,CHKON GO TO CHECK ON RTN 47120021 BAL JP,GETWD GET NEXT WORD 47130021 CLI CURCOD,XX54 COBOL WORD 47140021 BNE USHENA CK BCD NAME 47150021 CLI CURN,XX64 OUTPUT 47160021 BE USERON YES -CK FOR OUTPUT ERR 47170021 CLI CURN,XX66 INPUT 47180021 BE USERIN YES -CK FOR INPUT ERR 47190021 CLI CURN,XX6B I-O 47200021 BNE USERRA NO -CK LABEL INFO 47210021 CLC IOSTER(LX2),FRHWZ WAS ERROR FOR I-O SPEC'D 47220021 BNE ERRUA YES 47230021 MVC IOSTER(LX2),LCNUM MOVE I-O GN FOR ERROR 47240021 BAL JP,USFLS3 MAKE USETBL ENTRY 43521 47250021 B USHEND PUT ON FILE 2 - GET CUR CODE 47260021 USERON CLC OUSTER(LX2),FRHWZ WAS ERROR FOR OUTPUT SPEC'D 47270021 BNE ERRUA YES 47280021 MVC OUSTER(LX2),LCNUM MOVE OUTPUT GN 47290021 BAL JP,USFLS3 MAKE USETBL ENTRY 43521 47300021 B USHEND PUT ON FILE 2 - GET CUR CODE 47310021 USERIN CLC INSTER(LX2),FRHWZ WAS ERROR FOR INPUT SPEC'D 47320021 BNE ERRUA YES 47330021 MVC INSTER(LX2),LCNUM MOVE GN FOR INPUT 47340021 BAL JP,USFLS3 MAKE USETBL ENTRY 43521 47350021 B USHEND PUT ON FILE 2 47360021 USHENA CLI CURCOD,XX23 BCD-FILE-NAME 47370021 BC EQ,USHENB YES-USHENB 47380021 BAL JP,MSG23 -MSG23 47390021 BC UNCOND,USHEND -USHEND 47400021 USHENB LA JG,CURN ADDR OF FILE-NAME 47410021 BAL JP,SCHFNT -SCHFNT-SEARCH FNTBL 47420021 TM SCHSW,XX40 WAS NAME FOUND 47430021 BC ZERO,USHENC NO-USHENC 47440021 MVC LCRPD(LX1),DX3(JB) GET RPD NUM FROM FNTBL TO W 47450021 CLC FNGNSE(LX2,JB),FRHWZ WAS ERROR GN SPEC'D FOR FILE 47460021 BNE ERRUA YES 47470021 MVC FNGNSE(LX2,JB),LCNUM MOVE ERROR GN FOR FILE 47480021 BAL JP,USFLS3 MAKE USETBL ENTRY 43521 47490021 BC UNCOND,USHEND -USHEND 47500021 * 47510021 USHENC BAL JP,MSG24 -MSG24 47520021 USHEND BAL JP,GENA -GENA 47530021 BAL JP,GETWD -GETWD 47540021 USHENE OI LCCHAR+NX1,XX08 SET K TO 1 (ERROR-USE) 47550021 TM INSRSW,XX20 47560021 BO *+NX8 GO PUT IN DICTIONARY 47570021 BAL JP,DICENT -DICENT 47580021 OI USEPDE,XX08 USE ERROR 47590021 OI INSRSW,XX20 NO INSERT IN DICT 47600021 CLI CURCOD,XX23 FILENM2 ? 47610021 BE USHENB ENTER SECTION NM AGAIN 47620021 NI INSRSW,XXDF 47630021 BC UNCOND,VRBENT -VRBENT 47640021 * 47650021 * USE BEFORE REPORTING 47660021 USFENT BAL JP,GENA -GENA 47670021 BAL JP,GETWD -GETWD 47680021 LA JF,EOSCON GEN OUT 47690021 BAL JP,GENB EOS 47700021 OI PRDSW,XX04 SET 'ON' PRDSW 47710021 * 47720021 BAL JP,MAJTST MAJOR-0 47730021 BC UNCOND,USFDNT YES-USFDNT 47740021 TM CURSW,XX01 A-MARGIN 47750021 BC ONES,USFCNT YES-USFCNT 47760021 * 47770021 USFBNT CLI CURCOD,XX23 DATA-NAME 47780021 BC EQ,USFANT YES-USFANT 47790021 BAL JP,MSG32 -MSG32 47800021 BAL JP,CHKIN -CHKIN 47810021 BC UNCOND,*-NX4 -*-4 47820021 * 47830021 USFANT OI LCCHAR+NX1,XX01 SET N TO 1 REPORT-USE 47840021 BAL JP,USFLS3 MAKE USETBL ENTRY 43521 47850021 BAL JP,UBRTN -UBRTN 47860021 BAL JP,DICENT -DICENT 47870021 BAL JP,CHKIN -CHKIN 47880021 BAL JP,MSG52 -MSG52 47890021 BAL JP,CHKIN -CHKIN 47900021 BC UNCOND,*-NX4 -*-4 47910021 * 47920021 USFCNT BAL JP,CHKLHN -CHKLHN 47930021 BC UNCOND,USFDNT YES-USFDNT 47940021 BC UNCOND,USFBNT -USFBNT 47950021 * 47960021 USFDNT BAL JP,MSG51 -MSG51 47970021 BC UNCOND,DELIM -DELIM 47980021 * 47990021 TOTMSG BAL JP,MSG153 TOTALED AREA ILLEG 48000021 B USFLS2 GO TO GET NEXT WORD 48010021 * 48020021 USERRA BAL JP,MSG32 -MSG32 48030021 BAL JP,DICENT -DICENT 48040021 BC UNCOND,VRBENT -VRBENT 48050021 * 48060021 ERRUA EQU * 48070021 BAL JP,MSG133 MORE THAN 1 USE ON STAND. ERR 48080021 B ERRMX+LX4 GO TO DICT ENTRY 48090021 ERRMX BAL JP,MSG143 USE STATEMENTS IGNORED 48100021 BAL JP,DICENT GO TO DICT ENTRY 48110021 B VRBENT GO TO VERB ENTRY 48120021 ERRUSF BAL JP,MSG134 USE INCORR FOR LABEL INFO 48130021 B ERRMX+LX4 GO TO DICT ENTRY 48140021 ***** 48150021 ***** 48160021 PIUSB LH JC,FNPIOT(JB) PIOTBL PTR 48170021 PIUSB1 ST JP,SV1F12 48180021 BAL JP,SETPIO GET PIOTBL ENTRY 48190021 OI PIOFL2(JE),PIOUSE TURN ON USE LABEL OR ERROR 48200021 L JP,SV1F12 48210021 BR JP - RETURN 48220021 PIUSB2 ST JP,SV1F12 SAVE RETURN REG 48230021 BAL JP,SETPIO GO GET RIGHT PIOTBL ENTRY 48240021 OI PIOFL3(JE),PIONST SET NSL BIT ON 48250021 L JP,SV1F12 RESTORE REGISTER 48260021 BR JP RETURN TO CALLER 48270021 ***** 48280021 * GET ADDR OF ENTRY IN PIOTBL, HAVING PTR TO IT. 48290021 SETPIO L JE,PIOCON PIOTBL-TIB 48300021 L JE,DX0(JE) PIOTBL-TAMM 48310021 L JE,DX0(JE) PIOTBL-ADDR 48320021 LA JE,DX0(JC,JE) ADDR OF PIOTBL ENTRY 48330021 BCR UNCOND,JP -RETURN 48340021 * 48350021 EJECT 48360021 *=2 DELIM 48370021 * 48380021 ***** DELIM SCAN ***** 48390021 * 48400021 DELIM CLC CURCOD(LX2),EOSCON EOS 48410021 BC NOTEQ,DELMAJ NO-DELMAJ 48420021 DLAENT BAL JP,GETWD -GETWD 48430021 BC UNCOND,DELIM -DELIM 48440021 DELMAJ BAL JP,MAJTST MAJOR IS '0' TEST 48450021 BC UNCOND,DLOKPD YES-DLOKPD 48460021 TM CURSW,XX01 NO-IS IT IN A-MARGIN 48470021 BC ZERO,DLBENT NO-DLBENT 48480021 BAL JP,CHKLHN -CHKLHN 48490021 BC UNCOND,LHNAM YES-LHNAM 48500021 DLBENT NI PRDSW,XXFB SET 'OFF' PRDSW 48510021 BC UNCOND,VRBGEN -VRBGEN 48520021 DLOKPD TM CURDCD,XX02 OK FOR PROCEDURE DIV 48530021 BC ONES,DLCENT YES-DLCENT 48540021 BAL JP,MSG98 -MSG98 48550021 MVC CURCOD(LX2),ERRCOD MAKE CODE ERROR CODE 48560021 BC UNCOND,DLBENT -DLBENT 48570021 DLCENT CLI CURCOD,XX42 CRITICAL PROG BREAK 48580021 BC EQ,DELEND YES-DELEND 48590021 CLI CURCOD,XX44 CRITICAL COBOL WORD 48600021 BC EQ,VRBSCN YES-VRBSCN 48610021 BC NOTEQ,DLBENT NO-DLBENT 48620021 DELEND CLI CURN,XX08 END-DECLARATIVES 48630021 BC NOTEQ,DELDCL NO-DELDCL 48640021 TM LCCHAR+NX1,XX10 IN DECLARATIVES 48650021 BC ONES,DELGEN YES-DELGEN 48660021 BAL JP,MSG93 NO-MSG93 48670021 BC UNCOND,DLAENT -DLAENT 48680021 DELGEN BAL JP,GENA -GENA 48690021 NI DECSEG,XXFD TURN OFF DECLARATIVES SW 48700021 NI LCCHAR+NX1,XXE0 SET 'OFF' ALL DECL BITS 48710021 MVI LCRPD,XX00 SET RPD-NUM TO '0' 48720021 BAL JP,CHKEOS -CHKEOS 48730021 TM ENTSW,XX20 ENTRY GN TO BE GENERATED 48740021 BZ DELEPN NO 48750021 MVI GODEF,XX88 MOVE GN DEF CODE 48760021 LA JF,GODEF GNE OUT GN DEF 48770021 BAL JP,GENB PUT ON FILE 2 48780021 NI ENTSW,XXDF TURN OFF ENTRY VERB SW 48790021 DELEPN OI DHDRSW,XX08 48800021 BC UNCOND,DELIM -DELIM 48810021 DELDCL CLI CURN,XX07 DECLARATIVES 48820021 BC NOTEQ,DELEOP NO-DELEOP 48830021 TM CURSW,XX01 IN 'A-MARGIN' 48840021 BC ZERO,DLBENT NO-DLBENT 48850021 BAL JP,MSG92 NO-MSG92 48860021 BC UNCOND,DLAENT -DLAENT 48870021 DELEOP CLI CURN,XXFF EOP 48880021 BC EQ,PROEND YES-PROEND 48890021 BC UNCOND,DLAENT -DLAENT 48900021 EJECT 48910021 *=2 LHN 48920021 * 48930021 ***** CHECK LHN ***** 48940021 * 48950021 CHKLHN ST JP,SV1F02 SAVE LINK REG 48960021 CLI CURCOD,XX23 BCD NAME 48970021 BCR EQ,JP YES-RETURN 48980021 CLI CURCOD,XX32 NUMERIC LITERAL 48990021 BC NOTEQ,LHNERR NO-LHNERR 49000021 CLI CURBCD+NX1,XX00 INTEGRAL 49010021 BC EQ,LHNBCD YES-LHNBCD 49020021 LHNERR BAL JP,MSG91 -MSG91 49030021 L JP,SV1F02 RESTORE LINK REG 49040021 BC UNCOND,DX4(JP) -RETURN-ERROR 49050021 LHNBCD LA JB,CURN ADDR OF CURN 49060021 LA JG,CURCNT ADDR OF CURCNT 49070021 IC JD,CURCNT SIZE OF NAME 49080021 EX JD,TXMOVE MOVE LIT IN BCD TO CURN 49090021 MVI CURCOD,XX23 SET CODE TO '23' 49100021 BCR UNCOND,JP -RETURN 49110021 * 49120021 ***** LH NAME SCAN ***** 49130021 * 49140021 LHNAM MVI CURCOD,XX05 CODE AS LHN 49150021 CLI COMWRK+NX6,XX40 IS COLUMN7 BLANK 7075 49160021 BE COL7OK YES,-COL7OK 7075 49170021 BAL JP,MSG150 NO,-PARAGRAPH NAME IN COL 77075 49180021 COL7OK TM DHDRSW,XX08 DHDRSW 'ON' 7075 49190021 BC ZERO,LHNGEN NO-LHNGEN 49200021 NI DHDRSW,XXF7 SET OFF DHDRSW 7453 49210021 CLC NXTCOD(LX2),SCTCON NEXT IS SECTION 49220021 BC EQ,LHNX BYPASS DUNGEM 7453 49230021 BAL JP,DUMGEN -DUMGEN 49240021 BC UNCOND,LHNX BYPASS 7453 49250021 LHNGEN CLC NXTCOD(LX2),SCTCON NEXT WORD SECTION 7453 49260021 BE LHN1 CHECK FOR DUPLICATE 7453 49270021 LHNX BAL JP,GENSEQ WRITE P-/ 7453 49280021 BAL JP,GENA -GENA 49290021 MVC LCBCD(LX31),CURCNT LHN TO 'BCD-NAME AREA' 49300021 CLC NXTCOD(LX2),SCTCON NEXT IS SECTION 49310021 BC EQ,LHNSCT YES-LHNSCT 49320021 BAL JP,CHKPAR -CHKPAR 49330021 NI LCCHAR,XXBF SET T-0 49340021 BC UNCOND,LHNSWH -LHNSWH 49350021 LHNSCT BAL JP,CHKSKT -CHKSKT 49360021 OI LCCHAR,XX40 SET 'T' TO '1' 49370021 LHNSWH OI CURSW,XX02 SET CURSW TO SHOW LHN PRECE 49380021 BAL JP,LHNNUM GET NEW PN NUMBER 49390021 BAL JP,INCLCK -INCLCK 49400021 TM LCCHAR+NX1,XX10 IN DECLARATIVES 49410021 BC ZERO,LHNOUT NO-LHNOUT 49420021 TM LCCHAR,XX40 SECTION-NAME 49430021 BC ONES,DCLSN YES-DCLSN 49440021 BC UNCOND,DCLPN NO-DCLPN 49450021 LHNOUT BAL JP,DICENT -DICENT (LHN TO DICT) 49460021 BC UNCOND,DELIM -DELIM 49470021 * 49480021 LHN1 MVC LOCNAM(LX32),CURCNT SET UP 49490021 MVC RNMBCD+NX1(LX3),LOCNAMAD FOR LOC ATTRIB 49500021 LA JA,RNMBCD FOR LOCATE NAME 7453 49510021 L JQ,LATRCN ADDR OF LATRNM 7453 49520021 BALR JP,JQ CALL ACCESS 7453 49530021 STC JQ,DICTRTN SAVE RETURN CODE 7453 49540021 L JQ,SVREG+NX56 RESTORE R 15 7453 49550021 CLI DICTRTN,XX04 DUPLICATE NAME 7453 49560021 BE LHNX ENTER IT IN DICTIONARY 7453 49570021 BAL JP,MSG139 YES - GIVE MESSAGE 49580021 BAL JP,GETWD PUT SECTION INTO CUR 7453 49590021 BAL JP,GETWD BYPASS WORD SECTION 7453 49600021 BC UNCOND,DELIM CONTINUE PROCESSING 7453 49610021 LHNNUM L JA,COSADR ADDR OF COS 49620021 LH JC,PNCTR 49630021 LA JC,DX1(JC) INCREASE BY ONE 49640021 STH JC,PNCTR 49650021 STH JC,LCNUM STOR IN LCNUM FIELD 49660021 BCR UNCOND,JP -RETURN 49670021 * 49680021 EJECT 49690021 *=2 PROCEDURE NAME 49700021 * 49710021 ***** PROCEDURE NAME + QUAL NAME SCAN ***** 49720021 * 49730021 PRONAM TM CURSW,XX01 IN 'A' MARGIN 49740021 BC ONES,DX4(JP) YES-RETURN NOT FOUND 49750021 PRONMD ST JP,SV1F03 SAVE LINK REG 49760021 NI DSQLSW,XX3F SET DSQLSW + QLPNSW 'OFF' 49770021 XC PNBCDQ(LX32),PNBCDQ 49780021 MVI PNQLCD,XX22 INITIALIZE 49790021 CLI CURCOD,XXA2 QUAL BCD NAME 49800021 BC EQ,PROQLF YES-PROQLF 49810021 CLI CURCOD,XX23 BCD NAME 49820021 BC EQ,PROGEN YES-PROGEN 49830021 TM CURSW,XX08 INT-NUM-LIT 49840021 BC ZERO,DX4(JP) NO-RETURN + 4 49850021 PROCOD MVC CURN(LX31),CURCNT MAKE NUM-LIT BCD FORM 49860021 MVI CURCOD,XX23 CODE AS BCD-NAME 49870021 PROGEN BAL JP,GENA -GENA 49880021 B PROGSK RESTORE REG. AND RETURN 49890021 PROGN2 ST R2,CPYSAV+NX20 END OF COPY QUAL ENTRY 49900021 LM R1,R8,CPYSAV RESTORE REGS 1 - 8 49910021 L JQ,SVCALP 49920021 ST JQ,LNKR15 49930021 PROGSK EQU * 49940021 L JP,SV1F03 RESTORE LINK REG 49950021 BCR UNCOND,JP -RETURN 49960021 * 49970021 CQLFAQ STM R1,R8,CPYSAV STORE COPY REGS 1 - 8 49980021 QLFNAM ST JP,SV1F03 SAVE LINK REG 49990021 PROQLF NI DSQLSW,XX7F SET DSQLSW 'OFF' 50000021 L JF,QLTCON ADDR OF TIB 50010021 L JF,DX0(JF) ADDR OF TAMM 50020021 L JE,DX0(JF) ADDR OF TABLE START 50030021 LH JD,DX4(JF) SIZE OF TABLE 50040021 LA JG,DX0(JD,JE) ADDR OF TABLE END+1 50050021 TM REPQSW,XX01 CALLED BY COPY-REPLACING RT 50060021 BC ZERO,QPNBLD NO - SKIP 50070021 LA R2,DX0(JD,R3) ADDR FOR ENTRY IN COPY WK A 50080021 ST R2,CPYSAV+NX16 SAVE END ADDR IN R5 50090021 QPNBLD LA JE,PNBCDQ ADDR OF BCD NM IN WK AREA 50100021 LA JF,PNQLCD ADDR OF WORK AREA 50110021 XR JA,JA CLEAR REG 50120021 XR JD,JD CLEAR REG 50130021 XR JH,JH CLEAR REG 50140021 BCTR JG,JR ADJ ADDR TO 'N' BYTE 50150021 QLFGET IC JD,DX0(JG) PUT 'N' IN JD 50160021 MVI DX0(JG),XX61 MOVE'/'BETWEEN NAMES FOR 50170021 SR JG,JD ADJ ADDR TO START OF NAME 50180021 AR JA,JD ADD NAME LENGTH FOR 50190021 SR R2,JD ADDR OF ENTRY IN COPY WK AR 50200021 QNBCTR BCTR JG,JR ADJ ADDR TO 'N' BYTE 50210021 CLI DX0(JG),XX00 END OF QUAL NAMES 50220021 BC EQ,QLTEND YES-QLTEND 50230021 LA JA,DX1(JA) ADD ONE FOR 'N' BYTE 50240021 STC JD,DX0(JE) PUT 'N' IN OUTPUT AREA 50250021 BCTR JD,JR ADJ SIZE FOR 'EX' 50260021 * 50270021 *** THE FOLLOWING CODE MOVES THE CONTENTS OF QLTAB TO 50280021 **** AN AREA WITHIN PH 1 . AFTER MOVE WDS APPEAR IN * 50290021 ***** WORK AREA AS THEY WOULD ON SOURCE CARD. * 50300021 * 50310021 TM REPQSW,XX01 REPLACING OPTION ? 50320021 BC ZERO,QNORML NORMAL QUALIFIER 50330021 EX JD,QLPMV2 50340021 SH R2,HWFOUR ADDR OF INCON MOVE 50350021 MVC DX0(LX4,R2),CINCON MOVE ' IN ' 50360021 B QLFGET LOOP AGAIN 50370021 * 50380021 * 50390021 QNORML EX JD,QLPMOV BCD NM TO OUTPUT AREA 50400021 LA JH,DX1(JH) COUNT NUMBER OF QUAL NAMES 50410021 BAL JP,GENB -GENB 50420021 BC UNCOND,QLFGET -QLFGET 50430021 * 50440021 QLPMV2 MVC DX0(LX0,R2),DX1(JG) MOVE TO WORK AREA 50450021 * 50460021 QLPMOV MVC DX1(LX0,JE),DX1(JG) 'EX' MOVE 50470021 * 50480021 QLTEND TM REPQSW,XX01 REPLACING 50490021 BC ZERO,QLTEN2 NO 50500021 BCTR JD,JR REDUCE FOR EX 50510021 EX JD,QLPMV2 50520021 B PROGN2 GO TO END OF COPY QUAL ENTRY 50530021 QLTEN2 CH JH,HWONE MORE THAN ONE QUAL NM 50540021 BC EQ,PROQSW NO-PROQSW 50550021 OI DSQLSW,XX80 SET DSQLSW 'ON' 50560021 PROQSW OI QLPNSW,XX40 SET QLPNSW 'ON' 50570021 BC UNCOND,PROCOD -PROCOD 50580021 EJECT 50590021 *=2 VERB SCAN 50600021 * 50610021 ***** VERB SCAN ***** 50620021 * 50630021 VRBSCN NI PRDSW,XXFB SET PRDSW 'OFF' 50640021 BAL JP,CHKVRB -CHKVRB 50650021 CLI CURN,XX31 USE 50660021 BC NOTEQ,VRBDHD NO-VRBDHD 50670021 TM LCCHAR+NX1,XX10 IN DECLARATIVES 50680021 BC ONES,USESVB YES-USESVB 50690021 VRBDHD TM DHDRSW,XX08 DHDRSW 'ON' 50700021 BC ZERO,*+NX8 NO-*+8 50710021 BAL JP,DUMGEN -DUMGEN 50720021 * 50730021 * CHECK FOR VERBS NEEDING SPECIAL HANDLING 50740021 * 50750021 CLI CURN,XX2F PROCESS 50760021 BC EQ,PROSVB YES-PROSVB 50770021 CLI CURN,XX30 HOLD 50780021 BC EQ,HOLSVB YES-HOLSVB 50790021 CLI CURN,XX11 GO 50800021 BC EQ,GOSVB YES-GOSVB 50810021 CLI CURN,XX1C ALTER 50820021 BC EQ,ALTSVB YES-ALTSVB 50830021 CLI CURN,XX38 PERFORM 50840021 BC EQ,PRFSVB YES-PRFSVB 50850021 CLI CURN,XX32 EXIT 50860021 BC EQ,EXTSVB YES-EXTSVB 50870021 CLI CURN,XXF7 NOTE 50880021 BC EQ,NOTSVB YES-NOTSVB 50890021 CLI CURN,XX5E SEARCH 50900021 BE SCHSVB YES- SCHSVB 50910021 CLI CURN,XX2E ENTER 50920021 BE ENRSVB YES 50930021 CLI CURN,XX29 READY 50940021 BC EQ,RDYSVB YES-RDYSVB 50950021 CLI CURN,XX3B *DEBUG 50960021 BC EQ,DEBSVB YES-DEBSVB 50970021 CLI CURN,XX27 EXHIBIT 50980021 BC EQ,EXHSVB YES-EXHSVB 50990021 CLI CURN,XX21 OPEN 51000021 BC EQ,OPNSVB YES-OPNSVB 51010021 CLI CURN,XX22 CLOSE 51020021 BC EQ,CLOSVB YES-CLOSVB 51030021 CLI CURN,XX23 WRITE 51040021 BC EQ,WRTSVB YES-WRTSVB 51050021 CLI CURN,XX24 REWRITE 51060021 BC EQ,RWRSVB YES-RWRSVB 51070021 CLI CURN,XX2D CALL 51080021 BC EQ,CALSVB YES-CALL 51090021 CLI CURN,XX36 SORT 51100021 BC EQ,SRTSVB YES-SRTSVB 51110021 *DEL 51120021 *DEL 51130021 CLI CURN,XX20 READ 51140021 BE REDSVB YES- REDSVB 51150021 CLI CURN,XX26 DISPLAY 51160021 BC EQ,DSPSVB YES-DSPSVB 51170021 CLI CURN,XX2C ENTRY 51180021 BE ENTSVB YES 51190021 CLI CURN,XX25 ACCEPT 51200021 BC EQ,ACCSVB YES-ACCSVB 51210021 CLI CURN,XX64 START 51220021 BE STTSVB YES - STTSVB 51230021 CLI CURN,XX63 SEEK 51240021 BE SEKSVB YES - SEKSVB 51250021 CLI CURN,XX33 INITIATE 51260021 BC EQ,INIT YES-INIT 51270021 CLI CURN,XX34 GENERATE 51280021 BC EQ,GENR YES-GENR 51290021 CLI CURN,XX35 TERMINATE 51300021 BC EQ,TERM YES-TERM 51310021 CLI CURN,XXF5 COPY 51320021 BC NOTEQ,VRBGCN NO-VRBGCN 51330021 BAL JP,MSG9 -MSG9 51340021 BC UNCOND,VRBGET -VRBGET 51350021 VRBGCN BAL JP,GENSEQ GEN CARD NUM - F4 SEQ NUM - F2 51360021 VRBGEN BAL JP,GENA -GENA 51370021 VRBGET CLC CURCOD(LX2),EOSCON CUR HAS PERIOD? 2392 51380021 BC EQ,CHKAMR YES - CHKAMR 2392 51390021 BAL JP,GETWD NO - GETWD 2392 51400021 B VRBENT - VRBENT 2392 51410021 CHKAMR CLI NXTCOD,XX23 BCD NAME? 2392 51420021 BC NOTEQ,VRBEN1 NO - VRBEN1 2392 51430021 TM NXTSW,XX01 A-MARGIN? 2392 51440021 BC ONES,VRBEN1 YES - VRBEN1 2392 51450021 BAL JP,GENSEQ GEN CD # - F4 SEQ # - F2 2392 51460021 BAL JP,MSG86 A-MARGIN MESSAGE 2392 51470021 BAL JP,GETWD GET WORD 2392 51480021 VRBEN1 BAL JP,GETWD GET WORD 2392 51490021 VRBENT BAL JP,MAJTST MAJOR IS '0' TEST 51500021 BC UNCOND,VRBMAJ YES-VRBMAJ 51510021 TM CURSW,XX01 NO-IS IT IN A-MARGIN 51520021 BC ZERO,VRCENT NO-VRCENT 51530021 VEDENT BAL JP,CHKLHN -CHKLHN 51540021 BC UNCOND,VRBLHN YES-VRBLHN 51550021 VRCENT NI PRDSW,XXFB SET PRDSW 'OFF' 51560021 CLI CURCOD,XXA2 QUAL BCD NAME 51570021 BC NOTEQ,VRBGEN NO-VRBGEN 51580021 BAL JP,QLFNAM -QLFNAM 51590021 BC UNCOND,VRBGET -VRBGET 51600021 VRBLHN TM PRDSW,XX04 PRDSW 'ON' 51610021 BC ONES,LHNAM YES-LHNAM 51620021 BAL JP,EOSTGP -EOSTGP 51630021 BC UNCOND,LHNAM -LHNAM 51640021 VRBEND TM PRDSW,XX04 PRDSW 'ON' 51650021 BC ONES,DELIM YES-DELIM 51660021 BAL JP,EOSTGP -EOSTGP 51670021 BC UNCOND,DELIM -DELIM 51680021 VRBMAJ1 BAL JP,EOSTST GO TEST FOR END OF SECTION 51690021 VRBMAJ CLI CURCOD,XX44 CRITICAL COBOL WORD 51700021 BC NOTEQ,VRBEND NO-VRBEND 51710021 CLI CURN,XX06 EOS 51720021 BC EQ,VRBPRD YES-VRBPRD 51730021 CLI CURN,XXF7 NOTE 51740021 BC NOTEQ,VRBSCN NO-VRBSCN 51750021 TM PRDSW,XX04 PRDSW 'ON' 51760021 BC ONES,NOTSVB YES-NOTSVB 51770021 BAL JP,EOSTST -EOSTST 51780021 BC UNCOND,NOTSVB -NOTSVB 51790021 VRBPRD TM PRDSW,XX04 PRDSW 'ON' 51800021 BC ONES,VRBGET YES-VRBGET 51810021 OI PRDSW,XX04 SET PRDSW 'ON' 51820021 BC UNCOND,VRBGEN -VRBSCN 51830021 EJECT 51840021 *=2 PROCESS-HOLD-GO-ALTER-PERFORM-EXIT-NOTE-*DEBUG 51850021 *=2 READY-EXHIBIT-OPEN-CLOSE-WRITE-REWRITE-SORT-USE 51860021 * 51870021 ***** PROCESS VERB ***** 51880021 * 51890021 PROSVB DS 0H **** PROCESS NOT IMPLEMENTED **** 51900021 *********************************************************************** 51910021 *PROSVB BAL JP,GENSEQ POSSIBLE 51920021 * BAL JP,GENA CODING 51930021 BAL JP,GETWD -GETWD 51940021 *PROSCK BAL JP,PRONAM WHEN 51950021 * B VRBGET IMPLEMENTED 51960021 * B VRBENT 51970021 *********************************************************************** 51980021 BAL JP,MAJTST BYPASS 51990021 B VRBMAJ1 CODING 52000021 TM CURSW,XX01 52010021 BZ PROSVB - PROSUB 52020021 B VEDENT - VEDENT 52030021 * 52040021 * 52050021 ***** HOLD VERB ***** 52060021 * 52070021 HOLSVB EQU PROSVB ***** HOLD NOT IMPLEMENTED ***** 52080021 *********************************************************************** 52090021 *HOLSVB BAL JP,GENSEQ 52100021 * BAL JP,GENA 52110021 * BAL JP,GETWD 52120021 * CLC CURCOD(2),ALLCON 52130021 * BE VRBGEN 52140021 * B PROSCK 52150021 *********************************************************************** 52160021 * 52170021 ***** GO TO VERB ***** 52180021 * 52190021 GOSVB NI PLHNSW,XXFE SET PLHNSW 'OFF' 52200021 TM CURSW,XX02 WAS LAST WORD A 'LHN' 52210021 BC ZERO,GOGENA NO-GOGENA 52220021 OI PLHNSW,XX01 SET PLHNSW 'ON' 52230021 GOGENA BAL JP,GENSEQ GEN CARD NUM - F4 SEQ NUM - F2 52240021 BAL JP,GENA -GENA 'GO TO' 52250021 BAL JP,GETWD -GETWD 52260021 CLC CURCOD(LX2),TOCON 'TO' 52270021 BC NOTEQ,GOPRON NO-GOPRON 52280021 BAL JP,GENA -GENA 52290021 BAL JP,GETWD -GETWD 52300021 GOPRON BAL JP,PRONAM -PRONAM 52310021 BC UNCOND,GOGET YES-GOGET 52320021 GOLHSW TM PLHNSW,XX01 PRECEDED BY LHN 52330021 BC ZERO,VRBENT NO-VRBENT 52340021 CLC CURCOD(LX2),EOSCON EOS 52350021 BC EQ,GOSETG YES-GOSETG 52360021 BAL JP,MAJTST MAJOR IS '0' TEST 52370021 BC ZERO,GOSETG YES--GOSETG 52380021 TM CURSW,XX01 NO-IS I0 IN A-MARGIN 52390021 BC ZERO,VRBENT NO-VRBENT 52400021 GOSETG OI PNCHAR,XX08 SET CHAR 'G' 52410021 BAL JP,ATRLNT -ATRLNT 'PUT IN PNTABL' 52420021 BC UNCOND,VRBENT -VRBENT 52430021 GOGET BAL JP,GETWD -GETWD 52440021 BAL JP,PRONAM -PRONAM 52450021 BC UNCOND,GOPRNM YES-GOPRNM 52460021 CLC CURCOD(LX2),DEPNCN NO, IS WORD 'DEPENDING'? 52470021 BC EQ,DEPEND YES - DEPEND 52480021 BC UNCOND,GOLHSW -GOLHSW 52490021 GOPRNM BAL JP,GETWD -GETWD 52500021 BAL JP,PRONAM -PRONAM 52510021 BC UNCOND,GOPRNM YES-GOPRNM 52520021 CLC CURCOD(LX2),DEPNCN NO, IS WORD 'DEPENDING'? 52530021 BNE VRBENT NO, GO TO VRBENT 52540021 DEPEND CLC NXTCOD(LX2),ONCON YES,IS 'ON' AFTER 'DEPENDING'? 52550021 BNE VRBENT NO,GO CHECK FOR MAJOR VERB 52560021 BAL JP,GENA YES,PUT OUT IC-TEXT FOR DEPNG 52570021 BAL JP,GETWD GET WORD 52580021 BAL JP,GENA PUT 'ON' ON IC-TEXT 52590021 B VRBGET CONTINUE SCAN 52600021 * 52610021 ************** CALL VERB ************ 52620021 * 52630021 CALSVB BAL JP,GENSEQ GO TO GENERATE SEQ NUM 52640021 BAL JP,GENA GEN CALL 52650021 BAL JP,GETWD GET NEXT WORD 52660021 BAL JP,EXTNA3 CHECK EXTERNAL NAME 52670021 B VRBGEN YES 52680021 B VRBGET NO 52690021 * 52700021 * 52710021 ********************* ENTRY VERB ***************** 52720021 * 52730021 ENTSVB BAL JP,GENSEQ GEN CARD NUM - F4 SEQ NUM - 52740021 BAL JP,GENA PUT ON FILE 2 - GEN CALL 52750021 BAL JP,GETWD GET NEXT WORD 52760021 BAL JP,EXTNA3 CHECK EXTERNAL NAME 52770021 B *+8 YES 52780021 B VRBGET NO 52790021 L R1,COSADR 52800021 CLC CURWD(LX8),PROGID LITERAL = PROGRAM-ID 52810021 BNE VRBENT NO 52820021 BAL JP,MSG158 -ENTRY STMT ERROR 52830021 B VRBGET GET VERB RTN 52840021 ***** ALTER VERB ***** 52850021 * 52860021 ALTSVB BAL JP,GENSEQ GEN CARD NUM - F4 SEQ NUM - F2 52870021 BAL JP,GENA -GENA 'ALTER' 52880021 ALTGET BAL JP,GETWD -GETWD 52890021 BAL JP,PRONAM -PRONAM 52900021 BC UNCOND,*+NX8 YES-*+8 52910021 BC UNCOND,VRBENT NO-VRBENT 52920021 OI PNCHAR,XX10 SET CHAR 'A' 52930021 BAL JP,ATRENT -ATRENT 52940021 BAL JP,GETWD -GETWD 52950021 CLC CURCOD(LX2),TOCON 'TO' 52960021 BC NOTEQ,PRCEED NO-PRCEED 52970021 BAL JP,GENA -GENA 52980021 BAL JP,GETWD -GETWD 52990021 PRCEED CLC CURCOD(LX2),PRCDCN 'PROCEED' 53000021 BC NOTEQ,TOCNCK NO-TOCNCK 53010021 BAL JP,GENA -GENA 53020021 BAL JP,GETWD -GETWD 53030021 TOCNCK CLC CURCOD(LX2),TOCON 'TO' 53040021 BC NOTEQ,PRNMCK NO-PRNMCK 53050021 BAL JP,GENA -GENA 53060021 BAL JP,GETWD -GETWD 53070021 PRNMCK BAL JP,PRONAM -PRONAM 53080021 BC UNCOND,ALTGET YES-ALTGET 53090021 BC UNCOND,VRBENT NO-VRBENT 53100021 * 53110021 ***** PERFORM VERB ***** 53120021 * 53130021 PRFSVB BAL JP,GENSEQ GEN CARD NUM - F4 SEQ NUM - F2 53140021 BAL JP,GENA -GENA 'PERFORM' 53150021 BAL JP,GETWD -GETWD 53160021 BAL JP,PRONAM -PRONAM 53170021 BC UNCOND,*+NX8 YES-*+8 53180021 BC UNCOND,VRBENT NO-VRBENT 53190021 CLC NXTCOD(LX2),THRUCN 'THRU' 53200021 BC NOTEQ,PRFSET NO-PRFSET 53210021 BAL JP,GETWD -GETWD 53220021 BAL JP,GENA -GENA 53230021 BAL JP,GETWD -GETWD 53240021 BAL JP,PRONAM -PRONAM 53250021 BC UNCOND,PRFSET YES-PRFSET 53260021 BC UNCOND,VRBENT NO-VRBENT 53270021 PRFSET OI PNCHAR,XX20 SET CHAR 'P' 53280021 BAL JP,ATRENT -ATRENT 53290021 BC UNCOND,VRBGET -VRBGET 53300021 * 53310021 ***** EXIT VERB ***** 53320021 * 53330021 EXTSVB TM CURSW,XX02 WAS LAST WORD A 'LHN' 53340021 BC ZERO,VRBGCN VERB GEN 53350021 OI PNCHAR,XX04 SET CHAR 'E' 53360021 BAL JP,ATRLNT -ATRLNT 53370021 BC UNCOND,VRBGCN GO TO VERB GEN 53380021 * 53390021 ***** READY ***** 53400021 * 53410021 RDYSVB L JA,COSADR COS ADDRESS 53420021 OI SWITCH,XX80 ) 53430021 BC UNCOND,VRBGCN -RETURN 53440021 * 53450021 ***** NOTE VERB ***** 53460021 * 53470021 NOTSVB OI NOTESW,XX02 SET 'ON' NOTESW 53480021 NI NOLHSW,XX7F SET 'OFF' NOLHSW 53490021 TM CURSW,XX02 WAS LAST A LHN 53500021 BC ONES,NOTGET YES-NOTGET 53510021 OI NOLHSW,XX80 SET 'ON' NOLHSW 53520021 NOTGET BAL JP,GETWD -GETWD 53530021 OI NOTESW,XX02 53540021 CLC CURCOD(LX2),EOSCON EOS 53550021 BC NOTEQ,NOTOFF NO-NOTOFF 53560021 TM CURSW,XX04 FOLLOWED BY BLANK 53570021 BC EQ,NOTBLK YES-NOTBLK 53580021 NOTOFF NI PRDSW,XXFB SET'OFF'PRDSW 53590021 NOTAMG TM CURSW,XX01 IN A-MARGIN 53600021 BC ZERO,NOTGET NO-NOTGET 53610021 CLI CURCOD,XX42 '42' WORD 53620021 BC EQ,NOTEXT YES-NOTEXT 53630021 BAL JP,CHKLHN -CHKLHN 53640021 BC UNCOND,NOTEXT YES-NOTEXT 53650021 BC UNCOND,NOTGET NO-NOTEXT 53660021 NOTEXT NI NOTESW,XXFD SET 'OFF' NOTESW 53670021 TM PRDSW,XX04 PRDSW 'ON' 53680021 BC ONES,DELIM YES-DELIM 53690021 BAL JP,MSG43 -MSG43 53700021 BC UNCOND,DELIM -DELIM 53710021 NOTBLK OI PRDSW,XX04 SET 'ON' PRDSW 53720021 TM NOLHSW,XX80 NOLHSW 'ON' 53730021 BC ONES,NOTEND YES-NOTEND 53740021 BAL JP,GETWD -GETWD 53750021 BC UNCOND,NOTAMG -NOTAMG 53760021 NOTEND NI NOTESW,XXFD SET 'OFF' NOTESW 53770021 BC UNCOND,DELIM -DELIM 53780021 * 53790021 ***** *DEBUG VERB ***** 53800021 * 53810021 DEBSVB BAL JP,DUMGEN -DUMGEN 53820021 MVI LCRPD,XX00 SET RPD TO 0 53830021 TM DEBGSW,XX10 IS IT 1ST '*DEBUG' 53840021 BC ONES,DEBGEN NO-DEBGEN 53850021 LA JF,DEBSCT YES-GENERATE 53860021 BAL JP,GENB DEBUG HEADER '4209' 53870021 OI DEBGSW,XX10 SET 'ON' DEBGSW SHOWS HDR 53880021 OI LCCHAR+NX1,XX40 DEFINE FUTURE PN AS BEING D 53890021 DEBGEN NI LCCHAR+NX1,XXE0 CLEAR LAST 5 BITS 53900021 BAL JP,GENSEQ -GENSEQ 53910021 BAL JP,GENA -GENA 53920021 OI DHDRSW,XX08 SET 'ON' DHDRSW (GEN SECT H 53930021 CLC CURGCN(LX2),NXTGCN NEXT ON SAME CARD 53940021 BC EQ,DEBPNM YES-DEBPNM 53950021 MVC ERRCOD+NX1(LX2),HWZERO SET UP ERRCOD B90000 53960021 LA JF,ERRCOD 53970021 MVC CURCOD(LX2),BLNKCN MAKE CODE BLANK FOR MSG20 53980021 BAL JP,GENB -GENB 53990021 BC UNCOND,DEBM20 -DEBM20 54000021 DEBPNM BAL JP,GETWD -GETWD 54010021 BAL JP,PRONMD -PRONMD (IS IT A PN) 54020021 BC UNCOND,DEBYES YES-DEBYES 54030021 BAL JP,GENA -GENA 54040021 BC UNCOND,DEBOUT NO-DEBOUT 54050021 DEBYES EQU * 54060021 * 54070021 MVC PNBCDN(LX31),CURCNT PM TO WORK AREA 54080021 TM QLPNSW,XX40 QUAL PN 54090021 BC ZERO,DEBPTA NO-DEBPTA 54100021 * 54110021 MVC LNMBCD+NX1(LX3),PNBCQN ADDR OF QUALIFIER TO PARAM 54120021 LA JA,LNMBCD ADDR OF PARAM 54130021 L JQ,LDELCN CALL 54140021 BALR JP,JQ LDELNM 54150021 LTR JQ,JQ SECTION FOUND 54160021 L JQ,SVREG+NX56 RESTORE BASE REG 54170021 BC NOTZER,DEBBNT NO-DEBBNT 54180021 LTR JA,JA DELIM IS '0' - NOT BUILT YE 54190021 BC ZERO,DEBBNT YES-DEBBNT 54200021 * 54210021 ST JC,GRPPTR SECT PTR TO PARAM 54220021 MVC GRPBCD+NX1(LX3),PNBCNN ADDR OF PN TO PARAM 54230021 LA JA,GRPBCD ADDR OF PARAM 54240021 L JB,LATGCN ADDR OF LATGRP 54250021 BC UNCOND,DEBPTB -DEBPTB 54260021 * 54270021 DEBPTA MVC RNMBCD+NX1(LX3),PNBCNN ADDR OF PN TO PARAM 54280021 LA JA,RNMBCD ADDR OF PARAM 54290021 L JB,LATRCN ADDR OF LATRNM 54300021 DEBPTB LR JQ,JB CALL 54310021 BALR JP,JQ LATGRP OR LATRNM 54320021 LTR JQ,JQ PN FOUND 54330021 L JQ,SVREG+NX56 RESTORE BASE REG 54340021 BC NOTZER,DEBBNT NO - DEBBNT 54350021 * 54360021 MVC LCRPD(LX1),DX5(JB) GET RPD-NUM FROM DICT TO WO 54370021 OC LCCHAR+NX1(LX1),DX2(JB) GET CHAR FROM DICT TO WORK 54380021 NI LCCHAR+NX1,XX5F MAKE B AND X 0'S 54390021 OI DX2(JB),XX80 SET B TO 1 (REF BY *DEBUG) 54400021 XC PNCHAR(LX2),PNCHAR CLEAR CHAR WORK AREA 54410021 * 54420021 DEBBNT BAL JP,DEBNXT -DEBNXT (NXT WD ON SAME CA 54430021 BAL JP,GENA -GENA 54440021 BAL JP,DEBNXT -DEBNXT (NXT WD ON SAME CA 54450021 DEBM21 BAL JP,MSG21 -MSG21 54460021 BC UNCOND,DEBOUT -DEBOUT 54470021 DEBM20 BAL JP,MSG20 -MSG20 54480021 BC UNCOND,DEBOUT -DEBOUT 54490021 * 54500021 DEBNXT ST JP,SV1F02 SAVE LINK REG 54510021 DEBNTA CLC CURGCN(LX2),NXTGCN NEXT WD ON SAME CARD 54520021 BC NOTEQ,DLAENT NO-DLAENT 54530021 BAL JP,GETWD -GETWD 54540021 CLC CURCOD(LX2),EOSCON EOS 54550021 BC NOTEQ,DEBNTB NO-DEBNTB 54560021 BAL JP,MSG22 -MSG22 54570021 BC UNCOND,DEBNTA -DEBNTA 54580021 DEBNTB L JP,SV1F02 RESTORE LINK REG 54590021 BCR UNCOND,JP -RETURN 54600021 * 54610021 DEBOUT CLC CURGCN(LX2),NXTGCN NEXT WD ON SAME CARD 54620021 BC NOTEQ,DLAENT NO-DLAENT 54630021 BAL JP,GETWD -GETWD 54640021 BC UNCOND,DEBOUT -DEBOUT 54650021 * 54660021 **************** SEARCH VERB ************** 54670021 * 54680021 SCHSVB CLC NXTCOD(LX2),ALLCON ALL FOLLOWS SEARCH 54690021 BNE VRBGCN NO 54700021 MVI NXTCNT,XX40 BLANK OUT NXTCNT 54710021 MVC NXTWD+NX6(LX4),NXTCNT SET UP FOR 'SEARCH ALL' 54720021 MVC NXTWD(LX6),CURWD 'SEARCH' TO NEXT 54730021 MVI NXTCNT,XX0A SIZE OF SEARCH ALL 54740021 BAL JP,GETWD CALL GTWD 54750021 MVI CURCOD,XX44 MAKE CURRENT A VERB 54760021 MVI CURN,XX5F CODE FOR SEARCH ALL 54770021 B VRBGCN GO TO VERB GEN 54780021 * 54790021 * 54800021 ************* ENTER VERB ************* 54810021 * 54820021 ENRSVB BAL JP,GENSEQ GEN CARD NUM - F4 SEQ NUM - 54830021 BAL JP,GETWD GET LANGUAGE NAME 54840021 BAL JP,GETWD GET ROUTINE NAME 54850021 BAL JP,MAJTST MAJOR IS '0' 54860021 B VRBMAJ YES 54870021 TM CURSW,XX01 IN A MARGIN 54880021 BZ VRBGET NO MUST BE ROUTINE NAME 54890021 B VEDENT - VEDENT 54900021 EJECT 54910021 IKF108 CSECT 54920021 ***** EXHIBIT VERB ***** 54930021 * 54940021 EXHSVB NI NAMDSW,XXFD SET'OFF'NAMDSW 54950021 BAL JP,GENSEQ -GENSEQ 54960021 EXGETA BAL JP,CHKOUT -CHKOUT 54970021 CLC CURCOD(LX2),CHGCON CHANGED 54980021 BC NOTEQ,EXSWNM NO-EXSWNM 54990021 BAL JP,CHKOUT -CHKOUT 55000021 EXSWNM TM NAMDSW,XX02 NAMDSW IS 'ON' 55010021 BC ZERO,EXNAME NO-EXNAME 55020021 BC UNCOND,EXALPH -EXALPH 55030021 EXNAME CLC CURCOD(LX2),NAMCON NAMED 55040021 BC NOTEQ,DSPEXH NO-DSPEXH 55050021 OI NAMDSW,XX02 SET'ON'NAMDSW 55060021 BC UNCOND,EXGETA -EXGETA 55070021 EXGENA BAL JP,CHKOUT -CHKOUT (A-MARG OR MAJ-0) 55080021 EXALPH CLI CURCOD,XX33 FLOAT PNT LIT 55090021 BC NOTEQ,EXTALY NO-EXTALY 55100021 MVC CURN(LX31),CURCNT PUT IN BCD FORM 55110021 BC UNCOND,EXGENA -EXGENA 55120021 EXTALY CLI CURCOD,XX79 '79' CODE 55130021 BC NOTEQ,EXBCDN NO-EXBCDN 55140021 BAL JP,GENA -GENA 55150021 MVI CURNUM+NX5,XX35 SET CODE '35' 55160021 LA JF,CURNUM+NX5 ADDR OF '35' FIELD 55170021 BAL JP,GENB -GENB 55180021 BAL JP,CHKIN -CHKIN 55190021 BC UNCOND,EXALPH -EXALPH 55200021 EXBCDN CLI CURCOD,XX23 BCD-NAME 55210021 BC NOTEQ,EXQBCD NO-EXQBCD 55220021 BAL JP,GENA -GENA 55230021 MVI CURCOD,XX35 SET CODE TO '35' 55240021 BC UNCOND,EXGENA -EXGENA 55250021 EXQBCD CLI CURCOD,XXA2 QUAL-NAME 55260021 BC NOTEQ,EXGENA NO-EXGENA 55270021 BAL JP,QLFNAM -QLFNAM---GENB OF 22'S AND 55280021 STC JA,DX0(JG) PUT LENGTH IN 'N' BYTE 55290021 BCTR JG,JR MOVE POINTER TO CODE BYTE 55300021 LR JF,JG ADDR OF CODE BYTE TO REG JF 55310021 BAL JP,GENB -GENB 55320021 MVI DX1(JG),XX00 RESET 2ND TABLE BYTE TO ZER 55330021 BAL JP,CHKIN -CHKIN (A-MARIN OR MAJ-0) 55340021 BC UNCOND,EXALPH -EXALPH 55350021 * 55360021 ***** OPEN VERB ***** 55370021 * 55380021 OPNSVB BAL JP,GENSEQ -GENSEQ 55390021 XC PIOCOD,PIOCOD CLEAR CODE AREA 55400021 XC OPNGNS(LX10),OPNGNS ZERO OUT GNS 55410021 CLI NXTCOD,XX54 COBOL WORD? 1889 55420021 BC NOTEQ,OPENER NO - OPENER 1889 55430021 CLI NXTN,XX66 INPUT? 1889 55440021 BC EQ,OPNGEN YES - OPNGEN 1889 55450021 CLI NXTN,XX64 OUTPUT? 1889 55460021 BC EQ,OPNGEN YES - OPNGEN 1889 55470021 CLI NXTN,XX6B I-O? 1889 55480021 BC EQ,OPNGEN YES - OPNGEN 1889 55490021 OPENER MVC CLSNM(LX31),CURCNT PUT 'OPEN' IN CLSNM 1889 55500021 BAL JP,GETWD PUT INVALID WORD IN CUR FIELD 55510021 BAL JP,MSG17 INVALID WORD MESSAGE 1889 55520021 CLC NXTCOD(LX2),EOSCON PERIOD NEXT CODE?? 07236 55530021 BC EQ,VRBGET YES-GET NEXT VERB 07236 55540021 SKPOPN BAL JP,GETWD GET NEXT WORD 1889 55550021 TM NXTCOD,XX30 MAJOR IS 0? 1889 55560021 BNZ SKPOPN NO - SKPOPN 1889 55570021 CLC NXTCOD(LX2),EOSCON IS NEXT A PERIOD? 1889 55580021 BE VRBGET YES - VRBGET 04431 55590021 CLC NXTCOD(LX2),EOPCON END SYSIN 04431 55600021 BNE SKPOPN NO - CONTINUE EOS SEARCH 04431 55610021 BAL JP,EOSTGP YES-THEN GENERATE EOS 04431 55620021 B VRBGET EXIT 04431 55630021 OPNGEN BAL JP,CHKOUT -CHKOUT (A-MARG OR MAJ-0) 55640021 CLI CURCOD,XX54 COBOL WORD 55650021 BC NOTEQ,OPNCOD NO-OPNCOD 55660021 CLI CURN,XX66 INPUT 55670021 BC EQ,OPNINP YES-OPNINP 55680021 CLI CURN,XX64 OUTPUT 55690021 BC EQ,OPNOUT YES-OPNOUT 55700021 CLI CURN,XX6B I-O 55710021 BC EQ,OPNIO SET I-O CODE 55720021 CLI CURN,XX6E REVERSED 55730021 BE OPNRV1 YES 55740021 CLI CURN,XX6C WITH 55750021 BE OPNRW1 YES 55760021 CLC NXTCOD(LX2),NOCON NO 55770021 BNE OPNGEN GO GEN OPEN RTN 55780021 OPNRW1 OI DX2(JE),PIOONR 55790021 B OPNGEN GO GEN OPEN RTN 55800021 OPNRV1 OI DX1(JE),PIOOIR REVERSED BIT ON 55810021 B OPNGEN GO GEN OPEN RTN 55820021 OPNIO MVI PIOCOD,XX20 SET CODE 20 FOR I-O 55830021 BC UNCOND,OPNGEN -OPNGEN 55840021 OPNOUT MVI PIOCOD,XX40 SET CODE '40' FOR OUTPUT 55850021 BC UNCOND,OPNGEN -OPNGEN 55860021 OPNINP MVI PIOCOD,XX80 SET CODE '80' FOR INPUT 55870021 BC UNCOND,OPNGEN -OPNGEN 55880021 OPNCOD TM PIOCOD,XXE0 IS A CODE SET 55890021 BC ZERO,OPNGEN NO-OPNGEN 55900021 CLI CURCOD,XX23 BCD-FILE-NAME 55910021 BC NOTEQ,OPNGEN NO-OPNGEN 55920021 LA JG,CURN ADDR OF FILE-NAME 55930021 BAL JP,SCHFNT -SCHFNT 55940021 TM SCHSW,XX40 WAS NAME FOUND 55950021 BZ OPNER5 NO, ERROR 56194 55960021 LH JC,DX0(JB) PIOTBL-PTR 55970021 BAL JP,SETPIO -SETPIO 55980021 OC DX0(LX1,JE),PIOCOD SET CODE IN PIOTBL CODE 55990021 * JB CONTAINS PTR TO FNTBL 56000021 * JE CONTAINS ADDR OF PIOTBL FOR FILE 56010021 * JG IS INDEX TO NO OF GNS TESTED IN OPNGNS. 56020021 BAL JP,GENA GEN OUT FILENAME 56030021 OPNSR1 XR JG,JG 56040021 LR JC,JB SAVE ADDR OF BEG OF FNTBL EN 56050021 TM PIOCOD,XX80 INPUT 56060021 BZ OPNCD1 CK FOR I-O GNS 56070021 LA JF,INSTER INPUT STAND ERROR GN 56080021 LA JD,INGNBF INPUT BEFORE LABEL GNS 56090021 LA JH,INGNAF INPUT AFTER LABEL GNS 56100021 B OPNERR CK FOR USE ERR 56110021 OPNCD1 TM PIOCOD,XX40 OUTPUT 56120021 BZ OPNCD2 CK FOR I-O GNS 56130021 LA JF,OUSTER OUTPUT STAND ERROR GN 56140021 LA JD,OUGNBF OUTPUT BEFOR LABEL GNS 56150021 LA JH,OUGNAF OUTPUT AFTER LABEL GNS 56160021 B OPNERR CK FOR USE ERR 56170021 OPNCD2 LA JF,IOSTER I-O 56180021 LA JD,IOGNBF I-O BEFORE LABEL GNS-NON-ST 56190021 LA JH,IOGNAF I-O AFTER LABEL GNS-STAND 56200021 OPNERR TM USEPDE,XX08 WERE THERE ANY USE ERROR 56210021 BZ OPNLAB NO 56220021 OPNER1 CLC FNGNSE(LX2,JB),FRHWZ STAND ERR GN IN FNTBL IS 0 56230021 BE OPNER2 YES 56240021 MVC OPNSTE(LX2),FNGNSE(JB) NO MOVE GN INTO OUTPUT AREA 56250021 CLC DX0(LX2,JF),FRHWZ WAS STAND ERR SPEC'D FOR OP 56260021 BE OPNLAB NO 56270021 BAL JP,MSG142 USE FOR OPEN OPTION IGNOR 56280021 B OPNLAB GO CK RECORD LABELS 56290021 OPNER2 MVC OPNSTE(LX2),DX0(JF) MOVE STAND ERR GN FOR OPTIO 56300021 B OPNLAB GO CK RECORD LABELS 56310021 OPNGNP TM FNFL1(JC),FNBEF IS IT BEFORE 56320021 BZ OPNGN3 NO 56330021 CLC OPNEOF(LX2),OPNEOV EOF GN = EOV GN 56340021 BE OPNGN3 YES 56350021 CLC OPNEOF(LX2),FRHWZ EOF GN = 0 56360021 BE OPNGN3 YES - OK 56370021 CLC OPNEOV(LX2),FRHWZ EOV GN = 0 56380021 BE OPNGN3 YES - OK 56390021 BAL JP,MSG154 2 DIF LAB PROC FOR EOF-EOV 56400021 MVC OPNEOV(LX2),FRHWZ ZERO OUT EOV GN 56410021 OPNGN3 CLC OPNGNS(LX10),FRHWZ ANY LABELS OR ERROR GNS 56420021 BE OPNGN2 NO 56430021 CLC OPNGNS(LX2),FRHWZ USE ON STD ERR 56440021 BE OPNGN2 NO - DON'T SET BIT 56450021 LH JC,FNPIOT(JC) 56460021 BAL JP,PIUSB1 SET USE BIT ON 56470021 OPNGN2 TM SRTSW,XX04 RETURN CONTROL TO SORT VERB 56480021 BZ OPNGN1 NO 56490021 L JP,SV1F14 56500021 BR JP RETURN 56510021 OPNGN1 LA JF,OPNSTR WRITE GNS 56520021 BAL JP,GENB GEN ON FILE 2 56530021 XC OPNGNS(LX10),OPNGNS ZERO OUT GNS 56540021 BAL JP,CHKIN SAVE JP AND GET NXT WORD 56550021 B OPNGEN+NX4 GO COMP CODE TO COBOL WORD -54 56560021 ** 56570021 OPNBIT CLC DX0(LX2,JH),FRHWZ IS STAND GN FOR OPEN 0 56580021 BE OPNSTZ YES 56590021 TM FNFL1(JC),FNBEF IS NON-ST BIT ON IN FNTBL 56600021 BO OPNMG2 -MSG143 USE STMT IGNORED 56610021 OI FNFL1(JC),FNAFT TURN ON STAND LABEL BIT 56620021 MVC DX0(LX2,JF),DX0(JH) MOVE STAND GN TO OPEN GN 56630021 B OPNGNL -OPEN GN LABELS 56640021 OPNSTZ CLC DX0(LX2,JD),FRHWZ IS NON-ST GN FOR OPEN 0 56650021 BE OPNGNL YES 56660021 TM FNFL1(JC),FNAFT IS STAND BIT ON IN FNTBL 56670021 BO OPNMG2 -MSG143 USE STMT IGNORED 56680021 OI FNFL1(JC),FNBEF SET NON-ST LABEL BIT ON 56690021 ST JC,SV1F01 SAVE ADDRESS OF ENTRY 56700021 LH JC,FNPIOT(JC) GET DISPL OF PIOTBL ENTRY 56710021 BAL JP,PIUSB2 GO SET NSL BIT ON IN PIOTBL 56720021 L JC,SV1F01 RESTORE ADDRESS 56730021 MVC DX0(LX2,JF),DX0(JD) MOVE NON-ST GN TO OPEN GN 56740021 B OPNGNL -OPEN GN LABELS 56750021 OPNMG2 BAL JP,MSG143 -MSG143 USE STMT IGNORED 56760021 B OPNGNL -OPEN GN LABELS 56770021 OPNLAB LA JF,OPNGNS 56780021 TM FNFL1(JB),FNLRS+FNLRO LABEL RECS STAND OR OMITTED 56790021 BM OPNGNP YES 56800021 TM USEPDL,XX10 ANY USE FOR LABELS 56810021 BZ OPNGNP NO 56820021 B OPNFST BUMP ADDR TO GNS 56830021 OPNGNL LA JG,DX2(JG) UP INDEX TO GNS 56840021 CH JG,HW8 56850021 BE OPNGNP YES 56860021 LA JD,DX2(JD) UP ADDR IN GN BEFORE LABELS 56870021 LA JH,DX2(JH) UP ADDR IN GN AFTER LABELS 56880021 OPNFST LA JF,DX2(JF) UP ADDR TO OPNGNS 56890021 LA JB,DX2(JB) UP ADDR IN FNTBL 56900021 OPNLP CLC FNGNSE(LX2,JB),FRHWZ IS GN 0 IN FNTBL 56910021 BE OPNBIT YES 56920021 CLC DX0(LX2,JD),FRHWZ IS GN 0 IN OPEN OPTION GNBE 56930021 BNE OPNMG1 NO - GET ERR MSG 56940021 CLC DX0(LX2,JH),FRHWZ IS GN 0 IN OPEN OPTION GNAF 56950021 BNE OPNMG1 NO - GET ERR MSG 56960021 MVC DX0(LX2,JF),FNGNSE(JB) MOVE GN FROM FNTBL TO OPEN G 56970021 B OPNGNL -OPEN GN LABELS 56980021 OPNMG1 BAL JP,MSG142 -USE OPEN IGNORED 56990021 B OPNGNL -OPEN GN LABELS 57000021 OPNSRT ST JP,SV1F14 57010021 B OPNSR1 -CK FOR INPUT FILE 57020021 OPNER5 CLI NXTCOD,XX23 IS IT POSSIBLE FILENAME 56194 57030021 BE OPNGEN YES, GO CHECK FOR 56194 57040021 CLI NXTCOD,XX54 IS IT POSSIBLE OPTION 56194 57050021 BE OPNGEN YES, GO CHECK FRO 56194 57060021 B VRBGEN NO RETURN 56194 57070021 * 57080021 ***** CLOSE VERB ***** 57090021 * 57100021 CLOSVB BAL JP,GENSEQ -GENSEQ 57110021 CLOGEN BAL JP,CHKOUT -CHKOUT 57120021 CLI CURCOD,XX23 BCD-FILE-NAME 57130021 BC NOTEQ,CLOGEN NO-CLOGEN 57140021 CLI NXTCOD,XX54 IS NEXT COBOL WORD 57150021 BC NOTEQ,CLOGEN NO-CLOGEN 57160021 CLI NXTN,XX17 IS NEXT 'REEL' 57170021 BC EQ,CLOSCH YES-CLOSCH 57180021 CLI NXTN,XXA2 IS NEXT 'UNIT' 57190021 BC NOTEQ,CLOGEN NO-CLOGEN 57200021 CLOSCH LA JG,CURN ADDR OF FILE-NAME 57210021 BAL JP,SCHFNT -SCHFNT 57220021 TM SCHSW,XX40 WAS NAME FOUND 57230021 BC ZERO,CLOGEN NO-CLOGEN 57240021 LH JC,DX0(JB) PIOTBL-PTR 57250021 BAL JP,SETPIO -SETPIO 57260021 BAL JP,CHKOUT CHKOUT 57270021 CLI NXTCOD,XX54 NEXT IS COBOL WORD 57280021 BC NOTEQ,CLONLY NO-CLONLY 57290021 BAL JP,CHKOUT -CHKOUT 57300021 CLI CURN,XX6C WITH 57310021 BC NOTEQ,CLONO NO-CLONO 57320021 BAL JP,CHKOUT CHKOUT 57330021 CLI CURCOD,XX54 COBOL WORD 57340021 BC NOTEQ,CLONLY NO-CLONLY 57350021 CLONO CLI CURN,XX9E NO 57360021 BC EQ,CLORWD YES-CLORWD 57370021 CLI CURN,XX76 LOCK 57380021 BC NOTEQ,CLONLY NO-CLONLY 57390021 MVI PIOCOD,XX04 SET CODE '04' FOR LOCK 57400021 BC UNCOND,CLOSET -CLOSET 57410021 CLORWD BAL JP,CHKOUT CHKOUT 57420021 CLI CURCOD,XX54 COBOL WORD 57430021 BC NOTEQ,CLOGEN NO-CLOGEN 57440021 CLI CURN,XX6D REWIND 57450021 BC NOTEQ,CLOGEN NO-CLOGEN 57460021 MVI PIOCOD,XX10 SET CODE '10' FOR NO REWIND 57470021 BC UNCOND,CLOSET -CLOSET 57480021 CLONLY MVI PIOCOD,XX02 SET CODE '02' FOR CLOSE ONL 57490021 CLOSET OC DX0(LX1,JE),PIOCOD SET CODE IN PIOTBL CODE 57500021 BC UNCOND,CLOGEN -CLOGEN 57510021 * 57520021 * 57530021 *DEL 57540021 *DEL 57550021 *DEL 57560021 *DEL 57570021 *DEL 57580021 *DEL 57590021 *DEL 57600021 * 57610021 * 57620021 ***** REWRITE VERB ***** 57630021 * 57640021 RWRSVB DS 0H 57650021 OI REWRSW,RWRON TURN ON REWRITE VERB SWITCH 57660021 BC UNCOND,WRTSEQ -WRTSEQ 57670021 * 57680021 ***** WRITE VERB ***** 57690021 * 57700021 WRTSVB DS 0H 57710021 NI REWRSW,RWROFF TURN OFF REWRITE VERB SWITCH 57720021 NI FRESW,FREOFF TURN OFF FREE VERB SWITCH 57730021 LA JG,NXTN ADDR OF RECORD NAME 57740021 BAL JP,SCHRCT SEARCH RECORD TABLE 57750021 TM SCHSW,XX40 FOUND ? 57760021 BZ WRTSEQ NO - WRTSEQ 57770021 LH JB,DX0(JB) FNTBL PTR 57780021 L JA,FNTCON ADDR F FNTBL TIB 57790021 L JA,DX0(JA) ADDR OF FNTBL TAMM 57800021 L JA,DX0(JA) SDDR OF FNTBL 57810021 LA JA,DX0(JB,JA) ADDR OF FNTBL ENTRY 57820021 LH JC,DX0(JA) PIOTBL PTR 57830021 BAL JP,SETPIO -SETPIO 57840021 TM DX1(JE),XX80 RERUN BIT ON 57850021 BZ WRTSEQ NO - WRITSW 57860021 MVI CURN,XX72 WRITE FOR RERUN 57870021 WRTSEQ BAL JP,GENSEQ -GENSEQ 57880021 BAL JP,GENA -GENA 57890021 BAL JP,GETWD -GETWD 57900021 CLI CURCOD,XX23 BCD-RECORD-NAME 57910021 BC EQ,WRTCUR YES-WRTCUR 57920021 CLI CURCOD,XXA2 QUAL-NAME 57930021 BC NOTEQ,VRBENT NO-VRBENT 57940021 WRTCUR LA JG,CURN ADDR OF RCD-NAME 57950021 OI RCDSW1,XX01 TESTED IN SEARCH SCAN 57960021 BAL JP,SCHRCT -SCHRCT 57970021 NI RCDSW1,XX00 57980021 TM SCHSW,XX40 WAS NAME FOUND 57990021 BC ZERO,WRTFN NO-WRTFN 58000021 LH JC,DX0(JB) FNTBL-PTR 58010021 L JE,FNTCON FNTBL-TIB 58020021 L JE,DX0(JE) FNTBL-TAMM 58030021 L JE,DX0(JE) FNTBL-ADDR 58040021 LA JE,DX0(JC,JE) ADDR OF FNTBL ENTRY 58050021 MVC BCDGEN+NX1(LX31),FNWFND(JE) PUT FN IN WORK AREA 58060021 LA JF,BCDGEN ADDR FOR GENB 58070021 BAL JP,GENB GENB 58080021 LH JC,DX0(JE) PIOTBL PTR 58090021 BAL JP,SETPIO GET ADDR OF PIOTBL ENTRY 58100021 TM REWRSW,RWRON IS SWITCH FOR REWRITE VERB ON? 58110021 BNO FREVRB NO, TEST FOR FREE VERB 58120021 OI PIOFL1(JE),PIOREW YES, TURN ON REWRITE BIT 58130021 B WRTGEN CHECK FOR OTHER OPTIONS 58140021 FREVRB DS 0H 58150021 TM FRESW,FREON IS SWITCH FOR FREE VERB ON? 58160021 BO WRTGN9 PUT VERB OUT 58170021 OI PIOFL3(JE),PIOWRT TURN ON WRITE BIT 58180021 WRTGEN BAL JP,CHKOUT -CHKOUT (A-MARG OR MAJ-0) 58190021 CLC CURCOD(LX2),AFTCON AFTER 58200021 BE WRTAFT YES -CK FOR POSITION 58210021 CLC CURCOD(LX2),BEFCON BEFORE 58220021 BE WRTBEF YES - SET BEF - ADV SW 58230021 CLC CURCOD(LX2),INVCON INVALID ? 58240021 BNE WRTGEN NO - WRTGEN 58250021 OI TEMPSW+NX2,PIOINV SET INVALID SW ON 58260021 B WRTGN2 TURN ON PIOTBL SW 58270021 WRTBEF MVI TEMPSW+NX1,PIOWBA BEFORE ADVANCING 58280021 B WRTCCW -CHKOUT 58290021 WRTAFT CLC NXTCOD(LX2),POSCON POSITIONING 58300021 BE WRTPOS YES 58310021 MVI TEMPSW,PIOWAV AFTER ADV 58320021 WRTCCW BAL JP,CHKOUT GO CKOUT VERB 58330021 CLC CURCOD(LX2),ADVCON ADVANCING 58340021 BNE WRTGN7 NO 58350021 CLI NXTCOD,XX23 BCD NM 58360021 BNE WRTGN2 NO - SET PO 58370021 BAL JP,CHKOUT YES 58380021 WRTGN7 CLI CURCOD,XX23 BCD NAME 58390021 BNE WRTGN2 NO 58400021 ST JE,SV1F14 SAVE PIOTBL PTR 58410021 LA JG,CURN ADDR OF BCDNAME 58420021 BAL JP,SCHSPN SEARCH SPNTBL 58430021 TM SCHSW,XX40 FOUND 58440021 BZ WRTGN8 NO 58450021 MVC CURCOD(LX3),DX0(JB) YES-SAVE CARR-CTL CODE 58460021 WRTGN8 L JE,SV1F14 RESTORE PIOTBL PTR 58470021 WRTGN2 EQU * 58480021 OC PIOFL1(LX3,JE),TEMPSW OR IN OPTIONS 58490021 XC TEMPSW(LX3),TEMPSW ZERO OUT OPTION FIELD 58500021 TM PIOFL2(JE),PIOWAP WRITE AFT POS 58510021 BZ VRBENT CHECK FOR MAJ 0 58520021 TM PIOFL2(JE),PIOWAP+PIOWBA WRITE AFT POS AND BEFORE ADV 58530021 BO WRTERR YES 58540021 TM PIOFL1(JE),PIOWAV WRITE AFT ADV 58550021 BO WRTERR YES 58560021 BC UNCOND,VRBGEN -VRBGEN 58570021 WRTFN BAL JP,GENA -GENA 58580021 MVC CURN(LX2),HWZERO SET UP ERROR-CODE 58590021 MVI CURCOD,XXB9 OF 'B90000' 58600021 BC UNCOND,VRBGEN -VRBGEN 58610021 WRTERR BAL JP,MSG144 POSIT. AND AFTER ADV OPTION ILL 58620021 B VRBGEN - GENA 58630021 WRTPOS OI TEMPSW+NX1,PIOWAP WRITE AFTER POS 58640021 B WRTGN2 SET PO 58650021 WRTGN9 OI PIOFL2(JE),PIOFRE 58660021 B VRBGEN - GENA GENERATE 58670021 * 58680021 ***** SORT VERB ***** 58690021 * 58700021 SRTSVB BAL JP,GENSEQ -GENSEQ 58710021 SRTFND XC TEMPSW(LX3),TEMPSW ZERO OUT OPTION AREA 58720021 NI SRTSW,XXFB TURN SORT SW OFF 58730021 SRTANT BAL JP,CHKOUT -CHKOUT 58740021 SRTENT CLC CURCOD(LX2),EOSCON PERIOD IN CURRENT 1904 58750021 BC EQUAL,VRBMAJ YES GET OUT 1904 58760021 CLI CURCOD,XX44 IS VERB IN CURRENT 57817 58770021 BC EQUAL,VRBMAJ YES, BR 57817 58780021 CLI CURCOD,XX54 COBOL WORD IN CURRENT 1904 58790021 BC NOTEQ,SRTANT NO-SRTANT 58800021 CLI CURN,XX66 INPUT 58810021 BC EQ,SRTBNT YES-SRTBNT 58820021 CLI CURN,XX89 USING 58830021 BE SRTUSG YES 58840021 CLI CURN,XX81 GIVING 58850021 BE SRTGIV YES 58860021 CLI CURN,XX64 OUTPUT 58870021 BC NOTEQ,SRTANT NO-SRTANT 58880021 SRTBNT BAL JP,CHKOUT -CHKOUT 58890021 CLC CURCOD(LX2),PROCCD PROCEDURE 58900021 BC NOTEQ,SRTCNT NO-SRTCNT 58910021 CLC NXTCOD(LX2),ISCON IS IN NXT 58920021 BNE *+8 NO - SKIP 58930021 BAL JP,CHKOUT YES - GEN OUT 58940021 BAL JP,CHKOUT -CHKOUT 58950021 SRTCNT BAL JP,PRONAM -PRONAM 58960021 BC UNCOND,*+NX8 YES-*+8 58970021 BC UNCOND,SRTANT NO-SRTANT 58980021 CLC NXTCOD(LX2),THRUCN NEXT IS 'THRU' 58990021 BC NOTEQ,SRTDNT NO-SRTDNT 59000021 BAL JP,GETWD -GETWD 59010021 BAL JP,CHKOUT -CHKOUT 59020021 BAL JP,PRONAM -PRONAM 59030021 BC UNCOND,*+NX8 YES-*+8 59040021 BC UNCOND,SRTANT NO-SRTANT 59050021 SRTDNT OI PNCHAR,XX20 SET CHAR 'P' 59060021 BAL JP,ATRENT -ATRENT 59070021 BAL JP,CHKIN -CHKIN 59080021 BC UNCOND,SRTENT -SRTENT 59090021 SRTUSG EQU * 59100021 OI TEMPSW,PIOUSG 59110021 SRTUS1 CLI NXTCOD,XX23 BCD FILENAME 59120021 BNE SRTANT NO 59130021 LA JG,NXTN ADDR OF FILENAME 59140021 BAL JP,FILSV2 GO TO SUBRTN FOR FILE NAME 59150021 B SRTANT NO 59160021 SRUSGV OC PIOFL2(LX1,JE),TEMPSW SET ON USING - GIVING BIT 59170021 OI SRTSW,XX04 TURN SORT SW ON 59180021 TM PIOFL2(JE),PIOUSG IS IT USING 59190021 BO SRTUS2 YES 59200021 MVI PIOCOD,XX40 GIVING-OUTPUT 59210021 SRTFNT XC OPNGNS(LX10),OPNGNS ZERO OUT GN FIELD 59220021 BAL JP,OPNSRT GO TO OPEN CODE - SORT FILE 59230021 OC PIOFL1(LX1,JE),PIOCOD SAVE TYPE OF OPEN 59240021 BAL JP,CHKOUT GO TO CK IF QUAL BCD 59250021 BAL JP,CHKOUT GO TO CK IF QUAL BCD 59260021 LA JF,OPNSTR WRITE GNS 59270021 BAL JP,GENB PUT ON FILE 2 59280021 SRTEND XC TEMPSW(LX3),TEMPSW 59290021 NI SRTSW,XXFB TURN SORT SW OFF 59300021 B SRTENT CHECK FOR COBOL WORD 59310021 SRTGIV EQU * 59320021 OI TEMPSW,PIOGVG SET ON GIVING BIT 59330021 B SRTUS1 CK IF BCD FILENAME 59340021 SRTUS2 MVI PIOCOD,XX80 USING-INPUT 59350021 B SRTFNT GO TO OPEN SORT FILE CODE RTN 59360021 * 59370021 CHKIN ST JP,SV1F01 SAVE LINK REG 59380021 BC UNCOND,CHKGTA -CHKGTA 59390021 CHKOUT ST JP,SV1F01 SAVE LINK REG 59400021 CLI CURCOD,XXA2 QUAL-BCD-NAME 59410021 BC NOTEQ,CHKGTB NO-CHKGTB 59420021 LR JC,JE SAVE PIOTBL PTR 59430021 BAL JP,QLFNAM -QLFNAM 59440021 LR JE,JC RESTORE PTR 59450021 BC UNCOND,CHKGTA -CHKGTA 59460021 CHKGTB BAL JP,GENA -GENA 59470021 CHKGTA BAL JP,GETWD -GETWD 59480021 TM SRTSW,XX04 SORT SW ON- 59490021 BO CHKRTN YES-RETURN 59500021 BAL JP,MAJTST -MAJTST 59510021 BC UNCOND,VRBMAJ YES-VRBMAJ 59520021 TM CURSW,XX01 IN A-MARGIN 59530021 BC ZERO,CHKRTN NO-CHKRTN 59540021 BAL JP,CHKLHN -CHKLHN 59550021 BC UNCOND,VRBLHN YES-VRBLHN 59560021 CHKRTN L JP,SV1F01 RESTORE LINK REG 59570021 BCR UNCOND,JP -RETURN-JP 59580021 * 59590021 * 59600021 ************************* READ *********************************** 59610021 * 59620021 * 59630021 REDSVB BAL JP,GENSEQ GEN CARD ON FILE 2 AFTER CHK 59640021 LA JG,NXTN 59650021 BAL JP,FILSV2 GO TO SUBRTN FOR FILE NAME 59660021 B VRBGEN WRITE ON FILE2 59670021 OI DX2(JE),XX01 READ BIT IN PIOTBL 44686 59680021 TM DX1(JE),XX80 59690021 BZ INVCHK CHECK FOR INV CONST. 59700021 CLI CURN,XX65 59710021 BNE RRUNCD MOVE CODE TO CURN 59720021 MVI CURN,XX75 59730021 B *+NX8 BRANCH AROUND MOVE TO CURN 59740021 RRUNCD MVI CURN,XX71 59750021 INVCHK CLC NXTCOD(LX2),INVCON 59760021 BE INVPOR SET BIT GO TO VRBGEN 59770021 BAL JP,CHKOUT CK FOR QUAL-BCD-NAME 59780021 B INVCHK CK FOR CONST 59790021 INVPOR OI PIOFL3(JE),PIOINV 59800021 B VRBENT CHECK FOR QUAL NAME BEFORE GETWORD 59810021 * 59820021 ***** DISPLAY VERB ***** 59830021 * 59840021 DSPSVB BAL JP,GENSEQ -GENSEQ 59850021 DSPGEN BAL JP,CHKOUT -CHKOUT (A-MARG OR MAJ-0) 59860021 DSPEXH CLI CURCOD,XX33 FLOAT PNT LIT 59870021 BC NOTEQ,DSPSPN NO-DSPSPN 59880021 * SET UP LITERAL IN EXTERNAL FORM 59890021 MVC CURN(LX31),CURCNT 59900021 BC UNCOND,DSPGEN -DSPGEN 59910021 * 59920021 DSPSPN CLC CURCOD(LX2),UPONCN UPON 59930021 BC NOTEQ,DSPGEN NO-DSPGEN 59940021 BAL JP,CHKOUT -CHKOUT 59950021 LA JG,CURN ADDR OF MNEMONIC NAME 59960021 BAL JP,SCHSPN -SCHSPN 59970021 TM SCHSW,XX40 FOUND 59980021 BZ DSPGEN NO 59990021 MVC CURCOD(LX3),DX0(JB) MOVE CODE 60000021 BC UNCOND,DSPGEN -DSPGEN 60010021 * 60020021 ***** ACCEPT VERB ***** 60030021 * 60040021 ACCSVB BAL JP,GENSEQ -GENSEQ 60050021 ACCANT BAL JP,CHKOUT -CHKOUT 60060021 CLC CURCOD(LX2),FROMCN FROM 60070021 BC NOTEQ,ACCANT NO-ACCANT 60080021 BAL JP,CHKOUT -CHKOUT 60090021 LA JG,CURN ADDR OF MNEMONIC NAME 60100021 BAL JP,SCHSPN -SCHSPN 60110021 TM SCHSW,XX40 FOUND 60120021 BZ ACCANT NO 60130021 MVC CURCOD(LX3),DX0(JB) MOVE CODE 60140021 BC UNCOND,ACCANT -ACCANT 60150021 * 60160021 * 60170021 ************ SUBROUTINE FOR FILENAME ********* 60180021 * 60190021 FILSVB ST JP,SV1F12 SAVE LINK REG 60200021 BAL JP,GENSEQ GEN CARD NUM - F4 SEQ NUM - F2 60210021 B *+8 SKIP SAVE 60220021 FILSVR ST JP,SV1F12 SAVE LINK REG 60230021 BAL JP,GENA PUT ON FILE 2 60240021 BAL JP,GETWD GET NEXT WORD 60250021 CLI CURCOD,XX23 BCD NAME 60260021 BNE FILSV1 NO 60270021 LA JG,CURN 60280021 FILSV3 BAL JP,SCHFNT SEARCH FNT TABLE 60290021 TM SCHSW,XX40 FOUND 60300021 BZ FILSV1 NO 60310021 LH JC,FNPIOT(JB) GET PIOTBL PTR 60320021 BAL JP,SETPIO GET PIOTBL ENTRY 60330021 L JP,SV1F12 60340021 B NX4(JP) 4 PASS RT ADDR TO VRBENT RTN 60350021 FILSV1 L JP,SV1F12 RETURN-NOT FOUND 60360021 BR JP RETURN 60370021 FILSV2 ST JP,SV1F12 60380021 B FILSV3 SEARCH FNTBL RTN 60390021 * 60400021 ************ START VERB ************* 60410021 * 60420021 STTSVB BAL JP,FILSVB CHECK IF FN IS IN FNTBL 60430021 B VRBENT CHK FOR MAJ VERB 60440021 OI PIOFL3(JE),PIOSTR YES - TURN ON START BIT 60450021 B INVCHK CK INVALID 60460021 * 60470021 ************ SEEK VERB **************** 60480021 * 60490021 SEKSVB BAL JP,GETWD GET SEEK CLAUSE WDS 60500021 BAL JP,MAJTST NEXT CLAUSE 60510021 B VRBMAJ YES - VRB SCAN 60520021 B SEKSVB NO - KEEP GETTING 60530021 * 60540021 EJECT 60550021 *=2 GEN FILES 3,4 60560021 * 60570021 ***** GENSEQ ***** 60580021 * 60590021 GENSEQ ST JP,SV1F05 SAVE LINK REG 60600021 MVC CRDGCN+NX1(LX2),CURGCN GEN CARD NUMBER 60610021 LA JF,CRDGCN ADDR OF CARD NUM TEXT 60620021 CLI CURCOD,XX44 IS IT VERB 60630021 BNE *+8 NO 60640021 OI CRDGCN+NX1,XX80 INDICATE CARD NO FOR VERB 60650021 BAL JP,GENB -GENB PUT TO FILE TWO 60660021 NI CRDGCN+NX1,XX7F FOR PHASE 6 CLIST PROCESSING 60670021 L JA,COSADR WRITE 60680021 TM PHZSW3,VERBR LISTING A-TEXT OPTION 60690021 BNO GENMOV1 NO 60700021 XR JC,JC CLEAR REG 60710021 IC JC,CURCNT WORD SIZE 60720021 LA JB,PRF4NU MOVE TO 60730021 LA JG,CURCNT MOVE FROM 60740021 EX JC,TXMOVE EX MOVE OF WORD TO F4 TEXT 60750021 LA JC,DX2(JC) ADJ TO SIZE OF F4 TEXT FIELD 60760021 LA JB,PRF4CD ADDR OF ENTRY ATEXT 60770021 GENMOV L JA,COSADR PUTN TO 60780021 BALR JR,JA FILE 60790021 DC X'12' TWO 60800021 GENMOV1 CLI CURCOD,XX44 VERB 60810021 BNE GENCVB NO 60820021 L JA,COSADR 60830021 AP DATE+NX4(LX4),SVCINC ADD 1 TO VERB COUNT 60840021 GENCVB L JP,SV1F05 60850021 BCR UNCOND,JP RETURN 60860021 EJECT 60870021 *=2 DICTIONARY ENTRY 60880021 * 60890021 ***** DICTIONARY ENTRY OF LHN ***** 60900021 * 60910021 DICENT ST JP,SV1F06 SAVE LINK REG 60920021 TM LCCHAR,XX40 SECTION NAME 60930021 BC ONES,DICSCT YES-DICSCT 60940021 MVI NAMCOD,XX00 SET CODE TO '0' FOR ENTNAM 60950021 MVI NAMCOD+NX4,XX06 ATTRIB COUNT FOR PN 60960021 MVI LCATRB,XX6D COUNT TO WORK-AREA 60970021 BC UNCOND,DICPAR -DICPAR 60980021 DICSCT MVI NAMCOD,XX04 SET CODE TO '4' FOR ENTNAM 60990021 MVI NAMCOD+NX4,XX09 ATTRIB CT FOR SCT NAME 61000021 MVI LCATRB,XX9D CT TO WORK AREA 61010021 LA JA,NAMCOD ADDR OF PARAM 61020021 L JQ,ENNMCN ADDR OF ENTNAM 61030021 BALR JP,JQ -ENTNAM 61040021 L JQ,SVREG+NX56 RESTORE REG JQ 61050021 MVC SCTPTR,DELPTR DELIM PTR TO SECT PTR 61060021 ST JA,DELPTR STORE NEW DELIM PTR 61070021 TM FSTLHN,XX02 FIRST LHN 61080021 BC ZERO,DICFLN YES-DICFLN 61090021 LA JA,SCTPTR ADDR OF PARAM 61100021 L JQ,ENDLCN ADDR OF ENTDEL 61110021 BALR JP,JQ -ENTDEL 61120021 L JQ,SVREG+NX56 RESTORE REG JQ 61130021 MVI SCTPTR,XX04 SET CODE FOR LATRPT 61140021 LA JA,SCTPTR ADDR OF PARAM 61150021 L JQ,LATPCN ADDR OF LATRPT 61160021 BALR JP,JQ -LATRPT 61170021 L JQ,SVREG+NX56 RESTORE REG JQ 61180021 MVC DX7(LX2,JB),LCNUM PRESENT SCT NUM TO LAST SCT 61190021 BAL JP,SCNPNT SCAN PN TABLE 61200021 BC UNCOND,DICEXT -DICEXT 61210021 DICFLN OI FSTLHN,XX02 SET FSTLHN 'ON' 61220021 DICEXT L JP,SV1F06 RESTORE LINK REG 61230021 BCR UNCOND,JP -RETURN 61240021 DICPAR LA JA,NAMCOD ADDR OF PARAM 61250021 L JQ,ENNMCN ADDR OF ENTNAM 61260021 BALR JP,JQ -ENTNAM 61270021 L JQ,SVREG+NX56 RESTORE REG JQ 61280021 BC UNCOND,DICEXT -DICEXT 61290021 EJECT 61300021 *=2 ATTRIB SAVE 61310021 * 61320021 ***** ATTRIBUTE ENTRY TO SAVE TABLE ***** 61330021 * 61340021 ATRLNT ST JP,SV1F07 SAVE LINK REG 61350021 MVC PNBCDN(LX32),LCBCD LHN TO WORK AREA 61360021 BC UNCOND,ATRNQN -ATRNQN 61370021 ATRENT ST JP,SV1F07 SAVE LINK REG 61380021 TM DSQLSW,XX80 MORE THAN ONE QUALIFIER 61390021 BCR ONES,JP YES-RETURN 61400021 MVC PNBCDN(LX31),CURN PROCEDURE NAME TO WORK AREA 61410021 TM QLPNSW,XX40 QUALIFIED PN 61420021 BC ONES,ATRQNM YES-ATRQNM 61430021 L JA,PNTCON 61440021 LA JH,PNBCDN GET ADDR OF FIELD TO COMPAR 61450021 BAL JP,VARPN CHECK IF PN IS IN TABLE 61460021 TM VRPNSW,XX40 PN FOUND 61470021 BC ZERO,ATRNQN NO 61480021 PNCOR LA JB,DX2(JC,JB) YES, GET ADDR OF PNCHAR 61490021 OC DX0(LX2,JB),PNCHAR OR IN ATTRIBUTES 61500021 BC UNCOND,ATREXT RETURN 61510021 ATRNQN L JA,PNTCON ADDR OF PNTABL 61520021 SR JR,JR 61530021 IC JR,PNBCDN 61540021 AH JR,HWFOUR 61550021 STC JR,PNBCT 61560021 AH JR,HWONE 61570021 L JQ,ADSERT CALL INSERT 61580021 BALR JP,JQ GO TO INSERT RTN 61590021 L JQ,SVREG+NX56 RESTORE BASE REG 61600021 LA JG,PNBCDN+NX1 GET ADDR OF PN 61610021 SR JC,JC 61620021 IC JC,PNBCDN 61630021 AR JG,JC ADD LENGTH OF PN 61640021 MVC DX0(LX3,JG),PNCHAR MOVE CONSTANTS UP 61650021 BC UNCOND,ATRPNB PREP TO EXEC MOVE INSTRUCT. 61660021 ATRQNM L JA,PNQCON ADDR OF PNQTBL 61670021 LA JH,PNBCDN GET ADDR OF FIELD TO COMPAR 61680021 BAL JP,VARPN CHECK IF PN QUAL IS IN TBL 61690021 TM VRPNSW,XX40 PNQ FOUND 61700021 BC ONES,PNCOR YES 61710021 L JA,PNQCON NO 61720021 SR JC,JC 61730021 IC JC,PNBCDN GET CT OF PN 61740021 SR JD,JD 61750021 IC JD,PNBCDQ GET CT OF PN QUAL 61760021 LA JR,DX6(JC,JD) ADD CONSTANTS BYTES 61770021 STC JR,PNBCT STORE TOTAL CT 61780021 AH JR,HWONE ADD 1 FOR TOTAL CT BYTE 61790021 L JQ,ADSERT CALL INSERT 61800021 BALR JP,JQ GO TO INSERT RTN 61810021 L JQ,SVREG+NX56 RESTORE BASE REG 61820021 LA JG,PNBCDN+NX1 GET ADDR OF PN 61830021 SR JC,JC 61840021 IC JC,PNBCDN 61850021 AR JC,JG ADD LENGTH OF PN 61860021 LA JD,DX4(JD) ADD 4 BYTES TO PN QUAL LENG 61870021 EX JD,PNQMV MOVE CONSTANTS/PNQUAL UP 61880021 ATRPNB LA JG,PNBCT GET ADDR OF AREA TO STORE 61890021 SR JA,JA 61900021 IC JA,PNBCT GET CT FOR 'EX' 61910021 EX JA,TXMOVE 'EX' MOVE TO TABLE 61920021 MVI PNQLCD,XX22 REINITIALIZE AFTER SHIFTING QUAL PN 61930021 ATREXT XC PNCHAR(LX3),PNCHAR SET TO ZERO 61940021 L JP,SV1F07 RESTORE LINK REG 61950021 BCR UNCOND,JP -RETURN 61960021 *DEL 61970021 *DEL 61980021 EJECT 61990021 *=2 SEARCH PN TABLE 62000021 * 62010021 ** SEARCH PN TABLE - IF FOUND PUT ATTRIB IN ENTRY AND DELETE PN 62020021 * 62030021 SCNPNT TM FSTLHN,XX02 FIRST LHN SW 'ON' 62040021 BC ONES,SCNSET YES-SCNSET 62050021 OI FSTLHN,XX02 SET FSLHN 'ON' 62060021 BCR UNCOND,JP -RETURN 62070021 SCNSET NI QLPNSW,XXBF SET QLPNSW 'OFF' 62080021 ST JP,SV1F08 SAVE LINK REG 62090021 L JF,PNTCON ADDR OF TABLE TO BE SCANED 62100021 MVC GRPPTR+NX1(LX3),SCTPTR+NX1 CUR SECT TO BE SEARCHED 62110021 BAL JP,SEARCH -SEARCH 62120021 L JF,DX0(JF) ADDR OF TAMM 62130021 STH JD,DX4(JF) ADJ DISPL OF PNTABL 62140021 * 62150021 ** SEARCH QUAL PN TABLE - IF FOUND PUT ATTRIB IN ENTRY AND DELETE 62160021 * 62170021 L JF,PNQCON ADDR OF TABLE TO BE SCANED 62180021 OI QLPNSW,XX40 SET QLPNSW 'ON' 62190021 BAL JP,SEARCH -SEARCH 62200021 L JF,DX0(JF) ADDR OF TAMM 62210021 STH JD,DX4(JF) ADJ DISPL OF PNQTBL 62220021 L JP,SV1F08 RESTORE LINK REG 62230021 BCR UNCOND,JP -RETURN 62240021 * 62250021 SEARCH ST JP,SV1F09 SAVE LINK REG 62260021 XC DISPJH(LX4),DISPJH 62270021 SR JE,JE 62280021 SR JH,JH 62290021 BAL JP,PNTAB CALC ADDR 62300021 LH JD,DX4(JC) GET SIZE OF TAB 62310021 STH JD,EOTPN 62320021 SEAEND CLC EOTCP(LX2),EOTPN END OF TABLE 62330021 BC NOTLO,SEAEXT YES BRANCH 62340021 TM QLPNSW,XX40 SCANNING PNQTBL 62350021 BC ONES,SEADEL YES 62360021 SEALAT IC JE,DX0(JG) NO, GET TOTAL CT 62370021 LA JE,DX1(JE) TOTAL CT + 1 62380021 LA JP,DX1(JG) GET ADDR OF PN IN TBL 62390021 IC JH,DX1(JG) CT OF BCD PN 62400021 XC PNMVS(LX32),PNMVS ZERO OUT WORKAREA FOR ACCESS 62410021 EX JH,PNMVD MOVE PN TO FULL WORD(ACCESS) 62420021 MVC GRPBCD+NX1(LX3),ADPNMV+NX1 62430021 LA JA,GRPBCD ADDR OF PARAM 62440021 L JQ,LATGCN ADDR OF LATGRP 62450021 BALR JP,JQ -LATGRP 62460021 LR JA,JQ SAVE REG FOR TEST 62470021 L JQ,SVREG+NX56 RESTORE REG JQ 62480021 BAL JP,PNTAB RECALCULATE ADDR ACROSS ACC 62490021 CH JA,HWFOUR FOUND 62500021 BC EQ,SEANEW NO-SEANEW 62510021 BC HI,SEASIZ DUP-SEASIZ 62520021 SEAINS LA JC,DX2(JH,JG) ADDR OF PNCHAR 62530021 OC DX1(LX2,JB),DX0(JC) PUT ATTRIB FROM TBL TO DICT 62540021 SEASIZ SR JD,JE REDUCE SIZE OF TABLE 62550021 TM QLPNSW,XX40 PNQTBL SEARCH? 51903 62560021 BNO SEBENT NO - CONTINUE 51903 62570021 LTR JD,JD JD ZERO? 51903 62580021 BC ZERO,SEBENT YES - LEAVE TABLE ALONE 51903 62590021 LA JP,SEAEND LOAD RETURN REGISTER 51903 62600021 B PNQMOVUP ADJUST PNQTBL 51903 62610021 SEANEW TM QLPNSW,XX40 QLPNSW 'ON' 62620021 BC ONES,SEBENT YES-SEBENT 62630021 LA JC,DX4(JH,JG) GET ADDR OF PNOLD 62640021 TM DX0(JC),XX80 NEW 62650021 BC ONES,SEAENT NO-SEAENT 62660021 MVC RNMBCD+NX1(LX3),ADPNMV+NX1 62670021 LA JA,RNMBCD ADDR OF PARAM 62680021 L JQ,LATRCN ADDR OF LATRNM 62690021 BALR JP,JQ -LATRNM 62700021 LR JA,JQ SAVE REG FOR TEST 62710021 L JQ,SVREG+NX56 RESTORE REG JQ 62720021 BAL JP,PNTAB CALC ADDR ACROSS ACCESS 62730021 CH JA,HWFOUR FOUND 62740021 BC HI,SEASIZ DUP-SEASIZ 62750021 BC LO,SEAINS YES-SEAINS 62760021 LA JC,DX4(JH,JG) CALCULATE ADDR OF PNOLD 62770021 OI DX0(JC),XX80 MAKE OLD 62780021 SEAENT CLC EOTCP(LX2),DISPJH MOVE UP NEEDED 62790021 BC EQ,SEAADV NO-SEAADV 62800021 L JC,DX0(JF) YES GET ADDR OF TABLE 62810021 L JC,DX0(JC) 62820021 LA JC,DX0(JC) 62830021 AH JC,DISPJH CALC ADDR TO MOVE TO 62840021 BCTR JE,JR SUB ONE FROM REG FOR MOVE 62850021 EX JE,UPMOVE MOVE ENTRY UP 62860021 LA JE,DX1(JE) 62870021 SEAADV LH JC,DISPJH ADVANCE SAVE DISP 62880021 AR JC,JE 62890021 STH JC,DISPJH 62900021 SEBENT LH JR,EOTCP ADVANCE 62910021 AR JR,JE LOOKUP 62920021 STH JR,EOTCP DISP 62930021 AR JG,JE ADVANCE LOOKUP ADDR 62940021 BC UNCOND,SEAEND -SEAEND 62950021 UPMOVE MVC DX0(LX0,JC),DX0(JG) 62960021 SEADEL IC JE,DX0(JG) GET TOTAL CT 62970021 LA JE,DX1(JE) TOTAL CT + 1 62980021 IC JH,DX1(JG) GET BCD CT OF PN 62990021 LA JP,DX6(JH,JG) GET ADDR OF QUALIFIER 63000021 SR JA,JA 63010021 IC JA,DX0(JP) GET COUNT OF BCD QUAL 63020021 XC PNMVS(LX32),PNMVS ZERO OUT WORKAREA FOR ACCESS 63030021 EX JA,PNMVD MOVE PNQ TO FULL WD FOR ACCE 63040021 MVC LNMBCD+NX1(LX3),ADPNMV+NX1 63050021 LA JA,LNMBCD ADDR OF PARAM 63060021 L JQ,LDELCN ADDR OF LDELNM 63070021 BALR JP,JQ -LDELNM 63080021 LR JB,JQ SAVE REG FOR TEST 63090021 L JQ,SVREG+NX56 RESTORE REG JQ 63100021 ST JC,LOOKUP SAVE SECT PTR 63110021 BAL JP,PNTAB CALC ADDR ACROSS ACCESS 63120021 CH JB,HWFOUR FOUND 63130021 BC HI,SEASIZ DUP-SEASIZ 63140021 BC EQ,SEAENT NO-SEAENT 63150021 LTR JA,JA DELIM IS '0'- NOT BUILT YET 63160021 BC ZERO,SEAENT YES-SEAENT 63170021 MVC GRPPTR+NX1(LX3),LOOKUP+NX1 SECT PTR TO PARAM LATGRP 63180021 BC UNCOND,SEALAT -SEALAT 63190021 SEAEXT L JP,SV1F09 RESTORE LINK REG 63200021 BCR UNCOND,JP -RETURN 63210021 *DEL 63220021 *DEL 63230021 *DEL 63240021 *DEL 63250021 *DEL 63260021 *DEL 63270021 EJECT 63280021 *=2 DUMMY HEADER 63290021 * 63300021 ***** DUMMY HEADER GENERATION ****** 63310021 * 63320021 * 63330021 * THIS ROUTINE IS CALLED TO INSERT A DUMMY SECTION-NAME, 63340021 * WHEN ONE IS MISSING, AT THE FOLLOWING POINTS IN PROC-D 63350021 * 63360021 * AFTER--PROC-DIV HEADER W/O DECLARATIVES SECTION. 63370021 * -DECLARATIVES HEADER. 63380021 * -END DECLARATIVES. 63390021 * -LAST PARAGRAPH OF PROC-DIV. 63400021 * BEFORE-EACH USE SENTENCE IN DECLARATIVES SECTION. 63410021 * 63420021 * LEAVES DICTIONARY WORK AREA SET UP WITH DUMMY-NAME AND 63430021 * 63440021 DUMGEN ST JQ,SAVJQ1 SAVE REG 15 63450021 ST JP,SV1F10 SAVE REG 14 63460021 L JP,ADUMGN A(DUMGN) 63470021 BCR UNCOND,JP BR TO DUMGEN 63480021 *DEL 63490021 *DEL 63500021 *DEL 63510021 *DEL 63520021 *DEL 63530021 *DEL 63540021 *DEL 63550021 *DEL 63560021 *DEL 63570021 *DEL 63580021 *DEL 63590021 *DEL 63600021 *DEL 63610021 *DEL 63620021 EJECT 63630021 *=2 EOS GENERATOR 63640021 * 63650021 ***** EOS TEST AND GENER IF MISSING ***** 63660021 * 63670021 EOSTGP TM DEBEOS,XX08 IS DEBEOS 'ON' 63680021 BCR ONES,JP YES-RETURN 63690021 ST JP,SV1F11 SAVE LINK REG 63700021 CLC CURCOD(LX2),EOSCON PERIOD 63710021 BC EQ,EOSTXT YES-EOSTXT 63720021 CLC CURCOD(LX3),EOPCON END-OF-FILE SYSIN? 9833 63730021 BE RUNEOS YES 9833 63740021 GENMSG BAL JP,MSG43 -MSG43 9833 63750021 EOSTXT LA JF,EOSCON SET UP ADDR OF EOS 63760021 BAL JP,GENB -GENB GENERATE EOS 63770021 L JP,SV1F11 RESTORE LINK REG 63780021 BCR UNCOND,JP -RETURN 63790021 RUNEOS CLC CURWD(LX4),STOPCN STOP? 9833 63800021 BNE GENMSG NO 9833 63810021 LA JF,RUNCDE ENCODE 'RUN' 9833 63820021 BAL JP,GENB X 9833 63830021 B GENMSG CONTINUE EOS GENERATION 9833 63840021 EJECT 63850021 *=2 END OF JOB ROUTINE 63860021 * 63870021 ***** EOJ ROUTINE ***** 63880021 * 63890021 PRGEND LA JF,PROCCD ADDR OF PD CONSTANT 63900021 BAL JP,GENB -GENB-FORCE PD HDR ON FILE- 63910021 PROEND OI LASTSEG,XX08 PICK UP LATEST PROIRITY NO 8035 63920021 BAL JP,DUMGEN CLOSE PD WITH DUM SECTION 8035 63930021 L JH,COSADR ADDR OF COS 63940021 MVC NUMCDS(LX4,JH),SVCPCK+NX4 SAVE NUM OF CARDS 63950021 MVC DICND1-COS(LX4,JH),DELPTR 63960021 TM PTYSEG,XX01 SEGMENTED PROGRAM 63970021 BO PROENZ YES 63980021 MVI SEGLMT-COS(JH),XXFF 63990021 PROENZ TM RPTWSW,XX01 RPT SECTION 64000021 BC ZERO,NORWR NO 64010021 L JQ,ADTREL ADDR OF TABREL 64020021 L JA,RNMCON RNMTBL 64030021 BALR JP,JQ RELEASE TABLE 64040021 L JA,RWRCON RWRTBL 64050021 BALR JP,JQ RELEASE TABLE 64060021 L JA,ROUCON ROUTBL 64070021 BALR JP,JQ RELEASE TABLE 64080021 L JA,DETCON DETTBL 64090021 BALR JP,JQ RELEASE TABLE 64100021 NORWR DS 0H 64110021 L JQ,ADTREL ADDR OF TABREL 64120021 L JA,RWRCON RWRTBL TIB 64130021 TM DX0(JA),XX06 TBL PRIMED OR STATIC 64140021 BC ZERO,NORLWR NO...CONTINUE 64150021 BALR JP,JQ RELEASE TIB 64160021 NORLWR DS 0H 64170021 L JA,PNTCON PNTABL 64180021 BALR JP,JQ RELEASE 64190021 L JA,PNQCON PNQTBL 64200021 BALR JP,JQ RELEASE 64210021 L JA,FNTCON FNTBL 64220021 BALR JP,JQ RELEASE 64230021 L JA,RCDCON RCDTBL 64240021 BALR JP,JQ RELEASE 64250021 L JA,QLTCON QLTABL 64260021 BALR JP,JQ RELEASE 64270021 L JA,SPNCON SPNTBL 64280021 BALR JP,JQ RELEASE 64290021 L JQ,ADSTAC ADDRESS OF STATIC 43521 64300021 L JA,USDCON USETBL 43521 64310021 BALR JP,JQ STATIC 43521 64320021 L JB,DX0(JA) TAMM ADDRESS IN JB 43521 64330021 BAL JD,ENDREL CHECK FOR ZERO LENGTH 43521 64340021 L JQ,SVREG+NX56 RESTORE BASE REG 64350021 * L JA,APPCON APPTBL 64360021 * L JB,0(JA) 64370021 * BAL JD,ENDREL TEST FOR '0' - RELEASE 64380021 L JA,CKPCON CKPTBL 64390021 L JB,DX0(JA) 64400021 BAL JD,ENDREL TEST FOR '0' - RELEASE 64410021 L JA,TOTCON TOTTBL 64420021 L JB,DX0(JA) 64430021 BAL JD,ENDREL CHECK FOR '0'-RELEASE 64440021 L JA,OD2CON OD2TBL 64450021 L JB,DX0(JA) 64460021 BAL JD,ENDREL TEST FOR '0' - RELEASE 64470021 L JA,PIOCON PIOTBL 64480021 L JB,DX0(JA) 64490021 BAL JD,ENDREL TEST FOR '0' - RELEASE 64500021 BALR JR,JH LOAD 64510021 DC X'A0' NEXT PHASE 64520021 ENDREL CLC DX4(LX2,JB),HWZERO TABLE LENGTH USED IS ZERO 64530021 BCR NOTEQ,JD NO-RETURN 64540021 L JQ,ADTREL YES-RELEASE 64550021 BALR JP,JQ TABLE 64560021 L JQ,SVREG+NX56 RESTORE BASE REG 64570021 BCR UNCOND,JD -RETURN 64580021 EJECT 64590021 *=2 PROCESS REPORT VERBS 64600021 * 64610021 *** PROCESS REPORT VERBS 64620021 * 64630021 * 64640021 * 64650021 * 64660021 * INIT ** INITIATE VERB ** SAME AS TERMINATE VERB 64670021 * 64680021 * INITIATE RPT-NM GENS ** RPT-CALL INT-ROUT 64690021 * TERMINATE RPT-NAME GENS ** RPT-CALL LST-ROUT 64700021 * 64710021 INIT DS 0H 64720021 OI INITSW,XX80 TURN ON INITIATE SWITCH 64730021 BC UNCOND,TERM GO PROCESS 64740021 * 64750021 *GENR -- GENERATE VERB 64760021 * 64770021 GENR EQU * 64780021 BAL JP,GENSEQ GO TO GEN SEQ NUM RTN 64790021 TM RPTWSW,XX01 RPT SECTION PROCESSED 64800021 BC ZERO,RVER1B NO 64810021 BAL JP,GETWD GET NEXT WORD 64820021 CLI CURCOD,XX23 BCD NAME 64830021 BC NOTEQ,GNER NO ERROR 64840021 * GET DETAIL NAME FROM DETAIL TABLE 64850021 L JA,DETCON DETTBL TIB 64860021 BAL JP,TBLNIT GET START ETC 64870021 BC ZERO,GENR4 NO-MIGHT BE GEN RPT-NM 64880021 LA JB,DX0(JB,JA) LAST ADR OF TABLE 64890021 GENR1 CLC CURBCD(LX30),DX0(JA) DETAIL NAME FOUND 64900021 BC EQ,GENR2 YES 64910021 LA JA,DX38(JA) GET NEXT ENTRY 64920021 CR JA,JB OUT OF TABLE 64930021 BC LO,GENR1 NO-LOOK AGAIN 64940021 BC UNCOND,GENR4 YES-MIGHT BE GEN RPT-NAME 64950021 GENR2 DS 0H 64960021 ST JA,DETADR SAVE ADR OF DETTBL 64970021 MVC DRWDSP(LX2),DX34(JA) SAVE DISP OF RD NM ENT 64980021 L JA,RWRCON RWRTBL TIB 64990021 L JA,DX0(JA) RWRTBL TAMM 65000021 L JB,DX0(JA) START OF RWRTBL 65010021 LH JA,DRWDSP ADD DISP IN RWRTBL 65020021 LA JB,DX0(JA,JB) 65030021 GENR2A ST JB,RDADR SAVE ADR OF RDNM IN RWRTBL 65040021 MVC RRWDSP(LX2),DX46(JB) DISPL OF ROUTS IN ROUTBL 65050021 CLC RWDN(LX30),DX0(JB) WORKING ON SAME RPT 65060021 BC EQ,GENR3 ROUTS OK FOR THIS RPT 65070021 MVC RWDN(LX30),DX0(JB) NO MUST SET UP FOR THIS RPT 65080021 L JA,ROUCON ROUTBL TIB 65090021 L JA,DX0(JA) ROUTBL TIB 65100021 L JB,DX0(JA) START OF ROUTBL 65110021 LH JA,RRWDSP ADD DISP IN ROUTBL 65120021 LA JB,DX0(JA,JB) 65130021 MVC GNRH(LX26),DX0(JB) 65140021 L JA,RDADR 65150021 GENR3 DS 0H 65160021 TM GENSW2,XX20 GEN RPT-NAME 65170021 BC ZERO,GENR3B NO 65180021 MVC CURRD+NX1(LX31),CURN PUT RD NAME IN CURRD 10 65190021 MVC RCGN(LX2),GNFRST GEN RPT-CALL GNFRST 65200021 BAL JP,GNRCLL GO TO GENERATE REPORT CALL 65210021 MVC RCGN(LX2),GNCTLB GEN RPT-CALL GNCTLB 65220021 BAL JP,GNRCLL GO TO GENERATE REPORT CALL 65230021 * GET DETAIL ENTRIES FOR THIS REPORT NAME 65240021 * AND GEN A RPT-CALL FOR EACH USM-ROUT 65250021 * DRWDSP HAS DSPL INTO RWRTBL FOR THIS RPT-NM 65260021 L JA,DETCON DETTBL TIB 65270021 BAL JP,TBLNIT GET START ETC 65280021 LR JD,JA SAVE START IN JD 65290021 LA JE,DX0(JB,JA) GET END IN JE 65300021 GEN31 DS 0H 65310021 CLC HWZERO(LX2),DX0(JD) IS THIS A DUMMY DETAIL ENTRY 65320021 BC EQ,GEN32 YES..SKIP 65330021 CLC DRWDSP(LX2),DX34(JD) SAME DISPLACEMENTS 65340021 BC EQ,GEN33 YES..GO GEN 65350021 GEN32 DS 0H 65360021 LA JD,DX38(JD) POINT TO NEXT ENTRY 65370021 CR JD,JE END OF TBL 65380021 BC LO,GEN31 NO...CHECK AGAIN 65390021 BC UNCOND,GENR3A CONTINUE 65400021 GEN33 DS 0H 65410021 TM DX33(JD),XXFF IS THIS AN UPON DE-NM 65420021 BC ONES,GEN32 YES..SKIP 65430021 MVC RCGN(LX2),DX36(JD) NO...GEN 65440021 BAL JP,GNRCLL RPT-CALL USM-ROUT 65450021 BC UNCOND,GEN32 CHECK NEXT ENTRY 65460021 GENR3B DS 0H 65470021 L JA,DETADR GET DETAIL ENTRY 65480021 MVC RCGN(LX2),DX31(JA) GEN RPT-CALL DET 65490021 BAL JP,GNRCLL GO TO GENERATE REPORT CALL 65500021 L JA,RDADR 65510021 BC UNCOND,GNXIT EXIT TO GET WD IN VRB SCAN RTN 65520021 GENR3A DS 0H 65530021 NI GENSW2,XXDF SET OF GEN RPT-NM 65540021 BC UNCOND,GNXIT EXIT TO GET WD IN VRB SCAN RTN 65550021 *GENR4-CHECK FOR GEN RPT-NM 65560021 GENR4 DS 0H 65570021 L JA,RWRCON RWRTBL TIB 65580021 BAL JP,TBLNIT GET START ETC 65590021 BC ZERO,GNER NO ENTRY IN TABLE 65600021 LR JE,JA SAVE START 65610021 LA JB,DX0(JB,JA) LAST ADR OF TABLE 65620021 GENR5 CLC CURWD(LX30),DX0(JA) RD NM FOUND 65630021 BC EQ,GENR6 YES 65640021 LA JA,DX48(JA) GET NEXT ENTRY 65650021 CR JA,JB OUT OF TBL 65660021 BC LO,GENR5 NO-LOOK AGAIN 65670021 BC UNCOND,GNER YES ERROR 65680021 GENR6 LR JB,JA SET UP FOR GEN RPT-NM 65690021 CLI DX46(JA),XXFF REPORT SPECIFIED IN RPT-SECT 65700021 BE GNER NO...ERROR 65710021 SR JA,JE GET DISPL FOR THIS RD 65720021 STH JA,DRWDSP SAVE 65730021 OI GENSW2,XX20 CODE GEN RPT-NM 65740021 BC UNCOND,GENR2A -GO SAVE ADDR OF RDNUM 65750021 GNXIT BAL JP,CHKIN CK IN VERB SCAN RTN 65760021 BC UNCOND,RVER1 ERR - UNRECOGNIZED WD 65770021 * 65780021 *TERM -- TERMINATE VERB 65790021 * 65800021 TERM EQU * 65810021 BAL JP,GENSEQ GENER SEQ NUM 65820021 TM RPTWSW,XX01 REPORT SECTION PROCESSED 65830021 BC ZERO,RVER1B ERR - INVALID WORD 65840021 TTMPGO BAL JP,GETWD GET NEXT WORD 65850021 L JA,RWRCON 65860021 L JB,DX0(JA) GET TAMM 65870021 TM DX0(JB),XX06 WAS TBL PRIMED OR STATIC 65880021 BC ZERO,TERER NO...NO REPORTS ALLOWED 65890021 BAL JP,TBLNIT GET START ETC 65900021 BC ZERO,TERER YES ERROR NO OPND FOR TERM 65910021 LA JB,DX0(JB,JA) LAST ADR OF TBL 65920021 ST JA,RDADR SAVE ADR OF RDNM IN RWRTBL 65930021 TERM1 DS 0H 65940021 MVC RRWDSP(LX2),DX46(JA) DISPL OF ROUT IN ROUTBL 65950021 CLC CURWD(LX30),DX0(JA) 65960021 BC EQ,TERM2 NAME FOUND 65970021 LA JA,DX48(JA) STEP TO NEXT ENTRY 65980021 CR JA,JB OUT OF TBL 65990021 BC LO,TERM1 NO-LOOK AGAIN 66000021 BC UNCOND,TERER ERROR NO OPND 66010021 TERM2 DS 0H NAME FOUND 66020021 CLI DX46(JA),XXFF REPORT SPECIFIED IN RPT-SECT 66030021 BE TERER NO...ERROR 66040021 MVC RWDN(LX30),DX0(JA) SAVE RPT-NAME FOR ROUTBL ENTRIES 66050021 L JA,ROUCON ROUTBL TIB 66060021 L JA,DX0(JA) ROUTBL TAMM 66070021 L JB,DX0(JA) START OF TBL 66080021 LH JA,RRWDSP 66090021 LA JB,DX0(JA,JB) 66100021 MVC GNRH(LX48),DX0(JB) ROUTINE GN'S TO GN AREA 66110021 MVC RCGN(LX2),GNLAST GEN RPT-CALL GNLAST 66120021 TM INITSW,XX80 IN INITIATE CLAUSE 66130021 BC ZERO,TERM3 NO...GEN RPT-CALL LST-ROUT 66140021 MVC RCGN(LX2),GNINT YES..GEN RPT-CALL INT-ROUT 66150021 TERM3 DS 0H 66160021 BAL JP,GNRCLL GO TO GENERATE REPORT CALL 66170021 * CHECK FOR MORE THAN ONE REPORT NAME TO BE TERMINATED 66180021 TERXIT CLI NXTCOD,XX23 BCD NAME 66190021 BC EQ,TTMPGO YES-TERMINATE NEXT RPT-NAME 66200021 NI INITSW,XX7F RESET 66210021 BAL JP,CHKIN CK IN VERB SCAN RTN 66220021 BC UNCOND,RVER1 ERR - UNRECOGNIZED 66230021 * 66240021 **USE BEFORE REPORTING DATANAME ROUTINE 66250021 *SECTNM=LCBCD 32 COUNT FOLLOWED BY DATA-NAME LCCHAR+1 (FE)= DN NO 66260021 UBRTN DS 0H 66270021 ST JP,JPUBRS 66280021 L JA,RNMCON SET DATA-NAME FROM TABLE 66290021 BAL JP,TBLNIT GET START ETC 66300021 BC ZERO,UBXER ERROR 66310021 LA JB,DX0(JB,JA) LAST ADR OF TABLE 66320021 UBRTN2 CLC CURCOD(LX32),DX0(JA) NAME FOUND 66330021 BC EQ,UBRTN3 YES - GEN ORG AND RESET RTN 66340021 LA JA,DX35(JA) NEXT ENTRY 66350021 CR JA,JB 66360021 BC LO,UBRTN2 LOOK AGAIN 66370021 UBXER NI LCCHAR+NX1,XXFE SET OF SWITCH IND ERROR 66380021 BAL JP,MSG32 INCORRECT IN USE SENT. 66390021 BC UNCOND,UBRXIT GET RETURN ADDR 66400021 *GENERATE ORG AND RESET 66410021 UBRTN3 DS 0H 66420021 MVC RWDNPR(LX3),DX32(JA) SAVE PAR NM 66430021 LA JF,RORG GEN ORG 66440021 BAL JP,GENB WRITE CALL 66450021 MVC GOGN(LX2),RWDNPR GEN PAR NAME 66460021 LA JF,GOGNA 66470021 BAL JP,GENB WRITE CALL 66480021 CLI ORGFLG,XX01 66490021 BC EQ,UBRTN4 SAVE WAS USED IN ROUT-+ 66500021 LA JF,ZECON MODIF = ZERO 66510021 BC UNCOND,UBRTN5 WRITE THEN GEN SECT NAM 66520021 UBRTN4 DS 0H 66530021 LA JF,PLUSCD MODIF = PLUS 66540021 UBRTN5 BAL JP,GENB WRITE GN 66550021 LA JF,SLBCD GEN SECTION-NAME 66560021 BAL JP,GENB WRITE GN FOR SECT NAM 66570021 LA JF,RRORG GEN OVERLAY RESET 66580021 BAL JP,GENB WRITE GN FOR OVERLAY 66590021 UBRXIT L JP,JPUBRS 66600021 BCR UNCOND,JP - RETURN 66610021 * 66620021 RVER1 EQU * UNRECOGNIZED WD IN RW VB CL 66630021 CLI CURN,XX50 IS WORD 'THEN'? 08586 66640021 BC EQ,RVER1A YES-CONTINUE VERB SCAN 08586 66650021 BAL JP,MSG60 INVALID WD IN RW VERB CLAUSE 66660021 NI INITSW,XX7F RESET 66670021 RVER1A BAL JP,CHKIN CK IN VERB SCAN 66680021 BC UNCOND,RVER1A CHECK IN LOOP 66690021 RVER1B DS 0H DID NOT HAVE REPORT SECTIO 66700021 BAL JP,MSG4 INVALID WORD 66710021 BC UNCOND,RVER1A CHKIN LOOP 66720021 GNER EQU * ILLEGAL OPND FOR GENERATE 66730021 BAL JP,MSG68 -OPEN FOR GN NOT FOUND 66740021 BC UNCOND,GNXIT EXIT TO SCAN VERB 66750021 TERER DS 0H 66760021 TM INITSW,XX80 IN INITIATE CLAUSE 66770021 BC ZERO,TERER1 NO...MSG106...TERM ERROR 66780021 BAL JP,MSG54 ERROR 66790021 BC UNCOND,TERER2 EXIT 66800021 TERER1 DS 0H 66810021 BAL JP,MSG106 OPERAND FOR TERMINATE NOT FOUND 66820021 TERER2 DS 0H 66830021 BC UNCOND,TERXIT CK FOR ANOTHER REPORT - TERMIN. 66840021 EJECT 66850021 IKF109 CSECT 66860021 * JA CONTAINS TIB. RTN USES JA JB JC JD JE JF JG JH 66870021 * JH CONTAINS ADDR OF FIELD TO COMPARE TO 66880021 * JB RETURNS ADDR OF NEXT EMPTY ENTRY OR ADDR OF FOUND PN 66890021 * 66900021 USING *,JQ 66910021 VARPQ L JA,DX0(JA) 66920021 L JB,DX0(JA) ADDR OF TABLE 66930021 LA JB,DX0(JB) 66940021 LH JA,DX4(JA) SIZE OF TABLE 66950021 LTR JA,JA IS IT EMPTY 66960021 BC ZERO,TBEPFL YES 66970021 SR JG,JG NO JG-LENGTH OF PNQ 66980021 SR JC,JC JC-CT OF BCD PN 66990021 SR JD,JD JD-TOTAL CT OF ENTRY 67000021 SR JE,JE JE-NO OF BYTES SEARCHED 67010021 VARAGN IC JD,DX0(JB) GET TOTAL CT 67020021 LA JD,DX1(JD) ADD 1 TO TOTAL CT 67030021 IC JC,DX1(JB) GET CT OF PN 67040021 EX JC,VARCMP COMPARE FIELD TO TBL 67050021 BC NOTEQ,VARNXT NO, 67060021 TM QLPNSW,XX40 YES IS IT PNQTBL 67070021 BC ONES,VARQLP YES, CHECK QUALIFIER 67080021 VARFD OI VRPNSW,XX40 NO, SW ON SINCE PN IS IN TB 67090021 VARRET L JQ,SVCAL1 67100021 ST JQ,LNKR15 67110021 BCR UNCOND,JP RETURN 67120021 VARCMP CLC DX1(LX0,JB),DX0(JH) EX INSTRUCTION 67130021 VARQCP CLC DX0(LX0,JF),PNBCDQ EX INSTRUCTION 67140021 VARNXT LA JB,DX0(JD,JB) ADVANCE ADDR TO NEXT ENTRY 67150021 AR JE,JD ACCUMULATE SIZE OF TBL 67160021 CR JE,JA IS IT END OF TBL 67170021 BC LO,VARAGN NO 67180021 TBEPFL NI VRPNSW,XXBF YES, PN NOT FOUND OR TBL EM 67190021 BC UNCOND,VARRET GO SET UP BASE REGISTER 67200021 VARQLP LA JF,DX6(JC,JB) ADVANCE ADDR TO PNQUAL 67210021 IC JG,DX0(JF) GET CT OF QUAL 67220021 EX JG,VARQCP IS IT SAME QUAL 67230021 BC NOTEQ,VARNXT NO 67240021 BC UNCOND,VARFD YES 67250021 * 67260021 EJECT 67270021 *=2 DUMMY HEADER 67280021 * 67290021 ***** DUMMY HEADER GENERATION ***** 67300021 * 67310021 * 67320021 * THIS ROUTINE IS CALLED TO INSERT A DUMMY SECTION-NAME, 67330021 * WHEN ONE IS MISSING, AT THE FOLLOWING POINTS IN PROC-D: 67340021 * 67350021 * AFTER--PROC-DIV HEADER W/O DECLARATIVES SECTION. 67360021 * -DECLARATIVES HEADER. 67370021 * -END DECLARATIVES. 67380021 * -LAST PARAGRAPH OF PROC-DIV. 67390021 * BEFORE-EACH USE SENTENCE IN DECLARATIVES SECTION. 67400021 * 67410021 * LEAVES DICTIONARY WORK AREA SET UP WITH DUMMY-NAME. 67420021 * 67430021 * 67440021 DUMGN EQU * 67450021 L JQ,ADCON1 SET UP ADDRESSIBILITY 67460021 L JF,ALHNNM A(LHNNUM) 67470021 BALR JP,JF BR TO LHNNUM 67480021 SR JF,JF CLEAR REG 6 67490021 MVC DUMCON+NX3(LX2),LCNUM DUMMY NAME W/PN-NUM 67500021 MVC LCBCD(LX4),DUMCON+NX1 SET BCD NM TO '4*NN' 67510021 OI LCCHAR,XX40 SET CHAR TO 1 67520021 OI LCCHAR+NX1,XX20 SET X TO 1 IDENT DUMMY PN 67530021 TM LASTSEG,XX08 END OF PROC DIV 67540021 BO DUMGEN1 SV LATEST PRIORITY NO. 67550021 MVI LCPTY,XX00 PTY=0 67560021 DUMGEN1 TM DUMUSE,XX08 IS DUMUSE ON 67570021 BC ONES,DUMSKP YES - DUMSKP 67580021 ST JQ,SAVJQ SAVE BASE REG 67590021 BAL JP,DICENT -DICENT- TO DICTIONARY 67600021 L JQ,SAVJQ RESTORE ADDRESSIBILITY 67610021 NI DHDRSW,XXF7 SET OFF DHDRSW 67620021 DUMSKP LA JF,DUMCON ADDR OF DUMMY SECT NM 67630021 NI LCCHAR+NX1,XXDF RESET X TO 0 FOR DUMMY 67640021 BAL JP,GENB -GENB 67650021 L JQ,SAVJQ1 RESTORE CALLER'S REG 15 67660021 L JP,SV1F10 RETURN REG 67670021 BCR UNCOND,JP RETURN 67680021 SAVJQ DS F SAVE JQ - R15 67690021 ALHNNM DC AL4(LHNNUM) ADDR OF LHNNUM 67700021 EJECT 8922 67710021 IKF10A CSECT 8922 67720021 * 8922 67730021 * DEBUG COLUMN INDEPENDENT ROUTINE 8922 67740021 * 8922 67750021 USING *,R5 8922 67760021 DEBRTN STM R2,R4,DEBSAVE 8922 67770021 ST JP,DEBJP 8922 67780021 MVC TWOTRE1(LX2),SVCCRD+NX72 SAVE 2 BYTES 8922 67790021 MVC COMWRK+NX72(LX2),KQUOTE DELIMIT CARD 8922 67800021 LR R4,R1 R4 = ADDR 'DEBUG' 8922 67810021 SR R1,R1 CLEAR R1 FOR TRT 8922 67820021 TRT DX6(LX80,R4),UNONB SCAN TO PROC-NM 8922 67830021 LA R3,COMWRK+NX72 R3 = ADDR END-OF-CARD 8922 67840021 CR R1,R3 IS PROC-NM MISSING? 8922 67850021 BNL DEBRETN YES 8922 67860021 LR R4,R1 R4 = BEG. ADDR OF PROC-NM 8922 67870021 BAL JP,NOLDHI PREPARE SCAN END PROC-NM 8922 67880021 SR R1,R1 CLEAR R1 FOR TRT 8922 67890021 TRT DX0(LX80,R4),NONLDH FIND END ADDR OF PROC-NM 8922 67900021 BAL JP,NOLDHO RESTORE TRT TABLE 8922 67910021 LR R3,R1 R3 = END ADDR PROC-NM 8922 67920021 SR R3,R4 R3 = LENGTH PROC-NM 8922 67930021 LA JP,DX0 JP = 0 8922 67940021 CR R3,JP NON-BLANK AND NONLDH 8922 67950021 * POINT TO SAME LOCATION 8922 67960021 * E.G. USER HAS CODED 8922 67970021 * DEBUG , 8922 67980021 BE EXMOVE REGISTER ALREADY ZERO 8922 67990021 BCTR R3,R0 DECREMENT LENGTH FOR EXEC 8922 68000021 EXMOVE EX R3,DEBMOVE PROC-NM TO COMWRK COL 8 8922 68010021 MVC COMWRK(LX7),DEBKON 'DEBUG' TO COL 1 8922 68020021 LA R1,COMWRK+NX7 8922 68030021 AR R1,R3 R1 = NEW END ADDR PROC-NM 8922 68040021 LA R3,COMWRK+NX71 R3 = ADDR COL 72 8922 68050021 SR R3,R1 R3 = LENGTH REMAINDER 8922 68060021 LTR R3,R3 8922 68070021 BC R8,RETJP NO REMAINDER 8922 68080021 MVI DX1(R1),XX40 PROPAGATE BLANKS 8922 68090021 BCTR R3,R0 DECREMENT LENGTH FOR EXEC 8922 68100021 EX R3,BLNKCOM X 8922 68110021 RETJP MVC SVCCRD+NX72(LX2),TWOTRE1 RESTORE 2 BYTES 8922 68120021 LM R2,R4,DEBSAVE RESTORE REGISTERS 8922 68130021 L JP,DEBJP X 8922 68140021 LA R1,COMWRK R1 = ADDR DEBUG IN COL 1 8922 68150021 BR JP RETURN 8922 68160021 DEBRETN MVI COMWRK,XX40 NO PROC-NM 8922 68170021 MVC COMWRK+NX1(LX79),COMWRK BLANK OUT COMWRK 8922 68180021 MVC COMWRK(LX7),DEBKON 'DEBUG' TO COL 1 8922 68190021 B RETJP RETURN 8922 68200021 * 8922 68210021 * 8922 68220021 DEBSAVE DC 3F'0' DEBUG COL INDEP. SAVEAREA 8922 68230021 DEBJP DC 1F'0' X 8922 68240021 DEBMOVE MVC COMWRK+NX7(LX0),DX0(R4) MOVE PROC-NM TO COL 8 8922 68250021 BLNKCOM MVC DX2(LX0,R1),DX1(R1) PROPAGATE BLANKS IN COMWRK8922 68260021 TWOTRE1 DC XL2'4040' X 8922 68270021 DROP R5 8922 68280021 * 8922 68290021 * 8922 68300021 THEEND DS 0F 68310021 DX0 EQU 0 68320021 LX0 EQU 0 68330021 DX1 EQU 1 68340021 NX1 EQU 1 68350021 DX2 EQU 2 68360021 NX2 EQU 2 68370021 LX2 EQU 2 68380021 DX3 EQU 3 68390021 NX3 EQU 3 68400021 DX4 EQU 4 68410021 NX4 EQU 4 68420021 LX4 EQU 4 68430021 DX5 EQU 5 68440021 NX5 EQU 5 68450021 DX6 EQU 6 68460021 NX6 EQU 6 68470021 DX7 EQU 7 68480021 NX7 EQU 7 68490021 DX8 EQU 8 68500021 NX8 EQU 8 68510021 LX8 EQU 8 68520021 LX9 EQU 9 68530021 NX11 EQU 11 68540021 DX12 EQU 12 68550021 NX12 EQU 12 68560021 NX13 EQU 13 68570021 NX14 EQU 14 68580021 DX15 EQU 15 68590021 NX16 EQU 16 68600021 NX17 EQU 17 68610021 DX18 EQU 18 68620021 NX18 EQU 18 68630021 NX20 EQU 20 68640021 DX25 EQU 25 68650021 DX31 EQU 31 68660021 DX32 EQU 32 68670021 DX33 EQU 33 68680021 DX34 EQU 34 68690021 DX35 EQU 35 68700021 DX36 EQU 36 68710021 DX38 EQU 38 68720021 DX46 EQU 46 68730021 DX48 EQU 48 68740021 NX56 EQU 56 68750021 DX59 EQU 59 68760021 NX71 EQU 71 8922 68770021 NX72 EQU 72 68780021 NX73 EQU 73 68790021 NX74 EQU 74 68800021 DX88 EQU 88 68810021 NX96 EQU 96 68820021 DX125 EQU 125 68830021 DX148 EQU 148 68840021 DX213 EQU 213 68850021 DX215 EQU 215 68860021 DX321 EQU 321 68870021 DX329 EQU 329 68880021 DX337 EQU 337 68890021 DX338 EQU 338 68900021 DX339 EQU 339 68910021 DX341 EQU 341 68920021 DX345 EQU 345 68930021 DX425 EQU 425 68940021 DX433 EQU 433 68950021 DX435 EQU 435 68960021 XX0 EQU X'00' 68970021 XX01 EQU X'01' 68980021 XX80 EQU X'80' 68990021 XX6B EQU X'6B' 69000021 XX07 EQU X'07' 69010021 XX03 EQU X'03' 69020021 XX7F EQU X'7F' 69030021 XX32 EQU X'32' 69040021 XX23 EQU X'23' 69050021 XX02 EQU X'02' 69060021 XX00 EQU X'00' 69070021 XXB9 EQU X'B9' 69080021 XXA2 EQU X'A2' 69090021 XX22 EQU X'22' 69100021 XX34 EQU X'34' 69110021 XX08 EQU X'08' 69120021 XXF9 EQU X'F9' 69130021 XXF0 EQU X'F0' 69140021 XXCF EQU X'CF' 69150021 XXD1 EQU X'D1' 69160021 XX60 EQU X'60' 69170021 XX40 EQU X'40' 69180021 XX04 EQU X'04' 69190021 XXFC EQU X'FC' 69200021 XXFB EQU X'FB' 69210021 XX33 EQU X'33' 69220021 XXFE EQU X'FE' 69230021 XX4D EQU X'4D' 69240021 XX4E EQU X'4E' 69250021 XX5D EQU X'5D' 69260021 XX30 EQU X'30' 69270021 XX10 EQU X'10' 69280021 XX8F EQU X'8F' 69290021 XXBF EQU X'BF' 69300021 XXF3 EQU X'F3' 69310021 XXFF EQU X'FF' 69320021 XX20 EQU X'20' 69330021 XX4B EQU X'4B' 69340021 XXDF EQU X'DF' 69350021 XX1F EQU X'1F' 69360021 XXEF EQU X'EF' 69370021 XXF7 EQU X'F7' 69380021 XXFD EQU X'FD' 69390021 XXC3 EQU X'C3' 69400021 XX0C EQU X'0C' 69410021 XX54 EQU X'54' 69420021 XXF1 EQU X'F1' 69430021 XX5C EQU X'5C' 69440021 XX4F EQU X'4F' 69450021 XX50 EQU X'50' 69460021 XXC5 EQU X'C5' 69470021 XX42 EQU X'42' 69480021 XX43 EQU X'43' 69490021 XX88 EQU X'88' 69500021 XX35 EQU X'35' 69510021 XX44 EQU X'44' 69520021 XX7D EQU X'7D' QUOTE 51354 69530021 XX69 EQU X'69' 69540021 XXA3 EQU X'A3' 69550021 XX72 EQU X'72' 69560021 XX6A EQU X'6A' 69570021 XXD5 EQU X'D5' 69580021 XX84 EQU X'84' 69590021 XX61 EQU X'61' 69600021 XX62 EQU X'62' 69610021 XX3C EQU X'3C' 69620021 XX17 EQU X'17' 69630021 XX99 EQU X'99' 69640021 XX64 EQU X'64' 69650021 XX66 EQU X'66' 69660021 XXE0 EQU X'E0' 69670021 XX05 EQU X'05' 69680021 XX3F EQU X'3F' 69690021 XX31 EQU X'31' 69700021 XX2F EQU X'2F' 69710021 XX11 EQU X'11' 69720021 XX1C EQU X'1C' 69730021 XX38 EQU X'38' 69740021 XX5E EQU X'5E' 69750021 XX2E EQU X'2E' 69760021 XX29 EQU X'29' 69770021 XX3B EQU X'3B' 69780021 XX27 EQU X'27' 69790021 XX21 EQU X'21' 69800021 XX24 EQU X'24' 69810021 XX2D EQU X'2D' 69820021 XX36 EQU X'36' 69830021 XX26 EQU X'26' 69840021 XX2C EQU X'2C' 69850021 XX25 EQU X'25' 69860021 XX63 EQU X'63' 69870021 XXF5 EQU X'F5' 69880021 XX06 EQU X'06' 69890021 XX5F EQU X'5F' 69900021 XX0A EQU X'0A' 69910021 XX79 EQU X'79' 69920021 XX6E EQU X'6E' 69930021 XX6C EQU X'6C' 69940021 XX9E EQU X'9E' 69950021 XX76 EQU X'76' 69960021 XX6D EQU X'6D' 69970021 XX89 EQU X'89' 69980021 XX81 EQU X'81' 69990021 XX65 EQU X'65' 70000021 XX75 EQU X'75' 70010021 XX71 EQU X'71' 70020021 XX09 EQU X'09' 70030021 XX9D EQU X'9D' 70040021 XC0 EQU C'0' 70050021 RWRON EQU X'04' TURN ON REWRITE VERB SWITCH 70060021 RWROFF EQU X'FB' TURN OFF REWRITE VERB SWITCH 70070021 FREON EQU X'80' TURN ON FREE VERB SWITCH 70080021 FREOFF EQU X'7F' TURN OFF FREE VERB SWITCH 70090021 LX1 EQU 1 70100021 LX3 EQU 3 70110021 LX5 EQU 5 70120021 LX6 EQU 6 70130021 LX7 EQU 7 70140021 LX10 EQU 10 70150021 LX12 EQU 12 70160021 LX17 EQU 17 70170021 LX18 EQU 18 70180021 LX20 EQU 20 70190021 LX26 EQU 26 70200021 LX29 EQU 29 70210021 LX30 EQU 30 70220021 LX31 EQU 31 70230021 LX32 EQU 32 70240021 LX48 EQU 48 70250021 LX59 EQU 59 70260021 LX65 EQU 65 70270021 LX66 EQU 66 70280021 LX67 EQU 67 70290021 LX79 EQU 79 70300021 LX80 EQU 80 70310021 LX81 EQU 81 70320021 LX82 EQU 82 70330021 LX88 EQU 88 70340021 LX106 EQU 106 70350021 LX120 EQU 120 70360021 LX122 EQU 122 70370021 LX123 EQU 123 70380021 LX134 EQU 134 70390021 LX162 EQU 162 70400021 LX181 EQU 181 70410021 LX200 EQU 200 70420021 LX201 EQU 201 70430021 LX255 EQU 255 70440021 END PH1B 70450021 MSG195 DC X'10C3' UNIT RECORD FOR S-MODE 70460021 BUFUR EQU X'40' UNIT RECORD IN BUFCAL 70470021 ACCMON EQU X'0F' 70480021 DICTS EQU X'60' 70490021 ONEE EQU 1 70500021 BUFC24 EQU BUFCAL+24 70510021 VMODE EQU 4 70520021 ./ ADD SSI=01010723,NAME=IKFCBL10,SOURCE=0 *$MODULE PHASE1 00007021 IHBCOB 00014021 PH1A TITLE 'IKFCBL10' 00021021 IKF101 CSECT 00028021 USING COS,R1 00035021 ENTRY PH1A 00042021 * 00049021 * 00056021 * 00063021 * 00070021 * 00077021 * PATCH AREA IS DEFINED AS 'PATCH1' IN CSECT IKF103 FOR 1A 00084021 * 00091021 * AND FOR REPORT WRITER 'PATCH2' IN CSECT IKF109 00098021 * 00105021 * 00112021 * 00119021 * 00126021 * 00133021 *=3 00140021 * 00147021 * 00154021 *TITLE 00161021 * 00168021 * 'IKFCBL10' 00175021 * 00182021 *STATUS: 00189021 * 00196021 * CHANGE LEVEL 000 00203021 * 00210021 *FUNCTION/OPERATION: 00217021 * 00224021 * PHASE 1'S GENERAL FUNCTION: 00231021 * ENCODES THE ENTIRE SOURCE PROGRAM INTO INTERNAL COMPILER TEXT. 00238021 * PERFORMS SYNTAX ANALYSIS ON THE IDENTIFICATION, ENVIRONMENT AND 00245021 * DATA DIVISIONS. PRODUCES DATA IC TEXT FROM ENV. AND DATA DIV. 00252021 * PRODUCES OUTPUT 00259021 * LISTING AND/OR A-TEXT LISTING IF AN OBJECT MODULE LISTING IS 00266021 * REQUIRED. 00273021 * 00280021 * 00287021 *ENTRY POINTS: 00294021 * 00301021 * PH1A 00308021 * 00315021 *INPUT: 00322021 * 00329021 * SYSIN - SOURCE PROGRAM (IF NOLIB IN EFFECT) 00336021 * SYSUT4 - SOURCE PROGRAM (IF LIB IN EFFECT) 00343021 * 00350021 *OUTPUT: 00357021 * 00364021 * SYSUT3 DATA IC TEXT AND E TEXT IN ID. ENV. AND DATA DIV. 00371021 * SYSPRINT SOURCE PROGRAM LISTING (IF NOLIB IN EFFECT) 00378021 * 00385021 *EXTERNAL ROUTINES: 00392021 * 00399021 * PHASE 00 LINK TO I-O AND INTERPHASE COMMON REGION 00406021 * PRIME ASSIGN AN AREA IN A TABLE REGION TO INDIVIDUAL T 00413021 * TAMEIN TAMER INITIALIZATION ROUTINE CALLED BY PH1A ONLY 00420021 * INSERT GET ROOM FOR AN ENTRY TO BE MADE IN A TABLE 00427021 * TABREL RELEASE TABLE, FREE AREA IF NO LONGER NEEDED. 00434021 * STATIC NOTE NO NEW ENTRY TO BE MADE, RELEASE UNUSED ARE 00441021 * 00448021 *EXITS- NORMAL: 00455021 * 00462021 * VIA PHASE 00 TO PHASE 1B 00469021 * 00476021 * CALLING SEQUENCE: 00483021 * L JH,COSADR BALR 0,JH DC X'A0' 00490021 * 00497021 *EXITS-ERROR 00504021 * 00511021 * NONE 00518021 * 00525021 *TABLES/WORK AREAS COMTBL, QLTABL, QNMTBL, ENVTBL, APPTBL, SATBL, 00532021 * SSATBL, SRATBL, TOTTBL, UPSTBL, KEYTAB, INDXTB, CTSTBL, 00539021 * SDETBL, PIOTBL, CKPTBL, OD2TBL, FNTBL, RCDTBL, SPNTBL, RNMTBL, 00546021 * RWRTBL, CTLTBL, ROLTBL, ROUTBL, DETTBL, NPTTBL, SUMTBL, 00553021 * QALTBL. 148 BYTES ARE RESERVED UNDER REG 13 00560021 * AND OTHER WORK AREAS START AT DIVCOD. REPORT WRITER WORK AREA 00567021 * START AT CTLENT. 00574021 * PH1A BUILDS P1BTBL WHICH IS PASSED TO PH1B CONTAINING 00581021 * INFORMATION THAT PH1B REQUIRES EQ. GENERATED SEQUENCE NUM 00588021 * TABLES ARE DESCRIBED IN PLM AND LISTING. 00595021 * 00602021 *ATTRIBUTES: 00609021 * 00616021 * NOT REUSABLE 00623021 * 00630021 *NOTES: GENERAL ORGANIZATION:- 00637021 * 00644021 * 1. EQU'S 00651021 * 3. PHASE 1A HOUSEKEEPING, INITIALIZE TAMER, PRIME TABLES 00658021 * 4. ERROR MESSAGES 00665021 * 5. WORK AREAS, COMMON WORK AND SAVE AREAS 00672021 * 6. REPORT WRITER TAMER ADCONS AND CONSTANTS 00679021 * 7. COBOL WORD TABLE 00686021 * 8. COMMON ROUTINES 00693021 * 9. GETDLM ROUTINE 00700021 * 10. UNIT LEVEL SCAN 00707021 * 12. END OF JOB ROUTINE 00714021 * 13. PROCESS REPORT VERBS 00721021 * 14. DATA DIVISION SCAN 00728021 * 15. REPORT WRITER SCAN 00735021 * 1L. ENVIRONMENT SCAN 00742021 * 17. IDENTIFICATION SCAN 00749021 * 00756021 * 00763021 * REGISTERS USAGE OF PHASE 1 (EXCLUDING ACCESS) 00770021 * 00777021 * 0 WORK REGISTER 00784021 * 1 WORK REGISTER 00791021 * 2 WORK REGISTER 00798021 * 3 WORK REGISTER 00805021 * 4 WORK REGISTER 00812021 * 5 WORK REGISTER 00819021 * 6 WORK REGISTER 00826021 * 7 WORK REGISTER 00833021 * 8 BASE REGISTER IN DATA DIV. ELSE WORK REGISTER. 00840021 * 9 BASE REGISTER 00847021 * 10 BASE REGISTER 00854021 * 11 BASE REGISTER 00861021 * 12 BASE REGISTER 00868021 * 13 GLOBAL TABLE BASE, NEVER TOUCHED, ALSO PHASE 1'S BASE REG. 00875021 * 14 LINK REGISTER, CALL REGISTER FOR SUBROUTINE 00882021 * 15 BASE REGISTER FOR INTERFACE AND INFREQUENT SUBROUTINES 00889021 * 00896021 NUMCDS EQU DATE+8-COS 00903021 PRIME EQU APRIME-COS 00910021 INSERT EQU AINSRT-COS 00917021 STATIC EQU ADSTAT-COS 00924021 TABREL EQU RELADD-COS 00931021 TAMEIN EQU TAMNAD-COS 00938021 CKPTCT EQU CKPCTR-COS 00945021 SBLOMA EQU SBLOMX-COS 00952021 VLCOMA EQU VLCOMX-COS 00959021 SBLIMA EQU SBLIMX-COS 00966021 VLCIMA EQU VLCIMX-COS 00973021 RPTSV1 EQU RPTSAV-COS 00980021 CMTLNG EQU 68 LENGTH OF COMTBL ENTRY 00987021 * 00994021 * FOLLOWING ARE REGISTER EQUATES FOR TAMER. 01001021 * 01008021 * 01015021 ****** GENERAL REGISTER SYMBOLIC EQU'S ****** 01022021 * 01029021 JA EQU 1 01036021 JB EQU 2 01043021 JC EQU 3 01050021 JD EQU 4 01057021 JE EQU 5 01064021 JF EQU 6 01071021 JG EQU 7 01078021 JH EQU 8 01085021 JJ EQU 9 01092021 JK EQU 10 01099021 JL EQU 11 01106021 JM EQU 12 01113021 JN EQU 13 01120021 JP EQU 14 01127021 JQ EQU 15 01134021 JR EQU 0 01141021 * 01148021 R0 EQU 0 01155021 R1 EQU 1 01162021 R2 EQU 2 01169021 R3 EQU 3 01176021 R4 EQU 4 01183021 R5 EQU 5 01190021 R6 EQU 6 01197021 R7 EQU 7 01204021 R8 EQU 8 01211021 R9 EQU 9 01218021 R10 EQU 10 01225021 R11 EQU 11 01232021 R12 EQU 12 01239021 R13 EQU 13 01246021 R14 EQU 14 01253021 R15 EQU 15 01260021 * 01267021 FJR EQU 0 01274021 FJB EQU 2 01281021 FJD EQU 4 01288021 FJF EQU 6 01295021 * 01302021 * STANDARD EQUATES FOR BC INSTRUCTIONS 01309021 * 01316021 UNCOND EQU 15 01323021 HI EQU 2 01330021 LO EQU 4 01337021 EQ EQU 8 01344021 EQUAL EQU 8 01351021 NOTHI EQU 13 01358021 NOTLO EQU 11 01365021 NOTEQ EQU 7 01372021 OV EQU 1 01379021 POS EQU 2 01386021 NEG EQU 4 01393021 ZERO EQU 8 01400021 NOTOV EQU 14 01407021 NOTOFF EQU 5 2768 01414021 NOTPOS EQU 13 01421021 NOTNEG EQU 11 01428021 NOTZER EQU 7 01435021 ONES EQU 1 01442021 MIXED EQU 4 01449021 NOTONE EQU 14 01456021 NOTMXD EQU 11 01463021 NOP EQU 0 01470021 * 01477021 WORKA EQU 72 8 19F - WORK AREA FOR FLOPNT RTN 01484021 WORKA2 EQU 80 8 01491021 WORKA3 EQU 88 8 01498021 WORKB EQU 96 32 01505021 SVREG2 EQU 128 8 01512021 SYGNSW EQU 136 1 01519021 FLTEXP EQU 137 1 01526021 MANDEC EQU 138 2 01533021 MANINT EQU 140 2 01540021 MANLEN EQU 142 2 01547021 TOTLNG EQU 144 2 01554021 RESDEC EQU 146 2 01561021 * 01568021 * 01575021 EJECT 01582021 *=1 ENTRY TO PHASE 1 - HOUSEKEEPING ID 01589021 PBEG12 DS 0H 01596021 DC C'IKFCBL10' PHASE NAME 01603021 DC C'B' BUILD 01610021 DC X'1D' NUMBER IN HEX 01617021 PH1A DS 0H 01624021 IKFCBL10 EQU PH1A 01631021 DUMTST STM JP,JM,DX12(JN) SAVE REGISTERS IN PH0 SAVE AREA 01638021 CNOP 0,4 01645021 LR JB,JN SAVE ADDR OF PH0 SAVE AREA IN R2 01652021 BALR JQ,JR ADDR NEXT INSTR 01659021 BC UNCOND,DX8(JQ) SKIP DC 01666021 DC A(PH1SAV) SAVE AREA FOR PH1A REGS 01673021 L JN,DX4(JQ) SET R13 TO ADDR OF PHASE SAVE AREA 01680021 ST JP,DX12(JN) SAVE SYSTEM RETURN ADR IN PHASE SV AR 01687021 ST JB,DX4(JN) PUT PTR TO PH0 SV AREA IN PHASE SV A 01694021 ST JN,DX8(JB) PUT PTR TO PHASE SV AREA IN PH0 SV A 01701021 *=2 BASE REG ASSIGN + LOAD FOR COMMON ROUTINES AND AREAS 01708021 USING PH1SAV,JN 01715021 USING IDDIV1,JM 01722021 USING GETWD,JL 01729021 USING COBWRD,JK 01736021 BC UNCOND,DX148(JN) BRANCH 01743021 * 01750021 * THE FOLLOWING 148 BYTES ARE RESERVED AREA UNDER REG13 01757021 * 01764021 * * * * D O N O T D I S T U R B * * * 01771021 * 01778021 PH1SAV DS 0D 01785021 DS 37F 18F - SAVE AREA FOR PH0 01792021 * WORKA EQU 72 8 19F - WORK AREA FOR FLOPNT RTN 01799021 * WORKA2 EQU 80 8 01806021 * WORKA3 EQU 88 8 01813021 * WO-KB EQU 96 32 01820021 * SVREG2 EQU 128 8 01827021 * SYGNSW EQU 136 1 01834021 * FLTEXP EQU 137 1 01841021 * MANDEC EQU 138 2 01848021 * MANINT EQU 140 2 01855021 * MANLEN EQU 142 2 01862021 * TOTLNG EQU 144 2 01869021 * RESDEC EQU 146 2 01876021 * 01883021 L JM,HSKP1 01890021 L JL,HSKP2 01897021 L JK,ACBW 01904021 L JQ,GETADR SET-UP BASE REGS 01911021 L JJ,GTD1 FOR GET-WORD AND GET-CARD R 01918021 STM JA,JQ,SAVREG ROUTINES 01925021 L JQ,IDDIV SET-UP BASE REGS FOR 01932021 STM JA,JQ,SVREG ID DIV SCAN 01939021 ST JQ,LNKR15 SET-UP LINK REG15 AREA 01946021 * 01953021 L JA,DX0(JA) GET COS ADDR FROM CONTROL 01960021 ST JA,COSADR STORE COS ADDR 01967021 MVC ADPRIM(LX20),APRIME 01974021 * 01981021 *=2 INITIALIZE TAMER 01988021 TM PHZSW,LIBR PRE-PROCESSOR CALLED? 01995021 BO NOTAMIN YES-SKIP TAMEIN CALL 02002021 L JQ,ADTAMN CALL TAMEIN 02009021 BALR JP,JQ BRANCH TO TAMEIN 02016021 NOTAMIN DS 0H X 02023021 *=2 PRIME OF TAMER TABLES 02030021 LA JA,PARQLT PRIME QLTABL 02037021 L JQ,ADPRIM 02044021 BALR JP,JQ PRIME TABLES 02051021 L R1,QLTCON INSERT 02058021 LA R0,DX2(JR) OF TWO 02065021 L R15,ADSERT IN QLTABL 02072021 BALR R14,R15 ADSERT 02079021 L JQ,COSADR 02086021 L JA,ADPB12 02093021 BALR R0,JQ CALL PHASE 0 02100021 DC X'06' READ FROM SYSOUT 02107021 L JQ,SVREG+NX56 02114021 * 02121021 *** SET UP FOR DOUBLE QUOTE 02128021 * 02135021 L R1,COSADR DSECT BASE 02142021 TM PHZSW1,APOST SINGLE QUOTE 02149021 BC NOTZER,RSTRJQ YES - SKIP DOUBLE INIT 02156021 MVI TBQUT1,XX07 NO - SET TRT TAB FOR 02163021 MVI TBQUT2,XX03 DOUBLE & SINGLE QUOTE 02170021 MVI KQUOTE+NX1,XX7F CHNGE BLNK-QUOTE TO BLNK-DBQT 02177021 MVI QUOCON+NX1,XX7F SINGLE TO DOUBLE QUOTES 9638 02184021 MVI QUOSCN+NX1,XX7F SINGLE TO DOUBLE QUOTES 9638 02191021 MVI SNGLQ2,XX7F 02198021 L JQ,GETADR BASE FOR GETWD 02205021 USING UNLVSN,JQ 02212021 MVI SNGLQT,XX7F SINGLE TO DOUBLE 02219021 DROP JQ 02226021 L JQ,SVREG+NX56 BASE 02233021 RSTRJQ DS 0H 02240021 * 02247021 *=2 SETUP AND TEST OF FIRST CARD READ ID 02254021 * 02261021 MVC DIVNM,IDD PUT 02ID IN DIVNM 02268021 ** BAL 14,CHNGQT -QUOTE 02275021 ** BAL 14,CHGFOR -DEC COMMA 02282021 * 02289021 * READ 1ST CARD AND CHECK IF A BASIS CARD 02296021 * 02303021 OI FXCDSW,XX02 SET 'ON' FXCDSW 02310021 BAL JP,GETCRD -GETCRD (READ 1ST CARD) 02317021 NI FXCDSW,XXFD SET 'OFF' FXCDSW 02324021 D12 EQU 12 02331021 L R4,SAVREG+D12 ADDR COL 1 IN BUFFER 02338021 SR R1,R1 CLEAR REG1 FOR TRT 02345021 TRT DX0(LX72,R4),UNONB SCAN BUFFER FOR NON BLANK 02352021 CLC DX0(LX6,R1),BASISK IS IT BASIS? 0335 02359021 * AFTER ALLOWING BASIS AND LIBRARY NAME TO BE COLUMN INDEPENDENT, 02366021 * REALIGN THEM IN COMWRK TO COLUMNS 1 AND 8 SO THAT GETWD AND 02373021 * OTHER ROUTINES THAT ASSUME THESE POSITIONS CAN BE UTILIZED. 02380021 BC NOTEQ,BASNO NO,BR AROUND SAVING BASIS NAME 02387021 * THE BASIS/COPY FUNCTIONS ARE HANDLED BY PHASE 0. A BASIS 02394021 * CARD ENCOUNTERED BY PHASE 1 MEANS THE USER DID NOT 02401021 * SPECIFY THE LIB OPTION. THE FOLLOWING CALL TO PHASE 0 TO 02408021 * READ BASIS WITH AN INVALID LIBNAME WILL CAUSE PHASE 0 TO 02415021 * ISSUE A MESSAGE AND TERMINATE. NO RETURN TO PHASE 1. 02422021 L R8,COSADR ADDR OF COS 02429021 BALR R0,R8 READ INVALID BASIS 02436021 DC X'09' TO ISSUE MSG AND TERM 02443021 DC CL8' ' INVALID LIBNAME 02450021 DC C'B' TELLS PHASE0 IT IS BASIS 02457021 * 02464021 * SET UP NEXT + CURRENT CELLS, GETDLM AND EXIT 02471021 * 02478021 BASNO MVC NMCRD4(DX6),DX0(R4) SETUP 1ST SEQ-NUM 02485021 CLC NMCRD4(LX6),UBLNK SEQ-NUM BLANK 02492021 BC EQ,BASYES YES-BASYES 02499021 MVC SVCSEQ(LX6),NMCRD4 SAVE SEQ-NUM 02506021 BASYES LA R1,COMWRK+NX73 INITIALIZE NBLPTR 7641 02513021 ST R1,NBLPTR TO COL 74 7641 02520021 BAL JP,GETWD GETWD (SET UP NEXT CELL) 7641 02527021 BAL JP,GETWD -GETWD (SET UP CUR CELL) 02534021 TM CURBCD,XX10 DIVISION HEADER 02541021 BC ZERO,NOTHDR NO-NOTHDR 02548021 CLI CURN,XXF1 ID-DIV HEADER 02555021 BC EQ,GTDLM1 YES-GETDLM 02562021 BAL JP,MSG129 ID DIV MISSING OR MISPLACED 02569021 BAL JP,MSG97 PROG-ID MISSING 02576021 OI PRIDSW,XX10 FORCE ON PROGID FOUND SW 3816 02583021 BC UNCOND,GTDLM1 CONTINUE-GETDLM 02590021 NOTHDR BAL JP,MSG129 ID DIV MISSING OR MISPLACED 02597021 GTDLM1 BAL JP,GETDLM -GETDLM 02604021 BCR UNCOND,JQ -EXIT TO DIVISION IN EFFEC 02611021 * 02618021 EJECT 02625021 * 02632021 *=2 ROUTINES FOR CHANGING FROM DIV TO DIV ID ENV DATA 02639021 * 02646021 CWENVD ST JP,SV1F01 SAVE LINK REG 02653021 L JA,COSADR 02660021 MVC DATE-COS(LX12,JA),ZEROCS 02667021 L JQ,ADPRIM ADDR OF PRIME 02674021 LA JA,PARQNM QNMTBL 02681021 BALR JP,JQ PRIME 02688021 LA JA,PARENV ENVTBL 02695021 BALR JP,JQ PRIME 02702021 * LA JA,PARAPP APPTBL 02709021 * BALR JP,JQ PRIME 02716021 LA JA,PARSPN SPNTBL 02723021 BALR JP,JQ PRIME 02730021 LA JA,PARCKP CKPTBL 02737021 BALR JP,JQ PRIME 02744021 LA JA,PARSA SATBL 02751021 BALR JP,JQ PRIME 02758021 LA JA,PARSRA SRATBL 02765021 BALR JP,JQ PRIME 02772021 L JQ,ENVDIV SET BASE REG VALUES 02779021 ST JQ,SVREG+NX56 SAVE NEW VALUE 02786021 L JJ,ENVDV1 ADDR OF APPSCN 02793021 ST JJ,SVREG+NX32 STORE IN SAVE AREA 02800021 ST JQ,LNKR15 SET-UP LINK REG15 AREA 02807021 MVI IDKON,XX40 KILL ID 02814021 L JP,SV1F01 RESTORE LINK REG 02821021 BCR UNCOND,JP -RETURN 02828021 * 02835021 CWDATD ST JP,SV1F01 SAVE LINK REG 02842021 L JQ,ADSTAC 02849021 L JA,ENVCON ENVTBL 02856021 BALR JP,JQ STATIC 02863021 * L JA,APPCON APPTBL 02870021 * BALR JP,JQ STATIC 02877021 L JA,SPNCON SPNTBL 02884021 BALR JP,JQ STATIC 02891021 L JA,CKPCON CKPTBL 02898021 BALR JP,JQ STATIC 02905021 L JQ,ADTREL 02912021 L JA,SACON SATBL 02919021 BALR JP,JQ STATIC 02926021 L JA,SRACON SRATBL 02933021 BALR JP,JQ STATIC 02940021 L JQ,ADPRIM ADDR OF PRIME 02947021 LA JA,PAROD2 OD2TBL 02954021 BALR JP,JQ PRIME 02961021 LA JA,PARPIO PIOTBL 02968021 BALR JP,JQ PRIME 02975021 LA JA,PARFNT FNTBL 02982021 BALR JP,JQ PRIME 02989021 LA JA,PARRCD RCDTBL 02996021 BALR JP,JQ PRIME 03003021 LA JA,PARKEY KEY TABLE 03010021 BALR JP,JQ PRIME 03017021 LA JA,PARIND INDEX TABLE 03024021 BALR JP,JQ PRIME 03031021 LA JA,PARTOT TOTTBL 03038021 BALR JP,JQ PRIME 03045021 L JQ,DATDIV SET BASE REG VAL FOR DATA D 03052021 L JJ,DATDV1 03059021 L JH,DATDV2 03066021 ST JQ,SVREG+NX56 ADJ SAVE REG AREA 03073021 STM JH,JJ,SVREG+NX28 ADJ SAVE REG AREA 03080021 ST JQ,LNKR15 SET-UP LINK REG15 AREA 03087021 MVC DATACD(LX3),DATCON CWT VALUE FOR DATA 03094021 L JP,SV1F01 RESTORE LINK REG 03101021 BCR UNCOND,JP -RETURN 03108021 * 03115021 CWPRCD ST JP,SV1F01 SAVE LINK REG 03122021 TM RPTWSW,XX01 REPORT SECTION 03129021 BC ZERO,NORW NO -CONTINUE 03136021 NI RWLTSW,XXFD SET 'OFF' RWLTSW 03143021 TM FRSTRD,XX40 RD 03150021 BC ZERO,NORL NO CONTINUE 03157021 L JH,DATDV2 03164021 USING DDSCN,JQ 03171021 USING RDSCAN,JJ 03178021 USING FLUSH,JH 03185021 BAL JP,FLUSH FLUSH 03192021 TM GOODRD,XX20 GOOD RD 03199021 BC ZERO,NORL NO 03206021 BAL JP,GNSPRT GEN SPES ROUTS 03213021 DROP JQ 03220021 DROP JJ 03227021 DROP JH 03234021 NORL L JQ,ADTREL ADDR OF TABREL 03241021 L JA,NPTCON NPTTBL 03248021 BALR JP,JQ RELEASE NPTTBL 03255021 L JA,GCNCON RELEASE 03262021 BALR JP,JQ GCNTBL 03269021 L JA,QALCON RELEASE 03276021 BALR JP,JQ QALTBL 03283021 L JA,ROLCON ROLTBL 03290021 BALR JP,JQ RELEASE 03297021 L JA,CTLCON CTLTBL 03304021 BALR JP,JQ RELEASE 03311021 L JA,SUMCON SUMTBL 03318021 BALR JP,JQ RELEASE 03325021 L JA,SRCCON SOURCE TABLE 03332021 BALR JP,JQ RELEASE 03339021 L JA,SMSCON SMSTBL 03346021 BALR JP,JQ RELEASE 03353021 L JA,SNMCON SNMTBL 03360021 BALR JP,JQ RELEASE 03367021 L JQ,ADSTAC 03374021 L JA,RNMCON RNMTBL 03381021 BALR JP,JQ RELEASE 03388021 L JA,RWRCON RWRTBL 03395021 BALR JP,JQ RELEASE 03402021 L JA,ROUCON ROUTBL 03409021 BALR JP,JQ RELEASE 03416021 L JA,DETCON DETTBL 03423021 BALR JP,JQ RELEASE 03430021 NORW L JQ,ADTREL ADDR OF TABREL 03437021 L JA,QNMCON QNMTBL 03444021 BALR JP,JQ RELEASE 03451021 L JA,ENVCON ENVTBL 03458021 BALR JP,JQ RELEASE 03465021 L JA,KYCON KEY TABLE 03472021 BALR JP,JQ RELEASE 03479021 L JA,INDCON INDEX TABLE 03486021 BALR JP,JQ RELEASE 03493021 L JQ,ADSTAC 03500021 L JA,FNTCON FNTBL 03507021 BALR JP,JQ STATIC 03514021 L JA,OD2CON OD2TBL 03521021 BALR JP,JQ STATIC 03528021 L JA,PIOCON PIOTBL 03535021 BALR JP,JQ STATIC 03542021 L JA,RCDCON RCDTBL 03549021 BALR JP,JQ STATIC 03556021 L JA,TOTCON TOTTBL 03563021 BALR JP,JQ STATIC 03570021 L JP,SV1F01 RESTORE LINK REG 03577021 BCR UNCOND,JP -RETURN 03584021 *=1 EQUATES 03591021 * 03598021 ****** DATA AREA FOR PHASE 1 ****** 03605021 * 03612021 * 03619021 *=2 SWITCHES ID ENV DATA PR 03626021 * 03633021 * BIT 0 03640021 * BIT 1 03647021 * BIT 2 03654021 LINKSW DS 0F BIT 3 10 EF 03661021 MSG4SW DS 0F BIT 4 08 F7 03668021 MSG1SW DS 0F BIT 5 04 FB 03675021 NAMDSW DS 0F BIT 6 02 FD 03682021 CFGSW DS 0F BIT 7 01 FE 03689021 SWBYTS DC 5F'0' 20 BYTES FOR SWITCHES 03696021 IOSW EQU SWBYTS+1 BIT 0 03703021 SCHSW EQU SWBYTS+1 BIT 1 03710021 RCMDSW EQU SWBYTS+1 BIT 2 20 DF 03717021 RCDSW EQU SWBYTS+1 BIT 3 03724021 BLKSW EQU SWBYTS+1 BIT 4 03731021 LBLSW EQU SWBYTS+1 BIT 5 03738021 DATASW EQU SWBYTS+1 BIT 6 03745021 RPTSW EQU SWBYTS+1 BIT 7 03752021 FDMSW EQU SWBYTS+2 BIT 0 03759021 QUALSW EQU SWBYTS+2 BIT 1 03766021 INSRSW EQU SWBYTS+2 BIT 2 03773021 OD2SW EQU SWBYTS+2 BIT 3 03780021 DHDRSW EQU SWBYTS+2 BIT 4 08 F7 03787021 PRDSW EQU SWBYTS+2 BIT 5 04 FB 03794021 FSTLHN EQU SWBYTS+2 BIT 6 02 FD 03801021 PLHNSW EQU SWBYTS+2 BIT 7 01 FE 03808021 DSQLSW EQU SWBYTS+3 BIT 0 80 7F 03815021 QLPNSW EQU SWBYTS+3 BIT 1 40 BF 03822021 LCRDSW EQU SWBYTS+3 BIT 2 20 DF 03829021 DEBGSW EQU SWBYTS+3 BIT 3 10 EF 03836021 MSGPSW EQU SWBYTS+3 BIT 4 08 F7 STOPS ERROR MSGS 03843021 REWRSW EQU SWBYTS+3 BIT 5 04 FB 03850021 DATCSW EQU SWBYTS+3 BIT 6 02 FD 03857021 RPTWSW EQU SWBYTS+3 BIT 7 01 FE 03864021 SOCMSW EQU SWBYTS+4 BIT 0 80 7F 03871021 COPYSW EQU SWBYTS+4 BIT 1 40 BF COPY-LIBRARY IN ACTION 03878021 BASISW EQU SWBYTS+4 BIT 2 20 DF IN BASIS LIBRARY 03885021 BGNDSW EQU SWBYTS+4 BIT 3 10 EF BEGIN AND ENDING 03892021 DEBEOS EQU SWBYTS+4 BIT 4 08 F7 STOPS EOSGEN ON DEBUG 03899021 DEBULS EQU SWBYTS+4 BIT 5 04 FB STOPS ULSCAN FOR *DEBU 03906021 FXCDSW EQU SWBYTS+4 BIT 6 02 FD INDICATES 1ST CARD REA 03913021 CPYXSW EQU SWBYTS+4 BIT 7 01 FE COPY STATEMENT FOUND 03920021 INDLSW EQU SWBYTS+5 BIT 0 80 7F LOOK FOR INSERT/DELETE 03927021 INSTSW EQU SWBYTS+5 BIT 1 40 BF CARDS TO BE INSERTED 03934021 INDERR EQU SWBYTS+5 BIT 2 20 DF INS/DEL ERROR MSG WENT 03941021 INOWSW EQU SWBYTS+5 BIT 3 10 EF INSERT IN PROGRESS 03948021 DELSW1 EQU SWBYTS+5 BIT 4 08 F7 DELETE CARD 03955021 DELSW2 EQU SWBYTS+5 BIT 5 04 FB DELETE THRU CARD 03962021 DELSW3 EQU SWBYTS+5 BIT 6 02 FD DELETE THRU IN PROGRES 03969021 CPYCSW EQU SWBYTS+5 BIT 7 01 FE COPY CHECK FROM CUR CE 03976021 SYSISW EQU SWBYTS+6 BIT 0 80 7F SYSIN 03983021 SYSOSW EQU SWBYTS+6 BIT 1 40 BF SYSOUT 03990021 SYSPSW EQU SWBYTS+6 BIT 2 20 DF SYSPUNCH 03997021 SYSCSW EQU SWBYTS+6 BIT 3 10 EF CONSOLE 04004021 DUPMSG EQU SWBYTS+6 BIT 4 08 F7 SP-NAMES DUP MSG 04011021 FD01SW EQU SWBYTS+6 BIT 5 04 FB FD WAS LAST FILE-SCT L 04018021 NOTESW EQU SWBYTS+6 BIT 6 02 FD IN A NOTE IN P.D. 04025021 REDFSW EQU SWBYTS+6 BIT 7 01 FE NOT 1ST TIME THRU LEVE 04032021 NOLHSW EQU SWBYTS+7 BIT 0 80 7F NOT PRECEDED BY LHN-NO 04039021 IOCSW EQU SWBYTS+7 BIT 1 40 BF I-O-CONTROL 04046021 LCDXSW EQU SWBYTS+7 BIT 2 20 DF LAST CARD DURING INS/D 04053021 RPORSW EQU SWBYTS+7 BIT 3 10 EF REPORTS CLAUSE 04060021 DMSGSW EQU SWBYTS+7 BIT 4 08 F7 MSG FOR DELETE CARD 04067021 SELNSW EQU SWBYTS+7 BIT 5 04 FB MSGS FOR SELECT 04074021 RWLTSW EQU SWBYTS+7 BIT 6 02 FD IN RW IN DATA DIV ONLY 04081021 FRGNSW EQU SWBYTS+7 BIT 7 01 FE DECIMAL IS COMMA 04088021 ACCSW EQU SWBYTS+8 BIT 0 80 7F ACCESS 04095021 ORGSW EQU SWBYTS+8 BIT 1 40 BF ORGAN 04102021 RESSW EQU SWBYTS+8 BIT 2 20 DF RESERVE 04109021 FLTSW EQU SWBYTS+8 BIT 3 10 EF FILE-LIMIT 04116021 DUMUSE EQU SWBYTS+8 BIT 4 08 F7 SECTION-NAME FOR USE V 04123021 VALXW EQU SWBYTS+8 BIT 5 04 FB VALUE CLAUSE 04130021 RMULSW EQU SWBYTS+8 BIT 6 02 FD MULTIPLE VALUES 04137021 DDQSW EQU SWBYTS+8 BIT 7 01 FE QUAL NM IN DATA DIV 04144021 TOTUSD EQU SWBYTS+9 BIT 0 80 7F TOTALED SPEC'D 04151021 THRUSW EQU SWBYTS+9 BIT 1 40 BF FILE-LIMITS THRU FOUND 04158021 USEPDL EQU SWBYTS+9 BIT 3 10 EF USE IN PD FOR LABELS 04165021 USEPDE EQU SWBYTS+9 BIT 4 08 F7 USE IN PD FOR ERROR 04172021 SRTSW EQU SWBYTS+9 BIT 5 04 FB SORT SW 04179021 CRSGSW EQU SWBYTS+9 BIT 6 02 FD CURRENCY SIGN SW 04186021 CCWSW EQU SWBYTS+9 BIT 7 01 FE CARR-CTL SPEC-NM 04193021 DPSW EQU SWBYTS+11 BIT 0 80 7F USED FOR OCCURS CL 04200021 ASDESW EQU SWBYTS+11 BIT 1 40 BF 04207021 INDXSW EQU SWBYTS+11 BIT 2 20 DF 04214021 TOSW EQU SWBYTS+11 BIT 3 10 EF 04221021 * CONTINUATION OF DATA AREA FOR PH1A 04228021 REPSW EQU SWBYTS+11 BIT 4 08 F7 REPLACING IN COPY CL 04235021 BYSW EQU SWBYTS+11 BIT 5 04 FB BY IN COPY CLAUSE 04242021 WD1SW EQU SWBYTS+11 BIT 6 02 FD OBJECT OF REPLACE-COPY 04249021 WD2SW EQU SWBYTS+11 BIT 7 01 FE OBJECT OF BY IN COPY 04256021 CDSURP EQU SWBYTS+12 BIT 0 80 7F SURPRESS GTCARD CALL 04263021 BUF2SW EQU SWBYTS+12 BIT 1 40 BF 2 TEMP BUFF FOR COP RE 04270021 BUF3SW EQU SWBYTS+12 BIT 2 20 DF 3 BUF FOR COPY REPLACI 04277021 BUF4SW EQU SWBYTS+12 BIT 3 10 EF MORE THAN 3 WK BUF NEE 04284021 CONTSW EQU SWBYTS+12 BIT 4 08 F7 CONTINUATION ON NXT CD 04291021 CPERSW EQU SWBYTS+12 BIT 5 04 FB NO MEMBER IN COPY LIB 04298021 CPYQSW EQU SWBYTS+12 BIT 6 02 FD COPY IN 01 04305021 REPQSW EQU SWBYTS+12 BIT 7 01 FE QUALIFIED WD REPLACING 04312021 CON2SW EQU SWBYTS+13 BIT 0 80 7F USASIA CONTINUATION 04319021 NWCDSW EQU SWBYTS+13 BIT 1 40 BF CONTINUATION OF WD RTN 04326021 SKCDSW EQU SWBYTS+13 BIT 2 20 DF SKIP CARD GET IN GETWD 04333021 GTRTSW EQU SWBYTS+13 BIT 3 10 EF GETWD CALLED BY GTCD 04340021 LASTSW EQU SWBYTS+13 BIT 4 08 F7 LAST WD PROC FOR COPYR 04347021 CRCDSW EQU SWBYTS+13 BIT 5 04 FB COPY WD NOT ENT RECTBL 04354021 MVLASW EQU SWBYTS+13 BIT 6 02 FD LAST CARD HIT IN COPY 04361021 DBRDSW EQU SWBYTS+13 BIT 7 01 FE DOUBLE BUFFER IN COP R 04368021 CNRDSW EQU SWBYTS+14 BIT 0 80 7F SKIP READ AT END OF CO 04375021 SURPSW EQU SWBYTS+14 BIT 1 40 BF SUPPRESS COPY LIB 04382021 BUF5SW EQU SWBYTS+14 BIT 2 20 DF 4 WK AREA FOR COPYR 04389021 PRIDSW EQU SWBYTS+14 BIT 3 10 EF PROG-ID SWITCH 04396021 * SWBYTS+14 BIT 4 USED IN PH1B 04403021 OCCURNUM EQU SWBYTS+14 BIT 5 04 FB OCCURS CLAUSE IN EFFECT 04410021 CMNTCDSW EQU SWBYTS+14 BIT 6 02 FD DELETING COMMENT CARD 04417021 *REPORT WRITER SWITCHES 04424021 RDSW DC F'0' RESET ON NEW RD 04431021 FRST01 EQU RDSW 80 04438021 RDCLSW EQU RDSW 40 04445021 GOODRD EQU RDSW 20 04452021 CPRDSW EQU RDSW 10 COPY 04459021 PGLMIT EQU RDSW BIT 4 08 INT-1 ONLY 04466021 ROLSW EQU RDSW 04 04473021 SCNDFD EQU RDSW BIT 6 02 2ND FILE-NM SPECIFIED 04480021 SCNDTM EQU RDSW BIT 7 01 2ND TIME THRU SW 04487021 PFSW EQU RDSW+1 80 04494021 PHSW EQU RDSW+1 40 04501021 RHSW EQU RDSW+1 20 04508021 RFSW EQU RDSW+1 10 04515021 CHFSW EQU RDSW+1 O8 04522021 CFFSW EQU RDSW+1 O4 04529021 SCNDWR EQU RDSW+1 BIT 6 02 04536021 CTLSUB EQU RDSW+1 BIT 7 01 INDICATE SUBS CTL-NM 04543021 NOPGHD EQU RDSW+2 BIT 0 80 NO PH ALLOWED 04550021 NOPGFT EQU RDSW+2 BIT 1 40 NO PF ALLOWED 04557021 PGESW EQU RDSW+2 BIT 2 20 PAGE CLAUSE SPECIFIED 04564021 RELABS EQU RDSW+2 BIT 3 10 FLAG BAD ABS LINES 04571021 *** NOTE XFTFNL AND XFTFN2 MUST REMAIN TOGETHER ***************** 04578021 XFTFNL EQU RDSW+2 BIT 4 08 FINAL XFTNG ONLY *** 04585021 XFTFN2 EQU RDSW+2 BIT 5 04 FINAL XFTNG + CTLS *** 04592021 ******************************************************************* 04599021 * BIT 6 02 04606021 * BIT 7 01 04613021 CODSW EQU RDSW+3 BIT 0 80 CODE CLAUSE SPECIFIED 04620021 * BIT 1 40 04627021 * BIT 2 20 04634021 * BIT 3 10 04641021 * BIT 4 08 04648021 * BIT 5 04 04655021 * BIT 6 02 04662021 * BIT 7 01 04669021 RWSWA DC 2F'0' 04676021 SCAN02 EQU RWSWA BIT 0 80 IN PROC02 SCAN 04683021 INDOCT EQU RWSWA BIT 1 40 IN DOCTL ROUTINE 04690021 SCAN01 EQU RWSWA BIT 2 20 IN PROC01 SCAN 04697021 PGHXIT EQU RWSWA BIT 3 10 IN PH EXIT CODE 04704021 INRLSR EQU RWSWA BIT 4 08 IN RLS-ROUT 04711021 FSTLNA EQU RWSWA BIT 5 04 FIRST ABS LINE 04718021 FSTLNR EQU RWSWA BIT 6 02 FIRST RELATIVE LINE 04725021 BADLNA EQU RWSWA BIT 7 01 IGNORE ABS LINE 04732021 COLCLS EQU RWSWA+1 BIT 0 80 COL CLS SPEC IN RPT-GRP 04739021 CTLSW EQU RWSWA+1 1 40 04746021 NGINT EQU RWSWA+1 BIT 2 20 IN NEXT GROUP INTEGER 04753021 NXGPSW EQU RWSWA+1 10 04760021 LNSW EQU RWSWA+1 08 04767021 TPSW EQU RWSWA+1 04 04774021 INTPSW EQU RWSWA+1 02 04781021 USMRSW EQU RWSWA+1 BIT 7 01 IN USM-ROUT 04788021 * NOTE BYTE RNSWA+2 MUST REMAIN TOGETHER AS SPECIFIED 04795021 * INTFSW, INTDSW, INTESW, AND INTHSW MUST REPRESENT 04802021 * BITS 0, 1, 2, AND 7 RESPECTIVELY 04809021 INTFSW EQU RWSWA+2 80 04816021 INTDSW EQU RWSWA+2 40 04823021 INTESW EQU RWSWA+2 20 04830021 DNSW EQU RWSWA+2 10 04837021 LN01SW EQU RWSWA+2 08 04844021 NGPSW EQU RWSWA+2 04 04851021 ELEM01 EQU RWSWA+2 BIT 6 02 ELEMENTARY 01 ITEM 04858021 INTHSW EQU RWSWA+2 BIT 7 01 INT-2 THRU INT-5 04865021 COLSW EQU RWSWA+3 80 04872021 GINSW EQU RWSWA+3 40 04879021 BWZSW EQU RWSWA+3 20 04886021 RSTSW EQU RWSWA+3 10 04893021 PICSW EQU RWSWA+3 08 04900021 SRCSW EQU RWSWA+3 04 04907021 SUMSW EQU RWSWA+3 02 04914021 VALSW EQU RWSWA+3 01 04921021 JUSSW EQU RWSWA+4 80 04928021 LN2SW EQU RWSWA+4 40 04935021 DUP2SW EQU RWSWA+4 20 ERROR IN VAL,PICT 04942021 SUMSW1 EQU RWSWA+4 10 END OF SUMTBL FOR SUMTB1 04949021 SUMSW2 EQU RWSWA+4 08 END OF SUMTBL FOR SUMTB2 04956021 SUMSW3 EQU RWSWA+4 04 ENTRY WAS MADE IN ROLTBL 04963021 SUMSWS EQU RWSWA+4 02 NO SEARCH - S.NAME 04970021 INSBSW EQU RWSWA+4 01 04977021 SRCQSW EQU RWSWA+5 80 04984021 SRCSSW EQU RWSWA+5 40 04991021 SUBSW EQU RWSWA+5 20 04998021 EL01OK EQU RWSWA+5 BIT 3 10 ELEMENTARY 01 OK 05005021 ELEMNN EQU RWSWA+5 BIT 4 08 ELEMENTARY NN ITEM 05012021 VALALL EQU RWSWA+5 BIT 5 04 VALUE ALL SWITCH 05019021 PRSWCF EQU RWSWA+5 BIT 6 02 CF EXIT CODE 05026021 RSETSW EQU RWSWA+5 BIT 7 01 RESET SPECIFIED 05033021 BADGRP EQU RWSWA+6 BIT 0 80 BAD REPORT GROUP SW 05040021 RWSWB DC F'0' RW SWITCHES FOR PROC DIV 05047021 INITSW EQU RWSWB 80 -- 7F 05054021 GENSW1 EQU RWSWB 40 05061021 FRSTRD EQU GENSW1 40 USED AS FIRST RD 05068021 GENSW2 EQU RWSWB 20 05075021 * 05082021 QLRTSW DC X'00' QUALIFIED-NAME ROUTINE SWIT 05089021 AMARSW DC X'00' BIT0-STD WD, 1-BCD NAME, 2-INT-NUM-LIT, O-DECLA 05096021 PICTSW DC X'0' 05103021 SIGNSW DC X'00' 05110021 DECSW DC X'00' MUST FOLLOW SIGNSW 05117021 * 05124021 * 05131021 * SIGNIFICANT NAMES. FIRST BYTE CONTAINS COUNT OF CHARS IN NAME. 05138021 * 05145021 DIVCOD DC X'0F' CODE TO TEST WHICH DIVISION IS IN EFFECT 05152021 DC X'23' 05159021 DIVNM DS CL31 NAME OF CURRENT DIVISION 05166021 DC X'23' 05173021 SECTNM DS CL31 NAME OF CURRENT SECTION 05180021 DC X'23' 05187021 PARNM DS CL31 NAME OF CURRENT PARAGRAPH 05194021 DC X'23' 05201021 CLSNM DS CL31 NAME OF CURRENT CLAUSE 05208021 DC X'23' 05215021 VERBNM DS CL31 NAME OF CURRENT VERB 05222021 * 05229021 HSKP1 DC A(IDDIV1) ***MUST BE IN PH1SAV USING*** 05236021 ADPB12 DC A(PBEG12) 05243021 *=2 COMMON WORK AREA SPACE 05250021 * 05257021 ICTEXT DC H'3' CONSTANT OF '0003' 05264021 DS CL230 05271021 * 05278021 *=2 FS TEXT BUILD AREA ENV 05285021 * 05292021 FSCONS EQU ICTEXT+1 1 IC-TEXT LEVEL CODE 05299021 FSN EQU ICTEXT+2 1 SIZE OF FS-TEXT 05306021 FSLEV EQU ICTEXT+3 1 LEVEL NUMBER FD 05313021 * 05320021 FSEGSN EQU ICTEXT+4 2 GEN CARD NUMBER 05327021 FSEEXT EQU ICTEXT+6 7 EXTERNAL NAME 05334021 FSEEXB EQU ICTEXT+12 1 BLANK IF SYSNNN IS FSEEXT 05341021 FSESYS EQU ICTEXT+13 1 SYS NUMBER 05348021 FSEACC EQU ICTEXT+14 10 1 80 ACCESS 0-SEQ,1-RAN 05355021 FSEORG EQU ICTEXT+14 3 70 ORGAN 0-SEQ,1-IND,2-DIR,4- 05362021 FSEDCL EQU ICTEXT+14 3 0E DEV-CL 1-DIR,2-U.R,4- 05369021 FSERVS EQU ICTEXT+14 1 01 RESERVE 05376021 FSEOPT EQU ICTEXT+15 1 80 SELECT OPTIONAL-DOS 05383021 FSESMS EQU ICTEXT+15 1 40 SAME AREA SW 05390021 FSEESS EQU ICTEXT+15 1 20 EXTENDED SEARCH SW 05397021 FSESRS EQU ICTEXT+15 1 10 SAME REC AREA SW 05404021 FSESSS EQU ICTEXT+15 1 08 SAME SORT AREA SW 05411021 FSECHP EQU ICTEXT+15 1 04 CKPTBL SW 05418021 FSEPIO EQU ICTEXT+15 1 02 PIOTBL SW 05425021 FSEAPP EQU ICTEXT+15 1 01 RANDOM PROCESSING 05432021 FSEDVC EQU ICTEXT+16 DEVICE NUMBER CODE 05439021 FSEAPT EQU ICTEXT+16 12 2 APPTBL PTR 05446021 FSEPIT EQU ICTEXT+18 14 2 PIOTBL PTR 05453021 FSERES EQU ICTEXT+20 16 1 RESERVE BIN-NUM 05460021 FSEDUM EQU ICTEXT+21 17 1 DUMMY-BYTE 05467021 FSETLM EQU ICTEXT+22 18 2 TRACK-LIMIT BIN NUM-OS 05474021 FSEESH EQU ICTEXT+24 20 2 EXTENDED-SEARCH BIN NUM-OS 05481021 FSECPT EQU ICTEXT+26 22 2 CKPTBL PTR 05488021 FSESAM EQU ICTEXT+28 24 1 SAME BIN-NUM 05495021 FSETKA EQU ICTEXT+29 25 2 C0 TRK-AR SW 1-DNM,2-INT 05502021 * 1 UNUSED 05509021 FSENOM EQU ICTEXT+29 1 10 NOMKEY SW 05516021 FSEACT EQU ICTEXT+29 1 08 ACTKEY SW 05523021 FSEREC EQU ICTEXT+29 1 04 RECKEY SW 05530021 FSEWRT EQU ICTEXT+29 1 02 WRONLY SW 05537021 FSERPT EQU ICTEXT+29 1 01 RECPRT SW 05544021 FSEWRV EQU ICTEXT+30 26 1 80 WRITE VERIFY SW 05551021 FSECOS EQU ICTEXT+30 1 40 CYL OVERFLOW SW 05558021 FSEMFT EQU ICTEXT+30 1 08 MULTIPLE FILE TAPE SW 05565021 FSEMSI EQU ICTEXT+30 1 04 MASTER INDEX SW 05572021 FSECYI EQU ICTEXT+30 1 02 CYL-INDEX 05579021 FSEROS EQU ICTEXT+30 1 01 RECORD OVERFLOW SW-OS 05586021 FSESWU EQU ICTEXT+31 27 4 FO NO OF SORT WORK UNITS 05593021 FSEICI EQU ICTEXT+31 1 08 CORE-INDEX 05600021 FSEREO EQU ICTEXT+31 1 04 REORG-CRITERIA 05607021 * 2 UNUSED BITS 05614021 FSESRA EQU ICTEXT+32 28 1 SAME RECORD AREA BIN NUM 05621021 FSEPIN EQU ICTEXT+33 29 1 POSITION INTEGER 05628021 FSECOT EQU ICTEXT+34 30 1 CYL OVERFLOW TRACKS-DOS 05635021 FSEDTC EQU ICTEXT+35 31 1 DEVICE TYPE CODE-DOS 05642021 FSEDHI EQU ICTEXT+36 32 1 DEVICE OF HIGHEST INDEX-DOS 05649021 FSESOT EQU ICTEXT+37 33 1 SAME SORT AREA-BIN NUM 05656021 FSEFN EQU ICTEXT+38 34 32 FILENAME 05663021 FSETAN EQU ICTEXT+70 66 4 TRK-AR SIZE PTR 05670021 FSENMK EQU ICTEXT+74 70 4 NOMKEY SIZE PTR 05677021 FSEACK EQU ICTEXT+78 74 4 ACTKEY SIZE PTR 05684021 FSERCK EQU ICTEXT+82 78 4 RECKEY SIZE PTR 05691021 FSEDCI EQU ICTEXT+86 82 4 DN FROM APPLY CYLINDEX SIZE 05698021 FSERED EQU ICTEXT+86 82 4 DN FOR APP REORG-CRIT 05705021 * 05712021 *=2 FS TEXT BUILD AREA FD DATA 05719021 * 05726021 FSDCPY EQU ICTEXT+21 1 80 COPY SW 05733021 FSDBCC EQU ICTEXT+21 2 18 BLOCK 1-REC,2-CHR 05740021 FSDLRD EQU ICTEXT+21 2 06 LABEL 1-STD,2-OMT,3-DNM 05747021 FSDRPT EQU ICTEXT+21 1 01 REPORTS 05754021 FSDBLC EQU ICTEXT+22 2 BLOCK-CONT BIN-NUM 05761021 FSDRC1 EQU ICTEXT+24 2 RECORD-CONT-1 BIN-NUM 05768021 FSDRC2 EQU ICTEXT+26 2 RECORD-CONT-2 BIN-NUM 05775021 FSDBLM EQU ICTEXT+44 2 BLOCK CONTAINS MAX CT BIN-NU 05782021 FSDTOG EQU ICTEXT+46 1 TOTALING AREA 05789021 FSDTOD EQU ICTEXT+46 1 TOTALED AREA 05796021 FSDRCM EQU ICTEXT+46 4 MODE 20-F 10-V 08-U 04-S 00- 05803021 FSDTDN EQU ICTEXT+90 4 TOTALING AR DN SIZE/PTR 05810021 FSDLRC EQU ICTEXT+102 4 LAB-REC SIZE/PTR 05817021 FSDFN EQU ICTEXT+47 05824021 FSDDN EQU ICTEXT+78 DN PTR/SIZE FROM ENVTBL 05831021 * 05838021 FSTXT0 EQU FSCONS * THESE EQU'S * 05845021 FSTXT1 EQU FSEGSN ARE USED 05852021 FSTXT2 EQU FSEDUM FOR PUT OF 05859021 FSTXT3 EQU FSESAM CONSTANT FSTEXT AREA 05866021 FSTXT4 EQU ICTEXT+47 05873021 FSENGT EQU FSEDCI+4-FSEEXT 05880021 * 05887021 *=2 FS TEXT BUILD AREA SA + SD DATA 05894021 * 05901021 SADCON DC X'0331' LEVEL CODE AND SIZE 05908021 * 05915021 SADCOD EQU ICTEXT+6 2 LEVEL-CODE AND LENGTH 05922021 SADLEV EQU ICTEXT+8 1 LEVEL-NUM 05929021 SADSWU EQU ICTEXT+9 4 NO OF SORT WORK UNITS 05936021 SADLBR EQU ICTEXT+9 2 LABEL RECDS 01-STAND 10-OMI 05943021 SADSRS EQU ICTEXT+9 1 SAME REC SW 05950021 SADSTS EQU ICTEXT+9 1 SAME SORT SW 05957021 SADGCN EQU ICTEXT+10 20 GEN-CARD-NUM 05964021 SADNM1 EQU ICTEXT+12 20 1ST INT 05971021 SADNM2 EQU ICTEXT+14 20 2ND INT 05978021 SADDVC EQU ICTEXT+16 3 DEVICE CLASS 05985021 SADMOD EQU ICTEXT+16 4 REC MODE 05992021 * 1 UNUSED 05999021 SADSRA EQU ICTEXT+17 1 SAME REC NO 06006021 SADEXN EQU ICTEXT+18 8 EXTERNAL NAME 06013021 SADBCD EQU ICTEXT+26 31 BCD NAME 06020021 * 06027021 *=2 LD TEXT BUILD AREA 01-49,77,88 DATA 06034021 * 06041021 LDCONS EQU ICTEXT+1 1 06048021 LDN EQU ICTEXT+2 1 06055021 LDLEV EQU ICTEXT+3 1 06062021 LDCDN EQU ICTEXT+4 2 06069021 LBZ EQU ICTEXT+6 1 06076021 LOD1 EQU ICTEXT+7 6 06083021 LRNS EQU ICTEXT+7 1 RENAMES 06090021 LSYN EQU ICTEXT+7 1 SYNCHRONIZED 06097021 LOH EQU ICTEXT+8 2 06104021 LSLR EQU ICTEXT+10 1 0 IS LEFT, 1 IS RIGHT 06111021 LRNT EQU ICTEXT+10 1 RENAMES THRU 06118021 LOCCRS EQU ICTEXT+10 1 ENTRY BYTE9/BIT5 OCCURS 47955 06125021 LNIND EQU ICTEXT+11 1 NO OF INDEXES 06132021 LNKEY EQU ICTEXT+12 1 NO OF KEYS 06139021 LD EQU ICTEXT+13 31 DATANAME 06146021 LP2 EQU ICTEXT+44 31 PICTURE 06153021 LV2 EQU ICTEXT+75 121 VALUE 06160021 LR2 EQU ICTEXT+196 31 REDEFINES 06167021 LOD2 EQU ICTEXT+227 2 PTR TO OD2TBL OR INTERNAL R 06174021 LDLNGT EQU LOD2+2-LDN 06181021 SDLNGT EQU SADBCD+31-SADSWU 06188021 * 06195021 *=2 E-TEXT MESSAGE PARAM ID ENV DATA PR 06202021 * 06209021 MSGDEF DC X'000600' MESSAGE DEFINITION 06216021 MSGNUM DC X'0000' MSG NUMBER 06223021 MSGGCN DC X'0000' GEN SEQ NUMBER 06230021 MSGSP DC X'01' SEVERITY - PHASE NUMBER 06237021 EPARNN DC X'0000' E-TEXT PARAM 06244021 EPARAM DC X'0000' -PARAM 06251021 DS CL120 CONTINUED 06258021 SECPAR DC 2XL16'0' SECOND PARAM 06265021 ENFSDS DSECT 06272021 ENFGSN DS 2X GENERATED CARD NO 06279021 ENFEXT DS 7X EXTERNAL NAME 06286021 ENFSYS DS 1X SYS NO 06293021 ENFFL1 DS 1X FLAG1 06300021 ENFACC EQU X'80' ACCESS 06307021 ENFORG EQU X'70' ORGAN 06314021 ENFDCL EQU X'0E' DEV-CL 06321021 ENFRVS EQU X'01' RESERVE 06328021 ENFFL2 DS 1X FLAG2 06335021 ENFOPT EQU X'80' OPTIONAL 06342021 ENFSMS EQU X'40' SAME AREA 06349021 ENFESS EQU X'20' EXTENDED SEARCH 06356021 ENFSRS EQU X'10' SAME REC AREA SW 06363021 ENFSSS EQU X'08' SAME SORT AREA SW 06370021 ENFCHP EQU X'04' CKPTBL 06377021 ENFPIO EQU X'02' PIOTBL 06384021 ENFAPP EQU X'01' RANDOM PROCESSING 06391021 ENFAPT DS 2X APPTBL PTR 06398021 ENFPIT DS 2X PIOTBL PTR 06405021 ENFRES DS 1X RESERVE NO 06412021 ENFDUM DS 1X DUMMY BYTE 06419021 ENFTLM DS 2X TRACKLIMIT NUM 06426021 ENFESH DS 2X EXT-SEARCH NUM 06433021 ENFCPT DS 2X CKPTBL 06440021 ENFSAM DS 1X SAM NUM 06447021 ENFFL3 DS 1X 06454021 ENFTKA EQU X'C0' TRK-AREA 06461021 * 06468021 ENFNOM EQU X'10' NOMINAL KEY 06475021 ENFACT EQU X'08' ACTUAL KEY 06482021 ENFREC EQU X'04' RECORD KEY 06489021 ENFWRT EQU X'02' WRITE ONLY 06496021 ENFRPT EQU X'01' RECORD PROTECT 06503021 ENFFL4 DS 1X FLAG 4 06510021 ENFWRV EQU X'80' WRITE VERIFY 06517021 ENFCOS EQU X'40' CYL OVERFLOW 06524021 ENFSRM EQU X'30' TO TEST BOTH SAMES 06531021 ENFMFT EQU X'08' MULTIPLE FILE TAPE 06538021 ENFMSI EQU X'04' MASTERINDEX 06545021 ENFCYI EQU X'02' CYL-INDEX 06552021 ENFROS EQU X'01' RECORD OVERFLOW 06559021 ENFFL5 DS 1X FLAG5 06566021 ENFSWU EQU X'F0' NO OF SORT WORK UNITS 06573021 ENFICI EQU X'08' CORE-INDEX 06580021 ENFREO EQU X'04' REORG-CRITERIA 06587021 * 06594021 ENFSRA DS 1X SAME RECORD AREA 06601021 ENFPIN DS 1X POSITION INTEGER 06608021 ENFCOT DS 1X CYL OVERFLOW TRACKS 06615021 ENFDTC DS 1X DEVICE TYPE CODE 06622021 ENFDHI DS 1X DEVICE OF HIGHEST INDEX 06629021 ENFSOT DS 1X SAME SORT AREA 06636021 ENFFN DS 32X FILENAME 06643021 ENFTAN DS 4X TRACK-AREA SIZE PTR 06650021 ENFNMK DS 4X NOMKEY SIZE PTR 06657021 ENFACK DS 4X ACKKEY SIZE PTR 06664021 ENFRCK DS 4X RECKEY SIZE PTR 06671021 ENFDCI DS 4X DN FROM APP CYL-IND SIZE PT 06678021 ENFRED EQU ENFDCI DN FOR APP REORG-CRIT 06685021 EJECT 06692021 IKF101 CSECT 06699021 ********** 06706021 * 06713021 *=2 INPUT-RECORD WORK AREA FOR LISTING 06720021 * 06727021 COMWK2 DS CL80 DOUBLE BUF AREA IN COP REPL 06734021 INCRONE DC X'0000001C' 06741021 SVCINC DC X'001C' FOR GCN 06748021 DS 0D ALIGN OF SVCPCK FOLLOWING 06755021 SVCPCK DC X'000000000000000C' DW FOR PACK OF GCN 06762021 SVCUPK DC D'0' DW FOR UNPACK OF GCN 06769021 SVCGCN EQU SVCUPK+3 START OF 5 DIGIT GCN 06776021 SVCTYP DC X'404040' 3 BLANKS BETWEEN NUMBERS 06783021 SVCCRD DC 5CL16' ' START OF 80 CHAR RECORD 06790021 COMMOV EQU SVCTYP+1 06797021 COMWRK EQU SVCTYP+3 06804021 SVCERR DC C'*ERROR NO.' ERROR MESSAGE NUMBER 06811021 DC C' , *' STATMENT CLAUSE 06818021 SVCSEQ DC XL6'00' SAVED SEQ NUMBER 06825021 UBLNK DC C' ' 16 BLANKS 06832021 TWOTRE DC X'4040' SAVE AREA TO RESTORE PRINT 06839021 * 06846021 *=2 SPECIAL-NAMES TABLE WORK AREA ENV 06853021 * 06860021 SPNWRK DS CL34 WORK AREA FOR 06867021 SPNNAM EQU SPNWRK+3 SPECIAL-NAMES TABLE ENTRY 06874021 * 06881021 *=2 APPLY TABLE ENTRY WORK AREA ENV 06888021 * 06895021 *APWTBL DS 0F APPLY WORK AREA 06902021 *APWRPD DC H'0' RPD NUMBER 06909021 *APWCYL DC X'0005' CONSTANT OFR 5 CYCLES 06916021 *APWSN DS CL31 SECTION NAME /N/BCD-SN-30BLK 06923021 *APWSAN DS CL31 SAVE-AREA NAME /N/BCD-SAN-30 06930021 * 06937021 *=2 FNTBL WORK AREA DATA 06944021 * 06951021 DS 0H 06958021 FNWA DC XL17'0' 00000000000000000 FIELD LENGTH 06965021 FNWFN DS CL32 N'1' FN '30' 06972021 FNPIOT EQU 0 PIOTBL PTR 06979021 FNRPDN EQU 2 RPD NO 06986021 FNAPPT EQU 4 APPTBL PTR 06993021 FNGNSE EQU 6 GN FOR STANDARD ERROR 07000021 FNGNHL EQU 8 GN FOR HEADER LABELS 07007021 FNGNTL EQU 10 GN FOR TRAILER LABELS 07014021 FNGNEV EQU 12 GN FOR END OF VOLUME LABELS 07021021 FNGNBV EQU 14 GN FOR BEG.OF VOLUME LABELS 07028021 FNFLG1 EQU FNWA+16 07035021 FNFL1 EQU 16 FLAG1 07042021 FNACR EQU X'80' 1 ACCESS RANDOM 07049021 FNMSF EQU X'40' 1 MASS STORAGE FILE 07056021 FNLRS EQU X'20' 1 LABEL RECORDS STANDARD 07063021 FNLRO EQU X'10' 1 LABEL RECORDS OMITTED 07070021 FNBEF EQU X'08' 1 BEFORE IN USE 07077021 FNAFT EQU X'04' 1 AFTER IN USE 07084021 FNRDP EQU X'02' 1 RECORD PROTECT 07091021 FNPMR EQU X'01' 1 PROC MODE RANDOM 07098021 FNWFND EQU 17 07105021 ENVSIZ EQU 86 07112021 FNSIZ EQU 48 SIZE OF FNTBL 07119021 * 07126021 LDMUL DS CL1 WORK AREA FOR MULT VALUE LD 07133021 LDMULV DS CL121 PRINT AREA 07140021 ****** 07147021 ********* 07154021 *=2 RCDTBL WORK AREA DATA 07161021 RNWA DC XL4'0' /FNTBL-PTR-2/N-1/BCD-NAME-31ZEROES/ 07168021 DS CL30 PRINT AREA 07175021 *=2 TOTTBL WORK AREA DATA 07182021 ***** 07189021 TOTCOT DC H'2' POINTER TO TOTAL COUNT 07196021 TOTCT EQU TOTCOT+1 07203021 TOTPTR DS 1H PTR TO FNTBL ENTRY 07210021 TOTDA DS 31C TOTALED DATANAME 07217021 ***** PROCEDURE NAME WORK AREA FOR ENTRY TO'PNTABL OR PNQTBL' * 07224021 ********** OR QUALIFIED NAME WORK AREA FOR ENTRY TO QLTABL 07231021 PNBC DC F'0' TOTAL COUNT EQUAL TO '0002' 07238021 PNBCT EQU PNBC+3 TOTAL COUNT 07245021 PNBCDN DC 8F'0' * BCD NAME //N/NAME// 07252021 PNCHAR DC H'0' * S,T,P,A,G,E,-,- * B,U,X,D,K,L,M, 07259021 * B-REF*D U-DEF*D X-DUMM D-DECL K-ERR L-LAB M-RAND N-RE 07266021 PNOLD DC X'00' NEW/OLD CODE 07273021 PNQLCD DC X'22' QUALIFIER CODE 07280021 PNBCDQ DC 8F'0' * BCD NAME QUALIFIER //N/NA 07287021 PNBCNN DC AL3(PNBCDN) ADDR OF PN BCD 07294021 PNBCQN DC AL3(PNBCDQ) ADDR OF QUALIFIER BCD 07301021 CRDGCN DC X'810000' GCN TEXT FOR FILE 2 07308021 EJECT 07315021 * 07322021 *=1 COMMON WORK AND SAVE AREAS ID ENV DATA PR 07329021 * 07336021 SVREG DS 15F LINK REG SAVE 07343021 SAVREG DS 15F ULSCN ROUTINE REG SAVE 07350021 SV1F01 DS F LINK REG SAVE 07357021 SV1F02 DS F LINK REG SAVE 07364021 SV1F03 DS F LINK REG SAVE 07371021 SV4F04 DS 4F LINK REG SAVE 07378021 SV1F11 DS F LINK REG SAVE 07385021 SV3F12 DS 3F LINK REG SAVE 07392021 SV1F15 DS F LINK REG SAVE 07399021 SV1F16 DS F SAVE JP SAVE AREA 07406021 JPSAVE DS F SAVE XR JP FOR ROUTS USED B 07413021 JPNGPS DS F NX GP ROUT SAVE AREA 07420021 JPNPTS DS F N. ROUT SAVE JP 07427021 JPNOPS DS F SAVE JP NOP ROUT 07434021 JPCTGS DS F SAVE JP IN GETCTL ROUTINE 07441021 JPSAV1 DS F SAVE JP SAVE AREA 1 07448021 JPSAV2 DS F SAVE JP SAVE AREA 2 07455021 JPHDSV DS F SAVE JP HDR ROUTINE 07462021 JPLNSV DS F SAVE JP LINE ROUTINE 07469021 JDSAV1 DS F SAVE XR4 07476021 JPN02S DS F SAVE JP END OF 02 07483021 JPCTSV DS F SAVE JP CTL CLAUSE 07490021 JPIFLC DS F SAVE JP FILE LENGTH CTR 07497021 SAVEJQ DS F SAVE JP REG 07504021 JPSPRT DS F SAVE JP SPEC NAMES RTN 07511021 JPSUBS DS F SAVE JP SUBROUTINES 07518021 JPIFNT DS F SAVE JP FILE NAMES 07525021 SV1REG DS F SAVE AREA FOR 1 REGISTER 9015 07532021 * COMMON WORK AREAS CON'T 07539021 JPMUSV DS F SAVE FOR MULT VALUES 07546021 PUTNSV DS F RW PUTN JP SAVE AREA 07553021 LASTWD DS XL68'0' SAVE AREA FOR LASTWD ON CARD9610 07560021 SVRPRG DS F ADDR OF COPYWD IN BUFFER 07567021 CPYSAV DS 8F COP RTN SAVE AREA 07574021 * 07581021 * 07588021 SVREAD DS F LINK REG SAVE FOR (READI) 07595021 * 07602021 VALNLT DC D'0' DOUBLEWORD SAVE FOR VAL NUM 07609021 GDLWKA DS D DOUBLEWORD WORK AREA GETDLM 07616021 WORKDA DC D'0' DOUBLEWORD WORK AREA 'A' 07623021 REGWOK DC F'0' FULLWORD REGISTER WORK AREA 07630021 REGWEK DC F'0' FOR FLT-PT-RTN 07637021 WORKFB DC F'0' WORKFB SAVE AREA 07644021 WORKHC DC H'0' WORKHC SAVE AREA 07651021 SMPNT DC H'0000' POINTER TO SAME TBLS 07658021 SMTEMP DC X'00' TEMP AREA 07665021 SMCT DC X'00' CT OF FILES IN SAME CLAUSE 07672021 SMCDNO DC X'0000' CARDNO OF SAME CLAUSE 07679021 SMTIB DS F SMTIB SAVE AREA 07686021 SRADIS DS F SRADIS SAVE AREA 07693021 SADISP DS F SAVE AREA FOR DISPLAY 07700021 YESNO DC X'00' SWITCH FOR DATANAME 07707021 * 07714021 ETYPE DS CL10 16--BYTE WORK AREA 07721021 SMECTR DC X'00' SAME COUNTER 07728021 APTRSV DS F APPSCN SAVE SIZE AND ADDRES 07735021 RPOSAV DC F'0' POINTER-SIZE OF SAVED RPT-N 07742021 SCHPTR DC F'0' SIZE + PTR OF SCHENV 'FIND' 07749021 * * * CONSTANTS * * * 07756021 SVCALP DS F SVC WORK AREA 07763021 ADPROM DC A(PRONAQ) PROGRAM ADCON 07770021 DNSW1 DC X'00' DATANAME SW 07777021 FSTRC EQU DNSW1 BIT0 IS ON IF RWRTB IS PRM 07784021 * DNSW1 BIT 6 ON IF NO CONTROLS CLAUSE SPECIFIED 07791021 * DNSW1 BIT 7 ON FOR DATANAME IN SUM CLAUSE 07798021 DNMSW EQU DNSW1 BIT 1 40 DATA NAME ON 01 LVL 07805021 EOPPHX DC X'00' END-OF-PAGE SW 07812021 TEMPSW DC 3X'00' TEMP SW 07819021 BASISK DC CL6'BASIS ' BASIS LIBRARY CALL-NAME 0335 07826021 PIOSIZ EQU 3 07833021 ABSADD DC F'0' TAMER ABSOLUTE ADDRESS SAVE 07840021 SAVSIZ DC H'0' SIZE OF LAST TAMER ENTRY 07847021 PONTER DC H'0' POINTER OF LAST TAMER ENTRY 07854021 SCHSAV DC H'0' SAVE ADJ FACTOR FOR SEARCH 07861021 USEFL1 DS 1X USEFLAG 07868021 WORKR1 DC X'031C01' 01 FOR 1 OF 4 07875021 WORKR2 DC X'000000200000000000' REPORT 2 OF 4 07882021 WORKR3 DC X'050000000000' CLAUSE 3 OF 4 07889021 WORKR4 DC X'08E74D00000000005D000000' IN FD 4 OF 4 07896021 RWK133 DC X'F0F0F1F3F3' DEFAULT 01 SIZE FOR REPORT 07903021 RWB133 DC X'0085' BINARY EQUIVALENT FOR 133 07910021 DECSIZ DC X'00000100' COMMUNICATION AREA 1 07917021 TOTSIZ EQU DECSIZ+1 FOR FLOATING- 2 07924021 FLPWK DS CL22 POINT ROUTINE 3 07931021 LNKR15 DS F STORE AREA FOR LINK REG15 07938021 R1442 EQU 1 07945021 PRNT EQU 1 07952021 R2520 EQU 3 07959021 R2540 EQU 5 07966021 X2501 EQU 7 07973021 X1403 EQU 8 07980021 X1404 EQU 9 07987021 X1443 EQU 10 07994021 X1445 EQU 11 08001021 X2301 EQU 15 08008021 X2302 EQU 16 08015021 X2303 EQU 17 08022021 X2311 EQU 18 08029021 X2311E EQU 19 08036021 X2314 EQU 20 08043021 X2321 EQU 21 08050021 X2400 EQU 22 08057021 EJECT 08064021 INTCNT DS H INTERNAL COUNT AREA 08071021 DECCNT DS H DECIMAL COUNT AREA 08078021 UNPWRK DS CL3 UNPACK WORK AREA 08085021 UNPSUB DS CL15 UNPACK SUBTRACT AREA 08092021 UNPEND DS CL1 UNPACK END AREA 08099021 PAKWRK DS CL2 UNPACK END AREA 08106021 PAKSUB DS CL8 UNPACK SUBTRACT AREA 08113021 PAKEND DS CL1 PACK AREA 08120021 WRK2 DS CL2 2-BYTE WORK AREA 08127021 WRK3 DS CL3 3-BYTE WORK AREA 08134021 SAVER8 DS F REG-8 SAVE AREA 08141021 RSAVE2 DS F REG 2 SAVEAREA 47955 08148021 * 08155021 ALREF DC X'3401' ALPHA LITERAL OF LENGTH OF O 08162021 EJECT 08169021 *=1 ERROR MESSAGES 08176021 * 08183021 * ERROR MSG NUMBER TABLE 08190021 DS 0F START MSGS ON FULL WORD 08197021 * 08204021 *=E 1 NUM-LIT NOT RECOG AS LEV-NUM,BECAUSE '-' ILLEGAL AS USE 08211021 MSG1 BAL JQ,PARMN WRITE ERR MSG 08218021 *=E 02 02 '-' SECTION HEADER MISSING. ASSUMED PRESENT. 08225021 MSG2 BAL JQ,PARM2 WRITE ERR MSG 08232021 *=E 03 03 '-' PARAGRAPH NAME MISSING. ASSUMED PRESENT. 08239021 MSG3 BAL JQ,PARM3 WRITE ERR MSG 08246021 *=E 04 INVALID WORD '-'. SKIP TO NEXT LEVEL, SECTION, DIVISION 08253021 MSG4 BAL JQ,PARMC WRITE ERR MSG 08260021 *=E 05 05 INVALID ORDER IN ENVIRONMENT DIV. SKIPPING TO NEXT DIV. 08267021 MSG5 BAL JQ,WRTMSG WRITE ERR MSG 08274021 DS F 55881 08281021 *=E 7 '--' NOT PRECEDED BY A SPACE. ASSUME SPACE. 08288021 MSG7 BAL JQ,PARMN WRITE ERR MSG 08295021 *=E 8 RIGHT PAREN SHOULD NOT BE PRECEDED BY A SPACE. 08302021 MSG8 BAL JQ,WRNMSG WRITE ERR MSG 08309021 FINDSV DC F'0' DELETE CARD POINTER SAVE 08316021 *=E 10 LEFT PAREN SHOULD NOT BE FOLLOWED BY A SPACE. 08323021 MSG10 BAL JQ,WRNMSG WRITE ERR MSG 08330021 *=E 11 RECORDING MODE SPECIFICATION IS INVALID. ASSUMED VARIAB 08337021 MSG11 BAL JQ,WRTMSG WRITE ERR MSG 08344021 *=E 0C 12 FILE-NAME NOT UNIQUE. USING FIRST DEFINITION OF FILE-NA 08351021 MSG12 BAL JQ,WRTMSG WRITE ERR MSG 08358021 *=E 0D 13 CHARACTER LENGTH IN SPECIAL-NAMES SHOULD ONE. 08365021 MSG13 BAL JQ,WRTMSG WRITE ERR MSG 08372021 *=E 0E 14 FILE NOT PRESENT IN MULTIPLE FILE CLAUSE. ASSUMED 08379021 *=E PRESENT. 08386021 MSG14 BAL JQ,WRTMSG WRITE ERR MSG 08393021 *=E 0F 15 EXTERNAL NAME '-' IN PROGRAM-ID,LIBRARY REFERENCE 08400021 *=E OR SYSTEM-NAME INVALID. EXTERNAL NAME IGNORED. 08407021 MSG15 BAL JQ,PARMC WRITE ERR MSG 08414021 *=E 10 16 MORE THAN ONE '-' CLAUSE. SKIPPING TO NEXT CLAUSE. 08421021 MSG16 BAL JQ,PARM4 WRITE ERR MSG 08428021 *=E 11 17 INVALID WORD IN '-' CLAUSE. SKIPPING TO NEXT CLAUSE. 08435021 MSG17 BAL JQ,PARM1C WRITE ERR MSG 08442021 *=E 12 18 COPY LIBRARY NOT FOUND/NOLIBR IN EFFECT 08449021 MSG18 BAL JQ,WRTMSG WRITE ERR MSG 08456021 *=E 13 19 COPY CLAUSE IGNORED DUE TO NO LIBRARY NAME. 08463021 MSG19 BAL JQ,WRTMSG WRITE ERR MSG 08470021 GDLRSV DS 3F GET DELIM 3 REG SAVE AREA 08477021 QUOTSV DS 2F SAVE REGS FOR QUOTE(GETWD) 08484021 *=E 19 25 REDEFINES CLS NOT 1ST CLS FOLLOWING DATA-NM. ASSUMED 1S 08491021 MSG25 BAL JQ,WRTMSG WRITE ERR MSG 08498021 *=E 26 TOTALED AND TOTALING AREA MUST BOTH BE SPEC'D FOR FILE 08505021 MSG26 BAL JQ,WRTMSG WRITE ERR MSG 08512021 GETCSV DS F SAVE LINK REG FOR GETCRD 08519021 *=E 1C 28 '-' SENTENCE IMPROPERLY WRITTEN. SENTENCE IGNORED. 08526021 MSG28 BAL JQ,PARM5 WRITE ERR MSG 08533021 *=E 1D 29 '-' IN '-' SENTENCE NOT DEFINED AS FILE-NAME. NAME IGNO 08540021 MSG29 BAL JQ,PARM6C WRITE ERR MSG 08547021 *=E 30 '-' IN '-' SENTENCE IS INVALID AS USED.SKIP NXT CL SCT 08554021 MSG30 BAL JQ,PARM6C WRITE ERR MSG 08561021 NBLPTR DS F ADDR OF GETWD WORD IN BUFFER 08568021 SKCTAD DS F ADDR PAST CONTINUATION 08575021 *=E 33 FILENAME ALREADY ASSIGNED THIS SAME CLAUSE OPTION USE 08582021 MSG33 BAL JQ,PARMC WRITE ERR MSG 08589021 *=E 22 34 '-' CLAUSE IN '-' LEVEL IS TREATED AS COMMENTS IN OS. 08596021 *=E NEXT CLAUSE. 08603021 MSG34 BAL JQ,PARM6C WRITE ERR MSG 08610021 *=E 23 35 INTEGER NOT FOUND FOLLOWING POSITION IN MULTIPLE FILE 08617021 *=E CLAUSE. POSITION OF FILE NAME IN CLAUSE ASSUMED. 08624021 MSG35 BAL JP,WRTMSG WRITE ERR MSG 08631021 *=E 24 36 QUALIFIED NAME FOLLOWING LEVEL NO. INVALID.USING LOW NA 08638021 MSG36 BAL JQ,WRTMSG WRITE ERR MSG 08645021 *=E 25 37 '-' INVALID IN DATA DESCRIPTION. NEXT CLAUSE. 08652021 MSG37 BAL JQ,PARMC WRITE ERR MSG 08659021 *=E 26 38 '-' INVALID FOLLOWING LEVEL NO. NEXT LEVEL. 08666021 MSG38 BAL JQ,PARMC WRITE ERR MSG 08673021 *=E 27 39 DATA-NAME IN '-' CLAUSE SHOULD BE UNQUAL. USING LOW NAM 08680021 MSG39 BAL JQ,PARM4 WRITE ERR MSG 08687021 *=E 28 40 IMPROPER LEVEL NO. FOR FILE-SECTION. 08694021 MSG40 BAL JQ,WRTMSG WRITE ERR MSG 08701021 *=E 29 41 '-' INVALID IN '-' SECTION. NEXT LEVEL, SECTION, DIVISI 08708021 MSG41 BAL JQ,PARM7C WRITE ERR MSG 08715021 *=E 42 ASSIGN CLAUSE MISSING IN SELECT. CONTINUE 08722021 MSG42 BAL JQ,WRTMSG WRITE ERR MSG 08729021 *=E 2B 43 END OF SENTENCE SHOULD PRECEDE '-'. ASSUMED PRESENT. 08736021 MSG43 BAL JQ,PARMC WRITE ERR MSG 08743021 *=E 44 INVALID WORD. SKIP TO NEXT LEVEL SECTION OR DIVISION 08750021 MSG44 BAL JQ,PARMC BR, TO MSG SET-UP ROUTINE 08757021 *=E 45 INVALID ORDER IN '-' SECTION. 08764021 MSG45 BAL JQ,PARM2 WRITE ERR MSG 08771021 *=E 46 MEMBER NOT FOUND IN LIBRARY. IGNORING COPY. 08778021 MSG46 BAL JQ,WRTMSG WRITE ERR MSG 08785021 *=E 47 LIBRARY NOT FOUND ON SYSTEM. IGNORING COPY. 08792021 MSG47 BAL JQ,WRTMSG WRITE ERR MSG 08799021 *=E 48 LIBRARY MEMBER HAS BAD TRACK. IGNORING REST OF COPY. 08806021 MSG48 BAL JQ,WRTMSG WRITE ERR MSG 08813021 *=E 31 49 **** FILE-NAME ALREADY ASSIGNED THIS MULTIPLE FILE 08820021 *=E CLAUSE OPTION. USING FIRST ONE. 08827021 MSG49 BAL JP,PARMC WRITE ERR MSG 08834021 *=E '-' FILE ALREADY ASSIGNED THIS APPLY OPTION.FILE-NAME I 08841021 MSG50 BAL JQ,PARMC WRITE ERR MSG 08848021 DS 2F PARAMETER AREA 08855021 *=E 35 53 '-' CLAUSE INVALID. CLAUSE IGNORED 08862021 MSG53 BAL JQ,PARM4 WRITE ERR MSG 08869021 *=E 54 SELECT SENTENCE FOR '-' IGNORED, NOT LEGAL FOR SD OR SA 08876021 MSG54 BAL JQ,PARMC WRITE ERR MSG 08883021 *=E 37 55 FILE-NAME NOT PRESENT. DESCRIPTION IGNORED. 08890021 MSG55 BAL JQ,WRTMSG WRITE ERR MSG 08897021 *=E 38 56 FILE-NAME NOT DEFINED IN A SELECT. DESCRIP IGNORED. 08904021 MSG56 BAL JQ,WRTMSG WRITE ERR MSG 08911021 *=E 57 FIRST WORD IN REPORT SECTION NOT 'RD'. IGNORED. 08918021 MSG57 BAL JQ,WRTMSG WRITE ERR MSG 08925021 *=E 58 NO REPORTS CLAUSE IN FILE SECTION. REPORT SECTION IGNO 08932021 MSG58 BAL JQ,WRTMSG WRITE ERR MSG 08939021 *=E 59 NO REPORT CLAUSE FOR RD. RD IGNORED. 08946021 MSG59 BAL JQ,WRTMSG WRITE ERR MSG 08953021 DS F WRTMSG-F 08960021 *=E 61 DUPLICATE CLAUSE. DROPPED. 08967021 MSG61 BAL JQ,WRTMSG WRITE ERR MSG 08974021 *=E 62 '-' IN COPY REPLACING STMT INVALID AS BCD NAME. 08981021 MSG62 BAL JQ,PARMC BR, TO MSG SET-UP ROUTINE 08988021 *=E 63 DUPLICATE ENTRY IN PAGE CLAUSE. DROPPED 08995021 MSG63 BAL JQ,WRTMSG WRITE ERR MSG 09002021 *=E 64 NO TYPE CLAUSE SPECIFIED. 09009021 MSG64 BAL JQ,WRTMSG WRITE ERR MSG 09016021 *=E 65 INTEGER MISSING IN PAGE CLAUSE. ENTRY IGNORED. 09023021 MSG65 BAL JQ,WRTMSG WRITE ERR MSG 09030021 *=E 66 INVALID WORD IN PGE CL-SKIP TO NXT RECOGNIZABLE WD 09037021 MSG66 BAL JQ,WRTMSG WRITE ERR MSG 09044021 *=E 67 INVALID HEADER-SKIPPING TO NXT RECOGNIZABLE WORD 09051021 MSG67 BAL JQ,WRTMSG WRITE ERR MSG 09058021 DS F WRTMSG-F 09065021 *=E 69 INVALID TYPE CLAUSE. DROPPED. 09072021 MSG69 BAL JQ,WRTMSG WRITE ERR MSG 09079021 *=E 46 70 FLOAT-POINT LIT MANTISSA EXC 16 DIG. TRUNC TO 16. 09086021 MSG70 BAL JQ,WRNMSG WRITE ERR MSG 09093021 *=E 47 71 FLOAT-POINT LIT EXPONT EXC 2 DIG. TRUNC TO 2. RESCAN AT 09100021 MSG71 BAL JQ,WRNMSG WRITE ERR MSG 09107021 *=E 48 72 FLOAT-POINT LIT EXPONT FOLL BY NONBLANK. RESCAN AT NONB 09114021 MSG72 BAL JQ,WRNMSG WRITE ERR MSG 09121021 *=E 49 73 FLT PNT LIT'E'FOLLOWED BY INVALID,CALC LIT,RESCAN AT 'E 09128021 MSG73 BAL JQ,WRNMSG WRITE ERR MSG 09135021 *=E 4A 74 FLT PNT LIT SIGN FOLLOWED BY INVALID,CALC LIT,RESCAN AT 09142021 MSG74 BAL JQ,WRNMSG WRITE ERR MSG 09149021 *=E 4B 75 FLT PNT LIT EXCEEDS LIM,ASSUME MAX OR MIN ON 'E' SIGN. 09156021 MSG75 BAL JQ,WRNMSG WRITE ERR MSG 09163021 *=E 4C 76 ALPHAMERIC-LIT EXCEEDS 120 CHAR. TRUNCATED TO 120. 09170021 MSG76 BAL JQ,WRNMSG WRITE ERR MSG 09177021 *=E 4D 77 ALPHAMERIC-LIT CONTINUED IN A-MARGIN. ASSUMMED B-MARGIN 09184021 MSG77 BAL JQ,WRNMSG WRITE ERR MSG 09191021 *=E 4E 78 ALPHA-LIT CONTINUED WITH MISSING HYPHEN OR QUOTE. ASSUM 09198021 MSG78 BAL JQ,WRNMSG WRITE ERR MSG 09205021 *=E 4F 79 ALPHAMERIC-LIT HAS ZERO LENGTH. ASSUME 1 BLANK CHAR. 09212021 MSG79 BAL JQ,WRNMSG WRITE ERR MSG 09219021 *=E 50 80 PERIOD PRECEEDED BY BLANK. ASSUMED EOS. 09226021 MSG80 BAL JQ,WRNMSG WRITE ERR MSG 09233021 *=E 51 81 PERIOD NOT FOLLOWED BY BLANK. ASSUMED EOS. 09240021 MSG81 BAL JQ,WRNMSG WRITE ERR MSG 09247021 *=E 52 82 NUM-LIT EXCEEDS 18 DIGITS. TRUNCATED TO 18 DIGITS. 09254021 MSG82 BAL JQ,WRNMSG WRITE ERR MSG 09261021 *=E 53 83 ILLEGAL CHARACTER, SCAN RESUMED AT NEXT VALID CHARACTER 09268021 MSG83 BAL JQ,WRNMSG WRITE ERR MSG 09275021 *=E 54 84 COMMA SHOULD NOT BE PRECEEDED BY BLANK. ASSUMED OK. 09282021 MSG84 BAL JQ,WRNMSG WRITE ERR MSG 09289021 *=E 85 WORD OR PICTURE EXCEEDS 30 CHAR. TRUNCATED TO 30 CHAR. 09296021 MSG85 BAL JQ,WRNMSG WRITE ERR MSG 09303021 *=E 56 86 '-' SHOULD BE IN A-MARGIN. 09310021 MSG86 BAL JQ,PARMN WRITE ERR MSG 09317021 *=E 57 87 '-' SHOULD NOT BE IN A-MARGIN. 09324021 MSG87 BAL JQ,PARMN WRITE ERR MSG 09331021 *=E 88 NO INS/DEL NUMBER. PASSING CARDS TO BE INSERTED. 09338021 MSG88 BAL JQ,PARMID WRITE ERR MSG 09345021 *=E 89 INSERT DEL NUMBER OUT OF SEQ. NEXT INS/DEL NUMBER. 09352021 MSG89 BAL JQ,PARMID WRITE ERR MSG 09359021 *=E 90 DELETE THRU NUMBER OUT OF SEQ. NEXT INS/DEL NUMBER. 09366021 MSG90 BAL JQ,PARMID WRITE ERR MSG 09373021 JPGNSP DS F SAVE JP-SPECIAL ROUTINES 7641 09380021 JPINSV DS F SAVE JP-INSERT ROUT TBL 7641 09387021 DS F PARM-ID FULLWORD 09394021 *=E 94 NEXT GROUP INT DOES NOT CONFORM TO PAGE CLAUSE SPECS 09401021 MSG94 BAL JQ,WRTMSG WRITE ERR MSG 09408021 *=E 5F 95 WORD SECTION OR DIVISION MISSING. ASSUMED PRESENT. 09415021 MSG95 BAL JQ,WRNMSG WRITE ERR MSG 09422021 *=E 96 NOT DNM FOR DE. UPON IGNORED FOR THIS SUM CLAUSE 09429021 MSG96 BAL JQ,WRTRSV WRITE ERR MSG 09436021 *=E 61 97 PROGRAM-ID MISSING OR MISPLACED. IF PROGRAM-ID DOES NO 09443021 *=E IMMEDIATELY FOLLOW IDENTIFICATION DIVISION, IT WILL BE 09450021 *=E IGNORED. 09457021 MSG97 BAL JQ,WRTMSG WRITE ERR MSG 09464021 *=E 4E 98 ALPHM-LIT NOT CONT WITH HYPHEN + QUOTE.END LIT ON LAST 09471021 MSG98 BAL JQ,WRTMSG WRITE ERR MSG 09478021 *=E 63 99 '-' IS INVALID AS USED. 09485021 MSG99 BAL JQ,PARMN WRITE ERR MSG 09492021 *=E 100 '-' IS NOT A POSITIVE INTEGRAL NUMBER. ASSUMING A ONE I 09499021 MSG100 BAL JQ,PARMN WRITE ERR MSG 09506021 *=E 101 NEXT PAGE NOT I 1ST LINE CLAUSE-IGNORED 09513021 MSG101 BAL JQ,WRTMSG WRITE ERR MSG 09520021 *=E 102 INCOMPLETE 02 LEVEL-ASSUME VALUE SPACES 09527021 MSG102 BAL JQ,WRTMSG WRITE ERR MSG 09534021 *=E 103 GROUP TYPE ALLOWED ONCE FOR RD-IGNORED 09541021 MSG103 BAL JQ,WRTMSG WRITE ERR MSG 09548021 *=E 104 CONTROL NAME NOT SPECIFIED IN RD-SKIPPING TO NEXT 01. 09555021 MSG104 BAL JQ,WRTMSG WRITE ERR MSG 09562021 *=E 105 LEVEL 02 EXPECTED-ASSUMED 09569021 MSG105 BAL JQ,WRTMSG WRITE ERR MSG 09576021 DS F 09583021 *=E 107 'NXT GRP'CLS ILLEGAL FOR THIS RPT-GRP. IGNORED 09590021 MSG107 BAL JQ,WRTMSG WRITE ERR MSG 09597021 *=E 108 '-' IS NOT A POSITIVE INTEGRAL NUMBER. ASSUMING 1. 09604021 MSG108 BAL JQ,PARMN WRITE ERR MSG 09611021 *=E 109 DUPLICATE USE OF CONTROL NAME-SKIPPING TO NEXT 01. 09618021 MSG109 BAL JQ,WRTMSG WRITE ERR MSG 09625021 *=E 110 INVALID USE OF SUM CLAUSE. CONTINUE. 09632021 MSG110 BAL JQ,WRTMSG WRITE ERR MSG 09639021 *=E 111 ELEMENTARY LEVEL WITHOUT COLUMN OR SUM CLAUSE-DROPPED 09646021 MSG111 BAL JQ,WRTMSG WRITE ERR MSG 09653021 *=E 112 RPT-NAME ALREADY SPECIFIED IN TWO FILE DESCRIPTION ENTRIES 09660021 MSG112 BAL JQ,PARMRW RPT-NAME IN MORE THAN 2 FD'S 09667021 *=E 113 EXPECT 6 DIG-SEQ-NUM.SKIP TO NEXT INS/DEL NUMBER. 09674021 MSG113 BAL JQ,PARMID WRITE ERR MSG 09681021 *=E 114 EXTRANEOUS COMMA / HYPHEN ON DEL CD. IGNOREING IT. 09688021 MSG114 BAL JQ,PARMID WRITE ERR MSG 09695021 *=E 115 NO BLANK COMMA OR HYPHEN FOLLOW SEQ-NUM. ASSUME BLANK 09702021 MSG115 BAL JQ,PARMID WRITE ERR MSG 09709021 *=E 116 EXPECT 6 DIG-SEQ-NUM AFTER HYPHEN.IGNORE DEL FROM THRU 09716021 MSG116 BAL JQ,PARMID WRITE ERR MSG 09723021 *=E 117 DELETE NUM GREATER THAN LAST SEQ-NUM.STOP INS/DEL. 09730021 MSG117 BAL JQ,PARMID WRITE ERR MSG 09737021 *=E 118 INSERT NUM GREATER THAN THAN LAST SEQ-NUM.STOP INS/DEL 09744021 MSG118 BAL JQ,PARMID WRITE ERR MSG 09751021 *=E 119 INTEGER IN LINE-CLS DOES NOT CONFORM TO PG-CLS SPECS 09758021 MSG119 BAL JQ,WRTMSG WRITE ERR MSG 09765021 *=E 120 COMMA NOT FOLLOWED BY BLANK. ASSUME SPACE. 09772021 MSG120 BAL JQ,WRNMSG WRITE ERR MSG 09779021 *=E 121 PERIOD OR COMMA INVALID AS USED IN PICTURE CLAUSE. 09786021 MSG121 BAL JQ,WRNMSG WRITE ERR MSG 09793021 *=E 122 EXTERNAL-NAME USED OUTSIDE OF RERUN CLAUSE. SENTENCE 09800021 *=E IGNORED. 09807021 MSG122 BAL JQ,WRTMSG WRITE ERR MSG 09814021 *=E 123 NUMBER IS ZERO OR NEGATIVE. SENTENCE IGNORED. 09821021 MSG123 BAL JQ,WRTMSG WRITE ERR MSG 09828021 *=E 124 NUMBER TOO LARGE FOR RERUN. SENTENCE IGNORED. 09835021 MSG124 BAL JQ,WRTMSG WRITE ERR MSG 09842021 *=E 125 '-' FILE-NAME USED IN PREVIOUS RERUN. USING FIRST ONE. 09849021 MSG125 BAL JQ,PARMC WRITE ERR MSG 09856021 *=E 126 '-' FILE-NAME SPECIFIED IN BOTH RERUN AND USING OR GIVING 09863021 *=E OPTION . RERUN IGNORED. 09870021 MSG126 BAL JQ,PARMC WRITE ERR MSG 09877021 *=E 127 '-' INVALID IN '-' SENTENCE. REST OF SENTENCE 09884021 *=E IGNORED. 09891021 MSG127 BAL JQ,PARM8C WRITE ERR MSG 09898021 *=E 128 FOUND **. EXPECTING ENVIRONMENT. ALL ENV. DIV. STATEMENTS 09905021 *=E IGNORED. 09912021 MSG128 BAL JQ,PARMC MSG128 09919021 *=E 129 ID DIV HEADER EXTRANEOUS,MISSING OR MISPLACED.ONE ASSUMED 8930 09926021 MSG129 BAL JQ,WRTMSG MSG129 09933021 *=E 130 ** DIV. HEADER MISSING. WORDS IN ** STATEMENTS ARE INVALID. 09940021 MSG130 BAL JQ,WRTMSG MSG130 09947021 DS F 09954021 *=E 132 INVALID IMPLEMENTOR NAME. SKIPPING TO NEXT CLAUSE. 09961021 MSG132 BAL JQ,WRTMSG WRITE ERR MSG 09968021 DS 2F WRTMSG-2F 09975021 *=E 135 INTEGER-1 OUTSIDE OF ALLOWABLE LIMITS. DEFAULT TAKEN 09982021 MSG135 BAL JQ,WRTMSG WRITE ERR MSG 09989021 *=E 136 DNM ALREADY SPECIFIED FOR A TYPE DE RPT-GRP. 09996021 *=E SKIPPING TO NEW 01, RD, SECTION 10003021 MSG136 BAL JQ,WRTMSG WRITE ERR MSG 10010021 *=E 137 MINIMUM NUMBER OF OCCURRENCES IN OCCURS CLAUSE NOT LESS 10017021 *=E THAN MAXIMUM NUMBER, CONTINUING. 10024021 MSG137 BAL JQ,WRTMSG WRITE ERR MSG 10031021 *=E 138 APPLY ** FEATURE IS A FUNCTION OF JCL IN OS. 10038021 MSG138 BAL JQ,WRTMSG MSG 138 10045021 DS F WRTMSG-F 10052021 *=E NUMERIC LITERAL EXCEEDS 32K 10059021 MSG140 BAL JQ,PARMC 10066021 *=E 141 FILE ORGANIZATION FIELD INVALID IN IMPLEMENTOR NAME. 10073021 *=E SEQUENTIAL ASSUMED. 10080021 MSG141 BAL JQ,WRTMSG WRITE ERR MSG 10087021 DS 3F WRTMSG-3F 10094021 *=E 145 '-' DUPLICATELY DEFINED IN SPEC-NMS PARA. SENT IGNORED 10101021 MSG145 BAL JQ,PARMC WRITE ERR MSG 10108021 DS F 10115021 *=E 147 SD ILLEGALLY SPECD IN SAME AREA. CLAUSE FOR SD IGNORED 10122021 MSG147 BAL JQ,PARMC WRITE ERR MSG 10129021 *=E 148 INVALID SEGMENT LIMIT. 50 ASSUMED. 10136021 MSG148 BAL JQ,WRTMSG WRITE ERR MSG 10143021 *=E 149 ILLEGAL COMBINATION OF SAME AREA AND SAME RECORD/SAME 10150021 *=E SORT AREA CLAUSES. SAME REC-SAME SORT CLAUSE IGNORED 10157021 MSG149 BAL JQ,WRTRSV WRITE ERR MSG 10164021 DS F RSVMSG-F 10171021 *=E 151 ILLEGAL CHAR IN CURRENCY SIGN CLAUSE CLAUSE IGNORED 10178021 MSG151 BAL JQ,WRTMSG WRITE ERR MSG 10185021 *=E 152 ON AND/OR OFF STATUS CLAUSE MUST BE SPECIFIED. 10192021 *=E SPECIAL NAME IGNORED 10199021 MSG152 BAL JQ,WRTMSG WRITE ERR MSG 10206021 DS 2F WRTMSG-F 10213021 *=E 155 DEVICE CLASS INVALID IN IMPLEMENTOR NAME. SKIPPING 10220021 *=E TO NEXT FIELD. 10227021 MSG155 BAL JQ,WRTMSG WRITE ERR MSG 10234021 *=E 156 DEVICE NUMBER INVALID IN IMPLEMENTOR NAME. '-' ASSUMED. 10241021 MSG156 BAL JQ,PARMC2 WRITE ERR MSG 10248021 *=E 157 EXTERNAL FILE NAME NOT PRESENT IN IMPLEMENTOR NAME. 10255021 *=E CONTINUING. 10262021 MSG157 BAL JQ,WRTMSG WRITE ERR MSG 10269021 DS F 10276021 *=E 159 PAGE LIMIT INTEGER-1 NOT SPECIFIED. ASSUME HIGH VALUE 10283021 MSG159 BAL JQ,WRTMSG WRITE ERR MSG 10290021 *=E 160 CONTINUATION OF WORD FOUND IN A MARGIN. 10297021 MSG160 BAL JQ,WRTMSG WRITE ERR MSG 10304021 DS F 10311021 *=E 162 *INTEGER IN LINE CLAUSE LESS THAN PREVIOUS VALUE IGNORE 10318021 MSG162 BAL JQ,WRTMSG WRITE ERR MSG 10325021 *=E 163 ABS LINE PRECEEDED BY REL LINE. ASSUME LINE PLUS 1 10332021 MSG163 BAL JQ,WRTMSG WRITE ERR MSG 10339021 *=E 164 NO PG-CLS. ALL LINES MUST BE LINE PLUS INT. IGNORED 10346021 MSG164 BAL JQ,WRTMSG WRITE ERR MSG 10353021 *=E 165 1ST-DE NOT SPEC IN PG-CLS. PH ILLEGAL. CONTINUING 10360021 MSG165 BAL JQ,WRTMSG WRITE ERR MSG 10367021 *=E 166 LST-DE AND FTNG NOT SPEC. PF ILLEGAL. CONTINUING 10374021 MSG166 BAL JQ,WRTMSG WRITE ERR MSG 10381021 *=E 167 'LINE NXT PG' CLS ILLEGAL FOR THIS RPT-GRP. IGNORED 10388021 MSG167 BAL JQ,WRTMSG WRITE ERR MSG 10395021 *=E 168 RD ALREADY SPECIFIED IN RPT-SECTION. SKIP TO NEW RD 10402021 MSG168 BAL JQ,WRTMSG WRITE ERR MSG 10409021 * 10416021 DS F 10423021 *=E 170 DE GRP SPECIFIED WITH NO DNM. CONTINUING 10430021 MSG170 BAL JQ,WRTMSG WRITE ERR MSG 10437021 *=E 171 INTEGERS IN PAGE CLAUSE NOT IN ASCENDING ORDER. CONTIN 10444021 MSG171 BAL JQ,WRTMSG WRITE ERR MSG 10451021 *=E 172 WORD IVALID AS RPT-NM. IGNORED 10458021 MSG172 BAL JQ,WRTMSG WRITE ERR MSG 10465021 *=E 173 GROUP INDICATE IS ILLEGAL FOR THIS REPORT GROUP 10472021 MSG173 BAL JQ,WRTMSG WRITE ERR MSG 10479021 *=E 174 NO LINE CLS IN PRECEEDING RPT-GRP 10486021 MSG174 BAL JQ,WRTMSG WRITE ERR MSG 10493021 *=E 175 DNM FOR THIS RPT-GRP NOT UNIQUE. SKIP TO NEW 01 ETC 10500021 MSG175 BAL JQ,WRTMSG WRITE ERR MSG 10507021 * 10514021 * 10521021 DS F WRT MSG-F 10528021 * 10535021 DS F 10542021 *=E 178 RESET SPEC, ILLEGAL EITHER NO SUM OR WRONG GROUP 10549021 MSG178 BAL JQ,WRTMSG WRITE ERR MSG 10556021 *=E 179 COLUMN NUMBER ILLEGAL. ASSUME COLUMN 1 10563021 MSG179 BAL JQ,WRTMSG WRITE ERR MSG 10570021 *=E 180 SYNTAX OF COMMENT IS INCORRECT. SKIPPING TO NEXT CLAUSE. 10577021 MSG180 BAL JQ,WRTMSG WRITE ERR MSG 10584021 DS F ALIGN MSG 189 PROPERLY 4668 10591021 ZERWRD DC F'0' ZEROWORD CONSTANT 9321 10598021 REGWRK DC F'0' WORK REG 9321 10605021 JPMVNT DS F SAVE JP MVN ROUTINE 9321 10612021 JPUBRS DS F SAVE JP UBR ROUTINE 9321 10619021 JPCLRS DS F SAVE JP CLR ROUTINE 9321 10626021 JPCRDS DS F SAVE JP 9321 10633021 JPFLSV DS F SAVE JP FL SAVE ROUTINE 9321 10640021 *=E 189 'TO *' PORTION OF APPLY CORE-INDEX CLAUSE IGNORED. 9321 10647021 MSG189 BAL JQ,PARMN WRITE ERR MSG 9321 10654021 *=E 190 'OF FILENAME' PORTION OF RERUN CLAUSE MISSING. RERUN 9321 10661021 *=E IGNORED. 9321 10668021 MSG190 BAL JQ,WRTMSG WRITE ERR MSG 9321 10675021 EJECT 10682021 * 10689021 * PARAM LOADING ROUTINS 10696021 * 10703021 PARMC MVC EPARAM(LX122),CURCOD 10710021 CLI CURCOD,XX32 NUM-LIT 10717021 BC NOTEQ,WRTMSG NO-WRTMSG 10724021 PARMC2 MVI EPARAM,XX23 SET UP 10731021 MVC EPARAM+NX1(LX20),CURCNT IN BCD 10738021 BC UNCOND,WRTMSG WRITE ERR MSG 10745021 * 10752021 PARMN MVC EPARAM(LX122),NXTCOD 10759021 CLI NXTCOD,XX32 NUM-LIT 10766021 BC NOTEQ,WRNMSG NO-WRNMSG 10773021 MVI EPARAM,XX23 SET UP 10780021 MVC EPARAM+NX1(LX20),NXTCNT IN BCD 10787021 BC UNCOND,WRNMSG WRITE ERR MSG 10794021 * 10801021 PARMRW EQU * 10808021 MVC MSGGCN(LX2),FSEGSN GCN FROM 'SELECT' TO MSG 10815021 MVI EPARAM,XX23 SET UP IN BCD 10822021 MVC EPARAM+NX1(LX31),DX0(JG) RPT-NAME TO WORK-AREA 10829021 BC UNCOND,WRTRSV WRITE ERR MSG 10836021 * 10843021 PARM1C MVC SECPAR(LX32),CLSNM-NX1 10850021 BC UNCOND,PARMC GET PARAM FOR MSG 10857021 * 10864021 PARM2 MVC EPARAM(LX32),SECTNM-NX1 10871021 BC UNCOND,WRTMSG WRITE ERR MSG 10878021 * 10885021 PARM3 MVC EPARAM(LX32),PARNM-NX1 10892021 BC UNCOND,WRTMSG WRITE ERR MSG 10899021 * 10906021 PARM4 MVC EPARAM(LX32),CLSNM-NX1 10913021 BC UNCOND,WRTMSG WRITE ERR MSG 10920021 * 10927021 PARM5 MVC EPARAM(LX32),VERBNM-NX1 10934021 BC UNCOND,WRTMSG WRITE ERR MSG 10941021 * 10948021 PARM6C MVC SECPAR(LX32),VERBNM-NX1 10955021 BC UNCOND,PARMC GET PARAM FOR MSG 10962021 * 10969021 PARM7C MVC SECPAR(LX32),SECTNM-NX1 10976021 BC UNCOND,PARMC GET PARAM FOR MSG 10983021 PARM8C MVC SECPAR(LX32),VERBNM-NX1 10990021 BC UNCOND,PARMN GET PARAM FOR MSG 10997021 * 11004021 PARMID MVC EPARAM(LX2),CARDCN SET UP CARD IMAGE 11011021 MVC EPARAM+NX2(LX80),SIDEWK FROM SIDEWK 11018021 BC UNCOND,WRDMSG -WRDMSG 11025021 * 11032021 SEVLST DC X'00' SEVCODE 11039021 * 11046021 * 1 2 3 4 5 6 7 8 910111213141516 11053021 DC X'11010121212101012101112121012121' MSGS 1 - 16 11060021 * 11067021 * 17181920212223242526272829303132 11074021 DC X'21212121210121211101012121211121' MSGS 17 - 32 11081021 * 11088021 * 33343536373839404142434445464748 11095021 DC X'01012111212101212121012121212121' MSGS 33 - 48 11102021 * 11109021 * 49505152535455565758596061626364 11116021 DC X'21212121212121212121212121212121' MSGS 49 - 64 11123021 * 11130021 * 65666768697071727374757677787980 11137021 DC X'21212121211111111111111111011101' MSGS 65 - 80 11144021 * 11151021 * 81828384858687888990919293949596 11158021 DC X'01111101110101212121112121210121' MSGS 81 - 96 11165021 * 11172021 * 979899 0 1 2 3 4 5 6 7 8 9101112 11179021 DC X'21212111210121210121112121210121' MSGS 97 - 112 11186021 * 11193021 * 13141516171819202122232425262728 11200021 DC X'21112121212121010101012121212101' MSGS 113-128 11207021 * 11214021 * 29303132333435363738394041424344 11221021 DC X'11210121010101210101212101010101' MSGS 129 - 144 47935 11228021 * 11235021 * 45464748495051525354555657585960 11242021 DC X'01010101010101010101010121010101' MSGS 145 - 160 8061 11249021 * 11256021 * 61626364656667686970717273747576 11263021 DC X'01212121212111210121212121212101' MSGS 161 - 176 11270021 * 11277021 * 77787980818283848586878889909192 11284021 DC X'21212101010101010101010101210101' MSG 177 - 192 9321 11291021 EJECT 11298021 * 11305021 * GCN LOADING FOR NEXT-WORD 11312021 * 11319021 WRNMSG MVC MSGGCN(LX2),NXTGCN GCN TO MSG-TEXT 11326021 BC UNCOND,WRTRSV -WRTRSV 11333021 * GCN LOADING FOR INSERT / DELETE 11340021 WRDMSG MVC MSGGCN(LX2),HWZERO ZERO GCN FOR INS/DEL 11347021 BC UNCOND,WRTRSV -WRTRSV 11354021 * GCN LOADING FOR CUR-WORD 11361021 WRTMSG MVC MSGGCN(LX2),CURGCN GCN TO MSG-TEXT 11368021 * CALC MSG NUMBER AND LOAD MSGNUM 11375021 WRTRSV STM JA,JC,SV3F12 SAVE REG 11382021 TM NOTESW,XX02 NOTESW 'ON' 11389021 BC ONES,WRTXTA YES-WRTXTA 11396021 LA JA,MSG1 ADDR OF START OF MSGS 11403021 LA JQ,DX0(JQ) CLEAR HI ORDER BYTE 11410021 SR JQ,JA GET DISPLACEMENT 11417021 SRL JQ,DX2(JR) DIVIDE BY 4 11424021 STC JQ,MSGNUM+NX1 STORE MSG-NUM IN MSG-TEXT 11431021 LA JA,SEVLST ADDR OF SEVLST 11438021 IC JC,DX0(JQ,JA) GET SEVERITY CODE 11445021 STC JC,MSGSP STORE SEVERITY IN MSG-TEXT 11452021 * WRITE OF ERROR MSG 11459021 L JC,COSADR WRITE OUT 11466021 LA JB,MSGDEF MSG ON 11473021 BALR JR,JC FILE 11480021 WRERR1 DC X'23' XX 11487021 * SET UP OF PARAM LENGTH 11494021 WRTSEC CLI EPARAM,XX00 PARAM PRESENT 11501021 BC EQ,WRTEXT NO-WRTEXT 11508021 CLI EPARAM,XXB9 CODE FOR INVALID WORD 11515021 BC NOTEQ,WRTADR NO-WRTADR 11522021 MVC EPARAM(LX2),EPARAM+NX1 MOVE CODE OVER ONE 11529021 WRTADR LA JB,EPARAM ADDR OF EPARAM 11536021 XR JA,JA CLEAR REG 11543021 IC JA,DX0(JB) GET IC-TEXT CODE 11550021 SRL JA,DX6(JR) SHIFT RIGHT 6 11557021 LTR JA,JA TEST IF ZERO 11564021 BC NOTZER,WRTADJ NO-WRTADJ 11571021 IC JA,DX1(JB) GET IC-TEXT 'N' 11578021 LA JA,DX1(JA) ADJ LENGTH FOR 'N' 11585021 WRTADJ LA JA,DX1(JA) ADJ LENGTH FOR CODE 11592021 STC JA,EPARNN+NX1 STORE IN PARAM 'N' FIELD 11599021 * WRITE OF PARAM 11606021 LA JB,EPARNN WRITE OUT 11613021 BALR JR,JC PARAM ON 11620021 WRERR2 DC X'23' FILE XX 11627021 * LOAD OF SECOND PARAM TO FIRST 11634021 MVC EPARAM(LX32),SECPAR MOVE SECOND PARAM TO FIRST 11641021 MVI SECPAR,XX00 ZERO SECPAR 11648021 BC UNCOND,WRTSEC -WRTSEC 11655021 * EXIT FROM ERROR MSG ROUTINE 11662021 WRTEXT LM JA,JC,SV3F12 RESTORE REGS 11669021 WRTXTA L JQ,LNKR15 RESTORE BASE REG15 11676021 BCR UNCOND,JP -RETURN 11683021 * 11690021 EJECT 11697021 IKF102 CSECT 11704021 * 11711021 *=2 COMMON CONSTANT AREA ID ENV DATA PR 11718021 * 11725021 IDDIV1 EQU * 11732021 DS CL15 OF CURRENT DATE 11739021 DATDV1 DC A(RDSCAN) PTR TO RDSCN 11746021 DATDV2 DC A(FLUSH) PTR TO FLUSH 11753021 DATDV4 DC A(SPCRTS) ADDR OF SPECIAL ROUTS CSECT 11760021 DATDV5 DC A(DOROL) PTR TO DORO1 11767021 DATDV3 DC A(PROC01) PTR TO PROC01 11774021 IDDIV DC A(IDDSCN) ADDR OF IDDSCN 11781021 HSKP2 DC A(GETWD) PTR TO GETWD 11788021 HSKP3 DC A(GETDLM) PTR TO GETDLM 11795021 GTD1 DC A(LETTER) PTR TO LETTER 11802021 ENVDIV DC A(ENVSCN) ADDR OF ENV DIV 11809021 ENVDV1 DC A(APPSCN) PTR TO APDSCN 11816021 ACBW DC A(COBWRD) PTR TO COBWRD 11823021 DATDIV DC A(DDSCN) ADDR OF DAT DIV 11830021 GETADR DC A(UNLVSN) ADDR OF UNIT LEVEL SCAN 11837021 * 11844021 SV1F13 DS 15F SAVE FOR CALLING COPY 11851021 GTWDSV DS 15F SAVE AREA FOR GETWD REGS 11858021 GTCDSV DS 15F SAVE FOR GTCD REGS 11865021 SAVECD DS CL80 80-BYTE CARD SAVE AREA 11872021 * 11879021 HWZERO DC H'0' HALFWORD OF ZEROS 11886021 HWONE DC H'1' HALFWORD OF +1 11893021 H1 EQU HWONE 11900021 HW1 EQU HWONE 11907021 HWTWO DC H'2' HALFWORD OF 2 11914021 H2 EQU HWTWO 11921021 HWTHRE DC H'3' HALFWORD OF +3 11928021 HW3 EQU HWTHRE 11935021 HWFOUR DC H'4' HALFWORD OF '4' 11942021 H5 DC H'5' HALFWORD CONSTANT 11949021 HWTEN DC H'10' HALFWORD OF TEN 11956021 HW034 DC H'34' HALFWORD OF 34 11963021 HW65 DC H'65' HALF WORD OF 66 11970021 HW8 DC H'8' HALFWORD OF EIGHT 11977021 HW49 DC H'49' HALFWORD OF 49 9015 11984021 CON32K DC H'32767' MAX SIZE FOR HALFWORD 9015 11991021 L049 DC X'049F' HALFWORD OF 49 11998021 L066 DC X'066F' HALFWORD OF 66 12005021 L077 DC X'077F' HALFWORD OF 77 12012021 L088 DC X'088F' HALFOWRD OF 88 12019021 H1442 DC H'1442' HALFWORD CONSTANT 12026021 H1403 DC H'1403' HALFWORD CONSTANT 12033021 H1404 DC H'1404' HALFWORD CONSTANT 12040021 H1443 DC H'1443' HALFWORD CONSTANT 12047021 H1445 DC H'1445' HALFWORD CONSTANT 12054021 HW2301 DC H'2301' HALF WD FOR BINARY 2301 12061021 HW2302 DC H'2302' HALF WD FOR 2302 12068021 HW2303 DC H'2303' HALF WD FOR BIN 2303 12075021 H2501 DC H'2501' HALFWORD CONSTANT 12082021 H2520 DC H'2520' HALFWORD CONSTANT 12089021 H2540 DC H'2540' HALFWORD CONSTANT 12096021 HW2400 DC H'2400' HALFWORD CONSTANT 12103021 HW2311 DC H'2311' HALFWORD CONSTANT 12110021 HW2314 DC H'2314' HALFWORD CONSTANT 12117021 HW2321 DC H'2321' HALFWORD CONSTANT 12124021 UNITRC DC C'UR' UNIT-RECORD SCAN CON 12131021 UTILTY DC C'UT' UTILITY SCAN CON 12138021 DIRACC DC C'DA' DIRECT ACCESS SCAN CON 12145021 S1403 DC C'1403' PRINTER CON 12152021 S2311 DC C'2311E' 2311 , 2311E CONFIGURATION 12159021 S2540 DC C'2540' READER CON 12166021 * 12173021 FILE54 DC X'420226' AFTER I-O-CONTROL 12180021 CINCON DC C' IN ' CINCON AREA 12187021 SVCURR DS CL181 SAVE AREA FOR CURENT CELLS 12194021 CPQCNT DS CL1 SAVE CURCNT 12201021 CPQWD DS CL30 SAVE CURWD 12208021 CPYQNM DC CL30' ' SAVE 01 DATANM FROM COPYLIB 12215021 F1 DC F'1' F1 CON 12222021 ALLFF DC F'-1' ALL FF CON 12229021 K2 DC F'2' K2 CON 12236021 K7 DC F'7' K7 CON 12243021 K16 DC F'16' K16 CON 12250021 K17 DC F'17' K17 CON 12257021 K18 DC F'18' K18 CON 12264021 K30 DC F'30' K30 CON 12271021 FWCONS DC F'48' FULLWORD OF 00000030 12278021 K120 DC F'120' FULWORD OF 120 12285021 NU255 DC F'255' FULLWORD WITH 255 12292021 TWOP24 DC F'16777216' CONSTANT 12299021 TNPW9 DC F'1000000000' CONSTANT 12306021 FLTONE DC D'1' FL-PT CON 12313021 ZEROCS DC X'0000000C' ZEROES CON 12320021 DC X'0000000C' ZEROES CON 12327021 DC X'0000000C' 12334021 * 12341021 * TABLES 12348021 * 12355021 PLSTBL DC E'7.2E11' PLSTBL CONSTANT AREA 12362021 DC E'7.2E43' INDEX 12369021 DC E'7.2E59' INDEX 12376021 DC E'7.2E67' INDEX 12383021 DC E'7.2E71' INDEX 12390021 DC E'7.2E73' INDEX 12397021 DC E'7.2E74' INDEX 12404021 * 12411021 NEGTBL DC E'5.4E-15' INDEX 12418021 DC E'5.4E-47' INDEX 12425021 DC E'5.4E-63' INDEX 12432021 DC E'5.4E-71' INDEX 12439021 DC E'5.4E-75' INDEX 12446021 DC E'5.4E-77' INDEX 12453021 DC E'5.4E-78' INDEX 12460021 * 12467021 PWRTBL DC D'1E64' INDEX 12474021 DC D'1E32' INDEX 12481021 DC D'1E16' INDEX 12488021 DC D'1E8' INDEX 12495021 DC D'1E4' INDEX 12502021 DC D'1E2' INDEX 12509021 DC D'1E1' INDEX 12516021 * 12523021 TBLEND DC A(PWRTBL+56) PTR TO END OF TB1 12530021 * 12537021 **************** 12544021 * 12551021 * TRT TABLE - SCANNING TO NON-DIGIT 12558021 * 12565021 NONLDH EQU * SCAN TO NON LETTER DIGIT HY 12572021 UDIGT DC 5X'040404040404040404040404040404' 12579021 DC X'03' PERIOD 12586021 DC 2X'04040404040404040404' 12593021 TBHYPN DC X'02' MINUS SIGN 12600021 DC 6X'04040404040404040404040404040404' 12607021 MSKLT1 DC X'010101010101010101' LETTERS 12614021 DC X'04040404040404' 12621021 MSKLT2 DC X'010101010101010101' LETTERS 12628021 DC X'0404040404040404' 12635021 MSKLT3 DC X'0101010101010101' LETTERS 12642021 DC X'040404040404' 12649021 DC X'00000000000000000000' 12656021 DC X'040404040404' 12663021 **************** 12670021 * 12677021 *** TRT TABLE SCANNING TO NON-BLAND ********** 12684021 * 12691021 * 12698021 UNONB DC 4X'07070707070707070707070707070707' ILLEGAL CHARACTER 12705021 DC X'00' BLANK 12712021 DC X'07070707070707070707' 12719021 DC X'04' PERIOD 12726021 DC X'06' LESS THAN SIGN 12733021 DC X'06' LEFT PAREN 12740021 DC X'05' PLUS SIGN 12747021 DC X'070707070707070707070707' 12754021 DC X'07' DOLLAR SIGN-ILLEGAL 12761021 DC X'06' ASTERISK 12768021 DC X'06' RIGHT PAREN 12775021 DC X'08' SEMI-COLON 12782021 DC X'07' 12789021 DC X'05' MINUS SIGN 12796021 DC X'06' SLASH 12803021 DC X'070707070707070707' 12810021 DC X'08' COMMA 12817021 DC X'0707' 12824021 DC X'06' GREATER THAN SIGN 12831021 DC X'0707070707070707070707070707' 12838021 TBQUT1 DC X'03' QUOTE 12845021 DC X'06' EQUAL SIGN 12852021 TBQUT2 DC X'07' DOUBLE QUOTE 12859021 DC 13X'0707070707' LETTERS 12866021 LETMSK DC X'010101010101010101' LETTERS 12873021 DC X'07070707070707' LETTERS 12880021 DC X'010101010101010101' LETTERS 12887021 DC X'0707070707070707' LETTERS 12894021 DC X'0101010101010101' LETTERS 12901021 DC X'070707070707' LETTERS 12908021 DC X'02020202020202020202' DIGITS 12915021 DC X'070707070707' LETTERS 12922021 * 12929021 RSEV DC X'07' BYTE OF 7 12936021 * 12943021 MSKLTP EQU MSKLT2+6 12950021 MSKLTR EQU MSKLT2+8 12957021 USETBL DC XL14'32F2E1E0DFDE2607060504030201' USAGE TBL & CONSTA 12964021 DS 0D 12971021 MAXFLT DC X'7FFFFFFFFFFFFFFF' FLT CON FIELD 12978021 KHYPHN EQU X'60' 12985021 KQUOTE DC X'407D' BLANK-QUOTE FOR COL 73+74 12992021 INKON DC C'IN ' SWITCH 12999021 OFKON DC C'OF ' SWITCH 13006021 KDECML DC X'4B6B' CONSTANT FOR PERIOD-COMA 13013021 EOPCON DC X'42FF1E' CONSTANT FOR EOP 13020021 REPCON DC X'54D604' CONSTANT FOR REPORT NOT AS 13027021 DATCON DC X'540104' CONSTANT FOR'DATA'IN DATA D 13034021 MODBYT DC X'2301' CONSTANT FOR 1 CHAR-BCD 13041021 EOSCON DC X'4406' CONSTANT FOR 'PERIOD' 13048021 FRHWZ DC H'0' HALFWORD 13055021 RSECT DC X'420B' REPORT SECTION HEADER 13062021 INLONE DC X'0301001C' INT-NUM-LIT OF ONE FOR 13069021 BUGCON DC X'00000000000006' 1-USED FOR *DEBUG FOLLOWED 13076021 CARDCN DC X'2348' CONST FOR WRITE OF INC/DEL CD 13083021 INTNL4 DC X'32050400' CONSTANT FOR 'INTEG NUM LIT 13090021 INSKON DC C'INSERT ' CONSTANT OF 'INSERT' 41557 13097021 DELKON DC C'DELETE ' CONSTANT OF 'DELETE' 41557 13104021 ***********************CURRENCY SIGN TABLE******************** 13111021 CURSGT DC C'0' CURRENCY TABLE FIELD 13118021 DC C'1' CURRENCY TABLE FIELD 13125021 DC C'2' CURRENCY TABLE FIELD 13132021 DC C'3' CURRENCY TABLE FIELD 13139021 DC C'4' CURRENCY TABLE FIELD 13146021 DC C'5' CURRENCY TABLE FIELD 13153021 DC C'6' CURRENCY TABLE FIELD 13160021 DC C'7' CURRENCY TABLE FIELD 13167021 DC C'8' CURRENCY TABLE FIELD 13174021 DC C'9' CURRENCY TABLE FIELD 13181021 DC C'A' CURRENCY TABLE FIELD 13188021 DC C'B' CURRENCY TABLE FIELD 13195021 DC C'C' CURRENCY TABLE FIELD 13202021 DC C'D' CURRENCY TABLE FIELD 13209021 DC C'P' CURRENCY TABLE FIELD 13216021 DC C'R' CURRENCY TABLE FIELD 13223021 DC C'S' CURRENCY TABLE FIELD 13230021 DC C'V' CURRENCY TABLE FIELD 13237021 DC C'X' CURRENCY TABLE FIELD 13244021 DC C'Z' CURRENCY TABLE FIELD 13251021 DC C' ' CURRENCY TABLE FIELD 13258021 DC C'*' CURRENCY TABLE FIELD 13265021 DC C'+' CURRENCY TABLE FIELD 13272021 DC C'-' CURRENT FIELD 13279021 DC C',' CURRENT FIELD 13286021 DC C'.' CURRENT FIELD 13293021 DC C';' CURRENT FIELD 13300021 DC C'(' CURRENT FIELD 13307021 DC C')' CURRENT FIELD 13314021 DC C'"' CURRENT FIELD 13321021 CURSGE EQU * 13328021 CPARAG DC AL1(10) CONSTANT OF '10PARAGRAPH' 13335021 DC C'PARAGRAPH' 13342021 CSENTE DC AL1(8) CONSTANT OF '8SENTENCE' 13349021 DC C'SENTENCE' 13356021 CCLAUS DC AL1(6) CONSTANT OF '6CLAUSE' 13363021 DC C'CLAUSE' 13370021 CFG13 DC AL1(13) CONSTANT OF '13CONFIGURATIO 13377021 DC C'CONFIGURATION' 13384021 EXTRSW DC X'00' BIT 1 = 1 IF EXT-NM IN RERUN 13391021 DAT4 DC AL1(4) CONSTANT OF '4DATA' 13398021 DC C'DATA' 13405021 ENV11 DC AL1(11) CONSTANT OF '11ENVIRONMENT' 13412021 DC C'ENVIRONMENT' 13419021 FILE4 DC AL1(4) CONSTANT OF '4FILE' 13426021 DC C'FILE' 13433021 FCTL12 DC AL1(12) CONSTANT OF '12FILE-CONTROL 13440021 DC C'FILE-CONTROL' 13447021 INOT12 DC AL1(12) CONSTANT OF '12INPUT-OUTPUT 13454021 DC C'INPUT-OUTPUT' 13461021 IOCT11 DC AL1(11) CONSTANT OF '11I-O-CONTROL' 13468021 DC C'I-O-CONTROL' 13475021 REPRT6 DC AL1(6) CONSTANT OF '6REPORT' 13482021 DC C'REPORT' 13489021 SPNM13 DC AL1(13) CONSTANT OF 'SPECIAL-NAMES' 13496021 DC C'SPECIAL-NAMES' 13503021 WKST15 DC AL1(15) CONSTANT OF '15WORKING-STOR 13510021 DC C'WORKING-STORAGE' 13517021 RENAM7 DC AL1(7) CONSTANT OF '7RENAMES' 7869 13524021 DC C'RENAMES' 7869 13531021 IDD DC AL1(2) CONSTANT OF '2ID' 13538021 DC C'ID' 13545021 PRCD9 DC AL1(9) CONSTANT OF '9PROCEDURE' 13552021 DC C'PROCEDURE' 13559021 ESCH15 DC AL1(15) CONSTANT OF '15EXTENDED-SEARCH' 13566021 DC C'EXTENDED-SEARCH' 13573021 CYOV12 DC AL1(12) CONSTANT OF '12CYL-OVERFLOW' 13580021 DC C'CYL-OVERFLOW' 13587021 MSTX12 DC AL1(12) CONSTANT OF '12MASTER-INDEX' 13594021 DC C'MASTER-INDEX' 13601021 CYLX9 DC AL1(9) CONSTANT OF '9CYL-INDEX' 13608021 DC C'CYL-INDEX' 13615021 WVER12 DC AL1(12) CONSTANT OF '12WRITE-VERIFY' 13622021 DC C'WRITE-VERIFY' 13629021 CORX10 DC AL1(10) CONSTANT OF '10CORE-INDEX' 13636021 DC C'CORE-INDEX' 13643021 * CURRENT WORD INFORMATION 13650021 DS 0F 13657021 CURNUM DC C'000000' 6-BYTE CURNUM 13664021 CURCNT DS CL1 1-BYTE AREA FOR COUNT 13671021 CURWD DS CL30 LENGTH OF CURWORD 13678021 CURSW DS CL1 1-BYTE SWITCH AREA 13685021 CURGCN DC H'0' GENERATED CARD NUMBER 13692021 CURCOD DS CL1 1-BYTE CODE 13699021 CURN DS CL1 1-BYTE AREA 13706021 CURDCD DS 0CL1 CURDCD EQU CURBCD FIRST BYTE 13713021 CURBCD DS CL120 120 BYTE BCD NAME FIELD 13720021 CURXNL DS CL19 EXTERNAL-NUM-LIT IN BCD W/SI 13727021 * NEXT WORD INFORMATION 13734021 DS 0H 13741021 NXTNUM DC C'000000' 6-BYTE FIELD 13748021 NXTCNT DS CL1 7-BYTE AREA 13755021 NXTWD DS CL30 30 WORD AREA 13762021 NXTSW DC X'00' 80-BCD,08-INL,04-NONBLK,02-LHNP,01-A-M 13769021 NXTGCN DC H'0' GENERATED CARD NUMBER 13776021 NXTCOD DC CL1'0' CODE SWITCH 13783021 NXTN DS CL1 7-BYTE FIELD 13790021 NXTBCD DS CL120 120-BYTE BCD NAME FIELD 13797021 * 13804021 * THESE EQUATES ARE USED FOR IMPLEMENTOR NAME SCAN IN THE 13811021 * SELECT SENTENCE SCAN 13818021 * 13825021 CURLIT EQU CURXNL+1 13832021 HYPH2 EQU CURBCD+7 13839021 NNN EQU CURBCD+3 13846021 * 13853021 BCDP EQU CURBCD+7 13860021 MAJ0 EQU X'30' 2768 13867021 EJECT 13874021 * 13881021 *=2 TAMER ADCONS AND CONSTANTS ID ENV DATA PR 13888021 * 13895021 DS 0F 13902021 * 13909021 COSADR DC A(0) ADDR OF COS 13916021 * 13923021 ADPRIM DC A(PRIME) PRIME 13930021 ADSERT DC A(INSERT) INSERT 13937021 ADSTAC DC A(STATIC) STATIC PTR 13944021 ADTREL DC A(TABREL) TABREL 13951021 ADTAMN DC A(TAMEIN) TAMEIN 13958021 * 13965021 DS 0F 13972021 QLTABL EQU TIB1-COS 13979021 QLTCON EQU * 13986021 PARQLT DC X'00' PARAM FOR QLTABL 13993021 DC AL3(QLTABL) 14000021 DC X'00640020' 100 BYTES 14007021 QNMTBL EQU TIB2-COS 14014021 QNMCON EQU * 14021021 PARQNM DC X'0F' PARAM FOR QNMTBL 14028021 DC AL3(QNMTBL) 14035021 DC X'01000040' 256 BYTES 14042021 P1BTBL EQU TIB2-COS 14049021 P1BCON EQU * 14056021 PARP1B DC X'00' 1-BYTE CON 14063021 DC AL3(P1BTBL) 14070021 DC X'02000000' 512 BYTES 14077021 ENVTBL EQU TIB3-COS 14084021 ENVCON EQU * 14091021 PARENV DC X'56' PARAM FOR ENVTBL 14098021 DC AL3(ENVTBL) 14105021 DC X'026E0056' 450 BYTES 5 ENTRIES 14112021 *APPTBL EQU TIB4-COS 14119021 *APPCON EQU * 14126021 *PARAPP DC X'42' PARAM FOR APPTBL 14133021 * DC AL3(APPTBL) 14140021 * DC X'014A0042' 330 BYTES 5 ENTRIES 14147021 PNTABL EQU TIB5-COS 14154021 PNQTBL EQU TIB6-COS 14161021 PIOTBL EQU TIB7-COS 14168021 PIOCON EQU * 14175021 PARPIO DC X'03' PARAM FOR PIOTBL 14182021 DC AL3(PIOTBL) 14189021 DC X'00360000' 60 BYTES 20 ENTRIES 14196021 SATBL EQU TIB5-COS 14203021 SACON EQU * 14210021 PARSA DC X'00' PARAM FOR SATBL 14217021 DC AL3(SATBL) 14224021 DC X'00800020' 4-BYTE CON 14231021 SRATBL EQU TIB6-COS 14238021 SRACON EQU * 14245021 PARSRA DC X'00' PARAM FOR SRATBL 14252021 DC AL3(SRATBL) 14259021 DC X'00800020' 4-BYTE CON 14266021 CKPTBL EQU TIB8-COS 14273021 CKPCON EQU * 14280021 PARCKP DC X'10' PARAM FOR CKPTBL 14287021 DC AL3(CKPTBL) 14294021 DC X'00500010' 80 BYTES 5 ENTRIES 14301021 OD2TBL EQU TIB9-COS 14308021 OD2CON EQU * 14315021 PAROD2 DC X'20' PARAM FOR OD2TBL 14322021 DC AL3(OD2TBL) 14329021 DC X'01000064' 256 BYTES 14336021 FNTBL EQU TIB10-COS 14343021 FNTCON EQU * 14350021 PARFNT DC X'30' PARAM FOR FNTBL 14357021 DC AL3(FNTBL) 14364021 DC X'00F00030' 240 BYTES 5 ENTRIES 14371021 RCDTBL EQU TIB11-COS 14378021 RCDCON EQU * 14385021 PARRCD DC X'22' PARAM FOR RCDTBL 14392021 DC AL3(RCDTBL) 14399021 DC X'02A80022' 680 BYTES 20 ENTRIES 14406021 SPNTBL EQU TIB21-COS 14413021 SPNCON EQU * 14420021 PARSPN DC X'22' PARAM FOR SPNTBL 14427021 DC AL3(SPNTBL) 14434021 DC X'01540022' 340 BYTES 10 ENTRIES 14441021 TOTTBL EQU TIB32-COS 14448021 TOTCON EQU * 14455021 PARTOT DC X'22' 2-BYTE FIELD 14462021 DC AL3(TOTTBL) 14469021 DC X'00880022' 136 BYTES 4 ENTRIES 14476021 KEYTAB EQU TIB26-COS KEYTABLE 14483021 KYCON EQU * 14490021 PARKEY DC X'00' PARAM FOR KEY TABLE 14497021 DC AL3(KEYTAB) 14504021 DC X'001E0000' 30 BYTES 14511021 INDXTB EQU TIB27-COS INDEX TABLE 14518021 INDCON EQU * 14525021 PARIND DC X'00' PARAM FOR INDEX TABLE 14532021 DC AL3(INDXTB) 14539021 DC X'001E0000' 30 BYTES 14546021 EJECT 14553021 * 14560021 * 14567021 *=1 REPORT WRITER TAMER ADCONS AND CONSTANTS 14574021 * 14581021 RNMTBL EQU TIB12-COS 14588021 RNMCON EQU * 14595021 RNMTB DC X'23' 2-BYTE FIELD 14602021 DC AL3(RNMTBL) 14609021 DC X'00D20023' 6 ENTRIES 14616021 RWRTBL EQU TIB13-COS 14623021 RWRCON EQU * 14630021 RWRTB DC X'30' MAIN REPORT-WRITER TBL 14637021 DC AL3(RWRTBL) 14644021 DC X'00C00030' 4 ENTRIES 14651021 CTLTBL EQU TIB14-COS 14658021 CTLCON EQU * 14665021 CTLTB DC X'38' TBL OF CTL-NMS 14672021 DC AL3(CTLTBL) 14679021 DC X'01500038' 6 ENTRIES 14686021 ROLTBL EQU TIB15-COS 14693021 ROLCON EQU * 14700021 ROLTB DC X'10' 2-BYTE FIELD 14707021 DC AL3(ROLTBL) 14714021 DC X'01E00040' 10 ENTRIES 14721021 ROUTBL EQU TIB16-COS 14728021 ROUCON EQU * 14735021 ROUTB DC X'22' TABLE OF PROCEDURE NAMES 14742021 DC AL3(ROUTBL) FOR OVFLO,PAGE,ETC. ROUTINE 14749021 DC X'00880022' 14756021 DETTBL EQU TIB17-COS 14763021 DETCON EQU * 14770021 DETTB DC X'26' TBL OF PROC NAMES 14777021 DC AL3(DETTBL) FOR DETAIL ROUTINES 14784021 DC X'017C0026' 10 ENTRIES 14791021 NPTTBL EQU TIB18-COS 14798021 NPTCON EQU * 14805021 NPTTB DC X'08' 2-BYTE FIELD 14812021 DC AL3(NPTTBL) 14819021 DC X'00A00008' 20 ENTRIES 14826021 SUMTBL EQU TIB19-COS 14833021 SUMCON EQU * 14840021 SUMTB DC X'2C' TABLE OF SUM COUNTERS 14847021 DC AL3(SUMTBL) 14854021 DC X'01820040' 10 ENTRIES 14861021 QALTBL EQU TIB23-COS 14868021 QALCON EQU * 14875021 QALTB DC X'50' WORK TBL FOR QUAL/SUBS/INDX 14882021 DC AL3(QALTBL) 14889021 DC X'00500050' 1 ENTRY 14896021 SRCTBL EQU TIB22-COS 14903021 SRCCON EQU * 14910021 SRCTB DC X'20' 2-BYTE FIELD 14917021 DC AL3(SRCTBL) 14924021 DC X'01400020' 10 ENTRIES 14931021 SMSTBL EQU TIB28-COS 14938021 SMSCON EQU * 14945021 SMSTB DC X'38' TBL OF SUM OPERANDS 14952021 DC AL3(SMSTBL) 14959021 DC X'01500038' 6 ENTRIES 14966021 SNMTBL EQU TIB35-COS 14973021 SNMCON EQU * 14980021 SNMTB DC X'23' TBL OF SUM NAMES 14987021 DC AL3(SNMTBL) 14994021 DC X'00D20023' 6 ENTRIES 15001021 GCNTBL EQU TIB24-COS 15008021 GCNCON EQU * 15015021 GCNTB DC X'06' TBL OF GCNS FOR BAD ABS LINE 15022021 DC AL3(GCNTBL) THAT CONFLICT WITH PAGE LIM 15029021 DC X'001E0006' 10 ENTRIES 15036021 * 15043021 EJECT 15050021 *=2 REPORT WRITER CONSTANTS 15057021 * AND WORK AREAS 15064021 CTLENT DC 3CL16'0' CTLTBL ENTRY 15071021 DC XL6'0' 6-BYTE FIELD 15078021 RWRENT EQU CTLENT MAIN RPT-WTR TABLE ENTRY 15085021 DETENT DC 3XL16'0' DETAIL TABLE ENTRY 15092021 * 15099021 LVCNT DC X'00' 7-BYTE FIELD 15106021 *CURRENT RD 15113021 CURRD DC 2XL16'0' 15120021 CURRDN EQU CURRD+2 15127021 GRPNCN DC X'2207' GRP.IND CONSTANT 15134021 DC C'GRP.IND' 15141021 DUMENT DC X'0002' DUMMY ENTRY 15148021 DC CL2'N.' FOR SMSTBL 15155021 DRWDSP DS 0H RD-NAME DISP IN RWTBL FOR D 15162021 DC X'0000' 15169021 RRWDSP DS 0H 15176021 DC X'0000' 15183021 RWGCNS DS 0H * MUST STAY * ACCUMULATOR FOR GCNS 15190021 DC X'0000' * TOGETHER * USED FOR RW ROUTINES 15197021 SVJA DS F SAVE JA IN RDGCN ROUTINE 15204021 DETSAV DC H'0' DISPL INTO DETTBL FOR SRCTBL 15211021 SVRDCN DC X'0000' SV RD CDN