ibm:vm370-lib:cms:dmscwr.assemble_src
Table of Contents
DMSCWR Source
References
- Fixes Applied : 3
- This Source Date : Tuesday, December 12, 1978
- Last Fix ID : [HRC002DS]
Source Listing
- DMSCWR.ASSEMBLE.txt
- CWR TITLE 'DMSCWR (CMS) VM/370 - RELEASE 6' 00001000
- SPACE 2 00002000
- *. 00003000
- * MODULE NAME 00004000
- * 00005000
- * DMSCWR 00006000
- * 00007000
- * FUNCTION 00008000
- * 00009000
- * WRITE OUTPUT LINE TO CONSOLE 00010000
- * 00011000
- * ENTRY POINTS 00012000
- * 00013000
- * DMSCWR 00014000
- * 00015000
- * ATTRIBUTES 00016000
- * 00017000
- * NUCLEUS RESIDENT, REENTRANT 00018000
- * 00019000
- * ENTRY CONDITIONS 00020000
- * 00021000
- * GPR1 = A(PLIST) 00022000
- * 00023000
- * PLIST DC CL8'TYPLIN' V0003 00024000
- * DC AL1(1) 00025000
- * DC AL3(OUTPUT LINE ADDRESS) 00026000
- * DC CL1'CODE' 00027000
- * DC X'FLAGS' V0003 00028000
- * DC AL2(MESSAGE LENGTH) V0003 00029000
- * 00030000
- * CODES 00031000
- * B = TYPE IN BLACK 00032000
- * R = TYPE IN RED 00033000
- * V0003 00034000
- * FLAGS BITS V0003 00035000
- * 80 = NO CAR. RTN. V0003 00036000
- * 40 = DO DIAGNOSE FOR ERROR MSG EDITING @VA01388 00037000
- * 10 = DO "LONG" WRITE (FROM USER BUFFER) @VA04603 00038000
- * 01 = PRIORITY WRITE V0003 00039000
- * 02 = CALL FROM QUERY INPUT OR OUTPUT 00040000
- * V0003 00041000
- * EXIT CONDITIONS 00042000
- * 00043000
- * RETURN TO CALLER, R15=0 00044000
- * 00045000
- * ERROR- 00046000
- * GOTO DMSERR ON PERMANENT CONSOLE ERROR 00047000
- * 00048000
- * CALLS TO OTHER ROUTINES 00049000
- * 00050000
- * DMSIOW, DMSCITB, DMSCITA, DMSERR 00051000
- * 00052000
- * EXTERNAL REFERENCES 00053000
- * 00054000
- * DMSNUC 00055000
- * 00056000
- * TABLES/WORKAREAS 00057000
- * 00058000
- * NONE 00059000
- * 00060000
- * REGISTER USAGE 00061000
- * 00062000
- * R2 - PLIST 00063000
- * R5 - CONSOLE AREA IN DMSNUC 00064000
- * R12 - BASE 00065000
- * REST WORK 00066000
- * 00067000
- * OPERATION 00068000
- * 00069000
- * ELIMINATE TRAILING BLANKS FROM LINE, SET 00070000
- * CARRIAGE RETURN CODE. IF HALT TYPING IS IN 00071000
- * EFFECT RETURN TO CALLER. IF LINE WON'T FIT IN 00072000
- * WRITE STACK CALL DMSIOW TO LET THE STACK DRAIN. 00073000
- * MOVE THE LINE TO WRITE STACK WITH TRANSLATION. 00074000
- * IF THERE WERE WRITES IN STACK ALREADY OR A 00075000
- * READ IS PENDING RETURN TO CALLER. OTHERWISE 00076000
- * CALL DMSCITB TO START WRITE OPERATION. RETURN TO 00077000
- * CALLER. 00078000
- *. 00079000
- EJECT 00080000
- EJECT 00081000
- DMSCWR START 00082000
- BALR R12,0 00083000
- USING *,R12 00084000
- USING NUCON,R0 00085000
- LR R2,R1 SAVE PARAMETER LIST PTR 00086000
- USING TYPDSECT,2 00087000
- L R5,AFVS POINT TO FVSECT 00088000
- USING FVSECT,R5 00089000
- OI KXFLAG,KXWSVC HOLD KX UNTIL SVC ACTIVITY 00090000
- L R5,=V(CONSOLE) LOAD ADDRESS OF CONSOLE DEVICE TABLE 00091000
- USING NUCDSECT,5 00092000
- LH R9,NCDEVAD GET CONSOLE DEVICE ADDRESS @VA04854 00093000
- LA R5,NOCR SET FOR NO CARRIAGE RETURN @VA04854 00094000
- L 3,TYBUFADD-1 SET R3 TO BUFFER ADDRESS 00095000
- LH 4,TYSIZEH AND R4 TO BUFFER LENGTH 00096000
- LTR 4,4 IS IT ZERO 00097000
- BP CKTYPE BP IF > 0 (GO ON) 00098000
- LA 4,1 YES, RESET LENGTH TO 1 00099000
- LA 3,BLANK AND POINT R3 TO A BLANK 00100000
- CKTYPE TM TYSIZE3,NORETN TYPLIN CALL ? @V2D3914 00101000
- BO TJOIN NO 00102000
- LA R5,CARG SET FOR CARRIAGE RETURN @VA04854 00103000
- LA R6,0(R3,R4) SET R6 TO END OF BUFFE 00104000
- SHORTLP BCTR 6,0 00105000
- CLI 0(6),C' ' IS CHARACTER A BLANK? 00106000
- BNE TJOIN NO, CONTINUE ON 00107000
- BCT 4,SHORTLP YES, REDUCE BUFFER LENGTH AND SCAN NEXT C 00108000
- LA 4,1 IF ALL BLANKS, RESET LENGTH TO 1 00109000
- TJOIN L R11,AOPSECT 00110000
- USING OPSECT,R11 00111000
- LR 13,14 SAVE RETURN REGISTER IN R13 00112000
- RECKT TM TYSIZE3,ERROP USE SPECIAL ERROR OP CODE ? @V2D3914 00113000
- BNO STACK1 NO 00114000
- DC X'83',X'34',X'005C' EDIT ERROR MSG ACCORDING @VA01388 00115000
- * TO USER'S EMSG SETTING @VA01388 00116000
- LTR R4,R4 LENGTH OF 0 (I.E., EMSG OFF) @VA01388 00117000
- BZ EXIT YES, DON'T SEND MSG; JUST RETURN @VA01388 00118000
- STACK1 TM TYSIZE3,PRIOWR IS LINE A PRIORITY WRITE ? @V2D3914 00119000
- LR R10,R5 GET CARG/NOCR INDICATOR @VA04854 00120000
- BNO STACK2 NO 00121000
- LA R10,X'80'(R10) SET THE PRIORITY FLAG @VA0872 00122000
- B STACK3 OMIT HT CHECK 00123000
- STACK2 TM MSGFLAGS,NOTYPING HT IN EFFECT 00124000
- BO EXIT YES, DON'T PROCESS WRITE 00125000
- EJECT 00126000
- STACK3 L R6,PENDWRIT GET ADDRESS OF NEXT STACK ENTRY 00127000
- LA 15,LA7264 (FOR BCR'S TO SAVE SPACE) 00128000
- SR 8,8 R8=0 MEANS LINE TO BE TYPED IN BLACK. 00129000
- LR R0,R4 PRESERVE R4 CONTENTS @VA07156 00130000
- TM TYSIZE3,NOMAX OVERRIDE LENGTH LIMIT ? @V2D3914 00131000
- BNO CKLONGOP NO, CHECK FOR LONG WRITE @VA04964 00132000
- CH R4,MAXLINE YES, LENGTH REALLY > 130 ? @VA04964 00133000
- BNH STKENDCK NO, CAN STACK ACTUAL MSG @VA04964 00134000
- B SETLONG YES, BETTER HANDLE AS LONGOP @VA04964 00135000
- CKLONGOP EQU * @VA04964 00136000
- TM TYSIZE3,LONGOP IS IT WRITE-FROM-USER-AREA? @V2D4598 00137000
- BNO STACK4 -NO, CONTINUE @V2D4598 00138000
- SETLONG EQU * @VA04964 00139000
- LA R10,LONGOP(,R10) YES, SET OPCODE FLAG @V2D4598 00140000
- LA R4,LNLONGOP-2 AND SET SIZE IN STACK @V2D4598 00141000
- BR R15 'B LA7264', SKIPPING LENGTH CHK @V2D4598 00142000
- STACK4 EQU * @V2D4598 00143000
- CH 4,MAXLINE INSURE BUFFER IS .LE. TO 130 00144000
- BL STKENDCK BL IF < 130, CHECK FOR POSSIBLE RED. 00145000
- LH 4,MAXLINE IF TOO BIG, TRUNCATE IT TO MAXLINE 00146000
- BR 15 "B LA7264" - GO COMPUTE END OF STACK. 00147000
- STKENDCK CLI TYTYPE,C'R' IS "RED" DESIRED ? 00148000
- BCR 7,15 "BNE LA7264" IF NOT, ASSUME BLACK. 00149000
- CH 4,MAXRED IF YES, ENOUGH ROOM FOR EXTRA CHARS. ? 00150000
- BCR 2,15 "BH LA7264" IF NOT (BLACK WILL HAVE TO DO) 00151000
- TM MSGFLAGS,REDERRID IS RED TYPE ALLOWED ? 00152000
- BCR 8,15 "BZ LA7264" IF NOT (FORGET IT) 00153000
- LA 8,4 SIGNAL RED IF WANTED AND ENOUGH ROOM. 00154000
- LA7264 LA 7,2(6,4) COMPUTE END OF STACK 00155000
- AR 7,8 (INCLUDING EXTRA CHARS - IF ANY) 00156000
- LA R15,CONSTACK+L'CONSTACK POINT TO END OF OUTPUT STACK 00157000
- CR 7,15 WILL THIS LINE FIT ? 00158000
- BNH INSERT BNH IF YES, GO INSERT IT. 00159000
- WAITLP LA 1,WAITLST NO, WAIT FOR ENTIRE STACK TO EMPTY 00160000
- L 15,=V(WAIT) CALL WAIT VIA BALR (FASTER) 00161000
- LR R4,R0 RESTORE R4 @VA07156 00162000
- BALR 14,15 (24 SEPTEMBER 1968) 00163000
- CLC NUMPNDWR,=H'1' IS STACK DOWN TO ONE YET? 00164000
- BH WAITLP NO,LOOP TO WAIT SOME MORE @V2D4598 00165000
- BE STACK1 YES, RE-DO STACKING @V2D4598 00166000
- B EXIT WENT TO ZERO, ERGO ATTN STRUCK @V2D4598 00167000
- INSERT ST R7,PENDWRIT RESET NEXT STACK ADDRESS 00168000
- STC 10,0(,6) SET WRITE FLAGS 00169000
- TM 0(R6),LONGOP IS IT LONG? (DIFFERENT FORMAT) @V2D4598 00170000
- BNO INSERT2 -NO, CONTINUE AS IN '68... @V2D4598 00171000
- LA R5,1760 LONGEST LINE CP CAN HANDLE @VA04854 00172000
- CH R5,TYSIZEH COMPARE WITH REQUESTED LENGTH @VA04854 00173000
- BNH INSERTL ASKED FOR TOO MUCH; SKIP @VA04854 00174000
- LH R5,TYSIZEH OK; USE REQUESTED LENGTH @VA04854 00175000
- LTR R5,R5 ZERO LENGTH BUFFER @VA07610 00175200
- BNZ INSERTL NO-OK @VA07610 00175400
- LA R5,C1 SET LENGTH TO 1 AS BEFORE @VA07610 00175600
- INSERTL STH R5,TOLNGLEN(,R6) PUT LENGTH IN THE STACK @VA04854 00176000
- LA R0,7(,R5) ROUND UP LENGTH ... @VA04854 00177000
- SRL R0,3 ... TO NEXT DOUBLEWORD @VA04854 00178000
- DMSFREE DWORDS=(0),TYPCALL=BALR GET SOME STORE @VA04854 00179000
- STCM R1,B'0111',TOLNGADR(R6) PUT ADDR IN STACK @VA04854 00180000
- SLL R0,3 CHANGE DOUBLEWORDS BACK TO BYTES @VA04854 00181000
- LR R15,R0 TO GET TARGET LENGTH FOR MVCL, @VA04854 00182000
- LR R14,R1 THEN TARGET ADDRESS, @VA04854 00183000
- LR R4,R3 SOURCE ADDRESS (R5 = LENGTH) @VA04854 00184000
- MVCL R14,R4 MOVE LINE TO BUFFER @VA04854 00185000
- ICM R3,B'1111',AOUTRTBL ADDR OF USER TRANS TABLE @VA06216 00186000
- BZ LH8 IF NONE EXISTS @VA06216 00187000
- LR R6,R1 ADDR OF LINE @VA06216 00188000
- LA R5,1760 LONGEST LINE TO WRITE @VA10758 00189100
- CH R5,TYSIZEH COMPARE WITH REQUESTED LENGTH @VA10758 00189200
- BNH LONGE1 ASKED FOR TOO MUCH USE 1760 @VA10758 00189300
- LH R5,TYSIZEH OK, USE REQUESTOR'S LENGTH @VA11579 00189400
- LTR R5,R5 LENGTH ZERO? @VA10758 00189500
- BNZ LONGE1 NO, IT'S O.K. @VA10758 00189600
- LA R5,C1 SET TO 1 AS MINIMUM @VA10758 00189700
- LONGE1 EQU * @VA06216 00190000
- LR R15,R5 COPY OF LENGTH @VA06216 00192000
- CL R5,F256 MORE THAN MAX ? @VA08132 00193000
- BNH LONGEOK NO, USE REMAINDER @VA06216 00194000
- L R15,F256 YES RESET TO MAX @VA08132 00195000
- LONGEOK EQU * @VA06216 00196000
- BCTR R15,0 DECRMNT FOR EX MVC @VA08132 00196100
- BCTR R5,0 DECRMNT FOR EX MVC @VA08132 00196200
- EX R15,LOUTRANS TRANSLATE 1 FOR 1 @VA07410 00197000
- LA R6,1(R6,R15) CORRECT BUFFER POINTER @VA06216 00198000
- SR R5,R15 ANY LEFT? @VA06216 00199000
- BP LONGE1 YES. GO TRANSLATE @VA06216 00200000
- B LH8 AND START THE WRITE. @VA06216 00201000
- INSERT2 EQU * @VA06216 00202000
- LA R15,0(R4,R8) GET CORRECT MESSAGE LENGTH, @VA06216 00203000
- STC R15,1(,R6) AND STORE WHERE NEEDED @VA06216 00204000
- BCTR R4,0 SETUP TO MOVE MSG INTO STACK @VA06216 00205000
- LTR 8,8 'RED' WANTED ? 00206000
- BZ EX4 BZ IF NOT, USE REGULAR LOGIC. 00207000
- MVC 2(2,6),BLACKRED IF YES, MOVE IN BLACK-TO-RED CHARS, 00208000
- H2 LA 6,2(6,0) BUMP R6 UP BY 2, 00209000
- SH 7,H2+2 BACK OFF 2 BYTES FROM 'END OF LINE' 00210000
- MVC 0(2,7),REDBLACK MOVE IN RED-TO-BLACK CHARS, 00211000
- EX4 EX 4,STKMVC MOVE THE LINE TO THE STACK BUFFER. 00212000
- TM TYSIZE3,TYSZ02 DO NOT TRANSLATE IF CALL @VA06217 00213000
- BO LH8 FROM Q INPUT OR Q OUTPUT @VA06217 00214000
- L R3,AOUTRTBL OUTPUT-TRANSLATION WANTED ? 00215000
- LTR 3,3 ... 00216000
- BZ LH8 BZ IF NOT (USUALLY WON'T). 00217000
- EX 4,OUTRANS TRANSLATE OUTPUT LINE (IN STACK BUFFER) 00218000
- LH8 LA R15,1 HANDY CONSTANT '1' @V2D4598 00219000
- ICM R8,B'0011',NUMPNDWR LOAD & TEST COUNT OF WRITES @V2D4598 00220000
- BZ TYPNOW NO, GO START THIS WRITE NOW 00221000
- AR 8,15 IF NUMWRTS > 0, ADD 1 TO IT. 00222000
- STH R8,NUMPNDWR 00223000
- EXIT SR 15,15 00224000
- TEXIT LR 14,13 00225000
- L R8,AFVS POINT TO FVSECT P3101 00226000
- USING FVSECT,R8 P3101 00227000
- NI KXFLAG,X'FF'-KXWSVC TURN OFF 'HX' WAIT FLAG P3101 00228000
- DROP R8 P3101 00229000
- BR 14 RETURN TO CALLER 00230000
- * 00231000
- TYPNOW STH R15,NUMPNDWR STORE STACK COUNT OF 1 00232000
- CLC PENDREAD,=F'0' IS THERE A PENDING READ UP ? 00233000
- BNE EXIT IF YES, DON'T TRY THE WRITE NOW. 00234000
- LA R1,CONSTACK SET R1 FOR 'STNEWCON' 00235000
- L R15,=V(DMSCITB) AND CALL IT 00236000
- BALR 14,15 00237000
- LTR 15,15 DID SIO GET STARTED 00238000
- BZ TEXIT IF YES, GO EXIT (R15 ALREADY 0). 00239000
- CLI CSW+4,X'90' ATTENTION PENDING 00240000
- BNE ALLOVER NO, SOME OTHER CONDITION 00241000
- L R15,=V(DMSCITA) CALL INTERRRUPT HANDLER 00242000
- L R5,=V(CONSOLE) 00243000
- LR R14,R13 RETURN LOCATION 00244000
- BR R15 00245000
- ALLOVER DMSERR TEXT='PERMANENT CONSOLE ERROR',NUM=171, X00246000
- LET=T,TYPCALL=BALR,HALT=YES 00247000
- B ALLOVER 00248000
- DC CL4'CON1' 00249000
- SPACE 2 00250000
- STKMVC MVC 2(*-*,6),0(3) MOVES LINE TO STACK BUFFER WHEN EXECUTED 00251000
- OUTRANS TR 2(*-*,6),0(3) TRANSLATES OUTPUT LINE IF NECESSARY 00252000
- LOUTRANS TR 0(0,6),0(3) TRANSLATE LONG OUTOUT @VA07410 00253000
- SPACE 2 00254000
- LTORG 00255000
- SPACE 2 00256000
- MAXLINE DC H'130' 00257000
- MAXRED DC H'126' MAXIMUM LINE WE CAN TYPE IN RED. 00258000
- BLACKRED DC X'2781' BLACK---> RED 00259000
- REDBLACK DC X'2782' RED-----> BLACK 00260000
- BLANK DC C' ' 'BLANK' OK FOR 'TYPE', BUT ... 00261000
- * 00262000
- TYPENT DC AL2(NOCR) 00263000
- F256 DC F'256' @VA08132 00264000
- ATTN EQU X'80' 00265000
- BUSY EQU X'10' 00266000
- NOCR EQU 1 00267000
- CARG EQU 9 00268000
- SPACE 1 @V2D3914 00269000
- * TYSIZE3 BIT ASSIGNMENTS @V2D3914 00270000
- NORETN EQU X'80' NO CARRIAGE RETURN IN OP CODE @V2D3914 00271000
- ERROP EQU X'40' SPECIAL ERROR CCW REQUEST @V2D3914 00272000
- NOMAX EQU X'20' OVERRIDE MAXIMUM WRITE REQUEST @V2D3914 00273000
- TYSZ10 EQU X'10' UNUSED @V2D3914 00274000
- TYSZ08 EQU X'08' UNUSED @V2D3914 00275000
- TYSZ04 EQU X'04' UNUSED @V2D3914 00276000
- TYSZ02 EQU X'02' CALL FROM QUERY INPUT OR OUTPUT @VA06217 00277000
- PRIOWR EQU X'01' PRIORITY WRITE REQUEST @V2D3914 00278000
- SPACE 00279000
- * @V2D4598 00280000
- * EQUATES FOR WRITE OPERATION STRINGS @V2D4598 00281000
- * @V2D4598 00282000
- LNLONGOP EQU 6 LENGTH OF A 'LONG' WRITE @V2D4598 00283000
- LNNORMOP EQU 2 LENGTH OF A NORMAL ONE @V2D4598 00284000
- TOLNGLEN EQU 4 OFFSET TO LENGTH HALFWORD @V2D4598 00285000
- TOLNGADR EQU 1 OFFSET TO LONG BUFFADDR @V2D4598 00286000
- TONRMLN EQU 1 OFFSET TO NORMAL LENGTH BYTE @V2D4598 00287000
- * @V2D4598 00288000
- LONGOP EQU X'10' FLAG OF 'LONG', IN OPCODE @V2D4598 00289000
- PRTYWRIT EQU X'80' FLAG OF A PRIORITY WRITE @V2D4598 00290000
- SPACE 2 00291000
- NUCDSECT DSECT 00292000
- NCDEVAD DS H 00293000
- NCSTATS DS H 00294000
- NCWAITB EQU NCSTATS 00295000
- NCDEVTP EQU NCSTATS+1 00296000
- NCNAME DS CL4 00297000
- NCINTRTN DS A 00298000
- NUCNSIZE EQU *-NUCDSECT 00299000
- * 00300000
- TYPDSECT DSECT 00301000
- DS CL8 00302000
- TYTERMNO DS AL1 00303000
- TYBUFADD DS AL3 00304000
- TYTYPE DS C 00305000
- TYSIZE3 DS AL3 00306000
- TYSIZEH EQU TYSIZE3+1 00307000
- * 00308000
- EJECT 00309000
- NUCON 00310000
- IO 00311000
- FVS 00312000
- REGEQU 00313000
- END 00314000
ibm/vm370-lib/cms/dmscwr.assemble_src.txt · Last modified: 2023/08/06 13:35 by Site Administrator