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 <CL8'(RETURN)'> 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