ZAP TITLE 'DMSZAP (CMS) VM/370 - RELEASE 6' 00001000 SPACE 2 00002000 *. 00003000 * 00004000 * 00005000 * MODULE NAME: 00006000 * 00007000 * DMSZAP (ZAP) 00008000 * 00009000 * FUNCTION: 00010000 * 00011000 * TO PROVIDE A SUPERZAP LIKE FACILITY TO MAINTAIN CMS 00012000 * LOADLIB, TXTLIB, AND MODULE FILES. 00013000 * 00014000 * ATTRIBUTES: 00015000 * 00016000 * DISK RESIDENT. 00017000 * 00018000 * ENTRY POINTS: 00019000 * 00020000 * DMSZAP - VIA THE COMMAND ZAP 00021000 * 00022000 * ENTRY CONDITIONS: 00023000 * 00024000 * R15 - ADDRESSABILITY 00025000 * R1 - PLIST 00026000 * 00027000 * PLIST: 00028000 * CL8'ZAP' 00029000 * CL8'LOADLIB', 'TXTLIB', OR 'MODULE' 00030000 * CL8'LIBRARY-NAME' FOR TXTLIB OR LOADLIB 00031000 * CL8'LIBRARY-NAME' OPTIONAL 00032000 * CL8'LIBRARY-NAME' OPTIONAL 00033000 * CL8'(' IF OPTIONS DESIRED 00034000 * CL8'TERM' OR 'INPUT FILE-NAME' 00035000 * CL8'PRINT' OR 'NOPRINT' 00036000 * CL8'FFFFFFFF' 00037000 * 00038000 * LIBRARY-NAME - FILENAME(S) OF THE LOADLIB(S) 00039000 * OR TXTLIB(S) CONTAINING THE MEMBER(S) BEING 00040000 * REFERENCED IN THE ZAP CONTROL RECORDS. 00041000 * 00042000 * INPUT - SPECIFIES THE ZAP CONTROL RECORDS ARE 00043000 * TO BE READ FROM 'FILE-NAME' WITH A FILE TYPE 00044000 * OF 'ZAP'. 00045000 * 00046000 * TERM - DEFINES THE ZAP CONTROL RECORDS AS BEING 00047000 * READ FROM THE USERS CONSOLE, THIS IS THE DEFAULT. 00048000 * 00049000 * PRINT - SPECIFIES THAT ZAP CONTROL RECORDS AND 00050000 * MESSAGES ARE TO BE PRINTED ON THE SYSPRINT DEVICE. 00051000 * THIS IS THE DEFAULT. 00052000 * 00053000 * NOPRINT - NO OUTPUT IS TO GO TO THE SYSPRINT 00054000 * DEVICE. 00055000 * 00056000 * EXIT CONDITIONS: 00057000 * 00058000 * NORMAL - RETURN TO CMS VIA R14, R15 = ZERO 00059000 * ERROR - RETURN TO CMS VIA R14, R15= NON-ZERO 00060000 * 00061000 * CALLS TO OTHER ROUTINES: 00062000 * 00063000 * DMSSVT,DMSSMN, DMSFNS, DMSSTT, DMSBWR, DMSBRD, 00064000 * DMSPRT, DMSERR 00065000 * 00066000 * EXTERNAL REFERENCES: 00067000 * 00068000 * NONE 00069000 * 00070000 * TABLES/WORKAREAS: 00071000 * 00072000 * NONE 00073000 * 00074000 * REGISTER USAGE: 00075000 * 00076000 * R1 - INPUT PLIST 00077000 * R2-R8 - WORK 00078000 * R9 - BASE 00079000 * R10 - LINK 00080000 * R11-R12 - BASE 00081000 * R13 - SAVE AREA 00082000 * R14 - RETURN 00083000 * R15 - ERROR RETURN 00084000 * 00085000 * OPREATION: 00086000 * 00087000 * THE INPUT REGISTERS ARE SAVED AND BASE REGISTERS ARE 00088000 * SET. 00089000 * 00090000 * THE COMMAND LINE IS THEN CHECKED FOR ACCURACY AND 00091000 * OPTIONS ARE SET. 00092000 * 00093000 * IF INPUT WAS ONE OF THE OPTIONS, THE INPUT FILE IS 00094000 * LOCATED AND CHECKED FOR PROPER ATTRIBUTES. 00095000 * 00096000 * A CONTROL RECORD IS READ. IF THE PRINT OPTION IS IN 00097000 * EFFECT, THE RECORD IS WRITTEN ON THE SYSPRINT FILE. 00098000 * IF THE NOPRINT AND INPUT OPTIONS HAVE BEEN SPECIFIED, 00099000 * THE INPUT RECORDS ARE DISPLAYED ON THE CONSOLE. THE 00100000 * TYPE OF CONTROL RECORD IS THEN DETERMINED AND CONTROL 00101000 * PASSES TO THE PROPER SUBROUTINE. 00102000 * 00103000 * DUMP CONTROL RECORD: 00104000 * 00105000 * THE MEMBER OR MODULE NAME IS RETRIEVED FROM THE 00106000 * CONTROL RECORD AND A SEARCH IS MADE FOR THE CSECT 00107000 * NAME. IF NO CSECT IS SPECIFIED, THE FIRST CSECT 00108000 * WILL BE DUMPED. IF 'ALL' IS SPECIFIED, THE COMPLETE 00109000 * MEMBER OR MODULE WILL BE DUMPED. IF A CSECT IS 00110000 * SPECIFIED, A SEARCH IS MADE FOR STARTING AND ENDING 00111000 * ADDRESSES. IF THE STARTING ADDRESS IS LOCATED, THE 00112000 * DUMP WILL COMMENCE AT THAT LOCATION. IF NO ENDING 00113000 * ADDRESS IS SPECIFIED, THE COMMAND WILL DUMP THE REST 00114000 * OF THE CSECT. IF NEITHER ADDRESS IS SPECIFIED, THE 00115000 * COMPLETE CSECT WILL BE DUMPED. THE SPECIFIED CSECT 00116000 * IS THEN LOCATED (SEE OPEN ROUTINE) AND THE FILE 00117000 * RECORDS ARE READ AND PRINTED (SEE READ TEXT ROUTINE). 00118000 * 00119000 * NAME CONTROL RECORD: 00120000 * 00121000 * THE MEMBER OR MODULE NAME IS RETRIEVED FROM THE 00122000 * CONTROL RECORD AND A SEARCH IS MADE FOR THE CSECT 00123000 * NAME. IF NO CSECT IS SPECIFIED, THE FIRST CSECT 00124000 * IS ASSUMED THE DESIRED CSECT. THE LIBRARY OR 00125000 * MODULE IS THEN LOCATED AND THE SPECIFIED NAMES ARE 00126000 * FOUND (SEE OPEN ROUTINE). 00127000 * 00128000 * BASE CONTROL RECORD: 00129000 * 00130000 * THE BASE ADDRESS IS RETRIEVED AND A CHECK IS MADE TO 00131000 * DETERMINE THAT THE BASE ADDRESS AGREES WITH A CSECT 00132000 * ADDRESS. IF THE BASE CONTROL RECORD IS BEING USED 00133000 * WITH A MODULE GENERATED WITH THE NOMAP OPTINE, NO 00134000 * CHECK IS MADE. 00135000 * 00136000 * VER AND REP CONTROL RECORDS: 00137000 * 00138000 * CHECKS ARE MADE THAT A NAME CONTROL RECORD HAS BEEN 00139000 * ENTERED AND, IF REP, THE NOGO SWITCH IS OFF. THE 00140000 * DISPLACEMENT AND DATA FIELDS ARE OBTAINED AND COMMAS, 00141000 * IF ANY, ARE REMOVED FROM THE DATA FIELD. THE CSECT 00142000 * STARTING AND ENDING ADDRESSES ARE COMPARED WITH THE 00143000 * DISPLACEMENT ADDRESS AND DATA LENGTH TO VERIFY THE 00144000 * OPERATION IS WHOLLY WITHIN THE CSECT. THE SPECIFIED 00145000 * MEMBER IS THEN READ AND THE OPERATION PERFORMED (SEE 00146000 * READ TEXT ROUTINE). 00147000 * 00148000 * LOG CONTROL RECORD: 00149000 * 00150000 * CHECKS THAT THE REP FUNCTION WAS COMPLETED AS 00151000 * SPECIFIED. IF SO, THE FIX NUMBER IS LOGGED TO 00152000 * A FILE OF 'FILENAME' EQUAL MEMBER NAME AND 00153000 * 'FILETYPE' EQUAL TO THE DEFAULT OF 'ZAPLOG', OR 00154000 * OPTIONALLY SPECIFIED AS THE LOG CONTROL RECORD. 00155000 * IF THE FILE ALREADY EXISTS, THE RECORD IS WRITTEN 00156000 * AS THE FIRST RECORD IN THE FILE. 00157000 * 00158000 * END CONTROL RECORDS: 00159000 * 00160000 * ALL FILES ARE CLOSED, A COMPLETE MESSAGE IS PRINTED, 00161000 * AND CONTROL RETURNS TO CMS. 00162000 * 00163000 * THE OPEN ROUTINE: 00164000 * 00165000 * THE MODULE OR FIRST LIBRARY NAME IS OBTAINED AND A 00166000 * SEARCH IS MADE FOR THE FILE. IF ALL THE SPECIFIED 00167000 * LIBRARIES CANNOT BE LOCATED, PROCESSING TERMINATES. 00168000 * ONCE A LIBRARY HAS BEEN LOCATED, A SEARCH IS MADE 00169000 * FOR THE MEMBER OR, FOR TXTLIBS, THE CSECT NAME 00170000 * SPECIFIED. IF THE NAME CANNOT BE LOCATED, AN ATTEMPT 00171000 * IS MADE TO LOCATE ANOTHER LIBRARY AND REPEAT THE 00172000 * OPERATION. IF THE MEMBER CANNOT BE FOUND OR A MODULE 00173000 * CANNOT BE LOCATED, AN ERROR MESSAGE IS ISSUED AND 00174000 * CONTROL RETURNS TO READ ANOTHER INPUT CONTROL RECORD. 00175000 * ONCE THE MEMBER OR MODULE HAS BEEN LOCATED, A SEARCH 00176000 * IS MADE FOR THE CSECT, IF ONE IS SPECIFIED. IF NO 00177000 * CSECT IS SPECIFIED, THE FIRST CSECT IS ASSUMED. FOR 00178000 * MODULES WITH NO LOADER TABLES, THE COMPLETE MODULE 00179000 * IS TREATED AS ONE CSECT. WHEN THE CSECT IS FOUND, 00180000 * ITS STARTING AND ENDING ADDRESSES ARE SAVED AND 00181000 * CONTROL RETURNS TO THE CALLING ROUTINE. 00182000 * 00183000 * THE READ TEXT ROUTINE: 00184000 * 00185000 * THE FIRST RECORD OF THE MEMBER OR MODULE IS READ AND, 00186000 * IF TXTLIB OR LOADLIB, CHECKED FOR THE PROPER CSECT. 00187000 * IF NOT THE CORRECT CSECT, THE MEMBER'S RECORDS ARE 00188000 * READ UNTIL THE PROPER CSECT IS LOCATED. THE ENDING 00189000 * ADDRESS OF EACH TEXT RECORD IS COMPARED WITH THE 00190000 * DESIRED STARTING POINT OF THE OPERATION AND, IF NOT 00191000 * GREATER THEN THE DESIRED START, THE NEW TEXT RECORD 00192000 * IS READ. WHEN THE PROPER TEXT RECORD IS LOCATED, A 00193000 * TEST IS MADE TO DETERMINE IF THIS IS STARTING OR 00194000 * CONTINUING AN OPERATION. IF CONTINUING AN OPERATION, 00195000 * A FURTHER CHECK IS MADE TO DETERMINE IF THE FIRST 00196000 * BYTE OF THE CURRENT RECORD IMMEDIATELY FOLLOWS THE 00197000 * LAST BYTE OF THE PREVIOUS RECORD. IF NOT, AND THE 00198000 * OPERATION IS VER OR REP, THE OPERATION STOPS. THE 00199000 * DISPLACEMENT WITHIN THE RECORD IS DETERMINED AND THE 00200000 * DESIRED OPERATION IS PERFORMED. 00201000 * 00202000 * FOR VER AND REP OPERATIONS, THE LENGTH OF THE DATA 00203000 * FIELD IS OBTAINED AND THE DATA IS EITHER COMPARED 00204000 * WITH THE RECORD OR MOVED INTO THE RECORD. WHEN THE 00205000 * RECORD OR DATA IS EXHAUSTED AND THE OPERATION IS 00206000 * REP, THE RECORD IS WRITTEN BACK TO THE FILE. THEN 00207000 * THE CONTINUING FLAG IS SET AND ANOTHER RECORD IS READ; 00208000 * OTHERWISE, CONTROL RETURNS TO READ ANOTHER INPUT 00209000 * CONTROL RECORD. 00210000 * 00211000 * FOR DUMP OPERATIONS, A CHECK IS MADE FOR 'ALL'. IF 00212000 * SO, A LINE IS PRINTED WITH THE CSECT NAME BEFORE 00213000 * EACH CSECT IS PRINTED. THE OUTPUT LINE IS THEN SET 00214000 * UP DEPENDING ON WHETHER THE LINE GOES TO THE USER'S 00215000 * CONSOLE OR TO THE PRINTER. THE ADDRESS OF THE 00216000 * CURRENT RECORD IS INSERTED INTO THE LINE AND THE 00217000 * RECORD DATA ARE FORMATTED AND MOVED INTO THE LINE. 00218000 * IF THE LINE IS COMPLETED, THE DATA ARE CONVERTED 00219000 * INTO CHARACTERS AND THE LINE IS PRINTED. IF ANOTHER 00220000 * INPUT RECORD IS REQUIRED TO COMPLETE THE LINE, THE 00221000 * CURRENT LINE POINTERS ARE SAVED AND A NEW RECORD IS 00222000 * READ. IF THE AREA TO BE PRINTED CONTAINS UNDEFINED 00223000 * AREAS (SUCH AS DEFINE STORAGE INSTRUCTIONS), 00224000 * BLANKS ARE INSERTED INTO THE HEXADECIMAL PORTION 00225000 * OF THE DUMP LINE. THE LINE IS THEN PRINTED OR TYPED 00226000 * DEPENDING ON THE PRINT OR NOPRINT OPTION SPECIFIED. 00227000 * WHEN THE SPECIFIED LINES HAVE BEEN PRINTED, 00228000 * CONTROL RETURNS TO READ ANOTHER ZAP CONTROL RECORD. 00229000 *. 00230000 EJECT 00231000 DMSZAP START 0 @V200809 00232000 * 00233000 * SAVE INPUT REGISTERS AND SET ADDRESSABILITY. 00234000 * 00235000 SAVE (14,12) @V200809 00236000 LR R12,R15 SET BASE REG @V200809 00237000 LA R11,4095(,R12) SET SECOND BASE REG @V200809 00238000 LA R11,1(R11) @V200809 00239000 LA R9,4095(,R11) SET THIRD BASE REGISTER @V2A3765 00240000 LA R9,1(,R9) @V2A3765 00241000 * R13 WILL BE SET LATER 00241700 USING DMSZAP,R12,R11,R9,R13 @VA09155 00242400 USING NUCON,R0 @V200809 00243000 ST R13,REGSAVE+4 SET BACKWARD SAVE CHAIN @V200809 00244000 LR R10,R13 @V200809 00245000 LA R13,REGSAVE @V200809 00246000 ST R13,8(,R10) SET FORWARD SAVE CHAIN @V200809 00247000 LA R1,8(R1) INCREMENT TO PLIST @V200809 00248000 DMSKEY NUCLEUS @V305066 00249000 MVC DOSF,DOSFLAGS SAVE FLAGS TEMPORARILY @V305066 00250000 NI DOSFLAGS,255-DOSSVC DISABLE DOSSVC FOR AWHILE @V305066 00251000 DMSKEY RESET @V305066 00252000 * 00253000 * VERIFY COMMAND LINE 00254000 * 00255000 LA R13,4095(,R9) INITIALIZE R13 AS @VA09155 00255300 LA R13,1(,R13) FOURTH BASE REG @VA09155 00255600 BAL R10,SCANLINE @V2A3765 00256000 B INITOPEN @V2A3765 00257000 B NOMORE @V2A3765 00258000 * 00259000 * OPEN INPUT (IF SPECIFIED) AND OUTPUT (PRINTER) FILES 00260000 * 00261000 INITOPEN EQU * @V2A3765 00262000 BAL R10,FDEFINP @V2A3765 00263000 B CONTROL @V2A3765 00264000 B NOMORE @V2A3765 00265000 * 00266000 * READ INPUT CONTROL RECORDS AND PERFORM OPERATIONS 00267000 * 00268000 CONTROL EQU * @V2A3765 00269000 B READINP @V2A3765 00270000 * 00271000 * FINISH UP AND RETURN 00272000 * 00273000 NOMORE EQU * @V2A3765 00274000 SR R15,R15 @V2A3765 00275000 IC R15,ERCODE GET ERROR CODE @V2A3765 00276000 L R13,REGSAVE+4 GET PRIOR SAVE AREA ADDRESS @V2A3765 00277000 DMSEXS MVC,DOSFLAGS,DOSF RESTORE DOSFLAGS @V305066 00278000 RETURN (14,12),RC=(15) @V2A3765 00279000 EJECT 1 00280000 SCANLINE EQU * @V2A3765 00281000 * 00282000 * SCAN INPUT LINE 00283000 * 00284000 ST R10,SCANSAVE SAVE LINK REGISTER @V2A3765 00285000 CLI 0(R1),X'FF' END OF INPUT PLIST? @V200809 00286000 BNE FUNCOK BRANCH IF NOT @V2A3765 00287000 BAL R10,NOFUNC ELSE ILLEGAL FUNCTION @V2A3765 00288000 L R10,SCANSAVE GET LINK REGISTER @V2A3765 00289000 LA R10,4(,R10) INDICATE ERROR @V2A3765 00290000 B ENDSCAN1 @V2A3765 00291000 FUNCOK EQU * @V2A3765 00292000 ST R1,INPLIST SAVE PLIST ADDR @V200809 00293000 LR R2,R1 PLIST IN R2 @V200809 00294000 CLC 0(8,R2),STNAME+8 LOADLIB SPECIFIED? @V2A3765 00295000 BE CHKLIB BRANCH IF YES @V2A3765 00296000 CLC 0(8,R2),MODULE MODULE SPAECIFIED? @V2A3765 00297000 BE YESMOD BRANCH IF YES @V2A3765 00298000 CLC 0(8,R2),TXTLIB TXTLIB SPECIFIED? @V2A3765 00299000 BE GOODFUNC BRANCH IF YES @V2A3765 00300000 BAL R10,INVFUNC ELSE INVALID FUNCTION @V2A3765 00301000 L R10,SCANSAVE GET LINK REGISTER @V2A3765 00302000 LA R10,4(,R10) INDICATE ERROR @V2A3765 00303000 B ENDSCAN1 @V2A3765 00304000 YESMOD EQU * @V2A3765 00305000 OI SWT,ZAPM INDICATE MODULE @V2A3765 00306000 MVC STNAME+8(8),MODULE MOVE IN FILETYPE @V2A3765 00307000 LA R2,8(,R2) POINT TO NEXT PARAMETER @V2A3765 00308000 B CHKPRN @V2A3765 00309000 GOODFUNC EQU * @V2A3765 00310000 OI SWT,ZAPT INDICATE TXTLIB @V2A3765 00311000 MVC STNAME+8(8),TXTLIB MOVE IN TILETYPE @V2A3765 00312000 CHKLIB EQU * @V2A3765 00313000 LA R2,8(R2) INCREMENT TO NEXT PARM @V200809 00314000 CLI 0(R2),X'FF' END OF PLIST? @V2A3765 00315000 BE NOLIB BRANCH IF YES, ERROR @V2A3765 00316000 CLI 0(R2),LFTPRN IS THIS LEFT PARN? @V2A3765 00317000 BNE ONELIB BRANCH IF NOT @V2A3765 00318000 NOLIB EQU * @V2A3765 00319000 BAL R10,MISSLIB ELSE MISSING LIBRARY @V2A3765 00320000 L R10,SCANSAVE GET LINK REGISTER @V2A3765 00321000 LA R10,4(,R10) INDICATE ERROR @V2A3765 00322000 B ENDSCAN1 @V2A3765 00323000 ONELIB EQU * @V200809 00324000 LA R15,LIBNAME1 POINT TO FIRST LIBNAME @V2A3765 00325000 LA R14,3 MAXIMUM OF 3 LIBRARYS @V2A3765 00326000 STLIB EQU * @V2A3765 00327000 ST R2,0(,R15) SAVE LIBRARY ADDRESS @V2A3765 00328000 LA R15,4(,R15) POINT TO NEXT LIBRARY @V2A3765 00329000 LA R2,8(R2) YES, INCREMENT TO NEXT PARM @V200809 00330000 CLI 0(R2),LFTPRN IS THIS LEFT PARN? @V2A3765 00331000 BE CHKOPT YES, CHECK OPTIONS @V2A3765 00332000 CLI 0(R2),X'FF' END OF PLIST? @V2A3765 00333000 BE ENDSCAN BRANCH IF YES @V2A3765 00334000 OI SWT2,MULTLIB NO, INDICATE MULTIPLE LIBS @VM03228 00335000 BCT R14,STLIB DO NEXT LIBRARY @V2A3765 00336000 CHKPRN EQU * @V2A3765 00337000 CLI 0(R2),X'FF' END OF PLIST? @V200809 00338000 BE ENDSCAN BRANCH IF YES @V2A3765 00339000 CLI 0(R2),LFTPRN IS THIS LEFT PARN? @V2A3765 00340000 BE CHKOPT BRANCH IF YES @V2A3765 00341000 BAL R10,INVPARM ELSE INVALID PARAMETER @V2A3765 00342000 L R10,SCANSAVE GET LINK REGISTER @V2A3765 00343000 LA R10,4(,R10) INDICATE ERROR @V2A3765 00344000 B ENDSCAN1 @V2A3765 00345000 CHKOPT EQU * @V2A3765 00346000 LA R15,OPTNUM GET NUMBER OF OPTIONS @V2A3765 00347000 LA R14,OPTTAB POINT TO TABLE @V2A3765 00348000 LA R2,8(,R2) POINT TO OPTION @V2A3765 00349000 CHKOPT1 EQU * @V2A3765 00350000 CLC 0(8,R14),0(R2) IS THIS THE OPTION? @V2A3765 00351000 BE OPTFND BRANCH IF SO @V2A3765 00352000 LA R14,TABENT(,R14) GET NEXT OPTION @V2A3765 00353000 BCT R15,CHKOPT1 AND CHECK IT @V2A3765 00354000 B OPTBAD NO MATCH, ERROR @V2A3765 00355000 OPTFND EQU * @V2A3765 00356000 L R15,TABADDR(,R14) GET ROUTINE ADDRESS @V2A3765 00357000 BALR R10,R15 GO TO ROUTINE @V2A3765 00358000 B OPTBAD BAD OPTION @V2A3765 00359000 B CHKOPT @V2A3765 00360000 OPTEND EQU * @V2A3765 00361000 MVI LIBSWT,INITLIB INITIALIZE LIBSWT @V2A3765 00362000 B ENDSCAN @V2A3765 00363000 OPTBAD EQU * @V2A3765 00364000 BAL R10,INVOPT ELSE INVALID OPTION @V2A3765 00365000 L R10,SCANSAVE GET LINK REGISTER @V2A3765 00366000 LA R10,4(,R10) INDICATE ERROR @V2A3765 00367000 B ENDSCAN1 @V2A3765 00368000 ENDSCAN EQU * @V2A3765 00369000 L R10,SCANSAVE GET LINK REGISTER @V2A3765 00370000 ENDSCAN1 EQU * @V2A3765 00371000 BR R10 @V2A3765 00372000 SPACE 3 00373000 SCANSAVE DS F @V2A3765 00374000 EJECT 1 00375000 * 00376000 * SET INPUT OPTION 00377000 * 00378000 INPTOPT EQU * @V2A3765 00379000 TM LIBSWT,INPUT+CONS SPEC. CONS OR INPUT BEFORE? @V2A3765 00380000 BNZ INPTRT BRANCH IF YES, ERROR @V2A3765 00381000 OI LIBSWT,INPUT INDICATE INPUT @V2A3765 00382000 LA R2,8(,R2) POINT TO INPUT NAME @V2A3765 00383000 CLI 0(R2),X'FF' IS THERE A NAME? @V2A3765 00384000 BE INPTRT BRANCH IF NOT @V2A3765 00385000 ST R2,DDNAME SAVE ADDRESS @V2A3765 00386000 NI SWT,255-CONSOLE REMOVE CONSOLE @V2A3765 00387000 LA R10,4(,R10) GOOD RETURN @V2A3765 00388000 INPTRT EQU * @V2A3765 00389000 BR R10 @V2A3765 00390000 EJECT 1 00391000 * 00392000 * SET CONSOLE OPTION 00393000 * 00394000 CONSOPT EQU * @V2A3765 00395000 TM LIBSWT,INPUT+CONS SPEC. CONS OR INPUT BEFORE? @V2A3765 00396000 BNZ CONSRT BRANCH IF YES, ERROR @V2A3765 00397000 OI LIBSWT,CONS INDICATE CONSOLE @V2A3765 00398000 LA R10,4(,R10) GOOD RETURN @V2A3765 00399000 CONSRT EQU * @V2A3765 00400000 BR R10 @V2A3765 00401000 EJECT 1 00402000 * 00403000 * SET PRINT OPTION 00404000 * 00405000 PRINTOPT EQU * @V2A3765 00406000 TM LIBSWT,PT+NOPT SPEC. PRT OR NOPRT BEFORE? @V2A3765 00407000 BNZ PRINTRT BRANCH IF YES, ERROR @V2A3765 00408000 OI LIBSWT,PT INDICATE PRINT @V2A3765 00409000 LA R10,4(,R10) GOOD RETURN @V2A3765 00410000 PRINTRT EQU * @V2A3765 00411000 BR R10 @V2A3765 00412000 EJECT 1 00413000 * 00414000 * SET NOPRINT OPTION 00415000 * 00416000 NOPRTOPT EQU * @V2A3765 00417000 TM LIBSWT,PT+NOPT SPEC. PRT OR NOPRT BEFORE? @V2A3765 00418000 BNZ NOPRTRT BRANCH IF YES, ERROR @V2A3765 00419000 OI LIBSWT,NOPT INDICATE NOPRINT @V2A3765 00420000 NI SWT,255-PRINT REMOVE PRINT @V2A3765 00421000 LA R10,4(,R10) GOOD RETURN @V2A3765 00422000 NOPRTRT EQU * @V2A3765 00423000 BR R10 @V2A3765 00424000 EJECT 00425000 * 00426000 * FILEDEF INPUT DCB AND OPEN IT 00427000 * 00428000 FDEFINP EQU * @V2A3765 00429000 TM SWT,CONSOLE CONSOLE BEEN SPECIFIED? @V2A3765 00430000 BO FDEFEND BRANCH IF YES @V2A3765 00431000 L R3,DDNAME GET FILENAME @V2A3765 00432000 MVC INFILEN,0(R3) AND INSERT INTO PLIST @V2A3765 00433000 LA R8,INFILEN POINT TO FILENAME @V2A3765 00434000 LA R1,INFUNC POINT TO PLIST @V2A3765 00435000 SVC 202 @V2A3765 00436000 DC AL4(*+4) @V2A3765 00437000 LTR R15,R15 ARE THERE ERRORS? @V2A3765 00438000 BZ INPFND BRANCH IF NOT @V2A3765 00439000 LR R2,R10 SAVE RETURN REGISTER @V2A3765 00440000 BAL R10,LIBNTFD1 GO PRINT MESSAGE @V2A3765 00441000 LA R10,4(,R2) SET ERROR RETURN @V2A3765 00442000 B FDEFEND @V2A3765 00443000 INPFND EQU * @V2A3765 00444000 L R1,INBUF POINT TO FST @V2A3765 00445000 USING FSTSECT,R1 @V2A3765 00446000 MVC INFLGS(1),FSTFV MOVE IN F/V INDICATOR @V2A3765 00447000 CLI INFLGS,C'F' IS FILE FIXED? @V2A3765 00448000 BNE FILENTF ERROR IF NOT @V2A3765 00449000 MVI INFLGS+1,C' ' @V2A3765 00450000 MVC INMODE,FSTM MOVE IN MODE @V2A3765 00451000 MVC INBFSZ(4),FSTIL MOVE IN RECORD SIZE @V2A3765 00452000 DROP R1 @V2A3765 00453000 CLC INBFSZ+2(2),EIGHTY IS RECORD 80 BYTES? @V2A3765 00454000 BNE FILENTF BRANCH IF NOT, ERROR @V2A3765 00455000 LA R15,1 INDICATE 1 ITEM @V2A3765 00456000 STH R15,INNUMR @V2A3765 00457000 LA R15,CDBUF GET INPUT BUFFER @V2A3765 00458000 ST R15,INBUF AND STORE IT @V2A3765 00459000 FDEFEND EQU * @V2A3765 00460000 BR R10 @V2A3765 00461000 EJECT 00462000 * 00463000 * READ CONTROL RECORD FROM INPUT FILE 00464000 * WRITE CONTROL RECORD TO OUTPUT (SYSPRINT) FILE 00465000 * SCAN FIRST KEYWORD FROM CONTROL RECORD 00466000 * 00467000 READINP EQU * @V200809 00468000 MVI LINESWT,X'00' CLEAR LINESWT @V2A3765 00469000 BAL R10,RDCARD GO READ INPUT RECORD @V200809 00470000 BAL R10,WRCARD GO WRITE INPUT RECORD TO SYSPRINT @V200809 00471000 TM SWT,CONSOLE+PRINT INPUT AND NOPRINT? @V2A3765 00472000 BNZ PREPINP BRANCH IF NOT @V2A3765 00473000 BAL R10,PRTCARD GO PRINT CARD @V2A3765 00474000 PREPINP EQU * @V2A3765 00475000 MVI PRTBUF,SPCNTRL SET CARR. CONTROL TO SPACE @V2A3765 00476000 MVI SCANSWT,KEYSCAN INDICATE KEYWORD SCAN @V2A3765 00477000 LA R2,CDBUF POINT TO BUFFER @V2A3765 00478000 LA R3,80 MAXIMUM CARD LENGTH @V2A3765 00479000 BAL R10,SCANKEY1 GO SCAN FOR KEYWORD @V2A3765 00480000 SPACE 1 00481000 LA R10,READINP ERROR MSGS RETURN TO READINP @V2A3765 00482000 TM SCANSWT,RETBLNKS CARD BLANK? @V2A3765 00483000 BCR 1,R10 YES, READ NEXT CARD @V2A3765 00484000 CKLEN EQU * @V200809 00485000 CH R5,SIX LENGTH > 6 ? @V200809 00486000 BH INVEREP YES, ERROR @V200809 00487000 LR R6,R5 LENGTH IN R6 ALSO @V200809 00488000 LA R15,TABNUM LOAD NUMBER OF ENTRIES @V2A3765 00489000 LA R14,TABSTRT AND START OF TABLE @V2A3765 00490000 TABLOOK EQU * @V2A3765 00491000 EX R6,COMNAME COMPARE NAME TO TABLE @V2A3765 00492000 BE NAMFOUND BRANCH IF MATCH @V2A3765 00493000 LA R14,TABENT(,R14) GET NEXT ENTRY @V2A3765 00494000 BCT R15,TABLOOK AND CHECK IT @V2A3765 00495000 B INVEREP NO MORE ENTRIES, ERROR @V2A3765 00496000 NAMFOUND EQU * @V2A3765 00497000 L R10,TABADDR(,R14) GET ADDRESS OF ROUTINE @V2A3765 00498000 BR R10 BRANCH TO ROUTINE @V2A3765 00499000 SPACE 3 00500000 COMNAME CLC 0(0,R14),0(R4) @V2A3765 00501000 EJECT 00502000 * 00503000 * IF KEYWORD IS AN '*' GO READ THE NEXT CONTROL RECORD 00504000 * 00505000 CKAST EQU READINP @V2A3765 00506000 EJECT @V60CE91 00507000 * 00508000 * LOG INFORMATION VERIFICATION ROUTINE 00509000 * 00510000 LOGNOTF TM OPSWT,NOGO ERROR CONDITION ? @V60CE91 00511000 BOR R10 YES...SKIP MESSAGE @V60CE91 00512000 STM R0,R15,AUXSAVE SAVE R10 @V60CE91 00513000 OI SWT2,LOGNHIT+LOGHIT PROCESSING DUMMY LOG @V60CE91 00514000 LA R2,CLOG CARD IN ERROR @VMI0082 00515000 BAL R10,DUMMYLOG LOG MESSAGE @VA10327 00516000 MVC HOLDLINE,CDBUF SAVE CURRENT CARD @VMI0082 00517000 LOGNOTF1 MVC CDBUF(10),=CL10'NONAME' INDICATE DUMMY RECORD @VMI0082 00518000 MVC CDBUF+10(L'CDBUF-10),CDBUF+9 BLANK OUT REC @V60CE91 00519000 LA R1,AUXFSCB @VMI0082 00520000 USING FSCBD,R1 SET UP DSECT @VMI0082 00521000 MVC FSCBBUFF,=A(CDBUF) POINT AT DUMMY CARD @VMI0082 00522000 B NOAUX PUT OUT DUMMY RECORD @V60CE91 00523000 SPACE 2 00524000 LOGRTN EQU * @V60CE91 00525000 OI SWT2,LOGHIT LOG RECORD FOUND @V60CE91 00526000 TM OPSWT,NOGO ERROR CONDITION ? @VMI0082 00527000 BNO LOGRTN1 NO...OK @VMI0082 00528000 LA R8,FLUSHMGL FLUSH CARD @VMI0082 00529000 BAL R10,INVEREP2 PRINT MESSAGE @VMI0082 00530000 B LOGDONE SKIP LOG PROCESSING @VMI0082 00531000 LOGRTN1 TM OPSWT,NAMEHIT+REPOP NAME AND REP DONE? @VMI0082 00532000 BNO LOGERR INDICATE ERROR @VMI0082 00533000 SPACE 2 @VMI0082 00534000 MVI SCANSWT,KEYSCAN INDICATE KEYWORD SCAN @VMI0082 00535000 LTR R3,R3 ANY DATA LEFT @V60CE91 00536000 BZ LOGERRC INDICATE ERROR @VMI0082 00537000 BAL R10,SCANKEY1 GO SCAN FOR NEXT PARM @V60CE91 00538000 TM SCANSWT,RETBLNKS ANY DATA ? @V60CE91 00539000 BO LOGERRC NO, BAD CARD @VMI0082 00540000 CL R5,=A(AUXNUML) PROPER FIX NUMBER ? @V60CE91 00541000 BH LOGERRC NO...ERROR @VMI0082 00542000 LA R1,WORKFSCB POINT AT FSCB @V60CE91 00543000 ST R4,FSCBBUFF POINT PAST 'LOG' @V60CE91 00544000 LTR R3,R3 ANY DATA LEFT @V60CE91 00545000 BZ NOAUX IND NO FT SPECIFIED @V60CE91 00546000 BAL R10,SCANKEY1 GO SCAN FOR NEXT PARM @V60CE91 00547000 TM SCANSWT,RETBLNKS ANY DATA ? @V60CE91 00548000 BO NOAUX IND NO FT SPECIFIED @V60CE91 00549000 CH R5,EIGHT LENGTH GT 8 @V60CE91 00550000 BH LOGERRC YES, TOO BAD @VMI0082 00551000 LA R1,AUXFSCB @V60CE91 00552000 MVC FSCBFT,BLANKS CLEAR OUT DEFAULT NAME @V60CE91 00553000 BCTR R5,0 DECREMENT FOR MOVE @V60CE91 00554000 EX R5,MOVEAUX MOVE IN AUX ID @V60CE91 00555000 SPACE 1 00556000 NOAUX LA R1,AUXFSCB @V60CE91 00557000 MVC FSCBFN,MEMNAME MOVE IN FILENAME @V60CE91 00558000 MVC FSCBFM(1),RDMODE ALSO, GET FILEMODE @VA10327 00558300 MVC WORKFSCB+24(1),RDMODE SAME MODE FOR WORKFILE @VA10327 00558600 MVC AUXFNFT,FSCBFN SAVE FN FT FOR RENAME @V60CE91 00559000 FSERASE FSCB=WORKFSCB ERASE WORK FILE @V60CE91 00560000 FSOPEN FSCB=WORKFSCB,ERROR=WRKOPEN GO OPEN WORK FILE @V60CE91 00561000 SPACE 1 00562000 AUXWRITE EQU * @V60CE91 00563000 LA R1,DTTMBUF PREPARE TO READ CP CLOCK @VA11269 00563300 DC X'8310000C' 'DIAGNOSE' TO READ CLOCK @VA11269 00563600 LA R1,WORKFSCB @VMI0082 00564000 L R4,FSCBBUFF POINT AT RECORD @VMI0082 00565000 MVC AUXDATE(L'CURRDATE+L'CURRTIME,R4),DTTMBUF X00566000 GET DATE AND TIME FOR LOG ENTRY @VA11269 00566100 FSWRITE FSCB=WORKFSCB,ERROR=LOGERR GO WRITE DATA @V60CE91 00567000 MVC FSCBBUFF,=A(CDBUF) @V60CE91 00568000 FSOPEN FSCB=AUXFSCB,ERROR=LOGOPEN GO OPEN FILE @V60CE91 00569000 SPACE 1 00570000 LOGFILL EQU * @V60CE91 00571000 FSREAD FSCB=AUXFSCB,ERROR=AUXRDER READ OLD DATA @V60CE91 00572000 FSWRITE FSCB=WORKFSCB,ERROR=LOGERR GO WRITE DATA @V60CE91 00573000 B LOGFILL GO WRITE RECORD @V60CE91 00574000 SPACE 1 00575000 AUXRDER EQU * @V60CE91 00576000 CH R15,TWELVE END OF FILE ? @VMI0082 00577000 BNE LOGERR INDICATE ERROR @V60CE91 00578000 FSCLOSE FSCB=AUXFSCB,ERROR=LOGERR CLOSE OUTPUT FILE @V60CE91 00579000 SPACE 1 00580000 LOGWRITE EQU * @V60CE91 00581000 FSCLOSE FSCB=WORKFSCB,ERROR=LOGERR CLOSE WORK FILE @V60CE91 00582000 FSERASE FSCB=AUXFSCB @V60CE91 00583000 SPACE 1 00584000 LA R1,AUXFUNC GET ADDRESS OF FUNCTION @V60CE91 00585000 SVC 202 @V60CE91 00586000 DC AL4(LOGERR) @V60CE91 00587000 LOGDONE LA R1,AUXFSCB @V60CE91 00588000 MVC FSCBFT,=CL8'ZAPLOG' DEFAULT NAME @V60CE91 00589000 TM SWT2,LOGNHIT DUMMY LOG ? @V60CE91 00590000 BNO READINP NO...PROCEED @V60CE91 00591000 NI SWT2,X'FF'-LOGNHIT TURN OFF SWITCH @V60CE91 00592000 MVC CDBUF,HOLDLINE RETRIEVE RECORD @VMI0082 00593000 LM R0,R15,AUXSAVE @V60CE91 00594000 BR R10 RETURN TO ROUTINE @V60CE91 00595000 SPACE 1 00596000 WRKOPEN EQU * @V60CE91 00597000 CH R15,AUXNOTF IS IT NOT FOUND ? @V60CE91 00598000 BE AUXWRITE YES, GO WRITE FIRST RECORD @V60CE91 00599000 B LOGERR INDICATE ERROR @V60CE91 00600000 SPACE 1 00601000 LOGOPEN EQU * @V60CE91 00602000 CH R15,AUXNOTF IS IT NOT FOUND ? @V60CE91 00603000 BE LOGWRITE YES, GO DO WRITE ANYWAY @V60CE91 00604000 B LOGERR INDICATE ERROR @V60CE91 00605000 SPACE 1 00606000 LOGERR EQU * @V60CE91 00607000 BAL R10,INVEREP GO PRINT MESSAGE @V60CE91 00608000 B LOGDONE AND CHECK FOR MORE INPUT @V60CE91 00609000 SPACE 1 00610000 LOGERRC BAL R10,INVEREP GO PRINT MESSAGE @VMI0082 00611000 B LOGNOTF1 CREATE DUMMY LINE @VMI0082 00612000 SPACE 1 @VMI0082 00613000 MOVEAUX MVC FSCBFT(*-*),0(R4) EXECUTED FROM ABOVE @V60CE91 00614000 AUXSAVE DC 16F'00' SAVE AREA @V60CE91 00615000 DROP R1 @V60CE91 00616000 EJECT 1 00617000 * 00618000 * GET LOCATION OF DUMP AND PRINT IT 00619000 * 00620000 DUMPREC EQU * @VMI0082 00621000 TM OPSWT,REPOP REP ALREADY PROCESSED? @VA10327 00622000 BNO DUMPREC1 NO...OK @V60CE91 00623000 TM SWT2,LOGHIT FOUND LOG TOO ? @V60CE91 00624000 BO DUMPREC1 YES...OK @V60CE91 00625000 BAL R10,LOGNOTF OTHERWISE WRITE DUMMY RECORD @VA10327 00626000 DUMPREC1 NI SWT2,X'FF'-LOGHIT TURN OFF LOG SWITCH @V60CE91 00627000 MVI OPSWT,DUMPHIT INDICATE DUMP FOUND @V2A3765 00628000 MVI SCANSWT,KEYSCAN INDICATE KEYWORD SCAN @V2A3765 00629000 MVI DUPSWT,X'00' CLEAR DUPSWT @V2A3765 00630000 NI SWT,255-FSTCSECT REMOVE FIRST CSECT @V2A3765 00631000 XC PACKADDS,PACKADDS CLEAR ADDRESS FIELDS @V2A3765 00632000 XC PACKADDE,PACKADDE @V2A3765 00633000 MVC MEMNAME,BLANKS AND CLEAR NAME FIELDS @V2A3765 00634000 MVC CSECTNAM,BLANKS @V2A3765 00635000 LTR R3,R3 END OF CARD? @V2A3765 00636000 BZ DUMPERR BRANCH IF YES @V2A3765 00637000 BAL R10,SCANKEY1 GO SCAN MEMBER NAME @V2A3765 00638000 TM SCANSWT,RETBLNKS WAS REST OF CARD BLANK? @V2A3765 00639000 BO DUMPERR @V2A3765 00640000 CH R5,EIGHT LENGTH > 8? @V2A3765 00641000 BH DUMPERR BRANCH IF YES, ERROR @V2A3765 00642000 BCTR R5,0 @V2A3765 00643000 EX R5,MVEMEM MOVE MEMBER NAME @V2A3765 00644000 LTR R3,R3 END OF CARD @V2A3765 00645000 BZ DMPFSCST BRANCH IF YES, DUMP FIRST @V2A3765 00646000 BAL R10,SCANKEY1 GO SCAN CSECT NAME @V2A3765 00647000 TM SCANSWT,RETBLNKS WAS REST OF CARD BLANK? @V2A3765 00648000 BO DMPFSCST BRANCH IF YES, DUMP FIRST @V2A3765 00649000 CH R5,EIGHT LENGTH > 8? @V2A3765 00650000 BH DUMPERR BRANCH IF YES, ERROR @V2A3765 00651000 CH R5,THREE IS IT 3 CHARACTERS? @V2A3765 00652000 BNE DMPNTALL BRANCH IF NOT @V2A3765 00653000 CLC 0(3,R4),=C'ALL' ALL CSECTS REQUESTED? @V2A3765 00654000 BNE DMPNTALL BRANCH IF NOT @V2A3765 00655000 OI SWT,ALLCSECT+FSTCSECT INDICATE YES @V2A3765 00656000 B DMPCSECT BRANCH IF YES @V2A3765 00657000 DMPNTALL EQU * @V2A3765 00658000 BCTR R5,0 @V2A3765 00659000 EX R5,MVECSECT MOVE CSECT NAME @V2A3765 00660000 LTR R3,R3 END OF CARD? @V2A3765 00661000 BZ DMPCSECT BRANCH IF YES, DUMP CSECT @V2A3765 00662000 MVI SCANSWT,DISPSCAN INDICATE DISPLACEMENT SCAN @V2A3765 00663000 BAL R10,SCANKEY1 GO SCAN START ADDRESS @V2A3765 00664000 TM SCANSWT,RETBLNKS WAS REST OF CARD BLANK? @V2A3765 00665000 BO DMPCSECT JUST DUMP CSECT @V2A3765 00666000 OI DUPSWT,DUPSTRTA INDICATE START ADDRESS @V2A3765 00667000 BAL R10,DECODE1 GO CHECK ADDRESS VALIDITY @V2A3765 00668000 B DUMPEND BAD ADDRESS @V2A3765 00669000 LA R7,ADDRSEND GET END OF ADDRESS FIELD @V2A3765 00670000 LA R14,ADDRS AND ITS START @V2A3765 00671000 LA R15,PACKADDS GET PACK ADDRESS @V2A3765 00672000 BAL R10,PACKVAL GO PACK START ADDRESS @V2A3765 00673000 LTR R3,R3 END OF CARD? @V2A3765 00674000 BZ DMPCSECT BRANCH IF YES, DUMP TO END @V2A3765 00675000 BAL R10,SCANKEY1 GO SCAN END ADDRESS @V2A3765 00676000 TM SCANSWT,RETBLNKS WAS REST OF CARD BLANK? @V2A3765 00677000 BO DMPCSECT BRANCH IF YES, DUMP CSECT @V2A3765 00678000 OI DUPSWT,DUPENDA INDICATE END ADDRESS @V2A3765 00679000 BAL R10,DECODE1 GO CHECK ADDRESS VALIDITY @V2A3765 00680000 B DUMPEND BAD ADDRESS @V2A3765 00681000 LA R7,ADDREEND GET END OF ADDRESS FIELD @V2A3765 00682000 LA R14,ADDREND AND ITS START @V2A3765 00683000 LA R15,PACKADDE GET PACK ADDRESS @V2A3765 00684000 BAL R10,PACKVAL GO PACK END ADDRESS @V2A3765 00685000 L R15,PACKADDE GET END ADDRESS @V2A3765 00686000 LA R15,1(,R15) ADD ONE @V2A3765 00687000 ST R15,PACKADDE AND STORE IT @V2A3765 00688000 C R15,PACKADDS END LOWER THAN START? @V2A3765 00689000 BL DUMPOVLP BRANCH IF YES @V2A3765 00690000 B DMPCSECT @V2A3765 00691000 DUMPERR EQU * @V2A3765 00692000 BAL R10,INVEREP GO PRINT ERROR MESSAGE @V2A3765 00693000 B DUMPEND @V2A3765 00694000 DMPFSCST EQU * @V2A3765 00695000 OI SWT,FSTCSECT INDICATE FIRST CSECT @V2A3765 00696000 DMPCSECT EQU * @V2A3765 00697000 BAL R10,PREOPLIB GO OPEN FILE @V2A3765 00698000 TM LINESWT,FINCSECT CSECTS FINISHED? @V2A3765 00699000 BO DUMPEND BRANCH IF YES @V2A3765 00700000 TM OPSWT,NOGO FILE OPEN OK? @V2A3765 00701000 BO DUMPEND BRANCH IF NOT @V2A3765 00702000 L R15,PACKADDS GET START ADDRESS @V2A3765 00703000 L R14,ESDADD GET CSECT START ADDRESS @V2A3765 00704000 AR R15,R14 ADD STARTS @V2A3765 00705000 TM SWT,ALLCSECT DUMP ALL CSECTS? @V2A3765 00706000 BO STSTART BRANCH IF YES @V2A3765 00707000 TM DUPSWT,DUPSTRTA WAS START ADDRESS SPECIFIED? @V2A3765 00708000 BO CKCSTEND BRANCH IF YES @V2A3765 00709000 STSTART EQU * @V2A3765 00710000 LTR R14,R14 LOAD POINT GREATER THAN ORIGIN? @VA07429 00711000 BM ADCSLEN YES, ADJUST END ADDRESS @VA07429 00712000 ST R14,PACKADDS SAVE CSECT START @V2A3765 00713000 ADCSLEN EQU * @VA07429 00714000 A R14,ESDLEN ADD CSECT LENGTH @V2A3765 00715000 B SETEND GO SET END ADDRESS @V2A3765 00716000 CKCSTEND EQU * @V2A3765 00717000 LTR R14,R14 LOADPOINT GREATER THAN ORIGIN? @VA07429 00718000 BNM COMPEND NO, CHECK CSECT LENGTH @VA07429 00719000 LTR R15,R15 STARTING BELOW LOAD POINT? @VA07429 00720000 BM DUMPOVLP BRANCH IF LOW @VA07429 00721000 COMPEND EQU * @VA07429 00723000 CR R14,R15 IS START WITHIN CSECT? @V2A3765 00724000 BH DUMPOVLP BRANCH IF NOT @V2A3765 00725000 A R14,ESDLEN ADD CSECT LENGTH @V2A3765 00726000 CR R14,R15 CHECK OTHER WAY @V2A3765 00727000 BL DUMPOVLP BRANCH IF OVER @V2A3765 00728000 ST R15,PACKADDS SAVE ADJUSTED START ADDRESS @VA10372 00728500 SETEND EQU * @V2A3765 00729000 TM SWT,ALLCSECT DUMP ALL CSECTS? @V2A3765 00730000 BO SETEND1 BRANCH IF YES @V2A3765 00731000 TM DUPSWT,DUPENDA WAS END ADDRESS SPECIFIED? @V2A3765 00732000 BZ SETEND1 BRANCH IF NOT @V2A3765 00733000 L R15,PACKADDE GET REQUESTED END @V2A3765 00741000 A R15,ESDADD ADD CSECT START @V2A3765 00742000 CR R14,R15 IS END WITHIN CSECT? @V2A3765 00744000 BL DUMPOVLP BRANCH IF NOT @V2A3765 00745000 ST R15,PACKADDE SAVE ADJUSTED END ADDRESS @VA10372 00745500 B GORDTXT @V2A3765 00746000 SETEND1 EQU * @V2A3765 00747000 ST R14,PACKADDE SET END ADDRESS @V2A3765 00748000 GORDTXT EQU * @V2A3765 00749000 MVC PACKDISP(4),PACKADDS SET DISPLACEMENT @V2A3765 00750000 BAL R10,RDTXT GO READ TEXT AND PRINT IT @V2A3765 00751000 TM SWT,ALLCSECT ALL CSECTS? @V2A3765 00752000 BZ DUMPEND BRANCH IF NOT @V2A3765 00753000 B DMPCSECT @V2A3765 00754000 DUMPOVLP EQU * @V2A3765 00755000 LA R8,OVLPMSGL POINT TO ERROR MESSAGE @V2A3765 00756000 BAL R10,INVEREP2 GO PRINT IT @V2A3765 00757000 DUMPEND EQU * @V2A3765 00758000 XC ENDMET,ENDMET CLEAR FIELD FOR DUMPS @VA07318 00759000 NI OPSWT,255-DUMPHIT REMOVE DUMP INDICATOR @V2A3765 00760000 NI SWT,255-ALLCSECT-FSTCSECT REMOVE SETTINGS @V2A3765 00761000 B READINP @V2A3765 00762000 EJECT 00763000 * 00764000 * DETERMAIN IF THIS IS A VER OR REP RECORD AND SCAN THE 00765000 * REST OF THE RECORD. CHECK VALIDITY OF RECORD AND SAVE 00766000 * THE NECESSARY DATA. 00767000 * 00768000 GOODTHRE EQU * @V200809 00769000 TM OPSWT,NAMEHIT HAS A NAME RECORD BEEN FOUND?@V2A3765 00770000 BZ NONAME BRANCH IF NOT @V2A3765 00771000 TM OPSWT,REPOP REP ALREADY PROCESSED? @VA10327 00771100 BNO GOODTHR1 NO @VA10327 00771200 TM OPSWT,NOGO WAS ERROR ENCOUNTERED? @VA10327 00771300 BO GOODTHR1 YES, BYPASS LOG @VA10327 00771400 TM SWT2,LOGHIT WAS IT LOGGED? @VA10327 00771500 BO GOODTHR1 YES @VA10327 00771600 OI SWT2,REPNOLOG INDICATE UNLOGGED REP @VA10327 00771700 GOODTHR1 EQU * @VA10327 00771800 NI OPSWT,255-VEROP-REPOP TURN OFF VER AND REP @V200809 00772000 OI OPSWT,VEROP INDICATE VERIFY OPERATION @V200809 00773000 CLC 0(3,R4),VER IS THIS 'VER' OR 'REP' @V200809 00774000 BE DOVER VERIFY @V200809 00775000 XI OPSWT,VEROP+REPOP REP,TURN OFF VEROP , ON REPOP @V200809 00776000 DOVER EQU * @V200809 00777000 TM OPSWT,VEROP IS THIS VERIFY? @V2A3765 00778000 BO GOOK BRANCH IF YES @V2A3765 00779000 TM OPSWT,NOGO NOGO CONDITION? @V2A3765 00780000 BZ GOOK BRANCH IF NOT @V2A3765 00781000 NONAME EQU * @V2A3765 00782000 LA R8,FLUSHMGL GET MESSAGE ADDRESS @V2A3765 00783000 BAL R10,INVEREP2 GO PRINT MESSAGE @V2A3765 00784000 B ENDVER @V2A3765 00785000 GOOK EQU * @V2A3765 00786000 LTR R3,R3 END OF CARD? @V2A3765 00787000 BZ NODISP BRANCH IF YES @V2A3765 00788000 MVI SCANSWT,DISPSCAN INDICATE DISPLACEMENT SCAN @V2A3765 00789000 BAL R10,SCANKEY1 GO SCAN VER RECORD @V200809 00790000 TM SCANSWT,RETBLNKS REST OF CARD BLANK? @V2A3765 00791000 BZ DECODE BRANCH IF NOT @V2A3765 00792000 NODISP EQU * @V2A3765 00793000 BAL R10,INVEREP GO PRINT MESSAGE @V2A3765 00794000 B ENDVER @V2A3765 00795000 DECODE EQU * @V2A3765 00796000 BAL R10,DECODE1 @V2A3765 00797000 B ENDVER ERROR RETURN @V2A3765 00798000 LA R14,DISP GET DISPLACEMENT ADDRESS @V2A3765 00799000 LA R7,DISPEND @V200809 00800000 LA R15,PACKDISP GET PACKED DISP. ADDRESS @V2A3765 00801000 BAL R10,PACKVAL GO PACK DISPLACEMENT @V2A3765 00802000 LTR R3,R3 END OF CARD? @V2A3765 00803000 BZ NODATA BRANCH IF YES @V2A3765 00804000 MVI SCANSWT,DATASCAN INDICATE DATA SCAN @V2A3765 00805000 BAL R10,SCANKEY1 GO SCAN REST OF RECORD @V200809 00806000 TM SCANSWT,RETBLNKS RECORD BLANK? @V2A3765 00807000 BNO CKCOMMA1 BRANCH IF NOT @V2A3765 00808000 NODATA EQU * @V2A3765 00809000 BAL R10,INVEREP GO PRINT MESSAGE @V2A3765 00810000 B ENDVER @V2A3765 00811000 CKCOMMA1 EQU * @V200809 00812000 CH R5,SEVNTHRE DATA LENGTH > 73? @V200809 00813000 BNH LESS74 BRANCH IF NOT @V2A3765 00814000 BAL R10,INVEREP GO PRINT MESSAGE @V2A3765 00815000 B ENDVER @V2A3765 00816000 LESS74 EQU * @V2A3765 00817000 LA R6,DATA @V200809 00818000 XC DATA(73),DATA CLEAR DATA FIELD @V200809 00819000 CKCOMMA2 EQU * @V200809 00820000 CLI 0(R4),COMMA IS THIS A COMMA? @V200809 00821000 BE CKCOMMA3 YES @V200809 00822000 MVC 0(1,R6),0(R4) MOVE DATA TO DATA SAVE AREA @V200809 00823000 LA R6,1(R6) INCREMENT SAVE AREA ADDR @V200809 00824000 CKCOMMA3 EQU * @V200809 00825000 LA R4,1(R4) INCREMENT DATA ADDR @V200809 00826000 BCT R5,CKCOMMA2 LOOP @V200809 00827000 SPACE 1 00828000 LA R4,DATA @V200809 00829000 SR R6,R4 GET TRUE DATA LENGTH @V200809 00830000 LR R5,R6 PUT IT INTO R5 TOO @V200809 00831000 SRL R6,1 @V200809 00832000 SLL R6,1 IS LENGTH AN EVEN NUMBER? @V200809 00833000 CR R6,R5 IF NOT ERROR @V200809 00834000 BE EQLNTH BRANCH IF EQUAL @V2A3765 00835000 LA R8,ODDIGITL POINT TO MESSAGE @V2A3765 00836000 BAL R10,INVEREP2 GO PRINT MESSAGE @V2A3765 00837000 B ENDVER @V2A3765 00838000 EQLNTH EQU * @V2A3765 00839000 BAL R10,PACKDAT GET DATA PACKED @V2A3765 00840000 LTR R4,R4 FIRST CSECT? @VA07429 00841000 BP VALIDESD NO, VALIDATE ESD @VA07429 00842000 LTR R7,R7 NON-ZERO BASE SPECIFIED? @VA07429 00843000 BNZ BADBASE ERROR IF NON-ZERO @VA07429 00844000 B ADDLEN VERIFY LENGTH @VA07429 00845000 VALIDESD EQU * @VA07429 00846000 SR R4,R7 ESD ADDR= ESD ADDR-BASE @V2A3765 00847000 BM BADBASE BAD IF NEGATIVE @V2A3765 00848000 CR R4,R6 VER DISP WITHIN CSECT? @V2A3765 00849000 BH BADBASE BRANCH IF NOT @V2A3765 00850000 ADDLEN EQU * @VA07429 00851000 A R4,ESDLEN ADD CSECT LENGTH @V2A3765 00852000 LA R5,1(,R5) RESTORE LENGTH @V2A3765 00853000 SRL R5,1 DIVIDE BY 2 @V2A3765 00854000 AR R6,R5 R6 = DISP + VER DATA LENGTH @V2A3765 00855000 CR R4,R6 CHECK FOR OVERLAP OF CSECT @V2A3765 00856000 BNL GOVER BRANCH IF NOT @V2A3765 00857000 BADBASE EQU * @V2A3765 00858000 LA R8,OVLPMSGL GET MESSAGE ADDRESS @V2A3765 00859000 BAL R10,INVEREP2 AND PRINT ERROR @V2A3765 00860000 B ENDVER @V2A3765 00861000 GOVER EQU * @V2A3765 00862000 BAL R10,FINDMEM REPOSITION TO FRONT @V2A3765 00863000 BAL R10,RDTXT GO READ TEXT @V2A3765 00864000 TM SWT2,REPNOLOG REP NOT YET LOGGED? @VA10327 00864250 BNO ENDVER NO @VA10327 00864500 OI OPSWT,REPOP YES, SET REP INDICATOR ON @VA10327 00864750 ENDVER EQU * @V2A3765 00865000 NI SWT2,X'FF'-REPNOLOG RESET INDICATOR @VA10327 00865500 B READINP @V2A3765 00866000 EJECT 1 00867000 PACKDAT EQU * @V2A3765 00868000 BCTR R5,0 @V200809 00869000 EX R5,NORMDATA NORMALIZE DATA @V200809 00870000 TR DATA(73),TRANTBL TRANSLATE DATA @V200809 00871000 XC PACKDATA(37),PACKDATA CLEAR PACK DATA FIELD @V200809 00872000 LA R7,PACKDAED @V200809 00873000 SRL R6,1 DIVIDE BY TWO @V200809 00874000 STC R6,DATALEN SAVE PACKED LENGTH @V200809 00875000 SR R7,R6 @V200809 00876000 PACK2 EQU * @V200809 00877000 PACK 0(2,R7),0(3,R4) PACK VER DATA @V200809 00878000 LA R7,1(R7) INCREMENT @V200809 00879000 LA R4,2(R4) @V200809 00880000 BCT R6,PACK2 LOOP @V200809 00881000 SPACE 1 00882000 L R4,ESDADD LOAD ESD ADDR. @VM08551 00883000 L R6,PACKDISP AND DISP @VM08551 00884000 L R7,PACKBASE AND BASE VALUE @VM08551 00885000 TM OPSWT,BASEHIT IS THERE A BASE RECORD? @VM08551 00886000 BO CALCBASE YES @VM08551 00887000 AR R6,R4 NO, DISP=DISP+ESD ADDR. @VM08551 00888000 SR R7,R7 REMOVE BASE @V2A3765 00889000 ST R6,PACKDISP SAVE REAL DISP @VM08551 00890000 B CALCESD @VM08551 00891000 CALCBASE EQU * @VM08551 00892000 TM SWT,ZAPM+ZAPFM IS THIS MODULE? @VM03228 00893000 BZ LESSBASE BRANCH IF NOT @V2A3765 00894000 TM SWT,ZAPFM PERCHANCE A FIXED MODULE ? @VM03228 00895000 BO ADDBASE BRANCH IF YES @VM03228 00896000 LA R15,DICTHDR POINT TO HEADER RECORD @V2A3765 00897000 USING MDREC,R15 @V2A3765 00898000 CLC MDLDRENT,=H'0' IS THERE A LOADER TABLE? @V2A3765 00899000 BNE LESSBASE BRANCH IF YES @V2A3765 00900000 DROP R15 @V2A3765 00901000 ADDBASE AR R6,R7 DISP = DISP + BASE @VM03228 00902000 ST R6,PACKDISP SAVE REAL DISPLACEMENT @V2A3765 00903000 AR R4,R7 FOR SUBTRACT ON RETURN @V2A3765 00904000 B CALCESD @V2A3765 00905000 LESSBASE EQU * @V2A3765 00906000 SR R6,R7 DISP=DISP-BASE @V2A3765 00907000 CALCESD EQU * @V2A3765 00908000 BR R10 @V2A3765 00909000 SPACE 3 00910000 NORMDATA NC DATA(1),NORMCON @V200809 00911000 EJECT 1 00912000 * 00913000 * PACK SUBMITTED ADDRESSES 00914000 * 00915000 PACKVAL EQU * @V2A3765 00916000 XC 0(6,R14),0(R14) CLEAR NORMALIZED FIELD @V2A3765 00917000 SR R7,R6 GET BEGINNING @V2A3765 00918000 EX R5,DISPMOVE MOVE IN ADDRESS @V2A3765 00919000 EX R5,NORMDISP NORMALIZE IT @V2A3765 00920000 TR 0(6,R14),TRANTBL TRANSLATE @V2A3765 00921000 XC 0(3,R15),0(R15) CLEAR PACK FIELD @V2A3765 00922000 PACK 1(4,R15),0(7,R14) PACK ADDRESS @V2A3765 00923000 BR R10 @V2A3765 00924000 SPACE 3 00925000 DISPMOVE MVC 0(1,R7),0(R4) @V2A3765 00926000 NORMDISP NC 0(1,R7),NORMCON @V2A3765 00927000 EJECT 00928000 * 00929000 * FOR NAME RECORD SCAN RECORD FOR MEMBER-NAME AND CSECT-NAME 00930000 * 00931000 NAMEREC EQU * @V2A3765 00932000 TM OPSWT,REPOP REP ALREADY PROCESSED? @VA10327 00933000 BNO NAMEREC1 NO...OK @V60CE91 00934000 TM SWT2,LOGHIT FOUND LOG TOO ? @V60CE91 00935000 BO NAMEREC1 YES...OK @V60CE91 00936000 BAL R10,LOGNOTF OTHERWISE WRITE DUMMY RECORD @VA10327 00937000 NAMEREC1 NI SWT2,X'FF'-LOGHIT TURN OFF LOG SWITCH @V60CE91 00938000 MVI OPSWT,NAMEHIT INDICATE NAME FOUND @V2A3765 00939000 XC PACKBASE(4),PACKBASE ZERO PACK BASE FIELD @V2A3765 00940000 XC ESDADD(8),ESDADD AND ESD FIELD @V2A3765 00941000 NI SWT,255-FSTCSECT MAKE SURE FSTCSECT SWT OFF @V200809 00942000 MVC MEMNAME(8),BLANKS BLANK OUT @V200809 00943000 MVC CSECTNAM(8),BLANKS @V200809 00944000 LTR R3,R3 END OF CARD? @V2A3765 00945000 BZ NOMEM BRANCH IF YES @V2A3765 00946000 MVI SCANSWT,KEYSCAN FOR KEYWORD SCAN @V2A3765 00947000 BAL R10,SCANKEY1 GO SCAN MEMBER NAME @V200809 00948000 TM SCANSWT,RETBLNKS YES, REST OF CARD BLANK? @V2A3765 00949000 BNO CKLEN2 NO, CONTINUE @V2A3765 00950000 NOMEM EQU * @V2A3765 00951000 BAL R10,INVEREP YES, ERROR @V2A3765 00952000 B ENDNAME @V2A3765 00953000 SPACE 1 00954000 CKLEN2 EQU * @V200809 00955000 CH R5,EIGHT LENGTH > 8 ? @V200809 00956000 BNH CKLEN21 BRANCH IF NOT @V2A3765 00957000 BAL R10,INVEREP > 8 IS ERROR @V2A3765 00958000 B ENDNAME @V2A3765 00959000 CKLEN21 EQU * @V2A3765 00960000 BCTR R5,0 DECREMENT LENGTH BY 1 @V200809 00961000 EX R5,MVEMEM MOVE MEMBER NAME @V200809 00962000 LTR R3,R3 END OF CARD? @V2A3765 00963000 BZ NOCSECT BRANCH IF YES @V2A3765 00964000 BAL R10,SCANKEY1 GO SCAN CSECT NAME @V200809 00965000 TM SCANSWT,RETBLNKS YES, REST OF CARD BLANK? @V2A3765 00966000 BO NOCSECT YES, WILL USE MEMBER NAME @V200809 00967000 CKLEN3 EQU * @V200809 00968000 CH R5,EIGHT LENGTH > 8 ? @V200809 00969000 BNH CKLEN4 BRANCH IF NOT @V2A3765 00970000 BAL R10,INVEREP > 8 IS ERROR @V2A3765 00971000 B ENDNAME @V2A3765 00972000 CKLEN4 EQU * @V2A3765 00973000 BCTR R5,0 DECREMENT @V200809 00974000 EX R5,MVECSECT MOVE CSECT NAME @V200809 00975000 B NOCSECT1 @V2A3765 00976000 NOCSECT EQU * @V200809 00977000 OI SWT,FSTCSECT INDICATE FIRST CSECT FOUND @V200809 00978000 NOCSECT1 EQU * @V2A3765 00979000 BAL R10,PREOPLIB GET READY TO OPEN SYSLIB @V2A3765 00980000 ENDNAME EQU * @V2A3765 00981000 TM OPSWT,NOGO NOGO SWITCH SET? @V2A3765 00982000 BZ ENDNAME1 BRANCH IF NOT @V2A3765 00983000 NI OPSWT,X'FF'-NAMEHIT REMOVE NAME INDICATOR @V2A3765 00984000 ENDNAME1 EQU * @V2A3765 00985000 B READINP @V2A3765 00986000 SPACE 3 00987000 MVEMEM MVC MEMNAME(1),0(R4) @V2A3765 00988000 MVECSECT MVC CSECTNAM(1),0(R4) @V2A3765 00989000 EJECT 1 00990000 * 00991000 * FOR BASE RECORD SCAN FOR DISPLACEMENT 00992000 * 00993000 BASEREC EQU * @V2A3765 00994000 TM OPSWT,NAMEHIT HAS NAME RECORD BEEN FOUND? @V2A3765 00995000 BO SETBASE BRANCH IF YES @V2A3765 00996000 BAL R10,INVEREP GO PRINT MESSAGE @V2A3765 00997000 B ENDBASER @V2A3765 00998000 SETBASE EQU * @V2A3765 00999000 XC BASEVAL(6),BASEVAL ZERO BASE VALUE @V2A3765 01000000 LTR R3,R3 END OF CARD? @V2A3765 01001000 BZ NOBASE BRANCH IF YES @V2A3765 01002000 MVI SCANSWT,DISPSCAN INDICATE DISPLACEMENT SCAN @V2A3765 01003000 BAL R10,SCANKEY1 GO SCAN DISPLACEMENT @V2A3765 01004000 TM SCANSWT,RETBLNKS REST OF CARD BLANK? @V2A3765 01005000 BZ CKBASE BRANCH IF NOT @V2A3765 01006000 NOBASE EQU * @V2A3765 01007000 BAL R10,INVEREP YES, PRINT ERROR MESSAGE @V2A3765 01008000 B ENDBASER @V2A3765 01009000 * 01010000 * PACK BASE VALUE 01011000 * 01012000 CKBASE EQU * @VM08551 01013000 BAL R10,DECODE1 GO TO COMMON CODE @VM08551 01014000 B ENDBASER ERROR RETURN @V2A3765 01015000 LA R7,BASEVEND GET END OF BASE FIELD @VM08551 01016000 LA R14,BASEVAL SET UP REGISTERS @V2A3765 01017000 LA R15,PACKBASE @V2A3765 01018000 BAL R10,PACKVAL AND PACK THEM @V2A3765 01019000 L R4,ESDADD @VM03203 01020000 TM SWT,ZAPM+ZAPFM IS THIS MODULE? @VM03228 01021000 BZ CKBASE1 BRANCH IF NOT @VM03203 01022000 TM SWT,ZAPFM PERCHANCE A FIXED MODULE ? @VM03228 01023000 BO ENDBASE BRANCH IF YES @VM03228 01024000 LTR R4,R4 WAS LOADER TABLE PRESENT? @VM03203 01025000 BZ ENDBASE BRANCH IF NOT @VM03203 01026000 CKBASE1 EQU * @VM03203 01027000 L R6,PACKBASE @VM08551 01028000 CR R4,R6 BASE AND ESD ADDR EQUAL? @VM08551 01029000 BE ENDBASE BRANCH IF YES @V2A3765 01030000 LA R8,INVBAMGL GET MESSAGE ADDRESS @V2A3765 01031000 BAL R10,INVEREP2 AND PRINT ERROR @V2A3765 01032000 B ENDBASER @V2A3765 01033000 ENDBASE EQU * @V2A3765 01034000 OI OPSWT,BASEHIT INDICATE BASE HIT @V2A3765 01035000 ENDBASER EQU * @V2A3765 01036000 B READINP @V2A3765 01037000 EJECT 1 01038000 DECODE1 EQU * @V2A3765 01039000 CH R5,SIX DISP. FIELD > 6? @V2A3765 01040000 BNH DECODE2 BRANCH IF NOT @V2A3765 01041000 LR R6,R10 SAVE RETURN ADDRESS @V2A3765 01042000 BAL R10,INVEREP GO PRINT ERROR @V2A3765 01043000 LR R10,R6 SET ERROR RETURN @V2A3765 01044000 B DECODEND @V2A3765 01045000 DECODE2 EQU * @V2A3765 01046000 LR R6,R5 LENGTH IN R6 ALSO @V2A3765 01047000 SRL R6,1 @V2A3765 01048000 SLL R6,1 IS LENGTH EVEN NUMBER? @V2A3765 01049000 CR R6,R5 IF NOT, ERROR @V2A3765 01050000 BE DECODE3 BRANCH IF EVEN @V2A3765 01051000 LR R6,R10 @V2A3765 01052000 LA R8,ODDIGITL GET MESSAGE ADDRESS @V2A3765 01053000 BAL R10,INVEREP2 GO PRINT ERROR @V2A3765 01054000 LR R10,R6 SET ERROR RETURN @V2A3765 01055000 B DECODEND @V2A3765 01056000 DECODE3 EQU * @V2A3765 01057000 BCTR R5,0 DECREMENT R5 @V2A3765 01058000 LA R10,4(,R10) INDICATE GOOD RETURN @V2A3765 01059000 DECODEND EQU * @V2A3765 01060000 BR R10 @V2A3765 01061000 EJECT 01062000 * 01063000 * OPEN ZAP FILES AND LOOK FOR 'NAME' IF GIVEN 01064000 * 01065000 PREOPLIB EQU * @V200809 01066000 ST R10,PREOPSV SAVE RETURN REGISTER @V2A3765 01067000 NI ECSWT,255-ENDCD RESET END CARD INDICATOR @VA04591 01068000 BAL R10,CLOSELIB INSURE THAT SYSLIB IS CLOSED @V2A3765 01069000 MVI LIBSWT,INITLIB INITIALIZE LIBRARY SWITCH @V2A3765 01070000 TM SWT,ZAPM+ZAPFM IS THIS MODULE? @VM03228 01071000 BZ PREOPLB1 BRANCH IF NOT @V2A3765 01072000 BAL R10,CLRSPCE REMOVE BUFFER SPACE @V2A3765 01073000 LA R6,MEMNAME POINT TO FILENAME @V2A3765 01074000 B PREOPLB2 @V2A3765 01075000 PREOPLB1 EQU * @V2A3765 01076000 LA R5,LIBNAME1 GET FIRST LIB NAME ADDR @V200809 01077000 L R6,0(,R5) @V200809 01078000 PREOPLB2 EQU * @V2A3765 01079000 BAL R10,STFDEF GO DO STATE AND FILEDEF @V200809 01080000 B OPENFILE @V2A3765 01081000 SPACE 1 01082000 * IF STATE IS UNSUCCESSFUL, CONTROL WILL 01083000 * RETURN HERE TO CHECK NEXT LIBRARY NAME 01084000 SPACE 1 01085000 PREOPLB3 EQU * @V200809 01086000 LA R5,4(R5) GET NEXT LIBRARY NAME ADDR. @V200809 01087000 L R6,0(,R5) GET LIB NAME POINTER @V200809 01088000 LTR R6,R6 IS THERE ONE? @V200809 01089000 BNZ PREOPLB5 BRANCH IF YES @V2A3765 01090000 TM SWT,ZAPM+ZAPFM IS THIS MODULE? @VM03228 01091000 BNZ PREOPLB5 BRANCH IF YES @VM03228 01092000 PRE3 TM OPSWT,FILEFND IS THIS A MODULE? @VA03406 01093000 BO MEMNTFND BRANCH IF YES @V2A3765 01094000 LA R8,STNAME GET FILE NAME @V2A3765 01095000 LA R7,STNAME+8 GET FILE TYPE @V2A3765 01096000 BAL R10,LIBNTFD1 GO PRINT MESSAGE @V2A3765 01097000 BAL R10,CLOSINP CLOSE INPUT FILE @V2A3765 01098000 B NOMORE @V2A3765 01099000 PREOPLB5 EQU * @V2A3765 01100000 LA R8,LIBNTFDL POINT TO ERROR MESSAGE @V2A3765 01101000 MVC LIBNTFDN,STNAME MOVE IN FILE NAME @V2A3765 01102000 MVC LIBNTFDT,STNAME+8 MOVE IN FILETYPE @V2A3765 01103000 BAL R10,INVEREP2 GO PRINT MESSAGE @V2A3765 01104000 PRE5 NI OPSWT,255-NOGO REMOVE NOGO SWITCH @VA03406 01105000 TM SWT,ZAPM+ZAPFM IS THIS MODULE? @VM03228 01106000 BNZ MEMERR BRANCH IF YES @VM03228 01107000 SR R7,R7 CLEAR REGISTER @V2A3765 01108000 IC R7,LIBSWT SHIFT LIBRARY SWITCH @V2A3765 01109000 STC R7,LIBSWT SAVE IT @V200809 01110000 B PREOPLB2 GO CHECK NEXT LIBRARY @V200809 01111000 OPENFILE EQU * @V2A3765 01112000 OI OPSWT,FILEFND INDICATE FILE FOUND @V2A3765 01113000 BAL R10,PREOPLB4 OPEN LIBRARY @V2A3765 01114000 TM OPSWT,NOGO WAS NOGO SWITCH SET? @V2A3765 01115000 BO MEMEND BRANCH IF YES @V2A3765 01116000 LTR R15,R15 WAS MEMBER FOUND? @V2A3765 01117000 BZ MEMFND BRANCH IF YES @V2A3765 01118000 BAL R10,CLOSELIB NO, CLOSE LIBRARY @V2A3765 01119000 TM SWT,ZAPM+ZAPFM ZAPPING MODULE FILE? @VM03228 01120000 BZ CHLIBCT BRANCH IF NOT @V2A3765 01121000 LA R8,CSTNTFDL POINT TO MESSAGE @V2A3765 01122000 MVC CSTNTFTY(8),RDTYPE INSERT FILE TYPE @V2A3765 01123000 MVC CSTNTFDM(8),RDNAME INSERT FILE NAME @V2A3765 01124000 BAL R10,INVEREP2 GO PRINT MESSAGE @V2A3765 01125000 B MEMEND @V2A3765 01126000 CHLIBCT EQU * @V2A3765 01127000 TM LIBSWT,MAXLIB @VM03203 01128000 BO MEMNTFND BRANCH IF SO @VM03203 01129000 LA R5,4(,R5) POINT TO NEXT LIBRARY @VM03203 01130000 L R6,0(,R5) LOAD ITS ADDRESS @VM03203 01131000 LTR R6,R6 IS THERE ANOTHER? @VM03203 01132000 BZ PRE3 NO @VM03203 01133000 B PRE5 SET UP TO GET NEXT LIBRARY @VM03203 01134000 MEMNTFND EQU * @VM03203 01135000 LA R8,MEMNTFDL POINT TO MESSAGE @V2A3765 01136000 MVC MEMNTFDM(8),MEMNAME INSERT MEMBER NAME @V2A3765 01137000 BAL R10,INVEREP2 GO PRINT MESSAGE @V2A3765 01138000 B MEMEND @V2A3765 01139000 MEMFND EQU * @V2A3765 01140000 TM SWT2,MULTLIB MORE THAN ONE LIBRARY? @VM03228 01141000 BNO MEMFND2 NO, DON'T WRITE MESSAGE @V2A3765 01142000 MVC CSTFDMGT(8),0(R6) SET MSG LIBRARY NAME @V2A3765 01143000 LA R8,CSTFDMGL @V2A3765 01144000 BAL R10,INVEREP4 PRINT THE MESSAGE @V2A3765 01145000 NI OPSWT,255-NOGO CLEAR NOGO SWITCH @V2A3765 01146000 MEMFND2 EQU * @V2A3765 01147000 TM SWT,ZAPM+ZAPFM MODULE? @VM03228 01148000 BNZ MEMEND BRANCH IF YES @VM03228 01149000 B READCESD AND READ CESD @V2A3765 01150000 MEMERR EQU * @V2A3765 01151000 MVI ERCODE,ERR04 SET ERROR CODE @V2A3765 01152000 MVI OPSWT,NOGO NOGO SWITCH SET @V2A3765 01153000 MEMEND EQU * @V2A3765 01154000 L R10,PREOPSV GET RETURN REGISTER @V2A3765 01155000 BR R10 @V2A3765 01156000 SPACE 3 01157000 PREOPSV DS F @V2A3765 01158000 EJECT 1 01159000 PREOPLB4 EQU * @V200809 01160000 * 01161000 * READ ZAP FILE AND LOCATE MEMBER ( CSECT FOR MODULE 01162000 * IF NAME GIVEN ) 01163000 * 01164000 ST R10,PREOPLBS SAVE RETURN REGISTER @V2A3765 01165000 TM SWT,ZAPM+ZAPFM+ZAPT IS THIS LOADLIB? @VM03228 01166000 BNZ READDICT BRANCH IF NOT @V2A3765 01167000 LA R1,LIBRCD GET BUFFER ADDRESS @V2A3765 01168000 ST R1,RECBUF STORE IN PLIST @V2A3765 01169000 LA R1,LIBLEN GET BUFFER LENGTH @V2A3765 01170000 ST R1,BUFSIZE ALSO IN PLIST @V2A3765 01171000 B READLIB @V2A3765 01172000 READDICT TM SWT,ZAPFM PERCHANCE A FIXED MODULE ? @VM03238 01173000 BO SRCHLDRT BR. IF YES - SKIP THE READ @VM03238 01174000 LA R1,DICTLEN LENGTH OF FIRST RECORD @V2A3765 01175000 ST R1,BUFSIZE PUT IN PLIST @V2A3765 01176000 LA R1,DICTHDR BUFFER ADDRESS @V2A3765 01177000 ST R1,RECBUF ALSO IN PLIST @V2A3765 01178000 READLIB EQU * @V2A3765 01179000 LA R1,RDBUF READ FIRST RECORD @V2A3765 01180000 SVC 202 @V2A3765 01181000 DC AL4(RDLIBERR) @V2A3765 01182000 TM SWT,ZAPM MODULE FILE? @V2A3765 01183000 BZ FINDDICT BRANCH IF NOT @V2A3765 01184000 SRCHLDRT BAL R10,CHKLDTBL GO SEARCH LOADER TABLES (IF ANY) @VM03238 01185000 B ERRFIND CHKLDTBL SETS ERROR CODE @V2A3765 01186000 FINDDICT EQU * @V2A3765 01187000 TM SWT,ZAPT IS THIS TXTLIB? @V2A3765 01188000 BO FNDTXTDC BRANCH IF YES @V2A3765 01189000 CLC LIBRCD(6),=CL6'DMSLIB' IS THIS LIBRARY? @V2A3765 01190000 BNE INVFORM BRANCH IF NOT @V2A3765 01191000 LH R4,LIBRCD+6 GET RECORD NUMBER @V2A3765 01192000 L R10,STATFST GET FST ADDRESS @V2A3765 01193000 USING FSTSECT,R10 @V2A3765 01194000 CLC FSTIC,LIBRCD+6 EXCEED RECORD COUNT? @V2A3765 01195000 BL INVFORM BRANCH IF YES @V2A3765 01196000 DROP R10 @V2A3765 01197000 STH R4,RECNUM STORE IN PLIST @V2A3765 01198000 SR R2,R2 @V2A3765 01199000 L R3,LIBRCD+8 GET TOTAL RECORD SIZE @V2A3765 01200000 LH R1,LIBRCD+12 GET 1 RECORD SIZE @V2A3765 01201000 DR R2,R1 GET NUMBER OF RECORDS @V2A3765 01202000 LR R2,R3 @V2A3765 01203000 SR R8,R8 @V2A3765 01204000 B RECLOOP @V2A3765 01205000 FNDTXTDC EQU * @V2A3765 01206000 CLC DICTID,=CL6'DMSLIB' IS THIS LIBRARY? @V2A3765 01207000 BNE INVFORM BRANCH IF NOT @V2A3765 01208000 LH R4,DICTSTRT GET RECORD NUMBER @V2A3765 01209000 L R10,STATFST GET FST ADDRESS @V2A3765 01210000 USING FSTSECT,R10 @V2A3765 01211000 CLC FSTIC,DICTSTRT EXCEED RECORD COUNT? @V2A3765 01212000 BL INVFORM BRANCH IF YES @V2A3765 01213000 DROP R10 @V2A3765 01214000 STH R4,RECNUM AND STORE IT @V2A3765 01215000 LA R1,LIBRCD BUFFER ADDRESS @V2A3765 01216000 ST R1,RECBUF ALSO IN PLIST @V2A3765 01217000 L R2,DICTNO GET NUMBER OF DICT. RECORDS @V2A3765 01218000 SR R8,R8 @V2A3765 01219000 RECLOOP EQU * @V2A3765 01220000 TM SWT,ZAPT IS THIS TEXTLIB? @V2A3765 01221000 BZ LDLIBN BRANCH IF NOT @V2A3765 01222000 LA R3,DICTNUM GET NUMBER OF ENTRIES/RECORD @V2A3765 01223000 B RDDICT @V2A3765 01224000 LDLIBN EQU * @V2A3765 01225000 LA R3,21 NUMBER OF LOADLIB ENTRIES @V2A3765 01226000 RDDICT EQU * @V2A3765 01227000 LA R1,RDBUF READ DICTIONARY RECORD @V2A3765 01228000 SVC 202 @V2A3765 01229000 DC AL4(RDLIBERR) @V2A3765 01230000 LA R1,LIBRCD POINT TO RECORD @V2A3765 01231000 ENTLOOP EQU * @V2A3765 01232000 BAL R10,CHKMEM CHECK MEMBER NAME @V2A3765 01233000 LTR R15,R15 WAS MEMBER FOUND? @V2A3765 01234000 BZ LOCMEM BRANCH IF YES @V2A3765 01235000 LA R1,DICTENTL(,R1) POINT TO NEXT ENTRY @V2A3765 01236000 BCT R3,ENTLOOP LOOK AT NEXT ENTRY @V2A3765 01237000 LA R4,1(,R4) INCREMENT RECORD NO. @V2A3765 01238000 STH R4,RECNUM AND STORE IT @V2A3765 01239000 BCT R2,RECLOOP LOOK AT NEXT RECORD @V2A3765 01240000 LTR R8,R8 WAS CSECT FOUND? @V2A3765 01241000 BNZ LOCMEM BRANCH IF YES @V2A3765 01242000 LA R15,4 INDICATE MEMBER NOT FOUND @V2A3765 01243000 B ERRFIND @V2A3765 01244000 LOCMEM EQU * @V2A3765 01245000 STH R8,RECNUM STORE RECORD NUMBER @V2A3765 01246000 STH R8,LIBREC AND SAVE IT @V2A3765 01247000 ENDFIND EQU * @V2A3765 01248000 SR R15,R15 INDICATE NO ERROR @V2A3765 01249000 ERRFIND EQU * @V2A3765 01250000 L R10,PREOPLBS GET RETURN REGISTER @V2A3765 01251000 BR R10 @V2A3765 01252000 SPACE 3 01253000 PREOPLBS DS F @V2A3765 01254000 EJECT 1 01255000 * 01256000 * LOCATE CSECT FOR MODULE IF NAME GIVEN 01257000 * 01258000 USING MDREC,R1 @V2A3765 01259000 CHKLDTBL EQU * @V2A3765 01260000 ST R10,LDTBLSV SAVE RETURN REGISTER @V2A3765 01261000 LA R1,DICTHDR POINT TO RECORD @V2A3765 01262000 SR R15,R15 CLEAR REGISTER @V2A3765 01263000 L R3,MDLAST GET MODULE END @V2A3765 01264000 S R3,MDFIRST SUBTRACT BEGINNING @V2A3765 01265000 ST R3,MODLEN AND SAVE LENGTH OF MODULE @V2A3765 01266000 CLC MDLDRENT,=H'0' IS THERE A LOADER TABLE? @V2A3765 01267000 BNE CHKLDCST BRANCH IF YES @V2A3765 01268000 STH R15,RECNUM CLEAR RECORD NUMBER @V2A3765 01269000 TM SWT,FSTCSECT WAS NAME SPECIFIED? @V2A3765 01270000 BZ NOTABLE BRANCH IF YES @V2A3765 01271000 NI SWT,X'FF'-ALLCSECT REMOVE 'ALL' INDICATOR @V2A3765 01272000 B CHKLDERR @V2A3765 01273000 NOTABLE EQU * @V2A3765 01274000 LA R8,NOLDRTBL POINT TO ERROR MESSAGE @V2A3765 01275000 MVC NOLDRTBM,RDNAME MOVE IN NAME @V2A3765 01276000 BAL R10,INVEREP2 GO PRINT MESSAGE @V2A3765 01277000 B CHKLDERR @V2A3765 01278000 CHKLDCST EQU * @V2A3765 01279000 SR R2,R2 CLEAR EVEN REGISTER @V2A3765 01280000 L R15,MODMAX LOAD MAX. RECORD SIZE @V2A3765 01281000 DR R2,R15 DETERMINE NUMBER OF RECORDS @V2A3765 01282000 LTR R2,R2 ANY REMAINDER? @V2A3765 01283000 BZ NOREM BRANCH IF NOT @V2A3765 01284000 LA R3,1(,R3) INCREMENT @V2A3765 01285000 NOREM EQU * @V2A3765 01286000 LA R3,1(,R3) ADD ONE @V2A3765 01287000 AH R3,RECNUM @V2A3765 01288000 L R10,STATFST GET FST ADDRESS @V2A3765 01289000 USING FSTSECT,R10 @V2A3765 01290000 CH R3,FSTIC EQUAL RECORD COUNT? @V2A3765 01291000 BNE INVFORM BRANCH IF NOT @V2A3765 01292000 DROP R10 @V2A3765 01293000 STH R3,RECNUM POINT TO LOADER TABLE @V2A3765 01294000 LA R3,LDRLNTH GET SIZE OF LOADER ENTRY @V2A3765 01295000 MH R3,MDLDRENT TIMES NUMBER OF ENTRIES @V2A3765 01296000 ST R3,BUFSIZE SAVE BUFFERSIZE @V2A3765 01297000 SRL R3,3 DIVIDE BY 8 @V2A3765 01298000 LA R3,1(,R3) ADD ONE @V2A3765 01299000 LH R8,MDLDRENT GET NUMBER OF ENTRIES @V2A3765 01300000 LR R0,R3 LOAD NUM. OF DOUBLE WORDS @V2A3765 01301000 DMSFREE DWORDS=(0),TYPE=USER,ERR=DMSTORE @VA04197 01302000 ST R1,RECBUF SAVE BUFFER AREA @V2A3765 01303000 LA R1,RDBUF READ LOADER TABLE @V2A3765 01304000 SVC 202 @V2A3765 01305000 DC AL4(RDLIBERR) @V2A3765 01306000 DROP R1 @V2A3765 01307000 LR R0,R8 SAVE NUMBER OF ENTRIES @V2A3765 01308000 USING LDRENT,R1 @V2A3765 01309000 L R1,RECBUF POINT TO LOADER TABLE @V2A3765 01310000 LDRLOOP EQU * @V2A3765 01311000 TM LDRFLG2,LDRSECT IS THIS A CSECT? @V2A3765 01312000 BZ LDRNXT BRANCH IF NOT @V2A3765 01313000 CLC LDRNAME,CSECTNAM IS THIS THE NAME? @V2A3765 01314000 BE LDRFIND BRANCH IF YES @V2A3765 01315000 * 01316000 * LOADER TABLE HAS LAST CSECT FIRST, SO FIRST CSECT IS 01317000 * LAST CSECT IN LOADER TABLE. 01318000 * 01319000 LR R15,R1 POINT TO ENTRY @V2A3765 01320000 LDRNXT EQU * @V2A3765 01321000 LA R1,LDRLNTH(,R1) POINT TO NEXT ENTRY @V2A3765 01322000 BCT R8,LDRLOOP LOOK AT NEXT ENTRY @V2A3765 01323000 TM SWT,FSTCSECT+ALLCSECT LOOKING FOR FIRST CSECT? @V2A3765 01324000 BNZ LDRFIND BRANCH IF YES @V2A3765 01325000 L R1,RECBUF FREE THE BUFFER @V2A3765 01326000 LR R0,R3 GET DOUBLE WORD NUMBER @V2A3765 01327000 DMSFRET DWORDS=(0),LOC=(1) @V2A3765 01328000 LA R15,4 INDICATE ERROR @V2A3765 01329000 B CHKLDERR @V2A3765 01330000 LDRFIND EQU * @V2A3765 01331000 TM SWT,FSTCSECT+ALLCSECT WAS CSECT SPECIFIED? @V2A3765 01332000 BZ LDRFIND1 BRANCH IF YES @V2A3765 01333000 LR R1,R15 GET ENTRY ADDRESS @V2A3765 01334000 MVC CSECTNAM(8),LDRNAME MOVE IN CSECT NAME @V2A3765 01335000 TM SWT,ALLCSECT DUMP ALL CSECTS? @V2A3765 01336000 BZ LDRFIND1 BRANCH IF NOT @V2A3765 01337000 OI LINESWT,FRSTLINE INDICATE FIRST LINE @V2A3765 01338000 NI SWT,255-FSTCSECT REMOVE FIRST INDICATOR @V2A3765 01339000 LTR R15,R15 FIND A CSECT? @V2A3765 01340000 BNZ LDRFIND1 BRANCH IF YES @V2A3765 01341000 OI LINESWT,FINCSECT INDICATE END @V2A3765 01342000 B CHKLDERR @V2A3765 01343000 LDRFIND1 EQU * @V2A3765 01344000 L R15,LDRNOTE1 GET CSECT ADDRESS @V2A3765 01345000 LA R15,0(,R15) CLEAR HIGH BYTE @V2A3765 01346000 DROP R1 @V2A3765 01347000 USING MDREC,1 @V2A3765 01348000 LA R1,DICTHDR POINT TO HEADER RECORD @V2A3765 01349000 L R2,MDFIRST GET LOAD POINT @V2A3765 01350000 SR R15,R2 CLEAR LOAD POINT @V2A3765 01351000 ST R15,MODLOC SAVE CSECT ADDRESS @V2A3765 01352000 BAL R10,FNDCLNTH FIND THE CSECT LENGTH @V2A3765 01353000 L R1,RECBUF FREE THE BUFFER @V2A3765 01354000 LR R0,R3 GET DOUBLE WORD NUMBER @V2A3765 01355000 DMSFRET DWORDS=(0),LOC=(1) @V2A3765 01356000 DROP R1 @V2A3765 01357000 SR R15,R15 INDICATE NO ERROR @V2A3765 01358000 CHKLDERR EQU * @V2A3765 01359000 L R10,LDTBLSV GET RETURN REGISTER @V2A3765 01360000 BR R10 @V2A3765 01361000 SPACE 3 01362000 LDTBLSV DS F @V2A3765 01363000 EJECT 1 01364000 * 01365000 * LOCATE BOUNDARY OF CSECT 01366000 * 01367000 USING LDRENT,R1 @V2A3765 01368000 FNDCLNTH EQU * @V2A3765 01369000 SR R15,R15 CLEAR REGISTER @V2A3765 01370000 BCTR R15,0 R15 = FF @V2A3765 01371000 LA R15,0(,R15) CLEAR HIGH BYTE @V2A3765 01372000 LR R8,R15 AND SAVE REGISTER @V2A3765 01373000 L R1,RECBUF POINT TO FIRST LOADER ENTRY @V2A3765 01374000 NXTLDRC EQU * @V2A3765 01375000 TM LDRFLG2,LDRSECT IS THIS A CSECT? @V2A3765 01376000 BZ NXTENT BRANCH IF NOT @V2A3765 01377000 L R14,LDRNOTE1 GET CSECT ADDRESS @V2A3765 01378000 LA R14,0(,R14) CLEAR HIGH BYTE @V2A3765 01379000 SR R14,R2 CLEAR LOAD POINT @V2A3765 01380000 CR R14,R15 LOWER THAN PREVIOUS ENTRY? @V2A3765 01381000 BNL NXTENT BRANCH IF NOT @V2A3765 01382000 C R14,MODLOC HIGHER THAN SPECIFIED CSECT? @V2A3765 01383000 BNH NXTENT BRANCH IF NOT @V2A3765 01384000 LR R15,R14 SAVE CSECT ADDRESS @V2A3765 01385000 NXTENT EQU * @V2A3765 01386000 LA R1,LDRLNTH(,R1) POINT TO NEXT ENTRY @V2A3765 01387000 BCT R0,NXTLDRC LOOK AT NEXT ENTRY @V2A3765 01388000 CR R8,R15 WAS CSECT BOUNDARY FOUND? @V2A3765 01389000 BNE BNDRYFND BRANCH IF YES @V2A3765 01390000 DROP R1 @V2A3765 01391000 L R15,MODLEN GET MODULE ENDING ADDRESS @V2A3765 01392000 BNDRYFND EQU * @V2A3765 01393000 S R15,MODLOC SUBTRACT SPECIF. CSECT ADDR. @V2A3765 01394000 ST R15,MODLEN STORE CSECT LENGTH @V2A3765 01395000 BR R10 AND RETURN @V2A3765 01396000 EJECT 1 01397000 * 01398000 * CHECK FOR MEMBER OR, IF CMS TXTLIB, CSECT 01399000 * 01400000 USING DICTENT,R1 @V2A3765 01401000 CHKMEM EQU * @V2A3765 01402000 LR R15,R12 MAKE R15 NONZERO @V2A3765 01403000 CLI DICTTYPE,X'00' IS THIS A MEMBER? @V2A3765 01404000 BNE CHKCSECT BRANCH IF NOT @V2A3765 01405000 CLC MEMNAME,DICTNAME IS THIS THE NAME? @V2A3765 01406000 BNE CHKCSECT BRANCH IF NOT @V2A3765 01407000 SR R15,R15 INDICATE MEMBER FOUND @V2A3765 01408000 LH R8,DICTINDX GET INDEX NUMBER @V2A3765 01409000 B CHKMEMND @V2A3765 01410000 * 01411000 * IF THIS IS A CMS ONLY TXTLIB, THERE WILL BE NO 01412000 * MEMBER NAMES. THEREFORE, EVERY ENTRY WILL BE 01413000 * CHECKED FOR A MATCH ON THE SUPPLIED CSECT AND, IF 01414000 * FOUND, THE CSECT WILL BE ASSUMED THE WANTED 01415000 * MEMBER. 01416000 * 01417000 CHKCSECT EQU * @V2A3765 01418000 TM SWT,ZAPT IS THIS A TXTLIB? @V2A3765 01419000 BZ CHKMEMND BRANCH IF NOT, DONE @V2A3765 01420000 LTR R8,R8 HAS TEMP. CSECT BEEN FOUND? @V2A3765 01421000 BNZ CHKMEMND BRANCH IF YES @V2A3765 01422000 TM SWT,FSTCSECT FIRST CSECT TO BE USED? @V2A3765 01423000 BO CHKMEMND BRANCH IF YES @V2A3765 01424000 CLC CSECTNAM,DICTNAME IS THIS THE CSECT? @V2A3765 01425000 BNE CHKMEMND BRANCH IF NOT @V2A3765 01426000 LH R8,DICTINDX GET CSECT RECORD NUMBER @V2A3765 01427000 CHKMEMND EQU * @V2A3765 01428000 BR R10 @V2A3765 01429000 DROP R1 @V2A3765 01430000 EJECT 1 01431000 * 01432000 * PRINT THE REQUESTED DUMP 01433000 * 01434000 PRTDUMP EQU * @V2A3765 01435000 ST R10,PRTR10 SAVE RETURN REGISTER @V2A3765 01436000 ST R8,R8SAVE SAVE POINTER @V2A3765 01437000 TM OPSWT,VERINP IS THIS FIRST ENTRY? @V2A3765 01438000 BO PRTDUMP1 BRANCH IF NOT @V2A3765 01439000 AR R5,R2 ADD LENGTH OF RECORD @V2A3765 01440000 ST R5,RECEND SAVE END OF RECORD @V2A3765 01441000 B PRTFIRST @V2A3765 01442000 PRTDUMP1 EQU * @V2A3765 01443000 C R5,RECEND END EQUAL START? @V2A3765 01444000 BE FINRES BRANCH IF YES @V2A3765 01445000 BL DORG THIS IS AN ORG BACK @VA04197 01446000 BAL R10,SETBLANK GO SET DS BLANKS @V2A3765 01447000 TM LINESWT,LSTLNPRT LAST LINE PRINTED? @V2A3765 01448000 BZ FINRES BRANCH IF NOT @V2A3765 01449000 NI LINESWT,255-LSTLNPRT REMOVE LAST LINE IND. @V2A3765 01450000 B PRTRDNXT DONE @V2A3765 01451000 FINRES EQU * @V2A3765 01452000 AR R5,R2 ADD LENGTH OF RECORD @V2A3765 01453000 ST R5,RECEND SAVE END OF RECORD @V2A3765 01454000 BAL R10,FINLINE GO FINISH LINE @V2A3765 01455000 B PRTRDNXT END OF FILE @VA04197 01456000 PRTFIRST EQU * @VA04197 01457000 BAL R10,NEWLIN GO PRINT FULL LINES @VA04197 01458000 PRTRDNXT EQU * @VA04197 01459000 L R10,PRTR10 GET BAL ADDRESS @VA04197 01460000 BR R10 AND RETURN @VA04197 01461000 SPACE 3 @VA04197 01462000 PRTR10 DS F @VA04197 01463000 R8SAVE DS F @VA04197 01464000 EJECT 1 @VA04197 01465000 * @VA04197 01466000 * ROUTINE TO POSITION ORG BACKS @VA04197 01467000 * @VA04197 01468000 DORG AR R5,R2 UPDATE NEW RECORD END @VA04197 01469000 ST R5,RECEND @VA04197 01470000 ST R7,LOOPSAVE+20 SAVE DATA SIZE IN CASE @VA04197 01471000 BAL R10,PRTLINE PRINT THIS LINE AS IS @VA04197 01472000 LA R1,1 INITIALIZE BUMP VALUE @VA04197 01473000 TM SWT,PRINT IS THIS A FULL LINE @VA04197 01474000 BZ DORGA NO @VA04197 01475000 AR R1,R1 DOUBLE BUMP VALUE @VA04197 01476000 DORGA SLL R1,4 TIMES 16 @VA04197 01477000 L R15,RECENDA GET NEW START DISPLACEMENT @VA04197 01478000 L R10,PACKADDS GET CURRENT ADDRESS @VA04197 01479000 CR R10,R15 CURRENT ADDRESS OK @VA04197 01480000 BNH DORGCC YES @VA04197 01481000 DORGB SR R10,R1 MINUS BUMP VALUE @VA04197 01482000 BZ DORGC CANNOT LOWER ANYMORE @VA04197 01483000 CR R15,R10 LOW ENOUGH YET @VA04197 01484000 BL DORGB NO, REDUCE AGAIN @VA04197 01485000 DORGC ST R10,PACKADDS THIS IS WHERE WE START @VA04197 01486000 DORGCC NI OPSWT,255-VERINP RESET INTERUPTED LINE @VA04197 01487000 OI ECSWT,ORGCD INDICATE AN ORG BACK @VA04197 01488000 ST R10,ORGADD SAVE NEW START DISPLACEMENT @VA04197 01489000 B PRTFIRST GO DO IT @VA04197 01490000 EJECT 1 @VA04197 01491000 * @VA04197 01492000 * ROUTINE TO POSITION DUMP LINE AT PROPER SPOT ON @VA04197 01493000 * OUTPUT LINE @VA04197 01494000 * @VA04197 01495000 DORGD EQU * @VA04197 01496000 ST R10,ORG10SV SAVE RETURN REGISTER @VA04197 01497000 CLC PACKADDS,PACKADDE IS THIS END OF CSECT? @VA04179 01498000 BL DORGDA BRANCH IF NOT @VA04197 01499000 TM ECSWT,EOCSORG ORG FOUND AT END OF CSECT? @VA09155 01499300 BO DORGDA YES, NOT LAST LINE @VA09155 01499600 OI LINESWT,LASTLINE INDICATE LAST @VA04197 01500000 DORGDA AR R5,R15 UPDATE CHAR POINTER @VA04197 01501000 AR R15,R15 DOUBLE FOR PRT BUFFER @VA04197 01502000 AR R14,R15 UPDATE PRT BUFFER POINTER @VA04197 01503000 SR R10,R10 @VA04197 01504000 SRL R15,1 HALF TO ORIGINAL VALUE @VA04197 01505000 DORGE S R15,=F'4' SEE HOW MANY SLOTS OVER @VA04197 01506000 BM DORGF COUNT FINISHED @VA04197 01507000 LA R10,1(0,R10) BUMP SLOT COUNTER @VA04197 01508000 LA R14,2(0,R14) BUMP PRT POSITION POINTER @VA04197 01509000 B DORGE @VA04197 01510000 DORGF ST R5,LOOPSAVE+16 ALSO PRT CHAR POSITION @VA04197 01511000 LA R1,1 @VA04197 01512000 TM SWT,PRINT IS THIS A FULL LINE @VA04197 01513000 BZ DORGG NO, ONLY ONE PASS @VA04197 01514000 LA R1,1(0,R1) MAKE TWO PASSES @VA04197 01515000 DORGG LH R15,FOUR SET UP INITIAL LOOP COUNT @VA04197 01516000 TM ECSWT,NEWCT NEW CSECT @VA04197 01517000 BZ DORGGG @VA04197 01518000 SR R6,R6 @VA04197 01519000 ST R2,LOOPSAVE+20 SET UP LENGTH @VA04197 01520000 DORGGG SR R15,R10 @VA04197 01521000 ST R15,LOOPSAVE+4 SAVE INITIAL LOOP COUNT @VA04197 01522000 BP DORGH LOOP COUNT OK AS IS @VA04197 01523000 AH R15,FOUR CORRECT THE LOOP COUNT @VA04197 01524000 BCTR R1,0 DECREMENT SECOND PASS COUNT @VA04197 01525000 LA R14,2(0,R14) OVER 2D HALF SEPARATOR @VA04197 01526000 ST R15,LOOPSAVE+4 THIS IS THE CORRECT LOOP COUNT @VA04197 01527000 DORGH ST R1,LOOPSAVE+8 SET UP PASS COUNT @VA04197 01528000 ST R14,LOOPSAVE SET UP PRT BUFFER POINTER @VA04197 01529000 L R1,PACKDISP GET NEW END DISPLACEMENT @VA07636 01530000 TM SWT,ZAPM ZAP MODULE? @VA08997 01530200 BO DORGI YES, CONTINUE @VA08997 01530400 L R1,RECENDA GET END DISPLACEMENT @VA08997 01530600 DORGI EQU * @VA08997 01530800 S R1,ORGADD MINUS LINE START ADDRESS @VA04197 01531000 DORGJ SH R1,FOUR CALC RESIDUAL COUNT @VA04197 01532000 BP DORGJ TRY AGAIN @VA04197 01533000 BZ DORGK @VA04197 01534000 AH R1,FOUR RESTORE COUNT @VA04197 01535000 DORGK ST R1,LOOPSAVE+12 @VA04197 01536000 OI OPSWT,VERINP INDICATE INTERRUPTED LINE @VA04197 01537000 NI ECSWT,255-ORGCD-NEWCT RESET ORG BACK SWITCH @VA04197 01538000 XC ORGADD(4),ORGADD @VA04197 01539000 L R10,ORG10SV RESTORE RETURN REGISTER @VA04197 01540000 BR R10 AND RETURN @VA04197 01541000 ORG10SV DC F'0' @VA04197 01542000 ORGCT DC F'0' SLOT COUNTER @VA04197 01543000 ORGADD DC F'0' @VA04197 01544000 PACKSAVE DC F'0' @VA04197 01545000 EJECT @VA04197 01546000 * 01547000 * ROUTINE TO PRINT FULL LINES 01548000 * 01549000 NEWLIN EQU * @V2A3765 01550000 ST R10,NEWR10 @V2A3765 01551000 NEWLINE EQU * @V2A3765 01552000 SR R4,R4 CLEAR CONVERT REGISTER @V2A3765 01553000 LA R14,CDBUF GET BUFFER ADDRESS @V2A3765 01554000 MVI CDBUF,C' ' @V2A3765 01555000 MVC CDBUF+1(132),CDBUF CLEAR THE PRINT AREA @V2A3765 01556000 TM LINESWT,FRSTLINE IS THIS THE FIRST LINE? @V2A3765 01557000 BZ NOFSTLN BRANCH IF NOT @V2A3765 01558000 BAL R10,PRTHDR GO PRINT HEADER @V2A3765 01559000 NOFSTLN EQU * @V2A3765 01560000 TM ECSWT,ORGCD ORG BACK FOUND @VA04197 01561000 BZ NOBLNKL NO @VA04197 01562000 BAL R10,PRTLINE PRINT A BLANK SEPARATOR LINE @VA04197 01563000 LA R14,CDBUF RESET OUTPUT BUFFER PTR @VA04197 01564000 NOBLNKL EQU * @VA04197 01565000 TM SWT,PRINT IS THIS FULL LINE? @V2A3765 01566000 BZ SETFORCN BRANCH IF NOT @V2A3765 01567000 LA R1,2 INDICATE FULL LINE @V2A3765 01568000 MVI CDBUF+98,C'*' PUT START DELIMITER @V2A3765 01569000 LA R5,CDBUF+99 POINT TO CHARACTER SECTION @V2A3765 01570000 MVI CDBUF+131,C'*' PUT END DELIMITER @V2A3765 01571000 B SETADD @V2A3765 01572000 SETFORCN EQU * @V2A3765 01573000 LA R1,1 INDICATE HALF LINE @V2A3765 01574000 MVI PRTBUF+58,C'*' PUT START DELIMITER @V2A3765 01575000 LA R5,PRTBUF+59 POINT TO CHARACTER SECTION @V2A3765 01576000 MVI PRTBUF+75,C'*' PUT END DELIMITER @V2A3765 01577000 LA R14,3(,R14) SET BUFFER ADDRESS @V2A3765 01578000 SETADD EQU * @V2A3765 01579000 LA R15,PACKADDS POINT TO ADDRESS @V2A3765 01580000 UNPK HEXUNPK(9),0(5,R15) UNPACK ADDRESS @V2A3765 01581000 NC HEXUNPK(8),NORMCON NORMALIZE @V2A3765 01582000 TR HEXUNPK(8),TRANTBL AND TRANSLATE IT @V2A3765 01583000 MVC 0(8,R14),HEXUNPK MOVE ADDRESS INTO LINE @V2A3765 01584000 LA R14,12(,R14) POINT TO NEXT AVAILABLE BYTE @V2A3765 01585000 L R15,PACKADDS GET THE ADDRESS @V2A3765 01586000 ST R15,PACKSAVE @VA04197 01587000 LR R7,R1 GET LINE SIZE @V2A3765 01588000 SLL R7,4 MULTIPLY BY 16 @V2A3765 01589000 LA R15,0(R7,R15) UPDATE ADDRESS @V2A3765 01590000 ST R15,PACKADDS AND SAVE IT @V2A3765 01591000 TM ECSWT,ORGCD+NEWCT ORG BACK ENCOUNTERED @VA04197 01592000 BZ SETADDA NO @VA04197 01593000 L R15,PACKDISP GET START DISPLACEMENT @VA07636 01594000 TM SWT,ZAPM ZAP MODULE? @VA08997 01594200 BO SETADDC YES,CONTINUE @VA08997 01594400 L R15,RECENDA GET START DISPLACEMENT @VA08997 01594600 SETADDC EQU * @VA08997 01594800 S R15,PACKSAVE MINUS LINE ADDRESS @VA04197 01595000 BZ SETADDB MODIFIED PRT LINE @VA04197 01596000 SETADDD CR R15,R7 BIGGER THAN MAX LINE @VA04197 01597000 BL CALDORGD NO, GO SET LINE START @VA04197 01598000 BE SETADDA @VA04197 01599000 BAL R10,PRTLINE GO PRINT A 'DSLINE' @VA04197 01600000 LA R14,CDBUF RESET OUTPUT BUFFER PTR @VA04197 01601000 B NOBLNKL SET UP NEXT LINE @VA04197 01602000 CALDORGD EQU * @VA04197 01603000 BAL R10,DORGD POSITION LINE @VA04197 01604000 TM LINESWT,DSLINE IS THIS DS SPACING? @VA04197 01605000 BO NEWEOR1 BRANCH IF YES @VA04197 01606000 BAL R10,FINLINE GO FINISH LINE @VA04197 01607000 B NEWEOR1 BRANCH IF END OF FILE @VA04197 01608000 B NEWLINE PRINT NEW LINES @VA04197 01609000 SETADDB NI ECSWT,255-ORGCD-NEWCT RESET ORG BACK FLAG @VA04197 01610000 SETADDA EQU * @VA04197 01611000 SPACE 01611100 *********************************************************************** 01611180 * * 01611260 * PROCESSING OF TXTLIB RECORDS IS COMPLETED AT CSECT END * 01611340 * EXCEPT WHEN AN ORG IS INCLUDED AT THE END ADDRESS. * 01611420 * TO DETECT THIS EXCEPTION THE RECORD POINTER IS ADJUSTED * 01611500 * TEMPORARILY TO ALLOW READING THE NEXT RECORD. * 01611580 * * 01611660 *********************************************************************** 01611740 SPACE 01611820 STH R1,LNINDSAV SAVE LINE INDICATOR SETTING @VA09155 01611900 OI LINESWT,LASTLINE INDICATE LAST LINE @V2A3765 01612000 L R15,PACKADDS RESTORE VALUE @VA04197 01613000 S R15,PACKADDE IS THIS LAST LINE? @V2A3765 01614000 BM SETNTLST BRANCH IF NOT @V2A3765 01615000 TM SWT,ZAPT DUMPING A TXTLIB? @VA09155 01615100 BNO ENDCSECT NO, END OF CSECT @VA09155 01615160 TM DUPSWT,DUPSTRTA DUMPING PART OF CSECT? @VA09155 01615220 BO ENDCSECT YES, NO SEARCH FOR ORG BACK @VA09155 01615280 TM ECSWT,ENDCD END CARD ENCOUNTERED? @VA09155 01615340 BO ENDCSECT YES, DON'T TEST FOR MORE TEXT @VA09155 01615400 TM ECSWT,EOCSORG ORG FOUND AT END OF CSECT? @VA09155 01615460 BO SETNTLST YES, TURN OFF LAST LINE FLAG @VA09155 01615520 SR R10,R10 CLEAR REGISTER @VA09155 01615580 ICM R10,M3,RECNUM CURRENT TEXT RECORD POINTER @VA09155 01615640 LA R10,1(R10) POINT TO NEXT RECORD @VA09155 01615700 L R15,RECEND END ADDRESS OF CURRENT TEXT @VA09155 01615760 S R15,PACKADDE LOWER THAN END OF CSECT? @VA09155 01615820 BNM TRECNUM NO, END OF DATA IF NO ORG FOUND @VA09155 01615880 LA R10,1(10) NOT EOD, INCREASE RECORD NUMBER @VA09155 01615940 TRECNUM EQU * @VA09155 01616000 STH R10,RECNUM SET TEMPORARY RECORD POINTER @VA09155 01616060 BAL R10,RDLIB READ THE RECORD @VA09155 01616120 SR R10,R10 CLEAR REGISTER @VA09155 01616180 ICM R10,M3,RECNUM GET RECORD NUMBER @VA09155 01616240 BCTR R10,0 RETURN TO PRECEDING RECORD @VA09155 01616300 L R15,RECEND GET END ADDRESS OF CURRENT TEXT @VA09155 01616360 S R15,PACKADDE LESS THAN END OF CSECT? @VA09155 01616420 BNM CRECNUM NO, POINTER IS AT CURRENT RECORD @VA09155 01616480 BCTR R10,0 READJUST RECORD POINTER @VA09155 01616540 CRECNUM EQU * @VA09155 01616600 STH R10,RECNUM RESTORE RECORD NUMBER @VA09155 01616660 CLC TXTREC,LIBRCD WAS FOLLOWING RECORD 'TXT'? @VA09155 01616720 BNE ENDCSTXT NO, END OF TEXT @VA09155 01616780 CLC LIBRCD+14(2),CSECTID+2 SAME CSECT ID? @VA09155 01616840 BNE ENDCSTXT NO, NEXT CSECT READ @VA09155 01616900 SR R10,R10 CLEAR REGISTER @VA09155 01616960 ICM R10,M7,LIBRCD+5 GET NEXT TEXT DISPLACEMENT @VA09155 01617020 S R10,PACKADDE WITHIN ESD LIMIT? @VA09155 01617080 BNM ENDCSTXT NO, END OF CSECT @VA09155 01617140 OI ECSWT,EOCSORG INDICATE ORG AT END OF CSECT @VA09155 01617200 BAL R10,RDLIB READ CURRENT TEXT RECORD BACK IN @VA09155 01617260 B SETNTLST TURN OFF LAST LINE FLAG @VA09155 01617320 ENDCSTXT EQU * @VA09155 01617380 BAL R10,RDLIB RESTORE LAST TEXT RECORD @VA09155 01617440 ENDCSECT EQU * @VA09155 01617500 L R15,PACKADDS RESTORE START DISPLACEMENT @VA09155 01617560 S R15,PACKADDE COMPARE WITH ESD LIMIT @VA09155 01617620 BE SETHFLN BRANCH IF EQUAL @V2A3765 01617680 SR R7,R15 GET LENGTH @V2A3765 01617740 LR R15,R7 PUT INTO R15 @V2A3765 01618000 AR R15,R6 ADD CURRENT FILE POINTER @V2A3765 01619000 CR R15,R2 EXCEED RECORD SIZE? @V2A3765 01620000 BH SETHFLN @V2A3765 01621000 LR R2,R15 SET RECORD SIZE @V2A3765 01622000 OI LINESWT,LASTREC INDICATE LAST RECORD @V2A3765 01623000 B SETHFLN @V2A3765 01624000 SETNTLST EQU * @V2A3765 01625000 NI LINESWT,255-LASTLINE NOT LAST LINE @V2A3765 01626000 SETHFLN EQU * @V2A3765 01627000 LH R1,LNINDSAV RESTORE LINE INDICATOR @VA09155 01627300 SETHFLN1 EQU * @VA09155 01627600 LA R15,4 FOUR PRINT BLOCKS/HALF PAGE @V2A3765 01628000 BAL R10,SETHXLN GO SET UP LINE @V2A3765 01629000 B NEWEOR @V2A3765 01630000 BCT R1,SETHFLN1 DO SECOND HALF OR FALL THRU @VA09155 01631000 BAL R10,CHARCONV GO CONVERT NON-PRINT CHARS. @V2A3765 01632000 BAL R10,PRTLINE GO PRINT LINE @V2A3765 01633000 TM LINESWT,LASTLINE IS THIS LAST LINE? @V2A3765 01634000 BO NEWEOR1 BRANCH IF YES @V2A3765 01635000 B NEWLINE @V2A3765 01636000 NEWEOR EQU * @V2A3765 01637000 TM LINESWT,LASTREC LAST RECORD? @V2A3765 01638000 BZ NEWEOR1 BRANCH IF NOT @V2A3765 01639000 BAL R10,PRTLINE GO PRINT LINE @V2A3765 01640000 NI OPSWT,255-VERINP REMOVE IN PROGRESS IND. @V2A3765 01641000 NI LINESWT,255-LASTREC REMOVE LAST REC. IND. @V2A3765 01642000 OI LINESWT,LSTLNPRT SET LAST LINE PRINTED @V2A3765 01643000 NEWEOR1 EQU * @V2A3765 01644000 L R10,NEWR10 GET RETURN ADDRESS @V2A3765 01645000 NEWEND EQU * @V2A3765 01646000 BR R10 @V2A3765 01647000 SPACE 3 01648000 NEWR10 DS F @V2A3765 01649000 LNINDSAV DC H'0' @VA09155 01649500 EJECT 1 01650000 * 01651000 * ROUTINE TO PRINT DUMP LINE 01652000 * 01653000 PRTLINE EQU * @V2A3765 01654000 ST R10,PRTLINR SAVE RETURN ADDRESS @V2A3765 01655000 TM DUPSWT,DUPMSG IS THIS DUP MESSAGE? @V2A3765 01656000 BO PRTLIN2 BRANCH IF YES @V2A3765 01657000 LA R14,CDBUF POINT TO OUTPUT BUFFER @V2A3765 01658000 LA R15,132 FULL OUTPUT LINE @V2A3765 01659000 TM SWT,PRINT PRINT OPTION? @V2A3765 01660000 BO CHKDUP BRANCH IF YES @V2A3765 01661000 LA R14,3(,R14) POINT TO TRUE LINE @V2A3765 01662000 LA R15,129 LINE LESS 3 @V2A3765 01663000 CHKDUP EQU * @V2A3765 01664000 TM DUPSWT,DUPFRST IS THIS FIRST LINE? @V2A3765 01665000 BZ PRTLIN1 BRANCH IF YES @V2A3765 01666000 CLC 12(80,R14),HOLDLINE SAME AS PREVIOUS? @V2A3765 01667000 BNE NOTDUP BRANCH IF NOT @V2A3765 01668000 TM DUPSWT,DUPHELD HAS LINE BEEN HELD? @V2A3765 01669000 BO CHKLAST BRANCH IF YES @V2A3765 01670000 MVC FRSTADDR,2(R14) SAVE STARTING ADDRESS @V2A3765 01671000 OI DUPSWT,DUPHELD INDICATE LINE HELD @V2A3765 01672000 CHKLAST EQU * @V2A3765 01673000 TM LINESWT,LASTLINE IS THIS THE LAST LINE? @V2A3765 01674000 BZ PRTLINEN BRANCH IF NOT @V2A3765 01675000 OI DUPSWT,DUPEND INDICATE END @V2A3765 01676000 MVC 2(6,R14),=CL6'FINISH' INDICATE END @V2A3765 01677000 NOTDUP EQU * @V2A3765 01678000 TM DUPSWT,DUPHELD HAS LINE BEEN HELD? @V2A3765 01679000 BZ PRTLIN1 BRANCH IF NOT @V2A3765 01680000 MVC SECDADDR,2(R14) MOVE IN STOP ADDRESS @V2A3765 01681000 CLC SECDADDR(6),=CL6' ' ALL BLANKS @VA04197 01682000 BNE FINOK NO, OK AS IS @VA04197 01683000 MVC SECDADDR(6),=CL6'FINISH' @VA04197 01684000 FINOK EQU * @VA04197 01685000 OI DUPSWT,DUPMSG INDICATE DUP MESSAGE @V2A3765 01686000 MVC HOLDLINE,PRTBUF SAVE NEW LINE @V2A3765 01687000 EX R15,MVPRTBUF MOVE IN MESSAGE @V2A3765 01688000 MVC PRTLINRA,PRTLINR SAVE RETURN ADDRESS @V2A3765 01689000 NI DUPSWT,255-DUPHELD REMOVE LINE HELD IND. @V2A3765 01690000 BAL R10,PRTLINE PRINT DUP MESSAGE @V2A3765 01691000 NI DUPSWT,255-DUPMSG REMOVE DUP SWITCH @V2A3765 01692000 MVC PRTLINR,PRTLINRA RESTORE RETURN REGISTER @V2A3765 01693000 TM DUPSWT,DUPEND END OF DUMP? @V2A3765 01694000 BZ NDUPEND NO @VA04197 01695000 NI DUPSWT,255-DUPEND CLEAR END SWITCH @VA04197 01696000 B PRTLINEN @VA04197 01697000 NDUPEND EQU * @VA04197 01698000 MVC PRTBUF(134),HOLDLINE RESTORE LINE @V2A3765 01699000 PRTLIN1 EQU * @V2A3765 01700000 MVC HOLDLINE(80),12(R14) SAVE OUTPUT LINE @V2A3765 01701000 OI DUPSWT,DUPFRST INDICATE FIRST LINE @V2A3765 01702000 PRTLIN2 EQU * @V2A3765 01703000 TM SWT,PRINT PRINT OPTION? @V2A3765 01704000 BZ TYPLINE BRANCH IF NOT, GO TYPE @V2A3765 01705000 BAL R10,WRCARD GO PRINT LINE @V2A3765 01706000 B PRTLINEN @V2A3765 01707000 TYPLINE EQU * @V2A3765 01708000 LA R7,84 GET MAXIMUM LENGTH @V2A3765 01709000 STH R7,PRTBUF AND STORE IT @V2A3765 01710000 LA R1,PRTBUF POINT TO WTO LIST @V2A3765 01711000 WTO MF=(E,(1)) AND TYPE IT @V2A3765 01712000 PRTLINEN EQU * @V2A3765 01713000 L R10,PRTLINR GET RETURN ADDRESS @V2A3765 01714000 BR R10 @V2A3765 01715000 SPACE 3 01716000 PRTLINR DS F @V2A3765 01717000 PRTLINRA DS F @V2A3765 01718000 MVPRTBUF MVC 0(1,R14),DUPMSGN @V2A3765 01719000 EJECT 1 01720000 * 01721000 * FINISH STARTED DUMP LINE 01722000 * 01723000 FINLINE EQU * @V2A3765 01724000 ST R10,FINR10 SAVE RETURN REGISTER @V2A3765 01725000 LM R14,R15,LOOPSAVE GET LOOP REGISTERS @V2A3765 01726000 L R1,LOOPSAVE+8 @V2A3765 01727000 L R5,LOOPSAVE+16 GET CHARACTER POINTER @V2A3765 01728000 L R7,LOOPSAVE+20 @V2A3765 01729000 L R0,LOOPSAVE+12 GET RESIDUAL COUNT @V2A3765 01730000 SR R4,R4 @V2A3765 01731000 TM ECSWT,ENDCD CHECK FOR END CARD @VA09155 01731200 BNO LSTLNTST IF NOT END, TEST FOR LAST LINE @VA09155 01731400 OI LINESWT,LASTLINE INDICATE LAST LINE @VA09155 01731600 LSTLNTST EQU * @VA09155 01731800 TM LINESWT,LASTLINE @V2A3765 01732000 BZ CHKCNT BRANCH IF NOT @V2A3765 01733000 LR R10,R6 GET RECORD START @V2A3765 01734000 AR R10,R7 ADD REMAINING CHARS. @V2A3765 01735000 CR R10,R2 EXCEED RECORD LENGTH @V2A3765 01736000 BH CHKCNT BRANCH IF NOT @V2A3765 01737000 LR R2,R10 SET MAXIMUM @V2A3765 01738000 OI LINESWT,LASTREC INDICATE LAST RECORD @V2A3765 01739000 CHKCNT EQU * @V2A3765 01740000 LTR R0,R0 ANY COUNT? @V2A3765 01741000 BZ FINLIN1 BRANCH IF NOT @V2A3765 01742000 LH R10,FOUR COMPUTE NUMBER OF BYTES TO @V2A3765 01743000 SR R10,R0 BE INSERTED INTO BLOCK @V2A3765 01744000 TM LINESWT,LASTLINE IS THIS LAST LINE? @V2A3765 01745000 BZ CHKFILL BRANCH IF NOT @V2A3765 01746000 C R10,PACKADDS EXCEED REQUEST? @V2A3765 01747000 BL CHKFILL BRANCH IF NOT @V2A3765 01748000 L R10,PACKADDS GET REMAINDER @V2A3765 01749000 CHKFILL EQU * @V2A3765 01750000 CR R2,R10 WILL LENGTH FILL BLOCK? @V2A3765 01751000 BL FINLIN1 BRANCH IF NOT @V2A3765 01752000 NI OPSWT,255-VERINP REMOVE IN PROGRESS IND. @V2A3765 01753000 SLL R10,1 REMAINING TIMES 2 @V2A3765 01754000 TM LINESWT,DSLINE IS THIS DS SPACE? @V2A3765 01755000 BZ FINREAL BRANCH IF NOT @V2A3765 01756000 LA R14,2(R10,R14) ADD SPACES SKIPPED AND SPACING @V2A3765 01757000 SRL R10,1 @V2A3765 01758000 B FINBLOCK BRANCH IF YES @V2A3765 01759000 FINREAL EQU * @V2A3765 01760000 BCTR R10,0 @V2A3765 01761000 EX R0,PARTUNPK UNPACK REMAINING CHARS. @V2A3765 01762000 EX R0,PARTNC NORMALIZE @V2A3765 01763000 EX R0,PARTTR TRANSLATE @V2A3765 01764000 EX R10,MOVEUNPK MOVE REMAINING CHARS. @V2A3765 01765000 LA R10,1(,R10) RESTORE REMAINING BYTES @V2A3765 01766000 LA R14,2(R10,R14) UPDATE BLOCK POINTER @V2A3765 01767000 SRL R10,1 @V2A3765 01768000 AR R8,R10 INCREMENT RECORD POINTER @V2A3765 01769000 FINBLOCK EQU * @V2A3765 01770000 AR R6,R10 INCREMENT FILE POINTER @V2A3765 01771000 AR R4,R10 UPDATE CHARACTER POINTER @V2A3765 01772000 BCTR R15,0 DECREMENT FOR PREVIOUS BAL @V2A3765 01773000 LTR R15,R15 WAS IT END OF 4-BLOCK AREA? @V2A3765 01774000 BNZ FINLIN1 BRANCH IF NOT @V2A3765 01775000 LA R14,2(,R14) SET BLOCK SEPARATOR @V2A3765 01776000 B FINLIN2 @V2A3765 01777000 FINLIN EQU * @V2A3765 01778000 LA R15,4 @V2A3765 01779000 FINLIN1 EQU * @V2A3765 01780000 BAL R10,SETHXLN GO FINISH 4-BLOCK AREA @V2A3765 01781000 B FINEND ERROR RETURN @V2A3765 01782000 FINLIN2 EQU * @V2A3765 01783000 BCT R1,FINLIN DO SECOND HALF OR FALL THRU @V2A3765 01784000 L R10,PACKADDS CHECK IF ALL DONE @VA04197 01785000 S R10,PACKADDE @VA04197 01786000 BNM FINEND ALL DONE @VA04197 01787000 BAL R10,CHARCONV GO CONVERT NON-PRINT CHARS. @V2A3765 01788000 BAL R10,PRTLINE GO PRINT LINE @V2A3765 01789000 NI OPSWT,255-VERINP REMOVE IN PROGRESS IND. @V2A3765 01790000 L R10,FINR10 GET RETURN REGISTER @V2A3765 01791000 LA R10,4(,R10) INDICATE GOOD RETURN @V2A3765 01792000 B FINENDD @V2A3765 01793000 FINEND EQU * @V2A3765 01794000 TM LINESWT,LASTLINE IS THIS THE LAST LINE? @V2A3765 01795000 BZ FINENDR BRANCH IF NOT @V2A3765 01796000 NI OPSWT,255-VERINP REMOVE IN PROGRESS IND. @V2A3765 01797000 OI LINESWT,LSTLNPRT INDICATE LINE PRINTED @V2A3765 01798000 BAL R10,PRTLINE PRINT PARTIAL LINE @V2A3765 01799000 FINENDR EQU * @V2A3765 01800000 L R10,FINR10 GET RETURN ADDRESS @V2A3765 01801000 FINENDD EQU * @V2A3765 01802000 BR R10 @V2A3765 01803000 SPACE 3 01804000 FINR10 DS F @V2A3765 01805000 DS 0F @V2A3765 01806000 LOOPSAVE DC 6F'0' @V2A3765 01807000 PARTUNPK UNPK HEXUNPK(9),0(5,R8) @V2A3765 01808000 PARTNC NC HEXUNPK(8),NORMCON @V2A3765 01809000 PARTTR TR HEXUNPK(8),TRANTBL @V2A3765 01810000 MOVEUNPK MVC 0(0,R14),HEXUNPK @V2A3765 01811000 EJECT 1 01812000 * 01813000 * SET UP DUMP LINE 01814000 * 01815000 SETHXLN EQU * @V2A3765 01816000 LA R6,4(,R6) UPDATE FILE POINTER @V2A3765 01817000 LA R2,0(,R2) CLEAR HIGH ORDER BYTE @VA03364 01818000 CR R6,R2 REACH END OF RECORD? @V2A3765 01819000 BNH SETHXLN1 BRANCH IF NOT @V2A3765 01820000 LA R2,4(,R2) UPDATE REGISTER @V2A3765 01821000 SR R2,R6 GET RESIDUAL COUNT @V2A3765 01822000 LTR R2,R2 WAS THERE RESIDUAL? @V2A3765 01823000 BZ SETHXFIN BRANCH IF NOT @V2A3765 01824000 AR R4,R2 UPDATE CHARACTER POINTER @V2A3765 01825000 LR R6,R2 GET RESIDUAL @V2A3765 01826000 SLL R6,1 TIMES 2 @V2A3765 01827000 TM LINESWT,DSLINE IS THIS DS SPACE? @V2A3765 01828000 BO SETHXLNA BRANCH IF YES @V2A3765 01829000 BCTR R6,0 DECREMENT @V2A3765 01830000 EX R0,PARTUNPK UNPACK REMAINING CHARS. @V2A3765 01831000 EX R0,PARTNC NORMALIZE @V2A3765 01832000 EX R0,PARTTR TRANSLATE @V2A3765 01833000 EX R6,MOVEUNPK MOVE REMAINING CHARS. @V2A3765 01834000 LA R6,1(,R6) INCREMENT @V2A3765 01835000 SETHXLNA EQU * @V2A3765 01836000 AR R14,R6 ADD CHARACTERS MOVED @V2A3765 01837000 SETHXFIN EQU * @V2A3765 01838000 STM R14,R15,LOOPSAVE SAVE LOOP REGISTERS @V2A3765 01839000 LTR R4,R4 ANYTHING TO CONVERT? @V2A3765 01840000 BZ SETHXNPR BRANCH IF NOT @V2A3765 01841000 LR R0,R10 SAVE RETURN REGISTER @V2A3765 01842000 BAL R10,CHARCONV GO CONVERT PARTIAL LINE @V2A3765 01843000 LR R10,R0 GET RETURN REGISTER @V2A3765 01844000 LA R4,1(,R4) INCREMENT CHARACTER COUNT @V2A3765 01845000 AR R5,R4 UPDATE CHARACTER POINTER @V2A3765 01846000 SETHXNPR EQU * @V2A3765 01847000 TM OPSWT,VERINP IS THIS PARTIAL? @V2A3765 01848000 BZ SETHXNPS BRANCH IF NOT @V2A3765 01849000 L R0,LOOPSAVE+12 GET PREVIOUS PARTIAL @V2A3765 01850000 AR R2,R0 ADD CURRENT PARTIAL @V2A3765 01851000 SETHXNPS EQU * @V2A3765 01852000 ST R5,LOOPSAVE+16 @V2A3765 01853000 SR R7,R4 GET REMAINING COUNT @V2A3765 01854000 ST R7,LOOPSAVE+20 @V2A3765 01855000 STM R1,R2,LOOPSAVE+8 @V2A3765 01856000 OI OPSWT,VERINP INDICATE IN PROGRESS @V2A3765 01857000 TM ECSWT,ENDCD WAS THE END CARD FOUND @VA04591 01858000 BO SETHXLN1 @VA04591 01859000 B SETHXLND @V2A3765 01860000 SETHXLN1 EQU * @V2A3765 01861000 TM LINESWT,DSLINE IS THIS DS SPACE? @V2A3765 01862000 BO SETHXLN2 BRANCH IF YES @V2A3765 01863000 UNPK HEXUNPK(9),0(5,R8) CONVERT DATA @V2A3765 01864000 NC HEXUNPK(8),NORMCON NORMALIZE @V2A3765 01865000 TR HEXUNPK(8),TRANTBL TO HEXADECIMAL @V2A3765 01866000 MVC 0(8,R14),HEXUNPK MOVE TO PRINTER BUFFER @V2A3765 01867000 LA R8,4(,R8) POINT TO NEXT DATA @V2A3765 01868000 SETHXLN2 EQU * @V2A3765 01869000 LA R4,4(,R4) @V2A3765 01870000 LA R14,10(,R14) UPDATE POINTER @V2A3765 01871000 BCT R15,SETHXLN GO DO NEXT @V2A3765 01872000 LA R14,2(,R14) SPACE FOR SECOND HALF @V2A3765 01873000 LA R10,4(,R10) INDICATE GOOD RETURN @V2A3765 01874000 SETHXLND EQU * @V2A3765 01875000 BR R10 @V2A3765 01876000 SPACE 3 01877000 EJECT 1 01878000 * 01879000 * CONVERT NON-PRINTING CHARACTERS 01880000 * 01881000 CHARCONV EQU * @V2A3765 01882000 BCTR R4,0 @V2A3765 01883000 TM LINESWT,DSLINE IS THIS DS SPACE? @V2A3765 01884000 BO CHAREND BRANCH IF YES @V2A3765 01885000 L R15,R8SAVE GET FILE POINTER @V2A3765 01886000 EX R4,PRTMOVE MOVE CHARACTERS TO LINE @V2A3765 01887000 EX R4,PRTTRAN CONVERT NON-PRINTING CHARS. @V2A3765 01888000 LA R15,1(R4,R15) UPDATE FILE POINTER @V2A3765 01889000 ST R15,R8SAVE AND STORE IT @V2A3765 01890000 CHAREND EQU * @V2A3765 01891000 BR R10 @V2A3765 01892000 SPACE 3 01893000 PRTMOVE MVC 0(0,R5),0(R15) @V2A3765 01894000 PRTTRAN TR 0(0,R5),PRINTBL @V2A3765 01895000 EJECT 1 01896000 * 01897000 * ROUTINE TO PRINT DUMP CSECT NAME 01898000 * 01899000 PRTHDR EQU * @V2A3765 01900000 ST R10,PRTHDRR SAVE RETURN REGISTER @V2A3765 01901000 ST R1,PRTHDRR+4 @V2A3765 01902000 LA R14,PRTBUF+4 GET PRINT LINE @V2A3765 01903000 BAL R10,PRTLINE DO A BLANK LINE @VA04197 01904000 LA R14,PRTBUF+4 @VA04197 01905000 MVC 0(14,R14),CSCTHDRM MOVE IN MESSAGE @V2A3765 01906000 MVC 14(8,R14),CSECTNAM MOVE IN CSECT NAME @VA04197 01907000 MVC 24(5,R14),CSECTL MOVE IN LENGTH WORD @VA04197 01908000 L R15,PACKADDE GET END OF CSECT @VA04197 01909000 S R15,PACKDISP MINUS START OF CSECT @VA04197 01910000 ST R15,PACKSIZE PUT IT SOMEWHERE @VA04197 01911000 LA R15,PACKSIZE POINT AT IT @VA04197 01912000 UNPK HEXUNPK(9),0(5,R15) UNPACK ADDRESS @VA04197 01913000 NC HEXUNPK(8),NORMCON NORMALIZE @VA04197 01914000 TR HEXUNPK(8),TRANTBL AND TRANSLATE IT @VA04197 01915000 LA R1,7 @VA04197 01916000 LA R10,HEXUNPK @VA04197 01917000 CKZERO CLI 0(R10),X'F0' IS IT A LEADING ZERO @VA04197 01918000 BNE LNMOVE NO, GO MOVE LENGTH FIELD @VA04197 01919000 LA R10,1(0,R10) @VA04197 01920000 BCT R1,CKZERO CHECK SOME MORE @VA04197 01921000 LNMOVE EX R1,MOVELN MOVE THE LENGTH FIELD @VA04197 01922000 BAL R10,PRTLINE GO PRINT LINE @VA04197 01923000 L R1,PRTHDRR+4 @V2A3765 01924000 MVI PRTBUF+4,C' ' CLEAR LINE @V2A3765 01925000 MVC PRTBUF+5(40),PRTBUF+4 @VA04197 01926000 LA R14,CDBUF POINT TO LINE @VA04197 01927000 BAL R10,PRTLINE DO A BLANK LINE @VA04197 01928000 L R15,PACKADDS GET LINE ADDRESS @VA04197 01929000 LH R14,MASK TRANSFORM BOUNDRY @VA04197 01930000 TM SWT,PRINT FULL LINE @VA04197 01931000 BZ SMALLINE @VA04197 01932000 SLL R14,1 ADJUST MASK FOR FULL LINE @VA04197 01933000 SMALLINE NR R15,R14 @VA04197 01934000 ST R15,PACKADDS SET NEW LINE ADDRESS @VA04197 01935000 LA R14,CDBUF @VA04197 01936000 L R10,PRTHDRR RESTORE RETURN REGISTER @VA04197 01937000 L R1,PRTHDRR+4 @VA04197 01938000 OI ECSWT,NEWCT FORCE A CHECK OF START POSITION @VA04197 01939000 NI LINESWT,255-LASTREC-LASTLINE-LSTLNPRT @VA04197 01940000 NI DUPSWT,255-DUPFRST REMOVE FIRST INDICATOR @VA04197 01941000 NI LINESWT,255-FRSTLINE REMOVE FIRST LINE IND. @V2A3765 01942000 BR R10 @V2A3765 01943000 SPACE 3 01944000 MOVELN MVC 29(0,R14),0(R10) @VA04197 01945000 PACKSIZE DC F'0' @VA04197 01946000 MASK DC H'-16' @VA04197 01947000 PRTHDRR DS 2F @V2A3765 01948000 EJECT 1 01949000 * 01950000 * ROUTINE TO SPACE OVER DS 01951000 * 01952000 SETBLANK EQU * @V2A3765 01953000 ST R10,DSR10SAV SAVE RETURN REGISTER @V2A3765 01954000 ST R8,DSR8SAVE SAVE REAL RECORD POINTERS @V2A3765 01955000 ST R2,DSR2SAVE @V2A3765 01956000 STM R5,R6,DSR5SAVE @V2A3765 01957000 S R5,RECEND COMPUTE DS BYTES @V2A3765 01958000 OI LINESWT,DSLINE INDICATE DS @V2A3765 01959000 LR R2,R5 GET LENGTH OF DS @V2A3765 01960000 SR R6,R6 @V2A3765 01961000 TM OPSWT,VERINP IN PROGRESS? @V2A3765 01962000 BZ SETLINE BRANCH IF NOT @V2A3765 01963000 BAL R10,FINLINE GO FINISH LINE @V2A3765 01964000 B SETPOINT GO GET REAL RECORD POINTERS @V2A3765 01965000 SETLINE EQU * @V2A3765 01966000 BAL R10,NEWLIN GO PRINT LINES @V2A3765 01967000 SETPOINT EQU * @V2A3765 01968000 L R8,DSR8SAVE LOAD REAL RECORD POINTERS @V2A3765 01969000 LM R5,R6,DSR5SAVE @V2A3765 01970000 L R2,DSR2SAVE @V2A3765 01971000 L R10,DSR10SAV @V2A3765 01972000 NI LINESWT,255-DSLINE REMOVE DS INDICATOR @V2A3765 01973000 BR R10 @V2A3765 01974000 SPACE 3 01975000 DSR2SAVE DS F @V2A3765 01976000 DSR5SAVE DS 2F @V2A3765 01977000 DSR8SAVE DS F @V2A3765 01978000 DSR10SAV DS F @V2A3765 01979000 EJECT 1 01980000 * 01981000 * READ CESD RECORD OF MEMBER 01982000 * 01983000 READCESD EQU * @V2A3765 01984000 XC ENDCNT,ENDCNT CLEAR NUMBER OF END CARDS @VA07108 01985000 SR R7,R7 CLEAR R7 @V200809 01986000 SR R8,R8 @V2A3765 01987000 B RDCESD1 @V2A3765 01988000 RDCESD EQU * @V200809 01989000 LH R10,RECNUM GET RECORD NUMBER @V2A3765 01990000 LA R10,1(,R10) POINT TO NEXT RECORD @V2A3765 01991000 STH R10,RECNUM AND STORE IT @V2A3765 01992000 RDCESD1 EQU * @V2A3765 01993000 BAL R10,RDLIB GO READ CESD @V200809 01994000 LA R3,LIBRCD SET RECORD BASE @V200809 01995000 TM SWT,ZAPT IS THIS TXTLIB? @V2A3765 01996000 BZ LDCESD BRANCH IF NOT @V2A3765 01997000 BAL R10,TXTESD GO LOCATE CSECT @V2A3765 01998000 B CSECTFND FOUND IT @V2A3765 01999000 B RDCESD READ ANOTHER RECORD @V2A3765 02000000 B NOCESD NO CSECT @V2A3765 02001000 LDCESD EQU * @V2A3765 02002000 CLI 0(R3),SYMRCD IS THIS A 'SYS' RECORD? @V2A3765 02003000 BE RDCESD YES, SKIP IT @V200809 02004000 CLI 0(R3),CESDRCD NO, IS THIS A CESD RECORD? @V2A3765 02005000 BNE NOCESD NO @V200809 02006000 SPACE 1 02007000 * 02008000 * SEARCH CESD RECORD FOR ESD ENTRY WITH CSECT-NAME 02009000 * 02010000 LH R2,6(,R3) GET ESD DATA LENGTH @V200809 02011000 LA R2,8(R2) ADD 8 BYTE HEADER @V200809 02012000 LA R4,8 @V200809 02013000 SEARCHSD EQU * @V200809 02014000 LA R7,1(R7) INCREMENT ESD COUNT @V200809 02015000 LA R5,0(R4,R3) R5 = FIRST ESD ITEM @V200809 02016000 TM 8(R5),ESDRCD IS THIS AN ESD? @V2A3765 02017000 BNZ INCCESD NO, KEEP SEARCHING @V200809 02018000 TM SWT,FSTCSECT+ALLCSECT ALL CSECTS?(FIRST TIME) @V2A3765 02019000 BO CSECTALL BRANCH IF YES @V2A3765 02020000 TM SWT,FSTCSECT ARE WE LOOKING FOR FIRST ESD?@V200809 02021000 BO CSECTFND YES @V200809 02022000 CLC 0(8,R5),CSECTNAM IS THIS THE CSECT ? @V200809 02023000 BNE NXTESD BRANCH IF NOT @V2A3765 02024000 TM SWT,ALLCSECT ALL CSECTS? @V2A3765 02025000 BZ CSECTFND BRANCH IF NOT, FOUND @V2A3765 02026000 LR R8,R10 INDICATE CSECT FOUND @V2A3765 02027000 B INCCESD NEED NEXT CSECT @V2A3765 02028000 NXTESD EQU * @V2A3765 02029000 LTR R8,R8 NEXT CSECT FOR ALL? @V2A3765 02030000 BNZ CSECTALL BRANCH IF YES @V2A3765 02031000 INCCESD EQU * @V200809 02032000 AH R4,SIXTEEN R4 = HEADER + ESD DATA LENGTH@V200809 02033000 CR R4,R2 END OF CESD RECORD @V200809 02034000 BE RDCESD YES, GO READ NEXT @V200809 02035000 B SEARCHSD NO, KEEP SEARCHING @V200809 02036000 SPACE 2 02037000 NOCESD EQU * @V200809 02038000 TM SWT,ALLCSECT LOOKING FOR ALL CSECTS? @V2A3765 02039000 BZ NOCESD2 BRANCH IF NOT @V2A3765 02040000 OI LINESWT,FINCSECT INDICATE FINISHED @V2A3765 02041000 B CESDEND @V2A3765 02042000 NOCESD2 EQU * @V2A3765 02043000 MVI ERCODE,ERR04 SET ERROR CODE @V2A3765 02044000 MVC CSTNTFTY(8),=CL8'MEMBER' MOVE IN WORD MEMBER @VA03621 02045000 MVC CSTNTFDM(8),MEMNAME SET MEMBER-NAME INTO MESSAGE@V200809 02046000 LA R8,CSTNTFDL @V200809 02047000 BAL R10,INVEREP2 GO PRINT MESSAGE @V2A3765 02048000 NI SWT,255-FSTCSECT REMOVE FIRST CSECT INDICATOR @V2A3765 02049000 B CESDEND @V2A3765 02050000 CSECTALL EQU * @V2A3765 02051000 MVC CSECTNAM,0(R5) MOVE IN NAME @V2A3765 02052000 NI SWT,255-FSTCSECT REMOVE FIRST INDICATOR @V2A3765 02053000 OI LINESWT,FRSTLINE SET FOR HEADER @V2A3765 02054000 SPACE 2 02055000 CSECTFND EQU * @V200809 02056000 ST R7,CSECTID SAVE ESD ID COUNT @V200809 02057000 MVC ESDADD+1(3),9(R5) SAVE ESD ADDRESS @V200809 02058000 MVC ESDLEN+1(3),13(R5) SAVE ESD LENGTH @V200809 02059000 TM SWT,ZAPT TXTLIB SPECIFIED? @VA09238 02059100 BZ CESDEND NO, BYPASS @VA09238 02059180 BCT R7,CESDEND EXAMINE FIRST CSECT ONLY @VA09238 02059260 ICM R10,7,ESDLEN+1 GET LENGTH FIELD @VA09238 02059340 BNZ CESDEND BRANCH IF LENGTH IS FOUND @VA09238 02059420 SR R7,R7 CLEAR REGISTER @VA09238 02059500 ICM R7,3,RECNUM REMEMBER RECORD NUMBER @VA09238 02059580 CESDLOOP EQU * @VA09238 02059660 SR R10,R10 CLEAR REGISTER @VA09238 02059740 ICM R10,3,RECNUM INITIALIZE FOR LOOP @VA09238 02059820 LA R10,1(R10) NEXT RECORD @VA09238 02059900 STH R10,RECNUM SAVE RECORD NUMBER @VA09238 02059980 BAL R10,RDLIB READ THE RECORD @VA09238 02060060 CLC ENDREC,LIBRCD END OF TXTLIB MEMBER? @VA09238 02060140 BE CESDEND2 IF SO, NO END CARD PRESENT @VA09238 02060220 CLC ENDRECA,LIBRCD SEARCH FOR END CARD @VA09238 02060300 BNE CESDLOOP IF NOT FOUND, REPEAT LOOP @VA09238 02060380 CLC LIBRCD+28(4),BLANKS LENGTH FIELD FOUND? @VA09238 02060460 BE CESDEND2 NO, FIELD IS BLANK @VA09238 02060540 MVC ESDLEN+1(3),LIBRCD+29 MOVE TO ESD LENGTH FIELD @VA09238 02060620 CESDEND2 EQU * @VA09238 02060700 STH R7,RECNUM RESTORE RECORD NUMBER @VA09238 02060780 CESDEND EQU * @VA09238 02060860 B MEMEND @V2A3765 02061000 EJECT 1 02062000 * 02063000 * FIND TXTLIB CSECT 02064000 * 02065000 TXTESD EQU * @V2A3765 02066000 USING ESD,R3 @V2A3765 02067000 CLC ESDREC,RECTYPE IS THIS AN ESD? @V2A3765 02068000 BE TXTSD BRANCH IF YES @V2A3765 02069000 CLC ENDRECA,RECTYPE IS THIS AN END CARD? @VA07108 02070000 BNE TXTFIN BRANCH IF NOT @VA07108 02071000 SR R7,R7 CLEAR THE CSECTID COUNTER @VA07108 02072000 LH R15,ENDCNT GET CURRENT SAVED END COUNT @VA07108 02073000 LA R15,1(,R15) INCREMENT BY ONE @VA07108 02074000 STH R15,ENDCNT AND SAVE NEW COUNT @VA07108 02075000 B NXTTXT GO READ NEXT CARD @VA07108 02076000 TXTFIN EQU * @VA07108 02077000 CLC ENDREC,RECTYPE IS THIS AN END? @V2A3765 02078000 BNE NXTTXT BRANCH IF NOT @V2A3765 02079000 LA R10,4(,R10) YES, INDICATE ERROR @V2A3765 02080000 B NXTTXT @V2A3765 02081000 TXTSD EQU * @V2A3765 02082000 CLC ESDCNT,BLANKS DOES THIS CARD HAVE ENTRIES? @VA07108 02083000 BE NXTTXT BRANCH IF NOT, GO GET NEXT @VA07108 02084000 USING ESDDAT,R5 @V2A3765 02085000 LA R5,ESDHDRL(,R3) POINT TO ESD DATA ITEM @V2A3765 02086000 LH R15,ESDNUM GET NUMBER OF ITEMS @V2A3765 02087000 SRL R15,4 DIVIDE BY 16 @V2A3765 02088000 ESDLOOP EQU * @V2A3765 02089000 CLI ESDTYPE,XONE IS ESD A LABEL DEFINITION? @VA10838 02091000 BE ESDNXT YES, ITEM NOT COUNTED @VA10838 02093000 LA R7,1(0,R7) UPDATE ESD ITEM NUMBER @VA04197 02095000 CLI ESDTYPE,XZERO IS THIS A SECTION DEFINITION?@VA07108 02096000 BNE ESDNXT BRANCH IF NOT @VA07108 02097000 TM SWT,FSTCSECT+ALLCSECT ALL CSECTS?(FIRST TIME) @V2A3765 02098000 BO TXTALL BRANCH IF YES @V2A3765 02099000 TM SWT,FSTCSECT LOOKING FOR FIRST CSECT? @V2A3765 02100000 BO TXTRTN BRANCH IF YES @V2A3765 02101000 CLC CSECTNAM,ESDNAME IS THIS THE CSECT? @V2A3765 02102000 BNE ESDALL BRANCH IF NOT @V2A3765 02103000 TM SWT,ALLCSECT ALL CSECTS? @V2A3765 02104000 BZ TXTRTN BRANCH IF NOT, FOUND @V2A3765 02105000 CLC ENDMET,ENDCNT HAS THIS BEEN PROCESSED? @VA07318 02106000 BH ESDNXT BRANCH IF YES @VA07318 02107000 MVC ENDMET,ENDCNT SET NEW COUNT @VA07318 02108000 LR R8,R10 INDICATE CSECT FOUND @V2A3765 02109000 B ESDNXT NEED NEXT CSECT @V2A3765 02110000 ESDALL EQU * @V2A3765 02111000 LTR R8,R8 NEXT CSECT FOR ALL? @V2A3765 02112000 BNZ TXTALL BRANCH IF YES @V2A3765 02113000 ESDNXT EQU * @V2A3765 02114000 LA R5,ESDENDL(,R5) POINT TO NEXT ITEM @V2A3765 02115000 BCT R15,ESDLOOP LOOK AT NEXT ENTRY @V2A3765 02116000 B NXTTXT @V2A3765 02117000 TXTALL EQU * @V2A3765 02118000 MVC CSECTNAM,ESDNAME MOVE IN NAME @V2A3765 02119000 NI SWT,255-FSTCSECT REMOVE FIRST INDICATOR @V2A3765 02120000 OI LINESWT,FRSTLINE SET FOR HEADER @V2A3765 02121000 BR R10 @VA04591 02122000 NXTTXT EQU * @V2A3765 02123000 LA R10,4(,R10) INDICATE READ NEXT RECORD @V2A3765 02124000 TXTRTN EQU * @V2A3765 02125000 BR R10 @V2A3765 02126000 DROP R3,R5 @V2A3765 02127000 EJECT 02128000 * 02129000 * READ ZAP FILE SEARCHING FOR RECORD TO BE DUMPED, 02130000 * VERIFIED, OR REPLACED 02131000 * 02132000 RDTXT EQU * @V200809 02133000 ST R10,RDTXTSAV SAVE RETURN REGISTER @V2A3765 02134000 TM OPSWT,DUMPHIT ARE WE DUMPING? @VA07318 02135000 BO PRERDTXT BRANCH IF YES, NO CLEAR @VA07318 02136000 XC ENDMET,ENDMET CLEAR ENDS READ COUNTER @VA07108 02137000 PRERDTXT EQU * @V2A3765 02138000 LA R15,1 R15=1 TO SET/INCREMENT REC. NO. @VM03238 02139000 TM SWT,ZAPFM PERCHANCE A FIXED MODULE ? @VM03238 02140000 BO RDTXT0 BR. IF YES - KEEP COUNT = 1 @VM03238 02141000 AH R15,RECNUM NO - ADD OLD RECORD NUMBER @VM03238 02142000 RDTXT0 STH R15,RECNUM STORE NEW RECORD NUMBER @VM03238 02143000 BAL R10,RDLIB READ CONTROL RECORD FROM LIB @V200809 02144000 TM SWT,ZAPM+ZAPFM IS THIS MODULE? @VM03228 02145000 BNZ SETMOD BRANCH IF YES @VM03228 02146000 LA R3,LIBRCD GET RECORD READ ADDR. @V200809 02147000 SR R2,R2 CLEAR R2 @V200809 02148000 TM OPSWT,VERINP IS THIS THE MIDDLE OF VER OR REP@V200809 02149000 BO RDTXT1 YES @V200809 02150000 SR R1,R1 @V200809 02151000 SR R4,R4 @V200809 02152000 SR R5,R5 @V200809 02153000 SR R6,R6 @V200809 02154000 SR R8,R8 @V200809 02155000 RDTXT1 EQU * @V200809 02156000 TM SWT,ZAPT IS THIS TXTLIB? @V2A3765 02157000 BZ RDTXT1A BRANCH IF NOT @V2A3765 02158000 LA R15,RDTXTLIB POINT TO ROUTINE @V2A3765 02159000 B RDTXT1B @V2A3765 02160000 RDTXT1A EQU * @V2A3765 02161000 LA R15,RDLDLIB POINT TO ROUTINE @V2A3765 02162000 RDTXT1B EQU * @V2A3765 02163000 BALR R10,R15 GO ANALYZE @V2A3765 02164000 B CHKVER GOOD RECORD @V2A3765 02165000 B PRERDTXT READ NEXT RECORD @V2A3765 02166000 B RDTXEND ERROR @V2A3765 02167000 SETMOD EQU * @V2A3765 02168000 SR R5,R5 CLEAR "STARTING ADDRESS", @VM03238 02169000 TM SWT,ZAPFM PERCHANCE A FIXED MODULE ? @VM03238 02170000 BO SETMOD2 BRANCH IF YES (R5 ALL SET). @VM03238 02171000 L R15,MODMAX GET RECORD SIZE @V2A3765 02172000 LH R14,RECNUM AND NUMBER OF RECORDS @V2A3765 02173000 BCTR R14,0 REMOVE HEADER RECORD @V2A3765 02174000 BCTR R14,0 POINT TO START OF RECORD @V2A3765 02175000 MR R14,R14 GET NUMBER OF BYTES @V2A3765 02176000 LR R5,R15 GET STARTING ADDRESS @V2A3765 02177000 * OF THIS RECORD 02178000 SETMOD2 L R2,BYTESRD POINT TO LAST BYTE @VM03238 02179000 CHKVER EQU * @V2A3765 02180000 TM OPSWT,VERINP MIDDLE OF VER OR REP ? @V200809 02181000 BNO RDTXT4 NO @V200809 02182000 SR R6,R6 YES, START A BEGINNING OF REC@V200809 02183000 B GETVADD DON'T HAVE TO LOAD REGS @V200809 02184000 RDTXT4 EQU * @V200809 02185000 L R6,PACKDISP LOAD VER DISP ADDR @V200809 02186000 SR R6,R5 SUBSTRACT TXT RCD START @V200809 02187000 TM SWT,ZAPM IS THIS A MODULE @VA04197 02188000 BZ RDTXT5 NO @VA04197 02189000 ST R6,RECENDA SAVE START ADDRESS @VA04197 02190000 RDTXT5 EQU * @VA04197 02191000 SR R7,R7 CLEAR REGISTER @V2A3765 02192000 IC R7,DATALEN LOAD VER DATA LEN @V2A3765 02193000 GETVADD EQU * @V2A3765 02194000 LA R4,PACKDAED LOAD END VER DATA ADDR @V2A3765 02195000 SR R4,R7 GET START OF VER DATA @V2A3765 02196000 LA R8,0(R6,R3) LOAD TXT VER ADDR. @V200809 02197000 BAL R10,VERCHK GO DO OPERATION @V2A3765 02198000 TM OPSWT,VERINP VERIFY STILL IN PROGRESS? @V2A3765 02199000 BO PRERDTXT BRANCH IF YES @V2A3765 02200000 RDTXEND EQU * @V2A3765 02201000 NI LINESWT,255-ESDFND REMOVE FOUND IND. @V2A3765 02202000 L R10,RDTXTSAV GET RETURN ADDRESS @V2A3765 02203000 BR R10 @V2A3765 02204000 SPACE 3 02205000 RDTXTSAV DS F @V2A3765 02206000 EJECT 1 02207000 VERCHK EQU * @V2A3765 02208000 ST R10,VERSAVE SAVE REGISTER @V2A3765 02209000 TM OPSWT,DUMPHIT IS THIS DUMP? @V2A3765 02210000 BZ VERLOOP BRANCH IF NOT @V2A3765 02211000 BAL R10,PRTDUMP GO PRINT DUMP @V2A3765 02212000 B VEREND @V2A3765 02213000 VERLOOP EQU * @V200809 02214000 CR R2,R6 END OF THIS RCD? @V200809 02215000 BE VER2RCD YES @V200809 02216000 TM OPSWT,REPOP IS THIS A REP OPERATION? @V200809 02217000 BNO VERIFY1 NO, DO VERIFY @V200809 02218000 MVC 0(1,R8),0(R4) YES MOVE IN REP CODE @V200809 02219000 B VERIFY2 @V200809 02220000 VERIFY1 EQU * @V200809 02221000 CLC 0(1,R8),0(R4) VERIFY ONE BYTE AT A TIME @V200809 02222000 BE VERIFY2 BRANCH IF GOOD @V2A3765 02223000 LA R8,VERJMSGL GET MESSAGE ADDRESS @V2A3765 02224000 BAL R10,INVEREP2 INDICATE VERIFY FAILED @V2A3765 02225000 NI OPSWT,255-VERINP @V2A3765 02226000 B VEREND @V2A3765 02227000 VERIFY2 EQU * @V200809 02228000 LA R8,1(R8) INCREMENT @V200809 02229000 LA R4,1(R4) @V200809 02230000 LA R6,1(R6) @V200809 02231000 BCT R7,VERLOOP @V2A3765 02232000 NI OPSWT,255-VERINP TURN OFF NERIFY IN PROGRESS @V200809 02233000 TM OPSWT,REPOP IS THIS A REP OPERATION? @V200809 02234000 BNO VEREND BRANCH IF NOT @V2A3765 02235000 BAL R10,WRLIB YES, GO REWRITE LIB RECORD @V200809 02236000 B VEREND @V2A3765 02237000 VER2RCD EQU * @V200809 02238000 OI OPSWT,VERINP INDICATE VERIFY IN PROCESS @V200809 02239000 AR R2,R5 GET END OF RECORD @V2A3765 02240000 ST R2,RECEND AND STORE IT @V2A3765 02241000 TM OPSWT,REPOP IS THIS A REP OPERATION @V200809 02242000 BNO VEREND BRANCH IF NOT @V2A3765 02243000 BAL R10,WRLIB YES, REWRITE THIS RECORD @V200809 02244000 VEREND EQU * @V2A3765 02245000 L R10,VERSAVE GET RETURN ADDRESS @V2A3765 02246000 BR R10 @V2A3765 02247000 SPACE 3 02248000 VERSAVE DS F @V2A3765 02249000 EJECT 1 02250000 * 02251000 * ANALYZE TXTLIB RECORDS 02252000 * 02253000 USING TXTDAT,R3 @V2A3765 02254000 RDTXTLIB EQU * @V2A3765 02255000 ST R10,RDTXTR10 SAVE RETURN REGISTER @V2A3765 02256000 CLC TXTTYPE,ENDRECA IS IT AN END CARD? @VA04591 02257000 BE READEND YES, GO CLOSE OFF @VA04591 02258000 CLC TXTTYPE,TXTREC IS THIS A TEXT RECORD @V2A3765 02259000 BNE RDTXTNXT BRANCH IF NOT @V2A3765 02260000 TM OPSWT,DUMPHIT IS THIS A DUMP? @VA07108 02261000 BO CHKCSCTD BRANCH IF YES, NO ENDS @VA07108 02262000 CLC ENDMET,ENDCNT IS THIS THE END WANTED? @VA07108 02263000 BNE RDTXTNXT BRANCH IF NOT @VA07108 02264000 CHKCSCTD EQU * @VA07108 02265000 CLC TXTID,CSECTID+2 IS THIS THE PROPER CSECT? @V2A3765 02266000 BE RDTXTFND BRANCH IF YES @V2A3765 02267000 B RDTXTNXT NO, SKIP OVER THIS CSECT @VA04591 02268000 READEND EQU * @VA04591 02269000 TM OPSWT,DUMPHIT IS THIS A DUMP? @VA07108 02270000 BO READENDA BRANCH IF YES @VA07108 02271000 LH R15,ENDMET GET COUNT OF ENDS READ @VA07108 02272000 LA R15,1(,R15) INCREMENT BY ONE @VA07108 02273000 STH R15,ENDMET AND SAVE NEW COUNT @VA07108 02274000 CLC ENDMET,ENDCNT IS THIS THE END WANTED? @VA07108 02275000 BNH RDTXTNXT BRANCH IF NOT GREATER @VA07108 02276000 B RDTXTERR ERROR IF GREATER @VA07108 02277000 READENDA EQU * @VA07108 02278000 OI ECSWT,ENDCD INDICATE END CARD FOUND @VA04591 02279000 NI ECSWT,255-EOCSORG REMOVE SETTING @VA09155 02279500 L R6,ESDLEN GET ESD LENGTH @V2A3765 02280000 A R6,ESDADD ADD THE START ADDRESS @V2A3765 02281000 LR R5,R6 PUT INTO R5 @V2A3765 02282000 SR R6,R6 @V2A3765 02283000 OI LINESWT,DSLINE SET DSLINE @V2A3765 02284000 TM OPSWT,VERINP WORKING ON A LINE @VA04591 02285000 BZ NOFILL NO, JUST FINISH UP @VA04591 02286000 BAL R10,FINLINE GO FINISH THIS LINE @VA04591 02287000 B RSETDS NEW LINE NOT REQUIRED @VA04591 02288000 NOFILL EQU * @VA04591 02289000 BAL R10,NEWLIN GO PRINT DS @V2A3765 02290000 RSETDS NI OPSWT,255-VERINP RESET MIDDLE LINE INDICATOR @VA04591 02291000 NI LINESWT,255-DSLINE REMOVE DS @V2A3765 02292000 B RDTXTER1 @V2A3765 02293000 RDTXTFND EQU * @V2A3765 02294000 OI LINESWT,ESDFND INDICATE ESD FOUND @V2A3765 02295000 SR R6,R6 CLEAR THE REGISTER @V2A3765 02296000 ICM R6,B'0111',TXTADDR GET TEXT ADDRESS @V2A3765 02297000 ST R6,RECENDA SAVE START DISPLACEMENT @VA04197 02298000 LR R5,R6 AND SAVE IT @V2A3765 02299000 TM OPSWT,VERINP MIDDLE OF VER OR REP? @V2A3765 02300000 BO RDTXTLB2 BRANCH IF YES @V2A3765 02301000 C R6,PACKDISP TEXT ADDR < VER DISP? @V2A3765 02302000 BNH RDTXTLB3 BRANCH IF YES @V2A3765 02303000 TM OPSWT,DUMPHIT IS THIS DUMP? @V2A3765 02304000 BZ RDTXTERR BRANCH IF NOT @V2A3765 02305000 XC RECEND,RECEND CLEAR RECEND @V2A3765 02306000 S R5,PACKDISP GET UNDEFINED LENGTH @V2A3765 02307000 BAL R10,SETBLANK GO PRINT DS @V2A3765 02308000 LR R5,R6 RESTORE R5 @V2A3765 02309000 ST R5,RECEND SET RECORD END @V2A3765 02310000 TM LINESWT,LSTLNPRT ANY RECORD LEFT? @V2A3765 02311000 BZ RDTXTLB3 BRANCH IF YES @V2A3765 02312000 NI LINESWT,255-LSTLNPRT REMOVE LAST LINE IND. @V2A3765 02313000 B RDTXTER1 @V2A3765 02314000 RDTXTERR EQU * @V2A3765 02315000 LA R8,INVADMGL POINT TO ERROR MESSAGE @V2A3765 02316000 BAL R10,INVEREP2 GO PRINT MESSAGE @V2A3765 02317000 RDTXTER1 EQU * @V2A3765 02318000 L R10,RDTXTR10 GET RETURN REGISTER @V2A3765 02319000 LA R10,8(,R10) SET ERROR RETURN @V2A3765 02320000 B RDTXTRET @V2A3765 02321000 RDTXTLB2 EQU * @V2A3765 02322000 TM OPSWT,DUMPHIT IS THIS DUMP? @V2A3765 02323000 BO RDTXTLB3 BRANCH IF YES @V2A3765 02324000 C R6,RECEND IS THIS THE NEXT BYTE? @V2A3765 02325000 BH RDTXTERR BRANCH IF NOT @V2A3765 02326000 RDTXTLB3 EQU * @V2A3765 02327000 LH R2,TXTBYTES GET NUMBER OF TEXT BYTES @V2A3765 02328000 AR R6,R2 CALC END OF TEXT RECORD @V2A3765 02329000 LA R3,TXTINFO POINT TO TEXT DATA @V2A3765 02330000 C R6,PACKDISP END ADDR > DISP? @V2A3765 02331000 BH RDTXTEND BRANCH IF YES @V2A3765 02332000 RDTXTNXT EQU * @V2A3765 02333000 L R10,RDTXTR10 GET RETURN REGISTER @V2A3765 02334000 LA R10,4(,R10) INDICATE READ NEXT RECORD @V2A3765 02335000 B RDTXTRET @V2A3765 02336000 RDTXTEND EQU * @V2A3765 02337000 L R10,RDTXTR10 GET RETURN REGISTER @V2A3765 02338000 RDTXTRET EQU * @V2A3765 02339000 BR R10 @V2A3765 02340000 SPACE 3 02341000 RDTXTR10 DS F @V2A3765 02342000 DROP R3 @V2A3765 02343000 EJECT 1 02344000 * 02345000 * ANALYZE LOADLIB RECORDS 02346000 * 02347000 RDLDLIB EQU * @V2A3765 02348000 ST R10,RDLDR10 SAVE RETURN REGISTER @V2A3765 02349000 TM 0(R3),SEGEND END OF SEGMENT? @V2A3765 02350000 BZ RDLDCR BRANCH IF NOT @V2A3765 02351000 TM 0(R3),FINRCD ONE MORE TEXT RECORD? @V2A3765 02352000 BZ RDLDNXT BRANCH IF NOT @V2A3765 02353000 RDLDCR EQU * @V2A3765 02354000 TM 0(R3),CRRCD RLD OR CONT. RECORD? @V2A3765 02355000 BZ RDLDNXT BRANCH IF NEITHER @V2A3765 02356000 BO RDLDCHK BOTH, CHECK IT @V2A3765 02357000 TM 0(R3),RLDRCD JUST RLD? @V2A3765 02358000 BO RDLDNXT BRANCH IF NEXT @V2A3765 02359000 RDLDCHK EQU * @V2A3765 02360000 LH R1,4(,R3) GET CONTROL DATA @V2A3765 02361000 LH R4,6(,R3) AND DATA LENGTH @V2A3765 02362000 RDLDLOOP EQU * @V2A3765 02363000 LH R5,16(R4,R3) GET ESDID @V2A3765 02364000 ST R2,RECENDA SAVE INCASE NO ADDRESS @VA04197 02365000 AH R2,18(R4,R3) ADD LENGTH @V2A3765 02366000 CH R5,CSECTID+2 IS THIS CORRECT ESD ID? @V2A3765 02367000 BE RDLDESD BRANCH IF YES @V2A3765 02368000 TM LINESWT,ESDFND WAS ESD FOUND? @V2A3765 02369000 BO RDLDDS BRANCH IF YES @V2A3765 02370000 SH R1,FOUR DECREMENT CONTROL COUNT @V2A3765 02371000 LTR R1,R1 ANY MORE? @V2A3765 02372000 BZ RDLDSKIP BRANCH IF NOT @V2A3765 02373000 LA R4,4(,R4) INCREMENT @V2A3765 02374000 B RDLDLOOP @V2A3765 02375000 RDLDDS EQU * @V2A3765 02376000 TM OPSWT,DUMPHIT DOING DUMP? @V2A3765 02377000 BZ RDLDERR BRANCH IF NOT, ERROR @V2A3765 02378000 L R6,ESDLEN GET LENGTH OF ESD @V2A3765 02379000 A R6,ESDADD ADD THE START ADDRESS @V2A3765 02380000 LR R5,R6 PUT INTO R5 @V2A3765 02381000 TM OPSWT,VERINP IN PROGRESS? @V2A3765 02382000 BO RDLDESD1 BRANCH IF YES @V2A3765 02383000 LR R2,R5 GET LENGTH OF DS @V2A3765 02384000 SR R6,R6 @V2A3765 02385000 OI LINESWT,DSLINE SET DSLINE @V2A3765 02386000 BAL R10,NEWLIN GO PRINT DS @V2A3765 02387000 NI LINESWT,255-DSLINE @V2A3765 02388000 B RDLDERR1 @V2A3765 02389000 RDLDESD EQU * @V2A3765 02390000 ICM R6,B'0111',9(R3) LOAD TXT ADDRESS @V2A3765 02391000 LTR R6,R6 IS THERE AN ADDRESS @VA04197 02392000 BZ ADDISET YES, ADDRESS IS SET @VA04197 02393000 ST R6,RECENDA SET START ADDRESS @VA04197 02394000 ADDISET EQU * @VA04197 02395000 LR R5,R6 PUT INTO R5 @V2A3765 02396000 TM OPSWT,VERINP IN PROGRESS INDICATOR? @V2A3765 02397000 BO RDLDLIM BRANCH IF YES @V2A3765 02398000 C R6,PACKDISP TEXT ADDR < VER DISP @V2A3765 02399000 BNH RDLDLIM1 BRANCH IF YES @V2A3765 02400000 RDLDESD1 EQU * @V2A3765 02401000 TM OPSWT,DUMPHIT DOING DUMP? @V2A3765 02402000 BZ RDLDERR BRANCH IF NOT, ERROR @V2A3765 02403000 XC RECEND,RECEND CLEAR RECEND @V2A3765 02404000 S R5,PACKDISP GET UNDEFINED LENGTH @V2A3765 02405000 BAL R10,SETBLANK GO PRINT DS @V2A3765 02406000 LR R5,R6 RESTORE R5 @V2A3765 02407000 ST R5,RECEND SET RECORD END @V2A3765 02408000 TM LINESWT,LSTLNPRT ANY RECORD LEFT? @V2A3765 02409000 BO RDLDERR1 BRANCH IF NOT @V2A3765 02410000 RDLDLIM EQU * @V2A3765 02411000 TM OPSWT,DUMPHIT IS THIS DUMP? @V2A3765 02412000 BO RDLDLIM1 BRANCH IF YES @V2A3765 02413000 C R6,RECEND IS THIS THE NEXT BYTE? @V2A3765 02414000 BH RDLDERR BRANCH IF NOT @V2A3765 02415000 RDLDLIM1 EQU * @V2A3765 02416000 NI LINESWT,255-LSTLNPRT REMOVE LAST LINE PRT @V2A3765 02417000 OI LINESWT,ESDFND INDICATE ESD FOUND @V2A3765 02418000 AR R6,R2 CALC. END OF TEXT REC. @V2A3765 02419000 C R6,PACKDISP TEXT REC. <= DISP? @V2A3765 02420000 BNH RDLDSKIP BRANCH IF YES @V2A3765 02421000 LH R15,RECNUM GET RECORD NUMBER @V2A3765 02422000 LA R15,1(,R15) POINT TO NEXT RECORD @V2A3765 02423000 STH R15,RECNUM AND STORE IT @V2A3765 02424000 BAL R10,RDLIB READ REAL TEXT RECORD @V2A3765 02425000 L R10,RDLDR10 GET RETURN REGISTER @V2A3765 02426000 B RDLDRET @V2A3765 02427000 RDLDSKIP EQU * SKIP NEXT TEXT RECORD @V2A3765 02428000 LH R15,RECNUM GET RECORD NUMBER @V2A3765 02429000 LA R15,1(,R15) POINT TO NEXT RECORD @V2A3765 02430000 STH R15,RECNUM AND STORE IT @V2A3765 02431000 RDLDNXT EQU * @V2A3765 02432000 L R10,RDLDR10 GET RETURN REGISTER @V2A3765 02433000 LA R10,4(,R10) INDICATE READ NEXT RECORD @V2A3765 02434000 B RDLDRET @V2A3765 02435000 RDLDERR EQU * @V2A3765 02436000 LA R8,INVADMGL POINT TO ERROR MESSAGE @V2A3765 02437000 BAL R10,INVEREP2 GO PRINT MESSAGE @V2A3765 02438000 RDLDERR1 EQU * @V2A3765 02439000 L R10,RDLDR10 GET RETURN REGISTER @V2A3765 02440000 LA R10,8(,R10) SET ERROR RETURN @V2A3765 02441000 RDLDRET EQU * @V2A3765 02442000 BR R10 RETURN @V2A3765 02443000 SPACE 3 02444000 RDLDR10 DS F @V2A3765 02445000 EJECT 02446000 * 02447000 * ANY INVALID CONDITION ON A CONTROL RECORD WILL COME HERE. 02448000 * CLOSE THE SYSLIB FILE AND PRINT THE ERROR MESSAGE. 02449000 * 02450000 INVEREP EQU * @V200809 02451000 LA R8,NOGOMGL SET MESSAGE ADDR @V200809 02452000 INVEREP2 EQU * @V200809 02453000 MVI ERCODE,ERR04 SET ERROR CODE @V2A3765 02454000 INVEREP4 EQU * @V2A3765 02455000 ST R10,INVER10 SAVE RETURN REGISTER @V2A3765 02456000 OI OPSWT,NOGO SET NOGO SWITCH @V2A3765 02457000 BAL R10,CLOSELIB CLOSE SYSLIB @V200809 02458000 TM SWT,CONSOLE CONSOLE MODE? @V2A3765 02459000 BO NOTYPE BRANCH IF YES @V2A3765 02460000 BAL R10,PRTCARD GO PRINT CARD @V2A3765 02461000 NOTYPE EQU * @V2A3765 02462000 SR R7,R7 @V200809 02463000 IC R7,0(,R8) GET MESSAGE LENGTH @V200809 02464000 TM SWT,PRINT PRINTER OPTION? @V2A3765 02465000 BO DOPRT BRANCH IF YES, PRINT IT @V2A3765 02466000 LA R8,1(,R8) POINT TO MESSAGE @V2A3765 02467000 B DOCONS AND TYPE IT @V2A3765 02468000 DOPRT EQU * @V2A3765 02469000 BAL R10,PRTMSG GO WRITE MESSAGE TO PRT @V200809 02470000 DOCONS EQU * @V2A3765 02471000 BAL R10,DOWTO YES, WRITE IT TO CONSOLE @V200809 02472000 INVEREP3 EQU * @V200809 02473000 L R10,INVER10 RESTORE RETURN ADDRESS @V2A3765 02474000 BR R10 @V2A3765 02475000 SPACE 3 02476000 INVER10 DS F @V2A3765 02477000 EJECT 02478000 * 02479000 * READ INPUT CONTROL RECORD FILE 02480000 * 02481000 RDCARD EQU * @V200809 02482000 MVI CDBUF,X'40' BLANK OUT INPUT BUFFER @V200809 02483000 MVC CDBUF+1(132),CDBUF BEFORE READ @V2A3765 02484000 TM SWT,CONSOLE IS THIS CONSOLE MODE? @V200809 02485000 BNO RDCARD2 NO @V200809 02486000 WTOR 'ENTER:',CDBUF,80,WTOECB @V2A3765 02487000 SPACE 1 02488000 WAIT ECB=WTOECB @V200809 02489000 BR R10 @V200809 02490000 EJECT 1 02491000 RDCARD2 EQU * @V200809 02492000 FSREAD FSCB=INFUNC,ERROR=RDCRDERR @V2A3765 02493000 B RDCRDEND @V2A3765 02494000 RDCRDERR EQU * @V2A3765 02495000 CH R15,TWELVE END OF FILE? @V2A3765 02496000 BE CONEND BRANCH IF YES @V2A3765 02497000 OI SCANSWT,INPUTERR INDICATE ERROR @V2A3765 02498000 B RDLIBERR @V2A3765 02499000 RDCRDEND EQU * @V2A3765 02500000 SPACE 2 02501000 BR R10 @V200809 02502000 EJECT 1 02503000 * 02504000 * WRITE CONTROL RECORD AND MESSAGES TO SYSPRINT FILE 02505000 * 02506000 WRCARD EQU * @V200809 02507000 TM SWT,PRINT IS PRINT OPTION ACTIVE? @V2A3765 02508000 BZ WRCRDEND BRANCH IF NOT @V2A3765 02509000 PRINTL PRTBUF,ERROR=PRTERR @V2A3765 02510000 B WRCRDEND @V2A3765 02511000 SPACE 2 02512000 PRTERR EQU * @V2A3765 02513000 CH R15,THREE WAS CHANNEL 9 SENSED? @V2A3765 02514000 BE WRCARD BRANCH IF YES, REPEAT @V2A3765 02515000 CH R15,TWO CHAN 12? @VA03623 02516000 BE WRCARD YES,THEN DO AGAIN @VA03623 02517000 B PRTERMSG @V2A3765 02518000 SPACE 2 02519000 WRCRDEND EQU * @V2A3765 02520000 SPACE 2 02521000 BR R10 @V200809 02522000 EJECT 1 02523000 * 02524000 * LOCATE BEGINNING OF MEMBER 02525000 * 02526000 FINDMEM EQU * @V200809 02527000 LH R15,RECNUM GET RECORD NUMBER @V2A3765 02528000 TM SWT,ZAPM+ZAPFM IS THIS MODULE? @VM03228 02529000 BNZ FINDEND BRANCH IF YES @VM03228 02530000 LH R15,LIBREC GET RECORD NUMBER @V2A3765 02531000 FINDEND EQU * @V2A3765 02532000 BCTR R15,0 @V2A3765 02533000 STH R15,RECNUM READ WILL INCREMENT @V2A3765 02534000 BR R10 @V200809 02535000 EJECT 1 02536000 * 02537000 * PRINT CARD IMAGE 02538000 * 02539000 PRTCARD EQU * @V2A3765 02540000 TM LINESWT,CARDPRTD BEEN PRINTED? @V2A3765 02541000 BO PRTCDEND BRANCH IF YES @V2A3765 02542000 LA R14,80 MAXIMUM CARD LENGTH @V2A3765 02543000 LA R15,CDBUF+79 POINT TO END OF BUFFER @V2A3765 02544000 CRDLNTH EQU * @V2A3765 02545000 BCTR R14,0 DECREMENT @V2A3765 02546000 LTR R14,R14 WAS CARD BLANK? @V2A3765 02547000 BM PRTCDEND BRANCH IF YES @V2A3765 02548000 CLI 0(R15),C' ' IS CHARACTER BLANK? @V2A3765 02549000 BNE FNDLNTH BRANCH IF NOT @V2A3765 02550000 BCT R15,CRDLNTH LOOK AT NEXT CHARACTER @V2A3765 02551000 FNDLNTH EQU * @V2A3765 02552000 EX R14,MVCARD MOVE CARD IMAGE INTO LIST @V2A3765 02553000 LA R14,5(,R14) ADD HEADER + 1 @V2A3765 02554000 STH R14,WTOLEN AND STORE LENGTH @V2A3765 02555000 LA R1,WTOLIST POINT TO LIST @V2A3765 02556000 WTO MF=(E,(1)) GO TYPE IT @V2A3765 02557000 OI LINESWT,CARDPRTD INDICATE PRINTED @V2A3765 02558000 PRTCDEND EQU * @V2A3765 02559000 BR R10 @V2A3765 02560000 SPACE 3 02561000 MVCARD MVC WTOMSG(0),CDBUF @V2A3765 02562000 EJECT 02563000 * 02564000 * READ ZAP FILE 02565000 * 02566000 RDLIB EQU * @V2A3765 02567000 TM SWT,ZAPM+ZAPFM IS THIS MODULE? @VM03228 02568000 BZ NOTMOD BRANCH IF NOT @V2A3765 02569000 TM OPSWT,VERINP IS VERIFY IN PROGRESS? @V2A3765 02570000 BO RDREC BRANCH IF YES @V2A3765 02571000 LA R3,1 SET FOR RECORD NO. 1, @VM03238 02572000 TM SWT,ZAPFM PERCHANCE A FIXED MODULE ? @VM03238 02573000 BO PREPBUF SET - GET A BUFFER & READ MODULE @VM03238 02574000 L R3,PACKDISP GET DISPLACEMENT OF OPERATION@V2A3765 02575000 SR R2,R2 TO DETERMINE OFFSET @V2A3765 02576000 D R2,MODMAX R2 HAS OFFSET INTO RECORD @V2A3765 02577000 ST R2,MODDISP AND SAVE IT @V2A3765 02578000 LA R3,2(,R3) ADD HEADER RECORD @V2A3765 02579000 TM SWT,MODBUF BUFFER ALREADY GOTTEN? @VA05524 02580000 BZ PREPBUF BRANCH IF NOT @VA05524 02581000 CH R3,RECNUM IS RECORD ALREADY READ? @V2A3765 02582000 BNE PREPBUF BRANCH IF NOT @V2A3765 02583000 L R3,RECBUF YES, GET POINTER @V2A3765 02584000 B RDEND AND RETURN @V2A3765 02585000 PREPBUF EQU * @V2A3765 02586000 STH R3,RECNUM POINT TO RECORD WANTED @V2A3765 02587000 TM SWT,MODBUF BUFFER ALREADY GOTTEN? @V2A3765 02588000 BZ GETBUF BRANCH IF NOT @V2A3765 02589000 L R3,RECBUF YES, GET POINTER @V2A3765 02590000 B RDREC @V2A3765 02591000 GETBUF EQU * @V2A3765 02592000 L R0,MODSIZE GET BUFFER SIZE @VM03228 02593000 ST R0,BUFSIZE AND SAVE IT @V2A3765 02594000 GETMAIN R,LV=(0) @V2A3765 02595000 ST R1,RECBUF SAVE BUFFER ADDRESS @V2A3765 02596000 LR R3,R1 ALSO IN R3 @V2A3765 02597000 OI SWT,MODBUF INDICATE BUFFER GOTTEN @V2A3765 02598000 B RDREC @V2A3765 02599000 NOTMOD EQU * @V2A3765 02600000 XC LIBRCD(130),LIBRCD ZERO OUT HALF BUFFER @V200809 02601000 XC LIBRCD+130(130),LIBRCD+130 AND NEXT HALF @V200809 02602000 RDREC EQU * @V2A3765 02603000 LA R1,RDBUF GET PLIST ADDRESS @V2A3765 02604000 SVC 202 READ THE RECORD @V2A3765 02605000 DC AL4(RDLIBERR) @V2A3765 02606000 RDEND EQU * @V2A3765 02607000 SPACE 2 02608000 BR R10 @V200809 02609000 EJECT 1 02610000 * 02611000 * UPDATE ZAP FILE 02612000 * 02613000 WRLIB EQU * @V200809 02614000 LR R8,R10 SAVE RETURN ADDRESS @V2A3765 02615000 BAL R10,CLOSELIB CLOSE THE FILE @V2A3765 02616000 MVC RDBUF,=CL8'WRBUF' INDICATE WRITE @V2A3765 02617000 L R6,BUFSIZE HOLD BUFFER SIZE @V2A3765 02618000 L R1,BYTESRD GET BYTES READ @V2A3765 02619000 ST R1,BUFSIZE AND SAVE THEM @V2A3765 02620000 LA R1,RDBUF POINT TO PLIST @V2A3765 02621000 SVC 202 GO WRITE THE RECORD @V2A3765 02622000 ST R6,BUFSIZE RESTORE BUFFER SIZE @V2A3765 02623000 BAL R10,CLRSPCE REMOVE BUFFER SPACE @V2A3765 02624000 BAL R10,CLOSELIB AND CLOSE THE FILE @V2A3765 02625000 MVC RDBUF,=CL8'RDBUF' CHANGE TO READ @V2A3765 02626000 SPACE 2 02627000 BR R8 @V2A3765 02628000 EJECT 02629000 * 02630000 * ROUTINE TO SCAN CONTROL RECORDS 02631000 * 02632000 SCANKEY1 EQU * @V200809 02633000 LR R4,R2 BUFFER ADDR IN R2 @V200809 02634000 SCANKEY2 EQU * @V200809 02635000 CLI 0(R4),BLANK IS THIS A BLANK? @V200809 02636000 BNE SCANKEY3 NO, FIRST CHAR OF KEYWORD FOUND @V200809 02637000 LA R4,1(R4) INCREMENT TO NEXT POSITION @V200809 02638000 BCT R3,SCANKEY2 LOOP @V200809 02639000 OI SCANSWT,RETBLNKS INDICATE RETURNING BLANKS @V2A3765 02640000 B SCANKEY6 @V2A3765 02641000 SPACE 2 02642000 SCANKEY3 EQU * @V200809 02643000 LR R2,R4 KEYWORD START IN R2 @V200809 02644000 SCANKEY4 EQU * @V200809 02645000 TM SCANSWT,KEYSCAN IS THIS A KEYWORD SCAN? @VM08595 02646000 BO KEY4B YES, NO CHAR. CHECK @VM08595 02647000 TM SCANSWT,DISPSCAN DISP. SCAN? @VM08595 02648000 BO KEY4A YES, NO COMMA CHECK @VM08595 02649000 CLI 0(R2),COMMA NO, IS IT A COMMA @VM08595 02650000 BE KEY4B YES @VM08595 02651000 KEY4A EQU * @VM08595 02652000 CLI 0(R2),A 'A' OR HIGHER? @VM08595 02653000 BL SCANERR NO, ERROR @V2A3765 02654000 CLI 0(R2),F YES, HIGHER THAN 'F'? @VM08595 02655000 BNH KEY4B NO, GOOD CHAR. @VM08595 02656000 CLI 0(R2),ZERO YES, LESS THAN '0'? @VM03203 02657000 BNL NOTLOW BRANCH IF NOT @VM03203 02658000 SCANERR EQU * @VM03203 02659000 LA R10,READINP RETURN TO READINP @VM03203 02660000 B INVEREP AFTER ERROR MESSAGE @VM03203 02661000 NOTLOW EQU * @V2A3765 02662000 CLI 0(R2),NINE HIGHER THAN '9'? @VM08595 02663000 BNH KEY4B BRANCH IF NOT @V2A3765 02664000 LA R10,READINP RETURN TO READINP @V2A3765 02665000 B INVEREP AFTER ERROR MESSAGE @V2A3765 02666000 KEY4B EQU * @VM08595 02667000 LA R2,1(R2) INCREMENT @V200809 02668000 BCTR R3,0 DECREMENT COLUMN COUNTER @V200809 02669000 LTR R3,R3 END OF CARD ? @V200809 02670000 BZ SCANKEY5 YES @V200809 02671000 CLI 0(R2),BLANK END OF KEYWORD? @V200809 02672000 BNE SCANKEY4 NO LOOP @V200809 02673000 SCANKEY5 EQU * @V200809 02674000 LR R5,R2 YES, CALC. LENGTH @V200809 02675000 SR R5,R4 @V200809 02676000 SCANKEY6 EQU * @V2A3765 02677000 BR R10 RETURN TO MAINLINE @V200809 02678000 EJECT 02679000 * 02680000 * ISSUE 'STATE' FOR LIBRARY FILE, CHECK THAT DISK IS READ 02681000 * WRITE. 02682000 * 02683000 STFDEF EQU * @V200809 02684000 MVC STNAME(8),0(R6) SET STATE NAME @V200809 02685000 MVC STATE,STATEC INDICATE STATE @V2A3765 02686000 LA R1,STATE @V200809 02687000 SVC 202 @V200809 02688000 DC AL4(*+4) @V200809 02689000 LTR R15,R15 LIBRARY FOUND ? @V200809 02690000 BZ CHKST BRANCH IF SO @V2A3765 02691000 LA R10,4(,R10) INDICATE ERROR @V2A3765 02692000 B STATEND @V2A3765 02693000 CHKST EQU * @V2A3765 02694000 L R1,STATFST LOAD FST ADDR @V200809 02695000 USING FSTSECT,R1 @V200809 02696000 CLI FSTFB,FSTFRW DISK READ/WRITE? @V200809 02697000 BNE LIBRO NO @V200809 02698000 MVC RDNAME(16),STNAME MOVE IN NAME AND TYPE @V2A3765 02699000 MVC FLAGS(1),FSTFV SAVE F/V FLAG @V2A3765 02700000 MVC RDMODE,FSTM MOVE IN FILEMODE @V2A3765 02701000 MVC AUXFM1(1),FSTM NEED SAME MODE LETTER IN @VA10327 02701300 MVC AUXFM2(1),FSTM FILEID'S FOR RENAME @VA10327 02701600 MVC RECNUM,ONE POSITION AT START @V2A3765 02702000 LA R8,RDNAME POINT TO FILENAME @V2A3765 02703000 TM SWT,ZAPT IS THIS TEXTLIB? @V2A3765 02704000 BO CHKFIX BRANCH IF SO @V2A3765 02705000 CLI FSTFV,C'V' IS THIS A VARIABLE FILE ? @V200809 02706000 BE SAVESIZE YES - OK. @VM03228 02707000 TM SWT,ZAPM+ZAPFM IF FIXED, IS IT A MODULE ? @VM03228 02708000 BZ LIBNTV IF NOT, IT'S A REAL ERROR. @VM03228 02709000 * FIXED (TRANSIENT) MODULE: 02710000 CLC ONE,FSTIC RECORD COUNT MUST BE ONE; @VM03228 02711000 BNE LIBNTV IF NOT, USE EXISTING ERROR MSG @VM03228 02712000 CLC MAXTRMOD,FSTIL AND RECORD MUST BE 8192 OR LESS @VM03228 02713000 BL LIBNTV IF TOO BIG, USE EXISTING ERR MSG.@VM03228 02714000 NI SWT,X'FF'-ZAPM OK - SIGNAL IT'S A FIXED MODULE @VM03228 02715000 OI SWT,ZAPFM ... @VM03228 02716000 XC DICTHDR(DICTLEN),DICTHDR ZERO DICTIONARY HEADER @VM03228 02717000 LA R15,DICTHDR REFERENCE AS A MODULE HEADER @VM03228 02718000 USING MDREC,R15 ... @VM03228 02719000 L R14,ADTRANS GET STARTING ADDRESS @VM03228 02720000 ST R14,MDSTART STORE @VM03228 02721000 ST R14,MDFIRST ... @VM03228 02722000 A R14,FSTIL ADD LENGTH OF MODULE @VM03228 02723000 ST R14,MDLAST STORE @VM03228 02724000 DROP R15 @VM03228 02725000 SAVESIZE MVC MODSIZE,FSTIL SAVE MAXIMUM RECORD SIZE @VM03228 02726000 B STATEND AND GO EXIT FROM SUBROUTINE. @VM03228 02727000 CHKFIX EQU * @V2A3765 02728000 CLI FSTFV,C'F' IS THIS A FIXED FILE? @V2A3765 02729000 BNE FILENTF BRANCH IF NOT @V2A3765 02730000 CLC FSTIL+2(2),EIGHTY IS RECORD LENGTH 80? @V2A3765 02731000 BNE FILENTF BRANCH IF NOT @V2A3765 02732000 DROP R1 @V2A3765 02733000 STATEND EQU * @V2A3765 02734000 BR R10 @V2A3765 02735000 EJECT 02736000 * 02737000 * FINIS ZAP FILE 02738000 * 02739000 CLOSELIB EQU * @V200809 02740000 CLI STNAME,C' ' ANY NAME PRESENT? @V2A3765 02741000 BE CLOSEND BRANCH IF NOT @V2A3765 02742000 FSCLOSE FSCB=STATE CLOSE THE FILE @V2A3765 02743000 CLOSEND EQU * @V2A3765 02744000 SPACE 2 02745000 BR R10 RETURN TO MAINLINE @V200809 02746000 SPACE 2 02747000 EJECT 02748000 * 02749000 * PREPARE TO WRITE MESSAGES TO SYSPRINT 02750000 * 02751000 PRTMSG EQU * @V200809 02752000 ST R10,PRTMSGSV SAVE RETURN REGISTER @V2A3765 02753000 MVI PRTBUF,X'40' MAKE SURE SINGLE SPACE @VM08595 02754000 MVI CDBUF,BLANK BLANK OUT BUFFER @V200809 02755000 MVC CDBUF+1(80),CDBUF CLEAR BUFFER AREA @V2A3765 02756000 SR R10,R10 @V2A3765 02757000 IC R10,0(R8) GET MESSAGE LENGTH IN R10 @V2A3765 02758000 BCTR R10,0 DECREMENT BY 1 @V2A3765 02759000 LA R8,1(R8) INCREMENT R8 TO MESSAGE @V200809 02760000 EX R10,MSGMOVE PUT MESSAGE INTO BUFFER @V2A3765 02761000 BAL R10,WRCARD GO WRITE MESSAGE @V2A3765 02762000 L R10,PRTMSGSV GET RETURN REGISTER @V2A3765 02763000 BR R10 @V2A3765 02764000 SPACE 3 02765000 PRTMSGSV DS F @V2A3765 02766000 EJECT 1 02767000 CLRSPCE EQU * @V2A3765 02768000 * 02769000 * FREEMAIN BUFFER SPACE 02770000 * 02771000 TM SWT,MODBUF IS THERE A BUFFER? @V2A3765 02772000 BZ NOBUF BRANCH IF NOT @V2A3765 02773000 L R0,MODSIZE GET BUFFER SIZE @VM03228 02774000 L R1,RECBUF AND ITS ADDRESS @V2A3765 02775000 FREEMAIN R,LV=(0),A=(1) AND FREE IT @V2A3765 02776000 NI SWT,255-MODBUF REMOVE BUFFER INDICATOR @V2A3765 02777000 NOBUF EQU * @V2A3765 02778000 BR R10 @V2A3765 02779000 EJECT 1 02780000 * 02781000 * THIS ROUTINE DOES WRITE TO OPERATOR FOR MESSAGES WHEN 02782000 * IN CONSOLE MODE. 02783000 * 02784000 DOWTO EQU * @V200809 02785000 DC X'83',X'87',X'005C' EDIT ERROR MSG. ACCORDING @VM03027 02786000 * TO USER'S EMSG SETTING. 02787000 LTR R7,R7 IS MESSAGE LENGTH 0 ? @VM03027 02788000 BZR R10 YES, DON'T SEND MESSAGE. @VM03027 02789000 BCTR R7,0 DECREMENT LENGTH FOR MOVE @V200809 02790000 EX R7,WTOMOVE MOVE MESSAGE TO WTO LIST @V200809 02791000 LA R7,5(R7) R7 = R7 + MOVE DEC. + HEADER @V200809 02792000 STH R7,WTOLEN STORE LENGTH INTO WTO LENGTH @V200809 02793000 LA R1,WTOLIST @V200809 02794000 WTO MF=(E,(1)) ISSUE WTO @V200809 02795000 BR R10 RETURN @V200809 02796000 SPACE 3 02797000 MSGMOVE MVC CDBUF(1),0(R8) MOVE MESSAGE TO BUFFER @V200809 02798000 WTOMOVE MVC WTOMSG(1),0(R8) MOVE MESSAGE TO WTO BUFFER @V200809 02799000 EJECT 02800000 CONEND EQU * @V200809 02801000 TM OPSWT,REPOP REP ALREADY PROCESSED? @VA10327 02802000 BNO CONENDA NO...OK @V60CE91 02803000 TM SWT2,LOGHIT FOUND LOG TOO ? @V60CE91 02804000 BO CONENDA YES...OK @V60CE91 02805000 BAL R10,LOGNOTF OTHERWISE WRITE DUMMY RECORD @VA10327 02806000 CONENDA NI SWT2,X'FF'-LOGHIT TURN OFF LOG SWITCH @V60CE91 02807000 TM SWT,PRINT PRINTING? @V2A3765 02808000 BZ CONEND1 BRANCH IF NOT @V2A3765 02809000 LA R8,ENDMSGL POINT TO ENDING MESSAGE @V2A3765 02810000 BAL R10,PRTMSG GO PRINT IT @V2A3765 02811000 LA R1,CLSPLIST CLOSE THE PRINT FILE @VA04593 02812000 SVC 202 @VA04593 02813000 DC AL4(CONEND1) @VA04593 02814000 CONEND1 EQU * @V2A3765 02815000 BAL R10,CLOSELIB GO CLOSE LIBRARY @V2A3765 02816000 BAL R10,CLOSINP CLOSE INPUT FILE @V2A3765 02817000 BAL R10,CLRSPCE REMOVE BUFFER SPACE @V2A3765 02818000 B NOMORE @V2A3765 02819000 SPACE 2 02820000 CLSPLIST DC CL8'CP' @VA04593 02821000 DC CL8'CLOSE' @VA04593 02822000 DC CL8'PRINTER' @VA04593 02823000 DC 8X'FF' @VA04593 02824000 EJECT 1 02825000 * 02826000 * CLOSE INPUT FILE 02827000 * 02828000 CLOSINP EQU * @V2A3765 02829000 CLI INFILEN,C' ' IS THERE AN INPUT FILE? @V2A3765 02830000 BE CLOSINPE BRANCH IF NOT @V2A3765 02831000 FSCLOSE FSCB=INFUNC CLOSE INPUT FILE @V2A3765 02832000 CLOSINPE EQU * @V2A3765 02833000 BR R10 @V2A3765 02834000 EJECT 02835000 * 02836000 * PLISTS, SAVE AREAS AND CONSTANTS 02837000 * 02838000 DS 0D @V200809 02839000 STATE DC CL8'STATE' @V200809 02840000 STNAME DC CL8' ' @V200809 02841000 DC CL8'LOADLIB' @V200809 02842000 DC CL2'*' @V200809 02843000 DC H'00' @V200809 02844000 STATFST DC A(0) @V200809 02845000 DC 8X'FF' @V200809 02846000 SPACE 2 02847000 AUXFSCB FSCB 'FN ZAPLOG A',BUFFER=CDBUF,BSIZE=80 @V60CE91 02848000 AUXBSIZE EQU 80 @V60CE91 02849000 AUXDATE EQU 63 @V60CE91 02850000 AUXNUML EQU 8 @V60CE91 02851000 AUXNOTF DC H'28' NOT FOUND @V60CE91 02852000 WORKFSCB FSCB 'ZAP CMSUT1 A5',BUFFER=CDBUF,BSIZE=80 @V60CE91 02853000 SPACE 2 02854000 DS 0D @V60CE91 02855000 AUXFUNC DC CL8'RENAME' @V60CE91 02856000 DC CL8'ZAP' @V60CE91 02857000 DC CL8'CMSUT1' @V60CE91 02858000 AUXFM1 DC CL8'A5' @VA10327 02859000 AUXFNFT DC CL16' ' @V60CE91 02860000 AUXFM2 DC CL8'A1' @VA10327 02861000 DC 8X'FF' @V60CE91 02862000 SPACE 1 02863000 DS 0D @V60CE91 02864000 INFUNC DC CL8'STATE' @V2A3765 02865000 INFILEN DC CL8' ' @V2A3765 02866000 DC CL8'ZAP' @V2A3765 02867000 INMODE DC CL2'*' @V2A3765 02868000 INRNUM DC H'0' @V2A3765 02869000 INBUF DC A(0) @V2A3765 02870000 INBFSZ DC 4X'FF' @V2A3765 02871000 INFLGS DC 2X'FF' @V2A3765 02872000 INNUMR DC 2X'FF' @V2A3765 02873000 INBYTES DC F'0' @V2A3765 02874000 DC 8X'FF' @V2A3765 02875000 SPACE 3 02876000 DS 0D @V2A3765 02877000 RDBUF DC CL8'RDBUF' @V2A3765 02878000 RDNAME DC CL8' ' @V2A3765 02879000 RDTYPE DC CL8' ' @V2A3765 02880000 RDMODE DC CL2'* ' @V2A3765 02881000 RECNUM DC H'1' @V2A3765 02882000 RECBUF DC A(0) @V2A3765 02883000 BUFSIZE DC F'0' @V2A3765 02884000 FLAGS DC CL2'V ' @V2A3765 02885000 NUMOFREC DC H'1' @V2A3765 02886000 BYTESRD DC F'0' @V2A3765 02887000 DC 8X'FF' @V2A3765 02888000 SPACE 3 02889000 DTTMBUF DS 4D DATE AND TIME BUFFER @VA11269 02889500 DICTHDR EQU * DICTIONARY HEADER @V2A3765 02890000 DICTID DS CL6 @V2A3765 02891000 DICTSTRT DS CL2 POINTER TO FIRST DICT. RCD @V2A3765 02892000 DICTSIZE DS CL4 NO. BYTES IN DICT. @V2A3765 02893000 DICTNO DS CL4 NO. RECORDS IN DICT. @V2A3765 02894000 DS CL64 @V2A3765 02895000 DICTEND EQU * @V2A3765 02896000 DICTLEN EQU DICTEND-DICTHDR @V2A3765 02897000 DICTENTL EQU 12 LENGTH OF DICTIONARY ENTRY @V2A3765 02898000 DICTNUM EQU 6 NUMBER OF ENTRIES/RECORD @V2A3765 02899000 SPACE 3 02900000 SPACE 2 02901000 REGSAVE DC 18F'0' @V200809 02902000 INPLIST DC A(0) @V200809 02903000 LIBNAME1 DC A(0) @V200809 02904000 LIBNAME2 DC A(0) @V200809 02905000 LIBNAME3 DC A(0) @V200809 02906000 DC F'0' DENOTES END OF LIBRARY NAMES @V200809 02907000 DDNAME DC A(0) @V200809 02908000 BLANKS DC CL8' ' @V200809 02909000 MEMNAME DC CL8' ' @V200809 02910000 CSECTNAM DC CL8' ' @V200809 02911000 ONE DC H'1' @V2A3765 02912000 TWO DC H'2' @VA03623 02913000 THREE DC H'3' @V2A3765 02914000 FOUR DC H'4' @V200809 02915000 SIX DC H'6' @V200809 02916000 EIGHT DC H'8' @V200809 02917000 ELEVEN DC H'11' @V2A3765 02918000 TWELVE DC H'12' @V200809 02919000 SIXTEEN DC H'16' @V200809 02920000 SEVNTHRE DC H'73' @V200809 02921000 EIGHTY DC H'80' @V2A3765 02922000 LIBREC DC H'0' RECORD NUMBER OF MODULE @V2A3765 02923000 ENDCNT DC H'0' NUMBER OF ENDS TO ESD @VA07108 02924000 ENDMET DC H'0' NUMBER OF ENDS READ @VA07108 02925000 MODMAX DC F'65535' MODULE RECORD SIZE(MAXIMUM) @V2A3765 02926000 MAXTRMOD DC F'8192' MAX. SIZE FIXED=TRANSIENT MODULE @VM03228 02927000 MODSIZE DC F'65535' SIZE OF MODULE'S LARGEST RECORD @VM03228 02928000 ADTRANS DC A(X'E000') ADDRESS OF CMS TRANSIENT AREA @VM03228 02929000 TXTLIB DC CL8'TXTLIB' @V2A3765 02930000 MODULE DC CL8'MODULE' @V2A3765 02931000 STATEC DC CL8'STATE' @V2A3765 02932000 SPACE 1 02933000 CSECTID DC F'0' @V200809 02934000 ESDADD DC 4X'00' @V200809 02935000 ESDLEN DC 4X'00' @V200809 02936000 MODDISP EQU CSECTID @V2A3765 02937000 MODLOC EQU ESDADD @V2A3765 02938000 MODLEN EQU ESDLEN @V2A3765 02939000 SPACE 1 02940000 BASEVAL DC 6X'00' @VM08551 02941000 BASEVEND DS 0C @VM08551 02942000 DISP DC 6X'00' @V200809 02943000 DISPEND DS 0C @V200809 02944000 DATA DC 73X'00' @V200809 02945000 SPACE 1 02946000 DS 0F @V200809 02947000 PACKBASE DC 4X'00' @VM08595 02948000 PACKBAED DS 0C @VM08595 02949000 PACKDISP DC 4X'00' @V200809 02950000 PACKDPED DS 0C @V200809 02951000 RECEND DC F'0' @V2A3765 02952000 PACKADDS DC F'0' @V2A3765 02953000 PACKADDE DC F'0' @V2A3765 02954000 ADDRS DC 6X'00' @V2A3765 02955000 ADDRSEND DS 0C @V2A3765 02956000 ADDREND DC 6X'00' @V2A3765 02957000 ADDREEND DS 0C @V2A3765 02958000 HEXUNPK DS 3F @V2A3765 02959000 PACKDATA DC 37X'00' @V200809 02960000 PACKDAED DS 0C @V200809 02961000 DC 2C' ' FILLER @V200809 02962000 DATALEN DC X'00' @V200809 02963000 NORMCON DC 73X'1F' @V200809 02964000 SPACE 1 02965000 TRANTBL DC X'00FAFBFCFDFEFF' @V200809 02966000 DS 9C @V200809 02967000 DC C'0123456789ABCDEF' @V200809 02968000 SPACE 2 02969000 EJECT 02970000 PRINTBL EQU * @V2A3765 02971000 DC 64C'.',C' ',12C'.',C'(+',13C'.',C'*)' @V2A3765 02972000 DC C'..',C'-/',9C'.',C',',17C'.',C'''=',66C'.' @V2A3765 02973000 DC C'ABCDEFGHI',7C'.',C'JKLMNOPQR',8C'.' @V2A3765 02974000 DC C'STUVWXYZ',6C'.',C'0123456789',6C'.' @V2A3765 02975000 WTOECB DC F'0' @V200809 02976000 DOSF DC X'0' @V305066 02977000 SPACE 2 02978000 LIBRCD DC 65F'0' @V200809 02979000 SYMRCD EQU X'40' @V2A3765 02980000 CESDRCD EQU X'20' @V2A3765 02981000 ESDRCD EQU X'0F' @V2A3765 02982000 SEGEND EQU X'04' @V2A3765 02983000 CRRCD EQU X'03' @V2A3765 02984000 RLDRCD EQU X'02' @V2A3765 02985000 FINRCD EQU X'01' @V2A3765 02986000 LIBEND EQU * @V2A3765 02987000 LIBLEN EQU LIBEND-LIBRCD @V2A3765 02988000 SPACE 2 02989000 PRTBUF DC C'1' @V200809 02990000 SPCNTRL EQU X'40' @V2A3765 02991000 CDBUF DC CL133' ' @V2A3765 02992000 HOLDLINE DC CL134' ' @V2A3765 02993000 SPACE 2 02994000 SCANSWT DC X'0' @VM08595 02995000 KEYSCAN EQU X'80' @VM08595 02996000 DISPSCAN EQU X'40' @VM08595 02997000 DATASCAN EQU X'20' @VM03203 02998000 RETBLNKS EQU X'10' @VM03203 02999000 INPUTERR EQU X'08' @VM03203 03000000 SPACE 3 03001000 DUPSWT DC X'00' @VM03203 03002000 DUPFRST EQU X'80' @VM03203 03003000 DUPSTRTA EQU X'40' @VM03203 03004000 DUPENDA EQU X'20' @VM03203 03005000 DUPHELD EQU X'04' @VM03203 03006000 DUPMSG EQU X'02' @VM03203 03007000 DUPEND EQU X'01' @VM03203 03008000 SPACE 2 03009000 SWT DC X'41' @V2A3765 03010000 ZAPFM EQU X'80' ZAP A FIXED (TRANSIENT) MODULE @VM03228 03011000 CONSOLE EQU X'40' @V200809 03012000 FSTCSECT EQU X'20' @V200809 03013000 MODBUF EQU X'10' @V2A3765 03014000 ALLCSECT EQU X'08' @V2A3765 03015000 ZAPM EQU X'04' ZAP A (VARIABLE) MODULE @VM03228 03016000 ZAPT EQU X'02' ZAP TEXT @V2A3765 03017000 PRINT EQU X'01' @V2A3765 03018000 SPACE 2 03019000 SWT2 DC X'00' ADDITIONAL FLAG(S): @VM03228 03020000 MULTLIB EQU X'80' INDICATES MULTIPLE LIBRARIES @VM03228 03021000 LOGHIT EQU X'40' LOG RECORD FOUND @V60CE91 03022000 LOGNHIT EQU X'20' DUMMY LOG RECORD @V60CE91 03023000 REPNOLOG EQU X'10' REP NOT YET LOGGED @VA10327 03023100 SPACE 2 03024000 OPSWT DC X'00' @V200809 03025000 NAMEHIT EQU X'80' @V200809 03026000 VEROP EQU X'40' @V200809 03027000 REPOP EQU X'20' @V200809 03028000 NOGO EQU X'10' @V200809 03029000 VERINP EQU X'08' @V200809 03030000 BASEHIT EQU X'04' @VM08551 03031000 FILEFND EQU X'02' @V2A3765 03032000 DUMPHIT EQU X'01' @V2A3765 03033000 SPACE 3 03034000 LINESWT DC X'00' @V2A3765 03035000 FRSTLINE EQU X'80' @V2A3765 03036000 LASTLINE EQU X'40' @V2A3765 03037000 FINCSECT EQU X'20' @V2A3765 03038000 DSLINE EQU X'10' @V2A3765 03039000 CARDPRTD EQU X'08' @V2A3765 03040000 LASTREC EQU X'04' @V2A3765 03041000 ESDFND EQU X'02' @V2A3765 03042000 LSTLNPRT EQU X'01' @V2A3765 03043000 SPACE 2 03044000 LIBSWT DC X'00' @V2A3765 03045000 INPUT EQU X'80' @V2A3765 03046000 CONS EQU X'40' @V2A3765 03047000 PT EQU X'20' @V2A3765 03048000 NOPT EQU X'10' @V2A3765 03049000 INITLIB EQU X'01' INITIAL LIBRARY @V2A3765 03050000 MAXLIB EQU X'04' TOO MANY LIBRARIES @V2A3765 03051000 SPACE 3 03052000 ECSWT DC X'00' @VA04591 03053000 ENDCD EQU X'80' @VA04591 03054000 ORGCD EQU X'40' @VA04197 03055000 NEWCT EQU X'20' INDICATES START OF NEW CSECT @VA04197 03056000 EOCSORG EQU X'10' INDICATES ORG AT END OF CSECT @VA09155 03056500 RECENDA DC F'0' @VA04197 03057000 ERCODE DC X'0' @V200809 03058000 ERR18 EQU X'18' @V2A3765 03059000 ERR04 EQU X'04' @V2A3765 03060000 ERR32 EQU X'20' @V305066 03061000 ERR36 EQU X'24' @V305066 03062000 ERR100 EQU X'64' @V305066 03063000 SPACE 2 03064000 DS 0F @V2A3765 03065000 TABSTRT EQU * @V2A3765 03066000 DC CL8'*' @V2A3765 03067000 DC A(CKAST) @V2A3765 03068000 VER DC CL8'VER' @V2A3765 03069000 DC A(GOODTHRE) @V2A3765 03070000 DC CL8'REP' @V2A3765 03071000 DC A(GOODTHRE) @V2A3765 03072000 CLOG DC CL8'LOG' @VMI0082 03073000 DC A(LOGRTN) @V60CE91 03074000 DC CL8'END' @V2A3765 03075000 DC A(CONEND) @V2A3765 03076000 DC CL8'BASE' @V2A3765 03077000 DC A(BASEREC) @V2A3765 03078000 DC CL8'NAME' @V2A3765 03079000 DC A(NAMEREC) @V2A3765 03080000 DC CL8'DUMP' @V2A3765 03081000 DC A(DUMPREC) @V2A3765 03082000 DC CL8'VERIFY' @V2A3765 03083000 DC A(GOODTHRE) @V2A3765 03084000 TABEND EQU * @V2A3765 03085000 SPACE 2 03086000 OPTTAB EQU * @V2A3765 03087000 DC CL8'INPUT' @V2A3765 03088000 DC A(INPTOPT) @V2A3765 03089000 DC CL8'TERM' @V2A3765 03090000 DC A(CONSOPT) @V2A3765 03091000 DC CL8'PRINT' @V2A3765 03092000 DC A(PRINTOPT) @V2A3765 03093000 DC CL8'NOPRINT' @V2A3765 03094000 DC A(NOPRTOPT) @V2A3765 03095000 DC CL8')' @V2A3765 03096000 DC A(OPTEND) @V2A3765 03097000 DC 8X'FF' @V2A3765 03098000 DC A(OPTEND) @V2A3765 03099000 OPTTABE EQU * @V2A3765 03100000 SPACE 2 03101000 TABADDR EQU 8 DISPLACEMENT OF BRANCH ADDR @V2A3765 03102000 TABENT EQU 12 LENGTH OF TABLE ENTRY @V2A3765 03103000 TABNUM EQU (TABEND-TABSTRT)/TABENT NO. OF TABLE ENTRIES @V2A3765 03104000 OPTNUM EQU (OPTTABE-OPTTAB)/TABENT @V2A3765 03105000 SPACE 3 03106000 ESDREC DC X'02C5E2C4' @V2A3765 03107000 ENDREC DC X'61FFFF61' @V2A3765 03108000 TXTREC DC X'02E3E7E3' @V2A3765 03109000 ENDRECA DC XL4'02C5D5C4' @VA04591 03110000 SPACE 3 03111000 LFTPRN EQU C'(' @V200809 03112000 RGTPRN EQU C')' @V200809 03113000 BLANK EQU C' ' @V200809 03114000 COMMA EQU C',' @V200809 03115000 A EQU C'A' @VM08595 03116000 F EQU C'F' @VM08595 03117000 M3 EQU 3 MASK B'0011' @VA09155 03117300 M7 EQU 7 MASK B'0111' @VA09155 03117600 ZERO EQU C'0' @VM08595 03118000 NINE EQU C'9' @VM08595 03119000 XZERO EQU 0 @VA07108 03120000 XONE EQU 1 @VA10838 03121000 SPACE 3 03122000 EJECT 03123000 * 03124000 * MESSAGES WRITTEN TO SYSPRINT AND TO THE CONSOLE WHEN IN 03125000 * CONSOLE MODE. 03126000 * 03127000 WTOLIST EQU * @V200809 03128000 DS 0F @V200809 03129000 WTOLEN DC AL2(0) WTO LENGTH @V200809 03130000 DC B'0000000000000000' MCS FLAGS @V200809 03131000 WTOMSG DC 80C' ' MESSAGE BUFFER @V2A3765 03132000 SPACE 3 03133000 LIBNTFDL DC AL1(LIBNTFDE-LIBNTFDS) @V2A3765 03134000 LIBNTFDS DC C'DMSZAP002W ' @V2A3765 03135000 DC C'FILE ''' @V2A3765 03136000 LIBNTFDN DC CL8' ' @V2A3765 03137000 DC C' ' @V2A3765 03138000 LIBNTFDT DC CL8' ' @V2A3765 03139000 DC C''' NOT FOUND.' @V2A3765 03140000 LIBNTFDE EQU * @V2A3765 03141000 SPACE 3 03142000 FLUSHMGL DC AL1(FLUSHMGE-FLUSHMGN) @V200809 03143000 FLUSHMGN DC C'DMSZAP193W ' @V305066 03144000 FLUSHMGT DC C'PRECEDING CONTROL RECORD FLUSHED.' @V2A3765 03145000 FLUSHMGE EQU * @V200809 03146000 SPACE 2 03147000 CSTNTFDL DC AL1(CSTNTFDE-CSTNTFDN) @V200809 03148000 CSTNTFDN DC C'DMSZAP194W ' @V305066 03149000 CSTNTFDT DC C'CSECT NOT FOUND IN ' @VA03621 03150000 CSTNTFTY DC CL8' ' @VA03621 03151000 DC C' ''' @VA03621 03152000 CSTNTFDM DC CL8' ' @VA03621 03153000 DC C''' - SET NO GO SWITCH.' @V2A3765 03154000 CSTNTFDE EQU * @V200809 03155000 SPACE 2 03156000 NOGOMGL DC AL1(NOGOMGE-NOGOMGN) @V200809 03157000 NOGOMGN DC C'DMSZAP190W ' @V305066 03158000 NOGOMGT DC C'INVALID CONTROL RECORD OR NOGO SWITCH SET.' @V2A3765 03159000 NOGOMGE EQU * @V200809 03160000 SPACE 2 03161000 ENDMSGL DC AL1(ENDMSGE-ENDMSGN) @V200809 03162000 ENDMSGN DC C'DMSZAP750I ' @V2A3765 03163000 ENDMSGT DC C'ZAP PROCESSING COMPLETE.' @V2A3765 03164000 ENDMSGE EQU * @V200809 03165000 SPACE 2 03166000 VERJMSGL DC AL1(VERJMSGE-VERJMSGN) @V200809 03167000 VERJMSGN DC C'DMSZAP200W ' @V2A3765 03168000 DC C'VERIFY REJECT - SET NO GO SWITCH.' @V2A3765 03169000 VERJMSGE EQU * @V200809 03170000 SPACE 2 03171000 OVLPMSGL DC AL1(OVLPMSGE-OVLPMSGN) @V200809 03172000 OVLPMSGN DC C'DMSZAP191W ' @V305066 03173000 DC C'PATCH OVERLAPS - SET NO GO SWITCH.' @V2A3765 03174000 OVLPMSGE EQU * @V200809 03175000 SPACE 3 03176000 INVADMGL DC AL1(INVADMGE-INVADMGN) @V2A3765 03177000 INVADMGN DC C'DMSZAP248W ' @V2A3765 03178000 DC C'INVALID VER/REP DISP - SET NO GO SWITCH.' @V2A3765 03179000 INVADMGE EQU * @V2A3765 03180000 SPACE 2 03181000 CSTFDMGL DC AL1(CSTFDMGE-CSTFDMGN) @V200809 03182000 CSTFDMGN DC C'DMSZAP751I ' @V2A3765 03183000 DC C'MEMBER FOUND IN LIBRARY ' @V2A3765 03184000 DC C'''' @V200809 03185000 CSTFDMGT DC CL8' ' @V200809 03186000 DC C'''.' @V2A3765 03187000 CSTFDMGE EQU * @V200809 03188000 SPACE 3 03189000 MEMNTFDL DC AL1(MEMNTFDE-MEMNTFDN) @V2A3765 03190000 MEMNTFDN DC C'DMSZAP247W ' @V2A3765 03191000 MEMNTFDT DC C'MEMBER ''' @V2A3765 03192000 MEMNTFDM DC CL8' ' @V2A3765 03193000 DC C''' NOT FOUND - SET NO GO SWITCH.' @V2A3765 03194000 MEMNTFDE EQU * @V2A3765 03195000 SPACE 3 03196000 NOLDRTBL DC AL1(NOLDRTBE-NOLDRTBN) @V2A3765 03197000 NOLDRTBN DC C'DMSZAP246W ' @V2A3765 03198000 NOLDRTBT DC C'NO LOADER TABLE PRESENT FOR MODULE ''' @V2A3765 03199000 NOLDRTBM DC CL8' ' @V2A3765 03200000 DC C''' - SET NO GO SWITCH.' @V2A3765 03201000 NOLDRTBE EQU * @V2A3765 03202000 SPACE 3 03203000 ODDIGITL DC AL1(ODDIGITE-ODDIGITN) @V200809 03204000 ODDIGITN DC C'DMSZAP192W ' @V305066 03205000 DC C'ERROR-ODD NUMBER OF DIGITS-SET NO GO SWITCH.' @V2A3765 03206000 ODDIGITE EQU * @V200809 03207000 SPACE 2 03208000 INVBAMGL DC AL1(INVBAMGE-INVBAMGN) @VM08551 03209000 INVBAMGN DC C'DMSZAP195W ' @V305066 03210000 DC C'BASE VALUE INVALID - SET NO GO SWITCH.' @V2A3765 03211000 INVBAMGE EQU * @VM08551 03212000 SPACE 3 03213000 CSCTHDRM DC C'CSECT NAME ' @V2A3765 03214000 CSECTL DC C'SIZE ' @VA04197 03215000 SPACE 3 03216000 DUPMSGN DC C'LINES ' @V2A3765 03217000 FRSTADDR DC CL6' ' @V2A3765 03218000 DC C' TO ' @V2A3765 03219000 SECDADDR DC CL6' ' @V2A3765 03220000 DC C' SAME AS ABOVE' @V2A3765 03221000 DC CL97' ' @V2A3765 03222000 EJECT 03223000 * 03224000 * ERROR MESSAGES WRITTEN TO THE CONSOLE. 03225000 * 03226000 DS 0F @V200809 03227000 INVPARM EQU * @V200809 03228000 DMSERR NUM=70,LET=E,TEXT='INVALID PARAMETER ''........''', X03229000 SUB=(CHARA,(R2)) @V200809 03230000 MVI ERCODE,ERR18 SET ERROR CODE @V2A3765 03231000 BR R10 @V2A3765 03232000 EJECT 1 03233000 PRTERMSG EQU * @V2A3765 03234000 DMSERR NUM=245,LET=S,SUB=(DEC,(R15)), @V2A3765X03235000 TEXT='ERROR ''...'' ON PRINTER' @V2A3765 03236000 BAL R10,CLOSELIB CLOSE LIBRARY @V2A3765 03237000 BAL R10,CLOSINP AND INPUT FILE @V2A3765 03238000 MVI ERCODE,ERR100 SET RC = 100 @V305066 03239000 B NOMORE @V2A3765 03240000 EJECT 1 03241000 MISSLIB EQU * @V200809 03242000 DMSERR NUM=001,LET=E,TEXT='NO FILENAME SPECIFIED' @V2A3765 03243000 MVI ERCODE,ERR18 SET ERROR CODE @V2A3765 03244000 BR R10 @V2A3765 03245000 EJECT 1 03246000 NOFUNC EQU * @V2A3765 03247000 DMSERR NUM=047,LET=E,TEXT='NO FUNCTION SPECIFIED' @V2A3765 03248000 MVI ERCODE,ERR18 SET ERROR CODE @V2A3765 03249000 BR R10 @V2A3765 03250000 EJECT 1 03251000 LIBNTFD1 EQU * @V200809 03252000 LA R7,8(,R8) GET FILETYPE ADDRESS @V2A3765 03253000 DMSERR NUM=002,LET=E,MF=(E,RDERLIST), @V2A3765X03254000 TEXT='FILE ''........ ........'' NOT FOUND', @V2A3765X03255000 SUB=(CHARA,(8),CHARA,(7)) @V2A3765 03256000 MVI ERCODE,ERR18 SET ERROR CODE @V2A3765 03257000 BR R10 @V200809 03258000 EJECT 1 03259000 INVFUNC EQU * @V2A3765 03260000 DMSERR NUM=014,LET=E,SUB=(CHARA,(R2)), @V2A3765X03261000 TEXT='INVALID FUNCTION ''........''' @V2A3765 03262000 MVI ERCODE,ERR18 SET ERROR CODE @V2A3765 03263000 BR R10 @V2A3765 03264000 EJECT 1 03265000 INVFORM EQU * @V2A3765 03266000 LA R8,RDNAME GET FILE NAME @V2A3765 03267000 LA R10,RDTYPE AND FILE TYPE @V2A3765 03268000 DMSERR NUM=056,LET=E,SUB=(CHARA,(R8),CHARA,(R10)), @V2A3765X03269000 TEXT='FILE ''........ ........'' CONTAINS INVALID RECORDX03270000 FORMATS',MF=(E,RDERLIST) @V2A3765 03271000 BAL R10,CLOSELIB CLOSE LIBRARY @V2A3765 03272000 BAL R10,CLOSINP CLOSE INPUT @V2A3765 03273000 MVI ERCODE,ERR32 SET RETURN CODE @V305066 03274000 B NOMORE @V2A3765 03275000 EJECT 1 03276000 LIBNTV EQU * @V200809 03277000 LA R8,STNAME GET LIBRARY NAME @V200809 03278000 LA R7,8(,R8) GET FILETYPE ADDRESS @V2A3765 03279000 DMSERR NUM=208,LET=E,MF=(E,RDERLIST),TEXT='FILE ''........ ...X03280000 .....'' IS NOT VARIABLE RECORD FORMAT', @V2A3765X03281000 SUB=(CHARA,(8),CHARA,(7)) @V2A3765 03282000 SPACE 1 03283000 BAL R10,CLOSELIB CLOSE LIBRARY @V2A3765 03284000 BAL R10,CLOSINP AND INPUT FILE @V2A3765 03285000 MVI ERCODE,ERR18 SET ERROR CODE @V2A3765 03286000 B NOMORE @V2A3765 03287000 EJECT 1 03288000 FILENTF EQU * @V2A3765 03289000 LA R7,8(,R8) GET FILETYPE ADDRESS @V2A3765 03290000 DMSERR NUM=07,LET=E,MF=(E,RDERLIST), @V2A3765X03291000 TEXT='FILE ''........ ........'' IS NOT FIXED, 80 CHAR. X03292000 RECORDS',SUB=(CHARA,(8),CHARA,(7)) @V2A3765 03293000 BAL R10,CLOSELIB GO CLOSE LIBRARY @V2A3765 03294000 BAL R10,CLOSINP AND INPUT FILE @V2A3765 03295000 MVI ERCODE,ERR18 SET ERROR CODE @V2A3765 03296000 B NOMORE @V2A3765 03297000 EJECT 1 03298000 INVOPT EQU * @V2A3765 03299000 DMSERR NUM=003,LET=E,SUB=(CHARA,(R2)), @V2A3765X03300000 TEXT='INVALID OPTION ''........''' @V2A3765 03301000 MVI ERCODE,ERR18 SET ERROR CODE @V2A3765 03302000 BR R10 @V2A3765 03303000 EJECT 1 03304000 LIBRO EQU * @V200809 03305000 LA R8,STNAME SET LIBRARY NAME ADDR @V200809 03306000 LA R7,STNAME+8 AND FILE TYPE ADDRESS @V2A3765 03307000 DMSERR MF=(E,RDERLIST),NUM=210,LET=E,TEXT='FILE ''........ ...X03308000 .....'' IS ON A READ/ONLY DISK', @V2A3765X03309000 SUB=(CHARA,(R8),CHARA,(R7)) @V2A3765 03310000 SPACE 1 03311000 BAL R10,CLOSELIB GO CLOSE LIBRARY @V2A3765 03312000 BAL R10,CLOSINP AND INPUT FILE @V2A3765 03313000 MVI ERCODE,ERR36 SET RC = 36 @V305066 03314000 B NOMORE @V2A3765 03315000 EJECT 1 03316000 RDLIBERR EQU * @V2A3765 03317000 LR R10,R15 SAVE RETURN CODE @V2A3765 03318000 TM SCANSWT,INPUTERR INPUT FILE ERROR? @V2A3765 03319000 BO INPTERR1 BRANCH IF YES @V2A3765 03320000 LA R8,RDNAME GET FILENAME ADDRESS @V2A3765 03321000 LA R7,RDTYPE GET FILETYPE ADDRESS @V2A3765 03322000 LA R14,RDMODE GET FILEMODE ADDRESS @V2A3765 03323000 B LIBERR @V2A3765 03324000 INPTERR1 EQU * @V2A3765 03325000 LA R8,INFILEN POINT TO FILENAME @V2A3765 03326000 LA R7,INFILEN+8 AND TO FILETYPE @V2A3765 03327000 LA R14,INMODE AND FILEMODE @V2A3765 03328000 LIBERR EQU * @V2A3765 03329000 DMSERR MF=(E,RDERLIST),NUM=104,LET=S,TEXT='ERROR ''...'' READIX03330000 NG FILE ''........ ........ ..'' FROM DISK', @V2A3765X03331000 SUB=(DEC,(10),CHARA,(8),CHARA,(7),CHARA,(14)) @V2A3765 03332000 BAL R10,CLOSELIB GO CLOSE LIBRARY @V2A3765 03333000 BAL R10,CLOSINP AND INPUT FILE @V2A3765 03334000 MVI ERCODE,ERR18 SET ERROR CODE @V2A3765 03335000 B NOMORE @V2A3765 03336000 EJECT 1 03337000 RDERLIST DMSERR MF=L,SUB=(HEX,0,CHAR,0,CHAR,0,CHAR,0) @V2A3765 03338000 SPACE 2 @VA04197 03339000 DMSTORE DMSERR TEXT='VIRTUAL STORAGE EXCEEDED', @VA04197X03340000 LET=S,NUM=109 @VA04197 03341000 MVI ERCODE,104 SET ERROR CODE @VA04197 03342000 B CONEND @VA04197 03343000 EJECT 03343125 DUMMYLOG EQU * 03343250 DMSERR TEXT='DUMMY LOG ENTRY IN FILE ''........ ZAPLOG ..''', X03343375 NUM=249,LET=I,SUB=(CHARA,MEMNAME,CHARA,AUXFM2), X03343500 MF=(E,RDERLIST) @VA10327 03343625 BR R10 RETURN @VA10327 03343750 SPACE 03344000 LTORG NEEDED CONSTANTS ... @VM03228 03345000 EJECT 03346000 ESD DSECT @V2A3765 03347000 RECTYPE DS CL4 @V2A3765 03348000 DS CL6 @V2A3765 03349000 ESDNUM DS CL2 @V2A3765 03350000 DS CL2 @VA07108 03351000 ESDCNT DS CL2 @VA07108 03352000 ESDHDR EQU * @V2A3765 03353000 ESDHDRL EQU ESDHDR-RECTYPE @V2A3765 03354000 SPACE 3 03355000 ESDDAT DSECT @V2A3765 03356000 ESDNAME DS CL8 @V2A3765 03357000 ESDTYPE DS C @V2A3765 03358000 ESDSTART DS AL3 @V2A3765 03359000 DS C @V2A3765 03360000 ESDLNTH DS AL3 @V2A3765 03361000 ESDEND EQU * @V2A3765 03362000 ESDENDL EQU ESDEND-ESDNAME @V2A3765 03363000 SPACE 3 03364000 TXTDAT DSECT @V2A3765 03365000 TXTTYPE DS CL4 @V2A3765 03366000 DS C @V2A3765 03367000 TXTADDR DS AL3 @V2A3765 03368000 DS CL2 @V2A3765 03369000 TXTBYTES DS H @V2A3765 03370000 DS CL2 @V2A3765 03371000 TXTID DS H @V2A3765 03372000 TXTINFO DS CL56 @V2A3765 03373000 DS CL8 @V2A3765 03374000 TXTEND EQU * @V2A3765 03375000 SPACE 3 03376000 DICTENT DSECT @V2A3765 03377000 DICTNAME DS CL8 @V2A3765 03378000 DICTINDX DS CL2 @V2A3765 03379000 DS C @V2A3765 03380000 DICTTYPE DS C @V2A3765 03381000 EJECT 03382000 NUCON @V200809 03383000 CMSCB @V200809 03384000 FSTB @V200809 03385000 * 03386000 * MODULE HEADER RECORD 03387000 * 03388000 MDREC DSECT @V2A3765 03389000 MDSTART DS 1F MODULE STARTING ADDRESS @V2A3765 03390000 MDFIRST DS 1F MODULE BEGINNING ADDRESS @V2A3765 03391000 MDLAST DS 1F MODULE ENDING ADDRESS @V2A3765 03392000 DS 5F @V2A3765 03393000 MDLDRFGS DS 1F LOADER FLAGS @V2A3765 03394000 DS 1F @V2A3765 03395000 MDLDRENT DS 1H NO. LOADER TABLE ENTRIES @V2A3765 03396000 SPACE 3 03397000 * 03398000 * LOADER RECORD ENTRY 03399000 * 03400000 LDRENT DSECT @V2A3765 03401000 LDRNAME DS D SYMBOLIC NAME FROM ESD @V2A3765 03402000 LDRFLG1 DS X @V2A3765 03403000 LDRINFO DS 3X @V2A3765 03404000 LDRNOTE1 DS X USE COUNT FOR DYNAMIC LOAD @V2A3765 03405000 LDRVALUE DS AL3 @V2A3765 03406000 LDRFLG2 DS X @V2A3765 03407000 LDRIDN EQU X'80' ENTRY ADDED BY IDENTITY @V2A3765 03408000 LDRLOC EQU X'04' NAME LOCATED IN A TXTLIB @V2A3765 03409000 LDRSECT EQU X'02' SECTION DEFINITION ENTRY @V2A3765 03410000 LDRCHN EQU X'01' IDENTITY CHAIN EXISTS @V2A3765 03411000 LDRIDCH DS AL3 ADDRESS OF IDENTITY CHAIN @V2A3765 03412000 LDREND EQU * @V2A3765 03413000 LDRLNTH EQU LDREND-LDRENT LOADER RECORD LENGTH @V2A3765 03414000 EJECT 1 03415000 REGEQU @V200809 03416000 FSCBD @V60CE91 03417000 END 03418000