/// <summary>
/// Constructs a Fortran compiler object with the given options.
/// </summary>
/// <param name="opts">Compiler options</param>
public Compiler(FortranOptions opts)
{
_globalSymbols = new SymbolCollection("Global"); // Functions and Subroutines
_localSymbols = new SymbolCollection("Local"); // Everything else including labels
_ptree = new CollectionParseNode();
_messages = new MessageCollection(opts);
_entryPointName = "Main";
_opts = opts;
}
// Logical IF
ParseNode KLogicalIf(ParseNode expr)
{
ConditionalParseNode node = new ConditionalParseNode();
_parsingIf = true;
CollectionParseNode body = new CollectionParseNode();
body.Add(Statement(_ls.GetKeyword()));
_parsingIf = false;
node.Add(expr, body);
return node;
}
// Block IF
ParseNode KBlockIf(ParseNode expr)
{
ConditionalParseNode node = new ConditionalParseNode();
TokenID id;
do {
ParseNode labelNode;
CollectionParseNode statements = new CollectionParseNode();
SimpleToken token = _ls.GetKeyword();
++_blockDepth;
while (!IsEndOfIfBlock(token.ID)) {
labelNode = CheckLabel();
if (labelNode != null) {
statements.Add(labelNode);
}
ParseNode subnode = Statement(token);
if (subnode != null) {
statements.Add(MarkLine());
statements.Add(subnode);
}
ExpectEndOfLine();
token = _ls.GetKeyword();
}
--_blockDepth;
// Labels on terminators are valid so we need
// to check for and add those.
labelNode = CheckLabel();
if (labelNode != null) {
statements.Add(labelNode);
}
node.Add(expr, statements);
id = token.ID;
if (id == TokenID.KELSEIF) {
ExpectToken(TokenID.LPAREN);
expr = Expression();
ExpectToken(TokenID.RPAREN);
ExpectToken(TokenID.KTHEN);
ExpectEndOfLine();
} else if (id == TokenID.KELSE) {
// We mark the end of the sequence of IF blocks with
// a null expression.
expr = null;
ExpectEndOfLine();
}
} while(id == TokenID.KELSEIF || id == TokenID.KELSE);
_ls.BackToken();
ExpectToken(TokenID.KENDIF);
return node;
}
// Recursive validation of a block and all sub-blocks. Currently the only
// validation done at this point is for GO TO to verify we're not jumping
// into the middle of an inner block.
void ValidateBlock(int level, CollectionParseNode blockNodes)
{
string filename = null;
int line = 0;
foreach (ParseNode node in blockNodes.Nodes) {
switch (node.ID) {
case ParseID.COND: {
// Block IF statement. One sub-block for each
// IF...ELSE...ENDIF group.
ConditionalParseNode tokenNode = (ConditionalParseNode)node;
for (int m = 1; m < tokenNode.BodyList.Count; m += 2) {
if (tokenNode.BodyList[m] != null) {
ValidateBlock(level + 1, tokenNode.BodyList[m]);
}
}
break;
}
case ParseID.FILENAME: {
MarkFilenameParseNode tokenNode = (MarkFilenameParseNode)node;
filename = tokenNode.Filename;
break;
}
case ParseID.LINENUMBER: {
MarkLineParseNode tokenNode = (MarkLineParseNode)node;
line = tokenNode.LineNumber;
break;
}
case ParseID.LOOP:
ValidateBlock(level + 1, ((LoopParseNode)node).LoopBody);
break;
case ParseID.GOTO: {
GotoParseNode tokenNode = (GotoParseNode)node;
if (tokenNode.Nodes.Count > 0) {
SymbolParseNode symNode = (SymbolParseNode)tokenNode.Nodes[0];
Symbol sym = symNode.Symbol;
if (sym.Depth > level) {
_messages.Error(filename, MessageCode.GOTOINTOBLOCK, line, "GOTO into an inner block");
}
}
break;
}
}
}
}
// Parse the body of a standard DO or DO WHILE loop.
CollectionParseNode ParseDoBody(SymbolParseNode endLabelNode)
{
CollectionParseNode statements = new CollectionParseNode();
bool loopDone = false;
SimpleToken token = _ls.GetKeyword();
++_blockDepth;
do {
ParseNode labelNode = CheckLabel();
if (labelNode != null) {
statements.Add(labelNode);
}
if (token.ID == TokenID.KENDDO) {
_messages.Warning(MessageCode.NONSTANDARDENDDO, 4, "Use of ENDDO is non-standard");
loopDone = true;
break;
}
statements.Add(MarkLine());
ParseNode subnode = Statement(token);
if (subnode != null) {
statements.Add(subnode);
}
if (_ls.HasLabel && endLabelNode != null && _ls.Label == endLabelNode.Symbol.Name) {
loopDone = true;
break;
}
ExpectEndOfLine();
token = _ls.GetKeyword();
} while (token.ID != TokenID.ENDOFFILE);
--_blockDepth;
if (!loopDone) {
_messages.Error(MessageCode.MISSINGDOENDLABEL, "End label for DO loop not found");
}
return statements;
}
/// <summary>
/// Adds a conditional and body.
/// </summary>
/// <param name="expr">Conditional expression node</param>
/// <param name="body">Statements to be executed</param>
public void Add(ParseNode expr, CollectionParseNode body)
{
_exprList.Add(expr);
_bodyList.Add(body);
}
/// Starts a subroutine block. For this, we create a separate symbol table
/// to supplement the main one.
ParseNode KSubFunc(SymClass klass, string methodName, SymFullType returnType)
{
ProcedureParseNode node = new ProcedureParseNode();
EnsureNoLabel();
// Add the name to the global scope, ensuring it hasn't already been
// defined.
if (methodName == null) {
IdentifierToken identToken = ExpectIdentifierToken();
if (identToken == null) {
SkipToEndOfLine();
return null;
}
methodName = identToken.Name;
}
Symbol method = _globalSymbols.Get(methodName);
if (method != null && method.Defined && !method.IsExternal) {
_messages.Error(MessageCode.SUBFUNCDEFINED, String.Format("{0} already defined", methodName));
SkipToEndOfLine();
return null;
}
// Reset the COMMON indexes for this program unit
foreach (Symbol sym in _globalSymbols) {
if (sym.Type == SymType.COMMON) {
sym.CommonIndex = 0;
}
}
// New local symbol table for this block
_localSymbols = new SymbolCollection("Local");
_hasReturn = false;
// Parameter list allowed for subroutines and functions, but
// not the main program.
Collection<Symbol> parameters = null;
int alternateReturnCount = 0;
switch (klass) {
case SymClass.PROGRAM:
parameters = new Collection<Symbol>();
klass = SymClass.SUBROUTINE;
methodName = _entryPointName;
break;
case SymClass.FUNCTION:
parameters = ParseParameterDecl(_localSymbols, SymScope.PARAMETER, out alternateReturnCount);
break;
case SymClass.SUBROUTINE:
parameters = ParseParameterDecl(_localSymbols, SymScope.PARAMETER, out alternateReturnCount);
if (alternateReturnCount > 0) {
returnType = new SymFullType(SymType.INTEGER);
}
break;
}
// Don't allow alternate returns for anything except subroutines
if (alternateReturnCount > 0 && klass != SymClass.SUBROUTINE) {
_messages.Error(MessageCode.ALTRETURNNOTALLOWED, "Alternate return only permitted for subroutines");
}
// Add this method to the global symbol table now.
if (method == null) {
method = _globalSymbols.Add(methodName, new SymFullType(), klass, null, _ls.LineNumber);
}
method.Parameters = parameters;
method.Defined = true;
method.Class = klass;
if (returnType.Type != SymType.NONE) {
method.FullType = returnType;
}
if (methodName == _entryPointName) {
method.Modifier |= SymModifier.ENTRYPOINT;
_hasProgram = true;
}
// Special case for functions. Create a local symbol with the same
// name to be used for the return value.
if (klass == SymClass.FUNCTION || alternateReturnCount > 0) {
method.RetVal = _localSymbols.Add(methodName, returnType, SymClass.VAR, null, _ls.LineNumber);
method.RetVal.Modifier = SymModifier.RETVAL;
}
node.ProcedureSymbol = method;
node.LocalSymbols = _localSymbols;
node.LabelList = new Collection<ParseNode>();
_currentProcedure = node;
_currentProcedure.AlternateReturnCount = alternateReturnCount;
_initList = new CollectionParseNode();
node.InitList = _initList;
// Compile the body of the procedure
SimpleToken token = _ls.GetKeyword();
while (token.ID != TokenID.ENDOFFILE) {
if (token.ID != TokenID.EOL) {
ParseNode labelNode = CheckLabel();
if (labelNode != null) {
node.Add(labelNode);
}
if (token.ID == TokenID.KEND) {
break;
}
ParseNode lineNode = Statement(token);
if (lineNode != null) {
node.Add(MarkLine());
node.Add(lineNode);
}
ExpectEndOfLine();
}
token = _ls.GetKeyword();
}
// If we hit the end of the file first then we're missing
// a mandatory END statement.
if (token.ID != TokenID.KEND) {
_messages.Error(MessageCode.MISSINGENDSTATEMENT, "Missing END statement");
}
// Make sure we have a RETURN statement.
if (!_hasReturn) {
node.Add(new ReturnParseNode());
}
// Validate the block.
foreach (Symbol sym in _localSymbols) {
if (sym.IsLabel && !sym.Defined) {
_messages.Error(MessageCode.UNDEFINEDLABEL, sym.RefLine, String.Format("Undefined label {0}", sym.Name));
}
if (_saveAll && sym.IsLocal) {
sym.Modifier |= SymModifier.STATIC;
}
// For non-array characters, if there's no value, set the empty string
if (sym.Type == SymType.FIXEDCHAR && !sym.IsArray && !sym.Value.HasValue) {
sym.Value = new Variant(string.Empty);
}
if (!sym.IsReferenced && !(sym.Modifier.HasFlag(SymModifier.RETVAL))) {
string scopeName = (sym.IsParameter) ? "parameter" : (sym.IsLabel) ? "label" : "variable";
_messages.Warning(MessageCode.UNUSEDVARIABLE,
3,
sym.RefLine,
String.Format("Unused {0} {1} in function", scopeName, sym.Name));
}
}
ValidateBlock(0, node);
_state = BlockState.SPECIFICATION;
return node;
}