Nodes of different colours represent the following:
Solid arrows point from a parent (sub)module to the submodule which is descended from it. Dashed arrows point from a module being used to the module or program unit using it. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | StackNum |
Nodes of different colours represent the following:
Solid arrows point from a procedure to one which it calls. Dashed arrows point from an interface to procedures which implement that interface. This could include the module procedures in a generic interface or the implementation in a submodule of an interface in a parent module. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
Nodes of different colours represent the following:
Solid arrows point from a procedure to one which it calls. Dashed arrows point from an interface to procedures which implement that interface. This could include the module procedures in a generic interface or the implementation in a submodule of an interface in a parent module. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
SUBROUTINE ParseStack(StackNum)
! SUBROUTINE INFORMATION:
! AUTHOR Peter Graham Ellis
! DATE WRITTEN June 2006
! MODIFIED Brent Griffith June 2009
! Brent Griffith March 2012, add WHILE loops
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Parsing a block of text creates a program stack in DataRuntimeLanguage.
! This routine only executes once for each Erl program.
! METHODOLOGY EMPLOYED:
! Loop over each line of Erl code and parse based on statement keyword
! USE STATEMENTS:
USE InputProcessor, ONLY: MakeUpperCase, ProcessNumber, FindItemInList
USE DataSystemVariables, ONLY: DeveloperFlag
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: StackNum !
! SUBROUTINE PARAMETER DEFINITIONS:
INTEGER, PARAMETER :: IfDepthAllowed = 5 ! depth of IF block nesting
INTEGER, PARAMETER :: ELSEIFLengthAllowed = 200 ! number of ELSEIFs allowed
INTEGER, PARAMETER :: WhileDepthAllowed = 1 ! depth of While block nesting
CHARACTER(len=*), PARAMETER :: fmta='(A)'
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: LineNum
INTEGER :: StackNum2
INTEGER :: Pos
INTEGER :: ExpressionNum
INTEGER :: VariableNum
CHARACTER(len=MaxNameLength) :: Line ! local copy of a single line of Erl program code
CHARACTER(len=MaxNameLength) :: Keyword ! local copy of statement keyword parsed from line (Run, Set, If, etc)
CHARACTER(len=MaxNameLength) :: Remainder ! local copy of what is left for text in the line after keyword
CHARACTER(len=MaxNameLength) :: Expression !
CHARACTER(len=MaxNameLength) :: Variable
INTEGER :: NestedIFDepth ! indicates depth into If statement,
INTEGER :: NestedWhileDepth ! indicates depth into While statement
INTEGER :: InstructionNum
INTEGER :: InstructionNum2
INTEGER :: GotoNum
INTEGER, DIMENSION(IfDepthAllowed) :: SavedIfInstructionNum ! index is depth of If statements
INTEGER, DIMENSION(IfDepthAllowed, ELSEIFLengthAllowed) :: SavedGotoInstructionNum
INTEGER, DIMENSION(IfDepthAllowed) :: NumGotos ! index is depth of If statements,
INTEGER :: SavedWhileInstructionNum
INTEGER :: SavedWhileExpressionNum
INTEGER :: NumWhileGotos
LOGICAL, DIMENSION(IfDepthAllowed) :: ReadyForElse
LOGICAL, DIMENSION(IfDepthAllowed) :: ReadyForEndif
! CHARACTER(len=2*MaxNameLength), DIMENSION(:), ALLOCATABLE :: DummyError
! FLOW:
LineNum = 1
NestedIFDepth = 0
ReadyForElse=.false.
ReadyForEndif=.false.
SavedIfInstructionNum = 0
SavedGotoInstructionNum = 0
NumGotos = 0
NestedWhileDepth = 0
SavedWhileInstructionNum =0
SavedWhileExpressionNum = 0
NumWhileGotos = 0
DO WHILE (LineNum <= ErlStack(StackNum)%NumLines)
Line = ADJUSTL(ErlStack(StackNum)%Line(LineNum))
IF (LEN_TRIM(Line) == 0) THEN
LineNum = LineNum + 1
CYCLE ! Blank lines can be skipped
END IF
Pos = SCAN(TRIM(Line), ' ')
IF (Pos == 0) Pos = LEN_TRIM(Line) + 1
! Keyword = MakeUpperCase(Line(1:Pos-1))
Keyword = Line(1:Pos-1)
Remainder = ADJUSTL(Line(Pos+1:))
SELECT CASE (Keyword)
CASE ('RETURN')
IF (DeveloperFlag) write(OutputFileDebug,fmta) 'RETURN "'//trim(Line)//'"'
IF (LEN_TRIM(Remainder) == 0) THEN
InstructionNum = AddInstruction(StackNum, LineNum, KeywordReturn)
ELSE
CALL ParseExpression(Remainder, StackNum, ExpressionNum, Line)
InstructionNum = AddInstruction(StackNum, LineNum, KeywordReturn, ExpressionNum)
END IF
CASE ('SET')
IF (DeveloperFlag) write(OutputFileDebug,fmta) 'SET "'//trim(Line)//'"'
Pos = SCAN(Remainder, '=')
IF (Pos == 0) THEN
CALL AddError(StackNum, LineNum, 'Equal sign missing for the SET instruction.')
ELSE IF (Pos == 1) THEN
CALL AddError(StackNum, LineNum, 'Variable name missing for the SET instruction.')
ELSE
Variable = ADJUSTL(Remainder(1:Pos-1)) ! VariableName would be more expressive
VariableNum = NewEMSVariable(Variable, StackNum)
! Check for invalid variable name
Expression = ADJUSTL(Remainder(Pos+1:))
IF (LEN_TRIM(Expression) == 0) THEN
CALL AddError(StackNum, LineNum, 'Expression missing for the SET instruction.')
ELSE
CALL ParseExpression(Expression, StackNum, ExpressionNum, Line)
InstructionNum = AddInstruction(StackNum, LineNum, KeywordSet, VariableNum, ExpressionNum)
END IF
END IF
CASE ('RUN')
IF (DeveloperFlag) write(OutputFileDebug,fmta) 'RUN "'//trim(Line)//'"'
IF (LEN_TRIM(Remainder) == 0) THEN
CALL AddError(StackNum, LineNum, 'Program or Subroutine name missing for the RUN instruction.')
ELSE
Pos = SCAN(Remainder, ' ')
Variable = MakeUpperCase(ADJUSTL(Remainder(1:Pos-1))) ! really the subroutine, or reference to instruction set
StackNum2 = FindItemInList(Variable, ErlStack%Name, NumErlStacks)
IF (StackNum2 == 0) THEN
CALL AddError(StackNum, LineNum,'Program or Subroutine name ['//TRIM(Variable)//'] not found for the RUN instruction.')
ELSE
InstructionNum = AddInstruction(StackNum, LineNum, KeywordRun, StackNum2)
END IF
END IF
CASE ('IF')
IF (DeveloperFlag) write(OutputFileDebug,fmta) 'IF "'//trim(Line)//'"'
IF (DeveloperFlag) write(OutputFileDebug,*) 'NestedIf=',NestedIFDepth
IF (LEN_TRIM(Remainder) == 0) THEN
CALL AddError(StackNum, LineNum, 'Expression missing for the IF instruction.')
ExpressionNum = 0
ELSE
Expression = ADJUSTL(Remainder)
CALL ParseExpression(Expression, StackNum, ExpressionNum, Line)
END IF
NestedIFDepth = NestedIFDepth + 1
ReadyForElse(NestedIFDepth)=.true.
ReadyForEndif(NestedIFDepth)=.true.
IF (NestedIFDepth > IfDepthAllowed) THEN
CALL AddError(StackNum,LineNum, 'Detected IF nested deeper than is allowed; need to terminate an earlier IF instruction.')
EXIT
ELSE
InstructionNum = AddInstruction(StackNum, LineNum, KeywordIf, ExpressionNum) ! Arg2 added at next ELSEIF, ELSE, ENDIF
SavedIfInstructionNum(NestedIFDepth) = InstructionNum
ENDIF
CASE ('ELSEIF')
IF (DeveloperFlag) write(OutputFileDebug,fmta) 'ELSEIF "'//trim(Line)//'"'
IF (DeveloperFlag) write(OutputFileDebug,*) 'NestedIf=',NestedIFDepth
IF (NestedIFDepth == 0) THEN
CALL AddError(StackNum, LineNum, 'Starting IF instruction missing for the ELSEIF instruction.')
EXIT ! Getting strange error on DEALLOCATE for the next instruction that I try to add, so doing EXIT here
END IF
! Complete the preceding block with a GOTO instruction
InstructionNum = AddInstruction(StackNum, 0, KeywordGoto) ! Arg2 is added at the ENDIF
NumGotos(NestedIFDepth) = NumGotos(NestedIFDepth) + 1
IF (NumGotos(NestedIFDepth) > ELSEIFLengthAllowed) THEN
CALL AddError(StackNum,LineNum, 'Detected ELSEIF series that is longer than allowed; terminate earlier IF instruction.')
EXIT
ELSE
SavedGotoInstructionNum(NestedIFDepth, NumGotos(NestedIFDepth)) = InstructionNum
ENDIF
IF (LEN_TRIM(Remainder) == 0) THEN
CALL AddError(StackNum, LineNum, 'Expression missing for the ELSEIF instruction.')
ExpressionNum = 0
ELSE
Expression = ADJUSTL(Remainder)
CALL ParseExpression(Expression, StackNum, ExpressionNum, Line)
END IF
InstructionNum = AddInstruction(StackNum, LineNum, KeywordIf, ExpressionNum) ! Arg2 added at next ELSEIF, ELSE, ENDIF
ErlStack(StackNum)%Instruction(SavedIfInstructionNum(NestedIFDepth))%Argument2 = InstructionNum
SavedIfInstructionNum(NestedIFDepth) = InstructionNum
CASE ('ELSE')
IF (DeveloperFlag) write(OutputFileDebug,fmta) 'ELSE "'//trim(Line)//'"'
IF (DeveloperFlag) write(OutputFileDebug,*) 'NestedIf=',NestedIFDepth
IF (NestedIFDepth == 0) THEN
CALL AddError(StackNum, LineNum, 'Starting IF instruction missing for the ELSE instruction.')
EXIT ! Getting strange error on DEALLOCATE for the next instruction that I try to add, so doing EXIT here
END IF
IF (.not. ReadyForElse(NestedIfDepth)) THEN
CALL AddError(StackNum, LineNum, 'ELSE statement without corresponding IF stetement.')
ENDIF
ReadyForElse(NestedIfDepth)=.false.
! Complete the preceding block with a GOTO instruction
InstructionNum = AddInstruction(StackNum, 0, KeywordGoto) ! Arg2 is added at the ENDIF
NumGotos(NestedIFDepth) = NumGotos(NestedIFDepth) + 1
IF (NumGotos(NestedIFDepth) > ELSEIFLengthAllowed) THEN
CALL AddError(StackNum,LineNum, 'Detected ELSEIF-ELSE series that is longer than allowed.')
EXIT
ELSE
SavedGotoInstructionNum(NestedIFDepth, NumGotos(NestedIFDepth)) = InstructionNum
ENDIF
IF (LEN_TRIM(Remainder) > 0) THEN
CALL AddError(StackNum, LineNum, 'Nothing is allowed to follow the ELSE instruction.')
END IF
InstructionNum = AddInstruction(StackNum, LineNum, KeywordElse) ! can make this into a KeywordIf?
ErlStack(StackNum)%Instruction(SavedIfInstructionNum(NestedIFDepth))%Argument2 = InstructionNum
SavedIfInstructionNum(NestedIFDepth) = InstructionNum
CASE ('ENDIF')
IF (DeveloperFlag) write(OutputFileDebug,fmta) 'ENDIF "'//trim(Line)//'"'
IF (DeveloperFlag) write(OutputFileDebug,*) 'NestedIf=',NestedIFDepth
IF (NestedIFDepth == 0) THEN
CALL AddError(StackNum, LineNum, 'Starting IF instruction missing for the ENDIF instruction.')
EXIT ! PE Getting strange error on DEALLOCATE for the next instruction that I try to add, so doing EXIT here
END IF
IF (.not. ReadyForEndif(NestedIfDepth)) THEN
CALL AddError(StackNum, LineNum, 'ENDIF statement without corresponding IF stetement.')
ENDIF
ReadyForEndif(NestedIfDepth)=.false.
ReadyForElse(NestedIfDepth)=.false.
IF (LEN_TRIM(Remainder) > 0) THEN
CALL AddError(StackNum, LineNum, 'Nothing is allowed to follow the ENDIF instruction.')
END IF
InstructionNum = AddInstruction(StackNum, LineNum, KeywordEndIf)
ErlStack(StackNum)%Instruction(SavedIfInstructionNum(NestedIFDepth))%Argument2 = InstructionNum
! Go back and complete all of the GOTOs that terminate each IF and ELSEIF block
DO GotoNum = 1, NumGotos(NestedIFDepth)
InstructionNum2 = SavedGotoInstructionNum(NestedIFDepth, GotoNum)
ErlStack(StackNum)%Instruction(InstructionNum2)%Argument1 = InstructionNum
SavedGotoInstructionNum(NestedIFDepth, GotoNum) = 0
END DO
NumGotos(NestedIFDepth) = 0
SavedIfInstructionNum(NestedIFDepth) = 0
NestedIFDepth = NestedIFDepth - 1
CASE ('WHILE')
IF (DeveloperFlag) write(OutputFileDebug,fmta) 'WHILE "'//trim(Line)//'"'
IF (LEN_TRIM(Remainder) == 0) THEN
CALL AddError(StackNum, LineNum, 'Expression missing for the WHILE instruction.')
ExpressionNum = 0
ELSE
Expression = ADJUSTL(Remainder)
CALL ParseExpression(Expression, StackNum, ExpressionNum, Line)
END IF
NestedWhileDepth = NestedWhileDepth + 1
IF (NestedWhileDepth > WhileDepthAllowed) THEN
CALL AddError(StackNum,LineNum, &
'Detected WHILE nested deeper than is allowed; need to terminate an earlier WHILE instruction.')
EXIT
ELSE
InstructionNum = AddInstruction(StackNum, LineNum, KeywordWhile, ExpressionNum)
SavedWhileInstructionNum = InstructionNum
SavedWhileExpressionNum = ExpressionNum
ENDIF
CASE ('ENDWHILE')
IF (DeveloperFlag) write(OutputFileDebug,fmta) 'ENDWHILE "'//trim(Line)//'"'
IF (NestedWhileDepth == 0) THEN
CALL AddError(StackNum, LineNum, 'Starting WHILE instruction missing for the ENDWHILE instruction.')
EXIT
END IF
IF (LEN_TRIM(Remainder) > 0) THEN
CALL AddError(StackNum, LineNum, 'Nothing is allowed to follow the ENDWHILE instruction.')
END IF
InstructionNum = AddInstruction(StackNum, LineNum, KeywordEndWhile)
ErlStack(StackNum)%Instruction(SavedWhileInstructionNum)%Argument2 = InstructionNum
ErlStack(StackNum)%Instruction(InstructionNum)%Argument1 = SavedWhileExpressionNum
ErlStack(StackNum)%Instruction(InstructionNum)%Argument2 = SavedWhileInstructionNum
NestedWhileDepth = 0
SavedWhileInstructionNum =0
SavedWhileExpressionNum = 0
CASE DEFAULT
IF (DeveloperFlag) write(OutputFileDebug,fmta) 'ERROR "'//trim(Line)//'"'
CALL AddError(StackNum, LineNum, 'Unknown keyword ['//TRIM(Keyword)//'].')
END SELECT
LineNum = LineNum + 1
END DO ! LineNum
IF (NestedIFDepth == 1) THEN
CALL AddError(StackNum, 0, 'Missing an ENDIF instruction needed to terminate an earlier IF instruction.')
ELSE IF (NestedIFDepth > 1) THEN
CALL AddError(StackNum, 0, &
'Missing '//TRIM(IntegerToString(NestedIFDepth))//' ENDIF instructions needed to terminate earlier IF instructions.')
END IF
! ALLOCATE(DummyError(ErlStack(StackNum)%NumErrors))
! DummyError = ErlStack(StackNum)%Error
RETURN
END SUBROUTINE ParseStack