EXC TITLE 'DMSEXC (CMS) VM/370 - RELEASE 6' 00001000
SPACE 2 00002000
* MODULE NAME - 00003000
* 00004000
* DMSEXC (EXEC) 00005000
* 00006000
* FUNCTION - 00007000
* 00008000
* BOOTSTRAP FOR DISK VERSION OF EXEC. 00009000
* 00010000
* ATTRIBUTES - 00011000
* 00012000
* NUCLEUS, REENTRANT, SHARED 00013000
* 00014000
* ENTRY POINTS - 00015000
* 00016000
* DMSEXC(EXEC) 00017000
* 00018000
* ENTRY CONDITIONS - 00019000
* 00020000
* GPR1 = A(EXEC PARAMETER LIST) 00021000
* GPR14 = RETURN ADDRESS 00022000
* GPR15 = A(DMSEXC) 00023000
* PLIST = IMMATERIAL 00024000
* 00025000
* EXIT CONDITIONS - 00026000
* 00027000
* NORMAL - 00028000
* GPR15 = 0(AS RETURNED BY EXECTOR) 00029000
* 00030000
* ERROR - 00031000
* GPR15 NE 0(AS RETURNED BY EXECTOR) 00032000
* GPR15 = -3 : EXECTOR MODULE NOT FOUND 00033000
* 00034000
* CALLS TO OTHER ROUTINES - 00035000
* 00036000
* FREE - GET FREE STORAGE 00037000
* FRET - RETURNS FREE STORAGE 00038000
* STATE - SEE IF EXECTOR MODULE EXISTS 00039000
* RDBUF - READ IN EXECTOR MODULE 00040000
* FINIS - CLOSE THE READING OF EXECTOR MODULE 00041000
* REXX - Execute a REXX procedure HRC371DS 00041100
* 00042000
* EXTERNAL REFERENCES - 00043000
* 00044000
* FVS 00045000
* OPSECT - I/O INFORMATION 00046000
* NUCON - NUCLEUS AREA INFORMATION 00047000
* 00048000
* TABLES / WORKAREAS - 00049000
* 00050000
* STATE - LIST AREA FOR STATE, FINIS, RDBUF 00051000
* BUFFER - read first line of EXEC here HRC371DS 00051100
* FILEID - fileid of EXEC to read HRC371DS 00051200
* 00052000
* REGISTER USAGE - 00053000
* 00054000
* GPR1 = A(PLIST FOR CALLS TO OTHER ROUTINES) 00055000
* GPR2 = A(EXEC PLIST) 00056000
* GPR6 = A(FVS) 00057000
* GPR7 = A(OPSECT) 00058000
* GPR8 = A(NUCON) 00059000
* GPR9 = A(SYSREF) 00060000
* GPR9 = saved R14 while checking for REXX program HRC371DS 00060100
* GPR10 = saved R0 while checking for REXX program HRC371DS 00060200
* GPR11 = saved R1 while checking for REXX program HRC371DS 00060300
* GPR13 = BASE REGISTER 00061000
* GPR14, GPR15 = BALR INSTRUCTIONS 00062000
* GPR0, GPR3, GPR4 = WORK REGISTERS 00063000
* GPR5 = RETURN ADDRESS SAVED 00064000
* 00065000
* NOTES - 00066000
* 00067000
* NONE 00068000
* 00069000
* OPERATION - 00070000
* 00071000
* 0. Read the first line of the user program, and scan HRC371DS 00071100
* to determine if the first word in the line is HRC371DS 00071200
* '/*'. If so, call REXX via SVC 202 to execute HRC371DS 00071300
* the program, then return to our caller. HRC371DS 00071400
* HRC371DS 00071500
* 1. DETERMINE FROM EXLEVEL IN OPSECT WHETHER OR NOT THE 00072000
* EXECTOR MODULE MUST BE READ IN. 00073000
* 00074000
* 2. IF LEVEL=1 THEN CALL STATE TO SEE IF THE MODULE EXISTS. 00075000
* IF THE FILE EXISTS, GET ENOUGH FREE STORAGE(VIA FREE) 00076000
* TO HOLD IT AND READ IT IN(RDBUF). ONCE THE FILE IS 00077000
* READ IN, CALL FINIS TO END THE READING OPERATION, 00078000
* AND SET THE EXECRUN FLAG ON. 00079000
* 00080000
* 3. SET THE ENTRY CONDITIONS REQUIRED FOR EXECTOR AND 00081000
* BALR THERE. 00082000
* 00083000
* 4. DECREMENT EXLEVEL AND STORE THE NEW VALUE. IF IT IS 0, 00084000
* RETURN THE FREE STORAGE(VIA FRET). 00085000
* 00086000
* 5. SET EXECRUN FLAG OFF AND RETURN. 00087000
*. 00088000
EJECT 00089000
EXEC CSECT 00090000
DMSEXC EQU EXEC 00091000
ENTRY DMSEXC 00092000
LR R13,R15 ADDRESSABILITY 00093000
USING EXEC,R13 INTO R13, 00094000
USING NUCON,R0 ACCESS NUCLEUS AREA INFORMATION 00095000
LR R5,R14 SAVE RETURN-REGISTER IN R5 (SAFE THERE) 00096000
CLI 8(R1),FENCE EXECNAME SPECIFIED ? @VM03113 00097000
BE ERR001 NO, ERROR @VM03113 00098000
SPACE 1 HRC371DS 00098010
* The exec program can be written either in REXX or EXEC. We HRC371DS 00098020
* read the first line of the file, and if the first word in HRC371DS 00098030
* that line begins with '/*', then it is a REXX program, and HRC371DS 00098040
* we invoke DMSREX to execute it. Otherwise we fall through HRC371DS 00098050
* and let EXEC handle it. HRC371DS 00098060
LR R9,R14 save return address HRC371DS 00098070
LR R10,R0 save eplist pointer HRC371DS 00098080
LR R11,R1 save plist pointer HRC371DS 00098090
DMSFREE DWORDS=66,TYPE=NUCLEUS,TYPCALL=BALR HRC371DS 00098100
LR R8,R1 save memory address HRC371DS 00098110
USING WORK,R8 HRC371DS 00098120
LA R7,256(R8) map FSCB on top of BUFFER1 HRC371DS 00098130
USING FSCBD,R7 HRC371DS 00098140
MVC FSCBCOMM(8),=C'RDBUF ' HRC371DS 00098150
MVC FSCBFN(8),8(R11) copy exec name HRC371DS 00098160
MVC FSCBFT(10),=C'EXEC * ' HRC371DS 00098170
MVC FSCBITNO(2),=H'1' HRC371DS 00098180
ST R8,FSCBBUFF HRC371DS 00098190
MVC FSCBSIZE,=F'256' buffer length HRC371DS 00098200
MVC FSCBNOIT(2),=H'1' HRC371DS 00098210
LR R1,R7 address of FSCB HRC371DS 00098220
L R15,ARDBUF HRC371DS 00098230
BALR R14,R15 read the file's first line HRC371DS 00098240
BNZ NOTREXX let EXEC handle any read error HRC371DS 00098250
MVC FSCBCOMM(8),=C'FINIS ' HRC371DS 00098260
L R15,AFINIS close the file HRC371DS 00098270
BALR R14,R15 HRC371DS 00098280
* Now scan the line we read, looking for '/*'. HRC371DS 00098290
L R5,FSCBNORD get bytes read HRC371DS 00098300
DROP R7 HRC371DS 00098310
LR R3,R8 start of line into R3 HRC371DS 00098320
LA R4,1 increment HRC371DS 00098330
AR R5,R3 end of line into R5 HRC371DS 00098340
SCANLOOP DS 0H HRC371DS 00098350
CLI 0(R3),C' ' skip blanks HRC371DS 00098360
BNE CHECK found non-blank HRC371DS 00098370
BXLE R3,R4,SCANLOOP keep looking HRC371DS 00098380
CHECK DS 0H HRC371DS 00098390
CLC 0(2,R3),=C'/*' found REXX comment? HRC371DS 00098400
BNE NOTREXX no, continue with EXEC HRC371DS 00098410
* We have an exec written in REXX. Build new regular and HRC371DS 00098420
* extended plists with REXX as the command name. HRC371DS 00098430
MVC BUFFER1(256),0(R11) copy original plist HRC371DS 00098440
MVC BUFFER1(8),=C'DMSREX ' overlay EXEC with REXX HRC371DS 00098450
LA R1,BUFFER1 recover R1 HRC371DS 00098460
ST R11,BUFFER0 HRC371DS 00098470
ICM R1,8,BUFFER0 copy flag byte from original R1 HRC371DS 00098480
MVC BUFFER0(7),=C'DMSREX ' insert command name HRC371DS 00098490
L R3,0(R10) get start of eplist HRC371DS 00098500
L R4,8(R10) end of old argstring HRC371DS 00098510
MVC BUFFER0+7(249),0(R3) copy eplist HRC371DS 00098520
SR R4,R3 compute length of old argstring HRC371DS 00098530
LA R3,BUFFER0 HRC371DS 00098540
ST R3,EPLIST store as eplist command HRC371DS 00098550
LA R3,7(R3) start of arguments HRC371DS 00098560
ST R3,EPLIST+4 store as eplist argbeg HRC371DS 00098570
AR R3,R4 add length of arguments HRC371DS 00098580
ST R3,EPLIST+8 store a eplist argend HRC371DS 00098590
SR R3,R3 HRC371DS 00098600
ST R3,EPLIST+12 HRC371DS 00098610
LA R0,EPLIST point R0 at eplist HRC371DS 00098620
* At last we invoke the REXX interpreter. HRC371DS 00098630
SVC 202 should we set EXECRUN flag??? HRC371DS 00098640
DC AL4(*+4) HRC371DS 00098650
LR R3,R15 save return code from REXX HRC371DS 00098660
DMSFRET DWORDS=66,LOC=WORK,TYPCALL=BALR HRC371DS 00098670
LR R15,R3 recover return code HRC371DS 00098680
BR R9 return to our caller HRC371DS 00098690
* Return our memory, restore registers, and let EXEC proceed HRC371DS 00098700
NOTREXX DS 0H continue with normal EXEC... HRC371DS 00098710
DMSFRET DWORDS=66,LOC=WORK,TYPCALL=BALR HRC371DS 00098720
DROP R8 HRC371DS 00098730
LR R5,R9 recover R5 HRC371DS 00098740
LR R0,R10 recover R0 HRC371DS 00098750
LR R1,R11 recover R1 HRC371DS 00098760
SPACE 1 HRC371DS 00098770
LR R2,R1 SAVE POINTER TO P-LIST, 00099000
L R7,AOPSECT A(IO INFORMATION) 00100000
USING OPSECT,R7 ... 00101000
LM R3,R4,EXLEVEL EXEC LEVEL INTO R3, 1 --> R4 00102000
AR R3,R4 ADD 1 TO LEVEL, 00103000
CR R3,R4 IF LEVEL = 1, MUST READ IN EXECTOR MODU, 00104000
BNE GETBASE READ FROM DISK FOR ... @V305614 00105000
SPACE 1 00106000
MVC PLIST(SIZDUM),STATE SET UP STATE & RDBUF PLIST @V305614 00107000
OI MISFLAGS,NEGITS GUILTY UNTIL PROVEN INNOCENT @VA04594 00108000
STLOOP LA R1,PLIST POINT TO STATE PLIST @V305614 00109000
LH R12,FFD FORCE ERROR -3 IF ERROR @V305614 00110000
ST R12,EXNUM INITIALIZE NEGATIVE @V305614 00111000
L R15,=V(DMSLFS) CALL "FSTLKP" @VM03083 00112000
BALR R14,R15 LOADMOD ON DISK ? @V305614 00113000
BZ LOADEX YES, LOADMOD IT @V305614 00114000
SPACE 1 00115000
CLI FILEMODE,E2 WAS THAT FOR THE 'S' DISK ? @V305066 00116000
BE SETRET IF SO, WE'RE ALL DONE @V305614 00117000
B TRYSYS OTHERWISE, TRY SAVED SYSTEM @V305614 00118000
SPACE 1 00119000
LOADEX LR R6,R1 GET FST ADDRESS @V305614 00120000
USING FSTD,R6 ..... @V305614 00121000
L R1,FSTLRECL GET MODULE SIZE @V305614 00122000
ST R1,FILEBYTE STORE WHERE NEEDED @V305614 00123000
LR R11,R0 GET ADT ADDRESS @V305614 00124000
USING ADTSECT,R11 ..... @V305614 00125000
SPACE 1 00126000
MVC FILEMODE(2),ADTM SET PLIST FILEMODE @V305614 00127000
LA R0,7(,R1) ROUND UPWARD AND.. @V305614 00128000
SRA R0,3 SHIFT FOR DWORDS @V305614 00129000
* GET ENOUGH FREE STORAGE FOR EXECTOR MODULE .... 00130000
DMSFREE DWORDS=(0),TYPE=NUCLEUS,TYPCALL=BALR @VM03083 00131000
ST R1,FILEBUFF STORE ADDRESS IN PLIST AND @V305614 00132000
STM R0,R1,EXNUM SAVE THESE FOR LATER FRET CALL @V305614 00133000
LA R1,PLIST READ IN EXECTOR @V305614 00134000
SVC 202 INTO FREE STORAGE @V305614 00135000
DC AL4(SETRET) @V305614 00136000
L R15,AFINIS FINIS THE FILE @V305614 00137000
BALR R14,R15 ..... @V305614 00138000
B EXECIN PROCEED.. @V305614 00139000
SPACE 1 00140000
NOSYS MVC FILEMODE(2),SMODE LETS TRY FOR THE 'S' DISK @V305614 00141000
B STLOOP LAST ATTEMPT @V305614 00142000
SPACE 1 00143000
TRYSYS TM DCSSFLAG,DCSSLDED+DCSSAVAL CHECK DCSS STATUS @V305614 00144000
BZ NOSYS BR, IF NO DCSS AVAILABLE @V305614 00145000
BM LOADSYS BR, IF DCSS NOT LOADED @V305614 00146000
L R8,ACMSSEG GET SEGMENT ADDRESS @V305614 00147000
B SKIPLOAD AND GO AROUND LOADSYS @V305614 00148000
SPACE 1 00149000
LOADSYS L R10,ASYSNAMS POINT TO SAVEDSYS NAME TABLE @V305614 00150000
USING SYSNAMES,R10 SYSNAMES ADDRESSABILITY @V305614 00151000
LA R8,CMSSEG PULL OUT CMSSEG NAME @V305614 00152000
DROP R10 ..... @V305614 00153000
SR R9,R9 INDICATE LOADSYS FUNCTION @V305614 00154000
DC X'83890064' LOADSYS @V305614 00155000
BC 3,NOSYS BR, MIX UP SOMEWHERE @V305614 00156000
SPACE 1 00157000
ST R8,ACMSSEG PLUG NUCLEUS SEGMENT ADDRESS @V305614 00158000
OI DCSSFLAG,DCSSLDED LET EVERYONE KNOW @V305614 00159000
SKIPLOAD L R8,4(,R8) LOAD EXECTOR ENTRY ADR @V305614 00160000
L R8,0(,R8) ONE EXTRA LOAD NEEDED ... @VM03154 00161000
ST R8,EXADD AND SAVE ADDRESS OF DMSEXT @VM03154 00162000
EXECIN OI EXECFLAG,EXECRUN INDICATE THAT EXEC LIVES @V305614 00163000
NI MISFLAGS,X'FF'-NEGITS VERDICT: INNOCENT @VA04594 00164000
GETBASE ST R3,EXLEVEL STORE NEW LEVEL, 00165000
LR R1,R2 RESTORE POINTER TO P-LIST IN R1, 00166000
L R15,EXADD GET ADDRESS OF EXECTOR, 00167000
BALR R14,R15 CALL "EXECTOR" WHO REALLY DOES THE WORK 00168000
NI MISFLAGS,X'FF'-NEGITS RESET NEGITS @VA06277 00169000
L R13,AEXEC RESTORE ADDRESSIBILITY 00170000
L R7,AOPSECT RELOAD A(IO INFORMATION) 00171000
LM R3,R4,EXLEVEL DECREMENT EXEC NEST LEVEL @V305614 00172000
SR R3,R4 LEVEL 00173000
ST R3,EXLEVEL AND STORE NEW VALUE. 00174000
BNZ OUT IF NOT ZERO, KEEP EXECTOR IN CORE 00175000
LR R12,R15 SAVE THE RETURN CODE @VA04594 00176000
NOFILE EQU * 00177000
LM R0,R1,EXNUM RETURN FREE STORAGE 00178000
LTR R0,R0 SHARED SYSTEM ? @V305614 00179000
BM NOFILE1 YES, NO STORAGE TO FREE @V305614 00180000
DMSFRET DWORDS=(0),LOC=(1),TYPCALL=BALR @VM03083 00181000
NOFILE1 EQU * 00182000
L R1,EXADD+4 GET POINTER TO GLOBAL FREE STOR @V305614 00183000
LA R0,7 NUMBER OF DWORDS @V305614 00184000
DMSFRET DWORDS=(0),LOC=(1),TYPCALL=BALR @VM03083 00185000
NI EXECFLAG,255-EXECRUN TURN OFF EXECRUN FLAG 00186000
SETRET LR R15,R12 PUT RETURN CODE INTO R15 @V305614 00187000
* 00188000
OUT LR R14,R5 RESTORE RETURN-REGISTER (WAS SAFE IN R5) 00189000
BR R14 RETURN TO CALLER 00190000
* 00191000
FFD DC H'-3' ERROR RETURN CODE @V305614 00192000
SMODE DC CL2'S ' FOR 'S' DISK STATE @V305614 00193000
E2 EQU X'E2' @V305066 00194000
FENCE EQU X'FF' PLIST FENCETESTER @VM03113 00195000
TWENTY4 EQU 24 ERROR RETURN CODE @VM03113 00196000
* 00197000
DS 0F LIVE P-LIST FOR STATE = DUMMY FOR RDBUF & FINIS: 00198000
STATE DC CL8'RDBUF' (NOTE - OK FOR ALL 3 - NO FOOLIN') 00199000
DC CL8'DMSEXT' 00200000
DC CL8'MODULE' 00201000
STATEFM DC CL2'-S' ALL BUT 'S' DISK (TEMPORARY) @V305614 00202000
DC H'0002' ITEM 2 = CORE-IMAGE (FOR RDBUF) 00203000
DC A(0) END OF STATE PART OF P-LIST 00204000
DC F'0' WILL BECOME NO. OF BYTES TO READ 00205000
DC CL2'V' VARIABLE FILE (MODULE) 00206000
DC H'1' READ ONE RECORD (ITEM NO. 2) 00207000
* 00208000
SIZDUM EQU *-STATE SIZE DUMMY P-LIST IN BYTES (FOR MVC) 00209000
* 00210000
SPACE 3 00211000
* ABEND RECOVER ENTRY POINT 00212000
ENTRY DMSEXCAB 00213000
DMSEXCAB EQU * 00214000
L R13,AEXEC SET BASE REGISTER 00215000
LR R5,R14 SAVE RETURN REGISTER 00216000
L R6,AFVS POINT TO FVSECT 00217000
L R7,AOPSECT POINT TO OPSECT 00218000
SR R12,R12 ZERO RETURN CODE FROM HERE @V305614 00219000
ST R12,EXLEVEL SET ZERO EXEC LEVEL @V305614 00220000
TM EXECFLAG,EXECRUN IS EXECTOR IN CORE? 00221000
BO NOFILE GO RELEASE IT IF SO 00222000
B SETRET OTHERWISE, JUST RETURN @V305614 00223000
SPACE 2 00224000
ERR001 EQU * @VM03113 00225000
DMSERR NUM=001,LET=E,CSECT=EXC,TEXT='NO FILENAME SPECIFIED' 00226000
LA R15,TWENTY4 SET BAD RETURN CODE @VM03113 00227000
B OUT @VM03113 00228000
LTORG 00229000
EJECT 00230000
SPACE 1 HRC371DS 00230100
WORK DSECT HRC371DS 00230200
BUFFER0 DS CL256 HRC371DS 00230300
BUFFER1 DS CL256 HRC371DS 00230400
EPLIST DS 4A HRC371DS 00230500
FSCBD HRC371DS 00230600
FSTD , @V305614 00231000
ADT , @V305614 00232000
IO 00233000
NUCON 00234000
SYSNAMES 00235000
* 00236000
REGEQU 00237000
END 00238000