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

*** empty log message ***

Browse Source
This commit is contained in:
Viktor Szakats
1999-08-04 15:54:15 +00:00
parent 316192136b
commit 1ad06736f0
32 changed files with 570 additions and 380 deletions
Download Patch File Download Diff File Expand all files Collapse all files

86
harbour/ChangeLog
View File

@@ -1,3 +1,89 @@
19990804-17:30 GMT+1 Victor Szel <info@szelvesz.hu>
* source/rtl/msgxxx.c
- __TURBOC__ branch deleted.
* source/rtl/alert.prg
+ Added the handling of first parameters of Alert() if they are not strings.
* source/rtl/copyfile.c
+ Changed to use: hb_errorRT_BASE_Ext1()
So now it can retry or default.
* source/rtl/errorapi.c
include/rtl/errorapi.h
+ Added: hb_errorRT_BASE_Ext1()
+ Added: hb_errorRT_New() (static)
! Fixed: hb_errorLaunch() so that it converts the logical
value returned by the codeblock to a number.
+ Added: hb_errorLaunch() some notes about internal error which can occur
here.
* source/rtl/errorsys.prg
+ Added: Alert() box.
* source/rtl/msgxxx.c (code moved away from here)
source/rtl/classes.c
source/rtl/errorapi.c
source/vm/hvm.v
+ Uses Language API instead of hb_errorNat...() function.
* source/vm/hvm.c
! LONG lLineNo -> WORD wLineNo to suppress a warning.
* include/langapi.h
source/rtl/langapi.c
+ Language API initial implementation.
* source/rtl/vm/ForTest()
- Removed the "internal error" which stated that there will
be infinite loop if STEP 0 is used, Clipper just goes into an
ininite loop.
! Changed printf() to a standard error is STEP expression is not numeric.
* include/errorapi.h
source/rtl/errorapi.c
source/rtl/msgxxx.c
source/rtl/msg*.c
+ Added internal error launcher API call hb_errorInternal()
* source/hbpp/hbpp.c
include/hberrors.h
* "#error" message standardized, made Clipper like.
* tests/working/Makefile
tests/working/dyssym.prg
+ __DYNSYM*() tests added.
* include/Makefile
include/initsymc.h (renamed from initsymb.h)
include/initsymd.h (added)
source/vm/initsymb.c
source/runner/runner.c
Init function extern declarations put into initsymd.h
* source/vm/dynsym.c
* Name changes:
HB_DYNSYMBOLS -> HB___DYNSYMCOUNT
HB_DYNSYMNAME -> HB___DYNSYMGETNAME
HB_GETDYNSYM -> HB___DYNSYMGETINDEX
* source/runner/runner.c
! Using "ctoharb.h"
* source/rtl/gt/gtwin.c
! Compiler warning corrected.
* source/rtl/achoice.prg
% Some small optimalizations, userfunc as codeblock support documented.
* source/rtl/alert.prg
+ Added TOFIX: DispBegin issue.
* include/ctoharb.h
include/extend.h
include/init.h
source/vm/initsymb.c
source/vm/hvm.c
source/vm/dynsym.c
source/rtl/memvars.c
source/rtl/codebloc.c
source/rtl/classes.c
source/runner/runner.c
source/compiler/genobj32.c
* SYMBOL -> HB_SYMB
PSYMBOL -> PHB_SYMB
* tests/working/Makefile
+ debugger.prg and testread.prg added
* source/rtl/tget.prg
source/rtl/tgetlist.prg
tests/working/testread.prg
tests/working/debugger.prg
+ CVS tags added.
* source/rtl/Makefile
+ Added tget*.prg
Wed Aug 04 11:00:07 1999 Gonzalo A. Diethelm <Gonzalo.Diethelm@jda.cl>
* source/tools/stringsx.c:

4
harbour/include/Makefile
View File

@@ -20,9 +20,11 @@ C_HEADERS=\
hbsetup.h \
hbver.h \
init.h \
initsymb.h \
initsymc.h \
initsymd.h \
inkey.h \
itemapi.h \
langapi.h \
pcode.h \
rddapi.h \
run_exp.h \

6
harbour/include/ctoharb.h
View File

@@ -30,8 +30,8 @@
/* Calling Harbour from C code */
/* executing Harbour code from C */
extern void Message( PSYMBOL );
extern void PushSymbol( PSYMBOL pSym ); /* pushes a function pointer onto the stack */
extern void Message( PHB_SYMB );
extern void PushSymbol( PHB_SYMB pSym ); /* pushes a function pointer onto the stack */
extern void Push( PHB_ITEM pItem ); /* pushes any item to the stack */
extern void PushNil( void ); /* in this case it places nil at self */
/* parameters should come here using Push...() */
@@ -41,7 +41,7 @@ extern void PushLong( long lNumber );
extern void PushDouble( double dNumber, WORD wDec );
extern void PushString( char * szText, ULONG length ); /* pushes a string on to the stack */
extern void PushLogical( int iTrueFalse ); /* pushes a logical value onto the stack */
extern void PushSymbol( PSYMBOL );
extern void PushSymbol( PHB_SYMB );
extern void Do( WORD wParams ); /* invokes the virtual machine */
extern void Function( WORD wParams ); /* invokes the virtual machine */

64
harbour/include/errorapi.h
View File

@@ -71,39 +71,41 @@
/* Standard API */
extern char * hb_errGetDescription ( PHB_ITEM pError );
extern char * hb_errGetFileName ( PHB_ITEM pError );
extern USHORT hb_errGetFlags ( PHB_ITEM pError );
extern USHORT hb_errGetGenCode ( PHB_ITEM pError );
extern char * hb_errGetOperation ( PHB_ITEM pError );
extern USHORT hb_errGetOsCode ( PHB_ITEM pError );
extern USHORT hb_errGetSeverity ( PHB_ITEM pError );
extern USHORT hb_errGetSubCode ( PHB_ITEM pError );
extern char * hb_errGetSubSystem ( PHB_ITEM pError );
extern USHORT hb_errGetTries ( PHB_ITEM pError );
extern WORD hb_errLaunch ( PHB_ITEM pError );
extern PHB_ITEM hb_errNew ( void );
extern PHB_ITEM hb_errPutDescription ( PHB_ITEM pError, char * szDescription );
extern PHB_ITEM hb_errPutFileName ( PHB_ITEM pError, char * szFileName );
extern PHB_ITEM hb_errPutFlags ( PHB_ITEM pError, USHORT uiFlags );
extern PHB_ITEM hb_errPutGenCode ( PHB_ITEM pError, USHORT uiGenCode );
extern PHB_ITEM hb_errPutOperation ( PHB_ITEM pError, char * szOperation );
extern PHB_ITEM hb_errPutOsCode ( PHB_ITEM pError, USHORT uiOsCode );
extern PHB_ITEM hb_errPutSeverity ( PHB_ITEM pError, USHORT uiSeverity );
extern PHB_ITEM hb_errPutSubCode ( PHB_ITEM pError, USHORT uiSubCode );
extern PHB_ITEM hb_errPutSubSystem ( PHB_ITEM pError, char * szSubSystem );
extern PHB_ITEM hb_errPutTries ( PHB_ITEM pError, USHORT uiTries );
extern void hb_errRelease ( PHB_ITEM pError );
extern char * hb_errGetDescription ( PHB_ITEM pError );
extern char * hb_errGetFileName ( PHB_ITEM pError );
extern USHORT hb_errGetFlags ( PHB_ITEM pError );
extern USHORT hb_errGetGenCode ( PHB_ITEM pError );
extern char * hb_errGetOperation ( PHB_ITEM pError );
extern USHORT hb_errGetOsCode ( PHB_ITEM pError );
extern USHORT hb_errGetSeverity ( PHB_ITEM pError );
extern USHORT hb_errGetSubCode ( PHB_ITEM pError );
extern char * hb_errGetSubSystem ( PHB_ITEM pError );
extern USHORT hb_errGetTries ( PHB_ITEM pError );
extern WORD hb_errLaunch ( PHB_ITEM pError );
extern PHB_ITEM hb_errNew ( void );
extern PHB_ITEM hb_errPutDescription ( PHB_ITEM pError, char * szDescription );
extern PHB_ITEM hb_errPutFileName ( PHB_ITEM pError, char * szFileName );
extern PHB_ITEM hb_errPutFlags ( PHB_ITEM pError, USHORT uiFlags );
extern PHB_ITEM hb_errPutGenCode ( PHB_ITEM pError, USHORT uiGenCode );
extern PHB_ITEM hb_errPutOperation ( PHB_ITEM pError, char * szOperation );
extern PHB_ITEM hb_errPutOsCode ( PHB_ITEM pError, USHORT uiOsCode );
extern PHB_ITEM hb_errPutSeverity ( PHB_ITEM pError, USHORT uiSeverity );
extern PHB_ITEM hb_errPutSubCode ( PHB_ITEM pError, USHORT uiSubCode );
extern PHB_ITEM hb_errPutSubSystem ( PHB_ITEM pError, char * szSubSystem );
extern PHB_ITEM hb_errPutTries ( PHB_ITEM pError, USHORT uiTries );
extern void hb_errRelease ( PHB_ITEM pError );
/* Error launchers */
extern WORD hb_errorRT_BASE ( ULONG ulGenCode, ULONG ulSubCode, char * szDescription, char * szOperation );
extern WORD hb_errorRT_TERMINAL ( ULONG ulGenCode, ULONG ulSubCode, char * szDescription, char * szOperation );
extern WORD hb_errorRT_DBCMD ( ULONG ulGenCode, ULONG ulSubCode, char * szDescription, char * szOperation );
extern WORD hb_errorRT_TOOLS ( ULONG ulGenCode, ULONG ulSubCode, char * szDescription, char * szOperation );
/* TODO: Enable this:
extern void hb_errorInternal ( ULONG ulCode );
*/
extern char * hb_errorNatDescription ( ULONG ulGenCode ); /* Reads error description in national language */
extern void hb_errorInternal ( ULONG ulIntCode, char * szText, char * szModul, WORD wLine, char * szPar1, char * szPar2, char * szPar3 );
extern WORD hb_errorRT_BASE ( ULONG ulGenCode, ULONG ulSubCode, char * szDescription, char * szOperation );
extern WORD hb_errorRT_BASE_Ext1 ( ULONG ulGenCode, ULONG ulSubCode, char * szDescription, char * szOperation, USHORT uiOsCode, USHORT uiFlags );
extern WORD hb_errorRT_TERMINAL ( ULONG ulGenCode, ULONG ulSubCode, char * szDescription, char * szOperation );
extern WORD hb_errorRT_DBCMD ( ULONG ulGenCode, ULONG ulSubCode, char * szDescription, char * szOperation );
extern WORD hb_errorRT_TOOLS ( ULONG ulGenCode, ULONG ulSubCode, char * szDescription, char * szOperation );
extern char * hb_errorNatDescription ( ULONG ulGenCode ); /* Reads error description in national language */
extern char * hb_errorNatInternal ( ULONG ulIntCode ); /* Reads internal error description in national language */
#endif /* HB_ERRORAPI_H_ */

33
harbour/include/extend.h
View File

