* /* START OF SPECIFICATIONS *** * 00010002 *01* PROCESSOR = ASSEM; * 00012002 **** END OF SPECIFICATIONS ***/ * 00014002 TITLE 'IEHPROG1-IEHPROGM ROOT, PARAM LIST BUILDER, VOL LOOKUP' 00020002 *********************************************************************** 00040002 * YL026VC* 00050002 * MODULE NAME -- IEHPROG1 YL026VC* 00052002 * YL026VC* 00054002 * DESCRIPTIVE NAME -- IEHPROGM ROOT, PARAM LIST BUILDER, VOL YL026VC* 00056002 * LOOKUP YL026VC* 00056402 * YL026VC* 00058002 * COPYRIGHT -- NONE YL026VC* 00058402 * YL026VC* 00058802 * STATUS -- 'IEHPROG1' OS/VS2 PROLOGUE MODIFICATION YL026VC* 00060002 * SEPTEMBER 1975 @Z40CSJH* 00100004 * YL026VC* 00110002 * FUNCTION -- THIS MODULE IS THE FIRST LOAD OF 'MODIFY'. * 00120002 * IT SAVES THE SYSTEMS REGISTERS, AND ISSUES A GETMAIN * 00140002 * FOR 2048 BYTES WHICH WILL SERVE AS A WORK AREA FOR * 00160002 * THE PROGRAM. ON INITIAL ENTRY IT WILL CALL ON IEHPROG4 * 00180002 * A SEPARATE CSECT THAT WILL ANALYZE THE PARAMETER LIST * 00200002 * PASSED BY THE INVOCER AND RETURN WITH DCB'S OPENED * 00220002 * FOR SYSIN AND SYSPRINT. IT WILL THEN READ SYSIN FOR * 00240002 * THE UTILITY CONTROL STATEMENTS, ANALYZE THE CONTENTS * 00260002 * OF THESE STATEMENTS, BUILD REQUIRED PARAMETER LIST * 00280002 * AND CALL ON IEHPROG5 TO MOUNT REQUIRED VOLUMES. IF THE * 00300002 * INPUT CONTROL STATEMENT IS IN ERROR OR IF THE REQUIRED * 00320002 * VOLUMES CANNOT BE MOUNTED A DIAGNOSTIC MESSAGE WILL BE * 00340002 * WRITTEN ON 'SYSPRINT' AND THE PROGRAM WILL CONTINUE BY * 00360002 * READING THE NEXT CONTROL STATEMENT. IF THE STATEMENT * 00380002 * IS VALID AND THE VOLUMES ARE (OR CAN BE) MOUNTED THEN * 00400002 * THIS MODULE WILL XCTL TO IEHPROG2, A MODULE WHICH WILL * 00420002 * ISSUE THE APPROPRIATE SVC'S AND ANALYZE THEIR RETURNS. * 00440002 * * 00450004 * THE FOLLOWING OS CVOL (CONTROL VOLUME) FUNCTIONS @Z40CSJH* 00452004 * HAVE BEEN REACTIVATED FOR MVS EXTENDED CVOL SUPPORT @Z40CSJH* 00454004 * BLDG,BLDX,DLTX,BLDA,DLTA @Z40CSJH* 00456004 * CONNECT AND RELEASE @Z40CSJH* 00458004 * ALSO REACTIVATED FOR ARE THE FOLLOWING @Z40CSJH* 00458404 * KEYWORD PARAMETERS ASSOCIATED WITH THE ABOVE FUNCTIONS @Z40CSJH* 00458804 * INDEX,ALIAS,DELETE,ENTRIES,EMPTY @Z40CSJH* 00459204 * * 00460002 * ENTRY POINTS -- * 00480002 * IEHPROG6 IS ALWAYS THE INITIAL ENTRY POINT FOR THIS * 00500002 * MODULE. ENTRY IS FROM THE SUPERVISOR AS A RESULT OF AN * 00520002 * EXECUTE CARD IN THE JOB STREAM OR AN XCTL OR LINK FROM * 00540002 * ANY OTHER PROGRAM. * 00560002 * IEHPROG9 IS THE SECOND ENTRY POINT AND IS ENTERED * 00580002 * ONLY BY A RETURN FROM THE SECOND LOAD OF MODIFY. * 00600002 * * 00620002 * INPUT -- INPUT DATA TO THIS MODULE IS 80 CHARACTER BLOCKED * 00640002 * CARD IMAGES READ FROM 'SYSIN'. THE FORMAT OF THESE * 00660002 * CONTROL STATEMENTS IS DESCRIBED IN THE FORM 'OPERATING * 00680002 * SYSTEM / 360 UTILITIES'. * 00700002 * * 00720002 * OUTPUT -- OUTPUT TO 'SYSPRINT' CONSISTS OF MESSAGES WHICH * 00740002 * IDENTIFY PARTICULAR CONTROL STATEMENT ERRORS PLUS A LIST * 00760002 * OF CONTROL STATEMENTS. OUTPUT TO THE SECOND LOAD OF * 00780002 * MODIFY CONSISTS OF THE ADDRESS OF THE COMMON WORK AREA * 00800002 * CONTAINED IN REGISTER 12. * 00820002 * * 00840002 * EXTERNAL REFERENCES -- * 00860002 * IEHPROG4 IS CALLED UPON TO INTERPRET THE PARAMETERS * 00880002 * PASSED BY AN INVOKER. * 00900002 * IEHPROG5 IS CALLED UPON TO MOUNT THE REQUIRED VOLUMES. * 00920002 * IEHPROG3 IS CALLED UPON TO WRITE ALL MESSAGES. * 00940002 * IEHPROG2 IS CALLED UPON TO PERFORM THE SECOND LOAD * 00960002 * OF MODIFY. * 00980002 * * 01000002 * EXITS,NORMAL -- THIS ROUTINE RESTORES THE SYSTEMS REGISTERS * 01020002 * AND EXITS THROUGH REGISTER 14. REGISTER 15 WILL EQUAL 0 * 01040002 * INDICATING THAT ALL REQUESTS WERE SERVICED AND NO ERROR * 01060002 * WAS ENCOUNTERED. * 01080002 * * 01100002 * EXITS,ERROR -- THIS ROUTINE RESTORES THE SYSTEMS REGISTERS * 01120002 * AND EXITS THROUGH REGISTER 14. REGISTER 15 CONTAINS THE * 01140002 * ERROR CODE AS FOLLOWS: * 01160002 * REGISTER 15 = 8 SOME REQUEST(S) NOT SERVICED * 01180002 * REGISTER 15 = 12 PERMANENT ERROR ON SYSIN * 01200002 * REGISTER 15 = 12 PERMANENT ERROR ON SYSPRINT * 01220002 * REGISTER 15 = 16 PROGRAM INTERRUPT * 01240002 * * 01260002 * TABLES/WORK AREAS -- * 01280002 * VCONLIST - A LIST OF ADDRESS CONSTANTS USED TO PROVIDE * 01300002 * LINKAGE TO MODULES WHEN THE PROGRAM IS USED IN OVERLAY * 01320002 * MODE. * 01340002 * PPARAMSW - A TWO BYTE BIT STRING FOR EACH OPTION WITH * 01360002 * BITS SET TO ONE TO INDICATE THE VALID PARAMETERS. * 01380002 * TABLEN1 THRU TABLEN9 - TABLES USED FOR CHECKING THE * 01400002 * VALIDITY OF OPERATIONS AND OPERANDS AND CONTAINING THE * 01420002 * ADDRESS OF CODE TO PROCESS THE SAME. * 01440002 * NAMEX - DSECT OF THE WORK AREA OBTAINED BY GETMAIN AND * 01460002 * USED BY ALL MODULES OF THE PROGRAM. * 01480002 * * 01500002 * ATTRIBUTES -- READ ONLY, REENTRANT, REUSABLE, PROBLEM PROGRAM, * 01520002 * ENABLED. * 01540002 * * 01560002 * CHARACTER CODE DEPENDENCY -- THIS MODULE MUST BE ASSEMBLED * 01580002 * IN EBCDIC AND RUN IN EBCDIC TO INSURE COLLATING SEQUENCE * 01600002 * AND INTERNAL REPRESENTATION OF CERTAIN CHARACTERS. * 01620002 * * 01640002 * NOTES -- STORAGE OF APPROXIMATELY 6000 BYTES FOR CODE AND * 01660002 * ANOTHER 5390 BYTE WORK AREA. * 01680002 * * 01700002 * CHANGE ACTIVITY -- FOLLOWS PROLOGUE YL026VC* 01710002 * YL026VC* 01712002 *********************************************************************** 01720002 * 01740002 * 01760002 ******************************************************************** 01780002 * * 01800002 * * 01820002 * -----IEHPROG1 THE STEM OF MODIFY----- M2838 01840002 * * 01860002 IEHPROG1 CSECT M2838 01880002 *A500-588,1100,17100-17200 YL026VC 01882002 *C600-1000 YL026VC 01884002 *C313600,315600-316000,317400-322200,323000,324400-324800 YL026VC 01890002 *C327000-329200 YL026VC 01894002 *A295240 YM5077 01900002 *A278900 YA01672 01910002 *C400,13200 M2838 01920002 *277200,277400 I276 01940002 *2480068000,265600 8429 01960002 *0233171600,276600 DT0I 01980002 *2359047000 PTM1623 02000002 * 082800,083200,262400,262600 A23466 02020002 * A24144 02040002 * A24020 02060002 * A25564 02080002 * A28552 02100002 * A31430 02120002 *A 073100-073120,073701-073703,073728-073732,073773-073775 YA01678 02122002 *C 073618,073699,073753 YA01678 02124002 *D 073627 YA01678 02126002 *C 145060 YA01707 02130002 *A 202700,202720,205601-205740 @ZA01655 02130102 *C 145000,203600,224200 @ZA01655 02130202 *C 437800 @30AAAG 02132003 *C 145000 @ZM33351 02132203 *A 437920,940 @30AAAG 02134003 *C 1000,4520-4592,313600,315600-316000 @Z40CSJH 02136004 *C 317400-320400,321200-322200 @Z40CSJH 02138004 *C 323100,324400-324800,325600 @Z40CSJH 02138404 *C 327000-327400,328200-329200 @Z40CSJH 02138804 *A 422300 @ZA11944 02139299 *C 415400 @ZA13755 02139699 USING *,15 * 02140002 SAVE (14,12) THIS SAVE INCLUDES R9 02160002 L 9,VCONLIST * 02180002 L 15,VCON1 * 02200002 BR 15 * 02220002 VCON1 DC V(IEHPROG6) THIS LIST OF ADCONS M2838 02240002 VCON2 DC V(IEHPROG9) IS USED THROUGHOUT THE M2838 02260002 VCON3 DC V(IEHPROG3) PROGRAM TO PROVIDE THE M2838 02280002 VCON4 DC V(IEHPROG5) LINKAGE REQUIREMENTS OF M2838 02300002 VCON5 DC V(IEHPROG4) MODIFY IN AN OVERLAY M2838 02320002 VCON6 DC V(IEHPROG8) STRUCTURE. M2838 02340002 VCON7 DC V(IEHPROG7) THROUGHOUT EXECUTION OF M2838 02360002 VCON8 DC V(IEHPROG2) THE PROGRAM THE ADDRESS M2838 02380002 VCON9 DC V(IEHPROGA) OF THIS LIST IS MAINTAINED M2838 02400002 VCONLIST DC A(VCON1) IN THE WORKAREA AT A * 02420002 * LOCATION KNOWN AS DECB2 * 02440002 * FOR USE BY THE ENTIRE * 02460002 * PROGRAM AS REQUIRED. * 02480002 * * 02500002 ******************************************************************** 02520002 * 02540002 * 02560002 IEHPROG6 CSECT M2838 02580002 * ***** REGISTER USAGE ***** 02600002 ZERO EQU 0 ---------------------------------------- 02620002 R1 EQU 12 02640002 ARGREG EQU 1 ARGUMENT ADDRESS FROM TRT A28552 02660002 R2 EQU 2 02680002 R3 EQU 3 REGISTERS ZERO THROUGH 02700002 R4 EQU 4 TEN ARE WORK REGISTERS 02720002 R5 EQU 5 02740002 R6 EQU 6 REGESTERS ELEVEN AND 02760002 R7 EQU 7 TWELVE ARE BASE REGISTERS 02780002 R8 EQU 8 FOR THE PROGRAN AND THE 02800002 R9 EQU 9 DUMMY SECTION RESPECTIVELY 02820002 NAMEPTR EQU 9 POINTS TO NAME TO CHECK A28552 02840002 * INDEX LENGTH , ALPHA 1ST A28552 02860002 * AND ALPHAMERIC CHARACTERS A28552 02880002 RB2 EQU 10 SECONDARY BASE REGISTER S21046 02900002 OFFSET1K EQU 4095 OFFSET FOR BASE REG 2 S21046 02920002 KPLUS2 EQU 4097 2ND BASE OFFSET FROM IEHESCAN S21046 02940002 QUOTECHR EQU X'7D' QUOTE CHARACTER S21046 02960002 TWO EQU 2 CONSTANT 2 S21046 02980002 OFFSET2 EQU 4097 OFFSET 2 FOR BASE REG 2 S21046 03000002 DSECTSZE EQU 2695 HALF DSECT SIZE FOR GETMAIN M2838 03020002 MULTPBY2 EQU 1 SHIFT TO MULT BY 2 S21046 03040002 ONEBYTE EQU 1 ONE BYTE S21046 03060002 CNTTOTAL EQU 6 TOTAL COUNT FOR ALL WTOR'S S21046 03080002 CNT1PAS EQU 3 TOTAL WTOR'S ALLOWED FOR PSWD S21046 03100002 SIXTEEN EQU 16 RETURN CODE OF 16 COMPARE S21046 03120002 INCRMNT1 EQU 1 INCREMENT OF 1 S21046 03140002 MOVE55 EQU 55 BLANK OUT MESSAGE AFTER PARM S21046 03160002 * ERROR MESSAGE PRINTED S21046 03180002 PRORTNCD EQU X'FF' MASK TO SHOW PROTECT RETURN S21046 03200002 NUMFLD EQU X'F0' F FIELD OF EBCDIC NUMERALS S21046 03220002 TWELVE EQU X'12' RETURN CODE OF 12 S21046 03240002 ZERORTN EQU 0 ZERO RETURN CODE S21046 03260002 PRNTBIT EQU X'80' MASK TO TEST PRINT OR NOPRINT S21046 03280002 CVOLBIT EQU X'08' TURN ON THE CVOL BIT S21046 03300002 CVOLOFF EQU X'F7' TURN OFF THE CVOL BIT S21046 03320002 SKIP3 EQU 49 FORCE THREE SPACES S21046 03340002 BLANKBYT EQU X'40' BLANK CHAR IN HEX S21046 03360002 SEVEN EQU 7 CONSTANT OF 7 S21046 03380002 ONEWORD EQU 4 FOUR BYTE CONSTANT S21046 03400002 ZEROBYTE EQU 0 CONSTANT OF 0 S21046 03420002 MNTVOL EQU X'40' IEHESW2 MASK TO CAUSE VOL MNT S21046 03440002 VOLMNT EQU X'01' IEHEMAC1 VOL MOUNT S21046 03460002 EIGHT EQU 8 CONSTANT OF 8 S21046 03480002 PSWD1MSK EQU X'20' PPARMSW MASK FOR PASWORD1 S21046 03500002 PSWD1DUP EQU X'20' DUP MASK TEST FOR PASWORD1 S21046 03520002 PSWD1PRM EQU 8 DISPLACEMENT FOR PASWORD1 S21046 03540002 PSWD2MSK EQU X'40' PPARMSW MASK FOR PASWORD2 S21046 03560002 PSWD2DUP EQU X'04' DUP MASK TEST FOR PASWORD2 S21046 03580002 PSWD2PRM EQU 21 DISPLACEMENT FOR PASWORD2 S21046 03600002 CPSWDMSK EQU X'04' PPARMSW MASK FOR CPASWORD S21046 03620002 CPSWDDUP EQU X'10' DUP MASK TEST FOR CPASWORD S21046 03640002 CODE4 EQU 4 RETURN CODE OF 4 S21046 03660002 MSG67 EQU 67 PRINT PARM ERROR MESSAGE S21046 03680002 MSGPRINT EQU X'02' CHECK FOR PARMFIELD ERROR S21046 03700002 CPSWDPRM EQU 12 DISPLACEMENT FOR CPASWORD S21046 03720002 TYPEMSK EQU X'10' PPARAMSW MASK FOR TYPE S21046 03740002 TYPEDUP EQU X'08' DUP MASK TEST FOR TYPE S21046 03760002 TYPEPRM EQU 20 DISPLACEMENT FOR TYPE S21046 03780002 UCBADDR EQU X'02' ARG LENGTH OF UCB ADDRESS A35899 03800002 TYPECODE EQU X'03' HIGHEST TYPE CODE PERMISSIBLE S21046 03820002 DATAMSK EQU X'08' PPARMSW MASK FOR DATA S21046 03840002 DATADUP EQU X'02' DUP MASK TEST FOR DATA S21046 03860002 DATAPRM EQU 24 DISPLACEMENT FOR DATA S21046 03880002 THREEBYT EQU 3 3 BYTE DISPLACEMENT S21046 03900002 ZERODSP EQU 0 DISPLACEMENT OF 0 S21046 03920002 DROPZONE EQU X'0F' MASK TO DROP ZONE S21046 03940002 HALFWD EQU 2 ONE HALF WORD S21046 03960002 QUOTEMSK EQU X'01' CODE FOR QUOTE FROM SCAN S21046 03980002 ONEQUOTE EQU X'20' ONE QUOTE HAS BEEN FOUND S21046 04000002 LNGTHCHK EQU X'07' LENGTH COMPARE S21046 04020002 MULTBY4 EQU 2 SHIFT TO MULT BY 4 S21046 04040002 VOLPRM EQU 16 DISPLACEMENT FOR VOL S21046 04060002 SIX EQU 6 CONSTANT OF 6 S21046 04080002 NINETEEN EQU 19 ZERO OUT PARAMETER LIST S21046 04100002 DATALGTH EQU 76 MAX LENGTH OF DATA FIELD S21046 04120002 RB EQU 11 THIRTEEN POINTS TO A REGISTER 04140002 RBD EQU 12 04160002 SAVEREG EQU 13 SAVE AREA 04180002 RETURN EQU 14 04200002 LINKREG EQU 15 FIFTEEN AND FOURTEEN ARE LINK 04220002 PARAMREG EQU 0 AND RETURN REGISTERS RESPECTIVELY 04240002 LISTREG EQU 1 ----------------------------------------- 04260002 * 04280002 * ***** SWITCH USAGE ***** 04300002 NDSWMSK EQU 128 END SWITCH BIT POS ZERO SWITCH 1 04320002 COMMENTS EQU 64 04340002 CONTINUE EQU 32 04360002 FIRSTONE EQU 16 04380002 BIGSHIFT EQU 8 04400002 SHIFTLOC EQU 4 04420002 VOLSW EQU 2 04440002 CLEAROUT EQU 253 AFFECTS THE 7TH BIT OF A23466 04460002 * MOUNTSW A23466 04480002 ERRSW EQU 2 USED TO TEST FOR ERROR A23466 04500002 * IN CONTINUATION A23466 04520002 ERRSW2 EQU 4 USED TO TEST FOR ERROR A24020 04540002 * ENCOUNTERED IN NAME FIELD A24020 04560002 CLEARSW EQU 251 AFFECTS THE 6TH BIT OF A24020 04580002 * MOUNTSW A24020 04600002 COMMENCE SAVE (14,8),T,MODIFY THIS SAVE DOES NOT INCLUDE R9 04620002 STM 10,12,60(13) SAVE R 10 THRU R 12 04640002 BALR RB,0 04660002 USING *,RB S21046 04680002 USING *+OFFSET1K,RB2 S21046 04700002 LA RB2,OFFSET1K(RB) SET UP BASE REG DISPLACEMENT S21046 04720002 B IEHEREAD 04740002 IEHESCAN BALR RB,0 04760002 USING *,RB S21046 04780002 USING *+OFFSET1K,RB2 S21046 04800002 LA RB2,OFFSET1K(RB) SET UP BASE REG DISPLACEMENT S21046 04820002 USING IEHECHAR,R1 04840002 * 04860002 TM IEHESW1,NDSWMSK TEST FOR END OF PARAMETERS 04880002 BZ NOTEND 04900002 OI IEHESW1,COMMENTS TURN ON THE COMMENTS SWITCH 04920002 TM IEHESW1,CONTINUE CONTINUE CARDS PRESENT 04940002 BZ GETMORE YES BRANCH 04960002 ENDCALL L R2,IEHECALL GET ADDRESS OF CALLING SEQUENCE 04980002 CLI VOLPAREN+1,X'00' IF PAREN COUNT IS ZERO 05000002 BCR 8,2 GO HONOR THE REQUEST 05020002 MVI VOLPAREN+1,X'00' OTHERWISE GO TO 05040002 B BADSYN THE ERROR ROUTINE 05060002 NOTEND LM R2,R3,IEHESTT AREA TO BE SCANNED DEFINED BY 05080002 SR R5,R5 THE ADDRESSES IN REGISTERS TWO,THREE 05100002 ST RETURN,SCANRET SAVE RETURN ADDRESS 05120002 LR R4,R5 CLEAR REG 4 05140002 CR R2,R3 05160002 BH DOWNLNTH-2 05180002 IC R4,IEHECOND LOAD MASK FOR THE BRANCH CONDITION 05200002 LA R6,MIDDLE 05220002 CR R2,R6 TEST IF WE ARE SCANNING THE READ IN ARED 05240002 BNH COMPAGN BRANCH IF WE ARE NOT 05260002 TM IEHESW1,CONTINUE+SHIFTLOC CAN WE SHIFT 05280002 BNE COMPAGN NO BRANCH 05300002 TM IEHESW1,BIGSHIFT TEST FOR A LONG SHIFT 05320002 BZ LONGONE 05340002 MVC INPUT+15(57),MIDDLE TAKE A SHORT SHIFT 05360002 LA R6,56 05380002 SR R2,R6 RESET THE START ADDRESS 05400002 ST R2,IEHESTT 05420002 B GETMORE 05440002 LONGONE OI IEHESW1,BIGSHIFT TURN OFF THE BIG SHIFT SWITCH 05460002 MVC INPUT(72),READTOO 05480002 LA R6,72 05500002 SR R2,R6 05520002 ST R2,IEHESTT 05540002 B GETMORE 05560002 COMPAGN EQU * A25564 05580002 L RETURN,SCANRET RESTORE THE RETURN ADDRESSA25564 05600002 TRYAGAIN EQU * A25564 05620002 LTR R2,R2 IF REG 2 IS ZERO A42333 05640002 BZ BADSYN INVALID SYNTAX A42333 05660002 CLC 0(1,R2),IEHECHAR CHARACTER BEING SCANNED A25564 05680002 * FOR IS COMPARED TO A A25564 05700002 * CHARACTER IN THE AREA A25564 05720002 * BEING SCANNED A25564 05740002 NOP CKBLANK SCAN IS TERMINATED IF THE 05760002 EX R4,*-4 CONDITION SPECIFIED IS MET 05780002 ENTAGN LA R5,1(R5) 05800002 LA R2,1(R2) UPDATE POINTER TO SCAN AREA 05820002 CR R2,R3 COMPARE START TO STOP ADDRESS 05840002 BNH TRYAGAIN NO FIND--THEN LOOK AGAIN A25564 05860002 * 05880002 * ARRIVING HERE MEANS NO FIND 05900002 * IN THE AREA THAT WAS SCANNED 05920002 * THE POINTER TO THE FOUND 05940002 * CHARACTER IS SET TO ZERO 05960002 SR R2,R2 05980002 * ***LENGTH OF SCAN AND FOUND 06000002 DOWNLNTH BCTR R5,0 ***ADDRESS STORED IN SCANLIST 06020002 STC R5,IEHEARGL STORE LENGTH 06040002 ST R2,IEHEFND STORE ADDRESS 06060002 * 06080002 * CHECK TO SEE IF THERE WAS A FIND 06100002 * BY TESTING THE 'FOUND'ADDRESS 06120002 LTR R2,R2 FOR A NOT ZERO 06140002 BNE GETCODE 06160002 STC R2,IEHECODE NOFIND- ZERO THE CODE IN SCANLIST 06180002 ST R2,IEHEFUN ZERO THE FUNCTION ADDRESS 06200002 BR RETURN SCRAMETH BACK. 06220002 * 06240002 * AT THIS POINT SCAN HAS STOPED FOR 06260002 * A FIND CONDITION. AND WE WILL PLACE 06280002 * A CODE INTO SCANLIST DESCRIBING THE 06300002 * CHARACTER FOUND AS FOLLOWS 06320002 * 06340002 * TYPE OF CHARACTER CODE 06360002 * . 1 06380002 * , 2 06400002 * = 3 06420002 * ( 4 06440002 * ) 5 06460002 * BLANK 6 06480002 * ALL OTHERS 0 06500002 * 06520002 * 06540002 * 06560002 GETCODE LA R3,CODELIST+5 CHARACTER THAT STOPED THE SCAN 06580002 LA R4,6 IS COMPARED TO A CHARACTER 06600002 NEXTCODE CLC 0(1,R2),0(R3) IN THE CODELIST. 06620002 BE PUTCODE 06640002 BCTR R3,0 GET NEXT CHARACTER 06660002 BCT R4,NEXTCODE CHECK FOR LAST AND MODIFY CODE 06680002 CLC NOTBLANK(2),IEHECHAR 06700002 BE PUTCODE 06720002 LM 2,5,MARESAR RESTORE THE REGISTERS 06740002 B ENTAGN AND SCAN SOME MORE 06760002 CHKBLNK BCTR R2,0 BACK UP PTM1623 06780002 CLI 0(R2),X'4B' CHECK FOR PERIOD PTM1623 06800002 LA R2,1(R2) PTM1623 06820002 BE BADSYN BRANCH ON YES PTM1623 06840002 B CONSCAN PTM1623 06860002 PUTCODE STC R4,IEHECODE PUT CODE INTO SCANLIST 06880002 * 06900002 * 06920002 * AT THIS POINT SCAN IS COMPLETE 06940002 * AND THE FOUND ADDRESS,LENGTH OF 06960002 * THE SCAN, AND CODE HAVE BEEN 06980002 * PLACED INTO THE SCANLIST 07000002 * NOW WE WILL TEST THE TLU SW. 07020002 CLI IEHECODE,X'06' WAS DELIMITER A BLANK PTM1623 07040002 BE CHKBLNK BRANCH ON YES PTM1623 07060002 CLI IEHECODE,X'02' CHECK FOR COMMA PTM1623 07080002 BE CHKBLNK BRANCH ON YES PTM1623 07100002 CONSCAN L R2,IEHETBL PTM1623 07120002 LTR R2,R2 07140002 BCR 8,RETURN RETURN IF NO TLU IS REQUESTED 07160002 * 07180002 * A TLU IS REQUIRED. WE WILL 07200002 * NOW SELECT THE ADDRESS OF THE 07220002 * PROPER TABLE TO BE SEARCHED 07240002 * BY USING THE LENGTH IN SCANLIST 07260002 * 07280002 SPTABAD CLI IEHEARGL,X'08' TESTING FOR MAX AND MIN VALUES 07300002 BH NOTABLE OF ARGUMENT LENGTH TO INSURE 07320002 CLI IEHEARGL,X'01' COMPATIBILITY WITH OUR TABLES 07340002 BNH NOTABLE BRANCH IF NOT COMPATIBLE 07360002 SR R2,R2 07380002 IC R2,IEHEARGL PUT LENGTH INTO REG. 07400002 SLA R2,2 MULTIPLY BY FOUR 07420002 LA R2,TABLEADS(R2) ADD TO TABLE ADDRESS 07440002 MVC IEHETBL(4),0(R2) PUT TABLE ADDRESS INTO SCANLIST 07460002 B IEHETLU GO TO TABLE LOOK UP ROUTINE 07480002 NOTABLE SR R2,R2 ARGUMENT LENGTH IS ZERO 07500002 ST R2,IEHEFUN ZERO THE FUNCTION 07520002 BR RETURN RETURN 07540002 CKBLANK CLI 0(R2),C' ' SEE IF A BLANK STORE THE SCAN 07560002 STM 2,5,MARESAR 07580002 BNE DOWNLNTH IF NOT; FORGET IT 07600002 LTR R5,R5 * CHECK LENGTH OF 07620002 BZ ZEROLNTH * SCAN FOR ZERO 07640002 OI IEHESW1,NDSWMSK NOT ZERO TURN ON END SWITCH 07660002 B DOWNLNTH 07680002 * 07700002 * SCAN HAS STOPED FOR A BLANK 07720002 * LENGTH OF SCAN WAS ZERO 07740002 * CHECK FOR ') ' OR ', ' 07760002 * 07780002 ZEROLNTH LR R6,R2 GET ADDRESS OF PRECEEDING CHARACTER 07800002 BCTR R6,0 BY DECREASING FOUND ADDRESS BY ONE 07820002 CLI 0(R6),C',' CHECK FOR COMMA 07840002 BE SKIPCARD 07860002 CLI 0(R6),C')' CHECK FOR RIGHT PARENTHESIS 07880002 BE ENDCALL IF EQUAL GO GET THE MACRO REQUIRED 07900002 CLI 0(R6),QUOTECHR CHECK FOR QUOTE S21046 07920002 BE ENDCALL IF EQUAL GET THE MACRO REQUIRE S21046 07940002 LA PARAMREG,1 07960002 L LINKREG,SEVER8 GO TO CONDITION A25564 07980002 BALR RETURN,LINKREG CODE HANDLER A25564 08000002 B GOAGAIN 08020002 * 08040002 SKIPCARD LA R6,MIDDLE -------------------------- 08060002 ST R6,IEHESTT SKIP OVER COMMENTS IN THIS 08080002 CR R6,R2 CARD... IF THIS IS LAST 08100002 BH NOTEND CARD GGO CALL THE MACRO 08120002 B BADSYN HAVE FOUND ', ' WITH NO CONTIN PUNCH 10859 08140002 * 08160002 * 08180002 * 08200002 * 08220002 * ***** USE OF REGISTERS FOR TLU ***** 08240002 * 08260002 * REGISTER NO. CONTENTS. 08280002 * 2 ADDRESS OF SEARCH ARG 08300002 * 3 LENGTH -1 OF THE ARG 08320002 * 4 ADDRESS OF THE TABLE ARG 08340002 * 5 NUMBER OF ELEMENTS 08360002 * 6 LENGTH OF ELEMENTS 08380002 * 7--10 VARIOUS WORK 08400002 * 08420002 * 08440002 * 08460002 IEHETLU L R2,IEHESTT 08480002 L R4,IEHETBL 08500002 SR R3,R3 08520002 LR R5,R3 SET UP REGISTERS 08540002 LR R6,R3 AS SPECIFIED 08560002 IC R3,IEHEARGL ABOVE 08580002 IC R5,0(R4) 08600002 IC R6,1(R4) 08620002 LA R4,2(R4) 08640002 * 08660002 * COMPARISON OF ARGUMENTS MADE BY 08680002 * EXECUTE 'CLC' TO USE THE 08700002 * LENGTH IS REG 3 08720002 * 08740002 * 08760002 EXCLC EX R3,TLUCLC COMPARE ARGUMENTS 08780002 BE ARGFOUND BRANCH ON FIND 08800002 BCT R5,ARG DECREASE ARG COUNT --EXIT IF ZERO 08820002 ST R5,IEHEFUN STORE ZEROS FOR NO FIND 08840002 BR RETURN 08860002 ARG AR R4,R6 GET NEXT TABLE ARGUMENT. 08880002 B EXCLC REPEAT 08900002 ARGFOUND LA R4,1(R4,R3) FUNCTION ADDRESS =ARG LENTH + 1 08920002 ST R4,IEHEFUN +TABLE POINTER, STORE IT 08940002 BR RETURN 08960002 TLUCLC CLC 0(1,R2),0(R4) 08980002 GOAGAIN ST PARAMREG,IEHESPC SAVE MESSAGE NUMBER 09000002 OI IEHESW1,NDSWMSK SET END SW. ON 09020002 LA R2,GORETURN 09040002 ST R2,IEHECALL GIVE SCAN A WAY BACK 09060002 BALR RETURN,RB READ ANY COMMENTS CARDS 09080002 GORETURN L PARAMREG,IEHESPC 09100002 L LINKREG,MSGRTNAD GO WRITE THE SAVED MESSAGE 09120002 BALR RETURN,LINKREG 09140002 B STTRESET 09160002 IEHPROG8 BR RETURN RETURN TO CALLING POINT M2838 09180002 ENTRY IEHPROG8 M2838 09200002 IEHEREAD BALR RB,0 -------------------- 09220002 USING *,RB S21046 09240002 USING *+OFFSET1K,RB2 S21046 09260002 LA RB2,OFFSET1K(RB) SET UP BASE REG DISPLACEMENT S21046 09280002 L RB,SCANBASE 09300002 LA RB2,OFFSET1K(RB) SET UP BASE REG DISPLACEMENT S21046 09320002 USING IEHESCAN+TWO,RB S21046 09340002 USING IEHESCAN+OFFSET2,RB2 S21046 09360002 LA ZERO,DSECTSZE SET UP REG 0 TO GET S21046 09380002 SLL ZERO,MULTPBY2 5390 BYTES OF MAIN STORAGE M2838 09400002 GETMAIN R,LV=(0) 8429 09420002 LR RBD,LISTREG 09440002 USING IEHECHAR,RBD 09460002 ST R9,DECB2 SAVE ADDRESS OF THE VCONS 09480002 LOAD EP=DEVNAMET LOAD DEVICE NAME TABLE I276 09500002 ST ZERO,TABLEAD SAVE ADDRESS OF TABLE I276 09520002 L 0,20(R9) GET ADDRESS OF IEHRET01 09540002 ST 0,DECB2+4 SAVE IT 09560002 L LISTREG,24(13) RESTORE REG 1 09580002 ST 13,IEHESAT SAVE 13 09600002 XC MOUNTSW(1),MOUNTSW CLEAR MOUNTSW A23466 09620002 XC IEHESW2(ONEBYTE),IEHESW2 ZERO IEHESW2 S21046 09640002 LA R3,CNTTOTAL LOAD DECREMENT FOR TOTAL WTOR S21046 09660002 STC R3,TOTALPS STORE DECREMENT FOR TOTAL WTOR S21046 09680002 ST SAVEREG,MARESAR+4 SAVE OLD SAVE AREA LOCATION M2838 09700002 LA 13,MARESAR POINT AT NEW SAVE AREA 09720002 L LINKREG,INVOCRTN GO TO THE 09740002 BALR RETURN,LINKREG INVOKE ROUTINE 09760002 * 09780002 * ----- AT THIS POINT ----- 09800002 * CONTROL HAS JUST PASSED TO 'IEHINVOC' A ROUTIN USED TO 09820002 * SCAN THE PARAMETER LIST THAT THE PROGRAM RECEIVES UPON 09840002 * INVOCATION. UPON RETURN THERE WILL BE A DCB OPENED FOR 09860002 * INPUT AT 'UTINDCB' AND A DCB OPEN FOR OUTPUT AT 'UTOUTDCB' 09880002 * SWITCHES WILL BE SET AT 'IEHESAT' TO INDICATE WHETHER OR 09900002 * NOT A LIST OF DDNAMES WAS PASSED AND WHETHER OR NOT IT 09920002 * INCLUDED REPLACEMENT NAMES FOR SYSIN AND SYSPRINT. 09940002 * THIS INFORMATION WILL BE USED LATER BY THE VOLUME MOUNTING 09960002 * ROUTINE TO INSURE THAT REQUIRED VOLUMES ARE NOT DISMOUNTED 09980002 * 10000002 * 10020002 TM UTOUTDCB+48,X'10' TEST IF SYSPRINT IS OPEN 8687 10040002 BO TESTFLG YES IT IS OPEN BS0H 10060002 OI DFLG,X'01' YA01678 10066002 B ERCLOS2 YA01678 10072002 CODERTN LA LINKREG,16 RETURN CODE OF 16 BS0H 10080002 STC LINKREG,ERRFLD+2 SAVE RETURN CODE 8687 10100002 B FREEMAIN QUIT 8687 10120002 TESTFLG TM DFLG,X'10' CHECK FOR BLKSIZE ERROR BS0H 10140002 BO ERCLOS2 YES BRANCH YA01678 10160002 TESTIN TM UTINDCB+48,X'10' TEST IF SYSIN IS OPEN BS0H 10200002 BO TESTFLAG YES IT IS OPEN BS0H 10220002 LA PARAMREG,56 BS0H 10240002 ERMESG MVI MSGOUT,C' ' CLEAR MESSAGE AREA BS0H 10260002 MVC MSGOUT+1(119),MSGOUT BS0H 10280002 L LINKREG,MSGRTNAD BS0H 10300002 ERCLOS1 TM DFLG,X'01' YA01678 10320002 BO CODERTN YA01678 10326002 LA R5,CLOSE YA01678 10332002 LA R2,UTOUTDCB BS0H 10360002 BALR R4,R5 GO TO CLOSE ROUTINE BS0H 10380002 B CODERTN SET ERROR CODE BS0H 10400002 ERCLOS2 TM UTINDCB+48,X'10' TEST IF SYSIN OPEN YA01678 10405002 BO ERCLOS3 YES YA01678 10410002 B ERCLOS1 NO YA01678 10415002 TESTFLAG TM DFLAG,X'10' BS0H 10420002 BC 8,MESSAGE PUT OUT HEADER BS0H 10440002 ERCLOS3 LA R5,CLOSE YA01678 10440102 LA R2,UTINDCB BS0H 10480002 BALR R4,R5 CLOSE SYSIN DCB BS0H 10500002 TM DFLG,X'11' TEST IF BLKSIZE ERROR YA01678 10506002 BNZ ERCLOS1 YES GO TO SYSPRINT CLOSE YA01678 10512002 LA PARAMREG,55 WRITE ERROR MESSAGE -- BS0H 10520002 B ERMESG INVALID BLOCKSIZE BS0H 10540002 MESSAGE MVI MSGOUT,C' ' CLEAR MESSAGE OUTPUT AREA 8687 10560002 MVC MSGOUT+1(119),MSGOUT 10580002 LA PARAMREG,48 10600002 L LINKREG,MSGRTNAD SKIP TO ONE 10620002 BALR RETURN,LINKREG AND WRITE A HEADER 10640002 XC ERRFLD(8),ERRFLD RESET ERROR RETURN CODES 10660002 TM IEHESW2,MSGPRINT IS PARM ERROR MSG TO BE PRINT S21046 10680002 BC 1,PARMERR IF YES GO PRINT IT S21046 10700002 B STARTAGN 10720002 * S21046 10740002 * AN ERROR WAS ENCOUNTERED IN THE PARM FIELD OF THE S21046 10760002 * EXEC CARD , PRINT MESSAGE 67 AND SET A RETURN CODE OF 4 S21046 10780002 * S21046 10800002 PARMERR EQU * PRINT PARM ERROR MESSAGE S21046 10820002 LA PARAMREG,MSG67 MESSAGE 67 S21046 10840002 L LINKREG,MSGRTNAD ADDRESS OF MESSAGE ROUTINE S21046 10860002 BALR RETURN,LINKREG GO TO MESSAGE ROUTINE S21046 10880002 MVI ERRFLD+TWO,CODE4 SET RETURN CODE OF 4 S21046 10900002 MVI MSGOUT,BLANK BLANK OUT THE MESSAGE AREA S21046 10920002 MVC MSGOUT+INCRMNT1(MOVE55),MSGOUT S21046 10940002 LA PARAMREG,SKIP3 FORCE THREE SPACES S21046 10960002 L LINKREG,MSGRTNAD ADDR OF MESSAGE ROUTINE S21046 10980002 BALR RETURN,LINKREG GO SPACE THREE LINES S21046 11000002 B STARTAGN BEGIN ANEW S21046 11020002 IEHPROG9 EQU * M2838 11040002 ENTRY IEHPROG9 M2838 11060002 BALR 15,0 11080002 USING *,15 11100002 DROP RB2 DON'T WANT RB2 USED AS BASE S21046 11120002 * REG ON THE LOAD OF SCANBASE S21046 11140002 L RB,SCANBASE RESET OUR BASE REGISTR 11160002 LA RB2,OFFSET1K(RB) SET UP BASE REG DISPLACEMENT S21046 11180002 L 15,DECB2 11200002 L 15,20(15) 11220002 ST 15,DECB2+4 STORE RETURN ADDRESS 11240002 DROP 15 11260002 USING IEHESCAN+OFFSET2,RB2 S21046 11280002 CLI ERRFLD+TWO,SIXTEEN IS RETURN CODE 16 S21046 11300002 BE IEHPROGD YES BRANCH TO SYSIN END M2838 11320002 STTRESET LA PARAMREG,49 FORCE A TRIPLE SPACE 11340002 L LINKREG,MSGRTNAD EXIT TO THE 11360002 BALR RETURN,LINKREG MESSAGE WRITER 11380002 CLI ERRFLD,PRORTNCD IS THIS RETURN FOR PROTECT S21046 11400002 BE PRORETRN YES BRANCH S21046 11420002 OC ERRFLD+1(1),ERRFLD POST THE RETURN CODE 11440002 BZ STARTAGN NO ERROR--RESET SWITCHES A25564 11460002 CLI ERRFLD,X'12' WAS IO ERROR ENCOUNTERED A25564 11480002 BNE SVCERROR NO, GO POST ERROR FOR SVC A25564 11500002 SVR12 L LINKREG,SEVER12 GO TO CONDITION CODE S21046 11520002 BALR RETURN,LINKREG HANDLER A25564 11540002 B STARTAGN GO TO CLEAR SWITCHES A25564 11560002 PRORETRN CLI ERRFLD+ONEBYTE,TWELVE IS RETURN I/O ERROR S21046 11580002 BE SVR12 YES GO TO SEVERITY 12 RETURN S21046 11600002 CLI ERRFLD+ONEBYTE,ZERORTN IS RETURN CODE 0 S21046 11620002 BE STARTAGN YES THEN START AGAIN S21046 11640002 B SVCERROR POST RETURN FOR SEVERITY 8 S21046 11660002 SVCERROR EQU * A25564 11680002 L LINKREG,SEVER8 GO TO CONDITION CODE A25564 11700002 BALR RETURN,LINKREG HANDLER TO POST CODE OF 8 A25564 11720002 STARTAGN XC IEHECHAR(DECB1-IEHECHAR),IEHECHAR CLEAR SWITCHES 11740002 XC VOLISTAD(IEHERSAV-VOLISTAD),VOLISTAD AND WORK AREA 11760002 XC ERRFLD(2),ERRFLD CLEAR 1ST TWO BYTES OF A25564 11780002 * ERRFLD A25564 11800002 MVC CODELIST(8),SPECIALS RESET SPECIAL CHARACTERS 9660 11820002 NI IEHESW2,PRNTBIT INITIALIZE IEHESW2 S21046 11840002 * 11860002 * THE MACRO PARAMETER LIST IS PARTIALLY CONSTRUCTED 11880002 * HERE BY STORING INTO IT THE ADDRESSES THAT WILL 11900002 * EVENTUALLY CONTAIN THE PARAMETERS THAT THE MACRO 11920002 * REQUIRES FOR PROPER OPERATION 11940002 * 11960002 LA R2,PARAM2 11980002 LA R3,PARAM3 12000002 LA R4,PARAM4 12020002 STM R2,R4,IEHEMAC1+4 12040002 LA SAVEREG,MARESAR 12060002 GETMORE GET UTINDCB,READTOO 12080002 TM IEHESW2,PRNTBIT ARE WE TO PRINT CONTROL CARDS S21046 12100002 BC 8,CHECKPRT NO THEN BRANCH S21046 12120002 MVC MSGOUT(80),READTOO 12140002 SR ZERO,ZERO GO TO MSG WRITER 12160002 L LINKREG,MSGRTNAD WITH A REQUEST TO WRITE 12180002 BALR RETURN,LINKREG FROM THE OUTPUT AREA 12200002 CHECKPRT CLC READTOO(TWO),SLASHAST CHECK INPUT STREAM FOR S21046 12220002 BNE *+10 A '/*' IN COLUMN 1 AND 2 12240002 L LINKREG,UTINDCB+32 EXIT ON A FIND 12260002 BR LINKREG 12280002 CLI COL72,BLANK CHECK IF CONTINUE CARD 12300002 BC 7,TURNSW BRANCH IF CONTINUATION IS A23466 12320002 * EXPECTED A23466 12340002 OI IEHESW1,CONTINUE END OF CONTINUE CARDS SET BIT 2 SW 1 12360002 NI MOUNTSW,CLEAROUT TURN ERROR SWITCH A23466 12380002 * INDICATOR OFF A23466 12400002 BC 15,COMMENT BRANCH TO TEST FOR COMMENTA23466 12420002 * IS ON A23466 12440002 TURNSW EQU * A23466 12460002 OI MOUNTSW,X'02' TURN ERROR SWITCH A23466 12480002 * INDICATOR ON A23466 12500002 COMMENT EQU * A23466 12520002 TM IEHESW1,COMMENTS TEST IF COMMENT SWITCH A23466 12540002 BZ CARDONE 12560002 TM IEHESW1,CONTINUE CHECK IF CONTINUE CARD 12580002 BZ GETMORE BRANCH IF A COMMENT AND CONTINUE CARD 12600002 TM IEHESW1,NDSWMSK TEST FOR END OF SCAN 12620002 BO ENDCALL BRANCH IF END 12640002 B COMPAGN GO BACK TO THE SCAN ROUTINE 12660002 CHECK16 CLI COL16,BLANK TEST IF COL 16 IS BLANK 12680002 BNE *+8 BRANCH IF IT IS NOT 12700002 OI IEHESW1,COMMENTS TURN ON THE COMMENTS SWITCH 12720002 MVC MIDDLE(57),COL16 BUTT THIS CARD TO PREVIOUS CARD 12740002 B COMPAGN GO BACK TO THE SCAN ROUTINE 12760002 CARDONE TM IEHESW1,FIRSTONE TEST IF THIS IS FIRST CARD 12780002 BNE CHECK16 BRANCH IF IT IS NOT 12800002 OI IEHESW1,FIRSTONE TURN OFF THE FIRST CARD SW. 12820002 LA R2,READTOO 12840002 LA R3,71(R2) 12860002 STM R2,R3,IEHESTIN STORE STT AND STP FOR SCAN 12880002 B FNDECODE 12900002 ENDATA DC F'0' 12920002 * THIS ROUTINE SCANS OFF A KEYWORD OR AN OPTION, 12940002 * PERFORMS A TABLE LOOK UP ON THE FIELD SCANNED 12960002 * OUT, AND FROM THE TABLE SELECTS THE ADDRESS 12980002 * OF A ROUTINE TO WHICH IT THEN PASSES CONTROL 13000002 KODECODE BALR RB,0 13020002 USING *,RB S21046 13040002 USING *+OFFSET1K,RB2 S21046 13060002 LA RB2,OFFSET1K(RB) SET UP BASE REG DISPLACEMENT S21046 13080002 L RB,SCANBASE 13100002 LA RB2,OFFSET1K(RB) SET UP BASE REG DISPLACEMENT S21046 13120002 USING IEHESCAN+TWO,RB S21046 13140002 USING IEHESCAN+OFFSET2,RB2 S21046 13160002 MVC IEHECHAR(2),ANYSPEC STOP ON ANY SPECIAL CHARACTER 13180002 MVI IEHETBL,X'F0' REQUEST A TLU. 13200002 BALR RETURN,RB ROUTINE 13220002 NI IEHEARGL,X'07' 13240002 LM R2,R3,0(RBD) PLACE THE KEYWORD 13260002 STC R2,KWSA AND ITS LENGTH 13280002 EX R2,MOVEKEY INTO KEYWORD SAVE AREA 13300002 L R7,IEHEFUN ADDRESS OF FUNCTION TO REG 7 13320002 LTR R7,R7 TEST FOR A FIND IN THE TLU 13340002 BZ BADSYN BRANCH IF NO FIND 13360002 SR R8,R8 13380002 IC R8,IEHECODE GET THE DELIMITER CODE 13400002 SLL R8,2 4 TIMES THE CODE FOR INDEXING 13420002 EX 0,DOSMTHIN(R8) 13440002 BNE BADSYN BRANCH IF ERROR IN STATEMENT SYNTAX 13460002 * IF WE HAVE NOT BRANCHED AS A RESULT OF THE 13480002 * PREVIOUS EXECUTE AND BNE INSTRUCTIONS THEN IT IS 13500002 * ESTABLISHED THAT A COMMA OR BLANK DELIMITED A VALID 13520002 * OPTION. OR A AN EQUAL SIGN DELIMITED A VALID KEYWORD 13540002 * WE WILL THERFORE SELECT THE ADDRESS OF THE ROUTINE 13560002 * WHICH HANDLES THIS KEYWORD OR OPTION AND GO TO IT. 13580002 * FIRST WE MUST UPDATE THE START ADDRESS FOR SCAN. 13600002 L R4,IEHEFND 13620002 LA R4,1(R4) UPDATE THE START 13640002 ST R4,IEHESTT ADDRESS FOR SCAN 13660002 SPACE 2 13680002 MVC FULLWORD(4),2(R7) ALLIGN THE REQUIRED ADDRESS 13700002 L R4,FULLWORD PUT IT IN A REGISTER 13720002 BR R4 GO THERE 13740002 MOVEKEY MVC KWSA+1(1),0(R3) 13760002 BADSYN EQU * A25564 13780002 L LINKREG,SEVER8 GO TO CONDITION CODE A25564 13800002 BALR RETURN,LINKREG HANDLER A25564 13820002 LA PARAMREG,3 PUT MSG# INTO REGISTER A25564 13840002 B GOAGAIN 13860002 DOSMTHIN B BADSYN 13880002 B BADSYN ONE OF THESE INSTRUCTIONS IS 13900002 CLI 0(R7),X'02' EXECUTED TO PROVIDE A CHECK 13920002 CLI 0(R7),X'01' ON CONTROL CARD SYNTAX WHICH 13940002 B BADSYN ONE IS DETERMINED BY THE DELIMITER 13960002 B BADSYN FOUND BY THE LAST SCAN. 13980002 CLI 0(R7),X'02' 14000002 SPACE 2 14020002 **** **** FUNCTION NAME DECODING **** **** **** 14040002 SPACE 2 14060002 * THE PURPOSE OF THIS ROUTINE IS TO OBTAIN THE ADDRESS OF 14080002 * ANOTHER ROUTINE WHICH WILL BE USED LATER TO CALL THE MACRO 14100002 * WHICH WILL PROVIDE THE REQUESTED FUNCTION. 14120002 SPACE 1 14140002 * TO THIS END IT WILL TEST CONTROL STATEMENT FOR THE 14160002 * PRESENCE OF A NAME FIELD. IF ONE IS PRESENT IT WILL A24020 14180002 * SCAN OVER IT FOR SYNTAX ERRORS. BLANKS PRECEEDING THE A24020 14200002 * OPERAND FIELD WILL BE SKIPPED. THE ROUTINE WILL THEN A24020 14220002 * SCAN OUT THE FUNCTIONS NAME, PERFORM A TABLE LOOK UP A24020 14240002 * WITH IT AND MOVE THE ASSOCIATED ADDRESS TO A KNOWN A24020 14260002 * LOCATION FOR FUTURE REFERENCE. A24020 14280002 FNDECODE LA R3,IEHESTIN START AND STOP ADDRESSES 14300002 LM R3,R4,0(R3) ARE PLACED IN THE 14320002 STM R3,R4,IEHESTT SCANLIST 14340002 MVI CCNAME,BLANKBYT BLANK OUT CCNAME IN DSECT S21046 14360002 MVC CCNAME+ONEBYTE(SEVEN),CCNAME S21046 14380002 CLI 0(R3),C' ' TEST FOR A BLANK NAME FIELD 14400002 BE NONAME 14420002 CLI 0(R3),C'A' TEST TO SEE IF 1ST CHAR A24020 14440002 * IS AN ALPHABETIC A24020 14460002 BC 4,SETERROR IF LOW GO SET ERROR SWITCHA24020 14480002 CLI 0(R3),C'Z' TEST TO SEE IF 1ST CHAR @ZM33351 14500003 * IS AN ALPHABETIC A24020 14520002 BC 2,SETERROR IF HIGH GO TO SET ERROR SWA24020 14540002 CONTSCAN EQU * A24020 14560002 LA R3,1(R3) GO TO NEXT BYTE A24020 14580002 ST LISTREG,AREAONE SAVE REGISTER 1 A24020 14600002 ST R2,AREATWO SAVE REGISTER 2 A24020 14620002 ST R5,AREAFIVE SAVE REGISTER 5 A24020 14640002 ST R6,AREASIX SAVE REGISTER 6 A24020 14660002 XR LISTREG,LISTREG CLEAR OUT REGISTER 1 A24020 14680002 XR R2,R2 CLEAR OUT REGISTER 2 A24020 14700002 TRT 0(8,R3),TRTTABLE SCAN NAME FIELD OF A24020 14720002 * CONTROL STATEMENT A24020 14740002 SCAN EQU * A24020 14760002 LR R6,LISTREG PUT ADDRESS OF LAST BYTE A24020 14780002 * SCANNED INTO REGISTER 6 A24020 14800002 BC 8,TOOLONG BRANCH IF NAME IS TOO LONGA24020 14820002 BRNCHTAB BC 15,BRNCHTAB(R2) TAKE BRANCH DEPENDENT UPONA24020 14840002 * CONTENTS OF REGISTER 2 A24020 14860002 BC 15,INVALID CC=4 BRANCH TO INVALID RTNA24020 14880002 ENDSCAN EQU * A24020 14900002 ST R6,IEHEFND PUT ADDRESS OF BLANK A24020 14920002 * FOUND INTO IEHEFND A24020 14940002 L R2,IEHESTT LOAD ADDRESS OF CONTROL CARD N S21046 14960002 SR R6,R2 GET NAME FIELD LENGTH S21046 14980002 EX R6,CCMOVE MOVE THE NAME TO SAVE IT S21046 15000002 L LISTREG,AREAONE RESTORE A24020 15020002 L R2,AREATWO REGISTERS A24020 15040002 L R5,AREAFIVE TO ORGINAL A24020 15060002 L R6,AREASIX STATUS A24020 15080002 TM MOUNTSW,ERRSW2 WAS SYNTAX ERROR FOUND S21046 15100002 BC 8,SCANOPRD NO, SYNTAX ERROR WAS NOT A24020 15120002 * FOUND, GO TO CONTINUE SCANA24020 15140002 * OF CONTROL STATEMENT A24020 15160002 NI MOUNTSW,CLEARSW TURN ERROR SWITCH OFF A24020 15180002 LA PARAMREG,58 PUT ERROR MESG NUMBER A24020 15200002 * INTO REG 0 A24020 15220002 MVI MSGOUT,C' ' CLEAR A24020 15240002 MVC MSGOUT+1(119),MSGOUT MESSAGE AREA A24020 15260002 L LINKREG,MSGRTNAD PUT ADDRESS OF MSG RTN A24020 15280002 * INTO REG 15 A24020 15300002 BALR RETURN,LINKREG GO WRITE MESSAGE A24020 15320002 L LINKREG,SEVER4 GO TO CONDITION CODE A24020 15340002 BALR RETURN,LINKREG HANDLER A24020 15360002 BC 15,SCANOPRD CONTINUE TO SCAN CONTROL A24020 15380002 * STATEMENT A24020 15400002 SETERROR EQU * A24020 15420002 OI MOUNTSW,X'04' NO, POST ERROR CODE OF 4 A24020 15440002 BC 15,CONTSCAN BRANCH TO CONTINUE SCAN OFA24020 15460002 * NAME FIELD A24020 15480002 TOOLONG EQU * A24020 15500002 OI MOUNTSW,X'04' POST ERROR CODE OF 4 A24020 15520002 LA R6,8(R3) GO TO NEXT BYTE A24020 15540002 TESTAGAN EQU * A24020 15560002 CLI 0(R6),X'40' IS THIS BYTE BLANK A24020 15580002 BC 8,ENDSCAN YES, GO TO END OF SCAN A24020 15600002 LA R6,1(R6) GO TO NEXT BYTE A24020 15620002 BC 15,TESTAGAN NO, TEST NEXT BYTE A24020 15640002 INVALID EQU * A24020 15660002 OI MOUNTSW,X'04' POST ERROR CODE OF 4 A24020 15680002 LA R5,7(R3) PUT ADDRESS OF LAST BYTE A24020 15700002 * TO BE SCANNED INTO REG 5 A24020 15720002 SR R5,R6 FIND OUT HOW MANY BYTES A24020 15740002 * ARE LEFT TO BE SCANNED A24020 15760002 LA R8,1(R6) GO TO NEXT BYTE A24020 15780002 BCTR R5,0 TAKE ONE FROM REGISTER 5 A24020 15800002 XR LISTREG,LISTREG CLEAR REGISTER 1 A24020 15820002 XR R2,R2 CLEAR REGISTER 2 A24020 15840002 EX R5,NEXTTEST INSERT NUMBER OF BYTES TO A24020 15860002 * BE SCANNED INTO TRT INSTR A24020 15880002 BC 15,SCAN GO TO SCAN ANALYSIS RTN A24020 15900002 CCMOVE MVC CCNAME(ONEBYTE),ZERODSP(R2) S21046 15920002 * MOVE FOR NAME FIELD S21046 15940002 NEXTTEST TRT 0(0,R8),TRTTABLE USED FOR SCAN OF NAME A24020 15960002 * FIELD A24020 15980002 SCANOPRD EQU * A24020 16000002 NI IEHESW1,ENDSWOFF 16020002 * AT THIS POINT THE NAME FIELD HAS BEEN SCANNED FOR THESE A24020 16040002 * SYNTAX ERRORS: A24020 16060002 * 1. THE FIRST CHARACTER NOT BEING AN ALPHABETIC. A24020 16080002 * 2. THE NAME FIELD BEING LONGER THAN 8 CHARACTERS. A24020 16100002 * 3. CHARACTERS 2-8 CONTAINING ANYTHING OTHER THAN A24020 16120002 * ALPHAMERIC OR NATIONAL CHARACTERS A24020 16140002 * IF ANY OF THE ABOVE CONDITIONS ARE FOUND AN ERROR A24020 16160002 * MESSAGE IS WRITTEN AND A CONDITION CODE OF 4 IS A24020 16180002 * POSTED. THE SEARCH IS NOW CONTINUED FROM THE FIRST A24020 16200002 * BLANK COLUMN TO THE FIRST NONBLANK COLUMN (THE START OF A24020 16220002 * THE OPERATION FIELD.) A24020 16240002 MVC IEHESTT(4),IEHEFND START ADDRESS ALONG WITH 16260002 NONAME MVC IEHECHAR(2),NOTBLANK CHARACTER AND CODE ARE 16280002 * INSERTED INTO THE SCANLIST 16300002 L RB,SCANAD GO TO THE SCAN 16320002 LA RB2,OFFSET1K(RB) SET UP BASE REG DISPLACEMENT S21046 16340002 BALR RETURN,RB ROUTINE 16360002 USING *,RETURN SCAN RETURNS WITH THE ADDRESS 16380002 DROP RB2 DON'T WANT RB2 USED AS BASE S21046 16400002 * REG ON THE LOAD OF SCANBASE S21046 16420002 L RB,SCANBASE OF THE BEGINING OF THE OPERATION 16440002 LA RB2,OFFSET1K(RB) SET UP BASE REG S21046 16460002 DROP RETURN FIELD 16480002 USING IEHESCAN+OFFSET2,RB2 S21046 16500002 * I WILL NOW SCAN ACROSS THE OPERATION FIELD AND HAVE 16520002 * A TABLE LOOK UP PERFORMED ON THE OPERATION SCANNED OUT. 16540002 * IF THE OPERATION IS NOT FOUND IN THE TABLE OR IS FOUND BUT 16560002 * IS NOT A FUNCTION NAME A DIAGNOSTIC MESSAGE WILL BE 16580002 * WRITTEN AND THE REQUEST IGNORED 16600002 MVC IEHESTT(4),IEHEFND RESET START ADDRESS 16620002 MVC IEHECHAR(2),BLANKEQU RESET CHARACTER AND CODE 16640002 MVI IEHETBL,X'FF' ISSUE REQUEST FOR TLU 16660002 L RB,SCANAD GO TO THE SCAN 16680002 BALR RETURN,RB ROUTINE 16700002 NI IEHEARGL,X'07' PLACE FUNCTION NAME 16720002 LM R2,R3,0(RBD) AND ITS LENGTH 16740002 STC R2,FNSA INTO FUNCTION NAME 16760002 EX R2,*+8 SAVE AREA 16780002 B *+10 16800002 MVC FNSA+1(1),0(R3) 16820002 NI IEHESW1,ENDSWOFF 16840002 L R4,IEHEFUN R4 GETS ADDRESS OF TABLE FUNCTION 16860002 LTR R4,R4 16880002 BZ NOTINTAB BRANCH IF NO FIND FROM TLU ROUTINE 16900002 CLI 0(R4),X'03' TEST FOR A VALID REQUEST NAME. 16920002 BNE NOTINTAB BRANCH IF NOT VALID 16940002 MVC FINUSE(4),2(R4) ----------FDLD INSERT------- 16960002 * AT THIS POINT THE ADDRESS OF THE ROUTINE WHICH PROVIDES 16980002 * THE REQUESTED FUNCTION HAS BEEN STORED. WE WILL NOW SCAN OVER 17000002 * BLANKS WHICH PRECEED THE OPERAND FIELD, AND SET UP SCANLIST 17020002 * BEFORE GOING TO THE KEYWORD AND OPTION DECODER. 17040002 MVC IEHESTT(4),IEHEFND RESET THE START ADDRESS 17060002 MVC IEHECHAR(2),NOTBLANK RESET CHARACTERS AND CODE 17080002 SR R6,R6 17100002 ST R6,IEHETBL NO TLU WANTED 17120002 L RB,SCANAD GO TO THE SCAN 17140002 BALR RETURN,RB ROUTINE 17160002 MVC IEHESTT(4),IEHEFND RESET START ADDRESS 17180002 *-----------------GENERAL FUNCTION ROUTINE----------------- 17200002 FDLD L R9,FINUSE GET ADDRESS OF LIST IN USE 17220002 LA R5,ONEWORD(R9) S21046 17240002 ST R5,FINUSE UPDATE THE ADDRESS OF LIST S21046 17260002 SR R2,R2 17280002 IC R2,0(R9) 17300002 SLL R2,2 SELECT THE ROUTINE TO BE PERFORMED 17320002 LA RETURN,FDLD PROVIDE A RETURN 17340002 EX 0,*+4(R2) GO THERE 17360002 * 17380002 * ONE OF THESE BRANCH INSTRUCTIONS ARE EXECUTED AS DETERMINED FROM 17400002 * THE FIRST BYTE OF THE DATA LIST FOR THE FUNCTION IN USE 17420002 B XCONTROL EXECUTE FOR A ZERO OP 17440002 B LISTECII EXECUTE FOR A ONE OP 17460002 B TESTDUP EXECUTE FOR A TWO OP 17480002 B SETDUP 17500002 B LINKSAVE 17520002 B DCRETURN 17540002 B GETAMSG 17560002 B EXECUTE 17580002 B READALL 17600002 B STTRESET 17620002 B XCTL 17640002 B SETCCODE GO SET CONDITION CODE A25564 17660002 B INIT INITIALIZE PARAMETER LIST S21046 17680002 B DSLNGTH PUT DSNAME LENGTH IN PARAMETER S21046 17700002 * LIST FOR PROTECT S21046 17720002 * FOR LIST OPERATION S21046 17740002 FRECOVER MVC FINUSE(4),FLSTADDR 17760002 B FDLD 17780002 * ZERO IN FIRST BYTE WE WILL PASS CONTROL TO THE LOCATION SPECIFIED 17800002 XCONTROL L R2,0(R9) 17820002 BR R2 GO TO LOCATION IN THE DATA LIST 17840002 * A ONE OP CODE CAUSES SETTING OF PAIAMSW, MAC1, CALL,ETC. 17860002 * INITIALIZE THE FUNCTION ---A ONE IN FIRST BYTE---- 17880002 * S21046 17900002 * SET UP TO ANALYZE OPERANDS S21046 17920002 * S21046 17940002 LISTECII MVC PPARAMSW(2),2(R9) 17960002 MVC IEHEMAC1(4),4(R9) 17980002 LA R2,FRECOVER 18000002 ST R2,IEHECALL 18020002 LA R5,ONEWORD(R5) S21046 18040002 ST R5,FLSTADDR S21046 18060002 B KODECODE 18080002 * S21046 18100002 * TEST FOR MINIMUM PARAMETERS S21046 18120002 * S21046 18140002 TESTDUP IC R2,3(R9) 2 OP TEST A SWITCH 18160002 SLL R2,4 18180002 IC R3,2(R9) 18200002 SR R4,R4 18220002 IC R4,1(R9) 18240002 LA R4,DUPSW(R4) 18260002 EX R3,TESTSW 18280002 EX R2,BOC 18300002 LA R5,ONEWORD(R5) S21046 18320002 ST R5,FINUSE S21046 18340002 B FDLD 18360002 TESTSW TM 0(R4),ZERO 18380002 BOC BC 0,FDLD 18400002 * SET THE DUPSW A 3 OP MASK IS LAST BYTE 18420002 SETDUP L R2,0(R9) 18440002 EX R2,DUPSET 18460002 B FDLD 18480002 DUPSET OI DUPSW,ZERO 18500002 * S21046 18520002 * PICK UP ROUTING TABLE FOR MESSAGES TO BE PRINTED S21046 18540002 * S21046 18560002 LINKSAVE L R2,0(R9) 18580002 ST R2,FINUSE 18600002 ST R5,DCSAVEAD S21046 18620002 B FDLD 18640002 * 5 OP RETURN TO OLD DC LIST IN DCSAVEAD 18660002 DCRETURN MVC FINUSE(4),DCSAVEAD 18680002 B FDLD 18700002 * 6 OP SET REG ZERO AND GO TO THE MSG WRITER 18720002 GETAMSG L PARAMREG,0(R9) 18740002 L LINKREG,MSGRTNAD 18760002 BR LINKREG 18780002 * 7 OP EXECUTE A REMOTE INSTRUCTION OP ADDR 18800002 EXECUTE L LINKREG,0(R9) 18820002 EX 0,0(LINKREG) 18840002 B FDLD 18860002 SETCCODE EQU * SET CONDITION CODE A25564 18880002 ST RETURN,IEHECALL A25564 18900002 L LINKREG,SEVER8 GO TO CONDITION A25564 18920002 BALR RETURN,LINKREG CODE HANDLER A25564 18940002 L RETURN,IEHECALL RESTORE REGISTER 14 A25564 18960002 OI IEHESW1,NDSWMSK A25564 18980002 BR RB GO BACK TO IEHESCAN A25564 19000002 * S21046 19020002 * 12 OP INITIALIZE FOR PROTECT COMMANDS S21046 19040002 * S21046 19060002 INIT XC IEHEMAC1+EIGHT(NINETEEN),IEHEMAC1+EIGHT ZERO OUT S21046 19080002 * MOVE ZEROES TO PARAMETER LIST S21046 19100002 LA R3,CNT1PAS LOAD DECREMENT FOR ONE WTOR S21046 19120002 STC R3,PASWDCT1 STORE DECREMENT FOR PASWORD1 S21046 19140002 STC R3,PASWDCT3 STORE DECREMENT FOR CPASWORD S21046 19160002 B FDLD GO TO NEXT ENTRY OF TABLE S21046 19180002 * S21046 19200002 * 13 OP PUT DSNAME LENGTH INTO PARAMETER FOR PROTECT S21046 19220002 * S21046 19240002 DSLNGTH IC R2,PARAM2-ONEBYTE PUT THE DSNAME LNGTH IN PARM S21046 19260002 LA R2,ONEBYTE(R2) S21046 19280002 STC R2,IEHEMAC1+ONEWORD S21046 19300002 B FDLD GO TO NEXT ENTRY OF TABLE S21046 19320002 * 8 OP READ ALL CARD ASSOCIATED WITH THIS JOB NOW 19340002 READALL OI IEHESW1,NDSWMSK 19360002 ST RETURN,IEHECALL 19380002 BR RB GO BACK TO IEHESCAN A25564 19400002 XCTL L R2,0(R9) GET NUMBER OF THE LIST IN USE 19420002 TM DUPSW,X'08' WAS MEMBER SPECIFIED 19440002 BZ NOMEMBER NO ..... BRANCH 19460002 OI PPARAMSW,X'01' SO VOL MOUNT WILL MOVE A DCB 19480002 MVC IEHEMAC1+8(4),IEHEMAC1+4 19500002 MVI IEHEMAC1,X'C1' 19520002 MVI IEHEMAC1+2,X'20' SET UP A MEMBER OPERATOON 19540002 CLI PARAM4+1,X'01' IS THERE MORE THAN 1 VOLUME 19560002 BNE XTRAKEY YES .... BRANCH (ERROR) 19580002 LA R2,13 POINT TO THE MEMBER LIST 19600002 NOMEMBER EQU * 19620002 ST R2,FINUSE STORE IT FOR THE SECOND LOAD 19640002 TM IEHESW2,MNTVOL IS VOL PRESENT FOR PROTECT S21046 19660002 BZ NOPROTCT NO BRANCH S21046 19680002 OI IEHEMAC1,VOLMNT CAUSE VOL MOUNTING S21046 19700002 NOPROTCT EX ZERO,GETAVOL HAVE REQUIRED VOLUMES MOUNTED S21046 19720002 L 15,DECB2 GET ADDRESS OF V ADCONS 19740002 L 15,28(15) GET V ADCON OF SECOND LOAD 19760002 BR 15 GO THERE 19780002 NOTINTAB EQU * A25564 19800002 L LINKREG,SEVER8 GO TO CONDITION CODE A25564 19820002 BALR RETURN,LINKREG HANDLER A25564 19840002 LA PARAMREG,2 A25564 19860002 B GOAGAIN 19880002 * THIS ROUTINE WILL HANDLE THE MOVING OF PARAMETERS THAT 19900002 * DO NOT REQUIRE ANY THING OTHER THAN MOVING THAT IS 19920002 * THEY DO NOT NEED ANY CONVERSTION OR UNPACKING ETC. 19940002 JUSTMOVE EQU * 19960002 MVC CODELIST(8),COMBLANK SET SCAN FOR A COMMA OR BLANK 19980002 XC IEHETBL(4),IEHETBL REQUEST NO TQBLE LOOK UP 20000002 BALR RETURN,RB GO TO SCAN ROUTINE 20020002 MVC CODELIST(8),SPECIALS RESET SPECIAL CHARACTERS 20040002 SPACE 1 20060002 * ON RETURNING FROM SCAN WE HAVE ALL THE INFO NEEDED 20080002 * TO MOVE THE ITEM JUST SCANNED OFF. THE ADDRESS AND LENGTH 20100002 * OF THE ITEM ARE IN THE SCANLIST. THE RECEIVE LOCATION CAN 20120002 * BE DETERMINED FROM THE 2ND BYTE OF THE FUNCTION POINTED TO 20140002 * BY THE SCANLIST THIS FUNCTION IS ASSOCIATED WITH THE 20160002 * KEYWORD WHICH CAUSED ENTRY TO THIS ROUTINE. 20180002 SPACE 1 20200002 CLI IEHEARGL,X'2B' CHECK LENGTH OF THE SCAN 20220002 BH CODERR BRANCH IF DSNAME IS LONGER M1607 20240002 * THAN 44 CHARACTERS M1607 20260002 TM PPARAMSW+1,X'02' MEMBERNAME SCANNED? @ZA01655 20270002 BO MEMBLNG YES.CHECK LGTH OF MEMBERNAME @ZA01655 20272002 * A28552 20280002 * CHECK NAME , ALIAS , OR INDEX GIVEN FOR INDEX LEVEL <= 8 CHARS 20300002 * ALPHABETIC FIRST CHARACTERS , AND ALPHAMERIC CHARACTERS . A28552 20320002 * A28552 20340002 CHECKS TM PPARAMSW+1,X'01' CHECK 1ST CHARS ? @ZA01655 20360002 BZ DONTCHCK NO CHECK REQUIRED A28552 20380002 L NAMEPTR,IEHESTT GET ADDRESS OF NAME A28552 20400002 STM LISTREG,R2,AREAONE SAVE REGISTERS A28552 20420002 XR LISTREG,LISTREG ZERO OUT REGISTERS USED A28552 20440002 * IN TRT INSTRUCTION A28552 20460002 TM PPARAMSW+1,X'02' IS THIS A MEMBER NAME ? A28552 20480002 BZ NXTFRST IF NOT BRANCH A28552 20500002 NI PPARAMSW+1,X'FD' TURN OFF THE MEMBER BIT A28552 20520002 B CHCKLNG DON'T CHECK FOR ALPHABETICA28552 20540002 * FIRST CHARACTER A28552 20560002 MEMBLNG NI PPARAMSW+1,X'FD' TURN OFF THE MEMBER BIT @ZA01655 20560102 CLI IEHEARGL,X'07' MEMBERNAME > 8. @ZA01655 20570002 BH CODERR YES... ERROR MSG @ZA01655 20572002 B CHECKS NO.. GO ON TESTING @ZA01655 20574002 NXTFRST EQU * CHECK FIRST CHARACTER OF A28552 20580002 * INDEX LEVEL TO BE SURE A28552 20600002 CLI 0(NAMEPTR),C'$' IT IS BETWEEN $ AND Z A28552 20620002 BL CODERR A28552 20640002 CLI 0(NAMEPTR),C'Z' A28552 20660002 BH CODERR A28552 20680002 CHCKLNG EQU * A28552 20700002 TRT 0(9,NAMEPTR),TRTTABLE CHECK CHAR VALIDITY A28552 20720002 BC 8,CODERR BRANCH IF TOO LONG A28552 20740002 CLC 0(1,ARGREG),SPECIALS+1 DELIMITED BY A COMMA ? A28552 20760002 BE LOADREG IF SO MOVE ON A28552 20780002 CLC 0(1,ARGREG),SPECIALS+6 DELIMITED BY A BLANK ? A28552 20800002 BE LOADREG IF SO MOVE ON A28552 20820002 CLC 0(1,ARGREG),SPECIALS DELIMITED BY A PERIOD ? A28552 20840002 BNE CODERR IF NOT BRANCH TO ERROR RTNA28552 20860002 LA NAMEPTR,1(ARGREG) UPDATE POINTER A28552 20880002 B NXTFRST CHECK 1ST CHAR OF NEXT A28552 20900002 * INDEX LEVEL A28552 20920002 CODERR EQU * A28552 20940002 L LINKREG,SEVER8 GO SET CONDITION CODE A28552 20960002 BALR RETURN,LINKREG A28552 20980002 LA PARAMREG,59 MESSAGE NUMBER 59 A28552 21000002 B GOAGAIN BRANCH TO LINK ROUTINE A28552 21020002 LOADREG EQU * A28552 21040002 LM LISTREG,R2,AREAONE RESTORE REGISTERS A28552 21060002 TM IEHEMAC1+2,X'20' IS THIS RENAME A42349 21080002 BZ DONTCHCK IF NOT DONT TURN OFF BIT A42349 21100002 NI PPARAMSW+1,X'FE' TURN OFF TEST BIT A42349 21120002 DONTCHCK EQU * A28552 21140002 L R2,IEHEFUN FUNCTION ADDRESS TO R2 21160002 SR R3,R3 21180002 IC R3,1(R2) NUMBER OF RECEIVE AREA TO REG 3 21200002 LA R4,256 PUT A BIT IN REG FOUR 21220002 SRL R4,0(R3) BUILD A MASK WITH IT 21240002 EX R4,DUPTEST TEST FOR DUPLICATE PARAMETERS 21260002 BO XTRAKEY BRANCH IF DUPLICATED A25564 21280002 EX R4,SETDUPSW NO DUPLICATE THEN TURN ON SWITCH 21300002 SLL R3,2 4 TIME THE NUMBER FOR INDEXING 21320002 L R4,WARE2PUT(R3) ADDR OF RECEIVE AREA TO REG 4 21340002 MVI 0(R4),C' ' 21360002 MVC 1(43,R4),0(R4) CLEAR RECEIVE AREA TO BLANKS 21380002 L R5,IEHESTT ADDRESS OF DATA TO REG 5 21400002 IC R3,IEHEARGL LENGTH OF DATA TO REG 3 21420002 EX R3,MOVEDATA MOVE THE PARAMETER TO ITS AREA 21440002 BCTR R4,0 INTO THE RECEIVE AREA -1 21460002 STC R3,0(R4) STORE THE LENGTH 21480002 L R6,IEHEFND 21500002 LA R6,1(R6) 1 UP START ADDRESS FOR SCAN 21520002 ST R6,IEHESTT 21540002 B KODECODE 21560002 MOVEDATA MVC 0(1,R4),0(R5) MOVES DATA TO RECEIVE AREA WHEN EXECUTED 21580002 DUPTEST TM DUPSW,X'00' TESTS FOR DUPLICATE PARAMETERS 21600002 SETDUPSW OI DUPSW,X'00' RECORDS PARAMETERS PRESENCE 21620002 INDEX TM PPARAMSW,X'80' TEST TO SEE IF INDEX SHOULD BE 21640002 BO JUSTMOVE PRESENTIF YES GO MOVE IT 21660002 XTRAKEY EQU * A25564 21680002 LA LISTREG,XTRADATA A25564 21700002 ENT2FDLD ST LISTREG,FINUSE 21720002 B FDLD 21740002 EMPTY TM PPARAMSW+1,X'80' IS EMPTY ALLOWED 21760002 BZ XTRAKEY NO ..... BRANCH 21780002 OI IEHEMAC1+2,X'08' RECORD THE PRESENCE OF EMPTY 21800002 B KODECODE 21820002 DELETE TM PPARAMSW+1,X'80' IS DELETE ALLOWED 21840002 BZ XTRAKEY NO ..... BRANCH 21860002 OI IEHEMAC1+2,X'40' RECORD DELETE 21880002 B KODECODE 21900002 ENTRIES TM PPARAMSW+1,X'80' IS ENTRIES ALLOWED 21920002 BZ XTRAKEY NO ..... BRANCH 21940002 TM DUPSW,X'02' 21960002 BO XTRAKEY BRANCH IF ENTRIES IS SPECIFIED TWICE 21980002 OI DUPSW,X'02' RECORD ENTRIES 22000002 XC IEHETBL(4),IEHETBL PREVENT A TLU 22020002 BALR RETURN,RB SCAN OFF THE NUMBER 22040002 MVC VOLISTAD(4),IEHEMAC1+12 22060002 B DSSEQ UNPACK,CONVERT,STORE AT PARAM4+1 22080002 CVOL TM PPARAMSW,X'40' TEST TO SEE IF CVOL SHOULD BE 22100002 BZ XTRAKEY 22120002 OI IEHEMAC1,X'80' 22140002 TM DUPSW,X'20' 22160002 BO XTRAKEY BRANCH IF DUPLICATE ENTRY 22180002 OI DUPSW,X'20' 22200002 LA R3,PARAM3 22220002 ST R3,VOLISTAD 22240002 LA R4,VMATRIX1 22260002 ST R4,MATRIXIU 22280002 LA R3,PARAM3+4 22300002 ST R3,IEHEMAC1+8 22320002 OI IEHESW2,CVOLBIT TURN ON THE CVOL BIT S21046 22340002 B VOLSCAN 22360002 MEMBER TM IEHEMAC1,X'01' SHOLUD MEMBER BE PRESENT 22380002 BZ XTRAKEY NO ..... BRANCH 22400002 OI PPARAMSW+1,X'02' TURN ON BIT TO HAVE @ZA01655 22420002 * MEMBER CHECKED FOR A28552 22440002 * LENGTH AND ALPHAMERICS A28552 22460002 LA 0,EOCORE 22480002 ST 0,IEHEMAC1+16 22500002 DSNAME TM PPARAMSW,X'10' SHOULD DSNAME BE HERE ? 22520002 BZ XTRAKEY NO... BRANCH 22540002 NI PPARAMSW,X'FE' 22560002 B JUSTMOVE 22580002 * S21046 22600002 * CHECK TO BE SURE PASWORD1 IS VALID HERE, IF IT IS A S21046 22620002 * DUPLICATE, AND INITIALIZE TO MOVE IT TO THE PROTECT S21046 22640002 * PARAMETER LIST S21046 22660002 * S21046 22680002 PASWORD1 TM PPARAMSW+ONEBYTE,PSWD1MSK SHOULD PASWORD1 BE HERE S21046 22700002 BZ XTRAKEY NO IT IS REDUNDANT S21046 22720002 TM DUPSW+ONEBYTE,PSWD1DUP HAS PASWORD1 BEEN HERE S21046 22740002 BO XTRAKEY YES IT IS A DUPLICATE S21046 22760002 OI DUPSW+ONEBYTE,PSWD1DUP INDICATE PASWORD1 PRESENT S21046 22780002 LA R3,PARAM3 GET ADDRESS FOR PASWORD1 S21046 22800002 ST R3,IEHEMAC1+PSWD1PRM STORE AD IN PARAMETERS S21046 22820002 B MOVPASWD GO MOVE PASWORD1 TO ITS AREA S21046 22840002 * S21046 22860002 * CHECK TO BE SURE PASWORD2 IS VALID HERE, IF IT IS A S21046 22880002 * DUPLICATE, AND INITIALIZE TO MOVE IT TO THE PROTECT S21046 22900002 * PARAMETER LIST. S21046 22920002 * S21046 22940002 PASWORD2 TM PPARAMSW+ONEBYTE,PSWD2MSK SHOULD PASWORD2 BE HERE S21046 22960002 BZ XTRAKEY NO IT IS REDUNDANT S21046 22980002 TM DUPSW+ONEBYTE,PSWD2DUP HAS PASWORD2 BEEN HERE S21046 23000002 BO XTRAKEY YES IT IS A DUPLICATE S21046 23020002 OI DUPSW+ONEBYTE,PSWD2DUP INDICATE PASWORD2 PRESENT S21046 23040002 LA R3,PARAM7 GET ADDRESS FOR PASWORD2 S21046 23060002 ST R3,DUMMY STORE ADDRESS IN TEMPORARY S21046 23080002 MVC IEHEMAC1+PSWD2PRM(THREEBYT),DUMMY+ONEBYTE S21046 23100002 * MOVE PASWORD2 TO PARAM LIST S21046 23120002 B MOVPASWD GO MOVE PASWORD2 S21046 23140002 * S21046 23160002 * CHECK TO BE SURE CPASWORD IS VALID HERE, IF IT IS A S21046 23180002 * DUPLICATE, AND INITIALIZE TO MOVE IT TO THE PROTECT S21046 23200002 * PARAMETER LIST. S21046 23220002 * S21046 23240002 CPASWORD TM PPARAMSW+ONEBYTE,CPSWDMSK SHOULD CPASWORD BE HERE S21046 23260002 BZ XTRAKEY NO IT IS REDUNDANT S21046 23280002 TM DUPSW+ONEBYTE,CPSWDDUP HAS CPASWORD BEEN HERE S21046 23300002 BO XTRAKEY YES IT IS A DUPLICATE S21046 23320002 OI DUPSW+ONEBYTE,CPSWDDUP INDICATE CPASWORD PRESENT S21046 23340002 LA R3,PARAM5 GET ADDRESS FOR CPASWORD S21046 23360002 ST R3,IEHEMAC1+CPSWDPRM STORE AD IN PARAMETERS S21046 23380002 B MOVPASWD GO MOVE CPASWORD TO ITS AREA S21046 23400002 * S21046 23420002 * CHECK TO BE SURE TYPE SHOULD BE HERE, CHECK FOR DUPLICATE S21046 23440002 * SCAN FOR THE NUMERIC TYPE, AND MOVE NUMBER SCANNED S21046 23460002 * TO THE PROTECT PARAMETER LIST. S21046 23480002 * S21046 23500002 TYPE TM PPARAMSW+ONEBYTE,TYPEMSK SHOULD TYPE BE HERE S21046 23520002 BZ XTRAKEY NO IT IS REDUNDANT S21046 23540002 TM DUPSW+ONEBYTE,TYPEDUP HAS TYPE BEEN HERE S21046 23560002 BO XTRAKEY YES IT IS A DUPLICATE S21046 23580002 OI DUPSW+ONEBYTE,TYPEDUP INDICATE TYPE PRESENT S21046 23600002 MVC CODELIST(EIGHT),COMBLANK SCAN FOR , OR BLANK S21046 23620002 XC IEHETBL(ONEWORD),IEHETBL NO TABLE LOOKUP WANTED S21046 23640002 BALR RETURN,RB GO TO SCAN ROUTINE S21046 23660002 MVC CODELIST(EIGHT),SPECIALS RESET CODELIST S21046 23680002 CLI IEHEARGL,ZEROBYTE CHECK LENGTH OF SCAN S21046 23700002 BH BADSYN BRANCH IF LENGTH GREATER TWO S21046 23720002 L R3,IEHESTT LOAD ADDRESS OF TYPE FIELD S21046 23740002 TM ZERODSP(R3),NUMFLD EBCDIC CHARACTER S21046 23760002 BNO BADSYN BRANCH IF NOT NUMERAL S21046 23780002 NI ZERODSP(R3),DROPZONE DROP THE ZONE S21046 23800002 CLI ZERODSP(R3),TYPECODE IS TYPE GREATER THAN 3 S21046 23820002 BH BADSYN IF SO IT IS INVALID S21046 23840002 MVC IEHEMAC1+TYPEPRM(ONEBYTE),ZERODSP(R3) S21046 23860002 * MOVE TYPE TO PARAMETER LIST S21046 23880002 L R6,IEHEFND UP THE START S21046 23900002 LA R6,ONEBYTE(R6) ADDRESS S21046 23920002 ST R6,IEHESTT BY ONE FOR NEXT SCAN AND S21046 23940002 B KODECODE GO GET ANOTHER KEYWORD S21046 23960002 * S21046 23980002 * CHECK TO BE SURE 'DATA' SHOULD BE HERE, CHECK FOR S21046 24000002 * DUPLICATES, PUT ADDRESS OF DATA INTO PROTECT S21046 24020002 * PARAMETER LIST, AND GO SCAN FOR BEGINNING AND END S21046 24040002 * OF THE CHARACTER STRING. S21046 24060002 * S21046 24080002 DATA TM PPARAMSW+ONEBYTE,DATAMSK SHOULD DATA BE HERE S21046 24100002 BZ XTRAKEY NO IT IS REDUNDANT S21046 24120002 TM DUPSW+ONEBYTE,DATADUP HAS DATA BEEN HERE S21046 24140002 BO XTRAKEY YES IT IS A DUPLICATE S21046 24160002 OI DUPSW+ONEBYTE,DATADUP INDICATE DATA IS PRESENT S21046 24180002 LA R3,PARAM8 LOAD ADDRESS FOR DATA S21046 24200002 ST R3,IEHEMAC1+DATAPRM STORE AD IN PARAMETER S21046 24220002 MVC CODELIST(EIGHT),QUOTE SET CODE LIST FIND QUOTE S21046 24240002 MVC IEHECHAR(HALFWD),AQUOTE SCAN FOR ONLY A QUOTE S21046 24260002 XC IEHETBL(ONEWORD),IEHETBL NO TABLE LOOKUP S21046 24280002 AGN BALR RETURN,RB GO TO SCAN S21046 24300002 CLI IEHECODE,QUOTEMSK WAS A QUOTE FOUND S21046 24320002 BNE BADSYN NO BRANCH S21046 24340002 L R6,IEHEFND SET UP SCAN TO FIND QUOTE S21046 24360002 LA R6,ONEBYTE(R6) UP THE START ADDRESS FOR SCAN S21046 24380002 L R5,IEHESTT THE START FOR THE DATA AREA S21046 24400002 ST R6,IEHESTT STORE NEW START FOR SCAN S21046 24420002 TM IEHESW2,ONEQUOTE WAS ONE QUOTE FOUND BEFORE S21046 24440002 BO MOVE YES BRANCH S21046 24460002 OI IEHESW2,ONEQUOTE INDICATE ONE QUOTE IS FOUND S21046 24480002 B AGN GO FIND SECOND QUOTE S21046 24500002 * S21046 24520002 * CHECK DATA CHARACTER STRING LENGTH FOR GREATER THAN S21046 24540002 * 77 CHARACTERS, IF LEGAL PUT DATA LENGTH INTO PROTECT S21046 24560002 * PARAMETER LIST, IF NOT LEGAL INITIALIZE TO PRINT S21046 24580002 * ERROR MESSAGE S21046 24600002 * S21046 24620002 MOVE IC R4,IEHEARGL GET LENGTH OF ARGUMENT S21046 24640002 LA R4,ONEBYTE(R4) LENGTH IS ONE GREATER S21046 24660002 CLI IEHEARGL,DATALGTH DATA LENGTH GREATER THAN 77 S21046 24680002 BH BADSYN IF YES, BAD SYNTAX S21046 24700002 STC R4,IEHEMAC1+DATAPRM STOR DATA LENGTH S21046 24720002 LA R3,PARAM8 LOAD ADDRESS FOR PARAMETER S21046 24740002 EX R4,PROTCTMV MOVE THE PARAMETER TO AREA S21046 24760002 MVC IEHECHAR(HALFWD),ANYSPEC S21046 24780002 * SCAN FOR ANY SPECIAL CHAR S21046 24800002 MVC CODELIST(EIGHT),COMBLANK S21046 24820002 * SEARCH FOR COMMA OR BLANK S21046 24840002 BALR RETURN,RB GO TO SCAN ROUTINE S21046 24860002 MVC CODELIST(EIGHT),SPECIALS S21046 24880002 * RESTORE THE CODELIST S21046 24900002 L R6,IEHEFND UP THE START ADDRESS S21046 24920002 LA R6,ONEBYTE(R6) S21046 24940002 ST R6,IEHESTT STORE THE NEW START ADDRESS S21046 24960002 B KODECODE GO GET ANOTHE KEYWORD S21046 24980002 * S21046 25000002 * SCAN FOR A PASSWORD, CHECK LENGTH FOR GREATER THAN 8 S21046 25020002 * CHARACTERS AND MOVE THE PASSWORD TO THE PROTECT S21046 25040002 * PARAMETER LIST IF IT IS LEGAL. IF THE PASSWORD IS LONGER S21046 25060002 * THAN EIGHT INITIALIZE TO PRINT ERROR MESSAGE S21046 25080002 * S21046 25100002 MOVPASWD MVC CODELIST(EIGHT),COMBLANK S21046 25120002 * SEARCH FOR COMMA OR BLANK S21046 25140002 XC IEHETBL(ONEWORD),IEHETBL S21046 25160002 * NO TABLE LOOKUP WANTED S21046 25180002 BALR RETURN,RB GO TO SCAN ROUTINE S21046 25200002 MVC CODELIST(EIGHT),SPECIALS S21046 25220002 * RESTORE THE CODELIST S21046 25240002 CLI IEHEARGL,LNGTHCHK IS LENGTH GREATER THAN 8 S21046 25260002 BH BADSYN GO PRINT MESSAGE S21046 25280002 L R2,IEHEFUN LOAD FUNCTION TABLE S21046 25300002 IC R5,ONEBYTE(R2) LOAD PARAMETER WORD NUMBER S21046 25320002 SLL R5,MULTBY4 MULT BY 4 TO GET WORD S21046 25340002 L R3,WARE2PUT(R5) LOAD ADDRESS TO PUT PAR&M S21046 25360002 MVI ZERODSP(R3),BLANKBYT BLANK OUT RECIEVE AREA S21046 25380002 MVC ONEBYTE(SEVEN,R3),ZERODSP(R3) S21046 25400002 LM R4,R5,IEHECHAR GET LENGTH AND START FOR MVC S21046 25420002 EX R4,PROTCTMV MOVE THE PARAMETER TO ITS AREA S21046 25440002 L R6,IEHEFND UP THE START ADDRESS S21046 25460002 LA R6,ONEBYTE(R6) S21046 25480002 ST R6,IEHESTT STORE THE NEW START ADDRESS S21046 25500002 B KODECODE GO GET ANOTHER KEYWORD S21046 25520002 PROTCTMV MVC ZERODSP(ONEBYTE,R3),ZERODSP(R5) S21046 25540002 * MOVE FOR PROTECT OPERATIONS S21046 25560002 SYS TM PPARAMSW,X'01' SHOULD 'SYS' BE PRESANT 25580002 BZ XTRAKEY NO--- 25600002 NI PPARAMSW,X'EF' TURN OF DSNAME SW 25620002 OI IEHESW5,X'02' TURN ON 'SYS' SWITCH 25640002 B KODECODE 25660002 VTOC TM PPARAMSW,X'01' SHOULD VTOC BE PRESENT 25680002 BZ XTRAKEY NO .....BRANCH 25700002 NI PPARAMSW,X'EF' TURN OFF DSNAME BIT 25720002 MVC FLSTADDR(4),ADVTOCDC 25740002 MVC PARAM2-1(5),KWSA 25760002 B STT1UP 25780002 NEWNAME TM PPARAMSW,X'08' 25800002 BZ XTRAKEY 25820002 OI IEHEMAC1,X'80' 25840002 OI PPARAMSW+1,X'01' TURN ON NAME TEST BIT A42349 25860002 B JUSTMOVE 25880002 ALIAS TM PPARAMSW,X'02' SHOULD ALIAS BE HERE 25900002 BZ XTRAKEY NO.....BRANCH 25920002 B JUSTMOVE 25940002 PURGE TM PPARAMSW,X'04' 25960002 BZ XTRAKEY 25980002 OI IEHEMAC1+2,X'10' 26000002 B KODECODE 26020002 * 26040002 * THIS ROUTINE TESTS TO SEE IF THE VOLUME STATEMENT IS PERMITTED 26060002 * UNDER THE PRESENT FUNCTION INSURES THAT IT IA NOT ENCOUNTERED 26080002 * MORE THAN ONCE. AND SETS UP MATRIX ONE TO CONTROLTHE SCAN OPERATION 26100002 * 26120002 * 26140002 VOL TM PPARAMSW,X'20' 26160002 BZ XTRAKEY BRANCH IF VOL SHOULD NOT A25564 26180002 * BE PRESENT A25564 26200002 TM DUPSW,X'10' 26220002 BO XTRAKEY BRANCH IF DUPLICATE ENTRY A25564 26240002 OI DUPSW,X'10' 26260002 TM IEHEMAC1,PRORTNCD IS THIS PROTECT OPERATION S21046 26280002 BC 7,NOTPRO NO BRANCH S21046 26300002 OI IEHESW2,MNTVOL CAUSE VOL TO BE MOUNTED S21046 26320002 NOTPRO OI IEHEMAC1,BLANKBYT RECORD THE PRESENCE OF VOL S21046 26340002 LA R4,VMATRIX1 26360002 ST R4,MATRIXIU 26380002 LA R3,PARAM4+2 26400002 ST R3,VOLISTAD SETADDRESS OF THE VOL LIST 26420002 LA R8,PARAM6 LOAD ADDRESS OF VOL PARAMETER S21046 26440002 ST R8,IEHEMAC1+VOLPRM STORE ADDRESS IN PARM LIST S21046 26460002 ST R8,PROTCTAD STORE ADDRESS OF VOL FOR S21046 26480002 * CURRENT VOL ID STORE S21046 26500002 XC PARAM4(2),PARAM4 26520002 OI IEHESW1,VOLSW SET VOL SWITCH ON 26540002 * 26560002 * HERE WE HAVE A SCAN PERFORMED AND DECODE THE RETURNSFROM SCAN 26580002 * BY REFERANCING THE MATRIX IN USE...THIS WILL BE MATRIX ONE FOR 26600002 * THE INITIAL ENTRY AND WILL BECOME MATRIX TWO ONLY AFTER A DEVICE 26620002 * TYPE HAS BEEN FOUND............................................... 26640002 * 26660002 * 26680002 VOLSCAN XC IEHETBL(4),IEHETBL 26700002 BALR RETURN,RB NO TLU AND GO TO SCAN 26720002 CLI IEHECODE,X'02' CHECK TYPE OF DELIMITER FOUND 26740002 BL VLISTERR BRANCH IF PERIOD OR INVALID 26760002 SR R3,R3 ------------------------------------ 26780002 IC R3,IEHECODE 26800002 CLI IEHEARGL,X'FF' THE TYPE OF DELIMITER AND THE LENGTH 26820002 BE *+8 OF SCAN IS TRANSLATED TO THE ADDRESS 26840002 LA R3,5(R3) OF A ROUTINE BY CROSS REFERANCE OF 26860002 L R4,MATRIXIU A MATRIX AND AN ADDRESS TEBLE 26880002 IC R3,0(R3,R4) 26900002 SLL R3,2 26920002 L R3,VOLDECAD(R3) SELECT THE ADDRESS NEEDED 26940002 BR R3 --------------GO THERE -------------- 26960002 * 26980002 * 27000002 SELECTOR XC VSRCM+1,VSRCM 27020002 BZ VOLID 27040002 * 27060002 DSSEQ XC DBLWORD(8),DBLWORD 27080002 CLI IEHEARGL,X'03' IS VOL SEQ NUMBER TO LONG 9760 27100002 BH BADSYN IF SO PUT OUT THE MESSAGE 9760 27120002 L R5,IEHESTT GET THE ADDRESS OF THE ARGUMENT 9760 27140002 SR R4,R4 AND THE LENGTH OF THE ARGUMENT9760 27160002 IC R4,IEHEARGL INTO REGISTERS R5 AND R4 9760 27180002 LA R3,1(R4) --SET UP THE 9760 27200002 AR R5,R3 LOOP CONTROL-- 9760 27220002 TESTZONE BCTR R5,0 THIS LOOP CHECKS EACH 9760 27240002 TM 0(R5),X'F0' BYTE OF THE VOL SEQ NUMBER 9760 27260002 BNO BADSYN FOR A NUMERIC ZONE, 9760 27280002 BCT R3,TESTZONE THAT IS, AN 'F' 9760 27300002 LA R3,1(R4) IF THE ZONES WERE VALID, SET 9760 27320002 AR R5,R3 UP LOOP CONTROL AGAIN 9760 27340002 TESTNMRC BCTR R5,0 ---AND TEST FOR VALID DECIMAL 9760 27360002 CLI 0(R5),X'F9' DIGITS BY COMPARING BYTES 9760 27380002 BH BADSYN OF VOL SEQ NUMBER TO AN 9760 27400002 BCT R3,TESTNMRC 'F9'. IF SEQ NO'S. OK, 9760 27420002 LA R3,DBLWORD+7 SET UP POINTER FOR MVC, RIGHT 9760 27440002 SR R3,R4 JUSTIFIED, INTO WORK AREA 9760 27460002 EX R4,MVCSEQ PUT SEQ NO. IN THE DOUBLE WORD 27480002 PACK DBLWORD(8),DBLWORD(8) PACK IT 27500002 CVB R6,DBLWORD CONVERT IT TO BINARY 27520002 SEQ2LIST ST R6,FULLWORD STORE IT 27540002 L R3,VOLISTAD 27560002 MVC 0(2,R3),FULLWORD+2 PUT IT IN THE VOL LIST 27580002 LA R3,2(R3) 27600002 ST R3,VOLISTAD SET POINTER TO NEXT VOL I.D. 27620002 B EOVLTEST 27640002 * 27660002 * 27680002 VOLID L R3,VOLISTAD 27700002 CLI IEHEARGL,X'05' IS VOLUME ID TO LONG 9760 27720002 BH BADSYN IF SO, PUT OUT MESSAGE 9760 27740002 MVC 0(4,R3),VDTIU PUT DEVICE CODE INTO VOL LIST 27760002 MVC 4(8,R3),VCBPAD FORMAT THE ENTRY 27780002 LM R4,R5,IEHECHAR 27800002 EX R4,MVCVOL PUT VOLUME I.D. INTO VOL LIST 27820002 TM IEHESW2,CVOLBIT IS THIS A CVOL S21046 27840002 BC 1,NOTVOL IF SO SKIP NEXT S21046 27860002 L R8,PROTCTAD LOAD ADDRESS OF VOL ID LIST S21046 27880002 MVC 0(6,R8),VCBPAD MOVE BLANKS TO VOL ID LIST YA01672 27890002 EX R4,PRTCTVOL MOVE VOL ID TO THIS AREA S21046 27900002 LA R8,SIX(R8) UPDATE ADDRESS FOR S21046 27920002 ST R8,PROTCTAD NEXT VOL ID S21046 27940002 IC R7,IEHEMAC1+VOLPRM UPDATE THE COUNT S21046 27960002 LA R7,ONEBYTE(R7) OF THE S21046 27980002 STC R7,IEHEMAC1+VOLPRM NUMBER OF VOL ID'S S21046 28000002 NOTVOL EQU * ENTER IF NOT VOL S21046 28020002 NI IEHESW2,CVOLOFF TURN OFF THE CVOL SWITCH S21046 28040002 TM IEHESW1,VOLSW 28060002 BZ CVOLTEST 28080002 LH R7,PARAM4 28100002 LA R7,1(R7) COUNT THE ENTRIES IN THE LIST 28120002 STH R7,PARAM4 28140002 CLI VSRCM,X'00' DIRECT ACCESS DEVICE? 28160002 BE DATYPE YES....BRANCH 28180002 LA R3,10(R3) 28200002 ST R3,VOLISTAD SET POINTER TO DS SEQ NO. 28220002 B EOVLTEST 28240002 CVOLTEST TM VSRCM,X'01' 28260002 BZ STT1UP 28280002 LA LISTREG,BADCVOL 28300002 B ENT2FDLD 28320002 DATYPE MVI 11(R3),X'00' 28340002 LA R3,12(R3) 28360002 ST R3,VOLISTAD SET POINTER TOO NEXT VOL I.D. 28380002 * 28400002 EOVLTEST LH R5,VOLPAREN 28420002 LTR R5,R5 TEST FOR END OF VOLUME LIST 28440002 BNE UPSTART NOT END...BRANCH 28460002 NI IEHESW1,X'FD' RESET THE VOL SWITCH 28480002 L R2,IEHEFND 28500002 CLI 1(R2),C',' 28520002 BNE STT1UP 28540002 LA R2,2(R2) 28560002 ST R2,IEHESTT 28580002 B KODECODE 28600002 STT1UP L R5,IEHEFND 28620002 LA R5,1(R5) UP THE START ADDRESS FOR SCAN 28640002 ST R5,IEHESTT 28660002 B KODECODE GO GET A KEYWORD 28680002 * 28700002 VOLDTTLU LM R2,R3,IEHECHAR 28720002 EX R2,MVCTYPE PAD DEVICE TYPE WITH BLANKS 28740002 LA R2,MSGOUT+4 POINT AT WORK AREA FOR TLU 28760002 MVC 20(4,R2),DECB2+4 SET UP RETURN V ADCON DT0I 28780002 L 15,TLUADDR GET ADDRESS OF TLU ROUTINE 28800002 BALR 14,15 BE GONE 28820002 OC 8(4,R2),8(R2) TEST FOR A FIND 28840002 BZ BADTYPE BAD GENERIC TYPE CODE A35899 28860002 MVC PASSUNIT(5),12(R2) PASS SPECIFIC UNIT TO DT0I 28880002 * VOLUME MOUNTING ROUTINE DT0I 28900002 VOLDTFND MVC VDTIU(4),8(R2) SAVE THE DEVICE CODE 28920002 LA R2,VMATRIX2 28940002 ST R2,MATRIXIU SWITCH THE CONTROLLING MATRIX 28960002 MVI VSRCM,X'01' SET CONTROL BYTE TO 28980002 MVI VSRCM+1,X'01' INDICATE A SEQUENTIAL DEVICE 29000002 TM VDTIU+2,X'20' IS IT DIRECT ACCESS 29020002 BZ *+10 NO.....BRANCH 29040002 XC VSRCM(2),VSRCM SET CONTROL TO DIRECT ACCESS 29060002 MVC MSGOUT+1(119),MSGOUT CLEAR THE PRINT AREA 29080002 UPSTART L R2,IEHEFND GENERSTE 29100002 LA R2,1(R2) A NEW START ADDRESS FOR SCAN 29120002 ST R2,IEHESTT PASS IT 29140002 MVC VDSA(1),IEHECODE 29160002 B VOLSCAN 29180002 * 29200002 VRPAREN LH R4,VOLPAREN 29220002 BCTR R4,0 DECREASE PAREN COUNT 29240002 STH R4,VOLPAREN 29260002 LTR R4,R4 29280002 BM VLISTERR ERROR IF COUNT IS NEGATIVE 29300002 CLI IEHEARGL,X'FF' 29320002 BE VRPARZL BRANCH IF LENGTH IS ZERO 29340002 CLI VDSA,X'04' WAS THE LAST DELIMITER A ( 29360002 BE SELECTOR 29380002 CLI VDSA,X'02' WAS PREVIOUS DELIMITER A , 29400002 BNE VLISTERR NO.....BRANCH 29420002 B SELECTOR 29440002 VRPARZL CLI VDSA,X'05' WAS PREVIOUS DELIMITER A ) 29460002 BE EOVLTEST YES....BRANCH 29480002 CLI VDSA,X'02' WAS PREVIOUS DELIMITER A COMMA 29500002 BNE VLISTERR NO.....BRANCH 29520002 B SEQNUM1 29540002 VCOMZL CLI VDSA,X'05' WAS PREVIOUS DELIMITER A ) 29560002 BE UPSTART YES....BRANCH 29580002 CLI VDSA,X'02' WAS PREVIOUS DELIMITER A , 29600002 BNE VLISTERR NO.....BRANCH 29620002 SEQNUM1 EX 0,SELECTOR IS IT A VOLUME ID MISSING 29640002 BZ VLISTERR YES....BRANCH 29660002 LA R6,1 ASSUME A SEQUENCE NO. OF 1 29680002 B SEQ2LIST GO PUT IT INTO THE LIST 29700002 * 29720002 * 29740002 AD2PAREN LH R4,VOLPAREN 29760002 LA R4,1(R4) ADD ONE TO PAREN COUNT 29780002 STH R4,VOLPAREN 29800002 B UPSTART 29820002 * 29840002 * 29860002 VLISTERR LA PARAMREG,10 29880002 L LINKREG,SEVER8 GO TO CONDITION CODE A25564 29900002 BALR RETURN,LINKREG HANDLER A25564 29920002 B GOAGAIN 29940002 GETAVOL BAL R8,*+4 29960002 TM IEHESW5,X'01' TEST SW5 FOR PREVIOUS 29980002 BCR 1,R8 ENTRY TO THIS ROUTINE 30000002 OI IEHESW5,X'01' TO PREVENT MULTIPLE OVERLAYS 30020002 L LINKREG,MOUNTRTN GO GET REQUIRED 30040002 BALR RETURN,LINKREG VOLUMES MOUNTED 30060002 BADTYPE EQU * ENTER FOR BAD GENERIC TYPEA35899 30080002 L LINKREG,SEVER8 GO TO CONDITION CODE A25564 30100002 BALR RETURN,LINKREG HANDLER A25564 30120002 CNOP 0,4 30140002 BAL LISTREG,ENT2FDLD 30160002 DC FL1'6' 30180002 DC FL3'37' INFORM THE USER 30200002 DC FL1'6' THAT THE REQUIRED 30220002 DC FL1'1' VOLUMES COULD NOT 30240002 DC FL2'50' BE MOUNTED 30260002 DC FL1'4' 30280002 DC AL3(ABEOJ+4) EXIT 30300002 DS 0F 30320002 VOLDECAD EQU *-4 30340002 DC A(VLISTERR) 30360002 DC A(VOLDTTLU) 30380002 DC A(AD2PAREN) 30400002 DC A(VRPAREN) 30420002 DC A(SELECTOR) 30440002 DC A(VCOMZL) 30460002 MVCVOL MVC 4(1,R3),0(R5) 30480002 PRTCTVOL MVC ZERODSP(ONEBYTE,R8),ZERODSP(R5) S21046 30500002 * MOVE FOR PROTECT VOL ID S21046 30520002 MVCSEQ MVC 0(1,R3),0(R5) 30540002 MVCTYPE MVC MSGOUT+4(1),0(R3) PUT NAME IN WORK AREA 30560002 VCBPAD DC CL6' ' 30580002 DC FL2'1' 30600002 VMATRIX1 EQU *-2 30620002 DC X'01010301010102010101' 30640002 VMATRIX2 EQU *-2 30660002 DC X'06010304010502010405' 30680002 COMBLANK DC CL8' , ' 30700002 QUOTE DC X'7D40404040404040' CODELIST FOR QUOTE S21046 30720002 AQUOTE DC XL2'7D80' SCAN FOR ONLY A QUOTE S21046 30740002 SLASHAST DC CL2'/*' '...SLASH ASTERICK...' 30760002 BLDXBITS DC XL4'04400000' 30780002 BLANKEQU DC XL2'4080' 30800002 NOTBLANK DC XL2'4070' 30820002 ANYSPEC DC XL2'7FD0' 30840002 ENDSWOFF EQU 127 30860002 DS 0F 30880002 TABLEADS EQU *-8 30900002 DC A(TABLEN3) ADDRESSES OF TABLES USED 30920002 DC A(TABLEN4) BY THE TLU ROUTINE 30940002 DC A(TABLEN5) 30960002 DC A(TABLEN6) 30980002 DC A(TABLEN7) 31000002 DC A(TABLEN8) 31020002 DC A(TABLEN9) 31040002 TLUADDR DC V(IEHPROGA) ADDRESS OF TLU ROUTINE M2838 31060002 DLTASWAP MVC PARAM2-1(45),PARAM4-1 CORRECT POSITION OF ALIAS NAME 31080002 IEHPROGB CSECT M2838 31100002 TABLEN1 DS 0F THIS TABLE FOR TESTING ONLY 31120002 TABLEN2 DS 0F 31140002 TABLEN3 DC X'0309' THREE ENTRIES IN TABLE S21046 31160002 DC C'ADD' ADD OPERATION S21046 31180002 DC X'0300' INDICATES OPERATION S21046 31200002 DC AL4(ADD) ADDRESS OF ADD CODE S21046 31220002 DC C'VOL' 31240002 DC X'0104' 31260002 DC AL4(VOL) 31280002 DC C'SYS' 31300002 DC X'0200' 31320002 DC AL4(SYS) 31340002 TABLEN4 DC X'0A0A' TEN ENTRIES IN TABLE @Z40CSJH 31360004 DC C'LIST' SEARCH ARGUMENT FOR LIST S21046 31380002 DC X'0300' INDICATES OPERATION S21046 31400002 DC AL4(LIST) ADDRESS OF THE LIST CODE S21046 31420002 DC C'TYPE' SEARCH ARGUMENT FOR TYPE S21046 31440002 DC X'0100' INDICATES OPERAND S21046 31460002 DC AL4(TYPE) ADDRESS OF TYPE CODE S21046 31480002 DC C'DATA' SEARCH ARGUMENT FOR DATA S21046 31500002 DC X'0100' INDICATES OPERAND S21046 31520002 DC AL4(DATA) ADDRESS OF DATA CODE S21046 31540002 DC C'BLDG' @Z40CSJH 31560004 DC X'0300' @Z40CSJH 31580004 DC AL4(BLDG) @Z40CSJH 31600004 DC C'CVOL' 31620002 DC X'0103' 31640002 DC AL4(CVOL) 31660002 DC C'VTOC' 31680002 DC X'0202' 31700002 DC AL4(VTOC) 31720002 DC C'BLDX' @Z40CSJH 31740004 DC X'0300' @Z40CSJH 31760004 DC AL4(BUILDX) @Z40CSJH 31780004 DC C'DLTX' @Z40CSJH 31800004 DC X'0300' @Z40CSJH 31820004 DC AL4(DELETEX) @Z40CSJH 31840004 DC C'BLDA' @Z40CSJH 31860004 DC X'0300' @Z40CSJH 31880004 DC AL4(BUILDA) @Z40CSJH 31900004 DC C'DLTA' @Z40CSJH 31920004 DC X'0300' @Z40CSJH 31940004 DC AL4(DELETEA) @Z40CSJH 31960004 TABLEN5 DC X'050B' FIVE ENTRIES IN TABLE @Z40CSJH 31980004 DC C'EMPTY' @Z40CSJH 32000004 DC X'0200' @Z40CSJH 32020004 DC AL4(EMPTY) @Z40CSJH 32040004 DC C'CATLG' YL026VC 32060002 DC X'0300' YL026VC 32080002 DC AL4(CATALOG) YL026VC 32100002 DC C'INDEX' @Z40CSJH 32120004 DC X'0102' @Z40CSJH 32140004 DC AL4(INDEX) @Z40CSJH 32160004 DC C'ALIAS' @Z40CSJH 32180004 DC X'0104' @Z40CSJH 32200004 DC AL4(ALIAS) @Z40CSJH 32220004 DC C'PURGE' 32240002 DC X'0200' 32260002 DC AL4(PURGE) 32280002 TABLEN6 DC X'040C' FOUR ENTRIES IN TABLE @Z40CSJH 32310004 DC C'MEMBER' 32320002 DC X'0105' 32340002 DC AL4(MEMBER) 32360002 DC C'DSNAME' 32380002 DC X'0102' 32400002 DC AL4(DSNAME) 32420002 DC C'DELETE' @Z40CSJH 32440004 DC X'0200' @Z40CSJH 32460004 DC AL4(DELETE) @Z40CSJH 32480004 DC C'RENAME' 32500002 DC X'0300' 32520002 DC AL4(RENAME) 32540002 TABLEN7 DC X'080D' EIGHT ENTRIES IN TABLE @Z40CSJH 32560004 DC C'REPLACE' SEARCH ARGUMENT FOR REPLACE S21046 32580002 DC X'0300' INDICATES OPERATION S21046 32600002 DC AL4(REPLACE) ADDRESS OF REPLACE CODE S21046 32620002 DC C'DELETEP' SEARCH ARGUMENT FOR DELETEP S21046 32640002 DC X'0300' INDICATES OPERATION S21046 32660002 DC AL4(DELETEP) ADDRESS OF DELETEP CODE S21046 32680002 DC C'ENTRIES' @Z40CSJH 32700004 DC X'0104' @Z40CSJH 32720004 DC AL4(ENTRIES) @Z40CSJH 32740004 DC C'UNCATLG' YL026VC 32760002 DC X'0300' YL026VC 32780002 DC AL4(UNCATLG) YL026VC 32800002 DC C'CONNECT' @Z40CSJH 32820004 DC X'0300' @Z40CSJH 32840004 DC AL4(CONNECT) @Z40CSJH 32860004 DC C'RELEASE' @Z40CSJH 32880004 DC X'0300' @Z40CSJH 32900004 DC AL4(RELEASE) @Z40CSJH 32920004 DC C'SCRATCH' 32940002 DC X'0300' 32960002 DC AL4(SCRATCH) 32980002 DC C'NEWNAME' 33000002 DC X'0103' 33020002 DC AL4(NEWNAME) 33040002 TABLEN8 DC X'030E' THREE ENTRIES S21046 33060002 DC C'PASWORD1' SEARCH ARGUMENT FOR PASWORD1 S21046 33080002 DC X'0103' INDICATES OPERAND S21046 33100002 DC AL4(PASWORD1) ADDRESS OF PASWORD1 CODE S21046 33120002 DC C'PASWORD2' SEARCH ARGUMENT FOR PASWORD2 S21046 33140002 DC X'0106' INDICATES OPERAND S21046 33160002 DC AL4(PASWORD2) ADDRESS OF PASWORD2 CODE S21046 33180002 DC C'CPASWORD' SEARCH ARGUMENT FOR CPASWORD S21046 33200002 DC X'0104' INDICATES OPERAND S21046 33220002 DC AL4(CPASWORD) ADDRESS OF CPASWORD CODE S21046 33240002 TABLEN9 EQU TABLEN1 33260002 CATALOG DS 0F 33280002 DC FL2'256' LIST INITIALIZE 33300002 DC BL2'0111000000000001' CVOL,VOL,DSNAME,ALPHABET A28552 33320002 DC BL4'00100100000000000000000000000000' CATALOG 33340002 * 33360002 * THIS IS FOR TEST BEFORE WE CALL THE MACRO 33380002 * 33400002 DC FL1'2' TEST DUP SWITCH FOR 33420002 DC FL1'0' 33440002 DC BL1'01010000' DSNAME - VOLUME LIST 33460002 DC FL1'12' BRANCH CONDITION ZERO OR ONE 33480002 DC FL1'4' 33500002 DC AL3(BADCAT) 33520002 DC X'08000000' READ ALL CONTINUE CARDS 33540002 DC FL1'10' 33560002 DC FL3'1' 33580002 * 33600002 * -----UNCATALOG----- 33620002 * 33640002 UNCATLG DS 0F 33660002 DC FL1'1' 33680002 DC FL1'0' 33700002 DC BL2'0101000000000000' ALLOW DSNAME AND CVOL 33720002 DC BL4'00001100000000000000000000000000' 33740002 DC FL1'2' 33760002 DC FL1'0' 33780002 DC BL1'01000000' 33800002 DC FL1'8' 33820002 DC FL1'4' 33840002 DC AL3(BADCAT) 33860002 DC X'08000000' READ ALL CONTINUE CARDS 33880002 DC FL1'10' 33900002 DC FL3'2' 33920002 IEHPROGC CSECT M2838 33940002 * 33960002 * -----DELETE INDEX----- 33980002 * 34000002 DELETEX DS 0F 34020002 DC FL1'1' 34040002 DC FL1'0' 34060002 DC BL2'1100000000000000' 34080002 DC BL4'00000100000001000000000000000000' 34100002 DC FL1'2' TEST DUP SWITCH 34120002 DC FL1'0' 34140002 DC BL1'01000000' FOR INDEX 34160002 DC FL1'8' 34180002 DC FL1'4' 34200002 DC AL3(BADINDX) EXIT IF INDEX NOT SUPPLIED 34220002 DC X'08000000' READ ALL CONTINUE CARDS 34240002 DC FL1'10' 34260002 DC FL3'3' 34280002 * 34300002 * -----CONNECT ----- 34320002 * 34340002 CONNECT DS 0F 34360002 DC FL1'1' 34380002 DC FL1'0' 34400002 DC BL2'1110000000000000' 34420002 DC BL4'00000100000010000000000000000000' 34440002 DC FL1'2' 34460002 DC FL1'0' 34480002 DC BL1'01010000' 34500002 DC FL1'12' 34520002 DC FL1'4' 34540002 DC AL3(BADINDX) 34560002 DC X'08000000' READ ALL CONTINUE CARDS 34580002 DC FL1'10' 34600002 DC FL3'4' 34620002 * 34640002 * ------ RELEASE ------ 34660002 * 34680002 RELEASE DS 0F 34700002 DC FL1'1' 34720002 DC FL1'0' 34740002 DC BL2'1100000000000000' 34760002 DC BL4'00000100000000001000000000000000' 34780002 DC FL1'2' 34800002 DC FL1'0' 34820002 DC BL1'01000000' TEST FOR INDEX 34840002 DC FL1'12' 34860002 DC FL1'4' 34880002 DC AL3(BADINDX) 34900002 DC X'08000000' READ ALL CONTINUE CARDS 34920002 DC FL1'10' 34940002 DC FL3'5' 34960002 * 34980002 * ----- BUILD ALIAS ----- 35000002 * 35020002 BUILDA DS 0F 35040002 DC FL1'1' 35060002 DC FL1'0' 35080002 DC BL2'1100001000000001' INDEX,CVOL,ALIAS,ALPHABET A28552 35100002 DC BL4'01000100000100000000000000000000' 35120002 DC FL1'2' 35140002 DC FL1'0' 35160002 DC BL1'01010000' 35180002 DC FL1'12' 35200002 DC FL1'4' 35220002 DC AL3(BADINDX) 35240002 DC X'08000000' READ ALL CONTINUE CARDS 35260002 DC FL1'10' 35280002 DC FL3'6' 35300002 * 35320002 * ----- DELETE ALIAS ----- 35340002 * 35360002 DELETEA DS 0F 35380002 DC FL1'1' 35400002 DC FL1'0' 35420002 DC BL2'0100001000000000' 35440002 DC BL4'00000100000000010000000000000000' 35460002 DC FL1'7' 35480002 DC AL3(DLTASWAP) 35500002 DC FL1'2' 35520002 DC FL1'0' 35540002 DC BL1'00010000' 35560002 DC FL1'8' 35580002 DC FL1'4' 35600002 DC AL3(BADINDX) 35620002 DC X'08000000' READ ALL CONTINUE CARDS 35640002 DC FL1'10' 35660002 DC FL3'7' 35680002 * 35700002 * ----- SCRATCH ----- 35720002 * 35740002 SCRATCH DS 0F 35760002 DC FL2'256' ONE OP 35780002 DC BL2'0011010100000000' DSNAME VTOC VOL PURGE 35800002 DC BL4'00000001000000000100000000000000' SET SCRATCH 35820002 DC FL1'2' 35840002 DC FL1'0' 35860002 DC BL1'01010000' TEST 4 DSNAME & VOLUME 35880002 DC FL1'12' 35900002 DC FL1'4' 35920002 DC AL3(BADSCR) 35940002 DC X'08000000' READ ALL CONTINUE CARDS 35960002 DC FL1'10' 35980002 DC FL3'8' 36000002 * 36020002 * ----- BUILDX ----- 36040002 * 36060002 BUILDX DS 0F 36080002 DC FL2'256' OP CODE 1 36100002 DC BL2'1100000000000001' INDEX,CVOL,CHECK ALPHA A28552 36120002 DC BL4'00000100010000000000000000000000' SET BUILDX 36140002 DC FL1'2' TEST DUP SWITCH 36160002 DC FL1'0' 36180002 DC BL1'01000000' FOR INDEX 36200002 DC FL1'8' 36220002 DC FL1'4' 36240002 DC AL3(BADINDX) 36260002 DC X'08000000' READ ALL CONTINUE CARDS 36280002 DC FL1'10' 36300002 DC FL3'9' 36320002 * 36340002 * ----- RENAME ----- 36360002 * 36380002 RENAME DS 0F 36400002 DC FL1'1' 36420002 DC FL1'0' 36440002 DC BL2'0011100000000000' DSNAME, NEWNAME, VOL A42349 36460002 DC BL4'00000001000000000010000000000000' RENAME 36480002 DC FL1'2' 36500002 DC FL1'0' 36520002 DC BL1'01110000' 36540002 DC FL1'12' 36560002 DC FL1'4' 36580002 DC AL3(BADRENAM) 36600002 DC X'08000000' READ ALL CONTINUE CARDS 36620002 DC FL1'10' 36640002 DC FL3'10' 36660002 * S21046 36680002 * ---- ADD ---- S21046 36700002 * S21046 36720002 ADD DS 0F S21046 36740002 DC FL1'12' INITIALIZE PARAMETER LIST S21046 36760002 DC FL3'0' FILLER S21046 36780002 DC FL2'256' SET PPARAMSW AND IEHEMAC1 S21046 36800002 * ALLOW TYPE, DATA, VOL, DSNAME, PASWORD2, CPASWORD S21046 36820002 DC BL2'0011000001011101' S21046 36840002 DC BL4'00000000000000000000000000000000' IEHEMAC1 S21046 36860002 DC FL1'13' PUT DSNAME LENGTH IN PARM S21046 36880002 DC FL3'0' FILLER S21046 36900002 DC FL1'2' TEST FOR DUPLICATE PARMS S21046 36920002 DC FL1'0' FILLER S21046 36940002 DC BL1'01000000' MASK FIELD S21046 36960002 DC FL1'12' SET CONDITION CODE S21046 36980002 DC FL1'4' FOR BAD ADD OPERATION S21046 37000002 DC AL3(BADADD) ADDRESS OF ERROR ROUTINE S21046 37020002 DC X'08000000' READ ALL CONTINUE CARDS S21046 37040002 DC FL1'10' BRANCH TO CALL PROPER ROUTINE S21046 37060002 DC FL3'14' TABLE NUMBER 14 S21046 37080002 * S21046 37100002 * ---- DELETEP ---- S21046 37120002 * S21046 37140002 DELETEP DS 0F S21046 37160002 DC FL1'12' INITIALIZE PARAMETER LIST S21046 37180002 DC FL3'0' FILLER S21046 37200002 DC FL2'256' SET PPARAMSW AND IEHEM&C S21046 37220002 * ALLOW PASWORD1, CPASWORD, VOL AND DSNAME S21046 37240002 DC BL2'0011000000100100' PPARAMSW S21046 37260002 DC BL4'00000000000000000000000000000000' IEHEMAC1 S21046 37280002 DC FL1'13' PUT DSNAME LENGTH IN PARM S21046 37300002 DC FL3'0' FILLER S21046 37320002 DC FL1'2' TEST FOR DUPLICATE PARMS S21046 37340002 DC FL1'0' FILLER S21046 37360002 DC BL1'01000000' MASK FIELD S21046 37380002 DC FL1'12' SET CONDITION CODE S21046 37400002 DC FL1'4' FOR BAD DELETEP OPERATION S21046 37420002 DC AL3(BADDEL) BAD DELETEP OPERATION S21046 37440002 DC X'08000000' READ ALL CONTINUE CARDS S21046 37460002 DC FL1'10' BRANCH TO CALL PROPER ROUTINE S21046 37480002 DC FL3'15' TABLE NUMBER 15 S21046 37500002 * S21046 37520002 * ---- REPLACE ---- S21046 37540002 * S21046 37560002 REPLACE DS 0F S21046 37580002 DC FL1'12' INITIALIZE PARAMETER LIST S21046 37600002 DC FL3'0' FILLER S21046 37620002 DC FL2'256' SET PPARAMSW AND IEHEM&C S21046 37640002 * ALLOW TYPE, DATA, VOL, DSNAME, PASWORD2, CPASWORD, AND PASWO S21046 37660002 * AND DSNAME S21046 37680002 DC BL2'0011000001111101' S21046 37700002 DC BL4'00000000000000000000000000000000' IEHEMAC1 S21046 37720002 DC FL1'13' PUT DSNAME LENGTH IN PARM S21046 37740002 DC FL3'0' FILLER S21046 37760002 DC FL1'2' TEST FOR DUPLICATE PARMS S21046 37780002 DC FL1'0' FILLER S21046 37800002 DC BL1'01000000' MASK FIELD S21046 37820002 DC FL1'12' SET THE CONDITION CODE S21046 37840002 DC FL1'4' CODE WILL BE FOUR S21046 37860002 DC AL3(BADREP) BAD REPLACE OPERATION S21046 37880002 DC X'08000000' READ ALL CONTINUE CARDS S21046 37900002 DC FL1'10' BRANCH TO CALL PROPER ROUTINE S21046 37920002 DC FL3'16' TABLE NUMBER 16 S21046 37940002 * S21046 37960002 * ---- LIST ---- S21046 37980002 * S21046 38000002 LIST DS 0F S21046 38020002 DC FL1'12' INITIALIZE PARAMETER LIST S21046 38040002 DC FL3'0' FILLER S21046 38060002 DC FL2'256' SET PPARAMSW AND IEHEM&C S21046 38080002 * ALLOW PASWORD1, DSNAME S21046 38100002 DC BL2'0001000000100000' PPARAMSW S21046 38120002 DC BL4'00000000000000000000000000000000' IEHEMAC1 S21046 38140002 DC FL1'13' PUT DSNAME LENGTH IN PARM S21046 38160002 DC FL3'0' FILLER S21046 38180002 DC FL1'2' TEST FOR DUPLICATE PARMS S21046 38200002 DC FL1'0' FILLER S21046 38220002 DC BL1'01000000' MASK FIELD S21046 38240002 DC FL1'12' GO SET THE CONDITION CODE S21046 38260002 DC FL1'4' CODE WILL BE FOUR FOR A S21046 38280002 DC AL3(BADLIST) BAD LIST OPERATION S21046 38300002 DC X'08000000' READ ALL CONTINUE CARDS S21046 38320002 DC FL1'10' BRANCH TO CALL PROPER ROUTINE S21046 38340002 DC FL3'17' TABLE NUMBER 17 S21046 38360002 * 38380002 IEHPROG6 CSECT M2838 38400002 XTRADATA DS 0F 38420002 DC X'0B000000' SET CONDITION CODE AND A25564 38440002 * READ ALL CONTINUE CARDS A25564 38460002 DC FL1'6' WRITE REDUNDANT INFO MSG 38480002 DC FL3'14' 38500002 DC FL1'4' 38520002 DC AL3(ABEOJ) 38540002 * 38560002 TRTTABLE EQU * A24020 38580002 DC 64X'04' A24020 38600002 BLANKS DC X'08' A24020 38620002 DC 15X'04' A24020 38640002 ANDSIGN DC X'00' A24020 38660002 DC 10X'04' A24020 38680002 DOLLAR DC X'00' A24020 38700002 DC 4X'04' A24020 38720002 DASH DC X'00' A24020 38740002 DC 26X'04' A24020 38760002 LBSIGN DC X'00' A24020 38780002 ATSIGN DC X'00' A24020 38800002 DC 67X'04' 38820002 TWLVZERO DC X'00' 38840002 ALPHA1 DC 9X'00' A24020 38860002 DC 7X'04' A24020 38880002 ALPHA2 DC 9X'00' A24020 38900002 DC 8X'04' A24020 38920002 ALPHA3 DC 8X'00' A24020 38940002 DC 6X'04' A24020 38960002 NUMBERS DC 10X'00' A24020 38980002 DC 6X'04' A24020 39000002 VOLTEST TM IEHEMAC1,X'40' TEST IF VOL PARM IS PRESENT 39020002 BO FDLD YES, GO GET NEXT PARM 39040002 BAL LISTREG,ENT2FDLD 39060002 BADINDX DS 0F 39080002 BADCAT DS 0F 39100002 BADSCR DS 0F 39120002 BADRENAM DS 0F 39140002 BADADD DS 0F BAD ADD TABLE S21046 39160002 BADDEL DS 0F BAD DELETE TABLE S21046 39180002 BADREP DS 0F BAD REPLACE TABLE S21046 39200002 BADLIST DS 0F BAD LIST TABLE S21046 39220002 DC X'0B000000' SET CONDITION CODE AND A25564 39240002 * READ ALL CONTINUE CARDS A25564 39260002 DC FL1'6' 39280002 DC FL1'1' 39300002 DC FL2'14' 39320002 DC FL1'6' 39340002 DC FL2'45' 39360002 DC FL1'15' 39380002 ABEOJ DC FL1'6' 39400002 DC FL1'1' 39420002 DC FL2'16' 39440002 DC FL1'6' 39460002 DC FL1'2' 39480002 DC FL2'17' 39500002 DC X'09000000' 39520002 BADCVOL EQU * A25564 39540002 DC X'0B000000' SET CONDITION CODE AND A25564 39560002 * READ ALL CONTINUE CARDS A25564 39580002 DC FL1'6' 39600002 DC FL2'0' 39620002 DC FL1'19' 39640002 DC FL1'4' 39660002 DC AL3(ABEOJ) 39680002 DS 0F 39700002 OKEND BAL LISTREG,ENT2FDLD 39720002 NORMEND EQU * 39740002 DC FL1'6' SELECT A MESSAGE 39760002 DC FL1'1' SUPPRESS PRINT 39780002 DC FL2'9' MSG NUM = 9 39800002 DC FL1'6' 39820002 DC FL2'33' INSERT FUNCTION NAME 39840002 DC FL1'5' AND WRITE THE MSG 39860002 DC X'09000000' 39880002 DS 0F 39900002 NOVOL BAL LISTREG,ENT2FDLD 39920002 VOLREM EQU * 39940002 DC X'0B000000' SET CONDITION CODE AND A25564 39960002 * READ ALL CONTINUE CARDS A25564 39980002 DC FL1'6' 40000002 DC FL1'1' SELECT AND SUPPRESS 40020002 DC FL2'11' MESSAGE 11 40040002 DC FL1'6' 40060002 DC FL2'54' ADD MSG 17 AND WRITE 40080002 DC FL1'17' 40100002 DC X'09000000' 40120002 * 40140002 * FOR THE HANDLING OF UNKNOWN ERRORS...... 40160002 * 40180002 DS 0F 40200002 UNKERR BAL LISTREG,ENT2FDLD 40220002 OVERSIZE EQU * 40240002 DC X'0B000000' SET CONDITION CODE AND A25564 40260002 * READ ALL CONTINUE CARDS A25564 40280002 DC FL1'6' 40300002 DC FL3'12' INFORM THE USER OF AN ERROR 40320002 DC FL1'6' AND THE UNDEFINED CODE 40340002 DC FL1'1' 40360002 DC FL2'4' 40380002 DC FL1'4' 40400002 DC AL3(ABEOJ+4) 40420002 IEHPROGE EQU * M2838 40440002 BALR R2,0 40460002 USING *,R2 40480002 DROP RB2 DON'T WANT RB2 USED AS BASE S21046 40500002 * REG ON THE LOAD OF SCANBASE S21046 40520002 L RB,SCANBASE RESET THE BASE REGISTER 40540002 LA RB2,OFFSET1K(RB) SET UP BASE REGISTER S21046 40560002 DROP R2 40580002 USING IEHESCAN+KPLUS2,RB2 SET UP ADDRESSABILITY S21046 40600002 LA R2,UTOUTDCB TEST FOR THE DCB THAT 40620002 CR 1,R2 CAUSED THIS ENTRY 40640002 BL SYNAD002 SYNAD FROM SYSIN 40660002 BE SYNAD003 SYNAD FROM SYSPRINT 40680002 BH SYNAD004 SYNAD FROM THE VTOC 40700002 SYNAD002 EQU * A25564 40720002 L LINKREG,SEVER12 GO TO CONDITION CODE A25564 40740002 BALR RETURN,LINKREG HANDLER A25564 40760002 LA PARAMREG,53 WRITE SYSIN ERROR MSG 40780002 B EOJ 40800002 SYNAD003 EQU * A25564 40820002 L LINKREG,SEVER12 GO TO CONDITION CODE A25564 40840002 BALR RETURN,LINKREG HANDLER A25564 40860002 LA PARAMREG,51 WTO SYSPRINT ERROR MSG 40880002 B EOJ 40900002 SYNAD004 CLOSE ((R2)) CLOSE THE VTOC 40920002 ORG *-18 40940002 LR R2,1 R2 POINT AT THE DCB 40960002 LA 1,DBLWORD REG 1 POINT AT A WORD 40980002 NOPR 0 41000002 ORG 41020002 NI CTRLWORD,X'EF' RESET OPEN VTOC SWITCH 41040002 L LINKREG,SEVER12 GO TO CONDITION CODE A25564 41060002 BALR RETURN,LINKREG HANDLER A25564 41080002 LA PARAMREG,54 WRITE SYNAD ON VTOC A25564 41100002 B GOAGAIN GET THE NEXT REQUEST A25564 41120002 *THE FOLLOWING CODE DEALS WITH ERROR CONDITION CODES. THE CODE A25564 41140002 *INSURES THAT A HIGHER CONDITION CODE WILL NOT BE OVERRIDDEN BY A25564 41160002 * LOWER CONDITION CODE. A25564 41180002 CODEOF4 EQU * A25564 41200002 CLI ERRFLD+2,X'04' PRESENT CONDITION CODE A25564 41220002 * HIGHER THAN OR EQUAL TO 4 A25564 41240002 BC 11,EXIT YES, RETURN A25564 41260002 MVI ERRFLD+2,X'04' NO, POST ERROR CODE OF 4 A25564 41280002 BR RETURN A25564 41300002 CODEOF8 EQU * A25564 41320002 CLI ERRFLD+2,X'08' PRESENT CONDITION CODE A25564 41340002 * HIGHER THAN OR EQUAL TO 8?A25564 41360002 BC 11,EXIT YES, RETURN A25564 41380002 MVI ERRFLD+2,X'08' NO, POST ERROR CODE OF 8 A25564 41400002 EXIT EQU * A25564 41420002 BR RETURN A25564 41440002 CODEOF12 EQU * A25564 41460002 CLI ERRFLD+2,X'12' PRESENT CONDITION CODE A25564 41480002 * HIGHER THAN OR EQUAL TO 12A25564 41500002 BC 11,EXIT YES, RETURN A25564 41520002 MVI ERRFLD+2,X'0C' NO, POST ERROR CODE OF 12 @ZA13755 41540099 BR RETURN A25564 41560002 B GOAGAIN GET THE NEXT REQUEST 41580002 IEHPROGD EQU * M2838 41600002 TM MOUNTSW,ERRSW IS CONTINUATION CARD A23466 41620002 * EXPECTED A23466 41640002 BC 8,VALIDEND NO, GO WRITE FINAL A23466 41660002 * MESSAGE A23466 41680002 NI MOUNTSW,CLEAROUT TURN ERROR INDICATION A23466 41700002 * OFF A23466 41720002 LA PARAMREG,57 PUT MESSAGE NUMBER INTO A23466 41740002 * REGISTER 0 A23466 41760002 MVI MSGOUT,C' ' CLEAR MESSAGE AREA A23466 41780002 MVC MSGOUT+1(119),MSGOUT A23466 41800002 L LINKREG,MSGRTNAD A23466 41820002 BALR RETURN,LINKREG WRITE ERROR MESSAGE A23466 41840002 L LINKREG,SEVER8 GO TO CONDITION CODE A25564 41860002 BALR RETURN,LINKREG HANDLER A25564 41880002 VALIDEND EQU * A23466 41900002 LA PARAMREG,31 WRITE UTILITY END A23466 41920002 EOJ EQU * A23466 41940002 L LINKREG,MSGRTNAD A23466 41960002 BALR RETURN,LINKREG GO WRITE OUR FINAL MSG 41980002 DELETE EP=DEVNAMET DELETE DEVICE NAME TABLE I276 42000002 LA R5,CLOSE 42020002 LA R2,UTINDCB CLOSE SYSIN 42040002 BALR R4,R5 42060002 LA R2,UTOUTDCB CLOSE SYSPRINT 42080002 BALR R4,R5 42100002 FREEPOOL UTOUTDCB FREE UNUSED BUFFER SPACE A34996 42120002 TM CTRLWORD,X'10' IS THE VTOC OPEN 42140002 BZ FREEMAIN NO .... BRANCH 42160002 LA R2,DCB4VTOC 42180002 BALR R4,R5 CLOSE THE VTOC 42200002 FREEMAIN L 13,CTRLWORD POINT TO ORIGINAL SAVE AREA 42220002 LA 13,0(13) CLEAR HIGH ORDER BYTE @ZA11944 42230099 SR R2,R2 42240002 IC R2,ERRFLD+2 42260002 LR 1,RBD 42280002 LA ZERO,DSECTSZE S21046 42300002 SLL ZERO,1 8429 42320002 FREEMAIN R,LV=(0),A=(1) RETURN OUR CORE TO THE SUPERVISOR 8429 42340002 LR 15,R2 42360002 RETURN (14,12),RC=(15) BACK TO THE CALLING PROGRAM 42380002 CLOSE CLOSE ((R2)) 42400002 ORG *-18 42420002 LA 1,DBLWORD CLOSE THE DCB IN R2 42440002 NOP 0 42460002 ORG 42480002 BR R4 RETURN 42500002 * 42520002 AREAONE DS F SAVEAREA OF REGISTER 1 A24020 42540002 AREATWO DS F SAVEAREA OF REGISTER 2 A24020 42560002 AREAFIVE DS F SAVEAREA OF REGISTER 5 A24020 42580002 AREASIX DS F SAVEAREA OF REGISTER 6 A24020 42600002 SCANAD DC A(IEHESCAN) 42620002 SEVER4 DC A(CODEOF4) ADCON TO RET CODE OF 4 A25564 42640002 * HANDLING ROUTINE A25564 42660002 SEVER8 DC A(CODEOF8) ADCON TO RET CODE OF 8 A25564 42680002 * HANDLING ROUTINE A25564 42700002 SEVER12 DC A(CODEOF12) ADCON TO RET CODE OF 12 A25564 42720002 * HANDLING ROUTINE A25564 42740002 SCANBASE DC A(IEHESCAN+2) 42760002 ADVTOCDC DC A(VTOCDCS) 42780002 NOTVALID EQU 5 42800002 MSGRTNAD DC V(IEHPROG3) LOC OF MESSAGE ROUTINE M2838 42820002 INVOCRTN DC V(IEHPROG4) LOC OF RTN TO OPEN INPUT/OUTPUT M2838 42840002 MOUNTRTN DC V(IEHPROG5) LOC OF VOLUME MOUNTING RTN M2838 42860002 SPECIALS DC C'.,=() ' 42880002 * 42900002 * 42920002 VTOCDCS DS 0F ALLIGN THE LIST 42940002 DC X'08000000' READ ALL CONTINUE CARDS 42960002 DC A(VOLTEST) GO TEST IF VOL PARM IS PRESENT 42980002 DC FL1'10' 43000002 DC FL3'11' 43020002 BLDG DS 0F 43040002 DC FL1'1' 43060002 DC FL1'0' 43080002 DC BL2'1100000010000001' INDEX,CVOL,CHECK ALPHA A28552 43100002 DC BL4'00000100001000000000000000000000' 43120002 DC X'08000000' READ ALL CONTINUE CARDS 43140002 DC FL1'2' 43160002 DC FL1'0' TEST FOR MINIMUM REQUIREMENTS 43180002 DC BL1'01000010' INDEX AND ENTRIES 43200002 DC FL1'12' 43220002 DC FL1'4' IF NOT BOTH PRESENT 43240002 DC AL3(BADINDX) GO TO BAD INDX 43260002 DC FL1'10' 43280002 DC FL3'12' 43300002 ENTRY IEHPROGD M2838 43320002 ENTRY IEHPROGE M2838 43340002 IEHPROGA CSECT M2838 43360002 USING *,15 43380002 USING NAME,2 43400002 STM 3,5,REGSAVE SAVE THE REGISTERS 43420002 L 3,TABLEAD GET ADDRESS OF TABLE 43440002 L 4,0(3) GET NUMBER OF TABLE ENTRIES 43460002 LA 3,4(3) POINT AT THE FIRST ENTRY 43480002 XC DEVICE(4),DEVICE INDICATE A NO FIND CONDITION 43500002 XC UNIT(5),UNIT CLEAR SPECIFIC UNIT NAME DT0I 43520002 LOOKUP CLC NAME(8),0(3) COMPARE THE NAMES 43540002 BNE CHECKEND BRANCH .... NO FIND 43560002 MVC DEVICE(4),8(3) POST THE FOUND DEVICE CODE 43580002 LA 4,1 FORCE AN END OF LOOP 43600002 CHECKEND LA 3,12(3) POINT AT THE NEXT ENTRY 43620002 BCT 4,LOOKUP 43640002 CLC DEVICE(4),ZEROCON HAS DEVICE BEEN FOUND DT0I 43660002 BC 7,DEVFOUND BRANCH ON YES DT0I 43680002 CLI IEHEARGL,UCBADDR IS ARG LENGTH EQUAL 3 A35899 43700002 BNE DEVFOUND IF NOT GET OUT A35899 43720002 L R3,16 GET UCBLUT PTR DT0I 43740002 L R3,40(R3) DT0I 43760002 UCB EQU * @30AAAG 43780003 SR R4,R4 ZERO WORK REG @30AAAG 43792003 ICM R4,3,0(R3) GET UCB PTR @30AAAG 43794003 TM 0(R3),X'FF' TEST FOR END OF TABLE DT0I 43800002 BC 14,NXTENTRY GO TO NXTENTRY IF NOT END DT0I 43820002 TM 1(R3),X'FF' DT0I 43840002 BC 1,DEVFOUND SET UP AND RETURN TO CALLERDT0I 43860002 NXTENTRY LTR R4,R4 IS THIS A ZERO ENTRY DT0I 43880002 BZ UP BRANCH ON YES DT0I 43900002 CLC 13(3,R4),NAME IS THIS THE SPECIFIC NAME DT0I 43920002 BE FOUND BRANCH ON YES DT0I 43940002 UP LA R3,2(R3) POINT TO NEXT UCBLUT ENTRY DT0I 43960002 B UCB BRANCH TO CHECK NEXT ENTRY DT0I 43980002 FOUND MVC DEVICE(4),16(R4) MOVE IN DEVICE TYPE FROM UCBDT0I 44000002 MVC UNIT(5),NAME SAVE SPECIFIC DEVICE NAME DT0I 44020002 DEVFOUND LM R3,R5,REGSAVE RESTORE THE REGISTERS DT0I 44040002 L 15,GOBACK2 PICK UP THE RETURN ADDRESS 44060002 BR 15 RETURN 44080002 ZEROCON DC F'0' DT0I 44100002 NAMEX DSECT 44120002 NAME DC CL8'-DEVICE-' NAME OF REQUIRED DEVICE 44140002 DEVICE DC CL4'TYPE' 4 BYTE DEVICE TYPE CODE 44160002 UNIT DC XL5'00' SPEC UNIT NAME IF SPECIFIED DT0I 44180002 GOBACK2 DC A(0) RETURN ADDRESS 44200002 REGSAVE DC 3F'0' USED TO SAVE THE REGISTERS 44220002 DSECT DSECT 44240002 IEHECHAR DS C CHARACTER TO BE SCANNED FOR 44260002 IEHECOND DS C CONDITION CODE TO STOP ON 44280002 IEHECODE DS C 44300002 IEHEARGL DS C 44320002 IEHESTT DS F 44340002 IEHESTP DS F 44360002 IEHEFND DS F 44380002 IEHETBL DS F 44400002 IEHEFUN DS F 44420002 IEHESCNX DS 3F 44440002 IEHEMAC1 DS 7F PARAMETER LIST S21046 44460002 IEHEMAC2 DS 6F 44480002 IEHESTIN DS F 44500002 IEHENDIN DS F 44520002 IEHECCNT DS 2C 44540002 IEHESW1 DS C 44560002 DUPSW DS 2C SWITCHES FOR TEST OF DUPLICATE S21046 44580002 * PARAMETERS S21046 44600002 PPARAMSW DS CL2 44620002 IEHESW5 DS C 44640002 IEHESW6 DS C 44660002 IEHECALL DS F 44680002 DS 0D 44700002 DBLWORD DS F 44720002 FULLWORD DS F 44740002 DS 0D 44760002 DECB1 DS 24X 44780002 DECB2 DS 24X 44800002 VOLISTAD DS F 44820002 MATRIXIU DS F 44840002 VDTIU DS F 44860002 VOLPAREN DS FL2 44880002 VSRCM DS 2X 44900002 VDSA DS X 44920002 DFLG DS X BS0H 44940002 DFLAG DS X BS0H 44960002 DS 0F 44980002 FLSTADDR DS F 45000002 FNSA DS 12X 45020002 KWSA DS 12X 45040002 SCANRET DS F 45060002 MARESAR DS 72X 45080002 IEHESPC DS XL20 45100002 DS XL20 45120002 IEHERSAV DS 64X 45140002 PASSUNIT DS 5X DT0I 45160002 MOUNTSW DS X DT0I 45180002 TABLEAD DS F ADDRESS OF DEVICE NAME TABLE I276 45200002 IEHESW2 DS X PROTECT SWITCHES S21046 45220002 * BIT 1=1 IF WE ARE TO PRINT S21046 45240002 * CONTROL CARDS S21046 45260002 * BIT 3=1 INDICATES FIRST QUOTE S21046 45280002 * IN SCAN FOR DATA S21046 45300002 * OPERATION IS FOUND S21046 45320002 * BIT 4= 1 IF WTOR SETUP IS DONE S21046 45340002 * BIT 6=1 IF FIRST PARM ENTRY S21046 45360002 * WAS VALID S21046 45380002 * BIT 7=1 IF INVALID PARM ENTRY S21046 45400002 * MSG HAS BEEN PRINTED S21046 45420002 PASWDCT1 DS 1X NUMBER OF PROMPTS FOR PASWORD1 S21046 45440002 PASWDCT3 DS 1X NUMBER OF PROMPTS FOR CPASWORD S21046 45460002 TOTALPS DS 1X TOTAL NUMBER OF INVALID PWS S21046 45480002 WTORECB DS 1F EVENT CONTROL BLOCK FOR WTOR S21046 45500002 TIOTADRS DS 1F TIOT ADDRESS FOR WTOR S21046 45520002 CCNAME DS 8C NAME OFF CONTROL CARD S21046 45540002 WTORLIST WTOR 'IEH220A JOBNAMES, STEPNAME, CARDNAME, REPLY WITH PASSWOX45560002 RD',,8,WTORECB,ROUTCDE=(9),DESC=2,MF=L S21046 45580002 EXTRACTO EXTRACT ,'S',FIELDS=(TIOT),MF=L S21046 45600002 DCBAREA DS 0F 45620002 UTINDCB DCB DSORG=PS,MACRF=(GM) 45640002 CODELIST DC C'.,=() ' SPECIAL CHARACTERS CODED BY SCAN 45660002 MAXLINES DC FL2'45' MAXIMUM LINES PER PAGE 45680002 LINECNT DC FL2'0' LINE COUNT FIELD 45700002 SKIP21 DC X'8B' SKIP TO 1 COMMAND 45720002 WRITEHDR DC X'19' SPACE 3 AFTER PRINT 45740002 HEADER DC CL30'MODIFY....VERSION BETA-1......' 45760002 DC CL30'LAST UPDATED....JULY 11 10 PM' 45780002 DC CL30' ' 45800002 DC CL30' PAGE 001 ' 45820002 PAGENUM EQU HEADER+110 45840002 DDNAMES DS 3CL8 FOR THREE DD NAMES 45860002 UTOUTDCB DCB DSORG=PS,MACRF=(PM) 45880002 DS 2F 45900002 CTRLWORD DS 0F REG 13 SAVED, SWITCHES FOR VOLUME MOUNTING 45920002 IEHESAT DS 150X 45940002 READBASE DC F'0' 45960002 ERRFLD DS 0CL8 FOR POSTING OF ERROR RETURN CODES 45980002 PARAM1 DS 44X 46000002 DS F FOR LENGTH OF PARAM2 46020002 PARAM2 DS 44X 46040002 DS F FOR LENGTH OF PARAM3 46060002 PARAM3 DS 44X 46080002 PARAM5 DS 2F CPASWORD PARAMETER S21046 46100002 PARAM6 DS 151F VOL IDS PARAMETER S21046 46120002 PARAM7 DS 2F PASSWORD2 PARAMETER S21046 46140002 PARAM8 DS 80X DATA PARAMETER S21046 46160002 DUMMY DS 1F TEMPORARY STORAGE FIELD S21046 46180002 PROTCTAD DS 1F ADDRESS OF WHERE TO PUT NEXT S21046 46200002 * VOL ID IN PARAM6 FOR PROTECT S21046 46220002 FINUSE DS F ADDR OF DC LIST IN USE 46240002 DCSAVEAD DS F SAVE AREA FOR ADDR OF DC LIST 46260002 INPUT DS 40F TWO CARD INPUT AREA 46280002 MSGOUT DS 30F MSG OUTPUT AREA 46300002 DS F 46320002 DS 0D 46340002 PARAM4 DS 151F FOR A VOLUME LIST 46360002 EOCORE EQU *-12 46380002 ORG PARAM4+20 46400002 VTOCDCB2 DS 0F 46420002 DCB4VTOC DCB DDNAME=VTOC, .46440002 DSORG=PS, .46460002 MACRF=R, .46480002 KEYLEN=44, .46500002 BLKSIZE=1, .46520002 RECFM=U 46540002 JFCB DS 24D 46560002 * THE FOLLOWING ORG STATEMENT IS FLAGGED YM5077 46580002 ORG 46600002 SAVEREG2 DS 72X SECONDARY SAVE AREA M2838 46620002 SAVEREG3 DS 72X THIRD LEVEL SAVE AREA M2838 46640002 ORG 46660002 VTOCSW EQU JFCB+50 46680002 VTOCDECB EQU JFCB+60 46700002 JFCBVOL EQU JFCB+118 46720002 EXLST2 EQU DCB4VTOC+36 46740002 FORMATID EQU PARAM2+44 46760002 BLANK EQU 64 46780002 READTOO EQU INPUT+72 46800002 COL16 EQU READTOO+15 46820002 COL72 EQU READTOO+71 46840002 MIDDLE EQU READTOO-1 46860002 WARE2PUT EQU IEHEMAC1-4 46880002 UCBAD1 EQU IEHESAT+16 46900002 END COMMENCE 46920002