Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-01 - decus/20-0001/errcx.for
There is 1 other file named errcx.for in the archive. Click here to see a list.
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