mirror of
https://gitee.com/mirrors_PX4/PX4-Autopilot.git
synced 2026-04-14 10:07:39 +08:00
add995c32e
git-svn-id: https://nuttx.svn.sourceforge.net/svnroot/nuttx/trunk@4200 7fd9a85b-ad96-42d3-883c-3090e2eb8679
2264 lines
61 KiB
C
2264 lines
61 KiB
C
/***************************************************************
|
|
* pblck.c
|
|
* Process a Pascal Block
|
|
*
|
|
* Copyright (C) 2008-2009 Gregory Nutt. All rights reserved.
|
|
* Author: Gregory Nutt <spudmonkey@racsa.co.cr>
|
|
*
|
|
* 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 <stdio.h>
|
|
#include <string.h>
|
|
|
|
#include "keywords.h"
|
|
#include "pasdefs.h"
|
|
#include "ptdefs.h"
|
|
#include "pedefs.h"
|
|
#include "podefs.h"
|
|
|
|
#include "pas.h"
|
|
#include "pblck.h"
|
|
#include "pexpr.h"
|
|
#include "pstm.h"
|
|
#include "pgen.h"
|
|
#include "ptkn.h"
|
|
#include "ptbl.h"
|
|
#include "pinsn.h"
|
|
#include "perr.h"
|
|
|
|
/***************************************************************
|
|
* Private Definitions
|
|
***************************************************************/
|
|
|
|
/* This macro implements a test for:
|
|
* FORM: unsigned-constant = integer-number | real-number |
|
|
* character-literal | string-literal | constant-identifier |
|
|
* 'nil'
|
|
*/
|
|
|
|
#define isConstant(x) \
|
|
( ((x) == tINT_CONST) \
|
|
|| ((x) == tBOOLEAN_CONST) \
|
|
|| ((x) == tCHAR_CONST) \
|
|
|| ((x) == tREAL_CONST) \
|
|
|| ((x) == sSCALAR_OBJECT))
|
|
|
|
#define isIntAligned(x) (((x) & (sINT_SIZE-1)) == 0)
|
|
#define intAlign(x) (((x) + (sINT_SIZE-1)) & (~(sINT_SIZE-1)))
|
|
|
|
/***************************************************************
|
|
* Private Function Prototypes
|
|
***************************************************************/
|
|
|
|
static void pas_DeclareLabel (void);
|
|
static void pas_DeclareConst (void);
|
|
static STYPE *pas_DeclareType (char *typeName);
|
|
static STYPE *pas_DeclareOrdinalType (char *typeName);
|
|
static STYPE *pas_DeclareVar (void);
|
|
static void pas_DeclareFile (void);
|
|
static void pas_ProcedureDeclaration (void);
|
|
static void pas_FunctionDeclaration (void);
|
|
|
|
static void pas_SetTypeSize (STYPE *typePtr, bool allocate);
|
|
static STYPE *pas_TypeIdentifier (bool allocate);
|
|
static STYPE *pas_TypeDenoter (char *typeName, bool allocate);
|
|
static STYPE *pas_NewComplexType (char *typeName);
|
|
static STYPE *pas_NewOrdinalType (char *typeName);
|
|
static STYPE *pas_OrdinalTypeIdentifier (bool allocate);
|
|
static STYPE *pas_GetArrayType (void);
|
|
static STYPE *pas_DeclareRecord (char *recordName);
|
|
static STYPE *pas_DeclareField (STYPE *recordPtr);
|
|
static STYPE *pas_DeclareParameter (bool pointerType);
|
|
static bool pas_IntAlignRequired (STYPE *typePtr);
|
|
|
|
/***************************************************************
|
|
* Private Global Variables
|
|
***************************************************************/
|
|
|
|
static int32_t g_nParms;
|
|
static int32_t g_dwVarSize;
|
|
|
|
/***************************************************************
|
|
* Public Functions
|
|
***************************************************************/
|
|
/* Process BLOCK. This function implements:
|
|
*
|
|
* block = declaration-group compound-statement
|
|
*
|
|
* Where block can appear in the followinging:
|
|
*
|
|
* function-block = block
|
|
* function-declaration =
|
|
* function-heading ';' directive |
|
|
* function-heading ';' function-block
|
|
*
|
|
* procedure-block = block
|
|
* procedure-declaration =
|
|
* procedure-heading ';' directive |
|
|
* procedure-heading ';' procedure-block
|
|
*
|
|
* program = program-heading ';' [ uses-section ] block '.'
|
|
*/
|
|
|
|
void block()
|
|
{
|
|
uint16_t beginLabel = ++label; /* BEGIN label */
|
|
int32_t saveDStack = dstack; /* Save DSEG size */
|
|
char *saveStringSP = stringSP; /* Save top of string stack */
|
|
int16_t saveNSym = nsym; /* Save top of symbol table */
|
|
int16_t saveNConst = nconst; /* Save top of constant table */
|
|
register int16_t i;
|
|
|
|
TRACE(lstFile,"[block]");
|
|
|
|
/* When we enter block at level zero, then we must be at the
|
|
* entry point to the program. Save the entry point label
|
|
* in the POFF file.
|
|
*/
|
|
|
|
if ((level == 0) && (FP0->kind == eIsProgram))
|
|
{
|
|
poffSetEntryPoint(poffHandle, label);
|
|
}
|
|
|
|
/* Init size of the new DSEG */
|
|
|
|
dstack = 0;
|
|
|
|
/* FORM: block = declaration-group compound-statement
|
|
* Process the declaration-group
|
|
*
|
|
* declaration-group =
|
|
* label-declaration-group |
|
|
* constant-definition-group |
|
|
* type-definition-group |
|
|
* variable-declaration-group |
|
|
* function-declaration |
|
|
* procedure-declaration
|
|
*/
|
|
|
|
declarationGroup(beginLabel);
|
|
|
|
/* Process the compound-statement
|
|
*
|
|
* FORM: compound-statement = 'begin' statement-sequence 'end'
|
|
*/
|
|
|
|
/* Verify that the compound-statement begins with BEGIN */
|
|
|
|
if (token != tBEGIN)
|
|
{
|
|
error (eBEGIN);
|
|
}
|
|
|
|
/* It may be necessary to jump around some local functions to
|
|
* get to the main body of the block. If any jumps are generated,
|
|
* they will come to the beginLabel emitted here.
|
|
*/
|
|
|
|
pas_GenerateDataOperation(opLABEL, (int32_t)beginLabel);
|
|
|
|
/* Since we don't know for certain how we got here, invalidate
|
|
* the level stack pointer (LSP). This is, of course, only
|
|
* meaningful on architectures that implement an LSP.
|
|
*/
|
|
|
|
pas_InvalidateCurrentStackLevel();
|
|
|
|
/* Then emit the compoundStatement itself */
|
|
|
|
if (dstack)
|
|
{
|
|
pas_GenerateDataOperation(opINDS, (int32_t)dstack);
|
|
}
|
|
|
|
compoundStatement();
|
|
|
|
if (dstack)
|
|
{
|
|
pas_GenerateDataOperation(opINDS, -(int32_t)dstack);
|
|
}
|
|
|
|
/* Make sure all declared labels were defined in the block */
|
|
|
|
verifyLabels(saveNSym);
|
|
|
|
/* Re-initialize file table -- clear files defined in this level */
|
|
|
|
for (i = 0; i <= MAX_FILES; i++)
|
|
{
|
|
if ((files [i].defined) && (files [i].flevel >= level)) {
|
|
files [i].defined = 0;
|
|
files [i].flevel = 0;
|
|
files [i].ftype = 0;
|
|
files [i].faddr = 0;
|
|
files [i].fsize = 0;
|
|
}
|
|
}
|
|
|
|
/* "Pop" declarations local to this block */
|
|
|
|
dstack = saveDStack; /* Restore old DSEG size */
|
|
stringSP = saveStringSP; /* Restore top of string stack */
|
|
nsym = saveNSym; /* Restore top of symbol table */
|
|
nconst = saveNConst; /* Restore top of constant table */
|
|
}
|
|
|
|
/***************************************************************/
|
|
/* Process declarative-part */
|
|
|
|
void declarationGroup(int32_t beginLabel)
|
|
{
|
|
int16_t notFirst = 0; /* Init count of nested procs */
|
|
int16_t saveNSym = nsym; /* Save top of symbol table */
|
|
int16_t saveNConst = nconst; /* Save top of constant table */
|
|
|
|
TRACE(lstFile,"[declarationGroup]");
|
|
|
|
/* FORM: declarative-part = { declaration-group }
|
|
* FORM: declaration-group =
|
|
* label-declaration-group | constant-definition-group |
|
|
* type-definition-group | variable-declaration-group |
|
|
* function-declaration | procedure-declaration
|
|
*/
|
|
|
|
/* Process label-declaration-group.
|
|
* FORM: label-declaration-group = 'label' label { ',' label } ';'
|
|
*/
|
|
|
|
if (token == tLABEL) pas_DeclareLabel();
|
|
|
|
/* Process 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();
|
|
}
|
|
|
|
/* 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();
|
|
}
|
|
|
|
/* Process 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();
|
|
}
|
|
|
|
/* Process procedure/function-declaration(s) if present
|
|
* FORM: function-declaration =
|
|
* function-heading ';' directive |
|
|
* function-heading ';' function-block
|
|
* FORM: procedure-declaration =
|
|
* procedure-heading ';' directive |
|
|
* procedure-heading ';' procedure-block
|
|
*
|
|
* NOTE: a JMP to the executable body of this block is generated
|
|
* if there are nested procedures and this is not level=0
|
|
*/
|
|
|
|
for (;;)
|
|
{
|
|
/* FORM: function-heading =
|
|
* 'function' identifier [ formal-parameter-list ] ':' result-type
|
|
*/
|
|
|
|
if (token == tFUNCTION)
|
|
{
|
|
/* Check if we need to put a jump around the function */
|
|
|
|
if ((beginLabel > 0) && !(notFirst) && (level > 0))
|
|
{
|
|
pas_GenerateDataOperation(opJMP, (int32_t)beginLabel);
|
|
}
|
|
|
|
/* Get the procedure-identifier */
|
|
|
|
const_strt = saveNConst; /* Limit search to present level */
|
|
sym_strt = saveNSym;
|
|
getToken(); /* Get identifier */
|
|
const_strt = 0;
|
|
sym_strt = 0;
|
|
|
|
/* Define the function */
|
|
|
|
pas_FunctionDeclaration();
|
|
notFirst++; /* No JMP next time */
|
|
}
|
|
|
|
/* FORM: procedure-heading =
|
|
* 'procedure' identifier [ formal-parameter-list ]
|
|
*/
|
|
|
|
else if (token == tPROCEDURE)
|
|
{
|
|
/* Check if we need to put a jump around the function */
|
|
|
|
if ((beginLabel > 0) && !(notFirst) && (level > 0))
|
|
{
|
|
pas_GenerateDataOperation(opJMP, (int32_t)beginLabel);
|
|
}
|
|
|
|
/* Get the procedure-identifier */
|
|
|
|
const_strt = saveNConst; /* Limit search to present level */
|
|
sym_strt = saveNSym;
|
|
getToken(); /* Get identifier */
|
|
const_strt = 0;
|
|
sym_strt = 0;
|
|
|
|
/* Define the procedure */
|
|
|
|
pas_ProcedureDeclaration();
|
|
notFirst++; /* No JMP next time */
|
|
}
|
|
else break;
|
|
}
|
|
}
|
|
|
|
/***************************************************************/
|
|
|
|
void constantDefinitionGroup(void)
|
|
{
|
|
/* Process constant-definition-group.
|
|
* FORM: constant-definition-group =
|
|
* 'const' constant-definition ';' { constant-definition ';' }
|
|
* FORM: constant-definition = identifier '=' constant
|
|
*
|
|
* On entry, token should point to the identifier of the first
|
|
* constant-definition.
|
|
*/
|
|
|
|
for (;;)
|
|
{
|
|
if (token == tIDENT)
|
|
{
|
|
pas_DeclareConst();
|
|
if (token != ';') break;
|
|
else getToken();
|
|
}
|
|
else break;
|
|
}
|
|
}
|
|
|
|
/***************************************************************/
|
|
|
|
void typeDefinitionGroup(void)
|
|
{
|
|
char *typeName;
|
|
|
|
/* Process type-definition-group
|
|
* FORM: type-definition-group =
|
|
* 'type' type-definition ';' { type-definition ';' }
|
|
* FORM: type-definition = identifier '=' type-denoter
|
|
*
|
|
* On entry, token refers to the first identifier (if any) of
|
|
* the type-definition list.
|
|
*/
|
|
|
|
for (;;)
|
|
{
|
|
if (token == tIDENT)
|
|
{
|
|
/* Save the type identifier */
|
|
|
|
typeName = tkn_strt;
|
|
getToken();
|
|
|
|
/* Verify that '=' follows the type identifier */
|
|
|
|
if (token != '=') error (eEQ);
|
|
else getToken();
|
|
|
|
(void)pas_DeclareType(typeName);
|
|
if (token != ';') break;
|
|
else getToken();
|
|
|
|
}
|
|
else break;
|
|
}
|
|
}
|
|
|
|
/***************************************************************/
|
|
|
|
void variableDeclarationGroup(void)
|
|
{
|
|
/* Process variable-declaration-group
|
|
* FORM: variable-declaration-group =
|
|
* 'var' variable-declaration { ';' variable-declaration }
|
|
* FORM: variable-declaration = identifier-list ':' type-denoter
|
|
* FORM: identifier-list = identifier { ',' identifier }
|
|
*
|
|
* Only entry, token holds the first identfier (if any) of the
|
|
* variable-declaration list.
|
|
*/
|
|
|
|
for (;;)
|
|
{
|
|
if (token == tIDENT)
|
|
{
|
|
(void)pas_DeclareVar();
|
|
if (token != ';') break;
|
|
else getToken();
|
|
}
|
|
else if (token == sFILE)
|
|
{
|
|
pas_DeclareFile();
|
|
if (token != ';') break;
|
|
else getToken();
|
|
}
|
|
else break;
|
|
}
|
|
}
|
|
|
|
/***************************************************************/
|
|
/* Process formal-parameter-list */
|
|
|
|
int16_t formalParameterList(STYPE *procPtr)
|
|
{
|
|
int16_t parameterOffset;
|
|
int16_t i;
|
|
bool pointerType;
|
|
|
|
TRACE(lstFile,"[formalParameterList]");
|
|
|
|
/* FORM: formal-parameter-list =
|
|
* '(' formal-parameter-section { ';' formal-parameter-section } ')'
|
|
* FORM: formal-parameter-section =
|
|
* value-parameter-specification |
|
|
* variable-parameter-specification |
|
|
* procedure-parameter-specification |
|
|
* function-parameter-specification
|
|
* FORM: value-parameter-specification =
|
|
* identifier-list ':' type-identifier
|
|
* FORM: variable-parameter-specification =
|
|
* 'var' identifier-list ':' type-identifier
|
|
*
|
|
* On entry token should refer to the '(' at the beginning of the
|
|
* (optional) formal parameter list.
|
|
*/
|
|
|
|
g_nParms = 0;
|
|
|
|
/* Check if the formal-parameter-list is present. It is optional in
|
|
* all contexts in which this function is called.
|
|
*/
|
|
|
|
if (token == '(')
|
|
{
|
|
/* Process each formal-parameter-section */
|
|
|
|
do
|
|
{
|
|
getToken();
|
|
|
|
/* Check for variable-parameter-specification */
|
|
|
|
if (token == tVAR)
|
|
{
|
|
pointerType = 1;
|
|
getToken();
|
|
}
|
|
else pointerType = 0;
|
|
|
|
/* Process the common part of the variable-parameter-specification
|
|
* and the value-parameter specification.
|
|
* NOTE that procedure-parameter-specification and
|
|
* function-parameter-specification are not yet supported.
|
|
*/
|
|
|
|
(void)pas_DeclareParameter(pointerType);
|
|
|
|
}
|
|
while (token == ';');
|
|
|
|
/* Verify that the formal parameter list terminates with a
|
|
* right parenthesis.
|
|
*/
|
|
|
|
if (token != ')') error (eRPAREN);
|
|
else getToken();
|
|
|
|
}
|
|
|
|
/* Save the number of parameters found in sPROC/sFUNC symbol table entry */
|
|
|
|
procPtr->sParm.p.nParms = g_nParms;
|
|
|
|
/* Now, calculate the parameter offsets from the size of each parameter */
|
|
|
|
parameterOffset = -sRETURN_SIZE;
|
|
for (i = g_nParms; i > 0; i--)
|
|
{
|
|
/* The offset to the next parameter is the offset to the previous
|
|
* parameter minus the size of the new parameter (aligned to
|
|
* multiples of size of INTEGER).
|
|
*/
|
|
|
|
parameterOffset -= procPtr[i].sParm.v.size;
|
|
parameterOffset = intAlign(parameterOffset);
|
|
procPtr[i].sParm.v.offset = parameterOffset;
|
|
}
|
|
|
|
return parameterOffset;
|
|
}
|
|
|
|
/***************************************************************
|
|
* Private Functions
|
|
***************************************************************/
|
|
/* Process LABEL block */
|
|
|
|
static void pas_DeclareLabel(void)
|
|
{
|
|
char *labelname; /* Label symbol table name */
|
|
|
|
TRACE(lstFile,"[pas_DeclareLabel]");
|
|
|
|
/* FORM: LABEL <integer>[,<integer>[,<integer>][...]]]; */
|
|
|
|
do
|
|
{
|
|
getToken();
|
|
if ((token == tINT_CONST) && (tknInt >= 0))
|
|
{
|
|
labelname = stringSP;
|
|
(void)sprintf (labelname, "%ld", tknInt);
|
|
while (*stringSP++);
|
|
(void)addLabel(labelname, ++label);
|
|
getToken();
|
|
}
|
|
else error(eINTCONST);
|
|
}
|
|
while (token == ',');
|
|
|
|
if (token != ';') error (eSEMICOLON);
|
|
else getToken();
|
|
}
|
|
|
|
/***************************************************************/
|
|
/* Process constant definition:
|
|
* FORM: constant-definition = identifier '=' constant
|
|
* FORM: constant = [ sign ] integer-number |
|
|
* [ sign ] real-number |
|
|
* [ sign ] constant-identifier |
|
|
* character-literal |
|
|
* string-literal
|
|
*/
|
|
|
|
static void pas_DeclareConst(void)
|
|
{
|
|
char *const_name;
|
|
|
|
TRACE(lstFile,"[pas_DeclareConst]");
|
|
|
|
/* FORM: <identifier> = <numeric constant|string>
|
|
* NOTE: Only integer constants are supported
|
|
*/
|
|
|
|
/* Save the name of the constant */
|
|
|
|
const_name = tkn_strt;
|
|
|
|
/* Verify that the name is followed by '=' and get the
|
|
* following constant value.
|
|
*/
|
|
|
|
getToken();
|
|
if (token != '=') error (eEQ);
|
|
else getToken();
|
|
|
|
/* Handle constant expressions */
|
|
|
|
constantExpression();
|
|
|
|
/* Add the constant to the symbol table based on the type of
|
|
* the constant found following the '= [ sign ]'
|
|
*/
|
|
|
|
switch (constantToken)
|
|
{
|
|
case tINT_CONST :
|
|
case tCHAR_CONST :
|
|
case tBOOLEAN_CONST :
|
|
case sSCALAR_OBJECT :
|
|
(void)addConstant(const_name, constantToken, &constantInt, NULL);
|
|
break;
|
|
|
|
case tREAL_CONST :
|
|
(void)addConstant(const_name, constantToken, (int32_t*)&constantReal, NULL);
|
|
break;
|
|
|
|
case tSTRING_CONST :
|
|
{
|
|
uint32_t offset = poffAddRoDataString(poffHandle, constantStart);
|
|
(void)addStringConst(const_name, offset, strlen(constantStart));
|
|
}
|
|
break;
|
|
|
|
default :
|
|
error(eINVCONST);
|
|
}
|
|
}
|
|
|
|
/***************************************************************/
|
|
/* Process TYPE declaration */
|
|
|
|
static STYPE *pas_DeclareType(char *typeName)
|
|
{
|
|
STYPE *typePtr;
|
|
|
|
TRACE(lstFile,"[pas_DeclareType]");
|
|
|
|
/* This function processes the type-denoter in
|
|
* FORM: type-definition = identifier '=' type-denoter
|
|
* FORM: array-type = 'array' '[' index-type-list ']' 'of' type-denoter
|
|
*/
|
|
|
|
/* FORM: type-denoter = type-identifier | new-type
|
|
* FORM: new-type = new-ordinal-type | new-complex-type
|
|
*/
|
|
|
|
typePtr = pas_NewComplexType(typeName);
|
|
if (typePtr == NULL)
|
|
{
|
|
/* Check for Simple Types */
|
|
|
|
typePtr = pas_DeclareOrdinalType(typeName);
|
|
if (typePtr == NULL)
|
|
{
|
|
error(eINVTYPE);
|
|
}
|
|
}
|
|
|
|
return typePtr;
|
|
}
|
|
|
|
/***************************************************************/
|
|
/* Process a simple TYPE declaration */
|
|
|
|
static STYPE *pas_DeclareOrdinalType(char *typeName)
|
|
{
|
|
STYPE *typePtr;
|
|
STYPE *typeIdPtr;
|
|
|
|
/* Declare a new ordinal type */
|
|
|
|
typePtr = pas_NewOrdinalType(typeName);
|
|
|
|
/* Otherwise, declare a type equivalent to a previously defined type
|
|
* NOTE: the following logic is incomplete. Its is only good for
|
|
* sKind == sType
|
|
*/
|
|
|
|
if (typePtr == NULL)
|
|
{
|
|
typeIdPtr = pas_TypeIdentifier(1);
|
|
if (typeIdPtr)
|
|
{
|
|
typePtr = addTypeDefine(typeName, typeIdPtr->sParm.t.type,
|
|
g_dwVarSize, typeIdPtr);
|
|
}
|
|
}
|
|
|
|
return typePtr;
|
|
}
|
|
|
|
/***************************************************************/
|
|
/* Process VAR declaration */
|
|
|
|
static STYPE *pas_DeclareVar(void)
|
|
{
|
|
STYPE *varPtr;
|
|
STYPE *typePtr;
|
|
char *varName;
|
|
|
|
TRACE(lstFile,"[pas_DeclareVar]");
|
|
|
|
/* FORM: variable-declaration = identifier-list ':' type-denoter
|
|
* FORM: identifier-list = identifier { ',' identifier }
|
|
*/
|
|
|
|
typePtr = NULL;
|
|
|
|
/* Save the current identifier */
|
|
|
|
varName = tkn_strt;
|
|
getToken();
|
|
|
|
/* A comma indicates that there is another indentifier int the
|
|
* identifier-list
|
|
*/
|
|
|
|
if (token == ',')
|
|
{
|
|
/* Yes ..Process the next identifer in the indentifier list
|
|
* via recursion
|
|
*/
|
|
|
|
getToken();
|
|
if (token != tIDENT) error(eIDENT);
|
|
else typePtr = pas_DeclareVar();
|
|
}
|
|
else
|
|
{
|
|
/* No.. verify that the identifer-list is followed by ';' */
|
|
|
|
if (token != ':') error(eCOLON);
|
|
else getToken();
|
|
|
|
/* Process the type-denoter */
|
|
|
|
typePtr = pas_TypeDenoter(varName, 1);
|
|
if (typePtr == NULL)
|
|
{
|
|
error(eINVTYPE);
|
|
}
|
|
}
|
|
|
|
if (typePtr)
|
|
{
|
|
uint8_t varType = typePtr->sParm.t.type;
|
|
|
|
/* Determine if alignment to INTEGER boundaries is necessary */
|
|
|
|
if ((!isIntAligned(dstack)) && (pas_IntAlignRequired(typePtr)))
|
|
dstack = intAlign(dstack);
|
|
|
|
/* Add the new variable to the symbol table */
|
|
|
|
varPtr = addVariable(varName, varType, dstack, g_dwVarSize, typePtr);
|
|
|
|
/* If the variable is declared in an interface section at level zero,
|
|
* then it is a candidate to imported or exported.
|
|
*/
|
|
|
|
if ((!level) && (FP->section == eIsInterfaceSection))
|
|
{
|
|
/* Are we importing or exporting the interface?
|
|
*
|
|
* PROGRAM EXPORTS:
|
|
* If we are generating a program binary (i.e., FP0->kind ==
|
|
* eIsProgram) then the variable memory allocation must appear
|
|
* on the initial stack allocation; therefore the variable
|
|
* stack offset myst be exported by the program binary.
|
|
*
|
|
* UNIT IMPORTS:
|
|
* If we are generating a unit binary (i.e., FP0->kind ==
|
|
* eIsUnit), then we are importing the level 0 stack offset
|
|
* from the main program.
|
|
*/
|
|
|
|
if (FP0->kind == eIsUnit)
|
|
{
|
|
/* Mark the symbol as external and replace the absolute
|
|
* offset with this relative offset.
|
|
*/
|
|
|
|
varPtr->sParm.v.flags |= SVAR_EXTERNAL;
|
|
varPtr->sParm.v.offset = dstack - FP->dstack;
|
|
|
|
/* IMPORT the symbol; assign an offset relative to
|
|
* the dstack at the beginning of this file
|
|
*/
|
|
|
|
pas_GenerateStackImport(varPtr);
|
|
}
|
|
else /* if (FP0->kind == eIsProgram) */
|
|
{
|
|
/* EXPORT the symbol */
|
|
|
|
pas_GenerateStackExport(varPtr);
|
|
}
|
|
}
|
|
|
|
/* In any event, bump the stack offset to include space for
|
|
* this new symbol. The 'bumped' stack offset will be the
|
|
* offset for the next variable that is declared.
|
|
*/
|
|
|
|
dstack += g_dwVarSize;
|
|
}
|
|
|
|
return typePtr;
|
|
}
|
|
|
|
/***************************************************************/
|
|
/* Process VAR FILE OF declaration */
|
|
|
|
static void pas_DeclareFile(void)
|
|
{
|
|
int16_t fileNumber = tknPtr->sParm.fileNumber;
|
|
STYPE *filePtr;
|
|
|
|
TRACE(lstFile,"[pas_DeclareFile]");
|
|
|
|
/* FORM: <file identifier> : FILE OF <type> */
|
|
/* OR: <file identifier> : <FILE OF type identifier> */
|
|
if (!(fileNumber)) error(eINVFILE);
|
|
else if (files [fileNumber].defined) error(eDUPFILE);
|
|
else {
|
|
|
|
/* Skip over the <file identifier> */
|
|
getToken();
|
|
|
|
/* Verify that a colon follows the <file identifier> */
|
|
if (token != ':') error (eCOLON);
|
|
else getToken();
|
|
|
|
/* Make sure that the data stack is aligned to INTEGER boundaries */
|
|
dstack = intAlign(dstack);
|
|
|
|
/* FORM: <file identifier> : FILE OF <type> */
|
|
if (token == sFILE_OF) {
|
|
|
|
files[fileNumber].defined = -1;
|
|
files[fileNumber].flevel = level;
|
|
files[fileNumber].ftype = tknPtr->sParm.t.type;
|
|
files[fileNumber].faddr = dstack;
|
|
files[fileNumber].fsize = tknPtr->sParm.t.asize;
|
|
dstack += (tknPtr->sParm.t.asize);
|
|
getToken();
|
|
|
|
}
|
|
|
|
/* FORM: <file identifier> : <FILE OF type identifier> */
|
|
else {
|
|
if (token != tFILE) error (eFILE);
|
|
else getToken();
|
|
if (token != tOF) error (eOF);
|
|
else getToken();
|
|
|
|
filePtr = pas_TypeIdentifier(1);
|
|
if (filePtr) {
|
|
|
|
files[fileNumber].defined = -1;
|
|
files[fileNumber].flevel = level;
|
|
files[fileNumber].ftype = filePtr->sParm.t.type;
|
|
files[fileNumber].faddr = dstack;
|
|
files[fileNumber].fsize = g_dwVarSize;
|
|
dstack += g_dwVarSize;
|
|
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
/***************************************************************/
|
|
/* Process Procedure Declaration Block */
|
|
|
|
static void pas_ProcedureDeclaration(void)
|
|
{
|
|
uint16_t procLabel = ++label;
|
|
char *saveStringSP;
|
|
STYPE *procPtr;
|
|
register int i;
|
|
|
|
TRACE(lstFile,"[pas_ProcedureDeclaration]");
|
|
|
|
/* FORM: procedure-declaration =
|
|
* procedure-heading ';' directive |
|
|
* procedure-heading ';' procedure-block
|
|
* 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;
|
|
}
|
|
|
|
/* Add the procedure to the symbol table */
|
|
|
|
procPtr = addProcedure(tkn_strt, sPROC, procLabel, 0, NULL);
|
|
|
|
/* Save the string stack pointer so that we can release all
|
|
* formal parameter strings later. Then get the next token.
|
|
*/
|
|
|
|
saveStringSP = 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 here then we know that we are either in a program file
|
|
* or the 'implementation' part of a unit file (see punit.c -- At present,
|
|
* the procedure declarations of the 'interface' section of a unit file
|
|
* follow a different path). In the latter case (only), we should export
|
|
* every procedure declared at level zero.
|
|
*/
|
|
|
|
if ((level == 1) && (FP->kind == eIsUnit))
|
|
{
|
|
/* EXPORT the procedure symbol. */
|
|
|
|
pas_GenerateProcExport(procPtr);
|
|
}
|
|
|
|
/* Save debug information about the procedure */
|
|
|
|
pas_GenerateDebugInfo(procPtr, 0);
|
|
|
|
/* Process block */
|
|
|
|
pas_GenerateDataOperation(opLABEL, (int32_t)procLabel);
|
|
block();
|
|
|
|
/* Destroy formal parameter names */
|
|
|
|
for (i = 1; i <= procPtr->sParm.p.nParms; i++)
|
|
{
|
|
procPtr[i].sName = NULL;
|
|
}
|
|
|
|
stringSP = saveStringSP;
|
|
|
|
/* Generate exit from procedure */
|
|
|
|
pas_GenerateSimple(opRET);
|
|
level--;
|
|
|
|
/* Verify that END terminates with a semicolon */
|
|
|
|
if (token != ';') error (eSEMICOLON);
|
|
else getToken();
|
|
}
|
|
|
|
/***************************************************************/
|
|
/* Process Function Declaration Block */
|
|
|
|
static void pas_FunctionDeclaration(void)
|
|
{
|
|
uint16_t funcLabel = ++label;
|
|
int16_t parameterOffset;
|
|
char *saveStringSP;
|
|
STYPE *funcPtr;
|
|
STYPE *valPtr;
|
|
STYPE *typePtr;
|
|
char *funcName;
|
|
register int i;
|
|
|
|
TRACE(lstFile,"[pas_FunctionDeclaration]");
|
|
|
|
/* 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;
|
|
}
|
|
|
|
funcPtr = addProcedure(tkn_strt, sFUNC, funcLabel, 0, NULL);
|
|
|
|
/* 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.
|
|
*/
|
|
|
|
funcName = tkn_strt;
|
|
saveStringSP = stringSP;
|
|
getToken();
|
|
|
|
/* Process parameter list */
|
|
|
|
parameterOffset = formalParameterList(funcPtr);
|
|
|
|
/* Verify that the parameter list is followed by a colon */
|
|
|
|
if (token != ':') error (eCOLON);
|
|
else getToken();
|
|
|
|
/* Declare the function return value variable. This variable has
|
|
* the same name as the function itself. We fill the variable
|
|
* symbol descriptor with bogus information now (but we fix it
|
|
* below).
|
|
*/
|
|
|
|
valPtr = addVariable(funcName, sINT, 0, sINT_SIZE, NULL);
|
|
|
|
/* Get function type, return value type/size and offset to return value */
|
|
|
|
typePtr = pas_TypeIdentifier(0);
|
|
if (typePtr) {
|
|
|
|
/* 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 -= g_dwVarSize;
|
|
parameterOffset = intAlign(parameterOffset);
|
|
|
|
/* Save the TYPE for the function return value local variable */
|
|
|
|
valPtr->sKind = typePtr->sParm.t.rtype;
|
|
valPtr->sParm.v.offset = parameterOffset;
|
|
valPtr->sParm.v.size = g_dwVarSize;
|
|
valPtr->sParm.v.parent = typePtr;
|
|
|
|
/* Save the TYPE for the function */
|
|
|
|
funcPtr->sParm.p.parent = typePtr;
|
|
|
|
/* If we are here then we know that we are either in a program file
|
|
* or the 'implementation' part of a unit file (see punit.c -- At present,
|
|
* the function declarations of the 'interface' section of a unit file
|
|
* follow a different path). In the latter case (only), we should export
|
|
* every function declared at level zero.
|
|
*/
|
|
|
|
if ((level == 1) && (FP->kind == eIsUnit))
|
|
{
|
|
/* EXPORT the function symbol. */
|
|
|
|
pas_GenerateProcExport(funcPtr);
|
|
}
|
|
}
|
|
else
|
|
error(eINVTYPE);
|
|
|
|
/* Save debug information about the function */
|
|
|
|
pas_GenerateDebugInfo(funcPtr, g_dwVarSize);
|
|
|
|
/* Process block */
|
|
|
|
if (token != ';') error (eSEMICOLON);
|
|
else getToken();
|
|
|
|
pas_GenerateDataOperation(opLABEL, (int32_t)funcLabel);
|
|
block();
|
|
|
|
/* Destroy formal parameter names and the function return value name */
|
|
|
|
for (i = 1; i <= funcPtr->sParm.p.nParms; i++)
|
|
{
|
|
funcPtr[i].sName = ((char *) NULL);
|
|
}
|
|
|
|
valPtr->sName = ((char *) NULL);
|
|
stringSP = saveStringSP;
|
|
|
|
/* Generate exit from procedure/function */
|
|
|
|
pas_GenerateSimple(opRET);
|
|
level--;
|
|
|
|
/* Verify that END terminates with a semicolon */
|
|
|
|
if (token != ';') error (eSEMICOLON);
|
|
else getToken();
|
|
}
|
|
|
|
/***************************************************************/
|
|
/* Determine the size value to use with this type */
|
|
|
|
static void pas_SetTypeSize(STYPE *typePtr, bool allocate)
|
|
{
|
|
TRACE(lstFile,"[pas_SetTypeSize]");
|
|
|
|
/* Check for type-identifier */
|
|
|
|
g_dwVarSize = 0;
|
|
|
|
if (typePtr != NULL)
|
|
{
|
|
/* If allocate is true, then we want to return the size of
|
|
* the type that we would use if we are going to allocate
|
|
* an instance on the stack.
|
|
*/
|
|
|
|
if (allocate)
|
|
{
|
|
/* Could it be a storage size value (such as is used for
|
|
* the enhanced pascal string type?). In an weak attempt to
|
|
* be compatible with everyone in the world, we will allow
|
|
* either '[]' or '()' to delimit the size specification.
|
|
*/
|
|
|
|
if (((token == '[') || (token == '(')) &&
|
|
((typePtr->sParm.t.flags & STYPE_VARSIZE) != 0))
|
|
{
|
|
uint16_t term_token;
|
|
uint16_t errcode;
|
|
|
|
/* Yes... we need to parse the size from the input stream.
|
|
* First, determine which token will terminate the size
|
|
* specification.
|
|
*/
|
|
|
|
if (token == '(')
|
|
{
|
|
term_token = ')'; /* Should end with ')' */
|
|
errcode = eRPAREN; /* If not, this is the error */
|
|
}
|
|
else
|
|
{
|
|
term_token = ']'; /* Should end with ']' */
|
|
errcode = eRBRACKET; /* If not, this is the error */
|
|
}
|
|
|
|
/* Now, parse the size specification */
|
|
|
|
/* We expect the size to consist of a single integer constant.
|
|
* We should support any constant integer expression, but this
|
|
* has not yet been implemented.
|
|
*/
|
|
|
|
getToken();
|
|
if (token != tINT_CONST) error(eINTCONST);
|
|
/* else if (tknInt <= 0) error(eINVCONST); see below */
|
|
else if (tknInt <= 2) error(eINVCONST);
|
|
else
|
|
{
|
|
/* Use the value of the integer constant for the size
|
|
* the allocation. NOTE: There is a problem here in
|
|
* that for the sSTRING type, it wants the first 2 bytes
|
|
* for the string length. This means that the actual
|
|
* length is real two less than the specified length.
|
|
*/
|
|
|
|
g_dwVarSize = tknInt;
|
|
}
|
|
|
|
/* Verify that the correct token terminated the size
|
|
* specification. This could be either ')' or ']'
|
|
*/
|
|
|
|
getToken();
|
|
if (token != term_token) error(errcode);
|
|
else getToken();
|
|
}
|
|
else
|
|
{
|
|
/* Return the fixed size of the allocated instance of
|
|
* this type */
|
|
|
|
g_dwVarSize = typePtr->sParm.t.asize;
|
|
}
|
|
}
|
|
|
|
/* If allocate is false, then we want to return the size of
|
|
* the type that we would use if we are going to refer to
|
|
* a reference on the stack. This is really non-standard
|
|
* and is handle certain optimatizations where we cheat and
|
|
* pass some types by reference rather than by value. The
|
|
* enhanced pascal string type is the only example at present.
|
|
*/
|
|
|
|
else
|
|
{
|
|
/* Return the size to a clone, reference to an instance */
|
|
|
|
g_dwVarSize = typePtr->sParm.t.rsize;
|
|
}
|
|
}
|
|
}
|
|
|
|
/***************************************************************/
|
|
/* Verify that the next token is a type identifer
|
|
* NOTE: This function modifies the global variable g_dwVarSize
|
|
* as a side-effect
|
|
*/
|
|
|
|
static STYPE *pas_TypeIdentifier(bool allocate)
|
|
{
|
|
STYPE *typePtr = NULL;
|
|
|
|
TRACE(lstFile,"[pas_TypeIdentifier]");
|
|
|
|
/* Check for type-identifier */
|
|
|
|
if (token == sTYPE)
|
|
{
|
|
/* Return a reference to the type token. */
|
|
|
|
typePtr = tknPtr;
|
|
getToken();
|
|
|
|
/* Return the size value associated with this type */
|
|
|
|
pas_SetTypeSize(typePtr, allocate);
|
|
}
|
|
|
|
return typePtr;
|
|
}
|
|
|
|
/***************************************************************/
|
|
|
|
static STYPE *pas_TypeDenoter(char *typeName, bool allocate)
|
|
{
|
|
STYPE *typePtr;
|
|
|
|
TRACE(lstFile,"[pas_TypeDenoter]");
|
|
|
|
/* FORM: type-denoter = type-identifier | new-type
|
|
*
|
|
* Check for type-identifier
|
|
*/
|
|
|
|
typePtr = pas_TypeIdentifier(allocate);
|
|
if (typePtr != NULL)
|
|
{
|
|
/* Return the type identifier */
|
|
|
|
return typePtr;
|
|
}
|
|
|
|
/* Check for new-type
|
|
* FORM: new-type = new-ordinal-type | new-complex-type
|
|
*/
|
|
|
|
/* Check for new-complex-type */
|
|
|
|
typePtr = pas_NewComplexType(typeName);
|
|
if (typePtr == NULL)
|
|
{
|
|
/* Check for new-ordinal-type */
|
|
|
|
typePtr = pas_NewOrdinalType(typeName);
|
|
}
|
|
|
|
/* Return the size value associated with this type */
|
|
|
|
pas_SetTypeSize(typePtr, allocate);
|
|
|
|
return typePtr;
|
|
}
|
|
|
|
/***************************************************************/
|
|
/* Declare is new ordinal type */
|
|
|
|
static STYPE *pas_NewOrdinalType(char *typeName)
|
|
{
|
|
STYPE *typePtr = NULL;
|
|
|
|
/* Declare a new-ordinal-type
|
|
* FORM: new-ordinal-type = enumerated-type | subrange-type
|
|
*/
|
|
|
|
/* FORM: enumerated-type = '(' enumerated-constant-list ')' */
|
|
|
|
if (token == '(')
|
|
{
|
|
int32_t nObjects;
|
|
nObjects = 0;
|
|
typePtr = addTypeDefine(typeName, sSCALAR, sINT_SIZE, NULL);
|
|
|
|
/* Now declare each instance of the scalar */
|
|
|
|
do {
|
|
getToken();
|
|
if (token != tIDENT) error(eIDENT);
|
|
else
|
|
{
|
|
(void)addConstant(tkn_strt, sSCALAR_OBJECT, &nObjects, typePtr);
|
|
nObjects++;
|
|
getToken();
|
|
}
|
|
} while (token == ',');
|
|
|
|
/* Save the number of objects associated with the scalar type (the
|
|
* maximum ORD is nObjects - 1). */
|
|
|
|
typePtr->sParm.t.maxValue = nObjects - 1;
|
|
|
|
if (token != ')') error(eRPAREN);
|
|
else getToken();
|
|
|
|
}
|
|
|
|
/* Declare a new subrange type
|
|
* FORM: subrange-type = constant '..' constant
|
|
* FORM: constant =
|
|
* [ sign ] integer-number | [ sign ] real-number |
|
|
* [ sign ] constant-identifier | character-literal | string-literal
|
|
*
|
|
* Case 1: <constant> is INTEGER
|
|
*/
|
|
|
|
else if (token == tINT_CONST)
|
|
{
|
|
/* Create the new INTEGER subrange type */
|
|
|
|
typePtr = addTypeDefine(typeName, sSUBRANGE, sINT_SIZE, NULL);
|
|
typePtr->sParm.t.subType = sINT;
|
|
typePtr->sParm.t.minValue = tknInt;
|
|
typePtr->sParm.t.maxValue = MAXINT;
|
|
|
|
/* Verify that ".." separates the two constants */
|
|
|
|
getToken();
|
|
if (token != tSUBRANGE) error(eSUBRANGE);
|
|
else getToken();
|
|
|
|
/* Verify that the ".." is following by an INTEGER constant */
|
|
|
|
if ((token != tINT_CONST) || (tknInt < typePtr->sParm.t.minValue))
|
|
error(eSUBRANGETYPE);
|
|
else
|
|
{
|
|
typePtr->sParm.t.maxValue = tknInt;
|
|
getToken();
|
|
}
|
|
}
|
|
|
|
/* Case 2: <constant> is CHAR */
|
|
|
|
else if (token == tCHAR_CONST)
|
|
{
|
|
/* Create the new CHAR subrange type */
|
|
|
|
typePtr = addTypeDefine(typeName, sSUBRANGE, sCHAR_SIZE, NULL);
|
|
typePtr->sParm.t.subType = sCHAR;
|
|
typePtr->sParm.t.minValue = tknInt;
|
|
typePtr->sParm.t.maxValue = MAXCHAR;
|
|
|
|
/* Verify that ".." separates the two constants */
|
|
|
|
getToken();
|
|
if (token != tSUBRANGE) error(eSUBRANGE);
|
|
else getToken();
|
|
|
|
/* Verify that the ".." is following by a CHAR constant */
|
|
|
|
if ((token != tCHAR_CONST) || (tknInt < typePtr->sParm.t.minValue))
|
|
error(eSUBRANGETYPE);
|
|
else
|
|
{
|
|
typePtr->sParm.t.maxValue = tknInt;
|
|
getToken();
|
|
}
|
|
}
|
|
|
|
/* Case 3: <constant> is a SCALAR type */
|
|
|
|
else if (token == sSCALAR_OBJECT)
|
|
{
|
|
/* Create the new SCALAR subrange type */
|
|
|
|
typePtr = addTypeDefine(typeName, sSUBRANGE, sINT_SIZE, tknPtr);
|
|
typePtr->sParm.t.subType = token;
|
|
typePtr->sParm.t.minValue = tknInt;
|
|
typePtr->sParm.t.maxValue = MAXINT;
|
|
|
|
/* Verify that ".." separates the two constants */
|
|
|
|
getToken();
|
|
if (token != tSUBRANGE) error(eSUBRANGE);
|
|
else getToken();
|
|
|
|
/* Verify that the ".." is following by a SCALAR constant of the same
|
|
* type as the one which preceded it
|
|
*/
|
|
|
|
if ((token != sSCALAR_OBJECT) ||
|
|
(tknPtr != typePtr->sParm.t.parent) ||
|
|
(tknPtr->sParm.c.val.i < typePtr->sParm.t.minValue))
|
|
error(eSUBRANGETYPE);
|
|
else
|
|
{
|
|
typePtr->sParm.t.maxValue = tknPtr->sParm.c.val.i;
|
|
getToken();
|
|
}
|
|
}
|
|
|
|
return typePtr;
|
|
}
|
|
|
|
/***************************************************************/
|
|
|
|
static STYPE *pas_NewComplexType(char *typeName)
|
|
{
|
|
STYPE *typePtr = NULL;
|
|
STYPE *typeIdPtr;
|
|
|
|
TRACE(lstFile,"[pas_TypeDenoter]");
|
|
|
|
/* FORM: new-complex-type = new-structured-type | new-pointer-type */
|
|
|
|
switch (token)
|
|
{
|
|
/* FORM: new-pointer-type = '^' domain-type | '@' domain-type */
|
|
|
|
case '^' :
|
|
getToken();
|
|
typeIdPtr = pas_TypeIdentifier(1);
|
|
if (typeIdPtr)
|
|
{
|
|
typePtr = addTypeDefine(typeName, sPOINTER, g_dwVarSize, typeIdPtr);
|
|
}
|
|
else
|
|
{
|
|
error(eINVTYPE);
|
|
}
|
|
break;
|
|
|
|
/* FORM: new-structured-type =
|
|
* [ 'packed' ] array-type | [ 'packed' ] record-type |
|
|
* [ 'packed' ] set-type | [ 'packed' ] file-type |
|
|
* [ 'packed' ] list-type | object-type | string-type
|
|
*/
|
|
|
|
/* PACKED Types */
|
|
|
|
case tPACKED :
|
|
error (eNOTYET);
|
|
getToken();
|
|
if (token != tARRAY) break;
|
|
/* Fall through to process PACKED ARRAY type */
|
|
|
|
/* Array Types
|
|
* FORM: array-type = 'array' [ index-type-list ']' 'of' type-denoter
|
|
*/
|
|
|
|
case tARRAY :
|
|
getToken();
|
|
typeIdPtr = pas_GetArrayType();
|
|
if (typeIdPtr)
|
|
{
|
|
typePtr = addTypeDefine(typeName, sARRAY, g_dwVarSize, typeIdPtr);
|
|
}
|
|
else
|
|
{
|
|
error(eINVTYPE);
|
|
}
|
|
break;
|
|
|
|
/* RECORD Types
|
|
* FORM: record-type = 'record' field-list 'end'
|
|
*/
|
|
|
|
case tRECORD :
|
|
getToken();
|
|
typePtr = pas_DeclareRecord(typeName);
|
|
break;
|
|
|
|
/* Set Types
|
|
*
|
|
* FORM: set-type = 'set' 'of' ordinal-type
|
|
*/
|
|
|
|
case tSET :
|
|
|
|
/* Verify that 'set' is followed by 'of' */
|
|
|
|
getToken();
|
|
if (token != tOF) error (eOF);
|
|
else getToken();
|
|
|
|
/* Verify that 'set of' is followed by an ordinal-type
|
|
* If not, then declare a new one with no name
|
|
*/
|
|
|
|
typeIdPtr = pas_OrdinalTypeIdentifier(1);
|
|
if (typeIdPtr)
|
|
getToken();
|
|
else
|
|
typeIdPtr = pas_DeclareOrdinalType(NULL);
|
|
|
|
/* Verify that the ordinal-type is either a scalar or a
|
|
* subrange type. These are the only valid types for 'set of'
|
|
*/
|
|
|
|
if ((typeIdPtr) &&
|
|
((typeIdPtr->sParm.t.type == sSCALAR) ||
|
|
(typeIdPtr->sParm.t.type == sSUBRANGE)))
|
|
{
|
|
/* Declare the SET type */
|
|
|
|
typePtr = addTypeDefine(typeName, sSET_OF,
|
|
typeIdPtr->sParm.t.asize, typeIdPtr);
|
|
|
|
if (typePtr)
|
|
{
|
|
int16_t nObjects;
|
|
|
|
/* Copy the scalar/subrange characteristics for convenience */
|
|
|
|
typePtr->sParm.t.subType = typeIdPtr->sParm.t.type;
|
|
typePtr->sParm.t.minValue = typeIdPtr->sParm.t.minValue;
|
|
typePtr->sParm.t.maxValue = typeIdPtr->sParm.t.minValue;
|
|
|
|
/* Verify that the number of objects associated with the
|
|
* scalar or subrange type will fit into an integer
|
|
* representation of a set as a bit-string.
|
|
*/
|
|
|
|
nObjects = typeIdPtr->sParm.t.maxValue
|
|
- typeIdPtr->sParm.t.minValue + 1;
|
|
if (nObjects > BITS_IN_INTEGER)
|
|
{
|
|
error(eSETRANGE);
|
|
typePtr->sParm.t.maxValue = typePtr->sParm.t.minValue
|
|
+ BITS_IN_INTEGER - 1;
|
|
}
|
|
}
|
|
}
|
|
else
|
|
error(eSET);
|
|
break;
|
|
|
|
/* File Types
|
|
* FORM: file-type = 'file' 'of' type-denoter
|
|
*/
|
|
|
|
/* FORM: file-type = 'file' 'of' type-denoter */
|
|
|
|
case tFILE :
|
|
|
|
/* Make sure that 'file' is followed by 'of' */
|
|
|
|
getToken();
|
|
if (token != tOF) error (eOF);
|
|
else getToken();
|
|
|
|
/* Get the type-denoter */
|
|
|
|
typeIdPtr = pas_TypeDenoter(NULL,1);
|
|
if (typeIdPtr)
|
|
{
|
|
typePtr = addTypeDefine(typeName, sFILE_OF, g_dwVarSize, typeIdPtr);
|
|
if (typePtr)
|
|
{
|
|
typePtr->sParm.t.subType = typeIdPtr->sParm.t.type;
|
|
}
|
|
}
|
|
else
|
|
{
|
|
error(eINVTYPE);
|
|
}
|
|
break;
|
|
|
|
/* FORM: string-type = pascal-string-type | c-string-type
|
|
* FORM: pascal-string-type = 'string' [ max-string-length ]
|
|
*/
|
|
case sSTRING :
|
|
error (eNOTYET);
|
|
getToken();
|
|
break;
|
|
|
|
/* FORM: list-type = 'list' 'of' type-denoter */
|
|
/* FORM: object-type = 'object' | 'class' */
|
|
default :
|
|
break;
|
|
|
|
}
|
|
|
|
return typePtr;
|
|
}
|
|
|
|
/***************************************************************/
|
|
/* Verify that the next token is a type identifer
|
|
*/
|
|
|
|
static STYPE *pas_OrdinalTypeIdentifier(bool allocate)
|
|
{
|
|
STYPE *typePtr;
|
|
|
|
TRACE(lstFile,"[pas_OrdinalTypeIdentifier]");
|
|
|
|
/* Get the next type from the input stream */
|
|
|
|
typePtr = pas_TypeIdentifier(allocate);
|
|
|
|
/* Was a type encountered? */
|
|
|
|
if (typePtr != NULL)
|
|
{
|
|
switch (typePtr->sParm.t.type)
|
|
{
|
|
/* Check for an ordinal type (verify this list!) */
|
|
|
|
case sINT :
|
|
case sBOOLEAN :
|
|
case sCHAR :
|
|
case sSCALAR :
|
|
case sSUBRANGE:
|
|
/* If it is an ordinal type, then just return the
|
|
* type pointer.
|
|
*/
|
|
|
|
break;
|
|
default :
|
|
/* If not, return NULL */
|
|
|
|
typePtr = NULL;
|
|
break;
|
|
}
|
|
}
|
|
return typePtr;
|
|
}
|
|
|
|
/***************************************************************/
|
|
/* get array type argument for TYPE block or variable declaration */
|
|
|
|
static STYPE *pas_GetArrayType(void)
|
|
{
|
|
STYPE *typePtr = NULL;
|
|
|
|
TRACE(lstFile,"[pas_GetArrayType]");
|
|
|
|
/* FORM: array-type = 'array' '[' index-type-list ']' 'of' type-denoter */
|
|
/* FORM: [PACKED] ARRAY [<integer>] OF type-denoter
|
|
* NOTE: Bracketed value is the array size! NONSTANDARD! */
|
|
|
|
g_dwVarSize = 0;
|
|
|
|
/* Verify that the index-type-list is preceded by '[' */
|
|
|
|
if (token != '[') error (eLBRACKET);
|
|
else
|
|
{
|
|
/* FORM: index-type-list = index-type { ',' index-type }
|
|
* FORM: index-type = ordinal-type
|
|
*/
|
|
|
|
getToken();
|
|
if (token != tINT_CONST) error (eINTCONST);
|
|
else
|
|
{
|
|
g_dwVarSize = tknInt;
|
|
getToken();
|
|
|
|
/* Verify that the index-type-list is followed by ']' */
|
|
|
|
if (token != ']') error (eRBRACKET);
|
|
else getToken();
|
|
|
|
/* Verify that 'of' precedes the type-denoter */
|
|
|
|
if (token != tOF) error (eOF);
|
|
else getToken();
|
|
|
|
/* We have the array size in elements, not get the type and convert
|
|
* the size for the type found
|
|
*/
|
|
|
|
typePtr = pas_DeclareType(NULL);
|
|
if (typePtr)
|
|
{
|
|
g_dwVarSize *= typePtr->sParm.t.asize;
|
|
}
|
|
}
|
|
}
|
|
|
|
return typePtr;
|
|
}
|
|
|
|
/***************************************************************/
|
|
|
|
static STYPE *pas_DeclareRecord(char *recordName)
|
|
{
|
|
STYPE *recordPtr;
|
|
int16_t recordOffset;
|
|
int recordCount, symbolIndex;
|
|
|
|
TRACE(lstFile,"[pas_DeclareRecord]");
|
|
|
|
/* FORM: record-type = 'record' field-list 'end' */
|
|
|
|
/* Declare the new RECORD type */
|
|
|
|
recordPtr = addTypeDefine(recordName, sRECORD, 0, NULL);
|
|
|
|
/* Then declare the field-list associated with the RECORD
|
|
* FORM: field-list =
|
|
* [
|
|
* fixed-part [ ';' ] variant-part [ ';' ] |
|
|
* fixed-part [ ';' ] |
|
|
* variant-part [ ';' ] |
|
|
* ]
|
|
*
|
|
* Process the fixed-part first.
|
|
* FORM: fixed-part = record-section { ';' record-section }
|
|
* FORM: record-section = identifier-list ':' type-denoter
|
|
* FORM: identifier-list = identifier { ',' identifier }
|
|
*/
|
|
|
|
for (;;)
|
|
{
|
|
/* Terminate parsing of the fixed-part when we encounter
|
|
* 'case' indicating the beginning of the variant part of
|
|
* the record. If there is no fixed-part, then 'case' will
|
|
* appear immediately.
|
|
*/
|
|
|
|
if (token == tCASE) break;
|
|
|
|
/* We now expect to see and indentifier representating the
|
|
* beginning of the next fixed field.
|
|
*/
|
|
|
|
(void)pas_DeclareField(recordPtr);
|
|
|
|
/* If the field declaration terminates with a semicolon, then
|
|
* we expect to see another <fixed part> declaration in the
|
|
* record.
|
|
*/
|
|
|
|
if (token == ';')
|
|
{
|
|
/* Skip over the semicolon and process the next fixed
|
|
* field declaration.
|
|
*/
|
|
|
|
getToken();
|
|
|
|
/* We will treat this semi colon as optional. If we
|
|
* hit 'end' or 'case' after the semicolon, then we
|
|
* will terminate the fixed part with no complaint.
|
|
*/
|
|
|
|
if ((token == tEND) || (token == tCASE))
|
|
break;
|
|
}
|
|
|
|
/* If there is no semicolon after the field declaration,
|
|
* then 'end' or 'case' is expected. This will be verified
|
|
* below.
|
|
*/
|
|
|
|
else break;
|
|
}
|
|
|
|
/* Get the total size of the RECORD type and the offset of each
|
|
* field within the RECORD.
|
|
*/
|
|
|
|
for (recordOffset = 0, symbolIndex = 1, recordCount = 0;
|
|
recordCount < recordPtr->sParm.t.maxValue;
|
|
symbolIndex++)
|
|
{
|
|
/* We know that 'maxValue' sRECORD_OBJECT symbols follow the sRECORD
|
|
* type declaration. However, these may not be sequential due to the
|
|
* possible declaration of sTYPEs associated with each field.
|
|
*/
|
|
|
|
if (recordPtr[symbolIndex].sKind == sRECORD_OBJECT)
|
|
{
|
|
/* Align the recordOffset (if necessary) */
|
|
|
|
if ((!isIntAligned(recordOffset)) &&
|
|
(pas_IntAlignRequired(recordPtr[symbolIndex].sParm.r.parent)))
|
|
recordOffset = intAlign(recordOffset);
|
|
|
|
/* Save the offset associated with this field, and determine the
|
|
* offset to the next field (if there is one)
|
|
*/
|
|
|
|
recordPtr[symbolIndex].sParm.r.offset = recordOffset;
|
|
recordOffset += recordPtr[symbolIndex].sParm.r.size;
|
|
recordCount++;
|
|
}
|
|
}
|
|
|
|
/* Update the RECORD entry for the total size of all fields */
|
|
|
|
recordPtr->sParm.t.asize = recordOffset;
|
|
|
|
/* Now we are ready to process the variant-part.
|
|
* FORM: variant-part = 'case' variant-selector 'of' variant-body
|
|
*/
|
|
|
|
if (token == tCASE)
|
|
{
|
|
int16_t variantOffset;
|
|
uint16_t maxRecordSize;
|
|
|
|
/* Skip over the 'case' */
|
|
|
|
getToken();
|
|
|
|
/* Check for variant-selector
|
|
* FORM: variant-selector = [ identifier ':' ] ordinal-type-identifer
|
|
*/
|
|
|
|
if (token != tIDENT) error(eRECORDDECLARE);
|
|
|
|
/* Add a variant-selector to the fixed-part of the record */
|
|
|
|
else
|
|
{
|
|
STYPE *typePtr;
|
|
char *fieldName;
|
|
|
|
/* Save the field name */
|
|
|
|
fieldName = tkn_strt;
|
|
getToken();
|
|
|
|
/* Verify that the identifier is followed by a colon */
|
|
|
|
if (token != ':') error(eCOLON);
|
|
else getToken();
|
|
|
|
/* Get the ordinal-type-identifier */
|
|
|
|
typePtr = pas_OrdinalTypeIdentifier(1);
|
|
if (!typePtr) error(eINVTYPE);
|
|
else
|
|
{
|
|
STYPE *fieldPtr;
|
|
|
|
/* Declare a <field> with this <identifier> as its name */
|
|
|
|
fieldPtr = addField(fieldName, recordPtr);
|
|
|
|
/* Increment the number of fields in the record */
|
|
|
|
recordPtr->sParm.t.maxValue++;
|
|
|
|
/* Copy the size of field from the sTYPE entry into the
|
|
* <field> type entry. NOTE: This element is not essential
|
|
* since it can be obtained from the parent type pointer
|
|
*/
|
|
|
|
fieldPtr->sParm.r.size = typePtr->sParm.t.asize;
|
|
|
|
/* Save a pointer back to the parent field type */
|
|
|
|
fieldPtr->sParm.r.parent = typePtr;
|
|
|
|
/* Align the recordOffset (if necessary) */
|
|
|
|
if ((!isIntAligned(recordOffset)) &&
|
|
(pas_IntAlignRequired(typePtr)))
|
|
recordOffset = intAlign(recordOffset);
|
|
|
|
/* Save the offset associated with this field, and determine
|
|
* the offset to the next field (if there is one)
|
|
*/
|
|
|
|
fieldPtr->sParm.r.offset = recordOffset;
|
|
recordOffset += recordPtr[symbolIndex].sParm.r.size;
|
|
}
|
|
}
|
|
|
|
/* Save the offset to the start of the variant portion of the RECORD */
|
|
|
|
variantOffset = recordOffset;
|
|
maxRecordSize = recordOffset;
|
|
|
|
/* Skip over the 'of' following the variant selector */
|
|
|
|
if (token != tOF) error(eOF);
|
|
else getToken();
|
|
|
|
/* Loop to process the variant-body
|
|
* FORM: variant-body =
|
|
* variant-list [ [ ';' ] variant-part-completer ] |
|
|
* variant-part-completer
|
|
* FORM: variant-list = variant { ';' variant }
|
|
* FORM: variant-part-completer = ( 'otherwise' | 'else' ) ( field-list )
|
|
*/
|
|
|
|
for (;;)
|
|
{
|
|
/* Now process each variant where:
|
|
* FORM: variant = case-constant-list ':' '(' field-list ')'
|
|
* FORM: case-constant-list = case-specifier { ',' case-specifier }
|
|
* FORM: case-specifier = case-constant [ '..' case-constant ]
|
|
*/
|
|
|
|
/* Verify that the case selector begins with a case-constant.
|
|
* Note that subrange case-specifiers are not yet supported.
|
|
*/
|
|
|
|
if (!isConstant(token))
|
|
{
|
|
error(eINVCONST);
|
|
break;
|
|
}
|
|
|
|
/* Just consume the <case selector> for now -- Really need to
|
|
* verify that each constant is of the same type as the type
|
|
* identifier (or the type associated with the tag) in the CASE
|
|
*/
|
|
|
|
do
|
|
{
|
|
getToken();
|
|
if (token == ',') getToken();
|
|
}
|
|
while (isConstant(token));
|
|
|
|
/* Make sure a colon separates case-constant-list from the
|
|
* field-list
|
|
*/
|
|
|
|
if (token == ':') getToken();
|
|
else error(eCOLON);
|
|
|
|
/* The field-list must be enclosed in parentheses */
|
|
|
|
if (token == '(') getToken();
|
|
else error(eLPAREN);
|
|
|
|
/* Special case the empty variant <field list> */
|
|
|
|
if (token != ')')
|
|
{
|
|
/* Now process the <field list> for the variant. This works
|
|
* just like the field list of the fixed part, except the
|
|
* offset is reset for each variant.
|
|
* FORM: field-list =
|
|
* [
|
|
* fixed-part [ ';' ] variant-part [ ';' ] |
|
|
* fixed-part [ ';' ] |
|
|
* variant-part [ ';' ] |
|
|
* ]
|
|
*/
|
|
|
|
for (;;)
|
|
{
|
|
/* We now expect to see and indentifier representating the
|
|
* beginning of the next variablefield.
|
|
*/
|
|
|
|
(void)pas_DeclareField(recordPtr);
|
|
|
|
/* If the field declaration terminates with a semicolon,
|
|
* then we expect to see another <variable part>
|
|
* declaration in the record.
|
|
*/
|
|
|
|
if (token == ';')
|
|
{
|
|
/* Skip over the semicolon and process the next
|
|
* variable field declaration.
|
|
*/
|
|
|
|
getToken();
|
|
|
|
/* We will treat this semi colon as optional. If we
|
|
* hit 'end' after the semicolon, then we will
|
|
* terminate the fixed part with no complaint.
|
|
*/
|
|
|
|
if (token == tEND)
|
|
break;
|
|
}
|
|
else break;
|
|
}
|
|
|
|
/* Get the total size of the RECORD type and the offset of each
|
|
* field within the RECORD.
|
|
*/
|
|
|
|
for (recordOffset = variantOffset;
|
|
recordCount < recordPtr->sParm.t.maxValue;
|
|
symbolIndex++)
|
|
{
|
|
/* We know that 'maxValue' sRECORD_OBJECT symbols follow
|
|
* the sRECORD type declaration. However, these may not
|
|
* be sequential due to the possible declaration of sTYPEs
|
|
* associated with each field.
|
|
*/
|
|
|
|
if (recordPtr[symbolIndex].sKind == sRECORD_OBJECT)
|
|
{
|
|
/* Align the recordOffset (if necessary) */
|
|
|
|
if ((!isIntAligned(recordOffset)) &&
|
|
(pas_IntAlignRequired(recordPtr[symbolIndex].sParm.r.parent)))
|
|
recordOffset = intAlign(recordOffset);
|
|
|
|
/* Save the offset associated with this field, and
|
|
* determine the offset to the next field (if there
|
|
* is one)
|
|
*/
|
|
|
|
recordPtr[symbolIndex].sParm.r.offset = recordOffset;
|
|
recordOffset += recordPtr[symbolIndex].sParm.r.size;
|
|
recordCount++;
|
|
}
|
|
}
|
|
|
|
/* Check if this is the largest variant that we have found
|
|
* so far
|
|
*/
|
|
|
|
if (recordOffset > maxRecordSize)
|
|
maxRecordSize = recordOffset;
|
|
}
|
|
|
|
/* Verify that the <field list> is enclosed in parentheses */
|
|
|
|
if (token == ')') getToken();
|
|
else error(eRPAREN);
|
|
|
|
/* A semicolon at this position means that another <variant>
|
|
* follows. Keep looping until all of the variants have been
|
|
* processed (i.e., no semi-colon)
|
|
*/
|
|
|
|
if (token == ';') getToken();
|
|
else break;
|
|
}
|
|
|
|
/* Update the RECORD entry for the maximum size of all variants */
|
|
|
|
recordPtr->sParm.t.asize = maxRecordSize;
|
|
}
|
|
|
|
/* Verify that the RECORD declaration terminates with END */
|
|
|
|
if (token != tEND) error(eRECORDDECLARE);
|
|
else getToken();
|
|
|
|
return recordPtr;
|
|
}
|
|
|
|
/***************************************************************/
|
|
|
|
static STYPE *pas_DeclareField(STYPE *recordPtr)
|
|
{
|
|
STYPE *fieldPtr = NULL;
|
|
STYPE *typePtr;
|
|
|
|
TRACE(lstFile,"[pas_DeclareField]");
|
|
|
|
/* Declare one record-section with a record.
|
|
* FORM: record-section = identifier-list ':' type-denoter
|
|
* FORM: identifier-list = identifier { ',' identifier }
|
|
*/
|
|
|
|
if (token != tIDENT) error(eIDENT);
|
|
else {
|
|
|
|
/* Declare a <field> with this <identifier> as its name */
|
|
|
|
fieldPtr = addField(tkn_strt, recordPtr);
|
|
getToken();
|
|
|
|
/* Check for multiple fields of this <type> */
|
|
|
|
if (token == ',') {
|
|
|
|
getToken();
|
|
typePtr = pas_DeclareField(recordPtr);
|
|
|
|
}
|
|
else {
|
|
|
|
if (token != ':') error(eCOLON);
|
|
else getToken();
|
|
|
|
/* Use the existing type or declare a new type with no name */
|
|
|
|
typePtr = pas_TypeDenoter(NULL, 1);
|
|
}
|
|
|
|
recordPtr->sParm.t.maxValue++;
|
|
if (typePtr) {
|
|
|
|
/* Copy the size of field from the sTYPE entry into the <field> */
|
|
/* type entry. NOTE: This element is not essential since it */
|
|
/* can be obtained from the parent type pointer */
|
|
|
|
fieldPtr->sParm.r.size = typePtr->sParm.t.asize;
|
|
|
|
/* Save a pointer back to the parent field type */
|
|
|
|
fieldPtr->sParm.r.parent = typePtr;
|
|
|
|
}
|
|
}
|
|
|
|
return typePtr;
|
|
}
|
|
|
|
/***************************************************************/
|
|
/* Process VAR/value Parameter Declaration */
|
|
/* NOTE: This function increments the global variable g_nParms */
|
|
/* as a side-effect */
|
|
|
|
static STYPE *pas_DeclareParameter(bool pointerType)
|
|
{
|
|
int16_t varType = 0;
|
|
STYPE *varPtr;
|
|
STYPE *typePtr;
|
|
|
|
TRACE(lstFile,"[pas_DeclareParameter]");
|
|
|
|
/* FORM:
|
|
* <identifier>[,<identifier>[,<identifier>[...]]] : <type identifier>
|
|
*/
|
|
|
|
if (token != tIDENT) error (eIDENT);
|
|
else
|
|
{
|
|
varPtr = addVariable(tkn_strt, sINT, 0, sINT_SIZE, NULL);
|
|
getToken();
|
|
|
|
if (token == ',')
|
|
{
|
|
getToken();
|
|
typePtr = pas_DeclareParameter(pointerType);
|
|
}
|
|
else
|
|
{
|
|
if (token != ':') error (eCOLON);
|
|
else getToken();
|
|
typePtr = pas_TypeIdentifier(0);
|
|
}
|
|
|
|
if (pointerType)
|
|
{
|
|
varType = sVAR_PARM;
|
|
g_dwVarSize = sPTR_SIZE;
|
|
}
|
|
else
|
|
{
|
|
varType = typePtr->sParm.t.rtype;
|
|
}
|
|
|
|
g_nParms++;
|
|
varPtr->sKind = varType;
|
|
varPtr->sParm.v.size = g_dwVarSize;
|
|
varPtr->sParm.v.parent = typePtr;
|
|
}
|
|
|
|
return typePtr;
|
|
}
|
|
|
|
/***************************************************************/
|
|
|
|
static bool pas_IntAlignRequired(STYPE *typePtr)
|
|
{
|
|
bool returnValue = false;
|
|
|
|
/* Type CHAR and ARRAYS of CHAR do not require alignment (unless
|
|
* they are passed as value parameters). Otherwise, alignment
|
|
* to type INTEGER boundaries is required.
|
|
*/
|
|
|
|
if (typePtr)
|
|
{
|
|
if (typePtr->sKind == sCHAR)
|
|
{
|
|
returnValue = true;
|
|
}
|
|
else if (typePtr->sKind == sARRAY)
|
|
{
|
|
typePtr = typePtr->sParm.t.parent;
|
|
if ((typePtr) && (typePtr->sKind == sCHAR))
|
|
{
|
|
returnValue = true;
|
|
}
|
|
}
|
|
}
|
|
|
|
return returnValue;
|
|
}
|
|
|
|
/***************************************************************/
|