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

19990914-11:40 GMT+1

Browse Source
This commit is contained in:
Viktor Szakats
1999-09-14 10:02:44 +00:00
parent c7f7909be2
commit 71ef013ace
16 changed files with 274 additions and 130 deletions
Download Patch File Download Diff File Expand all files Collapse all files

47
harbour/ChangeLog
View File

@@ -1,3 +1,50 @@
19990914-11:40 GMT+1 Victor Szel <info@szelvesz.hu>
* source/runner/stdalone/external.prg
include/external.ch
* Regenerated.
* source/runner/runlib.c
! Made some steps to release memory blocks when an undeclared symbol error
occurs, seemingly with few success. This needs some more work.
+ TODO added about a possible direction for further development.
The idea would be to replicate the Blinker DLL functionality.
* source/compiler/harbour.y
source/compiler/harbour.l
source/compiler/gen*.c
* Only every 100th line number is shown on the counter while parsing,
this way it's more Clipper like. In theory it should also be faster,
but due to the stdout buffering, it's approx. the same speed. Though it
could be faster in some platform/compiler/screen output combinations.
+ The "syntax ok" message is now replaced with the total number of
functions and the total number of lines. Similar to Clipper, but not
so specific to the generated output.
+ /q0 switch no suppresses the "Harbour Compiler" header.
+ The "Generating ... output" line format changed, it's now more
compact.
* tests/working/rtl_test.prg
+ A new VAL() test added to test the huge value problem.
! One failure eliminated by hiding a filename generating difference in
__COPYFILE(), NOTE added about this.
* source/rtl/strings.c
+ HB_VAL() now uses hb_retnlen().
! HB_VAL() was incompatible for huge integer values (5000000000). This
is fixed.
* source/rtl/memvars.c
* __MVRESTORE() is now using hb_itemPutNLen()
* source/rtl/extend.c
include/extend.h
+ hb_retnlen() Extend API function added, which is a wrapper for
hb_itemPutNLen().
* source/rtl/itemapi.c
include/itemapi.h
+ hb_itemPutNLen() generic function added to assign a number to an item,
the low-level type of the number is automatically selected, based on the
magnitude and presence of decimal places. Similar to hb_vmPushNumber().
+ hb_itemPutN?Len() functions will now accept any negative width/dec
parameters as a request for the default. So:
For iDec now any negative number will do the same as -1 before.
For iWidth now any negative number will do the same as 0 before.
This way the interface is more fool proof and consistent.
19990914-01:00 GMT+1 Victor Szel <info@szelvesz.hu>
* source/vm/hvm.c
include/ctoharb.h

1
harbour/include/extend.h
View File

@@ -256,6 +256,7 @@ extern void hb_retl( int iTrueFalse ); /* returns a logical integer */
extern void hb_retnd( double dNumber ); /* returns a double */
extern void hb_retni( int iNumber ); /* returns a integer number */
extern void hb_retnl( long lNumber ); /* returns a long number */
extern void hb_retnlen( double dNumber, int iWidth, int iDec ); /* returns a double, with specific width and decimals */
extern void hb_retndlen( double dNumber, int iWidth, int iDec ); /* returns a double, with specific width and decimals */
extern void hb_retnilen( int iNumber, int iWidth ); /* returns a integer number, with specific width */
extern void hb_retnllen( long lNumber, int iWidth ); /* returns a long number, with specific width */

44
harbour/include/external.ch
View File

