mirror of
https://gitee.com/mirrors_PX4/PX4-Autopilot.git
synced 2026-05-18 03:57:34 +08:00
patacongo
add995c32e
git-svn-id: https://nuttx.svn.sourceforge.net/svnroot/nuttx/trunk@4200 7fd9a85b-ad96-42d3-883c-3090e2eb8679
737 lines
21 KiB
C
737 lines
21 KiB
C
/****************************************************************************
|
|
* pproc.c
|
|
* Standard procedures (all called in pstm.c)
|
|
*
|
|
* Copyright (C) 2008-2009 Gregory Nutt. All rights reserved.
|
|
* Author: Gregory Nutt <spudmonkey@racsa.co.cr>
|
|
*
|
|
* Redistribution and use in source and binary forms, with or without
|
|
* modification, are permitted provided that the following conditions
|
|
* are met:
|
|
*
|
|
* 1. Redistributions of source code must retain the above copyright
|
|
* notice, this list of conditions and the following disclaimer.
|
|
* 2. Redistributions in binary form must reproduce the above copyright
|
|
* notice, this list of conditions and the following disclaimer in
|
|
* the documentation and/or other materials provided with the
|
|
* distribution.
|
|
* 3. Neither the name NuttX nor the names of its contributors may be
|
|
* used to endorse or promote products derived from this software
|
|
* without specific prior written permission.
|
|
*
|
|
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
|
* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
|
|
* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
|
|
* FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
|
|
* COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
|
|
* INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
|
|
* BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS
|
|
* OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED
|
|
* AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
|
|
* LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
|
|
* ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
|
|
* POSSIBILITY OF SUCH DAMAGE.
|
|
*
|
|
****************************************************************************/
|
|
|
|
/****************************************************************************
|
|
* Included Files
|
|
****************************************************************************/
|
|
|
|
#include <stdint.h>
|
|
#include <stdbool.h>
|
|
#include <stdio.h>
|
|
#include <string.h>
|
|
|
|
#include "keywords.h"
|
|
#include "pasdefs.h"
|
|
#include "ptdefs.h"
|
|
#include "podefs.h"
|
|
#include "pedefs.h"
|
|
#include "pxdefs.h"
|
|
|
|
#include "pas.h"
|
|
#include "pexpr.h"
|
|
#include "pproc.h"
|
|
#include "pgen.h" /* for pas_Generate*() */
|
|
#include "ptkn.h"
|
|
#include "ptbl.h" /* For parent symbol references */
|
|
#include "perr.h"
|
|
|
|
/****************************************************************************
|
|
* Private Function Prototypes
|
|
****************************************************************************/
|
|
|
|
/* Helpers for standard procedures */
|
|
|
|
static int16_t readProc (void); /* READ procedure */
|
|
static void readText (uint16_t fileNumber); /* READ text file */
|
|
static void readlnProc (void); /* READLN procedure */
|
|
static void fileProc (uint16_t opcode); /* RESET/REWRITE/PAGE procedure */
|
|
static int16_t writeProc (void); /* WRITE procedure */
|
|
static void writeText (uint16_t fileNumber); /* WRITE text file */
|
|
static void writelnProc (void); /* WRITELN procedure */
|
|
|
|
/* Helpers for less-than-standard procedures */
|
|
|
|
static void valProc (void); /* VAL procedure */
|
|
|
|
/****************************************************************************
|
|
* Private Data
|
|
****************************************************************************/
|
|
|
|
/* procedure val(const S : string; var V; var Code : word); */
|
|
|
|
static STYPE valSymbol[4];
|
|
|
|
/****************************************************************************/
|
|
|
|
void primeBuiltInProcedures(void)
|
|
{
|
|
/* procedure val(const S : string; var V; var Code : word); */
|
|
|
|
valSymbol[0].sParm.p.nParms = 3;
|
|
valSymbol[1].sKind = sSTRING;
|
|
valSymbol[1].sParm.p.parent = parentString;
|
|
valSymbol[2].sKind = sVAR_PARM;
|
|
valSymbol[2].sParm.p.parent = parentInteger;
|
|
valSymbol[3].sKind = sVAR_PARM;
|
|
valSymbol[3].sParm.p.parent = parentInteger;
|
|
}
|
|
|
|
/***********************************************************************/
|
|
|
|
void builtInProcedure(void)
|
|
{
|
|
TRACE(lstFile, "[builtInProcedure]");
|
|
|
|
/* Is the token a procedure? */
|
|
|
|
|
|
if (token == tPROC)
|
|
{
|
|
/* Yes, process it procedure according to the extended token type */
|
|
|
|
switch (tknSubType)
|
|
{
|
|
/* Standard Procedures & Functions */
|
|
|
|
case txPAGE :
|
|
fileProc(xWRITE_PAGE);
|
|
break;
|
|
|
|
case txREAD :
|
|
getToken();
|
|
(void)readProc();
|
|
break;
|
|
|
|
case txREADLN :
|
|
readlnProc();
|
|
break;
|
|
|
|
case txRESET :
|
|
fileProc(xRESET);
|
|
break;
|
|
|
|
case txREWRITE :
|
|
fileProc(xREWRITE);
|
|
break;
|
|
|
|
case txWRITE :
|
|
getToken();
|
|
(void)writeProc();
|
|
break;
|
|
|
|
case txWRITELN :
|
|
writelnProc();
|
|
break;
|
|
|
|
case txGET :
|
|
case txNEW :
|
|
case txPACK :
|
|
case txPUT :
|
|
case txUNPACK :
|
|
error(eNOTYET);
|
|
getToken();
|
|
break;
|
|
|
|
/* less-than-standard procedures */
|
|
case txVAL :
|
|
valProc();
|
|
break;
|
|
|
|
/* Its not a recognized procedure */
|
|
|
|
default :
|
|
error(eINVALIDPROC);
|
|
break;
|
|
|
|
} /* end switch */
|
|
} /* end if */
|
|
} /* end builtInProcedure */
|
|
|
|
/***********************************************************************/
|
|
|
|
int actualParameterSize(STYPE *procPtr, int parmNo)
|
|
{
|
|
/* These sizes must agree with the sizes used in actualParameterListg()
|
|
* below.
|
|
*/
|
|
|
|
STYPE *typePtr = procPtr[parmNo].sParm.v.parent;
|
|
switch (typePtr->sKind)
|
|
{
|
|
case sINT :
|
|
case sSUBRANGE :
|
|
case sSCALAR :
|
|
case sSET_OF :
|
|
default:
|
|
return sINT_SIZE;
|
|
break;
|
|
case sCHAR :
|
|
return sCHAR_SIZE;
|
|
break;
|
|
case sREAL :
|
|
return sREAL_SIZE;
|
|
break;
|
|
case sSTRING :
|
|
case sRSTRING :
|
|
return sRSTRING_SIZE;
|
|
break;
|
|
case sARRAY :
|
|
case sRECORD :
|
|
return typePtr->sParm.t.asize;
|
|
break;
|
|
case sVAR_PARM :
|
|
return sPTR_SIZE;
|
|
break;
|
|
}
|
|
}
|
|
|
|
/***********************************************************************/
|
|
|
|
int actualParameterList(STYPE *procPtr)
|
|
{
|
|
STYPE *typePtr;
|
|
register int nParms = 0;
|
|
int size = 0;
|
|
|
|
TRACE(lstFile,"[actualParameterList]");
|
|
|
|
/* Processes the (optional) actual-parameter-list associated with
|
|
* a function or procedure call:
|
|
*
|
|
* FORM: procedure-method-statement =
|
|
* procedure-method-specifier [ actual-parameter-list ]
|
|
* FORM: function-designator = function-identifier [ actual-parameter-list ]
|
|
*
|
|
*
|
|
* On entry, 'token' refers to the token just AFTER the procedure
|
|
* function identifier.
|
|
*
|
|
* FORM: actual-parameter-list =
|
|
* '(' actual-parameter { ',' actual-parameter } ')'
|
|
* FORM: actual-parameter =
|
|
* expression | variable-access |
|
|
* procedure-identifier | function-identifier
|
|
*/
|
|
|
|
/* If this procedure requires parameters, get them and make sure that
|
|
* they match in type and number
|
|
*/
|
|
|
|
if (procPtr->sParm.p.nParms)
|
|
{
|
|
/* If it requires parameters, then the actual-parameter-list must
|
|
* be present and must begin with '('
|
|
*/
|
|
|
|
if (token != '(') error (eLPAREN);
|
|
else getToken();
|
|
|
|
/* Loop to process the expected number of parameters. The formal
|
|
* argument descriptions follow the procedure/function description
|
|
* as an array of variable declarations. (These sizes below must
|
|
* agree with actualParameterSize() above);
|
|
*/
|
|
|
|
for (nParms = 1; nParms <= procPtr->sParm.p.nParms; nParms++)
|
|
{
|
|
typePtr = procPtr[nParms].sParm.v.parent;
|
|
switch (procPtr[nParms].sKind)
|
|
{
|
|
case sINT :
|
|
expression(exprInteger, typePtr);
|
|
size += sINT_SIZE;
|
|
break;
|
|
case sCHAR :
|
|
expression(exprChar, typePtr);
|
|
size += sCHAR_SIZE;
|
|
break;
|
|
case sREAL :
|
|
expression(exprReal, typePtr);
|
|
size += sREAL_SIZE;
|
|
break;
|
|
case sSTRING :
|
|
case sRSTRING :
|
|
expression(exprString, typePtr);
|
|
size += sRSTRING_SIZE;
|
|
break;
|
|
case sSUBRANGE :
|
|
expression(exprInteger, typePtr);
|
|
size += sINT_SIZE;
|
|
break;
|
|
case sSCALAR :
|
|
expression(exprScalar, typePtr);
|
|
size += sINT_SIZE;
|
|
break;
|
|
case sSET_OF :
|
|
expression(exprSet, typePtr);
|
|
size += sINT_SIZE;
|
|
break;
|
|
case sARRAY :
|
|
expression(exprArray, typePtr);
|
|
size += typePtr->sParm.t.asize;
|
|
break;
|
|
case sRECORD :
|
|
expression(exprRecord, typePtr);
|
|
size += typePtr->sParm.t.asize;
|
|
break;
|
|
case sVAR_PARM :
|
|
if (typePtr)
|
|
{
|
|
switch (typePtr->sParm.t.type)
|
|
{
|
|
case sINT :
|
|
varParm(exprIntegerPtr, typePtr);
|
|
size += sPTR_SIZE;
|
|
break;
|
|
case sBOOLEAN :
|
|
varParm(exprBooleanPtr, typePtr);
|
|
size += sPTR_SIZE;
|
|
break;
|
|
case sCHAR :
|
|
varParm(exprCharPtr, typePtr);
|
|
size += sPTR_SIZE;
|
|
break;
|
|
case sREAL :
|
|
varParm(exprRealPtr, typePtr);
|
|
size += sPTR_SIZE;
|
|
break;
|
|
case sARRAY :
|
|
varParm(exprArrayPtr, typePtr);
|
|
size += sPTR_SIZE;
|
|
break;
|
|
case sRECORD :
|
|
varParm(exprRecordPtr, typePtr);
|
|
size += sPTR_SIZE;
|
|
break;
|
|
default :
|
|
error(eVARPARMTYPE);
|
|
break;
|
|
} /* end switch */
|
|
} /* end if */
|
|
else
|
|
error(eVARPARMTYPE);
|
|
break;
|
|
default :
|
|
error (eNPARMS);
|
|
} /* end switch */
|
|
|
|
if (nParms < procPtr->sParm.p.nParms)
|
|
{
|
|
if (token != ',') error (eCOMMA);
|
|
else getToken();
|
|
} /* end if */
|
|
} /* end for */
|
|
|
|
if (token != ')') error (eRPAREN);
|
|
else getToken();
|
|
|
|
} /* end if */
|
|
|
|
return size;
|
|
|
|
} /* end actualParameterList */
|
|
|
|
/***********************************************************************/
|
|
|
|
static int16_t readProc(void)
|
|
{
|
|
uint16_t fileNumber = 0;
|
|
|
|
TRACE(lstFile, "[readProc]");
|
|
|
|
/* FORM:
|
|
* (1) Binary READ: read '(' file-variable ')'
|
|
* (2) Test READ: read read-parameter-list
|
|
* FORM: read-parameter-list =
|
|
* '(' [ file-variable ',' ] variable-access { ',' variable-access } ')'
|
|
*/
|
|
|
|
if (token != '(') error (eLPAREN); /* Skip over '(' */
|
|
else getToken();
|
|
|
|
/* Get file number */
|
|
|
|
if (token == sFILE)
|
|
{
|
|
fileNumber = tknPtr->sParm.fileNumber;
|
|
getToken();
|
|
} /* end if */
|
|
if (token == ',') getToken();
|
|
|
|
/* Determine if this is a text or binary file */
|
|
|
|
if (!(files [fileNumber].defined)) error (eUNDEFILE);
|
|
else if (files [fileNumber].ftype == sCHAR)
|
|
{
|
|
readText (fileNumber);
|
|
}
|
|
else
|
|
{
|
|
pas_GenerateLevelReference(opLAS, files[fileNumber].flevel, files [fileNumber].faddr);
|
|
pas_GenerateDataOperation(opPUSH, files[fileNumber].fsize);
|
|
pas_GenerateIoOperation(xREAD_BINARY, fileNumber);
|
|
} /* end else */
|
|
|
|
if (token != ')') error (eRPAREN);
|
|
else getToken();
|
|
|
|
return (fileNumber);
|
|
} /* end readProc */
|
|
|
|
/***********************************************************************/
|
|
|
|
static void readText (uint16_t fileNumber)
|
|
{
|
|
STYPE *rPtr;
|
|
|
|
TRACE(lstFile, "[readText]");
|
|
|
|
/* The general form is <VAR parm>, <VAR parm>,... */
|
|
|
|
for (;;)
|
|
{
|
|
switch (token)
|
|
{
|
|
/* SPECIAL CASE: Array of type CHAR without indexing */
|
|
|
|
case sARRAY :
|
|
rPtr = tknPtr->sParm.v.parent;
|
|
if (((rPtr) && (rPtr->sKind == sTYPE)) &&
|
|
(rPtr->sParm.t.type == sCHAR) &&
|
|
(getNextCharacter(true) != '['))
|
|
{
|
|
pas_GenerateStackReference(opLAS, rPtr);
|
|
pas_GenerateDataOperation(opPUSH, rPtr->sParm.v.size);
|
|
pas_GenerateIoOperation(xREAD_STRING, fileNumber);
|
|
pas_GenerateDataOperation(opINDS, -(sPTR_SIZE+sINT_SIZE));
|
|
} /* end if */
|
|
|
|
/* Otherwise, we fall through to process the ARRAY like any */
|
|
/* expression */
|
|
|
|
default :
|
|
|
|
switch (varParm(exprUnknown, NULL))
|
|
{
|
|
case exprIntegerPtr :
|
|
pas_GenerateIoOperation(xREAD_INT, fileNumber);
|
|
pas_GenerateDataOperation(opINDS, -sPTR_SIZE);
|
|
break;
|
|
|
|
case exprCharPtr :
|
|
pas_GenerateIoOperation(xREAD_CHAR, fileNumber);
|
|
pas_GenerateDataOperation(opINDS, -sPTR_SIZE);
|
|
break;
|
|
|
|
case exprRealPtr :
|
|
pas_GenerateIoOperation(xREAD_REAL, fileNumber);
|
|
pas_GenerateDataOperation(opINDS, -sPTR_SIZE);
|
|
break;
|
|
|
|
default :
|
|
error(eINVARG);
|
|
break;
|
|
} /* end switch */
|
|
break;
|
|
|
|
} /* end switch */
|
|
|
|
if (token == ',') getToken();
|
|
else return;
|
|
|
|
} /* end for */
|
|
|
|
} /* end readText */
|
|
|
|
/****************************************************************************/
|
|
|
|
static void readlnProc(void) /* READLN procedure */
|
|
{
|
|
int32_t fileNumber;
|
|
|
|
TRACE(lstFile, "[readlnProc]");
|
|
|
|
/* FORM: Just like READ */
|
|
|
|
getToken();
|
|
if (token == '(')
|
|
fileNumber = readProc();
|
|
|
|
/* skip to end-of-line mark in the file (NOTE: No check is made,
|
|
* but this is meaningful only for a test file).
|
|
*/
|
|
|
|
pas_GenerateIoOperation(xREADLN, fileNumber);
|
|
|
|
} /* end readlnProc */
|
|
|
|
/****************************************************************************/
|
|
/* REWRITE/RESET/PAGE procedure call -- REWRITE sets the file pointer to the
|
|
* beginning of the file and prepares the file for write access; RESET is
|
|
* similar except that it prepares the file for read access; PAGE simply
|
|
* writes a form-feed to the file (no check is made, but is meaningful only
|
|
* for a text file). */
|
|
|
|
static void fileProc (uint16_t opcode)
|
|
{
|
|
TRACE(lstFile, "[fileProc]");
|
|
|
|
/* FORM: RESET|REWRITE(<file number>) */
|
|
|
|
getToken();
|
|
if (token != '(') error(eLPAREN);
|
|
else getToken();
|
|
if (token != sFILE) error(eFILE);
|
|
else {
|
|
pas_GenerateIoOperation(opcode, tknPtr->sParm.fileNumber);
|
|
getToken();
|
|
if (token != ')') error(eRPAREN);
|
|
else getToken();
|
|
} /* end else */
|
|
|
|
} /* End fileProc */
|
|
|
|
/***********************************************************************/
|
|
|
|
static int16_t writeProc(void)
|
|
{
|
|
uint16_t fileNumber = 0;
|
|
|
|
TRACE(lstFile, "[writeProc]");
|
|
|
|
/* FORM: (1) Binary WRITE: WRITE(<fileNumber>);
|
|
* (2) Test WRITE: WRITE([<fileNumber>], arg1 [,arg2 [...]]) */
|
|
|
|
if (token != '(') error(eLPAREN); /* Skip over '(' */
|
|
else getToken();
|
|
|
|
/* Get file number */
|
|
|
|
if (token == sFILE) {
|
|
fileNumber = tknPtr->sParm.fileNumber;
|
|
getToken();
|
|
} /* end if */
|
|
if (token == ',') getToken();
|
|
|
|
/* Determine if this is a text or binary file */
|
|
|
|
if (!(files [fileNumber].defined)) error(eUNDEFILE);
|
|
else if (files [fileNumber].ftype == sCHAR)
|
|
writeText(fileNumber);
|
|
else {
|
|
pas_GenerateLevelReference(opLAS, files[fileNumber].flevel, files [fileNumber].faddr);
|
|
pas_GenerateDataOperation(opPUSH, files[fileNumber].fsize);
|
|
pas_GenerateIoOperation(xWRITE_BINARY, fileNumber);
|
|
} /* end else */
|
|
|
|
if (token != ')') error(eRPAREN);
|
|
else getToken();
|
|
return(fileNumber);
|
|
} /* end writeProc */
|
|
|
|
/***********************************************************************/
|
|
|
|
static void writeText (uint16_t fileNumber)
|
|
{
|
|
exprType writeType;
|
|
STYPE *wPtr;
|
|
|
|
TRACE(lstFile, "[writeText]");
|
|
|
|
for (;;)
|
|
{
|
|
/* The general form is <expression>, <expression>, ... However,
|
|
* there are a few unique things that must be handled as special
|
|
* cases
|
|
*/
|
|
|
|
switch (token)
|
|
{
|
|
/* const strings -- either literal constants (tSTRING_CONST)
|
|
* or defined string constant symbols (sSTRING_CONST)
|
|
*/
|
|
|
|
case tSTRING_CONST :
|
|
{
|
|
/* Add the literal string constant to the RO data section
|
|
* and receive the offset to the data.
|
|
*/
|
|
|
|
uint32_t offset = poffAddRoDataString(poffHandle, tkn_strt);
|
|
|
|
/* Set the offset and size on the stack (order is important) */
|
|
|
|
pas_GenerateDataOperation(opLAC, (uint16_t)offset);
|
|
pas_GenerateDataOperation(opPUSH, strlen(tkn_strt));
|
|
|
|
pas_GenerateIoOperation(xWRITE_STRING, fileNumber);
|
|
pas_GenerateDataOperation(opINDS, -(sPTR_SIZE + sINT_SIZE));
|
|
stringSP = tkn_strt;
|
|
getToken();
|
|
}
|
|
break;
|
|
|
|
case sSTRING_CONST :
|
|
pas_GenerateDataOperation(opLAC, (uint16_t)tknPtr->sParm.s.offset);
|
|
pas_GenerateDataOperation(opPUSH, (uint16_t)tknPtr->sParm.s.size);
|
|
pas_GenerateIoOperation(xWRITE_STRING, fileNumber);
|
|
pas_GenerateDataOperation(opINDS, -(sPTR_SIZE + sINT_SIZE));
|
|
getToken();
|
|
break;
|
|
|
|
/* Array of type CHAR without indexing */
|
|
|
|
case sARRAY :
|
|
wPtr = tknPtr->sParm.v.parent;
|
|
if (((wPtr) && (wPtr->sKind == sTYPE)) &&
|
|
(wPtr->sParm.t.type == sCHAR) &&
|
|
(getNextCharacter(true) != '['))
|
|
{
|
|
pas_GenerateStackReference(opLAS, wPtr);
|
|
pas_GenerateDataOperation(opPUSH, wPtr->sParm.v.size);
|
|
pas_GenerateIoOperation(xWRITE_STRING, fileNumber);
|
|
pas_GenerateDataOperation(opINDS, -(sPTR_SIZE + sINT_SIZE));
|
|
break;
|
|
} /* end if */
|
|
|
|
/* Otherwise, we fall through to process the ARRAY like any */
|
|
/* expression */
|
|
|
|
default :
|
|
writeType = expression(exprUnknown, NULL);
|
|
switch (writeType)
|
|
{
|
|
case exprInteger :
|
|
pas_GenerateIoOperation(xWRITE_INT, fileNumber);
|
|
pas_GenerateDataOperation(opINDS, -sINT_SIZE);
|
|
break;
|
|
|
|
case exprBoolean :
|
|
error(eNOTYET);
|
|
break;
|
|
|
|
case exprChar :
|
|
pas_GenerateIoOperation(xWRITE_CHAR, fileNumber);
|
|
pas_GenerateDataOperation(opINDS, -sINT_SIZE);
|
|
break;
|
|
|
|
case exprReal :
|
|
pas_GenerateIoOperation(xWRITE_REAL, fileNumber);
|
|
pas_GenerateDataOperation(opINDS, -sREAL_SIZE);
|
|
break;
|
|
|
|
case exprString :
|
|
case exprStkString :
|
|
pas_GenerateIoOperation(xWRITE_STRING, fileNumber);
|
|
pas_GenerateDataOperation(opINDS, -sRSTRING_SIZE);
|
|
break;
|
|
|
|
default :
|
|
error(eWRITEPARM);
|
|
break;
|
|
|
|
} /* end switch */
|
|
break;
|
|
|
|
} /* end switch */
|
|
|
|
if (token == ',') getToken();
|
|
else return;
|
|
|
|
} /* end for */
|
|
|
|
} /* end writeText */
|
|
|
|
/****************************************************************************/
|
|
|
|
static void writelnProc(void) /* WRITELN procedure */
|
|
{
|
|
int32_t fileNumber = 0;
|
|
|
|
TRACE(lstFile, "[writelnProc]");
|
|
|
|
/* FORM: Just like WRITE */
|
|
|
|
getToken();
|
|
if (token == '(')
|
|
{
|
|
fileNumber = writeProc();
|
|
}
|
|
|
|
/* Skip to past end-of-line mark in the file (NOTE: No check is made, but
|
|
* this is meaningful only for a test file).
|
|
*/
|
|
|
|
pas_GenerateIoOperation(xWRITELN, fileNumber);
|
|
|
|
} /* end writelnProc */
|
|
|
|
/****************************************************************************/
|
|
|
|
static void valProc(void) /* VAL procedure */
|
|
{
|
|
int size;
|
|
|
|
TRACE(lstFile, "[valProc]");
|
|
|
|
/* Declaration:
|
|
* procedure val(const S : string; var V; var Code : word);
|
|
*
|
|
* Description:
|
|
* val() converts the value represented in the string S to a numerical
|
|
* value, and stores this value in the variable V, which can be of type
|
|
* Longint, Real and Byte. If the conversion isn��t succesfull, then the
|
|
* parameter Code contains the index of the character in S which
|
|
* prevented the conversion. The string S is allowed to contain spaces
|
|
* in the beginning.
|
|
*
|
|
* The string S can contain a number in decimal, hexadecimal, binary or
|
|
* octal format, as described in the language reference.
|
|
*
|
|
* Errors:
|
|
* If the conversion doesn��t succeed, the value of Code indicates the
|
|
* position where the conversion went wrong.
|
|
*/
|
|
|
|
/* Skip over the 'val' identifer */
|
|
|
|
getToken();
|
|
|
|
/* Setup the actual-parameter-list */
|
|
|
|
size = actualParameterList(valSymbol);
|
|
|
|
/* Generate the built-in procedure call. NOTE the procedure call
|
|
* logic will release the parameters from the stack saving us from
|
|
* having to generate the INDS here.
|
|
*/
|
|
|
|
pas_BuiltInFunctionCall(lbVAL);
|
|
|
|
} /* end writelnProc */
|
|
|
|
/***********************************************************************/
|