*S~ SUBROUTINE DECIDE (ERR) C C DECIDE is used to decide what kind of statement is currently C being scanned by the IFTRAN processor. C KIND, returned in IFTCOM, returns values according to the C convention below: C C KIND STATEMENT TYPE C 0 Non-IFTRAN statement C 1 DATA C 2 FORMAT C 3 IF () C 4 OR IF () C 5 ELSE C 6 END IF C 7 WHILE () C 8 END WHILE C 9 END C 10 EXIT IF C 11 EXIT WHILE C 12 DO C 13 UNTIL () C 14 EXIT DO C 15 FOR Var = Lim1, Lim2 C 16 END FOR C 17 EXIT FOR C Revision History: C 19-JAN-81 Character variables changed to type BYTE C 19-JAN-81 IFTCOM common rearranged C 17-FEB-81 Hooks added to decode FORMAT and DATA stmts C 24-APR-81 ELSE IF changed to OR IF, LOOP deleted C 24-APR-81 Error detection for missing () added IMPLICIT INTEGER (A - Z) BYTE X ; Internal string variables BYTE LABEL, LHEAD, LIST, CONLBL ; Common string variables LOGICAL*1 ERR, LISTNG ; Error return, listing flags LOGICAL*1 PASCOM ; Pass comments flag COMMON /IFTCOM/ DONE, INFILE, IP, KIND, L, LNUM, LOUT, OUTFIL, + ERRCNT, LISTNG, PASCOM, CONLBL(6), LABEL(66), LHEAD(6), LIST(1320) ERR = .FALSE. ; Hope no errors detected I = 0 KIND = 0 ; Guess non-IFTRAN statement CALL TOKEN (I, TYPE) ; Get head of statement IP = I + 1 ; Insertion point IF (TYPE .LE. 0) RETURN ; Guess was correct C ****************************************************************** C * * C * IF () * C * * C ****************************************************************** IF (TYPE .EQ. 1) ; IF found CALL TOKEN (I, TYPE) ; Get next token type IF ((TYPE .EQ. -1) .AND. (I .EQ. L)) KIND = 3 ; IF (...) established C ****************************************************************** C * * C * DO * C * * C ****************************************************************** OR IF (TYPE .EQ. 2) IF (I .EQ. L) KIND = 12 ; DO established C ****************************************************************** C * * C * OR IF () * C * * C ****************************************************************** OR IF (TYPE .EQ. 3) ; OR found CALL TOKEN (I, TYPE) ; Check next token IF (TYPE .EQ. 1) ; Is it an IF? IP = I + 1 CALL TOKEN (I, TYPE) ; Check next token IF ((TYPE .EQ. -1) .AND. (I .EQ. L)) ; (...) and end of line? KIND = 4 ; OR IF (...) found ELSE ; Syntax error ERR = .TRUE. ; Set error flag END IF END IF C ****************************************************************** C * * C * END * C * * C ****************************************************************** OR IF (TYPE .EQ. 4) IF (I .EQ. L) ; END found KIND = 9 ; END established ELSE CALL TOKEN (I, TYPE) IF (I .EQ. L) IF (TYPE .EQ. 1) KIND = 6 ; END IF established IF (TYPE .EQ. 5) KIND = 16 ; END FOR established IF (TYPE .EQ. 10) KIND = 8 ; END WHILE established END IF END IF C ****************************************************************** C * * C * FOR * C * * C ****************************************************************** OR IF (TYPE .EQ. 5) DO ; FOR found X = NEXT(I) IF ((X .NE. '=') .AND. ((X .LT. '0') .OR. ((X .GT. '9') .AND. + (X .LT. 'A')) .OR. (X .GT. 'Z'))) I = L ; Force stop on punctuation UNTIL ((X .EQ. '=') .OR. (I .EQ. L)) IF (I .LT. L) DO X = NEXT(I) IF ((X .NE. ',') .AND. ((X .LT. '0') .OR. ((X .GT. '9') .AND. + (X .LT. 'A')) .OR. (X .GT. 'Z'))) I = L ; Force stop on punctuation UNTIL ((X .EQ. ',') .OR. (I .EQ. L)) IF (I .LT. L) KIND = 15 ; FOR Var = ... established END IF C ****************************************************************** C * * C * DATA * C * * C ****************************************************************** OR IF (TYPE .EQ. 6) KIND = 1 ; DATA found RETURN C ****************************************************************** C * * C * ELSE * C * * C ****************************************************************** OR IF (TYPE .EQ. 7) ; ELSE found IF (I .EQ. L) KIND = 5 ; ELSE established C ****************************************************************** C * * C * EXIT * C * * C ****************************************************************** OR IF (TYPE .EQ. 8) ; EXIT found CALL TOKEN (I, TYPE) ; Check next token IP = I IF (TYPE .EQ. 1) KIND = 10 ; EXIT IF established IF (TYPE .EQ. 2) KIND = 14 ; EXIT DO established IF (TYPE .EQ. 5) KIND = 17 ; EXIT FOR established IF (TYPE .EQ. 10) KIND = 11 ; EXIT WHILE established IF (I .LT. L) CALL TOKEN (I, TYPE) ; Check next token IF (TYPE .NE. 1) ; Optional IF? ERR = .TRUE. ; No, set error flag KIND = 0 ; Set non-IFTRAN stmt END IF CALL TOKEN (I, TYPE) ; Check next token IF ((TYPE .NE. -1) .OR. (I .LT. L)) ; Optional (...) ? ERR = .TRUE. ; No, set error flag KIND = 0 ; Set non-IFTRAN stmt END IF END IF C ****************************************************************** C * * C * WHILE () * C * * C ****************************************************************** OR IF (TYPE .EQ. 10) ; WHILE found CALL TOKEN (I, TYPE) ; Check next token IF ((TYPE .EQ. -1) .AND. (I .EQ. L)) ; (...) and end of line? KIND = 7 ; WHILE (...) established ELSE ; Syntax error ERR = .TRUE. ; Set error flag END IF C ****************************************************************** C * * C * UNTIL () * C * * C ****************************************************************** OR IF (TYPE .EQ. 11) ; UNTIL found CALL TOKEN (I, TYPE) ; Check next token IF ((TYPE .EQ. -1) .AND. (I .EQ. L)) ; (...) and end of line? KIND = 13 ; UNTIL (...) established ELSE ; Syntax error, warn user ERR = .TRUE. ; Set error flag END IF C ****************************************************************** C * * C * FORMAT * C * * C ****************************************************************** OR IF (TYPE .EQ. 12) KIND = 2 ; FORMAT found RETURN END IF IP = IP + 6 ; Insert point relative to LHEAD RETURN END