EDX TITLE 'DMSEDX (CMS) VM/370 - RELEASE 6' 00001000 * FORCE 3270 REMOTE TERMINAL TO 2741 MODE OF OPERATION. 00002000 SPACE 2 00003000 *. 00004000 ***************************************************** 00005000 * 00006000 * MODULE NAME: 00007000 * 00008000 * DMSEDX 00009000 * 00010000 * FUNCTION: 00011000 * 00012000 * PERFORMS INITIALIZATION FOR THE CMS EDITOR. 00013000 * 00014000 * ATTRIBUTES: 00015000 * 00016000 * EXECUTES IN TRANSIENT AREA. REUSEABLE. 00017000 * 00018000 * ENTRY POINT: 00019000 * 00020000 * DMSEDX 00021000 * 00022000 * ENTRY CONDITIONS: 00023000 * 00024000 * GPR 1 CONTAINS THE ADDRESS OF THE EDIT COMMAND LINE. 00025000 * 00026000 * EXIT CONDITIONS: 00027000 * 00028000 * NORMAL .. GPR 15 = 0 00029000 * 00030000 * ERROR .. GPR 15 ¬= 0 00031000 * 00032000 * GPR 15 = 24 INCOMPLETE FILEID 00033000 * 24 INVALID OPTION 00034000 * 24 INVALID LRECL PARAMETER 00035000 * 24 INVALID DISK MODE 00036000 * 00037000 * 28 EDIT WORK FILE ''EDIT CMSUT1'' EXISTS. 00038000 * IF IT IS WANTED, RENAME THE FILENAME 00039000 * OR FILETYPE; OTHERWISE, ERASE IT. 00040000 * 00041000 * 32 RECORD LENGTH TOO LARGE FOR EDIT 00042000 * @VA12416 00042300 * 36 TARGET DISK NOT ACCESSED. @VA12416 00042600 * 00043000 * 88 FILE TOO LARGE FOR EDIT ..INSUFFICIENT 00044000 * STORAGE 00045000 * 00046000 * 88 REQUESTED FILE IN ACTIVE STATUS 00047000 * 00048000 * 100 I/O ERROR READING/WRITING FILE 00049000 * 00050000 * CALLS TO OTHER ROUTINES: 00051000 * 00052000 * DMSSTT,DMSERR,DMSEDF,DMSBRD,DMSFNS,DMSFREE,DMSFRET 00053000 * DMSKEY,DMSCWT 00054000 * 00055000 * EXTERNAL REFERENCES: 00056000 * 00057000 * AFINIS .. ADDRESS OF CMS FILE ''CLOSE'' ROUTINE 00058000 * IN CMS NUCLEUS 00059000 * 00060000 * ARDBUF .. ADDRESS OF DISK READ ROUTINE IN CMS 00061000 * NUCLEUS 00062000 * 00063000 * ASTATE .. ADDRESS OF STATE ROUTINE IN CMS NUCLEUS 00064000 * 00065000 * ASTATEW .. ADDRESS OF STATE ROUTINE IN CMS NUCLEUS 00066000 * FOR R/W DISKS 00067000 * 00068000 * ASTRINIT .. ADDRESS OF STORAGE INITIALIZATION 00069000 * ROUTINE IN CMS NUCLEUS 00070000 * 00071000 * ASYSNAMS.. ADDRESS OF SYSNAME TABLE IN CMS NUCLEUS 00072000 * 00073000 * CONSTACK .. PENDING CONSOLE WRITE OPERATION IN 00074000 * CMS NUCLEUS 00075000 * 00076000 * CPULOG .. CPU LOGOUT AREA IN CMS NUCLEUS 00077000 * 00078000 * DMPTITLE .. DUMP TITLE LINE IN CMS NUCLEUS 00079000 * 00080000 * DIAGTIME ..BUFFER FOR DIAGNOSE TIMER IN CMS 00081000 * NUCLEUS 00082000 * 00083000 * FPRLOG .. FLOATING POINT REGISTER LOGOUT AREA IN 00084000 * CMS NUCLEUS 00085000 * 00086000 * FSTFINRD .. FINISHED CONSOLE READ BUFFER IN 00087000 * CMS NUCLEUS 00088000 * 00089000 * GPRLOG .. GENERAL PURPOSE REGISTER LOGOUT AREA IN 00090000 * CMS NUCLEUS 00091000 * 00092000 * MISFLAGS .. MISCELLANEOUS FLAGS IN CMS NUCLEUS 00093000 * 00094000 * IPLPSW .. IPL PSW IN CMS NUCLEUS 00095000 * 00096000 * LASTTMOD .. NAME OF LAST TRANSIENT MODULE LOADED 00097000 * IN CMS NUCLEUS 00098000 * 00099000 * LOWSAVE .. SAVE AREA FOR 1ST 160 BYTES OF 00100000 * STORAGE 00101000 * 00102000 * SYSNAMES .. SAVED SYSTEM NAME TABLE IN CMS NUCLEUS 00103000 * 00104000 * OUTPUT: 00105000 * 00106000 * THE EDCB (EDIT CONTROL BLOCK) IN FREE STORAGE IS 00107000 * INITIALIZED BY DMSEDX. IT IS FIRST CLEARED TO X'0', 00108000 * THEN ALL NECESSARY INITIALIZATION IS DONE. 00109000 * 00110000 * OPERATION: 00111000 * 00112000 * DMSEDX LOADED INTO THE TRANSIENT AREA OF VIRTUAL 00113000 * MACHINE STORAGE AND EXECUTED AS A RESULT OF THE CMS 00114000 * EDIT COMMAND BEING ISSUED. DMSEDX FIRST ATTEMPTS 00115000 * TO LOAD A SAVED SYSTEM WITH THE NAME AT THE ENTRY 00116000 * FOR 'SHREXEC' IN THE CMS NUCLEUS SAVED SYSTEM NAME 00117000 * TABLE ''SYSNAMES''. IF THE NAME PROVIDED IS NOT 00118000 * VALID, AN ATTEMPT IS MADE TO LOADMOD A DMSEXT MODULE 00119000 * USING THE USER'S ACCESSED DISKS. 00120000 * DMSEDX NOW ISSUES A DMSFREE FOR ALL BUT 15K OF 00121000 * VIRTUAL MACHINE STORAGE. THE FIRST PART OF THIS 00122000 * FREE STORAGE IS CLEARED TO X'0' AND ALLOCATED TO 00123000 * TE EDCB (EDIT CONTROL BLOCK) WHICH IS USED BY ALL 00124000 * EDIT ROUTINES. THE EDCB CONTAINS ALL NECESSARY 00125000 * ASSIGNMENTS TO ALLOW THE CMS EDITOR TO BE REENTRANT 00126000 * AND THEREFORE BE ALLOWED TO BE LOADED INTO A VM/370 00127000 * SHARED SEGMENT. 00128000 * DMSEDX THEN INITIALIZES EDCB WITH ALL NECESSARY 00129000 * PLIST, ETC. REQUIRED BY EDIT ROUTINES. 00130000 * 00131000 * DMSEDX SCANS THE EDIT COMMAND LINE FOR VALIDITY. 00132000 * 00133000 * IF A REMOTE 3270 TERMINAL IS IN USE IT IS FORCED TO 00134000 * OPERATE IN 2741 OR TYPEWRITE MODE TO CUT DOWN ON THE 00135000 * AMOUNT OF DATA TRANSMITTED. THIS MODE CAN BE 00136000 * OVERRIDDEN BY THE FORMAT SUBCOMMAND. 00137000 * 00138000 * IF THE NODISP OPTION WAS SPECIFIED IN THE EDIT 00139000 * COMMAND A 3270 TYPE TERMINAL IS FORCED TO OPERATE IN 00140000 * 2741 MODE FOR THE DURATION OF THE EDIT SESSION. NO 00141000 * OVERRIDE IS ALLOWED. 00142000 * 00143000 * IF THE FILE IS FOUND ON DISK BY THE CALL TO 00144000 * DMSSTT, THE FILE IS READ FROM 00145000 * DISK BY DMSBRD AND THE FILE PLACE IN THE EDIT FREE 00146000 * STORAGE AREA WITH APPROPRIATE LINE POINTERS INCLUDED 00147000 * IN EACH RECORD. 00148000 * IF THE FILE IS NOT FOUND ON DISK, STORAGE IS 00149000 * INITIALIZED AND A MESSAGE IS TYPED TELLING THE 00150000 * USER THE FILE IS NEW. 00151000 * AT THIS TIME THE FILE ATTRIBUTES, EXISTING, 00152000 * SPECIFIED, OR DEFAULTED, ARE MOVED TO THE PROPER 00153000 * AREA IN EDCB. 00154000 * 00155000 * DMSEDX THEN BRANCHES TO THE MAIN EDIT ROUTINE. 00156000 * 00157000 * MESSAGES: 00158000 * 00159000 * DMSEDI003E INVALID OPTION 'OPTION' 00160000 * INVALID OPTION SPECIFIED ON EDIT COMMAND. 00161000 * 00162000 * DMSEDI024E FILE 'EDIT CMSUT1 FM' ALREADY EXISTS 00163000 * THE EDITOR WORK FILE, EDIT CMSUT1, ALREADY EXISTS AS THE 00164000 * RESULT OF A PREVIOUS EDIT SESSION ENDING ABNORMALLY. 00165000 * 00166000 * DMSEDI029E INVALID PARAMETER 'PARAM' IN THE OPTION 00167000 * 'LRECL' FIELD 00168000 * INVALID LRECL PARAMETER SPECIFIED 00169000 * 00170000 * DMSEDI044E RECORD LENGTH EXCEEDS ALLOWABLE MAXIMUM 00171000 * LRECL SPECIFIED IS GREATER THAN 133. 00172000 * 00173000 * DMSEDI048E INVALID MODE 'FM' 00174000 * INVALID MODE SPECIFIED IN EDIT COMMAND 00175000 * 00176000 * DMSEDI054E INCOMPLETE FILEID SPECIFIED 00177000 * FILENAME OR FILETYPE WERE NOT INCLUDED IN EDIT COMMAND 00178000 * 00179000 * DMSEDI069E DISK 'MODE' NOT ACCESSED @VA12416 00179500 * THE SPECIFIED DISK HAS NOT BEEN ACCESSED. @VA12416 00179600 * @VA12416 00179700 * DMSEDI076E ACTUAL RECORD LENGTH EXCEEDS THAT SPECIFIED 00180000 * EXISTING FILE HAS A RECORD LENGTH GREATER THAN THAT 00181000 * SPECIFIED IN THE COMMAND LINE 00182000 * 00183000 * DMSEDI104S ERROR 'NN' READING FILE 'FN FT FM' FROM DISK 00184000 * UNRECOVERABLE ERROR OCCURRED READING THE FILE FROM 00185000 * DISK. 00186000 * 00187000 * DMSEDI132S FILE 'FN FT FM' TOO LARGE 00188000 * THE SPECIFIED FILE IS TOO LARGE FOR THE USER'S 00189000 * MACHINE. 00190000 * 00191000 * DMSEDI143S UNABLE TO LOAD SAVED SYSTEM OR LOAD MODULE. 00192000 * 00193000 * DMSEDI144S REQUESTED FILE IS IN ACTIVE STATUS. 00194000 * 00195000 ***************************************************** 00196000 MACRO 00197000 &NAME CMS &PLIST,&PROG=,&ERROR= 00198000 &NAME LA 1,&PLIST 00199000 AIF (N'&PROG EQ 0).SEQ1 00200000 MVC 0(8,1),=CL8'&PROG' 00201000 .SEQ1 SVC X'CA' 00202000 AIF (N'&ERROR EQ 0).SEQ2 00203000 AIF ('&ERROR' EQ 'IGNORE').SEQ3 00204000 DC AL4(&ERROR) 00205000 MEXIT 00206000 .SEQ3 DC AL4(*+4) 00207000 .SEQ2 MEND 00208000 EJECT 00209000 * 00210000 ************** 00211000 * 00212000 * EDITOR INITIALIZATION ... GO THROUGH PARAMETER LIST ... 00213000 * LOOK FOR GIVEN FILE ... SET DEFAULTS. 00214000 * 00215000 ************** 00216000 SPACE 00217000 DMSEDX START 0 START OF INITIALIZATION 00218000 LR R12,R15 LOAD STARTING ADDRESS INTO REGISTER. 00219000 USING DMSEDX,R12,R11 SET UP ADDRESSABILITY. @VA12416 00220000 LA R11,4095(,R12) SET UP SECOND BASE REG. @VA12416 00220300 LA R11,1(,R11) @VA12416 00220600 USING NUCON,R0 00221000 TM SUBFLAG,SUBACT CALLED FROM CMS SUBSET ? @V305614 00222000 BNO EDITGO NO, BRANCH @V305614 00223000 OI SUBFLAG,SUBREJ SIGNAL INVALID SUBSET COMMAND @VM03083 00224000 BR R14 AND RETURN TO SUBSET @V305614 00225000 SPACE 1 00226000 EDITGO L R10,ADEVTAB GET ADDRESS OF DEVICE TABLE @V305614 00227000 USING DEVTAB,R10 FOR ADDRESSABILITY 00228000 LR R9,R14 SAVE RETURN ADDRESS @V305614 00229000 LR R2,R1 SAVE COMMAND LINE PTR @V305614 00230000 MVC STTFM(2),NOTSFM INITIALIZE STATE FILEMODE @V305614 00231000 SPACE 1 00232000 STLOOP LA R1,STTPLIST POINT TO STATE PLIST @V305614 00233000 L R15,VCFSTLKP GET FSTLKP ENTRY @VM03093 00234000 BALR R14,R15 LOADMOD ON DISK ? @V305614 00235000 BZ LOADIT YES, LOADMOD IT @V305614 00236000 SPACE 1 00237000 CLI STTFM,E2 WAS THAT FOR THE 'S' DISK ? @V305666 00238000 BE ERR143 YES, NO EDMAIN AVAILABLE @V305614 00239000 B TRYSYS OTHERWISE, TRY SAVED SYSTEM @V305614 00240000 SPACE 1 00241000 LOADIT DS 0H @VA07660 00242000 LR R1,R0 ADT ADDRESS @VA07660 00242150 USING ADTSECT,R1 ADT ADDRESSABILITY @VA07660 00242300 MVC MODE(ONE),ADTM ADT FILE MODE @VA07660 00242450 LA R1,LOADMOD LOADMOD EDMAIN MODULE @VA07660 00242600 DROP R1 @VA07660 00242750 SVC 202 ... @VM03083 00243000 DC AL4(ERR143) OOPS - WE DIDN'T GET IT @VM03083 00244000 SR R3,R3 R3 = 0 MEANS WE'LL USE A MODULE, @VM03083 00245000 B MODLDED PROCEED ... @V305614 00246000 SPACE 1 00247000 GETSMOD MVC STTFM(2),SMODE TRY THE 'S' DISK @V305614 00248000 B STLOOP LAST ATTEMPT @V305614 00249000 SPACE 1 00250000 TRYSYS TM DCSSFLAG,DCSSLDED+DCSSAVAL CHECK DCSS STATUS @V305614 00251000 BZ GETSMOD BR, IF NO DCSS @V305614 00252000 BM LOADSYS BR, IF AVAILABLE BUT NOT LOADED @V305614 00253000 L R3,ACMSSEG GET ADR OF LOADED SEGMENT @V305614 00254000 B SYSLDED GO AROUND LOADSYS @V305614 00255000 SPACE 1 00256000 LOADSYS L R5,ASYSNAMS POINT TO SAVED SYS NAME TABLE @V305614 00257000 USING SYSNAMES,R5 @V305614 00258000 LA R3,CMSSEG POINT TO EDIT SEGMENT NAME @V305614 00259000 SR R4,R4 TELL DIAGNOSE THIS IS LOADSYS @V305614 00260000 DC X'83340064' LOADSYS @V305614 00261000 BC 3,GETSMOD BR, IF UNABLE TO LOAD @V305614 00262000 OI DCSSFLAG,DCSSLDED TELL EVERYONE @V305614 00263000 ST R3,ACMSSEG PLUG NUCLEUS ADDRESS @V305614 00264000 SYSLDED MVC LOCCNT(4),AUSEAR FORCE INITIALIZATION @VM03182 00265000 STRINIT OF FREE STORAGE POINTERS @VM03182 00266000 L R3,8(R3) GET CMSSEG ENTRY POINT FOR EDIT @VM03182 00267000 L R3,0(,R3) ONE EXTRA LOAD NEEDED ... @VM03154 00268000 MODLDED L R0,FFREE ALLOW 15K FOR STACKING + EXEC @V305614 00269000 DMSFREE DWORDS=(0),ERR=*,MIN=1,TYPE=NUCLEUS,TYPCALL=BALR 00270000 LR R8,R1 SAVE STORAGE LOCATION @V305614 00271000 STM R0,R1,0(R8) SAVE FOR DMSFRET, @VM03083 00272000 SR R4,R4 R4=0 MEANS DOSFLAGS IS OK @VM03083 00273000 TM DOSFLAGS,DOSSVC INTERNAL SVC-BIT SET ? @VM03083 00274000 BZ DOSFOK1 IF 0 WE'RE OK @VM03083 00275000 IC R4,DOSFLAGS IF NOT 0, REMEMBER DOSFLAGS, @VM03083 00276000 NI DOSFLAGS,255-DOSSVC AND RESET FLAGBIT @VM03083 00277000 DOSFOK1 GETMAIN VC,LA=LIMITS,A=FREEADR GET SOME USER STORAGE @VM03083 00278000 LTR R15,R15 WAS GETMAIN SUCCESSFUL @VA07625 00278100 BNZ ERR109S NO PUT OUT MSG @VA07625 00278200 L R0,FREEBYT LENGTH INTO R0, AND ... @VM03083 00279000 L R1,FREEADR ADDRESS INTO R1 PLEASE, @VM03083 00280000 LTR R4,R4 WAS DOSFLAGS OK BEFORE ? @VM03083 00281000 BZ DOSFOK2 IF YES WE'RE OK @VM03083 00282000 STC R4,DOSFLAGS IF NOT, RESTORE IT AS IT WAS @VM03083 00283000 DOSFOK2 LR R4,R1 NOW CLEAR JUST THE SPACE TO @VM03083 00284000 LA R5,EDCBLTH CONTAIN EDCB .... @V305614 00285000 SR R7,R7 ..... @V305614 00286000 MVCL R4,R6 ..... @V305614 00287000 SPACE 1 00288000 LR R7,R1 ADDRESSABILITY FOR FREE STORAGE @V305614 00289000 USING EDCB,R7 CONTROL BLOCK @V305614 00290000 STM R0,R1,FREELEN SAVE FREE STORAGE PTRS @V305614 00291000 ST R9,EDRET SAVE RETURN ADDRESS @V305614 00292000 ST R3,MAINAD SAVE MAIN ROUTINE ADDRESS @V305614 00293000 SPACE 1 00294000 LM R0,R1,0(R8) GET FRET POINTERS @V305614 00295000 * AND RETURN THE "STACKING STORAGE" 00296000 DMSFRET DWORDS=(0),LOC=(1),TYPCALL=BALR ... @VM03083 00297000 SPACE 1 00298000 MVC CARDINCR+3(6),BLOCINIT NOW INITIALIZE AS MUCH @V305614 00299000 LA R9,MSGINITL AS NECESSARY @V305614 00300000 EX R9,MVCINIT ..... @V305614 00301000 LA R9,ONE ..... @V305666 00302000 ST R9,REPCNT ..... @V305614 00303000 MVI TWITCH,ON INITIALIZE TO TOF @V305666 00304000 MVI BLANK1,BLANK ...... @V305666 00305000 MVI BLANK2,BLANK ..... @V305666 00306000 MVI BLANK3,BLANK ..... @V305666 00307000 MVI SEQNAME,BLANK ..... @VM03108 00308000 MVC INVLDHDR(INVINITL),INVINIT SET EDLIN HEADERS @VA04733 00309100 MVI PADBUF+8,BLANK ..... @VM03036 00310000 LA R9,LPLIST GET LGTH OF PLIST INIT CODE @V305614 00311000 EX R9,LISTMOVE AND MOVE IT .. @V305614 00312000 LA R9,EDLIN INITIALIZE EDLIN ADR @V305614 00313000 STCM R9,BIN0111,AEDLIN ..... @V305666 00314000 LA R9,LINELOC NOW SET UP GIO PLIST @V305614 00315000 ST R9,ALINELOC ..... @V305614 00316000 LA R9,NUMLOC ..... @V305614 00317000 ST R9,ANUMLOC ..... @V305614 00318000 LA R9,FLAGLOC ..... @V305614 00319000 ST R9,AFLAGLOC ..... @V305614 00320000 MVC CMDBLOK(8),CCWINIT INITIALIZE DMSGIO CCW @VA05027 00321100 SPACE 1 00322000 LA R9,1 KEEP IT REUSABLE... @VM08583 00323000 STH R9,RECS ...FOR V TYPE FILES @VM08583 00324000 LH R8,CONSOLE GET VIRT CONS DEV ADR @V60A6B6 00325000 DROP R10 FINISHED WITH DEVTAB. @V60A6B6 00325100 DC X'83890024' DIAG FOR CONSOLE CLASS @V60A6B6 00326000 BC 2,NOGRAF TREAT AS LINE DEVICE IF DISC. @V305614 00327000 CLM R10,B'1000',CLASTERM REMOTE 3270? @V60A6B6 00328000 BNE CHECKLOC NO,CHECK FOR LOCAL 3270 @V60A6B6 00329000 CLM R10,B'0100',TYP3275 REMOTE 3275? @V60A6B6 00329100 BE SETREMOT YES,SET FOR REMOTE 3270 @V60A6B6 00329200 CLM R10,B'0100',TYP3277 REMOTE 3277? @V60A6B6 00329300 BE SETREMOT YES,SET FOR REMOTE 3277 @V60A6B6 00329400 B NOGRAF SET FOR TYPEWRITER TERMINAL @V60A6B6 00329500 CHECKLOC DS 0H CHECK FOR LOCAL @V60A6B6 00329600 CLM R10,B'1100',T3066 3066 DISPLAY CONSOLE ? @V60A6B6 00330000 BE NODISPX YES,SET NODISP FLAG @VA09093 00331010 CLM R10,B'0100',TYP3278 3278 DISPLAY CONSOLE ? @V60A6B6 00331100 BE SETUBE YES...BR @V60A6B6 00331200 CLM R10,B'1000',GRAFCON LOCAL DISPLAY STATION @V60A6B6 00332000 BE SETUBE YES ... BR @V2D3914 00333000 NODISPX EQU * 00333510 OI FLAG2,NODISP INHIBIT DISPLAY MODE @VA09093 00333520 B NOGRAF @VA09093 00333530 SPACE 1 00335000 SETREMOT OI FLAG2,REMOTE FORCE 2741 MODE @V2D3914 00336000 B CONSGRAF GO GET TYPE OF DISPLAY TERMINAL @V60A6B6 00337000 SPACE 1 00338000 MVCINIT MVC CHNGMSG(*-*),MSGINIT @V305614 00339000 LISTMOVE MVC TIN(*-*),INITLIST @V305614 00340000 SPACE 1 00341000 SETUBE EQU * TERMINAL IS A LOCAL 3270 DISPLAY @V60A6B6 00342000 OI FLAG2,TUBE SET INDICATOR FOR DMSEDI @V60A6B6 00343000 CONSGRAF STCM R10,B'0010',TYPSCR SAVE SCREEN SIZE INDEX HRC073DS 00344000 NOGRAF EQU * TERMINAL IS NOT A DISPLAY TYPE HRC073DS 00345000 MVC LINE(L'LINE),0(2) SAVE COMMAND LINE HRC073DS 00346000 LA R15,FSTFINRD GET READ STACK ANCHOR ADDRESS 00347000 ST R15,AFSTFNRD SAVE IT FOR LATER USE 00348000 CLI 8(R2),X'FF' ANY PARAMETERS AT ALL? 00349000 BE ERR54E SHOULD HAVE SPECIFIED SOMETHING! 00350000 EJECT 00351000 * 00352000 ************** 00353000 * 00354000 * SCAN EDIT COMMAND LINE 00355000 * 00356000 ************** 00357000 SPACE 1 00358000 LA R2,8(,R2) POINT TO FILENAME (USE R1) 00359000 MVC FNAME(8),0(R2) SET FILENAME 00360000 LA R2,8(,2) POINT TO FILETYPE 00361000 CLI 0(R2),X'FF' FILETYPE GIVEN ? 00362000 BE ERR54E BRANCH IF NOT 00363000 MVC ALTMODE(R2),DMODE SET A DEFAULT MODE 00364000 MVC FTYPE(8),0(R2) SET THE FILETYPE 00365000 LA R2,8(,R2) POINT TO NEXT ENTRY 00366000 CLI 0(R2),X'FF' FILEMODE GIVEN ? 00367000 BE TYPDATA BRANCH IF NOT 00368000 SPACE 1 00369000 CLI 0(R2),C'(' START OF OPTION ? 00370000 BE ITCHK1 IF SO, GO AROUND MODE CHECK 00371000 SPACE 1 00372000 LA R14,ERR048E PENALTY ADDRESS FOR ANAMOLOUS MODE. 00373000 MVC FMODE(2),0(R2) USE THE GIVEN MODE (FOR NOW) 00374000 CLC =C'* ',0(R2) IS THIS '*' HRC002DS 00375890 BE CONT2 YES, CONTINUE HRC002DS 00376780 CLC =C' ',0(R2) IS IT BLANK? HRC002DS 00377670 BE CONT0 YES, HRC002DS 00378560 CLI 0(R2),C'A' 'A' ? HRC002DS 00379450 BLR R14 < 'A' ERROR HRC002DS 00380340 CLI 0(R2),C'I' 'I' ? HRC002DS 00381230 BNH CONT1 <= 'I' O.K. HRC002DS 00382120 CLI 0(R2),C'J' 'J' ? HRC002DS 00383010 BLR R14 < 'J' ERROR HRC002DS 00383900 CLI 0(R2),C'R' 'R' ? HRC002DS 00384790 BNH CONT1 <= 'R' O.K. HRC002DS 00385680 CLI 0(R2),C'S' 'S' ? HRC002DS 00386570 BLR R14 < 'S' ERROR HRC002DS 00387460 CLI 0(R2),C'Z' 'Z' ? HRC002DS 00388350 BNH CONT1 <= 'Z' O.K. HRC002DS 00389240 BR R14 RETURN WITH ERROR CC HRC002DS 00390130 CONT0 MVC 0(2,R2),=C'* ' TREAT LIKE * HRC002DS 00391020 B CONT2 HRC002DS 00391910 CONT1 CLI 1(R2),C'5' MODE NUMBER GT '5' HRC002DS 00392800 BHR R14 IF SO, ERROR RETURN HRC002DS 00393690 CLI 1(R2),C'0' NUMBER LT '1' ? 00395000 BNL CONT2 IF NOT, SHE'S IN THE RANGE... 00396000 CLI 1(R2),C' ' IF SO, COULD BE BLANK 00397000 BNER R14 ERROR IF NOT BLANK HRC002DS 00398490 MVI FMODE+1,C'1' DEFAULT TO '1' MODE TYPE 00399000 CONT2 CLI 2(R2),C' ' ANYTHING AFTER MODE NUMBER ? 00400000 BCR 7,R14 WELL, THAT'S NOT ALLOWED. 00401000 MVC ALTMODE(2),FMODE MOVE GIVEN FILEMODE TO ALTMODE 00402000 MVC IOMODE(2),ALTMODE INITIALIZE MODE FOR 'STATE' 00403000 LA R2,8(,R2) POINT TO NEXT ENTRY 00404000 EJECT 00405000 ITCHK EQU * CHECK WHETHER ITEM LENGTH GIVEN 00406000 CLI 0(R2),X'FF' WELL? 00407000 BE TYPDATA BRANCH IF IT'S NOT 00408000 CLI 0(R2),C'(' START OF OPTION ? 00409000 BNE ERR3E INVALID OPTION IF NOT 00410000 ITCHK1 LA R2,8(,R2) IF SO, POINT TO NEXT ENTRY 00411000 CLC 0(6,R2),=CL6'LRECL ' CHECK PROPER KEYWORD 00412000 BNE CHKNOD NOT 'LRECL', SEE IF 'NODISP' @V2D3914 00413000 LA R2,8(,R2) POINT TO NEXT ENTRY 00414000 CLI 0(R2),X'FF' IS ACTUAL LRECL GIVEN ? 00415000 BE ERR29E ERROR IF NOT 00416000 SPACE 1 00417000 LA R14,ERR29E LOAD ERROR VECTOR 00418000 CLI 0(R2),C'0' < 0? 00419000 BCR 4,R14 ERROR 00420000 CLI 0(R2),C'9' > 9? 00421000 BCR 2,R14 ERROR 00422000 SR R6,R6 EMPTY A REGISTER 00423000 SR R3,R3 AND ANOTHER 00424000 LR R4,R2 SAVE PLIST POINTER 00425000 LA R5,X'F0' LOAD APPROPRIATE MASK 00426000 LA R15,8 SET MAXIMUM ARGUMENT LENGTH 00427000 NUMLOOP CLI 0(R4),C' ' CHECK FOR BLANK 00428000 BE NUMDONE DONE IF THIS IS ONE 00429000 IC R3,0(,R4) PICK UP CHARACTER 00430000 SR R3,R5 MAKE IT BINARY 00431000 BCR 4,R14 ERROR IF NOT NUMERIC 00432000 MH R6,TEN ADJUST 00433000 AR R6,R3 SAVE IT AWAY 00434000 LA R4,1(,R4) POINT TO THE NEXT POSITION 00435000 BCT R15,NUMLOOP DECREMENT THE ARGUMENT LENGTH 00436000 NUMDONE LTR R6,R6 CHECK THE SAVED PORTION 00437000 BCR 13,R14 POSITIVE REQUIREMENT 00438000 SPACE 1 00439000 CH R6,=H'160' GIVEN ITEM LENGTH GT 160 ? @V2D3914 00440000 BH ERR44E BRANCH IF TOO GREAT 00441000 ST R6,ITEM SAVE FOR REAL 00442000 CLI 8(R2),C')' CLOSING PARENS ? 00443000 BE TYPDATA CONTINUE IF SO 00444000 CLI 8(R2),X'FF' CHECK NO MORE PARMS 00445000 BE TYPDATA CONTINUE IF NOT @V2D3914 00446000 LA R2,8(,R2) POINT TO NEXT ENTRY @V2D3914 00447000 CHKNOD CLC 0(7,R2),=CL7'NODISP ' IS IT 'NODISP' ? HRC002DS 00448490 BNE ERR3E NO...INVALID OPTION @V2D3914 00449000 MVI FLAG2,NODISP SET ONLY NODISP FLAG @V2D3914 00450000 CLI 8(R2),C')' CLOSING PARENS ? @V2D3914 00451000 BE TYPDATA CONTINUE IF SO @V2D3914 00452000 CLI 8(R2),X'FF' ANY MORE OPTIONS ? @V2D3914 00453000 BNE ITCHK1 SEE IF IT'S 'LRECL' @V2D3914 00454000 B TYPDATA CONTINUE... @V2D3914 00455000 EJECT 00456000 * 00457000 ************** 00458000 * 00459000 * FIND THE FILETYPE DATA (IN EDFILES) 00460000 * 00461000 ************** 00462000 SPACE 00463000 TYPDATA EQU * 00464000 MVC FMODE(2),ALTMODE IN CASE NO FM SPECIFIED @VM08583 00465000 MVC IOMODE(2),ALTMODE SET FMODE FOR STATE @VM08583 00466000 LA R1,IOLIST POINT TO THE PLIST 00467000 MVC IOLIST+8(16),=CL16'EDIT CMSUT1' 00468000 MVC IOAD(4),=CL4'****' FOR REUSEABILITY @VM08650 00469000 L R15,ASTATEW LOOK AT R/W DISKS 00470000 BALR R14,R15 GO CHECK THEM 00471000 LTR R2,R15 WORK FILE EXIST? 00472000 BZ ERR24E YES, ERROR 00473000 CH R15,=H'36' WAS DISK NOT ACCESSED? @VA12416 00473300 BE ERRMSG36 GIVE MSG @VA12416 00473600 CH R15,=H'28' 'NOT FOUND' CONDITION? 00474000 BNE EDEXIT TERMINATE. 00475000 L R1,=V(EDFILES) THIS IS WHERE IT STARTS 00476000 SPACE 1 00477000 MVC SPECFT,FTYPE PUT FILETYPE IN WKAREA 00478000 CLC SPECFT(4),UPDT UPDATE FILE? 00479000 BNE TYPDATLP NO WORRY IF NOT 00480000 MVC SPECFT+4(4),XXXX DUMMY IT UP FOR TEST 00481000 SPACE 00482000 TYPDATLP EQU * SEARCH LOOP 00483000 CLI 0(R1),X'FF' IS THIS THE DEFAULT ENTRY? 00484000 BE TYPFND BRANCH IF SO (USE IT) 00485000 CLC 0(8,1),SPECFT DOES THIS ENTRY MATCH OUR FILETYPE? 00486000 BE TYPFND BRANCH IF SO (JOLLY GOOD) 00487000 LA R1,12(,R1) LOOK AT NEXT FILETYPE IN THE TABLE 00488000 B TYPDATLP AND LOOP 00489000 SPACE 00490000 TYPFND EQU * FOUND THE FILETYPE (REAL OR DEFAULT) 00491000 L R10,8(,R1) ADDRESS OF FILETYPE DATA @V305614 00492000 MVC CASESW(1),0(R10) MOVE IN THE CASESW PROMTO @V305614 00493000 MVC FLAG(1),1(R10) SAME FOR FLAGS @V305614 00494000 OI FLAG2,LONGSW+VER DEFAULT TO LONG MSGS 00495000 EJECT 00496000 * 00497000 ************** 00498000 * 00499000 * LOOK FOR SOURCE FILE 00500000 * 00501000 ************** 00502000 SPACE 00503000 LA R1,IOLIST POINT TO THE PLIST 00504000 MVC IOLIST+8(18),FNAME MOVE FILE DATA INTO PLIST 00505000 MVC IOAD(4),=CL4'****' FOR REUSEABILITY @VM08650 00506000 L R15,ASTATE GO TO STATE 00507000 BALR R14,R15 ASK IF FILE EXISTS 00508000 LTR R2,R15 ANY ERRORS? 00509000 BZ OLDFST NO, FILE EXISTS. 00510000 CH R15,=H'36' WAS DISK NOT ACCESSED? @VA12416 00510500 BE ERRMSG36 GIVE MSG @VA12416 00510800 CH R15,=H'28' FILE NOT FOUND? 00511000 BE NEWFILE MUST BE NEW FILE... 00512000 B EDEXIT SO TERMINATE 00513000 SPACE 1 00514000 OLDFST EQU * 00515000 L R3,IOLIST+28 GET STATE DATA 00516000 USING FSTD,R3 @V305614 00517000 L R15,32(,R3) ITEM LENGTH 00518000 CH R15,=H'160' TOO BIG ? @V2D3914 00519000 BH ERR44E BRANCH IF SO 00520000 ST R15,OLDITEM SAVE AS OLD FILE ITEM LENGTH 00521000 MVC FV(1),FSTRECFM GET FST 'F' OR 'V' FLAG @V305614 00522000 MVC IOLIST+36(1),FV SET UP THE RDBUF FORMAT 00523000 CLI ITEM+3,0 HAS ITEM LENGTH BEEN SPECIFIED? 00524000 BNE FORVIS BRANCH IF SO 00525000 ST R15,ITEM USE THE OLD LENGTH 00526000 CLI FV,C'V' VARIABLE LENGTH? 00527000 BNE DEFAULT IF NOT, CONTINUE INIT'N. 00528000 CLM R15,B'0001',3(R10) ACTUAL LENGTH > DEFAULT ? @V305614 00529000 BH DEFAULT IF SO, USE IT 00530000 MVC ITEM+3(1),3(R10) IF NOT, USE DMSEDF DEFAULT @V305614 00531000 B DEFAULT AND CONTINUE... 00532000 SPACE 00533000 FORVIS EQU * IT'S F OR V FORMAT 00534000 C R15,ITEM COMPARE ACTUAL AND SPECIFIED WIDTH 00535000 BH ERR76E BRANCH IF REAL > SPECIFIED 00536000 DEFAULT EQU * 00537000 MVC FMODE(2),FSTFMODE SET FILEMODE @V305614 00538000 BAL R4,CORINIT INITIALIZE CORE 00539000 ST R8,PTR1 SET FIRST RECORD POINTER @V305614 00540000 LA R1,PTR1 NOW INITIALIZE PTR2 @V305614 00541000 ST R1,PTR2 ..... @V305614 00542000 SR R0,R0 MAKE THE HALFWORD MORE @VA02566 00543000 ICM R0,LOWHW,FSTRECCT MANAGEABLE @V305614 00544000 DROP R3 ..... @V305614 00545000 CR R15,R0 ENOUGH ROOM FOR THE FILE? @VA02566 00546000 BL ERR132S BRANCH IF NOT 00547000 MVC IOLIST+24(2),FMODE SET FILEMODE 00548000 SR R0,R0 SET R0 = 0 00549000 STH R0,IOLIST+26 SET FOR SEQUENTIAL 00550000 L R6,ITEM SAVE THE ITEM LENGTH 00551000 BCTR R6,0 DECREMENTED FOR EXECUTE 00552000 CLI FV,C'V' V FORMAT FILE? 00553000 BE XINVAR BRANCH IF SO 00554000 CLC ITEM(4),OLDITEM COMPUTE OLD AND NEW ITEM LENGTHS 00555000 BNE XINVAR BRANCH IF NOT EQUAL 00556000 EJECT 00557000 * 00558000 ************** 00559000 * 00560000 * READ F FORMAT FILE FOR WHICH EDIT ITEM LENGTH <= ACTUAL 00561000 * ITEM LENGTH. 00562000 * 00563000 ************** 00564000 SPACE 1 00565000 LA R3,BUFFER POINT TO PREALLOCATED BUFFER 00566000 ST R3,IOLIST+28 SET UP A(USER AREA) 00567000 LA R1,800 SIZE OF WORK AREA 00568000 ST R1,IOLIST+32 STORE IN RDBUF PARM LIST 00569000 SR R0,R0 CLEAR HIGH-ORDER DIVIDEND 00570000 D R0,ITEM COMPUTE NUMBER OF ITEMS TO READ 00571000 STH R1,IOLIST+38 STORE IN PARM LIST 00572000 LA R1,IOLIST POINT TO RDBUF PLIST 00573000 SPACE 00574000 XINT01 EQU * 00575000 L R15,ARDBUF GET ADDRESS OF DISK READ 00576000 BALR R14,R15 GET A BLOCK OF RECORDS 00577000 BNZ XINT06 CHECK FOR ERROR RETURN 00578000 LA R2,BUFFER REINITIALIZE BUFFER POINTER 00579000 L R5,IOLIST+40 GET NUMBER BYTES ACTUALLY READ 00580000 L R4,OLDITEM LOAD INCREMENT FOR BXLE 00581000 AR R5,R2 GET BXLE COMPARAND 00582000 SR R5,R4 AND POINTER TO THE END 00583000 SPACE 1 00584000 XINT03 EQU * 00585000 EX R6,BUFFMOVE PUT THE LINE INTO STORAGE 00586000 BAL R14,XWRITEA PUT IT INTO CORE 00587000 BXLE R2,R4,XINT03 LOOP THROUGH BLOCK 00588000 B XINT01 FALL THROUGH, READ NEXT BUNCH 00589000 SPACE 00590000 BUFFMOVE MVC 8(*-*,8),0(R2) LINE MOVER 00591000 EJECT 00592000 * 00593000 ************** 00594000 * 00595000 * READ V FORMAT FILE, OR ONE FOR WHICH EDIT ITEM LENGTH > ACTUAL 00596000 * ITEM LENGTH. 00597000 * 00598000 ************** 00599000 SPACE 1 00600000 XINVAR EQU * 00601000 LA R1,IOLIST PICK UP POINTER FOR PLIST 00602000 LA R3,8(,R8) POINT 8 BEYOND AEXTEND TARGET 00603000 ST R3,IOLIST+28 THIS IS THE BUFFER FOR RDBUF 00604000 MVI 0(R3),C' ' WHICH... 00605000 EX R6,LINECLR SHOULD BE CLEARED. 00606000 L R15,ARDBUF GET ADDRESS OF DISK READ 00607000 BALR R14,R15 READ A LINE INTO STORAGE 00608000 BNZ XINT06 CHECK FOR ERROR 00609000 BAL R14,XWRITEA PUT IN THE POINTERS 00610000 B XINVAR AND LOOP UNTIL EOF @V305614 00611000 SPACE 00612000 LINECLR MVC 1(*-*,R3),0(R3) BLANK MOVER 00613000 EJECT 00614000 * 00615000 ************** 00616000 * 00617000 * CLOSE THE INPUT FILE 00618000 * 00619000 ************** 00620000 SPACE 1 00621000 XINT06 EQU * 00622000 LR R2,R15 SAVE ERROR CODE IN R0 00623000 ST R8,AEXTEND POINT TO NEXT AVAIL. LINE 00624000 S R8,CORITEM BACK UP BY CORITEM @V305614 00625000 ST R8,PTR3 SET PTR3 EQUAL LAST LINE @V2D3913 00626000 LA R8,PTR1 GET ADDRESS OF TOP POINTER @V305614 00627000 ST R8,PTR2 SET PTR2 @V305614 00628000 SR R8,R8 ZERO OUT @V305614 00629000 L R9,PTR3 LAST RECORD @V305614 00630000 ST R8,0(,R9) FORWARD POINTER @V305614 00631000 L R15,AFINIS GET CLOSE ROUTINE ADDRESS 00632000 BALR R14,R15 CLOSE THE FILE 00633000 CH R2,=H'12' EOF? 00634000 BNE ERR104S BRANCH IF NOT 00635000 LA R2,ONE NOW REINITIALIZE @V305666 00636000 STH R2,RECS THE IO PLIST FOR EDIT @V305614 00637000 B ISORISNT GO TO COMMON IS OR ISN'T ROUTINE 00638000 EJECT 00639000 * 00640000 ************** 00641000 * 00642000 * XWRITEA INSTALLS FORWARD AND BACKWARD POINTERS 00643000 * INTO THE STORAGE COPY OF THE FILE BEING EDITTED 00644000 * 00645000 ************** 00646000 SPACE 1 00647000 DS 0H 00648000 XWRITEA BCTR R13,0 REDUCE BY 1 00649000 ST R13,SPARES AND STORE AS NEW VALUE OF SPARES 00650000 L R9,PTR2 GR1=A(OLD ITEM) 00651000 ST R8,PTR2 READ PTR POINTS TO ITEM 00652000 L R3,0(,R9) GR14=A(OLD+1) @V305614 00653000 ST R3,0(,R8) E =>OLD+1 @V305614 00654000 ST R9,4(,R8) OLD <= E 00655000 ST R8,0(,R9) OLD => E 00656000 A R8,CORITEM ADDS CORE ITEM TO CURRENT POINTER@V305614 00657000 BR R14 RETURN TO CALLER 00658000 EJECT 00659000 * 00660000 ************** 00661000 * 00662000 * NEW FILE ... 00663000 * 00664000 ************** 00665000 SPACE 00666000 NEWFILE EQU * IT'S A NEW FILE 00667000 CLC ALTMODE(FMOD),ASTRKMOD SET FILEMODE '*' TO A1 @VA06274 00667200 BNE DRVDMODE MODE IS A1 OR GIVEN MODE @VA06274 00667400 MVC ALTMODE(FMOD),DMODE REVERT TO MODE A1 @VA06274 00667600 DRVDMODE EQU * @VA06274 00667800 MVC FMODE(2),ALTMODE USE DERIVED FILEMODE 00668000 MVC FV(1),2(R10) SET FV FLAG FROM FILETYPE DATA @V305614 00669000 CLI ITEM+3,0 HAS ITEM LENGTH BEEN SPECIFIED? 00670000 BNE *+10 SKIP IF SO 00671000 MVC ITEM+3(1),3(R10) USE DEFAULT FOR FILETYPE @V305614 00672000 BAL R4,CORINIT INITIALIZE CORE 00673000 LTR R15,R15 HOW MANY LINES CAN WE FIT IN? 00674000 BNH ERR132S BRANCH IF NONE 00675000 SPACE 00676000 L R15,PTR2 GET PTR2 VALUE @V305614 00677000 ST R15,PTR3 AND AS VALUE OF PTR3 @V2D3913 00678000 TM FLAG2,TUBE DISPLAY TYPE TERM ? 00679000 BNO TYPMSG NO ... BR 00680000 OI FLAG2,NUFILE INDICATE NEW FILE 00681000 B ISORISNT 00682000 TYPMSG LA R2,NEWMSG POINT TO THE MESSAGE 00683000 BAL R14,WRTYPE TYPE 'NEW FILE:' 00684000 EJECT 00685000 * 00686000 ************** 00687000 * 00688000 * NEW OR OLD FILE ... 00689000 * 00690000 ************** 00691000 SPACE 00692000 ISORISNT EQU * FILE IS OR FILE ISN'T 00693000 L R15,ITEM GET ITEM LENGTH TO BE USED 00694000 SR R0,R0 CLEAR R0 00695000 IC R0,4(,R10) TRUNCATION COLUMN (AND END ZONE) @V305614 00696000 LTR R0,R0 IS IT TO BE SET TO ITEM-LENGTH? 00697000 BNZ *+6 SKIP IF NOT 00698000 LR R0,R15 OTHERWISE USE ITEM LENGTH 00699000 CR R0,R15 TOO BIG? 00700000 BNH *+6 SKIP IF NOT 00701000 LR R0,R15 USE ITEM LENGTH 00702000 STC R0,TRUNCOL+1 SET TRUNCOL 00703000 STC R0,ZONE2+1 AND END ZONE 00704000 SPACE 00705000 * DISABLE SERIALIZATION IF LRECL NOT 80. 00705100 SPACE 1 00705200 CH R15,H80 IS LRECL EQUAL TO 80? @VA04598 00705300 BE NODISSER YES, SERIALIZATION UNAFFECTED @VA04598 00705400 NI FLAG,X'FF'-(SERSW+SERNAME) NO, DISABLE SERIAL. @VA04598 00705500 SPACE 1 00705600 NODISSER EQU * @VA04598 00705700 IC R0,5(,R10) PICK UP COLUMN OF VERIFICATION @V305614 00706000 LTR R0,R0 IS IT TO BE SET TO THE ITEM-LENGTH? 00707000 BNZ *+6 SKIP IF NOT 00708000 LR R0,R15 SET IT TO THE ITEM-LENGTH 00709000 CR R0,R15 TOO BIG? 00710000 BNH *+6 SKIP IF NOT 00711000 LR R0,R15 USE ITEM LENGTH 00712000 SPACE 1 00713000 STH R0,VERCOL2 SAVE AS VERIFY END COLUMN @V2D3914 00714000 STH R0,VERLEN AND VERIFY LENGTH @V2D3914 00715000 LA R1,1 INITIALIZE FIRST VERIFY @V2D3914 00716000 STH R1,VERCOL1 COLUMN TO 1 @V2D3914 00717000 SPACE 00718000 L R1,8(,R10) ADDRESS OF DEFAULT TABS @V305614 00719000 MVC TABS(ENDTABS-TABS),0(R1) MOVE THEM INTO 'TABS' 00720000 SR R1,R1 CLEAR REG FOR ZONE SET 00721000 IC R1,TABS GET STARTING TAB 00722000 BCTR R1,0 STORE 1 LESS FOR CALC. EASE 00723000 STH R1,ZONE1 STORE IN FIRST ZONE ENTRY 00724000 MVI PADCHAR,C'0' INITIALIZE PADCHAR 00725000 MVI LMSTART+1,75 AND LMSTART 00726000 TM FLAG,LEFT LINEMODE LEFT? 00727000 BZ IS1 SKIP IF NOT 00728000 SPACE 1 00729000 TM FLAG,LINE8 ARE LINENUMBERS THE LONG KIND? 00730000 BO *+8 WELL THEN, THEY'RE ZERO FILLED. 00731000 MVI PADCHAR,C' ' PAD CHARACTER FOR LEFT 00732000 MVI LMSTART+1,0 AND STARTING POSITION 00733000 SPACE 1 00734000 IS1 EQU * 00735000 MVC JAR(ENDBLOC-BLOC),BLOC INITIAL PRESERVE @V305614 00736000 SR R2,R2 CLEAR R2 = "RETURN CODE" @VM03083 00737000 CL R2,MAINAD SHOULD WE USE A MODULE ? @VM03083 00738000 BE NOSEG YES (IF MAINAD = 0) - BRANCH @VM03083 00739000 L R14,MAINAD OTHERWISE, GET ADDRESS OF EDMAIN @VM03108 00740000 B EXIT USE IT ... @V305614 00741000 NOSEG L R14,AUSEAR GET LOADMOD ENTRY POINT @VM03182 00742000 B EXIT GO TO NORMAL EXIT RTN @V305614 00743000 EJECT 00744000 * 00745000 ************** 00746000 * 00747000 * CORINIT IS A SUBROUTINE WHICH INITIALIZES CORE. 00748000 * 00749000 * 1. COMPUTES NO. OF BYTES REQUIRED PER LINE (CORITEM) 00750000 * 2. CALLS GETMAIN 00751000 * 3. COMPUTES NUMBER OF LINES WE CAN FIT IN (SPARES) 00752000 * 00753000 * CALL: 00754000 * BAL 4,CORINIT 00755000 * 00756000 ************** 00757000 SPACE 00758000 CORINIT DS 0H 00759000 LA R14,PTR1 LOCATE PTR1 00760000 ST 14,PTR2 MAKE PTR2 POINT TO IT 00761000 L R14,ITEM ITEM LENGTH 00762000 LA R14,3(,R14) ROUND TO WORD 00763000 N R14,FMINUS4 ... 00764000 LA R14,8(,R14) ADD ROOM FOR POINTERS @V305614 00765000 ST R14,CORITEM STORE AS CORITEM @V305614 00766000 SPACE 00767000 L R15,FREELEN GET LENGTH OF FREE STORAGE @VM03108 00768000 LA R8,EDCBLTH GET LENGTH OF EDCB @V305614 00769000 SR R15,R8 DEDUCT EDCB LENGTH @V305614 00770000 LA R8,EDCBEND POINT TO AREA AFTER EDCB @V305614 00771000 SPACE 1 00772000 TM FLAG2,TUBE+REMOTE DEALING WITH GRAPHICS? @V2D3914 00773000 BZ REGCALC EASY, IF NOT. @V2D3913 00774000 ST R8,SCRBUFAD RESERVE A SCREEN BUFFER @V2D3913 00775000 SLR R13,R13 CLEAR SCREEN INDEX REGISTER @V60A6B6 00775100 SPACE 00775110 *********************************************************************** 00775120 ** THE FOLLOWING CODE CHANGES THE MODEL NUMBER OF A 3278 MODEL 2A TO ** 00775130 ** A 6 IN TYPSCR SO THAT THE DISPLACEMENT OF 16 (6-2*4=16) CAN BE 73DS 00775140 ** ESTABLISHED. IF THE ACTUAL MODEL NUMBER OF 6 IS EVER USED THEN 73DS 00775150 ** THIS CODE MUST BE CHANGED..THAT IS BE SURE TO GET THE CORRECT ** 00775160 ** DISPLACEMENT. ** 00775170 *********************************************************************** 00775180 SPACE 00775190 CLI TYPSCR,MODEL2A IS MODEL A 3278 MODEL 2A? @V60A6B6 00775200 BNE NOT2A NO... DO NORMAL INDEX COMP.. @V60A6B6 00775210 MVI TYPSCR,6 MOVE 6 INTO FIELD HRC073DS 00775220 IC R13,TYPSCR PICK IT OUT TO START INDEXING @V60A6B6 00775230 SH R13,TWO COMPUTE INDEX @V60A6B6 00775240 MH R13,FOUR . . . @V60A6B6 00775250 B INDEXSET DON'T REDO INDEXING @V60A6B6 00775260 NOT2A EQU * 00775270 IC R13,TYPSCR GET THE DISPLAY ALT. SIZE INDEX @V60A6B6 00776000 SH R13,TWO COMPUTE INDEX @V60A6B6 00776010 MH R13,FOUR . . . @V60A6B6 00776020 INDEXSET EQU * 00776030 L R13,SCRSIZES(R13) AND GET SCREEN BUFFER. @V60A6B6 00776100 AR R8,R13 OFFSET STORAGE START @V2D3913 00777000 SR R15,R13 REDUCE LENGTH @V2D3913 00778000 BNP ERR132S MUST HAVE SOME @V2D3913 00779000 REGCALC EQU * @V2D3913 00780000 ST R8,AEXTEND MAKE IT THE STANDARD 00781000 SR R14,R14 ZERO FOR DIVIDE 00782000 D R14,CORITEM NO. OF LINES WE CAN HANDLE 00783000 LR R13,R15 SAVE FOR COMPUTING LATER. 00784000 ST R15,SPARES SAVE AS SPARES 00785000 BR R4 RETURN 00786000 EJECT 00787000 * 00788000 ************** 00789000 * 00790000 * TERMINAL ERRORS ... 00791000 * 00792000 ************** 00793000 SPACE 00794000 ERR3E DMSERR NUM=3,LET=E,SUB=(CHARA,(2)),TEXT='Invalid option ''....*00795490 ....''',CSECT=EDI 00796000 LA R2,24 RETURN CODE = 24 00797000 B EDEXIT FREEMAIN AND EXIT @V305614 00798000 SPACE 2 00799000 ERR24E DMSERR NUM=24,LET=E,SUB=(CHAR8A,EDWORK),TEXT='File ''.........*00800590 ...........'' already exists',CSECT=EDI HRC002DS 00801180 LA 2,28 RETURN CODE = 28 00802000 B EDEXIT FREEMAIN AND EXIT @V305614 00803000 SPACE 2 00804000 ERR29E DMSERR NUM=29,LET=E,SUB=(CHARA,(2)),TEXT='Invalid parameter ''*00805590 ........'' in the option ''LRECL'' field',CSECT=HRC002DS 00806180 LA R2,24 RETURN CODE = 24 00807000 B EDEXIT FREEMAIN AND EXIT @V305614 00808000 SPACE 2 00809000 ERR44E DMSERR NUM=44,LET=E,TEXT='Record length exceeds allowable maxi*00810590 mum',CSECT=EDI HRC002DS 00811180 LA R2,32 RETURN CODE = 32 @V305614 00812000 B EDEXIT FREEMAIN AND EXIT @V305614 00813000 SPACE 2 00814000 ERR048E DMSERR NUM=48,LET=E,SUB=(CHARA,(2)),TEXT='Invalid mode ''.....*00815490 ...''',CSECT=EDI 00816000 LA R2,24 RETURN CODE = 24 00817000 B EDEXIT FREEMAIN AND EXIT @V305614 00818000 SPACE 2 00819000 ERR54E DMSERR NUM=54,LET=E,TEXT='Incomplete fileid specified',CSECT=E*00820490 DI 00821000 LA R2,24 RETURN CODE = 24 00822000 B EDEXIT FREEMAIN AND EXIT @V305614 00823000 ERRMSG36 EQU * @VA12416 00823150 LA R0,24(R1) POINT TO MODE LETTER @VA12416 00823300 DMSERR TEXT='Disk ''..'' not accessed',NUM=69, X00823510 LET=E,SUB=(CHARA,((R0),1)) @VA12416 00823600 LA R2,36 GIVE RETCODE @VA12416 00823750 B EDEXIT AND GO RETURN TO CALLER @VA12416 00823900 SPACE 2 00824000 ERR76E DMSERR TEXT='Actual record length exceeds that specified', X00825490 NUM=76,LET=E,CSECT=EDI @VA03885 00826000 LA R2,40 RETURN CODE = 40 00827000 SR R0,R0 CLEAN A REG @VA02417 00828000 ST R0,ITEM CLEAR UP MISTAKES BEFORE LEAVING @VA02417 00829000 B EDEXIT FREEMAIN AND EXIT @V305614 00830000 SPACE 2 00831000 ERR104S DMSERR NUM=104,LET=S,SUB=(DEC,(2),CHAR8A,IOID),TEXT='Error ''.*00832590 .'' reading file ''....................'' from disk',REN*00833180 T=NO,CSECT=EDI 00834000 LA R1,IOLIST ATTEMPT TO CLOSE THE FILE @VM03083 00835000 L R15,AFINIS ... @VM03083 00836000 BALR R14,R15 ... @VM03083 00837000 LA R2,100 RETURN CODE = 100 00838000 B EDEXIT AND QUIT.. @V305614 00839000 SPACE 00840000 ERR132S DMSERR NUM=132,LET=S,SUB=(CHAR8A,FNAME),TEXT='File ''.........*00841590 ...........'' too large',CSECT=EDI HRC002DS 00842180 LA R2,88 RETURN CODE = 88 00843000 B EDEXIT FREEMAIN AND EXIT @V305614 00844000 SPACE 1 00845000 SPACE , HRC104DS 00846000 ERR143 DMSERR NUM=143,LET=S,TEXT=' Unable to load SAVED SYSTEM or loaX00846590 d module',CSECT=EDI HRC002DS 00847180 LA R2,FORTY SET RETURN CODE @V305666 00848000 LR R14,R9 SET UP CMS RETURN @V305614 00849000 B EXIT AND RETURN @V305614 00850000 ERR109S EQU * @VA07625 00850100 DMSERR NUM=109,LET=S,TEXT='Virtual storage capacity exceeded' *00850220 HRC002DS 00850240 LM R0,R1,0(R8) SET UP FOR FRET @VA07625 00850300 DMSFRET DWORDS=(0),LOC=(1),TYPCALL=BALR FRET @VA07625 00850400 SR R7,R7 CLEAR R7 @VA07625 00850500 LA R2,RET88 PUT RET CODE IN R2 @VA07625 00850600 LR R14,R9 GET RETURN ADDRESS @VA07625 00850700 B EXIT GO EXIT @VA07625 00850800 SPACE 1 00851000 EJECT 00852000 * 00853000 ************** 00854000 * 00855000 * GENERAL TERMINAL WRITE ROUTINE 00856000 * 00857000 ************** 00858000 SPACE 1 00859000 WRTYPE EQU * @V305614 00860000 LA R1,WRLIST POINT TO PLIST @V305614 00861000 MVI 0(R1),HEX80 SET 1ST FLAG @V305666 00862000 MVI 1(R1),HEX81 AND 2ND FLAG @VM03210 00863000 STCM R2,BIN0111,2(R1) AND MSG ADDRESS @V305666 00864000 SVC 203 @V305614 00865000 DC H'-6' @V305614 00866000 BR R14 RETURN TO THE CALLER 00867000 SPACE 1 00868000 EJECT 00869000 * 00870000 ************** 00871000 * 00872000 * RETURN TO THE CALLER (DMSEDI) 00873000 * 00874000 ************** 00875000 SPACE 1 00876000 EDEXIT EQU * 00877000 SR R1,R1 GET A ZERO @VA02874 00878000 ST R1,ITEM CLEAN UP ERROR @VA02874 00879000 L R1,AFSTFNRD ADDRESS OF ANCHOR FOR STACKED READS 00880000 L R1,0(,R1) CHECK THE CHAIN. 00881000 LTR R1,R1 ARE THERE ANY? 00882000 BZ FREECORE IF NOT, GO FREE STORAGE @V305614 00883000 CMS CONWAIT WAIT FOR PEACE AND QUIET 00884000 CMS DESBUF DESTROY STACKED LINES 00885000 LR 5,2 SAVE RETURN CODE 00886000 LA R2,CLRMSG POINT TO THE MESSAGE. 00887000 BAL R14,WRTYPE TYPE WARNING MESSAGE 00888000 LR 2,5 GET SAVED RETURN CODE 00889000 FREECORE L R14,EDRET SET CMSRETURN ADDRESS @V305614 00890000 SPACE 1 00891000 LM R0,R1,FREELEN GIVE BACK FREE STORAGE @V305614 00892000 SR R4,R4 R4=0 MEANS DOSFLAGS IS OK @VM03083 00893000 TM DOSFLAGS,DOSSVC INTERNAL SVC-BIT SET ? @VM03083 00894000 BZ DOSFOK3 IF 0 WE'RE OK @VM03083 00895000 IC R4,DOSFLAGS IF NOT 0, REMEMBER DOSFLAGS, @VM03083 00896000 NI DOSFLAGS,255-DOSSVC AND RESET FLAGBIT @VM03083 00897000 DOSFOK3 FREEMAIN R,LV=(0),A=(1) RETURN THE USER STORAGE @VM03083 00898000 LTR R4,R4 WAS DOSFLAGS OK BEFORE ? @VM03083 00899000 BZ EXIT IF YES WE'RE OK @VM03083 00900000 STC R4,DOSFLAGS IF NOT, RESTORE IT AS IT WAS @VM03083 00901000 EXIT EQU * GO TO EDMAIN OR RETURN TO CMS: @VM03083 00902000 LR R15,R2 SET RETURN CODE @V305614 00903000 LR R1,R7 PASS ALONG THE FREE STOR ADR @V305614 00904000 BR R14 GO BACK TO CMS OR MAIN RTN @V305614 00905000 SPACE 1 00906000 EJECT 00907000 * 00908000 ************** 00909000 * 00910000 * PARAMETER LISTS AND MESSAGE DUMMIES 00911000 * 00912000 ************** 00913000 SPACE 1 00914000 INITLIST DS 0F @V305614 00915000 DC CL8'WAITRD' @V305614 00916000 DC AL1(1) @V305614 00917000 DS AL3 @V305614 00918000 DC C'U' @V305614 00919000 DS AL3 @V305614 00920000 DC CL8'TYPLIN' @V305614 00921000 DC AL1(1) @V305614 00922000 DS AL3 @V305614 00923000 DC C'B' @V305614 00924000 DC X'10' @VA06190 00925500 DS H @V305614 00926000 DC CL8'STATE' @V305614 00927000 DC CL8'EDIT' @V305614 00928000 DC CL8'CMSUT1' @V305614 00929000 DC CL2'A1' @V305614 00930000 DS H @V305614 00931000 DC CL4'****' @V305614 00932000 DC F'160' @V305614 00933000 DC CL2' ' @V305614 00934000 DC H'1' @V305614 00935000 DS F @V305614 00936000 DC CL8'RENAME' @V305614 00937000 DC CL8'EDIT' @V305614 00938000 DC CL8'CMSUT1' @V305614 00939000 DC CL8'A1' @V305614 00940000 DS CL8 @V305614 00941000 DS CL8 @V305614 00942000 DC CL2'*',CL6' ' @V305614 00943000 DC 8X'FF' @V305614 00944000 DC CL8'ATTN' @V305614 00945000 DC CL4'FIFO' @V305614 00946000 DS AL1,AL3 @V305614 00947000 DC CL8'ATTN' @V305614 00948000 DC CL4'LIFO' @V305614 00949000 DS AL1,AL3 @V305614 00950000 DC CL8'RENUM' @V305614 00951000 DS 8F @V305614 00952000 ENDPLIST DS 0F @V305614 00953000 LPLIST EQU (ENDPLIST-INITLIST) @V305614 00954000 SPACE 1 00955000 CCWINIT DC X'1900000020000000' @VA05027 00956100 SPACE 1 00958000 SPACE 1 00959000 CONWAIT DS 0F 00960000 DC CL8'CONWAIT' 00961000 DC CL4'CON1' 00962000 SPACE 00963000 DESBUF DS 0F 00964000 DC CL8'DESBUF' 00965000 SPACE 00966000 CLRMSG DC AL1(L'KILMES) 00967000 KILMES DC C'Stacked lines cleared' HRC002DS 00968490 SPACE 1 00969000 NEWMSG DC AL1(L'NOTFND) 00970000 NOTFND DC C'New file:' HRC002DS 00971490 SPACE 00972000 EJECT 00973000 * 00974000 ************** 00975000 * 00976000 * MISCELLANEOUS DATA FIELDS 00977000 * 00978000 ************** 00979000 SPACE 1 00980000 FREEADR DC A(0) ADDRESS OF "GETMAIN" BUFFER @VM03083 00981000 FREEBYT DC A(0) AND LENGTH OF SAME @VM03083 00982000 SPACE 00983000 FFREE DC F'1960' NO. DBLWDS FOR STACK AND EXEC 00984000 LIMITS DC F'88' RANGE FOR CONDITIONAL GETMAIN 00985000 DC F'16777215' 00986000 AUSEAR DC F'131072' 20000 @VM03182 00987000 FMINUS4 DC F'-4' USED FOR ROUNDING 00988000 TEN DC H'10' JUST LIKE THE 'NEW MATH' 00989000 H80 DC H'80' HALFWORD 80 @VA04598 00989100 DMODE DC CL2'A1' DEFAULT MODE 00990000 ASTRKMOD DC CL2'* ' FILEMODE ASTERISK @VA06274 00990500 UPDT DC CL4'UPDT' POSSIBLE UPDATE FT PREFIX 00991000 XXXX DC CL4'XXXX' DUMMY SUFFIX 00992000 TWO DC H'2' USED TO COMPUTE SCREEN SIZE @V60A6B6 00992100 FOUR DC H'4' USED TO COMPUTE SCREEN SIZE @V60A6B6 00992200 FIVE EQU X'05' USED TO COMPUTE SCREEN SIZE @V60A6B6 00992300 MODEL2A EQU X'2A' @V60A6B6 00992400 MODEL02 EQU X'02' HRC104DS 00992500 MODEL03 EQU X'03' HRC104DS 00992600 MODEL04 EQU X'04' HRC104DS 00992700 MODEL05 EQU X'05' HRC104DS 00992800 SPACE 1 00993000 BLOCINIT DC X'0A004B000AF0' @V305614 00994000 MSGINIT DC C'.... line(s) changed' HRC002DS 00995090 DC C', ' @VA04193 00995200 DC C'.... line(s) ' HRC002DS 00995590 DC C'truncated' HRC002DS 00995780 DC CL4'A1' CMODE @V305614 00996000 DC C'Set new FILEXXXX and retry' HRC002DS 00997490 MSGLIMIT EQU * @V305614 00998000 MSGINITL EQU (MSGLIMIT-MSGINIT) @V305614 00999000 SPACE 1 00999300 INVINIT EQU * START OF EDLIN HEADERS @VA04733 00999600 DC CL6'?EDIT:' HEADER FOR INVALID REQUEST MSG @VA04733 00999900 DC CL4'EXEC' HEADER FOR EDIT MACRO STACKING @VA04733 01000200 DC CL6' ' SPOT TO HOLD SELECTED HEADER @VA04733 01000500 DC CL1' ' BLANK TO OFFSET SELECTED HEADER @VA04733 01000800 INVINITL EQU *-INVINIT LENGTH OF EDLIN HEADERS (PLUS) @VA04733 01001100 SPACE 1 01001400 GRAFCON DC X'40' DISPLAY CLASS TERMINAL 01002000 REMOTUBE DC X'8080' REMOTE DISPLAY TERMINAL TYPE @V2D3914 01003000 TYP3275 DC X'02' 3275 DISPLAY STATION @V60A6B6 01003100 TYP3277 DC X'04' 3277 DISPLAY STATION @V60A6B6 01003200 TYP3278 DC X'01' 3278 DISPLAY STATION @V60A6B6 01003300 CLASTERM DC X'80' TERMINAL CLASS @V60A6B6 01003400 T3066 DC X'4010' 3066 CONSOLE TYPE @VA07296 01004000 SCRSIZES DC A(1920,2560,3440,3564,1600) SCREEN BUFFER SIZES HRC073DS 01004490 SPACE 1 01005000 STTPLIST DS 0F @V305614 01006000 DC CL8'STATE' @V305614 01007000 DC CL8'EDMAIN' @V305614 01008000 DC CL8'MODULE' @V305614 01009000 STTFM DC CL4'*' @V305614 01010000 DC A(*-*) @V305614 01011000 SPACE 1 01012000 LOADMOD DS 0F LOADMOD PLIST @V305614 01013000 DC CL8'LOADMOD' @V305614 01014000 DC CL8'EDMAIN' @V305614 01015000 DC CL8'MODULE' FILE TYPE @VA07660 01015300 MODE DC XL2'FF40' FILE MODE @VA07660 01015600 DC 8X'FF' FENCE @V305614 01016000 SPACE 1 01017000 LFSDIFF EQU 4 A(FSTLKP)-A(DMSLFS) @V305614 01018000 SMODE DC CL2'S ' FOR 'S' DISK' STATE @V305614 01019000 NOTSFM DC CL2'-S' STATE FOR ALL BUT 'S' DISK @V305614 01020000 SPACE 1 01021000 * SYMBOLIC REGISTER EQUATES FOR MOVEREGS 01022000 SPACE 1 01023000 BLOCREG EQU 3 01024000 PTREG EQU 4 01025000 JAREG EQU 5 01026000 SPACE 1 01027000 * EQUATES USED IN FLAG 01028000 SPACE 1 01029000 CAN EQU X'01' 01030000 SERSW EQU X'04' SERIALIZATION IS REQUIRED @VA04598 01030100 SERNAME EQU X'08' SERIALIZATION IS WITH 3-CHAR NAME@VA04598 01030200 LINE8 EQU X'10' 01031000 LEFT EQU X'40' 01032000 SPACE 1 01033000 * EQUATES USED IN FLAG2 01034000 SPACE 1 01035000 VER EQU X'01' 01036000 LONGSW EQU X'02' 01037000 TUBE EQU X'04' INDICATES DISPLAY TERMINAL 01038000 NUFILE EQU X'08' INDICATES NEW FILE 01039000 SPACE 1 01040000 * EQUATES FOR ICM INSTRUCTIONS 01041000 SPACE 1 01042000 LOWHW EQU B'0011' INSERT INTO LOW-ORDER HALF @VA02566 01043000 BIN0111 EQU B'0111' @V305066 01044000 SPACE 2 01045000 REMOTE EQU X'20' INDICATES REMOTE DISPLAY TERM. @V2D3914 01046000 SWITCH EQU X'40' USED BY INPUT RTN IN DMSEDI @V2D3914 01047000 NODISP EQU X'80' NODISP OPTION INCLUDED @V2D3914 01048000 E2 EQU X'E2' @V305066 01049000 ONE EQU 1 @V305066 01050000 ON EQU X'01' @V305066 01051000 BLANK EQU X'40' @V305066 01052000 FORTY EQU 40 RETURN CODE = 40 @V305066 01053000 HEX80 EQU X'80' @V305066 01054000 HEX81 EQU X'81' @V305066 01055000 FMOD EQU 2 2-BYTE FILEMODE FIELD @VA06274 01055500 RET88 EQU X'88' @VA07625 01055550 SPACE 1 01056000 EJECT 01057000 OLDITEM DS F SPOT FOR ACTUAL ITEM LENGTH OF FI@V305614 01058000 SPECFT DS CL8 HOLDING FIELD FOR FT @V305614 01059000 WRLIST DS 22X GENERAL WRITE RTN PLIST @V305614 01060000 * RDBUF BUFFER FOR READING FIXED-BLOCKED 01061000 SPACE 1 01062000 BUFFER DS CL800 @V305614 01063000 SPACE 1 01064000 * COMMAND LINE BUFFER FOR BETTER PAGING 01065000 SPACE 01066000 LTORG (AS NEEDED) @VM03083 01067000 EJECT 01068000 EDCB @V305614 01069000 FSTD @V305614 01070000 ADT @VA08391 01070500 NUCON @V305614 01071000 DEVTAB @V305614 01072000 SYSNAMES @V305614 01073000 REGEQU 01074000 END 01075000