C C C G E T B S U C C GET A B.S.U. ( BASIC SYNTACTIC UNIT ) C C THIS ROUTINE FINDS THE NEXT B.S.U. IN AN EXPRESSION AND RETURNS ITS C VALUE. A B.S.U. MAY BE EITHER A SYMBOL OR AN OPERATOR CHARACTER. C THE CALLING SEQUENCE IS: C C CALL GETBSU ( IFLAG , IVAL ) C C WHERE IFLAG AND IVAL ARE INTEGER VARIABLES WHICH RETURN TWO INTEGER C VALUES AS FOLLOWS: C C IFLAG IVAL COMMENT C -3 0 UNDEFINED SYMBOL FOUND C -2 0 ILLEGAL CHARACTER FOUND C -1 0 NO MORE B.S.U.'S IN EXPRESSION C 0 VALUE SYMBOL OR CONSTANT VALUE RETURNED C 1 >0 KEYCHR INDEX RETURNED ( OPERATOR C SUBROUTINE GETBSU (IFLAG , IVAL) INCLUDE 'BSUCOM.CMN' INCLUDE 'PRMSYM.CMN' INCLUDE 'LSTHDG.CMN' INCLUDE 'SRCLIN.CMN' INCLUDE 'OUTLIN.CMN' INTEGER HERE , VALFLG INTEGER SYMBOL(8), LRADIX , TABS INTEGER*4 IVAL , VALSYM EQUIVALENCE ( KEYCHR(27) , HERE) , ( KEYCHR(28) , TABS ) C IVAL = 0 VALSYM = 0 MODBAS = 0 NXTCHR = REMIDX + 1 IF ( NXTCHR .GT. EOR ) GO TO 10000 D WRITE (5,2) EOR-NXTCHR+1,(REMAIN(I),I=NXTCHR,EOR) D 2 FORMAT (' GETBSU START, ',I5,' CHARS IN STRING ',80A1) DO 200 I = NXTCHR , EOR REMIDX = I DO 100 J = 1 , 28 IF ( REMAIN(I) .NE. KEYCHR(J) ) GO TO 100 KEYIDX = J GO TO ( 13000 , 13000 , 13000 , 13000 , 13000 , 13000 , * 13000 , 13000 , 11000 , 10000 ,400 ,200 , * 11000 , 11000 , 11000 ,300 ,300 ,400 , * 400 , 10000 , 11000 ,4000 , 13000 , 11000 , * 11000 ,500 ,500 ,200 ) , KEYIDX 100 CONTINUE IF ( REMAIN(I) .GE. KEYCHR(16) .AND. * REMAIN(I) .LE. KEYCHR(17) ) GO TO 300 !? 0 - 9 ? IF ( REMAIN(I) .GE. KEYCHR(18) .AND. * REMAIN(I) .LE. KEYCHR(19) ) GO TO 400 !? A - Z ? GO TO 11000 200 CONTINUE GO TO 10000 C C FIND OUT WHAT KIND OF NUMBER IT IS C 300 CONTINUE LRADIX = 10 ! ASSUME DECIMAL DO 305 J=REMIDX,EOR IF (REMAIN(J).GE.KEYCHR(16).AND. $ REMAIN(J).LE.'F') GO TO 305 IF (REMAIN(J).EQ.'H') GO TO 3000 ! HEXIDECIMAL IF (REMAIN(J).EQ.'O'.OR. $ REMAIN(J).EQ.'Q') GO TO 320 ! OCTAL GO TO 310 ! NON-NUMERIC 305 CONTINUE J = EOR 310 CONTINUE IF (REMAIN(J).EQ.'B') GO TO 315 ! BINARY IF (REMAIN(J).EQ.'D') GO TO 330 ! DECIMAL GO TO 340 315 CONTINUE LRADIX = 2 GO TO 330 C C BREAK DOWN A DIGIT STRING C 320 CONTINUE LRADIX = 8 330 CONTINUE MODBAS = 1 ! THERE WAS A NUMERIC MODIFIER 340 CONTINUE DO 350 I = REMIDX , EOR IF ( REMAIN(I) .LT. KEYCHR(16) .OR. * REMAIN(I) .GE. ( KEYCHR(16) + LRADIX ) ) GO TO 370 REMIDX = I IDIGIT = REMAIN(I) - KEYCHR(16) IVAL = IVAL * LRADIX + IDIGIT VALSYM = IVAL 350 CONTINUE VALSYM = IVAL 370 CONTINUE IF (MODBAS.EQ.1) REMIDX = I GO TO 12000 C C LETTER ( SYMBOL MAYBE ) C 400 CONTINUE CALL FNDSYM ( REMAIN , REMIDX , EOR , SYMBOL ) CALL GETSYM ( SYMBOL , IFLAG , VALSYM , VALFLG ) IF ( IFLAG .LE. 0 ) GO TO 410 CALL XREF(IFLAG,LINCNT+1,1) ! A reference GO TO 12000 410 CALL LSERCH ( REGSYM , 10 , SYMBOL , 6 , I ) IF ( I .LT. 0 ) GO TO 450 VALSYM = REGVAL(I) GO TO 12000 450 CONTINUE C C U-ERROR,UNDEF. SYMBOL C CALL FLGERR ( 21 ) GO TO 11500 C C $ FOUND C 500 CONTINUE C C RETURN PRESENT VALUE OF P-COUNTER C VALSYM = PCNTR GO TO 12000 C C HEX CONSTANT FOUND C 3000 CONTINUE LRADIX = 16 DO 3500 I = REMIDX , EOR C C ?0 TO 9? C IF ( REMAIN(I) .GE. KEYCHR(16) .AND. * REMAIN(I) .LE. KEYCHR(17) ) GO TO 3100 C C ?A TO F? C IF ( REMAIN(I) .LT. KEYCHR(18) .OR. * REMAIN(I) .GT.(KEYCHR(18)+5) ) GO TO 3510 IDIGIT = REMAIN(I) - KEYCHR(18) + 10 GO TO 3200 3100 CONTINUE IDIGIT = REMAIN(I) - KEYCHR(16) 3200 CONTINUE REMIDX = I IVAL = IVAL * LRADIX + IDIGIT VALSYM = IVAL 3500 CONTINUE VALSYM = IVAL 3510 CONTINUE REMIDX = I ! MOVE OVER THE 'H' GO TO 12000 C C ' - ASCII CONSTANT (1 BYTE LONG) C 4000 CONTINUE REMIDX = REMIDX + 2 ! STEP OVER CLOSING ' VALSYM = REMAIN(REMIDX-1) - "20000 GO TO 12000 C C , - EXPRESSION DELIMETER C 10000 CONTINUE IVAL = 0 IFLAG = -1 GO TO 20000 C C ILLEGAL CHARACTER C 11000 CONTINUE IVAL = 0 IFLAG = -2 GO TO 20000 C C UNDEFINED SYMBOL C 11500 CONTINUE IVAL = 0 IFLAG = -3 GO TO 20000 C C RETURN A SYMBOL VALUE C 12000 CONTINUE IFLAG = 0 IVAL = VALSYM GO TO 20000 C C RETURN A KEY CHARACTER INDEX C 13000 CONTINUE IFLAG = 1 IVAL= KEYIDX 20000 CONTINUE D WRITE (5,1) IFLAG,IVAL D 1 FORMAT (' GETBSU RETURNS IFLAG, IVAL = ',2I6) RETURN END