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