ibm:vm370-lib:cms:dmsams.assemble_src
Table of Contents
DMSAMS Source
References
- Fixes Applied : 1
- This Source Date : Tuesday, December 12, 1978
- Last Fix ID : [HRC002DS]
Source Listing
- DMSAMS.ASSEMBLE.txt
- 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 <FNAME2> < (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
ibm/vm370-lib/cms/dmsams.assemble_src.txt · Last modified: 2023/08/06 13:35 by Site Administrator