fly316/PX4-Autopilot
7
0
Fork 0
mirror of https://gitee.com/mirrors_PX4/PX4-Autopilot.git synced 2026-07-08 06:50:35 +08:00
Code Issues Packages Projects Releases Wiki Activity

Resync new repository with old repo r5166

Browse Source 
git-svn-id: http://svn.code.sf.net/p/nuttx/code/trunk@5153 42af7a65-404d-4744-a932-0658087f49c3
This commit is contained in:
patacongo
2012-09-17 18:18:44 +00:00
commit 57623d42eb
5691 changed files with 1361853 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files
misc/pascal/pascal/Makefile
+85
View File
@@ -0,0 +1,85 @@
############################################################################
# pascal/Makefile
#
# Copyright (C) 2008 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.
#
############################################################################
#
# Directories
#
PASDIR = ${shell pwd}
PASCAL = $(PASDIR)/..
include $(PASCAL)/Make.config
include $(PASCAL)/Make.defs
INCDIR = $(PASCAL)/include
LIBDIR = $(PASCAL)/lib
BINDIR-$(CONFIG_INSN16) = $(PASCAL)/bin16
BINDIR-$(CONFIG_INSN32) = $(PASCAL)/bin32
#
# Objects and targets
#
PASSRCS = pas.c pprgm.c punit.c pblck.c pstm.c pexpr.c \
pcexpr.c pproc.c pffunc.c pcfunc.c pgen.c ptkn.c \
ptbl.c perr.c
PASOBJS = $(PASSRCS:.c=.o)
OBJS = $(PASOBJS)
all: pascal
.PHONY: all pascal clean
$(OBJS): %.o: %.c
$(CC) -c $(CFLAGS) $< -o $@
check_libs:
@if [ ! -f $(LIBDIR)/libpoff.a ] ; then \
echo "$(LIBDIR)/libpoff.a does not exist" ; \
exit 1 ; \
fi
@if [ ! -f $(LIBDIR)/libpas.a ] ; then \
echo "$(LIBDIR)/libpas.a does not exist" ; \
exit 1 ; \
fi
@if [ ! -f $(LIBDIR)/libinsn.a ] ; then \
echo "$(LIBDIR)/libinsn.a does not exist" ; \
exit 1 ; \
fi
$(BINDIR-y)/pascal: check_libs $(PASOBJS)
$(CC) -o $@ $(LDFLAGS) $(PASOBJS) -linsn -lpoff -lpas -lm
pascal: $(BINDIR-y)/pascal
clean:
$(RM) pascal *.o core *~
misc/pascal/pascal/pas.c
+538
View File
@@ -0,0 +1,538 @@
/**********************************************************************
* pas.c
* Main process
*
* 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
**********************************************************************/
#define _GNU_SOURCE
#include <sys/types.h>
#include <stdint.h>
#include <stdio.h>
#include <stdlib.h>
#include <ctype.h>
#include <string.h>
#include <signal.h>
#include <errno.h>
#include "config.h"
#include "keywords.h"
#include "pasdefs.h"
#include "ptdefs.h"
#include "podefs.h"
#include "pedefs.h"
#include "pas.h"
#include "paslib.h" /* For extension */
#include "pproc.h" /* For primeBuiltInProcedures */
#include "pfunc.h" /* For primeBuiltInFunctions */
#include "ptkn.h" /* For primeTokenizer */
#include "ptbl.h" /* For primeSymbolTable */
#include "pofflib.h" /* For poffInitializeForOutput() */
#include "poff.h" /* For POFF definitions */
#include "pprgm.h" /* for program() */
#include "punit.h" /* for unit() */
#include "perr.h" /* for error() */
/**********************************************************************
* Pre-processor Definitions
**********************************************************************/
/**********************************************************************
* Global Variables
**********************************************************************/
/* Unitialized Global Data */
uint16_t token; /* Current token */
uint16_t tknSubType; /* Extended token type */
int32_t tknInt; /* Integer token value */
double tknReal; /* Real token value */
STYPE *tknPtr; /* Pointer to symbol token*/
WTYPE withRecord; /* RECORD used with WITH statement */
FTYPE files[MAX_FILES+1]; /* File Table */
fileState_t fileState[MAX_INCL]; /* State of all open files */
/* sourceFileName : Program name from command line
* includePath[] : Pathes to search when including file
*/
char *sourceFileName;
char *includePath[MAX_INCPATHES];
poffHandle_t poffHandle; /* Handle for POFF object */
FILE *poffFile; /* Pass1 POFF output file */
FILE *lstFile; /* List File pointer */
FILE *errFile; /* Error file pointer */
/* Initialized Global Data */
int16_t level = 0; /* Static nesting level */
int16_t includeIndex = 0; /* Include file index */
int16_t nIncPathes = 0; /* Number pathes in includePath[] */
uint16_t label = 0; /* Last label number */
int16_t nsym = 0; /* Number symbol table entries */
int16_t nconst = 0; /* Number constant table entries */
int16_t sym_strt = 0; /* Symbol search start index */
int16_t const_strt = 0; /* Constant search start index */
int16_t err_count = 0; /* Error counter */
int16_t nfiles = 0; /* Program file counter */
int32_t warn_count = 0; /* Warning counter */
int32_t dstack = 0; /* data stack size */
/**********************************************************************
* Private Type Definitions
**********************************************************************/
struct outFileDesc_s
{
const char *extension;
const char *flags;
FILE **stream;
};
typedef struct outFileDesc_s outFileDesc_t;
/**********************************************************************
* Private Variables
**********************************************************************/
static const outFileDesc_t outFiles[] =
{
{ "o1", "wb", &poffFile }, /* Pass 1 POFF object file */
#if LSTTOFILE
{ "lst", "w", &lstFile }, /* List file */
#endif
{ "err", "w", &errFile }, /* Error file */
{ NULL, NULL } /* (terminates list */
};
static const char *programName;
/***********************************************************************
* Private Function Prototypes
***********************************************************************/
static void closeFiles(void);
static void openOutputFiles(void);
static void showUsage(void);
static void parseArguments(int argc, char **argv);
/***********************************************************************
* Private Functions
***********************************************************************/
static void closeFiles(void)
{
const outFileDesc_t *outFile;
/* Close input source files */
for(; includeIndex >= 0; includeIndex--)
{
if (FP->stream)
{
(void)fclose(FP->stream);
FP->stream = NULL;
}
}
/* Close output files */
for (outFile = outFiles; outFile->extension; outFile++)
{
if (*outFile->stream)
{
(void)fclose(*outFile->stream);
*outFile->stream = NULL;
}
}
}
/***********************************************************************/
static void openOutputFiles(void)
{
const outFileDesc_t *outFile;
char tmpname[FNAME_SIZE+1];
/* Open output files */
for (outFile = outFiles; outFile->extension; outFile++)
{
/* Generate an output file name from the source file
* name and an extension associated with the output file.
*/
(void)extension(sourceFileName, outFile->extension, tmpname, 1);
*outFile->stream = fopen(tmpname, outFile->flags);
if (*outFile->stream == NULL)
{
fprintf(stderr, "Could not open output file '%s': %s\n",
tmpname, strerror(errno));
showUsage();
}
}
}
/***********************************************************************/
static void signalHandler(int signo)
{
#ifdef _GNU_SOURCE
fprintf(errFile, "Received signal: %s\n", strsignal(signo));
fprintf(lstFile, "Received signal: %s\n", strsignal(signo));
#else
fprintf(errFile, "Received signal %d\n", signo);
fprintf(lstFile, "Received signal %d\n", signo);
#endif
closeFiles();
error(eRCVDSIGNAL);
exit(1);
}
/***********************************************************************/
static void primeSignalHandlers(void)
{
(void)signal(SIGHUP, signalHandler);
(void)signal(SIGINT, signalHandler);
(void)signal(SIGQUIT, signalHandler);
(void)signal(SIGILL, signalHandler);
(void)signal(SIGABRT, signalHandler);
(void)signal(SIGSEGV, signalHandler);
(void)signal(SIGTERM, signalHandler);
}
/***********************************************************************/
static void showUsage(void)
{
fprintf(stderr, "USAGE:\n");
fprintf(stderr, " %s [options] <filename>\n", programName);
fprintf(stderr, "[options]\n");
fprintf(stderr, " -I<include-path>\n");
fprintf(stderr, " Search in <include-path> for additional file\n");
fprintf(stderr, " A maximum of %d pathes may be specified\n",
MAX_INCPATHES);
fprintf(stderr, " (default is current directory)\n");
closeFiles();
exit(1);
} /* end showUsage */
/***********************************************************************/
static void parseArguments(int argc, char **argv)
{
int i;
programName = argv[0];
/* Check for existence of at least the filename argument */
if (argc < 2)
{
fprintf(stderr, "Invalid number of arguments\n");
showUsage();
}
/* Parse any optional command line arguments */
for (i = 1; i < argc-1; i++)
{
char *ptr = argv[i];
if (ptr[0] == '-')
{
switch (ptr[1])
{
case 'I' :
if (nIncPathes >= MAX_INCPATHES)
{
fprintf(stderr, "Unrecognized [option]\n");
showUsage();
}
else
{
includePath[nIncPathes] = &ptr[2];
nIncPathes++;
}
break;
default:
fprintf(stderr, "Unrecognized [option]\n");
showUsage();
}
}
else
{
fprintf(stderr, "Unrecognized [option]\n");
showUsage();
}
}
/* Extract the Pascal program name from the command line */
sourceFileName = argv[argc-1];
}
/***********************************************************************
* Public Functions
***********************************************************************/
int main(int argc, char *argv[])
{
char filename [FNAME_SIZE+1];
/* Parse command line arguments */
parseArguments(argc, argv);
/* Open all output files */
openOutputFiles();
#if !LSTTOFILE
lstFile = stdout;
#endif
/* Open source file -- Use .PAS or command line extension, if supplied */
(void)extension(sourceFileName, "PAS", filename, 0);
fprintf(errFile, "%01x=%s\n", FP->include, filename);
memset(FP, 0, sizeof(fileState_t));
FP->stream = fopen(filename, "r");
if (!FP->stream)
{
errmsg("Could not open source file '%s': %s\n",
filename, strerror(errno));
showUsage();
}
/* Initialization */
primeSignalHandlers();
primeSymbolTable(MAX_SYM);
primeBuiltInProcedures();
primeBuiltInFunctions();
primeTokenizer(MAX_STRINGS);
/* Initialize the POFF object */
poffHandle = poffCreateHandle();
if (poffHandle == NULL)
fatal(eNOMEMORY);
/* Save the soure file name in the POFF output file */
FP->include = poffAddFileName(poffHandle, filename);
/* Define standard input/output file characteristics */
files[0].defined = -1;
files[0].flevel = level;
files[0].ftype = sCHAR;
files[0].faddr = dstack;
files[0].fsize = sCHAR_SIZE;
dstack += sCHAR_SIZE;
/* We need the following in order to calculate relative stack positions. */
FP->dstack = dstack;
/* Indicate that no WITH statement has been processed */
memset(&withRecord, 0, sizeof(WTYPE));
/* Process the pascal program
*
* FORM: pascal = program | unit
* FORM: program = program-heading ';' [uses-section ] block '.'
* FORM: program-heading = 'program' identifier [ '(' identifier-list ')' ]
* FORM: unit = unit-heading ';' interface-section implementation-section init-section
* FORM: unit-heading = 'unit' identifer
*/
getToken();
if (token == tPROGRAM)
{
/* Compile a pascal program */
FP->kind = eIsProgram;
FP->section = eIsProgramSection;
getToken();
program();
}
else if (token == tUNIT)
{
/* Compile a pascal unit */
FP->kind = eIsUnit;
FP->section = eIsOtherSection;
getToken();
unitImplementation();
}
else
{
/* Expected 'program' or 'unit' */
error(ePROGRAM);
}
/* Dump the symbol table content (debug only) */
#if CONFIG_DEBUG
dumpTables();
#endif
/* Write the POFF output file */
poffWriteFile(poffHandle, poffFile);
poffDestroyHandle(poffHandle);
/* Close all output files */
closeFiles();
/* Write Closing Message */
if (warn_count > 0)
{
printf(" %ld Warnings Issued\n", warn_count);
} /* end if */
if (err_count > 0)
{
printf(" %d Errors Detected\n\n", err_count);
return -1;
} /* end if */
return 0;
} /* end main */
/***********************************************************************/
void openNestedFile(const char *fileName)
{
fileState_t *prev = FP;
char fullpath[FNAME_SIZE + 1];
int i;
/* Make sure we can handle another nested file */
if (++includeIndex >= MAX_INCL) fatal(eOVF);
else
{
/* Clear the file state structure for the new include level */
memset(FP, 0, sizeof(fileState_t));
/* Try all source include pathes until we find the file or
* until we exhaust the include path list.
*/
for (i = 0; ; i++)
{
/* Open the nested file -- try all possible pathes or
* until we successfully open the file.
*/
/* The final path that we will try is the current directory */
if (i == nIncPathes)
{
sprintf(fullpath, "./%s", fileName);
}
else
{
sprintf(fullpath, "%s/%s", includePath[i], fileName);
}
FP->stream = fopen (fullpath, "rb");
if (!FP->stream)
{
/* We failed to open the file. If there are no more
* include pathes to examine (including the current directory),
* then error out. This is fatal. Otherwise, continue
* looping.
*/
if (i == nIncPathes)
{
errmsg("Failed to open '%s': %s\n",
fileName, strerror(errno));
fatal(eINCLUDE);
break; /* Won't get here */
}
} /* end else if */
else
break;
}
/* Setup the newly opened file */
fprintf(errFile, "%01x=%s\n", FP->include, fullpath);
FP->include = poffAddFileName(poffHandle, fullpath);
/* The caller may change this, but the default behavior is
* to inherit the kind and section of the including file
* and the current data stack offset.
*/
FP->kind = prev->kind;
FP->section = prev->section;
FP->dstack = dstack;
rePrimeTokenizer();
/* Get the first token from the file */
getToken();
} /* end else */
}
/***********************************************************************/
void closeNestedFile(void)
{
if (FP->stream)
{
(void)fclose(FP->stream);
includeIndex--;
}
}
/***********************************************************************/
misc/pascal/pascal/pas.h
+116
View File
@@ -0,0 +1,116 @@
/***************************************************************************
* pas.h
* External Declarations associated with pas.c
*
* 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.
*
***************************************************************************/
#ifndef __PAS_H
#define __PAS_H
/***************************************************************************
* Compilation Switches
***************************************************************************/
#define LSTTOFILE 1
/***************************************************************************
* Included Files
***************************************************************************/
#include <sys/types.h>
#include <stdint.h>
#include "pasdefs.h"
#include "pofflib.h"
/***************************************************************************
* Pre-processor Definitions
***************************************************************************/
/* This is a helper macro just to make things pretty in the source code */
#define FP0 (&fileState[0]) /* Main file description */
#define FP (&fileState[includeIndex]) /* Current file description */
#define FPP (&fileState[includeIndex-1]) /* Previous file description */
#define IS_NESTED_UNIT ((includeIndex > 0) && (FP->kind == eIsUnit))
/***************************************************************************
* Global Types
***************************************************************************/
/***************************************************************************
* Global Variable
***************************************************************************/
extern uint16_t token; /* Current token */
extern uint16_t tknSubType; /* Extended token type */
extern int32_t tknInt; /* Integer token value */
extern double tknReal; /* Real token value */
extern STYPE *tknPtr; /* Pointer to symbol token */
extern FTYPE files[MAX_FILES+1]; /* File Table */
extern fileState_t fileState[MAX_INCL]; /* State of all open files */
/* sourceFileName : Source file name from command line
* includePath[] : Pathes to search when including file
*/
extern char *sourceFileName;
extern char *includePath[MAX_INCPATHES];
extern poffHandle_t poffHandle; /* Handle for POFF object */
extern FILE *poffFile; /* POFF output file */
extern FILE *errFile; /* Error file pointer */
extern FILE *lstFile; /* List file pointer */
extern WTYPE withRecord; /* RECORD of WITH statement */
extern int16_t level; /* Static nesting level */
extern int16_t includeIndex; /* Include file index */
extern int16_t nIncPathes; /* Number pathes in includePath[] */
extern uint16_t label; /* Last label number */
extern int16_t nsym; /* Number symbol table entries */
extern int16_t nconst; /* Number constant table entries */
extern int16_t sym_strt; /* Symbol search start index */
extern int16_t const_strt; /* Constant search start index */
extern int16_t err_count; /* Error counter */
extern int16_t nfiles; /* Program file counter */
extern int32_t warn_count; /* Warning counter */
extern int32_t dstack; /* data stack size */
/***************************************************************************
* Global Function Prototypes
***************************************************************************/
extern void openNestedFile (const char *fileName);
extern void closeNestedFile (void);
#endif /* __PAS_H */
misc/pascal/pascal/pasdefs.h
+284
View File
@@ -0,0 +1,284 @@
/***********************************************************************
* pascal/pasdefs.h
* General definitions for the Pascal Compiler/Optimizer
*
* 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.
*
***********************************************************************/
#ifndef __PASDEFS_H
#define __PASDEFS_H
/***********************************************************************
* Included Files
***********************************************************************/
#include <sys/types.h>
#include <stdint.h>
#include <stdbool.h>
#include <stdio.h> /* for FILE */
#include <config.h>
#include "pdefs.h" /* Common definitions */
/***********************************************************************
* Pre-processor Definitions
***********************************************************************/
/* Size Parameters -- some of these can be overridden from the
* command line.
*/
#define MAX_SYM (4096)
#define MAX_STRINGS (65536)
#define MAX_INCL 3 /* Max number of nested include files */
#define MAX_FILES 8 /* Max number of opened files */
#define FNAME_SIZE 40 /* Max size file name */
#define MAX_INCPATHES 8 /* Max number of include pathes */
/* Bit values for the 'flags' field of the symType_t, symProc_t, and
* symVar_t (see below)
*/
#define STYPE_VARSIZE 0x01 /* Type has variable size */
#define SPROC_EXTERNAL 0x01 /* Proc/func. is defined externally */
#define SVAR_EXTERNAL 0x01 /* Variable is defined externally */
/***********************************************************************
* Public Enumeration Types
***********************************************************************/
/* This enumeration identies what kind of binary object we are creating
* with the compilation. At present, we may be generating either a
* program binary or a unit binary.
*/
enum fileKind_e
{
eIsProgram = 0,
eIsUnit
};
typedef enum fileKind_e fileKind_t;
/* This enumeration determines what part of a file that we are
* processing now.
*/
enum fileSection_e
{
eIsOtherSection = 0, /* Unspecified part of the file */
eIsProgramSection, /* Any part of a program file */
eIsInterfaceSection, /* INTERFACE section of a unit file */
eIsImplementationSection, /* IMPLEMENTATION section of a unit file */
eIsInitializationSection, /* INITIALIZATION section of a unit file */
};
typedef enum fileSection_e fileSection_t;
/***********************************************************************
* Public Structure/Types
***********************************************************************/
/* Reserved word table entry */
struct R
{
char *rname; /* pointer to name in string stack */
uint8_t rtype; /* reserved word type */
uint8_t subtype; /* reserved word extended type */
};
typedef struct R RTYPE;
/* Symbol table entry */
struct symType_s /* for sKind = sTYPE */
{
uint8_t type; /* specific type */
uint8_t rtype; /* reference to type */
uint8_t subType; /* constant type for subrange types */
uint8_t flags; /* flags to customize a type (see above) */
uint32_t asize; /* size of allocated instances of this type */
uint32_t rsize; /* size of reference to an instances of this type */
int32_t minValue; /* minimum value taken subrange */
int32_t maxValue; /* maximum value taken by subrange or scalar */
struct S *parent; /* pointer to parent type */
};
typedef struct symType_s symType_t;
struct symConst_s /* for sKind == constant type */
{
union
{
double f; /* real value */
int32_t i; /* integer value */
} val;
struct S *parent; /* pointer to parent type */
};
typedef struct symConst_s symConst_t;
struct symStringConst_s /* for sKind == sSTRING_CONST */
{
uint32_t offset; /* RO data section offset of string */
uint32_t size; /* length of string in bytes */
};
typedef struct symStringConst_s symStringConst_t;
struct symVarString_s /* for sKind == sSTRING */
{
uint16_t label; /* label at string declaration */
uint16_t size; /* valid length of string in bytes */
uint16_t alloc; /* max length of string in bytes */
};
typedef struct symVarString_s symVarString_t;
struct symLabel_s /* for sKind == sLABEL */
{
uint16_t label; /* label number */
bool unDefined; /* set false when defined */
};
typedef struct symLabel_s symLabel_t;
struct symVar_s /* for sKind == type identifier */
{
int32_t offset; /* Data stack offset */
uint32_t size; /* Size of variable */
uint8_t flags; /* flags to customize a variable (see above) */
uint32_t symIndex; /* POFF symbol table index (if undefined) */
struct S *parent; /* pointer to parent type */
};
typedef struct symVar_s symVar_t;
struct symProc_s /* for sKind == sPROC or sFUNC */
{
uint16_t label; /* entry point label */
uint16_t nParms; /* number of parameters that follow */
uint8_t flags; /* flags to customize a proc/func (see above) */
uint32_t symIndex; /* POFF symbol table index (if undefined) */
struct S *parent; /* pointer to parent type (sFUNC only) */
};
typedef struct symProc_s symProc_t;
struct symRecord_s /* for sKind == sRECORD_OBJECT */
{
uint32_t size; /* size of this field */
uint32_t offset; /* offset into the RECORD */
struct S *record; /* pointer to parent sRECORD type */
struct S *parent; /* pointer to parent field type */
};
typedef struct symRecord_s symRecord_t;
struct S
{
char *sName; /* pointer to name in string stack */
uint8_t sKind; /* kind of symbol */
uint8_t sLevel; /* static nesting level */
union
{
symType_t t; /* for type definitions */
symConst_t c; /* for constants */
symStringConst_t s; /* for strings of constant size*/
symVarString_t vs; /* for strings of variable size*/
uint16_t fileNumber; /* for files */
symLabel_t l; /* for labels */
symVar_t v; /* for variables */
symProc_t p; /* for functions & procedures */
symRecord_t r; /* for files of RECORDS */
} sParm;
};
typedef struct S STYPE;
/* WITH structure */
struct W
{
uint8_t level; /* static nesting level */
bool pointer; /* true if offset is to pointer to RECORD */
bool varParm; /* true if VAR param (+pointer) */
int32_t offset; /* Data stack offset */
uint16_t index; /* RECORD offset (if pointer) */
STYPE *parent; /* pointer to parent RECORD type */
};
typedef struct W WTYPE;
/* File table record */
struct F
{
int16_t defined;
int16_t flevel;
int16_t ftype;
int32_t faddr;
int16_t fsize;
};
typedef struct F FTYPE;
/* This structure captures the parsing state of the compiler for a particular
* file. Since multiple, nested files can be processed, this represents
* only level in the "stack" of nested files.
*/
struct fileState_s
{
/* These fields are managed by the higher level parsing logic
*
* stream - Stream pointer the input stream associated with this
* file.
* kind - Kind of file we are processing. If include > 0,
* this should be eIsUnit.
* section - This is the part of the program that we are parsing
* now.
* dstack - Level zero dstack offset at the time the unit was
* included. This is used to convert absolute program
* stack offsets into relative unit stack offsets.
* include - Is a unique number that identifies the file. In
* POFF ouput file, this would be the index to the
* entry in the .files section.
*/
FILE *stream;
fileKind_t kind;
fileSection_t section;
int32_t dstack;
int16_t include;
/* These fields are managed by the tokenizer. These are all
* initialized by primeTokenizer().
*
* buffer[] - Holds the current input line
* line - Is the line number in this file for the current line
* cp - Is the current pointer into buffer[]
*/
uint32_t line;
unsigned char *cp;
unsigned char buffer[LINE_SIZE + 1];
};
typedef struct fileState_s fileState_t;
#endif /* __PASDEFS_H */
misc/pascal/pascal/pblck.c
+2263
View File
File diff suppressed because it is too large Load Diff
misc/pascal/pascal/pblck.h
+57
View File
@@ -0,0 +1,57 @@
/***************************************************************************
* pblck.h
* External Declarations associated with pblck.c
*
* 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.
*
***************************************************************************/
#ifndef __PBLCK_H
#define __PBLCK_H
/***************************************************************************
* Included Files
***************************************************************************/
#include <stdint.h>
/***************************************************************************
* Global Function Prototypes
***************************************************************************/
extern void block(void);
extern void declarationGroup(int32_t beginLabel);
extern void constantDefinitionGroup(void);
extern void typeDefinitionGroup(void);
extern void variableDeclarationGroup(void);
extern int16_t formalParameterList(STYPE *procPtr);
#endif /* __PBLCK_H */
misc/pascal/pascal/pcexpr.c
+576
View File
@@ -0,0 +1,576 @@
/***************************************************************
* pexpr.c
* Constant expression evaluation
*
* 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 <sys/types.h>
#include <stdint.h>
#include <stdio.h>
#include <string.h>
#include <math.h>
#include "keywords.h"
#include "pasdefs.h"
#include "ptdefs.h"
#include "pedefs.h"
#include "keywords.h"
#include "pas.h"
#include "pstm.h"
#include "pexpr.h"
#include "pfunc.h"
#include "ptkn.h"
#include "perr.h"
/***************************************************************
* Pre-processor Definitions
***************************************************************/
#define ADDRESS_DEREFERENCE 0x01
#define ADDRESS_FACTOR 0x02
#define INDEXED_FACTOR 0x04
#define VAR_PARM_FACTOR 0x08
#define intTrunc(x) ((x) & (~(sINT_SIZE)))
#define isRelationalOperator(t) \
(((t) == tEQ) || ((t) == tNE) || \
((t) == tLT) || ((t) == tLE) || \
((t) == tGT) || ((t) == tGE) || \
((t) == tIN))
#define isRelationalType(t) \
(((t) == tINT_CONST) || ((t) == tCHAR_CONST) || \
(((t) == tBOOLEAN_CONST) || ((t) == tREAL_CONST)))
#define isAdditiveType(t) \
(((t) == tINT_CONST) || ((t) == tREAL_CONST))
#define isMultiplicativeType(t) \
(((t) == tINT_CONST) || ((t) == tREAL_CONST))
#define isLogicalType(t) \
(((t) == tINT_CONST) || ((t) == tBOOLEAN_CONST))
/***************************************************************
* Private Type Declarations
***************************************************************/
/***************************************************************
* Private Function Prototypes
***************************************************************/
static void constantSimpleExpression(void);
static void constantTerm(void);
static void constantFactor(void);
/***************************************************************
* Global Variables
***************************************************************/
int constantToken;
int32_t constantInt;
double constantReal;
char *constantStart;
/***************************************************************
* Private Variables
***************************************************************/
/***************************************************************/
/* Evaluate a simple expression of constant values */
void constantExpression(void)
{
TRACE(lstFile,"[constantExpression]");
/* Get the value of a simple constant expression */
constantSimpleExpression();
/* Is it followed by a relational operator? */
if (isRelationalOperator(token) && isRelationalType(constantToken))
{
int simple1 = constantToken;
int32_t simple1Int = constantInt;
double simple1Real = constantReal;
int operator = token;
/* Get the second simple expression */
constantSimpleExpression();
if (simple1 != constantToken)
{
/* Handle the case where the 1st argument is REAL and the
* second is INTEGER. */
if ((simple1 == tREAL_CONST) && (constantToken == tINT_CONST))
{
simple1Real = (double)simple1Int;
simple1 = tREAL_CONST;
}
/* Handle the case where the 1st argument is Integer and the
* second is REAL. */
else if ((simple1 == tINT_CONST) && (constantToken == tREAL_CONST))
{
constantReal = (double)constantInt;
}
/* Allow the case of <scalar type> IN <set type>
* Otherwise, the two terms must agree in type
* -- NOT YET implemented.
*/
else
{
error(eEXPRTYPE);
}
}
/* Generate the comparison by type */
switch (simple1)
{
case tINT_CONST :
case tCHAR_CONST :
case tBOOLEAN_CONST :
switch (operator)
{
case tEQ :
constantInt = (simple1Int == constantInt);
break;
case tNE :
constantInt = (simple1Int != constantInt);
break;
case tLT :
constantInt = (simple1Int < constantInt);
break;
case tLE :
constantInt = (simple1Int <= constantInt);
break;
case tGT :
constantInt = (simple1Int > constantInt);
break;
case tGE :
constantInt = (simple1Int >= constantInt);
break;
case tIN :
/* Not yet */
default :
error(eEXPRTYPE);
break;
}
break;
case tREAL_CONST:
switch (operator)
{
case tEQ :
constantInt = (simple1Real == constantReal);
break;
case tNE :
constantInt = (simple1Real != constantReal);
break;
case tLT :
constantInt = (simple1Real < constantReal);
break;
case tLE :
constantInt = (simple1Real <= constantReal);
break;
case tGT :
constantInt = (simple1Real > constantReal);
break;
case tGE :
constantInt = (simple1Real >= constantReal);
break;
case tIN :
/* Not yet */
default :
error(eEXPRTYPE);
break;
}
break;
default :
error(eEXPRTYPE);
break;
}
/* The type resulting from these operations becomes BOOLEAN */
constantToken = tBOOLEAN_CONST;
}
}
/***************************************************************/
/* Process Simple Expression */
static void constantSimpleExpression(void)
{
int16_t unary = ' ';
int term;
int32_t termInt;
double termReal;
TRACE(lstFile,"[constantSimpleExpression]");
/* FORM: [+|-] <term> [{+|-} <term> [{+|-} <term> [...]]] */
/* get +/- unary operation */
if ((token == '+') || (token == '-'))
{
unary = token;
getToken();
}
/* Process first (non-optional) term and apply unary operation */
constantTerm();
term = constantToken;
if ((unary != ' ') && !isAdditiveType(term))
{
error(eINVSIGNEDCONST);
}
else if (unary == '-')
{
termInt = -constantInt;
termReal = -constantReal;
}
else
{
termInt = constantInt;
termReal = constantReal;
}
/* Process subsequent (optional) terms and binary operations */
for (;;)
{
int operator;
/* Check for binary operator */
if ((((token == '+') || (token == '-')) )&& isAdditiveType(term))
operator = token;
else if ((token == tOR) && isLogicalType(term))
operator = token;
else
break;
/* Get the 2nd term */
getToken();
constantTerm();
/* Before generating the operation, verify that the types match.
* Perform automatic type conversion from INTEGER to REAL as
* necessary.
*/
if (term != constantToken)
{
/* Handle the case where the 1st argument is REAL and the
* second is INTEGER. */
if ((term == tREAL_CONST) && (constantToken == tINT_CONST))
{
constantReal = (double)constantInt;
constantToken = tREAL_CONST;
}
/* Handle the case where the 1st argument is Integer and the
* second is REAL. */
else if ((term == tINT_CONST) && (constantToken == tREAL_CONST))
{
termReal = (double)termInt;
term = tREAL_CONST;
}
/* Otherwise, the two terms must agree in type */
else
{
error(eTERMTYPE);
}
} /* end if */
/* Perform the selected binary operation */
switch (term)
{
case tINT_CONST :
if (operator == '+')
{
termInt += constantInt;
}
else
{
termInt -= constantInt;
}
break;
case tREAL_CONST :
if (operator == '+')
{
termReal += constantReal;
}
else
{
termReal -= constantReal;
}
break;
case tBOOLEAN_CONST :
termInt |= constantInt;
break;
default :
error(eEXPRTYPE);
break;
}
}
constantToken = term;
constantInt = termInt;
constantReal = termReal;
}
/***************************************************************/
/* Evaluate a TERM */
void constantTerm(void)
{
int operator;
int factor;
int32_t factorInt;
double factorReal;
TRACE(lstFile,"[constantTerm]");
/* FORM: <factor> [<operator> <factor>[<operator><factor>[...]]] */
constantFactor();
factor = constantToken;
factorInt = constantInt;
factorReal = constantReal;
for (;;) {
/* Check for binary operator */
if (((token == tMUL) || (token == tMOD)) &&
(isMultiplicativeType(factor)))
operator = token;
else if (((token == tDIV) || (token == tSHL) || (token == tSHR)) &&
(factor == tINT_CONST))
operator = token;
else if ((token == tFDIV) && (factor == tREAL_CONST))
operator = token;
#if 0
else if ((token == tFDIV) && (factor == tINT_CONST))
{
factorReal = (double)factorInt;
factor = tREAL_CONST;
operator = token;
}
#endif
else if ((token == tAND) && isLogicalType(factor))
operator = token;
else
{
constantToken = factor;
constantInt = factorInt;
constantReal = factorReal;
break;
}
/* Get the next factor */
getToken();
constantFactor();
/* Before generating the operation, verify that the types match.
* Perform automatic type conversion from INTEGER to REAL as
* necessary.
*/
if (factor != constantToken)
{
/* Handle the case where the 1st argument is REAL and the
* second is INTEGER. */
if ((factor == tREAL_CONST) && (constantToken == tINT_CONST))
{
constantReal = (double)constantInt;
}
/* Handle the case where the 1st argument is Integer and the
* second is REAL. */
else if ((factor == tINT_CONST) && (constantToken == tREAL_CONST))
{
factorReal = (double)factorInt;
factor = tREAL_CONST;
}
/* Otherwise, the two factors must agree in type */
else
{
error(eFACTORTYPE);
}
} /* end if */
/* Generate code to perform the selected binary operation */
switch (operator)
{
case tMUL :
if (factor == tINT_CONST)
factorInt *= constantInt;
else if (factor == tREAL_CONST)
factorReal *= constantReal;
else
error(eFACTORTYPE);
break;
case tDIV :
if (factor == tINT_CONST)
factorInt /= constantInt;
else
error(eFACTORTYPE);
break;
case tFDIV :
if (factor == tREAL_CONST)
factorReal /= constantReal;
else
error(eFACTORTYPE);
break;
case tMOD :
if (factor == tINT_CONST)
factorInt %= constantInt;
else if (factor == tREAL_CONST)
factorReal = fmod(factorReal, constantReal);
else
error(eFACTORTYPE);
break;
case tAND :
if ((factor == tINT_CONST) || (factor == tBOOLEAN_CONST))
factorInt &= constantInt;
else
error(eFACTORTYPE);
break;
case tSHL :
if (factor == tINT_CONST)
factorInt <<= constantInt;
else
error(eFACTORTYPE);
break;
case tSHR :
if (factor == tINT_CONST)
factorInt >>= constantInt;
else
error(eFACTORTYPE);
break;
}
}
}
/***************************************************************/
/* Process a FACTOR */
static void constantFactor(void)
{
TRACE(lstFile,"[constantFactor]");
/* Process by token type */
switch (token)
{
case tINT_CONST :
case tBOOLEAN_CONST :
case tCHAR_CONST :
constantToken = token;
constantInt = tknInt;
getToken();
break;
case tREAL_CONST :
constantToken = token;
constantReal = tknReal;
getToken();
break;
case tSTRING_CONST :
constantToken = token;
constantStart = tkn_strt;
getToken();
break;
/* Highest Priority Operators */
case tNOT:
getToken();
constantFactor();
if ((constantToken != tINT_CONST) && (constantToken != tBOOLEAN_CONST))
error(eFACTORTYPE);
constantInt = ~constantInt;
break;
/* Built-in function? */
case tFUNC:
builtInFunctionOfConstant();
break;
/* Hmmm... Try the standard functions */
default :
error(eINVFACTOR);
break;
}
}
misc/pascal/pascal/pcfunc.c
+341
View File
@@ -0,0 +1,341 @@
/***************************************************************
* pcfunc.c
* Standard Function operating on constant values
*
* 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 <sys/types.h>
#include <stdint.h>
#include <stdio.h>
#include <math.h>
#include "keywords.h"
#include "pasdefs.h"
#include "ptdefs.h"
#include "podefs.h"
#include "pfdefs.h"
#include "pedefs.h"
#include "pxdefs.h"
#include "pas.h"
#include "pexpr.h"
#include "pfunc.h"
#include "ptkn.h"
#include "perr.h"
/***************************************************************
* Private Function Prototypes
***************************************************************/
/* Standard Pascal Functions */
static void constantAbsFunc(void); /* Integer absolute value */
static void constantPredFunc(void);
static void constantOrdFunc(void); /* Convert scalar to integer */
static void constantSqrFunc(void);
static void constantRealFunc(uint8_t fpCode);
static void constantSuccFunc(void);
static void constantOddFunc(void);
static void constantChrFunc(void);
static void constantReal2IntFunc(int kind);
static void isOrdinalConstant(void);
/***************************************************************/
/* Process a standard Pascal function call */
void builtInFunctionOfConstant(void)
{
TRACE(lstFile,"[builtInFunctionFactor]");
/* Is the token a function? */
if (token == tFUNC)
{
/* Yes, process it procedure according to the extended token type */
switch (tknSubType)
{
/* Functions which return the same type as their argument */
case txABS :
constantAbsFunc();
break;
case txSQR :
constantSqrFunc();
break;
case txPRED :
constantPredFunc();
break;
case txSUCC :
constantSuccFunc();
break;
/* Functions returning INTEGER with REAL arguments */
case txROUND :
constantReal2IntFunc(fpROUND);
break;
case txTRUNC :
constantReal2IntFunc(fpTRUNC);
break;
/* Functions returning CHARACTER with INTEGER arguments. */
case txCHR :
constantChrFunc();
break;
/* Function returning integer with scalar arguments */
case txORD :
constantOrdFunc();
break;
/* Functions returning BOOLEAN */
case txODD :
constantOddFunc();
break;
/* Functions returning REAL with REAL/INTEGER arguments */
case txSQRT :
constantRealFunc(fpSQRT);
break;
case txSIN :
constantRealFunc(fpSIN);
break;
case txCOS :
constantRealFunc(fpCOS);
break;
case txARCTAN :
constantRealFunc(fpATAN);
break;
case txLN :
constantRealFunc(fpLN);
break;
case txEXP :
constantRealFunc(fpEXP);
break;
case txGETENV : /* Non-standard C library interfaces */
case txEOLN :
case txEOF :
default :
error(eINVALIDPROC);
break;
}
}
}
/**********************************************************************/
static void constantAbsFunc(void)
{
TRACE(lstFile,"[constantAbsFunc]");
/* FORM: ABS (<simple integer/real expression>) */
checkLParen();
constantExpression();
if (constantToken == tINT_CONST)
{
if (constantInt < 0)
constantInt = -constantInt;
}
else if (constantToken == tREAL_CONST)
{
if (constantReal < 0)
constantReal = -constantInt;
}
else
error(eINVARG);
checkRParen();
}
/**********************************************************************/
static void constantOrdFunc(void)
{
TRACE(lstFile,"[constantOrdFunc]");
/* FORM: ORD (<scalar type>) */
checkLParen();
constantExpression();
isOrdinalConstant();
checkRParen();
}
/**********************************************************************/
static void constantPredFunc(void)
{
TRACE(lstFile,"[constantPredFunc]");
/* FORM: PRED (<simple integer expression>) */
checkLParen();
constantExpression();
isOrdinalConstant();
constantInt--;
checkRParen();
}
/**********************************************************************/
static void constantSqrFunc(void)
{
TRACE(lstFile,"[constantSqrFunc]");
/* FORM: SQR (<simple integer OR real expression>) */
checkLParen();
constantExpression();
if (constantToken == tINT_CONST)
{
constantInt *= constantInt;
}
else if (constantToken == tREAL_CONST)
{
constantReal *= constantReal;
}
else
{
error(eINVARG);
}
checkRParen();
}
/**********************************************************************/
static void constantRealFunc(uint8_t fpOpCode)
{
TRACE(lstFile,"[constantRealFunc]");
/* FORM: <function identifier> (<real/integer expression>) */
checkLParen();
constantExpression();
if (constantToken == tINT_CONST)
constantReal = (double)constantInt;
else
error(eINVARG);
checkRParen();
}
/**********************************************************************/
static void constantSuccFunc(void)
{
TRACE(lstFile,"[constantSuccFunc]");
/* FORM: SUCC (<simple integer expression>) */
checkLParen();
constantExpression();
isOrdinalConstant();
constantInt++;
checkRParen();
}
/***********************************************************************/
static void constantOddFunc(void)
{
TRACE(lstFile,"[constantOddFunc]");
/* FORM: ODD (<simple integer expression>) */
checkLParen();
constantExpression();
isOrdinalConstant();
constantInt &= 1;
expression(exprAnyOrdinal, NULL);
checkRParen();
}
/***********************************************************************/
/* Process the standard chr function */
static void constantChrFunc(void)
{
TRACE(lstFile,"[constantCharFunc]");
/* Form: chr(integer expression).
*
* char(val) is only defined if there exists a character ch such
* that ord(ch) = val. If this is not the case, we will simply
* let the returned value exceed the range of type char. */
checkLParen();
constantExpression();
if (constantToken == tINT_CONST)
{
constantToken = tCHAR_CONST;
}
else
{
error(eINVARG);
}
checkRParen();
}
/***********************************************************************/
static void constantReal2IntFunc(int kind)
{
error(eNOTYET);
}
/***********************************************************************/
static void isOrdinalConstant(void)
{
if ((constantToken == tINT_CONST) || /* integer value */
(constantToken == tCHAR_CONST) || /* character value */
(constantToken == tBOOLEAN_CONST))
return;
else
error(eINVARG);
}
/***********************************************************************/
misc/pascal/pascal/perr.c
+191
View File
@@ -0,0 +1,191 @@
/**********************************************************************
* perr.c
* Error Handlers
*
* 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 <stdarg.h>
#include "config.h"
#include "keywords.h"
#include "pasdefs.h"
#include "pedefs.h"
#include "pas.h"
#include "ptkn.h"
#include "perr.h"
#if CONFIG_DEBUG
# include "ptbl.h"
#endif
/**********************************************************************
* Pre-processor Definitions
**********************************************************************/
#if CONFIG_DEBUG
#define DUMPTABLES dumpTables()
#else
#define DUMPTABLES
#endif
/**********************************************************************
* Private Variables
**********************************************************************/
static const char fmtErrNoToken[] =
"Line %d:%04ld Error %02x Token %02x\n";
static const char fmtErrWithToken[] =
"Line %d:%04ld Error %02x Token %02x (%s)\n";
static const char fmtErrAbort[] =
"Fatal Error %d -- Compilation aborted\n";
/**********************************************************************
* Private Function Prototypes
**********************************************************************/
static void printError(uint16_t errcode);
/***********************************************************************/
void errmsg(char *fmt, ...)
{
char buffer[1024];
va_list ap;
/* Get the full string */
va_start(ap, fmt);
(void)vsprintf(buffer, fmt, ap);
/* Then output the string to stderr, the err file, and the list file */
fputs(buffer, stderr);
fputs(buffer, errFile);
fputs(buffer, lstFile);
va_end(ap);
}
/***********************************************************************/
void warn(uint16_t errcode)
{
TRACE(lstFile,"[warn:%04x]", errcode);
/* Write error record to the error and list files */
printError(errcode);
/* Increment the count of warning */
warn_count++;
} /* end warn */
/***********************************************************************/
void error(uint16_t errcode)
{
TRACE(lstFile,"[error:%04x]", errcode);
#if CONFIG_DEBUG
fatal(errcode);
#else
/* Write error record to the error and list files */
printError(errcode);
/* Check if err_count has been execeeded the max allowable */
if ((++err_count) > MAX_ERRORS)
{
fatal(eCOUNT);
}
#endif
} /* end error */
/***********************************************************************/
void fatal(uint16_t errcode)
{
TRACE(lstFile,"[fatal:%04x]", errcode);
/* Write error record to the error and list files */
printError( errcode );
/* Dump the tables (if CONFIG_DEBUG) */
DUMPTABLES;
/* And say goodbye */
printf(fmtErrAbort, errcode);
fprintf(lstFile, fmtErrAbort, errcode);
exit(1);
} /* end fatal */
/***********************************************************************/
static void printError(uint16_t errcode)
{
/* Write error record to the error and list files */
if ((tkn_strt) && (tkn_strt < stringSP))
{
fprintf (errFile, fmtErrWithToken,
FP->include, FP->line, errcode, token, tkn_strt);
fprintf (lstFile, fmtErrWithToken,
FP->include, FP->line, errcode, token, tkn_strt);
stringSP = tkn_strt; /* Clean up string stack */
} /* end if */
else
{
fprintf (errFile, fmtErrNoToken,
FP->include, FP->line, errcode, token);
fprintf (lstFile, fmtErrNoToken,
FP->include, FP->line, errcode, token);
} /* end else */
} /* end printError */
/***********************************************************************/
misc/pascal/pascal/pexpr.c
+2737
View File
File diff suppressed because it is too large Load Diff
misc/pascal/pascal/pexpr.h
+98
View File
@@ -0,0 +1,98 @@
/***********************************************************************
* pexpr.h
* External Declarations associated with pexpr.c
*
* 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.
*
***********************************************************************/
#ifndef __PEXPR_H
#define __PEXPR_H
/***********************************************************************
* Included Files
***********************************************************************/
#include <stdint.h>
/***********************************************************************
* Type Definitions
***********************************************************************/
typedef enum exprEnum
{
exprUnknown = 0, /* TOS value unknown */
exprAnyOrdinal, /* TOS = any ordinal type */
exprAnyString, /* TOS = any string type */
exprInteger, /* TOS = integer value */
exprReal, /* TOS = real value */
exprChar, /* TOS = character value */
exprBoolean, /* TOS = boolean(integer) value */
exprScalar, /* TOS = scalar(integer) value */
exprString, /* TOS = variable length string reference */
exprStkString, /* TOS = reference to string on string stack */
exprCString, /* TOS = pointer to C string */
exprSet, /* TOS = set(integer) value */
exprArray, /* TOS = array */
exprRecord, /* TOS = record */
exprIntegerPtr, /* TOS = pointer to integer value */
exprRealPtr, /* TOS = pointer to a real value */
exprCharPtr, /* TOS = pointer to a character value */
exprBooleanPtr, /* TOS = pointer to a boolean value */
exprScalarPtr, /* TOS = pointer to a scalar value */
exprSetPtr, /* TOS = pointer to a set value */
exprArrayPtr, /* TOS = pointer to an array */
exprRecordPtr /* TOS = pointer to a record */
} exprType;
/***********************************************************************
* Global Variables
***********************************************************************/
extern int constantToken;
extern int32_t constantInt;
extern double constantReal;
extern char *constantStart;
/***********************************************************************
* Global Function Protypes
***********************************************************************/
extern exprType expression ( exprType findExprType, STYPE *typePtr );
extern exprType varParm ( exprType varExprType, STYPE *typePtr );
extern void arrayIndex ( int32_t size );
extern exprType getExprType( STYPE *sType );
extern void constantExpression(void);
#endif /* __PEXPR_H */
misc/pascal/pascal/pffunc.c
+452
View File
@@ -0,0 +1,452 @@
/***************************************************************
* pfunc.c
* Standard Functions
*
* 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 "keywords.h"
#include "pasdefs.h"
#include "ptdefs.h"
#include "podefs.h"
#include "pfdefs.h"
#include "pedefs.h"
#include "pxdefs.h"
#include "pas.h"
#include "pexpr.h"
#include "pfunc.h"
#include "pgen.h" /* for pas_Generate*() */
#include "ptkn.h"
#include "pinsn.h"
#include "perr.h"
/***************************************************************
* Private Function Prototypes
***************************************************************/
/* Standard Pascal Functions */
static exprType absFunc (void); /* Integer absolute value */
static exprType predFunc (void);
static void ordFunc (void); /* Convert scalar to integer */
static exprType sqrFunc (void);
static void realFunc (uint8_t fpCode);
static exprType succFunc (void);
static void oddFunc (void);
static void chrFunc (void);
static void fileFunc (uint16_t opcode);
/* Enhanced Pascal functions */
/* Non-standard C-library interface functions */
static exprType getenvFunc (void); /* Get environment string value */
/***************************************************************
* Public Functions
***************************************************************/
void primeBuiltInFunctions(void)
{
}
/***************************************************************/
/* Process a standard Pascal function call */
exprType builtInFunction(void)
{
exprType funcType = exprUnknown;
TRACE(lstFile,"[builtInFunction]");
/* Is the token a function? */
if (token == tFUNC)
{
/* Yes, process it procedure according to the extended token type */
switch (tknSubType)
{
/* Functions which return the same type as their argument */
case txABS :
funcType = absFunc();
break;
case txSQR :
funcType = sqrFunc();
break;
case txPRED :
funcType = predFunc();
break;
case txSUCC :
funcType = succFunc();
break;
case txGETENV : /* Non-standard C library interfaces */
funcType = getenvFunc();
break;
/* Functions returning INTEGER with REAL arguments */
case txROUND :
getToken(); /* Skip over 'round' */
expression(exprReal, NULL);
pas_GenerateFpOperation(fpROUND);
funcType = exprInteger;
break;
case txTRUNC :
getToken(); /* Skip over 'trunc' */
expression(exprReal, NULL);
pas_GenerateFpOperation(fpTRUNC);
funcType = exprInteger;
break;
/* Functions returning CHARACTER with INTEGER arguments. */
case txCHR :
chrFunc();
funcType = exprChar;
break;
/* Function returning integer with scalar arguments */
case txORD :
ordFunc();
funcType = exprInteger;
break;
/* Functions returning BOOLEAN */
case txODD :
oddFunc();
funcType = exprBoolean;
break;
case txEOF :
fileFunc(xEOF);
funcType = exprBoolean;
break;
case txEOLN :
fileFunc(xEOLN);
funcType = exprBoolean;
break;
/* Functions returning REAL with REAL/INTEGER arguments */
case txSQRT :
realFunc(fpSQRT);
funcType = exprReal;
break;
case txSIN :
realFunc(fpSIN);
funcType = exprReal;
break;
case txCOS :
realFunc(fpCOS);
funcType = exprReal;
break;
case txARCTAN :
realFunc(fpATAN);
funcType = exprReal;
break;
case txLN :
realFunc(fpLN);
funcType = exprReal;
break;
case txEXP :
realFunc(fpEXP);
funcType = exprReal;
break;
default :
error(eINVALIDPROC);
break;
} /* end switch */
} /* end if */
return funcType;
} /* end builtInFunction */
void checkLParen(void)
{
getToken(); /* Skip over function name */
if (token != '(') error(eLPAREN); /* Check for '(' */
else getToken();
}
void checkRParen(void)
{
if (token != ')') error(eRPAREN); /* Check for ')') */
else getToken();
}
/***************************************************************
* Private Functions
***************************************************************/
static exprType absFunc(void)
{
exprType absType;
TRACE(lstFile,"[absFunc]");
/* FORM: ABS (<simple integer/real expression>) */
checkLParen();
absType = expression(exprUnknown, NULL);
if (absType == exprInteger)
pas_GenerateSimple(opABS);
else if (absType == exprReal)
pas_GenerateFpOperation(fpABS);
else
error(eINVARG);
checkRParen();
return absType;
} /* end absFunc */
/**********************************************************************/
static void ordFunc(void)
{
TRACE(lstFile,"[ordFunc]");
/* FORM: ORD (<scalar type>) */
checkLParen();
expression(exprAnyOrdinal, NULL); /* Get any ordinal type */
checkRParen();
} /* end ordFunc */
/**********************************************************************/
static exprType predFunc(void)
{
exprType predType;
TRACE(lstFile,"[predFunc]");
/* FORM: PRED (<simple integer expression>) */
checkLParen();
/* Process any ordinal expression */
predType = expression(exprAnyOrdinal, NULL);
checkRParen();
pas_GenerateSimple(opDEC);
return predType;
} /* end predFunc */
/**********************************************************************/
static exprType sqrFunc(void)
{
exprType sqrType;
TRACE(lstFile,"[sqrFunc]");
/* FORM: SQR (<simple integer OR real expression>) */
checkLParen();
sqrType = expression(exprUnknown, NULL); /* Process any expression */
if (sqrType == exprInteger) {
pas_GenerateSimple(opDUP);
pas_GenerateSimple(opMUL);
} /* end if */
else if (sqrType == exprReal)
pas_GenerateFpOperation(fpSQR);
else
error(eINVARG);
checkRParen();
return sqrType;
} /* end sqrFunc */
/**********************************************************************/
static void realFunc (uint8_t fpOpCode)
{
exprType realType;
TRACE(lstFile,"[realFunc]");
/* FORM: <function identifier> (<real/integer expression>) */
checkLParen();
realType = expression(exprUnknown, NULL); /* Process any expression */
if (realType == exprInteger)
pas_GenerateFpOperation((fpOpCode | fpARG1));
else if (realType == exprReal)
pas_GenerateFpOperation(fpOpCode);
else
error(eINVARG);
checkRParen();
} /* end realFunc */
/**********************************************************************/
static exprType succFunc(void)
{
exprType succType;
TRACE(lstFile,"[succFunc]");
/* FORM: SUCC (<simple integer expression>) */
checkLParen();
/* Process any ordinal expression */
succType = expression(exprAnyOrdinal, NULL);
checkRParen();
pas_GenerateSimple(opINC);
return succType;
} /* end succFunc */
/***********************************************************************/
static void oddFunc(void)
{
TRACE(lstFile,"[oddFunc]");
/* FORM: ODD (<simple integer expression>) */
checkLParen();
/* Process any ordinal expression */
expression(exprAnyOrdinal, NULL);
checkRParen();
pas_GenerateDataOperation(opPUSH, 1);
pas_GenerateSimple(opAND);
pas_GenerateSimple(opNEQZ);
} /* end oddFunc */
/***********************************************************************/
/* Process the standard chr function */
static void chrFunc(void)
{
TRACE(lstFile,"[charFactor]");
/* Form: chr(integer expression).
*
* char(val) is only defined if there exists a character ch such
* that ord(ch) = val. If this is not the case, we will simply
* let the returned value exceed the range of type char. */
checkLParen();
expression(exprInteger, NULL);
checkRParen();
} /* end chrFunc */
/****************************************************************************/
/* EOF/EOLN function */
static void fileFunc(uint16_t opcode)
{
TRACE(lstFile,"[fileFunc]");
/* FORM: EOF|EOLN (<file number>) */
checkLParen();
if (token != sFILE)
{
error(eFILE);
}
else
{
pas_GenerateDataOperation(opINDS, sBOOLEAN_SIZE);
pas_GenerateIoOperation(opcode, tknPtr->sParm.fileNumber);
getToken();
checkRParen();
} /* end else */
} /* end fileFunc */
/**********************************************************************/
/* C library getenv interface */
static exprType getenvFunc(void)
{
exprType stringType;
TRACE(lstFile, "[getenvFunc]");
/* FORM: <string_var> = getenv(<string>) */
checkLParen();
/* Get the string expression representing the environment variable
* name.
*/
stringType = expression(exprString, NULL);
/* Two possible kinds of strings could be returned.
* Anything else other then 'exprString' would be an error (but
* should happen).
*/
if ((stringType != exprString) && (stringType != exprStkString))
{
error(eINVARG);
}
pas_BuiltInFunctionCall(lbGETENV);
checkRParen();
return exprCString;
}
/***********************************************************************/
misc/pascal/pascal/pfunc.h
+57
View File
@@ -0,0 +1,57 @@
/***************************************************************************
* pfunc.h
* External Declarations associated with pfunc.c
*
* Copyright (C) 2008 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.
*
***************************************************************************/
#ifndef __PFUNC_H
#define __PFUNC_H
/***************************************************************************
* Included Files
***************************************************************************/
#include "pexpr.h" /* For exprType */
/***************************************************************************
* Global Function Prototypes
***************************************************************************/
extern void primeBuiltInFunctions(void);
extern exprType builtInFunction(void);
extern void builtInFunctionOfConstant(void);
extern void checkLParen(void);
extern void checkRParen(void);
#endif /* __PFUNC_H */
misc/pascal/pascal/pgen.c
+641
View File
@@ -0,0 +1,641 @@
/**********************************************************************
* pgen.c
* P-Code generation logic
*
* 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 <string.h>
#include <errno.h>
#include "config.h" /* Configuration */
#include "keywords.h" /* Standard types */
#include "pasdefs.h" /* Common types */
#include "ptdefs.h" /* Token / symbol table definitions */
#include "podefs.h" /* Logical opcode definitions */
#include "pedefs.h" /* error code definitions */
#include "pas.h" /* Global variables */
#include "poff.h" /* For POFF file format */
#include "pofflib.h" /* For poff*() functions*/
#include "pinsn.h" /* (DEBUG only) */
#include "perr.h" /* error() */
#include "pproc.h" /* for actualParameterSize */
#include "pgen.h" /* (to verify prototypes in this file) */
/**********************************************************************
* Pre-processor Definitions
**********************************************************************/
#define UNDEFINED_LEVEL (-1)
#define INVALID_PCODE (-1)
#define LEVEL_DEFINED(l) ((int32_t)(l) >= 0)
#define PCODE_VALID(p) ((int32_t)(p) >= 0)
/**********************************************************************
* Global Variables
**********************************************************************/
/**********************************************************************
* Private Variables
**********************************************************************/
static int32_t g_currentStackLevelReference = UNDEFINED_LEVEL;
static uint32_t g_nStackLevelReferenceChanges = 0;
/***********************************************************************
* Private Function Prototypes
***********************************************************************/
/***********************************************************************
* Private Functions
***********************************************************************/
/***********************************************************************/
/* Generate a stack reference opcode to a global variable residing at
* static nesting level zero.
*/
static void
pas_GenerateLevel0StackReference(enum pcode_e eOpCode, STYPE *pVar)
{
/* Sanity checking. Double check nesting level and also since this is
* a level zero reference, then the offset must be positive
*/
if ((pVar->sLevel != 0) || (pVar->sParm.v.offset < 0))
{
error(eHUH);
}
else
{
/* Generate the P-code */
insn_GenerateDataOperation(eOpCode, pVar->sParm.v.offset);
/* If the variable is undefined, also generate a relocation
* record.
*/
if ((pVar->sParm.v.flags & SVAR_EXTERNAL) != 0)
{
(void)poffAddRelocation(poffHandle, RLT_LDST,
pVar->sParm.v.symIndex, 0);
}
}
}
/***********************************************************************/
/* There are some special P-codes for accessing stack data at static
* nesting level 0. Check if the specified opcode is one of those. If
* so, return the mapped opcode. Otherwise, return INVALID_PCODE.
*/
static int32_t
pas_GetLevel0Opcode(enum pcode_e eOpCode)
{
switch (eOpCode)
{
case opLDS: return opLD;
case opLDSH: return opLDH;
case opLDSB: return opLDB;
case opLDSM: return opLDM;
case opSTS: return opST;
case opSTSB: return opSTB;
case opSTSM: return opSTM;
case opLDSX: return opLDX;
case opLDSXB: return opLDXB;
case opLDSXM: return opLDXM;
case opSTSX: return opSTX;
case opSTSXB: return opSTXB;
case opSTSXM: return opSTXM;
case opLAS: return opLA;
case opLASX: return opLAX;
default: return INVALID_PCODE;
}
}
/***********************************************************************/
/* A new static nesting level has been encountered. Check if we need
* to reset the level stack pointer (LSP) register (assuming that the
* architecutre has one).
*/
static void
pas_SetLevelStackPointer(uint32_t dwLevel)
{
if (dwLevel != g_currentStackLevelReference)
{
/* Set the level stack pointer (LSP) register */
insn_SetStackLevel(dwLevel);
/* Remember the setting so that we do not reset the LSP until
* the level changes (or it is invalidated).
*/
g_currentStackLevelReference = dwLevel;
g_nStackLevelReferenceChanges++;
}
}
/***********************************************************************
* Public Functions
***********************************************************************/
/***********************************************************************/
/* Return the current setting of the level stack pointer (LSP) register
* -- assuming that the underlying architecure may have one.
*/
int32_t pas_GetCurrentStackLevel(void)
{
return g_currentStackLevelReference;
}
/***********************************************************************/
/* Invalidate the current stack level register setting. This will cause
* us to reset the LSP when the next stack level reference is encountered.
*/
void pas_InvalidateCurrentStackLevel(void)
{
g_currentStackLevelReference = UNDEFINED_LEVEL;
g_nStackLevelReferenceChanges++;
}
/***********************************************************************/
/* Set the stack level pointer to known value. This is done when in
* while and for loop processing. The value of the LSP will be that
* as sampled at the top of the lop not necessarily the value at the
* bottom of the loop.
*/
void pas_SetCurrentStackLevel(int32_t dwLsp)
{
g_currentStackLevelReference = dwLsp;
g_nStackLevelReferenceChanges++;
}
/***********************************************************************/
/* Get the number of changes made to the level stack pointer. This is
* useful by compiler logic to determine if the stack level pointer was
* ever changed by any logic path.
*/
uint32_t pas_GetNStackLevelChanges(void)
{
return g_nStackLevelReferenceChanges;
}
/***********************************************************************/
/* Generate the most simple of all P-codes */
void pas_GenerateSimple(enum pcode_e eOpCode)
{
insn_GenerateSimple(eOpCode);
}
/***********************************************************************/
/* Generate a P-code with a single data argument */
void pas_GenerateDataOperation(enum pcode_e eOpCode, int32_t dwData)
{
insn_GenerateDataOperation(eOpCode, dwData);
}
/***********************************************************************/
/* This function is called just before a multiple register operation is
* is generated. This should generate logic to specify the size of the
* multiple register operation (in bytes, not registers). This may translate
* into different operations on different architectures. Typically,
* this would generate a push of the size onto the stack or, perhaps,
* setting of a dedicated count register.
*/
void pas_GenerateDataSize(int32_t dwDataSize)
{
insn_GenerateDataSize(dwDataSize);
}
/***********************************************************************/
/* Generate a floating point operation */
void pas_GenerateFpOperation(uint8_t fpOpcode)
{
insn_GenerateFpOperation(fpOpcode);
}
/***********************************************************************/
/* Generate an IO operation */
void pas_GenerateIoOperation(uint16_t ioOpcode, uint16_t fileNumber)
{
insn_GenerateIoOperation(ioOpcode, fileNumber);
}
/***********************************************************************/
/* Generate a pseudo call to a built-in, standard pascal function */
void pas_BuiltInFunctionCall(uint16_t libOpcode)
{
insn_BuiltInFunctionCall(libOpcode);
}
/***********************************************************************/
/* Generate a reference to data on the data stack using the specified
* level and offset.
*/
void pas_GenerateLevelReference(enum pcode_e eOpCode, uint16_t wLevel,
int32_t dwOffset)
{
/* Is this variable declared at level 0 (i.e., it has global scope)
* that is being offset via a nesting level?
*/
if (wLevel == 0)
{
int32_t level0Opcode = pas_GetLevel0Opcode(eOpCode);
if (PCODE_VALID(level0Opcode))
{
insn_GenerateDataOperation(level0Opcode, dwOffset);
return;
}
}
/* We get here if the reference is at some static nesting level
* other that zero OR if there is no special PCode to reference
* data at static nesting level 0 for this operation.
*
* Check if we have to change the level stack pointer (LSP) register
* (assuming that the architecture has one).
*/
pas_SetLevelStackPointer(wLevel);
/* Then generate the opcode passing the level in the event that the
* architecture does not have an LSP.
*/
insn_GenerateLevelReference(eOpCode, wLevel, dwOffset);
}
/***********************************************************************/
/* Generate a stack reference opcode, handling references to undefined
* stack offsets.
*/
void pas_GenerateStackReference(enum pcode_e eOpCode, STYPE *pVar)
{
/* Is this variable declared at level 0 (i.e., it has global scope)
* that is being offset via a nesting level?
*/
if (pVar->sLevel == 0)
{
int32_t level0Opcode = pas_GetLevel0Opcode(eOpCode);
if (PCODE_VALID(level0Opcode))
{
pas_GenerateLevel0StackReference(level0Opcode, pVar);
return;
}
}
/* We get here if the reference is at some static nesting level
* other that zero OR if there is no special PCode to reference
* data at static nesting level 0 for this operation.
*
* Check if we have to change the level stack pointer (LSP) register
* (assuming that the architecture has one).
*/
pas_SetLevelStackPointer(pVar->sLevel);
/* Generate the P-Code at the defined offset and with the specified
* static level offset (in case that the architecture does not have
* an LSP)
*/
insn_GenerateLevelReference(eOpCode, (level - pVar->sLevel),
pVar->sParm.v.offset);
}
/***********************************************************************/
/* Generate a procedure call and an associated relocation record if the
* called procedure is external.
*/
void
pas_GenerateProcedureCall(STYPE *pProc)
{
/* sLevel is the level at which the procedure was declared. We need
* to set the SLP to this value prior to the call (on some architectures
* where the SLP is pushed onto the stack by the procedure
* call).
*/
pas_SetLevelStackPointer(pProc->sLevel);
/* Then generate the procedure call (passing the level again for those
* architectures that do not support the SLP.
*/
insn_GenerateProcedureCall(pProc->sLevel, pProc->sParm.p.label);
/* If the variable is undefined, also generate a relocation
* record.
*/
#if 0 /* Not yet */
if ((pVar->sParm.p.flags & SVAR_EXTERNAL) != 0)
{
/* For now */
# error "Don't know what last parameter should be"
(void)poffAddRelocation(poffHandle, RLT_PCAL,
pVar->sParm.p.symIndex,
0);
}
#endif
/* Any logic after the procedure/function call return must assume
* that the last level reference is unknown.
*/
pas_InvalidateCurrentStackLevel();
}
/***********************************************************************/
void pas_GenerateLineNumber(uint16_t wIncludeNumber, uint32_t dwLineNumber)
{
insn_GenerateLineNumber(wIncludeNumber, dwLineNumber);
}
/***********************************************************************/
void pas_GenerateDebugInfo(STYPE *pProc, uint32_t dwReturnSize)
{
int i;
/* Allocate a container to pass the proc information to the library */
uint32_t nparms = pProc->sParm.p.nParms;
poffLibDebugFuncInfo_t *pContainer = poffCreateDebugInfoContainer(nparms);
/* Put the proc information into the container */
pContainer->value = pProc->sParm.p.label;
pContainer->retsize = dwReturnSize;
pContainer->nparms = nparms;
/* Add the argument information to the container */
for (i = 0; i < nparms; i++)
{
pContainer->argsize[i] = actualParameterSize(pProc, i+1);
}
/* Add the contained information to the library */
poffAddDebugFuncInfo(poffHandle, pContainer);
/* Release the container */
poffReleaseDebugFuncContainer(pContainer);
}
/***********************************************************************/
/* Generate description of a level 0 stack variable that can be
* exported by a unit.
*/
void pas_GenerateStackExport(STYPE *pVar)
{
poffLibSymbol_t symbol;
#if CONFIG_DEBUG
/* Get the parent type of the variable */
STYPE *typePtr = pVar->sParm.v.parent;
/* Perform some sanity checking:
* - Must have a parent type
* - Must not be declared external
* - Must be declared at static nesting level zero
*/
if ((!typePtr) ||
((pVar->sParm.v.flags & SVAR_EXTERNAL) != 0) ||
(pVar->sLevel != 0))
{
error(eSYMTABINTERNAL);
}
#endif
/* Create the symbol structure */
symbol.type = STT_DATA;
symbol.align = STA_8BIT; /* for now */
symbol.flags = STF_NONE;
symbol.name = pVar->sName;
symbol.value = pVar->sParm.v.offset;
symbol.size = pVar->sParm.v.size;
/* Add the symbol to the symbol table */
(void)poffAddSymbol(poffHandle, &symbol);
}
/***********************************************************************/
/* Generate description of a level 0 stack variable that must be
* imported by a program or unit from a unit.
*/
void pas_GenerateStackImport(STYPE *pVar)
{
poffLibSymbol_t symbol;
#if CONFIG_DEBUG
/* Get the parent type of the variable */
STYPE *typePtr = pVar->sParm.v.parent;
/* Perform some sanity checking
* - Must have a parent type
* - Must be declared external
* - Must be declared at static nesting level zero
*/
if ((!typePtr) ||
((pVar->sParm.v.flags & SVAR_EXTERNAL) == 0) ||
(pVar->sLevel != 0))
{
error(eSYMTABINTERNAL);
}
#endif
/* Create the symbol structure */
symbol.type = STT_DATA;
symbol.align = STA_8BIT; /* for now */
symbol.flags = STF_UNDEFINED;
symbol.name = pVar->sName;
symbol.value = pVar->sParm.v.offset; /* for now */
symbol.size = pVar->sParm.v.size;
/* Add the symbol to the symbol table */
pVar->sParm.v.symIndex = poffAddSymbol(poffHandle, &symbol);
}
/***********************************************************************/
/* Generate description of a level 0 procedure or function that can be
* exported by a unit.
*/
void pas_GenerateProcExport(STYPE *pProc)
{
poffLibSymbol_t symbol;
#if CONFIG_DEBUG
/* Get the parent type of the function (assuming it is a function) */
STYPE *typePtr = pProc->sParm.p.parent;
/* Perform some sanity checking */
/* Check for a function reference which must have a valid parent type */
if ((pProc->sKind == sFUNC) && (typePtr != NULL));
/* Check for a procedure reference which must not have a valid type */
else if ((pProc->sKind == sPROC) && (typePtr == NULL));
/* Anything else is an error */
else
error(eSYMTABINTERNAL);
/* The function / procedure should NOT be declared external and
* only procedures declared at static nesting level zero can
* be exported.
*/
if (((pProc->sParm.p.flags & SPROC_EXTERNAL) != 0) ||
(pProc->sLevel != 0))
error(eSYMTABINTERNAL);
#endif
/* Everthing looks okay. Create the symbol structure */
if (pProc->sKind == sPROC)
symbol.type = STT_PROC;
else
symbol.type = STT_FUNC;
symbol.align = STA_NONE;
symbol.flags = STF_NONE;
symbol.name = pProc->sName;
symbol.value = pProc->sParm.p.label;
symbol.size = 0;
/* Add the symbol to the symbol table */
(void)poffAddSymbol(poffHandle, &symbol);
}
/***********************************************************************/
/* Generate description of a level 0 procedure or function that must be
* imported by a program or unit from a unit.
*/
void pas_GenerateProcImport(STYPE *pProc)
{
poffLibSymbol_t symbol;
#if CONFIG_DEBUG
/* Get the parent type of the function (assuming it is a function) */
STYPE *typePtr = pProc->sParm.p.parent;
/* Perform some sanity checking */
/* Check for a function reference which must have a valid parent type */
if ((pProc->sKind == sFUNC) && (typePtr != NULL));
/* Check for a procedure reference which must not have a valid type */
else if ((pProc->sKind == sPROC) && (typePtr == NULL));
/* Anything else is an error */
else
error(eSYMTABINTERNAL);
/* The function / procedure should also be declared external and
* only procedures declared at static nesting level zero can
* be exported.
*/
if (((pProc->sParm.p.flags & SPROC_EXTERNAL) == 0) ||
(pProc->sLevel != 0))
error(eSYMTABINTERNAL);
#endif
/* Everthing looks okay. Create the symbol structure */
if (pProc->sKind == sPROC)
symbol.type = STT_PROC;
else
symbol.type = STT_FUNC;
symbol.align = STA_NONE;
symbol.flags = STF_UNDEFINED;
symbol.name = pProc->sName;
symbol.value = pProc->sParm.p.label;
symbol.size = 0;
/* Add the symbol to the symbol table */
pProc->sParm.p.symIndex = poffAddSymbol(poffHandle, &symbol);
}
misc/pascal/pascal/pgen.h
+89
View File
@@ -0,0 +1,89 @@
/***************************************************************************
* pgen.h
* External Declarations associated with pgen.c
*
* 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.
*
***************************************************************************/
#ifndef __PGEN_H
#define __PGEN_H
/***************************************************************************
* Included Files
***************************************************************************/
#include <stdint.h>
#include "podefs.h"
/***************************************************************************
* Pre-processor Definitions
***************************************************************************/
/***************************************************************************
* Global Types
***************************************************************************/
/***************************************************************************
* Global Variable Prototypes
***************************************************************************/
/***************************************************************************
* Global Function Prototypes
***************************************************************************/
extern int32_t pas_GetCurrentStackLevel(void);
extern void pas_InvalidateCurrentStackLevel(void);
extern void pas_SetCurrentStackLevel(int32_t dwLsp);
extern uint32_t pas_GetNStackLevelChanges(void);
extern void pas_GenerateSimple(enum pcode_e eOpCode);
extern void pas_GenerateDataOperation(enum pcode_e eOpCode, int32_t dwData);
extern void pas_GenerateDataSize(int32_t dwDataSize);
extern void pas_GenerateFpOperation(uint8_t fpOpcode);
extern void pas_GenerateIoOperation(uint16_t ioOpcode, uint16_t fileNumber);
extern void pas_BuiltInFunctionCall(uint16_t libOpcode);
extern void pas_GenerateLevelReference(enum pcode_e eOpCode, uint16_t wLevel,
int32_t dwOffset);
extern void pas_GenerateStackReference(enum pcode_e eOpCode, STYPE *pVarPtr);
extern void pas_GenerateProcedureCall(STYPE *pProcPtr);
extern void pas_GenerateLineNumber(uint16_t wIncludeNumber,
uint32_t dwLineNumber);
extern void pas_GenerateStackExport(STYPE *pVarPtr);
extern void pas_GenerateStackImport(STYPE *pVarPtr);
extern void pas_GenerateProcedureCall(STYPE *pProcPtr);
extern void pas_GenerateDebugInfo(STYPE *pProcPtr, uint32_t dwReturnSize);
extern void pas_GenerateProcExport(STYPE *pProcPtr);
extern void pas_GenerateProcImport(STYPE *pProcPtr);
extern void pas_GeneratePoffOutput(void);
#endif /* __PGEN_H */
misc/pascal/pascal/pprgm.c
+265
View File
@@ -0,0 +1,265 @@
/**********************************************************************
* pas.c
* main - process PROGRAM
*
* 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 + openNestedFile */
#include "pblck.h" /* for block() */
#include "pgen.h" /* for pas_Generate*() */
#include "ptkn.h" /* for getToken() */
#include "ptbl.h" /* for addFile() */
#include "pofflib.h" /* For poff*() functions*/
#include "paslib.h" /* for extension() */
#include "perr.h" /* for error() */
#include "punit.h" /* for unit() */
#include "pprgm.h"
/**********************************************************************
* Pre-processor Definitions
**********************************************************************/
/**********************************************************************
* Global Variables
**********************************************************************/
/**********************************************************************
* Private Variables
**********************************************************************/
/***********************************************************************
* Private Function Prototypes
***********************************************************************/
/***********************************************************************
* Private Functions
***********************************************************************/
/***********************************************************************
* Public Functions
***********************************************************************/
void program(void)
{
char *pgmname = NULL;
TRACE(lstFile, "[program]");
/* FORM: program = program-heading ';' [uses-section ] block '.'
* FORM: program-heading = 'program' identifier [ '(' identifier-list ')' ]
*
* On entry, 'program' has already been identified and token refers to
* the next token after 'program'
*/
if (token != tIDENT) error(eIDENT); /* Verify <program name> */
else
{
pgmname = tkn_strt; /* Save program name */
getToken();
} /* end else */
/* Process optional file list (allow re-declaration of INPUT & OUTPUT) */
if (token == '(')
{
do
{
getToken();
if (token == tIDENT)
{
if ((++nfiles) > MAX_FILES) fatal(eOVF);
(void)addFile(tkn_strt, nfiles);
stringSP = tkn_strt;
getToken();
} /* end if */
else if ((token == sFILE) && !(tknPtr->sParm.fileNumber))
getToken();
else
error(eIDENT);
}
while (token == ',');
if (token != ')') error(eRPAREN);
else getToken();
} /* End if */
/* Make sure that a semicolon follows the program-heading */
if (token != ';') error(eSEMICOLON);
else getToken();
/* Set the POFF file header type */
poffSetFileType(poffHandle, FHT_PROGRAM, nfiles, pgmname);
poffSetArchitecture(poffHandle, FHA_PCODE);
/* Discard the program name string */
stringSP = pgmname;
/* Process the optional 'uses-section'
* FORM: uses-section = 'uses' [ uses-unit-list ] ';'
*/
if (token == tUSES)
{
getToken();
usesSection();
}
/* Process the block */
block();
if (token != '.') error(ePERIOD);
pas_GenerateSimple(opEND);
} /* end program */
/***********************************************************************/
void usesSection(void)
{
uint16_t saveToken;
char defaultUnitFileName[FNAME_SIZE + 1];
char *unitFileName = NULL;
char *saveTknStrt;
char *unitName;
TRACE(lstFile, "[usesSection]");
/* FORM: uses-section = 'uses' [ uses-unit-list ] ';'
* FORM: uses-unit-list = unit-import {';' uses-unit-list }
* FORM: unit-import = identifier ['in' non-empty-string ]
*
* On entry, token will point to the token just after
* the 'uses' reservers word.
*/
while (token == tIDENT)
{
/* Save the unit name identifier and skip over the identifier */
unitName = tkn_strt;
getToken();
/* Check for the optional 'in' */
saveTknStrt = tkn_strt;
if (token == tIN)
{
/* Skip over 'in' and verify that a string constant representing
* the file name follows.
*/
getToken();
if (token != tSTRING_CONST) error(eSTRING);
else
{
/* Save the unit file name and skip to the
* next token.
*/
unitFileName = tkn_strt;
saveTknStrt = tkn_strt;
getToken();
}
}
/* In any event, make sure that we have a non-NULL unit
* file name.
*/
if (!unitFileName)
{
/* Create a default filename */
(void)extension(unitName, ".pas", defaultUnitFileName, 1);
unitFileName = defaultUnitFileName;
}
/* Open the unit file */
saveToken = token;
openNestedFile(unitFileName);
FP->kind = eIsUnit;
FP->section = eIsOtherSection;
/* Verify that this is a unit file */
if (token != tUNIT) error(eUNIT);
else getToken();
/* Release the file name from the string stack */
stringSP = saveTknStrt;
/* Verify that the file provides the unit that we are looking
* for (only one unit per file is supported)
*/
if (token != tIDENT) error(eIDENT);
else if (strcmp(unitName, tkn_strt) != 0) error(eUNITNAME);
/* Parse the interface from the unit file (token must refer
* to the unit name on entry into unit().
*/
unitInterface();
closeNestedFile();
/* Verify the terminating semicolon */
token = saveToken;
if (token != ';') error(eSEMICOLON);
else getToken();
}
}
/***********************************************************************/
misc/pascal/pascal/pprgm.h
+47
View File
@@ -0,0 +1,47 @@
/***************************************************************************
* pprgm.h
* External Declarations associated with pprgm.c
*
* Copyright (C) 2008 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.
*
***************************************************************************/
#ifndef __PPRGM_H
#define __PPRGM_H
/***************************************************************************
* Global Function Prototypes
***************************************************************************/
extern void program(void);
extern void usesSection(void);
#endif /* __PPRGM_H */
misc/pascal/pascal/pproc.c
+736
View File
@@ -0,0 +1,736 @@
/****************************************************************************
* pproc.c
* Standard procedures (all called in pstm.c)
*
* 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 <stdbool.h>
#include <stdio.h>
#include <string.h>
#include "keywords.h"
#include "pasdefs.h"
#include "ptdefs.h"
#include "podefs.h"
#include "pedefs.h"
#include "pxdefs.h"
#include "pas.h"
#include "pexpr.h"
#include "pproc.h"
#include "pgen.h" /* for pas_Generate*() */
#include "ptkn.h"
#include "ptbl.h" /* For parent symbol references */
#include "perr.h"
/****************************************************************************
* Private Function Prototypes
****************************************************************************/
/* Helpers for standard procedures */
static int16_t readProc (void); /* READ procedure */
static void readText (uint16_t fileNumber); /* READ text file */
static void readlnProc (void); /* READLN procedure */
static void fileProc (uint16_t opcode); /* RESET/REWRITE/PAGE procedure */
static int16_t writeProc (void); /* WRITE procedure */
static void writeText (uint16_t fileNumber); /* WRITE text file */
static void writelnProc (void); /* WRITELN procedure */
/* Helpers for less-than-standard procedures */
static void valProc (void); /* VAL procedure */
/****************************************************************************
* Private Data
****************************************************************************/
/* procedure val(const S : string; var V; var Code : word); */
static STYPE valSymbol[4];
/****************************************************************************/
void primeBuiltInProcedures(void)
{
/* procedure val(const S : string; var V; var Code : word); */
valSymbol[0].sParm.p.nParms = 3;
valSymbol[1].sKind = sSTRING;
valSymbol[1].sParm.p.parent = parentString;
valSymbol[2].sKind = sVAR_PARM;
valSymbol[2].sParm.p.parent = parentInteger;
valSymbol[3].sKind = sVAR_PARM;
valSymbol[3].sParm.p.parent = parentInteger;
}
/***********************************************************************/
void builtInProcedure(void)
{
TRACE(lstFile, "[builtInProcedure]");
/* Is the token a procedure? */
if (token == tPROC)
{
/* Yes, process it procedure according to the extended token type */
switch (tknSubType)
{
/* Standard Procedures & Functions */
case txPAGE :
fileProc(xWRITE_PAGE);
break;
case txREAD :
getToken();
(void)readProc();
break;
case txREADLN :
readlnProc();
break;
case txRESET :
fileProc(xRESET);
break;
case txREWRITE :
fileProc(xREWRITE);
break;
case txWRITE :
getToken();
(void)writeProc();
break;
case txWRITELN :
writelnProc();
break;
case txGET :
case txNEW :
case txPACK :
case txPUT :
case txUNPACK :
error(eNOTYET);
getToken();
break;
/* less-than-standard procedures */
case txVAL :
valProc();
break;
/* Its not a recognized procedure */
default :
error(eINVALIDPROC);
break;
} /* end switch */
} /* end if */
} /* end builtInProcedure */
/***********************************************************************/
int actualParameterSize(STYPE *procPtr, int parmNo)
{
/* These sizes must agree with the sizes used in actualParameterListg()
* below.
*/
STYPE *typePtr = procPtr[parmNo].sParm.v.parent;
switch (typePtr->sKind)
{
case sINT :
case sSUBRANGE :
case sSCALAR :
case sSET_OF :
default:
return sINT_SIZE;
break;
case sCHAR :
return sCHAR_SIZE;
break;
case sREAL :
return sREAL_SIZE;
break;
case sSTRING :
case sRSTRING :
return sRSTRING_SIZE;
break;
case sARRAY :
case sRECORD :
return typePtr->sParm.t.asize;
break;
case sVAR_PARM :
return sPTR_SIZE;
break;
}
}
/***********************************************************************/
int actualParameterList(STYPE *procPtr)
{
STYPE *typePtr;
register int nParms = 0;
int size = 0;
TRACE(lstFile,"[actualParameterList]");
/* Processes the (optional) actual-parameter-list associated with
* a function or procedure call:
*
* FORM: procedure-method-statement =
* procedure-method-specifier [ actual-parameter-list ]
* FORM: function-designator = function-identifier [ actual-parameter-list ]
*
*
* On entry, 'token' refers to the token just AFTER the procedure
* function identifier.
*
* FORM: actual-parameter-list =
* '(' actual-parameter { ',' actual-parameter } ')'
* FORM: actual-parameter =
* expression | variable-access |
* procedure-identifier | function-identifier
*/
/* If this procedure requires parameters, get them and make sure that
* they match in type and number
*/
if (procPtr->sParm.p.nParms)
{
/* If it requires parameters, then the actual-parameter-list must
* be present and must begin with '('
*/
if (token != '(') error (eLPAREN);
else getToken();
/* Loop to process the expected number of parameters. The formal
* argument descriptions follow the procedure/function description
* as an array of variable declarations. (These sizes below must
* agree with actualParameterSize() above);
*/
for (nParms = 1; nParms <= procPtr->sParm.p.nParms; nParms++)
{
typePtr = procPtr[nParms].sParm.v.parent;
switch (procPtr[nParms].sKind)
{
case sINT :
expression(exprInteger, typePtr);
size += sINT_SIZE;
break;
case sCHAR :
expression(exprChar, typePtr);
size += sCHAR_SIZE;
break;
case sREAL :
expression(exprReal, typePtr);
size += sREAL_SIZE;
break;
case sSTRING :
case sRSTRING :
expression(exprString, typePtr);
size += sRSTRING_SIZE;
break;
case sSUBRANGE :
expression(exprInteger, typePtr);
size += sINT_SIZE;
break;
case sSCALAR :
expression(exprScalar, typePtr);
size += sINT_SIZE;
break;
case sSET_OF :
expression(exprSet, typePtr);
size += sINT_SIZE;
break;
case sARRAY :
expression(exprArray, typePtr);
size += typePtr->sParm.t.asize;
break;
case sRECORD :
expression(exprRecord, typePtr);
size += typePtr->sParm.t.asize;
break;
case sVAR_PARM :
if (typePtr)
{
switch (typePtr->sParm.t.type)
{
case sINT :
varParm(exprIntegerPtr, typePtr);
size += sPTR_SIZE;
break;
case sBOOLEAN :
varParm(exprBooleanPtr, typePtr);
size += sPTR_SIZE;
break;
case sCHAR :
varParm(exprCharPtr, typePtr);
size += sPTR_SIZE;
break;
case sREAL :
varParm(exprRealPtr, typePtr);
size += sPTR_SIZE;
break;
case sARRAY :
varParm(exprArrayPtr, typePtr);
size += sPTR_SIZE;
break;
case sRECORD :
varParm(exprRecordPtr, typePtr);
size += sPTR_SIZE;
break;
default :
error(eVARPARMTYPE);
break;
} /* end switch */
} /* end if */
else
error(eVARPARMTYPE);
break;
default :
error (eNPARMS);
} /* end switch */
if (nParms < procPtr->sParm.p.nParms)
{
if (token != ',') error (eCOMMA);
else getToken();
} /* end if */
} /* end for */
if (token != ')') error (eRPAREN);
else getToken();
} /* end if */
return size;
} /* end actualParameterList */
/***********************************************************************/
static int16_t readProc(void)
{
uint16_t fileNumber = 0;
TRACE(lstFile, "[readProc]");
/* FORM:
* (1) Binary READ: read '(' file-variable ')'
* (2) Test READ: read read-parameter-list
* FORM: read-parameter-list =
* '(' [ file-variable ',' ] variable-access { ',' variable-access } ')'
*/
if (token != '(') error (eLPAREN); /* Skip over '(' */
else getToken();
/* Get file number */
if (token == sFILE)
{
fileNumber = tknPtr->sParm.fileNumber;
getToken();
} /* end if */
if (token == ',') getToken();
/* Determine if this is a text or binary file */
if (!(files [fileNumber].defined)) error (eUNDEFILE);
else if (files [fileNumber].ftype == sCHAR)
{
readText (fileNumber);
}
else
{
pas_GenerateLevelReference(opLAS, files[fileNumber].flevel, files [fileNumber].faddr);
pas_GenerateDataOperation(opPUSH, files[fileNumber].fsize);
pas_GenerateIoOperation(xREAD_BINARY, fileNumber);
} /* end else */
if (token != ')') error (eRPAREN);
else getToken();
return (fileNumber);
} /* end readProc */
/***********************************************************************/
static void readText (uint16_t fileNumber)
{
STYPE *rPtr;
TRACE(lstFile, "[readText]");
/* The general form is <VAR parm>, <VAR parm>,... */
for (;;)
{
switch (token)
{
/* SPECIAL CASE: Array of type CHAR without indexing */
case sARRAY :
rPtr = tknPtr->sParm.v.parent;
if (((rPtr) && (rPtr->sKind == sTYPE)) &&
(rPtr->sParm.t.type == sCHAR) &&
(getNextCharacter(true) != '['))
{
pas_GenerateStackReference(opLAS, rPtr);
pas_GenerateDataOperation(opPUSH, rPtr->sParm.v.size);
pas_GenerateIoOperation(xREAD_STRING, fileNumber);
pas_GenerateDataOperation(opINDS, -(sPTR_SIZE+sINT_SIZE));
} /* end if */
/* Otherwise, we fall through to process the ARRAY like any */
/* expression */
default :
switch (varParm(exprUnknown, NULL))
{
case exprIntegerPtr :
pas_GenerateIoOperation(xREAD_INT, fileNumber);
pas_GenerateDataOperation(opINDS, -sPTR_SIZE);
break;
case exprCharPtr :
pas_GenerateIoOperation(xREAD_CHAR, fileNumber);
pas_GenerateDataOperation(opINDS, -sPTR_SIZE);
break;
case exprRealPtr :
pas_GenerateIoOperation(xREAD_REAL, fileNumber);
pas_GenerateDataOperation(opINDS, -sPTR_SIZE);
break;
default :
error(eINVARG);
break;
} /* end switch */
break;
} /* end switch */
if (token == ',') getToken();
else return;
} /* end for */
} /* end readText */
/****************************************************************************/
static void readlnProc(void) /* READLN procedure */
{
int32_t fileNumber;
TRACE(lstFile, "[readlnProc]");
/* FORM: Just like READ */
getToken();
if (token == '(')
fileNumber = readProc();
/* skip to end-of-line mark in the file (NOTE: No check is made,
* but this is meaningful only for a test file).
*/
pas_GenerateIoOperation(xREADLN, fileNumber);
} /* end readlnProc */
/****************************************************************************/
/* REWRITE/RESET/PAGE procedure call -- REWRITE sets the file pointer to the
* beginning of the file and prepares the file for write access; RESET is
* similar except that it prepares the file for read access; PAGE simply
* writes a form-feed to the file (no check is made, but is meaningful only
* for a text file). */
static void fileProc (uint16_t opcode)
{
TRACE(lstFile, "[fileProc]");
/* FORM: RESET|REWRITE(<file number>) */
getToken();
if (token != '(') error(eLPAREN);
else getToken();
if (token != sFILE) error(eFILE);
else {
pas_GenerateIoOperation(opcode, tknPtr->sParm.fileNumber);
getToken();
if (token != ')') error(eRPAREN);
else getToken();
} /* end else */
} /* End fileProc */
/***********************************************************************/
static int16_t writeProc(void)
{
uint16_t fileNumber = 0;
TRACE(lstFile, "[writeProc]");
/* FORM: (1) Binary WRITE: WRITE(<fileNumber>);
* (2) Test WRITE: WRITE([<fileNumber>], arg1 [,arg2 [...]]) */
if (token != '(') error(eLPAREN); /* Skip over '(' */
else getToken();
/* Get file number */
if (token == sFILE) {
fileNumber = tknPtr->sParm.fileNumber;
getToken();
} /* end if */
if (token == ',') getToken();
/* Determine if this is a text or binary file */
if (!(files [fileNumber].defined)) error(eUNDEFILE);
else if (files [fileNumber].ftype == sCHAR)
writeText(fileNumber);
else {
pas_GenerateLevelReference(opLAS, files[fileNumber].flevel, files [fileNumber].faddr);
pas_GenerateDataOperation(opPUSH, files[fileNumber].fsize);
pas_GenerateIoOperation(xWRITE_BINARY, fileNumber);
} /* end else */
if (token != ')') error(eRPAREN);
else getToken();
return(fileNumber);
} /* end writeProc */
/***********************************************************************/
static void writeText (uint16_t fileNumber)
{
exprType writeType;
STYPE *wPtr;
TRACE(lstFile, "[writeText]");
for (;;)
{
/* The general form is <expression>, <expression>, ... However,
* there are a few unique things that must be handled as special
* cases
*/
switch (token)
{
/* const strings -- either literal constants (tSTRING_CONST)
* or defined string constant symbols (sSTRING_CONST)
*/
case tSTRING_CONST :
{
/* Add the literal string constant to the RO data section
* and receive the offset to the data.
*/
uint32_t offset = poffAddRoDataString(poffHandle, tkn_strt);
/* Set the offset and size on the stack (order is important) */
pas_GenerateDataOperation(opLAC, (uint16_t)offset);
pas_GenerateDataOperation(opPUSH, strlen(tkn_strt));
pas_GenerateIoOperation(xWRITE_STRING, fileNumber);
pas_GenerateDataOperation(opINDS, -(sPTR_SIZE + sINT_SIZE));
stringSP = tkn_strt;
getToken();
}
break;
case sSTRING_CONST :
pas_GenerateDataOperation(opLAC, (uint16_t)tknPtr->sParm.s.offset);
pas_GenerateDataOperation(opPUSH, (uint16_t)tknPtr->sParm.s.size);
pas_GenerateIoOperation(xWRITE_STRING, fileNumber);
pas_GenerateDataOperation(opINDS, -(sPTR_SIZE + sINT_SIZE));
getToken();
break;
/* Array of type CHAR without indexing */
case sARRAY :
wPtr = tknPtr->sParm.v.parent;
if (((wPtr) && (wPtr->sKind == sTYPE)) &&
(wPtr->sParm.t.type == sCHAR) &&
(getNextCharacter(true) != '['))
{
pas_GenerateStackReference(opLAS, wPtr);
pas_GenerateDataOperation(opPUSH, wPtr->sParm.v.size);
pas_GenerateIoOperation(xWRITE_STRING, fileNumber);
pas_GenerateDataOperation(opINDS, -(sPTR_SIZE + sINT_SIZE));
break;
} /* end if */
/* Otherwise, we fall through to process the ARRAY like any */
/* expression */
default :
writeType = expression(exprUnknown, NULL);
switch (writeType)
{
case exprInteger :
pas_GenerateIoOperation(xWRITE_INT, fileNumber);
pas_GenerateDataOperation(opINDS, -sINT_SIZE);
break;
case exprBoolean :
error(eNOTYET);
break;
case exprChar :
pas_GenerateIoOperation(xWRITE_CHAR, fileNumber);
pas_GenerateDataOperation(opINDS, -sINT_SIZE);
break;
case exprReal :
pas_GenerateIoOperation(xWRITE_REAL, fileNumber);
pas_GenerateDataOperation(opINDS, -sREAL_SIZE);
break;
case exprString :
case exprStkString :
pas_GenerateIoOperation(xWRITE_STRING, fileNumber);
pas_GenerateDataOperation(opINDS, -sRSTRING_SIZE);
break;
default :
error(eWRITEPARM);
break;
} /* end switch */
break;
} /* end switch */
if (token == ',') getToken();
else return;
} /* end for */
} /* end writeText */
/****************************************************************************/
static void writelnProc(void) /* WRITELN procedure */
{
int32_t fileNumber = 0;
TRACE(lstFile, "[writelnProc]");
/* FORM: Just like WRITE */
getToken();
if (token == '(')
{
fileNumber = writeProc();
}
/* Skip to past end-of-line mark in the file (NOTE: No check is made, but
* this is meaningful only for a test file).
*/
pas_GenerateIoOperation(xWRITELN, fileNumber);
} /* end writelnProc */
/****************************************************************************/
static void valProc(void) /* VAL procedure */
{
int size;
TRACE(lstFile, "[valProc]");
/* Declaration:
* procedure val(const S : string; var V; var Code : word);
*
* Description:
* val() converts the value represented in the string S to a numerical
* value, and stores this value in the variable V, which can be of type
* Longint, Real and Byte. If the conversion isn��t succesfull, then the
* parameter Code contains the index of the character in S which
* prevented the conversion. The string S is allowed to contain spaces
* in the beginning.
*
* The string S can contain a number in decimal, hexadecimal, binary or
* octal format, as described in the language reference.
*
* Errors:
* If the conversion doesn��t succeed, the value of Code indicates the
* position where the conversion went wrong.
*/
/* Skip over the 'val' identifer */
getToken();
/* Setup the actual-parameter-list */
size = actualParameterList(valSymbol);
/* Generate the built-in procedure call. NOTE the procedure call
* logic will release the parameters from the stack saving us from
* having to generate the INDS here.
*/
pas_BuiltInFunctionCall(lbVAL);
} /* end writelnProc */
/***********************************************************************/
misc/pascal/pascal/pproc.h
+49
View File
@@ -0,0 +1,49 @@
/***************************************************************************
* pproc.h
* External Declarations associated with PPROC.C
*
* Copyright (C) 2008 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.
*
***************************************************************************/
#ifndef __PPROC_H
#define __PPROC_H
/***************************************************************************
* Global Function Prototypes
***************************************************************************/
extern void primeBuiltInProcedures(void);
extern void builtInProcedure(void);
extern int actualParameterSize(STYPE *procPtr, int parmNo);
extern int actualParameterList(STYPE *procPtr);
#endif /* __PPROC_H */
misc/pascal/pascal/pstm.c
+1683
View File
File diff suppressed because it is too large Load Diff
misc/pascal/pascal/pstm.h
+47
View File
@@ -0,0 +1,47 @@
/***************************************************************************
* pstm.h
* External Declarations associated with pstm.c
*
* Copyright (C) 2008 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.
*
***************************************************************************/
#ifndef __PSTM_H
#define __PSTM_H
/***************************************************************************
* Global Function Prototypes
***************************************************************************/
extern void statement (void); /* Process Statement */
extern void compoundStatement (void); /* Compound statement */
#endif /* __PSTM_H */
misc/pascal/pascal/ptbl.c
+692
View File
@@ -0,0 +1,692 @@
/***************************************************************
* ptbl.c
* Table Management Package
*
* 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 <sys/types.h>
#include <stdbool.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include "config.h"
#include "keywords.h"
#include "pasdefs.h"
#include "ptdefs.h"
#include "pedefs.h"
#include "pas.h"
#include "ptbl.h"
#include "perr.h"
/***************************************************************
* Private Function Prototypes
***************************************************************/
static STYPE *addSymbol(char *name, int16_t type);
/***************************************************************
* Public Variables
***************************************************************/
STYPE *parentInteger = NULL;
STYPE *parentString = NULL;
/***************************************************************
* Private Variables
***************************************************************/
/* NOTES in the following:
* (1) Standard Pascal reserved word
* (2) Standard Pascal Function
* (3) Standard Pascal Procedure
* (4) Extended (or non-standard) Pascal reserved word
* (5) Extended (or non-standard) Pascal function
* (6) Extended (or non-standard) Pascal procedure
*/
static const RTYPE rsw[] = /* Reserved word list */
{
{"ABS", tFUNC, txABS}, /* (2) */
{"AND", tAND, txNONE}, /* (1) */
{"ARCTAN", tFUNC, txARCTAN}, /* (2) */
{"ARRAY", tARRAY, txNONE}, /* (1) */
{"BEGIN", tBEGIN, txNONE}, /* (1) */
{"CASE", tCASE, txNONE}, /* (1) */
{"CHR", tFUNC, txCHR}, /* (2) */
{"CONST", tCONST, txNONE}, /* (1) */
{"COS", tFUNC, txCOS}, /* (2) */
{"DIV", tDIV, txNONE}, /* (1) */
{"DO", tDO, txNONE}, /* (1) */
{"DOWNTO", tDOWNTO, txNONE}, /* (1) */
{"ELSE", tELSE, txNONE}, /* (1) */
{"END", tEND, txNONE}, /* (1) */
{"EOF", tFUNC, txEOF}, /* (2) */
{"EOLN", tFUNC, txEOLN}, /* (2) */
{"EXP", tFUNC, txEXP}, /* (2) */
{"FILE", tFILE, txNONE}, /* (1) */
{"FOR", tFOR, txNONE}, /* (1) */
{"FUNCTION", tFUNCTION, txNONE}, /* (1) */
{"GET", tPROC, txGET}, /* (3) */
{"GETENV", tFUNC, txGETENV}, /* (5) */
{"GOTO", tGOTO, txNONE}, /* (1) */
{"IF", tIF, txNONE}, /* (1) */
{"IMPLEMENTATION", tIMPLEMENTATION, txNONE}, /* (4) */
{"IN", tIN, txNONE}, /* (1) */
{"INTERFACE", tINTERFACE, txNONE}, /* (4) */
{"LABEL", tLABEL, txNONE}, /* (1) */
{"LN", tFUNC, txLN}, /* (2) */
{"MOD", tMOD, txNONE}, /* (1) */
{"NEW", tPROC, txNEW}, /* (3) */
{"NOT", tNOT, txNONE}, /* (1) */
{"ODD", tFUNC, txODD}, /* (2) */
{"OF", tOF, txNONE}, /* (1) */
{"OR", tOR, txNONE}, /* (1) */
{"ORD", tFUNC, txORD}, /* (2) */
{"PACK", tPROC, txPACK}, /* (3) */
{"PACKED", tPACKED, txNONE}, /* (1) */
{"PAGE", tPROC, txPAGE}, /* (3) */
{"PRED", tFUNC, txPRED}, /* (2) */
{"PROCEDURE", tPROCEDURE, txNONE}, /* (1) */
{"PROGRAM", tPROGRAM, txNONE}, /* (1) */
{"PUT", tPROC, txPUT}, /* (3) */
{"READ", tPROC, txREAD}, /* (3) */
{"READLN", tPROC, txREADLN}, /* (3) */
{"RECORD", tRECORD, txNONE}, /* (1) */
{"REPEAT", tREPEAT, txNONE}, /* (1) */
{"RESET", tPROC, txRESET}, /* (3) */
{"REWRITE", tPROC, txREWRITE}, /* (3) */
{"ROUND", tFUNC, txROUND}, /* (2) */
{"SET", tSET, txNONE}, /* (1) */
{"SHL", tSHL, txNONE}, /* (4) */
{"SHR", tSHR, txNONE}, /* (4) */
{"SIN", tFUNC, txSIN}, /* (2) */
{"SQR", tFUNC, txSQR}, /* (2) */
{"SQRT", tFUNC, txSQRT}, /* (2) */
{"SUCC", tFUNC, txSUCC}, /* (2) */
{"THEN", tTHEN, txNONE}, /* (1) */
{"TO", tTO, txNONE}, /* (1) */
{"TRUNC", tFUNC, txTRUNC}, /* (2) */
{"TYPE", tTYPE, txNONE}, /* (1) */
{"UNIT", tUNIT, txNONE}, /* (4) */
{"UNPACK", tPROC, txUNPACK}, /* (3) */
{"UNTIL", tUNTIL, txNONE}, /* (1) */
{"USES", tUSES, txNONE}, /* (4) */
{"VAL", tPROC, txVAL}, /* (6) */
{"VAR", tVAR, txNONE}, /* (1) */
{"WHILE", tWHILE, txNONE}, /* (1) */
{"WITH", tWITH, txNONE}, /* (1) */
{"WRITE", tPROC, txWRITE}, /* (3) */
{"WRITELN", tPROC, txWRITELN}, /* (3) */
{NULL, 0, txNONE} /* List terminator */
};
static STYPE *symbolTable; /* Symbol Table */
/**************************************************************/
const RTYPE *findReservedWord (char *name)
{
register const RTYPE *ptr; /* Point into reserved word list */
register int16_t cmp; /* 0=equal; >0=past it */
for (ptr = rsw; (ptr->rname); ptr++) /* Try each each reserved word */
{
cmp = strcmp(ptr->rname, name); /* Check if names match */
if (!cmp) /* Check if names match */
return ptr; /* Return pointer to entry if match */
else if (cmp > 0) /* Exit early if we are past it */
break;
} /* end for */
return (RTYPE*)NULL; /* return NULL pointer if no match */
} /* fnd findReservedWord */
/***************************************************************/
STYPE *findSymbol (char *inName)
{
register int16_t i; /* loop index */
for (i=nsym-1; i>=sym_strt; i--)
if (symbolTable[i].sName)
if (!strcmp(symbolTable[i].sName, inName))
return &symbolTable[i];
return (STYPE*)NULL;
} /* end findSymbol */
/***************************************************************/
static STYPE *addSymbol(char *name, int16_t type)
{
TRACE(lstFile,"[addSymbol]");
/* Check for Symbol Table overflow */
if (nsym >= MAX_SYM) {
fatal(eOVF);
return (STYPE *)NULL;
} /* end if */
else {
/* Clear all elements of the symbol table entry */
memset(&symbolTable[nsym], 0, sizeof(STYPE));
/* Set the elements which are independent of sKind */
symbolTable[nsym].sName = name;
symbolTable[nsym].sKind = type;
symbolTable[nsym].sLevel = level;
return &symbolTable[nsym++];
} /* end else */
} /* end addSymbol */
/***************************************************************/
STYPE *addTypeDefine(char *name, uint8_t type, uint16_t size, STYPE *parent)
{
STYPE *typePtr;
TRACE(lstFile,"[addTypeDefine]");
/* Get a slot in the symbol table */
typePtr = addSymbol(name, sTYPE);
if (typePtr)
{
/* Add the type definition to the symbol table
* NOTES:
* 1. The minValue and maxValue fields (for scalar and subrange)
* types must be set external to this function
* 2. For most variables, allocated size/type (rsize/rtype) and
* the clone size/type are the same. If this is not the case,
* external logic will need to clarify this as well.
* 3. We assume that there are no special flags associated with
* the type.
*/
typePtr->sParm.t.type = type;
typePtr->sParm.t.rtype = type;
typePtr->sParm.t.flags = 0;
typePtr->sParm.t.asize = size;
typePtr->sParm.t.rsize = size;
typePtr->sParm.t.parent = parent;
} /* end if */
/* Return a pointer to the new constant symbol */
return typePtr;
} /* end addTypeDefine */
/***************************************************************/
STYPE *addConstant(char *name, uint8_t type, int32_t *value, STYPE *parent)
{
STYPE *constPtr;
TRACE(lstFile,"[addConstant]");
/* Get a slot in the symbol table */
constPtr = addSymbol(name, type);
if (constPtr) {
/* Add the value of the constant to the symbol table */
if (type == tREAL_CONST)
constPtr->sParm.c.val.f = *((double*) value);
else
constPtr->sParm.c.val.i = *value;
constPtr->sParm.c.parent = parent;
} /* end if */
/* Return a pointer to the new constant symbol */
return constPtr;
} /* end addConstant */
/***************************************************************/
STYPE *addStringConst(char *name, uint32_t offset, uint32_t size)
{
STYPE *stringPtr;
TRACE(lstFile,"[addStringConst]");
/* Get a slot in the symbol table */
stringPtr = addSymbol(name, sSTRING_CONST);
if (stringPtr)
{
/* Add the value of the constant to the symbol table */
stringPtr->sParm.s.offset = offset;
stringPtr->sParm.s.size = size;
} /* end if */
/* Return a pointer to the new string symbol */
return stringPtr;
} /* end addString */
/***************************************************************/
STYPE *addFile(char *name, uint16_t fileNumber)
{
STYPE *filePtr;
TRACE(lstFile,"[addFile]");
/* Get a slot in the symbol table */
filePtr = addSymbol(name, sFILE);
if (filePtr) {
/* Add the fileNumber to the symbol table */
filePtr->sParm.fileNumber = fileNumber;
} /* end if */
/* Return a pointer to the new file symbol */
return filePtr;
} /* end addFile */
/***************************************************************/
STYPE *addProcedure(char *name, uint8_t type, uint16_t label,
uint16_t nParms, STYPE *parent)
{
STYPE *procPtr;
TRACE(lstFile,"[addProcedure]");
/* Get a slot in the symbol table */
procPtr = addSymbol(name, type);
if (procPtr)
{
/* Add the procedure/function definition to the symbol table */
procPtr->sParm.p.label = label;
procPtr->sParm.p.nParms = nParms;
procPtr->sParm.p.flags = 0;
procPtr->sParm.p.symIndex = 0;
procPtr->sParm.p.parent = parent;
} /* end if */
/* Return a pointer to the new procedure/function symbol */
return procPtr;
} /* end addProcedure */
/***************************************************************/
STYPE *addVariable(char *name, uint8_t type, uint16_t offset,
uint16_t size, STYPE *parent)
{
STYPE *varPtr;
TRACE(lstFile,"[addVariable]");
/* Get a slot in the symbol table */
varPtr = addSymbol(name, type);
if (varPtr)
{
/* Add the variable to the symbol table */
varPtr->sParm.v.offset = offset;
varPtr->sParm.v.size = size;
varPtr->sParm.v.flags = 0;
varPtr->sParm.v.symIndex = 0;
varPtr->sParm.v.parent = parent;
} /* end if */
/* Return a pointer to the new variable symbol */
return varPtr;
} /* end addFile */
/***************************************************************/
STYPE *addLabel(char *name, uint16_t label)
{
STYPE *labelPtr;
TRACE(lstFile,"[addLabel]");
/* Get a slot in the symbol table */
labelPtr = addSymbol(name, sLABEL);
if (labelPtr)
{
/* Add the label to the symbol table */
labelPtr->sParm.l.label = label;
labelPtr->sParm.l.unDefined = true;
} /* end if */
/* Return a pointer to the new label symbol */
return labelPtr;
} /* end addFile */
/***************************************************************/
STYPE *addField(char *name, STYPE *record)
{
STYPE *fieldPtr;
TRACE(lstFile,"[addField]");
/* Get a slot in the symbol table */
fieldPtr = addSymbol(name, sRECORD_OBJECT);
if (fieldPtr) {
/* Add the field to the symbol table */
fieldPtr->sParm.r.record = record;
} /* end if */
/* Return a pointer to the new variable symbol */
return fieldPtr;
} /* end addField */
/***************************************************************/
void primeSymbolTable(unsigned long symbolTableSize)
{
int32_t trueValue = -1;
int32_t falseValue = 0;
int32_t maxintValue = MAXINT;
STYPE *typePtr;
register int16_t i;
TRACE(lstFile,"[primeSymbolTable]");
/* Allocate and initialize symbol table */
symbolTable = malloc(symbolTableSize * sizeof(STYPE));
if (!symbolTable)
{
fatal(eNOMEMORY);
}
nsym = 0;
/* Add the standard constants to the symbol table */
(void)addConstant("TRUE", tBOOLEAN_CONST, &trueValue, NULL);
(void)addConstant("FALSE", tBOOLEAN_CONST, &falseValue, NULL);
(void)addConstant("MAXINT", tINT_CONST, &maxintValue, NULL);
(void)addConstant("NIL", tNIL, &falseValue, NULL);
/* Add the standard types to the symbol table */
typePtr = addTypeDefine("INTEGER", sINT, sINT_SIZE, NULL);
if (typePtr)
{
parentInteger = typePtr;
typePtr->sParm.t.minValue = MININT;
typePtr->sParm.t.maxValue = MAXINT;
} /* end if */
typePtr = addTypeDefine("BOOLEAN", sBOOLEAN, sBOOLEAN_SIZE, NULL);
if (typePtr)
{
typePtr->sParm.t.minValue = falseValue;
typePtr->sParm.t.maxValue = trueValue;
} /* end if */
typePtr = addTypeDefine("REAL", sREAL, sREAL_SIZE, NULL);
typePtr = addTypeDefine("CHAR", sCHAR, sCHAR_SIZE, NULL);
if (typePtr)
{
typePtr->sParm.t.minValue = MINCHAR;
typePtr->sParm.t.maxValue = MAXCHAR;
} /* end if */
typePtr = addTypeDefine("TEXT", sFILE_OF, sCHAR_SIZE, NULL);
if (typePtr)
{
typePtr->sParm.t.subType = sCHAR;
typePtr->sParm.t.minValue = MINCHAR;
typePtr->sParm.t.maxValue = MAXCHAR;
} /* end if */
/* Add some enhanced Pascal standard" types to the symbol table
*
* string is represent by a 256 byte memory regions consisting of
* one byte for the valid string length plus 255 bytes for string
* storage
*/
typePtr = addTypeDefine("STRING", sSTRING, sSTRING_SIZE, NULL);
if (typePtr)
{
parentString = typePtr;
typePtr->sParm.t.rtype = sRSTRING;
typePtr->sParm.t.subType = sCHAR;
typePtr->sParm.t.rsize = sRSTRING_SIZE;
typePtr->sParm.t.flags = STYPE_VARSIZE;
typePtr->sParm.t.minValue = MINCHAR;
typePtr->sParm.t.maxValue = MAXCHAR;
} /* end if */
/* Add the standard files to the symbol table */
(void)addFile("INPUT", 0);
(void)addFile("OUTPUT", 0);
/* Initialize files table */
for (i = 0; i <= MAX_FILES; i++)
{
files [i].defined = 0;
files [i].flevel = 0;
files [i].ftype = 0;
files [i].faddr = 0;
files [i].fsize = 0;
} /* end for */
} /* end primeSymbolTable */
/***************************************************************/
void verifyLabels(int32_t symIndex)
{
register int16_t i; /* loop index */
for (i=symIndex; i < nsym; i++)
if ((symbolTable[i].sKind == sLABEL)
&& (symbolTable[i].sParm.l.unDefined))
error (eUNDEFLABEL);
} /* end verifyLabels */
/***************************************************************/
#if CONFIG_DEBUG
const char noName[] = "********";
void dumpTables(void)
{
register int16_t i;
fprintf(lstFile,"\nSYMBOL TABLE:\n");
fprintf(lstFile,"[ Addr ] NAME KIND LEVL\n");
for (i = 0; i < nsym; i++)
{
fprintf(lstFile,"[%08lx] ", (uint32_t)&symbolTable[i]);
if (symbolTable[i].sName)
fprintf(lstFile, "%8s", symbolTable[i].sName);
else
fprintf(lstFile, "%8s", noName);
fprintf(lstFile," %04x %04x ",
symbolTable[i].sKind,
symbolTable[i].sLevel);
switch (symbolTable[i].sKind)
{
/* Constants */
case tINT_CONST :
case tCHAR_CONST :
case tBOOLEAN_CONST :
case tNIL :
case sSCALAR :
fprintf(lstFile, "val=%ld parent=[%08lx]\n",
symbolTable[i].sParm.c.val.i,
(unsigned long)symbolTable[i].sParm.c.parent);
break;
case tREAL_CONST :
fprintf(lstFile, "val=%f parent=[%08lx]\n",
symbolTable[i].sParm.c.val.f,
(unsigned long)symbolTable[i].sParm.c.parent);
break;
/* Types */
case sTYPE :
fprintf(lstFile,
"type=%02x rtype=%02x subType=%02x flags=%02x "
"asize=%ld rsize=%ld minValue=%ld maxValue=%ld "
"parent=[%08lx]\n",
symbolTable[i].sParm.t.type,
symbolTable[i].sParm.t.rtype,
symbolTable[i].sParm.t.subType,
symbolTable[i].sParm.t.flags,
symbolTable[i].sParm.t.asize,
symbolTable[i].sParm.t.rsize,
symbolTable[i].sParm.t.minValue,
symbolTable[i].sParm.t.maxValue,
(unsigned long)symbolTable[i].sParm.t.parent);
break;
/* Procedures/Functions */
/* Procedures and Functions */
case sPROC :
case sFUNC :
fprintf(lstFile,
"label=L%04x nParms=%d flags=%02x parent=[%08lx]\n",
symbolTable[i].sParm.p.label,
symbolTable[i].sParm.p.nParms,
symbolTable[i].sParm.p.flags,
(unsigned long)symbolTable[i].sParm.p.parent);
break;
/* Labels */
case sLABEL :
fprintf(lstFile, "label=L%04x unDefined=%d\n",
symbolTable[i].sParm.l.label,
symbolTable[i].sParm.l.unDefined);
break;
/* Files */
case sFILE :
fprintf(lstFile, "fileNumber=%d\n",
symbolTable[i].sParm.fileNumber);
break;
/* Variables */
case sINT :
case sBOOLEAN :
case sCHAR :
case sREAL :
case sTEXT :
case sARRAY :
case sPOINTER :
case sVAR_PARM :
case sRECORD :
case sFILE_OF :
fprintf(lstFile, "offset=%ld size=%ld flags=%02x parent=[%08lx]\n",
symbolTable[i].sParm.v.offset,
symbolTable[i].sParm.v.size,
symbolTable[i].sParm.v.flags,
(unsigned long)symbolTable[i].sParm.v.parent);
break;
/* Record objects */
case sRECORD_OBJECT :
fprintf(lstFile,
"offset=%ld size=%ld record=[%08lx] parent=[%08lx]\n",
symbolTable[i].sParm.r.offset,
symbolTable[i].sParm.r.size,
(unsigned long)symbolTable[i].sParm.r.record,
(unsigned long)symbolTable[i].sParm.r.parent);
break;
/* Constant strings */
case sSTRING_CONST :
fprintf(lstFile, "offset=%04lx size=%ld\n",
symbolTable[i].sParm.s.offset,
symbolTable[i].sParm.s.size);
break;
default :
fprintf(lstFile, "Unknown sKind\n");
break;
} /* end switch */
} /* end for */
} /* end dumpTables */
#endif
/***************************************************************/
misc/pascal/pascal/ptbl.h
+79
View File
@@ -0,0 +1,79 @@
/***************************************************************************
* ptbl.h
* External Declarations associated with ptbl.c
*
* 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.
*
***************************************************************************/
#ifndef __PTBL_H
#define __PTBL_H
/***************************************************************************
* Included Files
***************************************************************************/
#include <stdint.h>
#include "config.h"
/***************************************************************************
* Global Variables
***************************************************************************/
extern STYPE *parentInteger;
extern STYPE *parentString;
/***************************************************************************
* Global Function Prototypes
***************************************************************************/
extern const RTYPE *findReservedWord (char *name);
extern STYPE *findSymbol (char *inName);
extern STYPE *addTypeDefine (char *name, uint8_t type, uint16_t size,
STYPE *parent);
extern STYPE *addConstant (char *name, uint8_t type, int32_t *value,
STYPE *parent);
extern STYPE *addStringConst (char *name, uint32_t offset, uint32_t size);
extern STYPE *addFile (char *name, uint16_t fileNumber);
extern STYPE *addLabel (char *name, uint16_t label);
extern STYPE *addProcedure (char *name, uint8_t type, uint16_t label,
uint16_t nParms, STYPE *parent);
extern STYPE *addVariable (char *name, uint8_t type, uint16_t offset,
uint16_t size, STYPE *parent);
extern STYPE *addField (char *name, STYPE *record);
extern void primeSymbolTable (unsigned long symbolTableSize);
extern void verifyLabels (int32_t symIndex);
#if CONFIG_DEBUG
extern void dumpTables (void);
#endif
#endif /* __PTBL_H */
misc/pascal/pascal/ptdefs.h
+209
View File
@@ -0,0 +1,209 @@
/***********************************************************************
* ptdefs.h
* Token and Symbol Table Definitions
*
* Copyright (C) 2008 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.
*
***********************************************************************/
#ifndef __PTDEFS_H
#define __PTDEFS_H
/***********************************************************************/
/* Token Values 0-0x20 reserved for get_token identification */
#define tIDENT 0x01
#define tINT_CONST 0x02
#define tCHAR_CONST 0x03
#define tBOOLEAN_CONST 0x04
#define tREAL_CONST 0x05
#define tSTRING_CONST 0x06
#define tLE 0x07
#define tGE 0x08
#define tASSIGN 0x09
#define tSUBRANGE 0x0A
/* Token Values 0x21-0x2F (except 0x24) are for ASCII character tokens */
#define tNE ('#')
#define SQUOTE 0x27
#define tMUL ('*')
#define tFDIV ('/')
/* Token Values 0x30-0x39 are spare */
/* Token Values 0x3A-0x40 are for ASCII character tokens */
#define tLT ('<')
#define tEQ ('=')
#define tGT ('>')
/* Token Values 0x41-0x5A are SYMBOL TABLE definitions */
#define sPROC 0x41
#define sFUNC 0x42
#define sLABEL 0x43
#define sTYPE 0x44
#define sFILE 0x45
#define sINT 0x46
#define sBOOLEAN 0x47
#define sCHAR 0x48
#define sREAL 0x49
#define sTEXT 0x4a
#define sSTRING 0x4b /* String storage type */
#define sRSTRING 0x4c /* String reference type */
#define sSTRING_CONST 0x4d
#define sPOINTER 0x4e
#define sSCALAR 0x4f
#define sSCALAR_OBJECT 0x50
#define sSUBRANGE 0x51
#define sSET_OF 0x52
#define sARRAY 0x53
#define sRECORD 0x54
#define sRECORD_OBJECT 0x55
#define sFILE_OF 0x56
#define sVAR_PARM 0x57
/* Token Values 0x5B-0x60 (except 0x5F) are for ASCII character tokens */
/* Token Values 0x61-0x7a are SYMBOL TABLE definitions */
/* Token Values 0x7b-0x7f are for ASCII character tokens */
/* Token Value 0x7f is spare */
/* Token Values 0x80-0xef are for RESERVED WORDS */
/* Standard constants (TRUE, FALSE, MAXINT) and standard files (INPUT, OUTPUT)
* are hard initialized into the constant/symbol table and are transparent
* to the compiler */
/* Reserved Words 0x80-0xaf*/
#define tAND 0x80
#define tARRAY 0x81
#define tBEGIN 0x82
#define tCASE 0x83
#define tCONST 0x84
#define tDIV 0x85
#define tDO 0x86
#define tDOWNTO 0x87
#define tELSE 0x88
#define tEND 0x89
#define tFILE 0x8a
#define tFOR 0x8b
#define tFUNCTION 0x8c
#define tGOTO 0x8d
#define tIF 0x8e
#define tIMPLEMENTATION 0x08f /* Extended pascal */
#define tIN 0x90
#define tINTERFACE 0x91 /* Extended pascal */
#define tLABEL 0x92
#define tMOD 0x93
#define tNIL 0x94
#define tNOT 0x95
#define tOF 0x96
#define tOR 0x97
#define tPACKED 0x98
#define tPROCEDURE 0x99
#define tPROGRAM 0x9a
#define tRECORD 0x9b
#define tREPEAT 0x9c
#define tSET 0x9d
#define tSHL 0x9e
#define tSHR 0x9f
#define tTHEN 0xa0
#define tTO 0xa1
#define tTYPE 0xa2
#define tUNIT 0xa3 /* Extended pascal */
#define tUNTIL 0xa4
#define tUSES 0xa5 /* Extended pascal */
#define tVAR 0xa6
#define tWHILE 0xa7
#define tWITH 0xa8
/* The following codes indicate that the token is a built-in procedure
* or function recognized by the compiler. An additional code will be
* place in tknSubType by the tokenizer to indicate which built-in
* procedure or function applies.
*/
#define tFUNC 0xb0
#define tPROC 0xb1
/***********************************************************************/
/* Codes to indentify built-in functions and procedures */
#define txNONE 0x00
/* Standard Functions 0x01-0x1f*/
#define txABS 0x01
#define txARCTAN 0x02
#define txCHR 0x03
#define txCOS 0x04
#define txEOF 0x05
#define txEOLN 0x06
#define txEXP 0x07
#define txLN 0x08
#define txODD 0x09
#define txORD 0x0a
#define txPRED 0x0b
#define txROUND 0x0c
#define txSIN 0x0d
#define txSQR 0x0e
#define txSQRT 0x0f
#define txSUCC 0x10
#define txTRUNC 0x11
/* "Less than standard" Functions 0x20-0x7f */
#define txGETENV 0x20
/* Standard Procedures 0x81-0xbf */
#define txGET 0x80
#define txNEW 0x81
#define txPACK 0x82
#define txPAGE 0x83
#define txPUT 0x84
#define txREAD 0x85
#define txREADLN 0x86
#define txRESET 0x87
#define txREWRITE 0x88
#define txUNPACK 0x89
#define txWRITE 0x8a
#define txWRITELN 0x8b
/* "Less than standard" Procedures 0xc0-0xff */
#define txVAL 0xc0
#endif /* __PTDEFS_H */
misc/pascal/pascal/ptkn.c
+899
View File
@@ -0,0 +1,899 @@
/***************************************************************
* ptkn.c
* Tokenization Package
*
* 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 Functions
***************************************************************/
#include <stdio.h>
#include <stdlib.h>
#include <ctype.h>
#include "keywords.h"
#include "pasdefs.h"
#include "ptdefs.h"
#include "pedefs.h"
#include "pas.h"
#include "ptkn.h"
#include "ptbl.h"
#include "perr.h"
/***************************************************************
* Private Function Prototypes
***************************************************************/
static void getCharacter (void);
static void skipLine (void);
static bool getLine (void);
static void identifier (void);
static void string (void);
static void unsignedNumber (void);
static void unsignedRealNumber (void);
static void unsignedExponent (void);
static void unsignedHexadecimal (void);
static void unsignedBinary (void);
/***************************************************************
* Private Variables
***************************************************************/
static char *strStack; /* String Stack */
static uint16_t inChar; /* last gotten character */
/***************************************************************
* Public Variables
***************************************************************/
char *tkn_strt; /* Start of token in string stack */
char *stringSP; /* Top of string stack */
/***************************************************************
* Public Functions
***************************************************************/
int16_t primeTokenizer(unsigned long stringStackSize)
{
TRACE(lstFile,"[primeTokenizer]");
/* Allocate and initialize the string stack and stack pointers */
strStack = malloc(stringStackSize);
if (!strStack)
{
fatal(eNOMEMORY);
}
/* Initially, everything points to the bottom of the
* string stack.
*/
tkn_strt = strStack;
stringSP = strStack;
/* Set up for input at the initial level of file parsing */
rePrimeTokenizer();
return 0;
}
/***************************************************************/
int16_t rePrimeTokenizer(void)
{
TRACE(lstFile,"[rePrimeTokenizer]");
/* (Re-)set the char pointer to the beginning of the line */
FP->cp = FP->buffer;
/* Read the next line from the input stream */
if (!fgets(FP->cp, LINE_SIZE, FP->stream))
{
/* EOF.. close file */
return 1;
}
/* Initialize the line nubmer */
FP->line = 1;
/* Get the first character from the new file */
getCharacter();
return 0;
}
/***************************************************************/
/* Tell 'em what what the next character will be (if they should
* choose to get it). This is similar to getCharacter(), except that
* the character pointer is not incremented past the character. The
* next time that getCharacter() is called, it will get the character
* again.
*/
char getNextCharacter(bool skipWhiteSpace)
{
/* Get the next character from the line buffer. */
inChar = *(FP->cp);
/* If it is the EOL then read the next line from the input file */
if (!inChar)
{
/* We have used all of the characters on this line. Read the next
* line of data
*/
if (getLine())
{
/* Uh-oh, we are out of data! Just return some bogus value. */
inChar = '?';
} /* end if */
else
{
/* Otherwise, recurse to try again. */
return getNextCharacter(skipWhiteSpace);
} /* end else */
} /* end if */
/* If it is a space and we have been told to skip spaces then consume
* the input line until a non-space or the EOL is encountered.
*/
else if (skipWhiteSpace)
{
while ((isspace(inChar)) && (inChar))
{
/* Skip over the space */
(FP->cp)++;
/* A get the character after the space */
inChar = *(FP->cp);
} /* end while */
/* If we hit the EOL while searching for the next non-space, then
* recurse to try again on the next line
*/
if (!inChar)
{
return getNextCharacter(skipWhiteSpace);
}
} /* end else if */
return inChar;
} /* end getNextCharacter */
/***************************************************************/
void getToken(void)
{
/* Skip over leading spaces and comments */
while (isspace(inChar)) getCharacter();
/* Point to the beginning of the next token */
tkn_strt = stringSP;
/* Process Identifier, Symbol, or Reserved Word */
if ((isalpha(inChar)) || (inChar == '_'))
identifier();
/* Process Numeric */
else if (isdigit(inChar))
unsignedNumber();
/* Process string */
else if (inChar == SQUOTE)
string(); /* process string type */
/* Process ':' or assignment */
else if (inChar == ':')
{
getCharacter();
if (inChar == '=') {token = tASSIGN; getCharacter();}
else token = ':';
} /* end else if */
/* Process '.' or subrange or real-number */
else if (inChar == '.')
{
/* Get the character after the '.' */
getCharacter();
/* ".." indicates a subrange */
if (inChar == '.')
{
token = tSUBRANGE;
getCharacter();
}
/* '.' digit is a real number */
else if (isdigit(inChar))
unsignedRealNumber();
/* Otherwise, it is just a '.' */
else token = '.';
} /* end else if */
/* Process '<' or '<=' or '<>' or '<<' */
else if (inChar == '<')
{
getCharacter();
if (inChar == '>') {token = tNE; getCharacter();}
else if (inChar == '=') {token = tLE; getCharacter();}
else if (inChar == '<') {token = tSHL; getCharacter();}
else token = tLT;
} /* end else if */
/* Process '>' or '>=' or '><' or '>>' */
else if (inChar == '>')
{
getCharacter();
if (inChar == '<') {token = tNE; getCharacter();}
else if (inChar == '=') {token = tGE; getCharacter();}
else if (inChar == '>') {token = tSHR; getCharacter();}
else token = tGT;
} /* end else if */
/* Get Comment -- form { .. } */
else if (inChar == '{')
{
do getCharacter(); /* get the next character */
while (inChar != '}'); /* loop until end of comment */
getCharacter(); /* skip over end of comment */
getToken(); /* get the next real token */
} /* end else if */
/* Get comment -- form (* .. *) */
else if (inChar == '(')
{
getCharacter(); /* skip over comment character */
if (inChar != '*') /* is this a comment? */
{
token = '('; /* No return '(' leaving the
* unprocessed char in inChar */
}
else
{
uint16_t lastChar = ' '; /* YES... prime the look behind */
for (;;) /* look for end of comment */
{
getCharacter(); /* get the next character */
if ((lastChar == '*') && /* Is it '*)' ? */
(inChar == ')'))
{
break; /* Yes... break out */
}
lastChar = inChar; /* save the last character */
} /* end for */
getCharacter(); /* skip over the comment end char */
getToken(); /* and get the next real token */
} /* end else */
} /* end else if */
/* NONSTANDARD: All C/C++-style comments */
else if (inChar == '/')
{
getCharacter(); /* skip over comment character */
if (inChar == '/') /* C++ style comment? */
{
skipLine(); /* Yes, skip rest of line */
getToken(); /* and get the next real token */
}
else if (inChar != '*') /* is this a C-style comment? */
{
token = '/'; /* No return '/' leaving the
* unprocessed char in inChar */
}
else
{
uint16_t lastChar = ' '; /* YES... prime the look behind */
for (;;) /* look for end of comment */
{
getCharacter(); /* get the next character */
if ((lastChar == '*') && /* Is it '*)' ? */
(inChar == '/'))
{
break; /* Yes... break out */
}
lastChar = inChar; /* save the last character */
} /* end for */
getCharacter(); /* skip over the comment end char */
getToken(); /* and get the next real token */
} /* end else */
} /* end else if */
/* Check for $XXXX (hex) */
else if (inChar == '%')
unsignedHexadecimal();
/* Check for $BBBB (binary) */
else if (inChar == '%')
unsignedBinary();
/* if inChar is an ASCII character then return token = character */
else if (isascii(inChar))
{
token = inChar;
getCharacter();
} /* end else if */
/* Otherwise, discard the character and try again */
else
{
getCharacter();
getToken();
} /* end else */
DEBUG(lstFile,"[%02x]", token);
} /* End getToken */
/***************************************************************
* Private Functions
***************************************************************/
static void identifier(void)
{
const RTYPE *rptr; /* Pointer to reserved word */
tknSubType = txNONE; /* Initialize */
/* Concatenate identifier */
do
{
*stringSP++ = toupper(inChar); /* concatenate char */
getCharacter(); /* get next character */
}
while ((isalnum(inChar)) || (inChar == '_'));
*stringSP++ = '\0'; /* make ASCIIZ string */
/* Check if the identifier is a reserved word */
rptr = findReservedWord(tkn_strt);
if (rptr)
{
token = rptr->rtype; /* get type from rsw table */
tknSubType = rptr->subtype; /* get subtype from rsw table */
stringSP = tkn_strt; /* pop token from stack */
} /* End if */
/* Check if the identifier is a symbol */
else
{
tknPtr = findSymbol(tkn_strt);
if (tknPtr)
{
token = tknPtr->sKind; /* get type from symbol table */
stringSP = tkn_strt; /* pop token from stack */
/* The following assignments only apply to constants. However it
* is simpler just to make the assignments than it is to determine
* if is appropriate to do so
*/
if (token == tREAL_CONST)
tknReal = tknPtr->sParm.c.val.f;
else
tknInt = tknPtr->sParm.c.val.i;
} /* End if */
/* Otherwise, the token is an identifier */
else
token = tIDENT;
} /* end else */
} /* End identifier */
/***************************************************************/
/* Process string */
static void string(void)
{
register int16_t count = 0; /* # chars in string */
token = tSTRING_CONST; /* indicate string constant type */
getCharacter(); /* skip over 1st single quote */
while (inChar != SQUOTE) /* loop until next single quote */
{
if (inChar == '\n') /* check for EOL in string */
{
error(eNOSQUOTE); /* ERROR, terminate string */
break;
} /* end if */
else
{
*stringSP++ = inChar; /* concatenate character */
count++; /* bump count of chars */
} /* end else */
getCharacter(); /* get the next character */
} /* end while */
*stringSP++ = '\0'; /* terminate ASCIIZ string */
getCharacter(); /* skip over last single quote */
if (count == 1) /* Check for char constant */
{
token = tCHAR_CONST; /* indicate char constant type */
tknInt = *tkn_strt; /* (integer) value = single char */
stringSP = tkn_strt; /* "pop" from string stack */
} /* end if */
} /* end string */
/***************************************************************/
static void getCharacter(void)
{
/* Get the next character from the line buffer. If EOL, get next line */
inChar = *(FP->cp)++;
if (!inChar)
{
/* We have used all of the characters on this line. Read the next
* line of data
*/
skipLine();
}
}
/***************************************************************/
static void skipLine(void)
{
if (getLine())
{
/* Uh-oh, we are out of data! Just return some bogus value. */
inChar = '?';
} /* end if */
else
{
/* Otherwise, get the first character from the line */
getCharacter();
}
}
/***************************************************************/
static bool getLine(void)
{
bool endOfFile = false;
/* Reset the character pointer to the start of the new line */
FP->cp = FP->buffer;
/* Read the next line from the currently active file */
if (!fgets(FP->cp, LINE_SIZE, FP->stream))
{
/* We are at an EOF for this file. Check if we are processing an
* included file
*/
if (includeIndex > 0)
{
/* Yes. Close the file */
closeNestedFile();
/* Indicate that there is no data on the input line. NOTE:
* that FP now refers to the previous file at the next lower
* level of nesting.
*/
FP->buffer[0] = '\0';
} /* end if */
else
{
/* No. We are completely out of data. Return true in this case. */
endOfFile = true;
} /* end else */
} /* end if */
else
{
/* We have a new line of data. Increment the line number, then echo
* the new line to the list file.
*/
(FP->line)++;
fprintf(lstFile, "%d:%04ld %s", FP->include, FP->line, FP->buffer);
} /* end else */
return endOfFile;
} /* end getLine */
/***************************************************************/
static void unsignedNumber(void)
{
/* This logic (along with with unsignedRealNumber, and
* unsignedRealExponent) handles:
*
* FORM: integer-number = decimal-integer | hexadecimal-integer |
* binary-integer
* FORM: decimal-integer = digit-sequence
* FORM: real-number =
* digit-sequence '.' [digit-sequence] [ exponent scale-factor ] |
* '.' digit-sequence [ exponent scale-factor ] |
* digit-sequence exponent scale-factor
* FORM: exponent = 'e' | 'E'
*
* When called, inChar is equal to the leading digit of a
* digit-sequence. NOTE that the real-number form beginning with
* '.' does not use this logic.
*/
/* Assume an integer type (might be real) */
token = tINT_CONST;
/* Concatenate all digits until an non-digit is found */
do
{
*stringSP++ = inChar;
getCharacter();
}
while (isdigit(inChar));
/* If it is a digit-sequence followed by 'e' (or 'E'), then
* continue processing this token as a real number.
*/
if ((inChar == 'e') || (inChar == 'E'))
{
unsignedExponent();
}
/* If the digit-sequence is followed by '.' but not by ".." (i.e.,
* this is not a subrange), then switch we are parsing a real time.
* Otherwise, convert the integer string to binary.
*/
else if ((inChar != '.') || (getNextCharacter(false) == '.'))
{
/* Terminate the integer string and convert it using sscanf */
*stringSP++ = '\0';
(void)sscanf(tkn_strt, "%ld", &tknInt);
/* Remove the integer string from the character identifer stack */
stringSP = tkn_strt;
} /* end if */
else
{
/* Its a real value! Now really get the next character and
* after the decimal point (this will work whether or not
* getNextCharacter() was called). Then process the real number.
*/
getCharacter();
unsignedRealNumber();
} /* end if */
}
/***************************************************************/
static void unsignedRealNumber(void)
{
/* This logic (along with with unsignedNumber and unsignedExponent)
* handles:
*
* FORM: real-number =
* digit-sequence '.' [digit-sequence] [ exponent scale-factor ] |
* '.' digit-sequence [ exponent scale-factor ] |
* digit-sequence exponent scale-factor
* FORM: exponent = 'e' | 'E'
*
* When called:
* - inChar is the character AFTER the '.'.
* - Any leading digit-sequence is already in the character stack
* - the '.' is not in the character stack.
*/
/* Its a real constant */
token = tREAL_CONST;
/* Save the decimal point (inChar points to the character after
* the decimal point).
*/
*stringSP++ = '.';
/* Now, loop to process the optional digit-sequence after the
* decimal point.
*/
while (isdigit(inChar))
{
*stringSP++ = inChar;
getCharacter();
}
/* If it is a digit-sequence followed by 'e' (or 'E'), then
* continue processing this token as a real number.
*/
if ((inChar == 'e') || (inChar == 'E'))
{
unsignedExponent();
}
else
{
/* There is no exponent...
* Terminate the real number string and convert it to binay
* using sscanf.
*/
*stringSP++ = '\0';
(void) sscanf(tkn_strt, "%lf", &tknReal);
} /* end if */
/* Remove the number string from the character identifer stack */
stringSP = tkn_strt;
}
/***************************************************************/
static void unsignedExponent(void)
{
/* This logic (along with with unsignedNumber and unsignedRealNumber)
* handles:
*
* FORM: real-number =
* digit-sequence '.' [digit-sequence] [ exponent scale-factor ] |
* '.' digit-sequence [ exponent scale-factor ] |
* digit-sequence exponent scale-factor
* FORM: exponent = 'e'
* FORM: scale-factor = [ sign ] digit-sequence
*
* When called:
* - inChar holds the 'E' (or 'e') exponent
* - Any leading digit-sequences or decimal points are already in the
* character stack
* - the 'E' (or 'e') is not in the character stack.
*/
/* Its a real constant */
token = tREAL_CONST;
/* Save the decimal point (inChar points to the character after
* the decimal point).
*/
*stringSP++ = inChar;
getCharacter();
/* Check for an optional sign before the exponent value */
if ((inChar == '-') || (inChar == '+'))
{
/* Add the sign to the stack */
*stringSP++ = inChar;
getCharacter();
}
else
{
/* Add a '+' sign to the stack */
*stringSP++ = '+';
}
/* A digit sequence must appear after the exponent and optional
* sign.
*/
if (!isdigit(inChar))
{
error(eEXPONENT);
tknReal = 0.0;
}
else
{
/* Now, loop to process the required digit-sequence */
do
{
*stringSP++ = inChar;
getCharacter();
}
while (isdigit(inChar));
/* Terminate the real number string and convert it to binay
* using sscanf.
*/
*stringSP++ = '\0';
(void) sscanf(tkn_strt, "%lf", &tknReal);
}
/* Remove the number string from the character identifer stack */
stringSP = tkn_strt;
}
/***************************************************************/
static void unsignedHexadecimal(void)
{
/* FORM: integer-number = decimal-integer | hexadecimal-integer |
* binary-integer
* FORM: hexadecimal-integer = '$' hex-digit-sequence
* FORM: hex-digit-sequence = hex-digit { hex-digit }
* FORM: hex-digit = digit | 'a' | 'b' | 'c' | 'd' | 'e' | 'f'
*
* On entry, inChar is '$'
*/
/* This is another representation for an integer */
token = tINT_CONST;
/* Loop to process each hex 'digit' */
for (;;)
{
/* Get the next character */
getCharacter();
/* Is it a decimal digit? */
if (isdigit(inChar))
*stringSP++ = inChar;
/* Is it a hex 'digit'? */
else if ((inChar >= 'A') && (inChar <= 'F'))
*stringSP++ = inChar;
else if ((inChar >= 'a') && (inChar <= 'f'))
*stringSP++ = _toupper(inChar);
/* Otherwise, that must be the end of the hex value */
else break;
}
/* Terminate the hex string and convert to binary using sscanf */
*stringSP++ = '\0';
(void)sscanf(tkn_strt, "%lx", &tknInt);
/* Remove the hex string from the character identifer stack */
stringSP = tkn_strt;
}
/***************************************************************/
static void unsignedBinary(void)
{
uint32_t value;
/* FORM: integer-number = decimal-integer | hexadecimal-integer |
* binary-integer
* FORM: binary-integer = '%' binary-digit-sequence
* FORM: binary-digit-sequence = binary-digit { binary-digit }
* FORM: binary-digit = '0' | '1'
*
* On entry, inChar is '%'
*/
/* This is another representation for an integer */
token = tINT_CONST;
/* Loop to process each hex 'digit' */
value = 0;
for (;;)
{
/* Get the next character */
getCharacter();
/* Is it a binary 'digit'? */
if (inChar == '0')
value <<= 1;
else if (inChar == '1')
{
value <<= 1;
value |= 1;
}
/* Otherwise, that must be the end of the binary value */
else break;
}
/* I don't there there is an sscanf conversion for binary, that's
* why we did it above.
*/
tknInt = (int32_t)value;
}
/***************************************************************/
misc/pascal/pascal/ptkn.h
+65
View File
@@ -0,0 +1,65 @@
/***************************************************************************
* ptkn.h
* External Declarations associated with ptkn.c
*
* 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.
*
***************************************************************************/
#ifndef __PTKN_H
#define __PTKN_H
/***************************************************************************
* Included Files
***************************************************************************/
#include <stdint.h>
#include <stdbool.h>
/***************************************************************************
* Public Variables
***************************************************************************/
/* String stack access variables */
extern char *tkn_strt; /* Start of token in string stack */
extern char *stringSP; /* Top of string stack */
/***************************************************************************
* Public Function Prototypes
***************************************************************************/
extern void getToken (void);
extern char getNextCharacter (bool skipWhiteSpace);
extern int16_t primeTokenizer (unsigned long stringStackSize);
extern int16_t rePrimeTokenizer (void);
#endif /* __PTKN_H */
misc/pascal/pascal/punit.c
+599
View File
@@ -0,0 +1,599 @@
/**********************************************************************
* 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 */
misc/pascal/pascal/punit.h
+51
View File
@@ -0,0 +1,51 @@
/***************************************************************************
* punit.h
* External Declarations associated with punit.c
*
* Copyright (C) 2008 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.
*
***************************************************************************/
#ifndef __PUNIT_H
#define __PUNIT_H
/***************************************************************************
* Public Types
***************************************************************************/
/***************************************************************************
* Global Function Prototypes
***************************************************************************/
extern void unitImplementation(void);
extern void unitInterface(void);
#endif /* __PUNIT_H */