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