@@ -36,6 +36,17 @@
// Files from: vm
//
//
//symbols from file: vm\debug.c
//
EXTERNAL __ASTATIC
EXTERNAL __STATIC
EXTERNAL __GLOBALSTACKLEN
EXTERNAL __AGLOBALSTACK
EXTERNAL __STACKLEN
EXTERNAL __ASTACK
EXTERNAL __APARAM
EXTERNAL __GETLOCAL
//
//symbols from file: vm\dynsym.c
//
EXTERNAL __DYNSCOUNT
@@ -49,6 +60,7 @@ EXTERNAL ERRORNEW
EXTERNAL LEN
EXTERNAL EMPTY
EXTERNAL VALTYPE
EXTERNAL TYPE
EXTERNAL WORD
EXTERNAL PROCNAME
EXTERNAL PROCLINE
@@ -58,6 +70,9 @@ EXTERNAL PCOUNT
EXTERNAL PVALUE
EXTERNAL BREAK
//
//symbols from file: vm\hvm_.c
//
//
//symbols from file: vm\initsymb.c
//
//------------------------------------------------------------
@@ -130,6 +145,7 @@ EXTERNAL SAVESCREEN
EXTERNAL RESTSCREEN
EXTERNAL SETCURSOR
EXTERNAL SETBLINK
EXTERNAL SETMODE
EXTERNAL __ACCEPT
EXTERNAL __COLORINDEX
//
@@ -229,6 +245,8 @@ EXTERNAL __KEYBOARD
EXTERNAL __KEYPUT
EXTERNAL NEXTKEY
EXTERNAL LASTKEY
EXTERNAL FKLABEL
EXTERNAL FKMAX
//
//symbols from file: rtl\itemapi.c
//
@@ -248,10 +266,6 @@ EXTERNAL MOD
EXTERNAL ROUND
EXTERNAL SQRT
//
//symbols from file: rtl\memvarbl.prg
//
EXTERNAL MEMVARBLOCK
//
//symbols from file: rtl\memvars.c
//
EXTERNAL __MVPUBLIC
@@ -263,6 +277,13 @@ EXTERNAL __MVCLEAR
EXTERNAL __MVDBGINFO
EXTERNAL __MVGET
EXTERNAL __MVPUT
EXTERNAL __MVSAVE
EXTERNAL __MVRESTORE
EXTERNAL __MCLEAR
EXTERNAL __MRELEASE
EXTERNAL __MXRELEASE
EXTERNAL __MSAVE
EXTERNAL __MRESTORE
//
//symbols from file: rtl\mouseapi.c
//
@@ -354,6 +375,10 @@ EXTERNAL DEVOUTPICT
//symbols from file: rtl\errorsys.prg
//
//
//symbols from file: rtl\memvarbl.prg
//
EXTERNAL MEMVARBLOCK
//
//symbols from file: rtl\menuto.prg
//
EXTERNAL __ATPROMPT
@@ -401,6 +426,7 @@ EXTERNAL TCLASS
//
//symbols from file: rtl\terror.prg
//
EXTERNAL ERRORNEW
//
//symbols from file: rtl\tget.prg
//
@@ -577,16 +603,6 @@ EXTERNAL BOY
//
EXTERNAL DATETIME
//
//symbols from file: tools\debug.c
//
EXTERNAL __ASTATIC
EXTERNAL __STATIC
EXTERNAL __GLOBALSTACKLEN
EXTERNAL __AGLOBALSTACK
EXTERNAL __STACKLEN
EXTERNAL __ASTACK
EXTERNAL __APARAM
//
//symbols from file: tools\hb_f.c
//
EXTERNAL HB_FUSE

3
harbour/include/itemapi.h
View File

@@ -79,7 +79,8 @@ extern PHB_ITEM hb_itemPutL ( PHB_ITEM pItem, BOOL bValue );
extern PHB_ITEM hb_itemPutND ( PHB_ITEM pItem, double dNumber );
extern PHB_ITEM hb_itemPutNI ( PHB_ITEM pItem, int iNumber );
extern PHB_ITEM hb_itemPutNL ( PHB_ITEM pItem, long lNumber );
extern PHB_ITEM hb_itemPutNDLen ( PHB_ITEM pItem, double dNumber, int iWidth, int iDecimal );
extern PHB_ITEM hb_itemPutNLen ( PHB_ITEM pItem, double dNumber, int iWidth, int iDec );
extern PHB_ITEM hb_itemPutNDLen ( PHB_ITEM pItem, double dNumber, int iWidth, int iDec );
extern PHB_ITEM hb_itemPutNILen ( PHB_ITEM pItem, int iNumber, int iWidth );
extern PHB_ITEM hb_itemPutNLLen ( PHB_ITEM pItem, long lNumber, int iWidth );
extern BOOL hb_itemRelease ( PHB_ITEM pItem );

4
harbour/source/compiler/genc.c
View File

