SCR TITLE 'DMSSCR (CMS) VM/370 - RELEASE 6' 00001000 SPACE 2 00002000 *. 00003000 *************************************************************** 00004000 * MODULE NAME: 00005000 * 00006000 * DMSSCR 00007000 * 00008000 * FUNCTION: 00009000 * 00010000 * LOAD DISPLAY BUFFERS AND CREATE A PARAMETER LIST FOR 00011000 * MODULE DMSGIO. 00012000 * 00013000 * ATTRIBUTES: 00014000 * 00015000 * EXECUTES IN USER AREA AS PART OF EDIT LOAD MODULE. 00016000 * 00017000 * ENTRY POINT: 00018000 * 00019000 * DMSSCR 00020000 * 00021000 * ENTRY CONDITIONS: 00022000 * 00023000 * GPR 14 CONTAINS A RETURN ADDRESS. 00024000 * 00025000 * EXIT CONDITIONS: 00026000 * 00027000 * NORMAL .. GPR 15 = 0 00028000 * 00029000 * ERROR .. GPR 15 = 4 ERROR WRITING TO SCREEN 00030000 * 00031000 * CALLS TO OTHER ROUTINES: 00032000 * 00033000 * DMSGIO 00034000 * 00035000 * EXTERNAL REFERENCES: 00036000 * 00037000 * CONTROL BLOCKS IN DMSEDI 00038000 * 00039000 * BLOC 00040000 * PTRCONS 00041000 * SCRINFO 00042000 * 00043000 * OUTPUT: 00044000 * 00045000 * DISPLAY BUFFERS ARE FILLED AND MAINTAINED BY THIS 00046000 * MODULE. THE DATA ADDRESS TO BE WRITTEN, THE LENGTH 00047000 * OF DATA, AND THE PHYSICAL LINE TO WRITE TO IS PASSED 00048000 * BY THIS MODULE TO DMSGIO. 00049000 * 00050000 * 00051000 * OPERATION: 00052000 * 00053000 * UPON ENTRY TO THIS ROUTINE THE TWO BYTES LABELLED 00054000 * SCRFLGS, AND SCRFLG2 WILL BE SET TO INDICATE THE 00055000 * FOLLOWING: 00056000 * 00057000 * SCRFLGS= X'80' REWRITE THE STATUS AREA 00058000 * 00059000 * SCRFLGS= X'40' WRITE THE CURRENT LINE TO LINE 9 OF ALL DISPLAYS 00060000 * EXCEPT 3278 MOD 2A WHICH IS LINE 7 00061000 * 00062000 * SCRFLGS= X'20' WRITE FROM THE CURRENT LINE DOWN TO THE 00063000 * BOTTOM OF THE OUTPUT AREA. 00064000 * 00065000 * SCRFLGS= X'02' WRITE FROM CURRENT LINE UP TO TOP 00066000 * 00067000 * 00068000 * SCRFLG2= X'80' CAUSE CP MORE STATUS. ISSUED WITH A 00069000 * COMPLETE WRITE REQUEST. 00070000 * 00071000 * SCRFLG2= X'40' CAUSE AN EFFECTIVE OPERATOR CANCEL. 00072000 * 00073000 * SCAFLG2= X'04' WRITE LAST COMMAND TO INPUT AREA 00074000 * 00075000 * 00076000 * DMSSCR USES THE FLAG BITS TO LOAD A DISPLAY BUFFER 00077000 * AREA WHICH IS LOCATED IN USER FREE STORAGE. THIS AREA 00078000 * WAS OBTAINED BY DMSEDX DURING INITIALIZATION. 00079000 * 00080000 * FILEID INFORMATION IS OBTAINED FROM CONTROL BLOCKS 00081000 * IN DMSEDI. EDITOR STATUS IS DETERMINED BY FLAG BITS 00082000 * IN DMSEDI INDICATING 'NEW FILE','EDIT MODE',OR 00083000 * 'INPUT MODE'. 00084000 * 00085000 * THE LENGTH AND ADDRESS OF A MESSAGE TO BE WRITTEN 00086000 * ARE LOCATED IN REGISTERS 0 AND 1 RESPECTIVELY AT 00087000 * ENTRY TO THIS MODULE. 00088000 * 00089000 * THE TRUNCATION COLUMN IS USED TO DETERMINE THE 00090000 * LENGTH OF THE CURRENT LINE TO BE PLACED IN THE INPUT 00091000 * AREA BUFFER. IN THE CASE OF A DISPLAY CHANGE COMMAND 00092000 * WITH LINEMODE IN EFFECT, THE LINE NUMBER IS NOT 00093000 * WRITTEN IN THE INPUT AREA WITH THE REST OF THE DATA. 00094000 * IT IS THEREBY PROTECTED FROM ALTERATION BY THE USER. 00095000 * 00096000 * LOADING OUTPUT AREA BUFFERS 00097000 * 00098000 * THE OUTPUT BUFFERS ARE ALWAYS LOADED SO THAT LINE 9 00099000 * OF THE DISPLAY ALWAYS CONTAINS THE CURRENT LINE UNLESS 00100000 * IT IS A 3278 MOD 2A THEN IT IS LINE 7. IF 00101000 * THE VERIFICATION COLUMN IS GREATER THAN 80, TWO LINES 00102000 * MAY BE USED TO DISPLAY THE RECORD. 00103000 * TRAILING BLANKS IN A RECORD ARE IGNORED IN DETERMIN- 00104000 * ING WHETHER OR NOT A RECORD WILL REQUIRE TWO DISPLAY 00105000 * LINES. 00106000 * THE CURRENT LINE IS THE FIRST TO BE LOADED INTO THE 00107000 * BUFFER AREA. 00108000 * ENOUGH RECORDS FOLLOWING THE CURRENT LINE TO FILL 00109000 * THE REMAINING LOWER OUTPUT BUFFER AREA ARE THEN 00110000 * LOADED. 00111000 * THEN THE LINES PRECEDING THE CURRENT LINE ARE 00112000 * LOADED IN REVERSE ORDER, THAT IS, LINE 8, LINE 7, ETC, 00113000 * THROUGH LINE 2. 00114000 * IN THE CASE OF TOP OF FILE OR END OF FILE BEING 00115000 * ENCOUNTEREDIN LOADING THE BUFFER AREA, THE REMAINING 00116000 * BUFFER LINES IN THE OUTPUT AREA ARE PADDED WITH 00117000 * BLANKS. 00118000 * 00119000 * WHEN THE REQUESTED BUFFERS HAVE BEEN LOADED A 00120000 * PARAMETER LIST IS GENERATED USING THE UPPER AND LOWER 00121000 * LIMITS OF THE WRITE REQUEST TO CALCULATE THE NUMBER 00122000 * OF BYTES TO BE WRITTEN. A CALL IS MADE TO DMSGIO FOR 00123000 * ISSUANCE OF THE CP DIAGNOSE TO WRITE TO THE DISPLAY. 00124000 * 00125000 * UPON RETURN FROM DMSGIO, DMSSCR RETURNS TO THE CALLER 00126000 * WITH CP'S DIAGNOSE RETURN CODE IN REGISTER 15. 00127000 * 00128000 * 00129000 *************************************************************** 00130000 *. 00131000 SPACE 2 00132000 EJECT 00133000 DMSSCR START 0 00134000 USING DMSSCR,R15 TEMP ADDRESSABILITY 00135000 USING EDCB,R13 @V305614 00136000 STM R0,R14,SAVEAR SAVE INCOMING REGISTERS @V2D3913 00137000 LR R12,R15 CHANGE BASE 00138000 DROP R15 00139000 USING DMSSCR,R12 NEW ADDRESSABILITY 00140000 L R11,SCRBUFAD GET ADR OF BUFFER 00141000 USING SCRBUF,R11 00142000 MVI FLAGLOC,X'00' RESET GIO PLIST @V2D3913 00143000 MVC HOLDFLAG(1),SCRFLGS FOR BETTER PAGING @V2D3913 00144000 NI UTILFLAG,255-TWOLINES RESET UTILFLAG CAREFULLY @V2D3913 00145000 TM HOLDFLAG,WRSTATB CALL TO REWRITE STATUS LINE @V2D3913 00146000 BNO CLRMSG NO, KEEP CHECKING @V2D3913 00147000 EJECT 00148000 FILLHED MVI BUF0,X'40' PREPARE TO CLEAR 00149000 MVC BUF0+1(79),BUF0 BLANK OUT THE STATUS BUFFER @V2D3913 00150000 MVC NAME(8),FNAME PLUG NAME 00151000 MVC TYPE(8),FTYPE PLUG TYPE 00152000 MVC MODE(2),FMODE PLUG MODE 00153000 MVC LVL,EDITLVL 00153010 L R5,ITEM GET RECORD LENGTH 00154000 CVD R5,DECLTH CONVERT TO DECIMAL 00155000 MVC EDMSK,PATRN MASK FOR EDIT OP 00156000 ED EDMSK,DECLTH+6 EDIT LENGTH FIELD 00157000 MVC LTH(3),EDMSK+1 MOVE TO BUFFER 00158000 MVC SFV(1),FV PLUG FORMAT 00159000 MVC ZN,=C'ZONE=' 00159010 MVC VER,=C'VERFY=' 00159020 MVC CSE,=C'CASE=' 00159030 MVC TNCC,=C'TRUNC=' 00159040 MVI ZNH,C'-' 00159050 MVI VERH,C'-' 00159060 MVI CASE,C'U' 00159070 CLI CASESW,C'U' IS IT? 00159080 BE *+8 SKIP IS SO 00159090 MVI CASE,C'M' NOPE MOVE M 00159100 LH R5,ZONE1 GET FIRST ZONE CHAR 00159110 LA R5,1(0,R5) BUMP 00159120 CVD R5,DECLTH CONVERT TO DECIMAL 00159130 MVC EDMSK,PATRN MASK FOR EDIT OP 00159140 ED EDMSK,DECLTH+6 EDIT LENGTH FIELD 00159150 MVC ZNS(3),EDMSK+1 MOVE TO BUFFER 00159160 LH R5,ZONE2 GET END OF ZONE 00159170 CVD R5,DECLTH CONVERT TO DECIMAL 00159180 MVC EDMSK,PATRN MASK FOR EDIT OP 00159190 ED EDMSK,DECLTH+6 EDIT LENGTH FIELD 00159200 MVC ZNE(3),EDMSK+1 AND MOVE TO HEADER LINE 00159210 LH R5,TRUNCOL 00159220 CVD R5,DECLTH CONVERT TO DECIMAL 00159230 MVC EDMSK,PATRN MASK FOR EDIT OP 00159240 ED EDMSK,DECLTH+6 EDIT LENGTH FIELD 00159250 MVC TNC(3),EDMSK+1 AND MOVE TO HEADER LINE 00159260 LH R5,VERCOL1 00159270 CVD R5,DECLTH 00159280 MVC EDMSK,PATRN 00159290 ED EDMSK,DECLTH+6 00159300 MVC VERS(3),EDMSK+1 00159310 LH R5,VERCOL2 00159320 CVD R5,DECLTH 00159330 MVC EDMSK,PATRN 00159340 ED EDMSK,DECLTH+6 00159350 MVC VERE(3),EDMSK+1 00159360 MVC STAT(5),EDMSG ASSUME EDIT MODE 00160010 TM FLAG2,NUFILE BUT, TEST FOR NEW FILE @V2D3913 00161000 BNO NOTNU NO...BR 00162000 MVC STAT(5),NEWFMSG ASSUME EDIT MODE 00163010 NI FLAG2,255-NUFILE RESET NEW FLAG 00164000 B CLRMSG GO CLEAR MSG LINE 00165000 NOTNU TM FLAG2,INMODE INPUT MODE ? 00166000 BNO CLRMSG NO, IT WAS EDIT MODE @V2D3913 00167000 MVC STAT(5),INPMSG ASSUME EDIT MODE 00168010 CLRMSG MVI BUF1,X'40' GET A BLANK @V2D3913 00169000 MVC BUF1+1(79),BUF1 CLEAR THE MESSAGE BUFFER @V2D3913 00170000 TM HOLDFLAG,WRMSGB MESSAGE TO WRITE ? @V2D3913 00171000 BNO NOSPEC NO ... BR @V2D3913 00172000 MVC BUF1(5),RTPTR SET LEFT POINTERS @V2D3913 00173000 LA R4,MSGTXT POINT TO LINE ADDR @V2D3913 00174000 LA R5,74 LENGTH OF REMAINING LINE @V2D3913 00175000 L R7,SAVEAR GET INCOMING R0 (MSG LN) @V2D3913 00176000 L R6,SAVEAR+4 GET INCOMING R1 (MSG ADDR) @V2D3913 00177000 BAL R15,MOVESEG MOVE THE MESSAGE @V2D3913 00178000 OI UTILFLAG,MSG FLAG THAT MESSAGE IS IN BUFFER @V2D3913 00179000 NOSPEC LA R1,80 LINE LENGTH OF 80 00180000 CLI TYPSCR,X'05' 3278 MODEL 5? HRC073DS 00180100 BNE *+8 No HRC073DS 00180200 LA R1,132 Else line length is 132 HRC073DS 00180300 L R2,PTR2 GET CL POINTER @V2D3913 00181000 SLR R10,R10 ZERO ALTERNATE SIZE INDEX REG. @V60A6B6 00182000 SPACE 00183000 *********************************************************************** 00184000 ** THE FOLLOWING CODE CHANGES THE MODEL NUMBER OF 3278 MOD 2A TO 6 73DS 00185000 ** IN TYPSCR SO THAT THE DISPLACMENT OF 16 (6-2*4=16) INTO SCRPRMSZ73DS 00186000 ** CAN BE ESTABLISHED. IF THE ACTUAL MODEL NUMBER OF 6 IS EVER USED73DS 00187000 ** THIS CODE MUST BE CHANGED HERE. ** 00188000 *********************************************************************** 00189000 SPACE 00190000 CLI TYPSCR,MODEL2A IS THIS A 3278 MODEL 2A? @V60A6B6 00191000 BNE NOT2A NO NOT TODAY @V60A6B6 00192000 MVI TYPSCR,6 MOVE 6 FOR INDEX TO MODEL 2A HRC073DS 00193000 IC R10,TYPSCR LOAD UP THE MODEL NUMBER @V60A6B6 00194000 SH R10,TWO COMPUTE SCREEN SIZE INDEX @V60A6B6 00195000 MH R10,FOUR . . . @V60A6B6 00196000 B INDEXSET @V60A6B6 00197000 NOT2A EQU * 00198000 IC R10,TYPSCR LOAD THE MODEL NUMBER @V60A6B6 00199000 SH R10,TWO COMPUTE SCREEN SIZE INDEX @V60A6B6 00200000 MH R10,FOUR . . . @V60A6B6 00201000 INDEXSET EQU * 00202000 L R10,SCRPRMSZ(R10) AND CALCULATE FIELD OFFSET @V60A6B6 00203000 LA R10,SCRPARMS(R10) GET CORRECT TABLE OF SIZES @V60A6B6 00204000 USING SCRSIZES,R10 ADDRESSABILITY TO THIS TABLE @V60A6B6 00205000 TM SCRFLG2,CANCB CANCEL REQUEST ? @V2D3913 00206000 BO CANCOP YES ... BR @V2D3913 00207000 TM SCRFLG2,WRCLINB WRITE CL TO INPUT AREA ? @V2D3913 00208000 BO WRCLIN YES 00209000 TM SCRFLG2,CMDINB WRITE LAST CMND TO INPUT AREA ? @V2D3913 00210000 BO WRLAST YES 00211000 TM HOLDFLAG,WRCLB+WRCLDNB+WRCLUPB AREA SPECIFIED ?@V2D3913 00212000 BNZ FILLBUFF YES, THEN DO IT @V2D3913 00213000 B FINDHIGH ELSE BUFFER IS SET @V2D3913 00214000 EJECT 00215000 WRCLIN EQU * WRITE CL INTO INPUT AREA 00216000 BAL R15,CMPRESS COMPRESS INPUT LINE TO ALLOW @V2D3914 00217000 LR R3,R7 KEYBOARD INSERTIONS @V2D3914 00218000 LH R7,TRUNCOL GET TRUNCATION COLUMN 00219000 LA R6,8(,R2) GET LINE ADDR 00220000 TM FLAG,LEFT+RIGHT LINEMODE ON ? 00221000 BZ INPUTLD NO...BR 00222000 TM FLAG,RIGHT LINEMODE RIGHT ? 00223000 BO RTLINE YES...BR 00224000 MVC SCLNO(8),8(R2) SAVE SEQ NUMBER 00225000 LA R6,14(,R2) SKIP SEQ NUMBER 00226000 TM FLAG,LINE8 LONG SEQ NUMBER ? 00227000 BNO LENCALC NO...BR 00228000 LA R6,16(,R2) SKIP LONG SEQ NUMB 00229000 LENCALC LA R7,8(R7,R2) TRUNC END ADDRESS 00230000 SR R7,R6 CAL INPUT TEXT LGTH 00231000 BNM INPUTLD COULD END UP MINUS @V305614 00232000 SR R7,R7 IF SO, CALL IT ZERO LENGTH @V305614 00233000 B INPUTLD LOAD BUFFER 00234000 RTLINE EQU * 00235000 MVC SCLNO(5),83(R2) SAVE RIGHT SEQ NUMB 00236000 B INPUTLD LOAD INPUT BUFFER 00237000 SPACE 1 00238000 WRLAST EQU * WRITE LAST COMMAND TO INPUT 00239000 LA R6,TABLIN ADR OF SAVED COMMAND @V305614 00240000 LA R3,161 FORCE LENGTH REGISTER USAGE @V305614 00241000 LH R7,SAVCNT LENGTH OF SAVED COMMAND 00242000 INPUTLD LH R4,INOFFSET GET INPUT BUFFER OFFSET @V60A6B6 00243000 LA R4,BUF0(R4) GET INPUT BUFFER ADDR @V60A6B6 00244000 LA R5,136 INPUT AREA LENGTH 00245000 CR R3,R7 DO THIS FOR 3270 CHARACTER @V305614 00246000 BNL INLD1 INSERTION @V305614 00247000 LR R7,R3 TRANSFER LOWER NUMBER @V305614 00248000 INLD1 LR R3,R5 KEEP INPUT LENGTH HERE ALSO @V305614 00249000 ICM R7,B'1000',PAD0 FOR PAD CHARACTER 00250000 MVCL R4,R6 PADDED COMMAND IN INPUT BUFFER 00251000 LH R4,INPUTNUM POINT TO LINE NUMBER @V60A6B6 00252000 B SETRANGE BUILD GIO PLIST @V2D3913 00253000 SPACE 1 00254000 CANCOP EQU * @V2D3913 00255000 MVI FLAGLOC,X'02' SET FLAG FOR GIO PLIST @V2D3913 00256000 LR R3,R1 LENGTH INTO R3 @V2D3913 00257000 LH R4,CLNUMBER LINE PTR FOR FORM'S SAKE @V60A6B6 00258000 B SETRANGE FINISH BUILDING PLIST @V2D3913 00259000 EJECT 00260000 *************************************************************** 00261000 * 00262000 * COMMON ENTRY TO FILL BUFFERS 00263000 * 00264000 *************************************************************** 00265000 SPACE 1 00266000 FILLBUFF EQU * @V2D3913 00267000 LH R4,CLOFFSET GET CL BUFFER OFFSET @V60A6B6 00268000 LA R4,BUF0(R4) GET CL BUFFER ADDR @V60A6B6 00269000 TM TWITCH,TOPSW+EOF ENDRANGE ? @V2D3913 00270000 BNZ CLONE YES ... BR @V2D3913 00271000 BAL R15,CMPRESS ELSE TRUNC TRAILING BLANKS @V2D3913 00272000 BAL R15,MOVELINE AND MOVE DATA TO BUFFER @V2D3913 00273000 L R2,0(,R2) PICK UP NEXT LINE POINTER @V2D3913 00274000 TM UTILFLAG,TWOLINES CL LENGTH > 80 ? @V2D3913 00275000 BO CLTWO YES ... BR @V2D3913 00276000 SPACE 1 00277000 CLONE TM TWITCH,TOPSW AT TOP OF FILE ? @V2D3914 00278000 BNO CLONE1 NO ... BR @V2D3914 00279000 L R2,0(,R2) POINT TO LINE 1 @V2D3914 00280000 LA R4,80(,R4) SET BUFFER POINTER @V60A6B6 00281000 CLI TYPSCR,X'05' 3278 MODEL 5? HRC073DS 00281300 BNE CLONE1 No HRC073DS 00281400 LA R4,52(,R4) Else incr length total by 132 HRC073DS 00281500 CLONE1 TM UTILFLAG,CLGT80B PREVIOUS CL > 80 ? @V2D3913 00282000 BNO CLSET NO ... BR @V2D3913 00283000 NI UTILFLAG,255-CLGT80B RESET FLAG FOR NEXT CALL @V2D3913 00284000 B SETDOWN AND CONTINUE @V2D3913 00285000 SPACE 1 00286000 CLTWO TM UTILFLAG,CLGT80B PREVIOUS CL > 80 ? @V2D3913 00287000 BO CLSET YES, ALL DONE FOR NOW @V2D3913 00288000 OI UTILFLAG,CLGT80B FLAG FOR NEXT CALL THEN @V2D3913 00289000 SETDOWN OI HOLDFLAG,WRCLDNB JUST CHANGE LOWER HALF @V2D3913 00290000 SPACE 1 00291000 CLSET LH R3,INOFFSET GET END OF BUFFER OFFSET @V60A6B6 00292000 LA R3,BUF0(R3) POINT TO END OF BUFFER @V60A6B6 00293000 TM TWITCH,EOF EOF ? @V2D3913 00294000 BO DISPEOF HANDLE SEPARATELY @V2D3913 00295000 TM HOLDFLAG,WRCLDNB WRITE CL DOWN ? @V2D3913 00296000 BO FILLDOWN YES ... BR @V2D3913 00297000 CHECKUP LA R3,BUF2 POINT TO START OF BUFFER @V2D3913 00298000 LH R4,CLOFFSET GET CL OFFSET VALUE @V60A6B6 00299000 LA R4,BUF0(R4) AND POINT TO CL BUFFER @V60A6B6 00300000 TM TWITCH,TOPSW TOF ? @V2D3913 00301000 BO DISPTOF YES, HANDLE SEPARATELY @V2D3913 00302000 TM HOLDFLAG,WRCLUPB WRITE CL UP ? @V2D3913 00303000 BO FILLUP YES ... BR @V2D3913 00304000 B FINDHIGH NOW SET UP GIO PLIST @V2D3913 00305000 EJECT 00306000 *************************************************************** 00307000 * 00308000 * ROUTINE TO FILL BUFFERS DOWN FROM SOME STARTING POINT 00309000 * 00310000 *************************************************************** 00311000 SPACE 1 00312000 FILLDOWN EQU * @V2D3913 00313000 LTR R2,R2 NOW POINTING TO END OF FILE ? @V2D3913 00314000 BZ DISPEOF YES, HANDLE SEPARATELY @V2D3913 00315000 BAL R15,CMPRESS COMPRESS TRAILING BLANKS @V2D3913 00316000 BAL R15,MOVELINE NOW MOVE LINE TO BUFFER @V2D3913 00317000 L R2,0(,R2) ADVANCE TO NEXT INPUT LINE @V2D3913 00318000 CR R3,R4 END OF DISPLAY BUFFER ? @V2D3913 00319000 BH FILLDOWN NO, BR @V2D3913 00320000 B CHECKUP LOWER DISPLAY FINISHED @V2D3913 00321000 SPACE 1 00322000 DISPEOF EQU * @V2D3913 00323000 SR R3,R4 CALC DISTANCE TO END OF BUFFER @V2D3913 00324000 LR R5,R3 LENGTH INTO PROPER REG @V2D3913 00325000 LA R6,EOFREC POINT TO SUBSTITUTE DATA @V2D3913 00326000 LA R7,4 INDICATE ITS TRUE LENGTH @V2D3913 00327000 BAL R15,MOVESEG FILL LOWER BUFFER AS REQUIRED @V2D3913 00328000 B CHECKUP NOW CHECK UPPER BUFFER @V2D3913 00329000 EJECT 00330000 *************************************************************** 00331000 * 00332000 * ROUTINE TO FILL BUFFERS UP FROM SOME STARTING POINT 00333000 * 00334000 *************************************************************** 00335000 SPACE 1 00336000 FILLUP EQU * @V2D3913 00337000 L R2,PTR2 REFRESH CL POINTER @V2D3913 00338000 LA R14,PTR1 DETERMINE ITS UPPER BOUND @V2D3913 00339000 TM TWITCH,EOF AT END OF FILE ? @V2D3913 00340000 BO UPL1 YES ... BR @V2D3913 00341000 SPACE 1 00342000 UPLOOP EQU * @V2D3913 00343000 L R2,4(,R2) BACK UP ONE DATA LINE @V2D3913 00344000 UPL1 SR R4,R1 BACK UP ONE DISPLAY BUFFER @V2D3913 00345000 CR R4,R3 END OF BUFFER (UPWARD) ? @V2D3913 00346000 BL FINDHIGH YES, FILL OUT GIO PLIST @V2D3913 00347000 CR R14,R2 TOP OF FILE ? @V2D3913 00348000 BE DISPTOF YES, HANDLE SEPARATELY @V2D3913 00349000 BAL R15,CMPRESS COMPRESS TRAILING BLANKS @V2D3913 00350000 BNL UPONE BR IF DATA = OR < 80 @V2D3913 00351000 SR R4,R1 BACK UP ONE MORE BUFFER @V2D3913 00352000 UPONE CR R4,R3 BUFFER POOL EXHAUSTED ? @V2D3913 00353000 BNL UPMOVE NO ... BR @V2D3913 00354000 SR R7,R1 DERIVE TRAILING DATA LENGTH @V2D3913 00355000 AR R6,R1 AND ITS STARTING POINT @V2D3913 00356000 AR R4,R1 READJUST BUFFER POINTER @V2D3913 00357000 NI UTILFLAG,255-TWOLINES RESET SIGNAL @V2D3913 00358000 UPMOVE BAL R15,MOVELINE MOVE DATA TO THE BUFFER @V2D3913 00359000 SR R4,R1 BACK UP ANOTHER BUFFER @V2D3913 00360000 TM UTILFLAG,TWOLINES BOUBLE BUFFER REQUIRED ? @V2D3913 00361000 BNO UPLOOP NO ... BR @V2D3913 00362000 NI UTILFLAG,255-TWOLINES RESET SIGNAL @V2D3913 00363000 SR R4,R1 BUT READJUST BUFFER PTR DOWNWARD @V2D3913 00364000 B UPLOOP KEEP ON MOVING @V2D3913 00365000 SPACE 1 00366000 DISPTOF EQU * @V2D3913 00367000 LA R6,TOPMSG POINT TO SUBSTITUTE DATA @V2D3913 00368000 LA R7,4 AND INDICATE ITS LENGTH @V2D3913 00369000 NI UTILFLAG,255-TWOLINES TURN THIS OFF @V2D3914 00370000 BAL R15,MOVELINE FILL BUFFER @V2D3913 00371000 LR R5,R4 MOVE POINTER TO PROPER REG @V2D3913 00372000 LR R4,R3 POINT TO TOP OF SCREEN @V2D3913 00373000 SR R5,R1 BACK UP ONE BUFFER @V2D3913 00374000 SR R5,R3 CALC LENGTH TO BE BLANKED @V2D3913 00375000 LA R7,1 GET LENGTH INDICATOR @V2D3913 00376000 LA R6,PAD ... FOR A BLANK @V2D3913 00377000 BAL R15,MOVESEG BLANK UPPER SCREEN AS REQUIRED @V2D3913 00378000 B FINDHIGH FILL OUT GIO PLIST @V2D3913 00379000 EJECT 00380000 ************************************************************** 00381000 * THE CMPRESS ROUTINE COMPRESSES TRAILING BLANKS OF A 00382000 * RECORD AND PASSES BACK THE LENGTH OF ACTUAL DATA IN 00383000 * REGISTER 7. IT ALSO SETS THE CONDITION CODE AS FOLLOWS: 00384000 * CC0 = COMPRESSED RECORD LENGTH IS EQUAL TO 80. 00385000 * CC1 = COMPRESSED RECORD LENGTH IS GREATER THAN 80. 00386000 * CC2 = COMPRESSED RECORD LENGTH IS LESS THAN 80. 00387000 ************************************************************** 00388000 CMPRESS EQU * @V2D3914 00389000 NI UTILFLAG,255-TWOLINES RESET SIGNAL @V2D3913 00390000 TM SCRFLGS,WRMSGB IS THIS WRITE MESSAGE? @VA04851 00391000 BO GETVER BRANCH IF YES, USE VERIF. @VA04851 00392000 TM CHNGFLAG,DTYPE IS THIS DISPLAY CHANGE? @VA04851 00393000 BNO GETVER BRANCH IF NOT @VA04851 00394000 SR R5,R5 INDICATE BEGINNING OF LINE @VA04851 00395000 LH R7,TRUNCOL GET END OF CHANGEABLE LINE @VA04851 00396000 B SETUP @VA04851 00397000 GETVER EQU * @VA04851 00398000 LH R7,VERLEN GET VERIFY LENGTH @V2D3914 00399000 LH R5,VERCOL1 INDEX TO VERIFY FRONT @V2D3914 00400000 BCTR R5,R0 DECREMENT FOR INDEX @V2D3914 00401000 SETUP EQU * @VA04851 00402000 LA R6,8(R5,R2) POINT TO FRONT OF VERIFY @V2D3914 00403000 LR R0,R1 GET LINE LENGTH @V2D3914 00404000 LA R9,0(R7,R6) SET BACK POINTER @V305614 00405000 SHIFT BCTR R9,R0 SHIFT CHARACTER POINTER @V305614 00406000 CLI 0(R9),BLANK BLANK CHARACTER ? @V305066 00407000 BNE SIGNIFX GET OUT IF SIGNIFICANT CHAR. @V2D3914 00408000 BCT R7,SHIFT DECREMENT LENGTH AND LOOP @V2D3914 00409000 LA R7,1 MAKE NULL LINE LENGTH = 1 @V2D3914 00410000 SIGNIFX CR R0,R7 SET CONDITION CODE @V2D3914 00411000 BNLR R15 BR, IF < 81 @V2D3913 00412000 OI UTILFLAG,TWOLINES ELSE SET SIGNAL @V2D3913 00413000 BR R15 RETURN @V2D3913 00414000 SPACE 3 00415000 *************************************************************** 00416000 * 00417000 * MOVELINE & MOVESEG ACTUALLY MOVE DATA INTO BUFFERS 00418000 * 00419000 *************************************************************** 00420000 MOVELINE LR R5,R1 ASSUME MOVING 80 BYTES @V2D3913 00421000 TM UTILFLAG,TWOLINES TWO LINES PERCHANCE ? @V2D3913 00422000 BNO MOVESEG NO, ALL SET @V2D3913 00423000 AR R5,R1 BETTER DOUBLE THE COUNT @V2D3913 00424000 MOVESEG ICM R7,B'1000',PAD GET BLANK FOR PADDING @V2D3913 00425000 MVCL R4,R6 MOVE THE DATA (PAD AS REQUIRED) @V2D3913 00426000 BR R15 RETURN @V2D3913 00427000 EJECT 00428000 *************************************************************** 00429000 * 00430000 * ROUTINE TO DETERMINE EXTENT OF DISPLAY REQUESTED 00431000 * 00432000 *************************************************************** 00433000 SPACE 1 00434000 FINDHIGH EQU * @V2D3913 00435000 LA R15,FINDLOW SET THE EXIT VECTOR @V2D3913 00436000 LH R4,CLNUMBER AND SET UPPER LIMIT TO CL BUFFER @V60A6B6 00437000 LR R3,R4 SET LOWER LIMIT TO CURRENT BUFFER@V2D3913 00438000 TM HOLDFLAG,WRSTATB DID WE WRITE STATUS ? @V2D3913 00439000 BNO X1 NO ... BR @V2D3913 00440000 SR R4,R4 SET BUF0 AS UPPER LIMIT @V2D3913 00441000 BR R15 GO CHECK LOWER LIMIT @V2D3913 00442000 X1 TM HOLDFLAG,WRMSGB DID WE WRITE A MESSAGE ? @V2D3913 00443000 BNO X2 NO ... BR @V2D3913 00444000 LA R4,1 SET BUF1 AS UPPER LIMIT @V2D3913 00445000 BR R15 GO CHECK LOWER LIMIT @V2D3913 00446000 X2 TM HOLDFLAG,WRCLUPB WRITE CURRENT LINE UP ? @V2D3913 00447000 BNO X3 NO ... BR @V2D3913 00448000 LA R4,2 SET BUF2 AS UPPER LIMIT @V2D3913 00449000 BR R15 GO CHECK LOWER LIMIT @V2D3913 00450000 X3 TM HOLDFLAG,WRCLB+WRCLDNB WRITE CL OR CL DOWN ? @V2D3913 00451000 BNZR R15 YES, THEN LIMIT IS CORRECT @V2D3913 00452000 SR R15,R15 JUST A LONG FORM NOP, THEN @V2D3913 00453000 B SCROUT GET OUT @V2D3913 00454000 SPACE 1 00455000 FINDLOW LA R15,VERHIGH RESET THE EXIT VECTOR @V2D3913 00456000 TM HOLDFLAG,WRCLDNB WAS IT CL DOWN ? @V2D3913 00457000 BNO Y1 NO ... BR @V2D3913 00458000 LH R3,LLNUMBER SET LAST LINE AS LOWER LIMIT @V60A6B6 00459000 BR R15 GO VERIFY DERIVED LIMITS @V2D3913 00460000 Y1 TM HOLDFLAG,WRCLB+WRCLUPB WRITE CL OR CL UP ? @V2D3913 00461000 BZ Y2 NO ... BR @V2D3913 00462000 TM UTILFLAG,CLGT80B CL LONGER THAN 80 ? @V2D3913 00463000 BZR R15 NO ... BR @V2D3913 00464000 LH R3,CLNXTNUM SET LINE AFTER CL AS LOWER LIMIT @V60A6B6 00465000 BR R15 GO VERIFY DERIVED LIMITS @V2D3913 00466000 Y2 LA R3,1 LOW LIMIT MUST BE BUF1 @V2D3913 00467000 TM HOLDFLAG,WRMSGB DID WE WRITE A MESSAGE ? @V2D3913 00468000 BOR R15 YES, THEN BUF1 IS CORRECT @V2D3913 00469000 SR R3,R3 APPARENTLY ONLY WROTE STATUS @V2D3913 00470000 EJECT 00471000 VERHIGH LA R15,GETRANGE RESET EXIT VECTOR @V2D3913 00472000 TM HOLDFLAG,WRMSGB DID WE WRITE A MESSAGE ? @V2D3913 00473000 BOR R15 YES, NO ADJUSTMENT NEEDED @V2D3913 00474000 TM UTILFLAG,MSG MSG WRITTEN LAST TIME THRU ? @V2D3913 00475000 BZR R15 NO, THINGS ARE STILL GREAT @V2D3913 00476000 NI UTILFLAG,255-MSG RESET MESSAGE FLAG @V2D3913 00477000 LA R5,1 PICK POINTER INDICATOR FOR BUF1 @V2D3913 00478000 LTR R4,R4 UPPER LIMIT INCLUDE BUF1 ? @V2D3913 00479000 BZ VERLOW YES ... BR @V2D3913 00480000 LR R4,R5 RESET UPPER LIMIT TO BUF1 @V2D3913 00481000 VERLOW LTR R3,R3 LOWER LIMIT INCLUDE BUF1 ? @V2D3913 00482000 BNZR R15 YES ... BR @V2D3913 00483000 LR R3,R5 RESET LOWER LIMIT TO BUF1 @V2D3913 00484000 EJECT 00485000 GETRANGE EQU * @V2D3913 00486000 LA R3,1(,R3) EXTEND LOWER LIMIT FOR COMPUTE @V2D3913 00487000 SR R3,R4 DERIVE RANGE (NUMBER OF LINES) @V2D3913 00488000 MR R2,R1 DERIVE LENGTH (NUMBER OF BYTES) @V2D3913 00489000 SPACE 1 00490000 SETRANGE EQU * @V2D3913 00491000 CH R4,CLNUMBER ARE WE ON LINE 9 00491100 BNE NOTCUR 00491200 S R3,=F'1' 00491300 MVI FLAGLOC,X'04' YES SET HILIGHT 00491400 NOTCUR EQU * 00491500 STH R3,NUMLOC PUT LENGTH INTO GIO-PLIST @V2D3913 00492000 STH R4,LINELOC PUT START LINE INTO GIO-PLIST @V2D3913 00493000 MR R0,R4 DERIVE INDEX INTO SCREEN BUFFER @V2D3913 00494000 LA R4,BUF0(R1) RESOLVE INTO BUFFER STARTING ADDR@V2D3913 00495000 ST R4,BUFFLOC PUT BUFFER ADDR INTO GIO-PLIST @V2D3913 00496000 TM SCRFLG2,MOREB SHOULD WE CAUSE 'MORE' STATUS ? @V2D3913 00497000 BNO WRITEM NO ... BR @V2D3913 00498000 MVI FLAGLOC,X'01' SET FLAG IN GIO-PLIST @V2D3913 00499000 SPACE 1 00500000 WRITEM EQU * @V2D3913 00501000 LA R1,GIOPLIST POINT TO THE GIO-PLIST @V2D3913 00502000 L R15,=V(DMSGIO) GET ADDR OF I/O ROUTINE @V2D3913 00503000 BALR R14,R15 WRITE THE SCREEN @V2D3913 00504000 LTR R15,R15 HOW DID WE DO ? @V2D3913 00505000 BZ SCROUT JUST FINE @V2D3913 00506000 EJECT 00507000 DMSERR NUM=117,LET=S,TEXT='ERROR WRITING TO DISPLAY TERMINAL',X00508000 CSECT=EDI @VA01693 00509000 LA R15,4 SET RETURN AND @VA01693 00510000 SCROUT LTR R15,R15 SET CONDITION CODE @VA01693 00511000 LM R0,R14,SAVEAR RESTORE REGS 00512000 BR R14 RETURN 00513000 EJECT 00514000 * CONSTANTS USED IN DMSSCR 00515000 SPACE 1 00516000 TWO DC H'2' CONSTANT TO COMPUTE SCREEN INDEX @V60A6B6 00517000 FOUR DC H'4' CONSTANT TO COMPUTE SCREEN INDEX @V60A6B6 00518000 FIVE EQU X'05' CONSTANT TO COMPURE SCREEN INDEX @V60A6B6 00519000 MODEL2A EQU X'2A' @V60A6B6 00520000 PATRN DC X'40202020' @V2D3913 00521000 NEWFMSG DC CL5'NEW ' 00524010 INPMSG DC CL5'INPUT' 00524020 EDMSG DC CL5'EDIT ' 00524030 EOFREC DC C'EOF:' 00525000 TOPMSG DC C'TOF:' 00526000 RTPTR DC CL5'>>>>>' 00527000 SPACE 1 00528000 PAD DC C' ' @V2D3913 00529000 PAD0 DC X'00' @V2D3913 00530000 LTORG @VA04193 00531000 SPACE 00532000 ************************************************************ 00533000 * THE FOLLOWING DCS ESTABLISH A TABLE TO FIND THE CORRECT * 00534000 * SCREEN SIZE FOR THE TERMINALS/CONSOLES THAT MAY BE USED. * 00535000 ************************************************************ 00536000 SCRPARMS DC H'09,10,21,22,0720,1760' - 3277 @V60A6B6 00537000 SCRPRMLG EQU *-SCRPARMS @V60A6B6 00538000 DC H'12,13,29,30,0960,2400' - 3278 MODEL 3 HRC104DS 00539690 DC H'18,19,40,41,1440,3280' - 3278 MODEL 4 HRC104DS 00540380 DC H'11,12,24,25,1452,3300' - 3278 MODEL 5 HRC073DS 00541000 DC H'07,08,17,18,0560,1440' - 3278 MODEL 2A HRC104DS 00541070 SCRPRMSZ DC A(0,SCRPRMLG,SCRPRMLG*2,SCRPRMLG*3) @V60A6B6 00542000 SPACE 2 00543000 SPACE 2 00544000 SCRBUF DSECT 00545000 BUF0 EQU * 00546000 STAT DS CL5 00547010 DS CL1 00547020 LVL DS CL1 00547030 DS CL1 00547040 NAME DS CL8 00549000 DS C 00550000 TYPE DS CL8 00551000 DS C 00552000 MODE DS CL2 00553000 DS CL2 00554000 SFV DS C 00555000 DS C 00556000 LTH DS CL3 00557000 DS C 00558010 ZN DS CL5 00558020 ZNS DS CL3 00558030 ZNH DS C 00558040 ZNE DS CL3 00558050 DS C 00558060 VER DS CL6 00558070 VERS DS CL3 00558080 VERH DS C 00558090 VERE DS CL3 00558100 DS C 00558110 CSE DS CL5 00558120 CASE DS C 00558130 DS C 00558140 TNCC DS CL6 00558150 TNC DS CL3 00558160 BUF1 EQU * 00559000 PTLFT DS CL6 00560000 MSGTXT DS CL74 00561000 BUF2 DS CL80 @V60A6B6 00562000 SPACE 2 00563000 SCRSIZES DSECT @V60A6B6 00564000 CLNUMBER DS H @V60A6B6 00565000 CLNXTNUM DS H @V60A6B6 00566000 LLNUMBER DS H @V60A6B6 00567000 INPUTNUM DS H @V60A6B6 00568000 CLOFFSET DS H @V60A6B6 00569000 INOFFSET DS H @V60A6B6 00570000 EJECT 00571000 ********************************************************** 00572000 * 00573000 * EQUATES FOR SCRFLGS & HOLDFLAG 00574000 * 00575000 *********************************************************** 00576000 WRCLUPB EQU X'02' WRITE CL UP @V2D3914 00577000 WRMSGB EQU X'10' @V2D3913 00578000 WRCLDNB EQU X'20' WRITE CL DOWN 00579000 WRCLB EQU X'40' WRITE CL ONLY 00580000 WRSTATB EQU X'80' @V2D3913 00581000 WRFULLB EQU WRCLDNB+WRCLUPB @V2D3913 00582000 WRTOPB EQU WRSTATB+WRFULLB @V2D3913 00583000 ********************************************************** 00584000 * 00585000 * EQUATES FOR SCRFLG2 00586000 * 00587000 ********************************************************** 00588000 MOREB EQU X'80' CAUSE MORE STATUS 00589000 CANCB EQU X'40' CAUSE CANCEL OP 00590000 WRCLINB EQU X'08' @V2D3913 00591000 CMDINB EQU X'04' @V2D3913 00592000 ***************************************************************@VA04851 00593000 * @VA04851 00594000 * EQUATES FOR CHNGFLAG @VA04851 00595000 * @VA04851 00596000 ***************************************************************@VA04851 00597000 DTYPE EQU X'04' @VA04851 00598000 ********************************************************* 00599000 * 00600000 * EQUATES FOR FLAG 00601000 * 00602000 ********************************************************** 00603000 LINE8 EQU X'10' 8 CHARACTER LINE NUMBER 00604000 LEFT EQU X'40' LINEMODE LEFT 00605000 RIGHT EQU X'80' LINEMODE RIGHT 00606000 ************************************************************* 00607000 * 00608000 * EQUATES FOR FLAG2 00609000 * 00610000 ************************************************************** 00611000 LONGSW EQU X'02' LONG IS SET 00612000 TUBE EQU X'04' CONSOLE IS DISPLAY TYPE 00613000 NUFILE EQU X'08' NEW FILE 00614000 INMODE EQU X'10' INPUT MODE IN EFFECT 00615000 ************************************************** 00616000 * 00617000 * MISCELANEOUS EQUATES 00618000 * 00619000 ************************************************** 00620000 BLANK EQU X'40' ... @V305614 00621000 EDCB @V305614 00622000 ************************************************************ 00623000 * 00624000 * EQUATES FOR TWITCH 00625000 * 00626000 *********************************************************** 00627000 TOPSW EQU X'01' TOP OF FILE 00628000 EOF EQU X'02' END OF FILE 00629000 *************************************************************** 00630000 * 00631000 * EQUATES FOR UTILFLAG 00632000 * 00633000 *************************************************************** 00634000 CLGT80B EQU X'01' LENGTH > 80 BYTES @VA08152 00635000 MSG EQU X'02' MESSAGE IN BUFFER @VA08152 00636000 TWOLINES EQU X'04' LENGTH > 80 BYTES @VA08152 00637000 LINSEQ EQU X'08' NO SPACE FOR LINEMODE INPUT @VA08152 00638000 EJECT 00639000 NUCON 00640000 REGEQU 00641000 END 00642000