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

2000-06-07 22:50 UTC-0800 Ron Pinkas <Ron@Profit-Master.com>

Browse Source 
* include/hbpp.h
  * source/compiler/harbour.c
  * source/pp/ppcore.c
    * Modified hb_pp_SetRules() to receive 2nd parameter BOOL hb_comp_bQuiet, since ppcore is part of PP.lib which is linked
      into HBRUN.exe which does not include harbour.c where hb_comp_bQuiet is defined.

  * source/compiler/harbour.l
    ! Fixed parse error on IF [...]

  * source/vm/classes.c
    Posted patch provided by JF

  * source/rtl/tobject.prg
    Posted missing file provided by JF
This commit is contained in:
Ron Pinkas
2000-06-09 06:59:56 +00:00
parent d7198df0a4
commit f4a4d1f980
7 changed files with 155 additions and 33 deletions
Download Patch File Download Diff File Expand all files Collapse all files

17
harbour/ChangeLog
View File

@@ -1,3 +1,20 @@
2000-06-07 22:50 UTC-0800 Ron Pinkas <Ron@Profit-Master.com>
* include/hbpp.h
* source/compiler/harbour.c
* source/pp/ppcore.c
* Modified hb_pp_SetRules() to receive 2nd parameter BOOL hb_comp_bQuiet, since ppcore is part of PP.lib which is linked
into HBRUN.exe which does not include harbour.c where hb_comp_bQuiet is defined.
* source/compiler/harbour.l
! Fixed parse error on IF [...]
* source/vm/classes.c
Posted patch provided by JF
* source/rtl/tobject.prg
Posted missing file provided by JF
2000-06-09 08:15 UTC+0100 Lubos Janica <janica@fornax.sk>
* source/rdd/dbfntx1.c
After this change we can create indexes. And they working with Clipper !

2
harbour/include/hbpp.h
View File

@@ -79,7 +79,7 @@ typedef struct _COMMANDS
/* HBPP.C exported functions */
extern void hb_pp_SetRules( BOOL (*hb_compInclude)(char *, PATHNAMES * ) );
extern void hb_pp_SetRules( BOOL (*hb_compInclude)(char *, PATHNAMES * ), BOOL hb_comp_bQuiet );
extern void hb_pp_Init( void );
extern int hb_pp_ParseDirective( char * ); /* Parsing preprocessor directives ( #... ) */
extern int hb_pp_ParseExpression( char *, char * ); /* Parsing a line ( without preprocessor directive ) */

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

@@ -143,20 +143,20 @@ static void hb_compSaveVars( PHARBVARS, int );
static void hb_compRestoreVars( PHARBVARS, int );
/* In Harbour.l */
void * hb_compGet_YY_CURRENT_BUFFER( void );
void hb_compSet_YY_CURRENT_BUFFER( void * );
int hb_compGet_yy_init( void );
void hb_compSet_yy_init( int i );
int hb_compGet_yy_start( void );
void hb_compSet_yy_start( int i );
int hb_compGet_yy_did_buffer_switch_on_eof( void );
void hb_compSet_yy_did_buffer_switch_on_eof( int );
extern void * hb_compGet_YY_CURRENT_BUFFER( void );
extern void hb_compSet_YY_CURRENT_BUFFER( void * );
extern int hb_compGet_yy_init( void );
extern void hb_compSet_yy_init( int i );
extern int hb_compGet_yy_start( void );
extern void hb_compSet_yy_start( int i );
extern int hb_compGet_yy_did_buffer_switch_on_eof( void );
extern void hb_compSet_yy_did_buffer_switch_on_eof( int );
/* In Harbour.y */
void * hb_compGet_pLoops( void );
void hb_compSet_pLoops( void * pLoops );
void * hb_compGet_rtvars( void );
void hb_compSet_rtvars( void * rtvars );
extern void * hb_compGet_pLoops( void );
extern void hb_compSet_pLoops( void * pLoops );
extern void * hb_compGet_rtvars( void );
extern void hb_compSet_rtvars( void * rtvars );
extern int yyparse( void ); /* main yacc parsing function */
@@ -213,7 +213,7 @@ int main( int argc, char * argv[] )
hb_compChkPaths();
/* Set standard rules */
hb_pp_SetRules( hb_compInclude );
hb_pp_SetRules( hb_compInclude, hb_comp_bQuiet );
/* Process all files passed via the command line. */

