ibm:vm370-lib:cms:dmsedi.assemble_src
Table of Contents
DMSEDI Source
References
- Fixes Applied : 15
- This Source Date : Tuesday, December 12, 1978
- Last Fix ID : [HRC342DS]
Source Listing
- DMSEDI.ASSEMBLE.txt
- EDI TITLE 'DMSEDI (CMS) VM/370 - RELEASE 6' 00001000
- SPACE 2 00002000
- *********************************************************************** 00003000
- * 00004000
- * MACROS FOR EDIT 00005000
- * 00006000
- *********************************************************************** 00007000
- SPACE 2 00008000
- * 00009000
- ************** 00010000
- * 00011000
- * REQ SETS UP THE DECLARATIONS FOR A REQUEST 00012000
- * (SEE TABLE OF REQUESTS -- PRQUEST ET SEQ.) 00013000
- * 00014000
- ************** 00015000
- SPACE 00016000
- MACRO 00017000
- &LOC REQ &NAME,&MIN,&ADDR,&TRAV 00018000
- LCLA &M,&L,&K 00019000
- LCLC &A 00020000
- &M SETA 1 00021000
- AIF (N'&MIN EQ 0).SEQ1 00022000
- &M SETA &MIN 00023000
- .SEQ1 ANOP 00024000
- &L SETA K'&NAME 00025000
- &A SETC '&NAME' 00026000
- AIF (N'&ADDR EQ 0).SEQ2 00027000
- &A SETC '&ADDR' 00028000
- .SEQ2 ANOP 00029000
- &K SETA 0 00030000
- AIF (N'&TRAV EQ 0).SEQ3 00031000
- &K SETA 1 00032000
- .SEQ3 ANOP 00033000
- &LOC DC AL1(&M,&L,&K),C'&NAME',AL2(&A-EDIT) 00034000
- MEND 00035000
- EJECT 00036000
- * 00037000
- ************** 00038000
- * 00039000
- * WTYPE TYPES A LINE AT THE TERMINAL 00040000
- * 00041000
- ************** 00042000
- SPACE 00043000
- MACRO 00044000
- &LOC WTYPE &TEXT,&NUM,&RETURN=,&VERIFY= 00045000
- LCLA &A 00046000
- LCLC &SUF 00047000
- AIF (N'&VERIFY EQ 0).SEQ1 00048000
- AIF ('&VERIFY' NE 'YES').SEQ1 00049000
- &SUF SETC '1' 00050000
- .SEQ1 ANOP 00051000
- &LOC LA 1,&TEXT 00052000
- AIF (N'&NUM EQ 0).SEQ1A 00053000
- &A SETA &NUM 00054000
- AGO .SEQ2 00055000
- .SEQ1A ANOP 00056000
- &A SETA L'&TEXT 00057000
- .SEQ2 LA 0,&A 00058000
- AIF (N'&RETURN EQ 0).SEQ3 00059000
- LA 14,&RETURN 00060000
- B WRTYPE&SUF 00061000
- MEXIT 00062000
- .SEQ3 BAL 14,WRTYPE&SUF 00063000
- MEND 00064000
- SPACE 2 00065000
- * 00066000
- ************** 00067000
- * 00068000
- * VTYPE TYPES A LINE IF IN VERIFY MODE 00069000
- * 00070000
- ************** 00071000
- SPACE 00072000
- MACRO 00073000
- &LOC VTYPE &TEXT,&NUM,&RETURN= 00074000
- &LOC WTYPE &TEXT,&NUM,RETURN=&RETURN,VERIFY=YES 00075000
- MEND 00076000
- EJECT 00077000
- * 00078000
- ************** 00079000
- * 00080000
- * VERIFY VERIFIES THE CURRENT LINE 00081000
- * 00082000
- ************** 00083000
- SPACE 00084000
- MACRO 00085000
- &NAME VERIFY &RETURN= 00086000
- AIF (N'&RETURN EQ 0).SEQ1 00087000
- &NAME LA 14,&RETURN 00088000
- B VERSUB 00089000
- MEXIT 00090000
- .SEQ1 ANOP 00091000
- &NAME BAL 14,VERSUB 00092000
- MEND 00093000
- SPACE 2 00094000
- * 00095000
- ************** 00096000
- * 00097000
- * CMS SETS UP THE CALLING SEQUENCE FOR SVC 202. 00098000
- * 00099000
- ************** 00100000
- SPACE 00101000
- MACRO 00102000
- &NAME CMS &PLIST,&PROG=,&ERROR= 00103000
- &NAME LA 1,&PLIST 00104000
- AIF (N'&PROG EQ 0).SEQ2 00105000
- MVC 0(8,1),=CL8'&PROG' 00106000
- .SEQ2 SVC X'CA' 00107000
- AIF (N'&ERROR EQ 0).SEQ1 00108000
- AIF ('&ERROR' EQ 'IGNORE').SEQ3 00109000
- AIF ('&ERROR' EQ 'DIE').SEQ4 00110000
- DC AL4(&ERROR) 00111000
- MEXIT 00112000
- .SEQ4 DC AL4(*) ...'DIE' IF UNEXPECTED CMS ERROR... 00113000
- MEXIT 00114000
- .SEQ3 DC AL4(*+4) 00115000
- .SEQ1 MEND 00116000
- EJECT 00117000
- *. 00118000
- * 00119000
- * MODULE NAME: 00120000
- * 00121000
- * DMSEDI (EDIT) 00122000
- * 00123000
- * FUNCTION: 00124000
- * 00125000
- * TO MODIFY THE CONTENTS OF AN EXISTING FILE OR TO CREATE 00126000
- * A NEW FILE. 00127000
- * 00128000
- * ATTRIBUTES: 00129000
- * 00130000
- * DISK RESIDENT 00131000
- * 00132000
- * ENTRY POINTS: 00133000
- * 00134000
- * DMSEDI - SEE FUNCTION DESCRIPTION 00135000
- * 00136000
- * ENTRY CONDITIONS: 00137000
- * 00138000
- * GPR1 - A(EDCB) 00139000
- * 00140000
- * EXIT CONDITIONS: 00141000
- * 00142000
- * NORMAL - GPR15 = 0 00143000
- * 00144000
- * ERROR - GPR15 ¬= 0 00145000
- * 00146000
- * GPR15 = 20 INVALID CHARACTER 00147000
- * 00148000
- * 24 INCOMPLETE FILEID 00149000
- * 24 INVALID OPTION 00150000
- * 24 INVALID LRECL PARAMETER 00151000
- * 00152000
- * 28 EDIT WORK-FILE "EDIT CMSUT1" EXISTS. 00153000
- * IF IT IS WANTED, RENAME THE FILENAME OR FILETYPE; 00154000
- * OTHERWISE, ERASE IT. 00155000
- * 00156000
- * 88 RECORD LENGTH TOO LARGE FOR EDIT 00157000
- * 00158000
- * 40 GIVE A LARGER RECORD-LENGTH IN THE LRECL PARAMETE 00159000
- * 00160000
- * 88 FILE TOO LARGE FOR EDIT - INSUFFICIENT STORAGE 00161000
- * 00162000
- * 100 I/O ERROR, READING/WRITING FILE 00163000
- * 00164000
- * 00165000
- * CALLS TO OTHER ROUTINES: 00166000
- * 00167000
- * DMSSCR - WRITE TO DISPLAY TERMINAL 00168000
- * DMSBWR - WRITE A FILE TO DISK 00169000
- * DMSBRD - READ A FILE FROM DISK 00170000
- * DMSSTT - VERIFY EXISTENCE OF A FILE 00171000
- * DMSRNM - ALTER FILEID 00172000
- * DMSCWRB - TYPE INFORMATION TO USER CONSOLE 00173000
- * DMSCWT - WAIT ON CONSOLE I/O 00174000
- * DMSCRD - WAIT ON CONSOLE RESPONSE 00175000
- * DMSCAT - STACK CONSOLE INPUT 00176000
- * DMSERS - ERASE UTILITY FILES 00177000
- * DMSFNS - 'CLOSE' A FILE 00178000
- * 00179000
- * EXTERNAL REFERENCES: 00180000
- * 00181000
- * EDCANON - EXTERNAL CANONICALIZATION ROUTINE 00182000
- * 00183000
- * EDCMS - 00184000
- * EDAFSTFN: ADDRESS OF FINISHED READ BUFFER IN 00185000
- * CMS 'NUCON'. 00186000
- * 00187000
- * EDASTRIN: ADDRESS OF STORAGE INITIALIZATION ROUTINE 00188000
- * ('STRINIT') IN CMS 'NUCON'. 00189000
- * 00190000
- * OPERATION: 00191000
- * 00192000
- * THE EDIT MODULE IS LOADED INTO STORAGE BY THE EDIT 00193000
- * INITIALIZATION MODULE, DMSEDX. IT MAY RESIDE IN A 00194000
- * DISCONTIGUOUS SEGMENT OR IN USER STORAGE. DMSEDX 00195000
- * GETS FREE STORAGE FOR AND INITIALIZES THE EDIT 00196000
- * FREE WORKING STORAGE (EDCB), THEN LOADS AND 00197000
- * BRANCHES TO THE EDIT MODULEWITH REGISTER 1 00198000
- * CONTAINING THE ADDRESS OF EDCB. 00199000
- * UPON ENTRY, A MESSAGE IS TYPED TELLING THE 00200000
- * USER HE IS IN THE EDIT ENVIRONMENT AND 'WAITRD' IS CALLED 00201000
- * TO READ A LINE FROM THE TERMINAL. IF A NULL LINE IS ENTERED, 00202000
- * ANOTHER READ FROM THE TERMINAL IS EXECUTED. 00203000
- * IF THE LINE IS NOT NULL, THE FIRST ENTRY ON THE LINE IS 00204000
- * ASSUMED TO BE AN EDIT SUB-COMMAND; IF IT IS, A BRANCH IS 00205000
- * TAKEN TO THE APPROPRIATE EDIT SUB-ROUTINE TO PROCESS THE 00206000
- * COMMAND. 00207000
- * IF THE FIRST ENTRY IS NOT RECOGNIZED AS A SUB-COMMAND, 00208000
- * AN ERROR MESSAGE IS ISSUED TO THE TERMINAL AND ANOTHER 00209000
- * READ IS ISSSUED TO THE TERMINAL. 00210000
- * 00211000
- *. 00212000
- EJECT 00213000
- PUNCH 'SPB' @VM03178 00214000
- DMSEDI START X'0' 00215000
- EDIT EQU * 00216000
- LR R10,R14 ADDRESSABILITY FOR 1ST PAGE @V305614 00217000
- LA 15,4095 00218000
- LA 11,1(10,15) ... FOR 2ND PAGE 00219000
- LA 12,1(11,15) ... FOR 3RD PAGE 00220000
- USING DMSEDI,10 00221000
- USING DMSEDI+4096,11 00222000
- USING DMSEDI+8192,12 00223000
- USING NUCON,0 @V200714 00224000
- USING EDCB,R13 @V305614 00225000
- LR R13,R1 SET FREE STOR ADDRESSABILITY @V305614 00226000
- DMSKEY USER RUN WITH USER KEY(FOR SAFETY)@VA04825 00227000
- SSM FE ALLOW INPUT WHILE EDITTING @VA04825 00228000
- CMS CWAIT SYNCHRONIZE OUTPUT @VA04825 00229000
- SPACE 1 00230000
- REFRESH EQU * @V2D3913 00231000
- NI FLAG2,255-INMODE CANNOT BE 'INPUT' MODE @V2D3913 00232000
- TM FLAG2,TUBE IS THIS A DISPLAY TERMINAL ? @V2D3913 00233000
- BNO PEDIT IF NOT, TYPE 'EDIT:' @V2D3913 00234000
- VERIFY RETURN=PEDIT1 @V2D3913 00235000
- SPACE 1 00236000
- DS 0F @VM03243 00237000
- CWAIT DC CL8'CONWAIT' @VM03243 00238000
- EJECT 00239000
- *********************************************************************** 00240000
- * 00241000
- * PRINT OUT 'EDIT:' AND ENTER EDIT MODE - ACCEPTING 00242000
- * REQUESTS FROM THE USER. 00243000
- * 00244000
- *********************************************************************** 00245000
- SPACE 00246000
- MPEDIT EQU * @VA07347 00247000
- TM FLAG2,VER IS THIS VERIFY MODE? @VA07347 00248000
- BO PEDIT BRANCH IF YES @VA07347 00249000
- OI TWITCH,VEROVER SET VERIFY OVERRIDE FLAG @VA07347 00250000
- SPACE 1 00251000
- PEDIT VTYPE EDITXX @V2D3913 00252000
- SPACE 00253000
- PEDIT1 EQU * 00254000
- EX 0,NEXT6 ZERO X-Y COUNT 00255000
- SPACE 00256000
- NEXT EQU * NORMAL RETURN POINT FOR NEXT REQUEST 00257000
- NI SIGNAL,255-REPL ENSURE REPLACE FUNC IS OFF @VA04196 00258000
- TM TWITCH,TOPSW+EOF ENDRANGE? @V2D3913 00259000
- BZ NEXT4 BRANCH IF NOT 00260000
- NEXT6 EQU * 00261000
- XC XYCNT,XYCNT CLEAR X-Y COUNT JUST IN CASE 00262000
- NEXT4 EQU * RETURN FROM X OR Y COMMAND 00263000
- NI TWITCH,255-(TRUNC+UPWARD) RESET TWITCH, @V2D3913 00264000
- MVI SCRFLGS,X'00' SCRFLGS, AND SCRFLG2 FOR @V2D3913 00265000
- MVI SCRFLG2,X'00' THE NEXT COMMAND @V2D3913 00266000
- L 2,XYCNT GET X-Y COUNT 00267000
- LTR 2,2 IS IT ZERO? 00268000
- BZ NEXT8 BRANCH IF SO 00269000
- BCTR 2,0 MINUS ONE 00270000
- ST 2,XYCNT STORE NEW VALUE 00271000
- B NEXT5 00272000
- SPACE 00273000
- NEXT8 EQU * 00274000
- NI XYFLAG,255-(XACT+YACT) CLEAR X-ACTIVE AND Y-ACTIVE 00275000
- TM SIGNAL,QUOD WAS LAST REQUEST ? OR "? 00276000
- BO NEXT10 BRANCH IF SO 00277000
- LH 1,COUNT LENGTH OF REQUEST 00278000
- STH 1,SAVCNT SAVE IT 00279000
- LTR 1,1 TEST IT 00280000
- BZ NEXT10 BRANCH IF NOUGHT 00281000
- BCTR 1,0 DECREASE FOR EXEC 00282000
- EX 1,SAVREQ SAVE THE REQUEST IN TABLIN 00283000
- OI SIGNAL,QUOD LIE THAT IT'S A ? OR " (MAY BE NULL LINE) 00284000
- NEXT10 EQU * 00285000
- BAL 14,RDTYPE READ A LINE FROM THE TERMINAL 00286000
- BNZ CKLINSEQ HANDLE EDIT LINE INPUT @VA08152 00286250
- NI UTILFLAG,255-LINSEQ RESET ERROR FLAG @VA08152 00286500
- B MPEDIT CC=0 MEANS NULL LINE @VA08152 00286750
- CKLINSEQ EQU * 00287000
- TM UTILFLAG,LINSEQ LINE-NUMBER CONSTRICTION? @VA08152 00287250
- BO NEXT10 PURGE INPUT LINES @VA08152 00287500
- NI SIGNAL,255-(QUOD+OVER) CLEAR ? AND " AND OVERLAY FLAGS 00288000
- XC DITCNT,DITCNT CLEAR DITCNT 00289000
- SPACE 00290000
- NEXT5 EQU * COME HERE IS IT'S AN X OR Y REQUEST 00291000
- XC EDCT,EDCT CLEAR EDCT 00292000
- BAL 14,GET GET EDIT TOKEN 00293000
- BZ INVREQ INVALID REQUEST IF CC = 0 00294000
- NEXT1 EQU * @VA06391 00295000
- TM GETFLAG,ALPHA+NONALNUM 00296000
- BZ SFIND TOKEN NUMERIC - FIND LINENO. 00297000
- SPACE 00298000
- LA 2,PRQUEST ADDRESS OF PRE-REQUEST TABLE 00299000
- LA 3,PRQEND END OF PRE-REQUEST TABLE 00300000
- BAL 14,REQSUB SEARCH TABLE 00301000
- LA 14,1 LOAD UP A CONSTANT OF 1 @V200713 00302000
- ST 14,REPCNT RESET REPCNT @V200713 00303000
- LA 2,RQUEST ADDRESS OF MAIN REQUEST TABLE 00304000
- LA 3,REQEND END OF MAIN REQUEST TABLE 00305000
- BAL 14,REQSUB SEARCH TABLE 00306000
- B INVREQ BRANCH IF NOT FOUND 00307000
- SPACE 00308000
- SAVREQ MVC TABLIN(*-*),EDLIN SAVE THE LAST REQUEST 00309000
- SPACE 00310000
- EDITXX DC C'EDIT:' 00311000
- EJECT 00312000
- ************** 00313000
- * 00314000
- * SUBROUTINE TO SEARCH REQUEST TABLE. 00315000
- * 00316000
- * CALL: 00317000
- * BAL 14,REQSUB 00318000
- * 00319000
- * ON ENTRY: 00320000
- * R1 HOLDS LENGTH-1 OF GIVEN REQUEST 00321000
- * R2 HOLDS STARTING ADDRESS OF REQUEST TABLE 00322000
- * R3 HOLDS END ADDRESS OF REQUEST TABLE 00323000
- * 00324000
- * IF MATCH IS FOUND, A DIRECT BRANCH IS TAKEN FROM HERE 00325000
- * TO THE APPROPRIATE ROUTINE. OTHERWISE WE RETURN TO CALLER. 00326000
- * 00327000
- * (LEVEL 1 SUBROUTINE, CALLED FROM PEDIT. USES REGSAV.) 00328000
- * 00329000
- ************** 00330000
- SPACE 00331000
- REQSUB DS 0H 00332000
- LA R4,XXXCWD-1(R1) POINT TO END OF ARG @V2D3913 00333000
- SR R15,R15 EMPTY A REGISTER @V2D3913 00334000
- LR R5,R1 SAVE A COPY OF REG(1) @V2D3913 00335000
- CLC 0(2,R4),=CL2'UP' WAS UP SPECIFIED? @V2D3913 00336000
- BNE ISITU WASN'T CL2'UP', SO GO ON @V2D3913 00337000
- BCTR R1,R0 DECREMENT THE COUNT REGISTER @V2D3913 00338000
- B UORUP GO TO COMMON CODE @V2D3913 00339000
- ISITU CLI 1(R4),C'U' MAYBE JUST U? @V2D3913 00340000
- BNE REQLOOP IF NOT, NOT UPWARD @V2D3913 00341000
- UORUP BCTR R1,R0 DECREMENT COUNT REGISTER @V2D3913 00342000
- OI TWITCH,UPWARD TURN ON THE UP FLAG @V2D3913 00343000
- LTR R1,R1 ANY COUNT LEFT? @V2D3913 00344000
- BM NEXLIN IF NOT, IT'S JUST "UP" @V2D3913 00345000
- SPACE 1 00346000
- REQLOOP EQU * SEARCH THE TABLE 00347000
- IC 15,0(2) PICK UP MINIMUM LENGTH OF REQUEST 00348000
- BCTR 15,0 DECREASE FOR COMPARISON 00349000
- CR 1,15 ENOUGH CHARACTERS TYPED IN? 00350000
- IC 15,1(2) (PICK UP MAXIMUM LENGTH ANYWAY) 00351000
- BL REQLP1 BRANCH IF NOT ENOUGH CHARACTERS 00352000
- CR 1,15 TOO MANY CHARACTERS TYPED IN? 00353000
- BNL REQLP1 BRANCH IF SO 00354000
- EX 1,REQCOMP DO WE HAVE A MATCH? 00355000
- BE REQGO BRANCH IF SO 00356000
- REQLP1 LA R2,5(R15,R2) ADDRESS OF NEXT ENTRY IN TABLE. @V2D3913 00357000
- CR 2,3 HAVE WE REACHED AND OF TABLE? 00358000
- BL REQLOOP LOOP IF NOT 00359000
- LR R1,R5 GET BACK THE OLD REG(1) @V2D3913 00360000
- BR 14 RETURN 00361000
- SPACE 00362000
- REQGO EQU * WE MAY HAVE FOUND THE ROUTINE @V2D3913 00363000
- TM TWITCH,UPWARD DID IT LOOK LIKE UP @V2D3913 00364000
- BNO REQGO1 NOT AT ALL @V2D3913 00365000
- CLI 2(R2),X'01' IS UPWARD ALLOWED @V2D3913 00366000
- BE REQGO1 O.K. IF SO @V2D3913 00367000
- LA R5,4(R2,R1) INDEX INTO VALID COMMAND FORM @V2D3913 00368000
- CLI 0(R5),C'U' DOES A 'U' HAPPEN TO BE THERE ? @V2D3913 00369000
- BNER R14 DEFINITE ERROR IF NOT @V2D3913 00370000
- CLC 0(2,4),=CL2'UP' BUT NOW YOU CAN'T GO UP @V2D3913 00371000
- BER R14 ERROR IF YOU TRY @V2D3913 00372000
- REQGO1 LA R2,3(R15,R2) GET OFFSET TO APPROVED ROUTINE @V2D3913 00373000
- ICM 15,B'0011',0(2) GET DISPL TO COMMAND RTN @V200713 00374000
- LA 15,EDIT(15) OFFSET BY BASE @V200713 00375000
- BR 15 GO THERE @V200713 00376000
- SPACE 2 00377000
- REQCOMP CLC XXXCWD(*-*),3(R2) @V2D3913 00378000
- EJECT 00379000
- * 00380000
- ************** 00381000
- * 00382000
- * DEAL WITH INVALID REQUEST 00383000
- * 00384000
- ************** 00385000
- SPACE 00386000
- INVREQ DS 0H INVALID EDIT REQUEST. TELL HIM SO. 00387000
- TM FLAG2,LONGSW ARE WE IN LONG MODE? @V1D1613 00388000
- BO INVREQ1 BRANCH IF SO 00389000
- WTYPE INVD,1,RETURN=INVREQX @V200713 00390000
- SPACE 00391000
- INVDOT EQU * INVALID MACRO REQUEST 00392000
- TM FLAG2,LONGSW ARE WE IN LONG MODE? @V1D1613 00393000
- BO INVREQ1 BRANCH IF SO 00394000
- WTYPE INVD,2,RETURN=INVREQX @V200713 00395000
- SPACE 00396000
- INVREQ1 EQU * 00397000
- MVC INVLD(L'INVLDHDR),INVLDHDR SET MSG HEADER @VA04733 00398000
- LA 1,INVLD ADDRESS OF ERROR MESSAGE 00399000
- LA 0,EDLIN-INVLD LENGTH OF '?EDIT: ' 00400000
- AH 0,COUNT ADD LENGTH OF REQUEST 00401000
- BAL 14,WRTYPE TYPE MESSAGE 00402000
- SPACE 00403000
- INVREQX EQU * ERROR MESSAGE ALREADY GIVEN 00404000
- LH 2,DITCNT GET DITCNT 00405000
- LTR 2,2 TEST IT 00406000
- BZ NEXT6 BRANCH IF ZERO 00407000
- L 3,AFSTFNRD ADDR. TO TEST EXISTENCE OF STACK 00408000
- SPACE 1 00409000
- UNDITTO EQU * CLEAR THE STACK 00410000
- L 1,0(3) VALUE OF FSTFINRD (DOES STACK EXIST?) 00411000
- LTR 1,1 00412000
- BZ NEXT6 BRANCH IF STACK IS EMPTY 00413000
- BAL 14,RDTYPE READ ONE STACKED LINE 00414000
- BCT 2,UNDITTO AND LOOP UNTIL DONE 00415000
- B NEXT6 00416000
- SPACE 2 00417000
- INVD DC C'¬$' SHORT FORMS FOR INVALID EDIT REQUEST 00418000
- EJECT 00419000
- *********************************************************************** 00420000
- * 00421000
- * ENTER INPUT MODE AND ACCEPT LINES FROM THE CONSOLE 00422000
- * AS NEW LINES TO BE PUT IN THE FILE. A NULL LINE 00423000
- * TERMINATES THIS MODE AND REVERTS TO EDIT MODE. 00424000
- * 00425000
- *********************************************************************** 00426000
- SPACE 00427000
- PINPUT DS 0H TYPE 'INPUT:' IF IN VERIFY MODE 00428000
- TM FLAG2,REMOTE+TUBE DISPLAY MODE WITH REMOTE ? @V2D3914 00429000
- BNO PINPUT0 NO...BR @V2D3914 00430000
- OI SCRFLG2,CANCB DON'T CAUSE MORE STATUS @VM01093 00431000
- BAL R14,WRTYPEX ISSUE CONCEL OP TO SCREEN @VM01093 00432000
- XI FLAG2,TUBE+SWITCH FLIP TUBE FLAG AND REMEMBER @V2D3914 00433000
- PINPUT0 EQU * @V2D3914 00434000
- OI FLAG2,INMODE GRAPHICS FLAG @V200714 00435000
- TM FLAG2,TUBE DISPLAY TERMINAL ? @V2D3913 00436000
- BNO PINPUT1 TYPE 'INPUT:' IF NOT @V2D3913 00437000
- TM FLAG2,VER VERIFY ON? @VA04074 00438000
- BNO INPUT NO ... BR @VA04074 00439000
- MVI SCRFLGS,WRSTATB REWRITE STATUS LINE @VA04074 00440000
- VERIFY @V2D3913 00441000
- MVI SCRFLGS,WRCLUPB WRITE FROM CL UP @V2D3914 00442000
- B INPUT NOW GET NEXT LINE @V2D3913 00443000
- SPACE 1 00444000
- PINPUT1 EQU * @V2D3913 00445000
- VTYPE INPUTXX INDICATE INPUT MODE 00446000
- SPACE 00447000
- INPUT EQU * 00448000
- NI SIGNAL,255-QUOD CLEAR ? AND " FLAG 00449000
- TM FLAG,RIGHT+LEFT LINEMODE ON? 00450000
- BM PROMPTER GO TO PROMPTING ROUTINE 00451000
- SPACE 1 00452000
- INP1 EQU * 00453000
- BAL 14,RDTYPE READ INPUT LINE 00454000
- BNZ INP2 BR IF NOT NULL ENTRY @V2D3914 00455000
- NI SIGNAL,255-REPL RESET REPLACE FLAG IF ON @VA04074 00456000
- MVI SCRFLGS,WRSTATB CHANGE STATUS FIELD @V2D3914 00457000
- TM FLAG2,SWITCH IF WE SET TUBE FLAG OFF, @V2D3914 00458000
- BNO REFRESH THEN RESET IT @V2D3914 00459000
- XI FLAG2,SWITCH+TUBE ....... @V2D3914 00460000
- OI SCRFLGS,WRTOPB CAUSE A FULL DISPLAY @V2D3914 00461000
- B REFRESH CLEAN UP AND GO TO EDIT @V2D3914 00462000
- INP2 XC EDCT(2),EDCT CLEAR EDIT COUNT @V2D3914 00463000
- BAL R4,TAKELINE GO DO THE RIGHT THING @V2D3913 00464000
- B INPUT GET THE NEXT LINE @V2D3913 00465000
- SPACE 1 00466000
- INPUTXX DC C'INPUT:' 00467000
- EJECT 00468000
- ************************************************************** 00469000
- * 00470000
- * 'REPLACE' REPLACES THE CURRENT LINE BY THE LINE 00471000
- * FOLLOWING THE COMMAND. IF 'REPLACE' IS TYPED ALONE, 00472000
- * INPUT MODE IS ENTERED. 00473000
- * 00474000
- *********************************************************************** 00475000
- SPACE 00476000
- RETYPE DS 0H TR 00477000
- LA R2,1 SET THE REPLACE SIGNAL @V2D3913 00478000
- TM TWITCH,TOPSW+EOF ARE WE AT TOP OR EOF? 00479000
- BZ RTYP1 FLAG IS CORRECT @V2D3913 00480000
- SPACE 1 00481000
- INSERT EQU * @V2D3913 00482000
- SR R2,R2 SET THE INSERT FLAG @V2D3913 00483000
- SPACE 00484000
- RTYP1 EQU * 00485000
- CLC EDCT(2),COUNT WAS NULL LINE ENTERED? 00486000
- BL RTYP4 BRANCH IF NOT 00487000
- LTR 2,2 IS THIS INSERT 00488000
- BZ PINPUT THEN GO DIRECTLY TO INPUT @V2D3913 00489000
- OI SIGNAL,REPL SET TRICKY REPLACE MODE 00490000
- B PINPUT NOW GO TO INPUT @V2D3913 00491000
- SPACE 00492000
- RTYP4 EQU * 00493000
- TM FLAG,LEFT+RIGHT LINEMODE ON? 00494000
- BM INVREQ ERROR IF SO 00495000
- MVI SCRFLGS,WRCLUPB WRITE ALL CHANGES @V2D3914 00496000
- LTR R2,R2 IS THIS INSERT? @V2D3913 00497000
- BZ RTYP5 ALL SET IN THAT CASE @V2D3913 00498000
- SPACE 1 00499000
- RTYP4A EQU * @V2D3913 00500000
- OI SIGNAL,REPL SET THE REPLACE FLAG @V2D3913 00501000
- MVI SCRFLGS,WRCLB ONLY CL CHANGED @V2D3914 00502000
- SPACE 1 00503000
- RTYP5 EQU * 00504000
- BAL R4,TAKELINE GO DO THE RIGHT THING @V2D3913 00505000
- B NEXT ALL DONE @V2D3913 00506000
- EJECT 00507000
- ************** 00508000
- * 00509000
- * TAKELINE INSERTS OR REPLACES LINES IN STORAGE 00510000
- * ACCORDING TO THE SETTING OF THE REPL SWITCH IN FLAG 00511000
- * 00512000
- ************** 00513000
- SPACE 1 00514000
- TAKELINE DS 0H @V2D3913 00515000
- BAL R14,SPREAD UN-TAB THE LINE @V2D3913 00516000
- NI CHNGFLAG,255-DTYPE TURN OFF DISPLAY TYPE FLAG @VA04851 00517000
- L R14,ITEM GET THE ITEM LENGTH @V2D3913 00518000
- BCTR R14,R0 LESS 1 FOR EXECUTE @V2D3913 00519000
- EX R14,INMOVE MOVE CHARACTERS TO 'LINE' @V2D3913 00520000
- LA R1,LINE WHERE IS LINE? @V2D3913 00521000
- TM FLAG,LEFT+RIGHT LINEMODE ON? @V2D3913 00522000
- BZ TL1 SKIP IF NOT. @V2D3913 00523000
- LR R3,R1 MAKE A COPY OF A(LINE) @V2D3913 00524000
- TM SIGNAL,REPL DISPLAY TYPE CHANGE ? @V2D3914 00525000
- BNO TL0 NO ... BR @V2D3914 00526000
- L R3,PTR2 SAVE THE OLD LINE NUMBER @V2D3914 00527000
- AH R3,LMSTART ADD LINENUMBER OFFSET @V2D3914 00528000
- MVC PADBUF+3(5),8(R3) FROM THE CORE CHAIN @V2D3914 00529000
- TM FLAG,LINE8 LONG LINE NUMBERS ? @V2D3914 00530000
- BNO TL0 NO ... BR @V2D3914 00531000
- MVC PADBUF(8),8(R3) MOVE IN OLD NUMBER @V2D3914 00532000
- TL0 LR R3,R1 MAKE A COPY OF A(LINE) @V2D3914 00533000
- AH R3,LMSTART GET LINENUMBER OFFSET @V2D3913 00534000
- TM FLAG,RIGHT LINEMODE RIGHT ? @V2D3914 00535000
- BO TLRIGHT YES ... BR @V2D3914 00536000
- MVC 0(5,R3),PADBUF+3 MOVE 5 DIGIT LINENUMBER @V2D3913 00537000
- TM FLAG,LINE8 IS THIS A LONG LINENUMBER? @V2D3913 00538000
- BNO TL1 ALL DONE IF NOT. @V2D3913 00539000
- MVC 0(8,R3),PADBUF CHANGE THE LINENUMBER @V2D3913 00540000
- B TL1 DONE WITH LONG LINENUMBERS @V2D3914 00541000
- TLRIGHT MVC 0(5,R3),PADBUF+3 CHANGE RIGHT LINENUMBER @V2D3914 00542000
- TL1 TM SIGNAL,REPL TRICKY REPLACE MODE? @V2D3913 00543000
- BNZ TL2 YEP ... BR @VA04074 00544000
- BAL R14,XWRITE WRITE OUT THE LINE @V2D3913 00545000
- BNL TL3 BRANCH IF NO OVERFLOW. @V2D3913 00546000
- TLERR EQU * COME HERE IF AUTOSAVE ERROR @VA04190 00547000
- NI FLAG2,255-INMODE RESET INPUT MODE FLAG @VA04190 00548000
- TM FLAG2,TUBE DISPLAY TERMINAL? @VA04190 00549000
- BNO MPEDIT NO ... GO TYPE 'EDIT' @VA04190 00550000
- OI SCRFLG2,MOREB MAKE SURE SEES PREV MSG @VA04190 00551000
- MVI SCRFLGS,WRSTATB CHG STATUS TO EDIT @VA04190 00552000
- TM FLAG2,VER VERIFY ON? @VA04190 00553000
- BZ MPEDIT NO ... JUST TYPE 'EDIT' @VA04190 00554000
- OI SCRFLGS,WRFULLB REWRITE SCREEN AND @VA04190 00555000
- B MPEDIT GO TYPE 'EDIT' @VA04190 00556000
- SPACE 1 00557000
- TL2 NI SIGNAL,255-REPL ONLY HAPPENS ONCE @V2D3913 00558000
- BAL R14,XREPLX REPLACE THE CURRENT LINE. @V2D3913 00559000
- TL3 TM TWITCH,TRUNC TRUNCATED? @V2D3913 00560000
- BO TL4 IF NOT, CONTINUE @V2D3913 00561000
- TM FLAG2,TUBE GRAPHICS? @V2D3913 00562000
- BNOR R4 IF NOT, ALL DONE. @V2D3913 00563000
- BAL R14,VERSUB SHOW THE NEW LINE. @V2D3913 00564000
- BR R4 NOW RETURN @V2D3913 00565000
- SPACE 1 00566000
- TL4 WTYPE TRUNCX @V2D3913 00567000
- NI TWITCH,255-TRUNC RESET TRUNCATION FLAG @V2D3913 00568000
- TM FLAG2,TUBE IS THIS A SCREEN @V2D3913 00569000
- BOR R4 ALL DONE IF SO @V2D3913 00570000
- LH R0,TRUNCOL SET THE TYPING LENGTH @V2D3913 00571000
- LA R1,LINE AND THE TARGET ADDRESS. @V2D3913 00572000
- BAL R14,WRTYPE3 DISPLAY THE CURRENT RESULT @V2D3913 00573000
- BR R4 @V2D3913 00574000
- EJECT 00575000
- *********************************************************************** 00576000
- * 00577000
- * 'TYPE' WILL PRINT OUT THE CURRENT LINE AND THE 00578000
- * NEXT N-1 LINES. 00579000
- * 00580000
- *********************************************************************** 00581000
- SPACE 00582000
- PRINT DS 0H 00583000
- BAL 14,NUM GET PARM 00584000
- BAL 14,STARCHK IF NOT NUMERIC, HOPEFULLY * 00585000
- LR 2,0 SAVE IN R2 00586000
- LH R3,VERLEN SAVE VERIFY LENGTH FOR LATER @V2D3914 00587000
- LH R4,VERCOL1 AND THE 1ST VERIFY COLUMN @V2D3914 00588000
- BCTR R4,R0 MINUS 1 AS AN INDEX TO THE LINE@V2D3914 00589000
- BAL 14,NUM LOOK FOR SECOND ARGUMENT 00590000
- B PRINSTAR CHECK FOR '*' IF NOT NUMERIC 00591000
- BL PRINT1 BRANCH IF NOTHING THERE (USE VERCOL) 00592000
- C 0,ITEM COMPARE WITH ITEM LENGTH 00593000
- BH INVREQ BRANCH IF GREATER (INVALID) 00594000
- LR 3,0 SET COLUMN LIMIT AS GIVEN 00595000
- LTR R3,R3 CHECK IF NUMBER OF COLUMNS = 0 @VA07129 00596000
- BZ INVREQ YES (INVALID REQUEST) @VA07129 00597000
- PRINCHK EQU * CHECK NO MORE ARGUMENTS 00598000
- BAL 14,PARMCHK CHECK NO MORE PARMS 00599000
- PRINT1 EQU * 00600000
- LTR R0,R2 HOW MANY LINES? @V2D3913 00601000
- BZ NEXT BRANCH IF NONE 00602000
- TM FLAG2,TUBE DISPLAY TERMINAL ? @V200714 00603000
- BNO PRINTSK NO...BR @V200714 00604000
- OI TWITCH,VEROVER SET VERIFY OVERRIDE @V2D3913 00605000
- BCT R0,TYPIN DECREMENT COUNT + USE NEXT @V2D3914 00606000
- B LOCFND1 UNLESS NO COUNT @V2D3914 00607000
- SPACE 1 00608000
- PRINTSK EQU * @V200714 00609000
- L R1,PTR2 GET THE CL POINTER @V2D3913 00610000
- BAL R14,EORCHK TEST FILE BOUNDS @V2D3913 00611000
- B PRINTLP1 MUST TYPE 'TOF' OR 'EOF' @V2D3913 00612000
- B PRINTLP2 GO TYPE THE CURENT LINE @V2D3913 00613000
- SPACE 00614000
- PRINTLP EQU * 00615000
- BAL R14,XNEXT GET POINTER TO NEXT LINE @V2D3913 00616000
- TM TWITCH,TOPSW+EOF ENDRANGE? @V2D3913 00617000
- BZ PRINTLP2 CONTINUE IF NOT @V2D3913 00618000
- PRINTLP1 LA R2,1 FUDGE LOOP-COUNT @V2D3913 00619000
- SPACE 1 00620000
- PRINTLP2 EQU * @V2D3913 00621000
- LR R0,R3 REFRESH VERIFY COLUMN @V2D3913 00622000
- LA R1,8(R4,R1) POINT TO THE VERIFICATION COLUMN @V2D3914 00623000
- BAL 14,WRTYPE2 TYPE LINE 00624000
- BCT R2,PRINTLP LOOP 'TIL COUNT EXHAUSTED @V2D3913 00625000
- B NEXT BRANCH IF ALL DONE 00626000
- SPACE 00627000
- PRINSTAR EQU * CHECK UP ON '*' 00628000
- BAL 14,STARCHK IF NOT '*', ERROR - DON'T RETURN 00629000
- L 3,ITEM SET COLUMN LIMIT TO ITEM LENGTH 00630000
- SR R4,R4 IGNOR VERIFY COLUMN @VA04968 00631000
- B PRINCHK GO CHECK NO MORE ARGUMENTS 00632000
- EJECT 00633000
- *********************************************************************** 00634000
- ** 00635000
- ** XWRITE--INSERT A LINE INTO CORE 00636000
- ** 00637000
- ** INPUT-- 00638000
- ** R1--ADDRESS OF LINE TO BE WRITTEN 00639000
- ** R14--RETURN ADDRESS 00640000
- ** 00641000
- ** OUTPUT-- 00642000
- ** THE UPDATED LIST 00643000
- ** PTR2=>INSERT (AS IF INSERT HAS JUST BEEN READ) 00644000
- ** (LINE JUST READ)=>INSERT=>(NEXT LINE) 00645000
- ** 00646000
- ** EXIT-- 00647000
- ** RETURN VIA R14 00648000
- ** CC SET NEGATIVE IF CORE EXHAUSTED 00649000
- ** 00650000
- ** (LEVEL 1 SUBROUTINE. USES REGSAV.) 00651000
- ** 00652000
- *********************************************************************** 00653000
- SPACE 00654000
- XWRITE DS 0H 00655000
- NI TWITCH,255-(TOPSW+EOF) NOT AT TOP OR BOTTOM 00656000
- ST 14,REGSAV SAVE RETURN 00657000
- L 14,SPARES NUMBER OF SPARES LEFT IN CORE 00658000
- LTR 14,14 ANY? 00659000
- BZ CORBUST BRANCH IF NOT 00660000
- BCTR 14,0 REDUCE BY 1 00661000
- ST 14,SPARES AND STORE AS NEW VALUE OF SPARES 00662000
- L 15,FPTR LOAD FREE-LIST POINTER 00663000
- LTR 15,15 IS LIST EMPTY 00664000
- BNZ XWRIT08 NO, WE'RE OK 00665000
- L 15,AEXTEND LIMIT TO WHICH WE'VE GONE SO FAR 00666000
- SR 0,0 CLEAR FORWARD CHAIN OF NEW LINE 00667000
- ST 0,0(,15) 00668000
- LR 0,15 COMPUTE NEW BOUND 00669000
- A 0,CORITEM 00670000
- ST 0,AEXTEND AND SAVE IN AEXTEND 00671000
- SPACE 00672000
- XWRIT08 EQU * 00673000
- L 0,0(,15) LOAD NEXT ENTRY ADDRESS 00674000
- ST 0,FPTR AND UPDATE FREE-LIST POINTER 00675000
- L 14,ITEM LOAD ITEM LENGTH 00676000
- BCTR 14,0 MINUS '1' FOR 'EX' 00677000
- EX 14,XWRIT02 MOVE IN LINE 00678000
- L 1,PTR2 GR1=A(OLD ITEM) 00679000
- ST 15,PTR2 READ PTR POINTS TO ITEM 00680000
- L 14,0(,1) GR14=A(OLD+1) 00681000
- ST 14,0(,15) E =>OLD+1 00682000
- LTR 14,14 IS OLD+1=EOF 00683000
- BNZ XWRIT08A NO ... BR @V2D3913 00684000
- ST R15,PTR3 RESET BOTTOM LINE POINTER @V2D3913 00685000
- B XWRIT08B CONTINUE @V2D3913 00686000
- EJECT 00687000
- XWRIT08A EQU * @V2D3913 00688000
- ST 15,4(,14) NO, E <= OLD+1 00689000
- XWRIT08B EQU * @V2D3913 00690000
- ST 1,4(,15) OLD <= E 00691000
- ST 15,0(,1) OLD => E 00692000
- BAL 14,AUTOCHEK CHECK FOR AUTO. SAVING @V200706 00693000
- L 14,SPARES 00694000
- LTR 14,14 HOW MANY SPARES LEFT? 00695000
- BZ CORFULL BRANCH IF NONE 00696000
- SR 15,15 CLEAR CONDITION CODE 00697000
- XWRITEX EQU * RETURN FROM 'XWRITE' 00698000
- L 14,REGSAV RESTORE RETURN ADDRESS 00699000
- BR 14 RETURN TO CALLER 00700000
- SPACE 00701000
- XWRIT02 MVC 8(*-*,15),0(1) BLANK 'MVC' FOR 'EX' 00702000
- EJECT 00703000
- ****************************************************************** 00704000
- * 00705000
- * 'AUTOCHEK' IS CALLED TO CHECK FOR ACTIVE AUTOMATIC SAVING 00706000
- * OF THE UPDATED FILE. ANY UPDATING SUBROUTINE (XWRITE, 00707000
- * XREPL OR XDELE) CALLS BY BAL 14,AUTOCHEK . 00708000
- * 00709000
- * (LEVEL 2 SUBROUTINE. USES AUTOREG.) 00710000
- * 00711000
- ****************************************************************** 00712000
- SPACE 1 00713000
- AUTOCHEK EQU * COME HERE TOO FROM 'REPLACE'@V200706 00714000
- TM SIGNAL,AUTOFLAG AUTO. SAVE ACTIVE? @V200706 00715000
- BCR 8,14 IF NOT, RETURN @V200706 00716000
- STM 13,9,AUTOREG SAVE CALLER'S STUFF @V200706 00717000
- LH 1,AUTOCURR IF SO, BUMP THE LINE COUNT @V200706 00718000
- LA 1,1(,1) @V200706 00719000
- CH 1,AUTOCNT AND CHEK FOR LIMIT @V200706 00720000
- BL UPAUTO @V200706 00721000
- OI SIGNAL,AUTOSVFL IF LIMIT REACHED, SAVE. @V200706 00722000
- MVC NEWNAME(18),FNAME MAKE SURE WE IDENTIFY IT @V200706 00723000
- B FILE1 @V200706 00724000
- UPAUTO STH 1,AUTOCURR @V200706 00725000
- SAVRET EQU * COME HERE AFTER AUTO. SAVE @V200706 00726000
- LM 13,9,AUTOREG @V200706 00727000
- BR 14 RETURN TO CALLING SUBROUTINE@V200706 00728000
- EJECT 00729000
- *********************************************************************** 00730000
- ** 00731000
- ** XREPL--REPLACE A LINE IN CORE 00732000
- ** 00733000
- ** INPUT-- 00734000
- ** UPDATE LINE IN 'LINE' 00735000
- ** R14--RETURN REGISTER 00736000
- ** 00737000
- ** OUTPUT-- 00738000
- ** UPDATED LINE IN CORE 00739000
- ** 00740000
- ** EXITS-- 00741000
- ** RETURN TO CALLER 00742000
- ** 00743000
- * (LEVEL N SUBROUTINE. USES REGSAV ) 00744000
- ** 00745000
- *********************************************************************** 00746000
- SPACE 00747000
- XREPL DS 0H @V2D3914 00748000
- TM FLAG,CAN CANONICALIZATION ON? 00749000
- BZ XREPLX BRANCH IF NOT 00750000
- LA 1,LINE 00751000
- L 0,ITEM ITEM LENGTH IN R0 00752000
- BAL 15,CANON GO CANONICALIZE 00753000
- SPACE 00754000
- XREPLX EQU * 00755000
- ST 14,REGSAV SAVE CALLER'S ADDRESS @V200706 00756000
- L 15,PTR2 LOAD READ POINTER 00757000
- L 1,ITEM LOAD ITEM LENGTH 00758000
- BCTR 1,0 MINUS '1' FOR 'EX' 00759000
- EX 1,XREPL01 UPDATE RECORD IN LIST 00760000
- TM TWITCH,SAVOVER OVERRIDE AUTOSAVE ? @V2D3914 00761000
- BO NOSAV YES ... BR @V2D3914 00762000
- BAL 14,AUTOCHEK CHECK FOR AUTO. SAVING @V200706 00763000
- NOSAV L R14,REGSAV RESTORE RETURN REG @V2D3914 00764000
- BR 14 AND RETURN TO CALLER 00765000
- SPACE 00766000
- XREPL01 MVC 8(*-*,15),LINE BLANK 'MVC' FOR 'EX' 00767000
- EJECT 00768000
- *********************************************************************** 00769000
- ** 00770000
- ** XREAD--READ AN LINE FROM CORE 00771000
- ** 00772000
- ** INPUT-- 00773000
- ** R14--RETURN ADDRESS 00774000
- ** 00775000
- ** OUTPUT-- 00776000
- ** THE NEXT LINE IN 'LINE' 00777000
- ** 00778000
- ** EXITS-- 00779000
- ** VIA R14 ONLY 00780000
- ** (EOF FLAG SET IF AT EOF) 00781000
- ** 00782000
- ** (LEVEL 1 SUBROUTINE. USES REGSAV.) 00783000
- ** 00784000
- *********************************************************************** 00785000
- SPACE 00786000
- XREAD DS 0H 00787000
- ST 14,REGSAV SAVE R14 00788000
- BAL 14,XNEXT CALL XNEXT TO DO THE WORK 00789000
- L 14,REGSAV RESTORE R14 00790000
- SPACE 00791000
- XREADB EQU * SECONDARY ENTRY POINT 00792000
- L 15,ITEM LOAD ITEM LENGTH 00793000
- L R1,PTR2 REFRESH POINTER TO CL @V2D3913 00794000
- BCTR 15,0 MINUS '1' FOR 'MVC' 00795000
- EX 15,XREAD02 MOVE DATA INTO 'LINE' 00796000
- BR 14 AND RETURN TO CALLER 00797000
- SPACE 2 00798000
- XREAD02 MVC LINE(*-*),8(1) BLANK 'MVC' FOR 'EX' 00799000
- EJECT 00800000
- *********************************************************************** 00801000
- ** 00802000
- ** XNEXT (AND XNEXTA) -- CHAIN TO NEXT LINE IN CORE 00803000
- ** WITHOUT MOVING THE CONTENTS 00804000
- ** 00805000
- ** CALL: 00806000
- ** BAL 14,XNEXT (OR BAL 14,XNEXTA) 00807000
- ** 00808000
- ** ACTION: 00809000
- ** SETS NEW VALUE OF READ POINTER (PTR2); 00810000
- * SETS EOF OR TOPSW AS APPROPRIATE. 00811000
- ** 00812000
- ** EXIT: 00813000
- ** BR 14 00814000
- ** 00815000
- ** (LEVEL 1 SUBROUTINE; LEVEL N WHEN CALLED FROM 00816000
- ** XREAD OR XDELE.) 00817000
- ** 00818000
- *********************************************************************** 00819000
- SPACE 00820000
- XNEXT DS 0H 00821000
- L R15,PTR2 GET THE CURRENT LINE POINTER @V2D3913 00822000
- TM TWITCH,UPWARD IS THIS AN UP REQUEST @V2D3913 00823000
- BO XNEXTA IF SO, GO HANDLE @V2D3913 00824000
- L R1,0(,R15) GR1 = A(OLD+1) @V2D3913 00825000
- LTR R1,R1 IS OLD+1 = EOF ? @V2D3913 00826000
- BNZ XNEXTB NO ... BR @V2D3913 00827000
- OI TWITCH,EOF TURN ON THE EOF INDICATOR @V2D3913 00828000
- NI TWITCH,255-TOPSW TURN OFF TOF INDICATOR @V2D3913 00829000
- LR R1,R15 LOAD PTR INTO PARM REG @V2D3913 00830000
- BR R14 RETURN @V2D3913 00831000
- SPACE 1 00832000
- XNEXTA L R1,4(,R15) GR1 = A(OLD-1) @V2D3913 00833000
- LTR R1,R1 IS OLD-1= TOF ? @V2D3913 00834000
- BZ XNEXTC YES ... BR @V2D3913 00835000
- C R15,PTR1 ARE WE AT TOF ? @V2D3913 00836000
- BNE XNEXTB NO ... BR @V2D3913 00837000
- TM TWITCH,EOF ARE WE AT EOF ? @V2D3913 00838000
- BO XNEXTB YES ... BR @V2D3913 00839000
- LA R15,PTR1 SET CURRENT LINE POINTER @V2D3913 00840000
- ST R15,PTR2 TO TOF AND @V2D3913 00841000
- B XNEXTC SET FLAG @V2D3913 00842000
- SPACE 1 00843000
- XNEXTB TM TWITCH,EOF ARE WE AT EOF ? @V2D3913 00844000
- BZ XNEXTB1 NO ... BR @V2D3913 00845000
- LR R1,R15 DON'T CHANGE CURRENT LINE PTR @V2D3913 00846000
- XNEXTB1 ST R1,PTR2 LOAD CURRENT LINE PTR @V2D3913 00847000
- NI TWITCH,255-(TOPSW+EOF) RESET LIMIT FLAGS @V2D3913 00848000
- BR R14 RETURN @V2D3913 00849000
- SPACE 1 00850000
- XNEXTC OI TWITCH,TOPSW SET TOF @V2D3913 00851000
- NI TWITCH,255-EOF RESET EOF @V2D3913 00852000
- LR R1,R15 LOAD PTR INTO PARM REG @V2D3913 00853000
- BR R14 RETURN @V2D3913 00854000
- EJECT 00855000
- *********************************************************************** 00856000
- * 00857000
- * CLOSE IS A SUBROUTINE WHICH SETS THE TOP LINE AS THE 00858000
- * CURRENT LINE UNLESS AT TOF WHEN GOING UPWARD 00859000
- * IN WHICH CASE EOF IS SET. 00860000
- * 00861000
- * CALL: 00862000
- * BAL 14,CLOSE 00863000
- * 00864000
- * (LEVEL 1 SUBROUTINE) 00865000
- * 00866000
- *********************************************************************** 00867000
- SPACE 00868000
- CLOSE DS 0H 00869000
- TM TWITCH,UPWARD+TOPSW TOF & UPWARD? @V2D3913 00870000
- BO CLOSE1 HANDLE IF SO @V2D3913 00871000
- OI TWITCH,TOPSW BACK AT TOP OF FILE 00872000
- NI TWITCH,255-EOF CLEAR EOF BIT 00873000
- LA 0,PTR1 POINT TO 'TOP' OF FILE 00874000
- CLOSEX EQU * @V2D3913 00875000
- ST 0,PTR2 RESET READ POINTER 00876000
- BR 14 AND RETURN TO CALLER 00877000
- SPACE 1 00878000
- CLOSE1 OI TWITCH,EOF SET END-OF-FILE @V2D3913 00879000
- NI TWITCH,255-TOPSW TURN OFF TOF @V2D3913 00880000
- L R0,PTR3 LOAD BOTTOM LINE PTR @V2D3913 00881000
- B CLOSEX JOIN COMMON CODE @V2D3913 00882000
- SPACE 3 00883000
- *************************************************************** 00884000
- * 00885000
- * EORCHK CHECKS FOR TOPSW+UPWARD OR EOF+¬UPWARD 00886000
- * 00887000
- *************************************************************** 00888000
- SPACE 1 00889000
- EORCHK DS 0H @V2D3913 00890000
- TM TWITCH,TOPSW+UPWARD UPPER BOUND? @V2D3913 00891000
- BOR R14 RETURN, IF SO. @V2D3913 00892000
- TM TWITCH,UPWARD IS THE DIRECTION UPWARD AT ALL? @V2D3913 00893000
- BO 4(,R14) NO PROBLEM, IF SO. @V2D3913 00894000
- TM TWITCH,EOF THEN, IS IT END-OF-FILE? @V2D3913 00895000
- BOR R14 RETURN, IF SO. @V2D3913 00896000
- B 4(,R14) ALL ELSE IS OK @V2D3913 00897000
- EJECT 00898000
- *************************************************************** 00899000
- * 00900000
- * 'NOTFOUND' AND 'ENDRANGE' ARE BRANCHED TO FROM ALL 00901000
- * OVER THE PLACE AND TYPE 'EOF' OR 'TOF' AS REQUIRED 00902000
- * 00903000
- *********************************************************************** 00904000
- SPACE 00905000
- NOTFOUND DS 0H (COME HERE FROM FIND, LOCATE AND CHANGE) 00906000
- MVI SCRFLGS,WRFULLB REWRITE ALL TEXT @V2D3913 00907000
- WTYPE FLDNTFND TELL HIM FIELD NOT FOUND 00908000
- TM FLAG2,TUBE DISPLAY TUBE? @V2D3913 00909000
- BO NEXT SCREEN LOOKS FINE IF SO @V2D3913 00910000
- SPACE 1 00911000
- ENDRANGE TM TWITCH,EOF+TOPSW ENDRANGE? @V2D3913 00912000
- BZ NEXT NOPE, SO GET NEXT REQUEST @V2D3913 00913000
- ENDRANG1 OI SCRFLGS,WRFULLB @V2D3913 00914000
- VERIFY RETURN=NEXT @V2D3913 00915000
- SPACE 1 00916000
- EOFREC DC C'EOF:' 00917000
- TOPMSG DC C'TOF:' @V200713 00918000
- EJECT 00919000
- *********************************************************************** 00920000
- * 00921000
- * VERSUB--VERIFY SUBROUTINE (IT FIGURES) 00922000
- * 00923000
- * INPUT-- 00924000
- * R14--RETURN REGISTER 00925000
- * 00926000
- * OUTPUT-- 00927000
- * TYPED OUT LINE IF IN VERIFY MODE 00928000
- * 00929000
- * EXITS-- 00930000
- * RETURN VIA R14 ONLY 00931000
- * 00932000
- * (LEVEL 1 SUBROUTINE; ALSO CALLED AS LEVEL 2 SUBROUTINE 00933000
- * FROM REPT ONLY. USES REGSAV.) 00934000
- * 00935000
- *********************************************************************** 00936000
- SPACE 00937000
- VERSUB DS 0H 00938000
- TM FLAG2,VER VERIFY MODE? @V1D1613 00939000
- BO MVERSUB YES ... BR @V2D3913 00940000
- TM TWITCH,VEROVER IMMEDIATE VERIFY(OVERRIDE)? @V2D3913 00941000
- BZR R14 NO ... BR @V2D3913 00942000
- NI TWITCH,255-VEROVER RESET OVERRIDE FLAG @V2D3913 00943000
- MVERSUB STM 14,1,REGSAV @V2D3913 00944000
- TM SCRFLGS,WRCLB+WRCLUPB+WRCLDNB+WRSTATB @V2D3913 00945000
- BNZ VERTYP JUST DISPLAY AS SPECIFIED @V2D3913 00946000
- OI SCRFLGS,WRTOPB WRITE ALL IF NO SPECIFIC REQUEST @V2D3913 00947000
- VERTYP LH R0,VERLEN LOAD VERIFY LENGTH @V2D3914 00948000
- L R1,PTR2 POINT TO THE CURRENT LINE @V2D3913 00949000
- LH R14,VERCOL1 SET VERIFY INDEX FOR @V2D3914 00950000
- BCTR R14,R0 WRTYPE @V2D3914 00951000
- LA R1,8(R14,R1) POINT TO DATA PORTION @V2D3914 00952000
- BAL 14,WRTYPE2 TYPE LINE 00953000
- LM 14,1,REGSAV RESTORE REGISTERS 00954000
- BR 14 RETURN TO CALLER 00955000
- EJECT 00956000
- *********************************************************************** 00957000
- * 00958000
- * PARMCHK CHECKS WHETHER WE HAVE REACHED THE END OF THE 00959000
- * ARGUMENT LIST. 00960000
- * IF WE HAVE, IT RETURNS IMMEDIATELY. 00961000
- * OTHERWISE IT JUMPS TO INVREQ. 00962000
- * 00963000
- * CALL: 00964000
- * BAL 14,PARMCHK 00965000
- * 00966000
- * (LEVEL 1 SUBROUTINE) 00967000
- * 00968000
- *********************************************************************** 00969000
- SPACE 00970000
- PARMCHK DS 0H 00971000
- STM 14,1,REGSAV SAVE REGS 00972000
- LH 1,COUNT 00973000
- SH 1,EDCT NO OF CHARS LEFT 00974000
- BZ PARMRET NONE - RETURN PRONTO 00975000
- BAL 14,GET CALL GET 00976000
- BNZ INVREQ BRANCH IF PARMS 00977000
- PARMRET EQU * 00978000
- LM 14,1,REGSAV RESTORE REGS 00979000
- BR 14 RETURN 00980000
- SPACE 4 00981000
- *********************************************************************** 00982000
- * 00983000
- * STARCHK CHECKS WHETHER XXXCWD CONTAINS '*' AND RETURNS WITH 00984000
- * R0 = -1 AND CC +VE IF IT DOES. 00985000
- * OTHERWISE IT JUMPS TO INVREQ. 00986000
- * 00987000
- * CALL: 00988000
- * BAL 14,STARCHK 00989000
- * 00990000
- * (LEVEL 1 SUBROUTINE) 00991000
- * 00992000
- *********************************************************************** 00993000
- SPACE 00994000
- STARCHK DS 0H 00995000
- CLI XXXCWD,C'*' 00996000
- BNE INVREQ 00997000
- SR 0,0 00998000
- BCTR 0,0 SET FOR INFINITE LOOP 00999000
- LPR 1,0 SET CC +VE 01000000
- BR 14 RETURN 01001000
- EJECT 01002000
- *********************************************************************** 01003000
- * 01004000
- * GET SCANS EDLIN FROM EDCT AND PUTS THE NEXT TOKEN IN XXXCWD. 01005000
- * 01006000
- * CALL: 01007000
- * BAL 14,GET 01008000
- * 01009000
- * WILL BRANCH DIRECTLY TO INVREQ (INVALID EDIT REQUEST) IF 01010000
- * A TOKEN IS LONGER THAN 8 CHARACTERS, OR IF IT IS NOT 01011000
- * APPROPRIATELY DELIMITED. 01012000
- * 01013000
- * (LEVEL 1 SUBROUTINE; LEVEL 2 WHEN CALLED FROM PARMCHK OR 01014000
- * NUM. USES REGSAVX.) 01015000
- * 01016000
- *********************************************************************** 01017000
- SPACE 01018000
- GET DS 0H 01019000
- MVC XXXCWD(8),XXXCWD-1 CLEAR XXXCWD 01020000
- MVI GETFLAG,X'00' CLEAR GETFLAG 01021000
- LH 1,EDCT START SCANNING HERE. 01022000
- LH 0,COUNT DO THE NEXT COUNT-EDCT CHARACTERS. 01023000
- SR 0,1 01024000
- BNH GET3E IF NO MORE - RETURN EMPTY. 01025000
- STM 2,4,REGSAVX 01026000
- SR 2,2 NO. OF CHARS IN WORD 01027000
- SPACE 01028000
- GET1A EQU * @V200714 01029000
- LA 3,EDLIN(1) 01030000
- CLI 0(3),C' ' COMPARE FOR BLANK. 01031000
- BE GET2 YES. 01032000
- TM SIGNAL,GETCAT TEST GETCAT FLAG 01033000
- BO GET3D BRANCH IF ON 01034000
- BAL 4,CHARTYPE FIND CHARTYPE 01035000
- BL GETNONAN BRANCH IF NOT ALPHANUMERIC 01036000
- BH GETNUM BRANCH IF NUMERIC 01037000
- TM SIGNAL,HEXSW HEX FLAG SET? 01038000
- BZ GETALPH BRANCH IF NOT (ALPHABETIC) 01039000
- MVI BYTE,X'40' PREPARE TO CONVERT TO UPPER CASE 01040000
- OC BYTE(1),0(3) USE 'BYTE' (A USEFUL TEMP) 01041000
- CLI BYTE,C'F' HEX? 01042000
- BNH GETNUM BRANCH IF SO (TREAT AS NUMERIC) 01043000
- SPACE 01044000
- GETALPH EQU * IT'S ALPHABETIC 01045000
- LTR 2,2 ANYTHING FOUND YET? 01046000
- BNZ GETALPH1 BRANCH IF SO 01047000
- OI GETFLAG,ALPHA SET THE ALPHABETIC FLAG 01048000
- B GET3B AND CONTINUE 01049000
- GETALPH1 EQU * 01050000
- TM GETFLAG,ALPHA WAS THAT ALPHABETIC TOO? 01051000
- BZ GET5 BRANCH IF NOT 01052000
- B GET3C AND CONTINUE 01053000
- SPACE 01054000
- GETNONAN EQU * NOT ALPHANUMERIC 01055000
- LTR 2,2 ANYTHING FOUND YET? 01056000
- BNZ GET5 BRANCH IF SO (TERMINATE PRONTO) 01057000
- OI GETFLAG,NONALNUM SET NON-ALPHANUMERIC FLAG 01058000
- B GET3B AND CONTINUE 01059000
- SPACE 01060000
- GETNUM EQU * IT'S A NUMBER 01061000
- LTR 2,2 ANYTHING FOUND YET? 01062000
- BZ GET3B BRANCH IF NOT 01063000
- TM GETFLAG,ALPHA+NONALNUM WAS THAT NUMERIC TOO? 01064000
- BNZ GET5 BRANCH IF NOT (QUIT) 01065000
- B GET3C CONTINUE 01066000
- SPACE 01067000
- GET3D EQU * 01068000
- LTR 2,2 ANYTHING FOUND YET? 01069000
- BNZ GET3C BRANCH IF SO 01070000
- GET3B EQU * 01071000
- STH 1,EDCT SAVE START OF TOKEN 01072000
- GET3C EQU * 01073000
- LA 2,1(2) INCREMENT TOKEN LENGTH 01074000
- GET3A EQU * 01075000
- LA 1,1(1) LOOK AT NEXT CHAR 01076000
- BCT 0,GET1A AND LOOP UNTIL EDLIN EXHAUSTED @V200714 01077000
- SPACE 01078000
- LTR 2,2 ANYTHING FOUND? 01079000
- BNZ GET5 BRANCH IF SO 01080000
- LM 2,4,REGSAVX RESTORE REGISTERS 01081000
- GET3E EQU * 01082000
- NI SIGNAL,255-(GETCAT+HEXSW) CLEAR SPECIAL GET FLAGS 01083000
- SR 1,1 SET CONDITION CODE 01084000
- BR 14 RETURN 01085000
- SPACE 01086000
- GET2 EQU * FOUND A BLANK 01087000
- LTR 2,2 ANYTHING FOUND YET? 01088000
- BZ GET3A BRANCH IF NOT 01089000
- LA 1,1(1) RESUME SEARCH AT NEXT CHARACTER 01090000
- SPACE 01091000
- GET5 EQU * 01092000
- LH 0,EDCT SAVE STARTING POSITION 01093000
- STH 1,EDCT STORE NEW START OF LOOK. 01094000
- LR 1,0 01095000
- LA 1,EDLIN-1(1) FORM STARTING ADDRESS. 01096000
- LA 4,8 MAX ARGUMENT LENGTH @V200713 01097000
- CR 2,4 SHOULDN'T BE GREATER @V200713 01098000
- BH GETBUST BRANCH IF IT ISN'T 01099000
- TM SIGNAL,GETCAT IS GETCAT SET? 01100000
- BZ GET7 BRANCH IF NOT 01101000
- CLI 0(1),C' ' CHECK THAT PRECEDING CHAR WAS BLANK 01102000
- BNE GETBUST BRANCH IF IT WASN'T 01103000
- SPACE 01104000
- GET7 EQU * 01105000
- LR 4,2 SAVE FOR SETTING COND. CODE PRESENTLY 01106000
- BCTR 2,0 DECREASE FOR EXEC 01107000
- EX 2,MOVCWD MOVE TOKEN INTO XXXCWD 01108000
- CLI CASESW,C'S' LOWER-CASE FILE? 01109000
- BNE GET9 BRANCH IF NOT 01110000
- TM SIGNAL,HEXSW IS THIS A SPECIAL HEXSW CALL? 01111000
- BO GET9 BRANCH IF SO 01112000
- EX 2,UPCASE CONVERT TO UPPER CASE 01113000
- SPACE 01114000
- GET9 EQU * 01115000
- NI SIGNAL,255-(GETCAT+HEXSW) CLEAR SPECIAL GET FLAGS 01116000
- LR 1,2 RETURN VALUE 01117000
- LTR 4,4 SET CONDITION CODE 01118000
- LM 2,4,REGSAVX RESTORE REGS 01119000
- BR 14 RETURN. 01120000
- SPACE 01121000
- GETBUST EQU * 01122000
- NI SIGNAL,255-(GETCAT+HEXSW) CLEAR SPECIAL GET FLAGS 01123000
- B INVREQ 01124000
- SPACE 01125000
- MOVCWD MVC XXXCWD(*-*),1(1) 01126000
- EJECT 01127000
- *********************************************************************** 01128000
- * 01129000
- * 'NUM' ACTS AS GET DOES, BUT DEALS WITH A NUMERIC TOKEN. 01130000
- * LEAVES THE ANSWER IN R0. 01131000
- * 01132000
- * CALL: 01133000
- * BAL 14,NUM 01134000
- * 01135000
- * NORMAL RETURN: 01136000
- * B 4(,14) 01137000
- * ERROR RETURN: 01138000
- * BR 14 01139000
- * 01140000
- * IF NO FIELD IS PRESENT, CC IS SET -VE AND R0 = 1. 01141000
- * 01142000
- * (LEVEL 1 SUBROUTINE. USES REGSAV.) 01143000
- * 01144000
- *********************************************************************** 01145000
- SPACE 01146000
- NUM DS 0H 01147000
- ST 14,REGSAV SAVE REGISTER 14. 01148000
- BAL 14,GET CALL FOR NEXT FIELD INTO XXXCWD. 01149000
- BNZ CHEKNUM BNZ IF SPECIFIED, CHECK NUMERIC-IND. 01150000
- BCTR 1,0 01151000
- LTR 1,1 01152000
- LA 0,1 01153000
- B NUM1 01154000
- SPACE 01155000
- CHEKNUM EQU * 01156000
- TM GETFLAG,ALPHA+NONALNUM CHECK WHETHER NUMERIC TOKEN 01157000
- BZ NUM2 VALID NUMERICAL ENTRY. TR 01158000
- L 14,REGSAV OBTAIN RETURN ADDRESS TR 01159000
- BR 14 ERROR RETURN TR 01160000
- SPACE 01161000
- NUM2 EQU * TR 01162000
- LA 0,1(,1) SET R0 TO NUMBER OF CHARACTERS JS 01163000
- LA 1,XXXCWD CALL FOR CONVERSION 01164000
- BAL 14,DECBIN 01165000
- LTR 0,1 RETURN CONDITION CODE. 01166000
- SPACE 01167000
- NUM1 EQU * 01168000
- L 14,REGSAV RESTORE RETURN. 01169000
- B 4(,14) NORMAL RETURN. TR 01170000
- EJECT 01171000
- *********************************************************************** 01172000
- * 01173000
- * 'SPREAD' ACCEPTS A LINE WHICH MAY CONTAIN TABS AND 01174000
- * BACKSPACES, AND WHICH STARTS AT EDLIN(EDCT), AND SPREADS 01175000
- * IT OUT ACCORDING TO THE CURRENT TAB SETTINGS. 01176000
- * CHARACTERS ARE NOT AFFECTED BY BEING BACKSPACED OVER; 01177000
- * CHARACTERS WHICH ARE MOVED OVER FORWARDS ARE REPLACED. 01178000
- * 01179000
- * IF CANONICALIZATION IS IN EFFECT, TABS AND BACKSPACES ARE 01180000
- * NOT REPLACED; INSTEAD THE LINE IS PROCESSED BY THE CANAONI- 01181000
- * CALIZING ROUTINE. 01182000
- * 01183000
- * IF 'IMAGE' IS OFF, THE LINE IS PASSED THROUGH AS TYPED. 01184000
- * 01185000
- * CALL: 01186000
- * BAL 14,SPREAD 01187000
- * 01188000
- * (LEVEL 1 SUBROUTINE. USES REGSAV.) 01189000
- * 01190000
- *********************************************************************** 01191000
- SPACE 01192000
- SPREAD DS 0H 01193000
- STM 2,6,REGSAV SAVE REGS 01194000
- NI TWITCH,255-TRUNC CLEAR TRUNCATION BIT 01195000
- L 1,ITEM ITEM LENGTH 01196000
- BCTR 1,0 DECREASE FOR EXEC 01197000
- EX 1,TABCLR CLEAR TABLIN AS FAR AS THE ITEM LENGTH 01198000
- SR 5,5 CLEAR MAX. COLUMN COUNT 01199000
- LA 4,TABS+1 GET LOCATION OF TABS TABLE 01200000
- LH 3,COUNT NUMBER OF TYPED CHARACTERS. 01201000
- LA R2,1 SET INITIAL OFFSET @VA03027 01202000
- TM FLAG,LEFT @VA03536 01203000
- BO BYPS YES, THEN DONT CHECK DISPLAY FLAG@VA03536 01204000
- TM CHNGFLAG,DTYPE IS DISPLAY BIT ON? @VA03027 01205000
- BNO BYPS NO, USE FIRST TAB @VA08298 01205300
- CLI TABS,X'01' FIRST TAB BEYOND COLUMN 1? @VA08298 01205600
- BNH NOTAB NO, BRANCH @VA08298 01205900
- BCTR R4,0 POINT TO FIRST TAB SETTING @VA08298 01206200
- B NOTAB ALL TABS AVAILABLE NOW @VA08298 01206500
- BYPS SR 2,2 @VA03536 01207000
- IC 2,TABS FIRST TAB IS START COLUMN 01208000
- NOTAB LH 1,EDCT NUMBER CHARS ALREADY SCANNED @VA03027 01209000
- SR 0,0 01210000
- SR 3,1 COMPUTE NO. OF CHARACTERS LEFT TO SCAN. 01211000
- BZ SPRET NONE LEFT. 01212000
- LA 1,EDLIN(1) 01213000
- LA 15,135 HANDY IF NOT CANON @V200713 01214000
- SPACE 01215000
- * CHECK FOR CANONICALIZATION ... 01216000
- SPACE 01217000
- TM FLAG,CAN CANONICALIZATION REQUIRED? 01218000
- BZ SLOOP BRANCH IF NOT 01219000
- LR 0,3 LENGTH IN R0 01220000
- BCTR 3,0 DECREMENT FOR EXEC 01221000
- EX 3,MOVSCRPT MOVE THE TYPED LINE INTO TABLIN 01222000
- LA 1,TABLIN 01223000
- BAL 15,CANON GO CANONICALIZE 01224000
- LR 5,0 PUT NEW LWNGTH IN R5 01225000
- B TRUNCO AND GO CHECK FOR TRUNCATION 01226000
- SPACE 01227000
- MOVSCRPT MVC TABLIN(0),0(1) 01228000
- SPACE 01229000
- * CANONICALIZATION NOT REQUIRED ... 01230000
- SPACE 01231000
- SLOOP EQU * 01232000
- TM FLAG,IMNOT LINE IMAGE SUPPRESSED? 01233000
- BO SLOOP2 BRANCH IF SO 01234000
- CLI 0(1),TAB CHECK FOR TAB CHARACTER RAM 01235000
- BE STBLP BRANCH IF A TAB @V200713 01236000
- CLI 0(1),BACKSPAC NO, IS THIS REAL BACKSPACE 01237000
- BNE SLOOP2 KEEP ON IF NOT @V200713 01238000
- LA 4,TABS GET BEGINNING OF TABS @V200713 01239000
- BCT 2,SLOOP1 DECREMENT COUNT @V200713 01240000
- LA 2,1 @V200713 01241000
- B SLOOP1 @V200713 01242000
- SPACE 1 01243000
- SLOOP2 EQU * 01244000
- CH 2,TRUNCOL BEYOND TRUNC COL? 01245000
- BH TRUNCATE BRANCH IF SO 01246000
- SLOOP4 EQU * 01247000
- IC 0,0(,1) PICK UP THE CHAR 01248000
- STC 0,TABLIN-1(2) AND PUT IT INTO LINE IMAGE 01249000
- CR 2,5 IS THIS A NEW COLUMN MAXIMUM? 01250000
- BNH SLOOP3 BRANCH IF NOT 01251000
- LR 5,2 SET COLUMN MAXIMUM 01252000
- SLOOP3 EQU * 01253000
- LA 2,1(,2) MOVE TO NEXT SPOT 01254000
- SLOOP1 EQU * 01255000
- LA 1,1(,1) ADVANCE INPUT IMAGE POINTER. 01256000
- BCT 3,SLOOP AND GET NEXT CHARACTER. 01257000
- SPACE 01258000
- TRUNCO EQU * CHECK FOR TRUNCATION 01259000
- LH 2,TRUNCOL TRUNCATION COLUMN 01260000
- SR 5,2 LENGTH TO CHECK FOR BLANKS 01261000
- BNH SPRET BRANCH IF NOTHING TO CHECK 01262000
- LA 2,TABLIN(2) SPOT TO START 01263000
- TRUNCLP EQU * 01264000
- CLI 0(2),C' ' BLANK? 01265000
- BE TRUNCLP1 BRANCH IF SO 01266000
- TM SIGNAL,OVER OVERLAY FLAG SET? 01267000
- BZ TRUNCLP2 BRANCH IF NOT 01268000
- CLI 0(2),C'_' IS IT AN UNDERSCORE? 01269000
- BE TRUNCLP1 BRANCH IF SO (THAT'S OK) 01270000
- TRUNCLP2 EQU * 01271000
- OI TWITCH,TRUNC SET TRUNCATION FOR REAL 01272000
- MVI 0(2),C' ' CLEAR THE BYTE 01273000
- TRUNCLP1 EQU * 01274000
- LA 2,1(2) LOOK AT NEXT CHAR 01275000
- BCT 5,TRUNCLP LOOP UNTIL FULLY CHECKED 01276000
- SPACE 01277000
- SPRET EQU * RETURN FROM SPREAD 01278000
- LM 2,6,REGSAV RESTORE REGS 01279000
- BR 14 01280000
- SPACE 01281000
- TRUNCATE EQU * 01282000
- CLI 0(1),C' ' BLANK? 01283000
- BE SPRUNC BRANCH IF SO 01284000
- TM SIGNAL,OVER OVERLAY? 01285000
- BZ TRUNOTO BRANCH IF NOT 01286000
- CLI 0(1),C'_' UNDERSCORE? 01287000
- BE SPRUNC BRANCH IF SO 01288000
- TRUNOTO EQU * 01289000
- CR 2,15 COMPARE WITH 135 @V200713 01290000
- BNH SLOOP4 BRANCH IF NOT 01291000
- OI TWITCH,TRUNC SET TRUNCATION FOR REAL 01292000
- SPRUNC EQU * 01293000
- CR 2,15 COMPARE WITH 135 @V200713 01294000
- BNH SLOOP4 BRANCH IF SO 01295000
- B SLOOP3 01296000
- SPACE 01297000
- STBLP EQU * 01298000
- IC 0,0(,4) GET TAB VALUE 01299000
- LTR 0,0 END OF TABS? 01300000
- BZ SETRUNC BRANCH IF SO 01301000
- LA 4,1(,4) ADVANCE TO NEXT TAB VALUE 01302000
- CR 2,0 ARE WE PAST IT? 01303000
- BL STBGOT BRANCH IF NOT (GOT IT) 01304000
- B STBLP LOOP 01305000
- SPACE 01306000
- SETRUNC EQU * SET FOR TRUNCATION LATER 01307000
- LA 0,255 01308000
- SPACE 01309000
- STBGOT EQU * 01310000
- LA 6,X'40' INSERT A BLANK INTO R5 01311000
- TABPADLP EQU * 01312000
- CR 2,15 COMPARE WITH 135 @V200713 01313000
- BH SETLCOL BRANCH IF SO 01314000
- STC 6,TABLIN-1(2) PUT A BLANK INTO THE LINE IMAGE 01315000
- LA 2,1(,2) MOVE ALONG ONE 01316000
- CR 2,0 REACHED THE TAB STOP YET? 01317000
- BL TABPADLP LOOP IF NOT 01318000
- SETLCOL EQU * 01319000
- LR 2,0 01320000
- B SLOOP1 01321000
- SPACE 01322000
- TABCLR MVC TABLIN(*-*),TABLIN-1 BLANK MVC FOR CLEARING TABLIN 01323000
- EJECT 01324000
- *********************************************************************** 01325000
- * 01326000
- * NUMBER CONVERSION UTILITY ROUTINE 01327000
- * 01328000
- * CALL: 01329000
- * BAL 14,DECBIN 01330000
- * 01331000
- * (LEVEL N SUBROUTINE) 01332000
- * 01333000
- *********************************************************************** 01334000
- SPACE 01335000
- DECBIN DS 0H 01336000
- IC 15,PACK+1 FORM EXECUTABLE PACK INSTRUCTION 01337000
- BCTR 0,0 01338000
- OR 15,0 01339000
- EX 15,PACK GET PACKED DECIMAL 01340000
- OI DECIMAL+7,X'0F' FORCE PLUS 01341000
- CVB 1,DECIMAL GET BINARY VALUE 01342000
- BR 14 AND RETURN TO CALLER 01343000
- SPACE 01344000
- PACK PACK DECIMAL(8),0(0,1) PACK FOR 'EX' 01345000
- EJECT 01346000
- *********************************************************************** 01347000
- * 01348000
- * CHARTYPE SETS CONDITION CODE ACCORDING TO TYPE OF CHAR 01349000
- * POINTED TO BY R3. 01350000
- * 01351000
- * -VE: NON-ALPHANUMERIC 01352000
- * 0: ALPHABETIC 01353000
- * +VE: NUMERIC 01354000
- * 01355000
- * CALL: 01356000
- * BAL 4,CHARTYPE 01357000
- * 01358000
- * (LEVEL N SUBROUTINE) 01359000
- * 01360000
- *********************************************************************** 01361000
- SPACE 01362000
- CHARTYPE DS 0H 01363000
- CLI 0(3),X'80' 01364000
- BCR 4,4 RETURN IF NON-ALPHANUMERIC 01365000
- CLI 0(3),X'F9' 01366000
- BH EXOTIC BRANCH IF > '9' 01367000
- CLI 0(3),X'EF' 01368000
- BCR 2,4 RETURN IF NUMERIC 01369000
- SR 15,15 SET CC = 0 01370000
- BR 4 ALPHABETIC 01371000
- SPACE 01372000
- EXOTIC EQU * 01373000
- SR 15,15 SET CC = -VE 01374000
- BCTR 15,0 01375000
- LTR 15,15 01376000
- BR 4 01377000
- SPACE 3 01378000
- *********************************************************************** 01379000
- * 01380000
- * INTERFACE FOR EDCANON, CANONICALIZING ROUTINE. 01381000
- * 01382000
- * CALL: 01383000
- * BAL 15,CANON 01384000
- * 01385000
- * (LEVEL N SUBROUTINE, CALLED FROM XREPL, SPREAD, STRING1. 01386000
- * USES REGSAVX.) 01387000
- * 01388000
- *********************************************************************** 01389000
- SPACE 01390000
- CANON DS 0H 01391000
- STM 14,15,REGSAVX SAVE REGISTERS 01392000
- L 15,=V(EDCANON) CALL EDCANON 01393000
- BALR 14,15 01394000
- LM 14,15,REGSAVX RESTORE REGS 01395000
- BR 15 RETURN 01396000
- EJECT 01397000
- *********************************************************************** 01398000
- * 01399000
- * RDTYPE -- READ A LINE FROM THE TERMINAL 01400000
- * 01401000
- * CALL: 01402000
- * BAL 14,RDTYPE 01403000
- * 01404000
- * (LEVEL 1 SUBROUTINE) 01405000
- * 01406000
- *********************************************************************** 01407000
- SPACE 01408000
- RDTYPE DS 0H 01409000
- MVC CASEREAD(1),CASESW USE CURRENT SETTING 01410000
- CMS TIN CALL FOR WAITRD 01411000
- LH 0,TIN+14 SET UP 'COUNT' 01412000
- STH 0,COUNT 01413000
- LTR 0,0 SET CONDITION CODE 01414000
- BR 14 01415000
- EJECT 01416000
- *********************************************************************** 01417000
- * 01418000
- * WRTYPE -- TYPE A LINE AT THE TERMINAL 01419000
- * WRTYPE1 -- TYPE A LINE IF IN VERIFY MODE 01420000
- * WRTYPE2 -- TYPE A LINE WITH LEFT LINE NO., IF REQUIRED 01421000
- * WRTYPE3 -- AS ABOVE IF IN VERIFY MODE 01422000
- * 01423000
- * CALL: 01424000
- * BAL 14,WRTYPE (OR BAL 14,WRTYPE1) 01425000
- * 01426000
- * ON INPUT: 01427000
- * R0 = LENGTH OF STRING TO BE TYPED 01428000
- * R1 = ADDRESS OF STRING TO BE TYPED 01429000
- * 01430000
- * (LEVEL N SUBROUTINES) 01431000
- * 01432000
- *********************************************************************** 01433000
- SPACE 01434000
- WRTYPE1 DS 0H 01435000
- TM FLAG2,VER VERIFY MODE? @V1D1613 01436000
- BO WRTYPE YES ... BRANCH @VA04014 01437000
- TM TWITCH,VEROVER IMMEDIATE VERIFY OVERRIDE? @VA04014 01438000
- BCR 8,14 NO, RETURN WITH NO TYPING 01439000
- NI TWITCH,255-VEROVER RESET OVERRIDE FLAG @VA04014 01440000
- SPACE 01441000
- WRTYPE EQU * 01442000
- OI SCRFLGS,WRMSGB MESSAGE LINE ENTRY @V2D3913 01443000
- WRTYPEX EQU * @V2D3913 01444000
- TM MSGFLAGS,NOTYPING HT IN EFFECT ? @V200714 01445000
- BO WROUT YES ... BR @V2D3913 01446000
- TM FLAG2,TUBE DISPLAY TERMINAL ? @V200714 01447000
- BNO NOTGRAF NO...BR @V200714 01448000
- ST R14,REGSAVX SAVE RETURN REGISTER @V2D3913 01449000
- L R15,=V(DMSSCR) @V200714 01450000
- BALR R14,R15 LOAD BUFFERS AND DISPLAY @V200714 01451000
- BNZ IOERR BR..IF ERROR FROM SCR @VM08823 01452000
- L R14,REGSAVX RESTORE RETURN @V2D3913 01453000
- MVI SCRFLG2,X'00' CLEAR MORE STATUS FLAG @V2D3913 01454000
- WROUT NI SCRFLGS,255-WRMSGB RESET MESSAGE FLAG @V2D3913 01455000
- BR R14 RETURN TO CALLER @V200714 01456000
- NOTGRAF STH 0,TOUT+14 STORE NO BYTES TO OUTPUT @V200714 01457000
- STCM 1,B'0111',TOUT+9 STORE NEW ADDRESS @V200713 01458000
- CMS TOUT CALL CMS 01459000
- BR 14 RETURN. 01460000
- WRTYPE3 EQU * 01461000
- TM FLAG2,VER VERIFY MODE? @V1D1613 01462000
- BCR 8,14 NO,RETURN WITH NO TYPING 01463000
- WRTYPE2 EQU * 01464000
- TM TWITCH,TOPSW+EOF AT TOF OR EOF ? @V2D3913 01465000
- BZ WRTYPE2A NO ... BR @VA04074 01466000
- LA R1,EOFREC POINT TO 'EOF:' STRING @V2D3913 01467000
- LA R0,4 SET LENGTH OF MESSAGE @V2D3913 01468000
- TM TWITCH,EOF AT EOF ? @V2D3913 01469000
- BO WRTYPEX YES ... BR @V2D3913 01470000
- LA R1,TOPMSG POINT TO 'TOF:' STRING @V2D3913 01471000
- B WRTYPEX @V2D3913 01472000
- WRTYPE2A EQU * @VA04074 01473000
- TM FLAG,RIGHT LINEMODE RIGHT? @VA04074 01474000
- BZ WRTYPEX NO ... BR @VA04074 01475000
- TM FLAG2,TUBE DISPLAY TERMINAL? @VA04074 01476000
- BO WRTYPEX YES ... BR @VA04074 01477000
- L R15,PTR2 GET PTR TO CURRENT LINE @VA04074 01478000
- AH R15,LMSTART OFFSET TO LINE NUMBER @VA04074 01479000
- MVC LINENO(5),8(R15) MOVE IN NUMBER @VA04074 01480000
- LR R15,R0 GET VERIFY LINE LENGTH @VA04074 01481000
- EX R15,WREADX MOVE VERIFY DATA INTO 'LINE' @VA04074 01482000
- LA 1,6 NOW GET 6 POSITION OFFSET @VA04074 01483000
- AR 0,1 AND OFFSET THE LINE LENGTH @VA04074 01484000
- LA 1,LINENO BACKUP START @VA04074 01485000
- B WRTYPEX @VA04074 01486000
- WREADX MVC LINE(*-*),0(R1) BLANK 'MVC' FOR 'EX' @VA04074 01487000
- EJECT 01488000
- *********************************************************************** 01489000
- * 01490000
- * TABLE OF REQUESTS (IN A NICE COMPACT FORM) 01491000
- * 01492000
- * REQ MACRO HAS FORM: 01493000
- * 01494000
- * REQ NAME<,MIN-LENGTH<,ROUTINE-NAME>> 01495000
- * 01496000
- * DEFAULTS ARE: MIN-LENGTH = 1; ROUTINE-NAME = NAME 01497000
- * 01498000
- *********************************************************************** 01499000
- SPACE 01500000
- PRQUEST EQU * REQUESTS WHICH DO NOT RESET THE FOR COUNT 01501000
- REQ OVERLAY,1,OVRLAY 01502000
- REQ X,1,XXX 01503000
- REQ Y,1,YYY 01504000
- REQ ?,1,QUERY 01505000
- REQ REUSE,5,DITTO 01506000
- REQ =,1,DITTO P3123 01507000
- PRQEND EQU * 01508000
- SPACE 01509000
- RQUEST EQU * REQUESTS WHICH RESET THE FOR COUNT 01510000
- REQ INPUT,1,INSERT 01511000
- REQ REPLACE,1,RETYPE 01512000
- REQ TYPE,1,PRINT 01513000
- REQ TOP,3 01514000
- REQ DELETE,3,DELETE @V2D3914 01515000
- REQ DSTRING,2,DSTRING @V2D3914 01516000
- REQ BOTTOM 01517000
- REQ NEXT,1,NEXLIN 01518000
- REQ DOWN,2,NEXLIN 01519000
- REQ FIND 01520000
- REQ /,1,PRELOC 01521000
- REQ LOCATE 01522000
- REQ ALTER,2 01523000
- REQ CHANGE 01524000
- REQ REPEAT,6,REPEAT P3123 01525000
- REQ TRUNC,5,TRUNCIT 01526000
- REQ ZONE 01527000
- REQ TABSET,4 01528000
- REQ CASE,4 01529000
- REQ IMAGE,5 01530000
- REQ VERIFY 01531000
- REQ LONG,4 01532000
- REQ SHORT,5 01533000
- REQ PRESERVE,3 01534000
- REQ RESTORE,3 01535000
- REQ STACK,5 01536000
- REQ $,1,DOT 01537000
- REQ FNAME,2,NAME 01538000
- REQ FMODE,2,MODE 01539000
- REQ RECFM,3,RECFORM P3123 01540000
- REQ SERIAL,3 01541000
- REQ CMS,3 01542000
- REQ QUIT,4 01543000
- REQ GETFILE 01544000
- REQ SAVE,4 01545000
- REQ FILE,4 01546000
- REQ LINEMODE,4 01547000
- REQ PROMPT,6 01548000
- REQ AUTOSAVE,4 @V200706 01549000
- REQ SCROLL,1,,UP @V2D3913 01550000
- REQ FORWARD,2,NEXLIN @V200714 01551000
- REQ BACKWARD,2,BACKWD @V2D3914 01552000
- REQ RENUM,3 @V242801 01553000
- REQ FORMAT,4,FORMAT @V2D3914 01554000
- REQEND EQU * 01555000
- EJECT 01556000
- *********************************************************************** 01557000
- * 01558000
- * EXEC INSTRUCTIONS AND MISCELLANEOUS CONSTANTS 01559000
- * 01560000
- *********************************************************************** 01561000
- SPACE 2 01562000
- LINECLR MVC LINE(*-*),LINE-1 CLEAR 'LINE' (PAGE 3) 01563000
- INMOVE MVC LINE(*-*),TABLIN MOVE IN SPREAD LINE 01564000
- UPCASE OC XXXCWD(*-*),CAPS CONVERT TOKEN TO UPPER CASE 01565000
- SPACE 01566000
- CAPS DC 8X'40' BLANKS FOR UPCASE 01567000
- SPACE 01568000
- TRUNCX DC C'TRUNCATED' 01569000
- * NEXT TWO MESSAGE STRINGS MUST BE KEPT IN ORDER 01570000
- LINNOT DC C'LINE ' @V200713 01571000
- FLDNTFND DC C'NOT FOUND' 01572000
- EJECT 01573000
- *********************************************************************** 01574000
- * 01575000
- * 'DELETE' REMOVES THE NEXT N LINES FROM THE FILE. IF N IS 01576000
- * OMITTED, A VALUE OF 1 IS ASSUMED. 01577000
- * 01578000
- *********************************************************************** 01579000
- SPACE 01580000
- DELETE DS 0H @V2D3913 01581000
- BAL 14,NUM GET NUM OF DELETES TR 01582000
- BAL 14,STARCHK THEN HOPEFULLY IT'S A STAR 01583000
- BAL 14,PARMCHK CHECK NO MORE ARGUMENTS GIVEN 01584000
- DSENT LTR R2,R0 DID THE USER SPECIFY ZERO? @V2D3914 01585000
- BZ NEXT WE ARE ALL DONE IF HE DID. @V2D3913 01586000
- BAL R14,EORCHK CHECK THE CURRENT BOUNDS @V2D3913 01587000
- B ENDRANGE TYPE TOF OR EOF IF APPROPRIATE @V2D3913 01588000
- L R3,PTR2 PICK UP THE CURRENT LINE POINTER @V2D3913 01589000
- DELNEXT BAL R14,XNEXT GET THE NEXT POINTER @V2D3913 01590000
- TM TWITCH,TOPSW+EOF AT A BOUDARY YET? @V2D3913 01591000
- BNZ DELEND NO MORE LOOPING IF SO. @V2D3913 01592000
- BCT R2,DELNEXT KEEP INDEXING @V2D3913 01593000
- DELEND TM TWITCH,TOPSW+EOF IS IT TOF/EOF? @V2D3914 01594000
- BZ DELSKIP SKIP IF NOT. @V2D3914 01595000
- BCTR R2,R0 MORE ADJUSTING @V2D3913 01596000
- DELSKIP L R14,4(,R3) GET OLD BACK POINTER @V2D3914 01597000
- LTR R14,R14 WERE WE AT TOF ? @V2D3914 01598000
- BNZ NODELTOF BR IF NOT @V2D3914 01599000
- LA R4,1 COUNT IS ONE PLUS IF @V2D3914 01600000
- AR R2,R4 STARTING AT TOF @V2D3914 01601000
- L R3,0(,R3) AND POINT TO REAL 1ST LINE @V2D3914 01602000
- MVI SCRFLGS,WRFULLB UPPER DISPLAY WILL CHANGE @V2D3914 01603000
- NODELTOF SR R0,R2 HOW MANY DID WE REALLY DELETE ? @V2D3914 01604000
- BZ ENDRANG1 NONE, IF ZERO @V2D3914 01605000
- L R14,SPARES GET THE FREE-LINES COUNT. @V2D3914 01606000
- AR R14,R0 INCREMENT IT BY DECREMENT COUNT. @V2D3913 01607000
- ST R14,SPARES SAVE AS NEW FREE COUNT. @V2D3913 01608000
- TM TWITCH,UPWARD GOING UP? @V2D3913 01609000
- BO DELUP REQUIRES DIFFERENT PROCESSING @V2D3913 01610000
- OI SCRFLGS,WRCLDNB LOWER DISPLAY WILL CHANGE @V2D3914 01611000
- L R2,4(,R3) GET THE BACK POINTER @V2D3913 01612000
- SR R4,R4 @V2D3914 01613000
- TM TWITCH,EOF @V2D3913 01614000
- BNO NOTEOF BR IF NOT EOF @V2D3914 01615000
- ST R2,PTR2 SET NEW CL POINTER @V2D3914 01616000
- ST R2,PTR3 SET NEW BOTTOM POINTER @V2D3914 01617000
- B DELEOF MAKE SURE FWD PTR IS ZERO @V2D3914 01618000
- NOTEOF LR R4,R1 GET THE NEW FORWARD PONTER @V2D3914 01619000
- ST R2,4(,R1) @V2D3913 01620000
- DELEOF ST R4,0(,R2) @V2D3914 01621000
- B DELFCHN GO SET FREE LIST @V2D3914 01622000
- SPACE 1 01623000
- DELUP OI SCRFLGS,WRCLUPB UPPER DISPLAY WILL CHANGE @V2D3914 01624000
- L R2,0(,R3) GET OLD FWD POINTER @V2D3914 01625000
- ST R2,0(,R1) PUT IT IN NEW FWD POINTER @V2D3914 01626000
- LTR R2,R2 WAS IT EOF ? @V2D3914 01627000
- BZ SETPTR3 YES....BR @V2D3914 01628000
- ST R1,4(,R2) SET BACK POINTER @V2D3914 01629000
- B DELFCHN GO SET FREE LIST @V2D3914 01630000
- SPACE 1 01631000
- SETPTR3 ST R1,PTR3 SET NEW BOTTOM POINTER @V2D3914 01632000
- BCTR R0,R0 AND DECREMENT COUNT @V2D3914 01633000
- OI SCRFLGS,WRCLDNB LOWER AREA WILL CHANGE @V2D3914 01634000
- SPACE 1 01635000
- DELFCHN EQU * @V2D3914 01636000
- L R2,FPTR GET OLD FREE LIST PTR @V2D3914 01637000
- TM TWITCH,UPWARD GOING UP ? @V2D3914 01638000
- BO DELEUP YES...BR @V2D3914 01639000
- L R4,0(,R3) GET OLD FORWARD PTR @V2D3914 01640000
- B DELRDY .... @V2D3914 01641000
- DELEUP L R4,4(,R3) USE BACK PTR FOR DELETE UP @V2D3914 01642000
- DELRDY ST R2,0(,R3) FPTR BECOMES NEW FWD PTR @V2D3914 01643000
- ST R3,FPTR LOAD NEW FPTR @V2D3914 01644000
- LR R3,R4 POINT TO NEXT LINE @V2D3914 01645000
- BCT R0,DELFCHN DELETE SPECIFIED NUMBER @V2D3914 01646000
- BAL R14,AUTOCHEK PERFORM AUTOSAVE FUNCTION @V2D3914 01647000
- TM TWITCH,TOPSW+EOF AT TOP OR END OF FILE ? @VM01077 01648000
- BNZ DELVER YES, THEN VERIFY FOR HIM @VM01077 01649000
- TM FLAG2,TUBE NO VERIFICATION FOR @V2D3914 01650000
- BNO NEXT TYPEWRITER TERMINAL @V2D3914 01651000
- DELVER VERIFY RETURN=NEXT @VM01077 01652000
- EJECT 01653000
- *************************************************************** 01654000
- * 01655000
- * 'TOP' POSITIONS THE USER AT THE TOP OF HIS FILE. 01656000
- * 01657000
- *************************************************************** 01658000
- SPACE 1 01659000
- TOP DS 0H @V2D3913 01660000
- BAL R14,PARMCHK NO MORE PARAMETERS ALLOWED @V2D3913 01661000
- BAL R14,CLOSE BACK TO THE TOP @V2D3913 01662000
- B ENDRANGE PRINT TOF @V2D3913 01663000
- SPACE 4 01664000
- ********************************************************************** 01665000
- * 01666000
- * 'BOTTOM' WILL POINT TO THE LAST LINE OF FILE. 01667000
- * 01668000
- *********************************************************************** 01669000
- SPACE 01670000
- BOTTOM EQU * START OF "BOTTOM" COMMAND TR 01671000
- BAL 14,PARMCHK CHECK WHETHER LAST PARM 01672000
- SPACE 1 01673000
- BTM2 EQU * @V2D3913 01674000
- L R1,PTR3 GET BOTTOM LINE POINTER @V2D3913 01675000
- LA R14,PTR1 AND TOF POINTER @V2D3913 01676000
- CR R1,R14 AND COMPARE @V2D3913 01677000
- BNE BTM3 BR, IF NOT A NULL FILE @V2D3913 01678000
- BAL R14,CLOSE IF NULL, SET TOF FLAG @V2D3913 01679000
- B ENDRANGE AND TYPE TOF MESSAGE @V2D3913 01680000
- SPACE 1 01681000
- BTM3 EQU * @V2D3913 01682000
- ST R1,PTR2 CL PTR-> BOTTOM LINE @V2D3913 01683000
- NI TWITCH,255-(EOF+TOPSW) RESET FILE LIMIT FLAGS @V2D3913 01684000
- B LOCFND VERIFY @V2D3913 01685000
- EJECT 01686000
- *********************************************************************** 01687000
- * 01688000
- * 'NEXT' SKIPS THROUGH THE FILE N LINES. IF N IS OMITTED, 01689000
- * THE NEXT LINE IS ASSUMED. 01690000
- * 01691000
- *********************************************************************** 01692000
- SPACE 01693000
- NEXLIN DS 0H 01694000
- BAL 14,NUM GO TO NEXT (N) LINES. 01695000
- B INVREQ ERROR RETURN. TR 01696000
- BAL 14,PARMCHK CHECK NO MORE ARGUMENTS GIVEN 01697000
- SPACE 1 01698000
- TYPIN EQU * @V2D3913 01699000
- LTR 2,0 01700000
- BZ LOCFND JUST TYPE IT. @V2D3913 01701000
- BAL R14,EORCHK CHECK CURRENT BOUNDS @V2D3913 01702000
- B ENDRANGE TYPE TOF,EOF MESSAGE @V2D3913 01703000
- SPACE 01704000
- NEXLOOP EQU * REWRITTEN TO IMPROVE SPEED 01705000
- BAL 14,XNEXT CHAIN DOWN THROUGH FILE 01706000
- TM TWITCH,TOPSW+EOF ENDRANGE? @V2D3913 01707000
- BNZ ENDRANGE TYPE EOF OR TOF @V2D3913 01708000
- BCT 2,NEXLOOP LOOP UNTIL DONE 01709000
- B LOCFND SHOW THE LINE @V2D3913 01710000
- SPACE 4 01711000
- ************************************************************** 01712000
- * 01713000
- * 'BACKWARD' PERFORMS THE SAME FUNCTION AS 'UP'. 01714000
- * HOWEVER, UP IS TREATED AS A SPECIAL CASE, SO THIS 01715000
- * CODE IS NECESSARY. 01716000
- * 01717000
- ************************************************************** 01718000
- SPACE 1 01719000
- BACKWD DS 0H @V2D3914 01720000
- OI TWITCH,UPWARD TURN ON THE UP FLAG @V2D3914 01721000
- B NEXLIN LET THE COMMAN ROUTINE DO IT @V2D3914 01722000
- EJECT 01723000
- *********************************************************************** 01724000
- * 01725000
- * 'FIND' LOOKS FOR AN EXACT MATCH IN THE NON-BLANK 01726000
- * COLUMNS OF THE EDIT LINE. IT WILL STOP AT EOF. 01727000
- * 01728000
- *********************************************************************** 01729000
- SPACE 01730000
- FIND DS 0H TR 01731000
- LH 2,TRUNCOL SAVE TRUNCOL VALUE TR 01732000
- L 4,ITEM ITEM LENGTH 01733000
- STH 4,TRUNCOL USE IT (TEMPORARILY) AS TRUNC. COL. 01734000
- BAL 14,SPREAD SPREAD THE EDIT LINE 01735000
- STH 2,TRUNCOL RESTORE PERMANENT TRUNCOL VALUE 01736000
- BAL R14,EORCHK CHECK CURRENT BOUNDS @V2D3913 01737000
- BAL R14,CLOSE CALL CLOSE ROUTINE @V2D3913 01738000
- SPACE 1 01739000
- FIND2 EQU * 01740000
- BAL 14,XNEXT MOVE TO NEXT LINE 01741000
- TM TWITCH,TOPSW+EOF ENDRANGE? @V2D3913 01742000
- BNZ NOTFOUND REQUIRES NOT FOUND MSG @V2D3913 01743000
- LA 2,TABLIN POINT TO THE SPREAD LINE 01744000
- LR 3,4 SET R3 TO ITEM-LENGTH 01745000
- SPACE 01746000
- FIND3 EQU * 01747000
- CLI 0(2),C' ' COMPARE FOR BLANK. 01748000
- BE FIND4 BRANCH IF IT IS (DON'T COMPARE HERE) 01749000
- CLC 0(1,2),8(1) MAKE THE COMPARISON 01750000
- BNE FIND2 BRANCH IF THEY DON'T MATCH 01751000
- SPACE 01752000
- FIND4 EQU * 01753000
- LA 1,1(,1) MOVE TO NEXT CHARACTER IN LINE OF FILE 01754000
- LA 2,1(,2) AND NEXT CHARACTER IN GIVEN LINE 01755000
- BCT 3,FIND3 LOOP UNTIL WE'VE EXAMINED THEM ALL 01756000
- B LOCFND BRANCH INTO LOCATE ROUTINE 01757000
- EJECT 01758000
- *********************************************************************** 01759000
- * 01760000
- * 'LOCATE' SEARCHES THOSE COLUMNS OF THE FILE SPECIFIED 01761000
- * BY THE CURRENT SETTINGS OF 'ZONE' FOR A MATCH WITH THE 01762000
- * GIVEN DELIMITED STRING. IT WILL STOP AT EOF. 01763000
- * 01764000
- *********************************************************************** 01765000
- SPACE 01766000
- PRELOC DS 0H SPECIAL LOCATE FORM ENTRY 01767000
- STH 0,EDCT SET EDCT BACK (GET TELLS US WHERE VIA R0) 01768000
- SPACE 01769000
- LOCATE EQU * 01770000
- BAL 14,STRING1 SCAN STRING1 01771000
- BAL 14,PARMCHK CHECK NO MORE PARMS 01772000
- BAL R14,EORCHK CHECK CURRENT BOUNDS @V2D3913 01773000
- BAL R14,CLOSE CALL CLOSE ROUTINE @V2D3913 01774000
- LA R9,LOCEND THIS IS FOR LATER BRANCH @V2D3914 01775000
- SPACE 1 01776000
- LOCSUB EQU * @V2D3914 01777000
- SR R8,R8 CLEAR LINE COUNT REG @V2D3914 01778000
- LH 4,ZONE1 COLUMN TO START 01779000
- LH 5,ZONE2 COLUMN TO END 01780000
- SR 5,4 NO. OF COLS. TO SEARCH 01781000
- SR 5,3 NO. OF COMPARISONS TO MAKE 01782000
- SPACE 01783000
- LOCATE2 EQU * 01784000
- BAL 14,XNEXT MOVE TO NEXT LINE 01785000
- LA R8,1(,R8) BUMP LINE COUNT @V2D3914 01786000
- LTR R3,R3 NULL STRING IS AUTOMATIC @V2D3914 01787000
- BL 4(,R9) NEXT LINE @V2D3914 01788000
- TM TWITCH,TOPSW+EOF ENDRANGE? @V2D3913 01789000
- BNZ 0(,R9) NOTFOUND OR NOSTRING @V2D3914 01790000
- AR 1,4 R1 NOW POINTS TO FIRST COLUMN TO SEARCH 01791000
- LR 0,5 AND R0 GIVES NO. OF SEPARATE COMPARISONS 01792000
- SPACE 01793000
- LOCLOOP EQU * 01794000
- EX 3,LOCCOM COMPARE CLC 8(*-*,1),0(2) 01795000
- BE 4(,R9) LOCATE OR STRING FOUND @V2D3914 01796000
- LA 1,1(,1) LOOK AT NEXT SPOT 01797000
- BCT 0,LOCLOOP AND LOOP 01798000
- B LOCATE2 (NOT FOUND IN THIS LINE) 01799000
- SPACE 01800000
- LOCEND B NOTFOUND HERE IF STRING NOT FOUND @V2D3914 01801000
- LOCFND EQU * 01802000
- MVI SCRFLGS,WRFULLB TEXT CHANGED @V2D3914 01803000
- LOCFND1 VERIFY RETURN=NEXT @V2D3914 01804000
- SPACE 01805000
- LOCCOM CLC 8(*-*,1),0(2) 01806000
- EJECT 01807000
- ************************************************************** 01808000
- * 01809000
- * 'DSTRING' CAUSES DELETION OF LINES UP TO A LINE 01810000
- * CONTAINING THE SPECIFIED CHARACTER STRING. 01811000
- * 01812000
- ************************************************************** 01813000
- SPACE 1 01814000
- DSTRING DS 0H @V2D3914 01815000
- BAL R14,STRING1 DELIMIT STRING @V2D3914 01816000
- BAL R14,PARMCHK STRING MUST BE LAST PARAMETER @V2D3914 01817000
- L R6,PTR2 SAVE CL PTR @V2D3914 01818000
- IC R7,TWITCH AND CL FLAGS @V305614 01819000
- BAL R14,EORCHK IF AT EOF, CAN'T POSSIBLY @V2D3914 01820000
- B NOWAY FIND IT @V2D3914 01821000
- SPACE 1 01822000
- BAL R9,LOCSUB GO FIND LINE WITH THIS STRING @V2D3914 01823000
- B NOSTRING RETURN HERE IF NOT FOUND @V2D3914 01824000
- ST R6,PTR2 IF FOUND, RESTORE THE CL PTR @V2D3914 01825000
- STC R7,TWITCH AND CL FLAGS @V305614 01826000
- LR R0,R8 GET NUMBER OF LINES FOR DELETE @V2D3914 01827000
- B DSENT AND USE DELETE TO EXECUTE @V2D3914 01828000
- SPACE 1 01829000
- NOSTRING ST R6,PTR2 RESTORE ORIGINAL CL PTR @V2D3914 01830000
- STC R7,TWITCH AND FLAGS @V305614 01831000
- NOWAY WTYPE NOSTR,RETURN=NEXT @V2D3914 01832000
- SPACE 1 01833000
- NOSTR DC C'STRING NOT FOUND, NO DELETIONS MADE.' @V2D3914 01834000
- EJECT 01835000
- * 01836000
- LTORG @V305614 01837000
- SPACE 4 01838000
- ************************************* 01839000
- ************************************* 01840000
- ***** ***** 01841000
- ***** END OF PAGE 1 ***** 01842000
- ***** ***** 01843000
- ************************************* 01844000
- ************************************* 01845000
- SPACE 4 01846000
- *********************************************************************** 01847000
- * 01848000
- * PAGE 1 MAY (PHYSICALLY) EXTEND A FEW HUNDRED BYTES BEYOND 01849000
- * THIS POINT. PAGE 2 IS ARRANGED TO TAKE ADVANTAGE 01850000
- * OF THIS BY HAVING AT THE BEGINNING ROUTINES WHICH ARE 01851000
- * OFTEN USED AND DO NOT CALL SOUBROUTINES OR USE DATA OUTSIDE 01852000
- * OF PAGE 1 OR THE BEGINNING OF PAGE 2. 01853000
- * 01854000
- *********************************************************************** 01855000
- EJECT 01856000
- *********************************************************************** 01857000
- * 01858000
- * 'ALTER' ENABLES ARBITRARY CHARACTERS TO BE MANIPULATED. 01859000
- * AFTER DECODING THE FIRST TWO ARGUMENTS, IT TRANSFERS INTO 01860000
- * THE CHANGE ROUTINE. 01861000
- * 01862000
- *********************************************************************** 01863000
- SPACE 01864000
- ALTER DS 0H 01865000
- LA 2,ALCHAR1 POINT TO SPOT FOR FIRST CHAR 01866000
- BAL 4,ALTSUB PUT THE FIRST ARGUMENT THERE 01867000
- LA 2,ALCHAR2 POINT TO SPOT FOR SECOND CHAR 01868000
- BAL 4,ALTSUB PUT THE SECOND ARGUMENT THERE 01869000
- LA 2,ALCHAR1 POINT R2 TO CHAR1 01870000
- SR 3,3 SET R3 = 0 01871000
- LA 4,ALCHAR2 POINT R4 TO SECOND CHAR 01872000
- LA 5,1(4) AND R5 ONE UP FROM THAT 01873000
- B CHNGTRNS TRANSFER INTO CHANGE 01874000
- SPACE 01875000
- ALTSUB EQU * ALTER SUBROUTINE 01876000
- OI SIGNAL,HEXSW SET HEX FLAG FOR GET 01877000
- BAL 14,GET GET THE ARGUMENT 01878000
- BZ INVREQ BRANCH IF NONE GIVEN 01879000
- LTR 1,1 HOW MANY CHARS? 01880000
- BNZ ALHEX BRANCH IF > 1 (MUST BE HEX) 01881000
- MVC 0(1,2),XXXCWD MOVE THE ARGUMENT INTO THE SPOT 01882000
- BR 4 RETURN 01883000
- SPACE 01884000
- ALHEX LA R5,1 DECODE HEX ARGUMENT @V2D3913 01885000
- CR R1,R5 EXACTLY TWO CHARACTERS? @V2D3913 01886000
- BNE INVREQ BRANCH IF NOT (NO GOOD) 01887000
- EX 1,UPCASE CONVERT TO UPPER CASE 01888000
- LA 5,XXXCWD POINT TO THE FIRST HEX DIGIT 01889000
- BAL 14,HEXSUB GET IT 01890000
- BCTR 0,0 AND CORRECT IT 01891000
- LR 3,0 SAVE IT IN R3 01892000
- LA 5,1(5) LOOK AT SECOND HEX DIGIT 01893000
- BAL 14,HEXSUB GET IT 01894000
- BCTR 0,0 CORRECT IT 01895000
- SLL 3,4 MOVE UP THE OLD VALUE 01896000
- AR 0,3 GET THE TOTAL VALUE 01897000
- STC 0,0(2) STORE IT WHERE TOLD 01898000
- BR 4 RETURN 01899000
- SPACE 01900000
- HEXSUB EQU * GET VALUE OF HEX DIGIT 01901000
- LA 0,16 01902000
- LA 1,HEX+15 POINT TO LAST HEX CHAR (F) 01903000
- HEXSUBLP CLC 0(1,5),0(1) DOES IT MATCH? @V200713 01904000
- BCR 8,14 RETURN IF SO (R0 HOLDS THE VALUE + 1) 01905000
- BCTR 1,0 DECREMENT THE SPOT IN HEX 01906000
- BCT 0,HEXSUBLP AND LOOP UNTIL HEX EXHAUSTED 01907000
- B INVREQ CHARACTER NOT FOUND 01908000
- SPACE 01909000
- HEX DC C'0123456789ABCDEF' 01910000
- EJECT 01911000
- *********************************************************************** 01912000
- * * 01913000
- * 'CHANGE' WILL REPLACE THE FIRST DELIMITED FIELD BY THE * 01914000
- * SECOND, FOR THE CURRENT LINE OR FOR MANY LINES, FOR * 01915000
- * THE FIRST OCCURRENCE IN THE LINE OR FOR ALL OCCURRENCES. * 01916000
- * THE COLUMNS AFFECTED ARE CONTROLLED BY 'ZONE'. * 01917000
- * * 01918000
- * (THIS ROUTINE HAS BEEN MODIFIED SO THAT STRING1 MAY BE * 01919000
- * NULL, IN WHICH CASE STRING2 IS INSERTED AT THE BEGINNING * 01920000
- * OF THE ZONE, AND THE 'GLOBAL' OPTION IS INVALID. * 01921000
- * * 01922000
- *********************************************************************** 01923000
- SPACE 01924000
- CHANGE DS 0H 01925000
- TM FLAG2,TUBE DISPLAY TERMINAL ? @V200714 01926000
- BNO SKT NO...BR @V200714 01927000
- CLC EDCT(2),COUNT ANY PARAMETERS SPECIFIED ? @V2D3913 01928000
- BNE SKT YES...BR @V200714 01929000
- TM TWITCH,TOPSW+EOF TOF OR EOF ? @V200714 01930000
- BM NOTFOUND IF SO, CAN'T CHANGE @V200714 01931000
- MVI SCRFLG2,WRCLINB SET FLAG FOR DISPLAY RTN @V2D3913 01932000
- OI CHNGFLAG,DTYPE SET DISPLAY TYPE ON @VA07968 01932500
- BAL 14,WRTYPEX WRITE LINE TO INPUT AREA @V2D3913 01933000
- NI CHNGFLAG,255-DTYPE SET DISPLAY TYPE OFF @VA07968 01933500
- BAL R14,RDTYPE READ THE LINE IN. @V2D3913 01934000
- BZ NEXT EXIT, IF MIND HAS CHANGED. @V2D3913 01935000
- OI CHNGFLAG,DTYPE TURN ON DISPLAY TYPE FLAG @VA07258 01936000
- XC EDCT(2),EDCT CLEAR EDIT COUNT @V2D3913 01937000
- B RTYP4A NOW REPLACE THE LINE. @V2D3913 01938000
- SKT EQU * @VA04193 01939000
- XC TRNCNUM(4),TRNCNUM ZERO TRUNCATE COUNT @VA04193 01940000
- BAL 14,STRING1 DECODE STRING 1 @VA04193 01941000
- LH 6,COUNT COMPUTE LENGTH OF REPLACEMENT FIELD. 01942000
- LR 5,4 POSSIBLE. 01943000
- LA 14,EDLIN POINT TO INPUT SPEC @V200713 01944000
- SR 5,14 @V200713 01945000
- SR 6,5 01946000
- LR 5,4 01947000
- BZ CHNG2A BRANCH IF R6=0 01948000
- CHNG2 EX 7,CHNGCOMP CLI 0(5),** 01949000
- BE CHNG1 01950000
- LA 5,1(,5) 01951000
- BCT 6,CHNG2 01952000
- CHNG2A EQU * 01953000
- LR R8,R5 ALLOW NO CLOSING DELIMITER @V305614 01954000
- BCTR R8,R0 @V305614 01955000
- B *+6 01956000
- SPACE 01957000
- CHNG1 EQU * CHECK FOR MULTIPLE LINES AND GLOBAL 01958000
- LR R8,R5 @V305614 01959000
- SR R8,R14 SUBTRACT A(EDLIN) @V305614 01960000
- LA R8,1(,R8) BUMP IT @V305614 01961000
- STH R8,EDCT SAVE FOR 'GET' @V305614 01962000
- EJECT 01963000
- CHNGTRNS EQU * @V2D3913 01964000
- NI CHNGFLAG,255-(NULLSW1+NULLSW2+GLOBSW+FLDFND+CHNGSW) 01965000
- BAL 14,NUM CHECK FOR NUMBER OF LINES SUPPLIED. 01966000
- BAL 14,STARCHK NON-NUMERIC RETURN. TR 01967000
- ST R0,CHNGNUM SAVE COUNT OF NO. OF LINES @V305614 01968000
- OI SCRFLGS,WRFULLB REWRITE ALL TEXT @V2D3914 01969000
- BAL R14,GET GET NEXT TOKEN @V2D3913 01970000
- BZ CHNG4 NO GOOD IF CC = 0 01971000
- CLC XXXCWD(2),=CL2'G ' MAYBE HE USED 'G' 01972000
- BE CHNG3 BRANCH IF SO @V2D3913 01973000
- BAL 14,STARCHK BETTER BE ASTERISK @V2D3913 01974000
- CHNG3 EQU * 01975000
- BAL 14,PARMCHK CHECK NO MORE PARMS 01976000
- OI CHNGFLAG,GLOBSW INDICATE GLOBAL CHANGE REQ. 01977000
- CHNG4 EQU * 01978000
- SR R6,R6 CLEAR REGISTER @V2D3913 01979000
- LTR 3,3 IS STRING1 NULL? 01980000
- BNL CHNG5 BRANCH IF NOT 01981000
- TM CHNGFLAG,GLOBSW WAS GLOBAL REQUESTED? 01982000
- BO INVREQ BRANCH IF SO (THAT'S NOT ON) 01983000
- OI CHNGFLAG,NULLSW1 SET TWITCH 01984000
- CHNG5 EQU * 01985000
- L R14,CHNGNUM ANY LINES TO CHANGE ? @V305614 01986000
- LTR R14,R14 ..... @V305614 01987000
- BZ NOTFOUND INDICATE NO CHANGE @VA07942 01988000
- BAL R14,EORCHK CHECK CURRENT BOUNDS @V2D3913 01989000
- B CEOFILE ALL DONE IN THIS CASE @V2D3913 01990000
- BAL R14,XREADB FILL COMPARE BUFFER @V2D3913 01991000
- SR 5,4 LENGTH OF REPLACEMENT FIELD 01992000
- LTR 5,5 WAS FIELD NULL. 01993000
- BZ *+10 YES. 01994000
- BCTR 5,0 DECREMENT FOR ACCURATE REPLACEMENT. 01995000
- B *+8 01996000
- OI CHNGFLAG,NULLSW2 YES - INDICATE TO PROCESS NULL. 01997000
- TM TWITCH,TOPSW+EOF @V2D3913 01998000
- BZ CHNGSTRT BRANCH IF NOT 01999000
- B CHNGNXT1 02000000
- EJECT 02001000
- CHNGNXT3 OI CHNGFLAG,CHNGSW INDICATE LINE CHANGED. 02002000
- CR 3,5 COMP LENGTHS OF ORIGINAL & CHANGED. 02003000
- BE DOCHNG SAME LENGTH; REPLACE ONLY. 02004000
- BH MOVELEFT SHORTER - REQUIRES SHIFT TO LEFT. 02005000
- * LONGER - REQUIRES SHIFT TO RIGHT. TR 02006000
- LH 7,ZONE2 GET TRUNCATION COLUMN 02007000
- LA 7,LINE(7) ADJUST TO COL LOCATION TR 02008000
- LR 9,7 LOAD REG 9 02009000
- BCTR 9,0 DECREMENT GR 9. TO POINTER TR 02010000
- SR 7,1 NO. OF COLS. AVAILABLE FOR STRING2 02011000
- SR 7,5 NO. OF COLS. LEFT OVER IN ZONE + 1 02012000
- BH CHNG7 CHANGE FIELD WILL NOT BE TRUNCATED TR 02013000
- BCTR 7,0 CHANGED FLD WILL BE TRUNCATED. TR 02014000
- SPACE 02015000
- * SO STRING2 IS TO BE TRUNCATED. LET'S SEE WHETHER ANY NON- 02016000
- * BLANKS ARE BEING LOST. (CJS) 02017000
- SPACE 02018000
- * R4: START OF STRING2 02019000
- * R5: LENGTH-1 OF STRING2 02020000
- * R7: -(NO. OF CHARS TO THROW AWAY) 02021000
- * R14 AND R15: AVAILABLE FOR SCRATCH 02022000
- SPACE 02023000
- LA 15,0(4,5) ADDRESS OF LAST CHAR IN STRING2 02024000
- LPR 14,7 NO. OF CHARS TO THROW AWAY FROM STRING2 02025000
- SPACE 02026000
- STR2LP EQU * LOOP HEAD 02027000
- CLI 0(15),C' ' BLANK? 02028000
- BNE SIGLOST BRANCH IF NOT (SIGNIFICANT CHARS LOST) 02029000
- BCTR 15,0 LOOK AT PREVIOUS CHAR 02030000
- BCT 14,STR2LP AND LOOP 02031000
- EJECT 02032000
- * IF WE GET HERE, WE KNOW THAT SIGNIFICANT CHARACTERS ARE NOT 02033000
- * BEING LOST FROM STRING2. 02034000
- * BUT WHAT ABOUT THAT PART OF THE EXISTING LINE WHICH IS BEING 02035000
- * PUSHED OVER THE EDGE? 02036000
- SPACE 02037000
- * R1: ADDRESS OF FIRST CHARACTER TO BE CHANGED 02038000
- * R3: LENGTH-1 OF STRING1 02039000
- * R9: ADDRESS OF LAST CHAR IN ZONE 02040000
- SPACE 02041000
- LR 15,9 ADDRESS OF LAST CHAR IN ZONE 02042000
- LR 14,9 SAME THING 02043000
- SR 14,1 TOTAL NO. OF CHARS TO BE REMOVED - 1 02044000
- SR 14,3 NO. OF CHARS TO BE LOST NON-EXPLICITLY 02045000
- BZ SIGNTLST BRANCH IF NONE (SIG CHARS NOT LOST) 02046000
- SPACE 02047000
- LOSTLP EQU * LOOP HEAD 02048000
- CLI 0(15),C' ' BLANK? 02049000
- BNE SIGLOST BRANCH IF NOT (SIGNIFICANT CHARS LOST) 02050000
- BCTR 15,0 LOOK AT PREVIOUS CHAR 02051000
- BCT 14,LOSTLP AND LOOP 02052000
- B SIGNTLST SIGNIFICANT CHARS NOT LOST 02053000
- SPACE 02054000
- SIGLOST EQU * SIGNIFICANT CHARS ARE BEING LOST 02055000
- OI TWITCH,TRUNC SET TRUNC SWITCH 02056000
- SPACE 02057000
- SIGNTLST EQU * SIGNIFICANT CHARS NOT LOST 02058000
- AR 7,5 REDUCED LENGTH OF STRING2 02059000
- B DOCHNG2 GO AND PERFORM THE CHANGE 02060000
- EJECT 02061000
- * END OF CHECK FOR WHETHER NON-BLANKS ARE LOST FROM STRING2 02062000
- * OR FROM THAT PART OF THE EXISTING LINE WHICH IS BEING THROWN 02063000
- * AWAY, IN THE CASE WHEN STRING2 IS TRUNCATED. 02064000
- SPACE 02065000
- CHNG7 EQU * TR 02066000
- LNR 8,5 1 - L'STRING2 02067000
- AR 8,3 L'STRING1 - L'STRING2 02068000
- BZ DOCHNG 02069000
- LPR 15,8 NO. OF BYTES TO BE DISCARDED INTO R15, JS 02070000
- AR 8,9 R8 POINTS TO LAST BYTE TO BE MOVED 02071000
- LR 14,8 WHERE-TO-START (LESS 1) INTO R14, JS 02072000
- JCLI14 CLI 1(14),C' ' IS CHARACTER-TO-BE-DISCARDED A BLANK ? JS 02073000
- BE JLAR14 BE IF YES (NO PROBLEM SO FAR) JS 02074000
- OI TWITCH,TRUNC IF NOT, SET TRUNCATED-BIT AND JS 02075000
- B MOVERT START MOVING AS USUAL. JS 02076000
- JLAR14 LA 14,1(,14) ADVANCE TO NEXT CHARACTER, JS 02077000
- BCT 15,JCLI14 AND CHECK ALL CHARACTERS THROWN AWAY. JS 02078000
- MOVERT MVC 0(1,9),0(8) 02079000
- BCTR 9,0 02080000
- BCTR 8,0 02081000
- BCT 7,MOVERT 02082000
- DOCHNG EQU * SET UP TO PERFORM CHANGE 02083000
- LR 7,5 LENGTH-1 OF STRING2 02084000
- DOCHNG2 EQU * PERFORM CHANGE 02085000
- EX 7,MOVEIN (THERE) 02086000
- CHNGSCOL EQU * UPDATE R1 TO NEXT COLUMN TO CHANGE 02087000
- LA 1,1(1,5) STARTING POSITION + L'STRING2 02088000
- B CHNGNEXT 02089000
- EJECT 02090000
- MOVELEFT EQU * CHANGE INVOLVES MOVE TO LEFT 02091000
- LR 15,3 L'STRING1-1 02092000
- LA 8,1(1,15) ADDR. OF BYTE AFTER OCCURRENCE OF STRING1 02093000
- LA 9,0(5,8) 02094000
- SR 9,15 02095000
- LH 7,ZONE2 GET TRUNCATION COLUMN 02096000
- LA 7,LINE(7) TR 02097000
- LR 14,7 SAVE COL ADDRESS TR 02098000
- SR 7,8 02099000
- BNH *+10 IF NOT GT 0, DO NOT MOVE ANYTHING. TR 02100000
- BCTR 7,0 02101000
- EX 7,MOVER 02102000
- EX 5,MOVEIN GR 5 = NUMB OF REPLACING CHARACTERS 02103000
- SR 15,5 02104000
- BCTR 15,0 GR 15 = NUMB OG BLANKS TO BE MOVED IN 02105000
- LR 9,14 LOAD REG 9 TR 02106000
- BCTR 9,0 TR 02107000
- SR 9,15 02108000
- MVI 0(9),C' ' SET UP ONE BLANK 02109000
- BCTR 15,0 COUNT-1 02110000
- LTR 15,15 WAS THERE ONLY ONE BLANK 02111000
- BL *+8 YES, SKIP 'EX' 02112000
- EX 15,MOVEBL NO, MVC 1(*-*,9),0(9) 02113000
- B CHNGSCOL 02114000
- EJECT 02115000
- DONULL EQU * STRING2 IS NULL, STRING1 NOT NULL 02116000
- OI CHNGFLAG,CHNGSW INDICATE CHANGE MADE 02117000
- LR 9,1 MOVE INTO HERE. 02118000
- LA 8,1(3,9) ADDR. OF BYTE AFTER OCCURRENCE OF STRING1 02119000
- LH 7,ZONE2 GET TRUNCATION COLUMN 02120000
- LA 7,LINE(7) COMPUTE ADDRESS OF COL. BEYOND EOZ 02121000
- SR 7,8 NO. OF ACTIVE COLS. AFTER STRING1 02122000
- BNH DONULL1 BRANCH IF NONE 02123000
- BCTR 7,0 DECREASE FOR EXEC 02124000
- EX 7,MOVER MOVE THEM OVER 02125000
- LA 9,1(9,7) POINT TO COL. AFTER WHAT WE'VE MOVED 02126000
- DONULL1 EQU * (JUMP HERE IF NOUGHT TO MOVE OVER) 02127000
- MVI 0(9),C' ' MOVE IN ONE BLANK 02128000
- LR 15,3 L'STRING1-1 = NO. OF BLANKS LEFT TO PAD 02129000
- BCTR 15,0 DECREASE FOR EXEC 02130000
- LTR 15,15 WAS THERE AT LEAST ONE? 02131000
- BL *+8 SKIP IF NOT 02132000
- EX 15,MOVEBL MVC 1(*-*,9),0(9) 02133000
- LH 7,CHNGCNT ITERATION COUNT FOR THIS LINE 02134000
- BCTR 7,0 MINUS... 02135000
- SR 7,3 ...L'STRING1. 02136000
- BNH CHNGNXT1 BRANCH IF WE'VE EXHAUSTED THE ZONE 02137000
- STH 7,CHNGCNT SAVE DECREMENTED VALUE OF CHNGCNT 02138000
- SPACE 02139000
- CHNGNEXT TM CHNGFLAG,GLOBSW IS GLOBAL REQUESTED. 02140000
- BZ CHNGNXT1 NO. 02141000
- LA 0,LINE GET LINE ADDRESS TR 02142000
- AH 0,ZONE2 GET TRUNCATION COL ADDRESS 02143000
- SR 0,1 02144000
- SR 0,3 02145000
- BH CHNGNXT2 LOOP PROTECTOR TR 02146000
- EJECT 02147000
- CHNGNXT1 L R14,CHNGNUM GET THE LINE COUNT @V305614 02148000
- BCTR R14,R0 DECREMENT IT @V305614 02149000
- ST R14,CHNGNUM AND PUT IT BACK @V305614 02150000
- OI TWITCH,SAVOVER OVERRIDE AUTOSAVE @V2D3914 02151000
- TM CHNGFLAG,CHNGSW HAS THE LINE BEEN CHANGED? @V2D3913 02152000
- BZ CHNGNXT7 NO. 02153000
- BAL 14,XREPL YES, REPLACE LINE 02154000
- LA R6,1(,R6) INCREASE NUMBER OF LINES CHANGED @V2D3913 02155000
- TM TWITCH,TRUNC WAS LINE TRUNCATED? 02156000
- BZ CHNGVER2 NO 02157000
- L R1,TRNCNUM GET TRUNCATE COUNT @VA04193 02158000
- LA R1,1(R1) INCREMENT COUNT @VA04193 02159000
- ST R1,TRNCNUM STORE NEW COUNT @VA04193 02160000
- TM FLAG2,VER VERIFY OFF? @VA04193 02161000
- BZ CHNGCLR YES ... BR @VA04193 02162000
- TM FLAG2,TUBE DISPLAY TERMINAL? @VA04193 02163000
- BO CHNGCLR YES ... BR @VA04193 02164000
- WTYPE TRUNCX YES 02165000
- CHNGVER2 TM FLAG2,TUBE DISPLAY TERMINAL ? @V2D3913 02166000
- BO CHNGCLR YES ... BR @V2D3913 02167000
- VERIFY @V2D3913 02168000
- CHNGCLR NI TWITCH,255-TRUNC RESET TRUNC FLAG @VA04193 02169000
- NI CHNGFLAG,255-CHNGSW CLEAR TWITCH. 02170000
- CHNGNXT7 L R14,CHNGNUM ANY LINES LEFT TO DO ? @V305614 02171000
- LTR R14,R14 ..... @V305614 02172000
- BZ CEOFILE STANDARD EXIT (NOW) @V2D3913 02173000
- BAL R14,XREAD READ ANOTHER LINE. @V2D3913 02174000
- TM TWITCH,TOPSW+EOF ARE WE AT EITHER EXTREME? @V2D3913 02175000
- BNZ CEOFILE ALL DONE, IF SO. @V2D3913 02176000
- CHNGSTRT EQU * CHANGE START 02177000
- LH 1,ZONE1 BEGINNING ZONE-1 02178000
- LH 0,ZONE2 END ZONE 02179000
- SR 0,1 WIDTH OF ZONE FIELD 02180000
- STH 0,CHNGCNT SAVE FOR DONULL (MAX. INTERATION COUNT) 02181000
- LA 1,LINE(1) START SEARCH HERE 02182000
- TM CHNGFLAG,NULLSW1 IS STRING1 NULL? 02183000
- BO CHNGNXT6 BRANCH IF SO 02184000
- SR 0,3 LOOP COUNT 02185000
- CHNGNXT2 EX 3,CHNGCOM 02186000
- BE CHNGNXT6 FOUND STRING 02187000
- LA 1,1(,1) UPDATE STARTING COLUMN. 02188000
- BCT 0,CHNGNXT2 02189000
- B CHNGNXT1 NOT FOUND HERE. 02190000
- SPACE 02191000
- CHNGNXT6 OI CHNGFLAG,FLDFND RAM 02192000
- TM CHNGFLAG,NULLSW2 IS STRING2 NULL? RAM 02193000
- BZ CHNGNXT3 BRANCH IF IT'S NOT 02194000
- TM CHNGFLAG,NULLSW1 IS STRING1 NULL? 02195000
- BO CHNGNXT1 BRANCH IF SO (BEHAVE AS NO-OP) 02196000
- B DONULL ATTEND TO CASE OF STRING2 = NULL 02197000
- SPACE 02198000
- CEOFILE NI TWITCH,255-SAVOVER RESET SAVE OVERRIDE @V2D3914 02199000
- TM CHNGFLAG,FLDFND DID WE CHANGE ANYTHING ? @V2D3914 02200000
- BNO NOTFOUND NO ... BR @V2D3913 02201000
- BAL R14,AUTOCHEK NOW CHECK FOR AUTOSAVE @V2D3914 02202000
- TM FLAG2,TUBE DISPLAY TERMINAL ? @V2D3913 02203000
- BO CHMSG YES ... BR @VA04193 02204000
- TM FLAG2,VER VERIFY ON? @VA04193 02205000
- BO ENDRANGE YES ... BR @VA04193 02206000
- ICM R0,15,TRNCNUM GET TRUNC COUNT; IS IT ZERO? @VA04193 02207000
- BZ NEXT YES ... BR @VA04193 02208000
- LA R1,CHGTRUNC GET TRUNCATE MESSAGE ADDR @VA04193 02209000
- LA R6,22 AND LENGTH @VA04193 02210000
- B CNVTRUNC AND GO CONVERT @VA04193 02211000
- CHMSG LR R0,R6 GET NUMBER OF LINES CHANGED @V2D3914 02212000
- BAL R14,BINDEC CONVERT NUMBER @V2D3913 02213000
- MVC CHNGMSG(4),AREA+4 PLUG INTO MESSAGE @V2D3913 02214000
- LA R1,CHNGMSG LOAD MESSAGE ADDR AND @VA04193 02215000
- LA R6,20 LOAD INIT MSG LENGTH @VA04193 02216000
- ICM R0,15,TRNCNUM GET TRUNC COUNT; IS IT ZERO? @VA04193 02217000
- BZ TYPCHMSG YES ... BR @VA04193 02218000
- LA R6,44 LOAD LONG MSG LENGTH @VA04193 02219000
- CNVTRUNC EQU * 02220000
- BAL R14,BINDEC CONVERT TRUNC NUMBER AND @VA04193 02221000
- MVC CHGTRUNC(4),AREA+4 PLUG INTO MESSAGE @VA04193 02222000
- B TYPCMSG1 TYPE, REGARDLESS OF VERIFICATION @VA05355 02223000
- TYPCHMSG EQU * @VA05355 02224000
- TM FLAG2,VER VERIFICATION ON ? @VA05355 02225000
- BNO NEXT NO, GET NEXT COMMAND @VA05355 02226000
- TYPCMSG1 EQU * BR HERE IF TRUNC OCCURRED @VA05355 02227000
- LR R0,R6 GET MSG LENGTH @VA04193 02228000
- LA R14,NEXT AND RETURN ADDR @VA04193 02229000
- B WRTYPE AND GO TO IT! @VA04193 02230000
- SPACE 1 02231000
- SPACE 1 02232000
- MOVER MVC 0(*-*,9),0(8) 02233000
- MOVEIN MVC 0(*-*,1),0(4) 02234000
- MOVEBL MVC 1(*-*,9),0(9) 02235000
- CHNGCOMP CLI 0(5),*-* 02236000
- CHNGCOM CLC 0(*-*,1),0(2) 02237000
- EJECT 02238000
- *********************************************************************** 02239000
- * 02240000
- * 'STRING1' IS A SUBROUTINE WHICH IS CALLED FROM 'LOCATE' 02241000
- * AND 'CHANGE' TO DELIMIT STRING1. 02242000
- * 02243000
- * CALL: 02244000
- * BAL 14,STRING1 02245000
- * 02246000
- * ON EXIT: 02247000
- * R2 POINTS TO START OF STRING1 (WHICH WILL HAVE BEEN 02248000
- * MOVED INTO TABLIN); 02249000
- * R3 CONTAINS LENGTH-1 OF STRING1; 02250000
- * R4 POINTS TO NEXT FIELD IN EDLIN; 02251000
- * R7 CONTAINS THE DELIMITER (IN THE LOW-ORDER BYTE). 02252000
- * 02253000
- * IF THE LENGTH OF STRING1 IS GREATER THEN THE ZONE WIDTH, 02254000
- * THE MESSAGE 'ZONE ERROR' IS TYPED, AND A DIRECT BRANCH IS 02255000
- * TAKEN TO INVREQX (INVALID REQUEST, BUT DON'T SAY SO). 02256000
- * 02257000
- * (LEVEL 1 SUBROUTINE) 02258000
- * 02259000
- *********************************************************************** 02260000
- SPACE 02261000
- STRING1 DS 0H 02262000
- LA 2,TABLIN POINT R2 TO TABLIN 02263000
- LH 3,EDCT SPOT IN EDLIN TO START LOOKING 02264000
- LA 4,EDLIN(3) CONVERT TO ACTUAL ADDRESS 02265000
- LH 5,COUNT LENGTH OF EDLIN 02266000
- SR 5,3 LENGTH OF PIECE TO LOOK AT 02267000
- BNH INVREQ BRANCH IF NONE (TELL HIM BAD REQUEST) 02268000
- SPACE 02269000
- STRG4 EQU * LOOK FOR OPENING DELIMITER 02270000
- CLI 0(4),C' ' IS THIS IT? 02271000
- BNE STRG1 BRANCH IF SO 02272000
- LA 4,1(,4) LOOK AT NEXT BYTE 02273000
- BCT 5,STRG4 LOOP UNTIL WE FIND IT 02274000
- B INVREQ BRANCH IF STRING EXHAUSTED 02275000
- SPACE 02276000
- STRG1 EQU * WE'VE FOUND THE OPENING DELIMITER 02277000
- IC 7,0(,4) PUT IT IN R7 02278000
- LA 4,1(,4) LOOK AT NEXT BYTE 02279000
- LR 1,4 SAVE THE SPOT IN R1 02280000
- LR 3,4 AND IN R3 02281000
- BCTR 5,0 LENGTH REMAINING 02282000
- LTR 5,5 IS THERE ANY? 02283000
- BZ STRG2 BRANCH IF NOT 02284000
- SPACE 02285000
- STRG3 EQU * SEARCH FOR CLOSING DELIMITER 02286000
- EX 7,STRGCOMP IS THIS IT? 02287000
- BE STRG2 BRANCH IF SO 02288000
- LA 4,1(,4) LOOK AT NEXT BYTE 02289000
- BCT 5,STRG3 LOOP 02290000
- SPACE 02291000
- STRG2 EQU * WE'VE DELIMITED STRING1 02292000
- SR 3,4 COMPUTE ITS LENGTH 02293000
- LPR 3,3 AND PUT IT IN R3 02294000
- BCTR 3,0 (NOW LENGTH-1) 02295000
- LTR 5,5 WAS THE CLOSING DELIMITER GIVEN? 02296000
- BZ *+8 SKIP IF NOT 02297000
- LA 4,1(,4) POINT TO NEXT BYTE 02298000
- LA 0,EDLIN COMPUTE NEW VALUE FOR EDCT 02299000
- SR 0,4 02300000
- LPR 0,0 02301000
- STH 0,EDCT AND PUT IT THERE 02302000
- LTR 3,3 TEST LENGTH OF STRING1 02303000
- BCR 4,14 RETURN IF ZERO (LENGTH-1 -VE) 02304000
- SPACE 02305000
- EX 3,STRGMOV MOVE STRING1 INTO TABLIN 02306000
- TM FLAG,CAN CANONICALIZATION REQUIRED? 02307000
- BZ STRG6 BRANCH IF NOT 02308000
- SPACE 02309000
- * CANONICALIZE THE STRING 02310000
- SPACE 02311000
- LA 0,1(3) LENGTH OF STRING1 INTO R0 02312000
- LR 1,2 ADDRESS INTO R1 02313000
- BAL 15,CANON CALL CANONICALIZING ROUTINE 02314000
- LR 3,0 NEW LENGTH INTO R3 02315000
- BCTR 3,0 (NOW LENGTH-1) 02316000
- SPACE 02317000
- STRG6 EQU * 02318000
- LH 0,ZONE2 END ZONE 02319000
- SH 0,ZONE1 MINUS STARTING ZONE 02320000
- CR 3,0 IS STRING1 TOO LONG FOR ZONE? 02321000
- BCR 4,14 RETURN IF NOT 02322000
- WTYPE ZONERRMS,,RETURN=INVREQX @V200713 02323000
- SPACE 02324000
- STRGCOMP CLI 0(4),X'00' (WE FILL IN THE IMMEDIATE FIELD VIA EXEC) 02325000
- STRGMOV MVC TABLIN(*-*),0(1) 02326000
- SPACE 02327000
- ZONERRMS DC C'ZONE ERROR' 02328000
- EJECT 02329000
- *********************************************************************** 02330000
- * 02331000
- * 'OVERLAY' REPLACES THE CHARACTERS OF A LINE WITH ANY 02332000
- * CHARACTERS IN THE INPUT LINE WHICH ARE NON-BLANK. 02333000
- * 02334000
- * AN UNDERSCORE IS THE INPUT LINE FORCES A BLANK INTO THE 02335000
- * LINE BEING OVERLAID. 02336000
- * 02337000
- *********************************************************************** 02338000
- SPACE 02339000
- OVRLAY DS 0H 02340000
- NC REPCNT,REPCNT TEST REPCNT 02341000
- LA R3,1 GET AN AMIABLE COUNT @V2D3913 02342000
- BNZ OVRL2 BRANCH IF NOT ZERO 02343000
- ST R3,REPCNT RESET THE REPEAT COUNT @V2D3913 02344000
- B NEXT AND GET NEXT REQUEST 02345000
- SPACE 1 02346000
- OVRL2 BAL R14,EORCHK CHECK THE CURRENT BOUNDS @V2D3913 02347000
- B REPSET ALL DONE @V2D3913 02348000
- BAL R14,XREADB REFRESH LINE @V2D3913 02349000
- TM FLAG2,TUBE DISPLAY TERMINAL ? @V200714 02350000
- BNO SPREDOVR NO...BR @V200714 02351000
- CLC EDCT(2),COUNT CHECK LENGTH @V2D3913 02352000
- BNE SPREDOVR YES...BR @V200714 02353000
- BAL 14,RDTYPE GET NEW LINE @V200714 02354000
- XC EDCT,EDCT POINT AT FIRST CHAR FOR SPREAD @V200714 02355000
- SPREDOVR OI SIGNAL,OVER SET OVERLAY FLAG FOR SPREAD @V200714 02356000
- BAL 14,SPREAD SPREAD THE LINE 02357000
- TM TWITCH,TRUNC TRUNCATION? @VA04193 02358000
- BZ OVRLEOR NO ... BR @VA04193 02359000
- WTYPE TRUNCX SET UP TRUNCATION MESSAGE @VA04193 02360000
- OI SCRFLG2,MOREB MAKE SURE IT'S SEEN @VA04193 02361000
- OVRLEOR EQU * @VA04193 02362000
- TM TWITCH,TOPSW+EOF ENDRANGE? @V2D3913 02363000
- BZ *+8 SKIP IF NOT 02364000
- BAL 2,REPT1 LET REPT1 HANDLE IF SO 02365000
- SPACE 02366000
- OVRL EQU * 02367000
- OI TWITCH,SAVOVER OVERRIDE AUTOSAVE @V2D3914 02368000
- LH R0,TRUNCOL SET NUMBER OF CHARS TO OVLAY @V2D3914 02369000
- LA 1,TABLIN POINT TO THE SPREAD LINE 02370000
- LA 2,LINE AND THE LINE TO BE OVERLAID 02371000
- OVRL1 CLI 0(R1),C' ' CHECK FOR BLANK @V2D3913 02372000
- BE OVRL7 IF SO IGNORE 02373000
- CLI 0(1),C'_' IS CHARACTER AN UNDERLINE? 02374000
- BNE OVRL6 BRANCH IF NOT 02375000
- MVI 0(2),C' ' FORCE A BLANK 02376000
- B OVRL7 02377000
- OVRL6 MVC 0(1,R2),0(R1) REPLACE OLD WITH NEW @V2D3913 02378000
- OVRL7 AR R2,R3 MOVE ON. @V2D3913 02379000
- AR R1,R3 HERE, AS WELL. @V2D3913 02380000
- BCT 0,OVRL1 LOOP UNTIL DONE 02381000
- BAL 2,REPT CHECK FOR MORE 02382000
- B OVRL 02383000
- EJECT 02384000
- *********************************************************************** 02385000
- * 02386000
- * 'FOR' WILL CAUSE AN OVERLAY REQUEST TO BE DUPLICATED 02387000
- * ON THE NEXT 'N' LINES. 02388000
- * 02389000
- * (REPT AND REPT1 ARE LEVEL 1 SUBROUTINES, CALLED FROM OVRLAY. 02390000
- * CALL IS: BAL 2,REPT; OR BAL 2,REPT1.) 02391000
- * 02392000
- *********************************************************************** 02393000
- SPACE 02394000
- REPEAT DS 0H 02395000
- BAL 14,NUM GET PARM 02396000
- BAL 14,STARCHK MUST BE A STAR (HOPE) 02397000
- BAL 14,PARMCHK CHECK NO MORE PARMS 02398000
- ST 0,REPCNT STORE AS REPCNT 02399000
- B NEXT 02400000
- SPACE 02401000
- REPT EQU * 02402000
- BAL 14,XREPL UPDATE LINE 02403000
- REPT1 L R6,REPCNT GET REPEAT COUNT @V2D3914 02404000
- BCTR R6,R0 DECREMENT THE COUNT @V2D3914 02405000
- TM FLAG2,TUBE IS THIS A DISPLAY TERMINAL ? @V2D3914 02406000
- BNO REPTA NO ... BR @V2D3914 02407000
- SPACE 1 02408000
- LTR R6,R6 IS REPEAT COUNT ZERO ? @V2D3914 02409000
- BNZ REPTB IF NOT, SKIP VERIFICATION @V2D3914 02410000
- MVI SCRFLGS,WRTOPB REWRITE EVERYTHING @VM01058 02411000
- SPACE 1 02412000
- REPTA VERIFY @V2D3914 02413000
- LTR R6,R6 IS REPEAT COUNT ZERO ? @V2D3914 02414000
- BNZ REPTB CONTINUE IF NOT @V2D3914 02415000
- BAL R14,AUTOCHEK CHECK FOR AUTOSAVE @V2D3914 02416000
- NI TWITCH,255-SAVOVER RESET SAVE OVERRIDE @V2D3914 02417000
- B NEXT RETURN @V2D3914 02418000
- SPACE 1 02419000
- REPTB ST R6,REPCNT SAVE NEW REPEAT COUNT @V2D3914 02420000
- BAL R14,XREAD READ THE NEXT LINE OF TEXT @V2D3914 02421000
- TM TWITCH,TOPSW+EOF AT FILE LIMIT ? @V2D3914 02422000
- BZR R2 RETURN IF NOT @V2D3914 02423000
- SPACE 02424000
- REPSET EQU * 02425000
- LA 14,1 GET A 1 @V200713 02426000
- ST 14,REPCNT RESET REPCNT @V200713 02427000
- B ENDRANGE TYPE EOF OR TOF @V2D3913 02428000
- EJECT 02429000
- *********************************************************************** 02430000
- * 02431000
- * X & Y COMMANDS-- 02432000
- * 02433000
- * FORMS-- 02434000
- * 1. (X OR Y) COMMAND 02435000
- * 2. (X OR Y) <NUMBER> 02436000
- * 02437000
- * FORM 1 CAUSES THE COMMAND TO BE SAVED. 02438000
- * FORM 2 CAUSES THE SAVED COMMAND TO BE EXECUTED ONCE, OR 02439000
- * THE NUMBER OF TIMES SPECIFIED. 02440000
- * 02441000
- *********************************************************************** 02442000
- SPACE 02443000
- XXX DS 0H 'X' REQUEST 02444000
- LA 3,XACT NOTE THAT IT'S AN 'X' REQUEST 02445000
- LA 4,XAREA POINT TO 'X' COMMAND AREA 02446000
- B XYCOM AND ON TO COMMON ROUTINE 02447000
- SPACE 02448000
- YYY EQU * 'Y' REQUEST 02449000
- LA 3,YACT NOTE THAT IT'S A 'Y' REQUEST 02450000
- LA 4,YAREA POINT TO 'Y' COMMAND AREA 02451000
- SPACE 02452000
- XYCOM EQU * 'X' OR 'Y' REQUEST 02453000
- LH 2,EDCT REMEMBER EDCT NOW 02454000
- BAL 14,NUM TEST FOR NUMBER 02455000
- B XYSAVE ERROR, MUST BE ALPHA, SAVE IT 02456000
- BAL 14,PARMCHK CHECK NO MORE PARMS 02457000
- L 1,XYCNT GET EXISTING XY COUNT 02458000
- LTR 1,1 TEST IT 02459000
- BNZ INVREQ BRANCH IF NOT ZERO (INVALID) 02460000
- IC 1,XYFLAG PICK UP OLD VALUE OF XYFLAG 02461000
- LR 2,1 SAME THING 02462000
- NR 2,3 IS THIS REQUEST ALREADY ACTIVE? 02463000
- BNZ INVREQ BRANCH IF SO (RECURSIVE ERROR) 02464000
- OR 1,3 MAKE IT ACTIVE NOW 02465000
- STC 1,XYFLAG 02466000
- ST 0,XYCNT SAVE X-Y COUNT 02467000
- MVC COUNT(2),0(4) GET COUNT 02468000
- MVC EDLIN(L'EDLIN),2(4) MOVE IN SAVED COMMAND 02469000
- B NEXT4 AND EXECUTE SAVED COMMAND 02470000
- SPACE 02471000
- XYSAVE EQU * 02472000
- LH 1,COUNT LOAD LINE COUNT 02473000
- SR 1,2 MINUS POINTER=CHARS TO MOVE 02474000
- STH 1,0(4) SAVE COUNT 02475000
- BCTR 1,0 MINUS 1 FOR 'EX' 02476000
- LA 3,EDLIN(2) POINT TO START OF MOVE 02477000
- EX 1,XYMVC MOVE IN LINE 02478000
- B NEXT AND BACK TO MAIN LOOP 02479000
- SPACE 02480000
- XYMVC MVC 2(*-*,4),0(3) BLANK 'MVC' FOR 'EX' 02481000
- EJECT 02482000
- *********************************************************************** 02483000
- * 02484000
- * TRUNCIT SETS THE COLUMN OF TRUNCATION. 02485000
- * 02486000
- *********************************************************************** 02487000
- SPACE 02488000
- TRUNCIT DS 0H 02489000
- BAL 14,NUM GET PARM 02490000
- B TRUSTAR BRANCH IF NOT A NUMBER 02491000
- BZ INVREQ TRUNC = 0, NOT ALLOWED 02492000
- BM TRUNCTYP NOTHING THERE - TYPE CURRENT SETTINGS 02493000
- C 0,ITEM TOO BIG? 02494000
- BH INVREQ BRANCH IF SO 02495000
- TRUNCIT1 EQU * 02496000
- BAL 14,PARMCHK CHECK NO MORE PARMS 02497000
- STH 0,TRUNCOL STORE IT 02498000
- B NEXT 02499000
- SPACE 02500000
- TRUSTAR EQU * 02501000
- BAL 14,STARCHK CHECK WHETHER PARM IS A STAR 02502000
- L 0,ITEM USE ITEM LENGTH 02503000
- B TRUNCIT1 02504000
- SPACE 02505000
- TRUNCTYP EQU * TYPE CURRENT TRUNC SETTING 02506000
- LH 0,TRUNCOL LOAD UP R0 WITH SETTING 02507000
- SPACE 1 02508000
- AREATYPE BAL R14,BINDEC @V2D3913 02509000
- WTYPE AREA+3,5,RETURN=NEXT @V2D3913 02510000
- SPACE 3 02511000
- *********************************************************************** 02512000
- * 02513000
- * 'BINDEC' CONVERTS THE BINARY CONTENTS OF R0 TO PACKED DECIMAL 02514000
- * AND EDITS THIS DATA, PROVIDING (ONLY) THE LOW-ORDER FOUR (4) 02515000
- * CHARACTERS FOR TYPING. THE ZONED DATA IS AVAILABLE 02516000
- * IN THE FIELD 'AREA' UPON RETURN FROM BINDEC. 02517000
- * BINDEC IS CALLED BY 'TRUNCIT', 'ZONE', 'VERIFY' AND 'CHANGE' 02518000
- * 02519000
- *********************************************************************** 02520000
- SPACE 02521000
- BINDEC DS 0H 02522000
- CVD 0,DECIMAL 02523000
- MVC AREA(8),PATTERN SUPPLY EDIT PATTERN V0379 02524000
- ED AREA(8),HALF EDIT ALL DIGITS V0379 02525000
- BR 14 RETURN TO CALLER 02526000
- SPACE 1 02527000
- PATTERN DC X'4020202020202021' EDIT PATTERN @V305614 02528000
- EJECT 02529000
- *********************************************************************** 02530000
- * 02531000
- * 'ZONE' Z1 <Z2> SETS THE BEGINNING AND END COLUMN FOR 02532000
- * CHANGE, ALTER AND LOCATE. 02533000
- * 02534000
- *********************************************************************** 02535000
- SPACE 02536000
- ZONE DS 0H 02537000
- BAL 14,NUM GET ARGUMENT 02538000
- BAL 14,STARCHK HOPEFULLY A STAR 02539000
- BM ZONTYPE BRANCH IF NOT GIVEN @VM08700 02540000
- BZ INVREQ BRANCH IF 0 @VM08700 02541000
- LPR 2,0 SAVE IT, OR 1 IF * 02542000
- BAL 14,NUM GET 2ND ARG 02543000
- B ZSTAR HOPEFULLY A STAR IF ERROR RETURN FROM NUM 02544000
- BZ INVREQ BRANCH IF ZERO 02545000
- BL ZONEC BRANCH IF 2ND ARG. ABSENT 02546000
- C 0,ITEM TOO BIG? 02547000
- BH INVREQ BRANCH IF SO 02548000
- ZONEB EQU * 02549000
- BAL 14,PARMCHK CHECK NO MORE ARGS 02550000
- CR 0,2 CHECK END ZONE >= START 02551000
- BL INVREQ BRANCH IF NOT 02552000
- STH 0,ZONE2 SAVE END ZONE 02553000
- B ZONED 02554000
- ZONEC EQU * 2ND ARG IS ABSENT 02555000
- CH 2,ZONE2 COMPARE 1ST WITH EXISTING ZONE2 02556000
- BH INVREQ BRANCH IF GREATER 02557000
- ZONED EQU * 02558000
- BCTR 2,0 DECREMENT START ZONE 02559000
- STH 2,ZONE1 SAVE IT 02560000
- B NEXT 02561000
- SPACE 02562000
- ZSTAR EQU * 02563000
- BAL 14,STARCHK CHECK THAT IT'S A STAR 02564000
- L 0,ITEM USE THE ITEM LENGTH 02565000
- B ZONEB 02566000
- SPACE 2 02567000
- ZONTYPE EQU * TYPE CURRENT ZONES 02568000
- LH 1,ZONE1 FIRST GET ZONE-1 02569000
- LA 1,1(,1) MAKE UP FOR DECREMENT (ABOVE) 02570000
- LR 0,1 PUT IT IN R0 FOR 'BINDEC' 02571000
- BAL 14,BINDEC GO TO EDITTING ROUTINE 02572000
- MVC RANGE(4),AREA+4 SET UP ZONE-1 V0379 02573000
- LH 0,ZONE2 NOW LOAD UP ZONE-2 02574000
- BAL 14,BINDEC AND DO IT AGAIN (EDIT) 02575000
- MVC RANGE+4(4),AREA+4 SET UP ZONE-2 V0379 02576000
- WTYPE RANGE,8,RETURN=NEXT @V305614 02577000
- EJECT 02578000
- *********************************************************************** 02579000
- * 02580000
- * 'CASE' SETS THE CASE OF THE FILE TO 'U' (UPPER) OR 02581000
- * 'M' (MIXED). IT AFFECTS LINES OF INPUT FROM THE TERMINAL, 02582000
- * OR LINES WHICH HAVE BEEN 'STACKED'. DEFAULT DEPENDS UPON 02583000
- * THE FILETYPE. 02584000
- * 02585000
- * IT HAS A CONFUSING EFFECT ON ANY OTHER LOGICAL LINES WHICH 02586000
- * ARE STACKED BY MEANS OF THE 'LINEND' CHARACTER AFTER 02587000
- * THE 'CASE' REQUEST, ON THE SAME PHYSICAL LINE. 02588000
- * THESE OTHER LOGICAL LINES ARE INTERPRETED BY CMS BEFORE 02589000
- * THE 'CASE' REQUEST HAS TAKEN EFFECT, AND WILL THEREFORE 02590000
- * BE READ AS IF ISSUED BEFORE THE 'CASE' REQUEST. 02591000
- * 02592000
- *********************************************************************** 02593000
- SPACE 02594000
- CASE DS 0H 02595000
- BAL 14,GET GET THE ARGUMENT 02596000
- BZ CASETELL BRANCH IF NONE GIVEN (TELL HIM) 02597000
- LTR 1,1 HOW MANY CHARACTERS HAS IT? 02598000
- BNZ INVREQ BRANCH IF ¬= 1 (WON'T DO) 02599000
- MVC SAVCWD(1),XXXCWD SAVE IT 02600000
- BAL 14,PARMCHK CHECK NO MORE PARMS 02601000
- CLI SAVCWD,C'U' IS IT 'CASE U'? 02602000
- BNE CASEM BRANCH IF NOT (CHECK FOR 'CASE M') 02603000
- MVI CASESW,C'U' SET CASESW 02604000
- B NEXT 02605000
- CASEM EQU * CHECK FOR 'CASE M' 02606000
- CLI SAVCWD,C'M' WELL? 02607000
- BNE INVREQ BRANCH IF NOT (INVALID REQUEST) 02608000
- MVI CASESW,C'S' SET CASESW TO 'S' 02609000
- B NEXT 02610000
- SPACE 02611000
- CASETELL EQU * TELL HIM THE CASE 02612000
- MVI SAVCWD,C'U' SUPPOSE IT'S 'U' 02613000
- CLI CASESW,C'U' IS IT? 02614000
- BE *+8 SKIP IS SO 02615000
- MVI SAVCWD,C'M' MUST BE 'M' 02616000
- SPACE 1 02617000
- WTYPE SAVCWD,1,RETURN=NEXT @V200713 02618000
- EJECT 02619000
- *********************************************************************** 02620000
- * 02621000
- * IMAGE TURNS ON OR OFF THE CREATION OF A LINE IMAGE, OR 02622000
- * SETS CANONICAL ORDERING. DEFAULT DEPENDS UPON FILETYPE. 02623000
- * 02624000
- *********************************************************************** 02625000
- SPACE 02626000
- IMAGE DS 0H 02627000
- BAL 14,GET GET PARM 02628000
- BZ IMTYPE IF NOT GIVEN, TYPE CURRENT SETTING 02629000
- MVC SAVCWD(8),XXXCWD SAVE THE ANSWER 02630000
- BAL 14,PARMCHK ENSURE NO MORE PARMS 02631000
- CLC SAVCWD(3),ON ON ? @V2D3914 02632000
- BE IMON BRANCH IF SO 02633000
- CLC SAVCWD(4),OFF OFF ? @V2D3914 02634000
- BE IMOFF BRANCH IF SO 02635000
- CLC SAVCWD(6),=CL6'CANON ' CANON? 02636000
- BNE INVREQ BRANCH IF NOT 02637000
- OI FLAG,CAN SET CANONICAL ORDERING 02638000
- NI FLAG,255-IMNOT AND ENSURE THAT IMAGE IS NOT OFF 02639000
- B NEXT 02640000
- SPACE 02641000
- IMON EQU * 02642000
- NI FLAG,255-(CAN+IMNOT) SET CANONICAL ORDERING OFF... 02643000
- B NEXT (AND IMAGE ON) 02644000
- SPACE 02645000
- IMOFF EQU * 02646000
- OI FLAG,IMNOT SUPPRESS LINE IMAGE 02647000
- NI FLAG,255-CAN AND CANONICAL ORDERING 02648000
- B NEXT 02649000
- SPACE 2 02650000
- IMTYPE EQU * TYPE CURRENT IMAGE SETTING 02651000
- TM FLAG,CAN IS 'CANON' ACTIVE ? 02652000
- BZ IMOFFCK NO 02653000
- MVC RANGE(5),=CL6'CANON ' 02654000
- B ITYPE TYPE 'CANON' 02655000
- IMOFFCK TM FLAG,IMNOT IS 'OFF' ACTIVE ? 02656000
- BO LMW2 @V2D3913 02657000
- IMONTYP MVC RANGE(5),ON @V2D3914 02658000
- SPACE 2 02659000
- ITYPE WTYPE RANGE,5,RETURN=NEXT @V200713 02660000
- SPACE 1 02661000
- ON DC CL5'ON' @V2D3914 02662000
- OFF DC CL5'OFF' @V2D3914 02663000
- EJECT 02664000
- *********************************************************************** 02665000
- * 02666000
- * LINEMODE SWITCHES LINE-EDITING MODE ON OR OFF 02667000
- * VALID FORMS ARE 02668000
- * LINEMODE LEFT (COLS 1-5) 02669000
- * LINEMODE RIGHT (COLS 76-80) 02670000
- * LINEMODE OFF 02671000
- * LINEMODE TELLS YOU WHICH MODE 02672000
- *********************************************************************** 02673000
- SPACE 02674000
- LINEMODE DS 0H 02675000
- BAL 14,GET 02676000
- BZ LMWHICH TELL THE USER WHERE HE'S AT 02677000
- MVC SAVCWD(8),XXXCWD SAVE THE PARAMETER @V2D3913 02678000
- BAL R14,PARMCHK SHOULD ONLY BE 1. @V2D3913 02679000
- CLC SAVCWD(4),MOFF IS IT "OFF"? @V2D3913 02680000
- BE LMOFF GO HANDLE @V2D3913 02681000
- CLC SAVCWD(2),=CL2'L' L FOR LEFT IS ALLOWED @VA03087 02682000
- BE LMLEFT .... @VA03087 02683000
- CLC SAVCWD(5),MLEFT IS IT "LEFT"? @V2D3913 02684000
- BE LMLEFT GO HANDLE @V2D3913 02685000
- CLC SAVCWD(6),MRIGHT MIGHT BE RIGHT @V2D3913 02686000
- BE LMRIGHT .... @VA03087 02687000
- CLC SAVCWD(2),=CL2'R' R FOR RIGHT IS ALLOWED @VA03087 02688000
- BNE INVREQ IF NOT, BAD ARGUMENT @VA03087 02689000
- LMRIGHT EQU * 02690000
- CLI FV,C'F' F FORMAT FILE? 02691000
- BNE SERBAD BRANCH IF NOT 02692000
- CLI ITEM+3,80 ITEM LENGTH 80? 02693000
- BNE SERBAD BRANCH IF NOT 02694000
- OI FLAG,RIGHT SET MODE 02695000
- MVI TRUNCOL+1,72 TRUNCATION COLUMN=72 02696000
- TM FLAG2,TUBE DISPLAY TERMINAL? @VA04074 02697000
- BO LMOK YES ... BR @VA04074 02698000
- CLI VERCOL1+1,72 START VERIFY COL > 72 @VA04074 02699000
- BNH LMCOL2 NO ... BR @VA04074 02700000
- MVI VERCOL1+1,72 RESET TO 72 (=VERCOL2) @VA04074 02701000
- LMCOL2 EQU * @VA04074 02702000
- MVI VERCOL2+1,72 END VERIFY COL = 72 @VA04074 02703000
- LH R3,VERCOL1 GET START AND @VA04074 02704000
- LA R4,73 END+1 COLUMN POSITIONS @VA04074 02705000
- SR R4,R3 CALC VERIFY LENGTH @VA04074 02706000
- STH R4,VERLEN STORE NEW LENGTH @VA04074 02707000
- LMOK EQU * @VA04074 02708000
- MVI ZONE1+1,0 NEAR ZONE = 1 @VA00984 02709000
- MVI ZONE2+1,72 FAR ZONE=72 02710000
- LMR1 EQU * LMOFF JOINS HERE 02711000
- NI FLAG,255-LEFT NOT LEFT 02712000
- MVI LMSTART+1,75 SET COLUMN WHERE NUMBERS START 02713000
- MVI PADCHAR,C'0' PAD WITH ZEROS 02714000
- MVI TABS,1 RESET FIRST TAB 02715000
- B NEXT 02716000
- LMOFF EQU * 02717000
- NI FLAG,255-RIGHT MODE NOT RIGHT 02718000
- B LMR1 02719000
- LMLEFT EQU * 02720000
- TM FLAG,LINE8 8-DIGIT LINE NUMBERS? @VA08342 02720150
- BNO LMLEFT1 VALID COMMAND IF NOT @VA08342 02720300
- TM FLAG,LEFT LINEMODE ALREADY ON? @VA08342 02720450
- BO NEXT BYPASS REDUNDANT REQUEST @VA08342 02720600
- B INVREQ LINEMODE LEFT WAS CANCELLED @VA08342 02720750
- LMLEFT1 EQU * @VA08342 02720900
- NI FLAG,255-RIGHT CLEAR RIGHT BIT 02721000
- OI FLAG,LEFT SET MODE LEFT 02722000
- MVI PADCHAR,C' ' PAD WITH BLANKS 02723000
- MVI LMSTART+1,0 SET COLUMN WHERE NUMBERS START 02724000
- CLI ZONE1+1,6 MAY NEED TO RESET ZONE 02725000
- BH LML1 OK - NOW CHECK TABS 02726000
- MVI ZONE1+1,6 NOT OK - RESET TO 7 02727000
- CLI ZONE2+1,6 TEST FAR ZONE 02728000
- BH LML1 OK - NOW CHECK TABS 02729000
- MVI ZONE2+1,6 ELSE SET NEW VALUE 02730000
- LML1 EQU * CHECK TABS 02731000
- CLI TABS,7 STARTING COLUMN > 7? @VA08142 02732000
- BH LML2 YES, INSERT COLUMN 7 TAB @VA08142 02733000
- MVI TABS,7 ELSE RESET TO 7 02734000
- LML3 EQU * 02735000
- CLI TABS+1,8 IS FIRST TAB GE 8? 02736000
- BNL NEXT YES - ALL DONE 02737000
- CLI TABS+1,0 OR ZERO? 02738000
- BE NEXT YES - THAT'S OK TOO 02739000
- MVC TABS+1(ENDTABS-TABS-2),TABS+2 SHIFT TABS LEFT 02740000
- B LML3 REPEAT IF NECESSARY 02741000
- LML2 MVC TEMPTAB(ENDTABS-TABS-1),TABS STORE FOR SHIFT @VA08142 02741150
- MVI TABS,7 INSERT FIXED TAB @VA08142 02741300
- MVC TABS+1(ENDTABS-TABS-2),TEMPTAB SHIFT TO RIGHT @VA08142 02741450
- B NEXT FINISHED @VA08142 02741600
- SPACE 1 02742000
- LMWHICH EQU * 02743000
- TM FLAG,RIGHT IS LINEMODE RIGHT? 02744000
- BZ LMW1 BRANCH IF NOT 02745000
- WTYPE MRIGHT,,RETURN=NEXT @V200713 02746000
- SPACE 1 02747000
- LMW1 EQU * 02748000
- TM FLAG,LEFT IS LINEMODE LEFT? 02749000
- BZ LMW2 BRANCH IF NOT 02750000
- WTYPE MLEFT,,RETURN=NEXT @V200713 02751000
- SPACE 1 02752000
- LMW2 EQU * 02753000
- WTYPE OFF,3,RETURN=NEXT @V2D3914 02754000
- SPACE 1 02755000
- SERBAD EQU * 02756000
- VTYPE SERBMSG,,RETURN=NEXT @V200713 02757000
- SPACE 1 02758000
- SERBMSG DC C'WRONG FILE FORMAT FOR LINEMODE RIGHT' 02759000
- MRIGHT DC C'RIGHT ' 02760000
- MLEFT DC C'LEFT ' 02761000
- MOFF DC CL5'OFF' @V200706 02762000
- MON DC CL5'ON' @V200706 02763000
- EJECT 02764000
- *********************************************************************** 02765000
- * 02766000
- * 'SUPERFIND' AND 'SUPERFIX' 02767000
- * VALID FORMS ARE 02768000
- * NNN (FIND LINE NNN) 02769000
- * NNN TEXT (INSERT/REPLACE LINE NNN) 02770000
- * 02771000
- *********************************************************************** 02772000
- SPACE 02773000
- SFIND DS 0H 02774000
- TM FLAG,RIGHT+LEFT LINEMODE ON? V0263 02775000
- BZ INVREQ DISABLED IF NOT V0263 02776000
- LA 3,1 GET A 1 @V200713 02777000
- ST 3,REPCNT RESET REPCNT @V200713 02778000
- CLI PADCHAR,C' ' ARE WE PADDING WITH BLANKS? 02779000
- BNE SF1 BRANCH IF NOT 02780000
- CLI XXXCWD,C'0' NUMBER HAS LEADING ZERO? 02781000
- BE INVREQ BRANCH INVALID IF SO 02782000
- SF1 EQU * 02783000
- LR 3,1 NO OF CHARS LESS ONE 02784000
- LA 0,1(,1) NO OF CHARS 02785000
- LA 4,5 @V1D1613 02786000
- TM FLAG,LINE8 @V1D1613 02787000
- BNO SF1B @V1D1613 02788000
- LA 4,8 @V1D1613 02789000
- SF1B CR 0,4 @V1D1613 02790000
- BH SF6 @V1D1613 02791000
- MVC PADBUF(8),PADCHAR @V1D1613 02792000
- LA 2,PADBUF(4) @V1D1613 02793000
- BCTR 4,0 @V1D1613 02794000
- SR 2,0 MOVE NOS HERE 02795000
- EX 3,SFX1 LEFT PADDING EFFECTED 02796000
- BAL 14,CLOSE GO TO TOP OF FILE 02797000
- SFL1 EQU * 02798000
- BAL R14,XNEXT FIND THE NEXT LINE @V2D3913 02799000
- TM TWITCH,EOF END OF FILE? 02800000
- BO SF1A BRANCH IF EOF @V2D3913 02801000
- LA R1,8(,R1) ELSE GET PAST THE POINTERS @V2D3913 02802000
- AH 1,LMSTART 02803000
- EX 4,CLCNUM @V1D1613 02804000
- BH SFL1 NOT YET - GO LOOP 02805000
- BE SF2 HIT - GO VERIFY 02806000
- LR 0,4 @V1D1613 02807000
- BAL 14,NUMCHECK OVERSHOOT - IS IT VALID? 02808000
- SF1A EQU * @V2D3913 02809000
- OI TWITCH,UPWARD GET SET TO BACK-UP @V2D3913 02810000
- BAL R14,XNEXT NOW DO IT @V2D3913 02811000
- CLC EDCT(2),COUNT NUMBER ONLY? 02812000
- BL SF3 BRANCH IF NOT LOCATE @V2D3913 02813000
- OI SCRFLGS,WRFULLB REWRITE ALL TEXT @V2D3914 02814000
- WTYPE LINNOT,14 @V2D3913 02815000
- B NEXT RETURN TO USER @V2D3914 02816000
- SF1C VERIFY RETURN=NEXT @V2D3913 02817000
- SF2 EQU * @V2D3913 02818000
- CLC EDCT(2),COUNT NUMBER ONLY? @V2D3913 02819000
- BNL SF1C GUESS SO @V2D3913 02820000
- OI SIGNAL,REPL SET REPLACE INDICATOR @V2D3913 02821000
- SF3 EQU * 02822000
- TM FLAG,LINE8 LONG LINENUMBERS? @V2D3914 02823000
- BO RTYP5 THEY'RE OK. @V2D3913 02824000
- MVC PADBUF+5(3),PADBUF+2 @V2D3913 02825000
- MVC PADBUF+3(2),PADBUF @V2D3913 02826000
- B RTYP5 GO INSERT/REPLACE V0263 02827000
- SF6 EQU * 02828000
- VTYPE NONOS,,RETURN=NEXT @V200713 02829000
- SPACE 1 02830000
- SFX1 MVC 0(*-*,2),XXXCWD MOVE NO INTO PAD BUFFER 02831000
- CLCNUM CLC PADBUF(*-*),0(1) @V1D1613 02832000
- EJECT 02833000
- *********************************************************************** 02834000
- * 02835000
- * PROMPTER - COMPUTE NEXT LINE NUMBER AND TYPE IT FOR USER 02836000
- * 02837000
- *********************************************************************** 02838000
- SPACE 02839000
- PROMPTER DS 0H 02840000
- SR 1,1 02841000
- LA 0,5 @V1D1613 02842000
- TM FLAG,LINE8 @V1D1613 02843000
- BNO PRA @V1D1613 02844000
- LA 0,8 @V1D1613 02845000
- PRA LR 4,0 @V1D1613 02846000
- TM TWITCH,TOPSW AT TOP? 02847000
- BO PR0 BRANCH IF SO (LINE=0) 02848000
- L R2,PTR1 GET LINE POINTER @VA02110 02849000
- LTR R2,R2 NULL FILE? @VA02110 02850000
- BNZ PRAB NO,CONTINUE NORMALLY @VA02110 02851000
- BAL R14,CLOSE YES,PRETEND WE ARE AT TOP @VA02110 02852000
- B PR0 AND BRANCH SO @VA02110 02853000
- PRAB L R1,PTR2 GET CURRENT LINE NUMBER @VA02110 02854000
- LA 1,8(,1) GET PAST POINTERS 02855000
- AH 1,LMSTART ON TO WHERE NUMBER IS 02856000
- BAL 14,NUMCHECK CONVERT TO BINARY 02857000
- LR 0,4 @V1D1613 02858000
- TM SIGNAL,REPL IMMEDIATE REPLACE? @VA04074 02859000
- BO PR22 YEP ... BR @VA04074 02860000
- PR0 EQU * 02861000
- ST 1,LMCURR SAVE CURRENT LINE NUMBER 02862000
- * NOW GET NEXT LINE NUMBER. WE DON'T USE XNEXT SINCE 02863000
- * WE WANT TO BACK UP AGAIN IMMEDIATELY 02864000
- L 1,PTR2 CURRENT LINE POINTER 02865000
- L 1,0(,1) NEXT LINE POINTER 02866000
- LTR 1,1 EOF? 02867000
- BNZ PR4 BRANCH IF NOT 02868000
- LH 2,LMINCR COME HERE IF END OF FILE 02869000
- A 2,LMCURR NEW LINE NUMBER 02870000
- C 2,=F'100000' IS IT TOO LARGE? 02871000
- BL PR2 BRANCH IF NOT 02872000
- L 1,=F'100000' MAKE 100000 'NEXT LINE NUMBER' 02873000
- B PR1 02874000
- PR4 EQU * 02875000
- LA 1,8(,1) BYPASS POINTERS 02876000
- AH 1,LMSTART GET TO LINE NUMBER 02877000
- BAL 14,NUMCHECK READ IN BINARY 02878000
- * NOW R1 CONTAINS THE NEXT LINE NUMBER (OR 100000) 02879000
- * LINE,EOF, TOPSW, AND PTR2 ARE UNCHANGED (IN CASE OF ERROR) 02880000
- PR1 EQU * 02881000
- S 1,LMCURR SUBTRACT TO GET DIFFERENCE 02882000
- LA R2,1 GET A ONE @V2D3913 02883000
- CR R1,R2 IS IT A ONE? @V2D3913 02884000
- BNH PR3 YES - MUST RENUMBER 02885000
- LH 2,LMINCR 02886000
- CR 1,2 IS DIFFERENCE LESS THAN INCREMENT? 02887000
- BH PR11 BRANCH IF NOT 02888000
- SRL 1,2 DIVIDE DIFFERENCE BY 4 02889000
- LA 2,1(,1) AND ADD ONE 02890000
- PR11 EQU * 02891000
- A 2,LMCURR COMPUTE NEW LINE NUMBER 02892000
- PR2 EQU * 02893000
- LR 1,2 SAVE R2 - WORK ON R1 02894000
- LH 3,LMINCR 02895000
- SR 0,0 ROUND DOWN TO MEAREST MULTIPLE OF LMINCR 02896000
- DR 0,3 BY DIVIDING 02897000
- MR 0,3 AND MULTIPLYING AGAIN 02898000
- C 1,LMCURR CAN WE USE THIS? 02899000
- BH PR22 ITS GREATER THAN PRESENT LINENO (=OK) 02900000
- LR 1,2 NO - USE PREVIOUSLY CALCULATED NUMBER 02901000
- PR22 EQU * TYPE NUMBER AT TERMINAL WITH NO CR 02902000
- CVD 1,DECIMAL BACK TO DECIMAL 02903000
- UNPK PADBUF(8),DECIMAL(8) @V1D1613 02904000
- OI PADBUF+7,C'0' @V1D1613 02905000
- LA 1,PADBUF 02906000
- CLI PADCHAR,C' ' IS PAD CHARACTER BLANK? 02907000
- BNE PR5 BRANCH IF NOT 02908000
- PRLOOP EQU * 02909000
- CLI 0(1),C'0' IS CHARACTER ZERO 02910000
- BNE PR5 BRANCH IF NOT 02911000
- MVI 0(1),C' ' IF SO MAKE IT BLANK 02912000
- LA 1,1(,1) GET NEXT CHARACTER 02913000
- B PRLOOP 02914000
- PR5 EQU * LINE FIT TO PRINT 02915000
- LA 1,PADBUF+8 @V1D1613 02916000
- SR 0,0 @V1D1613 02917000
- CH 4,=H'5' @V1D1613 02918000
- BNE *+8 @V1D1613 02919000
- LA 0,1 @V1D1613 02920000
- AR 0,4 @V1D1613 02921000
- SR 1,4 @V1D1613 02922000
- OI TYPFLG,CRBIT SUPPRESS CARRIAGE RETURN 02923000
- BAL 14,WRTYPE TYPE NUMBER 02924000
- NI TYPFLG,255-CRBIT RESTORE CARRIAGE RETURN 02925000
- B INP1 RETURN 02926000
- PR3 EQU * 02927000
- NI FLAG2,255-INMODE RESET INPUT FLAG @V200714 02928000
- OI UTILFLAG,LINSEQ NO SPACE FOR LINEMODE INPUT @VA08152 02928500
- OI SCRFLGS,WRSTATB REWRITE STATUS LINE @V2D3913 02929000
- VTYPE NOSPACE,,RETURN=PRGRCK @V200714 02930000
- SPACE 1 02931000
- NUMCHECK EQU * 02932000
- LA 15,0(4,1) @V1D1613 02933000
- NCL EQU * 02934000
- CLI 0(1),C'0' POSITIVE NUMBER? 02935000
- BL NC3 BRANCH IF NOT 02936000
- NC2 EQU * 02937000
- LA 1,1(,1) NEXT CHARACTER 02938000
- CR 1,15 02939000
- BL NCL LOOP IF NOT DONE 02940000
- SR 1,4 @V1D1613 02941000
- B DECBIN ELSE CONVERT TO BINARY 02942000
- NC3 EQU * 02943000
- CLI 0(1),C' ' IS IT A BLANK? 02944000
- BE NC2 BRANCH BACK IF SO 02945000
- NI FLAG2,255-INMODE RESET INPUT FLAG @V200714 02946000
- OI SCRFLGS,WRSTATB REWRITE STATUS LINE @V2D3913 02947000
- WTYPE NUMBAD @V200714 02948000
- PRGRCK EQU * @V200714 02949000
- TM FLAG2,TUBE DISPLAY TERMINAL ? @V200714 02950000
- BNO PEDIT NO...BR @V200714 02951000
- B PEDIT1 @V200714 02952000
- NOSPACE DC C'RENUMBER LINES' 02953000
- NONOS DC C'MAXIMUM LINE NUMBER EXCEEDED' 02954000
- NUMBAD DC C'NON-NUMERIC CHARACTER IN LINE NUMBER COLUMNS' 02955000
- EJECT 02956000
- *********************************************************************** 02957000
- * 02958000
- * PROMPT N - RESET PROMPT INCREMENT TO N 02959000
- * 02960000
- *********************************************************************** 02961000
- SPACE 02962000
- PROMPT DS 0H 02963000
- BAL 14,NUM GET INCREMENT 02964000
- B INVREQ INVALID IF NOT NUMERIC 02965000
- BM PROMTELL TYPE CURRENT INCR IF NO ARGS 02966000
- LTR 0,0 IS IT POSITIVE? 02967000
- BNP INVREQ BRANCH IF NOT 02968000
- CH 0,HALFLIM COMPARE WITH 32767 @V200713 02969000
- BH INVREQ ERROR IF SO V0263 02970000
- STH 0,LMINCR 02971000
- B NEXT 02972000
- SPACE 1 02973000
- PROMTELL EQU * TYPE CURRENT LINE INCR 02974000
- LH 0,LMINCR LOADUP R0 WITH INCR 02975000
- B AREATYPE @V2D3913 02976000
- EJECT 02977000
- ****************************************************************** 02978000
- * 02979000
- * 'PRESERVE' AND 'RESTORE' PRESERVE AND RESTORE THE SETTING 02980000
- * OF TRUNC, VERIFY, ZONE, LONG, TABS, IMAGE, SCOPE, SERIAL, 02981000
- * CASE, NAME, MODE AND RECFORM. 02982000
- * 02983000
- ****************************************************************** 02984000
- SPACE 1 02985000
- PRESERVE DS 0H @V200713 02986000
- BAL 14,PARMCHK CHECK NO PARM @V200713 02987000
- MVC JAR(ENDBLOC-BLOC),BLOC SAVE DATA IN PRESERVING@V200713 02988000
- B NEXT @V200713 02989000
- SPACE 1 02990000
- RESTORE DS 0H @V200713 02991000
- BAL 14,PARMCHK CHECK NO PARM @V200713 02992000
- MVC BLOC(ENDBLOC-BLOC),JAR RESTORE DATA FROM JAR @V200713 02993000
- B NEXT @V200713 02994000
- EJECT 02995000
- ****************************************************************** 02996000
- * 02997000
- * 'AUTOSAVE' ALLOWS THE EDIT USER TO AUTOMATICALLY SAVE THE 02998000
- * CURRENT COPY OF HIS FILE AFTER EVERY 'N' LINES HAVE BEEN 02999000
- * ADDED, REPLACED OR DELETED. IF NO PARAMETERS ARE GIVEN, 03000000
- * THE CURRENT LINE LIMIT IS TYPED. IF 'OFF' IS SPECIFIED, 03001000
- * THE AUTOSAVE FEATURE IS SET OFF. 03002000
- * 03003000
- ****************************************************************** 03004000
- SPACE 1 03005000
- AUTOSAVE DS 0H @V200706 03006000
- BAL 14,NUM READ THE ARGUMENT @V200706 03007000
- B AUTOFF IF NON-NUMERIC TOKEN @V200706 03008000
- BM AUTOTELL IF NO TOKEN @V200706 03009000
- LTR 0,0 IS NUMERIC POSITIVE? @V200706 03010000
- BNP INVREQ ERROR IF NOT @V200706 03011000
- CH 0,HALFLIM 'N' > 32767? @V200706 03012000
- BH INVREQ ERROR IF SO @V200706 03013000
- BAL 14,PARMCHK NO MORE TOKENS, PLEASE. @V200706 03014000
- SPACE 1 03015000
- STH 0,AUTOCNT SAVE THE LIMIT @V200706 03016000
- OI SIGNAL,AUTOFLAG OBVIOUSLY. @V200706 03017000
- B NEXT GET NEXT EDIT SUBCOMMAND @V200706 03018000
- SPACE 1 03019000
- AUTOFF CLC XXXCWD(4),OFF ONLY 'OFF' ALLOWED @V2D3914 03020000
- BNE INVREQ TOO BAD. @V200706 03021000
- NI SIGNAL,255-AUTOFLAG TURN IT ALL OFF @V200706 03022000
- XC AUTOCNT(4),AUTOCNT CLEAR LIMIT AND CURRENT NO. @V200706 03023000
- B NEXT GET NEXT COMMAND @V200706 03024000
- SPACE 1 03025000
- AUTOTELL LH 0,AUTOCNT GET LIMIT COUNT @V200706 03026000
- LTR 0,0 CHEK FOR NO ENTRY @V200706 03027000
- BZ LMW2 BR, IF NO ENTRY @V2D3913 03028000
- B AREATYPE AND DISPLAY IT @V2D3913 03029000
- SPACE 1 03030000
- HALFLIM DC H'32767' HALFWORD LIMIT @V200706 03031000
- EJECT 03032000
- *************************************************************** 03033000
- * 03034000
- * 'TABSET' REDEFINES THE TAB STOPS 03035000
- * 03036000
- *************************************************************** 03037000
- SPACE 1 03038000
- TABSET DS 0H @V2D3913 03039000
- LA R2,ENDTABS-TABS LENGTH OF TAB AREA @V2D3913 03040000
- SR R4,R4 @V2D3913 03041000
- LA R5,L'LINE GET LENGTH OF LINE @V2D3913 03042000
- LA R3,TEMPTAB @V2D3913 03043000
- BAL R14,NUM GET FIRST ARGUMENT @V2D3913 03044000
- B INVREQ NON-NUMERIC, ERROR @V2D3913 03045000
- BL INVREQ NO ARG ENTERED, ERROR @V2D3913 03046000
- LA R6,7 STANDARD TAB FOR LINEMODE LEFT @VA08142 03046500
- B TABBIG CONTINUE CHECKS @V2D3913 03047000
- SPACE 1 03048000
- TABSET1 EQU * @V2D3913 03049000
- BAL R14,NUM GET FIELD. @V2D3913 03050000
- B INVREQ ERROR RETURN. @V2D3913 03051000
- BL TABSET2 END. @V2D3913 03052000
- SR R6,R6 RESET FIRST-TIME INDICATOR @VA08142 03052500
- TABBIG CR R0,R5 COMPARE WITH L'LINE @V2D3913 03053000
- BH INVREQ BRANCH IF SO @V2D3913 03054000
- CR R0,R4 BIGGER THAN LAST ONE? @V2D3913 03055000
- BNH INVREQ BRANCH IF NOT @V2D3913 03056000
- LR R4,R0 SAVE IT @V2D3913 03057000
- TM FLAG,LEFT LINEMODE LEFT? @VA08142 03057060
- BNO TABSET3 NO, STORE IN BUFFER @VA08142 03057120
- LTR R6,R6 FIRST TIME THROUGH? @VA08142 03057180
- BZ TABSET3 NO, STORE IN BUFFER @VA08142 03057240
- TM FLAG,LINE8 8-DIGIT NUMBER FIELD? @VA08142 03057300
- BNO COMPTAB NO, 5-DIGIT FIELD @VA08142 03057360
- LA R6,9 FIRST TAB FOR FREEFORT @VA08142 03057420
- COMPTAB EQU * @VA08142 03057480
- CR R0,R6 TO RIGHT OF FIXED MARGIN? @VA08142 03057540
- BNH TABSET3 NO, STORE IN BUFFER @VA08142 03057600
- STC R6,0(,R3) YES, STORE FIXED TAB FIRST @VA08142 03057660
- LA R3,1(,R3) POINT TO NEXT POSITION @VA08142 03057720
- BCTR R2,0 REDUCE REMAINDER @VA08142 03057780
- TABSET3 EQU * @VA08142 03057840
- STC R0,0(,R3) HERE TOO @V2D3913 03058000
- LA R3,1(,R3) @V2D3913 03059000
- BCT R2,TABSET1 @V2D3913 03060000
- B INVREQ TOO MANY TABS @V2D3913 03061000
- SPACE 1 03062000
- TABSET2 EQU * @V2D3913 03063000
- XC 0(1,R3),0(R3) ZERO OUT LAST TAB SETTING @V2D3913 03064000
- MVC TABS(ENDTABS-TABS),TEMPTAB MOVE IN NEW TABS @V2D3913 03065000
- B NEXT @V2D3913 03066000
- EJECT 03067000
- *************************************************************** 03068000
- * 03069000
- * DITTO STACKS (LIFO) THE LAST EDIT REQUEST WHICH (WHETHER 03070000
- * VALID OR NOT) DID NOT START WITH A DOUBLE-QUOTE OR A 03071000
- * QUESTION MARK. 03072000
- * 03073000
- *********************************************************************** 03074000
- SPACE 03075000
- DITTO DS 0H 03076000
- OI SIGNAL,QUOD SET ? AND " FLAG 03077000
- L 1,XYCNT GET XY COUNT 03078000
- LTR 1,1 MAKE SURE IT'S ZERO 03079000
- BNZ INVREQ (CONFUSION REINS IF IT'S NOT) 03080000
- LA 1,TABLIN @V200713 03081000
- ST 1,ATTNLEN SET INTO ATTN PLIST @V200713 03082000
- LH 1,DITCNT 03083000
- LA 1,1(1) ADD ONE TO DITCNT 03084000
- STH 1,DITCNT 03085000
- LH 1,SAVCNT LENGTH OF SAVED REQUEST 03086000
- STC 1,ATTNLEN SET THE LENGTH TO STACK @V200713 03087000
- CMS ATTN @V200713 03088000
- BAL 14,GET GET THE NEXT TOKEN 03089000
- BZ NEXT BRANCH IF NONE 03090000
- B NEXT1 03091000
- EJECT 03092000
- ************************************************************** 03093000
- * 03094000
- * FORMAT ALLOWS A DISPLAY TERMINAL USER TO SWITCH BETWEEN 03095000
- * DISPLAY AND TYPEWRITER MODE OF OPERATION WHILE IN AN EDIT 03096000
- * SESSION. 03097000
- * 03098000
- ************************************************************** 03099000
- SPACE 1 03100000
- FORMAT EQU * @VM03203 03101000
- LA R5,INVREQ FOR INVALID REQUEST BRANCH @VM03203 03102000
- TM FLAG2,NODISP NODISP OPTION INCLUDED ? @VM03203 03103000
- BOR R5 INVALID IF SO @VM03203 03104000
- L R4,ADEVTAB POINT TO DEVICE TABLE @VM03203 03105000
- USING DEVTAB,R4 FOR CONSOLE ADDRESS @VM03203 03106000
- LH R2,CONSOLE GET CONSOLE ADDRESS @VA09296 03107000
- DROP R4 ..... @VM03203 03108000
- SPACE 1 03109000
- DC X'83230024' DIAGNOSE FOR CONSOLE CLASS @VA09296 03110000
- BHR R5 INVALID IF DISCONNECTED @VM03203 03111000
- CLM R4,BIN1000,GRAFCON GRAPHICS TERMINAL ! @VM03203 03112000
- BE FORMOK OK, IF SO @VM03203 03113000
- CLM R4,BIN1000,CLASTERM TERMINAL CLASS? @VA09296 03114000
- BNER R5 NO -- ERROR @VA09296 03114200
- CLM R4,BIN0100,TYP3275 3275 DISPLAY? @VA09296 03114400
- BE FORMOK YES -- CONTINUE @VA09296 03114600
- CLM R4,BIN0100,TYP3277 3277 DISPLAY? @VA09296 03114800
- BE FORMOK YES -- CONTINUE @VA09296 03115000
- CLM R4,BIN0100,TYP3278 3278 DISPLAY? @VA09296 03115200
- BNER R5 NO -- ERROR @VA09296 03115400
- SPACE 1 03116000
- FORMOK BAL R14,GET GET OPERAND @VM03203 03117000
- BZ INVREQ MUST HAVE AN OPERAND @V2D3914 03118000
- SPACE 1 03119000
- CLC XXXCWD(4),=C'LINE' LINE SPECIFIED ? @V2D3914 03120000
- BE SNGMODE YES ... BR @V2D3914 03121000
- CLC XXXCWD(7),=C'DISPLAY' OPERAND HAD BETTER @V2D3914 03122000
- BNER R5 BE DISPLAY.. @V2D3914 03123000
- SPACE 1 03124000
- OI FLAG2,TUBE TELL EDIT IT'S A TUBE @V2D3914 03125000
- NI FLAG2,255-INMODE MAKE SURE INPUT FLAG OFF @VA04190 03126000
- OI SCRFLGS,WRTOPB CAUSE A FULL DISPLAY @V2D3914 03127000
- VERIFY RETURN=NEXT @V2D3914 03128000
- SPACE 1 03129000
- SNGMODE NI FLAG2,255-TUBE TELL EDIT IT'S A TYPEWRITER @V2D3914 03130000
- B NEXT @V2D3914 03131000
- SPACE 1 03132000
- GRAFCON DC X'40' GRAPHICS CONSOLE TYPE @VM03203 03133000
- TYP3275 DC X'02' 3275 DISPLAY STATION @VA09296 03134000
- TYP3277 DC X'04' 3277 DISPLAY STATION @VA09296 03134050
- TYP3278 DC X'01' 3278 DISPLAY STATION @VA09296 03134100
- CLASTERM DC X'80' TERMINAL CLASS @VA09296 03134150
- EJECT 03135000
- *********************************************************************** 03136000
- * 03137000
- * 'STACK' HAS 2 FORMS: 03138000
- * 03139000
- * 1. STACK <N> 03140000
- * 2. STACK EDIT-REQUEST 03141000
- * 03142000
- * FORM 1 STACKS (FIFO) N LINES (OR 1 LINE IF N IS OMITTED), 03143000
- * STARTING WITH THE CURRENT LINE AND MAKING THE LAST LINE 03144000
- * STACKED THE NEW CURRENT LINE. 'STACK 0' IS TREATED AS A 03145000
- * SPECIAL CASE, AND STACKS A NULL LINE. 03146000
- * 03147000
- * FORM 2 STACKS (FIFO) THE GIVEN EDIT-REQUEST. 03148000
- * 03149000
- * IN FORM 1, A CHECK IS MADE FOR AN EXCESSIVE NUMBERS OF LINES. 03150000
- * WE WANT TO AVOID RUNNING OUT OF FREE STORAGE (WHICH IS WHERE 03151000
- * LINES THAT ARE STACKED ARE PUT) 03152000
- * 03153000
- *********************************************************************** 03154000
- SPACE 03155000
- STACK DS 0H 03156000
- LH 2,EDCT REMEMBER EDCT 03157000
- L R3,PTR2 GET POINTER TO THE CURRENT LINE @VA04608 03158000
- BAL 14,NUM GET PARM 03159000
- B STACKREQ BARNCH IF NOT NUMERIC 03160000
- BAL 14,PARMCHK CHECK NO MORE PARMS 03161000
- LA 1,LINE ADDRESS FROM WHICH TO STACK LINES 03162000
- LTR 2,0 GET NUMBER OF LINES 03163000
- BZ STACKNUL GO AND STACK NULL LINE IF ZERO 03164000
- LA 1,25 GET THE STACK LIMIT COUNT @V200713 03165000
- CR 2,1 CHECK NUMBER REQUESTED @V200713 03166000
- BH STKBUST BRANCH IF TOO MANY 03167000
- MVC STACKATL(1),TRUNCOL+1 LENGTH OF LINE TO STACK 03168000
- LR R1,R3 INITIALIZE LINE POINTER @VA04608 03169000
- BAL R14,EORCHK CHECK CURRENT RANGE @V2D3913 03170000
- B ENDRANGE ALL DONE IN THIS CASE @V2D3913 03171000
- SPACE 03172000
- TM TWITCH,TOPSW+EOF SOME OTHER BOUNDARY? @V2D3913 03173000
- BNZ STACKIT1 SKIP IT, THEN @V2D3914 03174000
- STACKIT EQU * @V200713 03175000
- LA R1,8(,R1) POINT PAST THE POINTERS @V2D3913 03176000
- STCM R1,B'0111',STACKATL+1 STORE THE DATA ADDRESS @V2D3913 03177000
- STACKIT3 EQU * 03178000
- CMS STACKAT STACK THE LINE 03179000
- STACKIT1 BCT R2,STACKIT2 MORE TO DO ? @V2D3914 03180000
- TM FLAG2,TUBE IS THIS A GRAPHICS DEVICE? @VA04608 03181000
- BNO NEXT NO. THEN WE'RE ALL DONE @VA04608 03182000
- CL R3,PTR2 HAS THE CURRENT LINE MOVED? @VA04608 03183000
- BE NEXT DISPLAY IS CORRECT IF IT HASN'T @VA04608 03184000
- VERIFY RETURN=NEXT @VA04608 03185000
- STACKIT2 BAL R14,XNEXT GET NEXT LINE LOCATION @V2D3914 03186000
- TM TWITCH,TOPSW+EOF @V2D3913 03187000
- BNZ ENDRANGE @V2D3913 03188000
- B STACKIT STACK THIS LINE @V2D3914 03189000
- SPACE 1 03190000
- SPACE 03191000
- STACKREQ EQU * STACK REST OF LINE (AS EDIT REQUEST) 03192000
- LA 1,EDLIN(2) WHERE IN EDLIN TO START 03193000
- ST 1,STACKATL STORE IN 'ATTN' PLIST 03194000
- LH 1,COUNT TOTAL LENGTH OF EDLIN 03195000
- SR 1,2 MINUS EDCT MAKES LENGTH TO STACK 03196000
- STC 1,STACKATL STORE FOR 'ATTN' 03197000
- B STACKONE FORCE STACK COUNT TO ONE @V2D3914 03198000
- STACKNUL EQU * @V200713 03199000
- MVI STACKATL,X'00' STACK A NULL LINE. @V2D3913 03200000
- STACKONE LA R2,1 FUDGE FOR BCT (ONCE) @V2D3914 03201000
- B STACKIT3 PLIST SET TO GO @V2D3914 03202000
- SPACE 03203000
- STKBUST EQU * TOO MANY LINES 03204000
- WTYPE STKBSTMS,,RETURN=INVREQX @V200713 03205000
- SPACE 03206000
- STKBSTMS DC C'TOO MANY LINES TO STACK' 03207000
- EJECT 03208000
- *********************************************************************** 03209000
- * 03210000
- * A MACRO REQUEST (STARTING WITH A PERIOD) GOES TO FIND AN 03211000
- * EXEC FILE VIA CMS SUBSET. 03212000
- * 03213000
- *********************************************************************** 03214000
- SPACE 2 03215000
- DOT DS 0H 03216000
- L 1,XYCNT CHECK UP ON X-Y COUNT 03217000
- LTR 1,1 MUST NOT BE 03218000
- BNZ INVREQ (TOO EASY TO STACK TOO MANY LINES) 03219000
- TM TWITCH,TOPSW TOP OF FILE? V0263 03220000
- BNO CKEOF NO, CHEK EOF V0263 03221000
- LA 1,TOPMSG YES, POINT TO 'TOF' MSG V0263 03222000
- B STPTR ...AND BUILD PLIST V0263 03223000
- CKEOF TM TWITCH,EOF END OF FILE? V0263 03224000
- BNO NOPTR NEITHER, DROP THRU V0263 03225000
- LA 1,EOFREC POINT TO 'EOF' V0263 03226000
- STPTR EQU * V0263 03227000
- ST 1,ATTNLEN SET ADDRESS INTO ATTN PLIST @V200713 03228000
- MVI ATTNLEN,X'03' SET THE LENGTH @V200713 03229000
- CMS ATTN @V200713 03230000
- NOPTR EQU * V0263 03231000
- MVC MACRO(L'MACROHDR),MACROHDR FORCE CALL TO EXEC@VA04733 03232000
- LA R1,MACRO POINT TO 'EXEC $...' COMMAND @VA04733 03233000
- ST 1,ATTNLEN PUT ADDRESS INTO ATTN PLIST @V200713 03234000
- LH R1,COUNT GET THE LENGTH @VA04733 03235000
- LA R1,EDLIN-MACRO(R1) INCREMENTED BY L'EXEC + 1 @VA04733 03236000
- STC 1,ATTNLEN PUT IT INTO THE PLIST @V200713 03237000
- CMS ATTN @V200713 03238000
- CMS SUBSET,ERROR=IGNORE @V200713 03239000
- LTR 15,15 TEST RETURN CODE 03240000
- BZ NEXT BRANCH IF ZERO (OK) 03241000
- LR 2,15 @V200713 03242000
- BAL 4,STACKCLR CLEAR STACK IF NECESSARY V0379 03243000
- LA 2,1(,2) @V200713 03244000
- LTR 2,2 @V200713 03245000
- BZ INVDOT @V200713 03246000
- B NEXT 03247000
- SPACE 1 03248000
- SUBSET DS 0F 03249000
- DC CL8'SUBSET' 03250000
- DC CL8'(RETURN' 03251000
- DC 8X'FF' 03252000
- EJECT 03253000
- *********************************************************************** 03254000
- * 03255000
- * 'CMS' PUTS THE USER INTO CMS SUBSET 03256000
- * 03257000
- *********************************************************************** 03258000
- SPACE 03259000
- CMS DS 0H 03260000
- BAL 14,PARMCHK CHECK NO PARMS 03261000
- TM FLAG2,TUBE DISPLAY TERMINAL ? @V200714 03262000
- BNO MODESW NO...BR @V200714 03263000
- MVI SCRFLG2,CANCB CAUSE TUBE CANCEL OP @V200714 03264000
- BAL R14,WRTYPEX @V2D3913 03265000
- NI SCRFLG2,255-CANCB RESET CANCEL FLAG @VA04074 03266000
- MODESW EQU * @V200714 03267000
- CMS CMSSUB,ERROR=INVREQ CALL CMS SUBSET 03268000
- B REFRESH @V2D3913 03269000
- SPACE 03270000
- CMSSUB DS 0F 03271000
- DC CL8'SUBSET' 03272000
- DC X'FF' 03273000
- SPACE 4 03274000
- *********************************************************************** 03275000
- * 03276000
- * 'QUIT' CAUSES EXIT FROM THE EDITOR, ABANDONING CONTENTS 03277000
- * 03278000
- *********************************************************************** 03279000
- SPACE 03280000
- QUIT DS 0H 03281000
- BAL 14,PARMCHK CHECK NO PARMS 03282000
- XR 2,2 RETURN CODE = 0 03283000
- B EDEXIT1 GO EXIT 03284000
- EJECT 03285000
- *********************************************************************** 03286000
- * 03287000
- * 'STACKCLR' IS A SUBROUTINE WHICH CLEARS THE READ STACK 03288000
- * BY CALLING THE CMS 'DESBUF' FUNCTION. 03289000
- * 03290000
- * CALL: 03291000
- * BAL 4,STACKCLR 03292000
- * 03293000
- * (LEVEL N SUBROUTINE) 03294000
- * 03295000
- *********************************************************************** 03296000
- SPACE 03297000
- STACKCLR DS 0H 03298000
- L 1,AFSTFNRD ADDRESS OF ANCHOR FOR STACKED READS 03299000
- L 1,0(1) ARE THERE ANY? 03300000
- LTR 1,1 03301000
- BCR 8,4 @V200713 03302000
- CMS CONWAIT WAIT FOR PEACE AND QUIET 03303000
- CMS DESBUF DESTROY STACKED LINES 03304000
- WTYPE KILMES TYPE WARNING MESSAGE 03305000
- BR 4 RETURN 03306000
- SPACE 03307000
- CONWAIT DS 0F 03308000
- DC CL8'CONWAIT' 03309000
- DC CL4'CON1' 03310000
- SPACE 03311000
- DESBUF DS 0F 03312000
- DC CL8'DESBUF' 03313000
- SPACE 03314000
- KILMES DC C'STACKED LINES CLEARED' 03315000
- EJECT 03316000
- ************** 03317000
- * 03318000
- * 'KTCLR' IS A SUBROUTINE TO CLEAR THE 'KT' FLAG IN ORDER 03319000
- * TO TYPE AN IMPORTANT MESSAGE WHICH SHOULD NOT BE MISSED. 03320000
- * IT DOES SO BY STACKING A NULL LINE (LIFO) AND THEN 03321000
- * READING IT. 03322000
- * 03323000
- * CALL IS: 03324000
- * BAL 4,KTCLR 03325000
- * 03326000
- * (LEVEL N SUBROUTINE, CALLED FROM XWRITE, SAVE/FILE AND 03327000
- * TERMINAL ERRORS.) 03328000
- * 03329000
- ************** 03330000
- SPACE 03331000
- KTCLR DS 0H 03332000
- ICM R1,3,COUNT GET REQUEST LENGTH @VA04190 03333000
- STH R1,SAVCNT SAVE IT @VA04190 03334000
- BZ KTNEXT BRANCH IF NULL @VA04190 03335000
- BCTR R1,0 MINUS ONE FOR 'EX' @VA04190 03336000
- EX R1,SAVREQ SAVE REQUEST IN TABLIN @VA04190 03337000
- OI SIGNAL,QUOD MAKE LIKE A ? OR " @VA04190 03338000
- KTNEXT EQU * @VA04190 03339000
- MVI ATTNLEN,X'00' STACK ZERO CHARACTERS. @V200713 03340000
- CMS ATTN @V200713 03341000
- BAL 14,RDTYPE THEN READ IT, THEREBY CLEARING KT FLAG 03342000
- BR 4 RETURN 03343000
- EJECT 03344000
- ****************************************************************** 03345000
- * 03346000
- * QUERY TYPES OUT THE LAST EDIT REQUEST WHICH (WHETHER 03347000
- * VALID OR NOT) DID NOT START WITH A DOUBLE QUOTE OR A 03348000
- * QUESTION MARK. 03349000
- * 03350000
- ****************************************************************** 03351000
- SPACE 1 03352000
- QUERY DS 0H @V200713 03353000
- OI SIGNAL,QUOD SET ? AND " FLAG @V200713 03354000
- BAL 14,PARMCHK ENSURE NO MORE PARMS @V200713 03355000
- LH 0,SAVCNT GET LENGTH OF SAVED REQUEST @V200713 03356000
- LA 1,TABLIN AND ADDRESS @V200713 03357000
- OI SCRFLG2,CMDINB SET FLAG FOR DISPLAY RTN @V2D3913 03358000
- LA R14,NEXT WRITE LAST COMMAND TO INPUT AREA @V2D3913 03359000
- B WRTYPEX THEN GET NEXT SUBCOMMAND @V2D3913 03360000
- EJECT 03361000
- ****************************************************************** 03362000
- * 03363000
- * 'LONG' AND 'SHORT' CHANGE BETWEEN LONG AND SHORT 03364000
- * DIAGNOSTIC MESSAGES. 03365000
- * 03366000
- ****************************************************************** 03367000
- SPACE 1 03368000
- LONG DS 0H @V200713 03369000
- BAL 14,PARMCHK AT END OF PARMS? @V200713 03370000
- OI FLAG2,LONGSW SET 'LONG' MODE @V200713 03371000
- B NEXT @V200713 03372000
- SPACE 2 03373000
- SHORT EQU * @V200713 03374000
- BAL 14,PARMCHK AT END OF PARMS? @V200713 03375000
- NI FLAG2,255-LONGSW SET 'SHORT' MODE @V200713 03376000
- B NEXT @V200713 03377000
- EJECT 03378000
- ****************************************************************** 03379000
- * 03380000
- * 'FNAME' RESETS THE FILENAME FOR SUBSEQUENT UNQUALIFIED 03381000
- * AND SAVE REQUESTS. 03382000
- * IF ISSUED WITHOUT AN ARGUMENT, IT DISPLAYS THE CURRENT 03383000
- * NAME 03384000
- ****************************************************************** 03385000
- SPACE 1 03386000
- NAME DS 0H @V200713 03387000
- OI SIGNAL,GETCAT SET GETCAT FLAG @V200713 03388000
- BAL 14,GET GET NAME @V200713 03389000
- BZ NAMETELL BRANCH IF NONE GIVEN @V200713 03390000
- CLI XXXCWD,C'*' NAME STAR WITH A STAR? @V200713 03391000
- BE INVREQ BRANCH IF SO (NO ALLOWED) @V200713 03392000
- MVC SAVCWD(8),XXXCWD SAVE NAME @V200713 03393000
- BAL 14,PARMCHK CHECK NO MORE PARMS @V200713 03394000
- MVC FNAME(8),SAVCWD MOVE IN NEW NAME @V200713 03395000
- B VERSTAT VERIFY IF TUBE TERMINAL @V200714 03396000
- SPACE 1 03397000
- NAMETELL EQU * TYPE THE CURRENT NAME @V200713 03398000
- WTYPE FNAME,8,RETURN=NEXT @V305614 03399000
- EJECT 03400000
- ****************************************************************** 03401000
- * 03402000
- * 'FMODE' RESETS THE FILEMODE FOR THE NEW FILE. 03403000
- * IF CALLED WITHOUT ANY PARM, DISPLAYS THE CURRENT 03404000
- * SETTING 03405000
- ****************************************************************** 03406000
- SPACE 1 03407000
- MODE DS 0H @V200713 03408000
- OI SIGNAL,GETCAT SET GETCAT FLAG @V200713 03409000
- BAL 14,GET GET PARM @V200713 03410000
- BZ MODETELL BRANCH IF NONE @V200713 03411000
- BCTR 1,0 DECREMENT THE COUNT @V200713 03412000
- LTR 1,1 CHECK IT NOW @V200713 03413000
- BP INVREQ ERROR IF TOO MANY @V200713 03414000
- MVC CMODE(4),XXXCWD READY FOR 'MODECHK' @V200713 03415000
- BAL 14,MODECHK GO CHEK FOR VALID MODE @V200713 03416000
- BNZ MODERR ERROR IF CC IS -VE @V200713 03417000
- MVC FMODE(2),CMODE SAVE NEW FILEMODE @V200713 03418000
- BAL 14,PARMCHK NO MORE ARGS, PLEASE @V200713 03419000
- B VERSTAT VERIFY IF TUBE TERMINAL @V200714 03420000
- SPACE 1 03421000
- MODETELL EQU * TYPE THE CURRENT MODE @V200713 03422000
- WTYPE FMODE,2,RETURN=NEXT @V305614 03423000
- VERSTAT EQU * @V200714 03424000
- TM FLAG2,TUBE DISPLAY TERMINAL ? @V200714 03425000
- BNO NEXT NO...BR @V200714 03426000
- MVI SCRFLGS,WRSTATB STATUS CHANGE ONLY @V2D3914 03427000
- VERIFY RETURN=NEXT @V2D3913 03428000
- EJECT 03429000
- LTORG @V200713 03430000
- * *********************************** 03431000
- * *********************************** 03432000
- * ***** ***** 03433000
- * ***** END OF PAGE 2 ***** 03434000
- * ***** ***** 03435000
- * *********************************** 03436000
- * *********************************** 03437000
- EJECT 03438000
- ****************************************************************** 03439000
- * 03440000
- * 'RECFORM' RESETS RECORD FORMAT BETWEEN F AND V. 03441000
- * DEFAULT DEPENDS UPON THE FILETYPE. 03442000
- * 03443000
- ****************************************************************** 03444000
- SPACE 1 03445000
- RECFORM DS 0H @V200713 03446000
- MVI SCRFLGS,WRSTATB MAY CHANGE STATUS LINE @V2D3914 03447000
- BAL 14,GET GET PARM @V200713 03448000
- BZ FORMTELL BRANCH IF NONE @V200713 03449000
- LTR 1,1 HOW MANY CHARS WERE TYPED? @V200713 03450000
- BNZ INVREQ BRANCH IF NOT ONE @V200713 03451000
- MVC SAVCWD(8),XXXCWD AND MOVE INTO SAVCWD @V200713 03452000
- BAL 14,PARMCHK CHECK NO MORE PARMS @V200713 03453000
- CLI SAVCWD,C'F' F? @V200713 03454000
- BNE RECFORM1 BRANCH IF NOT @V200713 03455000
- MVI FV,C'F' SAVE NEW FORMAT @V200713 03456000
- B VERSTAT VERIFY IF TUBE TERMINAL @V200714 03457000
- SPACE 1 03458000
- RECFORM1 EQU * @V200713 03459000
- CLI SAVCWD,C'V' V FORMAT? @V200713 03460000
- BNE INVREQ BRANCH IF NOT @V200713 03461000
- TM FLAG,RIGHT LINEMODE RIGHT? @V200713 03462000
- BZ RECFORM2 SKIP IF NOT @V200713 03463000
- WTYPE SERBMSG,,RETURN=NEXT @V200713 03464000
- SPACE 1 03465000
- RECFORM2 EQU * @V200713 03466000
- MVI FV,C'V' SAVE NEW FORMAT @V200713 03467000
- TM FLAG,SERSW SERIALIZATION? @V200713 03468000
- BZ VERSTAT VERIFY IF TUBE TERMINAL @V200714 03469000
- NI FLAG,255-SERSW TURN SERIALIZATION OFF @V200713 03470000
- OI SCRFLG2,WRTOPB CAUSE FULL WRITE @V200714 03471000
- WTYPE SEROFFMS,,RETURN=NEXT @V200713 03472000
- SPACE 1 03473000
- FORMTELL EQU * @V200713 03474000
- WTYPE FV,1,RETURN=NEXT @V305614 03475000
- SPACE 2 03476000
- SEROFFMS DC C'SERIALIZATION TURNED OFF FOR V FORMAT' @V200713 03477000
- EJECT 03478000
- ************************************************************** 03479000
- * 03480000
- * VERIFY SETS THE VERIFY-MODE AND/OR VERIFY COLUMN 03481000
- * 03482000
- ************************************************************** 03483000
- VERIFY DS 0H @V2D3914 03484000
- LA R5,INVREQ FOR MORE EFFICIENT USE OF CORE @V2D3914 03485000
- SR R3,R3 CLEAR A REG @V2D3914 03486000
- L R2,ITEM GET LINE LENGTH @V2D3914 03487000
- BAL R14,NUM SEE IF NUMERIC PARAMETER @V2D3914 03488000
- B VEROFFCK NO, SEE IF 'OFF' @V2D3914 03489000
- BM VERTYPE BR IF NO PARAMETER @V2D3914 03490000
- BZR R5 ZERO IS INVALID @V2D3914 03491000
- B SETVER USE VALID NUMBER @V2D3914 03492000
- SPACE 1 03493000
- VEROFFCK CLC XXXCWD(4),MOFF WAS 'OFF' SPECIFIED ? @V2D3914 03494000
- BNE VERONCK NO, SEE IF IT WAS 'ON' @V2D3914 03495000
- BCTR R3,R0 SET MINUS AS INDICATOR @V2D3914 03496000
- B VERMORE SEE IF NUMBER SPECIFIED @V2D3914 03497000
- SPACE 1 03498000
- VERONCK CLC XXXCWD(3),MON WAS 'ON' SPECIFIED ? @V2D3914 03499000
- BNE VERSTAR NO, IT BETTER BE ASTERISK @V2D3914 03500000
- LR R3,R2 YES, SET POSITIVE AS INDICATOR @V2D3914 03501000
- VERMORE BAL R14,NUM SEE IF NUMBER SPECIFIED @V2D3914 03502000
- VERSTAR BAL R14,STARCHK BETTER BE ASTERISK @V2D3914 03503000
- BM SETVER5 BR IF NOTHING SPECIFIED @V2D3914 03504000
- BZR R5 ZERO NOT ALLOWED @V2D3914 03505000
- LTR R0,R0 ASTERISK SPECIFIED ? @V2D3914 03506000
- BNM SETVER NO...BR @V2D3914 03507000
- LR R0,R2 VERIFY WHOLE LINE @V2D3914 03508000
- B SETVER2 DO SOME CHECKING @V2D3914 03509000
- SPACE 1 03510000
- SETVER LR R4,R0 SAVE FIRST NUMBER @V2D3914 03511000
- BAL R14,NUM GET NEXT NUMBER @V2D3914 03512000
- BAL R14,STARCHK MIGHT BE AN ASTERISK @V2D3914 03513000
- BNM SETVER1 BR IF 2ND NUMBER EXISTS @V2D3914 03514000
- LR R0,R4 SHIFT 'EM BACK @V2D3914 03515000
- B SETVER2 ..AND CONTINUE @V2D3914 03516000
- SPACE 1 03517000
- SETVER1 LTR R0,R0 ASTERISK SPECIFIED ? @V2D3914 03518000
- BNM SETVER3 NO ... BR @V2D3914 03519000
- LR R0,R2 USE LRECL FOR END COLUMN @V2D3914 03520000
- B SETVER3 DO SOME CHECKING @V2D3914 03521000
- SPACE 1 03522000
- SETVER2 LA R4,1 USE DEFAULT START COLUMN @V2D3914 03523000
- SETVER3 BAL R14,PARMCHK NO MORE PARAMETERS ALLOWED @V2D3914 03524000
- CR R4,R0 2ND NUMBER > OR = 1ST NUMBER ? @V2D3914 03525000
- BHR R5 INVALID IF NOT @V2D3914 03526000
- CR R0,R2 2ND NUMBER > LRECL ? @V2D3914 03527000
- BHR R5 INVALID IF SO @V2D3914 03528000
- SPACE 1 03529000
- SETVER4 STH R4,TVERCOL1 PLUG VALUES INTO TEMPORARY @V2D3914 03530000
- STH R0,TVERCOL2 ATTRIBUTE LIST @V2D3914 03531000
- SR R0,R4 CALCULATE LENGTH OF @V2D3914 03532000
- LR R4,R0 OUTPUT REQUESTED @V2D3914 03533000
- LA R4,1(,R4) ..... @V2D3914 03534000
- STH R4,VERLEN AND PLUG INTO ATTRIBUTE LIST @V2D3914 03535000
- MVC VERCOL1(4),TVERCOL1 ALSO PUT IN COLUMNS @V2D3914 03536000
- SPACE 1 03537000
- SETVER5 LTR R3,R3 CHECK OUR INDICATING REG @V2D3914 03538000
- BZ NEXT BR, IF ONLY NUMBER SPECIFIED @V2D3914 03539000
- BM VEROFF BR, IF 'OFF' SPECIFIED @V2D3914 03540000
- VERON OI FLAG2,VER SET VERIFICATION ON @V2D3914 03541000
- B NEXT GET NEXT COMMAND @V2D3914 03542000
- VEROFF NI FLAG2,255-VER RESET VERIFICATION FLAG @V2D3914 03543000
- B NEXT GET NEXT COMMAND @V2D3914 03544000
- SPACE 1 03545000
- VERTYPE LH R0,VERCOL1 CONVERT BINARY VALUE @V2D3914 03546000
- BAL R14,BINDEC TO DECIMAL @V2D3914 03547000
- MVC RANGE(4),AREA+4 PUT IT INTO AN OUTPUT AREA @V2D3914 03548000
- LH R0,VERCOL2 DO IT AGAIN @V2D3914 03549000
- BAL R14,BINDEC FOR 2ND VALUE @V2D3914 03550000
- MVC RANGE+4(4),AREA+4 ....... @V2D3914 03551000
- WTYPE RANGE,8,RETURN=NEXT AND PRINT IT @VM03203 03552000
- EJECT 03553000
- *********************************************************************** 03554000
- * 03555000
- * 'SERIAL' ALLOWS THE USER TO CONTROL SERIALIZATION. 03556000
- * 03557000
- *********************************************************************** 03558000
- SPACE 03559000
- SERIAL DS 0H 03560000
- MVI SERTSEQ,C' ' SET TEMP. SERIAL DATA TO DEFAULTS 03561000
- MVI SERTSW,X'00' CLEAR TEMPORARY SERNAME SWITCH 03562000
- LA R3,10 KEEP INCREMENT IN R3 (INIT. TO 10 03563000
- OI SIGNAL,GETCAT SET GETCAT FLAG (CONCATENATE EDIT 03564000
- BAL R14,GET GET 1ST PARM 03565000
- BZ INVREQ INVALID FOR NO ARGS 03566000
- CLC XXXCWD(4),MOFF CHECK FOR 'OFF' V0379 03567000
- BE SERIAL1 03568000
- CLC XXXCWD(4),=CL4'ALL' CHECK 'ALL 03569000
- BE SERIAL5 USE 8 DIGITS 03570000
- OI SERTSW,SERNAME SET SERIAL. WITH NAME 03571000
- CLC XXXCWD(3),MON CHECK 'ON' @V200706 03572000
- BE SERIAL5 BRANCH IF EQUAL (FILE USES FN) 03573000
- MVC SERTSEQ(3),XXXCWD FILL IN THE NAME 03574000
- SERIAL5 EQU * 03575000
- BAL R14,NUM LOOK FOR INCREMENT 03576000
- B INVREQ BRANCH IF NOT VALID 03577000
- BL SERIAL4 BRANCH IF NONE GIVEN 03578000
- LR R3,R0 PUT IT INTO R3 03579000
- BAL R14,PARMCHK CHECK NO MORE PARMS 03580000
- SPACE 03581000
- SERIAL4 EQU * 03582000
- CLI FV,C'F' F FORMAT FILE? 03583000
- BNE BADFORM BRANCH IF NOT 03584000
- CLI ITEM+3,80 ITEM LENGTH 80? 03585000
- BNE BADFORM BRANCH IF NOT 03586000
- CLI TRUNCOL+1,72 CHECK TRUNCOL 03587000
- BNH CHKZON IT'S OK 03588000
- MVI TRUNCOL+1,72 SET IT TO 72 03589000
- WTYPE TRUNCMES TELL HIM SO 03590000
- SPACE 03591000
- CHKZON EQU * NOW CHECK ZONES 03592000
- CLI ZONE1+1,72 FINALLY CHECK BEGINNING ZONE 03593000
- BL SERSET BRANCH IF < 03594000
- MVI ZONE1+1,71 SET BEGINNING ZONE TO 72 03595000
- SPACE 03596000
- SERSET EQU * VALID COMMAND -- SET THINGS FOR FILE 03597000
- OI FLAG,SERSW SET SERIALIZATION (FOR REAL) 03598000
- NI FLAG,255-SERNAME CLEAR NAME SWITCH 03599000
- OC FLAG(1),SERTSW AND DO AS TOLD 03600000
- MVC SEQNAME(3),SERTSEQ MOVE IN SEQUENCE NAME (IF ANY) 03601000
- ST R3,CARDINCR AND USE GIVEN (OR DEFAULT) INCREMENT 03602000
- CLI ZONE2+1,72 COMPARE END ZONE TO 72 @V200713 03603000
- BNH NEXT BRANCH IF <= @V200713 03604000
- MVI ZONE2+1,72 SET TO 72 IF NOT @V200713 03605000
- WTYPE ZONMES,,RETURN=NEXT @V200713 03606000
- SPACE 03607000
- BADFORM EQU * 03608000
- WTYPE BADFMES,,RETURN=NEXT @V200713 03609000
- SPACE 03610000
- SERIAL1 EQU * 03611000
- BAL R14,PARMCHK CHECK NO MORE PARMS 03612000
- NI FLAG,255-SERSW INDICATE SERIALIZATION SUPPRESSED 03613000
- B NEXT 03614000
- SPACE 2 03615000
- TRUNCMES DC C'TRUNC SET TO 72' 03616000
- ZONMES DC C'END ZONE SET TO 72' 03617000
- BADFMES DC C'WRONG FILE FORMAT FOR SERIALIZATION' 03618000
- EJECT 03619000
- *********************************************************************** 03620000
- * 03621000
- * GETFILE LOADS A FILE, OR PART OF A FILE, INTO THE FILE BEING 03622000
- * EDITED. 03623000
- * 03624000
- *********************************************************************** 03625000
- SPACE 03626000
- GETFILE DS 0H 03627000
- OI SIGNAL,GETCAT SET GETCAT FLAG (CONCATENATE EDIT TOKS) 03628000
- BAL 14,GET GET FILENAME 03629000
- BZ INVREQ BRANCH IF NOT GIVEN 03630000
- MVC IOLIST+8(8),XXXCWD MOVE IN FILENAME 03631000
- SR 2,2 KEEP ZERO HERE 03632000
- MVC IOLIST+16(8),FTYPE SET CURRENT FILETYPE 03633000
- MVC IOLIST+24(2),=CL2'* ' AND ANY MODE 03634000
- STH 2,IOLIST+26 SET FOR SEQUENTIAL READING 03635000
- SR 3,3 INITIALIZE FLAG FOR READING TO EOF 03636000
- OI SIGNAL,GETCAT RESET GETCAT FLAG (CONCATENATE EDIT TOKS) 03637000
- BAL 14,GET GET FILETYPE (IF GIVEN) 03638000
- BZ GETFGO BRANCH IF NOT GIVEN 03639000
- CLI XXXCWD,C'*' STAR? 03640000
- BNE GETFMVTY BRANCH IF NOT 03641000
- LTR 1,1 ONLY THE ONE CHARACTER GIVEN? 03642000
- BH INVREQ BRANCH IF NOT (WON'T DO) 03643000
- B GETFMODE 03644000
- GETFMVTY EQU * USE THE GIVEN FILETYPE 03645000
- MVC IOLIST+16(8),XXXCWD MOVE IN GIVEN FILETYPE 03646000
- GETFMODE EQU * LOOK FOR GIVEN FILEMODE 03647000
- OI SIGNAL,GETCAT SET GETCAT FLAG (CONCATENATE EDIT TOKS) 03648000
- BAL 14,GET GET FILEMODE 03649000
- BZ GETFGO BRANCH IF NOT GIVEN 03650000
- MVC CMODE(3),XXXCWD PROVIDE GIVEN MODE TO CHECKER 03651000
- BAL 14,MODECHK AND GO THERE... 03652000
- BNZ MODERR ERROR IF MODE INVALID 03653000
- MVC IOLIST+24(2),XXXCWD MOVE IN GIVEN FILEMODE 03654000
- BAL 14,NUM GET STARTING LINE NUMBER 03655000
- B INVREQ BRANCH IF NOT NUMERIC 03656000
- BZ INVREQ OR ZERO 03657000
- STH 0,IOLIST+26 STORE IT 03658000
- BAL 14,NUM GET NO. OF LINES 03659000
- BAL 14,STARCHK IF NOT NUMERIC, HOPEFULLY IT'S * 03660000
- BZ NEXT BRANCH IF NO LINES 03661000
- BL GETFGO BRANCH IF LINES NOT SPECIFIED 03662000
- LR 3,0 SAVE LINES IN R3 03663000
- SPACE 03664000
- GETFGO EQU * 03665000
- BAL 14,PARMCHK CHECK NO MORE PARMS 03666000
- CMS IOLIST,PROG=STATE,ERROR=IGNORE 03667000
- LTR 15,15 ANY ERRORS? 03668000
- BZ GETFST NO, WE FOUND IT 03669000
- CH 15,=H'28' IS THIS A 'NOT FOUND' ERR? 03670000
- BE NOGETF THAT'S RIGHT 03671000
- B INVREQX BAD FILEID, NO MSG PLEASE. 03672000
- GETFST EQU * 03673000
- L 1,IOLIST+28 GET FST 03674000
- L 4,ITEM GET ITEM LENGTH 03675000
- C 4,32(1) COMPARE WITH THAT OF NEW FILE 03676000
- BL BADGETF BRANCH IF NEW ONE TOO LARGE 03677000
- CLC IOLIST+26(2),26(1) CHECK STARTING LINE NO. 03678000
- BH BADGETF1 BRANCH IF NOT ENOUGH LINES 03679000
- MVC IOLIST+24(2),24(1) USE ACTUAL FILEMODE 03680000
- MVC IOLIST+36(2),30(1) AND ACTUAL F OR V 03681000
- LA 1,LINE USE LINE FOR INPUT 03682000
- ST 1,IOLIST+28 STORE ITS ADDRESS IN PARM LIST 03683000
- LA 1,L'LINE LENGTH OF LINE 03684000
- ST 1,IOLIST+32 PUT IN RDBUF PARM LIST 03685000
- TM SIGNAL,AUTOFLAG AUTOSAVE ACTIVE? @VA02879 03686000
- BZ NOTAUT IF NOT GO @VA02879 03687000
- NI SIGNAL,255-AUTOFLAG IF SO DISABLE TEMPORARILY @VA02879 03688000
- OI SIGNAL,AUTOSVFL USE OTHER FLAG TO REMEMBER @VA02879 03689000
- NOTAUT EQU * @VA02879 03690000
- MVI SCRFLGS,WRTOPB REWRITE FULL DISPLAY @V2D3913 03691000
- SPACE 03692000
- DMSKEY NUCLEUS NEED NUCLEUS KEY FOR BALR CALLS @VM03083 03693000
- GETFLOOP EQU * LOOP TO "GET" DESIRED FILE: @VM03083 03694000
- EX 4,LINECLR CLEAR NECESSARY PART OF LINE 03695000
- SSM DISABLE DISABLE INTERRUPTS @VA05354 03696000
- LA R1,IOLIST POINT TO PARAMETER LIST, @VM03083 03697000
- L R15,ARDBUF CALL 'RDBUF' @VM03083 03698000
- BALR R14,R15 (VIA BALR FOR SPEED) @VM03083 03699000
- SSM FE ENABLE INTERRUPTS @VA05354 03700000
- BNZ GETFIN BRANCH IF ERROR (E.G. EOF) @VM03083 03701000
- LA 1,LINE PARM FOR XWRITE 03702000
- BAL 14,XWRITE INSERT THE LINE 03703000
- BH GETFOFL BRANCH IF NO MORE ROOM 03704000
- BL GETCLOS BRANCH IF CORE OVERFLOW (NB: R4 IS LOST) 03705000
- L 0,SPARES LOAD NO. OF SPARES LEFT 03706000
- STH 2,IOLIST+26 ENSURE WE'RE SET FOR SEQUENTIAL 03707000
- BCT 3,GETFLOOP AND READ NEXT LINE 03708000
- GETVER VERIFY @VA03087 03709000
- SPACE 03710000
- GETCLOS EQU * CLOSE THE FILE 03711000
- SSM DISABLE DISABLE INTERRUPTS @VA05354 03712000
- LA R1,IOLIST POINT TO PARAMETER LIST, @VM03083 03713000
- L R15,AFINIS CALL 'FINIS' @VM03083 03714000
- BALR R14,R15 (VIA BALR FOR SPEED) @VM03083 03715000
- SSM FE ENABLE INTERRUPTS @VA05354 03716000
- DMSKEY RESET RESTORE USER KEY AFTER BALR CALLS@VM03083 03717000
- TM SIGNAL,AUTOSVFL ARE WE AUTOSAVING? @V200706 03718000
- BZ NEXT IF NOT, GET NEXT COMMAND @V200706 03719000
- NI SIGNAL,255-AUTOSVFL IF SO, RESTORE AUTO FLAGS @V200706 03720000
- OI SIGNAL,AUTOFLAG @V200706 03721000
- LA 14,NEXT SETUP RETURN ADDRESS @V200706 03722000
- B AUTOCHEK AND PERFORM AN AUTOSAVE @V200706 03723000
- SPACE 03724000
- GETFIN EQU * ERROR FROM RDBUF 03725000
- CH 15,=H'12' EOF? 03726000
- BNE GETFERR BRANCH IF NOT (BAD NEWS) 03727000
- VTYPE REACHEOF TYPE MESSAGE IF IN VER MODE 03728000
- B GETVER @VA03087 03729000
- SPACE 03730000
- GETFERR EQU * BAD ERROR 03731000
- WTYPE GETFERRM TYPE MESSAGE 03732000
- B GETCLOS CLOSE FILE 03733000
- SPACE 03734000
- GETFOFL EQU * CORE OVERFLOW 03735000
- WTYPE GETFOFMS TYPE MESSAGE 03736000
- B GETCLOS CLOSE FILE 03737000
- SPACE 03738000
- NOGETF EQU * FILE NOT FOUND 03739000
- WTYPE FILNTFND,,RETURN=INVREQX @V200713 03740000
- SPACE 03741000
- BADGETF EQU * EXCESSIVE ITEM LENGTH 03742000
- WTYPE BADGETIT,,RETURN=INVREQX @V200713 03743000
- SPACE 03744000
- BADGETF1 EQU * NOT ENOUGH LINES 03745000
- WTYPE GETFSHT,,RETURN=INVREQX @V200713 03746000
- SPACE 2 03747000
- REACHEOF DC C'EOF REACHED' 03748000
- GETFERRM DC C'READ ERROR - GETFILE IS INCOMPLETE' 03749000
- GETFOFMS DC C'GETFILE IS INCOMPLETE' 03750000
- FILNTFND DC C'FILE NOT FOUND' 03751000
- BADGETIT DC C'RECORD LENGTH OF FILE TOO LARGE' 03752000
- GETFSHT DC C'GIVEN STARTING LINE IS BEYOND EOF' 03753000
- EJECT 03754000
- *********************************************************************** 03755000
- * 03756000
- * 'MODECHK' VALIDATES THE FILEMODE IN 'CMODE' PROVIDED BY THE 03757000
- * CALLING ROUTINE. 03758000
- * MODECHK SETS THE CONDITION CODE BEFORE RETURNING VIA R14. ANY 03759000
- * ERROR DETECTED BY MODECHK WILL RESULT IN A NON-ZERO CONDITION 03760000
- * CODE. 03761000
- * 03762000
- *********************************************************************** 03763000
- MODECHK DS 0H 03764000
- CLI CMODE,C'G' 03765000
- BE CONT1 O.K. IF = 'G' 03766000
- BL TESTA CHECK IF A - F 03767000
- CLI CMODE,C'Y' 03768000
- BE CONT1 03769000
- CLI CMODE,C'Z' 03770000
- BE CONT1 03771000
- CLI CMODE,C'S' 03772000
- BE CONT1 03773000
- BCR 15,14 RETURN WITH ERROR CC 03774000
- TESTA CLI CMODE,C'A' MODE LETTER < A 03775000
- BNL CONT1 IF NOT, CONTINUE 03776000
- CLI CMODE,C'*' IF SO, BETTER BE STAR... 03777000
- BCR 7,14 ERROR RETURN IF NOT 03778000
- CLI CMODE+1,C' ' BETTER HAVE BLANK NEXT.. 03779000
- BCR 7,14 ERROR IF NOT 03780000
- B CONT2 CONTINUE 03781000
- CONT1 CLI CMODE+1,C'5' MODE NUMBER GT '5' 03782000
- BCR 2,14 IF SO, ERROR RETURN 03783000
- CLI CMODE+1,C'0' NUMBER LESS THAN ZERO? @V200713 03784000
- BNL CONT2 IF NOT, SHE'S IN THE RANGE... 03785000
- CLI CMODE+1,C' ' IF SO, COULD BE BLANK 03786000
- BCR 7,14 ERROR IF NOT BLANK 03787000
- MVC CMODE+1(1),FMODE+1 DEFAULT TO OLD MODE NUMBER @VA05071 03788000
- CONT2 CLI CMODE+2,C' ' ANYTHING AFTER MODE NUMBER ? 03789000
- BCR 7,14 IF SO, ERROR RETURN 03790000
- SR 15,15 OTHERWISE, 15 = 0 03791000
- LTR 15,15 CC = 0 03792000
- BR 14 NORMAL RETURN... 03793000
- EJECT 03794000
- *********************************************************************** 03795000
- * 03796000
- * 'SAVE' AND 'FILE' WRITE OUT THE CONTENTS OF THE EDITOR, 03797000
- * REPLACING THE EXISTING FILE (IF ANY). 03798000
- * 03799000
- *********************************************************************** 03800000
- SPACE 03801000
- SAVE DS 0H 03802000
- OI SIGNAL,SVFL SET SAVE FLAG 03803000
- B FILEA 03804000
- SPACE 03805000
- FILE EQU * 03806000
- NI SIGNAL,255-SVFL SET SAVE FLAG OFF 03807000
- NI SIGNAL,255-AUTOSVFL SET ALL SAVE FLAGS OFF @VA02449 03808000
- SPACE 03809000
- FILEA EQU * 03810000
- CMS ALTLIST,PROG=ERASE,ERROR=IGNORE 03811000
- MVC NEWNAME(18),FNAME INITIALIZE TO OLD NAME,TYPE AND MODE 03812000
- OI SIGNAL,GETCAT SET GETCAT FLAG (CONCATENATE EDIT TOKS) 03824000
- BAL 14,GET LOOK FOR FILE NAME 03825000
- BZ FILE1 03826000
- CLI XXXCWD,C'*' NO STARS ALLOWED P3123 03827000
- BE INVREQ P3123 03828000
- CLI XXXCWD,C'=' NO EQUALS ALLOWED @VM08629 03829000
- BE INVREQ @VM08629 03830000
- MVC NEWNAME(8),XXXCWD MOVE IN GIVEN NAME 03831000
- OI SIGNAL,GETCAT 03832000
- BAL 14,GET GET NEXT PARM 03833000
- BZ FILE1 CONTINUE IF NOTHING THERE 03834000
- CLI XXXCWD,C'*' NO STARS ALLOWED P3123 03835000
- BE INVREQ P3123 03836000
- CLI XXXCWD,C'=' NO EQUALS ALLOWED @VM08629 03837000
- BE INVREQ @VM08629 03838000
- MVC NEWTYPE(8),XXXCWD IT'S GOOD ENOUGH 03839000
- OI SIGNAL,GETCAT NOW LET'S TRY THE MODE, IF GIVEN 03840000
- BAL 14,GET GET THE PARM 03841000
- BZ FILE1 CONTINUE IF NOTHING THERE 03842000
- MVC CMODE(3),XXXCWD PROVIDE MODE TO CHECKER... 03843000
- BAL 14,MODECHK AND GO TO HIM 03844000
- BNZ MODERR INVALID MODE 03845000
- CLI XXXCWD,C'*' IS IT STAR? 03846000
- BE INVREQ SORRY, THAT'S A NO-NO TOO. 03847000
- MVC NEWMODE(2),CMODE IT'S GOOD 03848000
- BAL 14,PARMCHK CHECK NO MORE PARMS 03849000
- SPACE 03850000
- FILE1 EQU * 03851000
- TM FLAG,RIGHT+SERSW LINEMODE RIGHT? 03852000
- BNO FILE2A SKIP IF NOT 03853000
- VTYPE SERPRESS TELL NOW - SUPRESS LATER 03854000
- FILE2A EQU * 03855000
- DMSKEY NUCLEUS NEED NUCLEUS KEY FOR BALR CALLS @VM03083 03856000
- LA R1,IOLIST POINT TO PARAMETER LIST @VA08977 03856050
- SSM DISABLE DISABLE INTERRUPTS @VA08977 03856100
- MVC IOID(IDL18),NEWNAME MOVE IN NEW FILEID @VA08977 03856150
- L R15,ASTATE STATE FUNCTION WILL @VA08977 03856200
- BALR R14,R15 VALIDATE FILEID @VA08977 03856250
- SSM FE ENABLE INTERRUPTS @VA08977 03856300
- CLM R15,BIN0001,INVCHAR RETURN CODE 20? @VA08977 03856350
- BE ALTERR YES,INVALID ID @VA08977 03856400
- L 2,PTR1 LOAD TOP PTR 03857000
- LTR 2,2 IS FILE NULL ? 03858000
- BZ NULLFILE YES, TELL USER 03859000
- SR 0,0 PUT ZERO HERE 03860000
- MVC EDCT(2),COUNT TO FOOL 'INPUT' (IF SAVE REQ.) 03861000
- MVC IOLIST+8(16),ALTLIST+8 SET WORK-FILE NAME,TYPE 03862000
- MVC IOLIST+24(2),NEWMODE 03863000
- STH 0,IOLIST+26 ENSURE WE'RE SET FOR SEQUENTIAL 03864000
- MVC IOLIST+32(4),ITEM SET UP ITEM LENGTH IN PARM 03865000
- MVC IOLIST+36(1),FV SET FV BYTE 03866000
- ST 0,CARDNO INITIALIZE SEQUENCE NO. 03867000
- MVC SERSAV(8),72+8(R2) SAVE COLS 73-80 FOR ERROR @VA04190 03868000
- SPACE 03869000
- FILE3 EQU * 03870000
- LA 1,8(,2) POINT TO DATA AREA ON RECORD 03871000
- ST 1,IOLIST+28 STORE IN PARM LIST 03872000
- TM FLAG,SERSW IS SERIALIZATION REQUIRED 03873000
- BZ FILE5 NO, SKIP THIS JAZZ 03874000
- TM FLAG,RIGHT LINEMODE RIGHT? 03875000
- BO FILE7 YES, SKIP SERIAL'N. 03876000
- TM FLAG,SERNAME SERIALIZATION WITH NAME? 03877000
- BZ FILE4A BRANCH IF NOT 03878000
- CLI SEQNAME,C' ' CHECK FOR ALPHA SUPPLIED 03879000
- BNE FILE4 BRANCH IF THEY ARE 03880000
- MVC 72(3,1),NEWNAME USE CURRENT FILENAME 03881000
- B FILE4A 03882000
- FILE4 EQU * 03883000
- MVC 72(3,1),SEQNAME MOVE IN ALPHA SEQUENCE 03884000
- SPACE 03885000
- FILE4A EQU * 03886000
- L 0,CARDNO CARD NUMBER 03887000
- A 0,CARDINCR INCREMENT IT 03888000
- ST 0,CARDNO UPDATE COUNT 03889000
- CVD 0,DECIMAL CONVERT TO PACKED 03890000
- TM FLAG,SERNAME SERIALIZATION WITH NAME? 03891000
- BO FILE4C BRANCH IF SO 03892000
- UNPK 72(8,1),DECIMAL(8) 8 DIGIT SERIALIZATION 03893000
- B FILE4D 03894000
- FILE4C EQU * 03895000
- UNPK 75(5,1),DECIMAL(8) 5 DIGIT SERIALIZATION 03896000
- FILE4D EQU * 03897000
- OI 79(1),C'0' CORRECT LOUSY SIGN 03898000
- SPACE 03899000
- FILE5 EQU * 03900000
- CLI FV,C'V' V FORMAT FILE? 03901000
- BNE FILE7 BRANCH IF NOT 03902000
- CLC FTYPE,=CL8'VSBDATA' VSBASIC DATA CAN SPAN RCDS @VA04596 03903000
- BE FILE7 TRAILING BLANKS MAY BE DATA @VA04596 03904000
- LR 0,1 03905000
- AH 1,ITEM+2 DELETE ALL TRAILING BLANKS 03906000
- BCTR 1,0 POINT TO LAST BYTE 03907000
- SPACE 03908000
- FILE5A EQU * 03909000
- CLI 0(1),C' ' 03910000
- BNE FILE8 IF NOT BLANK, SEARCH IS OVER 03911000
- BCT 1,FILE5A LOOK AGAIN 03912000
- SPACE 03913000
- FILE8 EQU * 03914000
- SR 1,0 03915000
- BNM FILE8A 03916000
- SR 1,1 03917000
- FILE8A EQU * 03918000
- LA 1,1(,1) CORRECT LENGTH 03919000
- ST 1,IOLIST+32 STORE IT IN PARAMETER LIST 03920000
- SPACE 03921000
- FILE7 EQU * 03922000
- SSM DISABLE DISABLE INTERRUPTS @VA05354 03923000
- LA R1,IOLIST POINT TO PARAMETER LIST, @VM03083 03924000
- L R15,AWRBUF CALL 'WRBUF' @VM03083 03925000
- BALR R14,R15 (VIA BALR FOR SPEED) @VM03083 03926000
- SSM FE ENABLE INTERRUPTS @VA05354 03927000
- BNZ FILERR BRANCH IF ERROR WRITING FILE @VM03083 03928000
- L 2,0(,2) LOAD NEXT RECORD ADDRESS 03929000
- LTR 2,2 ARE WE AT EOF 03930000
- BNZ FILE3 NO, OUTPUT NEXT RECORD 03931000
- BAL 4,UPDLINE UPDATE 'LINE' IF NECESSARY 03932000
- SPACE 03933000
- FILCLOS EQU * COME HERE FROM 'NULLFILE' V0263 03934000
- SSM DISABLE DISABLE INTERRUPTS @VA05354 03935000
- LA R1,IOLIST CLOSE TEMP FILE @VM03083 03936000
- L R15,AFINIS CALL 'FINIS' @VM03083 03937000
- BALR R14,R15 (VIA BALR FOR SPEED) @VM03083 03938000
- SPACE 03939000
- MVC IOLIST+8(8),NEWNAME MOVE IN NEW FILENAME 03940000
- MVC IOLIST+16(8),NEWTYPE AND THE FILETYPE 03941000
- TM TWITCH,NULL NULL FILE ? @VM08785 03942000
- BNO ERASCLOS NO..BR @VM08785 03943000
- MVC IOMODE(2),NEWMODE YES..INCLUDE FM @VM08785 03944000
- ERASCLOS EQU * @VM08785 03945000
- LA R1,IOLIST ERASE OLD FILE (IF ANY), @VM03083 03946000
- L R15,AERASE CALL 'ERASE' @VM03083 03947000
- BALR R14,R15 (VIA BALR FOR SPEED) @VM03083 03948000
- DMSKEY RESET RESTORE USER KEY AFTER BALR CALLS@VM03083 03950000
- SPACE 03951000
- TM TWITCH,NULL NULL FILE? V0263 03952000
- BZ FILREN NO, RENAME AS USUAL V0263 03953000
- STCM R15,1,CMODE GET LAST BYTE OF RETURN CODE @VA04190 03954000
- TM CMODE,X'0C' CHECK FOR FILEMODE ERRORS @VA04190 03955000
- BNM FILEND NO ... SKIP RENAME @VA04190 03956000
- SSM FE ENABLE INTERRUPTS @VA07669 03956100
- NI TWITCH,255-NULL TURN OFF NULL FLAG @VA04190 03957000
- B MODERR AND GO TYPE ERROR MSG @VA04190 03958000
- FILREN EQU * V0263 03959000
- MVC ALTLIST+32(16),IOLIST+8 SET UP RENAME LIST 03960000
- MVC ALTLIST+24(2),NEWMODE 03961000
- MVC ALTLIST+48(2),NEWMODE 03962000
- CMS ALTLIST,PROG=RENAME,ERROR=ALTERR RENAME WORK @VA00984 03963000
- TM FLAG,SERSW SERIALIZATION DONE? @VA04190 03964000
- BNO FILEND NO ... BR @VA04190 03965000
- TM FLAG,RIGHT LINEMODE RIGHT? @VA04190 03966000
- BO FILEND YES ... BR @VA04190 03967000
- CLC VERCOL2(2),=H'80' VERIFY TO 80? @VA04190 03968000
- BL FILEND NO ... BR @VA04190 03969000
- MVI SCRFLGS,WRTOPB FORCE FULL DISPLAY REWRITE @VA04190 03970000
- SPACE 03971000
- FILEND EQU * 03972000
- SSM FE ENABLE INTERRUPTS @VA07669 03972100
- TM SIGNAL,SVFL+AUTOSVFL ANY SAVE BEING DONE? @V200706 03973000
- BZ EDEXIT1 NO, MUST BE 'FILE' @V200706 03974000
- LA 2,PEDIT LOAD RETURN ADDRESS @VA04190 03975000
- TM SIGNAL,AUTOSVFL+AUTOFLAG ANY 'AUTO' ACTIVE? @V200706 03976000
- BZ CKNULL NO, 'SAVE' W/O AUTO @VA04190 03977000
- BNO ZERAUTO 'SAVE' WITH AUTO ACTIVE @VA04190 03978000
- LA 2,SAVRET WE'VE COME A LONG WAY, BABY @V200706 03979000
- NI SIGNAL,255-AUTOSVFL MUST BE AUTO SAVE @V200706 03980000
- ZERAUTO EQU * CLEAR THE CURRENT LINE COUNT@V200706 03981000
- XR 1,1 @V200706 03982000
- STH 1,AUTOCURR @V200706 03983000
- VTYPE AUTOMSG TELL USER IT'S SAVED @V200706 03984000
- MVI SCRFLGS,WRTOPB FORCE FULL DISPLAY REWRITE @V2D3913 03985000
- SPACE 03986000
- CKNULL EQU * @VA04190 03987000
- TM TWITCH,NULL CK FOR NULL FILE @VA04190 03988000
- BZR R2 NO ... RETURN @VA04190 03989000
- WTYPE NULLMES TELL USER FILE EMPTY @VA04190 03990000
- NI TWITCH,255-NULL TURN OFF NULL FLAG @VA04190 03991000
- TM FLAG2,TUBE DISPLAY TERMINAL? @VA04190 03992000
- BO PEDIT1 YES ... GET NEXT REQUEST @VA04190 03993000
- BR R2 NO ... GO TYPE 'EDIT' @VA04190 03994000
- SPACE 03995000
- NULLFILE EQU * FILE IS EMPTY 03996000
- OI TWITCH,NULL SIGNAL NULL FILE V0263 03997000
- B FILCLOS MAKE SURE OLD FILE IS ERASED V0263 03998000
- SPACE 03999000
- FILERR EQU * ERROR FROM WRBUF 04000000
- TM FLAG,SERSW HAVE WE BEEN SERIALIZING? 04001000
- BZ *+10 SKIP IF NOT 04002000
- MVC 8+72(8,2),SERSAV RESTORE COLS 73-80 04003000
- BAL 4,UPDLINE UPDATE 'LINE' IF NECESSARY 04004000
- CH 15,=H'13' IS IT ERROR 13 (DISK FULL)? 04005000
- BE DISKFUL BRANCH IF SO 04006000
- LR R14,R15 IF NOT 13, REMEMBER ERROR CODE, @VM03083 04007000
- DMSKEY RESET RESTORE USER KEY AFTER BALR CALLS@VM03083 04008000
- C 2,PTR1 FIRST LINE? 04009000
- BNE ERR105S BRANCH IF NOT (FATAL ERROR) 04010000
- CH R14,=H'10' TOO MANY FILES ? @VM03083 04011000
- BE DISKFUL1 BRANCH IF SO 04012000
- MODERR BAL 4,KTCLR CLEAR THE 'KT' FLAG 04013000
- MVC FILEMS+12(4),=CL4'MODE' PATCH THE MESSAGE 04014000
- WTYPE FILEMS,26 TYPE SOME GOOD ADVICE @V305614 04015000
- B SVFLERR 04016000
- SPACE 04017000
- DISKFUL EQU * 04018000
- SSM DISABLE DISABLE INTERRUPTS @VA05354 04019000
- LA R1,IOLIST ERASE WORK-FILE, @VM03083 04020000
- L R15,AERASE CALL 'ERASE' @VM03083 04021000
- BALR R14,R15 (VIA BALR FOR SPEED) @VM03083 04022000
- SSM FE ENABLE INTERRUPTS @VA05354 04023000
- DMSKEY RESET RESTORE USER KEY AFTER BALR CALLS@VM03083 04024000
- OI SCRFLGS,WRMSGB REWRITE MESSAGE LINE @V2D3913 04025000
- TM FLAG,SERSW ARE WE DOING SERIALIZATION? 04026000
- BZ DISKFUL1 BRANCH IF NOT 04027000
- WTYPE SERMS TYPE A WARNING 04028000
- OI SCRFLG2,MOREB MAKE SURE ALL DISPLAYED @VM08703 04029000
- DISKFUL1 EQU * 04030000
- BAL 4,KTCLR CLEAR THE 'KT' FLAG 04031000
- WTYPE DISKMS TYPE SOME GOOD ADVICE 04032000
- B SVFLERR 04033000
- SPACE 04034000
- ALTERR EQU * ERROR FROM RENAME 04035000
- SSM FE ENABLE INTERRUPTS @VA07669 04035100
- DMSKEY RESET RESET KEY @VA08977
- BAL 4,KTCLR CLEAR THE 'KT' FLAG 04036000
- MVC FILEMS+12(4),=CL4'NAME' PATCH THE MESSAGE 04037000
- WTYPE FILEMS,26 SOME ADVICE (MAY NOT BE GOOD) @V305614 04038000
- SPACE 04039000
- SVFLERR EQU * ERROR RETURN FROM SAVE AND FILE 04040000
- NI SIGNAL,255-AUTOSVFL INCASE 'AUTO' ACTIVE @V200706 04041000
- OI SCRFLG2,MOREB MAKES SURE SEES ERROR MSG @VA04190 04042000
- OI SCRFLGS,WRTOPB ALONG WITH SCREEN @VA04190 04043000
- BAL 4,STACKCLR CLEAR THE STACK, SINCE HE EXPECTED TO GO 04044000
- NI SCRFLG2,255-MOREB TURN OFF MORE FLAG @VA04190 04045000
- TM FLAG2,TUBE GRAPHICS? @VA03883 04046000
- BNO MPEDIT NO ... GO TYPE 'EDIT' @VA04190 04047000
- TM FLAG2,INMODE INPUT MODE? @VA04190 04048000
- BO TLERR YES ... GO CHG STATUS TO 'EDIT' @VA04190 04049000
- B NEXT ELSE, GET ANOTHER REQUEST @VA04190 04050000
- SPACE 1 04051000
- FE DC X'FE' @VM03120 04052000
- DISABLE DC X'00' DISABLE ALL CHANNELS @VA06347 04053000
- INVCHAR DC X'14' RETURN CODE 20 @VA06347 04054000
- IDL18 EQU 18 FILEID LENGTH = 18 BYTES @VA06347 04055000
- EJECT 04056000
- * 04057000
- ************** 04058000
- * 04059000
- * SUBROUTINE TO UPDATE 'LINE' IF NECESSARY AFTER SERIALIZING. 04060000
- * CALLED ONLY FROM 'FILE' (AND 'SAVE'), THUS: BAL 4,UPDLINE. 04061000
- * USES R1. 04062000
- * 04063000
- ************** 04064000
- SPACE 04065000
- UPDLINE DS 0H 04066000
- TM FLAG,SERSW HAVE WE BEEN SERIALIZING? 04067000
- BCR 8,4 RETURN PRONTO IF NOT 04068000
- TM TWITCH,TOPSW ARE WE AT THE TOP OF THE FILE? 04069000
- BCR 1,4 RETURN IF SO 04070000
- L 1,PTR2 A(CURRENT LINE) 04071000
- MVC LINE+72(8),8+72(1) UPDATE COLS 73-80 OF 'LINE' 04072000
- BR 4 RETURN 04073000
- SPACE 04074000
- * 04075000
- ************** 04076000
- * 04077000
- * DATA FOR 'FILE' AND 'SAVE'... 04078000
- * 04079000
- ************** 04080000
- SPACE 04081000
- NULLMES DC C'FILE IS EMPTY' 04082000
- AUTOMSG DC C'_SAVED' @V200706 04083000
- SPACE 04084000
- SERPRESS DC C'RESERIALIZATION SUPRESSED' 04085000
- SERMS DC C'SERIALIZATION IS INCOMPLETE' 04086000
- DISKMS DC C'SET NEW FILEMODE, OR ENTER CMS SUBSET AND CLEAR SOME SPACE' 04087000
- EJECT 04088000
- *********************************************************************** 04089000
- * 04090000
- * TERMINAL ERRORS ... 04091000
- * 04092000
- *********************************************************************** 04093000
- SPACE 04094000
- DS 0H 04095000
- SPACE 04096000
- ERR105S LR R2,R14 PUT WRBUF ERROR RETURN IN R2, @VM03083 04097000
- DMSERR NUM=105,LET=S,SUB=(DEC,(2),CHAR8A,IOID),TEXT='ERROR ''.*04098000
- ..'' WRITING FILE ''....................'' ON DISK', *04099000
- MF=(E,'SYS') @V305614 04100000
- IOERR LA R2,100 RETURN CODE = 100 @VM08823 04101000
- CMS IOLIST,PROG=FINIS,ERROR=IGNORE 04102000
- B EDEXIT2 GO 'FREEMAIN' IF NEEDED, THEN EXIT. JS 04103000
- EJECT 04104000
- *********************************************************************** 04105000
- * 04106000
- * 'CORFULL' AND 'CORBUST' ARE ERROR MESSAGE ROUTINES WHICH 04107000
- * ARE BRANCHED TO FROM 'XWRITE' WHEN THE AVAILABLE CORE 04108000
- * IS FULL. THEY ARE PUT HERE (RATHER THAN WITH 'XWRITE') 04109000
- * SO THAT THEY DO NOT OCCUPY ROOM IN THE FIRST PAGE. THEY 04110000
- * RETURN TO 'XWRITE'. 04111000
- * 04112000
- *********************************************************************** 04113000
- SPACE 04114000
- CORFULL DS 0H THIS WAS THE LAST LINE WE CAN FIT IN CORE 04115000
- WTYPE CORFLMS WARN HIM THAT IT'S FULL 04116000
- LA 15,1 ERROR CODE 1 04117000
- LTR 15,15 AND SET CONDITION CODE 04118000
- B XWRITEX RETURN TO 'XWRITE' 04119000
- SPACE 04120000
- CORBUST EQU * ATTEMPT TO WRITE AFTER CORE FULL WARNING 04121000
- BAL 4,KTCLR CLEAR THE 'KT' FLAG, IF SET 04122000
- BAL 4,STACKCLR CLEAR STACK @VA04190 04123000
- WTYPE NOROOM TELL HIM NO ROOM @VA04190 04124000
- SR 15,15 04125000
- BCTR 15,0 SET ERROR CODE -VE 04126000
- LTR 15,15 SET CONDITION CODE 04127000
- B XWRITEX RETURN TO 'XWRITE' 04128000
- SPACE 2 04129000
- CORFLMS DC C'AVAILABLE STORAGE IS NOW FULL' 04130000
- NOROOM DC C'NO ROOM' 04131000
- EJECT 04132000
- *********************************************************************** 04133000
- * 04134000
- * TIDY UP AND RETURN TO CALLER 04135000
- * 04136000
- *********************************************************************** 04137000
- SPACE 04138000
- EDEXIT1 DS 0H 04139000
- SPACE 04140000
- EDEXIT2 EQU * 04141000
- SPACE 04142000
- LTR 2,2 WHAT IS IT? 04143000
- BZ *+8 SKIP IF ZERO 04144000
- EDEXIT4 BAL 4,STACKCLR CLEAR STACKED READS 04145000
- LTR R15,R2 PUT RETURN CODE IN R15 @VM08823 04146000
- BNZ EXREST GET OUT @V2D3914 04147000
- SPACE 1 04148000
- TM FLAG2,TUBE DISPLAY TERMINAL ? @VM01040 04149000
- BZ EXREST NO...BR @V2D3914 04150000
- MVI SCRFLG2,CANCB CAUSE TUBE CANCEL OP @V200714 04151000
- BAL R14,WRTYPEX @V2D3913 04152000
- EXREST L 14,EDRET RESTORE RETURN ADDRESS @V200714 04153000
- SR R4,R4 R4=0 MEANS DOSFLAGS IS OK @VM03083 04154000
- TM DOSFLAGS,DOSSVC INTERNAL SVC-BIT SET ? @VM03083 04155000
- BZ DOSFOK1 IF 0 WE'RE OK @VM03083 04156000
- IC R4,DOSFLAGS IF NOT 0, REMEMBER DOSFLAGS, @VM03083 04157000
- DMSEXS NI,DOSFLAGS,255-DOSSVC AND RESET FLAGBIT @VM03083 04158000
- DOSFOK1 LM R0,R1,FREELEN GET FREE STORAGE POINTERS @VM03083 04159000
- FREEMAIN R,LV=(0),A=(1) RETURN THE USER STORAGE @VM03083 04160000
- LTR R4,R4 WAS DOSFLAGS OK BEFORE ? @VM03083 04161000
- BZ DOSFOK2 IF YES WE'RE OK @VM03083 04162000
- DMSEXS STC,R4,DOSFLAGS IF NOT, RESTORE IT AS IT WAS @VM03083 04163000
- DOSFOK2 DMSKEY RESET TURN OFF USER KEY, @VM03083 04164000
- DMSEXS OI,MISFLAGS,RELPAGES SET RELPAGE SW ON @VA05711 04165000
- LTR R15,R2 MAKE SURE RETURN-CODE IN R15, @VM03083 04166000
- BR 14 RETURN. 04167000
- EJECT 04168000
- *********************************************************************** 04169000
- * 04170000
- * RENUM SUBCOMMAND ALLOWS USER TO RENUMBER HIS VSBASIC 04171000
- * PROGRAM, CORRELATING ALL LINE NUMBER REFERENCES TO 04172000
- * THE NEW LINE NUMBERS PRODUCED FROM THE STRTNO AND 04173000
- * INCRNO PARAMETERS. 04174000
- * FREEFORT FILES ARE RENUMBERED IN COLS 1 THROUGH 8 04175000
- * USING THE STRTNO AND INCRNO PARAMETERS TO CREATE 04176000
- * THE NEW LINE NUMBERS. 04177000
- * 04178000
- *********************************************************************** 04179000
- SPACE 04180000
- RENUM DS 0H @V242801 04181000
- LA R14,10 GET DEFAULT VALUE @V242801 04182000
- ST R14,STRTNO SAVE AS STARTING NO. @V242801 04183000
- ST R14,INCRNO SAVE AS INCREMENT VALUE @V242801 04184000
- BAL R14,NUM GET FIRST PARAM @V242801 04185000
- B INVREQ INVALID REQUEST EXIT @V242801 04186000
- BM RENUM2 NONE SPECIFIED..USE DEFAULTS @V242801 04187000
- BZ INVREQ ZERO NOT ALLOWED @V2D3914 04188000
- ST R0,STRTNO SAVE AS STARTING NUMBER @V242801 04189000
- ST R0,INCRNO AND AS INCREMENT ALSO @V242801 04190000
- BAL R14,NUM CHECK INCREMENT @V242801 04191000
- B INVREQ INVALID REQUEST EXIT @V242801 04192000
- BM RENUM2 LOOKS LIKE NO INCREMENT @V242801 04193000
- BZ INVREQ ZERO NOT ALLOWED @V2D3914 04194000
- ST R0,INCRNO SAVE AS INCREMENT VALUE @V242801 04195000
- BAL R14,PARMCHK NO MORE ALLOWED @V242801 04196000
- RENUM2 L R14,PTR1 GET TOP OF FILE @V242801 04197000
- ST R14,AINCORE SAVE AS INCORE ADDRESS @V242801 04198000
- L R14,ITEM GET RECORD LENGTH @V242801 04199000
- ST R14,FSIZE SAVE AS ITEM LENGTH @V242801 04200000
- MVC RPLIST(12),FTYPE SET UP RENUM FILEID @V242801 04201000
- LA R1,RPLIST-8 GET RENUM PLIST @V242801 04202000
- SVC 202 CALL RENUM @V242801 04203000
- DC AL4(RENUME) ERROR RETURN @V242801 04204000
- B REFRESH @V2D3913 04205000
- EJECT 04206000
- RENUME CH R15,=H'-3' IS IT NOT FOUND ERROR ? @V242801 04207000
- BNE RENUM4 NO, CHECK FOR I/O ERROR @V242801 04208000
- WTYPE NORNE,,RETURN=NEXT @V242801 04209000
- RENUM4 CH R15,=H'100' IS IT I/O ERROR ? @V242801 04210000
- BE EDEXIT2 YES, FREEMAIN AND GET OUT @V242801 04211000
- CH R15,=H'13' IS IT DISK FULL ? @V242801 04212000
- BE DISKFUL1 YES, GO TYPE MSG @V242801 04213000
- LM R0,R1,0(R15) GET MSG LEN AND ADDR @V242801 04214000
- LA R14,NEXT GET RETURN ADDRESS @V242801 04215000
- B WRTYPE GO TYPE MSG @V242801 04216000
- NORNE DC C'RENUM MODULE NOT FOUND' @V242801 04217000
- EJECT 04218000
- ******************************************************** 04219000
- * 04220000
- * SCROLL SUBCOMMAND ALLOWS USER TO MOVE THE CURRENT 04221000
- * LINE POINTER IN EITHER DIRECTION BY ENOUGH TO FILL A 04222000
- * NEW DISPLAY PAGE. 04223000
- * 04224000
- ****************************************************** 04225000
- SPACE 1 04226000
- SCROLL EQU * @V200714 04227000
- TM FLAG2,TUBE IN DISPLAY MODE ? @V2D3914 04228000
- BNO INVREQ IF NOT, AN INVALID COMMAND @V2D3914 04229000
- MVI SCRFLGS,WRTOPB WRITE FULL SCREEN @V2D3914 04230000
- LA R5,10 GUESS NUMBER OF LINES @V2D3913 04231000
- LA R3,80 DO WE NEED MORE THAN ONE @V200714 04232000
- CH R3,VERLEN DISPLAY LINE PER RECORD @V2D3914 04233000
- BNL SNGL NO..BR @V200714 04234000
- SR R5,R5 REDUCE THE COUNT OF LINES @V2D3913 04235000
- SNGL LA R5,10(,R5) ADD 10 TO THE LINE COUNT @V2D3913 04236000
- BAL R14,NUM DID WE GET A NUMBER ? @V200714 04237000
- BAL R14,STARCHK LOOK FOR ASTERISK @V2D3913 04238000
- LTR R3,R0 SAVE NUMBER SPECIFIED @V200714 04239000
- BZ NEXT IF ZERO..DO NOTHING @V200714 04240000
- BAL R14,PARMCHK NO MORE ARGS ALLOWED @V200714 04241000
- BAL R14,EORCHK CHECK THE RANGE @V2D3913 04242000
- B ENDRANGE OBVIOUSLY DONE, IN THIS CASE. @V2D3913 04243000
- B FWD1 DONT CAUSE MORE STATUS ON 1ST SCR@V200714 04244000
- SCRFWD EQU * LOOP FOR FORWARD SCROLL @V200714 04245000
- MVI SCRFLG2,MOREB CAUSE MORE STATUS @V2D3913 04246000
- FWD1 LR R4,R5 REFRESH THE COUNT @V2D3913 04247000
- FLOOP BAL R14,XNEXT LOCATE THE LINE @V2D3913 04248000
- TM TWITCH,EOF+TOPSW IS IT ENDRANGE? @V2D3913 04249000
- BNZ ENDRG IF SO, WHY BOTHER. @V2D3914 04250000
- BCT R4,FLOOP ENOUGH TO REFILL BUFFER @V200714 04251000
- ENDRG BAL R14,WRTYPEX REWRITE DISPLAY @V2D3913 04252000
- NOWRT TM TWITCH,EOF+TOPSW ENDRANGE? @V2D3913 04253000
- BNZ NEXT ALL DONE. @V2D3913 04254000
- BCT R3,SCRFWD DO IT N TIMES @V200714 04255000
- B NEXT @V200714 04256000
- EJECT 04257000
- *********************************************************************** 04258000
- * 04259000
- * EQUS. 04260000
- * 04261000
- *********************************************************************** 04262000
- SPACE 04263000
- TAB EQU X'05' TAB CHARACTER 04264000
- BACKSPAC EQU X'16' BACKSPACE 04265000
- SPACE 04266000
- * BITS FOR FLAG ... 04267000
- * (DON'T ALTER THESE WITHOUT TELLING EDFILES ABOUT IT) 04268000
- SPACE 04269000
- CAN EQU X'01' CANONICALIZATION IS REQUIRED 04270000
- IMNOT EQU X'02' LINE IMAGE (OR CANONLZTN) SUPPRESSED 04271000
- SERSW EQU X'04' SERIALIZATION IS REQUIRED 04272000
- SERNAME EQU X'08' SERIALIZATION IS TO BE WITH 3-CHAR NAME 04273000
- LINE8 EQU X'10' LINENUMBERS ARE 8 DIGITS LONG @V1D1613 04274000
- ZEROPAD EQU X'20' LINENUMBERS ARE ZERO-FILLED @V1D1613 04275000
- LEFT EQU X'40' LINEMODE LEFT IF ON 04276000
- RIGHT EQU X'80' LINEMODE RIGHT IF ON 04277000
- SPACE 1 04278000
- * BITS FOR FLAG2... 04279000
- VER EQU X'01' VERIFY IS SET @V1D1613 04280000
- LONGSW EQU X'02' LONG IS SET @V1D1613 04281000
- TUBE EQU X'04' CONSOLE IS DISPLAY TYPE @V200714 04282000
- NUFILE EQU X'08' NEW FILE @V200714 04283000
- INMODE EQU X'10' INPUT MODE IN EFFECT @V200714 04284000
- REMOTE EQU X'20' REMOTE DISPLAY TERMINAL @V2D3914 04285000
- SWITCH EQU X'40' INPUT REMINDER TO RESET MODE @V2D3914 04286000
- NODISP EQU X'80' NODISPLAY OPTION IN EFFECT @V2D3914 04287000
- SPACE 1 04288000
- * BITS FOR TWITCH... 04289000
- SPACE 04290000
- TOPSW EQU X'01' WE ARE AT TOP OF FILE 04291000
- EOF EQU X'02' EOF CONDITION IS RAISED 04292000
- NULL EQU X'04' FILE IS EMPTY V0263 04293000
- UPWARD EQU X'08' @V2D3913 04294000
- VEROVER EQU X'10' @V2D3913 04295000
- TRUNC EQU X'20' TRUNCATION HAS OCCURRED 04296000
- SAVOVER EQU X'40' OVERRIDE AUTOSAVE @V2D3914 04297000
- * EQU X'80' 04298000
- SPACE 04299000
- * BITS FOR SCRFLGS ... 04300000
- SPACE 1 04301000
- WRCLUPB EQU X'02' WRITE FROM CL UP @V2D3913 04302000
- WRMSGB EQU X'10' WRITE DISPLAY MESSAGE AREA @V2D3913 04303000
- WRCLDNB EQU X'20' WRITE FROM CL DOWN @V200714 04304000
- WRCLB EQU X'40' WRITE CL ONLY @V200714 04305000
- WRSTATB EQU X'80' WRITE STATUS AREA @V2D3913 04306000
- WRFULLB EQU WRCLDNB+WRCLUPB WRITE ALL TEXT @V2D3913 04307000
- WRTOPB EQU WRSTATB+WRFULLB WRITE COMPLETE DISPLAY @V2D3913 04308000
- SPACE 1 04309000
- * BITS FOR SCRFLG2 ... 04310000
- SPACE 1 04311000
- MOREB EQU X'80' CAUSE MORE STATUS @V200714 04312000
- CANCB EQU X'40' CAUSE CANCEL OP @V200714 04313000
- WRCLINB EQU X'08' WRITE CL INTO INPUT AREA @V2D3913 04314000
- CMDINB EQU X'04' WRITE LAST COMMAND TO INPUT AREA @V2D3913 04315000
- SPACE 1 04316000
- * BITS FOR SIGNAL ... 04317000
- SPACE 04318000
- GETCAT EQU X'01' TELLS GET TO CONCATENATE TOKS UNTIL BLANK 04319000
- HEXSW EQU X'02' TELLS GET TO LOOK FOR HEXADECIMAL TOKEN 04320000
- QUOD EQU X'04' LAST REQUEST WAS ? OR " 04321000
- REPL EQU X'08' TRICKY REPLACE MODE (1ST LINE AFTER 'R') 04322000
- OVER EQU X'10' REQUEST IS 'OVERLAY' 04323000
- SVFL EQU X'20' REQUEST IS 'SAVE' 04324000
- AUTOFLAG EQU X'40' AUTO. SAVE ACTIVE @V200706 04325000
- AUTOSVFL EQU X'80' AUTO. SAVE BEING EXECUTED @V200706 04326000
- SPACE 04327000
- * BITS FOR GETFLAG ... 04328000
- SPACE 04329000
- ALPHA EQU X'01' TOKEN IS ALPHABETIC 04330000
- NONALNUM EQU X'02' TOKEN IS NON-ALPHANUMERIC 04331000
- SPACE 04332000
- * BITS FOR CHNGFLAG ... 04333000
- SPACE 04334000
- NULLSW1 EQU X'01' STRING1 IS NULL 04335000
- NULLSW2 EQU X'02' STRING2 IS NULL 04336000
- DTYPE EQU X'04' DISPLAY TYPE CHANGE BIT @VA03027 04337000
- GLOBSW EQU X'08' GLOBAL OPTION IS GIVEN 04338000
- * EQU X'10' 04339000
- CHNGSW EQU X'20' LINE HAS BEEN CHANGED 04340000
- FLDFND EQU X'40' MATCHING FIELD HAS BEEN FOUND 04341000
- * EQU X'80' 04342000
- SPACE 04343000
- * BITS FOR XYFLAG 04344000
- SPACE 04345000
- XACT EQU X'01' 'X' IS ACTIVE 04346000
- YACT EQU X'02' 'Y' IS ACTIVE 04347000
- SPACE 04347100
- * BITS FOR UTILFLAG ... 04347200
- SPACE 04347300
- CLGT80B EQU X'01' LENGTH > 80 BYTES @VA08152 04347400
- MSG EQU X'02' MESSAGE IN BUFFER @VA08152 04347500
- TWOLINES EQU X'04' LENGTH > 80 BYTES @VA08152 04347600
- LINSEQ EQU X'08' NO SPACE FOR LINEMODE INPUT @VA08152 04347700
- SPACE 2 04348000
- * MASKS FOR CLM INSTRUCTION 04349000
- BIN1000 EQU B'1000' @V305066 04350000
- BIN1100 EQU B'1100' @V305066 04351000
- BIN0001 EQU B'0001' MASK FOR BYTE 3 @VA06347 04352000
- BIN0100 EQU B'0100' @VA09296 04352100
- SPACE 04353000
- EDCB @V305614 04354000
- EJECT 04355000
- NUCON @V200714 04356000
- DEVTAB , @V305014 04357000
- REGEQU @V200714 04358000
- DMSEDI CSECT @V200714 04359000
- EJECT 04360000
- * 04361000
- LTORG 04362000
- SPACE 2 04363000
- END 04364000
ibm/vm370-lib/cms/dmsedi.assemble_src.txt · Last modified: 2023/08/06 13:35 by Site Administrator