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