@@ -60,7 +60,7 @@ void GenCCode( char * szFileName, char * szName ) /* generates the C langu
}
if( ! _bQuiet )
printf( "\nGenerating C language output...\n" );
printf( "\nGenerating C language output to \'%s\'... ", szFileName );
fprintf( yyc, "/* Harbour compiler generated code */\n\n" );
fprintf( yyc, "#include \"hb_vmpub.h\"\n" );
@@ -935,5 +935,5 @@ void GenCCode( char * szFileName, char * szName ) /* generates the C langu
pSym = KillSymbol( pSym );
if( ! _bQuiet )
printf( "%s -> done!\n", szFileName );
printf( "Done.\n" );
}

4
harbour/source/compiler/genhrb.c
View File

@@ -64,7 +64,7 @@ void GenPortObj( char * szFileName, char * szName )
}
if( ! _bQuiet )
printf( "\nGenerating portable object...\n" );
printf( "\nGenerating portable object output to \'%s\'... ", szFileName );
/* writes the symbol table */
@@ -380,5 +380,5 @@ void GenPortObj( char * szFileName, char * szName )
fclose( yyc );
if( ! _bQuiet )
printf( "%s -> done!\n", szFileName );
printf( "Done.\n" );
}

4
harbour/source/compiler/genobj32.c
View File

@@ -77,7 +77,7 @@ void GenObj32( char * szObjFileName, char * szFileName )
}
if( ! _bQuiet )
printf( "\nGenerating Windows/Dos OBJ 32 bits..." );
printf( "\nGenerating Windows/DOS OBJ 32 bits language output to \'%s\'... ", szObjFileName );
CompiledFileName( hObjFile, szFileName );
CompilerVersion( hObjFile, "Harbour" );
@@ -91,7 +91,7 @@ void GenObj32( char * szObjFileName, char * szFileName )
fclose( hObjFile );
if( ! _bQuiet )
printf( "\n%s -> done!\n", szObjFileName );
printf( "Done.\n" );
}
static ULONG GetSymbolsSize( void )

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

@@ -218,11 +218,27 @@ Separator {SpaceTab}
{SpaceTab} ;
\n.* _iState=LOOKUP; yyless( 1 ); ++iLine; if( ! _bQuiet ) printf( "\rline: %i", iLine ); return '\n';
\n.* {
_iState = LOOKUP;
yyless( 1 );
++iLine;
#if 0
if( ! _bQuiet )
{
printf( "\r%i", iLine );
}
#endif
if( ! _bQuiet && ( iLine % 100 ) == 0 )
{
printf( "\r%i", iLine );
fflush( stdout );
}
return '\n';
}
%{
/* ************************************************************************ */
%}
; _iState =LOOKUP; if( ! i_INDEX_STATE ) return ';';
; _iState = LOOKUP; if( ! i_INDEX_STATE ) return ';';
%{
/* ************************************************************************ */
%}

39
harbour/source/compiler/harbour.y
View File

