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