diff --git a/harbour/ChangeLog b/harbour/ChangeLog index e7892fc43c..0a350ace90 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,8 +1,21 @@ +2000-07-25 09:30 UTC+0800 Ron Pinkas + * hb_slex.bc + * Sinchronized with recent changes to makefile.bc + + Added ;source\compiler to $(INCLUDE) + + * source/compiler/harbour.slx + + Added logic to support 2 imediately following identifiers as needed by: DECLARE ClassName ClassVar ... + + + contrib/hb_struc + + contrib/hb_struc/hbstruc.ch + + contrib/hb_struc/hbstruc.prg + + contrib/hb_struc/teststru.prg + 2000-07-25 13:47 UTC+0100 Victor Szakats * source/rtl/errorapi.c * include/hbapierr.h - + hb_errRT_BASE_SubstR() added, which will automatically return the + + hb_errRT_BASE_SubstR() added, which will automatically return the substituted value. * source/rtl/abs.c @@ -35,7 +48,7 @@ * source/vm/memvars.c * source/vm/runner.c % hb_errRT_BASE_Subst() -> hb_itemReturn() -> hb_itemRelease() constructs - replaced with a simple call to hb_errRT_BASE_SubstR(), this way many + replaced with a simple call to hb_errRT_BASE_SubstR(), this way many local variables were removed, the code got smaller and a bit faster. The error handling code in the RTL functions is very simple now. @@ -119,8 +132,8 @@ converted to this smaller and faster one: hb_itemRelease/Clear( hb_itemReturn( x ) ); - Actually the speed increase and binary size decrease is almost zero, - but the source code is more compact. This snippet is mostly found in + Actually the speed increase and binary size decrease is almost zero, + but the source code is more compact. This snippet is mostly found in runtime error branches. Some local variables could be eliminated this way. diff --git a/harbour/contrib/hb_struc/hbstruc.ch b/harbour/contrib/hb_struc/hbstruc.ch new file mode 100644 index 0000000000..3145d083d2 --- /dev/null +++ b/harbour/contrib/hb_struc/hbstruc.ch @@ -0,0 +1,10 @@ +#ifndef HB_STRUCTURE + + #define HB_STRUCTURE + + #COMMAND STRUCTURE [, ] => ; + STATIC __ := {|| IF( __ == NIL, , ) , HB_Structure( <"StruName">, { <"Var1"> [, <"VarN">] } )} ;; + DECLARE [ ] ;; + #TRANSLATE AS NEW => AS STRUCTURE := ( Eval( __ ), HB_Structure( <"StruName"> ) ) + +#endif diff --git a/harbour/contrib/hb_struc/hbstruc.prg b/harbour/contrib/hb_struc/hbstruc.prg new file mode 100644 index 0000000000..07f456656f --- /dev/null +++ b/harbour/contrib/hb_struc/hbstruc.prg @@ -0,0 +1,100 @@ +/* + * $Id$ + */ + +/* + * Harbour Project source code: + * Base Class for internal handling of class creation + * + * Copyright 2000 Ron Pinkas + * www - http://www.harbour-project.org + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version, with one exception: + * + * The exception is that if you link the Harbour Runtime Library (HRL) + * and/or the Harbour Virtual Machine (HVM) with other files to produce + * an executable, this does not by itself cause the resulting executable + * to be covered by the GNU General Public License. Your use of that + * executable is in no way restricted on account of linking the HRL + * and/or HVM code into it. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit + * their web site at http://www.gnu.org/). + * + */ + +#include "hbstruc.ch" + +//----------------------------------------------------------------------------// + +Function HB_Structure( cStructureName AS Char, aMembers AS Array OF Char ) + + STRUCTURE HB_Structure cName AS Char, hId As Num + + DECLARE __ClsNew( ClassName AS Char, N As Num ) AS Num + DECLARE __ClsAddMsg( H AS Num, Data AS Char, ID As Num, Type As Num ) AS Num + DECLARE __ClsInst( H AS Num ) AS Structure HB_Structure + + LOCAL hStructure AS Num, nCounter AS Num, nMembers AS Num + + STATIC asStructures AS Array OF Structure HB_Structure := {} + + STATIC sStructure AS Stru HB_Structure + + LOCAL hSelf As Num + + cStructureName := Upper( cStructureName ) + + hStructure := aScan( asStructures, { |aStructure| aStructure:cName == cStructureName } ) + + IF aMembers == NIL + IF hStructure == 0 + //hb_Structure( cStructureName, {} ) + RETURN NIL //hb_Structure( cStructureName ) + ELSE + RETURN __ClsInst( asStructures[ hStructure ]:hId ) + ENDIF + ELSE + IF hStructure > 0 + // Duplicate declaration + RETURN NIL + ENDIF + ENDIF + + nMembers := Len( aMembers ) + + hStructure := __ClsNew( cStructureName, nMembers ) + + FOR nCounter := 1 TO nMembers + __clsAddMsg( hStructure, aMembers[nCounter], nCounter, 1 ) + __clsAddMsg( hStructure, '_' + aMembers[nCounter], nCounter, 1 ) + NEXT + + IF sStructure == NIL + hSelf := __ClsNew( "HB_Structure", 2 ) + + __clsAddMsg( hSelf, "cName", 1, 1 ) + __clsAddMsg( hSelf, "_cName", 1, 1 ) + __clsAddMsg( hSelf, "hID", 2, 1 ) + __clsAddMsg( hSelf, "_hID", 2, 1 ) + + sStructure := __ClsInst( hSelf ) + ENDIF + + sStructure:cName := cStructureName + sStructure:hId := hStructure + + aAdd( asStructures, sStructure ) + +RETURN NIL //__clsInst( hStructure ) + diff --git a/harbour/contrib/hb_struc/teststru.prg b/harbour/contrib/hb_struc/teststru.prg new file mode 100644 index 0000000000..74a94bcfa3 --- /dev/null +++ b/harbour/contrib/hb_struc/teststru.prg @@ -0,0 +1,29 @@ +REQUEST HBSTRUC +#INCLUDE "HBSTRUC.CH" + +STRUCTURE MyStruct Var1 As Char, Var2 As Num, sNext AS Stru MyStruct + +STRUCTURE OtherStruct sNested As Stru MyStruct, sNext AS Structure OtherStruct + +PROCEDURE MAIN() + + LOCAL sTest AS New MyStruct, sTest2 As New OtherStruct + + sTest:Var1 := 'Working' // No problem here. (Var1 of myStruct is Char) + + ? sTest:Var1 // No Problem here. + + sTest:Var1 := 8 // Warning Here as Expected. -> Var1 of MyStruct is Char not Num + + sTest2:sNested:Var1 := 8 // Warning Here Expected -> Var1 of MyStruct is Char not Num + + sTest2:sNested:sNext := 8 // Warning Here Expected -> sNext of MyStruct is MyStruct not Num + + + /* Run TIME ERROR Here */ + sTest2:sNested:sNested := 8 // Warning Here Expected -> MyStruct has no sNested Var + + /* Run TIME ERROR Here */ + sTest:NoSuchVar := "Error" // Warning here as expected. -> MyStruct has no NoSuchVar Var. + +RETURN diff --git a/harbour/hb_slex.bc b/harbour/hb_slex.bc index 0956280e5a..5f44ea5e97 100644 --- a/harbour/hb_slex.bc +++ b/harbour/hb_slex.bc @@ -70,7 +70,7 @@ CFLAGS = -O2 $(CFLAGS) # Directory macros. These should never have to change. # -INCLUDE_DIR = include +INCLUDE_DIR = include;source\compiler COMMON_DIR = source\common COMPILER_DIR = source\compiler DEBUG_DIR = source\debug @@ -337,6 +337,7 @@ LANG_LIB_OBJS = \ $(OBJ_DIR)\msghuwin.obj \ $(OBJ_DIR)\msgis850.obj \ $(OBJ_DIR)\msgit.obj \ + $(OBJ_DIR)\msgko.obj \ $(OBJ_DIR)\msgpt.obj \ $(OBJ_DIR)\msgro.obj \ $(OBJ_DIR)\msgsr852.obj \ @@ -520,8 +521,7 @@ HARBOUR_EXE_OBJS = \ $(OBJ_DIR)\exproptb.obj \ $(OBJ_DIR)\exproptc.obj \ $(OBJ_DIR)\hbfunchk.obj \ - $(OBJ_DIR)\ppcore.obj \ - $(OBJ_DIR)\ppcomp.obj + $(PP_LIB) # # HBRUN.EXE rules @@ -1767,6 +1767,10 @@ $(OBJ_DIR)\msgit.obj : $(LANG_DIR)\msgit.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(LANG_LIB) $(ARFLAGS) -+$@,, +$(OBJ_DIR)\msgko.obj : $(LANG_DIR)\msgko.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(LANG_LIB) $(ARFLAGS) -+$@,, + $(OBJ_DIR)\msgpt.obj : $(LANG_DIR)\msgpt.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(LANG_LIB) $(ARFLAGS) -+$@,, diff --git a/harbour/source/compiler/harbour.slx b/harbour/source/compiler/harbour.slx index c5d4916117..a521257a00 100644 --- a/harbour/source/compiler/harbour.slx +++ b/harbour/source/compiler/harbour.slx @@ -52,6 +52,8 @@ static int iTexts = 0; static char * aTexts[1024]; +static int iIdentifier = 0; +static char* sIdOnHold; long hb_lex_Hex2L( char* sHex ); @@ -64,7 +66,7 @@ DELIMITER_BELONGS_TO_TOKEN_IF_ONE_OF_THESE( "" ); /* Custom Action can be requested by setting reduction to LEX_CUSTOM_ACTION or lower. */ -/* Intermediate Token neede to be expanded. */ +/* Intermediate Token needed to be expanded. */ #define HB_LIT_ACT -1000 /* Stream Pairs. */ @@ -207,7 +209,7 @@ LANGUAGE_WORDS_ARE { LEX_WORD( "STRING" ) AS_TOKEN( _STRING_ ), LEX_WORD( "CLASS" ) AS_TOKEN( _CLASS_ ), LEX_WORD( "STRUCTURE" ) AS_TOKEN( _STRUCTURE_ ), - /* LEX_WORD( "STRU" ) AS_TOKEN( _CLASS_ ), */ + /* LEX_WORD( "STRU" ) AS_TOKEN( _STRUCTURE_ ), */ LEX_WORD( "DATE" ) AS_TOKEN( _DATE_ ), LEX_WORD( "LOGICAL" ) AS_TOKEN( _LOGICAL_ ), LEX_WORD( "BOOLEAN" ) AS_TOKEN( _LOGICAL_ ), @@ -278,6 +280,9 @@ LANGUAGE_WORDS_ARE { #define HB_RETURN_ID -1054 #define HB_END_ID -1055 +/* When 2 identifiers are correct syntax like in class declaration, we have to temporarily store the 2nd identifier. */ +#define HB_ID_ON_HOLD -1056 + /* Intermediate Reductions when still ambigious or need further reductions. */ #define _WHILE_WITH 3001 #define _ID_ARRAY 3002 @@ -888,6 +893,11 @@ LANGUAGE_RULES_ARE { #undef INTERCEPT_ACTION #define INTERCEPT_ACTION(x) \ \ + if( x == IDENTIFIER ) \ + { \ + iIdentifier--; \ + } \ + \ if( x == IDENTIFIER ) \ printf( " IDENTIFIER = \"%s\"\n", yylval.string ); \ else if( x == LITERAL ) \ @@ -909,6 +919,14 @@ LANGUAGE_RULES_ARE { printf( " DELIMITER = \"%c\"\n", x ); \ else \ printf( " TOKEN = %i\n", x ); +#else + #undef INTERCEPT_ACTION + #define INTERCEPT_ACTION(x) \ + \ + if( x == IDENTIFIER ) \ + { \ + iIdentifier--; \ + } #endif /* Support Functions implemented as macros for speed. */ @@ -981,8 +999,17 @@ LANGUAGE_RULES_ARE { {\ DEBUG_INFO( printf( "Element \"%s\" is IDENTIFIER\n", yytext ) );\ \ - yylval.string = hb_compIdentifierNew( yytext, TRUE );\ - iRet = IDENTIFIER; \ + if( iIdentifier )\ + {\ + sIdOnHold = hb_compIdentifierNew( yytext, TRUE );\ + iRet = HB_ID_ON_HOLD;\ + }\ + else\ + {\ + iIdentifier++;\ + yylval.string = hb_compIdentifierNew( yytext, TRUE );\ + iRet = IDENTIFIER;\ + }\ }\ }\ else\ @@ -1079,6 +1106,8 @@ LANGUAGE_RULES_ARE { #undef CUSTOM_ACTION #define CUSTOM_ACTION(x) \ +{\ + BOOL bRestored = FALSE;\ \ DEBUG_INFO( printf( "Custom Action for %i\n", x ) );\ \ @@ -1090,6 +1119,13 @@ LANGUAGE_RULES_ARE { \ switch ( x )\ {\ + case HB_ID_ON_HOLD :\ + bRestored = TRUE;\ + yylval.string = sIdOnHold;\ + iIdentifier++;\ + x = IDENTIFIER;\ + break;\ +\ case HB_LIT_ACT :\ yylval.string = hb_compIdentifierNew( sPair, TRUE );\ x = LITERAL;\ @@ -1417,16 +1453,19 @@ LANGUAGE_RULES_ARE { printf( "No Handler for Custom Action %i\n", x );\ }\ \ - if( x == IDENTIFIER )\ + if( x == IDENTIFIER && ! bRestored )\ {\ yylval.string = hb_compIdentifierNew( yytext, TRUE );\ \ /* No longer needed. */\ hb_xfree( yytext );\ +\ + iIdentifier++;\ \ PUSH_TOKEN( IDENTIFIER );\ x = 0;\ - } + }\ +} #undef INIT_ACTION #define INIT_ACTION() hb_comp_bSimpLex = TRUE;