Pascal Compiler

git-svn-id: svn://svn.code.sf.net/p/nuttx/code/trunk@489 42af7a65-404d-4744-a932-0658087f49c3
author: patacongo <patacongo@42af7a65-404d-4744-a932-0658087f49c3> 2008-01-05 13:35:56 +0000
committer: patacongo <patacongo@42af7a65-404d-4744-a932-0658087f49c3> 2008-01-05 13:35:56 +0000
commit: 15c5db8e173651f7e0375d3b6e23ee089681448e (patch)
tree: f3a13e408be3ce89c9405394d26aed1397ce3993 /misc/pascal
parent: f6d83168b86cb3f48151a462f3513f58c3762063 (diff)
download: nuttx-15c5db8e173651f7e0375d3b6e23ee089681448e.tar.gz
nuttx-15c5db8e173651f7e0375d3b6e23ee089681448e.tar.bz2
nuttx-15c5db8e173651f7e0375d3b6e23ee089681448e.zip
15 files changed, 12680 insertions, 0 deletions
diff --git a/misc/pascal/pascal/Makefile b/misc/pascal/pascal/Makefile
new file mode 100644
index 000000000..6029fb245
--- /dev/null
+++ b/misc/pascal/pascal/Makefile
@@ -0,0 +1,85 @@
+############################################################################
+# pascal/Makefile
+#
+#   Copyright (C) 2008 Gregory Nutt. All rights reserved.
+#   Author: Gregory Nutt <spudmonkey@racsa.co.cr>
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions
+# are met:
+#
+# 1. Redistributions of source code must retain the above copyright
+#    notice, this list of conditions and the following disclaimer.
+# 2. Redistributions in binary form must reproduce the above copyright
+#    notice, this list of conditions and the following disclaimer in
+#    the documentation and/or other materials provided with the
+#    distribution.
+# 3. Neither the name NuttX nor the names of its contributors may be
+#    used to endorse or promote products derived from this software
+#    without specific prior written permission.
+#
+# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+# "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+# LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+# FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+# COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+# INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+# BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS
+# OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED
+# AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+# ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+# POSSIBILITY OF SUCH DAMAGE.
+#
+############################################################################
+#
+# 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 -lpas -lpoff -lm
+
+pascal: $(BINDIR-y)/pascal
+
+clean:
+	$(RM) pascal *.o core *~
diff --git a/misc/pascal/pascal/pas.c b/misc/pascal/pascal/pas.c
new file mode 100644
index 000000000..b9ca3d889
--- /dev/null
+++ b/misc/pascal/pascal/pas.c
@@ -0,0 +1,536 @@
+/**********************************************************************
+ * pas.c
+ * Main process
+ *
+ *   Copyright (C) 2008 Gregory Nutt. All rights reserved.
+ *   Author: Gregory Nutt <spudmonkey@racsa.co.cr>
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ *    notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ *    notice, this list of conditions and the following disclaimer in
+ *    the documentation and/or other materials provided with the
+ *    distribution.
+ * 3. Neither the name NuttX nor the names of its contributors may be
+ *    used to endorse or promote products derived from this software
+ *    without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+ * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+ * COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+ * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+ * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS
+ * OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED
+ * AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+ * ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *
+ **********************************************************************/
+
+/**********************************************************************
+ * Included Files
+ **********************************************************************/
+
+#define _GNU_SOURCE
+#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 "pdefs.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() */
+
+/**********************************************************************
+ * Definitions
+ **********************************************************************/
+
+/**********************************************************************
+ * Global Variables
+ **********************************************************************/
+
+/* Unitialized Global Data */
+
+uint16      token;                   /* Current token */
+uint16      tknSubType;              /* Extended token type */
+sint32      tknInt;                  /* Integer token value */
+float64     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 */
+
+sint16      level        = 0;        /* Static nesting level */
+sint16      includeIndex = 0;        /* Include file index */
+sint16      nIncPathes   = 0;        /* Number pathes in includePath[] */
+uint16      label        = 0;        /* Last label number */
+sint16      nsym         = 0;        /* Number symbol table entries */
+sint16      nconst       = 0;        /* Number constant table entries */
+sint16      sym_strt     = 0;        /* Symbol search start index */
+sint16      const_strt   = 0;        /* Constant search start index */
+sint16      err_count    = 0;        /* Error counter */
+sint16      nfiles       = 0;        /* Program file counter */
+sint32      warn_count   = 0;        /* Warning counter */
+sint32      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--;
+    }
+}
+
+/***********************************************************************/
diff --git a/misc/pascal/pascal/pblck.c b/misc/pascal/pascal/pblck.c
new file mode 100644
index 000000000..b1ac5f815
--- /dev/null
+++ b/misc/pascal/pascal/pblck.c
@@ -0,0 +1,2263 @@
+/***************************************************************
+ * pblck.c
+ * Process a Pascal Block
+ *
+ *   Copyright (C) 2008 Gregory Nutt. All rights reserved.
+ *   Author: Gregory Nutt <spudmonkey@racsa.co.cr>
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ *    notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ *    notice, this list of conditions and the following disclaimer in
+ *    the documentation and/or other materials provided with the
+ *    distribution.
+ * 3. Neither the name NuttX nor the names of its contributors may be
+ *    used to endorse or promote products derived from this software
+ *    without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+ * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+ * COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+ * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+ * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS
+ * OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED
+ * AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+ * ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *
+ ***************************************************************/
+
+/***************************************************************
+ * Included Files
+ ***************************************************************/
+
+#include <stdio.h>
+#include <string.h>
+
+#include "keywords.h"
+#include "pdefs.h"
+#include "ptdefs.h"
+#include "pedefs.h"
+#include "podefs.h"
+
+#include "pas.h"
+#include "pblck.h"
+#include "pexpr.h"
+#include "pstm.h"
+#include "pgen.h"
+#include "ptkn.h"
+#include "ptbl.h"
+#include "pinsn.h"
+#include "perr.h"
+
+/***************************************************************
+ * Private Definitions
+ ***************************************************************/
+
+/* This macro implements a test for:
+ * FORM:  unsigned-constant = integer-number | real-number |
+ *       character-literal | string-literal | constant-identifier |
+ *       'nil'
+ */
+
+#define isConstant(x) \
+	(  ((x) == tINT_CONST) \
+	|| ((x) == tBOOLEAN_CONST) \
+	|| ((x) == tCHAR_CONST) \
+	|| ((x) == tREAL_CONST) \
+	|| ((x) == sSCALAR_OBJECT))
+
+#define isIntAligned(x) (((x) & (sINT_SIZE-1)) == 0)
+#define intAlign(x)     (((x) + (sINT_SIZE-1)) & (~(sINT_SIZE-1)))
+
+/***************************************************************
+ * Private Function Prototypes
+ ***************************************************************/
+
+static void    pas_DeclareLabel          (void);
+static void    pas_DeclareConst          (void);
+static STYPE  *pas_DeclareType           (char *typeName);
+static STYPE  *pas_DeclareOrdinalType    (char *typeName);
+static STYPE  *pas_DeclareVar            (void);
+static void    pas_DeclareFile           (void);
+static void    pas_ProcedureDeclaration  (void);
+static void    pas_FunctionDeclaration   (void);
+
+static void    pas_SetTypeSize           (STYPE *typePtr, boolean allocate);
+static STYPE  *pas_TypeIdentifier        (boolean allocate);
+static STYPE  *pas_TypeDenoter           (char *typeName, boolean allocate);
+static STYPE  *pas_NewComplexType        (char *typeName);
+static STYPE  *pas_NewOrdinalType        (char *typeName);
+static STYPE  *pas_OrdinalTypeIdentifier (boolean allocate);
+static STYPE  *pas_GetArrayType          (void);
+static STYPE  *pas_DeclareRecord         (char *recordName);
+static STYPE  *pas_DeclareField          (STYPE *recordPtr);
+static STYPE  *pas_DeclareParameter      (boolean pointerType);
+static boolean pas_IntAlignRequired      (STYPE *typePtr);
+
+/***************************************************************
+ * Private Global Variables
+ ***************************************************************/
+
+static sint32  g_nParms;
+static sint32  g_dwVarSize;                      
+
+/***************************************************************
+ * Public Functions
+ ***************************************************************/
+/* Process BLOCK.  This function implements:
+ *
+ * block = declaration-group compound-statement
+ *
+ * Where block can appear in the followinging:
+ *
+ * function-block = block
+ * function-declaration =
+ *     function-heading ';' directive |
+ *     function-heading ';' function-block
+ *
+ * procedure-block = block
+ * procedure-declaration =
+ *     procedure-heading ';' directive |
+ *     procedure-heading ';' procedure-block
+ *
+ * program = program-heading ';' [ uses-section ] block '.'
+ */
+
+void block()
+{
+  uint16  beginLabel   = ++label;     /* BEGIN label */
+  sint32  saveDStack   = dstack;      /* Save DSEG size */
+  char   *saveStringSP = stringSP;    /* Save top of string stack */
+  sint16  saveNSym     = nsym;        /* Save top of symbol table */
+  sint16  saveNConst   = nconst;      /* Save top of constant table */
+  register sint16 i;
+
+  TRACE(lstFile,"[block]");
+
+  /* When we enter block at level zero, then we must be at the
+   * entry point to the program.  Save the entry point label
+   * in the POFF file.
+   */
+
+  if ((level == 0) && (FP0->kind == eIsProgram))
+    {
+      poffSetEntryPoint(poffHandle, label);
+    }
+
+  /* Init size of the new DSEG */
+
+  dstack = 0;
+
+  /* FORM: block = declaration-group compound-statement
+   * Process the declaration-group
+   *
+   * declaration-group =
+   *     label-declaration-group |
+   *     constant-definition-group |
+   *     type-definition-group |
+   *     variable-declaration-group |
+   *     function-declaration  |
+   *     procedure-declaration
+   */
+
+  declarationGroup(beginLabel);
+
+  /* Process the compound-statement
+   *
+   * FORM: compound-statement = 'begin' statement-sequence 'end'
+   */
+
+  /* Verify that the compound-statement begins with BEGIN */
+
+  if (token != tBEGIN)
+    {
+      error (eBEGIN);
+    }
+
+  /* It may be necessary to jump around some local functions to
+   * get to the main body of the block.  If any jumps are generated,
+   * they will come to the beginLabel emitted here.
+   */
+
+  pas_GenerateDataOperation(opLABEL, (sint32)beginLabel);
+
+  /* Since we don't know for certain how we got here, invalidate
+   * the level stack pointer (LSP).  This is, of course, only 
+   * meaningful on architectures that implement an LSP.
+   */
+
+  pas_InvalidateCurrentStackLevel();
+
+  /* Then emit the compoundStatement itself */
+
+  if (dstack)
+    {
+      pas_GenerateDataOperation(opINDS, (sint32)dstack);
+    }
+
+  compoundStatement();
+
+  if (dstack)
+    {
+      pas_GenerateDataOperation(opINDS, -(sint32)dstack);
+    }
+
+  /* Make sure all declared labels were defined in the block */
+
+  verifyLabels(saveNSym);
+
+  /* Re-initialize file table -- clear files defined in this level */
+
+  for (i = 0; i <= MAX_FILES; i++)
+    {
+      if ((files [i].defined) && (files [i].flevel >= level)) {
+	files [i].defined = 0;
+	files [i].flevel  = 0;
+	files [i].ftype   = 0;
+	files [i].faddr   = 0;
+	files [i].fsize   = 0;
+      }
+    }
+
+  /* "Pop" declarations local to this block */
+
+  dstack   = saveDStack;               /* Restore old DSEG size */
+  stringSP = saveStringSP;             /* Restore top of string stack */
+  nsym     = saveNSym;                 /* Restore top of symbol table */
+  nconst   = saveNConst;               /* Restore top of constant table */
+}
+
+/***************************************************************/
+/* Process declarative-part */
+
+void declarationGroup(sint32 beginLabel)
+{
+  sint16  notFirst   = 0;             /* Init count of nested procs */
+  sint16  saveNSym   = nsym;          /* Save top of symbol table */
+  sint16  saveNConst = nconst;        /* Save top of constant table */
+
+  TRACE(lstFile,"[declarationGroup]");
+
+  /* FORM: declarative-part = { declaration-group }
+   * FORM: declaration-group =
+   *       label-declaration-group | constant-definition-group |
+   *       type-definition-group   | variable-declaration-group |
+   *       function-declaration    | procedure-declaration
+   */
+
+  /* Process label-declaration-group.
+   * FORM: label-declaration-group = 'label' label { ',' label } ';'
+   */
+
+  if (token == tLABEL) pas_DeclareLabel();
+
+  /* Process constant-definition-group.
+   * FORM: constant-definition-group =
+   *       'const' constant-definition ';' { constant-definition ';' }
+   */
+
+  if (token == tCONST)
+    {
+      const_strt = saveNConst;        /* Limit search to present level */
+      getToken();                     /* Get identifier */
+      const_strt = 0;
+
+      /* Process constant-definition.
+       * FORM: constant-definition = identifier '=' constant
+       */
+
+      constantDefinitionGroup();
+    }
+
+  /* Process type-definition-group
+   * FORM: type-definition-group =
+   *       'type' type-definition ';' { type-definition ';' }
+   */
+
+  if (token == tTYPE)
+    {
+      const_strt = saveNConst;        /* Limit search to present level */
+      sym_strt   = saveNSym;
+      getToken();                     /* Get identifier */
+      const_strt = 0;
+      sym_strt   = 0;
+
+      /* Process the type-definitions in the type-definition-group
+       * FORM: type-definition = identifier '=' type-denoter
+       */
+
+      typeDefinitionGroup();
+    }
+
+  /* Process variable-declaration-group
+   * FORM: variable-declaration-group =
+   *       'var' variable-declaration { ';' variable-declaration }
+   */
+
+  if (token == tVAR)
+    {
+      const_strt = saveNConst;        /* Limit search to present level */
+      sym_strt   = saveNSym;
+      getToken();                     /* Get identifier */
+      const_strt = 0;
+      sym_strt   = 0;
+
+      /* Process the variable declarations
+       * FORM: variable-declaration = identifier-list ':' type-denoter
+       * FORM: identifier-list = identifier { ',' identifier }
+       */
+
+      variableDeclarationGroup();
+    }
+
+  /* Process procedure/function-declaration(s) if present 
+   * FORM: function-declaration =
+   *       function-heading ';' directive |
+   *       function-heading ';' function-block
+   * FORM: procedure-declaration =
+   *       procedure-heading ';' directive |
+   *       procedure-heading ';' procedure-block
+   *
+   * NOTE:  a JMP to the executable body of this block is generated
+   * if there are nested procedures and this is not level=0
+   */
+
+  for (;;)
+    {
+      /* FORM: function-heading =
+       *       'function' identifier [ formal-parameter-list ] ':' result-type
+       */
+
+      if (token == tFUNCTION)
+	{
+	  /* Check if we need to put a jump around the function */
+
+	  if ((beginLabel > 0) && !(notFirst) && (level > 0))
+	    {
+	      pas_GenerateDataOperation(opJMP, (sint32)beginLabel);
+	    }
+
+	  /* Get the procedure-identifier */
+
+	  const_strt = saveNConst;    /* Limit search to present level */
+	  sym_strt   = saveNSym;
+	  getToken();                 /* Get identifier */
+	  const_strt = 0;
+	  sym_strt   = 0;
+
+	  /* Define the function */
+
+	  pas_FunctionDeclaration();
+	  notFirst++;                 /* No JMP next time */
+	}
+
+      /* FORM: procedure-heading =
+       *       'procedure' identifier [ formal-parameter-list ]
+       */
+
+      else if (token == tPROCEDURE)
+	{
+	  /* Check if we need to put a jump around the function */
+
+	  if ((beginLabel > 0) && !(notFirst) && (level > 0))
+	    {
+	      pas_GenerateDataOperation(opJMP, (sint32)beginLabel);
+	    }
+
+	  /* Get the procedure-identifier */
+
+	  const_strt = saveNConst;    /* Limit search to present level */
+	  sym_strt   = saveNSym;
+	  getToken();                 /* Get identifier */
+	  const_strt = 0;
+	  sym_strt   = 0;
+
+	  /* Define the procedure */
+
+	  pas_ProcedureDeclaration();
+	  notFirst++;                 /* No JMP next time */
+	}
+      else break;
+    }
+}
+
+/***************************************************************/
+
+void constantDefinitionGroup(void)
+{
+  /* Process constant-definition-group.
+   * FORM: constant-definition-group =
+   *       'const' constant-definition ';' { constant-definition ';' }
+   * FORM: constant-definition = identifier '=' constant
+   *
+   * On entry, token should point to the identifier of the first
+   * constant-definition.
+   */
+
+  for (;;)
+    {
+      if (token == tIDENT)
+	{
+	  pas_DeclareConst();
+	  if (token != ';') break;
+	  else getToken();
+	}
+      else break;
+    }
+}
+
+/***************************************************************/
+
+void typeDefinitionGroup(void)
+{
+  char   *typeName;
+
+  /* Process type-definition-group
+   * FORM: type-definition-group =
+   *       'type' type-definition ';' { type-definition ';' }
+   * FORM: type-definition = identifier '=' type-denoter
+   *
+   * On entry, token refers to the first identifier (if any) of
+   * the type-definition list.
+   */
+
+  for (;;)
+    {
+      if (token == tIDENT)
+	{
+	  /* Save the type identifier */
+
+	  typeName = tkn_strt;
+	  getToken();
+
+	  /* Verify that '=' follows the type identifier */
+
+	  if (token != '=') error (eEQ);
+	  else getToken();
+
+	  (void)pas_DeclareType(typeName);
+	  if (token != ';') break;
+	  else getToken();
+
+	}
+      else break;
+    }
+}
+
+/***************************************************************/
+
+void variableDeclarationGroup(void)
+{
+   /* Process variable-declaration-group
+    * FORM: variable-declaration-group =
+    *       'var' variable-declaration { ';' variable-declaration }
+    * FORM: variable-declaration = identifier-list ':' type-denoter
+    * FORM: identifier-list = identifier { ',' identifier }
+    *
+    * Only entry, token holds the first identfier (if any) of the
+    * variable-declaration list.
+    */
+
+  for (;;)
+    {
+      if (token == tIDENT)
+	{
+	  (void)pas_DeclareVar();
+	  if (token != ';') break;
+	  else getToken();
+	}
+      else if (token == sFILE)
+	{
+	  pas_DeclareFile();
+	  if (token != ';') break;
+	  else getToken();
+	}
+      else break;
+    }
+}
+
+/***************************************************************/
+/* Process formal-parameter-list */
+
+sint16 formalParameterList(STYPE *procPtr)
+{
+  sint16 parameterOffset;
+  sint16 i;
+  boolean pointerType;
+
+  TRACE(lstFile,"[formalParameterList]");
+
+  /* FORM: formal-parameter-list =
+   *       '(' formal-parameter-section { ';' formal-parameter-section } ')'
+   * FORM: formal-parameter-section =
+   *       value-parameter-specification |
+   *       variable-parameter-specification |
+   *       procedure-parameter-specification |
+   *       function-parameter-specification
+   * FORM: value-parameter-specification =
+   *       identifier-list ':' type-identifier
+   * FORM: variable-parameter-specification =
+   *       'var' identifier-list ':' type-identifier
+   *
+   * On entry token should refer to the '(' at the beginning of the
+   * (optional) formal parameter list.
+   */
+
+  g_nParms = 0;
+
+  /* Check if the formal-parameter-list is present.  It is optional in
+   * all contexts in which this function is called.
+   */
+
+  if (token == '(')
+    {
+      /* Process each formal-parameter-section */
+
+      do
+	{
+	  getToken();
+
+	  /* Check for variable-parameter-specification */
+
+	  if (token == tVAR)
+	    {
+	      pointerType = 1;
+	      getToken();
+	    } 
+	  else pointerType = 0;
+
+	  /* Process the common part of the variable-parameter-specification
+	   * and the value-parameter specification.
+	   * NOTE that procedure-parameter-specification and
+	   * function-parameter-specification are not yet supported.
+	   */
+
+	  (void)pas_DeclareParameter(pointerType);
+
+	}
+      while (token == ';');
+
+      /* Verify that the formal parameter list terminates with a
+       * right parenthesis.
+       */
+
+      if (token != ')') error (eRPAREN);
+      else getToken();
+
+    }
+
+  /* Save the number of parameters found in sPROC/sFUNC symbol table entry */
+
+  procPtr->sParm.p.nParms = g_nParms;
+
+  /* Now, calculate the parameter offsets from the size of each parameter */
+
+  parameterOffset = -sRETURN_SIZE;
+  for (i = g_nParms; i > 0; i--)
+    {
+      /* The offset to the next parameter is the offset to the previous
+       * parameter minus the size of the new parameter (aligned to
+       * multiples of size of INTEGER).
+       */
+
+      parameterOffset -= procPtr[i].sParm.v.size;
+      parameterOffset  = intAlign(parameterOffset);
+      procPtr[i].sParm.v.offset = parameterOffset;
+    }
+
+  return parameterOffset;
+}
+
+/***************************************************************
+ * Private Functions
+ ***************************************************************/
+/* Process LABEL block */
+
+static void pas_DeclareLabel(void)
+{
+   char   *labelname;                   /* Label symbol table name */
+
+   TRACE(lstFile,"[pas_DeclareLabel]");
+
+   /* FORM:  LABEL <integer>[,<integer>[,<integer>][...]]]; */
+
+   do
+     {
+       getToken();
+       if ((token == tINT_CONST) && (tknInt >= 0))
+	 {
+	   labelname = stringSP;
+	   (void)sprintf (labelname, "%ld", tknInt);
+	   while (*stringSP++);
+	   (void)addLabel(labelname, ++label);
+	   getToken();
+	 }
+       else error(eINTCONST);
+     }
+   while (token == ',');
+
+   if (token != ';') error (eSEMICOLON);
+   else getToken();
+}
+
+/***************************************************************/
+/* Process constant definition:
+ * FORM: constant-definition = identifier '=' constant
+ * FORM: constant = [ sign ] integer-number |
+ *                  [ sign ] real-number |
+ *                  [ sign ] constant-identifier |
+ *                           character-literal |
+ *                           string-literal
+ */
+
+static void pas_DeclareConst(void)
+{
+  char *const_name;
+
+  TRACE(lstFile,"[pas_DeclareConst]");
+
+  /* FORM:  <identifier> = <numeric constant|string>
+   * NOTE:  Only integer constants are supported
+   */
+
+  /* Save the name of the constant */
+
+  const_name = tkn_strt;
+
+  /* Verify that the name is followed by '=' and get the
+   * following constant value.
+   */
+
+  getToken();
+  if (token != '=') error (eEQ);
+  else getToken();
+
+  /* Handle constant expressions */
+
+  constantExpression();
+
+  /* Add the constant to the symbol table based on the type of
+   * the constant found following the '= [ sign ]'
+   */
+
+  switch (constantToken)
+    {
+    case tINT_CONST :
+    case tCHAR_CONST :
+    case tBOOLEAN_CONST :
+    case sSCALAR_OBJECT :
+      (void)addConstant(const_name, constantToken, &constantInt, NULL);
+      break;
+
+    case tREAL_CONST :
+      (void)addConstant(const_name, constantToken, (sint32*)&constantReal, NULL);
+      break;
+
+    case tSTRING_CONST :
+      {
+	uint32 offset = poffAddRoDataString(poffHandle, constantStart);
+	(void)addStringConst(const_name, offset, strlen(constantStart));
+      }
+      break;
+
+    default :
+      error(eINVCONST);
+    }
+}
+
+/***************************************************************/
+/* Process TYPE declaration */
+
+static STYPE *pas_DeclareType(char *typeName)
+{
+  STYPE *typePtr;
+
+  TRACE(lstFile,"[pas_DeclareType]");
+
+  /* This function processes the type-denoter in
+   * FORM: type-definition = identifier '=' type-denoter
+   * FORM: array-type = 'array' '[' index-type-list ']' 'of' type-denoter
+   */
+
+  /* FORM: type-denoter = type-identifier | new-type
+   * FORM: new-type = new-ordinal-type | new-complex-type
+   */
+
+  typePtr = pas_NewComplexType(typeName);
+  if (typePtr == NULL)
+    {
+      /* Check for Simple Types */
+
+      typePtr = pas_DeclareOrdinalType(typeName);
+      if (typePtr == NULL)
+	{
+	  error(eINVTYPE);
+	}
+    }
+
+  return typePtr;
+}
+
+/***************************************************************/
+/* Process a simple TYPE declaration */
+
+static STYPE *pas_DeclareOrdinalType(char *typeName)
+{
+  STYPE *typePtr;
+  STYPE *typeIdPtr;
+
+  /* Declare a new ordinal type */
+
+  typePtr = pas_NewOrdinalType(typeName);
+
+  /* Otherwise, declare a type equivalent to a previously defined type
+   * NOTE: the following logic is incomplete.  Its is only good for
+   * sKind == sType
+   */
+
+  if (typePtr == NULL)
+     {
+       typeIdPtr = pas_TypeIdentifier(1);
+       if (typeIdPtr)
+	 {
+	   typePtr = addTypeDefine(typeName, typeIdPtr->sParm.t.type,
+				    g_dwVarSize, typeIdPtr);
+	 }
+     }
+
+   return typePtr;
+}
+
+/***************************************************************/
+/* Process VAR declaration */
+
+static STYPE *pas_DeclareVar(void)
+{
+  STYPE *varPtr;
+  STYPE *typePtr;
+  char  *varName;
+
+  TRACE(lstFile,"[pas_DeclareVar]");
+
+  /* FORM: variable-declaration = identifier-list ':' type-denoter
+   * FORM: identifier-list = identifier { ',' identifier }
+   */
+
+  typePtr  = NULL;
+
+  /* Save the current identifier */
+
+  varName = tkn_strt;
+  getToken();
+
+  /* A comma indicates that there is another indentifier int the
+   * identifier-list
+   */
+
+  if (token == ',')
+    {
+      /* Yes ..Process the next identifer in the indentifier list
+       * via recursion
+       */
+
+      getToken();
+      if (token != tIDENT) error(eIDENT);
+      else typePtr = pas_DeclareVar();
+    }
+  else
+    {
+      /* No.. verify that the identifer-list is followed by ';' */
+
+      if (token != ':') error(eCOLON);
+      else getToken();
+
+      /* Process the type-denoter */
+
+      typePtr = pas_TypeDenoter(varName, 1);
+      if (typePtr == NULL)
+	{
+	  error(eINVTYPE);
+	}
+    }
+
+  if (typePtr)
+    {
+      ubyte varType = typePtr->sParm.t.type;
+
+      /* Determine if alignment to INTEGER boundaries is necessary */
+
+      if ((!isIntAligned(dstack)) && (pas_IntAlignRequired(typePtr)))
+	dstack = intAlign(dstack);
+
+      /* Add the new variable to the symbol table */
+
+      varPtr = addVariable(varName, varType, dstack, g_dwVarSize, typePtr);
+
+      /* If the variable is declared in an interface section at level zero,
+       * then it is a candidate to imported or exported.
+       */
+
+      if ((!level) && (FP->section == eIsInterfaceSection))
+	{
+	  /* Are we importing or exporting the interface?
+	   *
+	   * PROGRAM EXPORTS:
+	   * If we are generating a program binary (i.e., FP0->kind ==
+	   * eIsProgram) then the variable memory allocation must appear
+	   * on the initial stack allocation; therefore the variable
+	   * stack offset myst be exported by the program binary.
+	   *
+	   * UNIT IMPORTS:
+	   * If we are generating a unit binary (i.e., FP0->kind ==
+	   * eIsUnit), then we are importing the level 0 stack offset
+	   * from the main program.
+	   */
+
+	  if (FP0->kind == eIsUnit)
+	    {
+	      /* Mark the symbol as external and replace the absolute
+	       * offset with this relative offset.
+	       */
+
+	      varPtr->sParm.v.flags  |= SVAR_EXTERNAL;
+	      varPtr->sParm.v.offset  = dstack - FP->dstack;
+
+	      /* IMPORT the symbol; assign an offset relative to
+	       * the dstack at the beginning of this file
+	       */
+ 
+	      pas_GenerateStackImport(varPtr);
+	    }
+	  else /* if (FP0->kind == eIsProgram) */
+	    {
+	      /* EXPORT the symbol */
+
+	      pas_GenerateStackExport(varPtr);
+	    }
+	}
+
+      /* In any event, bump the stack offset to include space for 
+       * this new symbol.  The 'bumped' stack offset will be the
+       * offset for the next variable that is declared.
+       */
+
+      dstack += g_dwVarSize;
+    }
+
+  return typePtr;
+}
+
+/***************************************************************/
+/* Process VAR FILE OF declaration */
+
+static void pas_DeclareFile(void)
+{
+   sint16 fileNumber = tknPtr->sParm.fileNumber;
+   STYPE *filePtr;
+
+   TRACE(lstFile,"[pas_DeclareFile]");
+
+   /* FORM:  <file identifier> : FILE OF <type> */
+   /* OR:    <file identifier> : <FILE OF type identifier> */
+   if (!(fileNumber)) error(eINVFILE);
+   else if (files [fileNumber].defined) error(eDUPFILE);
+   else {
+
+     /* Skip over the <file identifier> */
+     getToken();
+
+     /* Verify that a colon follows the <file identifier> */
+     if (token != ':') error (eCOLON);
+     else getToken();
+
+     /* Make sure that the data stack is aligned to INTEGER boundaries */
+     dstack = intAlign(dstack);
+
+     /* FORM:  <file identifier> : FILE OF <type> */
+     if (token == sFILE_OF) {
+
+       files[fileNumber].defined = -1;
+       files[fileNumber].flevel  = level;
+       files[fileNumber].ftype   = tknPtr->sParm.t.type;
+       files[fileNumber].faddr   = dstack;
+       files[fileNumber].fsize   = tknPtr->sParm.t.asize;
+       dstack += (tknPtr->sParm.t.asize);
+       getToken();
+
+     }
+
+     /* FORM:  <file identifier> : <FILE OF type identifier> */
+     else {
+       if (token != tFILE) error (eFILE);
+       else getToken();
+       if (token != tOF) error (eOF);
+       else getToken();
+
+       filePtr = pas_TypeIdentifier(1);
+       if (filePtr) {
+
+	 files[fileNumber].defined = -1;
+	 files[fileNumber].flevel  = level;
+	 files[fileNumber].ftype   = filePtr->sParm.t.type;
+	 files[fileNumber].faddr   = dstack;
+	 files[fileNumber].fsize   = g_dwVarSize;
+	 dstack += g_dwVarSize;
+
+       }
+     }
+   }
+}
+
+/***************************************************************/
+/* Process Procedure Declaration Block */
+
+static void pas_ProcedureDeclaration(void)
+{
+   uint16 procLabel = ++label;
+   char    *saveStringSP;
+   STYPE   *procPtr;
+   register int i;
+
+   TRACE(lstFile,"[pas_ProcedureDeclaration]");
+
+   /* FORM: procedure-declaration =
+    *       procedure-heading ';' directive |
+    *       procedure-heading ';' procedure-block
+    * FORM: procedure-heading =
+    *       'procedure' identifier [ formal-parameter-list ]
+    * FORM: procedure-identifier = identifier
+    *
+    * On entry, token refers to token AFTER the 'procedure' reserved
+    * word.
+    */
+
+   /* Process the procedure-heading */
+
+   if (token != tIDENT)
+     {
+       error (eIDENT);
+       return;
+     }
+
+   /* Add the procedure to the symbol table */
+
+   procPtr = addProcedure(tkn_strt, sPROC, procLabel, 0, NULL);
+
+   /* Save the string stack pointer so that we can release all
+    * formal parameter strings later.  Then get the next token.
+    */
+
+   saveStringSP = stringSP;
+   getToken();
+
+   /* NOTE:  The level associated with the PROCEDURE symbol is the level
+    * At which the procedure was declared.  Everything declare within the
+    * PROCEDURE is at the next level
+    */
+
+   level++;
+
+   /* Process parameter list */
+
+   (void)formalParameterList(procPtr);
+
+   if (token !=  ';') error (eSEMICOLON);
+   else getToken();
+
+   /* If we are here then we know that we are either in a program file
+    * or the 'implementation' part of a unit file (see punit.c -- At present,
+    * the procedure declarations of the 'interface' section of a unit file
+    * follow a different path).  In the latter case (only), we should export
+    * every procedure declared at level zero.
+    */
+
+   if ((level == 1) && (FP->kind == eIsUnit))
+     {
+       /* EXPORT the procedure symbol. */
+
+       pas_GenerateProcExport(procPtr);
+     }
+
+   /* Save debug information about the procedure */
+
+   pas_GenerateDebugInfo(procPtr, 0);
+
+   /* Process block */
+
+   pas_GenerateDataOperation(opLABEL, (sint32)procLabel);
+   block();
+
+   /* Destroy formal parameter names */
+
+   for (i = 1; i <= procPtr->sParm.p.nParms; i++)
+     {
+       procPtr[i].sName = NULL;
+     }
+
+   stringSP = saveStringSP;
+
+   /* Generate exit from procedure */
+
+   pas_GenerateSimple(opRET);
+   level--;
+
+   /* Verify that END terminates with a semicolon */
+
+   if (token !=  ';') error (eSEMICOLON);
+   else getToken();
+}
+
+/***************************************************************/
+/* Process Function Declaration Block */
+
+static void pas_FunctionDeclaration(void)
+{
+   uint16 funcLabel = ++label;
+   sint16  parameterOffset;
+   char    *saveStringSP;
+   STYPE   *funcPtr;
+   STYPE   *valPtr;
+   STYPE   *typePtr;
+   char    *funcName;
+   register int i;
+
+   TRACE(lstFile,"[pas_FunctionDeclaration]");
+
+   /* FORM: function-declaration =
+    *       function-heading ';' directive |
+    *       function-heading ';' function-block
+    * FORM: function-heading =
+    *       'function' function-identifier [ formal-parameter-list ]
+    *       ':' result-type
+    *
+    * On entry token should lrefer to the function-identifier.
+    */
+
+   /* Verify function-identifier */
+
+   if (token != tIDENT)
+     {
+       error (eIDENT);
+       return;
+     }
+
+   funcPtr = addProcedure(tkn_strt, sFUNC, funcLabel, 0, NULL);
+
+   /* NOTE:  The level associated with the FUNCTION symbol is the level
+    * At which the procedure was declared.  Everything declare within the
+    * PROCEDURE is at the next level
+    */
+
+   level++;
+
+   /* Save the string stack pointer so that we can release all
+    * formal parameter strings later.  Then get the next token.
+    */
+
+   funcName = tkn_strt;
+   saveStringSP = stringSP;
+   getToken();
+
+   /* Process parameter list */
+
+   parameterOffset = formalParameterList(funcPtr);
+
+   /* Verify that the parameter list is followed by a colon */
+
+   if (token !=  ':') error (eCOLON);
+   else getToken();
+
+   /* Declare the function return value variable.  This variable has
+    * the same name as the function itself.  We fill the variable
+    * symbol descriptor with bogus information now (but we fix it
+    * below).
+    */
+
+   valPtr  = addVariable(funcName, sINT, 0, sINT_SIZE, NULL);
+
+   /* Get function type, return value type/size and offset to return value */
+
+   typePtr = pas_TypeIdentifier(0);
+   if (typePtr) {
+
+     /* The offset to the return value is the offset to the last
+      * parameter minus the size of the return value (aligned to
+      * multiples of size of INTEGER).
+      */
+
+     parameterOffset        -= g_dwVarSize;
+     parameterOffset         = intAlign(parameterOffset);
+
+     /* Save the TYPE for the function return value local variable */
+
+     valPtr->sKind           = typePtr->sParm.t.rtype;
+     valPtr->sParm.v.offset  = parameterOffset;
+     valPtr->sParm.v.size    = g_dwVarSize;
+     valPtr->sParm.v.parent  = typePtr;
+
+     /* Save the TYPE for the function */
+
+     funcPtr->sParm.p.parent = typePtr;
+
+     /* If we are here then we know that we are either in a program file
+      * or the 'implementation' part of a unit file (see punit.c -- At present,
+      * the function declarations of the 'interface' section of a unit file
+      * follow a different path).  In the latter case (only), we should export
+      * every function declared at level zero.
+      */
+
+     if ((level == 1) && (FP->kind == eIsUnit))
+       {
+	 /* EXPORT the function symbol. */
+
+	 pas_GenerateProcExport(funcPtr);
+       }
+   }
+   else
+     error(eINVTYPE);
+
+   /* Save debug information about the function */
+
+   pas_GenerateDebugInfo(funcPtr, g_dwVarSize);
+
+   /* Process block */
+
+   if (token !=  ';') error (eSEMICOLON);
+   else getToken();
+
+   pas_GenerateDataOperation(opLABEL, (sint32)funcLabel);
+   block();
+
+   /* Destroy formal parameter names and the function return value name */
+
+   for (i = 1; i <= funcPtr->sParm.p.nParms; i++)
+     {
+       funcPtr[i].sName = ((char *) NULL);
+     }
+
+   valPtr->sName = ((char *) NULL);
+   stringSP = saveStringSP;
+
+   /* Generate exit from procedure/function */
+
+   pas_GenerateSimple(opRET);
+   level--;
+
+   /* Verify that END terminates with a semicolon */
+
+   if (token !=  ';') error (eSEMICOLON);
+   else getToken();
+}
+
+/***************************************************************/
+/* Determine the size value to use with this type */
+
+static void pas_SetTypeSize(STYPE *typePtr, boolean allocate)
+{
+  TRACE(lstFile,"[pas_SetTypeSize]");
+
+  /* Check for type-identifier */
+
+  g_dwVarSize = 0;
+
+  if (typePtr != NULL)
+    {
+      /* If allocate is TRUE, then we want to return the size of
+       * the type that we would use if we are going to allocate
+       * an instance on the stack.
+       */
+
+      if (allocate)
+	{
+	  /* Could it be a storage size value (such as is used for
+	   * the enhanced pascal string type?).  In an weak attempt to
+	   * be compatible with everyone in the world, we will allow
+	   * either '[]' or '()' to delimit the size specification.
+	   */
+
+	  if (((token == '[') || (token == '(')) &&
+	      ((typePtr->sParm.t.flags & STYPE_VARSIZE) != 0))
+	    {
+	      uint16 term_token;
+	      uint16 errcode;
+
+	      /* Yes... we need to parse the size from the input stream.
+	       * First, determine which token will terminate the size
+	       * specification.
+	       */
+
+	      if (token == '(')
+		{
+		  term_token = ')';    /* Should end with ')' */
+		  errcode = eRPAREN;   /* If not, this is the error */
+		}
+	      else
+		{
+		  term_token = ']';    /* Should end with ']' */
+		  errcode = eRBRACKET; /* If not, this is the error */
+		}
+
+	      /* Now, parse the size specification */
+
+	      /* We expect the size to consist of a single integer constant.
+	       * We should support any constant integer expression, but this
+	       * has not yet been implemented.
+	       */
+
+	      getToken();
+	      if (token != tINT_CONST) error(eINTCONST);
+	      /* else if (tknInt <= 0) error(eINVCONST); see below */
+	      else if (tknInt <= 2) error(eINVCONST);
+	      else
+		{
+		  /* Use the value of the integer constant for the size
+		   * the allocation.  NOTE:  There is a problem here in
+		   * that for the sSTRING type, it wants the first 2 bytes
+		   * for the string length.  This means that the actual
+		   * length is real two less than the specified length.
+		   */
+
+		  g_dwVarSize = tknInt;
+		}
+
+	      /* Verify that the correct token terminated the size
+	       * specification.  This could be either ')' or ']'
+	       */
+
+	      getToken();
+	      if (token != term_token) error(errcode);
+	      else getToken();
+	    }
+	  else
+	    {
+	      /* Return the fixed size of the allocated instance of
+	       * this type */
+
+	      g_dwVarSize = typePtr->sParm.t.asize;
+	    }
+	}
+
+      /* If allocate is FALSE, then we want to return the size of
+       * the type that we would use if we are going to refer to
+       * a reference on the stack.  This is really non-standard
+       * and is handle certain optimatizations where we cheat and
+       * pass some types by reference rather than by value.  The
+       * enhanced pascal string type is the only example at present.
+       */
+
+      else
+	{
+	  /* Return the size to a clone, reference to an instance */
+
+	  g_dwVarSize = typePtr->sParm.t.rsize;
+	}
+    }
+}
+
+/***************************************************************/
+/* Verify that the next token is a type identifer
+ * NOTE:  This function modifies the global variable g_dwVarSize
+ * as a side-effect
+ */
+
+static STYPE *pas_TypeIdentifier(boolean allocate)
+{
+  STYPE *typePtr = NULL;
+
+  TRACE(lstFile,"[pas_TypeIdentifier]");
+
+  /* Check for type-identifier */
+
+  if (token == sTYPE)
+    {
+      /* Return a reference to the type token. */
+
+      typePtr = tknPtr;
+      getToken();
+
+      /* Return the size value associated with this type */
+
+      pas_SetTypeSize(typePtr, allocate);
+    }
+
+  return typePtr;
+}
+
+/***************************************************************/
+
+static STYPE *pas_TypeDenoter(char *typeName, boolean allocate)
+{
+  STYPE *typePtr;
+
+  TRACE(lstFile,"[pas_TypeDenoter]");
+
+  /* FORM: type-denoter = type-identifier | new-type
+   *
+   * Check for type-identifier
+   */
+
+  typePtr = pas_TypeIdentifier(allocate);
+  if (typePtr != NULL)
+    {
+      /* Return the type identifier */
+
+      return typePtr;
+    }
+
+  /* Check for new-type
+   * FORM: new-type = new-ordinal-type | new-complex-type
+   */
+
+  /* Check for new-complex-type */
+
+  typePtr = pas_NewComplexType(typeName);
+  if (typePtr == NULL)
+    {
+      /* Check for new-ordinal-type */
+
+      typePtr = pas_NewOrdinalType(typeName);
+    }
+
+  /* Return the size value associated with this type */
+
+  pas_SetTypeSize(typePtr, allocate);
+
+  return typePtr;
+}
+
+/***************************************************************/
+/* Declare is new ordinal type */
+
+static STYPE *pas_NewOrdinalType(char *typeName)
+{
+  STYPE *typePtr = NULL;
+
+  /* Declare a new-ordinal-type
+   * FORM: new-ordinal-type = enumerated-type | subrange-type
+   */
+
+  /* FORM: enumerated-type = '(' enumerated-constant-list ')' */
+
+   if (token == '(')
+     {
+       sint32 nObjects;
+       nObjects = 0;
+       typePtr = addTypeDefine(typeName, sSCALAR, sINT_SIZE, NULL);
+
+       /* Now declare each instance of the scalar */
+
+       do {
+	 getToken();
+	 if (token != tIDENT) error(eIDENT);
+	 else
+	   {
+	     (void)addConstant(tkn_strt, sSCALAR_OBJECT, &nObjects, typePtr);
+	     nObjects++;
+	     getToken();
+	   }
+       } while (token == ',');
+
+       /* Save the number of objects associated with the scalar type (the
+	* maximum ORD is nObjects - 1). */
+
+       typePtr->sParm.t.maxValue = nObjects - 1;
+
+       if (token != ')') error(eRPAREN);
+       else getToken();
+
+     }
+
+   /* Declare a new subrange type
+    * FORM: subrange-type = constant '..' constant
+    * FORM: constant =
+    *    [ sign ] integer-number |  [ sign ] real-number |
+    *    [ sign ] constant-identifier | character-literal | string-literal
+    *
+    * Case 1: <constant> is INTEGER
+    */
+
+   else if (token == tINT_CONST)
+     {
+       /* Create the new INTEGER subrange type */
+
+       typePtr = addTypeDefine(typeName, sSUBRANGE, sINT_SIZE, NULL);
+       typePtr->sParm.t.subType  = sINT;
+       typePtr->sParm.t.minValue = tknInt;
+       typePtr->sParm.t.maxValue = MAXINT;
+
+       /* Verify that ".." separates the two constants */
+
+       getToken();
+       if (token != tSUBRANGE) error(eSUBRANGE);
+       else getToken();
+
+       /* Verify that the ".." is following by an INTEGER constant */
+
+       if ((token != tINT_CONST) || (tknInt < typePtr->sParm.t.minValue))
+	 error(eSUBRANGETYPE);
+       else
+	 {
+	   typePtr->sParm.t.maxValue = tknInt;
+	   getToken();
+	 }
+     }
+
+   /* Case 2: <constant> is CHAR */
+
+   else if (token == tCHAR_CONST)
+     {
+       /* Create the new CHAR subrange type */
+
+       typePtr = addTypeDefine(typeName, sSUBRANGE, sCHAR_SIZE, NULL);
+       typePtr->sParm.t.subType  = sCHAR;
+       typePtr->sParm.t.minValue = tknInt;
+       typePtr->sParm.t.maxValue = MAXCHAR;
+
+       /* Verify that ".." separates the two constants */
+
+       getToken();
+       if (token != tSUBRANGE) error(eSUBRANGE);
+       else getToken();
+
+       /* Verify that the ".." is following by a CHAR constant */
+
+       if ((token != tCHAR_CONST) || (tknInt < typePtr->sParm.t.minValue))
+	 error(eSUBRANGETYPE);
+       else
+	 {
+	   typePtr->sParm.t.maxValue = tknInt;
+	   getToken();
+	 }
+     }
+
+   /* Case 3: <constant> is a SCALAR type */
+
+   else if (token == sSCALAR_OBJECT)
+     {
+       /* Create the new SCALAR subrange type */
+
+       typePtr = addTypeDefine(typeName, sSUBRANGE, sINT_SIZE, tknPtr);
+       typePtr->sParm.t.subType  = token;
+       typePtr->sParm.t.minValue = tknInt;
+       typePtr->sParm.t.maxValue = MAXINT;
+
+       /* Verify that ".." separates the two constants */
+
+       getToken();
+       if (token != tSUBRANGE) error(eSUBRANGE);
+       else getToken();
+
+       /* Verify that the ".." is following by a SCALAR constant of the same
+	* type as the one which preceded it
+	*/
+
+       if ((token != sSCALAR_OBJECT) ||
+	   (tknPtr != typePtr->sParm.t.parent) ||
+	   (tknPtr->sParm.c.val.i < typePtr->sParm.t.minValue))
+	 error(eSUBRANGETYPE);
+       else
+	 {
+	   typePtr->sParm.t.maxValue = tknPtr->sParm.c.val.i;
+	   getToken();
+	 }
+     }
+
+   return typePtr;
+}
+
+/***************************************************************/
+
+static STYPE *pas_NewComplexType(char *typeName)
+{
+  STYPE *typePtr = NULL;
+  STYPE *typeIdPtr;
+
+  TRACE(lstFile,"[pas_TypeDenoter]");
+
+  /* FORM: new-complex-type = new-structured-type | new-pointer-type */
+
+  switch (token)
+    {
+      /* FORM: new-pointer-type = '^' domain-type | '@' domain-type */
+
+    case '^'      :
+      getToken();
+      typeIdPtr = pas_TypeIdentifier(1);
+      if (typeIdPtr)
+	{
+	  typePtr = addTypeDefine(typeName, sPOINTER, g_dwVarSize, typeIdPtr);
+	}
+      else
+	{
+	  error(eINVTYPE);
+	}
+      break;
+
+      /* FORM: new-structured-type =
+       *     [ 'packed' ] array-type | [ 'packed' ] record-type |
+       *     [ 'packed' ] set-type   | [ 'packed' ] file-type |
+       *     [ 'packed' ] list-type  | object-type | string-type
+       */
+
+      /* PACKED Types */
+
+    case tPACKED :
+      error (eNOTYET);
+      getToken();
+      if (token != tARRAY) break;
+      /* Fall through to process PACKED ARRAY type */
+
+      /* Array Types
+       * FORM: array-type = 'array' [ index-type-list ']' 'of' type-denoter
+       */
+
+    case tARRAY :
+      getToken();
+      typeIdPtr = pas_GetArrayType();
+      if (typeIdPtr)
+	{
+	  typePtr = addTypeDefine(typeName, sARRAY, g_dwVarSize, typeIdPtr);
+	}
+      else
+	{
+	  error(eINVTYPE);
+	}
+      break;
+
+      /* RECORD Types
+       * FORM: record-type = 'record' field-list 'end'
+       */
+
+    case tRECORD :
+      getToken();
+      typePtr = pas_DeclareRecord(typeName);
+      break;
+
+      /* Set Types
+       *
+       * FORM: set-type = 'set' 'of' ordinal-type
+       */
+
+    case tSET :
+
+      /* Verify that 'set' is followed by 'of' */
+
+      getToken();
+      if (token != tOF) error (eOF);
+      else getToken();
+
+      /* Verify that 'set of' is followed by an ordinal-type
+       * If not, then declare a new one with no name
+       */
+
+      typeIdPtr = pas_OrdinalTypeIdentifier(1);
+      if (typeIdPtr)
+	getToken();
+      else
+	typeIdPtr = pas_DeclareOrdinalType(NULL);
+
+      /* Verify that the ordinal-type is either a scalar or a 
+       * subrange type.  These are the only valid types for 'set of'
+       */
+
+      if ((typeIdPtr) &&
+	  ((typeIdPtr->sParm.t.type == sSCALAR) ||
+	   (typeIdPtr->sParm.t.type == sSUBRANGE)))
+	{
+	  /* Declare the SET type */
+
+	  typePtr = addTypeDefine(typeName, sSET_OF,
+				  typeIdPtr->sParm.t.asize, typeIdPtr);
+
+	  if (typePtr)
+	    {
+	      sint16 nObjects;
+
+	      /* Copy the scalar/subrange characteristics for convenience */
+
+	      typePtr->sParm.t.subType  = typeIdPtr->sParm.t.type;
+	      typePtr->sParm.t.minValue = typeIdPtr->sParm.t.minValue;
+	      typePtr->sParm.t.maxValue = typeIdPtr->sParm.t.minValue;
+
+	      /* Verify that the number of objects associated with the
+	       * scalar or subrange type will fit into an integer
+	       * representation of a set as a bit-string.
+	       */
+
+	      nObjects = typeIdPtr->sParm.t.maxValue
+		- typeIdPtr->sParm.t.minValue + 1;
+	      if (nObjects > BITS_IN_INTEGER)
+		{
+		  error(eSETRANGE);
+		  typePtr->sParm.t.maxValue = typePtr->sParm.t.minValue
+		    + BITS_IN_INTEGER - 1;
+		}
+	    }
+	}
+      else
+	error(eSET);
+      break;
+ 
+      /* File Types
+       * FORM: file-type = 'file' 'of' type-denoter
+       */
+
+      /* FORM: file-type = 'file' 'of' type-denoter */
+
+    case tFILE :
+
+      /* Make sure that 'file' is followed by 'of' */
+
+      getToken();
+      if (token != tOF) error (eOF);
+      else getToken();
+
+      /* Get the type-denoter */
+
+      typeIdPtr = pas_TypeDenoter(NULL,1);
+      if (typeIdPtr)
+	{
+	  typePtr = addTypeDefine(typeName, sFILE_OF, g_dwVarSize, typeIdPtr);
+	  if (typePtr)
+	    {
+	      typePtr->sParm.t.subType = typeIdPtr->sParm.t.type;
+	    }
+	}
+      else
+	{
+	  error(eINVTYPE);
+	}
+      break;
+
+      /* FORM: string-type = pascal-string-type | c-string-type
+       * FORM: pascal-string-type = 'string' [ max-string-length ]
+       */
+    case sSTRING :
+      error (eNOTYET);
+      getToken();
+      break;
+
+      /* FORM: list-type = 'list' 'of' type-denoter */
+      /* FORM: object-type = 'object' | 'class' */
+    default :
+      break;
+
+   }
+
+  return typePtr;
+}
+
+/***************************************************************/
+/* Verify that the next token is a type identifer
+ */
+
+static STYPE *pas_OrdinalTypeIdentifier(boolean allocate)
+{
+  STYPE *typePtr;
+
+  TRACE(lstFile,"[pas_OrdinalTypeIdentifier]");
+
+  /* Get the next type from the input stream */
+
+  typePtr = pas_TypeIdentifier(allocate);
+
+  /* Was a type encountered? */
+
+  if (typePtr != NULL)
+    {
+      switch (typePtr->sParm.t.type)
+	{
+	  /* Check for an ordinal type (verify this list!) */
+
+	case sINT :
+	case sBOOLEAN :
+	case sCHAR :
+	case sSCALAR :
+	case sSUBRANGE:
+	  /* If it is an ordinal type, then just return the
+	   * type pointer.
+	   */
+
+	  break;
+	default :
+	  /* If not, return NULL */
+
+	  typePtr = NULL;
+	  break;
+	}
+    }
+  return typePtr;
+}
+
+/***************************************************************/
+/* get array type argument for TYPE block or variable declaration */
+
+static STYPE *pas_GetArrayType(void)
+{
+   STYPE *typePtr = NULL;
+
+   TRACE(lstFile,"[pas_GetArrayType]");
+
+   /* FORM: array-type = 'array' '[' index-type-list ']' 'of' type-denoter */
+   /* FORM: [PACKED] ARRAY [<integer>] OF type-denoter
+    * NOTE: Bracketed value is the array size!  NONSTANDARD! */
+
+   g_dwVarSize = 0;
+
+   /* Verify that the index-type-list is preceded by '[' */
+
+   if (token != '[') error (eLBRACKET);
+   else
+     {
+       /* FORM: index-type-list = index-type { ',' index-type }
+	* FORM: index-type = ordinal-type
+	*/
+
+       getToken();
+       if (token != tINT_CONST) error (eINTCONST);
+       else
+	 {
+	   g_dwVarSize = tknInt;
+	   getToken();
+
+	   /* Verify that the index-type-list is followed by ']' */
+
+	   if (token != ']') error (eRBRACKET);
+	   else getToken();
+
+	   /* Verify that 'of' precedes the type-denoter */
+
+	   if (token != tOF) error (eOF);
+	   else getToken();
+
+	   /* We have the array size in elements, not get the type and convert
+	    * the size for the type found
+	    */
+
+	   typePtr = pas_DeclareType(NULL);
+	   if (typePtr)
+	     {
+	       g_dwVarSize *= typePtr->sParm.t.asize;
+	     }
+	 }
+     }
+
+   return typePtr;
+}
+
+/***************************************************************/
+
+static STYPE *pas_DeclareRecord(char *recordName)
+{
+  STYPE *recordPtr;
+  sint16 recordOffset;
+  int recordCount, symbolIndex;
+
+  TRACE(lstFile,"[pas_DeclareRecord]");
+
+  /* FORM: record-type = 'record' field-list 'end' */
+
+  /* Declare the new RECORD type */
+
+  recordPtr = addTypeDefine(recordName, sRECORD, 0, NULL);
+
+  /* Then declare the field-list associated with the RECORD
+   * FORM: field-list =
+   *       [
+   *         fixed-part [ ';' ] variant-part [ ';' ] |
+   *         fixed-part [ ';' ] |
+   *         variant-part [ ';' ] |
+   *       ]
+   *
+   * Process the fixed-part first.
+   * FORM: fixed-part = record-section { ';' record-section }
+   * FORM: record-section = identifier-list ':' type-denoter
+   * FORM: identifier-list = identifier { ',' identifier }
+   */
+
+  for (;;)
+    {
+      /* Terminate parsing of the fixed-part when we encounter
+       * 'case' indicating the beginning of the variant part of
+       * the record.  If there is no fixed-part, then 'case' will
+       * appear immediately.
+       */
+
+      if (token == tCASE) break;
+
+      /* We now expect to see and indentifier representating the
+       * beginning of the next fixed field.
+       */
+
+      (void)pas_DeclareField(recordPtr);
+
+      /* If the field declaration terminates with a semicolon, then
+       * we expect to see another <fixed part> declaration in the
+       * record.
+       */
+
+      if (token == ';')
+	{
+	  /* Skip over the semicolon and process the next fixed
+	   * field declaration.
+	   */
+
+	  getToken();
+
+	  /* We will treat this semi colon as optional.  If we
+	   * hit 'end' or 'case' after the semicolon, then we
+	   * will terminate the fixed part with no complaint.
+	   */
+
+	  if ((token == tEND) || (token == tCASE))
+	    break;
+	}
+
+      /* If there is no semicolon after the field declaration,
+       * then 'end' or 'case' is expected.  This will be verified
+       * below.
+       */
+
+      else break;
+    }
+
+  /* Get the total size of the RECORD type and the offset of each
+   * field within the RECORD.
+   */
+
+  for (recordOffset = 0, symbolIndex = 1, recordCount = 0;
+       recordCount < recordPtr->sParm.t.maxValue;
+       symbolIndex++)
+    {
+      /* We know that 'maxValue' sRECORD_OBJECT symbols follow the sRECORD
+       * type declaration.  However, these may not be sequential due to the
+       * possible declaration of sTYPEs associated with each field.
+       */
+
+      if (recordPtr[symbolIndex].sKind == sRECORD_OBJECT)
+	{
+	  /* Align the recordOffset (if necessary) */
+
+	  if ((!isIntAligned(recordOffset)) &&
+	      (pas_IntAlignRequired(recordPtr[symbolIndex].sParm.r.parent)))
+	    recordOffset = intAlign(recordOffset);
+
+	  /* Save the offset associated with this field, and determine the
+	   * offset to the next field (if there is one)
+	   */
+
+	  recordPtr[symbolIndex].sParm.r.offset = recordOffset;
+	  recordOffset += recordPtr[symbolIndex].sParm.r.size;
+	  recordCount++;
+	}
+    } 
+
+  /* Update the RECORD entry for the total size of all fields */
+
+  recordPtr->sParm.t.asize = recordOffset;
+
+  /* Now we are ready to process the variant-part.
+   * FORM: variant-part = 'case' variant-selector 'of' variant-body
+   */
+
+  if (token == tCASE)
+    {
+      sint16 variantOffset;
+      uint16 maxRecordSize;
+
+      /* Skip over the 'case' */
+
+      getToken();
+
+      /* Check for variant-selector
+       * FORM: variant-selector = [ identifier ':' ] ordinal-type-identifer
+       */
+
+      if (token != tIDENT) error(eRECORDDECLARE);
+
+      /* Add a variant-selector to the fixed-part of the record */ 
+
+      else
+	{
+	  STYPE *typePtr;
+	  char  *fieldName;
+
+	  /* Save the field name */
+
+	  fieldName = tkn_strt;
+	  getToken();
+
+	  /* Verify that the identifier is followed by a colon */
+
+	  if (token != ':') error(eCOLON);
+	  else getToken();
+
+	  /* Get the ordinal-type-identifier */
+
+	  typePtr = pas_OrdinalTypeIdentifier(1);
+	  if (!typePtr) error(eINVTYPE);
+	  else
+	    {
+	      STYPE *fieldPtr;
+
+	      /* Declare a <field> with this <identifier> as its name */
+
+	      fieldPtr = addField(fieldName, recordPtr);
+
+	      /* Increment the number of fields in the record */
+
+	      recordPtr->sParm.t.maxValue++;
+
+	      /* Copy the size of field from the sTYPE entry into the
+	       * <field> type entry.  NOTE:  This element is not essential
+	       * since it  can be obtained from the parent type pointer
+	       */
+
+	      fieldPtr->sParm.r.size = typePtr->sParm.t.asize;
+
+	      /* Save a pointer back to the parent field type */
+
+	      fieldPtr->sParm.r.parent = typePtr;
+
+	      /* Align the recordOffset (if necessary) */
+
+	      if ((!isIntAligned(recordOffset)) &&
+		  (pas_IntAlignRequired(typePtr)))
+		recordOffset = intAlign(recordOffset);
+
+	      /* Save the offset associated with this field, and determine
+	       * the offset to the next field (if there is one)
+	       */
+
+	      fieldPtr->sParm.r.offset = recordOffset;
+	      recordOffset += recordPtr[symbolIndex].sParm.r.size;
+	    }
+	}
+
+      /* Save the offset to the start of the variant portion of the RECORD */
+
+      variantOffset = recordOffset;
+      maxRecordSize = recordOffset;
+
+      /* Skip over the 'of' following the variant selector */
+
+      if (token != tOF) error(eOF);
+      else getToken();
+
+      /* Loop to process the variant-body
+       * FORM: variant-body =
+       *       variant-list [ [ ';' ] variant-part-completer ] |
+       *       variant-part-completer
+       * FORM: variant-list = variant { ';' variant }
+       * FORM: variant-part-completer = ( 'otherwise' | 'else' ) ( field-list )
+       */
+
+      for (;;)
+	{
+	  /* Now process each variant where:
+	   * FORM: variant = case-constant-list ':' '(' field-list ')'
+	   * FORM: case-constant-list = case-specifier { ',' case-specifier }
+	   * FORM: case-specifier = case-constant [ '..' case-constant ]
+	   */
+
+	  /* Verify that the case selector begins with a case-constant.
+	   * Note that subrange case-specifiers are not yet supported.
+	   */
+
+	  if (!isConstant(token))
+	    {
+	      error(eINVCONST);
+	      break;
+	    }
+
+	  /* Just consume the <case selector> for now -- Really need to
+	   * verify that each constant is of the same type as the type
+	   * identifier (or the type associated with the tag) in the CASE
+	   */
+
+	  do
+	    {
+	      getToken();
+	      if (token == ',') getToken();
+	    }
+	  while (isConstant(token));
+
+	  /* Make sure a colon separates case-constant-list from the
+	   * field-list
+	   */
+
+	  if (token == ':') getToken();
+	  else error(eCOLON);
+
+	  /* The field-list must be enclosed in parentheses */
+
+	  if (token == '(') getToken();
+	  else error(eLPAREN);
+
+	  /* Special case the empty variant <field list> */
+
+	  if (token != ')')
+	    {
+	      /* Now process the <field list> for the variant.  This works
+	       * just like the field list of the fixed part, except the
+	       * offset is reset for each variant.
+	       * FORM: field-list =
+	       *       [
+	       *         fixed-part [ ';' ] variant-part [ ';' ] |
+	       *         fixed-part [ ';' ] |
+	       *         variant-part [ ';' ] |
+	       *       ]
+	       */
+
+	      for (;;)
+		{
+		  /* We now expect to see and indentifier representating the
+		   * beginning of the next variablefield.
+		   */
+
+		  (void)pas_DeclareField(recordPtr);
+
+		  /* If the field declaration terminates with a semicolon,
+		   * then we expect to see another <variable part>
+		   * declaration in the record.
+		   */
+
+		  if (token == ';')
+		    {
+		      /* Skip over the semicolon and process the next
+		       * variable field declaration.
+		       */
+
+		      getToken();
+
+		      /* We will treat this semi colon as optional.  If we
+		       * hit 'end' after the semicolon, then we will
+		       * terminate the fixed part with no complaint.
+		       */
+
+		      if (token == tEND)
+			break;
+		    }
+		  else break;
+		}
+
+	      /* Get the total size of the RECORD type and the offset of each
+	       * field within the RECORD.
+	       */
+
+	      for (recordOffset = variantOffset;
+		   recordCount < recordPtr->sParm.t.maxValue;
+		   symbolIndex++)
+		{
+		  /* We know that 'maxValue' sRECORD_OBJECT symbols follow
+		   * the sRECORD type declaration.  However, these may not
+		   * be sequential due to the possible declaration of sTYPEs
+		   * associated with each field.
+		   */
+
+		  if (recordPtr[symbolIndex].sKind == sRECORD_OBJECT)
+		    {
+		      /* Align the recordOffset (if necessary) */
+
+		      if ((!isIntAligned(recordOffset)) &&
+			  (pas_IntAlignRequired(recordPtr[symbolIndex].sParm.r.parent)))
+			recordOffset = intAlign(recordOffset);
+
+		      /* Save the offset associated with this field, and
+		       * determine the offset to the next field (if there
+		       * is one)
+		       */
+
+		      recordPtr[symbolIndex].sParm.r.offset = recordOffset;
+		      recordOffset += recordPtr[symbolIndex].sParm.r.size;
+		      recordCount++;
+		    }
+		}
+
+	      /* Check if this is the largest variant that we have found
+	       * so far
+	       */
+
+	      if (recordOffset > maxRecordSize)
+		maxRecordSize = recordOffset;
+	    } 
+
+	  /* Verify that the <field list> is enclosed in parentheses */
+
+	  if (token == ')') getToken();
+	  else error(eRPAREN);
+
+	  /* A semicolon at this position means that another <variant>
+	   * follows.  Keep looping until all of the variants have been
+	   * processed (i.e., no semi-colon)
+	   */
+
+	  if (token == ';') getToken();
+	  else break;
+	}
+
+      /* Update the RECORD entry for the maximum size of all variants */
+
+      recordPtr->sParm.t.asize = maxRecordSize;
+    }
+
+  /* Verify that the RECORD declaration terminates with END */
+
+  if (token != tEND) error(eRECORDDECLARE);
+  else getToken();
+
+  return recordPtr;
+}
+
+/***************************************************************/
+
+static STYPE *pas_DeclareField(STYPE *recordPtr)
+{
+   STYPE *fieldPtr = NULL;
+   STYPE *typePtr;
+
+   TRACE(lstFile,"[pas_DeclareField]");
+
+   /* Declare one record-section with a record.
+    * FORM: record-section = identifier-list ':' type-denoter
+    * FORM: identifier-list = identifier { ',' identifier }
+    */
+
+   if (token != tIDENT) error(eIDENT);
+   else {
+
+     /* Declare a <field> with this <identifier> as its name */
+
+     fieldPtr = addField(tkn_strt, recordPtr);
+     getToken();
+
+     /* Check for multiple fields of this <type> */
+
+     if (token == ',') {
+
+       getToken();
+       typePtr = pas_DeclareField(recordPtr);
+
+     }
+     else {
+
+       if (token != ':') error(eCOLON);
+       else getToken();
+
+       /* Use the existing type or declare a new type with no name */
+
+       typePtr = pas_TypeDenoter(NULL, 1);
+     }
+
+     recordPtr->sParm.t.maxValue++;
+     if (typePtr) {
+
+       /* Copy the size of field from the sTYPE entry into the <field> */
+       /* type entry.  NOTE:  This element is not essential since it */
+       /* can be obtained from the parent type pointer */
+
+       fieldPtr->sParm.r.size     = typePtr->sParm.t.asize;
+
+       /* Save a pointer back to the parent field type */
+
+       fieldPtr->sParm.r.parent   = typePtr;
+
+     }
+   }
+
+   return typePtr;
+}
+ 
+/***************************************************************/
+/* Process VAR/value Parameter Declaration */
+/* NOTE:  This function increments the global variable g_nParms */
+/* as a side-effect */
+
+static STYPE *pas_DeclareParameter(boolean pointerType)
+{
+   sint16  varType = 0;
+   STYPE  *varPtr;
+   STYPE  *typePtr;
+
+   TRACE(lstFile,"[pas_DeclareParameter]");
+
+   /* FORM:
+    * <identifier>[,<identifier>[,<identifier>[...]]] : <type identifier>
+    */
+
+   if (token != tIDENT) error (eIDENT);
+   else
+     {
+       varPtr = addVariable(tkn_strt, sINT, 0, sINT_SIZE, NULL);
+       getToken();
+
+       if (token == ',')
+	 {
+	   getToken();
+	   typePtr = pas_DeclareParameter(pointerType);
+	 }
+       else
+	 {
+	   if (token != ':') error (eCOLON);
+	   else getToken();
+	   typePtr = pas_TypeIdentifier(0);
+	 }
+
+       if (pointerType)
+	 {
+	   varType = sVAR_PARM;
+	   g_dwVarSize = sPTR_SIZE;
+	 }
+       else
+	 {
+	   varType = typePtr->sParm.t.rtype;
+	 }
+
+       g_nParms++;
+       varPtr->sKind          = varType;
+       varPtr->sParm.v.size   = g_dwVarSize;
+       varPtr->sParm.v.parent = typePtr;
+     }
+
+   return typePtr;
+}
+
+/***************************************************************/
+
+static boolean pas_IntAlignRequired(STYPE *typePtr)
+{
+  boolean returnValue = FALSE;
+
+  /* Type CHAR and ARRAYS of CHAR do not require alignment (unless
+   * they are passed as value parameters).  Otherwise, alignment
+   * to type INTEGER boundaries is required.
+   */
+
+  if (typePtr)
+    {
+      if (typePtr->sKind == sCHAR)
+	{
+	  returnValue = TRUE;
+	}
+      else if (typePtr->sKind == sARRAY)
+	{
+	  typePtr = typePtr->sParm.t.parent;
+	  if ((typePtr) && (typePtr->sKind == sCHAR))
+	    {
+	      returnValue = TRUE;
+	    }
+	}
+    }
+
+  return returnValue;
+}
+
+/***************************************************************/
diff --git a/misc/pascal/pascal/pcexpr.c b/misc/pascal/pascal/pcexpr.c
new file mode 100644
index 000000000..040c330ad
--- /dev/null
+++ b/misc/pascal/pascal/pcexpr.c
@@ -0,0 +1,574 @@
+/***************************************************************
+ * pexpr.c
+ * Constant expression evaluation
+ *
+ *   Copyright (C) 2008 Gregory Nutt. All rights reserved.
+ *   Author: Gregory Nutt <spudmonkey@racsa.co.cr>
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ *    notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ *    notice, this list of conditions and the following disclaimer in
+ *    the documentation and/or other materials provided with the
+ *    distribution.
+ * 3. Neither the name NuttX nor the names of its contributors may be
+ *    used to endorse or promote products derived from this software
+ *    without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+ * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+ * COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+ * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+ * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS
+ * OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED
+ * AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+ * ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *
+ ***************************************************************/
+
+/***************************************************************
+ * Included Files
+ ***************************************************************/
+
+#include <stdio.h>
+#include <string.h>
+#include <math.h>
+
+#include "keywords.h"
+#include "pdefs.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"
+
+/***************************************************************
+ * Private 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;
+sint32  constantInt;
+float64 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;
+      sint32 simple1Int   = constantInt;
+      float64 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 = (float64)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 = (float64)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)
+{
+  sint16  unary = ' ';
+  int     term;
+  sint32  termInt;
+  float64 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 = (float64)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 = (float64)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;
+  sint32  factorInt;
+  float64 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 = (float64)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 = (float64)constantInt;
+	  }
+	 
+	/* Handle the case where the 1st argument is Integer and the
+	 * second is REAL. */
+
+	else if ((factor == tINT_CONST) && (constantToken == tREAL_CONST))
+	  {
+	    factorReal = (float64)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;
+    }
+} 
diff --git a/misc/pascal/pascal/pcfunc.c b/misc/pascal/pascal/pcfunc.c
new file mode 100644
index 000000000..cfa3700d2
--- /dev/null
+++ b/misc/pascal/pascal/pcfunc.c
@@ -0,0 +1,339 @@
+/***************************************************************
+ * pcfunc.c
+ * Standard Function operating on constant values
+ *
+ *   Copyright (C) 2008 Gregory Nutt. All rights reserved.
+ *   Author: Gregory Nutt <spudmonkey@racsa.co.cr>
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ *    notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ *    notice, this list of conditions and the following disclaimer in
+ *    the documentation and/or other materials provided with the
+ *    distribution.
+ * 3. Neither the name NuttX nor the names of its contributors may be
+ *    used to endorse or promote products derived from this software
+ *    without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+ * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+ * COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+ * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+ * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS
+ * OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED
+ * AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+ * ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *
+ ***************************************************************/
+
+/***************************************************************
+ * Included Files
+ ***************************************************************/
+
+#include <stdio.h>
+#include <math.h>
+
+#include "keywords.h"
+#include "pdefs.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(ubyte 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(ubyte fpOpCode)
+{
+   TRACE(lstFile,"[constantRealFunc]");
+
+   /* FORM:  <function identifier> (<real/integer expression>) */
+
+   checkLParen();
+   constantExpression();
+   if (constantToken == tINT_CONST)
+     constantReal = (float64)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);
+}
+
+/***********************************************************************/
+
diff --git a/misc/pascal/pascal/perr.c b/misc/pascal/pascal/perr.c
new file mode 100644
index 000000000..498917eb6
--- /dev/null
+++ b/misc/pascal/pascal/perr.c
@@ -0,0 +1,190 @@
+/**********************************************************************
+ * perr.c
+ * Error Handlers
+ *
+ *   Copyright (C) 2008 Gregory Nutt. All rights reserved.
+ *   Author: Gregory Nutt <spudmonkey@racsa.co.cr>
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ *    notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ *    notice, this list of conditions and the following disclaimer in
+ *    the documentation and/or other materials provided with the
+ *    distribution.
+ * 3. Neither the name NuttX nor the names of its contributors may be
+ *    used to endorse or promote products derived from this software
+ *    without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+ * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+ * COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+ * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+ * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS
+ * OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED
+ * AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+ * ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *
+ **********************************************************************/
+
+/**********************************************************************
+ * Included Files
+ **********************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <stdarg.h>
+
+#include "config.h"
+#include "keywords.h"
+#include "pdefs.h"
+#include "pedefs.h"
+
+#include "pas.h"
+#include "ptkn.h"
+#include "perr.h"
+#if CONFIG_DEBUG
+# include "ptbl.h"
+#endif
+
+/**********************************************************************
+ * 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 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 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 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 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 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 */
+
+/***********************************************************************/
+
diff --git a/misc/pascal/pascal/pexpr.c b/misc/pascal/pascal/pexpr.c
new file mode 100644
index 000000000..79cf69044
--- /dev/null
+++ b/misc/pascal/pascal/pexpr.c
@@ -0,0 +1,2735 @@
+/***************************************************************
+ * pexpr.c
+ * Integer Expression
+ *
+ *   Copyright (C) 2008 Gregory Nutt. All rights reserved.
+ *   Author: Gregory Nutt <spudmonkey@racsa.co.cr>
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ *    notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ *    notice, this list of conditions and the following disclaimer in
+ *    the documentation and/or other materials provided with the
+ *    distribution.
+ * 3. Neither the name NuttX nor the names of its contributors may be
+ *    used to endorse or promote products derived from this software
+ *    without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+ * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+ * COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+ * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+ * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS
+ * OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED
+ * AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+ * ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *
+ ***************************************************************/
+
+/***************************************************************
+ * Included Files
+ ***************************************************************/
+
+#include <stdio.h>
+#include <string.h>
+
+#include "keywords.h"
+#include "pdefs.h"
+#include "ptdefs.h"
+#include "podefs.h" /* general operation codes */
+#include "pfdefs.h" /* floating point operations */
+#include "pxdefs.h" /* library operations */
+#include "pedefs.h"
+
+#include "keywords.h"
+#include "pas.h"
+#include "pstm.h"
+#include "pexpr.h"
+#include "pproc.h" /* for actualParameterList */
+#include "pfunc.h"
+#include "pgen.h"  /* for pas_Generate*() */
+#include "ptkn.h"
+#include "pinsn.h"
+#include "perr.h"
+
+/***************************************************************
+ * Private Definitions
+ ***************************************************************/
+
+#define ADDRESS_DEREFERENCE 0x01
+#define ADDRESS_FACTOR      0x02
+#define INDEXED_FACTOR      0x04
+#define VAR_PARM_FACTOR     0x08
+
+#define intTrunc(x) ((x) & (~(sINT_SIZE)))
+
+/***************************************************************
+ * Private Type Declarations
+ ***************************************************************/
+
+typedef struct {
+   ubyte   setType;
+   boolean typeFound;
+   sint16  minValue;
+   sint16  maxValue;
+   STYPE  *typePtr;
+} setTypeStruct;
+
+/***************************************************************
+ * Private Function Prototypes
+ ***************************************************************/
+
+static exprType simpleExpression  (exprType findExprType);
+static exprType term              (exprType findExprType);
+static exprType factor            (exprType findExprType);
+static exprType complexFactor     (void);
+static exprType simpleFactor      (STYPE *varPtr, ubyte factorFlags);
+static exprType ptrFactor         (void);
+static exprType complexPtrFactor  (void);
+static exprType simplePtrFactor   (STYPE *varPtr, ubyte factorFlags);
+static exprType functionDesignator(void);
+static void     setAbstractType   (STYPE *sType);
+static void     getSetFactor      (void);
+static void     getSetElement     (setTypeStruct *s);
+static boolean  isOrdinalType     (exprType testExprType);
+static boolean  isAnyStringType   (exprType testExprType);
+static boolean  isStringReference (exprType testExprType);
+
+/***************************************************************
+ * Private Variables
+ ***************************************************************/
+
+ /* The abstract types - SETs, RECORDS, etc - require an exact */
+ /* match in type.  This variable points to the symbol table   */
+ /* sTYPE entry associated with the expression. */
+  
+ static STYPE *abstractType;
+
+/***************************************************************/
+/* Evaluate (boolean) Expression */
+
+exprType expression(exprType findExprType, STYPE *typePtr)
+{
+   ubyte  operation;
+   uint16 intOpCode;
+   uint16 fpOpCode;
+   uint16 strOpCode;
+   exprType simple1Type;
+   exprType simple2Type;
+
+   TRACE(lstFile,"[expression]");
+
+   /* The abstract types - SETs, RECORDS, etc - require an exact */
+   /* match in type.  Save the symbol table sTYPE entry associated */
+   /* with the expression. */
+
+   if ((typePtr) && (typePtr->sKind != sTYPE)) error(eINVTYPE);
+   abstractType = typePtr;
+
+   /* FORM <simple expression> [<relational operator> <simple expression>] */
+   /* Get the first <simple expression> */
+
+   simple1Type = simpleExpression(findExprType);
+
+   /* Get the optional <relational operator> which may follow */
+
+   operation = token;
+   switch (operation)
+     {
+     case tEQ :
+       intOpCode = opEQU;
+       fpOpCode  = fpEQU;
+       strOpCode = opEQUZ;
+       break;
+     case tNE :
+       intOpCode = opNEQ;
+       fpOpCode  = fpNEQ;
+       strOpCode = opNEQZ;
+       break;
+     case tLT :
+       intOpCode = opLT;
+       fpOpCode  = fpLT;
+       strOpCode = opLTZ;
+       break;
+     case tLE :
+       intOpCode = opLTE;
+       fpOpCode  = fpLTE;
+       strOpCode = opLTEZ;
+       break;
+     case tGT :
+       intOpCode = opGT;
+       fpOpCode  = fpGT;
+       strOpCode = opGTZ;
+       break;
+     case tGE :
+       intOpCode = opGTE;
+       fpOpCode  = fpGTE;
+       strOpCode = opGTEZ;
+       break;
+     case tIN :
+       if ((!abstractType) ||
+	   ((abstractType->sParm.t.type != sSCALAR) &&
+	    (abstractType->sParm.t.type != sSUBRANGE)))
+	 error(eEXPRTYPE);
+       else if (abstractType->sParm.t.minValue)
+	 {
+	   pas_GenerateDataOperation(opPUSH, abstractType->sParm.t.minValue);
+	   pas_GenerateSimple(opSUB);
+	 } /* end else if */
+       intOpCode = opBIT;
+       fpOpCode  = fpINVLD;
+       strOpCode = opNOP;
+       break;
+     default  :
+       intOpCode = opNOP;
+       fpOpCode  = fpINVLD;
+       strOpCode = opNOP;
+       break;
+     } /* end switch */
+
+   /* Check if there is a 2nd simple expression needed */
+
+   if (intOpCode != opNOP)
+     {
+       /* Get the second simple expression */
+
+       getToken();
+       simple2Type = simpleExpression(findExprType);
+
+       /* Perform automatic type conversion from INTEGER to REAL
+	* for integer vs. real comparisons.
+	*/
+
+       if (simple1Type != simple2Type)
+	 {
+	   /* Handle the case where the 1st argument is REAL and the
+	    * second is INTEGER. */
+
+	   if ((simple1Type == exprReal) &&
+	       (simple2Type == exprInteger) &&
+	       (fpOpCode != fpINVLD))
+	     {
+	       fpOpCode   |= fpARG2;
+	       simple2Type = exprReal;
+	     } /* end if */
+
+	   /* Handle the case where the 1st argument is Integer and the
+	    * second is REAL. */
+
+	   else if ((simple1Type == exprInteger) &&
+		    (simple2Type == exprReal) &&
+		    (fpOpCode != fpINVLD))
+	     {
+	       fpOpCode   |= fpARG1;
+	       simple1Type = exprReal;
+	     } /* end else if */
+
+	   /* Allow the case of <scalar type> IN <set type> */
+	   /* Otherwise, the two terms must agree in type */
+
+	   else if ((operation != tIN) || (simple2Type != exprSet))
+	     {
+	       error(eEXPRTYPE);
+	     }
+	 } /* end if */
+
+       /* Generate the comparison */
+
+       if (simple1Type == exprReal)
+	 {
+	   if (fpOpCode == fpINVLD)
+	     error(eEXPRTYPE);
+	   else
+	     pas_GenerateFpOperation(fpOpCode);
+	 } /* end if */
+       else if ((simple1Type == exprString) || (simple1Type == exprString))
+	 {
+	   if (strOpCode != opNOP)
+	     {
+	       pas_BuiltInFunctionCall(lbSTRCMP);
+	       pas_GenerateSimple(strOpCode);
+	     }
+	   else
+	     {
+	       error(eEXPRTYPE);
+	     }
+	 }
+       else
+	 {
+	   pas_GenerateSimple(intOpCode);
+	 }
+
+       /* The type resulting from these operations becomes BOOLEAN */
+
+       simple1Type = exprBoolean;
+
+     } /* end if */
+
+   /* Verify that the expression is of the requested type.
+    * The following are okay:
+    *
+    * 1. We were told to find any kind of expression
+    *
+    * 2. We were told to find a specific kind of expression and
+    *    we found just that type.
+    *
+    * 3. We were told to find any kind of ordinal expression and
+    *    we found a ordinal expression.  This is what is needed, for
+    *    example, as an argument to ord(), pred(), succ(), or odd().
+    *    This is the kind of expression we need in a CASE statement
+    *    as well.
+    *
+    * 4. We were told to find any kind of string expression and
+    *    we found a string expression. This is a hack to handle
+    *    calls to system functions that return exprCString pointers
+    *    that must be converted to exprString records upon assignment.
+    *
+    * 5. We have a hack in the name space.  You use a bogus name
+    *    to represent a string reference that has string stack
+    *    allocated with it.  For expression processing purposes,
+    *    exprString and exprStkString are the same thing.  The
+    *    difference is that we have to clean up the string stack
+    *    for the latter.
+    *
+    * Special case:
+    *
+    *    We will perform automatic conversions to real from integer
+    *    if the requested type is a real expression.
+    */
+
+   if ((findExprType != exprUnknown) &&     /* 1)NOT Any expression */
+
+       (findExprType != simple1Type) &&     /* 2)NOT Matched expression */
+
+       ((findExprType != exprAnyOrdinal) || /* 3)NOT any ordinal type */
+	(!isOrdinalType(simple1Type))) &&   /*   OR type is not ordinal */
+
+       ((findExprType != exprAnyString) ||  /* 4)NOT any string type */
+	(!isAnyStringType(simple1Type))) && /*   OR type is not string */
+
+       ((findExprType != exprString) ||     /* 5)Not looking for string ref */
+	(!isStringReference(simple1Type)))) /*   OR type is not string ref */
+     {
+       /* Automatic conversions from INTEGER to REAL will be performed */
+
+       if ((findExprType == exprReal) && (simple1Type == exprInteger))
+	 {
+	   pas_GenerateFpOperation(fpFLOAT);
+	   simple1Type = exprReal;
+	 }
+
+       /* Any other type mismatch is an error */
+
+       else
+	 {
+	   error(eEXPRTYPE);
+	 }
+   } /* end if */
+
+   return simple1Type;
+
+} /* end expression */
+
+/***************************************************************/
+/* Provide VAR parameter assignments */
+
+exprType varParm (exprType varExprType, STYPE *typePtr)
+{
+   exprType factorType;
+
+   /* The abstract types - SETs, RECORDS, etc - require an exact
+    * match in type.  Save the symbol table sTYPE entry associated
+    * with the expression.
+    */
+
+   if ((typePtr) && (typePtr->sKind != sTYPE)) error(eINVTYPE);
+   abstractType = typePtr;
+
+   /* This function is really just an interface to the
+    * static function ptrFactor with some extra error
+    * checking.
+    */
+
+   factorType = ptrFactor();
+   if ((varExprType != exprUnknown) && (factorType != varExprType))
+      error(eINVVARPARM);
+
+   return factorType;
+
+} /* end varParm */
+ 
+/**********************************************************************/
+/* Process Array Index */
+void arrayIndex (sint32 size)
+{
+   TRACE(lstFile,"[arrayIndex]");
+
+   /* FORM:  [<integer expression>] */
+   getToken();
+   if (token != '[') error (eLBRACKET);
+   else {
+
+     /* Evaluate index expression */
+     /* FIX ME:  Need to allow any scalar type */
+     getToken();
+     expression(exprInteger, NULL);
+
+     /* Correct for size of array element */
+     if (size > 1) {
+	pas_GenerateDataOperation(opPUSH, size);
+        pas_GenerateSimple(opMUL);
+     } /* end if */
+
+     /* Verify right bracket */
+     if (token !=  ']') error (eRBRACKET);
+     else getToken();
+
+   } /* end else */
+
+} /* end arrayIndex */
+
+/*************************************************************************/
+/* Determine the expression type associated with a pointer to a type */
+/* symbol */
+
+exprType getExprType(STYPE *sType)
+{
+  exprType factorType = sINT;
+
+  TRACE(lstFile,"[getExprType]");
+
+  if ((sType) && (sType->sKind == sTYPE))
+    {
+      switch (sType->sParm.t.type)
+	{
+	case sINT :
+	  factorType = exprInteger;
+	  break;
+	case sBOOLEAN :
+	  factorType = exprBoolean;
+	  break;
+	case sCHAR :
+	  factorType = exprChar;
+	  break;
+	case sREAL :
+	  factorType = exprReal;
+	  break;
+	case sSCALAR :
+	  factorType = exprScalar;
+	  break;
+	case sSTRING :
+	case sRSTRING :
+	  factorType = exprString;
+	  break;
+       	case sSUBRANGE :
+	  switch (sType->sParm.t.subType)
+	    {
+	    case sINT :
+	      factorType = exprInteger;
+	      break;
+	    case sCHAR :
+	      factorType = exprChar;
+	      break;
+	    case sSCALAR :
+	      factorType = exprScalar;
+	      break;
+	    default :
+	      error(eSUBRANGETYPE);
+	      break;
+	    } /* end switch */
+	  break;
+	case sPOINTER :
+	  sType = sType->sParm.t.parent;
+	  if (sType)
+	    {
+	      switch (sType->sKind)
+		{
+		case sINT :
+		  factorType = exprIntegerPtr;
+		  break;
+		case sBOOLEAN :
+		  factorType = exprBooleanPtr;
+		  break;
+		case sCHAR :
+		  factorType = exprCharPtr;
+		  break;
+		case sREAL :
+		  factorType = exprRealPtr;
+		  break;
+		case sSCALAR :
+		  factorType = exprScalarPtr;
+		  break;
+		default :
+		  error(eINVTYPE);
+		  break;
+		} /* end switch */
+	    } /* end if */
+	  break;
+	default :
+	  error(eINVTYPE);
+	  break;
+	} /* end switch */
+    } /* end if */
+
+  return factorType;
+
+} /* end getExprType */
+
+/***************************************************************/
+/* Process Simple Expression */
+
+static exprType simpleExpression(exprType findExprType)
+{
+   sint16   operation = '+';
+   uint16   arg8FpBits;
+   exprType term1Type;
+   exprType term2Type;
+
+   TRACE(lstFile,"[simpleExpression]");
+
+   /* FORM: [+|-] <term> [{+|-} <term> [{+|-} <term> [...]]] */
+   /* get +/- unary operation */
+
+   if ((token == '+') || (token == '-'))
+     {
+       operation = token;
+       getToken();
+     } /* end if */
+
+   /* Process first (non-optional) term and apply unary operation */
+
+   term1Type = term(findExprType);
+   if (operation == '-')
+     {
+       if (term1Type == exprInteger)
+	 pas_GenerateSimple(opNEG);
+       else if (term1Type == exprReal)
+	 pas_GenerateFpOperation(fpNEG);
+       else
+	 error(eTERMTYPE);
+     } /* end if */
+
+   /* Process subsequent (optional) terms and binary operations */
+
+   for (;;)
+     {
+       /* Check for binary operator */
+
+       if ((token == '+') || (token == '-') || (token == tOR))
+	 operation = token;
+       else
+	 break;
+
+       /* Special case for string types.  So far, we have parsed
+	* '<string> +'  At this point, it is safe to assume we
+	* going to modified string.  So, if the string has not
+	* been copied to the string stack, we will have to do that
+	* now.
+	*/
+
+       if ((term1Type == exprString) && (operation == '+'))
+	 {
+	   /* Duplicate the string on the string stack.  And
+	    * change the expression type to reflect this.
+	    */
+
+	   pas_BuiltInFunctionCall(lbMKSTKSTR);
+	   term1Type = exprStkString;
+	 }
+
+       /* If we are going to add something to a char, then the
+	* result must be a string.  We will similarly have to
+	* convert the character to a string.
+	*/
+
+       else if ((term1Type == exprChar) && (operation == '+'))
+	 {
+	   /* Duplicate the string on the string stack.  And
+	    * change the expression type to reflect this.
+	    */
+
+	   pas_BuiltInFunctionCall(lbMKSTKC);
+	   term1Type = exprStkString;
+	 }
+
+       /* Get the 2nd term */
+
+       getToken();
+       term2Type = term(findExprType);
+
+       /* Before generating the operation, verify that the types match.
+	* Perform automatic type conversion from INTEGER to REAL as
+	* necessary.
+	*/
+
+       arg8FpBits = 0;
+
+       /* Skip over string types.  These will be handled below */
+
+       if (!isStringReference(term1Type))
+	 {
+	   /* Handle the case where the type of the terms differ. */
+
+	   if (term1Type != term2Type)
+	     {
+	       /* Handle the case where the 1st argument is REAL and the
+		* second is INTEGER. */
+
+	       if ((term1Type == exprReal) && (term2Type == exprInteger))
+		 {
+		   arg8FpBits = fpARG2;
+		   term2Type = exprReal;
+		 } /* end if */
+
+	       /* Handle the case where the 1st argument is Integer and the
+		* second is REAL. */
+
+	       else if ((term1Type == exprInteger) && (term2Type == exprReal))
+		 {
+		   arg8FpBits = fpARG1;
+		   term1Type = exprReal;
+		 } /* end if */
+
+	       /* Otherwise, the two terms must agree in type */
+
+	       else
+		 {
+		   error(eTERMTYPE);
+		 }
+	     } /* end if */
+
+	   /* We do not perform conversions for the cases where the two
+	    * terms agree in type. There is only one interesting case:
+	    * When the expected expression is real and both arguments are
+	    * integer.  Since addition an subtraction are exact, it would,
+	    * in general, be more efficient to perform the conversion
+	    * AFTER the operation (at the the risk of possible overflow
+	    * conditions due to the limited range of integers).
+	    */
+	 }
+
+       /* Generate code to perform the selected binary operation */
+
+       switch (operation)
+	 {
+	 case '+' :
+	   switch (term1Type)
+	     {
+	       /* Integer addition */
+
+	     case exprInteger :
+	       pas_GenerateSimple(opADD);
+	       break;
+
+	       /* Floating point addition */
+
+	     case exprReal :
+	       pas_GenerateFpOperation(fpADD | arg8FpBits);
+	       break;
+
+	       /* Set 'addition' */
+
+	     case exprSet :
+	       pas_GenerateSimple(opOR);
+	       break;
+
+	       /* Handle the special cases where '+' indicates that we are
+		* concatenating a string or a character to the end of a
+		* string.  Note that these operations can only be performed
+		* on stack copies of the strings.  Logic above should have
+		* made the conversion for the case of exprString.
+		*/
+
+	     case exprStkString :
+	       if ((term2Type == exprString) || (term2Type == exprStkString))
+		 {
+		   /* We are concatenating one string with another.*/
+
+		   pas_BuiltInFunctionCall(lbSTRCAT);
+		 }
+	       else if (term2Type == exprChar)
+		 {
+		   /* We are concatenating a character to the end of a string */
+
+		   pas_BuiltInFunctionCall(lbSTRCATC);
+		 }
+	       else
+		 {
+		   error(eTERMTYPE);
+		 }
+	       break;
+
+	       /* Otherwise, the '+' operation is not permitted */
+
+	     default :
+	       error(eTERMTYPE);
+	       break;
+	     }
+	   break;
+
+	 case '-' :
+	   /* Integer subtraction */
+
+	   if (term1Type == exprInteger)
+	     pas_GenerateSimple(opSUB);
+
+	   /* Floating point subtraction */
+
+	   else if (term1Type == exprReal)
+	     pas_GenerateFpOperation(fpSUB | arg8FpBits);
+
+	   /* Set 'subtraction' */
+
+	   else if (term1Type == exprSet)
+	     {
+	       pas_GenerateSimple(opNOT);
+	       pas_GenerateSimple(opAND);
+	     } /* end else if */
+
+	   /* Otherwise, the '-' operation is not permitted */
+
+	   else
+	     error(eTERMTYPE);
+	   break;
+
+	 case tOR :
+	   /* Integer/boolean 'OR' */
+
+	   if ((term1Type == exprInteger) || (term1Type == exprBoolean))
+	     pas_GenerateSimple(opOR);
+
+	   /* Otherwise, the 'OR' operation is not permitted */
+
+	   else
+	     error(eTERMTYPE);
+	   break;
+
+	 } /* end switch */
+     } /* end for */
+
+   return term1Type;
+
+} /* end simpleExpression */
+
+/***************************************************************/
+/* Evaluate a TERM */
+
+static exprType term(exprType findExprType)
+{
+   ubyte    operation;
+   uint16   arg8FpBits;
+   exprType factor1Type;
+   exprType factor2Type;
+
+   TRACE(lstFile,"[term]");
+
+   /* FORM:  <factor> [<operator> <factor>[<operator><factor>[...]]] */
+
+   factor1Type = factor(findExprType);
+   for (;;) {
+
+     /* Check for binary operator */
+
+     if ((token == tMUL)  || (token == tDIV)  ||
+	 (token == tFDIV) || (token == tMOD)  ||
+	 (token == tAND)  || (token == tSHL)  ||
+	 (token == tSHR))
+       operation = token;
+     else
+       break;
+
+     /* Get the next factor */
+
+     getToken();
+     factor2Type = factor(findExprType);
+
+     /* Before generating the operation, verify that the types match.
+      * Perform automatic type conversion from INTEGER to REAL as
+      * necessary.
+      */
+
+     arg8FpBits = 0;
+
+     /* Handle the case where the type of the terms differ. */
+
+     if (factor1Type != factor2Type)
+       {
+	 /* Handle the case where the 1st argument is REAL and the
+	  * second is INTEGER. */
+
+	 if ((factor1Type == exprReal) && (factor2Type == exprInteger))
+	   {
+	     arg8FpBits = fpARG2;
+	   } /* end if */
+	 
+	 /* Handle the case where the 1st argument is Integer and the
+	  * second is REAL. */
+
+	 else if ((factor1Type == exprInteger) && (factor2Type == exprReal))
+	   {
+	     arg8FpBits = fpARG1;
+	     factor1Type = exprReal;
+	   } /* end if */
+
+	 /* Otherwise, the two factors must agree in type */
+
+	 else
+	   {
+	     error(eFACTORTYPE);
+	   }
+       } /* end if */
+
+     /* Handle the cases for conversions when the two string
+      * type are the same type.
+      */
+
+     else
+       {
+	 /* There is only one interesting case:  When the
+	  * expected expression is real and both arguments are
+	  * integer.  In this case, for example, 1/2 must yield
+	  * 0.5, not 0.
+	  */
+
+	 if ((factor1Type == exprInteger) && (findExprType == exprReal))
+	   {
+	     /* However, we will perform this conversin only for the
+	      * arithmetic operations: tMUL, tDIV/tFDIV, and tMOD.
+	      * The logical operations must be performed on integer
+	      * types with the result converted to a real type afterward.
+	      */
+
+	     if ((operation == tMUL)  || (operation == tDIV)  ||
+		 (operation == tFDIV) || (operation == tMOD))
+	       {
+		 /* Perform the conversion of both terms */
+
+		 arg8FpBits = fpARG1 | fpARG2;
+		 factor1Type = exprReal;
+
+		 /* We will also have to switch the operation in
+		  * the case of tDIV:  We'll have to used tFDIV.
+		  */
+
+		 if (operation == tDIV) operation = tFDIV;
+	       }
+	   }
+       }
+
+     /* Generate code to perform the selected binary operation */
+
+     switch (operation)
+       {
+       case tMUL :
+	 if (factor1Type == exprInteger)
+	   pas_GenerateSimple(opMUL);
+	 else if (factor1Type == exprReal)
+	   pas_GenerateFpOperation(fpMUL | arg8FpBits);
+	 else if (factor1Type == exprSet)
+	   pas_GenerateSimple(opAND);
+         else
+	   error(eFACTORTYPE);
+         break;
+
+       case tDIV :
+	 if (factor1Type == exprInteger)
+	   pas_GenerateSimple(opDIV);
+         else
+	   error(eFACTORTYPE);
+	 break;
+
+       case tFDIV :
+	 if (factor1Type == exprReal)
+	   pas_GenerateFpOperation(fpDIV | arg8FpBits);
+	 else
+	   error(eFACTORTYPE);
+         break;
+
+       case tMOD :
+	 if (factor1Type == exprInteger)
+	   pas_GenerateSimple(opMOD);
+	 else if (factor1Type == exprReal)
+	   pas_GenerateFpOperation(fpMOD | arg8FpBits);
+	 else
+	   error(eFACTORTYPE);
+         break;
+
+       case tAND :
+	 if ((factor1Type == exprInteger) || (factor1Type == exprBoolean))
+	   pas_GenerateSimple(opAND);
+         else
+	   error(eFACTORTYPE);
+         break;
+
+       case tSHL :
+	 if (factor1Type == exprInteger)
+	   pas_GenerateSimple(opSLL);
+         else
+	   error(eFACTORTYPE);
+         break;
+
+       case tSHR :
+	 if (factor1Type == exprInteger)
+	   pas_GenerateSimple(opSRA);
+         else
+	   error(eFACTORTYPE);
+	 break;
+
+       } /* end switch */
+   } /* end for */
+
+   return factor1Type;
+
+} /* end term */
+
+/***************************************************************/
+/* Process a FACTOR */
+
+static exprType factor(exprType findExprType)
+{
+  exprType factorType = exprUnknown;
+
+  TRACE(lstFile,"[factor]");
+
+  /* Process by token type */
+
+  switch (token)
+    {
+      /* User defined tokens */
+
+    case tIDENT :
+      error(eUNDEFSYM);
+      stringSP = tkn_strt;
+      factorType = exprUnknown;
+      break;
+
+      /* Constant factors */
+
+    case tINT_CONST :
+      pas_GenerateDataOperation(opPUSH, tknInt);
+      getToken();
+      factorType = exprInteger;
+      break;
+
+    case tBOOLEAN_CONST :
+      pas_GenerateDataOperation(opPUSH, tknInt);
+      getToken();
+      factorType = exprBoolean;
+      break;
+
+    case tCHAR_CONST :
+      pas_GenerateDataOperation(opPUSH, tknInt);
+      getToken();
+      factorType = exprChar;
+      break;
+
+    case tREAL_CONST     :
+      pas_GenerateDataOperation(opPUSH, (sint32)*(((uint16*)&tknReal)+0));
+      pas_GenerateDataOperation(opPUSH, (sint32)*(((uint16*)&tknReal)+1));
+      pas_GenerateDataOperation(opPUSH, (sint32)*(((uint16*)&tknReal)+2));
+      pas_GenerateDataOperation(opPUSH, (sint32)*(((uint16*)&tknReal)+3));
+      getToken();
+      factorType = exprReal;
+      break;
+
+    case sSCALAR_OBJECT :
+      if (abstractType)
+	{
+	  if (tknPtr->sParm.c.parent != abstractType) error(eSCALARTYPE);
+	} /* end if */
+      else
+	abstractType = tknPtr->sParm.c.parent;
+
+      pas_GenerateDataOperation(opPUSH, tknPtr->sParm.c.val.i);
+      getToken();
+      factorType = exprScalar;
+      break;
+
+      /* Simple Factors */
+
+    case sINT :
+      pas_GenerateStackReference(opLDS, tknPtr);
+      getToken();
+      factorType = exprInteger;
+      break;
+
+    case sBOOLEAN :
+      pas_GenerateStackReference(opLDS, tknPtr);
+      getToken();
+      factorType = exprBoolean;
+      break;
+
+    case sCHAR :
+      pas_GenerateStackReference(opLDSB, tknPtr);
+      getToken();
+      factorType = exprChar;
+      break;
+
+    case sREAL :
+      pas_GenerateDataSize(sREAL_SIZE);
+      pas_GenerateStackReference(opLDSM, tknPtr);
+      getToken();
+      factorType = exprReal;
+      break;
+
+      /* Strings -- constant and variable */
+
+    case tSTRING_CONST :
+      {
+	/* Final stack representation is:
+	 * TOS(0) : size in bytes
+	 * TOS(1) : pointer to string
+	 *
+	 * Add the string to the RO data section of the output
+	 * and get the offset to the string location.
+	 */
+
+	uint32 offset = poffAddRoDataString(poffHandle, tkn_strt);
+
+	/* Get the offset then size of the string on the stack */
+
+	pas_GenerateDataOperation(opLAC, offset);
+	pas_GenerateDataOperation(opPUSH, strlen(tkn_strt));
+
+	/* Release the tokenized string */
+
+	stringSP = tkn_strt;
+	getToken();
+	factorType = exprString;
+      }
+      break;
+
+    case sSTRING_CONST :
+      /* Final stack representation is:
+       * TOS(0) : size in bytes
+       * TOS(1) : pointer to string
+       */
+
+      pas_GenerateDataOperation(opLAC, tknPtr->sParm.s.offset);
+      pas_GenerateDataOperation(opPUSH, tknPtr->sParm.s.size);
+      getToken();
+      factorType = exprString;
+      break;
+
+    case sSTRING :
+      /* Final stack representation is:
+       *   TOS(0) = size in bytes
+       *   TOS(1) = pointer to string data
+       */
+
+      pas_GenerateDataOperation(opPUSH, sSTRING_HDR_SIZE);
+      pas_GenerateStackReference(opLASX, tknPtr);
+      pas_GenerateStackReference(opLDSH, tknPtr);
+
+      getToken();
+      factorType = exprString;
+      break;
+
+    case sRSTRING :
+      /* Final stack representation is:
+       *   TOS(0) : size in bytes
+       *   TOS(1) : pointer to string data
+       *
+       * We get that by just cloning the reference on the top of the stack
+       */
+      pas_GenerateDataSize(tknPtr->sParm.v.size);
+      pas_GenerateStackReference(opLDSM, tknPtr);
+      getToken();
+      factorType = exprString;
+      break;
+
+    case sSCALAR :
+      if (abstractType)
+	{
+	  if (tknPtr->sParm.v.parent != abstractType) error(eSCALARTYPE);
+	} /* end if */
+      else
+	abstractType = tknPtr->sParm.v.parent;
+
+      pas_GenerateStackReference(opLDS, tknPtr);
+      getToken();
+      factorType = exprScalar;
+      break;
+
+    case sSET_OF :
+      /* If an abstractType is specified then it should either be the */
+      /* same SET OF <object> -OR- the same <object> */
+
+      if (abstractType)
+	{
+	  if ((tknPtr->sParm.v.parent != abstractType) &&
+	      (tknPtr->sParm.v.parent->sParm.t.parent != abstractType))
+	    error(eSET);
+	} /* end if */
+      else
+	abstractType = tknPtr->sParm.v.parent;
+
+      pas_GenerateStackReference(opLDS, tknPtr);
+      getToken();
+      factorType = exprSet;
+      break;
+
+      /* SET factors */
+
+    case '[' : /* Set constant */
+      getToken();
+      getSetFactor();
+      if (token != ']') error(eRBRACKET);
+      else getToken();
+      factorType = exprSet;
+      break;
+
+      /* Complex factors */
+
+    case sSUBRANGE :
+    case sRECORD :
+    case sRECORD_OBJECT :
+    case sVAR_PARM :
+    case sPOINTER :
+    case sARRAY :
+      factorType = complexFactor();
+      break;
+
+      /* Functions */
+
+    case sFUNC :
+      factorType = functionDesignator();
+      break;
+
+      /* Nested Expression */
+
+    case '(' :
+      getToken();
+      factorType = expression(exprUnknown, abstractType);
+      if (token == ')') getToken();
+      else error (eRPAREN);
+      break;
+
+      /* Address references */
+
+    case '^' :
+      getToken();
+      factorType = ptrFactor();
+      break;  
+
+      /* Highest Priority Operators */
+
+    case tNOT:
+      getToken();
+      factorType = factor(findExprType);
+      if ((factorType != exprInteger) && (factorType != exprBoolean))
+	error(eFACTORTYPE);
+      pas_GenerateSimple(opNOT);
+      break;
+
+      /* Built-in function? */
+
+    case tFUNC:
+      factorType = builtInFunction();
+      break;
+
+      /* Hmmm... Try the standard functions */
+
+    default :
+      error(eINVFACTOR);
+      break;
+
+    } /* end switch */
+
+  return factorType;
+
+} /* end factor */
+
+/***********************************************************************/
+/* Process a complex factor */
+
+static exprType complexFactor(void)
+{
+   STYPE symbolSave;
+
+   TRACE(lstFile,"[complexFactor]");
+
+   /* First, make a copy of the symbol table entry because the call to */
+   /* simpleFactor() will modify it. */
+
+   symbolSave = *tknPtr;
+   getToken();
+
+   /* Then process the complex factor until it is reduced to a simple */
+   /* factor (like int, char, etc.) */
+
+   return simpleFactor(&symbolSave, 0);
+
+} /* end complexFactor */
+
+/***********************************************************************/
+/* Process a complex factor (recursively) until it becomes a */
+/* simple factor */
+
+static exprType simpleFactor(STYPE *varPtr, ubyte factorFlags)
+{
+  STYPE *typePtr;
+  exprType factorType;
+
+  TRACE(lstFile,"[simpleFactor]");
+
+  /* Process according to the current variable sKind */
+
+  typePtr = varPtr->sParm.v.parent;
+  switch (varPtr->sKind)
+    {
+      /* Check if we have reduced the complex factor to a simple factor */
+
+    case sINT :
+      if ((factorFlags & INDEXED_FACTOR) != 0)
+	{
+	  if ((factorFlags & ADDRESS_DEREFERENCE) != 0)
+	    {
+	      pas_GenerateStackReference(opLDSX, varPtr);
+	      pas_GenerateSimple(opLDI);
+	      factorType = exprInteger;
+	    } /* end if */
+	  else if ((factorFlags & ADDRESS_FACTOR) != 0)
+	    {
+	      pas_GenerateStackReference(opLDSX, varPtr);
+	      factorType = exprIntegerPtr;
+	    } /* end else if */
+	  else
+	    {
+	      pas_GenerateStackReference(opLDSX, varPtr);
+	      factorType = exprInteger;
+	    } /* end else */
+	} /* end if */
+      else
+	{
+	  if ((factorFlags & ADDRESS_DEREFERENCE) != 0)
+	    {
+	      pas_GenerateStackReference(opLDS, varPtr);
+	      pas_GenerateSimple(opLDI);
+	      factorType = exprInteger;
+	    } /* end if */
+	  else if ((factorFlags & ADDRESS_FACTOR) != 0)
+	    {
+	      pas_GenerateStackReference(opLDS, varPtr);
+	      factorType = exprIntegerPtr;
+	    } /* end else if */
+	   else
+	     {
+	      pas_GenerateStackReference(opLDS, varPtr);
+	       factorType = exprInteger;
+	     } /* end else */
+	} /* end else */
+      break;
+    case sCHAR :
+      if ((factorFlags & INDEXED_FACTOR) != 0)
+	{
+	  if ((factorFlags & ADDRESS_DEREFERENCE) != 0)
+	    {
+	      pas_GenerateStackReference(opLDSX, varPtr);
+	      pas_GenerateSimple(opLDIB);
+	      factorType = exprChar;
+	    } /* end if */
+	  else if ((factorFlags & ADDRESS_FACTOR) != 0)
+	    {
+	      pas_GenerateStackReference(opLDSX, varPtr);
+	      factorType = exprCharPtr;
+	    } /* end else if */
+	  else
+	    {
+	      pas_GenerateStackReference(opLDSXB, varPtr);
+	      factorType = exprChar;
+	    } /* end else */
+	} /* end if */
+      else
+	{
+	  if ((factorFlags & ADDRESS_DEREFERENCE) != 0)
+	    {
+	      pas_GenerateStackReference(opLDS, varPtr);
+	      pas_GenerateSimple(opLDIB);
+	      factorType = exprChar;
+	    } /* end if */
+	  else if ((factorFlags & ADDRESS_FACTOR) != 0)
+	    {
+	      pas_GenerateStackReference(opLDS, varPtr);
+	      factorType = exprCharPtr;
+	    } /* end else if */
+	  else
+	    {
+	      pas_GenerateStackReference(opLDSB, varPtr);
+	      factorType = exprChar;
+	    } /* end else */
+	} /* end else */
+      break;
+    case sBOOLEAN :
+      if ((factorFlags & INDEXED_FACTOR) != 0)
+	{
+	  if ((factorFlags & ADDRESS_DEREFERENCE) != 0)
+	    {
+	      pas_GenerateStackReference(opLDSX, varPtr);
+	      pas_GenerateSimple(opLDI);
+	      factorType = exprBoolean;
+	    } /* end if */
+	  else if ((factorFlags & ADDRESS_FACTOR) != 0)
+	    {
+	      pas_GenerateStackReference(opLDSX, varPtr);
+	      factorType = exprBooleanPtr;
+	    } /* end else if */
+	  else
+	    {
+	      pas_GenerateStackReference(opLDSX, varPtr);
+	      factorType = exprBoolean;
+	    } /* end else */
+	} /* end if */
+      else
+	{
+	  if ((factorFlags & ADDRESS_DEREFERENCE) != 0)
+	    {
+	      pas_GenerateStackReference(opLDS, varPtr);
+	      pas_GenerateSimple(opLDI);
+	      factorType = exprBoolean;
+	    } /* end if */
+	  else if ((factorFlags & ADDRESS_FACTOR) != 0)
+	    {
+	      pas_GenerateStackReference(opLDS, varPtr);
+	      factorType = exprBooleanPtr;
+	    } /* end else if */
+	  else
+	    {
+	      pas_GenerateStackReference(opLDS, varPtr);
+	      factorType = exprBoolean;
+	    } /* end else */
+	} /* end else */
+      break;
+    case sREAL         :
+      if ((factorFlags & INDEXED_FACTOR) != 0)
+	{
+	  if ((factorFlags & ADDRESS_DEREFERENCE) != 0)
+	    {
+	      pas_GenerateStackReference(opLDSX, varPtr);
+	      pas_GenerateDataSize(varPtr->sParm.v.size);
+	      pas_GenerateSimple(opLDIM);
+	      factorType = exprReal;
+	    } /* end if */
+	  else if ((factorFlags & ADDRESS_FACTOR) != 0)
+	    {
+	      pas_GenerateStackReference(opLDSX, varPtr);
+	      factorType = exprRealPtr;
+	    } /* end else if */
+	  else
+	    {
+	      pas_GenerateDataSize(varPtr->sParm.v.size);
+	      pas_GenerateStackReference(opLDSXM, varPtr);
+	      factorType = exprReal;
+	    } /* end else */
+	} /* end if */
+      else
+	{
+	  if ((factorFlags & ADDRESS_DEREFERENCE) != 0)
+	    {
+	      pas_GenerateStackReference(opLDS, varPtr);
+	      pas_GenerateDataSize(varPtr->sParm.v.size);
+	      pas_GenerateSimple(opLDIM);
+	      factorType = exprReal;
+	    } /* end if */
+	  else if ((factorFlags & ADDRESS_FACTOR) != 0)
+	    {
+	      pas_GenerateStackReference(opLDS, varPtr);
+	      factorType = exprRealPtr;
+	    } /* end else if */
+	  else
+	    {
+	      pas_GenerateDataSize(varPtr->sParm.v.size);
+	      pas_GenerateStackReference(opLDSM, varPtr);
+	      factorType = exprReal;
+	    } /* end else */
+	} /* end else */
+      break;
+    case sSCALAR :
+      if (!abstractType)
+	abstractType = typePtr;
+      else if (typePtr != abstractType)
+	error(eSCALARTYPE);
+
+      if ((factorFlags & INDEXED_FACTOR) != 0)
+	{
+	  if ((factorFlags & ADDRESS_DEREFERENCE) != 0)
+	    {
+	      pas_GenerateStackReference(opLDSX, varPtr);
+	      pas_GenerateSimple(opLDI);
+	      factorType = exprScalar;
+	    } /* end if */
+	  else if ((factorFlags & ADDRESS_FACTOR) != 0)
+	    {
+	      pas_GenerateStackReference(opLDSX, varPtr);
+	      factorType = exprScalarPtr;
+	    } /* end else if */
+	  else
+	    {
+	      pas_GenerateStackReference(opLDSX, varPtr);
+	      factorType = exprScalar;
+	    } /* end else */
+	} /* end if */
+      else
+	{
+	  if ((factorFlags & ADDRESS_DEREFERENCE) != 0)
+	    {
+	      pas_GenerateStackReference(opLDS, varPtr);
+	      pas_GenerateSimple(opLDI);
+	      factorType = exprScalar;
+	    } /* end if */
+	  else if ((factorFlags & ADDRESS_FACTOR) != 0)
+	    {
+	      pas_GenerateStackReference(opLDS, varPtr);
+	      factorType = exprScalarPtr;
+	    } /* end else if */
+	  else
+	    {
+	      pas_GenerateStackReference(opLDS, varPtr);
+	      factorType = exprScalar;
+	    } /* end else */
+	} /* end else */
+      break;
+    case sSET_OF :
+      if (!abstractType)
+	abstractType = typePtr;
+      else if ((typePtr != abstractType) &&
+	       (typePtr->sParm.v.parent != abstractType))
+	error(eSCALARTYPE);
+
+      if ((factorFlags & INDEXED_FACTOR) != 0)
+	{
+	  if ((factorFlags & ADDRESS_DEREFERENCE) != 0)
+	    {
+	      pas_GenerateStackReference(opLDSX, varPtr);
+	      pas_GenerateSimple(opLDI);
+	      factorType = exprSet;
+	    } /* end if */
+	  else if ((factorFlags & ADDRESS_FACTOR) != 0)
+	    {
+	      pas_GenerateStackReference(opLDSX, varPtr);
+	      factorType = exprSetPtr;
+	    } /* end else if */
+	  else
+	    {
+	      pas_GenerateStackReference(opLDSX, varPtr);
+	      factorType = exprSet;
+	    } /* end else */
+	} /* end if */
+      else
+	{
+	  if ((factorFlags & ADDRESS_DEREFERENCE) != 0)
+	    {
+	      pas_GenerateStackReference(opLDS, varPtr);
+	      pas_GenerateSimple(opLDI);
+	      factorType = exprSet;
+	    } /* end if */
+	  else if ((factorFlags & ADDRESS_FACTOR) != 0)
+	    {
+	      pas_GenerateStackReference(opLDS, varPtr);
+	      factorType = exprSetPtr;
+	    } /* end else if */
+	  else
+	    {
+	      pas_GenerateStackReference(opLDS, varPtr);
+	      factorType = exprSet;
+	    } /* end else */
+	} /* end else */
+      break;
+
+      /* NOPE... recurse until it becomes a simple factor */
+
+    case sSUBRANGE :
+      if (!abstractType) abstractType = typePtr;
+      varPtr->sKind = typePtr->sParm.t.subType;
+      factorType = simpleFactor(varPtr, factorFlags);
+      break;
+
+    case sRECORD :
+      /* Check if this is a pointer to a record */
+
+      if ((factorFlags & ADDRESS_FACTOR) != 0)
+	{
+	  if (token == '.') error(ePOINTERTYPE);
+
+	  if ((factorFlags & INDEXED_FACTOR) != 0)
+	    pas_GenerateStackReference(opLDSX, varPtr);
+	  else
+	    pas_GenerateStackReference(opLDS, varPtr);
+
+	  factorType = exprRecordPtr;
+	} /* end if */
+
+      /* Verify that a period separates the RECORD identifier from the */
+      /* record field identifier */
+
+      else if (token == '.')
+	{
+	  if (((factorFlags & ADDRESS_DEREFERENCE) != 0) &&
+	      ((factorFlags & VAR_PARM_FACTOR) == 0))
+	    error(ePOINTERTYPE);
+
+	  /* Skip over the period. */
+
+	  getToken();
+
+	  /* Verify that a field identifier associated with this record */
+	  /* follows the period. */
+
+	  if ((token != sRECORD_OBJECT) ||
+	      (tknPtr->sParm.r.record != typePtr))
+	    {
+	      error(eRECORDOBJECT);
+	      factorType = exprInteger;
+	    } /* end if */
+	  else
+	    {
+	      /* Modify the variable so that it has the characteristics of the */
+	      /* the field but with level and offset associated with the record */
+
+	      typePtr                 = tknPtr->sParm.r.parent;
+	      varPtr->sKind           = typePtr->sParm.t.type;
+	      varPtr->sParm.v.parent  = typePtr;
+
+	      /* Special case:  The record is a VAR parameter. */
+
+	      if (factorFlags == (INDEXED_FACTOR | ADDRESS_DEREFERENCE | VAR_PARM_FACTOR))
+		{
+		  pas_GenerateDataOperation(opPUSH, tknPtr->sParm.r.offset);
+		  pas_GenerateSimple(opADD);
+		} /* end if */
+	      else
+		varPtr->sParm.v.offset += tknPtr->sParm.r.offset;
+
+	      getToken();
+	      factorType = simpleFactor(varPtr, factorFlags);
+	    } /* end else */
+	} /* end else if */
+
+      /* A RECORD name name be a valid factor -- as the input */
+      /* parameter of a function or in an assignment */
+
+      else if (abstractType == typePtr)
+	{
+	  /* Special case:  The record is a VAR parameter. */
+
+	  if (factorFlags == (INDEXED_FACTOR | ADDRESS_DEREFERENCE | VAR_PARM_FACTOR))
+	    {
+	      pas_GenerateStackReference(opLDS, varPtr);
+	      pas_GenerateSimple(opADD);
+	      pas_GenerateDataSize(varPtr->sParm.v.size);
+	      pas_GenerateSimple(opLDIM);
+	    } /* end if */
+	  else
+	    {
+	      pas_GenerateDataSize(varPtr->sParm.v.size);
+	      pas_GenerateStackReference(opLDSM, varPtr);
+	    } /* end else */
+
+	  factorType = exprRecord;
+	} /* end else if */
+      else error(ePERIOD);
+      break;
+
+    case sRECORD_OBJECT :
+      /* NOTE:  This must have been preceeded with a WITH statement */
+      /* defining the RECORD type */
+
+      if (!withRecord.parent)
+	error(eINVTYPE);
+      else if ((factorFlags && (ADDRESS_DEREFERENCE | ADDRESS_FACTOR)) != 0)
+	error(ePOINTERTYPE);
+      else if ((factorFlags && INDEXED_FACTOR) != 0)
+	error(eARRAYTYPE);
+
+      /* Verify that a field identifier is associated with the RECORD */
+      /* specified by the WITH statement. */
+
+      else if (varPtr->sParm.r.record != withRecord.parent)
+	error(eRECORDOBJECT);
+      else
+	{
+	  sint16 tempOffset;
+
+	  /* Now there are two cases to consider:  (1) the withRecord is a */
+	  /* pointer to a RECORD, or (2) the withRecord is the RECOR itself */
+
+	  if (withRecord.pointer)
+	    {
+	      /* If the pointer is really a VAR parameter, then other syntax */
+	      /* rules will apply */
+
+	      if (withRecord.varParm)
+		factorFlags |= (INDEXED_FACTOR | ADDRESS_DEREFERENCE | VAR_PARM_FACTOR);
+	      else
+		factorFlags |= (INDEXED_FACTOR | ADDRESS_DEREFERENCE);
+
+	      pas_GenerateDataOperation(opPUSH, (varPtr->sParm.r.offset + withRecord.index));
+	      tempOffset   = withRecord.offset;
+	    } /* end if */
+	  else
+	    {
+	      tempOffset   = varPtr->sParm.r.offset + withRecord.offset;
+	    } /* end else */
+
+	  /* Modify the variable so that it has the characteristics of the */
+	  /* the field but with level and offset associated with the record */
+	  /* NOTE:  We have to be careful here because the structure */
+	  /* associated with sRECORD_OBJECT is not the same as for */
+	  /* variables! */
+
+	  typePtr                 = varPtr->sParm.r.parent;
+	  tempOffset              = varPtr->sParm.r.offset;
+
+	  varPtr->sKind           = typePtr->sParm.t.type;
+	  varPtr->sLevel          = withRecord.level;
+	  varPtr->sParm.v.size    = typePtr->sParm.t.asize;
+	  varPtr->sParm.v.offset  = tempOffset + withRecord.offset;
+	  varPtr->sParm.v.parent  = typePtr;
+
+	  factorType = simpleFactor(varPtr, factorFlags);
+	} /* end else */
+      break;
+
+    case sPOINTER :
+      if (token == '^')
+	{
+	  getToken();
+	  factorFlags |= ADDRESS_DEREFERENCE;
+	} /* end if */
+      else
+	factorFlags |= ADDRESS_FACTOR;
+
+      varPtr->sKind  = typePtr->sParm.t.type;
+      factorType     = simpleFactor(varPtr, factorFlags);
+      break;
+
+    case sVAR_PARM :
+      if (factorFlags != 0) error(eVARPARMTYPE);
+      factorFlags  |= (ADDRESS_DEREFERENCE | VAR_PARM_FACTOR);
+
+      varPtr->sKind = typePtr->sParm.t.type;
+      factorType    = simpleFactor(varPtr, factorFlags);
+      break;
+
+    case sARRAY :
+      if (factorFlags != 0) error(eARRAYTYPE);
+
+      if (token == '[')
+	{
+	  factorFlags         |= INDEXED_FACTOR;
+	  arrayIndex(typePtr->sParm.t.asize);
+	  varPtr->sKind        = typePtr->sParm.t.type;
+	  varPtr->sParm.v.size = typePtr->sParm.t.asize;
+	  factorType           = simpleFactor(varPtr, factorFlags);
+	} /* end if */
+
+      /* An ARRAY name name be a valid factor -- only as the input */
+      /* parameter of a function */
+
+      else if (abstractType == varPtr)
+	{
+	  pas_GenerateDataSize(varPtr->sParm.v.size);
+	  pas_GenerateStackReference(opLDSM, varPtr);
+	  factorType = exprArray;
+	} /* end else if */
+      else error(eLBRACKET);
+      break;
+
+    default :
+      error(eINVTYPE);
+      factorType = exprInteger;
+      break;
+    } /* end switch */
+
+  return factorType;
+
+} /* end simpleFactor */
+
+/**********************************************************************/
+/* Process a factor of the for ^variable OR a VAR parameter (where the
+ * ^ is implicit. */
+
+static exprType ptrFactor(void)
+{
+   exprType factorType;
+
+   TRACE(lstFile,"[ptrFactor]");
+
+   /* Process by token type */
+
+   switch (token) {
+
+     /* Pointers to simple types */
+
+     case sINT              :
+       pas_GenerateStackReference(opLAS, tknPtr);
+       getToken();
+       factorType = exprIntegerPtr;
+       break;
+     case sBOOLEAN :
+       pas_GenerateStackReference(opLAS, tknPtr);
+       getToken();
+       factorType = exprBooleanPtr;
+       break;
+     case sCHAR           :
+       pas_GenerateStackReference(opLAS, tknPtr);
+       getToken();
+       factorType = exprCharPtr;
+       break;
+     case sREAL              :
+       pas_GenerateStackReference(opLAS, tknPtr);
+       getToken();
+       factorType = exprRealPtr;
+       break;
+     case sSCALAR :
+       if (abstractType)
+	 {
+	   if (tknPtr->sParm.v.parent != abstractType) error(eSCALARTYPE);
+	 } /* end if */
+       else
+	 abstractType = tknPtr->sParm.v.parent;
+
+       pas_GenerateStackReference(opLAS, tknPtr);
+       getToken();
+       factorType = exprScalarPtr;
+       break;
+     case sSET_OF :
+       /* If an abstractType is specified then it should either be the */
+       /* same SET OF <object> -OR- the same <object> */
+
+       if (abstractType) {
+	 if ((tknPtr->sParm.v.parent != abstractType)
+	 &&   (tknPtr->sParm.v.parent->sParm.t.parent != abstractType))
+	   error(eSET);
+       } /* end if */
+       else
+	 abstractType = tknPtr->sParm.v.parent;
+       pas_GenerateStackReference(opLAS, tknPtr);
+       getToken();
+       factorType = exprSetPtr;
+       break;
+
+     /* Complex factors */
+
+     case sSUBRANGE :
+     case sRECORD :
+     case sRECORD_OBJECT :
+     case sVAR_PARM :
+     case sPOINTER :
+     case sARRAY :
+       factorType = complexPtrFactor();
+       break;
+
+     /* References to address of a pointer */
+
+     case '^' :
+       error(eNOTYET);
+       getToken();
+       factorType = ptrFactor();
+       break;  
+
+     case '('             :
+       getToken();
+       factorType = ptrFactor();
+       if (token != ')') error (eRPAREN);
+       else getToken();
+       break;
+
+     default :
+       error(ePTRADR);
+       break;
+
+   } /* end switch */
+
+   return factorType;
+
+} /* end ptrFactor */
+
+/***********************************************************************/
+/* Process a complex factor */
+
+static exprType complexPtrFactor(void)
+{
+   STYPE symbolSave;
+
+   TRACE(lstFile,"[complexPtrFactor]");
+
+   /* First, make a copy of the symbol table entry because the call to */
+   /* simplePtrFactor() will modify it. */
+
+   symbolSave = *tknPtr;
+   getToken();
+
+   /* Then process the complex factor until it is reduced to a simple */
+   /* factor (like int, char, etc.) */
+
+   return simplePtrFactor(&symbolSave, 0);
+
+} /* end complexPtrFactor */
+
+/***********************************************************************/
+/* Process a complex factor (recursively) until it becomes a */
+/* simple simple */
+
+static exprType simplePtrFactor(STYPE *varPtr, ubyte factorFlags)
+{
+  STYPE *typePtr;
+  exprType factorType;
+
+  TRACE(lstFile,"[simplePtrFactor]");
+
+  /* Process according to the current variable sKind */
+
+  typePtr = varPtr->sParm.v.parent;
+  switch (varPtr->sKind)
+    {
+      /* Check if we have reduced the complex factor to a simple factor */
+    case sINT :
+      if ((factorFlags & INDEXED_FACTOR) != 0)
+	{
+	  if ((factorFlags & ADDRESS_DEREFERENCE) != 0)
+	    {
+	      pas_GenerateStackReference(opLDSX, varPtr);
+	    } /* end if */
+	  else
+	    {
+	      pas_GenerateStackReference(opLASX, varPtr);
+	    } /* end else */
+	  factorType = exprIntegerPtr;
+	} /* end if */
+      else
+	{
+	  if ((factorFlags & ADDRESS_DEREFERENCE) != 0)
+	    {
+	      pas_GenerateStackReference(opLDS, varPtr);
+	    } /* end if */
+	  else
+	    {
+	      pas_GenerateStackReference(opLAS, varPtr);
+	    } /* end else */
+	  factorType = exprIntegerPtr;
+	} /* end else */
+      break;
+    case sCHAR :
+      if ((factorFlags & INDEXED_FACTOR) != 0)
+	{
+	  if ((factorFlags & ADDRESS_DEREFERENCE) != 0)
+	    {
+	      pas_GenerateStackReference(opLDSX, varPtr);
+	    } /* end if */
+	  else
+	    {
+	      pas_GenerateStackReference(opLASX, varPtr);
+	    } /* end else */
+	  factorType = exprCharPtr;
+	} /* end if */
+      else
+	{
+	  if ((factorFlags & ADDRESS_DEREFERENCE) != 0)
+	    {
+	      pas_GenerateStackReference(opLDS, varPtr);
+	    } /* end if */
+	  else
+	    {
+	      pas_GenerateStackReference(opLAS, varPtr);
+	    } /* end else */
+	  factorType = exprCharPtr;
+	} /* end else */
+      break;
+    case sBOOLEAN :
+      if ((factorFlags & INDEXED_FACTOR) != 0)
+	{
+	  if ((factorFlags & ADDRESS_DEREFERENCE) != 0)
+	    {
+	      pas_GenerateStackReference(opLDSX, varPtr);
+	    } /* end if */
+	  else
+	    {
+	      pas_GenerateStackReference(opLASX, varPtr);
+	    } /* end else */
+	  factorType = exprBooleanPtr;
+	} /* end if */
+      else
+	{
+	  if ((factorFlags & ADDRESS_DEREFERENCE) != 0)
+	    {
+	      pas_GenerateStackReference(opLDS, varPtr);
+	    } /* end if */
+	  else
+	    {
+	      pas_GenerateStackReference(opLAS, varPtr);
+	    } /* end else */
+	  factorType = exprBooleanPtr;
+	} /* end else */
+      break;
+    case sREAL         :
+      if ((factorFlags & INDEXED_FACTOR) != 0)
+	{
+	  if ((factorFlags & ADDRESS_DEREFERENCE) != 0)
+	    {
+	      pas_GenerateStackReference(opLDSX, varPtr);
+	    } /* end if */
+	  else
+	    {
+	      pas_GenerateStackReference(opLASX, varPtr);
+	    } /* end else */
+	  factorType = exprRealPtr;
+	} /* end if */
+      else
+	{
+	  if ((factorFlags & ADDRESS_DEREFERENCE) != 0)
+	    {
+	      pas_GenerateStackReference(opLDS, varPtr);
+	    } /* end if */
+	  else
+	    {
+	      pas_GenerateStackReference(opLAS, varPtr);
+	    } /* end else */
+	  factorType = exprRealPtr;
+	} /* end else */
+      break;
+    case sSCALAR :
+      if (!abstractType)
+	abstractType = typePtr;
+      else if (typePtr != abstractType)
+	error(eSCALARTYPE);
+
+      if ((factorFlags & INDEXED_FACTOR) != 0)
+	{
+	  if ((factorFlags & ADDRESS_DEREFERENCE) != 0)
+	    {
+	      pas_GenerateStackReference(opLDSX, varPtr);
+	    } /* end if */
+	  else
+	    {
+	      pas_GenerateStackReference(opLASX, varPtr);
+	    } /* end else */
+	  factorType = exprScalarPtr;
+	} /* end if */
+      else
+	{
+	  if ((factorFlags & ADDRESS_DEREFERENCE) != 0)
+	    {
+	      pas_GenerateStackReference(opLDS, varPtr);
+	    } /* end if */
+	  else
+	    {
+	      pas_GenerateStackReference(opLAS, varPtr);
+	    } /* end else */
+	  factorType = exprScalarPtr;
+	} /* end else */
+      break;
+    case sSET_OF :
+      if (!abstractType)
+	abstractType = typePtr;
+      else if ((typePtr != abstractType) &&
+	       (typePtr->sParm.v.parent != abstractType))
+	error(eSCALARTYPE);
+
+      if ((factorFlags & INDEXED_FACTOR) != 0)
+	{
+	  if ((factorFlags & ADDRESS_DEREFERENCE) != 0)
+	    {
+	      pas_GenerateStackReference(opLDSX, varPtr);
+	    } /* end if */
+	  else
+	    {
+	      pas_GenerateStackReference(opLASX, varPtr);
+	    } /* end else */
+	  factorType = exprSetPtr;
+	} /* end if */
+      else
+	{
+	  if ((factorFlags & ADDRESS_DEREFERENCE) != 0)
+	    {
+	      pas_GenerateStackReference(opLDS, varPtr);
+	    } /* end if */
+	  else
+	    {
+	      pas_GenerateStackReference(opLAS, varPtr);
+	    } /* end else */
+	  factorType = exprSetPtr;
+	} /* end else */
+      break;
+
+      /* NOPE... recurse until it becomes a simple factor */
+
+    case sSUBRANGE :
+      if (!abstractType) abstractType = typePtr;
+      varPtr->sKind = typePtr->sParm.t.subType;
+      factorType = simplePtrFactor(varPtr, factorFlags);
+      break;
+
+    case sRECORD :
+      /* Check if this is a pointer to a record */
+
+      if (token != '.')
+	{
+	  if ((factorFlags & ADDRESS_DEREFERENCE) != 0)
+	    error(ePOINTERTYPE);
+
+	  if ((factorFlags & INDEXED_FACTOR) != 0)
+	    pas_GenerateStackReference(opLASX, varPtr);
+	  else
+	    pas_GenerateStackReference(opLAS, varPtr);
+
+	  factorType = exprRecordPtr;
+	} /* end if */
+      else
+	{
+	  /* Verify that a period separates the RECORD identifier from the
+	   * record field identifier
+	   */
+
+	  if (token != '.') error(ePERIOD);
+	  else getToken();
+
+	  /* Verify that a field identifier associated with this record
+	   * follows the period.
+	   */
+
+	  if ((token != sRECORD_OBJECT) ||
+	      (tknPtr->sParm.r.record != typePtr))
+	    {
+	      error(eRECORDOBJECT);
+	      factorType = exprInteger;
+	    } /* end if */
+	  else
+	    {
+	      /* Modify the variable so that it has the characteristics
+	       * of the field but with level and offset associated with
+	       * the record
+	       */
+
+	      typePtr                 = tknPtr->sParm.r.parent;
+	      varPtr->sKind           = typePtr->sParm.t.type;
+	      varPtr->sParm.v.offset += tknPtr->sParm.r.offset;
+	      varPtr->sParm.v.parent  = typePtr;
+
+	      getToken();
+	      factorType = simplePtrFactor(varPtr, factorFlags);
+
+	    } /* end else */
+	} /* end else */
+      break;
+
+    case sRECORD_OBJECT :
+      /* NOTE:  This must have been preceeded with a WITH statement
+       * defining the RECORD type
+       */
+
+      if (!withRecord.parent)
+	error(eINVTYPE);
+      else if ((factorFlags && ADDRESS_DEREFERENCE) != 0)
+	error(ePOINTERTYPE);
+      else if ((factorFlags && INDEXED_FACTOR) != 0)
+	error(eARRAYTYPE);
+
+      /* Verify that a field identifier is associated with the RECORD
+       * specified by the WITH statement.
+       */
+
+      else if (varPtr->sParm.r.record != withRecord.parent)
+	error(eRECORDOBJECT);
+      else
+	{
+	  sint16 tempOffset;
+
+	  /* Now there are two cases to consider:  (1) the withRecord is a
+	   * pointer to a RECORD, or (2) the withRecord is the RECOR itself
+	   */
+
+	  if (withRecord.pointer)
+	    {
+	      pas_GenerateDataOperation(opPUSH, (varPtr->sParm.r.offset + withRecord.index));
+	      factorFlags |= (INDEXED_FACTOR | ADDRESS_DEREFERENCE);
+	      tempOffset   = withRecord.offset;
+	    } /* end if */
+	  else
+	    {
+	      tempOffset   = varPtr->sParm.r.offset + withRecord.offset;
+	    } /* end else */
+
+	  /* Modify the variable so that it has the characteristics of the
+	   * the field but with level and offset associated with the record
+	   * NOTE:  We have to be careful here because the structure
+	   * associated with sRECORD_OBJECT is not the same as for
+	   * variables!
+	   */
+
+	  typePtr                 = varPtr->sParm.r.parent;
+	  tempOffset              = varPtr->sParm.r.offset;
+
+	  varPtr->sKind           = typePtr->sParm.t.type;
+	  varPtr->sLevel          = withRecord.level;
+	  varPtr->sParm.v.size    = typePtr->sParm.t.asize;
+	  varPtr->sParm.v.offset  = tempOffset + withRecord.offset;
+	  varPtr->sParm.v.parent  = typePtr;
+
+	  factorType = simplePtrFactor(varPtr, factorFlags);
+	} /* end else */
+      break;
+
+    case sPOINTER :
+      if (token == '^') error(ePTRADR);
+      else getToken();
+
+      factorFlags   |= ADDRESS_DEREFERENCE;
+      varPtr->sKind  = typePtr->sParm.t.type;
+      factorType     = simplePtrFactor(varPtr, factorFlags);
+      break;
+
+    case sVAR_PARM :
+      if (factorFlags != 0) error(eVARPARMTYPE);
+      factorFlags  |= ADDRESS_DEREFERENCE;
+
+      varPtr->sKind = typePtr->sParm.t.type;
+      factorType    = simplePtrFactor(varPtr, factorFlags);
+      break;
+
+    case sARRAY :
+      if (factorFlags != 0) error(eARRAYTYPE);
+      if (token == '[')
+	{
+	  factorFlags         |= INDEXED_FACTOR;
+
+	  arrayIndex(typePtr->sParm.t.asize);
+	  varPtr->sKind        = typePtr->sParm.t.type;
+	  varPtr->sParm.v.size = typePtr->sParm.t.asize;
+	  factorType           = simplePtrFactor(varPtr, factorFlags);
+	} /* end if */
+      else
+	{
+	  pas_GenerateStackReference(opLAS, varPtr);
+	  factorType = exprArrayPtr;
+	} /* end else */
+      break;
+
+    default :
+      error(eINVTYPE);
+      factorType = exprInteger;
+      break;
+
+    } /* end switch */
+
+  return factorType;
+
+} /* end simplePtrFactor */
+
+/***********************************************************************/
+
+static exprType functionDesignator(void)
+{
+  STYPE *funcPtr = tknPtr;
+  STYPE *typePtr = funcPtr->sParm.p.parent;
+  exprType factorType;
+  int size = 0;
+
+  TRACE(lstFile,"[functionDesignator]");
+
+  /* FORM: function-designator =
+   *       function-identifier [ actual-parameter-list ]
+   */
+
+  /* Allocate stack space for a reference instance of the type
+   * returned by the function.  This is an uninitalized "container"
+   * that will catch the valued returned by the function.
+   *
+   * Check for the special case of a string value.  In this case,
+   * the container cannot be empty.  Rather, it must refer to an
+   * empty string allocated on the string strack
+   */
+
+  if (typePtr->sParm.t.rtype == sRSTRING)
+    {
+      /* Create and empty string reference */
+
+      pas_BuiltInFunctionCall(lbMKSTK);
+    }
+  else
+    {
+      /* Okay, create the empty container */
+
+      pas_GenerateDataOperation(opINDS, typePtr->sParm.t.rsize);
+    }
+
+  /* Get the type of the function */
+
+  factorType = getExprType(typePtr);
+  setAbstractType(typePtr);
+
+   /* Skip over the function-identifier */
+
+  getToken();
+
+  /* Get the actual parameters (if any) associated with the procedure
+   * call.  This will lie in the stack "above" the function return
+   * value container.
+   */
+
+  size = actualParameterList(funcPtr);
+
+  /* Generate function call and stack adjustment (if required) */
+
+  pas_GenerateProcedureCall(funcPtr);
+
+  /* Release the actual parameter list (if any). */
+
+  if (size)
+    {
+      pas_GenerateDataOperation(opINDS, -size);
+    }
+
+  return factorType;
+
+} /* end functionDesignator */
+
+/*************************************************************************/
+/* Determine the expression type associated with a pointer to a type */
+/* symbol */
+
+static void setAbstractType(STYPE *sType)
+{
+   TRACE(lstFile,"[setAbstractType]");
+
+   if ((sType) && (sType->sKind == sTYPE)
+   &&   (sType->sParm.t.type == sPOINTER))
+     sType = sType->sParm.t.parent;
+       
+   if ((sType) && (sType->sKind == sTYPE)) {
+     switch (sType->sParm.t.type) {
+       case sSCALAR :
+	 if (abstractType) {
+           if (sType != abstractType) error(eSCALARTYPE);
+         } /* end if */
+         else
+           abstractType = sType;
+	 break;
+       case sSUBRANGE :
+	 if (!abstractType)
+	   abstractType = sType;
+	 else if ((abstractType->sParm.t.type != sSUBRANGE)
+         ||        (abstractType->sParm.t.subType != sType->sParm.t.subType))
+           error(eSUBRANGETYPE);
+	 switch (sType->sParm.t.subType) {
+	   case sINT :
+	   case sCHAR :
+	     break;
+	   case sSCALAR :
+             if (abstractType != sType) error(eSUBRANGETYPE);
+	     break;
+	   default :
+	     error(eSUBRANGETYPE);
+	     break;
+	 } /* end switch */
+	 break;
+     } /* end switch */
+   } /* end if */
+   else error(eINVTYPE);
+
+} /* end setAbstractType */
+
+/***************************************************************/
+static void getSetFactor(void)
+{
+   setTypeStruct s;
+
+   TRACE(lstFile,"[getSetFactor]");
+
+   /* FORM: [[<constant>[,<constant>[, ...]]]] */
+   /* ASSUMPTION:  The first '[' has already been processed */
+
+   /* First, verify that a scalar expression type has been specified */
+   /* If the abstractType is a SET, then we will need to get the TYPE */
+   /* that it is a SET OF */
+
+   if (abstractType) {
+     if (abstractType->sParm.t.type == sSET_OF)
+       s.typePtr = abstractType->sParm.t.parent;
+     else
+       s.typePtr = abstractType;
+   } /* end if */
+   else
+     s.typePtr   = NULL;
+
+   /* Now, get the associated type and MIN/MAX values */
+
+   if ((s.typePtr) && (s.typePtr->sParm.t.type == sSCALAR)) {
+     s.typeFound = TRUE;
+     s.setType   = sSCALAR;
+     s.minValue  = s.typePtr->sParm.t.minValue;
+     s.maxValue  = s.typePtr->sParm.t.maxValue;
+   } /* end else if */
+   else if ((s.typePtr) && (s.typePtr->sParm.t.type == sSUBRANGE)) {
+     s.typeFound = TRUE;
+     s.setType   = s.typePtr->sParm.t.subType;
+     s.minValue  = s.typePtr->sParm.t.minValue;
+     s.maxValue  = s.typePtr->sParm.t.maxValue;
+   } /* end else if */
+   else {
+     error(eSET);
+     s.typeFound = FALSE;
+     s.typePtr   = NULL;
+     s.minValue  = 0;
+     s.maxValue  = BITS_IN_INTEGER-1;
+   } /* end else */
+
+   /* Get the first element of the set */
+
+   getSetElement(&s);
+
+   /* Incorporate each additional element into the set */
+   /* NOTE:  The optimizer will combine sets of constant elements into a */
+   /* single PUSH! */
+
+   while (token == ',') {
+
+     /* Get the next element of the set */
+     getToken();
+     getSetElement(&s);
+
+     /* OR it with the previous element */
+     pas_GenerateSimple(opOR);
+
+   } /* end while */
+
+} /* end getSetFactor */
+
+/***************************************************************/
+static void getSetElement(setTypeStruct *s)
+{
+   uint16  setValue;
+   sint16  firstValue;
+   sint16  lastValue;
+   STYPE  *setPtr;
+
+   TRACE(lstFile,"[getSetElement]");
+
+   switch (token) {
+     case sSCALAR_OBJECT : /* A scalar or scalar subrange constant */
+       firstValue = tknPtr->sParm.c.val.i;
+       if (!s->typeFound) {
+	 s->typeFound = TRUE;
+	 s->typePtr   = tknPtr->sParm.c.parent;
+	 s->setType   = sSCALAR;
+	 s->minValue  = s->typePtr->sParm.t.minValue;
+	 s->maxValue  = s->typePtr->sParm.t.maxValue;
+       } /* end if */
+       else if ((s->setType != sSCALAR)
+       ||        (s->typePtr != tknPtr->sParm.c.parent))
+         error(eSET);
+       goto addBit;
+
+     case tINT_CONST : /* An integer subrange constant ? */
+       firstValue = tknInt;
+       if (!s->typeFound) {
+	 s->typeFound = TRUE;
+	 s->setType   = sINT;
+       } /* end if */
+       else if (s->setType != sINT)
+         error(eSET);
+       goto addBit;
+
+     case tCHAR_CONST : /* A character subrange constant */
+       firstValue = tknInt;
+       if (!s->typeFound) {
+	 s->typeFound = TRUE;
+	 s->setType   = sCHAR;
+       } /* end if */
+       else if (s->setType != sCHAR)
+         error(eSET);
+
+     addBit:
+       /* Check if the constant set element is the first value in a */
+       /* subrange of values */
+
+       getToken();
+       if (token != tSUBRANGE) {
+
+	 /* Verify that the new value is in range */
+
+         if ((firstValue < s->minValue) || (firstValue > s->maxValue)) {
+	   error(eSETRANGE);
+	   setValue = 0;
+         } /* end if */
+         else
+	   setValue = (1 << (firstValue - s->minValue));
+
+         /* Now, generate P-Code to push the set value onto the stack */
+
+	 pas_GenerateDataOperation(opPUSH, setValue);
+
+       } /* end if */
+       else {
+         if (!s->typeFound) error(eSUBRANGETYPE);
+
+	 /* Skip over the tSUBRANGE token */
+
+	 getToken();
+
+	 /* TYPE check */
+
+	 switch (token) {
+           case sSCALAR_OBJECT : /* A scalar or scalar subrange constant */
+	     lastValue = tknPtr->sParm.c.val.i;
+	     if ((s->setType != sSCALAR)
+	     ||   (s->typePtr != tknPtr->sParm.c.parent))
+	       error(eSET);
+	     goto addLottaBits;
+
+	   case tINT_CONST : /* An integer subrange constant ? */
+	     lastValue = tknInt;
+	     if (s->setType != sINT) error(eSET);
+	     goto addLottaBits;
+
+	   case tCHAR_CONST : /* A character subrange constant */
+	     lastValue = tknInt;
+	     if (s->setType != sCHAR) error(eSET);
+
+	   addLottaBits :
+	     /* Verify that the first value is in range */
+	     if (firstValue < s->minValue) {
+	       error(eSETRANGE);
+	       firstValue = s->minValue;
+             } /* end if */
+	     else if (firstValue > s->maxValue) {
+	       error(eSETRANGE);
+               firstValue = s->maxValue;
+	     } /* end else if */
+
+	     /* Verify that the last value is in range */
+	     if (lastValue < firstValue) {
+               error(eSETRANGE);
+	       lastValue = firstValue;
+             } /* end if */
+	     else if (lastValue > s->maxValue) {
+               error(eSETRANGE);
+	       lastValue = s->maxValue;
+             } /* end else if */
+
+	     /* Set all bits from firstValue through lastValue */
+
+	     setValue  = (0xffff << (firstValue - s->minValue));
+	     setValue &= (0xffff >> ((BITS_IN_INTEGER-1) - (lastValue - s->minValue)));
+
+             /* Now, generate P-Code to push the set value onto the stack */
+
+             pas_GenerateDataOperation(opPUSH, setValue);
+       	     break;
+
+           case sSCALAR :
+	     if ((!s->typePtr)
+	     ||   (s->typePtr != tknPtr->sParm.v.parent)) {
+	       error(eSET);
+
+               if (!s->typePtr) {
+	         s->typeFound = TRUE;
+	         s->typePtr   = tknPtr->sParm.v.parent;
+	         s->setType   = sSCALAR;
+	         s->minValue  = s->typePtr->sParm.t.minValue;
+	         s->maxValue  = s->typePtr->sParm.t.maxValue;
+               } /* end if */
+	     } /* end if */
+             goto addVarToBits;
+
+           case sINT : /* An integer subrange variable ? */
+	   case sCHAR : /* A character subrange variable? */
+	     if (s->setType != token) error(eSET);
+             goto addVarToBits;
+
+	   case sSUBRANGE :
+	     if ((!s->typePtr)
+	     ||   (s->typePtr != tknPtr->sParm.v.parent)) {
+
+	       if ((tknPtr->sParm.v.parent->sParm.t.subType == sSCALAR)
+	       ||   (tknPtr->sParm.v.parent->sParm.t.subType != s->setType))
+		 error(eSET);
+
+               if (!s->typePtr) {
+	         s->typeFound = TRUE;
+	         s->typePtr   = tknPtr->sParm.v.parent;
+	         s->setType   = s->typePtr->sParm.t.subType;
+	         s->minValue  = s->typePtr->sParm.t.minValue;
+		 s->maxValue  = s->typePtr->sParm.t.maxValue;
+               } /* end if */
+	     } /* end if */
+
+           addVarToBits:
+	     /* Verify that the first value is in range */
+
+	     if (firstValue < s->minValue) {
+	       error(eSETRANGE);
+	       firstValue = s->minValue;
+             } /* end if */
+	     else if (firstValue > s->maxValue) {
+	       error(eSETRANGE);
+               firstValue = s->maxValue;
+	     } /* end else if */
+
+	     /* Set all bits from firstValue through maxValue */
+
+	     setValue  = (0xffff >> ((BITS_IN_INTEGER-1) - (s->maxValue - s->minValue)));
+	     setValue &= (0xffff << (firstValue - s->minValue));
+
+	     /* Generate run-time logic to get all bits from firstValue */
+	     /* through last value, i.e., need to generate logic to get: */
+	     /* 0xffff >> ((BITS_IN_INTEGER-1)-(lastValue-minValue)) */
+
+	     pas_GenerateDataOperation(opPUSH, 0xffff);
+	     pas_GenerateDataOperation(opPUSH, ((BITS_IN_INTEGER-1) + s->minValue));
+	     pas_GenerateStackReference(opLDS, tknPtr);
+	     pas_GenerateSimple(opSUB);
+	     pas_GenerateSimple(opSRL);
+
+             /* Then AND this with the setValue */
+
+             if (setValue != 0xffff) {
+	       pas_GenerateDataOperation(opPUSH, setValue);
+	       pas_GenerateSimple(opAND);
+             } /* end if */
+
+             getToken();
+             break;
+
+	   default :
+             error(eSET);
+	     pas_GenerateDataOperation(opPUSH, 0);
+	     break;
+
+	 } /* end switch */
+       } /* end else */
+       break;
+
+     case sSCALAR :
+       if (s->typeFound) {
+	 if ((!s->typePtr) || (s->typePtr != tknPtr->sParm.v.parent))
+           error(eSET);
+       } /* end if */
+       else {
+         s->typeFound = TRUE;
+	 s->typePtr   = tknPtr->sParm.v.parent;
+	 s->setType   = sSCALAR;
+	 s->minValue  = s->typePtr->sParm.t.minValue;
+         s->maxValue  = s->typePtr->sParm.t.maxValue;
+       } /* end if */
+       goto addVar;
+
+     case sINT : /* An integer subrange variable ? */
+     case sCHAR : /* A character subrange variable? */
+       if (!s->typeFound) {
+	 s->typeFound = TRUE;
+	 s->setType   = token;
+       } /* end if */
+       else if (s->setType != token)
+         error(eSET);
+       goto addVar;
+
+     case sSUBRANGE :
+       if (s->typeFound) {
+	 if ((!s->typePtr) || (s->typePtr != tknPtr->sParm.v.parent))
+           error(eSET);
+       } /* end if */
+       else {
+         s->typeFound = TRUE;
+	 s->typePtr   = tknPtr->sParm.v.parent;
+	 s->setType   = s->typePtr->sParm.t.subType;
+	 s->minValue  = s->typePtr->sParm.t.minValue;
+         s->maxValue  = s->typePtr->sParm.t.maxValue;
+       } /* end if */
+
+     addVar:
+       /* Check if the variable set element is the first value in a */
+       /* subrange of values */
+
+       setPtr = tknPtr;
+       getToken();
+       if (token != tSUBRANGE) {
+
+	 /* Generate P-Code to push the set value onto the stack */
+         /* FORM:  1 << (firstValue - minValue) */
+
+         pas_GenerateDataOperation(opPUSH, 1);
+	 pas_GenerateStackReference(opLDS, setPtr);
+	 pas_GenerateDataOperation(opPUSH, s->minValue);
+	 pas_GenerateSimple(opSUB);
+	 pas_GenerateSimple(opSLL);
+
+       } /* end if */
+       else {
+         if (!s->typeFound) error(eSUBRANGETYPE);
+
+	 /* Skip over the tSUBRANGE token */
+
+	 getToken();
+
+	 /* TYPE check */
+
+	 switch (token) {
+           case sSCALAR_OBJECT : /* A scalar or scalar subrange constant */
+	     lastValue = tknPtr->sParm.c.val.i;
+	     if ((s->setType != sSCALAR)
+	     ||   (s->typePtr != tknPtr->sParm.c.parent))
+	       error(eSET);
+	     goto addBitsToVar;
+
+	   case tINT_CONST : /* An integer subrange constant ? */
+	     lastValue = tknInt;
+	     if (s->setType != sINT) error(eSET);
+	     goto addBitsToVar;
+
+	   case tCHAR_CONST : /* A character subrange constant */
+	     lastValue = tknInt;
+	     if (s->setType != sCHAR) error(eSET);
+
+	   addBitsToVar :
+	     /* Verify that the last value is in range */
+
+	     if (lastValue < s->minValue) {
+               error(eSETRANGE);
+	       lastValue = s->minValue;
+             } /* end if */
+	     else if (lastValue > s->maxValue) {
+               error(eSETRANGE);
+	       lastValue = s->maxValue;
+             } /* end else if */
+
+	     /* Set all bits from minValue through lastValue */
+
+	     setValue  = (0xffff >> ((BITS_IN_INTEGER-1) - (lastValue - s->minValue)));
+
+             /* Now, generate P-Code to push the set value onto the stack */
+	     /* First generate: 0xffff << (firstValue-minValue) */
+
+	     pas_GenerateDataOperation(opPUSH, 0xffff);
+	     pas_GenerateStackReference(opLDS, setPtr);
+             if (s->minValue) {
+	       pas_GenerateDataOperation(opPUSH, s->minValue);
+	       pas_GenerateSimple(opSUB);
+             } /* end if */
+	     pas_GenerateSimple(opSLL);
+
+             /* Then and this with the pre-computed constant set value */
+
+             if (setValue != 0xffff) {
+	       pas_GenerateDataOperation(opPUSH, setValue);
+	       pas_GenerateSimple(opAND);
+             } /* end if */
+
+             getToken();
+	     break;
+
+           case sINT : /* An integer subrange variable ? */
+           case sCHAR : /* A character subrange variable? */
+             if (s->setType != token) error(eSET);
+	     goto addVarToVar;
+
+	   case sSCALAR :
+	     if (s->typePtr != tknPtr->sParm.v.parent) error(eSET);
+	     goto addVarToVar;
+
+	   case sSUBRANGE :
+	     if ((s->typePtr != tknPtr->sParm.v.parent)
+	     &&   ((tknPtr->sParm.v.parent->sParm.t.subType == sSCALAR)
+             ||     (tknPtr->sParm.v.parent->sParm.t.subType != s->setType)))
+	       error(eSET);
+
+           addVarToVar:
+
+	     /* Generate run-time logic to get all bits from firstValue */
+	     /* through lastValue */
+	     /* First generate: 0xffff << (firstValue-minValue) */
+
+	     pas_GenerateDataOperation(opPUSH, 0xffff);
+	     pas_GenerateStackReference(opLDS, setPtr);
+	     if (s->minValue) {
+	       pas_GenerateDataOperation(opPUSH, s->minValue);
+	       pas_GenerateSimple(opSUB);
+             } /* end if */
+	     pas_GenerateSimple(opSLL);
+
+	     /* Generate logic to get: */
+	     /* 0xffff >> ((BITS_IN_INTEGER-1)-(lastValue-minValue)) */
+
+	     pas_GenerateDataOperation(opPUSH, 0xffff);
+	     pas_GenerateDataOperation(opPUSH, ((BITS_IN_INTEGER-1) + s->minValue));
+	     pas_GenerateStackReference(opLDS, tknPtr);
+	     pas_GenerateSimple(opSUB);
+	     pas_GenerateSimple(opSRL);
+
+             /* Then AND the two values */
+
+	     pas_GenerateSimple(opAND);
+
+	     getToken();
+             break;
+
+	   default :
+             error(eSET);
+	     pas_GenerateDataOperation(opPUSH, 0);
+	     break;
+
+	 } /* end switch */
+       } /* end else */
+       break;
+
+     default :
+       error(eSET);
+       pas_GenerateDataOperation(opPUSH, 0);
+       break;
+
+   } /* end switch */
+
+} /* end getSetElement */
+
+/***************************************************************/
+
+/* Check if this is a ordinal type.  This is what is needed, for
+ * example, as an argument to ord(), pred(), succ(), or odd().
+ * This is the kind of expression we need in a CASE statement
+ * as well.
+ */
+
+static boolean isOrdinalType(exprType testExprType)
+{
+  if ((testExprType == exprInteger) || /* integer value */
+      (testExprType == exprChar) ||    /* character value */
+      (testExprType == exprBoolean) || /* boolean(integer) value */
+      (testExprType == exprScalar))    /* scalar(integer) value */
+    return TRUE;
+  else
+    return FALSE;
+}
+
+/***************************************************************/
+/* This is a hack to handle calls to system functions that return
+ * exprCString pointers that must be converted to exprString
+ * records upon assignment.
+ */
+
+static boolean isAnyStringType(exprType testExprType)
+{
+  if ((testExprType == exprString) ||
+      (testExprType == exprStkString) ||
+      (testExprType == exprCString))
+    return TRUE;
+  else
+    return FALSE;
+}
+
+static boolean  isStringReference (exprType testExprType)
+{
+  if ((testExprType == exprString) ||
+      (testExprType == exprStkString))
+    return TRUE;
+  else
+    return FALSE;
+}
+
diff --git a/misc/pascal/pascal/pffunc.c b/misc/pascal/pascal/pffunc.c
new file mode 100644
index 000000000..bd2418133
--- /dev/null
+++ b/misc/pascal/pascal/pffunc.c
@@ -0,0 +1,451 @@
+/***************************************************************
+ * pfunc.c
+ * Standard Functions
+ *
+ *   Copyright (C) 2008 Gregory Nutt. All rights reserved.
+ *   Author: Gregory Nutt <spudmonkey@racsa.co.cr>
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ *    notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ *    notice, this list of conditions and the following disclaimer in
+ *    the documentation and/or other materials provided with the
+ *    distribution.
+ * 3. Neither the name NuttX nor the names of its contributors may be
+ *    used to endorse or promote products derived from this software
+ *    without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+ * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+ * COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+ * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+ * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS
+ * OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED
+ * AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+ * ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *
+ ***************************************************************/
+
+/***************************************************************
+ * Included Files
+ ***************************************************************/
+
+#include <stdio.h>
+
+#include "keywords.h"
+#include "pdefs.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   (ubyte fpCode);
+static exprType succFunc   (void);
+static void     oddFunc    (void);
+static void     chrFunc    (void);
+static void     fileFunc   (uint16 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 (ubyte 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 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;
+}            
+
+/***********************************************************************/
diff --git a/misc/pascal/pascal/pgen.c b/misc/pascal/pascal/pgen.c
new file mode 100644
index 000000000..78c81f801
--- /dev/null
+++ b/misc/pascal/pascal/pgen.c
@@ -0,0 +1,641 @@
+/**********************************************************************
+ * pgen.c
+ * P-Code generation logic
+ *
+ *   Copyright (C) 2008 Gregory Nutt. All rights reserved.
+ *   Author: Gregory Nutt <spudmonkey@racsa.co.cr>
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ *    notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ *    notice, this list of conditions and the following disclaimer in
+ *    the documentation and/or other materials provided with the
+ *    distribution.
+ * 3. Neither the name NuttX nor the names of its contributors may be
+ *    used to endorse or promote products derived from this software
+ *    without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+ * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+ * COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+ * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+ * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS
+ * OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED
+ * AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+ * ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *
+ **********************************************************************/
+
+/**********************************************************************
+ * Included Files
+ **********************************************************************/
+
+#include <stdio.h>
+#include <string.h>
+#include <errno.h>
+
+#include "config.h"   /* Configuration */
+#include "keywords.h" /* Standard types */
+#include "pdefs.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) */
+
+/**********************************************************************
+ * Definitions
+ **********************************************************************/
+
+#define UNDEFINED_LEVEL (-1)
+#define INVALID_PCODE   (-1)
+
+#define LEVEL_DEFINED(l)  ((sint32)(l) >= 0)
+#define PCODE_VALID(p)    ((sint32)(p) >= 0)
+
+/**********************************************************************
+ * Global Variables
+ **********************************************************************/
+
+/**********************************************************************
+ * Private Variables
+ **********************************************************************/
+
+static sint32 g_currentStackLevelReference = UNDEFINED_LEVEL;
+static uint32 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 sint32
+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 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.
+ */
+
+sint32 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(sint32 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 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, sint32 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(sint32 dwDataSize)
+{
+  insn_GenerateDataSize(dwDataSize);
+}
+
+/***********************************************************************/
+/* Generate a floating point operation */
+
+void pas_GenerateFpOperation(ubyte fpOpcode)
+{
+  insn_GenerateFpOperation(fpOpcode);
+}
+
+/***********************************************************************/
+/* Generate an IO operation */
+
+void pas_GenerateIoOperation(uint16 ioOpcode, uint16 fileNumber)
+{
+  insn_GenerateIoOperation(ioOpcode, fileNumber);
+}
+
+/***********************************************************************/
+/* Generate a psuedo call to a built-in, standard pascal function */
+
+void pas_BuiltInFunctionCall(uint16 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 wLevel,
+				sint32 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)
+    {
+      sint32 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)
+    {
+      sint32 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 wIncludeNumber, uint32 dwLineNumber)
+{
+  insn_GenerateLineNumber(wIncludeNumber, dwLineNumber);
+}
+
+/***********************************************************************/
+
+void pas_GenerateDebugInfo(STYPE *pProc, uint32 dwReturnSize)
+{
+  int i;
+
+  /* Allocate a container to pass the proc information to the library */
+
+  uint32 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);
+}
diff --git a/misc/pascal/pascal/pprgm.c b/misc/pascal/pascal/pprgm.c
new file mode 100644
index 000000000..4acd116d6
--- /dev/null
+++ b/misc/pascal/pascal/pprgm.c
@@ -0,0 +1,264 @@
+/**********************************************************************
+ * pas.c
+ * main - process PROGRAM
+ *
+ *   Copyright (C) 2008 Gregory Nutt. All rights reserved.
+ *   Author: Gregory Nutt <spudmonkey@racsa.co.cr>
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ *    notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ *    notice, this list of conditions and the following disclaimer in
+ *    the documentation and/or other materials provided with the
+ *    distribution.
+ * 3. Neither the name NuttX nor the names of its contributors may be
+ *    used to endorse or promote products derived from this software
+ *    without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+ * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+ * COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+ * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+ * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS
+ * OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED
+ * AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+ * ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *
+ **********************************************************************/
+
+/**********************************************************************
+ * Included Files
+ **********************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <ctype.h>
+#include <string.h>
+#include <errno.h>
+
+#include "keywords.h"
+#include "pdefs.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"
+
+/**********************************************************************
+ * 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 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();
+    }
+}
+
+/***********************************************************************/
diff --git a/misc/pascal/pascal/pproc.c b/misc/pascal/pascal/pproc.c
new file mode 100644
index 000000000..9934b0b3b
--- /dev/null
+++ b/misc/pascal/pascal/pproc.c
@@ -0,0 +1,734 @@
+/****************************************************************************
+ * pproc.c
+ * Standard procedures (all called in pstm.c)
+ *
+ *   Copyright (C) 2008 Gregory Nutt. All rights reserved.
+ *   Author: Gregory Nutt <spudmonkey@racsa.co.cr>
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ *    notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ *    notice, this list of conditions and the following disclaimer in
+ *    the documentation and/or other materials provided with the
+ *    distribution.
+ * 3. Neither the name NuttX nor the names of its contributors may be
+ *    used to endorse or promote products derived from this software
+ *    without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+ * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+ * COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+ * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+ * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS
+ * OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED
+ * AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+ * ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *
+ ****************************************************************************/
+
+/****************************************************************************
+ * Included Files
+ ****************************************************************************/
+
+#include <stdio.h>
+#include <string.h>
+
+#include "keywords.h"
+#include "pdefs.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 sint16 readProc    (void);              /* READ procedure */
+static void   readText    (uint16 fileNumber); /* READ text file */
+static void   readlnProc  (void);              /* READLN procedure */
+static void   fileProc    (uint16 opcode);     /* RESET/REWRITE/PAGE procedure */
+static sint16 writeProc   (void);              /* WRITE procedure */
+static void   writeText   (uint16 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 sint16 readProc(void)
+{
+  uint16 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 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 */
+{
+   sint32 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 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 sint16 writeProc(void)
+{
+   uint16 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 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 offset = poffAddRoDataString(poffHandle, tkn_strt);
+
+	    /* Set the offset and size on the stack (order is important) */
+
+	    pas_GenerateDataOperation(opLAC, (uint16)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)tknPtr->sParm.s.offset);
+	  pas_GenerateDataOperation(opPUSH, (uint16)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 */
+{
+   sint32 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 */
+
+/***********************************************************************/
diff --git a/misc/pascal/pascal/pstm.c b/misc/pascal/pascal/pstm.c
new file mode 100644
index 000000000..b1b2fe887
--- /dev/null
+++ b/misc/pascal/pascal/pstm.c
@@ -0,0 +1,1681 @@
+/****************************************************************************
+ * pstm.c
+ * Pascal Statements
+ *
+ *   Copyright (C) 2008 Gregory Nutt. All rights reserved.
+ *   Author: Gregory Nutt <spudmonkey@racsa.co.cr>
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ *    notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ *    notice, this list of conditions and the following disclaimer in
+ *    the documentation and/or other materials provided with the
+ *    distribution.
+ * 3. Neither the name NuttX nor the names of its contributors may be
+ *    used to endorse or promote products derived from this software
+ *    without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+ * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+ * COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+ * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+ * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS
+ * OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED
+ * AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+ * ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *
+ ****************************************************************************/
+
+/****************************************************************************
+ * Included Files
+ ****************************************************************************/
+
+#include <stdio.h>
+
+#include "keywords.h"
+#include "pdefs.h"
+#include "ptdefs.h"
+#include "podefs.h"
+#include "pedefs.h"
+#include "pxdefs.h"
+
+#include "pas.h"
+#include "pstm.h"
+#include "pproc.h"
+#include "pexpr.h"
+#include "pgen.h"
+#include "ptkn.h"
+#include "ptbl.h"
+#include "pinsn.h"
+#include "perr.h"
+
+/****************************************************************************
+ * Private Definitions
+ ****************************************************************************/
+
+#define ADDRESS_DEREFERENCE  0x01
+#define ADDRESS_ASSIGNMENT   0x02
+#define INDEXED_ASSIGNMENT   0x04
+#define VAR_PARM_ASSIGNMENT  0x08
+
+#define isConstant(x) \
+	(  ((x) == tINT_CONST) \
+	|| ((x) == tBOOLEAN_CONST) \
+	|| ((x) == tCHAR_CONST) \
+	|| ((x) == tREAL_CONST) \
+	|| ((x) == sSCALAR_OBJECT))
+
+/****************************************************************************
+ * Private Function Prototypes
+ ****************************************************************************/
+
+/* Assignment Statements */
+
+static void pas_ComplexAssignment(void);
+static void pas_SimpleAssignment (STYPE *varPtr, ubyte assignFlags);
+static void pas_Assignment       (uint16 storeOp, exprType assignType, STYPE *varPtr, STYPE *typePtr);
+static void pas_StringAssignment (STYPE *varPtr, STYPE *typePtr);
+static void pas_LargeAssignment  (uint16 storeOp, exprType assignType, STYPE *varPtr, STYPE *typePtr);
+
+/* Other Statements */
+
+static void pas_GotoStatement    (void);  /* GOTO statement */
+static void pas_LabelStatement   (void);  /* Label statement */
+static void pas_ProcStatement    (void);  /* Procedure method statement */
+static void pas_IfStatement      (void);  /* IF-THEN[-ELSE] statement */
+static void pas_CaseStatement    (void);  /* Case statement */
+static void pas_RepeatStatement  (void);  /* Repeat statement */
+static void pas_WhileStatement   (void);  /* While statement */
+static void pas_ForStatement     (void);  /* For statement */
+static void pas_WithStatement    (void);  /* With statement */
+
+/****************************************************************************/
+
+void statement(void)
+{
+  STYPE *symPtr;     /* Save Symbol Table pointer to token */
+
+  TRACE(lstFile,"[statement");
+
+  /* Generate file/line number pseudo-operation to facilitate P-Code testing */
+
+  pas_GenerateLineNumber(FP->include, FP->line);
+
+  /* We will push the string stack pointer at the beginning of each
+   * statement and pop the string stack pointer at the end of each
+   * statement.  Subsequent optimization logic will scan the generated
+   * pcode to ascertain if the push and pops were necessary.  They
+   * would be necessary if expression parsing generated temporary usage
+   * of string stack storage.  In this case, the push will save the
+   * value before the temporary usage and the pop will release the
+   * temporaray storage.
+   */
+
+  pas_GenerateSimple(opPUSHS);
+
+  /* Process the statement according to the type of the leading token */
+
+  switch (token)
+    {
+      /* Simple assignment statements */
+
+    case sINT :
+      symPtr = tknPtr;
+      getToken();
+      pas_Assignment(opSTS, exprInteger, symPtr, symPtr->sParm.v.parent);
+      break;
+    case sCHAR :
+      symPtr = tknPtr;
+      getToken();
+      pas_Assignment(opSTSB, exprChar, symPtr, symPtr->sParm.v.parent);
+      break;
+    case sBOOLEAN :
+      symPtr = tknPtr;
+      getToken();
+      pas_Assignment(opSTSB, exprBoolean, symPtr, NULL);
+      break;
+    case sREAL :
+      symPtr = tknPtr;
+      getToken();
+      pas_LargeAssignment(opSTSM, exprReal, symPtr, symPtr->sParm.v.parent);
+      break;
+    case sSCALAR :
+      symPtr = tknPtr;
+      getToken();
+      pas_Assignment(opSTS, exprScalar, symPtr, symPtr->sParm.v.parent);
+      break;
+    case sSET_OF :
+      symPtr = tknPtr;
+      getToken();
+      pas_Assignment(opSTS, exprSet, symPtr, symPtr->sParm.v.parent);
+      break;
+    case sSTRING :
+    case sRSTRING :
+      symPtr = tknPtr;
+      getToken();
+      pas_StringAssignment(symPtr, symPtr->sParm.v.parent);
+      break;
+
+      /* Complex assignments statements */
+
+    case sSUBRANGE :
+    case sRECORD :
+    case sRECORD_OBJECT :
+    case sPOINTER :
+    case sVAR_PARM :
+    case sARRAY :
+      pas_ComplexAssignment();
+      break;
+
+      /* Branch, Call and Label statements */
+
+    case sPROC         : pas_ProcStatement(); break;
+    case tGOTO         : pas_GotoStatement(); break;
+    case tINT_CONST    : pas_LabelStatement(); break;
+
+      /* Conditional Statements */
+
+    case tIF           : pas_IfStatement(); break;
+    case tCASE         : pas_CaseStatement(); break;
+
+      /* Loop Statements */
+
+    case tREPEAT       : pas_RepeatStatement(); break;
+    case tWHILE        : pas_WhileStatement(); break;
+    case tFOR          : pas_ForStatement(); break;
+
+      /* Other Statements */
+
+    case tBEGIN        : compoundStatement(); break;
+    case tWITH         : pas_WithStatement(); break;
+
+      /* None of the above, try standard procedures */
+    default            : builtInProcedure(); break;
+
+  } /* end switch */
+
+  /* Generate the POPS that matches the PUSHS generated at the begining
+   * of this function (see comments above).
+   */
+
+  pas_GenerateSimple(opPOPS);
+
+  TRACE(lstFile,"]");
+
+} /* end statement */
+
+/***********************************************************************/
+/* Process a complex assignment statement */
+
+static void pas_ComplexAssignment(void)
+{
+   STYPE symbolSave;
+   TRACE(lstFile,"[pas_ComplexAssignment]");
+
+   /* FORM:  <variable OR function identifer> := <expression>
+    * First, make a copy of the symbol table entry because the call to
+    * pas_SimpleAssignment() will modify it.
+    */
+
+   symbolSave = *tknPtr;
+   getToken();
+
+   /* Then process the complex assignment until it is reduced to a simple
+    * assignment (like int, char, etc.)
+    */
+
+   pas_SimpleAssignment(&symbolSave, 0);
+}
+
+/***********************************************************************/
+/* Process a complex assignment (recursively) until it becomes a
+ * simple assignment statement
+ */
+
+static void pas_SimpleAssignment(STYPE *varPtr, ubyte assignFlags)
+{
+  STYPE *typePtr;
+  TRACE(lstFile,"[pas_SimpleAssignment]");
+
+  /* FORM:  <variable OR function identifer> := <expression> */
+
+  typePtr = varPtr->sParm.v.parent;
+  switch (varPtr->sKind)
+    {
+      /* Check if we have reduce the complex assignment to a simple
+       * assignment yet
+       */
+
+    case sINT :
+      if ((assignFlags & INDEXED_ASSIGNMENT) != 0)
+	{
+	  if ((assignFlags & ADDRESS_DEREFERENCE) != 0)
+	    {
+	      pas_GenerateStackReference(opLDSX, varPtr);
+	      pas_Assignment(opSTI, exprInteger, varPtr, typePtr);
+	    } /* end if */
+	  else if ((assignFlags & ADDRESS_ASSIGNMENT) != 0)
+	    pas_Assignment(opSTSX, exprIntegerPtr, varPtr, typePtr);
+	  else 
+	    pas_Assignment(opSTSX, exprInteger, varPtr, typePtr);
+	} /* end if */
+      else
+	{
+	  if ((assignFlags & ADDRESS_DEREFERENCE) != 0)
+	    {
+	      pas_GenerateStackReference(opLDS, varPtr);
+	      pas_Assignment(opSTI, exprInteger, varPtr, typePtr);
+	    } /* end if */
+	  else if ((assignFlags & ADDRESS_ASSIGNMENT) != 0)
+            pas_Assignment(opSTS, exprIntegerPtr, varPtr, typePtr);
+	  else
+	    pas_Assignment(opSTS, exprInteger, varPtr, typePtr);
+	} /* end else */
+      break;
+    case sCHAR :
+      if ((assignFlags & INDEXED_ASSIGNMENT) != 0)
+	{
+	  if ((assignFlags & ADDRESS_DEREFERENCE) != 0)
+	    {
+	      pas_GenerateStackReference(opLDSX, varPtr);
+	      pas_Assignment(opSTIB, exprChar, varPtr, typePtr);
+	    } /* end if */
+	  else if ((assignFlags & ADDRESS_ASSIGNMENT) != 0)
+            pas_Assignment(opSTSX, exprCharPtr, varPtr, typePtr);
+	  else 
+	    pas_Assignment(opSTSXB, exprChar, varPtr, typePtr);
+	} /* end if */
+      else
+	{
+	  if ((assignFlags & ADDRESS_DEREFERENCE) != 0)
+	    {
+	      pas_GenerateStackReference(opLDS, varPtr);
+	      pas_Assignment(opSTIB, exprChar, varPtr, typePtr);
+	    } /* end if */
+	  else if ((assignFlags & ADDRESS_ASSIGNMENT) != 0)
+            pas_Assignment(opSTS, exprCharPtr, varPtr, typePtr);
+	  else
+	    pas_Assignment(opSTSB, exprChar, varPtr, typePtr);
+	} /* end else */
+      break;
+    case sBOOLEAN :
+      if ((assignFlags & INDEXED_ASSIGNMENT) != 0)
+	{
+	  if ((assignFlags & ADDRESS_DEREFERENCE) != 0)
+	    {
+	      pas_GenerateStackReference(opLDSX, varPtr);
+	      pas_Assignment(opSTI, exprBoolean, varPtr, NULL);
+	    } /* end if */
+	  else if ((assignFlags & ADDRESS_ASSIGNMENT) != 0)
+            pas_Assignment(opSTSX, exprBooleanPtr, varPtr, typePtr);
+	  else 
+	    pas_Assignment(opSTSX, exprBoolean, varPtr, NULL);
+	} /* end if */
+      else
+	{
+	  if ((assignFlags & ADDRESS_DEREFERENCE) != 0)
+	    {
+	      pas_GenerateStackReference(opLDS, varPtr);
+	      pas_Assignment(opSTI, exprBoolean, varPtr, NULL);
+	    } /* end if */
+	  else if ((assignFlags & ADDRESS_ASSIGNMENT) != 0)
+            pas_Assignment(opSTS, exprBooleanPtr, varPtr, typePtr);
+	  else
+	    pas_Assignment(opSTS, exprBoolean, varPtr, NULL);
+	} /* end else */
+      break;
+    case sREAL         :
+      if ((assignFlags & INDEXED_ASSIGNMENT) != 0)
+	{
+	  if ((assignFlags & ADDRESS_DEREFERENCE) != 0)
+	    {
+	      pas_GenerateStackReference(opLDSX, varPtr);
+	      pas_LargeAssignment(opSTIM, exprReal, varPtr, typePtr);
+	    } /* end if */
+	  else if ((assignFlags & ADDRESS_ASSIGNMENT) != 0)
+            pas_Assignment(opSTSX, exprRealPtr, varPtr, typePtr);
+	  else 
+	    pas_LargeAssignment(opSTSXM, exprReal, varPtr, typePtr);
+	} /* end if */
+      else
+	{
+	  if ((assignFlags & ADDRESS_DEREFERENCE) != 0)
+	    {
+	      pas_GenerateStackReference(opLDS, varPtr);
+	      pas_LargeAssignment(opSTIM, exprReal, varPtr, typePtr);
+	    } /* end if */
+	  else if ((assignFlags & ADDRESS_ASSIGNMENT) != 0)
+            pas_Assignment(opSTS, exprRealPtr, varPtr, typePtr);
+	  else
+	    pas_LargeAssignment(opSTSM, exprReal, varPtr, typePtr);
+	} /* end else */
+      break;
+    case sSCALAR :
+      if ((assignFlags & INDEXED_ASSIGNMENT) != 0)
+	{
+	  if ((assignFlags & ADDRESS_DEREFERENCE) != 0)
+	    {
+	      pas_GenerateStackReference(opLDSX, varPtr);
+	      pas_Assignment(opSTI, exprScalar, varPtr, typePtr);
+	    } /* end if */
+	  else if ((assignFlags & ADDRESS_ASSIGNMENT) != 0)
+            pas_Assignment(opSTSX, exprScalarPtr, varPtr, typePtr);
+	  else 
+	    pas_Assignment(opSTSX, exprScalar, varPtr, typePtr);
+	} /* end if */
+      else
+	{
+	  if ((assignFlags & ADDRESS_DEREFERENCE) != 0)
+	    {
+	      pas_GenerateStackReference(opLDS, varPtr);
+	      pas_Assignment(opSTI, exprScalar, varPtr, typePtr);
+	    } /* end if */
+	  else if ((assignFlags & ADDRESS_ASSIGNMENT) != 0)
+            pas_Assignment(opSTS, exprScalarPtr, varPtr, typePtr);
+	  else
+	    pas_Assignment(opSTS, exprScalar, varPtr, typePtr);
+	} /* end else */
+      break;
+    case sSET_OF :
+      if ((assignFlags & INDEXED_ASSIGNMENT) != 0)
+	{
+	  if ((assignFlags & ADDRESS_DEREFERENCE) != 0)
+	    {
+	      pas_GenerateStackReference(opLDSX, varPtr);
+	      pas_Assignment(opSTI, exprSet, varPtr, typePtr);
+	    } /* end if */
+	  else if ((assignFlags & ADDRESS_ASSIGNMENT) != 0)
+            pas_Assignment(opSTSX, exprSetPtr, varPtr, typePtr);
+	  else 
+	    pas_Assignment(opSTSX, exprSet, varPtr, typePtr);
+	} /* end if */
+      else
+	{
+	  if ((assignFlags & ADDRESS_DEREFERENCE) != 0)
+	    {
+	      pas_GenerateStackReference(opLDS, varPtr);
+	      pas_Assignment(opSTI, exprSet, varPtr, typePtr);
+	    } /* end if */
+	  else if ((assignFlags & ADDRESS_ASSIGNMENT) != 0)
+            pas_Assignment(opSTS, exprSetPtr, varPtr, typePtr);
+	  else
+	    pas_Assignment(opSTS, exprSet, varPtr, typePtr);
+	} /* end else */
+      break;
+
+      /* NOPE... recurse until it becomes a simple assignment */
+
+    case sSUBRANGE :
+      varPtr->sKind = typePtr->sParm.t.subType;
+      pas_SimpleAssignment(varPtr, assignFlags);
+      break;
+
+    case sRECORD :
+      /* FORM: <record identifier>.<field> := <expression>
+       * OR:   <record pointer identifier> := <pointer expression>
+       */
+
+      /* Check if this is a pointer to a record */
+
+      if ((assignFlags & ADDRESS_ASSIGNMENT) != 0)
+	{
+	  if (token == '.') error(ePOINTERTYPE);
+
+	  if ((assignFlags & INDEXED_ASSIGNMENT) != 0)
+	    pas_Assignment(opSTSX, exprRecordPtr, varPtr, typePtr);
+	  else
+	    pas_Assignment(opSTS, exprRecordPtr, varPtr, typePtr);
+	} /* end if */
+      else if (((assignFlags & ADDRESS_DEREFERENCE) != 0) &&
+               ((assignFlags & VAR_PARM_ASSIGNMENT) == 0))
+	error(ePOINTERTYPE);
+
+      /* Check if a period separates the RECORD identifier from the
+       * record field identifier
+       */
+
+      else if (token == '.')
+	{
+	  /* Skip over the period */
+
+	  getToken();
+
+	  /* Verify that a field identifier associated with this record
+	   * follows the period.
+	   */
+
+	  if ((token != sRECORD_OBJECT) ||
+	      (tknPtr->sParm.r.record != typePtr))
+	    error(eRECORDOBJECT);
+	  else
+	    {
+	      /* Modify the variable so that it has the characteristics of the
+	       * the field but with level and offset associated with the record
+	       */
+
+	      typePtr                 = tknPtr->sParm.r.parent;
+	      varPtr->sKind           = typePtr->sParm.t.type;
+	      varPtr->sParm.v.parent  = typePtr;
+
+	      /* Special case:  The record is a VAR parameter. */
+
+	      if (assignFlags == (INDEXED_ASSIGNMENT | ADDRESS_DEREFERENCE | VAR_PARM_ASSIGNMENT))
+		{
+		  pas_GenerateDataOperation(opPUSH, tknPtr->sParm.r.offset);
+		  pas_GenerateSimple(opADD);
+		} /* end if */
+	      else
+		varPtr->sParm.v.offset += tknPtr->sParm.r.offset;
+
+	      getToken();
+	      pas_SimpleAssignment(varPtr, assignFlags);
+
+	    } /* end else if */
+	} /* end else */
+
+      /* It must be a RECORD assignment */
+
+      else
+	{
+	  /* Special case:  The record is a VAR parameter. */
+
+	  if (assignFlags == (INDEXED_ASSIGNMENT | ADDRESS_DEREFERENCE | VAR_PARM_ASSIGNMENT))
+	    {
+	      pas_GenerateStackReference(opLDS, varPtr);
+	      pas_GenerateSimple(opADD);
+	      pas_LargeAssignment(opSTIM, exprRecord, varPtr, typePtr);
+	    } /* end if */
+	  else
+	    pas_LargeAssignment(opSTSM, exprRecord, varPtr, typePtr);
+	} /* end else */
+      break;
+
+    case sRECORD_OBJECT :
+      /* FORM: <field> := <expression>
+       * NOTE:  This must have been preceeded with a WITH statement
+       * defining the RECORD type
+       */
+
+      if (!withRecord.parent)
+	error(eINVTYPE);
+      else if ((assignFlags && (ADDRESS_DEREFERENCE | ADDRESS_ASSIGNMENT)) != 0)
+	error(ePOINTERTYPE);
+      else if ((assignFlags && INDEXED_ASSIGNMENT) != 0)
+	error(eARRAYTYPE);
+
+      /* Verify that a field identifier is associated with the RECORD
+       * specified by the WITH statement.
+       */
+
+      else if (varPtr->sParm.r.record != withRecord.parent)
+	error(eRECORDOBJECT);
+
+      else
+	{
+	  sint16 tempOffset;
+
+	  /* Now there are two cases to consider:  (1) the withRecord is a
+	   * pointer to a RECORD, or (2) the withRecord is the RECORD itself
+	   */
+
+	  if (withRecord.pointer)
+	    {
+	      /* If the pointer is really a VAR parameter, then other syntax
+	       * rules will apply
+	       */
+
+	      if (withRecord.varParm)
+		assignFlags |= (INDEXED_ASSIGNMENT | ADDRESS_DEREFERENCE | VAR_PARM_ASSIGNMENT);
+	      else
+		assignFlags |= (INDEXED_ASSIGNMENT | ADDRESS_DEREFERENCE);
+
+	      pas_GenerateDataOperation(opPUSH, (varPtr->sParm.r.offset + withRecord.index));
+	      tempOffset     = withRecord.offset;
+	    } /* end if */
+	  else
+	    {
+	      tempOffset   = varPtr->sParm.r.offset + withRecord.offset;
+	    } /* end else */
+
+	  /* Modify the variable so that it has the characteristics of the
+	   * the field but with level and offset associated with the record
+	   * NOTE:  We have to be careful here because the structure
+	   * associated with sRECORD_OBJECT is not the same as for
+	   * variables!
+	   */
+
+	  typePtr                 = varPtr->sParm.r.parent;
+
+	  varPtr->sKind           = typePtr->sParm.t.type;
+	  varPtr->sLevel          = withRecord.level;
+	  varPtr->sParm.v.size    = typePtr->sParm.t.asize;
+	  varPtr->sParm.v.offset  = tempOffset;
+	  varPtr->sParm.v.parent  = typePtr;
+
+	  pas_SimpleAssignment(varPtr, assignFlags);
+
+	} /* end else */
+      break;
+
+    case sPOINTER :
+      /* FORM: <pointer identifier>^ := <expression>
+       * OR:   <pointer identifier> := <pointer expression>
+       */
+
+      if (token == '^') /* value assignment? */
+	{
+	  getToken();
+	  assignFlags |= ADDRESS_DEREFERENCE;
+	} /* end if */
+      else
+	assignFlags |= ADDRESS_ASSIGNMENT;
+
+      varPtr->sKind = typePtr->sParm.t.type;
+      pas_SimpleAssignment(varPtr, assignFlags);
+      break;
+
+    case sVAR_PARM :
+      if (assignFlags != 0) error(eVARPARMTYPE);
+      assignFlags |= (ADDRESS_DEREFERENCE | VAR_PARM_ASSIGNMENT);
+
+      varPtr->sKind = typePtr->sParm.t.type;
+      pas_SimpleAssignment(varPtr, assignFlags);
+      break;
+
+    case sARRAY :
+      /* FORM: <array identifier> := <expression>
+       * OR:   <pointer array identifier>[<index>]^ := <expression>
+       * OR:   <pointer array identifier>[<index>] := <pointer expression>
+       * OR:   <record array identifier>[<index>].<field identifier> := <expression>
+       * OR:   etc., etc., etc.
+       */
+
+      if (assignFlags != 0) error(eARRAYTYPE);
+      assignFlags |= INDEXED_ASSIGNMENT;
+
+      arrayIndex(typePtr->sParm.t.asize);
+      varPtr->sKind        = typePtr->sParm.t.type;
+      varPtr->sParm.v.size = typePtr->sParm.t.asize;
+      pas_SimpleAssignment(varPtr, assignFlags);
+      break;
+
+    default :
+      error(eINVTYPE);
+      break;
+
+    }
+}
+
+/***********************************************************************/
+/* Process simple assignment statement */
+
+static void pas_Assignment(uint16 storeOp, exprType assignType,
+			   STYPE *varPtr, STYPE *typePtr)
+{
+   TRACE(lstFile,"[pas_Assignment]");
+
+   /* FORM:  <variable OR function identifer> := <expression> */
+
+   if (token != tASSIGN) error (eASSIGN);
+   else getToken();
+
+   expression(assignType, typePtr);
+   pas_GenerateStackReference(storeOp, varPtr);
+}
+
+/***********************************************************************/
+/* Process the assignment to a variable length string record */
+
+static void pas_StringAssignment(STYPE *varPtr, STYPE *typePtr)
+{
+  exprType stringKind;
+
+   TRACE(lstFile,"[pas_StringAssignment]");
+
+   /* FORM:  <variable OR function identifer> := <expression> */
+
+   /* Verify that the assignment token follows the indentifier */
+
+   if (token != tASSIGN) error (eASSIGN);
+   else getToken();
+
+   /* Get the expression after assignment token. We'll take any kind
+    * of string expression.  This is a hack to handle calls to system
+    * functions that return exprCString pointers that must be converted
+    * to exprString records upon assignment.
+    */
+
+   stringKind = expression(exprAnyString, typePtr);
+
+   /* Place the address of the destination string structure instance on the
+    * stack.
+    */
+
+   pas_GenerateStackReference(opLAS, varPtr);
+
+   /* Check if this is an assignment to a global allocated string, or
+    * to a stack reference to an allocated string.
+    */
+
+   if (varPtr->sKind == sRSTRING)
+     {
+       /* It is an assignment to a string reference --
+	* Generate a runtime library call to copy the destination
+	* string string into the pascal string instance.  The particular
+	* runtime call will account for any necesary string type conversion.
+	*/
+
+       if ((stringKind == exprString) || (stringKind == exprStkString))
+	 {
+	   /* It is a pascal string type. Current stack representation is:
+	    *
+	    *   TOS(0)=address of dest string reference
+	    *   TOS(1)=length of source string
+	    *   TOS(2)=pointer to source string
+	    */
+
+	   pas_BuiltInFunctionCall(lbSTR2RSTR);
+	 }
+       else if (stringKind == exprCString)
+	 {
+	   /* It is a 32-bit C string point.  Current stack representation is:
+	    *
+	    *   TOS(0)=address of dest string reference
+	    *   TOS(1)=MS 16-bits of 32-bit C source string pointer
+	    *   TOS(2)=LS 16-bits of 32-bit C source string pointer
+	    */
+
+	   pas_BuiltInFunctionCall(lbCSTR2RSTR);
+	 }
+     }
+   else
+     {
+       /* It is an assignment to a allocated Pascal string --
+	* Generate a runtime library call to copy the destination
+	* string string into the pascal string instance.  The particular
+	* runtime call will account for any necesary string type conversion.
+	*/
+
+       if ((stringKind == exprString) || (stringKind == exprStkString))
+	 {
+	   /* It is a pascal string type. Current stack representation is:
+	    *
+	    *   TOS(0)=address of dest string hdr
+	    *   TOS(1)=length of source string
+	    *   TOS(2)=pointer to source string
+	    */
+
+	   pas_BuiltInFunctionCall(lbSTR2STR);
+	 }
+       else if (stringKind == exprCString)
+	 {
+	   /* It is a 32-bit C string point.  Current stack representation is:
+	    *
+	    *   TOS(0)=address of dest string hdr
+	    *   TOS(1)=MS 16-bits of 32-bit C source string pointer
+	    *   TOS(2)=LS 16-bits of 32-bit C source string pointer
+	    */
+
+	   pas_BuiltInFunctionCall(lbCSTR2STR);
+	 }
+     }
+
+   /* else ... type mismatch error already reported by expression() */
+}
+
+/***********************************************************************/
+/* Process a multiple word assignment statement */
+
+static void pas_LargeAssignment(uint16 storeOp, exprType assignType,
+				STYPE *varPtr, STYPE *typePtr)
+{
+   TRACE(lstFile,"[pas_LargeAssignment]");
+
+   /* FORM:  <variable OR function identifer> := <expression> */
+
+   if (token != tASSIGN) error (eASSIGN);
+   else getToken();
+
+   expression(assignType, typePtr);
+   pas_GenerateDataSize(varPtr->sParm.v.size);
+   pas_GenerateStackReference(storeOp, varPtr);
+}
+
+/***********************************************************************/
+
+static void pas_GotoStatement(void)
+{
+   char   labelname [8];                /* Label symbol table name */
+   STYPE  *label_ptr;                   /* Pointer to Label Symbol */
+
+   TRACE(lstFile,"[pas_GotoStatement]");
+
+   /* FORM:  GOTO <integer> */
+
+   /* Get the token after the goto reserved word. It should be an <integer> */
+
+   getToken();
+   if (token != tINT_CONST)
+     {
+       /* Token following the goto is not an integer */
+
+       error(eINVLABEL);
+     }
+   else
+     {
+       /* The integer label must be non-negative */
+
+       if (tknInt < 0)
+	 {
+	   error(eINVLABEL);
+	 }
+       else
+	 {
+	   /* Find and verify the symbol associated with the label */
+
+	   (void)sprintf (labelname, "%ld", tknInt);
+	   if (!(label_ptr = findSymbol(labelname)))
+	     {
+	       error(eUNDECLABEL);
+	     }
+	   else if (label_ptr->sKind != sLABEL)
+	     {
+	       error(eINVLABEL);
+	     }
+	   else
+	     {
+	       /* Generate the branch to the label */
+
+	       pas_GenerateDataOperation(opJMP, label_ptr->sParm.l.label);
+	     }
+	 }
+
+       /* Get the token after the <integer> value */
+
+       getToken();
+     }
+}
+
+/***********************************************************************/
+
+static void pas_LabelStatement(void)
+{
+   char   labelName [8];                /* Label symbol table name */
+   STYPE  *labelPtr;                    /* Pointer to Label Symbol */
+
+   TRACE(lstFile,"[pas_LabelStatement]");
+
+   /* FORM:  <integer> : */
+
+   /* Verify that the integer is a label name */
+
+   (void)sprintf (labelName, "%ld", tknInt);
+   if (!(labelPtr = findSymbol(labelName)))
+     {
+       error(eUNDECLABEL);
+     }
+   else if(labelPtr->sKind != sLABEL)
+     {
+       error(eINVLABEL);
+     }
+
+   /* And also verify that the label symbol has not been previously
+    * defined.
+    */
+
+   else if(!(labelPtr->sParm.l.unDefined))
+     {
+       error(eMULTLABEL);
+     }
+   else
+     {
+       /* Generate the label and indicate that it has been defined */
+
+       pas_GenerateDataOperation(opLABEL, labelPtr->sParm.l.label);
+       labelPtr->sParm.l.unDefined = FALSE;
+
+       /* We have to assume that we got here via a goto statement.
+	* We don't have logic in place to track changes to the level
+	* stack pointer (LSP) register, so we have no choice but to
+	* invalidate that register now.
+	*/
+
+       pas_InvalidateCurrentStackLevel();
+     }
+
+   /* Skip over the label integer */
+
+   getToken();
+
+   /* Make sure that the label is followed by a colon */
+
+   if (token != ':') error (eCOLON);
+   else getToken();
+}
+
+/***********************************************************************/
+
+static void pas_ProcStatement(void)
+{
+  STYPE *procPtr = tknPtr;
+  int size = 0;
+
+  TRACE(lstFile,"[pas_ProcStatement]");
+
+  /* FORM: procedure-method-statement =
+   * procedure-method-specifier [ actual-parameter-list ]
+   *
+   * Skip over the procedure-method-statement
+   */
+
+  getToken();
+
+  /* Get the actual parameters (if any) associated with the procedure
+   * call.
+   */
+
+  size = actualParameterList(procPtr);
+
+  /* Generate procedure call and stack adjustment (if required)
+   * Upon return from the procedure, the level stack pointer (LSP)
+   * may also be invalid.  However, we rely on level level logic in 
+   * pgen.c to manage this case (as well as the function call case).
+   */
+
+  pas_GenerateProcedureCall(procPtr);
+  if (size)
+    {
+      pas_GenerateDataOperation(opINDS, -size);
+    }
+}
+
+/***********************************************************************/
+
+static void pas_IfStatement(void)
+{
+  uint16 else_label  = ++label;
+  uint16 endif_label = else_label;
+  sint32 thenLSP;
+  sint32 elseLSP;
+
+  TRACE(lstFile,"[pas_IfStatement]");
+
+  /* FORM: IF <expression> THEN <statement> [ELSE <statement>] */
+
+  /* Skip over the IF token */
+
+  getToken();
+
+  /* Evaluate the boolean expression */
+
+  expression(exprBoolean, NULL);
+
+  /* Make sure that the boolean expression is followed by the THEN token */
+
+  if (token !=  tTHEN)
+    error (eTHEN);
+  else
+    {
+      /* Skip over the THEN token */
+
+      getToken();
+
+      /* Generate a conditional branch to the "else_label."  This will be a
+       * branch to either the ENDIF or to the ELSE location (if present).
+       */
+
+      pas_GenerateDataOperation(opJEQUZ, else_label);
+
+      /* Save the value of the Level Stack Pointer (LSP) here.  This will be
+       * the value of the LSP at the ENDIF label if there is no ELSE <statement>
+       * presentl.  We will compare the elseLSP to the thenLSP at that point.
+       */
+
+      elseLSP = pas_GetCurrentStackLevel();
+
+      /* Parse the <statment> following the THEN token */
+
+      statement();
+
+      /* Save the LSP after generating the THEN <statement>.  We will compare the
+       * elseLSP to the thenLSP below.
+       */
+
+      thenLSP = pas_GetCurrentStackLevel();
+
+      /* Check for optional ELSE <statement> */
+
+      if (token == tELSE)
+	{
+	  /* Change the ENDIF label.  Now instead of branching to
+	   * the ENDIF, the logic above will branch to the ELSE
+	   * logic generated here.
+	   */
+
+	  endif_label = ++label;
+
+	  /* Skip over the ELSE token */
+
+	  getToken();
+
+	  /* Generate Jump to ENDIF label after the  THEN <statement> */
+
+	  pas_GenerateDataOperation(opJMP, endif_label);
+
+	  /* Generate the ELSE label here.  This is where we will go if
+	   * the IF <expression> evaluates to FALSE.
+	   */
+
+	  pas_GenerateDataOperation(opLABEL, else_label);
+
+	  /* Generate the ELSE <statement> then fall through to the
+	   * ENDIF label.
+	   */
+
+	  statement();
+
+	  /* Save the LSP after generating the ELSE <statement>.  We will
+	   * compare elseLSP to the thenLSP below.
+	   */
+
+	  elseLSP = pas_GetCurrentStackLevel();
+	}
+
+      /* Generate the ENDIF label here.  Note that if no ELSE <statement>
+       * is present, this will be the same as the else_label.
+       */
+
+      pas_GenerateDataOperation(opLABEL, endif_label);
+
+      /* We can get to this location through two of three pathes:  (1) through the
+       * THEN <statement>, (2) from the IF <expression> if no ELSE <statement>
+       * is present, or (3) from the ELSE <statement>.  If the LSP is different
+       * through these two pathes, then we will have to invalidate it.
+       */
+
+      if (thenLSP != elseLSP)
+	{
+	  pas_InvalidateCurrentStackLevel();
+	}
+    }
+}
+
+/***********************************************************************/
+
+void compoundStatement(void)
+{
+   TRACE(lstFile,"[compoundStatement]");
+
+   /* Process statements until END encountered */
+   do
+     {
+       getToken();
+       statement();
+     }
+   while (token == ';');
+
+   /* Verify that it really was END */
+
+   if (token != tEND) error (eEND);
+   else getToken();
+}
+
+/***********************************************************************/
+
+void pas_RepeatStatement ()
+{
+   uint16 rpt_label = ++label;
+
+   TRACE(lstFile,"[pas_RepeatStatement]");
+
+   /* REPEAT <statement[;statement[statement...]]> UNTIL <expression> */
+
+   /* Generate top of loop label */
+
+   pas_GenerateDataOperation(opLABEL, rpt_label);
+   do
+     {
+       getToken();
+
+       /* Process <statement> */
+
+       statement();
+     }
+   while (token == ';');
+
+   /* Verify UNTIL follows */
+
+   if (token !=  tUNTIL) error (eUNTIL);
+   else getToken();
+
+   /* Generate UNTIL <expression> */
+
+   expression(exprBoolean, NULL);
+
+   /* Generate conditional branch to the top of loop */
+
+   pas_GenerateDataOperation(opJEQUZ, rpt_label);
+
+   /* NOTE:  The current LSP setting will be correct after the repeat
+    * loop because we fall through from the bottom of the loop after
+    * executing the body at least once.
+    */
+}
+
+/***********************************************************************/
+
+static void pas_WhileStatement(void)
+{
+   uint16  while_label    = ++label;     /* Top of loop label */
+   uint16  endwhile_label = ++label;     /* End of loop label */
+   uint32  nLspChanges;
+   sint32  topOfLoopLSP;
+   boolean bCheckLSP      = FALSE;
+
+   TRACE(lstFile,"[pas_WhileStatement]");
+
+   /* Generate WHILE <expression> DO <statement> */
+
+   /* Skip over WHILE token */
+
+   getToken();
+
+   /* Set top of loop label */
+
+   pas_GenerateDataOperation(opLABEL, while_label);
+
+   /* Evaluate the WHILE <expression> */
+
+   nLspChanges = pas_GetNStackLevelChanges();
+   expression(exprBoolean, NULL);
+
+   /* Generate a conditional jump to the end of the loop */
+
+   pas_GenerateDataOperation(opJEQUZ, endwhile_label);
+
+   /* Save the level stack pointer (LSP) at the top of the
+    * loop.  When first executed, this value will depend on
+    * logic prior to the loop or on values set in the
+    * WHILE <expression>.  On subsequent loops, this value
+    * may be determined by logic within the loop body or
+    * have to restore this value when the loop terminates.
+    */
+
+   topOfLoopLSP =  pas_GetCurrentStackLevel();
+
+   /* Does the WHILE <expression> logic set the LSP? */
+
+   if (nLspChanges == pas_GetNStackLevelChanges())
+     {
+       /* Yes, then the value set in the WHILE <expression>
+	* is the one that will be in effect at the end_while
+	* label.
+	*/
+
+       bCheckLSP = TRUE;
+     }
+
+   /* Verify that the DO token follows the expression */
+
+   if (token !=  tDO) error(eDO);
+   else getToken();
+
+   /* Generate the <statement> following the DO token */
+
+   statement();
+
+   /* Generate a branch to the top of the loop */
+
+   pas_GenerateDataOperation(opJMP, while_label);
+
+   /* Set the bottom of loop label */
+
+   pas_GenerateDataOperation(opLABEL, endwhile_label);
+
+   /* We always get here from the check at the top of the loop.
+    * Normally this will be from the branch from the bottom of 
+    * the loop to the top of the loop.  Then from the conditional
+    * branch at the top of the loop to here.
+    *
+    * But, we need to allow for the special case when the body
+    * of the while loop never executed.  The flag bCheckLSP is
+    * set TRUE if the conditional expression evaluation does not
+    * set the LSP.  In the case, the current LSP will be either
+    * the LSP at the top of the loop (if he body was never executed)
+    * or the current LSP (the body executes at least once).
+    */
+
+   if (bCheckLSP)
+     {
+       if (topOfLoopLSP != pas_GetCurrentStackLevel())
+	 {
+	   /* In thise case, there is uncertainty in the value of the
+	    * LSP and we must invalidate it.  It will be reset to the
+	    * correct the next time that a level stack reference is
+	    * performed.
+	    */
+
+	   pas_InvalidateCurrentStackLevel();
+	 }
+     }
+   else
+     {
+       /* Otherwise, make sure that the code generation logic knows
+	* the correct value of the LSP at this point.
+	*/
+
+       pas_SetCurrentStackLevel(topOfLoopLSP);
+     }
+}
+
+/***********************************************************************/
+/* This is helper function for pas_CaseStatement */
+
+static boolean pas_CheckInvalidateLSP(sint32 *pTerminalLSP)
+{
+  /* Check the LSP after evaluating the case <statement>. */
+
+  sint32 caseLSP = pas_GetCurrentStackLevel();
+  if (caseLSP < 0)
+    {
+      /* If the LSP is invalid after any case <statement>, then it could
+       * be invalid at the end_case label as well.
+       */
+
+      return TRUE;
+    }
+  else if (*pTerminalLSP < 0)
+    {
+      /* The value of the LSP at the end_case label has not
+       * yet been determined.  It must be the value at the
+       * end of this case <statement> (or else it is invalid)
+       */
+
+      *pTerminalLSP = caseLSP;
+    }
+  else if (*pTerminalLSP != caseLSP)
+    {
+      /* The value of the LSP at the end of this case <statement> is
+       * different from the value of the LSP at the end of some other
+       * case <statement>.  The value of the LSP at the end_case label
+       * will be indeterminate and must be invalidated.
+       */
+
+      return TRUE;
+    }
+  /* So far so good */
+
+  return FALSE;
+}
+
+static void pas_CaseStatement(void)
+{
+   uint16  this_case;
+   uint16  next_case      = ++label;
+   uint16  end_case       = ++label;
+   sint32  terminalLSP    = -1;
+   boolean bInvalidateLSP = FALSE;
+
+   TRACE(lstFile,"[pas_CaseStatement]");
+
+   /* Process "CASE <expression> OF" */
+
+   /* Skip over the CASE token */
+
+   getToken();
+
+   /* Evaluate the CASE <expression> */
+
+   expression(exprAnyOrdinal, NULL);
+
+   /* Verify that CASE <expression> is followed with the OF token */
+
+   if (token !=  tOF) error (eOF);
+   else getToken();
+
+   /* Loop to process each case until END encountered */
+
+   for (;;)
+     {
+       this_case = next_case;
+       next_case = ++label;
+
+       /* Process NON-STANDARD ELSE <statement> END */
+
+       if (token == tELSE)
+	 {
+	   getToken();
+
+	   /* Set ELSE statement label */
+
+	   pas_GenerateDataOperation(opLABEL, this_case);
+
+	   /* Evaluate ELSE statement */
+
+	   statement();
+
+	   /* Check the LSP after evaluating the ELSE <statement>. */
+
+	   if (pas_CheckInvalidateLSP(&terminalLSP))
+	     {
+	       /* The LSP will be invalid at the end case label.  Set
+		* a flag so that we can handle invalidation of the LSP when
+		* we get to the end case label.
+		*/
+
+	       bInvalidateLSP = TRUE;
+	     }
+
+	   /* Verify that END follows the ELSE <statement> */
+
+	   if (token != tEND) error(eEND);
+	   else getToken();
+
+	   /* Terminate FOR loop */
+
+	   break;
+	 }
+
+       /* Process "<constant>[,<constant>[,...]] : <statement>"
+	* NOTE:  We accept any kind of constant for the case selector; there
+	* really should be some check to assure that the constant is of the
+	* same type as the expression!
+	*/  
+
+       else
+	 {
+	   /* Loop for each <constant> in the case list */
+
+	   for(;;)
+	     {
+	       /* Verify that we have a constant */
+
+	       if (!isConstant(token))
+		 {
+		   error(eINTCONST);
+		   break;
+		 }
+
+	       /* Generate a comparison of the CASE expression and the constant.
+		*
+		* First duplicate the value to be compared (from the CASE <expression>)
+		* and push the comparison value (from the <constant>:)
+		*/
+
+	       pas_GenerateSimple(opDUP);
+	       pas_GenerateDataOperation(opPUSH, tknInt);
+
+	       /* The kind of comparison we generate depends on if we have to
+		* jump over other case selector comparsions to the statement
+		* or if we can just fall through to the statement
+		*/
+
+	       /* Skip over the constant */
+
+	       getToken();
+
+	       /* If there are multiple constants, they will be separated with
+		* commas.
+		*/
+
+	       if (token == ',')
+		 {
+		   /* Generate jump to <statement> */
+
+		   pas_GenerateDataOperation(opJEQUZ, this_case);
+
+		   /* Skip over comma */
+
+		   getToken();
+		 }
+	       else
+		 {
+		   /* else jump to the next case */
+
+		   pas_GenerateDataOperation(opJNEQZ, next_case);
+		   break;
+		 }
+	     }
+
+	   /* Then process ... : <statement> */
+
+	   /* Verify colon presence */
+
+	   if (token != ':') error(eCOLON);
+	   else getToken();
+
+	   /* Set CASE label */
+
+	   pas_GenerateDataOperation(opLABEL, this_case);
+
+	   /* Evaluate <statement> */
+
+	   statement();
+
+	   /* Jump to exit CASE */
+
+	   pas_GenerateDataOperation(opJMP, end_case);
+
+	   /* Check the LSP after evaluating the case <statement>. */
+
+	   if (pas_CheckInvalidateLSP(&terminalLSP))
+	     {
+	       /* If the LSP will be invalid at the end case label.  Set
+		* a flag so that we can handle invalidation of the LSP when
+		* we get to the end case label.
+		*/
+
+	       bInvalidateLSP = TRUE;
+	     }
+	 }
+
+       /* Check if there are more statements.  If not, verify END present */
+
+       if (token == ';')
+	 {
+	   getToken();
+	 }
+       else if (token == tEND)
+	 {
+	   getToken();
+	   break;
+	 }
+       else
+	 {
+	   error (eEND);
+	   break;
+	 }
+     }
+
+   /* Generate ENDCASE label and Pop CASE <expression> from stack */
+
+   pas_GenerateDataOperation(opLABEL, end_case);
+   pas_GenerateDataOperation(opINDS, -sINT_SIZE);
+
+   /* We may have gotten to this point from many different case <statements>.
+    * The flag bInvalidateLSP will be set if the LSP is not the same for
+    * each of these pathes.  Invalidating the LSP will force it to be reloaded
+    * when the next level stack access is done.
+    */
+
+   if (bInvalidateLSP)
+     {
+       pas_InvalidateCurrentStackLevel();
+     }
+}
+
+/***********************************************************************/
+static void pas_ForStatement(void)
+{
+   STYPE *varPtr;
+   uint16 forLabel    = ++label;
+   uint16 endForLabel = ++label;
+   uint16 jmpOp;
+   uint16 modOp;
+   sint32 topOfLoopLSP;
+
+   TRACE(lstFile,"[pas_ForStatement]");
+
+   /* FOR <assigment statement> <TO, DOWNTO> <expression> DO <statement> */
+
+   /* Skip over the FOR token */
+
+   getToken();
+
+   /* Get and verify the left side of the assignment. */
+   if ((token != sINT) && (token != sSUBRANGE))
+     error(eINTVAR);
+   else
+     {
+       /* Save the token associated with the left side of the assignment
+	* and evaluate the integer assignment.
+	*/
+
+       varPtr = tknPtr;
+       getToken();
+
+       /* Generate the assignment to the integer variable */
+
+       pas_Assignment(opSTS, exprInteger, tknPtr, tknPtr->sParm.v.parent);
+
+       /* Determine if this is a TO or a DOWNTO loop and set up the opCodes
+	* to generate appropriately.
+	*/
+
+       if (token == tDOWNTO)
+	 {
+	   jmpOp = opJGT;
+	   modOp = opDEC;
+	   getToken();
+	 }
+       else if (token == tTO)
+	 {
+	   jmpOp = opJLT;
+	   modOp = opINC;
+	   getToken();
+	 }
+       else
+	 error (eTOorDOWNTO);
+
+       /* Evaluate <expression> DO */
+
+       expression(exprInteger, varPtr->sParm.v.parent);
+
+       /* Verify that the <expression> is followed by the DO token */
+
+       if (token != tDO) error (eDO);
+       else getToken();
+
+       /* Generate top of loop label */
+
+       pas_GenerateDataOperation(opLABEL, forLabel);
+
+       /* Generate the top of loop comparison.  Duplicate the end of loop
+	* value, push the current value, and perform the comparison.
+	*/
+
+       pas_GenerateSimple(opDUP);
+       pas_GenerateStackReference(opLDS, varPtr);
+       pas_GenerateDataOperation(jmpOp, endForLabel);
+
+       /* Save the level stack pointer (LSP) at the top of the FOR
+	* loop.  When first executed, this value will depend on
+	* logic prior to the loop body. On subsequent loops, this
+	* value may be determined by logic within the loop body.
+	*/
+
+       topOfLoopLSP = pas_GetCurrentStackLevel();
+
+       /* Evaluate the for statement <statement> */
+
+       statement();
+
+       /* Generate end of loop logic:  Load the variable, modify the
+	* variable, store the variable, and jump unconditionally to the
+	* top of the loop.
+	*/
+
+       pas_GenerateStackReference(opLDS, varPtr);
+       pas_GenerateSimple(modOp);
+       pas_GenerateStackReference(opSTS, varPtr);
+       pas_GenerateDataOperation(opJMP, forLabel);
+
+       /* Generate the end of loop label.  This is where the conditional
+	* branch at the top of the loop will come to.
+	*/
+
+       pas_GenerateDataOperation(opLABEL, endForLabel);
+       pas_GenerateDataOperation(opINDS, -sINT_SIZE);
+
+       /* We always get here from the check at the top of the loop.
+	* Normally this will be from the branch from the bottom of 
+	* the loop to the top of the loop.  Then from the conditional
+	* branch at the top of the loop to here.
+	*
+	* But, we need to allow for the special case when the body
+	* of the for loop never executed.  In this case, the LSP at
+	* the first time into the loop may differ from the LSP at
+	* subsequent times into the loop.  If this is the case, then
+	* will will have to invalidate the LSP.
+	*/
+
+       if (topOfLoopLSP != pas_GetCurrentStackLevel())
+	 {
+	   /* In thise case, there is uncertainty in the value of the
+	    * LSP and we must invalidate it.  It will be reset to the
+	    * correct the next time that a level stack reference is
+	    * performed.
+	    */
+
+	   pas_InvalidateCurrentStackLevel();
+	 }
+     }
+}
+
+/***********************************************************************/
+static void pas_WithStatement(void)
+{
+   WTYPE saveWithRecord;
+
+   TRACE(lstFile,"[pas_WithStatement]");
+
+   /* Generate WITH <variable[,variable[...]] DO <statement> */
+
+   /* Save the current WITH pointer.  Only one WITH can be active at
+    * any given time.
+    */
+
+   saveWithRecord = withRecord;
+
+   /* Process each RECORD or RECORD OBJECT in the <variable> list */
+
+   getToken();
+   for(;;)
+     {
+       /* A RECORD type variable may be used in the WITH statement only if
+	* there is no other WITH active
+	*/
+
+       if ((token == sRECORD) && (!withRecord.parent))
+	 {
+	   /* Save the RECORD variable as the new withRecord */
+
+	   withRecord.level   = tknPtr->sLevel;
+	   withRecord.pointer = FALSE;
+	   withRecord.varParm = FALSE;
+	   withRecord.offset  = tknPtr->sParm.v.offset;
+	   withRecord.parent  = tknPtr->sParm.v.parent;
+
+	   /* Skip over the RECORD variable */
+
+	   getToken();
+	 }
+
+       /* A RECORD VAR parameter may also be used in the WITH statement
+	* (again only if there is no other WITH active)
+	*/
+
+       else if ((token == sVAR_PARM) &&
+		(!withRecord.parent) &&
+		(tknPtr->sParm.v.parent->sParm.t.type == sRECORD))
+	 {
+	   /* Save the RECORD VAR parameter as the new withRecord */
+
+	   withRecord.level   = tknPtr->sLevel;
+	   withRecord.pointer = TRUE;
+	   withRecord.varParm = TRUE;
+	   withRecord.offset  = tknPtr->sParm.v.offset;
+	   withRecord.parent  = tknPtr->sParm.v.parent;
+
+	   /* Skip over the RECORD VAR parameter */
+
+	   getToken();
+	 }
+
+       /* A pointer to a RECORD may also be used in the WITH statement
+	* (again only if there is no other WITH active)
+	*/
+
+       else if ((token == sPOINTER) &&
+		(!withRecord.parent) &&
+		(tknPtr->sParm.v.parent->sParm.t.type == sRECORD))
+	 {
+	   /* Save the RECORD pointer as the new withRecord */
+
+	   withRecord.level   = tknPtr->sLevel;
+	   withRecord.pointer = TRUE;
+	   withRecord.pointer = FALSE;
+	   withRecord.offset  = tknPtr->sParm.v.offset;
+	   withRecord.parent  = tknPtr->sParm.v.parent;
+
+	   /* Skip over the RECORD pointer */
+
+	   getToken();
+
+	   /* Verify that deferencing is specified! */
+
+	   if (token != '^') error(eRECORDVAR);
+	   else getToken();
+	 }
+
+       /* A RECORD_OBJECT may be used in the WITH statement if the field
+	* is from the same sRECORD type and is itself of type RECORD.
+	*/
+
+       else if ((token == sRECORD_OBJECT) &&
+		(tknPtr->sParm.r.record == withRecord.parent) &&
+		(tknPtr->sParm.r.parent->sParm.t.type == sRECORD))
+	 {
+	   /* Okay, update the withRecord to use this record field */
+
+	   if (withRecord.pointer)
+	     withRecord.index += tknPtr->sParm.r.offset;
+	   else
+	     withRecord.offset += tknPtr->sParm.r.offset;
+
+	   withRecord.parent  = tknPtr->sParm.r.parent;
+
+	   /* Skip over the sRECORD_OBJECT */
+
+	   getToken();
+     }
+
+     /* Anything else is an error */
+
+       else
+	 {
+	   error(eRECORDVAR);
+	   break;
+	 }
+
+
+       /* Check if there are multiple variables in the WITH statement */
+
+       if (token == ',') getToken();
+       else break;
+     }
+
+   /* Verify that the RECORD list is terminated with DO */
+
+   if (token != tDO) error (eDO);
+   else getToken();
+
+   /* Then process the statement following the WITH */
+
+   statement();
+
+   /* Restore the previous value of the withRecord */
+
+   withRecord = saveWithRecord;
+}
+
+/***********************************************************************/
+
diff --git a/misc/pascal/pascal/ptbl.c b/misc/pascal/pascal/ptbl.c
new file mode 100644
index 000000000..da3db7f54
--- /dev/null
+++ b/misc/pascal/pascal/ptbl.c
@@ -0,0 +1,690 @@
+/***************************************************************
+ * ptbl.c
+ * Table Management Package
+ *
+ *   Copyright (C) 2008 Gregory Nutt. All rights reserved.
+ *   Author: Gregory Nutt <spudmonkey@racsa.co.cr>
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ *    notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ *    notice, this list of conditions and the following disclaimer in
+ *    the documentation and/or other materials provided with the
+ *    distribution.
+ * 3. Neither the name NuttX nor the names of its contributors may be
+ *    used to endorse or promote products derived from this software
+ *    without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+ * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+ * COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+ * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+ * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS
+ * OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED
+ * AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+ * ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *
+ ***************************************************************/
+
+/***************************************************************
+ * Included Files
+ ***************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include "config.h"
+#include "keywords.h"
+#include "pdefs.h"
+#include "ptdefs.h"
+#include "pedefs.h"
+
+#include "pas.h"
+#include "ptbl.h"
+#include "perr.h"
+
+/***************************************************************
+ * Private Function Prototypes
+ ***************************************************************/
+
+static STYPE *addSymbol(char *name, sint16 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 sint16 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 sint16 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, sint16 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, ubyte type, uint16 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, ubyte type, sint32 *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 = *((float64 *) 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 offset, uint32 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 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, ubyte type, uint16 label,
+		    uint16 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, ubyte type, uint16 offset,
+		   uint16 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 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)
+{
+  sint32 trueValue   = -1;
+  sint32 falseValue  =  0;
+  sint32 maxintValue = MAXINT;
+  STYPE *typePtr;
+  register sint16 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(sint32 symIndex)
+{
+   register sint16 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 sint16 i;
+
+  fprintf(lstFile,"\nSYMBOL TABLE:\n");
+  fprintf(lstFile,"[  Addr  ]     NAME KIND LEVL\n");
+
+  for (i = 0; i < nsym; i++)
+    {
+      fprintf(lstFile,"[%08lx] ", (uint32)&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
+
+/***************************************************************/
+
diff --git a/misc/pascal/pascal/ptkn.c b/misc/pascal/pascal/ptkn.c
new file mode 100644
index 000000000..e6be2bc09
--- /dev/null
+++ b/misc/pascal/pascal/ptkn.c
@@ -0,0 +1,899 @@
+/***************************************************************
+ * ptkn.c
+ * Tokenization Package
+ *
+ *   Copyright (C) 2008 Gregory Nutt. All rights reserved.
+ *   Author: Gregory Nutt <spudmonkey@racsa.co.cr>
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ *    notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ *    notice, this list of conditions and the following disclaimer in
+ *    the documentation and/or other materials provided with the
+ *    distribution.
+ * 3. Neither the name NuttX nor the names of its contributors may be
+ *    used to endorse or promote products derived from this software
+ *    without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+ * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+ * COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+ * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+ * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS
+ * OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED
+ * AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+ * ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *
+ ***************************************************************/
+
+/***************************************************************
+ * Included Functions
+ ***************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <ctype.h>
+
+#include "keywords.h"
+#include "pdefs.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 boolean 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  inChar;         /* last gotten character */
+
+/***************************************************************
+ * Public Variables
+ ***************************************************************/
+
+char *tkn_strt;               /* Start of token in string stack */
+char *stringSP;               /* Top of string stack */
+
+/***************************************************************
+ * Public Functions
+ ***************************************************************/
+
+sint16 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;
+}
+
+/***************************************************************/
+
+sint16 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(boolean 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 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 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 sint16 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 boolean getLine(void)
+{
+  boolean 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 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 = (sint32)value;
+}
+
+/***************************************************************/
diff --git a/misc/pascal/pascal/punit.c b/misc/pascal/pascal/punit.c
new file mode 100644
index 000000000..c86cc7b49
--- /dev/null
+++ b/misc/pascal/pascal/punit.c
@@ -0,0 +1,598 @@
+/**********************************************************************
+ * punit.c
+ * Parse a pascal unit file
+ *
+ *   Copyright (C) 2008 Gregory Nutt. All rights reserved.
+ *   Author: Gregory Nutt <spudmonkey@racsa.co.cr>
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ *    notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ *    notice, this list of conditions and the following disclaimer in
+ *    the documentation and/or other materials provided with the
+ *    distribution.
+ * 3. Neither the name NuttX nor the names of its contributors may be
+ *    used to endorse or promote products derived from this software
+ *    without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+ * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+ * COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+ * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+ * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS
+ * OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED
+ * AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+ * ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ *
+ **********************************************************************/
+
+/**********************************************************************
+ * Included Files
+ **********************************************************************/
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <ctype.h>
+#include <string.h>
+#include <errno.h>
+
+#include "keywords.h"
+#include "pdefs.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"
+
+/***********************************************************************
+ * 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)
+{
+  sint32  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)
+{
+  sint16  saveNSym   = nsym;          /* Save top of symbol table */
+  sint16  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   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   funcLabel = ++label;
+   sint16   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 */
author	patacongo <patacongo@42af7a65-404d-4744-a932-0658087f49c3>	2008-01-05 13:35:56 +0000
committer	patacongo <patacongo@42af7a65-404d-4744-a932-0658087f49c3>	2008-01-05 13:35:56 +0000
commit	15c5db8e173651f7e0375d3b6e23ee089681448e (patch)
tree	f3a13e408be3ce89c9405394d26aed1397ce3993 /misc/pascal
parent	f6d83168b86cb3f48151a462f3513f58c3762063 (diff)
download	nuttx-15c5db8e173651f7e0375d3b6e23ee089681448e.tar.gz nuttx-15c5db8e173651f7e0375d3b6e23ee089681448e.tar.bz2 nuttx-15c5db8e173651f7e0375d3b6e23ee089681448e.zip