C C C C COPYRIGHT (c) 1977 BY C DIGITAL EQUIPMENT CORPORTATION, MAYNARD, MASS. C C THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED C ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE C INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER C COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY C OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY C TRANSFERRED. C C THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE C AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT C CORPORATION. C C DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS C SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. C C C C C C C C C ++++++++++++++++++++++++++++++++++++++++++++++++++ C + + C + CALC VERSION X01-01 + C + + C + PETER BAUM 1-SEP-77 + C + DIGITAL EQUIPMENT CORPORATION + C + 146 MAIN STREET + C + MAYNARD, MASSACHUSETTS 01754 + C + + C ++++++++++++++++++++++++++++++++++++++++++++++++++ C C C C C 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 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) C COMMON LEVEL,LINE,NONBLK,LEND,VIEWSW,BASED COMMON /CONS/ALPHA,COMMA,BLANK,RPAR,LPAR,EQ 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) PARCNT=PARCNT+1 IF (LINE(I).EQ.RPAR) 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 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 DO 220 J=1,27 IF (LINE(I).EQ.ALPHA(J)) 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 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