@@ -422,8 +422,11 @@ SYMBOLS symbols;
#define HB_EXITLEVEL_SETEXIT 1
#define HB_EXITLEVEL_DELTARGET 2
int iFunctions = 0;
BOOL _bStartProc = TRUE; /* holds if we need to create the starting procedure */
BOOL _bLineNumbers = TRUE; /* holds if we need pcodes with line numbers */
BOOL _bLogo = TRUE; /* print logo */
BOOL _bQuiet = FALSE; /* quiet mode */
BOOL _bSyntaxCheckOnly = FALSE; /* syntax check only */
int _iLanguage = LANG_C; /* default Harbour generated output language */
@@ -539,7 +542,8 @@ extern int _iState; /* current parser state (defined in harbour.l */
Main : { Line(); } Source {
FixReturns(); /* fix all previous function returns offsets */
if( ! _bQuiet ) printf( "\nsyntax ok\n" );
if( ! _bQuiet )
printf( "\rLines %i, Functions %i\n", iLine, iFunctions );
}
Source : Crlf
@@ -1338,12 +1342,29 @@ void EXTERNAL_LINKAGE close_on_exit( void )
int harbour_main( int argc, char * argv[] )
{
int iStatus = 0, iArg = 1;
int iStatus = 0;
int iArg;
BOOL bSkipGen;
printf( "Harbour Compiler, Build %i%s (%04d.%02d.%02d)\n",
hb_build, hb_revision, hb_year, hb_month, hb_day );
printf( "Copyright 1999, http://www.harbour-project.org\n" );
/* Check for the nologo switch /q0 before everything else. */
for( iArg = 1; iArg < argc; iArg++ )
{
if( IS_OPT_SEP( argv[ iArg ][ 0 ] ) &&
( argv[ iArg ][ 1 ] == 'q' || argv[ iArg ][ 1 ] == 'Q' ) &&
argv[ iArg ][ 2 ] == '0' )
{
_bLogo = FALSE;
break;
}
}
if( _bLogo )
{
printf( "Harbour Compiler, Build %i%s (%04d.%02d.%02d)\n",
hb_build, hb_revision, hb_year, hb_month, hb_day );
printf( "Copyright 1999, http://www.harbour-project.org\n" );
}
if( argc > 1 )
{
@@ -1353,7 +1374,7 @@ int harbour_main( int argc, char * argv[] )
Hbpp_init(); /* Initialization of preprocessor arrays */
/* Command line options */
while( iArg < argc )
for( iArg = 1; iArg < argc; iArg++ )
{
if( IS_OPT_SEP( argv[ iArg ][ 0 ] ) )
{
@@ -1575,8 +1596,6 @@ int harbour_main( int argc, char * argv[] )
printf( "Not yet supported command line option: %s\n", &argv[ iArg ][ 0 ] );
else
_pFileName = hb_fsFNameSplit( argv[ iArg ] );
iArg++;
}
if( _pFileName )
@@ -2231,7 +2250,7 @@ int Include( char * szFileName, PATHNAMES * pSearch )
}
if( ! _bQuiet )
printf( "\nCompiling %s\n", szFileName );
printf( "\nCompiling \'%s\'\n", szFileName );
pFile = ( PFILE ) hb_xgrab( sizeof( _FILE ) );
pFile->handle = yyin;
@@ -2475,6 +2494,8 @@ void FunDef( char * szFunName, SYMBOLSCOPE cScope, int iType )
GenError( _szCErrors, 'E', ERR_FUNC_RESERVED, szFunction, szFunName );
}
iFunctions++;
FixReturns(); /* fix all previous function returns offsets */
pSym = GetSymbol( szFunName, NULL );

6
harbour/source/rtl/extend.c
View File

@@ -37,6 +37,7 @@
http://www.Harbour-Project.org/
The following functions are Copyright 1999 Victor Szel <info@szelvesz.hu>:
hb_retnlen()
hb_retnilen()
hb_retnllen()
hb_retndlen()
@@ -484,6 +485,11 @@ void hb_retnl( long lNumber )
hb_itemPutNL( &stack.Return, lNumber );
}
void hb_retnlen( double dNumber, int iWidth, int iDec )
{
hb_itemPutNLen( &stack.Return, dNumber, iWidth, iDec );
}
void hb_retndlen( double dNumber, int iWidth, int iDec )
{
hb_itemPutNDLen( &stack.Return, dNumber, iWidth, iDec );

29
harbour/source/rtl/itemapi.c
View File

@@ -48,6 +48,7 @@
hb_itemGetCPtr()
hb_itemGetCLen()
hb_itemGetNLen()
hb_itemPutNLen()
hb_itemPutNDLen()
hb_itemPutNILen()
hb_itemPutNLLen()
@@ -633,6 +634,26 @@ PHB_ITEM hb_itemPutNL( PHB_ITEM pItem, long lNumber )
return pItem;
}
PHB_ITEM hb_itemPutNLen( PHB_ITEM pItem, double dNumber, int iWidth, int iDec )
{
if( iWidth <= 0 || iWidth > 99 )
iWidth = ( dNumber > 10000000000.0 ) ? 20 : 10;
if( iDec < 0 )
iDec = hb_set.HB_SET_DECIMALS;
if( iDec > 0 )
pItem = hb_itemPutNDLen( pItem, dNumber, iWidth, iDec );
else if( SHRT_MIN <= dNumber && dNumber <= SHRT_MAX )
pItem = hb_itemPutNILen( pItem, ( int ) dNumber, iWidth );
else if( LONG_MIN <= dNumber && dNumber <= LONG_MAX )
pItem = hb_itemPutNLLen( pItem, ( long ) dNumber, iWidth );
else
pItem = hb_itemPutNDLen( pItem, dNumber, iWidth, 0 );
return pItem;
}
PHB_ITEM hb_itemPutNDLen( PHB_ITEM pItem, double dNumber, int iWidth, int iDec )
{
if( pItem )
@@ -640,10 +661,10 @@ PHB_ITEM hb_itemPutNDLen( PHB_ITEM pItem, double dNumber, int iWidth, int iDec )
else
pItem = hb_itemNew( NULL );
if( iWidth == 0 || iWidth > 99 )
if( iWidth <= 0 || iWidth > 99 )
iWidth = ( dNumber > 10000000000.0 ) ? 20 : 10;
if( iDec == -1 )
if( iDec < 0 )
iDec = hb_set.HB_SET_DECIMALS;
pItem->type = IT_DOUBLE;
@@ -661,7 +682,7 @@ PHB_ITEM hb_itemPutNILen( PHB_ITEM pItem, int iNumber, int iWidth )
else
pItem = hb_itemNew( NULL );
if( iWidth == 0 || iWidth > 99 )
if( iWidth <= 0 || iWidth > 99 )
iWidth = 10;
pItem->type = IT_INTEGER;
@@ -678,7 +699,7 @@ PHB_ITEM hb_itemPutNLLen( PHB_ITEM pItem, long lNumber, int iWidth )
else
pItem = hb_itemNew( NULL );
if( iWidth == 0 || iWidth > 99 )
if( iWidth <= 0 || iWidth > 99 )
iWidth = 10;
pItem->type = IT_LONG;

17
harbour/source/rtl/memvars.c
View File

@@ -48,7 +48,6 @@
See doc/hdr_tpl.txt, Version 1.2 or later, for licensing terms.
*/
#include <limits.h> /* for __MVSAVE()/__MVRESTORE() */
#include <ctype.h> /* for toupper() function */
#include "extend.h"
@@ -1787,21 +1786,7 @@ HARBOUR HB___MVRESTORE( void )
BYTE pbyNumber[ HB_MEM_NUM_LEN ];
if( hb_fsRead( fhnd, pbyNumber, HB_MEM_NUM_LEN ) == HB_MEM_NUM_LEN )
{
double dNumber = * ( double * ) &pbyNumber;
if( uiWidth >= 1 && uiDec )
pItem = hb_itemPutNDLen( NULL, dNumber, uiWidth - uiDec - 1, uiDec );
else if( SHRT_MIN <= dNumber && dNumber <= SHRT_MAX )
pItem = hb_itemPutNILen( NULL, ( int ) dNumber, uiWidth );
else if( LONG_MIN <= dNumber && dNumber <= LONG_MAX )
pItem = hb_itemPutNLLen( NULL, ( long ) dNumber, uiWidth );
else
pItem = hb_itemPutNDLen( NULL, dNumber, uiWidth, 0 );
}
pItem = hb_itemPutNLen( NULL, * ( double * ) &pbyNumber, uiWidth - ( uiDec ? ( uiDec + 1 ) : 0 ), uiDec );
break;
}

