ChangeLog 19991007-17:00 GMT+2

harbour/ChangeLog

@@ -1,3 +1,29 @@
+19991007-17:00 GMT+2 Ryszard Glab <rglab@imid.med.pl>
+
+    *source/compiler/harbour.y
+    *source/coompiler/expropt.c
+    *include/compiler.h
+	* moved all code related to checking of expressions value type
+	into th enew expropt.c file - it should be a good starting
+	point for the expressions optimalizer
+	* many coorections (rtl_test.prg doesn't GPF now when compiled
+	with -w option) - however this type checking didn't worked correctly
+	and it still doesn't work
+	* moved PSTACK_VAL_TYPE stucture into expropt.c
+
+    *source/compiler/harbour.y
+	* applied changes posted by Eddie Runia to correct compile
+	a:b[ 1 ]:c syntax
+	
+    *source/compiler/Makefile
+    *makefile.b32
+    *makefile.vc
+	* added expropt.c (not tested)
+
+    *source/rtl/dates.c
+	* change in #include (error in Linux)
+	<sys\timeb.h> -> <sys/timeb.h>	
+	
 19991007-09:16 GMT+1 Antonio Linares <alinares@fivetech.com>
    * source/rtl/tclass.prg
      * Method SetType() defaults init value to .f. when AS LOGICAL is specified.

harbour/include/compiler.h

@@ -95,13 +95,6 @@ typedef struct
    int        iCount;      /* number of defined symbols */
 } SYMBOLS;
 
-/* locals, static, public variables support */
-typedef struct _STACK_VAL_TYPE
-{
-   char cType;                      /* type of stack value */
-   struct _STACK_VAL_TYPE * pPrev;    /* pointer to previous stack value's type */
-} STACK_VAL_TYPE, * PSTACK_VAL_TYPE;
-
 extern PFUNCTION GetFunction( char * szFunName ); /* locates a previously defined function */
 extern USHORT      GetFunctionPos( char * szSymbolName ); /* returns the index + 1 of a function on the functions defined list */
 

harbour/makefile.b32

@@ -141,7 +141,7 @@ xsavescr.c   : xsavescr.prg  harbour.exe
   bcc32 $(BCC_OPT) -c -Iinclude -o$@ -DHARBOUR_USE_WIN_GTAPI $<
   tlib lib\b32\harbour.lib -+$@,,
 
-harbour.exe : harboury.c harbourl.c genc.obj genhrb.obj genjava.obj genrc.obj genpas.obj genobj32.obj harbour.obj compiler.h hbppint.c hbpp.c table.c
+harbour.exe : harboury.c harbourl.c genc.obj genhrb.obj genjava.obj genrc.obj genpas.obj genobj32.obj expropt.obj harbour.obj compiler.h hbppint.c hbpp.c table.c
    echo $(BCC_OPT) > temp.bld
    echo -ebin\harbour.exe >> temp.bld
    echo -Iinclude;source\compiler >> temp.bld
@@ -153,6 +153,7 @@ harbour.exe : harboury.c harbourl.c genc.obj genhrb.obj genjava.obj genrc.obj ge
    echo source\compiler\genjava.obj >> temp.bld
    echo source\compiler\genrc.obj >> temp.bld
    echo source\compiler\genpas.obj >> temp.bld
+   echo source\compiler\expropt.obj >> temp.bld
    echo source\compiler\harbour.obj >> temp.bld
    echo source\pp\hbppint.c >> temp.bld
    echo source\pp\hbpp.c >> temp.bld
@@ -192,6 +193,10 @@ genpas.obj : genpas.c
    bcc32 $(BCC_OPT) -c -Iinclude -osource\compiler\genpas.obj \
         source\compiler\genpas.c
 
+expropt.obj : expropt.c
+   bcc32 $(BCC_OPT) -c -Iinclude -osource\compiler\expropt.obj \
+        source\compiler\expropt.c
+
 harbour.obj : harbour.c
    bcc32 $(BCC_OPT) -c -Iinclude;source\compiler -osource\compiler\harbour.obj \
         source\compiler\harbour.c

harbour/makefile.vc

