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