13
harbour/source/rtl/strings.c
View File

@@ -1125,7 +1125,6 @@ HARBOUR HB_VAL( void )
{
int iWidth;
int iDec;
double dNumber = hb_strVal( pText->item.asString.value );
char * ptr = strchr( pText->item.asString.value, '.' );
if( ptr )
@@ -1139,17 +1138,7 @@ HARBOUR HB_VAL( void )
iDec = 0;
}
if( iDec )
hb_retndlen( dNumber, iWidth, iDec );
else if( SHRT_MIN <= dNumber && dNumber <= SHRT_MAX )
hb_retnilen( ( int ) dNumber, iWidth );
else if( LONG_MIN <= dNumber && dNumber <= LONG_MAX )
hb_retnllen( ( long ) dNumber, iWidth );
else
hb_retndlen( dNumber, iWidth, -1 );
hb_retnlen( hb_strVal( pText->item.asString.value ), iWidth, iDec );
}
else
hb_errRT_BASE( EG_ARG, 1098, NULL, "VAL" );

122
harbour/source/runner/runlib.c
View File

@@ -30,6 +30,20 @@
#include "ctoharb.h"
#include "pcode.h"
/* TODO: Separate the loading/unloading and the caller functions,
this way we could also call a specific function name from the
.HRB file. This way we have basically reproduced the DLL
functionality of Blinker.
hnd := __hrbLoad( "MYHRB.HRB" )
IF hnd != 0
__hrbDo( hnd, "MYINITFUNC", par1, par2 )
funhnd := __hrbGetHnd( hnd, "MYINITFUNC" )
__hrbDoHnd( funhnd, par1, par2 )
__hrbUnLoad( hnd )
ENDIF
*/
/* TODO: Fill the error codes with valid ones (instead of 9999) */
/* TOFIX: Change this assembler hack to something standard and portable */
/* TODO: Change the fopen()/fread()/fclose() calls to hb_fs*() */
@@ -106,6 +120,7 @@ HARBOUR HB___HRBRUN( void )
{
char * szFileName = hb_parc( 1 );
FILE * file;
BOOL bError = FALSE;
/* Open as binary */
@@ -128,8 +143,6 @@ HARBOUR HB___HRBRUN( void )
PHB_DYNF pDynFunc; /* Functions read */
PHB_DYNS pDynSym;
PHB_ITEM pRetVal;
int i;
ulSymbols = hb_hrbFileReadLong( file, szFileName );
@@ -173,7 +186,8 @@ HARBOUR HB___HRBRUN( void )
!( pSymRead[ ul ].cScope & FS_STATIC ) )
{
hb_errRT_BASE( EG_ARG, 9999, "Duplicate symbol", pSymRead[ ul ].szName );
return;
bError = TRUE;
break;
}
*/
pSymRead[ ul ].pFunPtr = pDynFunc[ ulPos ].pAsmCall->pFunPtr;
@@ -187,61 +201,70 @@ HARBOUR HB___HRBRUN( void )
if( !pDynSym )
{
hb_errRT_BASE( EG_ARG, 9999, "Unknown or unregistered symbol", pSymRead[ ul ].szName );
return;
bError = TRUE;
break;
}
pSymRead[ ul ].pFunPtr = pDynSym->pFunPtr;
}
}
hb_vmProcessSymbols( pSymRead, ulSymbols );
/* Initialize static variables first
*/
for( ul = 0; ul < ulSymbols; ul++ ) /* Check INIT functions */
if( ! bError )
{
if( ( pSymRead[ ul ].cScope & FS_INITEXIT ) == FS_INITEXIT )
{
/* call (_INITSTATICS) function. This function assigns
* literal values to static variables only. There is no need
* to pass any parameters to this function because they
* cannot be used to initialize static variable.
*/
pSymRead[ ul ].pFunPtr();
}
}
for( ul = 0; ul < ulSymbols; ul++ ) /* Check INIT functions */
{
if( ( pSymRead[ ul ].cScope & FS_INITEXIT ) == FS_INIT )
{
hb_vmPushSymbol( pSymRead + ul );
hb_vmPushNil();
for( i = 0; i < ( hb_pcount() - 1 ); i++ )
hb_vmPush( hb_param( i + 2, IT_ANY ) );
/* Push other cmdline params*/
hb_vmDo( hb_pcount() - 1 ); /* Run init function */
}
}
PHB_ITEM pRetVal;
hb_vmPushSymbol( pSymRead );
hb_vmPushNil();
for( i = 0; i < ( hb_pcount() - 1 ); i++ )
hb_vmPush( hb_param( i + 2, IT_ANY ) ); /* Push other cmdline params*/
hb_vmDo( hb_pcount() - 1 ); /* Run the thing !!! */
hb_vmProcessSymbols( pSymRead, ulSymbols );
pRetVal = hb_itemNew( NULL );
hb_itemCopy( pRetVal, &stack.Return );
for( ul = 0; ul < ulSymbols; ul++ ) /* Check EXIT functions */
{
if( ( pSymRead[ ul ].cScope & FS_INITEXIT ) == FS_EXIT )
/* Initialize static variables first
*/
for( ul = 0; ul < ulSymbols; ul++ ) /* Check INIT functions */
{
hb_vmPushSymbol( pSymRead + ul );
hb_vmPushNil();
hb_vmDo( 0 ); /* Run exit function */
pSymRead[ ul ].cScope = pSymRead[ ul ].cScope & ( ~FS_EXIT );
/* Exit function cannot be
handled by main in hvm.c */
if( ( pSymRead[ ul ].cScope & FS_INITEXIT ) == FS_INITEXIT )
{
/* call (_INITSTATICS) function. This function assigns
* literal values to static variables only. There is no need
* to pass any parameters to this function because they
* cannot be used to initialize static variable.
*/
pSymRead[ ul ].pFunPtr();
}
}
for( ul = 0; ul < ulSymbols; ul++ ) /* Check INIT functions */
{
if( ( pSymRead[ ul ].cScope & FS_INITEXIT ) == FS_INIT )
{
hb_vmPushSymbol( pSymRead + ul );
hb_vmPushNil();
for( i = 0; i < ( hb_pcount() - 1 ); i++ )
hb_vmPush( hb_param( i + 2, IT_ANY ) );
/* Push other cmdline params*/
hb_vmDo( hb_pcount() - 1 ); /* Run init function */
}
}
hb_vmPushSymbol( pSymRead );
hb_vmPushNil();
for( i = 0; i < ( hb_pcount() - 1 ); i++ )
hb_vmPush( hb_param( i + 2, IT_ANY ) ); /* Push other cmdline params*/
hb_vmDo( hb_pcount() - 1 ); /* Run the thing !!! */
pRetVal = hb_itemNew( NULL );
hb_itemCopy( pRetVal, &stack.Return );
for( ul = 0; ul < ulSymbols; ul++ ) /* Check EXIT functions */
{
if( ( pSymRead[ ul ].cScope & FS_INITEXIT ) == FS_EXIT )
{
hb_vmPushSymbol( pSymRead + ul );
hb_vmPushNil();
hb_vmDo( 0 ); /* Run exit function */
pSymRead[ ul ].cScope = pSymRead[ ul ].cScope & ( ~FS_EXIT );
/* Exit function cannot be
handled by main in hvm.c */
}
}
hb_itemReturn( pRetVal );
hb_itemRelease( pRetVal );
}
for( ul = 0; ul < ulFuncs; ul++ )
@@ -258,9 +281,6 @@ HARBOUR HB___HRBRUN( void )
hb_xfree( pDynFunc );
hb_xfree( pSymRead );
hb_hrbFileClose( file );
hb_itemReturn( pRetVal );
hb_itemRelease( pRetVal );
}
}
else

