SUBROUTINE EDMAI2(ISOURC,IEDINA,IDPSW) CCCCC PROGRAM EDMAIN COMMENTED OUT TO MAKE IT A SUBROUTINE 7/92 CCCCC THE ABOVE SUBROUTINE LINE WAS ADDED JULY 1992 CCCCC THE IDPSW ARGUMENT (= DATAPLOT SWITCH) WAS ADDED JULY 1993 C C PURPOSE--THIS IS THE SUBROUTINE VERSION OF THE MAIN ROUTINE C FOR THE EDITOR. IT IS THE SUBROUTINE VERSION BECAUSE C IT MUST BE CALLED BY DATAPLOT. C IT DIFFERS ONLY IN THAT-- C 1) PROGRAM EDMAIN ==> SUBROUTINE EDMAI2 C 2) CALL EXIT(1) ==> RETURN C C PURPOSE--THIS IS THE SECONDARY MAIN ROUTINE FOR THE EDITOR C C ORIGINAL VERSION (AS A SEPARATE ROUTINE)--JANUARY 19,1985 C UPDATED--APRIL 1990 ADD LIST OF UNSET VARAIBLES (FROM IBM-PC) C UPDATED--APRIL 1990 DEFINE CPUMIN C UPDATED--APRIL 1990 PUT DISK & DIRECTORY FOR HELP, MESS., ETC. FED FILES C UPDATED--APRIL 1990 ALLOW EXRR FILE.EXT PLUS OLD EXRR C UPDATED--APRIL 1990 EXTEND OLD EXRR (NO ARGS) TO EXRR FILE.EXT C UPDATED--APRIL 1990 ZX COMMANDS = CALL ZX. COMMANDS C UPDATED--MARCH 1991 ADD BYTE NUMBER TO STATUS C UPDATED--MARCH 1991 \EDITOR CHANGED TO \FED FOR I/O C UPDATED--JULY 1992 STOP SWITCH SO EXIT FROM EDMAIN C UPDATED--JULY 1992 FIX ER INFINITE LOOP PROBLEM C UPDATED--AUGUST 1992 MODIFY FILE NAMES FOR PORTABILITY C UPDATED--AUGUST 1992 RENAME TO AVOID DATAPLOT CONFLICTS C MAXCHA => MAXEDC C MAXLIN => MAXEDL C MAXCOM => MAXCMN C UPDATED--APRIL 1993 DEFINE IMASK (WAS DONE IN EDINIT) C UPDATED--APRIL 1993 DEFINE UNIX FILES C UPDATED--MAY 1993 GUI/MENU C UPDATED--JULY 1993 DEFINE IRD, IPR, ETC. C ONLY IF STAND-ALONE FED C UPDATED--JULY 1993 DEFINE NON-PRINTING ASCII CHARACTERS C ONLY IF STAND-ALONE FED C UPDATED--JULY 1993 DEFINE HOST C ONLY IF STAND-ALONE FED C UPDATED--AUGUST 1993 COMPILE ERROR ON RS-6000 C C--------------------------------------------------------------------- C CCCCC THE FOLLOWING 2 LINES WERE ADDED JULY 1992 CHARACTER*4 ISOURC CHARACTER*80 IEDINA CCCCC THE FOLLOWING LINE WAS ADDED JULY 1993 CHARACTER*4 IDPSW C CHARACTER*80 IFILE CHARACTER*12 ISTAT CHARACTER*12 IFORM CHARACTER*12 IACCES CHARACTER*12 IREWR CHARACTER*4 ISUBN0 CHARACTER*4 IERRFI CHARACTER*4 IENDFI CHARACTER*4 IREWIN C CHARACTER*4 ID CHARACTER*4 IHNAME CHARACTER*4 IHNAM2 CHARACTER*4 IUSE CHARACTER*12 ITEMP C CHARACTER*4 IEOF CHARACTER*4 ILCSW CHARACTER*1 IANS0 CHARACTER*1 IANSV C CHARACTER*4 IBLASW C CHARACTER*4 IEXEIM C CHARACTER*240 ICTEMP C CHARACTER*10 ICSEQN C CHARACTER*4 IERASW C CHARACTER*4 IMANUF CHARACTER*4 IMODEL C CHARACTER*4 IHARLC CHARACTER*4 IHARL2 C CHARACTER*4 IEXESL CHARACTER*4 IEXIST C CCCCC THE FOLLOWING LINE WAS ADDED APRIL 1990 CHARACTER*4 ICJUNK C CCCCC THE FOLLOWING 5 LINES WERE ADDED MAY 1990 CHARACTER*80 ITEMNA CHARACTER*12 ITEMST CHARACTER*12 ITEMFO CHARACTER*12 ITEMAC CHARACTER*12 ITEMRW C CCCCC THE FOLLOWING LINE WAS ADDED JULY 1992 CHARACTER*4 STOPSW C CCCCC THE FOLLOWING 3 LINES WERE ADDED AUGUST 1992 CHARACTER*6 INAME CHARACTER*4 IBUGIN CCCCC OCTOBER 1993. FOLLOWING IS DECLARED IN EDCOMM.INC CCCCC CHARACTER*80 IEDDIR CHARACTER*80 IEDDI2 C CCCCC THE FOLLOWING 2 LINES WERE ADDED (FOR GUI/MENU) MAY 1993 CHARACTER*80 IB CHARACTER*80 STRING CCCCC AUGUST 1993. ADD FOLLOWING TO AVOID COMPILE ERROR CHARACTER*4 IMODE1 CHARACTER*4 IMODE2 CHARACTER*4 ISITE1 CHARACTER*4 ISITE2 CCCCC END CHANGE C DIMENSION IHNAME(100) DIMENSION IHNAM2(100) DIMENSION IUSE(100) DIMENSION IVALUE(100) DIMENSION VALUE(100) C DIMENSION IANS0(240) DIMENSION IANSV(240) C DIMENSION IHARLC(100) DIMENSION IHARL2(100) C CHARACTER*4 ISUBN1 CHARACTER*4 ISUBN2 CHARACTER*4 ISTEPN C C-----COMMON VARIABLES (EDITING)----------------------------------------------- C INCLUDE 'DPCOPA.INC' INCLUDE 'DPCOHO.INC' INCLUDE 'DPCONP.INC' INCLUDE 'EDCOMM.INC' CCCCC THE FOLLOWING LINE WAS ADDED (FOR MENU/GUI) MAY 1993 INCLUDE 'DPCODV.INC' C C-----COMMON VARIABLES (GENERAL)----------------------------------------------- C COMMON /MACH/IRD,IPR,CPUMIN,CPUMAX,NUMBPC,NUMCPW,NUMBPW C C-----START POINT------------------------------------------- C ISUBN1='EDMA' ISUBN2='I2 ' C CCCCC THE FOLLOWING SECTION OF SETTINGS WERE ADDED APRIL 1990 CCCCC AS A RESULT OF UNSET VARIABLES AS DETECTED CCCCC BY THE OTG COMPILER ON MY IBM-PC 386 C NUMNAM=0 NUMINL=0 MAXINL=0 MAXCPL=0 IWIDTH=0 IPRINT=' ' IP2LI1=0 IP2LI1=0 IMAX=0 IFLIM1=0 IFLIM2=0 ICERAS=' ' IBLIM1=0 IBLIM2=0 C C ICOLL1=1 ICOLL2=50 IBLASW='YES' C IEXEIM='NO' C IWIDSV=240 C IPPLIN=50 IPPOFF=0 IERASW='ON' C ILPOFF=0 C IEXESL='-999' IEXIST='-999' C IPASS=0 C 1000 CONTINUE C CCCCC IF NON-DATAPLOT, THEN DEFINE IRD, IRP, ETC. JULY 1993 IF(IDPSW.EQ.'OFF')THEN IRD=5 IPR=6 C NUMBPC=8 NUMCPW=4 NUMBPW=32 C CPUMAX=10.0**15 CCCCC THE FOLLOWING LINE WAS ADDED APRIL 1990 CPUMIN=(-CPUMAX) ENDIF C CCCCC IF NON-DATAPLOT, THEN DEFINE NON-PRINTING ASCII CHAR. JULY 1993 IF(IDPSW.EQ.'OFF')THEN INULC=CHAR(0) ISOHC=CHAR(1) ISTXC=CHAR(2) IETXC=CHAR(3) IEOTC=CHAR(4) IENQC=CHAR(5) IACKC=CHAR(6) IBELC=CHAR(7) IBSC=CHAR(8) IHTC=CHAR(9) ILFC=CHAR(10) IVTC=CHAR(11) IFFC=CHAR(12) ICRC=CHAR(13) ISOC=CHAR(14) ISIC=CHAR(15) IDLEC=CHAR(16) IDC1C=CHAR(17) IDC2C=CHAR(18) IDC3C=CHAR(19) IDC4C=CHAR(20) INAKC=CHAR(21) ISYNC=CHAR(22) IETBC=CHAR(23) ICANC=CHAR(24) IEMC=CHAR(25) ISUBC=CHAR(26) IESCC=CHAR(27) IFSC=CHAR(28) IGSC=CHAR(29) IRSC=CHAR(30) IUSC=CHAR(31) ENDIF C CCCCC IF NON-DATAPLOT, THEN DEFINE THE HOST JULY 1993 IF(IDPSW.EQ.'OFF')THEN IHOST1='IBM-' IHOST2='PC ' CCCCC IHOST1='UNIX' CCCCC IHOST2=' ' IMANUF='TEKT' IMODEL='4014' ENDIF C IF(IDPSW.EQ.'OFF')THEN IMODE1=' ' IMODE2=' ' IOPSY1=' ' IOPSY2=' ' ISITE1=' ' ISITE2=' ' ENDIF C CALL EDINIT C CCCCC THE FOLLOWING LINE IS DELIBERATEDLY SET AT A DOUBLE BACKSLASH CCCCC TO ACCOMODATE BOTH NON-UNIX AND UNIX MACHINES. APRIL 1993 CCCCC IT WILL GENERATE A COMPILER WARNING APRIL 1993 CCCCC (BUT WILL SUCCESFULLY COMPILE) ON AN IBM-PC. APRIL 1993 IMASK='\\' C CCCCC AUGUST 1992. FOLLOWING SECTION MODIFIED. FOR BETTER PORTABILITY CCCCC AND EASIER INSTALLATION, DEFINE CCCCC EDITOR DIRECTOR IEDDIR CCCCC AND EDITOR PATH NAME IED CCCCC AND EDITOR CASE (PPER/LOWER) IEDCAS CCCCC AND EDITRO FILE EXTENSION IEDEXT CCCCC INITFO, USE THOSE NAMES HERE TO DEFINE THE FILES. USE SAME CCCCC SCHEME AS INITFO. C IBUGIN='OFF' CCCCC FEBRUARY 1995. COMMENT OUT FOLLOWING LINE (DONE IN INITFO). CCCCC FOLLOWING LINE WIPES OUT DEFINITION IN INITFO. CCCCC DEFINE IEDDI2 TO BE NULL FOR FILES FOUND IN CURRENT DIRECTORY CCCCC IEDDIR=' ' IEDDI2=' ' NCNULL=0 C CCCCC THE FOLLOWING 6 LINES WERE ADDED MAY 1990 ITEMNU=20 CCCCC ITEMNA='C:\FED\FEDARG.TEX' INAME='FEDARG' IF(IEDCAS.EQ.'LOWE')INAME='fedarg' NC=6 CALL INITF2(INAME,NC,IEDDIR,NCEDT1,IEDEXT,NCEDT2,ITEMNA,IBUGIN) C ITEMST='UNKNOWN' ITEMFO='FORMATTED' ITEMAC='SEQUENTIAL' ITEMRW='READONLY' C IORINU=21 IORINA='-999' IORIST='NEW' IF(IHOST1.EQ.'HONE')IORIST='UNKNOWN' IF(IHOST1.EQ.'PERK')IORIST='UNKNOWN' IF(IHOST1.EQ.'NVE')IORIST='UNKNOWN' IF(IHOST1.EQ.'205')IORIST='UNKNOWN' IF(IHOST1.EQ.'CDC')IORIST='UNKNOWN' IF(IHOST1.EQ.'IBM-')IORIST='UNKNOWN' IF(IOPSY1.EQ.'UNIX')IORIST='UNKNOWN' IORIFO='FORMATTED' IORIAC='SEQUENTIAL' IORIRW='READWRITE' C ISAVNU=22 CCCCC ISAVNA='EDSAVE.TEX' INAME='EDSAVE' IF(IEDCAS.EQ.'LOWE')INAME='edsave' NC=6 CCCCC CALL INITF2(INAME,NC,IEDDIR,NCNULL,IEDEXT,NCEDT2,ISAVNA,IBUGIN) CALL INITF2(INAME,NC,IEDDI2,NCNULL,IEDEXT,NCEDT2,ISAVNA,IBUGIN) C CCCCC ISAVST='UNKNOWN' ISAVST='NEW' IF(IHOST1.EQ.'HONE')ISAVST='UNKNOWN' IF(IHOST1.EQ.'PERK')ISAVST='UNKNOWN' IF(IHOST1.EQ.'NVE')ISAVST='UNKNOWN' IF(IHOST1.EQ.'205')ISAVST='UNKNOWN' IF(IHOST1.EQ.'CDC')ISAVST='UNKNOWN' IF(IHOST1.EQ.'IBM-')ISAVST='UNKNOWN' IF(IOPSY1.EQ.'UNIX')ISAVST='UNKNOWN' ISAVFO='FORMATTED' ISAVAC='SEQUENTIAL' ISAVRW='READWRITE' C IHELNU=23 CCCCC IHELNA='FED$:EDHELP.TEX' CCCCC THE FOLLOWING LINE WAS FIXED APRIL 1990 FOR MY IBM-PC 386 CCCCC IF(IHOST1.EQ.'IBM-')IHELNA='EDHELP.TEX' CCCCC IF(IHOST1.EQ.'IBM-')IHELNA='C:\FED\EDHELP.TEX' INAME='EDHELP' IF(IEDCAS.EQ.'LOWE')INAME='edhelp' NC=6 CALL INITF2(INAME,NC,IEDDIR,NCEDT1,IEDEXT,NCEDT2,IHELNA,IBUGIN) C CCCCC IHELST='UNKNOWN' IHELST='OLD' IHELFO='FORMATTED' IHELAC='SEQUENTIAL' IHELRW='READONLY' C ICOPNU=24 CCCCC ICOPNA='EDCOPY.TEX' INAME='EDCOPY' IF(IEDCAS.EQ.'LOWE')INAME='edcopy' NC=6 CCCCC CALL INITF2(INAME,NC,IEDDIR,NCNULL,IEDEXT,NCEDT2,ICOPNA,IBUGIN) CALL INITF2(INAME,NC,IEDDI2,NCNULL,IEDEXT,NCEDT2,ICOPNA,IBUGIN) C CCCCC ICOPST='UNKNOWN' ICOPST='NEW' IF(IHOST1.EQ.'HONE')ICOPST='UNKNOWN' IF(IHOST1.EQ.'PERK')ICOPST='UNKNOWN' IF(IHOST1.EQ.'NVE')ICOPST='UNKNOWN' IF(IHOST1.EQ.'205')ICOPST='UNKNOWN' IF(IHOST1.EQ.'CDC')ICOPST='UNKNOWN' IF(IHOST1.EQ.'IBM-')ICOPST='UNKNOWN' IF(IOPSY1.EQ.'UNIX')ICOPST='UNKNOWN' ICOPFO='FORMATTED' ICOPAC='SEQUENTIAL' ICOPRW='READWRITE' C ICOMNU=25 CCCCC ICOMNA='EDCOMM.TEX' INAME='EDCOMM' IF(IEDCAS.EQ.'LOWE')INAME='edcomm' NC=6 CCCCC CALL INITF2(INAME,NC,IEDDIR,NCNULL,IEDEXT,NCEDT2,ICOMNA,IBUGIN) CALL INITF2(INAME,NC,IEDDI2,NCNULL,IEDEXT,NCEDT2,ICOMNA,IBUGIN) C CCCCC ICOMST='UNKNOWN' ICOMST='NEW' IF(IHOST1.EQ.'HONE')ICOMST='UNKNOWN' IF(IHOST1.EQ.'PERK')ICOMST='UNKNOWN' IF(IHOST1.EQ.'NVE')ICOMST='UNKNOWN' IF(IHOST1.EQ.'205')ICOMST='UNKNOWN' IF(IHOST1.EQ.'CDC')ICOMST='UNKNOWN' IF(IHOST1.EQ.'IBM-')ICOMST='UNKNOWN' IF(IOPSY1.EQ.'UNIX')ICOMST='UNKNOWN' ICOMFO='FORMATTED' ICOMAC='SEQUENTIAL' ICOMRW='READWRITE' C ICALNU=26 CCCCC ICALNA='EDCALL.TEX' INAME='EDCALL' IF(IEDCAS.EQ.'LOWE')INAME='edcall' NC=6 CCCCC CALL INITF2(INAME,NC,IEDDIR,NCNULL,IEDEXT,NCEDT2,ICALNA,IBUGIN) CALL INITF2(INAME,NC,IEDDI2,NCNULL,IEDEXT,NCEDT2,ICALNA,IBUGIN) C CCCCC ICALST='UNKNOWN' ICALST='OLD' ICALFO='FORMATTED' ICALAC='SEQUENTIAL' CCCCC ICALRW='READWRITE' ICALRW='READONLY' C IPRINU=27 IF(IHOST1.EQ.'IBM-')THEN IPRINA='PRN' ELSE IPRINA='PRINT.DAT' ENDIF CCCCC FEBRUARY 1995. REVERT TO UNKNOWN. PRINTER OUTPUT WILL BE SENT CCCCC TO FILE ON NON-PC SYSTEMS. IF(IHOST1.EQ.'IBM-')THEN IPRIST='OLD' ELSE IPRIST='UNKNOWN' ENDIF IPRIFO='FORMATTED' IPRIAC='SEQUENTIAL' IPRIRW='READWRITE' C ILISNU=28 CCCCC ILISNA='EDLIST.TEX' INAME='EDLIST' IF(IEDCAS.EQ.'LOWE')INAME='edlist' NC=6 CCCCC CALL INITF2(INAME,NC,IEDDIR,NCNULL,IEDEXT,NCEDT2,ILISNA,IBUGIN) CALL INITF2(INAME,NC,IEDDI2,NCNULL,IEDEXT,NCEDT2,ILISNA,IBUGIN) C CCCCC ILISST='UNKNOWN' ILISST='OLD' ILISFO='FORMATTED' ILISAC='SEQUENTIAL' ILISRW='READONLY' C IMESNU=29 CCCCC THE FOLLOWING LINE WAS FIXED APRIL 1990 FOR MY IBM-PC 386 CCCCC IF(IHOST1.EQ.'IBM-')IMESNA='EDMESS.TEX' CCCCC IF(IHOST1.EQ.'IBM-')IMESNA='C:\FED\EDMESS.TEX' INAME='EDMESS' IF(IEDCAS.EQ.'LOWE')INAME='edmess' NC=6 CALL INITF2(INAME,NC,IEDDIR,NCEDT1,IEDEXT,NCEDT2,IMESNA,IBUGIN) C CCCCC IMESST='UNKNOWN' IMESST='OLD' IMESFO='FORMATTED' IMESAC='SEQUENTIAL' IMESRW='READONLY' C ISYSNU=30 CCCCC THE FOLLOWING LINE WAS FIXED APRIL 1990 FOR MY IBM-PC 386 CCCCC IF(IHOST1.EQ.'IBM-')ISYSNA='EDSYST.TEX' CCCCC IF(IHOST1.EQ.'IBM-')ISYSNA='C:\FED\EDSYST.TEX' INAME='EDSYST' IF(IEDCAS.EQ.'LOWE')INAME='edsyst' NC=6 CALL INITF2(INAME,NC,IEDDIR,NCEDT1,IEDEXT,NCEDT2,ISYSNA,IBUGIN) C CCCCC ISYSST='UNKNOWN' ISYSST='OLD' ISYSFO='FORMATTED' ISYSAC='SEQUENTIAL' ISYSRW='READONLY' C ILOGNU=31 CCCCC ILOGNA='EDLOGI.TEX' CCCCC THE FOLLOWING LINE WAS FIXED APRIL 1990 FOR MY IBM-PC 386 CCCCC IF(IHOST1.EQ.'IBM-')ILOGNA='EDLOGI.TEX' CCCCC IF(IHOST1.EQ.'IBM-')ILOGNA='C:\FED\EDLOGI.TEX' INAME='EDLOGI' IF(IEDCAS.EQ.'LOWE')INAME='edlogi' NC=6 CCCCC FEBRUARY 1995. FOR PC, EDLOGI IN FED DIRECTORY. FOR NON-PC, CCCCC GET EDLOGI FROM CURRENT DIRECTORY (TO ALLOW USER TO CHANGE). IF(IHOST1.EQ.'IBM-')THEN CALL INITF2(INAME,NC,IEDDIR,NCEDT1,IEDEXT,NCEDT2,ILOGNA,IBUGIN) ELSE CALL INITF2(INAME,NC,IEDDI2,NCNULL,IEDEXT,NCEDT2,ILOGNA,IBUGIN) ENDIF C CCCCC ILOGST='UNKNOWN' ILOGST='OLD' ILOGFO='FORMATTED' ILOGAC='SEQUENTIAL' ILOGRW='READONLY' C INEWNU=32 CCCCC THE FOLLOWING LINE WAS FIXED APRIL 1990 FOR MY IBM-PC 386 CCCCC IF(IHOST1.EQ.'IBM-')INEWNA='EDNEWS.TEX' CCCCC IF(IHOST1.EQ.'IBM-')INEWNA='C:\FED\EDNEWS.TEX' CCCCC IF(IHOST1.EQ.'HONE')INEWNA='ednews.text' INAME='EDNEWS' IF(IEDCAS.EQ.'LOWE')INAME='ednews' NC=6 CALL INITF2(INAME,NC,IEDDIR,NCEDT1,IEDEXT,NCEDT2,INEWNA,IBUGIN) C CCCCC INEWST='UNKNOWN' INEWST='OLD' INEWFO='FORMATTED' INEWAC='SEQUENTIAL' INEWRW='READONLY' C IOPENU=33 IF(IHOST1.EQ.'IBM-')THEN IOPENA='PRN' IOPEST='OLD' ELSE IOPENA='PRINT.DAT' IOPEST='UNKNOWN' END IF IOPEFO='FORMATTED' IOPEAC='SEQUENTIAL' IOPERW='READWRITE' C ICOM=' ' ICOM2=' ' ICOMT='-999' ICOMI=(-999) ACOM=(-999.0) C C ---------- C NUMCHA=10 ICHA(1)='A' ICHA(2)='B' ICHA(3)='C' ICHA(4)='D' ICHA(5)='E' ICHA(6)='F' ICHA(7)='G' ICHA(8)='H' ICHA(9)='I' ICHA(10)='J' C NUMLIN=4 C NUMROW=4 IPOINT(1)=1 IPOINT(2)=2 IPOINT(3)=3 IPOINT(4)=4 C ILOCC1(1)=1 ILOCC1(2)=4 ILOCC1(3)=6 ILOCC1(4)=8 C NUMCPL(1)=3 NUMCPL(2)=2 NUMCPL(3)=2 NUMCPL(4)=3 C ICURLN=1 C IEOF='NO' IECHSW='OFF' ILCSW='OFF' C NUMCOM=0 CCCCC MAXCMN=100 JULY 1993 DO310I=1,MAXCMN ICOM3(I)=' ' ICOM4(I)=' ' ICOM5(I)=' ' NCOM5(I)=0 310 CONTINUE C C THE INTEGER VARIABLE ISEQNU IS THE CURRENT SEQUENCE NUMBER C THAT IS USED IN THE CHANGE COMMAND C TO DO AUTOMATIC SEQUENCING C AS IN LS XXXXXX C ISEQNU=1 ICSEQN='1 ' NCSEQN=1 C IPRISW='OFF' C CCCCC THE FOLLOWING LINE WAS ADDED JULY 1992 C STOPSW='NO' C C ---------- C C ******************************************************** C ** STEP 0.5-- C ** (FOR NBS UNIVAC COMPUTER ONLY) C ** HAVE A DUMMY READ OF 1 LINE AFTER THE EDITOR HEADER C ** TO ABSORB AN EXTRANEOUS LINE GENERATED C ** BY THE UNIVAC SYSTEM SOFTWARE WHEN FIRST ACCESSING T C ** VIA @FED. C ******************************************************** C IF(IHOST1.EQ.'UNIV')READ(IRD,501) 501 FORMAT(1X) C C **************************************************** C ** STEP 0.6-- ** C ** IF A SIGN-ON MESSAGE FILE ** C ** (CONSISTING OF CURRENT EDITOR INFORMATION) ** C ** EXISTS AT THIS COMPUTER INSTALLATION, ** C ** WRITE OUT SUCH MESSAGES FOR THE ANALYST'S ** C ** PERUSAL ** C **************************************************** C ISTEPN='0.6' IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL EDTRA3(ISTEPN,ISUBN1,ISUBN2) C IF(IMESST.EQ.'NONE')GOTO690 CCCCC IBUGS2='ON' IF(IPASS.LE.1)CALL EDLIME 690 CONTINUE C C **************************** C ** STEP 11-- ** C ** READ IN BUG SWITCHES ** C **************************** C CCCCC CALL EDERAS(IMANUF,IMODEL) AUGUST 14, 1986 C IPASS=IPASS+1 IF(IPASS.GE.2)GOTO1190 C CCCCC IBUGED='ON' CCCCC IBUGE2='ON' CCCCC IBUGE3='ON' CCCCC IBUGMA='ON' C 1190 CONTINUE C C ************************************** C ** STEP 12-- ** C ** READ IN FILE NAME TO BE EDITED ** C ** AND DETERMINE STATUS OF FILE ** C ************************************** C CCCCC THE FOLLOWING SECTION WAS REWRITTEN JULY 1992 CCCCC NUMCFI=80 CCCCC IF(IHOST1.EQ.'VAX')GOTO1220 CCCCC GOTO1223 C C1220 CONTINUE CCCCC IF(IHOST1.EQ.'VAX'.AND.IPASS.EQ.1)CALL EDGETF(IORINA) CCCCC IF(IPASS.EQ.1)GOTO1229 CCCCC WRITE(ICOUT,1221) C1221 FORMAT('NAME OF FILE TO BE EDITED = ?') CCCCC READ(IRD,1222)IORINA C1222 FORMAT(A80) CCCCC GOTO1229 C NUMCFI=80 C IF(IHOST1.EQ.'VAX')THEN IF(IPASS.EQ.1)THEN CALL EDGETF(IORINA) GOTO1229 ENDIF WRITE(ICOUT,1221) 1221 FORMAT('NAME OF FILE TO BE EDITED = ?') CALL EDWRST('EDMAI2') READ(IRD,1222)IORINA 1222 FORMAT(A80) GOTO1229 ENDIF C CCCCC THE FOLLOWING SECTION IS FOR NON-VAX (ESPECIALLY IBM-PC) CCCCC THE FOLLOWING SECTION (TO 1229 CONTINUE) WAS CHANGED MAY 1990 CCCCC THE FOLLOWING SECTION WAS CHANGED JULY 1992 C IF(ISOURC.EQ.'SUBR')THEN IORINA=IEDINA ENDIF C IF(ISOURC.EQ.'FILE')THEN IOUNIT=ITEMNU IFILE=ITEMNA ISTAT=ITEMST IFORM=ITEMFO IACCES=ITEMAC IREWR=ITEMRW ISUBN0='MAIN' IERRFI='NO' C CALL EDINFI(IFILE,IEXIST,ISUBN0,IERRFI) CCCCC INQUIRE(FILE=IFILE,EXIST=ILEXIS,IOSTAT=IOS) IF(IEXIST.EQ.'YES')GOTO1224 GOTO1226 C 1224 CONTINUE CCCCC WRITE(ICOUT,777)IEXIST CC777 FORMAT('IEXIST = ',A4) CALL EDOPFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IREWR,ISUBN0, 1 IERRFI) READ(IOUNIT,1225)IORINA 1225 FORMAT(A80) CCCCC WRITE(ICOUT,778)IORINA CC778 FORMAT('FILE = ',A80) CALL EDCLFI(IOUNIT,IENDFI,IREWIN) IF(IORINA(1:4).EQ.' ')GOTO1226 GOTO1229 1226 CONTINUE WRITE(ICOUT,1227) 1227 FORMAT('NAME OF FILE TO BE EDITED = ?') CALL EDWRST('EDMAI2') READ(IRD,1228)IORINA 1228 FORMAT(A80) GOTO1229 ENDIF C 1229 CONTINUE C DO1235I=1,NUMCFI IREV=NUMCFI-I+1 IF(IORINA(IREV:IREV).NE.' ')GOTO1239 1235 CONTINUE IREV=0 1239 CONTINUE NUMCFI=IREV C ITEMP=IORIST IORIST='UNKNOWN' ID='ORIG' CALL EDREFW(ID) IORIST=ITEMP NUMLOR=NUMLIN C CCCCC ID='SAVE' CCCCC CALL EDWRWF(ID) C CCCCC WRITE(ICOUT,1241)IORINA C1241 FORMAT('FILE = ',A80) WRITE(ICOUT,1241)(IORINA(I:I),I=1,NUMCFI) 1241 FORMAT('FILE = ',80A1) CALL EDWRST('EDMAI2') CCCCC WRITE(ICOUT,1242)IORIST C1242 FORMAT('FILE STATUS = ',A4) WRITE(ICOUT,1243)NUMLIN 1243 FORMAT('NUMBER OF LINES = ',I8) CALL EDWRST('EDMAI2') C CCCCC WRITE(ICOUT,999) 999 FORMAT(1X) CCCCC WRITE(ICOUT,1251) C1251 FORMAT('YOU ARE IN EDIT MODE--') WRITE(ICOUT,1251) 1251 FORMAT('MODE (EDIT/INPUT) = EDIT') CALL EDWRST('EDMAI2') CCCCC WRITE(ICOUT,1252) C1252 FORMAT(' TO TOGGLE INTO INPUT MODE, ENTER INPUT') CCCCC WRITE(ICOUT,1253) C1253 FORMAT(' TO TOGGLE BACK TO EDIT MODE, ENTER EDIT') CCCCC WRITE(ICOUT,1254) C1254 FORMAT('FOR GENERAL ON-LINE ASSISTANCE, ENTER HELP') CCCCC WRITE(ICOUT,999) C NUMARG=0 CALL EDPRIN C C ********************************************** C ** STEP 13-- ** C ** OPEN THE COMMAND-SAVE (= JOURNAL) FILE ** C ********************************************** C ISTEPN='13' IF(IBUGFI.EQ.'ON'.OR.ISUBRO.EQ.'CALL') 1CALL EDTRA3(ISTEPN,ISUBN1,ISUBN2) C IOUNIT=ICOMNU IFORM=ICOMFO IFILE=ICOMNA ISTAT=ICOMST IACCES=ICOMAC IREWR=ICOMRW ISUBN0='MAIN' IERRFI='NO' C IF(IORINA.NE.ICOMNA.AND.IORINA.NE.ISAVNA) 1CALL EDOPFI(IOUNIT,IFILE,ISTAT,IFORM,IACCES,IREWR,ISUBN0,IERRFI) C C ************************************************************* C ** STEP 14-- ** C ** GENERATE A COMMAND STATEMENT (AND THEN EXECUTE IT) ** C ** WHICH STATES THAT WE SHOULD CALL EDSYST.TEX ** C ** (THIS ALLOWS US TO EXECUTE A SYSTEM "LOGIN" FILE ** C ** WHEN SIGNING ONT THE EDITOR WHICH IN TURN ALLOWS ** C ** AN IMPLEMENTORTO EASILY TAILOR THE EDITOR ** C ** FOR AN INDIVIDUAL SITE). ** C ************************************************************* C ISTEPN='14' IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL EDTRA3(ISTEPN,ISUBN1,ISUBN2) C ICTEMP(1:5)='CALL ' ICTEMP(6:85)=ISYSNA(1:80) NCTEMP=85 IF(IPASS.LE.1)CALL EDCOST(ICTEMP,NCTEMP) IEXEIM='YES' IEXESL='YES' GOTO2300 C C ************************************************************* C ** STEP 15-- ** C ** GENERATE A COMMAND STATEMENT (AND THEN EXECUTE IT) ** C ** WHICH STATES THAT WE SHOULD CALL EDLOGI.TEX ** C ** (THIS ALLOWS US TO EXECUTE A USER "LOGIN" FILE ** C ** WHEN SIGNING ONTO THE EDITOR WHICH IN TURN ALLOWS ** C ** A USER TO EASILY TAILOR THE EDITOR ** C ************************************************************* C 1500 CONTINUE ISTEPN='15' IF(IBUGMA.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL EDTRA3(ISTEPN,ISUBN1,ISUBN2) C IOUNIT=ILOGNU IFORM=ILOGFO IFILE=ILOGNA ISTAT=ILOGST IACCES=ILOGAC IREWR=ILOGRW ISUBN0='MAIN' IERRFI='NO' C CALL EDINFI(IFILE,IEXIST,ISUBN0,IERRFI) IF(IERRFI.EQ.'YES')GOTO1590 IF(IEXIST.EQ.'NO')GOTO1590 C ICTEMP(1:5)='CALL ' ICTEMP(6:85)=ILOGNA(1:80) NCTEMP=85 IF(IPASS.LE.1)CALL EDCOST(ICTEMP,NCTEMP) IEXEIM='YES' GOTO2300 C 1590 CONTINUE C C ************************** C ** STEP 21-- ** C ** WRITE OUT A PROMPT ** C ************************** C 2100 CONTINUE IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN')THEN WRITE(ICOUT,999) CALL EDWRST('EDMAI2') WRITE(ICOUT,2101) 2101 FORMAT('----------START OF NEW CYCLE----------') CALL EDWRST('EDMAI2') ENDIF C ISTEPN='21' IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL EDTRA3(ISTEPN,ISUBN1,ISUBN2) IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN')THEN WRITE(ICOUT,2102)ICCALL,ICXQT,ILCSW,IEOF,IPROSW 2102 FORMAT('ICCALL,ICXQT,ILCSW,IEOF,IPROSW = ', 1 A4,2X,A4,2X,A4,2X,A4,2X,A4) CALL EDWRST('EDMAI2') ENDIF C CCCCC IPRISW='OFF' IALL='OFF' IEOF='NO' C IF(ICCALL.EQ.'ON')GOTO2190 C IF(IPROSW.EQ.'ON')GOTO2110 GOTO2190 C 2110 CONTINUE IF(IMODE.EQ.'EDIT')GOTO2120 GOTO2140 C 2120 CONTINUE IF(IHOST1.EQ.'VAX ')GOTO2130 IF(0.LE.ICURLN.AND.ICURLN.LE.9)THEN WRITE(ICOUT,2121)ICURLN 2121 FORMAT(5X,I1,'> ') CALL EDWRST('EDMAI2') ENDIF IF(10.LE.ICURLN.AND.ICURLN.LE.99)THEN WRITE(ICOUT,2122)ICURLN 2122 FORMAT(4X,I2,'> ') CALL EDWRST('EDMAI2') ENDIF IF(100.LE.ICURLN.AND.ICURLN.LE.999)THEN WRITE(ICOUT,2123)ICURLN 2123 FORMAT(3X,I3,'> ') CALL EDWRST('EDMAI2') ENDIF IF(1000.LE.ICURLN.AND.ICURLN.LE.9999)THEN WRITE(ICOUT,2124)ICURLN 2124 FORMAT(2X,I4,'> ') CALL EDWRST('EDMAI2') ENDIF IF(10000.LE.ICURLN.AND.ICURLN.LE.99999)THEN WRITE(ICOUT,2125)ICURLN 2125 FORMAT(1X,I5,'> ') CALL EDWRST('EDMAI2') ENDIF GOTO2190 C 2130 CONTINUE IF(0.LE.ICURLN.AND.ICURLN.LE.9)THEN WRITE(ICOUT,2131)ICURLN 2131 FORMAT(5X,I1,'> ') CALL EDWRST('EDMAI2') ENDIF IF(10.LE.ICURLN.AND.ICURLN.LE.99)THEN WRITE(ICOUT,2132)ICURLN 2132 FORMAT(4X,I2,'> ') CALL EDWRST('EDMAI2') ENDIF IF(100.LE.ICURLN.AND.ICURLN.LE.999)THEN WRITE(ICOUT,2133)ICURLN 2133 FORMAT(3X,I3,'> ') CALL EDWRST('EDMAI2') ENDIF IF(1000.LE.ICURLN.AND.ICURLN.LE.9999)THEN WRITE(ICOUT,2134)ICURLN 2134 FORMAT(2X,I4,'> ') CALL EDWRST('EDMAI2') ENDIF IF(10000.LE.ICURLN.AND.ICURLN.LE.99999)THEN WRITE(ICOUT,2135)ICURLN 2135 FORMAT(1X,I5,'> ') CALL EDWRST('EDMAI2') ENDIF GOTO2190 C 2140 CONTINUE ICURLP=ICURLN+1 IF(IHOST1.EQ.'VAX ')GOTO2140 IF(0.LE.ICURLP.AND.ICURLP.LE.9)THEN WRITE(ICOUT,2141)ICURLP 2141 FORMAT(5X,I1,'> ') CALL EDWRST('EDMAI2') ENDIF IF(10.LE.ICURLP.AND.ICURLP.LE.99)THEN WRITE(ICOUT,2142)ICURLP 2142 FORMAT(4X,I2,'> ') CALL EDWRST('EDMAI2') ENDIF IF(100.LE.ICURLP.AND.ICURLP.LE.999)THEN WRITE(ICOUT,2143)ICURLP 2143 FORMAT(3X,I3,'> ') CALL EDWRST('EDMAI2') ENDIF IF(1000.LE.ICURLP.AND.ICURLP.LE.9999)THEN WRITE(ICOUT,2144)ICURLP 2144 FORMAT(2X,I4,'> ') CALL EDWRST('EDMAI2') ENDIF IF(10000.LE.ICURLP.AND.ICURLP.LE.99999)THEN WRITE(ICOUT,2145)ICURLP 2145 FORMAT(1X,I5,'> ') CALL EDWRST('EDMAI2') ENDIF GOTO2190 C 2150 CONTINUE IF(0.LE.ICURLP.AND.ICURLP.LE.9)THEN WRITE(ICOUT,2151)ICURLP 2151 FORMAT(5X,I1,'> ') CALL EDWRST('EDMAI2') ENDIF IF(10.LE.ICURLP.AND.ICURLP.LE.99)THEN WRITE(ICOUT,2152)ICURLP 2152 FORMAT(4X,I2,'> ') CALL EDWRST('EDMAI2') ENDIF IF(100.LE.ICURLP.AND.ICURLP.LE.999)THEN WRITE(ICOUT,2153)ICURLP 2153 FORMAT(3X,I3,'> ') CALL EDWRST('EDMAI2') ENDIF IF(1000.LE.ICURLP.AND.ICURLP.LE.9999)THEN WRITE(ICOUT,2154)ICURLP 2154 FORMAT(2X,I4,'> ') CALL EDWRST('EDMAI2') ENDIF IF(10000.LE.ICURLP.AND.ICURLP.LE.99999)THEN WRITE(ICOUT,2155)ICURLP 2155 FORMAT(1X,I5,'> ') CALL EDWRST('EDMAI2') ENDIF GOTO2190 C 2190 CONTINUE C C ******************************** C ** STEP 22-- ** C ** READ IN A COMMAND LINE. ** C ** DETERMINE WHERE ITS LAST ** C ** NON-BLANK CHARACTER IS. ** C ******************************** C 2200 CONTINUE ISTEPN='22' IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL EDTRA3(ISTEPN,ISUBN1,ISUBN2) IWIDTH=80 DO2205I=1,IWIDTH IANS(I)=' ' 2205 CONTINUE C IF(ICXQT.EQ.'ON')GOTO2210 IF(ICCALL.EQ.'ON')GOTO2220 IF(TCMENU.EQ.'ON')GOTO2230 GOTO2280 C 2210 CONTINUE ISTEPN='22.1' IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL EDTRA3(ISTEPN,ISUBN1,ISUBN2) IWIDTH=(-999) IF(IXQT.EQ.1)IWIDTH=NCHH1 IF(IXQT.EQ.2)IWIDTH=NCHH2 IF(IXQT.EQ.3)IWIDTH=NCHH3 IF(IXQT.EQ.4)IWIDTH=NCHH4 IF(IXQT.EQ.5)IWIDTH=NCHH5 IF(IXQT.EQ.6)IWIDTH=NCHH6 IF(IXQT.EQ.7)IWIDTH=NCHH7 IF(IXQT.EQ.8)IWIDTH=NCHH8 IF(IXQT.EQ.9)IWIDTH=NCHH9 IF(IXQT.EQ.10)IWIDTH=NCHH10 IF(IWIDTH.LE.0)GOTO2219 DO2211I=1,IWIDTH IF(IXQT.EQ.1)IANS(I)=IHOLS1(I:I) IF(IXQT.EQ.2)IANS(I)=IHOLS2(I:I) IF(IXQT.EQ.3)IANS(I)=IHOLS3(I:I) IF(IXQT.EQ.4)IANS(I)=IHOLS4(I:I) IF(IXQT.EQ.5)IANS(I)=IHOLS5(I:I) IF(IXQT.EQ.6)IANS(I)=IHOLS6(I:I) IF(IXQT.EQ.7)IANS(I)=IHOLS7(I:I) IF(IXQT.EQ.8)IANS(I)=IHOLS8(I:I) IF(IXQT.EQ.9)IANS(I)=IHOLS9(I:I) IF(IXQT.EQ.10)IANS(I)=IHOL10(I:I) 2211 CONTINUE 2219 CONTINUE ICXQT='OFF' IXQT=(-999) GOTO2290 C 2220 CONTINUE ISTEPN='22.2' IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL EDTRA3(ISTEPN,ISUBN1,ISUBN2) READ(ICALNU,2221,END=2225)(IANS(I),I=1,IWIDTH) 2221 FORMAT(240A1) GOTO2290 C 2225 CONTINUE IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1WRITE(ICOUT,2226) 2226 FORMAT('-----AN END OF FILE WAS ENCOUNTERED-----') IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN')CALL EDWRST('EDMAI2') ISTEPN='2225' IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL EDTRA3(ISTEPN,ISUBN1,ISUBN2) IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1WRITE(ICOUT,2227)ICCALL,ICXQT,ILCSW,IEOF,IPROSW 2227 FORMAT('ICCALL,ICXQT,ILCSW,IEOF,IPROSW = ', 1A4,2X,A4,2X,A4,2X,A4,2X,A4) IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN')CALL EDWRST('EDMAI2') IEOF='YES' CCCCC REWIND ICALNU CCCCC CLOSE(UNIT=ICALNU) IOUNIT=ICALNU IENDFI='OFF' IREWIN='ON' CALL EDCLFI(IOUNIT,IENDFI,IREWIN) C ICCALL='OFF' IF(IEXESL.EQ.'YES')GOTO2228 GOTO2229 2228 CONTINUE IEXESL='DONE' GOTO1500 2229 CONTINUE IF(ILCSW.EQ.'EXMA')GOTO4100 GOTO2100 C CCCCC THE FOLLOWING SECTION WAS ADDED (FOR GUI/MENU) MAY 1993 2230 CONTINUE ISTEPN='22.3' IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL EDTRA3(ISTEPN,ISUBN1,ISUBN2) CALL TCGECO(IB,NUMCHA,IBUGE2,ISUBRO) IWIDTH=NUMCHA IF(NUMCHA.LE.0)GOTO2239 DO2231I=1,NUMCHA IANS(I)=IB(I:I) 2231 CONTINUE 2239 CONTINUE GOTO2290 C 2280 CONTINUE ISTEPN='22.8' IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL EDTRA3(ISTEPN,ISUBN1,ISUBN2) C CCCCC WRITE(IPR,777)LOOPCT CC777 FORMAT('FROM EDMAI2--LOOPCT = ',I8) IF(LOOPCT.GE.1)THEN DO2281I=1,LOOPIW IANS(I)=LOOPST(I:I) 2281 CONTINUE LOOPCT=LOOPCT-1 ELSE READ(IRD,2282,END=2285)(IANS(I),I=1,IWIDTH) 2282 FORMAT(240A1) ENDIF C GOTO2290 2285 CONTINUE WRITE(ICOUT,2286) 2286 FORMAT('-----AN END OF FILE WAS ENCOUNTERED-----') CALL EDWRST('EDMAI2') IF(IMODE.EQ.'INPU')CALL EDEDIT GOTO2100 C 2290 CONTINUE C C ********************************* C ** STEP 22A-- ** C ** SAVE THE COMMAND LINE ** C ********************************* C IF(IORINA.NE.ICOMNA.AND.IORINA.NE.ISAVNA) 1WRITE(ICOMNU,2291)(IANS(I),I=1,IWIDTH) 2291 FORMAT(80A1) C CCCCC THE FOLLOWING SECTION WAS ADDED (FOR GUI/MENU) MAY 1993 C ************************************************** C ** STEP 22B-- ** C ** WRITE OUT (= APPEND) THE COMMAND LINE ** C ** TO A COMPLETE COMMAND LOG FILE ** C ** SO AS TO ALLOW SCROLLING ON THE C-SIDE. ** C ************************************************** C IF(TCMENU.EQ.'ON')THEN DO2292I=1,80 STRING(I:I)=IANS(I) 2292 CONTINUE CALL TCWRCO(STRING,ISUBRO) ENDIF C C ********************************* C ** STEP 23-- ** C ** DEBLANK THE COMMAND LINE ** C ********************************* C 2300 CONTINUE ISTEPN='23' IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL EDTRA3(ISTEPN,ISUBN1,ISUBN2) IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1WRITE(ICOUT,2301)IWIDTH,IANS(1) 2301 FORMAT('IWIDTH,IANS(1) = ',I8,2X,A1) IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN')CALL EDWRST('EDMAI2') C IEXEIM='NO' CALL EDDEBL(IANS,IWIDTH) C C **************************************** C ** STEP 24-- ** C ** TREAT THE REPEAT (R) COMMAND CASE ** C **************************************** ISTEPN='24' IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL EDTRA3(ISTEPN,ISUBN1,ISUBN2) IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1WRITE(ICOUT,2401)IWIDTH,IANS(1) 2401 FORMAT('IWIDTH,IANS(1) = ',I8,2X,A1) IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN')CALL EDWRST('EDMAI2') C IF(IWIDTH.EQ.1.AND.IANS(1).EQ.'R')GOTO2410 IF(IWIDTH.EQ.1.AND.IANS(1).EQ.'r')GOTO2410 GOTO2420 C 2410 CONTINUE DO2411I=1,240 IANS(I)=IANSV(I) 2411 CONTINUE IWIDTH=IWIDSV GOTO2490 C 2420 CONTINUE DO2421I=1,240 IANSV(I)=IANS(I) 2421 CONTINUE IWIDSV=IWIDTH GOTO2490 C 2490 CONTINUE C C ********************************* C ** STEP 25-- ** C ** ECHO BACK THE COMMAND LINE ** C ** (IF CALLED FOR) ** C ********************************* C IF(IECHSW.EQ.'ON')CALL EDECCO C C ****************************************************** C ** STEP 26-- ** C ** DECOMPOSE THE INSTRUCTION LINE INTO COMPONENTS ** C ****************************************************** C 2600 CONTINUE ICOMT='-999' CALL EDTYPE(IHNAME,IHNAM2,IUSE,IVALUE,VALUE,NUMNAM) C C ***************************************** C ** STEP 27-- ** C ** CONVERT THE COMMAND AND ARGUMENTS ** C ** TO UPPER CASE ** C ***************************************** C CALL EDUPP4(ICOM,ICOM) CALL EDUPP4(ICOM2,ICOM2) C IF(NUMARG.LE.0)GOTO2790 DO2700I=1,NUMARG IHARLC(I)=IHARG(I) IHARL2(I)=IHARG2(I) CALL EDUPP4(IHARG(I),IHARG(I)) CALL EDUPP4(IHARG2(I),IHARG2(I)) 2700 CONTINUE 2790 CONTINUE C C ***************************************** C ** STEP 41-- ** C ** TREAT THE LOCATE-CALL CASE ** C ***************************************** C 4100 CONTINUE ISTEPN='41' IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL EDTRA3(ISTEPN,ISUBN1,ISUBN2) IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1WRITE(ICOUT,4101)ILCSW 4101 FORMAT('ILCSW = ',A4) IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN')CALL EDWRST('EDMAI2') IF(ILCSW.EQ.'OFF')GOTO4105 GOTO4106 4105 CONTINUE IF(ICOM.EQ.'LC')GOTO4110 GOTO4190 4106 CONTINUE IF(ILCSW.EQ.'EXLO')GOTO4120 IF(ILCSW.EQ.'CAMA')GOTO4130 IF(ILCSW.EQ.'EXMA'.AND.IEOF.EQ.'NO')GOTO4140 IF(ILCSW.EQ.'EXMA'.AND.IEOF.EQ.'YES')GOTO4150 GOTO4190 C 4110 CONTINUE ISTEPN='41.1' IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL EDTRA3(ISTEPN,ISUBN1,ISUBN2) IWIDT0=IWIDTH DO4111I=1,IWIDTH IANS0(I)=IANS(I) IF(IBUGED.EQ.'OFF'.AND.ISUBRO.EQ.'MAIN') 1WRITE(ICOUT,4112)I,IANS(I),IANS0(I) 4112 FORMAT('I,IANS(I),IANS0(I) = ',I8,2X,A1,2X,A1) IF(IBUGED.EQ.'OFF'.AND.ISUBRO.EQ.'MAIN')CALL EDWRST('EDMAI2') 4111 CONTINUE ILCSW='EXLO' GOTO4100 C 4120 CONTINUE ISTEPN='41.2' IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL EDTRA3(ISTEPN,ISUBN1,ISUBN2) IANS(1)='L' IANS(2)='O' IANS(3)=' ' IWIDTH=2 J=3 IF(IWIDT0.LT.4)GOTO4128 DO4121I=4,IWIDT0 IF(IANS0(I).EQ.' ')IWIDTH=J IF(IANS0(I).EQ.' ')GOTO4128 J=J+1 IANS(J)=IANS0(I) IF(IBUGED.EQ.'OFF'.AND.ISUBRO.EQ.'MAIN') 1WRITE(ICOUT,4122)I,J,IANS0(I),IANS(J) 4122 FORMAT('I,J,IANS0(I),IANS(J) = ',2I8,2X,A1,2X,A1) IF(IBUGED.EQ.'OFF'.AND.ISUBRO.EQ.'MAIN')CALL EDWRST('EDMAI2') 4121 CONTINUE IWIDTH=J 4128 CONTINUE ICOM='LO' CALL EDLOCA IF(IBUGED.EQ.'OFF'.AND.ISUBRO.EQ.'MAIN') 1WRITE(ICOUT,4129)ICURLN,NUMLIN 4129 FORMAT('ICURLN,NUMLIN = ',2I8) IF(IBUGED.EQ.'OFF'.AND.ISUBRO.EQ.'MAIN')CALL EDWRST('EDMAI2') ILCSW='CAMA' IF(ICURLN.GT.NUMLIN)ILCSW='OFF' IF(ICURLN.GT.NUMLIN)GOTO2100 GOTO4100 C 4130 CONTINUE ISTEPN='41.4' IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL EDTRA3(ISTEPN,ISUBN1,ISUBN2) IANS(1)='C' IANS(2)='A' IANS(3)='L' IANS(4)='L' IANS(5)=' ' IARGUM=1 J=5 IF(IWIDT0.LT.4)GOTO4134 DO4131I=4,IWIDT0 IF(IANS0(I).EQ.' ')IARGUM=IARGUM+1 IF(IARGUM.EQ.1)GOTO4131 IF(IARGUM.EQ.2.AND.IANS0(I).EQ.' ')GOTO4131 J=J+1 IANS(J)=IANS0(I) IF(IBUGED.EQ.'OFF'.AND.ISUBRO.EQ.'MAIN') 1WRITE(ICOUT,4132)I,J,IANS0(I),IANS(J) 4132 FORMAT('I,J,IANS0(I),IANS(J) = ',2I8,2X,A1,2X,A1) IF(IBUGED.EQ.'OFF'.AND.ISUBRO.EQ.'MAIN')CALL EDWRST('EDMAI2') 4131 CONTINUE 4134 CONTINUE IWIDTH=J ICOM='CALL' CALL EDCALL C IF(IERROR.EQ.'YES'.AND.IEXESL.EQ.'YES')GOTO4135 GOTO4136 4135 CONTINUE IEXESL='DONE' GOTO1500 4136 CONTINUE IF(IERROR.EQ.'YES')GOTO2100 ILCSW='EXMA' GOTO2100 C 4140 CONTINUE ISTEPN='41.5' IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL EDTRA3(ISTEPN,ISUBN1,ISUBN2) GOTO4190 C 4150 CONTINUE ISTEPN='41.6' IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL EDTRA3(ISTEPN,ISUBN1,ISUBN2) IEOF='NO' ILCSW='EXLO' GOTO4100 C 4190 CONTINUE ISTEPN='41.9' IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL EDTRA3(ISTEPN,ISUBN1,ISUBN2) C C ************************************************* C ** STEP 61-- ** C ** SEARCH FOR VARIOUS EDITOR INSTRUCTIONS ** C ** AND (IF FOUND) CARRY OUT THE INSTRUCTION. ** C ************************************************* C 6100 CONTINUE ISTEPN='61' IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1CALL EDTRA3(ISTEPN,ISUBN1,ISUBN2) IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN') 1WRITE(ICOUT,6101)ILCSW 6101 FORMAT('ILCSW = ',A4) IF(IBUGE2.EQ.'ON'.OR.ISUBRO.EQ.'MAIN')CALL EDWRST('EDMAI2') CCCCC IF(ICOM.EQ.'EXIT')GOTO9000 C IF(ICOM.EQ.'PP'.AND.IERASW.EQ.'ON')GOTO6110 GOTO6115 6110 CONTINUE ICOM='ERAS' ICOM2='E ' CALL EDSEUC IF(IFOUND.EQ.'NO')CALL EDERAS(IMANUF,IMODEL) ICOM='PP ' ICOM2=' ' GOTO6119 6115 CONTINUE CALL EDSEUC IF(IFOUND.EQ.'YES')GOTO6200 GOTO6119 6119 CONTINUE C CALL EDSEAR(IMARK,ICOLL1,ICOLL2,IBLASW,ISHIFN,IEXEIM, 1ISEQNU,ICSEQN,NCSEQN,IPPLIN,IPPOFF,IERASW,IMANUF,IMODEL, 1ILPOFF, 1IHARLC,IHARL2,STOPSW) C CCCCC THE FOLLOWING LINE WAS ADDED JULY 1992 IF(STOPSW.EQ.'YES')GOTO9000 CCCCC IF(IEXEIM.EQ.'YES')ILCSW='EXMA' IF(IEXEIM.EQ.'YES')GOTO2300 IF(IFOUND.EQ.'YES')GOTO6200 C CCCCC THE FOLLOWING SECTION WAS ADDED APRIL 1990 CCCCC TO ALLOW FOR Z COMMAND = CALL Z. CCCCC Z1 COMMAND = CALL Z1. ... Z5 COMMAND = CALL Z5. IF(IWIDTH.GE.3)GOTO6149 IF(IWIDTH.LE.0)GOTO6149 IF(IANS(1).EQ.'Z')GOTO6140 GOTO6149 6140 CONTINUE ICJUNK=' ' IWJUNK=IWIDTH IF(IWIDTH.EQ.2)ICJUNK=IANS(2) IANS(1)='C' IANS(2)='A' IANS(3)='L' IANS(4)='L' IANS(5)=' ' IANS(6)='Z' IANS(7)='.' IWIDTH=7 IF(IWJUNK.EQ.2)IANS(7)=ICJUNK IF(IWJUNK.EQ.2)IANS(8)='.' IF(IWJUNK.EQ.2)IWIDTH=8 GOTO2300 6149 CONTINUE C WRITE(ICOUT,6181) 6181 FORMAT('NO MATCH FOUND FOR COMMAND.') CALL EDWRST('EDMAI2') IF(IFOUND.EQ.'NO')WRITE(ICOUT,6182)(IANS(I),I=1,IWIDTH) 6182 FORMAT('COMMAND LINE--',100A1) IF(IFOUND.EQ.'NO')CALL EDWRST('EDMAI2') C C ************************************************** C ** STEP 62-- ** C ** LOOP BACK AND GET ANOTHER INSTRUCTION LINE ** C ************************************************** C 6200 CONTINUE CCCCC THE FOLLOWING COMPLETE SECTION WAS UPDATED APRIL 1990 CCCCC SO CAN SAY EXRR JUNK.DAT AS A SINGLE COMMAND CCCCC THE FOLLOWING 2 LINES WERE COMMENTED OUT JULY 1992 CCCCC IF(ICOM.EQ.'ER')GOTO6220 CCCCC IF(ICOM.EQ.'ERR')GOTO6230 IF(ICOM.EQ.'EXR')GOTO6230 IF(ICOM.EQ.'EXRR')GOTO6240 IF(ICOM.EQ.'ABR')GOTO6230 IF(ICOM.EQ.'ABRR')GOTO6240 GOTO2100 C CCCCC FEBRUARY 1995. IF NO FILE NAME GIVEN, PUT IN INFINITE LOOP. CCCCC IN THIS CASE, SET STOPSW TO ON. 6220 CONTINUE CCCCC IF(NUMARG.LE.0)GOTO1000 IF(NUMARG.LE.0)THEN STOPSW='ON' GOTO9000 ENDIF DO6221I=1,77 IP3=I+3 IORINA(I:I)=IANS(IP3) 6221 CONTINUE IORINA(78:80)=' ' GOTO1229 C 6230 CONTINUE CCCCC IF(NUMARG.LE.0)GOTO1000 IF(NUMARG.LE.0)THEN STOPSW='ON' GOTO9000 ENDIF DO6231I=1,76 IP4=I+4 IORINA(I:I)=IANS(IP4) 6231 CONTINUE IORINA(77:80)=' ' GOTO1229 C 6240 CONTINUE CCCCC IF(NUMARG.LE.0)GOTO1000 IF(NUMARG.LE.0)THEN STOPSW='ON' GOTO9000 ENDIF DO6241I=1,75 IP5=I+5 IORINA(I:I)=IANS(IP5) 6241 CONTINUE IORINA(76:80)=' ' GOTO1229 C C ***************** C ** STEP 90-- ** C ** EXIT ** C ***************** C 9000 CONTINUE CCCCC STOP CCCCC CALL EXIT(1) COMMENTED OUT TO MAKE IT A SUBROUTINE 7/92 RETURN END