@@ -49,7 +49,7 @@ typedef struct
SYMBOLSCOPE cScope; /* the scope of the symbol */
PHB_FUNC pFunPtr; /* function address for function symbol table entries */
struct _DYNSYM * pDynSym; /* pointer to its dynamic symbol if defined */
} SYMBOL, * PSYMBOL, * SYMBOL_PTR;
} HB_SYMB, * PHB_SYMB, * HB_SYMB_PTR, SYMBOL, * PSYMBOL, * SYMBOL_PTR;
/* Harbour Functions scope */
#define FS_PUBLIC 0
@@ -60,8 +60,8 @@ typedef struct
#define FS_MESSAGE 32
#define FS_MEMVAR 128
extern void VirtualMachine( PBYTE pCode, PSYMBOL pSymbols ); /* invokes the virtual machine */
extern void ProcessSymbols( SYMBOL *, WORD );
extern void VirtualMachine( PBYTE pCode, PHB_SYMB pSymbols ); /* invokes the virtual machine */
extern void ProcessSymbols( PHB_SYMB pSymbols, WORD wSymbols ); /* statics symbols initialization */
/* items types */
#define IT_NIL 0x0000
@@ -166,7 +166,7 @@ struct hb_struSymbol
LONG stackbase;
WORD lineno;
WORD paramcnt;
PSYMBOL value;
PHB_SYMB value;
};
/* items hold at the virtual machine stack */
@@ -218,9 +218,9 @@ typedef struct _DYNSYM
{
HB_HANDLE hArea; /* Workarea number */
HB_HANDLE hMemvar; /* Index number into memvars ( publics & privates ) array */
PSYMBOL pSymbol; /* pointer to its relative local symbol */
PHB_SYMB pSymbol; /* pointer to its relative local symbol */
PHB_FUNC pFunPtr; /* Pointer to the function address */
} DYNSYM, * PDYNSYM, * DYNSYM_PTR;
} DYNSYM, * PDYNSYM, * DYNSYM_PTR;
typedef struct
{
@@ -233,7 +233,7 @@ typedef struct _HB_CODEBLOCK
BYTE* pCode; /* codeblock pcode */
PHB_ITEM pLocals; /* table with referenced local variables */
WORD wLocals; /* number of referenced local variables */
PSYMBOL pSymbols; /* codeblocks symbols */
PHB_SYMB pSymbols; /* codeblocks symbols */
ULONG lCounter; /* numer of references to this codeblock */
} HB_CODEBLOCK, * PHB_CODEBLOCK, * HB_CODEBLOCK_PTR;
@@ -245,7 +245,7 @@ typedef struct _HB_VALUE
} HB_VALUE, * PHB_VALUE, * HB_VALUE_PTR;
extern STACK stack;
extern SYMBOL symEval;
extern HB_SYMB symEval;
extern HB_ITEM errorBlock;
extern HB_ITEM aStatics;
@@ -316,19 +316,19 @@ extern ULONG hb_strAt( char *, long, char *, long );
extern char * hb_strUpper( char * szText, long lLen );
extern char * hb_strLower( char * szText, long lLen );
extern PHB_FUNC hb_GetMethod( PHB_ITEM pObject, PSYMBOL pSymMsg ); /* returns the method pointer of a object class */
extern PHB_FUNC hb_GetMethod( PHB_ITEM pObject, PHB_SYMB pSymMsg ); /* returns the method pointer of a object class */
extern char * hb_GetClassName( PHB_ITEM pObject ); /* retrieves an object class name */
extern ULONG hb_isMessage( PHB_ITEM, char * );
/* dynamic symbol table management */
extern PDYNSYM hb_GetDynSym( char * szName ); /* finds and creates a dynamic symbol if not found */
extern PDYNSYM hb_NewDynSym( PSYMBOL pSymbol ); /* creates a new dynamic symbol based on a local one */
extern PDYNSYM hb_NewDynSym( PHB_SYMB pSymbol ); /* creates a new dynamic symbol based on a local one */
extern PDYNSYM hb_FindDynSym( char * szName ); /* finds a dynamic symbol */
extern void hb_LogDynSym( void ); /* displays all dynamic symbols */
extern void hb_ReleaseDynSym( void ); /* releases the memory of the dynamic symbol table */
extern PSYMBOL hb_NewSymbol( char * szName );
extern PHB_SYMB hb_NewSymbol( char * szName );
extern HB_CODEBLOCK_PTR hb_CodeblockNew( BYTE *, WORD, WORD *, PSYMBOL );
extern HB_CODEBLOCK_PTR hb_CodeblockNew( BYTE *, WORD, WORD *, PHB_SYMB );
extern void hb_CodeblockDelete( PHB_ITEM );
extern PHB_ITEM hb_CodeblockGetVar( PHB_ITEM, LONG );
extern PHB_ITEM hb_CodeblockGetRef( PHB_ITEM, PHB_ITEM );
@@ -342,14 +342,13 @@ extern void hb_MemvarsInit( void );
extern void hb_MemvarsRelease( void );
extern void hb_MemvarValueIncRef( HB_HANDLE );
extern void hb_MemvarValueDecRef( HB_HANDLE );
extern void hb_MemvarSetValue( PSYMBOL, HB_ITEM_PTR );
extern void hb_MemvarGetValue( HB_ITEM_PTR, PSYMBOL );
extern void hb_MemvarGetRefer( HB_ITEM_PTR, PSYMBOL );
extern void hb_MemvarNewSymbol( PSYMBOL );
extern void hb_MemvarSetValue( PHB_SYMB, HB_ITEM_PTR );
extern void hb_MemvarGetValue( HB_ITEM_PTR, PHB_SYMB );
extern void hb_MemvarGetRefer( HB_ITEM_PTR, PHB_SYMB );
extern void hb_MemvarNewSymbol( PHB_SYMB );
extern ULONG hb_MemvarGetPrivatesBase( void );
extern void hb_MemvarSetPrivatesBase( ULONG );
extern void ProcessSymbols( PSYMBOL pSymbols, WORD wSymbols ); /* statics symbols initialization */
extern char * hb_setColor( char * );
#endif /* HB_EXTEND_H_ */

1
harbour/include/hberrors.h
View File

@@ -87,6 +87,7 @@
#define ERR_PATTERN_DEFINITION 7
#define ERR_RECURSE 8
#define ERR_WRONG_DIRECTIVE 9
#define ERR_EXPLICIT 10
extern void GenError( char* _szErrors[], char, int, char*, char * ); /* generic parsing error management function */
extern void GenWarning( int, char*, char * ); /* generic parsing warning management function */

22
harbour/include/init.h
View File

