/*************************************************************** * pfunc.c * Standard Functions * * Copyright (C) 2008-2009 Gregory Nutt. All rights reserved. * Author: Gregory Nutt * * 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 #include #include "keywords.h" #include "pasdefs.h" #include "ptdefs.h" #include "podefs.h" #include "pfdefs.h" #include "pedefs.h" #include "pxdefs.h" #include "pas.h" #include "pexpr.h" #include "pfunc.h" #include "pgen.h" /* for pas_Generate*() */ #include "ptkn.h" #include "pinsn.h" #include "perr.h" /*************************************************************** * Private Function Prototypes ***************************************************************/ /* Standard Pascal Functions */ static exprType absFunc (void); /* Integer absolute value */ static exprType predFunc (void); static void ordFunc (void); /* Convert scalar to integer */ static exprType sqrFunc (void); static void realFunc (uint8_t fpCode); static exprType succFunc (void); static void oddFunc (void); static void chrFunc (void); static void fileFunc (uint16_t opcode); /* Enhanced Pascal functions */ /* Non-standard C-library interface functions */ static exprType getenvFunc (void); /* Get environment string value */ /*************************************************************** * Public Functions ***************************************************************/ void primeBuiltInFunctions(void) { } /***************************************************************/ /* Process a standard Pascal function call */ exprType builtInFunction(void) { exprType funcType = exprUnknown; TRACE(lstFile,"[builtInFunction]"); /* Is the token a function? */ if (token == tFUNC) { /* Yes, process it procedure according to the extended token type */ switch (tknSubType) { /* Functions which return the same type as their argument */ case txABS : funcType = absFunc(); break; case txSQR : funcType = sqrFunc(); break; case txPRED : funcType = predFunc(); break; case txSUCC : funcType = succFunc(); break; case txGETENV : /* Non-standard C library interfaces */ funcType = getenvFunc(); break; /* Functions returning INTEGER with REAL arguments */ case txROUND : getToken(); /* Skip over 'round' */ expression(exprReal, NULL); pas_GenerateFpOperation(fpROUND); funcType = exprInteger; break; case txTRUNC : getToken(); /* Skip over 'trunc' */ expression(exprReal, NULL); pas_GenerateFpOperation(fpTRUNC); funcType = exprInteger; break; /* Functions returning CHARACTER with INTEGER arguments. */ case txCHR : chrFunc(); funcType = exprChar; break; /* Function returning integer with scalar arguments */ case txORD : ordFunc(); funcType = exprInteger; break; /* Functions returning BOOLEAN */ case txODD : oddFunc(); funcType = exprBoolean; break; case txEOF : fileFunc(xEOF); funcType = exprBoolean; break; case txEOLN : fileFunc(xEOLN); funcType = exprBoolean; break; /* Functions returning REAL with REAL/INTEGER arguments */ case txSQRT : realFunc(fpSQRT); funcType = exprReal; break; case txSIN : realFunc(fpSIN); funcType = exprReal; break; case txCOS : realFunc(fpCOS); funcType = exprReal; break; case txARCTAN : realFunc(fpATAN); funcType = exprReal; break; case txLN : realFunc(fpLN); funcType = exprReal; break; case txEXP : realFunc(fpEXP); funcType = exprReal; break; default : error(eINVALIDPROC); break; } /* end switch */ } /* end if */ return funcType; } /* end builtInFunction */ void checkLParen(void) { getToken(); /* Skip over function name */ if (token != '(') error(eLPAREN); /* Check for '(' */ else getToken(); } void checkRParen(void) { if (token != ')') error(eRPAREN); /* Check for ')') */ else getToken(); } /*************************************************************** * Private Functions ***************************************************************/ static exprType absFunc(void) { exprType absType; TRACE(lstFile,"[absFunc]"); /* FORM: ABS () */ 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 () */ checkLParen(); expression(exprAnyOrdinal, NULL); /* Get any ordinal type */ checkRParen(); } /* end ordFunc */ /**********************************************************************/ static exprType predFunc(void) { exprType predType; TRACE(lstFile,"[predFunc]"); /* FORM: PRED () */ 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 () */ checkLParen(); sqrType = expression(exprUnknown, NULL); /* Process any expression */ if (sqrType == exprInteger) { pas_GenerateSimple(opDUP); pas_GenerateSimple(opMUL); } /* end if */ else if (sqrType == exprReal) pas_GenerateFpOperation(fpSQR); else error(eINVARG); checkRParen(); return sqrType; } /* end sqrFunc */ /**********************************************************************/ static void realFunc (uint8_t fpOpCode) { exprType realType; TRACE(lstFile,"[realFunc]"); /* FORM: () */ 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 () */ 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 () */ checkLParen(); /* Process any ordinal expression */ expression(exprAnyOrdinal, NULL); checkRParen(); pas_GenerateDataOperation(opPUSH, 1); pas_GenerateSimple(opAND); pas_GenerateSimple(opNEQZ); } /* end oddFunc */ /***********************************************************************/ /* Process the standard chr function */ static void chrFunc(void) { TRACE(lstFile,"[charFactor]"); /* Form: chr(integer expression). * * char(val) is only defined if there exists a character ch such * that ord(ch) = val. If this is not the case, we will simply * let the returned value exceed the range of type char. */ checkLParen(); expression(exprInteger, NULL); checkRParen(); } /* end chrFunc */ /****************************************************************************/ /* EOF/EOLN function */ static void fileFunc(uint16_t opcode) { TRACE(lstFile,"[fileFunc]"); /* FORM: EOF|EOLN () */ 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: = getenv() */ 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; } /***********************************************************************/