*TITLEDDALOC -- DYNAMIC ALLOCATION (SVC 99) INTERFACE - ALLOCATION 00000100 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** *A AUTHOR BOB BENSON - BELL HELICOPTER TEXTRON 00000200 *A DESIGNER BOB BENSON 00000300 *A LANGUAGE ASSEMBLER 00000400 *A SYSTEM S/370 00000500 *A WRITTEN 03-12-79 00000600 * REVISED MM-DD-YY BY PROGRAMMER FOR REASON 00000700 * 00000800 * REVISED 08/29/85 NAM ADD WAIT FOR UNIT ON DSNAME ALLOCATE. 00000900 * INVOLVES USING SVC230 INSTEAD OF SVC 00001000 * 99 TO BECOME TEMPORARILY AUTHORIZED. 00001100 * REVISED 12/17/86 REM. INCREASE FIXSPACE BY 4 BYTES TO ALLOW 1 00001200 * EXTRA WORD IN CASE DSNAME IS NOT USED. 00001300 * REVISED 08/12/87 REM. FIX CLASS CHECK FOR SYSOUT SPEC (X'0018') 00001400 * REVISED 10/07/87 WAB. ADDED TRACK OVERFLOW OPTION FOR UNDEFINED 00001500 * RECFM (UT) 00001600 * REVISED 10/26/87 REM. ADD AUTHORIZED FLAG FOR MOUNT ATTRIBUTE. 00001700 *A 00001800 *A CALL DDALOC (NUNIT, KEYS, PARMS, DSNAME, IERR, JERR) 00001900 *A 00002000 *A IN/OUT ARGUMENT TYPE DESCRIPTION 00002100 *A 00002200 *A IN NUNIT I4 NUMBER OF KEYS PROVIDED IN KEY/PARM 00002300 *A ARRAYS. 00002400 *A IN KEYS I4 KEYS(N) IS A SINGLE WORD, INTEGER ARRAY 00002500 *A CONTAINING FLAGS TO INDICATE WHAT ACTION 00002600 *A IS BEING REQUESTED. 00002700 *A IN PARMS I8 PARMS(NUNIT) IS A DOUBLE WORD. INTEGER 00002800 *A ARRAY THAT HOLDS THE DATA FOR THE PARM 00002900 *A FIELDS. 00003000 *A IN/OUT DSNAME 12I4 46 BYTE AREA WHICH CONTAINS THE DSNAME TO 00003100 *A BE ALLOCATED, OR BLANKS IF A NAME IS TO 00003200 *A BE RETURNED. 00003300 *A OUT IERR I4 OUTPUT SINGLE WORD INTEGER WHICH 00003400 *A REPRESENTS IERR GE 0 RETURN CODE FROM SVC 00003500 *A 99. IF IERR GE 4, THE ALLOCATION WAS 00003600 *A REQUESTED BUT FAILED. 00003700 *A IERR LT 0 RETURN CODE FROM DDALOC. AN 00003800 *A ERROR WAS DETECTED WHILE BUILDING THE SVC 00003900 *A 99 CONTROL BLOCKS AND PROCESSING WAS 00004000 *A TERMINATED; THE SVC WAS NOT ISSUED. 00004100 *A OUT JERR I4 4 BYTE FIELD. 1ST 2 BYTES CONTAINS THE 00004200 *A ERROR RETURN CODE FIELD FROM SVC 99. THE 00004300 *A NEXT 2 BYTES IS THE INFO RETURN CODE 00004400 *A FIELD FROM SVC 99. 00004500 *A 00004600 *A 00004700 *A DDALOC PROVIDES A FORTRAN-CALLABLE INTERFACE TO THE DYNAMIC 00004800 *A ALLOCATION FACILITIES PROVIDED BY OS/VS2 REL3.7. 00004900 *A DDALOC BUILDS THE REQUEST BLOCKS AND INVOKES SVC 99 (DYNALLOC) 00005000 *A TO PERFORM ALLOCATION BY DSNAME. 00005100 *A 00005200 * EJECT 00005300 * 00005400 ********* MACRO DEFINITIONS ***** 00005500 * 00005600 SPACE 2 00005700 MACRO 00005800 &NAME SETTEXT &KEY,&NUM,&LEN 00005900 AIF (N'&NAME EQ 0).SKIP2 00006000 &NAME EQU * 00006100 .SKIP2 ANOP 00006200 ST R6,S99TUPTR CHAIN IN THE TEXT UNIT PTR 00006300 LA R8,&KEY PICK UP PROPER KEY 00006400 STH R8,S99TUKEY STORE IN TEXT UNIT 00006500 LA R8,&NUM NUMBER OF PARMS 00006600 STH R8,S99TUNUM STORE IN TEXT UNIT 00006700 AIF (&NUM EQ C'0').SKIP3 JUMP IF NO PARM 00006800 LA R8,&LEN PICK UP PARM LENGTH 00006900 STH R8,S99TULNG STORE IN TEXT UNIT 00007000 .SKIP3 ANOP 00007100 MEND 00007200 SPACE 00007300 MACRO 00007400 &NAME CHECKEY &VAL,&PUT,&NEXT,&OVER 00007500 AIF (N'&NAME EQ 0).SKIP3 00007600 &NAME EQU * 00007700 .SKIP3 AIF (K'&VAL EQ 1).SCLI 00007800 LCLA &LVAL 00007900 &LVAL SETA K'&VAL 00008000 CLC 0(&LVAL,R2),=C'&VAL' CHECK VALUE 00008100 AGO .SBNE 00008200 .SCLI CLI 0(R2),C'&VAL' CHECK VALUE 00008300 .SBNE BNE &NEXT BRANCH IF NOT EQUAL 00008400 AIF (K'&PUT EQ 2).SMVI 00008500 MVC S99TUPAR(2),=X'&PUT' 00008600 AGO .SOVER 00008700 .SMVI MVI S99TUPAR,X'&PUT' INSERT CORRECT KEY 00008800 .SOVER AIF (N'&OVER EQ 0).SKIP4 00008900 B &OVER MOVE ALONG 00009000 .SKIP4 ANOP 00009100 MEND 00009200 EJECT 00009300 DDALOC START 0 00009400 SPACE 2 00009500 * REGISTER SYNONYMS 00009600 SPACE 2 00009700 R0 EQU 0 REGISTER 00 00009800 R1 EQU 1 REGISTER 01 00009900 R2 EQU 2 REGISTER 02 00010000 R3 EQU 3 REGISTER 03 00010100 R4 EQU 4 REGISTER 04 00010200 R5 EQU 5 REGISTER 05 00010300 R6 EQU 6 REGISTER 06 00010400 R7 EQU 7 REGISTER 07 00010500 R8 EQU 8 REGISTER 08 00010600 R9 EQU 9 REGISTER 09 00010700 R10 EQU 10 REGISTER 10 00010800 R11 EQU 11 REGISTER 11 00010900 R12 EQU 12 REGISTER 12 00011000 R13 EQU 13 REGISTER 13 00011100 R14 EQU 14 REGISTER 14 00011200 R15 EQU 15 REGISTER 15 00011300 SPACE 5 00011400 SAVE (14,12),T,* SAVE REGISTERS 00011500 USING DDALOC,R15 TO GET THIS ACT GOING 00011600 LM R11,R12,ADDALOC ASSURE ADDRESSIBILITY 00011700 USING DDALOC,R11 THROUGHOUT 00011800 USING DDALOC+4096,R12 THIS PROGRAM. 00011900 DROP R15 00012000 B *+12 00012100 SPACE 00012200 ADDALOC DC A(DDALOC,DDALOC+4096) 00012300 SPACE 00012400 LA R15,SAVE STANDARD PROLOGUE 00012500 ST R13,4(,R15) TO LINK 00012600 ST R15,8(,R13) THE 00012700 LR R13,R15 SAVE AREAS 00012800 SPACE 2 00012900 * 00013000 * ACQUIRE PARAMETER LIST 00013100 * 00013200 ST R1,PLISTADR SAVE ADDRESS OF PARAMETER LIST 00013300 LM R2,R7,0(R1) LOAD PARAMETER ADDRESSES 00013400 STM R2,R7,PARAMLST SAVE PARAMETER ADDRESSES 00013500 L R2,0(R2) NUMBER OF KEYS/PARMS 00013600 ST R2,NUNITS SAVE THIS NUMBER 00013700 SPACE 2 00013800 LTR R2,R2 ASSURE NUNITS > 0 00013900 BP GOUNITS BRANCH IF GOOD 00014000 SPACE 00014100 * NO TEXT UNITS REQUESTED - BLOW IT OFF 00014200 SPACE 00014300 NOUNITS LA R15,1 ERROR CODE 00014400 LCR R15,R15 IS -1 00014500 ST R15,0(R6) STORE IN IERR 00014600 B GOHOME SHUT IT DOWN 00014700 EJECT 00014800 * 00014900 * SCAN DOWN KEYS ARRAY TO DETERMINE HOW MUCH CORE WILL BE NEEDED 00015000 * TO HANDLE ALL THE INPUT REQUESTS 00015100 * 00015200 SPACE 00015300 GOUNITS L R1,FIXSPACE LOAD FIXED SPACE LENGTH 00015400 LA R6,1 FOR OFFSET CALC'S 00015500 LA R7,0 FOR KEY RANGE CHECKS 00015600 LA R8,98 FOR KEY RANGE CHECKS 00015700 * 00015800 LGLOOP L R4,0(R3) PICK UP REQUEST CODE 00015900 CR R4,R7 CHECK KEY > 0 00016000 BNH BADKEY BRANCH IF NOT 00016100 CR R4,R8 CHECK KEY < 98 00016200 BNL BADKEY BRANCH IF NOT 00016300 SR R4,R6 CONVERT CODE TO OFFSET 00016400 SLL R4,1 IN HALFWORD TABLE 00016500 LH R5,PRMLEN(R4) OBTAIN PARM LENGTH ESTIMATE 00016600 AR R1,R5 SUM LENGTHS 00016700 LA R3,4(R3) STEP TO NEXT REQUEST 00016800 BCT R2,LGLOOP LOOP THRU REQUEST ARRAY 00016900 SPACE 00017000 * 00017100 * DETERMINE LENGTH OF THE DSNAME 00017200 * 00017300 L R2,ADSNAME GET DSNAME ADDRESS 00017400 CLI 0(R2),X'40' SEE IF ITS THERE 00017500 BE SNODSN BRANCH IF NONE 00017600 SPACE 00017700 LA R5,1 R5 = LENGTH OF DSNAME 00017800 LA R6,1 COUNTER WITH WHICH TO INCREMENT 00017900 LA R3,43 SCOPE OUT THE DSNAME 00018000 DSNSCN LR R4,R2 STARTING AT 00018100 AR R4,R5 THE FRONT 00018200 CLI 0(R4),X'40' LOOK FOR ENDING BLANK 00018300 BE ENDDSN BRANCH IF FOUND 00018400 AR R5,R6 KICK UP LENGTH 00018500 BCT R3,DSNSCN LOOP WILL TERMINATE OR MAXOUT AT 43 00018600 ENDDSN ST R5,DSNLGTH SAVE DSN LENGTH 00018700 LA R4,10 INCREMENT FOR TEXT UNIT POINTERS 00018800 AR R5,R4 AND HEADERS 00018900 AR R1,R5 COMPUTE GETMAIN LENGTH 00019000 B GETSET GO DO GETMAIN 00019100 SPACE 00019200 SNODSN LA R3,0 NO DSN ==> NO LENGTH 00019300 ST R3,DSNLGTH REMEMBER IT 00019400 SPACE 2 00019500 * 00019600 * PREPARE FOR BUILDING SVC 99 CONTROLS BY GETTING CORE FOR THEM 00019700 * 00019800 SPACE 00019900 GETSET ST R1,GETLGTH SAVE GETMAIN LENGTH 00020000 LR R0,R1 PUT REQUEST IN R0 00020100 SPACE 2 00020200 GETMAIN R,LV=(0) 00020300 SPACE 2 00020400 ST R1,AGETRB SAVE ADDRESS 00020500 SPACE 2 00020600 SR R8,R8 CLEAR R8 00020700 ST R8,ARDDNAME INDICATE NO 00020800 ST R8,ARDSNAME DATA RETURN 00020900 ST R8,ARDSORG UNITS 00021000 ST R8,ARVOLSER ENCOUNTERED 00021100 EJECT 00021200 * 00021300 * WE NOW EMBARK ON THAT MOST PERILOUS OF ENDEAVORS, THE BUILDING 00021400 * OF THE SVC 99 REQUEST CONTROL BLOCKS. WE NEED TO KNOW MANY THINGS 00021500 * DURING THIS LONG AND DANGEROUS TASK, SO WE RESERVE THE FOLLOWING 00021600 * REGISTERS TO POINT AT THE FOLLOWING WILD BEASTIES: 00021700 * R1 --> CURRENT KEY REQUEST 00021800 * R2 --> CURRENT PARM VALUE 00021900 * R3 - ADDRESSIBILITY FOR RBPTR 00022000 * R4 - ADDRESSIBILITY FOR RB 00022100 * R5 - ADDRESSIBILITY FOR TEXT UNIT POINTERS 00022200 * R6 - ADDRESSIBILITY FOR TEXT UNITS 00022300 * R7 - NUNITS (VALUE) TO CONTROL LOOPING 00022400 * 00022500 * WHILE IT WILL ALSO BE USED IN BUILDING THE TEXT UNITS, R8 WILL 00022600 * CONTAIN THE TRUE LENGTH OF THE TEXT UNIT WHEN A 'RETURN' IS MADE 00022700 * TO ENDREQ. THE FOLLOWING IN A PSEUDO-'DO CASE' FOR ALL YOU 00022800 * STRUCTURED PROGRAMMING NUTS. 00022900 * 00023000 SPACE 3 00023100 LR R3,R1 00023200 USING S99RBP,R3 ACCESS RBPTR 00023300 LA R4,S99RBPTR+4 00023400 USING S99RB,R4 ACCESS RB 00023500 ST R4,S99RBPTR RBPTR --> RB 00023600 OI S99RBPTR,S99RBPND TURN ON HI ORDER BIT 00023700 XC S99RB(RBLEN),S99RB ZERO ENTIRE RB 00023800 MVI S99RBLN,RBLEN PUT LENGTH IN LENGTH FIELD 00023900 MVI S99VERB,S99VRBAL VERB CODE IS DSNAME ALLOCATE 00024000 MVI S99FLAG2,X'00' INITIALIZE FLAG2 FIELD TO ZERO 00024100 MVC S99FLAG2+1(3),S99FLAG2 00024200 OI S99FLAG2,S99WTUNT WAIT FOR UNIT AUTHORIZED FLAG. 00024300 OI S99FLAG2,S99MOUNT MOUNT AUTHORIZED FLAG. 00024400 LA R5,S99RB+RBLEN 00024500 USING S99TUPL,R5 ACCESS TEXT POINTERS 00024600 ST R5,S99TXTPP POINTS TO POINTERS 00024700 L R7,NUNITS GET NUMBER OF REQUESTS 00024800 LR R6,R7 CALCULATE LENGTH OF PTRS 00024900 LA R8,1 INCREMENT BY ONE 00025000 AR R6,R8 FOR DSNAME 00025100 SLL R6,2 (MULTIPLY BY 4) 00025200 AR R6,R5 THAT'S THAT 00025300 USING S99TUNIT,R6 ACCESS TEXT UNITS 00025400 L R1,AKEYS --> REQUEST KEYS 00025500 L R2,APARMS --> REQUEST PARM VALUES 00025600 EJECT 00025700 * NOW THAT WE'RE ALL SET, STEP THRU THE INPUT TABLES, MERRILY 00025800 * BUILDING TEXT UNITS AS WE GO, TRA-LA, TRA-LA, TRA-LA. 00025900 * 00026000 SPACE 00026100 LA R0,1 1 FOR JUMP CALCULATION 00026200 B CFIND JUMP PAST THE 1ST TIME 00026300 SPACE 00026400 REQLOOP LA R1,4(R1) TO NEXT REQUEST KEY 00026500 LA R2,8(R2) TO NEXT PARM VALUE 00026600 LA R5,4(R5) TO NEXT TEXT PTR 00026700 LA R6,0(R8,R6) TO NEXT TXT UNIT 00026800 SPACE 00026900 CFIND L R9,0(R1) GET KEY VALUE 00027000 SR R9,R0 COMPUTE OFFSET 00027100 SLL R9,2 IN BRANCH TABLE 00027200 LA R8,FIND PICK UP HEAD OF TABLE 00027300 AR R9,R8 COMPUTE JUMP ADDRESS 00027400 BR R9 JUMP TO BRANCH TABLE 00027500 SPACE 00027600 FIND B RQDDNAM DDNAME REQUEST 00027700 B BADPARM DSNAME - THRU ANOTHER PARAMETER 00027800 B RQMEMBR PDS MEMBER REQUEST 00027900 B RQSTATS DATA SET STATUS 00028000 B RQNDISP NORMAL DISPOSITION 00028100 B RQCDISP CONDITIONAL DISPOSITION 00028200 B RQTRK TRACK SPACE ALLOCATION 00028300 B RQCYL CYLINDER SPACE ALLOCATION 00028400 B RQBLKLN BLOCK SPACE ALLOCATION 00028500 B RQPRIME PRIMARY SPACE 00028600 B RQSECND SECONDARY SPACE 00028700 B RQDIR DIRECTORY BLOCKS 00028800 B RQRLSE SPACE RLSE FEATURE 00028900 B RQSPFRM SPACE FORMAT 00029000 B RQROUND ROUND SPACE TO CYL 00029100 B RQVLSER VOL SER SPECIFICATION 00029200 B RQPRIVT VOL=PRIVATE SPEC. 00029300 B RQVLSEQ VOLUME SEQUENCE NUMBER 00029400 B RQVLCNT VOLUME COUNT 00029500 B RQVLRDS VOL=REF=DSNAME - NOT SUPPORTED 00029600 B RQUNIT UNIT TYPE DESCRIPTION 00029700 B RQUNCNT UNIT COUNT SPECIFICATION 00029800 B RQPARAL PARALLEL MOUNT REQUEST 00029900 B RQSYSOU SYSOUT SPECIFICATION 00030000 B RQSPGNM SYSOUT PROGRAM NAME 00030100 B RQSFMNO SYSOUT FORM NUMBER 00030200 B RQOUTLM SYSOUT OUTPUT LIMIT 00030300 B RQCLOSE UNALLOCATE AT CLOSE 00030400 B RQCOPYS SYSOUT COPIES NUMBER 00030500 B RQLABEL LABEL TYPE 00030600 B RQDSSEQ DATA SET SEQUENCE NUMBER 00030700 B RQPASPR PASSWORD PROTECTION REQUEST 00030800 B RQINOUT INPUT/OUTPUT ONLY 00030900 B RQEXPDT EXPIRATION DATE 00031000 B RQRETPD RETENTION PERIOD 00031100 B RQDUMMY DUMMY DATA SET 00031200 B RQFCBIM FCB IMAGE IDENTIFICATION 00031300 B RQFCBAV FORM ALIGNMENT/VERIFICATION 00031400 B RQQNAME QNAME SPECIFICATION (TSO) 00031500 B RQTERM TERMINAL DD SPEC. ( DD(*) ) 00031600 B RQUCS UNIV. CHAR. SET 00031700 B RQUFOLD FOLD MODE (PRINTER) 00031800 B RQUVRFY CHAR. SET IMAGE VERIFICATION 00031900 B RQDCBDS DCB REF TO DSNAME 00032000 B RQDCBDD DCB REF TO DDNAME 00032100 B RQBFALN BUFFER ALIGNMENT (BFALN) 00032200 B RQBFTEK BUFFER TECHNIQUE (BFTEK) 00032300 B RQBLKSZ BLKSIZE 00032400 B RQBUFIN BUFIN SPECIFICATION 00032500 B RQBUFL BUFL SPECIFICATION 00032600 B RQBUFMX BUFMX SPECIFICATION 00032700 B RQBUFNO BUFNO SPECIFICATION 00032800 B RQBUFOF BUFFOFF ( BUFFER OFFSET ) 00032900 B RQBUFOU BUFOUT SPECIFICATION 00033000 B RQBUFRQ BUFRQ SPECIFICATION 00033100 B RQBUFSZ BUFSZ SPECIFICATION 00033200 B RQCODE PAPER TAPE CODE 00033300 B RQCPRI CPRI 00033400 B RQDEN DEN (TAPE DENSITY) 00033500 B RQDSORG DSORG 00033600 B RQEROPT EROPT ERROR OPTION 00033700 B RQGNCP GNCP FOR GAM 00033800 B RQINTVL INTVL - NOT SUPPPORTED 00033900 B RQKYLEN KEYLEN - KEY LENGTH 00034000 B RQLIMCT LIMCT SEARCH LIMIT 00034100 B RQLRECL LRECL - LOGICAL RECORD LENGTH 00034200 B RQMODE MODE - NOT SUPPORTED 00034300 B RQNCP NCP BEFORE CHECK 00034400 B RQOPTCD OPTCD 00034500 B RQPCIR RECEIVING PCI 00034600 B RQPCIS SENDING PCI 00034700 B RQPRTSP PRTSP - PRINTER SPACING 00034800 B RQRECFM RECORD FORMAT 00034900 B RQRSRVF FIRST BUFFER RESERVE 00035000 B RQRSRVS SECONDARY BUFFER RESERVE 00035100 B RQSOWA SOWA - USER WORK AREAS 00035200 B RQSTACK STACKER BIN SPEC. 00035300 B RQTHRSH FLUSH THRESHOLD 00035400 B RQTRTCH 7-TRACK TAPE RECORDING 00035500 B RQPASSW SUPPLY PASSWORD 00035600 B RQIPLTX IPLTXTID - TCAM 00035700 B RQPERMA PERMANENTLY ALLOCATED ATTRIBUTE 00035800 B RQCNVRT CONVERTIBAL ATTRIBUTE 00035900 B RQDIAGN DIAGNOSTIC TRACE 00036000 B RQRTDDN RETURN DDNAME REQUESTED 00036100 B RQRTDSN REQUEST RETURN DSNAME 00036200 B RQRTORG REQUEST RETURN DSORG 00036300 B RQSUSER SYSOUT REMOTE STATION 00036400 B RQSHOLD SYSOUT HOLD QUE 00036500 B RQFUNC FUNC (CARD READER/PUNCH) 00036600 B RQFRID FRID - 3886 OCR - NOT SUPPORTED 00036700 B BADPARM ????????##################### 00036800 B RQRTVOL REQUEST RETURN VOLSER 00036900 B RQMSVGP MSS VIRTUAL VOLUME GROUP 00037000 B RQSSNM SUBSYSTEM NAME REQUEST 00037100 B RQSSPRM SUBSYSTEM PARM - NOT SUPPORTED 00037200 B RQPROT RACF PROTECTION REQUEST 00037300 SPACE 2 00037400 * UNRECOGNIZED REQUEST KEY ENCOUNTERED 00037500 SPACE 00037600 BADKEY LA R15,2 LOAD ERROR CODE -2 00037700 LCR R15,R15 MAKE NEGATIVE 00037800 L R7,AIERR GET ADDR OF IERR 00037900 ST R15,0(R7) PASS ERROR CODE BACK 00038000 B GOHOME NOW BEAT IT 00038100 SPACE 2 00038200 ENDREQ BCT R7,REQLOOP GO GET NEXT REQUEST 00038300 B ALLREQ ALL REQ'S DONE 00038400 SPACE 2 00038500 * 00038600 * NOW COME THE NASTY BITS - THOSE PARTS OF THE CODE WHEREIN THE REAL 00038700 * LIVE TEXT UNITS ARE BUILT. ARRRRRGGGGGGHHHHHH. 00038800 * 00038900 PRINT NOGEN 00039000 SPACE 2 00039100 * 00039200 * REQUEST CODE 1 X'0001' - DDNAME 00039300 * 00039400 RQDDNAM SETTEXT DALDDNAM,1,8 00039500 MVC S99TUPAR(8),0(R2) MOVE DDNAME 00039600 LA R8,14 LENGTH OF TEXT UNIT 00039700 B ENDREQ 00039800 SPACE 2 00039900 * 00040000 * REQUEST CODE 3 X'0003' - MEMBER NAME 00040100 * 00040200 RQMEMBR SETTEXT DALMEMBR,1,8 00040300 MVC S99TUPAR(8),0(R2) MOVE DDNAME 00040400 LA R8,14 LENGTH OF TEXT UNIT 00040500 B ENDREQ 00040600 SPACE 2 00040700 * 00040800 * REQUEST CODE 4 X'0004' - DATA SET STATUS 00040900 * 00041000 RQSTATS SETTEXT DALSTATS,1,1 00041100 CHECKEY O,01,RQSTAT1,RQSTAT4 TEST STATUS OLD 00041200 RQSTAT1 CHECKEY M,02,RQSTAT2,RQSTAT4 TEST STATUS MOD 00041300 RQSTAT2 CHECKEY N,04,RQSTAT3,RQSTAT4 TEST STATUS NEW 00041400 RQSTAT3 CHECKEY S,08,BADPARM TEST STATUS SHR 00041500 RQSTAT4 LA R8,7 LENGTH OF TEXT UNIT 00041600 B ENDREQ 00041700 SPACE 2 00041800 * 00041900 * REQUEST CODE 5 X'0005' - NORMAL DISPOSITION 00042000 * 00042100 RQNDISP SETTEXT DALNDISP,1,1 00042200 RQDISP CHECKEY U,01,RQNDSP1,RQNDSP4 TEST DISP = UNCATLG 00042300 RQNDSP1 CHECKEY C,02,RQNDSP2,RQNDSP4 TEST DISP = CATLGLG 00042400 RQNDSP2 CHECKEY D,04,RQNDSP3,RQNDSP4 TEST DISP = DELETEG 00042500 RQNDSP3 CHECKEY K,08,BADPARM TEST DISP = KEEPTEG 00042600 RQNDSP4 LA R8,7 LENGTH OF TEXT UNIT 00042700 B ENDREQ 00042800 SPACE 2 00042900 * 00043000 * REQUEST CODE 6 X'0006' - CONDITIONAL DISPOSITION 00043100 * NOTE: PROCESSING THE PARM IS JUST LIKE NORMAL DISP, SO... 00043200 * 00043300 RQCDISP SETTEXT DALCDISP,1,1 00043400 B RQDISP USE EXISTING CODE 00043500 SPACE 2 00043600 * 00043700 * REQUEST CODE 7 X'0007' - SPECIFY SPACE IN TRACKS 00043800 * 00043900 RQTRK SETTEXT DALTRK,0,0 00044000 LA R8,4 LENGTH OF TEXT UNIT 00044100 B ENDREQ 00044200 SPACE 2 00044300 * 00044400 * REQUEST CODE 8 X'0008' - SPECIFY SPACE IN CYLINDERS 00044500 * 00044600 RQCYL SETTEXT DALCYL,0,0 00044700 LA R8,4 LENGTH OF TEXT UNIT 00044800 B ENDREQ 00044900 SPACE 2 00045000 * 00045100 * REQUEST CODE 9 X'0009' - SPECIFY SPACE IN BLOCKS 00045200 * 00045300 RQBLKLN SETTEXT DALBLKLN,1,3 00045400 MVC S99TUPAR(3),5(R2) MOVE IN BLOCK LENGTH 00045500 LA R8,9 LENGTH OF TEXT UNIT 00045600 B ENDREQ 00045700 SPACE 2 00045800 * 00045900 * REQUEST CODE 10 X'000A' - PRIMARY SPACE QUANTITY 00046000 * 00046100 RQPRIME SETTEXT DALPRIME,1,3 00046200 MVC S99TUPAR(3),5(R2) MOVE IN SPACE REQUEST 00046300 LA R8,9 LENGTH OF TEXT UNIT 00046400 B ENDREQ 00046500 SPACE 2 00046600 * 00046700 * REQUEST CODE 11 X'000B' - SECONDARY SPACE REQUEST 00046800 * 00046900 RQSECND SETTEXT DALSECND,1,3 00047000 MVC S99TUPAR(3),5(R2) MOVE IN SPACE REQUEST 00047100 LA R8,9 LENGTH OF TEXT UNIT 00047200 B ENDREQ 00047300 SPACE 2 00047400 * 00047500 * REQUEST CODE 12 X'000C' - DIRECTORY BLOCK REQUEST 00047600 * 00047700 RQDIR SETTEXT DALDIR,1,3 00047800 MVC S99TUPAR(3),5(R2) MOVE IN NUM. OF DIR. BLOCKS 00047900 LA R8,9 LENGTH OF TEXT UNIT 00048000 B ENDREQ 00048100 SPACE 2 00048200 * 00048300 * REQUEST CODE 13 X'000D' - RLSE UNSED SPACE 00048400 * 00048500 RQRLSE SETTEXT DALRLSE,0,0 00048600 LA R8,4 LENGTH OF TEXT UNIT 00048700 B ENDREQ 00048800 SPACE 2 00048900 * 00049000 * REQUEST CODE 14 X'000E' - FORMAT OF ALLOCATED SPACE 00049100 * 00049200 RQSPFRM SETTEXT DALSPFRM,1,1 00049300 CHECKEY A,02,RQSPFR1,RQSPFR3 A - DIFFERENT CONTIGUOUS 00049400 RQSPFR1 CHECKEY M,04,RQSPFR2,RQSPFR3 M - MAXIMUM CONTIGUOUS 00049500 RQSPFR2 CHECKEY C,08,BADPARM C - CONTIGOUS 00049600 RQSPFR3 LA R8,7 LENGTH OF TEXT UNIT 00049700 B ENDREQ 00049800 SPACE 2 00049900 * 00050000 * REQUEST CODE 15 X'000F' - ROUND SPACE TO CYL 00050100 * 00050200 RQROUND SETTEXT DALROUND,0,0 00050300 LA R8,4 LENGTH OF TEXT UNIT 00050400 B ENDREQ 00050500 SPACE 2 00050600 * 00050700 * REQUEST CODE 16 X'0010' - VOL SER SPECIFICATION 00050800 * 00050900 RQVLSER SETTEXT DALVLSER,1,6 00051000 MVC S99TUPAR(6),0(R2) GET VOLUME SERIAL NUMBER 00051100 LA R8,12 LENGTH OF TEXT UNIT 00051200 B ENDREQ 00051300 SPACE 2 00051400 * 00051500 * REQUEST CODE 17 X'0011' - PRIVATE VOLUME SPEC. 00051600 * 00051700 RQPRIVT SETTEXT DALPRIVT,0,0 00051800 LA R8,4 LENGTH OF TEXT UNIT 00051900 B ENDREQ 00052000 SPACE 2 00052100 * 00052200 * REQUEST CODE 18 X'0012' - VOL SEQ NUMBER SPC. 00052300 * 00052400 RQVLSEQ SETTEXT DALVLSEQ,1,2 00052500 L R8,4(R2) GET VOLUME SEQUENCE NUMBER 00052600 STH R8,S99TUPAR STORE IT 00052700 LA R8,8 LENGTH OF TEXT UNIT 00052800 B ENDREQ 00052900 SPACE 2 00053000 * 00053100 * REQUEST CODE 19 X'0013' - VOLUME COUNT 00053200 * 00053300 RQVLCNT SETTEXT DALVLCNT,1,1 00053400 MVC S99TUPAR(1),7(R2) MOVE IN COUNT REQUEST 00053500 LA R8,7 LENGTH OF TEXT UNIT 00053600 B ENDREQ 00053700 SPACE 2 00053800 * 00053900 * REQUEST CODE 20 X'0014' - VOL REF DSNAME SPEC 00054000 * NOT SUPPORTED 00054100 RQVLRDS B BADPARM 00054200 SPACE 2 00054300 * 00054400 * REQUEST CODE 21 X'0015' - UNIT DESCRIPTION 00054500 * 00054600 RQUNIT SETTEXT DALUNIT,1,8 00054700 MVC S99TUPAR(8),0(R2) MOVE IN DESCRIPTION 00054800 LA R8,14 LENGTH OF TEXT UNIT 00054900 B ENDREQ 00055000 * 00055100 * REQUEST CODE 22 X'0016' - UNIT COUNT SPEC. 00055200 * 00055300 RQUNCNT SETTEXT DALUNCNT,1,1 00055400 MVC S99TUPAR(1),7(R2) MOVE IN COUNT REQUEST 00055500 LA R8,7 LENGTH OF TEXT UNIT 00055600 B ENDREQ 00055700 SPACE 2 00055800 * 00055900 * REQUEST CODE 23 X'0017' - PARALLEL MOUNT REQUEST 00056000 * 00056100 RQPARAL SETTEXT DALPARAL,0,0 00056200 LA R8,4 LENGTH OF TEXT UNIT 00056300 B ENDREQ 00056400 SPACE 2 00056500 * 00056600 * REQUEST CODE 24 X'0018' - SYSOUT SPECIFICATION 00056700 * 00056800 RQSYSOU CLI 0(R2),X'40' CHECK FOR CLASS SPECIFICATION 00056900 BE RQSYSO1 BRANCH IF NO SPEC. 00057000 SETTEXT DALSYSOU,1,1 00057100 MVC S99TUPAR(1),0(R2) GET CLASS 00057200 LA R8,7 LENGTH WITH CLASS 00057300 B RQSYSO2 00057400 RQSYSO1 SETTEXT DALSYSOU,0,0 00057500 LA R8,4 LENGTH OF TEXT UNIT 00057600 RQSYSO2 B ENDREQ 00057700 SPACE 2 00057800 * 00057900 * REQUEST CODE 25 X'0019' - SYSOUT PROGRAM NAME 00058000 * 00058100 RQSPGNM SETTEXT DALSPGNM,1,8 00058200 MVC S99TUPAR(8),0(R2) GET PGM NAME 00058300 LA R8,14 LENGTH OF TEXT UNIT 00058400 B ENDREQ 00058500 SPACE 2 00058600 * 00058700 * REQUEST CODE 26 X'001A' - SYSOUT FORM NUMBER 00058800 * 00058900 RQSFMNO SETTEXT DALSFMNO,1,4 00059000 MVC S99TUPAR(4),0(R2) GET FORM ID 00059100 LA R8,10 LENGTH OF TEXT UNIT 00059200 B ENDREQ 00059300 SPACE 2 00059400 * 00059500 * REQUEST CODE 27 X'001B' - SYSOUT OUTPUT LIMIT 00059600 * 00059700 RQOUTLM SETTEXT DALOUTLM,1,3 00059800 MVC S99TUPAR(3),5(R2) GET LIMIT (BINARY) 00059900 LA R8,9 LENGTH OF TEXT UNIT 00060000 B ENDREQ 00060100 SPACE 2 00060200 * 00060300 * REQUEST CODE 28 X'001C' - UNNALLOCATE AT CLOSE 00060400 * 00060500 RQCLOSE SETTEXT DALCLOSE,0,0 00060600 LA R8,4 LENGTH OF TEXT UNIT 00060700 B ENDREQ 00060800 SPACE 2 00060900 * 00061000 * REQUEST CODE 29 X'001D' - SYSOUT COPIES 00061100 * 00061200 RQCOPYS SETTEXT DALCOPYS,1,1 00061300 MVC S99TUPAR(1),7(R2) GET NUMBER OF COPIES (BINARY) 00061400 LA R8,17 LENGTH OF TEXT UNIT 00061500 B ENDREQ 00061600 SPACE 2 00061700 * 00061800 * REQUEST CODE 30 X'001E' - LABEL TYPE 00061900 * DOES NOT SUPPORT ALL LABEL TYPES 00062000 RQLABEL SETTEXT DALLABEL,1,1 00062100 CHECKEY NL,01,RQLABL1,RQLABL3 TEST LABEL=NL 00062200 RQLABL1 CHECKEY SL,02,RQLABL2,RQLABL3 TEST LABEL=SL 00062300 RQLABL2 CHECKEY BLP,10,BADPARM TEST LABEL=BLP 00062400 RQLABL3 LA R8,7 LENGTH OF TEXT UNIT 00062500 B ENDREQ 00062600 SPACE 2 00062700 * 00062800 * REQUEST CODE 31 X'001F' - DATA SET SEQUENCE NUMBER 00062900 * 00063000 RQDSSEQ SETTEXT DALDSSEQ,1,2 00063100 MVC S99TUPAR(2),6(R2) GET SEQUENCE NUMBER 00063200 LA R8,8 LENGTH OF TEXT UNIT 00063300 B ENDREQ 00063400 SPACE 2 00063500 * 00063600 * REQUEST CODE 32 X'0020' - PASSWORD PROTECT THIS ONE 00063700 * 00063800 RQPASPR SETTEXT DALPASPR,1,1 00063900 CLI 0(R2),C'R' CHECK READ ONLY 00064000 BNE RQPASP1 BRANCH IF NOT 00064100 MVI S99TUPAR,X'30' SET READ ONLY PROTECT 00064200 B RQPASP2 00064300 RQPASP1 MVI S99TUPAR,X'10' SET FULL PROTECT 00064400 RQPASP2 LA R8,7 LENGTH OF TEXT UNIT 00064500 B ENDREQ 00064600 SPACE 2 00064700 * 00064800 * REQUEST CODE 33 X'0021' - INPUT/OUTPUT ONLY 00064900 * 00065000 RQINOUT SETTEXT DALINOUT,1,1 00065100 CHECKEY O,40,RQINOU1,RQINOU2 TEST LABEL=OUT 00065200 RQINOU1 CHECKEY I,80,BADPARM TEST LABEL=IN 00065300 RQINOU2 LA R8,7 LENGTH OF TEXT UNIT 00065400 B ENDREQ 00065500 SPACE 2 00065600 * 00065700 * REQUEST CODE 34 X'0022' - EXPIRATION DATE 00065800 * 00065900 RQEXPDT SETTEXT DALEXPDT,1,5 00066000 MVC S99TUPAR(5),0(R2) GET DATE (CHARACTERS) 00066100 LA R8,11 LENGTH OF TEXT UNIT 00066200 B ENDREQ 00066300 SPACE 2 00066400 * 00066500 * REQUEST CODE 35 X'0023' - RETENTION PERIOD 00066600 * 00066700 RQRETPD SETTEXT DALRETPD,1,2 00066800 MVC S99TUPAR(2),6(R2) MOVE HALFWORD 00066900 LA R8,8 LENGTH OF TEXT UNIT 00067000 B ENDREQ 00067100 SPACE 2 00067200 * 00067300 * REQUEST CODE 36 X'0024' - DUMMY DATA SET SPECIFICATION 00067400 * 00067500 RQDUMMY SETTEXT DALDUMMY,0,0 00067600 LA R8,4 LENGTH OF TEXT UNIT 00067700 B ENDREQ 00067800 SPACE 2 00067900 * 00068000 * REQUEST CODE 37 X'0025' - FCB IMAGE IDENTIFICATION 00068100 * 00068200 RQFCBIM SETTEXT DALFCBIM,1,4 00068300 MVC S99TUPAR(4),0(R2) MOVE IMAGE ID. 00068400 LA R8,10 LENGTH OF TEXT UNIT 00068500 B ENDREQ 00068600 SPACE 2 00068700 * 00068800 * REQUEST CODE 38 X'0026' - FORM ALIGNMENT/VERIFICATION 00068900 * 00069000 RQFCBAV SETTEXT DALFCBAV,1,1 00069100 CHECKEY V,04,RQFCBA1,RQFCBA2 TEST VERIFY 00069200 RQFCBA1 CHECKEY A,08,BADPARM TEST ALIGN 00069300 RQFCBA2 LA R8,7 LENGTH OF TEXT UNIT 00069400 B ENDREQ 00069500 SPACE 2 00069600 * 00069700 * REQUEST CODE 39 X'0027' - QNAME SPECIFICATION 00069800 * 00069900 RQQNAME SETTEXT DALQNAME,1,8 00070000 MVC S99TUPAR(8),0(R2) GET QNAME 00070100 LA R8,14 LENGTH OF TEXT UNIT 00070200 B ENDREQ 00070300 SPACE 2 00070400 * 00070500 * REQUEST CODE 40 X'0028' - TERMINAL DD SPECIFICATION 00070600 * 00070700 RQTERM SETTEXT DALTERM,0,0 00070800 LA R8,4 LENGTH OF TEXT UNIT 00070900 B ENDREQ 00071000 SPACE 2 00071100 * 00071200 * REQUEST CODE 41 X'0029' - UCS (UNIV. CHAR. SET) SPEC. 00071300 * 00071400 RQUCS SETTEXT DALUCS,1,4 00071500 MVC S99TUPAR(4),0(R2) 00071600 LA R8,10 LENGTH OF TEXT UNIT 00071700 B ENDREQ 00071800 SPACE 2 00071900 * 00072000 * REQUEST CODE 42 X'002A' - FOLD MODE REQUEST 00072100 * 00072200 RQUFOLD SETTEXT DALUFOLD,0,0 00072300 LA R8,4 LENGTH OF TEXT UNIT 00072400 B ENDREQ 00072500 SPACE 2 00072600 * 00072700 * REQUEST CODE 43 X'002B' - CHAR. SET IMAGE VERIFICATION 00072800 * 00072900 RQUVRFY SETTEXT DALUVRFY,0,0 00073000 LA R8,4 LENGTH OF TEXT UNIT 00073100 B ENDREQ 00073200 SPACE 2 00073300 * 00073400 * REQUEST CODE 44 X'002C' - DCB REF TO DSNAME 00073500 * 00073600 * NOT CURRENTLY SUPORTED 00073700 RQDCBDS B BADPARM FUNCTION NOT SUPPORTED 00073800 SPACE 2 00073900 * 00074000 * REQUEST CODE 45 X'002D' - DCB REF TO DDNAME 00074100 * 00074200 RQDCBDD SETTEXT DALDCBDD,1,8 00074300 MVC S99TUPAR(8),0(R2) MOVE DDNAME 00074400 LA R8,14 LENGTH OF TEXT UNIT 00074500 B ENDREQ 00074600 SPACE 2 00074700 * 00074800 * REQUEST CODE 46 X'002E' - BFALN SPECIFICATION 00074900 * 00075000 RQBFALN SETTEXT DALBFALN,1,1 00075100 CHECKEY F,01,RQBFAL1,RQBFAL2 TEST FULLWORD ALIGNMENT 00075200 RQBFAL1 CHECKEY D,02,BADPARM TEST DOUBLEWORD ALIGN. 00075300 RQBFAL2 LA R8,7 LENGTH OF TEXT UNIT 00075400 B ENDREQ 00075500 SPACE 2 00075600 * 00075700 * REQUEST CODE 47 X'002F' - BFTEK SPECIFICATION 00075800 * 00075900 RQBFTEK SETTEXT DALBFTEK,1,1 00076000 CHECKEY D,08,RQBFTE1,RQBFTE5 TEST DYNAMIC 00076100 RQBFTE1 CHECKEY E,10,RQBFTE2,RQBFTE5 TEST EXCHANGE 00076200 RQBFTE2 CHECKEY R,20,RQBFTE3,RQBFTE5 TEST RECORD 00076300 RQBFTE3 CHECKEY S,40,RQBFTE4,RQBFTE5 TEST ???????????????? 00076400 RQBFTE4 CHECKEY A,60,BADPARM TEST ???????????????? 00076500 RQBFTE5 LA R8,7 LENGTH OF TEXT UNIT 00076600 B ENDREQ 00076700 SPACE 2 00076800 * 00076900 * REQUEST CODE 48 X'0030' - BLKSIZE SPECIFICATION 00077000 * 00077100 RQBLKSZ SETTEXT DALBLKSZ,1,2 00077200 MVC S99TUPAR(2),6(R2) MOVE BLOCK SIZE 00077300 LA R8,8 LENGTH OF TEXT UNIT 00077400 B ENDREQ 00077500 SPACE 2 00077600 * 00077700 * REQUEST CODE 49 X'0031' - BUFIN SPEC. 00077800 * 00077900 RQBUFIN SETTEXT DALBUFIN,1,1 00078000 MVC S99TUPAR(1),7(R2) 00078100 LA R8,7 LENGTH OF TEXT UNIT 00078200 B ENDREQ 00078300 SPACE 2 00078400 * 00078500 * REQUEST CODE 50 X'0032' - BUFL SPECIFICATION 00078600 * 00078700 RQBUFL SETTEXT DALBUFL,1,2 00078800 MVC S99TUPAR(2),6(R2) 00078900 LA R8,8 LENGTH OF TEXT UNIT 00079000 B ENDREQ 00079100 SPACE 2 00079200 * 00079300 * REQUEST CODE 51 X'0033' - BUFMAX SPECIFICATION 00079400 * 00079500 RQBUFMX SETTEXT DALBUFMX,1,1 00079600 MVC S99TUPAR(1),7(R2) 00079700 LA R8,7 LENGTH OF TEXT UNIT 00079800 B ENDREQ 00079900 SPACE 2 00080000 * 00080100 * REQUEST CODE 52 X'0034' - BUFNO SPECIFICATION 00080200 * 00080300 RQBUFNO SETTEXT DALBUFNO,1,1 00080400 MVC S99TUPAR(1),7(R2) MOVE BUFFER COUNT 00080500 LA R8,7 LENGTH OF TEXT UNIT 00080600 B ENDREQ 00080700 SPACE 2 00080800 * 00080900 * REQUEST CODE 53 X'0035' - BUFFOFF SPECIFICATION 00081000 * 00081100 RQBUFOF SETTEXT DALBUFOF,1,1 00081200 CHECKEY S,80,RQBUFO1,RQBUFO2 TEST STANDARD OFFSET 00081300 RQBUFO1 MVC S99TUPAR(1),7(R2) ASSUME NON-STANDARD 00081400 RQBUFO2 LA R8,7 LENGTH OF TEXT UNIT 00081500 B ENDREQ 00081600 SPACE 2 00081700 * 00081800 * REQUEST CODE 54 X'0036' - BUFOUT SPECIFICATION 00081900 * 00082000 RQBUFOU SETTEXT DALBUFOU,1,1 00082100 MVC S99TUPAR(1),7(R2) MOVE BUFFER COUNT 00082200 LA R8,7 LENGTH OF TEXT UNIT 00082300 B ENDREQ 00082400 SPACE 2 00082500 * 00082600 * REQUEST CODE 55 X'0037' - BUFRQ SPECIFICATION 00082700 * 00082800 RQBUFRQ SETTEXT DALBUFRQ,1,1 00082900 MVC S99TUPAR(1),7(R2) 00083000 LA R8,7 LENGTH OF TEXT UNIT 00083100 B ENDREQ 00083200 SPACE 2 00083300 * 00083400 * REQUEST CODE 56 X'0038' - BUFSZ SPECIFICATION 00083500 * 00083600 RQBUFSZ SETTEXT DALBUFSZ,1,2 00083700 MVC S99TUPAR(2),6(R2) 00083800 LA R8,8 LENGTH OF TEXT UNIT 00083900 B ENDREQ 00084000 SPACE 2 00084100 * 00084200 * REQUEST CODE 57 X'0039' - PAPER TAPE CODE 00084300 * NOT SUPPORTED 00084400 RQCODE B BADPARM 00084500 SPACE 2 00084600 * 00084700 * REQUEST CODE 58 X'003A' - CPRI SPECIFICATION 00084800 * NOT SUPPORTED 00084900 RQCPRI B BADPARM 00085000 SPACE 2 00085100 * 00085200 * REQUEST CODE 59 X'003B' - DEN(SITY) PARAM. (TAPE) 00085300 * 00085400 RQDEN SETTEXT DALDEN,1,1 00085500 CHECKEY 2,03,RQDEN1,RQDEN5 200 -> 200 BPI, 7 TRK 00085600 RQDEN1 CHECKEY 5,43,RQDEN2,RQDEN5 556 -> 556 BPI, 7 TRK 00085700 RQDEN2 CHECKEY 8,83,RQDEN3,RQDEN5 800 -> 800 BPI, 7/9 TRK 00085800 RQDEN3 CHECKEY 1,C3,RQDEN4,RQDEN5 1600 -> 1600 BPI, 9 TRK 00085900 RQDEN4 CHECKEY 6,D3,BADPARM 6250 -> 6250 BPI, 9 TRK 00086000 RQDEN5 LA R8,7 LENGTH OF TEXT UNIT 00086100 B ENDREQ 00086200 SPACE 2 00086300 * 00086400 * REQUEST CODE 60 X'003C' - DSORG 00086500 * 00086600 RQDSORG SETTEXT DALDSORG,1,2 00086700 CHECKEY PSU,4100,RQDSOR1,RQDSORL PHYS. SEQ. UNMOVABLE 00086800 RQDSOR1 CHECKEY PS,4000,RQDSOR2,RQDSORL PHYSICAL SEQUENTIAL 00086900 RQDSOR2 CHECKEY POU,0300,RQDSOR3,RQDSORL PARTITIONED UNMOVABLE 00087000 RQDSOR3 CHECKEY PO,0200,RQDSOR4,RQDSORL PARTITIONED 00087100 RQDSOR4 CHECKEY DAU,2100,RQDSOR5,RQDSORL DIRECT ACCESS UNMOVABLE 00087200 RQDSOR5 CHECKEY DA,2000,RQDSOR6,RQDSORL DIRECT ACCESS 00087300 RQDSOR6 CHECKEY VS,0008,RQDSOR7,RQDSORL VSAM 00087400 RQDSOR7 CHECKEY GS,0080,RQDSOR8,RQDSORL GRAPHICS 00087500 RQDSOR8 CHECKEY TC,0004,RQDSOR9,RQDSORL TCAM 3705 00087600 RQDSOR9 CHECKEY TQ,0020,RQDSORA,RQDSORL TCAM MESSAGE QUE 00087700 RQDSORA CHECKEY TX,0040,RQDSORB,RQDSORL TCAM LINE GROUP 00087800 RQDSORB CHECKEY MQ,0400,RQDSORC,RQDSORL MESSAGE PROCESSING QUE 00087900 RQDSORC CHECKEY CQ,0800,RQDSORD,RQDSORL DIRECT ACCESS MESSAGE QUE 00088000 RQDSORD CHECKEY CX,1000,BADPARM COMM LINE GROUP 00088100 RQDSORL LA R8,8 LENGTH OF TEXT UNIT 00088200 B ENDREQ 00088300 SPACE 2 00088400 * 00088500 * REQUEST CODE 61 X'003D' - EROPT - ERROR OPTION 00088600 * 00088700 RQEROPT SETTEXT DALEROPT,1,1 00088800 CHECKEY T,10,RQEROP1,RQEROP4 T - ONLINE BSAM TEST 00088900 RQEROP1 CHECKEY ABE,20,RQEROP2,RQEROP4 ABE - ABEND THE TASK 00089000 RQEROP2 CHECKEY SKP,40,RQEROP3,RQEROP4 SKP - SKIP THE ERROR BLOCK 00089100 RQEROP3 CHECKEY ACC,80,BADPARM ACC - ACCEPT THE ERROR BLOCK 00089200 RQEROP4 LA R8,7 LENGTH OF TEXT UNIT 00089300 B ENDREQ 00089400 SPACE 2 00089500 * 00089600 * REQUEST CODE 62 X'003E' - GNCP - FOR GAM 00089700 * 00089800 RQGNCP SETTEXT DALGNCP,1,1 00089900 MVC S99TUPAR(1),7(R2) 00090000 LA R8,7 LENGTH OF TEXT UNIT 00090100 B ENDREQ 00090200 SPACE 2 00090300 * 00090400 * REQUEST CODE 63 X'003F' - INTVL - POLLING INTERVAL 00090500 * NOT SUPPORTED 00090600 RQINTVL B BADPARM 00090700 SPACE 2 00090800 * 00090900 * REQUEST CODE 64 X'0040' - KEYLEN - KEY LENGTH 00091000 * 00091100 RQKYLEN SETTEXT DALKYLEN,1,1 00091200 MVC S99TUPAR(1),7(R2) 00091300 LA R8,7 LENGTH OF TEXT UNIT 00091400 B ENDREQ 00091500 SPACE 2 00091600 * 00091700 * REQUEST CODE 65 X'0041' - LIMCT SEARCH LIMIT 00091800 * 00091900 RQLIMCT SETTEXT DALLIMCT,1,3 00092000 MVC S99TUPAR(3),5(R2) 00092100 LA R8,9 LENGTH OF TEXT UNIT 00092200 B ENDREQ 00092300 SPACE 2 00092400 * 00092500 * REQUEST CODE 66 X'0042' - LRECL SPECIFICATION 00092600 * 00092700 RQLRECL SETTEXT DALLRECL,1,2 00092800 MVC S99TUPAR(2),6(R2) 00092900 LA R8,8 LENGTH OF TEXT UNIT 00093000 B ENDREQ 00093100 SPACE 2 00093200 * 00093300 * REQUEST CODE 67 X'0043' - MODE FOR CARD READER & PUNCH 00093400 * NOT SUPPORTED 00093500 RQMODE B BADPARM 00093600 SPACE 2 00093700 * 00093800 * REQUEST CODE 68 X'0044' - NCP READ/WRITES BEFORE CHECK 00093900 * 00094000 RQNCP SETTEXT DALNCP,1,1 00094100 MVC S99TUPAR(1),7(R2) 00094200 LA R8,7 LENGTH OF TEXT UNIT 00094300 B ENDREQ 00094400 SPACE 2 00094500 * 00094600 * REQUEST CODE 69 X'0045' - OPTCD PARAMETER 00094700 * NOT COMPLETELY SUPPORTED 00094800 RQOPTCD SETTEXT DALOPTCD,1,1 00094900 CHECKEY R,01,RQOPTC1,RQOPTCL RELATIVE ADDRESSING 00095000 RQOPTC1 CHECKEY T,02,RQOPTC2,RQOPTCL USER TOTALING 00095100 RQOPTC2 CHECKEY Z,04,RQOPTC3,RQOPTCL REDUCED TAPE ERROR RECOVERY 00095200 RQOPTC3 CHECKEY A,08,RQOPTC4,RQRECFL DIRECT ADDRESSING 00095300 RQOPTC4 CHECKEY F,10,RQOPTC5,RQRECFL FEEDBACK 00095400 RQOPTC5 CHECKEY E,20,RQOPTC6,RQRECFL EXTENDED SEARCH 00095500 RQOPTC6 CHECKEY B,40,RQOPTC2,RQRECFL DISREGARD EOF FOR TAPES 00095600 RQOPTC7 CHECKEY W,80,BADPARM WRITE VALIDITY CHECK 00095700 RQOPTCL LA R8,8 LENGTH OF TEXT UNIT 00095800 B ENDREQ 00095900 SPACE 2 00096000 * 00096100 * REQUEST CODE 70 X'0046' - RECEIVING PCI SPEC. 00096200 * 00096300 RQPCIR SETTEXT DALPCIR,1,1 00096400 CHECKEY R,02,RQPCIR1,RQPCIRL PIC/NO NEW BUFFER 00096500 RQPCIR1 CHECKEY N,08,RQPCIR2,RQPCIRL NO PCI'S 00096600 RQPCIR2 CHECKEY A,20,RQPCIR3,RQPCIRL PCI/NEW BUFFER 00096700 RQPCIR3 CHECKEY X,80,BADPARM PCI/NEW BUFFER/KEEP FIRST 00096800 RQPCIRL LA R8,8 LENGTH OF TEXT UNIT 00096900 B ENDREQ 00097000 SPACE 2 00097100 * 00097200 * REQUEST CODE 71 X'0047' - SENDING PCI SPEC. 00097300 * 00097400 RQPCIS SETTEXT DALPCIS,1,1 00097500 CHECKEY R,01,RQPCIS1,RQPCISL PIC/NO NEW BUFFER 00097600 RQPCIS1 CHECKEY N,04,RQPCIS2,RQPCISL NO PCI'S 00097700 RQPCIS2 CHECKEY A,10,RQPCIS3,RQPCISL PCI/NEW BUFFER 00097800 RQPCIS3 CHECKEY X,40,BADPARM PCI/NEW BUFFER/KEEP FIRST 00097900 RQPCISL LA R8,8 LENGTH OF TEXT UNIT 00098000 B ENDREQ 00098100 SPACE 2 00098200 * 00098300 * REQUEST CODE 72 X'0048' - PRTSP (PRINTER SPACING) 00098400 * 00098500 RQPRTSP SETTEXT DALPRTSP,1,1 00098600 CHECKEY 0,01,RQPRTS1,RQPRTSL 0 -> NO SPACING 00098700 RQPRTS1 CHECKEY 1,09,RQPRTS2,RQPRTSL 1 -> ONE-LINE SPACING 00098800 RQPRTS2 CHECKEY 2,11,RQPRTS3,RQPRTSL 2 -> TWO LINE SPACING 00098900 RQPRTS3 CHECKEY 3,19,BADPARM 3 -> THREE LINE SPACING 00099000 RQPRTSL LA R8,8 LENGTH OF TEXT UNIT 00099100 B ENDREQ 00099200 SPACE 2 00099300 * 00099400 * REQUEST CODE 73 X'0049' - RECFM 00099500 * 00099600 RQRECFM SETTEXT DALRECFM,1,1 00099700 CHECKEY FBSA,9C,RQRECF1,RQRECFL FIXED BLCKD STNRD ASCII 00099800 RQRECF1 CHECKEY FBA,94,RQRECF2,RQRECFL FIXED BLOCKED ASCII 00099900 RQRECF2 CHECKEY FBS,98,RQRECF3,RQRECFL FIXED BLOCKED STANDARD 00100000 RQRECF3 CHECKEY FBM,92,RQRECF4,RQRECFL FIXED BLOCKED MACHINE 00100100 RQRECF4 CHECKEY FB,90,RQRECF5,RQRECFL FIXED BLOCKED 00100200 RQRECF5 CHECKEY FS,88,RQRECF6,RQRECFL FIXED STANDARD 00100300 RQRECF6 CHECKEY FA,84,RQRECF7,RQRECFL FIXED ASCII 00100400 RQRECF7 CHECKEY FM,82,RQRECF8,RQRECFL FIXED MACHINE 00100500 RQRECF8 CHECKEY F,80,RQRECF9,RQRECFL FIXED 00100600 RQRECF9 CHECKEY VBM,52,RQRECFA,RQRECFL VARIABLE BLOCKED MACHINE 00100700 RQRECFA CHECKEY VBS,58,RQRECFB,RQRECFL VARIABLE BLOCKED SPANNED 00100800 RQRECFB CHECKEY VBA,54,RQRECFC,RQRECFL VARIABLE BLOCKED ASCII 00100900 RQRECFC CHECKEY VB,50,RQRECFD,RQRECFL VARIABLE BLOCKED 00101000 RQRECFD CHECKEY VS,48,RQRECFE,RQRECFL VARIABLE SPANNED 00101100 RQRECFE CHECKEY VA,44,RQRECFF,RQRECFL VARIABLE ASCII 00101200 RQRECFF CHECKEY VM,42,RQRECFG,RQRECFL VARIABLE MACHINE 00101300 RQRECFG CHECKEY V,40,RQRECFH,RQRECFL VARIABLE 00101400 RQRECFH CHECKEY UA,C4,RQRECFI,RQRECFL UNDEFINED ASCII 00101500 RQRECFI CHECKEY UM,C2,RQRECFJ,RQRECFL UNDEFINED MACHINE 00101600 RQRECFJ CHECKEY UT,E0,RQRECFK,RQRECFL UNDEFINED TRACK OVERFLOW 00101700 RQRECFK CHECKEY U,C0,BADPARM UNDEFINED 00101800 RQRECFL LA R8,8 LENGTH OF TEXT UNIT 00101900 B ENDREQ 00102000 SPACE 2 00102100 * 00102200 * REQUEST CODE 74 X'004A' - FIRST BUFFER RESERVE 00102300 * 00102400 RQRSRVF SETTEXT DALRSRVF,1,1 00102500 MVC S99TUPAR(1),7(R2) 00102600 LA R8,7 LENGTH OF TEXT UNIT 00102700 B ENDREQ 00102800 SPACE 2 00102900 * 00103000 * REQUEST CODE 75 X'004B' - SECONDARY BUFFER RESERVE 00103100 * 00103200 RQRSRVS SETTEXT DALRSRVS,1,1 00103300 MVC S99TUPAR(1),7(R2) 00103400 LA R8,7 LENGTH OF TEXT UNIT 00103500 B ENDREQ 00103600 SPACE 2 00103700 * 00103800 * REQUEST CODE 76 X'004C' - SOWA - USER INPUT WORK AREAS 00103900 * 00104000 RQSOWA SETTEXT DALSOWA,1,1 00104100 MVC S99TUPAR(2),6(R2) 00104200 LA R8,8 LENGTH OF TEXT UNIT 00104300 B ENDREQ 00104400 SPACE 2 00104500 * 00104600 * REQUEST CODE 77 X'004D' - STACK - STACKER BIN SPEC. 00104700 * NOT SUPPORTED 00104800 RQSTACK B BADPARM 00104900 SPACE 2 00105000 * 00105100 * REQUEST CODE 78 X'004E' - THRESH 00105200 * 00105300 RQTHRSH SETTEXT DALTHRSH,1,1 00105400 MVC S99TUPAR(1),7(R2) 00105500 LA R8,8 LENGTH OF TEXT UNIT 00105600 B ENDREQ 00105700 SPACE 2 00105800 * 00105900 * REQUEST CODE 79 X'004F' - TRTCH - 7-TRACK RECORDING 00106000 * NOT SUPPORTED 00106100 RQTRTCH B BADPARM 00106200 SPACE 2 00106300 * 00106400 * REQUEST CODE 80 X'0050' - SUPPLY THE PASSWORD 00106500 * 00106600 RQPASSW SETTEXT DALPASSW,1,8 00106700 MVC S99TUPAR(8),0(R2) 00106800 LA R8,14 LENGTH OF TEXT UNIT 00106900 B ENDREQ 00107000 SPACE 2 00107100 * 00107200 * REQUEST CODE 81 X'0051' - IPLTXTID - TCAM NET. CNTL. PGM NAME 00107300 * 00107400 RQIPLTX SETTEXT DALIPLTX,1,8 00107500 MVC S99TUPAR(8),0(R2) 00107600 LA R8,14 LENGTH OF TEXT UNIT 00107700 B ENDREQ 00107800 SPACE 2 00107900 * 00108000 * REQUEST CODE 82 X'0052' - PERMANENTLY ALLOCATED ATTRIBUTE 00108100 * 00108200 RQPERMA SETTEXT DALPERMA,0,0 00108300 LA R8,4 LENGTH OF TEXT UNIT 00108400 B ENDREQ 00108500 SPACE 2 00108600 * 00108700 * REQUEST CODE 83 X'0053' - CONVERTIBLE ATTRIBUTE 00108800 * 00108900 RQCNVRT SETTEXT DALCNVRT,0,0 00109000 LA R8,4 LENGTH OF TEXT UNIT 00109100 B ENDREQ 00109200 SPACE 2 00109300 * 00109400 * REQUEST CODE 84 X'0054' - DIAGNOSTIC TRACE 00109500 * 00109600 RQDIAGN SETTEXT DALDIAGN,0,0 00109700 LA R8,4 LENGTH OF TEXT UNIT 00109800 B ENDREQ 00109900 SPACE 2 00110000 * 00110100 * REQUEST CODE 85 X'0055' - RETURN DDNAME FROM SVC ACTION 00110200 * 00110300 RQRTDDN SETTEXT DALRTDDN,1,8 00110400 ST R2,ARDDNAME WHERE TO RETURN DDNAME TO 00110500 ST R6,PRDDNAME WHERE TO RETURN DDNAME FROM 00110600 LA R8,14 LENGTH OF TEXT UNIT 00110700 B ENDREQ 00110800 SPACE 2 00110900 * 00111000 * REQUEST CODE 86 X'0056' - RETURN DSNAME FROM SVC ACTION 00111100 * 00111200 RQRTDSN SETTEXT DALRTDSN,1,44 00111300 ST R2,ARDSNAME INDICATE RETURN DSNAME TO 00111400 ST R6,PRDSNAME WHERE TO RETURN DSNAME FROM 00111500 LA R8,50 LENGTH OF TEXT UNIT 00111600 B ENDREQ 00111700 SPACE 2 00111800 * 00111900 * REQUEST CODE 87 X'0057' - RETURN DSORG FROM SVC ACTION 00112000 * 00112100 RQRTORG SETTEXT DALRTORG,1,2 00112200 ST R2,ARDSORG WHERE TO RETURN DSORG TO 00112300 ST R6,PRDSORG WHERE TO RETURN DSORG FROM 00112400 LA R8,8 LENGTH OF TEXT UNIT 00112500 B ENDREQ 00112600 SPACE 2 00112700 * 00112800 * REQUEST CODE 88 X'0058' - SYSOUT REMOTE WORKSTATION 00112900 * 00113000 RQSUSER SETTEXT DALSUSER,1,8 00113100 MVC S99TUPAR(8),0(R2) 00113200 LA R8,14 LENGTH OF TEXT UNIT 00113300 B ENDREQ 00113400 SPACE 2 00113500 * 00113600 * REQUEST CODE 89 X'0059' - SYSOUT HOLD QUE SPECIFICATION 00113700 * 00113800 RQSHOLD SETTEXT DALSHOLD,0,0 00113900 LA R8,4 LENGTH OF TEXT UNIT 00114000 B ENDREQ 00114100 SPACE 2 00114200 * 00114300 * REQUEST CODE 90 X'005A' - FUNC 00114400 * NOT COMPLETELY SUPPORTED 00114500 RQFUNC SETTEXT DALFUNC,1,1 00114600 CHECKEY I,80,BADPARM I -> INTERPRET 00114700 RQFUNCL LA R8,8 LENGTH OF TEXT UNIT 00114800 B ENDREQ 00114900 SPACE 2 00115000 * 00115100 * REQUEST CODE 91 X'005B' - FRID - FOR 3886 OCR 00115200 * NOT SUPPORTED 00115300 RQFRID B BADPARM 00115400 SPACE 2 00115500 *#################CODE 92 / X'5C' MISSING FROM HERE################# 00115600 * 00115700 * REQUEST CODE 93 X'005D' - RETURN VOLSER FROM SVC ACTION 00115800 * 00115900 RQRTVOL SETTEXT DALRTVOL,1,6 00116000 ST R2,ARVOLSER WHERE TO RETURN VOLSER TO 00116100 ST R6,PRVOLSER WHERE TO RETURN VOLSER FROM 00116200 LA R8,12 LENGTH OF TEXT UNIT 00116300 B ENDREQ 00116400 SPACE 2 00116500 * 00116600 * REQUEST CODE 94 X'005E' - MSVGP - MSS VIRTUAL VOLUME GROUP 00116700 * 00116800 RQMSVGP SETTEXT DALMSVGP,1,8 00116900 MVC S99TUPAR(8),0(R2) 00117000 LA R8,14 LENGTH OF TEXT UNIT 00117100 B ENDREQ 00117200 SPACE 2 00117300 * 00117400 * REQUEST CODE 95 X'005F' - SUBSYSTEM NAME REQUEST 00117500 * 00117600 RQSSNM CLI (R2),X'40' CHECK FOR NAME 00117700 BE RQSSNM1 BRANCH IF NO SPEC. 00117800 SETTEXT DALSSNM,1,8 00117900 MVC S99TUPAR(8),0(R2) LOAD NAME 00118000 LA R8,14 LENGTH WITH NAME 00118100 B RQSSNM2 00118200 RQSSNM1 SETTEXT DALSSNM,0,0 USE DEFAULT NAME 00118300 LA R8,4 LENGTH OF TEXT UNIT 00118400 RQSSNM2 B ENDREQ 00118500 SPACE 2 00118600 * 00118700 * REQUEST CODE 96 X'0060' - SUBSYSTEM PARAMETERS 00118800 * NOT SUPPORTED 00118900 RQSSPRM B BADPARM 00119000 SPACE 2 00119100 * 00119200 * REQUEST CODE 97 X'0061' - PROTECT SPECIFICATION (RACF PROT.) 00119300 * 00119400 RQPROT SETTEXT DALPROT,0,0 00119500 LA R8,4 LENGTH OF TEXT UNIT 00119600 B ENDREQ 00119700 PRINT GEN 00119800 EJECT 00119900 * 00120000 * BY THE TIME WE GET HERE, WE'VE PROCESSED ALL THE TEXT UNITS IN THE 00120100 * KEY/PARM ARRAYS. THERE REMAINS THE POSSIBILITY THAT A DSNAME HAS 00120200 * BEEN PROVIDED IN THE DSNAME ARGUMENT. IF SO, BUILD A TEXT UNIT FOR 00120300 * IT; ELSE SKIP THIS SECTION. 00120400 * 00120500 SPACE 00120600 ALLREQ L R9,DSNLGTH GET DSNAME LENGTH 00120700 LTR R9,R9 TEST IT 00120800 BZ LSTPTR BRANCH IF NO DSNAME 00120900 SPACE 00121000 * HAVE DSNAME TO LOAD 00121100 LA R5,4(R5) CHAIN TO NEXT TEXT POINTER 00121200 LA R6,0(R8,R6) CHAIN TO NEXT TEXT UNIT 00121300 ST R6,S99TUPTR CHAIN IN POINTER 00121400 LA R8,DALDSNAM GET DSNAME KEY 00121500 STH R8,S99TUKEY PUT KEY IN TEXT 00121600 LA R8,1 NUMBER = 1 00121700 STH R8,S99TUNUM INDICATE 1 PARM 00121800 STH R9,S99TULNG STORE LENGTH OF DSNAME 00121900 L R8,ADSNAME GET ADDR OF DSNAME 00122000 EX R9,MVC MOVE PROPER LENGTH ( IN R9) 00122100 B LSTPTR BRANCH PAST MVC EX 00122200 MVC MVC S99TUPAR,0(R8) REMOTELY EXECUTE MOVE COMMAND. 00122300 SPACE 2 00122400 * 00122500 * ALL THE UNITS ARE BUILT. THE LAST TXT PTR MUST BE MARKED TO 00122600 * SHOW THAT IT IS INDEED THE LAST. 00122700 * 00122800 LSTPTR OI S99TUPTR,S99TUPLN MARK IT LAST 00122900 SPACE 2 00123000 * 00123100 * IS NOW READY FOR THE BIG BLOWING-THE-PROGRAM-OUT-OF-THE-WATER GIG 00123200 * 00123300 SPACE 00123400 LH R0,S230S99 PARM FOR SVC230 DYNAMIC ALLOCATION 00123500 LR R1,R3 PUT ADDR OF RBPTR IN R1 00123600 SPACE 2 00123700 SVC 230 DO IT DO IT DO IT... 00123800 SPACE 2 00123900 * 00124000 * POST THE VARIOUS RETURN CODES BACK TO THE USER'S AREAS 00124100 * 00124200 L R8,AIERR GET IERR ADDR 00124300 ST R15,0(,R8) STORE RETURN CODE THERE 00124400 L R9,AJERR GET JERR ADDR 00124500 MVC 0(4,R9),S99ERROR MOVE THE SVC CODES THERE 00124600 LTR R15,R15 CHECK THE RETURN CODE 00124700 BNZ CLEANUP ABORT RUN HERE IF NONZERO 00124800 SPACE 2 00124900 * 00125000 * THE ONLY THING LEFT TO DO NOW IS TO RECOVER ANY DATA THE BELOVED 00125100 * USER MAY HAVE REQUESTED BE RETURNED TO HIM. 00125200 * 00125300 USING PARMBACK,R8 FOR EASE OF DINKING 00125400 SPACE 2 00125500 * CHECK FOR DDNAME RETURN 00125600 SPACE 00125700 RETDDN L R8,ARDDNAME GET RETURN TO ADDR - DDNAME 00125800 LTR R8,R8 SEE IF THERE WAS A REQUEST 00125900 BZ RETDSN BRANCH IF NO REQUEST 00126000 L R6,PRDDNAME --> TEXT UNIT 00126100 SR R9,R9 CLEAR REGISTER 00126200 LH R9,S99TULNG DDNAME LENGTH 00126300 EX R9,MVCBACK MOVE PROPER LENGTH (IN R9) 00126400 SPACE 2 00126500 * CHECK FOR DSNAME RETURN 00126600 SPACE 00126700 RETDSN L R8,ARDSNAME GET RETURN TO ADDR - DSNAME 00126800 LTR R8,R8 SEE IF THERE WAS A REQUEST 00126900 BZ RETDSO BRANCH IF NO REQUEST 00127000 L R6,PRDSNAME --> TEXT UNIT 00127100 SR R9,R9 CLEAR REGISTER 00127200 LH R9,S99TULNG DSNAME LENGTH 00127300 L R8,ADSNAME DSNAME ADDR 00127400 EX R9,MVCBACK MOVE PROPER LENGTH (IN R9) 00127500 SPACE 2 00127600 * CHECK FOR DSORG RETURN 00127700 SPACE 00127800 RETDSO L R8,ARDSORG GET RETURN TO ADDR - DSORG 00127900 LTR R8,R8 SEE IF THERE WAS A REQUEST 00128000 BZ RETVOL BRANCH IF NO REQUEST 00128100 L R6,PRDSORG --> TEXT UNIT 00128200 SR R9,R9 CLEAR REGISTER 00128300 LH R9,S99TUPAR GET RETURNED FLAG 00128400 CH R9,=X'0000' CHECK UNIDENTIFIED 00128500 BNE RTDSO1 BRANCH IF NOT UNIDENTIFIED 00128600 MVC PARMVAL(8),=CL8'UNKNOWN' LOAD UNKNOWN FLAG 00128700 B RETVOL OFF THIS CASE 00128800 RTDSO1 CH R9,=X'0004' CHECK TR 00128900 BNE RTDSO2 BRANCH IF NOT TR 00129000 MVC PARMVAL(8),=CL8'TR' SAY ITS TR 00129100 B RETVOL OFF THIS CASE 00129200 RTDSO2 CH R9,=X'0008' CHECK VSAM 00129300 BNE RTDSO3 BRANCH IF NOT VSAM 00129400 MVC PARMVAL(8),=CL8'VSAM' SAY ITS VSAM 00129500 B RETVOL OFF THIS CASE 00129600 RTDSO3 CH R9,=X'0020' CHECK TQ 00129700 BNE RTDSO4 BRANCH IF NOT TQ 00129800 MVC PARMVAL(8),=CL8'TQ' SAY ITS TQ 00129900 B RETVOL OFF THIS CASE 00130000 RTDSO4 CH R9,=X'0040' CHECK TX 00130100 BNE RTDSO5 BRANCH IF NOT TX 00130200 MVC PARMVAL(8),=CL8'TX' SAY ITS TX 00130300 B RETVOL OFF THIS CASE 00130400 RTDSO5 CH R9,=X'0080' CHECK GS 00130500 BNE RTDSO6 BRANCH IF NOT GS 00130600 MVC PARMVAL(8),=CL8'GS' SAY ITS GS 00130700 B RETVOL OFF THIS CASE 00130800 RTDSO6 CH R9,=X'0200' CHECK PO 00130900 BNE RTDSO7 BRANCH IF NOT PO 00131000 MVC PARMVAL(8),=CL8'PO' SAY ITS PO 00131100 B RETVOL OFF THIS CASE 00131200 RTDSO7 CH R9,=X'0300' CHECK POU 00131300 BNE RTDSO8 BRANCH IF NOT POU 00131400 MVC PARMVAL(8),=CL8'POU' SAY ITS POU 00131500 B RETVOL OFF THIS CASE 00131600 RTDSO8 CH R9,=X'0400' CHECK MQ 00131700 BNE RTDSO9 BRANCH IF NOT MQ 00131800 MVC PARMVAL(8),=CL8'MQ' SAY ITS MQ 00131900 B RETVOL OFF THIS CASE 00132000 RTDSO9 CH R9,=X'0800' CHECK CQ 00132100 BNE RTDSOA BRANCH IF NOT CQ 00132200 MVC PARMVAL(8),=CL8'CQ' SAY ITS CQ 00132300 B RETVOL OFF THIS CASE 00132400 RTDSOA CH R9,=X'1000' CHECK CX 00132500 BNE RTDSOB BRANCH IF NOT CX 00132600 MVC PARMVAL(8),=CL8'CX' SAY ITS CX 00132700 B RETVOL OFF THIS CASE 00132800 RTDSOB CH R9,=X'2000' CHECK DA 00132900 BNE RTDSOC BRANCH IF NOT DA 00133000 MVC PARMVAL(8),=CL8'DA' SAY ITS DA 00133100 B RETVOL OFF THIS CASE 00133200 RTDSOC CH R9,=X'2100' CHECK DAU 00133300 BNE RTDSOD BRANCH IF NOT DAU 00133400 MVC PARMVAL(8),=CL8'DAU' SAY ITS DAU 00133500 B RETVOL OFF THIS CASE 00133600 RTDSOD CH R9,=X'4000' CHECK PS 00133700 BNE RTDSOE BRANCH IF NOT PS 00133800 MVC PARMVAL(8),=CL8'PS' SAY ITS PS 00133900 B RETVOL OFF THIS CASE 00134000 RTDSOE CH R9,=X'4100' CHECK PSU 00134100 BNE RTDSOF BRANCH IF NOT PSU 00134200 MVC PARMVAL(8),=CL8'PSU' SAY ITS PSU 00134300 B RETVOL OFF THIS CASE 00134400 RTDSOF CH R9,=X'8000' CHECK IS 00134500 BNE RTDSOG BRANCH IF NOT IS 00134600 MVC PARMVAL(8),=CL8'IS' SAY ITS IS 00134700 B RETVOL OFF THIS CASE 00134800 RTDSOG CH R9,=X'8100' CHECK ISU 00134900 BNE RTDSOH BRANCH IF NOT ISU 00135000 MVC PARMVAL(8),=CL8'ISU' SAY ITS ISU 00135100 B RETVOL OFF THIS CASE 00135200 RTDSOH MVC PARMVAL(8),=CL8'????????' SOMETHING WE DON'T KNOW ABOUT 00135300 SPACE 2 00135400 * CHECK FOR VOLSER RETURN 00135500 SPACE 00135600 RETVOL L R8,ARVOLSER GET RETURN TO ADDR - VOLSER 00135700 LTR R8,R8 SEE IF THERE WAS A REQUEST 00135800 BZ CLEANUP BRANCH IF NO REQUEST 00135900 L R6,PRVOLSER --> TEXT UNIT 00136000 SR R9,R9 CLEAR REGISTER 00136100 LH R9,S99TULNG DDNAME LENGTH 00136200 EX R9,MVCBACK MOVE PROPER LENGTH (IN R9) 00136300 SPACE 2 00136400 B CLEANUP FOR JUMPING ERROR HANDLER CODE 00136500 SPACE 2 00136600 MVCBACK MVC PARMVAL,S99TUPAR REMOTELY EXECUTED MOVE 00136700 EJECT 00136800 * 00136900 * THS IS THE PLACE WHERE WE COME WHEN AN INPUT PARM IS BOTCHED 00137000 * 00137100 BADPARM LA R15,3 RETURN ERROR CODE 00137200 LCR R15,R15 IS -3 00137300 L 7,AIERR PICK UP ADDR OF IERR 00137400 ST R15,0(R7) RETURN CODE IN IERR 00137500 SPACE 2 00137600 * 00137700 * NOW THAT WE'RE FINISHED, ISSUE A FREEMAIN TO GET RID OF THE 00137800 * EVIDENCE (OTHERWISE KNOWN AS THE SVC99 REQUEST BLOCKS). 00137900 * 00138000 CLEANUP L R1,AGETRB GET THE ADDRESS OF IT 00138100 L R0,GETLGTH GET LENGTH OF IT 00138200 SPACE 00138300 FREEMAIN R,LV=(R0),A=(R1) FREE IT UP 00138400 SPACE 00138500 GOHOME L R13,SAVE+4 CHAIN BACKIN 00138600 RETURN (14,12),T AND SPLIT 00138700 EJECT 00138800 * 00138900 * WHEREUPON WE NOW DECLARE OUR MANY AND VARIED STORAGE AREAS 00139000 * (ITS NOT AS BAD AS IT SOUNDS) 00139100 * 00139200 SPACE 00139300 SAVE DS 18F SAVE AREAS 00139400 S230S99 DC C'01' SVC 230 (IGARCO) PROCESS CODE 00139500 DS 0F 00139600 SPACE 2 00139700 PLISTADR DS F PARAMETER LIST ADDRESS 00139800 SPACE 00139900 PARAMLST DS 0F THIS IS THE ACTUAL PARAMETER LIST 00140000 ANUNITS DS V NUMBER OF UNITS 00140100 AKEYS DS V ARRAY OF KEYS 00140200 APARMS DS V ARRAY OF PARMS 00140300 ADSNAME DS V DATA SET NAME 00140400 AIERR DS V PRIMARY ERROR FLAG 00140500 AJERR DS V SVC ERROR FLAG 00140600 SPACE 00140700 FIXSPACE DC F'28' FIXED LENGTH SPACE REQUIREMENT(BYTES) 00140800 NUNITS DS F NUMBER OF REQUESTS 00140900 DSNLGTH DS F LENGTH OF INPUT DSNAME 00141000 GETLGTH DS F LENGTH OF GETMAIN AREA 00141100 AGETRB DS F ADDRESS OF GETMAIN RETURNED AREA 00141200 ARDDNAME DS F ADDR TO RETURN DDNAME 00141300 PRDDNAME DS F ADDR OF RETURN DDNAME TEXT UNIT 00141400 ARDSNAME DS F FLAG TO RETURN DSNAME 00141500 PRDSNAME DS F ADDR OF RETURN DSNAME TEXT UNIT 00141600 ARDSORG DS F ADDR TO RETURN DSORG 00141700 PRDSORG DS F ADDR OF RETURN DSORG TEXT UNIT 00141800 ARVOLSER DS F ADDR TO RETURN VOLSER 00141900 PRVOLSER DS F ADDR OF RETURN VOLSER TEXT UNIT 00142000 SPACE 00142100 * 00142200 * TABLE OF HALFWORD ENTRIES GIVING THE (MAXIMUM) LENGTH, IN BYTES, OF 00142300 * THE ENTRY REQUIRED BY EACH FUNCTION REQUEST. THIS LENGTH INCLUDES 00142400 * THE PARM, TEXT UNIT PREFACE, AND TEXT UNIT POINTERS. NOTE: JUST 00142500 * BECAUSE A FUNCTION HAS AN ENTRY HERE DOES NOT IMPLY THAT SAID 00142600 * FUNCTION HAS SUPPORTING CODE IMPLEMENTED. 00142700 * 00142800 PRMLEN DC X'001200380012000B000B000B000A000A000D000D' 00142900 DC X'000D000D000A000B000A0010000A000B000B000E' 00143000 DC X'0012000B000A000B0012000E000D000A000B000B' 00143100 DC X'000C000B000B000F000C000A000E000B0010000A' 00143200 DC X'000C000A000A00380012000B000B000C000B000C' 00143300 DC X'000B000B000B000B000B000C000B000B000B000C' 00143400 DC X'000B000B000B000B000D000C000B000B000B000B' 00143500 DC X'000B000B000B000B000B000C000B000B000B0012' 00143600 DC X'0012000A000A000A00120016000C0010000A000B' 00143700 DC X'000E000A00100012000E000A000A' 00143800 SPACE 4 00143900 PARMBACK DSECT TO ALLOW EASY RETURN 00144000 PARMVAL DS C OF RECOVERED VALUES 00144100 EJECT 00144200 IEFZB4D0 RB/TEXT DSECTS AND CODES 00144300 EJECT 00144400 IEFZB4D2 DYNALLOC TEXT UNIT KEYS 00144500 SPACE 2 00144600 RBLEN EQU (S99RBEND-S99RB) EASY LENGTH CONSTANT 00144700 SPACE 00144800 END 00144900 DDFREE TITLE 'DYNAMIC ALLOCATION (SVC 99) INTERFACE - UNALLOCATION' 00145000 SPACE 5 00145100