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