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