C ICSI MCR COMMAND STRING INTERPRETER CSWITCH ARRAY C (1,N) - SWITCH NAME (A2), SUPPLIED BY CALLER C (2,N) - OCCURRED FLAG C 0 - DID NOT OCCUR C 1 - OCCURRED WITHOUT A VALUE C 2 - OCCURRED WITH A VALUE C -1 - OCCURRED WITHOUT A VALUE & WAS NEGATED C -2 - OCCURRED WITH A VALUE & WAS NEGATED C (3,N) - THE FILE SPEC NUMBER (1-9) WHERE THE SWITCH OCCURRED, C 0 IF THE SWITCH DID NOT OCCUR C (4,N) - THE VALUE OF THE SWITCH (IF (2,N) = 2 OR -2), C NOT MODIFIED UNLESS A VALUE OCCURRED. C ONLY DECIMAL NUMBERS (WITHOUT THE DECIMAL POINT) ARE ALLOWED. C CDEFALT EXTENSION SPECIFICATION: CIN CALLER-- REAL DEFALT(4) C DATA DEFALT/'FTN ','LST ','FOO ','RAT '/ CIN ICSI THE BYTE DEFALT(4,4) CMAKES A CHAR. ARRAY EQUIVALENT. THE BLANK AT END OF EACH ONE IS REPLACE C WITH AN EOS. CNOTE: NUMERIC ARGUMENTS TO SWITCHES MUST BE DECIMAL NUMBERS, C WITHOUT A DECIMAL POINT. C DEFAULT EXTENSION FOR INDIRECT COMMAND FILES IS 'CMD'. C 'PROMPT' IS A STRING OF UP TO 7 CHAR FOR PROMPT AT TERMINAL, C EG., 'RAT>'. C A '!' WITHIN A COMMAND LINE IS TAKEN AS A COMMENT DELIMITER C AND THE REST OF THE COMMAND LINE IS IGNORED. THIS IS TRUE C OF LINES PASSED BY CALLER AS WELL AS ENTERED LINES. C ON LINES ENTERED BY INDIRECT FILES, C A ';' OR '!' IN COLUMN 1 MAKES THE WHOLE LINE A COMMENT. C SUCH FULL-LINE COMMENTS ARE NOT LEGAL FROM OPERATOR INPUT, BUT C TRAILING '!' COMMENTS ARE. BLANKS & TABS ALLOWED IN FRONT OF THE'!' C CINITIALIZATION OF CICSI BY CALLER: C IFIRST MUST BE SET TO 'YES' BEFORE FIRST CALL; THEN LEFT ALONE. C USER MUST BE SET TO LUN NUMBER TO BE USED FOR OPERATOR INPUT C INDLUN MUST BE SET TO LUN TO BE USED FOR INDIRECT COMMAND FILES; C OR 0, IF NOT ALLOWED. C INPUT & MCR MUST NEVER BE MODIFIED BY THE CALLER. C CLB IS A STRING; IT MUST EITHER BE NULL, IN WHICH CASE THE C COMMAND LINE IS TAKEN FROM EITHER THE MCR OR THE C USER'S TERMINAL; OR IT MUST CONTAIN A COMMAND LINE, C IN WHICH CASE THAT COMMAND LINE IS THE ONE PROCESSED C BY ICSI. DON'T FORGET TO RE-NULL IT EACH TIME C ICSI IS RE-CALLED AND A COMMAND LINE IS NOT SUPPLIED. C @ FILE SPECS ARE NOT ALLOWED TO BE SUPPLIED IN BY C CALLER IN CLB. NOTE THAT THE COMMAND LINE IS CONVERTED C TO UPPER CASE BEFORE SCANNING. CFILE=DEFIN.RAT ===== GENERAL CHARACTER SET DEFINITIONS =============== C PCN #73, DEC 79, ADD CARET,TILDE FOR .NOT. C C FILE=RATDEF.RAT CDEFINE (DECWRITER,) #DEFINED FOR DECWRITER OUTPUT C C$ ICSI - TO PARSE A RSX11 COMMAND LINE C PCN #99, 27 MAR 80, CONVERT COMMAND LINE TO UPPERCASE BEFORE SCANNING. C PCN 108, 1 OCT 80, USE EXPLICIT DEFAULT SY: SO YOUR CURRENT ASN IS USE C INTEGER FUNCTION ICSI ( NAMES, DEFALT, SWITCH, NUM, PROMPT ) C LOGICAL * 1 NAMES ( 35, 9 ), DEFALT ( 4, 4 ), PROMPT ( 1 ) LOGICAL * 1 PROMPX ( 8 ) INTEGER SWITCH ( 4, NUM ), NUM, ICSIL, ICSIN, SLEN, I, J, SCOPY C FILE = CICSI.RAT FOR ICSI COMMON / CICSI / INPUT, INDLUN, USER, IFIRST, MCR, CLB ( 81 ) INTEGER INPUT INTEGER INDLUN INTEGER USER INTEGER IFIRST INTEGER MCR LOGICAL * 1 CLB C COMMON / ICSIP / PROMPX C I = SCOPY ( PROMPT, PROMPX, 7, JUNK ) PROMPX ( I ) = 0 C IF (.NOT.( SLEN ( CLB ) .GT. 0 )) GOTO 20000 ICSI = ICSIN ( NAMES, DEFALT, SWITCH, NUM ) GOTO 20001 20000 CONTINUE 20002 CONTINUE ICSI = ICSIL ( PROMPT ) IF (.NOT.( ICSI .EQ. 1 )) GOTO 20005 ICSI = ICSIN ( NAMES, DEFALT, SWITCH, NUM ) 20005 CONTINUE 20003 IF (.NOT.( INPUT .NE. INDLUN .OR. ICSI .NE. - 1 )) GOTO 20002 20004 CONTINUE 20001 CONTINUE C C? IF (NUM > 0) C? WRITE (USER,2) ((SWITCH(I,J),I=1,4),J=1,NUM) C? 2 FORMAT (1X,A2,I4,I3,I6) C RETURN END C C$ ICSIN - PARSE FILE SPECIFICATIONS OUT OF INPUT BUFFER FOR ICSI C INTEGER FUNCTION ICSIN ( NAMES, DEFALT, SWITCH, NUM ) C LOGICAL * 1 NAMES ( 35, 9 ), DEFALT ( 4, 4 ) LOGICAL * 1 SAVE, TEMP1 ( 5 ), TEMP2 ( 10 ), TYPE INTEGER SWITCH ( 4, NUM ), NUM, INDEX, SJOIN, SCOPY INTEGER LCOL, N, JCOL, JUNK, MAX0, MIN0, SLEN, LEN, ICOL INTEGER I, J, LINE, BRAK, SPREV, ICSIS C FILE = CICSI.RAT FOR ICSI COMMON / CICSI / INPUT, INDLUN, USER, IFIRST, MCR, CLB ( 81 ) INTEGER INPUT INTEGER INDLUN INTEGER USER INTEGER IFIRST INTEGER MCR LOGICAL * 1 CLB C C DO 20007 J = 1, NUM DO 20009 I = 2, 3 SWITCH ( I, J ) = 0 20009 CONTINUE 20010 CONTINUE 20007 CONTINUE 20008 CONTINUE DO 20011 J = 1, 9 NAMES ( 1, J ) = 0 20011 CONTINUE 20012 CONTINUE DO 20013 J = 1, 4 DEFALT ( 4, J ) = 0 C 20013 CONTINUE 20014 CONTINUE CALL UNFOLD ( CLB ) C CFIND THE FILE SPEC STRINGS AND MOVE TO NAMES (1-9) ICOL = 1 LEN = INDEX ( CLB, 1H! ) - 1 IF (.NOT.( LEN .LT. 0 )) GOTO 20015 LEN = SLEN ( CLB ) GOTO 20016 20015 CONTINUE 20017 IF (.NOT.( CLB ( LEN ) .EQ. 32 .OR. CLB ( LEN ) .EQ. 9 )) GOTO $20018 LEN = LEN - 1 GOTO 20017 20018 CONTINUE 20016 CONTINUE JUNK = SCOPY ( 3HSY:, TEMP1 ( 1 ), 5, JUNK ) TEMP2 ( 1 ) = 0 IF (.NOT.( INDEX ( CLB, 1H= ) .EQ. 0 )) GOTO 20019 LINE = 4 GOTO 20020 20019 CONTINUE LINE = 1 20020 CONTINUE 20021 IF (.NOT.( LINE .LE. 9 .AND. ICOL .LT. LEN)) GOTO 20023 IF (.NOT.( CLB ( ICOL ) .NE. 44 )) GOTO 20024 BRAK = 0 I = ICOL 20026 IF (.NOT.( ( CLB ( I ) .NE. 44 .OR. BRAK .NE. 0 ) .AND. CLB ( I ) $.NE. 61 .AND. CLB ( I ) .NE. 47 .AND. I .LE. LEN)) GOTO 20028 IF (.NOT.( CLB ( I ) .EQ. 91 )) GOTO 20029 BRAK = BRAK + 1 GOTO 20030 20029 CONTINUE IF (.NOT.( CLB ( I ) .EQ. 93 )) GOTO 20031 BRAK = BRAK - 1 20031 CONTINUE 20030 CONTINUE 20027 I = I + 1 GOTO 20026 20028 CONTINUE IF (.NOT.( I .GT. ICOL )) GOTO 20033 SAVE = CLB ( I ) CLB ( I ) = 0 IF (.NOT.( INDEX ( CLB ( ICOL ), 1H; ) .EQ. 1 .AND. INDEX ( CLB ( $ICOL ), 1H. ) .EQ. 0 )) GOTO 20035 CALL ICSIE ( 41HExplicit Version Needs Explicit Extension ) ICSIN = ( - 1 ) RETURN 20035 CONTINUE IF (.NOT.( BRAK .NE. 0 )) GOTO 20037 CALL ICSIE ( 18HIllegal UIC syntax ) ICSIN = ( - 1 ) RETURN C 20037 CONTINUE JCOL = INDEX ( CLB ( ICOL ), 1H: ) + ICOL IF (.NOT.( JCOL .GT. ICOL )) GOTO 20039 JUNK = SCOPY ( CLB ( ICOL ), TEMP1 ( 1 ), JCOL - ICOL, JUNK ) 20039 CONTINUE LCOL = INDEX ( CLB ( ICOL ), 1H] ) + ICOL IF (.NOT.( LCOL .GT. ICOL )) GOTO 20041 N = MAX0 ( ICOL, JCOL ) JUNK = SCOPY ( CLB ( N ), TEMP2 ( 1 ), LCOL - N, JUNK ) C CBUILD UP FILE NAMES 20041 CONTINUE JUNK = SJOIN ( NAMES ( 1, LINE ), TEMP1, 35, JUNK ) JUNK = SJOIN ( NAMES ( 1, LINE ), TEMP2, 35, JUNK ) N = MAX0 ( ICOL, JCOL, LCOL ) JUNK = SJOIN ( NAMES ( 1, LINE ), CLB ( N ), 35, JUNK ) IF (.NOT.( INDEX ( CLB ( ICOL ), 1H. ) .EQ. 0 )) GOTO 20043 JUNK = SJOIN ( NAMES ( 1, LINE ), 1H., 35, JUNK ) JUNK = SJOIN ( NAMES ( 1, LINE ), DEFALT ( 1, MIN0 ( 4, LINE ) ), $35, JUNK ) 20043 CONTINUE CLB ( I ) = SAVE C CDECODE ANY SWITCHES FOR THIS FILE 20033 CONTINUE IF (.NOT.( ICSIS ( SWITCH, NUM, I, LINE ) .EQ. 1 )) GOTO 20045 ICOL = I GOTO 20046 20045 CONTINUE ICSIN = ( - 1 ) RETURN 20046 CONTINUE 20024 CONTINUE IF (.NOT.( CLB ( ICOL ) .EQ. 61 )) GOTO 20047 LINE = 3 JUNK = SCOPY ( 3HSY:, TEMP1 ( 1 ), 5, JUNK ) TEMP2 ( 1 ) = 0 20047 CONTINUE ICOL = ICOL + 1 C CSPECIAL DEFAULT MODE. IF NO OUTPUT FILES ARE SPECIFIED, BUT AT C LEAST 1 INPUT FILE WAS, ASSUME OUTPUT FILE NAMES ARE THE C SAME (USE NORMAL OUTPUT DEFAULT EXTENSIONS) AS FIRST INPUT FILE. C IF DEVICE & UIC WERE SPECIFIED WITH INPUT FILE, USE THOSE AS WELL, C ELSE, USE NORMAL OUTPUT DEFAULT DEVICE. C EXAMPLE RAT>FOO IS THE SAME AS RAT>FOO,FOO,FOO=FOO C 20022 LINE = LINE + 1 GOTO 20021 20023 CONTINUE IF (.NOT.( NAMES ( 1, 1 ) .EQ. 0 .AND. NAMES ( 1, 2 ) .EQ. 0 $.AND. NAMES ( 1, 3 ) .EQ. 0 .AND. NAMES ( 1, 4 ) .NE. 0 )) GOTO $20049 DO 20051 I = 1, 3 JUNK = SPREV ( NAMES ( 1, 4 ), 1H., NAMES ( 1, I ), 35, JUNK ) JUNK = SJOIN ( NAMES ( 1, I ), 1H., 35, JUNK ) JUNK = SJOIN ( NAMES ( 1, I ), DEFALT ( 1, I ), 35, JUNK ) 20051 CONTINUE 20052 CONTINUE 20049 CONTINUE ICSIN = ( 1 ) RETURN C END C C$ ICSIL - TO GET A COMMAND LINE FOR ICSI FROM USER OR INDIRECT FILE C PCN #77, 8 JAN 80, USE STRPUT TO OUTPUT THE PROMPT C PCN #82, 10 FEB 80, USE 'OPEN' INSTEAD OF 'ASSIGN/FDBSET' IF AVAILABLE C PCN #105, 26 SEP 80, FIX BUG THAT TRUNCATED LINES >35 CHAR. C PCN #108, 1 OCT 80, USE EXPLICIT DEFAULT SY: ON @ FILES. C INTEGER FUNCTION ICSIL ( PROMPT ) C INTEGER IQ, SCOPY, INDEX, SJOIN, STRPUT INTEGER I, JUNK, STRGET, SLEN LOGICAL * 1 PROMPT ( 1 ), NAMBUF ( 35 ) C C FILE = CICSI.RAT FOR ICSI COMMON / CICSI / INPUT, INDLUN, USER, IFIRST, MCR, CLB ( 81 ) INTEGER INPUT INTEGER INDLUN INTEGER USER INTEGER IFIRST INTEGER MCR LOGICAL * 1 CLB C IF (.NOT.( IFIRST .EQ. 1 )) GOTO 20053 INPUT = USER MCR = 0 20053 CONTINUE IF (.NOT.( MCR .EQ. 1 .AND. INPUT .EQ. USER )) GOTO 20055 ICSIL = ( - 3 ) RETURN 20055 CONTINUE IQ = 0 IF (.NOT.( IFIRST .EQ. 1 )) GOTO 20057 CALL GETMCR ( CLB, IQ ) IF (.NOT.( IQ .GT. 4 )) GOTO 20059 MCR = 1 CLB ( IQ + 1 ) = 0 I = INDEX ( CLB, 1H ) IF (.NOT.( I .LT. 4 )) GOTO 20061 ICSIL = ( - 1 ) RETURN 20061 CONTINUE IQ = SCOPY ( CLB ( I + 1 ), CLB ( 1 ), 80 - I, JUNK ) 20062 CONTINUE GOTO 20060 20059 CONTINUE IQ = 0 20060 CONTINUE IFIRST = 0 20057 CONTINUE 20063 IF (.NOT.( IQ .LE. 0 .OR. CLB ( 1 ) .EQ. 59 )) GOTO 20064 IF (.NOT.( USER .EQ. INPUT .AND. MCR .EQ. 0 )) GOTO 20065 JUNK = STRPUT ( USER, PROMPT, 36 ) 20065 CONTINUE IQ = STRGET ( INPUT, CLB, 80 ) IF (.NOT.( IQ .LT. 0 )) GOTO 20067 IF (.NOT.( INPUT .EQ. INDLUN .AND. MCR .EQ. 0 )) GOTO 20069 INPUT = USER CLOSE ( UNIT = INDLUN ) GOTO 20070 20069 CONTINUE ICSIL = ( - 3 ) RETURN 20070 CONTINUE 20067 CONTINUE GOTO 20063 20064 CONTINUE IF (.NOT.( CLB ( 1 ) .EQ. 64 )) GOTO 20071 IF (.NOT.( INDLUN .GT. 0 )) GOTO 20073 IF (.NOT.( INPUT .EQ. USER )) GOTO 20075 I = INDEX ( CLB, 1H! ) IF (.NOT.( I .GT. 0 )) GOTO 20077 CLB ( I ) = 0 20077 CONTINUE NAMBUF ( 1 ) = 0 IF (.NOT.( INDEX ( CLB, 1H: ) .EQ. 0 )) GOTO 20079 JUNK = SJOIN ( NAMBUF, 3HSY:, 35, JUNK ) 20079 CONTINUE JUNK = SJOIN ( NAMBUF, CLB ( 2 ), 35, JUNK ) IF (.NOT.( INDEX ( NAMBUF, 1H. ) .EQ. 0 )) GOTO 20081 JUNK = SJOIN ( NAMBUF, 4H.CMD, 35, JUNK ) 20081 CONTINUE OPEN ( UNIT = INDLUN, NAME = NAMBUF, READONLY, SHARED, ERR = 11, $TYPE = 'OLD' ) INPUT = INDLUN 20083 CONTINUE IF (.NOT.( STRGET ( INPUT, CLB, 80 ) .LT. 0 )) GOTO 20086 11 CALL ICSIE ( 22HOpen Failure on @ File ) ICSIL = ( - 1 ) RETURN 20086 CONTINUE 20084 IF (.NOT.( SLEN ( CLB ) .GT. 0 .AND. CLB ( 1 ) .NE. 59 .AND. CLB $( 1 ) .NE. 33 )) GOTO 20083 20085 CONTINUE GOTO 20076 20075 CONTINUE CALL ICSIE ( 22HNested @ Files Illegal ) ICSIL = ( - 1 ) RETURN 20076 CONTINUE GOTO 20074 20073 CONTINUE CALL ICSIE ( 15H@ Files Illegal ) ICSIL = ( - 1 ) RETURN 20074 CONTINUE 20071 CONTINUE ICSIL = ( 1 ) RETURN C END C C$ ICSIS - DECODE SWITCH SPECIFICATIONS FOR ICSI C PCN #64, 9 SPE 79, ALLOW SWITCHES WITH ARGUMENTS TO BE > 2 CHARS C 2 DEC 79, FIX PCN 64 C INTEGER FUNCTION ICSIS ( SWITCH, NUM, I, LINE ) C LOGICAL * 1 TESTC ( 2 ), TYPE INTEGER I, J, SWITCH ( 4, NUM ), NUM, LINE, SCTOI, NEG, OK, TEST EQUIVALENCE ( TEST, TESTC ) C FILE = CICSI.RAT FOR ICSI COMMON / CICSI / INPUT, INDLUN, USER, IFIRST, MCR, CLB ( 81 ) INTEGER INPUT INTEGER INDLUN INTEGER USER INTEGER IFIRST INTEGER MCR LOGICAL * 1 CLB C 20088 IF (.NOT.( CLB ( I ) .EQ. 47 )) GOTO 20089 I = I + 1 OK = 0 NEG = 0 IF (.NOT.( CLB ( I ) .EQ. 45 )) GOTO 20090 NEG = 1 I = I + 1 GOTO 20091 20090 CONTINUE IF (.NOT.( CLB ( I ) .EQ. 78 .AND. CLB ( I + 1 ) .EQ. 79 )) GOTO $20092 NEG = 1 I = I + 2 20092 CONTINUE 20091 CONTINUE TESTC ( 1 ) = CLB ( I ) TESTC ( 2 ) = CLB ( I + 1 ) I = I + 2 C CLOOK FOR ANY VALUES AND SETUP THE SWITCH ARRAY RETURN FLAGS C J = 1 20094 IF (.NOT.( J .LE. NUM)) GOTO 20096 IF (.NOT.( SWITCH ( 1, J ) .EQ. TEST )) GOTO 20097 OK = 1 20099 IF (.NOT.( TYPE ( CLB ( I ) ) .EQ. - 20 .OR. TYPE ( CLB ( I ) ) $.EQ. - 30 )) GOTO 20100 I = I + 1 GOTO 20099 20100 CONTINUE IF (.NOT.( CLB ( I ) .EQ. 58 )) GOTO 20101 I = I + 1 SWITCH ( 4, J ) = SCTOI ( CLB, I ) SWITCH ( 2, J ) = 2 GOTO 20102 20101 CONTINUE SWITCH ( 2, J ) = 1 20102 CONTINUE SWITCH ( 3, J ) = LINE IF (.NOT.( NEG .EQ. 1 )) GOTO 20103 SWITCH ( 2, J ) = - SWITCH ( 2, J ) 20103 CONTINUE GOTO 20096 20097 CONTINUE 20095 J = J + 1 GOTO 20094 20096 CONTINUE IF (.NOT.( OK .NE. 1 )) GOTO 20105 CALL ICSIE ( 14HIllegal Switch ) ICSIS = ( - 1 ) RETURN 20105 CONTINUE GOTO 20088 20089 CONTINUE ICSIS = ( 1 ) RETURN C END C C$ ICSIE - TO PRINT ERROR MESSAGES ON USER'S TERMINAL FOR ICSI C PCN #72, 3 DEC 79, MAKE TASK NAME (FROM PROMPT) SHOW AS 1ST PART OF ER C PCN #77, 8 JAN 80, MAKE 'PROMPT' A STRING. C SUBROUTINE ICSIE ( MSG ) C INTEGER STRPUT, JUNK, SJOIN LOGICAL * 1 MSG ( 1 ), PROMPX ( 8 ), OUTB ( 81 ) COMMON / ICSIP / PROMPX C C FILE = CICSI.RAT FOR ICSI COMMON / CICSI / INPUT, INDLUN, USER, IFIRST, MCR, CLB ( 81 ) INTEGER INPUT INTEGER INDLUN INTEGER USER INTEGER IFIRST INTEGER MCR LOGICAL * 1 CLB C IF (.NOT.( INPUT .EQ. INDLUN )) GOTO 20107 JUNK = STRPUT ( USER, CLB, 32 ) 20107 CONTINUE OUTB ( 1 ) = 7 OUTB ( 2 ) = 0 JUNK = SJOIN ( OUTB, PROMPX, 80, JUNK ) JUNK = SJOIN ( OUTB, 3H - , 80, JUNK ) JUNK = SJOIN ( OUTB, MSG, 80, JUNK ) JUNK = STRPUT ( USER, OUTB, 32 ) C RETURN END