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