fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

2000-07-25 09:30 UTC+0800 Ron Pinkas <ron@profit-master.com>

Browse Source 
* 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
This commit is contained in:
Ron Pinkas
2000-07-25 16:36:02 +00:00
parent f14fbd7510
commit c552e00b51
6 changed files with 208 additions and 13 deletions
Download Patch File Download Diff File Expand all files Collapse all files

21
harbour/ChangeLog
View File

@@ -1,8 +1,21 @@
2000-07-25 09:30 UTC+0800 Ron Pinkas <ron@profit-master.com>
* 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 <info@szelvesz.hu>
* 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.

10
harbour/contrib/hb_struc/hbstruc.ch Normal file
View File

@@ -0,0 +1,10 @@
#ifndef HB_STRUCTURE
#define HB_STRUCTURE
#COMMAND STRUCTURE <StruName> <Var1> <x1:AS CLASS,AS STRUCTURE,AS STRU,AS ARRAY OF,AS> <Type1> [, <VarN> <xN:AS CLASS,AS STRUCTURE,AS STRU,AS ARRAY OF,AS> <TypeN> ] => ;
STATIC __<StruName> := {|| IF( __<StruName> == NIL, , ) , HB_Structure( <"StruName">, { <"Var1"> [, <"VarN">] } )} ;;
DECLARE <StruName> <Var1> <x1> <Type1> [ <VarN> <xN> <TypeN> ] ;;
#TRANSLATE AS NEW <StruName> => AS STRUCTURE <StruName> := ( Eval( __<StruName> ), HB_Structure( <"StruName"> ) )
#endif

100
harbour/contrib/hb_struc/hbstruc.prg Normal file
View File

@@ -0,0 +1,100 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* Base Class for internal handling of class creation
*
* Copyright 2000 Ron Pinkas <Ron@Profit-Master.com>
* 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 )

29
harbour/contrib/hb_struc/teststru.prg Normal file
View File

@@ -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

10
harbour/hb_slex.bc
View File

@@ -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) -+$@,,

51
harbour/source/compiler/harbour.slx
View File

@@ -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;