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