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