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.
RECURSIVE FUNCTION EvaluateStack(StackNum) RESULT(ReturnValue)
! SUBROUTINE INFORMATION:
! AUTHOR Peter Graham Ellis
! DATE WRITTEN June 2006
! MODIFIED Brent Griffith, May 2009
! Brent Griffith, March 2012, add While loop support
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! Runs a stack with the interpreter.
! METHODOLOGY EMPLOYED:
!
! USE STATEMENTS:
USE DataInterfaces, ONLY: ShowFatalError
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
INTEGER, INTENT(IN) :: StackNum
TYPE(ErlValueType) :: ReturnValue
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
INTEGER :: InstructionNum
INTEGER :: InstructionNum2
INTEGER :: ExpressionNum
REAL(r64) :: ReturnValueActual ! for testing
INTEGER , SAVE :: VariableNum
INTEGER :: WhileLoopExitCounter ! to avoid infinite loop in While loop
WhileLoopExitCounter = 0
ReturnValue%Type = ValueNumber
ReturnValue%Number = 0.0d0
InstructionNum = 1
DO WHILE (InstructionNum <= ErlStack(StackNum)%NumInstructions)
SELECT CASE (ErlStack(StackNum)%Instruction(InstructionNum)%Keyword)
CASE (KeywordNone)
! There probably shouldn't be any of these
CASE (KeywordReturn)
IF (ErlStack(StackNum)%Instruction(InstructionNum)%Argument1 > 0) &
ReturnValue = EvaluateExpression(ErlStack(StackNum)%Instruction(InstructionNum)%Argument1)
CALL WriteTrace(StackNum, InstructionNum, ReturnValue)
EXIT ! RETURN always terminates an instruction stack
CASE (KeywordSet)
ReturnValue = EvaluateExpression(ErlStack(StackNum)%Instruction(InstructionNum)%Argument2)
VariableNum = ErlStack(StackNum)%Instruction(InstructionNum)%Argument1
IF ((.NOT. ErlVariable(VariableNum)%ReadOnly) .AND. (.NOT. ErlVariable(VariableNum)%Value%TrendVariable)) THEN
ErlVariable(VariableNum)%Value = ReturnValue
ELSEIF (ErlVariable(VariableNum)%Value%TrendVariable) THEN
ErlVariable(VariableNum)%Value%Number = ReturnValue%Number
ErlVariable(VariableNum)%Value%Error = ReturnValue%Error
ENDIF
CALL WriteTrace(StackNum, InstructionNum, ReturnValue)
CASE (KeywordRun)
ReturnValue%Type = ValueString
ReturnValue%String = ''
CALL WriteTrace(StackNum, InstructionNum, ReturnValue)
ReturnValue = EvaluateStack(ErlStack(StackNum)%Instruction(InstructionNum)%Argument1)
CASE (KeywordIf, KeywordElse) ! same???
ExpressionNum = ErlStack(StackNum)%Instruction(InstructionNum)%Argument1
InstructionNum2 = ErlStack(StackNum)%Instruction(InstructionNum)%Argument2
IF (ExpressionNum > 0) THEN ! could be 0 if this was an ELSE
ReturnValue = EvaluateExpression(ExpressionNum)
CALL WriteTrace(StackNum, InstructionNum, ReturnValue)
IF (ReturnValue%Number == 0.0d0) THEN ! This is the FALSE case
! Eventually should handle strings and arrays too
InstructionNum = InstructionNum2
CYCLE
END IF
ELSE
! KeywordELSE -- kind of a kludge
ReturnValue%Type = ValueNumber
ReturnValue%Number = 1.0d0
CALL WriteTrace(StackNum, InstructionNum, ReturnValue)
END IF
CASE (KeywordGoto)
InstructionNum = ErlStack(StackNum)%Instruction(InstructionNum)%Argument1
! For debug purposes only...
ReturnValue%Type = ValueString
ReturnValue%String = '' !IntegerToString(InstructionNum)
CYCLE
! PE if this ever went out of bounds, would the DO loop save it? or need check here?
CASE (KeywordEndIf)
ReturnValue%Type = ValueString
ReturnValue%String = ''
CALL WriteTrace(StackNum, InstructionNum, ReturnValue)
CASE (KeywordWhile)
! evaluate expresssion at while, skip to past endwhile if not true
ExpressionNum = ErlStack(StackNum)%Instruction(InstructionNum)%Argument1
InstructionNum2 = ErlStack(StackNum)%Instruction(InstructionNum)%Argument2
ReturnValue = EvaluateExpression(ExpressionNum)
CALL WriteTrace(StackNum, InstructionNum, ReturnValue)
IF (ReturnValue%Number == 0.0d0) THEN ! This is the FALSE case
! Eventually should handle strings and arrays too
InstructionNum = InstructionNum2
! CYCLE
END IF
CASE (KeywordEndWhile)
! reevaluate expression at While and goto there if true, otherwise continue
ExpressionNum = ErlStack(StackNum)%Instruction(InstructionNum)%Argument1
InstructionNum2 =ErlStack(StackNum)%Instruction(InstructionNum)%Argument2
ReturnValue = EvaluateExpression(ExpressionNum)
IF ((ReturnValue%Number /= 0.0d0) .AND. (WhileLoopExitCounter <= MaxWhileLoopIterations)) THEN ! This is the True case
! Eventually should handle strings and arrays too
CALL WriteTrace(StackNum, InstructionNum, ReturnValue) ! duplicative?
InstructionNum = InstructionNum2
WhileLoopExitCounter = WhileLoopExitCounter + 1
CYCLE
ELSE ! false, leave while block
IF (WhileLoopExitCounter > MaxWhileLoopIterations) THEN
WhileLoopExitCounter = 0
ReturnValue%Type = ValueError
ReturnValue%Error = 'Maximum WHILE loop iteration limit reached'
CALL WriteTrace(StackNum, InstructionNum, ReturnValue)
ELSE
ReturnValue%Type = ValueNumber
ReturnValue%Number = 0.0d0
CALL WriteTrace(StackNum, InstructionNum, ReturnValue)
WhileLoopExitCounter = 0
ENDIF
END IF
CASE DEFAULT
CALL ShowFatalError('Fatal error in RunStack: Unknown keyword.')
END SELECT
InstructionNum = InstructionNum + 1
END DO ! InstructionNum
ReturnValueActual = (4.91d0 + 632.d0) / (32.d0 * (4.d0 - 10.2d0)) ! must have extra periods
RETURN
END FUNCTION EvaluateStack