SUBROUTINE ERRCX (RETCD) INCLUDE 'VKLUGPRM.FTN' C PARAMETER RRW = 32 C PARAMETER RCL = 32 PARAMETER CUP=1,NEL=14 C RRW=MAX REAL ROWS C RCL=MAX REAL COLS C RRW MUST BE 1 LARGER TO HANDLE 1ST 27 VARIABLES IN AVBLS C VBLS AND TYPE DIMENSIONED RRW,RCL C ************************************************** C * * C * SUBROUTINE ERRCX * C * * C ************************************************** C C C THIS SUBROUTINE DOES INITIAL SYNTAX CHECKING ON THE INPUT C LINE. THE CHECKS MAKE SURE THAT PARENTHESES ARE BALANCED C AND THAT THE EQUAL SIGN IS NOT MISUSED. C C C C C RETCD MEANING C C 1 NO ERRORS DETECTED C 2 ERROR FOUND C C C C C MODIFICATION CLASSES: M1 C C C C C ERRCX CALLS ERRMSG WHICH PRINTS ERROR MESSAGES. C C C C ERRCX IS CALLED BY CALC C C C C VARIABLE USE C C ALPHA(27) HOLDS LEGAL VARIABLE NAMES: ALPHABETIC C OR THE CHARACTER %. C BLANK ' ' C I,J HOLDS TEMPORARY VALUES. C LAST HOLDS A CODE WHEN LOOKING FOR ERRORS INVOLVING C THE EQUAL SIGN. C LEND LAST NON-BLANK CHARACTER IN LINE(80). C LPAR '(' C PARCNT 0 IF PARENTHESIS ENCOUNTERED BALANCE. INCREASED C BY 1 FOR EVERY LEFT PARENTHESIS, DECREASED BY C BY 1 FOR EVERY RIGHT PERENTHESIS FOUND. C RETCD HOLDS RETURN CODE. 1=O.K. 2=ERROR C RPAR ')' C C C C MODIFIED REASON C C 18-MAY-1981 WHEN CHECKING FOR BALANCED PARENTHESIS, DON'T C INCLUDE THOSE THAT ARE PRECEEDED BY A SINGLE QUOTE C (CODE AT DO 100) (PB) C C C C SUBROUTINE ERRCX (RETCD) INTEGER*2 LEVEL,NONBLK,LEND INTEGER*2 RETCD,PARCNT,VIEWSW,BASED INTEGER*2 I,J,LAST C LOGICAL*1 ALPHA(27),COMMA,BLANK,RPAR,LPAR,EQ LOGICAL*1 LINE(80) LOGICAL*1 QUOTE COMMON LEVEL,LINE,NONBLK,LEND,VIEWSW,BASED COMMON /CONS/ALPHA,COMMA,BLANK,RPAR,LPAR,EQ DATA QUOTE/''''/ C C C RETCD=1 C C ************************************************** C ****** MAKE SURE PARENTHESIS ARE BALANCED ****** C ************************************************** C PARCNT=0 DO 100 I=NONBLK,LEND IF (LINE(I).EQ.LPAR) GOTO 50 IF (LINE(I).EQ.RPAR) GOTO 80 GOTO 100 C C ENCOUNTERED A LEFT PARENTHESIS, COUNT IT ONLY IF PRECEEDING C CHARACTER IS NOT A SINGLE QUOTE 50 IF(I.EQ.NONBLK) GOTO 60 IF(LINE(I-1).EQ.QUOTE) GOTO 100 60 PARCNT=PARCNT+1 GOTO 100 C C ENCOUNTERED A RIGHT PARENTHESIS, COUNT IT ONLY IF PRECEEDING C CHARACTER IS NOT A SINGLE QUOTE 80 IF(I.EQ.NONBLK) GOTO 90 IF(LINE(I-1).EQ.QUOTE) GOTO 100 90 PARCNT=PARCNT-1 IF(PARCNT.LT.0)GOTO 160 100 CONTINUE C IF (PARCNT.EQ.0) GOTO 200 C C C UNBALANCED PARENTHESIS I=6 140 CALL ERRMSG(I) 150 RETCD=2 RETURN C C C ILLEGAL EXPRESSION LIKE ')))X(((' 160 I=8 GOTO 140 C C C C C C C C ************************************************** C ********* = SIGN SYNTAX CHECK **************** C ************************************************** C 200 CONTINUE C C C ALLOW A=B=C+2 C MAY ONLY ASSIGN VALUES TO SINGLE UNSIGNED VARIABLES. C ALSO CATCH =A C AND A==B C C LAST = 0 FIRST CHAR OR FOUND = C 1 1 ALPHA CHARACTER C 2 MORE THAN 1 ALPHA OR C ENCOUNTERED NON-ALPHA C (BUT NOT = OR BLANK) C C C LAST=0 I=NONBLK 271 CONTINUE C DO 270 I=NONBLK,LEND IF (LINE(I).EQ.BLANK) GOTO 270 IF (LINE(I).EQ.EQ) GOTO 230 C C C LOOK FOR ALPHA C DO 220 J=1,27 C IF (LINE(I).EQ.ALPHA(J)) GOTO 240 C220 CONTINUE CALL VARSCN(LINE,I,LEND,LSTCHR,ID1,ID2,IVALID) IF(IVALID.EQ.0) GOTO 220 I=LSTCHR IF(LSTCHR.LT.LEND)I=LSTCHR-1 C IF WE GET A GOOD VARIABLE NAME POINT AT ITS END AND GO SAY WE'RE OK. GOTO 240 220 CONTINUE C C C MORE THAN 1 ALPHA OR ENCOUNTERED NON-ALPHA C (BUT NOT = SIGN OR BLANK) 225 LAST=2 GOTO 270 C C C = SIGN ENCOUNTERED 230 IF (LAST.EQ.1) GOTO 235 C C ILLEGAL USE OF = SIGN GOTO 290 C C HAD 1 ALPHA CHARACTER FOLLOWED BY = SIGN 235 LAST=0 GOTO 270 C C ENCOUNTERED A VARIABLE NAME (1 CHARACTER) 240 IF (LAST.EQ.2) GOTO 270 IF (LAST.EQ.1) GOTO 225 C C C EXACTLY 1 ALPHA CHARACTER EITHER AS FIRST CHARACTER C ENCOUNTERED OR AS THE 1ST CHARACTER AFTER AN = SIGN. LAST=1 270 CONTINUE I=I+1 IF(I.LE.LEND) GOTO 271 C *****&&&&& SIMULATE DO LOOP TO ALLOW MONKEYING WITH INDEX INSIDE. C C C C C C C <<<<<<<<<<<< ADD ADDITIONAL CHECKS HERE >>>>>>>>>> C RETURN C C C ILLEGAL USE OF = SIGN 290 I=17 GO TO 140 END