OVS TITLE 'DMSOVS (CMS) VM/370 - RELEASE 6' 00001000 SPACE 2 00002000 *. 00003000 * MODULE NAME - 00008000 * 00009000 * DMSOVS (OVERSUB) 00010000 * 00011000 * FUNCTION - 00012000 * 00013000 * 00014000 * PROVIDE TRACE INFORMATION REQUESTED BY 'SVCTRACE' COMMAND. 00015000 * 00016000 * ATTRIBUTES - 00017000 * 00018000 * DISK-RESIDENT, RE-USABLE 00019000 * 00020000 * ENTRY POINTS - 00021000 * 00022000 * DMSOVS 00023000 * 00024000 * ENTRY CONDITIONS - 00025000 * 00026000 * IT IS INTENDED THAT DMSOVS ONLY BE CALLED BY DMSITS, 00027000 * TO PROVIDE TRACE INFORMATION REQUESTED BY 'SVCTRACE'. 00028000 * AT ENTRY, CURRSAVE (IN NUCON) SHOULD POINT TO THE CURRENT 00029000 * SYSTEM SAVE AREA. 00030000 * IN ADDITION, DMSITS MUST HELP OUT DMSOVS BY PROVIDING THE 00031000 * FOLLOWING INFORMATION: 00032000 * THE ADDRESSES OF DMSERR AND DMSCWT MUST BE PASSED TO DMSOVS, 00033000 * AND PLACED IN THE ROURTH AND FIFTH WORDS THEREOF. 00034000 * ALSO, THE STARTUP PSW MUST BE PLACED IN LOCATIONS 0-8 OF 00035000 * LOW CORE. 00036000 * 00037000 * EXIT CONDITIONS - 00038000 * 00039000 * NORMAL - 00040000 * THE TRACE INFORMATION HAS BEEN PROVIDED. 00041000 * 00042000 * ERROR - 00043000 * THERE IS NO ERROR RETURN POSSIBLE. 00044000 * 00045000 * CALLS TO OTHER ROUTINES - 00046000 * 00047000 * DMSERR -- TO PROVIDE THE TRACE INFORMATION. 00048000 * DMSCWT (CONWAIT) -- TO WAIT FOR OUTPUT TO TERMINATE. 00049000 * 00050000 * EXTERNAL REFERENCES - 00051000 * 00052000 * NONE. (NOTE -- DMSITS MUST PASS THE ADDRESSES OF DMSERR 00053000 * AND DMSCWT TO DMSOVS.) 00054000 * 00055000 * TABLES / WORKAREAS - 00056000 * 00057000 * USES WORKSPACE INTERNAL TO ROUTINE. (ROUTINE IS NOT 00058000 * RE-ENTRANT.) 00059000 * 00060000 * REGISTER USAGE - 00061000 * 00062000 * R3 -> SVCSECT 00063000 * R4 -> CURRENT SYSTEM SAVE AREA 00064000 * R5, R6 = INTERNAL PARAMETER REGISTERS 00065000 * RR = INTERNAL SUBROUTINE LINK REGISTER 00066000 * R12 = BASE REGISTER 00067000 * 00068000 * NOTES - 00069000 * 00070000 * NONE. 00071000 * 00072000 * OPERATION - 00073000 * 00074000 * THE OVERRIDE FLAG BITS IN SVCSECT ARE INTERROGATED TO 00075000 * DETERMINE WHICH SVCTRACE OPTIONS ARE IN EFFECT. AS EACH 00076000 * 'ON' BIT IS FOUND, THE APPROPRIATE INFORMATION IS EITHER 00077000 * TYPED OR PRINTED. 00078000 * 00079000 * IF THE 'STOP' OPTION HAS BEEN SPECIFIED, THEN THE CP 'ADSTOP' 00080000 * FACILITY IS INVOKED TO ADDRESS STOP ON THE ADDRESS IN THE 00081000 * PSW WITH WHICH DMSITS IS TO RESTART. 00082000 * 00083000 * 00084000 * P3071 00085000 * P3071 00086000 * P3071 00087000 *. P3071 00088000 EJECT P3071 00089000 MACRO 00091000 TF &F,&B,&L 00092000 LCLC &C 00093000 &C SETC '&F'(1,1) 00094000 TM FLAGS-1+&C,OVF&F 00095000 B&B &L 00096000 MEND 00097000 SPACE 5 00098000 MACRO 00099000 TAFT &L 00100000 TM OVSTAT,OVSAFT CHECK 'AFTER' FLAG 00101000 BO &L GO IF IT'S ON 00102000 MEND 00103000 SPACE 2 00104000 MACRO 00105000 TBEF &L 00106000 TM OVSTAT,OVSAFT CHECK 'AFTER' FLAG 00107000 BZ &L GO IF OFF, MEANING 'BEFORE' 00108000 MEND 00109000 DMSOVS CSECT 00111000 REGEQU 00112000 SPACE 2 00113000 BR EQU R12 BASE REGISTER 00114000 SVCR EQU R3 POINTER TO SVCSECT 00115000 SR EQU R4 POINTER TO SYSTEM SAVE AREA 00116000 PR1 EQU R5 FIRST INTERNAL PARAMETER REG 00117000 PR2 EQU R6 SECOND INTERNAL PARAMETER REG 00118000 RR EQU R7 INTERNAL RETURN REGISTER 00119000 XR EQU R8 SCRATCH REGISTER 00120000 SPACE 5 00121000 USING DMSOVS,BR 00122000 USING SVCSECT,SVCR 00123000 USING SSAVE,SR 00124000 USING NUCON,R0 00125000 * DMSOVS -- THIS ROUTINE IS LOADED INTO NUCLEUS FREE STORAGE BY 00127100 * DMSOVR, AND SO MAY NOT CONTAIN ANY RELOCATABLE ADDRESS CONSTANTS 00129000 * OR VCONS. WE ENTER HERE FROM DMSITS TO PROVIDE THE NECESSARY 00130000 * TRACE INFORMATION. THE FIRST FEW WORDS OF THIS MODULE MUST BE THE 00131000 * SAVE AS DESCRIBED IN THE OVSECT MACRO, WHICH IS REFERENCED BY OTHER 00132000 * ROUTINES. 00133000 DMSOVS CSECT 00134000 USING *,R15 00135000 B START ENTER HERE TO START TRACE 00136000 ADMSERR DC A(0) ADDRESS OF DMSERR, AND OF ... 00137000 ACONWAIT DC A(0) CONWAIT, ARE PASSED BY DMSITS 00138000 LENOVS DC A(OVSLEN) LENGTH OF THIS ROUTINE IN DWORDS 00139000 * THIS MARKS THE END OF THE AREA DESCRIBED BY THE OVSECT MACRO. 00140000 SPACE 3 00141000 START EQU * 00142000 STM R0,R15,SAVEREGS SAVE ALL REGISTERS 00143000 MVC LOWCORE(16),ITSPSW SAVE 4 WORDS OF LOW CORE 00144000 LR BR,R15 COPY BASE REGISTER 00145000 DROP R15 00146000 L SVCR,ASVCSECT POINT TO SVCSECT 00147000 L SR,CURRSAVE POINT TO SYSTEM SAVE AREA 00148000 SPACE 00149000 * IF THIS IS A 'BEFORE' CALL, THEN WE INITIALIZE SOME 00150000 * SPECIAL THINGS IN THE SYSTEM SAVE AREA. 00151000 TAFT START1 GO IF THIS IS AN 'AFTER' CALL 00152000 MVC XGPR0(8),EGPR0 SET XGPR0, XGPR1 00153000 MVC XGPR15,EGPR15 SET XGPR15 00154000 MVC XCOUNT,SVCOUNT SET XCOUNT 00155000 SPACE 00156000 START1 EQU * 00157000 TM OVSTAT,OVSSO 'SUSPEND OVERRIDES' IN EFFECT 00158000 BO RT RETURN IMMEDIATELY, IF SO 00159000 TM OVSTAT,OVSHO 'HALT OVERRIDES' FLAG SET 00160000 BO HALTOVR GO HANDLE IT IF SO 00161000 MVC FLAGS(4),OVBPF COPY 'BEFORE' FLAGS 00162000 TBEF *+10 SKIP IF 'BEFORE' ENTRY 00163000 MVC FLAGS(4),OVAPF COPY 'AFTER' FLAGS, IF 'AFTER' 00164000 MVI STOPFLAG,0 TURN OFF STOPFLAG, FOR NOW 00165000 MVI TYPEFLAG,0 WE ARE NOT YET TYPING 00166000 SPACE 2 00167000 * COME HERE EITHER BY DROPPING THROUGH FROM ABOVE, OR BY RETURNING 00168000 * HERE AFTER THE PRINTING HAS BEEN COMPLETED TO CHECK FOR TYPING. 00169000 PTLOOP EQU * 00170000 TF 1ON,Z,NOWORK NOTHING TO DO IF NOT 'ON' 00171000 TM TYPFLAG,TPFSVO IS THIS 'OS SVC'? 00172000 BO PTOS GO IF IT IS 00173000 TBEF PTB GO IF 'BEFORE' 00174000 TF 2NR,O,PTB GO IF HE WANTS 'NORMAL' CMS SVCS 00175000 SPACE 00176000 * OTHERWISE, HE IS SUPPRESSING 'NORMAL CMS SVC' CALLS. WE CHECK TO 00177000 * SEE IF THIS IS A NORMAL RETURN. 00178000 CLC EGPR15,=F'0' IS THIS A NORMAL RETURN? 00179000 BE NOWORK NOTHING TO DO IF SO 00180000 SPACE 00181000 * COME HERE TO CHECK IF HE IS SUPPRESSING ALL CMS SVC CALLS. 00182000 PTB EQU * 00183000 TF 2CM,Z,NOWORK GO IF HE IS SUPPRESSING THEM 00184000 B PTE WE'RE OK IF HE'S NOT 00185000 SPACE 2 00186000 * COME HERE ON AN OS SVC CALL. WE MUST CHECK TO SEE IF HE WANTS THEM 00187000 * TRACED. 00188000 PTOS EQU * 00189000 TF 2OS,Z,NOWORK GO IF HE DOESN'T 00190000 SPACE 00191000 * COME HERE IF HE WANTS THIS ONE TRACED. 00192000 PTE EQU * 00193000 * WE OUTPUT THE DESCRIPTION LINE, WHICH SUMMARIZES THE SVC CALL. 00195000 DL EQU * 00196000 SPACE 00197000 LINEDIT TYPCALL=NONE,DOT=NO,BUFFA=LBUFF,DISP=NONE, *00198000 COMP=NO,MF=(E,ERLIST),TEXT=' ' OUTPUT A NULL LINE 00199000 BAL RR,OUTPUT 00200000 MVC DLTEXTRC,RCOFF ASSUME NO RC WANTED 00201000 MVI DLTEXTS,C'-' ASSUME '-' AS FIRST CHAR 00202000 SPACE 00203000 * IF THIS IS A 'BEFORE' CALL, THEN WE DON'T PRINT THE RC INFORMATION, 00204000 * AND THE DESCRIPTION LINE BEGINS WITH A HYPHEN. 00205000 TBEF DLL GO IF THIS IS 'BEFORE' 00206000 SPACE 00207000 * FOR 'AFTER' CALLS, THE DESCRIPTION LINE BEGINS WITH A PLUS SIGN 00208000 * (FOR NORMAL RETURNS OR OS SVCS) OR WITH A STAR (FOR ERROR CMS 00209000 * RETURNS). 00210000 MVI DLTEXTS,C'+' ASSUME PLUS SIGN 00211000 TM TYPFLAG,TPFSVO IS THIS AN OS SVC? 00212000 BO DLL THEN NO MORE ALTERATIONS 00213000 MVC DLTEXTRC,RCON INSERT 'RC' FIELD FOR CMS 00214000 CLC EGPR15,=F'0' IS THIS A NORMAL RETURN? 00215000 BE DLL NO ALTERATIONS, IF SO 00216000 MVI DLTEXTS,C'*' USE STAR AS FIRST CHAR, IF NOT 00217000 SPACE 00218000 * AT THIS POINT, THE 'TEXT' OF THE LINEDIT MACRO HAS BEEN FORMED, AND 00219000 * WE'RE READY TO MAKE THE CALL TO PERFORM THE SUBSTITUTIONS. 00220000 DLL EQU * 00221000 LINEDIT TYPCALL=NONE,DOT=NO,BUFFA=LBUFF,DISP=NONE, *00222000 TEXTA=DLTEXT,MF=(E,ERLIST), *00223000 SUB=(DECA,XCOUNT,DECA,DEPTH,CHARA,CALLEE,HEXA,CALLER, *00224000 HEX4A,OLDPSW,HEX4A,LOWCORE,DECA,EGPR15) 00225000 BAL RR,OUTPUT OUTPUT THE LINE 00226000 B DLE 00227000 SPACE 3 00228000 DLTEXT EQU * 00229000 DC AL1(DLTEXTL),C' ' 00230000 DLTEXTS DC C'*' - = BEFORE, + = AFTER, * = ERROR 00231000 DC C'N/D = ....../..,' 00232000 DC C' ........ FROM ......,' CALLEE/CALLER 00233000 DC C' OLDPSW = .................,' 00234000 DC C' GOPSW = .................' 00235000 DLTEXTRC DC C', RC = ..........' 00236000 DLTEXTL EQU *-DLTEXT-1 TEXT LENGTH 00237000 RCON DC C', RC = ..........' 00238000 RCOFF DC (L'RCON)C' ' 00239000 DS 0H 00240000 DLE EQU * 00241000 LINEDIT TYPCALL=NONE,DOT=NO,BUFFA=LBUFF,DISP=NONE, C00241250 COMP=NO,MF=(E,ERLIST),TEXT=' ' NULL LINE @VA06251 00241500 BAL RR,OUTPUT TO STOP OVERPRINTING @VA06251 00241750 GB EQU * 00243000 TF 1GB,Z,GBE GO IF GPRS BEFORE NOT WANTED 00244000 MVC DUMPAREA,EGPRS COPY EGPRS INTO DUMPAREA 00245000 MVC DUMPAREA(8),XGPR0 OVERLAY XGPR0, XGPR1 00246000 MVC DUMPAREA+4*R15,XGPR15 OVERLAY XGPR15 00247000 LA PR1,=C'GPRSB' TITLE = GPRSB 00248000 LA PR2,DUMPAREA POINT TO REGS 0-7 00249000 BAL RR,HEXDUMP DUMP THOSE 00250000 LA PR1,=CL5' ' NO TITLE ON SECOND LINE 00251000 LA PR2,DUMPAREA+32 POINT TO REGS 8-15 00252000 BAL RR,HEXDUMP DUMP THOSE 00253000 SPACE 00254000 GBE EQU * 00255000 GA EQU * 00257000 TF 1GA,Z,GAE GO IF GPRS AFTER NOT WANTED 00258000 TBEF GAE GO IF THIS IS 'BEFORE' DUMP 00259000 TF 1GB,O,GA1 IF WE HAVE JUST DUMPED GPRS *00260000 BEFORE, THEN USE DIFFERENT FORM 00261000 LA PR1,=C'GPRSA' TITLE = GPRSB 00262000 LA PR2,EGPRS POINT TO REGS 0-7 00263000 BAL RR,HEXDUMP DUMP THEM 00264000 LA PR1,=CL5' ' NO TITLE ON SECOND LINE 00265000 LA PR2,EGPRS+32 POINT TO REGS 8-15 00266000 BAL RR,HEXDUMP DUMP THEM 00267000 B GAE FINISHED WITH REGS AFTER 00268000 SPACE 00269000 * IF WE ARE DUMPING REGS BEFORE AND REGS AFTER, WE USE A DIFFERENT 00270000 * FORMAT -- WE DUMP JUST THE NEW VALUES OF REGS 0-1 AND 15. 00271000 * (IF ANY OTHER REGS HAVE BEEN CHANGED IN SSAVE, WE HAVE NO WAY OF 00272000 * KNOWLING ABOUT THEM, ANYWAY.) 00273000 GA1 EQU * 00274000 LINEDIT MF=(E,ERLIST),TYPCALL=NONE,DOT=NO,COMP=NO, *00275000 TEXTA=GATEXT,BUFFA=LBUFF,DISP=NONE, *00276000 SUB=(HEX4A,EGPR0,CHARA,EGPR0,HEX4A,EGPR15,CHARA,EGPR15) 00277000 BAL RR,OUTPUT GO OUTPUT THE LINE 00278000 B GAE 00279000 SPACE 2 00280000 GATEXT DC AL1(GATEXTL),C' ',X'00' 00281000 DC C'GPRS AFTER : R0-R1 = ' 00282000 DC (17)C'.',C' *',(8)C'.',C'*' 00283000 DC C' R15 = ',(8)C'.',C' *....*' 00284000 GATEXTL EQU *-GATEXT-1 00285000 DS 0H 00286000 GAE EQU * 00287000 GS EQU * 00289000 TF 1GS,Z,GSE GO IF GPRSS NOT WANTED 00290000 TBEF GSE GO IF THIS IS 'BEFORE' CALL 00291000 LA PR1,=C'GPRSS' TITLE = GPRSS 00292000 LA PR2,RGPRS POINT TO RGPR0-RGPR7 00293000 BAL RR,HEXDUMP DUMP THEM 00294000 LA PR1,=CL5' ' NO TITLE ON SECOND LINE 00295000 LA PR2,RGPR8 POINT TO RGPR8-RGPR15 00296000 BAL RR,HEXDUMP DUMP THEM 00297000 SPACE 00298000 GSE EQU * 00299000 F EQU * 00301000 TF 1F,Z,FE GO IF FPRS NOT WANTED 00302000 LA PR1,=C'FPRS ' TITLE = FPRS 00303000 LA PR2,EFPRS POINT TO THEM 00304000 BAL RR,HEXDUMP DUMP THEM 00305000 SPACE 00306000 FE EQU * 00307000 FS EQU * 00309000 TF 1FS,Z,FSE GO IF HE DOESN'T WANT THEM 00310000 TBEF FSE GO IF THIS IS 'BEFORE' CALL 00311000 LA PR1,=C'FPRSS' TITLE = FPRSS 00312000 LA PR2,RFPRS POINT TO THE REGS 00313000 BAL RR,HEXDUMP DUMP THEM 00314000 FSE EQU * 00315000 PL EQU * 00317000 TF 1PA,Z,PLE GO IF PARAM LIST NOT WANTED 00318000 LA PR1,=C'PARM ' TITLE = PARM 00319000 L PR2,XGPR1 XGPR1 -> PARAMETER LIST 00320000 SPACE 00321000 * THE PLIST LIST POINTER MUST BE WITHIN 64 BYTES OF 00322000 * THE END OF VIRTUAL MEMORY, TO PREVENT A PROGRAM CHECK. 00323000 LA PR2,0(,PR2) ZERO OUT HIGH BYTE 00324000 L XR,VMSIZE GET END OF VIRTUAL MEMORY 00325000 SH XR,=H'64' SUBTRACE 64 00326000 CLR PR2,XR COMPARE ADDRESSES 00327000 BH PLE SKIP OUTPUT IF TOO HIGH 00328000 BAL RR,HEXDUMP DUMP THE FIRST LINE 00329000 LA PR1,=CL5' ' NO TITLE ON SECOND LINE 00330000 LA PR2,32(,PR2) POINT TO NEXT GROUP OF TOKENS 00331000 BAL RR,HEXDUMP DUMP THE SECOND LINE 00332000 SPACE 00333000 PLE EQU * 00334000 TF 2ST,Z,*+8 SKIP IF 'STOP' NOT SPECIFIED 00336000 MVI STOPFLAG,X'FF' WE'LL HAVE TO STOP 00337000 SPACE 00338000 NOWORK EQU * 00339000 MVC FLAGS,FLAGS+2 COPY TYPE FLAGS TO FLAGS 00340000 MVI FLAGS+2,0 ZERO OUT OLD TYPE FLAGS 00341000 MVI TYPEFLAG,X'FF' WE ARE NOW TYPING 00342000 TF 1ON,O,PTLOOP GO BACK IF TYPING WANTED 00343000 * IF THE 'STOP' OPTION WAS SPECIFIED FOR EITHER TYPING OR PRINTING, 00345000 * THEN WE DIAGNOSE TO CP AN ADSTOP, SPECIFYING THE ADDRESS IN THE 00346000 * NEW PSW WHICH CMS WILL BE LOADING. 00347000 CST EQU * 00348000 CLI STOPFLAG,0 WAS 'STOP' SPECIFIED? 00349000 BE CSTE NOTHING TO DO IF NOT 00350000 STM R0,R15,DUMPAREA SAVE REGS TEMPORARILY 00351000 LA R1,=CL16'CONWAIT CON1' POINT TO A CONWAIT PLIST 00352000 LA R13,LBUFF PASS LBUFF AS A SAVE AREA 00353000 L R15,ACONWAIT ADDRESS OF CONWAIT ROUTINE 00354000 BALR R14,R15 CALL CONWAIT TO WAIT FOR TERM *00355000 OUTPUT TO BE DRAINED. 00356000 USING *,R14 00357000 LM R0,R15,DUMPAREA RESTORE ALL OUT REGS 00358000 DROP R14 00359000 SPACE 00360000 * FORM THE 'ADSTOP' LINE 00361000 LINEDIT DISP=CPCOMM,TYPCALL=NONE,DOT=NO, *00362000 TEXT='ADSTOP ......',SUB=(HEXA,LOWCORE+4) 00363000 L R15,ADMSERR CALL DMSERR 00364000 BALR R14,R15 00365000 LTR R15,R15 ANY ERROR RETURN FROM CP? 00366000 BZ CSTE GO IF NOT 00367000 LINEDIT TYPCALL=NONE,TEXT='CAN''T STOP' 00368000 L R15,ADMSERR 00369000 BALR R14,R15 CALL DMSERR 00370000 CSTE EQU * 00371000 RT EQU * 00373000 MVC ITSPSW(16),LOWCORE RESTORE LOW CORE 00374000 MVC CODE203(2),CODE MAKE SURE CODE203 IS OK @VA13234 00374500 LM R0,R15,SAVEREGS RESTORE DMSITS' REGS 00375000 BR R14 AND RETURN THERE 00376000 HALTOVR EQU * 00378000 NI OVSTAT,X'FF'-(OVSON+OVSSO+OVSHO) TURN OFF FLAGS 00379000 TM OVBPF,OVF1ON WAS 'BEFORE PRINT' ON? 00380000 BO HOP PRINT IF SO 00381000 TM OVAPF,OVF1ON WAS 'AFTER PRINT' ON? 00382000 BNO HO1 DON'T PRINT IF NOT 00383000 SPACE 00384000 HOP EQU * 00385000 LINEDIT DISP=PRINT,DOT=NO,COMP=NO,TYPCALL=NONE, *00386000 TEXT='0 SVCTRACE OFF (HO)' 00387000 L R15,ADMSERR 00388000 BALR R14,R15 CALL DMSERR 00389000 LINEDIT DISP=CPCOMM,DOT=NO,TYPCALL=NONE,TEXT='CLOSE PRT' 00390000 L R15,ADMSERR 00391000 BALR R14,R15 CALL DMSERR 00392000 SPACE 00393000 HO1 EQU * 00394000 MVC ITSPSW(16),LOWCORE RESTORE LOW CORE 00395000 MVC CODE203(2),CODE MAKE SURE CODE203 IS OK @VA13234 00395500 LM R0,R15,SAVEREGS RESTORE REGISTERS 00396000 SPACE 00397000 * A 'JUMP' RETURN WILL CAUSE DMSOVS TO BE RELEASED. 00398000 B 4(R14) JUMP RETURN TO DMSITS 00399000 * HEXDUMP SUBROUTINE -- DUMPS 32 BYTES IN BOTH HEX AND CHARACTER, 00401000 * IN STANDARD FORMAT. 00402000 * AT ENTRY, REGS ARE AS FOLLOWS: 00403000 * PR1 -| 5-BYTE TITLE FOR LINE 00404000 * PR2 -| 32-BYTE AREA TO BE DUMPED 00405000 * RR -| RETURN INSTRUCTION 00406000 HEXDUMP EQU * 00407000 LINEDIT MF=(E,ERLIST),TYPCALL=NONE,DOT=NO,COMP=NO,DISP=NONE, *00408000 TEXTA=LTEXT,BUFFA=LBUFF, *00409000 SUB=(CHARA,(PR1),HEX4A,(PR2),HEX4A,8(PR2),HEX4A,16(PR2),*00410000 HEX4A,24(PR2),CHARA,(PR2)) 00411000 B OUTPUT GO OUTPUT LINE AND RETURN 00412000 SPACE 2 00413000 LTEXT EQU * 00414000 DC AL1(LTEXTL),C' ',X'00' 00415000 DC C'..... = ' 00416000 DC (4)C'................. ' 00417000 DC C'*',(32)C'.',C'*' 00418000 LTEXTL EQU *-LTEXT-1 LENGTH OF TEXT 00419000 DS 0H 00420000 EJECT 00421000 * OUTPUT SUBROUTINE -- OUTPUT A LINE TO TERMINAL OR PRINTER. 00422000 * AT ENTRY, LBUFF CONTAINS THE LINE IN THE FORMAT RETURNED BY 00423000 * LINEDIT WITH 'BUFFA' OPTION, AND RR CONTAINS THE ADDRESS TO WHICH 00424000 * WE'RE TO RETURN. 00425000 OUTPUT EQU * 00426000 L R15,ADMSERR GET ADDRESS OF DMSERR 00427000 BALR R14,R15 FORM OUTPUT LINE 00428000 CLI TYPEFLAG,0 ARE WE TYPING? 00429000 BE OUTPRT GO PRINT IF NOT 00430000 SPACE 00431000 TR LBUFF+1(L'LBUFF-1),TYPTRT TRANSLATE LINE FOR TYPING 00432000 LINEDIT DISP=TYPE,TYPCALL=NONE,DOT=NO,COMP=NO,TEXTA=LBUFF, *00433000 MF=(E,ERLIST) 00434000 L R15,ADMSERR CALL DMSERR 00435000 BALR R14,R15 00436000 BR RR RETURN TO CALLER 00437000 SPACE 3 00438000 OUTPRT EQU * 00439000 TR LBUFF+1(L'LBUFF-1),PRTTRT TRANSLATE LINE FOR PRINTING 00440000 LINEDIT DISP=PRINT,TYPCALL=NONE,DOT=NO,COMP=NO,TEXTA=LBUFF, *00441000 MF=(E,ERLIST) 00442000 L R15,ADMSERR CALL DMSERR 00443000 BALR R14,R15 00444000 BR RR RETURN TO CALLER 00445000 EJECT 00446000 * TYPOUT TRANSLATE TABLE 00447000 TYPTRT EQU * 00448000 DC 64C'.' UNPRINTABLE CHARACTERS 00449000 DC C' ' BLANK 00450000 DC 10C'.' 00451000 DC C'.<(+|&&' 00452000 DC 10C'.' 00453000 DC C'$*);¬-/' 00454000 DC 9C'.' 00455000 DC X'6B6C' 'COMMA' & 'PERCENT' SIGNS 00456000 DC C'_>?' 00457000 DC 10C'.' 00458000 DC C':' 00459000 DC X'7B7C' 'POUND' & 'AT' SIGNS 00460000 DC C'''="' 00461000 DC 64C'.' 00462000 DC C'.ABCDEFGHI' 00463000 DC 7C'.' 00464000 DC C'JKLMNOPQR' 00465000 DC 8C'.' 00466000 DC C'STUVWXYZ' 00467000 DC 6C'.' 00468000 DC C'0123456789' 00469000 DC 6C'.' 00470000 SPACE 00471000 ORG TYPTRT+X'81' SMALL LETTER A 00472000 DC 9AL1(*-TYPTRT) SMALL LETTERS A THRU I 00473000 ORG TYPTRT+X'91' SMALL LETTER J 00474000 DC 9AL1(*-TYPTRT) SMALL LETTERS J THRU R 00475000 ORG TYPTRT+X'A2' SMALL LETTER S 00476000 DC 8AL1(*-TYPTRT) SMALL LETTERS S THRU Z 00477000 ORG 00478000 SPACE 00479000 * PRINT TRANSLATE TABLE 00480000 PRTTRT EQU * 00481000 DMKDMPTR DC 64C'.' UNPRINTABLE CHARACTERS 00482000 DC C' ' BLANK 00483000 DC 10C'.' 00484000 DC C'.<(+|&&' 00485000 DC 10C'.' 00486000 DC C'$*);¬-/' 00487000 DC 9C'.' 00488000 DC X'6B6C' 'COMMA' & 'PERCENT' SIGNS 00489000 DC C'_>?' 00490000 DC 10C'.' 00491000 DC C':' 00492000 DC X'7B7C' 'POUND' & 'AT' SIGNS 00493000 DC C'''="' 00494000 DC 64C'.' 00495000 DC C'.ABCDEFGHI' 00496000 DC 7C'.' 00497000 DC C'JKLMNOPQR' 00498000 DC 8C'.' 00499000 DC C'STUVWXYZ' 00500000 DC 6C'.' 00501000 DC C'0123456789' 00502000 DC 6C'.' 00503000 TYPEFLAG DS X 0 = PRINT, X'FF' = TYPE 00505000 STOPFLAG DS X 0 = NO STOP, X'FF' = STOP 00506000 FLAGS DS BL4 FLAGS COPIED FROM SVCSECT 00507000 SAVEREGS DS 16F SAVE AREA FOR REGS 00508000 LOWCORE DS 4F SAVE AREA FOR LOW CORE 00509000 ITSPSW EQU 0 00510000 DS 0D 00511000 DUMPAREA DS CL64 00512000 DS 0D 00513000 LBUFF DS CL132 00514000 ERLIST LINEDIT MF=L,MAXSUBS=8 SPACE FOR LINEDIT PLISTS 00515000 SPACE 3 00516000 LTORG 00517000 DS 0D 00518000 OVSLEN EQU (*-DMSOVS)/8 LENGTH OF DMSOVS IN DWORDS 00519000 NUCON 00521000 SVCSECT 00522000 SVCSAVE 00523000 END 00524000