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