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