/**********************************************************************
* punit.c
* Parse a pascal unit file
*
* Copyright (C) 2008-2009 Gregory Nutt. All rights reserved.
* Author: Gregory Nutt <gnutt@nuttx.org>
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions
* are met:
*
* 1. Redistributions of source code must retain the above copyright
* notice, this list of conditions and the following disclaimer.
* 2. Redistributions in binary form must reproduce the above copyright
* notice, this list of conditions and the following disclaimer in
* the documentation and/or other materials provided with the
* distribution.
* 3. Neither the name NuttX nor the names of its contributors may be
* used to endorse or promote products derived from this software
* without specific prior written permission.
*
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
* FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
* COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
* INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
* BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS
* OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED
* AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
* LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
* ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
* POSSIBILITY OF SUCH DAMAGE.
*
**********************************************************************/
/**********************************************************************
* Included Files
**********************************************************************/
#include <stdint.h>
#include <stdio.h>
#include <stdlib.h>
#include <ctype.h>
#include <string.h>
#include <errno.h>
#include "keywords.h"
#include "pasdefs.h"
#include "ptdefs.h"
#include "podefs.h"
#include "pedefs.h"
#include "poff.h" /* FHT_ definitions */
#include "pas.h" /* for globals */
#include "pblck.h" /* for block(), constantDefinitionGroup(), etc. */
#include "pgen.h" /* for pas_Generate*() */
#include "ptkn.h" /* for getToken() */
#include "ptbl.h" /* for addFile() */
#include "pofflib.h" /* For poff*() functions*/
#include "perr.h" /* for error() */
#include "pprgm.h" /* for usesSection() */
#include "punit.h"
/***********************************************************************
* Pre-processor Definitions
***********************************************************************/
#define intAlign(x) (((x) + (sINT_SIZE-1)) & (~(sINT_SIZE-1)))
/***********************************************************************
* Private Function Prototypes
***********************************************************************/
static void interfaceSection (void);
static void exportedProcedureHeading (void);
static void exportedFunctionHeading (void);
/***********************************************************************
* Global Functions
***********************************************************************/
/* This function is called only main() when the first token parsed out
* the specified file is 'unit'. In this case, we are parsing a unit file
* and generating a unit binary.
*/
void unitImplementation(void)
{
char *saveTknStart = tkn_strt;
TRACE(lstFile, "[unitImplementation]");
/* FORM: unit =
* unit-heading ';' interface-section implementation-section
* init-section '.'
* FORM: unit-heading = 'unit' identifer
* FORM: interface-section =
* 'interface' [ uses-section ] interface-declaration
* FORM: implementation-section =
* 'implementation' [ uses-section ] declaration-group
* FORM: init-section =
* 'initialization statement-sequence
* ['finalization' statement-sequence] 'end' |
* compound-statement | 'end'
*
* On entry, the 'unit' keyword has already been parsed. The
* current token should point to the identifier following unit.
*/
/* Skip over the unit identifier (the caller has already verified
* that we are processing the correct unit).
*/
if (token != tIDENT) error(eIDENT);
/* Set a UNIT indication in the output poff file header */
poffSetFileType(poffHandle, FHT_UNIT, 0, tkn_strt);
poffSetArchitecture(poffHandle, FHA_PCODE);
/* Discard the unit name and get the next token */
stringSP = saveTknStart;
getToken();
/* Skip over the semicolon separating the unit-heading from the
* interface-section.
*/
if (token != ';') error(eSEMICOLON);
else getToken();
/* Verify that the interface-section is present
* FORM: interface-section =
* 'interface' [ uses-section ] interface-declaration
*/
interfaceSection();
/* Verify that the implementation section is present
* FORM: implementation-section =
* 'implementation' [ uses-section ] declaration-group
*/
if (token != tIMPLEMENTATION) error(eIMPLEMENTATION);
else getToken();
FP->section = eIsImplementationSection;
/* Check for the presence of an optional uses-section */
if (token == tUSES)
{
/* Process the uses-section */
getToken();
usesSection();
}
/* Now, process the declaration-group
*
* FORM: implementation-section =
* 'implementation' [ uses-section ] declaration-group
* FORM: init-section =
* 'initialization statement-sequence
* ['finalization' statement-sequence] 'end' |
* compound-statement | 'end'
*/
declarationGroup(0);
/* Process the init-section
* FORM: init-section =
* 'initialization statement-sequence
* ['finalization' statement-sequence] 'end' |
* compound-statement | 'end'
*
* Not yet... for now, we only require the 'end'
*/
FP->section = eIsInitializationSection;
if (token != tEND) error(eEND);
else getToken();
FP->section = eIsOtherSection;
/* Verify that the unit file ends with a period */
if (token != '.') error(ePERIOD);
}
/***********************************************************************/
/* This logic is called from usersSection after any a uses-section is
* encountered in any file at any level. In this case, we are only
* going to parse the interface section from the unit file.
*/
void unitInterface(void)
{
int32_t savedDStack = dstack;
TRACE(lstFile, "[unitInterface]");
/* FORM: unit =
* unit-heading ';' interface-section implementation-section
* init-section
* FORM: unit-heading = 'unit' identifer
*
* On entry, the 'unit' keyword has already been parsed. The
* current token should point to the identifier following unit.
*/
/* Skip over the unit identifier (the caller has already verified
* that we are processing the correct unit).
*/
if (token != tIDENT) error(eIDENT);
else getToken();
/* Skip over the semicolon separating the unit-heading from the
* interface-section.
*/
if (token != ';') error(eSEMICOLON);
else getToken();
/* Process the interface-section
* FORM: interface-section =
* 'interface' [ uses-section ] interface-declaration
*/
interfaceSection();
/* Verify that the implementation section is present
* FORM: implementation-section =
* 'implementation' [ uses-section ] declaration-group
*/
if (token != tIMPLEMENTATION) error(eIMPLEMENTATION);
/* Then just ignore the rest of the file. We'll let the compilation
* of the unit file check the correctness of the implementation.
*/
FP->section = eIsOtherSection;
/* If we are generating a program binary, then all variables declared
* by this logic a bonafide. But if are generating UNIT binary, then
* all variables declared as imported with a relative stack offset.
* In this case, we must release any data stack allocated in this
* process.
*/
dstack = savedDStack;
}
/***********************************************************************
* Private Functions
***********************************************************************/
static void interfaceSection(void)
{
int16_t saveNSym = nsym; /* Save top of symbol table */
int16_t saveNConst = nconst; /* Save top of constant table */
TRACE(lstFile, "[interfaceSection]");
/* FORM: interface-section =
* 'interface' [ uses-section ] interface-declaration
*
* On entry, the unit-heading keyword has already been parsed. The
* current token should point to the identifier following unit.
*/
if (token != tINTERFACE) error(eINTERFACE);
else getToken();
FP->section = eIsInterfaceSection;
/* Check for the presence of an optional uses-section */
if (token == tUSES)
{
/* Process the uses-section */
getToken();
usesSection();
}
/* Process the interface-declaration
*
* FORM: interface-declaration =
* [ constant-definition-group ] [ type-definition-group ]
* [ variable-declaration-group ] exported-heading
*/
/* Process optional constant-definition-group.
* FORM: constant-definition-group =
* 'const' constant-definition ';' { constant-definition ';' }
*/
if (token == tCONST)
{
const_strt = saveNConst; /* Limit search to present level */
getToken(); /* Get identifier */
const_strt = 0;
/* Process constant-definition.
* FORM: constant-definition = identifier '=' constant
*/
constantDefinitionGroup();
} /* end if */
/* Process type-definition-group
* FORM: type-definition-group =
* 'type' type-definition ';' { type-definition ';' }
*/
if (token == tTYPE)
{
const_strt = saveNConst; /* Limit search to present level */
sym_strt = saveNSym;
getToken(); /* Get identifier */
const_strt = 0;
sym_strt = 0;
/* Process the type-definitions in the type-definition-group
* FORM: type-definition = identifier '=' type-denoter
*/
typeDefinitionGroup();
} /* end if */
/* Process the optional variable-declaration-group
* FORM: variable-declaration-group =
* 'var' variable-declaration { ';' variable-declaration }
*/
if (token == tVAR)
{
const_strt = saveNConst; /* Limit search to present level */
sym_strt = saveNSym;
getToken(); /* Get identifier */
const_strt = 0;
sym_strt = 0;
/* Process the variable declarations
* FORM: variable-declaration = identifier-list ':' type-denoter
* FORM: identifier-list = identifier { ',' identifier }
*/
variableDeclarationGroup();
} /* end if */
/* Process the exported-heading
*
* FORM: exported-heading =
* procedure-heading ';' [ directive ] |
* function-heading ';' [ directive ]
*/
for (;;)
{
/* FORM: function-heading =
* 'function' function-identifier [ formal-parameter-list ]
* ':' result-type
*/
if (token == tFUNCTION)
{
const_strt = saveNConst; /* Limit search to present level */
sym_strt = saveNSym;
getToken(); /* Get identifier */
const_strt = 0;
sym_strt = 0;
/* Process the interface declaration */
exportedFunctionHeading();
} /* end if */
/* FORM: procedure-heading =
* 'procedure' procedure-identifier [ formal-parameter-list ]
*/
else if (token == tPROCEDURE)
{
const_strt = saveNConst; /* Limit search to present level */
sym_strt = saveNSym;
getToken(); /* Get identifier */
const_strt = 0;
sym_strt = 0;
/* Process the interface declaration */
exportedProcedureHeading();
} /* end else if */
else break;
} /* end for */
/* We are finished with the interface section */
FP->section = eIsOtherSection;
}
/* Process Procedure Declaration Block */
static void exportedProcedureHeading(void)
{
uint16_t procLabel = ++label;
char *saveChSp;
STYPE *procPtr;
register int i;
TRACE(lstFile,"[exportedProcedureHeading]");
/* FORM: procedure-heading =
* 'procedure' identifier [ formal-parameter-list ]
* FORM: procedure-identifier = identifier
*
* On entry, token refers to token AFTER the 'procedure' reserved
* word.
*/
/* Process the procedure-heading */
if (token != tIDENT)
{
error (eIDENT);
return;
} /* endif */
procPtr = addProcedure(tkn_strt, sPROC, procLabel, 0, NULL);
/* Mark the procedure as external */
procPtr->sParm.p.flags |= SPROC_EXTERNAL;
/* Save the string stack pointer so that we can release all
* formal parameter strings later. Then get the next token.
*/
saveChSp = stringSP;
getToken();
/* NOTE: The level associated with the PROCEDURE symbol is the level
* At which the procedure was declared. Everything declare within the
* PROCEDURE is at the next level
*/
level++;
/* Process parameter list */
(void)formalParameterList(procPtr);
if (token != ';') error (eSEMICOLON);
else getToken();
/* If we are compiling a program or unit that "imports" the
* procedure then generate the appropriate symbol table entries
* in the output file to support relocation when the external
* procedure is called.
*/
if (includeIndex > 0)
{
pas_GenerateProcImport(procPtr);
}
/* Destroy formal parameter names */
for (i = 1; i <= procPtr->sParm.p.nParms; i++)
{
procPtr[i].sName = NULL;
}
stringSP = saveChSp;
/* Drop the level back to where it was */
level--;
} /* end exportedProcedureHeading */
/***************************************************************/
/* Process Function Declaration Block */
static void exportedFunctionHeading(void)
{
uint16_t funcLabel = ++label;
int16_t parameterOffset;
char *saveChSp;
STYPE *funcPtr;
register int i;
TRACE(lstFile,"[exportedFunctionHeading]");
/* FORM: function-declaration =
* function-heading ';' directive |
* function-heading ';' function-block
* FORM: function-heading =
* 'function' function-identifier [ formal-parameter-list ]
* ':' result-type
*
* On entry token should lrefer to the function-identifier.
*/
/* Verify function-identifier */
if (token != tIDENT)
{
error (eIDENT);
return;
} /* endif */
funcPtr = addProcedure(tkn_strt, sFUNC, funcLabel, 0, NULL);
/* Mark the procedure as external */
funcPtr->sParm.p.flags |= SPROC_EXTERNAL;
/* NOTE: The level associated with the FUNCTION symbol is the level
* At which the procedure was declared. Everything declare within the
* PROCEDURE is at the next level
*/
level++;
/* Save the string stack pointer so that we can release all
* formal parameter strings later. Then get the next token.
*/
saveChSp = stringSP;
getToken();
/* Process parameter list */
parameterOffset = formalParameterList(funcPtr);
/* Verify that the parameter list is followed by a colon */
if (token != ':') error (eCOLON);
else getToken();
/* Get function type, return value type/size and offset to return value */
if (token == sTYPE)
{
/* The offset to the return value is the offset to the last
* parameter minus the size of the return value (aligned to
* multiples of size of INTEGER).
*/
parameterOffset -= tknPtr->sParm.t.rsize;
parameterOffset = intAlign(parameterOffset);
/* Save the TYPE for the function */
funcPtr->sParm.p.parent = tknPtr;
/* Skip over the result-type token */
getToken();
} /* end if */
else
{
error(eINVTYPE);
}
/* Verify the final semicolon */
if (token != ';') error (eSEMICOLON);
else getToken();
/* If we are compiling a program or unit that "imports" the
* function then generate the appropriate symbol table entries
* in the output file to support relocation when the external
* function is called.
*/
if (includeIndex > 0)
{
pas_GenerateProcImport(funcPtr);
}
/* Destroy formal parameter names and the function return value name */
for (i = 1; i <= funcPtr->sParm.p.nParms; i++)
{
funcPtr[i].sName = ((char *) NULL);
}
stringSP = saveChSp;
/* Restore the original level */
level--;
} /* end exportedFunctionHeading */