@@ -29,17 +29,17 @@
#ifndef HB_INIT_H_
#define HB_INIT_H_
extern void ProcessSymbols( SYMBOL * pSymbols, WORD wSymbols );
extern void ProcessSymbols( PHB_SYMB pSymbols, WORD wSymbols ); /* statics symbols initialization */
#ifdef HARBOUR_STRICT_ANSI_C
#define HB_INIT_SYMBOLS_BEGIN( func ) \
static SYMBOL symbols[] = {
static HB_SYMB symbols[] = {
#define HB_INIT_SYMBOLS_END( func ) }; \
void func( void ) \
{ \
ProcessSymbols( symbols, sizeof( symbols ) / sizeof( SYMBOL ) ); \
ProcessSymbols( symbols, sizeof( symbols ) / sizeof( HB_SYMB ) ); \
}
#define HB_CALL_ON_STARTUP_BEGIN( func ) func( void ) {
@@ -49,12 +49,12 @@ extern void ProcessSymbols( SYMBOL * pSymbols, WORD wSymbols );
#ifdef __GNUC__
#define HB_INIT_SYMBOLS_BEGIN( func ) \
static SYMBOL symbols[] = {
static HB_SYMB symbols[] = {
#define HB_INIT_SYMBOLS_END( func ) }; \
void __attribute__ ((constructor)) func( void ) \
{ \
ProcessSymbols( symbols, sizeof( symbols ) / sizeof( SYMBOL ) ); \
ProcessSymbols( symbols, sizeof( symbols ) / sizeof( HB_SYMB ) ); \
}
@@ -67,12 +67,12 @@ extern void ProcessSymbols( SYMBOL * pSymbols, WORD wSymbols );
#ifdef __BORLANDC__
#define HB_INIT_SYMBOLS_BEGIN( func ) \
static SYMBOL symbols[] = {
static HB_SYMB symbols[] = {
#define HB_INIT_SYMBOLS_END( func ) }; \
void func( void ) \
{ \
ProcessSymbols( symbols, sizeof( symbols ) / sizeof( SYMBOL ) ); \
ProcessSymbols( symbols, sizeof( symbols ) / sizeof( HB_SYMB ) ); \
}
#define HB_CALL_ON_STARTUP_BEGIN( func ) \
@@ -83,12 +83,12 @@ extern void ProcessSymbols( SYMBOL * pSymbols, WORD wSymbols );
#if (defined(_MSC_VER) || defined(__IBMCPP__) || defined(__MPW__))
#define HB_INIT_SYMBOLS_BEGIN( func ) \
static SYMBOL symbols[] = {
static HB_SYMB symbols[] = {
#define HB_INIT_SYMBOLS_END( func ) }; \
int func( void ) \
{ \
ProcessSymbols( symbols, sizeof( symbols ) / sizeof( SYMBOL ) ); \
ProcessSymbols( symbols, sizeof( symbols ) / sizeof( HB_SYMB ) ); \
return 1; \
}; \
static int static_int_##func = func()
@@ -102,12 +102,12 @@ extern void ProcessSymbols( SYMBOL * pSymbols, WORD wSymbols );
#ifdef __WATCOMC__
#define HB_INIT_SYMBOLS_BEGIN( func ) \
static SYMBOL symbols[] = {
static HB_SYMB symbols[] = {
#define HB_INIT_SYMBOLS_END( func ) }; \
static int func( void ) \
{ \
ProcessSymbols( symbols, sizeof( symbols ) / sizeof( SYMBOL ) ); \
ProcessSymbols( symbols, sizeof( symbols ) / sizeof( HB_SYMB ) ); \
return 1; \
}; \
static int static_int_##func = func()

6
harbour/include/initsymb.h → harbour/include/initsymc.h
View File

@@ -2,8 +2,8 @@
* $Id$
*/
#ifndef HB_INITSYMB_H_
#define HB_INITSYMB_H_
#ifndef HB_INITSYMC_H_
#define HB_INITSYMC_H_
/* This file contains all the Run-Time library init symbols */
@@ -27,4 +27,4 @@
#endif
Transfrm__InitSymbols();
#endif /* HB_INITSYMB_H_ */
#endif /* HB_INITSYMC_H_ */

30
harbour/include/initsymd.h Normal file
View File

@@ -0,0 +1,30 @@
/*
* $Id$
*/
#ifndef HB_INITSYMD_H_
#define HB_INITSYMD_H_
/* This file contains all the Run-Time library init symbols */
extern void Arrays__InitSymbols( void );
extern void Classes__InitSymbols( void );
extern void Console__InitSymbols( void );
extern void CopyFile__InitSymbols( void );
extern void Dates__InitSymbols( void );
extern void Dates2__InitSymbols( void );
extern void Descend__InitSymbols( void );
extern void Dir__InitSymbols( void );
extern void Environ__InitSymbols( void );
extern void Files__InitSymbols( void );
extern void HardCR__InitSymbols( void );
extern void Math__InitSymbols( void );
extern void Memotran__InitSymbols( void );
extern void Set__InitSymbols( void );
extern void Strings__InitSymbols( void );
#ifdef HARBOUR_STRICT_CLIPPER_COMPATIBILITY
extern void Strings__InitInfinity( void );
#endif
extern void Transfrm__InitSymbols( void );
#endif /* HB_INITSYMD_H_ */

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

@@ -59,7 +59,7 @@ extern SYMBOLS symbols;
extern int _bQuiet, _bStartProc;
static BYTE prgFunction[] = { 0x68, 0x00, 0x00, 0x00, 0x00, 0x68, 0x00, 0x00, 0x00,
0x00, 0xE8, 0x00, 0x00, 0x00, 0x00, 0x83, 0xC4, 0x08, 0xC3 };
0x00, 0xE8, 0x00, 0x00, 0x00, 0x00, 0x83, 0xC4, 0x08, 0xC3 };
static char * * externNames = 0;
WORD wExternals = 1; /* _VirtualMachine is always added */
@@ -94,7 +94,7 @@ void GenObj32( char * szObjFileName, char * szFileName )
static ULONG GetSymbolsSize( void )
{
return ( symbols.iCount - ( _bStartProc ? 0: 1 ) ) * sizeof( SYMBOL );
return ( symbols.iCount - ( _bStartProc ? 0: 1 ) ) * sizeof( HB_SYMB );
}
static PCOMSYMBOL GetFirstSymbol( void )
@@ -165,7 +165,7 @@ WORD GetExternalPos( char * szExternal )
while( w < wExternals )
{
if( ! strcmp( szExternal, externNames[ w ] ) )
break;
break;
w++;
}
@@ -175,7 +175,7 @@ WORD GetExternalPos( char * szExternal )
static void GenerateLocalNames( FILE * hObjFile )
{
char * localNames[] = { "_TEXT", "CODE", "_DATA", "DATA",
"HB_SYMBOLS", "HB_STARTSYMBOLS", "HB_ENDSYMBOLS", "SYMGROUP", 0 };
"HB_SYMBOLS", "HB_STARTSYMBOLS", "HB_ENDSYMBOLS", "SYMGROUP", 0 };
LocalNames( hObjFile, localNames );
}
@@ -187,8 +187,8 @@ static void GenerateSymbolsSegment( FILE * hObjFile )
DefineSegment( hObjFile, 7, 5, 0 ); /* 7 = HB_STARTSYMBOLS, 5 = DATA */
DefineSegment( hObjFile, 6, /* "HB_SYMBOLS" position + 1 into localNames */
5, /* "DATA" position + 1 into localNames */
6 ); /* segment length */
5, /* "DATA" position + 1 into localNames */
6 ); /* segment length */
DefineSegment( hObjFile, 8, 5, 0 ); /* 8 = HB_ENDSYMBOLS, 5 = DATA */
GroupDef( hObjFile, 8, groupSegments ); /* 8 = "SYMGROUP" localNames position */
@@ -202,7 +202,7 @@ static void GenerateSymbolsSegment( FILE * hObjFile )
static void GenerateDataSegment( FILE * hObjFile )
{
SYMBOL symbol;
HB_SYMB symbol;
ULONG ulSize = GetSymbolsSize();
PCOMSYMBOL pSymbol = GetFirstSymbol();
ULONG ulSymbols = GetSymbolsAmount(), ul;
@@ -216,29 +216,29 @@ static void GenerateDataSegment( FILE * hObjFile )
ulSize += GetPCodesSize();
DefineSegment( hObjFile, 4, /* "_DATA" position + 1 into localNames */
5, /* "DATA" position + 1 into localNames */
ulSize ); /* segment length */
5, /* "DATA" position + 1 into localNames */
ulSize ); /* segment length */
memset( &symbol, 0, sizeof( symbol ) );
DataSegment( hObjFile, (BYTE *) &symbol,
sizeof( symbol ), GetSymbolsAmount(), ulSize );
sizeof( symbol ), GetSymbolsAmount(), ulSize );
pSymbol = GetFirstSymbol();
for( ul = 0; ul < ulSymbols; ul++ )
{
Fixup( hObjFile, 0xE4, ( ul * sizeof( SYMBOL ) ), 0x54, 2 ); /* Data symbol name location */
Fixup( hObjFile, 0xE4, ( ul * sizeof( HB_SYMB ) ), 0x54, 2 ); /* Data symbol name location */
if( IsExternal( ul ) )
{
if( ! ( pSymbol->cScope & FS_MESSAGE ) )
Fixup( hObjFile, 0xE4, ( ul * sizeof( SYMBOL ) ) + 5, 0x56,
GetExternalPos( GetSymbolName( ul ) ) + 1 );
}
{
if( ! ( pSymbol->cScope & FS_MESSAGE ) )
Fixup( hObjFile, 0xE4, ( ul * sizeof( HB_SYMB ) ) + 5, 0x56,
GetExternalPos( GetSymbolName( ul ) ) + 1 );
}
else
{
/* if( ! ( pSymbol->cScope & FS_MESSAGE ) ) */
Fixup( hObjFile, 0xE4, ( ul * sizeof( SYMBOL ) ) + 5, 0x54, 1 ); /* function address location */
}
{
/* if( ! ( pSymbol->cScope & FS_MESSAGE ) ) */
Fixup( hObjFile, 0xE4, ( ul * sizeof( HB_SYMB ) ) + 5, 0x54, 1 ); /* function address location */
}
pSymbol = pSymbol->pNext;
}
}
@@ -251,13 +251,13 @@ static void GenerateCodeSegment( FILE * hObjFile )
WORD w = 0;
DefineSegment( hObjFile, 2, /* "_TEXT" position + 1 into localNames */
3, /* "CODE" position + 1 into localNames */
ulSize ); /* segment length */
3, /* "CODE" position + 1 into localNames */
ulSize ); /* segment length */
while( pFunc )
{
if( !( pFunc->cScope & ( FS_STATIC | FS_INIT | FS_EXIT ) ) )
PubDef( hObjFile, pFunc->szName, 1, w * sizeof( prgFunction ) );
PubDef( hObjFile, pFunc->szName, 1, w * sizeof( prgFunction ) );
w++;
pFunc = pFunc->pNext;
}
@@ -288,7 +288,7 @@ static void GenerateExternals( FILE * hObjFile )
while( pFunc )
{
if( ! ( pFTemp = GetFunction( pFunc->szName ) ) || pFTemp == functions.pFirst )
wExternals++;
wExternals++;
pFunc = pFunc->pNext;
}
if( wExternals )
@@ -299,11 +299,11 @@ static void GenerateExternals( FILE * hObjFile )
pFunc = funcalls.pFirst;
while( pFunc )
{
if( ! ( pFTemp = GetFunction( pFunc->szName ) ) || pFTemp == functions.pFirst )
{
if( ! ( pFTemp = GetFunction( pFunc->szName ) ) || pFTemp == functions.pFirst )
externNames[ w++ ] = pFunc->szName;
pFunc = pFunc->pNext;
}
pFunc = pFunc->pNext;
}
externNames[ w ] = 0;
ExternalNames( hObjFile, externNames );
}
@@ -397,10 +397,10 @@ static void LocalNames( FILE * hObjFile, char * szNames[] )
c = 0;
while( szNames[ b ][ c ] )
{
putbyte( szNames[ b ][ c ], hObjFile );
bChk += szNames[ b ][ c++ ];
}
{
putbyte( szNames[ b ][ c ], hObjFile );
bChk += szNames[ b ][ c++ ];
}
b++;
}
putbyte( 256 - bChk, hObjFile );
@@ -432,10 +432,10 @@ static void ExternalNames( FILE * hObjFile, char * szNames[] )
c = 0;
while( szNames[ b ][ c ] )
{
putbyte( szNames[ b ][ c ], hObjFile );
bChk += szNames[ b ][ c++ ];
}
{
putbyte( szNames[ b ][ c ], hObjFile );
bChk += szNames[ b ][ c++ ];
}
putbyte( 0, hObjFile );
b++;
}
@@ -449,7 +449,7 @@ static void CodeSegment( FILE * hObjFile, BYTE * prgCode, ULONG ulPrgLen, WORD w
WORD wTotalLen = ( ulPrgLen * wFunctions ) + 4;
ULONG ul;
PFUNCTION pFunction = functions.pFirst;
ULONG ulPCodeOffset = ( symbols.iCount - ( _bStartProc ? 0: 1 ) ) * sizeof( SYMBOL );
ULONG ulPCodeOffset = ( symbols.iCount - ( _bStartProc ? 0: 1 ) ) * sizeof( HB_SYMB );
if( ! _bStartProc )
pFunction = pFunction->pNext;
@@ -470,10 +470,10 @@ static void CodeSegment( FILE * hObjFile, BYTE * prgCode, ULONG ulPrgLen, WORD w
{
* ( ULONG * ) &prgCode[ 6 ] = ulPCodeOffset; /* function pcode offset */
for( ul = 0; ul < ulPrgLen; ul++ )
{
putbyte( * ( prgCode + ul ), hObjFile );
bCheckSum += * ( prgCode + ul );
}
{
putbyte( * ( prgCode + ul ), hObjFile );
bCheckSum += * ( prgCode + ul );
}
ulPCodeOffset += pFunction->lPCodePos + 1; /* HB_P_ENDPROC !!! */
pFunction = pFunction->pNext;
}
@@ -512,24 +512,24 @@ static void DataSegment( FILE * hObjFile, BYTE * symbol, WORD wSymLen, WORD wSym
* ( ULONG * ) symbol = ulSymbolNameOffset;
if( ! IsExternal( y ) )
{
ulFunctionOffset = ( GetFunctionPos( pSymbol->szName ) - 1 ) *
sizeof( prgFunction );
* ( ( ULONG * ) &symbol[ 5 ] ) = ulFunctionOffset;
}
{
ulFunctionOffset = ( GetFunctionPos( pSymbol->szName ) - 1 ) *
sizeof( prgFunction );
* ( ( ULONG * ) &symbol[ 5 ] ) = ulFunctionOffset;
}
else
* ( ( ULONG * ) &symbol[ 5 ] ) = 0;
* ( ( ULONG * ) &symbol[ 5 ] ) = 0;
if( pSymbol->cScope == FS_MESSAGE )
symbol[ 4 ] = FS_PUBLIC;
symbol[ 4 ] = FS_PUBLIC;
else
symbol[ 4 ] = pSymbol->cScope;
symbol[ 4 ] = pSymbol->cScope;
for( w = 0; w < wSymLen; w++ )
{
putbyte( * ( symbol + w ), hObjFile );
bCheckSum += * ( symbol + w );
}
{
putbyte( * ( symbol + w ), hObjFile );
bCheckSum += * ( symbol + w );
}
ulSymbolNameOffset += strlen( pSymbol->szName ) + 1;
pSymbol = pSymbol->pNext;
@@ -538,10 +538,10 @@ static void DataSegment( FILE * hObjFile, BYTE * symbol, WORD wSymLen, WORD wSym
while( pFunction )
{
for( w = 0; w < pFunction->lPCodePos; w++ )
{
putbyte( pFunction->pCode[ w ], hObjFile );
bCheckSum += pFunction->pCode[ w ];
}
{
putbyte( pFunction->pCode[ w ], hObjFile );
bCheckSum += pFunction->pCode[ w ];
}
putbyte( HB_P_ENDPROC, hObjFile );
bCheckSum += HB_P_ENDPROC;
pFunction = pFunction->pNext;
@@ -552,10 +552,10 @@ static void DataSegment( FILE * hObjFile, BYTE * symbol, WORD wSymLen, WORD wSym
while( pSymbol )
{
for( w = 0; w < ( WORD ) strlen( pSymbol->szName ); w++ )
{
putbyte( pSymbol->szName[ w ], hObjFile );
bCheckSum += pSymbol->szName[ w ];
}
{
putbyte( pSymbol->szName[ w ], hObjFile );
bCheckSum += pSymbol->szName[ w ];
}
putbyte( 0, hObjFile );
pSymbol = pSymbol->pNext;
}

5
harbour/source/hbpp/hbpp.c
View File

@@ -141,7 +141,8 @@ char * _szPErrors[] = { "Can\'t open include file \"%s\"",
"Absent \"=>\" in command definition",
"Error in pattern definition",
"Cycled #define",
"Wrong directive \"%s\""
"Wrong directive \"%s\"",
"#error: \'%s\'"
};
int ParseDirective( char* sLine )
@@ -225,7 +226,7 @@ int ParseDirective( char* sLine )
else if ( i == 5 && memcmp ( sDirective, "ERROR", 5 ) == 0 )
{ /* --- #error --- */
printf ( "\n#error: %s\n", sLine );
GenError( _szPErrors, 'P', ERR_EXPLICIT, sLine, NULL );
exit(1);
}
else if ( i == 4 && memcmp ( sDirective, "LINE", 4 ) == 0 )

5
harbour/source/rtl/Makefile
View File

@@ -23,6 +23,7 @@ C_SOURCES=\
hardcr.c \
inkey.c \
itemapi.c \
langapi.c \
math.c \
memvars.c \
mtran.c \
@@ -47,8 +48,8 @@ PRG_SOURCES=\
objfunc.prg \
setkey.prg \
tclass.prg \
tget.prg \
tgetlist.prg \
tget.prg \
tgetlist.prg \
LIB=rtl

42
harbour/source/rtl/achoice.prg
View File

@@ -29,7 +29,7 @@
* ACHOICE(<nTop>, <nLeft>, <nBottom>, <nRight>,
* <acMenuItems>,
* [<alSelectableItems> | <lSelectableItems>],
* [<cUserFunction>],
* [<cUserFunction> | <bUserBlock>],
* [<nInitialItem>],
* [<nWindowRow>]) --> nPosition
*
@@ -57,6 +57,12 @@
* When it is called, it will be supplied with the
* parameters: nMode, nCurElement, and nRowPos.
* Default NIL.
* bUserBlock - a codeblock to be called which may
* effect special processing of keystrokes. It
* should be specified in the form
* {|nMode, nCurElemenet, nRowPos| ;
* MyFunc(nMode, nCurElemenet, nRowPos) }.
* Default NIL.
* nInitialItem - the number of the element to be highlighted as
* the current item when the array is initally
* displayed. 1 origin. Default 1.
@@ -101,7 +107,8 @@
*+
*+--------------------------------------------------------------------
*+
function achoice( nTop, nLft, nBtm, nRyt, acItems, xSelect, cUserFunc, nPos, nHiLytRow )
function achoice( nTop, nLft, nBtm, nRyt, acItems, xSelect, xUserFunc, nPos, nHiLytRow )
local nNumCols := 0 // Number of columns in the window
local nNumRows := 0 // Number of rows in the window
@@ -117,10 +124,8 @@ local nItems := 0 // The number of items
local nGap := 0 // The number of lines between top and current lines
// Block used to search for items
local bScan := { | cX | if( left( cX, 1 ) == upper( chr( nKey ) ), .T., .F. ) }
// Is a user function to be used?
local lUserFunc := ( !empty( cUserFunc ) )
local lUserFunc // Is a user function to be used?
local nUserFunc := 0 // Return value from user function
local bUserFunc := { || AC_ABORT } // Block form of user function
local cLoClr := Before( ",", setcolor() )
local cHiClr := Before( ",", After( ",", setcolor() ) )
local cUnClr := After( ",", After( ",", After( ",", After( ",", setcolor() ) ) ) )
@@ -129,9 +134,7 @@ local nFrstItem := 0
local nLastItem := 0
local nCntr
IF lUserFunc
bUserFunc := cUserFunc
endif
lUserFunc := !empty( xUserFunc ) .AND. ValType( xUserFunc ) $ "CB"
IF empty( cHiClr )
cHiClr := After( "/", cLoClr ) + "/" + Before( "/", cLoClr )
@@ -147,7 +150,6 @@ DEFAULT nBtm to maxrow() + 1 // The bottommost row of the windows
DEFAULT nRyt to maxcol() + 1 // The rightmost column of the window
DEFAULT acItems to {} // The items from which to choose
DEFAULT xSelect to .T. // Array or logical, what is selectable
DEFAULT cUserFunc to NIL // Optional function for key exceptions
DEFAULT nPos to 1 // The number of the selected item
DEFAULT nHiLytRow to 0 // The row to be highlighted
@@ -493,7 +495,7 @@ do while ( !lFinished )
endcase
IF lUserFunc
nUserFunc := do( bUserFunc, nMode, nPos, nPos - nAtTop )
nUserFunc := do( xUserFunc, nMode, nPos, nPos - nAtTop )
// DISPVAR nUserFunc
do case
case nUserFunc == AC_ABORT
@@ -560,8 +562,6 @@ return ( NIL )
*+
static function DispLine( cLine, nRow, nCol, lSelect, lHiLyt, cLoClr, cHiClr, cUnClr )
DEFAULT lHiLyt to .F.
@ nRow, nCol say cLine color if( lSelect, if( lHiLyt, cHiClr, cLoClr ), cUnClr )
return ( NIL )
@@ -601,10 +601,13 @@ return ( min( max( xLo, xVal ), xHi ) )
*+
static function Before( cDelim, cValue )
local cRetVal := cValue
local cRetVal
local nPos
IF cDelim $ cValue
cRetVal := left( cValue, at( cDelim, cValue ) - 1 )
IF (nPos := at( cDelim, cValue )) > 0
cRetVal := left( cValue, nPos - 1 )
else
cRetVal := cValue
endif
return ( cRetVal )
@@ -619,10 +622,13 @@ return ( cRetVal )
*+
static function After( cDelim, cValue )
local cRetVal := ""
local cRetVal
local nPos
IF cDelim $ cValue
cRetVal := substr( cValue, at( cDelim, cValue ) + 1 )
IF (nPos := at( cDelim, cValue )) > 0
cRetVal := substr( cValue, nPos + 1 )
else
cRetVal := ""
endif
return ( cRetVal )

54
harbour/source/rtl/alert.prg
View File

@@ -13,12 +13,18 @@
#include "box.ch"
#include "inkey.ch"
// ; TOFIX: Clipper can display an alert box even when DispBegin() is in effect.
// ; Clipper defines a clipped window for Alert()
// ; Clipper will return NIL if the first parameter is not a string, but
// this is not documented. This implementation convert the first parameter
// to a string if another type was passed. You can switch back to
// Clipper compatible mode by defining constant
// HARBOUR_STRICT_CLIPPER_COMPATIBILITY.
// ; Clipper handles these buttons { "Ok", "", "Cancel" } in a buggy way.
// This is fixed.
// ; nDelay parameter is a Harbour addition.
FUNCTION Alert(cMessage, aOptions, cColorNorm, nDelay)
FUNCTION Alert(xMessage, aOptions, cColorNorm, nDelay)
LOCAL nChoice
LOCAL aSay, nPos, nWidth, nOpWidth, nInitRow, nInitCol, iEval
LOCAL nKey, aPos, nCurrent, aHotkey, aOptionsOK
@@ -29,20 +35,55 @@ FUNCTION Alert(cMessage, aOptions, cColorNorm, nDelay)
LOCAL nOldCursor
LOCAL cOldScreen
/* TOFIX: Clipper decides at runtime, whether the GT is linked, */
/* TOFIX: Clipper decides at runtime, whether the GT is linked in, */
/* if it is not, the console mode is choosed here */
LOCAL lConsole := .F.
#ifdef HARBOUR_STRICT_CLIPPER_COMPATIBILITY
// TODO: Enable this when we have a function for querying the command line
// parameters.
// IF "//NOALERT" $ /* Upper(cCommandLine) */
// QUIT
// ENDIF
#endif
IF !(ValType(cMessage) == "C")
aSay := {}
#ifdef HARBOUR_STRICT_CLIPPER_COMPATIBILITY
IF !(ValType(xMessage) == "C")
RETURN NIL
ENDIF
#else
DO CASE
CASE ValType(xMessage) $ "CM"
DO WHILE (nPos := At(';', xMessage)) != 0
AAdd(aSay, Left(xMessage, nPos - 1))
xMessage := SubStr(xMessage, nPos + 1)
ENDDO
AAdd(aSay, xMessage)
CASE ValType(xMessage) == "A"
FOR iEval := 1 TO Len(xMessage)
IF ValType( xMessage[ iEval ] ) == "C"
AAdd(aSay, xMessage[ iEval ] )
ENDIF
NEXT
CASE ValType(xMessage) == "N" ; xMessage := Str( xMessage )
CASE ValType(xMessage) == "D" ; xMessage := DToC( xMessage )
CASE ValType(xMessage) == "L" ; xMessage := iif( xMessage, ".T.", ".F." )
CASE ValType(xMessage) == "O" ; xMessage := xMessage:className + " Object"
CASE ValType(xMessage) == "B" ; xMessage := "{||...}"
OTHERWISE ; xMessage := "NIL"
ENDCASE
#endif
IF !(ValType(aOptions) == "A")
aOptions := {}
ENDIF
@@ -59,13 +100,6 @@ FUNCTION Alert(cMessage, aOptions, cColorNorm, nDelay)
nDelay := 0
ENDIF
aSay := {}
DO WHILE (nPos := At(';', cMessage)) != 0
AAdd(aSay, Left(cMessage, nPos - 1))
cMessage := SubStr(cMessage, nPos + 1)
ENDDO
AAdd(aSay, cMessage)
/* The longest line */
nWidth := 0
AEval(aSay, { |x| nWidth := Max(Len(x), nWidth) })

53
harbour/source/rtl/arrays.c
View File

@@ -25,6 +25,7 @@
#include "itemapi.h"
#include "extend.h"
#include "errorapi.h"
#include "langapi.h"
#include "ctoharb.h"
#include "init.h"
#include "dates.h"
@@ -86,12 +87,12 @@ char * hb_arrayGetDate( PHB_ITEM pArray, ULONG ulIndex, char * szDate )
}
else
{
hb_errorRT_BASE(EG_BOUND, 1132, NULL, hb_errorNatDescription(EG_ARRACCESS));
hb_errorRT_BASE(EG_BOUND, 1132, NULL, hb_langDGetErrorDesc(EG_ARRACCESS));
}
}
else
{
hb_errorRT_BASE(EG_ARG, 1068, NULL, hb_errorNatDescription(EG_ARRACCESS));
hb_errorRT_BASE(EG_ARG, 1068, NULL, hb_langDGetErrorDesc(EG_ARRACCESS));
}
return szDate;
@@ -113,12 +114,12 @@ BOOL hb_arrayGetBool( PHB_ITEM pArray, ULONG ulIndex )
}
else
{
hb_errorRT_BASE(EG_BOUND, 1132, NULL, hb_errorNatDescription(EG_ARRACCESS));
hb_errorRT_BASE(EG_BOUND, 1132, NULL, hb_langDGetErrorDesc(EG_ARRACCESS));
}
}
else
{
hb_errorRT_BASE(EG_ARG, 1068, NULL, hb_errorNatDescription(EG_ARRACCESS));
hb_errorRT_BASE(EG_ARG, 1068, NULL, hb_langDGetErrorDesc(EG_ARRACCESS));
}
return 0;
}
@@ -145,12 +146,12 @@ double hb_arrayGetDouble( PHB_ITEM pArray, ULONG ulIndex )
}
else
{
hb_errorRT_BASE(EG_BOUND, 1132, NULL, hb_errorNatDescription(EG_ARRACCESS));
hb_errorRT_BASE(EG_BOUND, 1132, NULL, hb_langDGetErrorDesc(EG_ARRACCESS));
}
}
else
{
hb_errorRT_BASE(EG_ARG, 1068, NULL, hb_errorNatDescription(EG_ARRACCESS));
hb_errorRT_BASE(EG_ARG, 1068, NULL, hb_langDGetErrorDesc(EG_ARRACCESS));
}
return 0;
}
@@ -197,12 +198,12 @@ void hb_arrayGet( PHB_ITEM pArray, ULONG ulIndex, PHB_ITEM pItem )
hb_itemCopy( pItem, pArray->item.asArray.value->pItems + ( ulIndex - 1 ) );
else
{
hb_errorRT_BASE(EG_BOUND, 1132, NULL, hb_errorNatDescription(EG_ARRACCESS));
hb_errorRT_BASE(EG_BOUND, 1132, NULL, hb_langDGetErrorDesc(EG_ARRACCESS));
}
}
else
{
hb_errorRT_BASE(EG_ARG, 1068, NULL, hb_errorNatDescription(EG_ARRACCESS));
hb_errorRT_BASE(EG_ARG, 1068, NULL, hb_langDGetErrorDesc(EG_ARRACCESS));
}
}
@@ -221,12 +222,12 @@ char *hb_arrayGetString( PHB_ITEM pArray, ULONG ulIndex )
}
else
{
hb_errorRT_BASE(EG_BOUND, 1132, NULL, hb_errorNatDescription(EG_ARRACCESS));
hb_errorRT_BASE(EG_BOUND, 1132, NULL, hb_langDGetErrorDesc(EG_ARRACCESS));
}
}
else
{
hb_errorRT_BASE(EG_ARG, 1068, NULL, hb_errorNatDescription(EG_ARRACCESS));
hb_errorRT_BASE(EG_ARG, 1068, NULL, hb_langDGetErrorDesc(EG_ARRACCESS));
}
return "";
}
@@ -246,12 +247,12 @@ ULONG hb_arrayGetStringLen( PHB_ITEM pArray, ULONG ulIndex )
}
else
{
hb_errorRT_BASE(EG_BOUND, 1132, NULL, hb_errorNatDescription(EG_ARRACCESS));
hb_errorRT_BASE(EG_BOUND, 1132, NULL, hb_langDGetErrorDesc(EG_ARRACCESS));
}
}
else
{
hb_errorRT_BASE(EG_ARG, 1068, NULL, hb_errorNatDescription(EG_ARRACCESS));
hb_errorRT_BASE(EG_ARG, 1068, NULL, hb_langDGetErrorDesc(EG_ARRACCESS));
}
return 0;
}
@@ -267,12 +268,12 @@ int hb_arrayGetType( PHB_ITEM pArray, ULONG ulIndex )
}
else
{
hb_errorRT_BASE(EG_BOUND, 1132, NULL, hb_errorNatDescription(EG_ARRACCESS));
hb_errorRT_BASE(EG_BOUND, 1132, NULL, hb_langDGetErrorDesc(EG_ARRACCESS));
}
}
else
{
hb_errorRT_BASE(EG_ARG, 1068, NULL, hb_errorNatDescription(EG_ARRACCESS));
hb_errorRT_BASE(EG_ARG, 1068, NULL, hb_langDGetErrorDesc(EG_ARRACCESS));
}
return 0;
}
@@ -292,7 +293,7 @@ ULONG hb_arrayLen( PHB_ITEM pArray )
return pArray->item.asArray.value->ulLen;
else
{
hb_errorRT_BASE(EG_ARG, 1068, NULL, hb_errorNatDescription(EG_ARRACCESS));
hb_errorRT_BASE(EG_ARG, 1068, NULL, hb_langDGetErrorDesc(EG_ARRACCESS));
}
return 0;
}
@@ -305,12 +306,12 @@ void hb_arraySet( PHB_ITEM pArray, ULONG ulIndex, PHB_ITEM pItem )
hb_itemCopy( pArray->item.asArray.value->pItems + ( ulIndex - 1 ), pItem );
else
{
hb_errorRT_BASE(EG_BOUND, 1133, NULL, hb_errorNatDescription(EG_ARRASSIGN));
hb_errorRT_BASE(EG_BOUND, 1133, NULL, hb_langDGetErrorDesc(EG_ARRASSIGN));
}
}
else
{
hb_errorRT_BASE(EG_ARG, 1069, NULL, hb_errorNatDescription(EG_ARRASSIGN));
hb_errorRT_BASE(EG_ARG, 1069, NULL, hb_langDGetErrorDesc(EG_ARRASSIGN));
}
}
@@ -373,7 +374,7 @@ void hb_arrayFill( PHB_ITEM pArray, PHB_ITEM pValue, ULONG ulStart, ULONG ulCoun
}
else
{
hb_errorRT_BASE(EG_ARG, 1068, NULL, hb_errorNatDescription(EG_NOTARRAY));
hb_errorRT_BASE(EG_ARG, 1068, NULL, hb_langDGetErrorDesc(EG_NOTARRAY));
}
}
@@ -396,12 +397,12 @@ void hb_arrayDel( PHB_ITEM pArray, ULONG ulIndex )
}
else
{
hb_errorRT_BASE(EG_BOUND, 1132, NULL, hb_errorNatDescription(EG_ARRACCESS));
hb_errorRT_BASE(EG_BOUND, 1132, NULL, hb_langDGetErrorDesc(EG_ARRACCESS));
}
}
else
{
hb_errorRT_BASE(EG_ARG, 1068, NULL, hb_errorNatDescription(EG_NOTARRAY));
hb_errorRT_BASE(EG_ARG, 1068, NULL, hb_langDGetErrorDesc(EG_NOTARRAY));
}
}
@@ -424,12 +425,12 @@ void hb_arrayIns( PHB_ITEM pArray, ULONG ulIndex )
}
else
{
hb_errorRT_BASE(EG_BOUND, 1132, NULL, hb_errorNatDescription(EG_ARRACCESS));
hb_errorRT_BASE(EG_BOUND, 1132, NULL, hb_langDGetErrorDesc(EG_ARRACCESS));
}
}
else
{
hb_errorRT_BASE(EG_ARG, 1068, NULL, hb_errorNatDescription(EG_NOTARRAY));
hb_errorRT_BASE(EG_ARG, 1068, NULL, hb_langDGetErrorDesc(EG_NOTARRAY));
}
}
@@ -503,7 +504,7 @@ int hb_arrayScan( PHB_ITEM pArray, PHB_ITEM pValue, ULONG ulStart, ULONG ulCount
}
else
{
hb_errorRT_BASE(EG_ARG, 1068, NULL, hb_errorNatDescription(EG_NOTARRAY));
hb_errorRT_BASE(EG_ARG, 1068, NULL, hb_langDGetErrorDesc(EG_NOTARRAY));
}
return 0;
}
@@ -565,7 +566,7 @@ void hb_arrayRelease( PHB_ITEM pArray )
}
else
{
hb_errorRT_BASE(EG_ARG, 1068, NULL, hb_errorNatDescription(EG_NOTARRAY));
hb_errorRT_BASE(EG_ARG, 1068, NULL, hb_langDGetErrorDesc(EG_NOTARRAY));
}
}
@@ -603,7 +604,7 @@ void hb_arrayCopy( PHB_ITEM pSrcArray, PHB_ITEM pDstArray, ULONG ulStart,
}
else
{
hb_errorRT_BASE(EG_ARG, 1068, NULL, hb_errorNatDescription(EG_NOTARRAY));
hb_errorRT_BASE(EG_ARG, 1068, NULL, hb_langDGetErrorDesc(EG_NOTARRAY));
}
}
@@ -640,7 +641,7 @@ PHB_ITEM hb_arrayClone( PHB_ITEM pSrcArray )
}
else
{
hb_errorRT_BASE(EG_ARG, 1068, NULL, hb_errorNatDescription(EG_NOTARRAY));
hb_errorRT_BASE(EG_ARG, 1068, NULL, hb_langDGetErrorDesc(EG_NOTARRAY));
}
return pDstArray;
}

