INT TITLE 'DMSINT (CMS) VM/370 - RELEASE 6' 00001000 SPACE 2 00002000 *. 00007000 * 00008000 * MODULE NAME: 00009000 * 00010000 * DMSINT (INIT) 00011000 * 00012000 * FUNCTION: 00013000 * 00014000 * TO READ CMS COMMANDS FROM THE TERMINAL AND EXECUTE 00015000 * THEM. 00016000 * 00017000 * ATTRIBUTES: 00018000 * 00019000 * NUCLEUS RESIDENT AND REENTRANT. 00020000 * 00021000 * ENTRY POINTS: 00022000 * 00023000 * DMSINT - ENTRY FROM DMSINS 00024000 * DMSINTAB - ENTRY FROM DMSABN 00025000 * SUBSET - CMS SUBSET ENTRY 00026000 * 00027000 * FUNCTION: 00028000 * 00029000 * TO READ CMS COMMANDS FROM THE TERMINAL AND EXECUTE 00030000 * THEM. 00031000 * 00032000 * ENTRY CONDITIONS: 00033000 * 00034000 * GPR10 = ADDRESS OF OPSECT GPR11 = ADDRESS OF FVS 00035000 * GPR12 = ADDRESS OF DMSINT 00036000 * 00037000 * EXIT CONDITIONS: 00038000 * 00039000 * N/A - DMSINT NEVER EXITS. IT CONTINUES TO READ 00040000 * COMMANDS UNTIL THE USER LOGS OUT OF CP OR 00041000 * RE-IPL'S CMS. 00042000 * 00043000 * CALLS TO OTHER ROUTINES: 00044000 * 00045000 * DMSCRD, DMSCWR, DMSSTC, DMSINM, DMSINA, DMSITS, 00046000 * DMSAUD, DMSSCN, DMSCPF, DMSFREE, 00047000 * DMSFRET, DMSSMN, DMSHDI, DMSLFS, DMSFNS, DMSEXC 00048000 * 00049000 * EXTERNAL REFERENCES: 00050000 * 00051000 * NONE 00052000 * 00053000 * TABLES/WORKAREAS: 00054000 * 00055000 * REGISTER USAGE: 00056000 * 00057000 * GPR0 = WORK GPR1 = PLIST POINTER GPR2-6 = WORK 00058000 * GPR7-9 = UNUSED GPR10 = BASE REGISTER FOR OPSECT 00059000 * GPR11 = BASE REGISTER FOR FVSECT GPR12 = PROGRAM BASE 00060000 * REGISTER GPR13-15 = LINKAGE REGISTERS 00061000 * 00062000 * NOTES: 00063000 * 00064000 * NONE 00065000 * 00066000 * OPERATION: 00067000 * 00068000 * 00069000 * SYSTEM CONTINUITY 00070000 * 00071000 * INIT IS RESPONSIBLE FOR THE CONTINUITY OF OPERATION OF THE 00072000 * CMS COMMAND ENVIRONMENT. WHEN A TYPED-IN COMMAND HAS BEEN 00073000 * EXECUTED AND INTSVC RETURNS TO INIT, IT PASSES ALONG THE 00074000 * RETURN CODE FROM THE CALLED COMMAND IN REGISTER 15. A CODE 00075000 * OF ZERO INDICATES SUCCESSFUL COMPLETION OF THE COMMAND; A 00076000 * POSITIVE CODE INDICATES THAT THE COMMAND WAS COMPLETED BUT 00077000 * WITH AN APPARENT ERROR; AND A NEGATIVE CODE RETURNED BY 00078000 * INTSVC INDICATES THAT THE TYPED-IN COMMAND COULD NOT BE 00079000 * FOUND OR EXECUTED AT ALL. 00080000 * 00081000 * UPON RETURN, INIT SAVES THIS RETURN CODE BRIEFLY AND CALLS 00082000 * THE UPUFD FUNCTION PROGRAM TO UPDATE THE USER FILE DIRECTORY 00083000 * (UFD) ON THE APPROPRIATE USER'S DISK. 00084000 * 00085000 * HAVING UPDATED THE USER FILE DIRECTORY, INIT CHECKS THE 00086000 * RETURN CODE THAT HAD BEEN PASSED BACK. IF THE CODE IS ZERO, 00087000 * INIT TYPES A READY MESSAGE AND THE CPU TIME USED BY THE 00088000 * GIVEN COMMAND. IF THE CODE IS POSITIVE, AN ERROR MESSAGE IS 00089000 * TYPED, ALONG WITH THE CPU TIME USED. THE COMMAND WILL HAVE 00090000 * CAUSED THE TYPING OF AN ERROR MESSAGE OF THE FORMAT: 00091000 * DMSMMMNNN 'TEXT', WHERE MMM IS THE MODULE NAME, NNN IS THE 00092000 * MESSAGE IDENTIFICATION NUMBER, AND 'TEXT' IS THE MESSAGE. 00093000 * IF THE CODE IS NEGATIVE, INIT CHECKS IF THERE HAD BEEN ANY 00094000 * PROBLEM DETECTED IN LOADMOD, FOR IF THERE HAD THE 00095000 * COMMAND CANNOT BE ASSUMED TO BE A CP COMMAND. OTHERWISE, 00096000 * INIT WILL ISSUE A DIAGNOSE INSTRUCTION TO PRESENT THE 00097000 * COMMAND LINE TO THE CP ENVIRONMENT. IF IN FACT THE 00098000 * COMMAND IS NOT CP'S, INIT WILL TYPE THE MESSAGE "UNKNOWN 00099000 * COMMAND". (AS WOULD BE THE CASE FOR A BAD LOADMOD.) 00100000 * INIT THEN PROCEEDS IN THE MAIN CONTROL LOOP TO CALL CONREAD 00101000 * TO GET THE NEXT COMMAND. WHEN THE COMMAND IS ENTERED, INIT 00102000 * CALLS SETCLK TO INITIALIZE THE CPU TIME FOR THE NEW COMMAND 00103000 * AND THEN PUTS IT IN STANDARD PARAMETER-LIST FORM BY CALLING 00104000 * THE SCAN FUNCTION PROGRAM. AFTER CALLING SCAN, INIT CHECKS 00105000 * TO SEE IF AN EXEC FILETYPE EXISTS WITH A FILENAME OF THE 00106000 * TYPED-IN COMMAND. (FOR EXAMPLE, IF ABC WAS TYPED IN, INIT 00107000 * CHECKS TO SEE IF ABC EXEC EXISTS.) IF SUCH AN EXEC FILE 00108000 * DOES EXIST, INIT ADJUSTS REGISTER 1 TO POINT TO THE SAME 00109000 * COMMAND AS SET UP BY SCAN, BUT PRECEDED BY CL8'EXEC', AND 00110000 * THEN ISSUES AN SVC X'CA' TO CALL THE CORRESPONDING EXEC 00111000 * PROCEDURE ('ABC EXEC' IN THE EXAMPLE). 00112000 * 00113000 * IF NO SUCH EXEC FILE EXISTS FOR THE FIRST WORD TYPED IN, 00114000 * INIT MAKES ONE FURTHER CHECK USING THE CMS'ABBREV' 00115000 * ABBREVIATION-CHECKER. IF, FOR EXAMPLE, THE FIRST WORD TYPED 00116000 * IN HAD BEEN 'FORT', INIT LOOKS UP FORT VIA THE ABBREV 00117000 * ROUTINE FOR AN EQUIVALENT FORM; IF AN EQUIVALENT IS 00118000 * FOUND (FOR EXAMPLE, 'FORTRAN' FOR 'FORT'), INIT LOOKS FOR AN 00119000 * EXEC FILE WITH THE NAME OF THE EQUIVALENT WORD (FOR EXAMPLE, 00120000 * FORTRAN EXEC); IF SUCH A FILE IS FOUND, INIT ADJUSTS R1 AS 00121000 * DESCRIBED ABOVE TO CALL EXEC AND SUBSTITUTES THE EQUIVALENT 00122000 * WORD, FORTRAN, FOR THE FIRST WORD TYPED IN. THUS IF FORT IS 00123000 * A VALID ABBREVIATION FOR FORTRAN AND THE USER HAS AN EXEC 00124000 * FILE CALLED 'FORTRAN EXEC', HE INVOKES THIS WHEN HE MERELY 00125000 * TYPES IN 'FORT' FROM THE TERMINAL. 00126000 * 00127000 * IF NO EXEC FILE IS FOUND EITHER FOR THE ENTERED COMMAND NAME 00128000 * OR FOR ANY EQUIVALENT FOUND BY ABBREV, INIT LEAVES THE 00129000 * TERMINAL COMMAND AS PROCESSED BY SCAN AND THEN ISSUES AN SVC 00130000 * X'CA' TO PASS CONTROL TO INTSVC WHICH, IN TURN, PASSES 00131000 * CONTROL TO THE APPROPRIATE COMMAND PROGRAM. WHEN THE COMMAND 00132000 * TERMINATES EXECUTION, OR IF INTSVC CANNOT EXECUTE IT, THE 00133000 * RETURN CODE IS PASSED IN REGISTER 15, AND THE CMS COMMAND 00134000 * ENVIRONMENT CONTINUES AS DESCRIBED EARLIER. 00135000 * 00136000 * 00137000 * ENTRY POINT: 00138000 * 00139000 * SUBSET - CMS SUBSET ENTRY POINT 00140000 * 00141000 * FUNCTION: 00142000 * 00143000 * PROVIDE AN INTERFACE TO CONVERSATIONAL 00144000 * COMMAND EXECUTION WITHOUT REQUIRING A 00145000 * RETURN TO THE CMS COMMAND ENVIRONMENT. 00146000 * 00147000 * CALLING SEQUENCE: 00148000 * 00149000 * R1 MUST POINT TO SUBSET PARAMETER LIST. 00150000 * 00151000 * DS 0F 00152000 * PLIST DC CL*'SUBSET' 00153000 * DC 00154000 * DC 8XL1'FF' 00155000 * 00156000 * LA R1,PLIST 00157000 * SVC X'CA' 00158000 * 00159000 * EXIT CONDITIONS: 00160000 * 00161000 * NORMAL: GPR15= RETURN CODE OF FUNCTION PERFORMED 00162000 * 00163000 * ERROR: GPR15= 1 (FOR ATTEMPTED SUBSET RECURSION) 00164000 * 00165000 * CALLS TO OTHER ROUTINES: 00166000 * 00167000 * DMSLFS, DMSFREE, DMSFRET, DMSPNT, DMSLAF 00168000 * 00169000 * REGISTER USAGE: 00170000 * AS DEFINED UNDER DMSINT 00171000 * 00172000 * NOTES: 00173000 * 00174000 * NONE. 00175000 * 00176000 * OPERATION: 00177000 * 00178000 * UPON ON ENTRY TO SUBSET A CHECK IS MADE TO DETERMINE IF THIS 00179000 * ENTRY WOULD CONSTITUTE A RECURSION -- IF SO THIS IS ERROR 1. 00180000 * OTHERWISE, THE SUBSET AND SUBSET INITIALIZATION FLAGS ARE 00181000 * SET, THE RETURN ADDRESS IS SAVED, AND REGISTERS ARE SAVED. 00182000 * STAE AND SPIE INFORMATION IS SAVED, AS IS THE CURRENT VALUE 00183000 * OF OSSFLAGS. ACTLKP IS THEN CALLED TO DETERMINE WHETHER THERE 00184000 * ARE ANY OPEN FILES. IF THERE ARE, A COPY OF THE FILEID, READ AND 00185000 * WRITE POINTERS IS MADE AND RETAINED IN FREE STORAGE IN A CHAIN 00186000 * TERMINATED BY A COPY OF THE STATEFST EXTANT AT THE TIME OF ENTRY. 00187000 * ALL FILES ARE THEN CLOSED BY A CALL TO FINIS. A CHECK 00188000 * IS MADE FOR THE SPECIAL ARGUMENT 'RETURN', AND IF IT IS FOUND 00189000 * THE ENTRY MESSAGE IS SUPPRESSED AND THE NEXT COMMAND IS READ 00190000 * IMMEDIATELY. ELSE AN ANNOUNCEMENT OF ENTRY TO THE CMS SUBSET 00191000 * ENVIRONMENT IS MADE, THAT A DIFFERENTIATION FROM THE STRICT 00192000 * COMMAND ENVIRONMENT BE GIVEN TO THE USER. THE PRINCIPAL 00193000 * DIFFERENCE IN SUBSET IS THE RESTRICATION THAT ANY COMMAND 00194000 * EXECUTED MAY NOT UTILIZE OTHER THAN FREE STORAGE OR THE 00195000 * TRANSIENT AREA -- THUS PROTECTING PROGRAMS WHICH MAY BE RUNNING 00196000 * IN USER STORAGE (HEXLOC > 20000). THE COMMAND IS READ BY 00197000 * REJOINING DMSINT THROUGH THE WAITREAD SUBROUTINE. 00198000 * 00199000 * ALL COMMANDS EXECUTED IN CMS SUBSET RETURN TO THE LABEL 'SUBRET'. 00200000 * AT SUBRET ANY FILES WHICH WERE OPEN ON ENTRY TO SUBSET ARE 00201000 * RESTORED TO THEIR 'THEN' STATUS BY USING THE INFORMATION SAVED 00202000 * UPON ENTRY TO SUBSET AS A PARAMETER LIST FOR POINT. ANY 00203000 * READY MESSAGE ISSUED FROM SUBSET IS IN THE ABBREVIATED FORM 00204000 * SPECIFICALLY THAT JOB STEP TIMING INFORMATION IS NOT EFFECTED 00205000 * FOR THE COMMAND CURRENTLY IN PROGRESS AT THE TIME OF SUBSET ENTRY. 00206000 * 00207000 * ENTRY POINT: 00208000 * 00209000 * DMSINTAB 00210000 * 00211000 * FUNCTION: 00212000 * 00213000 * PROVIDE A RETURN ENTRY POINT TO DMSABN FOR RESUMPTION OF 00214000 * DMSINT ACTION. 00215000 * 00216000 * ENTRY CONDITIONS: 00217000 * 00218000 * NONE. 00219000 * 00220000 * EXIT CONDITIONS: 00221000 * 00222000 * NONE. 00223000 * 00224000 * CALLS TO OTHER ROUTINES: 00225000 * 00226000 * NONE. 00227000 * 00228000 * TABLES AND WORKAREAS: 00229000 * 00230000 * NONE. 00231000 * 00232000 * OPERATION: 00233000 * 00234000 * DMSINTAB UPON ENTRY ESTABLISHES ADDRESSIBILITY AND 00235000 * PICKS UP THE ADDRESS OF THE DSECTS REQUIRED BY DMSINT. 00236000 * AND THEN EXITS IMMEDIATELY. 00237000 * 00238000 *. 00239000 EJECT 00240000 INIT START 0 00241000 DMSINT EQU * 00242000 * 00243000 ENTRY DMSINT 00244000 ENTRY SUBSET 00245000 ENTRY RETSET @VA00871 00245100 * 00246000 USING NUCON,R0 00247000 USING SUBSECT,R7 P3047 00248000 USING OPSECT,R10 00249000 USING FVSECT,R11 00250000 USING INIT,R12 00251000 * 00252000 SSM =X'81' ENABLE FOR CHAN 0 & EXTERNAL INTERRUPTS 00253000 * 00254000 * START OF ONE-TIME-ONLY CODE 00255000 * 00256000 CONSNORM L R7,ASUBSECT FOR LATER USE @V200714 00257100 SR R13,R13 CLEAR REGISTER FOR UPDAT (IF NEEDED) 00258000 ST R13,CMSTIM+16 INDICATE WE WANT A RESET P1021 00259000 LA R1,CMSTIM GET A PLIST P1021 00260000 L R15,=V(CMSTIMER) AND A ROUTINE TO GO TO. P1021 00261000 BALR R14,R15 GO THERE P1021 00262000 LTR R3,R3 WERE ANY COMMANDS STACKED BY DMSINS? 00263000 BZ UPDAT GUESS NOT P1021 00264000 LA R4,INIT1A (SILLY BUT RETURN REQUIRED) 00265000 INIT1B LTR R5,R5 WAS THERE A USER FIRST COMMAND? 00266000 BNZ INIT1A NO. KEEP CHECKING, THOUGH. 00267000 CH R3,=H'1' IS THAT ALL THAT'S LEFT? 00268000 BE INIT1C YES. DO IT IN INIT MAINLINE @VA04649 00269150 INIT1A BAL R13,WAITREAD GET THE COMMAND. 00270000 SVC 202 AND DO IT 00271000 DC AL4(*+4) @VA00871 00271100 BCT R3,INIT1B REDUCE COUNT BY 1. P1021 00272000 INIT1C LR R13,R15 SAVE RETURN CODE FOR UPDAT @VA04649 00273100 B UPDAT OF COURSE. 00274000 * 00275000 * END OF ONE-TIME-ONLY CODE 00276000 * 00277000 EJECT 00278000 * 00279000 * IF A NULL LINE IS INPUTTED(CARRIAGE-RETURN ONLY), TYPE "CMS" 00280000 * 00281000 TYPCMS C R6,FSTFINRD ANYBODY STACKED BEHIND US? 00282000 BL WTRD0 YES, GO READ THE NEIGHBORS. 00283000 LA R0,CMS3 MESSAGE = 'CMS' 00284000 LA R1,4 BYTE COUNT (CMS+CR) @VM08810 00285100 TM SUBFLAG,X'01' CMS SUBSET? 00286000 BO SUBSAY YES, GIVE "CMS SUBSET" INSTEAD. @V305032 00287100 TM DOSFLAGS,DOSMODE ARE WE IN DOS MODE ? @V305032 00287200 BZ TYPBLK NO - "CMS" IT IS. @V305032 00287300 LA R0,CMS4 YES, GIVE "CMS (DOS ON)" MSG @V305032 00287400 LA R1,LCMS4 ... @V305032 00287500 B TYPBLK ... @V305032 00287600 SUBSAY LA R0,CMS5 TYPE 'CMS SUBSET' INSTEAD 00288000 LA R1,11 WHICH HAS LENGTH OF 10+1 @VM08810 00289000 TYPBLK LA R2,C'B' SET R2 FOR COLOR = BLACK 00290000 TYPALL TM MSGFLAGS,SPECLF MUST WE ISSUE SPECIAL LINEFEED ?@V200714 00291000 BO LINFD YES..BR @V200714 00291100 SH R1,NOLF NO..DONT USE X'25' IN MSG @VM08810 00291200 LINFD STM R0,R1,CONWRBUF STORE ADDR & BYTE COUNT OF MSG @V200714 00291300 STC R2,CONWRCOD STORE 'B' OR 'R' COLOR CODE 00292000 LA R1,CONWRITE TYPE THE MESSAGE 00293000 MVI CONWRCOD+1,X'01' RESULTS IN 09 OP CODE @VM08810 00294100 SVC 202 ... 00295000 DC AL4(*+4) @VA00871 00295100 MVI CONWRCOD+1,X'00' CLEAR DMSINT FLAG 00296000 * 00297000 * CLEAR USER-SUPPLIED SVC & INTERRUPT TABLES 00298000 * 00299000 L R13,ASVCSECT 00300000 TM SUBFLAG,X'01' CMS SUBSET? 00301000 BO INLOOP2 BRANCH, GO AND READ COMMAND @VA10491 00302000 USING SVCSECT,R13 00303000 LM R0,R3,JNUMB GET USER-SVC-TABLE (IF ANY) 00304000 LTR R1,R1 IS THERE? 00305000 BZ TBLOK BZ IF NOT, TABLE IS OK AS IS. 00306000 LTR R0,R0 IF EXISTS, IT IT IN FREE STORAGE ? 00307000 BZ R0CLR BZ IF NOT. 00308000 * CALL FRET IF NECESSARY TO RETURN IT 00309000 DMSFRET DWORDS=(0),LOC=(1),TYPCALL=BALR 00310000 SR R0,R0 AND CLEAR R0, 00311000 R0CLR SR R1,R1 CLEAR R1, 00312000 SR R3,R3 (AN R3 TO BE NEAT) 00313000 STM R0,R3,JNUMB STORE TABLE WITH CLEARED WORDS 0, 1, & 3. 00314000 DROP R13 00315000 * 00316000 TBLOK L R2,AIOSECT GET ADDR OF IONTABL 00317000 USING IOSECT,R2 00318000 LM R2,R5,IONTABL 00319000 LTR R3,R3 IS THERE ANYTHING THERE AT ALL ? 00320000 BZ PGREL CHECK FOR REL. PAGES 00321000 CHKEEP TM 2(R3),KEEP IS 'KEEP' FLAG SET IN FLAG-BYTE ? 00322000 BO BXLE34 BO IF YES, KEEP THE HANDLER. 00323000 LA R1,HNDILST IF NOT, LET 00324000 SVC X'CA' 'HNDINT PURGE' CLEAN IT UP. 00325000 DC AL4(PGREL) ERROR RETURN 00326000 B PGREL GET NEXT COM. AFTER PG CK 00327000 BXLE34 BXLE R3,R4,CHKEEP ITERATE THRU 'IONTABL' 00328000 DROP R2 00329000 * 00330000 * RELEASE USER-AREA PAGES IF NECESSARY 00331000 * PURGESYS CMS SAVED SEGMENT IF NECESSARY 00332050 * 00332100 PGREL TM DCSSFLAG,DCSSLDED SAVED SEGMENT LOADED ? @V305614 00332150 BNO NOPURGE NO, FORGET ALL THIS @V305614 00332200 SPACE 1 00332250 TM DCSSFLAG,DCSSJLNS CMSSEG LOADED NONSHARE ? @V305614 00332300 BNO PURGIT NO, THEN PURGE IT @V305614 00332350 B NOPURGE ..... @V305614 00332400 SPACE 1 00332450 PURGIT L R13,ASYSNAMS POINT TO SYSNAMES TABLE @V305614 00332500 USING SYSNAMES,R13 ..... @V305614 00332550 LA R4,CMSSEG POINT TO CMSSEG NAME @V305614 00332600 DROP R13 @V305614 00332650 LA R13,PURGESYS INDICATE PURGESYS FUNCTION @V305066 00332700 DC X'834D0064' PURGESYS CMSSEG @V305614 00332750 NI DCSSFLAG,255-DCSSLDED FLIP SEG LOADED INDICATOR @V305614 00332800 SPACE 1 00332850 NOPURGE TM OPTFLAGS,NOPAGREL CAN WE RELEASE PAGES ? @V305614 00332900 BO INLOOP1 NOPE. HOLD YOUR PAGES. 00334000 TM MISFLAGS,RELPAGES YES; SHOULD WE RELEASE PAGES? 00335000 BNO INLOOP1 NO. 00336000 NI MISFLAGS,255-RELPAGES TURN FLAG OFF AGAIN @VA02523 00336300 L R13,FREELOWE PUT LOWEXT INTO R13 00337000 SRL R13,12 00338000 BCTR R13,0 DECREMENT R13 00339000 SLL R13,12 PUT ZEROES INTO REG. 00340000 L R4,AUSRAREA FOR NO, MIN. PAGE 00341000 DC X'834D0010' GO RELEASE PAGES. 00342000 ST R4,LOCCNT SET LOCCNT TO START OF USERAREA @VA07510 00342500 STR STRINIT TYPCALL=BALR @VA03626 00344100 EJECT 00345000 * 00346000 * INITIAL COMMAND START-UP 00347000 * 00348000 INLOOP1 EQU * 00349000 L R4,=V(EXTPSW) CLEAR "TRAPPED" EXTERNAL PSW LL 00350000 SR R0,R0 00351000 ST R0,4(,R4) CLEAR EXTPSW+4 00352000 INLOOP2 LA R4,TYPCMS SET COUNT ZERO VECTOR 00353000 BAL R13,WAITREAD GO READ LINE 00354000 INLOOPA CH R0,=H'8' WAS ANYTHING SPECIFIED? 00355000 BE INLOOP2 ALL BLANKS. GO READ AGAIN. 00356000 CLI 0(R1),C'*' AN ASTERISK MEANS A COMMENT ONLY 00357000 BE INLOOP2 COMMENT. GO READ NEXT LINE 00358000 TM OPTFLAGS,NOIMPEX IMPLIED EXEC NOT WANTED TODAY ? 00359000 BO GO BRANCH IF SO (SKIP FANCY EXEC STUFF) 00360000 SR R5,R5 SET DETERMINATOR 00361000 LA R9,TRY1 SET VECTOR FOR "FULL" COMMAND NAME 00362000 LR R4,R1 SAVE R1 = =(COMBUF) 00363000 MVC FILENAME,0(R4) MOVE IN COMMAND NAME 00364000 MVC FILETYPE(10),=C'EXEC * ' 00365000 TRY2 L R15,=V(DMSLFS) VERIFY EXISTENCE OF EXEC-FILE 00366000 LA R1,PLIST 00367000 BALR R14,R15 00368000 BCR 8,R9 IF IT EXISTS, GO... 00369000 TM OPTFLAGS,NOABBREV IF NOT, ARE ABBREVIATIONS ALLOWED? 00370000 BO TRY3 NOT EXEC AND ABBREV'S ILLEGAL 00371000 LTR R5,R5 INITIAL 'ABBREV' ATTEMPT? 00372000 BZ INITIAL YES @VA06272 00373100 CLC FILENAME(3),=C'CP ' IS SYNONYM CP? @VA06272 00373200 BNE TRY3 NO,TRY MODULAR CMND @VA06272 00373300 MVC PREVCMND,LASTCMND SAVE PREVIOUS CMND NAME @VA06272 00373400 MVC LASTCMND,0(R4) SAVE CURRENT CMND NAME @VA06272 00373500 B CPFUNCTN BRANCH @VA06272 00373600 INITIAL EQU * @VA06272 00373700 LA R9,TRY1A POINT TO USE OF "ABBREV" COMMAND 00374000 LM R0,R1,0(R4) GET FULL NAME ENTERED 00375000 LR R5,R0 INDICATE "ABBREV" TO BE CALLED. 00376000 L R15,=V(ABBREV) GET ROUTINE ADDRESS 00377000 BALR R14,R15 ... 00378000 LTR R15,R15 DOES A MATCH-UP OCCUR 00379000 BNZ TRY3 NO. 00380000 STM R0,R1,FILENAME USE "ABBREV" COMMAND NAME 00381000 B TRY2 STATE ABBREV EXEC 00382000 TRY1A MVC 0(8,R4),FILENAME INSERT "ABBR"COMMAND NAME IN COMBUF 00383000 TRY1 SH R4,=H'8' DON'T SAY IT'S AN EXEC P3047 00384000 TRY3 LR R1,R4 R1=V("EXEC" OR 'COMMAND') 00385000 GO MVC PREVCMND,LASTCMND SAVE PREVIOUS COMMAND NAME. P0626 00386000 MVC LASTCMND,0(R1) SAVE CURRENT COMMAND NAME. P0626 00387000 CLC 0(3,R1),=C'CP ' IS IT A CP REQUEST? P0626 00388000 BE CPFUNCTN BRANCH IF YES. 00389000 GOSVC ICM R1,B'1000',=X'0C' FLAG AS "COMMAND" FROM "INIT" @VA01154 00395100 SVC 202 & GO TO SPECIFIED CMS COMMAND @VA01154 00395200 DC AL4(*+4) SKIP OVER ERROR 00396000 TM SUBFLAG,SUBACT+SUBREJ SUBSET COMMAND REJECT ? @V305614 00396020 BNO SSOK NO, BRANCH @V305614 00396040 NI SUBFLAG,255-SUBREJ RESET INDICATOR @V305614 00396060 TM SUBFLAG,SUBRTN SHOULD WE ALSO RETURN? @VA10314 00396080 BZ INVSUB BR IF NOT RETURN, TELL USER. @VA10314 00396085 LH R15,=H'-2' MAKE BELEIVE A BAD LOADMOD @VA10314 00396090 B FROMCMD AND RETURN TO THE USER. @VA10314 00396095 SPACE 1 00396100 SSOK CLC LASTCMND,=CL8'RETURN' WAS IT 'RETURN' ? @V305614 00396120 BE SUBRET YES, BRANCH @VA00871 00396200 EJECT 00397000 * 00398000 * RETURN FROM CONSOLE-INITIATED COMMAND 00399000 * 00400000 FROMCMD L R13,AEXTSECT ADDRESSABILITY @VA02474 00400050 USING EXTSECT,R13 @VA02474 00400100 CLI TIMCHAR,0 IS BLIP ON ? @VA02474 00400150 BE FROMC2 NO, THEN NOCHECK @VA02474 00400200 CLC TIMER(4),TIMINIT IS TIMER > 2 SECS? @VA02474 00400250 BL FROMC2 NO, THEN DONT RESET @VA02474 00400300 MVC TIMER(4),TIMINIT SET TO 2 SECS @VA02474 00400350 DROP R13 @VA02474 00400400 FROMC2 LTR R13,R15 RTN CODE --> R13 & SET COND CODE @VA02474 00400450 TM MISFLAGS,NEGITS BAD CMS COMMAND? @VA02241 00403000 BNO UPDAT NO, THEN GO TO NORMAL RTNE @VA02241 00403100 LTR R13,R15 @VA02241 00403200 BNM UPDAT @VA02241 00403300 TM OPTFLAGS,NOIMPCP CHEK FOR IMPLIED CP COMMND USE 00404000 BO UPDAT NO - DROP TO MESSAGES 00405000 CH R13,BADMOD WAS IT A BAD MODULE? 00406000 BE UPDAT YES -- THEN DON'T BUG 'CP' 00407000 CH R13,BADENV LOADMOD WHEN WRONG ENVIRONMENT? @V305066 00407100 BE UPDAT YES, THEN DON'T BUG 'CP' @V305066 00407200 CH R13,BADSUB LOADMOD HAVE TROUBLE? P3007 00408000 BE UPDAT APPARENTLY. P3007 00409000 CPFUNCTN LA R1,CMNDLINE PROVIDE A(COMMAND LINE) 00410000 LR R0,R6 AND COUNT FOR CP FUNCTION 00411000 L R15,=V(DMSCPF) GET ADDRESS OF DMSCPF 00412000 BALR R14,R15 SEND COMMAND TO CP 00413000 CH R15,=H'1' CHECK CP RETURN FOR UNKNOWN COMMAND 00414000 BNE NOT4 CP RECOGNIZED IT, IF NOT EQUAL 00415000 LNR R13,R15 IF SO, LOAD NEG. RC FOR APPROP. MSG 00416000 B UPDAT GO CLOSE THE FILES 00417000 NOT4 LR R13,R15 IF NOT, USE CP RET CODES & CONTINUE 00418000 * 00419000 * LOGOUT OUT ON DISK BEFORE GIVING READY MESSAGE 00420000 * 00421000 UPDAT LA R1,FINISLST CLOSE ALL FILES (IF ANY ARE OPEN) 00422000 SVC 202 UPDATING ANY USER FILE-DIRECTORIES 00423000 DC AL4(*+4) IN THE PROCESS. 00424000 TM OSSFLAGS,OSRESET RESET OF OS-FIELDS REQUIRED? P3038 00425000 BNO CLROSFLG NO. P3038 00426000 SVC 203 APPARENTLY. P3038 00427000 DC H'12' SVC203 CODE TO GO TO DMSSMNCL P3038 00428000 CLROSFLG MVI OSSFLAGS,X'00' RESET ALL THE FLAGS. P3038 00429000 TM SUBFLAG,X'01' IS IT SUBSET ?? @VA08831 00429020 BO RESTYP YES THEN DON'T FREE VSAM @VA08831 00429040 TM VSAMFLG1,VIPINIT OS VSAM PROGRAM FINISH? @V305106 00429100 BZ RESTYP IF NOT, CONTINUE @V305106 00429150 LA R1,VSRLIST IF SO, CLEANUP VSAM @V305106 00429200 SVC 202 BY CALLING DMSVSR... @V305106 00429250 RESTYP EQU * @V305106 00429300 LR R15,R13 RESTORE RETURN CODE 00430000 NI MSGFLAGS,255-NOTYPING RESTORE TYPING P3007 00431000 TM SUBFLAG,X'04' IS IT 'SUBSET (RETURN)'? 00432000 BO SUBRET BRANCH IF SO (RETURN PRONTO) 00433000 TM MISFLAGS,NEGITS BAD CMS COMMAND? @VA02241 00433100 BNO CKPR15 NO, THEN CONTINUE NORMALLY @VA02241 00433200 NI MISFLAGS,255-NEGITS TURN OFF BAD CMS FLAG @VA02241 00433300 LTR R15,R15 TEST RETURN CODE 00434000 BC 4,ERR4 BRANCH IF ERROR FOUND DURING SVC LINKER 00435000 BC 2,ERR5 BRANCH IF ERROR DURING COMMAND EXECUTION 00436000 B PRNREADY @VA02241 00436100 CKPR15 LTR R15,R15 CHECK R15 RETURN CODE @VA02241 00436200 BZ PRNREADY IF ZERO NORMALLY @VA02241 00436300 B ERR5 IF NOT PRINT ERROR CODE @VA02241 00436400 * 00437000 * NO ERROR MEANS THAT SOME COMMAND WAS USED SUCCESSFULLY 00438000 * 00439000 PRNREADY EQU * PRINT 'READY' MESSAGE WITH TIME & ADDED CAR-RETRN. 00440000 MVC RMSGBUF+7(9),=C'Ready; T=' HRC011DS 00441490 TM MSGFLAGS,NORDYTIM IS THE SHORT FORM DESIRED? 00442000 BO NORTMSG YES. GO PRINT IT THEN. 00443000 TM SUBFLAG,X'01' IS IT 'SUBSET (RETURN)'? 00444000 BO NORTMSG WE'RE O.K. HERE TOO. 00445000 BAL R13,TIMESUB CALL THE TIME SUBROUTINE. 00446000 LA R1,7(,R1) INCREMENT BYTE COUNT CORRECTLY HRC011DS 00447490 PRNRDY1 LA R0,RMSGBUF+7 NOW POINT TO THE WHOLE THING P3047 00448000 B TYPBLK ... AND PRINT IT. 00449000 SPACE 00450000 NORTMSG LA R1,RDYOFF UPDATE LENGTH REGISTER. 00451000 MVI RMSGBUF+13,X'15' HRC011DS 00452490 B PRNRDY1 00453000 SPACE 00454000 BADENV DC H'-5' LOADMOD WHEN WRONG ENVIRONMENT ACTIVE @V305066 00454100 BADMOD DC H'-4' P3007 00455000 BADSUB DC H'-2' P3007 00456000 BADCP DC H'-1' 00457000 NOLF DC H'1' FOR REMOVAL OF MSG LF @VM08810 00457100 EJECT 00458000 * 00459000 * THE FOLLOWING IS THE CODE FOR ENTRY TO AND RETURN FROM 00460000 * CMS SUBSET. 00461000 * 00462000 * IN THE CMS SUBSET THE USER ISSUES COMMANDS FROM THE CONSOLE 00463000 * AND IS PROTECTED FROM OVERLAYING THE USER AREA OF CORE 00464000 * (>= X'20000'); TIMES ARE NOT TYPED, AND ACCUMULATE. 00465000 * THE CMS SWITCH IS SET TO ZERO AND RESTORED ON RETURN. 00466000 * THE STAE AND SPIE ARE TURNED OFF AND RESTORED ON RETURN. 00467000 * THE READ AND WRITE POINTERS FOR ACTIVE FILES ARE SAVED, 00468000 * AND RESTORED ON RETURN. THEY ARE THEN CLOSED (BUT NOT 00469000 * ERASED, EVEN IF MODE NUMBER IS '3'). 00470000 * 00471000 * THE FORMAT IS: 00472000 * 00473000 * SUBSET <(RETURN)> 00474000 * 00475000 * 'RETURN' MEANS DON'T ANNOUNCE 'CMS SUBSET...' AND RETURN 00476000 * AFTER FIRST COMMAND. 00477000 * 00478000 SPACE 2 00479000 USING SUBSET,R12 00480000 DS 0F @V200714 00480100 SUBSET EQU * 00481000 L R12,=A(INIT) SET UP A BASE 00482000 USING INIT,R12 00483000 L R10,AOPSECT SINCE WE NEED IT. 00484000 L R7,ASUBSECT P3047 00485000 SR R15,R15 INITIALIZE RETURN CODE 00486000 TM SUBFLAG,X'01' ALREADY IN SUBSET? 00487000 BO ERRET BRANCH IF SO 00488000 OI SUBFLAG,X'03' SET SUBSET & SUBSET-INITIALIZATION FLAGS 00489000 * THE SUBSET-INITIALIZATION FLAG IS REFERRED TO BY FINIS, IN ORDER 00490000 * TO AVOID ERASING FILES WITH MODE NUMBER '3'. 00491000 ST R14,ASUBRET SAVE RETURN ADDRESS 00492000 LR R2,R1 SAVE R1 00493000 SPACE 00494000 * SAVE THE STAE DATA AND TURN IT OFF 00495000 SPACE 00496000 L R1,ASCBPTR ADDR OF POINTER TO THE STAE AREA. 00497000 MVC STAESAV(4),0(R1) SAVE IT 00498000 ST R15,0(R1) AND REPLACE FOR NOW WITH ZERO 00499000 SPACE 00500000 * NOW DO THE SAME WITH SPIE (EASIER BECAUSE THE MACRO IS SANE) 00501000 SPACE 00502000 IC R0,DOSFLAGS PRESERVE DOSFLAGS SETTING @V305101 00502100 NI DOSFLAGS,255-DOSSVC RESET DOSSVC FLAG IF 'ON' @V305101 00502200 SPIE 00503000 STC R0,DOSFLAGS RESTORE DOSFLAGS SETTING @V305101 00503100 ST R1,SPIESAV SAVE OLD PICA 00504000 SPACE 00505000 MVC SWTCHSAV(1),OSSFLAGS AND SAVE IT 00506000 SR R0,R0 CLEAR R0 00507000 MVI OSSFLAGS,X'00' AND REPLACE SWITCH WITH ZEROES 00508000 SPACE 1 @VA12058 00508100 * NOW SAVE THE STAX POINTER SO THAT SUBSET CAN HAVE @VA12058 00508200 * THE CONSOLE INTERRUPTS. @VA12058 00508300 SPACE 1 @VA12058 00508400 MVC STAXSAV(4),TAXEADDR SAVE STAX POINTER @VA12058 00508500 ST R15,TAXEADDR ZERO IT. NOW SUBSET OWNS CONSOLE @VA12058 00508600 * 00509000 * LOOP THROUGH FILES IN ACTIVE FILE TABLE AND SAVE 00510000 * READ AND WRITE POINTERS. 00511000 * 00512000 SR R5,R5 SET FOR LAST LINK IN SUBFST CHAIN 00513000 SR R6,R6 AND SET TO SEARCH AFT FROM BEGINNING 00514000 * 00515000 FILSAVLP EQU * LOOP THOUGH ACTIVE FILES 00516000 LR R0,R6 SEARCH AFT FROM HERE 00517000 LA R1,STARS-8 PARAMETER LIST FOR ACTLKP 00518000 L R15,AACTLKP SEARCH ACTIVE FILE TABLE 00519000 BALR R14,R15 00520000 BNZ SUBSAV BRANCH IF NONE LEFT 00521000 LR R6,R1 ADDRESS OF ENTRY IN AFT 00522000 USING AFTSECT,R6 00523000 DMSFREE DWORDS=4,TYPE=NUCLEUS,TYPCALL=BALR 00524000 ST R5,0(R1) SAVE CHAIN PTR 00525000 LR R5,R1 POINT TO THIS SUBFST 00526000 USING SUBFST,R5 00527000 MVC SUBN(16),AFTN MOVE IN NAME AND TYPE 00528000 MVC SUBM(2),AFTM AND MODE 00529000 MVC SUBWP(4),AFTWP AND WP AND RP 00530000 DROP R5,R6 00531000 B FILSAVLP 00532000 SPACE 00533000 SUBSAV EQU * 00534000 L R11,AFVS LET'S GET SOME ADDRESSABILITY 00535000 DMSFREE DWORDS=STFSTSDW,TYPE=NUCLEUS,TYPCALL=BALR HRC015DS 00536100 MVC 0(STFSTSIZ,R1),STATEFST Preserve end of chain HRC015DS 00536600 ST R1,ASUBSTAT AND REMEMBER WHERE THAT IS 00538000 ST R5,ASUBFST SAVE LAST SUBFST CHAIN ADDRESS 00539000 LA R1,FINISLST CLOSE ANY FILES... 00540000 SVC 202 AND UPDATE FILE DIRECTORY IF NECESSARY 00541000 DC AL4(*+4) (DOESN'T MATTER IF NONE OPEN) 00542000 NI SUBFLAG,255-X'02' CLEAR SUBSET-INITIALIZATION FLAG 00543000 SPACE 00544000 CLI 8(R2),X'FF' END OF PARM LIST? 00545000 BE SUBSAY BRANCH IF SO 00546000 CLI 9(R2),C'R' IS 'RETURN' OPTION SPECIFIED? 00547000 BNE SUBSAY BRANCH IF NOT 00548000 OI SUBFLAG,X'04' SET 'RETURN' BIT 00549000 TM SUBFLAG,X'01' CMS SUBSET? @VA10491 00549200 BO INLOOP2 YES, DO NOT RESET @VA10491 00549400 B INLOOP1 GO AND READ COMMAND 00550000 RETSET BALR R1,0 ESTABLISH ADDRESSABILITY @VA00871 00550100 USING *,R1 ... @VA00871 00550200 USING NUCON,R0 ... @VA00871 00550300 SR R15,R15 ZERO RETURN CODE @VA00871 00550400 TM SUBFLAG,X'01' ARE WE IN CMS SUBSET? @VA00871 00550500 BZR R14 NO, RETURN NOW @VA00871 00550600 MVC LASTCMND,=CL8'RETURN' COMPENSATE FOR SYNONYM @VA00871 00550700 BR R14 RETURN @VA00871 00550800 DROP R1 @VA00871 00550900 SPACE 00551000 SUBRET EQU * RESET FILE PTRS, RET TO CALLER @VA00871 00551100 BALR R15,0 ESTABLISH ADDRESSABILITY @VA00871 00551200 USING *,R15 ... @VA00871 00551300 L R12,=A(INIT) SET COMMON BASE @VA00871 00551400 USING INIT,R12 ... @VA00871 00551500 DROP R15 @VA00871 00551600 USING NUCON,R0 @VA00871 00551700 L R7,ASUBSECT SET USEFUL BASES @VA00871 00551800 L R10,AOPSECT ... @VA00871 00551900 L R11,AFVS ... @VA00871 00552000 USING SUBSECT,R7 @VA00871 00552100 USING OPSECT,R10 @VA00871 00552200 USING FVSECT,R11 @VA00871 00552300 SR R15,R15 ZERO RETURN CODE @VA00871 00552400 TM SUBFLAG,X'01' NOW IN SUBSET? @VA00871 00552500 BZ FROMCMD NO, ALL DONE @VA00871 00552600 L R5,ASUBFST ADDRESS OF LAST LINK IN SUBFST CHAIN 00554000 FILRESLP EQU * LOOP THOUGH FILES IN SUBFST CHAIN 00555000 LTR R1,R5 END OF CHAIN? 00556000 BZ SUBRET1 BRANCH IF SO 00557000 USING SUBFST,R1 00558000 L R5,SUBP PICK UP CHAIN POINTER 00559000 MVC SUBP(8),=CL8'POINT' AND OVERWRITE WITH 'POINT' 00560000 SVC 202 ISSUE POINT FROM SUBFST 00561000 DC AL4(*+4) 00562000 LA R0,4 FREE 4 DBL-WDS 00563000 DMSFRET DWORDS=(0),LOC=(1),TYPCALL=BALR 00564000 DROP R1 00565000 B FILRESLP LOOP 00566000 SUBRET1 EQU * 00567000 L R1,ASUBSTAT GET ADDRESS OF STATEFST INFO 00568000 MVC STATEFST(STFSTSIZ),0(R1) Put it back HRC015DS 00569100 LA R0,STFSTSDW And release storage HRC015DS 00570100 DMSFRET DWORDS=(0),LOC=(1),TYPCALL=BALR 00571000 MVC OSSFLAGS(1),SWTCHSAV RESTORE ITS PREVIOUS SETTING. 00572000 L R1,SPIESAV PICK UP OLD PICA 00573000 IC R0,DOSFLAGS PRESERVE DOSFLAGS SETTING @V305066 00573100 NI DOSFLAGS,255-DOSSVC RESET DOSSVC FLAG IF ON @V305066 00573200 SPACE 1 @VA12058 00573300 * RESTORE THE STAX @VA12058 00573400 SPACE 1 @VA12058 00573500 MVC TAXEADDR(4),STAXSAV RESET STAX POINTER @VA12058 00573600 SPACE 00574000 * RESTORE THE SPIE 00575000 SPACE 00576000 SPIE MF=(E,(1)) AND RESTORE IT 00577000 STC R0,DOSFLAGS RESTORE SETTING @V305066 00577100 SPACE 00578000 * RESTORE THE STAE (MESSY BECAUSE THE MACRO WON'T DO IT) 00579000 SPACE 00580000 L R1,ASCBPTR ADDRESS OF PTR TO STAE DATA 00581000 MVC 0(4,R1),STAESAV RESTORE OLD POINTER 00582000 SPACE 00583000 LR R15,R13 SET RETURN CODE 00584000 TM SUBFLAG,X'04' IS THIS SUBSET WITH RETURN @VA02378 00584100 * OPTION? 00584200 BO OPRET YES, THEN LEAVE R15 ALONE @VA02378 00584300 SR R15,R15 NO THEN ZERO OUT R15 AND CONTINUE@VA02378 00584400 OPRET NI SUBFLAG,255-X'05' CLEAR SUBSET FLAG @VA02378 00585000 L R14,ASUBRET GET ADDRESS FOR RETURN 00586000 BR R14 RETURN FROM CMS SUBSET 00587000 SPACE 00588000 ERRET EQU * ERROR RETURN 00589000 LA R15,1 ERROR CODE = 1 00590000 BR R14 RETURN TO CALLER 00591000 EJECT 00592000 SUBFST DSECT 00593000 SPACE 00594000 SUBP DS D 00595000 SUBN DS D 00596000 SUBT DS D 00597000 SUBM DS CL2 00598000 SUBWP DS H 00599000 SUBRP DS H 00600000 EJECT 00601000 AFT 00602000 SVCSECT 00603000 INIT CSECT 00604000 * 00605000 * TIME HANDLER 00606000 * 00607000 TIMESUB LA R1,CONWAIT WAIT FOR CONSOLE TO SUBSIDE 00608000 SVC 202 00609000 DC AL4(*+4) @VA00871 00609100 LA R1,RMSGBUF+16 ADDRESS OF OUR BUFFER HRC011DS 00610490 ST R1,CMSTIM+16 STORE FOR CMSTIME 00611000 LA R1,CMSTIM PREPARE TO CALL CMSTIME 00612000 L R15,=V(CMSTIMER) 00613000 BALR R14,R15 CALL CMSTIME TO GET TIMES 00614000 LA R1,RMSGBUF+16 ADDR OF BUFFER (WITH TIMES NOW) PHRC011DS 00615490 LR R15,R1 SAVE THIS ADDRESS FOR LATER. 00616000 A R1,CMSTIM+20 PLUS LENGTH USED MAKES NEXT FREE BYTE 00617000 MVI 0(R1),X'15' @VA01602 00618100 SR R1,R15 ... 00619000 LA R1,3(,R1) MIGHT AS WELL INCREMENT HERE. P3038 00620000 BR R13 00621000 * 00622000 * READ IN LINE FROM TERMINAL 00623000 * R4=A(ZERO COUNT), R13=A(RETURN) 00624000 WAITREAD MVI CONRDCOD,C'U' ENSURE 'U' CODE 00625000 WTRD0 LA R1,CONREAD POINT TO THE READ PLIST. P3038 00626000 TM OPTFLAGS,NOVMREAD AUTOREAD OFF? @VM08878 00627150 BZ RDSVC NO..BR @V200714 00627200 OI MISFLAGS,QSWITCH TELL DMSCRD TO GO QUIETLY @VM08878 00627350 RDSVC SVC 202 READ INPUT LINE @V200714 00627400 NI MISFLAGS,255-QSWITCH RESET @VM08878 00627550 TM MSGFLAGS,NORDYTIM IS RDYMSG SET TO BRIEF? 00628000 BO WTRD2 BRANCH IF SO (GET ON WITH IT) 00629000 TM SUBFLAG,X'01' CMS SUBSET? 00630000 BO WTRD2 BRANCH IF SO (GET ON) 00631000 SR R1,R1 INDICATE TO CMSTIME THAT... 00632000 ST R1,CMSTIM+16 WE WANT 'RESET' ONLY. 00633000 LA R1,CMSTIM CALL CMSTIME TO RESET OUR CPU TIMES 00634000 L R15,=V(CMSTIMER) 00635000 BALR R14,R15 00636000 WTRD2 EQU * 00637000 LH R6,CONRDCNT PICK UP READ BYTE-COUNT 00638000 LTR R0,R6 CHECK IT (ALSO INTO R0) 00639000 BCR 8,R4 NOPE. GO IDENTIFY OURSELVES 00640000 LR R0,R6 LOAD BYTE COUNT FOR SCAN 00641000 LA R1,CMNDLINE POINT TO INPUT LINE 00642000 L R15,=V(DMSSCNN) CONVERT INPUT LINE TO PLIST 00643000 BALR R14,R15 (ON RETURN, R1 = A(COMBUF)) 00644000 BR R13 00645000 * 00646000 CONWAIT DS 0F 00647000 DC CL8'CONWAIT' 00648000 DC CL4'CON1' 00649000 EJECT 00650000 * 00651000 * ERROR RETURNS 00652000 * 00653000 ERR4 CH R15,BADCP WAS IT UNKNOWN CP-REQUEST? 00654000 BNE NOTCMS BRANCH IF NOT. 00655000 TM OPTFLAGS,NOIMPCP IS IMPLIED CP ALLOWED? 00656000 BO NOTCP BRANCH IF NOT. 00657000 CLC CMNDLINE(3),=C'CP ' WAS IT EXPLICIT CP-REQUEST? 00658000 BE NOTCP BRANCH IF SO. 00659000 LA R0,CPCMSMSG POINT TO CP/CMS MESSAGE. 00660000 LA R1,LCPCMS GET THE LENGTH. 00661000 B PRINT GO PRINT... 00662000 NOTCP LA R0,CPMSG POINT TO CP MESSAGE 00663000 LA R1,LCP GET THE LENGTH 00664000 B PRINT GO PRINT... 00665000 NOTCMS CH R15,BADMOD LOADMOD ERROR? P3007 00666000 BE INVCMS YES. P3007 00667000 CH R15,BADENV LOADMOD WHEN WRONG ENVIR. ACTIVE? @V305066 00667100 BE ERR5 YES, RETURN CODE = '-5' @V305066 00667200 TM SUBFLAG,X'01' ARE WE IN CMS SUBSET? P3007 00668000 BNO UNKCMS NO. P3007 00669000 CH R15,BADSUB TRYING TO MULTIPLY LOAD USER AREA? P3007 00670000 BE INVSUB OSTENSIBLY. P3007 00671000 UNKCMS LA R0,CMSMSG BAD CMS COMMAND. P3007 00672000 LA R1,LCMS GET THE LENGTH. 00673000 B PRINT GO PRINT... 00674000 INVCMS LA R0,INCMSMSG POINT TO THE MESSAGE. P3007 00675000 LA R1,LINCMS AND THE LENGTH. P3007 00676000 B PRINT GO PRINT P3007 00677000 INVSUB LA R0,INSUBMSG POINT TO THE MESSAGE. P3007 00678000 LA R1,LINSUB AND THE LENGTH. P3007 00679000 B PRINT PRINT IT. P3007 00680000 * 00681000 ERR5 EQU * ERROR DURING EXECUTION OF COMMAND 00682000 CVD R15,ERRNUM CONVERT TO DECIMAL P3047 00683000 MVC RMSGBUF(17),=C'Ready(NUMBR); T=' HRC011DS 00684490 UNPK RMSGBUF+6(5),ERRNUM+5(3) MOVE TO TYPEOUT HRC011DS 00684980 OI RMSGBUF+10,X'F0' FIX UP END CHARACTER TO BE PHRC011DS 00685470 LTR R13,R13 GET RET CODE @VA02241 00686100 BNM PLUSRT POSITIVE RETURN CODE @VA02241 00686200 MVI RMSGBUF+6,C'-' MINUS RETURN CODE HRC011DS 00686590 PLUSRT TM MSGFLAGS,NORDYTIM SHORT FORM? @VA02241 00687000 BO SHORTERR YES, LONG ENOUGH. 00688000 TM SUBFLAG,X'01' IS IT SUBSET? 00689000 BO SHORTERR STILL LONG ENOUGH. 00690000 BAL R13,TIMESUB COMPUTE AND STORE PRINTABLE TIME IN 'T' 00691000 LA R1,14(,R1) INCR BY L' R(NUMBR) HRC011DS 00692490 PRINTX LA R0,RMSGBUF SET FOR ERROR-MESSAGE P3047 00693000 PRINT TM MSGFLAGS,REDERRID RED ERR MSG ALLOWED ? 00694000 BNO TYPBLK NO. 00695000 LA R2,C'R' SET R2 FOR COLOR = RED 00696000 B TYPALL GO TYPE MESSAGE & GET NEXT LINE. 00697000 SPACE 00698000 SHORTERR LA R1,ERROFF USE THE ABBREVIATED LENGTH. 00699000 MVI RMSGBUF+13,X'15' HRC011DS 00700440 B PRINTX NOW DISPLAY THE GOOD NEWS. 00701000 SPACE 2 00702000 * RE-ENTER HERE FROM DMSABN. WE MUST SET UP ALL REGISTERS. 00703000 ENTRY DMSINTAB 00704000 USING *,R15 00705000 DMSINTAB EQU * 00706000 L R12,=A(INIT) SET BASE REGISTER 00707000 DROP R15 00708000 L R7,ASUBSECT P3047 00709000 L R10,AOPSECT POINT TO OPSECT 00710000 L R11,AFVS POINT TO FVSECT 00711000 LA R4,TYPCMS DON'T SURPRISE WAITREAD 00712000 LA R13,INLOOPA RETURN FROM WAITREAD 00713000 B WTRD2 00714000 EJECT 00715000 * 00716000 * NEEDED V-CONSTANTS AND PARAMETER-LISTS: 00717000 * 00718000 DS 0F 00719000 HNDILST DC CL8'HNDINT',CL4'PURGE' (12 BYTES ARE ENUF) 00720000 KEEP EQU X'08' KEEP-BIT IN IONTABL ENTRY FLAG-BYTE 00721000 * 00722000 RDYOFF EQU 7 LGTH OF SHORT FORM MSG HRC011DS 00723390 ERROFF EQU 14 LGTH OF SHORT ERROR MSG HRC011DS 00723680 PURGESYS EQU 8 @V305066 00724110 H8 DC H'08' 00725000 SPACE 00726000 LTORG 00727000 * 00728000 * INIT ERROR MESSAGES 00729000 * 00730000 CPMSG DC C'Unknown CP command' HRC011DS 00731490 DC X'15' @VA01602 00732100 LCP EQU *-CPMSG 00733000 * 00734000 CMSMSG DC C'Unknown CMS command' HRC011DS 00735490 DC X'15' @VA01602 00736100 LCMS EQU *-CMSMSG 00737000 * 00738000 CPCMSMSG DC C'Unknown CP/CMS command' HRC011DS 00739490 DC X'15' @VA01602 00740100 LCPCMS EQU *-CPCMSMSG 00741000 * 00742000 INCMSMSG DC C'Invalid CMS command' HRC011DS 00743490 DC X'15' @VA01602 00744100 LINCMS EQU *-INCMSMSG P3007 00745000 * 00746000 INSUBMSG DC C'Invalid SUBSET command' HRC011DS 00747490 DC X'15' @VA01602 00748100 LINSUB EQU *-INSUBMSG P3007 00749000 * 00750000 CMS3 DC C'CMS' 00751000 DC X'15' @VA01602 00752100 * 00753100 CMS4 DC C'CMS (DOS ON)',X'15' @V305032 00753200 LCMS4 EQU *-CMS4 @V305032 00753300 * 00753400 CMS5 DC C'CMS Subset',X'15' HRC011DS 00754140 VSRLIST DS 0D CALL LIST FOR DMSVSR @V305106 00754200 DC CL8'DMSVSR' (FOR VSAM CLEANUP) @V305106 00754250 DC 8X'FF' @V305106 00754300 EJECT 00755000 NUCON 00756000 IO 00757000 EXTSECT @VA02474 00757100 FVS 00758000 SYSNAMES , @V305614 00758100 SUBSECT P3047 00759000 IOSECT 00760000 REGEQU 00761000 END 00762000