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

2000-05-22 10:40 UTC-800 Ron Pinkas <Ron@Profit-Master.com>

Browse Source 
* 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
This commit is contained in:
Ron Pinkas
2000-05-26 07:39:42 +00:00
parent 8379f01566
commit 04837b2eaa
11 changed files with 180 additions and 91 deletions
Download Patch File Download Diff File Expand all files Collapse all files

30
harbour/ChangeLog
View File

@@ -1,3 +1,33 @@
2000-05-22 10:40 UTC-800 Ron Pinkas <Ron@Profit-Master.com>
* 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 <dholm@jsd-llc.com>
* source/rtl/tgetlist.prg

3
harbour/include/hbextern.ch
View File

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

10
harbour/include/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

2
harbour/include/hbvmpub.h
View File

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

8
harbour/makefile.bc
View File

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

25
harbour/source/compiler/harbour.c
View File

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

9
harbour/source/pp/pptable.c
View File

@@ -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 <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> ] => ;
@@ -398,7 +401,9 @@ static COMMANDS sC___240 = {0,"STRUCTURE","\1A00 \1B00 \1C20:AS CLASS,AS STRUCTU
#TRANSLATE AS NEW <StruName> => AS STRUCTURE <StruName> := ( Eval( __<StruName> ), 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*/;

100
harbour/source/rtl/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 )

67
harbour/source/rtl/tclass.prg
View File

@@ -41,10 +41,6 @@
* Support for inheritance
* Support for default DATA values
*
* Copyright 2000 Ron Pinkas <Ron@Profit-Master.com>
*
* 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 )
//----------------------------------------------------------------------------//

15
harbour/source/vm/runner.c
View File

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

2
harbour/tests/teststru.prg
View File

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