ibm:vm370-lib:cms:dmscrd.assemble_src
Table of Contents
DMSCRD Source
References
- Fixes Applied : 2
- This Source Date : Tuesday, December 12, 1978
- Last Fix ID : [HRC002DS]
Source Listing
- DMSCRD.ASSEMBLE.txt
- 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
ibm/vm370-lib/cms/dmscrd.assemble_src.txt · Last modified: 2023/08/06 13:35 by Site Administrator