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