TITLE 'IKJEGDCB, THE LISTDCB FUNCTION OF THE TEST COMMAND' 00016002 * /* START OF SPECIFICATIONS **** 00016402 *02* PROCESSOR = ASSEMBLER 00016802 **** END OF SPECIFICATIONS ***/ 00017202 *********************************************************************** 00030002 * STATUS CHANGE LEVEL 00, VERSION NO. 02, OS/VS2 * 00040002 * * 00050002 * FUNCTION/OPERATION * 00060002 * THIS COMMAND PROGRAM RECEIVES CONTROL FROM THE TEST COMMAND * 00070002 * PROCESSOR. IT DISPLAYS ALL OR PART OF THE DCB AT A USER * 00080002 * SPECIFIED ADDRESS. * 00090002 * * 00100002 * ENTRY POINTS * 00110002 * IKJEGDCB-PROCESSES THE FIELDS OF THE DCB * 00120002 * IKJEGDVK-VALIDITY CHECKS THE ADDRESS OF THE DCB * 00130002 * * 00140002 * INPUT * 00150002 * ONE LINE OF INPUT FROM THE TERMINAL CONTAINING THE COMMAND * 00160002 * * 00170002 * OUTPUT * 00180002 * LINES OF OUTPUT TO THE TERMINAL OR SPECIFIED DATA SET CONTAINING * 00190002 * DESCRIPTIVE HEADERS AND THE REQUESTED DCB FIELDS. * 00200002 * * 00210002 * EXTERNAL REFERENCES * 00220002 * IKJPARS - TO SCAN THE INPUT BUFFER * 00230002 * IKJEGCVT - TO CHECK AND CONVERT THE ADDRESS AND TO * 00240002 * CONVERT THE DCB FIELDS TO PRINTABLE HEXADECIMAL. * 00250002 * IKJEGIO - TO OUTPUT THE DCB HEADERS AND FIELDS * 00260002 * * 00280002 * EXITS,NORMAL * 00290002 * IKJPARS-VIA REGISTER 14 WITH ONE OF THE FOLLOWING RETURN * 00300002 * CODES IN REGISTER 15- * 00310002 * 0 INDICATING TO CONTINUE PROCESSING THE COMMAND BUFFER * 00320002 * 8 INDICATING IKJPARS SHOULD PROMPT WITH REENTER * 00330002 * 12 INDICATING IKJPARS SHOULD RETURN TO IKJEGDCB WITH A RETURN * 00340002 * * CODE OF 20. * 00350002 * * 00360002 * IKJEGMNL-VIA REGISTER 14 WITH ONE OF THE FOLLOWING RETURN * 00370002 * CODES IN REGISTER 15. * 00380002 * 0 NORMAL RETURN * 00390002 * 16 INDICATING AN ATTENTION INTERRUPT WAS ENCOUNTERED * 00400002 * * 00410002 * EXITS,ERROR * 00420002 * IKJEGMNL-VIA REGISTER 14 WITH A RETURN CODE OF 20 IN * 00430002 * REGISTER 15 INDICATING THE STAE RETRY ROUTINE WAS ENTERED. * 00440002 * IKJEGMNL-VIA REGISTER 14 WITH A RETURN CODE OF 24 IN * 00440402 * REGISTER 15 INDICATING THE ESTAE MACRO WAS NOT ISSUED * 00442002 * * 00450002 * TABLES/WORK AREAS * 00460002 * * 00470002 * TCOMTAB - DSECT CONTAINING THE ADDRESS OF THE OUTPUT BUFFER, * 00480002 * THE COMMAND BUFFER, LISTDCB'S WORKAREA AND SAVEAREA. * 00490002 * * 00500002 * DCBWKARA - CONTAINS THE PARAMETER LIST FOR IKJPARS, THE BUFFERS, * 00510002 * USED TO BUILD THE FIELD HEADERS AND FIELDS FOR * 00520002 * OUTPUT, AND THE SWITCHES USED BY IKJEGDCB. * 00530002 * * 00540002 * ATTRIBUTES * 00550002 * REENTRANT ROUTINE * 00560002 * REFRESHABLE ROUTINE * 00570002 * * 00580002 * CHARACTER CODE DEPENDENCY * 00590002 * THE OPERATION OF THIS MODULE DEPENDS UPON AN INTERNAL * 00600002 * REPRESENTATION OF THE EXTERNAL CHARACTER SET WHICH IS EQUIVALENT * 00610002 * TO THE ONE USED AT ASSEMBLY TIME. THE CODING HAS BEEN ARRANGED * 00620002 * SO THAT REDEFINITION OF CHARACTER CONSTANTS, BY REASSEMBLY, * 00630002 * WILL RESULT IN A CORRECT MODULE FOR THE NEW DEFINITION. * 00640002 * * 00650002 * NOTES * 00660002 * ABBREVIATIONS COMMONLY USED IN THE COMMENTS BESIDE THE CODE- * 00670002 * 1. PDL-PARAMETER DESCRIPTOR LIST * 00680002 * 2. PDE-PARAMETER DESCRIPTOR ENTRY * 00690002 * 3. PCL-PARAMETER CONTROL LIST * 00700002 * COMMENTS ON STATEMENTS USUALLY START IN COLUMN 36. * 00710002 * STAERTN IS THE ENTRY POINT INTO THE STAE RETRY ROUTINE. THIS * 00720002 * CODE IS ENTERED FROM IKJEGSTA. * 00730002 *********************************************************************** 00740002 EJECT 00750002 COPY IKJEGSIO 00752002 IKJEGDCB CSECT 00754002 R0 EQU 0 REGISTER 0 00760002 R1 EQU 1 REGISTER 1 00770002 R2 EQU 2 USED TO INDEX THROUGH OUTPUT BUFFER 00780002 R3 EQU 3 USED AS BASE FOR DCB BEING PROCESSED 00790002 R4 EQU 4 REGISTER 4 00800002 R5 EQU 5 BASE OF IKJEGDCB'S WORKAREA 00810002 R6 EQU 6 REGISTER 6 00820002 R7 EQU 7 REGISTER 7 00830002 R8 EQU 8 BASE FOR IKJPARMD 00840002 R9 EQU 9 BASE FOR TCOMTAB 00850002 R10 EQU 10 USED TO ADDRESS OUTPUT BUFFERS 00860002 R11 EQU 11 USED TO ADDRESS OUTPUT BUFFERS 00870002 R12 EQU 12 PROGRAM BASE 00880002 R13 EQU 13 POINTER TO IKJEGDCB'S SAVEAREA 00890002 R14 EQU 14 REGISTER 14 00900002 R15 EQU 15 REGISTER 15 00910002 ** THE FOLLOWING EQUATES ARE USED AS DISPLACEMENTS IN INSTRUCTIONS ** 00920002 ** AND TO INDICATE THE RELATIVE ADDRESS OF FIELDS WITHIN A DCB. ** 00930002 D0 EQU 0 DISPLACEMENT OF 0 00940002 D1 EQU 1 DISPLACEMENT OF 1 00950002 D2 EQU 2 DISPLACEMENT OF 2 00960002 D4 EQU 4 DISPLACEMENT OF 4 00970002 D5 EQU 5 DISPLACEMENT OF 5 00980002 D8 EQU 8 DISPLACEMENT OF 8 00990002 D10 EQU 10 DISPLACEMENT OF 10 01000002 D12 EQU 12 DISPLACEMENT OF 12 01010002 D14 EQU 14 DISPLACEMENT OF 14 01020002 D32 EQU 32 DISPLACEMENT OF 32 01030002 D35 EQU 35 DISPLACEMENT OF 35 01040002 D40 EQU 40 DISPLACEMENT OF 40 01050002 D44 EQU 44 DISPLACEMENT OF 44 01060002 D56 EQU 56 DISPLACEMENT OF 56 01070002 D68 EQU 68 DISPLACEMENT OF 68 01080002 D84 EQU 84 DISPLACEMENT OF 84 01090002 ** THE FOLLOWING EQUATES ARE USED IN TESTING AND IN DISPLACEMENTS ** 01100002 HEXBF EQU X'BF' USED TO TURN SECTION HEADER SW OFF 01110002 HEXDF EQU X'DF' USED TO TURN OFF FIELD HEADER SWITCH 01120002 HEXEF EQU X'EF' USED TO TURN OFF FIELD SWITCH 01130002 HEXCF EQU X'CF' USED TO TURN OFF FIELD HEADER AND 01140002 * FIELD SWITCHES 01150002 HEXFF EQU X'FF' HEX 'FF' 01160002 HEX10 EQU X'10' USED TO TEST OFLGS OF DCB TO 01170002 * DETERMINE IF DCB IS OPEN OR CLOSED 01180002 ALLCHECK EQU X'80' SWITCH INDICATING ALL FIELDS ARE TO 01190002 * BE OUTPUTTED 01200002 SECHDRCK EQU X'40' SWITCH INDICATING SECTION HEADER IS 01210002 * TO BE OUTPUTTED 01220002 HDRCHECK EQU X'20' SWITCH INDICATING FIELD HEADERS ARE 01230002 * TO BE OUTPUTTED. 01240002 FLDCHECK EQU X'10' SWITCH INDICATING CONTENTS OF FIELDS 01250002 * ARE TO BE OUTPUTTED 01260002 ZERO EQU X'0000' USED TO TURN PDE'S OFF AND ALSO TO 01270002 * TEST TO SEE IF FIELD WAS SPECIFIED 01280002 PDELEN EQU 53 NUMBER OF BYTES MINUS 1 OF THE FIELD 01290002 * PDES 01300002 FLAG EQU X'80' USED TO SET FLAG BYTE OF THE FIELD 01310002 * PDE PASSED TO IKJEGCVT 01320002 TYPE EQU X'04' INDICATES HEXADECIMAL TO IKJEGCVT 01330002 BLANK EQU C' ' BLANK 01340002 RET16 EQU 16 USED IN TESTING AND SETTING OF A 01350002 * RETURN CODE OF 16 01360002 BADESTAE EQU 24 USED TO PASS BACK A RETURN CODE 24 01362002 REGSMSK EQU X'38' USED TO TEST FOR ADDRESS 01370002 * BEING SPECIFIED AS REGISTER 01380002 HEXTHREE EQU X'03' USED TO TEST FOR ADDRESS BEING ON A 01390002 * FULLWORD BOUNDARY 01400002 INST99 EQU 99 STAE CODE FOR 'LINK FAILED' 01410002 HEXZERO EQU X'0000' USED TO TEST FOR INDIRECT ADDRESSING 01420002 * AGAINST INDIRECT FIELD OF ADDR PDE 01430002 RETCOD0 EQU 0 USED TO SET RETURN CODES 01440002 RETCODE8 EQU 8 USED TO SET AND TEST RETURN CODE 8 01450002 RETCOD12 EQU 12 USED TO SET RETURN CODE TO 01460002 * IKJPARS TO 12 01470002 RETCOD20 EQU 20 USED TO SET THE RETURN CODE TO 01480002 * IKJEGMNL TO 20 INDICATING STAE 01490002 * EXIT ROUTINE WAS ENTERED 01500002 FACTOR EQU 11 NUMBER OF BYTES PER SECTION 01510002 * OF CODE IN SUBTAB1 01520002 LINELGTH EQU 80 DEFAULT LINE LENGTH FOR TERMINAL 01530002 M0103 EQU 103 MESSAGE NUMBER FOR ERROR MESSAGE 01532002 M0015 EQU 15 MESSAGE NUMBER FOR ERROR MESSAGE 01534002 M0298 EQU 298 MESSAGE NUMBER FOR ERROR MESSAGE 01536002 M0280 EQU 280 MESSAGE NUMBER FOR ERROR MESSAGE 01538002 I0088 EQU 88 INSERT NUMBER FOR ERROR MESSAGE 01538402 I0003 EQU 3 INSERT NUMBER FOR ERROR MESSAGE 01538802 ** THE FOLLOWING EQUATES ARE USED IN THE LENGTH FIELDS OF ** 01540002 ** INSTRUCTIONS TO DESCRIBE THE NUMBER OF BYTES TO PROCESS. THEY ARE** 01550002 ** ALSO USED TO INDICATE THE NUMBER OF BYTES A PARTICULAR FIELD IN ** 01560002 ** THE DCB CONTAINS. ** 01570002 L0 EQU 0 LENGTH OF 0 01580002 L1 EQU 1 LENGTH OF 1 01590002 L2 EQU 2 LENGTH OF 2 01600002 L3 EQU 3 LENGTH OF 3 01610002 L4 EQU 4 LENGTH OF 4 01620002 L7 EQU 7 LENGTH OF 7 01630002 L8 EQU 8 LENGTH OF 8 01640002 L9 EQU 9 LENGTH OF 9 01650002 L52 EQU 52 LENGTH OF DCB IN BYTES 01660002 L79 EQU 79 LENGTH OF 79 01670002 L159 EQU 159 LENGTH OF 159 01680002 EJECT 01690002 SAVE (14,12),,* SAVE IKJEGMNL'S REGISTERS 01700002 LR R12,R15 LOAD ADDRESS OF THIS MODULE 01710002 USING IKJEGDCB,R12 ESTABLISH PROGRAM ADDRESSABILITY 01720002 USING TCOMTAB,R9 ESTABLISH TCOMTAB ADDRESSABILITY 01730002 L R15,REGSAVE2 LOAD ADDRESS OF NEW SAVE AREA 01740002 ST R13,D4(R15) STORE REGISTER 13 IN NEW SAVE AREA 01750002 ST R15,D8(R13) STORE NEW SAVE AREA ADDRESS 01760002 LR R13,R15 R13 NOW POINTS TO NEW SAVE AREA 01770002 L R6,WORKAREA LOAD ADDRESS OF TEST WORKAREA 01780002 USING TSTCWORK,R6 ESTABLISH ADDRESSABILITY 01790002 LA R5,CWORKCMD SKIP CONVERT WORK AREA 01800002 USING DCBWKARA,R5 ESTABLISH WORKAREA ADDRESSABILITY 01810002 DROP R6 RELEASE R6 FOR LATER USE 01820002 * CSECT 01850002 STM R14,R12,D12(R13) SAVE LISTDCB'S REGISTERS 01860002 SPACE 01870002 ********************************************************************** 01880002 * ISSUE ESTAE * 01890002 ********************************************************************** 01900002 SPACE 01910002 LA R15,STAEAREA GET ADDRESS OF STAE WORKAREA 01950002 MVC D0(STAELEN,R15),STAELIST PUT STAE LIST FORM INTO 01960002 * WORKAREA 01970002 L R2,TSTSTAE GET ADDR OF STAE EXIT ROUTINE 01980002 ESTAE (R2),CT,PARAM=IKJEGSPL,RECORD=YES,XCTL=NO,MF=(E,(R15)) 01990002 LTR R15,R15 RETURN CODE ZERO FROM STAE 02000002 SMTSTAE DS 0H SMT LABEL FOR TEST CASE TDCB2700 02010002 BZ SETPARSE YES, CONTINUE PROCESSING 02020002 STC R15,TSTESTRC STORE RETURN CODE FOR MAINLINE 02020402 LA R15,BADESTAE PASS BACK BAD ESTAE RTN CODE (24) 02020802 B RETTAB(R15) RETURN TO CALLER 02021202 EJECT 02070002 SETPARSE DS 0H 02080002 **THIS CODE SETS UP TO GO TO IKJPARS TO VALIDITY CHECK THE COMMAND ** 02090002 **BUFFER. ** 02100002 XC PPLLIST(TYPECODE-PPLLIST),PPLLIST CLEAR WORKAREA 02110002 LR R4,R5 ESTABLISH ADDRESSABILITY TO PARSE 02120002 USING PPL,R4 PARAMETER LIST 02130002 MVC PPLUPT(L4),TSTUPT PUT ADDR UPT INTO PARAMETER LIST 02140002 MVC PPLECT(L4),TSTECT PUT ADDR ECT INTO PARAMETER LIST 02150002 MVC PPLECB(L4),TSTCPECB PUT ADDR ECB INTO PARAMETER LIST 02160002 MVC PPLPCL(L4),PCLADDR PUT ADDR OF PCL INTO PARAMETER LIST 02170002 LA R2,TSTANSPL PUT POINTER TO ANSWER PLACE INTO 02180002 ST R2,PPLANS PARAMETER LIST TO PARSE 02190002 MVC PPLCBUF(L4),INBUF PUT ADDR OF COMMAND BUFFER INTO 02200002 * PARAMETER LIST FOR PARSE 02210002 ST R13,PPLUWA PUT POINTER TO SAVE AREA INTO LIST 02220002 LR R1,R4 REGISTER 1 POINTS TO PARAMETER LIST 02230002 LINK EP=IKJPARS,ERRET=LINKFAIL GO TO PARSE 02240002 PARSBLOW DS 0H LABEL USED BY STAE RETRY ROUTINE 02240402 B LINKOK IF CONTROL COMES HERE LINK OK 02242002 LINKFAIL DS 0H 02244002 LR R8,R15 TRANSFER RETURN CODE 02246002 LR R6,R1 TRANSFER ABEND CODE 02248002 XC TSTIOPRM,TSTIOPRM CLEAR PARM LIST 02248402 IKJEGSIO SVCERR,SVC=6,ABENDRG=(R6),RC=(R8),INST11=(NUM,I0040),*02248802 ID=DCB10,MF=(E,TSTIOPRM) CALL I/O FOR ERROR MSG 02249202 B RETTAB(R15) BRANCH INTO RETURN CODE TABLE 02249602 LINKOK DS 0H 02249702 SMTPARS DS 0H SMT LABEL FOR TEST CASE TDCB2600 02260002 B PARSDONE GO TO PARSDONE 02270002 EJECT 02280002 IKJEGDVK DS 0H 02290002 ** THIS CODE IS RESPONSIBLE FOR ANALYSING THE PARAMETERS FOR LISTDCB ** 02300002 ** AFTER IKJPARS HAS CHECKED THEM FOR SYMTAX ERRORS. CONTROL IS ** 02310002 ** PASSED TO THIS ROUTINE BY A LINK FROM IKJPARS. ** 02320002 SAVE (14,12),,* SAVE PARSE REGISTERS 02330002 L R9,D4(R1) OBTAIN ADDRESS OF LISTDCB SAVEAREA 02340002 L R12,D68(R9) RESTORE PROGRAM ADDRESSABILITY 02350002 L R5,D40(R9) RESTORE WORKAREA ADDRESSABILITY 02360002 L R6,D44(R9) RESTORE MSG CSECT ADDRESSABILITY 02370002 L R9,D56(R9) RESTORE TCOMTAB ADDRESSABILITY 02380002 L R15,REGSAVE3 LOAD SAVE AREA FOR IKJEGCVT 02390002 ST R13,D4(R15) SAVE ADDR OF PARSE'S SAVEAREA 02400002 ST R15,D8(R13) SAVE ADDR OF VALIDITY CHECK RTN'S 02410002 * SAVEAREA IN PARSE'S SAVEAREA 02420002 LR R13,R15 LOAD NEW SAVEAREA ADDRESS 02430002 L R2,D0(R1) GET ADDRESS OF PDE 02440002 LA R7,D8(R1) SAVE ADDR OF 3RD PARAMETER FROM 02450002 * PARSE 02460002 OI TSTFLGS4,TSTVALCK TURN ON VALIDITY CHECK FLAG FOR I/O 02462002 SR R0,R0 ZERO OUT REGISTER FOR NO SECOND LEV 02464002 L R15,OUTBUF PICK UP POINTER TO OUTBUF 02468002 ST R0,ZERO(R15) STORE NO SECOND LEV MSG INDICATOR 02468402 USING IKJPARMA,R2 ESTABLISH ADDRESSABILITY TO 02470002 * PARAMETER DESCRIPTOR ENTRY (PDE) 02480002 CLC PDEINDCT(L2),WORDZERO TEST TO SEE IF INDIRECT 02490002 * ADDRESSING WAS USED 02500002 BNE CONVERT NO, GO SET UP FOR IKJEGCVT 02510002 TM PDEFLG4,REGSMSK YES, IS TYPE OF ADDR REGISTER 02520002 BZ CONVERT NO, GO SET UP FOR IKJEGCVT 02530002 XC TSTIOPRM,TSTIOPRM CLEAR PARM LIST FOR I/O I/O CALL 02540002 IKJEGSIO MSG,FIRST=M0101,SECOND=M0268,ID=DCB10,MF=(E,TSTIOPRM) 02550002 LTR R15,R15 TEST FOR ERROR 02552002 BZ SET8 OK-GO BACK TO PARSE FOR REENTER 02555202 B SET12 NO GO BACK TO MAINLINE THRU PARSE 02556002 CONVERT DS 0H 02560002 ** THIS ROUTINE SETS UP THE PARAMETERS AND THEN GOES TO IKJEGCVT FOR ** 02570002 ** BINARY CONVERSION OF THE DCB ADDRESS. ** 02580002 LR R1,R2 PUT ADDRESS OF ADDR PDE INTO REG 1 02590002 LNR R1,R1 NEGATE REGISTER 1 TO INDICATE ADDR 02600002 * CONVERSION 02610002 XR R0,R0 RO IS POSITIVE TO INDICATE BINARY 02620002 * CONVERSION 02630002 L R15,TSTCONVT OBTAIN ADDR OF ENTRY POINT TO 02640002 * IKJEGCVT FROM TCOMTAB 02650002 BALR R14,R15 GO TO IKJEGCVT 02660002 LPR R1,R1 RESET REGISTER 1 TO POSITIVE 02670002 B CONVTAB(R15) BRANCH INTO TABLE INDEXED BY 02680002 * CONTENTS OF REGISTER 15 02690002 CONVTAB DS 0H 02700002 B BOUNDCK 0-CONTINUE PROCESSING 02710002 B SETMSG 4-SET BY IKJEGCVT-MOVE MSG ADDR 02720002 B SETMSG2 8-SET BY IKJEGSYM-MOVE MSG ADDR 02730002 B SETMSG2 12-SET BY IKJEGSYM-MOVE MSG ADDR 02740002 B SET12 16-ATTENTION INTERRUPT-RETURN 02750002 B SET12 20-IKJEGCVT OR IKJEGSYM BLEW 02760002 B SET12 24-IKJEGCVT OR IKJEGSYM BLEW 02762002 SETMSG2 DS 0H 02770002 SET12 DS 0H 02790002 ST R15,REG15 SAVE RETURN CODE FOR LATER USE 02800002 LA R15,RETCOD12 SET RETURN CODE TO 12 02810002 B PARSRTRN GO RETURN TO IKJPARS 02820002 SETMSG DS 0H 02830002 MVC D0(L4,R7),PDEUSER PUT MSG ADDR INTO PARAMETER LIST 02840002 SET8 DS 0H 02850002 LA R15,RETCODE8 SET RETURN CODE TO 8 02860002 B PARSRTRN PREPARE TO RETURN TO IKJPARS 02870002 SPACE 02880002 BOUNDCK DS 0H 02890002 L R3,PDEUSER LOAD SAVEPTR (WORD PASSED TO PARSE) 02900002 TM PDEFLG5,PDESIB IF ADDR IS NOT SYMBOLIC 02912002 BZ NOSYM ...THEN BRANCH 02920002 L R3,D0(R3) ...ELSE GET ADDR FROM SIB 02930002 NOSYM EQU * 02940002 LA R3,0(,R3) ZERO HIGH ORDER BYTE 02942002 L R4,REGSAVE2 LOAD ADDR OF LISTDCBS REGISTERS 02950002 ST R3,D32(R4) SAVE CONVERTED ADDRESS IN REG 3 02960002 * FOR MAINLINE CODE 02970002 LA R3,L52(R3) GET ADDRESS OF END OF DCB 02980002 BOUNDARY DS 0H 02990002 TM D35(R4),HEXTHREE IS ADDRESS ON FULL WORD BOUNDARY 03000002 BZ SET0 IF YES, RETURN TO PARSE 03010002 XC TSTIOPRM,TSTIOPRM CLEAR I/O PARM LIST 03020002 IKJEGSIO MSG,FIRST=M0101,INST11=(APDE,(R2)), CALL I/O *03030002 INST21=(NUM,I0003),SECOND=M0280,ID=DCB10,MF=(E,TSTIOPRM) 03040002 LTR R15,R15 TEST FOR ERROR 03052002 BZ SET8 OK-GO BACK TO PARSE FOR REENTER 03060002 B SET12 NO GO BACK TO MAINLINE THRU PARSE 03070002 SET0 DS 0H 03410002 XR R15,R15 INDICATE PARAMETER IS VALID 03420002 PARSRTRN DS 0H 03430002 DROP R2 RELEASE ADDRESSABILITY TO ADDR PDE 03440002 L R6,OUTBUF PICK UP ADDRESS OF OUTBUF 03442002 LH R5,ZERO(R6) PICK UP MESSAGE LENGTH IF ONE 03444002 LTR R5,R5 SEE IF THERE IS A MESSAGE 03446002 BZ NO2NDLEV BRANCH AROUND NEXT INST. IF NONE 03448002 ST R6,ZERO(R7) PASS 2ND MSG ADDRESS TO PARSE 03448802 NO2NDLEV DS 0H 03449202 NI TSTFLGS4,HEXFF-TSTVALCK TURN OFF VALIDITY CHECK BIT 03449602 L R13,D4(R13) RESTORE ADDRESS OF PARSE SAVEAREA 03450002 RETURN (14,12),,RC=(15) RESTORE REGISTERS AND RETURN 03460002 EJECT 03480002 *********************************************************************** 03490002 * THE FOLLOWING CODE IS EXECUTED UPON COMPLETION OF IKJPARS * 03500002 *********************************************************************** 03510002 PARSDONE DS 0H 03520002 ** THE FOLLOWING IS A BRANCH TABLE USED TO DETERMINE WHERE CONTROL ** 03530002 ** SHOULD BE GIVEN AFTER RETURNING FROM IKJPARS. ** 03540002 B PARSTAB(R15) BRANCH TO TABLE INDEXED BY CONTENTS 03550002 * OF REGISTER 15 03560002 PARSTAB DS 0H 03570002 B PDLADDR RETURN CODE 0-CONTINUE PROCESSING 03580002 B FLUSHIT RETURN CODE 4-GO BACK TO IKJEGMNL 03590002 B DCBRC16 RETURN CODE 8-ATTENTION INTERRUPT 03600002 B PARMSG2 RETURN CODE 12-GO WRITE MESSAGE 03610002 B PARMSG3 RETURN CODE 16-GO WRITE MESSAGE 03620002 B CHKRET RETURN CODE 20-GO CHECK FOR CODE 03630002 PARMSG2 DS 0H 03640002 ** THIS SETS UP TO WRITE MESSAGES IKJ57206I ** 03650002 XC TSTIOPRM,TSTIOPRM CLEAR I/O PARM LIST 03660002 IKJEGSIO MSG,FIRST=M0104,INST11=(NUM,I0007),SECOND=M0277, *03674002 ID=DCB10,MF=(E,TSTIOPRM) CALL I/O TO ISSUE ERROR MSG 03674402 B RETTAB(R15) BRANCH INTO RTN CODE TABLE 03674802 PARMSG3 DS 0H 03676002 LA R4,M0103 GET MESSAGE NUMBER INTO PARM REG 03678002 B MSGERR GO ISSUE ERROR MESSAGE TO TERM 03678402 PDLADDR DS 0H 03680002 L R8,TSTANSPL OBTAIN ADDRESS OF PARSE PARAMETER 03700002 * DESCRIPTOR LIST (PDL) 03710002 USING IKJPARMD,R8 ESTABLISH PDL ADDRESSABILITY 03720002 EJECT 03730002 FIELDCHK DS 0H 03740002 ** THIS CODE TESTS TO SEE IF THE FIELD PARAMETER WAS CODED ON THE ** 03750002 ** CONTROL STATEMENT. ** 03760002 USING IHADCB,R3 ESTABLISH ADDRESSABILITY TO DCB 03770002 CLC DCBFIELD(L2),WORDZERO WAS FIELD PARAMETER SPECIFIED 03780002 BNE SCANPDES YES, GO SCAN DCBFIELDS 03790002 OI OUTPUTSW,ALLCHECK NO, INDICATE ALL DCBFIELDS ARE TO BE 03800002 * OUTPUTTED 03810002 MVI RELAD,HEXFF SET THE FIRST PARSE DESCRIPTOR 03820002 * ENTRY (PDE) TO NON ZERO 03830002 MVC RELAD+D1(PDELEN),RELAD SET REMAINING PDES NON ZERO 03840002 MVC FTEK(L4),WORDZERO ZERO DCBFTEK AND DCBBFALN PDES 03850002 TM DCBOFLGS,HEX10 IS THIS AN OPEN DCB 03860002 BZ CLOSED NO, GO HANDLE FOR CLOSED 03870002 MVI DDNAM,HEXZERO YES, ZERO OUT PDES DESCRIBING A 03880002 MVC DDNAM+D1(L7),DDNAM CLOSED DCB 03890002 B PRINTCHK GO SEE IF PRINT WAS SPECIFIED 03900002 CLOSED DS 0H 03910002 MVI TIOT,ZERO ZERO OUT PDES DESCRIBING AN 03920002 MVC TIOT+D1(L9),TIOT OPEN DCB 03930002 B PRINTCHK GO SEE IF PRINT WAS SPECIFIED 03940002 SCANPDES DS 0H 03950002 CLC OFLGS(L2),WORDZERO WAS DCBOFLGS SPECIFIED 03960002 BE TRIHDR NO, GO CHECK COMMON HEADER FIELD 03970002 TM DCBOFLGS,HEX10 YES, IS THIS AN OPEN DCB 03980002 BZ TRIHDR NO, GO CHECK COMMON HEADER FIELD 03990002 MVC OFLGS(L2),WORDZERO YES, TURN OFF CLOSED DCBOFLGS PDE 04000002 MVC OFLGS2(L2),HEXFFFF TURN ON OPEN DCBOFLGS PDE 04010002 TRIHDR DS 0H 04020002 ** THIS CODE TESTS TO SEE IF ONE OF THE FOLLOWING OR ALL OF THE ** 04030002 ** FOLLOWING FIELDS ARE SPECIFIED- DCBHIARC,DCBFTEK OR DCBBFALN ** 04040002 ** THE CODE WILL LEAVE ONE OF THE PDES ON TO BE PROCESSED AND WILL ** 04050002 ** TURN THE REST OF THEM OFF. THIS IS TO AVOID OUTPUTTING THE SAME ** 04060002 ** FIELD THREE TIMES. ** 04070002 CLC HIARC(L2),WORDZERO WAS THE DCBHIARC FIELD SPECIFIED 04080002 BNE CLEAR2 YES, CLEAR DCBFTEK AND DCBBFALN PDES 04090002 CLC FTEK(L2),WORDZERO WAS THE DCBFTEK FIELD SPECIFIED 04100002 BE PRINTCHK NO, GO SEE IF PRINT WAS SPECIFIED 04110002 MVC BFALN(L2),WORDZERO YES, ZERO OUT DCBBFALN PDE 04120002 B PRINTCHK GO SEE IF PRINT WAS SPECIFIED 04130002 CLEAR2 DS 0H 04140002 MVC FTEK(L4),WORDZERO CLEAR DCBFTEK AND DCBBFALN PDES 04150002 EJECT 04160002 PRINTCHK DS 0H 04170002 ** THIS CODE IS RESPONSIBLE FOR DETERMINING IF THE PRINT PARAMETER ** 04180002 ** WAS SPECIFED. ** 04190002 CLC PRINT(L2),WORDZERO WAS PRINT SPECIFIED 04200002 BNE PRNTSPEC YES, PDE NON ZERO BRANCH 04210002 NI TSTFLGS1,(HEXFF-TSTPRINT) INITIALIZE OUTPUT FLAGS 04220002 * IN TCOMTAB 04230002 B TABLESCN GO DETERMINE LENGTH OF OUTPUT LINE 04240002 PRNTSPEC DS 0H 04250002 ** THIS CODE IS EXECUTED WHEN THE USER HAS SPECIFIED AN OUTPUT DATA ** 04260002 ** SET. IT SAVES THE ADDRESS OF THE DSNAME PDE FOUND IN THE PDL ** 04270002 ** PASSED BY PARSE AND SETS A FLAG IN TCOMTAB TO INDICATE THIS ** 04280002 ** CONDITION TO IKJEGIO. ** 04290002 LA R2,DSNAM LOAD ADDRESS OF DSNAME PDE 04300002 OI TSTFLGS1,TSTPRINT SET FLAG IN TCOMTAB TO INDICATE 04310002 * USER SPECIFIED OUTPUT DATA SET 04320002 ST R2,PRINTFLG STORE ADDR OF DSNAME PDE 04330002 TABLESCN DS 0H 04340002 ** THIS CODE IS RESPONSIBLE FOR DETERMINING THE LENGTH OF THE OUTPUT ** 04350002 ** LINE. THE DEFAULT IS 80 IF THE USER SPECIFIED AN OUTPUT LINE ** 04360002 ** GREATER THAN 80 OR LESS THAN 40. IKJEGDCB TRIES TO GIVE A GOOD ** 04370002 ** FORMAT FOR THOSE OUTPUT LINES IN THE RANGE OF 40 TO 80. ** 04380002 LA R4,LINELGTH LOAD DEFAULT LINE LENGTH 04390002 CH R4,TMPLL COMPARE TO TERMINAL LINE LENGTH 04400002 BNH LINESET BRANCH IF 80 IS LOW OR EQUAL TO 04410002 * TERMINAL LINE LENGTH 04420002 LA R4,D40 04430002 CH R4,TMPLL COMPARE 40 WITH TMP LINE LENGTH 04440002 BH DEFAULT BRANCH IF 40 IS HIGHER THAN TERMINAL 04450002 * LINE LENGTH 04460002 LH R4,TMPLL USE SPECIFIED LINE LENGTH 04470002 B LINESET GO SET LINE LENGTH 04480002 DEFAULT DS 0H 04490002 LA R4,LINELGTH DEFAULT LINE LENGTH 04500002 LINESET DS 0H 04510002 STH R4,LINELEN STORE OUTPUT LINE LENGTH 04520002 L R10,OUTBUF GET ADDRESS OF OUTPUT BUFFER 04530002 MVI D4(R10),BLANK BLANK OUT OUTPUT BUFFER 04540002 MVC D5(L159,R10),D4(R10) 04550002 XC D0(L4,R10),D0(R10) CLEAR 1ST 4 BYTES OF OUTBUF 04560002 LA R2,OFLGS2+D2 GET ADDRESS OF END OF DSECT 04570002 ST R2,ENDEND STORE LAST PDE ADDRESS+2 04580002 XR R2,R2 INITIALIZE LENGTH OF OUTPUT TO ZERO 04590002 LA R6,RELAD POINT TO FIRST PDE 04600002 EJECT 04610002 PDECHECK DS 0H 04620002 CLC D0(L2,R6),WORDZERO IS THIS FIELD DESIRED 04630002 BNE SBRTNSVR BRANCH IF DESIRED 04640002 PDECHK DS 0H 04650002 LA R6,D2(R6) NO, POINT TO NEXT PDE 04660002 C R6,ENDEND ARE THERE MORE PDE'S 04670002 BE PDLEND NO, GO TO END PROCESSING 04680002 B PDECHECK YES, CHECK NEXT PDE 04690002 SBRTNSVR DS 0H 04700002 LR R11,R6 PRESERVE R6 04710002 LA R7,RELAD ADDRESS OF FIRST PDE 04720002 SR R11,R7 FIND RELATIVE POSITION OF PDE 04730002 LA R10,FACTOR LOAD MULTIPLICATION FACTOR 04740002 LA R7,SUBTAB1 LOAD ADDRESS OF TABLE 04750002 MR R10,R10 COMPUTE PROPER OFFSET 04760002 AR R7,R11 ADD OFFSET TO BASE 04770002 BR R7 GO TO PROPER SUBROUTINE 04780002 SPACE 04790002 *********************************************************************** 04800002 * THE FOLLOWING CODE CONSISTS OF 27 SUBROUTINES CORRESPONDING TO THE * 04810002 * FIELDS OF DCB. EACH SUBROUTINE MOVES THE RELATIVE ADDRESS, FIELD * 04820002 * LENGTH, HEADER LENGTH, AND HEADER TO A COMMON BUFFER. CONTROL IS * 04830002 * THEN PASSED EITHER TO THE CONVERSION ROUTINE OR TO A HEADER OUTPUT * 04840002 * ROUTINE AND THEN TO A CONVERSION ROUTINE. THE SUBROUTINE FOR DDNAM * 04850002 * WILL PASS CONTROL TO A VALIDITY CHECKING ROUTINE. IT IS ESSENTIAL * 04860002 * FOR PROPER LOGIC FLOW THAT EACH SUBROUTINE HAVE THE SAME LENGTH. * 04870002 *********************************************************************** 04880002 SPACE 04890002 SUBTAB1 DS 0H 04900002 **THE FOLLOWING CODE SETS UP FOR FIELDS IN THE DEVICE INTERFACE 04910002 DSRELAD EQU * 04920002 MVC HDRBUFFR(L'HDRRELAD),HDRRELAD MOVE HEADING IN 04930002 MVI HDRLENTH,L'HDRRELAD MOVE LENGTH OF HEADER IN 04940002 MVI FLDLENTH,L4 MOVE IN FIELD LENGTH 04950002 LA R4,DCBRELAD MOVE IN RELATIVE ADDRESS 04960002 B HDROUTPT GO WRITE SECTION HDR OUT 04970002 DSKEYCN EQU * 04980002 MVC HDRBUFFR(L'HDRKEYCN),HDRKEYCN MOVE HEADING IN 04990002 MVI HDRLENTH,L'HDRKEYCN MOVE LENGTH OF HEADER IN 05000002 MVI FLDLENTH,L1 MOVE IN FIELD LENGTH 05010002 LA R4,DCBKEYCN MOVE IN RELATIVE ADDRESS 05020002 B CVTANDIO GO SET UP FOR CONVERSION 05030002 DSFDAD EQU * 05040002 MVC HDRBUFFR(L'HDRFDAD),HDRFDAD MOVE IN HEADING 05050002 MVI HDRLENTH,L'HDRFDAD MOVE LENGTH OF HEADER IN 05060002 MVI FLDLENTH,L8 MOVE IN FIELD LENGTH 05070002 LA R4,DCBFDAD MOVE IN RELATIVE ADDRESS 05080002 B CVTANDIO GO SET UP FOR CONVERSION 05090002 DSDVTBL EQU * 05100002 MVC HDRBUFFR(L'HDRDVTBL),HDRDVTBL MOVE HEADING IN 05110002 MVI HDRLENTH,L'HDRDVTBL MOVE LENGTH OF HEADER IN 05120002 MVI FLDLENTH,L3 MOVE LENGTH OF FIELD IN 05130002 LA R4,DCBDVTBL+D1 MOVE IN RELATIVE ADDRESS 05140002 B CVTANDIO GO SET UP FOR CONVERSION 05150002 DSKEYLE EQU * 05160002 MVC HDRBUFFR(L'HDRKEYLE),HDRKEYLE MOVE HEADING IN 05170002 MVI HDRLENTH,L'HDRKEYLE MOVE LENGTH OF HEADING IN 05180002 MVI FLDLENTH,L1 MOVE IN FIELD LENGTH 05190002 LA R4,DCBKEYLE MOVE IN RELATIVE ADDRESS 05200002 B CVTANDIO GO SET UP FOR CONVERSION 05210002 DSDEVT EQU * 05220002 MVC HDRBUFFR(L'HDRDEVT),HDRDEVT MOVE HEADING IN 05230002 MVI HDRLENTH,L'HDRDEVT MOVE LENGTH OF HEADING IN 05240002 MVI FLDLENTH,L1 MOVE LENGTH OF FIELD IN 05250002 LA R4,DCBDEVT MOVE IN RELATIVE ADDRESS 05260002 B CVTANDIO GO SET UP FOR CONVERSION 05270002 DSTRBAL EQU * 05280002 MVC HDRBUFFR(L'HDRTRBAL),HDRTRBAL MOVE HEADING IN 05290002 MVI HDRLENTH,L'HDRTRBAL MOVE LENGTH OF HEADING IN 05300002 MVI FLDLENTH,L2 MOVE LENGTH OF FIELD IN 05310002 LA R4,DCBTRBAL MOVE IN RELATIVE ADDRESS 05320002 B CVTANDIO GO SET UP FOR CONVERSION 05330002 **THE FOLLOWING CODE SETS UP FOR FIELDS IN THE COMMON INTERFACE 05340002 DSBUFNO EQU * 05350002 MVC HDRBUFFR(L'HDRBUFNO),HDRBUFNO MOVE HEADING IN 05360002 MVI HDRLENTH,L'HDRBUFNO MOVE LENGTH OF HEADING IN 05370002 MVI FLDLENTH,L1 MOVE IN FIELD LENGTH 05380002 LA R4,DCBBUFNO MOVE IN RELATIVE ADDRESS 05390002 B HDROUTPT GO WRITE SECTION HEADER OUT 05400002 DSBUFCB EQU * 05410002 MVC HDRBUFFR(L'HDRBUFCB),HDRBUFCB MOVE HEADING IN 05420002 MVI HDRLENTH,L'HDRBUFCB MOVE LENGTH OF HEADING IN 05430002 MVI FLDLENTH,L3 MOVE LENGTH OF FIELD IN 05440002 LA R4,DCBBUFCB+D1 MOVE IN RELATIVE ADDRESS 05450002 B CVTANDIO GO SET UP FOR CONVERSION 05460002 DSBUFL EQU * 05470002 MVC HDRBUFFR(L'HDRBUFL),HDRBUFL MOVE HEADING IN 05480002 MVI HDRLENTH,L'HDRBUFL MOVE LENGTH OF HEADING IN 05490002 MVI FLDLENTH,L2 MOVE LENGTH OF FIELD IN 05500002 LA R4,DCBBUFL MOVE IN RELATIVE ADDRESS 05510002 B CVTANDIO GO SET UP FOR CONVERSION 05520002 DSDSORG EQU * 05530002 MVC HDRBUFFR(L'HDRDSORG),HDRDSORG MOVE HEADING IN 05540002 MVI HDRLENTH,L'HDRDSORG MOVE LENGTH OF HEADING IN 05550002 MVI FLDLENTH,L2 MOVE LENGTH OF FIELD IN 05560002 LA R4,DCBDSORG MOVE IN RELATIVE ADDRESS 05570002 B CVTANDIO GO SET UP FOR CONVERSION 05580002 DSIOBAD DS 0H 05590002 MVC HDRBUFFR(L'HDRIOBAD),HDRIOBAD MOVE HEADING IN 05600002 MVI HDRLENTH,L'HDRIOBAD MOVE LENGTH OF HEADING IN 05610002 MVI FLDLENTH,L4 MOVE LENGTH OF FIELD IN 05620002 LA R4,DCBIOBAD MOVE IN RELATIVE ADDRESS 05630002 B CVTANDIO GO SET UP FOR CONVERSION 05640002 **THE FOLLOWING CODE SETS UP FOR FIELDS IN THE FOUNDATION EXTENSION 05650002 DSHIARC DS 0H 05660002 MVC HDRBUFFR(L'HDRHIARC),HDRHIARC MOVE HEADING IN 05670002 MVI HDRLENTH,L'HDRHIARC MOVE LENGTH OF HEADING IN 05680002 MVI FLDLENTH,L1 MOVE LENGTH OF FIELD IN 05690002 LA R4,DCBBFTEK MOVE IN RELATIVE ADDRESS 05700002 B HDROUTPT GO WRITE SECTION HEADER OUT 05710002 DSBFTEK DS 0H 05720002 MVC HDRBUFFR(L'HDRBFTEK),HDRBFTEK MOVE HEADING IN 05730002 MVI HDRLENTH,L'HDRBFTEK MOVE LENGTH OF HEADER IN 05740002 MVI FLDLENTH,L1 MOVE IN FIELD LENGTH 05750002 LA R4,DCBBFTEK MOVE IN RELATIVE ADDRESS 05760002 B CVTANDIO GO SET UP FOR CONVERSION 05770002 DSBFALN DS 0H 05780002 MVC HDRBUFFR(L'HDRBFALN),HDRBFALN MOVE HEADING IN 05790002 MVI HDRLENTH,L'HDRBFALN MOVE LENGTH OF HEADING IN 05800002 MVI FLDLENTH,L1 MOVE IN FIELD LENGTH 05810002 LA R4,DCBBFALN MOVE IN RELATIVE ADDRESS 05820002 B CVTANDIO GO SET UP FOR CONVERSION 05830002 DSEODAD DS 0H 05840002 MVC HDRBUFFR(L'HDREODAD),HDREODAD MOVE HEADING IN 05850002 MVI HDRLENTH,L'HDREODAD MOVE LENGTH OF HEADING IN 05860002 MVI FLDLENTH,L3 MOVE IN FIELD LENGTH 05870002 LA R4,DCBEODAD+D1 MOVE IN RELATIVE ADDRESS 05880002 B CVTANDIO GO SET UP FOR CONVERSION 05890002 DSRECFM DS 0H 05900002 MVC HDRBUFFR(L'HDRRECFM),HDRRECFM MOVE HEADING IN 05910002 MVI HDRLENTH,L'HDRRECFM MOVE LENGTH OF HEADING IN 05920002 MVI FLDLENTH,L1 MOVE IN FIELD LENGTH 05930002 LA R4,DCBRECFM MOVE IN RELATIVE ADDRESS 05940002 B CVTANDIO GO SET UP FOR CONVERSION 05950002 DSEXLST DS 0H 05960002 MVC HDRBUFFR(L'HDREXLST),HDREXLST MOVE HEADING IN 05970002 MVI HDRLENTH,L'HDREXLST MOVE IN LENGTH OF HEADING 05980002 MVI FLDLENTH,L3 MOVE IN FIELD LENGTH 05990002 LA R4,DCBEXLST+D1 MOVE IN RELATIVE ADDRESS 06000002 B CVTANDIO GO SET UP FOR CONVERSION 06010002 **THE FOLLOWING CODE SETS UP FOR FIELDS IN A CLOSED FOUNDATION 06020002 DSDDNAM DS 0H 06030002 MVC HDRBUFFR(L'HDRDDNAM),HDRDDNAM MOVE HEADING IN 06040002 MVI HDRLENTH,L'HDRDDNAM MOVE LENGTH OF HEADING IN 06050002 MVI FLDLENTH,L8 MOVE IN FIELD LENGTH 06060002 LA R4,DCBDDNAM MOVE IN RELATIVE ADDRESS 06070002 B HDROUTPT GO WRITE SECTION HEADER OUT 06080002 DSOFLG1 DS 0H 06090002 MVC HDRBUFFR(L'HDROFLGS),HDROFLGS MOVE HEADING IN 06100002 MVI HDRLENTH,L'HDROFLGS MOVE LENGTH OF HEADING IN 06110002 MVI FLDLENTH,L1 MOVE IN FIELD LENGTH 06120002 LA R4,DCBOFLGS MOVE IN RELATIVE ADDRESS 06130002 B CVTANDIO GO SET UP FOR CONVERSION 06140002 DSIFLG DS 0H 06150002 MVC HDRBUFFR(L'HDRIFLG),HDRIFLG MOVE HEADING IN 06160002 MVI HDRLENTH,L'HDRIFLG MOVE LENGTH OF HEADING IN 06170002 MVI FLDLENTH,L1 MOVE IN FIELD LENGTH 06180002 LA R4,DCBIFLG MOVE IN RELATIVE ADDRESS 06190002 B CVTANDIO GO SET UP FOR CONVERSION 06200002 DSMACR DS 0H 06210002 MVC HDRBUFFR(L'HDRMACR),HDRMACR MOVE HEADING IN 06220002 MVI HDRLENTH,L'HDRMACR MOVE LENGTH OF HEADING IN 06230002 MVI FLDLENTH,L2 MOVE IN FIELD LENGTH 06240002 LA R4,DCBMACR MOVE IN RELATIVE ADDRESS 06250002 B CVTANDIO GO SET UP FOR CONVERSION 06260002 **THE FOLLOWING CODE SETS UP FOR FIELDS IN AN OPEN FOUNDATION 06270002 DSTIOT DS 0H 06280002 MVC HDRBUFFR(L'HDRTIOT),HDRTIOT MOVE HEADING IN 06290002 MVI HDRLENTH,L'HDRTIOT MOVE LENGTH OF HEADING IN 06300002 MVI FLDLENTH,L2 MOVE IN FIELD LENGTH 06310002 LA R4,DCBTIOT MOVE IN RELATIVE ADDRESS 06320002 B HDROUTPT GO WRITE SECTION HEADER OUT 06330002 DSMACRF DS 0H 06340002 MVC HDRBUFFR(L'HDRMACRF),HDRMACRF MOVE HEADING IN 06350002 MVI HDRLENTH,L'HDRMACRF MOVE LENGTH OF HEADING IN 06360002 MVI FLDLENTH,L2 MOVE IN FIELD LENGTH 06370002 LA R4,DCBMACRF MOVE IN RELATIVE ADDRESS 06380002 B CVTANDIO GO SET UP FOR CONVERSION 06390002 DSIFLGS DS 0H 06400002 MVC HDRBUFFR(L'HDRIFLGS),HDRIFLGS MOVE HEADING IN 06410002 MVI HDRLENTH,L'HDRIFLGS MOVE LENGTH OF HEADING IN 06420002 MVI FLDLENTH,L1 MOVE IN FIELD LENGTH 06430002 LA R4,DCBIFLGS MOVE IN RELATIVE ADDRESS 06440002 B CVTANDIO GO SET UP FOR CONVERSION 06450002 DSDEBAD DS 0H 06460002 MVC HDRBUFFR(L'HDRDEBAD),HDRDEBAD MOVE HEADING IN 06470002 MVI HDRLENTH,L'HDRDEBAD MOVE IN LENGTH OF HEADING 06480002 MVI FLDLENTH,L3 MOVE IN FIELD LENGTH 06490002 LA R4,DCBDEBAD+D1 MOVE IN RELATIVE ADDRESS 06500002 B CVTANDIO GO SET UP FOR CONVERSION 06510002 DSOFLG2 DS 0H 06520002 MVC HDRBUFFR(L'HDROFLGS),HDROFLGS MOVE HEADING IN 06530002 MVI HDRLENTH,L'HDROFLGS MOVE LENGTH OF HEADING IN 06540002 MVI FLDLENTH,L1 MOVE IN FIELD LENGTH 06550002 LA R4,DCBOFLGS MOVE IN RELATIVE ADDRESS 06560002 B CVTANDIO GO SET UP FOR CONVERSION 06570002 EJECT 06580002 ** THE FOLLOWING CODE OUTPUTS THE SECTION HEADERS ** 06590002 HDROUTPT DS 0H 06600002 TM OUTPUTSW,ALLCHECK ARE ALL THE FIELDS TO BE OUTPUTTED 06610002 BZ DDCHECK2 NO, GO CHECK FOR DDNAME PDE 06620002 LTR R2,R2 YES, IS THERE PREVIOUS OUTPUT 06630002 BZ CONTINUE NO, GO PREPARE HEADER 06640002 L R10,OUTBUF YES, POINT TO OUTPUT BUFFER 06650002 LA R14,D4(R2) SET LENGTH OF OUTPUT 06660002 STH R14,D0(R10) STORE LENGTH IN OUTPUT BUFFER 06670002 OI OUTPUTSW,HDRCHECK INDICATE HEADER BEING OUTPUTTED 06680002 OI OUTPUTSW,SECHDRCK INDICATE SECTION HEADER IS TO BE 06690002 * OUTPUTTED 06700002 BAL R14,DCBIO GO SET UP PARAMETER LIST FOR I/O 06710002 XR R2,R2 RESET OUTPUT COUNTER 06720002 CONTINUE DS 0H 06730002 XR R11,R11 CLEAR A REGISTER 06740002 IC R11,HDRCOUNT LOAD OFFSET TO PROPER INSTRUCTION 06750002 LA R7,D14(R11) POINT TO NEXT HEADER 06760002 STC R7,HDRCOUNT SET COUNTER FOR NEXT HEADER 06770002 LA R7,HDRTAB POINT TO TABLE 06780002 AR R7,R11 ADD OFFSET TO TABLE ADDRESS 06790002 L R10,OUTBUF POINT TO OUTPUT BUFFER 06800002 BR R7 GO MOVE HEADER TO OUTPUT BUFFER 06810002 HDRTAB DS 0H 06820002 MVC D4(L'HEADER1,R10),HEADER1 MOVE HEADER TO BUFFER 06830002 LA R14,L'HEADER1 STORE LENGTH 06840002 B HDRIO GO OUTPUT HEADER 06850002 MVC D4(L'HEADER2,R10),HEADER2 MOVE HEADER TO BUFFER 06860002 LA R14,L'HEADER2 STORE LENGTH 06870002 B HDRIO GO OUTPUT HEADER 06880002 MVC D4(L'HEADER3,R10),HEADER3 MOVE HEADER TO BUFFER 06890002 LA R14,L'HEADER3 STORE LENGTH 06900002 B HDRIO GO OUTPUT HEADER 06910002 MVC D4(L'HEADER4,R10),HEADER4 MOVE HEADER TO BUFFER 06920002 LA R14,L'HEADER4 STORE LENGTH 06930002 HDRIO DS 0H 06940002 LA R14,D4(R14) SET LENGTH OF OUTPUT 06950002 NI OUTPUTSW,HEXCF TURN OFF FIELD AND HEADER SWITCHES 06960002 STH R14,D0(R10) PUT LENGTH AT BEGINNING OF BUFFER 06970002 BAL R14,DCBIO GO PUT OUT THE HEADER 06980002 DDCHECK2 DS 0H 06990002 LA R11,DDNAM GET ADDRESS OF DCBDDNAM PDE 07000002 CR R6,R11 IS THIS DDNAM FIELD 07010002 BE TRNSLATE IF YES GO VALIDITY CHECK THE FIELD 07020002 EJECT 07030002 *********************************************************************** 07040002 * THE FOLLOWING CODE WILL SET UP CONVERSION AND OUTPUT OF REQUESTED * 07050002 * FIELDS. WHEN SECTION IS REACHED, RELATIVE ADDRESS, FIELD LENGTH * 07060002 * HEADER LENGTH, AND HEADER WILL BE IN THE COMMON BUFFERS. * 07070002 *********************************************************************** 07080002 SPACE 07090002 CVTANDIO DS 0H 07100002 XR R7,R7 07110002 XR R10,R10 07120002 SR R0,R0 ZERO OUT REGISTER 07130002 OI OUTPUTSW,HDRCHECK TURN ON FIELD HEADER SWITCH 07140002 IC R7,FLDLENTH LOAD FIELD LENGTH 07150002 ST R0,HDROFFST CLEAR OUT HDROFFST AND FLDOFFST 07160002 IC R10,HDRLENTH LOAD HEADER LENGTH 07170002 AR R7,R7 DOUBLE FOR TRUE PRINTABLE LENGTH 07180002 LR R0,R10 LOAD HEADER LENGTH 07190002 SR R0,R7 DIFFERENCE BETWEEN HEADER AND FIELD 07200002 LPR R0,R0 ASSURE THAT DIFFERENCE IS POSITIVE 07210002 SRL R0,D1 SHIFT TO DIVIDE BY TWO 07220002 CR R7,R10 WHICH IS LONGER 07230002 BH FLDLONGR IF FIELD IS LONGER, BRANCH 07240002 STH R0,FLDOFFST STORE IN WORK AREA 07250002 SR R0,R0 CLEAR OUT REGISTER 07260002 LR R7,R10 R7 NOW CONTAINS OUTPUT LENGTH 07270002 FLDLONGR DS 0H 07280002 STH R0,HDROFFST STORE IN WORK AREA 07290002 AR R7,R2 COMPUTE TENTATIVE OUTPUT LENGTH 07300002 CH R7,LINELEN IS FIELD LONGER THAN OUTPUT LINE 07310002 BNH MOREROOM BRANCH IF THE FIELD CAN FIT 07320002 L R11,OUTBUF OBTAIN ADDRESS OF OUTBUF 07330002 LA R10,D2(R2) ADD TWO BYTES TO LENGTH OF OUTPUT 07340002 STH R10,D0(R11) STORE LENGTH OF OUTPUT 07350002 BAL R14,DCBIO GO OUTPUT LINES 07360002 SR R7,R2 RESET LENGTH OF CURRENT FIELD 07370002 XR R2,R2 RESET LINE TO ZERO 07380002 OI OUTPUTSW,HDRCHECK TURN ON FIELD HEADER SWITCH 07390002 EJECT 07400002 *********************************************************************** 07410002 * THE FOLLOWING IS REACHED WHEN THERE IS MORE ROOM IN OUTPUT BUFFER * 07420002 * IT SETS UP FOR IKJEGCVT WHICH WILL CONVERT THE FIELD AND MOVE THE * 07430002 * HEADER AND FIELD TO THE PROPER BUFFERS. * 07440002 *********************************************************************** 07450002 MOREROOM DS 0H 07460002 SR R7,R2 07470002 MVI CVTLL,HEXZERO ZERO OUT 1ST BYTE OF LENGTH 07480002 MVC CVTLL+D1(L1),FLDLENTH MOVE LENGTH OF FIELD INTO 07490002 * PARAMETER LIST 07500002 ST R4,STRNGPTR STORE POINTER TO FIELD CONTENTS 07510002 MVI FLAGS,FLAG MOVE FLAG TO PARAMETER LIST 07520002 MVI TYPECODE,TYPE MOVE TYPE CODE (HEX) TO LIST 07530002 LNR R0,R7 INDICATE CONVERSION TO PRINTABLE 07540002 LA R1,STRNGPTR LOAD ADDRESS OF PARAMETER LIST 07550002 L R15,TSTCONVT LOAD ADDRESS OF IKJEGCVT 07560002 BALR R14,R15 GO CONVERT THE FIELD 07570002 LPR R0,R0 RESTORE REGISTER 0 TO POSITIVE 07580002 LTR R15,R15 IS RETURN CODE ZERO 07590002 BNZ SEVRET NO, GO HANDLE SERVICE ROUTINE CODE 07600002 L R10,OUTBUF YES, POINT TO OUTPUT BUFFER 07610002 LH R11,FLDOFFST 07620002 AR R11,R10 ADD IN OFFSET FOR FORMATTING 07630002 LA R11,D84(R11) POINT TO POSITION IN FIELD BUFFER 07640002 AR R11,R2 GET PROPER DISPLACEMENT INTO BUFFER 07650002 L R10,CONAREA POINT TO CONVERT OUTPUT AREA 07660002 XR R1,R1 CLEAR A REGISTER 07670002 IC R1,D0(R10) OBTAIN LENGTH OF DCB FIELD FROM 07680002 * FIRST BYTE OF CONVERTED AREA 07690002 BCTR R1,R0 TAKE ONE FROM LENGTH 07700002 EX R1,MOVE2 GO MOVE FIELD INTO BUFFER 07710002 LH R10,HDROFFST 07720002 L R11,OUTBUF GET ADDRESS OF OUTPUT BUFFER 07730002 AR R11,R10 07740002 LA R10,HDRBUFFR GET ADDRESS OF FIELD HEADER 07750002 AR R11,R2 GET PROPER DISPLACEMENT INTO BUFFER 07760002 XR R1,R1 CLEAR REGISTER 1 07770002 IC R1,HDRLENTH OBTAIN LENGTH OF DCB FIELD 07780002 BCTR R1,R0 TAKE ONE FROM LENGTH 07790002 EX R1,MOVE3 GO MOVE FIELD NAME INTO BUFFER 07800002 AR R2,R7 RESET OUTPUT CHARACTER COUNT 07810002 LA R2,D2(R2) 2 SPACES BETWEEN THIS AND NEXT FIELD 07820002 B PDECHK GO CHECK TO SEE IF THERE ARE MORE 07830002 * FIELDS TO BE OUTPUTTED 07840002 EJECT 07850002 *********************************************************************** 07860002 * THE FOLLOWING CODE SETS UP A PARAMETER LIST FOR IKJEGIO WHICH WILL * 07870002 * OUTPUT THE LINE(S). THIS CODE IS BRANCHED TO FROM CVTANDIO, DCBRET,* 07880002 * AND HDROUTPT. UPON ENTRY OUTBUF POINTS TO THE DATA TO BE OUTPUTTED.* 07890002 *********************************************************************** 07900002 SPACE 07910002 DCBIO DS 0H 07920002 STM R2,R3,DATAREGS SAVE PARM REGISTERS 07922002 L R1,OUTBUF POINT TO OUTPUT BUFFER 07930002 ST R1,OUTPTR1 STORE POINTER IN PARAMETER LIST 07940002 L R0,PRINTFLG SEND IKJEGIO POINTER TO DSNAME PDE 07950002 * THE FIRST TIME 07960002 LR R2,R1 TRANSFER ADDRESS OF OUTPUT LINE 07962002 LR R3,R0 TRANSFER ADDRESS OF DSNAME PDE 07964002 XR R1,R1 CLEAR A REGISTER 07970002 ST R1,PRINTFLG CLEAR PRINTFLG TO AVOID SENDING 07980002 * THE ADDRESS OF THE DSNAME PDE TO 07990002 * IKJEGIO MORE THAN ONCE 08000002 ST R14,REG14 SAVE CONTENTS OF REGISTER 14 08040002 XC TSTIOPRM,TSTIOPRM CLEAR I/O PARM LIST 08050002 IKJEGSIO DATA,DATAPTR=(R2),DSNAME=(R3),ID=DCB10, *08052002 MF=(E,TSTIOPRM) CALL I/O TO SEND OUT DATA 08054002 LM R2,R3,DATAREGS RESTORE DATA PARM REGS 08056002 LTR R15,R15 RETURN CODE FROM IO A ZERO 08060002 BZ CLEARBUF YES, GO CLEAR BUFFERS 08070002 B SEVRET NO, GO HANDLE SERVICE ROUTINE CODES 08080002 CLEARBUF DS 0H 08090002 L R10,OUTBUF GET ADDRESS OF OUTPUT BUFFER 08100002 MVI D4(R10),BLANK CLEAR OUTPUT AREA 08110002 MVC D5(L79,R10),D4(R10) 08120002 L R14,REG14 RESTORE CONTENTS OF REGISTER 14 08130002 TM OUTPUTSW,FLDCHECK WAS A FIELD JUST PUT OUT 08140002 BZ FURTHCHK NO, GO CHECK FOR FIELD HEADER 08150002 NI OUTPUTSW,HEXEF YES, TURN OFF FIELD SWITCH 08160002 TM OUTPUTSW,SECHDRCK IS SECTION HEADER TO BE OUTPUTTED 08170002 BZ BRANCH1 NO, CONTINUE PROCESSING 08180002 NI OUTPUTSW,HEXBF YES, TURN OFF SECTION HEADER SWITCH 08190002 XC D0(L4,R10),D0(R10) CLEAR FIRST FOUR BYTES OF OUTBUF 08200002 * TO INDICATE A LINE SHOULD BE SKIPPED 08210002 B DCBIO GO BACK TO I/O ROUTINE 08220002 BRANCH1 DS 0H 08230002 BR R14 RETURN TO CALLING ROUTINE 08240002 FURTHCHK DS 0H 08250002 TM OUTPUTSW,HDRCHECK WAS A FIELD HEADER JUST PUT OUT 08260002 BZ BRANCH1 NO, BRANCH TO RETURN TO CALLER 08270002 NI OUTPUTSW,HEXDF YES, TURN OFF FIELD HEADER SWITCH 08280002 L R11,OUTBUF GET ADDRESS OF OUTPUT BUFFER 08290002 LA R10,D84(R11) POINT TO FIELD BUFFER 08300002 LR R1,R2 GET LENGTH OF DATA TO BE OUTPUTTED 08310002 BCTR R1,R0 TAKE ONE FROM LENGTH 08320002 EX R1,MOVE3 MOVE FIELD DATA INTO OUTPUT BUFFER 08330002 OI OUTPUTSW,FLDCHECK INDICATE FIELD DATA TO BE OUTPUTTED 08340002 MVI D0(R10),BLANK CLEAR WORK BUFFER 08350002 MVC D1(L79,R10),D0(R10) 08360002 B DCBIO GO TO I/O ROUTINE 08370002 EJECT 08380002 *********************************************************************** 08390002 * THE FOLLOWING CODE SCANS THE DDNAME FIELD AND CONVERTS THE FIELD TO * 08400002 * PRINTABLES. A NON PRINTABLE IS CONVERTED TO A PERIOD. ACCEPTED * 08410002 * CHARACTERS ARE ALL OF THE ALPHANUMERIC, NATIONAL, THE QUOTE SIGN, * 08420002 * AND BLANKS. * 08430002 *********************************************************************** 08440002 TRNSLATE DS 0H 08450002 MVC DDNAMBUF(L8),D0(R4) COPY DDNAME INTO WORKAREA 08460002 TR DDNAMBUF(L8),TRTABLE TRANSLATE DDNAM TO PRINTABLES 08470002 LA R10,L8 LOAD LENGTH OF DDNAME 08480002 AR R10,R2 ADD PREVIOUS OUTPUT LENGTH 08490002 CH R10,LINELEN DOES DDNAM FIT IN OUTPUT LINE 08500002 BH NOFIT BRANCH IF NOT ENOUGH ROOM 08510002 B MOVEIT GO PUT DDNAME FIELD IN WORK BUFFER 08520002 NOFIT DS 0H 08530002 BAL R14,DCBIO OUTPUT FIELDS AND HEADERS 08540002 XR R2,R2 08550002 MOVEIT DS 0H 08560002 L R11,OUTBUF POINT TO OUTPUT BUFFER 08570002 AR R11,R2 08580002 LA R10,D84(R11) POINT TO FIELD BUFFER 08590002 OI OUTPUTSW,HDRCHECK TURN ON FIELD HEADER SWITCH 08600002 MVC D4(L'HDRDDNAM,R11),HDRBUFFR MOVE HEADING INTO I/O BUFFER 08610002 MVC D0(L8,R10),DDNAMBUF MOVE DDNAME TO FIELD BUFFER 08620002 * FROM DCB 08630002 LA R2,D10(R2) RESET LINE LENGTH 08640002 B PDECHK GO CHECK NEXT PDE 08650002 EJECT 08660002 DCBRC16 DS 0H 08670002 LA R15,RET16 SET RETURN CODE TO 16 (ATTENTION) 08680002 B EXITNOW RETURN TO IKJEGMNL 08690002 FIELDMSG DS 0H 08700002 LA R4,M0015 GET MESSAGE NUMBER INTO PARM REG 08710002 MSGERR DS 0H 08720002 XC TSTIOPRM,TSTIOPRM CLEAR PARM LIST FOR I/O CALL 08730002 IKJEGSIO MSG,FIRST=(R4),ID=DCB10,MF=(E,TSTIOPRM) CALL I/O 08732002 B RETTAB(R15) BRANCH INTO BRANCH RTN TABLE 08734002 DCBRET0 DS 0H 08830002 LA R15,RETCOD0 SET RETURN CODE FOR IKJEGMNL TO 0 08840002 RETURN DS 0H 08850002 CLC REG14,WORDZERO DID IKJEGDCB CALL IKJEGIO 08860002 BE FIELDMSG NO, GO WRITE MESSAGE 08870002 EXITNOW DS 0H 08880002 NI TSTFLGS1,(HEXFF-TSTPRINT) TURN OFF OUTPUT FLAG 08890002 LR R2,R15 SAVE RETURN CODE 08890102 * IN TCOMTAB 08890402 ESTAE 0,OV REMOVE THE ESTAE 08892002 NI TSTFLGS4,HEXFF-TSTRERTN IF THE RETRY SWITCH ON, TURN OFF 08894002 L R13,D4(R13) RESTORE REGISTER 13 08910002 LR R15,R2 RESTORE RETURN CODE 08912002 RETURN (14,12),T,RC=(15) RETURN TO IKJEGMNL 08920002 FLUSHIT DS 0H 08930002 OI TSTFLGS4,TSTFLUSH INDICATE TO IKJEGMNL TO FLUSH STACK 08940002 RETURN0 DS 0H 08950002 XR R15,R15 SET RETURN CODE TO ZERO 08960002 B EXITNOW RETURN TO IKJEGMNL 08970002 CHKRET DS 0H 08980002 L R15,REG15 PUT SAVED RETURN CODE INTO REG 15 08990002 SEVRET DS 0H 09000002 B RETTAB(R15) GO THRU FOLLOWING TABLE INDEXED BY 09010002 * CONTENTS OF REGISTER 15 09020002 RETTAB DS 0H 09030002 B RETURN0 0-FROM SERVICE ROUTINE-RETURN-0 09040002 B RETURN0 4-FROM SERVICE ROUTINE-RETURN-0 09050002 B RETURN0 8-FROM SERVICE ROUTINE-RETURN-0 09060002 B RETURN0 12-FROM SERVICE ROUTINE RETURN-0 09070002 B EXITNOW 16-FROM SERVICE ROUTINE-RETURN 16 09080002 B EXITNOW 20-FROM SERVICE ROUTINE-RETURN 20 09090002 B EXITNOW 24-FROM SERVICE ROUTINE-RETURN 24 09092002 PDLEND DS 0H 09100002 LTR R2,R2 IS THERE ANY MORE OUTPUT 09110002 BZ DCBRET0 IF NO, BRANCH 09120002 LA R2,D2(R2) ADD 2 BYTES TO OUTPUT LENGTH 09130002 L R10,OUTBUF GET ADDRESS OF OUTPUT BUFFER 09140002 STH R2,D0(R10) STORE LENGTH OF OUTPUT IN BUFFER 09150002 BAL R14,DCBIO GO OUTPUT HEADERS AND FIELDS 09160002 B DCBRET0 RETURN TO IKJEGMNL 09170002 EJECT 09180002 ********************************************************************** 09190002 * STAE RETRY ROUTINE * 09200002 ********************************************************************** 09210002 STAERTN DS 0H 09220002 L R6,CVTPTR GET CVT ADDRESS 09240002 USING CVT,R6 ESTABLISH ADDRESSABILITY TO CVT 09250002 L R6,CVTTCBP GET ADDRESS OF TCB WORDS 09260002 L R6,D4(R6) GET ADDRESS OF CURRENT TCB 09270002 DROP R6 DROP ADDRESSABLITY TO CVT 09280002 USING TCB,R6 ESTABLISH ADDRESSABILITY TO TCB 09290002 L R9,TCBTRN PICK UP POINTER TO TCOMTAB FROM 09300002 * TCBTRN FIELD OF TEST'S TCB 09310002 OI TSTFLGS4,TSTRERTN TURN ON THE RETRY IN PROCESS SWITCH 09312002 L R13,REGSAVE2 GET ADDR OF LISTDCB'S REGISTERS 09320002 L R12,D68(R13) RESET BASE REGISTER 09330002 LA R15,RETCOD20 INDICATE STAE EXIT RTN ENTERED 09380002 B EXITNOW GO BACK TO IKJEGMNL 09390002 EJECT 09400002 IKJEGSPL IKJEGSPL RTRY=STAERTN,ABNTB=STATBL,MODNM=IKJEGDCB,TNM=LISTDCB 09400402 ZZZZZZZZ DC 52C'Z' TO BE USED FOR MAINTENANCE 09402002 TRTABLE DS 0H 09410002 DC 256CL1'.' INITIALIZE TO 256 PERIODS 09420002 ORG TRTABLE+(C'A') GO TO POSITION +193 IN TABLE 09430002 DC C'ABCDEFGHI' FIRST THIRD OF ALPHABET 09440002 ORG TRTABLE+(C'J') GO TO POSITION +209 IN TABLE 09450002 DC C'JKLMNOPQR' SECOND THIRD OF ALPHABET 09460002 ORG TRTABLE+(C'S') GO TO POSITION +226 IN TABLE 09470002 DC C'STUBWXYZ' THIRD THIRD OF ALPHABET 09480002 ORG TRTABLE+(C'0') GO TO POSITION +240 IN TABLE 09490002 DC C'0123456789' ACCEPT NUMBERS 09500002 ORG TRTABLE+(C'''') GO TO POSITION +125 IN TABLE 09510002 DC C'''' ACCEPT QUOTES 09520002 ORG TRTABLE+(C'=') GO TO POSITION +126 IN TABLE 09530002 DC C'=' ACCEPT EQUAL MARKS 09540002 ORG TRTABLE+(C'$') GO TO POSITION +91 IN TABLE 09550002 DC C'$' ACCEPT DOLLAR SIGN 09560002 ORG TRTABLE+(C' ') GO TO POSITION +64 IN TABLE 09570002 DC C' ' ACCEPT BLANK 09580002 ORG TRTABLE+256 GO TO END OF TABLE 09590002 SPACE 09600002 HDRRELAD DC C'RELAD' FIELD HEADER IN DEVICE INTERFACE SEG 09610002 HDRKEYCN DC C'KEYCN' FIELD HEADER IN DEVICE INTERFACE SEG 09620002 HDRFDAD DC C'FDAD' FIELD HEADER IN DEVICE INTERFACE SEG 09630002 HDRDVTBL DC C'DVTBL' FIELD HEADER IN DEVICE INTERFACE SEG 09640002 HDRKEYLE DC C'KEYLE' FIELD HEADER IN DEVICE INTERFACE SEG 09650002 HDRDEVT DC C'DEVT' FIELD HEADER IN DEVICE INTERFACE SEG 09660002 HDRTRBAL DC C'TRBAL' FIELD HEADER IN DEVICE INTERFACE SEG 09670002 HDRBUFNO DC C'BUFNO' FIELD HEADER IN COMMON INTERFACE 09680002 HDRBUFCB DC C'BUFCB' FIELD HEADER IN COMMON INTERFACE 09690002 HDRBUFL DC C'BUFL' FIELD HEADER IN COMMON INTERFACE 09700002 HDRDSORG DC C'DSORG' FIELD HEADER IN COMMON INTERFACE 09710002 HDRIOBAD DC C'IOBAD' FIELD HEADER IN COMMON INTERFACE 09720002 HDRHIARC DC C'HIARC-BFTEK-BFALN' TRI HEADERS IN FOUNDATION EXTENSION 09730002 HDRBFTEK DC C'BFTEK-HIARC-BFALN' TRI HEADERS IN FOUNDATION EXTENSION 09740002 HDRBFALN DC C'BFALN-HIARC-BFTEK' TRI HEADERS IN FOUNDATION EXTENSION 09750002 HDREODAD DC C'EODAD' FIELD HEADER IN FOUNDATION EXTENSION 09760002 HDRRECFM DC C'RECFM' FIELD HEADER IN FOUNDATION EXTENSION 09770002 HDREXLST DC C'EXLST' FIELD HEADER IN FOUNDATION EXTENSION 09780002 HDRDDNAM DC C'DDNAM' FIELD HEADER IN CLOSED FOUNDATION 09790002 HDROFLGS DC C'OFLGS' FIELD HEADER IN CLOSED FOUNDATION 09800002 HDRIFLG DC C'IFLG' FIELD HEADER IN CLOSED FOUNDATION 09810002 HDRMACR DC C'MACR' FIELD HEADER IN CLOSED FOUNDATION 09820002 HDRTIOT DC C'TIOT' FIELD HEADER IN OPEN FOUNDATION 09830002 HDRMACRF DC C'MACRF' FIELD HEADER IN OPEN FOUNDATION 09840002 HDRIFLGS DC C'IFLGS' FIELD HEADER IN OPEN FOUNDATION 09850002 HDRDEBAD DC C'DEBAD' FIELD HEADER IN OPEN FOUNDATION 09860002 HEADER1 DC C'DEVICE INTERFACE SEGMENT' DCB SECTION HEADER 09870002 HEADER2 DC C'COMMON INTERFACE' DCB SECTION HEADER 09880002 HEADER3 DC C'FOUNDATION EXTENSION' DCB SECTION HEADER 09890002 HEADER4 DC C'FOUNDATION' DCB SECTION HEADER 09900002 WORDZERO DC X'00000000' WORD OF ZEROES 09910002 HEXFFFF DC X'FFFF' USED TO TURN ON PDES DESCRIBING THE 09920002 * DCB FIELDS 09930002 PCLADDR DC V(IKJEGPCL) ADDRESS OF PARAMETER CONTROL LIST 09950002 * FOR IKJPARS 09960002 RETRYADR DC AL3(STAERTN) ADDR OF STAE EXIT ROUTINE 09970002 ** THE FOLLOWING IS THE STAE MESSAGE TABLE ** 09980002 STATBL DS 0F 09990002 DC AL1(INST99),AL3(PARSBLOW) PARSE LINK FAILED 10000002 DC AL1(HEXFF) END OF STATE ABEND TABLE 10010002 MOVE2 MVC D0(L0,R11),D1(R10) MOVE FIELD INTO BUFFER 10020002 MOVE3 MVC D4(L0,R11),D0(R10) MOVE FIELD HEADER OR DATA INTO BUFFER 10030002 STAEL DS 0F 10040002 STAELIST ESTAE STAELIST,MF=L LIST FORM OF STAE MACRO 10050002 STAELEN EQU *-STAELIST LENGTH OF STAE LIST FORM 10060002 EJECT 10730002 IKJEGPCL IKJPARM 10740002 ADDRESS IKJPOSIT ADDRESS,VALIDCK=IKJEGDVK,PROMPT='ADDRESS OF DCB' 10750002 PRINT IKJKEYWD 10760002 IKJNAME 'PRINT',SUBFLD=DSNAME 10770002 DCBFIELD IKJKEYWD 10780002 IKJNAME 'FIELD',SUBFLD=FIELDNAM 10790002 DSNAME IKJSUBF 10800002 DSNAM IKJPOSIT DSNAME,PROMPT='DSNAME' 10810002 FIELDNAM IKJSUBF 10820002 RELAD IKJKEYWD 10830002 IKJNAME 'DCBRELAD' 10840002 KEYCN IKJKEYWD 10850002 IKJNAME 'DCBKEYCN' 10860002 FDAD IKJKEYWD 10870002 IKJNAME 'DCBFDAD' 10880002 DVTBL IKJKEYWD 10890002 IKJNAME 'DCBDVTBL' 10900002 KEYLE IKJKEYWD 10910002 IKJNAME 'DCBKEYLE' 10920002 DEVT IKJKEYWD 10930002 IKJNAME 'DCBDEVT' 10940002 TRBAL IKJKEYWD 10950002 IKJNAME 'DCBTRBAL' 10960002 BUFNO IKJKEYWD 10970002 IKJNAME 'DCBBUFNO' 10980002 BUFCB IKJKEYWD 10990002 IKJNAME 'DCBBUFCB' 11000002 BUFL IKJKEYWD 11010002 IKJNAME 'DCBBUFL' 11020002 DSORG IKJKEYWD 11030002 IKJNAME 'DCBDSORG' 11040002 IOBAD IKJKEYWD 11050002 IKJNAME 'DCBIOBAD' 11060002 HIARC IKJKEYWD 11070002 IKJNAME 'DCBHIARC' 11080002 FTEK IKJKEYWD 11090002 IKJNAME 'DCBBFTEK' 11100002 BFALN IKJKEYWD 11110002 IKJNAME 'DCBBFALN' 11120002 EODAD IKJKEYWD 11130002 IKJNAME 'DCBEODAD' 11140002 RECFM IKJKEYWD 11150002 IKJNAME 'DCBRECFM' 11160002 EXLST IKJKEYWD 11170002 IKJNAME 'DCBEXLST' 11180002 DDNAM IKJKEYWD 11190002 IKJNAME 'DCBDDNAM' 11200002 OFLGS IKJKEYWD 11210002 IKJNAME 'DCBOFLGS' 11220002 IFLG IKJKEYWD 11230002 IKJNAME 'DCBIFLG' 11240002 MACR IKJKEYWD 11250002 IKJNAME 'DCBMACR' 11260002 TIOT IKJKEYWD 11270002 IKJNAME 'DCBTIOT' 11280002 MACRF IKJKEYWD 11290002 IKJNAME 'DCBMACRF' 11300002 IFLGS IKJKEYWD 11310002 IKJNAME 'DCBIFLGS' 11320002 DEBAD IKJKEYWD 11330002 IKJNAME 'DCBDEBAD' 11340002 OFLGS2 IKJKEYWD 11350002 IKJNAME 'DCBOFLG2' 11360002 IKJENDP 11370002 EJECT 11380002 IKJPARMA 11390002 EJECT 11400002 IKJPPL 11410002 EJECT 11420002 CVT DSECT 11430002 CVT 11440002 EJECT 11450002 IKJTCB 11460002 EJECT 11470002 TCOMTAB 11480002 EJECT 11490002 TSTCWORK 11500002 EJECT 11510002 DCBD DSORG=PS,DEVD=DA 11520002 EJECT 11530002 DCBWKARA DSECT 11540002 PPLLIST DS 7F PARSE PARAMETER LIST DESCRIBED IN IKJPPL 11550002 * MACRO 11560002 HDRBUFFR DS 5F BUFFER FOR ONE FIELD HEADER 11570002 PRINTFLG DS F ADDRESS OF DSNAME PDE FOR IKJEGIO 11580002 ENDEND DS F ADDRESS OF LAST FIELD PDE + 2 11590002 DDNAMBUF DS 2F BUFFER FOR DDNAM FIELD 11600002 OUTPTR1 DS F FIRST OUTPUT POINTER FOR IKJEGIO 11610002 OUTPTR2 DS F SECOND OUTPUT POINTER FOR IKJEGIO 11620002 ** THE FOLLOWING FIELD IS INITIALIZED IN THE DCBIO ROUTINE. BEFORE ** 11630002 ** RETURNING TO IKJEGMNL THIS FIELD IS CHECKED FOR A 0 INDICATING ** 11640002 ** IKJEGIO WAS NOT CALLED TO OUTPUT A FIELD. ** 11650002 REG14 DS F REGISTER 14 SAVEAREA 11660002 REG15 DS F RETURN CODE SAVEAREA 11670002 HDROFFST DS CL2 OFFSET FOR FORMATTING 11680002 FLDOFFST DS CL2 OFFSET FOR FORMATTING 11690002 HDRLENTH DS CL1 LENGTH OF PRECEDING FIELD HEADER 11700002 FLDLENTH DS CL1 LENGTH OF DCB FIELD 11710002 OUTPUTSW DS CL1 OUTPUT FLAGS 11720002 HDRCOUNT DS CL1 NUMBER OF SECTION HEADERS ALREADY OUT 11730002 ** THE FOLLOWING FOUR FIELDS MAKE UP THE PARAMETER LIST FOR IKJEGCVT ** 11740002 STRNGPTR DS F POINTER TO FIELD TO BE CONVERTED 11750002 CVTLL DS CL2 LENGTH OF FIELD TO BE CONVERTED 11760002 FLAGS DS CL1 FLAG FOR IKJEGCVT 11770002 TYPECODE DS CL1 TYPE OF INPUT DATA TO IKJEGCVT (HEX) 11780002 LINELEN DS H OUTPUT LINE LENGTH 11790002 STAEL2 DS 0F 11800002 STAEAREA DS 3F WORKAREA FOR STAE 11810002 DATAREGS DS 2F WORK REGISTER SAVE ON DATA I/O CALL 11812002 END 11820002