10
harbour/source/rtl/classes.c
View File

@@ -103,7 +103,7 @@ static void DictRealloc( PCLASS );
static HARBOUR EvalInline( void );
static HARBOUR GetClassData( void );
static HARBOUR GetData( void );
PHB_FUNC hb_GetMethod( PHB_ITEM, PSYMBOL );
PHB_FUNC hb_GetMethod( PHB_ITEM, PHB_SYMB );
ULONG hb_isMessage( PHB_ITEM, char *);
HARBOUR HB_ISMESSAGE( void );
HARBOUR HB_OCLONE( void );
@@ -345,7 +345,7 @@ HARBOUR HB_CLASSCREATE(void)
HARBOUR HB_CLASSDEL(void)
{
PHB_ITEM pString = hb_param( 2, IT_STRING );
PSYMBOL pMessage = hb_GetDynSym( pString->item.asString.value )->pSymbol;
PHB_SYMB pMessage = hb_GetDynSym( pString->item.asString.value )->pSymbol;
PDYNSYM pMsg = ( PDYNSYM ) pMessage->pDynSym;
PCLASS pClass;
@@ -446,7 +446,7 @@ HARBOUR HB_CLASSINSTANCE(void)
HARBOUR HB_CLASSMOD(void)
{
PHB_ITEM pString = hb_param( 2, IT_STRING );
PSYMBOL pMessage = hb_GetDynSym( pString->item.asString.value )->pSymbol;
PHB_SYMB pMessage = hb_GetDynSym( pString->item.asString.value )->pSymbol;
PDYNSYM pMsg = ( PDYNSYM ) pMessage->pDynSym;
PCLASS pClass;
@@ -723,7 +723,7 @@ static HARBOUR GetData( void )
*
* Internal function to the function pointer of a message of an object
*/
PHB_FUNC hb_GetMethod( PHB_ITEM pObject, PSYMBOL pMessage )
PHB_FUNC hb_GetMethod( PHB_ITEM pObject, PHB_SYMB pMessage )
{
WORD wAt, wLimit, wMask;
WORD wClass;
@@ -789,7 +789,7 @@ PHB_FUNC hb_GetMethod( PHB_ITEM pObject, PSYMBOL pMessage )
*/
ULONG hb_isMessage( PHB_ITEM pObject, char *szString )
{
PSYMBOL pMessage = hb_GetDynSym( szString )->pSymbol;
PHB_SYMB pMessage = hb_GetDynSym( szString )->pSymbol;
return( (ULONG) hb_GetMethod( pObject, pMessage ) );
} /* Get funcptr of message */

2
harbour/source/rtl/codebloc.c
View File

@@ -56,7 +56,7 @@
HB_CODEBLOCK_PTR hb_CodeblockNew( BYTE * pBuffer,
WORD wLocals,
WORD *pLocalPosTable,
PSYMBOL pSymbols )
PHB_SYMB pSymbols )
{
HB_CODEBLOCK_PTR pCBlock;

10
harbour/source/rtl/copyfile.c
View File

@@ -48,11 +48,8 @@ HB_INIT_SYMBOLS_END( CopyFile__InitSymbols );
static BOOL hb_fsCopy(char* szSource, char* szDest, ULONG* ulWrittenTotal);
/* INCOMPATIBILITY: Clipper returns .F. on failure and NIL on success */
/* TODO: hb_errorRT_BASE() or a replacement should also handle DOS error */
/* and canRetry/canDefault flags */
HARBOUR HB___COPYFILE( void )
{
if ( ISCHAR(1) && ISCHAR(2) )
{
@@ -74,7 +71,6 @@ HARBOUR HB___COPYFILE( void )
}
static BOOL hb_fsCopy(char* szSource, char* szDest, ULONG* ulWrittenTotal)
{
BOOL bRetVal = FALSE;
FHANDLE fhndSource;
@@ -84,7 +80,7 @@ static BOOL hb_fsCopy(char* szSource, char* szDest, ULONG* ulWrittenTotal)
while ((fhndSource = hb_fsOpen((BYTEP)szSource, FO_READ)) == FS_ERROR)
{
if (hb_errorRT_BASE(EG_OPEN, 2012, NULL, szSource) == E_DEFAULT)
if (hb_errorRT_BASE_Ext1(EG_OPEN, 2012, NULL, szSource, hb_fsError(), EF_CANDEFAULT | EF_CANRETRY ) == E_DEFAULT)
{
*ulWrittenTotal = (ULONG)-1L;
break;
@@ -95,7 +91,7 @@ static BOOL hb_fsCopy(char* szSource, char* szDest, ULONG* ulWrittenTotal)
{
while ((fhndDest = hb_fsCreate((BYTEP)szDest, FC_NORMAL)) == FS_ERROR)
{
if (hb_errorRT_BASE(EG_CREATE, 2012, NULL, szDest) == E_DEFAULT)
if (hb_errorRT_BASE_Ext1(EG_CREATE, 2012, NULL, szDest, hb_fsError(), EF_CANDEFAULT | EF_CANRETRY ) == E_DEFAULT)
{
*ulWrittenTotal = (ULONG)-2L;
break;
@@ -123,7 +119,7 @@ static BOOL hb_fsCopy(char* szSource, char* szDest, ULONG* ulWrittenTotal)
{
while ((usWritten = hb_fsWrite(fhndDest, buffer, usRead)) != usRead)
{
if (hb_errorRT_BASE(EG_WRITE, 2012, NULL, szDest) == E_DEFAULT)
if (hb_errorRT_BASE_Ext1(EG_WRITE, 2012, NULL, szDest, hb_fsError(), EF_CANDEFAULT | EF_CANRETRY ) == E_DEFAULT)
{
bRetVal = FALSE;
break;

125
harbour/source/rtl/errorapi.c
View File

@@ -26,6 +26,7 @@
#include "ctoharb.h"
#include "itemapi.h"
#include "errorapi.h"
#include "langapi.h"
PHB_ITEM hb_errNew( void )
{
@@ -42,12 +43,28 @@ PHB_ITEM hb_errNew( void )
WORD hb_errLaunch( PHB_ITEM pError )
{
if ( !IS_BLOCK( &errorBlock ) )
{
/* TODO: Internal error: */
/* "No ERRORBLOCK() for error at: MODULENAME (0)" */
exit(1);
}
PushSymbol( &symEval );
Push( &errorBlock );
Push( pError );
Do( 1 );
return stack.Return.item.asInteger.value; /* TODO: hb_parnl( -1 ) */
if ( !IS_LOGICAL( &stack.Return ) )
{
/* TODO: Internal error: */
/* "Error recovery failure, MODULENAME (0)" */
exit(1);
}
return stack.Return.item.asLogical.value ? E_RETRY : E_DEFAULT;
}
void hb_errRelease( PHB_ITEM pError )
@@ -270,20 +287,29 @@ PHB_ITEM hb_errPutFlags( PHB_ITEM pError, USHORT uiFlags )
/* Wrappers for hb_errLaunch() */
WORD hb_errorRT_BASE( ULONG ulGenCode, ULONG ulSubCode, char * szDescription, char * szOperation )
static WORD hb_errorRT_New
(
USHORT uiSeverity,
char * szSubSystem,
ULONG ulGenCode,
ULONG ulSubCode,
char * szDescription,
char * szOperation,
USHORT uiOsCode,
USHORT uiFlags
)
{
PHB_ITEM pError = hb_errNew();
WORD wRetVal;
hb_errPutSeverity( pError, ES_ERROR );
hb_errPutSubSystem( pError, HB_ERR_SS_BASE );
hb_errPutSeverity( pError, uiSeverity );
hb_errPutSubSystem( pError, szSubSystem );
hb_errPutGenCode( pError, ulGenCode );
hb_errPutSubCode( pError, ulSubCode );
if( szDescription )
hb_errPutDescription( pError, szDescription );
else
hb_errPutDescription( pError, hb_errorNatDescription(ulGenCode) );
hb_errPutDescription( pError, szDescription ? szDescription : hb_langDGetErrorDesc(ulGenCode) );
hb_errPutOperation( pError, szOperation );
hb_errPutOsCode( pError, uiOsCode );
hb_errPutFlags( pError, uiFlags );
wRetVal = hb_errLaunch( pError );
@@ -292,69 +318,44 @@ WORD hb_errorRT_BASE( ULONG ulGenCode, ULONG ulSubCode, char * szDescription, ch
return wRetVal;
}
WORD hb_errorRT_BASE( ULONG ulGenCode, ULONG ulSubCode, char * szDescription, char * szOperation )
{
return hb_errorRT_New( ES_ERROR, HB_ERR_SS_BASE, ulGenCode, ulSubCode, szDescription, szOperation, 0, EF_NONE );
}
WORD hb_errorRT_BASE_Ext1( ULONG ulGenCode, ULONG ulSubCode, char * szDescription, char * szOperation, USHORT uiOsCode, USHORT uiFlags )
{
return hb_errorRT_New( ES_ERROR, HB_ERR_SS_BASE, ulGenCode, ulSubCode, szDescription, szOperation, uiOsCode, uiFlags );
}
WORD hb_errorRT_TERMINAL( ULONG ulGenCode, ULONG ulSubCode, char * szDescription, char * szOperation )
{
PHB_ITEM pError = hb_errNew();
WORD wRetVal;
hb_errPutSeverity( pError, ES_ERROR );
hb_errPutSubSystem( pError, HB_ERR_SS_TERMINAL );
hb_errPutGenCode( pError, ulGenCode );
hb_errPutSubCode( pError, ulSubCode );
if( szDescription )
hb_errPutDescription( pError, szDescription );
else
hb_errPutDescription( pError, hb_errorNatDescription(ulGenCode) );
hb_errPutOperation( pError, szOperation );
wRetVal = hb_errLaunch( pError );
hb_errRelease( pError );
return wRetVal;
return hb_errorRT_New( ES_ERROR, HB_ERR_SS_TERMINAL, ulGenCode, ulSubCode, szDescription, szOperation, 0, EF_NONE );
}
WORD hb_errorRT_DBCMD( ULONG ulGenCode, ULONG ulSubCode, char * szDescription, char * szOperation )
{
PHB_ITEM pError = hb_errNew();
WORD wRetVal;
hb_errPutSeverity( pError, ES_ERROR );
hb_errPutSubSystem( pError, HB_ERR_SS_DBCMD );
hb_errPutGenCode( pError, ulGenCode );
hb_errPutSubCode( pError, ulSubCode );
if( szDescription )
hb_errPutDescription( pError, szDescription );
else
hb_errPutDescription( pError, hb_errorNatDescription(ulGenCode) );
hb_errPutOperation( pError, szOperation );
wRetVal = hb_errLaunch( pError );
hb_errRelease( pError );
return wRetVal;
return hb_errorRT_New( ES_ERROR, HB_ERR_SS_DBCMD, ulGenCode, ulSubCode, szDescription, szOperation, 0, EF_NONE );
}
WORD hb_errorRT_TOOLS( ULONG ulGenCode, ULONG ulSubCode, char * szDescription, char * szOperation )
{
PHB_ITEM pError = hb_errNew();
WORD wRetVal;
hb_errPutSeverity( pError, ES_ERROR );
hb_errPutSubSystem( pError, HB_ERR_SS_BASE );
hb_errPutGenCode( pError, ulGenCode );
hb_errPutSubCode( pError, ulSubCode );
if( szDescription )
hb_errPutDescription( pError, szDescription );
else
hb_errPutDescription( pError, hb_errorNatDescription(ulGenCode) );
hb_errPutOperation( pError, szOperation );
wRetVal = hb_errLaunch( pError );
hb_errRelease( pError );
return wRetVal;
return hb_errorRT_New( ES_ERROR, HB_ERR_SS_BASE, ulGenCode, ulSubCode, szDescription, szOperation, 0, EF_NONE );
}
/* NOTES: Use as minimal calls from here, as possible. */
/* Don't allocate memory from this function. */
void hb_errorInternal ( ULONG ulIntCode, char * szText, char * szModule, WORD wLine, char * szPar1, char * szPar2, char * szPar3 )
{
char szError [ 256 ];
if ( szModule )
printf( "\n%s (%i) ", szModule, wLine );
sprintf( szError, szText ? szText : hb_langDGetErrorIntr( ulIntCode ), szPar1, szPar2, szPar3 );
printf( "Internal error %lu: %s\n\n", ulIntCode, szError );
exit( 1 );
}

53
harbour/source/rtl/errorsys.prg
View File

@@ -44,27 +44,70 @@ return
static function DefError( oError )
LOCAL cMessage
local cInfo := ""
local n := 2
LOCAL aOptions
LOCAL nChoice
LOCAL cInfo := ""
LOCAL n := 2
cMessage := ErrorMessage(oError)
// Build buttons
aOptions := {}
// aAdd(aOptions, "Break" )
aAdd(aOptions, "Quit" )
IF oError:canRetry
aAdd(aOptions, "Retry")
ENDIF
IF oError:canDefault
aAdd(aOptions, "Default")
ENDIF
// Show alert box
nChoice := 0
DO WHILE nChoice == 0
IF Empty( oError:osCode )
nChoice := Alert( cMessage, aOptions )
ELSE
nChoice := Alert( cMessage + ";(DOS Error " + LTrim(Str(oError:osCode)) + ")", aOptions)
ENDIF
ENDDO
DO CASE
CASE aOptions[ nChoice ] == "Break"
// Break(oError)
CASE aOptions[ nChoice ] == "Retry"
RETURN .T.
CASE aOptions[ nChoice ] == "Default"
RETURN .F.
ENDCASE
// "Quit" selected
IF !Empty(oError:osCode)
cMessage += " (DOS Error " + LTrim(Str(oError:osCode)) + ")"
ENDIF
QOut( cMessage)
do while ! Empty( ProcName( n ) )
DO WHILE ! Empty( ProcName( n ) )
QOut("Called from " + ProcName( n ) + ;
"(" + AllTrim( Str( ProcLine( n++ ) ) ) + ")")
enddo
ENDDO
// TOFIX: Removing ErrorLevel() call will cause a VM error
// don't know why [vszel]
ErrorLevel(1)
QUIT
return .F.
RETURN .F.
//----------------------------------------------------------------------------//

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

@@ -334,7 +334,7 @@ void hb_MemvarValueDecRef( HB_HANDLE hValue )
* pItem - value to store in memvar
*
*/
void hb_MemvarSetValue( PSYMBOL pMemvarSymb, HB_ITEM_PTR pItem )
void hb_MemvarSetValue( PHB_SYMB pMemvarSymb, HB_ITEM_PTR pItem )
{
PDYNSYM pDyn;
@@ -365,7 +365,7 @@ void hb_MemvarSetValue( PSYMBOL pMemvarSymb, HB_ITEM_PTR pItem )
hb_errorRT_BASE( EG_NOVAR, 1003, NULL, pMemvarSymb->szName );
}
void hb_MemvarGetValue( HB_ITEM_PTR pItem, PSYMBOL pMemvarSymb )
void hb_MemvarGetValue( HB_ITEM_PTR pItem, PHB_SYMB pMemvarSymb )
{
PDYNSYM pDyn;
@@ -393,7 +393,7 @@ void hb_MemvarGetValue( HB_ITEM_PTR pItem, PSYMBOL pMemvarSymb )
hb_errorRT_BASE( EG_NOVAR, 1003, NULL, pMemvarSymb->szName );
}
void hb_MemvarGetRefer( HB_ITEM_PTR pItem, PSYMBOL pMemvarSymb )
void hb_MemvarGetRefer( HB_ITEM_PTR pItem, PHB_SYMB pMemvarSymb )
{
PDYNSYM pDyn;

14
harbour/source/rtl/msgxxx.c
View File

@@ -50,17 +50,5 @@
#elif defined(HARBOUR_LANGUAGE_PLMAZ)
#include "natmsg/msgplmaz.c"
#else
#ifdef __TURBOC__
#include "source\rtl\natmsg\msgen.c"
#else
#include "natmsg/msgen.c"
#include "natmsg/msgen.c"
#endif
#endif
char *hb_errorNatDescription( ULONG ulGenError )
{
if( ulGenError < sizeof(hb_errorsGeneric) / sizeof(hb_errorsGeneric[ 0 ]) )
return hb_errorsGeneric[ ulGenError ];
else
return hb_errorsGeneric[ 0 ];
}

4
harbour/source/rtl/tget.prg
View File

@@ -1,3 +1,7 @@
/*
* $Id$
*/
/* Harbour Class TGet
* Copyright(C) 1999 by Ignacio Ortiz de Zúniga
*

6
harbour/source/rtl/tgetlist.prg
View File

@@ -1,3 +1,7 @@
/*
* $Id$
*/
/* Harbour Class TGetList
* Copyright(C) 1999 by Antonio Linares.
*
@@ -486,7 +490,7 @@ METHOD ReadVar( cNewVarName ) CLASS TGetList
local cOldName := ::cVarName
if ValType( cNewVarName ) == "C"
::cVarName = cNewVarName
::cVarName := cNewVarName
endif
return cOldName

35
harbour/source/runner/runner.c
View File

@@ -27,7 +27,9 @@
#include "pcode.h"
#include "errorapi.h"
#include "ctoharb.h"
#include "init.h"
#include "initsymd.h"
/* #if INTEL32 */
static BYTE prgFunction[] = { 0x68, 0x00, 0x00, 0x00, 0x00,
@@ -72,16 +74,12 @@ typedef struct
#define SYM_NOT_FOUND 0xFFFFFFFF /* Symbol not found.
FindSymbol */
static PASM_CALL CreateFun( PSYMBOL, PBYTE ); /* Create a dynamic function*/
void Do( WORD );
static ULONG FindSymbol( char *, PDYNFUNC, ULONG );
HARBOUR HB_HB_RUN();
static PASM_CALL CreateFun( PHB_SYMB, PBYTE ); /* Create a dynamic function*/
static ULONG FindSymbol( char *, PDYNFUNC, ULONG );
static void HRB_FileClose( FILE * );
static void HRB_FileRead ( char *, int, int, FILE * );
static FILE *HRB_FileOpen ( char * );
void Push( PHB_ITEM );
void PushNil( void );
void PushSymbol( PSYMBOL );
BYTE ReadByte( FILE * );
char *ReadId ( FILE * );
long ReadLong( FILE * );
@@ -92,26 +90,9 @@ static FILE *HRB_FileOpen ( char * );
*/
#include "run_exp.h"
extern void Arrays__InitSymbols( void );
extern void Classes__InitSymbols( void );
extern void Console__InitSymbols( void );
extern void CopyFile__InitSymbols( void );
extern void Dates__InitSymbols( void );
extern void Dates2__InitSymbols( void );
extern void Descend__InitSymbols( void );
extern void Dir__InitSymbols( void );
extern void Environ__InitSymbols( void );
extern void Files__InitSymbols( void );
extern void HardCR__InitSymbols( void );
extern void Math__InitSymbols( void );
extern void Memotran__InitSymbols( void );
extern void Set__InitSymbols( void );
extern void Strings__InitSymbols( void );
extern void Transfrm__InitSymbols( void );
static void InitRunnerTable( void )
{
#include "initsymb.h" /* Include default symbols */
#include "initsymc.h" /* Include default symbols */
}
#if !defined( __GNUC__ )
#pragma startup InitRunnerTable
@@ -142,7 +123,7 @@ HARBOUR HB_HB_RUN( void )
int i;
PSYMBOL pSymRead; /* Symbols read */
PHB_SYMB pSymRead; /* Symbols read */
PDYNFUNC pDynFunc; /* Functions read */
PDYNSYM pDynSym;
@@ -155,7 +136,7 @@ HARBOUR HB_HB_RUN( void )
if( file )
{
ulSymbols = ReadLong( file );
pSymRead = ( PSYMBOL )hb_xgrab( ulSymbols * sizeof( SYMBOL ) );
pSymRead = ( PHB_SYMB )hb_xgrab( ulSymbols * sizeof( HB_SYMB ) );
for( ul=0; ul < ulSymbols; ul++) /* Read symbols in .HRB */
{
@@ -454,7 +435,7 @@ static void PatchRelative( PBYTE pCode, ULONG ulOffset,
If a .PRG contains 10 functions, 10 dynamic functions are created which
are all the same :-) except for 2 pointers.
*/
static PASM_CALL CreateFun( PSYMBOL pSymbols, PBYTE pCode )
static PASM_CALL CreateFun( PHB_SYMB pSymbols, PBYTE pCode )
{
PASM_CALL asmRet = (PASM_CALL) hb_xgrab( sizeof( ASM_CALL ) );

23
harbour/source/vm/dynsym.c
View File

@@ -45,9 +45,9 @@ void hb_LogDynSym( void )
printf( "%i %s\n", w + 1, pDynItems[ w ].pDynSym->pSymbol->szName );
}
PSYMBOL hb_NewSymbol( char * szName ) /* Create a new symbol */
PHB_SYMB hb_NewSymbol( char * szName ) /* Create a new symbol */
{
PSYMBOL pSymbol = ( PSYMBOL ) hb_xgrab( sizeof( SYMBOL ) );
PHB_SYMB pSymbol = ( PHB_SYMB ) hb_xgrab( sizeof( HB_SYMB ) );
pSymbol->szName = ( char * ) hb_xgrab( strlen( szName ) + 1 );
pSymbol->cScope = SYM_ALLOCATED; /* to know what symbols to release when exiting the app */
@@ -58,7 +58,7 @@ PSYMBOL hb_NewSymbol( char * szName ) /* Create a new symbol */
return pSymbol;
}
PDYNSYM hb_NewDynSym( PSYMBOL pSymbol ) /* creates a new dynamic symbol */
PDYNSYM hb_NewDynSym( PHB_SYMB pSymbol ) /* creates a new dynamic symbol */
{
PDYNSYM pDynSym = hb_FindDynSym( pSymbol->szName ); /* Find position */
WORD w;
@@ -202,18 +202,17 @@ void hb_ReleaseDynSym( void )
hb_xfree( pDynItems );
}
HARBOUR HB_DYNSYMNAME(void) /* Get name of symbol */
{ /* cSymbol = DynSymName( dsIndex ) */
hb_retc( pDynItems[ hb_parnl( 1 ) - 1 ].pDynSym->pSymbol->szName );
}
HARBOUR HB_DYNSYMBOLS(void) /* How much symbols do we have */
{ /* dsCount = DynSymbols() */
HARBOUR HB___DYNSYMCOUNT( void ) /* How much symbols do we have: dsCount = __dynsymCount() */
{
hb_retnl( wDynSymbols );
}
HARBOUR HB_GETDYNSYM(void) /* Gimme index number of symbol */
/* dsIndex = hb_GetDynSym( cSymbol ) */
HARBOUR HB___DYNSYMGETNAME( void ) /* Get name of symbol: cSymbol = __dynsymGetName( dsIndex ) */
{
hb_retc( pDynItems[ hb_parnl( 1 ) - 1 ].pDynSym->pSymbol->szName );
}
HARBOUR HB___DYNSYMGETINDEX( void ) /* Gimme index number of symbol: dsIndex = __dynsymGetIndex( cSymbol ) */
{
hb_retnl( ( LONG ) hb_GetDynSym( hb_parc( 1 ) ) );
}

81
harbour/source/vm/hvm.c
View File

@@ -38,6 +38,7 @@
#include "extend.h"
#include "errorapi.h"
#include "itemapi.h"
#include "langapi.h"
#include "pcode.h"
#include "set.h"
#include "inkey.h"
@@ -54,11 +55,11 @@ extern ULONG ulMemoryMaxConsumed; /* memory max size consumed */
typedef struct _SYMBOLS
{
PSYMBOL pModuleSymbols; /* pointer to a one module own symbol table */
WORD wModuleSymbols; /* number of symbols on that table */
struct _SYMBOLS * pNext;/* pointer to the next SYMBOLS structure */
SYMBOLSCOPE hScope; /* scope collected from all symbols in module used to speed initialization code */
} SYMBOLS, * PSYMBOLS; /* structure to keep track of all modules symbol tables */
PHB_SYMB pModuleSymbols; /* pointer to a one module own symbol table */
WORD wModuleSymbols; /* number of symbols on that table */
struct _SYMBOLS * pNext; /* pointer to the next SYMBOLS structure */
SYMBOLSCOPE hScope; /* scope collected from all symbols in module used to speed initialization code */
} SYMBOLS, * PSYMBOLS; /* structure to keep track of all modules symbol tables */
HARBOUR HB_ERRORSYS( void );
HARBOUR HB_ERRORNEW( void );
@@ -90,7 +91,7 @@ void Inc( void ); /* increment the latest numeric value on the st
void Instring( void ); /* check whether string 1 is contained in string 2 */
void Less( void ); /* checks if the latest - 1 value is less than the latest, removes both and leaves result */
void LessEqual( void ); /* checks if the latest - 1 value is less than or equal the latest, removes both and leaves result */
void Message( PSYMBOL pSymMsg ); /* sends a message to an object */
void Message( PHB_SYMB pSymMsg ); /* sends a message to an object */
void Minus( void ); /* substracts the latest two values on the stack, removes them and leaves the result */
void Modulus( void ); /* calculates the modulus of latest two values on the stack, removes them and leaves the result */
void Mult( void ); /* multiplies the latest two values on the stack, removes them and leaves the result */
@@ -105,33 +106,33 @@ void PopDefStat( WORD wStatic ); /* pops the stack latest value onto a static
double PopDouble( WORD * ); /* pops the stack latest value and returns its double numeric format value */
void PopLocal( SHORT wLocal ); /* pops the stack latest value onto a local */
int PopLogical( void ); /* pops the stack latest value and returns its logical value */
void PopMemvar( PSYMBOL ); /* pops a value of memvar variable */
void PopMemvar( PHB_SYMB ); /* pops a value of memvar variable */
double PopNumber( void ); /* pops the stack latest value and returns its numeric value */
void PopParameter( PSYMBOL, BYTE ); /* creates a PRIVATE variable and sets it with parameter's value */
void PopParameter( PHB_SYMB, BYTE ); /* creates a PRIVATE variable and sets it with parameter's value */
void PopStatic( WORD wStatic ); /* pops the stack latest value onto a static */
void Power( void ); /* power the latest two values on the stack, removes them and leaves the result */
void Push( PHB_ITEM pItem ); /* pushes a generic item onto the stack */
void PushBlock( BYTE * pCode, PSYMBOL pSymbols ); /* creates a codeblock */
void PushBlock( BYTE * pCode, PHB_SYMB pSymbols ); /* creates a codeblock */
void PushDate( LONG lDate ); /* pushes a long date onto the stack */
void PushDouble( double lNumber, WORD wDec ); /* pushes a double number onto the stack */
void PushLocal( SHORT iLocal ); /* pushes the containts of a local onto the stack */
void PushLocalByRef( SHORT iLocal ); /* pushes a local by refrence onto the stack */
void PushLogical( int iTrueFalse ); /* pushes a logical value onto the stack */
void PushLong( long lNumber ); /* pushes a long number onto the stack */
void PushMemvar( PSYMBOL ); /* pushes a value of memvar variable */
void PushMemvarByRef( PSYMBOL ); /* pushes a reference to a memvar variable */
void PushMemvar( PHB_SYMB ); /* pushes a value of memvar variable */
void PushMemvarByRef( PHB_SYMB ); /* pushes a reference to a memvar variable */
void PushNil( void ); /* in this case it places nil at self */
void PushNumber( double dNumber, WORD wDec ); /* pushes a number on to the stack and decides if it is integer, long or double */
void PushStatic( WORD wStatic ); /* pushes the containts of a static onto the stack */
void PushStaticByRef( WORD iLocal ); /* pushes a static by refrence onto the stack */
void PushString( char * szText, ULONG length ); /* pushes a string on to the stack */
void PushSymbol( PSYMBOL pSym ); /* pushes a function pointer onto the stack */
void PushSymbol( PHB_SYMB pSym ); /* pushes a function pointer onto the stack */
void PushInteger( int iNumber ); /* pushes a integer number onto the stack */
void RetValue( void ); /* pops the latest stack value into stack.Return */
void SFrame( PSYMBOL pSym ); /* sets the statics frame for a function */
void Statics( PSYMBOL pSym ); /* increases the the global statics array to hold a PRG statics */
void SFrame( PHB_SYMB pSym ); /* sets the statics frame for a function */
void Statics( PHB_SYMB pSym ); /* increases the the global statics array to hold a PRG statics */
void ProcessSymbols( PSYMBOL pSymbols, WORD wSymbols ); /* statics symbols initialization */
void ProcessSymbols( PHB_SYMB pSymbols, WORD wSymbols ); /* statics symbols initialization */
void DoInitStatics( void ); /* executes all _INITSTATICS functions */
void DoInitFunctions( int argc, char * argv[] ); /* executes all defined PRGs INIT functions */
void DoExitFunctions( void ); /* executes all defined PRGs EXIT functions */
@@ -142,8 +143,8 @@ void ProcessObjSymbols ( void ); /* process Harbour generated OBJ symbols */
typedef struct
{
WORD wSymbols; /* module local symbol table symbols amount */
PSYMBOL pSymbols; /* module local symbol table address */
WORD wSymbols; /* module local symbol table symbols amount */
PHB_SYMB pSymbols; /* module local symbol table address */
} OBJSYMBOLS, * POBJSYMBOLS; /* structure used from Harbour generated OBJs */
#ifdef __cplusplus
@@ -168,8 +169,8 @@ static void ForceLink( void );
int iHB_DEBUG = 0; /* if 1 traces the virtual machine activity */
STACK stack;
SYMBOL symEval = { "__EVAL", FS_PUBLIC, DoBlock, 0 }; /* symbol to evaluate codeblocks */
PSYMBOL pSymStart; /* start symbol of the application. MAIN() is not required */
HB_SYMB symEval = { "__EVAL", FS_PUBLIC, DoBlock, 0 }; /* symbol to evaluate codeblocks */
PHB_SYMB pSymStart; /* start symbol of the application. MAIN() is not required */
HB_ITEM aStatics; /* Harbour array to hold all application statics variables */
HB_ITEM errorBlock; /* errorblock */
PSYMBOLS pSymbols = 0; /* to hold a linked list of all different modules symbol tables */
@@ -263,7 +264,7 @@ int main( int argc, char * argv[] )
return bErrorLevel;
}
void VirtualMachine( PBYTE pCode, PSYMBOL pSymbols )
void VirtualMachine( PBYTE pCode, PHB_SYMB pSymbols )
{
BYTE bCode;
WORD w = 0, wParams, wSize;
@@ -742,13 +743,13 @@ void Div( void )
void Do( WORD wParams )
{
PHB_ITEM pItem = stack.pPos - wParams - 2; /* procedure name */
PSYMBOL pSym = pItem->item.asSymbol.value;
PHB_SYMB pSym = pItem->item.asSymbol.value;
LONG wStackBase = stack.pBase - stack.pItems; /* as the stack memory block could change */
LONG wItemIndex = pItem - stack.pItems;
PHB_ITEM pSelf = stack.pPos - wParams - 1; /* NIL, OBJECT or BLOCK */
PHB_FUNC pFunc;
int iStatics = stack.iStatics; /* Return iStatics position */
LONG lLineNo = stack.pBase->item.asSymbol.lineno;
WORD wLineNo = stack.pBase->item.asSymbol.lineno;
if( ! IS_SYMBOL( pItem ) )
{
@@ -780,8 +781,8 @@ void Do( WORD wParams )
if( ! pFunc )
{
printf( "error: message %s not implemented for class %s in line %li\n",
pSym->szName, hb_GetClassName( pSelf ), lLineNo );
printf( "error: message %s not implemented for class %s in line %i\n",
pSym->szName, hb_GetClassName( pSelf ), wLineNo );
exit( 1 );
}
pFunc();
@@ -944,19 +945,21 @@ void ForTest( void ) /* Test to check the end point of the FOR */
dStep = PopDouble( &wDec );
/* NOTE: step of zero will cause endless loop, as in Clipper */
if( dStep > 0 ) /* Positive loop. Use LESS */
Less();
else if( dStep < 0 ) /* Negative loop. Use GREATER */
Greater();
else
printf( "step of zero will cause endless loop" );
/* Add some break code or so... */
iEqual = PopLogical(); /* Logical should be on top of stack */
PushNumber( dStep, wDec ); /* Push the step expression back on the stack */
PushLogical( iEqual );
}
else
printf( "step expression should be numerical" );
{
hb_errorRT_BASE(EG_ARG, 1073, NULL, "<");
}
}
void Frame( BYTE bLocals, BYTE bParams )
@@ -1237,7 +1240,7 @@ void LessEqual( void )
}
}
void Message( PSYMBOL pSymMsg ) /* sends a message to an object */
void Message( PHB_SYMB pSymMsg ) /* sends a message to an object */
{
hb_itemCopy( stack.pPos, stack.pPos - 1 ); /* moves the object forward */
hb_itemClear( stack.pPos - 1 );
@@ -1564,12 +1567,12 @@ int PopLogical( void )
}
else
{
hb_errorRT_BASE(EG_ARG, 1066, NULL, hb_errorNatDescription(EG_CONDITION));
hb_errorRT_BASE(EG_ARG, 1066, NULL, hb_langDGetErrorDesc(EG_CONDITION));
return 0;
}
}
void PopMemvar( PSYMBOL pSym )
void PopMemvar( PHB_SYMB pSym )
{
StackDec();
hb_MemvarSetValue( pSym, stack.pPos );
@@ -1608,7 +1611,7 @@ double PopNumber( void )
return dNumber;
}
void PopParameter( PSYMBOL pSym, BYTE bParam )
void PopParameter( PHB_SYMB pSym, BYTE bParam )
{
hb_MemvarSetValue( pSym, stack.pBase +1 +bParam );
HB_DEBUG( "PopParameter\n" );
@@ -1684,14 +1687,14 @@ void PushLocalByRef( SHORT iLocal )
HB_DEBUG2( "PushLocalByRef %i\n", iLocal );
}
void PushMemvar( PSYMBOL pSym )
void PushMemvar( PHB_SYMB pSym )
{
hb_MemvarGetValue( stack.pPos, pSym );
StackPush();
HB_DEBUG( "PushMemvar\n" );
}
void PushMemvarByRef( PSYMBOL pSym )
void PushMemvarByRef( PHB_SYMB pSym )
{
hb_MemvarGetRefer( stack.pPos, pSym );
StackPush();
@@ -1759,7 +1762,7 @@ void PushString( char * szText, ULONG length )
HB_DEBUG( "PushString\n" );
}
void PushSymbol( PSYMBOL pSym )
void PushSymbol( PHB_SYMB pSym )
{
stack.pPos->type = IT_SYMBOL;
stack.pPos->item.asSymbol.value = pSym;
@@ -1781,7 +1784,7 @@ void Push( PHB_ITEM pItem )
* +5 +6 -> number of referenced local variables
* +7 -> start of table with referenced local variables
*/
void PushBlock( BYTE * pCode, PSYMBOL pSymbols )
void PushBlock( BYTE * pCode, PHB_SYMB pSymbols )
{
WORD wLocals;
@@ -1981,14 +1984,14 @@ void StackShow( void )
printf( "\n" );
}
void SFrame( PSYMBOL pSym ) /* sets the statics frame for a function */
void SFrame( PHB_SYMB pSym ) /* sets the statics frame for a function */
{
/* _INITSTATICS is now the statics frame. Statics() changed it! */
stack.iStatics = ( int ) pSym->pFunPtr; /* pSym is { "$_INITSTATICS", FS_INIT | FS_EXIT, _INITSTATICS } for each PRG */
HB_DEBUG( "SFrame\n" );
}
void Statics( PSYMBOL pSym ) /* initializes the global aStatics array or redimensionates it */
void Statics( PHB_SYMB pSym ) /* initializes the global aStatics array or redimensionates it */
{
WORD wStatics = PopNumber();
@@ -2006,7 +2009,7 @@ void Statics( PSYMBOL pSym ) /* initializes the global aStatics array or redimen
HB_DEBUG2( "Statics %li\n", hb_arrayLen( &aStatics ) );
}
void ProcessSymbols( PSYMBOL pModuleSymbols, WORD wModuleSymbols ) /* module symbols initialization */
void ProcessSymbols( PHB_SYMB pModuleSymbols, WORD wModuleSymbols ) /* module symbols initialization */
{
PSYMBOLS pNewSymbols, pLastSymbols;
WORD w;

24
harbour/source/vm/initsymb.c
View File

@@ -9,23 +9,7 @@
#include "hbsetup.h"
#include "extend.h"
#include "hbdefs.h"
extern void Arrays__InitSymbols( void );
extern void Classes__InitSymbols( void );
extern void Console__InitSymbols( void );
extern void CopyFile__InitSymbols( void );
extern void Dates__InitSymbols( void );
extern void Dates2__InitSymbols( void );
extern void Descend__InitSymbols( void );
extern void Dir__InitSymbols( void );
extern void Environ__InitSymbols( void );
extern void Files__InitSymbols( void );
extern void HardCR__InitSymbols( void );
extern void Math__InitSymbols( void );
extern void Memotran__InitSymbols( void );
extern void Set__InitSymbols( void );
extern void Strings__InitSymbols( void );
extern void Transfrm__InitSymbols( void );
#include "initsymd.h"
HARBOUR HB_AADD( void );
HARBOUR HB_ABS( void );
@@ -73,7 +57,7 @@ HARBOUR HB_UPPER( void );
HARBOUR HB_VAL( void );
HARBOUR HB_YEAR( void );
static SYMBOL symbols[] = {
static HB_SYMB symbols[] = {
{ "AADD" , FS_PUBLIC, HB_AADD , 0 },
{ "ABS" , FS_PUBLIC, HB_ABS , 0 },
{ "ASC" , FS_PUBLIC, HB_ASC , 0 },
@@ -155,11 +139,11 @@ void InitSymbolTable( void )
* The symbol tables from runtime support modules start here
*/
#ifdef HARBOUR_STRICT_ANSI_C
#include "initsymb.h"
#include "initsymc.h"
#endif
/*
* The system symbol table with runtime functions HAVE TO be called last
*/
ProcessSymbols( symbols, sizeof(symbols)/sizeof( SYMBOL ) );
ProcessSymbols( symbols, sizeof(symbols)/sizeof( HB_SYMB ) );
}

3
harbour/tests/working/Makefile
View File

@@ -45,12 +45,14 @@ PRG_SOURCES=\
dates2.prg \
dates3.prg \
dates4.prg \
debugger.prg \
debugtst.prg \
descend.prg \
dirtest.prg \
docase.prg \
dosshell.prg \
dynobj.prg \
dynsym.prg \
empty.prg \
exittest.prg \
fib.prg \
@@ -127,6 +129,7 @@ PRG_SOURCES=\
teststr.prg \
testtok.prg \
testpre.prg \
testread.prg \
testrdd.prg \
testvars.prg \
testwarn.prg \

4
harbour/tests/working/debugger.prg
View File

@@ -1,3 +1,7 @@
/*
* $Id$
*/
/* Harbour debugger first outline
* Copyright(C) 1999 by Antonio Linares <alinares@fivetech.com>
*

13
harbour/tests/working/dynsym.prg Normal file
View File

@@ -0,0 +1,13 @@
/*
* $Id$
*/
FUNCTION Main()
LOCAL nCount := __dynsymCount()
LOCAL nPos
FOR nPos := 1 TO nCount
OutStd( __dynsymGetName( nPos ), Chr(13) + Chr(10) )
NEXT
RETURN NIL

4
harbour/tests/working/testread.prg
View File

@@ -1,3 +1,7 @@
/*
* $Id$
*/
// Harbour Get System sample
function Main()