3
harbour/source/compiler/harbour.l
View File

@@ -148,6 +148,7 @@ Separator {SpaceTab}
("!"|".not.")[ \t]*"[" { BEGIN STRING3; return NOT; }
(","|"{"|"<"|">"|"(")[ \t]*"[" { BEGIN STRING3; hb_comp_iState = OPERATOR; yyleng = 1; yytext[1] = 0; return yytext[ 0 ]; }
("retu"|"retur"|"return")[ \t]*"[" { BEGIN STRING3; hb_comp_iState = RETURN; return RETURN; }
"if"[ \t]*"[" { BEGIN STRING3; return IF; }
<INITIAL>\[ { BEGIN STRING3; }
<STRING1>[^'^\n]* { hb_compGenError( hb_comp_szErrors, 'E', HB_COMP_ERR_STRING_TERMINATOR, yytext, NULL ); BEGIN 0; }
@@ -828,7 +829,7 @@ Separator {SpaceTab}
hb_comp_iState =IIF;
return hb_comp_iState;
}
<IF_>{Separator}*[\)\[\]\/\^\*\%\=\$\@] {
<IF_>{Separator}*[\)\]\/\^\*\%\=\$\@] {
hb_compGenError( hb_comp_szErrors, 'E', HB_COMP_ERR_SYNTAX2, yytext, "IF" );
}
<IF_>{Separator}*"->" {

2
harbour/source/pp/ppcore.c
View File

@@ -199,7 +199,7 @@ char * hb_pp_szWarnings[] =
"1No directives in command definitions file"
};
void hb_pp_SetRules( BOOL (*hb_compInclude)(char *, PATHNAMES * ) )
void hb_pp_SetRules( BOOL (*hb_compInclude)(char *, PATHNAMES * ), BOOL hb_comp_bQuiet )
{
if( hb_pp_STD_CH )
{

102
harbour/source/rtl/tobject.prg Normal file
View File

@@ -0,0 +1,102 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* Base Object from wich all object finally inherit
*
* Copyright 2000 JfL&RaC <jfl@mafact.com>, <rac@mafact.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/).
*
*/
/*
* The following parts are Copyright of the individual authors.
* www - http://www.harbour-project.org
*
* This is work in progress ... To be continued
*
* See doc/license.txt for licensing terms.
*
*/
/* Harbour Class TObject ! Warning ... can not use the preprocessor */
#include "common.ch"
#include "hboo.ch"
function TObject()
static oClass
local nScope := 1
if oClass == nil
oClass := TClass():New("TObject", {} )
oClass:AddInline("CLASSNAME" , {|Self | __OBJGETCLSNAME( SELF ) }, nScope )
oClass:AddInline("CLASSH" , {|Self | __CLASSH( SELF ) }, nScope )
oClass:AddInline("CLASSSEL" , {|Self | __CLASSSEL( SELF:CLASSH() ) }, nScope )
/*oClass:AddInline("EVAL" ,{|Self | __EVAL( SELF ) }, nScope ) */
/*oClass:AddInline("ISDERIVEDFROM" ,{|Self, xPar1 | ObjDerivedFrom( SELF,xPar1 ) }, nScope ) */
/* Those one exist within class(y), so we will probably try to implement it */
/*oClass:AddInline("INIT" ,{|Self | Self }, nScope ) */
/*oClass:AddInline("MSGNOTFOUND" ,{|Self | }, nScope ) */
/*oClass:AddInline("ISKINDOF" ,{|Self | }, nScope ) */
/*oClass:AddInline("asString" ,{|Self | ::class:name + " object" }, nScope ) */
/*oClass:AddInline("asExpStr" ,{|Self | }, nScope ) */
/*oClass:AddInline("basicSize" ,{|Self | LEN( self ) }, nScope ) */
/*oClass:AddInline("become" ,{|Self | }, nScope ) */
/*oClass:AddInline("isEqual" ,{|Self | }, nScope ) */
/*oClass:AddInline("isScalar" ,{|Self | }, nScope ) */
/*oClass:AddInline("copy" ,{|Self | }, nScope ) */
/*oClass:AddInline("deepCopy" ,{|Self | }, nScope ) */
/*oClass:AddInline("deferred" ,{|Self | }, nScope ) */
/*oClass:AddInline("exec" ,{|Self | }, nScope ) */
/*oClass:AddInline("error ,{|Self | }, nScope ) */
/*oClass:AddInline("hash" ,{|Self | }, nScope ) */
/*oClass:AddInline("null" ,{|Self | }, nScope ) */
/*oClass:AddInline("size" ,{|Self | LEN( self ) }, nScope ) */
/*oClass:AddInline("protectErr" ,{|Self | }, nScope ) */
/*oClass:AddInline("hiddenErr" ,{|Self | }, nScope ) */
/*oClass:AddInline("msgNotFound" ,{|Self | }, nScope ) */
/*oClass:AddInline("readOnlyErr" ,{|Self | }, nScope ) */
/*oClass:AddInline("wrongClass" ,{|Self | }, nScope ) */
/*oClass:AddInline("badMethod" ,{|Self | }, nScope ) */
/* this one exit within VO and is Auto Called when object ran out of scope */
/*oClass:AddInline("Axit" ,{|Self | }, nScope ) */
oClass:Create()
endif
return oClass:Instance()

36
harbour/source/vm/classes.c
View File

@@ -1,6 +1,5 @@
/*
* $Id$
=======
*/
/*
@@ -78,13 +77,13 @@
* Now, Each object instance will hold one object instance of all its parents
* The first one has the same pointer as SUPER and __SUPER msgs.
* See hb___msgSuper()
* Each inherited data will now has a pointer linked to it's original object's position
* Each inherited data will now has a pointer linked to it's original object's position
*
* hb___msgGetShrData()
* hb___msgSetShrData()
* hb___msgClsParent()
* __CLS_PARAM() (Now, all class inherit automaticly from TObject Class)
* __CLSPARENT()
* __CLSPARENT()
* __SENDER()
* __CLSINST() (Call to hb__clsinst())
* hb_cls_MsgToNum() (New Hashing method to allow a better use of buckets)
@@ -139,7 +138,7 @@ typedef struct
#define BASE_METHODS 255 /* starting maximum number of message */
#define BUCKET 5
#define HASH_KEY ( BASE_METHODS / BUCKET )
#define HASH_KEY ( BASE_METHODS / BUCKET ) /* Idealy, here we want a "nombre premier" */
static PCLASS s_pClasses = NULL;
static USHORT s_uiClasses = 0;
@@ -625,9 +624,12 @@ HB_FUNC( __CLSADDMSG )
/* Find either the existing message or an open spot for a new message */
while( pClass->pMethods[ uiAt ].pMessage &&
( pClass->pMethods[ uiAt ].pMessage != pMessage ) )
uiAt = ( USHORT ) ( ( uiAt == uiMask ) ? 0 : uiAt + 1 );
while(
pClass->pMethods[ uiAt ].pMessage
&&
( strcmp( pClass->pMethods[ uiAt ].pMessage->pSymbol->szName, pMessage->pSymbol->szName ) != 0 )
)
uiAt = ( USHORT ) ( ( uiAt == uiMask ) ? 0 : uiAt + 1 );
pNewMeth = pClass->pMethods + uiAt;
@@ -644,6 +646,7 @@ HB_FUNC( __CLSADDMSG )
case HB_OO_MSG_METHOD:
pNewMeth->pFunction = ( PHB_FUNC ) hb_parnl( 3 );
pNewMeth->uiScope = uiScope;
pNewMeth->uiData = 0;
break;
case HB_OO_MSG_DATA:
@@ -937,7 +940,6 @@ HB_FUNC( __CLSNEW )
for( uiBucket = 0; uiBucket < BUCKET; uiBucket++ )
{
#ifdef HB_CLS_MASKHIDDEN /* no hidden methods allowed by the inheritence. */
if( ( pSprCls->pMethods[ ui ].uiScope & HB_OO_CLSTP_HIDDEN ) == HB_OO_CLSTP_HIDDEN )
break;
@@ -949,7 +951,7 @@ HB_FUNC( __CLSNEW )
pNewCls->uiMethods++;
memcpy(pNewCls->pMethods + ( uiAt+uiBucket ), pSprCls->pMethods + ui, sizeof( METHOD ) );
if(
pNewCls->pMethods[ uiAt+uiBucket ].pFunction == hb___msgSetClsData
||
@@ -975,7 +977,7 @@ HB_FUNC( __CLSNEW )
pNewCls->pMethods[ uiAt+uiBucket ].uiScope = ( USHORT ) ( pSprCls->pMethods[ ui ].uiScope + HB_OO_CLSTP_SUPER );
else
pNewCls->pMethods[ uiAt+uiBucket ].uiScope = pSprCls->pMethods[ ui ].uiScope;
if( pSprCls->pMethods[ ui ].pInitValue )
{
PHB_ITEM pInitValue;
@@ -992,7 +994,7 @@ HB_FUNC( __CLSNEW )
}
break;
}
else if( pNewCls->pMethods[ uiAt+uiBucket ].pMessage->pSymbol->szName == pMsg->pSymbol->szName )
else if( strcmp( pNewCls->pMethods[ uiAt+uiBucket ].pMessage->pSymbol->szName, pMsg->pSymbol->szName ) == 0 )
break;
}
}
@@ -1116,14 +1118,14 @@ PHB_ITEM hb__clsinst( USHORT uiClass )
pSelf->item.asArray.value->uiClass = uiClass;
pSelf->item.asArray.value->uiPrevCls = 0;
for( uiAt = 0; uiAt < uiLimit; uiAt++, pMeth++ )
{
if( ( pMeth->uiScope & HB_OO_CLSTP_CLASS ) == HB_OO_CLSTP_CLASS
{
if( ( pMeth->uiScope & HB_OO_CLSTP_CLASS ) == HB_OO_CLSTP_CLASS
&&
( pMeth->uiScope & HB_OO_CLSTP_SUPER ) != HB_OO_CLSTP_SUPER
)
{
{
pSprObj = hb__clsinst( pMeth->uiSprClass ); /*instance super object*/
hb_arraySet( pSelf, pMeth->uiData, pSprObj );
uiSize ++ ;
@@ -1557,7 +1559,7 @@ HB_FUNC( __CLS_PARAM )
USHORT n;
if( uiParam >= 1 )
{
{
array = hb_itemArrayNew( uiParam );
for( n = 1; n <= uiParam; n++ )
{
@@ -1940,7 +1942,7 @@ static HARBOUR hb___msgSetData( void )
USHORT uiIndex = s_pMethod->uiData;
// If it's an herited data, the data reside within it's original Super object
// So we use the know pointer saved as an item long !!!!!!!!!!
// So we use the know pointer
if ( ( s_pMethod->uiScope & HB_OO_CLSTP_SUPER ) == HB_OO_CLSTP_SUPER )
{
PHB_ITEM pPtrNum;