MACRO 00020000 SGIKJ0E2 &DST=,&SUBFD= 00040000 .* THIS SYSGEN MACRO IS USED TO GENERATED ALL DATA SET TYPES TO A45714 00060000 .* BE RECOGNIZED BY THE EDIT COMMAND PROCESSOR, AND TO BUILD A A45714 00080000 .* SUBFIELD FOR ANY DATA SET TYPE REQUIRING ONE. THIS MACRO A45714 00100000 .* PERFORMS THIS FUNCTION BY GENERATING THE PROPER IKJPARS A45714 00120000 .* MACROS FOR ALL THE DATA SET TYPES PASSED BY THE 'DST' A45714 00140000 .* PARAMETER. A45714 00160000 LCLA &I,&J,&K A45714 00180000 LCLB &SW A45714 00200000 .*A013300,321500-321597,352900,394700-394720,467700,470700 A45713 00220000 .*A477900-480713,480792,486500-494784,501500-502392 A45713 00240000 .*A704700-704797,749500-749597,750100,781700 A45713 00260000 .*A781740-781780,787520-787540 A45713 00280000 .*C013000-013200,467200-467600,480772,480829,481800,482400 A45713 00300000 .*C483800,485200,485600,496000,496600 A45713 00320000 .*D477600-479800,482600-483200,486200-494600,499400-499600 A45713 00340000 .*D500600-501200,501600-502200 A45713 00360000 .*A000300-000557,070100,070300,403100-405740,409100-412329 A45714 00380000 .*A421300-421380,503120-503969,578700-585900,587300,592300 A45714 00400000 .*A727300,731300-732376,759500,781724,781784-781926 A45714 00420000 .*C069800,579000-579200,706200,707000,711000,728600,729600 A45714 00440000 .*D402600-405600,408800-411600,502800-503000 A45714 00460000 .*A412600-412800 A50467 00466000 .*D412600-412800 A50467 00472000 .*A139000-141188,141300-141520,281820-282000,370010-370040 YA00002 00472200 .*A370810-370820 YA00002 00472400 .*C141800,292800,328400 YA00002 00472600 .*D139000-141000,141400,282000-284200 YA00002 00472800 .*A511200 YA00871 00474000 .*C511000 YA00871 00476000 .*D510200-510600 YA00871 00478000 .*A744000-744392 SM5064 00478100 .*D744000 SM5064 00478200 .*A092900-093197,521900-522197,580500-580599 Y02676 00478600 .*C007400-008000,423400-423600,427200,530800,534400 Y02676 00478700 .*D092600-093000,521600-522000,580200-580400 Y02676 00478800 .*A267405-267450,272605-272625,274005-274010,275005 Y01676 00481200 .*A334001-334010 Y01676 00484200 .*D267600-270000,274200-274400 Y01676 00487200 .*C409200 @YA01909 00490200 .*A023700,,077500-077666,136900-136984 @YA02225 00490800 .*D732810 @YM04732 00491200 .*A280900-280984,292100-292184,326900-326984,354700-354760 @YA02225 00491400 .*A510500-510784,591700-591740 @YA02225 00492000 .*D077600-078000,137000-137200,281000-281200,292200-292400 @YA02225 00492600 .*D327000-327200,354800-355000,510800-511200,591800-592000 @YA02225 00493200 .*C431920,432600 @Y30NQKK 00496200 .*A249420-249870,363850-363900,822430-822530,822700 @ZA05823 00496700 .*A828010,030010,415410-415430 @ZA05823 00497200 .*C250600,238200-238800 @ZA05823 00497700 .*D240200-249200,257400,239000 00498200 .* ABEND 0C9 ON 3350 DEVICE @ZA13889 00498700 .* LAST BLOCK OVERHEAD ERROR @ZA25135 00499200 .* INITIALIZE TO NUMBER OF DATA SET TYPES PASSED. A45714 00500000 &I SETA N'&DST A45714 00510000 .* INITIALIZE LOOP CONTROL INDEX FOR 'DST' PARAMETER. A45714 00520000 &J SETA 1 A45714 00540000 .* INITIALIZE INDEX FOR USER DATA SET TYPES. A45714 00560000 &K SETA 1 A45714 00580000 .* INITIALIZE SWITCH TO INDICATED IF SUBFIELD REQUIRED. A45714 00600000 &SW SETB 0 A45714 00620000 .* CHECK IF ANY DSTYPES PASSED, IF NOT, ERROR HAS OCCURRED A45714 00640000 AIF (&I GT 0).TAG0 A45714 00660000 MNOTE 8,'DATA SET TYPE PARAMETERS MISSING.' A45714 00680000 MEXIT A45714 00700000 .TAG0 ANOP A45714 00720000 .* CHECK FOR TOO MANY DATA SET TYPES - INDEX 'I' GT 26. Y02676 00740000 AIF (&I LE 26).TAGX1 Y02676 00760000 .* PROCESS ONLY FIRST 26 - SET INDEX 'I' TO 26. Y02676 00780000 &I SETA 26 Y02676 00800000 .* CHECK IF ANY TRAILING 'DST' ENTRIES ARE NULL. A45714 00820000 .TAGX1 AIF ('&DST(&I)' NE '').OUTX1 A45714 00840000 .* IF NULL, DECREMENT INDEX 'I' TO NEXT ENTRY. A45714 00860000 &I SETA &I-1 A45714 00880000 AGO .TAGX1 A45714 00900000 .* INDEX 'I' EQUALS NO. OF NON-NULL 'DST' ENTRIES. A45714 00920000 .OUTX1 ANOP A45714 00940000 BEIN TITLE 'IKJEBEIN - INITIALIZATION MODULE - EDIT CP TSO/360' 00960000 IKJEBEIN CSECT 00980000 *A 327000,327600 A42958 01000000 *C 327400 A42958 01020000 *A 264200-265600 A42947 01040000 *C 399400-400400 A42959 01060000 *C117800,118000 ZA28057 01065000 *A194600,259630-259750 ZA32095 01067000 *A643700 ZA32148 01070000 *C204800,205200,265800,266200 ZA33984 01075000 * D674600-675000,675400-676000 @OZ32315 01077000 *C217800 SEQ DATASETS AS PO OZ37857 01078000 *C670600,A670700 @ZA57015 01079000 *A342606-342792 CLEAN UP AFTER LOCATE RC 12 @ZA73615 01079500 *A342752,A342754,A370803,A370806 LOOP MSGIKJ52313I @ZA77969 01079700 * 01081700 * OZ85473 -- REPLACE CALCULATIONS FOR NUMBER OF BLOCKS ON 01083700 * ONE TRACK OF A DEVICE WITH THE TRKCALC MACRO @ZA85473 01085700 * 01087700 * OZ85402 -- DISPOSITION OF KEEP,KEEP WAS REMOVED FROM THE DAIR 08 01089700 * AND 18 REQUEST BLOCKS SO THAT THE DISP OF THE EDITTED 01091700 * DATASET WOULD REMAIN UNCHANGED @ZA85402 01093700 * 01095700 * OZ86100 -- MSGIKJ52309I WHEN EDITING AN EXISTING BUT EMPTY PDS 01096200 * @ZA86100 01096700 * 01097200 ENTRY IKJEBEIN 01097700 ENTRY IKJEBIN0 01100000 *********************************************************************** 01120000 * MODULE NAME -- IKJEBEIN * 01122000 * * 01124000 * DESCRIPTIVE NAME -- EDIT INITIALIZATION * 01126000 * * 01128000 * COPYRIGHT -- N/A * 01130000 * * 01132000 * CHANGE ACTIVITY -- SEE INFORMATION PRECEDING PROLOGUE * 01134000 * * 01140000 * STATUS -- VERSION NO. 02, VS/2 RELEASE 3 PTF UZ03371 @ZA08735* 01160000 * PTF UZ04307 @ZA10761* 01165000 * ABEND 0C9 ON 3350 DATA SETS @ZA13889* 01170000 * * 01180000 * FUNCTION -- THIS ROUTINE IS ATTACHED BY THE TERMINAL MONITOR * 01200000 * PROGRAM (TMP) WHENEVER THE USER ENTERS THE EDIT COMMAND. * 01220000 * IKJEBEIN ISSUES A GETMAIN MACRO INSTRUCTION FOR THE EDIT * 01240000 * COMMUNICATION AREA, SCANS THE COMMAND BUFFER USING IKJPARS, AND * 01260000 * INITIALIZES THE COMMUNICATION AREA TO CONTAIN VALUES * 01280000 * REPRESENTING OPERANDS ON THE EDIT COMMAND. IF THE USER SPECIFIES* 01300000 * THAT THE DATA SET IS OLD, IKJEBEIN ALLOCATES IT USING IKJDAIR * 01320000 * AND VERIFIES THAT ITS ATTRIBUTES ARE CONSISTENT WITH THE OTHER * 01340000 * OPERANDS SPECIFIED ON THE COMMAND. WHEN IKJEBEIN COMPLETES * 01360000 * SUCCESSFULLY, CONTROL IS PASSED TO THE EDIT MAIN CONTROLLER, * 01380000 * IKJEBEMA, VIA AN XCTL MACRO INSTRUCTION. * 01400000 * * 01420000 * ENTRY POINTS -- * 01440000 * IKJEBEIN - AFTER BEING ATTACHED BY THE TMP WHEN THE EDIT * 01460000 * COMMAND IS ENTERED AT THE TERMINAL. * 01480000 * * 01500000 * INPUT -- * 01520000 * REGISTER ONE (1) CONTAINS A POINTER TO THE COMMAND PROCESSOR * 01540000 * PARAMETER LIST (CPPL). * 01560000 * * 01580000 * OUTPUT -- * 01600000 * REGISTER FIFTEEN (15) CONTAINS A RETURN CODE INDICATING WHETHER * 01620000 * EDIT COMPLETED SUCCESSFULLY OR NOT. RETURN CODES ARE -- * 01640000 * * 01660000 * 00 - SUCCESSFUL COMPLETION. * 01680000 * 12 - UNSUCCESSFUL COMPLETION. * 01700000 * * 01720000 * EXTERNAL REFERENCES -- * 01740000 * IKJDAIR - SERVICE ROUTINE USED TO DYNAMICALLY ALLOCATE * 01760000 * THE EDIT DATA SET * 01780000 * IKJEBECO - INITIAL COPY ROUTINE - INVOKED TO COPY AN OLD * 01800000 * DATA SET TO THE UTILITY DATA SET * 01820000 * IKJEBEMS - MESSAGE SELECTION ROUTINE LOADED BY * 01840000 * THIS ROUTINE * 01860000 * IKJEBEPS - PROCESSOR TABLE SEARCH ROUTINE LOADED BY * 01880000 * THIS ROUTINE * 01900000 * IKJEBEUI - UTILITY INITIALIZATION ROUTINE - USED TO * 01920000 * INITIALIZE THE EDIT ACCESS METHOD WHEN THE USER * 01940000 * HAS SPECIFIED A NEW DATA SET * 01960000 * IKJEBEUT - UTILITY INTERFACE ROUTINE - LOADED BY THIS * 01980000 * ROUTINE PRIOR TO THE COPY OF THE EDIT DATA SET * 02000000 * AND DELETED WHEN THE COPY IS COMPLETE * 02020000 * IKJEBIN1 - EDIT COMMAND PCL (PARAMETER CONTROL LIST) * 02040000 * IKJEBIN2 - PCL FOR NEW/OLD PROMPT * 02060000 * IKJEBIN3 - INITIAL MESSAGE PROCESSING ROUTINE * 02080000 * IKJEBIN4 - IKJPARS NUMERIC SUBFIELD VALIDITY CHECK EXIT * 02100000 * IKJEBIN5 - DATA SET TYPE PROMPTING ROUTINE * 02120000 * IKJEBIN7 - PARTIALLY QUALIFIED DSNAME PROCESSING ROUTINE * 02140000 * IKJEBIN8 - OPERAND VALIDITY CHECKING AND CONVERSION * 02160000 * ROUTINE * 02180000 * IKJPARS - SERVICE ROUTINE USED TO SYNTAX CHECK THE EDIT * 02200000 * COMMAND AND RESPONSES TO NEW/OLD PROMPT A45713 02220000 * IKJPTGT - SERVICE ROUTINE USED TO PROMPT FOR DATA SET A45713 02240000 * TYPE A45713 02260000 * * 02280000 * MACROS USED -- * 02300000 * * 02320000 * BLDL - BUILD LIST OF DIRECTORY INFORMATION * 02340000 * CALL - PASS CONTROL TO LOADED PROGRAM * 02360000 * CALLTSSR - INVOKE SERVICE ROUTINES @YA02225* 02370000 * CAMLST - BUILD CONTROL LIST FOR OBTAIN MACRO INSTRUCTION * 02380000 * CVT - DEFINE THE COMMUNICATIONS VECTOR TABLE (CVT) * 02400000 * DCBD - DEFINE THE DATA CONTROL BLOCK (DCB) * 02420000 * DELETE - DELETE COPY OF LOADED PROGRAM FROM MAIN STORAGE * 02440000 * DEVTYPE - OBTAIN DEVICE DEPENDENT INFORMATION * 02460000 * FREEMAIN - FREE CORE OBTAINED VIA GETMAIN MACRO INSTRUCTION * 02470000 * GETMAIN - GET CORE FOR EDIT COMMUNICATION AREA * 02500000 * IECSDSL1 - DEFINE THE DATA SET CONTROL BLOCK (DSCB) FORMAT 1* 02520000 * IEFUCBOB - DEFINE THE UNIT CONTROL BLOCK (UCB) * 02540000 * IEFTIOT1 - DEFINE THE TASK INPUT/OUTPUT TABLE (TIOT) * 02560000 * IKJCPPL - DEFINE THE COMMAND PROCESSOR PARAMETER * 02580000 * LIST (CPPL) * 02600000 * IKJDFPL - DEFINE THE DEFAULT SERVICE ROUTINE PARAMETER LIST* 02620000 * IKJDFPB - DEFINE THE DEFAULT SERVICE ROUTINE PARAMETER * 02640000 * BLOCK * 02660000 * IKJEBECA - DEFINE EDIT COMMUNICATION AREA * 02680000 * IKJEBESH - PASS CONTROL TO EDIT SERVICE ROUTINES * 02700000 * IKJECT - DEFINE THE ENVIRONMENT CONTROL TABLE (ECT) * 02720000 * IKJENDP - END IKJPARS PCL * 02740000 * IKJIDENT - DEFINE POSITIONAL OPERAND TO IKJPARS * 02760000 * IKJKEYWD - DEFINE KEYWORD OPERAND TO IKJPARS * 02780000 * IKJNAME - DEFINE VALID KEYWORDS FOR KEYWORD OPERAND * 02800000 * TO IKJPARS * 02820000 * IKJPARM - BEGIN IKJPARS PCL * 02840000 * IKJPOSIT - DEFINE POSITIONAL OPERAND TO IKJPARS * 02860000 * IKJPPL - DEFINE THE IKJPARS PARAMETER LIST (PPL) * 02880000 * IKJPSCB - DEFINE THE PROTECTED STEP CONTROL BLOCK (PSCB) * 02900000 * IKJRLSA - RELEASE IKJPARS PDL * 02920000 * IKJSUBF - DEFINE SUBFIELD OF AN OPERAND TO IKJPARS * 02940000 * IKJTCB - DEFINE THE TASK CONTROL BLOCK (TCB) * 02960000 * LINK - LOAD AND PASS CONTROL TO EXTERNAL PROGRAM * 02980000 * LOAD - LOAD PROGRAM INTO MAIN STORAGE * 03000000 * LOCATE - DETERMINE VOLID AND F1 DSCB NAME @ZA05823* 03010000 * OBTAIN - READ DSCB INTO MAIN STORAGE * 03020000 * RETURN - RESTORE CALLERS REGISTERS BEFORE RETURN * 03040000 * SAVE - SAVE REGISTERS ON INITIAL ENTRY * 03060000 * TRKCALC - GET COUNT OF BLOCKS THAT FIT ON 1 TRACK @ZA85473* 03070000 * XCTL - TRANSFER CONTROL TO MAIN CONTROLLER * 03080000 * * 03100000 * EXITS, NORMAL -- * 03120000 * WHEN IKJEBEIN COMPLETES SUCCESSFULLY, CONTROL IS PASSED TO THE * 03140000 * MAIN CONTROLLER ROUTINE, IKJEBEMA, VIA AN XCTL MACRO INSTRUCTION.* 03160000 * * 03180000 * EXITS, ERROR -- * 03200000 * WHEN IKJEBEIN ENCOUNTERS ANY CONDITION WHICH DOES NOT ALLOW * 03220000 * IT TO COMPLETE SUCCESSFULLY, CONTROL IS RETURNED TO THE TMP * 03240000 * BY BRANCHING ON REGISTER FOURTEEN (14). * 03260000 * * 03280000 * TABLES/WORK AREAS -- * 03300000 * * 03320000 * THE EDIT COMMUNICATION AREA IS BUILT AND INITIALIZED BY * 03340000 * IKJEBEIN. IKJEBEIN WILL INITIALIZE THE FULLY QUALIFIED DATA SET * 03360000 * NAME, DATA SET TYPE, DATA SET DEPENDENT INFORMATION, LRECL, * 03380000 * BLKSIZE, SEQUENCE NUMBER FIELD DESCRIPTION, SYNTAX CHECKING * 03400000 * INFORMATION, AND WILL INDICATE WHETHER DATA IS TO BE MAINTAINED * 03420000 * AS ENTERED OR TRANSLATED TO UPPER CASE ALPHABETICS. * 03440000 * * 03460000 * THE EDIT COMMAND PDL (PARAMETER DESCRIPTOR LIST) IS RETURNED * 03480000 * BY IKJPARS AFTER SCANNING THE EDIT COMMAND. IT ALLOWS IKJEBEIN * 03500000 * TO ADDRESS COMMAND OPERANDS FOR PURPOSES OF CONVERSION, * 03520000 * INITIALIZATION, AND VALIDATION. IT IS ALWAYS FREEMAINED BEFORE * 03540000 * IKJEBEIN RELINQUISHES CONTROL. * 03560000 * * 03580000 * ATTRIBUTES -- * 03600000 * REFRESHABLE, ENABLED, NON-PRIVILEGED * 03620000 * * 03640000 * CHARACTER CODE DEPENDENCY -- * 03660000 * THE MAIN CSECT OF THE EDIT INITIALIZATION IS NOT CHARACTER * 03680000 * CODE DEPENDENT. * 03700000 * * 03720000 * NOTES -- NONE. * 03740000 * * 03760000 *********************************************************************** 03780000 EJECT 03800000 *********************************************************************** 03820000 * * 03840000 * GENERAL PURPOSE REGISTER EQUATES FOR THIS ROUTINE. * 03860000 * * 03880000 *********************************************************************** 03900000 ENTCDREG EQU 0 REGISTER USED TO CONTAIN ENTRY CODE 03920000 PARMREG0 EQU 0 PARAMETER REGISTER. 03940000 PARMREG1 EQU 1 INPUT - ADDRESS OF COMMAND PROCESSOR 03960000 * PARAMETER LIST. 03980000 * OUTPUT - ADDRESS OF THE EDIT 04000000 * COMMUNICATION AREA. 04020000 * GENERAL USAGE IN THIS MODULE - 04040000 * ADDRESS OF A PARAMETER LIST TO 04060000 * BE PASSED TO A ROUTINE INVOKED 04080000 * BY IKJEBEIN. 04100000 INDEXREG EQU 2 REGISTER USED AS INDEX INTO TABLE 04120000 * OF DATA SET TYPES. 04140000 LENREG EQU 2 REGISTER USED TO CONTAIN LENGTH FOR 04160000 * CURRENT OPERATION. 04180000 UPTREG EQU 3 ADDRESS OF UPT. 04200000 COUNTREG EQU 3 LOOP CONTROL COUNTER. 04220000 ECTREG EQU 4 ADDRESS OF ECT. 04240000 FLAGREG EQU 3 FLAG BYTE USED IN IMMEDIATE 04260000 * INSTRUCTIONS. 04280000 SIZEREG EQU 3 SIZE OF AREA BEING INITIALIZED 04300000 * DURING CURRENT OPERATION. 04320000 TABPTREG EQU 3 ADDRESS OF CURRENT LOCATION IN 04340000 * TABLE BEING REFERENCED. 04360000 AREAREG EQU 4 ADDRESS OF CURRENT POSITION IN AREA 04380000 * BEING INITIALIZED. 04400000 QUALREG EQU 4 ADDRESS OF DATA SET QUALIFIER. 04420000 * PROCESSED. 04440000 DSNAMREG EQU 5 ADDRESS OF DATA SET NAME. 04460000 ECBREG EQU 5 ADDRESS OF ATTENTION ECB. 04480000 ERR1REG EQU 5 REGISTER USED FOR RELATIVE FIRST 04500000 * LEVEL MESSAGE NUMBER. 04520000 STRTNREG EQU 5 START COLUMN NUMBER FOR NUM CHECK. 04540000 ERR2REG EQU 6 REGISTER USED FOR RELATIVE SECOND 04560000 * LEVEL MESSAGE NUMBER. 04580000 PCLREG EQU 6 ADDRESS OF PCL FOR IKJPARSE. 04600000 TMPREG EQU 6 ADDRESS OF TMP PARAMETER LIST. 04620000 TMPCDREG EQU 6 REGISTER USED TO TEST RETURN CODES 04640000 * FROM INVOKED ROUTINES. 04660000 TYPNOREG EQU 6 REGISTER USED AS COUNTER FOR NUMBER 04680000 * OF ENTRIES REMAINING IN DATA 04700000 * SET TYPE. 04720000 DATA1REG EQU 7 REGISTER USED TO TRANSMIT DATA TO 04740000 * IKJEBEIA FOR MESSAGE INSERTION. 04760000 PDLREG EQU 7 ADDRESS OF AREA FOR IKJPARSE TO 04780000 * RETURN PDL ADDRESS. 04800000 DATA2REG EQU 8 REGISTER USED TO TRANSMIT DATA TO 04820000 * IKJEBEIA FOR MESSAGE INSERTION. 04840000 PASSREG EQU 8 ADDRESS OF PSCB. 04860000 SRRTNREG EQU 8 REGISTER USED TO LINK TO INTERNAL 04880000 * SUBROUTINES. 04900000 COMMREG EQU 9 BASE REGISTER USED TO ADDRESS THE 04920000 * COMMUNICATION AREA. 04940000 BASEREG EQU 11 BASE REGISTER FOR THIS CSECT 04960000 DATAREG EQU 12 BASE REGISTER USED TO ADDRESS THE 04980000 * INPUT PARAMETER LIST. 05000000 SAVEREG EQU 13 ADDRESS OF SAVE AREA. 05020000 RETREG EQU 14 ADDRESS OF RETURN POINT IN CALLING 05040000 * MODULE. 05060000 TOPPTR EQU 14 POINTER TO TOP OF DATASET. Y01676 05060200 EPLOCREG EQU 15 ENTRY POINT ADDRESS OF MODULE TO BE 05080000 * INVOKED. 05100000 RETCDREG EQU 15 CONDITION CODE RETURNED TO CALLING 05120000 * ROUTINE. 05140000 EJECT 05160000 *********************************************************************** 05180000 * * 05200000 * PROLOG * 05220000 * * 05240000 *********************************************************************** 05260000 SAVE (14,12),,* SAVE ENTRY REGISTERS. 05280000 BALR BASEREG,PARMREG0 ESTABLISH A BASE REGISTER AND 05300000 USING *,BASEREG ADDRESSABILITY FOR THIS CSECT. 05320000 LR DATAREG,PARMREG1 SAVE ADDRESS OF INPUT PARAMETERS. 05340000 GETMAIN R,LV=CADLEN,SP=SUBPOOL GET SAVE AND WORK AREA. 05360000 LR COMMREG,PARMREG1 ADDRESS OF COMMUNICATION AREA. 05380000 EJECT 05400000 *********************************************************************** 05480000 * * 05500000 * ESTABLISH ADDRESSABILITY TO COMMUNICATION AREA AND INITIALIZE * 05520000 * TO ZERO. INITIALIZE ADDRESS TO TMP PARAMETER LIST. * 05540000 * * 05560000 *********************************************************************** 05580000 USING IKJEBECA,COMMREG ESTABLISH ADDRESSABILITY TO 05600000 * COMMUNICATION AREA. 05620000 LA LENREG,INF255 NUMBER OF BYTES SET TO ZERO EACH 05640000 * TIME THROUGH LOOP BUT LAST. 05660000 LA SIZEREG,CADLEN SIZE OF COMMUNICATION AREA. 05680000 BCTR SIZEREG,PARMREG0 REDUCE SIZE OF COMMUNICATION AREA 05700000 * BY 1. 05720000 LR AREAREG,COMMREG COPY ADDRESS OF AREA TO BE SET 05740000 * TO ZERO. 05760000 IN001010 EQU * 05780000 CR SIZEREG,LENREG DETERMINE IF SIZE GREATER THAN 255. 05800000 BNH IN001020 IF NOT, BRANCH TO SET REMAINING 05820000 * AREA TO ZERO. 05840000 EX LENREG,INXC001 ZERO 255 BYTES. 05860000 AR AREAREG,LENREG UPDATE POINTER TO NEXT SECTION TO 05880000 * BE SET TO ZERO. 05900000 SR SIZEREG,LENREG DECREMENT NUMBER OF BYTES TO BE 05920000 * ZEROED BY NUMBER JUST SET TO 05940000 * ZERO. 05960000 B IN001010 BRANCH TO CHECK IF DONE. 05980000 IN001020 EQU * 06000000 EX SIZEREG,INXC001 ZERO NUMBER OF BYTES REMAINING. 06020000 LA RETCDREG,CASVAREA ADDRESS OF SAVE AREA IN THE 06040000 * COMMUNICATION AREA. 06060000 ST SAVEREG,D4(,RETCDREG) CROSS CHAIN PREVIOUS AND 06080000 ST RETCDREG,D8(,SAVEREG) CURRENT SAVE AREAS AND 06100000 LR SAVEREG,RETCDREG INITIALIZE REG13 TO POINT TO 06120000 * CURRENT SAVE AREA. 06140000 LA RETCDREG,D72(,RETCDREG) COMPUTE ADDRESS OF NEXT 06160000 ST RETCDREG,CANXTSVA LOWER SAVE AREA AND SAVE 06180000 * IN COMMUNICATION AREA. 06200000 ST DATAREG,CAPTTMP SAVE ADDRESS TO INPUT PARAMETER 06220000 * LIST FROM TMP. 06240000 EJECT 06260000 *********************************************************************** 06280000 * * 06300000 * LOAD IKJEBEMS (MESSAGE SELECTION ROUTINE). SAVE ENTRY POINT * 06320000 * ADDRESS IN THE COMMUNICATION AREA. * 06340000 * * 06360000 *********************************************************************** 06380000 SPACE 2 06400000 LOAD EP=IKJEBEMS LOAD IKJEBEMS. 06420000 ST PARMREG0,CAPTMS SAVE ENTRY POINT ADDRESS IN THE 06440000 * COMMUNICATION AREA. 06460000 SPACE 2 06480000 EJECT 06500000 *********************************************************************** 06520000 * * 06540000 * BUILD MODE MESSAGE INSERTION IN THE COMMUNICATION AREA. THE * 06560000 * INSERTION RECORD CONTAINS THE NAME OF THE EDIT COMMAND AS THE * 06580000 * USER ENTERED IT. * 06600000 * * 06620000 *********************************************************************** 06640000 L AREAREG,CAPTTMP ADDRESS OF CPPL. 06660000 L AREAREG,(CPPLECT-CPPL)(,AREAREG) ADDRESS OF ECT. 06680000 MVC CAMODETX+D1(L'ECTPCMD),(ECTPCMD-ECT)(AREAREG) 06700000 * MOVE COMMAND NAME TO INSERTION 06720000 * RECORD. 06740000 MVI CAMODETX,CHRBLANK MOVE IN BLANK BEFORE COMMAND 06760000 * NAME. 06780000 LA LENREG,(L'ECTPCMD+D1)(,D0) LOOP CONTROL COUNTER. 06800000 LA SIZEREG,CAMODETX+(L'ECTPCMD) ADDRESS OF LAST 06820000 * CHARACTER IN COMMAND NAME. 06840000 IN000010 EQU * 06860000 CLI D0(SIZEREG),CHRBLANK CHECK FOR BLANK. 06880000 BNE IN000020 IF NOT A BLANK, ALL TRAILING BLANKS 06900000 * HAVE BEEN SUPPRESSED. 06920000 BCTR SIZEREG,D0 BACK POINTER UP ONE CHARACTER. 06940000 BCT LENREG,IN000010 REDUCE COUNTER BY ONE AND BRANCH 06960000 * TO CHECK NEXT BYTE. 06980000 IN000020 EQU * 07000000 LA LENREG,D4(,LENREG) COMPUTE LENGTH OF INSERTION 07020000 STH LENREG,CAMODELN AND SAVE IN CONTROL FIELD. 07040000 LA LENREG,D1(,D0) INITIALIZE NUMBER OF SEGMENTS IN 07060000 ST LENREG,CAMODEIS MODE MESSAGE. 07080000 LA AREAREG,CAMODELN INITIALIZE ADDRESS OF MODE 07100000 ST AREAREG,CAMODEPT MESSAGE IN OUTPUT DESCRIPTOR. 07120000 EJECT 07140000 *********************************************************************** 07160000 * * 07180000 * CALL IKJPARS TO SYNTAX CHECK THE EDIT COMMAND. * 07200000 * * 07220000 * INITIALIZE THE FIRST THREE WORDS OF THE SERVICE ROUTINE PARAMETER * 07240000 * LIST (CAPTUPT, CAPTECT, CAPTECT) TO POINT TO THE UPT, ECT, AND * 07260000 * THE EDIT ATTENTION ECB. * 07280000 * * 07300000 * INITIALIZE THE SEVEN WORD PARAMETER LIST FOR IKJPARS. LINK TO * 07320000 * IKJPARS TO SYNTAX CHECK THE EDIT COMMAND AND TO BUILD THE * 07340000 * PARAMETER DESCRIPTOR LIST. * 07360000 * * 07380000 *********************************************************************** 07400000 L DATAREG,CAPTTMP ADDRESS OF PARAMETER LIST PASSED 07420000 * BY TMP. 07440000 L UPTREG,(CPPLUPT-CPPL)(,DATAREG) GET ADDRESS 07460000 * OF UPT. 07480000 L ECTREG,(CPPLECT-CPPL)(,DATAREG) GET ADDRESS 07500000 * OF ECT. 07520000 LA ECBREG,CAATTN GET ADDRESS OF ATTENTION ECB. 07540000 L PCLREG,INPTPCL ADDRESS OF PCL FOR IKJPARSE. 07560000 L PASSREG,(CPPLCBUF-CPPL)(,DATAREG) ADDRESS OF 07580000 * EDIT COMMAND. 07600000 LA PDLREG,CAPTPRSD SPECIFY ADDRESS OF AREA IN 07640000 * WHICH IKJPARS RETURNS THE 07660000 * POINTER TO THE PDL. 07680000 XC CATMPLST+(PPLPCL-PPL)(PPLUWA-PPLPCL+L'PPLUWA),CATMPLST+(X07700000 PPLPCL-PPL) ZERO IKJPARS PORTION OF PARAMETER 07720000 * LIST. 07740000 LA PARMREG1,CATMPLST ADDRESS OF PARAMETER LIST @YA02225 07748500 STM UPTREG,COMMREG,0(PARMREG1) STORE IN PARM LIST @YA02225 07749000 CALLTSSR EP=IKJPARS INVOKE PARSE SERVICE ROUTINE @YA02225 07751000 IN001060 EQU * 07820000 B IN001060+D4(RETCDREG) IKJPARS RETURN CODE BRANCH 07840000 * TABLE. 07860000 B IN001070 00 - SUCCESSFUL COMPLETION. 07880000 B INEXIT2 04 - COMMAND NOT COMPLETE, COULD 07900000 * NOT PROMPT, RETURN. 07920000 B INEXIT2 08 - ATTENTION ISSUED, RETURN. 07940000 B IN001065 12 - INVALID PARAMETERS. 07960000 B IN001062 16 - NO MAIN STORAGE AVAILABLE -- A45714 07980000 B IN001065 20 - ERROR IN VALID. CHK EXIT. A45714 08000000 * PUT ERROR MESSAGE AND RETURN. 08020000 SPACE 2 08040000 IN001062 EQU * A45714 08060000 *********************************************************************** 08080000 * * 08100000 * ISSUE NO MAIN STORAGE AVAILABLE MESSAGE AND TERMINATE. * 08120000 * * 08140000 *********************************************************************** 08160000 LA ERR1REG,INERROR1 RELATIVE ERROR TO BE PROCESSED. 08180000 B IN010010 BRANCH TO CALL IKJEBIN3 TO PUT 08200000 * ERROR MESSAGE AND RETURN. 08220000 SPACE 2 08240000 *********************************************************************** 08260000 * * 08280000 * ISSUE COMMAND SYSTEM ERROR MESSAGE AND TERMINATE. * 08300000 * * 08320000 *********************************************************************** 08340000 IN001065 EQU * 08360000 LA ERR1REG,INERROR2 RELATIVE ERROR TO BE PROCESSED. 08380000 LR DATA2REG,RETCDREG SAVE RETURN CODE FOR MESSAGE. 08400000 O DATA2REG,INPARS INDICATE ROUTINE NAME AS IKJPARS. 08420000 B IN010010 BRANCH TO CALL IKJEBIN3 TO PUT 08440000 * ERROR MESSAGE AND RETURN. 08460000 SPACE 2 08480000 IN001070 EQU * 08500000 L DATAREG,CAPTPRSD ADDRESS OF EDIT PDL. 08520000 USING INECMNDD,DATAREG AND ESTABLISH ADDRESSABILITY 08540000 * TO IT. 08560000 EJECT 08580000 *********************************************************************** 08600000 * * 08620000 * DETERMINE IF DATA SET TYPE SPECIFIED ON THE EDIT COMMAND. IF * 08640000 * DATA SET TYPE NOT SPECIFIED, BRANCH TO PROCESS DATA SET NAME. * 08660000 * * 08680000 * WHEN DATA SET TYPE IS SPECIFIED, INITIALIZE THE DATA SET TYPE * 08700000 * FIELD IN THE COMMUNICATION AREA USING A DATA SET TYPE FROM * 08720000 * INDSTAB LOCATED BY THE KEYWORD NUMBER RETURNED BY IKJPARS. * 08740000 * AFTER THE DATA SET TYPE IS INITIALIZED, LOAD AND CALL IKJEBEPS * 08760000 * TO VERIFY THE DATA SET TYPE AND RETURN ALL DATA SET DEPENDENT * 08780000 * INFORMATION. * 08800000 * * 08820000 *********************************************************************** 08840000 CLC INDSTYPE(L'INNOKEYW),INNOKEYW DETERMINE IF DATA 08860000 * SET TYPE SPECIFIED ON COMMAND. 08880000 BE IN001075 IF NOT SPECIFIED, BRANCH TO PROCESS 08900000 * DATA SET NAME. 08920000 LH INDEXREG,INDSTYPE OBTAIN KEYWORD NUMBER RETURNED 08940000 * BY IKJPARS TO BE USED AS 08960000 * INDEX TO DATA SET TYPE TABLE. 08980000 SLL INDEXREG,D3(D0) MULTIPLY INDEX BY 8. 09000000 LA AREAREG,IKJEBIN0-D8(INDEXREG) OBTAIN ADDRESS OF 09020000 * DATA SET TYPE. 09040000 MVC CADSTYPE(INDSTELN),D0(AREAREG) MOVE DATA SET TYPE 09060000 * TO COMMUNICATION AREA TO BE 09080000 * USED AS INPUT PARAMETER TO 09100000 * IKJEBEPS. 09120000 LOAD EP=IKJEBEPS LOAD PROCESSOR TABLE SEARCH ROUTINE 09140000 LR EPLOCREG,PARMREG0 COPY ENTRY POINT ADDRESS. 09160000 CALL (15),,MF=(E,CADSTYPE) BRANCH TO IKJEBEPS. 09180000 LTR RETCDREG,RETCDREG TEST FOR SUCCESSFUL COMPLETION. 09200000 BNZ IN001071 IF RETURN CODE = 4, BRANCH TO PUT 09220000 * ERROR MESSAGE AND RETURN. 09240000 MVC CADSTYPE(CADATEXT-CAPD),D0(PARMREG1) MOVE FIRST Y02676 09290000 * PORTION OF TYPE-DEPENDENT Y02676 09300000 * INFORMATION TO THE Y02676 09310000 * COMMUNICATION AREA. Y02676 09312000 LA RETCDREG,CAPDEXT OBTAIN ADDRESS OF PROCESSOR Y02676 09314000 * TABLE EXTENSION. Y02676 09316000 ST RETCDREG,CAPTPDXT STORE PTR TO EXTENSION AREA. Y02676 09318000 USING IKJEBECX,RETCDREG EXTENSION ADDRESSABILITY. Y02676 09318400 MVC CXDATEXT(CXDLEN),CADATEXT-CAPD(PARMREG1) MOVE Y02676 09318800 * REMAINING INFORMATION TO Y02676 09319200 * TABLE EXTENSION AREA. Y02676 09319600 DROP RETCDREG END EXTENSION ADDRESSABILITY. Y02676 09319700 DELETE EP=IKJEBEPS DELETE LOAD MODULE FROM CORE. 09320000 B IN001075 BRANCH TO PROCESS DATA SET NAME. 09340000 SPACE 2 09360000 *********************************************************************** 09380000 * * 09400000 * ISSUE COMMAND SYSTEM ERROR MESSAGE. * 09420000 * * 09440000 *********************************************************************** 09460000 IN001071 EQU * 09480000 DELETE EP=IKJEBEPS DELETE PROCESSOR SEARCH ROUTINE. 09500000 LA ERR1REG,INERROR2 RELATIVE ERROR TO BE PROCESSED. 09520000 LA DATA2REG,ININS004 ADDRESS OF INSERTION LIST FOR 09540000 * SECOND LEVEL MESSAGE. 09560000 B IN010010 BRANCH TO CALL IKJEBIN3 TO PUT 09580000 * ERROR MESSAGE AND TERMINATE. 09600000 EJECT 09620000 *********************************************************************** 09640000 * * 09660000 * DATA SET NAME PROCESSING. * 09680000 * * 09700000 * UPON RETURN FROM IKJPARS, DETERMINE IF DATA SET NAME WAS ENTERED * 09720000 * FULLY QUALIFIED. IF NOT FULLY QUALIFIED, BRANCH TO FULLY * 09740000 * QUALIFY THE DATA SET NAME. WHEN FULLY QUALIFIED, DETERMINE IF * 09760000 * USER SPECIFIED A DATA SET TYPE. IF A DATA SET TYPE WAS NOT * 09780000 * ENTERED, USE PARSE TO PROMPT FOR THE DATA SET TYPE. * 09800000 * * 09820000 *********************************************************************** 09840000 IN001075 EQU * 09860000 MVI CAEDDSN,CHRBLANK INITIALIZE DATA SET NAME, MEMBER 09880000 MVC CAEDDSN+D1(CAEDPSWD+L'CAEDPSWD-CAEDDSN-D1),CAEDDSN 09900000 * NAME, DDNAME AND PASSWORD 09920000 * FIELDS TO CHARACTER BLANKS. 09940000 LH LENREG,INDSN+INDSNLL GET DATA SET NAME LENGTH. 09960000 STH LENREG,CAEDDSNL SAVE LENGTH OF DATA SET NAME. 09980000 LTR LENREG,LENREG DETERMINE IF MEMBER NAME ONLY WAS 10000000 * SPECIFIED. 10020000 BZ IN001077 IF SO, BYPASS MOVE OF DSNAME TO 10040000 * COMMUNICATION AREA. 10060000 L AREAREG,INDSN+INDSNPT GET POINTER TO DATA SET NAME 10080000 BCTR LENREG,PARMREG0 REDUCE DATA SET NAME BY 1. 10100000 EX LENREG,INMV003 MOVE DATA SET NAME TO COMMUNICATION 10120000 * AREA. 10140000 TM INDSN+INMEMFLG,INOPRNDO DETERMINE IF MEMBER NAME 10160000 * SUPPLIED. 10180000 BZ IN001080 IF NOT, BRANCH TO CHECK PASSWORD. 10200000 IN001077 EQU * 10220000 LH LENREG,INDSN+INMEMLL GET LENGTH OF MEMBER NAME. 10240000 L AREAREG,INDSN+INMEMPT GET ADDRESS OF MEMBER NAME. 10260000 BCTR LENREG,PARMREG0 REDUCE MEMBER NAME LENGTH BY 1. 10280000 EX LENREG,INMV004 MOVE MEMBER NAME TO COMMUNICATION 10300000 * AREA. 10320000 OI CAEDFLAG,CAEDDSOR INDICATE DSORG OF PO. 10340000 IN001080 EQU * 10360000 TM INDSN+INPSWFLG,INOPRNDO DETERMINE IF PASSWORD 10380000 * SPECIFIED. 10400000 BZ IN001090 IF NOT, BRANCH TO CHECK DATA SET 10420000 * TYPE. 10440000 LH LENREG,INDSN+INPSWLL GET LENGTH OF PASSWORD. 10460000 L AREAREG,INDSN+INPSWPT GET ADDRESS OF PASSWORD. 10480000 BCTR LENREG,PARMREG0 REDUCE LENGTH OF PASSWORD BY 1. 10500000 EX LENREG,INMV005 MOVE PASSWORD TO COMMUNICATION 10520000 * AREA. 10540000 IN001090 EQU * 10560000 TM INDSN+INDSNFLG,INFULLQ DETERMINE IF DATA SET NAME 10580000 * WAS ENTERED FULLY QUALIFIED. 10600000 BO IN001095 IF FULLY QUALIFIED, BRANCH TO CHECK 10620000 * IF DATA SET TYPE SPECIFIED. 10640000 * IF DATA SET NAME IS NOT FULLY QUALIFIED, CALL IKJEBEID TO 10660000 * FULLY QUALIFY. 10680000 CALL IKJEBIN7,((COMMREG),(DATAREG)),MF=(E,INSVCRTN) X10700000 FULLY QUALIFY DATA SET NAME. 10720000 IN001093 EQU * 10740000 B IN001093+D4(RETCDREG) RETURN CODE BRANCH TABLE. 10760000 B IN002000 00 - SUCCESSFUL. 10780000 B INEXIT1 04 - UNSUCCESSFUL. (TERMINATE EDIT.) 10800000 IN001095 EQU * 10820000 CLI CADSCODE,D0 DETERMINE IF DATA SET TYPE WAS 10840000 BNE IN002000 ENTERED ON THE EDIT COMMAND. 10860000 * IF SPECIFIED, BRANCH TO LINK 10880000 * TO IKJDAIR. 10900000 CALL IKJEBIN5,((COMMREG)),MF=(E,INSVCRTN) PROMPT FOR X10920000 DATA SET TYPE. 10940000 * BRANCH TO PROMPT FOR SAME. 10960000 LTR RETCDREG,RETCDREG TEST RETURN CODE FOR SUCCESSFUL 10980000 BNZ INEXIT1 COMPLETION. IF NOT ZERO, 11000000 * BRANCH TO EXIT. 11020000 EJECT 11040000 IN002000 EQU * 11060000 *********************************************************************** 11080000 * * 11100000 * BUILD DATA SET NAME INSERTION RECORD IN COMMUNICATION AREA. THE * 11120000 * INSERTION RECORD WILL BE USED BY ANY ROUTINE WHICH HAS TO ISSUE * 11140000 * AN ERROR MESSAGE CONTAINING A DATA SET NAME. THE INSERTION WILL * 11160000 * CONTAIN THE FULLY QUALIFIED DATA SET NAME IN SINGLE QUOTES IF THE * 11180000 * USER SPECIFIED A FULLY QUALIFIED DATA SET NAME ON THE EDIT * 11200000 * COMMAND. WHEN THE DATA SET NAME IS ENTERED PARTIALLY QUALIFIED, * 11220000 * ALL LEVELS OF QUALIFICATION EXCEPT USERID ARE PLACED IN THE * 11240000 * COMMUNICATION AREA. * 11260000 * * 11280000 *********************************************************************** 11300000 LA AREAREG,CADSNREC ADDRESS OF INSERTION RECORD. 11320000 LH LENREG,CAEDDSNL LENGTH OF FULLY QUALIFIED DSNAME. 11340000 LA DSNAMREG,CAEDDSN ADDRESS OF DATA SET NAME. 11360000 TM INDSN+INDSNFLG,INFULLQ DETERMINE IF DATA SET NAME 11380000 * WAS ENTERED FULLY QUALIFIED. 11400000 BZ IN002210 IF NOT FULLY QUALIFIED, BRANCH TO 11420000 * BUILD INSERTION RECORD. 11440000 MVI D0(AREAREG),INSNGLQT MOVE IN SINGLE QUOTE FOR 11460000 * INSERTION RECORD. 11480000 LA COUNTREG,X1(,D0) INITIALIZE COUNTER TO NUMBER OF 11500000 * CHARACTERS IN NAME. 11520000 AR AREAREG,COUNTREG UPDATE ADDRESS IN INSERTION 11540000 * RECORD. 11560000 B IN002030 BRANCH TO MOVE DATA SET NAME. 11580000 IN002210 EQU * 11600000 CLI D0(DSNAMREG),INPERIOD CHECK FOR FIRST OCCURRENCE 11620000 BE IN002220 OF PERIOD IN DSNAME. BRANCH 11640000 * TO UPDATE COUNTER IF FOUND. 11660000 LA DSNAMREG,X1(,DSNAMREG) UPDATE ADDRESS INTO DSNAME 11680000 BCT LENREG,IN002210 AND REDUCE LENGTH BY 1. 11700000 * BRANCH TO TEST NEXT CHARACTER 11720000 * IN BUFFER. 11740000 * 11760000 LA LENREG,D2(,D0) LENREG HAS BECOME ZERO ADD 2 ZA28057 11780000 * SO THAT MVC WILL BE OK. ZA28057 11790000 * 11820000 IN002220 EQU * 11840000 LA DSNAMREG,X1(,DSNAMREG) RESET ADDRESS IN DATA SET 11860000 BCTR LENREG,D0 NAME AND LENGTH TO BYPASS THE 11880000 * PERIOD. 11900000 SR COUNTREG,COUNTREG ZERO COUNTER OF NUMBER OF BYTES 11920000 * IN DATA SET NAME. 11940000 IN002030 EQU * 11960000 BCTR LENREG,D0 REDUCE LENGTH TO BE MOVED BY ONE 11980000 * FOR MOVE CHARACTER. 12000000 EX LENREG,INMV001 MOVE DATA SET NAME TO INSERTION 12020000 * RECORD. 12040000 LA COUNTREG,X1(LENREG,COUNTREG) UPDATE COUNTER TO 12060000 * NUMBER OF BYTES IN DSNAME. 12080000 LA AREAREG,D1(LENREG,AREAREG) UPDATE ADDRESS IN 12100000 * INSERTION RECORD. 12120000 TM INDSN+INMEMFLG,INOPRNDO DETERMINE IF MEMBER NAME 12140000 * SUPPLIED. 12160000 BZ IN002230 IF NOT SUPPLIED, BRANCH TO COMPLETE 12180000 * INSERTION RECORD. 12200000 MVI D0(AREAREG),INLFTPRN MOVE LEFT PARENTHESIS TO 12220000 * INSERTION RECORD. 12240000 LH LENREG,INDSN+INMEMLL LENGTH OF MEMBER NAME. 12260000 L DSNAMREG,INDSN+INMEMPT ADDRESS OF MEMBER NAME. 12280000 BCTR LENREG,D0 REDUCE LENGTH BY 1 FOR MVC. 12300000 EX LENREG,INMV002 MOVE MEMBER NAME TO INSERTION 12320000 * RECORD. 12340000 LA AREAREG,D2(LENREG,AREAREG) UPDATE ADDRESS IN DATA 12360000 * SET NAME INSERTION. 12380000 MVI D0(AREAREG),INRTPRN MOVE RIGHT PARENTHESIS TO 12400000 * INSERTION RECORD. 12420000 LA AREAREG,D1(,AREAREG) UPDATE ADDRESS IN DATA 12440000 * SET NAME INSERTION. 12460000 LA COUNTREG,D3(LENREG,COUNTREG) UPDATE COUNTER TO 12480000 * REFLECT NUMBER OF CHARACTERS 12500000 * IN DSNAME AND MEMBER NAME. 12520000 IN002230 EQU * 12540000 TM INDSN+INDSNFLG,INFULLQ DETERMINE IF DATA SET NAME 12560000 * WAS ENTERED FULLY QUALIFIED. 12580000 BZ IN002240 IF NOT FULLY QUALIFIED, BRANCH TO 12600000 * PLACE LENGTH IN INSERTION 12620000 * RECORD. 12640000 MVI D0(AREAREG),INSNGLQT MOVE CLOSING SINGLE QUOTE IN 12660000 * INSERTION RECORD. 12680000 LA COUNTREG,X1(,COUNTREG) UPDATE COUNTER TO REFLECT 12700000 * NUMBER OF CHARACTERS IN RECORD 12720000 IN002240 EQU * 12740000 XC CADSNPTR(CADSNREC-CADSNPTR),CADSNPTR ZERO CONTROL 12760000 * WORDS FOR INSERTION RECORD. 12780000 LA COUNTREG,D4(,COUNTREG) UPDATE COUNTER TO INCLUDE 12800000 * LENGTH OF CONTROL WORD AND 12820000 STH COUNTREG,CADSNLEN SAVE IN INSERTION RECORD. 12840000 EJECT 12860000 *********************************************************************** 12880000 * * 12900000 * ALLOCATE THE EDIT DATA SET. * 12920000 * * 12940000 * INDICATE THAT THE DATA SET BEING PROCESSED IS THE EDIT DATA SET. * 12960000 * BUILD A PARAMETER BLOCK FOR IKJDAIR AND INCLUDE A PASSWORD IF * 12980000 * SPECIFIED. CHECK IF USER SPECIFIED NEW ON THE COMMAND -- IF SO, * 13000000 * BRANCH TO VALIDATE OPERANDS SPECIFIED ON THE COMMAND. OTHERWISE * 13020000 * DETERMINE IF A MEMBER NAME WAS SPECIFIED. WHEN A MEMBER NAME IS * 13040000 * ENTERED, CHANGE DISPOSITION FROM OLD TO SHR FOR IKJDAIR. LINK * 13060000 * TO IKJDAIR WITH ENTRY CODE X'08' TO ALLOCATE THE DATA SET. * 13080000 * * 13100000 *********************************************************************** 13120000 OI CAEDFLAG,CAEDITDS INDICATE EDIT DATA SET. 13140000 L PASSREG,CAPTTMP ADDRESS OF TMP PARAMETER LIST. 13160000 L PASSREG,(CPPLPSCB-CPPL)(,PASSREG) ADDRESS OF PSCB. 13180000 LA AREAREG,CAEDDSNL ADDRESS OF DATA SET NAME LENGTH 13200000 * AND DATA SET NAME. 13220000 MVC INDREC(INDR8OLL),INDAIR8O INITIALIZE IKJDAIR 13240000 * PARAMETER LIST - ENTRY CODE 8. 13260000 TM INDSN+INPSWFLG,INOPRNDO DETERMINE IF PASSWORD 13280000 * SPECIFIED. 13300000 BZ IN002250 IF NOT, BRANCH TO CHECK IF NEW 13320000 * OPERAND SPECIFIED ON COMMAND. 13340000 MVC INDREC+(DA08PSWD-DAPB08)(L'CAEDPSWD),CAEDPSWD MOVE 13360000 * PASSWORD TO PARAMETER LIST. 13380000 IN002250 EQU * 13400000 CLC INSTAT(L'INDISPNW),INDISPNW DETERMINE IF NEW WAS 13420000 * SPECIFIED ON COMMAND. 13440000 BE IN003100 BRANCH TO VALIDATE OPERANDS ENTERED 13460000 * ON COMMAND IF NEW SPECIFIED. 13480000 TM INDSN+INMEMFLG,INOPRNDO DETERMINE IF MEMBER NAME 13500000 * ENTERED ON COMMAND. 13520000 BZ IN002255 IF NOT, BRANCH TO COMPLETE 13540000 * PARAMETER LIST FOR IKJDAIR. 13560000 OI INDREC+(DA08DSP1-DAPB08),DA08SHR INDICATE DISP=SHR 13580000 * FOR OLD, PARTITIONED DATA SETS 13600000 IN002255 EQU * 13620000 ST AREAREG,INDREC+(DA08PDSN-DAPB08) PUT ADDRESS OF 13640000 * DSNAME IN PARAMETER LIST. 13660000 LA AREAREG,INDREC ADDRESS OF IKJDAIR PARAMETER LIST. 13680000 LA PARMREG1,CATMPLST LOAD PARAM REG 1 @YA02225 13682000 LR RETREG,(PASSREG) PICK UP PARAMETER @YA02225 13684000 LR RETCDREG,(AREAREG) PICK UP PARAMETER @YA02225 13686000 STM 14,15,12(1) STORE INTO PARAM LIST @YA02225 13688000 CALLTSSR EP=IKJDAIR,MF=(E,CATMPLST) INVOKE DAIR @YA02225X13690000 SERVICE ROUTINE @YA02225 13692000 SPACE 2 13740000 *********************************************************************** 13760000 * * 13780000 * UPON RETURN FROM IKJDAIR, TEST RETURN CODE FOR SUCCESSFUL * 13800000 * COMPLETION. WHEN IKJDAIR RETURNS A NON-ZERO RETURN CODE, BRANCH * 13820000 * TO APPROPRIATE DIAGNOSTIC AREA. * 13840000 * * 13860000 *********************************************************************** 13880000 LTR RETCDREG,RETCDREG CHECK FOR NORMAL COMPLETION. YA00002 13930000 BZ IN002400 IF SO, BR TO CONTINUE NORMALLY. YA00002 13980000 IN002260 EQU * YA00002 14030000 CH RETCDREG,INDAIR08 CHECK FOR CATLG ERROR. YA00002 14080000 BL IN002270 INVALID PARAMETERS, SEND MESSAGE. YA00002 14090000 BE IN002290 CATLG ERROR, SEND MESSAGE. YA00002 14100000 CH RETCDREG,INDAIR16 CHECK IF TIOT FULL. YA00002 14110000 BL IN002350 DYN ALLOCATION ERROR, DETERMINE YA00002 14112000 * CAUSE AND SEND MESSAGE. YA00002 14114000 BE IN002280 NO TIOT ENTRIES AVAILABLE, SEND YA00002 14116000 * APPROPRIATE MESSAGE. YA00002 14118000 CH RETCDREG,INDAIR48 CHECK FOR DAIR STAE ENTERED. YA00002 14118400 BE INEXIT12 IF SO, RETURN TO TMP WITH RC=12. YA00002 14118800 SPACE 5 14120000 * YA00002 14130000 * OTHERWISE, FALL THROUGH TO ISSUE GENERAL ERROR MESSAGE. YA00002 14140000 * YA00002 14150000 *************************************************************** YA00002 14152000 * * 14160000 * IKJDAIR RETURN CODES 04, 20, 24, 28, 32, 36, 40 YA00002 14180000 * * 14200000 * ISSUE COMMAND NOT EXECUTABLE MESSAGE WITH SECOND LEVEL LOGIC * 14220000 * ERROR MESSAGE. * 14240000 * * 14260000 *********************************************************************** 14280000 IN002270 EQU * 14300000 LA ERR1REG,INERROR2 RELATIVE ERROR TO BE PROCESSED. 14320000 LR DATA2REG,RETCDREG SAVE RETURN CODE FOR MESSAGE. 14340000 O DATA2REG,INDAIR INDICATE ROUTINE NAME AS IKJDAIR. 14360000 B IN010010 BRANCH TO CALL IKJEBIN3 TO PUT 14380000 * ERROR MESSAGE. 14400000 EJECT 14420000 *********************************************************************** 14440000 * * 14460000 * IKJDAIR RETURN CODE 16 * 14480000 * * 14500000 * ISSUE TOO MANY DATA SETS ALLOCATED MESSAGE. * 14520000 * * 14540000 *********************************************************************** 14560000 IN002280 EQU * 14580000 LA ERR1REG,INERRORM RELATIVE ERROR TO BE PROCESSED. 14600000 B IN010010 BRANCH TO CALL IKJEBIN3 TO PUT 14620000 * ERROR MESSAGE. 14640000 SPACE 5 14660000 *********************************************************************** 14680000 * * 14700000 * IKJDAIR RETURN CODE 08 - CATALOG ERROR. * 14720000 * * 14740000 * SINCE IKJDAIR RETURNS THIS RETURN CODE FOR A DYNAMIC ALLOCATION * 14760000 * FAILURE OF X'17XX', THIS CODE ASSUMES THAT AN OBTAIN FAILURE HAS * 14780000 * OCCURRED WHEN THE DA08DARC FIELD IS ZERO AND THE DA08CTRC FIELD * 14800000 * IS NON-ZERO. * 14820000 * * 14840000 *********************************************************************** 14860000 IN002290 EQU * 14880000 CLC INDREC+(DA08DARC-DAPB08)(L'INDR0000),INDR0000 TEST 14900000 * FOR DARC = ZERO. 14920000 BNE IN002350 IF NOT ZERO, BRANCH TO DETERMINE 14940000 * CAUSE OF DYNAMIC ALLOCATION 14960000 * FAILURE. 14980000 * 15000000 * THE FOLLOWING ASSUMES AN OBTAIN FAILURE, I.E., DARC = ZERO 15020000 * AND CTRC = NON-ZERO. 15040000 * 15060000 IN002300 EQU * 15080000 CLC INDREC+(DA08CTRC-DAPB08)(L'INDR0004),INDR0004 TEST 15100000 * FOR CATALOG ERROR CODE = 4. 15120000 BNE IN002320 IF NOT 4, BRANCH TO CHECK FOR 8. 15140000 EJECT 15160000 *********************************************************************** 15180000 * * 15200000 * CATALOG ERROR RETURN CODE = 4. * 15220000 * * 15240000 * ISSUE REQUIRED VOLUME NOT MOUNTED MESSAGE. * 15260000 * * 15280000 *********************************************************************** 15300000 IN002310 EQU * 15320000 LA ERR1REG,INERRORN RELATIVE ERROR TO BE PROCESSED. 15340000 B IN010010 BRANCH TO CALL IKJEBIN3 TO PUT 15360000 * ERROR MESSAGE. 15380000 SPACE 2 15400000 IN002320 EQU * 15420000 CLC INDREC+(DA08CTRC-DAPB08)(L'INDR0008),INDR0008 TEST 15440000 * FOR CATALOG ERROR = 8. 15460000 BNE IN002340 IF NOT 8, BRANCH TO CHECK FOR 28. 15480000 EJECT 15500000 SPACE 5 15520000 IN002325 EQU * 15540000 *********************************************************************** 15560000 * * 15580000 * CATALOG ERROR RETURN CODE = 8. * 15600000 * * 15620000 * ISSUE DATA SET NOT ON VOLUME MESSAGE. * 15640000 * * 15660000 *********************************************************************** 15680000 LA ERR1REG,INERRORO RELATIVE ERROR TO BE PROCESSED. 15700000 B IN010010 BRANCH TO CALL IKJEBIN3 TO PUT 15720000 * ERROR MESSAGE. 15740000 IN002340 EQU * 15760000 CLC INDREC+(DA08CTRC-DAPB08)(L'INDR0028),INDR0028 TEST 15780000 * FOR CATALOG ERROR = 28. 15800000 BNE IN002346 IF NOT 28, BRANCH TO ISSUE ERROR 15820000 * MESSAGE - ALLOCATION FAILED. 15840000 EJECT 15860000 *********************************************************************** 15880000 * 15900000 * CATALOG ERROR CODE 28. 15920000 * 15940000 * ISSUE CATALOG I/O ERROR MESSAGE. 15960000 * 15980000 *********************************************************************** 16000000 IN002343 EQU * 16020000 LA ERR2REG,M3043 RELATIVE SECOND-LEVEL MESSAGE. 16040000 LA ERR1REG,INERRORP RELATIVE ERROR TO BE PROCESSED. 16060000 B IN010010 BRANCH TO CALL IKJEBIN3 TO PUT 16080000 * ERROR MESSAGE. 16100000 SPACE 5 16120000 *********************************************************************** 16140000 * * 16160000 * CATALOG ERROR RETURN CODE OTHER THAN 4,8, OR 28. * 16180000 * * 16200000 * ISSUE ALLOCATION FAILED - SYSTEM ERROR MESSAGE. * 16220000 * * 16240000 *********************************************************************** 16260000 IN002346 EQU * 16280000 LA ERR1REG,INERRORP RELATIVE ERROR TO BE PROCESSED. 16300000 LA ERR2REG,M3042 RELATIVE SECOND LEVEL MESSAGE. 16320000 LH DATA2REG,INDREC+(DA08CTRC-DAPB08) OBTAIN CATALOG 16340000 * ERROR FOR SECOND LEVEL MESSAGE 16360000 B IN010010 BRANCH TO CALL IKJEBIN3 TO PUT 16380000 * ERROR MESSAGE. 16400000 EJECT 16420000 *********************************************************************** 16440000 * * 16460000 * DYNAMIC ALLOCATION FAILURE - DARC IS NON-ZERO. * 16480000 * * 16500000 * A TEST IS MADE FOR A DYNAMIC ALLOCATION RETURN CODE IN THE FORM * 16520000 * X'17XX' (LOCATE FAILURE). IF THE CAUSE OF ALLOCATION FAILURE * 16540000 * IS ASSOCIATED WITH LOCATE, THE LOW ORDER BYTE OF THE DARC FIELD * 16560000 * (THE LOCATE RETURN CODE) IS TESTED. IF THE RETURN CODE IS 8, * 16580000 * 12, OR 16 THE DATA SET NAME COULD NOT BE FOUND IN THE CATALOG. * 16600000 * IF IT IS 4, THE USER IS INFORMED BY TERMINAL MESSAGE THAT A * 16620000 * REQUIRED CVOL IS NOT MOUNTED. IF THE LOCATE RETURN CODE IS 24, * 16640000 * A PERMANENT I/O ERROR EXISTS IN THE CATALOG AND AN APPROPRIATE * 16660000 * ERROR MESSAGE IS ISSUED. ALL OTHER RETURN CODES RESULT IN A * 16680000 * GENERAL ALLOCATION ERROR MESSAGE BEING PUT TO THE TERMINAL. * 16700000 * TERMINATION OCCURS AFTER ERROR MESSAGES ARE ISSUED FOR THE ABOVE * 16720000 * CONDITIONS. * 16740000 * * 16760000 *********************************************************************** 16780000 IN002350 EQU * 16800000 CLI INDREC+(DA08DARC-DAPB08),INDR1700 CHECK IF A 16820000 * LOCATE ERROR OCCURRED. 16840000 BNE IN002370 IF NOT A LOCATE ERROR, BRANCH TO 16860000 * DETERMINE CAUSE OF DYNAMIC 16880000 * ALLOCATION FAILURE. 16900000 CLI INDREC+D1+(DA08DARC-DAPB08),D24 CHECK IF I/O ERROR 16920000 * IN CATALOG. 16940000 BE IN002343 IF SO, BRANCH TO SET PARAMETERS FOR 16960000 * ERROR MESSAGE. 16980000 CLI INDREC+D1+(DA08DARC-DAPB08),D12 CHECK FOR LOWEST 17000000 * QUALIFIER OF DSNAME BEING AN 17020000 * INDEX LEVEL OR CVOL POINTER. 17040000 BE IN002355 IF SO, BRANCH TO ISSUE ERROR 17060000 * MESSAGE. 17080000 CLI INDREC+D1+(DA08DARC-DAPB08),D16 IS DATA SET NAME 17100000 * INCOMPATIBLE WITH CATALOG 17120000 * STRUCTURE. 17140000 BE IN002355 IF SO, BRANCH TO ISSUE ERROR MESSAGE. 17160000 CLI INDREC+D1+(DA08DARC-DAPB08),D8 CHECK LOCATE RETURN 17180000 * CODE. 17200000 BL IN002310 04 - REQUIRED VOLUME NOT AVAILABLE 17220000 BH IN002390 20-32 - SYSTEM ERROR IN DYNAMIC 17240000 * ALLOCATION. 17260000 SPACE 2 17280000 * FALLING THROUGH THE ABOVE BRANCH IMPLIES THAT DATA SET NAME WAS 17300000 * NOT FOUND IN THE CATALOG. 17320000 SPACE 2 17340000 IN002355 EQU * 17360000 CLC INSTAT(L'INKEYDEF),INKEYDEF DETERMINE IF USER 17380000 * SPECIFIED OLD. 17400000 BE IN002360 IF OLD SPECIFIED, BRANCH TO PUT 17420000 * ERROR MESSAGE AND TERMINATE. 17440000 BAL SRRTNREG,IN012010 ELSE, ASSUME TO BE NEW @OZ05180 17446000 B IN003100 PROCESS NEW @OZ05180 17452000 SPACE 5 17560000 *********************************************************************** 17580000 * * 17600000 * USER SPECIFIED OLD AND DATA SET NOT FOUND -- ISSUE ERROR MESSAGE * 17620000 * THAT DATA SET NOT FOUND AND TERMINATE EDIT. * 17640000 * * 17660000 *********************************************************************** 17680000 IN002360 EQU * 17700000 LA ERR1REG,INERROR7 RELATIVE ERROR TO BE PROCESSED. 17720000 B IN010010 BRANCH TO CALL IKJEBIN3 TO PUT 17740000 * ERROR MESSAGE. 17760000 EJECT 17780000 *********************************************************************** 17800000 * * 17820000 * DETERMINE CAUSE OF DYNAMIC ALLOCATION FAILURE. * 17840000 * * 17860000 *********************************************************************** 17880000 IN002370 EQU * 17900000 CLC INDREC+(DA08DARC-DAPB08)(L'INDR0218),INDR0218 TEST 17920000 * FOR DYNAMIC ALLOCATION RETURN 17940000 * CODE OF X'0218'. 17960000 BE IN002310 BRANCH TO ISSUE REQUIRED VOLUME NOT 17980000 * MOUNTED MESSAGE. 18000000 CLC INDREC+(DA08DARC-DAPB08)(L'INDR020C),INDR020C TEST 18020000 * FOR DARC = X'020C'. 18040000 BE IN002385 IF SO, BRANCH TO INDICATE ERROR. 18060000 CLC INDREC+(DA08DARC-DAPB08)(L'INDR0210),INDR0210 TEST 18080000 * FOR DARC=X'0210' 18100000 BNE IN002390 IF NOT DATA SET ALREADY IN USE, 18120000 * BRANCH TO CONTINUE TESTS. 18140000 SPACE 5 18160000 *********************************************************************** 18180000 * * 18200000 * DYNAMIC ALLOCATION ERROR X'020C' * 18220000 * DYNAMIC ALLOCATION ERROR X'0210' * 18240000 * * 18260000 * ISSUE DATA SET ALREADY IN USE MESSAGE. * 18280000 * * 18300000 *********************************************************************** 18320000 IN002385 EQU * 18340000 LA ERR1REG,INERRORK RELATIVE ERROR TO BE PROCESSED. 18360000 B IN010010 BRANCH TO CALL IKJEBIN3 TO PUT 18380000 * ERROR MESSAGE. 18400000 EJECT 18420000 IN002390 EQU * 18440000 CLC INDREC+(DA08DARC-DAPB08)(L'INDR0214),INDR0214 TEST 18460000 * FOR DARC=X'0214'. 18480000 BE IN002391 IF DARC=X'0214', BRANCH TO PROCESS. 18500000 CLC INDREC+(DA08DARC-DAPB08)(L'INDR021C),INDR021C TEST 18520000 * FOR DARC=X'021C'. 18540000 BNE IN002393 IF NOT X'021C',BRANCH TO CONTINUE 18560000 * TESTS. 18580000 SPACE 5 18600000 *********************************************************************** 18620000 * 18640000 * DYNAMIC ALLOCATION ERROR X'021C'. 18660000 * NO UNIT IS AVAILABLE. 18680000 * 18700000 * DYNAMIC ALLOCATION ERROR X'0214'. 18720000 * INVALID UNIT IN UADS. 18740000 * 18760000 *********************************************************************** 18780000 LA ERR2REG,M3182 SPECIFY NO UNIT AVAILABLE MESSAGE. 18800000 B IN002392 BRANCH TO SET RELATIVE MESSAGE NO. 18820000 IN002391 EQU * 18840000 LA ERR2REG,M3181 SPECIFY INVALID UNIT MESSAGE. 18860000 IN002392 EQU * 18880000 LA ERR1REG,INERRORW RELATIVE ERROR TO BE PROCESSED. 18900000 B IN010010 BRANCH TO CALL IKJEBIN3 TO PUT 18920000 * MESSAGE. 18940000 EJECT 18960000 IN002393 EQU * 18980000 CLC INDREC+(DA08DARC-DAPB08)(L'INDR0404),INDR0404 TEST 19000000 * FOR DEVICE NOT DIRECT ACCESS. 19020000 BNE IN002395 IF NOT X'0404' BRANCH TO CONTINUE 19040000 * TESTS. 19060000 SPACE 5 19080000 *********************************************************************** 19100000 * 19120000 * DYNAMIC ALLOCATION ERROR X'0404'. 19140000 * 19160000 * ISSUE MESSAGE FOR DEVICE NOT DIRECT ACCESS. 19180000 * 19200000 *********************************************************************** 19220000 LA ERR1REG,INERRORQ RELATIVE ERROR TO BE PROCESSED. 19240000 B IN010010 BRANCH TO CALL IKJEBIN3 TO PUT 19260000 * MESSAGE. 19280000 SPACE 2 19300000 IN002395 EQU * 19320000 CLC INDREC+(DA08DARC-DAPB08)(L'INDR041C),INDR041C TEST 19340000 * FOR DATA SET ON MULTIPLE 19360000 * VOLUMES. 19380000 BNE IN002399 IF NOT X'041C', BRANCH TO ISSUE 19400000 * SYSTEM ERROR DIAGNOSTIC WITH 19420000 * DARC AS INSERTION. 19440000 SPACE 5 19460000 IN002396 EQU * ZA32095 19470000 *********************************************************************** 19480000 * 19500000 * DYNAMIC ALLOCATION ERROR X'041C'. 19520000 * 19540000 * ISSUE DIAGNOSTIC FOR MULTIPLE VOLUMES NOT SUPPORTED. 19560000 * 19580000 *********************************************************************** 19600000 LA ERR1REG,INERRORT RELATIVE ERROR TO BE PROCESSED. 19620000 B IN010010 BRANCH TO CALL IKJEBIN3 TO PUT 19640000 * MESSAGE. 19660000 EJECT 19680000 *********************************************************************** 19700000 * * 19720000 * DYNAMIC ALLOCATION ERRORS OTHER THAN THOSE SPECIFICALLY 19740000 * TESTED FOR. 19760000 * * 19780000 * ISSUE ALLOCATION FAILED - SYSTEM ERROR MESSAGE. * 19800000 * * 19820000 *********************************************************************** 19840000 IN002399 EQU * 19860000 LA ERR1REG,INERRORP RELATIVE ERROR TO BE PROCESSED. 19880000 LA ERR2REG,M3041 RELATIVE SECOND LEVEL MESSAGE. 19900000 LH DATA2REG,INDREC+(DA08DARC-DAPB08) OBTAIN DARC FOR 19920000 * SECOND LEVEL MESSAGE. 19940000 B IN010010 BRANCH TO CALL IKJEBIN3 TO PUT 19960000 * ERROR MESSAGE. 19980000 EJECT 20000000 *********************************************************************** 20020000 * * 20040000 * DATA SET SUCCESSFULLY ALLOCATED. * 20060000 * * 20080000 * MOVE DDNAME RETURNED BY IKJDAIR TO COMMUNICATION AREA AND * 20100000 * INDICATE THAT DATA SET IS ALLOCATED. DETERMINE IF DATA SET * 20120000 * ORGANIZATION IS VALID FOR EDIT -- IF NOT, ISSUE ERROR MESSAGE * 20140000 * AND TERMINATE. IF DATA SET ORGANIZATION IS PARTITIONED, BRANCH * 20160000 * TO PROCESS MEMBER NAME. WHEN DATA SET HAS SEQUENTIAL ORGANIZA- * 20180000 * TION, CHECK IF USER SPECIFIED A MEMBER NAME ON COMMAND. IF * 20200000 * A MEMBER NAME WAS ENTERED, REBUILD DATA SET NAME INSERTION AND * 20220000 * PUT DIAGNOSTIC MESSAGE TO TERMINAL. AFTER USER HAS BEEN * 20240000 * INFORMED OF ERROR, BRANCH TO PROCESS LOGICAL RECORD SIZE AND * 20260000 * BLOCK SIZE FOR OLD DATA SET. * 20280000 * * 20300000 *********************************************************************** 20320000 IN002400 EQU * 20340000 MVC CAEDDDN(L'CAEDDDN),INDREC+(DA08DDN-DAPB08) MOVE 20360000 * DDNAME RETURNED BY IKJDAIR 20380000 * INTO THE COMMUNICATION AREA. 20400000 OI CAEDFLAG,CAEDDISP+CAEDALOC INDICATE THAT THE EDIT 20420000 * DATA SET HAS BEEN ALLOCATED 20440000 * AND THAT IT HAS DISP = OLD. 20460000 TM INDREC+(DA08DSO-DAPB08),DS1ORGPO DETERMINE IF A ZA33984 20480000 * PARTITIONED DATA SET. 20500000 BO IN002430 IF SO, BRANCH TO PROCESS MEMBER ZA33984 20520000 * NAME. 20540000 CLI INDREC+(DA08DSO-DAPB08),DS1ORGPS DETERMINE IF A 20560000 * SEQUENTIAL DATA SET. 20580000 BE IN002410 IF SO, BRANCH TO DETERMINE IF A 20600000 * MEMBER NAME WAS ENTERED. 20620000 CLI INDREC+(DA08DSO-DAPB08),D0 DETERMINE IF DSORG HAS 20640000 * BEEN ESTABLISHED FOR DATA SET. 20660000 BE IN002410 IF NO DSORG, BRANCH TO DO OBTAIN 20680000 * ON DATA SET NAME. 20700000 EJECT 20720000 *********************************************************************** 20740000 * * 20760000 * IF NEITHER PARTITIONED OR SEQUENTIAL, ISSUE ERROR MESSAGE THAT * 20780000 * DATA SET ORGANIZATION IS INVALID FOR EDIT AND TERMINATE. * 20800000 * * 20820000 *********************************************************************** 20840000 LA ERR1REG,INERROR4 RELATIVE ERROR TO BE PROCESSED. 20860000 LA DATA1REG,INDREC+(DA08DSO-DAPB08) ADDRESS OF DSORG 20880000 * BYTE FOR IKJEBIN3. 20900000 B IN010010 BRANCH TO CALL IKJEBIN3 TO PUT 20920000 * ERROR MESSAGE. 20940000 SPACE 2 20960000 IN002410 EQU * 20980000 TM INDSN+INMEMFLG,INOPRNDO DETERMINE IF MEMBER NAME 21000000 * SUPPLIED. 21020000 BZ IN002010 IF NOT, BRANCH TO CHECK DATA SET 21040000 * ATTRIBUTES. 21060000 LH SIZEREG,CADSNLEN OBTAIN LENGTH OF INSERTION RECORD 21080000 * WITH MEMBER NAME. 21100000 LH LENREG,INDSN+INMEMLL GET LENGTH OF MEMBER NAME 21120000 * ENTERED ON COMMAND. 21140000 LR DATA1REG,LENREG SAVE MEMBER LENGTH FOR MESSAGE. 21160000 LA LENREG,D2(,LENREG) ADD 2 TO LENGTH OF MEMBER NAME 21180000 * FOR PARENTHESES. 21200000 SR SIZEREG,LENREG REDUCE INSERTION LENGTH BY NUMBER 21220000 * OF CHARACTERS IN MEMBER NAME 21240000 STH SIZEREG,CADSNLEN AND SAVE IN INSERTION RECORD. 21260000 TM INDSN+INDSNFLG,INFULLQ DETERMINE IF DATA SET NAME 21280000 * WAS ENTERED FULLY QUALIFIED. 21300000 BZ IN002420 IF NOT, BRANCH TO REMOVE MEMBER 21320000 * NAME FROM INSERTION RECORD. 21340000 LA LENREG,D5(,D0) REDUCE NEW LENGTH BY 5 SO THAT 21360000 SR SIZEREG,LENREG FINAL QUOTE MAY BE ADDED. 21380000 LA AREAREG,CADSNREC(SIZEREG) COMPUTE LOCATION OF 21400000 MVI D0(AREAREG),INSNGLQT SINGLE QUOTE AND MOVE TO 21420000 * INSERTION RECORD. 21440000 EJECT 21460000 *********************************************************************** 21480000 * * 21500000 * WHEN A MEMBER NAME IS ENTERED, ISSUE ERROR MESSAGE THAT DATA * 21520000 * SET IS NOT A PARTITIONED DATA SET. IF A ZERO RETURN CODE IS * 21540000 * RETURNED FROM IKJEBIN3, BRANCH TO VALIDATE OLD DATA SET * 21560000 * ATTRIBUTES. WHEN IKJEBIN3 RETURNS A NON-ZERO RETURN CODE, * 21580000 * TERMINATE EDIT. * 21600000 * * 21620000 *********************************************************************** 21640000 IN002420 EQU * 21660000 LA ERR1REG,INERROR3 RELATIVE ERROR TO BE PROCESSED. 21680000 L EPLOCREG,INMSGRTN ADDRESS OF MESSAGE ROUTINE. 21700000 CALL (15),((COMMREG),(ERR1REG),,(DATA1REG),), X21720000 MF=(E,INSVCRTN) CALL IKJEBIN3 TO ISSUE MESSAGE. 21740000 LTR RETCDREG,RETCDREG CHECK FOR SUCCESSFUL COMPLETION. 21760000 B INEXIT1 DON'T ALLOW WN EDIT OF THIS DS OZ37857 21780000 MVI CAEDMEMB,CHRBLANK REMOVE MEMBER NAME FROM COMMUNI- 21820000 MVC CAEDMEMB+D1(L'CAEDMEMB-D1),CAEDMEMB CATION AREA. 21840000 NI CAEDFLAG,X'FF'-CAEDDSOR INDICATE DS IS SEQUENTIAL 21860000 B IN002010 IF RETURN CODE IS ZERO, BRANCH TO 21880000 * CHECK DATA SET ATTRIBUTES. 21900000 EJECT 21920000 *********************************************************************** 21940000 * * 21960000 * DATA SET ORGANIZATION IS PARTITIONED. * 21980000 * * 22000000 * INDICATE THAT DATA SET ORGANIZATION IS PARTITIONED IN THE * 22020000 * COMMUNICATION AREA. BUILD A DCB AND OPEN FOR BSAM SO THAT * 22040000 * BLDL MAY BE USED TO DETERMINE IF MEMBER EXISTS. IF IT IS NOT * 22060000 * POSSIBLE TO OPEN THE DCB, ISSUE ERROR MESSAGE AND RETURN TO * 22080000 * THE TMP. WHEN OPEN IS SUCCESSFUL, DETERMINE IF USER SPECIFIED * 22100000 * A MEMBER NAME. IF A MEMBER NAME WAS NOT SPECIFIED, DEFAULT * 22120000 * MEMBER TO TEMPNAME. ISSUE THE BLDL MACRO INSTRUCTION TO * 22140000 * DETERMINE IF THE MEMBER EXISTS. UPON RETURN FROM BLDL, SAVE * 22160000 * BLDL RETURN CODE, CLOSE THE DCB, AND UNALLOCATE THE DATA SET. * 22180000 * UPON RETURN FROM UNALLOCATE, TEST RETURN CODE FOR ZERO -- IF * 22200000 * NOT ZERO, BRANCH TO DIAGNOSE ERROR. OTHERWISE, CHECK BLDL * 22220000 * RETURN CODE. * 22240000 * * 22260000 *********************************************************************** 22280000 IN002430 EQU * 22300000 OI CAEDFLAG,CAEDDSOR INDICATE THAT DSORG = PO. 22320000 MVC INWKDCB(INDCBL),INDCB MOVE DCB TO WORK AREA. 22340000 MVC INWKOPEN(INOPENL),INOPEN INITIALIZE OPEN PARAMETER 22360000 * LIST. 22380000 LA AREAREG,INWKDCB ADDRESS OF DCB FOR OPEN. 22400000 MVC INWKDCB+(DCBDDNAM-IHADCB)(L'DCBDDNAM),CAEDDDN MOVE 22420000 * DDNAME INTO DCB. 22440000 OPEN ((AREAREG),(INPUT)),MF=(E,INWKOPEN) OPEN DCB. 22460000 TM INWKDCB+(DCBOFLGS-IHADCB),INOPENED CHECK IF DCB 22480000 * WAS OPENED SUCCESSFULLY. 22500000 BO IN002440 IF DCB OPENED, BRANCH TO DO BLDL. 22520000 * OTHERWISE, ISSUE OPEN FAILED 22540000 * MESSAGE. 22560000 LA ERR1REG,INERRORL RELATIVE ERROR TO BE PROCESSED. 22580000 LA ERR2REG,M3093 RELATIVE SECOND LEVEL MESSAGE. 22600000 B IN010010 BRANCH TO CALL IKJEBIN3 TO PUT 22620000 * ERROR MESSAGE. 22640000 SPACE 2 22660000 IN002440 EQU * 22680000 TM INDSN+INMEMFLG,INOPRNDO DETERMINE IF MEMBER NAME 22700000 * SUPPLIED. 22720000 BO IN002450 IF ENTERED, BRANCH TO ISSUE BLDL. 22740000 MVC CAEDMEMB(L'CAEDMEMB),INTEMPNM SET MEMBER NAME TO 22760000 * TEMPNAME. 22780000 LA PARMREG1,D8 DUMMY UP LENGTH OF MEMBER NAME FOR 22800000 STH PARMREG1,INDSN+INMEMLL MESSAGE INSERTION. 22820000 IN002450 EQU * 22840000 MVC INBLDWD(L'INBLINIT),INBLINIT INITIALIZE LIST WITH 22860000 MVC INMEMBER(L'CAEDMEMB),CAEDMEMB MEMBER NAME FOR BLDL 22880000 LA PARMREG0,INBLDWD ADDRESS OF LIST FOR BLDL. 22900000 BLDL (AREAREG),(0) DETERMINE IF MEMBER EXISTS. 22920000 LR TMPCDREG,RETCDREG SAVE BLDL RETURN CODE. 22940000 MVC INWKOPEN(INCLOSEL),INCLOSE INITIALIZE CLOSE 22960000 * PARAMETER LIST. 22980000 CLOSE ((AREAREG),),MF=(E,INWKOPEN) CLOSE DCB. 23000000 B IN002460(TMPCDREG) BLDL RETURN CODE BRANCH TABLE. 23020000 IN002460 EQU * 23040000 B IN002005 00 - VALIDATE DATA SET ATTRIBUTES. 23060000 B IN002470 04 - PROMPT FOR NEW OR OLD OPERAND. 23080000 * 08 - PERMANENT I/O ERROR. 23100000 LA ERR1REG,INERROR2 RELATIVE ERROR TO BE PROCESSED. 23120000 LA ERR2REG,M3131 RELATIVE SECOND LEVEL MESSAGE. 23140000 LA DATA2REG,ININS002 ADDRESS OF INSERTION TEXT FOR 23160000 * SECOND LEVEL MESSAGE. 23180000 B IN010010 BRANCH TO CALL IKJEBIN3 TO PUT 23200000 * ERROR MESSAGE. 23220000 EJECT 23240000 *********************************************************************** 23260000 * 23280000 * PROMPT FOR NEW/OLD OPERAND IF NOT SPECIFIED ON THE COMMAND. IF * 23300000 * OLD WAS SPECIFIED ORIGINALLY ISSUE ERROR MESSAGE AND RETURN. * 23320000 * 23340000 *********************************************************************** 23360000 IN002470 EQU * 23380000 CLC INSTAT(L'INKEYDEF),INKEYDEF DETERMINE IF USER 23400000 * SPECIFIED OLD. 23420000 BE IN002480 IF OLD SPECIFIED, BRANCH TO PUT 23440000 * ERROR MESSAGE AND TERMINATE. 23460000 BAL SRRTNREG,IN012010 ELSE, ASSUME TO BE NEW @OZ05180 23462000 NI CAEDFLAG,INF255-(CAEDDISP+CAEDMEM) @OZ05180 23464000 B IN002150 PROCESS AS NEW @OZ05180 23466000 IN002480 EQU * 23468000 LA ERR1REG,INERRORI RELATIVE ERROR TO BE PROCESSED. 23470000 LH DATA1REG,INDSN+INMEMLL LENGTH OF MEMBER NAME. 23472000 B IN010010 BRANCH TO CALL IKJEBEIA TO PUT 23474000 * ERROR MESSAGE AND RETURN. 23476000 EJECT 23760000 *********************************************************************** 23780000 * * 23800000 * SEARCH TIOT FOR POINTER TO THE UCB FOR THE EDIT DATA SET @ZA08735* 23806000 * TO GET THE VOLID. @ZA08735* 23812000 * * 23920000 *********************************************************************** 23940000 IN002005 EQU * 23960000 OI CAEDFLAG,CAEDMEM INDICATE THAT MEMBER IS OLD. 23980000 IN002010 EQU * 24000000 L AREAREG,CVTPTR ADDRESSOF CVT. @ZA08735 24010000 USING CVT,AREAREG ADDRESS IN CVT DSECT. @ZA08735 24020000 L AREAREG,CVTTCBP ADDRESS NEXT AND CURRENT TCB @ZA08735 24040000 * POINTERS @ZA08735 24060000 DROP AREAREG @ZA08735 24080000 L AREAREG,CURNTTCB(PARMREG0,AREAREG) ADDRESS OF @ZA08735 24100000 * CURRENT TCB @ZA08735 24120000 L AREAREG,(TCBTIO-TCB)(,AREAREG) ADDRESS OF TIOT. @ZA08735 24140000 USING IEFTIOT1,AREAREG ADDRESSABILITY IN TIOT DSECT. @ZA08735 24160000 IN002050 EQU * @ZA08735 24180000 SR LENREG,LENREG ZERO LENGTH REG. @ZA08735 24200000 IC LENREG,TIOELNGH LENGTH OF TIOT ENTRY. @ZA08735 24220000 LTR LENREG,LENREG CHECK IF END OF TIOT REACHED. @ZA08735 24240000 BZ IN002055 IF END OF TIOT, BRANCH TO PUT @ZA08735 24260000 * ERROR MESSAGE AND RETURN TO TMP.@ZA08735 24280000 CLC TIOEDDNM(L'CAEDDDN),CAEDDDN CHECK IF THIS ENTRY @ZA08735 24300000 * IS FOR THE EDIT DATA SET. @ZA08735 24320000 BE IN002060 IF SO, BRANCH TO GET UCB ADDR. @ZA08735 24340000 LA AREAREG,D0(LENREG,AREAREG) UPDATE TIOT POINTER @ZA08735 24360000 * TO NEXT ENTRY. @ZA08735 24380000 B IN002050 BRANCH TO CHECK NEXT ENTRY IN TIOT.@ZA08735 24400000 IN002055 EQU * @ZA08735 24420000 LA ERR1REG,INERRORF RELATIVE ERROR TO PROCESS @ZA08735 24440000 LA ERR2REG,M4245 RELATIVE SECOND LEVEL MESSAGE @ZA08735 24460000 B IN010010 BRANCH TO CALL IKJEBIN3 TO PUT @ZA08735 24480000 * MESSAGE TO TERMINAL. @ZA08735 24500000 IN002060 EQU * @ZA08735 24520000 L AREAREG,TIOEFSRT-D1 ADDRESS OF UCB, @ZA08735 24540000 DROP AREAREG @ZA08735 24560000 IN002070 EQU * @ZA08735 24580000 USING IEFUCBOB,AREAREG ADDRESSABILITY IN UCB DSECT. @ZA08735 24590000 MVC INDSNAME,CAEDDSN MOVE DSN TO OBTAIN @ZA08735 24600000 * PARM LIST @ZA08735 24610000 MVC INCAMVLD(L'INCAMVLD),UCBVOLI MOVE VOLID TO @ZA08735 24620000 * OBTAIN PARM LIST @ZA08735 24630000 TM UCBTBYT3,UCB3DACC CHECK IF DA DEVICE. @ZA08735 24640000 BNZ IN002080 IF SO, CONTINUE NORMAL PROCESSING. @ZA08735 24650000 LA ERR1REG,INERRORQ SPECIFY RELATIVE ERROR. @ZA08735 24660000 B IN010010 BRANCH TO CALL IKJEBIN3 TO PUT @ZA08735 24670000 EJECT 24680000 *********************************************************************** 24690000 * * 24700000 * ASSUME EDIT DSN IS ALIAS, FIRST OBTAIN GOT RET CODE 8. @ZA08735* 24710000 * ISSUE LOCATE MACRO TO GET PRIMARY DSN AND VOLID. @ZA08735* 24720000 * * 24730000 *********************************************************************** 24740000 IN002075 EQU * 24940000 MVC INDSNAME(44),CAEDDSN MOVE EDIT DSNAME TO @ZA05823 24943000 * LOCATE PARAMETER LIST @ZA05823 24946000 MVC INCAMFLG(LOCATLEN),LOCATEDS INIT LOCATE PARMS @ZA05823 24949000 LA RETCDREG,INDSNAME POINT TO LOCATE DSNAME @ZA05823 24952000 LA PARMREG0,0(0,0) ZERO OUT RESERVED FIELD @ZA05823 24955000 LA PARMREG1,INCAMOBT LOAD WORK AREA ADDRESS @ZA05823 24960000 STM RETCDREG,PARMREG1,INCAMDSN FILL OUT PARMLIST @ZA05823 24960600 LOCATE INCAMFLG BE SURE WE HAVE TRUE DSNAME @ZA05823 24961200 MVC INCAMVLD(L'INCAMVLD),LOCATVLD MOVE VOLID TO @ZA08735 24961800 * OBTAIN PARM LIST @ZA08735 24962400 LTR RETCDREG,RETCDREG CHECK LOCATE RETURN CODE @ZA05823 24963000 BNZ IN002078 ONLY RC = ZERO IS VALID @ZA08735 24963600 EJECT @ZA05823 24964200 *********************************************************************** 24964800 * * 24965400 * ASSUME EDIT DSN IS AN ALIAS. ISSUE OBTAIN MACRO AGAIN @ZA08735* 24966000 * * 24966600 * USING PRIMARY DSN AND VOLID TO GET DSCB @ZA08735* 24967200 *********************************************************************** 24967800 IN002076 EQU * @ZA08735 24968400 MVC INCAMFLG(INCAMEND),INCAMLST INITIALIZE FLAGS @ZA08735 24969000 * FOR OBTAIN @ZA08735 24969600 LA RETCDREG,INDSNAME ADDRESS OF DATA SET NAME @ZA08735 24970200 LA PARMREG0,INCAMVLD ADDRESS OF VOLUME SERIAL NMBR @ZA08735 24970800 LA PARMREG1,INCAMOBT ADDRESS OF OBTAIN WORKAREA. @ZA08735 24971400 STM RETCDREG,PARMREG1,INCAMDSN INITIALIZE POINTERS @ZA08735 24972000 * IN OBTAIN PARAMETER LIST. @ZA08735 24972600 OBTAIN INCAMFLG OBTAIN DSCB FOR DATA SET. @ZA08735 24973200 B IN002077(RETCDREG) BRANCH TO TABLE TO DIAGNOSE @ZA08735 24973800 * RETURN CODE FROM OBTAIN. @ZA08735 24974400 * @ZA08735 24975000 * THE BRANCH TABLE BELOW IS POSITION DEPENDENT. @ZA08735 24975600 * @ZA08735 24976200 IN002077 EQU * @ZA08735 24976800 B IN002085 00 - NORMAL RETURN @ZA08735 24977400 B IN002310 04 - REQUIRED VOLUME NOT MOUNTED @ZA08735 24980000 B IN002325 08 - DATA SET NOT ON VOLUME @ZA08735 24980500 B IN002084 12 - PERMANENT I/O ERROR @ZA08735 24981000 B IN002084 16 - INVALID PARAMETERS TO OBTAIN@ZA08735 24981500 B IN002084 20 - CCHH NOT WTHIN BOUNDARIES O@ZA08735 24982000 * VTOC EXTENT @ZA08735 24982500 EJECT @ZA05823 24983000 ***************************************************************@ZA05823 24983500 * @ZA05823 24984000 * ISSUE COMMAND SYSTEM ERROR MSG IF LOCATE RETURN CODE @ZA05823 24984500 * WAS NON ZERO. @ZA05823 24985000 * @ZA05823 24985500 ***************************************************************@ZA05823 24986000 SPACE 5 @ZA05823 24986500 IN002078 CVD RETCDREG,INCVDAR CONVERT RETURN CODE AND @ZA05823 24987000 UNPK INUNPKAR(8),INCVDAR MAKE IT PRINTABLE @ZA05823 24987500 OI INUNPKAR+7,X'F0' BY OR-ING ON ALL ZONE BITS @ZA05823 24988000 MVC INMSGBUF(ININSLEN),ININS006 MOVE MODEL INSERTS @ZA05823 24988500 MVC INMSGBUF+ININSLEN-2(2),INUNPKAR+6 AND RETCODE @ZA05823 24989000 LA DATA2REG,INMSGBUF+ININS6LN CHAIN UP SECOND @ZA05823 24989500 ST DATA2REG,INMSGBUF LEVEL INSERTS @ZA05823 24990000 LA ERR1REG,INERROR2 LOAD RELATIVE ERROR NUMBER @ZA05823 24990500 LA ERR2REG,M3131 AND 2D LVL MSG NUMBER @ZA05823 24991000 LA DATA1REG,0(0,0) ZERO 1ST LVL INSERT PTR @ZA05823 24991500 LA DATA2REG,INMSGBUF POINT TO 2D LVL INSERTS @ZA05823 24992000 B IN010010 GO TO CALL IKJEBIN3 TO @ZA05823 24992500 * ISSUE MSG IKJ52313I @ZA05823 24993000 EJECT @ZA05823 24993500 *********************************************************************** 24994000 * * 24994500 * OBTAIN FORMAT ONE DSCB FOR THE EDIT DATA SET. @ZA08735* 24995000 * * 24995500 *********************************************************************** 24996000 IN002080 EQU * 24996500 MVC INCAMFLG(INCAMEND),INCAMLST INITIALIZE FLAGS FOR 25020000 * OBTAIN. 25040000 LA RETCDREG,INDSNAME ADDRESS OF DATA SET NAME @ZA05823 25050000 LA PARMREG0,INCAMVLD ADDRESS OF VOLUME SERIAL NUMBER. 25080000 LA PARMREG1,INCAMOBT ADDRESS OF OBTAIN WORKAREA. 25100000 STM RETCDREG,PARMREG1,INCAMDSN INITIALIZE POINTERS IN 25120000 * OBTAIN PARAMETER LIST. 25140000 OBTAIN INCAMFLG OBTAIN DSCB FOR DATA SET. 25160000 B IN002082(RETCDREG) BRANCH TO TABLE TO DIAGNOSE 25180000 * RETURN CODE FROM OBTAIN. 25200000 * 25220000 * THE BRANCH TABLE BELOW IS POSITION DEPENDENT. 25240000 * 25260000 IN002082 EQU * 25280000 B IN002085 00 - NORMAL RETURN 25300000 B IN002310 04 - REQUIRED VOLUME NOT MOUNTED 25320000 B IN002075 08 - DATA SET NOT ON VOLUME @ZA08735 25330000 B IN002084 12 - PERMANENT I/O ERROR 25360000 B IN002084 16 - INVALID PARAMETERS TO OBTAIN 25380000 * 20 - CCHH NOT WITHIN BOUNDARIES OF 25400000 * VTOC EXTENT 25420000 EJECT 25440000 *********************************************************************** 25460000 * 25480000 * ISSUE COMMAND SYSTEM ERROR MESSAGE FOR OBTAIN RETURN CODES 12, 16 25500000 * AND 20. 25520000 * 25540000 *********************************************************************** 25560000 IN002084 EQU * 25580000 LA ERR1REG,INERROR2 RELATIVE ERROR TO BE PROCESSED. 25600000 LR DATA2REG,RETCDREG SAVE RETURN CODE FOR MESSAGE. 25620000 O DATA2REG,INSVCOBT INDICATE ROUTINE NAME AS OBTAIN. 25640000 B IN010010 BRANCH TO CALL IKJEBIN3 TO PUT 25660000 * ERROR MESSAGE AND RETURN. 25680000 EJECT 25700000 IN002085 EQU * 25720000 LA AREAREG,INCAMOBT ADDRESS OF DSCB RETURNED BY 25760000 * OBTAIN. 25780000 USING IECDSCB1+(DS1FMTID-IECSDSL1),AREAREG 25800000 * ADDRESSABILITY IN DSCB DSECT. 25820000 LA PARMREG0,X1(,D0) SET TAG REGISTER TO 1. 25840000 MVC CAUTILNO+D1(L'DS1LSTAR),DS1LSTAR SAVE LAST BLOCK 25860000 * POINTER FOR CALCULATION OF 25880000 * OLD DATA SET SIZE. 25900000 CLC DS1LSTAR(L'DS1LSTAR),INDSMTY DETERMINE IF DATA SET 25920000 * HAS BEEN WRITTEN INTO. 25940000 BNE IN002100 IF NOT ZERO, BRANCH TO CHECK DSORG. 25960000 CLC DS1TRBAL(L'DS1TRBAL),INDSMTY IF BOTH DS1LSTAR ZA32095 25963000 * AND DS1TRBAL ARE ZERO THIS IS A ZA32095 25966000 BE IN002396 MULTIPLE VOLUME DATA SET NOT ZA32095 25969000 * SUPPORTED BY EDIT ZA32095 25972000 * EMPTY DATA SET PROCEED WITH EDIT ZA32095 25975000 SR PARMREG0,PARMREG0 SET TAG REGISTER TO ZERO. 25980000 NI CAEDFLAG,INF255-CAEDDISP INDICATE DATA SET IS 26000000 * EMPTY AND IS TO BE PROCESSED 26020000 * AS NEW. 26040000 CLI DS1DSORG,DS1ORGPS DETERMINE IF SEQUENTIAL. 26060000 BE IN002110 IF DSORG=PS, BRANCH TO SET FLAG IN 26080000 * THE COMMUNICATION AREA. 26100000 CLI DS1DSORG,D0 DETERMINE IF DSORG HAS BEEN 26120000 * ESTABLISHED FOR THE DATA SET. 26140000 BE IN003100 IF DSORG IS NOT SET, BRANCH TO 26160000 * PROCESS AS A NEW DATA SET. 26180000 SPACE 5 26200000 IN002090 EQU * 26220000 *********************************************************************** 26240000 * 26260000 * AN INVALID DSORG ENCOUNTERED, PUT MESSAGE TO USER AND RETURN 26280000 * TO THE TMP. 26300000 * 26320000 *********************************************************************** 26340000 LA ERR1REG,INERROR4 RELATIVE ERROR TO BE PROCESSED. 26360000 LA DATA1REG,DS1DSORG ADDRESS OF DSORG FIELD. 26380000 B IN010010 BRANCH TO CALL IKJEBIN3 TO PUT 26400000 * ERROR MESSAGE AND RETURN. 26420000 EJECT 26440000 IN002100 EQU * 26460000 * 26480000 * DATA SET CONTAINS RECORDS (DS1LSTAR NOT ZERO) 26500000 * 26520000 CLI DS1DSORG,DS1ORGPS DETERMINE IF DSORG IS SEQUENTIAL 26540000 BE IN002110 IF PS, BRANCH TO CHECK RECFM. 26560000 TM DS1DSORG,DS1ORGPO DETERMINE IF DSORG IS ZA33984 26580000 * PARTITIONED. 26600000 BNO IN002090 NEITHER PS OR PO, BRANCH TO PUT ZA33984 26620000 * ERROR MESSAGE. 26640000 OI CAEDFLAG,CAEDDSOR INDICATE DATA SET HAS DSORG = PO 26660000 IN002110 EQU * 26680000 * 26700000 * DSORG = PS OR PO. 26720000 * 26740000 TM DS1RECFM,DS1FMUDF CHECK FOR UNDEFINED FORMAT. Y01676 26740500 BO IN002120 IF SO, BRANCH TO SEND ERROR MSG. Y01676 26741000 BZ IN002132 IF NOT DEFINED, IT IS NEW, Y01676 26741500 * PRE-ALLOCATED DATA SET. Y01676 26742000 TM DS1RECFM,DS1FMOVF CHECK FOR TRACK OVERFLOW Y01676 26742500 * FORMAT. Y01676 26743000 BO IN002120 IF SO, BRANCH TO SEND ERROR MSG. Y01676 26743500 TM DS1RECFM,DS1FMVAR+DS1FMSTD CHECK FOR SPANNED Y01676 26744000 * RECORDS. Y01676 26744500 BNO IN002125 IF NOT, BR TO PROCESS VALID FORMAT Y01676 26745000 SPACE 5 27020000 IN002120 EQU * 27040000 *********************************************************************** 27060000 * 27080000 * INVALID RECORD FORMAT ENCOUNTERED, PUT MESSAGE TO USER AND 27100000 * RETURN TO THE TMP. 27120000 * 27140000 *********************************************************************** 27160000 LA ERR1REG,INERROR5 RELATIVE ERROR TO BE PROCESSED. 27180000 LA DATA1REG,DS1RECFM ADDRESS OF RECFM FIELD. 27200000 B IN010010 BRANCH TO CALL IKJEBEIA TO PUT 27220000 * ERROR MESSAGE AND RETURN. 27240000 EJECT 27260000 IN002125 EQU * Y01676 27260200 TM DS1RECFM,DS1FMA+DS1FMM CHECK FOR CONTROL Y01676 27260500 * CHARACTER FORMATS. Y01676 27261000 BZ IN002130 IF NOT, CONTINUE PROCESSING. Y01676 27261500 OI CAEDFLG2,CAEDPRTC IF SO, INDICATE CONTROL Y01676 27262000 * CHARACTER PRESENCE. Y01676 27262500 IN002130 EQU * 27280000 * 27300000 * DSORG PS OR PO AND RECFM IS FIXED OR VARIABLE -- DETERMINE 27320000 * WHICH. 27340000 * 27360000 TM DS1RECFM,DS1FMVAR DETERMINE IF RECFM = V. 27380000 BO IN002140 IF RECFM=V, BRANCH TO OBTAIN LRECL. 27400000 B IN002135 RECORD FORMAT IS FIXED, BR TO Y01676 27400500 * PROCESS. Y01676 27401000 * A42947 27460000 * RECFM NOT INITIALIZED FOR DATA SET -- DETERMINE DEFAULT. A42947 27480000 * A42947 27500000 IN002132 EQU * Y01676 27500500 TM CARECFMD,CARECFMV DETERMINE IF RECFM=V IS DEFLT. A42947 27520000 BO IN002140 IF RECFM DEFLT = V, OBTAIN LRECL. A42947 27540000 IN002135 EQU * A42947 27560000 OI CACFLAG2,CARECFM INDICATE THAT DATA SET HAS 27580000 * RECFM = F. 27600000 IN002140 EQU * 27620000 MVC CALRECL(L'CALRECL),DS1LRECL MOVE LRECL TO THE 27640000 * COMMUNICATION AREA. 27660000 LTR PARMREG0,PARMREG0 CHECK TAG REGISTER AND SET NEW 27680000 BZ IN003100 FLAG BASED ON DS1LSTAR CONTENT 27700000 OI CAEDFLAG,CAEDDISP INDICATE THAT DATA SET IS OLD. 27720000 MVC CABLKS(L'CABLKS),DS1BLKL UPDATE BLOCK SIZE FOR OLD 27740000 * DATA SETS. 27760000 TM CAEDFLAG,CAEDDSOR CHECK IF DSORG = PO. 27780000 BZ IN002940 IF NOT PO, BRANCH TO VALIDATE 27800000 * COMMAND OPERANDS. 27820000 IN002150 EQU * 27840000 * 27860000 * UNALLOCATE THE DATA SET. 27880000 * 27900000 L PASSREG,CAPTTMP ADDRESS OF TMP PARAMETER LIST. 27920000 L PASSREG,(CPPLPSCB-CPPL)(,PASSREG) ADDRESS OF PSCB. 27940000 LA AREAREG,CAEDDSNL ADDRESS OF DATA SET NAME LENGTH 27960000 * AND DATA SET NAME. 27980000 MVC INDREC(INDR18L),INDR18 INITIALIZE IKJDAIR 28000000 * PARAMETER LIST - ENTRY CODE 18 28020000 ST AREAREG,INDREC+(DA18PDSN-DAPB18) PUT ADDRESS OF 28040000 * DSNAME IN PARAMETER LIST. 28060000 LA AREAREG,INDREC ADDRESS OF IKJDAIR PARAMETER LIST. 28080000 LA PARMREG1,CATMPLST LOAD PARAM REG 1 @YA02225 28082000 LR RETREG,(PASSREG) PICK UP PARAMETER @YA02225 28084000 LR RETCDREG,(AREAREG) PICK UP PARAMETER @YA02225 28086000 STM 14,15,12(1) STORE INTO PARAM LIST @YA02225 28088000 CALLTSSR EP=IKJDAIR,MF=(E,CATMPLST) INVOKE DAIR @YA02225 28090000 * SERVICE ROUTINE @YA02225 28092000 LTR RETCDREG,RETCDREG TEST FOR RETURN CODE OF ZERO. 28140000 BZ IN002190 IF NOT, BRANCH TO CONTINUE NORMAL 28160000 * PROCESSING. 28180000 CH RETCDREG,INDRRC24 CHECK IF DATA SET UNALLOCATED YA00002 28182000 * BELONGS TO CONCATENATED GRP. YA00002 28183000 BE IN002190 IF SO, BRANCH TO CONTINUE PROCESS YA00002 28184000 IN002160 EQU * YA00002 28184200 CH RETCDREG,INDAIR08 CHECK FOR CATALOG ERROR. YA00002 28186000 BL IN002270 INVALID PARAMETERS, SEND MESSAGE. YA00002 28188000 BE IN002170 CATLG MGMT ERROR, SEND MESSAGE. YA00002 28190000 CH RETCDREG,INDAIR16 CHECK FOR DYN ALLOC. ERROR. YA00002 28192000 BL IN002180 IF SO, SEND MESSAGE. YA00002 28194000 CH RETCDREG,INDAIR48 CHECK FOR DAIR STAE ENTERED. YA00002 28196000 BNE IN002270 IF NOT, BR TO SEND GENERAL YA00002 28196200 * ERROR MESSAGE. YA00002 28196400 BE INEXIT12 IF SO, BR TO TERMINATE WITHOUT YA00002 28198000 * ERROR MESSAGE. YA00002 28200000 IN002170 EQU * 28440000 LA ERR2REG,M4244 SPECIFY CATALOG ERROR. 28460000 LH DATA2REG,INDREC+(DA18CTRC-DAPB18) ACQUIRE CTRC. 28480000 B IN002185 BRANCH TO CONTINUE ERROR PROCESSING. 28500000 IN002180 EQU * 28520000 LA ERR2REG,M4242 SPECIFY DYNAMIC ALLOCATION ERROR. 28540000 LH DATA2REG,INDREC+(DA18DARC-DAPB18) ACQUIRE DARC. 28560000 IN002185 EQU * 28580000 LA ERR1REG,INERRORF SPECIFY RELATIVE ERROR. 28600000 B IN010010 BRANCH TO CALL IKJEBIN3 TO PUT 28620000 * MESSAGE TO THE TERMINAL. 28640000 IN002190 EQU * 28660000 NI CAEDFLAG,INF255-CAEDALOC INDICATE DATA SET NO 28680000 * LONGER ALLOCATED. 28700000 TM CAEDFLAG,CAEDMEM CHECK IF NEW MEMBER IS TO BE 28720000 * CREATED. 28740000 BZ IN003100 IF SO, BRANCH TO VALIDATE COMMAND 28760000 * OPERANDS. 28780000 * 28800000 * ALLOCATE DATA SET WITH MEMBER NAME SPECIFIED. 28820000 * 28840000 MVC INDREC(INDR8OLL),INDAIR8O INITIALIZE IKJDAIR 28860000 * PARAMETER LIST. 28880000 MVC INDREC+(DA08MNM-DAPB08)(L'CAEDMEMB),CAEDMEMB MOVE 28900000 * MEMBER NAME TO PARAMETER LIST. 28920000 TM INDSN+INPSWFLG,INOPRNDO DETERMINE IF PASSWORD WAS 28940000 * ENTERED. 28960000 BZ IN002930 IF NOT, BRANCH TO CALL IKJDAIR. 28980000 MVC INDREC+(DA08PSWD-DAPB08)(L'CAEDPSWD),CAEDPSWD MOVE 29000000 * PASSWORD TO PARAMETER LIST. 29020000 IN002930 EQU * 29040000 LA AREAREG,CAEDDSNL GET ADDRESS OF DSNAME AND PLACE 29060000 ST AREAREG,INDREC+(DA08PDSN-DAPB08) IN IKJDAIR 29080000 * PARAMETER LIST. 29100000 LA AREAREG,INDREC ADDRESS OF IKJDAIR PARAMETER BLOCK. 29120000 L PASSREG,CAPTTMP ADDRESS OF TMP PARAMETER LIST. 29140000 L PASSREG,(CPPLPSCB-CPPL)(,PASSREG) ADDRESS OF PSCB. 29160000 OI INDREC+(DA08DSP1-DAPB08),DA08SHR INDICATE DISP=SHR 29180000 * FOR OLD, PARTITIONED DATA SETS 29200000 LA PARMREG1,CATMPLST LOAD PARAM REG 1 @YA02225 29202000 LR RETREG,(PASSREG) PICK UP PARAMETER @YA02225 29204000 LR RETCDREG,(AREAREG) PICK UP PAREMETER @YA02225 29206000 STM 14,15,12(1) STORE INTO PARAM LIST @YA02225 29208000 CALLTSSR EP=IKJDAIR,MF=(E,CATMPLST) INVOKE DAIR @YA02225X29210000 SERVICE ROUTINE @YA02225 29212000 LTR RETCDREG,RETCDREG CHECK IF DATA SET ALLOCATED. 29260000 BNZ IN002260 IF DATA SET NOT ALLOCATED, YA00002 29280000 * BRANCH TO SELECT DIAGNOSTIC 29300000 * AND RETURN TO TMP. 29320000 OI CAEDFLAG,CAEDALOC INDICATE DATA SET ALLOCATED. 29340000 MVC CAEDDDN(L'CAEDDDN),INDREC+(DA08DDN-DAPB08) MOVE 29360000 * DDNAME RETURNED BY IKJDAIR TO 29380000 * THE COMMUNICATION AREA. 29400000 IN002940 EQU * 29420000 * 29440000 * AN OLD SEQUENTIAL DATA SET OR AN EXISTING PARTITIONED DATA 29460000 * SET(MEMBER) HAS BEEN SUCCESSFULLY ALLOCATED, AND ITS DDNAME 29480000 * AND LRECL ARE IN THE COMMUNICATION AREA. 29500000 * 29520000 SR PARMREG0,PARMREG0 SET ENTRY CODE TO ZERO FOR 29540000 * IKJEBIN8 (OPERAND VALIDATION) 29560000 * SUBROUTINE. 29580000 B IN003110 BRANCH TO CALL IKJEBIN8. 29600000 EJECT 29620000 *********************************************************************** 29640000 * 29660000 * CALL OPERAND VALIDITY CHECKING ROUTINE TO VERIFY THAT ALL 29680000 * OPERANDS SPECIFIED ON THE COMMAND ARE ACCEPTABLE. UPON 29700000 * RETURN FROM IKJEBIN8, TEST THE RETURN CODE FOR SUCCESSFUL 29720000 * COMPLETION. IF SUCCESSFUL (RETURN CODE = 0), BRANCH TO XCTL 29740000 * TO IKJEBEMA. IF UNSUCCESSFUL (RETURN CODE = 4), BRANCH TO 29760000 * TERMINATE EDIT. 29780000 * 29800000 * NOTE -- AN ENTRY CODE IS SET IN REGISTER ZERO (0) PRIOR TO 29820000 * CALLING IKJEBIN8 -- 29840000 * 29860000 * 00 - OLD DATA SET 29880000 * 04 - NEW DATA SET 29900000 * 29920000 *********************************************************************** 29940000 SPACE 2 29960000 IN003100 EQU * 29980000 LA PARMREG0,D4(,D0) SET ENTRY CODE FOR IKJEBEIE 30000000 * (OPERAND VALIDATION) ROUTINE. 30020000 IN003110 EQU * 30040000 CALL IKJEBIN8,((COMMREG),(DATAREG)), X30060000 MF=(E,INSVCRTN) CALL OPERAND VALIDATION ROUTINE. 30080000 LTR RETCDREG,RETCDREG CHECK FOR SUCCESSFUL COMPLETION. 30100000 BNZ INEXIT1 IF IKJEBIN8 RETURNED A NON-ZERO 30120000 * RETURN CODE, BRANCH TO RETURN 30140000 * TO THE TMP. 30160000 EJECT 30180000 IN008030 EQU * 30200000 *********************************************************************** 30220000 * * 30240000 * CHECK STATUS OF EDIT DATA SET. * 30260000 * * 30280000 * COMPUTE LOGICAL RECORD SIZE FOR ALL SUBCOMMAND PROCESSORS AND * 30300000 * SERVICE ROUTINES. EDIT LRECL IS THE LRECL FOR THE DATA SET + 4 * 30320000 * (LENGTH OF CONTROL WORD FOR EACH). * 30340000 * * 30360000 * DETERMINE WHETHER DATA SET IS OLD OR NEW. IF DATA SET IS NEW, * 30380000 * SET INDICATION THAT INPUT MODE SHOULD BE ENTERED INITIALLY. IF * 30400000 * DATA SET IS OLD, CHECK IF A PARTITIONED DATA SET. IF NOT A * 30420000 * PDS, LOAD IKJEBEUT (THE EDIT UTILITY INTERFACE ROUTINE) INTO * 30440000 * MAIN STORAGE AND INITIALIZE 'CAPTUT' IN THE EDIT COMMUNICATION * 30460000 * AREA WITH ITS ENTRY POINT ADDRESS. CALL IKJEBECO TO COPY THE * 30480000 * EDIT DATA SET TO THE UTILITY DATA SET. IF A PDS, PERFORM THE * 30500000 * COPY ONLY IF THE MEMBER EXISTS. UPON RETURN FROM IKJEBECO, * 30520000 * DELETE THE UTILITY INTERFACE ROUTINE (IKJEBEUT). * 30540000 * * 30560000 *********************************************************************** 30580000 TM CACFLAG2,CARECFM CHECK IF RECFM IS VARIABLE. 30600000 BZ IN008035 IF RECFM = V, LRECL ALREADY IS 4 30620000 * GREATER THAN DATA PORTION OF 30640000 * RECORD, BRANCH AROUND 30660000 * COMPUTATION FOR RECFM = F. 30680000 LH LENREG,CALRECL OBTAIN LRECL FOR EDIT DATA SET. 30700000 LA LENREG,D4(PARMREG0,LENREG) ADD 4 TO LRECL (FOR 30720000 STH LENREG,CALRECL CONTROL WORD) AND SAVE. 30740000 IN008035 EQU * 30760000 TM CAEDFLAG,CAEDDSOR CHECK IF DSORG = PS. 30780000 BZ IN008040 IF DSORG = PS, BRANCH TO CHECK 30800000 * NEW/OLD STATUS. 30820000 TM CAEDFLAG,CAEDMEM WHEN DSORG = PO, CHECK IF 30840000 * MEMBER ALREADY EXISTS. 30860000 BO IN009010 IF MEMBER EXISTS, BRANCH TO CALL 30880000 * IKJEBECO. 30900000 B IN009030 IF MEMBER IS TO BE CREATED, BRANCH 30920000 * TO CALL IKJEBEUI. 30940000 IN008040 EQU * 30960000 TM CAEDFLAG,CAEDDISP CHECK IF DISPOSITION IS OLD. 30980000 BZ IN009030 IF NEW, BRANCH TO INDICATE INPUT 31000000 * MODE TO BE CALLED. 31020000 IN009010 EQU * 31040000 OI CAEDFLAG,CAEDINCP INDICATE TO INITIAL COPY THAT 31060000 * EDIT DATA SET IS TO BE COPIED. 31080000 LOAD EP=IKJEBEUT LOAD UTILITY INTERFACE ROUTINE. 31100000 ST PARMREG0,CAPTUT SAVE ENTRY POINT ADDRESS IN THE 31120000 * COMMUNICATION AREA. 31140000 IKJEBESH (COMMREG),IKJEBECO,PARAM=((COMMREG)), X31160000 MF=(E,INSVCRTN) CALL INITIAL COPY ROUTINE. 31180000 NI CAEDFLAG,INF255-CAEDINCP TURN OF INITIAL COPY FLAG 31200000 * FOR EDIT DATA SET. 31220000 IN009020 EQU * 31240000 B IN009020+D4(RETCDREG) IKJEBECO RETURN CODE BRANCH 31260000 * TABLE. 31280000 B IN009025 RETURN CODE 0, BRANCH TO DELETE 31300000 * IKJEBEUT. 31320000 B IN009060 RETURN CODE 4, BRANCH TO INDICATE 31340000 * INPUT MODE TO BE INITIALLY 31360000 * ENTERED. 31380000 B INEXIT1 RETURN CODE = 8, BRANCH TO RETURN 31400000 * TO THE TMP. 31420000 IN009025 EQU * 31440000 DELETE EP=IKJEBEUT DELETE UTILITY INTERFACE ROUTINE X31460000 FROM MAIN STORAGE. 31480000 B IN009067 BRANCH TO UNALLOCATE DATA SET (IF A 31500000 * PDS) AND XCTL TO IKJEBEMA. 31520000 EJECT 31540000 IN009030 EQU * 31560000 *********************************************************************** 31580000 * * 31600000 * DATA SET IS NEW. * 31620000 * * 31640000 * WHEN A NEW DATA SET IS TO BE PROCESSED, LINK TO IKJEBEUI TO * 31660000 * INITIALIZE THE EDIT ACCESS METHOD. UPON RETURN FROM IKJEBEUI, * 31680000 * DETERMINE IF IKJEBEUI WAS SUCCESSFUL. IF IKJEBEUI IS NOT * 31700000 * SUCCESSFUL, BRANCH TO INFORM USER AND TO RETURN TO TMP. * 31720000 * * 31740000 * IF IKJEBEUI IS SUCCESSFUL, PLACE ADDRESS OF UTILITY DCB IN THE * 31760000 * COMMUNICATION AREA AND XCTL TO IKJEBEMA. * 31780000 * * 31800000 *********************************************************************** 31820000 LINK EP=IKJEBEUI,DCB=0,MF=(E,(COMMREG)),SF=(E,INLINKSF) 31840000 LTR RETCDREG,RETCDREG CHECK IF IKJEBEUI SUCCESSFULLY 31860000 * INITIALIZED ACCESS METHOD. 31880000 BNZ INEXIT1 IF UNSUCCESSFUL, BRANCH TO RETURN 31900000 * TO TMP. 31920000 ST PARMREG0,CAPTCDCB SAVE ADDRESS OF DCB IN 31940000 * COMMUNICATION AREA. 31960000 B IN009062 @ZA86100 31970000 IN009060 EQU * 31980000 NI CAEDFLAG,INF255-CAEDDISP DATA SET IS NEW @ZA86100 31986600 IN009062 EQU * 31993200 TM CAEDFLAG,CAEDDSOR CHECK IF DSORG = PS. 32000000 BZ IN009065 IF DSORG = PS, BRANCH TO INDICATE 32020000 * INPUT MODE BE ENTERED. 32040000 NI CAEDFLAG,INF255-CAEDMEM FOR DSORG = PO, INDICATE 32060000 * THAT MEMBER IS TO BE CREATED. 32080000 B IN009070 BRANCH TO XCTL TO IKJEBEMA. 32100000 IN009065 EQU * 32120000 NI CAEDFLAG,INF255-CAEDDISP INDICATE THAT DATA SET IS 32140000 * NEW AND THAT IKJEBEIP TO BE 32160000 * ENTERED INITIALLY. 32180000 B IN009070 BRANCH TO XCTL TO IKJEBEMA. 32200000 EJECT 32220000 IN009067 EQU * 32240000 *********************************************************************** 32260000 * * 32280000 * UNALLOCATE DATA SET IF EDIT DATA SET IS AN OLD PARTITIONED DATA * 32300000 * SET. * 32320000 * * 32340000 *********************************************************************** 32360000 TM CAEDFLAG,CAEDALOC+CAEDMEM+CAEDDSOR CHECK IF EDIT 32380000 * DATA SET IS AN OLD PDS THAT IS 32400000 * CURRENTLY ALLOCATED. 32420000 BNO IN009070 IF NOT OLD AND ALLOCATED, BRANCH TO 32440000 * XCTL TO THE MAIN CONTROLLER. 32460000 L PASSREG,CAPTTMP ADDRESS OF TMP PARAMETER LIST. 32480000 L PASSREG,(CPPLPSCB-CPPL)(,PASSREG) ADDRESS OF PSCB. 32500000 LA AREAREG,CAEDDSNL ADDRESS OF DATA SET NAME LENGTH 32520000 * AND DATA SET NAME. 32540000 MVC INDREC(INDR18L),INDR18 INITIALIZE IKJDAIR 32560000 * PARAMETER LIST - ENTRY CODE 18 32580000 MVC INDREC+(DA18MNM-DAPB18)(L'CAEDMEMB),CAEDMEMB MOVE 32600000 * MEMBER NAME TO PARAMETER LIST. 32620000 ST AREAREG,INDREC+(DA18PDSN-DAPB18) PUT ADDRESS OF 32640000 * DSNAME IN PARAMETER LIST. 32660000 LA AREAREG,INDREC ADDRESS OF IKJDAIR PARAMETER LIST. 32680000 LA PARMREG1,CATMPLST LOAD PARAM REG 1 @YA02225 32682000 LR RETREG,(PASSREG) PICK UP PARAMETER @YA02225 32684000 LR RETCDREG,(AREAREG) PICK UP PARAMETER @YA02225 32686000 STM 14,15,12(1) STORE INTO PARAM LIST @YA02225 32688000 CALLTSSR EP=IKJDAIR,MF=(E,CATMPLST) INVOKE DAIR @YA02225X32690000 SERVICE ROUTINE @YA02225 32692000 LTR RETCDREG,RETCDREG TEST FOR RETURN CODE OF ZERO. 32740000 BZ IN009068 IF RETURN CODE IS ZERO, BRANCH TO 32760000 * CONTINUE NORMAL PROCESSING. 32780000 CH RETCDREG,INDRRC24 CHECK FOR RETURN CODE 24 32800000 * (DECIMAL) FROM IKJDAIR. 32820000 BNE IN002160 IF NOT 24, BRANCH TO DIAGNOSE YA00002 32840000 * IKJDAIR ERROR RETURN CODE. 32860000 IN009068 EQU * 32880000 NI CAEDFLAG,INF255-CAEDALOC INDICATE DATA SET NO 32900000 * LONGER ALLOCATED. 32920000 EJECT 32940000 IN009070 EQU * 32960000 *********************************************************************** 32980000 * * 33000000 * TRANSFER CONTROL TO MAIN CONTROLLER. * 33020000 * * 33040000 * FREE IKJPARSE PDL USING THE IKJRLSA MACRO INSTRUCTION. BUILD * 33060000 * PARAMETER LIST FOR XCTL. FREE THIS ROUTINES SAVE AREA AND * 33080000 * XCTL TO IKJEBEMA. * 33100000 * * 33120000 *********************************************************************** 33140000 L AREAREG,INPDLPTR ADDRESS OF PROMPT PDL. A45713 33160000 LTR AREAREG,AREAREG CHECK IF PROMPT PDL PRESENT. A45713 33180000 BNP IN009075 IF NO, BRANCH TO FREE MAIN PDL. A45713 33200000 IKJRLSA INPDLPTR FREE PROMPT PDL. A45713 33220000 L AREAREG,INPGLIST+PGPBIBUF-PGPB PROMPT BFR ADDR. A45713 33240000 LH PARMREG0,D0(,AREAREG) LENGTH OF PROMPT BUFFER. A45713 33260000 L PARMREG1,INPGLIST+PGPBIBUF-PGPB PTR TO BFR ADDR. A45713 33280000 O PARMREG0,INSUBPL1 INDICATE SUBPOOL ONE. A45713 33300000 FREEMAIN R,LV=(0),A=(1) FREE PUTGET PROMPT BFR. A45713 33320000 IN009075 EQU * A45713 33340000 IKJRLSA CAPTPRSD FREE IKJPARS PDL. 33360000 OI CAPRSPDL,CAFREEDL INDICATE THAT NO PDL REMAINS TO 33380000 * BE FREEMAINED. 33400000 SR TOPPTR,TOPPTR Y01676 33400100 ST TOPPTR,CACURNUM SET CURRENT LINE NUMBER TO Y01676 33400300 * ZERO SO THAT AT ENTRY TO EDIT Y01676 33400400 * THE CURRENT LINE POINTER WILL Y01676 33400600 * BE POSITIONED AT THE TOP OF Y01676 33400800 * THE DATASET. Y01676 33401000 TM CACFLAG1,CANONUM TEST IF DATA SET IS LINE NUMBERED 33420000 * SO THAT DEFAULT INCREMENTS MAY 33440000 * BE SET ACCORDINGLY. 33460000 BZ IN009080 IF DATA SET IS NUMBERED, BRANCH TO 33480000 * DEFAULT INCREMENTS TO 10. 33500000 MVC CAINCRE(L'CAINCRE),ININC100 SET DATA SET INCREMENT 33520000 MVC CAIMLINC(L'CAIMLINC),ININC100 AND LAST INCREMENT 33540000 * USED IN INPUT MODE TO 100 FOR 33560000 * NON-LINE NUMBERED DATA SETS. 33580000 B IN009090 BRANCH TO TRANSFER CONTROL TO THE 33600000 * MAIN CONTROLLER (IKJEBEMA). 33620000 IN009080 EQU * 33640000 MVC CAINCRE(L'CAINCRE),ININC010 SET DATA SET INCREMENT 33660000 MVC CAIMLINC(L'CAIMLINC),ININC010 AND LAST INCREMENT 33680000 * USED IN INPUT MODE TO 10 FOR 33700000 * LINE NUMBERED DATA SETS. 33720000 OI CACFLAG3,CAIMPT INDICATE THAT USER TO BE PROMPTED. 33740000 IN009090 EQU * 33760000 MVC INXCTLPL(INXCTLLN),INXCTL INITIALIZE XCTL 33780000 * PARAMETER LIST. 33800000 DROP DATAREG 33820000 LR PARMREG1,SAVEREG ADDRESS OF SAVE/WORK AREA. 33840000 L SAVEREG,D4(PARMREG0,SAVEREG) ADDRESS OF HIGHER 33860000 * SAVE AREA 33880000 L RETREG,D12(,SAVEREG) ADDRESS OF RETURN POINT. A42958 33900000 XC D0(D72,PARMREG1),D0(PARMREG1) ZERO SAVE AREA. 33920000 XCTL (2,12),EP=IKJEBEMA,MF=(E,(COMMREG)), A42958*33940000 SF=(E,INXCTLPL) A42958 33960000 * XCTL TO IKJEBEMA. 33980000 EJECT 34000000 *********************************************************************** 34020000 * * 34040000 * CALL IKJEBIN3 TO ISSUE ERROR MESSAGE TO USER. UPON RETURN * 34060000 * FROM IKJEBIN3, SET RETURN CODE TO 12 AND RETURN TO THE TMP. * 34080000 * * 34100000 *********************************************************************** 34120000 IN010010 EQU * 34140000 L EPLOCREG,INMSGRTN ADDRESS OF MESSAGE ROUTINE. 34160000 CALL (15),((COMMREG),(ERR1REG),(ERR2REG),(DATA1REG), X34180000 (DATA2REG)),MF=(E,INSVCRTN) BRANCH TO PUT ERROR X34200000 MESSAGE. 34220000 INEXIT12 EQU * YA00002 34221000 LA TMPCDREG,D12(,D0) SET RETURN CODE 12 FOR TMP. 34240000 EJECT 34260000 *********************************************************************** 34260600 * * 34261200 * UNALLOCATE THE DATA SET IF IT HAS BEEN ALLOCATED. * 34261800 * * 34262400 *********************************************************************** 34263000 IN010015 EQU * 34263600 L PASSREG,CAPTTMP ADDRESS OF TMP PARM LIST @ZA73615 34264200 L PASSREG,(CPPLPSCB-CPPL)(,PASSREG) PSCB ADDRESS @ZA73615 34264800 LA AREAREG,CAEDDSNL ADDRESS OF DATA SET NAME @ZA73615 34265400 * LENGTH AND DATA SET NAME. @ZA73615 34266000 MVC INDREC(INDR18L),INDR18 INITIALIZE IKJDAIR @ZA73615 34266600 * PARAMETER LIST-ENTRY CODE 18 @ZA73615 34267200 MVC INDREC+(DA18MNM-DAPB18)(L'CAEDMEMB),CAEDMEMB @ZA73615 34267800 * MOVE MEMBER NAME TO PARM LIST @ZA73615 34268400 ST AREAREG,INDREC+(DA18PDSN-DAPB18) PUT ADDRESS OF @ZA73615 34269000 * DSNAME IN IKJDAIR PARM LIST @ZA73615 34269600 LA AREAREG,INDREC ADDRESS OF IKJDAIR PARM LIST @ZA73615 34270200 LA PARMREG1,CATMPLST LOAD PARM REG 1 @ZA73615 34270800 LR RETREG,(PASSREG) PICK UP PARAMETER @ZA73615 34271400 LR RETCDREG,(AREAREG) PICK UP PARAMETER @ZA73615 34272000 STM 14,15,12(1) STORE INTO PARM LIST @ZA73615 34272600 CALLTSSR EP=IKJDAIR,MF=(E,CATMPLST) INVOKE DAIR @ZA73615 34273200 LTR RETCDREG,RETCDREG TEST FOR RETURN CODE OF ZERO @ZA73615 34273800 BZ IN010017 IF RETURN CODE IS ZERO, BRANCH TO @ZA73615 34274400 * CONTINUE EXIT. @ZA73615 34275000 CH RETCDREG,INDRRC28 CHECK FOR RETURN CODE 28 @ZA77969 34275200 BE INEXIT1 GO EXIT @ZA77969 34275400 CH RETCDREG,INDRRC24 CHECK FOR RETURN CODE 24 @ZA73615 34275600 * (DECIMAL) FROM IKJDAIR @ZA73615 34276200 BNE IN002160 IF NOT 24 BRANCH TO DIAGNOSE @ZA73615 34276800 * IKJDAIR ERROR RETURN CODE. @ZA73615 34277400 IN010017 EQU * @ZA73615 34278000 NI CAEDFLAG,INF255-CAEDALOC INDICATE DATA SET NO @ZA73615 34278600 * LONGER ALLOCATED. @ZA73615 34279200 INEXIT0 EQU * 34280000 *********************************************************************** 34300000 * * 34320000 * EXIT AREA -- AN ERROR WAS ENCOUNTERED DURING INITIALIZATION OF * 34340000 * THE EDIT COMMAND. ON EXIT, (1) RELEASE THE IKJPARSE PDL USING * 34360000 * THE IKJRLSA MACRO INSTRUCTION, (2) CALL IKJEBESR TO DELETE THE * 34380000 * PERMANENTLY RESIDENT SERVICE ROUTINES, (3) DELETE IKJEBESR USING * 34400000 * THE DELETE MACRO INSTRUCTION, (4) ISSUE A FREEMAIN MACRO * 34420000 * INSTRUCTION FOR THE BLDL LIST AND THE COMMUNICATION AREA, AND * 34440000 * (5) RETURN TO THE TMP WITH A RETURN CODE OF 12. * 34460000 * * 34480000 *********************************************************************** 34500000 INEXIT1 EQU * 34520000 TM CAPRSPDL,CAFREEDL CHECK IF PDL EXISTS. 34540000 BNZ INEXIT2 IF NOT, BRANCH TO EXIT. 34560000 IKJRLSA CAPTPRSD FREE IKJPARS PDL. 34580000 INEXIT2 EQU * 34600000 DELETE EP=IKJEBEMS DELETE MESSAGE SELECTION ROUTINE X34620000 FROM MAIN STORAGE. 34640000 TCLEARQ INPUT CLEAR INPUT QUEUES. 34660000 MVC CASRPLST+D4(INSTPBLN),INSTKPRM MOVE STACK PARAMETER 34680000 * BLOCK TO DYNAMIC AREA. 34700000 LA EPLOCREG,CASRPLST+D4 ADDRESS OF STACK PARAMETER BLOCK. 34720000 ST EPLOCREG,CATMPLST+IOPLIOPB-IOPL STORE ADDRESS IN 34740000 * SERVICE ROUTINE PARAMETER LIST. 34760000 STACK MF=(E,CATMPLST) DELETE ALL ELEMENTS BUT TERMINAL X34780000 FROM INPUT STACK. 34800000 L SAVEREG,D4(,SAVEREG) ADDRESS OF NEXT HIGHER SAVE 34820000 * AREA. 34840000 FREEMAIN R,LV=CADLEN,A=(COMMREG),SP=SUBPOOL FREE THE X34860000 COMMUNICATION AREA. 34880000 RETURN (14,12),,RC=12 RETURN TO THE TMP. 34900000 EJECT 34920000 *********************************************************************** 34940000 * * 34960000 * IF DATA SET IS NOT FOUND AS OLD, ISSUE MESSAGE THAT DATA SET 34961000 * IS ASSUMED TO BE NEW. 34962000 * 34963000 *********************************************************************** 34964000 IN012010 EQU * 34965000 LA AREAREG,INPTLIST GET ADDR OF PARM LIST @OZ05180 34966000 USING PTPB,AREAREG SET UP ADDRESSIBILITY @OZ05180 34967000 XC PTPB(INPTPBLN),PTPB ZERO PARM LIST @OZ05180 34968000 ST AREAREG,CATMPLST+IOPLIOPB-IOPL STORE ADDR @OZ05180 34969000 LA PARMREG1,CATMPLST PARMLIST ADDR IN REG 1 @OZ05180 34970000 PUTLINE ,OUTPUT=INNOTOLD,MF=(E,(1)) ISSUE MESSAGE @OZ05180 34971000 BR SRRTNREG GO TO PROCESS NEW DSN @OZ05180 34972000 EJECT 35840000 ********************************************************************** 35860000 * * 35880000 * EQUATES, CONSTANTS AND AREAS USED BY INITIALIZATION. * 35900000 * * 35920000 *********************************************************************** 35940000 INMSGRTN DC V(IKJEBIN3) ADDRESS OF MESSAGE ROUTINE FOR 35960000 * INITIALIZATION PHASE. 35980000 SPACE 5 36000000 INCL001 CLC D0(*-*,FLAGREG),INNEW CHECK IF NEW ENTERED. 36020000 INXC001 XC D0(*-*,AREAREG),D0(AREAREG) INSTRUCTION EXECUTED 36040000 * OUT OF SEQUENCE TO ZERO CORE. 36060000 INMV001 MVC D0(*-*,AREAREG),D0(DSNAMREG) MOVE DATA SET NAME 36080000 * TO MESSAGE INSERTION RECORD. 36100000 INMV002 MVC X1(*-*,AREAREG),D0(DSNAMREG) MOVE MEMBER NAME TO 36120000 * MESSAGE INSERTION RECORD. 36140000 INMV003 MVC CAEDDSN(*-*),D0(AREAREG) MOVE EDIT DATA SET NAME TO 36160000 * COMMUNICATION AREA. 36180000 INMV004 MVC CAEDMEMB(*-*),D0(AREAREG) MOVE MEMBER NAME TO 36200000 * COMMUNICATION AREA. 36220000 INMV005 MVC CAEDPSWD(*-*),D0(AREAREG) MOVE PASSWORD TO 36240000 * COMMUNICATION AREA. 36260000 SPACE 5 36280000 INXCTL XCTL ,SF=L XCTL PARAMETER LIST. 36300000 INXCTLLN EQU *-INXCTL LENGTH OF XCTL PARAMETER LIST. 36320000 SPACE 5 36340000 INCAMLST CAMLST SEARCH,1,2,3 CAMLIST FOR OBTAIN DSCB. 36360000 INCAMEND EQU *-INCAMLST LENGTH OF CAMLIST EXPANSION. 36370000 SPACE 5 36380000 LOCATEDS CAMLST NAME,1,,3 CAMLST LIST FORM MACRO FOR LOCATE@ZA10761 36381000 LOCATLEN EQU *-LOCATEDS LENGTH OF CAMLIST MACRO EXPANSION@ZA05823 36382000 SPACE 5 36383000 INNOTOLD DC F'1' NUMBER OF SEGMENTS @OZ05180 36384000 DC A(INOTOLD1) PTR TO SEGMENT @OZ05180 36385000 INOTOLD1 DC AL2(INOTOLDL) LENGTH OF MESSAGE @OZ05180 36386000 DC H'0' OFFSET @OZ05180 36387000 DC CL57'IKJ52320I DATA SET OR MEMBER NOT FOUND, ASSUMED TO X36388000 BE NEW' @OZ05180 36389000 INOTOLDL EQU *-INOTOLD1 MESSAGE LENGTH @OZ05180 36390000 SPACE 5 36400000 DS 0F @OZ05180 36410000 INKEYDEF DC H'1' DEFAULT KEYWORD NUMBER FROM IKJPARSE. 36420000 INDISPNW DC XL2'2' RELATIVE KEYWORD NUMBER FOR NEW. 36440000 INPARS DC XL4'01000000' INDICATOR FOR IKJPARS SERVICE 36460000 * ROUTINE. 36480000 INDAIR DC XL4'02000000' INDICATOR FOR IKJDAIR SERVICE 36500000 * ROUTINE. 36520000 INSVCOBT DC XL4'04000000' INDICATOR FOR OBTAIN SVC. 36540000 INSUBPL1 DC XL4'01000000' INDICATOR FOR SUBPOOL ONE. A45713 36560000 INDSMTY DC XL3'0' CONSTANT USED TO CHECK DS1LSTAR. 36580000 INNOKEYW DC XL2'0' CONSTANT USED TO DETERMINE IF A 36600000 * KEYWORD ENTERED ON COMMAND. 36620000 INNEW DC CL3'NEW' NEW DISPOSITION OPERAND KEYWORD. 36640000 INBUFRCW DC XL4'000C0000' BUFFER CONTROL WORD FOR DUMMY 36660000 * IKJPARS BUFFER. 36680000 ININC010 DC F'10' DEFAULT INCREMENT FOR LINE 36700000 * NUMBERED DATA SETS. 36720000 ININC100 DC F'100' DEFAULT INCREMENT FOR NON-LINE 36740000 * NUMBERED DATA SETS. 36760000 INDR0000 DC XL2'0000' IKJDAIR DARC = 0 - CATALOG ERROR. 36780000 INDR0004 DC XL2'4' IKJDAIR CTRC = 4 - CATALOG ERROR. 36800000 INDR0008 DC XL2'8' IKJDAIR CTRC = 8 - CATALOG ERROR. 36820000 INDR0028 DC XL2'1C' IKJDAIR CTRC = 28- CATALOG ERROR. 36840000 INDR020C DC XL2'020C' IKJDAIR DYNAMIC ALLOCATION ERROR. 36860000 INDR0210 DC XL2'0210' IKJDAIR DYNAMIC ALLOCATION ERROR. 36880000 INDR0214 DC XL2'0214' IKJDAIR DYNAMIC ALLOCATION ERROR. 36900000 INDR0218 DC XL2'0218' IKJDAIR DYNAMIC ALLOCATION ERROR. 36920000 INDR021C DC XL2'021C' IKJDAIR DYNAMIC ALLOCATION ERROR. 36940000 INDR0220 DC XL2'0220' IKJDAIR DYNAMIC ALLOCATION ERROR. 36960000 INDR0404 DC XL2'0404' IKJDAIR DYNAMIC ALLOCATION ERROR. 36980000 INDR041C DC XL2'041C' IKJDAIR DYNAMIC ALLOCATION ERROR. 37000000 INDAIR08 DC H'8' IKJDAIR RETURN CODE 8 (CATALOG YA00002 37001000 * MANAGEMENT ERROR.) YA00002 37002000 INDAIR16 DC H'16' IKJDAIR RETURN CODE 16 (NO ENTRY YA00002 37003000 * AVAILABLE IN TIOT.) YA00002 37004000 INDRRC24 DC H'24' IKJDAIR RETURN CODE 24 (DATA SET 37020000 * BELONGS TO A CONCATENATED 37040000 * GROUP). THIS RETURN CODE IS 37060000 * ACCEPTABLE FOR UNALLOCATION. 37080000 INDRRC28 DC H'28' IKJDAIR RETURN CODE 28 @ZA77969 37080300 * DDNAME OR DSNAME NOT ALLOCATED. @ZA77969 37080600 INDAIR48 DC H'48' IKJDAIR RETURN CODE 48 (DAIR STAE YA00002 37081000 * EXIT ENTERED.) YA00002 37082000 INBLINIT DC XL4'0001000E' CONSTANT USED FOR BLDL LIST 37100000 * INITIALIZATION. 37120000 INTEMPNM DC CL8'TEMPNAME' DEFAULT MEMBER NAME WHEN NOT 37140000 * SUPPLIED ON COMMAND. 37160000 SPACE 5 37180000 INDCB DCB DSORG=PO,MACRF=(E),DDNAME=XXXXXXXX DCB FOR BLDL. 37200000 INDCBL EQU *-INDCB LENGTH OF DCB. 37220000 INOPEN OPEN (,),MF=L PARAMETER LIST FOR OPEN. 37240000 INOPENL EQU *-INOPEN LENGTH OF OPEN PARAMETER LIST. 37260000 INCLOSE CLOSE (,),MF=L PARAMETER LIST FOR CLOSE. 37280000 INCLOSEL EQU *-INCLOSE LENGTH OF CLOSE PARAMETER LIST. 37300000 SPACE 2 37320000 INSTKPRM STACK DELETE=ALL,MF=L LIST-FORM STACK MACRO FOR DELETING X37340000 ALL ELEMENTS BUT TERMINAL FROM X37360000 THE INPUT STACK. 37380000 INSTPBLN EQU *-INSTKPRM LENGTH OF STACK PARAMETER BLOCK. 37400000 SPACE 2 37420000 SPACE 5 37440000 D0 EQU 0 OFFSET ZERO (DECIMAL). 37460000 D1 EQU 1 OFFSET 1 (DECIMAL). 37480000 D4 EQU 4 OFFSET 4 (DECIMAL). 37500000 D5 EQU 5 OFFSET 5 (DECIMAL). 37520000 D6 EQU 6 OFFSET 6 (DECIMAL). 37540000 D8 EQU 8 OFFSET 8 (DECIMAL). 37560000 D9 EQU 9 OFFSET 9 (DECIMAL). 37580000 D16 EQU 16 OFFSET 16 (DECIMAL). 37600000 D72 EQU 72 OFFSET 72 (DECIMAL). 37620000 D12 EQU 12 OFFSET 12 (DECIMAL). 37640000 D15 EQU 15 OFFSET 15 (DECIMAL). 37660000 D3 EQU 3 OFFSET 3 (DECIMAL). 37680000 D2 EQU 2 OFFSET 2 (DECIMAL). 37700000 D7 EQU 7 OFFSET 7 (DECIMAL). 37720000 D20 EQU 20 OFFSET 20 (DECIMAL). 37740000 D24 EQU 24 OFFSET 24 (DECIMAL). 37760000 D30 EQU 30 OFFSET 30 (DECIMAL). 37780000 D32 EQU 32 OFFSET 32 (DECIMAL). 37800000 X1 EQU 1 OFFSET 1. 37820000 INSMGPT EQU 0 OFFSET IN PDE TO POINTER. 37840000 INSMGLN EQU 4 OFFSET IN PDE TO LENGTH. 37860000 INSMGFLG EQU 6 OFFSET IN PDE TO FLAGS. 37880000 INLSRCMG EQU 2 LEFT SOURCE MARGIN FOR PL/I. 37900000 INRSRCMG EQU 72 RIGHT SOURCE MARGIN FOR PL/I. 37920000 INSNOPT EQU 0 OFFSET IN PDE TO POINTER. 37940000 INSNOLN EQU 4 OFFSET IN PDE TO LENGTH. 37960000 INSNOFLG EQU 6 OFFSET IN PDE TO FLAGS. 37980000 INSNOOMT EQU X'80' START POSITION/LENGTH ENTERED. 38000000 INBLKPT EQU 0 OFFSET IN PDE TO ADDRESS OF BLOCK 38020000 * VALUE. 38040000 INBLKLN EQU 4 OFFSET IN PDE TO LENGTH OF BLOCK 38060000 * VALUE. 38080000 INLNEPT EQU 0 OFFSET IN PDE TO ADDRESS OF LINE 38100000 * VALUE. 38120000 INLNELN EQU 4 OFFSET IN PDE TO LENGTH OF LINE 38140000 * VALUE. 38160000 DS1FMUDF EQU B'11000000' DSCB RECFM = UNDEFINED. 38180000 DS1FMVAR EQU B'01000000' DSCB RECFM = VARIABLE. 38200000 DS1FMSTD EQU B'00001000' DSCB RECFM = STANDARD BLOCKS. 38220000 DS1FMOVF EQU B'00100000' DSCB RECFM = TRACK OVERFLOW. 38240000 DS1FMA EQU B'00000100' DSCB RECFM = ASA CONTROL CHARACTER. 38260000 DS1FMM EQU B'00000010' DSCB RECFM = MACHINE CONTROL 38280000 * CHARACTER. 38300000 DS1FMBLK EQU B'00010000' DSCB RECFM = BLOCKED. 38320000 DS1FMFX EQU B'10000000' DSCB RECFM = FIXED. 38340000 DS1ORGPO EQU B'00000010' DSCB DSORG = PARTITIONED. 38360000 DS1ORGPS EQU B'01000000' DSCB DSORG = PHYSICAL SEQUENTIAL. 38380000 INSTATN EQU 2 RELATIVE KEYWORD NUMBER FOR NEW. 38400000 CURNTTCB EQU 4 OFFSET TO CURRENT TCB. 38420000 INSTATO EQU 1 KEYWORD NUMBER FOR OLD (STATUS). 38440000 INOPRNDO EQU X'80' IKJPARSE OPERAND OMITTED. 38460000 INFULLQ EQU X'40' DATA SET NAME FULLY QUALIFIED. 38480000 INDSNPT EQU 0 OFFSET IN PDE TO DATA SET NAME PT 38500000 INDSNLL EQU 4 OFFSET IN PDE TO DATA SET NAME LENGTH 38520000 INDSNFLG EQU 6 OFFSET IN PDE TO DATA SET NAME FLAGS. 38540000 INMEMPT EQU 8 OFFSET IN PDE TO MEMBER PT 38560000 INMEMLL EQU 12 OFFSET IN PDE TO MEMBER LENGTH. 38580000 INMEMFLG EQU 14 OFFSET IN PDE TO MEMBER FLAGS. 38600000 INPSWPT EQU 16 OFFSET IN PDE TO PASSWORD PT. 38620000 INPSWLL EQU 20 OFFSET IN PDE TO PASSWORD LENGTH. 38640000 INPSWFLG EQU 22 OFFSET IN PDE TO PASSWORD FLAGS. 38660000 INTSFSQO EQU 73 GOFORT(FIXED) SEQUENCE NUMBER 38680000 * START COLUMN. 38700000 RCODE4 EQU 4 RETURN CODE 4 - USED TO TEST RETURN 38720000 * CODES. 38740000 RCODE12 EQU 12 RETURN CODE 12 - USED IN VALIDITY 38760000 * CHECK EXIT 38780000 SUBPOOL EQU 1 SUBPOOL NUMBER FOR MAIN STORAGE 38800000 * REQUESTS 38820000 INF255 EQU 255 CONSTANT 255 USED FOR LENGTH 38840000 * CHECKS IN CLEARING CORE. 38860000 CHRBLANK EQU C' ' CHARACTER BLANK. 38880000 INDCZERO EQU C'0' DECIMAL ZERO (UNPACKED AND UNSIGNED). 38900000 INSNGLQT EQU C'''' SINGLE QUOTE. 38920000 INPERIOD EQU C'.' PERIOD. 38940000 INLFTPRN EQU C'(' LEFT PARENTHESIS. 38960000 INRTPRN EQU C')' RIGHT PARENTHESIS. 38980000 INDR1700 EQU X'17' IKJDAIR DYNAMIC ALLOCATION ERROR. 39000000 INOPENED EQU X'10' MASK USED TO DETERMINE WHETHER THE 39020000 * DCB OPENED SUCCESSFULLY. 39040000 SPACE 5 39060000 INERROR1 EQU 0 RELATIVE ERROR 1 - TERMINATE EDIT 39080000 * WITH NOT ENOUGH MAIN STORAGE 39100000 * MESSAGE. 39120000 INERROR2 EQU 4 RELATIVE ERROR 2 - TERMINATE EDIT 39140000 * WITH REQUIRED PROGRAM NOT 39160000 * AVAILABLE MESSAGE. 39180000 INERROR3 EQU 8 RELATIVE ERROR 3 - TERMINATE EDIT 39200000 * WITH LOGIC ERROR MESSAGE. 39220000 INERROR4 EQU 12 RELATIVE ERROR 4 - TERMINATE EDIT 39240000 * WITH DATA SET ORGANIZATION NOT 39260000 * ACCEPTABLE MESSAGE. 39280000 INERROR5 EQU 16 RELATIVE ERROR 5 - TERMINATE EDIT 39300000 * WITH RECORD FORMAT = UNDEFINED 39320000 * NOT ACCEPTABLE MESSAGE. 39340000 INERROR6 EQU 20 RELATIVE ERROR 6 - TERMINATE EDIT 39360000 * WITH DATA SET NOT USABLE 39380000 * MESSAGE. 39400000 INERROR7 EQU 24 RELATIVE ERROR 7 - DATA SET NOT 39420000 * FOUND, OLD SPECIFIED. 39440000 INERROR8 EQU 28 RELATIVE ERROR 8 - LINE VALUE 39460000 * SPECIFIED ON COMMAND INVALID, 39480000 * OR LRECL FIELD IN THE FORMAT 39500000 * 1 DSCB IS SET TO ZERO. 39520000 INERROR9 EQU 32 RELATIVE ERROR 9 - BLOCK VALUE 39540000 * SPECIFIED ON COMMAND INVALID. 39560000 INERRORA EQU 36 RELATIVE ERROR 10 - SYNTAX CHECKING 39580000 * SPECIFIED FOR A NON-SCANABLE 39600000 * DATA SET TYPE OR SYNTAX 39620000 * CHECKER NOT IN SYSTEM. 39640000 INERRORB EQU 40 RELATIVE ERROR 11 - NONUM SPECIFIED 39660000 * DATA SET MUST BE NUMBERED. 39680000 INERRORC EQU 44 RELATIVE ERROR 12 - INVALID PL/I 39700000 * SOURCE MARGINS. 39720000 INERRORD EQU 48 RELATIVE ERROR 13 - NUM OPERAND 39740000 * INCORRECT FOR ASM DATA SET 39760000 * TYPE. 39780000 INERRORE EQU 52 RELATIVE ERROR 14 - ASIS SPECIFIED, 39800000 * CAPS REQUIRED. 39820000 INERRORF EQU 56 RELATIVE ERROR 15 - UNALLOCATION 39840000 * ERROR OR DDNAME NOT FOUND. 39860000 INERRORG EQU 60 RELATIVE ERROR 16 - LINE OPERAND 39880000 * SPECIFIED FOR OLD DATA SET. 39900000 INERRORH EQU 64 RELATIVE ERROR 17 - BLOCK OPERAND 39920000 * SPECIFIED FOR OLD DATA SET. 39940000 INERRORI EQU 68 RELATIVE ERROR 18 - DATA SET 39960000 * FOUND, NEW SPECIFIED. 39980000 INERRORJ EQU 72 RELATIVE ERROR 19 - OLD DATA SET 40000000 * HAS LRECL OTHER THAN 80. 40020000 INERRORK EQU 76 RELATIVE ERROR 20 - IKJDAIR RETURN 40040000 * CODE NOT ZERO. 40060000 INERRORL EQU 80 RELATIVE ERROR 21 - DATA SET NOT 40080000 * USEABLE. 40100000 INERRORM EQU 84 RELATIVE ERROR 22 - TERMINATE EDIT 40120000 * WITH TOO MANY DATA SETS 40140000 * ALLOCATED MESSAGE. 40160000 INERRORN EQU 88 RELATIVE ERROR 23 - TERMINATE EDIT 40180000 * WITH REQUIRED VOLUME NOT 40200000 * MOUNTED MESSAGE. 40220000 INERRORO EQU 92 RELATIVE ERROR 24 - TERMINATE EDIT 40240000 * WITH DATA SET NOT ON VOLUME 40260000 * MESSAGE. 40280000 INERRORP EQU 96 RELATIVE ERROR 25 - TERMINATE EDIT 40300000 * WITH ALLOCATION FAILED MESSAGE 40320000 INERRORQ EQU 100 RELATIVE ERROR 26 - TERMINATE EDIT 40340000 * WITH DEVICE NOT DIRECT ACCESS 40360000 * MESSAGE. 40380000 INERRORR EQU 104 RELATIVE ERROR 27 - TERMINATE EDIT 40400000 * WITH INVALID DSNAME MESSAGE. 40420000 INERRORS EQU 108 RELATIVE ERROR 28 - TERMINATE EDIT 40440000 * WITH DATA SET WILL CREATE 40460000 * INVALID CATALOG STRUCTURE 40480000 * MESSAGE. 40500000 INERRORT EQU 112 RELATIVE ERROR 29 - TERMINATE EDIT 40520000 * WITH DSNAME NOT QUALIFIED 40540000 * MESSAGE. 40560000 INERRORU EQU 116 RELATIVE ERROR 30 - TERMINATE EDIT 40580000 * WITH DSNAME NOT RESOLVED 40600000 * MESSAGE. 40620000 INERRORV EQU 120 RELATIVE ERROR 31 - GOFORT(FREE) 40640000 * SPECIFIED BUT RECORD FORMAT IS 40660000 * FIXED. 40680000 INERRORW EQU 124 RELATIVE ERROR 32 - TERMINATE EDIT 40700000 * WITH INVALID UNIT OR UNIT NOT 40720000 * AVAILABLE MESSAGE. 40740000 INERRORX EQU 128 RELATIVE ERROR 33 - TERMINATE EDIT A45713 40760000 * WITH MISSING DATA SET TYPE. A45713 40780000 SPACE 5 40800000 INDR18 DS 0F PARAMETER BLOCK FOR ENTRY CODE 18. 40820000 DC XL2'18' IKJDAIR ENTRY CODE X'18' 40840000 DC 3XL2'0' FLAGS, DARC, CTRC. 40860000 DC A(0) ADDRESS OF DSNAME. 40880000 DC 2CL8' ' DDNAME, MEMBER NAME. 40900000 DC CL2' ' SYSOUT CLASS SPECIFICATION. @YA01909 40920000 DC X'00' NO OVERIDING DISPOSITION. @ZA85402 40940000 DC X'0' CONTROL FLAGS. 40960000 DC CL8' ' JOBNAME. 40980000 INDR18L EQU *-INDR18 LENGTH OF PARAMETER BLOCK. 41000000 SPACE 5 41020000 INDAIR8O DS 0F 41040000 DC XL2'8' IKJDAIR ENTRY CODE 8. 41060000 DC 10X'0' INITIALIZE FLAGS, DARC, CTRC AND 41080000 * DSNAME PT FIELDS TO ZEROES. 41100000 DC 3CL8' ' INITIALIZE DDNAME, UNITNAME AND 41120000 * SERIAL NO. TO BLANKS. 41140000 DC 4F'0' INITIALIZE BLKSIZE, PRIMARY, 41160000 * SECONDARY, AND DIRECTORY 41180000 * QUANTITY TO ZEROES. 41200000 DC 2CL8' ' INITIALIZE MEMBERNAME AND PASSWORD 41220000 * FIELDS TO BLANKS. 41240000 DC X'0' INITIALIZE STATUS TO OLD. A50467 41260000 DC AL2(0) ALLOW NORMAL AND COND DISPOSITON 41286600 * TO DEFAULT. @ZA85402 41313200 DC 5X'0' INITIALIZE FLAGS AND DSORG FIELDS A42959 41340000 * SET BY IKJDAIR TO ZERO. A42959 41360000 INDR8OLL EQU *-INDAIR8O LENGTH OF PARAMETER LIST FOR ENTRY 41380000 * CODE 8. 41400000 SPACE 5 41420000 ININS001 EQU * 41440000 ININS002 IKJEBEMG ININS003,M3131IN1,'BLDL' INSERTION IN COMMAND 41460000 ININS003 IKJEBEMG 0,M3131IN2,'8' SYSTEM ERROR MESSAGE. 41480000 ININS004 IKJEBEMG ININS005,M3131IN1,'IKJEBEPS' SERVICE ROUTINE X41500000 NAME FOR INSERTION. 41520000 ININS005 IKJEBEMG 0,M3131IN2,'4' RETURN CODE FOR INSERTION. 41540000 ININS006 IKJEBEMG ININS007,M3131IN1,'LOCATE' SERV RTN NAME @ZA05823 41544000 ININS007 IKJEBEMG 0,M3131IN2,'04' RETURN CODE FOR INSERTION @ZA05823 41548000 ININS6LN EQU ININS007-ININS006 OFFSET TO SECOND INSERT @ZA05823 41552000 ININSLEN EQU *-ININS006 @ZA05823 41556000 SPACE 5 41560000 IKJEBIN0 EQU * 41580000 .TAG1 ANOP A45714 41600000 .* CHECK IF LOOP FINISHED - INDEX 'J' GT NO. OF DSTYPES. A45714 41620000 AIF (&J GT &I).OUT1 A45714 41640000 DC CL8'&DST(&J)' - EDIT DATA SET TYPE. A45714 41660000 .* INCREMENT INDEX 'J' BY ONE. A45714 41680000 &J SETA &J+1 A45714 41700000 .* REPEAT LOOP. A45714 41720000 AGO .TAG1 A45714 41740000 .OUT1 ANOP A45714 41760000 INDSTELN EQU 8 LENGTH OF TABLE ENTRY. 41780000 INNODSTY EQU (*-IKJEBIN0)/INDSTELN NUMBER OF ENTRIES IN DATA 41800000 * SET TYPE TABLE. 41820000 SPACE 5 41840000 EJECT 41860000 INPTPCL DC A(IKJEBIN1) ADDRESS OF IKJPARSE PCL FOR THE 41880000 * EDIT COMMAND. 41900000 IKJEBIN1 IKJPARM DSECT=INECMNDD BEGIN EDIT COMMAND PCL. 41920000 INDSN IKJPOSIT DSNAME,PROMPT='DATA SET NAME' DATA SET NAME. 41940000 * DATA SET STATUS. 41960000 INSTAT IKJKEYWD 41980000 IKJNAME 'OLD' STATUS = OLD. 42000000 IKJNAME 'NEW' STATUS = NEW. 42020000 * DEFINE DATA SET TYPE. 42040000 INDSTYPE IKJKEYWD 42060000 .* INITIALIZE INDEX 'J' TO ONE. A45714 42080000 &J SETA 1 A45714 42100000 .TAG2 ANOP A45714 42120000 .* CHECK IF LOOP FINISHED - INDEX 'J' GT NO. OF DSTYPES. A45714 42140000 AIF (&J GT &I).OUT2 A45714 42160000 .* CHECK IF DSTYPE IS 'PLI' - USE SPECIAL SUBFIELD. A45714 42180000 AIF ('&DST(&J)' EQ 'PLI').TAG3 A45714 42200000 .* CHECK IF DSTYPE IS 'IPLI' - USE SPECIAL SUBFIELD. A45714 42220000 AIF ('&DST(&J)' EQ 'IPLI').TAG4 A45714 42240000 .* CHECK IF DSTYPE IS 'GOFORT' - USE SPECIAL SUBFIELD. A45714 42260000 AIF ('&DST(&J)' EQ 'GOFORT').TAG5 A45714 42280000 .* CHECK IF DSTYPE IS 'PLIF' - USE SPECIAL SUBFIELD. A45714 42300000 AIF ('&DST(&J)' EQ 'PLIF').TAG6 A45714 42320000 .* CHECK IF USER DSTYPE - FIRST 16 ARE IBM SUPPLIED TYPES. Y02676 42340000 AIF (&J GT 16).TAG7 Y02676 42360000 .TAG2A ANOP A45714 42380000 IKJNAME '&DST(&J)' - EDIT DATA SET TYPE. A45714 42400000 AGO .LOOP1 A45714 42420000 .TAG3 ANOP A45714 42440000 IKJNAME 'PLI',SUBFLD=INPL1 - EDIT DATA SET TYPE. A45714 42460000 AGO .LOOP1 A45714 42480000 .TAG4 ANOP A45714 42500000 IKJNAME 'IPLI',SUBFLD=INIPLICS - EDIT DATA SET TYPE. A45714 42520000 AGO .LOOP1 A45714 42540000 .TAG5 ANOP A45714 42560000 IKJNAME 'GOFORT',SUBFLD=INTSFTN - EDIT DATA SET TYPE. A45714 42580000 AGO .LOOP1 A45714 42600000 .TAG6 ANOP A45714 42620000 IKJNAME 'PLIF',SUBFLD=INPL1 - EDIT DATA SET TYPE. A45714 42640000 AGO .LOOP1 A45714 42660000 .TAG7 ANOP A45714 42680000 .* SET INDEX 'K' FOR USER EXIT NAME. A45714 42700000 &K SETA &J-16 Y02676 42720000 .* CHECK IF USER EXIT SUPPLIED. A45714 42740000 AIF ('&SUBFD(&K)' EQ '').TAG2A A45714 42760000 IKJNAME '&DST(&J)',SUBFLD=INUXERTY - EDIT DATA SET TYP. A45714 42780000 .* SET SWITCH 'SW' TO INDICATE EXIT SUPPLIED. A45714 42800000 &SW SETB 1 A45714 42820000 .LOOP1 ANOP A45714 42840000 .* INCREMENT INDEX 'J' BY ONE A45714 42860000 &J SETA &J+1 A45714 42880000 .* REPEAT LOOP. A45714 42900000 AGO .TAG2 A45714 42920000 .OUT2 ANOP A45714 42940000 INSCN IKJKEYWD DEFAULT='NOSCAN' SCAN OPERAND. 42960000 IKJNAME 'NOSCAN' SYNTAX CHECKING NOT DESIRED. 42980000 IKJNAME 'SCAN' SYNTAX CHECKING DESIRED. 43000000 * DATA SET FORMAT. 43020000 INFMT IKJKEYWD 43040000 IKJNAME 'CAPS' DATA MAINTAINED IN UPPER CASE. 43060000 IKJNAME 'ASIS' DATA MAINTAINED AS ENTERED. 43080000 INNUM IKJKEYWD DEFAULT='NUM' LINE NUMBER OPERANDS. 43100000 IKJNAME 'NUM',SUBFLD=INNUMS NUMBER DATA SET. 43120000 IKJNAME 'NONUM' DO NOT NUMBER DATA SET. 43140000 * BLOCK OPERAND. 43160000 INBLK IKJKEYWD 43180000 * USER SPECIFIES BLOCK SIZE 43186000 IKJNAME 'BLOCK',SUBFLD=INBLKSZ,ALIAS='BLKSIZE' @Y30NQKK 43192000 INLNE IKJKEYWD 43240000 * USER SPECIFIES LRECL 43250000 IKJNAME 'LINE',SUBFLD=INLRECL,ALIAS='LRECL' @Y30NQKK 43260000 * SUBFIELD DESCRIPTION FOR BLOCK. 43280000 INBLKSZ IKJSUBF 43300000 INBLKSZE IKJIDENT 'NUMBER',FIRST=NUMERIC,OTHER=NUMERIC, X43320000 PROMPT='BLOCKSIZE',VALIDCK=IKJEBIN4 BLKSIZE TO BE X43340000 USED. 43360000 * SUBFIELD DESCRIPTION FOR LINE. 43380000 INLRECL IKJSUBF 43400000 INLNESZ IKJIDENT 'NUMBER',FIRST=NUMERIC,OTHER=NUMERIC, X43420000 PROMPT='LINESIZE',VALIDCK=IKJEBIN4 LRECL TO BE X43440000 USED. 43460000 * SUBFIELD DESCRIPTION FOR NUM. 43480000 INNUMS IKJSUBF 43500000 INNOSTP IKJIDENT 'NUMBER',FIRST=NUMERIC,OTHER=NUMERIC START POSITION 43520000 INNOLEN IKJIDENT 'NUMBER',FIRST=NUMERIC,OTHER=NUMERIC LENGTH. 43540000 * SUBFIELD DESCRIPTION FOR PL1. 43560000 INPL1 IKJSUBF 43580000 INPL1CL1 IKJIDENT 'NUMBER',FIRST=NUMERIC,OTHER=NUMERIC, X43600000 DEFAULT='2',VALIDCK=IKJEBIN4 LEFT SOURCE MARGIN. 43620000 INPL1CL2 IKJIDENT 'NUMBER',FIRST=NUMERIC,OTHER=NUMERIC, X43640000 DEFAULT='72',VALIDCK=IKJEBIN4 RIGHT SOURCE MARGIN. 43660000 INPL1TYP IKJKEYWD DEFAULT='CHAR60' CHARACTER SET USED. 43680000 IKJNAME 'CHAR60' 60 CHARACTER SET. 43700000 IKJNAME 'CHAR48' 48 CHARACTER SET. 43720000 INIPLICS IKJSUBF 43740000 INIPLICH IKJKEYWD DEFAULT='CHAR60' CHARACTER SET TO BE USED. 43760000 IKJNAME 'CHAR60' 60-CHARACTER SET. 43780000 IKJNAME 'CHAR48' 48-CHARACTER SET. 43800000 * SUBFIELD DESCRIPTION FOR GOFORT. 43820000 INTSFTN IKJSUBF 43840000 INTSFTFM IKJKEYWD DEFAULT='FREE' DEFINE STATEMENT FORMAT. 43860000 IKJNAME 'FREE' FREE FORMAT STATEMENTS. 1 43880000 IKJNAME 'FIXED' FIXED FORMAT STATEMENTS. 2 43900000 .* CHECK IF USER EXIT SUPPLIED. A45714 43920000 AIF (&SW EQ 0).TAG8 A45714 43940000 * SUBFIELD DESCRIPT. FOR USER TYPES. A45714 43960000 INUXERTY IKJSUBF 43980000 INUSERTY IKJIDENT 'DATA SET TYPE PARAMETERS',FIRST=ANY,OTHER=ANY A45714 44000000 .TAG8 ANOP A45714 44020000 IKJENDP 44040000 EJECT 44060000 TITLE 'IKJEBIN2 - PCL FOR NEW/OLD PROMPT' 44080000 INDISPDL DC A(IKJEBIN2) ADDRESS OF IKJPARS PCL. 44100000 SPACE 2 44120000 IKJEBIN2 IKJPARM DSECT=INDISPD PCL FOR DISPOSITION PROMPT. 44140000 INDISPX IKJIDENT 'NEW OR OLD',MAXLNTH=3,PROMPT='NEW OR OLD' 44160000 IKJENDP 44180000 EJECT 44200000 TITLE 'IKJEBIN3 - MESSAGE PROCESSING' 44220000 *********************************************************************** 44240000 * * 44260000 * STATUS -- VERSION NO. 01, OS/360 RELEASE NO. 20 * 44280000 * * 44300000 * FUNCTION -- THIS ROUTINE IS CALLED BY ALL CSECTS OF EDIT * 44320000 * INITIALIZATION THAT ISSUE ERROR MESSAGES. IT SUPPLIES A WORK * 44340000 * AREA FOR IKJEBEIA (INITIALIZATION MESSAGE FORMATTING MODULE) * 44360000 * AND INVOKES IT VIA LINK MACRO. UPON RETURN, THE PUTLINE CODE * 44380000 * RETURNED IS TESTED, AND THE COMMAND SYSTEM ERROR DIAGNOSTIC * 44400000 * MESSAGE ISSUED IF AN ERROR CONDITION HAS OCCURRED. * 44420000 * * 44440000 * ENTRY POINTS -- * 44460000 * IKJEBIN3 - VIA CALL MACRO FROM ANY EDIT INITIALIZATION * 44480000 * CSECT THAT ISSUES INFORMATIONAL MESSAGES. * 44500000 * * 44520000 * INPUT -- * 44540000 * REGISTER ONE (1) CONTAINS A POINTER TO AN INCOMPLETE PARAMETER * 44560000 * LIST FOR IKJEBEIA. IKJEBIN3 COMPLETES THE PARAMETER LIST BY * 44580000 * INITIALIZING THE SIXTH WORD TO THE ADDRESS OF A WORK AREA FOR THE* 44600000 * USE OF IKJEBEIA. * 44620000 * * 44640000 * OUTPUT -- * 44660000 * REGISTER FIFTEEN (15) CONTAINS THE RETURN CODE FROM THE FINAL * 44680000 * INVOCATION OF THE PUTLINE SERVICE ROUTINE. * 44700000 * * 44720000 * EXTERNAL REFERENCES -- * 44740000 * * 44760000 * IKJEBEIA - INVOKED VIA LINK FOR TERMINAL OUTPUT OF EDIT * 44780000 * MESSAGES. * 44800000 * * 44820000 * IKJEBEMS - INVOKED VIA IKJEBESH MACRO FOR TERMINAL OUTPUT * 44840000 * OF THE COMMAND SYSTEM ERROR DIAGNOSTIC FOR * 44860000 * ERROR RETURN CODES RETURNED BY IKJEBEIA. * 44880000 * * 44900000 * MACROS USED -- * 44920000 * * 44940000 * IKJEBEMG - FOR BUILDING A MESSAGE INSERTION. * 44960000 * * 44980000 * IKJEBEML - FOR BUILDING AN IKJEBEMS PARAMETER LIST. * 45000000 * * 45020000 * IKJEBEMI - GENERATES SYMBOLIC EQUATES FOR ALL RELATIVE * 45040000 * MESSAGE NUMBERS AND INSERTION OFFSETS AFFECTING * 45060000 * INITIALIZATION MESSAGES. * 45080000 * * 45100000 * IKJEBERT - RETURN LINKAGE WITHIN THE EDIT COMMAND * 45120000 * PROCESSOR. * 45140000 * * 45160000 * IKJEBESH - USED FOR INVOCATION OF EDIT SERVICE ROUTINES. * 45180000 * * 45200000 * IKJEBESV - ENTRY LINKAGE WITHIN THE EDIT COMMAND PROCESSOR. * 45220000 * * 45240000 * LINK - ISSUED TO INVOKE IKJEBEIA. * 45260000 * * 45280000 * EXITS, NORMAL -- * 45300000 * WHEN IKJEBEIA RETURNS A PUTLINE RETURN CODE OF ZERO, CONTROL * 45320000 * IS RETURNED BY BRANCHING ON REGISTER FOURTEEN (14). * 45340000 * * 45360000 * EXITS, ERROR -- * 45380000 * WHEN AN ERROR CONDITION IS INDICATED BY IKJEBEIA, THE COMMAND * 45400000 * SYSTEM ERROR MESSAGE IS ISSUED THROUGH IKJEBEMS. THE PUTLINE * 45420000 * RETURN CODE RETURNED IN REGISTER FIFTEEN (15) BY IKJEBEMS IS * 45440000 * RETURNED TO THE CALLING ROUTINE WHEN CONTROL IS RETURNED BY * 45460000 * BRANCHING ON REGISTER FOURTEEN (14). * 45480000 * * 45500000 * TABLES/WORK AREAS -- * 45520000 * * 45540000 * THE EDIT COMMUNICATION AREA CONTAINS CONTROL INFORMATION, * 45560000 * BUFFERS, AND A WORK AREA FOR THIS ROUTINE. * 45580000 * * 45600000 * ATTRIBUTES -- * 45620000 * REFRESHABLE, ENABLED, NON-PRIVILEGED * 45640000 * * 45660000 * CHARACTER CODE DEPENDENCY -- * 45680000 * THIS ROUTINE MAKES THE ASSUMPTION THAT ALL BITS OF THE HIGH * 45700000 * ORDER ZONE OF A CHARACTER DIGIT ARE COMMON TO THOSE OF A SIGNED * 45720000 * AND UNPACKED DECIMAL DIGIT. * 45740000 * * 45760000 * NOTES -- NONE. * 45780000 * * 45800000 *********************************************************************** 45820000 EJECT 45840000 IKJEBIN3 CSECT 45860000 IKJEBESV (14,12),,*,COMMREG=D0(PARMREG1) ENTRY LINKAGE. 45880000 USING IKJEBECA,COMMREG ADDRESSABILITY TO COMMUNICATION 45900000 * AREA. 45920000 LA PARMREG0,CATEMPBF ADDRESS OF WORK AREA FOR 45940000 * IKJEBEIA. 45960000 ST PARMREG0,D20(,PARMREG1) ADD WORK AREA ADDRESS TO 45980000 * PARAMETER LIST. 46000000 LINK EP=IKJEBEIA,MF=(E,(1)) INVOKE MESSAGE ROUTINE 46020000 * FOR EDIT INITIALIZATION. 46040000 LTR RETCDREG,RETCDREG CHECK IF TERMINAL OUTPUT 46060000 * SUCCESSFUL. 46080000 BZ IN300010 IF SO, RETURN TO CALLING ROUTINE. 46100000 CH RETCDREG,IN3ATTN CHECK FOR ATTENTION ISSUED. 46120000 BE IN300010 IF SO, RETURN TO CALLING ROUTINE. 46140000 CVD RETCDREG,IN3INS2 CONVERT RETURN CODE TO DECIMAL. 46160000 UNPK IN3INS2-D1(D3),IN3INS2+D6(D2) UNPACK SIGNIFICANT 46180000 * DIGITS. 46200000 OI IN3INS2+D1,INDCZERO INSURE CHARACTER DIGIT IN 46220000 * SECOND POSITION. 46240000 LA LENREG,D6 LENGTH OF SECOND INSERTION. 46260000 STH LENREG,IN3LEN2 SET LENGTH IN INSERTION LIST. 46280000 LA LENREG,M3131IN2 OFFSET FOR SECOND INSERTION. 46300000 STH LENREG,IN3OFF2 STORE OFFSET IN LIST. 46320000 SR LENREG,LENREG ZERO REGISTER. 46340000 ST LENREG,IN3PT2 INDICATE RETURN CODE AS LAST 46360000 * INSERTION. 46380000 MVC IN3PT1(D15),IN3SRINS MOVE SERVICE ROUTINE 46400000 * INSERTION TO WORK AREA. 46420000 LA LENREG,IN3PT2 ADDRESS SECOND INSERTION. 46440000 ST LENREG,IN3PT1 CHAIN INSERTIONS. 46460000 MVC IN3MSLST(D12),IN3MSPRM MOVE PARAMETER LIST 46480000 * TO WORK AREA. 46500000 LA LENREG,IN3PT1 ADDRESS FIRST INSERTION. 46520000 ST LENREG,IN3MSLST+D8 COMPLETE INSERTION CHAIN FOR 46540000 * SECOND LEVEL MESSAGE. 46560000 IKJEBESH (COMMREG),IKJEBEMS,PARAM=((COMMREG),IN3MSLST), X46580000 MF=(E,IN3WKA) PUT PUTLINE ERROR MESSAGE. 46600000 IN300010 EQU * 46620000 IKJEBERT (14,12),,RC=(15) RETURN TO CALLER WITH PUTLINE X46640000 RETURN CODE. 46660000 EJECT 46680000 *********************************************************************** 46700000 * 46720000 * CONSTANTS FOR IKJEBIN3 46740000 * 46760000 *********************************************************************** 46780000 SPACE 2 46800000 IN3MSPRM IKJEBEML M313,M3131,D0,D0,MF=L PARAMETER LIST FOR X46820000 COMMAND SYSTEM ERROR MESSAGE. 46840000 SPACE 2 46860000 IN3SRINS IKJEBEMG 0,M3131IN1,'PUTLINE' SERVICE ROUTINE NAME X46880000 INSERTION. 46900000 SPACE 2 46920000 IN3ATTN DC H'4' PUTLINE RETURN CODE 4 IS ATTENTION 46940000 * ISSUED. 46960000 EJECT 46980000 *********************************************************************** 47000000 * 47020000 * FOLLOWING IS INFORMATION ON ALL MESSAGES USED BY 47040000 * EDIT INITIALIZATION. 47060000 * 47080000 *********************************************************************** 47100000 SPACE 2 47120000 IKJEBEMI (301,302,303,304,305,306,307,308,309,310,311,312, X47140000 313,314,315,316,317,318,330,331,332,333,334,335,336, X47160000 342,343,360,361,362,363,364,365,424) 47180000 EJECT 47200000 TITLE 'IKJEBIN4 - VALIDITY CHECK EXIT FOR COMMAND OPERANDS' 47220000 IKJEBIN4 CSECT 47240000 IKJEBESV (14,12),,*,COMMREG=D4(,PARMREG1) 47260000 USING IKJEBECA,COMMREG COMMUNICATION AREA ADDRESSABILITY 47280000 SR RETCDREG,RETCDREG SET ZERO RETURN CODE. 47300000 L DATAREG,D0(,PARMREG1) ADDRESS OF PDE FOR NUMERIC 47320000 * SUBFIELD. 47340000 L AREAREG,IBNOADDR(,DATAREG) ADDRESS OF NUMBER 47360000 * ENTERED. 47380000 LH LENREG,IBNOLEN(,DATAREG) LENGTH OF NUMBER ENTERED. 47400000 BCTR LENREG,D0 REDUCE LENGTH BY ONE AND TEST FOR 47420000 EX LENREG,IBCLC001 ZERO. 47440000 BH IB001010 IF GREATER THAN ZERO, BRANCH TO 47460000 * RETURN. 47480000 LA RETCDREG,D4(,D0) SET ERROR RETURN CODE WHEN LESS 47500000 * THAN ZERO. 47520000 IB001010 EQU * 47540000 IKJEBERT (14,12),,RC=(15) RETURN TO IKJPARS. 47560000 SPACE 5 47580000 IBCLC001 CLC D0(*-*,AREAREG),IBZEROES CHECK FOR ZERO. 47600000 IBZEROES DC CL8'00000000' CONSTANT USED TO CHECK FOR ZEROES. 47620000 IBNOADDR EQU 0 OFFSET IN PDE TO OPERAND ADDRES.. 47640000 IBNOLEN EQU 4 OFFSET IN PDE TO OPERAND LENGTH. 47660000 EJECT 47680000 TITLE 'IKJEBIN5 - PROMPT FOR DATA SET TYPE PROCESSING' 47700000 *********************************************************************** 47720000 * * 47740000 * STATUS -- VERSION NO. 01, OS/360 RELEASE NO. 20 * 47760000 * * 47780000 * FUNCTION -- THIS ROUTINE IS CALLED BY THE IKJEBEIN AND IKJEBIN7 * 47800000 * CSECTS OF THE EDIT INITIALIZATION PROGRAM TO PROMPT THE TERMINAL * 47820000 * USER TO ENTER DATA SET TYPE. THIS IS ACCOMPLISHED BY INVOKING * 47840000 * IKJPARS, SPECIFYING A REQUIRED POSITIONAL PARAMETER AND * 47860000 * SUPPLYING A BLANK BUFFER TO 'PARSE'. THE VALIDITY CHECK EXIT * 47880000 * INDICATED IN THE PARSE PCL GAINS CONTROL TO CHECK THE TYPE * 47900000 * ENTERED IN RESPONSE TO A PROMPT MADE BY IKJPARS. IT REQUESTS * 47920000 * IKJPARS TO RE-PROMPT UNTIL BOTH OF THE FOLLOWING CONDITIONS ARE * 47940000 * MET -- * 47960000 * * 47980000 * (1) THE TYPE ENTERED IS FOUND IN A LOCAL TABLE OF EDITABLE DATA * 48000000 * SET TYPES. * 48020000 * * 48040000 * (2) THE TYPE ENTERED IS LOCATED BY THE PROCESSOR SEARCH ROUTINE * 48060000 * (IKJEBEPS) IN THE PROCESSOR DESCRIPTOR CSECT (IKJEBEPD). * 48080000 * * 48100000 * WHEN A VALID TYPE HAS BEEN ENTERED, THE TABLE ENTRY RETURNED * 48120000 * BY IKJEBEPS IS MOVED TO THE COMMUNICATION AREA PROCESSOR TABLE * 48140000 * FIELD (CAPD) AND CONTROL IS RETURNED TO THE CALLING ROUTINE. * 48160000 * * 48180000 * ENTRY POINTS -- * 48200000 * IKJEBIN5 - VIA CALL MACRO FROM IKJEBEIN OR IKJEBIN7 WHEN * 48220000 * IT IS NECESSARY TO PROMPT THE TERMINAL USER * 48240000 * FOR DATA SET TYPE. * 48260000 * * 48280000 * INPUT -- * 48300000 * REGISTER ONE (1) POINTS TO A WORD CONTAINING THE ADDRESS * 48320000 * OF THE EDIT COMMUNICATION AREA. * 48340000 * * 48360000 * OUTPUT -- * 48380000 * REGISTER FIFTEEN (15) CONTAINS -- * 48400000 * 00 - SUCCESSFUL OPERATION. * 48420000 * 04 - IKJPARS ERROR (TERMINATE EDIT). * 48440000 * * 48460000 * EXTERNAL REFERENCES -- * 48480000 * * 48500000 * IKJEBEPS - THE EDIT PROCESSOR SEARCH ROUTINE, LOADED * 48520000 * AND CALLED TO VALIDATE A DATA SET TYPE AND * 48540000 * RETURN PROCESSOR DEPENDENT INFORMATION FOR * 48560000 * VALID DATA SET TYPES * 48580000 * IKJEBIN3 - CALLED FOR PROCESSING EDIT MESSAGES * 48600000 * IKJPARS - INVOKED VIA LINK MACRO TO SYNTAX CHECK THE A45713 48620000 * RESPONSE FROM IKJPTGT A45713 48640000 * IKJPTGT - INVOKED VIA PUTGET MACRO TO PROMPT THE USER A45713 48660000 * FOR DATA SET TYPE A45713 48680000 * * 48700000 * MACROS USED -- * 48720000 * * 48740000 * CALL - LINKAGE TO IKJEBEPS AND IKJEBIN3. * 48760000 * DELETE - USED TO DELETE IKJEBEPS FROM MAIN STORAGE. * 48780000 * IKJEBERT - RETURN LINKAGE WITHIN THE EDIT COMMAND * 48800000 * PROCESSOR. * 48820000 * IKJEBESV - ENTRY LINKAGE WITHIN THE EDIT COMMAND PROCESSOR. * 48840000 * IKJENDP - DEFINES THE END OF THE IKJPARS PCL. * 48860000 * IKJIDENT - BUILDS A PCE FOR THE DATA SET TYPE POSITIONAL * 48880000 * PARAMETER. * 48900000 * IKJPARMD - DEFINES A PCL FOR IKJPARS. * 48920000 * LINK - LINKAGE TO IKJPARS. * 48940000 * LOAD - USED TO LOAD THE PROCESSOR SEARCH ROUTINE * 48960000 * (IKJEBEPS) INTO MAIN STORAGE. * 48980000 * PUTGET - USED TO LINK TO IKJPTGT. A45713 49000000 * * 49020000 * EXITS, NORMAL -- * 49040000 * RETURN TO THE CALLING ROUTINE BY BRANCHING ON REGISTER FOURTEEN * 49060000 * (14) WITH REGISTER FIFTEEN (15) SET TO ZERO. * 49080000 * * 49100000 * EXITS, ERROR -- * 49120000 * RETURN TO THE CALLING ROUTINE BY BRANCHING ON REGISTER * 49140000 * FOURTEEN (14) WITH REGISTER FIFTEEN (15) SET TO FOUR (4). * 49160000 * * 49180000 * TABLES/WORK AREAS -- * 49200000 * * 49220000 * THE EDIT COMMUNICATION AREA CONTAINS CONTROL INFORMATION AND * 49240000 * A WORK AREA FOR THIS ROUTINE -- * 49260000 * * 49280000 * CADSTYPE - DATA SET TYPE FIELD. * 49300000 * CAPD - THIS PROCESSOR TABLE FIELD IS UPDATED BY MOVING THE * 49320000 * TABLE ENTRY RETURNED BY IKJEBEPS. * 49340000 * * 49360000 * ATTRIBUTES -- * 49380000 * REFRESHABLE, ENABLED, NON-PRIVILEGED * 49400000 * * 49420000 * CHARACTER CODE DEPENDENCY -- NONE. * 49440000 * * 49460000 * NOTES -- * 49480000 * * 49500000 *********************************************************************** 49520000 EJECT 49540000 IKJEBIN5 CSECT 49560000 IKJEBESV (14,12),,*,COMMREG=D0(,PARMREG1) SAVE REGISTERS 49580000 USING IKJEBECA,COMMREG ESTABLISH ADDRESSABILITY TO THE 49600000 * COMMUNICATION AREA. 49620000 IC001010 EQU * A45713 49640000 **************************************************************** A45713 49660000 * A45713 49680000 * BUILD PARMLIST AND LINK TO IKJPTGT TO PROMPT USER FOR DATA A45713 49700000 * SET TYPE. A45713 49720000 * A45713 49740000 **************************************************************** A45713 49760000 LA AREAREG,INPGLIST ADDRESS OF PUTGET PARMBLOCK. A45713 49780000 USING PGPB,AREAREG ESTAB. ADDRESSABILITY TO PARMBLOCK.A45713 49800000 XC PGPB(INPGPBLN),PGPB ZERO OUT PARMBLOCK. A45713 49820000 ST AREAREG,CATMPLST+IOPLIOPB-IOPL A45713 49840000 LA PARMREG1,CATMPLST ADDRESS OF PUTGET PARMLIST. A45713 49860000 PUTGET ,OUTPUT=(INPMTOLD,SINGLE,PROMPT), A45713*49880000 TERMGET=(EDIT,WAIT), A45713*49900000 TERMPUT=(EDIT,WAIT,NOHOLD,NOBREAK),MF=(E,(1)) A45713 49920000 B IC001015(RETCDREG) PROCESS RETURN CODE. A45713 49940000 SPACE 49960000 IC001015 EQU * A45713 49980000 B IC001050 RC = 00, SUCCESSFUL RETURN. A45713 50000000 B IC001020 RC = 04, SOURCE OF INPUT IN-CORE. A45713 50020000 B IC001065 RC = 08, ATTENTION ISSUED. A45713 50040000 B IC001040 RC = 12, TRYING TO PROMPT IN PROC. A45713 50060000 B IC001020 RC = 16, NOWAIT SPECIFIED FOR TPUT.A45713 50080000 B IC001020 RC = 20, NOWAIT SPECIFIED FOR TGET.A45713 50100000 B IC001020 RC = 24, INVALID PARAMETERS. A45713 50120000 B IC001030 RC = 28, NOT ENOUGH CORE AVAILABLE.A45713 50140000 SPACE 2 50160000 IC001020 EQU * A45713 50180000 **************************************************************** A45713 50200000 * A45713 50220000 * ISSUE COMMAND SYSTEM ERROR MESSAGE AND TERMINATE. A45713 50240000 * A45713 50260000 **************************************************************** A45713 50280000 LA ERR1REG,INERROR2 RELATIVE ERROR TO BE PROCESSED. A45713 50300000 LR DATA2REG,RETCDREG SAVE RETURN CODE FOR MESSAGE. A45713 50320000 O DATA2REG,ICPTGT INDICATE ROUTINE NAME IS IKJPTGT. A45713 50340000 B IC001045 BRANCH TO CALL IKJEBIN3 TO PUT A45713 50360000 * ERROR MESSAGE AND RETURN. A45713 50380000 SPACE 2 50400000 IC001030 EQU * A45713 50420000 **************************************************************** A45713 50440000 * A45713 50460000 * ISSUE NO MAIN STORAGE AVAILABLE MESSAGE AND TERMINATE. A45713 50480000 * A45713 50500000 **************************************************************** A45713 50520000 LA ERR1REG,INERROR1 RELATIVE ERROR TO BE PROCESSED. A45713 50540000 B IC001045 BRANCH TO CALL IKJEBIN3 TO PUT A45713 50560000 * ERROR MESSAGE AND TERMINATE. A45713 50580000 SPACE 2 50600000 IC001040 EQU * A45713 50620000 **************************************************************** A45713 50640000 * A45713 50660000 * ISSUE MISSING DATA SET TYPE AND TERMINATE. A45713 50680000 * A45713 50700000 **************************************************************** A45713 50720000 LA ERR1REG,INERRORX RELATIVE ERROR TO BE PROCESSED. A45713 50740000 IC001045 EQU * 50760000 L EPLOCREG,ICMSGRTN ADDRESS OF MESSAGE ROUTINE. A45713 50780000 CALL (15),((COMMREG),(ERR1REG),(ERR2REG),(DATA1REG), *50800000 (DATA2REG)),MF=(E,INSVCRTN) 50820000 B IC001065 BRANCH TO RETURN TO CALLER WITH RC=4. 50840000 SPACE 2 50860000 IC001050 EQU * A45713 50880000 L PCLREG,ICPTPCL ADDRESS OF PCL FOR IKJPARS. 50900000 L AREAREG,PGPBIBUF ADDRESS OF BUFFER. A45713 50920000 DROP AREAREG A45713 50940000 LA PDLREG,INPDLPTR SPECIFY ADDRESS OF AREA IN A45713 50960000 * WHICH IKJPARS RETURNS ADDRESS 50980000 * OF PDL. 51000000 LA PARMREG1,CATMPLST LOAD PARAM REG 1 @YA02225 51008000 LR RETREG,(PCLREG) PICK UP PARAMETER @YA02225 51016000 LR RETCDREG,(PDLREG) PICK UP PARAMETER @YA02225 51024000 LR PARMREG0,(AREAREG) PICK UP PARAMETER @YA02225 51032000 STM 14,0,12(1) STORE INTO PARAM LIST @YA02225 51040000 ST (COMMREG),24(0,1) STORE INTO PARAM LSIT @YA02225 51048000 CALLTSSR EP=IKJPARS,MF=(E,CATMPLST) INVOKE PARSE @YA02225X51056000 SERVICE ROUTINE @YA02225 51064000 LTR RETCDREG,RETCDREG TEST FOR SUCCESSFUL COMPLETION. 51140000 BZ IC001070 IF SUCCESSFUL, BRANCH TO RETURN A45713 51160000 LA ERR1REG,D8 51180000 CR ERR1REG,RETCDREG CHECK FOR RETURN CODE 4 OR 8. 51200000 BNL IC001065 IF 4 OR 8, RETURN WITH NO A45713 51220000 * DIAGNOSTIC MESSAGE. 51240000 LA ERR1REG,INERROR2 RELATIVE ERROR TO BE PROCESSED. 51260000 LR DATA2REG,RETCDREG SAVE RETURN CODE FOR MESSAGE. 51280000 O DATA2REG,ICPARS INDICATE ROUTINE NAME AS IKJPARS. 51300000 CALL IKJEBIN3,((COMMREG),(ERR1REG),,,(DATA2REG)), X51320000 MF=(E,INSVCRTN) PUT ERROR MESSAGE TO USER. 51340000 IC001065 EQU * A45713 51360000 LA RETCDREG,D4(,D0) SET ERROR RETURN CODE FOR CALLER. 51380000 IC001068 EQU * A45713 51400000 IKJEBERT (14,12),,RC=(15) RESTORE REGISTERS AND RETURN. 51420000 EJECT 51440000 IC001070 EQU * A45713 51460000 * A45713 51480000 * DETERMINE IF VALID DATA SET TYPE ENTERED. A45713 51500000 * A45713 51520000 L DATAREG,INPDLPTR OBTAIN POINTER TO PROMPT PDL. A45713 51540000 USING ICDSTPDL,DATAREG ESTAB. ADDRESSABILITY TO PDL. A45713 51560000 LH INDEXREG,INDSTYP2 OBTAIN KEYWORD NO. A45713 51580000 LTR INDEXREG,INDEXREG CHECK IF DSTYPE ENTERED. A45713 51600000 BNZ IC001080 IF YES, BRANCH TO PROCESS DSTYPE. A45713 51620000 IKJRLSA INPDLPTR RELEASE PDL CORE. A45713 51640000 LH PARMREG0,D0(,AREAREG) LENGTH OF PUTGET BFR. A45713 51660000 L PARMREG1,INPGLIST+PGPBIBUF-PGPB PTR TO BFR ADDR. A45713 51680000 O PARMREG0,ICSUBPL1 SET SUBPOOL VALUE TO ONE. A45713 51700000 FREEMAIN R,LV=(0),A=(1) FREE PUTGET BUFFER. A45713 51720000 B IC001010 BRANCH TO RE-PROMPT USER. A45713 51740000 SPACE 2 51760000 IC001080 EQU * A45713 51780000 SLL INDEXREG,D3(D0) MULTIPLY INDEX BY EIGHT. A45713 51800000 L AREAREG,ICPTTYPE ADDRESS OF DATA SET TYPE TABLE. A45713 51820000 SH AREAREG,ICCONST8 SUBTRACT EIGHT FOR ZERO ORIGIN. A45713 51840000 LA AREAREG,D0(INDEXREG,AREAREG) OBTAIN ADDRESS OF A45713 51860000 * DATA SET TYPE SPECIFIED. A45713 51880000 MVC CADSTYPE(INDSTELN),D0(AREAREG) MOVE DATA SET TYPE A45713 51900000 * INTO COMMUNICATION AREA. A45713 51920000 LOAD EP=IKJEBEPS LOAD IKJEBEPS. 51940000 LR EPLOCREG,PARMREG0 COPY ENTRY POINT ADDRESS. 51960000 CALL (15),,MF=(E,CADSTYPE) BRANCH TO IKJEBEPS. 51980000 LTR RETCDREG,RETCDREG TEST FOR SUCCESSFUL COMPLETION. 52000000 BZ IC002070 BRANCH TO MOVE TABLE ENTRY TO THE 52020000 * COMMUNICATION AREA. 52040000 LA RETCDREG,RCODE4 SET RETURN CODE 4 FOR CALLER. A45713 52060000 IC002060 EQU * 52080000 DELETE EP=IKJEBEPS DELETE IKJEBEPS. 52100000 B IC001068 BRANCH TO RETURN TO CALLER. A45713 52120000 IC002070 EQU * 52140000 MVC CADSTYPE(CADATEXT-CAPD),D0(PARMREG1) MOVE FIRST Y02676 52190000 * PORTION OF TYPE-DEPENDENT Y02676 52200000 * INFORMATION TO THE Y02676 52210000 * COMMUNICATION AREA. Y02676 52212000 LA RETCDREG,CAPDEXT OBTAIN ADDRESS OF PROCESSOR Y02676 52214000 * TABLE EXTENSION. Y02676 52216000 ST RETCDREG,CAPTPDXT STORE PTR TO EXTENSION AREA. Y02676 52218000 USING IKJEBECX,RETCDREG EXTENSION ADDRESSABILITY. Y02676 52218400 MVC CXDATEXT(CXDLEN),CADATEXT-CAPD(PARMREG1) MOVE Y02676 52218800 * REMAINING INFORMATION TO Y02676 52219200 * TABLE EXTENSION AREA. Y02676 52219600 DROP RETCDREG END EXTENSION ADDRESSABILITY. Y02676 52219700 SR RETCDREG,RETCDREG SET SUCCESSFUL RETURN CODE FOR 52220000 * IKJPARS. 52240000 B IC002060 BRANCH TO DELETE IKJEBEPS. 52260000 EJECT 52280000 *********************************************************************** 52300000 * * 52320000 * EQUATES, CONSTANTS, AND AREAS USED BY THIS CSECT. * 52340000 * * 52360000 *********************************************************************** 52380000 ICPTPCL DC A(IKJEBIN6) ADDRESS OF PCL FOR DATA SET TYPE 52400000 * PROMPT. 52420000 ICMSGRTN DC V(IKJEBIN3) ADDRESS OF MESSAGE ROUTINE. 52440000 ICPARS DC XL4'01000000' INDICATOR FOR IKJPARS SERVICE 52460000 * ROUTINE. 52480000 ICPTGT DC XL4'07000000' INDICATOR FOR IKJPTGT SERV. RTN. 52500000 ICPTTYPE DC V(IKJEBIN0) ADDRESS OF DATA SET TYPE TABLE. 52520000 SPACE 52540000 * DATA SET TYPE PROMPT MESSAGE. A45713 52560000 INPRMTMG DC AL2(INPRMTLN) MESSAGE LENGTH. A45713 52580000 DC H'0' MESSAGE OFFSET. A45713 52600000 DC C'IKJ52567A ' MESSAGE IDENTIFIER. A45713 52620000 DC C'ENTER DATA SET TYPE-' MESSAGE TEXT. A45713 52640000 INPRMTLN EQU *-INPRMTMG LENGTH OF PROMPT MESSAGE. A45713 52660000 * OUTPUT LINE DESCRIPTOR FOR DSTYPE PROMPT MESSAGE. A45713 52680000 INPMTOLD DC F'1' NO. OF MESSAGE SEGMENTS. A45713 52700000 DC A(INPRMTMG) ADDRESS OF MESSAGE. A45713 52720000 SPACE 52740000 ICSUBPL1 DC XL4'01000000' INDICATOR FOR SUBPOOL ONE. A45713 52760000 ICCONST8 DC H'8' CONSTANT OF EIGHT. A45713 52780000 TITLE 'IKJEBIN6 - PCL FOR DATA SET TYPE PROMPT' 52800000 IKJEBIN6 IKJPARM DSECT=ICDSTPDL BEGIN PCL FOR DATA SET TYPE. 52820000 INDSTYP2 IKJKEYWD 52840000 .* INITIALIZE INDEX 'J' TO ONE. A45714 52860000 &J SETA 1 A45714 52880000 .TAG9 ANOP A45714 52900000 .* CHECK IF LOOP FINISHED - INDEX 'J' GT NO. OF DSTYPES. A45714 52920000 AIF (&J GT &I).OUT3 A45714 52940000 .* CHECK FOR DSTYPES WITH SPECIAL SUBFIELDS. A45714 52960000 AIF ('&DST(&J)' EQ 'PLI').TAG10 A45714 52980000 AIF ('&DST(&J)' EQ 'IPLI').TAG11 A45714 53000000 AIF ('&DST(&J)' EQ 'GOFORT').TAG12 A45714 53020000 AIF ('&DST(&J)' EQ 'PLIF').TAG13 A45714 53040000 .* CHECK IF DSTYPE IS USER TYPE. A45714 53060000 AIF (&J LE 16).TAG9A Y02676 53080000 AIF (&SW EQ 1).TAG14 A45714 53100000 .TAG9A ANOP A45714 53120000 IKJNAME '&DST(&J)' - EDIT DATA SET TYPE. A45714 53140000 AGO .LOOP2 A45714 53160000 .TAG10 ANOP A45714 53180000 IKJNAME 'PLI',SUBFLD=INPLI2 - EDIT DATA SET TYPE. A45714 53200000 AGO .LOOP2 A45714 53220000 .TAG11 ANOP A45714 53240000 IKJNAME 'IPLI',SUBFLD=INIPLI2 - EDIT DATA SET TYPE. A45714 53260000 AGO .LOOP2 A45714 53280000 .TAG12 ANOP A45714 53300000 IKJNAME 'GOFORT',SUBFLD=INTSFTN2 - EDIT DATA SET TYPE. A45714 53320000 AGO .LOOP2 A45714 53340000 .TAG13 ANOP A45714 53360000 IKJNAME 'PLIF',SUBFLD=INPLI2 - EDIT DATA SET TYPE. A45714 53380000 AGO .LOOP2 A45714 53400000 .TAG14 ANOP A45714 53420000 &K SETA &J-16 Y02676 53440000 .* CHECK IF USER EXIT SUPPLIED FOR DSTYPE. A45714 53460000 AIF ('&SUBFD(&K)' EQ '').TAG9A A45714 53480000 IKJNAME '&DST(&J)',SUBFLD=INUXRTY2 - USER DSTYPE. A45714 53500000 .LOOP2 ANOP A45714 53520000 .* INCREMENT LOOP INDEX 'J' BY ONE. A45714 53540000 &J SETA &J+1 A45714 53560000 AGO .TAG9 A45714 53580000 .OUT3 ANOP A45714 53600000 * SUBFIELD DESCRIPTION FOR PL1. A45714 53620000 INPLI2 IKJSUBF 53640000 INPLICL1 IKJIDENT 'NUMBER',FIRST=NUMERIC,OTHER=NUMERIC, A45714*53660000 DEFAULT='2',VALIDCK=IKJEBIN4 LEFT SOURCE MARGIN. A45714 53680000 INPLICL2 IKJIDENT 'NUMBER',FIRST=NUMERIC,OTHER=NUMERIC, A45714*53700000 DEFAULT='72',VALIDCK=IKJEBIN4 RIGHT SOURCE MARGIN.A45714 53720000 INPLITYP IKJKEYWD DEFAULT='CHAR60' CHARACTER SET USED. A45714 53740000 IKJNAME 'CHAR60' 60 CHARACTER SET. A45714 53760000 IKJNAME 'CHAR48' 48 CHARACTER SET. A45714 53780000 INIPLI2 IKJSUBF 53800000 INIPLIC2 IKJKEYWD DEFAULT='CHAR60' CHARACTER SET TO BE USED. A45714 53820000 IKJNAME 'CHAR60' 60-CHARACTER SET. A45714 53840000 IKJNAME 'CHAR48' 48-CHARACTER SET. A45714 53860000 * SUBFIELD DESCRIPTION FOR GOFORT. A45714 53880000 INTSFTN2 IKJSUBF 53900000 INTSFTF2 IKJKEYWD DEFAULT='FREE' DEFINE STATEMENT FORMAT. A45714 53920000 IKJNAME 'FREE' FREE FORMAT STATEMENTS. 1A45714 53940000 IKJNAME 'FIXED' FIXED FORMAT STATEMENTS. 2A45714 53960000 .* CHECK IF USER EXIT SUPPLIED. A45714 53980000 AIF (&SW EQ 0).TAG15 A45714 54000000 * SUBFIELD DESCRIPT. FOR USER TYPES. A45714 54020000 INUXRTY2 IKJSUBF 54040000 INUSRTY2 IKJIDENT 'DATA SET TYPE PARAMETERS',FIRST=ANY,OTHER=ANY A45714 54060000 .TAG15 ANOP A45714 54080000 IKJENDP 54100000 EJECT 54120000 TITLE 'IKJEBIN7 - PARTIALLY QUALIFIED DSNAME PROCESSING' 54140000 *********************************************************************** 54160000 * * 54180000 * STATUS -- VERSION NO. 01, OS/360 RELEASE NO. 20 * 54200000 * * 54220000 * FUNCTION -- THIS ROUTINE IS CALLED BY THE IKJEBEIN CSECT OF THE * 54240000 * EDIT INITIALIZATION PROGRAM WHENEVER A PARTIALLY QUALIFIED * 54260000 * DSNAME IS ENTERED ON THE EDIT COMMAND. IT SCANS OFF THE * 54280000 * RIGHTMOST QUALIFIER OF THE DSNAME AND DETERMINES IF THE NAME * 54300000 * IS (1) SINGLE-LEVEL OR (2) MULTI-LEVEL. IF SINGLE-LEVEL, IT * 54320000 * UNCONDITIONALLY APPENDS A DESCRIPTIVE QUALIFIER FOR THE DATA * 54340000 * SET TYPE ENTERED OR PROMPTED FOR. IT ALSO TAKES THE ABOVE * 54360000 * ACTION WHEN THE RIGHTMOST QUALIFIER OF A MULTI-LEVEL NAME IS NOT * 54380000 * DESCRIPTIVE FOR THE DATA SET TYPE ENTERED ON THE COMMAND. IF * 54400000 * THE NAME IS MULTI-LEVEL AND DATA SET TYPE WAS NOT SPECIFIED, * 54420000 * IT DETERMINES WHETHER THE RIGHTMOST QUALIFIER IS DESCRIPTIVE * 54440000 * FOR ANY DATA SET TYPE BY LOADING AND CALLING THE EDIT * 54460000 * PROCESSOR SEARCH ROUTINE (IKJEBEPS). IF THE QUALIFIER IS * 54480000 * DESCRIPTIVE, DATA SET TYPE DEFAULTS BASED ON THE QUALIFIER. * 54500000 * OTHERWISE DATA SET TYPE IS PROMPTED FOR AND THE ASSOCIATED * 54520000 * QUALIFIER IS APPENDED TO THE DSNAME ENTERED. THE PARTIALLY- * 54540000 * QUALIFIED NAME IS ALWAYS ADJUSTED SUCH THAT PARAMETERS FOR THE * 54560000 * DEFAULT SERVICE ROUTINE (IKJDFLT) DO NOT CONTAIN ANY * 54580000 * REDUNDANCY BETWEEN (1) THE RIGHTMOST QUALIFIER OF THE DSNAME AND * 54600000 * (2) THE QUALIFIER TO BE SUFFIXED TO THE NAME. THE DEFAULT * 54620000 * SERVICE ROUTINE IS INVOKED TO (1) FULLY QUALIFY THE NAME * 54640000 * SYNTACTICALLY AND (2) TO PERFORM A CATALOG SEARCH ON THE FULLY * 54660000 * QUALIFIED DSNAME. THE RETURN CODE FROM THE DEFAULT SERVICE * 54680000 * ROUTINE IS CHECKED AND ERROR MESSAGES ISSUED IF NECESSARY. * 54700000 * * 54720000 * ENTRY POINTS -- * 54740000 * IKJEBIN7 - VIA CALL MACRO FROM IKJEBEIN, THE MAIN CSECT * 54760000 * OF THE EDIT INITIALIZATION PROGRAM WHEN A * 54780000 * PARTIALLY QUALIFIED DSNAME IS ENTERED ON THE * 54800000 * EDIT COMMAND. * 54820000 * * 54840000 * INPUT -- * 54860000 * REGISTER ONE (1) CONTAINS A POINTER TO A WORD CONTAINING THE * 54880000 * ADDRESS OF THE EDIT COMMUNICATION AREA. * 54900000 * * 54920000 * OUTPUT -- * 54940000 * REGISTER FIFTEEN (15) CONTAINS ONE OF THE FOLLOWING * 54960000 * RETURN CODES -- * 54980000 * * 55000000 * 00 - SUCCESSFUL COMPLETION. * 55020000 * 04 - TERMINATION REQUIRED - ERROR OCCURRED. * 55040000 * * 55060000 * EXTERNAL REFERENCES -- * 55080000 * * 55100000 * IKJDFLT - DEFAULT SERVICE ROUTINE, INVOKED VIA LINK TO * 55120000 * QUALIFY THE NAME SUPPLIED BY THE USER AND TO * 55140000 * PERFORM A CATALOG SEARCH ON IT. * 55160000 * IKJEBIN3 - CSECT OF EDIT INITIALIZATION CALLED FOR * 55180000 * INITIAL MESSAGE PROCESSING. * 55200000 * IKJEBIN5 - CSECT OF EDIT INITIALIZATION CALLED TO PROMPT * 55220000 * THE USER FOR DATA SET TYPE. * 55240000 * * 55260000 * MACROS USED -- * 55280000 * * 55300000 * CALL - USED FOR LINKAGE TO MODULES CONTAINED IN THE * 55320000 * LOAD MODULE AS WELL AS IKJEBEPS, THE PROCESSOR * 55340000 * SEARCH ROUTINE. * 55360000 * DELETE - USED TO DELETE THE IKJEBEPS MODULE FROM MAIN * 55380000 * STORAGE. * 55400000 * IKJEBERT - RETURN LINKAGE WITHIN THE EDIT COMMAND PROCESSOR.* 55420000 * IKJEBESV - ENTRY LINKAGE WITHIN THE EDIT COMMAND PROCESSOR. * 55440000 * LINK - ISSUED TO INVOKE THE DEFAULT SERVICE ROUTINE. * 55460000 * LOAD - ISSUED TO LOAD IKJEBEPS INTO MAIN STORAGE. * 55480000 * * 55500000 * EXITS, NORMAL -- * 55520000 * RETURN TO IKJEBEIN BY BRANCHING ON REGISTER FOURTEEN (14) * 55540000 * WITH REGISTER FIFTEEN (15) SET TO ZERO (0). * 55560000 * * 55580000 * EXITS, ERROR -- * 55600000 * RETURN TO IKJEBEIN BY BRANCHING ON REGISTER FOURTEEN (14) * 55620000 * WITH REGISTER FIFTEEN (15) SET TO FOUR (4). * 55640000 * * 55660000 * TABLES/WORK AREAS -- * 55680000 * * 55700000 * THE EDIT COMMUNICATION AREA CONTAINS CONTROL INFORMATION AND * 55720000 * A WORK AREA FOR THIS ROUTINE. THE FOLLOWING FIELDS ANR (1) USED * 55740000 * AS INPUT AND (2) ARE UPDATED BY THIS ROUTINE -- * 55760000 * * 55780000 * CADSQUAL - DESCRIPTIVE QUALIFIER FIELD. * 55800000 * * 55820000 * CAEDDSN - DSNAME ENTERED BY THE USER AND QUALIFIED BY THIS * 55840000 * ROUTINE. * 55860000 * * 55880000 * THE PROCESSOR TABLE (BEGINNING AT OFFSET 'CAPD') IS INITIALIZED * 55900000 * BY THIS ROUTINE OR BY IKJEBIN5 WHENEVER THE DATA SET TYPE IS * 55920000 * DEFAULTED OR PROMPTED FOR. * 55940000 * * 55960000 * ATTRIBUTES -- * 55980000 * REFRESHABLE, ENABLED, NON-PRIVILEGED * 56000000 * * 56020000 * CHARACTER CODE DEPENDENCY -- NONE. * 56040000 * * 56060000 * NOTES -- NONE. * 56080000 * * 56100000 *********************************************************************** 56120000 EJECT 56140000 IKJEBIN7 CSECT 56160000 *********************************************************************** 56180000 * 56200000 * PROLOGUE 56220000 * 56240000 *********************************************************************** 56260000 IKJEBESV (14,12),,*,COMMREG=D0(,PARMREG1) ENTRY LINKAGE 56280000 USING IKJEBECA,COMMREG ESTABLISH COMMUNICATION AREA 56300000 * ADDRESSABILITY 56320000 XC IN7WORK(IN7WKLEN),IN7WORK ZERO WORK AREA. 56340000 EJECT 56360000 *********************************************************************** 56380000 * 56400000 * THIS SECTION SCANS THE USER-SUPPLIED NAME. IF THE NAME IS NULL OR 56420000 * CONTAINS ONE LEVEL ONLY, A SWITCH IS SET TO INDICATE THAT NO 56440000 * QUALIFIER CHECKING IS TO BE DONE. OTHERWISE, THE LENGTH AND 56460000 * ADDRESS OF THE RIGHTMOST QUALIFIER ARE ESTABLISHED. 56480000 * 56500000 *********************************************************************** 56520000 SPACE 2 56540000 LH LENREG,CAEDDSNL GET LENGTH OF USER SUPPLIED NAME. 56560000 LA TMPREG,D2 CONSTANT FOR COMPARES. 56580000 SR LENREG,TMPREG IF USER NAME IS 2 CHARACTERS OR LESS, 56600000 BNH ID000020 BRANCH TO INDICATE SIMPLE NAME. 56620000 LA QUALREG,CAEDDSN(LENREG) ADDRESS NEXT-TO-LAST CHAR. 56640000 ID000010 EQU * 56660000 CLI D0(QUALREG),INPERIOD IS CHARACTER A PERIOD - 56680000 BE ID000030 IF SO, QUALIFIER CHECK IS REQUIRED. 56700000 BCTR QUALREG,D0 ADDRESS NEXT CHARACTER TO LEFT. 56720000 BCT LENREG,ID000010 DECREMENT LEN AND REPEAT IF GT 0. 56740000 ID000020 EQU * 56760000 OI IN7FLAGS,IN7NOQLF INDICATE NO QUALIFIER CHECKING. 56780000 B ID000040 BRANCH TO CONTINUE PROCESSING. 56800000 ID000030 EQU * 56820000 NI IN7FLAGS,IN7QLFCK INDICATE QUALIFIER CHECKING. 56840000 SH LENREG,CAEDDSNL SUBTRACT FULL LENGTH FROM LENGTH. 56860000 LCR LENREG,LENREG COMPLEMENT TO GET QUALIFIER LENGTH. 56880000 SR LENREG,TMPREG ADJUST QUALIFIER LENGTH FOR 56900000 * SS OPERATIONS 56920000 EJECT 56940000 *********************************************************************** 56960000 * 56980000 * THIS SECTION MAKES NECESSARY CHECKS ON THE RIGHTMOST QUALIFIER. 57000000 * 57020000 * IF NO QUALIFIER CHECKS ARE NECESSARY, DATA SET TYPE IS PROMPTED 57040000 * FOR IF NOT ENTERED ON THE COMMAND. THE DEFAULT SERVICE ROUTINE 57060000 * MAY THEN BE INVOKED TO QUALIFY THE USER-SUPPLIED NAME. 57080000 * 57100000 * IF QUALIFIER CHECKING IS NECESSARY, IKJEBEPS IS INVOKED TO 57120000 * DETERMINE WHETHER THE RIGHTMOST QUALIFIER IS DESCRIPTIVE FOR 57140000 * EDIT. IF NOT, PROCESSING IS BASED ON THE QUALIFIER ASSOCIATED 57160000 * WITH THE DATA SET TYPE ENTERED OR PROMPTED FOR. IF THE QUALIFIER 57180000 * IS DESCRIPTIVE AND DATA SET TYPE WAS NOT ENTERED ON THE COMMAND 57200000 * DATA SET TYPE IS BASED ON THE REGHTMOST QUALIFIER OF THE DSNAME. 57220000 * IF THE QUALIFIER IS DESCRIPTIVE AND DATA SET TYPE WAS ENTERED, 57240000 * STRIPPING OF THE QUALIFIER IS PERFORMED WHEN THE QUALIFIER 57260000 * IS DESCRIPTIVE FOR THE DATA SET TYPE ENTERED. 57280000 * 57300000 *********************************************************************** 57320000 SPACE 2 57340000 ID000040 EQU * 57360000 TM IN7FLAGS,IN7NOQLF IS QUALIFIER CHECKING NECESSARY - 57380000 BZ ID000060 IF NECESSARY, BRANCH TO VALIDATE 57400000 CLI CADSCODE,CANOTYPE WAS DATA SET TYPE ENTERED - 57420000 BNE ID000130 IF SO, BRANCH TO INVOKE DEFAULT. 57440000 ID000050 EQU * 57460000 CALL IKJEBIN5,((COMMREG)),MF=(E,IN7PLIST) CALL IKJEBIN5 57480000 * TO PROMPT FOR DATA SET TYPE. 57500000 LTR RETCDREG,RETCDREG WAS PROMPT SUCCESSFUL - 57520000 BZ ID000110 IF SO, BRANCH TO INVOKE DEFAULT. 57540000 BNZ IDRETCD4 IF NOT, RETURN TO IKJEBEIN WITH RC=4. 57560000 EJECT 57580000 ID000060 EQU * 57600000 LOAD EP=IKJEBEPS LOAD PROCESSOR SEARCH ROUTINE. 57620000 OI IN7FLAGS,IN7DELPS SPECIFY DELETE NECESSARY FOR 57640000 * ROUTINE. 57660000 LR EPLOCREG,PARMREG0 COPY ENTRY POINT ADDRESS. 57680000 LA PARMREG1,D1(,QUALREG) POINT TO QUALIFIER. 57700000 LCR PARMREG1,PARMREG1 SPECIFY SEARCH ON QUALIFIER. 57720000 CALL (15),MF=(E,(1)) CALL IKJEBEPS. 57740000 LTR RETCDREG,RETCDREG IS QUALIFIER DESCRIPTIVE - 57760000 BNZ ID000070 IF NOT, BRANCH TO CHECK DATA SET TYPE. 57780000 CLI CADSCODE-CAPD(PARMREG1),CAEDTTYP IS QUALIFIER 57800000 * DESCRIPTIVE FOR EDIT - 57820000 BNH ID000080 IF SO, BRANCH TO CHECK DATA SET 57840000 * TYPE ENTERED AGAINST QUALIFIER. 57860000 ID000070 EQU * 57880000 CLI CADSCODE,CANOTYPE DATA SET TYPE ENTERED ON COMMAND - 57900000 BE ID000050 IF NOT, BRANCH TO CAUSE PROMPT. 57920000 B ID000120 IF SO, BRANCH TO INVOKE DEFAULT. 57940000 ID000080 EQU * 57960000 CLI CADSCODE,CANOTYPE WAS TYPE ENTERED ON COMMAND - 57980000 BNE ID000100 IF SO, BRANCH TO COMPARE QUALIFIERS. 58000000 MVC CADSTYPE(CADATEXT-CAPD),D0(PARMREG1) MOVE FIRST Y02676 58050000 * PORTION OF TYPE-DEPENDENT Y02676 58052000 * INFORMATION TO THE Y02676 58054000 * COMMUNICATION AREA. Y02676 58056000 LA RETCDREG,CAPDEXT OBTAIN ADDRESS OF PROCESSOR Y02676 58058000 * TABLE EXTENSION. Y02676 58058400 ST RETCDREG,CAPTPDXT STORE PTR TO EXTENSION AREA. Y02676 58058800 USING IKJEBECX,RETCDREG EXTENSION ADDRESSABILITY. Y02676 58059200 MVC CXDATEXT(CXDLEN),CADATEXT-CAPD(PARMREG1) MOVE Y02676 58059600 * REMAINING INFORMATION TO Y02676 58059700 * TABLE EXTENSION AREA. Y02676 58059800 DROP RETCDREG END EXTENSION ADDRESSABILITY. Y02676 58059900 ID000090 EQU * 58060000 LH QUALREG,CAEDDSNL GET DSNAME LENGTH. 58080000 LA LENREG,D2(,LENREG) ADJUST QUALIFIER LENGTH. 58100000 SR QUALREG,LENREG SUBTRACT QUALIFIER LENGTH. 58120000 STH QUALREG,CAEDDSNL UPDATE DSNAME LENGTH TO LOGICALLY 58140000 * REMOVE RIGHTMOST QUALIFIER. 58160000 B ID000120 BRANCH TO INVOKE DEFAULT SERVICE 58180000 * ROUTINE. 58200000 ID000100 EQU * 58220000 EX LENREG,IDCOMPCL COMPARE TABLE QUALIFIER AND 58240000 * RIGHTMOST QUALIFIER OF NAME. 58260000 BE ID000090 IF ALIKE, STRIP NAME QUALIFIER. 58280000 BNE ID000120 IF DIFFERENT, BRANCH TO QUALIFY NAME. 58300000 EJECT 58320000 *********************************************************************** 58340000 * 58360000 * THIS SECTION INVOKES THE DEFAULT SERVICE ROUTINE TO FULLY QUALIFY 58380000 * THE NAME ENTERED. IKJEBEPS IS DELETED IF NECESSARY PRIOR TO 58400000 * INITIALIZING PARAMETERS FOR DEFAULT. PARAMETERS ARE SPECIFIED 58420000 * FOR APPENDING THE USERID AND DESCRIPTIVE QUALIFIER. IKJDFLT IS 58440000 * INVOKED VIA LINK. RETURN CODES ARE DIAGNOSED AND DIAGNOSTICS 58460000 * ISSUED IF NECESSARY. RETURN CODES TO IKJEBEIN ARE -- 58480000 * 58500000 * 0 - SUCCESSFUL. 58520000 * 4 - NOT SUCCESSFUL (TERMINATE EDIT). 58540000 * 58560000 *********************************************************************** 58580000 SPACE 2 58600000 ID000110 EQU * 58620000 TM IN7FLAGS,IN7DELPS MUST IKJEBEPS BE DELETED - 58640000 BZ ID000130 IF NOT, BRANCH TO INVOKE IKJDFLT 58660000 ID000120 EQU * 58680000 DELETE EP=IKJEBEPS DELETE PROCESSOR SEARCH ROUTINE. 58700000 LTR RETCDREG,RETCDREG WAS DELETE SUCCESSFUL - 58720000 BZ ID000130 IF SO, CONTINUE. 58740000 B ID000200 IF NOT, ISSUE DIAGNOSTIC AND 58760000 * TERMINATE. 58780000 ID000130 EQU * 58800000 LA TMPREG,DFPB00 SPECIFY ENTRY CODE FOR IKJDFLT. 58820000 STC TMPREG,IN7PLIST+DFPBCODE-DFPB SET ENTRY CODE BYTE 58840000 * IN PARAMETER BLOCK. 58860000 LA DSNAMREG,CAEDDSNL ADDRESS USER-SUPPLIED DSNAME. 58880000 ST DSNAMREG,IN7PLIST+DFPBDSN-DFPB STORE DSNAME IN 58900000 * DEFAULT PARAMETER BLOCK. 58920000 L TMPREG,CAPTTMP ADDRESS COMMAND PARAMETER LIST. 58940000 L PASSREG,CPPLPSCB-CPPL(,TMPREG) ADDRESS PSCB. 58960000 ST PASSREG,IN7PLIST+DFPBPSCB-DFPB STORE PSCB ADDRESS 58980000 * IN DEFAULT PARAMETER BLOCK. 59000000 LA QUALREG,CADSQUAL ADDRESS DESCRIPTIVE QUALIFIER. 59020000 ST QUALREG,IN7PLIST+DFPBQUAL-DFPB STORE QUALIFIER 59040000 * ADDRESS IN PARAMETER BLOCK. 59060000 MVI IN7PLIST+DFPBCNTL-DFPB,DFPBUID SPECIFY PREFIXING 59080000 * OF USERID TO DSNAME. 59100000 LA QUALREG,IN7PLIST ADDRESS DEFAULT PARAMETER BLOCK 59120000 ST QUALREG,CATMPLST+DFPLDFPB-DFPL AND CHAIN TO 59140000 * PARAMETER LIST. 59160000 LA PARMREG1,CATMPLST LOAD PARAM REG 1 @YA02225 59165000 CALLTSSR EP=IKJEHDEF,MF=(E,CATMPLST) INVOKE DEFAULT @YA02225 59170000 * SERVICE ROUTINE @YA02225 59190000 LR ERR1REG,RETCDREG SAVE RETURN CODE. 59220000 SRL RETCDREG,D2 DIVIDE RETURN CODE BY 4 FOR USE 59240000 * AS INDEX TO TABLE. 59260000 IC RETCDREG,IDRCTAB(RETCDREG) GET ACTION CODE. 59280000 EJECT 59300000 *********************************************************************** 59320000 * 59340000 * ACTION CODES ARE BASED ON RETURN CODES FROM THE DEFAULT SERVICE 59360000 * ROUTINE -- 59380000 * 59400000 * ACTION CODE DEFAULT RC'S ACTION 59420000 * 59440000 * 00 00,20,36 SUCCESSFUL RETURN 59460000 * 04 24 RETURN WITH RETURN CODE=04. 59480000 * 08 08 INVALID DSNAME MSG - RC IS 04. 59500000 * 12 16 CATALOG STRUCTURE MSG - RC IS 04. 59520000 * 16 04 NAME NOT RESOLVED MSG - RC IS 04. 59540000 * 20 12 NAME NOT RESOLVED MSG - RC IS 04. 59560000 * 24 28,32 COMMAND SYSTEM ERROR MSG - RC IS 04. 59580000 * 59600000 * THE ACTION CODE IS USED AS AN INDEX TO THE BRANCH TABLE BELOW. 59620000 * 59640000 *********************************************************************** 59660000 SPACE 2 59680000 B ID000140(RETCDREG) BRANCH TO BRANCH TABLE. 59700000 ID000140 EQU * THIS BRANCH TABLE IS POSITION 59720000 * DEPENDENT. 59740000 B IDRETURN SUCCESSFUL - RETURN WITH RETURN CODE 59760000 * ZERO. 59780000 B IDRETURN ATTN ISSUED - RETURN WITH RETURN 59800000 * CODE FOUR. 59820000 B ID000150 ISSUE DIAGNOSTIC - RC IS FOUR. 59840000 B ID000160 ISSUE DIAGNOSTIC - RC IS FOUR. 59860000 B ID000180 ISSUE DIAGNOSTIC - RC IS FOUR. 59880000 B ID000180 ISSUE DIAGNOSTIC - RC IS FOUR. 59900000 B ID000190 ISSUE DIAGNOSTIC - RC IS FOUR. 59920000 EJECT 59940000 *********************************************************************** 59960000 * 59980000 * DIAGNOSTICS AND RETURN LINKAGE. 60000000 * 60020000 *********************************************************************** 60040000 SPACE 2 60060000 ID000150 EQU * INVALID DSNAME. 60080000 LA ERR1REG,INERRORR SPECIFY MESSAGE INDEX. 60100000 B ID000220 BRANCH TO CALL IKJEBIN3. 60120000 SPACE 60140000 ID000160 EQU * LOCATE RC 16 RETURNED TO DEFAULT 60160000 * SERVICE ROUTINE. 60180000 LA ERR1REG,INERRORS SPECIFY MESSAGE INDEX. 60200000 SR DATA1REG,DATA1REG SPECIFY THAT DSNAME INSERTION 60220000 * MUST BE BUILT FOR MESSAGE. 60240000 B ID000220 BRANCH TO CALL IKJEBIN3. 60260000 SPACE 60280000 ID000180 EQU * DEFAULT ERROR CODE 4 OR 12. 60300000 LR DATA2REG,ERR1REG COPY DEFAULT RETURN CODE. 60320000 LA ERR2REG,M3151 SPECIFY RELATIVE LEVEL-2 MESSAGE. 60340000 LA ERR1REG,INERRORU SPECIFY MESSAGE INDEX. 60360000 B ID000220 BRANCH TO CALL IKJEBIN3. 60380000 SPACE 60400000 ID000190 EQU * COMMAND SYSTEM ERROR IN DEFAULT 60420000 * SERVICE ROUTINE. 60440000 LR DATA2REG,ERR1REG COPY DEFAULT RETURN CODE. 60460000 O DATA2REG,IDDFAULT SPECIFY SECOND-LEVEL INSERTION 60480000 * NAME - 'DEFAULT' 60500000 B ID000210 BRANCH TO CONTINUE. 60520000 SPACE 60540000 ID000200 EQU * DELETE SVC ERROR. 60560000 LR DATA2REG,RETCDREG COPY DELETE RETURN CODE. 60580000 O DATA2REG,IDDELSVC SPECIFY SECOND-LEVEL INSERTION 60600000 * NAME - 'DELETE SVC' 60620000 SPACE 60640000 ID000210 EQU * COMMAND SYSTEM ERROR. 60660000 LA ERR1REG,INERROR2 SPECIFY MESSAGE INDEX. 60680000 SPACE 60700000 ID000220 EQU * CALL MESSAGE INITIALIZATION ROUTINE. 60720000 CALL IKJEBIN3,((COMMREG),(ERR1REG),,,(DATA2REG)), X60740000 MF=(E,IN7PLIST) CALL IKJEBIN3. 60760000 IDRETCD4 EQU * 60780000 LA RETCDREG,D4 RETURN CODE TO IKJEBEIN IS FOUR. 60800000 IDRETURN EQU * 60820000 IKJEBERT (14,12),,RC=(15) RETURN TO IKJEBEIN. 60840000 EJECT 60860000 *********************************************************************** 60880000 * 60900000 * LOCAL STORAGE CONSTANTS AND EXECUTED INSTRUCTIONS. 60920000 * 60940000 *********************************************************************** 60960000 SPACE 2 60980000 DS 0F ALIGNMENT. 61000000 IDDFAULT DC X'05000000' INDICATOR FOR DEFAULT INSERTION. 61020000 IDDELSVC DC X'06000000' INDICATOR FOR DELETE SVC INSERTION. 61040000 SPACE 2 61060000 IDCOMPCL CLC D1(*-*,QUALREG),CADSQUAL COMPARE RIGHTMOST 61080000 * QUALIFIER TO QUALIFIER IN 61100000 * PROCESSOR TABLE. 61120000 SPACE 2 61140000 IDRCTAB DC X'001008140C0004181800' ACTION CODE TABLE. 61160000 EJECT 61180000 TITLE 'IKJEBIN8 - OPERAND PROCESSING' 61200000 *********************************************************************** 61220000 * * 61240000 * STATUS -- VERSION NO. 01, OS/360 RELEASE NO. 20 * 61260000 * * 61280000 * FUNCTION -- THIS ROUTINE VALIDATES KEYWORD AND DATA SET TYPE * 61300000 * SUBFIELD OPERANDS ENTERED ON THE EDIT COMMAND. THE LINE * 61320000 * OPERAND (OR LRECL IN THE CASE OF AN OLD DATA SET) IS VALIDATED * 61340000 * AGAINST TABLE ENTRIES ASSOCIATED WITH THE DATA SET TYPE. * 61360000 * THE BLOCK OPERAND (OR BLOCK SIZE) IS CHECKED IN MUCH THE SAME * 61380000 * WAY. THE REMAINING EDIT OPERANDS ARE VALIDITY CHECKED IN THE * 61400000 * FOLLOWING ORDER -- * 61420000 * * 61440000 * (1) SCAN/NOSCAN * 61460000 * (2) NUM/NONUM * 61480000 * (3) CAPS/ASIS * 61500000 * * 61520000 * SPECIAL CASES ARE THOSE DATA SET TYPES FOR WHICH THE USER MAY * 61540000 * OPTIONALLY SPECIFY SUBFIELD OPERANDS -- * 61560000 * * 61580000 * (1) IPLI CHARACTER SET * 61600000 * (2) PLI OR PLIF CHARACTER SET AND SOURCE MARGINS * 61620000 * (3) GOFORT FORMAT (FIXED OR FREE) * 61640000 * (4) USER DSTYPE SUBFIELD, IF SYSGENED A45714 61660000 * * 61680000 * IN CASES 1,2, AND 4, OPERAND CHECKING FOLLOWS VALIDATION A45714 61700000 * OF THE OTHER EDIT OPERANDS. IN CASE 3, SPECIAL A45714 61720000 * PROCESSING IS DONE IN PARALLEL WITH LINE OPERAND VALIDATION. * 61740000 * * 61760000 * MESSAGES ARE ISSUED WHENEVER INVALID, INCONSISTENT, OR * 61780000 * SUPERFLUOUS OPERANDS ARE SPECIFIED OR INVALID LRECL'S OR * 61800000 * BLKSIZE'S ENCOUNTERED. * 61820000 * * 61840000 * ENTRY POINTS -- * 61860000 * IKJEBIN8 - VIA CALL MACRO FROM IKJEBEIN, THE MAIN CSECT * 61880000 * OF THE EDIT INITIALIZATION PROGRAM WHEN IT * 61900000 * BECOMES NECESSARY TO VALIDATE COMMAND OPERANDS. * 61920000 * * 61940000 * INPUT -- * 61960000 * REGISTER ONE (1) CONTAINS A POINTER TO A TWO-WORD * 61980000 * PARAMETER LIST -- * 62000000 * WORD 1 - ADDRESS OF THE EDIT COMMUNICATION AREA * 62020000 * WORD 2 - ADDRESS OF THE EDIT COMMAND PDL * 62040000 * * 62060000 * REGISTER ZERO (0) CONTAINS AN ENTRY CODE -- * 62080000 * 00 - OLD DATA SET * 62100000 * 04 - NEW DATA SET * 62120000 * * 62140000 * OUTPUT -- * 62160000 * REGISTER FIFTEEN (15) CONTAINS A RETURN CODE -- * 62180000 * * 62200000 * 00 - SUCCESSFUL OPERATION. * 62220000 * 04 - TERMINATION ERROR. * 62240000 * * 62260000 * EXTERNAL REFERENCES -- * 62280000 * * 62300000 * IKJEBIN3 - CALLED FOR INITIAL MESSAGE PROCESSING * 62320000 * * 62340000 * MACROS USED -- * 62360000 * * 62380000 * BLDL - BUILD LIST OF DIRECTORY INFORMATION A45714 62400000 * CALL - LINKAGE TO IKJEBIN3. * 62420000 * DEVTYPE - ISSUED FOR OLD DATA SETS IN ORDER TO OBTAIN * 62440000 * TRACK CAPACITY. * 62460000 * IKJEBEMG - BUILDING MESSAGE INSERTION LISTS. * 62480000 * IKJEBERT - RETURN LINKAGE WITHIN THE EDIT COMMAND * 62500000 * PROCESSOR. * 62520000 * IKJEBESV - ENTRY LINKAGE WITHIN THE EDIT COMMAND PROCESSOR. * 62540000 * LINK - PASS CONTROL TO EXTERNAL PROGRAM A45714 62560000 * * 62580000 * EXITS, NORMAL -- * 62600000 * RETURN TO THE CALLING ROUTINE BY BRANCHING ON REGISTER * 62620000 * FOURTEEN (14) WITH REGISTER FIFTEEN (15) SET TO ZERO (0). * 62640000 * * 62660000 * EXITS, ERROR -- * 62680000 * RETURN TO THE CALLING ROUTINE BY BRANCHING ON REGISTER * 62700000 * FOURTEEN (14) WITH REGISTER FIFTEEN (15) SET TO FOUR (4). * 62720000 * * 62740000 * TABLES/WORK AREAS -- * 62760000 * * 62780000 * THE EDIT COMMUNICATION AREA CONTAINS CONTROL INFORMATION AND * 62800000 * WORK AREAS FOR THIS ROUTINE. THE FOLLOWING FIELDS ARE UPDATED * 62820000 * BY IKJEBIN8 -- * 62840000 * * 62860000 * CABLKS - BLOCK SIZE * 62880000 * CACFLAG1 - CONTROL FLAG * 62900000 * CACFLAG2 - CONTROL FLAG * 62920000 * CACFLAG6 - CONTROL FLAG * 62940000 * CADSATTR - DATA SET ATTRIBUTES FLAG * 62960000 * CALINE - STARTING POSITION FOR SEQUENCE NUMBER * 62980000 * CALENGTH - SEQUENCE NUMBER LENGTH * 63000000 * CALRECL - LOGICAL RECORD LENGTH * 63020000 * CAPLIRTM - RIGHT SOURCE MARGIN POSITION * 63040000 * CAPLILFM - LEFT SOURCE MARGIN POSITION * 63060000 * CACHKOPT - LEFT AND RIGHT SOURCE MARGIN IN CHECKER PARMLIST A45714 63080000 * * 63100000 * THE EDIT COMMAND PDL (PARAMETER DESCRIPTOR LIST) IS RETURNED BY * 63120000 * IKJPARS AND CONTAINS COMMAND OPERAND INFORMATION. * 63140000 * * 63160000 * ATTRIBUTES -- * 63180000 * REFRESHABLE, ENABLED, NON-PRIVILEGED * 63200000 * * 63220000 * CHARACTER CODE DEPENDENCY -- NONE. * 63240000 * * 63260000 * NOTES -- * 63280000 * THIS ROUTINE CONTAINS PROCESSOR DEPENDENT CODE FOR THE FOLLOWING * 63300000 * DATA SET TYPES -- * 63320000 * * 63340000 * GOFORT * 63360000 * IPLI * 63380000 * PLI * 63400000 * PLIF * 63420000 *********************************************************************** 63440000 EJECT 63460000 IKJEBIN8 CSECT 63480000 IKJEBESV (14,12),,*,COMMREG=D0(,PARMREG1) SAVE ENTRY X63500000 REGISTERS. 63520000 USING IKJEBECA,COMMREG ESTABLISH ADDRESSABILITY TO THE 63540000 * COMMUNICATION AREA. 63560000 L DATAREG,D4(,PARMREG1) OBTAIN ADDRESS OF EDIT 63580000 * COMMAND PDL. 63600000 USING INECMNDD,DATAREG ESTABLISH ADDRESSABILITY TO THE 63620000 * EDIT COMMAND PDL. 63640000 MVI IN8FLAGS,IN8ZEROS ZERO FLAG BYTE FOR THIS ROUTINE. 63660000 LTR PARMREG0,PARMREG0 TEST FOR ENTRY CODE ZERO. 63680000 BNZ IN003030 IF ENTRY CODE IS NOT ZERO, BRANCH 63700000 * TO PROCESS AS NEW DATA SET. 63720000 LH LENREG,CALRECL ACQUIRE LRECL FOR OLD DATA SET. 63740000 B IN003065 BRANCH TO VALIDATE LRECL. 63760000 EJECT 63780000 *********************************************************************** 63800000 * * 63820000 * VALIDATE LINE OPERAND FOR A NEW DATA SET AND LRECL FOR AN OLD * 63840000 * DATA SET. * 63860000 * * 63880000 * AFTER CONVERTING THE LINE OPERAND TO BINARY, PLACE VALUE IN * 63900000 * THE COMMUNICATION AREA. (IF DATA SET WAS OLD, LRECL HAS * 63920000 * PREVIOUSLY BEEN PLACED IN THE COMMUNICATION AREA. VERIFY THAT * 63940000 * LINE(LRECL) IS CORRECT FOR THE DATA SET TYPE BEING EDITED. IF * 63960000 * LINE(LRECL) IS INVALID, PUT MESSAGE TO TERMINAL AND EXIT TO TMP. * 63980000 * * 64000000 *********************************************************************** 64020000 IN003030 EQU * 64040000 CLC INLNE(L'IENOKEYW),IENOKEYW CHECK IF LINE OPERAND 64060000 * SPECIFIED. 64080000 BNE IN003060 IF SPECIFIED, BRANCH TO CONVERT TO 64100000 * BINARY. 64120000 BAL SRRTNREG,IN011010 BRANCH TO CHECK IF DATA SET TYPE 64140000 * IS GOFORT. 64160000 TM IN8FLAGS,IN8TERME DETERMINE IF INVALID OPERANDS OR 64180000 * ATTRIBUTES FOR GOFORT. 64200000 BO IEEXIT1 IF SO, BRANCH TO TERMINATE. 64220000 IN003040 EQU * 64240000 SR PARMREG1,PARMREG1 CREATE CONSTANT OF ZERO. 64260000 CH PARMREG1,CAFLRLDF CHECK IF DEFAULT RECORD FORMAT 64280000 * IS FIXED. 64300000 BNZ IN003050 IF FIXED, BRANCH TO INITIALIZE LINE 64320000 MVC CALRECL(L'CALRECL),CAVLRLDF INITIALIZE LINE SIZE 64340000 * WITH VARIABLE FORMAT LRECL. 64360000 NI CACFLAG2,X'FF'-CARECFM SET RECFM TO VB ZA32148 64370000 B IN004520 BRANCH TO VALIDATE BLOCK OPERAND. 64380000 IN003050 EQU * 64400000 MVC CALRECL(L'CALRECL),CAFLRLDF INITIALIZE LINE SIZE 64420000 * WITH FIXED FORMAT LRECL. 64440000 OI CACFLAG2,CARECFM INDICATE THAT DATA SET HAS A 64460000 * FIXED OR FIXED BLOCK FORMAT. 64480000 B IN004520 BRANCH TO VALIDATE BLOCK OPERAND. 64500000 IN003060 EQU * 64520000 L AREAREG,INLNESZ+INLNEPT ADDRESS OF LINE VALUE. 64540000 LH SIZEREG,INLNESZ+INLNELN LENGTH OF LINE VALUE. 64560000 BAL RETREG,INCVBIN BRANCH TO CONVERT TO BINARY. 64580000 STH LENREG,CALRECL PLACE LINE VALUE IN COMMUNICATION 64600000 * AREA FOR TESTS. 64620000 IN003065 EQU * 64640000 LTR LENREG,LENREG CHECK IF LRECL IS ZERO. 64660000 BNZ IN003067 BYPASS ISSUING WARNING MESSAGE TO USER. 64680000 LA ERR1REG,INERROR8 SET RELATIVE ERROR INDICATION FOR 64700000 * WARNING MESSAGE. 64720000 LA ERR2REG,M3353 SET SECOND-LEVEL RELATIVE NUMBER. 64740000 LH DATA1REG,CABLKS SPECIFY LRECL TO BE USED. 64760000 STH DATA1REG,CALRECL SET LRECL FIELD IN COMMUNICATION 64780000 * AREA. 64800000 BAL AREAREG,IN013010 BRANCH TO ISSUE WARNING MESSAGE. 64820000 LR LENREG,DATA1REG COPY BLOCK SIZE INTO LRECL REGISTER. 64840000 IN003067 EQU * 64860000 BAL SRRTNREG,IN011010 BRANCH TO CHECK IF DATA SET TYPE 64880000 * IS GOFORT. 64900000 TM IN8FLAGS,IN8TERME DETERMINE IF INVALID OPERANDS OR 64920000 * ATTRIBUTES FOR GOFORT. 64940000 BO IEEXIT1 IF SO, BRANCH TO TERMINATE. 64960000 TM CADSATTR,CALRECLX CHECK IF DEFAULT LRECL IS 64980000 * REQUIRED. 65000000 BZ IN003080 WHEN DEFAULT IS NOT REQUIRED, 65020000 * BRANCH TO CHECK MAXIMUM. 65040000 LH SIZEREG,CAFLRLDF DEFAULT LRECL FOR DATA SET TYPE. 65060000 CR SIZEREG,LENREG CHECK IF LINE VALUE IS EQUAL TO 65080000 * DEFAULT LRECL. 65100000 BE IN003090 IF EQUAL, BRANCH TO PROCESS BLOCK 65120000 * OPERAND. 65140000 IN003070 EQU * 65160000 TM CAEDFLAG,CAEDDISP CHECK IF DATA SET IS NEW. 65180000 BZ IN003075 IF DATA SET IS NEW, BRANCH TO 65200000 * DEFAULT LRECL. 65220000 LH DATA1REG,CALRECL OBTAIN LRECL FOR MESSAGE. 65240000 LA ERR1REG,INERROR6 RELATIVE ERROR TO BE PROCESSED. 65260000 BAL AREAREG,IN013010 BRANCH TO PUT ERROR MESSAGE. 65280000 B IEEXIT1 BRANCH TO EXIT WITH ERROR RETURN 65300000 * CODE. 65320000 IN003073 EQU * 65340000 LH SIZEREG,CAFLRLDF OBTAIN DEFAULT LINE VALUE FOR FIXED 65360000 * FORMAT RECORDS. 65380000 LTR SIZEREG,SIZEREG DETERMINE IF VARIABLE DEFAULT IS 65400000 * TO BE USED. 65420000 BNZ IN003075 IF NOT, BRANCH TO PUT MESSAGE. 65440000 LH SIZEREG,CAVLRLDF IF SO, OBTAIN DEFAULT LINE 65460000 * VALUE FOR VARIABLE FORMAT 65480000 * RECORDS. 65500000 IN003075 EQU * 65520000 LA ERR1REG,INERROR8 RELATIVE ERROR TO BE PROCESSED. 65540000 LR DATA1REG,SIZEREG SAVE VALUE FOR MESSAGE INSERTION. 65560000 BAL AREAREG,IN013010 BRANCH TO PUT ERROR MESSAGE. 65580000 LTR RETCDREG,RETCDREG CHECK IF PUTLINE WAS SUCCESSFUL. 65600000 BNZ IEEXIT1 IF NOT SUCCESSFUL, BRANCH TO EXIT. 65620000 B IN003040 BRANCH TO DEFAULT LRECL. 65640000 IN003080 EQU * 65660000 TM CAEDFLAG,CAEDDISP CHECK IF DATA SET IS OLD. 65680000 BO IN003082 IF OLD, BRANCH TO CHECK IF RECFM=F 65700000 LH SIZEREG,CAFLRLMX MAXIMUM LRECL FOR DATA SET TYPE. 65720000 CR SIZEREG,LENREG CHECK IF LINE VALUE IS LESS THAN 65740000 * OR EQUAL TO MAXIMUM. 65760000 BL IN003073 IF NOT, BRANCH TO PUT MESSAGE. 65780000 B IN003090 OTHERWISE, BRANCH TO PROCESS BLOCK 65800000 * OPERAND. 65820000 IN003082 EQU * 65840000 TM CACFLAG2,CARECFM CHECK IF RECFM = F. 65860000 BO IN003084 IF FIXED, BRANCH TO CHECK MAXIMUM. 65880000 LH SIZEREG,CAVLRLMX MAXIMUM LRECL FOR DATA SET TYPE. 65900000 CR SIZEREG,LENREG CHECK IF LINE VALUE IS LESS THAN 65920000 * OR EQUAL TO MAXIMUM. 65940000 BL IN003070 IF NOT, BRANCH TO PUT MESSAGE. 65960000 B IN003090 OTHERWISE, BRANCH TO PROCESS BLOCK 65980000 * OPERAND. 66000000 IN003084 EQU * 66020000 LH SIZEREG,CAFLRLMX MAXIMUM LRECL FOR DATA SET TYPE. 66040000 CR SIZEREG,LENREG CHECK IF LINE VALUE IS LESS THAN 66060000 * OR EQUAL TO MAXIMUM. 66080000 BL IN003070 IF NOT, BRANCH TO PUT MESSAGE. 66100000 IN003090 EQU * 66120000 TM CAEDFLAG,CAEDDISP CHECK IF DATA SET IS NEW. 66140000 BO INP03010 IF DATA SET IS OLD, BRANCH TO CHECK 66160000 * IF BLOCK OPERAND ENTERED. 66180000 OI CACFLAG2,CARECFM INDICATE THAT DATA SET HAS A 66200000 * FIXED OR FIXED BLOCK FORMAT. 66220000 B IN004520 BRANCH TO VALIDATE BLOCK OPERAND. 66240000 EJECT 66260000 IN004020 EQU * 66280000 *********************************************************************** 66300000 * * 66320000 * VALIDATE BLOCK OPERAND. * 66340000 * * 66360000 * NEW DATA SET, BLOCK NOT SPECIFIED. BLKSIZE IS DEFAULTED TO * 66380000 * VALUE SPECIFIED AT SYSGEN TIME FOR DATA SET TYPE. * 66400000 * * 66420000 * NEW DATA SET, BLOCK SPECIFIED. CONVERT BLOCK OPERAND TO BINARY. * 66440000 * IF DATA SET HAS RECFM = V, CHECK THAT BLKSIZE IS GREATER THAN OR * 66460000 * EQUAL TO LRECL +4 AND LESS THAN 32760. IF DATA SET HAS * 66480000 * RECFM = F, CHECK THAT BLKSIZE / LRECL IS AN INTEGER. ISSUE * 66500000 * DEVTYPE MACRO INSTRUCTION TO OBTAIN TRACK CAPACITY. CHECK * 66520000 * BLKSIZE TO DETERMINE IF ONE BLOCK WILL FIT ON ONE TRACK OF * 66540000 * THE OUTPUT DEVICE. WHEN ANY OF THESE TESTS FAIL, NOTIFY USER * 66560000 * AND USE BLKSIZE SPECIFIED AT SYSGEN TIME. * 66580000 * * 66600000 * OLD DATA SET. DETERMINE IF LINE OR BLOCK OR BOTH OPERANDS WERE * 66620000 * SPECIFIED. IF SO, INFORM USER THAT OPERAND IS IGNORED. * 66640000 * * 66660000 *********************************************************************** 66680000 LA AREAREG,INDEVTYP ADDRESS OF DEVTYPE WORK AREA. 66700000 LA SIZEREG,CAEDDDN ADDRESS OF DDNAME FOR DEVTYPE. 66720000 DEVTYPE (SIZEREG),(AREAREG),DEVTAB OBTAIN TRACK SIZE. 66740000 LTR RETCDREG,RETCDREG CHECK IF DEVTYPE SUCCESSFUL. 66760000 BZ IN004025 IF SUCCESSFUL, BRANCH TO VALIDATE 66780000 * BLOCK OPERAND. 66800000 LA ERR1REG,INERROR2 RELATIVE ERROR TO BE PROCESSED. 66820000 LR DATA2REG,RETCDREG SAVE RETURN CODE FOR MESSAGE. 66840000 O DATA2REG,IEDEVTYP INDICATE ROUTINE NAME AS DEVTYPE 66860000 BAL AREAREG,IN013010 BRANCH TO PUT ERROR MESSAGE. 66880000 B IEEXIT1 BRANCH TO TERMINATE EDIT. 66900000 IN004025 EQU * 66920000 L LENREG,CAUTILNO LAST BLOCK POINTER FROM DSCB. 66940000 LTR LENREG,LENREG CHECK FOR EMPTY DATA SET. 66960000 BZ IN004420 IF EMPTY, NO COMPUTATION NECESSARY. 66980000 SRL LENREG,D8(D0) ROUND TTR POINTER UP TO NEXT FULL 67000000 LA LENREG,D1(,LENREG) TRACK. 67020000 ************************************************************** @ZA85473 67070000 * THE DATA SET IS AN OLD, NON-EMPTY DATA SET. * @ZA85473 67120000 * ISSUE THE TRKCALC MACRO TO FIND OUT HOW MANY BLOCKS * @ZA85473 67170000 * WILL FIT ON ONE TRACK OF THE DATA SET. * @ZA85473 67220000 ************************************************************** @ZA85473 67270000 LA AREAREG,CACLCPRM GET TRKCALC PARM LIST ADDR @ZA85473 67286600 L SIZEREG,INDEVTYP GET UCBTYP FIELD @ZA85473 67303200 ST SIZEREG,CACLCTYP PUT UCBTYP INTO PLIST @ZA85473 67319800 LA SIZEREG,D1 GET R VALUE FOR TRKCALC @ZA85473 67336400 SLL SIZEREG,24 MOVE IT TO HIGH-ORDER BYTE @ZA85473 67353000 ICM SIZEREG,3,CABLKS PUT BLKSIZE IN LOW HALFWORD @ZA85473 67369600 TRKCALC FUNCTN=TRKCAP,TYPE=*,REGSAVE=YES, @ZA85473X67386200 RKDD=(SIZEREG),MF=(E,(AREAREG)) @ZA85473 67402800 LR SIZEREG,ENTCDREG MOVE COUNT TO SIZEREG @ZA85473 67420000 LH AREAREG,CALRECL LRECL FOR RECFM = F. 67520000 IN004220 EQU * 67620000 LH RETREG,CABLKS OBTAIN BLKSIZE FOR DATA SET AND 67640000 SRDL RETREG,D32(D0) DIVIDE BY LRECL TO DETERMINE 67660000 DR RETREG,AREAREG NUMBER OF RECORDS PER BLOCK. 67680000 LTR RETREG,RETREG CHECK IF BLKSIZE IS MULTIPLE OF 67700000 BZ IN004320 LRECL. IF SO, BRANCH TO 67720000 * COMPUTE NUMBER OF RECORDS IN 67740000 * DATA SET. 67760000 LA RETCDREG,D1(,RETCDREG) IF BLKSIZE NOT A MULTIPLE 67780000 * OF LRECL, INCREASE BY 1. 67800000 SR RETREG,RETREG ZERO REGISTER FOR MULTIPLICATION. 67820000 IN004320 EQU * 67840000 MR RETREG,SIZEREG COMPUTE TOTAL NUMBER OF RECORDS IN 67860000 MR RETREG,LENREG OLD DATA SET AND SAVE FOR 67880000 ST RETCDREG,CAUTILNO IKJEBEUI. 67900000 IN004420 EQU * 67920000 TM CAEDFLAG,CAEDDISP CHECK IF DATA SET IS NEW. 67940000 BO IN005020 IF DATA SET IS OLD, BRANCH TO CHECK 67960000 * IF SCAN OPERAND ENTERED. 67980000 IN004520 EQU * 68000000 CLC INBLK(L'IENOKEYW),IENOKEYW CHECK IF BLOCK OPERAND 68020000 * SPECIFIED. 68040000 BE IN004070 IF NOT, BRANCH TO MAKE SURE LINE 68060000 * AND BLOCK OPERANDS ARE 68080000 * COMPATIBLE. 68100000 L AREAREG,INBLKSZE+INBLKPT ADDRESS OF BLOCK VALUE. 68120000 LH SIZEREG,INBLKSZE+INBLKLN LENGTH OF LINE VALUE. 68140000 BAL RETREG,INCVBIN BRANCH TO CONVERT TO BINARY. 68160000 TM CACFLAG2,CARECFM CHECK IF RECFM = F. 68180000 BO IN004050 IF FIXED, BRANCH TO CHECK BLOCK 68200000 * OPERAND. 68220000 LH SIZEREG,CALRECL OBTAIN LRECL AND ADD 4 TO COMPUTE 68240000 LA SIZEREG,D4(PARMREG0,SIZEREG) REQUIRED BLOCKSIZE 68260000 CR SIZEREG,LENREG CHECK IF BLKSIZE IS GREATER THAN OR 68280000 BNH IN004060 EQUAL TO LRECL + 4. IF SO, 68300000 * BRANCH TO CHECK MAXIMUM. 68320000 LA ERR2REG,M3334 RELATIVE SECOND LEVEL MESSAGE. 68340000 IN004030 EQU * 68360000 LA ERR1REG,INERROR9 RELATIVE ERROR TO BE PROCESSED. 68380000 BAL AREAREG,IN004080 BRANCH TO COMPUTE DEFAULT BLKSIZE 68400000 LH DATA1REG,CABLKS DEFAULT BLKSIZE FOR INSERTION. 68420000 BAL AREAREG,IN013010 BRANCH TO PUT ERROR MESSAGE. 68440000 LTR RETCDREG,RETCDREG CHECK IF PUTLINE WAS SUCCESSFUL. 68460000 BNZ IEEXIT1 IF NOT SUCCESSFUL, BRANCH TO EXIT. 68480000 B IN005020 BRANCH TO CHECK SCAN OPERAND. 68500000 IN004050 EQU * 68520000 LR RETREG,LENREG COPY BLKSIZE AND PLACE IN 68540000 SRDL RETREG,D32(PARMREG0) REGISTER FOR DIVISION. 68560000 LH SIZEREG,CALRECL OBTAIN LRECL AND PERFORM THE 68580000 DR RETREG,SIZEREG BLKSIZE / LRECL DIVISION. 68600000 LTR RETREG,RETREG CHECK IF QUOTIENT IS AN INTEGER. 68620000 BZ IN004060 IF BLOCK IS AN INTEGER MULTIPLE OF 68640000 * LINE, BRANCH TO CHECK IF LESS 68660000 * THAN MAXIMUM (SYSGEN) VALUE. 68680000 LA ERR2REG,M3333 RELATIVE SECOND LEVEL MESSAGE. 68700000 B IN004030 BRANCH TO CALL MESSAGE ROUTINE. 68720000 IN004060 EQU * 68740000 CH LENREG,CABLKS CHECK IF BLKSIZE IS GREATER THAN OR 68760000 BNH IN004065 EQUAL TO MAXIMUM. IF SO, 68780000 * DETERMINE IF LESS THAN OR 68800000 * EQUAL TO TRACK CAPACITY. 68820000 * OTHERWISE, INFORM USER OF ERROR. 68840000 LA ERR2REG,M3332 RELATIVE SECOND LEVEL MESSAGE. 68860000 B IN004030 BRANCH TO CALL MESSAGE ROUTINE. 68880000 IN004065 EQU * 68900000 STH LENREG,CABLKS INDICATE BLKSIZE IN COMMUNICATION 68920000 * AREA. 68940000 B IN005020 BRANCH TO CHECK SCAN OPERAND. 68960000 IN004070 EQU * 68980000 LA AREAREG,IN005020 ADDRESS OF NEXT CODE SEQUENCE 69000000 * TO BE EXECUTED. 69020000 IN004080 EQU * 69040000 TM CACFLAG2,CARECFM CHECK IF RECFM = F. 69060000 BZ IN004090 IF RECFM = V, LINE IS COMPATIBLE 69080000 * WITH BLOCK. 69100000 LH RETREG,CABLKS OBTAIN BLKSIZE AND PLACE IN 69120000 SRDL RETREG,D32(PARMREG0) REGISTER FOR DIVISION. 69140000 LH SIZEREG,CALRECL OBTAIN LRECL AND PERFORM THE 69160000 DR RETREG,SIZEREG BLKSIZE / LRECL DIVISION. 69180000 LTR RETREG,RETREG CHECK IF QUOTIENT IS AN INTEGER. 69200000 BZ IN004090 IF BLKSIZE IS A MULTIPLE OF LRECL, 69220000 * BRANCH TO CHECK SCAN OPERAND. 69240000 MH RETCDREG,CALRECL COMPUTE BLKSIZE THAT IS A 69260000 STH RETCDREG,CABLKS MULTIPLE OF LRECL AND SAVE IN 69280000 * THE COMMUNICATION AREA. 69300000 IN004090 EQU * 69320000 BR AREAREG RETURN TO CALLER. 69340000 EJECT 69360000 IN005020 EQU * 69380000 *********************************************************************** 69400000 * * 69420000 * VALIDATE SCAN OPERAND. * 69440000 * * 69460000 * DETERMINE IF USER ENTERED SCAN OR NOSCAN. IF SCAN WAS ENTERED, * 69480000 * CHECK IF VALID FOR DATA SET TYPE. IF NOT VALID, INFORM USER * 69500000 * AND IGNORE OPERAND. IF VALID, ISSUE A BLDL MACRO INSTRUCTION * 69520000 * FOR THE SYNTAX CHECKER NAME TO DETERMINE IF IN SYSTEM. IF * 69540000 * SYNTAX CHECKER NOT AVAILABLE, ZERO SYNTAX CHECKER NAME AND * 69560000 * INFORM USER. * 69580000 * * 69600000 *********************************************************************** 69620000 TM CADSATTR,CASCAN CHECK IF SYNTAX CHECKING ALLOWED. 69640000 BNO IN005035 IF SYNTAX CHECKING NOT ALLOWED, 69660000 * BRANCH TO CHECK IF SCAN/NOSCAN 69680000 * OPERAND SPECIFIED. 69700000 MVC INBLDWD(L'IELSTDSC),IELSTDSC INITIALIZE LIST 69720000 * DESCRIPTION FIELD FOR BLDL. 69740000 MVC INSYNNME(L'CASYNAME),CASYNAME MOVE MODULE NAME TO 69760000 * BLDL LIST. 69780000 BLDL 0,INSYNCHK BLDL ON SYNTAX CHECKER MODULE NAME. 69800000 LTR RETCDREG,RETCDREG CHECK IF SYNTAX CHECKER IN 69820000 * SYSTEM. 69840000 BZ IN005035 IF PRESENT, BRANCH TO INDICATE THAT 69860000 * USER REQUESTED SYNTAX CHECKING 69880000 XC CASYNAME(L'CASYNAME),CASYNAME ZERO SYNTAX CHECKER 69900000 * NAME FIELD TO INDICATE NOT 69920000 * AVAILABLE. 69940000 IN005035 EQU * 69960000 CLC INSCN(L'IEKEYDEF),IEKEYDEF CHECK IF SCAN SPECIFIED 69980000 BE IN005050 IF NOSCAN SPECIFIED, BRANCH TO 70000000 * CHECK NUM/NONUM OPERAND. 70020000 TM CADSATTR,CASCAN CHECK IF SYNTAX CHECKING ALLOWED. 70040000 BO IN005040 IF ALLOWED, BRANCH TO CHECK IF 70060000 * SYNTAX CHECKER OR PREPROCESSOR 70080000 * EXISTS IN SYSTEM. 70100000 IN005037 EQU * 70120000 LA ERR1REG,INERRORA RELATIVE ERROR TO BE PROCESSED. 70140000 BAL AREAREG,IN013010 BRANCH TO PUT ERROR MESSAGE. 70160000 B IEEXIT1 BRANCH TO RETURN WITH ERROR RETURN 70180000 * CODE. 70200000 IN005040 EQU * 70220000 LTR RETCDREG,RETCDREG CHECK IF CHECKER IN SYSTEM. 70240000 BZ IN005045 IF PRESENT, BRANCH TO INDICATE USER 70260000 * REQUESTED SYNTAX CHECKING. 70280000 B IN005037 BRANCH TO ISSUE ERROR MESSAGE. 70300000 IN005045 EQU * 70320000 OI CACFLAG2,CASCANON INDICATE THAT USER HAS REQUESTED 70340000 * SYNTAX CHECKING. 70360000 EJECT 70380000 IN005050 EQU * 70400000 *********************************************************************** 70420000 * * 70440000 * VALIDATE NUM/NONUM OPERAND. * 70460000 * * 70480000 * IF USER SPECIFIES NONUM, INDICATE THAT DATA SET IS NOT (DOES NOT) * 70500000 * TO CONTAIN SEQUENCE NUMBERS. IF THE USER SPECIFIES NUM, CHECK * 70520000 * IF SEQUENCE NUMBER AND START POSITION ARE ALSO SPECIFIED. WHEN * 70540000 * START POSITION AND LENGTH ARE SPECIFIED, CHECK THAT DATA SET TYPE * 70560000 * IS ASM. IF DATA SET TYPE IS NOT ASM, PUT DIAGNOSTIC TO TERMINAL. * 70580000 * * 70600000 * IF DATA SET TYPE IS ASM AND START POSITION AND LENGTH ARE * 70620000 * SPECIFIED, CHECK THAT START POSITION IS BETWEEN 73 AND 80 AND * 70640000 * THAT LENGTH IS LESS THAN OR EQUAL TO (80 - START POSITION + 1). * 70660000 * * 70680000 *********************************************************************** 70700000 CLC INNUM(L'IEKEYDEF),IEKEYDEF DETERMINE IF NONUM WAS 70720000 * SPECIFIED. 70740000 BE IN005060 IF NUM SPECIFIED, BRANCH TO PROCESS 70760000 * SUBFIELD OPERANDS. 70780000 TM CADSATTR,CALNNUM CHECK IF DATA SET MUST BE LINE 70800000 * NUMBERED. 70820000 BZ IN005055 IF NOT, BRANCH TO INDICATE DATA SET 70840000 * IS NOT TO (DOES NOT) CONTAIN 70860000 * LINE NUMBERS. 70880000 LA ERR1REG,INERRORB RELATIVE ERROR TO BE PROCESSED. 70900000 BAL AREAREG,IN013010 BRANCH TO PUT ERROR MESSAGE. 70920000 LTR RETCDREG,RETCDREG CHECK IF PUTLINE WAS SUCCESSFUL. 70940000 BNZ IEEXIT1 IF NOT, BRANCH TO RETURN TO TMP. 70960000 B IN006040 BRANCH TO CHECK IF SEQUENCE NUMBER 70980000 * START POSITION AND LENGTH ARE 71000000 * CORRECT FOR LRECL AND RECFM. 71020000 IN005055 EQU * 71040000 OI CACFLAG1,CANONUM INDICATE DATA SET DOES NOT (IS 71060000 * NOT TO) CONTAIN SEQUENCE NOS. 71080000 B IN006040 BRANCH TO CHECK SEQUENCE NUMBER 71100000 * START POSITION AND LENGTH. 71120000 IN005060 EQU * 71140000 TM INNOSTP+INSNOFLG,INSNOOMT CHECK IF START POSITION 71160000 * WAS ENTERED. 71180000 BZ IN006040 IF START POSITION NOT ENTERED, 71200000 * BRANCH TO CHECK IF SEQUENCE 71220000 * NUMBER START POSITION AND 71240000 * LENGTH ARE CORRECT. 71260000 CLI CADSCODE,CAASM CHECK IF DATA SET TYPE IS ASM. 71280000 BE IN005065 IF ASM, BRANCH TO PROCESS START 71300000 * POSITION AND LENGTH. 71320000 LA ERR2REG,M3603 INDICATE THAT NUM SUBFIELDS WERE 71340000 * SPECIFIED FOR NON-ASM DATA SET 71360000 * TYPE. 71380000 B IN005075 BRANCH TO PUT ERROR MESSAGE. 71400000 IN005065 EQU * 71420000 L AREAREG,INNOSTP+INSNOPT ADDRESS OF START POSITION. 71440000 LH SIZEREG,INNOSTP+INSNOLN LENGTH OF OPERAND. 71460000 BAL RETREG,INCVBIN BRANCH TO CONVERT TO BINARY. 71480000 LR STRTNREG,LENREG SAVE START POSITION. 71500000 TM INNOLEN+INSNOFLG,INSNOOMT CHECK IF SEQUENCE NUMBER 71520000 * LENGTH ALSO ENTERED. 71540000 BO IN005066 IF ENTERED, BRANCH TO CONVERT TO 71560000 * BINARY. 71580000 SR LENREG,LENREG INDICATE THAT LENGTH NOT ENTERED. 71600000 B IN005067 BRANCH TO VALIDATE START POSITION. 71620000 IN005066 EQU * 71640000 L AREAREG,INNOLEN+INSNOPT ADDRESS OF LENGTH. 71660000 LH SIZEREG,INNOLEN+INSNOLN LENGTH OF OPERAND SUBFIELD. 71680000 BAL RETREG,INCVBIN BRANCH TO CONVERT TO BINARY. 71700000 IN005067 EQU * 71720000 CH STRTNREG,IESTP073 CHECK IF START POSITION GREATER 71740000 BL IN005070 THAN OR EQUAL TO COLUMN 73. IF 71760000 * NOT, BRANCH TO PUT DIAGNOSTIC. 71780000 CH STRTNREG,IESTP080 CHECK IF START POSITION IS LESS 71800000 BNH IN005080 THAN OR EQUAL TO 80. IF NOT, 71820000 * PUT DIAGNOSTIC TO TERMINAL. 71840000 IN005070 EQU * 71860000 LA ERR2REG,M3601 INDICATE THAT START COLUMN IS IN 71880000 * ERROR. 71900000 IN005075 EQU * 71920000 LA ERR1REG,INERRORD RELATIVE ERROR TO BE PROCESSED. 71940000 BAL AREAREG,IN013010 BRANCH TO PUT ERROR MESSAGE. 71960000 LTR RETCDREG,RETCDREG CHECK IF PUTLINE WAS SUCCESSFUL. 71980000 BNZ IEEXIT1 IF NOT, BRANCH TO RETURN TO TMP. 72000000 B IN006050 BRANCH TO CHECK CAPS/ASIS KEYWORD. 72020000 IN005080 EQU * 72040000 LH SIZEREG,IESTP080 COMPUTE THE QUANTITY -- 72060000 LA SIZEREG,D1(PARMREG0,SIZEREG) 80 - SEQUENCE NUMBER 72080000 SR SIZEREG,STRTNREG START POSITION + 1. 72100000 LTR LENREG,LENREG CHECK IF SEQUENCE NUMBER LENGTH 72120000 * ALSO ENTERED. 72140000 BZ IN005090 IF NOT ENTERED, BRANCH TO COMPUTE 72160000 * OFFSET JUST COMPUTED. 72180000 CR LENREG,SIZEREG CHECK THAT LENGTH IS LESS THAN OR 72200000 BNH IN006010 EQUAL TO 80 - START POSITION 72220000 * + 1. IF SO, BRANCH TO UPDATE 72240000 * COMMUNICATION AREA. 72260000 LA ERR2REG,M3602 INDICATE THAT LENGTH IS IN ERROR. 72280000 B IN005075 BRANCH TO PUT ERROR MESSAGE. 72300000 IN005090 EQU * 72320000 LR LENREG,SIZEREG COMPUTED SEQUENCE NUMBER LENGTH. 72340000 IN006010 EQU * 72360000 STC STRTNREG,CALINE SAVE START POSITION IN 72380000 * COMMUNICATION AREA. 72400000 STC LENREG,CALENGTH SAVE SEQUENCE NUMBER LENGTH IN 72420000 * COMMUNICATION AREA. 72440000 OI CACFLAG2,CASEQCOL INDICATE THAT DEFAULT SEQUENCE 72460000 * FIELD START COLUMN AND LENGTH 72480000 * ARE NOT BEING USED. 72500000 B IN006050 BRANCH TO CHECK CAPS/ASIS KEYWORD. 72520000 IN006040 EQU * 72540000 TM CACFLAG2,CARECFM CHECK IF RECFM = V. IF SO, 72560000 BZ IN006045 BRANCH TO ASSURE THAT SEQUENCE 72580000 * NUMBER START POSITION AND 72600000 * LENGTH ARE CORRECT. 72620000 TM CADSATTR,CALRECLX MUST LRECL = 80. 72640000 BO IN006050 IF SO, BRANCH TO CHECK CAPS/ASIS 72660000 * KEYWORD. 72680000 TM CADSATR2,CALINTAB CHECK IF SEQUENCE POSIT. IS Y02676 72681000 * INCLUDED IN FIRST TAB VALUE. Y02676 72682000 BO IN006050 IF SO, ACCEPT DEFAULT SEQ. VALUES. Y02676 72683000 LH SIZEREG,CALRECL OBTAIN LRECL TO BE USED FOR DATA 72700000 * SET. 72720000 LA LENREG,D7(PARMREG0,PARMREG0) CONSTANT 7 USED TO 72740000 * FIND STARTING COLUMN NUMBER. 72760000 * COMPUTE STARTING COLUMN NUMBER 72780000 * START NUMBER = LRECL + 1 - SEQUENCE NUMBER LENGTH WHERE LENGTH 72800000 * IS ALWAYS 8. 72820000 SR SIZEREG,LENREG COMPUTE START COLUMN NUMBER AND 72840000 LTR SIZEREG,SIZEREG CHECK IF RECORD CAN CONTAIN 72860000 * DATA, I.E., LRECL GT LINE 72880000 * NUMBER SIZE. 72900000 BP IN006043 IF LRECL GT LINE NUMBER SIZE, 72920000 * BRANCH TO SAVE START POSITION. 72940000 TM CACFLAG1,CANONUM CHECK IF NONUM ENTERED. 72960000 BO IN006050 BRANCH TO CHECK CAPS/ASIS OPERAND 72980000 * IF NONUM. 73000000 * 73020000 * USER SUPPLIED INCOMPATIBLE LINE AND NUM OPERANDS. ISSUE 73040000 * MESSAGE AND TERMINATE EDIT. 73060000 * 73080000 LA ERR1REG,INERRORH RELATIVE ERROR TO BE PROCESSED. 73100000 BAL AREAREG,IN013010 BRANCH TO PUT ERROR MESSAGE. 73120000 B IEEXIT1 BRANCH TO TERMINATE EDIT. 73140000 IN006043 EQU * 73160000 STC SIZEREG,CALINE SAVE SEQUENCE NUMBER START POSITION 73180000 OI CACFLAG2,CASEQCOL INDICATE THAT DEFAULT SEQUENCE 73200000 * FIELD START COLUMN IS NOT 73220000 * BEING USED. 73240000 B IN006050 BRANCH TO CHECK CAPS/ASIS OPERAND. 73260000 IN006045 EQU * 73280000 CLI CALINE,D1 CHECK FOR START POSITION = 1 Y02676 73283000 * IN VARIABLE RECORD. Y02676 73284000 BE IN006050 IF SO, ACCEPT DEFAULT SEQ. VALUES. Y02676 73286000 MVI CALINE,D1 START COLUMN POSITION, RECFM = V. 73300000 MVI CALENGTH,D8 SEQUENCE NUMBER LENGTH, RECFM = V. 73320000 EJECT 73340000 IN006050 EQU * 73360000 *********************************************************************** 73380000 * * 73400000 * VALIDATE CAPS/ASIS KEYWORD. * 73420000 * * 73440000 * DETERMINE WHETHER OR NOT CAPS OR AS WAS ENTERED. IF CAPS WAS * 73460000 * ENTERED, INDICATE ALL DATA TO BE CONVERTED TO UPPER CASE. IF * 73480000 * ASIS WAS ENTERED, DETERMINE IF PERMISSABLE FOR DATA SET TYPE. * 73500000 * IF NOT PERMISSABLE TO USE ASIS, INFORM USER AND USE DEFAULT. * 73520000 * * 73540000 *********************************************************************** 73560000 CLC INFMT(L'IENOKEYW),IENOKEYW CHECK IF CAPS OR ASIS 73580000 * WAS ENTERED. 73600000 BE IN006080 IF NEITHER, BRANCH TO SET CAPS/ASIS 73620000 * FLAG BASED ON DATA SET 73640000 * ATTRIBUTES. 73660000 CLC INFMT(L'IECPSSUP),IECPSSUP CHECK IF CAPS ENTERED. 73680000 BE IN006085 IF CAPS SPECIFIED, BRANCH TO SET 73700000 * CAPS FLAG IN COMMUNICATION 73720000 * AREA. 73740000 TM CADSATTR,CACAPSRQ CHECK IF CAPS ARE REQUIRED. 73760000 BZ IN006090 IF NOT, BRANCH TO PROCESS PL/I 73780000 * DATA SET TYPE. 73800000 LA ERR1REG,INERRORE RELATIVE ERROR TO BE PROCESSED. 73820000 BAL AREAREG,IN013010 BRANCH TO PUT ERROR MESSAGE. 73840000 LTR RETCDREG,RETCDREG CHECK IF PUTLINE WAS SUCCESSFUL. 73860000 BNZ IEEXIT1 IF NOT, BRANCH TO RETURN TO TMP. 73880000 B IN006085 OTHERWISE, BRANCH TO SET CAPS FLAG 73900000 * IN COMMUNICATION AREA. 73920000 IN006080 EQU * 73940000 TM CADSATTR,CACAPSDF DETERMINE IF ASIS IS THE 73960000 * DEFAULT. 73980000 BZ IN006090 IF ASIS, BRANCH TO CHECK PLI DSTYPE 74000000 IN006085 EQU * 74020000 OI CACFLAG1,CACAPS INDICATE THAT ALL INPUT DATA IS 74040000 * TO BE TRANSLATED TO UPPER CASE 74060000 EJECT 74080000 IN006090 EQU * 74100000 *********************************************************************** 74120000 * 74140000 * IPLI KEYWORD SUBFIELD OPERAND. 74160000 * 74180000 * DETERMINE WHETHER CHAR48 OR CHAR60 WAS ENTERED. SET THE 74200000 * APPROPRIATE BIT IN CACFLAG6 OF THE COMMUNICATION AREA BASED ON 74220000 * WHAT WAS ENTERED ON THE COMMAND, AND BRANCH TO CHECK THE 74240000 * DISPOSITION OF THE EDIT DATA SET. 74260000 * 74280000 *********************************************************************** 74300000 SPACE 2 74320000 L AREAREG,INPDLPTR ADDRESS OF PROMPT PDL. A45713 74340000 LTR AREAREG,AREAREG CHECK IF PROMPT PDL PRESENT. A45713 74360000 BNP IN006095 IF NO, BRANCH TO PROCESS SUBFLD. A45713 74380000 LA LENREG,INPL1CL1 ADDRESS OF TYPE PDE IN MAIN SM5064 74400000 * (COMMAND) PDL. SM5064 74405000 SR LENREG,DATAREG COMPUTE OFFSET OF PDE FROM SM5064 74410000 * PDL ORIGIN. SM5064 74415000 LA PARMREG0,INPLICL1-ICDSTPDL OBTAIN OFFSET TO SM5064 74420000 * CORRESPONDING PDE IN PROMPT SM5064 74425000 * PDL. SM5064 74430000 SR LENREG,PARMREG0 COMPUTE FACTOR TO BE SM5064 74435000 * SUBTRACTED FROM PROMPT PDL SM5064 74440000 * ORIGIN TO GIVE IT ADDRESSA- SM5064 74445000 * BILITY USING MAIN PDL DSECT. SM5064 74450000 LR DATAREG,AREAREG ESTAB. ADDRESSABILITY TO PROMPT A45713 74460000 * PDL WHILE STILL REFERENCING A45713 74480000 * LABELS IN MAIN PDL. A45713 74500000 IN006095 EQU * A45713 74520000 CLI CADSCODE,CAIPLI CHECK IF DATA SET TYPE IS IPLI. 74540000 BNE IN007010 IF NOT, BRANCH TO CONTINUE 74560000 * PROCESSING. 74580000 CLC INIPLICH(L'IEKEYDEF),IEKEYDEF CHECK IF CHAR60 74600000 * SPECIFIED. 74620000 BNH IN007000 IF SO, BRANCH TO SET FLAG. 74640000 OI CACFLAG6,CACHAR48 INDICATE 48-CHARACTER SET. 74660000 B IN013020 BRANCH TO CHECK DISPOSITION OF A45714 74680000 * EDIT DATA SET. 74700000 IN007000 EQU * 74720000 OI CACFLAG6,CACHAR60 INDICATE 60-CHARACTER SET. 74740000 B IN013020 BRANCH TO CHECK DISPOSITION OF A45714 74760000 * EDIT DATA SET. 74780000 EJECT 74800000 IN007010 EQU * 74820000 *********************************************************************** 74840000 * * 74860000 * PLI KEYWORD SUBFIELD OPERAND. * 74880000 * * 74900000 * CONVERT SOURCE MARGIN(S) TO BINARY AND VALIDITY CHECK. LEFT * 74920000 * SOURCE MARGIN MUST BE LESS THAN RIGHT SOURCE MARGIN AND RIGHT * 74940000 * SOURCE MARGIN MUST BE LESS THAN SEQUENCE NUMBER START POSITION * 74960000 * (IF DATA SET IS SEQUENCE NUMBERED) OR LESS THAN OR EQUAL TO LINE * 74980000 * (IF DATA SET DOES NOT CONTAIN SEQUENCE NUMBERS). IF AN ERROR * 75000000 * IS ENCOUNTERED AND THE DATA SET IS NEW, NOTIFY USER AND DEFAULT. * 75020000 * * 75040000 *********************************************************************** 75060000 CLI CADSCODE,CAPLI CHECK IF DATA SET TYPE IS PL/I. 75080000 BE IN007050 IF PL/I, BRANCH TO CHECK SUBFIELD 75100000 * OPERANDS. 75120000 CLI CADSCODE,CAPLIF CHECK IF DATA SET TYPE IS PL/I (F) 75140000 BNE IN013020 IF NO, BRANCH TO CHECK DISPOSITION A45714 75160000 * OF EDIT DATA SET. 75180000 IN007050 EQU * 75200000 TM INPL1CL1+INSMGFLG,INOPRNDO DETERMINE IF USER 75220000 * SPECIFIED LEFT SOURCE MARGIN. 75240000 BZ IN007087 IF NOT, BRANCH TO DEFAULT. 75260000 LH EPLOCREG,CALRECL ACQUIRE LOGICAL RECORD LENGTH. 75280000 TM CACFLAG1,CANONUM CHECK IF DATA SET NONUM. 75300000 BO IN007053 IF SO, BRANCH TO CHECK IF FIXED 75320000 * OR VARIABLE RECORD FORMAT. 75340000 SR SIZEREG,SIZEREG 75360000 IC SIZEREG,CALENGTH ACQUIRE SEQUENCE NUMBER LENGTH. 75380000 SR EPLOCREG,SIZEREG SET MAXIMUM SOURCE MARGIN VALUE 75400000 * FOR FIXED, NUM DATA SETS. 75420000 IN007053 EQU * 75440000 TM CACFLAG2,CARECFM CHECK IF FIXED OR VARIABLE 75460000 * RECORD FORMAT. 75480000 BO IN007056 IF FIXED, BRANCH TO VALIDITY CHECK 75500000 * MARGINS SPECIFIED. 75520000 LA SIZEREG,D4 IF VARIABLE, 75540000 SR EPLOCREG,SIZEREG SUBTRACT 4 TO GIVE MAXIMUM 75560000 * MARGIN VALUE. 75580000 IN007056 EQU * 75600000 L AREAREG,INPL1CL1+INSMGPT ADDRESS OF LEFT SOURCE 75620000 * MARGIN. 75640000 LH SIZEREG,INPL1CL1+INSMGLN LENGTH OF LEFT SOURCE 75660000 * MARGIN. 75680000 BAL RETREG,INCVBIN BRANCH TO CONVERT TO BINARY. 75700000 LR STRTNREG,LENREG SAVE LEFT SOURCE MARGIN. 75720000 TM INPL1CL2+INSMGFLG,INOPRNDO DETERMINE IF USER 75740000 * SPECIFIED RIGHT SOURCE MARGIN. 75760000 BO IN007060 IF SPECIFIED, BRANCH TO PROCESS - 75780000 SR LENREG,LENREG OTHERWISE, INDICATE NOT SPECIFIED. 75800000 B IN007062 BRANCH TO VALIDATE SOURCE MARGINS. 75820000 IN007060 EQU * 75840000 L AREAREG,INPL1CL2+INSMGPT ADDRESS OF RIGHT SOURCE 75860000 * MARGIN. 75880000 LH SIZEREG,INPL1CL2+INSMGLN LENGTH OF RIGHT SOURCE 75900000 * MARGIN. 75920000 BAL RETREG,INCVBIN BRANCH TO CONVERT TO BINARY. 75940000 IN007062 EQU * 75960000 CR STRTNREG,LENREG CHECK IF LEFT MARGIN IS LESS THAN 75980000 * RIGHT MARGIN. 76000000 BL IN007070 IF LEFT MARGIN IS LESS THAN RIGHT 76020000 * MARGIN, BRANCH TO VALIDATE 76040000 * RIGHT MARGIN. 76060000 LTR LENREG,LENREG TEST IF RIGHT MARGIN SPECIFIED. 76080000 BNZ IN007085 IF SPECIFIED, BRANCH TO PUT ERROR 76100000 * MESSAGE. 76120000 LA PARMREG1,INRSRCMG DEFAULT RIGHT SOURCE MARGIN. 76140000 CR STRTNREG,PARMREG1 CHECK IF LEFT MARGIN IS LESS 76160000 BNL IN007085 THAN RIGHT MARGIN. IF NOT, 76180000 * BRANCH TO PUT ERROR MESSAGE. 76200000 CR STRTNREG,EPLOCREG CHECK IF LEFT SOURCE MARGIN 76220000 * EXCEEDS MAXIMUM ALLOWABLE. 76240000 BH IN007085 IF SO, BRANCH TO PUT ERROR MESSAGE. 76260000 STC STRTNREG,CAPLILFM INDICATE LEFT SOURCE MARGIN IN 76280000 * COMMUNICATION AREA. 76300000 MVI CAPLIRTM,INRSRCMG DEFAULT RIGHT MARGIN TO 72. 76320000 B IN008010 BRANCH TO CHECK CHARACTER SET. 76340000 IN007070 EQU * 76360000 STC STRTNREG,CAPLILFM INDICATE LEFT SOURCE MARGIN IN 76380000 * COMMUNICATION AREA. 76400000 CR LENREG,EPLOCREG CHECK IF RIGHT SOURCE MARGIN 76420000 * EXCEEDS MAXIMUM ALLOWABLE. 76440000 BNH IN007090 IF NOT, BRANCH TO SAVE RIGHT SOURCE 76460000 * MARGIN. 76480000 IN007085 EQU * 76500000 LR DATA1REG,STRTNREG BUILD PARAMETER VALUE FOR 76520000 SLL DATA1REG,D16(D0) MESSAGE ROUTINE CONTAINING 76540000 OR DATA1REG,LENREG OPERANDS ENTERED. 76560000 LA ERR1REG,INERRORC RELATIVE ERROR TO BE PROCESSED 76580000 BAL AREAREG,IN013010 BRANCH TO PUT ERROR MESSAGE. 76600000 LTR RETCDREG,RETCDREG CHECK IF PUTLINE WAS SUCCESSFUL. 76620000 BNZ IEEXIT1 IF NOT, BRANCH TO RETURN TO TMP. 76640000 IN007087 EQU * 76660000 MVI CAPLILFM,INLSRCMG DEFAULT LEFT AND RIGHT SOURCE 76680000 MVI CAPLIRTM,INRSRCMG MARGINS TO (2,72). 76700000 B IN008010 BRANCH TO CHECK CHARACTER SET. 76720000 IN007090 EQU * 76740000 STC LENREG,CAPLIRTM SAVE RIGHT SOURCE MARGIN. 76760000 IN008010 EQU * 76780000 MVC CACHKOPT(L'CACHKOPT),CAPLILFM INIT CHKR OPT WORD. A45714 76800000 CLC INPL1TYP(L'IEKEYDEF),IEKEYDEF CHECK IF CHAR60 76820000 * SPECIFIED. 76840000 BE IN008020 IF CHAR60, BRANCH TO INDICATE IN 76860000 * COMMUNICATION AREA. 76880000 OI CACFLAG6,CACHAR48 INDICATE CHAR48 IN COMMUNICATION 76900000 * AREA. 76920000 B IN013020 BRANCH TO CHECK DISPOSITION OF A45714 76940000 * EDIT DATA SET. 76960000 IN008020 EQU * 76980000 OI CACFLAG6,CACHAR60 INDICATE CHAR60 IN COMMUNICATION 77000000 * AREA. 77020000 B IN013020 BRANCH TO CHECK DISPOSITION OF A45714 77040000 * EDIT DATA SET. 77060000 EJECT 77080000 IN013010 EQU * 77100000 L EPLOCREG,IEMSGRTN ADDRESS OF MESSAGE ROUTINE. 77120000 CALL (15),((COMMREG),(ERR1REG),(ERR2REG),(DATA1REG), X77140000 (DATA2REG)),MF=(E,INSVCRTN) BRANCH TO PUT ERROR X77160000 MESSAGE. 77180000 BR AREAREG RETURN TO CALLER. 77200000 IN013020 EQU * A45714 77220000 .* CHECK IF USER DATA SET TYPE SUBFIELD SPECIFIED. A45714 77240000 AIF (&SW EQ 0).TAG16 A45714 77260000 EJECT A45714 77280000 **************************************************************** A45714 77300000 * A45714 77320000 * USER DATA SET TYPE KEYWORD SUBFIELD OPERAND. A45714 77340000 * A45714 77360000 * VERIFY PRESENCE AND INVOKE USER EXIT TO ENCODE SUBFIELD A45714 77380000 * PARAMETERS INTO A TWO BYTE FIELD 'CACHKOPT' IN THE EDIT A45714 77400000 * COMMUNICATION AREA. THE EXIT ROUTINE IS PASSED A THREE A45714 77420000 * WORD PARAMETER LIST IN THE FOLLOWING FORM: A45714 77440000 * A45714 77460000 * WORD 1 - ADDRESS OF SUBFIELD PDE. A45714 77480000 * WORD 2 - ADDRESS OF ANSWER AREA. A45714 77500000 * WORD 3 - ADDRESS OF CPPL. A45714 77520000 * A45714 77540000 * WHERE THE PDE IS OF THE FORM GENERATED BY THE IKJPARS A45714 77560000 * IKJIDENT MACRO AND THE ANSWER AREA IS A HALFWORD FIELD. A45714 77580000 * A45714 77600000 **************************************************************** A45714 77620000 CLI CAEXTNAM,D0 CHECK IF EXIT SUPPLIED. A45714 77640000 BE IN013060 IF NO, BRANCH TO CHECK DISPOSITION A45714 77660000 * OF EDIT DATA SET. A45714 77680000 LA LENREG,D1 NUMBER OF BLDL ENTRIES. A45714 77700000 STH LENREG,INBLDLNO A45714 77720000 LA LENREG,INENTRYL LENGTH OF BLDL LIST. A45714 77740000 STH LENREG,INBLDLLN A45714 77760000 MVC INBLDLNM(L'INBLDLNM),CAEXTNAM MOVE EXIT NAME A45714 77780000 * INTO BLDL ENTRY LIST. A45714 77800000 BLDL 0,INBLDLST ISSUE BLDL ON EXIT ROUTINE NAME. A45714 77820000 B IN013030(RETCDREG) CHECK RETURN CODE FROM BLDL. A45714 77840000 SPACE 77860000 IN013030 EQU * A45714 77880000 B IN013050 RC = 00, ROUTINE IN SYSTEM. A45714 77900000 B IN013040 RC = 04, ROUTINE NOT FOUND. A45714 77920000 * RC = 08, I/O ERROR DURING BLDL. A45714 77940000 LA ERR1REG,INERROR2 RELATIVE ERROR TO BE PROCESSED. A45714 77960000 LA ERR2REG,M3131 RELATIVE SECOND LEVEL MESSAGE. A45714 77980000 L DATA2REG,IEINS003 MESSAGE INSERTION ADDRESS. A45714 78000000 BAL AREAREG,IN013010 BRANCH TO PUT ERROR MESSAGE. A45714 78020000 B IEEXIT1 BRANCH TO RETURN TO TMP. A45714 78040000 SPACE 78060000 IN013040 EQU * A45714 78080000 LA ERR1REG,INERRORA RELATIVE ERROR TO BE PROCESSED. A45714 78100000 BAL AREAREG,IN013010 BRANCH TO PUT ERROR MESSAGE. A45714 78120000 B IEEXIT1 BRANCH TO RETURN TO TMP. A45714 78140000 SPACE 78160000 IN013050 EQU * A45714 78180000 * BUILD EXIT ROUTINE PARAMETER LIST. A45714 78200000 LA PDLREG,INUSERTY ADRESS OF SUBFIELD PDE. A45714 78220000 ST PDLREG,INEXTPDE A45714 78240000 LA PDLREG,CACHKOPT ADDRESS OF ANSWER AREA. A45714 78260000 ST PDLREG,INEXTANS A45714 78280000 L PDLREG,CAPTTMP ADDRESS OF CP PARMLIST. A45714 78300000 ST PDLREG,INEXTCPL A45714 78320000 LA PARMREG1,INEXTPRM ADDRESS OF PARMLIST. A45714 78340000 LA PDLREG,INBLDLNM ADDRESS OF BLDL LIST NAME. A45714 78360000 LINK DE=(PDLREG),DCB=0 LINK TO EXIT ROUTINE. A45714 78380000 SPACE 78400000 IN013060 EQU * A45714 78420000 .TAG16 ANOP A45714 78440000 B IEEXIT2 BRANCH TO CHECK DISPOSITION A45714 78460000 * OF EDIT DATA SET. A45714 78480000 EJECT 78500000 *********************************************************************** 78520000 * * 78540000 * EXIT AREA -- RETURN TO INVOKING ROUTINE WITH A RETURN CODE TO * 78560000 * INDICATE SUCCESS OR FAILURE. RETURN CODES ARE -- ZERO (ALL 78580000 * OPERANDS ENTERED BY USER WERE CORRECT OR WERE DEFAULTED FOR 78600000 * THE EDIT DATA SET TYPE), 4 (A TERMINAL ERROR WAS ENCOUNTERED, * 78620000 * TERMINATE EDIT). * 78640000 * * 78660000 *********************************************************************** 78680000 IEEXIT1 EQU * 78700000 LA RETCDREG,D4(,D0) SET ERROR RETURN CODE. 78720000 B IEEXIT3 BRANCH TO RETURN TO CALLING ROUTINE 78740000 IEEXIT2 EQU * 78760000 SR RETCDREG,RETCDREG SET SUCCESSFUL RETURN CODE. 78780000 IEEXIT3 EQU * 78800000 IKJEBERT (14,12),,RC=(15) RETURN TO CALLING ROUTINE. 78820000 EJECT 78840000 *********************************************************************** 78860000 * * 78880000 * CONVERT TO BINARY SUBROUTINE. * 78900000 * * 78920000 *********************************************************************** 78940000 INCVBIN EQU * 78960000 BCTR SIZEREG,PARMREG0 REDUCE OPERAND LENGTH BY 1. 78980000 EX SIZEREG,IEPACK1 CHANGE TO PACKED DECIMAL FORMAT. 79000000 CVB LENREG,INDECBIN CHANGE TO FIXED BINARY FORMAT. 79020000 BR RETREG RETURN TO CALLER. 79040000 SPACE 5 79060000 INP03010 EQU * 79080000 *********************************************************************** 79100000 * * 79120000 * SUBROUTINE USED TO DETERMINE IF LINE AND/OR BLOCK KEYWORDS WERE * 79140000 * ENTERED ON THE EDIT COMMAND. * 79160000 * * 79180000 * DETERMINE IF LINE OR BLOCK OR BOTH KEYWORDS WERE ENTERED. IF * 79200000 * SO, INFORM USER THAT KEYWORD IS INVALID WITH OLD DATA SET. * 79220000 * WHEN COMPLETE, BRANCH TO CHECK SCAN OPERAND. * 79240000 * * 79260000 *********************************************************************** 79280000 USING INECMNDD,DATAREG ADDRESSABILITY TO PARSE PDL. 79300000 TM CADSATTR,CALRECLX CHECK IF LRECL MUST BE 80. 79320000 BZ INP03015 IF NOT, BRANCH TO CHECK IF LINE 79340000 * AND/OR BLOCK OPERAND SPECIFIED 79360000 TM CACFLAG2,CARECFM CHECK IF RECFM = V FOR OLD DATA 79380000 BO INP03015 SETS. IF FIXED, BRANCH TO 79400000 * CHECK IF USER SPECIFIED LINE 79420000 * OPERAND. 79440000 LA ERR1REG,INERRORJ RELATIVE ERROR TO BE PROCESSED. 79460000 BAL AREAREG,IN013010 BRANCH TO PUT ERROR MESSAGE. 79480000 B IEEXIT1 BRANCH TO EXIT WITH ERROR RETURN 79500000 * CODE. 79520000 INP03015 EQU * 79540000 CLC INLNE(L'IENOKEYW),IENOKEYW CHECK IF LINE KEYWORD 79560000 * WAS SPECIFIED. 79580000 BE INP03020 IF NOT, BRANCH TO CHECK IF BLOCK 79600000 * KEYWORD WAS SPECIFIED. 79620000 LA ERR1REG,INERRORG RELATIVE ERROR TO BE PROCESSED. 79640000 LA DATA1REG,IEINS001 INSERTION RECORD FOR MESSAGE. 79660000 BAL AREAREG,IN013010 BRANCH TO PUT ERROR MESSAGE. 79680000 LTR RETCDREG,RETCDREG CHECK IF PUTLINE WAS SUCCESSFUL. 79700000 BNZ IEEXIT1 IF NOT, BRANCH TO RETURN TO TMP. 79720000 INP03020 EQU * 79740000 CLC INBLK(L'IENOKEYW),IENOKEYW CHECK IF BLOCK KEYWORD 79760000 * WAS SPECIFIED. 79780000 BE IN004020 IF NOT, BRANCH TO CALCULATE NUMBER 79800000 * OF RECORDS IN OLD DATA SET. 79820000 LA ERR1REG,INERRORG RELATIVE ERROR TO BE PROCESSED. 79840000 LA DATA1REG,IEINS002 INSERTION RECORD FOR MESSAGE. 79860000 BAL AREAREG,IN013010 BRANCH TO PUT ERROR MESSAGE. 79880000 LTR RETCDREG,RETCDREG CHECK IF PUTLINE WAS SUCCESSFUL. 79900000 BNZ IEEXIT1 IF NOT, BRANCH TO RETURN TO TMP. 79920000 B IN004020 BRANCH TO CALCULATE NUMBER OF 79940000 * RECORDS IN OLD DATA SET. 79960000 SPACE 5 79980000 IN011010 EQU * 80000000 *********************************************************************** 80020000 * * 80040000 * VALIDATE GOFORT OPERANDS. * 80060000 * * 80080000 * DETERMINE IF DATA SET TYPE IS GOFORT. IF NOT GOFORT, RETURN. * 80100000 * WHEN GOFORT, DETERMINE IF FIXED OR FREE WAS SPECIFIED. IF FREE * 80120000 * SPECIFIED, CAUSE EDIT TO BE TERMINATED UNDER TWO CONDITIONS -- * 80140000 * (1) RECORD FORMAT F FOR OLD DATA SET, OR (2) LINE OPERAND * 80160000 * SPECIFIED FOR A NEW DATA SET. IF GOFORT(FIXED) HAS BEEN * 80180000 * SPECIFIED, INDICATE THAT LRECL IS ALWAYS 80 AND THAT CAPS ARE * 80200000 * REQUIRED. CHANGE SEQUENCE NUMBER START POSITION FROM 1 TO 73. * 80220000 * * 80240000 *********************************************************************** 80260000 CLI CADSCODE,CAGOFORT DETERMINE IF DATA SET TYPE IS 80280000 BNE IN011020 GOFORT. IF NOT, RETURN. 80300000 L AREAREG,INPDLPTR ADDRESS OF PROMPT PDL. A45713 80320000 LTR AREAREG,AREAREG CHECK IF PDL PRESENT. A45713 80340000 BNP IN011011 IF NO, BRANCH TO PROCESS GOFORT. A45713 80360000 USING ICDSTPDL,AREAREG ESTAB. ADDRESSABILITY FOR PDL. A45713 80380000 CLC INTSFTF2(L'IEKEYDEF),IEKEYDEF CHECK IF 'FIXED' A45713 80400000 * SPECIFIED FOR GOFORT. A45713 80420000 BH IN011014 IF YES, BRANCH TO PROCESS. A45713 80440000 B IN01101A IF NO, BRANCH TO SET SWITCHES. A45713 80460000 DROP AREAREG A45713 80480000 SPACE 80500000 IN011011 EQU * A45713 80520000 CLC INTSFTFM(L'IEKEYDEF),IEKEYDEF DETERMINE IF 'FIXED' 80540000 * SPECIFIED FOR GOFORT. 80560000 BH IN011014 IF SO, BRANCH TO PROCESS. 80580000 IN01101A EQU * A45713 80600000 XI IN8FLAGS,IN8GOFSW FLIP GOFORT SWITCH. 80620000 BZ IN011020 IF ZERO, VALIDATION HAS BEEN 80640000 * PERFORMED, BRANCH TO RETURN. 80660000 TM CAEDFLAG,CAEDDISP DETERMINE IF DATA SET IS NEW. 80680000 BZ IN011012 IF SO, BRANCH TO DETERMINE IF LINE 80700000 * OPERAND SPECIFIED. 80720000 TM CACFLAG2,CARECFM IF OLD, DETERMINE IF RECORD FORMAT 80740000 * IS VARIABLE. 80760000 BZ IN011015 IF VARIABLE, BRANCH TO SET 'FREE' 80780000 * SWITCH AND RETURN. 80800000 B IN011013 BRANCH TO SEND ERROR MESSAGE. 80820000 IN011012 EQU * 80840000 CLC INLNE(L'IENOKEYW),IENOKEYW DETERMINE IF LINE 80860000 * OPERAND SPECIFIED. 80880000 BE IN011015 IF SO, BRANCH TO SET 'FREE' SWITCH 80900000 * AND RETURN. 80920000 IN011013 EQU * 80940000 LA ERR1REG,INERRORV SPECIFY RELATIVE ERROR TO BE 80960000 * PROCESSED. 80980000 BAL AREAREG,IN013010 BRANCH TO SEND ERROR MESSAGE. 81000000 OI IN8FLAGS,IN8TERME INDICATE THAT EDIT IS TO BE 81020000 * TERMINATED BY CALLER. 81040000 BR SRRTNREG RETURN TO CALLER. 81060000 IN011014 EQU * 81080000 OI CADSATTR,CACAPSRQ+CALRECLX INDICATE CAPS REQUIRED 81100000 * AND DEFAULT LRECL TO BE USED. 81120000 LH SIZEREG,IELR080 LRECL IS 80 FOR FIXED FORMAT. 81140000 STH SIZEREG,CAFLRLDF SET LRECL IN PROCESSOR TABLE. 81160000 MVI CALINE,INTSFSQO SET SEQUENCE NUMBER START POSITION 81180000 * TO 73 FOR FIXED. 81200000 B IN011020 BRANCH TO RETURN TO CALLER. 81220000 IN011015 EQU * 81240000 OI CACFLAG6,CAFREE INDICATE THAT GOFORT RECORD FORMAT 81260000 * IS FREE FORM. 81280000 IN011020 EQU * 81300000 BR SRRTNREG RETURN TO CALLER. 81320000 DROP DATAREG 81340000 EJECT 81360000 *********************************************************************** 81380000 * * 81400000 * EQUATES, CONSTANTS AND AREAS USED BY THIS ROUTINE. * 81420000 * * 81440000 *********************************************************************** 81460000 IENOKEYW DC XL2'0' CONSTANT USED TO DETERMINE IF A 81480000 * KEYWORD ENTERED ON COMMAND. 81500000 IEMSGRTN DC V(IKJEBIN3) ADDRESS OF MESSAGE ROUTINE FOR 81520000 * INITIALIZATION PHASE. 81540000 IEINS003 DC A(ININS002) ADDRESS OF MESSAGE INSERTION. A45714 81560000 IEKEYDEF DC XL2'1' DEFAULT KEYWORD NUMBER FROM IKJPARS 81580000 IELR080 DC H'80' DEFAULT LRECL = 80. 81600000 DS 0F ALIGN ON WORD BOUNDARY. 81620000 IEDEVTYP DC XL4'03000000' INDICATOR FOR DEVTYPE SVC ROUTINE. 81640000 IELSTDSC DC X'0001000E' LIST DESCRIPTION FIELD FOR BLDL. 81660000 IESTP073 DC H'73' START POSITION COLUMN 73. 81680000 IESTP080 EQU IELR080 START POSITION COLUMN 80. 81700000 IEPACK1 PACK INDECBIN(L'INDECBIN),D0(*-*,AREAREG) CONVERT 81720000 IECPSSUP EQU IEKEYDEF KEYWORD NUMBER FOR CAPS OPERAND. 81740000 * OPERAND TO PACKED DECIMAL. 81760000 IEINS001 IKJEBEMG 0,M334IN1,'LINE' INVALID OPERAND INSERTION. 81780000 IEINS002 IKJEBEMG 0,M334IN1,'BLOCK' INVALID OPERAND INSERTION. 81800000 EJECT 81820000 IKJDAP08 81840000 EJECT 81860000 IKJDAP18 81880000 EJECT 81900000 IKJEBECA 81920000 SPACE 2 81940000 *********************************************************************** 81960000 * * 81980000 * DEFINE INITIALIZATION WORK AREA IN THE COMMUNICATION AREA. * 82000000 * * 82020000 *********************************************************************** 82040000 ORG CABFRPL ORIGIN INITIALIZATION WORK AREA. 82060000 INWKAREA DS 0F INITIALIZATION WORKAREA. 82080000 INDREC DS (((DA08DSO-DAPB08+L'DA08DSO+3)/4)*4)X IKJDAIR 82100000 * PARAMETER BLOCK. 82120000 ORG INWKAREA OVERLAY INITIALIZATION WORK AREA. 82140000 INCAMFLG DS F CAMLIST FLAGS FOR OBTAIN. 82160000 INCAMDSN DS F ADDRESS OF DATA SET NAME FOR OBTAIN. 82180000 INCAMVOL DS F ADDRESS OF VOLSER NUMBER FOR OBTAIN. 82200000 INCAMWRK DS F ADDRESS OF WORK AREA FOR OBTAIN. 82220000 INMSGBUF EQU * 82230000 INCAMOBT DS 350C OBTAIN WORK AREA. 82240000 INOBTEND EQU * CONSTANT TO ORG TO @ZA05823 82243000 ORG INCAMOBT LOCATE OUTPUT OVERLAY @ZA05823 82246000 DS CL6 NO OF VOLUMES AND DEVICE TYPE @ZA05823 82249000 LOCATVLD DS CL6 VOLID FOR OBTAIN TO SEACRH @ZA05823 82252000 ORG INOBTEND RESUME NORMAL MAPPING @ZA05823 82255000 INCAMVLD DS CL6 VOLUME SERIAL NUMBER. 82260000 INDSNAME DS CL44 EDIT DATA SET'S TRUE NAME @ZA05823 82270000 INSYNCHK DS 0F ALIGN BLDL LIST ON WORD BOUNDARY. 82280000 INBLDWD DS F LIST DESCRIPTION FIELD. 82300000 INMEMBER DS 0C MEMBER NAME FOR BLDL. 82320000 INSYNNME DS 8C MODULE NAME. 82340000 DS 6X RESERVED FOR BLDL RETURN 82360000 * INFORMATION. 82380000 INDECBIN DS D DOUBLE WORD USED FOR CONVERT TO 82400000 * BINARY OPERATIONS. 82420000 INLINKSF DS 2F SUPERVISOR PARAMETER LIST FOR LINK. 82440000 INSVCRTN DS 6F WORK AREA FOR SERVICE ROUTINE 82460000 * HANDLER. 82480000 INXCTLPL DS 2F XCTL WORK AREA. 82500000 INDEVTYP DS 2F DEVTYPE WORK AREA. 82520000 INCYLNO DS H NUMBER OF CYLINDERS ON DEVICE. 82540000 INTRKNO DS H NUMBER OF TRACKS PER CYLINDER. 82560000 INTRKCAP DS H TRACK CAPACITY (IN BYTES). 82580000 INOVHDK DS X OVERHEAD FOR KEYED RECORDS, NOT 82600000 * LAST BLOCK. 82620000 INOVHDKL DS X OVERHEAD FOR KEYED RECORDS, LAST 82640000 * BLOCK. 82660000 INOVHDNK DS X OVERHEAD TO BE SUBTRACTED FOR 82680000 * NON-KEYED RECORDS. 82700000 INDEVFLG DS X TOLERANCE FACTOR FLAGS. 82720000 INOVHFLG EQU X'08' IF 1, BLOCK OVERHEAD IN HALFWORD @ZA13889 82726000 * IF 0, ONE BYTE @ZA13889 82732000 INTOLFLG EQU X'01' IF 1 (ONE), TOLERANCE FACTOR TO BE 82740000 * APPLIED. 82760000 INTOLFAC DS H TOLERANCE FACTOR. 82780000 INCOREPT DS F ADDRESS OF GOTTEN CORE. 82800000 INCVDAR DS D RETURN CODE IS PROCESSED HERE @ZA05823 82806000 INUNPKAR DS D AND UNPACKED HERE @ZA05823 82812000 ORG INWKAREA OVERLAY INITIALIZATION WORK AREA. 82820000 IN7WORK DS 0F WORK AREA FOR IKJEBIN7 82840000 IN7PLIST DS 6F PARAMETER LIST AREA FOR ROUTINES 82860000 * CALLED BY IKJEBIN7 82880000 IN7FLAGS DS X CONTROL FLAG FOR IKJEBIN7. 82900000 IN7DELPS EQU X'80' BIT 0 = 1 INDICATES DELETE MUST 82920000 * BE ISSUED FOR IKJEBEPS. 82940000 IN7NOQLF EQU X'40' BIT 1 = 1 INDICATES NO QUALIFIER 82960000 * CHECKING REQUIRED. 82980000 IN7QLFCK EQU X'FF'-IN7NOQLF BIT 1 = 0 INDICATES QUALIFIER 83000000 * CHECKING REQUIRED. 83020000 IN7WKLEN EQU *-IN7WORK LENGTH OF IKJEBIN7 WORK AREA. 83040000 SPACE 2 83060000 IN8FLAGS DS X CONTROL FLAG BYTE FOR IKJEBIN8. 83080000 IN8ZEROS EQU X'00' INITIAL VALUE FOR FLAG BYTE. 83100000 * 83120000 * NOTE -- BITS 2-7 OF 'IN8FLAGS' ARE RESERVED. 83140000 * 83160000 IN8GOFSW EQU X'80' AFTER EXCLUSIVE OR OF THIS BIT IN THE 83180000 * GOFORT VALIDATION SUBROUTINE, 83200000 * PROCESSING CONTINUES AS FOLLOWS -- 83220000 * BIT 0 ON - CONTINUE VALIDATION 83240000 * BIT 0 OFF - RETURN TO CALLER - 83260000 * OPERANDS AND ATTRIBUTES HAVE BEEN 83280000 * VALIDATED. 83300000 IN8TERME EQU X'40' BIT 1 ON - EDIT IS TO BE TERMINATED 83320000 * WITH ERROR INDICATION. 83340000 * BIT 1 OFF - GOFORT OPERAND VALIDATION 83360000 * SUCCESSFUL. 83380000 SPACE 2 83400000 INWKDCB DS 14F DCB USED FOR BLDL ON EDIT DATA SET. 83420000 INWKOPEN DS F REMOTE PARAMETER LIST FOR OPEN AND 83440000 * CLOSE SVCS. 83460000 SPACE 2 83480000 IN3WKA DS 7F REMOTE PROGRAM PARAMETER LIST. 83500000 IN3MSLST DS 3F PARAMETER LIST FOR IKJEBEMS. 83520000 IN3MSIN1 DS 0F INSERTION LIST FOR SERVICE ROUTINE 83540000 * NAME. 83560000 IN3PT1 DS F ADDRESS OF NEXT INSERTION. 83580000 IN3LEN1 DS H LENGTH OF INSERTION. 83600000 IN3OFF1 DS H OFFSET OF INSERTION. 83620000 IN3INS1 DS CL8 INSERTION TEXT. 83640000 IN3MSIN2 DS 0F INSERTION LIST FOR RETURN CODE. 83660000 IN3PT2 DS F ADDRESS OF NEXT INSERTION. 83680000 IN3LEN2 DS H LENGTH OF INSERTION. 83700000 IN3OFF2 DS H OFFSET OF INSERTION. 83720000 IN3INS2 DS CL2 INSERTION TEXT. 83740000 INTEMPBF DS CL88 TEMPORARY INPUT BUFFER USED FOR 83760000 * IKJPARS PROMPT RESPONSES. 83780000 SPACE 2 83800000 ORG CASCWKA DEFINE WORK AREA FOR IKJEBIN5 A45713 83820000 * AND PARTS OF IKJEBIN8. A45714 83840000 INPGLIST DS 4F IKJPTGT PARM BLOCK. A45713 83860000 INPTLIST DS 3F IKJPUTL LIST @OZ05180 83870000 INPDLPTR DS A ADDRESS OF PROMPT PDL. A45713 83880000 SPACE 83900000 INBLDLST DS 0H BLDL LIST FOR USER EXIT RTN. A45714 83920000 INBLDLNO DS H NUMBER OF BLDL ENTRIES. A45714 83940000 INBLDLLN DS H LENGTH OF BLDL ENTRY. A45714 83960000 INBLDLNM DS CL8 MODULE NAME OF USER EXIT. A45714 83980000 DS CL50 INFORMATION RETURNED BY BLDL. A45714 84000000 INENTRYL EQU *-INBLDLNM LENGTH OF BLDL ENTRY. A45714 84020000 SPACE 84040000 INEXTPRM DS 0F USER EXIT PARM LIST. A45714 84060000 INEXTPDE DS A ADDRESS OF SUBFIELD PDE. A45714 84080000 INEXTANS DS A ADDRESS OF ANSWER AREA. A45714 84100000 INEXTCPL DS A ADDRESS OF CP PARMLIST. A45714 84120000 EJECT 84140000 IEFTIOT1 DSECT DSECT FOR TASK INPUT/OUTPUT TABLE. 84160000 IEFTIOT1 84180000 EJECT 84200000 IEFUCBOB DSECT DSECT FOR UNIT CONTROL BLOCK. 84220000 IEFUCBOB 84240000 EJECT 84280000 CVT DSECT DSECT FOR COMMUNICATIONS VECTOR 84300000 CVT SYS=VMS TABLE. 84320000 EJECT 84340000 IKJTCB 84360000 EJECT 84380000 IECDSCB1 DSECT FORMAT 1 DSCB DSECT. 84400000 IECSDSL1 (1) 84420000 EJECT 84440000 IKJCPPL 84460000 EJECT 84480000 IKJECT 84500000 EJECT 84520000 IKJPPL 84540000 EJECT 84560000 DCBD DSORG=PO,DEVD=DA 84580000 EJECT 84600000 IKJDFPL 84620000 EJECT 84640000 IKJDFPB 84660000 EJECT 84680000 IKJIOPL 84700000 EJECT 84720000 IKJPGPB A45713 84740000 INPGPBLN EQU *-PGPB LENGTH OF PUTGET PARM BLOCK. A45713 84760000 EJECT 84780000 IKJPTPB @OZ05180 84786000 INPTPBLN EQU *-PTPB @OZ05180 84792000 IKJPSCB 84800000 MEND 84820000