AMS TITLE 'DMSAMS (CMS) VM/370 - RELEASE 6' 00001000 *. 00002000 * MODULE NAME - 00003000 * 00004000 * AMSERV - INTERFACE TO DOS ACCESS METHOD SERVICES UTILITIES 00005000 * 00006000 * FUNCTION - 00007000 * 00008000 * TO PROVIDE AN INTERFACE TO THE DOS ACCESS METHOD SERVICES 00009000 * UTILITY PROGRAMS (IDCAMS), FOR USE WITH CMS/VSAM. 00010000 * 00011000 * COMMAND LINE FORMAT - 00012000 * 00013000 * +------------------------------------------------------------+ 00014000 * | | | 00015000 * | AMSERV | FNAME1 < (PRINT TAPIN XXX > | 00016000 * | AM | < (PRINT TAPOUT YYY > | 00017000 * | | < (PRINT TAPIN XXX TAPOUT YYY > | 00018000 * | | | 00019000 * +------------------------------------------------------------+ 00020000 * 00021000 * (SEE "NOTES" BELOW.) 00022000 * 00023000 * ATTRIBUTES - 00024000 * 00025000 * DISK-RESIDENT, CALLED VIA SVC. 00026000 * 00027000 * ENTRY POINT - 00028000 * 00029000 * DMSAMS 00030000 * 00031000 * ENTRY CONDITIONS - 00032000 * 00033000 * GPR 1 POINTS TO AMSERV COMMAND LINE (AS ABOVE). 00034000 * GPR 14 = RETURN REGISTER 00035000 * GPR 15 = ADDRESS OF AMSERV 00036000 * 00037000 * EXIT CONDITIONS - 00038000 * 00039000 * GPR 14 = RETURN REGISTER 00040000 * GPR 15 = 0 (IF NO ERRORS) AND IDCAMS INVOKED. 00041000 * OR 00042000 * GPR 15 = ERROR CODE. 00043000 * 00044000 * DATA STORED AS NEEDED IN NUCON AND/OR DOSCB CONTROL BLOCK(S) 00045000 EJECT 00046000 * CALLS TO OTHER ROUTINES - 00047000 * 00048000 * STATE 00049000 * ADTLKW 00050000 * STATEW 00051000 * ERASE 00052000 * SET 00053000 * ASSGN 00054000 * DLBL 00055000 * DMSSMNAT 00056000 * IDCAMS (DOS ACCESS METHOD SERVICES UTILITIES) 00057000 * DMSVSR (ROUTINE TO "RESET" VSAM) 00058000 * 00059000 * EXTERNAL REFERENCES - 00060000 * 00061000 * NONE 00062000 * 00063000 * TABLES / WORK AREAS - 00064000 * 00065000 * INTERNAL SCRATCH WORDS AND AND PARAMETER LISTS ARE USED. 00066000 * 00067000 * REGISTER USAGE 00068000 * 00069000 * GPR 1 IS USED FOR CMS SVC CALLS. 00070000 * GPR 2 = POINTER TO AMSERV P-LIST 00071000 * GPR 6 = POINTER TO SAVED SYSTEM TABLE IN NUCON 00072000 * GPR 7 = POINTER TO 'ASSGN' OR 'DLBL' P-LIST FOR AMSERV INPUT 00073000 * GPR 8 = POINTER TO 'ASSGN' OR 'DLBL' P-LIST FOR AMSERV OUTPUT 00074000 * GPR 12 = ADDRESSABILITY 00075000 * 00076000 * OTHER REGISTERS ARE USED FOR WORK REGISTERS. 00077000 * 00078000 * NOTES - 00079000 * 00080000 * 1. THE INPUT LINES FOR DOS ACCESS METHOD SERVICES UTILITIES 00081000 * WILL BE READ FROM A CMS FILE WITH A FILENAME SPECIFIED BY THE 00082000 * 1ST OPERAND ("FNAME1"), AND A FILETYPE OF 'AMSERV', FROM ANY 00083000 * CMS DISK ON WHICH IT IS FOUND (NORMAL SEARCH ORDER). THIS FILE 00084000 * MUST HAVE A FIXED RECORD FORMAT, WITH A RECORD LENGTH OF 80. 00085000 * 00086000 * 2. IF 'PRINT' IS SPECIFIED AS AN OPTION, IDCAMS OUTPUT WILL GO 00087000 * TO THE PRINTER. 00088000 * 00089000 * OTHERWISE, IDCAMS OUTPUT WILL BE PLACED IN A CMS FILE ON 00090000 * THE FIRST READ/WRITE DISK (NORMALLY THE USER'S A-DISK) WITH 00091000 * A FILENAME GIVEN BY THE SECOND OPERAND ("FNAME2"), AND A 00092000 * FILETYPE OF 'LISTING' (REPLACING ANY OLD LISTING FILE OF 00093000 * THE SAME NAME ON THAT DISK). 00094000 * 00095000 * IF "FNAME2" IS OMITTED, "FNAME1" IS USED FOR THE OUTPUT 00096000 * FILENAME. 00097000 * 00098000 * IF "FNAME2" AND "(PRINT" ARE BOTH SPECIFIED, AN ERROR MESSAGE 00099000 * IS GIVEN, WITH RETURN TO CALLER. 00100000 EJECT 00101000 * NOTES (CONTINUED) - 00102000 * 00103000 * 3. INPUT TO IDCAMS MUST BE IN THE SAME FORMAT AS FOR THE 00104000 * DOS ACCESS METHOD SERVICES UTILITIES. INPUT LINES SHOULD 00105000 * NORMALLY START IN COLUMN 2. 00106000 * 00107000 * 4. OUTPUT FROM IDCAMS IS ALSO IN DOS FORMAT, AND MAY IN SOME 00108000 * CASES EXCEED 80 NON-BLANK CHARACTERS IN LENGTH. NO ATTEMPT 00109000 * WILL BE MADE BY CMS TO SHORTEN THE OUTPUT TO 80 CHARACTERS 00110000 * FOR CONCISENESS OR READABILITY. 00111000 * 00112000 * 5. THE 'PRINT' OPTION MAY BE ABBREVIATED (VIA TRUNCATION) TO 00113000 * ANY VALUE FROM 'P' TO 'PRIN'. 00114000 * 00115000 * 6. IF A "SET DOS ON" IS NOT CURRENTLY IN EFFECT (AS FOR AN 00116000 * "OS USER"), THE "TAPIN XXX" OPTION MUST BE USED IF THE 00117000 * ACCESS METHOD SERVICES REQUESTS WILL REQUIRE TAPE INPUT. 00118000 * SIMILARLY, "TAPOUT YYY" MUST BE USED IF TAPE OUTPUT IS 00119000 * REQUIRED. XXX AND YYY MUST BE EITHER VIRTUAL TAPE ADDRESSES 00120000 * IN HEXADECIMAL FORM (E.G. '181'), OR CMS SYMBOLIC TAPE NAMES 00121000 * (E.G. 'TAP1'). IF XXX AND YYY ARE BOTH GIVEN, THEY MUST NOT 00122000 * BE THE SAME DEVICE. 00123000 * 00124000 * IF "SET DOS ON" WAS IN EFFECT WHEN AMSERV WAS INVOKED AND 00125000 * THE 'TAPIN' OR 'TAPOUT' OPTIONS WERE NOT INCLUDED, THEN ANY 00126000 * 'ASSGN' SETTINGS CURRENTLY IN EFFECT FOR TAPE ARE RETAINED. 00127000 * 00128000 * 7. THE 'PRINT', 'TAPIN XXX', AND 'TAPOUT YYY' OPTIONS ARE 00129000 * INDEPENDENT OF EACH OTHER, AND MAY BE GIVEN IN ANY ORDER. 00130000 * 00131000 * 8. SUGGESTED LOADING PROCEDURE: 00132000 * LOAD DMSAMS (CLEAR TYPE NOMAP 00133000 * GENMOD AMSERV (ALL 00134000 * 00135000 * OPERATION - 00136000 * 00137000 * 1. THE INPUT LINE IS CHECKED FOR VALID OPERANDS AND OPTIONS; 00138000 * AN ERROR MESSAGE IS GIVEN IF NEEDED, WITH RETURN TO CALLER. 00139000 * 00140000 * 2. IF NO ERRORS WERE DETECTED, A 'SET DOS ON' COMMAND 00141000 * IS ISSUED (UNLESS THE USER WAS ALREADY IN DOS MODE). 00142000 * 00143000 * 3. AN 'ASSGN SYSIPT' COMMAND IS ISSUED FOR THE DISK WHICH 00144000 * CONTAINS THE AMSERV INPUT, AND A 'DLBL' COMMAND IS ISSUED TO 00145000 * CAUSE THE INPUT LINES TO BE READ FROM THE SPECIFIED CMS FILE. 00146000 * 00147000 * 4. FOR OUTPUT ON THE PRINTER, AN 'ASSGN SYSLST PRINTER' IS 00148000 * ISSUED. OTHERWISE, AN 'ASSGN SYSLST' AND A 'DLBL' ARE ISSUED 00149000 * TO DIRECT THE IDCAMS OUTPUT TO THE SPECIFIED CMS FILE. 00150000 EJECT 00151000 * OPERATION (CONTINUED) - 00152000 * 00153000 * 5. IF THE 'TAPIN' OR 'TAPOUT' OPTION(S) WERE PRESENT ON 00154000 * THE AMSERV COMMAND LINE, AN APPROPRIATE 'ASSGN SYS004 TAPN' 00155000 * IS INVOKED IF 'TAPIN' WAS SPECIFIED, AND/OR A SIMILAR 00156000 * 'ASSGN SYS005 TAPN' FOR 'TAPOUT'. 00157000 * 00158000 * 6. THEN A 'DIAGNOSE' IS PERFORMED TO BRING IN THE CMSAMS DCSS 00159000 * SEGMENT CONTAINING ALL THE DOS ACCESS METHOD SERVICES CODE; 00160000 * CDLOAD IS THEN INVOKED TO LOAD THE ROOT PHASE (IDCAMS) OF 00161000 * THE DOS ACCESS METHOD SERVICES UTILITY PACKAGE, AND CONTROL 00162000 * IS THEN PASSED TO IDCAMS. 00163000 * 00164000 * 7. UPON RETURN FROM IDCAMS, ANY DLBL'S WHICH WERE SET EARLIER 00165000 * ARE CLEARED VIA CALL(S) TO 'DLBL DDNAME CLEAR'. THEN ANY 00166000 * LUB AND PUB ENTRIES AFFECTED BY ASSGN COMMANDS DONE IN THE 00167000 * INITIALIZATION ABOVE (I.E. FOR SYSIPT AND SYSLST, AND FOR 00168000 * SYS004 OR SYS005 IF 'TAPIN' OR 'TAPOUT' WERE SPECIFIED) ARE 00169000 * SET BACK TO THE VALUES THEY HAD BEFORE AMSERV WAS CALLED. 00170000 * THEN 'DMSVSR' IS CALLED TO "RESET" VSAM, AND IF THE USER WAS 00171000 * NOT IN DOS MODE AT ENTRY (SEE STEP 2 ABOVE), A 'SET DOS OFF' 00172000 * COMMAND IS ISSUED. 00173000 * 00174000 * 8. FINALLY, RETURN IS MADE TO THE CMS ENVIRONMENT, PASSING 00175000 * BACK THE RETURN-CODE FROM IDCAMS. 00176000 * 00177000 * RESPONSES - 00178000 * 00179000 * 'DMSAMS722I FILE 'FNAME2 LISTING FM' WILL HOLD AMSERV OUTPUT.' 00180000 * (THIS RESPONSE GIVEN ONLY IF 'FM' IS NOT THE A-DISK) 00181000 * 00182000 * OTHER OUTPUT WILL BE FROM DOS ACCESS METHOD SERVICES (IDCAMS). 00183000 * 00184000 * ERROR MESSAGES - 00185000 * 00186000 * RETURN 00187000 * CODE ERROR MESSAGE 00188000 * ---- -------------------------------------------------------------- 00189000 * 20 DMSSTT062E INVALID CHARACTER '-' IN FILEID 'FNAME1 AMSERV'. 00190000 * 20 DMSSTT062E INVALID CHARACTER '-' IN FILEID 'FNAME2 LISTING'. 00191000 * 00192000 * 24 DMSAMS001E NO FILENAME SPECIFIED 00193000 * 28 DMSAMS002E FILE 'FNAME1 AMSERV' NOT FOUND 00194000 * 24 DMSAMS003E INVALID OPTION '........' 00195000 * 36 DMSAMS006E NO READ/WRITE DISK ACCESSED FOR 'FNAME2 LISTING' 00196000 * 32 DMSAMS007E FILE 'FNAME1 AMSERV FM' NOT FIXED, 80-CHAR. RECORDS 00197000 * 24 DMSAMS065E 'OPTION' OPTION SPECIFIED TWICE 00198000 * 24 DMSAMS066E 'OPTION' AND 'OPTION' ARE CONFLICTING OPTIONS. 00199000 * 24 DMSAMS070E INVALID PARAMETER '........' 00200000 * 104 DMSAMS136S CDLOAD OF 'IDCAMS' FAILED. 00201000 * 100 DMSAMS113S TAPIN (XXX) NOT ATTACHED 00202000 * 100 DMSAMS113S TAPOUT (YYY) NOT ATTACHED 00203000 * 104 DMSAMS401S V.M. SIZE (......) CANNOT EXCEED 'CMSAMS' START 00204000 * ADDRESS (......). 00205000 *. 00206000 EJECT 00207000 * NOTE: "SUPPORT CODE" FOR THIS MODULE = @V305132 00208000 SPACE 00209000 DMSAMS CSECT DISK-RESIDENT (IN USER AREA) @V305132 00210000 ENTRY AMSERV "MODULE NAME" @V305132 00211000 USING NUCON,R0 @V305132 00212000 USING *,R12 @V305132 00213000 AMSERV LR R12,R15 ADDRESSABILITY IN R12 @V305132 00214000 LR R11,R12 @V305132 00215000 A R11,F4096 GIMME SOME SLACK, MAN @V305132 00216000 USING DMSAMS+4096,R11 @V305132 00217000 ST R14,SAVE14 SAVE R14 = RETURN REGISTER @V305106 00218000 DMSKEY NUCLEUS RUN WITH NUCLEUS KEY FOR NOW @V305132 00219000 LR R2,R1 LET R2 POINT TO AMSERV P-LIST @V305132 00220000 CLI 8(R2),FF MAKE SURE FILENAME WASN'T OMITTED@V305066 00221000 BE NOFILNAM NOTHING THERE - A USER BLUNDER. @V305132 00222000 CLI 8(R2),LFTPAREN ALSO BEWARE OF LEFT-PAREN @V305066 00223000 BE NOFILNAM THAT'S AN ERROR TOO. @V305132 00224000 MVI AMSFLAG,ZERO CLEAR HANDY FLAG @V305066 00225000 MVC INPUTFIL(8),8(R2) STORE FILENAME IN P-LIST, @V305132 00226000 LA R1,FNDINPUT AND SEE IF 'FNAME AMSERV' EXISTS @V305132 00227000 L R15,ASTATE (GET DMSSTT ADDRESS) @VM03093 00228000 SSM AMSDIS DISABLE INTERRUPTS @VA06258 00228500 BALR R14,R15 (GO TO STATE) @VM03093 00229000 SSM AMSENA ENABLE INTERRUPTS @VA06258 00229500 BNZ FILNTFND APPARENTLY FILE NOT FOUND. @VM03093 00230000 * 00231000 * "FILENAME AMSERV" EXISTS - SET CMS/DOS FLAGS ACCORDINGLY: 00232000 * 00233000 L R1,ACOPYFST REFERENCE COPY OF 'FST' @V305132 00234000 USING FSTSECT,R1 ... @V305132 00235000 MVC INPUNAME(8),FSTN STORE FILE NAME, @V305132 00236000 LH R15,FSTM AND SAVE FILE MODE WHERE NEEDED @V305132 00237000 STH R15,INPUMODE (IN DLBL P-LIST) @V305132 00238000 STH R15,INPUTMOD (IN STATE PLIST FOR ERROR HNDLRS)@V305132 00239000 CLI FSTFV,FIXED MUST BE FIXED @V305066 00240000 BNE NOTFXD80 ERROR IF NOT 'F'. @V305132 00241000 LA R15,CON80 AND RECORD LENGTH MUST = 80 @V305066 00242000 CL R15,FSTIL ... @V305132 00243000 BNE NOTFXD80 ERROR IF NOT 80. @V305132 00244000 DROP R1 @V305132 00245000 * 00246000 * NOW PROCESS SECOND PARAMETER IN AMSERV P-LIST: 00247000 * 00248000 MVC OUTPUTFN(8),INPUTFIL DEFAULT OUT FN FROM IN FN @V305132 00249000 CLI 16(R2),FF DOES 2ND PARAMETER EXIST? @V305066 00250000 BE AMS15 NOPE - GO SETUP FOR OUTPUT FILE @V305132 00251000 CLI 16(R2),LFTPAREN ALSO LOOK FOR LEFT PAREN @V305066 00252000 BE AMS22 YES - GO CHECK OUT THE OPTIONS @V305132 00253000 MVC OUTPUTFN(8),16(R2) SAVE FNAME (IN ERASE P-LIST) @V305132 00254000 OI AMSFLAG,OUTFILSP SIGNAL OUTPUT FILE WAS SPECIFD @V305132 00255000 CLI 24(R2),LFTPAREN LT PAREN AFTER OP FN @V305066 00256000 BE AMS24 YES - GO CHECK OUT OPTIONS. @V305132 00257000 * (WILL RETURN TO AMS15 LATER IF NECESSARY) 00258000 CLI 24(R2),FF IF NOT '(', SHOULD BE END OF CMD @V305066 00259000 BNE INVALOPR IF NOT, GARBAGE ON COMMAND LINE. @V305132 00260000 * OK - CONTINUE: 00261000 EJECT 00262000 AMS15 LA R1,ADTLKWPL-24 POINT TO 'ADTLKW' P-LIST, @V305132 00263000 SR R0,R0 START SEARCHING WITH FIRST DISK, @V305132 00264000 L R15,VCADTLKW AND CALL 'ADTLKW' @VM03093 00265000 BALR R14,R15 ... @V305132 00266000 BNZ NORWDSK ERROR IF CAN'T GET A RD-WR DISK @V305132 00267000 USING ADTSECT,R1 IF FOUND, REFERENCE THE ADT BLOCK@V305132 00268000 IC R15,ADTM GET THE MODE-LETTER @V305132 00269000 DROP R1 AND @V305132 00270000 STC R15,OUTPUTFM STORE THE FILEMODE WHERE NEEDED @V305132 00271000 STC R15,OUTPMODE ... @V305132 00272000 STC R15,SETLSTDV ... @V305132 00273000 STC R15,RESPON1A ... @V305132 00274000 CLC OUTPUTFN(8),INPUTFIL IS 'FNAME2' = TO 'FNAME1'? @V305132 00275000 BE AMS15B YES - DON'T NEED VALID-CK OF FN2 @V305132 00276000 STC R15,STATEWFM NO - FILL IN FILE-MODE, @V305132 00277000 MVC STATEWFN(8),OUTPUTFN AND 'FNAME2' @V305132 00278000 LA R1,CHEKNAM2 VALID-CK (& FIND) FN2 LISTING @V305132 00279000 L R15,ASTATEW (GET DMSSTTW ADDRESS) @VM03093 00280000 SSM AMSDIS DISABLE INTERRUPTS @VA06258 00280500 BALR R14,R15 AND CALL 'STATEW' FUNCTION. @VM03093 00281000 SSM AMSENA ENABLE INTERRUPTS @VA06258 00281500 BNZ AMS15A BRANCH IF ERROR FOUND. @VM03093 00282000 B AMS15B CALL ERASE IF NO ERR FRM 'STATEW'@V305132 00283000 AMS15A CH R15,=H'28' ERROR 28 (NOT FOUND) FROM STATEW?@V305132 00284000 BE AMS15C YES - FN2 OK, BUT FILE NO EXIST. @V305132 00285000 B EXIT NO-EXIT (W/ERR-CODE FROM STATEW) @V305132 00286000 EJECT 00287000 * 00288000 * ERASE OLD 'FNAME2' LISTING FILE (IF ANY): 00289000 * 00290000 AMS15B LA R1,ERASEOLD POINT TO ERASE P-LIST; @V305132 00291000 L R15,AERASE GET DMSERS ADDRESS @VM03093 00292000 SSM AMSDIS DISABLE INTERRUPTS @VA06258 00292500 BALR R14,R15 ERASE OLD FILE (IF ANY) @VM03093 00293000 SSM AMSENA ENABLE INTERRUPTS @VA06258 00293500 AMS15C CLI OUTPUTFM,A IS THE RW DISK THE 'A' DISK? @V305066 00294000 BE AMS16 YES - NO RESPONSE NECESSARY @V305132 00295000 * 00296000 * GIVE RESPONSE MESSAGE SHOWING ON WHAT DISK OUTPUT WILL BE ON: 00297000 * 00298000 LA R3,RESP1 R3 POINTS TO MSG TEXT @V305132 00299000 LA R4,CON722 ERROR NUMBER 722 @V305066 00300000 LA R6,OUTPUTFN POINT TO FILLED-IN OUTPUT FNAME @V305132 00301000 DMSERR MF=(E,'SYS'),LET=I,NUM=(4),TEXTA=(3),DOT=YES, @V305132X00302000 SUB=(CHAR8A,(6)),TYPCALL=SVC @V305132 00303000 * 00304000 * ALSO SET CMS/DOS ACCORDINGLY FOR THE DISK WE'RE GOING TO WRITE ON: 00305000 * 00306000 AMS16 MVC OUTPNAME(8),OUTPUTFN SET OUTPUT FNAME AS NEEDED @V305132 00307000 LA R7,SETLST SET R7 TO DO 'ASSGN SYSLST X' @V305132 00308000 LA R8,OUTPDLBL & R8 TO ISSUE THE APPROP. 'DLBL @V305132 00309000 B AMS31 GO SET DOS (IF NEEDED). @V305132 00310000 EJECT 00311000 AMS22 EQU * LEFT-PAREN WAS FOUND AT 16(R2): @V305132 00312000 SH R2,=H'8' BACK UP 8 TO HNDL ALL CASES ALIKE@V305132 00313000 * CONTINUE: 00314000 AMS24 CLI 32(R2),FF NOTHING AFTER LEFT-PAREN? @V305066 00315000 BE AMS15 IF SO, HNDL AS IF '(' NOT THERE @V305132 00316000 CLI 32(R2),RTPAREN ALSO CHECK FOR RIGHT PAREN @VM03163 00317000 BE AMS15 AND IF SO, HANDLE AS ABOVE. @VM03163 00318000 LA R2,32(,R2) SOMETHING THERE - PT AT 1ST OPTN @V305132 00319000 AMS25 EQU * LOOP TO CHECK CMD LINE FOR OPTNS @V305132 00320000 CLI 0(R2),P 'P' FOUND? @V305066 00321000 BE CHEKPRNT YES - CHECK FOR 'PRINT' OPTION. @V305132 00322000 CLC =CL8'TAPIN',0(R2) 'TAPIN' SPECIFIED ? @V305132 00323000 BE AMS26 YES @V305132 00324000 CLC =CL8'TAPOUT',0(R2) 'TAPOUT' SPECIFIED ? @V305132 00325000 BNE INVALONE NO - AN ERROR. @V305132 00326000 TM AMSFLAG,TAPOUTF WAS TAPOUT OPTION GIVEN TWICE? @V305132 00327000 BO OPTWICE YES - THAT'S A NO-NO. @V305132 00328000 OI AMSFLAG,TAPOUTF REMEMBER IT WAS GIVEN @V305132 00329000 ST R2,STTAPOUT REM'BR WHERE TAPOUT OPTN STARTS @V305132 00330000 LA R4,OUTAPX POINT TO 'TAPOUT' PARMS ETC. @V305132 00331000 B AMS27 AND JOIN COMMON CODE. @V305132 00332000 AMS26 TM AMSFLAG,TAPINF WAS THE OPTION GIVEN TWICE ? @V305132 00333000 BO OPTWICE YES - THAT'S A BOO-BOO. @V305132 00334000 OI AMSFLAG,TAPINF REMEMBER IT WAS GIVEN @V305132 00335000 ST R2,STTAPIN REMEMBER WHERE TAPIN OPTN STARTS @V305132 00336000 LA R4,INTAPX POINT TO 'TAPIN' PARAMETERS ETC. @V305132 00337000 AMS27 CLI 8(R2),FF 'FENCE' AFTER 'TAPIN' OR 'TAPOUT'@V305066 00338000 BE INVALONE YES - HE CAN'T DO ANYTHING RIGHT.@V305132 00339000 CLI 8(R2),RTPAREN '(' AFTER 'TAPIN' OR 'TAPOUT' ? @VM03163 00340000 BE INVALONE YES - BAD ANYWAY. @VM03163 00341000 BAL R14,HEXBIN ATTEMPT TO CONVERT TO BINARY @V305132 00342000 BZ AMS28 IF OK, WAS HEX (NOW IN R1 AS BIN)@V305132 00343000 CLC INTAPX(3),8(R2) NOT HEX, MUST BE 'TAP' @V305132 00344000 BNE INVALTWO NOPE - A "MISTEAK" BY CALLER. @V305132 00345000 CLI 11(R2),CHAR0 TAP0 TO TAPF PLEASE HRC002DS 00346390 BL INVALTWO NO GOOD IF < 'TAP0' HRC002DS 00346780 CLI 11(R2),NINE ... HRC002DS 00347170 BNH AMS27TAP GOOD IF <= 'TAP9' HRC002DS 00347560 CLI 11(R2),A ... HRC002DS 00347950 BL INVALTWO NO GOOD IF < 'TAPA' HRC002DS 00348340 CLI 11(R2),F ... HRC002DS 00348730 BH INVALTWO NO GOOD IF > 'TAPF' HRC002DS 00349120 AMS27TAP EQU * , HRC002DS 00349510 CLI 12(R2),BLANK NEXT BYTE BLANK @V305066 00350000 BNE INVALTWO SO CLOSE BUT NO CIGAR. @V305132 00351000 MVC 0(4,R4),8(R2) OK - MOVE 'TAP1 - TAP4' TO PLIST @V305132 00352000 L R5,ADEVTAB POINT TO BEG'NG OF DEVICE-TABLE @V305132 00353000 LA R14,CON16 NUMBER OF BYTES PER TABLE ENTRY @V305066 00354000 L R15,ATABEND AND END OF DEVICE-TABLE @V305132 00355000 AMS27LP CLC DTAS(4,R5),8(R2) FIND 'TAP1 TO TAP4' IN DEV-TABL@V305132 00356000 BE AMS27FND GOT IT @V305132 00357000 BXLE R5,R14,AMS27LP ITERATE UNTIL WE FIND IT. @V305132 00358000 B INVALTWO STRANGE ERROR IF NOT FOUND. @V305132 00359000 AMS27FND LH R1,DTAD(,R5) PICK UP BINARY TAPE-ADDRESS, @V305132 00360000 B AMS29 GO STORE BINARY REPRES'ATION ETC.@V305132 00361000 EJECT 00362000 AMS28 EQU * HEX REPRESENTATION WAS GIVEN: @V305132 00363000 L R5,ADEVTAB POINT TO BEG'NG OF DEVICE-TABLE @V305132 00364000 LA R14,CON16 NUMBER OF BYTES PER TABLE ENTRY @V305066 00365000 L R15,ATABEND AND END OF DEVICE-TABLE @V305132 00366000 AMS28LP CH R1,DTAD(,R5) LOOK FOR GIVEN TAPE IN DEV TABLE @V305132 00367000 BE AMS28FND GOT IT @V305132 00368000 BXLE R5,R14,AMS28LP ITERATE UNTIL WE FIND IT. @V305132 00369000 B INVALTWO ERROR IF NOT FOUND. @V305132 00370000 AMS28FND CLC INTAPX(3),DTAS(R5) FOUND, MUST BE 'TAP' @V305132 00371000 BNE INVALTWO ERROR IF SOME OTHER DEVICE @V305132 00372000 MVC 0(4,R4),DTAS(R5) OK-MOVE 'TAP1 - TAP4' TO PLIST @V305132 00373000 AMS29 ST R1,TAPINDEV-INTAPX(,R4) SAVE BINARY REPRES'TN. @V305132 00374000 * 00375000 * MAKE SURE THE TAPE IS ATTACHED BEFORE GOING ANY FURTHER: 00376000 * 00377000 DC X'831E0024' ISSUE DIAG TO SEE IF TAPE ATT'CHD@V305132 00378000 BO TAPNOTAT TAPE NOT ATTACHED IF CC = 3 @V305132 00379000 LA R2,16(,R2) ALLOW FOR ADDITIONAL OPTIONS @V305132 00380000 AMS29A CLI 0(R2),FF ANYTHING THERE? @V305066 00381000 BE AMS30 NOPE - FINISH UP ERROR CHECKING. @V305132 00382000 CLI 0(R2),RTPAREN ALSO ALLOW FOR RIGHT PAREN @V305066 00383000 BNE AMS25 IF NOT, ASSUME MORE STUFF THERE. @V305132 00384000 AMS30 TM AMSFLAG,TAPINF+TAPOUTF ANY TAPE ASSIGNMENTS? @V305132 00385000 BZ AMS30A IF NOT, SKIP THE FOLLOWING CHECK@V305132 00386000 CLC INTAPX(4),OUTAPX YES - SAME LOGICAL TAPE NAME? @V305132 00387000 BE SAMETAPE THAT'S A BOO-BOO @V305132 00388000 CLC TAPINDEV(4),TAPOUTDV OR SAME PHYSICAL TAPE ADDR @V305132 00389000 BE SAMETAPE THAT'S JUST AS BAD. @V305132 00390000 AMS30A TM AMSFLAG,PRINTF WAS 'PRINT' SPECIFIED ? @V305132 00391000 BZ AMS15 NO - THEN SET UP OUTPUT FILE. @V305132 00392000 LA R7,OUTPRINT YES - SET R7 FOR ASSGN FOR PRNTR @V305132 00393000 SR R8,R8 AND CLEAR R8 (NO DLBL TO BE DONE)@V305132 00394000 EJECT 00395000 * 00396000 * NOW READY TO GO TO WORK: 00397000 * 00398000 AMS31 EQU * @VM03001 00399000 TM DOSFLAGS,DOSMODE ARE WE IN 'DOS MODE' ALREADY ? @V305132 00400000 BO AMS32 YES - GO ENSURE DOSSVC BIT IS SET@V305132 00401000 OI VSAMFLG1,VSAMSOS FOR DMSVSR TO SET DOS OFF @VM03082 00402000 LA R1,SETDOSON NO - SET DOS ON @V305132 00403000 SVC 202 ... @V305132 00404000 DC AL4(AMSRETRN) ... @V305132 00405000 * 00406000 * ISSUE DOS ASSGN'S FOR THE OS USER 00407000 * 00408000 L R5,DOSFIRST GET ADDR OF DOSCB'S @V305132 00409000 LTR R5,R5 ANY? @V305132 00410000 BZ AMS32 NO, SKIP THIS @V305132 00411000 USING DOSSECT,R5 @V305132 00412000 DCBLOOP ICM R2,1,DOSDSMD GET MODE FOR POSSIBLE ASSGN @V305132 00413000 LA R3,DOSYSXXX WHERE WE WANT DOS LOG UNIT @V305132 00414000 SR R9,R9 USE R9 FOR FIRST CALL FLAG @V305132 00415000 BAL R14,SRCHLUT CALL FOR DOS LOG UNIT ASSGN @V305132 00416000 CLI DOSEXTNO,ZERO ANY EXTENTS? @V305066 00417000 BZ MULTCHK NO, CHEK FOR MULTI-VOLS @V305106 00418000 ICM R9,1,DOSEXTNO GET NO. EXTENTS @V305106 00419000 L R10,DOSEXTTB AND ADDRESS OF BLOK @V305106 00420000 ELOOP ICM R2,1,0(R10) PROVIDE MODE FOR POSS ASSGN @V305132 00421000 CLM R2,1,DOSDSMD DOES MODE MATCH 'MASTER'? @V305132 00422000 BNE EPOINT NO, PREPAR TO CALL 'SRCHLUT'@V305132 00423000 MVC 1(2,R10),DOSYSXXX USE THE SAME LOG UNIT CODE @V305132 00424000 BE *+12 NO SENSE IN CALLING IF SO.. @V305132 00425000 EPOINT LA R3,1(,R10) WHERE WE WANT DOS LOG UNIT @V305132 00426000 BAL R14,SRCHLUT CALL FOR DOS LOGUNIT ASSGN @V305132 00427000 LA R10,11(,R10) POINT TO NEXT ENTRY @V305132 00428000 BCT R9,ELOOP LOOP THRU... @V305106 00429000 MULTCHK CLI DOSVOLNO,ZERO MULTI-VOLS SPECIFIED? @V305066 00430000 BZ NXTDOSCB NO, GET NEXT DOSCB @V305132 00431000 ICM R9,1,DOSVOLNO GET NO. ENTRIES @V305106 00432000 L R10,DOSVOLTB AND ADDRESS OF BLOK @V305106 00433000 MLOOP ICM R2,1,0(R10) PROVIDE MODE FOR POSS ASSGN @V305132 00434000 LA R3,1(,R10) WHERE WE WANT LOGUNIT STORED@V305132 00435000 BAL R14,SRCHLUT CALL FOR DOS LOGUNIT ASSGN @V305132 00436000 LA R10,3(,R10) POINT TO NEXT ENTRY @V305106 00437000 BCT R9,MLOOP LOOP THRU MULT BLOK @V305106 00438000 SPACE 00439000 NXTDOSCB ICM R5,MASK,DOSNEXT+1 POINT TO NEXT DOSCB @V305066 00440000 LTR R5,R5 ANY LEFT? @V305132 00441000 BP DCBLOOP YES, CONTINUE TO MARCH @V305132 00442000 * 00443000 * ISSUE 'ASSGN SYS010 IGN' OR 'ASSGN SYSCAT IGN' AS INDIC IN DLUT 00444000 * 00445000 MVC DASSGN+16(3),=CL3'IGN' SET IGNORE FIELD IN CMD @V305132 00446000 TM DUMFLAG,DUMDS ANY DUMMY DATA SETS FOUND? @V305132 00447000 BZ TDUMCAT NO, HOW ABOUT SYSCAT DATA SET@V305132 00448000 MVC DASSGN+11(3),DUMUNIT SET UP LOG UNIT SYS010 @V305132 00449000 BAL R14,DOSASSGN ISSUE COMMAND @V305132 00450000 TDUMCAT TM DUMFLAG,DUMCAT HAS IJSYSCT BEEN DUMMIED? @V305132 00451000 BZ AMS32 NO, END OF ASSIGNMENTS @V305132 00452000 MVC DASSGN+11(3),=CL3'CAT' LOGICAL UNIT @V305132 00453000 BAL R14,DOSASSGN ISSUE COMMAND THEN FALL THRU @V305132 00454000 B AMS32 TO CONTINUE @V305132 00455000 SPACE 2 00456000 SRCHLUT EQU * PROVIDE DOS LOGUNIT CODE, ASSGN IF NEC. @V305132 00457000 CLC DOSDD(7),=CL8'IJSYSCT' SYSCAT DDNAME? @V305132 00458000 BNE NOTCAT NO, CONTINUE.. @V305132 00459000 LTR R9,R9 CHEK FOR FIRST DOSCB CALL @V305132 00460000 BZ SYSCAT IF SO, ASSGN 'SYSCAT' CODE @V305132 00461000 CLM R2,1,DOSDSMD EXT. MODE SAME AS 'MASTER'? @V305132 00462000 BNE NOTCAT IF NOT, SKIP FOLLOWING... @V305132 00463000 SYSCAT MVC 0(2,R3),=X'000D' SET SYSTEM CODE IN DOSCB @V305132 00464000 CLI DOSDEV,DOSDUM SYSCAT DUMMIED? @V305132 00465000 BNE CAT NO, PROCEED @V305132 00466000 OI DUMFLAG,DUMCAT YES, SET FLAG FOR LATER REF @V305132 00467000 BR R14 RETURN TO CALLER @V305132 00468000 CAT MVC DASSGN+11(3),=CL3'CAT' SPECIAL LOG UNIT @V305132 00469000 B OSASSGN2 ISSUE DOS ASSGN COMMAND @V305132 00470000 NOTCAT EQU * @V305132 00471000 LA R6,DLUT BEGIN OF DOS LOGUNIT TABLE @V305132 00472000 MVI 0(R3),PROG SET TO INDIC PROG UNIT @V305066 00473000 CLI DOSDEV,DOSDUM DUMMY DATA SET? @V305132 00474000 BNE AGAIN NO, GO MATCH LOGICAL UNIT @V305132 00475000 OI DUMFLAG,DUMDS SET DUMMY FLAG FOR LATER REF @V305132 00476000 MVI 1(R3),SYS010 LOG UNIT SYS010 USED FOR DUMMIES @V305066 00477000 BR R14 RETURN TO CALLER @V305132 00478000 AGAIN CLI 0(R6),BLANK MODE STILL UNASSIGNED? @V305066 00479000 BE NEWSLOT YES, GO AND USE IT @V305132 00480000 CLM R2,1,0(R6) FILEMODE MATCH IN TABLE? @V305132 00481000 BNE UPDLUT NO @V305132 00482000 MVC 1(1,R3),3(R6) PROVIDE LOG DEV NUM FOR CALLR@V305132 00483000 NI 1(R3),HEX0F TRANSLATE TO HEX @V305066 00484000 BR R14 RETURN TO CALLER @V305132 00485000 UPDLUT LA R6,4(,R6) CHECK NEXT ENTRY IN TABLE @V305132 00486000 B AGAIN @V305132 00487000 NEWSLOT STCM R2,1,0(R6) ASSIGN MODE IN TABLE @V305132 00488000 MVC 1(1,R3),3(R6) PROVIDE LOG DEV NUM TO CALLER@V305132 00489000 NI 1(R3),HEX0F TRANSLATE TO HEX @V305066 00490000 * 00491000 * MODIFY ASSGN COMMAND FOR THIS DATA SET AND ISSUE DOS ASSGN 00492000 * 00493000 OSASSGN MVC DASSGN+11(3),1(R6) INSERT LOGICAL DEVICE @V305132 00494000 OSASSGN2 STCM R2,1,DASSGN+16 INSERT FILEMODE @V305132 00495000 DOSASSGN LA R1,DASSGN POINT TO PLIST @V305132 00496000 SVC 202 @V305132 00497000 DC AL4(AMSRETRN) @V305132 00498000 BR R14 RETURN TO CALLER @V305132 00499000 EJECT 00500000 AMS32 OI DOSFLAGS,DOSSVC ENSURE THAT DOS SVC BIT IS SET @V305132 00501000 IC R15,INPUMODE STORE DISK-MODE FOR ASSGN SYSIPT @V305132 00502000 STC R15,SETIPTDV ... @V305132 00503000 LA R3,EQUIPT SET REGS FOR SYSIPT @V305132 00504000 LA R4,SAVEIPT ... @V305132 00505000 BAL R14,SAVEPUB SAVE OLD PUB ENTRY @V305132 00506000 LA R1,SETIPT THEN DO 'ASSGN SYSIPT X' @V305132 00507000 SVC 202 ... @V305132 00508000 DC AL4(AMSRETRN) ... @V305132 00509000 LA R1,INPUDLBL THEN: DLBL FOR INPUT @V305132 00510000 SVC 202 ... @V305132 00511000 DC AL4(AMSRETRN) ... @V305132 00512000 LA R3,EQULST SET REGS FOR SYSLST @V305132 00513000 LA R4,SAVELST ... @V305132 00514000 BAL R14,SAVEPUB SAVE PUB ENTRY @V305132 00515000 LR R1,R7 AND THEN: ASSGN FOR OUTPUT @V305132 00516000 SVC 202 ... @V305132 00517000 DC AL4(AMSRETRN) ... @V305132 00518000 LTR R1,R8 AND THEN: DLBL FOR OUTPUT @V305132 00519000 BZ AMS33 (UNLESS NOT NEEDED) @V305132 00520000 SVC 202 ... @V305132 00521000 DC AL4(AMSRETRN) ... @V305132 00522000 AMS33 TM AMSFLAG,TAPINF NEED DO AN ASSGN FOR TAPE INPUT? @V305132 00523000 BZ AMS34 NOPE. @V305132 00524000 LA R3,EQU004 YES - SET REGS FOR SYS004 @V305132 00525000 LA R4,SAVE004 ... @V305132 00526000 BAL R14,SAVEPUB SAVE PUB ENTRY @V305132 00527000 LA R1,INPUTAPE THEN POINT TO P-LIST @V305132 00528000 SVC 202 AND DO ASSGN FOR TAPE INPUT @V305132 00529000 DC AL4(AMSRETRN) ... @V305132 00530000 LA R2,ATAPIBUF FOR KEEPING A(IN BUFFER) @V305132 00531000 LA R3,=CL8'INPUT' FOR DDNAME PROMPT @V305132 00532000 MVC DUMSYS(8),INPUTAPE+8 PROVIDE DOS LOG UNIT @V305132 00533000 BAL R14,TAPDLBLS ISSUE 'TLBL'S @V305132 00534000 AMS34 TM AMSFLAG,TAPOUTF WHAT ABOUT TAPE OUTPUT ? @V305132 00535000 BZ AMS36 NOPE. @V305132 00536000 LA R3,EQU005 SET REGS FOR SYS005 @V305132 00537000 LA R4,SAVE005 ... @V305132 00538000 BAL R14,SAVEPUB SAVE PUB ENTRY @V305132 00539000 LA R1,OUTPTAPE THEN POINT TO P-LIST, @V305132 00540000 SVC 202 AND DO ASSGN FOR TAPE OUTPUT @V305132 00541000 DC AL4(AMSRETRN) ... @V305132 00542000 LA R2,ATAPOBUF FOR KEEPING A(OUT BUFFER) @V305132 00543000 LA R3,=CL8'OUTPUT' FOR DDNAME PROMPT @V305132 00544000 MVC DUMSYS(8),OUTPTAPE+8 PROVIDE DOS LOG UNIT @V305132 00545000 BAL R14,TAPDLBLS ISSUE 'TLBL'S @V305132 00546000 EJECT 00547000 AMS36 EQU * NOW LOAD THE CMSAMS SAVED SYSTEM@V305132 00548000 L R6,ASYSNAMS GET A(SAVED SYS TABLE) @V305106 00549000 USING SYSNAMES,R6 AND MAP IT... @V305106 00550000 LA R1,CMSAMS R1 MUST POINT TO CMSAMS SYS NAME@V305106 00551000 LA R2,TWELVE USE 'FINDSYS' CODE @V305066 00552000 DC X'83120064' FIND SAVED SYSTEM @V305132 00553000 BC 8,LOADED CC=0, ALREADY LOADED @V305132 00554000 BC 4,LOADIT CC=1, EXISTS BUT NOT LOADED @V305132 00555000 B CDLOADNG ANY OTHER ERROR= "CDLOAD FAILED"@V305132 00556000 SPACE 1 00557000 LOADIT C R1,VMSIZE OVERLAY IN USER'S V.M. STORAGE? @V305132 00558000 BL CDOVRLAY ERR, SGMT WAS GEN'D INCORRECTLY @V305132 00559000 * (OR USER HAS A GIGANTIC VIRTUAL MACHINE) 00560000 LA R1,CMSAMS POINT TO NAME AGAIN @V305106 00561000 SR R2,R2 R2=0 FOR SHARED COPY @V305132 00562000 DC X'83120064' LOAD THE SHARED SYSTEM @V305132 00563000 BC 7,CDLOADNG ANY ERROR - A FAILURE. @V305132 00564000 LOADED EQU * IDCAMS SGMT LOADED (ADDR IN R1) @V305132 00565000 OI AMSFLAG,AMSLODED REMEMBER WE LOADED IDCAMS @V305132 00566000 C R1,VMSIZE OVERLAY IN USER'S V.M. STORAGE? @V305132 00567000 BL CDOVRLAY ERR, SGMT WAS GEN'D INCORRECTLY @V305132 00568000 * (OR USER HAS A GIGANTIC VIRTUAL MACHINE) 00569000 ST R1,AAMSSYS OK-STORE AAMSSYS ADDR (IN NUCON)@V305132 00570000 OI VSAMFLG1,VSAMSERV SIGNAL AMSERV IS RUNNING @V305132 00571000 LA R1,=CL8'DMSSMNAT' CALL STORAGE INITIALIZER @V305132 00572000 SVC 202 (TO SET UP STOR & ANCHOR TABLE) @V305132 00573000 DC AL4(*+4) ... @V305132 00574000 * IN CASE WE GET CANCELLED @VA04697 00574100 DMSKEY RESET DURING CDLOAD- RESET NOW @VA04697 00574200 LA R1,=CL8'IDCAMS' R1 MUST PT TO 'IDCAMS' PHASENAME@V305132 00575000 SR R15,R15 CLEAR INDICATOR FOR CDLOAD @V305132 00576000 SVC SVC65 ISSUE SVC FOR CDLOAD @V305066 00577000 LR R5,R15 SAVE REG OVER DMSKEY @VA04697 00577100 DMSKEY NUCLEUS BACK IN NUCLEUS KEY @VA04697 00577200 LR R15,R5 AND RESTORE RET CODE REG @VA04697 00577300 LTR R15,R15 DID CDLOAD SUCCEED ? @V305132 00578000 BNZ CDLOADNG NO - GIVE UP (SADLY). @V305132 00579000 LTR R14,R1 YES - ADDRESS INTO R14, @V305132 00580000 BNP CDLOADNG IF NOT POS, CDLOAD FAILED @V305132 00581000 L R5,ABGCOM REFERENCE 'BGCOM' @V305101 00582000 USING BGCOM,R5 ... @V305101 00583000 MVC COMNAME,INPUTYPE COMMAND NAME = AMSERV @V305101 00584000 DROP R5 @V305101 00585000 STXIT AB,STXRET,STXSAVE @V305106 00586000 EJECT 00587000 XC 0(12,R13),0(R13) CLEAR 1ST 12 BYTES OF THE R13 @V305132 00588000 * SAVE-AREA PROVIDED BY DMSITS 00589000 DMSKEY RESET RUN AMS WITH USER KEY @V305132 00590000 LA R1,AMSPARMS PT TO PARMS FOR IDCAMS USE @V305132 00591000 LA R15,6(,R14) ENTER AT BYTE 6 WHEN CALL AS BALR@V305132 00592000 BALR R14,R15 AND CALL 'IDCAMS' ... @V305132 00593000 STXIT AB TERMINATE LINKAGE TO SUPVSR @VA04730 00593100 CLEANUP LR R14,R15 SAVE R15 (NOT PRESRVD BY DMSKEY) @V305132 00594000 DMSKEY NUCLEUS NUCLEUS KEY FOR CLEANUP @V305132 00595000 LR R15,R14 AND RESTORE R15 @V305132 00596000 L R5,ABGCOM REFERENCE 'BGCOM' @V305101 00597000 USING BGCOM,R5 ... @V305101 00598000 MVC COMNAME,=CL8'NO NAME' COMMAND NAME = NO NAME @V305101 00599000 DROP R5 @V305101 00600000 AMSRETRN STH R15,ERRSAVE SAVE RETURN CODE @V305132 00601000 AMS38 TM AMSFLAG,AMSLODED DID WE LOAD IDCAMS OK ? @V305132 00602000 BZ AMS39 NO - DON'T TRY TO UN-LOAD IT. @V305132 00603000 L R6,ASYSNAMS GET PTR TO SAVED SYSTEM TABLE @V305132 00604000 LA R3,CMSAMS YES - POINT TO NAME AGAIN, @V305106 00605000 LA R4,CON8 R4=8 TO PURGE THE CMSAMS SEGMENT @V305066 00606000 DC X'83340064' PURGE THE SHARED SYSTEM @V305132 00607000 SR R3,R3 AND @V305132 00608000 ST R3,AAMSSYS CLEAR AAMSSYS ADDRESS (IN NUCON)@V305132 00609000 NI VSAMFLG1,255-VSAMSERV RESET AMSERV-RUNNING FLAG @V305132 00610000 EJECT 00611000 * 00612000 * NOW DO A 'DLBL DDNAME CLEAR' FOR ANY DLBL'S WHICH WE ISSUED: 00613000 * 00614000 AMS39 LA R1,CLRDLBLI ISSUE 'DLBL DDNAME CLEAR' @V305132 00615000 SVC 202 ... @V305132 00616000 DC AL4(*+4) ... @V305132 00617000 LA R3,EQUIPT SET REGS FOR SYSIPT @V305132 00618000 LA R4,SAVEIPT ... @V305132 00619000 BAL R14,RESTPUB RESTORE PUB ENTRY @V305132 00620000 AMS40 LTR R8,R8 DID WE DO 'DLBL' FOR OUTPUT FILE?@V305132 00621000 BZ AMS42 NOPE - DON'T HAVE TO CLEAR IT. @V305132 00622000 LA R1,CLRDLBLO YES ISSUE 'DLBL DDNAME CLEAR' @V305132 00623000 SVC 202 ... @V305132 00624000 DC AL4(*+4) ... @V305132 00625000 AMS42 LA R3,EQULST SET REGS FOR SYSLST @V305132 00626000 LA R4,SAVELST ... @V305132 00627000 BAL R14,RESTPUB RESTORE PUB ENTRY @V305132 00628000 TM AMSFLAG,TAPINF DID WE DO ASSGN FOR TAPE INPUT? @V305132 00629000 BZ AMS44 NOPE. @V305132 00630000 LA R3,EQU004 SET REGS FOR SYS004 @V305132 00631000 LA R4,SAVE004 ... @V305132 00632000 BAL R14,RESTPUB RESTORE PUB ENTRY @V305132 00633000 L R2,ATAPIBUF TO FRET DDNAME BUFFER @V305132 00634000 LTR R2,R2 'TLBL'S ISSUED? @V305132 00635000 BZ AMS44 NO, DON'T TRY TO CLEAR @V305132 00636000 BAL R14,TLBLCLR CLEAR 'TLBL'S @V305132 00637000 AMS44 TM AMSFLAG,TAPOUTF WHAT ABOUT TAPE OUTPUT ? @V305132 00638000 BZ AMS46 NOPE. @V305132 00639000 LA R3,EQU005 SET REGS FOR SYS005 @V305132 00640000 LA R4,SAVE005 ... @V305132 00641000 BAL R14,RESTPUB RESTORE PUB ENTRY @V305132 00642000 L R2,ATAPOBUF TO FRET DDNAME BUFFER @V305132 00643000 LTR R2,R2 'TLBL'S ISSUED? @V305132 00644000 BZ AMS46 NO, DON'T TRY TO CLEAR @V305132 00645000 BAL R14,TLBLCLR CLEAR 'TLBL'S @V305132 00646000 AMS46 EQU * NOW DO FINAL VSAM & DOS CLEANUP @V305132 00647000 LA R1,CLRVSAM NOW "RESET VSAM" @V305132 00648000 SVC 202 ... @V305132 00649000 DC AL4(*+4) ... @V305132 00650000 LH R15,ERRSAVE RESTORE RETURN CODE @VM03045 00651000 EJECT 00652000 EXIT EQU * NOW RETURN TO CMS: @V305132 00653000 L R14,SAVE14 RESTORE R14, @V305132 00654000 OI MISFLAGS,RELPAGES TELL CP DONE WITH USER PAGES @V305132 00655000 TM DOSFLAGS,DOSMODE STILL IN DOS MODE? @VM03231 00656000 BZ CMSRET NO, OS USER - RETURN TO CMS @VM03231 00657000 TM AMSFLAG,STXACT ARE WE IN STXIT? @VM03231 00658000 BZ CMSRET NO, RETURN TO CMS @VM03231 00659000 DMSKEY RESET RESET KEY FOR BENEFIT OF DMSITS @VM03246 00660000 EOJ YES, RETURN TO DOS @V305106 00661000 CMSRET L R5,ABGCOM ADDRESS OF BGCOM @VM03231 00662000 USING BGCOM,R5 ADDRESSABILITY @VM03231 00663000 MVI DOSRC,ZERO ZERO DOS RC FIELD @VM03231 00664000 DROP R5 @VM03231 00665000 LR R2,R15 REMEMBER RETURN CODE @VM03231 00666000 DMSKEY RESET RESET KEY FOR BENEFIT OF DMSITS @VM03231 00667000 LR R15,R2 RESTORE RETURN CODE @VM03231 00668000 BR R14 RETURN TO CMS @VM03231 00669000 SPACE 1 00670000 STXRET EQU * ENTRY POINT FOR 'STXIT' @V305106 00671000 LM R11,R12,72(R1) RESTORE ADDRESSABILITY @V305101 00672000 OI AMSFLAG,STXACT SIGNAL STXIT ACTIVE FOR WINDUP @V305106 00673000 L R5,ABGCOM POINT TO DOS SUPER AREA @V305106 00674000 USING BGCOM,R5 @V305106 00675000 XC LTK(2),LTK ZERO LOG TRANS AREA KEY @V305106 00676000 LH R10,PIBPT PIB ADDRESS @V305106 00677000 L R6,ALTASAVE LTA SAVE AREA ADDRESS @V305106 00678000 ST R6,8(,R10) STORE IN ATTEN. PIB @V305106 00679000 L R6,APPSAVE PPSAVE ADDRESS @V305106 00680000 LA R10,16(,R10) POINT TO PART. PIB @V305106 00681000 ST R6,4(,R10) STORE IN PART. PIB @V305106 00682000 DROP R5 @V305106 00683000 B CLEANUP AND GO CLEANUP THE MESS... @V305106 00684000 CHEKPRNT EQU * 'P' FOUND - CHECK IT OUT: @V305132 00685000 TM AMSFLAG,PRINTF WAS 'PRINT' ALREADY SPEC. ONCE? @V305132 00686000 BO PRTWICE YES - THAT'S A SILLY USER ERROR. @V305132 00687000 LA R15,5(,R2) POINT AT 6TH CHARACTER @V305132 00688000 CHKPRNLP CLI 0(R15),BLANK CHECK FOR BLANK @V305066 00689000 BNE NONBLNK NON-BLANK FOUND @V305132 00690000 BCT R15,CHKPRNLP ITERATE BACK TOWARDS THE 'P' @V305132 00691000 NONBLNK SR R15,R2 COMPUTE BYTE-COUNT (LESS ONE) @V305132 00692000 EX R15,EXPRINT SEE IF MATCHES ABBREV FOR 'PRINT'@V305132 00693000 BNE INVALONE NO GOOD IF DOESN'T MATCH. @V305132 00694000 OI AMSFLAG,PRINTF OK - SET 'PRINT' FLAG, @V305132 00695000 TM AMSFLAG,OUTFILSP WAS AN OUTPUT FILE SPECIFIED ? @V305132 00696000 BO INCOMPAT YES - INCOMPATIBLE OPERAND/OPTION@V305132 00697000 LA R2,8(,R2) OK - ADV TO NEXT POSSIBLE OPTION @V305132 00698000 B AMS29A CHECK FOR COMPLETION OF OPTIONS. @V305132 00699000 EJECT 00700000 * HEXBIN = SUBROUTINE TO CONVERT ALPHAMERIC HEX NUMBER TO BINARY: 00701000 * 00702000 * AT ENTRY: 00703000 * 8(R2) POINTS TO ALPHAMERIC HEXADECIMAL FIELD 00704000 * R14 = RETURN REGISTER 00705000 * 00706000 * AT EXIT: 00707000 * CONVERSION SUCCESSFUL: 00708000 * R1 HOLDS BINARY (POSITIVE) CONVERSION OF HEX NUMBER 00709000 * R15 = 0 (AND CONDITION-CODE = 0) 00710000 * CONVERSION FAILED: 00711000 * R15 = 1 (AND CONDITION-CODE = NONZERO) 00712000 * 00713000 * NOTE: R0 AND R3 ARE USED FOR SCRATCH AND ARE NOT PRESERVED. 00714000 * 00715000 HEXBIN DS 0H SUBRTNE TO CONVERT HEX TO BINARY @V305132 00716000 LA R3,8(,R2) LET R3 POINT TO THE FIRST CHAR @V305132 00717000 SR R0,R0 EMPTY A WORK REGISTER. @V305132 00718000 SR R1,R1 ...AND ANOTHER. @V305132 00719000 LA R15,8 LIMIT OF 8 BYTES, PLEASE @V305132 00720000 CKBYTE CLI 0(R3),CHAR0 COMPARE WITH ZERO @V305066 00721000 BL TESTA IF LOW, CAN BE ALPHA OR BLANK. @V305132 00722000 CLI 0(R3),NINE NUMERIC? @V305066 00723000 BH HEXERR NO GOOD AT ALL IF > 9. @V305132 00724000 IC R1,0(,R3) OK, STUFF IT INTO A REGISTER. @V305132 00725000 SH R1,=XL2'00F0' CHG 0-9 ALPHAMERIC TO 0-9 BINARY @V305132 00726000 R1OK SLL R0,CON4 MAKE ROOM @V305066 00727000 OR R0,R1 ADD IN NEW HALF-BYTE @V305132 00728000 LA R3,1(,R3) POINT TO NEXT CHARACTER, @V305132 00729000 BCT R15,CKBYTE ITERATE UP TO 8 CHARACTERS. @V305132 00730000 TESTPOS LTR R1,R0 ANSWER INTO R1, @V305132 00731000 BNP HEXERR POSITIVE NUMBERS PLEASE @V305132 00732000 C R1,MAXPOSS IS IT GREATER THAN X'6FF'? @V305132 00733000 BH HEXERR NO IT CAN'T. @V305132 00734000 SR R15,R15 OK - CLEAR COND.-CODE (AND R15) @V305132 00735000 BR R14 AND EXIT WITH ANSWER IN R1. @V305132 00736000 * 00737000 * CHARACTER IS LESS THAN C'0': 00738000 * 00739000 TESTA CLI 0(R3),A MATCH IT WITH 'A' @V305066 00740000 BL TESTBLNK IF LESS THAN A, MUST BE BLANK @V305132 00741000 CLI 0(R3),F AND NOW WITH AN 'F' @V305066 00742000 BH HEXERR ERROR IF HIGH @V305132 00743000 IC R1,0(,R3) STUFF IT INTO A REGISTER. @V305132 00744000 SH R1,=XL2'00B7' CHG A-F ALPH'MRIC TO 10-15 BINARY@V305132 00745000 B R1OK JOIN 0-9 CONVERSION PATH. @V305132 00746000 * 00747000 TESTBLNK CLI 0(R3),BLANK BLANK CHARACTER? @V305066 00748000 BE TESTPOS YES - WE'RE ALL DONE. @V305132 00749000 HEXERR LA R15,CON1 R15=1 INDICATES SOME ERROR @V305066 00750000 LTR R15,R15 WITH NONZERO CONDITION-CODE @V305132 00751000 BR R14 EXIT TO CALLER. @V305132 00752000 * 00753000 MAXPOSS DC A(X'6FF') MAX REASONABLE VIRT DEV ADDR @V305132 00754000 EJECT 00755000 * SUBROUTINES TO SAVE AND RESTORE PUB ENTRIES 00756000 * SAVEPUB = ENTRY TO SAVE A PUB ENTRY 00757000 * RESTPUB = ENTRY TO RESTORE A PUB ENTRY 00758000 * REGISTERS AT ENTRY: 00759000 * R3 = DISPLACEMENT OF LUB ENTRY (SEE 'EQUIPT' THRU 'EQU005') 00760000 * R4 = ADDRESS OF AREA AT WHICH PUB TO BE SAVED/RESTORED 00761000 * (SEE 'SAVEIPT' THRU 'SAVE005') 00762000 * R14 = RETURN-REGISTER 00763000 * REGISTER USAGE: 00764000 * R1, R5, R6, & R15 USED FOR SCRATCH (NOT PRESERVED) 00765000 SAVEPUB L R5,ABGCOM REFERENCE 'BGCOM' @V305132 00766000 USING BGCOM,R5 ... @V305132 00767000 LH R6,LUBPT POINT TO LUB-TABLE @V305132 00768000 AR R6,R3 ADD DISPL'MT, POINT TO LUB ENTRY @V305132 00769000 IC R3,0(,R6) PICK UP THE LUB BYTE @V305132 00770000 STC R3,0(,R4) SAVE IT @V305132 00771000 TM 0(R6),FE WAS LUB EITHER X'FE' OR X'FF' ? @V305066 00772000 BOR R14 YES - EXIT (NOTHING MORE TO SAVE)@V305132 00773000 SLL R3,THREE NO - TIMES 8 PLEASE @V305066 00774000 AH R3,PUBPT ADD ADDRESS OF PUB-TABLE @V305132 00775000 MVC 1(8,R4),0(R3) SAVE THE 8-BYTE PUB ENTRY @V305132 00776000 BR R14 RETN TO MAIN CODE (DO ASSGN NOW) @V305132 00777000 DROP R5 @V305132 00778000 SPACE 00779000 RESTPUB L R5,ABGCOM REFERENCE 'BGCOM' @V305132 00780000 USING BGCOM,R5 ... @V305132 00781000 LH R6,LUBPT POINT TO LUB-TABLE @V305132 00782000 AR R6,R3 ADD DISPL'MT, POINT TO LUB ENTRY @V305132 00783000 IC R3,0(,R4) PICK UP THE SAVED LUB BYTE @V305132 00784000 STC R3,0(,R6) RESTORE IT @V305132 00785000 TM 0(R4),FE WAS SAVED LUB X'FE'OR X'FF'? @V305066 00786000 BOR R14 YES - EXIT (NOTHING MORE TO SAVE)@V305132 00787000 SLL R3,THREE TIMES 8 PLEASE @V305066 00788000 AH R3,PUBPT ADD ADDRESS OF PUB-TABLE @V305132 00789000 MVC 0(8,R3),1(R4) RESTORE THE 8-BYTE PUB ENTRY @V305132 00790000 BR R14 RETURN TO MAIN CODE. @V305132 00791000 DROP R5 @V305132 00792000 EJECT 00793000 * ERROR HANDLERS: 00794000 SPACE 00795000 NOFILNAM EQU * INPUT FILENAME OMITTED @V305132 00796000 LA R3,EMSG1 R3 POINTS TO MSG TEXT @V305132 00797000 LA R4,CON1 ERROR MESSAGE NUMBER 001 @V305066 00798000 SR R6,R6 NOTHING TO FILL IN @V305132 00799000 ER24PRNT BAL R5,ERRMSG GIVE THE FILLED-IN ERROR MESSAGE @V305132 00800000 ERROR24 LA R15,TWENTY4 RETURN CODE MUST = 24 @V305066 00801000 B EXIT GO EXIT. @V305132 00802000 SPACE 00803000 FILNTFND EQU * FILENAME AMSERV NOT FOUND @V305132 00804000 CH R15,=H'20' ERROR 20 (BAD CHARS) FROM STATE? @V305132 00805000 BE EXIT YES - EXIT (ERR MSG ALREDY GIVEN)@V305132 00806000 LA R3,EMSG2 R3 POINTS TO MSG TEXT @V305132 00807000 LA R4,CON2 ERROR MESSAGE NUMBER 002 @V305066 00808000 LA R6,INPUTFIL R6 POINTS TO INPUT FILE NAME @V305132 00809000 BAL R5,ERRMSG GIVE THE FILLED-IN ERROR MESSAGE @V305132 00810000 LA R15,CON28 RETURN CODE MUST = 28 @V305066 00811000 B EXIT GO EXIT. @V305132 00812000 SPACE 00813000 NOTFXD80 EQU * INPUT FLE NOT FIXED 80 BYTE ITEMS@V305132 00814000 LA R3,EMSG3 R3 POINTS TO MSG TEXT @V305132 00815000 LA R4,CON7 ERROR MESSAGE NUMBER 007 @V305066 00816000 LA R6,INPUTFIL R6 POINTS TO INPUT FILE NAME @V305132 00817000 BAL R5,ERRMSG GIVE THE FILLED-IN ERROR MESSAGE @V305132 00818000 LA R15,THIRTY2 RETURN CODE MUST = 32 @V305066 00819000 B EXIT GO EXIT. @V305132 00820000 SPACE 00821000 NORWDSK EQU * NO R-W DISK AVAIL. FOR LISTING @V305132 00822000 LA R3,EMSG4 R3 POINTS TO MSG TEXT @V305132 00823000 LA R4,CON6 ERROR MESSAGE NUMBER 006 @V305066 00824000 LA R6,OUTPUTFN R6 POINTS TO OUTPUT FILE NAME @V305132 00825000 BAL R5,ERRMSG GIVE THE FILLED-IN ERROR MESSAGE @V305132 00826000 LA R15,THIRTY6 RETURN CODE MUST = 36 @V305066 00827000 B EXIT GO EXIT. @V305132 00828000 SPACE 00829000 PRTWICE EQU * 'PRINT' SPECIFIED TWICE: @V305132 00830000 LA R2,DCPRINT PT TO FULL 5-BYTE 'PRINT'; CONT. @V305132 00831000 OPTWICE EQU * THE SAME OPTION WAS GIVEN TWICE: @V305132 00832000 LA R3,EMSG65 R3 POINTS TO MSG TEXT @V305132 00833000 LA R4,SIXTY5 ERROR MESSAGE NUMBER 65 @V305066 00834000 LR R6,R2 R6 PTS TO THE TWICE-GIVEN OPTION @V305132 00835000 BAL R5,ERRMSG GIVE THE FILLED-IN ERROR MESSAGE @V305132 00836000 LA R15,TWENTY4 RETURN CODE MUST = 24 @V305066 00837000 B EXIT GO EXIT. @V305132 00838000 SPACE 00839000 CDLOADNG EQU * CDLOAD OF 'IDCAMS' FAILED: @V305132 00840000 LA R3,EMSG8 R3 POINTS TO MSG TEXT @V305132 00841000 LA R4,CON136 ERROR MESSAGE NUMBER 136 @V305066 00842000 SR R6,R6 NO FILLED-IN FIELDS @V305132 00843000 BAL R5,SEVERMSG GIVE THE "SEVERE" ERROR MESSAGE @V305132 00844000 ERROR104 LA R2,CON104 USE RCODE OF 104(INTO R15 LATE) @V305066 00845000 B AMS38 GO DO CLEANUP CODE. @V305132 00846000 EJECT 00847000 * 00848000 * ATTEMPT TO LOAD CMSAMS SEGMENT WOULD OVERLAY USER'S VIRTUAL MACHINE: 00849000 * 'VMSIZE' HOLDS USERS VIRTUAL MACHINE SIZE 00850000 * 'CMSAMS' HOLDS NAME OF SEGMENT GENERATED INCORRECTLY 00851000 * R1 (BINARY NO.) HOLDS ADDRESS AT WHICH SEGMENT WAS GENERATED 00852000 CDOVRLAY L R2,VMSIZE LOAD VMSIZE @V305132 00853000 LA R3,CMSAMS POINT TO NAME OF SYSTEM @V305106 00854000 LR R4,R1 SEGMENT ADDRESS INTO R4 @V305132 00855000 DMSERR MF=(E,'SYS'),LET=S,NUM=401,TEXTA=CDOVMSGL, @V305132X00856000 SUB=(HEX,(R2),CHARA,(R3),HEX,(R4)),RENT=YES,DOT=YES 00857000 B ERROR104 RETURN ERROR CODE 104. @V305132 00858000 SPACE 00859000 CDOVMSGL DC AL1(L'CDOVRMSG) @V305132 00860000 CDOVRMSG DC C'V.M. SIZE (......) CANNOT EXCEED ''........'' START ADX00861000 DRESS (......)' @V305132 00862000 EJECT 00863000 TAPDLBLS DS 0H ISSUE DUMMY DLBLS FOR TAPE @V305132 00864000 DMSERR SUB=(CHARA,(R3)),NUM=367,LET=R, *00865100 TEXT='ENTER TAPE ........ DDNAMES:',DOT=NO @V305132 00866000 LR R4,R14 PRESERVE OUR R14 @VM03128 00867000 DMSFREE DWORDS=17,ERR=ERR109S,TYPCALL=BALR @VM03093 00868000 LR R14,R4 RESTORE OUR R14 @VM03128 00869000 ST R1,0(R2) KEEP ADDR FOR DLBL CLEARS & FRET @V305132 00870000 LR R2,R1 CAN'T USE R1... @V305132 00871000 RDTERM (R2) READ USER RESPONSE (DDNAMES)@V305132 00872000 LTR R0,R0 NULL LINE ENTERED? @V305132 00873000 BZ ERR228E ERROR IF SO... @V305132 00874000 LR R4,R14 SAVE R14 FOR CALLER RETURN @V305132 00875000 LR R1,R2 DMSSCN REQUIRES R1->LINE @V305132 00876000 L R15,ASCANN POINT TO CMS LINE SCANNER @V305132 00877000 BALR R14,R15 R1=A(LINE) R0=COUNT @V305132 00878000 LR R14,R4 RESTORE OUR R14 @V305132 00879000 LR R3,R0 @V305132 00880000 CH R3,=H'130' USER ENTER > 130 CHARS? @V305132 00881000 BNH *+8 NO, CONTINUE.. @V305132 00882000 LA R3,CON130 YES, FORCE 130 CHARS @V305066 00883000 EX R3,EXMOVE MOVE SCANNED LINE BACK TO BUFFER @V305132 00884000 OI VSAMFLG1,VSAMSERV LET DLBL KNOW WHO'S CALLING @V305132 00885000 B TLBLPT SKIP AROUND CLEAR ENTRY... @V305132 00886000 TLBLCLR EQU * ENTRY FOR CLEANUP @V305132 00887000 LR R4,R2 SAVE BUFFER ADDR FOR FRET @V305132 00888000 TM AMSFLAG,NOCLEARS DID ERRORS OCCUR? @V305132 00889000 BO FRETLIST YES, NO TLBL CLEARS @V305132 00890000 MVC DUMDUM(8),CLEAR SET PLIST FOR CLEARS @V305132 00891000 MVC DUMOPT(8),FENCE MOVE UP FENCE FOR CLEAR @V305132 00892000 TLBLPT LA R1,DUMLIST DUMMY DLBL PLIST @V305132 00893000 DLBLOOP MVC DUMNAME(8),0(R2) PUT NAME IN DLBL PLIST @V305132 00894000 SVC 202 'DLBL NAME DUMMY' @V305132 00895000 DC AL4(*+4) @V305132 00896000 LA R2,8(,R2) POINT TO NEXT NAME... @V305132 00897000 CLC 0(8,R2),FENCE END OF LIST? @V305132 00898000 BNE DLBLOOP NO, CONT. TO LOOP THRU LIST @V305132 00899000 NI VSAMFLG1,255-VSAMSERV SET OFF INCASE DUMMY CALLS@V305132 00900000 CLC DUMDUM(8),CLEAR IS THIS CLEAR CALL? @V305132 00901000 BNER R14 NO, RETURN TO CALLER @V305132 00902000 FRETLIST EQU * FRET THE DDNAME LIST AREA @V305132 00903000 LR R1,R4 RESTORE A(BUFFER) @V305132 00904000 LR R4,R14 PRESERVE OUR R14 @VM03128 00905000 DMSFRET DWORDS=17,LOC=(1),TYPCALL=BALR @VM03093 00906000 LR R14,R4 RESTORE OUR R14 @VM03128 00907000 BR R14 RETURN TO CALLER @V305132 00908000 EXMOVE MVC 0(*-*,R2),0(R1) FROM 'CMNDLIST' TO DDNAME BUFFR@V305132 00909000 SPACE 00910000 ERR228E DMSERR TEXT='NO DDNAME ENTERED',LET=E,NUM=228 @V305132 00911000 LA R15,24 @V305132 00912000 OI AMSFLAG,NOCLEARS DON'T CLEAR TLBLS @V305132 00913000 B AMSRETRN @V305132 00914000 ERR109S DMSERR LET=S,NUM=109,TEXT='VIRTUAL STORAGE CAPACITY EXCEEDED' 00915000 LA R15,104 @V305132 00916000 B AMSRETRN @V305132 00917000 F4096 DC F'4096' @V305132 00918000 EJECT 00919000 SAMETAPE DS 0H 'TAPIN' & 'TAPOUT' SPEC SAME TAPE@V305132 00920000 LA R3,EMSG66 R3 POINTS TO MSG TEXT @V305132 00921000 LA R4,CON66 ERROR MESSAGE NUMBER 066 @V305066 00922000 LM R5,R6,STTAPIN PT. TO 'TAPIN' & 'TAPOUT' ON CMD @V305132 00923000 DMSERR MF=(E,'SYS'),LET=E,NUM=(4),TEXTA=(3),DOT=NO, @V305132X00924000 SUB=(CHAR8A,((5),16),CHAR8A,((6),16)),TYPCALL=SVC 00925000 B ERROR24 GO GIVE RETURN-CODE = 24 AND EXIT@V305132 00926000 INCOMPAT EQU * OUTPUT FNAME AND (PRNT BOTH GIVEN@V305132 00927000 LA R3,EMSG66P R3 POINTS TO MSG TEXT @V305132 00928000 LA R4,CON66 ERROR MESSAGE NUMBER 66 @V305066 00929000 LA R6,OUTPUTFN POINT TO OUTPUT FILE NAME @V305132 00930000 B ER24PRNT JOIN GENERAL ERROR 24 HANDLER. @V305132 00931000 SPACE 00932000 INVALOPR EQU * INVAL XTRA OPERAND(S) ON CMD LINE@V305132 00933000 LA R6,24(,R2) POINT TO FIRST EXTRANEOUS OPERAND@V305132 00934000 LA R3,EMSG70 POINT TO ERROR MESSAGE @V305132 00935000 LA R4,CON70 ERROR MESSAGE NUMBER 070 @V305066 00936000 B ER24PRNT GIVE ERROR MSG & RET. CODE OF 24 @V305132 00937000 EJECT 00938000 INVALONE LA R5,CON8 INVAL OPT (EXCL'NG TAPIN/TAPOUT) @V305066 00939000 B ERROR3JN @V305132 00940000 INVALTWO LA R5,CON16 INVAL 2-WD OPT (EG. TAPIN/TAPOUT)@V305066 00941000 * CONTINUE 00942000 ERROR3JN EQU * ERROR 3 VARIOUS PATHS JOIN HERE: @V305132 00943000 LA R3,EMSG5 R3 POINTS TO MSG TEXT @V305132 00944000 LA R4,CON3 ERROR MESSAGE NUMBER 003 @V305066 00945000 LR R6,R2 R6 POINTS TO OPTION @V305132 00946000 DMSERR MF=(E,'SYS'),LET=E,NUM=(4),TEXTA=(3),DOT=NO, @V305132X00947000 SUB=(CHAR8A,((6),(5))),TYPCALL=SVC @V305132 00948000 LA R15,TWENTY4 RETURN CODE MUST = 24 @V305066 00949000 B EXIT GO EXIT. @V305132 00950000 EJECT 00951000 TAPNOTAT EQU * TAPIN OR TAPOUT IS NOT ATTACHED: @V305132 00952000 LR R14,R4 REM'BR R4=A(INTAPX) OR A(OUTAPX) @V305132 00953000 LA R4,CON113 ERROR MESSAGE NUMBER 113 @V305066 00954000 LA R3,EMSG6 ASSUME IT'S TAPIN NOT ATTACHED @V305132 00955000 LA R15,INTAPX SEE IF WE WERE RIGHT @V305132 00956000 CR R14,R15 ... @V305132 00957000 BE NOTAPIN YES @V305132 00958000 LA R3,EMSG7 NO - NOBODY'S PERFECT @V305132 00959000 NOTAPIN L R6,TAPINDEV-INTAPX(,R14) PICK UP TAPE-ADDRESS @V305132 00960000 DMSERR MF=(E,'SYS'),LET=S,NUM=(4),TEXTA=(3),DOT=NO, @VM03213X00961000 SUB=(HEX,(6)),TYPCALL=SVC @V305132 00962000 LA R15,CON100 RETURN CODE = 100 (SIC) @V305066 00963000 B EXIT AND GO EXIT. @V305132 00964000 AMSDIS DC X'00' @VA06258 00964300 AMSENA DC X'FF' @VA06258 00964600 EJECT 00965000 * 00966000 * SUBROUTINE (VIA R5) TO GIVE TYPE 'E' ERROR MESSAGES: 00967000 * 00968000 ERRMSG DMSERR MF=(E,'SYS'),LET=E,NUM=(4),TEXTA=(3),DOT=NO, @V305132X00969000 SUB=(CHAR8A,(6)),TYPCALL=SVC @V305132 00970000 BR R5 RETURN TO ERROR HANDLER @V305132 00971000 * 00972000 * SIMILAR SUBROUTINE (VIA R5) FOR 'SEVERE' ERROR MESSAGES: 00973000 * 00974000 SEVERMSG DMSERR MF=(E,'SYS'),LET=S,NUM=(4),TEXTA=(3),DOT=NO, @V305132X00975000 SUB=(CHAR8A,(6)),TYPCALL=SVC @V305132 00976000 BR R5 RETURN TO ERROR HANDLER @V305132 00977000 EJECT 00978000 * 00979000 * RESPONSE SKELETONS: 00980000 * 00981000 RESP1 DC AL1(L'RESPON1+L'RESPON1A) @V305132 00982000 RESPON1 DC C'FILE ''........ LISTING ' @V305132 00983000 RESPON1A DC C'Z1'' WILL HOLD AMSERV OUTPUT' (MODE-LTR REPLD)@V305132 00984000 * 00985000 * ERROR MESSAGE SKELETONS: 00986000 * 00987000 EMSG1 DC AL1(L'ERMSG1) @V305132 00988000 ERMSG1 DC C'NO FILENAME SPECIFIED' @V305132 00989000 SPACE 00990000 EMSG2 DC AL1(L'ERMSG2) @V305132 00991000 ERMSG2 DC C'FILE ''........ AMSERV'' NOT FOUND' @V305132 00992000 SPACE 00993000 EMSG3 DC AL1(L'ERMSG3) @V305132 00994000 ERMSG3 DC C'FILE ''....................'' NOT FIXED, 80-CHAR. RECOX00995000 RDS' @V305132 00996000 SPACE 00997000 EMSG4 DC AL1(L'ERMSG4) @V305132 00998000 ERMSG4 DC C'NO READ/WRITE DISK ACCESSED FOR ''........ LISTING''' 00999000 SPACE 01000000 EMSG5 DC AL1(L'ERMSG5) @V305132 01001000 ERMSG5 DC C'INVALID OPTION ''.........................''' @V305132 01002000 SPACE 01003000 EMSG6 DC AL1(L'ERMSG6) @V305132 01004000 ERMSG6 DC C'TAPIN (...) NOT ATTACHED' @V305132 01005000 SPACE 01006000 EMSG7 DC AL1(L'ERMSG7) @V305132 01007000 ERMSG7 DC C'TAPOUT (...) NOT ATTACHED' @V305132 01008000 SPACE 01009000 EMSG8 DC AL1(L'ERMSG8) @V305132 01010000 ERMSG8 DC C'UNABLE TO LOAD ''IDCAMS.''' @V305132 01011000 SPACE 01012000 EMSG65 DC AL1(L'ERMSG65) @V305132 01013000 ERMSG65 DC C'''......'' OPTION SPECIFIED TWICE' @V305132 01014000 SPACE 01015000 EMSG66 DC AL1(L'ERMSG66) @V305132 01016000 ERMSG66 DC C'''..............'' AND ''..............'' ARE CONFLICTX01017000 ING OPTIONS.' @V305132 01018000 SPACE 01019000 EMSG66P DC AL1(L'ERMSG66P) @V305132 01020000 ERMSG66P DC C'''........'' AND ''PRINT'' ARE CONFLICTING OPTIONS.' 01021000 SPACE 01022000 EMSG70 DC AL1(L'ERMSG70) @V305132 01023000 ERMSG70 DC C'INVALID PARAMETER ''........''' @V305132 01024000 EJECT 01025000 * 01026000 * FILLED-IN PARAMETER-LISTS: 01027000 * 01028000 FNDINPUT DS 0D P-LIST TO FIND INPUT: @V305132 01029000 DC CL8'STATE' STATE ... @V305132 01030000 INPUTFIL DC CL8'XXXX' FILENAME (FILLED IN) @V305132 01031000 DC CL8'AMSERV' FILETYPE @V305132 01032000 INPUTMOD DC CL2'*' FILE MODE (WHEREVER WE FIND IT) @V305132 01033000 DC H'0' (NOT USED BY 'STATE') @V305132 01034000 ACOPYFST DC A(*-*) 'STATE' SETS THIS TO V(STATEFST) @V305132 01035000 DC X'FFFFFFFF' END OF 'STATE' P-LIST. @V305132 01036000 SPACE 01037000 CHEKNAM2 DS 0F P-LIST TO CK VALIDITY OF 'FNAME2'@V305132 01038000 DC CL8'STATEW' STATEW ... @V305132 01039000 STATEWFN DC CL8'XXXX' FILENAME (FILLED IN) @V305132 01040000 DC CL8'LISTING' FILETYPE @V305132 01041000 STATEWFM DC CL2'Z' FILE MODE (FILLED IN) @V305132 01042000 DC H'0' (NOT USED BY 'STATEW') @V305132 01043000 DC A(*-*) 'STATEW' SETS THIS TO V(STATEFST)@V305132 01044000 DC X'FFFFFFFF' END OF 'STATEW' P-LIST. @V305132 01045000 SPACE 01046000 SETDOSON DC CL8'SET' 'SET DOS ON' @V305132 01047000 DC CL8'DOS' ... @V305132 01048000 DC CL8'ON' ... @V305132 01049000 DC CL8'(' @V305132 01050000 DC CL8'VSAM' @V305132 01051000 DC X'FFFFFFFF' END OF P-LIST. @V305132 01052000 * 01053000 * P-LIST TO 'ASSGN' THE 'SYSIPT': 01054000 * 01055000 SETIPT DC CL8'ASSGN' APPROPRIATE 'ASSGN' P-LIST: @V305132 01056000 DC CL8'SYSIPT' ... @V305132 01057000 SETIPTDV DC CL8'X' (DISK-MODE FILLED IN) @V305132 01058000 DC X'FFFFFFFF' END OF P-LIST. @V305132 01059000 * 01060000 * P-LIST TO SET FOR INPUT FROM THE CMS FILE: 01061000 * 01062000 INPUDLBL DC CL8'DLBL' APPROPRIATE 'DLBL' P-LIST: @V305132 01063000 DC CL8'SYSIPT' ... @V305132 01064000 INPUMODE DC CL8'ZN' FILEMODE (FILLED IN) @V305132 01065000 DC CL8'CMS' ... @V305132 01066000 INPUNAME DC CL8'XXXX' FILENAME (FILLED IN) @V305132 01067000 INPUTYPE DC CL8'AMSERV' ... @V305132 01068000 DC CL8'(' ... @V305132 01069000 DC CL8'SYSIPT' ... @V305132 01070000 DC X'FFFFFFFF' END OF 'DLBL' P-LIST. @V305132 01071000 EJECT 01072000 * 01073000 * P-LIST TO 'ASSGN' THE 'SYSLST': 01074000 * 01075000 SETLST DC CL8'ASSGN' APPROPRIATE 'ASSGN' P-LIST: @V305132 01076000 DC CL8'SYSLST' ... @V305132 01077000 SETLSTDV DC CL8'X' (DISK-MODE FILLED IN HERE) @V305132 01078000 DC X'FFFFFFFF' END OF P-LIST. @V305132 01079000 * 01080000 * OUTPUT WILL BE ON THE PRINTER: 01081000 * 01082000 OUTPRINT DC CL8'ASSGN' APPROPRIATE 'ASSGN' P-LIST: @V305132 01083000 DC CL8'SYSLST' ... @V305132 01084000 DC CL8'PRINTER' ... @V305132 01085000 DC X'FFFFFFFF' END OF P-LIST. @V305132 01086000 * 01087000 * OUTPUT WILL BE TO A CMS FILE: 01088000 * 01089000 OUTPDLBL DC CL8'DLBL' APPROPRIATE 'DLBL' P-LIST: @V305132 01090000 DC CL8'SYSLST' ... @V305132 01091000 OUTPMODE DC CL8'Z1' FILEMODE (FILLED IN) @V305132 01092000 DC CL8'CMS' ... @V305132 01093000 OUTPNAME DC CL8'YYYY' FILENAME (FILLED IN) @V305132 01094000 DC CL8'LISTING' ... @V305132 01095000 DC CL8'(' ... @V305132 01096000 DC CL8'SYSLST' ... @V305132 01097000 DC X'FFFFFFFF' END OF 'DLBL' P-LIST. @V305132 01098000 * 01099000 * TAPE-INPUT WILL BE NEEDED: 01100000 * 01101000 INPUTAPE DC CL8'ASSGN' APPROPRIATE 'ASSGN' P-LIST: @V305132 01102000 DC CL8'SYS004' ... @V305132 01103000 INTAPX DC CL8'TAPX' TAP1/TAP2/TAP3/TAP4 (FILLED IN) @V305132 01104000 DC X'FFFFFFFF' END OF P-LIST. @V305132 01105000 TAPINDEV DC F'0' 'TAPIN' VIRTUAL DEVICE ADDRESS @V305132 01106000 * 01107000 * TAPE-OUTPUT WILL BE NEEDED: 01108000 * 01109000 OUTPTAPE DC CL8'ASSGN' APPROPRIATE 'ASSGN' P-LIST: @V305132 01110000 DC CL8'SYS005' ... @V305132 01111000 OUTAPX DC CL8'TAPX' TAP1/TAP2/TAP3/TAP4 (FILLED IN) @V305132 01112000 DC X'FFFFFFFF' END OF P-LIST. @V305132 01113000 TAPOUTDV DC F'0' 'TAPOUT' VIRTUAL DEVICE ADDRESS @V305132 01114000 SPACE 01115000 DUMLIST DC CL8'DLBL' @V305132 01116000 DUMNAME DC CL8' ' @V305132 01117000 DUMDUM DC CL8'DUMMY' @V305132 01118000 DUMOPT DC CL8'(' @V305132 01119000 DUMSYS DC CL8' ' @V305132 01120000 FENCE DC 8X'FF' @V305132 01121000 SPACE 01122000 ATAPIBUF DC A(0) POINTR TO TAPIN DDNAME LIST @V305132 01123000 ATAPOBUF DC A(0) POINTR TO TAPOUT DDNAME LIST@V305132 01124000 SPACE 01125000 ERRSAVE DC H'0' @V305132 01126000 EJECT 01127000 ERASEOLD DS 0D P-LIST TO ERASE OLD LISTING FILE:@V305132 01128000 DC CL8'ERASE' ERASE @V305132 01129000 OUTPUTFN DC CL8'YYYY' OUTPUT FILENAME (FILLED IN) @V305132 01130000 DC CL8'LISTING' OUTPUT FILETYPE @V305132 01131000 OUTPUTFM DC CL8'Z' OUTPUT FILEMODE (FILLED IN) @V305132 01132000 DC X'FFFFFFFF' END OF 'ERASE' P-LIST. @V305132 01133000 SPACE 01134000 CLRDLBLI DC CL8'DLBL' CLEAR DLBL ISSUED FOR INPUT FILE:@V305132 01135000 DC CL8'SYSIPT' ... @V305132 01136000 DC CL8'CLEAR' ... @V305132 01137000 DC X'FFFFFFFF' ... @V305132 01138000 SPACE 01139000 CLRDLBLO DC CL8'DLBL' CLEAR DLBL ISSUED FOR OUTPUT FILE@V305132 01140000 DC CL8'SYSLST' ... @V305132 01141000 CLEAR DC CL8'CLEAR' ... @V305132 01142000 DC 8X'FF' ... @V305132 01143000 SPACE 01144000 CLRVSAM DC CL8'DMSVSR' DMSVSR = SUBRTN TO "RESET VSAM" @V305132 01145000 DC X'FFFFFFFF' ... @V305132 01146000 SPACE 1 01147000 ADTLKWPL DC CL2'* ' "PARAMETER LIST" FOR 'ADTLKW' @V305132 01148000 SPACE 01149000 SAVE14 DS F @V305132 01150000 SPACE 01151000 DS 0D @V305132 01152000 DASSGN DC CL8'ASSGN' @V305132 01153000 SYSXXX DC CL8'SYS' @V305132 01154000 MODE DC CL8' ' @V305132 01155000 DC 8X'FF' @V305132 01156000 SPACE 1 01157000 DLUT DC CL4' 000' @V305132 01158000 DC CL4' 001' @V305132 01159000 DC CL4' 002' @V305132 01160000 DC CL4' 003' @V305132 01161000 DC CL4' 004' @V305132 01162000 DC CL4' 005' @V305132 01163000 DC CL4' 006' @V305132 01164000 DC CL4' 007' @V305132 01165000 DC CL4' 008' @V305132 01166000 DC CL4' 009' @V305132 01167000 DUMFLAG DC X'40' @V305132 01168000 DUMUNIT DC CL3'010' @V305132 01169000 * 'DUMFLAG' SETTINGS 01170000 DUMDS EQU X'80' DUMMY DATASET SPECIFIED @V305132 01171000 * X'40' FLAG INITIALIZED TO BLANK 01172000 DUMCAT EQU X'20' SYSCAT IS DUMMY @V305132 01173000 * 01174000 EJECT 01175000 AMSFLAG DC X'00' FLAG FOR REMEMBERING STUFF: @V305132 01176000 * 01177000 * AMSFLAG DEFINITIONS: 01178000 * 01179000 OUTFILSP EQU X'80' OUTPUT FILE WAS SPECIFIED @V305132 01180000 PRINTF EQU X'40' 'PRINT' WAS SPECIFIED @V305132 01181000 TAPINF EQU X'20' 'TAPIN' WAS SPECIFIED @V305132 01182000 TAPOUTF EQU X'10' 'TAPOUT' WAS SPECIFIED @V305132 01183000 AMSLODED EQU X'08' IDCAMS LOADED BY DCSS CODE @V305132 01184000 STXACT EQU X'04' STXIT EXIT IS ACTIVE @V305132 01185000 NOCLEARS EQU X'02' NO TLBL CLEARS PLEASE @V305132 01186000 SPACE 01187000 STTAPIN DC A(*-*) START OF 'TAPIN XXX' OPTION @V305132 01188000 STTAPOUT DC A(*-*) START OF 'TAPOUT YYY' OPTION @V305132 01189000 SPACE 01190000 * 9-BYTE AREAS FOR "SAVING" & "RESTORING" ASSGN'S: 01191000 * FIRST BYTE: X'FF' = NO ASSGN WAS IN EFFECT. 01192000 * X'FE' = ASSGN WAS TO BE IGNORED 01193000 * OTHER = INDEX TO PUB TABLE. 01194000 SAVEIPT DC X'FF',8X'00' SYSIPT @V305132 01195000 SAVELST DC X'FF',8X'00' SYSLST @V305132 01196000 SAVE004 DC X'FF',8X'00' SYS004 @V305132 01197000 SAVE005 DC X'FF',8X'00' SYS005 @V305132 01198000 SPACE 01199000 * EQUATES FOR DISPLACEMENTS FROM LUB-TABLE: 01200000 EQUIPT EQU 2 SYSIPT @V305132 01201000 EQULST EQU 6 SYSLST @V305132 01202000 EQU004 EQU 28+8 SYS004 @V305132 01203000 EQU005 EQU 28+10 SYS005 @V305132 01204000 SPACE 01205000 * OTHER CONSTANTS ETC.: 01206000 SPACE 01207000 EXPRINT CLC DCPRINT(*-*),0(R2) EX TO CK FOR 'P' TO 'PRINT' @V305132 01208000 DCPRINT DC CL6'PRINT ' (FOR 'PRINT' OPTION) @V305132 01209000 SPACE 01210000 AMSPARMS DS 0D PARMS PASSED TO IDCAMS (IF ANY) @V305132 01211000 AMSPARM1 DC F'0' @V305132 01212000 AMSPARM2 DC F'0' @V305132 01213000 AMSPARM3 DC F'0' @V305132 01214000 AMSPARM4 DC X'80000000' HIGH BIT MEANS "THE END". @V305132 01215000 SPACE 1 01216000 * ** KEEP NEXT THREE FIELDS TOGETHER ** 01217000 STXSAVE DS 18F STXIT SAVEAREA (NOT REALLY USED) @V305132 01218000 DC A(DMSAMS+4096) ADDRS OF DMSAMS+4096 AND DMSAMS @V305132 01219000 DC A(DMSAMS) FOR RESTORING ADDR'BILITY WHEN @V305132 01220000 * ENTERING STXIT EXIT 01221000 SPACE 2 01222000 FF EQU X'FF' @V305066 01223000 LFTPAREN EQU C'(' @V305066 01224000 MASK EQU B'0111' @V305066 01225000 ZERO EQU X'00' @V305066 01226000 FIXED EQU C'F' @V305066 01227000 A EQU C'A' @V305066 01228000 P EQU C'P' @V305066 01229000 F EQU C'F' @V305066 01230000 FE EQU X'FE' @V305066 01231000 CON80 EQU 80 @V305066 01232000 CON722 EQU 722 @V305066 01233000 CON16 EQU 16 @V305066 01234000 CON8 EQU 8 @V305066 01235000 CON4 EQU 4 @V305066 01236000 CON1 EQU 1 @V305066 01237000 CON2 EQU 2 @V305066 01238000 CON3 EQU 3 @V305066 01239000 CON28 EQU 28 @V305066 01240000 CON7 EQU 7 @V305066 01241000 CON6 EQU 6 @V305066 01242000 CON136 EQU 136 @V305066 01243000 CON104 EQU 104 @V305066 01244000 CON130 EQU 130 @V305066 01245000 CON66 EQU 66 @V305066 01246000 CON70 EQU 70 @V305066 01247000 CON113 EQU 113 @V305066 01248000 CON100 EQU 100 @V305066 01249000 ONE EQU C'1' @V305066 01250000 FOUR EQU C'4' @V305066 01251000 BLANK EQU C' ' @V305066 01252000 RTPAREN EQU C')' @V305066 01253000 PROG EQU X'01' @V305066 01254000 SYS010 EQU X'0A' @V305066 01255000 HEX0F EQU X'0F' @V305066 01256000 TWELVE EQU 12 @V305066 01257000 SVC65 EQU 65 @V305066 01258000 CHAR0 EQU C'0' @V305066 01259000 NINE EQU C'9' @V305066 01260000 THREE EQU 3 @V305066 01261000 TWENTY4 EQU 24 @V305066 01262000 THIRTY2 EQU 32 @V305066 01263000 THIRTY6 EQU 36 @V305066 01264000 SIXTY5 EQU 65 @V305066 01265000 EJECT 01266000 LTORG (OTHER CONSTANTS) @V305132 01267000 SPACE 01268000 ENTRY END$AMS END OF ... @V305132 01269000 END$AMS DS 0F ... DMSAMS (AMSERV). @V305132 01270000 EJECT 01271000 NUCON @V305132 01272000 BGCOM @V305132 01273000 REGEQU @V305132 01274000 ADT @V305132 01275000 FSTB @V305132 01276000 DOSCB @V305132 01277000 SYSNAMES @V305132 01278000 END 01279000