TITLE 'IKJEGDEB - TSO TEST LIST DEB ROUTINE' 00120002 * /* START OF SPECIFICATIONS **** 00130002 *02* PROCESSOR = ASSEMBLER 00140002 **** END OF SPECIFICATIONS ***/ 00142002 *********************************************************************** 00150002 * * 00200002 * STATUS -- * 00250002 * CHANGE LEVEL 00, VERSION NO. 02, OS/VS2 * 00300002 * * 00350002 * FUNCTION/OPERATION -- * 00400002 * THIS SUBCOMMAND PROCESSOR RECEIVES CONTROL FROM THE TEST MA * 00450002 * LINE PROGRAM. IT DISPLAYS ALL OR PART OF THE DEB AT THE * 00500002 * SPECIFIED ADDRESS. * 00550002 * * 00600002 * ENTRY POINTS -- * 00650002 * IKJEGDEB - MAIN ENTRY TO LISTDEB * 00700002 * DEBVALCK - PARSE VALIDITY CHECK EXIT FOR ADDRESS OF DEB * 00750002 * * 00800002 * INPUT -- * 00850002 * ONE LINE OF INPUT FROM THE TERMINAL CONTAINING THE SUBCOMMAND * 00900002 * * 00950002 * OUTPUT -- * 01000002 * LINES OF OUTPUT TO THE TERMINAL OR SPECIFIED DATA SET CONTAINING * 01050002 * DESCRIPTIVE HEADERS AND THE REQUESTED DEB FIELDS. * 01100002 * * 01150002 * EXTERNAL REFERENCES -- * 01200002 * 1. IKJPARS - TO SCAN THE INPUT BUFFER * 01250002 * 2. IKJEGCVT - TO CHECK AND CONVERT THE ADDRESS, * 01300002 * AND TO CONVERT THE DEB TO PRINTABLE HEX * 01350002 * 3. IKJEGIO - TO OUTPUT THE HEADER AND DEB FIELDS * 01400002 * * 01500002 * EXITS, NORMAL -- * 01550002 * RETURN TO IKJEGMNL VIA REGISTER 14 * 01600002 * * 01650002 * EXITS, ERROR -- * 01700002 * RETURN TO IKJEGMNL VIA REGISTER 14 * 01750002 * * 01800002 * TABLES/WORK AREAS -- * 01850002 * TCOMTAB - TEST TABLE AND WORKAREA * 01900002 * * 01950002 * ATTRIBUTES -- * 02000002 * REENTRANT, REFRESHABLE * 02050002 * * 02100002 * CHARACTER CODE DEPENDENCY -- * 02150002 * RE-ASSEMBLY IS REQUIRED FOR CHANGE OF CODE * 02200002 * * 02250002 * NOTES -- * 02300002 * THE LISTDEB ROUTINE WILL PRINT ONLY THE BASIC SECTION AND ANY * 02350002 * DIRECT ACCESS SECTIONS OF THE SPECIFIED DEB. * 02400002 * THE SPECIFIED DEB IS ASSUMED TO BE A VALID DEB. * 02450002 * * 02500002 *********************************************************************** 02550002 EJECT 02600002 COPY IKJEGSIO 02610002 TCOMTAB 02650002 SPACE 2 02700002 TSTCWORK 02750002 SPACE 2 02800002 IKJPPL 02850002 SPACE 2 02900002 IKJPARMA 02950002 EJECT 03000002 DCBD DSORG=PS 03050002 EJECT 03100002 IKJEGDEB CSECT 03150002 *********************************************************************** 04100002 * * 04150002 * REGISTER EQUATES * 04200002 * * 04250002 *********************************************************************** 04300002 SPACE 2 04350002 R0 EQU 0 REGISTER 0 04400002 R1 EQU 1 REGISTER 1 04450002 R2 EQU 2 REGISTER 2 04500002 R3 EQU 3 REGISTER 3 - BASE FOR DEB 04550002 R4 EQU 4 REGISTER 4 04600002 R5 EQU 5 BASE FOR DBWKAREA 04650002 R6 EQU 6 REGISTER 6 04700002 R7 EQU 7 REGISTER 7 04750002 R8 EQU 8 BASE FOR IKJPARMD 04800002 R9 EQU 9 BASE FOR TCOMTAB 04850002 R10 EQU 10 REGISTER 10 04900002 R11 EQU 11 REGISTER 11 04950002 R12 EQU 12 PROGRAM BASE 05000002 R13 EQU 13 REGISTER 13 05050002 R14 EQU 14 REGISTER 14 05100002 R15 EQU 15 REGISTER 15 05150002 SPACE 2 05200002 *********************************************************************** 05250002 * * 05300002 * OTHER EQUATES * 05350002 * * 05400002 *********************************************************************** 05450002 SPACE 2 05500002 BADESTAE EQU 24 RETURN CODE FOR UNSUCCESSFUL ESTAE 05510002 M0040 EQU 40 MESSAGE NUMBER 05550002 M0041 EQU 41 MESSAGE NUMBER 05560002 M0103 EQU 103 MESSAGE NUMBER 05570002 M0247 EQU 247 MESSAGE NUMBER 05580002 M0248 EQU 248 MESSAGE NUMBER 05582002 M0268 EQU 268 MESSAGE NUMBER 05590002 M0298 EQU 298 MESSAGE NUMBER 05592002 N30 EQU 30 DECIMAL 30 05600002 N0 EQU 0 DECIMAL 0 05650002 N1 EQU 1 DECIMAL 1 05700002 N2 EQU 2 DECIMAL 2 05750002 N3 EQU 3 DECIMAL 3 05800002 N4 EQU 4 DECIMAL 4 05850002 N5 EQU 5 DECIMAL 5 05900002 N104 EQU 104 DECIMAL 104 06000002 N8 EQU 8 DECIMAL 8 06050002 N11 EQU 11 DECIMAL 11 06200002 N12 EQU 12 DECIMAL 12 06250002 N15 EQU 15 DECIMAL 15 06400002 N16 EQU 16 DECIMAL 16 06450002 N20 EQU 20 DECIMAL 20 06550002 N24 EQU 24 DECIMAL 24 06600002 N32 EQU 32 DECIMAL 32 06950002 N40 EQU 40 DECIMAL 40 07050002 N56 EQU 56 DECIMAL 56 07150002 N68 EQU 68 DECIMAL 68 07200002 N79 EQU 79 DECIMAL 79 07250002 N80 EQU 80 DECIMAL 80 07300002 NOTSYM EQU 10 BC INSTR MASK, BRANCH POSTIVE OR 0 07350002 SPACE 2 07400002 *********************************************************************** 07450002 * * 07500002 * TO LIMIT THE SIZE OF IKJEGDEB, THE MAJORITY OF THE FIELD * 07550002 * HEADERS HAVE BEEN EQUATED TO FIELDS IN THE PARSE CSECT, * 07600002 * IKJEGDBP. THOSE EQUATES ARE AT THE END OF THE MODULE. THE * 07650002 * FOLLOWING EQUATES SET UP THOSE FIELD HEADER EQUATES. * 07700002 * * 07750002 *********************************************************************** 07800002 SPACE 2 07850002 LENKEYWD EQU 6 LENGTH OF IKJKEYWD PCE 07900002 LENNAME EQU 13 LENGTH OF IKJNAME PCE 07950002 FLDHDR EQU LENKEYWD+LENNAME NORMAL DISPLACEMENT BETWEEN FIELD 08000002 * HEADERS IN PARSE CSECT, IKJEGDBP 08050002 FIRSTHDR EQU 108 DISPLACEMENT INTO PARSE CSECT, 08100002 * IKJEGDBP, OF FIRST FIELD HDR, NMSUB 08150002 EJECT 08200002 SAVE (14,12),,* 08250002 LR R12,R15 08300002 USING IKJEGDEB,R12 ESTABLISH PROGRAM ADDRESSABILITY 08350002 USING TCOMTAB,R9 ESTABLISH TCOMTAB ADDRESSABILITY 08400002 L R15,REGSAVE2 ADDRESS OF LISTDEB SAVE AREA 08450002 ST R13,N4(R15) STORE REGISTER 13 NEW SAVE AREA 08500002 ST R15,N8(R13) STORE NEW SAVE AREA ADDRESS 08550002 LR R13,R15 R13 NOW POINTS TO NEW SAVE AREA 08600002 L R7,WORKAREA ADDR OF GENERAL WORK AREA FOR CMDS 08650002 USING TSTCWORK,R7 08700002 LA R5,CWORKCMD ADDRESS OF WORK AREA FOR CMDS 08750002 USING DBWKAREA,R5 ESTABLISH WORK AREA ADDRESSABILITY 08800002 DROP R7 08850002 L R3,TSTSTAE ADDRESS OF STAE EXIT ROUTINE 09100002 LA R1,STAELIST STAE PARAMETER LIST 09150002 ST R12,N68(R13) SAVE MY BASE IN MY SAVE AREA 09200002 MVC N0(N16,R1),LFSTAE STAE PARAMETER LIST TO WORK AREA 09250002 ESTAE (R3),CT,PARAM=IKJEGSPL,RECORD=YES,XCTL=NO,MF=(E,(R1)) 09310002 LTR R15,R15 WAS STAE ISSUED SUCCESSFULLY 09350002 SMTSTAE DS 0H SMT TESTCASE LABEL 09400002 * INSUFFICIENT CORE TO ISSUE STAE 09450002 * TESTCASE ID TDEB2800 09500002 BZ GOPARSE YES, GO SET UP TO PARSE COMMAND 09550002 STC R15,TSTESTRC SAVE RETURN CODE FOR MAINLINE 09600002 LA R15,BADESTAE PASS BACK A BAD ESTAE RTN CODE 09650002 B DEBRET BRANCH TO EXIT 09750002 GOPARSE DS 0H 09850002 MVI OUTPUTSW,HEX00 ZERO OUTPUT SWITCH 09900002 LR R1,R5 R1 POINTS TO LIST FOR PARSE 09950002 USING PPL,R1 10000002 MVC PPLUPT(N4),TSTUPT POINTER TO UPT FOR PARSE 10050002 MVC PPLECT(N4),TSTECT POINTER TO ECT FOR PARSE 10100002 MVC PPLECB(N4),TSTCPECB POINTER TO CP ECB FOR PARSE 10150002 MVC PPLPCL(N4),PCLADDR ADDR OF PCL INTO PARSE LIST 10200002 LA R2,TSTANSPL LOAD ADDRESS OF ANSWER PLACE 10250002 ST R2,PPLANS PTR TO ANSWER PLACE 10300002 MVC PPLCBUF(N4),INBUF PTR TO COMMAND BUFFER 10350002 ST R13,PPLUWA PTR TO SAVE AREA 10400002 DROP R1 10450002 LINK EP=IKJPARS,ERRET=LINKFAIL GO TO PARSE 10500002 PABEND1 DS 0H POSSIBLE ABEND RESUME ADDRESS 10502002 B LINKOK IF CONTROL COMES HERE SVC 6 OK 10510002 LINKFAIL DS 0H 10530002 LR R2,R1 TRANSFER THE ABEND CODE 10540002 LR R3,R15 TRANSFER THE RETURN CODE 10542002 XC TSTIOPRM,TSTIOPRM CLEAR PARM LIST FOR I/O CALL 10544002 IKJEGSIO SVCERR,SVC=6,ABENDRG=(R2),RC=(R3),ID=DEB11, *10546002 INST11=(NUM,I0040),MF=(E,TSTIOPRM) CALL I/O 10548002 B DEBRET BRANCH TO TEST RTN CODE AND EXIT 10548402 LINKOK DS 0H 10548802 SMTPARS DS 0H SMT TESTCASE LABEL 10600002 * LINK TO PARSE FAILED 10650002 * TESTCASE ID TDEB2700 10700002 B PARSDONE GO TO PARSDONE 10750002 SPACE 1 10800002 *********************************************************************** 10850002 * THIS IS THE PARSE ADDRESS VALIDITY CHECK EXIT ROUTINE * 10900002 *********************************************************************** 10950002 SPACE 1 11000002 DEBVALCK SAVE (14,12),,* 11050002 LR R2,R1 ADDR OF PARSE LIST FOR VALIDITY 11100002 * CHECK ROUTINES 11150002 L R9,N4(R1) LOAD R9 WITH ADDRESS OF SAVE AREA 11200002 L R12,N68(R9) RESTORE BASE REGISTER 11250002 L R5,N40(R9) RESTORE WORKAREA ADDRESSABILITY 11300002 L R1,N0(R1) ADDRESS OF ADDRESS PDE 11350002 LCR R1,R1 NEGATIVE 11400002 L R9,N56(R9) RESTORE TCOMTAB ADDRESSABILITY 11450002 L R15,REGSAVE3 LOAD SAVE AREA FOR IKJEGCVT 11500002 LCR R0,R1 R0 INDICATES CONVERT TO BINARY 11550002 ST R13,N4(R15) STORE OLD SAVE AREA ADDRESS 11600002 ST R15,N8(R13) STORE NEW SAVE AREA ADDRESS 11650002 LR R13,R15 11700002 L R15,OUTBUF PICK UP POINTER TO OUTBUF 11710002 SR R14,R14 ZERO FOR NO MSG DEFAULT VALUE 11720002 ST R14,N0(R15) STORE NO MSG INDICATOR 11730002 OI TSTFLGS4,TSTVALCK TURN ON VALIDITY CHECK BIT 11740002 L R15,TSTCONVT ENTRY POINT OF IKJEGCVT 11750002 BALR R14,R15 GO TO IKJEGCVT 11800002 LPR R1,R1 POSTIVE POINTER TO ADDRESS PDE 11850002 USING IKJPARMA,R1 R1 IS BASE FOR ADDRESS PDE 11900002 LTR R15,R15 IS RETURN CODE 0 11950002 BZ BOUNDCK YES, GO CHECK FOR VALID ADDRESS 12000002 LA R6,N4 UNSUCCESSFUL R.C. FROM CONVERT 12050002 CR R6,R15 WAS CONVERT UNABLE TO CONVERT 12100002 BNE STOP NO, WORST TROUBLES, GO SET TO END 12150002 RETCODE8 DS 0H 12250002 LA R15,N8 RC=8, PARSE GIVE REENTER MESG 12300002 PARSRTN DS 0H 12350002 NI TSTFLGS4,HEXFF-TSTVALCK TURN OFF VALIDITY CHECK BIT 12360002 L R13,N4(R13) 12400002 L R5,OUTBUF PICK UP POINTER TO OUTBUF 12402002 LH R6,N0(R5) PICK MSG LENGTH FIELD 12404002 LTR R6,R6 TEST FOR PRESENTS OF MSG 12406002 BZ NO2NDMSG IF ZERO THEN THERE ISN'T A MESSAGE 12408002 L R1,N24(R13) PICK UP POINTER TO PARSE PARM LIST 12410002 ST R5,N8(R1) STORE ADDRESS OF MESSAGE IN PARM L 12420002 NO2NDMSG DS 0H 12440002 RETURN (14,12),,RC=(15) RESTORE REGISTERS AND RETURN 12450002 BOUNDCK DS 0H 12500002 L R3,PDEUSER LOAD BINARY DEB ADDRESS 12550002 LTR R3,R3 WAS ADDRESS SYMBOLIC ? 12600002 BC NOTSYM,NOSYM BRANCH IF NOT SYMBOLIC 12650002 L R3,N0(R3) LOAD CONVERTED SYMBOLIC ADDR 12700002 ST R3,PDEUSER PDEUSER NOW POINTS TO DEB 12750002 NOSYM DS 0H 12800002 L R6,REGSAVE2 GET DEB'S SAVE AREA ADDRESS 12850002 ST R3,N32(R6) POINT DEB'S R3 TO DEB 12900002 REGTEST DS 0H 12950002 LH R4,PDEINDCT LOAD INDIRECT COUNT 13100002 LTR R4,R4 IS ADDRESS INDIRECT 13150002 BNZ FULLWORD IF INDIRECT BRANCH 13200002 TM PDEFLG4,GENR+LFPR+SFPR IS ADDRESS A REGISTER ? 13250002 BZ FULLWORD IF NOT REGISTER BRANCH 13300002 LA R3,M0268 PICK UP SECOND LEVEL MESSAGE NUMBER 13350002 B MESSAGIO PUT OUT THE MESSAGE 13400002 FULLWORD DS 0H 13450002 TM PDEUSER+N3,HEX03 ADDRESS ON FULL WORD 13500002 BNZ SETMESG NO, GO GIVE INVALID ADDRESS MESSAGE 13550002 LA R4,N32(R3) ESTAB ENDING ADDR OF DEB 13600002 L R7,PPTCB GET PP'S TCB ADDRESS 13650002 IKJEGS9G ADDRCHK,TCBADDR=(R7),VALUE=(R4),MF=(E,SVCPARMS) 13700002 C R15,EIGHT IS ADDRESS VALID ? 13750002 BE BADDEB NO, BAD DEB ADDR PRINT MESSAGE 13800002 BH STOP ERROR ENCOUNTERED IN SVC 97 13810002 LA R1,DEBBASND-DEBBASIC-N1(R3) ADDR END BASIC SEC. 13850002 PARDCB1 DS 0H NEXT INSTRUCTION MAY ABEND 13900002 L R4,DEBDCBAD-DEBBASIC(R3) GET DCB ADDRESS 13950002 PARDCB2 DS 0H PRECEDING INSTR MAY ABEND 14000002 LA R4,DCBDSORG-IHADCB(R4) GET ADDRESS OF DEB'S DCB 14050002 L R7,PPTCB GET PP'S TCB ADDRESS 14100002 * CHECK DCBDSORG FOR READABILIT 14150002 IKJEGS9G ADDRCHK,TCBADDR=(R7),VALUE=(R4),MF=(E,SVCPARMS) 14200002 C R15,EIGHT IS ADDRESS OK ? 14250002 BE BADDEB NO, DCB ADDRESS BAD - BAD DEB 14300002 BH STOP ERROR ENCOUNTERED IN SVC 97 14310002 LA R1,DEBBASND-DEBBASIC-N1(R3) ADDR END BASIC SEC. 14350002 TM DCBDSORG-IHADCB(R4),ISAM ISDEB FOR ISAM DATA SET? 14400002 BZ NOTISAM NOT ISAM, FORGET ADDED LENGTH 14450002 LA R1,DEBEXPTA-DEBISAM+L'DEBEXPTA(R1) ADD LEN ISAM 14500002 NOTISAM DS 0H CHECK FOR EXTENTS 14550002 SR R0,R0 CLEAR REGISTER TO ZERO 14600002 PARNMEX1 DS 0H NEXT INSTRUCTION MAY ABEND 14650002 IC R0,DEBNMEXT-DEBBASIC(R3) NUM EXTENTS IN DATASET 14700002 PARNMEX2 DS 0H PREVIOUS INSTR MAY ABEND 14750002 SLA R0,N4 MULTIPLY BY 16-LEN OF DA SECT 14800002 AR R0,R1 ENDING ADDRESS OF DEB 14850002 L R7,PPTCB GET ADDRESS OF PP'S TCB 14900002 LR R8,R0 GET ADDRESS OF END OF DEB 14950002 IKJEGS9G ADDRCHK,TCBADDR=(R7),VALUE=(R8),MF=(E,SVCPARMS) 15000002 C R15,EIGHT IS RETURN CODE 0 OR 4 ? 15050002 BE BADDEB NO, BAD DEB ADDR PRINT MESSAGE 15060002 BH STOP ERROR ENCOUNTERED IN SVC 97 15070002 SR R15,R15 SET RETURN CODE TO 0 15100002 B PARSRTN ADDRESS OK - RETURN TO PARSE 15150002 BADDEB DS 0H 15200002 LA R3,M0298 OBTAIN SECOND LEVEL MESSAGE NUMBER 15250002 B MESSAGIO GO GIVE MESSAGE 15300002 SETMESG DS 0H 15350002 L R2,N0(R2) PICK UP ADDRESS PDE POINTER 15360002 XC TSTIOPRM,TSTIOPRM CLEAR OUT PARM LIST FOR I/O 15400002 IKJEGSIO MSG,FIRST=M0101,INST11=(APDE,(R2)),SECOND=M0280, CALL*15410002 INST21=(NUM,I0003),ID=DEB11,MF=(E,TSTIOPRM) IO ISSUE MSG 15430002 B IOPARSE RETURN TO PARSE 15442002 MESSAGIO DS 0H 15450002 L R2,N0(R2) PTR TO ADDRESS PDE 15800002 XC TSTIOPRM,TSTIOPRM CLEAR OUT PARM LIST FOR I/O 15850002 IKJEGSIO MSG,FIRST=M0101,INST11=(APDE,(R2)),SECOND=(R3), CALL *15900002 ID=DEB11,MF=(E,TSTIOPRM) IO ISSUE ERROR MSG 15950002 IOPARSE DS 0H 16000002 LTR R15,R15 IS RETURN CODE 0 16450002 BZ RETCODE8 YES, GO BACK TO PARSE WITH RC=8 16500002 LA R6,N4 UNSUCCESSFUL I/O R.C. 16550002 CR R15,R6 COULD I/O PUT OUT MESSAGE 16600002 BNE STOP WORST TROUBLES, GO SAVE R.C. 16650002 SR R15,R15 CREATE 0 R.C. FOR MAINLINE 16700002 STOP DS 0H 16750002 ST R15,REG14 SAVE R.C. 16800002 LA R15,N12 HAVE PARSE CLEAN UP AND END 16850002 B PARSRTN GO BACK TO PARSE 16900002 SPACE 1 16950002 *********************************************************************** 17000002 * THE FOLLOWING CODE CHECKS THE FIELD,PRINT, AND ADDRESS PDE'S. IF * 17050002 * FIELD IS NOT SPECIFIED, THE PROGRAM SETS ALL THE FIELD PDE'S * 17100002 * NON-ZERO. IF PRINT IS SPECIFIED THE ADDRESS OF THE PRINT DATA SET * 17150002 * PDE IS STORED IN PRINTFLG AND LATER PASSED TO IKJEGIO1. THE ADDRESS* 17200002 * OF THE DEB IS FOUND IN THE USER WORD OF THE PARSE PARM LIST AFTER * 17250002 * CONTROL IS RETURNED FROM IKJEGCVT. * 17300002 *********************************************************************** 17350002 SPACE 1 17400002 PARSDONE DS 0H 17450002 LTR R15,R15 IS RETURN CODE 0 17500002 BNZ DEBRET1 IF NO BRANCH TO DEBRET1 17550002 DCBTRY1 DS 0H NEXT INSTRUCTION MAY ABEND 17600002 L R6,DEBDCBAD-DEBBASIC(R3) ADDR DCB FOR THIS DEB 17650002 DCBTRY2 DS 0H PREV / NEXT INSTRS MAY ABEND 17700002 TM DCBDSORG-IHADCB(R6),ISAM IS DEB ISAM DATA SET? 17750002 PABEND2 DS 0H 17800002 BZ NOTISAM1 NO, GO ON 17850002 OI OUTPUTSW,ISAMBIT YES, INDICATE FOR LATER PROCESSING 17900002 NOTISAM1 DS 0H 17950002 L R8,TSTANSPL FIND ADDRESS OF PARSE PDL 18000002 USING IKJPARMD,R8 ESTABLISH PDL ADDRESSABILITY 18050002 CLI DEBFIELD+N1,HEX00 WAS FIELD SPECIFIED 18100002 BNE PRINTCHK IF SPECIFIED CHECK FOR PRINT KEYWORD 18150002 OI OUTPUTSW,ALLCHECK 18200002 MVI NMSUB,HEXFF INDICATE THAT FIRST FIELD IS DESIRED 18250002 MVC NMSUB+N1(NMTRK-NMSUB+N1),NMSUB INDICATE ALL FDS 18300002 PRINTCHK DS 0H 18350002 CLI PRINT+N1,HEX00 WAS A PRINT DATA SET SPECIFIED 18400002 BNE PRNTSPEC IF NOT ZERO PRINT WAS SPECIFIED 18450002 SR R2,R2 18500002 B TABLESCN GO CHECK OUTPUT LINE LENGTH 18550002 PRNTSPEC LA R2,DSNAM 18600002 OI TSTFLGS1,TSTPRINT 18650002 EJECT 18700002 *********************************************************************** 18750002 * THE FOLLOWING CODE STARTS WITH THE FIRST FIELD PDE AND DETERMINES * 18800002 * WHETHER OR NOT THE FIELD CORRESPONDING TO THAT PDE IS DESIRED. IF * 18850002 * IT IS, CONTROL IS PASSED TO THE PROPER SUBROUTINE. IF NOT, THE NEXT* 18900002 * PDE IS CHECKED UNTIL ALL THE PDE'S HAVE BEEN EXAMINED. * 18950002 *********************************************************************** 19000002 SPACE 1 19050002 TABLESCN DS 0H 19100002 LA R4,N40 MINIMUM LINE LENGTH 19150002 CH R4,TMPLL IS USER SPECIFIED LINE LENGTH LESS 19200002 BH LL80 YES, GO USE 80 FOR LINE LENGTH 19250002 LA R4,N80 NO, MAXIMUM LINE LENGTH 19300002 CH R4,TMPLL IS SPECIFIED LINE LENGTH GREATER 19350002 BL LL80 YES, GO USE 80 FOR LINE LENGTH 19400002 LH R4,TMPLL NO, USE SPECIFIED LINE LENGTH 19450002 B LINESET GO SET LINE LENGTH 19500002 LL80 LA R4,N80 DEFAULT LINE LENGTH TO 80 19550002 LINESET ST R4,LINELEN STORE LINE LENGTH 19600002 ST R2,PRINTFLG INDICATE OUTPUT TO TERM OR DS 19650002 L R10,OUTBUF ADDRESS OF OUTPUT BUFFER 19700002 MVI N4(R10),BLANK CLEAR OUTPUT 19750002 MVC N5(N79,R10),N4(R10) BUFFER TO BLANKS 19800002 LA R11,BUFFER ADDR OF DEB BUFF FOR CONVERTED FLDS 19850002 MVC N0(N80,R11),N4(R10) CLEAR DEB FIELD BUFFER 19900002 NMTRY1 DS 0H NEXT INSTRUCTION MAY ABEND 19950002 MVC NMEXTSTR(N1),DEBNMEXT-DEBBASIC(R3) NUM OF EXTS 20000002 NMTRY2 DS 0H PREV NEXT INSTRS MAY ABEND 20050002 MVC EXTCTR(N1),DEBNMEXT-DEBBASIC(R3) ALSO IN EXT CTR 20100002 NMTRY3 DS 0H PREV & NEXT INSTRS MAY ABEND 20150002 CLI DEBEXSCL-DEBBASIC(R3),HEX04 IS DEB A DASD DATASET 20200002 EXTRY1 DS 0H PREVIOUS INSTR MAY ABEND 20250002 BE CHECKEXT YES, GO CHECK NUMBER OF EXTENTS 20300002 OI OUTPUTSW,NOTDASD NO, INDICATE WHY NO DASD SECTION 20350002 B SETPTRS GO SET UP TO SEARCH FIELD PDE 20400002 CHECKEXT DS 0H 20450002 CLI DEBNMEXT-DEBBASIC(R3),HEX00 ARE THEIR EXTENTS 20500002 EXTRY2 DS 0H PREVIOUS INSTR MAY ABEND 20550002 BNE SETPTRS YES, GO SET UP FIELD PDE SEARCH 20600002 OI OUTPUTSW,NOEXTENT NO, INDICATE WHY NO DASD SECTION 20650002 SETPTRS DS 0H 20700002 LA R2,DVMOD 20750002 ST R2,FSTPDEND ADDR OF 1ST PDE OF 2ND SECTION 20800002 LA R2,NMTRK ADDR OF LAST PDE OF 2ND SECTION 20850002 LA R2,N2(R2) ADDRESS GREATER THAN LAST PDE 20900002 ST R2,LASTPDE SAVE FOR END INDICATOR 20950002 LA R6,NMSUB POINT TO FIRST PDE 21000002 SR R2,R2 21050002 L R4,PCLADDR ADDRESS OF PARSE CSECT 21100002 USING IKJEGDBP,R4 21150002 PDECHECK CLI N1(R6),HEX00 WAS THIS FIELD SPECIFIED 21200002 BNE SBRTNSVR IF FIELD IS REQUESTED BRANCH 21250002 LA R6,N2(R6) OTHERWISE POINT TO NEXT PDE 21300002 C R6,LASTPDE ARE THERE MORE PDES 21350002 BE PDLEND IF NO MORE BRANCH TO PDLEND 21400002 B PDECHECK CHECK THE NEXT PDE 21450002 SBRTNSVR DS 0H 21500002 LR R11,R6 PRESERVE R6 21550002 LA R7,NMSUB ADDRESS OF FIRST PDE 21600002 SR R11,R7 FIND RELATIVE POSITION OF PDE 21650002 LA R10,N11 LOAD MULT FACTOR - EACH 21700002 * SUBRTN IS 22 BYTES 21750002 * LONG, 11 IS HALF 21800002 LA R7,SUBTAB1 LOAD ADDRESS OF TABLE 21850002 MR R10,R10 COMPUTE PROPER OFFSET 21900002 AR R7,R11 ADD OFFSET TO BASE 21950002 BR R7 GO TO PROPER SUBROUTINE 22000002 EJECT 22050002 *********************************************************************** 22100002 * THE FOLLOWING CODE CONSISTS OF 26 SUBROUTINES CORRESPONDING * 22150002 * TO THE 26 FIELDS OF THE DEB. EACH SUBROUTINE MOVES THE RELATIVE * 22200002 * ADDRESS, HEADER LENGTH, FIELD LENGTH, AND HEADER TO A COMMON * 22250002 * BUFFER. CONTROL IS THEN PASSED TO A COMMON CONVERSION AND * 22300002 * I/O ROUTINE. IT IS ESSENTIAL FOR PROPER LOGIC FLOW THAT EACH * 22350002 * SUBROUTINE HAVE THE SAME LENGTH * 22400002 *********************************************************************** 22450002 SPACE 1 22500002 SUBTAB1 DS 0H 22550002 DEB00B MVC HDRBUF(N5),HDRNMSUB FIELD HEADER TO HEADER BUFFER 22600002 MVI HDRLEN,N5 LENGTH OF FIELD HEADER 22650002 MVI FLDLEN,L'DEBNMSUB LENGTH OF DEB FIELD 22700002 MVI RELADR,DEBNMSUB-DEBBASIC DISP OF FIELD INTO DEB 22750002 B HEADERCK GO CHECK FOR SECTION HEADER 22800002 DEB01B MVC HDRBUF(N5),HDRTCBAD FIELD HEADER TO FIELD BUFFER 22850002 MVI HDRLEN,N5 LENGTH OF DEB FIELD HEADER 22900002 MVI FLDLEN,L'DEBTCBB LENGTH OF DEB FIELD 22950002 MVI RELADR,DEBTCBB-DEBBASIC DISP OF FIELD INTO DEB 23000002 B CVTANDIO GO CONVERT FIELD TO PRINTABLE 23050002 DEB04B MVC HDRBUF(N5),HDRAMLNG FIELD HEADER TO HEADER BUFFER 23100002 MVI HDRLEN,N5 LENGTH OF DEB FIELD HEADER 23150002 MVI FLDLEN,L'DEBAMLNG LENGTH OF DEB FIELD 23200002 MVI RELADR,DEBAMLNG-DEBBASIC DISP OF FIELD INTO DEB 23250002 B CVTANDIO GO CONVERT FIELD TO PRINTABLE 23300002 DEB05B MVC HDRBUF(N5),HDRDEBAD FIELD HEADER TO HEADER BUFFER 23350002 MVI HDRLEN,N5 LENGTH OF DEB FIELD HEADER 23400002 MVI FLDLEN,L'DEBDEBB LENGTH OF DEB FIELD 23450002 MVI RELADR,DEBDEBB-DEBBASIC DISP OF FIELD INTO DEB 23500002 B CVTANDIO GO CONVERT FIELD TO PRINTABLE 23550002 DEB08B MVC HDRBUF(N5),HDROFLGS FIELD HEADER TO HEADER BUFFER 23600002 MVI HDRLEN,N5 LENGTH OF DEB FIELD HEADER 23650002 MVI FLDLEN,L'DEBOFLGS LENGTH OF DEB FIELD 23700002 MVI RELADR,DEBOFLGS-DEBBASIC DISP OF FIELD INTO DEB 23750002 B CVTANDIO GO CONVERT FIELD TO PRINTABLE 23800002 DEB11B MVC HDRBUF(N5),HDRIRBAD FIELD HEADER TO HEADER BUFFER 23850002 MVI HDRLEN,N5 LENGTH OF DEB FIELD HEADER 23900002 MVI FLDLEN,L'DEBIRBB LENGTH OF DEB FIELD 23950002 MVI RELADR,DEBIRBB-DEBBASIC DISP OF FIELD INTO DEB 24000002 B CVTANDIO GO CONVERT FIELD TO PRINTABLE 24050002 DEB12B MVC HDRBUF(N5),HDROPATB FIELD HEADER TO HEADER BUFFER 24100002 MVI HDRLEN,N5 LENGTH OF DEB FIELD HEADER 24150002 MVI FLDLEN,L'DEBOPATB LENGTH OF DEB FIELD 24200002 MVI RELADR,DEBOPATB-DEBBASIC DISP OF FIELD INTO DEB 24250002 B CVTANDIO GO CONVERT FIELD TO PRINTABLE 24300002 DEB13B MVC HDRBUF(N5),HDRQSCNT FIELD HEADER TO HEADER BUFFER 24350002 MVI HDRLEN,N5 LENGTH OF DEB FIELD HEADER 24400002 MVI FLDLEN,L'DEBQSCNT LENGTH OF DEB FIELD 24450002 MVI RELADR,DEBQSCNT-DEBBASIC DISP OF FIELD INTO DEB 24500002 B CVTANDIO GO CONVERT FIELD TO PRINTABLE 24550002 DEB14B MVC HDRBUF(N5),HDRFLGS1 FIELD HEADER TO HEADER BUFFER 24600002 MVI HDRLEN,N5 LENGTH OF DEB FIELD HEADER 24650002 MVI FLDLEN,L'DEBFLGS1 LENGTH OF DEB FIELD 24700002 MVI RELADR,DEBFLGS1-DEBBASIC DISP OF FIELD INTO DEB 24750002 B CVTANDIO GO CONVERT FIELD TO PRINTABLE 24800002 DEB15B MVC HDRBUF(L'HDRRSRVD),HDRRSRVD 24850002 MVI HDRLEN,L'HDRRSRVD LENGTH OF DEB FIELD HEADER 24900002 MVI FLDLEN,N1 LENGTH OF DEB FIELD 24950002 MVI RELADR,N15 DISPLACEMENT OF FIELD INTO DEB 25000002 B CVTANDIO GO CONVERT FIELD TO PRINTABLE 25050002 DEB16B MVC HDRBUF(N5),HDRNMEXT FIELD HEADER TO HEADER BUFFER 25100002 MVI HDRLEN,N5 LENGTH OF DEB FIELD HEADER 25150002 MVI FLDLEN,L'DEBNMEXT LENGTH OF DEB FIELD 25200002 MVI RELADR,DEBNMEXT-DEBBASIC DISP OF FIELD INTO DEB 25250002 B CVTANDIO GO CONVERT FIELD TO PRINTABLE 25300002 DEB17B MVC HDRBUF(N5),HDRUSPRG FIELD HEADER TO HEADER BUFFER 25350002 MVI HDRLEN,N5 LENGTH OF DEB FIELD HEADER 25400002 MVI FLDLEN,L'DEBUSRPB LENGTH OF DEB FIELD 25450002 MVI RELADR,DEBUSRPB-DEBBASIC DISP OF FIELD INTO DEB 25500002 B CVTANDIO GO CONVERT FIELD TO PRINTABLE 25550002 DEB20B MVC HDRBUF(N5),HDRPRIOR FIELD HEADER TO HEADER BUFFER 25600002 MVI HDRLEN,N5 LENGTH OF DEB FIELD HEADER 25650002 MVI FLDLEN,L'DEBPRIOR LENGTH OF DEB FIELD 25700002 MVI RELADR,DEBPRIOR-DEBBASIC DISP OF FIELD INTO DEB 25750002 B CVTANDIO GO CONVERT FIELD TO PRINTABLE 25800002 DEB21B MVC HDRBUF(N5),HDRECBAD FIELD HEADER TO HEADER BUFFER 25850002 MVI HDRLEN,N5 LENGTH OF DEB FIELD HEADER 25900002 MVI FLDLEN,L'DEBECBB LENGTH OF DEB FIELD 25950002 MVI RELADR,DEBECBB-DEBBASIC DISP OF FIELD INTO DEB 26000002 B CVTANDIO GO CONVERT FIELD TO PRINTABLE 26050002 DEB24B1 MVC HDRBUF(L'HDRPROTG),HDRPROTG 26100002 MVI HDRLEN,L'HDRPROTG LENGTH OF DEB FIELD HEADER 26150002 MVI FLDLEN,L'DEBPROTG LENGTH OF DEB FIELD 26200002 MVI RELADR,DEBPROTG-DEBBASIC DISP OF FIELD INTO DEB 26250002 B CVTANDIO GO CONVERT FIELD TO PRINTABLE 26300002 DEB25B MVC HDRBUF(N5),HDRDCBAD FIELD HEADER TO HEADER BUFFER 26350002 MVI HDRLEN,N5 LENGTH OF DEB FIELD HEADER 26400002 MVI FLDLEN,L'DEBDCBB LENGTH OF DEB FIELD 26450002 MVI RELADR,DEBDCBB-DEBBASIC DISP OF FIELD INTO DEB 26500002 B CVTANDIO GO CONVERT FIELD TO PRINTABLE 26550002 DEB28B MVC HDRBUF(N5),HDREXSCL FIELD HEADER TO HEADER BUFFER 26600002 MVI HDRLEN,N5 LENGTH OF DEB FIELD HEADER 26650002 MVI FLDLEN,L'DEBEXSCL LENGTH OF DEB FIELD 26700002 MVI RELADR,DEBEXSCL-DEBBASIC DISP OF FIELD INTO DEB 26750002 B CVTANDIO GO CONVERT FIELD TO PRINTABLE 26800002 DEB29B MVC HDRBUF(N5),HDRAPPAD FIELD HEADER TO HEADER BUFFER 26850002 MVI HDRLEN,N5 LENGTH OF DEB FIELD HEADER 26900002 MVI FLDLEN,L'DEBAPPB LENGTH OF DEB FIELD 26950002 MVI RELADR,DEBAPPB-DEBBASIC DISP OF FIELD INTO DEB 27000002 B CVTANDIO GO CONVERT FIELD TO PRINTABLE 27050002 EJECT 27100002 *********************************************************************** 27150002 * THE FOLLOWING ROUTINES HANDLE THE DIRECT ACCESS SECTIONS * 27200002 *********************************************************************** 27250002 SPACE 1 27300002 DEB00DA MVC HDRBUF(N5),HDRDVMOD FIELD HEADER TO HEADER BUFFER 27350002 MVI HDRLEN,N5 LENGTH OF DEB FIELD HEADER 27400002 MVI FLDLEN,L'DEBDVMOD LENGTH OF FIELD 27450002 MVI RELADR,DEBDVMOD-DEBDASD DISPL FIELD INTO DASD SEC 27500002 B FIRSTSEC GO CHECK FOR ALL FIELDS REQUESTED 27550002 DEB01DA MVC HDRBUF(N5),HDRUCBAD FIELD HEADER TO HEADER BUFFER 27600002 MVI HDRLEN,N5 LENGTH OF DEB FIELD HEADER 27650002 MVI FLDLEN,L'DEBUCBA LENGTH OF DEB FIELD 27700002 MVI RELADR,DEBUCBA-DEBDASD DISPL FIELD INTO DASD SEC 27750002 B SECNDSEC GO CHECK POINTER TO DASD SECTION 27800002 DEB04DA MVC HDRBUF(N5),HDRBINUM FIELD HEADER TO HEADER BUFFER 27850002 MVI HDRLEN,N5 LENGTH OF DEB FIELD HEADER 27900002 MVI FLDLEN,L'DEBBINUM LENGTH OF DEB FIELD 27950002 MVI RELADR,DEBBINUM-DEBDASD DISPL FIELD INTO DASD SEC 28000002 B SECNDSEC GO CHECK POINTER TO DASD SECTION 28050002 DEB06DA MVC HDRBUF(N5),HDRSTRCC FIELD HEADER TO HEADER BUFFER 28100002 MVI HDRLEN,N5 LENGTH OF DEB FIELD HEADER 28150002 MVI FLDLEN,L'DEBSTRCC LENGTH OF DEB FIELD 28200002 MVI RELADR,DEBSTRCC-DEBDASD DISPL FIELD INTO DASD SEC 28250002 B SECNDSEC GO CHECK POINTER TO DASD SECTION 28300002 DEB08DA MVC HDRBUF(N5),HDRSTRHH FIELD HEADER TO HEADER BUFFER 28350002 MVI HDRLEN,N5 LENGTH OF DEB FIELD HEADER 28400002 MVI FLDLEN,L'DEBSTRHH LENGTH OF DEB FIELD 28450002 MVI RELADR,DEBSTRHH-DEBDASD DISPL FIELD INTO DASD SEC 28500002 B SECNDSEC GO CHECK POINTER TO DASD SECTION 28550002 DEB10DA MVC HDRBUF(N5),HDRENDCC FIELD HEADER TO HEADER BUFFER 28600002 MVI HDRLEN,N5 LENGTH OF DEB FIELD HEADER 28650002 MVI FLDLEN,L'DEBENDCC LENGTH OF DEB FIELD 28700002 MVI RELADR,DEBENDCC-DEBDASD DISPL FIELD INTO DASD SEC 28750002 B SECNDSEC GO CHECK POINTER TO DASD SECTION 28800002 DEB12DA MVC HDRBUF(N5),HDRENDHH FIELD HEADER TO HEADER BUFFER 28850002 MVI HDRLEN,N5 LENGTH OF DEB FIELD HEADER 28900002 MVI FLDLEN,L'DEBENDHH LENGTH OF DEB FIELD 28950002 MVI RELADR,DEBENDHH-DEBDASD DISPL FIELD INTO DASD SEC 29000002 B SECNDSEC GO CHECK POINTER TO DASD SECTION 29050002 DEB14DA MVC HDRBUF(N5),HDRNMTRK FIELD HEADER TO FIELD BUFFER 29100002 MVI HDRLEN,N5 LENGTH OF DEB FIELD HEADER 29150002 MVI FLDLEN,L'DEBNMTRK LENGTH OF DEB FIELD 29200002 MVI RELADR,DEBNMTRK-DEBDASD DISPL FIELD INTO DASD SEC 29250002 B SECNDSEC GO CHECK POINTER TO DASD SECTION 29300002 EJECT 29350002 * 29400002 * ANALYZE POSITION IN DEB 29450002 * 29500002 FIRSTSEC DS 0H 29550002 TM OUTPUTSW,ANYSECND IS THEIR A DIRECT ACCESS SECTION 29600002 BM NOSECOND NO, GO CLEAN UP AND GIVE MESSAGE 29650002 TM OUTPUTSW,ALLCHECK ARE ALL FIELDS REQUESTED 29700002 BO HEADERCK YES, GO PUT OUT DASD SECTION HDR 29750002 SECNDSEC DS 0H 29800002 TM OUTPUTSW,ANYSECND IS THEIR A DIRECT ACCESS SECTION 29850002 BM NOSECOND NO, GO CLEAN UP AND GIVE MESSAGE 29900002 TM OUTPUTSW,DASDSEC IS POINTER TO SECOND SECTION OK 29950002 BO CVTANDIO YES, GO CONVERT FIELD 30000002 LTR R2,R2 IS THEIR PREVIOUS OUTPUT 30050002 BZ SETSECPT NO, GO POINT TO DASD SECTION 30100002 L R10,OUTBUF POINT TO OUTPUT BUFFER 30150002 LA R14,N2(R2) SET LENGTH OF OUTPUT 30200002 SLL R14,N16 LENGTH IN HIGH ORDER HALF 30250002 ST R14,N0(R10) PREFIX OUTPUT WITH LENGTH 30300002 NI OUTPUTSW,(HEXFF-FLDCHECK) 30350002 OI OUTPUTSW,HDRCHECK 30400002 BAL R14,DEBIO GO PUT OUT FIRST SECTION HDRS 30450002 * AND FIELD DATA 30500002 SR R2,R2 NO OUTPUT TO PUT OUT 30550002 SETSECPT DS 0H 30600002 LA R3,DEBBASND-DEBBASIC(R3) POINT TO SEC SEC-DASD 30650002 TM OUTPUTSW,ISAMBIT IS DEB FOR A ISAM DATASET 30700002 BZ NOTISAM2 NO, GO ON 30750002 LA R3,DEBEXPTA-DEBBASND+L'DEBEXPTA(R3) YES,SKIP ISAM 30800002 NOTISAM2 DS 0H 30850002 OI OUTPUTSW,DASDSEC INDICATE POINTER TO DASD SEC OK 30900002 B CVTANDIO GO CONVERT DEB FIELD 30950002 HEADERCK DS 0H 31000002 TM OUTPUTSW,ALLCHECK ARE ALL FIELDS REQUESTED 31050002 BZ CVTANDIO IF NO PROCESS THE FIELD 31100002 LTR R2,R2 IS THERE PREVIOUS OUTPUT 31150002 BZ NOOUTPUT NO, GO GET SECTION HEADERS 31200002 L R10,OUTBUF POINT TO OUTPUT BUFFER 31250002 LA R14,N2(R2) SET LENGTH OF OUTPUT 31300002 SLL R14,N16 LENGTH IN HIGH ORDER HALFWORD 31350002 ST R14,N0(R10) STORE IN OUTPUT BUFFER 31400002 NI OUTPUTSW,(HEXFF-FLDCHECK) INDICATE NOT A FIELD 31450002 OI OUTPUTSW,HDRCHECK INDICATE A HEADER 31500002 BAL R14,DEBIO PUT OUT HEADER AND FIELD 31550002 SR R2,R2 RESET OUTPUT COUNTER 31600002 NOOUTPUT C R6,FSTPDEND IN SECTION1 OR SECTION2 31650002 L R10,OUTBUF POINT TO OUTPUT BUFFER 31700002 BNL SECT2IO IF IN SECTION2 BRANCH 31750002 MVC N4(L'HEADER1,R10),HEADER1 31800002 LA R14,L'HEADER1 LOAD LENGTH OF HEADER 31850002 B HDR10 OUTPUT THE HEADER 31900002 SECT2IO DS 0H 31950002 STM R2,R3,DATAREG SAVE WORK REGSITERS 31960002 SR R0,R0 SPACE 32000002 L R1,OUTBUF A 32050002 ST R0,N0(R1) LINE 32100002 LR R2,R1 INDICATE NULL LINE COMING 32210002 XC TSTIOPRM,TSTIOPRM CLEAR PARM LIST FOR I/O CALL 32260002 IKJEGSIO DATA,DATAPTR=(R2),ID=DEB11,MF=(E,TSTIOPRM) CALL I/O 32310002 LM R2,R3,DATAREG RESTORE REGISTERS 32320002 LTR R15,R15 WAS I/O OK 32350002 BNZ DEBRET NO, GO SET UP RETURN 32400002 MVC N4(L'HEADER2,R10),HEADER2 MOVE HEADER TO BUFFER 32450002 LA R14,L'HEADER2 32500002 NI OUTPUTSW,(HEXFF-ALLCHECK) 32550002 LA R3,DEBBASND-DEBBASIC(R3) ADDR OF 1ST DASD SEC 32600002 TM OUTPUTSW,ISAMBIT IS DEB FOR A ISAM DATASET 32650002 BZ NOTISAM3 NO, GO ON 32700002 LA R3,DEBEXPTA-DEBBASND+L'DEBEXPTA(R3) YES,SKIP ISAM 32750002 NOTISAM3 DS 0H 32800002 OI OUTPUTSW,DASDSEC INDICATE PTR TO SECOND SECTION OK 32850002 HDR10 LA R14,N4(R14) SET LENGTH OF OUTPUT 32900002 NI OUTPUTSW,(HEXFF-HDRCHECK-FLDCHECK) 32950002 SLL R14,N16 LENGTH IN HIGH ORDER HALFWORD 33000002 ST R14,N0(R10) STORE LENGTH IN OUTPUT BUFFER 33050002 BAL R14,DEBIO PUT OUT THE HEADER 33100002 SPACE 1 33150002 *********************************************************************** 33200002 * THE FOLLOWING CODE DETERMINES WHETHER THE OUTPUT LINE IS ALREADY * 33250002 * FULL. IF FULL CONTROL IS PASSED TO DEBIO. WHEN THIS SECTION IS * 33300002 * REACHED, R6 POINTS TO THE PDE OF THE FIELD BEING PROCESSED, AND * 33350002 * FLDLEN, HDRLEN, RELADR, AND HDRBUF CONTAIN THE PROPER INFORMATION * 33400002 * FOR THAT FIELD. * 33450002 *********************************************************************** 33500002 SPACE 1 33550002 CVTANDIO DS 0H 33600002 SR R7,R7 33650002 SR R10,R10 33700002 IC R7,FLDLEN LOAD FIELD LENGTH 33750002 IC R10,HDRLEN LOAD HEADER LENGTH 33800002 AR R7,R7 DOUBLE FOR TRUE PRINTABLE LENGTH 33850002 CR R7,R10 WHICH IS LONGER 33900002 BH FLDLONGR IF FIELD IS LONGER, BRANCH 33950002 LR R7,R10 R7 CONTAINS OUTPUT LENGTH 34000002 FLDLONGR AR R7,R2 CALCULATE TOTAL NEW OUTPUT LENGTH 34050002 C R7,LINELEN IS THERE ROOM FOR THIS FIELD 34100002 BNH MOREROOM BRANCH IF THE FIELD CAN FIT 34150002 L R11,OUTBUF POINT TO OUTPUT BUFFER 34200002 LA R10,N2(R2) LENGTH OF OUTPUT BUFFER 34250002 SLL R10,N16 LENGTH IN HIGH ORDER HALFWORD 34300002 ST R10,N0(R11) STORE LENGTH OF OUTPUT 34350002 TM OUTPUTSW,HDRCHECK 34400002 BZ HEADERIO GO SET UP TO OUTPUT FIELD HDRS 34450002 OI OUTPUTSW,FLDCHECK 34500002 B DEBIOGO GO SETUP TO OUTPUT LINE 34550002 HEADERIO NI OUTPUTSW,(HEXFF-FLDCHECK) 34600002 OI OUTPUTSW,HDRCHECK 34650002 DEBIOGO BAL R14,DEBIO GO TO INTERNAL I/O ROUTINE 34700002 SR R7,R2 RESET LENGTH OF FIELD TO BE CONVRTED 34750002 ST R6,FSTADDR 34800002 SR R2,R2 SET OUTPUT LENGTH TO ZERO 34850002 SPACE 34900002 *********************************************************************** 34950002 * THE FOLLOWING CODE IS REACHED WHEN THERE IS MORE ROOM IN THE * 35000002 * OUTPUT BUFFER. IT SETS UP FOR DEBCVT WHICH WILL CONVERT THE * 35050002 * FIELD TO PRINTABLE HEXADECIMAL AND MOVE THE HEADERS AND FIELD * 35100002 * TO THE PROPER BUFFERS * 35150002 *********************************************************************** 35200002 SPACE 35250002 MOREROOM DS 0H 35300002 LTR R2,R2 35350002 BNZ RESET MORE ROOM IN BUFFER, GO ADD 35400002 ST R6,FSTADDR 35450002 RESET SR R7,R2 35500002 SR R10,R10 35550002 IC R10,RELADR FIND OFFSET OF FIELD 35600002 AR R10,R3 ADD OFFSET TO BASE 35650002 SR R1,R1 ZERO R1 35700002 IC R1,FLDLEN PUT FIELD LENGTH IN R1 35750002 BCTR R1,R0 DECREMENT FOR MOVE 35800002 LA R11,TEMPAREA GET ADDRESS OF TEMP STORAGE 35850002 * AREA DATA TO BE TRANSLATED 35900002 MOVETRY1 DS 0H NEXT INSTRUCTION MAY ABEND 35950002 EX R1,MOVE1 MOVE DATA FROM DEB TEMPAREA 36000002 MOVETRY2 DS 0H PREVIOUS INSTR MAY ABEND 36050002 ST R11,STRNGPTR STORE IN LIST FOR IKJEGCVT 36100002 SPACE 1 36150002 *********************************************************************** 36200002 * THE FOLLOWING CODE SETS UP THE PARAMETER LIST FOR IKJEGCVT WHICH * 36250002 * WILL CONVERT THE DEB FIELD TO PRINTABLE HEXADECIMAL. IT THEN * 36300002 * DETERMINES WHETHER THE HEADER FOR THAT FIELD HAS BEEN OUTPUTTED, * 36350002 * AND MOVES THE CONVERTED FIELD TO THE PROPER BUFFER. * 36400002 *********************************************************************** 36450002 SPACE 36500002 DEBCVT DS 0H 36550002 MVI CVTLL,HEX00 ZERO OUT TOP BYTE OF LENGTH 36600002 MVC CVTLL+N1(N1),FLDLEN MOVE LENGTH OF FIELD TO PARM LIST 36650002 MVI FLAGS,FLAG MOVE FLAG TO LIST 36700002 MVI TYPE,TYPECODE MOVE IN CODE FOR HEX 36750002 LA R1,STRNGPTR POINT TO PARM LIST 36800002 LCR R0,R1 R0 NEGATIVE FOR CONVERT TO PRINTABLE 36850002 L R15,TSTCONVT LOAD ADDRESS OF IKJEGCVT 36900002 BALR R14,R15 GO TO IKJEGCVT 36950002 LTR R15,R15 IS RETURN CODE 0 37000002 BNZ DEBRET IF NO BRANCH 37050002 L R10,CONAREA LOAD ADDRESS OF CONVERTED FIELDS 37100002 TM OUTPUTSW,HDRCHECK IS HEADER OUT 37150002 BZ HDRNTOUT BRANCH IF NOT OUT YET 37200002 L R11,OUTBUF POINT TO OUTPUT BUFFER 37250002 AR R11,R2 SKIP PREVIOUS DATA 37300002 IC R1,FLDLEN GET LENGTH OF FIELD 37350002 AR R1,R1 DOUBLE FOR PRINTABLE LENGTH 37400002 BCTR R1,R0 LEN-1 FOR EXECUTE INSTR 37450002 EX R1,MOVE2 MOVE CONVERTED FIELD TO OUTBUF 37500002 B CVTRTRN GO CHECK FOR MORE FIELDS 37550002 HDRNTOUT LA R11,BUFFER POINT TO FIELD BUFFER 37600002 AR R11,R2 37650002 IC R1,FLDLEN GET LENGTH OF FIELD 37700002 AR R1,R1 DOUBLE FOR PRINTABLE LENGTH 37750002 BCTR R1,R0 LEN-1 FOR EXECUTE INSTR 37800002 EX R1,MOVE3 MOVE FIELD TO BUFFER IN WORKAREA 37850002 L R11,OUTBUF ADDRESS OF OUTPUT BUFFER 37900002 LA R10,HDRBUF ADDRESS OF HEADER BUFFER 37950002 AR R11,R2 38000002 SR R1,R1 38050002 IC R1,HDRLEN GET HEADER LENGTH 38100002 BCTR R1,R0 LEN-1 FOR EXECUTE INSTR 38150002 EX R1,MOVE4 MOVE FIELD HEADER TO OUTBUF 38200002 CVTRTRN LA R6,N2(R6) 38250002 LA R2,N2(R2) SET FOR TWO SPACES BETWEEN FIELDS 38300002 AR R2,R7 38350002 C R6,LASTPDE ARE THERE ANY MORE PDE'S 38400002 BE PDLEND BRANCH IF NO 38450002 B PDECHECK GO CHECK NEXT PDE 38500002 SPACE 38550002 *********************************************************************** 38600002 * THE FOLLOWING CODE CONTAINS THE HEART OF THE LOGIC OF THE PROGRAM. * 38650002 * IT SETS UP THE PARAMETER LIST FOR IKJEGIO1 WHICH WILL OUTPUT THE * 38700002 * LINE OF DATA. IT THEN DETERMINES WHAT KIND OF DATA, WHETHER HEADER * 38750002 * OR FIELD, WAS OUTPUTTED. IF FIELD DATA WAS PUT OUT IT CHECKS FOR * 38800002 * FURTHER EXTENTS OF THOSE FIELDS, AND FOR FURTHER FIELDS. IF A * 38850002 * FIELD HEADER WAS PUT OUT IT SETS UP THE BUFFERS AND THE PARAMETER * 38900002 * LIST TO OUTPUT THE CORRESPONDING FIELDS. * 38950002 * UPON REACHING THIS SECTION, R2 CONTAINS THE OUTPUT LINE LENGTH, * 39000002 * OUTPUTSW INDICATES THE KIND OF DATA IN THE BUFFER, R6 POINTS TO THE * 39050002 * PDE OF THE NEXT FIELD, EXTCTR CONTAINS THE NUMBER OF REMAINING * 39100002 * EXTENTS, AND R3 POINTS TO THE DEB. * 39150002 *********************************************************************** 39200002 SPACE 39250002 DEBIO DS 0H 39300002 OI OUTPUTSW,SOMEOUT INDICATE WE PUT OUT A LINE 39350002 L R1,OUTBUF POINT TO BUFFER 39400002 ST R1,OUTPTR1 STORE POINTER IN LIST 39450002 L R0,PRINTFLG 39500002 SR R1,R1 39550002 ST R1,PRINTFLG 39600002 ST R1,OUTPTR2 ZERO OUT SECOND WORD OF LIST 39650002 LA R1,OUTPTR1 POINT TO PARM LIST 39700002 STM R2,R3,DATAREG SAVE WORK REGISTERS 39710002 L R2,OUTPTR1 PICK UP DATA LINE POINTER 39720002 LR R3,R0 TRANSFER DSNPDE IF ONE 39730002 ST R14,REG14 STORE RETURN ADDRESS 39732002 XC TSTIOPRM,TSTIOPRM CLEAR PARM LIST FOR I/O CALL 39740002 IKJEGSIO DATA,DATAPTR=(R2),DSNAME=(R3),ID=DEB11, *39742002 MF=(E,TSTIOPRM) 39744002 LM R2,R3,DATAREG RESTORE WORKREGS 39794002 LTR R15,R15 IS RETURN CODE 0 39900002 BNZ DEBRET IF NO RETURN 39950002 L R10,OUTBUF 40000002 MVI N4(R10),BLANK 40050002 MVC N5(N79,R10),N4(R10) 40100002 L R14,REG14 RESTORE RETURN ADDRESS 40150002 TM OUTPUTSW,FLDCHECK WAS A FIELD JUST PUT OUT 40200002 BZ FURTHRCK BRANCH IF NOT A FIELD 40250002 BRANCH2 DS 0H CONVERTED FIELDS WERE JUST PUT OUT 40300002 BCTR R6,R0 POINT BACK 40350002 BCTR R6,R0 TO PDE 40400002 LA R10,BUFFER 40450002 MVI N0(R10),BLANK 40500002 MVC N1(N79,R10),N0(R10) 40550002 CLC FSTADDR(N4),FSTPDEND IN BASIC OR DASD SECTION 40600002 BL S1OUTPUT IF IN SECTION1 BRANCH 40650002 LA R6,N2(R6) 40700002 SR R10,R10 40750002 IC R10,EXTCTR LOAD EXTENT COUNTER 40800002 BCTR R10,R0 DECREMENT EXTENT COUNTER 40850002 STC R10,EXTCTR 40900002 LTR R10,R10 ARE THERE MORE EXTENTS 40950002 BZ NOMOREXT BRANCH IF NO MORE 41000002 L R6,FSTADDR POINT TO FIRST PDE FOR OUTPUT LINE 41050002 LA R3,N16(R3) POINT TO NEXT EXTENT 41100002 SR R2,R2 41150002 B PDECHECK CHECK NEXT PDE 41200002 FURTHRCK TM OUTPUTSW,HDRCHECK WAS A FIELD HEADER JUST PUT OUT 41250002 BZ BRANCH1 IF NO BRANCH TO SETUP RETURN 41300002 LA R10,BUFFER 41350002 L R11,OUTBUF 41400002 LR R1,R2 41450002 BCTR R1,R0 LEN-1 FOR EXECUTE INSTR 41500002 EX R1,MOVE4 MOVE FIELDS TO OUTBUF 41550002 OI OUTPUTSW,FLDCHECK 41600002 B DEBIO GO SETUP TO PUT OUT LINE 41650002 BRANCH1 BR R14 SECTION 1 OR 2 HEADER PUT OUT 41700002 NOMOREXT DS 0H 41750002 NI OUTPUTSW,(HEXFF-HDRCHECK) INDICATE NO HEADER YET 41800002 MVC EXTCTR(N1),NMEXTSTR RESET EXTENT COUNTER FOR FIELDS 41850002 L R3,TSTANSPL ADDRESS OF PDL 41900002 USING IKJPARMD,R3 R3 POINTS TO PDL 41950002 L R3,PDEUSER-IKJPARMA+ADDRESS ADDR DEB PDEUSER 42000002 DROP R3 R3 NO LONGER PDL BASE 42050002 LA R3,DEBBASND-DEBBASIC(R3) ADDRESS OF1ST DASD SEC 42100002 BR R14 RETURN TO MAIN ROUTINE 42150002 S1OUTPUT LA R6,N2(R6) RESTORE PDE POINTER 42200002 NI OUTPUTSW,(HEXFF-HDRCHECK) 42250002 NI OUTPUTSW,(HEXFF-FLDCHECK) 42300002 BR R14 RETURN TO MAIN ROUTINE 42350002 SPACE 42400002 *********************************************************************** 42450002 * THE FOLLOWING CODE IS REACHED WHEN THERE ARE NO MORE FIELDS. * 42500002 * IT CHECKS THE BUFFER FOR MORE DATA, IN WHICH CASE A BRANCH IS * 42550002 * MADE TO DEBIO. IF THERE ARE MORE EXTENTS IS THEN PASSED TO * 42600002 * TABLESCN WHICH WILL PROCESS THE NEXT EXTENT. OTHERWISE CONTROL * 42650002 * IS RETURNED AND PASSED TO DEBRET PRIOR TO RETURN TO IKJEGMN1. * 42700002 *********************************************************************** 42750002 SPACE 1 42800002 PDLEND DS 0H 42850002 LTR R2,R2 IS THERE ANY MORE OUTPUT 42900002 BNZ PUTITOUT YES, GO PUT OUT REST OF OUTPUT 42950002 TM OUTPUTSW,SOMEOUT DID WE OUTPUT ANY FIELDS 43000002 BO DEBRET YES, GO SET UP RETURN TO MAINLINE 43050002 LA R2,M0041 PICK UP ERROR MESSAGE NUMBER 43200002 SR R3,R3 INDICATE NO SECOND LEVEL 43210002 B MSGIO GO PUT OUT MESSAGE 43300002 PUTITOUT DS 0H 43350002 L R10,OUTBUF LOAD ADDRESS OF OUTPUT BUFFER 43400002 LA R1,N2(R2) LENGTH OF OUTPUT BUFFER 43450002 SLL R1,N16 LENGTH IN HIGH ORDER HALFWORD 43500002 ST R1,N0(R10) STORE LENGTH OF OUTPUT 43550002 TM OUTPUTSW,HDRCHECK 43600002 BZ TURNONHD GO SET UP FOR FIELD HEADER 43650002 OI OUTPUTSW,FLDCHECK 43700002 B BRANCH GO SET UP TO OUTPUT FIELDS 43750002 TURNONHD NI OUTPUTSW,(HEXFF-FLDCHECK) 43800002 OI OUTPUTSW,HDRCHECK 43850002 BRANCH BAL R14,DEBIO GO SETUP TO OUTPUT LINE 43900002 B DEBRET RETURN TO IKJEGMN1 43950002 NOSECOND DS 0H 44000002 LTR R2,R2 IS THEIR ANY FIELDS TO PUT OUT 44050002 BZ GIVEMESG NO, GO GIVE MESSAGE 44100002 L R10,OUTBUF ADDRESS OF OUTPUT BUFFER 44150002 LA R1,N2(R2) LENGTH OF DATA TO PUT OUT 44200002 SLL R1,N16 LENGTH IN HIGH ORDER HALFWORD 44250002 ST R1,N0(R10) PREFIX OUTPUT WITH LENGTH 44300002 NI OUTPUTSW,(HEXFF-FLDCHECK) 44350002 OI OUTPUTSW,HDRCHECK 44400002 BAL R14,DEBIO GO PUT OUT FIELD HDRS AND FIELDS 44450002 SR R2,R2 NO MORE OUTPUT 44500002 GIVEMESG DS 0H 44550002 TM OUTPUTSW,NOTDASD NO DASD SECTION BECAUSE NOT A DASD 44700002 BO PUTMSG6A YES, GO GIVE NOT A DASD MESSAGE 44750002 LA R2,M0040 PICK UP FIRST LEVEL ERROR MSG NUM 44800002 LA R3,M0247 PICK UP SECOND LEVEL ERROR MSG NUM 44810002 B MSGAGOGO GO PUT OUT MESSAGE 44850002 PUTMSG6A DS 0H 44900002 LA R2,M0040 PICK UP FIRST LEVEL MSG NUMBER 44950002 LA R3,M0248 PICK UP SECOND LEVEL MSG NUMBER 44960002 MSGAGOGO DS 0H 45050002 NI TSTFLGS1,(HEXFF-TSTPRINT) INSURE PRINT SWITCH OFF 45200002 B MSGIO BRANCH TO ISSUE MESSAGES 45300002 SPACE 45350002 *********************************************************************** 45400002 * THE FOLLOWING CODE PROCESSES THE VARIOUS RETURN CODES AND * 45450002 * RETURNS TO MAINLINE. * 45500002 *********************************************************************** 45550002 SPACE 45600002 DEBRETRY DS 0H 45650002 L R9,CVTPTR ADDRESS OF CVT 45700002 L R9,CVTTCBP-CVT(R9) POINTER TO NEW, CURRENT TCBS 45750002 L R9,N4(R9) ADDRESS OF CURRENT TCB IS TEST TCB 45800002 L R9,TCBTRN-TCB(R9) ADDRESS OF TCOMTAB 45850002 OI TSTFLGS4,TSTRERTN TURN ON RETRY IN PROCESS SW 45860002 L R13,REGSAVE2 ADDRESS OF MY SAVE AREA 45900002 L R12,N68(R13) MY BASE 45950002 LA R8,N20 ABEND RETURN CODE FOR MAINLINE 46000002 B RETURN GO RETURN TO MAINLINE 46200002 EXITERR DS 0H 46250002 L R15,REG14 VALIDITY EXIT SAVED RET CODE 46300002 DEBRET DS 0H 46350002 LA R8,N16 ATTENTION RETCODE 46400002 CR R8,R15 DID SOMEONE HIT ATTENTION 46450002 BE RETURN IF YES BRANCH 46500002 LA R8,N20 ABEND RETURN CODE 46550002 CR R8,R15 DID SOMEONE ABEND 46600002 BE RETURN YES, GO SET RETURN 46650002 LA R8,N24 TEST FOR BAD ESTAE 46660002 CR R8,R15 COMPARE WITH IO RTN CODE 46670002 BE RETURN IF SO GO BACK WITH RTN CODE 46680002 SR R8,R8 RETCODE IS ZERO 46700002 B RETURN GO RETURN TO MAINLINE 46750002 DEBRET1 DS 0H PARSE RETURN CODE ANALYSIS 46800002 LA R8,N8 ATTENTION R.C. FROM PARSE IS 8 46950002 CR R8,R15 HAS AN ATTENTION BEEN SCHEDULED 47000002 LA R8,N16 MAINLINE ATTENTION R.C. IS 16 47050002 BE RETURN ATTENTION SCHEDULED, GO SET UP RET 47100002 LA R8,N20 VALIDITY EXIT ERR R.C. FROM PARSE 47150002 CR R8,R15 DID VALIDITY EXIT SEEK TO END 47200002 BE EXITERR VALIDITY EXIT TERM., GO SET RETURN 47250002 LA R8,N16 NO CORE R.C. FROM PARSE 47300002 SR R3,R3 INDICATE NO SECOND LEVEL MSG 47310002 CR R8,R15 IS R.C. FROM PARSE 16 47350002 LA R2,M0103 PICK UP FIRST LEVEL MESSAGE NUM 47400002 BE MSGIO IF R.C. 16, GO GIVE NO CORE MESSAGE 47450002 LA R8,N12 INVALID PARMS R.C. FROM PARSE 47500002 CR R8,R15 IS R.C. FROM PARSE 12 47550002 BE PARSE12 IF A 12 SEND MESSAGE 47600002 SR R8,R8 PARSE RC=4, NO MESSAGE 47750002 OI TSTFLGS4,TSTFLUSH IF STACK, TELL MNL TO FLUSH 47800002 B RETURN GO RETURN TO CALLER 47850002 PARSE12 DS 0H 47860002 XC TSTIOPRM,TSTIOPRM CLEAR PARM LIST FOR I/O CALL 47870002 IKJEGSIO MSG,FIRST=M0104,INST11=(NUM,I0014),SECOND=M0277, *47880002 ID=DEB11,MF=(E,TSTIOPRM) CALL I/O FOR ERROR MSG 47890002 B DEBRET GO CHECK RETURN CODE FROM I/O 47892002 MSGIO DS 0H 47900002 XC TSTIOPRM,TSTIOPRM CLEAR PARM LIST FOR I/O CALL 47950002 IKJEGSIO MSG,FIRST=(R2),SECOND=(R3),ID=DEB11,MF=(E,TSTIOPRM) 48000002 B DEBRET GO CHECK RETURN CODE FROM I/O 48100002 RETURN DS 0H 48150002 NI TSTFLGS1,(HEXFF-TSTPRINT) 48200002 ESTAE 0,OV REMOVE ESTAE 48210002 LR R15,R8 RETCODE IN PROPER REGISTER 48250002 L R13,N4(R13) 48300002 NI TSTFLGS4,HEXFF-TSTRERTN TURN OFF RETRY SWITCH IF ON 48310002 RETURN (14,12),T,RC=(15) 48350002 EJECT 48400002 *********************************************************************** 48450002 * * 48500002 * HEADERS AND OTHER CONSTANTS * 48550002 * * 48600002 *********************************************************************** 48650002 SPACE 2 48700002 IKJEGSPL IKJEGSPL RTRY=DEBRETRY,ABNTB=ABENDTAB,MODNM=IKJEGDEB,TNM=LISTD*48710002 EB 48720002 ZZZZZZZZ DC 52C'Z' TO BE USED FOR MAINTENANCE 48750002 HDRRSRVD DC C'RESERVED' DEB FIELD HEADER 48800002 HDRPROTG DC C'PROTG/DEBID' DEB FIELD HEADER 48850002 HEADER1 DC C'BASIC SECTION' DEB SECTION HEADER 48900002 HEADER2 DC C'DIRECT ACCESS SECTION' DEB SECTION HEADER 48950002 FLAG EQU X'80' FLAG FOR IKJEGCVT 49000002 TYPECODE EQU X'04' TYPE CODE FOR HEX FOR CONVERT 49050002 BLANK EQU C' ' 49100002 HEXFF EQU X'FF' 49150002 HEX00 EQU X'00' 49200002 HEX38 EQU X'38' 49250002 HEX03 EQU X'03' 49300002 HEX04 EQU X'04' 49350002 HEX0F EQU X'0F' 49400002 FOUR DC F'4' USED COMPARE RC ADDR CHECK 49450002 EIGHT DC F'8' USED COMPARE RC ADDR CHECK 49460002 PCLADDR DC A(IKJEGDBP) ADDRESS OF PARSE PCL CSECT 49500002 ABENDTAB DS 0F 49550002 DC AL1(99) LINK FAILED CODE 49600002 DC AL3(PABEND1) RESUME IC AFTER LINK 49650002 DC AL1(98) INVALID DEB CODE 49700002 DC AL3(PARDCB1) RESUME IC AT DCB CHECK 49750002 DC AL1(98) INVALID DEB CODE 49800002 DC AL3(PARDCB2) RESUME IC AFTER DCB CHECK 49850002 DC AL1(98) INVALID DEB CODE 49900002 DC AL3(PARNMEX1) RESUME IC AT EXT CHECK 49950002 DC AL1(98) INVALID DEB CODE 50000002 DC AL3(PARNMEX2) RESUME IC AFTER EXT CHECK 50050002 DC AL1(98) INVALID DEB CODE 50100002 DC AL3(DCBTRY1) RESUME IC AT DCB CHECK 50150002 DC AL1(98) INVALID DEB CODE 50200002 DC AL3(DCBTRY2) RESUME IC AFTER DCB CHECK, AT 50250002 * DSORG CHECK 50300002 DC AL1(98) INVALID DEB CODE 50350002 DC AL3(PABEND2) RESUME IC AFTER CHECK DSORG IN DCB 50400002 DC AL1(98) INVALID DEB CODE 50450002 DC AL3(NMTRY1) RESUME IC AT NM CHECK 50500002 DC AL1(98) INVALID DEB CODE 50550002 DC AL3(NMTRY2) RESUME IC AFTER NM CK 50600002 DC AL1(98) INVALID DEB CODE 50650002 DC AL3(NMTRY3) RESUME IC AT NM CHECK 50700002 DC AL1(98) INVALID DEB CODE 50750002 DC AL3(EXTRY1) RESUME IC AT EXT CHECK 50800002 DC AL1(98) INVALID DEB CODE 50850002 DC AL3(CHECKEXT) RESUME IC AT EXT CHECK 50900002 DC AL1(98) INVALID DEB CODE 50950002 DC AL3(EXTRY2) RESUME IC AT EXT CHECK 51000002 DC AL1(98) INVALID DEB CODE 51050002 DC AL3(MOVETRY1) RESUME IC AT MOVE 51100002 DC AL1(98) INVALID DEB CODE 51150002 DC AL3(MOVETRY2) RESUME IC AFTER MOVE 51200002 DC X'FF' END OF TABLE INDICATOR 51250002 RETRYADR DC AL3(DEBRETRY) ADDRESS OF DEB STAE RETRY ROUTINE 51300002 LFSTAE DS 0F 51350002 ESTAE MF=L 51400002 MOVE1 MVC N0(N0,R11),N0(R10) 51450002 MOVE2 MVC N4(N0,R11),N1(R10) 51500002 MOVE3 MVC N0(N0,R11),N1(R10) 51550002 MOVE4 MVC N4(N0,R11),N0(R10) 51600002 PDELENTH EQU 51 TOTAL LENGTH OF FIELD PDES 51650002 ALLCHECK EQU X'80' OUTPUT FLAG FOR HEADER1 51700002 SOMEOUT EQU X'40' FLAG FOR ANY OUTPUT, CHECK BAD PARMS 51750002 HDRCHECK EQU X'20' OUTPUT FLAG FOR FIELD HEADERS 51800002 FLDCHECK EQU X'10' OUTPUT FLAG FOR FIELDS 51850002 DASDSEC EQU X'08' FLAG FOR SECOND SECTION POINTER 51900002 ISAMBIT EQU X'04' FLAG FOR DEB ASSOCIATED WITH ISAM DS 51950002 ANYSECND EQU X'03' NO DIRECT ACCESS SECTION 52000002 NOTDASD EQU X'02' NO DASD SECTION - DS NOT ON A DASD 52050002 NOEXTENT EQU X'01' NO DASD SECTION - 0 EXTENTS 52100002 ISAM EQU X'80' ISAM ORGANIZATION CODE IN DCB 52150002 DSORG EQU 26 OFFSET INTO DCB OF DSORG CODE 52200002 OFFSET EQU 64 OFFSET OF DBWKAREA INTO TEST WRKAREA 52250002 EJECT 52300002 DBWKAREA DSECT 52350002 PARSELST DS 7F PARM LIST FOR PARSE 52400002 PRINTFLG DS 1F ADDRESS OF PRINT PDL 52450002 OUTPUTSW DS CL1 OUTPUT FLAGS 52500002 DS CL2 TWO BYTES 52550002 EXTCTR DS CL1 NO. OF EXTENTS STILL TO BE PROCESSED 52600002 FSTADDR DS 1F ADDR OF PDE OF 1ST FLD ON OUTPUT LNE 52650002 FSTPDEND DS 1F ADDRESS OF DVMOD PDE 52700002 LASTPDE DS 1F ADDRESS OF NMTRK PDE +2 52750002 BUFFER DS 20F BUFFER FOR CONVERTED FIELDS 52800002 RELADR DS CL1 OFFSET OF FIELD INTO THE DEB 52850002 FLDLEN DS CL1 LENGTH OF DEB FIELD 52900002 HDRLEN DS CL1 LENGTH OF DEB FIELD HEADER 52950002 NMEXTSTR DS CL1 NUMBER OF EXTENTS IN DEB 53000002 HDRBUF DS 3F BUFFER FOR CURR DEB FLD HEADER 53050002 LINELEN DS 1F MAXIMUN LENGTH OF OUTPUT LINE 53100002 SVCPARMS DS 3F PARAMETER FOR SVC 97 ADRCK 53150002 TEMPAREA DS CL8 TEMPORARY STOR AREA FOR DATA 53200002 * TO TRANSLATE. THIS FIELD IS 53250002 * AS LONG AS THE LONGEST SINGLE 53300002 * FIELD IN DEB. IF LONGER FIELD 53350002 * IS EVER DEF, THIS FIELD MUST 53400002 * BE LENGTHENED. 53450002 * IT IS ESSENTIAL THAT THE FOLLOWING 6 AREAS BE CONTIGUOUS AND IN ORDER 53500002 STRNGPTR DS 1F CONVERT PARM LIST - PTR TO FIELD 53550002 CVTLL DS CL2 LENGTH OF FIELD 53600002 FLAGS DS CL1 FLAGS 53650002 TYPE DS CL1 TYPE OF DATA 53700002 OUTPTR1 DS 1F I/O PARM LIST - PTR TO IST I/O BUFF 53750002 OUTPTR2 DS 1F PTR TO 2ND I/O BUFF 53800002 REG14 DS 1F REG 14 OR VALIDITY CHECK EXIT R.C. 53850002 ORG DBWKAREA GO BACK TO BEGINNING OF WORK AREA 53900002 STAELIST DS 3F PARAMETER LIST FOR STAE 53950002 DATAREG DS 2F PLACE TO HOLD PARM REG FOR I/O CALL 53960002 EJECT 54000002 IKJEGDEB CSECT 57400002 EJECT 57450002 * 57500002 * PARSE MACROS 57550002 * 57600002 SPACE 2 57650002 IKJEGDBP IKJPARM 57700002 ADDRESS IKJPOSIT ADDRESS,VALIDCK=DEBVALCK,PROMPT='ADDRESS OF DEB' 57750002 PRINT IKJKEYWD 57800002 IKJNAME 'PRINT',SUBFLD=DSNAME 57850002 DEBFIELD IKJKEYWD 57900002 IKJNAME 'FIELD',SUBFLD=FIELDNAM 57950002 DSNAME IKJSUBF 58000002 DSNAM IKJPOSIT DSNAME,PROMPT='DATA SET NAME' 58050002 FIELDNAM IKJSUBF 58100002 NMSUB IKJKEYWD 58150002 IKJNAME 'DEBNMSUB' 58200002 TCBAD IKJKEYWD 58250002 IKJNAME 'DEBTCBAD' 58300002 AMLNG IKJKEYWD 58350002 IKJNAME 'DEBAMLNG' 58400002 DEBAD IKJKEYWD 58450002 IKJNAME 'DEBDEBAD' 58500002 OFLGS IKJKEYWD 58550002 IKJNAME 'DEBOFLGS' 58600002 IRBAD IKJKEYWD 58650002 IKJNAME 'DEBIRBAD' 58700002 OPATB IKJKEYWD 58750002 IKJNAME 'DEBOPATB' 58800002 QSCNT IKJKEYWD 58850002 IKJNAME 'DEBQSCNT' 58900002 FLGS1 IKJKEYWD 58950002 IKJNAME 'DEBFLGS1' 59000002 RSVD IKJKEYWD 59050002 IKJNAME 'DEBRSRVD' 59100002 NMEXT IKJKEYWD 59150002 IKJNAME 'DEBNMEXT' 59200002 USPRG IKJKEYWD 59250002 IKJNAME 'DEBUSPRG' 59300002 PRIOR IKJKEYWD 59350002 IKJNAME 'DEBPRIOR' 59400002 ECBAD IKJKEYWD 59450002 IKJNAME 'DEBECBAD' 59500002 PROTG IKJKEYWD 59550002 IKJNAME 'DEBPROTG' 59600002 IKJNAME 'DEBDEBID' 59650002 DCBAD IKJKEYWD 59700002 IKJNAME 'DEBDCBAD' 59750002 EXSCL IKJKEYWD 59800002 IKJNAME 'DEBEXSCL' 59850002 APPAD IKJKEYWD 59900002 IKJNAME 'DEBAPPAD' 59950002 DVMOD IKJKEYWD 60000002 IKJNAME 'DEBDVMOD' 60050002 UCBAD IKJKEYWD 60100002 IKJNAME 'DEBUCBAD' 60150002 BINUM IKJKEYWD 60200002 IKJNAME 'DEBBINUM' 60250002 STRCC IKJKEYWD 60300002 IKJNAME 'DEBSTRCC' 60350002 STRHH IKJKEYWD 60400002 IKJNAME 'DEBSTRHH' 60450002 ENDCC IKJKEYWD 60500002 IKJNAME 'DEBENDCC' 60550002 ENDHH IKJKEYWD 60600002 IKJNAME 'DEBENDHH' 60650002 NMTRK IKJKEYWD 60700002 IKJNAME 'DEBNMTRK' 60750002 IKJENDP 60800002 * 60850002 * THE FOLLOWING STATEMENTS EQUATE THE FIELD HEADERS IN THE PARSE 60900002 * CSECT 60950002 * 61000002 HDRNMSUB EQU IKJEGDBP+FIRSTHDR FIELD HEADER IN PDL 61050002 HDRTCBAD EQU HDRNMSUB+FLDHDR FIELD HEADER IN PDL 61100002 HDRAMLNG EQU HDRTCBAD+FLDHDR FIELD HEADER IN PDL 61150002 HDRDEBAD EQU HDRAMLNG+FLDHDR FIELD HEADER IN PDL 61200002 HDROFLGS EQU HDRDEBAD+FLDHDR FIELD HEADER IN PDL 61250002 HDRIRBAD EQU HDROFLGS+FLDHDR FIELD HEADER IN PDL 61300002 HDROPATB EQU HDRIRBAD+FLDHDR FIELD HEADER IN PDL 61350002 HDRQSCNT EQU HDROPATB+FLDHDR FIELD HEADER IN PDL 61400002 HDRFLGS1 EQU HDRQSCNT+FLDHDR FIELD HEADER IN PDL 61450002 HDRNMEXT EQU HDRFLGS1+FLDHDR+FLDHDR FIELD HEADER IN PDL 61500002 HDRUSPRG EQU HDRNMEXT+FLDHDR FIELD HEADER IN PDL 61550002 HDRPRIOR EQU HDRUSPRG+FLDHDR FIELD HEADER IN PDL 61600002 HDRECBAD EQU HDRPRIOR+FLDHDR FIELD HEADER IN PDL 61650002 HDRDCBAD EQU HDRECBAD+FLDHDR+FLDHDR+LENNAME FIELD HEADER IN PDL 61700002 HDREXSCL EQU HDRDCBAD+FLDHDR FIELD HEADER IN PDL 61750002 HDRAPPAD EQU HDREXSCL+FLDHDR FIELD HEADER IN PDL 61800002 HDRDVMOD EQU HDRAPPAD+FLDHDR FIELD HEADER IN PDL 61850002 HDRUCBAD EQU HDRDVMOD+FLDHDR FIELD HEADER IN PDL 61900002 HDRBINUM EQU HDRUCBAD+FLDHDR FIELD HEADER IN PDL 61950002 HDRSTRCC EQU HDRBINUM+FLDHDR FIELD HEADER IN PDL 62000002 HDRSTRHH EQU HDRSTRCC+FLDHDR FIELD HEADER IN PDL 62050002 HDRENDCC EQU HDRSTRHH+FLDHDR FIELD HEADER IN PDL 62100002 HDRENDHH EQU HDRENDCC+FLDHDR FIELD HEADER IN PDL 62150002 HDRNMTRK EQU HDRENDHH+FLDHDR FIELD HEADER IN PDL 62200002 SPACE 4 62250002 CVT DSECT 62300002 CVT 62350002 EJECT 62400002 IKJTCB 62450002 EJECT 62500002 IEZDEB 62550002 END 62600002