@@ -258,11 +258,12 @@ $(HARBOUR_EXE) : \
     $(COMPILER_DIR)\genrc.c \
     $(COMPILER_DIR)\genjava.c \
     $(COMPILER_DIR)\genpas.c \
+    $(COMPILER_DIR)\expropt.c \
     $(COMPILER_DIR)\harbour.c \
     $(PP_DIR)\hbpp.c \
     $(PP_DIR)\hbppint.c \
     $(PP_DIR)\table.c
-    $(CC) $(CFLAGS) -DHARBOUR_OBJ_GENERATION $(COMPILER_DIR)\harboury.c $(COMPILER_DIR)\harbourl.c $(COMPILER_DIR)\harbour.c $(COMPILER_DIR)\genobj32.c $(COMPILER_DIR)\genc.c $(COMPILER_DIR)\genhrb.c $(COMPILER_DIR)\genrc.c $(COMPILER_DIR)\genjava.c $(COMPILER_DIR)\genpas.c $(PP_DIR)\hbppint.c $(PP_DIR)\hbpp.c $(PP_DIR)\table.c -o $(BIN_DIR)\harbour
+    $(CC) $(CFLAGS) -DHARBOUR_OBJ_GENERATION $(COMPILER_DIR)\harboury.c $(COMPILER_DIR)\harbourl.c $(COMPILER_DIR)\harbour.c $(COMPILER_DIR)\genobj32.c $(COMPILER_DIR)\genc.c $(COMPILER_DIR)\genhrb.c $(COMPILER_DIR)\genrc.c $(COMPILER_DIR)\genjava.c $(COMPILER_DIR)\genpas.c $(COMPILER_DIR)\expropt.c $(PP_DIR)\hbppint.c $(PP_DIR)\hbpp.c $(PP_DIR)\table.c -o $(BIN_DIR)\harbour
     @Echo :	Ignore Lnk4033 warning
     -del harboury.obj
     -del harbourl.obj
@@ -276,6 +277,7 @@ $(HARBOUR_EXE) : \
     -del genrc.obj
     -del genjava.obj
     -del genpas.obj
+    -del expropt.obj
 
 #
 # Library dependencies and build rules

harbour/source/compiler/Makefile

@@ -28,6 +28,7 @@ C_SOURCES=\
         genobj32.c \
         genpas.c \
         genrc.c \
+	expropt.c \
 
 C_MAIN=harbour.c
 

harbour/source/compiler/expropt.c

