EDM TITLE 'DMMEDM (IPCS) VM/370 - RELEASE 6' 00001000
*. 00002000
* MODULE NAME - DMMEDM 00003000
* 00004000
* FUNCTION - TO EDIT AND PRINT A CP DUMP. 00005000
* 00006000
* ATTRIBUTES - RUNS IN A VIRTUAL MACHINE UNDER CMS 00007000
* CONTROL 00008000
* 00009000
* ENTRY POINTS - DMMEDMP 00010000
* 00011000
* ENTRY CONDITIONS - GPR 1=ADDRESS OF OPTION LIST 00012000
* GPR 13=SVC SAVEAREA ADDRESS 00013000
* GPR 14=RETURN ADDRESS 00014000
* GPR 15=ENTRY POINT ADDRESS 00015000
* 00016000
* EXIT CONDITIONS - 1. IF ERROR IS ENCOUNTERED READING TH 00017000
* CP DUMP FILE. GPR= NON ZERO. REFER TO 00018000
* RDBUF FOR CODE MEANINGS. 00019000
* 00020000
* CALLS TO OTHER - RDBUF VIA SVC TO READ IN DUMP FILE. 00021000
* ROUTINES ERASE VIA SVC TO DELETE THE CP DUMP 00022000
* FILE FROM THE P-DISK. 00023000
* CLOSIO VIA SVC TO CLOSE OUT PRINTER. 00024000
* PRINTR VIA SVC TO PRINT A LINE ON 00025000
* THE PRINTER. 00026000
* TYPLIN VIA SVC TO WRITE MESSAGE TO 00027000
* CONSOLE. 00028000
* 00029000
* 00030000
* EXTERNAL REFERENCES - NONE 00031000
* 00032000
* 00033000
* TABLES AND WORK AREAS - BUFF,BUFF2,HOLD,WORK,WORK2 00034000
* 00035000
* 00036000
* REGISTER USAGE - GPR 0-7= SCRATCH 00037000
* GPR 8= BUFF 00038000
* GPR 9= BUFF2 00039000
* GPR 10= PRTLINE 00040000
* GPR 11= DMMEDMP+4096 00041000
* GPR 12= DMMEDMP BASE 00042000
* GPR 13= SAVEAREA ADDRESS 00043000
* GPR 14= RETURN ADDRESS 00044000
* GPR 15= RETURN CODE 00045000
EJECT 00046000
* 00047000
* 00048000
* NOTES - THE VDUMP EXEC PROCEDURE INVOKES 00049000
* DMKFDM AND DMMEDM. 00050000
* RE-ASSEMBLE BECAUSE SIZE OF 'VCONCTL' DSECT WAS CHANGED 00051000
* 00052000
* 00053000
* OPERATION - 1. READS THE CP DUMP FROM THE CMS FILE. 00054000
* 2. EDIT AND PRINT IN A READABLE FORMAT THE 00055000
* FOLLOWING: 00056000
* A. PSW'S 00057000
* B. GPR'S, CREGS, AND FPREGS 00058000
* C. TOD CLOCK, CLOCK COMPARATOR, CPU TIMER, 00059000
* AND PREFIX REGISTER 00060000
* D. CSW AND CAW 00061000
* E. EXT, SVC, PGM, MCK, AND I/O PSWS 00062000
* F. LOAD MAP 00063000
* G. REAL DEVICE BLOCKS AND ASSOCIATED CONTROL 00064000
* BLOCKS; 00065000
* - RCHBLOK,RCUBLOK,RDEVBLOK,IOBLOK,RESPLCTL, 00066000
* SFBLOK,IOERBLOK,ALOCBLOK,RECBLOK 00067000
* H. SFBLOK CHAINS FOR READER,PRINTER,AND 00068000
* PUNCH FILES. 00069000
* I. CORE TABLE 00070000
* J. EACH USERS VIRTUAL DEVICE BLOCKS AND 00071000
* ASSOCIATED CONTROL BLOCKS 00072000
* - VMBLOK,VCHBLOK,VCUBLOK,VDEVBLOK,VSPLCTL, 00073000
* SFBLOK,VCONCTL 00074000
* K. EACH USERS SEGMENT,PAGE,AND SWAP TABLES. 00075000
* 3. PRINT A HEX DUMP OF CORE SUPPRESSING PRINT 00076000
* LINES THAT ARE DUPLICATES OF THE PRECEDING 00077000
* LINES. 00078000
* 4. OPERATOR OPTIONS WILL ALLOW; 00079000
* A. PREVENTION OF A FORMATTED DUMP TO PRINT 00080000
* B. PREVENTION OF A HEX DUMP TO PRINT 00081000
* C. THE CMS DUMP FILE TO BE ERASED. 00082000
* D. A LOAD MAP TO BE PRINTED. 00083000
* E. PRINTING OF DUMP AT THE USERS CONSOLE. 00084000
* F. DEFAULT OF OPTIONS WILL CAUSE A FORMATTED 00085000
* AND HEX DUMP TO BE PRINTED ON DEVICE 00E. 00086000
*. 00087000
* 5. IF A CHANNEL 12 CONDITION IS DETECTED 00088000
* (FROM A VIRTUAL 3211) THEN THE LINE COUNT 00089000
* IS SET TO 60 SO THAT AN EJECT WILL BE PERFORMED 00090000
* ON THE NEXT REQUEST TO PRINT A LINE. 00091000
* CHANNEL 9 RETURN CODES ARE IGNORED. 00092000
EJECT 00093000
DMMEDM CSECT @VA04250 00094000
USING *,R15 @VA04250 00095000
LM R11,R13,BASES LOAD BASE REGS @VA04250 00096000
USING DMMEDM,R11,R12,R13 @VA04250 00097000
DROP R15 @VA04250 00098000
ENTRY DUMPLIST @VA04250 00099000
ENTRY RETN @VA04250 00100000
STM R14,R1,REGSAVE @V407510 00101000
L R8,=A(ITEM2) SET BUFFER ADDRESS @VA04250 00102000
USING ITEM2,R8 @VA04250 00103000
MVC REGSAVE+K4(K4),=F'0' @V407510 00104000
WRTERM VDUMSG,VDUMSGL WRITE HEADER @VA04250 00105000
L R1,REGSAVE+K12 RESTORE R1 TO PARM LIST @V407510 00106000
SPACE 1 00107000
B CHKOP @VA04250 00108000
BASES DC A(DMMEDM,DMMEDM+4096,DMMEDM+8192) @VA04250 00109000
VDUMSG DC C'VM/370 ABEND DUMP EXTRACT, EDIT, AND PRINT' @VA04250 00110000
VDUMSGL EQU *-VDUMSG @VA04250 00111000
SPACE 3 00112000
* ********************************************* 00113000
* * DETERMINE OPTIONS SPECIFIED BY USER * 00114000
* ********************************************* 00115000
SPACE 3 00116000
CHKOP LA R7,8(R1) POINT TO OPTIONS LIST @VA04250 00117000
CLI 0(R7),XFF ANY OPTIONS ?? @VA04250 00118000
BE READFILE NO, READ CP DUMP @VA04250 00119000
LA R4,OPLIST PARM LIST @VA04250 00120000
CLC 0(4,R7),=CL4'DUMP' FIRST PARM DUMP ?? @VA04250 00121000
BE DOEDM YES, EDIT SPECIFIC FILE @VA04250 00122000
CLC 0(3,R7),=C'PRB' FIRST PARM 'PRB'? @VA04250 00123000
BE DOEDM YES, EDIT SPECIFIC FILE @VA04250 00124000
OPLOOP CLC 0(8,R7),0(R4) COMP PARM @VA04250 00125000
BE FNDOP FOUND @VA04250 00126000
CLI 0(R4),XFF AT END @VA04250 00127000
BE ERROP YES @VA04250 00128000
LA R4,8(R4) NEXT PARM @VA04250 00129000
B OPLOOP REPEAT @VA04250 00130000
FNDOP MVI 7(R4),X01 FLAG AS FOUND @VA04250 00131000
NXTOP LA R7,8(R7) NEXT PARM @VA04250 00132000
LA R4,OPLIST RESET LIST @VA04250 00133000
CLI 0(R7),XFF AT END OF OPTION LIST ?? @VA04250 00134000
BNE OPLOOP NO, LOOK FOR MORE @VA04250 00135000
B TSTFILE DONE @VA04250 00136000
DOEDM MVC DUMP,0(R7) SAVE DUMP FILE NAME @VA04250 00137000
B NXTOP GET MORE @VA04250 00138000
ERROP MVC ERR1OP,0(R7) ERROR PARM @VA04250 00139000
B ERROR1 EXIT @VA04250 00140000
SPACE 2 00141000
TSTFILE CLI DUMP,C'D' DUMP SPECIFIC FILE ?? @VA04250 00142000
BE SETEDM YES, SET UP EDIT @VA04250 00143000
READFILE DS 0H @VA04250 00144000
CLI DUMP,C'P' DUMP SPECIFIC FILE ? @VA04250 00145000
BNE RDUMP NO, READ CP DUMP @VA07214 00146000
SPACE 2 00147000
SETEDM MVC DUMPFILE+8(8),DUMP SET FSCB @VA04250 00148000
FSSTATE FSCB=DUMPFILE,ERROR=ERROR3 LOOK FOR FILE @VM08728 00149000
MVC PRBFN,DUMP MOVE REPORT FILENAME TO DUMP @VA04250 00150000
LA R2,PRBFILE POINT TO PROBLEM REPORT FN FT @VA04250 00151000
FSSTATE (R2),ERROR=NOREPORT @VA04250 00152000
XC DATA,DATA CLEAR OUTPUT DATA @VA04250 00153000
MVI CTL,SPACE1 SET FOR SINGLE SPACING @VA04250 00154000
PNLOOP FSREAD (R2),ERROR=NOREPORT,BUFFER=DATA,BSIZE=80 @VA04250 00155000
BAL R6,PRINTA GO PRINT THIS LINE OF REPORT @VA04250 00156000
B PNLOOP PRINT UNTIL END OF FILE @VA04250 00157000
NOREPORT MVI CTL,SPACE2 RESET TO DOUBLE SPACING @VA04250 00158000
MVC DMPP,DUMP GET NAME @VA04250 00159000
WRTERM DMSG,DMSGL @VA04250 00160000
MVC BSIZE(4),=F'8192' SET BUFFER SIZE FOR 2 PAGES @VA04250 00161000
B EDITDUMP DO EDIT DUMP @VA04250 00162000
SPACE 2 00163000
RDUMP BAL R2,READCPR READ CP RECORD @VA04250 00164000
*********************************************************** 00165000
ST R1,SAVEPRB SAVE R1 FOR LATER @VA05446 00166000
L R1,REGSAVE+K12 RESTORE R1 TO PARM LIST @V407510 00167000
L R15,=V(DMMINI) POINT TO DATA EXTRACTION RTN @VA05446 00168000
BALR R14,R15 GO ASSIGN A DUMP NUMBER @VA05446 00169000
L R1,SAVEPRB RESTORE R1 @VA05446 00170000
LA R4,DUMPLIST GET NAME OF FILE @VA07214 00171000
MVC DUMP,0(R4) SAVE FILE NAME @VA07214 00172000
MVC DUMPFILE+8(8),0(R4) SET FSCB NAME @VA07214 00173000
BAL R2,WTREC WRITE FIRST ITEM .. LOAD MAP @VA04250 00174000
BAL R2,READCPR GET NEXT CP RECORD @VA04250 00175000
BAL R2,WTREC WRITE INFO REC...REWRITE LATER @VA04250 00176000
L R10,=A(BUFF) BASE @VA04250 00177000
USING DMPINREC,R10 BASE @VA04250 00178000
MVC I2GRS(4*16),DMPGPRS SAVE GREGS @VA04250 00179000
MVC I2CRS(4*16),DMPCRS SAVE CREGS @VA04250 00180000
MVC I2FPRS(4*8),DMPFPRS SAVE FPREGS @VA04250 00181000
MVC I2TOD(8*4),DMPTODCK SAVE CLOCKS @VA04250 00182000
MVC I2LCORE(256),DMPLCORE SAVE LOW CORE @VA04250 00183000
MVC I2SYSRV,DMPSYSRV ***** DMPSYSRV ******* @VA04250 00184000
MVC I2PRFRG,DMPPRFRG SAVE PREFIX REGISTER @V407510 00185000
MVC I2AB,DMPABEND SAVE ABEND CODE @V407510 00186000
MVC I2PROCA,DMPPROCA SAVE PROCESSOR ADDRESS @V407510 00187000
* NOW BUILD ITEM TABLE FROM BIT MAP 00188000
SR R2,R2 CLEAR @VA04250 00189000
L R4,=A(ITEMTBL) BASE OF TABLE @VA04250 00190000
LA R7,128 MAX WORDS @VA04250 00191000
LA R3,DMPPGMAP BASE OF BIT MAP @VA04250 00192000
NXTWD L R5,0(R3) GET FIRST WORD @VA04250 00193000
LA R6,32 COUNT @VA04250 00194000
TSTBIT LTR R5,R5 TEST FOR HI BIT @VA04250 00195000
BNM NXTBIT NO @VA04250 00196000
STH R2,0(R4) SAVE PAGE NUMBER IN ITEM TABLE @VA04250 00197000
LA R4,2(R4) UP ITEM INDEX @VA04250 00198000
NXTBIT LA R2,1(R2) UP PAGE NUMBER @VA04250 00199000
SLL R5,1 SHIFT FOR NEXT TEST @VA04250 00200000
BCT R6,TSTBIT REPEAT @VA04250 00201000
LA R3,4(R3) NEXT WORD @VA04250 00202000
BCT R7,NXTWD LOOP FOR ALL OF MAP @VA04250 00203000
MVC 0(2,R4),=X'FFFF' MARK END OF TABLE @VA04250 00204000
SPACE 2 00205000
* ITEM TABLE CREATED 00206000
BAL R2,READCPR READ KEY RECORD 1 @VA04250 00207000
BAL R2,WTREC WRITE AS ITEM 3 @VA04250 00208000
BAL R2,READCPR READ KEY RECORD 2 @VA04250 00209000
BAL R2,WTREC WRITE AS ITEM 4 @VA04250 00210000
BAL R2,READCPR READ PAGE 0 RECORD @VA04250 00211000
MVC 0(256,R10),I2LCORE SET PAGE 0 LOW CORE @VA04250 00212000
BAL R2,WTREC WRITE AS ITEM 5 @VA04250 00213000
USING PSA,R10 BASE @VA04250 00214000
MVC I2DATE,DATE @VA04250 00215000
* CALCULATED TIME OF CRASH 00216000
* THIS CODE FROM DMKCVTDT 00217000
LM R0,R1,I2TOD GET TOD CLOCK AT CRASH @VA04250 00218000
SL R1,TODATE+4 MINUS BASE AT MIDNITE @VA04250 00219000
BC 11,*+8 OVERFLOW ?? @VA04250 00220000
SL R0,=F'1' ADJUST @VA04250 00221000
SL R0,TODATE .. @VA04250 00222000
CL R0,=X'000141DD' IS THIS MAX. FOR ONE DAY ? @VA01199 00223000
BH EDMMSG YES, BYPASS TIME @VA01199 00224000
SRDL R0,12 MICROSECS SINCE MIDNITE @VA04250 00225000
D R0,=F'1000000' CONVERT TO SECONDS @VA04250 00226000
SR R0,R0 FORGET REMAINDER @VA04250 00227000
D R0,=F'3600' GET HOURS @VA04250 00228000
CVD R1,WORK3 .. @VA04250 00229000
UNPK I2TIME(4),WORK3+6(3) .. @VA04250 00230000
MVI I2TIME+2,C':' EDIT @VA04250 00231000
LR R1,R0 REMAINING SECONDS @VA04250 00232000
SR R0,R0 CLEAR @VA04250 00233000
D R0,=F'60' GET MINUTES @VA04250 00234000
CVD R1,WORK3 CONVERT @VA04250 00235000
UNPK I2TIME+3(4),WORK3+6(3) .. @VA04250 00236000
MVI I2TIME+5,C':' EDIT @VA04250 00237000
CVD R0,WORK3 CONVERT SECONDS @VA04250 00238000
UNPK I2TIME+6(2),WORK3+6(2) .. @VA04250 00239000
OI I2TIME+7,XF0 SET ZONE @VA04250 00240000
EDMMSG EQU * @VA01199 00241000
MVC I2RCH(4*4),ARIOCT @VA04250 00242000
MVC I2SPL(4*3),ARSPPR @VA04250 00243000
MVC I2COR,ACORETBL @VA04250 00244000
MVC I2VM,ASYSVM @VA04250 00245000
MVC I2MPREF,PREFIXA SAVE MAIN PSA ADDR @V407510 00246000
MVC I2APREF,PREFIXB SAVE ATTACHED PSA ADDR @V407510 00247000
BAL R2,WTREC2 WRITE AS ITEM 2 @VA04250 00248000
LA R2,5 RESET TO ITEM 5 @VA04250 00249000
STH R2,ITEMNO .. @VA04250 00250000
* TYPE CAUSE OF DUMP AND ASK TO CONTINUE 00251000
MVC DATA(LABM),ABMSG ABEND MSG @VA04250 00252000
MVC DATA+K25(K3),I2AB GET ABEND CODE @V407510 00253000
L R1,I2AB GET NUMBER @V407510 00254000
N R1,=X'000000FF' ISOLATE NUMBER @VA04250 00255000
CVD R1,WORK3 CONVERT @VA04250 00256000
OI WORK3+7,X0F SET ZONE @VA04250 00257000
UNPK WORK3(3),WORK3+6(2) @VA04250 00258000
MVC DATA+28(3),WORK3 GET ABEND CODE @VA00803 00259000
MVC DATA+39(8),DATE MOVE MM/DD/YY @VA00803 00260000
MVC DATA+57(8),I2TIME MOVE HH:MM:SS @VA00803 00261000
MVC DATA+K66(K10),=C'PROCESSOR ' @V407510 00262000
LH R1,I2PROCA GET PROCESSOR ADDRESS @V407510 00263000
CVD R1,WORK3 CONVERT TO DECIMAL @V407510 00264000
OI WORK3+K7,X0F SET ZONE @V407510 00265000
UNPK WORK3(K2),WORK3+6(K2) PUT IN FINAL FORM @V407510 00266000
MVC DATA+K76(K2),WORK3 MOVE PROCESSOR ADDRESS @V407510 00267000
WRTERM DATA,K78 @V407510 00268000
REREAD WRTERM ASKMSG,ASKMSGL @VA04250 00269000
RDTERM DATA,EDIT=YES @VA04250 00270000
CLC DATA(3),=CL3'NO ' @VA04250 00271000
BE NOFDMP NO DUMP WANTED @VA04250 00272000
CLC DATA(4),=CL4'YES ' IS IT YES REPLY ?? @VA04250 00273000
BNE REREAD NO, ASK AGAIN @VA04250 00274000
MVC CMP,DUMP FILE NAME @VA04250 00275000
WRTERM CMSG,CMSGL CONFIRM DUMP @VA04250 00276000
LOOP BAL R2,READCPR GET NEXT CP RECORD @VA04250 00277000
BAL R2,WTREC WRITE IT OUT @VA04250 00278000
B LOOP DO UNTIL READCPR GIVES EOF @VA04250 00279000
SPACE 3 00280000
READCPR L R6,=A(BUFF) WHERE TO READ @VA04250 00281000
LA R7,X'00C' READER ADDRESS @VA04250 00282000
DC X'83670034' DIAG...READ CP DUMP FILE SEQ'LY @VA04250 00283000
BZR R2 RETURN - DATA IS IN THE BUFFER @VM08728 00284000
* 00285000
DIAGRTN BC 4,DMPEND1 EOF @VA04250 00286000
BC 2,NODMP READER EMPTY @VA04250 00287000
WRTERM DM0,DM0L DIAG FAILED @VA04250 00288000
BAL R2,ERASE @VA04250 00289000
LA R15,21 RETURN @VA04250 00290000
RETN DS 0H @V407510 00291000
ST R15,REGSAVE+K4 @V407510 00292000
EXIT DS 0H @V407510 00293000
LM R14,R15,REGSAVE RESTORE REGS @V407510 00294000
BR R14 RETURN TO CMS @VA04250 00295000
SPACE 3 00296000
WTREC LH R1,ITEMNO GET ITEM NUMBER @VA04250 00297000
LA R1,1(R1) BUMP @VA04250 00298000
STH R1,ITEMNO SET FOR WRITE @VA04250 00299000
FSWRT FSWRITE FSCB=DUMPFILE,BUFFER=BUFF,ERROR=ERRWRT @VA04250 00300000
BR R2 @VA04250 00301000
* 00302000
WTREC2 FSWRITE FSCB=DUMPFILE,BUFFER=ITEM2,ERROR=ERRWRT,RECNO=2 00303000
BR R2 @VA04250 00304000
SPACE 2 00305000
DMPEND1 MVC DM1P,DUMP SET FILE NAME @VA04250 00306000
WRTERM DM1,DM1L @VA04250 00307000
FSCLOSE FSCB=DUMPFILE SAVE DUMP FILE @VA04250 00308000
*************************************************************** 00309000
* CALL DMMEXT FOR EXTRACTION 00310000
*************************************************************** 00311000
L R15,=V(DMMEXT) POINT TO EXTRACTION PROGRAM @VA04250 00312000
BALR R14,R15 GO DO DATA EXTRACTION @VA04250 00313000
BAL R2,CLRDR CLOSE DUMP READER FILE @VA04250 00314000
B SETEDM SET UP TO EDIT DUMP @VA04250 00315000
EJECT 00316000
* ******************************************************** 00317000
* * THIS ROUTINE WILL PRINT OUT TIME,DATE,CAUSE * 00318000
* * GPRS,CONTROL REGS,FPRS, AND THE PSWS. * 00319000
* ************************************************** 00320000
SPACE 3 00321000
EDITDUMP DS 0H @VA04250 00322000
DROP R10 @VA04250 00323000
FSREAD FSCB=DUMPFILE,BUFFER=ITEM2,ERROR=QUIT,RECNO=2 @VA04250 00324000
CLI NOFORMAT+7,X01 NO FORMAT WANTED ?? @VA04250 00325000
BE HEXDUMP NO @VA04250 00326000
PREREG L R8,=A(ITEM2) SET BASE @VA04250 00327000
MVC RCHINDEX(4*K9),I2RCH GET POINTERS @V4M0004 00328000
MVC RDATE(8*K2),I2DATE GET DATE & TIME @V4M0004 00329000
MVC ABCODE(4),I2AB GET ABEND CODE @V4M0004 00330000
MVC RSYSRV,I2SYSRV GET STORAGE SIZE @V4M0004 00331000
MVC DATA(LABM),ABMSG ABEND MSG @VA04250 00332000
MVC DATA+25(3),I2AB ABEND CODE @VA04250 00333000
L R1,I2AB GET NUMBER @VA04250 00334000
N R1,=X'000000FF' ISOLATE NUMBER @VA04250 00335000
CVD R1,WORK3 CONVERT @VA04250 00336000
OI WORK3+7,X0F SET ZONE @VA04250 00337000
UNPK WORK3(3),WORK3+6(2) @VA04250 00338000
MVC DATA+28(3),WORK3 SET NUMBER @VA02058 00339000
MVC DATA+38(8),I2DATE @VA04250 00340000
MVC DATA+56(8),I2TIME @VA04250 00341000
MVC DATA+K65(K10),=C'PROCESSOR ' @V407510 00342000
LH R1,I2PROCA GET PROCESSOR ADDRESS @V407510 00343000
CVD R1,WORK3 CONVERT TO DECIMAL @V407510 00344000
OI WORK3+K7,X0F SET ZONE @V407510 00345000
UNPK WORK3(2),WORK3+K6(K2) PUT IN FINAL FORM @V4M0004 00346000
MVC DATA+K75(K2),WORK3 MOVE PROCESSOR ADDRESS @V4M0004 00347000
MVC LINECT,=H'60' FORCE EJECT @VA04250 00348000
MVI CTL,SPACE2 @VA04250 00349000
PRELIM3A BAL R6,PRINTA @VA04250 00350000
SPACE 2 00351000
* FORMAT AND PRINT GPRS AND CONTROL REGS 00352000
SPACE 2 00353000
PRELIM4 DS 0H @VA04250 00354000
LR R7,R8 SAVE BUFFER POINTER @VA04250 00355000
MVC DATA(K9),=C'GREGS 0-7' @VA04250 00356000
LA R9,I2GRS DATA @VA04250 00357000
PRELIM5 EQU * @VA04250 00358000
LA R10,K2 TWO LINES OF PRINT FOR GPRS @VA04250 00359000
LA R3,K64 LENGTH @VA04250 00360000
BAL R6,TRANINIT GO UNPACK @VA04250 00361000
LA R5,WORK+8 FROM ADDRESS @VA04250 00362000
PRELIM6 LA R4,DATA+12 TO ADDRESS @VA04250 00363000
LA R2,K64 LENGTH @VA04250 00364000
BAL R6,MVSBRTN GO MOVE 8 REGS @VA04250 00365000
BAL R6,PRINTA @VA04250 00366000
MVC DATA+5(K4),=C'8-15' @VA04250 00367000
MVI CTL,SPACE1 SET TO SINGLE SPACE @VA04250 00368000
BCT R10,PRELIM6 @VA04250 00369000
PRELIM7 NOP PRELIM8 @VA04250 00370000
MVI CTL,SPACE2 SPACE 2 @VA04250 00371000
MVC DATA(K9),=C'CREGS 0-7' @VA04250 00372000
MVI PRELIM7+1,XF0 SET TO UNCONDITIONAL BRANCH @VA04250 00373000
LA R9,I2CRS DATA @VA04250 00374000
B PRELIM5 GO BACK AND DO CONTROL REGS @VA04250 00375000
SPACE 2 00376000
* FORMAT AND PRINT FLOATING POINT REGS 00377000
SPACE 2 00378000
PRELIM8 MVI CTL,SPACE2 SET TO DOUBLE SPACE @VA04250 00379000
MVI PRELIM7+1,X00 RESTORE NOP @VA04250 00380000
LA R9,I2FPRS DATA @VA04250 00381000
LA R3,K32 LENGTH @VA04250 00382000
BAL R6,TRANINIT TRANSLATE @VA04250 00383000
LA R5,WORK+8 FROM ADDR @VA04250 00384000
LA R4,DATA+12 TO ADDR @VA04250 00385000
LA R2,K64 LENGTH @VA04250 00386000
BAL R6,MVSBRTN @VA04250 00387000
MVC DATA(K9),=C'FPRGS 0-4' @VA04250 00388000
BAL R6,PRINTA @VA04250 00389000
SPACE 2 00390000
* FORMAT TOD CLK ,COMPARATOR, AND CPU TIMER 00391000
SPACE 2 00392000
LA R9,I2TOD DATA @VA04250 00393000
LA R3,K24 LENGTH @VA04250 00394000
BAL R6,TRANINIT TRANSLATE @VA04250 00395000
MVC DATA(K9),=C'TOD CLOCK' @VA04250 00396000
MVC DATA+12(8),WORK+8 FIRST WORD OF CSW @VA04250 00397000
MVC DATA+22(8),WORK+16 SECOND WORD @VA04250 00398000
MVC DATA+36(K14),=C'TOD CLOCK COMP' @VA04250 00399000
MVC DATA+52(K8),WORK+40 MOVE 1ST WD OF COMP TO BUFF @VA04250 00400000
MVC DATA+62(K8),WORK+48 MOVE SECOND WORD @VA04250 00401000
BAL R6,PRINTA @VA04250 00402000
MVC DATA(K9),=C'CPU TIMER' @VA04250 00403000
MVC DATA+12(K8),WORK+24 MOVE FIRST WORD OF TIMER @VA04250 00404000
MVC DATA+22(K8),WORK+32 MOVE SECOND WORD OF TIMER @VA04250 00405000
LA R3,K4 LENGTH FOR TRANSLATE @V407510 00406000
LA R9,I2PRFRG ADDRESS OF PREFIX AREA ADDRESS @V407510 00407000
BAL R6,TRANINIT TRANSLATE @V407510 00408000
MVC DATA+K36(K11),=C'PREFIX REG ' @V407510 00409000
MVC DATA+K52(K8),WORK+K8 MOVE PREFIX REGISTER @V407510 00410000
BAL R6,PRINTA @VA04250 00411000
SPACE 2 00412000
* FORMAT AND PRINT PSWS 00413000
SPACE 2 00414000
PRELIM11 DS 0H @V407510 00415000
L R5,I2PRFRG GET PREFIX REG OF ABENDING PROC @V407510 00416000
LA R3,K256 PAGE LENGTH IN DOUBLEWORDS @V407510 00417000
MVI ERRINDX,IX1C SET ERROR INDEX FOR GETPAGE @V407510 00418000
BAL R2,GETPAGE GET PSA PAGE IN CORE @V407510 00419000
USING PSA,R9 SET UP ADDRESSABILITY FOR PSA @V407510 00420000
L R5,INTKFLIN GET I/O INT CODE @V407510 00421000
ST R5,WORK2 SAVE @VA04250 00422000
LA R9,EXOPSW ADDRESS OF DATA TO BE PRINTED @V407510 00423000
LA R3,120 THIS MANY BYTES @VA04250 00424000
BAL R6,TRANINIT TRANSLATE @VA04250 00425000
MVC DATA(K3),=C'CSW' @VA04250 00426000
MVC DATA+5(K8),WORK+88 MOVE LEF HALF OF CSW @VA04250 00427000
MVC DATA+15(K8),WORK+96 MOVE RIGHT HALF OF CSW @VA04250 00428000
MVC DATA+30(K3),=C'CAW' @VA04250 00429000
MVC DATA+35(K8),WORK+104 MOVE IN CAW ADDR @VA04250 00430000
MVC DATA+51(9),=CL9'INT TIMER' @VA04250 00431000
MVC DATA+62(8),WORK+120 @VA04250 00432000
BAL R6,PRINTA @VA04250 00433000
MVC DATA(K11),=C'EXT OLD PSW' @VA04250 00434000
MVC DATA+13(K4),WORK+228 GET INTERRUPT CODE @VA04250 00435000
MVC DATA+19(K8),WORK+8 MOVE LEFT HALF OF PSW @VA04250 00436000
MVC DATA+29(K8),WORK+16 MOVE RIGHT HALF @VA04250 00437000
MVC DATA+60(K11),=C'EXT NEW PSW' @VA04250 00438000
MVC DATA+73(K8),WORK+136 MOVE LSFT HALF @VA04250 00439000
MVC DATA+83(K8),WORK+144 MOVE RIGHT HALF @VA04250 00440000
BAL R6,PRINTA @VA04250 00441000
MVC DATA(K11),=C'SVC OLD PSW' @VA04250 00442000
MVC DATA+13(K4),WORK+236 MOVE INTERRUPT CODE @VA04250 00443000
MVC DATA+19(K8),WORK+24 MOVE LEFT HALF OF PSW @VA04250 00444000
MVC DATA+29(K8),WORK+32 MOVE RIGHT HALF @VA04250 00445000
PRELIM12 MVC DATA+60(K11),=C'SVC NEW PSW' @VA04250 00446000
MVC DATA+73(K8),WORK+152 MOVE LEFT HALF @VA04250 00447000
MVC DATA+83(K8),WORK+160 MOVE RIGHT HALF @VA04250 00448000
BAL R6,PRINTA @VA04250 00449000
MVC DATA(K11),=C'PGM OLD PSW' @VA04250 00450000
MVC DATA+13(K4),WORK+244 MOVE INTERRUP CODE @VA04250 00451000
MVC DATA+19(K8),WORK+40 MOVE LEFT HALF @VA04250 00452000
MVC DATA+29(K8),WORK+48 MOVE RIGHT HALF @VA04250 00453000
PRELIM13 MVC DATA+60(K11),=C'PGM NEW PSW' @VA04250 00454000
MVC DATA+73(K8),WORK+168 MOVE LEFT HALF @VA04250 00455000
MVC DATA+83(K8),WORK+176 MOVE RIGHT HALF @VA04250 00456000
BAL R6,PRINTA @VA04250 00457000
MVC DATA(K11),=C'MCK OLD PSW' @VA04250 00458000
MVC DATA+19(K8),WORK+56 MOVE LEFT HALF OF PSW @VA04250 00459000
MVC DATA+29(K8),WORK+64 MOVE RIGHT HALF @VA04250 00460000
MVC DATA+60(K11),=C'MCK NEW PSW' @VA04250 00461000
MVC DATA+73(K8),WORK+184 MOVE LEFT HALF OF PSW @VA04250 00462000
MVC DATA+83(K8),WORK+192 MOVE RIGHT HALF @VA04250 00463000
BAL R6,PRINTA @VA04250 00464000
MVC DATA(11),=C'I/O OLD PSW' @VA04250 00465000
MVC DATA+13(4),WORK+4 @VA04250 00466000
MVC DATA+19(8),WORK+72 @VA04250 00467000
MVC DATA+29(8),WORK+80 @VA04250 00468000
MVC DATA+60(11),=C'I/O NEW PSW' @VA04250 00469000
MVC DATA+73(8),WORK+200 @VA04250 00470000
MVC DATA+83(8),WORK+208 @VA04250 00471000
BAL R6,PRINTA @VA04250 00472000
DROP R9 @V407510 00473000
EJECT 00474000
* ************************************************** 00475000
* * THE FOLLOWING ROUTINE WILL PRINT OUT THE LOAD 00476000
* * MODULE MAP¬ THE MAP IS LOCATED IN ITEM = OF THE* 00477000
* * CMS DUMP FILE¬ * 00478000
* ************************************************** 00479000
SPACE 3 00480000
LOADMAP CLI MAP+7,X01 WAS A MAP REQUESTED @VA04250 00481000
BE PREND NO MAP @VA04250 00482000
MVC LINECT,=H'60' EJECT @VA04250 00483000
MVI CTL,SPACE2 SET FOR SINGLE SPACE @VA04250 00484000
MVI SPACENUM+1,X02 @VA04250 00485000
FSREAD FSCB=DUMPFILE,BUFFER=BUFF,ERROR=QUIT,RECNO=1 @VA04250 00486000
L R3,=A(BUFF) SET BASE @VA04250 00487000
LOADMAP2 LA R4,DATA DATA START @VA04250 00488000
LA R5,5 FIVE SYMBOLS PER LINE @VA04250 00489000
LOADMAP1 UNPK WORK(K9),K8(K5,R3) UNPK THE ADDR @VA04250 00490000
TR WORK(K8),TTAB-240 @VA04250 00491000
MVC 0(8,R4),0(R3) MOVE SYMBOL @VA04250 00492000
MVC 11(6,R4),WORK+2 MOVE ADDRESS @VA04250 00493000
MVI 9(R4),C'-' @VA04250 00494000
LA R4,24(R4) BUMP DATA AREA @VA04250 00495000
CLC 12(4,R3),=F'0' END OF LOAD MAP ? @VM08728 00496000
BE MAPEND YES @VA04250 00497000
LA R3,12(R3) NEXT SYMBOL @VA04250 00498000
BCT R5,LOADMAP1 LOOP TIMES @VA04250 00499000
BAL R6,PRINTA PRINT LINE @VA04250 00500000
B LOADMAP2 REPEAT @VA04250 00501000
MAPEND BAL R6,PRINTA PRINT LAST LINE @VA04250 00502000
PREND NOP RDKEY @VA01570 00503000
EJECT 00504000
* 00505000
* THIS SECTION FORMATS REAL CHANNEL BLOCKS- RCHBLOK 00506000
* 00507000
RCHFORM MVC LINECT,=H'60' @VA04250 00508000
USING BLOKFORM,R10 @VA04250 00509000
LA R10,DATA ADDR O/P AREA @VA04250 00510000
L R5,RCHINDEX ADDR REAL CHANNEL BLK INDEX TBL @VA04250 00511000
MVI ERRINDX,IX00 SET ERROR INDEX FOR GETPAGE @VA01570 00512000
LA R3,4 4 DBLWDS @VA04250 00513000
BAL R2,GETPAGE GET PAGE WITH TABLE @VA04250 00514000
MVC CHINDEX(K32),K0(R9) SAVE REAL CHAN BLK INDEX TBL@VA04250 00515000
L R4,CHDEX INITIAL ENTRY IN CHAN INDEX TABLE@VA04250 00516000
RCHINIT EQU * @VA04250 00517000
CLC K0(K2,R4),FFFF VALID CHAN TBL. ENTRY? @VA04250 00518000
BNE RCHPRC YES, PROCESS CHAN. BLOCK @VA11255 00519000
CHLOOP EQU * @VA01570 00520000
C R4,CHANLAST LAST CHAN. TBL. ENTRY? @VA04250 00521000
BE SFFORM @VA04250 00522000
LA R4,K2(,R4) GET NEXT TBL. ENTRY ADDR. @VA04250 00523000
B RCHINIT CHECK NEXT ENTRY @VA04250 00524000
SPACE 1 00525000
* AT THIS POINT REG 4 CONTAINS ADDR OF INDEX TABLE ENTRY FOR RCHBLOK 00526000
* TO BE PROCESSED 00527000
SPACE 1 00528000
RCHPRC EQU * @VA11255 00529000
ST R4,CHDEX SAVE ADDR CURR CH INDEX TBL ENTRY@VA04250 00530000
LH R5,K0(,R4) NDEX INTO RCHBLOK'S FOR THIS CHAN@VA04250 00531000
A R5,RCHSTRT + START ADDR RCHBLOK'S=NEW BLK AD@VA04250 00532000
ST R5,WORK2 SAVE RCHBLOK ADDR @VA04250 00533000
ST R5,CHAINCK SAVE FOR IOBLOK CHECK @VA04250 00534000
MVI ERRINDX,IX01 SET ERROR INDEX FOR GETPAGE @VA01570 00535000
LA R3,RCHSIZE SIZE @VA04250 00536000
BAL R2,GETPAGE GET PAGE WITH RCHBLOK TO PRINT @VA04250 00537000
USING RCHBLOK,R9 REAL CHANNEL BLOCK DSECT @VA04250 00538000
MVC CUINDEX(K64),RCHCUTBL SAVE REAL CU INDEX TABLE @VA04250 00539000
MVC IOBCHAIN(K4),RCHFIOB SAVE ADDR 1ST IOBLOK QUEUED@VA04250 00540000
SLL R3,3 8=NO. OF BYTES TO TRANSLATE @VA04250 00541000
BAL R6,TRANINIT TRANSLATE BLOCK @VA04250 00542000
* 00543000
* RCHBLOK HEADINGS FORMATED HERE 00544000
* 00545000
MVC HCHBADDR(6),WORK+2 CHAN ADDRESS @VA04250 00546000
SR R4,R4 CLEAR REG. @VA04250 00547000
IC R4,RCHADD GET CHANNEL ADDR @VA04250 00548000
LA R5,TTAB ADDR TRANSLATE TABLE @VA04250 00549000
AR R4,R5 ADDR OF TRANSLATED CHAR. @VA04250 00550000
MVC HCHNO(K1),K0(R4) MOVE CHN NO. IN CHAR TO HDNG@VA04250 00551000
SPACE 1 00552000
* SET UP FOR WRITING CHANNEL BLOCK 00553000
SPACE 1 00554000
LA R2,HCHBLK ADDR OF RCHBLOK HEADING @VA04250 00555000
LA R3,3 HEADINGINGS @VA04250 00556000
LA R5,RCHSIZE NO. OF DOUBLE WORDS TO PRINT @VA04250 00557000
LA R7,FRCHBLK INITIAL START ADDR IN O/P AREA @VA04250 00558000
BAL R6,BLKPRINT GO PRINT RCHBLOK @VA04250 00559000
* 00560000
* ANY IOBLOKS CHAINED OFF OF THE RCHBLOK JUST PRINTED ARE PRINTED NOW 00561000
* 00562000
MVC HIOBLKS(K13),HIOBLOK PUT 'IOBLOK' IN HEADING @VA04250 00563000
BAL R6,IOBPRINT GO TO IOBLOK PRINT ROUTINE @VA04250 00564000
* 00565000
* THIS SECTION FORMATS REAL CONTROL UNIT BLOCKS- RCUBLOK 00566000
* 00567000
L R4,CUDEX GET ADDR OF INITIAL ENTRY @VA04250 00568000
RCUINIT EQU * @VA04250 00569000
CLC K0(K2,R4),FFFF VALID TABLE ENTRY? @VA04250 00570000
BNE RCUPRC YES, PROCESS BLOCK @VA11255 00571000
CULOOP EQU * @VA01570 00572000
C R4,RCULAST LAST CONTROL UNIT ENTRY? @VA04250 00573000
BE CKCHAN YES, CK IF ANOTHER CHAN EXISTS @VA04250 00574000
LA R4,K2(,R4) GET NEXT TABLE ENTRY ADDR. @VA04250 00575000
B RCUINIT CHECK NEXT TABLE ENTRY @VA04250 00576000
* 00577000
* AT THIS POINT REG 4 CONTAINS ADDR OF INDEX TABLE ENTRY FOR RCUBLOK 00578000
* TO BE PROCESSED 00579000
* 00580000
RCUPRC EQU * @VA11255 00581000
ST R4,CUDEX SAVE ADDR CURR CU INDEX TBL ENTRY@VA04250 00582000
LH R5,K0(,R4) GET DISP INTO CU TBLS FOR THIS CU@VA04250 00583000
A R5,RCUSTRT PLUS CU TBL'S BASE =RCUBLOK ADDR @VA04250 00584000
ST R5,CHAINCK SAVE FOR IOBLOK CHECK @VA04250 00585000
ST R5,WORK2 SAVE RCUBLOK ADDR FOR TRANSLATION@VA04250 00586000
MVI ERRINDX,IX02 SET ERROR INDEX FOR GETPAGE @VA01570 00587000
LA R3,RCUSIZE SIZE @VA04250 00588000
BAL R2,GETPAGE GET PAGE WITH TABLE @VA04250 00589000
USING RCUBLOK,R9 @VA04250 00590000
MVC DEVINDEX(K32),RCUDVTBL SAVE DEV NDX TBL FOR THIS@VA04250 00591000
* CONTROL UNIT 00592000
MVC IOBCHAIN(K4),RCUFIOB SV ADD 1ST IOBLOK QD TO RCU@VA04250 00593000
SLL R3,3 8=NO. OF BYTES TO TRANSLATE @VA04250 00594000
BAL R6,TRANINIT TRANSLATE RCUBLOK & ITS ADDR @VA04250 00595000
* 00596000
* RCUBLOK HEADINGS FORMATED HERE 00597000
* 00598000
MVC HCUBADDR(6),WORK+2 CU ADDRESS @VA04250 00599000
SR R4,R4 CLEAR REG. @VA04250 00600000
IC R4,RCUADD+1 GET CONTROL UNIT ADDR @VA04250 00601000
SRL R4,4 MOVE UNIT NO TO LOW-ORDER FOR NDX@VA04250 00602000
LA R5,TTAB ADDR TRANSLATE TABLE @VA04250 00603000
AR R4,R5 ADDR OF TRANSLATED CHAR. @VA04250 00604000
MVC HCUNO+1(K1),K0(R4) MOVE CU NO. IN CHAR TO HEAD @VA04250 00605000
MVC HCUNO(K1),HCHNO PUT CHAN NO. IN UNIT ADDR. @VA04250 00606000
SPACE 1 00607000
* SETUP FOR WRITING REAL CONTROL UNIT BLOCK 00608000
SPACE 1 00609000
LA R2,HCUBLK ADDR OF RCUBLOK HEADING @VA04250 00610000
LA R3,K3 NO. OF HEADING LINES @VA04250 00611000
LA R5,RCUSIZE NO. OF DOUBLE WORDS TO PRINT @VA04250 00612000
LA R7,FRCUBLK INITIAL START ADDR IN O/P AREA @VA04250 00613000
BAL R6,BLKPRINT GO PRINT RCUBLOK @VA04250 00614000
* 00615000
* IOBLOKS CHAINED OFF OF THE RCUBLOK JUST PRINTED ARE PRINTED NOW 00616000
* 00617000
MVC HIOBLKS(K13),HIOBLOK PUT 'IOBLOK IN HEADING @VA04250 00618000
BAL R6,IOBPRINT GO TO IOBLOK PRINT ROUTINE @VA04250 00619000
* 00620000
* THIS SECTION FORMATS REAL DEVICE BLOCKS- RDEVBLOK 00621000
* 00622000
L R4,DEVDEX GET ADDR INITIAL ENTRY IN DEVICE @VA04250 00623000
* INDEX TABLE 00624000
RDEVINIT EQU * @VA04250 00625000
CLC K0(K2,R4),FFFF VALID DEV. TBL. ENTRY? @VA04250 00626000
BNE RDEVPRC YES, PROCESS BLOCK @VA11255 00627000
CKDEV EQU * @VA01570 00628000
C R4,DEVLAST LAST DEVICE ENTRY? @VA04250 00629000
BE CKCU YES, CK FOR ANOTHER CONTROL UNIT @VA04250 00630000
LA R4,K2(,R4) GET NEXT TABLE ENTRY ADDR. @VA04250 00631000
B RDEVINIT CHECK NEXT TABLE ENTRY @VA04250 00632000
SPACE 1 00633000
* AT THIS POINT REG 4 CONTAINS ADDR OF INDEX TABLE ENTRY FOR RDEVBLOK 00634000
* TO BE PROCESSED 00635000
SPACE 1 00636000
RDEVPRC EQU * @VA11255 00637000
ST R4,DEVDEX SAVE ADR CURR DEV NDX TBL ENTRY @VA04250 00638000
LH R5,K0(,R4) DISP INTO RDEVBLOKS FOR THIS DEV @VA04250 00639000
SLL R5,3(0) CONVERT TO BYTE INDEX @VM08728 00640000
A R5,RDEVSTRT PLUS DEV TBL'S BASE=RDEVBLOK ADDR@VA04250 00641000
ST R5,LIOBDEV SAVE FOR IOBLOK CHAIN CHECK @VA04250 00642000
ST R5,WORK2 SAVE RDEVBLOK ADDR FOR TRANS @VA04250 00643000
MVI ERRINDX,IX03 SET ERROR INDEX FOR GETPAGE @VA01570 00644000
LA R3,RDEVSIZE SIZE @VA04250 00645000
BAL R2,GETPAGE GET PAGE WITH RDEVBLOK @VA04250 00646000
USING RDEVBLOK,R9 @VA04250 00647000
TM RDEVTYPC,CLASURI+CLASURO SPOOL DEV ?? @VA04250 00648000
BZ TSTRCON NO, TEXT FOR CONSOLE @VA04250 00649000
L R5,RDEVSPL GET POINTER @VA04250 00650000
LTR R5,R5 TEST @VA04250 00651000
BZ RIOB NONE @VA04250 00652000
TM RDEVFLAG,RDEVACNT WAS IT DOING ACNTNG STUFF? @VA05034 00653000
BO RIOB YES - DONT TRY TO FORMAT RSPLCTL @VA05034 00654000
ST R5,SPOOLSAV SAVE @VA04250 00655000
OI SPOOLSW,XFF SET SW @VA04250 00656000
B RIOB @VA04250 00657000
TSTRCON TM RDEVTYPC,CLASTERM+CLASGRAF CONTASK CHAIN ? @VM08728 00658000
BZ ROWN NO @VA04250 00659000
L R5,RDEVCON GET POINTER @VA04250 00660000
LTR R5,R5 TEST @VA04250 00661000
BZ RIOB NONE @VA04250 00662000
ST R5,VCONAD SAVE @VA04250 00663000
OI CONSW,XFF SET SW @VA04250 00664000
B RIOB @VA04250 00665000
ROWN TM RDEVTYPC,CLASDASD DASD ?? @VA04250 00666000
BZ RIOB NO @VA04250 00667000
TM RDEVFLAG,RDEVOWN CP VOL ?? @VA04250 00668000
BZ RIOB NO @VA04250 00669000
L R5,RDEVPAGE GET ALLOC @VA04250 00670000
ST R5,PAGBLOK SAVE @VA04250 00671000
L R5,RDEVRECS SPOOL ALLOC @VA04250 00672000
ST R5,SPLBLOK SAVE @VA04250 00673000
OI OWNSW,XFF SET SW @VA04250 00674000
RIOB DS 0H @VA04250 00675000
MVC IOBDEV(K4),RDEVFIOB SVE ADR 1ST IOBLOK QD TO DEV@VA04250 00676000
SLL R3,3 8=NO. OF BYTES TO TRANSLATE @VA04250 00677000
BAL R6,TRANINIT TRANSLATE RDEVBLOK & ITS ADDR. @VA04250 00678000
L R5,RDEVIOER GET ADDR IOERBLOK-IF ANY @VA04250 00679000
LTR R5,R5 IS THERE AN IOERBLOK FOR THIS DEV@VA04250 00680000
BZ NOIOER NO @VA04250 00681000
OI IOERSW,XFF SET ERROR BLOCK SWITCH @VA04250 00682000
ST R5,ERRBLOCK SAVE ADDR IOERBLOK @VA04250 00683000
NOIOER EQU * @VA04250 00684000
L R5,RDEVAIOB GET ADDR ACTIVE IOBLOK @VA04250 00685000
LTR R5,R5 IS THIS ONE ACTIVE @VA04250 00686000
BZ SETDVHD NO @VA04250 00687000
OI ACTIOBSW,XFF SET ACTIVE IOB SWITCH @VA04250 00688000
ST R5,AIOB SAVE ACTIVE IOBLOK ADDR @VA04250 00689000
* 00690000
* RDEVBLOK HEADINGS FORMATED HERE 00691000
* 00692000
SETDVHD EQU * @VA04250 00693000
MVC HDBADDR(6),WORK+2 DEV ADDRESS @VA04250 00694000
MVC HDEVNO(K1),RDEVADD+1 GET CU & DEVICE ADDR. @VA04250 00695000
NI HDEVNO,X0F CLEAR CU ADDR. @VA04250 00696000
SR R4,R4 CLEAR REG. @VA04250 00697000
IC R4,HDEVNO GET DEVICE ADDR @VA04250 00698000
LA R5,TTAB ADDR TRANSLATE TABLE @VA04250 00699000
AR R4,R5 ADDR OF TRANSLATED CHAR. @VA04250 00700000
MVC HDEVNO+2(K1),K0(R4) PUT DEV ADDR IN CHAR IN HEAD@VA04250 00701000
MVC HDEVNO(K2),HCUNO PUT CH & CU ADDR IN DEV ADDR @VA04250 00702000
SPACE 1 00703000
* SETUP FOR WRITING REAL DEVICE BLOCK 00704000
SPACE 1 00705000
LA R2,HDEVBLK ADDR DEVICE BLOCK HEADINGS @VA04250 00706000
LA R3,3 HEADINGS @VA04250 00707000
LA R5,RDEVSIZE NO. OF DOUBLE WORDS TO PRINT @VA04250 00708000
LA R7,FRDEVBLK INITIAL START ADDR IN O/P AREA @VA04250 00709000
BAL R6,BLKPRINT PRINT FORMATED RDEVBLOK @VA04250 00710000
SPACE 1 00711000
* ACTIVE IOBLOK FORMATED HERE 00712000
SPACE 1 00713000
TM ACTIOBSW,XFF ACTIVE IOBLOK ON THIS DEVICE? @VA04250 00714000
BZ IOBPRC NO, PROC IOBLOKS CHAINED TO DEV @VA11255 00715000
MVC HIOBLKS(K13),HACTIO PUT ACTIVE IOBLOCK IN HEADNG@VA04250 00716000
MVC IOBCHAIN(K4),AIOB ACTIVE IOBLOK ADDR @VA04250 00717000
BAL R6,IOBPRINT PRINT ACTIVE IOBLOK @VA04250 00718000
NI ACTIOBSW,255-XFF CLEAR SWITCH @VA04250 00719000
SPACE 1 00720000
* REAL DEVICE IOBLOK PROCESSING 00721000
SPACE 1 00722000
IOBPRC EQU * @VA11255 00723000
MVC CHAINCK(K4),LIOBDEV ADR OF RDEVBLOK FOR CHAIN CK@VA04250 00724000
MVC HIOBLKS(K13),HIOBLOK PUT 'IOBLOK IN HEADING @VA04250 00725000
MVC IOBCHAIN(K4),IOBDEV FIRST IOBLOK ADDR -IF ANY @VA04250 00726000
BAL R6,IOBPRINT GO TO IOBLOK PRINT ROUTINE @VA04250 00727000
SPACE 1 00728000
* PRINT CONTASKS FOR TERMINAL 00729000
SPACE 1 00730000
TM CONSW,XFF TEST @VA04250 00731000
BZ TSTRSPL TEST FOR SPOOL @VA04250 00732000
MVI CONSW,X00 CLEAR @VA04250 00733000
CONLOOP L R5,VCONAD GET CONTASK ADDRESS @VA04250 00734000
LTR R5,R5 TEST FOR ANY @VA04250 00735000
BZ IOERPRNT NONE @VA04250 00736000
ST R5,WORK2 SAVE @VA04250 00737000
LA R3,16(0,0) MAX SIZE (FOR PRINTING) @VM08728 00738000
MVI ERRINDX,IX04 SET ERROR INDEX FOR GETPAGE @VA01570 00739000
BAL R2,GETPAGE GET BUFFER @VA04250 00740000
USING CONTASK,R9 @VA04250 00741000
LH R3,CONTSKSZ GET SIZE @VM08728 00742000
SLL R3,3 ... IN BYTES @VA04250 00743000
BAL R6,TRANINIT TRANSLATE @VA04250 00744000
MVC HIOBLKS(13),HCONTASK HEADING @VA04250 00745000
MVC HIOBADDR(6),WORK+2 ADDRESS @VA04250 00746000
LA R2,HIOBLKS HEADINGS @VA04250 00747000
LA R3,2 TWO @VA04250 00748000
LH R5,CONTSKSZ CONTASK SIZE (DBL-WDS) @VM08728 00749000
LTR R5,R5 AVOID ENDLESS LOOPS @VA01570 00750000
BNP ONLY16 ON ZERO AND MINUS @VA01570 00751000
CH R5,=H'16' MORE THAN WAS TRANSLATED ? @VM08728 00752000
BNH *+8 NO - O.K. @VM08728 00753000
ONLY16 EQU * @VA01570 00754000
LA R5,16(0,0) CAN ONLY PRINT 128 BYTES @VM08728 00755000
LA R7,FSPOOL DISP @VA04250 00756000
L R6,CONPNT GET NEXT ADDRESS @VA04250 00757000
ST R6,VCONAD SAVE @VA04250 00758000
BAL R6,BLKPRINT PRINT IT @VA04250 00759000
B CONLOOP DO ALL OF THEM @VA04250 00760000
SPACE 1 00761000
* IF THIS DEVICE IS A UNIT RECORD TYPE, RSPLCTL & SFBLOK FORMATED HERE 00762000
SPACE 1 00763000
TSTRSPL TM SPOOLSW,XFF IS THIS SPOOLING DEVICE? @VA04250 00764000
BZ IOERPRNT NO, CHECK FOR IOERBLOK @VA04250 00765000
NI SPOOLSW,255-XFF CLEAR SWITCH @VA04250 00766000
L R5,SPOOLSAV GET ADDR OF RSPLCTL BLOCK @VA04250 00767000
ST R5,WORK2 ADDR OF BLOCK FOR TRANSLATION @VA04250 00768000
MVI ERRINDX,IX05 SET ERROR INDEX FOR GETPAGE @VA01570 00769000
LA R3,RSPSIZE SIZE @VA04250 00770000
BAL R2,GETPAGE GET PAGE WITH RSPLCTL @VA04250 00771000
USING RSPLCTL,R9 @VA04250 00772000
MVC SPOOLSAV(K4),RSPSFBLK SAVE SFBLOK ADDR @VA04250 00773000
SLL R3,3 8=NO. OF BYTES TO TRANSLATE @VA04250 00774000
BAL R6,TRANINIT TRANSLATE BLOCK AND ITS ADDR. @VA04250 00775000
MVC HIOBLKS(K13),HRSPLCTL SET TOP HEADING @VA04250 00776000
MVC HIOBADDR(6),WORK+2 BLOK ADDRESS @VA04250 00777000
SPACE 1 00778000
* SETUP FOR WRITING RSPLCTL BLOCK 00779000
SPACE 1 00780000
LA R2,HIOBLKS ADDR HEADING LINES @VA04250 00781000
LA R3,K2 NO. OF HEADING LINES @VA04250 00782000
LA R5,RSPSIZE NO. OF DOUBLE WORDS TO PRINT @VA04250 00783000
LA R7,FSPOOL INITIAL START ADDR IN O/P AREA @VA04250 00784000
BAL R6,BLKPRINT GO PRINT RSPLCTL BLOCK @VA04250 00785000
BAL R6,SFPRINT GO TO SFBLOCK PRINT RTN. @VA04250 00786000
IOERPRNT TM IOERSW,XFF TEST FOR BLOCK @VA04250 00787000
BZ OWNTST NO @VA04250 00788000
BAL R6,IOERPRC PRINT IT @VA11255 00789000
OWNTST TM OWNSW,XFF TEST @VA04250 00790000
BZ ENDCK NO @VA04250 00791000
MVI OWNSW,X00 CLEAR @VA04250 00792000
PAGLOOP L R5,PAGBLOK GET BLOK ADDRESS @VA04250 00793000
LTR R5,R5 TEST FOR BLOK @VA04250 00794000
BZ SPLST TRY SPOOL LIST @VA04250 00795000
ST R5,WORK2 SAVE @VA04250 00796000
MVI ERRINDX,IX06 SET ERROR INDEX FOR GETPAGE @VA01570 00797000
LA R3,RECSIZE SIZE @VA04250 00798000
BAL R2,GETPAGE GET BUFFER @VA04250 00799000
USING RECBLOK,R9 @VA04250 00800000
SLL R3,3 @VA04250 00801000
BAL R6,TRANINIT TRANSLATE @VA04250 00802000
MVC HRECADDR(6),WORK+2 @VA04250 00803000
MVC HRECID(6),=CL6'-PAGE' @VA04250 00804000
LA R2,HRECBLK HEADING @VA04250 00805000
LA R3,2 3 @VA04250 00806000
LA R5,RECSIZE @VA04250 00807000
LA R7,FSPOOL DISP @VA04250 00808000
ST R9,REG9SAV SAVE REG 9 (RECBLOK ADDR) @VA02332 00809000
BAL R6,BLKPRINT PRINT IT @VA01570 00810000
L R9,REG9SAV RESTORE RECBLOK POINTER @VA02332 00811000
L R6,RECPNT GET NEXT @VA04250 00812000
ST R6,PAGBLOK SAVE @VA04250 00813000
B PAGLOOP @VA04250 00814000
SPLST L R5,SPLBLOK GET BLOK ADDRESS @VA04250 00815000
LTR R5,R5 TEST @VA04250 00816000
BZ ENDCK NONE @VA04250 00817000
ST R5,WORK2 SAVE @VA04250 00818000
MVI ERRINDX,IX07 SET ERROR INDEX FOR GETPAGE @VA01570 00819000
LA R3,RECSIZE SIZE @VA04250 00820000
BAL R2,GETPAGE GET BUFFER @VA04250 00821000
SLL R3,3 @VA04250 00822000
BAL R6,TRANINIT TRANSLATE @VA04250 00823000
MVC HRECADDR(6),WORK+2 @VA04250 00824000
MVC HRECID(6),=CL6'-SPOOL' @VA04250 00825000
LA R2,HRECBLK HEADING @VA04250 00826000
LA R3,2 3 @VA04250 00827000
LA R5,RECSIZE SIZE @VA04250 00828000
LA R7,FSPOOL DISP @VA04250 00829000
ST R9,REG9SAV SAVE REG 9 (RECBLOK ADDR) @VA02332 00830000
BAL R6,BLKPRINT PRINT IT @VA01570 00831000
L R9,REG9SAV RESTORE RECBLOK POINTER @VA02332 00832000
L R6,RECPNT GET NEXT @VA04250 00833000
ST R6,SPLBLOK SAVE @VA04250 00834000
B SPLST LOOP FOR ALL @VA04250 00835000
SPACE 1 00836000
* A CHECK IS MADE HERE FOR THE END OF THE DEVICE, CONTROL UNIT, AND 00837000
* CHANNEL INDEX TABLES 00838000
SPACE 1 00839000
ENDCK EQU * @VA04250 00840000
L R4,DEVDEX ADDR OF CURRENT DEV INDEX VALUE @VA04250 00841000
B CKDEV CHECK FOR LAST TABLE ENTRY @VA04250 00842000
CKCU EQU * @VA04250 00843000
LA R4,DEVINDEX ADDR 1ST ENTRY IN DEV.INDEX TBL. @VA04250 00844000
* FOR NEXT CONTROL UNIT 00845000
ST R4,DEVDEX REINITIALIZE INDEX PTR FOR NEXT @VA04250 00846000
* CONTROL UNIT 00847000
L R4,CUDEX ADDR OF CURRENT CU INDEX VALUE @VA04250 00848000
B CULOOP CHECK FOR LAST TABLE ENTRY @VA04250 00849000
CKCHAN EQU * @VA04250 00850000
LA R4,CUINDEX ADDR 1ST ENTRY IN CU INDEX TBL. @VA04250 00851000
ST R4,CUDEX REINITIALIZE CU INDEX TBL. PTR. @VA04250 00852000
L R4,CHDEX ADDR OF CURRENT CHAN INDEX VALUE @VA04250 00853000
B CHLOOP CHECK FOR LAST TABLE ENTRY @VA04250 00854000
EJECT 00855000
* 00856000
* PROCESSING OF THE VIRTUAL MACHINE VMBLOK'S AND I/O BLOCKS 00857000
* COMMENCES HERE 00858000
* 00859000
SPACE 2 00860000
VIRTUALM EQU * @VA04250 00861000
TM NOVIRT+7,X01 WANT VIRTUAL FORMAT ?? @VA04250 00862000
BO HEXDUMP NO @VA04250 00863000
OI VMBSW,XF0 FIRST SYSVMBLK @VA04250 00864000
LA R10,DATA SET DATA ADDRESS @VA04250 00865000
MVI HCHBLK,V CHG CH BLOCK HEADING TO VIRTUAL @VA04250 00866000
MVI HCUBLK,V CHG CU BLOCK HEADING TO VIRTUAL @VA04250 00867000
MVI HDEVBLK,V CHG DEV BLOCK HEADING TO VIRTUAL @VA04250 00868000
L R5,VMPTR GET 1ST VMBLOK ADDR(SYSVMBLK) @VA04250 00869000
VMPRC EQU * @VA11255 00870000
MVC LINECT,=H'60' FORCE EJECT @VA04250 00871000
ST R5,VMCURENT SAVE ADDR CURRENT VMBLOK @VA04250 00872000
ST R5,WORK2 SAVE ADDR FOR TRANSLATION @VA04250 00873000
SPACE 1 00874000
* CH, CU, & DEV INDEX POINTERS ARE REINITIALIZED 00875000
SPACE 1 00876000
LA R4,CHINDEX ADDR START OF CH INDEX TBL SAVE @VA04250 00877000
* AREA 00878000
ST R4,CHDEX INIT PTR TO CURRENT TB. VALUE @VA04250 00879000
LA R4,CUINDEX ADDR START OF CU NDX TBL SAVEAREA@VA04250 00880000
ST R4,CUDEX INIT PTR TO CURRENT TBL SAVE @VA04250 00881000
LA R4,DEVINDEX ADDR START OF DEV. INDEX TBL.SAVE@VA04250 00882000
ST R4,DEVDEX INIT PTR TO CURRENT TBL VALUE @VA04250 00883000
MVI ERRINDX,IX08 SET ERROR INDEX FOR GETPAGE @VA01570 00884000
LA R3,VMBSIZE SIZE @VA04250 00885000
BAL R2,GETPAGE GET PAGE WITH VMBLOK @VA04250 00886000
USING VMBLOK,R9 @VA04250 00887000
ST R9,REG9SAV SAVE VMBLOK POINTER @VA04250 00888000
NOSYS EQU * @VA04250 00889000
MVC VMCHAIN(K4),VMPNT SAVE ADR NXT VMBLOK IN CHAIN@VA04250 00890000
MVC VCHSTRT(K4),VMCHSTRT SAVE START ADDR CH NDX TBLS@VA04250 00891000
MVC VCUSTRT(K4),VMCUSTRT SAVE START ADDR CU NDX TBLS@VA04250 00892000
MVC VDVSTRT(K4),VMDVSTRT SAVE START ADR DEV NDX TBLS@VA04250 00893000
TM VMPEND,VMDEFSTK DEFERRED EXECUTION BLOCK @V407510 00894000
* STACKED FOR THIS VMBLOK? @V407510 00895000
BNO DEFZERO NO, ZERO POINTER @V407510 00896000
MVC DEFEXPT,VMDFTPNT SAVE @ DEFERRED EXECUTION BLOK @V407510 00897000
B NXT @V407510 00898000
DEFZERO DS 0H @V407510 00899000
XC DEFEXPT,DEFEXPT ZERO POINTER @V407510 00900000
NXT DS 0H @V407510 00901000
MVC PAGBLOK,VMECEXT SAVE EXT ADDRESS @VA04250 00902000
TM VMESTAT,VMEXTCM IN EC MODE ?? @VA04250 00903000
BZ *+8 NO @VA04250 00904000
MVI CONSW,XFF SET SW @VA04250 00905000
MVC SPLBLOK,VMTREXT TRACE EXT @VA04250 00906000
TM VMTRCTL,XFF TRACING ?? @VA04250 00907000
BZ *+8 NO @VA04250 00908000
MVI SPOOLSW,XFF SET SW @VA04250 00909000
MVC CHINDEX(K32),VMCHTBL SAVE CH BLOCK INDEX TABLE @VA04250 00910000
LA R3,K96 NO. OF BYTES TO TRANSLATE IN @VA04250 00911000
* 1ST 2 PRINTS 00912000
BAL R6,TRANINIT TRANSLATE VMBLOK AND ITS ADDR. @VA04250 00913000
SPACE 1 00914000
* VMBLOK HEADINGS FORMATED HERE 00915000
SPACE 1 00916000
MVC HVMBADDR(6),WORK+2 BLOK ADDRESS @VA04250 00917000
MVC HIDEN(K8),VMUSER USER ID @VA04250 00918000
SPACE 1 00919000
* SET UP FOR WRITING VMBLOK 00920000
SPACE 1 00921000
LA R5,VMBSIZE SIZE @VA04250 00922000
STH R5,VMSAVE SAVE @VA04250 00923000
OI VMBSW,X0F DOING VMBLOK @VA04250 00924000
LA R2,HVMBLOK ADDR VMBLOK HEADINGS @VA04250 00925000
LA R3,3 HEADINGS @VA04250 00926000
VMNXT LH R5,VMSAVE GET COUNT @VA04250 00927000
CH R5,=H'12' MORE THAN 3 LINE TO DO ?? @VA04250 00928000
BH VM12 YES @VA04250 00929000
NI VMBSW,XF0 LAST PART OF VMBLOK @VA04250 00930000
B VMPRINT PRINT IT @VA04250 00931000
VM12 SH R5,=H'12' DECREMENT @VA04250 00932000
STH R5,VMSAVE SAVE @VA04250 00933000
LA R5,12 SIZE @VA04250 00934000
VMPRINT DS 0H @VA04250 00935000
LA R7,FVMBLK INITIAL START ADDR IN O/P AREA @VA04250 00936000
BAL R6,BLKPRINT PRINT 3 LINES @VA04250 00937000
TM VMBSW,X0F MORE VMBLOK TO DO ?? @VA04250 00938000
BZ VMETST NO @VA04250 00939000
OI PRTENDSW,XF0 NO HEADING @VA04250 00940000
L R9,REG9SAV GET START ADDR OF LAST TRANS. @VA04250 00941000
LA R9,K96(,R9) ADDR NEXT TRANSLATION @VA04250 00942000
ST R9,REG9SAV SAVE IT @VA04250 00943000
LA R3,K96 NO. OF BYTES TO TRANSLATE @VA04250 00944000
BAL R6,TRANINIT TRANSLATE NEXT SECTION OF VMBLOK @VA04250 00945000
B VMNXT DO NEXT PART @VA04250 00946000
VMETST DS 0H @V407510 00947000
L R5,DEFEXPT ADDR OF DEFERRED EXECUTION BLK @V407510 00948000
LTR R5,R5 DOES ONE EXIST? @V407510 00949000
BZ VMETST1 NO, SKIP THIS PROCESSING @V407510 00950000
ST R5,WORK2 SAVE ADDRESS @V407510 00951000
MVI ERRINDX,IX1D SET ERROR INDICATOR @V407510 00952000
LA R3,CPEXSIZE GET LENGTH OF BLOK @V407510 00953000
BAL R2,GETPAGE BRING PAGE IN @V407510 00954000
USING CPEXBLOK,R9 SET UP ADDRESSABILITY @V407510 00955000
SLL R3,K3 GET LENGTH IN BYTES @V407510 00956000
BAL R6,TRANINIT TRANSLATE @V407510 00957000
MVC HIOBLKS(K13),HVMDE HEADING @V407510 00958000
MVC HIOBADDR(K6),WORK+K2 @V407510 00959000
LA R2,HIOBLKS ADDRESS OF HEADING @V407510 00960000
LA R3,K2 @V407510 00961000
LA R5,CPEXSIZE SIZE OF DEFERRED EXECECUTION BLK @V407510 00962000
LA R7,FVMBLK DISPLACEMENT @V407510 00963000
BAL R6,BLKPRINT PRINT IT @V407510 00964000
VMETST1 DS 0H @V407510 00965000
TM CONSW,XFF ANY ECBLOK? @VA08569 00966000
BZ TSTTR NO @VA08569 00967000
L R5,PAGBLOK GET ADDRSS @VA04250 00968000
MVI CONSW,X00 @VA04250 00969000
ST R5,WORK2 SAVE @VA04250 00970000
MVI ERRINDX,IX09 SET ERROR INDEX FOR GETPAGE @VA01570 00971000
LA R3,EXTSIZE SIZE @VA04250 00972000
BAL R2,GETPAGE GET BUFFER @VA04250 00973000
USING ECBLOK,R9 @VA04250 00974000
SLL R3,3 @VA04250 00975000
BAL R6,TRANINIT TRANSLATE @VA04250 00976000
MVC HIOBLKS(13),HVMEC HEADING @VA04250 00977000
MVC HIOBADDR(6),WORK+2 @VA04250 00978000
LA R2,HIOBLKS HEADING @VA04250 00979000
LA R3,2 2 @VA04250 00980000
LA R5,EXTSIZE SIZE @VA04250 00981000
LA R7,FVMBLK DISP @VA04250 00982000
BAL R6,BLKPRINT PRINT IT @VA04250 00983000
TSTTR TM SPOOLSW,XFF TEST FOR TR EXT @VA04250 00984000
BZ VMEND NONE @VA04250 00985000
MVI SPOOLSW,X00 @VA04250 00986000
L R5,SPLBLOK GET ADDRSSS @VA04250 00987000
ST R5,WORK2 SAVE @VA04250 00988000
MVI ERRINDX,IX0A SET ERROR INDEX FOR GETPAGE @VA01570 00989000
LA R3,TREXSIZE SIZE @VA04250 00990000
BAL R2,GETPAGE @VA04250 00991000
USING TREXT,R9 @VA04250 00992000
SLL R3,3 @VA04250 00993000
BAL R6,TRANINIT TRANSLATE @VA04250 00994000
MVC HIOBLKS(13),HVMTR @VA04250 00995000
MVC HIOBADDR(6),WORK+2 @VA04250 00996000
LA R2,HIOBLKS HEADING @VA04250 00997000
LA R3,2 @VA04250 00998000
LA R5,TREXSIZE SIZE @VA04250 00999000
LA R7,FVMBLK DISP @VA04250 01000000
BAL R6,BLKPRINT PRINT IT @VA04250 01001000
VMEND EQU * @VA04250 01002000
* 01003000
* VIRTUAL CHANNEL BLOCKS-VCHBLOK- PROCESSED HERE 01004000
* 01005000
L R4,CHDEX ADDR OF INIT ENTRY IN CH NDX TBL @VA04250 01006000
VCHINIT EQU * @VA04250 01007000
CLC K0(K2,R4),FFFF VALID CHANNEL TBL. ENTRY? @VA04250 01008000
BNE VCHPRC YES, PROCESS CHANNEL BLOCK @VA11255 01009000
LOOPCH EQU * @VA01570 01010000
C R4,CHANLAST LAST CHANNEL ENTRY? @VA04250 01011000
BE VMCK YES, PROCESS NEXT VIRTUAL MACHINE@VA04250 01012000
LA R4,K2(,R4) GET NEXT ENTRY ADDR. @VA04250 01013000
B VCHINIT CHECK FOR VALID ENTRY @VA04250 01014000
SPACE 1 01015000
VCHPRC EQU * @VA11255 01016000
ST R4,CHDEX SAVE ADDR CURR CH INDEX TBL ENTRY@VA04250 01017000
LH R5,K0(,R4) INDEX INTO VCHBLOK'S FOR THIS CH @VA04250 01018000
A R5,VCHSTRT + START ADDR VCHBLOKS=NEW BLK ADD@VA04250 01019000
ST R5,WORK2 SAVE ADDR FOR TRANSLATION @VA04250 01020000
MVI ERRINDX,IX0B SET ERROR INDEX FOR GETPAGE @VA01570 01021000
LA R3,VCHSIZE SIZE @VA04250 01022000
BAL R2,GETPAGE GET PAGE WITH VCHBLOK @VA04250 01023000
USING VCHBLOK,R9 @VA04250 01024000
MVC CUINDEX(K32),VCHCUTBL SAVE VIRTUAL CU INDEX TBL.@VA04250 01025000
SLL R3,3 8=NO. OF BYTES TO MOVE FOR TRANS.@VA04250 01026000
BAL R6,TRANINIT TRANSLATE VCHBLOK AND ITS ADDR @VA04250 01027000
SPACE 1 01028000
* VCHBLOK HEADINGS FORMATED HERE 01029000
SPACE 1 01030000
MVC HCHBADDR(6),WORK+2 BLOK ADDRESS @VA04250 01031000
SR R4,R4 CLEAR REG @VA04250 01032000
IC R4,VCHADD GET CHANNEL ADDR. @VA04250 01033000
LA R5,TTAB ADDR TRANSLATE TABLE @VA04250 01034000
AR R4,R5 ADDR. OF TRANSLATED CHAR. @VA04250 01035000
MVC HCHNO(K1),K0(R4) PUT CHAR. IN HEADING @VA04250 01036000
SPACE 1 01037000
* SETUP FOR WRITING CHANNEL BLOCK 01038000
SPACE 1 01039000
LA R2,HCHBLK ADDR VCHBLOK HEADING @VA04250 01040000
LA R3,3 HEADINGS @VA04250 01041000
LA R5,VCHSIZE NO. OF DOUBLE WORDS TO PRINT @VA04250 01042000
LA R7,FVCHBLK INITIAL START ADDR IN O/P AREA @VA04250 01043000
BAL R6,BLKPRINT PRINT BLOCK @VA04250 01044000
SPACE 1 01045000
* THIS SECTION FORMATS VIRTUAL CONTROL UNIT BLOCKS-VCUBLOK 01046000
SPACE 1 01047000
L R4,CUDEX ADDR INIT ENTRY IN CU INDEX TBL @VA04250 01048000
VCUINIT EQU * @VA04250 01049000
CLC K0(K2,R4),FFFF VALID CU TABLE ENTRY? @VA04250 01050000
BNE VCUPRC YES, FORMAT CU BLOCK @VA11255 01051000
VCULOOP EQU * @VA01570 01052000
C R4,VCULAST LAST CONTROL UNIT ENTRY? @VA04250 01053000
BE CHANCK YES, CHECK FOR ANOTHER CHANNEL @VA04250 01054000
LA R4,K2(,R4) GET NEXT ENTRY ADDR. @VA04250 01055000
B VCUINIT CHECK NEXT ENTRY @VA04250 01056000
SPACE 1 01057000
* AT THIS POINT REG 4 CONTAINS ADDR OF INDEX TABLE ENTRY FOR VCUBLOK 01058000
* TO BE PROCESSED 01059000
SPACE 01060000
VCUPRC EQU * @VA11255 01061000
ST R4,CUDEX SAVE ADDR CURR CU INDEX TBL ENTRY@VA04250 01062000
LH R5,K0(,R4) GET DISP INTO CU TBLS FOR THIS CU@VA04250 01063000
A R5,VCUSTRT PLUS CU TBL.BASE=RCUBLOK ADDR @VA04250 01064000
ST R5,WORK2 SAVE VCUBLOK ADDR FOR TRANSLATION@VA04250 01065000
MVI ERRINDX,IX0C SET ERROR INDEX FOR GETPAGE @VA01570 01066000
LA R3,VCUSIZE SIZE @VA04250 01067000
BAL R2,GETPAGE GET PAGE CONTAINING VCUBLOK @VA04250 01068000
USING VCUBLOK,R9 @VA04250 01069000
MVC DEVINDEX(K32),VCUDVTBL SAVE DEV NDX TBL FOR THIS@VA04250 01070000
* CONTROL UNIT 01071000
SLL R3,3 8=NO. OF BYTES TO TRANSLATE @VA04250 01072000
BAL R6,TRANINIT TRANSLATE VCUBLOK & ITS ADDR @VA04250 01073000
SPACE 1 01074000
* VCUBLOK HEADINGS FORMATED HERE 01075000
SPACE 1 01076000
MVC HCUBADDR(6),WORK+2 BLOK ADDRESS @VA04250 01077000
SR R4,R4 CLEAR REG. @VA04250 01078000
IC R4,VCUADD+1 GET CONTROL UNIT ADDR. @VA04250 01079000
SRL R4,4 ISOLATE UNIT ADDR. @VA04250 01080000
LA R5,TTAB ADDR TRANSLATE TABLE @VA04250 01081000
AR R4,R5 ADDR. OF TRANSLATED CHAR. @VA04250 01082000
MVC HCUNO+1(K1),K0(R4) PUT CU ADDR IN HEADING @VA04250 01083000
MVC HCUNO(K1),HCHNO PUT CHAN NO. IN UNIT ADDR. @VA04250 01084000
SPACE 1 01085000
* SET UP FOR WRITING VIRTUAL CONTROL UNIT BLOCK 01086000
SPACE 1 01087000
LA R2,HCUBLK ADDR OF VCUBLOK HEADING @VA04250 01088000
LA R3,K3 NO. OF HEADING LINES @VA04250 01089000
LA R5,VCUSIZE NO. OF DOUBLE WORDS IN VCUBLOK @VA04250 01090000
LA R7,FVCUBLK INITIAL START ADDR IN O/P AREA @VA04250 01091000
BAL R6,BLKPRINT GO PRINT VCUBLOK @VA04250 01092000
* 01093000
* THIS SECTION FORMATS VIRTUAL DEVICE BLOCKS 01094000
* 01095000
L R4,DEVDEX ADDR INIT ENTRY IN DEV INDEX TBL @VA04250 01096000
VDVINIT EQU * @VA04250 01097000
CLC K0(K2,R4),FFFF VALID DEVICE TABLE ENTRY? @VA04250 01098000
BNE VDEVPRC YES, FORMAT DEVICE BLOCK @VA11255 01099000
DEVCK EQU * @VA01570 01100000
C R4,DEVLAST LAST DEVICE ENTRY IN TBL. @VA04250 01101000
BE CUCK YES, CK FOR ANOTHER CONTROL UNIT @VA04250 01102000
LA R4,K2(,R4) GET NEXT ENTRY ADDR. @VA04250 01103000
B VDVINIT CHECK NEXT ENTRY @VA04250 01104000
SPACE 1 01105000
* AT THIS POINT REG 4 CONTAINS ADDR OF INDEX TABLE ENTRY FOR VDEVBLOK 01106000
* TO BE PROCESSED 01107000
SPACE 01108000
VDEVPRC EQU * @VA11255 01109000
ST R4,DEVDEX SAVE ADDR CURR DEV NDX TBL ENTRY @VA04250 01110000
LH R5,K0(,R4) DISP INTO RDEVBLOKS FOR THIS DEV @VA04250 01111000
NOCON EQU * @VA04250 01112000
A R5,VDVSTRT PLUS DEV TBL'S BASE=VDEVBLOK ADDR@VA04250 01113000
ST R5,WORK2 SAVE VDEVBLOK ADDR FOR TRANS @VA04250 01114000
MVI ERRINDX,IX0D SET ERROR INDEX FOR GETPAGE @VA01570 01115000
LA R3,VDEVSIZE @VA04250 01116000
BAL R2,GETPAGE GET PAGE WITH VDEVBLOK @VA04250 01117000
USING VDEVBLOK,R9 @VA04250 01118000
TM VDEVTYPC,CLASURI+CLASURO SPOOL DEV ?? @VA04250 01119000
BZ TSTCON NO @VA04250 01120000
L R5,VDEVSPL GET BLOK @VA04250 01121000
LTR R5,R5 TEST @VA04250 01122000
BZ DODEV NONE @VA04250 01123000
ST R5,ERRBLOCK SAVE @VA04250 01124000
OI SPOOLSW,XFF SET SW @VA04250 01125000
B DODEV CONT @VA04250 01126000
TSTCON TM VDEVTYPC,CLASTERM TERMINAL ?? @VA04250 01127000
BZ TSTIOB NO @VA04250 01128000
CLI VDEVTYPE,TYP3215 VIRT CONSOLE ?? @VA04250 01129000
BNE TSTIOB NO @VA04250 01130000
L R5,VDEVCON GET BLOK @VA04250 01131000
LTR R5,R5 TEST @VA04250 01132000
BZ DODEV NONE @VA04250 01133000
ST R5,ERRBLOCK SAVE @VA04250 01134000
OI CONSW,XFF SET SW @VA04250 01135000
B DODEV CONT @VA04250 01136000
TSTIOB L R5,VDEVIOB ANY ACTIVE IOB ?? @VA04250 01137000
LTR R5,R5 .. @VA04250 01138000
BZ TSTIOER NO @VA04250 01139000
ST R5,AIOB SAVE @VA04250 01140000
MVI ACTIOBSW,XFF SET SW @VA04250 01141000
TSTIOER L R5,VDEVIOER GET BLOK @VA04250 01142000
LTR R5,R5 TEST @VA04250 01143000
BZ DODEV NONE @VA04250 01144000
OI IOERSW,XFF SET SW @VA04250 01145000
ST R5,ERRBLOCK SAVE @VA04250 01146000
DODEV LA R3,VDEVSIZE VDEVBLOK SIZE IN DWORDS TIMES @VA04250 01147000
SLL R3,3 8=NO. OF BYTES TO TRANSLATE @VA04250 01148000
BAL R6,TRANINIT TRANSLATE VDEVBLOK & ITS ADDR @VA04250 01149000
SPACE 1 01150000
* VDEVBLOK HEADINGS FORMATED HERE 01151000
SPACE 1 01152000
MVC HDBADDR(6),WORK+2 BLOK ADDRESS @VA04250 01153000
MVC HDEVNO(K1),VDEVADD+1 GET CU & DEVICE ADDR. @VA04250 01154000
NI HDEVNO,255-XF0 CLEAR CU ADDR. @VA04250 01155000
SR R4,R4 CLEAR REG. @VA04250 01156000
IC R4,HDEVNO GET DEVICE ADDR. @VA04250 01157000
LA R5,TTAB ADDR TRANSLATE TABLE @VA04250 01158000
AR R4,R5 ADDR. OF TRANSLATED CHAR. @VA04250 01159000
MVC HDEVNO+K2(K1),K0(R4) PUT DEV ADR IN CHAR IN HEAD@VA04250 01160000
MVC HDEVNO(K2),HCUNO PUT CH & CU ADDR IN DEV ADDR@VA04250 01161000
SPACE 1 01162000
* SETUP FOR WRITING VIRTUAL DEVICE BLOCK 01163000
SPACE 1 01164000
LA R2,HDEVBLK ADDR HEADING LINES @VA04250 01165000
LA R3,3 HEADINGS @VA04250 01166000
LA R5,VDEVSIZE NO. OF DOUBLE WORDS TO PRINT @VA04250 01167000
LA R7,FVDEVBLK INITIAL START ADDR OF O/P AREA @VA04250 01168000
BAL R6,BLKPRINT PRINT VDEVBLOK @VA04250 01169000
SPACE 1 01170000
* IF THIS DEVICE IS THE CONSOLE, VCONCTL BLOCK IS PRINTED HERE 01171000
SPACE 1 01172000
TM CONSW,XFF IS THIS VIRTUAL CONSOLE? @VA04250 01173000
BZ TSTSPOOL NO,TEST FOR SPOOLING DEVICE @VA04250 01174000
NI CONSW,255-XFF CLEAR CONSOLE SWITCH @VA04250 01175000
L R5,ERRBLOCK GET ADDRESS @VA04250 01176000
ST R5,WORK2 ADDR OF BLOCK FOR TRANSLATION @VA04250 01177000
MVI ERRINDX,IX0E SET ERROR INDEX FOR GETPAGE @VA01570 01178000
LA R3,VCONSIZE SIZE @VA04250 01179000
BAL R2,GETPAGE GET PAGE WITH VCONCTL BLOCK @VA04250 01180000
SLL R3,3 TIMES 8=NO. OF BYTES TO TRANSLATE@VA04250 01181000
BAL R6,TRANINIT TRANSLATE BLOCK @VA04250 01182000
MVC HIOBLKS(K13),HVCONCTL SET TOP HEADING LINE @VA04250 01183000
MVC HIOBADDR(6),WORK+2 BLOK ADDRESS @VA04250 01184000
LA R2,HIOBLKS ADDR HEADING LINES @VA04250 01185000
LA R3,K2 NO. OF HEADING LINES @VA04250 01186000
LA R4,K4 NO. OF BLOCKS/LINE @VA04250 01187000
LA R5,VCONSIZE NO. OF BLOCKS TO PRINT @VA04250 01188000
LA R7,FSPOOL START ADDR IN O/P AREA @VA04250 01189000
BAL R6,BLKPRINT PRINT OUT VCONCTL BLOCK @VA04250 01190000
B NXTVDEV DO NEXT @VA04250 01191000
SPACE 1 01192000
* IF THIS DEVICE IS A UNIT RECORD TYPE, VSPLCTL & SFBLOK FORMATED HERE 01193000
SPACE 1 01194000
TSTSPOOL EQU * @VA04250 01195000
TM SPOOLSW,XFF IS THIS A SPOOLING DEVICE? @VA04250 01196000
BZ VIOB NO, CHECK FOR IOERBLOK @VA04250 01197000
NI SPOOLSW,255-XFF CLEAR SWITCH @VA04250 01198000
L R5,ERRBLOCK GET ADDRESS @VA04250 01199000
ST R5,WORK2 ADDR OF BLOCK FOR TRANSLATION @VA04250 01200000
MVI ERRINDX,IX0F SET ERROR INDEX FOR GETPAGE @VA01570 01201000
LA R3,VSPSIZE SIZE @VA04250 01202000
BAL R2,GETPAGE GET PAGE WITH VSPLCTL @VA04250 01203000
USING VSPLCTL,R9 @VA04250 01204000
L R5,VSPSFBLK GET NEXT @VA04250 01205000
ST R5,SPOOLSAV SAVE @VA04250 01206000
SLL R3,3 8=NO. OF BYTES TO TRANSLATE @VA04250 01207000
BAL R6,TRANINIT TRANSLATE BLOCK & ITS ADDR @VA04250 01208000
MVC HIOBLKS(K13),HVSPLCTL SET TOP HEADING LINE @VA04250 01209000
MVC HIOBADDR(6),WORK+2 BLOK ADDRESS @VA04250 01210000
SPACE 1 01211000
* SETUP FOR WRITING VSPLCTL BLOCK 01212000
SPACE 1 01213000
LA R2,HIOBLKS ADDR HEADING LINES @VA04250 01214000
LA R3,K2 NO. OF HEADING LINES @VA04250 01215000
LA R5,VSPSIZE NO. OF DOUBLE WORDS TO PRINT @VA04250 01216000
LA R7,FSPOOL INITIAL START ADDR IN O/P AREA @VA04250 01217000
BAL R6,BLKPRINT GO PRINT VSPLCTL BLOCK @VA04250 01218000
BAL R6,SFPRINT GO TO SFBLOK PRINT ROUTINE @VA04250 01219000
B NXTVDEV DO NEXT @VA04250 01220000
VIOB TM ACTIOBSW,XFF ANY IOB ?? @VA04250 01221000
BZ VIOER NO @VA04250 01222000
MVC HIOBLKS(13),HACTIO @VA04250 01223000
MVC IOBCHAIN,AIOB SET ADDRESS @VA04250 01224000
BAL R6,IOBPRINT PRINT IT @VA04250 01225000
MVI ACTIOBSW,X00 @VA04250 01226000
VIOER TM IOERSW,XFF TEST FOR IOER BLOK @VA04250 01227000
BZ NXTVDEV DO NEXT @VA04250 01228000
BAL R6,IOERPRC PRINT IT @VA11255 01229000
SPACE 1 01230000
* A CHECK IS MADE HERE FOR THE END OF THE DEVICE, CONTROL UNIT, 01231000
* CHANNEL INDEX TABLES AND VMBLOKS 01232000
SPACE 1 01233000
NXTVDEV L R4,DEVDEX ADDR OF CURRENT DEV. INDEX VALUE @VA04250 01234000
B DEVCK CHECK FOR LAST TABLE ENTRY @VA04250 01235000
CUCK EQU * @VA04250 01236000
LA R4,DEVINDEX ADDR 1ST ENTRY IN DEV INDEX TBL @VA04250 01237000
ST R4,DEVDEX REINITIALIZE DEV INDEX PTR FOR @VA04250 01238000
* NEXT CONTROL UNIT 01239000
L R4,CUDEX ADDR OF CURRENT CU INDEX VALUE @VA04250 01240000
B VCULOOP CHECK FOR LAST TABLE ENTRY @VA04250 01241000
CHANCK EQU * @VA04250 01242000
LA R4,CUINDEX ADDR 1ST ENTRY IN CU INDEX TBL. @VA04250 01243000
ST R4,CUDEX REINITIALIZE CU INDEX TBL PTR @VA04250 01244000
* FOR NEXT CHANNEL 01245000
L R4,CHDEX ADDR CURRENT CHAN INDEX VALUE @VA04250 01246000
B LOOPCH CHECK FOR LAST TABLE ENTRY @VA04250 01247000
VMCK EQU * @VA04250 01248000
LA R4,CHINDEX ADDR 1ST ENTRY IN CH INDEX TABLE @VA04250 01249000
ST R4,CHDEX REINITIALIZE CH TBL PTR FOR NEXT @VA04250 01250000
* VIRTUAL MACHINE 01251000
L R5,VMCURENT ADDR CURRENT VMBLOK @VA04250 01252000
BAL R6,SEGPGTB GO TO SEGMENT TABLE PROCESSING @VA04250 01253000
LA R10,DATA RESTORE ADDR. FOR O/P AREA DSECT @VA04250 01254000
CLC VMCHAIN(K4),VMPTR END OF VIRTUAL PROCESSING? @VA04250 01255000
BE HEXDUMP GO DO HEX DUMP IF REQUIRED @VA04250 01256000
L R5,VMCHAIN GET ADDR NEXT VMBLOK IN CHAIN @VA04250 01257000
LTR R5,R5 TEST FOR ONE ONLY @VA04250 01258000
BZ HEXDUMP DONE @VA04250 01259000
TM VMBSW,XF0 DOINF SYSVMBLK ?? @VA04250 01260000
BZ VMPRC NO @VA11255 01261000
NI VMBSW,X0F SW OFF @VA04250 01262000
ST R5,VMPTR SAVE 1ST VMBLOK ADDR FOR CHAIN CK@VA04250 01263000
B VMPRC PROCESS NEXT VIRTUAL MACHINE @VA11255 01264000
EJECT 01265000
* 01266000
* SUBROUTINE TO PRINT FORMATED I/O BLOCKS 01267000
* INPUT- R2= ADDR OF BLOCK HEADING, R3-NO. OF LINES IN HEADING, R4-NO. 01268000
* OF BLOCKS OF DATA(16 CHARS) TO PRINT/LINE, R5-TOTAL NO. OF DATA 01269000
* BLOCKS, R7-ADDR FOR START OF DATA 01270000
* 01271000
BLKPRINT EQU * @VA04250 01272000
ST R6,RTNSAVE SAVE RETURN ADDR @VA04250 01273000
LR R9,R5 GET DBL WORD COUNT @VA04250 01274000
SRL R9,2 GET NUMBER OF LINE FOR BLOCK @VA04250 01275000
AH R9,LINECT ADD COURRENT LINE COUNTER @VA04250 01276000
LA R9,2(R9) PLUS 2 FOR SPACING @VA04250 01277000
CH R9,=H'59' ENOUGH ON ONE PAGE ?? @VA10490 01278001
BNH SETUP YES, CONT @VA04250 01279000
STH R9,LINECT FORCE EJECT @VA04250 01280000
SETUP DS 0H @VA04250 01281000
LR R1,R7 SAVE O/P POINTER @VA04250 01282000
LA R9,WORK+8 START ADDR OF TRANSLATED BLOCK @VA04250 01283000
MVI SPACENUM+K1,X01 1 FOR LINE COUNTER @VA04250 01284000
MVI CTL,SPACE1 SET SINGLE SPACING @VA04250 01285000
MVCLOOP EQU * @VA04250 01286000
LA R8,4 FOUR DBL WORDS PER LINE @VA04250 01287000
LR R7,R1 RESET O/P POINTER @VA04250 01288000
HDTEST EQU * @VA04250 01289000
TM PRTENDSW,XF0 LAST HEAD ALREADY PRINTED? @VA04250 01290000
BO TSTDATA TEST FOR MORE DATA @VA04250 01291000
BCT R3,NOHDEND LAST HEAD LINE TEST @VA04250 01292000
OI PRTENDSW,XF0 SET LAST HEAD LINE SWITCH @VA04250 01293000
NOHDEND EQU * @VA04250 01294000
MVC K0(K14,R7),K0(R2) PUT HEAD IN O/P AREA @VA04250 01295000
LA R2,14(R2) NEXT HEADING @VA04250 01296000
TSTDATA TM PRTENDSW,X0F ANY MORE DATA @VA04250 01297000
BO PRNTLINE NO, PRINT @VA04250 01298000
CH R5,=H'4' MORE THAN 1 LINE LEFT ?? @VA04250 01299000
BH FULLINE YES @VA04250 01300000
LR R8,R5 SET COUNT @VA04250 01301000
OI PRTENDSW,X0F SET SW @VA04250 01302000
FULLINE SH R5,=H'4' REMAINING @VA04250 01303000
POSMOVE LA R7,2(R7) SPACE OVER @VA04250 01304000
UNPK WORK3(5),LINEHEX(3) GET HEX DISP @VA04250 01305000
TR WORK3(4),TTAB-240 @VA04250 01306000
MVC 14(3,R7),WORK3+1 SET DISP @VA04250 01307000
LH R4,LINEHEX GET COUNT @VA04250 01308000
LA R4,32(R4) BUMP COUNTER @VA04250 01309000
STH R4,LINEHEX SAVE @VA04250 01310000
DATAMOVE EQU * @VA04250 01311000
LA R7,K18(,R7) INCREMENT O/P POINTER @VA04250 01312000
MVC 0(8,R7),0(R9) MOVE FIRST WORD @VA04250 01313000
MVC 9(8,R7),8(R9) MOVE SECOND WORD @VA04250 01314000
LA R9,K16(,R9) INCREMENT TRANSLATED DATA POINTER@VA04250 01315000
BCT R8,DATAMOVE MOVE NEXT BLK IF NOT END OF LINE @VA04250 01316000
PRNTLINE EQU * @VA04250 01317000
CLI PRTENDSW,XFF ALL DONE @VA04250 01318000
BNE PRNTSP NO, PRINT AND CONT @VA04250 01319000
TM VMBSW,X0F DOING VMBLOK ?? @VA04250 01320000
BO SKIPSP YES @VA04250 01321000
BAL R6,PRINTA PRINT IT @VA04250 01322000
MVC LINEHEX,=H'0' CLEAR LINE DISP @VA04250 01323000
MVI CTL,SPACE2 SET SPACING @VA04250 01324000
MVI SPACENUM+1,2 @VA04250 01325000
SKIPSP BAL R6,PRINTA PRINT LINE @VA04250 01326000
MVI PRTENDSW,X00 CLEAR @VA04250 01327000
L R6,RTNSAVE RETURN @VA04250 01328000
BR R6 @VA04250 01329000
PRNTSP BAL R6,PRINTA PRINT LINE @VA04250 01330000
B MVCLOOP CONT @VA04250 01331000
EJECT 01332000
* 01333000
* IOBLOK PRINT SUBROUTINE. THIS ROUTINE PRINTS ALL IOBLOKS CHAINED 01334000
* OFF OF THE CHANNEL, CONTROL UNIT, OR DEVICE BLOCK THAT IS 01335000
* CURRENTLY BEING PROCESSED. THE FIELD 'IOBCHAIN' CONTAINS THE 01336000
* ADDR. OF THE FIRST IOBLOK CHAINED(IF ANY) TO THAT BLOCK. 01337000
* 01338000
IOBPRINT EQU * @VA04250 01339000
USING IOBLOK,R9 @VA04250 01340000
L R5,IOBCHAIN GET ADDR OF NEXT CHANNEL IOBLOK @VA04250 01341000
C R5,CHAINCK IS THERE AN IOBLOK CHAINED TO BLK@VA04250 01342000
BCR 8,R6 NO, RETURN @VA04250 01343000
ST R6,IOBRTN SAVE RETURN ADDR. @VA04250 01344000
IOBLOOP EQU * @VA04250 01345000
ST R5,WORK2 PUT BLOCK ADDR IN TRANS. @VA04250 01346000
MVI ERRINDX,IX10 SET ERROR INDEX FOR GETPAGE @VA01570 01347000
LA R3,IOBSIZE SIZE @VA04250 01348000
BAL R2,GETPAGE GET PAGE WITH THIS IOBLOK @VA04250 01349000
SLL R3,3 8=NO. OF BYTES TO TRANSLATE @VA04250 01350000
MVC IOBSAVE(4),IOBCHAIN REMEMBER THIS IOBLOK @VA07496 01351000
MVC IOBCHAIN(4),IOBFPNT SAVE ADDR NEXT IOBLOK CHAIND@VA04250 01352000
BAL R6,TRANINIT TRANSLATE FIELD @VA04250 01353000
MVC HIOBADDR(6),WORK+2 BLOK ADDRESS @VA04250 01354000
SPACE 1 01355000
* SETUP FOR WRITING IOBLOK 01356000
SPACE 1 01357000
LA R2,HIOBLKS ADDR OF IOBLOK HEADING @VA04250 01358000
LA R3,K2 NO. OF HEADING LINES @VA04250 01359000
LA R5,IOBSIZE NO. OF DOUBLE WORDS TO PRINT @VA04250 01360000
LA R7,FIOBLK INITIAL START ADDR IN O/P AREA @VA04250 01361000
BAL R6,BLKPRINT GO PRINT IOBLOK @VA04250 01362000
TM ACTIOBSW,XFF IS THIS AN ACTIVE IOBLOK? @VA04250 01363000
BO IOBACK YES, ONLY ONE TO PRINT @VA04250 01364000
L R5,IOBCHAIN GET ADDR OF NEXT IOBLOK @VA04250 01365000
CLC IOBSAVE(4),IOBCHAIN NEXT SAME AS LAST @VA07496 01366000
BE IOBACK YES, DON'T LOOP PRINTING IT @VA07496 01367000
CL R5,CHAINCK ANOTHER BLOCK ON CHAIN? @VA04250 01368000
BNE IOBLOOP YES,PROCESS NEXT BLOCK @VA04250 01369000
IOBACK EQU * @VA04250 01370000
L R6,IOBRTN GET RETURN ADDR. @VA04250 01371000
BR R6 RETURN @VA04250 01372000
EJECT 01373000
* THIS SUBROUTINE PRINTS A FORMATED SFBLOK. INPUT: THE FIELD 01374000
* 'SPOOLSAV' CONTAINS THE ADDR. OF THE SFBLOK TO PRINT 01375000
SPACE 1 01376000
SFPRINT EQU * @VA04250 01377000
ST R6,SFRTN SAVE RETURN ADDR. @VA04250 01378000
L R5,SPOOLSAV GET ADDR OF SFBLOK @VA04250 01379000
ST R5,WORK2 ADDR OF BLOCK FOR TRANSLATION @VA04250 01380000
MVI ERRINDX,IX11 SET ERROR INDEX FOR GETPAGE @VA01570 01381000
LA R3,SFBSIZE SIZE @VA04250 01382000
BAL R2,GETPAGE GET PAGE CONTAING BLOCK @VA04250 01383000
USING SFBLOK,R9 @VA04250 01384000
L R4,SFBPNT GET NEXT SFBLOK POINTER @VA04250 01385000
ST R4,NXTSFBK SAVE @VA04250 01386000
SLL R3,3 8=NO. OF BYTES TO TRANSLATE @VA04250 01387000
BAL R6,TRANINIT TRANSLATE BLOCK AND ITS ADDR @VA04250 01388000
MVC HSFID(8),SFBUSER USERID @VA04250 01389000
MVC HSFADDR(6),WORK+2 @VA04250 01390000
LA R2,HSFBLK @VA04250 01391000
LA R3,K3 NO. OF HEADING LINES @VA04250 01392000
LA R5,SFBSIZE NO. OF DOUBLE WORDS TO PRINT @VA04250 01393000
LA R7,FSPOOL INITIAL START ADDR IN O/P AREA @VA04250 01394000
BAL R6,BLKPRINT GO PRINT SFBLOK @VA04250 01395000
SFERR EQU * @VA02332 01396000
L R6,SFRTN GET RETURN ADDR. @VA04250 01397000
BR R6 RETURN @VA04250 01398000
SPACE 1 01399000
* THIS SUBROUTINE PRINTS THE IOERBLOK. INPUT: IF THERE IS A 01400000
* BLOCK TO PRINT THE SWITCH 'IOERSW' WILL CONTAIN A X'FF' AND 01401000
* THE FIELD 'ERRBLOCK' WILL CONTAIN THE ADDR. OF THE BLOCK TO 01402000
* PRINT 01403000
SPACE 1 01404000
IOERPRC EQU * @VA11255 01405000
ST R6,IOERSAV SAVE RETURN ADDR. @VA04250 01406000
NI IOERSW,255-XFF CLEAR SWITCH @VA04250 01407000
L R5,ERRBLOCK GET ADDR OF IOERBLOK @VA04250 01408000
ST R5,WORK2 PUT IN TRANSLATION AREA @VA04250 01409000
MVI ERRINDX,IX12 SET ERROR INDEX FOR GETPAGE @VA01570 01410000
LA R3,IOERSIZE SIZE @VA04250 01411000
BAL R2,GETPAGE GET PAGE WITH BLOCK @VA04250 01412000
USING IOERBLOK,R9 @VA04250 01413000
SLL R3,3 8=NO. OF BYTES TO TRANSLATE @VA04250 01414000
BAL R6,TRANINIT TRANSLATE BLOCK AND ITS ADDR @VA04250 01415000
MVC HIOBLKS(13),HIOERBLK PUT 'IOERBLOK' IN HEADING @VA04250 01416000
MVC HIOBADDR(6),WORK+2 BLOK ADDRESS @VA04250 01417000
LA R2,HIOBLKS ADDR HEADING LINES @VA04250 01418000
LA R3,K2 NO. OF HEADING LINES @VA04250 01419000
LA R5,IOERSIZE NO. OF DOUBLE WORDS TO PRINT @VA04250 01420000
LA R7,FSPOOL @VA04250 01421000
BAL R6,BLKPRINT GO PRINT IOERBLOK @VA04250 01422000
IOERERR EQU * RETURN FROM ERROR @VA01570 01423000
L R6,IOERSAV GET RETURN ADDR. @VA04250 01424000
BR R6 RETURN @VA04250 01425000
EJECT 01426000
* ******************************************** 01427000
* * THIS SUBROUTINE WILL PRINTOUT THE PTR, * 01428000
* * PCH,AND RDR SFBLOK CHAINS. * 01429000
* ******************************************** 01430000
SPACE 3 01431000
SFFORM EQU * @VA04250 01432000
MVC LINECT,=H'60' FORCE EJECT @VA04250 01433000
MVC DATA+2(K19),=C'PRINTER SPOOL CHAIN' @VA04250 01434000
MVI ERRINDX,IX13 SET ERROR INDEX FOR GETPAGE @VA01570 01435000
L R5,PRTSPL GET PTR SPOOL POINTER @VA04250 01436000
SFFORM1 LA R3,1 ONE WORD @VA04250 01437000
BAL R2,GETPAGE @VA04250 01438000
L R5,K0(,R9) GET ADR OF SFBLOK @VA04250 01439000
BAL R6,PRINTA GO PRINT HEADING @VA04250 01440000
SFFORM2 LTR R5,R5 EQUAL TO ZERO @VA04250 01441000
BZ SFFORM7 BRANCH IF YES @VA04250 01442000
MVI SFFORM7+1,XF0 SET SWITCH @VA04250 01443000
ST R5,SPOOLSAV ADDRESS OF SFBLOK @VA04250 01444000
BAL R6,SFPRINT PRINT BLOCK @VA04250 01445000
L R5,NXTSFBK GET NEXT BLOK ADDRESS @VA04250 01446000
B SFFORM2 @VA04250 01447000
SPACE 2 01448000
SFFORM7 NOP SFFORM8 @VA04250 01449000
MVI CTL,SPACE3 @VA04250 01450000
MVI SPACENUM+1,X03 @VA04250 01451000
MVC DATA+16(K24),=C'NO SFBLOKS ON THIS CHAIN' @VA04250 01452000
SFFORM8 BAL R6,PRINTA PRINT EXTRA BLANK LINE @VA04250 01453000
SFFORMC NOP SFFORM9 @VA04250 01454000
MVC DATA+2(K17),=C'PUNCH SPOOL CHAIN' @VA04250 01455000
MVI SFFORM7+1,X00 RESTORE NOP @VA04250 01456000
MVI SFFORMC+1,XF0 @VA04250 01457000
L R5,PNCHSPL GET PUNCH SPOOL POINTER @VA04250 01458000
B SFFORM1 @VA04250 01459000
SFFORM9 NOP CORTBL @VA04250 01460000
MVC DATA+2(K18),=C'READER SPOOL CHAIN' @VA04250 01461000
MVI SFFORM7+1,X00 RESTORE TO NOP @VA04250 01462000
MVI SFFORM9+1,XF0 @VA04250 01463000
L R5,RDRSPL GET RDR SPOOL POINTER @VA04250 01464000
B SFFORM1 @VA04250 01465000
EJECT 01466000
* ************************************************** 01467000
* * * THE FOLLOWING ROUTINE WILL FORMAT AND PRINT * 01468000
* * OUT THE CORETABLE. * 01469000
* ************************************************** 01470000
SPACE 3 01471000
USING CORTABLE,R10 @VA04250 01472000
CORTBL MVC LINECT,=H'59' 01473100
L R7,RSYSRV GET REAL STORAGE GENERATION SIZE @VA04250 01474000
SRL R7,12 SIZE IN PAGES @VA04250 01475000
L R5,CORPOINT GET START @VA04250 01476000
CORTBLS LH R6,LINECT GET COUNT @VA04250 01477000
CH R6,=H'59' ENOUGH ON ONE PAGE ?? @VA10490 01478001
BNE CORTBL2 NO @VA04250 01479000
MVI CTL,SPACE1 SETUP FOR SINGLE SPACE @VA04250 01480000
MVI SPACENUM+1,X01 @VA04250 01481000
MVC DATA+30(39),CORTBHD1 HEADING @VA04250 01482000
MVC DATA+72(K21),CORTBHD2 MVE 2ND LINE OF HD TO BUF@VA04250 01483000
MVC DATA+19(7),=C'ADDRESS' @VA04250 01484000
BAL R6,PRINTA @VA04250 01485000
BAL R6,PRINTA PRINT A BLANK LINE @VA01570 01486000
CORTBL2 ST R5,THIS @VA04250 01487000
MVI ERRINDX,IX14 SET ERROR INDEX FOR GETPAGE @VA01570 01488000
LA R3,2 2 DBL WDS @VA04250 01489000
BAL R2,GETPAGE @VA04250 01490000
A R5,BLKSIZE ADD 16 TO GET NXT BLK ADR @VA04250 01491000
ST R5,NXTSFBK @VA04250 01492000
UNPK WORK3(7),THIS+1(4) @VA04250 01493000
TR WORK3(6),TTAB-240 @VA04250 01494000
MVC DATA+20(6),WORK3 @VA04250 01495000
UNPK WORK3(5),PGCT(3) @VA04250 01496000
TR WORK3(4),TTAB-240 @VA04250 01497000
MVC DATA+74(3),WORK3+1 PAGE NUMBER @VA04250 01498000
MVC WORK2(K16),K0(R9) SAVE THE BLOCK @VA04250 01499000
SPACE 2 01500000
* GO GET USERS NAME 01501000
SPACE 2 01502000
USING CORTABLE,R10 @VA04250 01503000
CORTBL3 LR R10,R9 @VA04250 01504000
L R8,=A(ITEM2) RESTORE R8 TO POINT TO ITEM2 @VA08574 01505000
CLC I2VM,CORFPNT IS THIS THE VMBLOK? @VA08574 01506000
BNE CORTBL4 NO @VA04250 01507000
MVC DATA+82(18),=CL18'CP- RESIDENT' @VA04250 01508000
B CORTBL9 @VA04250 01509000
CORTBL4 CLC FREEID(K4),CORFPNT EQUAL TO FREE @VA04250 01510000
BNE CORTBL5 NO @VA04250 01511000
MVC DATA+82(18),=CL18'CP- FREE STORAGE' @VA04250 01512000
B CORTBL9 @VA04250 01513000
CORTBL5 TM CORFLAG,CORCP IS IT A CP PAGE ?? @VA04250 01514000
BNO CORTBL6 NO @VA04250 01515000
MVC DATA+82(18),=CL18'CP- PAGEABLE' @VA04250 01516000
B CORTBL9 @VA04250 01517000
SPACE 1 01518000
CORTBL6 TM CORFLAG,CORFREE CHECK TO SEE IF ON FREE LIST@VA04250 01519000
BO CORTBLA YES @VA04250 01520000
TM CORFLAG,CORDISA DISABLED ?? @VA04250 01521000
BO CORTBLE YES @VA04250 01522000
CLC CORFPNT,=CL4'*OL*' OFFLINE ?? @VA04250 01523000
BNE CORTBLB NO @VA04250 01524000
CORTBLE MVC DATA+82(18),=CL18'CP- OFFLINE' @VA04250 01525000
B CORTBL9 @VA04250 01526000
CORTBLA MVC DATA+82(18),=CL18'USER FREE LIST' @VA04250 01527000
B CORTBL9 @VA04250 01528000
CORTBLB TM CORFLAG,CORFLUSH @VA04250 01529000
BZ CORTBLC NO @VA04250 01530000
MVC DATA+82(18),=CL18'USER FLUSH LIST' @VA04250 01531000
B CORTBL9 @VA04250 01532000
CORTBLC TM CORFLAG,CORSHARE @VA04250 01533000
BZ CORTBLD NO @VA04250 01534000
MVC DATA+82(18),=CL18'USER SHARED PAGE' @VA04250 01535000
B CORTBL9 @VA04250 01536000
CORTBLD MVC DATA+82(18),=CL18'USER' @VA04250 01537000
CORTBL6A L R5,CORSWPNT GET SWPTABLE ADDRESS @VA04250 01538000
LA R5,0(R5) CLEAR @VA04250 01539000
MVI ERRINDX,IX15 SET ERROR INDEX FOR GETPAGE @VA01570 01540000
LA R3,1 SIZE @VA04250 01541000
BAL R2,GETPAGE GET SWPTABLE ENTRY @VA04250 01542000
USING SWPTABLE,R10 @VA04250 01543000
LR R10,R9 SAVE SWPTABLE ADDRESS @VA04250 01544000
SR R9,R9 @VA04250 01545000
IC R9,1(R10) GET VIRT PAGE ADDRESS @VA04250 01546000
LA R9,1(R9) UP INDEX @VA04250 01547000
SLL R9,3 TIMES 8 @VA04250 01548000
SR R5,R9 POINT TO VMBLOK POINTER @VA04250 01549000
MVI ERRINDX,IX16 SET ERROR INDEX FOR GETPAGE @VA01570 01550000
LA R3,1 SIZE @VA04250 01551000
BAL R2,GETPAGE @VA04250 01552000
LR R10,R9 LOAD BASE REG @VA04250 01553000
L R5,SWPVM GET VMBLOCK ADDRESS @VA04250 01554000
USING VMBLOK,R10 @VA04250 01555000
MVI ERRINDX,IX17 SET ERROR INDEX FOR GETPAGE @VA01570 01556000
LA R3,VMBSIZE SIZE @VA04250 01557000
BAL R2,GETPAGE GET VMBLOK @VA04250 01558000
LR R10,R9 LOAD BASE REG @VA04250 01559000
MVC DATA+87(K8),VMUSER MOVE USERID TO PRT BUF @VA04250 01560000
CORTBL9 DS 0H @VA04250 01561000
SPACE 2 01562000
* FORMAT COREBLOCK DATA AND PRINT IT 01563000
SPACE 1 01564000
CORTBL7 EQU * @VA04250 01565000
LA R3,K16 LENGTH @VA04250 01566000
BAL R6,TRANINT1 @VA04250 01567000
LA R4,DATA+30 TO FIELD @VA04250 01568000
LA R5,WORK FROM FIELD @VA04250 01569000
LA R2,K32 LENGTH @VA04250 01570000
BAL R6,MVSBRTN @VA04250 01571000
BAL R6,PRINTA @VA04250 01572000
LH R5,PGCT GET PAGE COUNT @VA04250 01573000
LA R5,1(R5) BUMP @VA04250 01574000
STH R5,PGCT SAVE @VA04250 01575000
L R5,NXTSFBK GET NEXT CORETABLE ENTRY @VA04250 01576000
BCT R7,CORTBLS LOOP @VA04250 01577000
B VIRTUALM DO VMBLOKS @VA04250 01578000
SPACE 2 01579000
EJECT 01580000
* ************************************************** 01581000
* * THE FOLLOWING ROUTINE WILL PRINT OUT THE * 01582000
* * * SEGMENT, PAGE, AND SWAP TABLES FOR A USER. * 01583000
* * UPON ENTRY TO THIS ROUTINE * 01584000
* * R5= POINTER TO VMBLOK 01585000
* * R6= RETURN ADDR * 01586000
* ************************************************** 01587000
SPACE 3 01588000
USING VMBLOK,R10 @VA04250 01589000
SEGPGTB ST R6,RETADR SAVE RETURN ADDRESS @VA04250 01590000
MVC SEGNUMB,=H'0' CLEAR @VA04250 01591000
MVI CTL,SPACE1 SETUP FOR TRIPLE SPACE @VA04250 01592000
MVI SPACENUM+1,X01 @VA04250 01593000
MVI ERRINDX,IX18 SET ERROR INDEX FOR GETPAGE @VA01570 01594000
LA R3,VMBSIZE SIZE @VA04250 01595000
BAL R2,GETPAGE GET VMBLOK @VA04250 01596000
LR R10,R9 LOAD INCORE ADR OF VMBLOK IN BASE@VA04250 01597000
L R5,VMSEG GET SEGMENT TABLE ADDR @VA04250 01598000
LTR R5,R5 DOES SEGMENT TABLE PTR=0 @VA04250 01599000
BNZ SEGPGTP1 BR IF NO @VA04250 01600000
MVC DATA+10(50),SEGHD3 MOVE MSG TO PRT BUFFER @VA04250 01601000
BAL R6,PRINTA @VA04250 01602000
B SEGPGTBF GO BACK TO CALLER @VA04250 01603000
SEGPGTP1 MVC DATA+10(40),SEGHD HEADING @VA04250 01604000
MVC LINECT,=H'60' FORCE EJECT @VA04250 01605000
BAL R6,PRINTA PRINT HEADING @VA04250 01606000
SPACE 1 01607000
SEGPGTBE ST R5,SEGSAVE SAVE IT @VA04250 01608000
L R10,VMSIZE GET NUMBER OF SEGMENTS TO BE @VA01570 01609000
* PRINTED 01610000
A R10,K64M1 ADJUST FOR PARTIAL SEGMENTS @VA01570 01611000
SRL R10,16 AND DROP REMAINDER @VA01570 01612000
DROP R10 @VA04250 01613000
L R5,SEGSAVE RESTORE SEGMENT TBL ADR @VA04250 01614000
SEGPGTB1 LA R3,1 SIZE @VA04250 01615000
MVI ERRINDX,IX19 SET ERROR INDEX FOR GETPAGE @VA01570 01616000
BAL R2,GETPAGE @VA04250 01617000
MVC PAGNUMB,=H'0' RESET PAGE COUNT @VA01570 01618000
MVI SEGPGTBA+1,X00 INIT THE FIRST SWITCH @VA01570 01619000
MVI SEGPGTBB+1,X00 AND THE SECOND TOO @VA01570 01620000
BAL R6,PRINTA PRINT A BLANK LINE @VA01570 01621000
MVC WORK2(K4),K0(R9) PLACE ENTRY INTO WORK2 @VA04250 01622000
L R5,K0(,R9) LOAD PAGE TABLE ADDR INTO R5 @VA04250 01623000
LA R5,0(R5) CLEAR HI BYTE @VA04250 01624000
S R5,=F'4' R5 POINTS TO PG TBL -4 @VA04250 01625000
SR R7,R7 CLEAR @VA04250 01626000
TM 3(R9),X'01' IS SEGMENT VALID ?? @VA04250 01627000
BO SEGPGTBD NO @VA04250 01628000
L R7,0(,R9) LOAD PAGETABLE ADDRESS @VA01127 01629000
SRL R7,28 GET NUMBER OF PAGE ENTRIES -1 @VA01127 01630000
LA R7,1(,R7) ADD ONE @VA01127 01631000
SEGPGTB2 ST R5,PGSAVE @VA04250 01632000
MVI ERRINDX,IX1A SET ERROR INDEX FOR GETPAGE @VA01570 01633000
LA R3,4 SIZE @VA04250 01634000
BAL R2,GETPAGE GO GET PAGE TABLE @VA04250 01635000
MVC WORK2+4(K2),K4(R9) SAVE PAGETABLE ENTRY @VA04250 01636000
SPACE 1 01637000
SEGPGTBA NOP SEGPGTB3 @VA04250 01638000
* * THE FOLLOWING INSTRUCTION IS EXECUTED ONLY WHEN 01639000
* A NEW SEGMENT TABLE ENTRY IS FETCHED. 01640000
MVC SWAPSAVE+1(K3),K1(R9) SAVE ADDR OF SWAPTABLE @VA04250 01641000
MVI SEGPGTBA+1,XF0 SET SWITCH @VA04250 01642000
LH R5,LINECT GET LINE COUNT @VA04250 01643000
CH R5,=H'43' ROOM ON PAGE FOR ALL ?? @VA04250 01644000
BL SEGPGTB3 YES @VA04250 01645000
MVC DATA+10(40),SEGHD HEADING @VA04250 01646000
MVC LINECT,=H'60' FORCE EJECT @VA04250 01647000
BAL R6,PRINTA PRINT IT @VA04250 01648000
BAL R6,PRINTA PRINT A BLANK LINE @VA01570 01649000
SPACE 3 01650000
SEGPGTB3 L R5,SWAPSAVE GET POINTER TO SWPTABLE ENTRY @VA04250 01651000
MVI ERRINDX,IX1B SET ERROR INDEX FOR GETPAGE @VA01570 01652000
LA R3,1 @VA04250 01653000
BAL R2,GETPAGE @VA04250 01654000
MVC WORK2+6(K8),K0(R9) MOVE ENTRY TO WORK2 @VA04250 01655000
SEGPGTBD LA R3,K16 LENGTH @VA04250 01656000
BAL R6,TRANINT1 GO UNPACK DATA @VA04250 01657000
SEGPGTBB NOP SEGPGTBC @VA04250 01658000
MVC DATA+10(K8),WORK MOVE SEGTBL ENTRY TO PRT BUF@VA04250 01659000
UNPK WORK3(3),SEGNUMB+1(2) @VA04250 01660000
TR WORK3(2),TTAB-240 @VA04250 01661000
MVC DATA+6(2),WORK3 SEG NUMBER @VA04250 01662000
LTR R7,R7 R7=0 EQUALS NO PG TBL THIS ENTRY @VA04250 01663000
BZ SEGPGTB7 @VA04250 01664000
MVI SEGPGTBB+1,XF0 @VA04250 01665000
SEGPGTBC MVC DATA+25(4),WORK+8 MOVE PAGTABLE @VA04250 01666000
LA R5,WORK+12 FROM ADDR @VA04250 01667000
LA R4,DATA+33 AREA @VA04250 01668000
LA R2,K16 LENGTH @VA04250 01669000
BAL R6,MVSBRTN MOVE SWAPTABLE ENTRY TO PRTBUF @VA04250 01670000
UNPK WORK3(3),PAGNUMB+1(2) @VA04250 01671000
TR WORK3(2),TTAB-240 @VA04250 01672000
MVC DATA+22(1),WORK3+1 @VA04250 01673000
BAL R6,PRINTA @VA04250 01674000
SEGERR EQU * @VA01570 01675000
BCT R7,SEGPGTB4 FALL THRU WHEN ALL PGTBLE PRTED @VA04250 01676000
B SEGPGTB5 @VA04250 01677000
SPACE 2 01678000
* INCREMENT PGSAVE TO POINT TO NEXT PAGE TABLE ENTRY 01679000
* AND INCREMENT THE PAGE NUMBER. 01680000
SPACE 2 01681000
SEGPGTB4 LH R5,PAGNUMB GET PAGE COUNT @VA04250 01682000
LA R5,1(R5) BUMP @VA04250 01683000
STH R5,PAGNUMB SAVE @VA04250 01684000
LA R5,K8 LENGTH OF SWAP TABLE @VA04250 01685000
A R5,SWAPSAVE UPDATE POINTER @VA04250 01686000
ST R5,SWAPSAVE SAVE IT @VA04250 01687000
LA R5,K2 ADD 2 TO @VA04250 01688000
A R5,PGSAVE TO POINT TO NEXT ENTRY @VA04250 01689000
MVC WORK(K8),BLANK1 CLEAR SEGMT ENTRY FROM WORK @VA04250 01690000
B SEGPGTB2 GO BACK TO CONSTRUCT NXT LINE @VA04250 01691000
SPACE 3 01692000
* WHEN A COMPLETE PAGE TABLE HAS BEEN PRTED UP DATE 01693000
* SEGMENT POINTERS, AND RETURN TO START CYCLE OVER. 01694000
SPACE 2 01695000
SEGPGTB5 BCT R10,SEGPGTB6 REDUCE BY 1 AMT OF SEG TAB ENTRY @VA04250 01696000
SEGPGTBF L R6,RETADR GET RETURN ADDR @VA04250 01697000
BR R6 GO BACK TO CALLER @VA04250 01698000
SEGPGTB6 LH R5,SEGNUMB GET SEG COUNT @VA04250 01699000
LA R5,1(R5) BUMP @VA04250 01700000
STH R5,SEGNUMB SAVE @VA04250 01701000
LA R5,K4 ADD 4 TO @VA04250 01702000
A R5,SEGSAVE TO POINT TO NXT ENTRY @VA04250 01703000
ST R5,SEGSAVE SAVE IT @VA04250 01704000
B SEGPGTB1 @VA04250 01705000
SPACE 2 01706000
SEGPGTB7 DS 0H @VA04250 01707000
MVC DATA+20(K39),SEGHD2 MOVE MESSAGE INTO BUF @VA04250 01708000
BAL R6,PRINTA @VA04250 01709000
B SEGPGTB5 GO GET NEXT SEGMENT ENTRY @VA04250 01710000
EJECT 01711000
* ************************************************** 01712000
* * HEX CORE DUMP ROUTINE * 01713000
* ************************************************** 01714000
SPACE 3 01715000
HEXDUMP CLI HEX+7,X01 SEE IF NO HEX DUMP WAS SPECIFIED @VA04250 01716000
BE ERASE3 BR IF YES @VA04250 01717000
MVC LINECT,=H'60' FORCE EJECT @VA04250 01718000
MVI PREND+1,XF0 SET EXIT SWITCH @VA01570 01719000
B PREREG PRINT LOW CORE INFO @VA04250 01720000
SPACE 01721000
RDKEY DS 0H RETURN AFTER PRINTING LOW CORE @VA04250 01722000
MVI CTL,SPACE1 @VA04250 01723000
MVI SPACENUM+1,1 @VA04250 01724000
MVC LINECT,=H'60' FORCE EJECT @VA04250 01725000
FSREAD FSCB=DUMPFILE,BUFFER=KEY,ERROR=QUIT,RECNO=3 @VA04250 01726000
FSREAD FSCB=DUMPFILE,BUFFER=KEY1,ERROR=QUIT,RECNO=4 @VA04250 01727000
L R9,=A(ITEMTBL) GET TABLE ADDRESS @VA04250 01728000
PRTMAIN DS 0H @V407510 01729000
L R8,=A(ITEM2) SET BUFFER ADDRESS @V407510 01730000
L R5,I2MPREF GET MAIN PROCESSOR PSA ADDR @V407510 01731000
LTR R5,R5 UNIPROCESSOR SYSTEM? @V407510 01732000
BZ READPAGE YES, START TO DUMP CORE @V407510 01733000
MVI PSASW,K0 CLEAR SWITCH FOR PSA @V407510 01734000
MVI ERRINDX,IX1E ERROR INDICATOR FOR GETPAGE @V407510 01735000
LA R7,HVMAIN SET UP FOR HEADING @V407510 01736000
XC CURRPAGE,CURRPAGE CLEAR CURRPAGE PTR @V407510 01737000
PSALOOP DS 0H @V407510 01738000
MVC LINECT,=H'60' FORCE PAGE EJECT @V407510 01739000
ST R5,WORK2 SAVE ADDRESS FOR HEADING @V407510 01740000
LA R3,K256 PAGE SIZE IN DBL WORDS @V407510 01741000
BAL R2,GETPAGE BRING PAGE IN CORE @V407510 01742000
SLL R3,K3 PAGE SIZE IN BYTES -DBLWORDS*8 @V407510 01743000
BAL R6,TRANINIT TRANSLATE @V407510 01744000
MVC DATA(K14),0(R7) MOVE IN HEADING @V407510 01745000
MVC DATA+K20(K6),WORK+K2 ADDRESS IN HEADING @V407510 01746000
BAL R6,PRINTA PRINT HEADING @V407510 01747000
LH R10,ITEMNO GET ITEM NUMBER @V407510 01748000
LA R6,K5 CORE DUMP STARTS AT REC 5 @V407510 01749000
SR R10,R6 GET ITEM # BASE LOC 0 @V407510 01750000
SLL R10,K1 MULTIPLY BY 2 FOR HW ENTRIES @V407510 01751000
A R10,=A(ITEMTBL) GET ITEMTBL ENTRY @V407510 01752000
LH R10,0(R10) GET PAGE NUMBER @V407510 01753000
BAL R6,GETKEY GET PROTECT KEY @V407510 01754000
SLL R10,K12 GET PROPER DISPLACEMENT @V407510 01755000
ST R10,LASTPAG INITIALIZE LASTPAG PTR @V407510 01756000
MVC HOLD(K32),BLK BLANK OUT COMPARE FIELD @V407510 01757000
LR R14,R9 SET UP BUFFER ADDRESS @V407510 01758000
BAL R6,PNTPAGE PRINT PAGE @V407510 01759000
PRTATT DS 0H @V407510 01760000
CLI PSASW,K0 FINISHED PROCESSING PSA? @V407510 01761000
BNZ DUMPCORE YES, DUMP CORE @V407510 01762000
MVI PSASW,XFF INDICATE END OF PSA PROCESSING @V407510 01763000
L R8,=A(ITEM2) SET BUFFER ADDRESS @V407510 01764000
L R5,I2APREF GET ATTACHED PROCESSOR PSA ADDR @V407510 01765000
MVI ERRINDX,IX1F SET ERROR INDICATOR FOR GETPAGE @V407510 01766000
LA R7,HVATT SET UP HEADING @V407510 01767000
B PSALOOP PROCESS ATTACHED PROCESSOR PSA @V407510 01768000
DUMPCORE DS 0H @V407510 01769000
XC LASTPAG,LASTPAG CLEAR LAST PAGE PTR @V407510 01770000
L R9,=A(ITEMTBL) GET TABLE ADDRESS @V407510 01771000
LA R1,K4 SET UP FOR LOOP CONTROL @V407510 01772000
STH R1,ITEMNO START LOOP WITH REC 5 @V407510 01773000
MVC DATA(K14),HVSTOR MOVE IN HEADING @V4M0004 01774000
MVC LINECT,=H'60' FORCE PAGE EJECT @V4M0004 01775000
BAL R6,PRINTA PRINT HEADING @V4M0004 01776000
READPAGE DS 0H @V407510 01777000
LH R1,ITEMNO GET ITEM @VA04250 01778000
LA R1,1(R1) ADD ONE @VA04250 01779000
STH R1,ITEMNO SET ITEM @VA04250 01780000
FSREAD FSCB=DUMPFILE,BUFFER=BUFF,ERROR=ERRCK @VA04250 01781000
LH R10,K0(,R9) GET PAGE NO @VA04250 01782000
CH R10,FFFF END OF DUMP DATA? @VA04250 01783000
BE ENDUMP YES, FINISH IT @VA08111 01784000
BAL R6,GETKEY GET PROTECT KEY @VA08111 01785000
SLL R10,K12 GET PROPER DISPLACEMENT @VA08111 01786000
L R14,=A(BUFF) SET BASE @VA08111 01787000
BAL R6,PNTPAGE @VA08111 01788000
LA R9,K2(,R9) @VA08111 01789000
B READPAGE @VA08111 01790000
ENDUMP LH R15,=H'12' INDICATE EOF @VA08111 01791000
B ERRCK GO DO FINAL PROCESSING @VA04250 01792000
SPACE 2 01793000
* GET STORAGE PROTECT KEYS FOR THIS PAGE OF REAL CORE 01794000
SPACE 2 01795000
GETKEY L R2,KEYADR GET STARTING ADDR OF KEYS @VA04250 01796000
LR R4,R10 MOVE PAGE NUMBER INTO R4 @VA04250 01797000
SLL R4,K1 MULTIPLY BY 2 - TWO KEYS PER PG @VA04250 01798000
LA R3,K0(R2,R4) GET ADDR WHICH ->KEYS FOR THIS PG@VA04250 01799000
UNPK KEYSAVE(K5),K0(K3,R3) @VA04250 01800000
TR KEYSAVE(K4),TTAB-240 @VA04250 01801000
MVC KEYPRT+2(K2),KEYSAVE PUT INTO PRTBUF - WILL BE @VA04250 01802000
* PRTED IN THE 1ST LINE OF EACH PAGE 01803000
BR R6 RETURN TO CALLER @V407510 01804000
SPACE 2 01805000
SPACE 2 01806000
ERRCK CH R15,=H'12' EOF ?? @VA04250 01807000
BNE QUIT @VA04250 01808000
ERASE3 EQU * @VA01570 01809000
MVC DATA(19),=C'*** END OF DUMP ***' @VA04250 01810000
BAL R6,PRINTA @VA04250 01811000
SR R15,R15 SET ZERO RETURN CODE @VA04250 01812000
ST R15,REGSAVE+K4 @V407510 01813000
CLI ERASEIT+7,X01 SEE IF FILE IS TO BE ERASED @VA04250 01814000
BNE KPFIL BR IF NO @VA04250 01815000
BAL R2,ERASE @VA04250 01816000
MVC ERMP,DUMP SET NAME @VA04250 01817000
WRTERM ERMSG,ERMSGL @VA04250 01818000
CLOSE MVC DMR1P,DUMP SET NAME @VA04250 01819000
LA R1,CLOSEPNT CLOSE PRINTER @VA04250 01820000
SVC X'CA' @VA04250 01821000
FSCLOSE FSCB=DUMPFILE CLOSE THE FILE @VA02628 01822000
SR R15,R15 CLEAR @VA04250 01823000
B RETN @VA04250 01824000
SPACE 2 01825000
SPACE 2 01826000
KPFIL EQU * @VA04250 01827000
MVC KMP,DUMP SET NAME @VA04250 01828000
WRTERM KPMSG,KPMSGL @VA04250 01829000
B CLOSE @VA04250 01830000
SPACE 3 01831000
* PRINT PAGE ROUTINE. R14=INPUT BUFFER, R10=LINE ADDRESS 01832000
SPACE 3 01833000
PNTPAGE ST R6,RETADR SAVE CALLERS ADDRESS @VA04250 01834000
C R10,LASTPAG CONTIGUOUS PAGES ?? @VA04250 01835000
BE NXTLINE YES, CONT @VA04250 01836000
ST R10,WORK2 SAVE START ADDRESS @VA04250 01837000
UNPK WORK(9),LASTPAG(5) SAVE NEXT PAGE ADDRSSS @VA04250 01838000
UNPK WORK+8(9),WORK2(5) THIS PAGE ADDRESS @VA04250 01839000
TR WORK(16),TTAB-240 TRANSLATE @VA04250 01840000
MVC DATA(6),WORK+2 SET FROM ADDRESS @VA04250 01841000
MVC DATA+8(2),=C'TO' EDIT @VA04250 01842000
MVC DATA+12(6),WORK+10 SET TO ADDRESS @VA04250 01843000
MVC DATA+20(44),=C'SUPPRESSED NON-CONTROL-PROGRAM PAGE(S) .....' 01844000
MVC KEYPRT+2(2),BLANK1 BLANK KEY ENTRY @VW01525 01845000
BAL R6,PRINTA PRINT LINE @VA04250 01846000
MVC KEYPRT+2(2),KEYSAVE RESTORE KEY FOR FIRST LINE @VW01525 01847000
MVC LINECT,=H'60' FORCE EJECT @VA04250 01848000
NXTLINE CLC HOLD(K32),K0(R14) PREVIOUS LINE THE SAME @VA04250 01849000
MVC HOLD(K32),K0(R14) SAVE THIS LINE @VA04250 01850000
BE SUPPRESS @VA04250 01851000
SUPSW BC K0,PRNSUPP @VA04250 01852000
ST R10,THISLINE @VA04250 01853000
UNPK WORK(K9),THISLINE(K5) @VA04250 01854000
TR WORK(K8),TTAB-240 @VA04250 01855000
MVC LINEADDR(K6),WORK+2 STORE LINE ADDR IN BUFFER @VA04250 01856000
MVC EBCIDIC(32),K0(R14) MOVE IN LINE @VA04250 01857000
LA R3,K32 @VA04250 01858000
LA R4,EBCIDIC @VA04250 01859000
LA R5,WORK @VA04250 01860000
BAL R6,TRANS @VA04250 01861000
LA R5,WORK FROM ADDR @VA04250 01862000
LA R4,WORDS TO ADDR @VA04250 01863000
LA R2,K32 LENGTH @VA04250 01864000
BAL R6,MVSBRTN @VA04250 01865000
LA R2,K32 @VA04250 01866000
LA R4,K2(,R4) @VA04250 01867000
BAL R6,MVSBRTN @VA04250 01868000
TR EBCIDIC(K32),HEXTAB @VA04250 01869000
MVI EBCIDIC-1,C'*' @VA04250 01870000
MVI EBCIDIC+32,C'*' @VA04250 01871000
BAL R6,PRINTA @VA04250 01872000
RESUMP LA R14,K32(,R14) BUMP INPUT BY 32 @VA04250 01873000
LA R10,K32(,R10) BUMP REAL LINE ADDR BY 32 @VA04250 01874000
ST R10,ANDFLD @VA04250 01875000
NC ANDFLD(K4),=F'4095' CHECK FOR THE END OF PAGE @VA04250 01876000
BZ RESUMP2 @VA04250 01877000
NC ANDFLD(K4),=F'2047' @VA04250 01878000
BNZ NXTLINE BR IF NOT END OF HALF PAGE @VA04250 01879000
MVC KEYPRT+2(K2),KEYSAVE+2 GET KEY FOR 2ND HALF PAG@VA04250 01880000
B NXTLINE @VA04250 01881000
RESUMP2 ST R10,LASTPAG SAVE LAST PAGE PRINTED @VA04250 01882000
RESUMP1 TM SUPSW+1,XF0 @VA04250 01883000
BC K7,CLEANUP @VA04250 01884000
GONE DS 0H @VA04250 01885000
L R6,RETADR @VA04250 01886000
BR R6 GO TO PG CONTROL FOR NXT PAGE @VA04250 01887000
SUPPRESS ST R10,SAME SAVE NEW ADDRESS @VA04250 01888000
MVI SUPSW+1,XF0 @VA04250 01889000
B RESUMP @VA04250 01890000
PRNSUPP ST R10,SAME @VA04250 01891000
LM R3,R4,THISLINE GET LAST PRTD LINE&LAST SAME LINE@VA04250 01892000
LA R3,K32(,R3) @VA04250 01893000
STM R3,R4,WORK2 @VA04250 01894000
UNPK WORK(K9),WORK2(K5) @VA04250 01895000
UNPK WORK+8(K9),WORK2+4(K5) @VA04250 01896000
TR WORK(K16),TTAB-240 @VA04250 01897000
MVC DATA(K6),WORK+2 @VA04250 01898000
MVC DATA+8(K2),=C'TO' @VA04250 01899000
MVC DATA+12(K6),WORK+10 @VA04250 01900000
MVC DATA+20(38),=C'SUPPRESSED LINE(S) SAME AS ABOVE .....' 01901000
BAL R6,PRINTA @VA04250 01902000
MVI SUPSW+1,X00 @VA04250 01903000
PAGEEND BC K0,PAGEFINI @VA04250 01904000
B SUPSW @VA04250 01905000
CLEANUP MVI PAGEEND+1,XF0 SET RETURN @VA04250 01906000
B PRNSUPP PRINT SUPPRESSED LINE MSG @VA04250 01907000
PAGEFINI MVI PAGEEND+1,X00 @VA04250 01908000
MVC HOLD(K32),BLK BLANK OUT COMPARE FIELD @VA04250 01909000
B GONE @VA04250 01910000
EJECT 01911000
* ******************************************** 01912000
* * PRINTA IS A SERVICE ROUTINE WHICH WILL * 01913000
* * * PRINT A 131 CHARACTER LINE FROM THE * 01914000
* * BUFFER LABELED DATA. IN ADDITION A LINE * 01915000
* * COUNT IS KEPT AND PAGE EJECT IS PERFORMED* 01916000
* * WHEN NECESSARY. * 01917000
* ******************************************** 01918000
SPACE 3 01919000
PRINTA STM R0,R2,PRTSAVE SAVE @VA04250 01920000
LH R2,LINECT GET THE LINE COUNT @VA04250 01921000
AH R2,SPACENUM UPDATE LINE COUNT @VA04250 01922000
CH R2,=H'59' ENOUGH ON ONE PAGE ?? @VMI0055 01923000
BNH PRINT BR IF LINE COUNT LESS THAN 60 @VA04250 01924000
PRINTL EJECT,1 @VA04250 01925000
NONFATAL EQU * @VA04250 01926000
LH R2,SPACENUM RESET LINE COUNT @VA04250 01927000
PRINT DS 0H @VA04250 01928000
PRINTL LINE,133,ERROR=PRTERR @VA04250 01929000
MVI DATA,C' ' @VA04250 01930000
MVC DATA+1(131),DATA @VA04250 01931000
STH R2,LINECT SAVE NEW COUNT @VA04250 01932000
LM R0,R2,PRTSAVE RESTORE @VA04250 01933000
BR R6 RETURN @VA04250 01934000
SPACE 2 01935000
PRTSAVE DS 3F'0' REG SAVE AREA @VA04250 01936000
LINECT DC H'0' @VA04250 01937000
SPACENUM DC H'1' @VA04250 01938000
LINE DS 0CL133 @VA04250 01939000
CTL DC C'0' SET FOR DOUBLE SPACING @VA04250 01940000
DATA DC CL132' ' LINE BUFFER @VA04250 01941000
LINEADDR EQU DATA @VA04250 01942000
WORDS EQU DATA+10 @VA04250 01943000
KEYPRT EQU DATA+90 @VA04250 01944000
EBCIDIC EQU DATA+97 @VA04250 01945000
DS 0F @VA04250 01946000
EJECT DC C'1' NEW PAGE @VA04250 01947000
SPACE 3 01948000
* ************************************************** 01949000
* * THE GETPAGE SERVICE ROUTINE WILL FETCH FROM THE* 01950000
* * DUMP FILE THE PAGE (OR TWO) WHICH CONTAINS THE * 01951000
* * ADDR IN R5. TWO PAGES WILL BE FETCHED AT A TIME* 01952000
* * IF CONTIGUOUS,IF NOT ONLY ONE. THIS IS BECAUSE * 01953000
* * A BLOK MAY OVERLAY A PAGE BOUNDRY. R9 UPON RE- * 01954000
* * * TURN WILL CONTAIN THE INCORE ADR OF THE R5 ADR.* 01955000
* ************************************************** 01956000
SPACE 3 01957000
GETPAGE DS 0H @VA04250 01958000
LR R6,R5 SAVE ADDRESS @VA04250 01959000
N R6,=X'00FFFFFF' @VA04250 01960000
SRL R6,K12 GET PAGE NUMBER @VA04250 01961000
CH R6,CURRPAGE IS PAGE IN BUFFER @VA04250 01962000
BE GIVE BR IF YES @VA04250 01963000
L R4,=A(ITEMTBL) GET TABLE BASE @VA04250 01964000
LA R8,K5 R8 IS ITEM NUMBER ON DISK OF PG 0@VA04250 01965000
SEARCH CH R6,0(,R4) IS THIS DESIRED PAGE @VA04250 01966000
BE GET BR IF YES @VA04250 01967000
LA R4,2(,R4) BUMP TO NEXT TABLE ENTRY @VA04250 01968000
LA R8,1(,R8) BUMP ITEM NUMBER @VA04250 01969000
CLC K0(K2,R4),FFFF CHECK FOR END OF ITEM TABLE @VA04250 01970000
BNE SEARCH BRANCH IF NO @VA04250 01971000
B ERRFND @VA04250 01972000
GET STH R8,ITEMNO STORE DESIRED ITEM NO. @VA04250 01973000
STH R6,CURRPAGE CURRENT PAGE IN BUFFER @VA04250 01974000
LR R8,R5 GET PAGE ADDRESS @VA04250 01975000
LR R4,R3 GET SIZE REQUIRED @VA04250 01976000
SLL R4,3 IN BYTES @VA04250 01977000
AR R8,R4 GET END PAGE ADDRESS @VA04250 01978000
SRL R8,12 GET PAGE ADDRESS @VA04250 01979000
CH R8,CURRPAGE IS IT THE SAME ?? @VA04250 01980000
BE GETONE YES, GET ONE PAGE ONLY @VA04250 01981000
GETWO MVI NUMBER+1,2 READ 2 RECORDS @VA04250 01982000
B RETRVE READ @VA04250 01983000
GETONE MVI NUMBER+1,1 @VA04250 01984000
RETRVE DS 0H @VA04250 01985000
FSREAD FSCB=DUMPFILE,BUFFER=BUFF,ERROR=QUIT @VA04250 01986000
SET9 L R9,=A(BUFF) GET BASE OF AREA @VA04250 01987000
LR R6,R5 GET ADDRESS @VA04250 01988000
N R6,XFFF GET DISPALCEMENT @VA04250 01989000
AR R9,R6 FORM ADDRESS OF DATA @VA04250 01990000
MVI NUMBER+1,1 RESET TO 1 @VA04250 01991000
BR R2 RETURN @VA04250 01992000
GIVE LR R8,R5 GET ADDRESS @VA04250 01993000
LR R4,R3 SIZE @VA04250 01994000
SLL R4,3 IN BYTES OF DESIRED AREA @VA04250 01995000
AR R8,R4 GET END PAGE ADDRESS @VA04250 01996000
SRL R8,12 FORM PAGE ADDRESS @VA04250 01997000
CH R8,CURRPAGE IN SAME PAGE ?? @VA04250 01998000
BNE GETWO NO, READ 2 RECORDS @VA04250 01999000
B SET9 OK, SET ADDRESS @VA04250 02000000
SPACE 3 02001000
* ************************************************** 02002000
* * TRANSLATE SERVICE ROUTINE WILL UNPACK DATA * 02003000
* * R4 - POINTS TO DATA TO BE UNPACKED * 02004000
* * R5 - PTS TO FIELD RECIEVING UPKED DATA * 02005000
* * R3 - LENGTH OF FIELD TO BE UNPACKED * 02006000
* ************************************************** 02007000
SPACE 3 02008000
TRANINIT EQU * @VA04250 02009000
CH R3,=H'128' DO NO MORE THAN 128 BYTES=16 DWDS@VA04250 02010000
BL *+8 OK @VA04250 02011000
LA R3,128 SET SIZE @VA04250 02012000
EX R3,BLOCKMVC MOVE BLK TO TRANSLATE AREA @VA04250 02013000
LA R3,K4(R3) LENGTH INCLUDING BLOCK ADDR @VA04250 02014000
TRANINT1 EQU * @VA04250 02015000
LA R4,WORK2 ADDR OF FIELD TO BE TRANSLATED @VA04250 02016000
LA R5,WORK ADDR OF AREA TO PLACE TRANSLATION@VA04250 02017000
TRANS SRL R3,K2 GET NO OF WORDS @VA04250 02018000
CH R3,=H'33' CANT DO MORE THAN 33 WORDS @VA04250 02019000
BL *+8 OK @VA04250 02020000
LA R3,33 SET SIZE @VA04250 02021000
UNP UNPK 0(K9,R5),0(K5,R4) UNPACK ONE WORD @VA04250 02022000
TR 0(K8,R5),TTAB-240 @VA04250 02023000
LA R5,K8(,R5) BUMP RECV. FIELD @VA04250 02024000
LA R4,K4(,R4) BUMP FROM FIELD @VA04250 02025000
BCT R3,UNP @VA04250 02026000
BR R6 RETURN TO CALLER @VA04250 02027000
SPACE 1 02028000
BLOCKMVC MVC WORK2+4(0),0(R9) EXECUTED MOVE @VA04250 02029000
SPACE 3 02030000
* ************************************************** 02031000
* * MOVE SERVICE ROUTINE WILL MOVE WILL TAKE A CON-* 02032000
* * TIGUOUS DATA AREA AND MOVE IT INTO A SECOND * 02033000
* * AREA IN THE FOLLOWING FORMAT - 8 BYTES, 2 SPACS* 02034000
* * 8 BYTES,2 SPACES, ETC... * 02035000
* * ON ENTRY ON EXIT * 02036000
* * R2=LENGTH R2=DESTROYED * 02037000
* * R3= R2=DESTROYED * 02038000
* * R4= TO FIELD R4=NXT TO FIELD * 02039000
* * R5= FRM FIELD R5=NXT FRM FIELD * 02040000
* ************************************************** 02041000
SPACE 3 02042000
MVSBRTN LA R3,K0(R2,R5) GET END OF INPUT FIELD @VA04250 02043000
S R3,=F'8' @VA04250 02044000
LA R2,K8 GET INCREMENT @VA04250 02045000
GO MVC K0(K8,R4),K0(R5) @VA04250 02046000
LA R4,K10(,R4) BUMP OUT AREA AND SPACE 2 BLANKS @VA04250 02047000
BXLE R5,R2,GO @VA04250 02048000
BR R6 RETURN TO CALLER @VA04250 02049000
EJECT 02050000
* ************************************************** 02051000
* * THE FOLLOWING CODE CONTAINS DMMEDM ERROR * 02052000
* * ROUTINES. * 02053000
* ************************************************** 02054000
SPACE 3 02055000
ERRWRT DS 0H @V407510 02056000
ST R15,REGSAVE+K4 @V407510 02057000
WRTERM DM2,DM2L @VA04250 02058000
BAL R2,HLDRDR @VA04250 02059000
ERS BAL R2,ERASE @VA04250 02060000
B EXIT @VA04250 02061000
ERROR1 WRTERM DM3,DM3L @VA04250 02062000
LA R15,24 RETURN @VA04250 02063000
B RETN @VA04250 02064000
ERROR2 WRTERM DM4,DM4L @VA04250 02065000
LA R15,22 @VA04250 02066000
B RETN @VA04250 02067000
ERROR3 MVC DM5P,DUMP @VA04250 02068000
ST R15,REGSAVE+K4 @V407510 02069000
WRTERM DM5,DM5L @VA04250 02070000
B EXIT @VA04250 02071000
NODMP WRTERM DM6,DM6L @VA04250 02072000
LA R15,23 @VA04250 02073000
ST R15,REGSAVE+K4 @V407510 02074000
B ERS @VA04250 02075000
NOFDMP WRTERM DM9,DM9L @VA04250 02076000
BAL R2,CLRDR @VA04250 02077000
LA R15,30 @VA04250 02078000
ST R15,REGSAVE+K4 @V407510 02079000
B ERS @VA04250 02080000
PRTERR C R15,=F'3' POSSIBLY CH 9 FROM V3211 @VA04250 02081000
BH FATAL BR. - NOPE, SOMEBODY GOOFED.@VA04250 02082000
C R15,=F'2' OR MAYBE CH 12 FROM V3211? @VA04250 02083000
BH NONFATAL BR - MUST HAVE BEEN CH 9, IGNORE @VA04250 02084000
BL FATAL OOPS, MUST BE 1, BAD NEWS. @VA04250 02085000
LA R2,60 SET LINE COUNT TO FORCE EJECT @VA04250 02086000
B PRINT NEXT TIME A LINE IS PRINTED @VA01570 02087000
FATAL DS 0H @V407510 02088000
ST R15,REGSAVE+K4 END OF ROAD @V407510 02089000
WRTERM DM10,DM10L @VA04250 02090000
B EXIT @VA04250 02091000
ERRFND WRTERM DM7,DM7L @VA04250 02092000
SR R2,R2 PREPARE FOR IC @VA01570 02093000
SR R6,R6 DOUBLE THE FUN @VA01570 02094000
IC R2,ERRINDX GET THE INDEX TO THE ERROR TABLES@VA01570 02095000
IC R6,ERMSGTAB(R2) GET THE LENGTH OF THE ERROR MSG @VA01570 02096000
BCTR R6,0 ADJUST FOR EXECUTE @VA01570 02097000
LR R9,R6 SAVE IT @VA01570 02098000
LA R6,L'DM7+L'DM7A(R6) SETUP LENGTH FOR EXECUTE @VA01570 02099000
MVI DATA,C'*' SOME KIND OF INDICATOR @VA01570 02100000
EX R6,STARMOVE HERE WE GO @VA01570 02101000
BAL R6,PRINTA @VA01570 02102000
MVC DATA(L'DM7),DM7 MOVE MSG DMMEDM864 @VA01570 02103000
MVC DATA+L'DM7(L'DM7A),DM7A AND SECOND PART @VA01570 02104000
L R6,ERMSGTAB(R2) GET NAME OF FAILING CTL BLOCK @VA01570 02105000
EX R9,ERRMOVE AND COMPLETE MESSAGE @VA01570 02106000
BAL R6,PRINTA PRINT THE GOODIE @VA01570 02107000
LA R6,L'DM7+L'DM7A(R9) GET LENGTH FOR EXEC AGAIN @VA01570 02108000
MVI DATA,C'*' @VA01570 02109000
EX R6,STARMOVE @VA01570 02110000
BAL R6,PRINTA @VA01570 02111000
L R6,ERRETAB(R2) GET ADDRESS OF RETURN POINT @VA01570 02112000
BR R6 AND TRY (AT LEAST) @VA01570 02113000
STARMOVE MVC DATA+1(0),DATA PROPAGATING @VA01570 02114000
ERRMOVE MVC DATA+L'DM7+L'DM7A(0),0(R6) @VA01570 02115000
QUIT DS 0H @V407510 02116000
ST R15,REGSAVE+K4 @V407510 02117000
WRTERM DM8,DM8L @VA04250 02118000
B EXIT @VA04250 02119000
ERASE FSERASE FSCB=DUMPFILE @VA04250 02120000
BR R2 @VA04250 02121000
SPACE 2 02122000
CLRDR MVC CPHOLD,=CL8' ' NO HOLD @VA04250 02123000
CLRDR1 LA R1,CPRDR @VA04250 02124000
SVC X'CA' @VA04250 02125000
BR R2 @VA04250 02126000
HLDRDR MVC CPHOLD,=CL8'HOLD' @VA04250 02127000
B CLRDR1 @VA04250 02128000
SPACE 2 02129000
CPRDR DC CL8'CP' @VA04250 02130000
DC CL8'CLOSE' @VA04250 02131000
DC CL8'00C' @VA04250 02132000
CPHOLD DC CL8'NOHOLD' @VA04250 02133000
DC 2F'-1' @VA04250 02134000
SAVEPRB DC F'0' @VA05446 02135000
EJECT 02136000
* ********************C O N S T A N T S******************* 02137000
SPACE 3 02138000
K0 EQU 0 @VA04250 02139000
K1 EQU 1 @VA04250 02140000
K2 EQU 2 @VA04250 02141000
K3 EQU 3 @VA04250 02142000
K4 EQU 4 @VA04250 02143000
K5 EQU 5 @VA04250 02144000
K7 EQU 7 @VA04250 02145000
K6 EQU 6 @VA04250 02146000
K8 EQU 8 @VA04250 02147000
K9 EQU 9 @VA04250 02148000
K10 EQU 10 @VA04250 02149000
K11 EQU 11 @VA04250 02150000
K12 EQU 12 @VA04250 02151000
K13 EQU 13 @VA04250 02152000
K14 EQU 14 @VA04250 02153000
K16 EQU 16 @VA04250 02154000
K18 EQU 18 @VA04250 02155000
K15 EQU 15 @VA04250 02156000
K17 EQU 17 @VA04250 02157000
K19 EQU 19 @VA04250 02158000
K20 EQU 20 @VA04250 02159000
K21 EQU 21 @VA04250 02160000
K22 EQU 22 @VA04250 02161000
K24 EQU 24 @VA04250 02162000
K25 EQU 25 @V407510 02163000
K28 EQU 28 @VA04250 02164000
K30 EQU 30 @VA04250 02165000
K32 EQU 32 @VA04250 02166000
K33 EQU 33 @VA04250 02167000
K36 EQU 36 @VA04250 02168000
K37 EQU 37 @VA04250 02169000
K39 EQU 39 @VA04250 02170000
K52 EQU 52 @VA04250 02171000
PRBFILE DS 0D PROBLEM REPORT FILE FN FT FM @VA04250 02172000
PRBFN DS CL8 REPORT FILENAME @VA04250 02173000
DC CL8'REPORT' FILETYPE OF REPORT @VA04250 02174000
DC C'A1' FILEMODE OF REPORT @VA04250 02175000
K45 EQU 45 @VA04250 02176000
K46 EQU 46 @VA04250 02177000
K48 EQU 48 @VA04250 02178000
K55 EQU 55 @VA04250 02179000
K56 EQU 56 @VA04250 02180000
K59 EQU 59 @VA04250 02181000
K60 EQU 60 @VA04250 02182000
K64 EQU 64 @VA04250 02183000
K65 EQU 65 @VA04250 02184000
K66 EQU 66 @VA04250 02185000
K75 EQU 75 @V407510 02186000
K76 EQU 76 @V407510 02187000
K77 EQU 77 @V407510 02188000
K78 EQU 78 @V407510 02189000
K80 EQU 80 @VA04250 02190000
K90 EQU 90 @VA04250 02191000
K92 EQU 92 @VA04250 02192000
K96 EQU 96 @VA04250 02193000
K120 EQU 120 @VA04250 02194000
K131 EQU 131 @VA04250 02195000
K144 EQU 144 @VA04250 02196000
K256 EQU 256 @VA04250 02197000
K512 EQU 512 @VA04250 02198000
K520 EQU 520 @VA04250 02199000
X00 EQU X'00' @VA04250 02200000
X01 EQU X'01' @VA04250 02201000
X02 EQU X'02' @VA04250 02202000
X03 EQU X'03' @VA04250 02203000
X08 EQU X'08' @VA04250 02204000
X0F EQU X'0F' @VA04250 02205000
X34 EQU X'34' @VA04250 02206000
X40 EQU X'40' @VA04250 02207000
XF0 EQU X'F0' @VA04250 02208000
XFF EQU X'FF' @VA04250 02209000
X0002 EQU X'000F' @VA04250 02210000
AMPERSAN EQU X'50' @VA04250 02211000
SPACE1 EQU X'40' @VA04250 02212000
SPACE2 EQU X'F0' @VA04250 02213000
SPACE3 EQU C'-' @VA04250 02214000
V EQU C'V' @VA04250 02215000
IX00 EQU X'00' @VA01570 02216000
IX01 EQU X'04' @VA01570 02217000
IX02 EQU X'08' @VA01570 02218000
IX03 EQU X'0C' @VA01570 02219000
IX04 EQU X'10' @VA01570 02220000
IX05 EQU X'14' @VA01570 02221000
IX06 EQU X'18' @VA01570 02222000
IX07 EQU X'1C' @VA01570 02223000
IX08 EQU X'20' @VA01570 02224000
IX09 EQU X'24' @VA01570 02225000
IX0A EQU X'28' @VA01570 02226000
IX0B EQU X'2C' @VA01570 02227000
IX0C EQU X'30' @VA01570 02228000
IX0D EQU X'34' @VA01570 02229000
IX0E EQU X'38' @VA01570 02230000
IX0F EQU X'3C' @VA01570 02231000
IX10 EQU X'40' @VA01570 02232000
IX11 EQU X'44' @VA01570 02233000
IX12 EQU X'48' @VA01570 02234000
IX13 EQU X'4C' @VA01570 02235000
IX14 EQU X'50' @VA01570 02236000
IX15 EQU X'54' @VA01570 02237000
IX16 EQU X'58' @VA01570 02238000
IX17 EQU X'5C' @VA01570 02239000
IX18 EQU X'60' @VA01570 02240000
IX19 EQU X'64' @VA01570 02241000
IX1A EQU X'68' @VA01570 02242000
IX1B EQU X'6C' @VA01570 02243000
IX1C EQU X'70' @V407510 02244000
IX1D EQU X'74' @V407510 02245000
IX1E EQU X'78' @V407510 02246000
IX1F EQU X'7C' @V407510 02247000
SPACE 3 02248000
DUMPLIST DC CL8'DUMP00' @VA04250 02249000
DC CL8'DUMP01' @VA04250 02250000
DC CL8'DUMP02' @VA04250 02251000
DC CL8'DUMP03' @VA04250 02252000
DC CL8'DUMP04' @VA04250 02253000
DC CL8'DUMP05' @VA04250 02254000
DC CL8'DUMP06' @VA04250 02255000
DC CL8'DUMP07' @VA04250 02256000
DC CL8'DUMP08' @VA04250 02257000
DC CL8'DUMP09' @VA04250 02258000
* ******************************************************* 02259000
DUMP DC CL8' ' DUMP FILE NAME @VA04250 02260000
OPLIST DS 0F OPTION LIST @VA04250 02261000
ERASEIT DC CL8'ERASE' @VA04250 02262000
MAP DC CL8'NOMAP' @VA04250 02263000
HEX DC CL8'NOHEX' @VA04250 02264000
NOFORMAT DC CL8'NOFORM' @VA04250 02265000
NOVIRT DC CL8'NOVIRT' @VA04250 02266000
END DC X'FFFFFFFF' @VA04250 02267000
SPACE 3 02268000
* ******************************************************* 02269000
DUMPFILE FSCB 'DUMPXX DUMP',BUFFER=BUFF,BSIZE=4096 @VA04250 02270000
ITEMNO EQU DUMPFILE+26 @VA04250 02271000
NUMBER EQU DUMPFILE+38 @VA04250 02272000
BSIZE EQU DUMPFILE+32 @VA04250 02273000
SPACE 3 02274000
DUMPSRCH FSCB 'DUMPXX DUMP',BUFFER=BUFF @VA04250 02275000
CLOSEPNT DS 0F @VA04250 02276000
DC CL8'CP' @VA04250 02277000
DC CL8'CLOSE' @VA04250 02278000
DC CL8'PRT' @VA04250 02279000
DC CL8'NAME' @VA04250 02280000
DMR1P DC CL8'SYSDUMP' @VA04250 02281000
DC CL8' DUMP' @VA04250 02282000
DC 2F'-1' @VA04250 02283000
SPACE 3 02284000
WORK2 DC 33F'0' @VA04250 02285000
WORK DC 66F'0' @VA04250 02286000
WORK3 DC D'0' @VA04250 02287000
BLANK1 DC 8C' ' @VA04250 02288000
CORTBHD1 DC C'********** C O R E T A B L E ********* ' @VA04250 02289000
CORTBHD2 DC C' PAG U S E R I D ' @VA04250 02290000
FREEID DC C'FREE' @VA04250 02291000
HEXTAB DC 64C'.' @VA04250 02292000
DC C' ' @VA04250 02293000
DC 10C'.' @VA04250 02294000
DC C'.)(+ &&' @VA04250 02295000
DC 10C'.' @VA04250 02296000
DC C'$*) -/' @VA04250 02297000
DC 9C'.' @VA04250 02298000
DC X'6B6C' @VA04250 02299000
DC C' ' @VA04250 02300000
DC 10C'.' @VA04250 02301000
DC C' ' @VA04250 02302000
DC X'7B7C' @VA04250 02303000
DC C'''= ' @VA04250 02304000
DC 64C'.' @VA04250 02305000
DC C'.ABCDEFGHI' @VA04250 02306000
DC 7C'.' @VA04250 02307000
DC C'JKLMNOPQR' @VA04250 02308000
DC 8C'.' @VA04250 02309000
DC C'STUVWXYZ' @VA04250 02310000
DC 6C'.' @VA04250 02311000
DC C'0123456789......' @VA04250 02312000
BLK DC C' ' @VA04250 02313000
HOLD DC 32C' ' @VA04250 02314000
INCR DC X'1C' @VA04250 02315000
KEYSAVE DC CL6' ' @VA04250 02316000
LASTPAG DC F'0' START AT ZERO @VA04250 02317000
LINEHEX DC H'0' @VA04250 02318000
PGCT DC H'0' @VA04250 02319000
PAGNUMB DC H'0' @VA04250 02320000
SEGNUMB DC H'0' @VA04250 02321000
SEGHD DC C'SEGTABLE PAGTABLE S W P T A B L E' @VA04250 02322000
SEGHD2 DC CL39'NO PAGTABLE ENTRIES FOR THIS SEGMENT' @VA04250 02323000
SEGHD3 DC CL50'NO SEGTABLE, PAGTABLE OR SWPTABLE FOR THIS USER' 02324000
ABMSG DC C'VM/370 SYSTEM ABEND CODE ' @VA00803 02325000
DC CL8'XXXXXX; ' @VA00803 02326000
DC C'DATE ' @VA04250 02327000
DC CL12' ' @VA04250 02328000
DC C'TIME ' @VA04250 02329000
LABM EQU *-ABMSG @VA04250 02330000
ZERO DC C'00' @VA04250 02331000
TTAB DC C'0123456789ABCDEF' @VA04250 02332000
SYSVMBLK DC C'SYSTEM' @VA04250 02333000
SPACESAV DC H'0' @VA04250 02334000
CTLSAV DC X'00' @VA04250 02335000
ANDFLD DC F'0' @VA04250 02336000
BLKSIZE DC F'16' @VA04250 02337000
KEYADR DC A(KEY) @VA04250 02338000
CURRPAGE DC X'FFFFFFFF' CURRENT PAGE IN BUFFER @V4M0004 02339000
NXTSFBK DC F'0' @VA04250 02340000
ONE DC F'1' @VA04250 02341000
PGSAVE DC F'0' @VA04250 02342000
PTRCORTB DC F'0' @VA04250 02343000
RETADR DC F'0' @VA04250 02344000
RSAV DC F'0' @VA04250 02345000
REGSAVE DC 4F'0' @V407510 02346000
SEGSAVE DC F'0' @VA04250 02347000
SWAPSAVE DC F'0' @VA04250 02348000
THIS DC F'0' @VA04250 02349000
THISLINE DC F'0' @VA04250 02350000
SAME DC F'0' @VA04250 02351000
CHAINCK DC F'0' IOBLOK CHAIN CHECK SAVE AREA @VA04250 02352000
IOBSAVE DC F'0' REMEMBER IOBLOK HERE @VA07496 02353000
LASTQUED DC F'0' LAST IOBLOK CHAINED TO A BLOCK @VA04250 02354000
LIOBDEV DC F'0' LAST IOBLOK CHAINED TO RDEVBLOK @VA04250 02355000
PLISTADR DC F'0' @VA04250 02356000
XFFF DC X'00000FFF' @VA04250 02357000
X000F DC X'0000000F' @VA04250 02358000
MCORTAB DC C'CORETABLE' @VA01570 02359000
MSWPTAB DC C'SWAPTABLE' @VA01570 02360000
MVMBLOK DC C'VMBLOK' @VA01570 02361000
MRCHIX DC C'REAL CHANNEL BLOCK INDEX' @VA01570 02362000
DM7A DC C' WHILE EDITING ' @VA01570 02363000
MABP DC C'ABENDING PROCESSOR PSA' @V407510 02364000
MDEBLOK DC C'DEFERRED EXECUTION BLOK' @V407510 02365000
MMAIN DC C'MAIN PROCESSOR PSA' @V407510 02366000
MATT DC C'ATTACHED PROCESSOR PSA' @V407510 02367000
EJECT 02368000
RCHINDEX DC F'0' @VA04250 02369000
RCHSTRT DC F'0' @VA04250 02370000
RCUSTRT DC F'0' @VA04250 02371000
RDEVSTRT DC F'0' @VA04250 02372000
PRTSPL DC F'0' @VA04250 02373000
PNCHSPL DC F'0' @VA04250 02374000
RDRSPL DC F'0' @VA04250 02375000
CORPOINT DC F'0' @VA04250 02376000
VMPTR DC F'0' @VA04250 02377000
ABCODE DC F'0' @VA04250 02378000
RSYSRV DC F'0' @VA04250 02379000
RDATE DC D'0' @VA04250 02380000
RTIME DC D'0' @VA04250 02381000
EJECT 02382000
* WHEN THE GETPAGE SUBROUTINE DETERMINES, THAT A PAGE IS NOT ON THE 02383000
* DUMPXX DATASET, RETURN IS MADE USING THE FOLLOWING TABLE. 02384000
* ERRINDX IS SET TO AN INDEX VALUE PRIOR TO THE ENTRY TO GETPAGE. 02385000
SPACE 2 02386000
ERRETAB EQU * @VA01570 02387000
DC A(SFFORM) @VA01570 02388000
DC A(CKCHAN) @VA01570 02389000
DC A(CKCU) @VA01570 02390000
DC A(ENDCK) @VA01570 02391000
DC A(IOERPRNT) @VA01570 02392000
DC A(IOERPRNT) @VA01570 02393000
DC A(SPLST) @VA02149 02394000
DC A(ENDCK) @VA02149 02395000
DC A(HEXDUMP) @VA01570 02396000
DC A(TSTTR) @VA01570 02397000
DC A(VMEND) @VA01570 02398000
DC A(CHANCK) @VA01570 02399000
DC A(CUCK) @VA01570 02400000
DC A(NXTVDEV) @VA01570 02401000
DC A(NXTVDEV) @VA01570 02402000
DC A(NXTVDEV) @VA01570 02403000
DC A(IOBACK) @VA01570 02404000
DC A(SFERR) @VA01570 02405000
DC A(IOERERR) @VA01570 02406000
DC A(CORTBL) @VA01570 02407000
DC A(VIRTUALM) @VA01570 02408000
DC A(CORTBL7) @VA01570 02409000
DC A(CORTBL7) @VA01570 02410000
DC A(CORTBL7) @VA01570 02411000
DC A(SEGPGTBF) @VA01570 02412000
DC A(SEGPGTB6) @VA01570 02413000
DC A(SEGERR) @VA01570 02414000
DC A(SEGERR) @VA01570 02415000
DC A(LOADMAP) @V407510 02416000
DC A(VMETST1) @V407510 02417000
DC A(PRTATT) @V407510 02418000
DC A(DUMPCORE) @V407510 02419000
SPACE 2 02420000
ERMSGTAB DS 0F @VA01570 02421000
DC AL1(L'MRCHIX),AL3(MRCHIX) @VA01570 02422000
DC AL1(L'HCHBLK),AL3(HCHBLK) @VA01570 02423000
DC AL1(L'HCUBLK),AL3(HCUBLK) @VA01570 02424000
DC AL1(L'HDEVBLK),AL3(HDEVBLK) @VA01570 02425000
DC AL1(L'HCONTASK),AL3(HCONTASK) @VA01570 02426000
DC AL1(L'HRSPLCTL),AL3(HRSPLCTL) @VA01570 02427000
DC AL1(L'HRECBLK),AL3(HRECBLK) @VA01570 02428000
DC AL1(L'HRECBLK),AL3(HRECBLK) @VA01570 02429000
DC AL1(L'HVMBLOK),AL3(HVMBLOK) @VA01570 02430000
DC AL1(L'HVMEC),AL3(HVMEC) @VA01570 02431000
DC AL1(L'HVMTR),AL3(HVMTR) @VA01570 02432000
DC AL1(L'HCHBLK),AL3(HCHBLK) @VA01570 02433000
DC AL1(L'HCUBLK),AL3(HCUBLK) @VA01570 02434000
DC AL1(L'HDEVBLK),AL3(HDEVBLK) @VA01570 02435000
DC AL1(L'HVCONCTL),AL3(HVCONCTL) @VA01570 02436000
DC AL1(L'HVSPLCTL),AL3(HVSPLCTL) @VA01570 02437000
DC AL1(14),AL3(HIOBLKS) @VA01570 02438000
DC AL1(L'HSFBLK),AL3(HSFBLK) @VA01570 02439000
DC AL1(L'HIOERBLK),AL3(HIOERBLK) @VA01570 02440000
DC AL1(19),AL3(DATA+2) @VA01570 02441000
DC AL1(L'MCORTAB),AL3(MCORTAB) @VA01570 02442000
DC AL1(L'MSWPTAB),AL3(MSWPTAB) @VA01570 02443000
DC AL1(L'MVMBLOK),AL3(MVMBLOK) @VA01570 02444000
DC AL1(L'MVMBLOK),AL3(MVMBLOK) @VA01570 02445000
DC AL1(L'MVMBLOK),AL3(MVMBLOK) @VA01570 02446000
DC AL1(8),AL3(SEGHD) @VA01570 02447000
DC AL1(8),AL3(SEGHD2+3) @VA01570 02448000
DC AL1(L'MSWPTAB),AL3(MSWPTAB) @VA01570 02449000
DC AL1(L'MABP),AL3(MABP) @V407510 02450000
DC AL1(L'MDEBLOK),AL3(MDEBLOK) @V407510 02451000
DC AL1(L'MMAIN),AL3(MMAIN) @V407510 02452000
DC AL1(L'MATT),AL3(MATT) @V407510 02453000
EJECT 02454000
* 02455000
* POINTERS INTO I/O BLOCK INDEX TABLES-ADDR SAVED HERE IS POINTER 02456000
* TO INDEX VALUE OF BLOCK BEING PROCESSED-ONE CHANNEL, ONE CU & 1DEV 02457000
* 02458000
CHDEX DC A(CHINDEX) ADDR OF CURRENT CHAN INDEX VALUE @VA04250 02459000
CUDEX DC A(CUINDEX) ADDR OF CURRENT CU INDEX VALUE @VA04250 02460000
DEVDEX DC A(DEVINDEX) ADDR OF CURRENT DEV INDEX VALUE @VA04250 02461000
SPACE 2 02462000
* 02463000
* SAVE AREAS FOR INDEX TABLES WITH DISPLACEMENTS INT I/O BLOCKS 02464000
* 02465000
CHINDEX DS 16H INDEX TBL FOR CHANNEL BLOCKS @VA04250 02466000
CUINDEX DS 32H INDEX TBL FOR CONTROL UNIT BLOCKS@VA04250 02467000
DEVINDEX DS 16H INDEX TBL FOR DEVICE BLOCKS @VA04250 02468000
SPACE 1 02469000
CHANLAST DC A(CHINDEX+30) ADDR LAST ENTRY IN CHAN TABLE @VA04250 02470000
RCULAST DC A(CUINDEX+62) ADDR LAST ENTRY REAL CU TABLE @VA04250 02471000
VCULAST DC A(CUINDEX+30) ADDR LAST ENTRY VIRTUAL CU TABLE @VA04250 02472000
DEVLAST DC A(DEVINDEX+30) ADDR LAST ENTRY DEVICE INDEX TABL@VA04250 02473000
SPACE 1 02474000
* THE FOLLOWING ENTRIES ARE SAVED FROM VMBLOK-EXECEPT VMCHTBL 02475000
* WHICH IS SAVED AT CHINDEX 02476000
SPACE 1 02477000
VCHSTRT DC F'0' START ADDR VIRTUAL CH INDEX TBL. @VA04250 02478000
VCUSTRT DC F'0' START ADDR VIRTUAL CU INDEX TABLE@VA04250 02479000
VDVSTRT DC F'0' START ADDR VIRT DEV INDEX TABLE @VA04250 02480000
* 02481000
VMCHAIN DC F'0' ADDR OF NEXT VMBLOK IN CHAIN @VA04250 02482000
VMCURENT DC F'0' ADDR. CURRENT VMBLOK @VA04250 02483000
DEFEXPT DC F'0' ADDR DEFERRED EXECUTION BLOK @V407510 02484000
SPACE 3 02485000
RTNSAVE DC A(0) RETURN ADDR SAVE AREA @VA04250 02486000
IOBRTN DC A(0) RTN ADDR SAVE FROM IOBLOK PRINT @VA04250 02487000
PRNTPTR DC F'0' VMBLOK PRINT POINTER SAVE AREA @VA04250 02488000
IOBCHAIN DC F'0' IOBBLOK CHAIN ADDR SAVE AREA @VA04250 02489000
IOBDEV DC F'0' ADDR 1ST IOBLOK CHAINED OFF DEV @VA04250 02490000
SFRTN DC F'0' RTN ADDR FROM SFBLOK PRINT RTN. @VA04250 02491000
IOERSAV DC F'0' RTN ADDR SAVE FROM IOERBLOK PRINT@VA04250 02492000
SPOOLSAV DC F'0' ADDR OF SPOOL FILE CONTROL BLOCK @VA04250 02493000
AIOB DC F'0' ACTIVE IOBLOK ADDR @VA04250 02494000
ERRBLOCK DC F'0' IOERBLOK ADDR SAVE AREA @VA04250 02495000
PAGBLOK DC F'0' @VA04250 02496000
SPLBLOK DC F'0' @VA04250 02497000
VCONAD DC F'0' @VA04250 02498000
REG9SAV DC F'0' REG 9 SAVE AREA @VA04250 02499000
K64M1 DC F'65535' 64K MINUS 1 @VA01570 02500000
VMSAVE DC H'0' NO. OF BLKS OF VMBLOK YET TO PRNT@VA04250 02501000
TWENTY4 DC H'24' @VA04250 02502000
TWELVE DC H'12' @VA04250 02503000
FOUR DC H'4' @VA04250 02504000
TWO DC H'2' @VA04250 02505000
FFFF DC X'FFFF' @VA04250 02506000
PRTENDSW DC X'00' LAST PRINT LINE SWITCH-F0=END OF @VA04250 02507000
* OF HEADINGS, 0F=END OF DATA 02508000
DATENDSW DC X'00' LAST DATA LINE SWITCH @VA04250 02509000
CONSW DC X'00' VIRTUAL CONSOLE DEVICE SWITCH @VA04250 02510000
IOERSW DC X'00' IOERBLOK SWITCH @VA04250 02511000
ACTIOBSW DC X'00' ACTIVE IOBLOK SWITCH @VA04250 02512000
SPOOLSW DC X'00' SPOOLING DEVICE SWITCH @VA04250 02513000
OWNSW DC X'00' @VA04250 02514000
VMBSW DC X'00' @VA04250 02515000
ERRINDX DC X'00' THIS IS THE UNFOOLING GUY @VA01570 02516000
PSASW DC X'00' PSA PROCESSING SWITCH @V407510 02517000
SPACE 3 02518000
* 02519000
* HEADINGS FOR ALL I/O AND VM BLOCKS 02520000
* 02521000
HCHBLK DC C'RCHBLOK ' CHANNEL BLOCK HEADING @VA04250 02522000
HCHAN DC C'CHAN ' CHANNEL NO. HEADING @VA04250 02523000
HCHNO DC C'XXX ' CHANNEL NUMBER @VA04250 02524000
HCHADDR DC C'ADDR ' @VA04250 02525000
HCHBADDR DC 9C' ' CHANNEL BLOCK ADDR @VA04250 02526000
SPACE 1 02527000
HCUBLK DC C'RCUBLOK ' CU BLOCK HEADING @VA04250 02528000
HCUNIT DC C'UNIT ' @VA04250 02529000
HCUNO DC C'XXX ' @VA04250 02530000
HCUADDR DC C'ADDR ' @VA04250 02531000
HCUBADDR DC 9C' ' CU BLOCK ADDR @VA04250 02532000
SPACE 1 02533000
HDEVBLK DC C'RDEVBLOK ' DEV BLOCK HEADING @VA04250 02534000
HDEV DC C'DEV ' @VA04250 02535000
HDEVNO DC C'XXX ' @VA04250 02536000
HDADDR DC C'ADDR ' @VA04250 02537000
HDBADDR DC 9C' ' BLOCK ADDR @VA04250 02538000
SPACE 1 02539000
HSFBLK DC CL14'SFBLOK' @VA04250 02540000
HSFID DC CL14' ' @VA04250 02541000
DC CL5'ADDR ' @VA04250 02542000
HSFADDR DC CL9' ' @VA04250 02543000
SPACE 1 02544000
HRECBLK DC CL8'RECBLOK' @VA04250 02545000
HRECID DC CL6' ' @VA04250 02546000
DC CL5'ADDR ' @VA04250 02547000
HRECADDR DC CL9' ' @VA04250 02548000
SPACE 1 02549000
HIOBLKS DC 14C' ' HEADING FOR IOBLOK,RSPLCTL, @VA04250 02550000
* SFBLOK,IOERBLOK, AND ACTIVE IOBLOK 02551000
HIOADDR DC C'ADDR ' @VA04250 02552000
HIOBADDR DC 9C' ' BLOCK ADDR. @VA04250 02553000
HACTIO DC C'ACTIVE IOBLOK' @VA04250 02554000
HIOBLOK DC C'IOBLOK ' @VA04250 02555000
HRSPLCTL DC C'RSPLCTL ' @VA04250 02556000
HCONTASK DC CL14'CONTASK' @VA04250 02557000
HIOERBLK DC C'IOERBLOK ' @VA04250 02558000
HVMEC DC CL14'ECBLOK' @VA04250 02559000
HVMTR DC CL14'TREXT' @VA04250 02560000
HVMDE DC CL14'DEFERRED TASK ' @V407510 02561000
HVMAIN DC CL14'MAIN PSA ' @V407510 02562000
HVATT DC CL14'ATTACHED PSA ' @V407510 02563000
HVSTOR DC CL14'MAIN STORAGE ' @V4M0004 02564000
HVCONCTL DC C'VCONCTL ' @VA04250 02565000
HVSPLCTL DC C'VSPLCTL ' @VA04250 02566000
SPACE 1 02567000
HVMBLOK DC C'VMBLOK ' VMBLOK HEADING @VA04250 02568000
HUSERID DC CL5'USER ' @VA04250 02569000
HIDEN DC 9C' ' USERID @VA04250 02570000
HVMADDR DC C'ADDR ' @VA04250 02571000
HVMBADDR DC 9C' ' BLOCK ADDR. @VA04250 02572000
EJECT 02573000
DM0 DC C'DMMEDM850I UNABLE TO READ DUMP FROM READER' @VA04250 02574000
DM0L EQU *-DM0 @VA04250 02575000
DM1 EQU * @VA04250 02576000
DC C'''' @VA04250 02577000
DM1P DC CL8' ' @VA04250 02578000
DC C' DUMP'' FILE CREATED' @VA04250 02579000
DM1L EQU *-DM1 @VA04250 02580000
DM2 DC C'DMMEDM852I FATAL I/O ERROR WRITING DUMP' @VA04250 02581000
DM2L EQU *-DM2 @VA04250 02582000
DM3 DC C'DMMEDM863E INVALID PARAMETER - ' @V305435 02583000
ERR1OP DC CL8' ' @VA04250 02584000
DM3L EQU *-DM3 @VA04250 02585000
DM4 DC C'DMMEDM851I TEN DUMP FILES ALREADY EXIST' @VA04250 02586000
DM4L EQU *-DM4 @VA04250 02587000
DM5 DC C'DMMEDM861E DUMP FILE ' @V305435 02588000
DC C'''' @VA04250 02589000
DM5P DC CL8' ' @VA04250 02590000
DC C' DUMP'' NOT FOUND' @VA04250 02591000
DM5L EQU *-DM5 @VA04250 02592000
DM6 DC C'DMMEDM853I NO DUMP FILES EXIST' @VA04250 02593000
DM6L EQU *-DM6 @VA04250 02594000
DM7 DC C'DMMEDM864I PAGE REFERENCED NOT AVAILABLE' @VA04250 02595000
DM7L EQU *-DM7 @VA04250 02596000
DM8 DC C'DMMEDM860I FATAL I/O ERROR READING DUMP' @VA04250 02597000
DM8L EQU *-DM8 @VA04250 02598000
DM9 DC C'NO DUMP FILE CREATED' @VA04250 02599000
DM9L EQU *-DM9 @VA04250 02600000
DM10 DC C'PRINTER ERROR' @VA04250 02601000
DM10L EQU *-DM10 @VA04250 02602000
DMSG DC C'PRINTING FILE ' @VA04250 02603000
DC C'''' @VA04250 02604000
DMPP DC CL8' ' @VA04250 02605000
DC C' DUMP''' @VA04250 02606000
DMSGL EQU *-DMSG @VA04250 02607000
CMSG DC C'CREATING FILE ' @VA04250 02608000
DC C'''' @VA04250 02609000
CMP DC CL8' ' @VA04250 02610000
DC C' DUMP''' @VA04250 02611000
CMSGL EQU *-CMSG @VA04250 02612000
KPMSG DC C'DUMP FILE ' @VA04250 02613000
DC C'''' @VA04250 02614000
KMP DC CL8' ' @VA04250 02615000
DC C' DUMP'' PRINTED AND KEPT' @VA04250 02616000
KPMSGL EQU *-KPMSG @VA04250 02617000
ERMSG DC C'DUMP FILE ' @VA04250 02618000
DC C'''' @VA04250 02619000
ERMP DC CL8' ' @VA04250 02620000
DC C' DUMP'' PRINTED AND ERASED' @VA04250 02621000
ERMSGL EQU *-ERMSG @VA04250 02622000
ASKMSG DC C'DO YOU WANT THIS DUMP? REPLY YES OR NO' @VA04250 02623000
ASKMSGL EQU *-ASKMSG @VA04250 02624000
LTORG @VA04250 02625000
ORG DMMEDM+(3*4096) ORG TO BUFFER AREA @VA04250 02626000
BUFF DS 1024F @VA04250 02627000
KEY EQU * @VA04250 02628000
BUFF2 DS 1024F @VA04250 02629000
KEY1 DS 1024F @VA04250 02630000
ITEM2 DS 1024F @VA04250 02631000
ORG ITEM2 @VA04250 02632000
I2GRS DS 16F @VA04250 02633000
I2CRS DS 16F @VA04250 02634000
I2FPRS DS 4D @VA04250 02635000
I2TOD DS 3D @VA04250 02636000
DS 2X @V407510 02637000
I2PROCA DS 1H PROCESSOR ADDRESS @V407510 02638000
I2SYSRV DS 1F STORAGE SIZE @V407510 02639000
I2LCORE DS XL256 @VA04250 02640000
***************************************************************@V407510 02641000
ORG I2LCORE+248 SAVE PREFIX REGS IN LCORE AREA @V407510 02642000
* AREA USED ONLY BY EDM***REC 5 @V407510 02643000
* HAS BEEN REFRESHED WITH DMPLCORE @V407510 02644000
I2MPREF DS 1F MAIN PREFIX RG @V407510 02645000
I2APREF DS 1F ATTACHED PREFIX RG @V407510 02646000
***************************************************************@V407510 02647000
I2PRFRG DS 1F PREFIX REGISTER @V407510 02648000
I2AB DS 1F ABEND CODE @V407510 02649000
I2RCH DS 4F @VA04250 02650000
I2SPL DS 3F @VA04250 02651000
I2COR DS 1F @VA04250 02652000
I2VM DS 1F @VA04250 02653000
I2DATE DS 1D @VA04250 02654000
I2TIME DS 1D @VA04250 02655000
ITEMTBL DS 0F @VA04250 02656000
EJECT 02657000
BLOKFORM DSECT @VA04250 02658000
FRCHBLK DS 0C @VA04250 02659000
DS CL9 @VA04250 02660000
FRCUBLK DS 0C @VA04250 02661000
DS CL9 @VA04250 02662000
FRDEVBLK DS 0C @VA04250 02663000
DS CL9 @VA04250 02664000
FIOBLK DS 0C @VA04250 02665000
DS CL9 @VA04250 02666000
FSPOOL DS 0C @VA04250 02667000
FVMBLK EQU FRCHBLK @VA04250 02668000
FVCHBLK EQU FRCHBLK @VA04250 02669000
FVCUBLK EQU FRCUBLK @VA04250 02670000
FVDEVBLK EQU FRDEVBLK @VA04250 02671000
EJECT 02672000
PSA @VA04250 02673000
COPY DMPBLOKS @VA04250 02674000
COPY ALLOC @VA04250 02675000
COPY CPEXBLOK @V4M0004 02676000
COPY TREXT @VA04250 02677000
COPY CORE @VA04250 02678000
COPY RBLOKS @VA04250 02679000
COPY VBLOKS @VA04250 02680000
COPY VMBLOK @VA04250 02681000
COPY IOBLOKS @VA04250 02682000
COPY SPOOL @VA04250 02683000
COPY DEVTYPES @VA04250 02684000
COPY EQU @VA04250 02685000
COPY IOER @VA04250 02686000
END 02687000