44
harbour/source/runner/stdalone/external.prg
View File

@@ -36,6 +36,17 @@
// Files from: vm
//
//
//symbols from file: vm\debug.c
//
EXTERNAL __ASTATIC
EXTERNAL __STATIC
EXTERNAL __GLOBALSTACKLEN
EXTERNAL __AGLOBALSTACK
EXTERNAL __STACKLEN
EXTERNAL __ASTACK
EXTERNAL __APARAM
EXTERNAL __GETLOCAL
//
//symbols from file: vm\dynsym.c
//
EXTERNAL __DYNSCOUNT
@@ -49,6 +60,7 @@ EXTERNAL ERRORNEW
EXTERNAL LEN
EXTERNAL EMPTY
EXTERNAL VALTYPE
EXTERNAL TYPE
EXTERNAL WORD
EXTERNAL PROCNAME
EXTERNAL PROCLINE
@@ -58,6 +70,9 @@ EXTERNAL PCOUNT
EXTERNAL PVALUE
EXTERNAL BREAK
//
//symbols from file: vm\hvm_.c
//
//
//symbols from file: vm\initsymb.c
//
//------------------------------------------------------------
@@ -130,6 +145,7 @@ EXTERNAL SAVESCREEN
EXTERNAL RESTSCREEN
EXTERNAL SETCURSOR
EXTERNAL SETBLINK
EXTERNAL SETMODE
EXTERNAL __ACCEPT
EXTERNAL __COLORINDEX
//
@@ -229,6 +245,8 @@ EXTERNAL __KEYBOARD
EXTERNAL __KEYPUT
EXTERNAL NEXTKEY
EXTERNAL LASTKEY
EXTERNAL FKLABEL
EXTERNAL FKMAX
//
//symbols from file: rtl\itemapi.c
//
@@ -248,10 +266,6 @@ EXTERNAL MOD
EXTERNAL ROUND
EXTERNAL SQRT
//
//symbols from file: rtl\memvarbl.prg
//
EXTERNAL MEMVARBLOCK
//
//symbols from file: rtl\memvars.c
//
EXTERNAL __MVPUBLIC
@@ -263,6 +277,13 @@ EXTERNAL __MVCLEAR
EXTERNAL __MVDBGINFO
EXTERNAL __MVGET
EXTERNAL __MVPUT
EXTERNAL __MVSAVE
EXTERNAL __MVRESTORE
EXTERNAL __MCLEAR
EXTERNAL __MRELEASE
EXTERNAL __MXRELEASE
EXTERNAL __MSAVE
EXTERNAL __MRESTORE
//
//symbols from file: rtl\mouseapi.c
//
@@ -354,6 +375,10 @@ EXTERNAL DEVOUTPICT
//symbols from file: rtl\errorsys.prg
//
//
//symbols from file: rtl\memvarbl.prg
//
EXTERNAL MEMVARBLOCK
//
//symbols from file: rtl\menuto.prg
//
EXTERNAL __ATPROMPT
@@ -401,6 +426,7 @@ EXTERNAL TCLASS
//
//symbols from file: rtl\terror.prg
//
EXTERNAL ERRORNEW
//
//symbols from file: rtl\tget.prg
//
@@ -577,16 +603,6 @@ EXTERNAL BOY
//
EXTERNAL DATETIME
//
//symbols from file: tools\debug.c
//
EXTERNAL __ASTATIC
EXTERNAL __STATIC
EXTERNAL __GLOBALSTACKLEN
EXTERNAL __AGLOBALSTACK
EXTERNAL __STACKLEN
EXTERNAL __ASTACK
EXTERNAL __APARAM
//
//symbols from file: tools\hb_f.c
//
EXTERNAL HB_FUSE

