1090 lines
29 KiB
C
1090 lines
29 KiB
C
/*
|
|
* $Id$
|
|
*/
|
|
|
|
/*
|
|
* Classes.C contains the base-routines for OOPS system
|
|
*
|
|
* Copyright(C) 1999 by Antonio Linares.
|
|
*
|
|
* 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.
|
|
*
|
|
* 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.
|
|
*
|
|
* You can contact me at: alinares@fivetech.com
|
|
*
|
|
*
|
|
* Partial Copyright (C) 1999 Eddie Runia ( eddie@runia.com )
|
|
* partial copyright regarding the following functions :
|
|
* CLASSDEL
|
|
* CLASSMOD
|
|
* :CLASSSEL()
|
|
* ISMESSAGE
|
|
* OCLONE
|
|
* OSEND
|
|
* SELECTSUPER
|
|
* __INSTSUPER
|
|
* __WCLSDATAS
|
|
* __WDATAS
|
|
* __WDATADEC
|
|
* __WDATAINC
|
|
*/
|
|
|
|
#include "extend.h"
|
|
#include "errorapi.h"
|
|
#include "itemapi.h"
|
|
#include "ctoharb.h"
|
|
#include "init.h"
|
|
|
|
#define MET_METHOD 0
|
|
#define MET_DATA 1
|
|
#define MET_CLASSDATA 2
|
|
#define MET_INLINE 3
|
|
#define MET_VIRTUAL 4
|
|
#define MET_SUPER 5
|
|
|
|
HARBOUR DoBlock( void ); /* executes a codeblock */
|
|
|
|
typedef struct
|
|
{
|
|
void * pMessage; /* pointer to dynamic symbol when they get ready */
|
|
HARBOURFUNC pFunction;
|
|
WORD wData;
|
|
WORD wScope;
|
|
PHB_ITEM pInitValue;
|
|
} METHOD, * PMETHOD;
|
|
|
|
typedef struct
|
|
{
|
|
char * szName;
|
|
WORD wDatas;
|
|
WORD wDataFirst; /* First wData from this class */
|
|
PMETHOD pMethods;
|
|
WORD wMethods;
|
|
WORD wHashKey;
|
|
PHB_ITEM pClassDatas; /* Array for ClassDatas */
|
|
PHB_ITEM pInlines; /* Array for inline codeblocks */
|
|
} CLASS, * PCLASS;
|
|
|
|
#define BASE_METHODS 200
|
|
#define BUCKET 4
|
|
#define HASH_KEY BASE_METHODS/BUCKET
|
|
|
|
extern STACK stack;
|
|
extern SYMBOL symEval;
|
|
|
|
PCLASS pClasses = 0;
|
|
WORD wClasses = 0;
|
|
PMETHOD pMethod = 0;
|
|
PDYNSYM msgClassName = 0,
|
|
msgClassH = 0,
|
|
msgEval = 0,
|
|
msgClassSel = 0;
|
|
|
|
/* All functions contained in classes.c */
|
|
|
|
HARBOUR HB_CLASSADD( void );
|
|
HARBOUR HB_CLASSCREATE( void );
|
|
HARBOUR HB_CLASSDEL( void );
|
|
static HARBOUR ClassH( void );
|
|
HARBOUR HB_CLASSINSTANCE( void );
|
|
HARBOUR HB_CLASSMOD( void );
|
|
static HARBOUR ClassName( void );
|
|
HARBOUR HB_CLASSNAME( void );
|
|
static HARBOUR ClassSel( void );
|
|
static void DictRealloc( PCLASS );
|
|
static HARBOUR EvalInline( void );
|
|
static HARBOUR GetClassData( void );
|
|
static HARBOUR GetData( void );
|
|
HARBOURFUNC hb_GetMethod( PHB_ITEM, PSYMBOL );
|
|
ULONG hb_isMessage( PHB_ITEM, char *);
|
|
HARBOUR HB_ISMESSAGE( void );
|
|
HARBOUR HB_OCLONE( void );
|
|
HARBOUR HB_OSEND( void );
|
|
void ReleaseClass( PCLASS );
|
|
void ReleaseClasses( void );
|
|
static HARBOUR SelectSuper( void );
|
|
static HARBOUR SetClassData( void );
|
|
static HARBOUR SetData( void );
|
|
static HARBOUR Virtual( void );
|
|
HARBOUR HB___INSTSUPER( void );
|
|
HARBOUR HB___WDATAS( void );
|
|
HARBOUR HB___WDATADEC( void );
|
|
HARBOUR HB___WDATAINC( void );
|
|
|
|
/* All function contained in matching objfunc.prg */
|
|
|
|
HARBOUR HB_AODATA( void );
|
|
HARBOUR HB_AOGET( void );
|
|
HARBOUR HB_AOMETHOD( void );
|
|
HARBOUR HB_AOSET( void );
|
|
HARBOUR HB_ISDATA( void );
|
|
HARBOUR HB_ISMETHOD( void );
|
|
HARBOUR HB_OADDDATA( void );
|
|
HARBOUR HB_OADDINLINE( void );
|
|
HARBOUR HB_OADDMETHOD( void );
|
|
HARBOUR HB_ODELDATA( void );
|
|
HARBOUR HB_ODELINLINE( void );
|
|
HARBOUR HB_ODELMETHOD( void );
|
|
HARBOUR HB_OMODINLINE( void );
|
|
HARBOUR HB_OMODMETHOD( void );
|
|
|
|
/* Exported symbols of both classes.c and objfunc.prg */
|
|
|
|
HB_INIT_SYMBOLS_BEGIN( Classes__InitSymbols )
|
|
{ "AODATA" , FS_PUBLIC, HB_AODATA , 0 },
|
|
{ "AOGET" , FS_PUBLIC, HB_AOGET , 0 },
|
|
{ "AOMETHOD" , FS_PUBLIC, HB_AOMETHOD , 0 },
|
|
{ "AOSET" , FS_PUBLIC, HB_AOSET , 0 },
|
|
{ "CLASSADD" , FS_PUBLIC, HB_CLASSADD , 0 },
|
|
{ "CLASSCREATE" , FS_PUBLIC, HB_CLASSCREATE , 0 },
|
|
{ "CLASSDEL" , FS_PUBLIC, HB_CLASSDEL , 0 },
|
|
{ "CLASSINSTANCE" , FS_PUBLIC, HB_CLASSINSTANCE , 0 },
|
|
{ "CLASSMOD" , FS_PUBLIC, HB_CLASSMOD , 0 },
|
|
{ "CLASSNAME" , FS_PUBLIC, HB_CLASSNAME , 0 },
|
|
{ "ISDATA" , FS_PUBLIC, HB_ISDATA , 0 },
|
|
{ "ISMESSAGE" , FS_PUBLIC, HB_ISMESSAGE , 0 },
|
|
{ "ISMETHOD" , FS_PUBLIC, HB_ISMETHOD , 0 },
|
|
{ "OADDDATA" , FS_PUBLIC, HB_OADDDATA , 0 },
|
|
{ "OADDINLINE" , FS_PUBLIC, HB_OADDINLINE , 0 },
|
|
{ "OADDMETHOD" , FS_PUBLIC, HB_OADDMETHOD , 0 },
|
|
{ "OCLONE" , FS_PUBLIC, HB_OCLONE , 0 },
|
|
{ "ODELDATA" , FS_PUBLIC, HB_ODELDATA , 0 },
|
|
{ "ODELINLINE" , FS_PUBLIC, HB_ODELINLINE , 0 },
|
|
{ "ODELMETHOD" , FS_PUBLIC, HB_ODELMETHOD , 0 },
|
|
{ "OMODINLINE" , FS_PUBLIC, HB_OMODINLINE , 0 },
|
|
{ "OMODMETHOD" , FS_PUBLIC, HB_OMODMETHOD , 0 },
|
|
{ "OSEND" , FS_PUBLIC, HB_OSEND , 0 }
|
|
HB_INIT_SYMBOLS_END( Classes__InitSymbols );
|
|
#if ! defined(__GNUC__)
|
|
#pragma startup Classes__InitSymbols
|
|
#endif
|
|
|
|
/*
|
|
* ClassAdd( <hClass>, <cMessage>, <pFunction>, <nType>, [xInit] )
|
|
*
|
|
* Add a message to the class.
|
|
*
|
|
* <hClass> Class handle
|
|
* <cMessage> Message
|
|
* <pFunction> MET_METHOD : Pointer to function
|
|
* MET_DATA : Index number in array
|
|
* MET_CLASSDATA : Index number in array
|
|
* MET_INLINE : Code block
|
|
* MET_SUPER : Handle of super class
|
|
* <nType> see MET_*
|
|
* <xInit> Optional initializer for DATA
|
|
*/
|
|
HARBOUR HB_CLASSADD(void)
|
|
{
|
|
WORD wClass = hb_parnl( 1 );
|
|
WORD wType = hb_parni( 4 );
|
|
WORD wAt, wMask;
|
|
|
|
PHB_ITEM pInit = hb_param( 5, IT_ANY );
|
|
PCLASS pClass;
|
|
PDYNSYM pMessage;
|
|
PMETHOD pNewMeth;
|
|
|
|
if( wClass && wClass <= wClasses )
|
|
{
|
|
pClass = &pClasses[ wClass - 1 ];
|
|
pMessage = hb_GetDynSym( hb_parc( 2 ) );
|
|
wAt = ( ( ( unsigned ) pMessage ) % pClass->wHashKey ) * BUCKET;
|
|
wMask = pClass->wHashKey * BUCKET;
|
|
|
|
if( pClass->wMethods > ( pClass->wHashKey * BUCKET * 2/3 ) )
|
|
DictRealloc( pClass );
|
|
|
|
/* Find either the existing message or an open spot for a new message */
|
|
|
|
while( pClass->pMethods[ wAt ].pMessage &&
|
|
( pClass->pMethods[ wAt ].pMessage != pMessage ) )
|
|
wAt = ( wAt == wMask ) ? 0 : wAt + 1;
|
|
|
|
pNewMeth = pClass->pMethods + wAt;
|
|
if( !pNewMeth->pMessage )
|
|
{
|
|
pNewMeth->pMessage = pMessage;
|
|
pClass->wMethods++; /* One more message */
|
|
}
|
|
|
|
switch( wType )
|
|
{
|
|
case MET_METHOD:
|
|
pNewMeth->pFunction = ( HARBOURFUNC ) hb_parnl( 3 );
|
|
break;
|
|
|
|
case MET_DATA:
|
|
pNewMeth->wData = hb_parnl( 3 );
|
|
if( pMessage->pSymbol->szName[ 0 ] == '_' )
|
|
pNewMeth->pFunction = SetData;
|
|
else
|
|
{
|
|
pNewMeth->pFunction = GetData;
|
|
if( pInit && !IS_NIL( pInit )) /* Initializer found */
|
|
{
|
|
pNewMeth->pInitValue = hb_itemNew( NULL );
|
|
hb_itemCopy( pNewMeth->pInitValue, pInit );
|
|
}
|
|
}
|
|
break;
|
|
|
|
case MET_CLASSDATA:
|
|
pNewMeth->wData = hb_parnl( 3 );
|
|
if( ( WORD ) hb_arrayLen( pClass->pClassDatas ) < hb_parnl( 3 ) )
|
|
hb_arraySize( pClass->pClassDatas, hb_parnl( 3 ) );
|
|
|
|
if( pMessage->pSymbol->szName[ 0 ] == '_' )
|
|
pNewMeth->pFunction = SetClassData;
|
|
else
|
|
pNewMeth->pFunction = GetClassData;
|
|
break;
|
|
|
|
case MET_INLINE:
|
|
pNewMeth->wData = hb_arrayLen( pClass->pInlines ) + 1;
|
|
hb_arraySize( pClass->pInlines, pNewMeth->wData );
|
|
hb_arraySet( pClass->pInlines, pNewMeth->wData,
|
|
hb_param( 3, IT_BLOCK ) );
|
|
pNewMeth->pFunction = EvalInline;
|
|
break;
|
|
|
|
case MET_VIRTUAL:
|
|
pNewMeth->pFunction = Virtual;
|
|
break;
|
|
|
|
case MET_SUPER:
|
|
pNewMeth->wData = hb_parnl( 3 );
|
|
pNewMeth->pFunction = SelectSuper;
|
|
break;
|
|
|
|
default:
|
|
printf( "Invalid method type from ClassAdd\n" );
|
|
exit( 1 );
|
|
break;
|
|
}
|
|
}
|
|
}
|
|
|
|
|
|
/*
|
|
* <hClass> := ClassCreate( <cClassName>, <nDatas>, [hSuper] )
|
|
*
|
|
* Create a new class
|
|
*
|
|
* <cClassName> Name of the class
|
|
* <nDatas> Number of DATAs in the class
|
|
* <hSuper> Optional handle of superclass
|
|
*/
|
|
HARBOUR HB_CLASSCREATE(void)
|
|
{
|
|
WORD wSuper = hb_parni( 3 ); /* Super class present */
|
|
WORD wSize;
|
|
PCLASS pNewCls;
|
|
PCLASS pSprCls;
|
|
|
|
if( pClasses )
|
|
pClasses = ( PCLASS ) hb_xrealloc( pClasses,
|
|
sizeof( CLASS ) * ( wClasses + 1 ) );
|
|
else
|
|
pClasses = ( PCLASS ) hb_xgrab( sizeof( CLASS ) );
|
|
|
|
pNewCls = pClasses + wClasses;
|
|
pNewCls->szName = ( char * ) hb_xgrab( hb_parclen( 1 ) + 1 );
|
|
strcpy( pNewCls->szName, hb_parc( 1 ) );
|
|
|
|
if( wSuper )
|
|
{
|
|
pSprCls = pClasses + wSuper - 1;
|
|
|
|
pNewCls->wDataFirst = pSprCls->wDatas;
|
|
pNewCls->wDatas = pSprCls->wDatas + hb_parni(2);
|
|
pNewCls->wMethods = pSprCls->wMethods;
|
|
|
|
pNewCls->pClassDatas = hb_arrayClone( pSprCls->pClassDatas );
|
|
pNewCls->pInlines = hb_arrayClone( pSprCls->pInlines );
|
|
|
|
pNewCls->wHashKey = pSprCls->wHashKey;
|
|
|
|
wSize = pSprCls->wHashKey * BUCKET * sizeof( METHOD );
|
|
pNewCls->pMethods = ( PMETHOD ) hb_xgrab( wSize );
|
|
memcpy( pNewCls->pMethods, pSprCls->pMethods, wSize );
|
|
} /* Copy all super methods */
|
|
else
|
|
{
|
|
pNewCls->wDatas = hb_parni( 2 );
|
|
pNewCls->wDataFirst = 0;
|
|
pNewCls->pMethods = ( PMETHOD ) hb_xgrab( BASE_METHODS * sizeof( METHOD ) );
|
|
pNewCls->wMethods = 0;
|
|
pNewCls->wHashKey = HASH_KEY; /* BUCKET = 4 repetitions */
|
|
|
|
pNewCls->pClassDatas = hb_itemArrayNew( 0 );
|
|
pNewCls->pInlines = hb_itemArrayNew( 0 );
|
|
|
|
memset( pNewCls->pMethods, 0, BASE_METHODS * sizeof( METHOD ) );
|
|
}
|
|
hb_retni( ++wClasses );
|
|
}
|
|
|
|
|
|
/*
|
|
* ClassDel( <oObj>, <cMessage> )
|
|
*
|
|
* Delete message (only for INLINE and METHOD)
|
|
*
|
|
* <oObj> Object
|
|
* <cMessage> Message
|
|
*/
|
|
HARBOUR HB_CLASSDEL(void)
|
|
{
|
|
PHB_ITEM pString = hb_param( 2, IT_STRING );
|
|
PSYMBOL pMessage = hb_GetDynSym( pString->item.asString.value )->pSymbol;
|
|
PDYNSYM pMsg = ( PDYNSYM ) pMessage->pDynSym;
|
|
PCLASS pClass;
|
|
|
|
WORD wClass = hb_parni( 1 );
|
|
WORD wAt;
|
|
WORD wLimit;
|
|
WORD wMask;
|
|
|
|
HARBOURFUNC pFunc;
|
|
|
|
if( wClass && wClass <= wClasses )
|
|
{
|
|
pClass = pClasses + wClass - 1;
|
|
wAt = ( ( ( unsigned ) pMsg ) % pClass->wHashKey ) * BUCKET;
|
|
wMask = pClass->wHashKey * BUCKET;
|
|
wLimit = wAt ? ( wAt - 1 ) : ( wMask - 1 );
|
|
|
|
while( ( wAt != wLimit ) &&
|
|
( pClass->pMethods[ wAt ].pMessage &&
|
|
( pClass->pMethods[ wAt ].pMessage != pMsg ) ) )
|
|
{
|
|
wAt++;
|
|
if( wAt == wMask)
|
|
wAt = 0;
|
|
}
|
|
|
|
if( wAt != wLimit )
|
|
{ /* Requested method found */
|
|
pFunc = pClass->pMethods[ wAt ].pFunction;
|
|
if( pFunc == EvalInline ) /* INLINE method deleted */
|
|
{
|
|
hb_arrayDel( pClass->pInlines, pClass->pMethods[ wAt ].wData );
|
|
/* Delete INLINE block */
|
|
}
|
|
/* Move messages */
|
|
while( pClass->pMethods[ wAt ].pMessage && wAt != wLimit )
|
|
{
|
|
memcpy( pClass->pMethods + wAt,
|
|
pClass->pMethods + ( ( wAt == wMask ) ? 0 : wAt + 1 ),
|
|
sizeof( METHOD ) );
|
|
wAt++;
|
|
if( wAt == wMask)
|
|
wAt = 0;
|
|
}
|
|
|
|
memset( pClass->pMethods + wAt, 0, sizeof( METHOD ) );
|
|
|
|
pClass->wMethods--; /* Decrease number messages */
|
|
}
|
|
}
|
|
}
|
|
|
|
|
|
/*
|
|
* <hClass> := <obj>:ClassH()
|
|
*
|
|
* Returns class handle of <obj>
|
|
*/
|
|
static HARBOUR ClassH( void )
|
|
{
|
|
hb_retni( ( stack.pBase + 1 )->item.asArray.value->wClass );
|
|
}
|
|
|
|
|
|
/*
|
|
* <oNewObject> := ClassInstance( <hClass> )
|
|
*
|
|
* Create a new object from class definition <hClass>
|
|
*/
|
|
HARBOUR HB_CLASSINSTANCE(void)
|
|
{
|
|
WORD wClass = hb_parni( 1 );
|
|
WORD wAt, wLimit;
|
|
PCLASS pClass;
|
|
PMETHOD pMeth;
|
|
|
|
if( wClass <= wClasses )
|
|
{
|
|
pClass = pClasses + ( wClass - 1 );
|
|
hb_arrayNew( &stack.Return, pClass->wDatas );
|
|
stack.Return.item.asArray.value->wClass = wClass;
|
|
|
|
pMeth = pClass->pMethods; /* Initialize DATA */
|
|
wLimit = pClass->wHashKey * BUCKET;
|
|
for( wAt = 0; wAt < wLimit; wAt++, pMeth++ )
|
|
if( pMeth->pInitValue )
|
|
hb_itemArrayPut( &stack.Return, pMeth->wData, pMeth->pInitValue );
|
|
}
|
|
else
|
|
hb_ret();
|
|
}
|
|
|
|
/*
|
|
* ClassMod( <oObj>, <cMessage>, <pFunc> )
|
|
*
|
|
* Modify message (only for INLINE and METHOD)
|
|
*/
|
|
HARBOUR HB_CLASSMOD(void)
|
|
{
|
|
PHB_ITEM pString = hb_param( 2, IT_STRING );
|
|
PSYMBOL pMessage = hb_GetDynSym( pString->item.asString.value )->pSymbol;
|
|
PDYNSYM pMsg = ( PDYNSYM ) pMessage->pDynSym;
|
|
PCLASS pClass;
|
|
|
|
WORD wClass = hb_parni( 1 );
|
|
WORD wAt;
|
|
WORD wLimit;
|
|
WORD wMask;
|
|
|
|
HARBOURFUNC pFunc;
|
|
|
|
if( wClass && wClass <= wClasses )
|
|
{
|
|
pClass = pClasses + wClass - 1;
|
|
wAt = ( ( ( unsigned ) pMsg ) % pClass->wHashKey ) * BUCKET;
|
|
wMask = pClass->wHashKey * BUCKET;
|
|
wLimit = wAt ? ( wAt - 1 ) : ( wMask - 1 );
|
|
|
|
while( ( wAt != wLimit ) &&
|
|
( pClass->pMethods[ wAt ].pMessage &&
|
|
( pClass->pMethods[ wAt ].pMessage != pMsg ) ) )
|
|
{
|
|
wAt++;
|
|
if( wAt == wMask)
|
|
wAt = 0;
|
|
}
|
|
|
|
if( wAt != wLimit )
|
|
{ /* Requested method found */
|
|
pFunc = pClass->pMethods[ wAt ].pFunction;
|
|
if( pFunc == EvalInline ) /* INLINE method changed */
|
|
hb_arraySet( pClass->pInlines, pClass->pMethods[ wAt ].wData,
|
|
hb_param( 3, IT_BLOCK ) );
|
|
else if( ( pFunc == SetData ) || ( pFunc == GetData ) )
|
|
{ /* Not allowed for DATA */
|
|
/*hb_errPutDescription(pError, "CLASSMOD: Cannot modify a DATA item");*/
|
|
hb_errorRT_BASE(EG_ARG, 3001, NULL, "CLASSMOD");
|
|
}
|
|
else /* Modify METHOD */
|
|
pClass->pMethods[ wAt ].pFunction = ( HARBOURFUNC ) hb_parnl( 3 );
|
|
}
|
|
}
|
|
}
|
|
|
|
|
|
/*
|
|
* <cClassName> := <obj>:ClassName()
|
|
*
|
|
* Return class name of <obj>. Can also be used for all types.
|
|
*/
|
|
static HARBOUR ClassName( void )
|
|
{
|
|
PHB_ITEM pItemRef;
|
|
|
|
if( IS_BYREF( stack.pBase + 1 ) ) /* Variables by reference */
|
|
pItemRef = hb_itemUnRef( stack.pBase + 1 );
|
|
else
|
|
pItemRef = stack.pBase + 1;
|
|
|
|
hb_retc( hb_GetClassName( pItemRef ) );
|
|
}
|
|
|
|
|
|
/*
|
|
* <cClassName> := ClassName( <hClass> )
|
|
*
|
|
* Returns class name of <hClass>
|
|
*/
|
|
HARBOUR HB_CLASSNAME(void)
|
|
{
|
|
PHB_ITEM pObject = hb_param( 0, IT_OBJECT );
|
|
WORD wClass;
|
|
|
|
if( pObject && pObject->item.asArray.value->wClass )
|
|
{
|
|
wClass = pObject->item.asArray.value->wClass;
|
|
hb_retc( pClasses[ wClass - 1 ].szName );
|
|
}
|
|
else
|
|
{
|
|
wClass = hb_parni( 1 );
|
|
if( wClass <= wClasses )
|
|
hb_retc( pClasses[ wClass - 1 ].szName );
|
|
else
|
|
hb_retc( "" );
|
|
}
|
|
}
|
|
|
|
|
|
/*
|
|
* <aMessages> := <obj>:ClassSel()
|
|
*
|
|
* Returns all the messages in <obj>
|
|
*/
|
|
static HARBOUR ClassSel(void)
|
|
{
|
|
WORD wClass = IS_ARRAY( stack.pBase + 1 ) ?
|
|
( stack.pBase + 1 )->item.asArray.value->wClass : 0;
|
|
/* Get class word */
|
|
WORD wLimit; /* Number of Hash keys */
|
|
WORD wAt;
|
|
WORD wPos = 0;
|
|
PCLASS pClass;
|
|
PDYNSYM pMessage;
|
|
PHB_ITEM pReturn = hb_itemNew( NULL );
|
|
PHB_ITEM pItem;
|
|
PHB_ITEM pItemRef;
|
|
|
|
if( ( ! wClass ) && IS_BYREF( stack.pBase + 1 ) )
|
|
{ /* Variables by reference */
|
|
pItemRef = hb_itemUnRef( stack.pBase + 1 );
|
|
if( IS_ARRAY( pItemRef ) )
|
|
wClass = pItemRef->item.asArray.value->wClass;
|
|
}
|
|
|
|
if( wClass && wClass <= wClasses )
|
|
{
|
|
pClass = &pClasses[ wClass - 1 ];
|
|
wLimit = pClass->wHashKey * BUCKET;
|
|
hb_itemRelease( pReturn );
|
|
pReturn = hb_itemArrayNew( pClass->wMethods );
|
|
/* Create a transfer array */
|
|
for( wAt = 0; wAt < wLimit ; wAt++ )
|
|
{
|
|
pMessage = (PDYNSYM) pClass->pMethods[ wAt ].pMessage;
|
|
if( pMessage ) /* Hash Entry used ? */
|
|
{
|
|
pItem = hb_itemPutC( NULL, pMessage->pSymbol->szName );
|
|
/* Add to array */
|
|
hb_itemArrayPut( pReturn, ++wPos, pItem );
|
|
hb_itemRelease( pItem );
|
|
}
|
|
}
|
|
}
|
|
hb_itemReturn ( pReturn );
|
|
hb_itemRelease( pReturn );
|
|
}
|
|
|
|
|
|
/*
|
|
* DictRealloc( PCLASS )
|
|
*
|
|
* Realloc (widen) class
|
|
*/
|
|
static void DictRealloc( PCLASS pClass )
|
|
{
|
|
/* TODO: Implement it for very large classes */
|
|
if( pClass )
|
|
{
|
|
printf( "classes.c DictRealloc not implemented yet\n" );
|
|
exit( 1 );
|
|
}
|
|
}
|
|
|
|
|
|
/*
|
|
* EvalInline()
|
|
*
|
|
* Internal function executed for inline methods
|
|
*/
|
|
static HARBOUR EvalInline( void )
|
|
{
|
|
HB_ITEM block;
|
|
WORD wClass = ( stack.pBase + 1 )->item.asArray.value->wClass;
|
|
WORD w;
|
|
|
|
hb_arrayGet( pClasses[ wClass - 1 ].pInlines, pMethod->wData, &block );
|
|
|
|
PushSymbol( &symEval );
|
|
Push( &block );
|
|
Push( stack.pBase + 1 ); /* Push self */
|
|
for( w = 1; w <= hb_pcount(); w++ )
|
|
Push( hb_param( w, IT_ANY ) );
|
|
Do( hb_pcount() + 1 ); /* Self is also an argument */
|
|
|
|
hb_itemClear( &block ); /* Release block */
|
|
}
|
|
|
|
|
|
/*
|
|
* <szName> = hb_GetClassName( pObject )
|
|
*
|
|
* Get the class name of an object
|
|
*
|
|
*/
|
|
char * hb_GetClassName( PHB_ITEM pObject )
|
|
{
|
|
char * szClassName;
|
|
|
|
if( IS_ARRAY( pObject ) )
|
|
{
|
|
if( ! pObject->item.asArray.value->wClass )
|
|
szClassName = "ARRAY";
|
|
else
|
|
szClassName =
|
|
( pClasses + pObject->item.asArray.value->wClass - 1 )->szName;
|
|
}
|
|
else /* built in types */
|
|
{
|
|
switch( pObject->type )
|
|
{
|
|
case IT_NIL:
|
|
szClassName = "NIL";
|
|
break;
|
|
|
|
case IT_STRING:
|
|
szClassName = "CHARACTER";
|
|
break;
|
|
|
|
case IT_BLOCK:
|
|
szClassName = "BLOCK";
|
|
break;
|
|
|
|
case IT_SYMBOL:
|
|
szClassName = "SYMBOL";
|
|
break;
|
|
|
|
case IT_DATE:
|
|
szClassName = "DATE";
|
|
break;
|
|
|
|
case IT_INTEGER:
|
|
case IT_LONG:
|
|
case IT_DOUBLE:
|
|
szClassName = "NUMERIC";
|
|
break;
|
|
|
|
case IT_LOGICAL:
|
|
szClassName = "LOGICAL";
|
|
break;
|
|
|
|
default:
|
|
szClassName = "UNKNOWN";
|
|
break;
|
|
}
|
|
}
|
|
return szClassName;
|
|
}
|
|
|
|
/*
|
|
* GetClassData()
|
|
*
|
|
* Internal function to return a CLASSDATA
|
|
*/
|
|
static HARBOUR GetClassData( void )
|
|
{
|
|
WORD wClass = ( stack.pBase + 1 )->item.asArray.value->wClass;
|
|
WORD wIndex = pMethod->wData;
|
|
|
|
if( wClass && wClass <= wClasses )
|
|
hb_arrayGet( pClasses[ wClass - 1 ].pClassDatas, wIndex,
|
|
&stack.Return );
|
|
}
|
|
|
|
|
|
/*
|
|
* GetData()
|
|
*
|
|
* Internal function to return a DATA
|
|
*/
|
|
static HARBOUR GetData( void )
|
|
{
|
|
PHB_ITEM pObject = stack.pBase + 1;
|
|
WORD wIndex = pMethod->wData;
|
|
|
|
if( wIndex > ( WORD ) hb_arrayLen ( pObject ) )
|
|
/* Resize needed */
|
|
hb_arraySize( pObject, wIndex ); /* Make large enough */
|
|
hb_arrayGet( pObject, wIndex, &stack.Return );
|
|
}
|
|
|
|
|
|
/*
|
|
* <pFunc> = hb_GetMethod( <pObject>, <pMessage> )
|
|
*
|
|
* Internal function to the function pointer of a message of an object
|
|
*/
|
|
HARBOURFUNC hb_GetMethod( PHB_ITEM pObject, PSYMBOL pMessage )
|
|
{
|
|
WORD wAt, wLimit, wMask;
|
|
WORD wClass;
|
|
PCLASS pClass;
|
|
PDYNSYM pMsg = ( PDYNSYM ) pMessage->pDynSym;
|
|
|
|
if( pObject->type == IT_OBJECT )
|
|
wClass = pObject->item.asArray.value->wClass;
|
|
else
|
|
wClass = 0;
|
|
|
|
if( ! msgClassName )
|
|
{
|
|
msgClassName = hb_GetDynSym( "CLASSNAME" ); /* Standard messages */
|
|
msgClassH = hb_GetDynSym( "CLASSH" ); /* Not present in classdef. */
|
|
msgClassSel = hb_GetDynSym( "CLASSSEL" );
|
|
msgEval = hb_GetDynSym( "EVAL" );
|
|
}
|
|
|
|
if( wClass && wClass <= wClasses )
|
|
{
|
|
pClass = &pClasses[ wClass - 1 ];
|
|
wAt = ( ( ( unsigned ) pMsg ) % pClass->wHashKey ) * BUCKET;
|
|
wMask = pClass->wHashKey * BUCKET;
|
|
wLimit = wAt ? ( wAt - 1 ) : ( wMask - 1 );
|
|
|
|
pMethod = 0; /* Current method pointer */
|
|
|
|
while( wAt != wLimit )
|
|
{
|
|
if( pClass->pMethods[ wAt ].pMessage == pMsg )
|
|
{
|
|
pMethod = pClass->pMethods + wAt;
|
|
return pMethod->pFunction;
|
|
}
|
|
wAt++;
|
|
if( wAt == wMask)
|
|
wAt = 0;
|
|
}
|
|
}
|
|
if( pMsg == msgClassName )
|
|
return ClassName;
|
|
|
|
else if( pMsg == msgClassH )
|
|
return ClassH;
|
|
|
|
else if( pMsg == msgClassSel )
|
|
return ClassSel;
|
|
|
|
else if( pMsg == msgEval )
|
|
return EvalInline;
|
|
|
|
return 0;
|
|
}
|
|
|
|
|
|
/*
|
|
* <uPtr> = hb_isMessage( <pObject>, <szString> )
|
|
*
|
|
* Check whether <szString> is an existing message for object.
|
|
*
|
|
* <uPtr> should be read as a boolean
|
|
*/
|
|
ULONG hb_isMessage( PHB_ITEM pObject, char *szString )
|
|
{
|
|
PSYMBOL pMessage = hb_GetDynSym( szString )->pSymbol;
|
|
return( (ULONG) hb_GetMethod( pObject, pMessage ) );
|
|
} /* Get funcptr of message */
|
|
|
|
|
|
/*
|
|
* <lRet> := IsMessage( <oObj>, <cSymbol> )
|
|
*
|
|
* Is <cSymbol> a valid message for the <oObj>
|
|
*/
|
|
HARBOUR HB_ISMESSAGE(void)
|
|
{
|
|
PHB_ITEM pObject = hb_param( 1, IT_OBJECT );
|
|
PHB_ITEM pString = hb_param( 2, IT_STRING );
|
|
|
|
if( pObject && pString )
|
|
hb_retl( hb_isMessage( pObject, pString->item.asString.value ) != 0 );
|
|
else
|
|
{
|
|
hb_errorRT_BASE(EG_ARG, 3000, NULL, "ISMESSAGE");
|
|
}
|
|
}
|
|
|
|
|
|
/*
|
|
* <oNew> := oClone( <oOld> )
|
|
*
|
|
* Clone an object. Note the similarity with aClone ;-)
|
|
*/
|
|
HARBOUR HB_OCLONE( void )
|
|
{
|
|
PHB_ITEM pSrcObject = hb_param( 1, IT_OBJECT );
|
|
|
|
if ( pSrcObject )
|
|
{
|
|
PHB_ITEM pDstObject = hb_arrayClone( pSrcObject );
|
|
|
|
hb_itemCopy( &stack.Return, pDstObject );
|
|
hb_itemRelease( pDstObject );
|
|
}
|
|
else
|
|
{
|
|
hb_errorRT_BASE(EG_ARG, 3000, NULL, "OCLONE");
|
|
}
|
|
}
|
|
|
|
|
|
/*
|
|
* <xRet> = oSend( <oObj>, <cSymbol>, <xArg,..>
|
|
*
|
|
* Send a message to an object
|
|
*/
|
|
HARBOUR HB_OSEND(void)
|
|
{
|
|
PHB_ITEM pObject = hb_param( 1, IT_OBJECT );
|
|
PHB_ITEM pMessage = hb_param( 2, IT_STRING );
|
|
WORD w;
|
|
|
|
if( pMessage && pObject ) /* Object & message passed */
|
|
{
|
|
Push( pObject ); /* Push object */
|
|
Message( hb_GetDynSym( pMessage->item.asString.value )->pSymbol );
|
|
/* Push char symbol as message */
|
|
for( w = 3; w <= hb_pcount(); w++ ) /* Push arguments on stack */
|
|
Push( hb_param( w, IT_ANY ) );
|
|
Do( hb_pcount()-2 ); /* Execute message */
|
|
}
|
|
else
|
|
{
|
|
hb_errorRT_BASE(EG_ARG, 3000, NULL, "OSEND");
|
|
}
|
|
}
|
|
|
|
|
|
/*
|
|
* ReleaseClass( <pClass> )
|
|
*
|
|
* Release a class from memory
|
|
*/
|
|
void ReleaseClass( PCLASS pClass )
|
|
{
|
|
WORD wAt;
|
|
WORD wLimit;
|
|
PMETHOD pMeth;
|
|
|
|
wLimit = pClass->wHashKey * BUCKET;
|
|
pMeth = pClass->pMethods;
|
|
for( wAt = 0; wAt < wLimit; wAt++, pMeth++ ) /* Release initializers */
|
|
if( pMeth->pInitValue && pMeth->wData > pClass->wDataFirst )
|
|
hb_itemRelease( pMeth->pInitValue );
|
|
|
|
hb_xfree( pClass->szName );
|
|
hb_xfree( pClass->pMethods );
|
|
|
|
hb_itemRelease( pClass->pClassDatas );
|
|
hb_itemRelease( pClass->pInlines );
|
|
}
|
|
|
|
|
|
/*
|
|
* ReleaseClasses()
|
|
*
|
|
* Release all classes
|
|
*/
|
|
void ReleaseClasses( void )
|
|
{
|
|
WORD w;
|
|
|
|
for( w = 0; w < wClasses; w++ )
|
|
ReleaseClass( pClasses + w );
|
|
|
|
if( pClasses )
|
|
hb_xfree( pClasses );
|
|
}
|
|
|
|
|
|
/*
|
|
* SelectSuper()
|
|
*
|
|
* Internal function to cast to a super method
|
|
*/
|
|
static HARBOUR SelectSuper( void )
|
|
{
|
|
PHB_ITEM pObject = stack.pBase + 1;
|
|
PHB_ITEM pSuper = (PHB_ITEM) hb_xgrab( sizeof( HB_ITEM ) );
|
|
PBASEARRAY pNewBase = (PBASEARRAY) hb_xgrab( sizeof( BASEARRAY ) );
|
|
WORD wSuperCls = pMethod->wData; /* Get handle of superclass */
|
|
|
|
memcpy( pSuper, pObject, sizeof( HB_ITEM ) );
|
|
/* Allocate new structures */
|
|
memcpy( pNewBase, pObject->item.asArray.value, sizeof( BASEARRAY ) );
|
|
|
|
pSuper->item.asArray.value = pNewBase;
|
|
|
|
pNewBase->wClass = wSuperCls;
|
|
pNewBase->wHolders = 1; /* New item is returned */
|
|
pNewBase->wSuperCast = TRUE; /* Do not dispose pItems !! */
|
|
/* A bit dirty, but KISS. */
|
|
hb_itemCopy( &stack.Return, pSuper );
|
|
hb_itemRelease( pSuper );
|
|
}
|
|
|
|
|
|
/*
|
|
* SetClassData()
|
|
*
|
|
* Internal function to set a CLASSDATA
|
|
*/
|
|
static HARBOUR SetClassData( void )
|
|
{
|
|
WORD wClass = ( stack.pBase + 1 )->item.asArray.value->wClass;
|
|
PHB_ITEM pReturn = stack.pBase + 2;
|
|
|
|
if( wClass && wClass <= wClasses )
|
|
{
|
|
hb_arraySet( pClasses[ wClass - 1 ].pClassDatas,
|
|
pMethod->wData, pReturn );
|
|
hb_itemCopy( &stack.Return, pReturn );
|
|
}
|
|
}
|
|
|
|
|
|
/*
|
|
* SetData()
|
|
*
|
|
* Internal function to set a DATA
|
|
*/
|
|
static HARBOUR SetData( void )
|
|
{
|
|
PHB_ITEM pObject = stack.pBase + 1;
|
|
PHB_ITEM pReturn = stack.pBase + 2;
|
|
WORD wIndex = pMethod->wData;
|
|
|
|
if( wIndex > ( WORD ) hb_arrayLen( pObject ) )
|
|
/* Resize needed */
|
|
hb_arraySize( pObject, wIndex ); /* Make large enough */
|
|
hb_arraySet( pObject, wIndex, pReturn );
|
|
hb_itemCopy( &stack.Return, pReturn );
|
|
}
|
|
|
|
|
|
/* No comment :-) */
|
|
static HARBOUR Virtual( void )
|
|
{
|
|
hb_ret();
|
|
}
|
|
|
|
|
|
/*
|
|
* <hClass> := hb__InstSuper( <cName> )
|
|
*
|
|
* Instance super class and return class handle
|
|
*/
|
|
HARBOUR HB___INSTSUPER( void )
|
|
{
|
|
PHB_ITEM pString = hb_param( 1, IT_STRING );
|
|
PDYNSYM pDynSym;
|
|
BYTE bFound = FALSE;
|
|
WORD w;
|
|
|
|
if( pString )
|
|
{
|
|
pDynSym = hb_FindDynSym( pString->item.asString.value );
|
|
if( pDynSym ) /* Find function */
|
|
{
|
|
PushSymbol( pDynSym->pSymbol ); /* Push function name */
|
|
PushNil();
|
|
Function( 0 ); /* Execute super class */
|
|
|
|
if( !IS_OBJECT( &stack.Return ) )
|
|
{
|
|
/* hb_errPutDescription(pError, "INSTSUPER : Super class does not return an object"); */
|
|
hb_errorRT_BASE(EG_ARG, 3002, NULL, "__INSTSUPER");
|
|
}
|
|
|
|
for( w = 0; !bFound && w < wClasses; w++ )
|
|
{ /* Locate the entry */
|
|
if( !hb_stricmp( pString->item.asString.value, pClasses[ w ].szName ) )
|
|
{
|
|
hb_retni( w + 1 ); /* Entry + 1 = ClassH */
|
|
bFound = TRUE;
|
|
}
|
|
}
|
|
}
|
|
else
|
|
{
|
|
/* hb_errPutDescription(pError, "INSTSUPER : Cannot find super class"); */
|
|
hb_errorRT_BASE(EG_ARG, 3003, NULL, "__INSTSUPER");
|
|
}
|
|
}
|
|
if( !bFound )
|
|
hb_retni( 0 );
|
|
}
|
|
|
|
|
|
/*
|
|
* <nSeq> = hb__wClsDatas( <hClass> )
|
|
*
|
|
* Return number of class datas
|
|
*/
|
|
HARBOUR HB___WCLSDATAS(void)
|
|
{
|
|
WORD wClass = hb_parnl( 1 );
|
|
PCLASS pClass;
|
|
|
|
if( wClass )
|
|
{
|
|
pClass = &pClasses[ wClass - 1 ];
|
|
hb_retni( hb_arrayLen( pClass->pClassDatas ) );
|
|
}
|
|
}
|
|
|
|
/*
|
|
* <nSeq> = hb__wDataDec( <hClass> )
|
|
*
|
|
* Return number of datas and decrease
|
|
*/
|
|
HARBOUR HB___WDATADEC(void)
|
|
{
|
|
WORD wClass = hb_parnl( 1 );
|
|
|
|
if( wClass )
|
|
hb_retni( pClasses[ wClass - 1 ].wDatas-- );
|
|
}
|
|
|
|
|
|
/*
|
|
* <nSeq> = hb__wDataInc( <hClass> )
|
|
*
|
|
* Return number of datas and decrease
|
|
*/
|
|
HARBOUR HB___WDATAINC(void)
|
|
{
|
|
WORD wClass = hb_parnl( 1 );
|
|
|
|
if( wClass )
|
|
hb_retni( ++pClasses[ wClass - 1 ].wDatas );
|
|
}
|
|
|
|
|
|
/*
|
|
* <nSeq> = hb__wDatas( <hClass> )
|
|
*
|
|
* Return number of datas
|
|
*/
|
|
HARBOUR HB___WDATAS(void)
|
|
{
|
|
WORD wClass = hb_parnl( 1 );
|
|
|
|
if( wClass )
|
|
hb_retni( pClasses[ wClass - 1 ].wDatas );
|
|
}
|
|
|