SET TITLE 'DMSSET (CMS) VM/370 - RELEASE 6' 00001000
SPACE 2 00002000
*. 00003000
* MODULE NAME - 00004000
* 00005000
* DMSSET 00006000
* 00007000
* FUNCTION - 00008000
* 00009000
* SET COMMAND. THE USER IS ALLOWED TO CHANGE VARIOUS ASPECTS 00010000
* OF THE SYSTEM DURING HIS TERMINAL SESSION 00011000
* 00012000
* ATTRIBUTES - 00013000
* 00014000
* TRANSIENT, NOT REENTRANT, CALLED VIA SVC 202 00015000
* NOTE: SET MUST BE GENMOD'D WITH THE SYSTEM OPTION 00016000
* 00017000
* ENTRY POINTS - 00018000
* 00019000
* SET - SET COMMAND ENTERED FROM THE TERMINAL 00020000
* 00021000
* ENTRY CONDITIONS - 00022000
* 00023000
* SET - 00024000
* GPR1 = A(PLIST) 00025000
* PLIST = CL8 - CALLED ROUTINE 00026000
* CL8 - FUNCTION 00027000
* 00028000
* OPTIONAL - 00029000
* CL8 - ARGUMENT 1 00030000
* CL8 - ARGUMENT 2 00031000
* CL8 - ARGUMENT 3 00032000
* 00033000
* XL8 - FENCE 00034000
* 00035000
* WHERE - 00036000
* FUNCTION = BLIP, RDYMSG, LDRTBLS, RELPAGE, AUTOREAD, 00037000
* INPUT,OUTPUT,ABBREV,IMPCP,IMPEX,SYSNAME, 00038000
* REDTYPE,PROTECT,DOS,DOSPART,NONSHARE,UPSI 00039000
* ARGUMENT 1 = ON, OFF, 'AA...', 'NN' 00040000
* ARGUMENT 2 = 'XX', 'NN' 00041000
* 00042000
* EXIT CONDITIONS - 00043000
* 00044000
* NORMAL 00045000
* GPR15 = 0 00046000
* 00047000
* ERROR 00048000
* GPR15 MESSAGE 00049000
* 24 DMSSET014E INVALID FUNCTION ... 00050000
* 24 DMSSET026E INVALID PARAMETER ... FOR ... FUNCTION 00051000
* 40 DMSSET031E LOADER TABLES CANNOT BE MODIFIED 00052000
* 24 DMSSET047E NO FUNCTION SPECIFIED 00053000
* 24 DMSSET048E INVALID MODE ... 00054000
* 24 DMSSET050E PARAMETER MISSING AFTER ... 00055000
* 24 DMSSET061E NO TRANSLATION CHARACTER SPECIFIED 00056000
* 24 DMSSET070E INVALID PARAMETER ... 00057000
* 4 DMSSET098W CMS OS SIMULATION NOT AVAILABLE 00058000
* 40 DMSSET099E CMS/DOS ENVIRONMENT NOT ACTIVE 00059000
* 4 DMSSET100W SYSTEM NAME ... NOT AVAILABLE 00060000
* 24 DMSSET142S SAVED SYSTEM NAME ... INVALID 00061000
* 44 DMSSET400S SYSTEM ... DOES NOT EXIST 00062000
* 40 DMSSET401S VM SIZE ... CANNOT EXCEED ... START ADDRESS .. 00063000
* 44/171 DMSSET410S CONTROL PROGRAM ERROR INDICATION ... 00064000
* 32 DMSSET444E VOLUME ... IS NOT A DOS SYSRES 00065000
* 00066000
* CALLS TO OTHER ROUTINES - 00067000
* 00068000
* DMSFRE - STORAGE MANAGEMENT 00069000
* DMSERR - OUTPUT MESSAGES TO THE TERMINAL 00070000
* DMSCPF - PASS COMMAND LINE TO CP 00071000
* 00072000
* EXTERNAL REFERENCES - 00073000
* 00074000
* EXTSECT - STORAGE FOR TIMER INTERRUPT 00075000
* NUCON - NUCLEUS CONSTANTS TABLE 00076000
* 00077000
* TABLES / WORKAREAS - 00078000
* 00079000
* MISCELLANEOUS CONSTANTS 00080000
* 00081000
* REGISTER USAGE - 00082000
* 00083000
* GPR1 = A(PLIST) 00084000
* GPR10 = RETURN CODE UNTIL EXIT 00085000
* GPR12 = BASE REGISTER 00086000
* 00087000
* NOTES - 00088000
* 00089000
* NONE 00090000
* 00091000
* OPERATION - 00092000
* 00093000
* 1. DETERMINE WHICH FUNCTION IS BEING SET. 00094000
* IF NOT IN THE CMS FUNCTION TABLE, PREPARE TO SEND 00095000
* THE COMMAND LINE TO CP. 00096000
* 00097000
* BLIP - 00098000
* 1. IF RUNNING IN BATCH MODE, EXIT. 00099000
* 00100000
* 2. IF A COUNT FIELD IS GIVEN, SAVE THE NUMBER OF CHARACTERS 00101000
* WANTED AS BLIP. 00102000
* 00103000
* 3. IF 'OFF' IS SPECIFIED, STORE X'00' AS BLIP. 00104000
* 00105000
* 4. IF THERE'S A FENCE IN THE 00106000
* PLIST, SET THE DEFAULT BLIP. 00107000
* 00108000
* RDYMSG - 00109000
* 1. IF 'LMSG' SPECIFIED, SET 'NORDYMSG', 'NORDYTIM' 00110000
* IN MSGFLAGS OFF. 00111000
* 00112000
* 2. IF 'SMSG' SPECIFIED, SET 'NORDYMSG' OFF, 'NORDYTIM' ON. 00113000
* 00114000
* LDRTBLS - 00115000
* 1. IF FENCE IS SPECIFIED, SET THE NUMBER OF LOADER 00116000
* TABLES TO THE STANDARD NUMBER OF LOADER TABLES. 00117000
* 00118000
* 2. IF NN IS SPECIFIED, SET THE NUMBER OF LOADER TABLES TO NN 00119000
* PROVIDED THE USER HAS ENOUGH CORE. 00120000
* 00121000
* RELPAGE - 00122000
* 1. IF 'ON' SPECIFIED, SET 'NOPAGREL' IN OPTFLAGS OFF. 00123000
* 00124000
* 2. IF 'OFF', SET FLAG SO USER PAGES ARE NOT RELEASED. 00125000
* 00126000
* AUTOREAD - 00127000
* 1. CAUSE A CONSOLE READ TO BE ISSUED AFTER COMMAND EXECUTION. 00128000
* 00129000
* 2. NO CONSOLE READ IS ISSUED AFTER COMMAND EXECUTION. 00130000
* 00131000
* INPUT - 00132000
* 1. IF FENCE IS NOT SPECIFIED, CONVERT HEX CHARACTER 00133000
* TO BINARY. 00134000
* 00135000
* 2. IS THERE A USER INPUT TRANSLATE TABLE ALREADY INUSE? 00136000
* NO, CALL DMSFRE FOR SPACE AND MOVE IN THE STANDARD TRANS- 00137000
* LATE TABLE INTO IT. CONTINUE. 00138000
* YES, STORE THE HEX NO. IN THE TABLE INDEXED BY THE 00139000
* CHARACTER. 00140000
* 00141000
* 3. IF NO CHARACTER WAS SPECIFIED, CALL DMSFRE TO 00142000
* RETURN THE TRANSLATE TABLE SPACE. 00143000
* 00144000
* OUTPUT - 00145000
* 1. IF FENCE IS NOT SPECIFIED, CONVERT HEX CHARACTER 00146000
* TO BINARY. 00147000
* 00148000
* 2. IF THERE IS NOT A TABLE INUSE, CALL DMSFRE TO GET SPACE, 00149000
* AND MOVE IN THE STANDARD TABLE. STORE THE HEX NO. IN 00150000
* TABLE INDEXED BY CHAR. 00151000
* 00152000
* 3. IF THE USER SET UP TABLE MATCHES THE STANDARD TABLE OR 00153000
* IF THE USER SPECIFIED NO CHARACTER, CALL 00154000
* DMSFRE TO RETURN 00155000
* THE SPACE FOR THE TRANSLATE TABLE. 00156000
* 00157000
* ABBREV - 00158000
* 1. IF 'ON' IS SPECIFIED, SET 'ABRVFLG' ON SO THAT 00159000
* ABBREVIATION CHECKING IS NOT INHIBITED. 00160000
* 00161000
* 2. IF 'OFF' IS SPECIFIED, SET 'ABRVFLG' OFF SO THAT 00162000
* ABBREVIATION CHECKING IS INHIBITED. 00163000
* 00164000
* DOS - 00165000
* 1. IF 'ON' SPECIFIED, AND IF DISK MODE IS SPECIFIED, 00166000
* VERIFY THAT THE MODE POINTS TO AN ACCESSED DOS-DISK. 00167000
* ALSO VERIFY THAT THE DOS DISK IS A VALID SYSRES. 00168000
* ENSURE THAT THE CMS/DOS SEGMENT EXISTS AND IF SO, 00169000
* LOAD IT. THEN SET THE DOSMODE AND DOSSVC FLAGS IN 00170000
* NUCON, AND ASSGN SYSLOG TO THE TERMINAL. 00171000
* 00172000
* 2. IF 'OFF' SPECIFIED, RESET FLAGS IN NUCON TO ZERO. 00173000
* ALSO UNASSIGN ALL LOGICAL UNITS, AND PURGE THE 00174000
* CMS/DOS SEGMENT. 00175000
* 00176000
* UPSI - 00177000
* 1. IF 'ON' IMPLIED, SET THE UPSI BYTE IN THE DOS COMM. 00178000
* REGION TO THE CORRESPONDING USER SPECIFIED BITS. 00179000
* 00180000
* 2. IF 'OFF' SPECIFIED, RESET THE UPSI BYTE TO BINARY ZEROS. 00181000
* 00182000
* IMPCP - 00183000
* 1. IF 'ON' IS SPECIFIED, SET NOIMPCP IN OPTFLAGS, OFF. 00184000
* 00185000
* 2. IF 'OFF' IS SPECIFIED, SET NOIMPCP IN OPTFLAGS ON. 00186000
* 00187000
* IMPEX - 00188000
* 1. IF 'ON' IS SPECIFIED, SET 'NOIMPEX' IN OPTFLAGS OFF. 00189000
* 00190000
* 2. IF 'OFF' IS SPECIFIED, SET NOIMPEX IN OPTFLAGS ON. 00191000
* 00192000
* SYSNAME - 00193000
* 1. REPLACE A SAVED SYSTEM NAME IN THE SAVENAMES 00194000
* NUCLEUS TABLE. 00195000
* 00196000
* REDTYPE - 00197000
* 1. IF 'ON' OR FENCE IS SPECIFIED, SET REDERRID IN MSGFLAGS ON 00198000
* 00199000
* 2. IF 'OFF' IS SPECIFIED, SET REDERRID IN MSGFLAGS OFF. 00200000
* 00201000
* PROTECT - 00202000
* 1. IF 'ON' IS SPECIFIED, SET 'PRFPOFF' IN PROTFLAG OFF. 00203000
* SET THE STORAGE KEYS ACCORDING TO THE FREETAB TABLE. 00204000
* USERKEY IF USERCODE, TRNCODE, OR USARCODE. 00205000
* NUCKEY IF NUCCODE OR SYSCODE. 00206000
* 00207000
* 2. IF 'OFF' IS SPECIFIED, SET 'PRFPOFF' IN PROTFLAG ON. 00208000
* SET ALL STORAGE KEYS TO NUCKEY. 00209000
SPACE 1 00210000
* NONSHARE - 00211000
* 1. PERFORM THE CP LOADSYS FUNCTION SPECIFYING THAT 00212000
* THE SYSTEM IS TO BE LOADED AS A NON-SHARED SYSTEM. 00213000
* 00214000
* DOSPART - 00215000
* 1. USE THE NN VALUE SPECIFIED TO SET THE DOS PARTITION 00216000
* SIZE IN K-BYTES. 00217000
* 00218000
* DOSLNCNT - 00219000
* 1. USE THE NN VALUE TO CONTROL THE SYSLST LINES PER 00220000
* PAGE. 00221000
* 00222000
*. 00223000
EJECT 00224000
DMSSET START 0 @V305014 00225000
SET EQU * @V305014 00226000
* 00227000
USING NUCON,R0 @V305114 00228000
USING DMSSET,R12 ADDRESSABILITY FOR ALL @V305014 00229000
USING DMSSET+4096,R11 .... @V305014 00230000
LA R2,4095 .... @V305014 00231000
LA R11,1(R12,R2) .... @V305014 00232000
ST R14,CMSAVE14 SAVE R14 (FOR EVERYBODY) 00233000
USING NUCON,R0 REFERENCE NUCON 00234000
LA R2,8(,R1) POINT TO THE SET FUNCTION 00235000
SR R10,R10 RETURN CODE FOR SUCCESSFUL COMPLETION 00236000
LA R3,8(,R2) ADVANCE POINTER TO ARGUMENT @VA04696 00237000
LM R5,R7,LISTLOOP LOAD LOOP CONTROL REGISTERS @VA04696 00238000
TM BATFLAGS,BATRUN+BATNOEX CMSBATCH RUNNING? V0742 00239000
BC 11,NOTBAT SKIP IF NOT RUNNG OR INITIALIZNG JOBV0742 00240000
LA R5,BATCOM POINT TO BATCH ONLY LIST @VA05126 00241000
NOTBAT EQU * V0742 00242000
* 00243000
FINDCOM EQU * FIND THE SET FUNCTION SPECIFIED 00244000
CLC 0(8,R2),0(R5) DOES ARGUMENT MATCH TABLE ENTRY? @VA04696 00245000
BE 8(,R5) IF SO, R5+8 POINTS TO ROUTINE @VA04696 00246000
BXLE R5,R6,FINDCOM ADVANCE SEARCH THROUGH LIST @VA04696 00247000
* 00248000
TM BATFLAGS,BATRUN+BATNOEX BATCH RUNNING ? @V305014 00249000
BC 11,CPFUNC BR, IF NOT OR INITIALIZING JOB @V305014 00250000
OI BATFLAG2,BATDCMS TELL BATCH WHO'S CALLING @V305014 00251000
L R14,CMSAVE14 SO BATCH RETURNS TO CMS @V305014 00252000
L R15,ABATABND ENTER BATCH AT 'ABEND' POINT @V305014 00253000
BR R15 AND DON'T COME BACK @V305014 00254000
CPFUNC EQU * 00255000
TM OPTFLAGS,NOIMPCP IMPLIED EXEC OFF ? 00256000
BO ERROR014 YES, SIGNAL FUNCTION INVALID 00257000
LA R10,3 PRETEND SVCINT DIDN'T FIND @VA01997 00258000
LNR R10,R10 US, HAVE INT CALL CP @VA01997 00259000
OI MISFLAGS,NEGITS SET FLAG FOR INT TO CALL CP @VA02241 00260000
B EXIT RETURN TO CALLER 00261000
SPACE 2 00262000
FIRSTCOM DS 0F PRECEDES FIRST SET FLAVOR: 00263000
* 00264000
DC CL8'ABEND' ABEND HRC009DS 00264300
B ABEND HRC009DS 00264600
DC CL8'BLIP' BLIP 00265000
B BLIP 00266000
DC CL8'EMSG' EMSG V0019 00267000
B EMSG V0019 00268000
DC CL8'E' V0019 00269000
B EMSG V0019 00270000
DC CL8'IMPCP' IMPCP 00271000
B IMPCP 00272000
DC CL8'INPUT' INPUT 00273000
B HIN 00274000
DC CL8'OUTPUT' OUTPUT 00275000
B HOUT 00276000
DC CL8'AUTOREAD' @V200714 00277000
B AUTRDRTN @V200714 00278000
DC CL8'REDTYPE' REDTYPE 00279000
B HRED 00280000
DC CL8'RELPAGE' RELPAGE 00281000
B RELPAG 00282000
DC CL8'PROTECT' PROTECT 00283000
B PROTECT 00284000
BATCOM DC CL8'ABBREV' ABBREV @V305014 00285000
B ABBREV @V305014 00286000
DC CL8'DOS' DOS @V305014 00287000
B DOS @V305014 00288000
DC CL8'DOSLNCNT' DOS LINE COUNT @V505098 00289000
B LINECT @V505098 00290000
DC CL8'DOSPART' DOSPART @VA04299 00291000
B DOSPART @VA04299 00292000
DC CL8'IMPEX' IMPEX @V305014 00293000
B HIMPEX @V305014 00294000
DC CL8'LDRTBLS' LDRTBLS @V305014 00295000
B LDRTBLS @V305014 00296000
DC CL8'NONSHARE' NONSHARE @V305014 00297000
B NONSHARE @V305014 00298000
DC CL8'RDYMSG' RDYMSG @V305014 00299000
B READY @V305014 00300000
DC CL8'SYSNAME' SAVEDSYS @V305114 00301000
B SAVNAME @V305114 00302000
DC CL8'UPSI' UPSI @V305014 00303000
B UPSISET @V305014 00304000
FENCE DC 8X'FF' FENCE 00305000
B ERROR047 NO FUNCTION SPECIFIED 00306000
AFTRLAST EQU *-12 POINT TO LAST SET FUNCTION FOR BXLE LOOP 00307000
EJECT 00308000
* 00309000
* SET ABBREV ON|OFF 00310000
* 00311000
ABBREV EQU * SET ABBREVIATION FLAG 00312000
CLI 0(R3),X'FF' DOES ARGUMENT FOLLOW FUNCTION? @VA04696 00313000
BE ERROR050 ERROR, IF NOT @VA04696 00314000
CLI 8(R3),X'FF' FENCE ? 00315000
BNE ERROR070 NO, UNEXPECTED PARAMETER 00316000
CLC OFF,0(R3) OFF SPECIFIED 00317000
BNE ABRVON NO 00318000
OI OPTFLAGS,NOABBREV SET ABBREV CHECKING OFF 00319000
B SR1515 EXIT TO CALLER 00320000
ABRVON EQU * ABBREVIATION CHECKING WANTED ? 00321000
CLC ON,0(R3) ON SPECIFIED 00322000
BNE CHARBAD NO, INVALID ARGUMENT 00323000
NI OPTFLAGS,255-NOABBREV SET ABBREV CHECKING ON 00324000
B SR1515 RETURN TO CALLER 00325000
EJECT 00326000
* 00327000
* SET EMSG ON|OFF|CODE|TEXT 00328000
* SET 'UPTMID' IN UPT FOR TSO USER BEFORE PASSING TO CP 00329000
* 00330000
EMSG EQU * V0019 00331000
CLI 08(R2),X'FF' DID USER SUPPLY AN ARGUMENT V0019 00332000
BE CPFUNC NO, LET CP HANDLE THE ERROR V0019 00333000
TSOGET GET POINTER TO TSOBLKS V0019 00334000
USING TSOBLKS,R1 SET UP ADDRESSIBILITY V0019 00335000
CLC ON,08(R2) USER SPECIFY 'ON' V0019 00336000
BE UPTMIDON YES, SET THE FLAG ON V0019 00337000
CLC OFF,08(R2) USER SPECIFY 'OFF' V0019 00338000
BE UPTMIDOF YES, SET THE FLAG OFF V0019 00339000
CLC CODE,08(R2) USER SPECIFY 'CODE' V0019 00340000
BE UPTMIDON YES, SET THE FLAG ON V0019 00341000
CLC TEXT,08(R2) USER SPECIFY 'TEXT' V0019 00342000
BE UPTMIDOF YES, SET THE FLAG OFF V0019 00343000
B CPFUNC LET CP HANDLE UNKNOWN ARGUMENT V0019 00344000
SPACE 1 00345000
UPTMIDON EQU * SET UPTMIDON ON V0019 00346000
OI UPTSWS,UPTMID PRINT IDENTIFIERS WANTED V0019 00347000
B CPFUNC PASS COMMAND LINE TO CP V0019 00348000
SPACE 1 00349000
UPTMIDOF EQU * SET UPTMIDON OFF V0019 00350000
NI UPTSWS,255-UPTMID PRINT IDENTIFIERS NOT WANTED V0019 00351000
B CPFUNC PASS COMMAND LINE TO CP V0019 00352000
EJECT 00353000
* 00354000
* SET INPUT : FREES USER INPUT TRANSLATE TABLE IF ANY 00355000
* SET INPUT A XX : SETS 'A' TO HEX CODE 'XX' UPON INPUT 00356000
* 00357000
HIN EQU * 00358000
L R1,AINTRTBL R1 POINTS TO USER-SET-UP TRANSLATE-TABLE 00359000
CLI 0(R3),X'FF' DOES CALLER WANT TO CANCEL TABLE ? 00360000
BE HIN3 BE IF YES. 00361000
CLI 8(R3),X'FF' ONLY ONE PARM GIVEN @VA01036 00362000
BE ERROR061 TYPE OUT ERROR @VA01036 00363000
CLI 16(R3),X'FF' UNEXPECTED PARMS @VA01036 00364000
BNE ERR070A GIVE IT AS AN ERROR @VA01036 00365000
CLI 2(R3),C' ' MAXIMUM PARM LENGTH EXCEEDED @VA01036 00375000
BNE CHARBAD YES, ERROR @VA01036 00376000
CLI 1(R3),C' ' EBCDIC OR HEX INPUT @VA01036 00377000
BNE RESET RESET FROM EBCDIC INPUT @VA01036 00378000
SR R5,R5 00379000
IC R5,8(R2) CHARACTER TRANSLATION TO BE CHANGED 00380000
B HIN2ND TRANSLATE THE SECOND PARM @VA01036 00381000
RESET BAL R14,HEXBIN TRANSLATE THE FIRST PARM @VA01036 00382000
LR R5,R6 SAVE IN INDEX REG @VA01036 00383000
HIN2ND LA R3,8(R3) POINT TO THE SECOND PARM @VA01036 00384000
BAL R14,HEXBIN TRANSLATE IT @VA01036 00385000
CHKTBL EQU * DOES INPUT TABLE EXIST? @VA09121 00385100
LTR R1,R1 DO WE HAVE A TABLE IN USE? @VA09121 00385200
BP HIN2 BRANCH IF YES @VA09121 00385300
LA R0,INTBLEN INDIC. SIZE OF TRANSL.TBL @VA09121 00385400
DMSFREE DWORDS=(0),TYPE=NUCLEUS,ERR=NOSTORE @VA09121 00385500
ST R1,AINTRTBL STORE ITS ADDRESS @VA09121 00385600
MVC 0(256,R1),ITRTABLE MOVE IN STANDARD TR. TBL @VA09121 00385700
MVC 256(256,R1),OTRTABLE ALSO A 1 FOR 1 TABLE @VA09121 00385800
HIN2 EQU * @VA09121 00385900
STC R6,0(R1,R5) STORE HEX NO. IN TABLE INDEXED BY CHAR. 00386000
STC R6,256(R1,R5) STORE ALSO IN 1 FOR 1 TABLE @VA02244 00387000
CLC 0(256,R1),ITRTABLE IS TABLE BACK TO STANDARD 00388000
BNE SR1515 NOT ZERO, EXIT 00389000
CLC 256(256,R1),OTRTABLE CHECK 1 FOR 1 TABLE TOO @VA05384 00390000
BNE SR1515 EXIT, IF NOT THE SAME @VA05384 00391000
HIN3 LTR R1,R1 MAKE SURE TABLE EXISTS, 00392000
BZ SR1515 EXIT 00393000
LA R0,INTBLEN INDICATE SIZE OF TRANS TABLE @VA04696 00394000
DMSFRET DWORDS=(0),LOC=(1) @VA04696 00395000
SR R1,R1 00396000
ST R1,AINTRTBL CLEAR POINTER THERETO 00397000
B SR1515 EXIT 00398000
EJECT 00399000
* 00400000
* SET OUTPUT : FREES USER OUTPUT TRANSLATE TABLE IF ANY 00401000
* SET OUTPUT XX A : TRANSLATE XX TO A UPON OUTPUT 00402000
* 00403000
HOUT EQU * 00404000
L R1,AOUTRTBL R1 POINTS TO USER OUTPUT TABLE 00405000
CLI 0(R3),X'FF' DOES CALLER WANT TO CANCEL TABLE ? 00406000
BE HOUT3 BE IF YES. 00407000
CLI ARGLEN(R3),FF OUTPUT CHAR SPECIFIED? @VA08706 00407100
BE ERROR061 NO, ERROR @VA08706 00407200
BAL R14,HEXBIN CONVERT HEX CHAR. TO BINARY, IN R6 00408000
SR R5,R5 ZERO R5 00416000
GETCHAR EQU * INSERT THE USER'S TRANSLATION 00419000
LA R3,8(,R3) POINT TO NEXT PARAMETER 00420000
CLI 8(R3),X'FF' FENCE ? 00421000
BNE ERROR070 NO, UNEXPECTED PARAMETER 00422000
CLI 1(R3),C' ' USER SPECIFIED MORE THAN 1 CHAR. 00423000
BNE CHARBAD YES, SIGNAL ERROR 00424000
IC R5,0(R3) INSERT THE TRANSLATE CHAR. 00425000
STC EQU * INSERT THE CHARACTER IN THE TRANSLATE TAB 00426000
LTR R1,R1 DO WE HAVE A TABLE IN USE? @VA09121 00426100
BP HOUT2 BRANCH IF YES @VA09121 00426200
LA R0,OUTBLEN INDIC. SIZE OF TRANSL.TBL @VA09121 00426300
DMSFREE DWORDS=(0),TYPE=NUCLEUS,ERR=NOSTORE @VA09121 00426400
ST R1,AOUTRTBL STORE ITS ADDRESS @VA09121 00426500
MVC 0(256,R1),OTRTABLE MOVE IN STANDARD TR. TBL @VA09121 00426600
HOUT2 EQU * @VA09121 00426700
STC R5,0(R1,R6) STORE THE TRANSLATE CHARACTER 00427000
CLC 0(256,R1),OTRTABLE IS THE TABLE BACK TO STANDARD ? 00428000
BNE SR1515 BNE IF NOT (WE'RE DONE) 00429000
HOUT3 LTR R1,R1 MAKE SURE TABLE EXISTS, 00430000
BZ SR1515 (EXIT IT NOT) 00431000
LA R0,OUTBLEN INDICATE SIZE OF TRANS TABLE @VA04696 00432000
DMSFRET DWORDS=(0),LOC=(1) @VA04696 00433000
SR R15,R15 00434000
ST R15,AOUTRTBL CLEAR POINTER THERETO 00435000
B EXIT THAT'S IT, FINISHED. 00436000
* 00437000
HEXBIN EQU * 00438000
CLI 2(R3),C' ' YUSER SPECIFIED MORE THAN 2 CHAR. 00439000
BNE CHARBAD YES, SIGNAL ERROR 00440000
LR R7,R3 POINT TO CHARACTER TO BE CONVERTED 00441000
LA R9,2 CHECK TWO CHARACTERS 00442000
SR R8,R8 CLEAR R8, 00443000
HEXCHK LR R6,R8 'REMEMBER' R8 IN R6, 00444000
IC R8,0(R7) GET HEX BYTE 00445000
CLI 0(R7),C'A' CHAR. A TO F ? 00446000
BL LESSA BL IF LESS THAN UPPER-CASE "A". 00447000
CLI 0(R7),C'F' ... 00448000
BH CHEK09 IF > F, CHECK FOR 0-9. 00449000
SH R8,ATO10 CONVERT A-F TO 10-15. 00450000
B LA717 AND GO CHECK NEXT CHARACTER. 00451000
* 00452000
LESSA CLI 0(R7),X'81' MAYBE LOWER CASE "A" TO "F" ? 00453000
BL CHARBAD ERROR IF < A 00454000
CLI 0(R7),X'86' ... 00455000
BH CHARBAD ERROR IF > F 00456000
SH R8,LAT10 CONVERT LOWER-CASE A-F TO 10-15. 00457000
B LA717 AND GO CHECK NEXT CHARACTER. 00458000
* 00459000
CHEK09 CLI 0(R7),C'9' ... 00460000
BH CHARBAD ERROR IF > 9. 00461000
SH R8,HC0 SUBTRACT ALPHAMERIC 0 00462000
BM CHARBAD ERROR IF LESS '0'. 00463000
LA717 LA R7,1(,R7) SET TO CHECK NEXT CHARACTER 00464000
BCT R9,HEXCHK AND CHECK IT. 00465000
SLL R6,4 FIRST CHARACTER LEFT FOUR BITS, 00466000
OR R6,R8 'OR' IN SECOND CHARACTER. 00467000
BR R14 EXIT TO CALLER. 00468000
EJECT , HRC009DS 00468020
* HRC009DS 00468040
* SET ABEND COMMAND LINE HRC009DS 00468060
* HRC009DS 00468080
ABEND EQU * HRC009DS 00468100
L R1,ABNCOMND ADDR ABEND COMMAND HRC009DS 00468120
LTR R1,R1 ANY THERE? HRC009DS 00468140
BNP CHKRES NO, SKIP FRET CALL HRC009DS 00468160
LA R0,17 ALWAYS 16 DWORDS HRC009DS 00468180
DMSFRET LOC=(1),DWORDS=(0) HRC009DS 00468200
ST R15,ABNCOMND ZERO OUT BUFFER HRC009DS 00468220
CHKRES CLI 0(R3),X'FF' REQUEST TO RESET? HRC009DS 00468240
BE SR1515 DONE THAT ALREADY HRC009DS 00468260
LA R0,17 GET A BUFFER HRC009DS 00468280
DMSFREE DWORDS=(0),ERR=NOSTORE HRC009DS 00468300
ST R1,ABNCOMND SAVE ADDRESS HRC009DS 00468320
MVI 0(R1),C' ' TO BLANK BUFFER HRC009DS 00468340
MVC 1(135,R1),0(R1) BLANK REST OF IT HRC009DS 00468360
LA R10,14 LOOP COUNT HRC009DS 00468380
LA R1,1(,R1) LENGTH GOES IN FIRST BYTE HRC009DS 00468400
ABNLOOP CLI 0(R3),X'FF' LAST PARM? HRC009DS 00468420
BE LOOPND YES HRC009DS 00468440
MVC 0(8,R1),0(R3) MOVE IN PARM HRC009DS 00468460
MVI 8(R1),C' ' SEPERATE PARMS HRC009DS 00468480
LA R3,8(,R3) NEXT PARM IN SET PLIST HRC009DS 00468500
LA R1,9(,R1) NEXT POSITION IN BUFFER HRC009DS 00468520
BCT R10,ABNLOOP GET SOME MORE HRC009DS 00468540
LOOPND BCTR R1,0 NO BLANK AFTER LAST PARM HRC009DS 00468560
L R3,ABNCOMND START OF BUFFER HRC009DS 00468580
SR R1,R3 GET LENGTH OF COMMAND HRC009DS 00468600
BCTR R1,0 MINUS ONE FOR LENGTH BYTE HRC009DS 00468620
STC R1,0(R3) SAVE LENGTH IN FIRST BYTE HRC009DS 00468640
B SR1515 RETURN HRC009DS 00468660
EJECT 00469000
* 00470000
* SET AUTOREAD ON|OFF 00471000
* 00472000
AUTRDRTN EQU * @VA04696 00473000
CLI 0(R3),X'FF' DOES ARGUMENT FOLLOW FUNCTION? @VA04696 00474000
BE ERROR050 ERROR, IF NOT @VA04696 00475000
CLI 8(R3),X'FF' FENCE AFTER THIS ? @V200714 00476000
BNE ERROR070 NO..UNEXPECTED PARAMETER @V200714 00477000
CLC ON,0(R3) ON WANTED ? @V200714 00478000
BE AUTRDON YES..BR @V200714 00479000
CLC OFF,0(R3) OFF WANTED @V200714 00480000
BE AUTRDOFF YES..BR @V200714 00481000
B CHARBAD ERROR IF NEITHER @V200714 00482000
AUTRDON NI OPTFLAGS,255-NOVMREAD SET FLAG OFF @V200714 00483000
B SR1515 @V200714 00484000
AUTRDOFF OI OPTFLAGS,X'04' SET NUC FLAG ON @V200714 00485000
B SR1515 @V200714 00486000
EJECT 00487000
* 00488000
* SET RDYMSG LMSG|SMSG 00489000
* 00490000
READY EQU * 00491000
CLI 0(R3),X'FF' DOES ARGUMENT FOLLOW FUNCTION? @VA04696 00492000
BE ERROR050 ERROR, IF NOT @VA04696 00493000
CLI 8(R3),X'FF' FENCE ? 00494000
BNE ERROR070 NO, UNEXPECTED PARAMETER 00495000
CLC LMSG,0(R3) LMSG SPECIFIED 00496000
BE READYON YES. 00497000
CLC SMSG,0(R3) SMSG SPECIFIED 00498000
BE READYSHR YES. 00499000
B CHARBAD INVALID ARGUMENT 00500000
READYON EQU * LONG READY MESSAGE WANTED 00501000
NI MSGFLAGS,255-NORDYMSG+NORDYTIM SET THE SWITCH 00502000
B SR1515 EXIT 00503000
READYSHR EQU * SHORT READY MESSAGE WANTED 00504000
OI MSGFLAGS,NORDYTIM SET CONCISE FLAG 00505000
NI MSGFLAGS,255-NORDYMSG SET SWITCH 00506000
B SR1515 EXIT 00507000
EJECT 00508000
* 00509000
* SET RELPAGE ON|OFF 00510000
* SET FOR RELEASING USER PAGES 'ON' OR 'OFF' 00511000
* 'ON' .... RELEASE USER PAGES.... 00512000
* 'OFF' ... DO NOT RELEASE USER PAGES.... 00513000
* 00514000
RELPAG DS 0H 00515000
CLI 0(R3),X'FF' DOES ARGUMENT FOLLOW FUNCTION? @VA04696 00516000
BE ERROR050 ERROR, IF NOT @VA04696 00517000
CLI 8(R3),X'FF' FENCE ? 00518000
BNE ERROR070 NO, UNEXPECTED PARAMETER 00519000
CLC ON,0(R3) ON SPECIFIED 00520000
BE RLPON YES, TRANSFER TO RLPON. 00521000
CLC OFF,0(R3) OFF SPECIFIED 00522000
BE RLPOFF YES, TRANSFER TO RLPOFF 00523000
B CHARBAD INVALID ARGUMENT 00524000
RLPON EQU * 00525000
NI OPTFLAGS,255-NOPAGREL TURN FLAG OFF FOR RELEASE 00526000
B SR1515 GO EXIT.. 00527000
* 00528000
RLPOFF EQU * 00529000
OI OPTFLAGS,NOPAGREL SET FLAG FOR NO RELEASE. 00530000
B SR1515 GO EXIT.. 00531000
EJECT 00532000
* 00533000
* SET IMPEX ON|OFF 00534000
* SET FOR 'IMPLIED EXEC' "ON" OR "OFF" 00535000
* 00536000
* 'IMPEX ON' --> "IMPLIED EXEC" (FROM TERMINAL) IS WANTED 00537000
* (NOTE - DEFAULT VALUE FOR CMS) 00538000
* 00539000
* 'IMPEX OFF' --> "IMPLIED EXEC" (FROM TERMINAL) NOT WANTED 00540000
* (NEW OPTION FOR USERS WHO PREFER TO 00541000
* TYPE IN "EXEC" ON PURPOSE IF THEY WANT IT.) 00542000
* 00543000
HIMPEX EQU * 00544000
CLI 0(R3),X'FF' DOES ARGUMENT FOLLOW FUNCTION? @VA04696 00545000
BE ERROR050 ERROR, IF NOT @VA04696 00546000
CLI 8(R3),X'FF' FENCE ? 00547000
BNE ERROR070 NO, UNEXPECTED PARAMETER 00548000
CLC ON,0(R3) ON SPECIFIED 00549000
BE XON TRF IF YES. 00550000
CLC OFF,0(R3) OFF SPECIFIED 00551000
BE XOFF TRF IF YES. 00552000
B CHARBAD INVALID ARGUMENT 00553000
XON NI OPTFLAGS,255-NOIMPEX IF 'ON' WANTED, RESET 00554000
B SR1515 FLAG-BIT. 00555000
* 00556000
XOFF OI OPTFLAGS,NOIMPEX IF 'OFF' WANTED, 00557000
B SR1515 SET THE FLAG-BIT. 00558000
EJECT 00559000
* 00560000
* SET IMPCP ON|OFF 00561000
* 00562000
IMPCP EQU * 00563000
CLI 0(R3),X'FF' DOES ARGUMENT FOLLOW FUNCTION? @VA04696 00564000
BE ERROR050 ERROR, IF NOT @VA04696 00565000
CLI 8(R3),X'FF' FENCE ? 00566000
BNE ERROR070 NO, UNEXPECTED PARAMETER 00567000
CLC ON,0(R3) ON SPECIFIED 00568000
BE IMPCPON YES 00569000
CLC OFF,0(R3) OFF SPECIFIED 00570000
BE IMPCPOFF YES 00571000
B CHARBAD INVALID ARGUMENT 00572000
IMPCPON EQU * 00573000
NI OPTFLAGS,255-NOIMPCP RESET THE FLAG 00574000
B SR1515 EXIT 00575000
IMPCPOFF EQU * 00576000
OI OPTFLAGS,NOIMPCP SET THE FLAG 00577000
B SR1515 EXIT 00578000
EJECT 00579000
* 00580000
* SET REDTYPE ON|OFF 00581000
* 00582000
HRED EQU * 00583000
CLI 0(R3),X'FF' DOES ARGUMENT FOLLOW FUNCTION? @VA04696 00584000
BE ERROR050 ERROR, IF NOT @VA04696 00585000
CLI 8(R3),X'FF' FENCE ? 00586000
BNE ERROR070 NO, UNEXPECTED PARAMETER 00587000
CLC ON,0(R3) ON SPECIFIED 00588000
BE REDON YES. 00589000
CLC OFF,0(R3) OFF SPECIFIED 00590000
BE REDOFF YES. 00591000
B CHARBAD INVALID CHARACTER 00592000
REDON EQU * 00593000
OI MSGFLAGS,REDERRID PERMIT RED TYPEOUTS 00594000
B SR1515 GO EXIT. 00595000
* 00596000
REDOFF EQU * 00597000
NI MSGFLAGS,255-REDERRID NO NOT PERMIT RED TYPEOUTS 00598000
B SR1515 GO EXIT. 00599000
EJECT 00600000
********************************************************************* 00601000
* 00602000
* SET LDRTBLS : NUMBER OF PAGES OF LDRTBLS = DEFAULT 00603000
* DEFAULT : 2 PAGES FOR VIRTUAL MACHINES OF @VA11938 00603200
* LESS THAN OR EQUAL TO 384K, OR @VA11938 00603400
* 3 PAGES FOR "LARGE MACHINES". @VA11938 00603600
* SET LDRTBLS NNN : NUMBER OF PAGES OF LDRTBLS = 'NNN' 00604000
* 00605000
* 'LDRTBLS NNN' WHERE NNN IS A DECIMAL NUMBER LESS THAN 127 00606000
* AND WHERE THE USER HAS ENOUGH CORE TO HAVE NNN 00607000
* PAGES OF LOADER TABLES, STORES NNN AS THE NEW 00608000
* VALUE OF LDRTBL IN NUCON 00609000
********************************************************************* 00610000
SPACE 2 00611000
LDRTBLS EQU * CHANGE THE NUMBER OF LOADER TABLES 00612000
XC GLDR,GLDR ENSURE LDRTBL FIELD REUSABLE @VA06145 00613000
CLI 0(R3),X'FF' DOES ARGUMENT FOLLOW FUNCTION? @VA04696 00614000
BE DEFAULT DEFAULT NUMBER OF LDRTBLS 00615000
CLI 8(R3),X'FF' FENCE ? 00616000
BNE ERROR070 NO, UNEXPECTED PARAMETER 00617000
LR R4,R3 POINT TO ARGUMENT FOR VALIDATION @VA04696 00618000
B NUMCHECK YES, MAKE SURE NUMBER SPECIFIED 00619000
DEFAULT EQU * DEFAULT NUMBER OF LDRTBLS 00620000
CLC SMALLM,VMSIZE IS MACHINE SIZE GT THAN 384K.? @VA11938 00621000
BL BIGM IF NOT A "LARGE MACHINE" @VA11938 00622000
LA R3,2 THE DEFAULT NUMBER OF LDRTBLS IS 2 00623000
B CONT CONTINUE 00624000
BIGM EQU * FOR MACHINE GT 384K @VA11938 00625000
LA R3,3 THE DEFAULT NUMBER OF LDRTBLS IS 3 00626000
B CONT CONTINUE 00627000
KPGNG CLI 3(R3),X'40' KEEP USER HONEST 00628000
BNE CHARBAD ERROR IF NOT JUST 3 DIG 00629000
CLI 1(R3),X'40' JUST ONE DIGIT ? 00630000
BE GO1 YES, GO 00631000
CLI 2(R3),X'40' JUST TWO DIGITS 00632000
BE GO2 YES, GO2 00633000
MVC GLDR+5(3),0(R3) MOVE 3 CHAR. IN. 00634000
B GO 00635000
GO1 MVC GLDR+7(1),0(R3) MOVE 1 CHAR. IN. 00636000
B GO 00637000
GO2 MVC GLDR+6(2),0(R3) MOVE 2 CHAR. IN 00638000
GO PACK PGLDR,GLDR CONVERT NO. TO BINARY 00639000
CVB R4,PGLDR CONVERT TO BINARY @VA04696 00640000
C R4,O127 127 PAGES IS THE MOST ALLOWED @VA04696 00641000
BH CHARBAD INCORRECT IF > 127 @VA04696 00642000
LR R3,R4 R3 = NUMBER OF LOADER TABLES @VA04988 00643000
SPACE 00644000
CONT SR R5,R5 CLEAR REG. BEFOR COMPUTING 00645000
TM DCSSFLAG,DCSSVTLD WAS SVT LOADED? @VA06166 00646000
BZ CONTA1 BRANCH IF NOT @VA06166 00647000
L R0,OSMODLDW GET DOUBLE WORDS FOR SVT @VA06166 00648000
L R1,AOSMODL AND ADDRESS OF SVT @VA06166 00649000
DMSFRET DWORDS=(0),LOC=(1) FREE SVT @VA06166 00650000
SR R0,R0 CLEAR A REGISTER @VA06166 00651000
ST R0,AOSMODL CLEAR SVT ADDRESS(KEEP DWORDS@VA06166 00652000
CONTA1 EQU * @VA06166 00653000
LR R7,R5 00654000
L R5,VMSIZE GET VMSIZE 00655000
L R9,ADMSFRT DMSFRT ADDRESS @VA08493 00655100
USING FRDSECT,R9 ADDRESSABILITY @VA08493 00655200
C R5,FREELOW1 IPL LOADER TABLES @VA08493 00655300
BE GETTBL NO, TRY DMSFREE @VA08493 00655400
SLR R7,R7 CLEAR FOR INSERT @VA08493 00655500
IC R7,ALDRTBLS GET CURRENT NO. LDR TBLS 00656000
SLL R7,12 TIMES X'1000' GIVE NO. PGS. FOR TBLS 00657000
SR R5,R7 GIVES NEC. LOWEXT OF TBLS 00658000
C R5,FREELOWE MUST EQUAL CURRENT LOW EXTENT 00659000
BNE NOTLOWE NO, TRY DMSFREE @VA08493 00660000
LR R7,R3 COMPUTE SAME FOR DESIRED NO. 00661000
SLL R7,12 OF LDR. TBLS 00662000
SR R8,R8 00663000
L R8,VMSIZE 00664000
SR R8,R7 00665000
C R8,MAINHIGH NO. PGS. NEC MUST BE GREATER 00666000
BNH NOTFRET THAN CURRENT MAINHIGH @VA08493 00667000
C R8,LOCCNT ALSO GREATER THAN LOCCNT 00668000
BNH NOTFRET NO, TRY DMSFREE @VA08493 00669000
SPACE 00670000
CR R8,R5 ANY CHANGE? @VA01282 00671000
BE SVTTEST BRANCH IF NOT @VA06297 00672000
ST R8,FREELOW1 MODIFY ORIGINAL FREELOWE @VA01282 00675000
L R9,AFREETAB LOAD FREETAB TABLE ADDRESS @VA01282 00676000
DROP R9 @VA01282 00677000
BL ADDTBLS BRANCH IF MORE PAGES REQUIRED@VA01282 00678000
LR R6,R5 GET CURRENT LOW EXTENT @VA01282 00679000
LR R7,R8 GET FREE START ADDRESS @VA01282 00680000
SR R7,R5 GET SPACE TO BE FREED @VA01282 00681000
SRL R7,12 CONVERT TO PAGES @VA01282 00682000
LA R14,USERCODE GET USER CODE @VA01282 00683000
LA R4,USERKEY SET TO USER KEY @VA01282 00684000
B SETCODE @VA01282 00685000
ADDTBLS EQU * @VA01282 00686000
LA R14,SYSCODE GET SYSTEM CODE @VA01282 00687000
SR R5,R8 GET BYTES REQUIRED @VA01282 00688000
SRL R5,12 NUMBER OF PAGES NEEDED @VA01282 00689000
LR R7,R5 @VA01282 00690000
LR R5,R8 GET BEGINNING ADDRESS @VA01282 00691000
LA R4,NUCKEY SET TO NUCLEUS KEY @VA01282 00692000
LR R6,R8 BEGINNING ADDRESS OF PAGES @VA01282 00693000
SETCODE EQU * @VA01282 00694000
SRL R6,12 NUMBER OF PAGES @VA01282 00695000
LA R9,0(R6,R9) POINT TO PROPER BYTE @VA01282 00696000
LA R6,2048 2K CONSTANT @VA01282 00697000
SETNUC EQU * @VA01282 00698000
EX R14,MVICODE INDICATE TYPE OF PAGE @VA01282 00699000
SSK R4,R5 SET KEY IN FIRST HALF PAGE @VA01282 00700000
AR R5,R6 ADD 2K TO ADDRESS @VA01282 00701000
SSK R4,R5 SET KEY IN LAST HALF PAGE @VA01282 00702000
AR R5,R6 ADD 2K TO ADDRESS @VA01282 00703000
LA R9,1(,R9) POINT TO NEXT BYTE @VA01282 00704000
BCT R7,SETNUC @VA01282 00705000
STC R3,ALDRTBLS STORE NEW NO. LDR TBL. @VA01282 00707000
ST R8,FREELOWE STORE NEW LOW EXT. @VA01282 00708000
SVTTEST EQU * @VA06297 00709000
TM DCSSFLAG,DCSSVTLD WAS SVT LOADED? @VA06166 00710000
BZ SR1515 BRANCH IF NOT @VA06166 00711000
NI DCSSFLAG,255-DCSSVTLD REMOVE SVT LOADED FLAG @VA06166 00712000
L R0,OSMODLDW GET LENGTH OF SVT MODULE @VA06166 00713000
B LOADFREE AND GO RELOAD IT @VA06166 00714000
GETTBL DS 0H @VA08493 00714100
L R1,ALDRTBLS TOP OF LOADER TABLES @VA08493 00714200
SLR R0,R0 CLEAR FOR INSERT @VA08493 00714300
ICM R0,1,ALDRTBLS CURRENT NUMBER OF LDR PAGES @VA08493 00714400
BZ NOTLOWE SKIP FRET IF ZERO @VA08493 00714500
SLL R0,12 TIMES X'1000' @VA08493 00714600
SR R1,R0 BEGINNING OF CURRENT TABLES @VA08493 00714700
SRL R0,3 DOUBLEWORD LENGTH @VA08493 00714800
DMSFRET DWORDS=(0),LOC=(1) FRET OLD TABLES @VA08493 00714900
NOTLOWE DS 0H @VA08493 00715000
LR R7,R3 REQUESTED NUMBER OF TABLES @VA08493 00715100
SLL R7,12 TIMES X'1000' @VA08493 00715200
NOTFRET DS 0H @VA08493 00715300
L R9,ADMSFRT DMSFRT ADDRESS @VA08493 00715400
USING FRDSECT,R9 ADDRESSABILITY @VA08493 00715500
L R5,VMSIZE TOP OF CMS MACHINE @VA08493 00715600
ST R5,FREELOW1 AVAILABLE TO DMSFREE @VA08493 00715700
DROP R9 @VA08493 00715800
LA R9,SVTTEST DMSFREE OK FOR NEW TABLES @VA08493 00715900
FREEOLD DS 0H ERROR ENTRY @VA08493 00716000
LTR R0,R7 REQUESTED SIZE OF TABLES = 0 @VA08493 00716100
BZ NOTABLE YES, DONT FREE SPACE @VA08493 00716200
SRL R0,3 INTO DOUBLE WORDS @VA08493 00716300
DMSFREE DWORDS=(0),AREA=HIGH,TYPE=NUCLEUS,ERR=NOFREE @VA08493 00716400
AR R7,R1 TOP OF NEW TABLES @VA08493 00716500
LR R5,R7 TOP OF LOADER TABLES @VA08493 00716600
NOTABLE DS 0H @VA08493 00716700
ST R5,ALDRTBLS SAVE FOR LOADER @VA08493 00716800
STC R3,ALDRTBLS SAVE NEW LOADER PAGES @VA08493 00716900
BR R9 SVTTEST OR ERROR @VA08493 00717000
NOFREE DS 0H @VA08493 00717100
SLR R7,R7 CLEAR FOR INSERT @VA08493 00717200
IC R7,ALDRTBLS OLD NUMBER OF TABLES @VA08493 00717300
LR R3,R7 SAVE IT @VA08493 00717400
SLL R7,12 TIMES X'1000' @VA08493 00717500
LA R9,ERROR ERROR 031 EXIT @VA08493 00717600
B FREEOLD DMSFREE OLD TABLES @VA08493 00717700
NUMCHECK DS 0H @VA08493 00717800
CLI 0(R4),X'40' CHECK THAT IT IS @VA08493 00717900
BE KPGNG A VALID DECIMAL NUMBER 00718000
CLI 0(R4),C'0' LESS THAN ZERO? 00719000
BL CHARBAD YES, GET OUT 00720000
CLI 0(R4),C'9' GREATER THAN 9? 00721000
BH CHARBAD YES, GET OUT 00722000
LA R4,1(R4) CHECK NEXT DIGIT 00723000
B NUMCHECK 00724000
MVICODE MVI 0(R9),0 SET FREETAB @VA01282 00725000
EJECT 00726000
* 00727000
* SET BLIP ON : BLIP CHARACTER EQUALS DEFAULT 00728000
* SET BLIP OFF : NO BLIP CHARACTER WANTED 00729000
* SET BLIP AAA.. : BLIP CHARACTER = 'AAA..' 00730000
* SET BLIP AAA... (N) : BLIP CHAR.R = AAA... LIMITED TO 'N' CHARACTE 00731000
* 'ON'|'OFF' MAY NOT BE USED AS A BLIP CHARACTER 00732000
* 00733000
BLIP EQU * BLIP 00734000
L R9,AEXTSECT REFERENCE EXTERNAL INTERRUPT INFO. 00735000
USING EXTSECT,R9 ... 00736000
CLI 0(R3),X'FF' DOES ARGUMENT FOLLOW FUNCTION? @VA04696 00737000
BE ERROR050 ERROR, IF NOT @VA04696 00738000
CLC ON,0(R3) BLIP 'ON' SPECIFIED 00739000
BNE BLIP20 NO, TEST 'OFF' 00740000
CLI 8(R3),X'FF' ANY UNEXPECTED PARAMETERS? @VA04696 00741000
BNE ERROR070 YES, SIGNAL ERROR 00742000
MVC TIMCHAR(8),FENCE SET DEFAULT BLIP CHARACTER 00743000
MVC TIMER(4),TIMINIT INITIALIZE TIMER TO 2 SECS. 00744000
B EXIT RETURN TO CALLER 00745000
BLIP20 EQU * SEE IF 'OFF' SPECIFIED 00746000
CLC OFF,0(R3) BLIP 'OFF' 00747000
BNE BLIP30 NO, MUST BE A BLIP CHAR. 00748000
CLI 8(R3),X'FF' ANY UNEXPECTED PARAMETERS? @VA04696 00749000
BNE ERROR070 SIGNAL ERROR IF SO 00750000
MVI TIMCHAR,00 NO BLIP WANTED INDICATOR 00751000
MVC TIMER(4),LARGEPOS SET TIMER TO LARGE POSITIVE NO. 00752000
B EXIT RETURN TO CALLER 00753000
BLIP30 EQU * USER SPECIFIED BLIP CHARACTERS 00754000
CLI 8(R3),C'(' COUNT CHAR. SUPPLIED 00755000
BE BLIP70 YES, GET USER'S COUNT 00756000
CLI 8(R3),X'FF' END OF PLIST 00757000
BNE ERROR070 NO, UNEXPECTED PARM. ENTERED 00758000
BLIP35 EQU * COUNT THE NUMBER OF BLIP CHARS. P0641 00759000
LA R2,8(,R2) POINT TO BLIP CHARACTERS 00760000
LA R4,1 POINT TO FIRST CHARACTER 00761000
LA R6,1 INCREMENT FOR BXLE LOOP 00762000
LA R7,8 MAX. NUMBER OF CHARACTERS ALLOWED 00763000
BLIP40 EQU * COUNT THE NUMBER OF BLIP CHAR. 00764000
CLI 0(R2),C' ' END OF BLIP CHAR ? 00765000
BE BLIP50 YES, SAVE THE COUNT 00766000
LA R2,1(,R2) POINT TO NEXT CHAR. 00767000
BXLE R4,R6,BLIP40 SEE IF THIS IS THE END 00768000
BLIP50 EQU * STORE THE COUNT 00769000
BCTR R4,0 DECREMENT 1 FOR EXACT COUNT 00770000
STC R4,TIMCCW+7 STORE IN THE CCW STRING 00771000
BLIP60 EQU * SAVE THE BLIP CHARACTER 00772000
MVC TIMCHAR(8),16(R1) MOVE TO EXTSECT 00773000
MVC TIMER(4),TIMINIT INITIALIZE THE TIMER TO 2 SEC. 00774000
B EXIT RETURN TO CALLER 00775000
BLIP70 EQU * CHECK THE COUNT CHAR. 00776000
LA R3,16(,R3) POINT TO THE NUMBER 00777000
CLI 0(R3),X'FF' FENCE ? P0641 00778000
BE BLIP35 YES, COUNT CHARACTERS ENTERED P0641 00779000
CLI 0(R3),C'1' LESS THAN ONE 00780000
BL CHARBAD YES, SIGNAL ERROR 00781000
CLI 0(R3),C'8' HIGHER THAN 8 00782000
BH CHARBAD YES, SIGNAL ERROR 00783000
CLI 1(R3),C' ' ONLY ONE DIGIT LEGAL 00784000
BNE CHARBAD IF NOT, SIGNAL ERROR 00785000
CLI 8(R3),X'FF' TOO HURRIED TO CLOSE PARENTHESIS?@VA04696 00786000
BE BLIP80 OKAY, WE'LL HURRY AS WELL @VA04696 00787000
CLI 8(R3),C')' CLOSING PARENTHESIS? @VA04696 00788000
BNE ERROR070 NOTHING ELSE IS ACCEPTABLE @VA04696 00789000
CLI 16(R3),X'FF' ANY ARGUMENTS REMAINING? @VA04696 00790000
BNE ERR070A CANNOT BE CORRECT, IF THERE ARE @VA04696 00791000
BLIP80 EQU * SAVE THE BLIP COUNT 00792000
MVC TIMCCW+7(1),0(R3) MOVE TO EXTSECT 00793000
NI TIMCCW+7,X'0F' CHANGE TO HEX 00794000
B BLIP60 SAVE THE BLIP CHARACTERS 00795000
DROP R9 00796000
* 00797000
EJECT 00798000
* 00799000
* SET PROTECT ON|OFF 00800000
* 00801000
SPACE 00802000
PROTECT EQU * 00803000
CLI 0(R3),X'FF' DOES ARGUMENT FOLLOW FUNCTION? @VA04696 00804000
BE ERROR050 ERROR, IF NOT @VA04696 00805000
CLI 8(R3),X'FF' FENCE ? 00806000
BNE ERROR070 NO, UNEXPECTED PARAMETER 00807000
CLC ON,0(R3) ON SPECIFIED 00808000
BE PROTCTON YES, SET FLAG ON 00809000
CLC OFF,0(R3) OFF SPECIFIED 00810000
BE PROTCTOF YES, SET FLAG OFF 00811000
B CHARBAD INVALID ARGUMENT 00812000
PROTCTON EQU * SET PROTECT ON 00813000
NI PROTFLAG,255-PRFPOFF TURN PRFPOFF OFF 00814000
B SR1515 EXIT WITHOUT ERROR 00815000
PROTCTOF EQU * SET PROTECT OFF 00816000
OI PROTFLAG,PRFPOFF TURN PRFPOFF ON 00817000
B SR1515 EXIT WITHOUT ERROR 00818000
EJECT 00819000
* 00820000
* SET NONSHARE SYSTEMNAME 00821000
* 00822000
SPACE 1 00823000
NONSHARE EQU * @VA04696 00824000
CLC FENCE,0(R3) BETTER BE THERE @V305014 00825000
BE ERROR050 ERROR IF NOT @V305014 00826000
CLC FENCE,8(R3) NOTHING ALLOWED AFTER SYSTEMNAME @V305014 00827000
BNE ERROR070 ERROR IF SO @V305014 00828000
LR R1,R3 SAVE PTR TO SEGMENT NAME @V305066 00829000
SPACE 1 00830000
LA R4,FINDSYS FINDSYS FOR LOCATION CHECK @V305066 00831000
DC X'83340064' @V305014 00832000
BC 2,DOSERRS BR IF FINDSYS ERROR @V305014 00833000
BAL R5,CHKSEG CHECK WHERE SEGMENT SAVED @V305014 00834000
SPACE 1 00835000
LA R3,8(,R2) RESTORE NAME POINTER @V305014 00836000
LA R4,LOADSYS LOADSYS IN NON-SHARED MODE @V305066 00837000
DC X'83340064' @V305014 00838000
BC 2,DOSERRS BR IF LOADSYS ERROR @V305014 00839000
SPACE 1 00840000
L R6,ASYSNAMS POINT TO SYSNAMES TABLE @V305014 00841000
USING SYSNAMES,R6 ..... @V305014 00842000
CLC CMSSEG(8),0(R1) IS THIS THE CMS SEGMENT ? @V305014 00843000
DROP R6 ..... @V305014 00844000
BNE SR1515 NO, ALL DONE @V305014 00845000
SPACE 1 00846000
TM DCSSFLAG,DCSSVTLD DMSSVT TEXT LOADED @V305614 00847000
BNO NOFRET NO, SKIP DMSFRET @V305614 00848000
L R9,OSMODLDW GET OS SIM. LENGTH @VA05055 00849000
L R1,AOSMODL POINT TO DMSSVT TEXT @V305614 00850000
DMSFRET DWORDS=(0),LOC=(1) @V305614 00851000
NI DCSSFLAG,255-DCSSVTLD NO LONGER LOADED @V305614 00852000
SR R1,R1 @VA05055 00853000
ST R1,AOSMODL CLEAR OS SIMUL. ADDR @VA05055 00854000
SPACE 1 00855000
NOFRET OI DCSSFLAG,DCSSJLNS+DCSSLDED DON'T LET INT PURGE @V305014 00856000
ST R3,ACMSSEG SAVE CMSSEG ADDRESS @V305014 00857000
B SR1515 EXECUTION COMPLETE .. @V305014 00858000
EJECT 00859000
* 00860000
* SET DOS ON|OFF <MODE> (VSAM) 00861000
* 00862000
SPACE 1 00863000
DOS EQU * @VA04696 00864000
CLI 0(R3),FF ANYTHING SPECIFIED ? @V305066 00865000
BE ERROR050 ERROR NO PARMS GIVEN @VA07126 00866000
CLC ON,0(R3) ON SPECIFIED ? @V305001 00867000
BE DOSON YES, BRANCH @V305001 00868000
CLC OFF,0(R3) OFF SPECIFIED ? @V305001 00869000
BE DOSOFF YES, BRANCH @V305001 00870000
B CHARBAD ERROR IF NONE @V305001 00871000
SPACE 1 00872000
DOSON LA R3,8(,R3) POINT TO 2ND. ARG @V305001 00873000
CLI 0(R3),FF ANYTHING ELSE SPECIFIED ? @V305666 00874000
BE DOSCONT NO, CONTINUE BELOW @V305001 00875000
CLI 0(R3),OPAREN OPTION SPECIFIED ? @V305114 00876000
BNE DSKMODE NO, MUST BE MODE @V305114 00877000
SPACE 1 00878000
OPTIN LA R3,8(,R3) YES, POINT TO IT @V305114 00879000
CLC 0(8,R3),VSAM HAS TO BE VSAM @V305114 00880000
BNE CHARBAD IF NOT, ERROR @V305114 00881000
SPACE 1 00882000
LA R3,8(,R3) NEXT TOKEN SHOULD BE @V305114 00883000
CLI 0(R3),FF X'FF' @V305666 00884000
BE VSAMOK OR @V305114 00885000
CLI 0(R3),CPAREN C')' @V305114 00886000
BNE CHARBAD IT'S AN ERROR @V305114 00887000
SPACE 1 00888000
LA R3,8(,R3) NEXT TOKEN @V305114 00889000
CLI 0(R3),FF MUST BE A FENCE @V305666 00890000
BNE CHARBAD ELSE IT'S AN ERROR @V305114 00891000
VSAMOK OI DOSFLAGS,DOSVSAM SET VSAM INDICATOR @V305114 00892000
B DOSCONT CONTINUE ... @V305114 00893000
EJECT 00894000
DSKMODE LR R1,R3 SET UP R1 @V305001 00895000
S R1,=F'24' PREPARE FOR ADTLKP @V305001 00896000
L R15,VCADTLKP GET ADTLKP ADDRESS @VM03093 00897000
BALR R14,R15 GO GET ADT FOR DISK MODE @V305001 00898000
LTR R15,R15 ANY ERRORS ? @V305001 00899000
BNZ CHARBAD YES, BRANCH @V305001 00900000
USING ADTSECT,R1 @V305001 00901000
TM ADTFLG2,ADTFDOS IS DISK DOS FORMATTED ? @V305001 00902000
BZ ERROR048 NO, ERROR @V305001 00903000
LA R4,MODETAB GET MODE/PUB TABLE @V305001 00904000
LA R5,EMODTAB GET NUMBER TABLE ENTRIES @V305001 00905000
MODECHK CLC ADTM(1),0(R4) MODE LETTER MATCH ? @V305001 00906000
BE VERRES YES,FOUND AND OK @VA04692 00907000
LA R4,2(,R4) BUMP TO NEXT ENTRY @V305001 00908000
BCT R5,MODECHK KEEP LOOKING.... @V305001 00909000
B ERROR048 ERROR IF HERE @V305001 00910000
* CHECK THAT DOS DISK IS A VALID SYSRES 00911000
* READ THE LABEL INFORMATION CYLINDER 00912000
VERRES EQU * @VA04692 00913000
L R5,ADTDTA GET DEVICE TABLE ADDRESS @VA04692 00914000
LH R9,0(R5) GET CUU @VA04692 00915000
LA R0,LICCW POINT TO CHANNEL PROGRAM @VA04692 00916000
DC X'83900020' DIAG FOR DISK I/O @VA04692 00917000
CLC NIDOS,SETBUFA MUST CONTAIN '$$A$IPL2' @VA04692 00918000
BNE ERROR444 NOT SYSRES @VA04692 00919000
IC R4,1(,R4) GET PUB INDEX FOR THIS MODE @VA04692 00920000
L R5,ABGCOM GET BGCOM ADDRESS @V305001 00921000
USING BGCOM,R5 @V305001 00922000
LH R6,LUBPT GET LUB TABLE POINTER @V305001 00923000
LA R6,12(,R6) BUMP TO SYSRES LUB @V305001 00924000
STC R4,0(,R6) SET PUB INDEX INTO LUB @V305001 00925000
N R4,=X'000000FF' ISOLATE LAST BYTE @V305001 00926000
SLL R4,3 MULTIPLY INDEX BY 8 @V305001 00927000
AH R4,PUBPT ADD INDEX TO PUB POINTER @V305001 00928000
MVC 3(1,R4),ADTM MOVE DISK MODE TO PUB @V305001 00929000
L R5,ADTDTA GET DEVICE TABLE ADDRESS @V305001 00930000
MVC 0(2,R4),0(R5) MOVE CUU TO PUB @V305001 00931000
MVI 4(R4),DOS2314 SET DASD 2314 TYPE IN PUB @V305066 00932000
CLI 3(R5),CMS2314 IS IT 2314 ? @V305066 00933000
BE CHKOPT CHECK FOR OPTION @V305114 00934000
MVI 4(R4),DOS3330 SET DASD 3330 TYPE IN PUB @V305066 00935000
CLI 3(R5),CMS3330 IS IT 3330 ? @V305066 00936000
BE CHKOPT CHECK FOR OPTION @V305114 00937000
MVI 4(R4),DOS333B SET DASD TYPE IN PUB 00938000
CLI 3(R5),CMS3330 IS IT A 3330-11 ? 00939000
BE CHKOPT CHECK FOR OPTION 00940000
MVI 4(R4),DOS3350 SET DASD TYPE IN PUB 00941000
CLI 3(R5),CMS3350 IS IT AS 3350 ? 00942000
BE CHKOPT CHECK FOR OPTION 00943000
MVI 4(R4),DOS3340 MUST BE 3340 TYPE THEN... @V305066 00944000
CHKOPT LA R3,8(,R3) BUMP COMMAND LINE POINTER @V305114 00945000
CLI 0(R3),FF ANY OPTIONS ? @V305666 00946000
BE DOSCONT NO, GET ON WITH IT @V305114 00947000
CLI 0(R3),OPAREN HAS TO BE OPEN PAREN @V305114 00948000
BNE CHARBAD ELSE, NO GOOD @V305114 00949000
B OPTIN GO CHECK OUT OPTION @V305114 00950000
EJECT 00951000
DOSCONT EQU * @V305014 00952000
USING SYSNAMES,R4 @V305014 00953000
L R4,ASYSNAMS POINT TO SAVED NAME TABLE @V305014 00954000
LA R3,CMSDOS POINT TO CMSDOS ENTRY @V305014 00955000
LR R1,R3 JUST IN CASE ERRORS @V305001 00956000
LA R4,FINDSYS GET FINDSYS CODE @V305066 00957000
DC X'83340064' ISSUE FINDSYS DIAGNOSE @V305001 00958000
BZ LOADED BRANCH IF SEG. ALREADY ACTIVE @V305001 00959000
BM LOADIT BRANCH IF SEG. TO BE LOADED @V305001 00960000
DOSERRS CH R4,=H'44' R.C. = 44 ? @V305001 00961000
BE ERROR400 YES, SEGMENT DOES NOT EXIST @V305001 00962000
B ERROR410 OTHERWISE PAGING ERROR @V305001 00963000
LOADIT BAL R5,CHKSEG CHECK WHERE SEGMENT SAVED @V305001 00964000
SR R4,R4 GET LOADSYS SHARED CODE @V305001 00965000
LR R3,R1 GET SEGMENT NAME @V305001 00966000
DC X'83340064' ISSUE LOADSYS DIAGNOSE @V305001 00967000
BP DOSERRS (SHOULD NOT HAPPEN) @V305001 00968000
LOADED BAL R5,CHKSEG (SHOULD ALWAYS RETURN) @V305001 00969000
ST R3,ADOSDCSS SAVE CMSDOS SEGMENT START @V305001 00970000
L R5,ABGCOM GET COM. REGION ADDRESS @V305001 00971000
ST R5,ASYSREF SAVE IN NUCON (LOC X'14') @V305001 00972000
XC PPEND(12),PPEND ZERO PPEND, HIPHAS & HIPROG @V305001 00973000
LH R1,LUBPT GET LUB TABLE POINTER @V305001 00974000
LA R1,8(,R1) POINT TO SYSLOG LUB ENTRY @V305001 00975000
MVI 0(R1),HEX00 INITIALIZE LUB INDEX @V305066 00976000
LH R1,PUBPT GET PUB TABLE POINTER @V305001 00977000
XC 0(8,R1),0(R1) INITIALIZE CONSOLE PUB ENTRY @V305001 00978000
L R3,ADEVTAB GET DEVICE TABLE ADDRESS @V305001 00979000
LH R3,0(,R3) GET CONSOLE CUU @V305001 00980000
STH R3,0(,R1) SAVE IN PUB ENTRY @V305001 00981000
L R1,ASYSCOM GET SYSCOM REGION ADDR @V305001 00982000
ST R1,CPULOG STORE IN NUCON @V305001 00983000
MVC JOBDATE,CURRDATE SET DATE IN BGCOMRG @VA07188 00984000
OI DOSFLAGS,DOSMODE+DOSSVC SET FLAGS IN NUCON @V305001 00985000
ICM R0,15,DOSTRANS TRANS AREA ALREADY ACQUIRED ? @V305101 00986000
BNZ SR1515 YES, JUST GET OUT @V305101 00987000
LA R0,CON175 GET $$B (LTA) SIZE @VA08226 00988100
DMSFREE DWORDS=(0),TYPCALL=BALR,TYPE=NUCLEUS @V305101 00989000
ST R1,DOSTRANS SAVE DOSTRANS AREA ADDRESS @V305101 00990000
B SR1515 AND FINALLY, GET OUT @V305101 00991000
DROP R1 @V305001 00992000
SPACE 1 00993000
CHKSEG C R3,VMSIZE WILL SEG OVERLAY USER'S V.M. ? @V305001 00994000
LA R14,EXIT PROVIDE EXIT FOR ERROR RTN @VM03024 00995000
BL ERROR401 YES, DO NOT ALLOW @V305001 00996000
BR R5 RETURN TO CALLER @V305001 00997000
EJECT 00998000
DOSOFF CLI 8(R3),FF 2ND. ARG SPECIFIED ? @V305066 00999000
BNE ERROR070 YES, ERROR @V305001 01000000
TM DOSFLAGS,DOSMODE CMS/DOS ACTIVE ? @V305001 01001000
BZ SR1515 NO, JUST GET OUT @V305001 01002000
USING SYSNAMES,R4 @V305014 01003000
L R4,ASYSNAMS POINT TO SAVED NAME TABLE @V305014 01004000
LA R1,CMSDOS POINT TO CMSDOS ENTRY @V305014 01005000
LA R3,PURGESYS GET PURGESYS CODE @V305066 01006000
DC X'83130064' ISSUE PURGESYS DIAGNOSE @V305001 01007000
SPACE 1 01008000
TM DOSFLAGS,DOSVSAM VSAM INCLUDED ? @V305114 01009000
BNO CLRDOS NO, SKIP PURGE @V305114 01010000
LA R1,CMSVSAM POINT TO CMSVSAM ENTRY @V305114 01011000
LA R3,PURGESYS INDICATE PURGESYS @V305166 01012000
DC X'83130064' ISSUE PURGESYS DIAGNOSE @V305114 01013000
NI VSAMFLG1,X'FF'-VSAMRUN RESET VSAM LOAD FLAG @VA11692 01013500
EJECT 01014000
CLRDOS MVI DOSFLAGS,HEX00 RESET FLAGS IN NUCON @V305166 01015000
L R5,ABGCOM GET ADDRESS OF BGCOM AREA @V305101 01016000
XC PPEND(12),PPEND ZERO PPEND, HIPHAS & HIPROG @V305101 01017000
XC LTK(2),LTK ZERO LOG. TRANS AREA KEY @V305101 01018000
XC DOSKPART,DOSKPART ZERO DOS PARTITON SIZE @VA04299 01019000
MVI UPSI,HEX00 AND THE UPSI BYTE. @VA04299 01020000
LH R1,PIBPT GET PIB ADDRESS @V305101 01021000
L R3,ALTASAVE AND LTA SAVE AREA ADDRESS @V305101 01022000
ST R3,8(,R1) STORE IN ATTN. PIB @V305101 01023000
L R3,APPSAVE NOW GET PP SAVE AREA ADDRESS @V305101 01024000
ST R3,20(,R1) AND STORE IN PART. PIB @V305101 01025000
MVC JCSW3(1),SOB1 NON-STD OPT. BYTE 3 = STD. @V305066 01026000
MVI JCSW4,OPT NON-STD OPT. BYTE 4 TO ZERO @V305066 01027000
LH R1,LUBPT NOW GET LUB POINTER @V305001 01028000
LA R3,LOGUNIT GET NUMBER LOGICAL UNITS @V305066 01029000
LA R3,LOGUNIT GET NUMBER LOGICAL UNITS @V305066 01030000
DOSLUP MVI 0(R1),FF UNASSIGN LOGICAL UNIT @V305066 01031000
LA R1,2(,R1) POINT TO NEXT LOGICAL UNIT @V305001 01032000
BCT R3,DOSLUP LOPP 'TILL ALL UNASSIGNED @V305001 01033000
LA R1,SYSREF GET CMS SYSREF ADDR @V305001 01034000
ST R1,ASYSREF STORE IN NUCON @V305001 01035000
XC CPULOG(4),CPULOG CLEAR SYSCOM ADDR @V305001 01036000
ICM R1,15,DOSTRANS GET DOSTRANS AREA ADDRESS @V305101 01037000
BZ SR1515 IF ZERO, JUST EXIT @V305101 01038000
LA R0,CON175 $$B (LTA) SIZE @VA09234 01039500
DMSFRET DWORDS=(0),LOC=(1),TYPCALL=BALR @V305101 01040000
XC DOSTRANS,DOSTRANS ZERO DOSTRANS AREA @V305101 01041000
B SR1515 AND FINALLY, GET OUT @V305101 01042000
DROP R5 @V305001 01043000
SPACE 2 01044000
MODETAB DC C'A',X'08' A-DISK MODE AND PUB INDEX @V305001 01045000
DC C'B',X'09' B-DISK MODE AND PUB INDEX @V305001 01046000
DC C'C',X'0A' C-DISK MODE AND PUB INDEX @V305001 01047000
DC C'D',X'0B' D-DISK MODE AND PUB INDEX @V305001 01048000
DC C'E',X'0C' E-DISK MODE AND PUB INDEX @V305001 01049000
DC C'F',X'0D' F-DISK MODE AND PUB INDEX @V305001 01050000
DC C'G',X'0E' G-DISK MODE AND PUB INDEX @V305001 01051000
DC C'S',X'0F' S-DISK MODE AND PUB INDEX @V305001 01052000
DC C'Y',X'10' Y-DISK MODE AND PUB INDEX @V305001 01053000
DC C'Z',X'11' Z-DISK MODE AND PUB INDEX @V305001 01054000
EMODTAB EQU (*-MODETAB)/2 NUMBER ITEMS IN TABLE @V305001 01055000
EJECT 01056000
* 01057000
* SET DOSPART NN 01058000
* 01059000
SPACE 1 01060000
DOSPART TM DOSFLAGS,DOSMODE IS CMS/DOS MODE ACTIVE ? @VA04299 01061000
BZ ERROR099 NO, ERROR @VA04299 01062000
CLI 0(R3),FF ANY SPECIFIED ? @VA04299 01063000
BE ERROR047 NO, NO ARGUMENT SPECIFIED. @VA04299 01064000
CLI 8(R3),FF MORE THAN ONE ARGUMENT IN LINE ? @VA04299 01065000
BNE ERROR070 YES, UNEXPECTED PARAMETER. @VA04299 01066000
SR R4,R4 CLEAR WORK REGISTER @VA04299 01067000
CLC 0(4,R3),OFF IS OFF SPECIFIED ? @VA04299 01068000
BE DOSPART4 YES, SET DOSPART TO 0 @VA04299 01069000
LR R4,R3 LET R4 POINT TO NO. K @VA04299 01070000
CLI 6(R4),BLANK SET IF EXCEEDS 5 DIGITS ? @VA04299 01071000
BNE CHARBAD ERROR IF MORE THAN 5 DIGITS. @VA04299 01072000
DOSPART2 CLI 0(R4),KBYTE CHECK NUMBER FOR VALID @VA04299 01073000
BE DOSPART3 DECIMAL VALUE. @VA04299 01074000
CLI 0(R4),CHAR0 LESS THAN ZERO ? @VA04299 01075000
BL CHARBAD YES, GIVE ERROR MESSAGE @VA04299 01076000
CLI 0(R4),CHAR9 GREATER THAN NINE ? @VA04299 01077000
BH CHARBAD YES, GIVE ERROR MESSAGE @VA04299 01078000
LA R4,1(,R4) BUMP TO NEXT DIGIT @VA04299 01079000
B DOSPART2 AND CHECH NEXT DIGIT. @VA04299 01080000
DOSPART3 SR R4,R3 COMPUTE NUMBER DIGITS. @VA04299 01081000
BZ CHARBAD IF NO VALUE, ERROR @VA04299 01082000
BCTR R4,0 LESS ONE FOR EXECUTE @VA04299 01083000
EX R4,DOSPACK PACK THE NUMBER @VA04299 01084000
CVB R4,PGLDR AND CONVERT IT TO BINARY. @VA04299 01085000
LTR R4,R4 IS VALUE ZERO ? @VA04299 01086000
BZ CHARBAD YES, GIVE ERROR MESSAGE @VA04299 01087000
L R6,FREELOWE GET UPPER BOUND AS OF THIS TIME @VA04299 01088000
S R6,AUSRAREA AND COMPUTE TOTAL USER AREA @VA04299 01089000
LH R5,FRERESPG GET NO. PAGES TO RESERVE FOR CMS @VA04299 01090000
SLL R5,12 AND CONVERT TO BYTES @VA04299 01091000
SR R6,R5 COMPUTE DOS POSSIBLE LARGEST PART@VA04299 01092000
SRL R6,10 NOW CONVERT TO K-BYTES @VA04299 01093000
CR R4,R6 EXCEEDS MAXIMUM ALLOWED ? @VA04299 01094000
BH ERRORXXX YES, GIVE ERROR MESSAGE @VA04299 01095000
DOSPART4 STH R4,DOSKPART STORE NUMBER K-BYTES IN NUCON. @VA04299 01096000
* 01097000
* SINCE A NEW PARTITION SIZE IS BEING SPECIFIED BY THE USER, 01098000
* 'DISABLE' ANY PREVIOUS LOADS OR FETCHES. 01099000
* 01100000
STRINIT TYPCALL=SVC @VA04299 01101000
XC STRTADDR(4),STRTADDR CLEAR STARTING ADDRESS @VA04299 01102000
XC TBENT(2),TBENT RESET NO. OF LOADER TABLE ENTRIES 01103000
B SR1515 EXIT WITHOUT ERROR @VA04299 01104000
SPACE 1 01105000
DOSPACK PACK PGLDR,0(0,R3) EXECUTED PACK @VA04299 01106000
EJECT 01107000
* 01108000
* SET DOSLNCNT NN WHERE 29<NN<100 01109000
* 01110000
SPACE 01111000
LINECT TM DOSFLAGS,DOSMODE IS CMS/DOS MODE ACTIVE?? @V505098 01112000
BZ ERROR099 NO, ERROR @V505098 01113000
CLI 0(R3),FF ANY ARGUMENTS SPECIFIED?? @V505098 01114000
BE ERROR047 NO, NO ARGUMENTS SPECIFIED?? @V505098 01115000
CLI 8(R3),FF MORE THAN ONE ARGUMENT IN LINE?? @V505098 01116000
BNE ERROR070 YES, UNEXPECTED PARAMETER @V505098 01117000
CLI 2(R3),C' ' IS ARGUMENT TOO LONG?? @V505098 01118000
BNE CHARBAD YES, INVALID PARAMETER @V505098 01119000
CLC 0(2,R3),LCLOW IS PARAMETER TOO SMALL?? @V505098 01120000
BL CHARBAD YES, INVALID PARAMETER @V505098 01121000
CLC 0(2,R3),LCHIGH IS PARAMETER TOO LARGE?? @V505098 01122000
BH CHARBAD YES, INVALID PARAMETER @V505098 01123000
L R1,ABGCOM GET ADDRES OF COMM. REGION @V505098 01124000
USING BGCOM,R1 SET UP ADDRESSABILITY @V505098 01125000
PACK DEC(8),0(2,R3) PACK THE LINE COUNT @V505098 01126000
CVB R3,DEC @V505098 01127000
STC R3,SYSLINE STORE LINECT IN COMM. REG. @V505098 01128000
DROP R1 GET RID OF ADDRESSABILITY @V505098 01129000
B SR1515 EXIT WITHOUT ERROR @V505098 01130000
EJECT 01131000
* 01132000
* SET UPSI NNNNNNNN|OFF 01133000
* 01134000
SPACE 1 01135000
UPSISET TM DOSFLAGS,DOSMODE IS CMS/DOS MODE ACTIVE ? @V305001 01136000
BZ ERROR099 NO, ERROR @V305001 01137000
L R1,ABGCOM GET ADDRESS OF COMM. REGION @V305001 01138000
USING BGCOM,R1 @V305001 01139000
CLI 0(R3),FF NONE SPECIFIED ? @V305066 01140000
BE ERROR047 NO, ERROR @V305001 01141000
CLI 8(R3),FF MORE THAN ONE ARGUMENT ? @V305066 01142000
BNE ERROR070 YES, GIVE ERROR MSG @V305001 01143000
CLC OFF,0(R3) UPSI OFF ? @V305001 01144000
BE UPSIOFF YES, ZERO UPSI BYTE @V305001 01145000
LR R4,R3 SAVE ARGUMENT POINTER @V305001 01146000
LA R5,CON128 GET UPSI ON MASK @V305066 01147000
LCR R6,R5 GET UPSI OFF MASK @V305001 01148000
BCTR R6,0 ... @V305001 01149000
LA R7,ARGLEN GET ARGUMENT MAX LENGTH @V305066 01150000
UPSICHK CLI 0(R4),X IS CHAR. 'X' ? @V305066 01151000
BE UPSINXT YES, BUMP TO NEXT BYTE @V305001 01152000
CLI 0(R4),CHAR1 IS CHAR. '1' ? @V305066 01153000
BE BITON YES, TURN PROPER BIT ON @V305001 01154000
CLI 0(R4),CHAR0 IS CHAR. '0' ? @V305066 01155000
BE BITOFF YES, TURN PROPER BIT OFF @V305001 01156000
CLI 0(R4),BLANK IS THIS ALL ? @V305066 01157000
BE SR1515 YES, GET OUT @V305001 01158000
B CHARBAD MUST BE INVALID FUNCTION @V305001 01159000
SPACE 1 01160000
BITON EX R5,EXOI TURN PROPER BIT ON @V305001 01161000
B UPSINXT GO PROCESS NEXT BYTE @V305001 01162000
BITOFF EX R6,EXNI TURN PROPER BIT OFF @V305001 01163000
SPACE 1 01164000
UPSINXT SRA R5,1 SHIFT MASK TO NEXT BIT @V305001 01165000
SRA R6,1 DITTO..... @V305001 01166000
LA R4,1(,R4) BUMP TO NEXT BYTE @V305001 01167000
BCT R7,UPSICHK KEEP CHECKING @V305001 01168000
B SR1515 ALL DONE HERE @V305001 01169000
UPSIOFF MVI UPSI,HEX00 SET UPSI BYTE TO ZERO @V305066 01170000
B SR1515 ALL DONE @V305001 01171000
SPACE 1 01172000
EXOI OI UPSI,HEX00 EXECUTED 'OI' @V305066 01173000
EXNI NI UPSI,HEX00 EXECUTED 'NI' @V305066 01174000
DROP R1 @V305001 01175000
EJECT 01176000
* 01177000
* SET SYSNAME SNAME NAME 01178000
* 01179000
SPACE 1 01180000
SAVNAME EQU * @V305114 01181000
CLI 0(R3),FF MUST BE THERE @V305166 01182000
BE ERROR050 ERROR, IF NOT @V305114 01183000
SPACE 1 01184000
LA R4,SAVNAMES POINT TO SAVED SYS NAME TABLE @V305114 01185000
LA R5,SAVNCNT GET TABLE ENTRY COUNT @V305114 01186000
L R6,ASYSNAMS POINT TO NUCLEUS TABLE @V305114 01187000
SPACE 1 01188000
SYSNSRCH CLC 0(8,R3),0(R4) THIS ENTRY ? @V305114 01189000
BE SYSNFND YES, BR @V305114 01190000
LA R4,8(,R4) POINT TO NEXT ENTRY @V305114 01191000
LA R6,8(,R6) POINT TO NEXT TABLE ENTRY @V305114 01192000
BCT R5,SYSNSRCH SEARCH TO THE BOTTOM @V305114 01193000
B ERROR142 ERROR IF NOT FOUND @V305114 01194000
SPACE 1 01195000
SYSNFND LA R3,8(,R3) POINT TO SUBSTITUTE @V305114 01196000
LA R2,8(,R2) POINT TO SYSNAME FOR ERROR MSG @V305114 01197000
CLI 0(R3),FF MUST BE THERE @V305166 01198000
BE ERROR050 ERROR, IF NOT @V305114 01199000
SPACE 1 01200000
CLI 8(R3),FF THIS MUST BE THE LAST PARAMETER @V305166 01201000
BNE ERROR070 ERROR, IF NOT @V305114 01202000
CLC 0(8,R2),SAVNAMES IS THIS THE CMSSEG ENTRY ? @V305614 01203000
BE SETCMS YES, BR @V305614 01204000
MVC 0(8,R6),0(R3) ELSE, PLUG NEW SYSTEM NAME @V305114 01205000
B SR1515 AND LEAVE... @V305114 01206000
SPACE 1 01207000
SETCMS L R6,ASYSNAMS POINT TO SYSNAMES TABLE @V305614 01208000
USING SYSNAMES,R6 ..... @V305614 01209000
LR R7,R3 ALLOW CODE SHARING @V305614 01210000
NI DCSSFLAG,255-DCSSAVAL MAY BECOME NOT AVAILABLE @V305614 01211000
TM DCSSFLAG,DCSSJLNS NON-SHARED CMSSEG ? @V305614 01212000
BNO NOTNSHR NO, PURGE NOT NECESSARY @V305614 01213000
SPACE 1 01214000
LA R4,PURGESYS INDICATE PURGESYS FUNCTION @V305666 01215000
LA R3,CMSSEG POINT TO OLD CMSSEG ENTRY @V305614 01216000
DC X'83340064' PURGE OLD SEGMENT @V305614 01217000
NI DCSSFLAG,255-DCSSJLNS RESET INDICATOR @V305614 01218000
SPACE 1 01219000
NOTNSHR MVC CMSSEG(8),0(R7) MOVE IN NEW NAME @V305614 01220000
LA R3,CMSSEG POINT TO CMSSEG ENTRY @V305614 01221000
LA R4,FINDSYS INDICATE FINDSYS FUNCTION @V305666 01222000
DC X'83340064' FINDSYS NEW SEGMENT @V305614 01223000
BC 2,NOTAVAL INVALID OR CP ERROR @VM03024 01224000
SPACE 1 01225000
C R3,VMSIZE WILL SEG OVERLAY VM STORAGE ? @V305614 01226000
BNL LOADSEG NO, LOAD IT @VM03024 01227000
LA R1,CMSSEG POINTER FOR MSG SUBSTITUTION @VM03024 01228000
LA R14,FSYSERR OTHERWISE ISSUE @VM03024 01229000
B ERROR401 WARNING MESSAGE @VM03024 01230000
SPACE 1 01231000
LOADSEG LA R3,CMSSEG POINT TO CMSSEG ENTRY @VM03024 01232000
SR R4,R4 INDICATE LOADSYS @V305614 01233000
DC X'83340064' LOADSYS @V305614 01234000
BNZ NOTAVAL ISSUE MSG IF LOAD ERROR @VM03024 01235000
SPACE 1 01236000
TM DCSSFLAG,DCSSVTLD SVT TEXT LOADED ? @V305614 01237000
BNO SKFRET NO, SKIP DMSFRET @V305614 01238000
L R0,OSMODLDW GET OS SIM. LENGTH (DWORDS) @VA05055 01239000
L R1,AOSMODL POINT TO DMSSVT TEXT @V305614 01240000
DMSFRET DWORDS=(0),LOC=(1) @V305614 01241000
SR R1,R1 @VA05055 01242000
ST R1,AOSMODL CLEAR OS SIM ADDR @VA05055 01243000
SPACE 1 01244000
SKFRET MVI DCSSFLAG,DCSSAVAL+DCSSLDED AVAIL AND LOADED @VA04737 01245000
ST R3,ACMSSEG SAVE SEGMENT ADDRESS IN NUCON @VA15001 01245500
B SR1515 PURGE IS DONE BY DMSINT @V305614 01246000
SPACE 1 01247000
NOTAVAL LA R2,CMSSEG GET CMSSEG ENTRY @VM03024 01248000
DMSERR NUM=100,LET=W,TEXT='SYSTEM NAME ''........'' NOT AVAILAX01249000
BLE',SUB=(CHARA,(R2)) @VM03024 01250000
LA R10,FOURBITS SET WARNING RETURN CODE @VM03156 01251000
SPACE 1 01252000
FSYSERR LR R8,R15 SAVE FIND/LOADSYS RETURN @VM03024 01253000
TM DCSSFLAG,DCSSVTLD WAS SVT LOADED ? @VA07273 01254000
BNO STATSVT NO, LOAD IT @VA07273 01255000
L R1,AOSMODL GET OS SIMULATION ADDRESS @VA07273 01256000
L R0,OSMODLDW GET CURRENT LENGTH @VA07273 01257000
DMSFRET DWORDS=(0),LOC=(1) @VA07273 01258000
SR R1,R1 CLEAR REG 1 @VA07273 01259000
ST R1,AOSMODL CLEAR ADDRESS AND @VA07273 01260000
ST R1,OSMODLDW LENGTH @VA07273 01261000
STATSVT NI DCSSFLAG,255-DCSSVTLD NO LONGER LOADED @VM03024 01262000
SPACE 1 01263000
LA R1,SVTST POINT TO DMSSVT STATE PLIST @VM03024 01264000
L R15,ASTATE AND GET STATE ENTRY POINT @V305614 01265000
BALR R14,R15 IS DMSSVT TEXT AVAILABLE ? @V305614 01266000
BNZ NOSVT NO, GET OUT @V305614 01267000
L R2,AUSRAREA LOAD AT X'20000' FOR SIZE @VA05055 01268000
BAL R9,LOADSUB LOAD TO GET SIZE... @VA05055 01269000
L R2,AUSRAREA WE LOADED AT X'20000'... @VA05055 01270000
L R3,LOCCNT R3-> LAST LOCATION LOADED... @VA05055 01271000
SR R3,R2 DIFF = SIZE OF OS SIMUL. @VA05055 01272000
LA R3,7(,R3) ROUND TO NEXT DWORD... @VA05055 01273000
SRL R3,3 DIVIDE BY 8 = NO. DWORDS @VA05055 01274000
ST R3,OSMODLDW KEEP SIZE OF OS SIM(DWORDS) @VA05055 01275000
LR R0,R3 GET OS SIM. LENGTH(DWORDS) @VA05055 01276000
LOADFREE EQU * @VA06166 01277000
DMSFREE DWORDS=(0),AREA=HIGH,TYPE=NUCLEUS,ERR=NOSVT @VA06297 01278000
ST R1,AOSMODL SAVE FREE STORAGE ADDR @VA05055 01279000
BYFREE LR R2,R1 R2-> OS SIM STORAGE @VA05055 01280000
LA R9,FINALOAD DROP THRU THIS TIME... @VA05055 01281000
SPACE 1 01282000
LOADSUB EQU * HERE FOR LOADING OS SIM. @VA05055 01283000
LA R14,MAXORG MAXIMUM ORIGIN LENGTH @V305665 01284000
LA R1,LOADSTRT+7 POINT TO ORIGIN FIELD @V305665 01285000
HALFBYTE EQU * @V305665 01286000
SRDL R2,FOURBITS MOVE HALF BYTE TO R3 @V305665 01287000
SRL R3,RESTWORD MOVE TO LOW BYTE @V305665 01288000
STC R3,0(,R1) STORE FULL BYTE IN PLIST @V305665 01289000
BCTR R1,0 GET LOWER BYTE ADDRESS @V305665 01290000
BCT R14,HALFBYTE AND LOOP @V305665 01291000
SPACE 1 01292000
TR LOADSTRT,HEXTBL TRANSLATE TO EBCDIC @V305665 01293000
LA R1,LDPLIST POINT TO PLIST @V305665 01294000
STM R0,R15,RGPRS SAVE REGISTERS @V305665 01295000
OI MODFLGS,SYSLOAD ALLOW LOAD ABOVE FREELOWE @VA04666 01296000
SVC 202 LOAD DMSSVT TEXT @V305614 01297000
DC AL4(*+4) ..... @V305614 01298000
NI MODFLGS,255-SYSLOAD RESET LOADER FLAG @VA04666 01299000
LTR R15,R15 ANY ERRORS? @V305665 01300000
LM R0,R15,RGPRS RESTORE REGISTERS @V305665 01301000
BNZ NOSVT IF ERROR, CAN'T ISSUE OS SVCS @V305614 01302000
BR R9 RETURN TO CALLER @VA05055 01303000
FINALOAD EQU * DROP THRU IF LAST LOAD @VA05055 01304000
OI DCSSFLAG,DCSSVTLD INDICATE LOADED @V305665 01305000
B EXIT ALL SET ... @VM03024 01306000
SPACE 1 01307000
NOSVT DMSERR NUM=098,LET=W,TEXT='CMS OS SIMULATION NOT AVAILABLE' 01308000
LA R10,FOURBITS SET WARNING RETURN CODE @VM03156 01309000
ICM R1,ALL,AOSMODL GET OS SIM ADDR @VA05055 01310000
BZ BYFRET IF ZERO, DON'T FRET @VA05055 01311000
L R0,OSMODLDW GET OS SIM LENGTH(DWORDS) @VA05055 01312000
DMSFRET DWORDS=(0),LOC=(1) @VM03024 01313000
SR R1,R1 @VA05055 01314000
ST R1,AOSMODL CLEAR OS SIM ADDR @VA05055 01315000
BYFRET EQU * @VA05055 01316000
CH R8,PAGERR WAS THERE A PAGING I/O ERROR ? @VM03024 01317000
BNE EXIT NO, EXIT @VM03024 01318000
LR R4,R8 SET UP FOR ERROR410 @VM03024 01319000
B ERROR410 ISSUE 410S MESSAGE @VM03024 01320000
DROP R6 @V305614 01321000
EJECT 01322000
ERROR014 EQU * 01323000
DMSERR NUM=14,LET=E,SUB=(CHARA,(R2)),TEXT='INVALID FUNCTION ''+01324000
........''' 01325000
LA R10,24 COMPLETION CODE P0641 01326000
B EXIT RETURN TO CALLER 01327000
SPACE 2 01328000
CHARBAD EQU * 01329000
DMSERR NUM=26,LET=E,SUB=(CHARA,(R3),CHARA,(R2)),RENT=NO,TEXT='+01330000
INVALID PARAMETER ''........'' FOR ''........'' FUNCTION+01331000
' 01332000
LA R10,24 RETURN CODE 01333000
B EXIT RETURN TO CALLER 01334000
EJECT 01335000
ERROR EQU * 01336000
DMSERR NUM=31,LET=E,TEXT='LOADER TABLES CANNOT BE MODIFIED' 01337000
SR R10,R10 ZERO R10 @VA06297 01338000
C R10,AOSMODL IS DMSSVT IN CORE @VA06297 01339000
LA R10,40 SET RETURN CODE @VA06297 01340000
BNE ERROREND YES IT IS @VA06297 01341000
NI DCSSFLAG,255-DCSSVTLD REMOVE SVT LOADED FLAG @VA06297 01342000
L R0,OSMODLDW GET LENGTH OF SVT MODULE @VA06297 01343000
B LOADFREE AND GO RELOAD IT. @VA06297 01344000
ERROREND EQU * @VA06297 01345000
B EXIT EXIT TO CALLER 01346000
SPACE 01347000
ERROR047 EQU * 01348000
DMSERR NUM=47,LET=E,TEXT='NO FUNCTION SPECIFIED' 01349000
LA R10,24 RETURN CODE 01350000
TM DCSSFLAG,DCSSVTLD WAS SVT LOADED? @VA06166 01351000
BZ EXIT BRANCH IF NOT @VA06166 01352000
NI DCSSFLAG,255-DCSSVTLD REMOVE SVT LOADED FLAG @VA06166 01353000
L R0,OSMODLDW GET LENGTH OF SVT MODULE @VA06166 01354000
B LOADFREE AND GO RELOAD IT @VA06166 01355000
EJECT 01356000
ERROR061 EQU * P0641 01357000
DMSERR NUM=61,LET=E, P0641*01358000
TEXT='NO TRANSLATION CHARACTER SPECIFIED' P0641 01359000
LA R10,24 COMPLETION CODE P0641 01360000
B EXIT RETURN TO CALLER P0641 01361000
SPACE 01362000
ERR070A LA R3,8(R3) ADJUST TO EXPECTED POSITION @VA01036 01363000
ERROR070 EQU * 01364000
LA R3,8(,R3) POINT TO UNEXPECTED PARM. 01365000
DMSERR NUM=70,LET=E,SUB=(CHARA,(R3)),TEXT='INVALID PARAMETER '+01366000
'........''' 01367000
LA R10,24 RETURN CODE 01368000
B EXIT RETURN TO CALLER @V305001 01369000
EJECT 01370000
ERROR048 EQU * INVALID MODE SPECIFIED @V305001 01371000
DMSERR NUM=48,LET=E,TEXT='INVALID MODE ''....''', @V305001*01372000
SUB=(CHARA,(R3)) @V305001 01373000
LA R10,TWENTY4 RETURN CODE @V305066 01374000
B EXIT RETURN TO CALLER @V305001 01375000
SPACE 1 01376000
ERROR050 EQU * MISSING PARAMETER @V305014 01377000
DMSERR NUM=50,LET=E,SUB=(CHARA,(R2)), @V305001X01378000
TEXT='PARAMETER MISSING AFTER ........' @V305014 01379000
LA R10,TWENTY4 RETURN CODE @V305066 01380000
B EXIT RETURN TO CALLER @V305014 01381000
EJECT 01382000
ERRORXXX EQU * DOS PARTITION SIZE TOO LARGE @VA04299 01383000
DMSERR TEXT='.....K PARTITION TOO LARGE FOR THIS VIRTUAL MACHI*01384000
NE',SUB=(DEC,(R4)),NUM=333,LET=E @VA04299 01385000
LA R10,TWENTY4 RETURN CODE @VA04299 01386000
B EXIT RETURN TO CALLER @VA04299 01387000
ERROR099 EQU * CMS/DOS NOT ACTIVE @V305001 01388000
DMSERR TEXT='CMS/DOS ENVIRONMENT NOT ACTIVE',NUM=99,LET=E 01389000
LA R10,FORTY RETURN CODE = 40 @V305066 01390000
B EXIT RETURN TO CALLER @V305001 01391000
EJECT 01392000
ERROR400 EQU * @V305001 01393000
DMSERR TEXT='SYSTEM ''........'' DOES NOT EXIST', @V305001*01394000
NUM=400,LET=S,SUB=(CHARA,(R3)) @V305001 01395000
LR R10,R4 RETURN CODE TO R10 @V305001 01396000
B EXIT RETURN TO CALLER @V305001 01397000
SPACE 1 01398000
ERROR401 LR R8,R2 SAVE PLIST POINTER @VA04735 01399000
LR R2,R1 POINT TO SEGMENT NAME @VA04735 01400000
DMSERR TEXT='V.M. SIZE (.......) CANNOT EXCEED ''........'' ST*01401000
ART ADDRESS (......)',MF=(E,'SYS'), @V305001*01402000
NUM=401,LET=S,SUB=(HEXA,VMSIZE,CHARA,(R2),HEX,(R3)) 01403000
CLC 0(8,R8),=CL8'DOS' WAS THIS A 'SET DOS' FUNCT? @VA04735 01404000
BNE E401OUT NO, THEN 401S WILL SUFFICE @VA04735 01405000
TM DOSFLAGS,DOSMODE ARE WE IN DOS ENVIRONMENT? @VA04735 01406000
BZ ERROR099 NO- THEN SAY CMS/DOS NOT ACT @VA04735 01407000
E401OUT LA R10,FORTY RETURN CODE TO R10 @VA04735 01408000
B EXIT RETURN TO CALLER @VA04735 01409000
EJECT 01410000
ERROR142 EQU * @V305114 01411000
DMSERR TEXT='SAVED SYSTEM NAME ''........'' INVALID',NUM=142,LX01412000
ET=S,SUB=(CHARA,(R3)) @V305114 01413000
LA R10,TWENTY4 SET RETURN CODE @V305166 01414000
B EXIT AND RETURN @V305114 01415000
SPACE 1 01416000
ERROR410 EQU * @V305001 01417000
DMSERR TEXT='CONTROL PROGRAM ERROR INDICATION ''....''', *01418000
NUM=410,LET=S,SUB=(DEC,(R4)) @VM03173 01419000
LR R10,R4 RETURN CODE TO R10 @V305001 01420000
B EXIT AND RETURN @VM03024 01421000
SPACE 01422000
SR1515 EQU * RETURN TO CALLER 01423000
SR R10,R10 CLEAR RETURN REGISTER @V305014 01424000
* 01425000
EXIT EQU * 01426000
LR R15,R10 SET RETURN CODE IN R15 01427000
L R14,CMSAVE14 RESTORE R14 AND 01428000
BR R14 EXIT TO CALLER. 01429000
ERROR444 EQU * @VA04692 01430000
LR R6,R1 LOAD POINTER TO DISK LABEL @VA04692 01431000
DMSERR TEXT='VOLUME ''......''IS NOT A DOS SYSRES',NUM=444, X01432000
LET=E,SUB=(CHARA,(R6)) 01433000
LA R10,THIRTY2 SET RETURN CODE @VA04692 01434000
B EXIT AND RETURN @VA04692 01435000
SPACE 1 01436000
NOSTORE DMSERR TEXT='VIRTUAL STORAGE CAPACITY EXCEEDED', *01437000
NUM=109,LET=S 01438000
LA R10,104 SET RETURN CODE @VA04696 01439000
B EXIT AND RETURN @VA04696 01440000
EJECT 1 01441000
* 01442000
* CONSTANTS AREA 01443000
* 01444000
DS 0D 01445000
* 01446000
* STANDARD INPUT AND OUTPUT TRANSLATE TABLE 01447000
* 01448000
OTRTABLE DC 256AL1(*-OTRTABLE) STANDARD OUTPUT TRANS. TABLE 01449000
ITRTABLE DC 129AL1(*-ITRTABLE) STANDARD INPUT TRANS. TABLE 01450000
UPA DC X'C1C2C3C4C5C6C7C8C9' 01451000
UPAB DC 7AL1(*-UPAB+138) 01452000
UPJ DC X'D1D2D3D4D5D6D7D8D9' 01453000
UPJB DC 8AL1(*-UPJB+154) 01454000
UPS DC X'E2E3E4E5E6E7E8E9' 01455000
UPSB DC 86AL1(*-UPSB+170) 01456000
INTBLEN EQU 64 DWORD SIZE OF INPUT TRANS TABLE @VA04696 01457000
OUTBLEN EQU 32 DWORD SIZE OF OUTPUT TRANS TABLE @VA04696 01458000
* 01459000
DEC DS 1D USED FOR NUMBER CONVERSION @V505098 01460000
* 01461000
LARGEPOS DC X'00FFFFFF' LARGE POSITIVE NO. FOR TIMER. 01462000
SMALLM DC X'00060000' SIZE OF MACHINE HAVING 2 LDRTBLS@VA11938 01463000
LAT10 DC H'0119' CONVERTS LOWER-CASE 'A' TO DECIMAL 10. 01464000
ATO10 DC H'0183' CONVERTS ALPHAMERIC 'A' TO DECIMAL 10. 01465000
HC0 DC H'0240' CONVERTS ALPHAMERIC '0' TO BINARY 0. 01466000
* 01467000
PAGERR DC H'174' CP PAGING ERROR CODE @V305614 01468000
GLDR DC D'0' 01469000
PGLDR DC D'0' 01470000
CMSAVE14 DC F'0' R14 SAVED HERE. 01471000
* 01472000
CPSET DS 0F PASS COMMAND LINE TO CP 01473000
DC CL8'CP' CALL DMSCPF 01474000
CPCMND DS CL132 COMMAND LINE 01475000
DC 4XL1'FF' END OF PLIST TO DMSCPF 01476000
O127 DC F'127' MAXIMUM FOR LOADER TABLE PAGES @VA04696 01477000
* 01478000
LISTLOOP DC AL4(FIRSTCOM,12,AFTRLAST) FUNCTION POINTERS @VA04696 01479000
* 01480000
ON DC CL4'ON' 'ON' SPECIFIED 01481000
OFF DC CL4'OFF' 'OFF' SPECIFIED 01482000
SMSG DC CL5'SMSG' 'SMSG' SPECIFIED 01483000
LMSG DC CL5'LMSG' 'LMSG' SPECIFIED 01484000
* 01485000
CODE DC CL5'CODE' 'CODE' SPECIFIED V0019 01486000
TEXT DC CL5'TEXT' 'TEXT' SPECIFIED V0019 01487000
OPAREN EQU C'(' @V305114 01488000
CPAREN EQU C')' @V305114 01489000
VSAM DC CL8'VSAM' @V305114 01490000
SPACE 1 01491000
LDPLIST DS 0F PLIST TO LOAD DMSSVT TEXT @V305614 01492000
DC CL8'LOAD' @V305614 01493000
DC CL8'DMSSVT' @V305614 01494000
DC CL8'(' @V305614 01495000
DC CL8'ORIGIN' @V305614 01496000
LOADSTRT DC CL8'0' @V305614 01497000
DC 8X'FF' @V305614 01498000
SPACE 1 01499000
SVTST DS 0F PLIST FOR DMSSVT STATE @V305614 01500000
DC CL8'STATE' @V305614 01501000
DC CL8'DMSSVT' @V305614 01502000
DC CL8'TEXT' @V305614 01503000
DC CL2'*' @V305614 01504000
DC 6X'00' @V305614 01505000
DC 8X'FF' @V305614 01506000
SPACE 1 01507000
HEXTBL DC C'0123456789ABCDEF' @V305614 01508000
SPACE 1 01509000
SAVNAMES DS 0F COMPARE TABLE FOR SAVEDSYS @V305114 01510000
DC CL8'CMSSEG' @V305114 01511000
DC CL8'CMSVSAM' @V305114 01512000
DC CL8'CMSAMS' @V305114 01513000
DC CL8'CMSDOS' @V305114 01514000
SAVNEND DS 0F @V305114 01515000
SAVNCNT EQU (SAVNEND-SAVNAMES)/8 @V305114 01516000
SPACE 1 01517000
SVTDWDS DC F'3584' LENGTH IN DWORDS OF DMSSVT LOAD @VM03051 01518000
SPACE 1 01519000
RGPRS DC 16F'0' REGISTER SAVE AREA @V305614 01520000
* CHANNEL PROGRAMS TO READ LABEL INFORMATION CYLINDER OF DOS DISK 01521000
* READ CYL 0 HEAD 1 RECORD 5 01522000
DS 0D @VA04692 01523000
LICCW CCW SEEK,LICNUM,CC+SLI,6 @VA04692 01524000
CCW SEARCH,LICNUMA,CC+SLI,5 @VA04692 01525000
CCW TIC,*-8,0,1 @VA04692 01526000
CCW READDATA,SETBUF,CC+SLI,14 @VA04692 01527000
CCW NOOP,0,SLI,1 @VA04692 01528000
SETBUF DC 6X'00' @VA04692 01529000
SETBUFA DC 8X'00' @VA04692 01530000
LICNUMA DC X'0000000105' @VA04692 01531000
LICNUM DC 6X'00' @VA04692 01532000
NIDOS DC CL8'$$A$IPL2' @VA04692 01533000
SPACE 1 01534000
FINDSYS EQU 12 FINDSYS CODE @V305066 01535000
LOADSYS EQU 4 LOADSYS CODE @V305066 01536000
FF EQU X'FF' FENCE FOR PLIST @V305066 01537000
LCLOW DC C'30' LOW VALUE FOR SYSLST LINES/PAGE @V505098 01538000
LCHIGH DC C'99' HIGH VALUE FOR SYSLST LINES/PAGE @V505098 01539000
DOS2314 EQU X'62' DOS DEVICE CODE - 2314 @V305066 01540000
DOS3330 EQU X'63' DOS DEVICE CODE - 3330 @V305066 01541000
DOS333B EQU X'65' DOS DEVICE CODE - 3330-11 @V505098 01542000
DOS3350 EQU X'67' DOS DEVICE CODE - 3350 @V505098 01543000
DOS3340 EQU X'69' DOS DEVICE CODE - 3340 @V305066 01544000
CMS2314 EQU X'08' ADT DEVICE CODE - 2314 @V305066 01545000
CMS3330 EQU X'09' ADT DEVICE CODE - 3330 @V305066 01546000
CMS3350 EQU X'0B' ADT DEVICE CODE - 3350 @V505098 01547000
HEX00 EQU X'00' ... @V305066 01548000
PURGESYS EQU 8 PURGESYS CODE @V305066 01549000
LOGUNIT EQU 256 MAX NUMBER LOGICAL UNITS @V305066 01550000
CON128 EQU 128 ... @V305066 01551000
ARGLEN EQU 8 ARGUMENT LENGTH @V305066 01552000
X EQU C'X' ... @V305066 01553000
CHAR1 EQU C'1' CHARACTER 1 @V305066 01554000
CHAR0 EQU C'0' CHARACTER 0 @V305066 01555000
CHAR9 EQU C'9' CHARACTER 9 @VA04299 01556000
KBYTE EQU C'K' CHARACTER K @VA04299 01557000
BLANK EQU C' ' BLANK @V305066 01558000
TWENTY4 EQU 24 RETURN CODE @V305066 01559000
THIRTY2 EQU 32 @VA04692 01560000
FORTY EQU 40 RETURN CODE @VA09121 01561000
CON175 EQU 175 SIZE OF LTA 1400 BYTES @VA09121 01562000
OPT EQU X'80' LANGUAGE TRANSLATOR OPTIONS @VA09121 01563000
MAXORG EQU 8 @V305614 01564000
FOURBITS EQU 4 @V305614 01565000
RESTWORD EQU 28 @V305614 01566000
ALL EQU 15 @VA05055 01567000
* CHANNEL PROGRAM EQUATES 01568000
SEEK EQU X'07' @VA04692 01569000
SEARCH EQU X'B1' @VA04692 01570000
TIC EQU X'08' @VA04692 01571000
READDATA EQU X'06' @VA04692 01572000
NOOP EQU X'03' @VA04692 01573000
CC EQU X'40' @VA04692 01574000
SLI EQU X'20' @VA04692 01575000
SPACE 01576000
LTORG 01577000
SPACE 2 01578000
SPACE 2 01579000
EJECT 01580000
NUCON 01581000
SYSNAMES @V305114 01582000
DMSFRT @VA00980 01583000
EXTSECT 01584000
ADT @V305001 01585000
BGCOM @V305001 01586000
REGEQU 01587000
TSOBLKS V0019 01588000
END 01589000