7
harbour/tests/working/rtl_test.prg
View File

@@ -927,6 +927,8 @@ STATIC FUNCTION Main_MATH()
TEST_LINE( Str(Val("15.00") ) , "15.00" )
TEST_LINE( Str(Val("15.000") ) , "15.000" )
TEST_LINE( Str(Val("15.001 ") ) , "15.0010" )
TEST_LINE( Str(Val("100000000") ) , "100000000" )
TEST_LINE( Str(Val("5000000000") ) , "5000000000" )
TEST_LINE( Str(Year(SToD("19990905")) ) , " 1999" )
TEST_LINE( Str(Month(SToD("19990905")) ) , " 9" )
TEST_LINE( Str(Day(SToD("19990905")) ) , " 5" )
@@ -1667,11 +1669,14 @@ STATIC FUNCTION Main_MISC()
/* NOTE: Cannot yet test the return value of the function on a DEFAULT-ed
failure. */
/* NOTE: The dot in the "*INVALID*." filename is intentional and serves
to hide different path handling, since Harbour is platform
independent. */
TEST_LINE( __copyfile("$$COPYFR.TMP") , "E BASE 2010 Argument error __COPYFILE " )
TEST_LINE( __copyfile("$$COPYFR.TMP", "$$COPYTO.TMP") , NIL )
TEST_LINE( __copyfile("_NOTHERE.$$$", "$$COPYTO.TMP") , "E BASE 2012 Open error _NOTHERE.$$$ F:DR" )
TEST_LINE( __copyfile("$$COPYFR.TMP", "*INVALID*") , "E BASE 2012 Create error *INVALID*. F:DR" )
TEST_LINE( __copyfile("$$COPYFR.TMP", "*INVALID*.") , "E BASE 2012 Create error *INVALID*. F:DR" )
FErase("$$COPYFR.TMP")
FErase("$$COPYTO.TMP")