CRD TITLE 'DMSCRD (CMS) VM/370 - RELEASE 6' 00001000
SPACE 2 00002000
*. 00003000
* 00004000
* 00005000
* 00006000
* MODULE: 00007000
* 00008000
* DMSCRD 00009000
* 00010000
* FUNCTION: 00011000
* 00012000
* TO READ AN INPUT LINE AND MAKE IT AVAILABLE TO THE 00013000
* USER. 00014000
* 00015000
* ATTRIBUTES: 00016000
* 00017000
* REENTRANT, NUCLEUS RESIDENT, CALLED VIA SVC 00018000
* 00019000
* ENTRY POINTS: 00020000
* 00021000
* DMSCRD 00022000
* DMSCRDUP - NON EXECUTABLE TABLE 00023000
* DMSCRDTB - NON EXECUTABLE TABLE 00024000
* 00025000
* ENTRY CONDITIONS: 00026000
* 00027000
* GRR 1 = A(PLIST) 00028000
* 00029000
* PLIST DC CL8'CONREAD' 00030000
* DC AL1(1) 00031000
* DC AL3(INPUT BUFFER) 00032000
* DC CL1'CODE' 00033000
* DC AL3(0) BYTE COUNT RECEIVED PUT @V2D4598 00034000
* HERE ON EXIT @V2D4598 00035000
* 00036000
* WHERE CODE: 00037000
* S = PAD WITH BLANKS TO 130 CHARACTERS 00038000
* T = READ A LOGICAL LINE 00039000
* U = PAD WITH BLANKS AND TRANSLATE TO UPPER CASE 00040000
* V = TRANSLATE TO UPPER CASE 00041000
* X = READ A PHYSICAL LINE 00042000
* * = READ PHYS. LINE TO CALLER'S BUFFER @V2D4598 00043000
* $ = READ TO CALLER'S BUFFER, AND DON'T RETRY @V2D4598 00044000
* THE READ IF IT ENDS IN ATTENTION @V2D4598 00045000
* 00046000
* EXIT CONDITIONS: 00047000
* 00048000
* GPR 15 = 0 INDICATES LINE READ SUCCESSFULLY 00049000
* GPR 15 = 2 INDICATES INVALID CODE - NO READ ISSUED 00050000
* GPR 15 = 4 CODE='$', ATTENTION ENDED READ @V2D4598 00051000
* 00052000
* ERROR- 00053000
* 00054000
* GOTO DMSERR ON PERMANENT CONSOLE ERROR 00055000
* 00056000
* CALLS TO OTHER ROUTINES: 00057000
* 00058000
* DMSFREB, DMSCITB, DMSIOW, DMSCAT, DMSERR 00059000
* 00060000
* EXTERNAL REFERENCES: 00061000
* 00062000
* DMSNUC 00063000
* 00064000
* TABLES/WORKAREAS: 00065000
* 00066000
* PSA - USED FOR ATTENTION PLIST 00067000
* 00068000
* REGISTER USAGE: 00069000
* 00070000
* GPR0-11,13 WORK REGISTERS 00071000
* GPR12 - BASE REGISTER 00072000
* GPR14,15 LINKAGE REGISTERS 00073000
* 00074000
* OPERATION: 00075000
* 00076000
* DMSCRD CHECKS THE VALIDITY OF THE READ CODE. IF 00077000
* INVALID, REGISTER 15 IS SET TO 2, AND RETURN IS MADE 00078000
* TO THE CALLER. IF VALID, DMSCRD CHECKS TO SEE IF 00079000
* THERE ARE ANY FINISHED READS. IF THERE ARE, THE DATA 00080000
* FROM THE FIRST INPUT BUFFER IN THE FINISHED READ 00081000
* STACK IS OBTAINED, EDITED ACCORDING TO THE READ CODE 00082000
* AND MOVED TO THE CALLER'S BUFFER. THE BUFFER IS 00083000
* REMOVED FROM THE STACK, THE POINTER TO THE FIRST 00084000
* FINISHED READ IS UPDATED TO POINT TO THE NEXT BUFFER, 00085000
* AND THE NUMBER OF FINISHED READS IS DECREMENTED. IF 00086000
* THE READ WAS GENERATED BY AN ATTENTION, ROUTINE 00087000
* DMSFREB IS CALLED TO RETURN THE BUFFER TO FREE 00088000
* STORAGE. 00089000
* 00090000
* IF THERE ARE NO FINISHED READS, THE PENDING READ 00091000
* POINTER IS CHECKED TO SEE IF THERE IS A PENDING READ. 00092000
* IF THERE IS, DMSCRD CALLS DMSIOW TO WAIT UNTIL THE 00093000
* PENDING READ FINISHES. WHEN THE READ COMPLETES, 00094000
* DMSCRD PROCEEDS AS IF THERE HAD BEEN AN ENTRY IN THE 00095000
* FINISHED READ STACK WHEN THE READ REQUEST WAS MADE. 00096000
* 00097000
* IF THERE IS NOT A PENDING READ, A CHECK IS MADE TO 00098000
* SEE IF THERE ARE ANY PENDING WRITES. IF THERE ARE 00099000
* DMSCRD CALLS DMSIOW TO WAIT FOR THE I/O TO COMPLETE. 00100000
* WHEN THERE ARE NO MORE PENDING WRITES, DMSCRD BALR'S 00101000
* TO ROUTINE DMSCITB TO START A READ OPERATION TO THE 00102000
* TERMINAL. DMSCRD THEN BALR'S TO DMSIOW TO WAIT FOR 00103000
* THE READ TO COMPLETE. WHEN THE READ FINISHES, DMSCRD 00104000
* CHECKS TO SEE IF THE READ WAS CANCELLED BY 00105000
* ATTENTION INTERRUPT. IF SO DMSCRD EXITS 00106000
* OTHERWISE, DMSCRD 00107000
* CONTINUES AS IF THERE HAD BEEN AN ENTRY IN THE 00108000
* FINISHED READ STACK WHEN THE READ REQUEST WAS MADE. 00109000
* 00110000
* IF DMSCRD FINDS A CARRIAGE RETURN WHEN EDITING THE 00111000
* INPUT LINE, DMSCAT IS CALLED TO STACK THE REMAINDER 00112000
* OF THE LINE BACK IN THE FINISHED READ STACK. 00113000
* 00114000
*. 00115000
EJECT 00116000
DMSCRD START 00117000
USING NUCON,R0 00118000
ENTRY DMSCRDUP,DMSCRDTB 00119000
USING *,R12 ADDRESSABILITY IN R12 00120000
LR R12,R15 ... 00121000
USING SCRATCH,R13 USE SCRATCH AREA PROVIDED BY SVCINT 00122000
L R11,AFVS POINT TO FVSECT 00123000
USING FVSECT,R11 00124000
OI KXFLAG,KXWSVC HOLD KX UNTIL SVC ACTIVITY 00125000
L R11,AOPSECT 00126000
USING OPSECT,R11 00127000
TM BATFLAGS,BATRUN+BATLOAD IS BATCH RUNNING? V0742 00128000
BC 11,NOTBAT V0742 00129000
XR R2,R2 V0742 00130000
CH R2,NUMFINRD BATCH READ FROM CON STACK? V0742 00131000
BNE NOTBAT YES: READ REAL CON STACK V0742 00132000
L R15,ABATPROC FIND HIS FREE STORAGE ADDR AND.V0742 00133000
BR R15 GO TO BATCH. V0742 00134000
* V0742 00135000
NOTBAT EQU * V0742 00136000
ST 14,SAV14 SAVE RETURN REGISTER 00137000
LR 10,1 SET R10 TO POINT TO PARAMETER LIST 00138000
USING READSECT,10 00139000
* @V2D4598 00140000
IC R8,RDTYPE OPTION CODE, S,T,U,V,X,*,$ @V2D4598 00141000
LM R3,R5,OPTBXLE SET REGS TO SCAN LIST @V2D4598 00142000
CKTPLP CLM R8,B'0001',0(R3) IS THIS IT? @V2D4598 00143000
BE TYPFND YES, FLAGS AT R3+1 @V2D4598 00144000
BXLE R3,R4,CKTPLP NO, TRY NEXT... @V2D4598 00145000
LR R15,R4 NO HITS, R.C.= 2 @V2D4598 00146000
BR R14 EXIT, PLIST INVALID @V2D4598 00147000
* @V2D4598 00148000
OPTBXLE DC A(FSTCHR,2,LSTCHR) = R3, R4, R5 @V2D4598 00149000
FSTCHR DC C'V',AL1(CLEANUP+UCASE) @V2D4598 00150000
DC C'U',AL1(CLEANUP+UCASE+BLNKFILL) @V2D4598 00151000
DC C'S',AL1(CLEANUP+BLNKFILL) @V2D4598 00152000
DC C'T',AL1(CLEANUP) @V2D4598 00153000
DC C'X',AL1(0) @V2D4598 00154000
DC C'*',AL1(LONGOP) @V2D4598 00155000
DC C'$',AL1(LONGOP+NOATTN) @V2D4598 00156000
LSTCHR EQU *-2 BXLE STOPPER @V2D4598 00157000
CLEANUP EQU 1 @V2D4598 00158000
UCASE EQU 2 @V2D4598 00159000
BLNKFILL EQU 4 @V2D4598 00160000
* @V2D4598 00161000
TYPFND MVC MSK,1(R3) SET OPTION-FLAGS @V2D4598 00162000
MVC CONINBLK+4(2),=AL1(X'0A',134) NORMALIZE BUFFER @V2D4598 00163000
EJECT 00164000
USING NUCDSECT,5 00165000
REREAD L R5,=V(CONSOLE) 00166000
LH 9,NCDEVAD SET R9 TO 1052 ADDRESS 00167000
CKFINRD ICM R2,B'0011',NUMFINRD ANY FINISHED READS? @V2D4598 00168000
BZ CKPENRD NO, GO CHECK FOR PENDING READS 00169000
BCTR 2,0 YES, DECRIMENT NUMBER 00170000
STH 2,NUMFINRD OF FINISHED READS 00171000
L 1,FSTFINRD GET LOCATION OF FINISHED READ 00172000
TM 4(1),X'40' WAS IT AN ATTN READ? 00173000
BZ CKSTK NO, THEN DATA ALREADY IN MY BUFFER 00174000
MVC CONINBUF,6(R1) YES, MOVE DATA TO MY BUFFER 00175000
CKSTK ICM R4,B'1111',0(R1) LOAD & TEST NEXT-READ PTR @V2D4598 00176000
ST R4,FSTFINRD MAKE IT HEAD OF CHAIN @V2D4598 00177000
BNZ CKFRET YES, BRANCH 00178000
ST 4,LSTFINRD NO, RESET POINTER TO LAST FINISHED 00179000
STH 4,NUMFINRD READ AND INSURE ZERO COUNT 00180000
CKFRET TM 4(1),X'40' WAS READ VIA ATTN? 00181000
BZ SCAN NO, GO SCAN INPUT LINE 00182000
LA 0,17 YES, RETURN WORK AREA TO FREE STORAGE 00183000
DMSFRET DWORDS=(0),LOC=(1),TYPCALL=BALR 00184000
B SCAN THEN GO SCAN THE INPUT LINE 00185000
EJECT 00186000
CKPENRD NI MSGFLAGS,255-NOTYPING RESET NO TYPING 00187000
CLC PENDREAD,=F'0' IS THERE A PENDING READ 00188000
BNE WAIT IF YES, GO WAIT FOR IT. 00189000
CLC NUMPNDWR,=F'0' ANY PENDING WRITES P3108 00190000
BNE WAIT YES, GO LET THEM DRAIN OUT 00191000
TM MISFLAGS,QSWITCH ISSUE READ OR WAIT? @VM08647 00192000
BO WAIT IF ON, WAIT @VM08647 00193000
SPACE 1 @VM08647 00194000
LA R2,CONINBLK SET PENDREAD TO INPUT BUFF @VM08647 00195000
ST R2,PENDREAD 00196000
XC CONINBUF,CONINBUF CLEAR INPUT BUFFER 00197000
TM MSK,LONGOP IS IT TO BE LONG? @V2D4598 00198000
BNO RETRY -NO, PROCEED AS USUAL @V2D4598 00199000
MVZ 4(1,R2),MSK SET 'LONGOP', 'NOATTN' @V2D4598 00200000
L R0,RDBUFADD-1 GET BUFFER-ADDRESS @V2D4598 00201000
LH R1,RDSIZE3+1 AND BUFFER LENGTH @V2D4598 00202000
LTR R1,R1 DISALLOW ZERO-LENGTH @V2D4598 00203000
BP LONGCH POSITIVE, O.K. @V2D4598 00204000
L R1,BUFLNG TAKE DEFAULT BUFFER LENGTH @VA08832 00205000
STH R1,RDSIZE3+1 PUT IN PLIST @VA07909 00205100
B LONGSTCM GO DO THE READ @VA07909 00205200
LONGCH CH R1,=H'2030' CP CAN'T HANDLE MORE THAN THAT @V2D4598 00207000
BNH LONGSTCM IT GIVES CHANNEL PROGCHECK @V2D4598 00208000
LH R1,=H'2030' 2K BYTES OF INPUT SHOULD DO IT @V2D4598 00209000
LONGSTCM STCM R0,B'0111',4+TOLNGADR(R2) @V2D4598 00210000
STH R1,4+TOLNGLEN(,R2) @V2D4598 00211000
SLR R15,R15 ZERO BUFFER SO WE CAN COUNT @V2D4598 00212000
MVCL R0,R14 THE BYTES READ @V2D4598 00213000
RETRY LA R1,4(,R2) SET R1 FOR 'STNEWCON' 00214000
L R15,=V(DMSCITB) CALL IT 00215000
BALR 14,15 00216000
LTR 15,15 WAS SIO SUCCESSFUL? 00217000
BZ WAIT YES, GO WAIT FOR COMPLETION 00218000
CLI CSW+4,X'90' PENDING ATTENTION 00219000
BE RETRY YES, IGNORE IT 00220000
CRDERR DMSERR TEXT='PERMANENT CONSOLE ERROR',NUM=171, X00221000
TYPCALL=BALR,HALT=YES,LET=T 00222000
B CRDERR 00223000
* 00224000
EJECT 00225000
WAIT LA 1,WAITLST GET WAIT PARAM LIST 00226000
L 15,=V(WAIT) CALL WAIT VIA BALR (FASTER) 00227000
BALR 14,15 (24 SEPTEMBER 1968) 00228000
TM TSOFLAGS,TSOATCNL ATTENTION DURING READ ? P3108 00229000
BNO CKFINRD NO, GO CHECK FOR FINISHED READ 00230000
B SCAN CLEAN UP BUFFER AND EXIT 00231000
* 00232000
EJECT 00233000
SCAN EQU * 00234000
MVI CLNFLG,0 RESET LINE ALTERED FLAG 00235000
L 3,RDBUFADD-1 SET R3 TO ADDRESS OF USERS INPUT BUFFER 00236000
* @V2D4598 00237000
TM CONINBLK+4,LONGOP IF THIS WAS A LONG READ, @V2D4598 00238000
BO LONGOPER GO MOVE LONG @VA06430 00239000
TM RDTYPE,X'80' IS THIS EDIT=PHYS? @VA06430 00240000
BO SCANON NO, SCAN IN 130 BYTE BUFFER @VA06430 00241000
LH R5,RDSIZE3+1 GET USERS LENGTH @VA06430 00242000
LTR R5,R5 DOES HE HAVE A LENGTH? @VA07389 00243000
BZ SCANON NO, GIVE HIM 130-- @VA07389 00244000
CL R5,BUFLNG IS BUFFER TOO LONG? @VA07632 00244100
BNH LGNOK BRANCH IF LENGTH IS OK @VA07632 00244200
L R5,BUFLNG OBTAIN MAX BUFFER LENGTH @VA07632 00244300
LR R0,R3 GET BUFFER ADDRESS @VA07909 00244310
LH R1,RDSIZE3+1 GET USERS BUFFER LENGTH @VA07909 00244320
SLR R15,R15 CLEAR R15 @VA07909 00244330
MVCL R0,R14 FILL ENTIRE BUFFER WITH ZEROS @VA07909 00244340
LGNOK EQU * ADJUST FOR MOVE @VA07632 00244400
BCTR R5,0 ADJUST FOR MOVE @VA06430 00245000
LA R4,CONINBUF GET INPUT ADDRESS @VA06430 00246000
EX R5,FINMVC GO MOVE IT @VA06430 00247000
LONGOPER LH R4,RDSIZE3+1 COUNT THE NON-ZERO BYTES IN THE @VA06430 00248000
LA R0,1 @V2D4598 00249000
LONGLOOP CLI 0(R3),X'00' BUFFER AND TELL THE CALLER @V2D4598 00250000
BE LONGEND HOW MUCH HE GOT @V2D4598 00251000
ALR R3,R0 @V2D4598 00252000
BCT R4,LONGLOOP @V2D4598 00253000
LONGEND SH R4,RDSIZE3+1 @V2D4598 00254000
LPR R4,R4 @V2D4598 00255000
STH R4,RDSIZE3+1 @V2D4598 00256000
L R9,AINTRTBL ANY INPUT TABLE? @VA06216 00257000
LTR R9,R9 @VA06216 00258000
BZ LONGE2 NO, NO TRANSLATION @VA06216 00259000
LA R9,LENTBL(R9) SET 1 FOR 1 TRANSLATE TABLE @VA06216 00260000
LR R5,R4 GET LENGTH @VA06216 00261000
L R4,RDBUFADD-1 POINT TO USERS BUFFER @VA06216 00262000
BCTR R5,0 SET FOR EXECUTE @VA06216 00263000
LTR R5,R5 @VA06216 00264000
BM LONGE2 IF NONE, QUIT @VA06216 00265000
LONGE1 EQU * @VA06216 00266000
LR R15,R5 GET COPY OF LENGTH @VA06216 00267000
C R5,F255 MORE THAN MAX? @VA06216 00268000
BNH LONGEOK NO, USE REMAINING LENGTH @VA06216 00269000
L R15,F255 SET TO MAX @VA06216 00270000
LONGEOK EQU * @VA06216 00271000
EX R15,DTRUPR TRANSL ACCORDING TO USER @VA06216 00272000
LA R4,1(R4,R15) POINT TO BUFFER SPOT @VA06216 00273000
SR R5,R15 CALC REMAINING LENGTH @VA06216 00274000
BP LONGE1 STILL SOME LEFT. @VA06216 00275000
LONGE2 EQU * @VA06216 00276000
TM CONINBLK+4,RDATTNZ IF ENDED BY ATTENTION, @VA06216 00277000
BNO EXIT ( IT WASN'T) @VA06216 00278000
LA R15,FOUR GIVE A R.C.OF 4 @VA06216 00279000
B TEXIT LONG READS ARE EASY... @VA06216 00280000
SCANON EQU * @VA06216 00281000
MVI 0(R3),ZERO ASSUME ZERO FILL IN BUFFER @VA06216 00282000
TM MSK,BLNKFILL IS IT? @VA06216 00283000
BZ FILLUP YES, FILL REST OF BUFFER @VA06216 00284000
MVI 0(3),C' ' NO, RESET FIRST BYTE WITH BLANK 00285000
FILLUP MVC 1(129,3),0(3) MOVE FIRST CHARACTER TO REMAINDER OF BUFF 00286000
LA R4,CONINBUF SET R4 TO ADDRESS OF REAL LINE 00287000
LA 5,130 COMPUTE NUMBER OF CHAR. TYPED IN 00288000
LA 14,1 SET R14 TO CONSTANT 1 00289000
TM MSK,CLEANUP IS CLEANUP DESIRED? 00290000
BO CLEAN YES GO DO IT 00291000
LR R1,R4 POINT R1 TO BEGINNING OF LINE 00292000
CK0 CLI 0(R1),00 LOOK FOR DELIMITER OF BINARY 00 00293000
BE GETLRL BE IF FOUND. 00294000
AR R1,R14 IF NOT YET, BUMP R1 UP BY 1, 00295000
BCT R5,CK0 AND KEEP CHECKING. 00296000
GETLRL SR R1,R4 R1 NOW = BYTE-COUNT OF LINE, 00297000
LR R5,R1 PLACE IN R5 FOR LATER USE 00298000
B CONN1 GO CHECK FOR TRANS AND FINISH @VA07386 00299000
EJECT 00300000
* 00301000
* CHARACTERS WERE TYPED IN, AND CLEANUP(AT LEAST) IS DESIRED 00302000
* 00303000
CLEAN SR 1,1 00304000
SR 2,2 CLEAR R1/R2 FOR 'TRT' 00305000
SR 5,14 SET CHARACTER COUNT DOWN 1 FOR 'EX' 00306000
LA R9,DMSCRDTB IF NOT, USE STD. TABLE 00307000
NULIN LR 6,4 R6 WILL BE START OF LOGICAL LINE 00308000
DOTRT EX 5,DTRT START SCAN 00309000
BC 6,JUMP-4(2) IF CC = 1/2 GO TO BREAK ROUTINE 00310000
AR 5,6 CLEAN SCAN, R5=A(LAST CHR) 00311000
SR 5,4 R5=LENGTH OF LINE-1 00312000
AR 5,14 R5=LENGTH OF LINE 00313000
B FINI GO FINISH UP. 00314000
* 00315000
LSTDELE SR 1,14 00316000
ENDLINE SR R1,R4 END OF REAL/LOGICAL LINE, COMPUTE LENGTH 00317000
LTR 5,1 SET R5 TO LENGTH 00318000
BP FINI GO FINISH UP IF LINE NOT NULL. JS 00319000
CLI CLNFLG,0 WAS ANY PART OF THE LINE ALTERED? 00320000
BE FINI NO, RETURN A ZERO COUNT 00321000
B REREAD YES, GO PUT UP THE READ AGAIN 00322000
* 00323000
B NULIN GO START OVER AGAIN. 00324000
* 00325000
JUMP DS 8X 00326000
B ENDLINE 12 - IF BINARY 00, END-OF-LINE REACHED 00327000
* 16 - IF LINEND CHAR., LOGICAL END OF LINE... 00328000
* 00329000
PNDSIGN TM CLNFLG,04 DID WE ALREADY HAVE A LINEND-CHAR ? JS 00330000
BO PND2 BO IF YES, KEEP ADDRESS OF 1ST ONE. JS 00331000
ST R1,LINADD IF NOT, STORE ADDRESS OF LINEND CHAR. JS 00332000
OI CLNFLG,04 SET FLAG-BIT FOR THE FUTURE JS 00333000
PND2 AR R5,R6 SET R5 = LOCATION OF LAST CHAR., JS 00334000
AR R1,R14 LET R1 POINT TO NEXT CHARACTER, JS 00335000
LR R6,R1 PLACE IN R6 IF WE CAN CONTINUE, JS 00336000
SR R5,R6 NOW R5 = REMAINING (CHAR. COUNT - 1) JS 00337000
BNM DOTRT RE-ISSUE 'TRT' FOR REST OF LINE, JS 00338000
B ENDLINE BUT BE WARY OF LINEND = VERY LAST CHAR. 00339000
* 00340000
FSTDELE SR 5,14 REDUCE COUNT BY 1 00341000
BM LSTDELE IF ONLY CHAR, GO AWAY 00342000
EX 5,DMVC3 ELSE PACK LOGICAL/REAL LINE DOWN 1 00343000
B NULIN AND GO START OVER AGAIN 00344000
* 00345000
DTRT TRT 0(*-*,R6),0(R9) TO APPLY DELETE-TABLE TO INPUT LINE JS 00346000
DMVC1 MVC 0(0,1),2(1) 00347000
DMVC2 MVC 0(0,4),1(1) 00348000
DMVC3 MVC 0(0,4),1(4) 00349000
EJECT 00350000
* CLEAN-UP ALL FINISHED, NOW 'FINISH UP' ... JS 00351000
FINI TM CLNFLG,04 DID WE HAVE ANY LINEND CHARACTERS ? JS 00352000
BZ CKUPPR BZ IF NOT (NO PROBLEM) JS 00353000
L R1,LINADD ADDRESS OF 1ST LINEND-CHAR INTO R1 JS 00354000
TM CLNFLG,03 DID WE DO ANY CLEANUP ? JS 00355000
BZ JBREAK BZ IF NOT (GOOD SHOW), R1 = CORRECT. JS 00356000
LR R6,R4 START AT BEGINNING OF LINE, JS 00357000
EX R5,DTRT TRY TO FIND FIRST LINEND CHARACTER JS 00358000
BC 6,JBREAK0 TRANSFER IF WE FOUND SOMETHING JS 00359000
CKUPPR TM MSK,UCASE IS UPPER CASE TRANSLATION DESIRED? 00360000
BZ CONN1 NO, BR TO CHECK FOR USERTABLE @VA02244 00361000
* ONLY 00362000
SR 5,14 YES, SET R5 FOR 'EX' 00363000
BM REST5 IF NEGATIVE, DON'T TRANSLATE. 00364000
L R9,AINTRTBL USER-SET-UP TRANSLATE TABLE PROVIDED ? 00365000
LTR R9,R9 ... 00366000
BP EXUP BP IF YES, USE IT. 00367000
LA R9,DMSCRDUP IF NOT, USE STD. UPPER CASE TBL 00368000
EXUP EX R5,DTRUPR TRANSLATE TO UPPER CASE, ETC. 00369000
REST5 AR R5,R14 RESTORE R5 00370000
* 00371000
CONT1 STH 5,RDSIZE3+1 SET THE LENGTH IN USERS PLIST 00372000
SR 5,14 REDUCE R5 FOR 'EX' 00373000
BM EXIT IF NEG., SKIP MOVE 00374000
EX 5,FINMVC MOVE LINE TO USER CORE 00375000
EXIT SR 15,15 CLEAR ERROR REG 00376000
TEXIT L 14,SAV14 GET RETURN ADDRESS 00377000
BR 14 RETURN TO CALLER 00378000
CONN1 L R9,AINTRTBL GET USER TABLE ADDRESS IF ANY @VA02244 00379000
LTR R9,R9 IS THERE ONE? @VA02244 00380000
BZ CONT1 NO, CONTINUE @VA02244 00381000
LA R9,256(R9) SET 1 FOR 1 TRANSLATE TABLE @VA02244 00382000
* (LOWERCASE) 00383000
SR R5,R14 DECREMENT FOR 'EX' @VA02244 00384000
BM REST5 NO TRANSLATION IF NEGATIVE @VA02244 00385000
B EXUP TRF TO 'EX' ROUTINE @VA02244 00386000
EJECT 00387000
* KEEP 'DELTBL' AND 'UPPRTAB' IN ORDER SO 'UPPRTAB' TABLE IS 00388000
* KNOWN TO IMMEDIATELY FOLLOW 'DELTBL' (256 BYTES LATER)... 00389000
* 00390000
DS 0D @V2D4598 00391000
WAITPSW DC X'00060000',CL4'CON1' @V2D4598 00392000
DMSCRDTB DS 0D DELETE-TABLE FOR CMS CONSOLE READING 00393000
DC X'0C',20X'00' '0C' = 12 FOR X'00' 00394000
DC X'10',52X'00' '10' = 16 FOR NEW LINE CHARACTER 00395000
DC 182X'00' 00396000
* 00397000
DMSCRDUP EQU * UPPERCASE TRANSLATION TABLE 00398000
* FOR 1050/1052/2741 00399000
DC X'000102030405060708090A0B0C0D0E0F' 00400000
DC X'101112131415161718191A1B1C1D1E1F' 00401000
DC X'202122232425262728292A2B2C2D2E2F' 00402000
DC X'303132333435363738393A3B3C3D3E3F' 00403000
DC X'404142434445464748494A4B4C4D4E4F' 00404000
DC X'505152535455565758595A5B5C5D5E5F' 00405000
DC X'606162636465666768696A6B6C6D6E6F' 00406000
DC X'707172737475767778797A7B7C7D7E7F' 00407000
DC X'80C1C2C3C4C5C6C7C8C98A8B8C8D8E8F' 00408000
DC X'90D1D2D3D4D5D6D7D8D99A9B9C9D9E9F' 00409000
DC X'A0A1E2E3E4E5E6E7E8E9AAABACADAEAF' 00410000
DC X'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF' 00411000
DC X'C0C1C2C3C4C5C6C7C8C9CACBCCCDCECF' 00412000
DC X'D0D1D2D3D4D5D6D7D8D9DADBDCDDDEDF' 00413000
DC X'E0E1E2E3E4E5E6E7E8E9EAEBECEDEEEF' 00414000
DC X'F0F1F2F3F4F5F6F7F8F9FAFBFCFDFEFF' 00415000
* 00416000
* 00417000
DTRUPR TR 0(*-*,R4),0(R9) TO TRANSLATE TO UPPER CASE, ETC. 00418000
FINMVC MVC 0(0,3),0(4) 00419000
* 00420000
JBREAK0 CLI 0(R1),X'15' IS CHARACTER A LINEND CHARACTER ? 00421000
BE JBREAK 00422000
B CKUPPR IF NOT, FORGET IT 00423000
* 00424000
JBREAK L R1,LINADD ADDRESS OF 1ST NEW LINE CHAR 00425000
SR 1,4 COMPUTE LENGTH OF LOGICAL LINE 00426000
SR 5,1 REMAINDER 00427000
SR 5,14 SUBRACT 1 00428000
LA 6,1(1,4) ADDRESS OF NEXT LOGICAL LINE 00429000
ST 6,STKADR SETUP PLIST FOR ATTN 00430000
STC 5,STKADR AND LENGTH 00431000
LR 5,1 00432000
MVC ATTNLIST(12),ATTN MOVE IN FIRST TWELVE BYTES AS NEEDED 00433000
LR R1,R13 AND USE P-LIST IN SCRATCH-AREA. 00434000
STM R12,R5,CRDSAV SAVE REGISTERS 00435000
LR R5,R13 REMEMBER SAVE AREA LOCATION 00436000
L R15,=V(DMSCAT) STACK REMAINDER OF LINE 00437000
BALR R14,R15 00438000
LR R13,R5 RESTORE SAVE PTR 00439000
LM R12,R5,CRDSAV RESTORE REGISTERS 00440000
B CKUPPR NOW CHECK FOR UPPER CASE, & MOVE TO USER. 00441000
ATTN DS 0C 12 BYTES DUMMY P-LIST ... 00442000
DC CL8'ATTN' 00443000
DC CL4'LIFO' USE "LAST-IN-FIRST-OUT" OPTION 00444000
F255 DC F'255' @VA06216 00445000
BUFLNG DC F'130' MAX BUFFER LENGTH @VA07632 00445100
LENTBL EQU 256 @VA06216 00446000
ZERO EQU 0 @VA06216 00447000
FOUR EQU 4 @VA06216 00448000
LTORG @V2D4598 00449000
EJECT 00450000
SCRATCH DSECT SCRATCH-AREA (R13) PROVIDED BY SVCINT 00451000
ATTNLIST DS CL8'ATTN' ... 00452000
DS CL4'LIFO' ... 00453000
STKADR DS 1F'0' ... 00454000
* 00455000
SAV14 DS 1F (R14 SAVED HERE) 00456000
LINADD DS 1F ADDRESS OF 1ST LINEND-CHAR. FOUND 00457000
MSK DS X (SCRATCH-STORAGE) 00458000
CLNFLG DS X " 00459000
CRDSAV DS 10F USED TO STORE REGS 12-5 @VA10779 00460000
* 00461000
NUCDSECT DSECT 00462000
NCDEVAD DS H 00463000
NCSTATS DS H 00464000
NCWAITB EQU NCSTATS 00465000
NCDEVTP EQU NCSTATS+1 00466000
NCNAME DS CL4 00467000
NCINTRTN DS A 00468000
NUCNSIZE EQU *-NUCDSECT 00469000
* 00470000
READSECT DSECT 00471000
DS CL8 00472000
RDTERMNO DS AL1 00473000
RDBUFADD DS AL3 00474000
RDTYPE DS C 00475000
RDSIZE3 DS AL3 00476000
* 00477000
SPACE 2 00478000
* @V2D4598 00479000
* EQUATES TO DESCRIBE CONSOLE-OP STRINGS @V2D4598 00480000
* @V2D4598 00481000
LNNORMOP EQU 2 LENGTH OF NORMAL READ-OP @V2D4598 00482000
LNLONGOP EQU 6 '' '' LONG READ-OP @V2D4598 00483000
TONRMLEN EQU 1 OFFSET TO NORMAL LENGTH-BYTE @V2D4598 00484000
TOLNGLEN EQU 4 OFFSET TO LONG LENGTH-HALFWORD @V2D4598 00485000
TOLNGADR EQU 1 OFFSET TO LONG BUFFADDR @V2D4598 00486000
* @V2D4598 00487000
* EQUATES FOR BITS IN HIGH HALF OF READ OPCODE @V2D4598 00488000
* @V2D4598 00489000
RDATTNZ EQU X'80' READ TERMINATED BY ATTN @V2D4598 00490000
FROMATTN EQU X'40' READ IN RESPONSE TO ATTN @V2D4598 00491000
NOATTN EQU X'20' DON'T RETRY AFTER ATTN @V2D4598 00492000
LONGOP EQU X'10' READ TO CALLER'S BUFFER @V2D4598 00493000
EJECT 00494000
NUCON 00495000
IO 00496000
FVS 00497000
REGEQU 00498000
END 00499000