G:/ScriptBasic/source/expression.c

Go to the documentation of this file.
00001 /*
00002 FILE:   expression.c
00003 HEADER: expression.h
00004 
00005 --GNU LGPL
00006 This library is free software; you can redistribute it and/or
00007 modify it under the terms of the GNU Lesser General Public
00008 License as published by the Free Software Foundation; either
00009 version 2.1 of the License, or (at your option) any later version.
00010 
00011 This library is distributed in the hope that it will be useful,
00012 but WITHOUT ANY WARRANTY; without even the implied warranty of
00013 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
00014 Lesser General Public License for more details.
00015 
00016 You should have received a copy of the GNU Lesser General Public
00017 License along with this library; if not, write to the Free Software
00018 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
00019 
00020 TO_HEADER:
00021 
00022 #define MAX_LEXES_PER_LINE 14 // the maximum number of lexicals allowed on a line
00023                               // (note that an expression or an expression list is one lexical in this calculation)
00024 #define MAX_GO_CONSTANTS 3    // the number of different unnamed label types a command may accept
00025                               // usually the only such construction is ENDIF that can finish an ELSE as
00026                               // well as an IF branch. But to be safe we have three.
00027 #define MAX_SAME_LABELS 10    // the max number of labels that can point to the same line
00028 
00029 typedef struct _SymbolUF { //User Function
00030   unsigned long FunId; // The serial number of the function
00031   long Argc; // the number of arguments (-1 means uninitialized)
00032   unsigned long node; // where the function is defined
00033   char *FunctionName; // the name of the function to print in error message when it is used, but not defined
00034   struct _SymbolUF *next;
00035   } SymbolUF, *pSymbolUF;
00036 
00037 
00038 typedef struct _eNODE {
00039   long OpCode; // the code of operation
00040   unsigned long NodeId; // the id of the node
00041   char *szFileName;// where the lexeme is
00042   long lLineNumber;// from which this syntax node is made
00043   union {
00044 
00045     // when the node is a command
00046     struct {
00047       union {
00048         struct _SymbolLABEL *pLabel;
00049         struct _eNODE *pNode;
00050         struct _eNODE_l *pNodeList;
00051         long lLongValue;
00052         double dDoubleValue;
00053         char *szStringValue;
00054         }Argument;
00055       long sLen;
00056       struct _eNODE *next;
00057       }CommandArgument;
00058 
00059     // when the node is an operation
00060     struct {
00061       struct _eNODE_l *Argument;
00062       }Arguments;
00063 
00064     // when the node is a constant
00065     struct {
00066       union {
00067         double dValue;        
00068         long   lValue;        
00069         char  *sValue;
00070         }Value;
00071       long sLen; //the length of the string constant
00072       }Constant;
00073 
00074     // when the node is a variable
00075     struct {
00076       unsigned long Serial; // the serial number of the variable
00077       }Variable;
00078 
00079     // when node is a user functions
00080     struct {
00081       pSymbolUF pFunction; // pointer to the function
00082       struct _eNODE_l *Argument;
00083       }UserFunction;
00084 
00085     }Parameter;
00086 
00087   } eNODE,*peNODE;
00088 
00089 // these values are used for the built-in functionalities
00090 // other opcode values are defined in tables
00091 enum {
00092   eNTYPE_ARR=1, // array access
00093   eNTYPE_SAR,   // assoc array access
00094   eNTYPE_FUN,   // function
00095   eNTYPE_LVR,   // local variable
00096   eNTYPE_GVR,   // global variable
00097   eNTYPE_DBL,   // constant double
00098   eNTYPE_LNG,   // constant long
00099   eNTYPE_STR,   // constant string
00100   eNTYPE_LST,   // list member (only after build)
00101   eNTYPE_CRG,   // command arguments
00102 
00103   __eNTYPE_DUMMY__
00104   };
00105 
00106 // node list
00107 typedef struct _eNODE_l{
00108   unsigned long NodeId; // the id of the node
00109   char *szFileName;// where the lexeme is
00110   long lLineNumber;// from which this syntax node is made
00111   peNODE actualm;
00112   struct _eNODE_l *rest;
00113   } eNODE_l, *peNODE_l;
00114 
00115 typedef struct _SymbolLABEL { // label for GOTO and alikes
00116   long Serial; // serial value of the label
00117   unsigned long node; // where the label is placed (the node id)
00118   } SymbolLABEL, *pSymbolLABEL;
00119 
00120 typedef struct _SymbolVAR { //Variable
00121   long Serial; // serial number of the variable
00122   } SymbolVAR, *pSymbolVAR;
00123 
00124 typedef struct _LabelStack {
00125   pSymbolLABEL pLabel;
00126   struct _LabelStack *Flink;
00127   long Type;
00128   } LabelStack, *pLabelStack;
00129 
00130 typedef struct _BFun {   // built in function
00131   long OpCode;  // Lexeme symbol code as well as operation code
00132   long MinArgs; // The minimum nulber of arguments
00133   long MaxArgs; // The maximum number of arguments
00134   } BFun, *pBFun;
00135 
00136 typedef struct _PredLConst {
00137   char *name;
00138   long value;
00139   }PredLConst,*pPredLConst;
00140 
00141 // constant values used in the line syntax description table
00142 enum {
00143   EX_LEX_EXP = 1,  // expression
00144   EX_LEX_EXPL,     // expression list
00145   EX_LEX_LVAL,     // left value
00146   EX_LEX_LVALL,    // left value list
00147   EX_LEX_NSYMBOL,  // non-alpha symbol or alpha symbol which is reserved and therefore tokenized
00148   EX_LEX_SYMBOL,   // a symbol, like a variable
00149   EX_LEX_ASYMBOL,  // a symbol that does not need name space tuning (usually like MODULE xxx)
00150   EX_LEX_PRAGMA,   // a pragma symbol
00151   EX_LEX_SET_NAME_SPACE, // a symbol that sets the name space
00152   EX_LEX_RESET_NAME_SPACE, // end of name space, old name space is restored
00153   EX_LEX_CHARACTER,// a character, like '(' or ')'
00154   EX_LEX_LONG,     // a numeric integer value
00155   EX_LEX_DOUBLE,   // a numeric float value
00156   EX_LEX_STRING,   // a string value
00157   EX_LEX_LOCAL,    // a local variable, does not generate code, but is declared as local
00158   EX_LEX_LOCALL,   // local variable list,    -"-
00159   EX_LEX_GLOBAL,   // global variable, -"-
00160   EX_LEX_GLOBALL,  // global variable list , -"-
00161   EX_LEX_FUNCTION, // function or procedure definition symbol
00162   EX_LEX_THIS_FUNCTION, // the name of the current function
00163   EX_LEX_LABEL_DEFINITION, //a global label is defined (symbol)
00164   EX_LEX_LABEL,    // a global label is used
00165   EX_LEX_STAR,     // the star pseudo lexer that says the syntax failure is final
00166   EX_LEX_NOEXEC,   // the command needs no code
00167   EX_LEX_ARG_NUM,  // store the number of arguments
00168 
00169   EX_LEX_GO_FORWARD,
00170   EX_LEX_GO_BACK,
00171   EX_LEX_COME_FORWARD,
00172   EX_LEX_COME_BACK,
00173 
00174 // The followings are pseudo syntax elements that instruct the
00175 // compiler to do some semantic action, but does not actually
00176 // match any lexical elements.
00177 // These values should usually appear at the end of a line
00178 // definition after the new line.
00179 
00180   EX_LEX_LOCAL_START, // start a new local area, like start of a user proc or user function
00181   EX_LEX_LOCAL_END,   // finish a local area
00182 
00183   EX_LEX_CONST_NAME,  // constant name
00184   EX_LEX_GCONST_NAME, // global constant name
00185   EX_LEX_CONST_VALUE, // constant value
00186 
00187   EX_LEX_DUMMY
00188   };
00189 
00190 typedef struct _LineSyntaxUnit {
00191   int type;          // type of the syntactical element from the enum above
00192   long OpCode;       // the opcode
00193   long GoConstant[MAX_GO_CONSTANTS];
00194   } LineSyntaxUnit, *pLineSyntaxUnit;
00195 
00196 typedef struct _LineSyntax {
00197   long CommandOpCode;
00198   peNODE (*pfAnalyzeFunction)();
00199   LineSyntaxUnit lexes[MAX_LEXES_PER_LINE];
00200   } LineSyntax, *pLineSyntax;
00201 
00202 typedef struct _NameSpaceStack {
00203   struct _NameSpaceStack *next;
00204   char *ThisNameSpace;
00205   }NameSpaceStack, *pNameSpaceStack;
00206 
00207 typedef struct _eXobject {
00208   void *(*memory_allocating_function)(size_t);
00209   void (*memory_releasing_function)(void *);
00210   void *pMemorySegment; //this pointer is passed to the memory allocating functions
00211                         //this pointer is initialized in ex_init
00212   void *pLocalVarMemorySegment; // this memory segment is used to allocate local memory variables
00213                                 // initialized in ex_init
00214   void *pSymbolTableMemorySegment; // for all symbol table entries that are not local
00215 
00216   pLexObject pLex;    // the lexicals that we work up
00217 
00218   SymbolTable GlobalVariables;
00219   SymbolTable UserFunctions;
00220   SymbolTable LocalVariables;
00221   SymbolTable LocallyDeclaredGlobalVariables;
00222   SymbolTable GlobalLabels;  // currently there are only global labels, locality is done with name decoration
00223   SymbolTable GlobalConstants; // global constants, locality is done with name decoration
00224   long *plNrLocalVariables; //pointer to the long where we store the number of the local variables
00225                             // this value is known at the end of the user function or user proc,
00226                             // but should be stored in the func or proc head.
00227                             // Note that we do need a single variable for this, and not a push/pop stack
00228                             // because functions and procedures can not be nested
00229   pPredLConst PredeclaredLongConstants;
00230   long cGlobalVariables;
00231   long cGlobalLabels;
00232   long cLocalVariables;
00233   long cUserFunctions;
00234 
00235   pSymbolUF FirstUF; // the first User Function. Used to go throug the functions to check that all are defined.
00236 
00237   int iWeAreLocal; // is true when variables should be processed as local variables otherwise zero
00238   int iDeclareVars; // is true when all global/local variables have to be declared
00239   int iDefaultLocal; // it is true when all undefined variables are treated as local
00240 
00241 // ScriptBasic supports modules and nested name spaces. However
00242 // this is nothing else than allowing :: in names, like main::a.
00243 
00244 // There is always a current name space during compilation. The default
00245 // name space is main.
00246 
00247 // A symbol or variable in the source can be absolute or relative
00248 // regarding name spaces. An absolute reference is like T<main::v>
00249 // a variable named T<v> from the name space main. Name spaces can
00250 // arbitrarily be nested, therefore package::subpackage::v is a valid variable.
00251 
00252 // The variable CurrentNameSpace contains the current name space and
00253 // should always contain the trailing ::
00254 
00255 
00256   char *CurrentNameSpace;
00257   long cbCurrentNameSpace;
00258   pNameSpaceStack pOldNameSpace;
00259 
00260   unsigned long *Unaries; // array of token codes that are unary operations. Final element should be zero
00261   // This array contains the opcodes of the binary operations. Each odd element should give the opcode
00262   // of the operation and the next element is the precedence value. The final element is zero,
00263   // therefore zero can not be used as a legal opcode for binary operations.
00264   unsigned long *Binaries;
00265   unsigned long MAXPREC; // maximal precedence of binary operators
00266 
00267   pBFun BuiltInFunctions;
00268 
00269   pReportFunction report;
00270   void *reportptr; // this pointer is passed to the report function. The caller should set it.
00271   int iErrorCounter;
00272   unsigned long fErrorFlags;
00273 
00274   char *Buffer;
00275   size_t cbBuffer;
00276 
00277   pLineSyntax Command;
00278 
00279   peNODE_l pCommandList;
00280 
00281   unsigned long NodeCounter; // used to count the nodes and assign NodeId
00282 
00283   pSymbolUF ThisFunction; // the serial number of the current function
00284 
00285   // the stack to store the unnamed labels for loop and 'if then else' constructions
00286   pLabelStack pComeAndGoStack;
00287   pLabelStack pFreeComeAndGoStack; // to save global allocation we store freed label stack structures
00288                                    // in this list
00289   pSymbolLABEL LabelsWaiting[MAX_SAME_LABELS];
00290   unsigned long cLabelsWaiting;
00291   pSymbolUF pFunctionWaiting;
00292 
00293   unsigned long cbStringTable; // all the bytes of builder StringTable including the zeroes
00294   struct _PreprocObject *pPREP;
00295   } eXobject, *peXobject;
00296 
00297 typedef void (*CommandFunctionType)();
00298 
00299 */
00300 
00301 /*POD
00302 
00303 The functions in this file compile a ScriptBasic expression into
00304 internal form. The functions are quite general, and do NOT depend
00305 on the actual operators that are implemented in the actual version.
00306 
00307 This means that you can define extra operators as well as extra
00308 built-in functions easily adding entries into tables and need not modify
00309 the compiling code.
00310 
00311 CUT*/
00312 
00313 /*POD
00314 =H What is an expression in ScriptBasic
00315 
00316 Altough the syntax defintion in script basic is table driven and can easily be modified
00317 expressions are not. The syntax of an expression is somewhat fix. Here we formally define
00318 what the program thinks to be an expression. This restriction should not cause problem
00319 in the usage of this module because this is the usual syntax of an expression. Any altering
00320 to this would result in an expression syntax which is unusual, and therefore difficult to
00321 use for the common users. The operators and functions along with therir precedence values are
00322 defined in tables anyway, so you have flexibility.
00323 
00324 The formal description of an expression syntax:
00325 
00326 =verbatim
00327  tag ::= UNOP tag
00328          NUMBER
00329          STRING
00330          '(' expression ')'
00331          VARIABLE { '[' expression_list ']' }
00332          VARIABLE '{' expression_list '}'
00333          FUNC '(' expression_list ')'
00334          .
00335 
00336  expression_list ::= expression [ ',' expression_list ] .
00337 
00338  expression_i(1) ::= tag .
00339 
00340  expression_i(i) := expression_i(i-1) [ OP(i) expression_i(i) ] .
00341 
00342  expression ::= expression_i(MAX_PREC) .
00343 
00344  left_value ::= variable { '[' expression_list ']' } 
00345                 variable '{' expression_list '}' .
00346 
00347 =noverbatim
00348 
00349 =itemize
00350 =item UNOP
00351 
00352 is unary operator as defined in tables in file operators.h
00353 
00354 =item NUMBER 
00355 
00356 is a number, lexical element.
00357 
00358 =item STRING 
00359 
00360 is a string, lexical element.
00361 
00362 =item VARIABLE 
00363 
00364 is a lexical element.
00365 
00366 =item FUNC 
00367 
00368 is a function either built in, or user defined
00369 
00370 =item OP(i)
00371 
00372 is an operator of precendece i as defined in tables.
00373 
00374 =noitemize
00375 
00376 
00377 CUT*/
00378 #include <stdlib.h>
00379 #include <string.h>
00380 #include <stdio.h>
00381 
00382 
00383 #include "errcodes.h"
00384 #include "report.h"
00385 #include "lexer.h"
00386 #include "sym.h"
00387 #include "expression.h"
00388 #include "myalloc.h"
00389 
00390 /* we need this to get the constant CMD_EQ, CMD_MINUS, CMD_PLUS */
00391 #include "syntax.h"
00392 #include "ipreproc.h"
00393 
00394 #define new_eNODE()    _new_eNODE(pEx)
00395 #define new_eNODE_l()  _new_eNODE_l(pEx,NULL,0L)
00396 #define new_eNODE_lL() _new_eNODE_l(pEx,pszFileName,lLineNumber)
00397 #define new_SymbolUF() _new_SymbolUF(pEx)
00398 #define new_SymbolVAR(y) _new_SymbolVAR(pEx,y)
00399 #define new_SymbolLABEL() _new_SymbolLABEL(pEx)
00400 #define ex_PopLabel(y) _ex_PopLabel(pEx,y)
00401 #define ex_CleanLabelStack() _ex_CleanLabelStack(pEx)
00402 #define LOCAL_VAR 1
00403 #define GLOBAL_VAR 0
00404 
00405 #define LexemeLineNumber lex_LineNumber(pEx->pLex)
00406 #define LexemeFileName   lex_FileName(pEx->pLex)
00407 #define NextLexeme       lex_NextLexeme(pEx->pLex);
00408 #define LexemeType       (lex_EOF(pEx->pLex) ? 0 : lex_Type(pEx->pLex))
00409 #define LexemeCode       lex_Code(pEx->pLex)
00410 #define LexemeChar       lex_Char(pEx->pLex)
00411 #define LexemeStrLen     lex_StrLen(pEx->pLex)
00412 #define LexemeString     lex_String(pEx->pLex)
00413 #define LexemeDouble     lex_Double(pEx->pLex)
00414 #define LexemeLong       lex_Long(pEx->pLex)
00415 #define LexemeInt        lex_Int(pEx->pLex)
00416 #define LexemeSymbol     lex_Symbol(pEx->pLex)
00417 #define WeAreLocal       (pEx->iWeAreLocal)
00418 #define WeAreNotLocal    (!pEx->iWeAreLocal)
00419 #define DeclareVars   (pEx->iDeclareVars)
00420 #define DefaultLocal     (pEx->iDefaultLocal)
00421 
00422 #define COUNT_STRING_LEN (pEx->cbStringTable += sizeof(long));
00423 
00424 #define CALL_PREPROCESSOR(X,Y) if( pEx->pPREP && pEx->pPREP->n )ipreproc_Process(pEx->pPREP,X,Y)
00425 
00426 #define REPORT(x1,x2,x3,x4) do{if( pEx->report )pEx->report(pEx->reportptr,x1,x2,x3,REPORT_ERROR,&(pEx->iErrorCounter),x4,&(pEx->fErrorFlags));}while(0)
00427 
00428 static isinset(int ch,char *string){
00429    while( ch != *string && *++string );
00430    return *string;
00431 }
00432 
00433 static void _ex_printVAR(char *name, void *value, void *f){
00434   FILE *fp = (FILE *)f;
00435   pSymbolVAR p = (pSymbolVAR)value;
00436 
00437   fprintf(f,"%s=%d\n",name,p->Serial);
00438   }
00439 
00440 /*POD
00441 =H ex_DumpVariables()
00442 
00443 This function dumps the variables stored in the symbol table to the file pointed by
00444 T<fp>
00445 
00446 /*FUNCTION*/
00447 void ex_DumpVariables(SymbolTable q,
00448                       FILE *fp
00449   ){
00450 /*noverbatim
00451 
00452 Note that this function is a debug function.
00453 CUT*/
00454   sym_TraverseSymbolTable(q,_ex_printVAR,(void*)fp);
00455   }
00456 
00457 static void _ex_pprint(FILE *f, peNODE p, peXobject pEx,int tab);
00458 void _ex_pprint_l(FILE *f, peNODE_l p, peXobject pEx,int tab){
00459   fprintf(f,"%*sexpression list\n",tab,"");
00460   while( p ){
00461     fprintf(f,"%*sNode id=%d\n",tab,"",p->NodeId);
00462     _ex_pprint(f,p->actualm,pEx,tab+1);
00463     p = p->rest ;
00464     }
00465   }
00466 
00467 static void _ex_pprint(FILE *f, peNODE p, peXobject pEx,int tab){
00468   unsigned long *q;
00469   pLineSyntax pCommand;
00470   peNODE_l z;
00471   int i,j;
00472 
00473 #define OPCODE (p->OpCode)
00474 
00475   if( tab )fprintf(f,"%*s",tab,"");
00476   fprintf(f," %d ",p->NodeId);
00477   tab++;
00478   if( p == NULL  )return;
00479   switch(OPCODE){
00480 
00481     case eNTYPE_ARR: /* array access */
00482       fprintf(f,"Array access\n");
00483       _ex_pprint_l(f, p->Parameter.Arguments.Argument ,pEx,tab+1);
00484       break;
00485     case eNTYPE_SAR: /* associative array access */
00486       fprintf(f,"Associative array access\n");
00487       _ex_pprint_l(f, p->Parameter.Arguments.Argument ,pEx,tab+1);
00488       break;
00489     case eNTYPE_FUN: /* function */
00490       fprintf(f,"User function call starting at node %d\n",p->Parameter.UserFunction.pFunction->node);
00491       _ex_pprint_l(f, p->Parameter.UserFunction.Argument ,pEx,tab+1);
00492       break;
00493     case eNTYPE_LVR: /* local variable */
00494       fprintf(f,"Local variable %d\n",p->Parameter.Variable.Serial);
00495       return;
00496     case eNTYPE_GVR: /* global variable */
00497       fprintf(f,"Global variable %d\n",p->Parameter.Variable.Serial);
00498       return;
00499     case eNTYPE_DBL: /* constant double */
00500       fprintf(f,"Double: %f\n",p->Parameter.Constant.Value.dValue);
00501       return;
00502     case eNTYPE_LNG: /* constant long */
00503       fprintf(f,"Long: %d\n",p->Parameter.Constant.Value.lValue);
00504       return;
00505     case eNTYPE_STR: /* constant string */
00506       fprintf(f,"String %s\n",p->Parameter.Constant.Value.sValue);
00507       return;
00508     default: /* */
00509       q = pEx->Binaries;
00510 
00511       while( *q && *q != (unsigned)OPCODE )q+=2;
00512       if( *q ){
00513         fprintf(f,"Opcode: %d %s",OPCODE,lex_SymbolicName(pEx->pLex,OPCODE));
00514         fprintf(f,"bin\n");
00515         _ex_pprint(f,p->Parameter.Arguments.Argument->actualm,pEx,tab);
00516         fprintf(f,"rest %d\n",p->Parameter.Arguments.Argument->rest->NodeId);
00517         _ex_pprint(f,p->Parameter.Arguments.Argument->rest->actualm,pEx,tab);
00518         return;
00519         }
00520       q = pEx->Unaries;
00521       while( *q && *q != (unsigned)OPCODE )q++;
00522       if( *q ){
00523         fprintf(f,"Opcode: %d %s",OPCODE,lex_SymbolicName(pEx->pLex,OPCODE));
00524         fprintf(f,"una\n");
00525         _ex_pprint(f,p->Parameter.Arguments.Argument->actualm,pEx,tab);
00526         return;
00527         }
00528       pCommand = pEx->Command;
00529       while( pCommand && pCommand->CommandOpCode != 0 && pCommand->CommandOpCode != OPCODE )pCommand++;
00530       if( pCommand && pCommand->CommandOpCode ){
00531         fprintf(f,"Command %d %s\n",OPCODE,lex_SymbolicName(pEx->pLex,OPCODE));
00532         for( i=0,j=0 ; j < MAX_LEXES_PER_LINE && pCommand->lexes[j].type && p ; j++ ){
00533           switch( pCommand->lexes[j].type ){
00534             case EX_LEX_CHARACTER:
00535               break;
00536             case EX_LEX_NSYMBOL:
00537               break;
00538             case EX_LEX_EXP:
00539               fprintf(f,"%*sexpression %d\n",tab,"",p->Parameter.CommandArgument.Argument.pNode->NodeId);
00540               _ex_pprint(f,p->Parameter.CommandArgument.Argument.pNode,pEx,tab);
00541               p=p->Parameter.CommandArgument.next;
00542               break;
00543             case EX_LEX_EXPL:
00544               fprintf(f,"%*sexpression list\n",tab,"");
00545               z = p->Parameter.CommandArgument.Argument.pNodeList;
00546               while( z ){
00547                 _ex_pprint(f,z->actualm,pEx,tab);
00548                 z = z->rest;
00549                 }
00550               p=p->Parameter.CommandArgument.next;
00551               break;
00552             case EX_LEX_LVAL:
00553               fprintf(f,"%*slval %d\n",tab,"",p->Parameter.CommandArgument.Argument.pNode->NodeId);
00554               _ex_pprint(f,p->Parameter.CommandArgument.Argument.pNode,pEx,tab);
00555               p=p->Parameter.CommandArgument.next;
00556               break;
00557             case EX_LEX_SYMBOL:
00558               fprintf(f,"%*ssymbol=%s\n",tab,"",p->Parameter.CommandArgument.Argument.szStringValue);
00559               p=p->Parameter.CommandArgument.next;
00560               break;
00561             case EX_LEX_LONG:
00562               fprintf(f,"%*slong=%d\n",tab,"",p->Parameter.CommandArgument.Argument.lLongValue);
00563               p=p->Parameter.CommandArgument.next;
00564               break;
00565             case EX_LEX_DOUBLE:
00566               fprintf(f,"%*sdouble=%f\n",tab,"",p->Parameter.CommandArgument.Argument.dDoubleValue);
00567               p=p->Parameter.CommandArgument.next;
00568               break;
00569             case EX_LEX_ASYMBOL:
00570               fprintf(f,"%*ssymbol=\"%s\"\n",tab,"",p->Parameter.CommandArgument.Argument.szStringValue);
00571               p=p->Parameter.CommandArgument.next;
00572               break;
00573             case EX_LEX_STRING:
00574               fprintf(f,"%*sstring=\"%s\"\n",tab,"",p->Parameter.CommandArgument.Argument.szStringValue);
00575               p=p->Parameter.CommandArgument.next;
00576               break;
00577             }       
00578           }
00579         return;
00580         }
00581       /* should be built-in function */
00582       fprintf(f,"Opcode: %d ",OPCODE);
00583       fprintf(f,"bif\n");
00584       z = p->Parameter.Arguments.Argument;
00585       while( z ){
00586          _ex_pprint(f,z->actualm,pEx,tab);
00587          z = z->rest;
00588          }
00589       return;
00590      }
00591 #undef OPCODE
00592    }
00593 
00594 /*POD
00595 =H expression_PushNameSpace()
00596 
00597 When a T<module name> instruction is encountered the name space is modified. However
00598 the old name space should be reset when an T<end module> statement is reached. As the
00599 modules can be nested into each other the name spaces are stored in a name space stack
00600 during syntax analysis.
00601 
00602 This function pushes the current name space onto the stack. After calling
00603 this function the caller can put the new string into the T<pEx->>T<CurrentNameSpace>
00604 variable and later calling R<ex_PopNameSpace()> can be called to retrive the saved name space.
00605 
00606 /*FUNCTION*/
00607 int expression_PushNameSpace(peXobject pEx
00608   ){
00609 /*noverbatim
00610 CUT*/
00611   pNameSpaceStack p;
00612 
00613   p = (pNameSpaceStack)alloc_Alloc(sizeof(NameSpaceStack),pEx->pMemorySegment);
00614   if( p == NULL )return EX_ERROR_MEMORY_LOW;
00615 
00616   p->ThisNameSpace = (char *)alloc_Alloc(strlen(pEx->CurrentNameSpace)+1,pEx->pMemorySegment);
00617   if( p->ThisNameSpace == NULL ){
00618     alloc_Free(p,pEx->pMemorySegment);
00619     return EX_ERROR_MEMORY_LOW;
00620     }
00621   strcpy(p->ThisNameSpace,pEx->CurrentNameSpace);
00622 
00623   p->next = pEx->pOldNameSpace;
00624   pEx->pOldNameSpace = p;
00625   return EX_ERROR_SUCCESS;
00626   }
00627 
00628 /* This is a callback function that the function CheckUndefinedLabels
00629    function calls via the TraverseSymbolTable function.
00630 */
00631 static void CUL_callback(char *LabelName, void *pL, void *f){
00632   peXobject pEx = (peXobject)f;
00633   pSymbolLABEL pLabel = (pSymbolLABEL)pL;
00634 
00635   if( pLabel->node == 0 ){
00636     if( pEx->report )
00637       REPORT("",0,EX_ERROR_LABEL_NOT_DEFINED,LabelName);
00638     else
00639       pEx->iErrorCounter++;
00640     }
00641   }
00642 
00643 /*POD
00644 =H ex_CheckUndefinedLabels()
00645 
00646 This function traverses the label symbol table and reports all undefined
00647 labels as error. Undefined labels reference the node with node-number zero. Jumping
00648 on a label like that caused the program to stop instead of compile time error
00649 in previous versions.
00650 
00651 /*FUNCTION*/
00652 void ex_CheckUndefinedLabels(peXobject pEx
00653   ){
00654 /*noverbatim
00655 CUT*/
00656   sym_TraverseSymbolTable(pEx->GlobalLabels,CUL_callback,pEx);
00657   }
00658 
00659 /*POD
00660 =H ex_CleanNameSpaceStack()
00661 
00662 This function cleans the name space stack. This cleaning does not need to be done during
00663 syntax analysis. It is needed after the analysis has been done to detect unclosed modules.
00664 
00665 Note that the T<main::> module is implicit and can not and should not be closed
00666 unless it was explicitly opened.
00667 
00668 The function calls the report function if the name space is not empty when the function is called.
00669 /*FUNCTION*/
00670 void ex_CleanNameSpaceStack(peXobject pEx
00671   ){
00672 /*noverbatim
00673 CUT*/
00674    pNameSpaceStack p;
00675 
00676   if( pEx->pOldNameSpace )
00677     REPORT(LexemeFileName,LexemeLineNumber,EX_ERROR_UNFINISHED_MODULE,NULL);
00678   while( pEx->pOldNameSpace ){
00679     p = pEx->pOldNameSpace;
00680     pEx->pOldNameSpace = pEx->pOldNameSpace->next;
00681     alloc_Free(p->ThisNameSpace,pEx->pMemorySegment);
00682     alloc_Free(p,pEx->pMemorySegment);
00683     }
00684   }
00685 
00686 /*POD
00687 =H expression_PopNameSpace()
00688 
00689 When a T<module name> instruction is encountered the name space is modified. However
00690 the old name space should be reset when an T<end module> statement is reached. As the
00691 modules can be nested into each other the name spaces are stored in a name space stack
00692 during syntax analysis.
00693 
00694 This function pops the name space from the name space stack and copies the value to the
00695 T<pEx->>T<CurrentNameSpace> variable. This should be executed when a name space is closed
00696 and we want to return to the embedding name space.
00697 
00698 /*FUNCTION*/
00699 int expression_PopNameSpace(peXobject pEx
00700   ){
00701 /*noverbatim
00702 CUT*/
00703   pNameSpaceStack p;
00704 
00705   if( (p=pEx->pOldNameSpace) == NULL )return EX_ERROR_NO_OLD_NAMESPACE;
00706 
00707   pEx->pOldNameSpace = pEx->pOldNameSpace->next;
00708   strcpy(pEx->CurrentNameSpace,p->ThisNameSpace);
00709 
00710   alloc_Free(p->ThisNameSpace,pEx->pMemorySegment);
00711   alloc_Free(p,pEx->pMemorySegment);
00712   return EX_ERROR_SUCCESS;
00713   }
00714 
00715 /*POD
00716 =H ex_PushWaitingLabel()
00717 
00718 This function is used to define a label.
00719 
00720 /*FUNCTION*/
00721 int ex_PushWaitingLabel(peXobject pEx,
00722                          pSymbolLABEL pLbl
00723   ){
00724 /*noverbatim
00725 
00726 When a label is defined the T<eNode_l> that the label is going to belong still does not exists, and
00727 therefore the T<NodeId> of that T<eNode_l> is not known. This function together with R<ex_PopWaitingLabel()>
00728 maintains a stack that can store labels which are currently defined and still need a line to be assigned
00729 to them. These labels all point to the same line. Altough it is very rare that many labels point to
00730 the same line, it is possible. The number of labels that can point the same line is defined by the
00731 constant T<MAX_SAME_LABELS> defined in T<expression.c>
00732 
00733 To make it clear see the following BASIC code:
00734 
00735 =verbatim
00736 
00737 this_is_a_label:
00738 REM this is a comment
00739             PRINT "hello word!!"
00740 
00741 =noverbatim
00742 
00743 The label is defined on the first line of the example. However the label belongs to the
00744 third line containing the statement T<PRINT>. When the label is processed the compiler does
00745 not know the node number of the code segment which is generated from the third line. Therefore
00746 this function maintains a label-stack to store all labels that need a line. Whenever a line is
00747 compiled so that a label can be assigned to that very line the stack is emptied and all labels waiting on the
00748 stack are assigned to the line just built up. (Or the line is assigned to the labels if you
00749 like the sentence the other way around.)
00750 
00751 Note that not only labels given by a label defining statement are pushed on this stack, but also
00752 labels generated by commands like 'while/wend' of 'if/else/endif'.
00753 
00754 CUT*/
00755   if( pEx->cLabelsWaiting < MAX_SAME_LABELS ){
00756     pEx->LabelsWaiting[pEx->cLabelsWaiting++] = pLbl;
00757     return EX_ERROR_SUCCESS;
00758     }
00759   return EX_ERROR_TOO_MANY_WAITING_LABEL;
00760   }
00761 
00762 /*POD
00763 =H ex_PopWaitingLabel()
00764 
00765 This function is used to get a label out of the waiting-label-stack.
00766 
00767 /*FUNCTION*/
00768 pSymbolLABEL ex_PopWaitingLabel(peXobject pEx
00769   ){
00770 /*noverbatim
00771 
00772 To get some description of waiting labels see the description of the function R<ex_PushWaitingLabel()>.
00773 
00774 CUT*/
00775   if( pEx->cLabelsWaiting == 0 )return NULL;
00776   return pEx->LabelsWaiting[ -- (pEx->cLabelsWaiting) ];
00777   }
00778 
00779 /*POD
00780 =H _ex_PushLabel()
00781 
00782 This function is used to push an unnamed label on the compile time stack.
00783 For more detailed defintion of the unnamed labels and this stack see the
00784 documentation of the function R<ex_PopLabel()>.
00785 
00786 /*FUNCTION*/
00787 int _ex_PushLabel(peXobject pEx,
00788                   pSymbolLABEL pLbl,
00789                   long Type,
00790                   void *pMemorySegment
00791   ){
00792 /*noverbatim
00793 
00794 The argument T<Type> is used to define the type of the unnamed label. This is usually defined
00795 in the table created by the program T<syntaxer.pl>
00796 
00797 =bold
00798 Do NOT get confused! This stack is NOT the same as the waiting label stack. That is usually for named
00799 labels.
00800 =nobold
00801 
00802 However the non-named labels are also pushed on that stack before they get value.
00803 
00804 CUT*/
00805   pLabelStack p;
00806 
00807   if( pEx->pFreeComeAndGoStack == NULL ){
00808     pEx->pFreeComeAndGoStack = alloc_Alloc(sizeof(LabelStack),pMemorySegment);
00809     if( pEx->pFreeComeAndGoStack == NULL )return EX_ERROR_MEMORY_LOW;
00810     pEx->pFreeComeAndGoStack->Flink = NULL;
00811     }
00812   p = pEx->pFreeComeAndGoStack;
00813   pEx->pFreeComeAndGoStack = pEx->pFreeComeAndGoStack->Flink;
00814   p->Flink = pEx->pComeAndGoStack;
00815   p->Type = Type;
00816   pEx->pComeAndGoStack = p;
00817   p->pLabel = pLbl;  
00818   return 0;
00819   }
00820 
00821 /*POD
00822 =H _ex_PopLabel()
00823 
00824 This function is used to pop an unnamed label off the compile stack.
00825 
00826 When a construct, like T<IF/ELSE/ENDIF> or T<REPEAT/UNTIL> or T<WHILE/WEND> is created
00827 it is defined using compile time label stack.
00828 
00829 For example analyzing the instruction T<WHILE> pushes a "go forward" value on the compile time
00830 label stack. When the instruction T<WEND> is analyzed it pops off the value and stores
00831 T<NodeId> for the label. The label itself is not present in the global label symbol table,
00832 because it is an unnamed label and is referenced during compile time by the pointer to the
00833 label structure.
00834 
00835 The value of the T<AcceptedType> ensures that a T<WEND> for example do not matches an T<IF>.
00836 
00837 
00838 /*FUNCTION*/
00839 pSymbolLABEL _ex_PopLabel(peXobject pEx,
00840                           long *pAcceptedType
00841   ){
00842 /*noverbatim
00843 
00844 The array T<pAcceptedType> is an array of long values that have T<MAX_GO_CONSTANTS> values.
00845 This is usually points to a static table element which is generated by the program T<syntaxer.pl>.
00846 
00847 =bold
00848 Do NOT get confused! This stack is NOT the same as the waiting label stack. That is for named
00849 labels.
00850 =nobold
00851 CUT*/
00852   pLabelStack q;
00853   pSymbolLABEL p;
00854   int i = MAX_GO_CONSTANTS;
00855   long lTypeOnStack;
00856 
00857   if( pEx->pComeAndGoStack == NULL )return NULL;
00858   p = pEx->pComeAndGoStack->pLabel;
00859   lTypeOnStack = pEx->pComeAndGoStack->Type;
00860   pEx->pComeAndGoStack->pLabel = NULL; /* be safe */
00861   q = pEx->pComeAndGoStack->Flink;
00862   pEx->pComeAndGoStack->Flink = pEx->pFreeComeAndGoStack;
00863   pEx->pFreeComeAndGoStack = pEx->pComeAndGoStack;
00864   pEx->pComeAndGoStack = q;
00865 
00866   if( pAcceptedType ){ /* passing NULL means that we do not care the type (usually to clean up the stack) */
00867     while( i-- )
00868       if( *pAcceptedType++ == lTypeOnStack )return p;
00869     REPORT(LexemeFileName,LexemeLineNumber,EX_ERROR_BAD_NESTING,NULL);
00870     }
00871 
00872   return p;
00873   }
00874 
00875 /*POD
00876 =H _ex_CleanLabelStack()
00877 
00878 This function is used to clean the unnamed label stack whenever
00879 a locality is left. This helps to detect when an instruction like
00880 T<FOR> or T<WHILE> is not closed within a function.
00881 /*FUNCTION*/
00882 void _ex_CleanLabelStack(peXobject pEx
00883   ){
00884 /*noverbatim
00885 CUT*/
00886 
00887   if( ex_PopLabel(NULL) )
00888     REPORT(LexemeFileName,LexemeLineNumber,EX_ERROR_UNFINISHED_NESTING,NULL);
00889   while( ex_PopLabel(NULL) );
00890   }
00891 
00892 /*POD
00893 =H Some NOTE on SymbolXXX functions
00894 
00895 The functions named T<SymbolXXX> like T<SymbolLABEL>, or T<SymbolUF> do NOT store 
00896 the names of the symbols. They are named T<SymbolXXX> because they are natural
00897 extensions of the symbol table system. In other compilers the functionality to
00898 retrieve the arguments of a symbol is part of the symbol table handling routines.
00899 
00900 In script basic the symbol table handling routines were developed to be general purpose.
00901 Therefore all the arguments the symbol table functions bind toa symbol is a T<void *>
00902 pointer. This pointer points to a struct that holds the arguments of the symbols,
00903 and the functions T<SymbolXXX> allocate the storage for the arguments.
00904 
00905 This way it is possible to allocate arguments for non-existing symbols, as it is done
00906 for labels. Script basic uses non-named labels to arrange the "jump" instructions for
00907 T<IF/ELSE/ENDIF> constructs. (And for some other constructs as well.) The label and
00908 jump constructs look like:
00909 
00910 =verbatim
00911 
00912        IF expression Then
00913 
00914        ELSE
00915 label1:
00916 
00917 
00918        END IF
00919 label2:
00920 
00921 =noverbatim
00922 
00923 The labels T<label1> and T<label2> do not have names in the system, not even autogenerated names.
00924 They are referenced via pointers and their value (the T<NodeId> of the instruction) get into the
00925 T<SymbolLABEL> structure and later int o the T<cNODE> during build.
00926 
00927 CUT*/
00928 
00929 /*POD
00930 =H _new_SymbolLABEL()
00931 
00932 This function should be used to create a new label. The label can be named or unnamed. Note that
00933 this structure does NOT contain the name of the label.
00934 
00935 /*FUNCTION*/
00936 pSymbolLABEL _new_SymbolLABEL(peXobject pEx
00937   ){
00938 /*noverbatim
00939 
00940 Also note that all labels are global in a basic program and are subject to name space decoration.
00941 However the same named label can not be used in two different functions in the same name space.
00942 
00943 A label has a serial value, which is not actually used and a number of the node that it points to.
00944 
00945 See the comments on R<ex_symbols()>.
00946 CUT*/
00947   pSymbolLABEL p;
00948 
00949   p = (pSymbolLABEL)alloc_Alloc(sizeof(SymbolLABEL),pEx->pMemorySegment);
00950   if( p == NULL )return NULL;
00951   pEx->cGlobalLabels ++;
00952   p->Serial = pEx->cGlobalLabels;
00953   p->node = 0; /* this means that the struct has no value */
00954   return p;
00955   }
00956 
00957 /*POD
00958 =H _new_SymbolVAR()
00959 
00960 This function should be used to create a new variable during compile time. A
00961 variable is nothing else than a serial number. This serial number starts
00962 from 1.
00963 
00964 /*FUNCTION*/
00965 pSymbolVAR _new_SymbolVAR(peXobject pEx,
00966                           int iLocal
00967   ){
00968 /*noverbatim
00969 
00970 The second argument should be true for local variables. The counting of local
00971 variables are reset whenever the program enters a new locality. Localities can
00972 not be nested.
00973 
00974 Also note that local variables are allocated in a different segment because they
00975 are deallocated whenever the syntax analyzer leaves a locality.
00976 CUT*/
00977   pSymbolVAR p;
00978 
00979   if( iLocal ){
00980     p = (pSymbolVAR)alloc_Alloc(sizeof(SymbolVAR),pEx->pLocalVarMemorySegment);
00981     if( p == NULL )return NULL;
00982     pEx->cLocalVariables++;
00983     p->Serial = pEx->cLocalVariables;
00984     }else{
00985     p = (pSymbolVAR)alloc_Alloc(sizeof(SymbolVAR),pEx->pMemorySegment);
00986     if( p == NULL )return NULL;
00987     pEx->cGlobalVariables++;
00988     p->Serial = pEx->cGlobalVariables;
00989     }
00990 
00991   return p;
00992   }
00993 
00994 /*POD
00995 =H _new_SymbolUF()
00996 
00997 This function should be used to create a new user defined function symbol.
00998 /*FUNCTION*/
00999 pSymbolUF _new_SymbolUF(peXobject pEx
01000   ){
01001 /*noverbatim
01002 
01003 A user function is defined by its serial number (serial number is actually not used in the
01004 current sytsem) and by the node number where the function actually starts.
01005 
01006 The number of arguments and the number of local variables are defined in the generated
01007 command and not in the symbol table. This way these numbers are available as they should be
01008 during run time.
01009 CUT*/
01010   pSymbolUF p;
01011 
01012   p = (pSymbolUF)alloc_Alloc(sizeof(SymbolUF),pEx->pMemorySegment);
01013   if( p == NULL )return NULL;
01014 
01015   pEx->cUserFunctions ++;
01016   p->FunId = pEx->cUserFunctions;
01017   p->next = pEx->FirstUF;
01018   pEx->FirstUF = p;
01019   p->node = 0L;
01020 
01021   return p;
01022   }
01023 
01024 /*POD
01025 =H _new_eNODE()
01026 
01027 This function should be used to create a new T<eNODE>.
01028 
01029 /*FUNCTION*/
01030 peNODE _new_eNODE(peXobject pEx
01031   ){
01032 /*noverbatim
01033 
01034 Each T<eNODE> and T<eNODE_l> structure has a serial number. The T<eNODE>s
01035 are referencing each other using pointers. However after build these pointers
01036 become integer numbers that refer to the ordinal number of the node. Nodes are
01037 stored in a single memory block after they are packed during build.
01038 
01039 An T<eNODE> is a structure that stores a unit of compiled code. For example
01040 an addition in an expression is stored in an T<eNODE> containing the code for the
01041 addition operator and containing pointers to the operands.
01042 
01043 CUT*/
01044   peNODE p;
01045 
01046   p = (peNODE)alloc_Alloc(sizeof(eNODE),pEx->pMemorySegment);
01047   if( p == NULL )return NULL;
01048   pEx->NodeCounter ++;
01049   p->NodeId = pEx->NodeCounter;
01050   if( pEx->pLex->pLexCurrentLexeme ){
01051     p->szFileName = pEx->pLex->pLexCurrentLexeme->szFileName;
01052     p->lLineNumber = pEx->pLex->pLexCurrentLexeme->lLineNumber;
01053     }else{
01054     p->szFileName = NULL;
01055     p->lLineNumber = 0;
01056     }
01057 
01058   return p;
01059   }
01060 /*POD
01061 =H _new_eNODE_l()
01062 
01063 This function should be used to create a new T<eNODE> list. This is nothing else
01064 than a simple structure having two pointers. One pointer points to an T<eNODE>
01065 while the other points to the next T<eNODE_l> struct or to NULL if the current
01066 T<eNODE_l> is the last of a list.
01067 
01068 /*FUNCTION*/
01069 peNODE_l _new_eNODE_l(peXobject pEx,
01070                       char *pszFileName,
01071                       long lLineNumber
01072   ){
01073 /*noverbatim
01074 
01075 Note that T<eNODE> and T<eNODE_l> are converted to the same type of 
01076 structure during build after the syntactical analysis is done.
01077 CUT*/
01078   peNODE_l p;
01079 
01080   p = ((peNODE_l)alloc_Alloc(sizeof(eNODE_l),pEx->pMemorySegment));
01081   if( p == NULL )return NULL;
01082   pEx->NodeCounter ++;
01083   p->NodeId = pEx->NodeCounter;
01084   p->szFileName = NULL;
01085   p->lLineNumber = 0;
01086   if( pszFileName ){
01087     p->szFileName = pszFileName;
01088     p->lLineNumber = lLineNumber;
01089     }else
01090   if( pEx->pLex && pEx->pLex->pLexCurrentLexeme ){
01091     p->szFileName = pEx->pLex->pLexCurrentLexeme->szFileName;
01092     p->lLineNumber = pEx->pLex->pLexCurrentLexeme->lLineNumber;
01093     }
01094   /* initializing these pointers here makes life safer */
01095   p->rest = NULL;
01096   p->actualm = NULL;
01097 
01098   return p;
01099   }
01100 
01101 /*POD
01102 =H ex_free()
01103 
01104 This function releases all memory that was allocated during syntax analysis.
01105 
01106 /*FUNCTION*/
01107 void ex_free(peXobject pEx
01108   ){
01109 /*noverbatim
01110 CUT*/
01111 
01112   alloc_FinishSegment(pEx->pMemorySegment);
01113   alloc_FinishSegment(pEx->pLocalVarMemorySegment);
01114   alloc_FinishSegment(pEx->pSymbolTableMemorySegment);
01115   pEx->pMemorySegment = NULL;
01116   }
01117 
01118 /*POD
01119 =H ex_init()
01120 
01121 This function should be called before starting syntactical analysis. This
01122 function 
01123 =itemize
01124 =item positions the lexeme pointer to the first lexeme,
01125 =item initializes the memory segments needed for structured memory allocation, 
01126 =item created the symbol tables
01127 =item initializes 'class' variables
01128 =item initializes the name space to be T<main::>
01129 =noitemize
01130 
01131 /*FUNCTION*/
01132 int ex_init(peXobject pEx
01133   ){
01134 /*noverbatim
01135 CUT*/
01136   long i;
01137 
01138 
01139   lex_StartIteration(pEx->pLex);
01140 
01141   pEx->pMemorySegment
01142                       = alloc_InitSegment(pEx->memory_allocating_function,
01143                                           pEx->memory_releasing_function);
01144   if( pEx->pMemorySegment == NULL )return EX_ERROR_MEMORY_LOW;
01145 
01146   pEx->pSymbolTableMemorySegment
01147                       = alloc_InitSegment(pEx->memory_allocating_function,
01148                                           pEx->memory_releasing_function);
01149   if( pEx->pSymbolTableMemorySegment == NULL )return EX_ERROR_MEMORY_LOW;
01150 
01151   pEx->pLocalVarMemorySegment = alloc_InitSegment(pEx->memory_allocating_function,
01152                                           pEx->memory_releasing_function);
01153   if( pEx->pLocalVarMemorySegment == NULL )return EX_ERROR_MEMORY_LOW;
01154 
01155 
01156   pEx->GlobalVariables  = sym_NewSymbolTable(alloc_Alloc,pEx->pSymbolTableMemorySegment);
01157   pEx->GlobalLabels     = sym_NewSymbolTable(alloc_Alloc,pEx->pSymbolTableMemorySegment);
01158   pEx->GlobalConstants  = sym_NewSymbolTable(alloc_Alloc,pEx->pSymbolTableMemorySegment);
01159 
01160   if( pEx->GlobalVariables == NULL ||
01161       pEx->GlobalLabels == NULL ||
01162       pEx->GlobalConstants == NULL )return EX_ERROR_MEMORY_LOW;
01163 
01164   pEx->LocalVariables   = NULL; /* it is initialized when we go local */
01165   pEx->LocallyDeclaredGlobalVariables = NULL; /* it is initialized when we go local */
01166   pEx->UserFunctions    = sym_NewSymbolTable(alloc_Alloc,pEx->pSymbolTableMemorySegment);
01167   if( pEx->UserFunctions == NULL )return EX_ERROR_MEMORY_LOW;
01168 
01169   pEx->ThisFunction = NULL;
01170 
01171   pEx->NodeCounter = 0;
01172 
01173   /* no function is defined currently */
01174   pEx->pFunctionWaiting = NULL;
01175 
01176   /* no user functions are defined */
01177   pEx->FirstUF = NULL;
01178 
01179   /* there are no waiting come backs, nor waitiong go forwards */
01180   pEx->pComeAndGoStack = NULL;
01181   pEx->pFreeComeAndGoStack = NULL;
01182 
01183   /* we start with global variables and go to local when entering a user defined function */
01184   pEx->iWeAreLocal = 0;
01185   /* the default language feature is that globals need not be declared */
01186   pEx->iDeclareVars = 0;
01187   /* the default language feature is that undeclared variables are global */
01188   pEx->iDefaultLocal = 0;
01189 
01190   pEx->Buffer   = alloc_Alloc(pEx->cbBuffer*sizeof(char),pEx->pMemorySegment);
01191   pEx->CurrentNameSpace = alloc_Alloc(pEx->cbCurrentNameSpace*sizeof(char),pEx->pMemorySegment);
01192 
01193   if( !pEx->GlobalVariables  || 
01194       !pEx->UserFunctions    ||
01195       !pEx->BuiltInFunctions ||
01196       !pEx->GlobalLabels     ||
01197       !pEx->GlobalConstants  ||
01198       !pEx->Binaries         ||
01199       !pEx->CurrentNameSpace ||
01200     0
01201     ){
01202     ex_free(pEx);
01203     return EX_ERROR_MEMORY_LOW;
01204     }
01205 
01206   pEx->cGlobalLabels = 0;
01207   pEx->cGlobalVariables = 0;
01208   /* pEx->cLocalVariables  = 0; /* this is initialized when we go local */
01209   pEx->cUserFunctions   = 0;
01210 
01211   if( pEx->cbCurrentNameSpace < 7 ){
01212     ex_free(pEx);
01213     return EX_ERROR_TOO_LONG_NAME_SPACE;
01214     }
01215   strcpy(pEx->CurrentNameSpace,"main::");
01216   pEx->pOldNameSpace = NULL;
01217   pEx->cbStringTable = 0L;
01218 
01219   for( i=0 ; pEx->PredeclaredLongConstants[i].name ; i++ )
01220     ex_PredeclareGlobalLongConst(pEx,
01221                                  pEx->PredeclaredLongConstants[i].name,
01222                                  pEx->PredeclaredLongConstants[i].value);
01223 
01224   return EX_ERROR_SUCCESS;
01225 }
01226 
01227 /*POD
01228 =H ex_CleanNamePath()
01229 
01230 This function created a normalized name space name from a non normalized. This is a simple
01231 string operation.
01232 
01233 Think of name space as directories and variables as files. A simple variable name is in the
01234 current name space. If there is a 'path' before the variable or function name the path has to be
01235 used. This path can either be relative or absolute.
01236 
01237 File system:
01238 
01239 T< ../ > is used to denote the parent directory in file systems.
01240 
01241 Name space:
01242 
01243 T< _::> is used to denote the parent name space.
01244 
01245 File system:
01246 
01247 T< mydir/../yourdir> is the same as T<yourdir>
01248 
01249 Name space:
01250 
01251 T< myns::_::yourns> is the same as T<yourns>
01252 
01253 This function removes the unneccesary downs and ups from the name space and creates the
01254 result in the same buffer as the original. This can always be done as the result is always 
01255 shorter. (Well, not longer.)
01256 
01257 /*FUNCTION*/
01258 void ex_CleanNamePath(char *s
01259   ){
01260 /*noverbatim
01261 CUT*/
01262   int i,j;
01263   int f; /* flag if we have found something to remove */
01264 
01265   while(1){
01266     j = 0; f = 0;
01267     for( i=0 ; s[i] ; i++ ){
01268       if( s[i] == ':' && s[i+1] == ':' && s[i+2] == '_' && s[i+3] == ':' && s[i+4] == ':' ){
01269         f = 1; /* relative upreference, like package::_::v is found */
01270         i += 5;
01271         break;
01272         }
01273       if( s[i] == ':' && s[i+1] == ':' ){
01274         j = i+2;
01275         i ++;
01276         continue;
01277         }
01278       }
01279     if( !f )return;
01280     while( s[j]=s[i] )i++,j++;/* pull down the end, and ...*/
01281     /* start over */
01282     }
01283   }
01284 
01285 /*POD
01286 =H ex_ConvertName()
01287 
01288 Use this function to convert a relative name to absolute containing name space.
01289 
01290 This function checks if the variable or function name is relative or absolute. If the
01291 name is relative it creates the absolute name using the current name space as a base.
01292 
01293 The result is always put into the T<Buffer>.
01294 
01295 A name is relative if it does NOT contain T<::> at all (implicit relative),
01296 if it starts with T<::> or is it starts with T<_::> (explicit relative).
01297 
01298 /*FUNCTION*/
01299 int ex_ConvertName(char *s,          /* name to convert            */
01300                    char *Buffer,     /* buffer to store the result */
01301                    size_t cbBuffer,  /* size of the buffer         */
01302                    peXobject pEx     /* current expression object  */
01303   ){
01304 /*noverbatim
01305 
01306 The error value is T<EX_ERROR_SUCCESS> (zero) menaing succesful conversion or
01307 T<EX_ERROR_TOO_LONG_VARIABLE> meaning that the variable is too long for the
01308 buffer.
01309 
01310 Note that the buffer is allocated in R<ex_init()> according to the size value given in
01311 the class variable T<cbBuffer>, which should be set by the main function calling
01312 syntax analysis.
01313 CUT*/
01314   int i;
01315 
01316   /* This is a zero or one character variable,
01317      it can not contain :: and therefore
01318      it is relative variable.                  */
01319   if( !s[0] || !s[1] ){
01320     if( cbBuffer < strlen(pEx->CurrentNameSpace) + strlen(s) + 1 )
01321       return EX_ERROR_TOO_LONG_VARIABLE;
01322     strcpy(Buffer,pEx->CurrentNameSpace);
01323     strcat(Buffer,s);
01324     return EX_ERROR_SUCCESS;
01325     }
01326 
01327   /* This starts with :: like ::variable or ::subpackage::variable
01328      This is an explicit relative variable.  */
01329   if( s[0] == ':' && s[1] == ':' ){
01330     if( cbBuffer < strlen(pEx->CurrentNameSpace) + strlen(s) - 1 )
01331       return EX_ERROR_TOO_LONG_VARIABLE;
01332     strcpy(Buffer,pEx->CurrentNameSpace);
01333     strcat(Buffer,s+2); /* current_name_space contains the trailing ::
01334                            we should not copy it twice. */
01335     ex_CleanNamePath(Buffer);    /* remove the package::_ references */
01336     return EX_ERROR_SUCCESS;
01337     }
01338 
01339   /* This starts with _:: like _::variable or _::subpackage::variable
01340      This is an explicit relative variable.  */
01341   if( s[0] == '_' && s[1] == ':' && s[2] == ':' ){
01342     if( cbBuffer < strlen(pEx->CurrentNameSpace) + strlen(s) + 1 )
01343       return EX_ERROR_TOO_LONG_VARIABLE;
01344     strcpy(Buffer,pEx->CurrentNameSpace);
01345     strcat(Buffer,s);
01346     ex_CleanNamePath(Buffer);    /* remove the package::_ references */
01347     return EX_ERROR_SUCCESS;
01348     }
01349 
01350   /* This is long enough to contain ::, and does not start with ::  */
01351   for( i=1 ; s[i] ; i++ ){
01352     /* if it contains :: inside and not in front then it is an absolute
01353        reference. */
01354     if( s[i] == ':' && s[i+1] == ':' ){
01355       if( cbBuffer < strlen(pEx->CurrentNameSpace) + 1 )
01356         return EX_ERROR_TOO_LONG_VARIABLE;
01357       strcpy(Buffer,s);
01358       ex_CleanNamePath(Buffer); /* let the user to write dirty paths if she wishes*/
01359       return EX_ERROR_SUCCESS;
01360       }
01361     }
01362 
01363    /* Finally this is a simple implicit relative variable
01364       without any :: inside or in front. */
01365    if( cbBuffer < strlen(pEx->CurrentNameSpace) + strlen(s) + 1 )
01366      return EX_ERROR_TOO_LONG_VARIABLE;
01367    strcpy(Buffer,pEx->CurrentNameSpace);
01368    strcat(Buffer,s);
01369    return EX_ERROR_SUCCESS;
01370 }
01371 
01372 /*POD
01373 =H ex_IsBFun()
01374 
01375 This function checks if the current lexeme is a built-in function and
01376 returns pointer to the function in the table T<BuiltInFunctions> or
01377 returns NULL if the symbol is not a built-in function.
01378 
01379 /*FUNCTION*/
01380 pBFun ex_IsBFun(peXobject pEx
01381   ){
01382 /*noverbatim
01383 CUT*/
01384   pBFun p;
01385 
01386   if( LexemeType != LEX_T_NSYMBOL )return NULL;
01387   p = pEx->BuiltInFunctions;
01388 
01389   while( p->OpCode && (long)p->OpCode != LexemeCode )p++;
01390   if( p->OpCode )return p;
01391   return NULL;
01392   }
01393 
01394 /*POD
01395 =H ex_IsUnop()
01396 
01397 This function checks if the current lexeme is an unary operator and
01398 returns the op code or zero if the lexem is not an unary operator.
01399 
01400 /*FUNCTION*/
01401 unsigned long ex_IsUnop(peXobject pEx
01402   ){
01403 /*noverbatim
01404 CUT*/
01405   unsigned long *p;
01406 
01407   if( LexemeType != LEX_T_NSYMBOL && LexemeType != LEX_T_ASYMBOL )return 0;
01408   p = pEx->Unaries;
01409 
01410   while( *p && (long)*p != LexemeCode )p++;
01411   return *p;
01412   }
01413 
01414 /*POD
01415 =H ex_IsBinop()
01416 
01417 This function checks if the current lexeme is a binary operator of the given precedence
01418 and returns the op code or zero.
01419 
01420 /*FUNCTION*/
01421 unsigned long ex_IsBinop(peXobject pEx,
01422                unsigned long precedence
01423   ){
01424 /*noverbatim
01425 CUT*/
01426   unsigned long *p;
01427 
01428   if( LexemeType != LEX_T_NSYMBOL && LexemeType != LEX_T_ASYMBOL )return 0;
01429   p = pEx->Binaries;
01430 
01431   while( *p && *p != (unsigned)LexemeCode )p += 2;
01432   if( *p && p[1] == precedence )return *p;
01433   return 0;
01434   }
01435 
01436 
01437 /*POD
01438 =H ex_LeftValueList()
01439 
01440 This function works up a T<leftvalue_list> pseudo terminal and creates the nodes for it.
01441 
01442 /*FUNCTION*/
01443 peNODE_l ex_LeftValueList(peXobject pEx
01444   ){
01445 /*noverbatim
01446 CUT*/
01447   peNODE_l r;
01448   peNODE   q;
01449 
01450   q = ex_LeftValue(pEx);
01451   if( ! q )return NULL;
01452   r = new_eNODE_l();
01453   r->actualm = q;
01454   r->rest = NULL;
01455   if( LexemeType == LEX_T_CHARACTER && LexemeChar == ',' ){
01456     NextLexeme;
01457     r->rest = ex_LeftValueList(pEx);
01458     }
01459   return r;  
01460   }
01461 
01462 /*POD
01463 =H ex_ExpressionList()
01464 
01465 This function works up an T<expression_list> pseudo terminal and creates
01466 the nodes for it.
01467 /*FUNCTION*/
01468 peNODE_l ex_ExpressionList(peXobject pEx
01469   ){
01470 /*noverbatim
01471 CUT*/
01472   peNODE_l r;
01473   peNODE   q;
01474 
01475   q = ex_Expression_i(pEx,pEx->MAXPREC);
01476   if( ! q )return NULL;
01477   r = new_eNODE_l();
01478   r->actualm = q;
01479   r->rest = NULL;
01480   if( LexemeType == LEX_T_CHARACTER && LexemeChar == ',' ){
01481     NextLexeme;
01482     r->rest = ex_ExpressionList(pEx);
01483     if( r->rest == NULL )return NULL;
01484     }
01485   return r;  
01486   }
01487 
01488 /*POD
01489 =H ex_Local()
01490 
01491 This function work up a T<local> pseudo terminal. This does not create any node.
01492 
01493 /*FUNCTION*/
01494 int ex_Local(peXobject pEx
01495   ){
01496 /*noverbatim
01497 The return value is T<0> if no error happens.
01498 
01499 T<1> means sytax error (the coming token is not a symbol)
01500 
01501 T<2> means that there is no local environment (aka. the T<local var> is not inside a function)
01502 CUT*/
01503   void **pSymbol;
01504 
01505   if( LexemeType != LEX_T_ASYMBOL )return 1;
01506   ex_ConvertName(LexemeSymbol, pEx->Buffer,pEx->cbBuffer,pEx);
01507   if( WeAreNotLocal )return 2;
01508   pSymbol = sym_LookupSymbol(pEx->Buffer,        /* symbol we search */
01509                              pEx->LocallyDeclaredGlobalVariables,/* in this table */
01510                              0,                  /* do not insert the symbol as new */
01511                              alloc_Alloc,
01512                              alloc_Free,
01513                              pEx->pLocalVarMemorySegment);
01514   if( pSymbol )REPORT(LexemeFileName,LexemeLineNumber,EX_ERROR_GLODEF,pEx->Buffer);
01515   pSymbol = sym_LookupSymbol(pEx->Buffer,        /* symbol we search */
01516                              pEx->LocalVariables,/* in this table */
01517                              1,                  /* insert the symbol as new */
01518                              alloc_Alloc,
01519                              alloc_Free,
01520                              pEx->pLocalVarMemorySegment);
01521   /* if this variable was not declared yet as local then allocate a serial
01522      number for it and place to store the compile time information for it */
01523   if( *pSymbol == NULL )
01524     *pSymbol = (void *)new_SymbolVAR(LOCAL_VAR);
01525   NextLexeme;
01526   return 0;
01527   }
01528 
01529 /*POD
01530 =H ex_LocalList()
01531 
01532 This function work up a T<local_list> pseudo terminal. This does not generate any node.
01533 
01534 /*FUNCTION*/
01535 int ex_LocalList(peXobject pEx
01536   ){
01537 /*noverbatim
01538 The return value is T<0> if no error happens.
01539 
01540 T<1> means sytax error (the coming token is not a symbol)
01541 
01542 T<2> means that there is no local environment (aka. the T<local var> is not inside a function)
01543 CUT*/
01544   int iErr;
01545 
01546   iErr = ex_Local(pEx);
01547   if( iErr )return iErr;
01548   while( LexemeType == LEX_T_CHARACTER && LexemeChar == ',' ){
01549     NextLexeme;
01550     iErr = ex_Local(pEx);
01551     if( iErr )return iErr;
01552     }
01553   return 0;
01554   }
01555 
01556 
01557 
01558 
01559 /*POD
01560 =H ex_Global()
01561 
01562 This function work up a T<global> pseudo terminal. This does not create any node.
01563 
01564 /*FUNCTION*/
01565 int ex_Global(peXobject pEx
01566   ){
01567 /*noverbatim
01568 The return value is T<0> if no error happens or the error is semantic and was
01569 reported (global variable redefinition).
01570 
01571 T<1> means syntax error (the coming token is not a symbol)
01572 
01573 CUT*/
01574   void **pSymbol;
01575   void **plSymbol;
01576 
01577   if( LexemeType != LEX_T_ASYMBOL )return 1;
01578   ex_ConvertName(LexemeSymbol, pEx->Buffer,pEx->cbBuffer,pEx);
01579 
01580   /* when we are inside a sub or function (when we are local)
01581      GLOBAL only means that we want to use this global variable
01582      but it has to be declared before in global scope
01583    */
01584   if( WeAreLocal ){
01585     pSymbol = sym_LookupSymbol(pEx->Buffer,         /* symbol we search */
01586                               pEx->GlobalVariables,/* in this table */
01587                               0,
01588                               alloc_Alloc,
01589                               alloc_Free,
01590                               pEx->pMemorySegment);
01591     if( pSymbol == NULL ){
01592       if( DeclareVars )REPORT(LexemeFileName,LexemeLineNumber,EX_ERROR_UNDEF_GLOBAL,NULL);
01593       /* ok error was reported (or not) now declare the variable not to propagate the error */
01594       pSymbol = sym_LookupSymbol(pEx->Buffer,         /* symbol we search */
01595                                 pEx->GlobalVariables,/* in this table */
01596                                 1,                   /* insert the symbol as new */
01597                                 alloc_Alloc,
01598                                 alloc_Free,
01599                                 pEx->pMemorySegment);
01600       }
01601     plSymbol = sym_LookupSymbol(pEx->Buffer,
01602                                 pEx->LocalVariables,/* in this table */
01603                                 0,                   /* do not insert the symbol as new */
01604                                 alloc_Alloc,
01605                                 alloc_Free,
01606                                 pEx->pLocalVarMemorySegment);
01607     if( plSymbol ){/* this is declared as global, but it was already declared as local, confusing */
01608       REPORT(LexemeFileName,LexemeLineNumber,EX_ERROR_GLODEF,pEx->Buffer);
01609       NextLexeme;
01610       return 0;
01611       }
01612     /* now insert the symboil into this table so that we know that this global variable is in use in this subroutine */
01613     sym_LookupSymbol(pEx->Buffer,         /* symbol we search */
01614                       pEx->LocallyDeclaredGlobalVariables,/* in this table */
01615                       1,                   /* insert the symbol as new */
01616                       alloc_Alloc,
01617                       alloc_Free,
01618                       pEx->pLocalVarMemorySegment);
01619     }else{/* if WeAreNotLocal */
01620     pSymbol = sym_LookupSymbol(pEx->Buffer,        /* symbol we search         */
01621                               pEx->GlobalVariables,/* in this table            */
01622                               1,                   /* insert the symbol as new */
01623                               alloc_Alloc,
01624                               alloc_Free,
01625                               pEx->pMemorySegment);
01626     if( *pSymbol ){
01627       REPORT(LexemeFileName,LexemeLineNumber,EX_ERROR_GREDEF,pEx->Buffer);
01628       NextLexeme;
01629       return 0;
01630       }
01631     }
01632   *pSymbol = (void *)new_SymbolVAR(GLOBAL_VAR);
01633   NextLexeme;
01634   return 0;
01635   }
01636 
01637 /*POD
01638 =H ex_GlobalList()
01639 
01640 This function work up a T<global_list> pseudo terminal. This does not generate any node.
01641 
01642 /*FUNCTION*/
01643 int ex_GlobalList(peXobject pEx
01644   ){
01645 /*noverbatim
01646 The return value is T<0> if no error happens.
01647 
01648 T<1> means sytax error (the coming token is not a symbol)
01649 
01650 T<2> means the variable was already defined
01651 CUT*/
01652   int iErr;
01653 
01654   iErr = ex_Global(pEx);
01655   if( iErr )return iErr;
01656   while( LexemeType == LEX_T_CHARACTER && LexemeChar == ',' ){
01657     NextLexeme;
01658     iErr = ex_Global(pEx);
01659     if( iErr )return iErr;
01660     }
01661   return 0;
01662   }
01663 
01664 
01665 /*POD
01666 =H ex_LookupUserFunction()
01667 
01668 This function searches a user defined function and returns a pointer to the symbol table entry.
01669 If the second argument T<iInsert> is true the symbol is inserted into the table and an
01670 undefined function is created. This is the case when a function is used before declared. If the
01671 argument T<iInsert> is fales T<NULL> is returned if the function is not yet defined.
01672 
01673 /*FUNCTION*/
01674 void **ex_LookupUserFunction(peXobject pEx,
01675                              int iInsert
01676   ){
01677 /*noverbatim
01678 CUT*/
01679   void **pSymbol;
01680 
01681   pSymbol = sym_LookupSymbol(pEx->Buffer,
01682                              pEx->UserFunctions,
01683                              iInsert,
01684                              alloc_Alloc,
01685                              alloc_Free,
01686                              pEx->pSymbolTableMemorySegment);
01687 
01688   return pSymbol;
01689   }
01690 
01691 /*POD
01692 =H ex_LookupGlobalVariable
01693 
01694 This function searches the global variable symbol table to find the global variable
01695 with the name stored in T{pEx->Buffer}. If the variable was not declared then this function
01696 inserts the variable into the symbol table if the argument T<iInsert> is true,
01697 but nothing more: the symbol table entry remains T<NULL>.
01698 
01699 /*FUNCTION*/
01700 void **ex_LookupGlobalVariable(peXobject pEx,
01701                                int iInsert
01702   ){
01703 /*noverbatim
01704 The function returns pointer to the pointer stored in the symbol table associated with the global
01705 variable.
01706 CUT*/
01707   void **pSymbol;
01708 
01709   pSymbol = sym_LookupSymbol(pEx->Buffer,        /* the symbol we search */
01710                              pEx->GlobalVariables,/* in the global table */
01711                              iInsert,                   /* insert automatically as new if not found */
01712                              alloc_Alloc,
01713                              alloc_Free,
01714                              pEx->pSymbolTableMemorySegment);
01715   return pSymbol;
01716   }
01717 
01718 /*POD
01719 =H ex_LookupLocallyDeclaredGlobalVariable
01720 
01721 This function searches the global variable symbol table to find the global variable
01722 with the name stored in T{pEx->Buffer}. If the variable was not declared then this function
01723 return T<NULL>. Othervise it returns a pointer to a T<void *> pointer, which is 
01724 T<NULL>.
01725 
01726 Note that this table is allocated when the program starts a T<sub> or T<function> (aka. when
01727 we go local) and is used to register, which variables did the program declare
01728 as global variables inside the subroutine. There is no any value associated with the symbols
01729 in this table, as the symbols are also inserted into the global symbol table which serves
01730 the purpose.
01731 
01732 /*FUNCTION*/
01733 void **ex_LookupLocallyDeclaredGlobalVariable(peXobject pEx
01734   ){
01735 /*noverbatim
01736 The function returns pointer to the pointer stored in the symbol table associated with the global
01737 variable or T<NULL>.
01738 CUT*/
01739   void **pSymbol;
01740 
01741   pSymbol = sym_LookupSymbol(pEx->Buffer,        /* the symbol we search */
01742                              pEx->LocallyDeclaredGlobalVariables,/* in the global table */
01743                              0,                   /* do not insert!  */
01744                              alloc_Alloc,
01745                              alloc_Free,
01746                              pEx->pLocalVarMemorySegment);
01747   return pSymbol;
01748   }
01749 
01750 /*POD
01751 =H ex_LookupLocalVariable
01752 
01753 This function searches the local variable symbol table to find the local variable
01754 with the name stored in T{pEx->Buffer}. If the variable was not declared and the argument T<iInsert>
01755 is true then then this function inserts the variable into the symbol table, 
01756 but nothing more: the symbol table entry remains
01757 T<NULL>.
01758 
01759 /*FUNCTION*/
01760 void **ex_LookupLocalVariable(peXobject pEx,
01761                               int iInsert
01762   ){
01763 /*noverbatim
01764 The function returns pointer to the pointer stored in the symbol table associated with the global
01765 variable.
01766 CUT*/
01767   void **pSymbol;
01768 
01769   pSymbol = sym_LookupSymbol(pEx->Buffer,        /* the symbol we search */
01770                              pEx->LocalVariables,/* in the actual local table */
01771                              iInsert,                   /* insert automatically as new if not found */
01772                              alloc_Alloc,
01773                              alloc_Free,
01774                              pEx->pLocalVarMemorySegment);
01775   return pSymbol;
01776   }
01777 
01778 /*POD
01779 =H ex_Tag
01780 
01781 This function implements the syntax analysis for the lowest syntax elements of an expression.
01782 This function is called when syntax analysis believes that a TAG has to be worked up
01783 in an expression. A tag is defined formally as
01784 
01785 =verbatim
01786  tag ::= UNOP tag
01787          BUN '(' expression_list ')'
01788          NUMBER
01789          STRING
01790          '(' expression ')'
01791          VARIABLE { '[' expression_list ']' }
01792          VARIABLE '{' expression_list '}'
01793          FUNC '(' expression_list ')'
01794         .
01795 =noverbatim
01796 
01797 /*FUNCTION*/
01798 peNODE ex_Tag(peXobject pEx
01799   ){
01800 /*noverbatim
01801 The function returns pointer to the new node.
01802 CUT*/
01803 
01804 /*
01805 Hey!!! Unary operators do not have precedence! They are above all! Is this
01806 your original intention, or did it just came out like this?!!
01807 */
01808   peNODE q,r;
01809   peNODE_l z;
01810   long OpCode;
01811   char *s,*pszFN;
01812   int is_local;
01813   int is_assoc; /* the array reference we are currently analize is associative */
01814   long arg_count;
01815   void **pSymbol;
01816   pBFun pFunction;
01817   pLexeme pConstantLexeme;
01818 
01819   /* BUN '(' expression_list ')' */
01820   if( pFunction = ex_IsBFun(pEx) ){
01821     q = new_eNODE();
01822     if( q == NULL )return NULL;
01823     q->OpCode = LexemeCode;
01824     NextLexeme;
01825     if( LexemeType == LEX_T_CHARACTER && LexemeChar == '('  ){
01826       NextLexeme;
01827       if( LexemeType == LEX_T_CHARACTER && LexemeChar == ')' ){
01828         NextLexeme;
01829         goto no_arguments; /* Sorry for the construct, I know this is dirty. */
01830         }
01831       q->Parameter.Arguments.Argument = ex_ExpressionList(pEx);
01832       if( LexemeType != LEX_T_CHARACTER || LexemeChar != ')' ){/* the closing ) is missing after function call */
01833         REPORT(LexemeFileName,LexemeLineNumber,EX_ERROR_MISSING_PAREN,NULL);
01834         }else{ NextLexeme; }
01835       /* go and check the number of arguments */
01836       z = q->Parameter.Arguments.Argument;
01837       arg_count = 0;
01838       while( z ){
01839         z = z->rest;
01840         arg_count++;
01841         }
01842       if( arg_count < pFunction->MinArgs )REPORT(LexemeFileName,LexemeLineNumber,EX_ERROR_TOO_FEW_ARGUMENTS,NULL);
01843       if( arg_count > pFunction->MaxArgs )REPORT(LexemeFileName,LexemeLineNumber,EX_ERROR_TOO_MANY_ARGUMENTS,NULL);
01844       return q;
01845       }else{/* if there is no '(' after the name of the built in function */
01846 no_arguments:
01847       q->Parameter.Arguments.Argument = NULL;
01848       /* having a function call w/o () is OK if there is no need for arguments */
01849       if( pFunction->MinArgs == 0 )return q;
01850       REPORT(LexemeFileName,LexemeLineNumber,EX_ERROR_FUNCTION_NEEDS_ARGUMENTS,NULL);
01851       return q;
01852       }
01853     }
01854 
01855   /* UNOP tag */
01856   if( OpCode = ex_IsUnop(pEx) ){
01857     q = new_eNODE();
01858     if( q == NULL )return NULL;
01859     q->OpCode = OpCode;
01860     NextLexeme;
01861     q->Parameter.Arguments.Argument = new_eNODE_l();
01862     if( q->Parameter.Arguments.Argument == NULL ){
01863       alloc_Free(q,pEx->pMemorySegment);
01864       return NULL;
01865       }
01866     q->Parameter.Arguments.Argument->actualm = ex_Tag(pEx);
01867     q->Parameter.Arguments.Argument->rest = NULL;
01868     return q;
01869     }
01870 
01871   /* '(' expression ')' */
01872   if( LexemeType == LEX_T_CHARACTER && LexemeChar == '('  ){
01873     NextLexeme;
01874     q = ex_Expression_i(pEx,pEx->MAXPREC);
01875     if( LexemeType != LEX_T_CHARACTER || LexemeChar != ')' ){
01876       REPORT(LexemeFileName,LexemeLineNumber,EX_ERROR_MISSING_PAREN,NULL);
01877       }else{
01878       NextLexeme;
01879       }
01880     return q;
01881     }
01882 
01883   /* check declared constant, like
01884 
01885      const MyConstant = 1
01886                                        */
01887   /*--
01888      This piece of code checks if the current symbol is declared as local or global constant.
01889      First local constants are checked and then global constant. Locality and globality is done
01890      the same way as for labels.
01891 
01892      If a symbol is not a defined constant is_const remains zero and nothing happens, life goes on
01893      normal.
01894 
01895      If a symbol is a constant then the variable pConstantLexeme will
01896      point to the lexeme of the constant.
01897    */
01898   pConstantLexeme = NULL ;
01899   if( LexemeType == LEX_T_ASYMBOL ){
01900     if( ex_ConvertName(LexemeSymbol, pEx->Buffer,pEx->cbBuffer,pEx) )goto ConstFinish;
01901     strcat(pEx->Buffer,"'");
01902     if( pEx->ThisFunction ){
01903       if( strlen(pEx->Buffer) + strlen(pEx->ThisFunction->FunctionName) >= pEx->cbBuffer )
01904         goto ConstFinish;
01905       strcat(pEx->Buffer,pEx->ThisFunction->FunctionName );
01906       pSymbol = sym_LookupSymbol(pEx->Buffer, /* the symbol we search */
01907                                  pEx->GlobalConstants, /* in this table */
01908                                  0,                 /* do not insert the symbol as new */
01909                                  alloc_Alloc,
01910                                  alloc_Free,
01911                                  pEx->pSymbolTableMemorySegment);
01912       if( pSymbol ){
01913         pConstantLexeme = (pLexeme)*pSymbol;
01914         goto ConstFinish;
01915         }
01916       }
01917     /* we get here if this is not a local constant */
01918     for( s=pEx->Buffer ; *s && *s != '\'' ; s++ );
01919     if( *s )s++;
01920     if( *s )*s = (char)0; /* cut off the function name, try the global const if there is */
01921     pSymbol = sym_LookupSymbol(pEx->Buffer, /* the symbol we search */
01922                                pEx->GlobalConstants, /* in this table */
01923                                0,                 /* do not insert the symbol as new */
01924                                alloc_Alloc,
01925                                alloc_Free,
01926                                pEx->pSymbolTableMemorySegment);
01927     if( pSymbol ){
01928       pConstantLexeme = (pLexeme)*pSymbol;
01929       goto ConstFinish;
01930       }
01931     /* we get here if this is not a local symbol and is not module symbol try a global one */
01932     pSymbol = sym_LookupSymbol(LexemeSymbol, /* the symbol we search */
01933                                pEx->GlobalConstants, /* in this table */
01934                                0,                 /* do not insert the symbol as new */
01935                                alloc_Alloc,
01936                                alloc_Free,
01937                                pEx->pSymbolTableMemorySegment);
01938     if( pSymbol ){
01939       pConstantLexeme = (pLexeme)*pSymbol;
01940       goto ConstFinish;
01941       }
01942     }
01943 ConstFinish:
01944 
01945   /* number or string */
01946   if( LexemeType == LEX_T_DOUBLE ||
01947       LexemeType == LEX_T_LONG   ||
01948       LexemeType == LEX_T_STRING ||
01949       pConstantLexeme
01950      ){
01951 
01952     if( pConstantLexeme == NULL )
01953       pConstantLexeme = pEx->pLex->pLexCurrentLexeme;
01954 
01955     q = new_eNODE();
01956     if( q == NULL )return NULL;
01957     switch( pConstantLexeme->type ){
01958       case LEX_T_DOUBLE:
01959         q->OpCode = eNTYPE_DBL;
01960         q->Parameter.Constant.Value.dValue = pConstantLexeme->value.dValue;
01961         break;
01962       case LEX_T_LONG:
01963         q->OpCode = eNTYPE_LNG;
01964         q->Parameter.Constant.Value.lValue = pConstantLexeme->value.lValue;
01965         break;
01966       case LEX_T_STRING: 
01967         q->OpCode = eNTYPE_STR;
01968         s = (char *)alloc_Alloc((pConstantLexeme->sLen+1)*sizeof(char),pEx->pMemorySegment);
01969         if( s == NULL ){
01970           alloc_Free(q,pEx->pMemorySegment);
01971           return NULL;
01972           }
01973         memcpy(s,pConstantLexeme->value.sValue,pConstantLexeme->sLen+1);
01974         pEx->cbStringTable += pConstantLexeme->sLen+1;
01975         COUNT_STRING_LEN
01976         q->Parameter.Constant.Value.sValue = s;
01977         q->Parameter.Constant.sLen = pConstantLexeme->sLen;
01978         break;
01979       default:
01980         REPORT(LexemeFileName,LexemeLineNumber,EX_ERROR_INTERNAL,NULL);
01981         break;
01982         }
01983     NextLexeme;
01984     return q;
01985     }
01986 
01987   /* variable or variable [ '[' expression_list ']' ]  or func '(' expression_list ')' */
01988    if( LexemeType == LEX_T_ASYMBOL ){
01989     q = new_eNODE();
01990     if( q == NULL )return NULL;
01991     ex_ConvertName(pszFN=LexemeSymbol, pEx->Buffer,pEx->cbBuffer,pEx);
01992 
01993     NextLexeme;
01994     if( LexemeType == LEX_T_CHARACTER && LexemeChar == '(' ){/* this is user function */
01995       pSymbol = ex_LookupUserFunction(pEx,1);
01996       if( *pSymbol == NULL ){
01997         /* This function has not been defined. */
01998         *pSymbol = (void *)new_SymbolUF();
01999         if( *pSymbol == NULL )return NULL;
02000         ((pSymbolUF)*pSymbol)->FunctionName = pszFN;
02001         }
02002       q->OpCode = eNTYPE_FUN;
02003       q->Parameter.UserFunction.pFunction = (pSymbolUF)(*pSymbol);
02004       NextLexeme;
02005       if( LexemeType == LEX_T_CHARACTER && LexemeChar == ')' ){
02006         /* empty parameter list */
02007         q->Parameter.UserFunction.Argument = NULL;
02008         NextLexeme;
02009         }else{
02010         q->Parameter.UserFunction.Argument = ex_ExpressionList(pEx);
02011         if( LexemeType != LEX_T_CHARACTER || LexemeChar != ')' ){/* the closing ) is missing after function call */
02012           REPORT(LexemeFileName,LexemeLineNumber,EX_ERROR_MISSING_PAREN,NULL);
02013           }else{ NextLexeme; }
02014         }
02015       return q;
02016       }
02017     if( LexemeType == LEX_T_CHARACTER && (LexemeChar == '[' || LexemeChar == '{') ){/* this is some array access */
02018       if( LexemeChar == '[' )is_assoc = 0; else is_assoc = 1;
02019       NextLexeme;
02020       q->OpCode = is_assoc ? eNTYPE_SAR : eNTYPE_ARR;
02021       if( WeAreNotLocal || (pSymbol = ex_LookupLocalVariable(pEx,0)) == NULL ){
02022         if( WeAreLocal && DefaultLocal && ex_LookupLocallyDeclaredGlobalVariable(pEx) == NULL ){
02023           pSymbol = ex_LookupLocalVariable(pEx,1);
02024           is_local = 1; 
02025           }else{
02026           pSymbol = ex_LookupGlobalVariable(pEx,1);
02027           is_local = 0; 
02028           }
02029         }else is_local = 1;
02030 
02031       if( *pSymbol == NULL ){/* this is a new variable symbol */
02032         if( DeclareVars )REPORT(LexemeFileName,LexemeLineNumber,EX_ERROR_UNDEF_GLOBAL,NULL);
02033       if( DefaultLocal && is_local )
02034           *pSymbol = (void *)new_SymbolVAR(LOCAL_VAR);
02035         else
02036           *pSymbol = (void *)new_SymbolVAR(GLOBAL_VAR);
02037         if( *pSymbol == NULL )return NULL;
02038         }else{/* this is an existing symbol */
02039         if( DeclareVars && DefaultLocal && is_local && ex_LookupLocallyDeclaredGlobalVariable(pEx) == NULL && ex_LookupLocalVariable(pEx,0) == NULL)
02040           REPORT(LexemeFileName,LexemeLineNumber,EX_ERROR_UNDEF_GLOBAL,NULL);
02041         }
02042       /* the first argument is the variable */
02043       q->Parameter.Arguments.Argument = new_eNODE_l();
02044       if( q->Parameter.Arguments.Argument == NULL )return NULL;
02045       q->Parameter.Arguments.Argument->actualm = new_eNODE();
02046       if( q->Parameter.Arguments.Argument->actualm == NULL )return NULL;
02047       q->Parameter.Arguments.Argument->actualm->Parameter.Variable.Serial = ((pSymbolVAR)(*pSymbol))->Serial;
02048       q->Parameter.Arguments.Argument->actualm->OpCode = is_local ? eNTYPE_LVR : eNTYPE_GVR;
02049       /* the rest of the arguments are the indices */
02050       q->Parameter.Arguments.Argument->rest = ex_ExpressionList(pEx);
02051       if( is_assoc )
02052         if( LexemeType != LEX_T_CHARACTER || LexemeChar != '}' ){/* the closing } is missing after array indexes */
02053           REPORT(LexemeFileName,LexemeLineNumber,EX_ERROR_MISSING_SAPAREN,NULL);
02054           }else{ NextLexeme; }
02055       else
02056         if( LexemeType != LEX_T_CHARACTER || LexemeChar != ']' ){/* the closing ] is missing after array indexes */
02057           REPORT(LexemeFileName,LexemeLineNumber,EX_ERROR_MISSING_APAREN,NULL);
02058           }else{ NextLexeme; }
02059       /* now process the additional indices, like a[13]{"alma"}[5] */
02060       while( LexemeType == LEX_T_CHARACTER && (LexemeChar == '[' || LexemeChar == '{') ){
02061         if( LexemeChar == '[' )is_assoc = 0; else is_assoc = 1;
02062         NextLexeme;
02063         r = q;
02064         q = new_eNODE();
02065         if( q == NULL )return NULL;
02066         q->OpCode = is_assoc ? eNTYPE_SAR : eNTYPE_ARR;
02067         q->Parameter.Arguments.Argument = new_eNODE_l();
02068         if( q->Parameter.Arguments.Argument == NULL )return NULL;
02069         /* The first element of the list is the array up to here, the rest is the actual index list. */
02070         q->Parameter.Arguments.Argument->actualm = r;
02071         /* the rest of the arguments are the indices */
02072         q->Parameter.Arguments.Argument->rest = ex_ExpressionList(pEx);
02073         if( is_assoc )
02074           if( LexemeType != LEX_T_CHARACTER || LexemeChar != '}' ){/* the closing } is missing after array indexes */
02075             REPORT(LexemeFileName,LexemeLineNumber,EX_ERROR_MISSING_SAPAREN,NULL);
02076             }else{ NextLexeme; }
02077         else
02078           if( LexemeType != LEX_T_CHARACTER || LexemeChar != ']' ){/* the closing ] is missing after array indexes */
02079             REPORT(LexemeFileName,LexemeLineNumber,EX_ERROR_MISSING_APAREN,NULL);
02080             }else{ NextLexeme; }
02081         }
02082       return q;
02083       }
02084 
02085     /* this is a simple variable */
02086     if( WeAreNotLocal || (pSymbol = ex_LookupLocalVariable(pEx,0)) == NULL ){
02087       if( WeAreLocal && DefaultLocal && ex_LookupLocallyDeclaredGlobalVariable(pEx) == NULL ){
02088         /* if we are local, the variable is not 
02089            declared and by default all undeclared variables are local */
02090         pSymbol = ex_LookupLocalVariable(pEx,1);
02091         is_local = 1;
02092         }else{
02093         /* if we are global or undeclared variables are global */
02094         pSymbol = ex_LookupGlobalVariable(pEx,1);
02095         is_local = 0;
02096         }
02097       }else is_local = 1;
02098     if( *pSymbol == NULL ){/* this is a new variable symbol */
02099       if( DeclareVars )REPORT(LexemeFileName,LexemeLineNumber,EX_ERROR_UNDEF_GLOBAL,NULL);
02100     if( DefaultLocal && is_local )
02101         *pSymbol = (void *)new_SymbolVAR(LOCAL_VAR);
02102       else
02103         *pSymbol = (void *)new_SymbolVAR(GLOBAL_VAR);
02104       if( *pSymbol == NULL )return NULL;
02105       }else{/* this is an existing symbol */
02106       if( DeclareVars && DefaultLocal && is_local && ex_LookupLocallyDeclaredGlobalVariable(pEx) == NULL && ex_LookupLocalVariable(pEx,0) == NULL)
02107         REPORT(LexemeFileName,LexemeLineNumber,EX_ERROR_UNDEF_GLOBAL,NULL);
02108       }
02109     q->OpCode = is_local ? eNTYPE_LVR : eNTYPE_GVR;
02110     q->Parameter.Variable.Serial = ((pSymbolVAR)(*pSymbol))->Serial;
02111     return q;
02112     }
02113    return NULL;
02114 }
02115 
02116 /*POD
02117 =H ex_Expression_i
02118 
02119 This function is called to analyze a sub-expression that has no lower precedence operators
02120 than T<i> (unless enclosed in parentheses inside the sub expression).
02121 
02122 If the argument variable T<i> is T<1> then this function simply calls R<ex_Tag>. Otherwise it
02123 calls itself recursively twice with optionally compiling the operator between the 
02124 two subexpressions.
02125 
02126 /*FUNCTION*/
02127 peNODE ex_Expression_i(peXobject pEx,
02128                        int i
02129   ){
02130 /*noverbatim
02131 The function returns pointer to the new node.
02132 CUT*/
02133   peNODE fo; /* first operand */
02134   peNODE q;
02135   int iOperation;
02136 
02137   if( i == 1 )return ex_Tag(pEx);
02138 
02139   fo = ex_Expression_i(pEx,i-1); /* first operand */
02140   if( fo == NULL )return NULL;
02141   while( iOperation = ex_IsBinop(pEx,i-1) ){
02142     q = new_eNODE();
02143     if( q == NULL )return NULL;
02144     q->OpCode = iOperation;
02145     q->Parameter.Arguments.Argument = new_eNODE_l();
02146     if( q->Parameter.Arguments.Argument == NULL )return NULL;
02147     q->Parameter.Arguments.Argument->actualm = fo;
02148     q->Parameter.Arguments.Argument->rest = new_eNODE_l();
02149     if( q->Parameter.Arguments.Argument->rest == NULL )return NULL;
02150     NextLexeme;
02151     q->Parameter.Arguments.Argument->rest->actualm = ex_Expression_i(pEx,i-1);
02152     /*this was inserted for v1.0b20 to report error on expression having no right argument for an op, like
02153       if a= then 
02154     */
02155     if( q->Parameter.Arguments.Argument->rest->actualm == NULL )return NULL;
02156     fo = q;
02157     }
02158   return fo;
02159 }
02160 
02161 /*POD
02162 =H ex_Expression_r
02163 
02164 This function implements the syntax analysis for an expression. This is quite simple. It only
02165 calls R<ex_Expression_i> to handle the lower precendece expression. 
02166 /*FUNCTION*/
02167 void ex_Expression_r(peXobject pEx,
02168                      peNODE *Result
02169   ){
02170 /*noverbatim
02171 CUT*/
02172   *Result = ex_Expression_i(pEx,pEx->MAXPREC);
02173   }
02174 
02175 /*POD
02176 =H ex_IsSymbolValidLval(pEx)
02177 
02178 This function checks whether the actual symbol used in as a start symbol of a left value
02179 is defined as a CONST in the BASIC program or not. If this is a const then the syntax analizer
02180 has to report an error (since v1.0b31).
02181 
02182 This function is called from the function R<ex_LeftValue> after the symbol was name space corrected.
02183 
02184 Note that a symbol can be a global, name space independant constant, a name space local constant and
02185 a function local constant. All these differ only in name decoration inside the interpreter.
02186 
02187 If a symbol is a local variable but is also a module or global symbol, but is NOT a function local symbol
02188 then that variable can indeed stand on the left side of a LET command. Therefore we check if the symbol
02189 is in the local variables table and in case this is in some of the global or module contant table,
02190 we just do not care.
02191 /*FUNCTION*/
02192 int ex_IsSymbolValidLval(peXobject pEx
02193   ){
02194 /*noverbatim
02195 The function returns 1 if the symbol is a constant or zero if not.
02196 CUT*/
02197   void **pSymbol;
02198   char *s;
02199   char *fs;
02200   int isLocalVar;
02201 
02202   fs = pEx->Buffer + strlen(pEx->Buffer);
02203   if( pEx->iWeAreLocal && pEx->ThisFunction ){
02204     pSymbol = sym_LookupSymbol(pEx->Buffer,        /* symbol we search */
02205                                pEx->LocalVariables,/* in this table */
02206                                0,                  /* dont insert if this is not a local symbol */
02207                                alloc_Alloc,
02208                                alloc_Free,
02209                                pEx->pLocalVarMemorySegment);
02210     isLocalVar = NULL != pSymbol; /* this may be a local variable if it is in the symbol table,
02211                                      thoug let's check if this is a local constant */
02212     }else isLocalVar = 0; /* can not be a local variable in a global environment */
02213 
02214   strcpy(fs,"'");
02215   if( pEx->iWeAreLocal && pEx->ThisFunction ){
02216     if( strlen(pEx->Buffer) + strlen(pEx->ThisFunction->FunctionName) >= pEx->cbBuffer )
02217       return 0;
02218     strcat(pEx->Buffer,pEx->ThisFunction->FunctionName );
02219     pSymbol = sym_LookupSymbol(pEx->Buffer, /* the symbol we search */
02220                                 pEx->GlobalConstants, /* in this table */
02221                                 0,                 /* do not insert the symbol as new */
02222                                 alloc_Alloc,
02223                                 alloc_Free,
02224                                 pEx->pSymbolTableMemorySegment);
02225     if( pSymbol && *pSymbol )return 1; /* this is a local constant */
02226     }
02227 
02228   /* If this is a local var then no further checks are needed. This is a local variable and that is it. */
02229   if( isLocalVar ){
02230     /* restore the symbol name cutting off all that has been appended, the ' and the function name */
02231     *fs = (char)0;
02232     return 0;/* this is not a const, this is a valid lval symbol */
02233     }
02234 
02235   /* we get here if this is not a function local constant nor a declared local variable */
02236   s = fs + 1 ;
02237   if( *s )*s = (char)0; /* cut off the function name, try the global const if there is */
02238   pSymbol = sym_LookupSymbol(pEx->Buffer, /* the symbol we search */
02239                              pEx->GlobalConstants, /* in this table */
02240                              0,                 /* do not insert the symbol as new */
02241                              alloc_Alloc,
02242                              alloc_Free,
02243                              pEx->pSymbolTableMemorySegment);
02244   if( pSymbol && *pSymbol )return 1;/* this is a module symbol */
02245 
02246   /* we get here if this is not a local symbol and is not module symbol try a global one */
02247   pSymbol = sym_LookupSymbol(LexemeSymbol, /* the symbol we search */
02248                               pEx->GlobalConstants, /* in this table */
02249                               0,                 /* do not insert the symbol as new */
02250                               alloc_Alloc,
02251                               alloc_Free,
02252                               pEx->pSymbolTableMemorySegment);
02253   if( pSymbol && *pSymbol )return 1;
02254 
02255   /* restore the symbol name cutting off all that has been appended */
02256   *fs = (char)0;
02257   /* give it up, this is not a const... */
02258   return 0;
02259   }
02260 
02261 /*POD
02262 =H ex_LeftValue
02263 
02264 This function implements the syntax analisys for a left value.
02265 
02266 /*FUNCTION*/
02267 peNODE ex_LeftValue(peXobject pEx
02268   ){
02269 /*noverbatim
02270 The function returns pointer to the new node.
02271 CUT*/
02272   peNODE q,r;
02273   int is_local;
02274   int is_assoc; /* is the array reference associative? */
02275   void **pSymbol;
02276 
02277   if( LexemeType != LEX_T_ASYMBOL )return NULL;
02278   ex_ConvertName(LexemeSymbol, pEx->Buffer,pEx->cbBuffer,pEx);
02279   if( ex_IsSymbolValidLval(pEx) )REPORT(LexemeFileName,LexemeLineNumber,EX_ERROR_CONST_LVAL,NULL);
02280 
02281   NextLexeme;
02282   if( LexemeType == LEX_T_CHARACTER && (LexemeChar == '[' || LexemeChar == '{') ){
02283     if( LexemeChar == '{' )is_assoc = 1; else is_assoc = 0;
02284     NextLexeme;
02285     q = new_eNODE();
02286     if( q == NULL )return NULL;
02287     q->OpCode = is_assoc ? eNTYPE_SAR : eNTYPE_ARR;
02288     if( WeAreNotLocal || (pSymbol = ex_LookupLocalVariable(pEx,0)) == NULL ){
02289       if( WeAreLocal && DefaultLocal && ex_LookupLocallyDeclaredGlobalVariable(pEx) == NULL ){
02290         pSymbol = ex_LookupLocalVariable(pEx,1);
02291         is_local = 1; 
02292         }else{
02293         pSymbol = ex_LookupGlobalVariable(pEx,1);
02294         is_local = 0; 
02295         }
02296       }else is_local = 1;
02297 
02298     if( *pSymbol == NULL ){/* this is a new variable symbol */
02299       if( DeclareVars )REPORT(LexemeFileName,LexemeLineNumber,EX_ERROR_UNDEF_GLOBAL,NULL);
02300     if( DefaultLocal && is_local )
02301         *pSymbol = (void *)new_SymbolVAR(LOCAL_VAR);
02302       else
02303         *pSymbol = (void *)new_SymbolVAR(GLOBAL_VAR);
02304       if( *pSymbol == NULL )return NULL;
02305       }else{/* this is an existing symbol */
02306       if( DeclareVars && DefaultLocal && is_local && ex_LookupLocallyDeclaredGlobalVariable(pEx) == NULL && ex_LookupLocalVariable(pEx,0) == NULL)
02307         REPORT(LexemeFileName,LexemeLineNumber,EX_ERROR_UNDEF_GLOBAL,NULL);
02308       }
02309     /* the first argument is the variable */
02310     q->Parameter.Arguments.Argument = new_eNODE_l();
02311     if( q->Parameter.Arguments.Argument == NULL )return NULL;
02312     q->Parameter.Arguments.Argument->actualm = new_eNODE();
02313     if( q->Parameter.Arguments.Argument->actualm == NULL )return NULL;
02314     q->Parameter.Arguments.Argument->actualm->Parameter.Variable.Serial = ((pSymbolVAR)(*pSymbol))->Serial;
02315     q->Parameter.Arguments.Argument->actualm->OpCode = is_local ? eNTYPE_LVR : eNTYPE_GVR;
02316     /* the rest of the arguments are the indices */
02317     q->Parameter.Arguments.Argument->rest = ex_ExpressionList(pEx);
02318     if( is_assoc )
02319       if( LexemeType != LEX_T_CHARACTER || LexemeChar != '}' ){/* the closing } is missing after array indexes */
02320         REPORT(LexemeFileName,LexemeLineNumber,EX_ERROR_MISSING_SAPAREN,NULL);
02321         }else{ NextLexeme; }
02322     else
02323       if( LexemeType != LEX_T_CHARACTER || LexemeChar != ']' ){/* the closing ] is missing after array indexes */
02324         REPORT(LexemeFileName,LexemeLineNumber,EX_ERROR_MISSING_APAREN,NULL);
02325         }else{ NextLexeme; }
02326     /* now process the additional indices, like a[13]{"alma"}[5] */
02327     while( LexemeType == LEX_T_CHARACTER && (LexemeChar == '[' || LexemeChar == '{') ){
02328       if( LexemeChar == '[' )is_assoc = 0; else is_assoc = 1;
02329       NextLexeme;
02330       r = q;
02331       q = new_eNODE();
02332       if( q == NULL )return NULL;
02333       q->OpCode = is_assoc ? eNTYPE_SAR : eNTYPE_ARR;
02334       q->Parameter.Arguments.Argument = new_eNODE_l();
02335       if( q->Parameter.Arguments.Argument == NULL )return NULL;
02336       /* The first element of the list is the array up to here, the rest is the actual index list. */
02337       q->Parameter.Arguments.Argument->actualm = r;
02338       /* the rest of the arguments are the indices */
02339       q->Parameter.Arguments.Argument->rest = ex_ExpressionList(pEx);
02340       if( is_assoc )
02341         if( LexemeType != LEX_T_CHARACTER || LexemeChar != '}' ){/* the closing } is missing after array indexes */
02342           REPORT(LexemeFileName,LexemeLineNumber,EX_ERROR_MISSING_SAPAREN,NULL);
02343           }else{ NextLexeme; }
02344       else
02345         if( LexemeType != LEX_T_CHARACTER || LexemeChar != ']' ){/* the closing ] is missing after array indexes */
02346           REPORT(LexemeFileName,LexemeLineNumber,EX_ERROR_MISSING_APAREN,NULL);
02347           }else{ NextLexeme; }
02348       }
02349     return q;
02350     }
02351 
02352   q = new_eNODE();
02353   if( q == NULL )return NULL;
02354   /* this is a simple variable */
02355   if( WeAreNotLocal || (pSymbol = ex_LookupLocalVariable(pEx,0)) == NULL ){
02356     if( WeAreLocal && DefaultLocal && ex_LookupLocallyDeclaredGlobalVariable(pEx) == NULL ){
02357       pSymbol = ex_LookupLocalVariable(pEx,1);
02358       is_local = 1; 
02359       }else{
02360       pSymbol = ex_LookupGlobalVariable(pEx,1);
02361       is_local = 0; 
02362       }
02363     }else is_local = 1;
02364   if( *pSymbol == NULL ){
02365     if( DeclareVars )REPORT(LexemeFileName,LexemeLineNumber,EX_ERROR_UNDEF_GLOBAL,NULL);
02366     if( DefaultLocal && is_local )
02367       *pSymbol = (void *)new_SymbolVAR(LOCAL_VAR);
02368     else
02369       *pSymbol = (void *)new_SymbolVAR(GLOBAL_VAR);
02370     }else{/* this is an existing symbol */
02371     if( DeclareVars && DefaultLocal && is_local && ex_LookupLocallyDeclaredGlobalVariable(pEx) == NULL && ex_LookupLocalVariable(pEx,0) == NULL)
02372       REPORT(LexemeFileName,LexemeLineNumber,EX_ERROR_UNDEF_GLOBAL,NULL);
02373     }
02374   q->OpCode = is_local ? eNTYPE_LVR : eNTYPE_GVR;
02375   q->Parameter.Variable.Serial = ((pSymbolVAR)(*pSymbol))->Serial;
02376   return q;
02377   }
02378 
02379 /*POD
02380 =H ex_PredeclareGlobalLongConst()
02381 
02382 This function is used to declare the global constants that are given
02383 in the syntax defintinon, and should be defined before the program
02384 is started to be analized.
02385 
02386 /*FUNCTION*/
02387 int ex_PredeclareGlobalLongConst(peXobject pEx,
02388                                  char *pszConstName,
02389                                  long lConstValue
02390   ){
02391 /*noverbatim
02392 CUT*/
02393   void **pSymbol;
02394   pLexeme pConstValue;
02395   void *prepar[2];
02396 
02397   prepar[0] = (void *)pszConstName;
02398   prepar[1] = (void *)lConstValue;
02399   pConstValue = alloc_Alloc(sizeof(Lexeme),pEx->pSymbolTableMemorySegment);
02400   if( pConstValue == NULL )return EX_ERROR_MEMORY_LOW;
02401   pSymbol = sym_LookupSymbol(pszConstName, /* the symbol we search */
02402                              pEx->GlobalConstants, /* in this table */
02403                              1,                 /* insert the symbol as new */
02404                              alloc_Alloc,
02405                              alloc_Free,
02406                              pEx->pSymbolTableMemorySegment);
02407   if( pSymbol == NULL )return 1;
02408   *pSymbol = (void *)pConstValue; /* note that this const value can be NULL to force a previously*/
02409   pConstValue->type = LEX_T_LONG;
02410   pConstValue->value.lValue = lConstValue;
02411   return 0;
02412   }
02413 
02414 /*POD
02415 =H ex_IsCommandThis
02416 
02417 This is the most general syntax analysis function that tries to match the syntax
02418 of the actual line syntax provided in argument T<p> against the token list at the actual
02419 position.
02420 
02421 The function has several side effects altering optionally the global and local variable table,
02422 define user defined functions and so on.
02423 
02424 The function signals the success of its operation via the argument T<piFailure> setting the T<int>
02425 pointed by it to be zero or the error code.
02426 
02427 If the syntax does not match the token list then the function cleans up all its actions if possible
02428 to allow the caller to iterate over to the next syntax defintion. In such a situation
02429 T<*piFailure> is set T<EX_ERROR_SYNTAX>
02430 
02431 If the syntax does not match the token list but the analysis went too far and had side effects that
02432 cannot be reversed then no cleanup is made. In such a situation T<*piFailure> is set
02433 T<EX_ERROR_SYNTAX_FATAL>.
02434 
02435 T<*piFailure> is also set to this value if the syntax definition reaches a "star" point. If the syntax
02436 analysis matches a line up to a "star" point then the line should match that syntax definition or is
02437 known erroneous. For example a command starting with the two keywords T<'declare' 'command'> after these
02438 two keywords reach a "star" point because no other line syntax but extrenal command declaration starts
02439 with these two keywords. In such a situation signalling fatal syntax error saves the compiler time
02440 to check other syntax definition.
02441 
02442 A "star" point is named this way, because the file T<syntax.def> uses the character T<*> to denote
02443 this point in the syntax definitions.
02444 
02445 /*FUNCTION*/
02446 peNODE ex_IsCommandThis(peXobject pEx,
02447                         pLineSyntax p,
02448                         int *piFailure
02449   ){
02450 /*noverbatim
02451 If the syntax analysis fully matches the syntax definition provided in the argument
02452 then the function returns the node that was generated. If more then one nodes were generated
02453 during the syntax analysis of the line then the root node of the generated nodes is returned.
02454 CUT*/
02455 #define ABORT goto SYNTAX_FAILURE_DO_CLEANUP
02456 #define ARGUMENT pArgument->Parameter.CommandArgument.Argument
02457 #define ASSERT_NON_NULL(x) if( (x) == NULL ){ *piFailure = EX_ERROR_MEMORY_LOW; ABORT; }
02458 
02459 #define NewArgument if( (*ppArgument = new_eNODE()) == NULL ){\
02460                        *piFailure = EX_ERROR_MEMORY_LOW;\
02461                        ABORT;\
02462                        }else{\
02463                        pArgument = *ppArgument;\
02464                        ppArgument = &(pArgument->Parameter.CommandArgument.next);\
02465                        *ppArgument = NULL;\
02466                        }
02467 /*
02468 This function call uses the stored memory segment because the memory is not release
02469 in case of error, but stored in a local free list. This caused error in former versions
02470 because the segment was released, but the local list still used the same memory. */
02471 #define ex_PushLabel(y,z) _ex_PushLabel(pEx,y,z,pMyMemorySegment)
02472 
02473   void *pMyMemorySegment,*pSwapMemorySegment;
02474 #define ex_SwapMemorySegment() do{ pSwapMemorySegment  = pEx->pMemorySegment; \
02475                                    pEx->pMemorySegment = pMyMemorySegment;    \
02476                                    pMyMemorySegment    = pSwapMemorySegment; }while(0)
02477   int iCurrentLex;
02478   int iSaveWeAreLocal;
02479   peNODE pCommandNode;
02480   peNODE *ppArgument,pArgument;
02481   pSymbolUF pFunction;
02482   pSymbolLABEL pLabel;
02483   void **pSymbol;
02484   void **pFailedFunctionSymbol;
02485   char *pszNewNameSpace;
02486   char *pszLabelDefined;
02487   char *pszConstDefined;
02488   int iConstGlobal;
02489   pLexeme pConstValue;
02490   char szNumericLabelName[80]; /* who is writing 10000...00 such a long basic label ?*/
02491   int iSideEffectWas;
02492   int iCommandNeedsCode;
02493   int fResetNameSpace;
02494   int StackCleanc;
02495   int isig;
02496   long sLen;
02497 
02498   iCommandNeedsCode = 1; /* command needs code even if there are no argument of the command */
02499   fResetNameSpace = 0;
02500   *piFailure = EX_ERROR_SUCCESS;
02501   iSaveWeAreLocal     = pEx->iWeAreLocal;
02502   pszNewNameSpace     = NULL;
02503   pszLabelDefined     = NULL;
02504   pszConstDefined     = NULL;
02505   pConstValue         = NULL;
02506   iSideEffectWas      = 0; /* there was no side effect so far */
02507   StackCleanc = 0;
02508   pFailedFunctionSymbol = NULL;
02509   pMyMemorySegment    = pEx->pMemorySegment; /* store the old value */
02510   /* allocate a new segment which is dropped on failure or merged on success */
02511   pEx->pMemorySegment = alloc_InitSegment(pEx->memory_allocating_function,
02512                                        pEx->memory_releasing_function);
02513 
02514   if( pEx->pMemorySegment == NULL ){
02515     pEx->pMemorySegment = pMyMemorySegment;
02516     return NULL;
02517     }
02518   ppArgument = &pCommandNode;
02519   pCommandNode = NULL;
02520 
02521   for( iCurrentLex = 0; p->lexes[iCurrentLex].type ; iCurrentLex ++ ){
02522     switch( p->lexes[iCurrentLex].type ){
02523 
02524       case EX_LEX_LOCAL_START: /* start local scope */
02525         if( pEx->iWeAreLocal )ABORT;/* this is some nested function construct,not allowed */
02526         pEx->iWeAreLocal = 1;
02527         pEx->cLocalVariables  = 0;
02528         NewArgument;
02529         pEx->plNrLocalVariables = &(ARGUMENT.lLongValue);
02530         pEx->LocalVariables = sym_NewSymbolTable(alloc_Alloc,pEx->pLocalVarMemorySegment);
02531         pEx->LocallyDeclaredGlobalVariables = sym_NewSymbolTable(alloc_Alloc,pEx->pLocalVarMemorySegment);
02532         CALL_PREPROCESSOR(PreprocessorExStartLocal,pEx);
02533         break;
02534 
02535       case EX_LEX_ARG_NUM: /* store the number of arguments */
02536         NewArgument;
02537         ARGUMENT.lLongValue = pEx->cLocalVariables;
02538         break;
02539 
02540       case EX_LEX_LOCAL_END: /* finish local scope */
02541         if( pEx->plNrLocalVariables )/* this may be NULL when a syntax error occured */
02542           *(pEx->plNrLocalVariables) = pEx->cLocalVariables;
02543         pEx->plNrLocalVariables = NULL; /* just to be safe */
02544         pEx->iWeAreLocal = 0;
02545         CALL_PREPROCESSOR(PreprocessorExEndLocal,pEx);
02546         /* there are other actions when the whole line is matched */
02547         break;
02548 
02549      case EX_LEX_STAR:
02550         iSideEffectWas = 1;
02551         break;
02552 
02553      case EX_LEX_NOEXEC:
02554         iCommandNeedsCode = 0;
02555         break;
02556 /*
02557        NOTE that local variables ARE inserted into the symbol table during the evaluation.
02558        This happens even if the matching process fails. This means a restriction on the
02559        normal syntax defintions. The syntax should know that this is a valid line and this
02560        is a local variable defintion when the analysis gets here.
02561 */
02562       case EX_LEX_LOCAL:    /* local variable definition */
02563         iSideEffectWas = 1;
02564         if( ex_Local(pEx) )ABORT;
02565         break;
02566 
02567       case EX_LEX_LOCALL:   /* local variable definition list*/
02568         iSideEffectWas = 1;
02569         if( ex_LocalList(pEx) )ABORT;
02570         break;
02571 
02572       case EX_LEX_GLOBAL: /* global variable definition */
02573         iSideEffectWas = 1;
02574         if( ex_Global(pEx) )ABORT;
02575         break;
02576 
02577       case EX_LEX_GLOBALL:   /* global variable definition list*/
02578         iSideEffectWas = 1;
02579         if( ex_GlobalList(pEx) )ABORT;
02580         break;
02581 
02582 /*
02583        NOTE that analyzing an expression or left value has a lot of side effects therefore the same restrictions
02584        will apply for expressions as does for LOCAL and LOCALL.
02585 */
02586 
02587       case EX_LEX_EXP:      /* expression */
02588         iSideEffectWas = 1;
02589         NewArgument;
02590         ex_Expression_r(pEx,&(ARGUMENT.pNode));
02591         if( ARGUMENT.pNode == NULL )ABORT;
02592         break;
02593 
02594       case EX_LEX_EXPL:     /* expression list */
02595         iSideEffectWas = 1;
02596         NewArgument;
02597         if( (ARGUMENT.pNodeList = ex_ExpressionList(pEx)) != NULL ){
02598           break; 
02599           }else{
02600           ABORT;
02601           }
02602 
02603 /* Generally the LET instruction that starts with a left value should be placed at the end of
02604    the command definition list. This is because left value analysis makes some side effects,
02605    like inserting undeclared global variables into the symbol table. Therefore when an LVAL
02606    syntax element is reached during syntax analysis it should be sure that the instruction is
02607    the one that is currently checked or is syntactically incorrect.
02608 
02609    However this is a very strict rule, and to ease the syntax defintion table build up we
02610    check that the very first lexeme that comes when a left value (or list of lvals)
02611    is indeed a symbol. If this is not a symbol, then nothing fatal has happened, and we can abort the
02612    check against the current syntax defintion line without prohibiting the syntax analyzer to
02613    go on for other lines.
02614 */
02615 
02616       case EX_LEX_LVAL:     /* left value */
02617         if( LexemeType != LEX_T_ASYMBOL )ABORT; /* this is needed only to ease a bit 
02618                                                    syntax defintion table build up. */
02619         iSideEffectWas = 1;
02620         NewArgument;
02621         if( (ARGUMENT.pNode = ex_LeftValue(pEx)) != NULL ){
02622           break;
02623           }else{
02624           ABORT;
02625           }
02626 
02627       case EX_LEX_LVALL:     /* left value list */
02628         if( LexemeType != LEX_T_ASYMBOL )ABORT; /* this is needed only to ease a bit 
02629                                                    syntax defintion table build up. */
02630         iSideEffectWas = 1;
02631         NewArgument;
02632         if( (ARGUMENT.pNodeList = ex_LeftValueList(pEx)) != NULL ){
02633           break;
02634           }else{
02635           ABORT;
02636           }
02637 /*
02638        NOTE that COME and GO virtual syntax elements push or pop values to/from the compile time stack.
02639        Therefore these elements should only appear at the end of the syntax defintion line where it is sure
02640        that the line is going to be accepted by this syntax definition.
02641 */
02642       case EX_LEX_GO_FORWARD:
02643         iSideEffectWas = 1;
02644         NewArgument;
02645         pLabel = (ARGUMENT.pLabel = new_SymbolLABEL());
02646         ex_PushLabel(pLabel,p->lexes[iCurrentLex].GoConstant[0]);
02647         StackCleanc++;
02648         break;
02649 
02650       case EX_LEX_GO_BACK:
02651         iSideEffectWas = 1;
02652         NewArgument;
02653         pLabel = (ARGUMENT.pLabel = ex_PopLabel(p->lexes[iCurrentLex].GoConstant));
02654         break;
02655 
02656       case EX_LEX_COME_FORWARD:
02657         iSideEffectWas = 1;
02658         pLabel = ex_PopLabel(p->lexes[iCurrentLex].GoConstant);
02659         /* Kevin Landman proposed that this check has to be done here to detect ELSE w/o any IF */
02660         if( NULL == pLabel ){
02661                 *piFailure = EX_ERROR_BAD_NESTING;
02662                 ABORT;
02663           }
02664         ex_PushWaitingLabel(pEx,pLabel);
02665         break;
02666 
02667       case EX_LEX_COME_BACK:
02668         iSideEffectWas = 1;
02669         pLabel = new_SymbolLABEL();
02670         ex_PushWaitingLabel(pEx,pLabel);
02671         ex_PushLabel(pLabel,p->lexes[iCurrentLex].GoConstant[0]);
02672         StackCleanc++;
02673         break;
02674 
02675       case EX_LEX_NSYMBOL: /* alpha or non-alpha symbol to ease handling and to let define alpha alternatives for non-alpha symbols */
02676         if( LexemeType != LEX_T_NSYMBOL )ABORT;
02677         /* printf("%s =?= %s\n",lex_SymbolicName(pEx->pLex,LexemeCode),lex_SymbolicName(pEx->pLex,p->lexes[iCurrentLex].OpCode)); */
02678         if( LexemeCode != p->lexes[iCurrentLex].OpCode )ABORT;
02679         NextLexeme;
02680         break;
02681 
02682       case EX_LEX_FUNCTION: /* a symbol that stands for a function or procedure name when function or
02683                                procedure is defined */
02684         if( LexemeType != LEX_T_ASYMBOL )ABORT;
02685         *piFailure = ex_ConvertName(LexemeSymbol, pEx->Buffer,pEx->cbBuffer,pEx);
02686         if( *piFailure )ABORT;
02687         pSymbol = ex_LookupUserFunction(pEx,1);
02688         ASSERT_NON_NULL(pSymbol);
02689         if( *pSymbol == NULL ){
02690           pFailedFunctionSymbol = pSymbol; /* we need this in case the command fails. */
02691           *pSymbol = (void *)(pFunction=new_SymbolUF());
02692           pFunction->node = 0; /* not defined yet */
02693           }
02694         else{
02695           pFunction = (pSymbolUF)*pSymbol;
02696           pFailedFunctionSymbol = NULL;
02697           }
02698         ASSERT_NON_NULL(pFunction)
02699         pEx->pFunctionWaiting = pFunction;
02700         pEx->ThisFunction = pFunction;
02701         pEx->ThisFunction->Argc = -1;
02702         pEx->ThisFunction->FunctionName = LexemeSymbol;
02703         if( pFunction->node ){
02704           *piFailure = EX_ERROR_FUNCTION_DOUBLE_DEFINED;
02705           ABORT;
02706           }
02707         NextLexeme;
02708         break;
02709 
02710       case EX_LEX_THIS_FUNCTION: /* a symbol that stands for a function or procedure name */
02711         if( LexemeType != LEX_T_ASYMBOL )ABORT;
02712         ex_ConvertName(LexemeSymbol, pEx->Buffer,pEx->cbBuffer,pEx);
02713         pSymbol = ex_LookupUserFunction(pEx,0);
02714         if( pSymbol == NULL )ABORT; /* no this is not a function name */
02715         pFunction = (pSymbolUF)*pSymbol;
02716         if( pEx->ThisFunction == NULL || 
02717             pFunction->FunId != pEx->ThisFunction->FunId )ABORT; /* this is a function name, but not the current */
02718         NextLexeme;
02719         break;
02720 
02721       case EX_LEX_CONST_NAME: /* a const is going to be defined (symbol) */
02722         if( LexemeType != LEX_T_ASYMBOL && LexemeType != LEX_T_LONG )ABORT;
02723         pszConstDefined = LexemeSymbol; /* there can only be one const defined on a line */
02724         /* the real const defintion takes place when the whole line is matched */
02725         NextLexeme;
02726         iConstGlobal = 0;
02727         break;
02728 
02729       case EX_LEX_GCONST_NAME: /* a global const is going to be defined (symbol) */
02730         if( LexemeType != LEX_T_ASYMBOL && LexemeType != LEX_T_LONG )ABORT;
02731         pszConstDefined = LexemeSymbol; /* there can only be one const defined on a line */
02732         /* the real const defintion takes place when the whole line is matched */
02733         NextLexeme;
02734         iConstGlobal = 1;
02735         break;
02736 
02737       case EX_LEX_CONST_VALUE:
02738         /* Here we have to let the user specify "simple exppression" as constant.
02739            The string -nnn or +nnn is never recognized as signed number by the lexical analyzer.
02740            It should not recognize it as signed number, because in that case we could face problems
02741            with expressions like 6+3. Then it would be just two numbers one following the other
02742            instead of being an expression. Therefore here we let the user to use a simple expression
02743            as constant value. If the lexical element that stands in place of the CVAL is a + or - sign
02744            then we go forward and take the number (if it is a number) and alter it according to the
02745            sign.
02746          */
02747         if( LexemeType == LEX_T_NSYMBOL && ( LexemeCode == CMD_MINUS || LexemeCode == CMD_PLUS ) ){
02748           pConstValue = pEx->pLex->pLexCurrentLexeme; /* in case the next symbol is not a number */
02749           if( LexemeCode == CMD_MINUS )isig = -1; else isig = 1;
02750           NextLexeme;
02751           if( LexemeType != LEX_T_DOUBLE && LexemeType != LEX_T_LONG )ABORT;
02752           pConstValue = pEx->pLex->pLexCurrentLexeme;
02753           NextLexeme;
02754           if( LexemeType != LEX_T_DOUBLE ){
02755             pConstValue->value.lValue *= isig;
02756             }else{
02757             pConstValue->value.dValue *= isig;
02758             }
02759           break;
02760           }
02761         if(  LexemeType != LEX_T_DOUBLE && LexemeType != LEX_T_LONG && LexemeType != LEX_T_STRING )ABORT;
02762         pConstValue = pEx->pLex->pLexCurrentLexeme;
02763         NextLexeme;
02764         break;
02765 
02766       case EX_LEX_LABEL_DEFINITION: /* a global label is defined (symbol) */
02767         if( LexemeType != LEX_T_ASYMBOL && LexemeType != LEX_T_LONG )ABORT;
02768         if( LexemeType == LEX_T_ASYMBOL ){
02769           pszLabelDefined = LexemeSymbol; /* there can only be one label defined on a line */
02770           /* the real label defintion takes place when the whole line is matched */
02771           }else{
02772           sprintf(szNumericLabelName,"%ld",LexemeLong);
02773           pszLabelDefined = szNumericLabelName;
02774           }
02775         NextLexeme;
02776         break;
02777 
02778       case EX_LEX_LABEL: /* a global label is used */
02779         if( LexemeType != LEX_T_ASYMBOL && LexemeType != LEX_T_LONG)ABORT;
02780         if( LexemeType == LEX_T_ASYMBOL ){
02781           *piFailure = ex_ConvertName(LexemeSymbol, pEx->Buffer,pEx->cbBuffer,pEx);
02782           }else{
02783           sprintf(szNumericLabelName,"%ld",LexemeLong);
02784           *piFailure = ex_ConvertName(szNumericLabelName, pEx->Buffer,pEx->cbBuffer,pEx);
02785         }
02786         
02787         if( *piFailure )ABORT;/* This is memory fault. */
02788         iSideEffectWas = 1; /* we insert this into the global label table */
02789         if( strlen(pEx->Buffer) >= pEx->cbBuffer-1 ){
02790           *piFailure = EX_ERROR_TOO_LONG_VARIABLE;
02791           ABORT;
02792           }
02793         strcat(pEx->Buffer,"'");
02794         if( pEx->ThisFunction ){
02795           if( strlen(pEx->Buffer) + strlen(pEx->ThisFunction->FunctionName) >= pEx->cbBuffer ){
02796             *piFailure = EX_ERROR_TOO_LONG_VARIABLE;
02797             ABORT;
02798             }
02799           strcat(pEx->Buffer,pEx->ThisFunction->FunctionName );
02800           }
02801 
02802         pSymbol = sym_LookupSymbol(pEx->Buffer, /* the symbol we search */
02803                                    pEx->GlobalLabels, /* in this table */
02804                                    1,                 /* insert the symbol as new */
02805                                    alloc_Alloc,
02806                                    alloc_Free,
02807                                    pEx->pSymbolTableMemorySegment);
02808         ASSERT_NON_NULL(pSymbol)
02809         if( *pSymbol == NULL ){
02810           *pSymbol = (void *)new_SymbolLABEL();
02811           pLabel = (pSymbolLABEL)*pSymbol;
02812           pLabel->node = 0;
02813           }else
02814           pLabel = (pSymbolLABEL)*pSymbol;
02815         ASSERT_NON_NULL(pLabel)
02816         NewArgument;
02817         ARGUMENT.pLabel = pLabel;
02818         NextLexeme;
02819         break;
02820 
02821       case EX_LEX_SET_NAME_SPACE: /* set the new name space */
02822         if( LexemeType != LEX_T_ASYMBOL )ABORT;
02823         if( LexemeSymbol[0] == ':' && LexemeSymbol[1] == ':' ){
02824           /* you should never have a syntax that has name space alteration and other stuff that uses the pEx buffer */
02825           *piFailure = ex_ConvertName(LexemeSymbol+2, pEx->Buffer,pEx->cbBuffer,pEx);
02826           if( *piFailure )ABORT;
02827           pszNewNameSpace = pEx->Buffer;
02828           }else{
02829           pszNewNameSpace = LexemeSymbol;  /* we will set is later, when the line has been accepted */
02830           }
02831         NextLexeme;
02832         break;
02833 
02834       case EX_LEX_RESET_NAME_SPACE: /*  reset the name space to the old value */
02835         fResetNameSpace = 1;
02836         break;
02837 
02838       case EX_LEX_PRAGMA:
02839         if( LexemeType != LEX_T_ASYMBOL && LexemeType != LEX_T_NSYMBOL )ABORT;
02840         if( LexemeType == LEX_T_ASYMBOL ){
02841           ex_Pragma(pEx,LexemeSymbol);
02842           }else{/* this is to handle absolute symbols that are predefined */
02843           ex_Pragma(pEx,lex_SymbolicName(pEx->pLex,LexemeCode));
02844           }
02845         NextLexeme;
02846         break;
02847 
02848       /* an absolute symbol without name space modification */
02849       case EX_LEX_ASYMBOL:
02850         if( LexemeType != LEX_T_ASYMBOL && LexemeType != LEX_T_NSYMBOL )ABORT;
02851         if( LexemeType == LEX_T_ASYMBOL ){
02852           NewArgument;
02853           if( (ARGUMENT.szStringValue = alloc_Alloc(sLen=strlen(LexemeSymbol)+1,pEx->pMemorySegment)) == NULL )ABORT;
02854           strcpy(ARGUMENT.szStringValue,LexemeSymbol);
02855           pArgument->Parameter.CommandArgument.sLen = sLen;
02856           pEx->cbStringTable += sLen+1;
02857           COUNT_STRING_LEN
02858           }else{/* this is to handle absolute symbols that are predefined */
02859           NewArgument;
02860           if( (ARGUMENT.szStringValue = alloc_Alloc(sLen=strlen(lex_SymbolicName(pEx->pLex,LexemeCode))+1,pEx->pMemorySegment)) == NULL )ABORT;
02861           strcpy(ARGUMENT.szStringValue,lex_SymbolicName(pEx->pLex,LexemeCode));
02862           pArgument->Parameter.CommandArgument.sLen = sLen;
02863           pEx->cbStringTable += sLen+1;
02864           COUNT_STRING_LEN
02865           }
02866         NextLexeme;
02867         break;
02868 
02869       case EX_LEX_SYMBOL:   /* a symbol, like an external function name from a dll */
02870         if( LexemeType != LEX_T_ASYMBOL )ABORT;
02871         *piFailure = ex_ConvertName(LexemeSymbol, pEx->Buffer,pEx->cbBuffer,pEx);
02872         if( *piFailure )ABORT;
02873         NewArgument;
02874         if( (ARGUMENT.szStringValue = alloc_Alloc((sLen=strlen(pEx->Buffer))+1,pEx->pMemorySegment)) == NULL )ABORT;
02875         strcpy(ARGUMENT.szStringValue,pEx->Buffer);
02876         pArgument->Parameter.CommandArgument.sLen = sLen;
02877         pEx->cbStringTable += sLen+1;
02878         COUNT_STRING_LEN
02879         NextLexeme;
02880         break;
02881 
02882       case EX_LEX_CHARACTER: /* a character, like '(' or ')' */
02883         if( LexemeType == LEX_T_CHARACTER && p->lexes[iCurrentLex].OpCode == LexemeChar ){
02884           NextLexeme;
02885           break;
02886           }
02887         ABORT;
02888 
02889       case EX_LEX_LONG:     /* a numeric integer value */
02890         if( LexemeType != LEX_T_LONG )ABORT;
02891         NewArgument;
02892         ARGUMENT.lLongValue = LexemeLong;
02893         NextLexeme;
02894         break;
02895 
02896       case EX_LEX_DOUBLE:   /* a numeric float value */
02897         if( LexemeType != LEX_T_DOUBLE && LexemeType != LEX_T_LONG )ABORT;
02898         NewArgument;
02899         if( LexemeType == LEX_T_LONG )
02900           ARGUMENT.dDoubleValue = (double)LexemeLong;
02901         else
02902           ARGUMENT.dDoubleValue = LexemeDouble;
02903         NextLexeme;
02904         break;
02905 
02906       case EX_LEX_STRING:   /* a string value */
02907         if( LexemeType != LEX_T_STRING )ABORT;
02908         NewArgument;
02909         ASSERT_NON_NULL( (ARGUMENT.szStringValue = alloc_Alloc(LexemeStrLen+1,pEx->pMemorySegment)) )
02910         memcpy(ARGUMENT.szStringValue,LexemeSymbol,LexemeStrLen+1);
02911         pArgument->Parameter.CommandArgument.sLen = LexemeStrLen;
02912         pEx->cbStringTable += LexemeStrLen+1;
02913         COUNT_STRING_LEN
02914         NextLexeme;
02915         break;
02916       }
02917     }
02918 
02919   /* if a const was defined on the line */
02920   if( pszConstDefined ){
02921     if( iConstGlobal ){
02922       if( strlen(pszConstDefined) >= pEx->cbBuffer ){
02923         *piFailure = EX_ERROR_TOO_LONG_VARIABLE;
02924         ABORT;
02925         }
02926       strcpy(pEx->Buffer,pszConstDefined);
02927       }else{
02928       ex_ConvertName(pszConstDefined, pEx->Buffer,pEx->cbBuffer,pEx);
02929       if( strlen(pEx->Buffer) >= pEx->cbBuffer-1 ){
02930         *piFailure = EX_ERROR_TOO_LONG_VARIABLE;
02931         ABORT;
02932         }
02933       strcat(pEx->Buffer,"'");
02934       if( pEx->ThisFunction ){
02935         if( strlen(pEx->Buffer) + strlen(pEx->ThisFunction->FunctionName) >= pEx->cbBuffer ){
02936           *piFailure = EX_ERROR_TOO_LONG_VARIABLE;
02937           ABORT;
02938           }
02939         strcat(pEx->Buffer,pEx->ThisFunction->FunctionName );
02940         }
02941       }
02942 
02943     pSymbol = sym_LookupSymbol(pEx->Buffer, /* the symbol we search */
02944                                pEx->GlobalConstants, /* in this table */
02945                                1,                 /* insert the symbol as new */
02946                                alloc_Alloc,
02947                                alloc_Free,
02948                                pEx->pSymbolTableMemorySegment);
02949     ASSERT_NON_NULL(pSymbol)
02950     *pSymbol = (void *)pConstValue; /* note that this const value can be NULL to force a previously
02951                                        declared constant to be variable again */
02952     }
02953 
02954   /* if a label was defined on the line do all the tasks that have side effects only now. */
02955   if( pszLabelDefined ){
02956     ex_ConvertName(pszLabelDefined, pEx->Buffer,pEx->cbBuffer,pEx);
02957     if( strlen(pEx->Buffer) >= pEx->cbBuffer-1 ){
02958       *piFailure = EX_ERROR_TOO_LONG_VARIABLE;
02959       ABORT;
02960       }
02961     strcat(pEx->Buffer,"'");
02962     if( pEx->ThisFunction ){
02963       if( strlen(pEx->Buffer) + strlen(pEx->ThisFunction->FunctionName) >= pEx->cbBuffer ){
02964         *piFailure = EX_ERROR_TOO_LONG_VARIABLE;
02965         ABORT;
02966         }
02967       strcat(pEx->Buffer,pEx->ThisFunction->FunctionName );
02968       }
02969 
02970     pSymbol = sym_LookupSymbol(pEx->Buffer, /* the symbol we search */
02971                                pEx->GlobalLabels, /* in this table */
02972                                1,                 /* insert the symbol as new */
02973                                alloc_Alloc,
02974                                alloc_Free,
02975                                pEx->pSymbolTableMemorySegment);
02976     ASSERT_NON_NULL(pSymbol)
02977     if( *pSymbol == NULL ){
02978       *pSymbol = (void *)new_SymbolLABEL();
02979       pLabel = (pSymbolLABEL)*pSymbol;
02980       pLabel->node = 0;
02981       }else{
02982       pLabel = (pSymbolLABEL)*pSymbol;
02983       }
02984     if( pLabel == NULL )ABORT;
02985     if( pLabel->node != 0 )*piFailure = EX_ERROR_LABEL_DOUBLE_DEFINED;
02986     ex_PushWaitingLabel(pEx,pLabel);
02987     }
02988 
02989   /* if we have just left the local scope (we are not local and we were local) */
02990   if( (!pEx->iWeAreLocal) && iSaveWeAreLocal ){
02991     /* free the memory assigned to local variables */
02992     alloc_FreeSegment(pEx->pLocalVarMemorySegment);
02993     pEx->LocalVariables = NULL; /* just to be safe */
02994     pEx->LocallyDeclaredGlobalVariables = NULL; /* also just to be safe */
02995     pEx->ThisFunction = NULL; /* there is no this function */
02996     ex_CleanLabelStack(); /* no nested construct cross locality border */
02997     }
02998 
02999   /* if this was a function definition then the number of local variables give the
03000      number of arguments because the arguments are nothing else than initialized
03001      local variables
03002   *//* we are in a function and the number of arguments was not set => this was the function head */
03003   if( pEx->ThisFunction && pEx->ThisFunction->Argc == -1 )pEx->ThisFunction->Argc = pEx->cLocalVariables;
03004 
03005   /* If we are not local then this pointer has to be NULL. This may happen when a 'declare sub XX alias "xx" lib "xx"'
03006      command is parsed. This sets this pointer to point to a function structure, but neither enters nor leaves
03007      local scope. On the other hand some of the code relies on this pointer.
03008   */
03009   if( !pEx->iWeAreLocal )pEx->ThisFunction = NULL;
03010 
03011   if( fResetNameSpace ){
03012     /* we have to swap the memory segments pMyMemorySegment and pEx->pMemorySegment because this
03013        function relies on the segment and tries to release the memory allocated to store the name
03014        of the name space */
03015     ex_SwapMemorySegment();
03016     if( *piFailure = expression_PopNameSpace(pEx) ){
03017       ex_SwapMemorySegment();
03018       ABORT;
03019       }
03020     ex_SwapMemorySegment();
03021     }
03022   if( pszNewNameSpace ){
03023     if( pEx->cbCurrentNameSpace < (long)strlen(pszNewNameSpace)+3 ){
03024       *piFailure = EX_ERROR_TOO_LONG_NAME_SPACE;
03025       ABORT;
03026       }
03027     if( *piFailure = expression_PushNameSpace(pEx) )ABORT;
03028     strcpy(pEx->CurrentNameSpace,pszNewNameSpace);
03029     strcat(pEx->CurrentNameSpace,"::");
03030     }
03031 
03032   if( pCommandNode == NULL && iCommandNeedsCode ){
03033     NewArgument;
03034     pCommandNode->Parameter.CommandArgument.Argument.pNode = NULL; /* just to be safe */
03035     }
03036 
03037   if( pCommandNode )
03038     pCommandNode->OpCode = p->CommandOpCode;
03039 
03040   alloc_MergeAndFinish(pEx->pMemorySegment,pMyMemorySegment);
03041 
03042   return pCommandNode;
03043 
03044 #undef ABORT
03045 #undef NextArgument
03046 #undef NewArgument
03047 #undef ARGUMENT
03048 
03049 SYNTAX_FAILURE_DO_CLEANUP:
03050   if( ! *piFailure )
03051     *piFailure = iSideEffectWas ? EX_ERROR_SYNTAX_FATAL : EX_ERROR_SYNTAX; /* general error */
03052 
03053   /* if this started as a function definition but it failed. */
03054   if( pEx->ThisFunction && pEx->ThisFunction->Argc == -1 ){
03055     pEx->ThisFunction = NULL;
03056     /* Here we have to delete the created undefined symbol. Otherwise it would happen that
03057        the program erroneously reports an undefined function symbol that it thought it
03058        was going to ge a function defined later, but it turned out not to be a function
03059        according to the syntax.
03060     */
03061     if( pFailedFunctionSymbol )*pFailedFunctionSymbol = NULL;
03062     }
03063   pEx->iWeAreLocal = iSaveWeAreLocal; /* it might have changed */
03064 
03065   /* Clean the label stack. This is needed when syntax analysis fails after some
03066      construct that has already been recognised as a loop/if/... construct. The
03067      most typical example is
03068 
03069         while expression do     <- "do" is not allowed
03070 
03071      The syntax analizer thinks that this is a "while" command, but fails
03072      when the keyword "do" is seen. Therefore here we clean the stack.
03073   */
03074   while( StackCleanc ){
03075     ex_PopLabel(NULL);
03076     StackCleanc--;
03077     }
03078   /* drop the memory segment, and */
03079   alloc_FinishSegment(pEx->pMemorySegment);
03080   /* restore the old one */
03081   pEx->pMemorySegment = pMyMemorySegment;
03082   return NULL;
03083   }
03084 
03085 /*POD
03086 =H ex_Command_r()
03087 
03088 This function finds the matching sytax line for the actual line in a loop. It
03089 starts with the first syntax definition and goes on until there are no more
03090 syntax defintions, a fatal error has happened or the actual line is matched.
03091 
03092 /*FUNCTION*/
03093 void ex_Command_r(peXobject pEx,
03094                   peNODE *Result,
03095                   int *piFailure
03096   ){
03097 /*noverbatim
03098 T<pEx> is the execution object.
03099 
03100 T<Result> is the resulting node.
03101 
03102 T<piFailure> is the error code.
03103 
03104 CUT*/
03105   pLineSyntax p;
03106   pLexeme pPosition;
03107   int i;
03108   p = pEx->Command;
03109   lex_SavePosition(pEx->pLex,&pPosition);
03110   i = 0;
03111   while(1){
03112     i++;
03113     *Result = p->pfAnalyzeFunction(pEx,p,piFailure);
03114     if( *piFailure != EX_ERROR_SYNTAX )
03115       break;
03116     p++;
03117     if( p->CommandOpCode == 0 )break;
03118     lex_RestorePosition(pEx->pLex,&pPosition);
03119     }
03120   }
03121 
03122 /*POD
03123 =H ex_Command_l()
03124 
03125 This function goes over the source lines and performs the syntax analysis. This 
03126 function calls the function R<ex_Command_r()>. When that function returns it
03127 allocated the list nodes that chain up the individual lines. It also defines
03128 the labels that are waiting to be defined.
03129 
03130 /*FUNCTION*/
03131 int ex_Command_l(peXobject pEx,
03132                   peNODE_l *Result
03133   ){
03134 /*noverbatim
03135 When all the lines are done this function cleans the name space stack,
03136 check for undefined labels that remained undefined still the end 
03137 of the source file.
03138 
03139 CUT*/
03140   int iFailure;
03141   peNODE pCommand;
03142   pSymbolLABEL pLabel;
03143   char *pszFileName;
03144   long lLineNumber;
03145 
03146   CALL_PREPROCESSOR(PreprocessorExStart,pEx);
03147   pEx->cLabelsWaiting = 0;
03148   *Result = NULL;
03149   while( LexemeType ){
03150     pszFileName = LexemeFileName;
03151     lLineNumber = LexemeLineNumber;
03152     CALL_PREPROCESSOR(PreprocessorExStartLine,pEx);
03153     ex_Command_r(pEx,&pCommand,&iFailure);
03154     if( iFailure ){/* this is some error. we go on to the next line */
03155       REPORT(LexemeFileName,LexemeLineNumber,iFailure,NULL);
03156       while( LexemeType && (LexemeType != LEX_T_CHARACTER || LexemeChar != '\n') ) NextLexeme;
03157       continue;
03158       }
03159     /* some lines may return a NULL (no code generated, but still success, like "MODULE MyModule" */
03160     if( pCommand ){/* if there was any code then step onto the next line. */
03161       *Result = new_eNODE_lL();/* create the code for the line head */
03162       CALL_PREPROCESSOR(PreprocessorExLineNode,pEx);
03163       if( *Result == NULL )return EX_ERROR_MEMORY_LOW;
03164       (*Result)->actualm = pCommand;/* link in the code of the line */
03165 
03166       /* define all the labels that were present on the line or on a previous line and
03167          still wait for the next code generating line to be assigned to */
03168       while( pLabel = ex_PopWaitingLabel(pEx) )pLabel->node = (*Result)->NodeId;
03169       if( pEx->pFunctionWaiting ){
03170         pEx->pFunctionWaiting->node = (*Result)->NodeId;
03171         pEx->pFunctionWaiting = NULL;
03172         }
03173       Result = &((*Result)->rest); /* step onto the next line pointer (line itself is not yet allocated) */
03174       *Result = NULL; /* because the line is not allocated and may not be allocated if this was the last line
03175                          that allocated any node */
03176       }
03177     }
03178 
03179   /* if there are labels waiting to be defined after the last command line then we
03180      create a dummy list node without members or rest */
03181   if( pLabel = ex_PopWaitingLabel(pEx) ){
03182     *Result = new_eNODE_lL();
03183     if( *Result == NULL )return EX_ERROR_MEMORY_LOW;
03184     (*Result)->actualm = NULL;
03185     (*Result)->rest = NULL;
03186     while( pLabel ){
03187       pLabel->node = (*Result)->NodeId;
03188       pLabel = ex_PopWaitingLabel(pEx);
03189       }
03190     }
03191 
03192   /* This function call cleans the name space stack. This is not really neccessary because the
03193      name space stack is cleand up by the caller when finishes all the memory segments of the
03194      lexer and expression module. The main reason calling this function here is that this function
03195      reports an error if the name space stack is not empty. This effectively means that a "moduile"
03196      statement was not tfollowed by an "end module" statement until the end of the file. */
03197   ex_CleanNameSpaceStack(pEx);
03198 
03199   /* there is not really a need to clean the label stack, but this function also
03200      calls error reports. This will generate error reports for programs that end
03201      before closing a 'while' 'if' or any other loop like statement */
03202   ex_CleanLabelStack();
03203 
03204   /* this function goes through the symbol table where labels are defined and error reports
03205      all labels that were used, but not defined.
03206   */
03207   ex_CheckUndefinedLabels(pEx);
03208 
03209   /* This is a little hack. All other part of this program assumes that there are global
03210      variables. However a "Hello Word" application may not have and it causes
03211      trouble, when allocation functions allocate zero size memory. Therefore we create
03212      at least one global variable.  */
03213   if( pEx->cGlobalVariables == 0 )pEx->cGlobalVariables++;
03214   CALL_PREPROCESSOR(PreprocessorExEnd,pEx);
03215   return 0;
03216   }
03217 
03218 /*FUNCTION*/
03219 void ex_pprint(FILE *f,
03220                peXobject pEx
03221   ){
03222   peNODE_l q;
03223 
03224   for( q = pEx->pCommandList ; q ; q = q->rest )
03225     _ex_pprint(f,q->actualm,pEx,0);
03226   }
03227 
03228 
03229 #define ABORT  do{ *piFailure = EX_ERROR_SYNTAX;return NULL; }while(0)
03230 #define FABORT do{ *piFailure = EX_ERROR_SYNTAX_FATAL;return NULL; }while(0)
03231 #define ARGUMENT pArgument->Parameter.CommandArgument.Argument
03232 #define ASSERT_NON_NULL(x) if( (x) == NULL ){ *piFailure = EX_ERROR_MEMORY_LOW; ABORT; }
03233 
03234 #define NewArgument if( (*ppArgument = new_eNODE()) == NULL ){\
03235                        *piFailure = EX_ERROR_MEMORY_LOW;\
03236                        return NULL;\
03237                        }else{\
03238                        pArgument = *ppArgument;\
03239                        ppArgument = &(pArgument->Parameter.CommandArgument.next);\
03240                        *ppArgument = NULL;\
03241                        }
03242 
03243 /*POD
03244 =H ex_Pragma
03245 
03246 This function implements the compiler directive "declare option".
03247 
03248 When the compiler finds a "declare option" directive it calls this function.
03249 The first argument is the compiler class pointer. The second argument points
03250 to a constant string containing the option.
03251 
03252 The function implements the internal settings of the compiler options reflecting
03253 the programmer needs expressed by the option. For example DeclareVars will
03254 require all variables declared to be either global or local.
03255 
03256 If the programmer specified an option, which is not implemented the error reporting
03257 function is called.
03258 
03259 /*FUNCTION*/
03260 int ex_Pragma(peXobject pEx,
03261               char *pszPragma
03262   ){
03263 /*noverbatim
03264 
03265 The function returns T<0> when the option was processed, and T<1> when not implemented
03266 option was supplied as argument.
03267 CUT*/
03268 
03269   if( ! strcmp(pszPragma,"DeclareVars") ){
03270     DeclareVars = 1;
03271     return 0;
03272     }
03273 
03274   if( ! strcmp(pszPragma,"AutoVars") ){
03275     DeclareVars = 0;
03276     return 0;
03277     }
03278 
03279   if( ! strcmp(pszPragma,"DefaultLocal") ){
03280     DefaultLocal = 1;
03281     return 0;
03282     }
03283 
03284   if( ! strcmp(pszPragma,"DefaultGlobal") ){
03285     DefaultLocal = 0;
03286     return 0;
03287     }
03288 
03289   REPORT(LexemeFileName,LexemeLineNumber,EX_ERROR_UNDEF_PRAGMA,pszPragma);
03290   return 1;
03291   }
03292 
03293 /*POD
03294 =H ex_IsCommandCALL()
03295 
03296 Because the syntax of a call statement is very special here is a special
03297 function to analyze the CALL statement.
03298 
03299 A call statement is a keyword CALL followed by a function call.
03300 
03301 If the function or sub is already defined then the keyword CALL can be missing.
03302 
03303 When the function or sub is called this way and not inseide an expression the
03304 enclosing parentheses can be missing.
03305 
03306 /*FUNCTION*/
03307 peNODE ex_IsCommandCALL(peXobject pEx,
03308                         pLineSyntax p,
03309                         int *piFailure
03310   ){
03311 /*noverbatim
03312 
03313 To get some description of waiting labels see the description of the function R<ex_PushWaitingLabel()>.
03314 
03315 CUT*/
03316 
03317   peNODE pCommandNode,q;
03318   peNODE *ppArgument,pArgument;
03319   char *pszFN;
03320   int iOpened; /* flag to check that there was an opening ( for the arguments */
03321   int PCbeforeNL; /* flag to check that a ) was immediately before the end of the line */
03322   void **pSymbol;
03323   pLexeme pPosition;
03324 
03325   *piFailure = EX_ERROR_SUCCESS;
03326 
03327   ppArgument = &pCommandNode;
03328   pCommandNode = NULL;
03329 
03330   pSymbol = NULL;
03331   if( LexemeType == LEX_T_NSYMBOL && LexemeCode == p->lexes[0].OpCode ){
03332     NextLexeme;
03333     }else{
03334     if( LexemeType == LEX_T_ASYMBOL ){
03335       ex_ConvertName(pszFN=LexemeSymbol, pEx->Buffer,pEx->cbBuffer,pEx);
03336       pSymbol = ex_LookupUserFunction(pEx,0);
03337       if( pSymbol == NULL )ABORT;
03338       }else ABORT;
03339 
03340     }
03341 
03342   /* the function name should come */
03343   if( LexemeType != LEX_T_ASYMBOL )ABORT;
03344 
03345 
03346   if( pSymbol == NULL ){/* pSymbol is NULL here if there was a CALL keyword on the line
03347                            otherwise we have already checked that this symbol was defined
03348                            as a sub or function */
03349     ex_ConvertName(pszFN=LexemeSymbol, pEx->Buffer,pEx->cbBuffer,pEx);
03350     pSymbol = ex_LookupUserFunction(pEx,1);
03351     }
03352   if( *pSymbol == NULL ){
03353     /* This function has not been defined. */
03354     *pSymbol = (void *)new_SymbolUF();
03355     if( *pSymbol == NULL )return NULL;
03356     ((pSymbolUF)*pSymbol)->FunctionName = pszFN;
03357     }
03358 
03359   NextLexeme;
03360   if( LexemeType == LEX_T_NSYMBOL && LexemeCode == CMD_EQ )ABORT; /* this seems to be an assignment */
03361   if( LexemeType == LEX_T_CHARACTER && LexemeChar == '[' )ABORT; /* this seems to be an assignment to an array element */
03362 
03363   /* now we can be sure that this is either a call statement or syntax error */
03364   NewArgument;
03365   q = new_eNODE();
03366   if( q == NULL ){
03367     *piFailure = EX_ERROR_MEMORY_LOW;
03368     return NULL;
03369     }
03370   ARGUMENT.pNode = q;
03371   q->OpCode = eNTYPE_FUN;
03372   q->Parameter.UserFunction.pFunction = (pSymbolUF)(*pSymbol);
03373 
03374   if( LexemeType == LEX_T_CHARACTER && LexemeChar == '(' ){
03375     /* Think about the following subroutine call:
03376 
03377        gotoxy (i+2)/3 , (j+2)/4
03378 
03379        Does it have the form [gotoxy a,b] or [gotoxy(a,b)].
03380        Obviously it is the first, but the expression list starts with a
03381        '(' character that confused the syntax analyzer before v1.0b24.
03382        This piece of code checks that if the expression list starts
03383        with a '(' character that there is or not a ',' out of all
03384        '(' ')' pairs. If there is then the starting '(' starts the first
03385        expression. If not then the '(' starts the expression list.
03386 
03387        The variable iOpened is used to count up and down the opening and
03388        closing parentheses. Finally it contains the number of net opening
03389        parentheses till the first comma or zero in case there is no comma
03390        on the line.
03391      */
03392     lex_SavePosition(pEx->pLex,&pPosition);
03393     iOpened = 0;
03394     while( ! lex_EOF(pEx->pLex) && !(LexemeType == LEX_T_CHARACTER && LexemeChar == '\n') ){
03395       PCbeforeNL = 0;
03396       if( LexemeType == LEX_T_CHARACTER && LexemeChar == '(' )iOpened++;
03397       else
03398       if( LexemeType == LEX_T_CHARACTER && LexemeChar == ')' ){
03399         iOpened--;
03400         PCbeforeNL = 1;
03401         }
03402       else
03403       if( LexemeType == LEX_T_CHARACTER && LexemeChar == ',' && iOpened == 1 ){
03404         goto CommaFound;
03405         }
03406       NextLexeme;
03407       }
03408     /* no comma was found on the command line*/
03409     iOpened = PCbeforeNL;
03410 CommaFound:
03411     lex_RestorePosition(pEx->pLex,&pPosition);
03412     if( iOpened )
03413       NextLexeme;
03414     }else iOpened = 0;
03415 
03416   if( iOpened && LexemeType == LEX_T_CHARACTER && LexemeChar == ')' ){
03417     /* empty parameter list */
03418     q->Parameter.UserFunction.Argument = NULL;
03419     NextLexeme;
03420     if( LexemeType == LEX_T_CHARACTER && LexemeChar == '\n' ){
03421        NextLexeme;
03422        pCommandNode->OpCode = p->CommandOpCode;
03423        return pCommandNode;
03424        }else FABORT;
03425      }
03426 
03427   if( (! iOpened) && LexemeType == LEX_T_CHARACTER && LexemeChar == '\n' ){
03428     q->Parameter.UserFunction.Argument = NULL;
03429     NextLexeme;
03430     pCommandNode->OpCode = p->CommandOpCode;
03431     return pCommandNode;
03432     }
03433 
03434   q->Parameter.UserFunction.Argument = ex_ExpressionList(pEx);
03435   if( q->Parameter.UserFunction.Argument == NULL )FABORT;
03436   if( iOpened ){
03437     if( LexemeType != LEX_T_CHARACTER || LexemeChar != ')' ){
03438       /* the closing ) is missing after function call */
03439       REPORT(LexemeFileName,LexemeLineNumber,EX_ERROR_MISSING_PAREN,NULL);
03440       FABORT;
03441       }else{ NextLexeme; }
03442     }
03443 
03444   /* check that there is nothing else on the line */
03445   if( LexemeType != LEX_T_CHARACTER || LexemeChar != '\n' )FABORT;
03446 
03447   pCommandNode->OpCode = p->CommandOpCode;
03448   return pCommandNode;
03449   }
03450 
03451 /*POD
03452 =H ex_IsCommandOPEN()
03453 
03454 The open statement is a simple one. The only problem is that the last parameter
03455 defining the length of a record is optional. This can only be handled using a separate
03456 function
03457 
03458 /*FUNCTION*/
03459 peNODE ex_IsCommandOPEN(peXobject pEx,
03460                         pLineSyntax p,
03461                         int *piFailure
03462   ){
03463 /*noverbatim
03464 
03465 'open' expression 'for' absolute_symbol 'as' expression 'len' '=' expression nl
03466 
03467 CUT*/
03468   peNODE pCommandNode,q;
03469   peNODE *ppArgument,pArgument;
03470   long sLen;
03471 
03472   *piFailure = EX_ERROR_SUCCESS;
03473 
03474   ppArgument = &pCommandNode;
03475   pCommandNode = NULL;
03476 
03477   /* check the keyword OPEN */
03478   if( LexemeType != EX_LEX_NSYMBOL || LexemeCode != p->lexes[0].OpCode )ABORT;
03479   NextLexeme;
03480 
03481   /* file name */
03482   NewArgument;
03483   ex_Expression_r(pEx,&(ARGUMENT.pNode));
03484   if( ARGUMENT.pNode == NULL )FABORT;
03485 
03486   /* keyword FOR */
03487   if( LexemeType != EX_LEX_NSYMBOL || LexemeCode != p->lexes[2].OpCode )FABORT;
03488   NextLexeme;
03489 
03490   /* FOR what? */
03491   if( LexemeType != LEX_T_ASYMBOL && LexemeType != LEX_T_NSYMBOL )FABORT;
03492   if( LexemeType == LEX_T_ASYMBOL ){
03493     NewArgument;
03494     if( (ARGUMENT.szStringValue = alloc_Alloc((sLen=strlen(LexemeSymbol))+1,pEx->pMemorySegment)) == NULL )ABORT;
03495     strcpy(ARGUMENT.szStringValue,LexemeSymbol);
03496     pArgument->Parameter.CommandArgument.sLen = sLen;
03497     pEx->cbStringTable += sLen+1;
03498     COUNT_STRING_LEN
03499     }else{/* this is to handle absolute symbols that are predefined */
03500     NewArgument;
03501     if( (ARGUMENT.szStringValue = alloc_Alloc((sLen=strlen(lex_SymbolicName(pEx->pLex,LexemeCode)))+1,pEx->pMemorySegment)) == NULL )ABORT;
03502     strcpy(ARGUMENT.szStringValue,lex_SymbolicName(pEx->pLex,LexemeCode));
03503     pArgument->Parameter.CommandArgument.sLen = sLen;
03504     pEx->cbStringTable += strlen(ARGUMENT.szStringValue)+1;
03505     COUNT_STRING_LEN
03506     }
03507   NextLexeme;
03508 
03509   /* AS */
03510   if( LexemeType != EX_LEX_NSYMBOL || LexemeCode != p->lexes[4].OpCode )FABORT;
03511   NextLexeme;
03512   /* optional # after the keyword AS */
03513   if( LexemeType == LEX_T_CHARACTER && LexemeCode == '#' )
03514     NextLexeme;
03515 
03516   /* file number expression */
03517   NewArgument;
03518   ex_Expression_r(pEx,&(ARGUMENT.pNode));
03519   if( ARGUMENT.pNode == NULL )FABORT;
03520 
03521   /* LEN */
03522   if( LexemeType == LEX_T_NSYMBOL && LexemeCode == p->lexes[6].OpCode ){
03523     NextLexeme;
03524     if( LexemeType != LEX_T_NSYMBOL || LexemeCode != p->lexes[7].OpCode )FABORT;
03525     NextLexeme;
03526 
03527     /* record length */
03528     NewArgument;
03529     ex_Expression_r(pEx,&(ARGUMENT.pNode));
03530     if( ARGUMENT.pNode == NULL )FABORT;
03531     }else{
03532     /* no len expression, default expression constant 1 */
03533     NewArgument;
03534     q = new_eNODE();
03535     if( q == NULL ){
03536       *piFailure = EX_ERROR_MEMORY_LOW;
03537       return NULL;
03538       }
03539     ARGUMENT.pNode = q;
03540     q->OpCode = eNTYPE_LNG;
03541     q->Parameter.Constant.Value.lValue = 1;
03542     }
03543 
03544   /* check the new line at the end of the line */
03545   if( LexemeType != LEX_T_CHARACTER || LexemeCode != p->lexes[9].OpCode )FABORT;
03546   NextLexeme;
03547 
03548   pCommandNode->OpCode = p->CommandOpCode;
03549   return pCommandNode;
03550   }
03551 
03552 /*POD
03553 =H ex_IsCommandSLIF()
03554 
03555 If syntax analysis gets to calling this function the command is surely
03556 not single line if, because the command SLIF is recognised by T<IsCommandIF>.
03557 
03558 The syntax of the command IF is presented in the syntax table before
03559 SLIF and therefore if the syntax analyser gets here it can not be
03560 SLIF.
03561 
03562 The original function T<IsCommandThis> could also do failing automatically,
03563 but it is simpler just to fail after the function call, so this function
03564 is just a bit of speedup.
03565 /*FUNCTION*/
03566 peNODE ex_IsCommandSLIF(peXobject pEx,
03567                         pLineSyntax p,
03568                         int *piFailure
03569   ){
03570 /*noverbatim
03571 CUT*/
03572   ABORT;
03573   }
03574 
03575 /*POD
03576 =H ex_IsCommandIF()
03577 
03578 The statement IF is quite simple. However there is another
03579 command that has almost the same syntax as the IF statement.
03580 This is the SLIF, single line IF.
03581 
03582 The difference between the command IF and SLIF is that SLIF does
03583 not have the new line character after the keyword T<THEN>.
03584 
03585 /*FUNCTION*/
03586 peNODE ex_IsCommandIF(peXobject pEx,
03587                         pLineSyntax p,
03588                         int *piFailure
03589   ){
03590 /*noverbatim
03591 
03592 IF/IF:    'if' * expression 'then' go_forward(IF) nl
03593 SLIF/SLIF:  'slif' * expression 'then'
03594 
03595 
03596 CUT*/
03597   peNODE pCommandNode;
03598   peNODE *ppArgument,pArgument;
03599   pSymbolLABEL pLabel;
03600 
03601   *piFailure = EX_ERROR_SUCCESS;
03602 
03603   ppArgument = &pCommandNode;
03604   pCommandNode = NULL;
03605 
03606   /* check the keyword IF */
03607   if( LexemeType != EX_LEX_NSYMBOL || LexemeCode != p->lexes[0].OpCode )ABORT;
03608   NextLexeme;
03609 
03610   /* expression */
03611   NewArgument;
03612   ex_Expression_r(pEx,&(ARGUMENT.pNode));
03613   if( ARGUMENT.pNode == NULL )FABORT;
03614 
03615   /* keyword THEN */
03616   if( LexemeType != EX_LEX_NSYMBOL || LexemeCode != p->lexes[3].OpCode )FABORT;
03617   NextLexeme;
03618 
03619   /* check the new line at the end of the line */
03620   if( LexemeType == LEX_T_CHARACTER && LexemeCode == p->lexes[5].OpCode ){
03621     /* this is an IF statement */
03622     pCommandNode->OpCode = p->CommandOpCode;  
03623     NextLexeme;
03624     NewArgument;
03625     pLabel = (ARGUMENT.pLabel = new_SymbolLABEL());
03626     _ex_PushLabel(pEx,pLabel,CMD_IF,pEx->pMemorySegment);
03627     }else{
03628     /* this is a SLIF statement */
03629     /* There are some restrictions on the commands that may not follow
03630        the SLIF command. These are: */
03631     if( LexemeType == EX_LEX_NSYMBOL &&
03632         ( LexemeCode == KEYWORDCODE_IF      || /* another IF statement    */
03633           LexemeCode == KEYWORDCODE_DECLARE || /* declare sub statement   */
03634           LexemeCode == KEYWORDCODE_MODULE  || /* module statement        */
03635           LexemeCode == KEYWORDCODE_ELSEIF  || /* else if statement       */
03636           LexemeCode == KEYWORDCODE_ELSIF   || /* else if statement       */
03637           LexemeCode == KEYWORDCODE_ELIF    || /* else if statement       */
03638           LexemeCode == KEYWORDCODE_ELSE    || /* else statement          */
03639           LexemeCode == KEYWORDCODE_ENDIF   || /* endif statement         */
03640 
03641           LexemeCode == KEYWORDCODE_GLOBAL  || /* global const            */
03642           LexemeCode == KEYWORDCODE_CONST   || /* const declaration       */
03643           LexemeCode == KEYWORDCODE_LOCAL   || /* local variable          */
03644           LexemeCode == KEYWORDCODE_VAR     || /* variable declaration    */
03645 
03646           LexemeCode == KEYWORDCODE_REPEAT  || /* any loop construct start*/
03647           LexemeCode == KEYWORDCODE_UNTIL   || /*                         */
03648           LexemeCode == KEYWORDCODE_FOR     || /*                         */
03649           LexemeCode == KEYWORDCODE_WHILE   || /*        or               */
03650           LexemeCode == KEYWORDCODE_NEXT    || /*                         */
03651           LexemeCode == KEYWORDCODE_WEND    || /*   end                   */
03652 
03653           LexemeCode == KEYWORDCODE_SUB     || /* subroutine start        */
03654           LexemeCode == KEYWORDCODE_FUNCTION|| /* function start          */
03655           LexemeCode == KEYWORDCODE_END     || /* end if/sub/function etc */
03656           0
03657         ) )FABORT;
03658     pCommandNode->OpCode = CMD_SLIF;
03659     }
03660 
03661   return pCommandNode;
03662   }
03663 
03664 /*POD
03665 =H ex_IsCommandLET()
03666 
03667 /*FUNCTION*/
03668 peNODE ex_IsCommandLET(peXobject pEx,
03669                        pLineSyntax p,
03670                        int *piFailure
03671   ){
03672 /*noverbatim
03673 
03674 CUT*/
03675   peNODE pCommandNode;
03676   peNODE *ppArgument,pArgument;
03677   
03678   *piFailure = EX_ERROR_SUCCESS;
03679 
03680   ppArgument = &pCommandNode;
03681   pCommandNode = NULL;
03682 
03683   if( LexemeType == EX_LEX_NSYMBOL && LexemeCode == KEYWORDCODE_LET )NextLexeme;
03684 
03685   if( LexemeType != LEX_T_ASYMBOL )ABORT; /* this is needed only to ease a bit 
03686                                               syntax defintion table build up. */
03687   NewArgument;
03688   if( (ARGUMENT.pNode = ex_LeftValue(pEx)) == NULL )FABORT;
03689 
03690   if(  LexemeType != EX_LEX_NSYMBOL )FABORT;
03691   switch( LexemeCode ){
03692     case CMD_EQ:
03693       pCommandNode->OpCode = CMD_LET;  
03694       break;
03695     case CMD_EXTOPAG:
03696       pCommandNode->OpCode = CMD_LETP;
03697       break;
03698     case CMD_EXTOPMG:
03699       pCommandNode->OpCode = CMD_LETC;
03700       break;
03701     case CMD_EXTOPHG:
03702       pCommandNode->OpCode = CMD_LETS;
03703       break;
03704     case CMD_EXTOPIG:
03705       pCommandNode->OpCode = CMD_LETD;
03706       break;
03707     case CMD_EXTOPBG:
03708       pCommandNode->OpCode = CMD_LETM;
03709       break;
03710     case CMD_EXTOPNG:
03711       pCommandNode->OpCode = CMD_LETI;
03712       break;
03713     default: FABORT;
03714     }
03715   NextLexeme;
03716 
03717   /* expression */
03718   NewArgument;
03719   ex_Expression_r(pEx,&(ARGUMENT.pNode));
03720   if( ARGUMENT.pNode == NULL )FABORT;
03721 
03722   /* check the new line at the end of the line */
03723   if( LexemeType == LEX_T_CHARACTER && LexemeCode == '\n' )
03724     return pCommandNode;
03725   FABORT;
03726   }

Generated on Sun Mar 12 23:56:28 2006 for ScriptBasic by  doxygen 1.4.6-NO