C C C X P R S I N C C EVALUATE AN EXPRESSION C C THIS ROUTINE IS USED TO EVALUATE EXPRESSIONS IN THE OPERAND FIELD C OF AN ASSEMBLY LANGUAGE SOURCE LINE.EXPRESSIONS ARE EVALUATED IN C A STRICT LEFT TO RIGHT ORDER ( IE. THERE IS NO OPERATOR PRECIDENCE. C THE CALLING SEQUENCE IS: C C CALL XPRSIN ( IFLAG , IVAL ) C C WHERE C IFLAG- AN INTEGER VARIABLE WHICH RETURNS A FLAG AS FOLLOWS: C -1 AN ERROR WAS DETECTED IN THE EXPRESSION C 0 NO EXPRESSION IN OPERAND FIELD C 1 EXPRESSION EVALUATED OK C C THE ROUTINE REPEATEDLY CALLS THE SUBROUTINE GETBSU WHICH RETURNS C THE VALUE OF THE NEXT B.S.U. ( BASIC SYNTACTIC UNIT ) OR AN END OF C LINE INDICATOR.XPRSIN LOOKS FOR A PAIR OF TERMS SEPERATED BY AN C OPERATOR CHARACTER ( +,-,&,*, ETC. ) AND THEN EVALUATES THIS SUB- C EXPRESSION.THE RESULTS OF THIS SUB-EXPRESSION IS THEN USED AS THE C LEFT SIDE OF THE NEXT SUB-EXPRESSION ( IF ANY ).WHEN ACOMPLETE C EXPRESSION HAS BEEN EVALUATED XPRSIN RETURNS TO THE CALLING ROUTINE C A KEY FLAGWORD IS BSUFLG. THIS FLAG IS USED TO REMEMBER THE TYPE OF C B.S.U. LAST FOUND. BSUFLG MAY HAVE ONE OF THE FOLLOWING VALUES C -1 OPERATOR CHARACTER FOUND LAST C 0 INITIAL VALUE, NO B.S.U.'S YET C 1 VALUE ( CONSTANT OR SYMBOL ) FOUND LAST C C SUBROUTINE XPRSIN ( IFLAG, IVAL ) INTEGER BSUFLG , IFLAG, GIFLAG INTEGER OPRATR , UNARY INTEGER*4 IVAL , GIVAL C D WRITE (5,1) D 1 FORMAT (' XPRSIN CALLED') BSUFLG = 0 !FLAG FOR BSU TYPE LAST FOUND IFLAG= 0 !RETURN FLAG IVAL= 0 UNARY= 0 !UNARY +/- INDICATOR OPRATR = 0 !OPERATOR CHARACTER INDEX 10 CONTINUE IF (IVAL.LT.0) IVAL = IVAL+65536 CALL GETBSU ( GIFLAG , GIVAL ) !GET NEXT BSU IF ( GIFLAG .EQ. -3) GO TO 2000 !UNDEFINED SYMBOL IF ( GIFLAG .EQ. -2 ) GO TO 900 !ILLEGAL CHARACTER FOUND IF ( GIFLAG .EQ. -1 ) GO TO 1000 !NO MORE BSU'S IF ( GIFLAG .EQ.0 ) GO TO 100 !VALUE RETURNED IF (BSUFLG.LE.0) GO TO 20 OPRATR = GIVAL BSUFLG = -1 GO TO 10 20 CONTINUE !OPERATOR FOUND LAST ( OR NOTHING YET) IF ( GIVAL .NE. 1 .AND. * GIVAL .NE. 2 ) GO TO 1500 !? UNARY + OR - ? UNARY = 1 !YES IF ( GIVAL .EQ. 2 ) UNARY = -1 CALL GETBSU ( GIFLAG , GIVAL ) IF ( GIFLAG .EQ. -2 ) GO TO 900 IF ( GIFLAG .NE. 0 ) GO TO 1500 GIVAL = GIVAL * UNARY IF ( OPRATR .EQ. 0 ) GO TO 110 GO TO 150 100 CONTINUE IF ( BSUFLG ) 150 , 110 , 1500 110 CONTINUE IVAL = GIVAL BSUFLG = 1 GO TO 10 150 CONTINUE IF ( OPRATR .LE. 0 .OR. * OPRATR .GE. 9 ) GO TO 2000 BSUFLG = 1 GO TO ( 200 , 250 , 300 , 350 , 400 , 450 , 500 ,550 ) , OPRATR 200 CONTINUE IVAL = IVAL + GIVAL GO TO 10 250 CONTINUE IVAL = IVAL - GIVAL GO TO 10 300 CONTINUE IVAL = IVAL * GIVAL GO TO 10 350 CONTINUE IVAL = IVAL / GIVAL GO TO 10 C 400 CONTINUE IVAL = IVAL ** GIVAL GO TO 10 450 CONTINUE IVAL = IVAL .AND. GIVAL GO TO 10 500 CONTINUE IVAL = IVAL .OR. GIVAL GO TO 10 550 CONTINUE IF ( GIVAL .LT. 0 ) GO TO 560 IVAL = IVAL * ( 2**GIVAL ) GO TO 10 560 CONTINUE GIVAL = -GIVAL IVAL = IVAL / ( 2**GIVAL ) GO TO 10 900 CONTINUE C C C-ERROR, BAD CHARACTER C CALL FLGERR ( 3 ) 1000 CONTINUE IF ( BSUFLG .NE. 0 ) GO TO 2000 IVAL = 0 IFLAG = -1 GO TO 3000 1500 CONTINUE C C O-ERROR, OPERAND ERROR C CALL FLGERR ( 15 ) 2000 CONTINUE IF (IVAL.LT.0) IVAL = IVAL+65536 IF ( BSUFLG .EQ. -1 ) CALL FLGERR ( 15 ) IFLAG = 1 3000 CONTINUE D WRITE (5,2) IFLAG,IVAL D 2 FORMAT (' XPRSIN RETURNED IFLAG, IVAL = ',2I8) RETURN END