ibm:vm370-lib:cms:dmserr.assemble_src
Table of Contents
DMSERR Source
References
- Fixes Applied : 1
- This Source Date : Tuesday, December 12, 1978
- Last Fix ID : [R09080DS]
Source Listing
- DMSERR.ASSEMBLE.txt
- ERR TITLE 'DMSERR (CMS) VM/370 - RELEASE 6' 00001000
- SPACE 2 00002000
- *. 00003000
- * 00004000
- * 00005000
- * 00006000
- * 00007000
- * MODULE NAME - 00008000
- * 00009000
- * DMSERR 00010000
- * 00011000
- * FUNCTION - 00012000
- * 00013000
- * HANDLE CALLS PRODUCED BY 'DMSERR' AND 'LINEDIT' 00014000
- * MACROS. 00015000
- * 00016000
- * ATTRIBUTES - 00017000
- * 00018000
- * NUCLEUS RESIDENT, RE-ENTRANT 00019000
- * 00020000
- * ENTRY POINTS - 00021000
- * 00022000
- * DMSERR 00023000
- * 00024000
- * ENTRY CONDITIONS - 00025000
- * 00026000
- * R1 POINTS TO THE PLIST GENERATED BY THE 'DMSERR' OR 'LINEDIT' 00027000
- * MACRO. THIS PLIST IS HIGHLY VARIABLE IN FORMAT. IN ADDITION, 00028000
- * IF ONLY ONE SUBSTITUTION HAS BEEN SPECIFIED, THEN R0 WILL 00029000
- * CONTAIN THE SUBSTITUTION PARAMETER. 00030000
- * 00031000
- * EXIT CONDITIONS - 00032000
- * 00033000
- * NORMAL - 00034000
- * ALL REGISTERS RESTORED TO VALUE AT ENTRY, EXCEPT THAT R15=0. 00035000
- * 00036000
- * ERROR - 00037000
- * ERRORS CAN OCCUR ONLY IN 'DISP=CPCOMM' OPTION, AND, IN THIS 00038000
- * CASE, R15 CONTAINS THE CODE RETURNED BY DMSCPF. 00039000
- * 00040000
- * CALLS TO OTHER ROUTINES - 00041000
- * 00042000
- * DMSCWR (TYPLIN) -- TO TYPE OUT THE MESSAGE. 00043000
- * 00044000
- * DMSCPF (CPFUNC) -- TO PERFORM PROCESSING ASSOCIATED WITH 00045000
- * 'DISP=CPCOMM' OPTION 00046000
- * 00047000
- * DMSCWT (CONWAIT) -- TO WAIT FOR CONSOLE OUTPUT TO BE 00048000
- * COMPLETED, IN CASE 'DIE=YES' WAS SPECIFIED. 00049000
- * 00050000
- * PRINTR -- TO PRINT A LINE, IN CASE 00051000
- * 'DISP=PRINT' WAS SPECIFIED. 00052000
- * 00053000
- * EXTERNAL REFERENCES - 00054000
- * 00055000
- * DMSERT -- ADDRESS OF DMSERR WORK AREA. 00056000
- * 00057000
- * SEE 'CALLS TO OTHER ROUTINES' FOR OTHER EXTERNAL REFERENCES. 00058000
- * 00059000
- * TABLES / WORKAREAS - 00060000
- * 00061000
- * DMSERT -- DMSERR WORK AREA 00062000
- * 00063000
- * REGISTER USAGE - 00064000
- * 00065000
- * R3 -> DMSERT (WORK AREA) 00066000
- * R4 = 'FROM' POINTER FOR MESSAGE TEXT PROCESSING. 00067000
- * R5 = 'END' POINTER FOR MESSAGE TEXT PROCESSING. 00068000
- * R6 = 'TO' POINTER FOR MESSAGE TEXT PROCESSING. 00069000
- * R7 IS USED TO COUNT THE NUMBER OF DOTS IN THE MESSAGE TEXT. 00070000
- * R8 = LENGTH OF SUBSTITUTION. 00071000
- * R9 = SCRATCH REGISTER 00072000
- * R10 = INTERNAL SUBROUTINE RETURN REGISTER 00073000
- * R12 = BASE REGSITER 00074000
- * 00075000
- * NOTES - 00076000
- * 00077000
- * NONE 00078000
- * 00079000
- * OPERATION - 00080000
- * 00081000
- * AT ENTRY, THE PLIST IS DECODED AND EXPANDED INSIDE THE WORK 00082000
- * AREA, SO THAT IT WILL BE POSSIBLE TO EASILY ACCESS ALL ITS 00083000
- * FIELDS. 00084000
- * 00085000
- * NEXT, THE MESSAGE HEADER IS CONSTRUCTED, IF 'DMSERR' (RATHER 00086000
- * THAN 'LINEDIT') WAS SPECIFIED. 00087000
- * 00088000
- * THEN, THE MESSAGE TEXT IS SCANNED, BYTE BY BYTE. WHENEVER TWO 00089000
- * OR MORE CONSECUTIVE DOTS ARE FOUND IN THE MESSAGE TEXT, AN 00090000
- * ARGUMENT IS TAKEN FROM THE 'SUBS' PARAMETER LIST, THE 00091000
- * APPROPRIATE CONVERSION IS PERFORMED, AND THE RESULT IS 00092000
- * SUBSTITUTED FOR THE DOTS INTO THE MESSAGE TEXT. 00093000
- * 00094000
- * NEXT, IF A 'BUFFA' BUFFER ADDRESS WAS SPECIFIED, THEN THE 00095000
- * RESULTING MESSAGE TEXT IS COPIED INTO THE SPECIFIED BUFFER. 00096000
- * 00097000
- * NEXT, THE 'DISP' FIELD IS EXAMINED, AND APPROPRIATE ACTION 00098000
- * IS TAKEN. FOR DISP=TYPE, DMSCWR IS CALLED. FOR 'DISP=PRINT', 00099000
- * PRINTR IS CALLED. FOR 'DISP=SIO', THE ROUTINE DOES ITS 00100000
- * OWN SIO TO THE CONSOLE. FOR 'DISP=CPCOMM', DMSCPF IS 00101000
- * CALLED. FOR 'DISP=NONE', NO ACTION IS PERFORMED. 00102000
- * 00103000
- * FINALLY, THE 'DIE' OPTION IS EXAMINED. IF 'DIE=YES' WAS 00104000
- * SPECIFIED, THEN A DISABLED WAIT STATE PSW IS CREATED, CON- 00105000
- * TAINING THE RETURN ADDRESS TO THE POINT WHERE DMSERR WAS 00106000
- * CALLED. ALL REGISTERS ARE RESTORED, AND THE DISABLED WAIT 00107000
- * STATE PSW IS LOADED. 00108000
- * 00109000
- * IF 'DIE=NO' (THE DEFAULT) WAS SPECIFIED, 00110000
- * THEN A NORMAL RETURN IS MADE. 00111000
- * P3071 00112000
- *. P3071 00113000
- EJECT P3071 00114000
- DMSERR CSECT P3071 00115000
- PUNCH ' LIBRARY *(DMSCWR,DMSCWRE,PRINTR,DMSCWT)' 00116000
- * REGEQU 00117000
- R0 EQU 0 00118000
- R1 EQU 1 00119000
- R2 EQU 2 00120000
- R3 EQU 3 00121000
- R4 EQU 4 00122000
- R5 EQU 5 00123000
- R6 EQU 6 00124000
- R7 EQU 7 00125000
- R8 EQU 8 00126000
- R9 EQU 9 00127000
- R10 EQU 10 00128000
- R11 EQU 11 00129000
- R12 EQU 12 00130000
- R13 EQU 13 00131000
- R14 EQU 14 00132000
- R15 EQU 15 00133000
- SPACE 5 00134000
- TR EQU R3 POINTER TO DMSERS (ERDSECT) 00135000
- IR EQU R4 'FROM' POINTER FOR TEXT 00136000
- ER EQU R5 'END' POINTER FOR TEXT 00137000
- OR EQU R6 'TO' PTR FOR TEXT 00138000
- DR EQU R7 COUNT # DOTS IN SUBSTITUTE FIELD 00139000
- LR EQU R8 COUNT LENGTH OF SUBSTITUTION 00140000
- XR EQU R9 SCRATCH REGISTER 00141000
- RR EQU R10 INTERNAL SUBR RETURN REG 00142000
- BR EQU R12 BASE REGISTER 00143000
- SPACE 5 00144000
- USING DMSERR,BR 00145000
- USING ERDSECT,TR 00146000
- USING NUCON,R0 00147000
- DMSERR CSECT 00148000
- USING *,R15 00149000
- L R15,=V(DMSERT) GET ADDRESS OF WORK AREA 00150000
- USING ERDSECT,R15 00151000
- STM R0,R14,ERSAVE SAVE REGISTERS IN WORK AREA 00152000
- LR TR,R15 TR IS NORMAL WORK AREA PTR 00153000
- BALR R15,0 GET ADDRESSABILITY 00154000
- USING *,R15 00155000
- L BR,=A(DMSERR) LOAD NORMAL BASE REGISTER 00156000
- DROP R15 00157000
- MVC ERSAVE+4*R15(4),=F'0' SET RETURN CODE TO 0 00158000
- * IN THE PLIST PASSED TO THIS ROUTINE, EVERYTHING IS PACKED TOGETHER, 00159000
- * AND, IN FACT, ANYTHING COULD BE ALMOST ANYWHERE. 00160000
- * IN THE FOLLOWING CODE WE RECONSTRUCT THE PLIST IN THE WORK AREA SO 00161000
- * THAT LATER WE WILL BE ABLE TO GET AT EVERYTHING EASILY. 00162000
- * AT THIS POINT, R1 POINTS TO THE PASSED PLIST. 00163000
- RP EQU * 00164000
- SPACE 00165000
- * IF THE PASSED PLIST BEGINS WITH 'DMSERR', THEN WE SKIP OVER THAT. 00166000
- CLC =CL8'DMSERR',0(R1) BEGINS WITH DMSERR? 00167000
- BNE *+8 SKIP IF NOT 00168000
- LA R1,8(,R1) SKIP OVER IT IF SO 00169000
- MVC ERPF1(2),0(R1) COPY TWO FLAG BYTES 00170000
- LA R1,2(,R1) AND SKIP OVER THEM 00171000
- SPACE 00172000
- TM ERPF1,ERF1TX IS TEXT ADDRESS IN PLIST? 00173000
- BNO RPTX GO IF NOT 00174000
- MVC ERPTXA+1(3),0(R1) COPY TEXT ADDRESS INTO WORK AREA 00175000
- LA R1,3(,R1) AND SKIP OVER IN PASSED PLIST 00176000
- RPTX EQU * 00177000
- SPACE 00178000
- TM ERPF1,ERF1HD IS HEADER IN PLIST? 00179000
- BNO RPHD GO IF NOT 00180000
- MVC ERPHDR,0(R1) COPY HEADER INTO WORK AREA 00181000
- LA R1,6(,R1) SKIP OVER IT IN PASSED PLIST 00182000
- RPHD EQU * 00183000
- SPACE 00184000
- TM ERPF1,ERF1BF 'BUFFA' BUFFER ADDR IN PLIST? 00185000
- BNO RPBF GO IF NOT 00186000
- MVC ERPBFA+1(3),0(R1) COPY BUFFER ADDRESS INTO WORK 00187000
- LA R1,3(,R1) AND SKIP OVER IT IN PASSED PLIST 00188000
- RPBF EQU * 00189000
- SPACE 00190000
- * AT THIS POINT, R1 POINTS TO THE FIRST (OR ONLY) SUBSTITUTION OPTION 00191000
- * BYTE. 00192000
- ST R1,ERPSBA POINTER TO FIRST SUB FLAG BYTE 00193000
- SPACE 2 00194000
- * IF THE TEXT WAS PART OF AN MF=I PLIST, THEN IT FOLLOWS THE END OF THE 00195000
- * PLIST SO FAR. WE MUST LOOP THROUGH ALL THE SUBSTITUTION PARAMETERS 00196000
- * UNTIL WE GET TO THE END OF THEM. THAT IS WHERE THE TEXT IS. 00197000
- * AT THIS POINT, R1 POINTS TO THE FIRST SUBSTITUTION OPTION BYTE, IF 00198000
- * ANY. 00199000
- TM ERPF1,ERF1TX WAS TEXT ADDR IN PLIST? 00200000
- BO RPTE NOTHING TO DO -- ALREADY SET 00201000
- SPACE 00202000
- * IF THERE ARE NO SUBSTITUTIONS AT ALL, THEN R1 ALREADY POINTS TO THE 00203000
- * TEXT. 00204000
- TM ERPF1,ERF1SB1+ERF1SBN ANY SUBS? 00205000
- BZ RPTFF GO IF SO -- TEXT ADDR IS IN R1 00206000
- SPACE 00207000
- * IF THERE IS ONLY ONE SUBSTITUTION, THEN WE MUST ONLY SKIP ONE BYTE. 00208000
- TM ERPF1,ERF1SBN MULTIPLE SUBSTITUTIONS? 00209000
- BO RPTF GO IF YES 00210000
- LA R1,1(,R1) SKIP OVER LONE OPTION BYTE 00211000
- B RPTFF R1 -> TEXT 00212000
- SPACE 00213000
- * MULTIPLE SUBSTITUTIONS -- WE MUST SKIP OVER THEM. 00214000
- RPTF EQU * 00215000
- LR R15,R1 SAVE ADDRESS OF SUB OPTION BYTE 00216000
- LA R1,5(,R1) AND MAKE MOST PROBABLE SKIP 00217000
- SPACE 00218000
- * CUTE TRICK -- THE GROUP IS FOUR BYTES LONG IF THE FOLLOWING TEST 00219000
- * GIVES 'MIXED' -- ELSE IT'S FIVE BYTES. 00220000
- TM 0(R15),ERSFA+ERSFL TEST 'ADDR' AND 'LEN' FLAGS 00221000
- BNM *+6 SKIP IF 5 BYTES 00222000
- BCTR R1,0 DECREMENT TO SKIP ONLY 4 00223000
- TM 0(R15),ERSFLST WAS THIS THE LAST SUB? 00224000
- BNO RPTF LOOP BACK IF NOT 00225000
- SPACE 00226000
- * R1 PROBABLY NOW POINTS TO THE TEXT -- BUT IF MF=I AND RENT=NO WERE 00227000
- * SPECIFIED ALONG WITH MULTIPLE SUBSTITUTIONS, THEN THE PLIST MAY 00228000
- * BE PADDED WITH SOME ZEROES. WE SKIP OVER THESE. 00229000
- RPTFF EQU * 00230000
- CLI 0(R1),0 ARE WE POINTING TO A ZERO? 00231000
- LA R1,1(,R1) INCREMENT TO NEXT BYTE 00232000
- BE *-8 LOOP BACK 2 IF WE ARE 00233000
- BCTR R1,0 DECREMENT TO FIRST REAL BYTE 00234000
- SPACE 00235000
- * AT THIS POINT, R1 POINTS TO THE TEXT. 00236000
- ST R1,ERPTXA 00237000
- RPTE EQU * 00238000
- * THE MESSAGE HEADER HAS THE FORMAT: 'DMSXXXNNNL', WHERE XXX IS THE 00239000
- * CSECT NAME, NNN IS THE MESSAGE NUMBER, AND L IS THE MESSAGE LEVEL 00240000
- * LETTER. IF THE DMSERR (RATHER THAN THE LINEDIT) MACRO WAS USED, THEN 00241000
- * THE PASSED PLIST CONTAINS THE NECESSARY HEADER INFORMATION. 00242000
- TM ERPF1,ERF1HD WAS A MESSAGE HEADER PASSED? 00243000
- BNO HDX NOTHING TO DO IF NOT 00244000
- SPACE 00245000
- * CREATE ERROR MESSAGE HEADER 00246000
- SPACE 00247000
- * FIRST, CONVERT ERROR MESSAGE NUMBER TO BCD. 00248000
- MVC ERNUM-1(4),=X'F0202120' STORE EDIT PATTERN 00249000
- LH R1,ERPNUM GET ERROR MESSAGE NUMBER 00250000
- CVD R1,ERT1 CONVERT TO DECIMAL 00251000
- ED ERNUM-1(4),ERT1+6 CONVERT TO BCD 00252000
- SPACE 00253000
- MVC ERMESS,=C'DMS' FIRST 3 LETTERS ARE DMS 00254000
- MVC ERSECT,ERPCS COPY CSECT NAME 00255000
- MVC ERLET,ERPLET COPY MESSAGE LEVEL LETTER 00256000
- MVI ERBL,C' ' SET BLANK FIELD 00257000
- HDX EQU * 00258000
- * WE COPY THE UNSCANNED MESSAGE TEXT INTO OUR MESSAGE AREA. 00259000
- L R1,ERPTXA GET ADDRESS OF MESSAGE TEXT 00260000
- SR ER,ER 00261000
- IC ER,0(R1) ER <- LENGTH OF MESSAGE TEXT 00262000
- CH ER,=AL2(ERTSIZE) COMPARE WITH SIZE OF OUR TEXT *00263000
- BUFFER 00264000
- BL *+8 SKIP IF LOWER 00265000
- LA ER,ERTSIZE TRUNCATE IF TOO LARGE 00266000
- BCTR ER,0 ER <- (TEXT LENGTH)-1 00267000
- LTR ER,ER ANYTHING LEFT? 00268000
- BNM *+6 SKIP IF YES 00269000
- SR ER,ER OTHERWISE USE 1 CHAR 00270000
- SPACE 00271000
- B *+10 SKIP OVER MVC 00272000
- MVC ERTEXT(0),1(R1) LENGTH FILLED IN BY EX 00273000
- EX ER,*-6 COPY TEXT 00274000
- SPACE 00275000
- * INITIALIZE SCAN POINTERS 00276000
- LA ER,ERTEXT(ER) ER -> LAST BYTE OF TEXT 00277000
- LA OR,ERTEXT-1 'TO' POINTER 00278000
- LR IR,OR 'FROM' POINTER 00279000
- SPACE 00280000
- * THE REGISTER DR CONTAINS THE LENGTH OF THE FIELD BEING SUBBED 00281000
- * INTO. WE MAKE IT NEGATIVE NOW. 00282000
- SR DR,DR 00283000
- BCTR DR,0 DR <- -1 00284000
- * WHEN CONTROL REACHES THIS POINT, THE REGISTERS ARE SET AS FOLLOWS: 00285000
- SPACE 00286000
- * OR POINTS TO THE PLACE WHERE THE LAST MESSAGE CHARACTER WAS 00287000
- * COPIED TO. 00288000
- * IR POINTS TO THE PLACE WHERE THE LAST MESSAGE CHARACTER WAS 00289000
- * COPIED FROM. 00290000
- SPACE 00291000
- * INITIALLY, BOTH IR AND OR (INPUT REGISTER AND OUTPUT REGISTER) 00292000
- * POINT TO THE SAME PLACE. THE BASIC LOOP MOVES 1 CHARACTER AT A TIME 00293000
- * FROM THE INPUT TO THE OUTPUT. BUT INITIALLY, THESE ARE IN THE SAME 00294000
- * PLACE, SO THAT THE MOVE HAS NO EFFECT. IN FACT, IF THE MESSAGE 00295000
- * CONTAINS NO MULTIPLE BLANKS, AND NO SUBSTITUTIONS, THEN THIS SCAN 00296000
- * WILL HAVE NO EFFECT WHATSOEVER. 00297000
- * HOWEVER, IF MULTIPLE BLANKS ARE DISCOVERED, THEN THOSE AFTER THE 00298000
- * FIRST WILL NOT BE COPIED, SO THAT IR WILL START TO MOVE AHEAD OF 00299000
- * OR, AND GENUINE DATA MOVEMENT WILL TAKE PLACE. 00300000
- SPACE 00301000
- * WHEN CONSECUTIVE DOTS ARE DISCOVERED IN THE MESSAGE TEXT, AND A 00302000
- * SUBSTITUTION CAN BE MADE, IT PROCEEDS AS FOLLOWS: 00303000
- * THE SUBSTITUTION IS MADE, OVERLAYING THE DOTS IN THE INPUT AREA. 00304000
- * THEN, AFTER THE SUBSTITUTION HAS BEEN MADE, THE BASIC LOOP (AT ERLUP) 00305000
- * IS RE-ENTERED, WITH IR AND OR UNCHANGED. THIS WILL CAUSE THE 00306000
- * NEWLY SUBSTITUTED FIELD TO BE COPIED FROM THE INPUT AREA TO THE 00307000
- * OUTPUT AREA, WITH BLANKS ELIMINATED. 00308000
- SPACE 00309000
- * THE REGISTER DR IS USED TO PREVENT A RECURSION LOOP. THAT IS, 00310000
- * IF THE 'CHAR' OPTION IS USED IN A SUBSTITUTION, THERE IS NOTHING 00311000
- * TO PREVENT THE SUBSTITUTED STRING FROM CONTAINING DOTS. THIS 00312000
- * WOULD MEAN THAT ANOTHER SUBSTITUTION WOULD BE MADE INTO THE 00313000
- * SUBSTITUTED FIELD. WE PREVENT THIS AS FOLLOWS: 00314000
- * WHEN A SUBSTITUTION IS MADE, REGISTER DR IS SET TO THE LENGTH OF 00315000
- * THE DOT FIELD, LESS 1. THAT NUMBER IS LEFT IN THERE WHEN CONTROL 00316000
- * IS RETURNED TO ERLUP. THUS, AS EACH CHARACTER IN THE INPUT FIELD 00317000
- * IS SCANNED, WE REDUCE REGISTER DR BY 1. IF CONSECUTIVE DOTS 00318000
- * ARE FOUND, THEY WILL BE IGNORED IF REGISTER DR IS NONNEGATIVE. 00319000
- * (FOR THIS REASON, DR IS INITIALIZED TO -1, ABOVE.) 00320000
- SPACE 00321000
- * FINALLY, WE NOTE HERE THAT REGISTER ER HAS BEEN SET TO THE LAST 00322000
- * CHARACTER OF THE INPUT AREA, SO THAT IT WILL BE POSSIBLE TO KNOW 00323000
- * WHEN TO STOP. 00324000
- TM ERPF2,ERF2CM IS BLANK COMPRESSION WANTED? @VA02528 00325000
- BZ ERLUP YES @VA02528 00326000
- TM ERPF2,ERF2PR PRINT OPTION ON? @VA02528 00327000
- BZ ERLUP NO @VA02528 00328000
- TM ERPF2,X'01' ARE YOU SURE? @VA02528 00329000
- BO ERLUP NOPE, NOT ON @VA02528 00330000
- LA IR,1(,IR) SKIP TO CARRIAGE CONTROL @VA02528 00331000
- CLI 0(IR),C'.' IS IT A DOT? @VA02528 00332000
- BE DECRE YES, CONTINUE NORMALLY @VA02528 00333000
- LA OR,1(,OR) SKIP TO CARRIAGE CONTROL @VA02528 00334000
- ERLUPX LA IR,1(,IR) INCREMENT FOR CHECK @VA02528 00335000
- CLI 0(IR),X'40' IS IT BLANK? @VA02528 00336000
- BE ERLUPX YES, CHECK NEXT POSITION @VA02528 00337000
- DECRE BCTR IR,0 GET PREVIOUS POSITION @VA02528 00338000
- SPACE 2 00339000
- ERLUP EQU * 00340000
- CR IR,ER END OF STRING? 00341000
- BNL ND END OF SCAN -- GO TYPE 00342000
- LA IR,1(,IR) INCREMENT INPUT POINTER 00343000
- BCTR DR,0 DECREMENT SCANNED FIELD LENGTH 00344000
- CLI 0(IR),C' ' IS THE INPUT CHAR A BLANK? 00345000
- BNE ERLUP1 SKIP CHECK IF NOT 00346000
- TM ERPF2,ERF2CM IS BLANK COMPRESSION WANTED? 00347000
- BZ ERLUP2 SIMPLY COPY THE BLANK IF NOT 00348000
- * WE MUST BE CAREFUL TO OMIT THE TERMINATING BLANKS OF A 00349000
- * SUBSTITUTION FIELD. DR CONTAINS THE NUMBER OF CHARACTERS AFTER 00350000
- * THIS ONE, REMAINING IN THE LAST SUBSTITUTION FIELD. 00351000
- LTR DR,DR ARE WE IN SUBSTITUTION FIELD? 00352000
- BZ ERLUP SKIP BLK IF AT END OF SUB FIELD 00353000
- BM BL1 GO IF NOT INSIDE SUB FIELD 00354000
- CLI 1(IR),C' ' IS NEXT CHAR IN SUB FIELD ALSO *00355000
- A BLANK? 00356000
- BNE ERLUP2 COPY BLANK IF NOT 00357000
- B ERLUP SKIP THIS BLANK IF SO 00358000
- SPACE 00359000
- * COME HERE IF WE ARE NOT INSIDE A SUBSTITUTION FIELD. 00360000
- BL1 EQU * 00361000
- CLI 0(OR),C' ' WAS LAST OUTPUT CHARACTER BLANK? 00362000
- BE ERLUP SKIP THIS BLANK IF SO 00363000
- B ERLUP2 COPY BLANK IF NOT 00364000
- SPACE 00365000
- ERLUP1 EQU * 00366000
- CLI 0(IR),C'.' IS INPUT CHAR A DOT? 00367000
- BNE ERLUP2 GO COPY IF NOT 00368000
- CR IR,ER IS IT LAST CHAR OF LINE? 00369000
- BE ERLUP2 COPY DOT IF SO 00370000
- LTR DR,DR ARE WE RE-SCANNING INPUT FIELD? 00371000
- BNM ERLUP2 COPY DOT IF WE ARE 00372000
- TM ERPF1,ERF1SB1+ERF1SBN ANY SUB PARMS (LEFT)? 00373000
- BZ ERLUP2 COPY DOT IF NOT 00374000
- CLI 1(IR),C'.' IS NEXT CHAR ALSO A DOT? 00375000
- BNE ERLUP2 COPY DOT IF NOT 00376000
- BCTR IR,0 POINT TO CHAR PRECEDING DOTS 00377000
- B ERDOTS GO PERFORM SUBSTITUTION 00378000
- SPACE 00379000
- * WHEN CONTROL REACHES THIS POINT, WE HAVE NOTHING TO DO BUT COPY OVER 00380000
- * THE CHARACTER AND RETURN TO THE MAIN LOOP. 00381000
- ERLUP2 EQU * 00382000
- LA OR,1(,OR) INCREMENT OUTPUT POINTER 00383000
- MVC 0(1,OR),0(IR) COPY OVER THE CHARACTER 00384000
- B ERLUP RETURN TO MAIN LOOP 00385000
- * AT THIS POINT, REGISTER IR, THE 'INPUT' REGISTER, POINTS TO THE 00386000
- * CHARACTER PRECEDING THE FIELD OF DOTS. 00387000
- ERDOTS EQU * 00388000
- SR DR,DR NUMBER OF DOTS SO FAR 00389000
- LR R1,IR R1 -> CHAR PRECEDING DOTS 00390000
- SPACE 00391000
- * IN THE FOLLOWING LOOP, WE COUNT THE NUMBER OF DOTS IN THE FIELD, 00392000
- * AND, AT THE SAME TIME, WE CHANGE EACH DOT TO A BLANK. 00393000
- ERDT1 EQU * 00394000
- LA R1,1(,R1) INCREASE TEXT POINTER 00395000
- CLI 0(R1),C'.' IS IT A DOT? 00396000
- BNE ERDT2 NO -- WE'RE THROUGH COUNTING 00397000
- CR R1,ER HAVE WE REACHED END OF TEXT? 00398000
- BH ERDT2 YES -- WE'RE THROUGH COUNTING 00399000
- SPACE 00400000
- MVI 0(R1),C' ' OTHERWISE, CHANGE DOT TO BLANK 00401000
- LA DR,1(,DR) INCREASE DOT COUNT 00402000
- B ERDT1 AND LOOP BACK TO CONTINUE COUNT 00403000
- SPACE 00404000
- * COME HERE AT END OF DOTS 00405000
- ERDT2 EQU * 00406000
- BCTR DR,0 00407000
- SPACE 00408000
- * REGISTERS AT THIS POINT ARE: 00409000
- * IR POINTS TO THE CHARACTER PRECEDING THE SUBSTITUTION FIELD. 00410000
- * DR CONTAINS (THE LENGTH OF THE FIELD)-1. 00411000
- SPACE 00412000
- ST DR,ERSSZ SAVE SUBSTITUTION FIELD SIZE 00413000
- SPACE 00414000
- TM ERPF1,ERF1SBN ONE SUBSTITUTION? 00415000
- BO SM GO HANDLE MULTIPLE SUB SITUATION 00416000
- SPACE 00417000
- * OTHERWISE, THERE IS ONLY ONE SUBSTITUTION, AND THE DATA IS IN REG 0. 00418000
- MVC ERSBD,ERSAVE+4*R0 COPY R0 FROM SAVE AREA 00419000
- L R1,ERPSBA POINT TO OPTION BYTE IN PLIST 00420000
- MVC ERSBF,0(R1) COPY OPTION BYTE INTO WORK AREA 00421000
- MVC ERSBL,ERSBD COPY LENGTH BYTE PASSED, IF ANY 00422000
- B SSC GO HANDLE SUBSTITUTION 00423000
- SPACE 00424000
- * COME HERE IF THIS IS ONE OF MULTIPLE SUBSTITUTIONS. THE SUBSTITUTION 00425000
- * INFORMATION IS PACKED TOGETHER AT THE END OF THE PLIST, AND ERPSBA IN 00426000
- * OUR WORK AREA POINTS TO THE INFORMATION FOR THE CURRENT ONE. 00427000
- * THIS INFORMATION AREA CAN HAVE THREE FORMATS, INDICATED BY THE OPTION 00428000
- * BYTE, WHICH IS ALWAYS THE FIRST BYTE OF THE GROUP (FOR THE FLAG 00429000
- * DEFINITIONS FOR THIS OPTION BYTE, SEE FLAGS DEFINITIONS UNDER ERSBF 00430000
- * IN WORK AREA). 00431000
- SPACE 00432000
- * THE FORMATS ARE AS FOLLOWS: 00433000
- SPACE 00434000
- * IF NEITHER ERSFA NOR ERSFL IS ON, THEN WE ARE BEING PASSED FOUR BYTES 00435000
- * OF DATA IN THE FORM, 00436000
- * (1 BYTE OPTION BYTE) (4 BYTES OF DATA) 00437000
- SPACE 00438000
- * IF JUST ERSFA IS ON, THEN WE ARE BEING PASSED THE ADDRESS OF 00439000
- * THE DATA, WITH NO LENGTH SPECIFIED, IN THE FOLLOWING FORMAT: 00440000
- * (1 BYTE OPTION BYTE) (3 BYTE ADDRESS) 00441000
- SPACE 00442000
- * IF BOTH ERSFA AND ERSFL ARE ON, THEN WE ARE BEING PASSED AN ADDRESS 00443000
- * AND LENGTH, IN THE FOLLOWING FORMAT: 00444000
- * (1 BYTE OPTION BYTE) (1 BYTE LENGTH FIELD) (3 BYTE ADDRESS) 00445000
- SPACE 00446000
- * IT IS IMPOSSIBLE FOR ERSFL TO BE ON WITH ERSFA OFF. 00447000
- SPACE 00448000
- * IN ORDER TO SIMPLIFY THINGS, WE COPY THE INFORMATION INTO FIELDS OF 00449000
- * OUR WORK AREA, SO THAT THE INDIVIDUAL SUBSTITUTION ROUTINES WILL 00450000
- * NOT HAVE ANY TROUBLE FINDING THINGS. 00451000
- SM EQU * 00452000
- L R1,ERPSBA POINT TO SUBSTITUTION PARMS 00453000
- MVC ERSBF,0(R1) COPY OPTION BYTE TO WORK AREA 00454000
- MVC ERSBD,1(R1) COPY DATA VALUE OR ADDRESS 00455000
- MVC ERSBL,1(R1) COPY LENGTH FIELD, IF ANY 00456000
- TM ERSBF,ERSFA+ERSFL TEST BOTH FLAGS SIMULTANEOUSLY 00457000
- SPACE 00458000
- * IF 'MIXED', THEN WE HAVE THE ONLY POSSIBLE CASE OF A FOUR-BYTE FIELD 00459000
- * (OTHER CASES HAVE 5-BYTE FIELDS). 00460000
- BNM *+12 SKIP 2 INSTRUCTIONS IF NOT MIXED 00461000
- MVC ERSBD,0(R1) COPY DATA ADDRESS CORRECTLY 00462000
- BCTR R1,0 DECREMENT SO SKIP ONLY FOUR 00463000
- LA R1,5(,R1) SKIP FIVE BYTES 00464000
- ST R1,ERPSBA POINTER TO NEXT SUBSTITUTION FLD 00465000
- SPACE 00466000
- * WHEN CONTROL REACHES THIS POINT, THE SUBSTITUTION INFORMATION HAS 00467000
- * BEEN COPIED INTO THE VARIOUS FIELDS OF THE WORK AREA, AND WE CAN GO 00468000
- * TO WORK. 00469000
- SSC EQU * 00470000
- TM ERSBF,ERSFLST IS THIS THE LAST SUBSTITUTION *00471000
- PARAMETER FIELD? 00472000
- BNO *+8 SKIP IF NOT 00473000
- NI ERPF1,X'FF'-(ERF1SB1+ERF1SBN) TURN OFF SUBSTITUTIONS *00474000
- FLAGS, TO PREVENT FURTHER ONES 00475000
- SPACE 00476000
- * SO ALL POINTERS ARE NOW SET UP, AND THE REGISTERS ARE AS FOLLOWS: 00477000
- * IR -> CHARACTER PRECEDING THE SUBSTITUTION FIELD 00478000
- * DR CONTAINS THE (LENGTH OF THE SUBSTITUTION FIELD) - 1, WHICH EQUALS 00479000
- * THE (NUMBER OF DOTS IN THE FIELD) - 1. 00480000
- IC R1,ERSBF GET OPTION BYTE FROM WORK AREA 00481000
- N R1,=AL1(0,0,0,7) GET LAST THREE BITS 00482000
- AR R1,R1 MULTIPLY BY FOUR 00483000
- AR R1,R1 00484000
- B *+4(R1) BRANCH BASED ON OPTION 00485000
- B SH HEX OR HEXA 00486000
- B SD DEC OR DECA 00487000
- B SC CHARA 00488000
- B SH4 HEX4A 00489000
- B SC8 CHAR8A 00490000
- B SSTAR ILLEGAL 00491000
- B SSTAR ILLEGAL 00492000
- B SSTAR ILLEGAL 00493000
- SPACE 3 00494000
- * ILLEGAL ARGUMENT -- JUST PUT TWO DOTS INTO FIELD. 00495000
- SSTAR EQU * 00496000
- MVC 0(2,IR),=C'**' 00497000
- B SEND GO FINISH UP SUBSTITUTION 00498000
- EJECT 00499000
- * CHAR OPTION -- MAKE A CHARACTER SUBSTITUTION. 00500000
- SC EQU * 00501000
- SR R1,R1 00502000
- IC R1,ERSBL GET SPECIFIED LENGTH, IF ANY 00503000
- BCTR R1,0 DECREMENT BY 1 00504000
- TM ERSBF,ERSFL WAS A LENGTH SPECIFIED? 00505000
- BO *+6 SKIP IF SO 00506000
- LR R1,DR OTHERWISE, USE NUMBER OF DOTS 00507000
- SPACE 00508000
- * AT THIS POINT, R1 CONTAINS EITHER THE LENGTH SPECIFIED BY THE USER 00509000
- * (MINUS 1) OR, IF NONE WAS SPECIFIED, THE CONTENTS OF DR, WHICH 00510000
- * CONTAINS ONE LESS THAN THE NUMBER OF DOTS IN THE FIELD. 00511000
- * WE NOW TAKE THE MINIMUM OF DR AND R1, AND THAT IS THE LENGTH OF THE 00512000
- * SUBSTITUTION TO BE MADE. 00513000
- LTR R1,R1 WAS SPECIFIED LENGTH = 0? 00514000
- BM SEND NOTHING TO DO IF IT WAS 00515000
- CLR R1,DR TAKE MINIMUM 00516000
- BNL *+6 SKIP IF SPECIFIED LEN HIGHER 00517000
- LR DR,R1 IF LESS, USE SPECIFIED LENGTH 00518000
- SPACE 00519000
- * DR NOW CONTAINS ONE LESS THAN THE NUMBER OF CHARACTERS TO BE COPIED 00520000
- * OVER. 00521000
- L R1,ERSBD GET DATA POINTER 00522000
- B *+10 SKIP OVER MVC 00523000
- MVC 1(,IR),0(R1) LENGTH FILLED IN BY EX 00524000
- EX DR,*-6 MOVE DATA INTO MESSAGE AREA 00525000
- B SEND GO FINISH UP SUBSTITUTION 00526000
- EJECT 00527000
- * CHAR8 OPTION -- MAKE A CHARACTER SUBSTITUTION, BUT STORE A BLANK 00528000
- * AFTER EVERY EIGHTH CHARACTER. 00529000
- SC8 EQU * 00530000
- TM ERSBF,ERSFL WAS A LENGTH SPECIFIED? 00531000
- BNO SC8A SKIP COMPUTATION IF NOT 00532000
- SPACE 00533000
- * OTHERWISE, THE MACRO SPECIFIED A LENGTH, IN BYTES, OF THE INPUT FIELD 00534000
- * TO BE COPIED. WE MUST DETERMINE HOW MANY BYTES THE SPECIFIED LENGTH 00535000
- * WILL REQUIRE IN THE MESSAGE TEXT. IT WILL BE APPROXIMATELY 9/8 AS 00536000
- * BIG TO ACCOMODATE THE BLANK AT THE END OF EACH EIGHTH CHARACTER. 00537000
- * THE EXACT FORMULA IS: 00538000
- * REQUIRED LENGTH = (L-1)/8*9 + MOD(L-1,8) + 1, 00539000
- * WHERE L IS THE LENGTH SPECIFIED BY THE USER. 00540000
- * WE PERFORM THIS COMPUTATION BELOW, EXCEPT THAT WE DO NOT BOTHER TO 00541000
- * ADD IN THE '+1' OF THE FORMULA, SINCE WE WANT THE (LENGTH - 1), 00542000
- * ANYWAY. 00543000
- SLR R0,R0 00544000
- SLR R1,R1 00545000
- IC R1,ERSBL GET LENGTH SPECIFIED BY MACRO 00546000
- BCTR R1,0 TAKE (L-1) 00547000
- LTR R1,R1 IS IT NEGATIVE? 00548000
- BM SEND HE SPECIFIED 0 LENGTH -- THAT *00549000
- MEANS NOTHING TO DO 00550000
- SPACE 00551000
- * THE R0-R1 REGISTER PAIR CONTAINS (L-1). WE DIVIDE BY 8, TO PUT 00552000
- * (L-1)/8 INTO REGISTER 1, AND MOD (L-1,8) INTO R0. 00553000
- D R0,=F'8' DIVIDE BY 8 00554000
- MH R1,=H'9' COMPUTE (L-1)/8*9 00555000
- AR R1,R0 (L-1)/8*9 + MOD(L-1,8) 00556000
- SPACE 00557000
- * REGISTER 1 NOW CONTAINS ONE LESS THAN THE NUMBER OF BYTES NECESSARY 00558000
- * TO COMPLY WITH THE USER'S LENGTH REQUEST. DR CONTAINS ONE LESS THAN 00559000
- * THE AVAILABLE FIELD SIZE (NUMBER OF DOTS). WE COMPARE THE TWO, AND 00560000
- * TAKE THE MINIMUM. 00561000
- CLR R1,DR COMPARE THE TWO 00562000
- BNL *+6 00563000
- LR DR,R1 TAKE THE MINIMUM 00564000
- SPACE 00565000
- * WE NOW PERFORM A LOOP WHICH COPIES 8 CHARACTERS AT A TIME, PUTTING 00566000
- * A SPACE AFTER EACH ONE, UNTIL THE FIELD IS EXHAUSTED. 00567000
- SC8A EQU * 00568000
- LA XR,1(,DR) XR <- EXACT FIELD LENGTH 00569000
- LR R14,IR R14 -> TARGET AREA 00570000
- L R15,ERSBD R15 -> SOURCE DATA AREA 00571000
- SPACE 00572000
- * LOOP BACK TO THIS POINT TO COPY THE NEXT EIGHT CHARACTERS. 00573000
- SC8B EQU * 00574000
- LR R1,XR COPY LENGTH REMAINING 00575000
- CH R1,=H'8' AT LEAST 8 CHARS LEFT? 00576000
- BL *+8 SKIP IF NOT 00577000
- LA R1,8 IF SO, COPY ONLY 8 CHARACTERS 00578000
- BCTR R1,0 DECREMENT FOR EX 00579000
- B *+10 SKIP OVER MVC 00580000
- MVC 1(,R14),0(R15) LENGTH FILLED IN BY EX 00581000
- EX R1,*-6 MOVE UP TO EIGHT BYTES OF DATA 00582000
- LA R14,9(,R14) INCREMENT TARGET POINTER, *00583000
- SKIPPING OVER AN EXTRA BLANK 00584000
- LA R15,8(,R15) SKIP OVER SOURCE 00585000
- SH XR,=H'9' COMPUTE REMAINING TARGET AREA 00586000
- BP SC8B LOOP BACK IF ANYTHING LEFT 00587000
- B SEND GO FINISH UP SUBSTITUTION 00588000
- EJECT 00589000
- * HEX AND HEXA OPTIONS -- PERFORM A HEXADECIMAL SUBSTITUTION. 00590000
- SPACE 00591000
- * SEE DISCUSSION BELOW UNDER 'HEX4A' OPTION FOR EXPLANATION OF WHY 00592000
- * A LENGTH IS NOT ALLOWED WITH THE 'HEXA' OPTION. 00593000
- SH EQU * 00594000
- TM ERSBF,ERSFA WAS AN ADDRESS SPECIFIED? 00595000
- L R1,ERSBD LOAD THIS ADDRESS, IF SO 00596000
- BZ *+10 SKIP IF DATA VALUE WAS SPECIFIED 00597000
- MVC ERSBD,0(R1) COPY DATA INTO ERSBD 00598000
- SPACE 00599000
- * IN EITHER CASE, ERSBD NOW CONTAINS THE FOUR BYTES OF DATA. 00600000
- CH DR,=H'7' MAXIMUM LENGTH IS 8 00601000
- BL *+8 LONGER THAN 8? 00602000
- LA DR,7 ALLOW ONLY 8 CHARS 00603000
- SPACE 00604000
- * CONVERT NUMBER TO BCD HEX 00605000
- UNPK ERT2(9),ERSBD(5) UNPACK IT 00606000
- TR ERT2(8),TRTBL TRANSLATE IT 00607000
- SPACE 00608000
- * COPY ONLY THE LAST K CHARACTERS, WHERE K IS THE LENGTH OF THE FIELD. 00609000
- LA R1,ERT2+7 POINT TO END OF STRING 00610000
- SR R1,DR SUBTRACT NUMBER OF CHARS 00611000
- B *+10 SKIP OVER MVC 00612000
- MVC 1(0,IR),0(R1) LENGTH FILLED IN BY MVC 00613000
- EX DR,*-6 COPY STRING 00614000
- B SEND GO FINISH UP SUBSTITUTION 00615000
- SPACE 00616000
- TRTBL EQU *-C'0' DISPLACE TRANSLATE TABLE BACK 00617000
- DC C'0123456789ABCDEF' TRANSLATE TABLE 00618000
- EJECT 00619000
- * HEX4A OPTION. COVERT THE SOURCE DATA FIELD INTO GRAPHIC 00620000
- * HEXADECIMAL, INSERTING A BLANK ON THE LINE AFTER EACH FOUR BYTES 00621000
- * OF INPUT ( FOUR BYTES OF OUTPUT). 00622000
- * NOTICE THAT THIS OPTION (HEX4A) IS DIFFERENT FROM THE HEX OPTION, 00623000
- * EVEN FOR VERY SHORT SUBSTITUTIONS -- UNDER FOUR CHARACTERS. 00624000
- * THE DIFFERENCE IS THAT YOU ALWAYS SPECIFIED FOUR BYTES OF DATA WITH 00625000
- * THE HEX OPTION, AND IF THE FIELD CONTAINS LESS THAN EIGHT BYTES, 00626000
- * YOU TRUNCATE FROM THE LEFT, KEEPING LOW-ORDER DIGITS IN THE FINAL 00627000
- * TEXT. IN THE CASE OF THE HEX4A OPTION, YOU TRUNCATE FROM THE RIGHT. 00628000
- * IN FACT, IT WAS THIS CONFUSION THAT CASUED ME NOT EVEN TO ALLOW A 00629000
- * LENGTH OT BE SPECIFIED WITH THE 'HEXA' OPTION. 00630000
- SH4 EQU * 00631000
- TM ERSBF,ERSFL DID THE USER SPECIFY A LENGTH? 00632000
- BNO SH4A GO IF HE DID NOT 00633000
- SPACE 00634000
- * IF THE USER SPECIFIED A LENGTH, IT IS THE LENGTH OF THE SOURCE FIELD, 00635000
- * WHICH IS TO BE CONVERTED. WE MUST COMPUTE THE FIELD SIZE WHICH HE 00636000
- * WILL REQUIRE FOR HIS INPUT LENGTH. THIS WILL BE APPROXIMATELY 00637000
- * 9/4'THS OF THE INPUT LENGTH. THE EXACT FORMULA IS: 00638000
- * REQUIRED LENGTH = (L-1)/4*9 + 2*MOD(L-1,4) + 2 00639000
- * WE COMPUTE THIS FORMULA BELOW, EXCEPT THAT WE ADD IN '+1' RATHER THAN 00640000
- * '+2', SINCE WE ARE INTERESTED IN THE LENGTH-1, TO COMPARE WITH 00641000
- * REGISTER DR. 00642000
- SLR R0,R0 00643000
- SLR R1,R1 00644000
- IC R1,ERSBL GET SPECIFIED LENGTH 00645000
- BCTR R1,0 R1 <- (L-1) 00646000
- LTR R1,R1 WAS LENGTH = 0? 00647000
- BM SEND NOTHING TO DO IF SO 00648000
- SPACE 00649000
- * WE DIVIDE (L-1) BY 4. THE QUOTIENT IS IN REG 1, AND THE 00650000
- * REMAINDER (MOD(L-1,4)) IS IN REG 0. 00651000
- D R0,=F'4' DIVIDE BY 4 00652000
- MH R1,=H'9' R1 <- (L-1)/4*9 00653000
- AR R0,R0 R0 <- 2*MOD(L-1,4) 00654000
- AR R1,R0 R1 <- (L-1)/4*9 + 2*MOD(L-1,4) 00655000
- LA R1,1(,R1) ADD AN EXTRA 1 00656000
- SPACE 00657000
- * R1 CONTAINS THE (NEEDED FIELD LENGTH) - 1 00658000
- CLR R1,DR TAKE MINIMUM OF THE TWO 00659000
- BNL *+6 00660000
- LR DR,R1 00661000
- SPACE 00662000
- * WE NOW CONVERT 4 BYTES AT A TIME OF THE SOURCE INTO EIGHT CHARACTERS, 00663000
- * AND INSERT THEM INTO THE MESSAGE AREA, PUTTING A BLANK AT THE END 00664000
- * OF EACH GROUP. 00665000
- SH4A EQU * 00666000
- LA XR,1(,DR) XR CONTAINS REAL FIELD SIZE 00667000
- LR R14,IR R14 -> TARGET AREA 00668000
- L R15,ERSBD R15 -> SOURCE AREA 00669000
- SPACE 00670000
- * LOOP BACK TO THIS POINT EACH TIME TO CONVERT FOUR MORE BYTES. 00671000
- SH4B EQU * 00672000
- LR R1,XR GET NUMBER OF BYTES REMAINING 00673000
- L R2,0(R15) GET DATA TO BE CONVERTED @VA02693 00674000
- ST R2,ERT1 PUT DATA INTO WORK AREA @VA02693 00675000
- UNPK ERT2(9),ERT1(5) CONVERT FOUR MORE BYTES @VA02693 00676000
- TR ERT2(8),TRTBL 00677000
- CH R1,=H'8' AT LEAST EIGHT BYTES LEFT? 00678000
- BL *+8 SKIP IF NOT 00679000
- LA R1,8 USE ONLY 8 CHARS IF MORE 00680000
- BCTR R1,0 DECREMENT FOR EX 00681000
- B *+10 SKIP OVER MVC 00682000
- MVC 1(,R14),ERT2 LENGTH FILLED IN BY EX 00683000
- EX R1,*-6 COPY DATA INTO MESSAGE AREA 00684000
- LA R14,9(,R14) SKIP OVER COPIED DATA AND BLANK 00685000
- LA R15,4(,R15) SKIP OVER SOURCE JUST CONVERTED 00686000
- SH XR,=H'9' COMPUTE NUMBER BYTES REMAINING 00687000
- BP SH4B GO IF SOMETHING LEFT 00688000
- B SEND OTHERWISE, FINISH UP SUB 00689000
- EJECT 00690000
- * DEC OR DECA OPTION. PERFORM A DECIMAL CONVERSION. 00691000
- SD EQU * 00692000
- L R1,ERSBD GET DATA ADDRESS, IF DECA 00693000
- TM ERSBF,ERSFA WAS IT DECA? 00694000
- BZ *+10 SKIP MVC IF NOT 00695000
- MVC ERSBD,0(R1) COPY DATA INTO ERSBD 00696000
- L R0,ERSBD R0 NOW CONTAINS THE VALUE TO *00697000
- BE CONVERTED. 00698000
- LTR XR,R0 GET NUMBER 00699000
- BNM ERDD1 GO IF NO MINUS SIGN 00700000
- SPACE 00701000
- * IF THE NUMBER IS NEGATIVE, WE INCREASE IR AND DECREASE DR, SO 00702000
- * THAT WE WILL HAVE ROOM FOR A MINUS SIGN. 00703000
- LA IR,1(,IR) INCREASE OUTPUT POINTER 00704000
- LPR R0,R0 MAKE NUMBER POSITIVE 00705000
- BCTR DR,0 DECREASE FIELD LENGTH BY 1 00706000
- SPACE 00707000
- * THE NUMBER IN R0 IS NOW POSITIVE. THE REAL NUMBER IS IN XR. 00708000
- ERDD1 EQU * 00709000
- CH DR,=H'14' BUFFER LENGTH EXCEED 15? 00710000
- BL *+8 SKIP IF NOT 00711000
- LA DR,14 15 IS THE MAXIMUM 00712000
- SPACE 00713000
- CVD R0,ERT1 CONVERT NUMBER TO DECIMAL 00714000
- MVC ERT2(16),ERDDED MOVE IN EDIT PATTERN 00715000
- ED ERT2(16),ERT1 CONVERT NUMBER TO BCD 00716000
- SPACE 00717000
- * COPY ONLY THE LAST K CHARACTERS, WHERE K IS THE LENGTH OF THE FIELD. 00718000
- LA R1,ERT2+15 POINT TO END OF STRING 00719000
- SR R1,DR SUBTRACT NUMBER OF CHARS 00720000
- B *+10 SKIP OVER MVC 00721000
- MVC 1(0,IR),0(R1) LENGTH FILLED IN BY EX 00722000
- EX DR,*-6 COPY BCD DECIMAL STRING 00723000
- SPACE 00724000
- * WE MUST RESET SOME POINTERS, IF THE ORIGINAL NUMBER WAS NEGATIVE. 00725000
- LTR XR,XR WAS NUMBER NEGATIVE? 00726000
- BNM SEND FINISH UP IF NOT 00727000
- BCTR IR,0 RESET FIELD POINTER 00728000
- LA DR,1(,DR) RESET FIELD LENGTH 00729000
- SPACE 00730000
- * WE SEARCH FOR THE FIRST NON-BLANK IN THE DECIMAL NUMBER, AND 00731000
- * INSERT A MINUS SIGN IN FRONT OF IT. 00732000
- LR R1,IR R1 -> BLANK BEFORE FIELD 00733000
- LA R1,1(,R1) INCREMENT CHAR POINTER 00734000
- CLI 0(R1),C' ' IS IT A BLANK 00735000
- BE *-8 LOOP BACK IF IT IS 00736000
- BCTR R1,0 POINT TO BLANK PRECEDING DIGIT 00737000
- MVI 0(R1),C'-' MOVE IN MINUS SIGN 00738000
- B SEND GO FINISH UP SUBSTITUTION 00739000
- SPACE 00740000
- ERDDED DC C' ',13X'20',X'2120' EDIT PATTERN 00741000
- EJECT 00742000
- * FINISH UP THE SUBSTITUTION. WE MUST SKIP ALL LEADING BLANKS IN 00743000
- * THE SUBSTITUTION FIELD (THE COPY LOOP WILL SKIP TERMINATING BLANKS). 00744000
- * OF COURSE WE DON'T DO THAT IF BLANK COMPRESSION IS NOT WANTED. 00745000
- SEND EQU * 00746000
- L DR,ERSSZ RESTORE SIZE OF SUB FIELD 00747000
- LA DR,1(,DR) DR <- # CHARS IN SUB FIELD 00748000
- TM ERPF2,ERF2CM BLANK COMPRESSION WANTED? 00749000
- BZ ERLUP GO IMMEDIATELY IF NOT 00750000
- SPACE 00751000
- * THE FOLLOWING LOOP SKIPS LEADING BLANKS. 00752000
- SEND1 EQU * 00753000
- CLI 1(IR),C' ' NEXT CHAR A BLANK? 00754000
- BNE ERLUP RE-ENTER SCAN LOOP IF NOT 00755000
- LA IR,1(,IR) SKIP OVER TO IT 00756000
- BCT DR,SEND1 LOOP BACK IF NOT END OF FIELD 00757000
- B ERLUP RE-ENTER SCAN LOOP 00758000
- * COME HERE ON END OF SCAN. 00759000
- ND EQU * 00760000
- TM ERPF2,ERF2DT DOES HE WANT A DOT? 00761000
- BZ NDD GO IF NOT 00762000
- TM ERPF2,ERF2CM DOES HE WANT BLANK COMPRESSION? 00763000
- BZ NB SKIP IF NOT 00764000
- CLI 0(OR),C' ' IS THERE A TERMINATING BLANK? 00765000
- BNE NB SKIP IF NOT 00766000
- BCTR OR,0 JUMP BACK IF SO 00767000
- SPACE 00768000
- NB EQU * 00769000
- CLI 0(OR),C'.' IS LAST CHAR ALREADY A DOT? 00770000
- BNE *+6 SKIP IF NOT 00771000
- BCTR OR,0 DON'T HAVE TWO, IF SO 00772000
- MVI 1(OR),C'.' INSERT A DOT 00773000
- LA OR,1(,OR) POINT TO LAST CHAR OF MESSAGE 00774000
- SPACE 00775000
- * AT THIS POINT, OR -> THE LAST CHAR OF THE MESSAGE. WE COMPUTE 00776000
- * MESSAGE LENGTH AND MESSAGE STARTING ADDRESS, AND STORE THEM INTO 00777000
- * THE 'TYPLIN' PLIST, FOR LACK OF A BETTER PLACE. 00778000
- NDD EQU * 00779000
- LA R1,ERMESS POINT TO START OF MESSAGE 00780000
- TM ERPF1,ERF1HD IS THERE A MESSAGE HEADER? 00781000
- BO *+8 SKIP IF SO 00782000
- LA R1,ERTEXT OTHERWISE, POINT TO TEXT AREA 00783000
- ST R1,ERTPLA STORE ADDRESS IN TYPLIN PLIST 00784000
- SR OR,R1 COMPUTE MESSAGE LENGTH 00785000
- LA OR,1(,OR) OR CONTAINS MESSAGE LENGTH 00786000
- ST OR,ERTPLL STORE LENGTH IN TYPLIN PLIST 00787000
- TM ERPF1,ERF1BF WAS 'BUFFA' SPECIFIED? 00788000
- BZ NU GO IF NOT 00789000
- SPACE 00790000
- * OTHERWISE, WE COPY THE MESSAGE TEXT INTO THE USER'S BUFFER AREA. 00791000
- L R1,ERTPLL GET MESSAGE LENGTH 00792000
- L R14,ERTPLA ADDRESS OF MESSAGE TEXT 00793000
- BCTR R14,0 POINT TO PRECEDING BYTE 00794000
- STC R1,0(R14) STORE LENGTH INTO PRECEDING BYTE 00795000
- L R15,ERPBFA POINT TO SPECIFIED BUFFER AREA 00796000
- B *+10 SKIP OVER MVC 00797000
- MVC 0(0,R15),0(R14) LENGTH FILLED IN BY EX 00798000
- EX R1,*-6 COPY OVER LENGTH AND MESSAGE 00799000
- SPACE 00800000
- NU EQU * 00801000
- SPACE 00802000
- * WE NOW BRANCH TO A SPECIAL ROUTINE DEPENDING ON WHAT THE MACRO 00803000
- * SPECIFIED IN THE 'DISP' FIELD. 00804000
- IC R1,ERPF2 GET DISP BYTE 00805000
- N R1,=AL1(0,0,0,7) GET LAST THREE BITS 00806000
- AR R1,R1 MULTIPLY BY 4 00807000
- AR R1,R1 00808000
- B *+4(R1) BRANCH TO SPECIALIZED ROUTINE 00809000
- B DER DISP=ERRMSG 00810000
- B DTY DISP=TYPE 00811000
- B DSI DISP=SIO 00812000
- B DNO DISP=NONE 00813000
- B DPR DISP=PRINT 00814000
- B DCP DISP=CPCOMM 00815000
- B DTY ILLEGAL 00816000
- B DTY ILLEGAL 00817000
- B DTY ILLEGAL 00818000
- EJECT 00819000
- * 'ERRMSG' OPTION. IN MOST CASES, WE WILL SET A SPECIAL BIT IN THE 00820000
- * TYPLIN PLIST SO THAT CONWRIT WILL DO THE SIO TO CP WITH A SPECIAL 00821000
- * OPCODE OF X'05', WHICH WILL INDICATE TO CP THAT THIS IS TO BE 00822000
- * PROCESSED AS AN ERROR MESSAGE. 00823000
- DER EQU * 00824000
- SPACE 00825000
- * TYPLIN PLIST BITS 00826000
- ERMBIT EQU X'40' ERROR MESSAGE BIT 00827000
- NOHTBIT EQU X'01' 'HT' CAN'T CANCEL THIS LINE 00828000
- SPACE 00829000
- * THE BITS THAT GET SET IN THE PLIST DEPEND ON THE 'LET' FIELD OF THE 00830000
- * ERROR MESSAGE. THE BITS ARE SET AS FOLLOWS: 00831000
- * E + I + W -> ERMBIT 00832000
- * S + T -> NOHTBIT 00833000
- * R + OTHERS -> NO BITS 00834000
- SPACE 00835000
- * WE CHECK THE LETTER NINE BYTES FROM THE START OF THE MESSAGE TEXT, 00836000
- * WHETHER DMSERR CREATED THE HEADER OR NOT. THIS WILL ALLOW 00837000
- * 'LINEDIT DISP=ERRMSG' TO WORK PROPERLY, WITH THE USER SPECIFYING HIS 00838000
- * OWN HEADER. 00839000
- L R1,ERTPLA GET ADDRESS OF MESSAGE TEXT 00840000
- CLI 9(R1),C'E' IS LETTER = E 00841000
- BE DERE GO IF YES 00842000
- CLI 9(R1),C'I' LETTER = I 00843000
- BE DERE GO IF SO 00844000
- CLI 9(R1),C'W' LETTER = W 00845000
- BE DERE GO IF SO 00846000
- CLI 9(R1),C'S' LETTER = S 00847000
- BE DERH GO IF SO 00848000
- CLI 9(R1),C'T' LETTER = T 00849000
- BE DERH GO IF SO 00850000
- SPACE 00851000
- * OTHERWISE, WE SET NO BITS WHATSOEVER, AND GO TYPE IT OUT. 00852000
- MVI ERTPLL+1,0 ZERO OUT FLAG BYTE 00853000
- B DTY 00854000
- SPACE 00855000
- * FOR E, I AND W, SET THE ERMBIT, SO THAT SIO X'05' WILL BE USED. 00856000
- DERE EQU * 00857000
- MVI ERTPLL+1,ERMBIT SET ERROR MESSAGE BIT 00858000
- B DTY GO TYPE MESSAGE 00859000
- SPACE 00860000
- * FOR S AND T MESSAGES, SET NOHTBIT, SO THAT THE MESSAGE CAN NEVER 00861000
- * BE CANCELED. 00862000
- DERH EQU * 00863000
- MVI ERTPLL+1,NOHTBIT SET NO HT BIT 00864000
- B DTY 00865000
- EJECT 00866000
- * 'TYPE' OPTION. WE BALR TO TYPLIN, SO THAT WE WON'T DO AN SVC, SO 00867000
- * THAT WE CAN BE CALLED FROM THE SAVC HANDLER, DMSITS. 00868000
- DTY EQU * 'TYPE' OPTION 00869000
- L R15,=V(DMSCWR) POINT TO TYPLIN ROUTINE 00870000
- LA R1,ERTPL POINT TO TYPLIN PLIST 00871000
- MVI ERTPLA,1 FILL IN REST OF IT 00872000
- MVI ERTPLL,C'R' 00873000
- MVC ERTPL(8),=CL8'TYPLIN' 00874000
- BAL RR,NUCCALL CALL TYPEOUT ROUTINE 00875000
- B DNO 00876000
- EJECT 00877000
- * PRINT OPTION. 00878000
- DPR EQU * 00879000
- MVC ERTPL(8),=CL8'PRINTR' SET UP PRINTR PLIST 00880000
- LA R1,ERTPL AND POINT TO IT 00881000
- L R15,=V(PRINTR) VCON FOR PRINTR ROUTINE 00882000
- BAL RR,NUCCALL GO CALL IT 00883000
- B DNO WE'RE FINISHED 00884000
- EJECT 00885000
- * DISP=SIO IS USED ONLY FOR EMERGENCIES, SUCH AS WHEN TYPLIN IS 00886000
- * CALLING DMSERR. IT DOES ITS OWN SIO'S TO THE TERMINAL, AND DOESN'T 00887000
- * USE SYSTEM FACILITIES. 00888000
- DSI EQU * 00889000
- SSM =X'00' DISABLE ALL INTERRUPTS V0005 00890000
- SR R1,R1 V0005 00891000
- BCTR R1,0 R1 <- -1 V0005 00892000
- DIAG R1,R14,X'24' FIND ADDRESS OF CONSOLE V0005 00893000
- BC B'0001',DSNC CC = 3 -> NO VIRTUAL CONSOLV0005 00894000
- SPACE 1 V0005 00895000
- * OTHERWISE, R1 CONTAINS THE VIRTUAL CONSOLE ADDRESS V0005 00896000
- SPACE 1 V0005 00897000
- * WE NOW 'REMEMBER' WHETHER THERE IS ACTIVITY PENDING ON THE V0005 00898000
- * VIRTUAL CONSOLE, SO WE CAN RESTORE THE STATUS AFTER WE HAVE V0005 00899000
- * TYPED OUT THE MESSAGE. V0005 00900000
- SR XR,XR ZERO FLAG = NO TERMINAL ACTIVITY 00901000
- TIO 0(R1) ANY CONSOLE ACTIVITY? V0005 00902000
- BZ DSIS GO IF NOT 00903000
- LA XR,1 SET FLAG FOR CONSOLE ACTIVITY 00904000
- TIO 0(R1) WAIT FOR CONSOLE ACTIVITY V0005*00905000
- TO FINISH V0005 00906000
- BC 7,*-4 JUMP BACK IF NOT FINISHED 00907000
- SPACE 00908000
- * SET UP CCW 00909000
- DSIS EQU * 00910000
- MVC ERT2(16),CCWS COPY DUMMY CCWS INTO WORK AREA 00911000
- MVC ERT2+1(3),ERTPLA+1 COPY DATA ADDRESS INTO CCW 00912000
- MVC ERT2+5(3),ERTPLL+1 COPY DATA LENGTH INTO CCW 00913000
- LA R0,ERT2 00914000
- ST R0,CAW STORE IN CAW V0005 00915000
- SIO 0(R1) DO OUTPUT TO CONSOLE V0005 00916000
- BC 7,*-4 LOOP UNTIL IT 'TAKES' 00917000
- TIO 0(R1) WAIT FOR COMPLETION V0005 00918000
- BC 7,*-4 WAIT UNTIL IT COMPLETES 00919000
- LTR XR,XR WAS THERE ANY CONSOLE ACTIVITY? 00920000
- BZ DNO NOTHING TO DO IF NOT 00921000
- SPACE 1 V0005 00922000
- * WE NOW WISH TO RESTORE THE 'ACTIVITY PENDING' STATUS OF THE V0005 00923000
- * CONSOLE, TO KEEP THE CONSOLE HANDLING ROUTINES HAPPY. THE V0005 00924000
- * WAY TO DO THIS IS TO DO A SIO ON THE SECOND OF THE TWO CCW'S V0005 00925000
- * IN CCWCONS, WHICH IS THE AREA IN NUCON USED BY THE CONSOLE V0005 00926000
- * ROUTINES. V0005 00927000
- MVI CONCCWS+8,4 CHANGE NOP TO SENSE V0005 00928000
- LA R0,CONCCWS+8 POINT TO CCW V0005 00929000
- ST R0,CAW STORE IN CAW V0005 00930000
- SIO 0(R1) START I/O ON THIS CCW V0005 00931000
- BC 7,*-4 LOOP UNTIL IT 'TAKES' V0005 00932000
- MVI CONCCWS+8,3 CHANGE SENSE BACK TO NOP V0005 00933000
- B DNO GO FINISH UP 00934000
- SPACE 2 V0005 00935000
- * IF THE GUY HAS NO CONSOLE ATTACHED, THEN WE PRODUCE THE MESSAGE V0005 00936000
- * BY MEANS OF 'CP MSG *' COMMAND. V0005 00937000
- DSNC EQU * V0005 00938000
- LA R1,DSMS POINT TO MSG * V0005 00939000
- LA R0,DSMSL GET LENGTH OF MESSAGE V0005 00940000
- DIAG R1,R0,8 DIAGNOSE TO CP V0005 00941000
- B DIE DIE IMMEDIATELY V0005 00942000
- SPACE 1 V0005 00943000
- DSMS DC C'MSG * DMSERR215T NO VIRTUAL CONSOLE ATTACHED. ' V0005 00944000
- DC C'RE-IPL CMS.' V0005 00945000
- DSMSL EQU *-DSMS V0005 00946000
- SPACE 2 00947000
- CCWS CCW 9,0,X'60',0 WRITE WITH CC/SILI 00948000
- CCW 3,0,X'20',1 NOP 00949000
- EJECT 00950000
- * CPCOMM OPTION. PASS THE TEXT TO CP TO EXECUTE AS A COMMAND. 00951000
- DCP EQU * 00952000
- LA R1,=CL16'CONWAIT CON1' POINT TO A PLIST @VA09080 00952300
- L R15,=V(DMSCWT) GET ADDRESS OF CONWAIT ROUTINE @VA09080 00952600
- BAL RR,NUCCALL AND CALL CONWAIT TO DRAIN I/O @VA09080 00952900
- L R1,ERTPLA GET ADDRESS OF MESSAGE TEXT 00953000
- L R0,ERTPLL GET LENGTH OF MESSAGE TEXT 00954000
- DC X'83100008' DIAGNOSE IT TO CP 00955000
- ST R0,ERSAVE+4*R15 SAVE ERROR CODE FOR OUR RETURN 00956000
- B DNO GO FINISH UP 00957000
- EJECT 00958000
- * COME HERE ON 'NONE' DISPOSITION, AND ALSO TO FINISH UP. 00959000
- * WE MUST RETURN TO CALLER, EITHER BY A NORMAL RETURN, OR BY 00960000
- * LOADING A DISABLED WAIT STATE PSW. 00961000
- DNO EQU * 00962000
- TM ERPF2,ERF2DI WAS DIE=YES SPECIFIED? 00963000
- BO DIE GO DIE IF SO 00964000
- LM R0,R15,ERSAVE RESTORE REGISTERS 00965000
- BR R14 AND RETURN TO CALLER 00966000
- EJECT 00967000
- * SUBROUTINE TO CALL A NUCLEUS ROUTINE, IF THE VCON TO IT WAS 00968000
- * RESOLVED. IF IT WAS NOT RESOLVED, THEN SVC 202 IS CALLED. 00969000
- * WE ASSUME R1 POINTS TO THE PLIST. 00970000
- NUCCALL EQU * 00971000
- ST RR,ERT1 SAVE RETURN REGISTER 00972000
- LTR R15,R15 WAS VCON RESOLVED? 00973000
- BZ NUCCALLS NO -- MAKE AN SVC CALL 00974000
- LA R13,ERPAS13 POINT TO A SAVE AREA 00975000
- BALR R14,R15 CALL ROUTINE 00976000
- SPACE 00977000
- * THE ROUTINE MAY HAVE CLOBBERED ALL OUR REGISTERS, WE ASSUME 00978000
- * NOTHING. 00979000
- BALR R15,0 RE-ESTABLISH ADDRESSABILITY 00980000
- USING *,R15 00981000
- L BR,=A(DMSERR) 00982000
- DROP R15 00983000
- L TR,=V(DMSERT) POINT TO WORK AREA 00984000
- L RR,ERT1 RESTORE RETURN REG 00985000
- BR RR AND RETURN TO CALLER 00986000
- SPACE 00987000
- NUCCALLS EQU * 00988000
- SVC 202 MAKE AN SVC CALL 00989000
- DC AL4(*+4) 00990000
- BR RR 00991000
- * COME HERE TO DIE 00992000
- DIE EQU * 00993000
- * IF BATCH IS RUNNING, DON'T ALLOW DISABLED WAIT STATE V0742 00994000
- TM BATFLAGS,BATRUN BATCH MONITOR RUNNING? V0742 00995000
- BZ NOTBAT IF NOT, FORGET THIS... V0742 00996000
- TM BATFLAG2,BATSYSAB RECURSIVE SYS ABEND CHEK @VA05162 00997000
- BZ BATABEND FIRST TIME, GOTO BATCH @VA05162 00998000
- BAL R1,DIEDIAG POINT TO MSG LINE @VA05162 00999000
- DIEMSG DC C'MSG OPERATOR CMSBATCH SYSTEM ABEND' @VA05162 01000000
- DIEMSGLN EQU *-DIEMSG @VA05162 01001000
- DIEDIAG LA R2,DIEMSGLN PROVIDE LENGTH OF DIE MSG @VA05162 01002000
- DC X'83120008' DIAG MSG TO CP AND... @VA05162 01003000
- B NOTBAT NOW DIE IN PEACE. @VA05162 01004000
- BATABEND OI BATFLAG2,BATSYSAB SET RECURSION FLAG ... @VA05162 01005000
- L R15,ABATABND GO TO BATCH ABEND PROC. V0742 01006000
- BALR R14,R15 AND DON'T COME BACK... V0742 01007000
- NOTBAT EQU * V0742 01008000
- SPACE 01009000
- L R15,AUSERRST ANY MACHINE THAT WANTS TO BE @V60C5BE 01010000
- * RESTARTED SHOULD PUT A VCON HERE.@V60C5BE 01011000
- XC AUSERRST,AUSERRST ZERO THE LOCATION TO PREVENT @V60C5BE 01012000
- * RECURSIVE ABEND LOOPS @V60C5BE 01013000
- LTR R15,R15 DID VM SUPPLY A RESTART ENTRY PT?@V60C5BE 01014000
- BCR 7,R15 IF THERE IS ONE, GO TO IT. @V60C5BE 01015000
- SPACE 01016000
- * IF THE GUY DID NOT REQUEST AN SIO, THEN WE DO A CONWAIT BEFORE DYING. 01017000
- IC R1,ERPF2 GET HIS 'DISP' VALUE 01018000
- N R1,=AL1(0,0,0,7) GET LAST THREE BITS 01019000
- CH R1,=AL2(ERF2SI) DID HE REQUEST 'SIO'? 01020000
- BE DIEW YES -- GO DIE DIRECTLY 01021000
- LA R1,=CL16'CONWAIT CON1' POINT TO A PLIST 01022000
- L R15,=V(DMSCWT) LOAD VCON FOR CONWAIT ROUTINE 01023000
- BAL RR,NUCCALL CALL CONWAIT 01024000
- SPACE 01025000
- * NOW, FINALLY, WE CAN DIE 01026000
- DIEW EQU * 01027000
- SPACE 01028000
- * WE MUST DECIDE WHETHER WE WERE CALLED BY SVC OR BALR CALL. 01029000
- L XR,CURRSAVE GET ADDRESS OF SYSTEM SAVE AREA 01030000
- LTR XR,XR IS THERE ANY? 01031000
- BZ DIEBALR NO -> WE WERE CALLED BY BALR 01032000
- USING SSAVE,XR 01033000
- SPACE 01034000
- * WE ARE NOW POINTING TO THE CURRENT SYSTEM SAVE AREA. WE CHECK TO 01035000
- * SEE IF THE CALLEE NAME IS DMSERR OR LINEDIT. 01036000
- CLC CALLEE,=CL8'DMSERR' IS THE CALLEE DMSERR? 01037000
- BE DIESVC SVC CALL IF SO 01038000
- CLC CALLEE,=CL8'LINEDIT' IS THE CALLED LINEDIT? 01039000
- BNE DIEBALR BALR CALL IF NOT 01040000
- SPACE 01041000
- * FOR SVC CALLS, WE SIMPLE DISABLE THE SVC OLD PSW, AND SET THE 01042000
- * WAIT STATE BIT ON. 01043000
- DIESVC EQU * 01044000
- MVI OLDPSW,0 TURN OFF THE SYSTEM MASK 01045000
- OI OLDPSW+1,X'02' TURN ON WAIT STATE BIT 01046000
- LM R0,R15,ERSAVE RESTORE REGS 01047000
- BR R14 RETURN TO SVC HANDLER 01048000
- SPACE 01049000
- * FOR BALR CALLS, WE CREATE OUR OWN DISABLED WAIT STATE PSW AND LOAD 01050000
- * IT. 01051000
- DIEBALR EQU * 01052000
- SPACE 01053000
- ERMPSW EQU X'30' CONSTRUCTION AREA FOR PSW 01054000
- MVC ERMPSW(4),=X'00020000' SET DISABLED WAIT STATE 01055000
- LM R0,R15,ERSAVE RESTORE REGISTERS 01056000
- ST R14,ERMPSW+4 SET ADDR IN PSW 01057000
- LPSW ERMPSW DIE 01058000
- LTORG 01059000
- EJECT 01060000
- DMSERT 01061000
- NUCON 01062000
- SVCSAVE 01063000
- END 01064000
ibm/vm370-lib/cms/dmserr.assemble_src.txt · Last modified: 2023/08/06 13:35 by Site Administrator