@@ -0,0 +1,255 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <ctype.h>
+#include "extend.h"
+#include "compiler.h"
+#include "hberrors.h"
+
+extern int _iWarnings;
+extern char *_szCWarnings[];
+
+typedef struct
+{
+   char cType;
+}
+STACK_VAL_TYPE, * PSTACK_VAL_TYPE;
+
+
+static PSTACK_VAL_TYPE pStackValType = NULL; /* compile time stack values linked list */
+static long lStackTop = 0;
+static long lStackLen;
+
+#define debug_msg2( x, y )
+#define debug_msg( x )
+
+
+void ValTypePush( char cType )
+{
+   if( _iWarnings )
+   {
+      if( pStackValType == NULL )
+      {
+         lStackTop =1;     /* start from the one */
+         lStackLen =64;
+         pStackValType =(PSTACK_VAL_TYPE)hb_xgrab( sizeof( STACK_VAL_TYPE ) * lStackLen );
+      }
+      else if( lStackTop == lStackLen )
+      {
+         lStackLen +=64;
+         pStackValType = ( PSTACK_VAL_TYPE ) hb_xrealloc( pStackValType, sizeof( STACK_VAL_TYPE ) * lStackLen );
+      }
+
+      pStackValType[ lStackTop++ ].cType = cType;
+
+      debug_msg2( "\nValTypePush( %c )", cType );
+   }
+}
+
+void ValTypePop( int iCount )
+{
+   if( _iWarnings )
+   {
+      debug_msg2( "\nValTypePop( %i )", iCount );
+      if( lStackTop )
+      {
+         while( lStackTop && iCount-- )
+            --lStackTop;
+      }
+      else
+         debug_msg( "\nValTypePop() Compile time stack underflow\n");
+   }
+}
+
+void ValTypePlus( void )
+{
+   if( _iWarnings )
+   {
+      debug_msg( "\nValTypePlus()" );
+
+      if( lStackTop > 2 )  /* at least two expressions are required */
+      {
+         PSTACK_VAL_TYPE pOperand1 = NULL, pOperand2;
+         char sType1[ 2 ], sType2[ 2 ], cType = ' ';
+
+         --lStackTop;
+         pOperand2 = pStackValType + lStackTop;
+         sType2[ 0 ] = pOperand2->cType;
+         sType2[ 1 ] = '\0';
+
+         /* skip back to the 1st. operand */
+         pOperand1 = pStackValType + lStackTop - 1;
+         sType1[ 0 ] = pOperand1->cType;
+         sType1[ 1 ] = '\0';
+
+         /* TODO: Adding numerical to date
+         *
+         */
+         if( pOperand1->cType != ' ' && pOperand2->cType != ' ' && pOperand1->cType != pOperand2->cType )
+            GenWarning( _szCWarnings, 'W', WARN_OPERANDS_INCOMPATBLE, sType1, sType2 );
+         else if( pOperand2->cType != ' ' && pOperand1->cType == ' ' )
+            GenWarning( _szCWarnings, 'W', WARN_OPERAND_SUSPECT, sType2, NULL );
+         else if( pOperand1->cType != ' ' && pOperand2->cType == ' ' )
+            GenWarning( _szCWarnings, 'W', WARN_OPERAND_SUSPECT, sType1, NULL );
+         else
+            cType = pOperand1->cType;
+
+         /* compile time 1st. operand has to be released *but* result will be pushed and type as calculated */
+         pOperand1->cType = cType;
+      }
+      else
+         debug_msg( " Compile time stack underflow" );
+   }
+}
+
+void ValTypeRelational( void )
+{
+   if( _iWarnings )
+   {
+      debug_msg( "\nValTypeRelational()" );
+
+      if( lStackTop > 2 )  /* at least two expressions are required */
+      {
+         PSTACK_VAL_TYPE pOperand1 = NULL, pOperand2;
+         char sType1[ 2 ], sType2[ 2 ];
+
+         /* 2nd. Operand (stack top)*/
+         --lStackTop;
+         pOperand2 = pStackValType + lStackTop;
+         sType2[ 0 ] = pOperand2->cType;
+         sType2[ 1 ] = '\0';
+
+         /* skip back to the 1st. operand */
+         pOperand1 = pStackValType + lStackTop - 1;
+         sType1[ 0 ] = pOperand1->cType;
+         sType1[ 1 ] = '\0';
+
+         if( pOperand1->cType != ' ' && pOperand2->cType != ' ' && pOperand1->cType != pOperand2->cType )
+            GenWarning( _szCWarnings, 'W', WARN_OPERANDS_INCOMPATBLE, sType1, sType2 );
+         else if( pOperand2->cType != ' ' && pOperand1->cType == ' ' )
+            GenWarning( _szCWarnings, 'W', WARN_OPERAND_SUSPECT, sType2, NULL );
+         else if( pOperand1->cType != ' ' && pOperand2->cType == ' ' )
+            GenWarning( _szCWarnings, 'W', WARN_OPERAND_SUSPECT, sType1, NULL );
+
+         /* compile time 1st. operand has to be released *but* result will be pushed and of type logical */
+         pOperand1->cType = 'L';
+      }
+      else
+         debug_msg( " Compile time stack underflow" );
+   }
+}
+
+void ValTypeCheck( char cExpected, int iExpWarning, int iSuspWarning )
+{
+   if( _iWarnings )
+   {
+      if( lStackTop )
+      {
+         if(  pStackValType[ lStackTop - 1 ].cType == ' ' )
+            GenWarning( _szCWarnings, 'W', iSuspWarning, NULL, NULL );
+         else if( pStackValType[ lStackTop -1  ].cType != cExpected )
+         {
+            char sType[ 2 ];
+
+            sType[ 0 ] = pStackValType[ lStackTop -1 ].cType;
+            sType[ 1 ] = '\0';
+
+            GenWarning( _szCWarnings, 'W', iExpWarning, sType, NULL );
+         }
+      }
+      else
+         debug_msg2( "\nValTypeCheck( %c ) Compile time stack underflow", cExpected );
+   }
+}
+
+void ValTypeCheck2( char cExpected, int iExpWarning, int iSuspWarning )
+{
+   if( _iWarnings )
+   {
+      debug_msg2( "\nValTypeCheck2( %c )", cExpected );
+
+      if( lStackTop > 2 )  /* at least two expressions are required */
+      {
+         PSTACK_VAL_TYPE pOperand1 = NULL, pOperand2;
+         char sType1[ 2 ], sType2[ 2 ];
+
+         /* 2nd. Operand (stack top)*/
+         pOperand2 = pStackValType + lStackTop - 1;
+         sType2[ 0 ] = pOperand2->cType;
+         sType2[ 1 ] = '\0';
+
+         /* skip back to the 1st. operand */
+         pOperand1 = pStackValType + lStackTop - 2;
+         sType1[ 0 ] = pOperand1->cType;
+         sType1[ 1 ] = '\0';
+
+         if( pOperand1->cType != cExpected && pOperand1->cType != ' ' )
+            GenWarning( _szCWarnings, 'W', iExpWarning, sType1, NULL );
+         else if( pOperand1->cType == ' ' )
+            GenWarning( _szCWarnings, 'W', iSuspWarning, NULL, NULL );
+
+         if( pOperand2->cType != cExpected && pOperand2->cType != ' ' )
+            GenWarning( _szCWarnings, 'W', iExpWarning, sType2, NULL );
+         else if( pOperand2->cType == ' ' )
+            GenWarning( _szCWarnings, 'W', iSuspWarning, NULL, NULL );
+      }
+      else
+         debug_msg( " Compile time stack underflow" );
+   }
+}
+
+
+char ValTypeGet( )
+{
+   return  (lStackTop > 1) ? pStackValType[ lStackTop - 1 ].cType : 0;
+}
+
+void ValTypePut( char cType )
+{
+   if( _iWarnings )
+   {
+      if( lStackTop > 1 )
+         /* reusing the place holder of the result value */
+         pStackValType[ lStackTop - 1 ].cType = cType;
+      else
+         debug_msg( "\nValTypePut() Compile time stack underflow\n" );
+   }
+}
+
+void ValTypeAssign( char *szVarName )
+{
+   if( _iWarnings )
+   {
+      if( lStackTop > 2 )  /* at least two expressions are required */
+      {
+         PSTACK_VAL_TYPE pLeft= NULL, pRight;
+         char sType1[ 2 ], sType2[ 2 ];
+
+         /* 2nd. Operand (stack top)*/
+         --lStackTop;
+         pRight = pStackValType + lStackTop;
+         sType2[ 0 ] = pRight->cType;
+         sType2[ 1 ] = '\0';
+
+         /* skip back to the 1st. operand */
+         --lStackTop;
+         pLeft = pStackValType + lStackTop;
+         sType1[ 0 ] = pLeft->cType;
+         sType1[ 1 ] = '\0';
+
+         if( pRight->cType != ' ' && pLeft->cType == ' ' )
+            GenWarning( _szCWarnings, 'W', WARN_ASSIGN_SUSPECT, szVarName, sType2 );
+         else if( pRight->cType != ' ' && pRight->cType != pLeft->cType )
+            GenWarning( _szCWarnings, 'W', WARN_ASSIGN_TYPE, szVarName, sType1 );
+      }
+      else
+         debug_msg( "\nValTypeAssign() Compile time stack underflow\n" );
+   }
+}
+
+void ValTypeReset( void )
+{
+   /* Clear the compile time stack values (should be empty at this point) */
+   if( lStackTop > 1 )
+      debug_msg2( "\n* *Compile time stack overflow: %i\n", lStackTop );
+   lStackTop =1;  /* first position to store a value */
+}

harbour/source/rtl/dates.c

@@ -73,7 +73,11 @@
 
 #include <ctype.h>
 #include <time.h>
+#if defined( OS_UNIX_COMPATIBLE )
+#include <sys/timeb.h>
+#else
 #include <sys\timeb.h>
+#endif
 #if defined(__TURBOC__) || defined(__BORLANDC__)  || defined(__DJGPP__)
    #include <dos.h>
 #endif