diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 9a292b76a7..dfefbb0ac8 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,33 @@ +2000-05-22 10:40 UTC-800 Ron Pinkas + + * include/hbvmpub.h + * Modified HB_FS_FIRST to ( ( HB_SYMBOLSCOPE ) 0x04 ) + + * source/compiler/harbour.c + * Minor optimization when storing HB_FS_FIRST + + * source/pp/pptable.c + - Removed built-in rule, for STRUCTURE support + + * source/vm/runner.c + ! Fixed bug when there is no startup procedure + + * source/rtl/tclass.prg + - Removed HB_Structure() + + * include/hbextern.ch + * Moved EXTERNAL HB_STRUCTURE to separate section + + * tests/teststru.prg + + added #INCLUDE "..\Include\HBSTRUC.CH" + + + include/hbstruc.ch + + + source/rtl/hbstruc.prg + + * makefile.bc + + Added rules for hbstruc.prg + 2000-05-25 12:45 UTC-0400 David G. Holm * source/rtl/tgetlist.prg diff --git a/harbour/include/hbextern.ch b/harbour/include/hbextern.ch index 79c5813da6..26404797ca 100644 --- a/harbour/include/hbextern.ch +++ b/harbour/include/hbextern.ch @@ -673,6 +673,9 @@ EXTERNAL TBROWSENEW //symbols from file: rtl\tclass.prg // EXTERNAL TCLASS +// +// Structure support +// EXTERNAL HB_STRUCTURE // //symbols from file: rtl\text.prg diff --git a/harbour/include/hbstruc.ch b/harbour/include/hbstruc.ch new file mode 100644 index 0000000000..3145d083d2 --- /dev/null +++ b/harbour/include/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/include/hbvmpub.h b/harbour/include/hbvmpub.h index 4591529523..f9092b4b41 100644 --- a/harbour/include/hbvmpub.h +++ b/harbour/include/hbvmpub.h @@ -75,11 +75,11 @@ typedef HB_DYNS_FUNC( PHB_DYNS_FUNC ); /* Harbour Functions scope ( HB_SYMBOLSCOPE ) */ #define HB_FS_PUBLIC ( ( HB_SYMBOLSCOPE ) 0x00 ) #define HB_FS_STATIC ( ( HB_SYMBOLSCOPE ) 0x02 ) +#define HB_FS_FIRST ( ( HB_SYMBOLSCOPE ) 0x04 ) #define HB_FS_INIT ( ( HB_SYMBOLSCOPE ) 0x08 ) #define HB_FS_EXIT ( ( HB_SYMBOLSCOPE ) 0x10 ) #define HB_FS_INITEXIT ( HB_FS_INIT | HB_FS_EXIT ) #define HB_FS_MESSAGE ( ( HB_SYMBOLSCOPE ) 0x20 ) -#define HB_FS_FIRST ( ( HB_SYMBOLSCOPE ) 0x40 ) #define HB_FS_MEMVAR ( ( HB_SYMBOLSCOPE ) 0x80 ) extern void hb_vmExecute( const BYTE * pCode, PHB_SYMB pSymbols ); /* invokes the virtual machine */ diff --git a/harbour/makefile.bc b/harbour/makefile.bc index b18528a267..5a5b07fbec 100644 --- a/harbour/makefile.bc +++ b/harbour/makefile.bc @@ -276,6 +276,7 @@ RTL_LIB_OBJS = \ $(OBJ_DIR)\fieldbl.obj \ $(OBJ_DIR)\getlist.obj \ $(OBJ_DIR)\getsys.obj \ + $(OBJ_DIR)\hbstruc.obj \ $(OBJ_DIR)\input.obj \ $(OBJ_DIR)\memoedit.obj \ $(OBJ_DIR)\memvarbl.obj \ @@ -1153,6 +1154,13 @@ $(OBJ_DIR)\hardcr.obj : $(RTL_DIR)\hardcr.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(RTL_LIB) $(ARFLAGS) -+$@,, +$(OBJ_DIR)\hbstruc.c : $(RTL_DIR)\hbstruc.prg + $(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@ + +$(OBJ_DIR)\hbstruc.obj : $(OBJ_DIR)\hbstruc.c + $(CC) $(CLIBFLAGS) -o$@ $** + tlib $(RTL_LIB) $(ARFLAGS) -+$@,, + $(OBJ_DIR)\inkey.obj : $(RTL_DIR)\inkey.c $(CC) $(CLIBFLAGS) -o$@ $** tlib $(RTL_LIB) $(ARFLAGS) -+$@,, diff --git a/harbour/source/compiler/harbour.c b/harbour/source/compiler/harbour.c index 7fdac999ad..eef84f9f0b 100644 --- a/harbour/source/compiler/harbour.c +++ b/harbour/source/compiler/harbour.c @@ -272,25 +272,20 @@ int main( int argc, char * argv[] ) { PCOMSYMBOL pSym = hb_comp_symbols.pFirst; + char * szFirstFunction ; + + if( hb_comp_bStartProc ) + szFirstFunction = hb_comp_functions.pFirst->szName ; + else if( hb_comp_functions.pFirst->pNext ) + szFirstFunction = hb_comp_functions.pFirst->pNext->szName ; + while( pSym ) { - if( hb_comp_bStartProc ) + if( strcmp( pSym->szName, szFirstFunction ) == 0 ) { - if( strcmp( pSym->szName, hb_comp_functions.pFirst->szName ) == 0 ) - { - pSym->cScope |= HB_FS_FIRST; - break; - } + pSym->cScope |= HB_FS_FIRST; + break; } - else if( hb_comp_functions.pFirst->pNext ) - { - if( strcmp( pSym->szName, hb_comp_functions.pFirst->pNext->szName ) == 0 ) - { - pSym->cScope |= HB_FS_FIRST; - break; - } - } - pSym = pSym->pNext; } } diff --git a/harbour/source/pp/pptable.c b/harbour/source/pp/pptable.c index 1c4924af13..196aea0003 100644 --- a/harbour/source/pp/pptable.c +++ b/harbour/source/pp/pptable.c @@ -389,7 +389,10 @@ static COMMANDS sC___236 = {0,"SET","INDEX TO [ \1A40 [, \1B40]] [\1C20 ADDITIVE static COMMANDS sC___237 = {0,"SET","ORDER TO \1A00 [IN \1B40]","ordSetFocus( \1A00 [, \1B30] )",&sC___236 }; static COMMANDS sC___238 = {0,"SET","ORDER TO TAG \1A40 [IN \1B40]","ordSetFocus( \1A30 [, \1B30] )",&sC___237 }; static COMMANDS sC___239 = {0,"SET","ORDER TO","ordSetFocus(0)",&sC___238 }; + +/* static COMMANDS sC___240 = {0,"STRUCTURE","\1A00 \1B00 \1C20:AS CLASS,AS STRUCTURE,AS STRU,AS ARRAY OF,AS> \1D00 [, \1E00 \1F20:AS CLASS,AS STRUCTURE,AS STRU,AS ARRAY OF,AS> \1G00 ]","STATIC __\1A00 := {|| IF(__\1A00 == NIL, , ) ,hb_structure( \1A20, { \1B20 [, \1E20] } )} ; DECLARE \1A00 \1B00 \1C00 \1D00 [ \1E00 \1F00 \1G00 ] ; #translate AS NEW \1A00 => AS CLASS \1A00 := ( Eval(__\1A00), hb_Structure( \1A20 ) )",&sC___239 }; +*/ /* #COMMAND STRUCTURE [, ] => ; @@ -398,7 +401,9 @@ static COMMANDS sC___240 = {0,"STRUCTURE","\1A00 \1B00 \1C20:AS CLASS,AS STRUCTU #TRANSLATE AS NEW => AS STRUCTURE := ( Eval( __ ), HB_Structure( <"StruName"> ) ) */ +/* static COMMANDS sT___1 = {0,"AS","NEW \1A00","AS CLASS \1A00 := \1A00():New()",NULL }; +*/ -COMMANDS * hb_pp_topCommand = &sC___240; -COMMANDS * hb_pp_topTranslate = &sT___1; +COMMANDS * hb_pp_topCommand = &sC___239 /*&sC___240*/; +COMMANDS * hb_pp_topTranslate = NULL /*&sT___1*/; diff --git a/harbour/source/rtl/hbstruc.prg b/harbour/source/rtl/hbstruc.prg new file mode 100644 index 0000000000..07f456656f --- /dev/null +++ b/harbour/source/rtl/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/source/rtl/tclass.prg b/harbour/source/rtl/tclass.prg index 09b9ea87e3..acd1273228 100644 --- a/harbour/source/rtl/tclass.prg +++ b/harbour/source/rtl/tclass.prg @@ -41,10 +41,6 @@ * Support for inheritance * Support for default DATA values * - * Copyright 2000 Ron Pinkas - * - * HB_Structure() - * * See doc/license.txt for licensing terms. * */ @@ -290,66 +286,3 @@ STATIC FUNCTION SetType( cType ) RETURN NIL //----------------------------------------------------------------------------// - -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/source/vm/runner.c b/harbour/source/vm/runner.c index 668065042f..a6ae1ecb6a 100644 --- a/harbour/source/vm/runner.c +++ b/harbour/source/vm/runner.c @@ -166,7 +166,7 @@ HB_FUNC( __HRBRUN ) PHB_DYNF pDynFunc; /* Functions read */ PHB_DYNS pDynSym; - ULONG ulSymStart; /* Startup Symbol */ + LONG ulSymStart = -1; /* Startup Symbol */ int i; @@ -180,7 +180,7 @@ HB_FUNC( __HRBRUN ) pSymRead[ ul ].pFunPtr = ( PHB_FUNC ) ( ULONG ) hb_hrbFileReadByte( file, szFileName ); pSymRead[ ul ].pDynSym = NULL; - if ( pSymRead[ ul ].cScope & HB_FS_FIRST && ! ( pSymRead[ ul ].cScope & HB_FS_INITEXIT ) ) + if ( ulSymStart == -1 && pSymRead[ ul ].cScope & HB_FS_FIRST && ! ( pSymRead[ ul ].cScope & HB_FS_INITEXIT ) ) ulSymStart = ul; } @@ -238,7 +238,7 @@ HB_FUNC( __HRBRUN ) if( ! bError ) { - PHB_ITEM pRetVal; + PHB_ITEM pRetVal = NULL; hb_vmProcessSymbols( pSymRead, ( USHORT ) ulSymbols ); @@ -270,7 +270,7 @@ HB_FUNC( __HRBRUN ) } /* May not have a startup symbol, if first symbol was an INIT Symbol (was executed already).*/ - if ( ulSymStart ) + if ( ulSymStart >= 0 ) { hb_vmPushSymbol( &( pSymRead[ ulSymStart ] ) ); hb_vmPushNil(); @@ -295,8 +295,11 @@ HB_FUNC( __HRBRUN ) } } - hb_itemReturn( pRetVal ); - hb_itemRelease( pRetVal ); + if ( pRetVal ) + { + hb_itemReturn( pRetVal ); + hb_itemRelease( pRetVal ); + } } for( ul = 0; ul < ulFuncs; ul++ ) diff --git a/harbour/tests/teststru.prg b/harbour/tests/teststru.prg index bc01c2bfe9..97b4540242 100644 --- a/harbour/tests/teststru.prg +++ b/harbour/tests/teststru.prg @@ -1,3 +1,5 @@ +#INCLUDE "..\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