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

ChangeLog: 19990629-05:55

Browse Source
This commit is contained in:
Ryszard Glab
1999-06-29 05:07:16 +00:00
parent 22edb32b44
commit cdfdaafdd5
31 changed files with 1160 additions and 882 deletions
Download Patch File Download Diff File Expand all files Collapse all files

42
harbour/ChangeLog
View File

@@ -1,3 +1,45 @@
19990629-05:55 Ryszard Glab <rglab@imid.med.pl>
* Tagged all sources with the name 'release_old_item'
You can download old version by issuing tthe following command:
cvs checkout -r release_old_item harbour
(be sure to checkout into new directory)
To check tag names for file use:
cvs status -v <filename>
* include/extend.h
* changed definition of HB_ITEM structure
* include/init.h
* added HB_INIT_SYMBOLS and HB_CALL_ON_STARTUP macros
* include/hbsetup.h
* renamed HB_STRICT_CLIPPER_COMPATIBILITY to
HARBOUR_STRICT_CLIPPER_COMPATIBILITY
+ added HARBOUR_STRICT_ANSI_C definition
* source/vm/hvm.c
* changed to use the new HB_ITEM
* source/initsymb.c
* changed to use HARBOUR_STRICT_ANSI_C
* source/rtl/*.c
* changed to use the new HB_ITEM
* changed to automatically register symbol table
*source/tools/stringsx.c
* removed direct access to Harbour internals HB_ITEM structure
* source/compiler/harbour.l
* corrected line continuation bugs
* source/compiler/harbour.y
* corrected line continuation bug
* tests/working/linecont.prg
* added some more code for testing line continuation
19990628-23:30 EDT David G. Holm <dholm@jsd-llc.com>
* source/tools/hb_f.c
* Undid previous type change for x in hb_hbfskip(), because it

119
harbour/include/extend.h
View File

@@ -49,31 +49,100 @@ void ProcessSymbols( SYMBOL *, WORD );
#define IT_NUMERIC ( IT_INTEGER | IT_LONG | IT_DOUBLE )
#define IT_ANY 0xFFFF
struct _CODEBLOCK; /* forward declaration */
struct _HB_CODEBLOCK; /* forward declaration */
struct _HB_BASEARRAY; /* forward declaration */
typedef struct /* items hold at the virtual machine stack */
struct hb_struArray
{
WORD wType; /* type of the item */
WORD wLength; /* length of the item */
WORD wDec; /* decimal places in a numeric double item */
union { /* different things may be holded here */
char * szText; /* string values */
int iNumber; /* int values */
long lNumber; /* long values */
double dNumber; /* double values */
int iLogical; /* logical values */
long lDate; /* date values */
PSYMBOL pSymbol; /* functions call symbol */
struct _CODEBLOCK * pCodeblock;/* pointer to a codeblock structure */
WORD wItem; /* variable by reference, stack offset */
void * pBaseArray; /* array base */
} value;
WORD wBase; /* stack frame number of items position for a function call */
WORD wLine; /* currently processed PRG line number */
WORD wParams; /* number of received parameters for a function call */
} HB_ITEM, * PHB_ITEM;
struct _HB_BASEARRAY * value;
};
typedef struct
struct hb_struBlock
{
LONG stackbase;
WORD lineno;
WORD paramcnt;
struct _HB_CODEBLOCK * value;
};
struct hb_struDate
{
WORD length;
LONG value;
};
struct hb_struDouble
{
WORD length;
WORD decimal;
double value;
};
struct hb_struInteger
{
WORD length;
WORD decimal;
int value;
};
struct hb_struLogical
{
WORD length;
WORD value;
};
struct hb_struLong
{
WORD length;
WORD decimal;
long value;
};
struct hb_struPointer
{
void *value;
};
struct hb_struRefer
{
LONG stackbase;
LONG value;
};
struct hb_struString
{
ULONG length;
char *value;
};
struct hb_struSymbol
{
LONG stackbase;
WORD lineno;
WORD paramcnt;
PSYMBOL value;
};
typedef struct /* items hold at the virtual machine stack */
{
WORD type;
union {
struct hb_struArray asArray;
struct hb_struBlock asBlock;
struct hb_struDate asDate;
struct hb_struDouble asDouble;
struct hb_struInteger asInteger;
struct hb_struLogical asLogical;
struct hb_struLong asLong;
struct hb_struPointer asPointer;
struct hb_struRefer asRefer;
struct hb_struString asString;
struct hb_struSymbol asSymbol;
} item;
}
HB_ITEM, *PHB_ITEM;
typedef struct _HB_BASEARRAY
{
PHB_ITEM pItems; /* pointer to the array items */
ULONG ulLen; /* number of items in the array */
@@ -86,7 +155,7 @@ typedef struct /* stack managed by the virtual machine */
{
PHB_ITEM pItems; /* pointer to the stack items */
PHB_ITEM pPos; /* pointer to the latest used item */
LONG wItems; /* total items that may be holded on the stack */
LONG wItems; /* total items that may be holded on the stack */
HB_ITEM Return; /* latest returned value */
PHB_ITEM pBase; /* stack frame position for the current function call */
PHB_ITEM pEvalBase;/* stack frame position for the evaluated codeblock */
@@ -103,7 +172,7 @@ typedef struct
} DYNSYM, * PDYNSYM; /* dynamic symbol structure */
/* internal structure for codeblocks */
typedef struct _CODEBLOCK
typedef struct _HB_CODEBLOCK
{
BYTE * pCode; /* codeblock pcode */
PHB_ITEM pItems; /* table with referenced local variables */
@@ -113,7 +182,7 @@ typedef struct _CODEBLOCK
WORD wRefBase; /* stack frame position for referenced local variables */
int iStatBase; /* static base for function where CB was created */
long lCounter; /* numer of references to this codeblock */
} CODEBLOCK, * PCODEBLOCK;
} HB_CODEBLOCK, * HB_CODEBLOCK_PTR;
PHB_ITEM hb_param( WORD wParam, WORD wType ); /* retrieve a generic parameter */
char * hb_parc( WORD wParam, ... ); /* retrieve a string parameter */

42
harbour/include/hbsetup.h
View File

@@ -1,15 +1,33 @@
/*
* $Id$
*
* Harbour compiler and runtime configuration file
*/
#ifndef HB_SETUP_H_
#define HB_SETUP_H_
/*
* Harbour compiler and runtime configuration file
*/
/* ***********************************************************************
* This symbol defines if Harbour is compiled using C compiler
* that support strict ANSI C only
*
* The only non ANSI C feature that we are using is an ability
* to call functions before the 'main' module is called.
* This trick is used to automatically join all symbol tables defined
* in run-time support modules and in user defined modules.
* If strict ANSI C compability is required then all symbol tables
* have to be joined manually by calling special function named
* <module_name>__InitSymbols
* (for example for myfirst.prg it will be: 'MYFIRST__InitSymbols'
* The generation of this function is performed by the macro called
* HB_CALL_ON_STARTUP that is defined in 'init.h'
*
* By default we are using extensions to ANSI C (symbol is not defined)
*/
/*#define HARBOUR_STRICT_ANSI_C */
/* The name of starting procedure
/* ***********************************************************************
* The name of starting procedure
* Note: You have to define it in case when Harbour cannot find the proper
* starting procedure (due to incorrect order of static data initialization)
*
@@ -25,26 +43,30 @@
#endif
#endif
/* This symbol defines if we want an ability to create and link OBJ files
/* ***********************************************************************
* This symbol defines if we want an ability to create and link OBJ files
* generated by Harbour compiler
*
* By default it is disabled (symbol is not defined)
*/
/*#define HARBOUR_OBJ_GENERATION*/
/* This symbol defines if we want to use strict Clipper compatibility
/* ***********************************************************************
* This symbol defines if we want to use strict Clipper compatibility
*
* By default it is disabled (symbol is not defined)
*/
/*#define HB_STRICT_CLIPPER_COMPATIBILITY*/
/*#define HARBOUR_STRICT_CLIPPER_COMPATIBILITY*/
/* This symbol defines if we want to use the GT API
/* ***********************************************************************
* This symbol defines if we want to use the GT API
*
* By default it is disabled (symbol is not defined)
*/
/*#define USE_GTAPI*/
/*#define HARBOUR_USE_GTAPI*/
/* Operating system specific definitions
/* ***********************************************************************
* Operating system specific definitions
*/
#ifdef __GNUC__
/* The GNU C compiler is used */

89
harbour/include/init.h
View File

@@ -1,47 +1,90 @@
/*
* $Id$
*
* Harbour local symbols initialization
*/
#ifndef HB_INIT_H_
#define HB_INIT_H_
/* Harbour local symbols initialization */
void ProcessSymbols( SYMBOL * pSymbols, WORD wSymbols );
#ifdef HARBOUR_STRICT_ANSI_C
#define HB_INIT_SYMBOLS( func ) \
void func( void ) \
{ \
ProcessSymbols( symbols, sizeof( symbols ) / sizeof( SYMBOL ) ); \
}
#define HB_CALL_ON_STARTUP( func ) func( void )
#define HB_RETURN_ON_STARTUP
#else /* HARBOUR_STRICT_ANSI_C */
#ifdef __GNUC__
static void __attribute__ ((constructor)) InitSymbols( void )
{
ProcessSymbols( symbols, sizeof( symbols ) / sizeof( SYMBOL ) );
}
#define HB_INIT_SYMBOLS( func ) \
static void __attribute__ ((constructor)) func( void ) \
{ \
ProcessSymbols( symbols, sizeof( symbols ) / sizeof( SYMBOL ) ); \
}
#define HB_CALL_ON_STARTUP( func ) \
static void __attribute__ ((constructor)) func( void )
#define HB_RETURN_ON_STARTUP
#endif
#ifdef __BORLANDC__
static void InitSymbols( void )
{
ProcessSymbols( symbols, sizeof( symbols ) / sizeof( SYMBOL ) );
}
#pragma startup InitSymbols
#define HB_INIT_SYMBOLS( func ) \
static void func( void ) \
{ \
ProcessSymbols( symbols, sizeof( symbols ) / sizeof( SYMBOL ) ); \
} \
#pragma startup func
#define HB_CALL_ON_STARTUP( func ) \
static void func( void )
#pragma startup func
#define HB_RETURN_ON_STARTUP
#endif
#if (defined(_MSC_VER) || defined(__IBMCPP__))
static int InitSymbols( void )
{
ProcessSymbols( symbols, sizeof( symbols ) / sizeof( SYMBOL ) );
return 1;
}
static int q = InitSymbols();
#define HB_INIT_SYMBOLS( func ) \
static int func( void ) \
{ \
ProcessSymbols( symbols, sizeof( symbols ) / sizeof( SYMBOL ) ); \
return 1; \
} \
static int static_int_##func = func();
#define HB_CALL_ON_STARTUP( func ) \
static int func( void ); \
static int static_int_##func = func(); \
static int func( void )
#define HB_RETURN_ON_STARTUP return 1;
#endif
#ifdef __WATCOMC__
static int InitSymbols( void )
{
ProcessSymbols( symbols, sizeof( symbols ) / sizeof( SYMBOL ) );
return 1;
}
static int _STATIC_INT_INIT_SYMBOLS = InitSymbols();
#define HB_INIT_SYMBOLS( func ) \
static int func( void ) \
{ \
ProcessSymbols( symbols, sizeof( symbols ) / sizeof( SYMBOL ) ); \
return 1; \
} \
static int static_int_##func = func();
#define HB_CALL_ON_STARTUP( func ) \
static int func( void ); \
static int static_int_##func = func(); \
static int func( void )
#define HB_RETURN_ON_STARTUP return 1;
#endif
#endif /*HARBOUR_STRICT_ANSI_C */
#endif /* HB_INIT_H_ */

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

@@ -58,7 +58,7 @@ long lNumber = 0;
#define LOOKUP 0 /* scan from the begining of line */
#define OPERATOR -1
#define SEPARATOR -2
static int _iState = LOOKUP;
int _iState = LOOKUP;
static int _iOpenBracket = 0;
/* Support for Array Index */
@@ -200,13 +200,12 @@ Separator {SpaceTab}
if( i_INDEX_STATE ) BEGIN INDEX; else BEGIN 0;
++iLine;
if( ! _iQuiet ) printf( "\rline: %i", iLine );
_iState=LINECONT_;
return ';';
}
<LINECONT_>{Separator}*("("|")") {
GenError( ERR_INCOMPLETE_STMT, yytext, NULL );
}
<LINECONT_>{Separator}*";" ; /*Ignore any repeated ';' */
<LINECONT_>";" ; /*Ignore any repeated ';' */
<LINECONT_>{Separator}*. {
unput( yytext[ yyleng-1 ] );
if( i_INDEX_STATE )

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

@@ -398,7 +398,6 @@ int _iRestrictSymbolLength = 0; /* generate 10 chars max symbols length */
int _iShortCuts = 1; /* .and. & .or. expressions shortcuts */
int _iWarnings = 0; /* enable parse warnings */
short int _iAltSymbolTableInit = 0; /* alternative method of symbol table initialization */
WORD _wSeqCounter = 0;
WORD _wForCounter = 0;
WORD _wIfCounter = 0;
@@ -416,6 +415,9 @@ PATHNAMES *_pIncludePath = NULL;
PSTACK_VAL_TYPE pStackValType = 0; /* compile time stack values linked list */
char cVarType = ' '; /* current declared variable type */
#define LOOKUP 0
extern int _iState; /* current parser state (defined in harbour.l */
%}
%union /* special structure used by lex and yacc to share info */
@@ -501,10 +503,11 @@ Source : Crlf
Include : NE1 INCLUDE LITERAL { if( ! Include( $3, _pIncludePath ) )
GenError( ERR_CANT_OPEN_INCLUDE, $3, NULL );
_iState =LOOKUP;
} Crlf
;
Extern : EXTERN ExtList Crlf
Extern : EXTERN ExtList { _iState =LOOKUP; } Crlf
;
ExtList : IDENTIFIER { AddExtern( $1 ); }
@@ -529,52 +532,52 @@ FunScope : { $$ = FS_PUBLIC; }
| EXIT { $$ = FS_EXIT; }
;
Params : { $$ = 0; }
| '(' ')' { $$ = 0; }
| '(' { iVarScope = VS_PARAMETER; } ParamList ')' { $$ = $3; }
Params : { $$ = 0; _iState =LOOKUP; }
| '(' ')' { $$ = 0; _iState =LOOKUP; }
| '(' { iVarScope = VS_PARAMETER; } ParamList ')' { $$ = $3; _iState =LOOKUP; }
;
ParamList : IDENTIFIER { cVarType = ' '; AddVar( $1 ); $$ = 1; }
| IDENTIFIER AS_NUMERIC { cVarType = 'N'; AddVar( $1 ); $$ = 1; }
| IDENTIFIER AS_CHARACTER { cVarType = 'C'; AddVar( $1 ); $$ = 1; }
| IDENTIFIER AS_DATE { cVarType = 'D'; AddVar( $1 ); $$ = 1; }
| IDENTIFIER AS_LOGICAL { cVarType = 'L'; AddVar( $1 ); $$ = 1; }
| IDENTIFIER AS_ARRAY { cVarType = 'A'; AddVar( $1 ); $$ = 1; }
| IDENTIFIER AS_BLOCK { cVarType = 'B'; AddVar( $1 ); $$ = 1; }
| IDENTIFIER AS_OBJECT { cVarType = 'O'; AddVar( $1 ); $$ = 1; }
| ParamList ',' IDENTIFIER { AddVar( $3 ); $$++; }
ParamList : IDENTIFIER { cVarType = ' '; AddVar( $1 ); $$ = 1; }
| IDENTIFIER AS_NUMERIC { cVarType = 'N'; AddVar( $1 ); $$ = 1; }
| IDENTIFIER AS_CHARACTER { cVarType = 'C'; AddVar( $1 ); $$ = 1; }
| IDENTIFIER AS_DATE { cVarType = 'D'; AddVar( $1 ); $$ = 1; }
| IDENTIFIER AS_LOGICAL { cVarType = 'L'; AddVar( $1 ); $$ = 1; }
| IDENTIFIER AS_ARRAY { cVarType = 'A'; AddVar( $1 ); $$ = 1; }
| IDENTIFIER AS_BLOCK { cVarType = 'B'; AddVar( $1 ); $$ = 1; }
| IDENTIFIER AS_OBJECT { cVarType = 'O'; AddVar( $1 ); $$ = 1; }
| ParamList ',' IDENTIFIER { AddVar( $3 ); $$++; }
;
Statements : Statement
| Statements { Line(); } Statement
;
Statement : ExecFlow Crlf {}
| FunCall Crlf { Do( $1 ); }
| AliasFunc Crlf {}
| IfInline Crlf { GenPCode1( HB_P_POP ); }
| ObjectMethod Crlf { GenPCode1( HB_P_POP ); }
| VarUnary Crlf { GenPCode1( HB_P_POP ); }
| VarAssign Crlf { GenPCode1( HB_P_POP ); }
Statement : ExecFlow { _iState =LOOKUP; } Crlf {}
| FunCall { _iState =LOOKUP; } Crlf { Do( $1 ); }
| AliasFunc { _iState =LOOKUP; } Crlf {}
| IfInline { _iState =LOOKUP; } Crlf { GenPCode1( HB_P_POP ); }
| ObjectMethod { _iState =LOOKUP; } Crlf { GenPCode1( HB_P_POP ); }
| VarUnary { _iState =LOOKUP; } Crlf { GenPCode1( HB_P_POP ); }
| VarAssign { _iState =LOOKUP; } Crlf { GenPCode1( HB_P_POP ); }
| IDENTIFIER '=' Expression Crlf { PopId( $1 ); }
| AliasExp '=' Expression Crlf { /* TODO */ GenPCode1( HB_P_POP ); }
| VarId ArrayIndex '=' Expression Crlf { GenPCode1( HB_P_ARRAYPUT ); GenPCode1( HB_P_POP ); }
| FunArrayCall '=' Expression Crlf { GenPCode1( HB_P_ARRAYPUT ); GenPCode1( HB_P_POP ); }
| IdSend IDENTIFIER '=' { Message( SetData( $2 ) ); } Expression Crlf { Function( 1 ); }
| ObjectData ArrayIndex '=' Expression Crlf { GenPCode1( HB_P_ARRAYPUT ); GenPCode1( HB_P_POP ); }
| ObjectMethod ArrayIndex '=' Expression Crlf { GenPCode1( HB_P_ARRAYPUT ); GenPCode1( HB_P_POP ); }
| IDENTIFIER '=' Expression { _iState =LOOKUP; } Crlf { PopId( $1 ); }
| AliasExp '=' Expression { _iState =LOOKUP; } Crlf { /* TODO */ GenPCode1( HB_P_POP ); }
| VarId ArrayIndex '=' Expression { _iState =LOOKUP; } Crlf { GenPCode1( HB_P_ARRAYPUT ); GenPCode1( HB_P_POP ); }
| FunArrayCall '=' Expression { _iState =LOOKUP; } Crlf { GenPCode1( HB_P_ARRAYPUT ); GenPCode1( HB_P_POP ); }
| IdSend IDENTIFIER '=' { Message( SetData( $2 ) ); } Expression { _iState =LOOKUP; } Crlf { Function( 1 ); }
| ObjectData ArrayIndex '=' Expression { _iState =LOOKUP; } Crlf { GenPCode1( HB_P_ARRAYPUT ); GenPCode1( HB_P_POP ); }
| ObjectMethod ArrayIndex '=' Expression { _iState =LOOKUP; } Crlf { GenPCode1( HB_P_ARRAYPUT ); GenPCode1( HB_P_POP ); }
| BREAK Crlf
| BREAK Expression Crlf
| RETURN Crlf { GenReturn( Jump( 0 ) ); }
| RETURN Expression Crlf { GenPCode1( HB_P_RETVALUE ); GenReturn( Jump ( 0 ) ); }
| PUBLIC { iVarScope = VS_MEMVAR; } VarList Crlf
| PRIVATE { iVarScope = VS_MEMVAR; } VarList Crlf
| PARAMETERS { iVarScope = VS_MEMVAR; } IdentList Crlf
| EXITLOOP Crlf { LoopExit(); }
| LOOP Crlf { LoopLoop(); }
| DoProc Crlf
| BREAK { _iState =LOOKUP; } Crlf
| BREAK Expression { _iState =LOOKUP; } Crlf
| RETURN { _iState =LOOKUP; } Crlf { GenReturn( Jump( 0 ) ); }
| RETURN Expression { _iState =LOOKUP; } Crlf { GenPCode1( HB_P_RETVALUE ); GenReturn( Jump ( 0 ) ); }
| PUBLIC { iVarScope = VS_MEMVAR; } VarList { _iState =LOOKUP; } Crlf
| PRIVATE { iVarScope = VS_MEMVAR; } VarList { _iState =LOOKUP; } Crlf
| PARAMETERS { iVarScope = VS_MEMVAR; } IdentList { _iState =LOOKUP; } Crlf
| EXITLOOP { _iState =LOOKUP; } Crlf { LoopExit(); }
| LOOP { _iState =LOOKUP; } Crlf { LoopLoop(); }
| DoProc { _iState =LOOKUP; } Crlf
;
FunCall : FunStart ')' { $$ = 0; }
@@ -877,8 +880,8 @@ ExpList : Expression %prec POST { $$ = 1; }
| ExpList { GenPCode1( HB_P_POP ); } ',' Expression %prec POST { $$++; }
;
VarDefs : LOCAL { iVarScope = VS_LOCAL; Line(); } VarList Crlf { cVarType = ' '; SetFrame(); }
| STATIC { StaticDefStart() } VarList Crlf { StaticDefEnd( $<iNumber>3 ); }
VarDefs : LOCAL { iVarScope = VS_LOCAL; Line(); } VarList { _iState =LOOKUP; } Crlf { cVarType = ' '; SetFrame(); }
| STATIC { StaticDefStart() } VarList { _iState =LOOKUP; } Crlf { StaticDefEnd( $<iNumber>3 ); }
;
VarList : VarDef { $$ = 1; }
@@ -905,7 +908,7 @@ VarDef : IDENTIFIER { cVarType = ' '; AddV
| IDENTIFIER '[' ExpList ']' AS_ARRAY { cVarType = 'A'; AddVar( $1 ); DimArray( $3 ); }
;
FieldsDef : FIELD { iVarScope =VS_FIELD; } FieldList Crlf { LineBody(); }
FieldsDef : FIELD { iVarScope =VS_FIELD; } FieldList { _iState =LOOKUP; } Crlf { LineBody(); }
;
FieldList : IDENTIFIER { cVarType = ' '; $$=FieldsCount(); AddVar( $1 ); }
@@ -920,7 +923,7 @@ FieldList : IDENTIFIER { cVarType = ' '; $$=FieldsCo
| FieldList IN IDENTIFIER { SetAlias( $3, $<iNumber>1 ); }
;
MemvarDef : MEMVAR { iVarScope = VS_MEMVAR; } MemvarList Crlf { LineBody(); }
MemvarDef : MEMVAR { iVarScope = VS_MEMVAR; } MemvarList { _iState =LOOKUP; } Crlf { LineBody(); }
;
MemvarList : IDENTIFIER { AddVar( $1 ); }
@@ -944,23 +947,23 @@ IfEndif : IfBegin EndIf { JumpHere( $1 ); }
| IfBegin IfElseIf IfElse EndIf { JumpHere( $1 ); FixElseIfs( $2 ); }
;
IfBegin : IF Expression { ++_wIfCounter; } Crlf { $$ = JumpFalse( 0 ); }
IfBegin : IF Expression { ++_wIfCounter; _iState =LOOKUP; } Crlf { $$ = JumpFalse( 0 ); }
IfStats
{ $$ = Jump( 0 ); JumpHere( $<iNumber>5 ); }
;
IfElse : ELSE Crlf IfStats
IfElse : ELSE { _iState =LOOKUP; } Crlf IfStats
;
IfElseIf : ELSEIF Expression Crlf { $<iNumber>$ = JumpFalse( 0 ); }
IfElseIf : ELSEIF Expression { _iState =LOOKUP; } Crlf { $<iNumber>$ = JumpFalse( 0 ); }
IfStats { $$ = GenElseIf( 0, Jump( 0 ) ); JumpHere( $<iNumber>4 ); }
| IfElseIf ELSEIF Expression Crlf { $<iNumber>$ = JumpFalse( 0 ); }
| IfElseIf ELSEIF Expression { _iState =LOOKUP; } Crlf { $<iNumber>$ = JumpFalse( 0 ); }
IfStats { $$ = GenElseIf( $1, Jump( 0 ) ); JumpHere( $<iNumber>5 ); }
;
EndIf : ENDIF { --_wIfCounter; }
| END { --_wIfCounter; }
EndIf : ENDIF { --_wIfCounter; _iState =LOOKUP; }
| END { --_wIfCounter; _iState =LOOKUP; }
;
IfStats : /* no statements */
@@ -984,29 +987,29 @@ DoCase : DoCaseBegin
EndCase { FixElseIfs( $2 ); }
;
EndCase : ENDCASE { --_wCaseCounter; }
| END { --_wCaseCounter; }
EndCase : ENDCASE { --_wCaseCounter; _iState =LOOKUP; }
| END { --_wCaseCounter; _iState =LOOKUP; }
;
DoCaseBegin : DOCASE { ++_wCaseCounter; } Crlf
DoCaseBegin : DOCASE { ++_wCaseCounter; _iState =LOOKUP; } Crlf
;
Cases : CASE Expression Crlf { $<iNumber>$ = JumpFalse( 0 ); Line(); } CaseStmts { $$ = GenElseIf( 0, Jump( 0 ) ); JumpHere( $<iNumber>4 ); Line(); }
| Cases CASE Expression Crlf { $<iNumber>$ = JumpFalse( 0 ); Line(); } CaseStmts { $$ = GenElseIf( $1, Jump( 0 ) ); JumpHere( $<iNumber>5 ); Line(); }
Cases : CASE Expression { _iState =LOOKUP; } Crlf { $<iNumber>$ = JumpFalse( 0 ); Line(); } CaseStmts { $$ = GenElseIf( 0, Jump( 0 ) ); JumpHere( $<iNumber>4 ); Line(); }
| Cases CASE Expression { _iState =LOOKUP; } Crlf { $<iNumber>$ = JumpFalse( 0 ); Line(); } CaseStmts { $$ = GenElseIf( $1, Jump( 0 ) ); JumpHere( $<iNumber>5 ); Line(); }
;
Otherwise : OTHERWISE Crlf CaseStmts
Otherwise : OTHERWISE { _iState =LOOKUP; } Crlf CaseStmts
;
CaseStmts : /* no statements */
| Statements
;
DoWhile : WhileBegin Expression Crlf { $<lNumber>$ = JumpFalse( 0 ); }
DoWhile : WhileBegin WhileExpression Crlf { $<lNumber>$ = JumpFalse( 0 ); }
{ Jump( $1 - functions.pLast->lPCodePos ); }
EndWhile { JumpHere( $<lNumber>4 ); --_wWhileCounter; }
| WhileBegin Expression Crlf { $<lNumber>$ = JumpFalse( 0 ); Line(); }
| WhileBegin WhileExpression Crlf { $<lNumber>$ = JumpFalse( 0 ); Line(); }
WhileStatements { LoopHere(); Jump( $1 - functions.pLast->lPCodePos ); }
EndWhile { JumpHere( $<lNumber>4 ); --_wWhileCounter; LoopEnd(); }
;
@@ -1014,17 +1017,20 @@ DoWhile : WhileBegin Expression Crlf { $<lNumber>$ = JumpFalse( 0 ); }
WhileBegin : WHILE { $$ = functions.pLast->lPCodePos; ++_wWhileCounter; LoopStart(); }
;
WhileExpression : Expression { _iState =LOOKUP; }
;
WhileStatements : Statement
| WhileStatements Statement { Line(); }
;
EndWhile : END
| ENDDO
EndWhile : END { _iState =LOOKUP; }
| ENDDO { _iState =LOOKUP; }
;
ForNext : FOR IDENTIFIER ForAssign Expression { PopId( $2 ); $<iNumber>$ = functions.pLast->lPCodePos; ++_wForCounter; LoopStart(); }
TO Expression { PushId( $2 ); }
StepExpr Crlf { GenPCode1( HB_P_FORTEST ); $<iNumber>$ = JumpTrue( 0 ); }
StepExpr { _iState =LOOKUP; } Crlf { GenPCode1( HB_P_FORTEST ); $<iNumber>$ = JumpTrue( 0 ); }
ForStatements { LoopHere(); PushId( $2 ); GenPCode1( HB_P_PLUS ); PopId( $2 ); Jump( $<iNumber>5 - functions.pLast->lPCodePos ); JumpHere( $<iNumber>11 ); LoopEnd(); }
;
@@ -1036,16 +1042,16 @@ StepExpr : /* default step expression */ { PushInteger( 1 ); }
| STEP Expression
;
ForStatements : ForStat NEXT { --_wForCounter; }
| ForStat NEXT IDENTIFIER { --_wForCounter; }
| NEXT { --_wForCounter; }
| NEXT IDENTIFIER { --_wForCounter; }
ForStatements : ForStat NEXT { --_wForCounter; _iState =LOOKUP; }
| ForStat NEXT IDENTIFIER { --_wForCounter; _iState =LOOKUP; }
| NEXT { --_wForCounter; _iState =LOOKUP; }
| NEXT IDENTIFIER { --_wForCounter; _iState =LOOKUP; }
;
ForStat : Statements { Line(); }
;
BeginSeq : BEGINSEQ { ++_wSeqCounter; } Crlf
BeginSeq : BEGINSEQ { ++_wSeqCounter; _iState =LOOKUP; } Crlf
SeqStatms
RecoverSeq
END { --_wSeqCounter; }
@@ -1056,10 +1062,16 @@ SeqStatms : /* empty */
;
RecoverSeq : /* no recover */
| RECOVER Crlf
| RECOVER Crlf Statements
| RECOVER USING IDENTIFIER Crlf
| RECOVER USING IDENTIFIER Crlf Statements
| RecoverEmpty Crlf
| RecoverEmpty Crlf Statements
| RecoverUsing Crlf
| RecoverUsing Crlf Statements
;
RecoverEmpty : RECOVER { _iState =LOOKUP; }
;
RecoverUsing : RECOVER USING IDENTIFIER { _iState =LOOKUP; }
;
DoProc : DO IDENTIFIER { PushSymbol( $2, 1 ); PushNil(); Do( 0 ); }
@@ -1260,11 +1272,6 @@ int harbour_main( int argc, char * argv[] )
_iSyntaxCheckOnly = 1;
break;
case 't':
case 'T':
_iAltSymbolTableInit = 1;
break;
case 'v':
case 'V':
break;
@@ -1810,7 +1817,7 @@ int Include( char * szFileName, PATHNAMES *pSearch )
{
pFileName->path =pSearch->szPath;
MakeFilename( szFName, pFileName );
yyin = fopen( szFName, "r" );
yyin = fopen( szFName, "r" );
if( ! yyin )
{
pSearch = pSearch->pNext;
@@ -2037,7 +2044,8 @@ void GenCCode( char *szFileName, char *szName ) /* generates the C languag
if( ! _iQuiet )
printf( "\nGenerating C language output...\n" );
fprintf( yyc, "#include \"pcode.h\"\n\n" );
fprintf( yyc, "#include \"pcode.h\"\n" );
fprintf( yyc, "#include <init.h>\n\n" );
if( ! _iStartProc )
pFunc = pFunc->pNext; /* No implicit starting procedure */
@@ -2095,7 +2103,7 @@ void GenCCode( char *szFileName, char *szName ) /* generates the C languag
fprintf( yyc, ", HB_%s, 0 }", pFTemp->szName );
else
{
pFTemp = GetFuncall( pSym->szName );
pFTemp = GetFuncall( pSym->szName );
if( pFTemp )
fprintf( yyc, ", HB_%s, 0 }", pFTemp->szName );
else
@@ -2109,15 +2117,9 @@ void GenCCode( char *szFileName, char *szName ) /* generates the C languag
}
fprintf( yyc, " };\n\n" );
if( _iAltSymbolTableInit )
{
fprintf( yyc, "void ProcessSymbols( SYMBOL *, WORD );\n" );
fprintf( yyc, "/* Add a local symbol table to the global one\n*/\n" );
fprintf( yyc, "void %s__InitSymbols( void )\n{\n"
" ProcessSymbols( symbols, %i );\n}\n\n", symbols.pFirst->szName, wSym );
}
else
fprintf( yyc, "#include <init.h>\n\n" );
/* Generate function that will initialize local symbol table
*/
fprintf( yyc, "HB_INIT_SYMBOLS( %s__InitSymbols );\n\n", symbols.pFirst->szName );
/* Generate functions data
*/
@@ -3142,9 +3144,9 @@ WORD JumpFalse( int iOffset )
/* compile time Operand value */
if( pStackValType && pStackValType->cType == ' ' )
GenWarning( WARN_LOGICAL_SUSPECT, NULL, NULL );
GenWarning( WARN_LOGICAL_SUSPECT, NULL, NULL );
else if( pStackValType && pStackValType->cType != 'L')
GenWarning( WARN_LOGICAL_TYPE, sType, NULL );
GenWarning( WARN_LOGICAL_TYPE, sType, NULL );
/* compile time assignment value has to be released */
pFree = pStackValType;
@@ -3196,9 +3198,9 @@ WORD JumpTrue( int iOffset )
/* compile time Operand value */
if( pStackValType && pStackValType->cType == ' ' )
GenWarning( WARN_LOGICAL_SUSPECT, NULL, NULL );
GenWarning( WARN_LOGICAL_SUSPECT, NULL, NULL );
else if( pStackValType && pStackValType->cType != 'L')
GenWarning( WARN_LOGICAL_TYPE, sType, NULL );
GenWarning( WARN_LOGICAL_TYPE, sType, NULL );
/* compile time assignment value has to be released */
pFree = pStackValType;
@@ -3362,16 +3364,16 @@ void PopId( char * szVarName ) /* generates the pcode to pop a value from the vi
sType[0] = pVarType->cType;
sType[1] = 0;
/* skip back to the assigned value */
pStackValType = pStackValType->pPrev;
/* skip back to the assigned value */
pStackValType = pStackValType->pPrev;
}
else
debug_msg( "\n***PopId() Compile time stack overflow\n", NULL );
if( pVarType && pStackValType && pVarType->cType != ' ' && pStackValType->cType == ' ' )
GenWarning( WARN_ASSIGN_SUSPECT, szVarName, sType );
GenWarning( WARN_ASSIGN_SUSPECT, szVarName, sType );
else if( pVarType && pStackValType && pVarType->cType != ' ' && pVarType->cType != pStackValType->cType )
GenWarning( WARN_ASSIGN_TYPE, szVarName, sType );
GenWarning( WARN_ASSIGN_TYPE, szVarName, sType );
/* compile time variable has to be released */
if( pVarType )
@@ -3716,7 +3718,7 @@ void Do( BYTE bParams )
else
debug_msg( "\n***Do() Compile time stack overflow\n", NULL );
if( pFree )
if( pFree )
{
OurFree( (void *) pFree );
}
@@ -3853,7 +3855,7 @@ void Function( BYTE bParams )
else
debug_msg( "\n***Function() parameter %i Compile time stack overflow\n", i );
if( pFree )
if( pFree )
{
OurFree( (void *) pFree );
}
@@ -3943,13 +3945,13 @@ void GenPCode1( BYTE byte )
{
PSTACK_VAL_TYPE pFree;
/* Releasing compile time assignment value */
/* Releasing compile time assignment value */
pFree = pStackValType;
debug_msg( "\n***---ArrayPut()\n", NULL );
if( pStackValType )
pStackValType = pStackValType->pPrev;
else
else
debug_msg( "\n***HB_P_ARRAYPUT Compile time stack overflow\n", NULL );
if( pFree )
@@ -3957,7 +3959,7 @@ void GenPCode1( BYTE byte )
OurFree( (void *) pFree );
}
/* Releasing compile time array element index value */
/* Releasing compile time array element index value */
pFree = pStackValType;
debug_msg( "\n***---HB_P_ARRAYPUT\n", NULL );
@@ -4322,8 +4324,8 @@ void CodeBlockEnd()
if( _iWarnings )
{
if( pStackValType )
/* reusing the place holder of the result value */
pStackValType->cType = 'B';
/* reusing the place holder of the result value */
pStackValType->cType = 'B';
else
debug_msg( "\n***CodeBlockEnd() Compile time stack overflow\n", NULL );
}

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

@@ -6,6 +6,7 @@
#include <extend.h>
#include <errorapi.h>
#include <ctoharb.h>
#include <init.h>
HARBOUR HB_AADD(void);
HARBOUR HB_ACLONE(void);
@@ -21,7 +22,6 @@ HARBOUR HB_ASORT(void);
HARBOUR HB_ATAIL(void);
static SYMBOL symbols[] = {
{ "AADD", FS_PUBLIC, HB_AADD , 0 },
{ "ACLONE", FS_PUBLIC, HB_ACLONE , 0 },
{ "ACOPY", FS_PUBLIC, HB_ACOPY , 0 },
{ "ADEL", FS_PUBLIC, HB_ADEL , 0 },
@@ -46,10 +46,13 @@ static char *szBoundError = "Bound error: Array access";
static char *szArgumentError = "Argument error: incorrect type";
HB_INIT_SYMBOLS( Arrays__InitSymbols );
/*
void Arrays__InitSymbols( void )
{
ProcessSymbols( symbols, sizeof(symbols)/sizeof( SYMBOL ) );
}
*/
/*
* Internal
@@ -62,7 +65,7 @@ void hb_arrayNew( PHB_ITEM pItem, ULONG ulLen ) /* creates a new array */
ItemRelease( pItem );
pItem->wType = IT_ARRAY;
pItem->type = IT_ARRAY;
if( ulLen )
pBaseArray->pItems = ( PHB_ITEM ) hb_xgrab( sizeof( HB_ITEM ) * ulLen );
@@ -75,16 +78,16 @@ void hb_arrayNew( PHB_ITEM pItem, ULONG ulLen ) /* creates a new array */
pBaseArray->wSuperCast = FALSE;
for( ul = 0; ul < ulLen; ul++ )
( pBaseArray->pItems + ul )->wType = IT_NIL;
( pBaseArray->pItems + ul )->type = IT_NIL;
pItem->value.pBaseArray = pBaseArray;
pItem->item.asArray.value = pBaseArray;
}
void hb_arrayAdd( PHB_ITEM pArray, PHB_ITEM pValue )
{
PBASEARRAY pBaseArray = ( PBASEARRAY ) pArray->value.pBaseArray;
PBASEARRAY pBaseArray = ( PBASEARRAY ) pArray->item.asArray.value;
hb_arraySize( pArray, pBaseArray->ulLen + 1 );
pBaseArray = ( PBASEARRAY ) pArray->value.pBaseArray;
pBaseArray = ( PBASEARRAY ) pArray->item.asArray.value;
ItemCopy( pBaseArray->pItems + ( pBaseArray->ulLen - 1 ), pValue );
}
@@ -93,7 +96,7 @@ void hb_arrayGet( PHB_ITEM pArray, ULONG ulIndex, PHB_ITEM pItem )
if( IS_ARRAY( pArray ) )
{
if( ulIndex <= ( unsigned )hb_arrayLen( pArray ) )
ItemCopy( pItem, ( ( PBASEARRAY ) pArray->value.pBaseArray )->pItems + ( ulIndex - 1 ) );
ItemCopy( pItem, pArray->item.asArray.value->pItems + ( ulIndex - 1 ) );
else
{
hb_errorRT_BASE(EG_ARG, 1132, "Bound error", "array access");
@@ -111,10 +114,10 @@ char *hb_arrayGetString( PHB_ITEM pArray, ULONG ulIndex )
{
if( ulIndex <= ( unsigned )hb_arrayLen( pArray ) )
{
PHB_ITEM pItem = ( ( PBASEARRAY ) pArray->value.pBaseArray )->pItems + ulIndex - 1;
PHB_ITEM pItem = pArray->item.asArray.value->pItems + ulIndex - 1;
if( IS_STRING( pItem ) )
return pItem->value.szText;
return pItem->item.asString.value;
else
return "";
}
@@ -136,10 +139,10 @@ ULONG hb_arrayGetStringLen( PHB_ITEM pArray, ULONG ulIndex )
{
if( ulIndex <= ( unsigned )hb_arrayLen( pArray ) )
{
PHB_ITEM pItem = ( ( PBASEARRAY ) pArray->value.pBaseArray )->pItems + ulIndex - 1;
PHB_ITEM pItem = pArray->item.asArray.value->pItems + ulIndex - 1;
if( IS_STRING( pItem ) )
return pItem->wLength;
return pItem->item.asString.length;
else
return 0;
}
@@ -161,8 +164,8 @@ int hb_arrayGetType( PHB_ITEM pArray, ULONG ulIndex )
{
if( ulIndex <= ( unsigned ) hb_arrayLen( pArray ) )
{
PHB_ITEM pItem = ( ( PBASEARRAY ) pArray->value.pBaseArray )->pItems + ulIndex - 1;
return pItem->wType;
PHB_ITEM pItem = pArray->item.asArray.value->pItems + ulIndex - 1;
return pItem->type;
}
else
{
@@ -178,9 +181,9 @@ int hb_arrayGetType( PHB_ITEM pArray, ULONG ulIndex )
void hb_arrayLast( PHB_ITEM pArray, PHB_ITEM pResult )
{
if ( ( ( PBASEARRAY ) pArray->value.pBaseArray )->ulLen )
ItemCopy( pResult, ( ( PBASEARRAY ) pArray->value.pBaseArray )->pItems +
( ( ( PBASEARRAY ) pArray->value.pBaseArray )->ulLen - 1 ) );
if ( pArray->item.asArray.value->ulLen )
ItemCopy( pResult, pArray->item.asArray.value->pItems +
( pArray->item.asArray.value->ulLen - 1 ) );
else
ItemRelease( pResult );
}
@@ -188,7 +191,7 @@ void hb_arrayLast( PHB_ITEM pArray, PHB_ITEM pResult )
ULONG hb_arrayLen( PHB_ITEM pArray )
{
if( IS_ARRAY( pArray ) )
return ( ( PBASEARRAY ) pArray->value.pBaseArray )->ulLen;
return pArray->item.asArray.value->ulLen;
else
{
hb_errorRT_BASE(EG_ARG, 1068, "Argument error", "array access");
@@ -201,7 +204,7 @@ void hb_arraySet( PHB_ITEM pArray, ULONG ulIndex, PHB_ITEM pItem )
if( IS_ARRAY( pArray ) )
{
if( ulIndex <= ( unsigned )hb_arrayLen( pArray ) )
ItemCopy( ( ( PBASEARRAY ) pArray->value.pBaseArray )->pItems + ( ulIndex - 1 ), pItem );
ItemCopy( pArray->item.asArray.value->pItems + ( ulIndex - 1 ), pItem );
else
{
hb_errorRT_BASE(EG_ARG, 1133, "Bound error", "array assign");
@@ -217,14 +220,14 @@ void hb_arraySize( PHB_ITEM pArray, ULONG ulLen )
{
if ( IS_ARRAY( pArray ) )
{
PBASEARRAY pBaseArray = ( PBASEARRAY ) pArray->value.pBaseArray;
PBASEARRAY pBaseArray = pArray->item.asArray.value;
ULONG ul;
if( ! pBaseArray->ulLen )
{
pBaseArray->pItems = ( PHB_ITEM ) hb_xgrab( ulLen * sizeof( HB_ITEM ) );
for ( ul = 0; ul < ulLen; ul ++ )
( pBaseArray->pItems + ul )->wType = IT_NIL;
( pBaseArray->pItems + ul )->type = IT_NIL;
}
else
{
@@ -234,7 +237,7 @@ void hb_arraySize( PHB_ITEM pArray, ULONG ulLen )
/* set value for new items */
for( ul = pBaseArray->ulLen; ul < ulLen; ul++ )
( pBaseArray->pItems + ul )->wType = IT_NIL;
( pBaseArray->pItems + ul )->type = IT_NIL;
}
else if( pBaseArray->ulLen > ulLen )
{
@@ -265,7 +268,7 @@ void hb_arrayFill( PHB_ITEM pArray, PHB_ITEM pValue, ULONG ulStart, ULONG ulCoun
if ( ulStart + ulCount > ulLen ) /* check range */
ulCount = ulLen - ulStart + 1;
pBaseArray = ( PBASEARRAY )pArray->value.pBaseArray;
pBaseArray = pArray->item.asArray.value;
for ( ; ulCount > 0; ulCount --, ulStart ++ ) /* set value items */
ItemCopy( pBaseArray->pItems + ( ulStart - 1 ), pValue );
@@ -287,7 +290,7 @@ void hb_arrayDel( PHB_ITEM pArray, ULONG ulIndex )
if ( ulIndex > 0 && ulIndex <= ulLen )
{
PBASEARRAY pBaseArray = ( PBASEARRAY )pArray->value.pBaseArray;
PBASEARRAY pBaseArray = pArray->item.asArray.value;
ItemRelease( pBaseArray->pItems + ( ulIndex - 1 ) );
@@ -321,7 +324,7 @@ void hb_arrayIns( PHB_ITEM pArray, ULONG ulIndex )
if ( ulIndex > 0 && ulIndex <= ulLen )
{
PBASEARRAY pBaseArray = ( PBASEARRAY )pArray->value.pBaseArray;
PBASEARRAY pBaseArray = pArray->item.asArray.value;
ItemRelease( pBaseArray->pItems + ( ulLen - 1 ) );
@@ -349,7 +352,7 @@ void hb_arrayIns( PHB_ITEM pArray, ULONG ulIndex )
int hb_arrayScan( PHB_ITEM pArray, PHB_ITEM pValue, ULONG ulStart, ULONG ulCount )
{
if ( IS_ARRAY( pArray ) && pValue->wType != IT_NIL )
if ( IS_ARRAY( pArray ) && pValue->type != IT_NIL )
{
int iRet = 0;
PBASEARRAY pBaseArray;
@@ -364,49 +367,49 @@ int hb_arrayScan( PHB_ITEM pArray, PHB_ITEM pValue, ULONG ulStart, ULONG ulCount
if ( ulStart + ulCount > ulLen ) /* check range */
ulCount = ulLen - ulStart + 1;
pBaseArray = ( PBASEARRAY )pArray->value.pBaseArray;
pBaseArray = pArray->item.asArray.value;
for ( ulStart --; ulCount > 0; ulCount --, ulStart ++ )
{
PHB_ITEM pItem = pBaseArray->pItems + ulStart;
if ( pValue->wType == IT_BLOCK )
if ( pValue->type == IT_BLOCK )
{
PushSymbol( &symEval );
Push( pValue );
Push( pItem );
Do( 1 );
if ( stack.Return.value.iLogical )
if ( stack.Return.item.asLogical.value )
iRet = 1;
}
else
{
if ( pValue->wType == pItem->wType )
if ( pValue->type == pItem->type )
{
switch( pItem->wType )
switch( pItem->type )
{
case IT_INTEGER :
iRet = ( pValue->value.iNumber == pItem->value.iNumber );
iRet = ( pValue->item.asInteger.value == pItem->item.asInteger.value);
break;
case IT_LONG :
iRet = ( pValue->value.lNumber == pItem->value.lNumber );
iRet = ( pValue->item.asLong.value == pItem->item.asLong.value );
break;
case IT_DOUBLE :
iRet = ( pValue->value.dNumber == pItem->value.dNumber );
iRet = ( pValue->item.asDouble.value == pItem->item.asDouble.value );
break;
case IT_DATE :
iRet = ( pValue->value.lDate == pItem->value.lDate );
iRet = ( pValue->item.asDate.value == pItem->item.asDouble.value );
break;
case IT_LOGICAL :
iRet = ( pValue->value.iLogical == pItem->value.iLogical );
iRet = ( pValue->item.asLogical.value == pItem->item.asLogical.value );
break;
case IT_STRING :
iRet = ( hb_itemStrCmp( pValue, pItem, FALSE ) == 0 );
iRet = ( hb_itemStrCmp( pValue, pItem, FALSE ) == 0 );
break;
}
}
@@ -441,7 +444,7 @@ void hb_arrayEval( PHB_ITEM pArray, PHB_ITEM bBlock, ULONG ulStart, ULONG ulCoun
if ( ulStart + ulCount > ulLen ) /* check range */
ulCount = ulLen - ulStart + 1;
pBaseArray = ( PBASEARRAY )pArray->value.pBaseArray;
pBaseArray = pArray->item.asArray.value;
for ( ulStart --; ulCount > 0; ulCount --, ulStart ++ )
{
@@ -464,7 +467,7 @@ void hb_arrayRelease( PHB_ITEM pArray )
if ( IS_ARRAY( pArray ) )
{
ULONG ul, ulLen = hb_arrayLen( pArray );
PBASEARRAY pBaseArray = ( PBASEARRAY )pArray->value.pBaseArray;
PBASEARRAY pBaseArray = pArray->item.asArray.value;
if( !pBaseArray->wSuperCast )
{
@@ -476,8 +479,8 @@ void hb_arrayRelease( PHB_ITEM pArray )
}
hb_xfree( pBaseArray );
pArray->wType = IT_NIL;
pArray->value.pBaseArray = NULL;
pArray->type = IT_NIL;
pArray->item.asArray.value = NULL;
}
else
{
@@ -512,8 +515,8 @@ void hb_arrayCopy( PHB_ITEM pSrcArray, PHB_ITEM pDstArray, ULONG ulStart,
if ( ulCount > ulDstLen )
ulCount = ulDstLen;
pSrcBaseArray = ( PBASEARRAY )pSrcArray->value.pBaseArray;
pDstBaseArray = ( PBASEARRAY )pDstArray->value.pBaseArray;
pSrcBaseArray = pSrcArray->item.asArray.value;
pDstBaseArray = pDstArray->item.asArray.value;
for ( ulTarget --, ulStart --; ulCount > 0; ulCount --, ulStart ++ )
{
@@ -540,15 +543,15 @@ PHB_ITEM hb_arrayClone( PHB_ITEM pSrcArray )
hb_arrayNew( pDstArray, ulSrcLen );
pSrcBaseArray = ( PBASEARRAY )pSrcArray->value.pBaseArray;
pDstBaseArray = ( PBASEARRAY )pDstArray->value.pBaseArray;
pSrcBaseArray = pSrcArray->item.asArray.value;
pDstBaseArray = pDstArray->item.asArray.value;
pDstBaseArray->wClass = pSrcBaseArray->wClass;
for ( ulCount = 0; ulCount < ulSrcLen; ulCount ++ )
{
PHB_ITEM pSrcItem = pSrcBaseArray->pItems + ulCount;
if ( pSrcItem->wType == IT_ARRAY )
if ( pSrcItem->type == IT_ARRAY )
{
PHB_ITEM pClone = hb_arrayClone( pSrcItem );

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

@@ -6,6 +6,7 @@
#include <errorapi.h>
#include <itemapi.h>
#include <ctoharb.h>
#include <init.h>
#define MET_METHOD 0
#define MET_DATA 1
@@ -121,11 +122,14 @@ static SYMBOL symbols[] = {
{ "OSEND" , FS_PUBLIC, HB_OSEND , 0 }
};
HB_INIT_SYMBOLS( Classes__InitSymbols );
/*
void Classes__InitSymbols( void )
{
ProcessSymbols( symbols, sizeof(symbols)/sizeof( SYMBOL ) );
}
*/
/*
* ClassAdd( <hClass>, <cMessage>, <pFunction>, <nType>, [xInit] )
@@ -303,7 +307,7 @@ HARBOUR HB_CLASSCREATE(void)
HARBOUR HB_CLASSDEL(void)
{
PHB_ITEM pString = hb_param( 2, IT_STRING );
PSYMBOL pMessage = GetDynSym( pString->value.szText )->pSymbol;
PSYMBOL pMessage = GetDynSym( pString->item.asString.value )->pSymbol;
PDYNSYM pMsg = ( PDYNSYM ) pMessage->pDynSym;
PCLASS pClass;
@@ -364,7 +368,7 @@ HARBOUR HB_CLASSDEL(void)
*/
static HARBOUR ClassH( void )
{
hb_retni( ( ( PBASEARRAY ) ( stack.pBase + 1 )->value.pBaseArray )->wClass );
hb_retni( ( stack.pBase + 1 )->item.asArray.value->wClass );
}
@@ -384,7 +388,7 @@ HARBOUR HB_CLASSINSTANCE(void)
{
pClass = pClasses + ( wClass - 1 );
hb_arrayNew( &stack.Return, pClass->wDatas );
( ( PBASEARRAY ) stack.Return.value.pBaseArray )->wClass = wClass;
stack.Return.item.asArray.value->wClass = wClass;
pMeth = pClass->pMethods; /* Initialize DATA */
wLimit = pClass->wHashKey * BUCKET;
@@ -404,7 +408,7 @@ HARBOUR HB_CLASSINSTANCE(void)
HARBOUR HB_CLASSMOD(void)
{
PHB_ITEM pString = hb_param( 2, IT_STRING );
PSYMBOL pMessage = GetDynSym( pString->value.szText )->pSymbol;
PSYMBOL pMessage = GetDynSym( pString->item.asString.value )->pSymbol;
PDYNSYM pMsg = ( PDYNSYM ) pMessage->pDynSym;
PCLASS pClass;
@@ -461,7 +465,7 @@ static HARBOUR ClassName( void )
PHB_ITEM pItemRef;
if( IS_BYREF( stack.pBase + 1 ) ) /* Variables by reference */
pItemRef = stack.pItems + ( stack.pBase + 1 )->value.wItem;
pItemRef = stack.pItems + ( stack.pBase + 1 )->item.asRefer.value;
else
pItemRef = stack.pBase + 1;
@@ -479,9 +483,9 @@ HARBOUR HB_CLASSNAME(void)
PHB_ITEM pObject = hb_param( 0, IT_OBJECT );
WORD wClass;
if( pObject && ( ( PBASEARRAY ) pObject->value.pBaseArray )->wClass )
if( pObject && pObject->item.asArray.value->wClass )
{
wClass = ( ( PBASEARRAY ) pObject->value.pBaseArray )->wClass;
wClass = pObject->item.asArray.value->wClass;
hb_retc( pClasses[ wClass - 1 ].szName );
}
else
@@ -503,7 +507,7 @@ HARBOUR HB_CLASSNAME(void)
static HARBOUR ClassSel(void)
{
WORD wClass = IS_ARRAY( stack.pBase + 1 ) ?
( ( PBASEARRAY ) ( stack.pBase + 1 )->value.pBaseArray )->wClass : 0;
( stack.pBase + 1 )->item.asArray.value->wClass : 0;
/* Get class word */
WORD wLimit; /* Number of Hash keys */
WORD wAt;
@@ -517,9 +521,9 @@ static HARBOUR ClassSel(void)
/* Variables by reference */
if( ( ! wClass ) && IS_BYREF( stack.pBase + 1 ) )
{
pItemRef = stack.pItems + ( stack.pBase + 1 )->value.wItem;
pItemRef = stack.pItems + ( stack.pBase + 1 )->item.asRefer.value;
if( IS_ARRAY( pItemRef ) )
wClass = ( ( PBASEARRAY ) pItemRef->value.pBaseArray )->wClass;
wClass = pItemRef->item.asArray.value->wClass;
}
if( wClass && wClass <= wClasses )
@@ -570,7 +574,7 @@ static void DictRealloc( PCLASS pClass )
static HARBOUR EvalInline( void )
{
HB_ITEM block;
WORD wClass = ( (PBASEARRAY) ( stack.pBase + 1 )->value.pBaseArray )->wClass;
WORD wClass = ( stack.pBase + 1 )->item.asArray.value->wClass;
WORD w;
hb_arrayGet( pClasses[ wClass - 1 ].pInlines, pMethod->wData, &block );
@@ -598,14 +602,14 @@ char * hb_GetClassName( PHB_ITEM pObject )
if( IS_ARRAY( pObject ) )
{
if( ! ( ( PBASEARRAY ) pObject->value.pBaseArray )->wClass )
if( ! pObject->item.asArray.value->wClass )
szClassName = "ARRAY";
else
szClassName = ( pClasses + ( ( PBASEARRAY ) pObject->value.pBaseArray )->wClass - 1 )->szName;
szClassName = ( pClasses + pObject->item.asArray.value->wClass - 1 )->szName;
}
else /* built in types */
{
switch( pObject->wType )
switch( pObject->type )
{
case IT_NIL:
szClassName = "NIL";
@@ -652,7 +656,7 @@ char * hb_GetClassName( PHB_ITEM pObject )
*/
static HARBOUR GetClassData( void )
{
WORD wClass = ( (PBASEARRAY) ( stack.pBase + 1 )->value.pBaseArray )->wClass;
WORD wClass = ( stack.pBase + 1 )->item.asArray.value->wClass;
if( wClass && wClass <= wClasses )
hb_arrayGet( pClasses[ wClass - 1 ].pClassDatas, pMethod->wData,
@@ -685,7 +689,7 @@ static HARBOUR GetData( void )
HARBOURFUNC GetMethod( PHB_ITEM pObject, PSYMBOL pMessage )
{
WORD wAt, wLimit, wMask;
WORD wClass = ( ( PBASEARRAY ) pObject->value.pBaseArray )->wClass;
WORD wClass = pObject->item.asArray.value->wClass;
PCLASS pClass;
PDYNSYM pMsg = ( PDYNSYM ) pMessage->pDynSym;
@@ -760,7 +764,7 @@ HARBOUR HB_ISMESSAGE(void)
PHB_ITEM pString = hb_param( 2, IT_STRING );
if( pObject && pString )
hb_retl( hb_isMessage( pObject, pString->value.szText ) != 0 );
hb_retl( hb_isMessage( pObject, pString->item.asString.value ) != 0 );
else
{
PHB_ITEM pError = hb_errNew();
@@ -811,7 +815,7 @@ HARBOUR HB_OSEND(void)
if( pMessage && pObject ) /* Object & message passed */
{
Push( pObject ); /* Push object */
Message( GetDynSym( pMessage->value.szText )->pSymbol );
Message( 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 ) );
@@ -882,9 +886,9 @@ static HARBOUR SelectSuper( void )
WORD wSuperCls = pMethod->wData; /* Get handle of superclass */
memcpy( pSuper, pObject, sizeof( HB_ITEM ) ); /* Allocate new structures */
memcpy( pNewBase, pObject->value.pBaseArray, sizeof( BASEARRAY ) );
memcpy( pNewBase, pObject->item.asArray.value, sizeof( BASEARRAY ) );
pSuper->value.pBaseArray = pNewBase;
pSuper->item.asArray.value = pNewBase;
pNewBase->wClass = wSuperCls;
pNewBase->wHolders = 1; /* New item is returned */
@@ -902,7 +906,7 @@ static HARBOUR SelectSuper( void )
*/
static HARBOUR SetClassData( void )
{
WORD wClass = ( (PBASEARRAY) ( stack.pBase + 1 )->value.pBaseArray )->wClass;
WORD wClass = ( stack.pBase + 1 )->item.asArray.value->wClass;
PHB_ITEM pReturn = stack.pBase + 2;
if( wClass && wClass <= wClasses )
@@ -954,7 +958,7 @@ HARBOUR HB___INSTSUPER( void )
if( pString )
{
pDynSym = FindDynSym( pString->value.szText );
pDynSym = FindDynSym( pString->item.asString.value );
if( pDynSym ) /* Find function */
{
PushSymbol( pDynSym->pSymbol ); /* Push function name */
@@ -971,7 +975,7 @@ HARBOUR HB___INSTSUPER( void )
for( w = 0; !bFound && w < wClasses; w++ )
{ /* Locate the entry */
if( !hb_stricmp( pString->value.szText, pClasses[ w ].szName ) )
if( !hb_stricmp( pString->item.asString.value, pClasses[ w ].szName ) )
{
hb_retni( w + 1 ); /* Entry + 1 = ClassH */
bFound = TRUE;

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

@@ -23,13 +23,13 @@ extern STACK stack;
* +2 bytes -> table of referenced local variables
* +2 + 2 *(number of referenced variables) -> codeblock pcode
*/
PCODEBLOCK CodeblockNew( BYTE * pBuffer, WORD wSize, PSYMBOL pSymbols,
HB_CODEBLOCK_PTR CodeblockNew( BYTE * pBuffer, WORD wSize, PSYMBOL pSymbols,
int iStaticsBase, WORD wStackBase )
{
PCODEBLOCK pCBlock;
HB_CODEBLOCK_PTR pCBlock;
WORD wVars;
pCBlock =( PCODEBLOCK ) hb_xgrab( sizeof(CODEBLOCK) );
pCBlock =( HB_CODEBLOCK_PTR ) hb_xgrab( sizeof(HB_CODEBLOCK) );
/* Check the number of referenced local variables
*/
@@ -50,8 +50,8 @@ PCODEBLOCK CodeblockNew( BYTE * pBuffer, WORD wSize, PSYMBOL pSymbols,
while( wVars-- )
{
pCBlock->pItems[ w ].wType =IT_INTEGER; /* not really integer */
pCBlock->pItems[ w ].value.wItem = * ( (WORD*) pBuffer );
pCBlock->pItems[ w ].type =IT_BYREF; /* not really integer */
pCBlock->pItems[ w ].item.asRefer.value = * ( (WORD*) pBuffer );
++w;
pBuffer +=2;
}
@@ -88,7 +88,7 @@ PCODEBLOCK CodeblockNew( BYTE * pBuffer, WORD wSize, PSYMBOL pSymbols,
/* Delete a codeblock
*/
void CodeblockDelete( PCODEBLOCK pCBlock )
void CodeblockDelete( HB_CODEBLOCK_PTR pCBlock )
{
#ifdef CODEBLOCKDEBUG
printf( "delete a codeblock (%li) %lx\n", pCBlock->lCounter, pCBlock );
@@ -118,7 +118,7 @@ void CodeblockDelete( PCODEBLOCK pCBlock )
/* Function to unlink variables referenced in a codeblock from a function
* where this codeblock was created
*/
void CodeblockDetach( PCODEBLOCK pCBlock )
void CodeblockDetach( HB_CODEBLOCK_PTR pCBlock )
{
if( pCBlock->wLocals && !pCBlock->wDetached )
{
@@ -134,9 +134,9 @@ void CodeblockDetach( PCODEBLOCK pCBlock )
* where this codeblock was defined
*/
pItem =pCBlock->pItems + w;
pItem =stack.pBase +pItem->value.wItem + 1;
pItem =stack.pBase +pItem->item.asRefer.value + 1;
if( IS_BYREF( pItem ) )
pItem =stack.pItems +pItem->value.wItem;
pItem =stack.pItems +pItem->item.asRefer.value;
ItemCopy( pCBlock->pItems + w, pItem );
++w;
}
@@ -151,7 +151,7 @@ void CodeblockDetach( PCODEBLOCK pCBlock )
* wStackBase is stack base of function where the codeblock was defined
* We need it because stack.pBase points to a stack base of EVAL function
*/
void CodeblockEvaluate( PCODEBLOCK pCBlock )
void CodeblockEvaluate( HB_CODEBLOCK_PTR pCBlock )
{
int iStatics = stack.iStatics;
@@ -162,9 +162,9 @@ void CodeblockEvaluate( PCODEBLOCK pCBlock )
/* Get local variable referenced in a codeblock
*/
PHB_ITEM CodeblockGetVar( PHB_ITEM pItem, SHORT iItemPos )
PHB_ITEM CodeblockGetVar( PHB_ITEM pItem, LONG iItemPos )
{
PCODEBLOCK pCBlock = (PCODEBLOCK)pItem->value.pCodeblock;
HB_CODEBLOCK_PTR pCBlock = pItem->item.asBlock.value;
PHB_ITEM pLocalVar;
pLocalVar =&pCBlock->pItems[ -iItemPos -1 ];
@@ -174,7 +174,7 @@ PHB_ITEM CodeblockGetVar( PHB_ITEM pItem, SHORT iItemPos )
/* when variables are not detached then a codeblock stores the variable's
* position on the stack
*/
pLocalVar =stack.pItems +pCBlock->wRefBase +pLocalVar->value.wItem + 1;
pLocalVar =stack.pItems +pCBlock->wRefBase +pLocalVar->item.asRefer.value + 1;
}
return pLocalVar;
@@ -186,9 +186,9 @@ PHB_ITEM CodeblockGetVar( PHB_ITEM pItem, SHORT iItemPos )
*/
void CodeblockCopy( PHB_ITEM pDest, PHB_ITEM pSource )
{
pDest->value.pCodeblock =pSource->value.pCodeblock;
((PCODEBLOCK) pDest->value.pCodeblock)->lCounter++;
pDest->item.asBlock.value =pSource->item.asBlock.value;
pDest->item.asBlock.value->lCounter++;
#ifdef CODEBLOCKDEBUG
printf( "copy a codeblock (%li) %lx\n", ((PCODEBLOCK) pDest->value.pCodeblock)->lCounter, pDest->value.pCodeblock);
printf( "copy a codeblock (%li) %lx\n", pDest->item.asBlock.valuevalue->lCounter, pDest->item.asBlock.valuevalue);
#endif
}

55
harbour/source/rtl/console.c
View File

@@ -9,8 +9,10 @@
#include <hbsetup.h>
#include <extend.h>
#include <ctoharb.h>
#include <init.h>
#include <dates.h>
#include <set.h>
#if defined(__GNUC__)
#include <unistd.h>
#if defined(__DJGPP__)
@@ -19,7 +21,7 @@
#else
#include <io.h>
#endif
#include <gtapi.h> /* USE_GTAPI is checked inside gtapi.h, so that
#include <gtapi.h> /* HARBOUR_USE_GTAPI is checked inside gtapi.h, so that
we can always get the border styles */
#define ACCEPT_BUFFER_LEN 256 /*length of input buffer for ACCEPT command */
@@ -58,9 +60,7 @@ HARBOUR HB_QQOUT( void );
static SYMBOL symbols[] = {
{ "__ACCEPT" , FS_PUBLIC, HB___ACCEPT , 0 },
{ "__EJECT" , FS_PUBLIC, HB___EJECT , 0 },
{ "COL" , FS_PUBLIC, HB_COL , 0 },
{ "DEVOUT" , FS_PUBLIC, HB_DEVOUT , 0 },
{ "DEVPOS" , FS_PUBLIC, HB_DEVPOS , 0 },
{ "DISPBEGIN", FS_PUBLIC, HB_DISPBEGIN, 0 },
{ "DISPBOX" , FS_PUBLIC, HB_DISPBOX , 0 },
{ "DISPCOUNT", FS_PUBLIC, HB_DISPCOUNT, 0 },
@@ -72,9 +72,6 @@ static SYMBOL symbols[] = {
{ "OUTERR" , FS_PUBLIC, HB_OUTERR , 0 },
{ "OUTSTD" , FS_PUBLIC, HB_OUTSTD , 0 },
{ "NOSNOW" , FS_PUBLIC, HB_NOSNOW , 0 },
{ "PCOL" , FS_PUBLIC, HB_PCOL , 0 },
{ "PROW" , FS_PUBLIC, HB_PROW , 0 },
{ "ROW" , FS_PUBLIC, HB_ROW , 0 },
{ "SCROLL" , FS_PUBLIC, HB_SCROLL , 0 },
{ "SETPOS" , FS_PUBLIC, HB_SETPOS , 0 },
{ "SETPRC" , FS_PUBLIC, HB_SETPRC , 0 },
@@ -82,10 +79,14 @@ static SYMBOL symbols[] = {
{ "QQOUT" , FS_PUBLIC, HB_QQOUT , 0 }
};
HB_INIT_SYMBOLS( Console__InitSymbols );
/*
void Console__InitSymbols( void )
{
ProcessSymbols( symbols, sizeof(symbols)/sizeof( SYMBOL ) );
}
*/
static unsigned short dev_row, dev_col, p_row, p_col;
static char CrLf [ CRLF_BUFFER_LEN ];
@@ -101,7 +102,7 @@ void InitializeConsole( void )
CrLf [1] = 0;
#endif
#ifdef USE_GTAPI
#ifdef HARBOUR_USE_GTAPI
dev_row = gtWhereY();
dev_col = gtWhereX();
hb_gtSetPos( dev_row, dev_col );
@@ -114,7 +115,7 @@ void InitializeConsole( void )
USHORT hb_max_row( void )
{
#ifdef USE_GTAPI
#ifdef HARBOUR_USE_GTAPI
return hb_gtMaxRow ();
#else
return 23; /* QUESTION: Shouldn't this be 24 ? info@szelvesz.hu */
@@ -123,14 +124,14 @@ USHORT hb_max_row( void )
USHORT hb_max_col( void )
{
#ifdef USE_GTAPI
#ifdef HARBOUR_USE_GTAPI
return hb_gtMaxCol ();
#else
return 79;
#endif
}
#ifndef USE_GTAPI
#ifndef HARBOUR_USE_GTAPI
static void adjust_pos( char * fpStr, WORD uiLen, USHORT * row, USHORT * col, USHORT max_row, USHORT max_col )
{
WORD uiCount;
@@ -251,7 +252,7 @@ static void hb_outstd( char * fpStr, WORD uiLen )
while( uiCount-- )
printf( "%c", *fpPtr++ );
fflush( stdout );
#ifdef USE_GTAPI
#ifdef HARBOUR_USE_GTAPI
if( isatty( fileno( stdout ) ) )
{
dev_row = gtWhereY();
@@ -271,7 +272,7 @@ static void hb_outerr( char * fpStr, WORD uiLen )
while( uiCount-- )
fprintf( stderr, "%c", *fpPtr++ );
fflush( stderr );
#ifdef USE_GTAPI
#ifdef HARBOUR_USE_GTAPI
if( isatty( fileno( stdout ) ) )
{
dev_row = gtWhereY();
@@ -288,7 +289,7 @@ static void hb_altout( char * fpStr, WORD uiLen )
{
if( hb_set.HB_SET_CONSOLE )
{
#ifdef USE_GTAPI
#ifdef HARBOUR_USE_GTAPI
hb_gtWriteCon( fpStr, uiLen );
hb_gtGetPos( &dev_row, &dev_col );
#else
@@ -322,7 +323,7 @@ static void hb_devout( char * fpStr, WORD uiLen )
}
else
{
#ifdef USE_GTAPI
#ifdef HARBOUR_USE_GTAPI
/* Otherwise, display to console */
hb_gtWrite( fpStr, uiLen );
hb_gtGetPos( &dev_row, &dev_col );
@@ -338,7 +339,7 @@ static void hb_devout( char * fpStr, WORD uiLen )
/* Output an item to the screen */
static void hb_dispout( char * fpStr, WORD uiLen )
{
#ifdef USE_GTAPI
#ifdef HARBOUR_USE_GTAPI
/* Display to console */
hb_gtWrite( fpStr, uiLen );
hb_gtGetPos( &dev_row, &dev_col );
@@ -352,7 +353,7 @@ static void hb_dispout( char * fpStr, WORD uiLen )
void hb_setpos( USHORT row, USHORT col )
{
#ifdef USE_GTAPI
#ifdef HARBOUR_USE_GTAPI
hb_gtSetPos( row, col );
#else
USHORT count;
@@ -473,7 +474,7 @@ HARBOUR HB_DEVOUT( void ) /* writes a single value to the current device (screen
{
if( hb_pcount() > 0 )
{
#ifdef USE_GTAPI
#ifdef HARBOUR_USE_GTAPI
char fpOldColor[ CLR_STRLEN ];
if( ISCHAR(2) )
@@ -485,7 +486,7 @@ HARBOUR HB_DEVOUT( void ) /* writes a single value to the current device (screen
hb_out( 1, hb_devout );
#ifdef USE_GTAPI
#ifdef HARBOUR_USE_GTAPI
if( ISCHAR(2) )
{
hb_gtSetColorStr( fpOldColor );
@@ -498,7 +499,7 @@ HARBOUR HB_DISPOUT( void ) /* writes a single value to the current device (scree
{
if( hb_pcount() > 0 )
{
#ifdef USE_GTAPI
#ifdef HARBOUR_USE_GTAPI
char fpOldColor[ CLR_STRLEN ];
if( ISCHAR(2) )
@@ -510,7 +511,7 @@ HARBOUR HB_DISPOUT( void ) /* writes a single value to the current device (scree
hb_out( 1, hb_dispout );
#ifdef USE_GTAPI
#ifdef HARBOUR_USE_GTAPI
if( ISCHAR(2) )
{
hb_gtSetColorStr( fpOldColor );
@@ -570,7 +571,7 @@ HARBOUR HB_SCROLL( void ) /* Scrolls a screen region (requires the GT API) */
if( hb_pcount() > 5 && hb_param( 6, IT_NUMERIC ) )
h_scroll = hb_parni( 6 );
#ifdef USE_GTAPI
#ifdef HARBOUR_USE_GTAPI
hb_gtScroll( top, left, bottom, right, v_scroll, h_scroll );
#else
if( top == 0 && bottom == hb_max_row()
@@ -607,7 +608,7 @@ HARBOUR HB_COL( void ) /* Return the current screen column position (zero origin
HARBOUR HB_DISPBOX (void)
{
#ifdef USE_GTAPI
#ifdef HARBOUR_USE_GTAPI
if (ISNUM(1) && ISNUM(2) && ISNUM(3) && ISNUM(4))
{
char szOldColor [CLR_STRLEN];
@@ -739,21 +740,21 @@ HARBOUR HB_DISPBOX (void)
HARBOUR HB_DISPBEGIN (void)
{
#ifdef USE_GTAPI
#ifdef HARBOUR_USE_GTAPI
hb_gtDispBegin();
#endif
}
HARBOUR HB_DISPEND (void)
{
#ifdef USE_GTAPI
#ifdef HARBOUR_USE_GTAPI
hb_gtDispBegin();
#endif
}
HARBOUR HB_DISPCOUNT (void)
{
#ifdef USE_GTAPI
#ifdef HARBOUR_USE_GTAPI
hb_retni(hb_gtDispCount());
#else
hb_retni(0);
@@ -762,7 +763,7 @@ HARBOUR HB_DISPCOUNT (void)
HARBOUR HB_ISCOLOR (void)
{
#ifdef USE_GTAPI
#ifdef HARBOUR_USE_GTAPI
hb_retl(hb_gtIsColor());
#else
hb_retl(FALSE);
@@ -771,7 +772,7 @@ HARBOUR HB_ISCOLOR (void)
HARBOUR HB_NOSNOW (void)
{
#ifdef USE_GTAPI
#ifdef HARBOUR_USE_GTAPI
if (ISLOG(1))
{
hb_gtSetSnowFlag(hb_parl(1));

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

@@ -22,10 +22,11 @@ static BOOL hb_fsCopy(char* szSource, char* szDest, ULONG* ulWrittenTotal);
/* and canRetry/canDefault flags */
HARBOUR HB___COPYFILE( void )
{
if ( ISCHAR(1) && ISCHAR(2) )
{
#ifdef HB_STRICT_CLIPPER_COMPATIBILITY
#ifdef HARBOUR_STRICT_CLIPPER_COMPATIBILITY
if (!hb_fsCopy(hb_parc(1), hb_parc(2)))
{
hb_retl(FALSE);
@@ -43,6 +44,7 @@ HARBOUR HB___COPYFILE( void )
}
static BOOL hb_fsCopy(char* szSource, char* szDest, ULONG* ulWrittenTotal)
{
BOOL bRetVal = FALSE;
FHANDLE fhndSource;

114
harbour/source/rtl/dates.c
View File

@@ -4,7 +4,9 @@
#include <hbsetup.h>
#include <extend.h>
#include <init.h>
#include <errorapi.h>
#include <itemapi.h>
#include <set.h>
#include <dates.h>
#include <ctype.h>
@@ -13,7 +15,7 @@
#include <dos.h>
#endif
#ifndef HB_STRICT_CLIPPER_COMPATIBILITY
#ifndef HARBOUR_STRICT_CLIPPER_COMPATIBILITY
#define HB_OPTIMIZE_DTOS
#endif
@@ -38,25 +40,17 @@ HARBOUR HB_TIME( void );
HARBOUR HB_YEAR( void );
static SYMBOL symbols[] = {
{ "HB_CDOW", FS_PUBLIC, HB_CDOW, 0 },
{ "HB_CMONTH", FS_PUBLIC, HB_CMONTH, 0 },
{ "HB_CTOD", FS_PUBLIC, HB_CTOD, 0 },
{ "HB_DATE", FS_PUBLIC, HB_DATE, 0 },
{ "HB_DAY", FS_PUBLIC, HB_DAY, 0 },
{ "HB_DOW", FS_PUBLIC, HB_DOW, 0 },
{ "HB_DTOC", FS_PUBLIC, HB_DTOC, 0 },
{ "HB_DTOS", FS_PUBLIC, HB_DTOS, 0 },
{ "HB_MONTH", FS_PUBLIC, HB_MONTH, 0 },
{ "HB_SECONDS", FS_PUBLIC, HB_SECONDS, 0 },
{ "HB_STOD", FS_PUBLIC, HB_STOD, 0 },
{ "HB_TIME", FS_PUBLIC, HB_TIME, 0 },
{ "HB_YEAR", FS_PUBLIC, HB_YEAR, 0 }
};
{ "STOD", FS_PUBLIC, HB_STOD, 0 }
}; /* rest of the functions is pulled automatically in initsymb.c */
HB_INIT_SYMBOLS( Dates__InitSymbols );
/*
void Dates__InitSymbols( void )
{
ProcessSymbols( symbols, sizeof(symbols)/sizeof( SYMBOL ) );
}
*/
double hb__seconds( void )
{
@@ -418,9 +412,20 @@ HARBOUR HB_DAY( void )
if( pDate )
{
hb_dateDecode( pDate->value.lDate, &lDay, &lMonth, &lYear );
PHB_ITEM pReturn = hb_itemNew( NULL );
hb_dateDecode( pDate->item.asDate.value, &lDay, &lMonth, &lYear );
pReturn->type = IT_LONG;
pReturn->item.asLong.value =lDay;
pReturn->item.asLong.length =3;
hb_itemReturn( pReturn );
hb_itemRelease( pReturn );
/*
hb_retni( lDay );
stack.Return.wLength = 3;
* It is dengerous to manipulate the stack return value directly!
stack.Return.item.asInteger.length = 3;
*/
}
else
{
@@ -435,9 +440,20 @@ HARBOUR HB_MONTH( void )
if( pDate )
{
hb_dateDecode( pDate->value.lDate, &lDay, &lMonth, &lYear );
PHB_ITEM pReturn = hb_itemNew( NULL );
hb_dateDecode( pDate->item.asDate.value, &lDay, &lMonth, &lYear );
pReturn->type = IT_LONG;
pReturn->item.asLong.value =lMonth;
pReturn->item.asLong.length =3;
hb_itemReturn( pReturn );
hb_itemRelease( pReturn );
/*
hb_retni( lMonth );
stack.Return.wLength = 3;
* It is dengerous to manipulate the stack return value directly!
stack.Return.item.asInteger.length = 3;
*/
}
else
{
@@ -452,9 +468,20 @@ HARBOUR HB_YEAR( void )
if( pDate )
{
hb_dateDecode( pDate->value.lDate, &lDay, &lMonth, &lYear );
PHB_ITEM pReturn = hb_itemNew( NULL );
hb_dateDecode( pDate->item.asDate.value, &lDay, &lMonth, &lYear );
pReturn->type = IT_LONG;
pReturn->item.asLong.value =lYear;
pReturn->item.asLong.length =5;
hb_itemReturn( pReturn );
hb_itemRelease( pReturn );
/*
hb_retni( lYear );
stack.Return.wLength = 5;
* It is dengerous to manipulate the stack return value directly!
stack.Return.item.asInteger.length = 5;
*/
}
else
{
@@ -477,7 +504,6 @@ HARBOUR HB_TIME( void )
}
else
{
/* QUESTION: Clipper catches this at compile time! */
hb_errorRT_BASE(EG_ARG, 9999, "Incorrect number of arguments", "TIME");
}
}
@@ -522,14 +548,28 @@ HARBOUR HB_DOW( void )
if( pDate )
{
if( pDate->value.lDate )
PHB_ITEM pReturn = hb_itemNew( NULL );
pReturn->type = IT_LONG;
if( pDate->item.asDate.value )
{
hb_dateDecode( pDate->value.lDate, &lDay, &lMonth, &lYear );
hb_retni( hb_dow( lDay, lMonth, lYear ) );
hb_dateDecode( pDate->item.asDate.value, &lDay, &lMonth, &lYear );
pReturn->item.asLong.value =hb_dow( lDay, lMonth, lYear );
/* hb_retni( hb_dow( lDay, lMonth, lYear ) );
*/
}
else
hb_retni( 0 );
stack.Return.wLength = 3;
pReturn->item.asLong.value =0;
/* hb_retni( 0 );
*/
pReturn->item.asLong.length =3;
hb_itemReturn( pReturn );
hb_itemRelease( pReturn );
/*
stack.Return.item.asInteger.length = 3;
*/
}
else
{
@@ -544,15 +584,15 @@ HARBOUR HB_CMONTH( void )
if( hb_pcount() )
{
if( pDate )
{
hb_dateDecode( pDate->value.lDate, &lDay, &lMonth, &lYear );
hb_retc( hb_cmonth( lMonth ) );
}
else
{
hb_errorRT_BASE(EG_ARG, 1116, "Argument error", "CMONTH");
}
if( pDate )
{
hb_dateDecode( pDate->item.asDate.value, &lDay, &lMonth, &lYear );
hb_retc( hb_cmonth( lMonth ) );
}
else
{
hb_errorRT_BASE(EG_ARG, 1116, "Argument error", "CMONTH");
}
}
else
{
@@ -570,7 +610,7 @@ HARBOUR HB_CDOW( void )
{
if( pDate )
{
hb_dateDecode( pDate->value.lDate, &lDay, &lMonth, &lYear );
hb_dateDecode( pDate->item.asDate.value, &lDay, &lMonth, &lYear );
hb_retc( hb_cdow( hb_dow( lDay, lMonth, lYear ) ) );
}
else

25
harbour/source/rtl/descend.c
View File

@@ -3,7 +3,9 @@
*/
#include <extend.h>
#include <itemapi.h>
#include <ctype.h>
#include <init.h>
extern STACK stack;
@@ -13,11 +15,13 @@ static SYMBOL symbols[] = {
{ "DESCEND", FS_PUBLIC, HB_DESCEND, 0 }
};
HB_INIT_SYMBOLS( Descend__InitSymbols );
/*
void Descend__InitSymbols( void )
{
ProcessSymbols( symbols, sizeof(symbols)/sizeof( SYMBOL ) );
}
*/
char *hb_strdescend( char *string )
{
char *s;
@@ -39,20 +43,27 @@ HARBOUR HB_DESCEND( void )
if( pItem )
{
if( IS_STRING( pItem ) )
hb_retc( hb_strdescend( pItem->value.szText ) );
hb_retc( hb_strdescend( pItem->item.asString.value ) );
else if( IS_DATE( pItem ) )
hb_retnl( 5231808 - pItem->value.lDate );
hb_retnl( 5231808 - pItem->item.asDate.value );
else if( IS_INTEGER( pItem ) )
hb_retni( -1 * pItem->value.iNumber );
hb_retni( -1 * pItem->item.asInteger.value );
else if( IS_LONG( pItem ) )
hb_retnl( -1 * pItem->value.lNumber );
hb_retnl( -1 * pItem->item.asLong.value );
else if( IS_DOUBLE( pItem ) )
{
hb_retnd( -1 * pItem->value.dNumber );
PHB_ITEM pReturn;
pReturn = hb_itemPutND( NULL, -1 * pItem->item.asDouble.value );
hb_itemReturn( pReturn );
hb_itemRelease( pReturn );
/* It is dengerous to operate on the stack directly
stack.Return.wDec = pItem->wDec;
*/
}
else if( IS_LOGICAL( pItem ) )
hb_retl( !pItem->value.iLogical );
hb_retl( !pItem->item.asLogical.value );
else
hb_retc( "NIL" );
}

4
harbour/source/rtl/dir.c
View File

@@ -7,6 +7,7 @@
#include <string.h>
#include <ctype.h>
#include <itemapi.h>
#include <init.h>
#if defined(__GNUC__)
#include <sys/types.h>
@@ -90,10 +91,13 @@ static SYMBOL symbols[] = {
{ "DIRECTORY", FS_PUBLIC, HB_DIRECTORY, 0 }
};
HB_INIT_SYMBOLS( Dir__InitSymbols );
/*
void Dir__InitSymbols( void )
{
ProcessSymbols( symbols, sizeof(symbols)/sizeof( SYMBOL ) );
}
*/
static BOOL hb_strMatchDOS (char *pszString, char *pszMask);

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

@@ -2,6 +2,9 @@
* $Id$
*/
#include <extend.h>
#include <init.h>
#ifdef __IBMCPP__
#define INCL_DOSMISC
#endif
@@ -45,10 +48,13 @@ static SYMBOL symbols[] = {
{ "VERSION", FS_PUBLIC, HB_VERSION, 0 }
};
HB_INIT_SYMBOLS( Environ__InitSymbols );
/*
void Environ__InitSymbols( void )
{
ProcessSymbols( symbols, sizeof(symbols)/sizeof( SYMBOL ) );
}
*/
HARBOUR HB_OS(void)
{
@@ -81,10 +87,10 @@ HARBOUR HB_OS(void)
system plays the major/minor version number game. Not all operating
systems work like that. So, we do a little bit of mucking around
because we've managed to work out version[] on our own. */
hb_os = "";
hb_osmajor = -2;
#else
/* TODO: add MSVC support but MSVC cannot detect any OS except Windows! */

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

@@ -31,7 +31,7 @@ WORD hb_errLaunch( PHB_ITEM pError )
Push( pError );
Do( 1 );
return stack.Return.value.iNumber; /* TODO: hb_parnl( -1 ) */
return stack.Return.item.asInteger.value; /* TODO: hb_parnl( -1 ) */
}
void hb_errRelease( PHB_ITEM pError )
@@ -44,7 +44,7 @@ char * hb_errGetDescription( PHB_ITEM pError )
PushSymbol( GetDynSym( "DESCRIPTION" )->pSymbol );
Push( pError );
Do( 0 );
return stack.Return.value.szText;
return stack.Return.item.asString.value;
}
PHB_ITEM hb_errPutDescription( PHB_ITEM pError, char * szDescription )
@@ -62,7 +62,7 @@ char * hb_errGetFileName( PHB_ITEM pError )
PushSymbol( GetDynSym( "FILENAME" )->pSymbol );
Push( pError );
Do( 0 );
return stack.Return.value.szText;
return stack.Return.item.asString.value;
}
PHB_ITEM hb_errPutFileName( PHB_ITEM pError, char * szFileName )
@@ -79,7 +79,7 @@ USHORT hb_errGetGenCode( PHB_ITEM pError )
PushSymbol( GetDynSym( "GENCODE" )->pSymbol );
Push( pError );
Do( 0 );
return stack.Return.value.iNumber;
return stack.Return.item.asInteger.value;
}
PHB_ITEM hb_errPutGenCode( PHB_ITEM pError, USHORT uiGenCode )
@@ -96,7 +96,7 @@ char * hb_errGetOperation( PHB_ITEM pError )
PushSymbol( GetDynSym( "OPERATION" )->pSymbol );
Push( pError );
Do( 0 );
return stack.Return.value.szText;
return stack.Return.item.asString.value;
}
PHB_ITEM hb_errPutOperation( PHB_ITEM pError, char * szOperation )
@@ -113,7 +113,7 @@ USHORT hb_errGetOsCode( PHB_ITEM pError )
PushSymbol( GetDynSym( "OSCODE" )->pSymbol );
Push( pError );
Do( 0 );
return stack.Return.value.iNumber;
return stack.Return.item.asInteger.value;
}
PHB_ITEM hb_errPutOsCode( PHB_ITEM pError, USHORT uiOsCode )
@@ -130,7 +130,7 @@ USHORT hb_errGetSeverity( PHB_ITEM pError )
PushSymbol( GetDynSym( "SEVERITY" )->pSymbol );
Push( pError );
Do( 0 );
return stack.Return.value.iNumber;
return stack.Return.item.asInteger.value;
}
PHB_ITEM hb_errPutSeverity( PHB_ITEM pError, USHORT uiSeverity )
@@ -147,7 +147,7 @@ USHORT hb_errGetSubCode( PHB_ITEM pError )
PushSymbol( GetDynSym( "SUBCODE" )->pSymbol );
Push( pError );
Do( 0 );
return stack.Return.value.iNumber;
return stack.Return.item.asInteger.value;
}
PHB_ITEM hb_errPutSubCode( PHB_ITEM pError, USHORT uiSubCode )
@@ -164,7 +164,7 @@ char * hb_errGetSubSystem( PHB_ITEM pError )
PushSymbol( GetDynSym( "SUBSYSTEM" )->pSymbol );
Push( pError );
Do( 0 );
return stack.Return.value.szText;
return stack.Return.item.asString.value;
}
PHB_ITEM hb_errPutSubSystem( PHB_ITEM pError, char * szSubSystem )
@@ -181,7 +181,7 @@ USHORT hb_errGetTries( PHB_ITEM pError )
PushSymbol( GetDynSym( "TRIES" )->pSymbol );
Push( pError );
Do( 0 );
return stack.Return.value.iNumber;
return stack.Return.item.asInteger.value;
}
PHB_ITEM hb_errPutTries( PHB_ITEM pError, USHORT uiTries )
@@ -203,7 +203,7 @@ USHORT hb_errGetFlags( PHB_ITEM pError )
Push( pError );
Do( 0 );
if (stack.Return.value.iLogical) uiFlags |= EF_CANRETRY;
if (stack.Return.item.asLogical.value) uiFlags |= EF_CANRETRY;
/* ; */
@@ -211,7 +211,7 @@ USHORT hb_errGetFlags( PHB_ITEM pError )
Push( pError );
Do( 0 );
if (stack.Return.value.iLogical) uiFlags |= EF_CANSUBSTITUTE;
if (stack.Return.item.asLogical.value) uiFlags |= EF_CANSUBSTITUTE;
/* ; */
@@ -219,7 +219,7 @@ USHORT hb_errGetFlags( PHB_ITEM pError )
Push( pError );
Do( 0 );
if (stack.Return.value.iLogical) uiFlags |= EF_CANDEFAULT;
if (stack.Return.item.asLogical.value) uiFlags |= EF_CANDEFAULT;
/* ; */

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

@@ -22,13 +22,13 @@ PHB_ITEM hb_param( WORD wParam, WORD wMask )
if( wParam <= hb_pcount() )
{
wType = ( stack.pBase + 1 + wParam )->wType;
wType = ( stack.pBase + 1 + wParam )->type;
if( ( wType & wMask ) || ( wType == IT_NIL && wMask == IT_ANY ) )
{
pLocal = stack.pBase + 1 + wParam;
if( wType & IT_BYREF )
return stack.pItems + pLocal->value.wItem;
return stack.pItems + pLocal->item.asRefer.value;
else
return pLocal;
}
@@ -51,8 +51,8 @@ char * hb_parc( WORD wParam, ... )
if( wParam <= hb_pcount() )
{
pItem = stack.pBase + 1 + wParam;
if( pItem->wType & IT_BYREF )
pItem = stack.pItems + pItem->value.wItem;
if( pItem->type & IT_BYREF )
pItem = stack.pItems + pItem->item.asRefer.value;
if( IS_ARRAY( pItem ) )
{
@@ -62,7 +62,7 @@ char * hb_parc( WORD wParam, ... )
return "";
}
else if( IS_STRING( pItem ) )
return pItem->value.szText;
return pItem->item.asString.value;
else
return "";
@@ -83,8 +83,8 @@ ULONG hb_parclen( WORD wParam, ... )
if( wParam <= hb_pcount() )
{
pItem = stack.pBase + 1 + wParam;
if( pItem->wType & IT_BYREF )
pItem = stack.pItems + pItem->value.wItem;
if( pItem->type & IT_BYREF )
pItem = stack.pItems + pItem->item.asRefer.value;
if( IS_ARRAY( pItem ) )
{
@@ -94,7 +94,7 @@ ULONG hb_parclen( WORD wParam, ... )
return 0;
}
else if( IS_STRING( pItem ) )
return pItem->wLength;
return pItem->item.asString.length;
else
return 0;
@@ -116,16 +116,16 @@ char * hb_pards( WORD wParam, ... )
if( wParam <= hb_pcount() )
{
pItem = stack.pBase + 1 + wParam;
if( pItem->wType & IT_BYREF )
pItem = stack.pItems + pItem->value.wItem;
if( pItem->type & IT_BYREF )
pItem = stack.pItems + pItem->item.asRefer.value;
if( IS_ARRAY( pItem ) && wArrayIndex )
/* TODO: implement wArrayIndex use when retrieving an array element */
return " ";
else if( IS_DATE( pItem ) && pItem->value.lDate > 0 )
else if( IS_DATE( pItem ) && pItem->item.asDate.value > 0 )
{
hb_dateDecode( pItem->value.lDate, &lDay, &lMonth, &lYear );
hb_dateDecode( pItem->item.asDate.value, &lDay, &lMonth, &lYear );
stack.szDate[ 0 ] = ( lYear / 1000 ) + '0';
stack.szDate[ 1 ] = ( ( lYear % 1000 ) / 100 ) + '0';
@@ -160,15 +160,15 @@ int hb_parl( WORD wParam, ... )
if( wParam <= hb_pcount() )
{
pItem = stack.pBase + 1 + wParam;
if( pItem->wType & IT_BYREF )
pItem = stack.pItems + pItem->value.wItem;
if( pItem->type & IT_BYREF )
pItem = stack.pItems + pItem->item.asRefer.value;
if( IS_ARRAY( pItem ) && wArrayIndex )
/* TODO: implement wArrayIndex use when retrieving an array element */
return 0;
else if( IS_LOGICAL( pItem ) )
return pItem->value.iLogical;
return pItem->item.asLogical.value;
else
return 0;
@@ -189,21 +189,21 @@ double hb_parnd( WORD wParam, ... )
if( wParam <= hb_pcount() )
{
pItem = stack.pBase + 1 + wParam;
if( pItem->wType & IT_BYREF )
pItem = stack.pItems + pItem->value.wItem;
if( pItem->type & IT_BYREF )
pItem = stack.pItems + pItem->item.asRefer.value;
if( IS_ARRAY( pItem ) && wArrayIndex )
/* TODO: implement wArrayIndex use when retrieving an array element */
return 0;
else if( IS_INTEGER( pItem ) )
return pItem->value.iNumber;
return pItem->item.asInteger.value;
else if( IS_LONG( pItem ) )
return pItem->value.lNumber;
return pItem->item.asLong.value;
else if( IS_DOUBLE( pItem ) )
return pItem->value.dNumber;
return pItem->item.asDouble.value;
else
return 0;
@@ -224,21 +224,21 @@ int hb_parni( WORD wParam, ... )
if( wParam <= hb_pcount() )
{
pItem = stack.pBase + 1 + wParam;
if( pItem->wType & IT_BYREF )
pItem = stack.pItems + pItem->value.wItem;
if( pItem->type & IT_BYREF )
pItem = stack.pItems + pItem->item.asRefer.value;
if( IS_ARRAY( pItem ) && wArrayIndex )
/* TODO: implement wArrayIndex use when retrieving an array element */
return 0;
else if( IS_INTEGER( pItem ) )
return pItem->value.iNumber;
return pItem->item.asInteger.value;
else if( IS_LONG( pItem ) )
return pItem->value.lNumber;
return pItem->item.asLong.value;
else if( IS_DOUBLE( pItem ) )
return pItem->value.dNumber;
return pItem->item.asDouble.value;
else
return 0;
@@ -259,21 +259,21 @@ long hb_parnl( WORD wParam, ... )
if( wParam <= hb_pcount() )
{
pItem = stack.pBase + 1 + wParam;
if( pItem->wType & IT_BYREF )
pItem = stack.pItems + pItem->value.wItem;
if( pItem->type & IT_BYREF )
pItem = stack.pItems + pItem->item.asRefer.value;
if( IS_ARRAY( pItem ) && wArrayIndex )
/* TODO: implement wArrayIndex use when retrieving an array element */
return 0;
else if( IS_INTEGER( pItem ) )
return (long) pItem->value.iNumber;
return (long) pItem->item.asInteger.value;
else if( IS_LONG( pItem ) )
return pItem->value.lNumber;
return pItem->item.asLong.value;
else if( IS_DOUBLE( pItem ) )
return (long) pItem->value.dNumber;
return (long) pItem->item.asDouble.value;
else
return 0;
@@ -299,11 +299,11 @@ int hb_parinfa( int iParamNum, ULONG uiArrayIndex )
WORD hb_parinfo( WORD wParam )
{
if( ! wParam )
return stack.pBase->wParams;
return stack.pBase->item.asSymbol.paramcnt;
else
{
if( wParam <= hb_pcount() )
return ( stack.pBase + 1 + wParam )->wType;
return ( stack.pBase + 1 + wParam )->type;
else
return 0;
}
@@ -311,7 +311,7 @@ WORD hb_parinfo( WORD wParam )
WORD hb_pcount( void )
{
return stack.pBase->wParams;
return stack.pBase->item.asSymbol.paramcnt;
}
void hb_ret( void )
@@ -329,20 +329,20 @@ void hb_retc( char * szText )
ULONG ulLen = strlen( szText );
ItemRelease( &stack.Return );
stack.Return.wType = IT_STRING;
stack.Return.wLength = ulLen;
stack.Return.value.szText = ( char * ) hb_xgrab( ulLen + 1 );
strcpy( stack.Return.value.szText, szText );
stack.Return.type = IT_STRING;
stack.Return.item.asString.length = ulLen;
stack.Return.item.asString.value = ( char * ) hb_xgrab( ulLen + 1 );
strcpy( stack.Return.item.asString.value, szText );
}
void hb_retclen( char * szText, ULONG ulLen )
{
ItemRelease( &stack.Return );
stack.Return.wType = IT_STRING;
stack.Return.wLength = ulLen;
stack.Return.value.szText = ( char * ) hb_xgrab( ulLen + 1 );
memcpy( stack.Return.value.szText, szText, ulLen );
stack.Return.value.szText[ ulLen ] = 0;
stack.Return.type = IT_STRING;
stack.Return.item.asString.length = ulLen;
stack.Return.item.asString.value = ( char * ) hb_xgrab( ulLen + 1 );
memcpy( stack.Return.item.asString.value, szText, ulLen );
stack.Return.item.asString.value[ ulLen ] = 0;
}
void hb_retds( char * szDate ) /* szDate must have yyyymmdd format */
@@ -362,48 +362,50 @@ void hb_retds( char * szDate ) /* szDate must have yyyymmdd format */
ItemRelease( &stack.Return );
stack.Return.wType = IT_DATE;
stack.Return.wLength = 8;
stack.Return.type = IT_DATE;
stack.Return.item.asDate.length = 8;
/* QUESTION: Is this ok ? we are going to use a long to store the date */
/* QUESTION: What happens if we use sizeof( LONG ) instead ? */
/* QUESTION: Would it break Clipper language code ? */
stack.Return.value.lDate = hb_dateEncode( lDay, lMonth, lYear );
stack.Return.item.asDate.value = hb_dateEncode( lDay, lMonth, lYear );
}
void hb_retnd( double dNumber )
{
ItemRelease( &stack.Return );
stack.Return.wType = IT_DOUBLE;
if( dNumber > 10000000000.0 ) stack.Return.wLength = 20;
else stack.Return.wLength = 10;
stack.Return.wDec = hb_set.HB_SET_DECIMALS;
stack.Return.value.dNumber = dNumber;
stack.Return.type = IT_DOUBLE;
if( dNumber > 10000000000.0 )
stack.Return.item.asDouble.length = 20;
else
stack.Return.item.asDouble.length = 10;
stack.Return.item.asDouble.decimal = hb_set.HB_SET_DECIMALS;
stack.Return.item.asDouble.value = dNumber;
}
void hb_retni( int iNumber )
{
ItemRelease( &stack.Return );
stack.Return.wType = IT_INTEGER;
stack.Return.wLength = 10;
stack.Return.wDec = 0;
stack.Return.value.iNumber = iNumber;
stack.Return.type = IT_INTEGER;
stack.Return.item.asInteger.length = 10;
stack.Return.item.asInteger.decimal = 0;
stack.Return.item.asInteger.value = iNumber;
}
void hb_retl( int iTrueFalse )
{
ItemRelease( &stack.Return );
stack.Return.wType = IT_LOGICAL;
stack.Return.wLength = 3;
stack.Return.value.iLogical = iTrueFalse;
stack.Return.type = IT_LOGICAL;
stack.Return.item.asLogical.length = 3;
stack.Return.item.asLogical.value = iTrueFalse;
}
void hb_retnl( long lNumber )
{
ItemRelease( &stack.Return );
stack.Return.wType = IT_LONG;
stack.Return.wLength = 10;
stack.Return.wDec = 0;
stack.Return.value.lNumber = lNumber;
stack.Return.type = IT_LONG;
stack.Return.item.asLong.length = 10;
stack.Return.item.asLong.decimal = 0;
stack.Return.item.asLong.value = lNumber;
}
void hb_storc( char * szText, WORD wParam, ... )
@@ -428,12 +430,12 @@ void hb_storc( char * szText, WORD wParam, ... )
if( IS_BYREF( pItem ) )
{
ulLen = strlen( szText );
pItemRef = stack.pItems + pItem->value.wItem;
pItemRef = stack.pItems + pItem->item.asRefer.value;
ItemRelease( pItemRef );
pItemRef->wType = IT_STRING;
pItemRef->wLength = ulLen;
pItemRef->value.szText = ( char * ) hb_xgrab( ulLen + 1 );
strcpy( pItemRef->value.szText, szText );
pItemRef->type = IT_STRING;
pItemRef->item.asString.length = ulLen;
pItemRef->item.asString.value = ( char * ) hb_xgrab( ulLen + 1 );
strcpy( pItemRef->item.asString.value, szText );
}
}
}
@@ -458,13 +460,13 @@ void hb_storclen( char * fixText, WORD wLength, WORD wParam, ... )
if( IS_BYREF( pItem ) )
{
pItemRef = stack.pItems + pItem->value.wItem;
pItemRef = stack.pItems + pItem->item.asRefer.value;
ItemRelease( pItemRef );
pItemRef->wType = IT_STRING;
pItemRef->wLength = wLength;
pItemRef->value.szText = ( char * ) hb_xgrab( wLength + 1 );
memcpy( pItemRef->value.szText, fixText, wLength );
pItemRef->value.szText[ wLength ] = '\0';
pItemRef->type = IT_STRING;
pItemRef->item.asString.length = wLength;
pItemRef->item.asString.value = ( char * ) hb_xgrab( wLength + 1 );
memcpy( pItemRef->item.asString.value, fixText, wLength );
pItemRef->item.asString.value[ wLength ] = '\0';
}
}
}
@@ -501,11 +503,11 @@ void hb_stords( char * szDate, WORD wParam, ... ) /* szDate must have yyyymmdd f
if( IS_BYREF( pItem ) )
{
pItemRef = stack.pItems + pItem->value.wItem;
pItemRef = stack.pItems + pItem->item.asRefer.value;
ItemRelease( pItemRef );
pItemRef->wType = IT_DATE;
pItemRef->wLength = 8;
pItemRef->value.lDate = hb_dateEncode( lDay, lMonth, lYear );
pItemRef->type = IT_DATE;
pItemRef->item.asDate.length = 8;
pItemRef->item.asDate.value = hb_dateEncode( lDay, lMonth, lYear );
}
}
}
@@ -530,11 +532,11 @@ void hb_storl( int iLogical, WORD wParam, ... )
if( IS_BYREF( pItem ) )
{
pItemRef = stack.pItems + pItem->value.wItem;
pItemRef = stack.pItems + pItem->item.asRefer.value;
ItemRelease( pItemRef );
pItemRef->wType = IT_LOGICAL;
pItemRef->wLength = 3;
pItemRef->value.iLogical = iLogical;
pItemRef->type = IT_LOGICAL;
pItemRef->item.asLogical.length = 3;
pItemRef->item.asLogical.value = iLogical;
}
}
}
@@ -559,12 +561,12 @@ void hb_storni( int iValue, WORD wParam, ... )
if( IS_BYREF( pItem ) )
{
pItemRef = stack.pItems + pItem->value.wItem;
pItemRef = stack.pItems + pItem->item.asRefer.value;
ItemRelease( pItemRef );
pItemRef->wType = IT_INTEGER;
pItemRef->wLength = 10;
pItemRef->wDec = 0;
pItemRef->value.iNumber = iValue;
pItemRef->type = IT_INTEGER;
pItemRef->item.asInteger.length = 10;
pItemRef->item.asInteger.decimal = 0;
pItemRef->item.asInteger.value = iValue;
}
}
}
@@ -589,12 +591,12 @@ void hb_stornl( long lValue, WORD wParam, ... )
if( IS_BYREF( pItem ) )
{
pItemRef = stack.pItems + pItem->value.wItem;
pItemRef = stack.pItems + pItem->item.asRefer.value;
ItemRelease( pItemRef );
pItemRef->wType = IT_LONG;
pItemRef->wLength = 10;
pItemRef->wDec = 0;
pItemRef->value.lNumber = lValue;
pItemRef->type = IT_LONG;
pItemRef->item.asLong.length = 10;
pItemRef->item.asLong.decimal = 0;
pItemRef->item.asLong.value = lValue;
}
}
}
@@ -619,13 +621,15 @@ void hb_stornd( double dValue, WORD wParam, ... )
if( IS_BYREF( pItem ) )
{
pItemRef = stack.pItems + pItem->value.wItem;
pItemRef = stack.pItems + pItem->item.asRefer.value;
ItemRelease( pItemRef );
pItemRef->wType = IT_DOUBLE;
if( dValue > 10000000000.0 ) pItemRef->wLength = 20;
else pItemRef->wLength = 10;
pItemRef->wDec = hb_set.HB_SET_DECIMALS;
pItemRef->value.dNumber = dValue;
pItemRef->type = IT_DOUBLE;
if( dValue > 10000000000.0 )
pItemRef->item.asDouble.length = 20;
else
pItemRef->item.asDouble.length = 10;
pItemRef->item.asDouble.decimal = hb_set.HB_SET_DECIMALS;
pItemRef->item.asDouble.value = dValue;
}
}
}

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

@@ -2,7 +2,8 @@
* $Id$
*/
#include <hbsetup.h>
#include <extend.h>
#include <init.h>
#include <filesys.h>
#include <string.h>
@@ -149,10 +150,13 @@ static SYMBOL symbols[] = {
{ "W2BIN" , FS_PUBLIC, HB_W2BIN , 0 }
};
HB_INIT_SYMBOLS( Files__InitSymbols );
/*
void Files__InitSymbols( void )
{
ProcessSymbols( symbols, sizeof(symbols)/sizeof( SYMBOL ) );
}
*/
/* Convert HARBOUR flags to IO subsystem flags */
@@ -580,7 +584,7 @@ HARBOUR HB_FWRITE( void )
if( arg1_it && arg2_it )
{
bytes = (arg3_it ? hb_parnl(3) : arg2_it->wLength );
bytes = (arg3_it ? hb_parnl(3) : hb_parclen( 2 ) );
bytes = hb_fsWrite( hb_parni(1), (BYTEP)hb_parc(2), bytes);
}
@@ -659,12 +663,12 @@ HARBOUR HB_FILE( void )
if( arg1_it )
{
/*TODO: Check if F_OK is defined in all compilers */
/*TODO: Check if F_OK is defined in all compilers */
#ifdef OS_UNIX_COMPATIBLE
hb_retl( access(hb_parc(1), F_OK) == 0 );
#else
#else
hb_retl( access(hb_parc(1), 0) == 0 );
#endif
#endif
}
else hb_retl(0);
return;

8
harbour/source/rtl/gtapi.c
View File

@@ -30,8 +30,8 @@ void hb_gtInit(void)
int hb_gtBox (USHORT uiTop, USHORT uiLeft, USHORT uiBottom, USHORT uiRight, char* pbyFrame)
{
BYTE pszBox [10];
BYTE cPadChar;
char pszBox [10];
char cPadChar;
USHORT uiRow = uiTop;
USHORT uiCol = uiLeft;
@@ -273,6 +273,7 @@ int hb_gtScrDim(USHORT * uipHeight, USHORT * uipWidth)
int hb_gtSetBlink(BOOL bBlink)
{
HB_SYMBOL_UNUSED( bBlink );
return(0);
}
@@ -284,6 +285,8 @@ int hb_gtSetCursor(USHORT uiCursorShape)
int hb_gtSetMode(USHORT uiRows, USHORT uiCols)
{
HB_SYMBOL_UNUSED( uiRows );
HB_SYMBOL_UNUSED( uiCols );
return(0);
}
@@ -302,6 +305,7 @@ int hb_gtSetPos(USHORT uiRow, USHORT uiCol)
int hb_gtSetSnowFlag(BOOL bNoSnow)
{
HB_SYMBOL_UNUSED( bNoSnow );
return(0);
}

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

@@ -4,21 +4,25 @@
#include <extend.h>
#include <ctype.h>
#include <init.h>
#define CHR_HARD1 (char)141
#define CHR_HARD2 (char)10
HARBOUR HB_HARDCR(void);
static SYMBOL symbols[] = {
{ "HARDCR", FS_PUBLIC, HB_HARDCR, 0 }
};
HB_INIT_SYMBOLS( HardCR__InitSymbols );
/*
void HardCR__InitSymbols( void )
{
ProcessSymbols( symbols, sizeof(symbols)/sizeof( SYMBOL ) );
}
*/
char *hb_hardcr( char *string )
{

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

@@ -96,10 +96,10 @@ PHB_ITEM hb_itemNew( PHB_ITEM pNull )
PHB_ITEM pItem = ( PHB_ITEM ) hb_xgrab( sizeof( HB_ITEM ) );
if( pNull ) /* keep the C compiler silent */
pNull->wType = 0; /* keep the C compiler silent */
pNull->type = 0; /* keep the C compiler silent */
memset( pItem, 0, sizeof( HB_ITEM ) );
pItem->wType = IT_NIL;
pItem->type = IT_NIL;
return pItem;
}
@@ -158,10 +158,10 @@ PHB_ITEM hb_itemPutC( PHB_ITEM pItem, char * szText )
else
pItem = hb_itemNew(0);
pItem->wType = IT_STRING;
pItem->wLength = strlen( szText );
pItem->value.szText = ( char * ) hb_xgrab( pItem->wLength + 1 );
strcpy( pItem->value.szText, szText );
pItem->type = IT_STRING;
pItem->item.asString.length = strlen( szText );
pItem->item.asString.value = ( char * ) hb_xgrab( pItem->item.asString.length + 1 );
strcpy( pItem->item.asString.value, szText );
return pItem;
}
@@ -172,11 +172,11 @@ PHB_ITEM hb_itemPutCL( PHB_ITEM pItem, char * nszText, ULONG ulLen )
else
pItem = hb_itemNew(0);
pItem->wType = IT_STRING;
pItem->wLength = ulLen;
pItem->value.szText = ( char * ) hb_xgrab( ulLen + 1 );
memcpy( pItem->value.szText, nszText, ulLen );
pItem->value.szText[ ulLen ] = 0;
pItem->type = IT_STRING;
pItem->item.asString.length = ulLen;
pItem->item.asString.value = ( char * ) hb_xgrab( ulLen + 1 );
memcpy( pItem->item.asString.value, nszText, ulLen );
pItem->item.asString.value[ ulLen ] = 0;
return pItem;
}
@@ -185,9 +185,9 @@ char *hb_itemGetC( PHB_ITEM pItem )
{
if( pItem && IS_STRING( pItem ) )
{
char *szResult = (char *) hb_xgrab(pItem->wLength + 1);
memcpy(szResult, pItem->value.szText, pItem->wLength);
szResult[pItem->wLength] = 0;
char *szResult = (char *) hb_xgrab(pItem->item.asString.length + 1);
memcpy(szResult, pItem->item.asString.value, pItem->item.asString.length);
szResult[ pItem->item.asString.length ] = 0;
return szResult;
}
@@ -200,9 +200,9 @@ ULONG hb_itemCopyC( PHB_ITEM pItem, char *szBuffer, ULONG ulLen )
if( pItem && IS_STRING(pItem) )
{
if( !ulLen )
ulLen = pItem->wLength;
ulLen = pItem->item.asString.length;
memcpy(szBuffer, pItem->value.szText, ulLen);
memcpy(szBuffer, pItem->item.asString.value, ulLen);
return ulLen;
}
else
@@ -226,7 +226,7 @@ char *hb_itemGetDS( PHB_ITEM pItem, char *szDate )
if( pItem && IS_DATE(pItem) )
{
long lDay, lMonth, lYear;
hb_dateDecode(pItem->value.lDate, &lDay, &lMonth, &lYear);
hb_dateDecode(pItem->item.asDate.value, &lDay, &lMonth, &lYear);
szDate[ 0 ] = ( lYear / 1000 ) + '0';
szDate[ 1 ] = ( ( lYear % 1000 ) / 100 ) + '0';
@@ -250,7 +250,7 @@ BOOL hb_itemGetL( PHB_ITEM pItem )
{
if( pItem && IS_LOGICAL(pItem) )
{
return pItem->value.iLogical;
return pItem->item.asLogical.value;
}
else
return FALSE;
@@ -260,11 +260,11 @@ double hb_itemGetND( PHB_ITEM pItem )
{
if( pItem )
{
switch( pItem->wType )
switch( pItem->type )
{
case IT_INTEGER: return pItem->value.iNumber;
case IT_DOUBLE: return pItem->value.dNumber;
case IT_LONG: return pItem->value.lNumber;
case IT_INTEGER: return pItem->item.asInteger.value;
case IT_DOUBLE: return pItem->item.asDouble.value;
case IT_LONG: return pItem->item.asLong.value;
default: return 0;
}
}
@@ -276,11 +276,11 @@ long hb_itemGetNL( PHB_ITEM pItem )
{
if( pItem )
{
switch( pItem->wType )
switch( pItem->type )
{
case IT_INTEGER: return pItem->value.iNumber;
case IT_DOUBLE: return pItem->value.dNumber;
case IT_LONG: return pItem->value.lNumber;
case IT_INTEGER: return pItem->item.asInteger.value;
case IT_DOUBLE: return pItem->item.asDouble.value;
case IT_LONG: return pItem->item.asLong.value;
default: return 0;
}
}
@@ -311,12 +311,12 @@ PHB_ITEM hb_itemPutDS( PHB_ITEM pItem, char *szDate )
+ ((szDate[ 2 ] - '0') * 10) + (szDate[ 3 ] - '0');
ItemRelease( pItem );
pItem->wType = IT_DATE;
pItem->wLength = 8;
pItem->type = IT_DATE;
pItem->item.asDate.length = 8;
/* QUESTION: Is this ok ? we are going to use a long to store the date */
/* QUESTION: What happens if we use sizeof( LONG ) instead ? */
/* QUESTION: Would it break Clipper language code ? */
pItem->value.lDate = hb_dateEncode(lDay, lMonth, lYear);
pItem->item.asDate.value = hb_dateEncode(lDay, lMonth, lYear);
return pItem;
}
@@ -328,9 +328,9 @@ PHB_ITEM hb_itemPutL( PHB_ITEM pItem, BOOL bValue )
else
pItem = hb_itemNew(0);
pItem->wType = IT_LOGICAL;
pItem->wLength = 3;
pItem->value.iLogical = bValue;
pItem->type = IT_LOGICAL;
pItem->item.asLogical.length = 3;
pItem->item.asLogical.value = bValue;
return pItem;
}
@@ -341,11 +341,11 @@ PHB_ITEM hb_itemPutND( PHB_ITEM pItem, double dNumber )
else
pItem = hb_itemNew(0);
pItem->wType = IT_DOUBLE;
if( dNumber > 10000000000.0 ) pItem->wLength = 20;
else pItem->wLength = 10;
pItem->wDec = hb_set.HB_SET_DECIMALS;
pItem->value.dNumber = dNumber;
pItem->type = IT_DOUBLE;
if( dNumber > 10000000000.0 ) pItem->item.asDouble.length = 20;
else pItem->item.asDouble.length = 10;
pItem->item.asDouble.decimal = hb_set.HB_SET_DECIMALS;
pItem->item.asDouble.value = dNumber;
return pItem;
}
@@ -356,10 +356,9 @@ PHB_ITEM hb_itemPutNL( PHB_ITEM pItem, long lNumber )
else
pItem = hb_itemNew(0);
pItem->wType = IT_DOUBLE;
pItem->wLength = 10;
pItem->wDec = hb_set.HB_SET_DECIMALS;
pItem->value.lNumber = lNumber;
pItem->type = IT_LONG;
pItem->item.asLong.length = 10;
pItem->item.asLong.value = lNumber;
return pItem;
}
@@ -367,10 +366,10 @@ ULONG hb_itemSize( PHB_ITEM pItem )
{
if( pItem )
{
switch( pItem->wType )
switch( pItem->type )
{
case IT_ARRAY: return hb_arrayLen(pItem);
case IT_STRING: return pItem->wLength;
case IT_STRING: return pItem->item.asString.length;
}
}
return 0;
@@ -378,5 +377,5 @@ ULONG hb_itemSize( PHB_ITEM pItem )
WORD hb_itemType( PHB_ITEM pItem )
{
return pItem->wType;
return pItem->type;
}

65
harbour/source/rtl/math.c
View File

@@ -2,6 +2,8 @@
* $Id$
*/
#include <extend.h>
#include <init.h>
#include <set.h>
#include <errorapi.h>
#include <math.h>
@@ -19,21 +21,16 @@ HARBOUR HB_ROUND( void );
HARBOUR HB_SQRT( void );
static SYMBOL symbols[] = {
{ "ABS" , FS_PUBLIC, HB_ABS , 0 },
{ "EXP" , FS_PUBLIC, HB_EXP , 0 },
{ "INT" , FS_PUBLIC, HB_INT , 0 },
{ "LOG" , FS_PUBLIC, HB_LOG , 0 },
{ "MAX" , FS_PUBLIC, HB_MAX , 0 },
{ "MIN" , FS_PUBLIC, HB_MIN , 0 },
{ "MOD" , FS_PUBLIC, HB_MOD , 0 },
{ "ROUND", FS_PUBLIC, HB_ROUND, 0 },
{ "SQRT" , FS_PUBLIC, HB_SQRT , 0 }
};
{ "MOD" , FS_PUBLIC, HB_MOD , 0 }
}; /* The rest of functions is pulled automatically by initsymb.c */
HB_INIT_SYMBOLS( Math__InitSymbols );
/*
void Math__InitSymbols( void )
{
ProcessSymbols( symbols, sizeof(symbols)/sizeof( SYMBOL ) );
}
*/
HARBOUR HB_ABS( void )
{
@@ -41,28 +38,28 @@ HARBOUR HB_ABS( void )
{
PHB_ITEM pNumber = hb_param(1, IT_NUMERIC);
if( pNumber ) switch( pNumber->wType )
if( pNumber ) switch( pNumber->type )
{
case IT_INTEGER:
if( pNumber->value.iNumber >= 0 )
hb_retni( pNumber->value.iNumber );
if( pNumber->item.asInteger.value >= 0 )
hb_retni( pNumber->item.asInteger.value );
else
hb_retni( -pNumber->value.iNumber );
hb_retni( -pNumber->item.asInteger.value );
break;
case IT_LONG:
if( pNumber->value.lNumber >= 0 )
hb_retnl( pNumber->value.lNumber );
if( pNumber->item.asLong.value >= 0 )
hb_retnl( pNumber->item.asLong.value );
else
hb_retnl( -pNumber->value.lNumber );
hb_retnl( -pNumber->item.asLong.value );
break;
case IT_DOUBLE:
if( pNumber->value.dNumber >= 0.0 )
hb_retnd( pNumber->value.dNumber );
if( pNumber->item.asDouble.value >= 0.0 )
hb_retnd( pNumber->item.asDouble.value );
else
hb_retnd( -pNumber->value.dNumber );
stack.Return.wDec = pNumber->wDec;
hb_retnd( -pNumber->item.asDouble.value );
stack.Return.item.asDouble.decimal = pNumber->item.asDouble.decimal;
}
else
{
@@ -86,7 +83,7 @@ HARBOUR HB_EXP( void )
{
hb_retnd( exp( hb_parnd( 1 ) ) );
/* Always set default number of decimals after EXP() */
stack.Return.wDec = hb_set.HB_SET_DECIMALS;
stack.Return.item.asDouble.decimal = hb_set.HB_SET_DECIMALS;
}
else
{
@@ -129,10 +126,10 @@ HARBOUR HB_LOG( void )
double dNumber = hb_parnd( 1 );
hb_retnd( log( dNumber ) );
/* Always set default number of decimals after LOG() */
stack.Return.wDec = hb_set.HB_SET_DECIMALS;
stack.Return.item.asDouble.decimal = hb_set.HB_SET_DECIMALS;
if( dNumber <= 0.0 )
/* Indicate overflow if called with an invalid argument */
stack.Return.wLength = 99;
stack.Return.item.asDouble.length = 99;
}
else
{
@@ -153,18 +150,18 @@ HARBOUR HB_MAX( void )
{
PHB_ITEM p1 = hb_param(1, IT_NUMERIC + IT_DATE), p2 = hb_param(2, IT_NUMERIC + IT_DATE);
if( p1 && p2 && p1->wType == p2->wType )
if( p1 && p2 && p1->type == p2->type )
{
if( p1->wType == IT_DATE )
if( p1->type == IT_DATE )
{
long l1 = p1->value.lDate, l2 = p2->value.lDate;
long l1 = p1->item.asDate.value, l2 = p2->item.asDate.value;
hb_retds(l1 > l2? hb_pards(1): hb_pards(2));
}
else
{
double d1 = hb_parnd(1), d2 = hb_parnd(2);
hb_retnd(d1 > d2? d1: d2);
stack.Return.wDec = (d1 > d2? p1->wDec : p2->wDec);
stack.Return.item.asDouble.decimal = (d1 > d2? p1->item.asDouble.decimal : p2->item.asDouble.decimal);
}
}
else
@@ -186,18 +183,18 @@ HARBOUR HB_MIN( void )
{
PHB_ITEM p1 = hb_param(1, IT_NUMERIC + IT_DATE), p2 = hb_param(2, IT_NUMERIC + IT_DATE);
if( p1 && p2 && p1->wType == p2->wType )
if( p1 && p2 && p1->type == p2->type )
{
if( p1->wType == IT_DATE )
if( p1->type == IT_DATE )
{
long l1 = p1->value.lDate, l2 = p2->value.lDate;
long l1 = p1->item.asDate.value, l2 = p2->item.asDate.value;
hb_retds(l1 < l2? hb_pards(1): hb_pards(2));
}
else
{
double d1 = hb_parnd(1), d2 = hb_parnd(2);
hb_retnd(d1 < d2? d1: d2);
stack.Return.wDec = (d1 < d2? p1->wDec : p2->wDec);
stack.Return.item.asDouble.decimal = (d1 < d2? p1->item.asDouble.decimal : p2->item.asDouble.decimal);
}
}
else
@@ -280,7 +277,7 @@ HARBOUR HB_ROUND( void )
hb_xfree( szResult );
}
hb_retnd( dResult );
stack.Return.wDec = iDec;
stack.Return.item.asDouble.decimal = iDec;
}
else
{
@@ -312,7 +309,7 @@ HARBOUR HB_SQRT( void )
/* Clipper doesn't error! */
hb_retnd(0);
/* Always set default number of decimals after SQRT() */
stack.Return.wDec = hb_set.HB_SET_DECIMALS;
stack.Return.item.asDouble.decimal = hb_set.HB_SET_DECIMALS;
}
else
{

5
harbour/source/rtl/mtran.c
View File

@@ -3,6 +3,7 @@
*/
#include <extend.h>
#include <init.h>
#include <ctype.h>
#define CHR_HARD1 (char)141
@@ -17,11 +18,13 @@ static SYMBOL symbols[] = {
{ "MEMOTRAN", FS_PUBLIC, HB_MEMOTRAN, 0 }
};
HB_INIT_SYMBOLS( Memotran__InitSymbols );
/*
void Memotran__InitSymbols( void )
{
ProcessSymbols( symbols, sizeof(symbols)/sizeof( SYMBOL ) );
}
*/
char *hb_memotran( char *string, char *hardcr, char *softcr )
{

50
harbour/source/rtl/set.c
View File

@@ -13,6 +13,7 @@
#include <ctype.h>
#include <extend.h>
#include <init.h>
#include <errorapi.h>
#include <fcntl.h>
#include <sys/stat.h>
@@ -38,28 +39,31 @@ static SYMBOL symbols[] = {
{ "SET" , FS_PUBLIC, HB_SET , 0 }
};
HB_INIT_SYMBOLS( Set__InitSymbols );
/*
void Set__InitSymbols( void )
{
ProcessSymbols( symbols, sizeof(symbols)/sizeof( SYMBOL ) );
}
*/
static BOOL set_logical (PHB_ITEM pItem)
{
BOOL logical = FALSE;
if (IS_LOGICAL (pItem)) logical = pItem->value.iLogical;
if (IS_LOGICAL (pItem)) logical = pItem->item.asLogical.value;
else if (IS_STRING (pItem))
{
if (pItem->wLength == 2)
if (pItem->item.asString.length == 2)
{
if (toupper (pItem->value.szText [0]) == 'O'
&& toupper (pItem->value.szText [1]) == 'N')
if (toupper (pItem->item.asString.value [0]) == 'O'
&& toupper (pItem->item.asString.value [1]) == 'N')
logical = TRUE;
}
else if (pItem->wLength == 3)
else if (pItem->item.asString.length == 3)
{
if (toupper (pItem->value.szText [0]) == 'O'
&& toupper (pItem->value.szText [1]) == 'F'
&& toupper (pItem->value.szText [2]) == 'F')
if (toupper (pItem->item.asString.value [0]) == 'O'
&& toupper (pItem->item.asString.value [1]) == 'F'
&& toupper (pItem->item.asString.value [2]) == 'F')
logical = FALSE;
}
}
@@ -69,9 +73,9 @@ static BOOL set_logical (PHB_ITEM pItem)
static int set_number (PHB_ITEM pItem, int old_value)
{
int number;
if (IS_INTEGER (pItem)) number = pItem->value.iNumber;
else if (IS_LONG (pItem)) number = (int)pItem->value.lNumber;
else if (IS_DOUBLE (pItem)) number = (int)pItem->value.dNumber;
if (IS_INTEGER (pItem)) number = pItem->item.asInteger.value;
else if (IS_LONG (pItem)) number = (int)pItem->item.asLong.value;
else if (IS_DOUBLE (pItem)) number = (int)pItem->item.asDouble.value;
else number = old_value;
return (number);
}
@@ -81,10 +85,10 @@ static char * set_string (PHB_ITEM pItem, char * old_str)
char * string;
if (IS_STRING (pItem))
{
int size = pItem->wLength;
int size = pItem->item.asString.length;
if (old_str) string = (char*)hb_xrealloc (old_str, size + 1);
else string = (char*)hb_xgrab (size + 1);
memcpy (string, pItem->value.szText, size);
memcpy (string, pItem->item.asString.value, size);
string [size] = 0;
}
else string = old_str;
@@ -92,7 +96,7 @@ static char * set_string (PHB_ITEM pItem, char * old_str)
}
static void close_binary( int handle )
{
{
#if defined(OS_UNIX_COMPATIBLE)
fchmod( handle, S_IRUSR|S_IWUSR );
#endif
@@ -105,7 +109,7 @@ static void close_text (int handle)
fchmod( handle, S_IRUSR|S_IWUSR );
#else
write (handle, "\x1A", 1);
#endif
#endif
close( handle );
}
@@ -190,20 +194,20 @@ HARBOUR HB___SETCENTURY (void)
* Then change the setting if the parameter is a logical value, or is
* either "ON" or "OFF" (regardless of case)
*/
if ( pItem && IS_LOGICAL (pItem)) hb_set_century = pItem->value.iLogical;
if ( pItem && IS_LOGICAL (pItem)) hb_set_century = pItem->item.asLogical.value;
else if ( pItem && IS_STRING (pItem))
{
if (pItem->wLength == 2)
if (pItem->item.asString.length == 2)
{
if (toupper (pItem->value.szText [0]) == 'O'
&& toupper (pItem->value.szText [1]) == 'N')
if (toupper (pItem->item.asString.value [0]) == 'O'
&& toupper (pItem->item.asString.value [1]) == 'N')
hb_set_century = TRUE;
}
else if (pItem->wLength == 3)
else if (pItem->item.asString.length == 3)
{
if (toupper (pItem->value.szText [0]) == 'O'
&& toupper (pItem->value.szText [1]) == 'F'
&& toupper (pItem->value.szText [2]) == 'F')
if (toupper (pItem->item.asString.value [0]) == 'O'
&& toupper (pItem->item.asString.value [1]) == 'F'
&& toupper (pItem->item.asString.value [2]) == 'F')
hb_set_century = FALSE;
}
}

8
harbour/source/rtl/strcmp.c
View File

@@ -33,10 +33,10 @@ int hb_stricmp( const char *s1, const char *s2 )
/* Check whether two strings are equal (0), smaller (-1), or greater (1) */
int hb_itemStrCmp( PHB_ITEM pFirst, PHB_ITEM pSecond, BOOL bForceExact )
{
char *szFirst = pFirst->value.szText;
char *szSecond = pSecond->value.szText;
long lLenFirst = pFirst->wLength; /* TODO: change HB_ITEM.wLength from WORD to long */
long lLenSecond = pSecond->wLength; /* TODO: change HB_ITEM.wLength from WORD to long */
char *szFirst = pFirst->item.asString.value;
char *szSecond = pSecond->item.asString.value;
ULONG lLenFirst = pFirst->item.asString.length;
ULONG lLenSecond = pSecond->item.asString.length;
long lMinLen;
long lCounter;
int iRet = 0; /* Current status */

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

@@ -5,6 +5,8 @@
#include <hbsetup.h>
#include <dates.h>
#include <extend.h>
#include <init.h>
#include <itemapi.h>
#include <errorapi.h>
#include <ctype.h>
#include <math.h>
@@ -12,7 +14,7 @@
extern STACK stack;
#ifdef HB_STRICT_CLIPPER_COMPATIBILITY
#ifdef HARBOUR_STRICT_CLIPPER_COMPATIBILITY
static double infinity = 0;
#endif
@@ -51,40 +53,36 @@ HARBOUR HB_VAL( void );
static SYMBOL symbols[] = {
{ "ALLTRIM" , FS_PUBLIC, HB_ALLTRIM, 0 },
{ "HB_ASC" , FS_PUBLIC, HB_ASC , 0 },
{ "HB_AT" , FS_PUBLIC, HB_AT , 0 },
{ "HB_CHR" , FS_PUBLIC, HB_CHR , 0 },
{ "ISALPHA" , FS_PUBLIC, HB_ISALPHA, 0 },
{ "ISDIGIT" , FS_PUBLIC, HB_ISDIGIT, 0 },
{ "ISUPPER" , FS_PUBLIC, HB_ISUPPER, 0 },
{ "ISLOWER" , FS_PUBLIC, HB_ISLOWER, 0 },
{ "HB_LEFT" , FS_PUBLIC, HB_LEFT , 0 },
{ "HB_LOWER" , FS_PUBLIC, HB_LOWER , 0 },
{ "HB_LTRIM" , FS_PUBLIC, HB_LTRIM , 0 },
{ "PAD" , FS_PUBLIC, HB_PAD , 0 },
{ "PADC" , FS_PUBLIC, HB_PADC , 0 },
{ "PADL" , FS_PUBLIC, HB_PADL , 0 },
{ "PADR" , FS_PUBLIC, HB_PADR , 0 },
{ "RAT" , FS_PUBLIC, HB_RAT , 0 },
{ "HB_REPLICATE" , FS_PUBLIC, HB_REPLICATE , 0 },
{ "RIGHT" , FS_PUBLIC, HB_RIGHT , 0 },
{ "HB_RTRIM" , FS_PUBLIC, HB_RTRIM , 0 },
{ "STR" , FS_PUBLIC, HB_STR , 0 },
{ "STRTRAN" , FS_PUBLIC, HB_STRTRAN, 0 },
{ "STUFF" , FS_PUBLIC, HB_STUFF , 0 },
{ "HB_SUBSTR" , FS_PUBLIC, HB_SUBSTR , 0 },
{ "TRIM" , FS_PUBLIC, HB_TRIM , 0 },
{ "HB_UPPER" , FS_PUBLIC, HB_UPPER , 0 },
{ "HB_VAL" , FS_PUBLIC, HB_VAL , 0 }
};
{ "STUFF" , FS_PUBLIC, HB_STUFF , 0 }
}; /* The rest of functions is pulled automatically by initsymb.c */
HB_INIT_SYMBOLS( Strings__InitSymbols );
/*
void Strings__InitSymbols( void )
{
ProcessSymbols( symbols, sizeof(symbols)/sizeof( SYMBOL ) );
#ifdef HB_STRICT_CLIPPER_COMPATIBILITY
infinity = -log( 0 );
#endif
}
*/
#ifdef HARBOUR_STRICT_CLIPPER_COMPATIBILITY
HB_CALL_ON_STARTUP( Strings_InitInfinity )
{
infinity = -log( 0 );
HB_RETURN_ON_STARTUP
}
#endif
BOOL hb_strempty( char * szText, ULONG ulLen )
{
@@ -158,8 +156,8 @@ HARBOUR HB_LTRIM( void )
if( pText )
{
ULONG lLen = pText->wLength;
char *szText = hb_strLTrim(pText->value.szText, &lLen);
ULONG lLen = pText->item.asString.length;
char *szText = hb_strLTrim(pText->item.asString.value, &lLen);
hb_retclen(szText, lLen);
}
@@ -202,11 +200,11 @@ HARBOUR HB_RTRIM( void )
if( pText )
{
BOOL bAnySpace = (hb_pcount() > 1? hb_parl(2): 0);
hb_retclen(pText->value.szText, hb_strRTrimLen(pText->value.szText, pText->wLength, bAnySpace));
hb_retclen(pText->item.asString.value, hb_strRTrimLen(pText->item.asString.value, pText->item.asString.length, bAnySpace));
}
else
{
#ifdef HB_STRICT_CLIPPER_COMPATIBILITY
#ifdef HARBOUR_STRICT_CLIPPER_COMPATIBILITY
/* Clipper doesn't error, but only in RTRIM. TRIM() throws an error, though */
hb_retc("");
#else
@@ -221,7 +219,7 @@ HARBOUR HB_RTRIM( void )
}
}
/* synonymn for RTRIM, with different error handling */
/* synonymn for RTRIM */
HARBOUR HB_TRIM( void )
{
if( hb_pcount() > 0 )
@@ -272,7 +270,7 @@ static char * hb_pad_prep( PHB_ITEM pItem, char * buffer, WORD * pwSize )
{
char * szText = 0;
if( pItem ) switch( pItem->wType )
if( pItem ) switch( pItem->type )
{
case IT_DATE:
szText = hb_dtoc( hb_pards( 1 ), buffer );
@@ -289,8 +287,8 @@ static char * hb_pad_prep( PHB_ITEM pItem, char * buffer, WORD * pwSize )
*pwSize = strlen( szText );
break;
case IT_DOUBLE:
if( pItem->wDec )
sprintf( buffer, "%.*f", pItem->wDec, hb_parnd( 1 ) );
if( pItem->item.asDouble.decimal )
sprintf( buffer, "%.*f", pItem->item.asDouble.decimal, hb_parnd( 1 ) );
else
sprintf( buffer, "%ld", hb_parnl( 1 ) );
szText = buffer;
@@ -480,7 +478,7 @@ HARBOUR HB_AT( void )
{
if( IS_STRING( pText ) && IS_STRING( pSub ) )
{
hb_retnl( hb_strAt(pSub->value.szText, pSub->wLength, pText->value.szText, pText->wLength) );
hb_retnl( hb_strAt(pSub->item.asString.value, pSub->item.asString.length, pText->item.asString.value, pText->item.asString.length) );
}
else
{
@@ -562,8 +560,8 @@ HARBOUR HB_ASC(void)
if( pText )
{
if( pText->wLength > 0 )
hb_retni(*(pText->value.szText));
if( pText->item.asString.length > 0 )
hb_retni(*(pText->item.asString.value));
else
hb_retni(0);
}
@@ -594,13 +592,13 @@ HARBOUR HB_LEFT( void )
{
long lLen = hb_parnl(2);
if( lLen > pText->wLength )
lLen = pText->wLength;
if( lLen > pText->item.asString.length )
lLen = pText->item.asString.length;
else if( lLen < 0 )
lLen = 0;
hb_retclen(pText->value.szText, lLen);
hb_retclen(pText->item.asString.value, lLen);
}
else
{
@@ -634,13 +632,13 @@ HARBOUR HB_RIGHT( void )
{
long lLen = hb_parnl(2);
if( lLen > pText->wLength )
lLen = pText->wLength;
if( lLen > pText->item.asString.length )
lLen = pText->item.asString.length;
else if( lLen < 0 )
lLen = 0;
hb_retclen(pText->value.szText + pText->wLength - lLen, lLen);
hb_retclen(pText->item.asString.value + pText->item.asString.length - lLen, lLen);
}
else
{
@@ -656,6 +654,7 @@ HARBOUR HB_RIGHT( void )
}
else
{
/* QUESTION: Clipper catches this at compile time! */
/* Clipper doesn't error */
hb_retc("");
}
@@ -675,7 +674,7 @@ HARBOUR HB_SUBSTR( void )
if( lPos < 0 )
{
lPos += pText->wLength;
lPos += pText->item.asString.length;
if( lPos < 0 )
lPos = 0;
}
@@ -684,7 +683,7 @@ HARBOUR HB_SUBSTR( void )
lPos--;
}
if( lPos < pText->wLength )
if( lPos < pText->item.asString.length )
{
PHB_ITEM pLen = hb_param(3, IT_NUMERIC);
long lLen;
@@ -693,14 +692,14 @@ HARBOUR HB_SUBSTR( void )
{
lLen = hb_parnl(3);
if( lLen > pText->wLength - lPos )
lLen = pText->wLength - lPos;
if( lLen > pText->item.asString.length - lPos )
lLen = pText->item.asString.length - lPos;
}
else
lLen = pText->wLength - lPos;
lLen = pText->item.asString.length - lPos;
if( lLen > 0 )
hb_retclen(pText->value.szText + lPos, lLen);
hb_retclen(pText->item.asString.value + lPos, lLen);
else
hb_retc("");
}
@@ -737,9 +736,9 @@ HARBOUR HB_LOWER( void )
if( pText )
{
long lLen = pText->wLength;
long lLen = pText->item.asString.length;
hb_retclen(hb_strLower(pText->value.szText, lLen), lLen);
hb_retclen(hb_strLower(pText->item.asString.value, lLen), lLen);
}
else
{
@@ -771,9 +770,9 @@ HARBOUR HB_UPPER( void )
if( pText )
{
long lLen = pText->wLength;
long lLen = pText->item.asString.length;
hb_retclen(hb_strUpper(pText->value.szText, lLen), lLen);
hb_retclen(hb_strUpper(pText->item.asString.value, lLen), lLen);
}
else
{
@@ -802,8 +801,8 @@ HARBOUR HB_REPLICATE( void )
if( lTimes > 0 )
{
char *szText = pText->value.szText;
long lLen = pText->wLength;
char *szText = pText->item.asString.value;
long lLen = pText->item.asString.length;
char *szResult = (char *)hb_xgrab((lLen * lTimes) + 1);
char *szPtr = szResult;
long i;
@@ -881,22 +880,22 @@ HARBOUR HB_STUFF( void )
pText = hb_param(1, IT_STRING);
if( pText )
{
char *szText = pText->value.szText;
char *szText = pText->item.asString.value;
PHB_ITEM pPos, pDel, pInsert;
long lPos, lDel, lInsert, lTotalLen;
ULONG lPos, lDel, lInsert, lTotalLen;
char *szInsert;
pPos = hb_param(2, IT_NUMERIC);
lPos = (pPos? pPos->value.lNumber - 1: 0);
if( lPos > pText->wLength )
lPos = pText->wLength;
lPos = (pPos? hb_itemGetNL( pPos ) - 1: 0);
if( lPos > pText->item.asString.length )
lPos = pText->item.asString.length;
pDel = hb_param(3, IT_NUMERIC);
if( pDel )
{
lDel = pDel->value.lNumber;
if( lDel > pText->wLength - lPos )
lDel = pText->wLength - lPos;
lDel = hb_itemGetNL( pDel );
if( lDel > pText->item.asString.length - lPos )
lDel = pText->item.asString.length - lPos;
}
else
lDel = 0;
@@ -904,8 +903,8 @@ HARBOUR HB_STUFF( void )
pInsert = hb_param(4, IT_STRING);
if( pInsert )
{
szInsert = pInsert->value.szText;
lInsert = pInsert->wLength;
szInsert = pInsert->item.asString.value;
lInsert = pInsert->item.asString.length;
}
else
{
@@ -913,14 +912,14 @@ HARBOUR HB_STUFF( void )
lInsert = 0;
}
if( (lTotalLen = pText->wLength + lInsert - lDel) > 0 )
if( (lTotalLen = pText->item.asString.length + lInsert - lDel) > 0 )
{
char *szResult = (char *)hb_xgrab(lTotalLen + 1);
memcpy(szResult, szText, lPos);
memcpy(szResult + lPos, szInsert, lInsert);
memcpy(szResult + lPos + lInsert, szText + lPos + lDel,
pText->wLength - (lPos + lDel));
pText->item.asString.length - (lPos + lDel));
szResult[lTotalLen] = 0;
hb_retclen(szResult, lTotalLen);
@@ -943,13 +942,13 @@ HARBOUR HB_STRTRAN( void )
PHB_ITEM pSeek = hb_param(2, IT_STRING);
if( pSeek )
{
char *szText = pText->value.szText;
if( pSeek->wLength && pSeek->wLength <= pText->wLength )
char *szText = pText->item.asString.value;
if( pSeek->item.asString.length && pSeek->item.asString.length <= pText->item.asString.length )
{
char *szSeek = pSeek->value.szText;
char *szSeek = pSeek->item.asString.value;
PHB_ITEM pStart = hb_param(4, IT_NUMERIC);
char *szReplace;
long iStart;
ULONG iStart;
iStart = (pStart? hb_parnl(4): 1);
if( !iStart )
@@ -961,13 +960,14 @@ HARBOUR HB_STRTRAN( void )
{
PHB_ITEM pReplace = hb_param(3, IT_STRING);
PHB_ITEM pCount = hb_param(5, IT_NUMERIC);
long iReplace;
long iCount, bAll;
ULONG iReplace;
ULONG iCount;
long bAll;
if( pReplace )
{
szReplace = pReplace->value.szText;
iReplace = pReplace->wLength;
szReplace = pReplace->item.asString.value;
iReplace = pReplace->item.asString.length;
}
else
{
@@ -977,7 +977,7 @@ HARBOUR HB_STRTRAN( void )
if( pCount )
{
iCount = pCount->value.lNumber;
iCount = hb_itemGetNL( pCount );
bAll = 0;
}
else
@@ -990,19 +990,19 @@ HARBOUR HB_STRTRAN( void )
{
long iFound = 0;
long iReplaced = 0;
long i = 0;
long iLength = pText->wLength;
ULONG i = 0;
ULONG iLength = pText->item.asString.length;
while( i < pText->wLength )
while( i < pText->item.asString.length )
{
if( (bAll || iReplaced < iCount) && !memcmp(szText + i, szSeek, pSeek->wLength) )
if( (bAll || iReplaced < iCount) && !memcmp(szText + i, szSeek, pSeek->item.asString.length) )
{
iFound++;
if( iFound >= iStart )
{
iReplaced++;
iLength = iLength - pSeek->wLength + iReplace;
i += pSeek->wLength;
iLength = iLength - pSeek->item.asString.length + iReplace;
i += pSeek->item.asString.length;
}
else
i++;
@@ -1018,9 +1018,9 @@ HARBOUR HB_STRTRAN( void )
iFound = 0;
i = 0;
while( i < pText->wLength )
while( i < pText->item.asString.length )
{
if( iReplaced && !memcmp(szText + i, szSeek, pSeek->wLength) )
if( iReplaced && !memcmp(szText + i, szSeek, pSeek->item.asString.length) )
{
iFound++;
if( iFound >= iStart )
@@ -1028,7 +1028,7 @@ HARBOUR HB_STRTRAN( void )
iReplaced--;
memcpy(szPtr, szReplace, iReplace);
szPtr += iReplace;
i += pSeek->wLength;
i += pSeek->item.asString.length;
}
else
{
@@ -1048,16 +1048,16 @@ HARBOUR HB_STRTRAN( void )
hb_xfree(szResult);
}
else
hb_retclen(szText, pText->wLength);
hb_retclen(szText, pText->item.asString.length);
}
else
hb_retclen(szText, pText->wLength);
hb_retclen(szText, pText->item.asString.length);
}
else
hb_retclen(szText, pText->wLength);
hb_retclen(szText, pText->item.asString.length);
}
else
hb_retclen(szText, pText->wLength);
hb_retclen(szText, pText->item.asString.length);
}
else
hb_retc("");
@@ -1082,16 +1082,16 @@ HARBOUR HB_VAL( void )
if( pText )
{
int nWidth, nDec = 0;
char * ptr = strchr( pText->value.szText, '.' );
char * ptr = strchr( pText->item.asString.value, '.' );
if( ptr )
{
nWidth = ptr - pText->value.szText;
nWidth = ptr - pText->item.asString.value;
nDec = strlen( ptr + 1 );
}
else nWidth = strlen( pText->value.szText );
hb_retnd(hb_strVal(pText->value.szText));
stack.Return.wLength = nWidth;
stack.Return.wDec = nDec;
else nWidth = strlen( pText->item.asString.value );
hb_retnd(hb_strVal(pText->item.asString.value));
stack.Return.item.asDouble.length = nWidth;
stack.Return.item.asDouble.decimal = nDec;
}
else
{
@@ -1120,8 +1120,8 @@ char * hb_str( PHB_ITEM pNumber, PHB_ITEM pWidth, PHB_ITEM pDec )
{
/* Default to the width and number of decimals specified by the item,
with a limit of 20 integer places and 9 decimal places */
int iWidth = pNumber->wLength;
int iDec = pNumber->wDec;
int iWidth = pNumber->item.asDouble.length;
int iDec = pNumber->item.asDouble.decimal;
if( iWidth > 20 )
iWidth = 20;
if( iDec > 9 )
@@ -1133,12 +1133,7 @@ char * hb_str( PHB_ITEM pNumber, PHB_ITEM pWidth, PHB_ITEM pDec )
{
/* If the width parameter is specified, override the default value
and set the number of decimals to zero */
if( IS_INTEGER( pWidth ) )
iWidth = pWidth->value.iNumber;
else if( IS_LONG( pWidth ) )
iWidth = (int) pWidth->value.lNumber;
else if( IS_DOUBLE( pWidth ) )
iWidth = (int) pWidth->value.dNumber;
iWidth =(int) hb_itemGetNL( pWidth );
if( iWidth < 1 )
iWidth = 10; /* If 0 or negative, use default */
@@ -1150,12 +1145,7 @@ char * hb_str( PHB_ITEM pNumber, PHB_ITEM pWidth, PHB_ITEM pDec )
/* This function does not include the decimal places in the width,
so the width must be adjusted downwards, if the decimal places
parameter is greater than 0 */
if( IS_INTEGER( pDec ) )
iDec = pDec->value.iNumber;
else if( IS_LONG( pDec ) )
iDec = (int) pDec->value.lNumber;
else if( IS_DOUBLE( pDec ) )
iDec = (int) pDec->value.dNumber;
iDec =(int) hb_itemGetNL( pDec );
if( iDec < 0 )
iDec = 0;
@@ -1174,17 +1164,10 @@ char * hb_str( PHB_ITEM pNumber, PHB_ITEM pWidth, PHB_ITEM pDec )
if( IS_DOUBLE( pNumber ) || iDec != 0 )
{
double dNumber;
double dNumber =hb_itemGetND( pNumber );
if( IS_INTEGER( pNumber ) )
dNumber = (double) pNumber->value.iNumber;
else if( IS_LONG( pNumber ) )
dNumber = (double) pNumber->value.lNumber;
else if( IS_DOUBLE( pNumber ) )
dNumber = pNumber->value.dNumber;
#ifdef HB_STRICT_CLIPPER_COMPATIBILITY
if( pNumber->wLength == 99 || dNumber == infinity || dNumber == -infinity )
#ifdef HARBOUR_STRICT_CLIPPER_COMPATIBILITY
if( pNumber->item.asDouble.length == 99 || dNumber == infinity || dNumber == -infinity )
/* Numeric overflow */
iBytes = iSize + 1;
else
@@ -1196,14 +1179,14 @@ char * hb_str( PHB_ITEM pNumber, PHB_ITEM pWidth, PHB_ITEM pDec )
iBytes = sprintf( szResult, "%*ld", iWidth, (long)dNumber );
}
}
else switch( pNumber->wType & ~IT_BYREF )
else switch( pNumber->type & ~IT_BYREF )
{
case IT_LONG:
iBytes = sprintf( szResult, "%*li", iWidth, pNumber->value.lNumber );
iBytes = sprintf( szResult, "%*li", iWidth, pNumber->item.asLong.value );
break;
case IT_INTEGER:
iBytes = sprintf( szResult, "%*i", iWidth, pNumber->value.iNumber );
iBytes = sprintf( szResult, "%*i", iWidth, pNumber->item.asInteger.value );
break;
default:

70
harbour/source/rtl/transfrm.c
View File

@@ -3,6 +3,7 @@
*/
#include <extend.h>
#include <init.h>
#include <errorapi.h>
#include <ctoharb.h>
#include <ctype.h>
@@ -18,13 +19,16 @@
HARBOUR HB_TRANSFORM( void );
static SYMBOL symbols[] = {
{ "HB_TRANSFORM" , FS_PUBLIC, HB_TRANSFORM , 0 }
{ "TRANSFORM" , FS_PUBLIC, HB_TRANSFORM , 0 }
};
HB_INIT_SYMBOLS( Transfrm__InitSymbols );
/*
void Transfrm__InitSymbols( void )
{
ProcessSymbols( symbols, sizeof(symbols)/sizeof( SYMBOL ) );
}
*/
extern STACK stack;
@@ -203,7 +207,7 @@ char *NumPicture( char *szPic, long lPic, int iPicFlags, double dValue,
pItem = &stack.Return;
if( IS_STRING( pItem ) ) /* Is it a string */
{
szStr = pItem->value.szText;
szStr = pItem->item.asString.value;
iCount = 0;
if( iPicFlags & PF_ZERO ) /* Pad with Zero's */
@@ -211,9 +215,9 @@ char *NumPicture( char *szPic, long lPic, int iPicFlags, double dValue,
for( i=0; szStr[i] == ' ' && i < iWidth; i++ )
szStr[i] = '0';
}
if( bEmpty && pItem->wLength ) /* Suppress empty value */
if( bEmpty && pItem->item.asString.length ) /* Suppress empty value */
{
szStr[pItem->wLength - 1] = ' ';
szStr[pItem->item.asString.length - 1] = ' ';
}
if( iPicFlags & PF_LEFT ) /* Left align */
@@ -329,7 +333,7 @@ PHB_ITEM NumDefault( double dValue )
PushDouble ( dValue, hb_set.HB_SET_DECIMALS ); /* Push value to transform */
Function ( 1 ); /* 1 Parameter */
StackPop (); /* Pop return value */
if( stack.pPos->wType != IT_STRING ) /* Is it a string */
if( stack.pPos->type != IT_STRING ) /* Is it a string */
{
printf( "\nNUMDEFAULT: STR does not return string" );
_exit(1);
@@ -441,14 +445,14 @@ HARBOUR HB_TRANSFORM( void )
PHB_ITEM pPic = hb_param( 2, IT_STRING); /* Picture string */
PHB_ITEM pExp = hb_param( 1, IT_ANY ); /* Input parameter */
char *szPic = pPic->value.szText;
char *szPic = pPic->item.asString.value;
char *szTemp;
char *szResult;
char *szExp;
PHB_ITEM pItem;
long lPic = pPic->wLength;
long lPic = pPic->item.asString.length;
long lPicStart = 0; /* Start of template */
long lExpPos = 0;
long lResultPos = 0;
@@ -460,28 +464,28 @@ HARBOUR HB_TRANSFORM( void )
if( lPic )
{
if( pPic->wLength )
if( pPic->item.asString.length )
{
if( *szPic == '@' ) /* Function marker found */
{
iPicFlags = PictFunc( &szPic, &lPic ); /* Get length of function*/
lPicStart = pPic->wLength - lPic; /* Get start of template */
lPicStart = pPic->item.asString.length - lPic; /* Get start of template */
}
switch( pExp->wType & ~IT_BYREF )
switch( pExp->type & ~IT_BYREF )
{
case IT_STRING:
{
szExp = pExp->value.szText;
szResult = (char *)hb_xgrab( ( (lPic-lPicStart) > pExp->wLength) ?
(lPic-lPicStart) + 1 : pExp->wLength + 1 );
szExp = pExp->item.asString.value;
szResult = (char *)hb_xgrab( ( (lPic-lPicStart) > pExp->item.asString.length) ?
(lPic-lPicStart) + 1 : pExp->item.asString.length + 1 );
/* Grab enough */
szPic += lPicStart; /* Skip functions */
if( iPicFlags & PF_UPPER ) /* Function : @! */
{
szTemp = szExp; /* Convert to upper */
for( n = pExp->wLength; n ; n--)
for( n = pExp->item.asString.length; n ; n--)
{
*szTemp = toupper( *szTemp );
szTemp++;
@@ -490,7 +494,7 @@ HARBOUR HB_TRANSFORM( void )
if( lPic ) /* Template string */
{
while( lPic && lExpPos < pExp->wLength )
while( lPic && lExpPos < pExp->item.asString.length )
{ /* Analyze picture mask */
switch( *szPic )
{
@@ -530,7 +534,7 @@ HARBOUR HB_TRANSFORM( void )
}
else if( iPicFlags & (PF_UPPER + PF_REMAIN) )
{ /* Without template */
for( n = pExp->wLength; n; n--)
for( n = pExp->item.asString.length; n; n--)
szResult[lResultPos++] = *szExp++;
}
@@ -557,7 +561,7 @@ HARBOUR HB_TRANSFORM( void )
{
case 'Y': /* Yes/No */
{
*szResult = pExp->value.iLogical ? 'Y' : 'N';
*szResult = pExp->item.asLogical.value ? 'Y' : 'N';
szPic++;
lPic--;
bDone = TRUE; /* Logical written */
@@ -567,7 +571,7 @@ HARBOUR HB_TRANSFORM( void )
case '#':
case 'L': /* True/False */
{
*szResult = pExp->value.iLogical ? 'T' : 'F';
*szResult = pExp->item.asLogical.value ? 'T' : 'F';
szPic++;
lPic--;
bDone = TRUE;
@@ -586,7 +590,7 @@ HARBOUR HB_TRANSFORM( void )
for( n = lPic; n; n--) /* Copy remainder */
szResult[lResultPos++] = *szPic++;
if( !bDone ) /* Logical written ? */
szResult[lResultPos++] = pExp->value.iLogical ? 'T' : 'F';
szResult[lResultPos++] = pExp->item.asLogical.value ? 'T' : 'F';
}
hb_retclen( szResult, lResultPos );
hb_xfree( szResult );
@@ -595,7 +599,7 @@ HARBOUR HB_TRANSFORM( void )
case IT_INTEGER:
{
szResult = NumPicture( szPic + lPicStart, lPic, iPicFlags,
(double) pExp->value.iNumber, &lResultPos );
(double) pExp->item.asInteger.value, &lResultPos );
hb_retclen( szResult, lResultPos );
hb_xfree( szResult );
break;
@@ -603,7 +607,7 @@ HARBOUR HB_TRANSFORM( void )
case IT_LONG:
{
szResult = NumPicture( szPic + lPicStart, lPic, iPicFlags,
(double) pExp->value.lNumber, &lResultPos );
(double) pExp->item.asLong.value, &lResultPos );
hb_retclen( szResult, lResultPos );
hb_xfree( szResult );
break;
@@ -611,14 +615,14 @@ HARBOUR HB_TRANSFORM( void )
case IT_DOUBLE:
{
szResult = NumPicture( szPic + lPicStart, lPic, iPicFlags,
(double) pExp->value.dNumber, &lResultPos );
(double) pExp->item.asDouble.value, &lResultPos );
hb_retclen( szResult, lResultPos);
hb_xfree( szResult );
break;
}
case IT_DATE:
{ /* Date is currently British; Century is on */
szResult = DatePicture( pExp->value.lDate, iPicFlags, &lResultPos );
szResult = DatePicture( pExp->item.asDate.value, iPicFlags, &lResultPos );
hb_retclen( szResult, lResultPos );
hb_xfree( szResult );
break;
@@ -636,42 +640,42 @@ HARBOUR HB_TRANSFORM( void )
}
else /* No picture supplied */
{
switch( pExp->wType & ~IT_BYREF ) /* Default behaviour */
switch( pExp->type & ~IT_BYREF ) /* Default behaviour */
{
case IT_STRING:
{
hb_retclen( pExp->value.szText, pExp->wLength);
hb_retclen( pExp->item.asString.value, pExp->item.asString.length);
break;
}
case IT_LOGICAL:
{
hb_retclen( pExp->value.iLogical ? "T" : "F", 1);
hb_retclen( pExp->item.asLogical.value ? "T" : "F", 1);
break;
}
case IT_INTEGER:
{
pItem = NumDefault( (double) pExp->value.iNumber );
hb_retclen( pItem->value.szText, pItem->wLength );
pItem = NumDefault( (double) pExp->item.asInteger.value );
hb_retclen( pItem->item.asString.value, pItem->item.asInteger.length );
ItemRelease( pItem );
break;
}
case IT_LONG:
{
pItem = NumDefault( (double) pExp->value.lNumber );
hb_retclen( pItem->value.szText, pItem->wLength );
pItem = NumDefault( (double) pExp->item.asLong.value );
hb_retclen( pItem->item.asString.value, pItem->item.asLong.length );
ItemRelease( pItem );
break;
}
case IT_DOUBLE:
{
pItem = NumDefault( (double) pExp->value.dNumber );
hb_retclen( pItem->value.szText, pItem->wLength );
pItem = NumDefault( (double) pExp->item.asDouble.value );
hb_retclen( pItem->item.asString.value, pItem->item.asDouble.length );
ItemRelease( pItem );
break;
}
case IT_DATE:
{
szResult = DatePicture( pExp->value.lDate, iPicFlags, &lResultPos );
szResult = DatePicture( pExp->item.asDate.value, iPicFlags, &lResultPos );
hb_retclen( szResult, lResultPos );
hb_xfree( szResult );
break;

8
harbour/source/tools/stringsx.c
View File

@@ -78,12 +78,10 @@ HARBOUR HB_STRTOKEN( void )
HARBOUR HB_ROT13( void )
{
PHB_ITEM pText = hb_param(1, IT_STRING);
if( pText )
if( ISCHAR(1) )
{
char *szText = pText->value.szText;
long i, lLen = pText->wLength;
char *szText = hb_parc( 1 );
ULONG i, lLen = hb_parclen( 1 );
char *szResult = (char*)hb_xgrab(lLen + 1);
for( i = 0; i < lLen; i++ )

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

@@ -75,7 +75,7 @@ void Or( void ); /* performs the logical OR on the latest two value
void Plus( void ); /* sums the latest two values on the stack, removes them and leaves the result */
long PopDate( void ); /* pops the stack latest value and returns its date value as a LONG */
void PopDefStat( WORD wStatic ); /* pops the stack latest value onto a static as default init */
double PopDouble( void ); /* pops the stack latest value and returns its double numeric format value */
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 */
double PopNumber( void ); /* pops the stack latest value and returns its numeric value */
@@ -121,12 +121,12 @@ void StackPush( void ); /* pushes an item on to the stack */
void StackInit( void ); /* initializes the stack */
void StackShow( void ); /* show the types of the items on the stack for debugging purposes */
PCODEBLOCK CodeblockNew( BYTE *, WORD, PSYMBOL, int, WORD );
void CodeblockDelete( PCODEBLOCK );
PHB_ITEM CodeblockGetVar( PHB_ITEM, SHORT );
void CodeblockEvaluate( PCODEBLOCK );
HB_CODEBLOCK_PTR CodeblockNew( BYTE *, WORD, PSYMBOL, int, WORD );
void CodeblockDelete( HB_CODEBLOCK_PTR );
PHB_ITEM CodeblockGetVar( PHB_ITEM, LONG );
void CodeblockEvaluate( HB_CODEBLOCK_PTR );
void CodeblockCopy( PHB_ITEM, PHB_ITEM );
void CodeblockDetach( PCODEBLOCK );
void CodeblockDetach( HB_CODEBLOCK_PTR );
void InitSymbolTable( void ); /* initialization of runtime support symbols */
@@ -191,9 +191,9 @@ BYTE bErrorLevel = 0; /* application exit errorlevel */
iHB_DEBUG += ( int ) DontDiscardForceLink; /* just to avoid warnings from the C compiler */
HB_DEBUG( "main\n" );
aStatics.wType = IT_NIL;
errorBlock.wType = IT_NIL;
stack.Return.wType = IT_NIL;
aStatics.type = IT_NIL;
errorBlock.type = IT_NIL;
stack.Return.type = IT_NIL;
StackInit();
NewDynSym( &symEval ); /* initialize dynamic symbol for evaluating codeblocks */
hb_setInitialize(); /* initialize Sets */
@@ -577,7 +577,7 @@ void VirtualMachine( PBYTE pCode, PSYMBOL pSymbols )
default:
printf( "The Harbour virtual machine can't run yet this PRG\n(unsuported pcode opcode: %i)\n", bCode );
printf( "Line number %i in %s", stack.pBase->wLine, stack.pBase->value.pSymbol->szName );
printf( "Line number %i in %s", stack.pBase->item.asSymbol.lineno, stack.pBase->item.asSymbol.value->szName );
exit( 1 );
break;
}
@@ -596,7 +596,7 @@ void And( void )
if( IS_LOGICAL( pItem1 ) && IS_LOGICAL( pItem2 ) )
{
iResult = pItem1->value.iLogical && pItem2->value.iLogical;
iResult = pItem1->item.asLogical.value && pItem2->item.asLogical.value;
StackPop();
StackPop();
PushLogical( iResult );
@@ -632,13 +632,13 @@ void ArrayPut( void )
ULONG ulIndex;
if( IS_INTEGER( pIndex ) )
ulIndex = pIndex->value.iNumber;
ulIndex = pIndex->item.asInteger.value;
else if( IS_LONG( pIndex ) )
ulIndex = pIndex->value.lNumber;
ulIndex = pIndex->item.asLong.value;
else if( IS_DOUBLE( pIndex ) )
ulIndex = pIndex->value.dNumber;
ulIndex = pIndex->item.asDouble.value;
else ;
/* QUESTION: Should we raise an error here ? */
@@ -653,11 +653,12 @@ void Dec( void )
{
double dNumber;
LONG lDate;
WORD wDec;
if( IS_NUMERIC( stack.pPos - 1 ) )
{
dNumber = PopDouble();
PushNumber( --dNumber, stack.pPos->wDec );
dNumber = PopDouble( &wDec );
PushNumber( --dNumber, wDec );
}
else if( IS_DATE( stack.pPos - 1 ) )
{
@@ -669,19 +670,20 @@ void Dec( void )
void Div( void )
{
double d2 = PopDouble();
double d1 = PopDouble();
WORD wDec1, wDec2;
double d2 = PopDouble( &wDec2 );
double d1 = PopDouble( &wDec1 );
PushNumber( d1 / d2, hb_set.HB_SET_DECIMALS );
PushNumber( d1 / d2, (wDec1>wDec2) ? wDec1 : wDec2 );
}
void Do( WORD wParams )
{
PHB_ITEM pItem = stack.pPos - wParams - 2;
PSYMBOL pSym = pItem->value.pSymbol;
WORD wStackBase = stack.pBase - stack.pItems; /* as the stack memory block could change */
WORD wItemIndex = pItem - stack.pItems;
PHB_ITEM pSelf = stack.pPos - wParams - 1;
PHB_ITEM pItem = stack.pPos - wParams - 2; /* procedure name */
PSYMBOL 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 */
HARBOURFUNC pFunc;
int iStatics = stack.iStatics; /* Return iStatics position */
@@ -699,10 +701,10 @@ void Do( WORD wParams )
exit( 1 );
}
pItem->wLine = 0;
pItem->wParams = wParams;
stack.pBase = stack.pItems + pItem->wBase;
pItem->wBase = wStackBase;
pItem->item.asSymbol.lineno = 0;
pItem->item.asSymbol.paramcnt = wParams;
stack.pBase = stack.pItems + pItem->item.asSymbol.stackbase;
pItem->item.asSymbol.stackbase = wStackBase;
HB_DEBUG2( "Do with %i params\n", wParams );
@@ -748,7 +750,7 @@ HARBOUR DoBlock( void )
}
/* Check for valid count of parameters */
iParam =pBlock->wParams -hb_pcount();
iParam =pBlock->item.asBlock.paramcnt -hb_pcount();
/* add missing parameters */
while( iParam-- > 0 )
PushNil();
@@ -756,9 +758,9 @@ HARBOUR DoBlock( void )
/* set pBaseCB to point to local variables of a function where
* the codeblock was defined
*/
stack.pBase->wLine =pBlock->wLine;
stack.pBase->item.asSymbol.lineno =pBlock->item.asBlock.lineno;
CodeblockEvaluate( (PCODEBLOCK)pBlock->value.pCodeblock );
CodeblockEvaluate( pBlock->item.asBlock.value );
/* restore stack pointers */
stack.pBase = stack.pItems + wStackBase;
@@ -815,6 +817,7 @@ void Equal( BOOL bExact )
PHB_ITEM pItem2 = stack.pPos - 1;
PHB_ITEM pItem1 = stack.pPos - 2;
int i;
WORD wDec;
if( IS_NIL( pItem1 ) && IS_NIL( pItem2 ) )
{
@@ -842,12 +845,12 @@ void Equal( BOOL bExact )
PushLogical( PopLogical() == PopLogical() );
else if( IS_NUMERIC( pItem1 ) && IS_NUMERIC( pItem2 ) )
PushLogical( PopDouble() == PopDouble() );
PushLogical( PopDouble(&wDec) == PopDouble(&wDec) );
else if( IS_OBJECT( pItem1 ) && hb_isMessage( pItem1, "==" ) )
OperatorCall( pItem1, pItem2, "==" );
else if( pItem1->wType != pItem2->wType )
else if( pItem1->type != pItem2->type )
{
printf( "types not match on equal operation\n" );
exit( 1 );
@@ -867,12 +870,13 @@ void ForTest( void ) /* Test to check the end point of the FOR */
{
double dStep;
int iEqual;
WORD wDec;
if( IS_NUMERIC( stack.pPos - 1 ) )
{
dStep = PopNumber();
wDec = stack.pPos->wDec;
WORD wDec;
dStep = PopDouble( &wDec );
if( dStep > 0 ) /* Positive loop. Use LESS */
Less();
else if( dStep < 0 ) /* Negative loop. Use GREATER */
@@ -894,7 +898,7 @@ void Frame( BYTE bLocals, BYTE bParams )
HB_DEBUG( "Frame\n" );
if( iTotal )
for( i = 0; i < ( iTotal - stack.pBase->wParams ); i++ )
for( i = 0; i < ( iTotal - stack.pBase->item.asSymbol.paramcnt ); i++ )
PushNil();
}
@@ -905,7 +909,7 @@ void FuncPtr( void ) /* pushes a function address pointer. Removes the symbol f
if( IS_SYMBOL( pItem ) )
{
StackPop();
PushLong( ( ULONG ) pItem->value.pSymbol->pFunPtr );
PushLong( ( ULONG ) pItem->item.asSymbol.value->pFunPtr );
}
else
{
@@ -926,10 +930,10 @@ void GenArray( WORD wElements ) /* generates a wElements Array and fills it from
HB_ITEM itArray;
WORD w;
itArray.wType = IT_NIL;
itArray.type = IT_NIL;
hb_arrayNew( &itArray, wElements );
for( w = 0; w < wElements; w++ )
ItemCopy( ( ( PBASEARRAY ) itArray.value.pBaseArray )->pItems + w,
ItemCopy( itArray.item.asArray.value->pItems + w,
stack.pPos - wElements + w );
for( w = 0; w < wElements; w++ )
@@ -980,7 +984,7 @@ void Greater( void )
hb_isMessage( stack.pPos - 2, ">" ) )
OperatorCall( stack.pPos - 2, stack.pPos - 1, ">" );
else if( ( stack.pPos - 2 )->wType != ( stack.pPos - 1 )->wType )
else if( ( stack.pPos - 2 )->type != ( stack.pPos - 1 )->type )
{
printf( "types not match on greater operation\n" );
exit( 1 );
@@ -1027,7 +1031,7 @@ void GreaterEqual( void )
hb_isMessage( stack.pPos - 2, ">=" ) )
OperatorCall( stack.pPos - 2, stack.pPos - 1, ">=" );
else if( ( stack.pPos - 2 )->wType != ( stack.pPos - 1 )->wType )
else if( ( stack.pPos - 2 )->type != ( stack.pPos - 1 )->type )
{
printf( "types not match on greaterequal operation\n" );
exit( 1 );
@@ -1039,11 +1043,12 @@ void Inc( void )
double dNumber;
LONG lDate;
PHB_ITEM pError;
WORD wDec;
if( IS_NUMERIC( stack.pPos - 1 ) )
{
dNumber = PopDouble();
PushNumber( ++dNumber, stack.pPos->wDec );
dNumber = PopDouble( &wDec );
PushNumber( ++dNumber, wDec );
}
else if( IS_DATE( stack.pPos - 1 ) )
{
@@ -1063,23 +1068,23 @@ void ItemRelease( PHB_ITEM pItem )
{
if( IS_STRING( pItem ) )
{
if( pItem->value.szText )
if( pItem->item.asString.value )
{
hb_xfree( pItem->value.szText );
pItem->value.szText = 0;
hb_xfree( pItem->item.asString.value );
pItem->item.asString.value = NULL;
}
pItem->wLength = 0;
pItem->item.asString.length = 0;
}
else if( IS_ARRAY( pItem ) && pItem->value.pBaseArray )
else if( IS_ARRAY( pItem ) && pItem->item.asArray.value )
{
if( --( ( PBASEARRAY ) pItem->value.pBaseArray )->wHolders == 0 )
if( --( pItem->item.asArray.value )->wHolders == 0 )
hb_arrayRelease( pItem );
}
else if( IS_BLOCK( pItem ) )
{
CodeblockDelete( ( PCODEBLOCK ) pItem->value.pCodeblock );
CodeblockDelete( pItem->item.asBlock.value );
}
pItem->wType = IT_NIL;
pItem->type = IT_NIL;
}
void Instring( void )
@@ -1091,9 +1096,9 @@ void Instring( void )
if( IS_STRING( pItem1 ) && IS_STRING( pItem2 ) )
{
for( iResult = 0, ul = 0; !iResult && ul < (ULONG) pItem1->wLength; ul++ )
iResult = hb_strAt( pItem1->value.szText + ul, 1,
pItem2->value.szText, pItem2->wLength );
for( iResult = 0, ul = 0; !iResult && ul < pItem1->item.asString.length; ul++ )
iResult = hb_strAt( pItem1->item.asString.value + ul, 1,
pItem2->item.asString.value, pItem2->item.asString.length );
StackPop();
StackPop();
PushLogical( iResult == 0 ? 0 : 1 );
@@ -1122,13 +1127,13 @@ void ItemCopy( PHB_ITEM pDest, PHB_ITEM pSource )
if( IS_STRING( pSource ) )
{
pDest->value.szText = ( char * ) hb_xgrab( pSource->wLength + 1 );
memcpy( pDest->value.szText, pSource->value.szText, pSource->wLength );
pDest->value.szText[ pSource->wLength ] = 0;
pDest->item.asString.value = ( char * ) hb_xgrab( pSource->item.asString.length + 1 );
memcpy( pDest->item.asString.value, pSource->item.asString.value, pSource->item.asString.length );
pDest->item.asString.value[ pSource->item.asString.length ] = 0;
}
else if( IS_ARRAY( pSource ) )
( ( PBASEARRAY ) pSource->value.pBaseArray )->wHolders++;
( pSource->item.asArray.value )->wHolders++;
else if( IS_BLOCK( pSource ) )
{
@@ -1176,7 +1181,7 @@ void Less( void )
hb_isMessage( stack.pPos - 2, "<" ) )
OperatorCall( stack.pPos - 2, stack.pPos - 1, "<" );
else if( ( stack.pPos - 2 )->wType != ( stack.pPos - 1 )->wType )
else if( ( stack.pPos - 2 )->type != ( stack.pPos - 1 )->type )
{
printf( "types not match on less operation\n" );
exit( 1 );
@@ -1223,7 +1228,7 @@ void LessEqual( void )
hb_isMessage( stack.pPos - 2, "<=" ) )
OperatorCall( stack.pPos - 2, stack.pPos - 1, "<=" );
else if( ( stack.pPos - 2 )->wType != ( stack.pPos - 1 )->wType )
else if( ( stack.pPos - 2 )->type != ( stack.pPos - 1 )->type )
{
printf( "types not match on lessequal operation\n" );
exit( 1 );
@@ -1234,29 +1239,29 @@ void Message( PSYMBOL pSymMsg ) /* sends a message to an object */
{
ItemCopy( stack.pPos, stack.pPos - 1 ); /* moves the object forward */
ItemRelease( stack.pPos - 1 );
( stack.pPos - 1 )->wType = IT_SYMBOL;
( stack.pPos - 1 )->value.pSymbol = pSymMsg;
( stack.pPos - 1 )->wBase = ( stack.pPos - 1 ) - stack.pItems;
( stack.pPos - 1 )->type = IT_SYMBOL;
( stack.pPos - 1 )->item.asSymbol.value = pSymMsg;
( stack.pPos - 1 )->item.asSymbol.stackbase = ( stack.pPos - 1 ) - stack.pItems;
StackPush();
HB_DEBUG2( "Message: %s\n", pSymMsg->szName );
}
void Line( WORD wLine )
{
stack.pBase->wLine = wLine;
stack.pBase->item.asSymbol.lineno = wLine;
HB_DEBUG( "line\n" );
}
void Negate( void )
{
if( IS_INTEGER( stack.pPos - 1 ) )
( stack.pPos - 1 )->value.iNumber = -( stack.pPos - 1 )->value.iNumber;
( stack.pPos - 1 )->item.asInteger.value = -( stack.pPos - 1 )->item.asInteger.value;
else if( IS_LONG( stack.pPos - 1 ) )
( stack.pPos - 1 )->value.lNumber = -( stack.pPos - 1 )->value.lNumber;
( stack.pPos - 1 )->item.asLong.value = -( stack.pPos - 1 )->item.asLong.value;
else if( IS_DOUBLE( stack.pPos - 1 ) )
( stack.pPos - 1 )->value.dNumber = -( stack.pPos - 1 )->value.dNumber;
( stack.pPos - 1 )->item.asDouble.value = -( stack.pPos - 1 )->item.asDouble.value;
}
void Not( void )
@@ -1264,7 +1269,7 @@ void Not( void )
PHB_ITEM pItem = stack.pPos - 1;
if( IS_LOGICAL( pItem ) )
pItem->value.iLogical = ! pItem->value.iLogical;
pItem->item.asLogical.value = ! pItem->item.asLogical.value;
else
; /* TODO: Raise an error here ? */
}
@@ -1274,6 +1279,7 @@ void NotEqual( void )
PHB_ITEM pItem2 = stack.pPos - 1;
PHB_ITEM pItem1 = stack.pPos - 2;
int i;
WORD wDec;
if( IS_NIL( pItem1 ) && IS_NIL( pItem2 ) )
{
@@ -1298,7 +1304,7 @@ void NotEqual( void )
}
else if( IS_NUMERIC( pItem1 ) && IS_NUMERIC( pItem2 ) )
PushLogical( PopDouble() != PopDouble() );
PushLogical( PopDouble( &wDec ) != PopDouble( &wDec ) );
else if( IS_LOGICAL( pItem1 ) && IS_LOGICAL( pItem2 ) )
PushLogical( PopLogical() != PopLogical() );
@@ -1306,7 +1312,7 @@ void NotEqual( void )
else if( IS_OBJECT( pItem1 ) && hb_isMessage( pItem1, "!=" ) )
OperatorCall( pItem1, pItem2, "!=" );
else if( pItem1->wType != pItem2->wType )
else if( pItem1->type != pItem2->type )
{
printf( "types not match on equal operation\n" );
exit( 1 );
@@ -1324,10 +1330,8 @@ void Minus( void )
if( IS_NUMERIC( stack.pPos - 1 ) && IS_NUMERIC( stack.pPos - 2 ) )
{
WORD wDec2, wDec1;
dNumber2 = PopNumber();
wDec2 = stack.pPos->wDec;
dNumber1 = PopNumber();
wDec1 = stack.pPos->wDec;
dNumber2 = PopDouble( &wDec2 );
dNumber1 = PopDouble( &wDec1 );
PushNumber( dNumber1 - dNumber2, (wDec1 > wDec2) ? wDec1 : wDec2 );
}
else if( IS_DATE( stack.pPos - 1 ) && IS_DATE( stack.pPos - 2 ) )
@@ -1351,19 +1355,18 @@ void Minus( void )
void Modulus( void )
{
double d2 = PopDouble();
double d1 = PopDouble();
WORD wDec1, wDec2;
double d2 = PopDouble( &wDec2 );
double d1 = PopDouble( &wDec1 );
PushNumber( ( long ) d1 % ( long ) d2, hb_set.HB_SET_DECIMALS );
PushNumber( ( long ) d1 % ( long ) d2, (wDec1>wDec2) ? wDec1 : wDec2 );
}
void Mult( void )
{
WORD wDec2, wDec1;
double d1, d2 = PopDouble();
wDec2 = stack.pPos->wDec;
d1 = PopDouble();
wDec1 = stack.pPos->wDec;
double d2 = PopDouble( &wDec2 );
double d1 = PopDouble( &wDec1 );
PushNumber( d1 * d2, wDec1 + wDec2 );
}
@@ -1385,7 +1388,7 @@ void Or( void )
if( IS_LOGICAL( pItem1 ) && IS_LOGICAL( pItem2 ) )
{
iResult = pItem1->value.iLogical || pItem2->value.iLogical;
iResult = pItem1->item.asLogical.value || pItem2->item.asLogical.value;
StackPop();
StackPop();
PushLogical( iResult );
@@ -1408,15 +1411,15 @@ void Plus( void )
if( IS_STRING( pItem1 ) && IS_STRING( pItem2 ) )
{
pItem1->value.szText = (char*)hb_xrealloc( pItem1->value.szText, pItem1->wLength + pItem2->wLength + 1 );
memcpy( pItem1->value.szText + pItem1->wLength,
pItem2->value.szText, pItem2->wLength );
pItem1->wLength += pItem2->wLength;
pItem1->value.szText[ pItem1->wLength ] = 0;
if( pItem2->value.szText )
pItem1->item.asString.value = (char*)hb_xrealloc( pItem1->item.asString.value, pItem1->item.asString.length + pItem2->item.asString.length + 1 );
memcpy( pItem1->item.asString.value+ pItem1->item.asString.length,
pItem2->item.asString.value, pItem2->item.asString.length );
pItem1->item.asString.length += pItem2->item.asString.length;
pItem1->item.asString.value[ pItem1->item.asString.length ] = 0;
if( pItem2->item.asString.value )
{
hb_xfree( pItem2->value.szText );
pItem2->value.szText = 0;
hb_xfree( pItem2->item.asString.value );
pItem2->item.asString.value = NULL;
}
StackPop();
return;
@@ -1425,12 +1428,10 @@ void Plus( void )
else if( IS_NUMERIC( pItem1 ) && IS_NUMERIC( pItem2 ) )
{
WORD wDec2, wDec1;
dNumber2 = PopDouble();
wDec2 = stack.pPos->wDec;
dNumber1 = PopDouble();
wDec1 = stack.pPos->wDec;
dNumber2 = PopDouble( &wDec2 );
dNumber1 = PopDouble( &wDec1 );
PushNumber( dNumber1 + dNumber2, (wDec1 > wDec2) ? wDec1 : wDec2 );
PushNumber( dNumber1 + dNumber2, (wDec1>wDec2) ? wDec1 : wDec2 );
}
else if( IS_DATE( pItem1 ) && IS_DATE( pItem2 ) )
@@ -1442,7 +1443,8 @@ void Plus( void )
else if( IS_DATE( pItem1 ) && IS_NUMERIC( pItem2 ) )
{
dNumber2 = PopDouble();
WORD wDec;
dNumber2 = PopDouble( &wDec );
lDate1 = PopDate();
PushDate( lDate1 + dNumber2 );
}
@@ -1459,7 +1461,7 @@ long PopDate( void )
StackPop();
if( IS_DATE( stack.pPos ) )
return stack.pPos->value.lDate;
return stack.pPos->item.asDate.value;
else
{
printf( "incorrect item value trying to Pop a date value\n" );
@@ -1473,41 +1475,44 @@ void PopDefStat( WORD wStatic ) /* Pops a default value to a STATIC */
PHB_ITEM pStatic;
StackPop();
pStatic = ( ( PBASEARRAY ) aStatics.value.pBaseArray )->pItems + stack.iStatics +
pStatic = aStatics.item.asArray.value->pItems + stack.iStatics +
wStatic - 1;
if( IS_BYREF( pStatic ) )
{
if( ( stack.pItems + pStatic->value.wItem )->wType == IT_NIL )
if( ( stack.pItems + pStatic->item.asRefer.value )->type == IT_NIL )
/* Only initialize when NIL */
ItemCopy( stack.pItems + pStatic->value.wItem, stack.pPos );
ItemCopy( stack.pItems + pStatic->item.asRefer.value, stack.pPos );
}
else
if( pStatic->wType == IT_NIL ) /* Only initialize when NIL */
if( pStatic->type == IT_NIL ) /* Only initialize when NIL */
ItemCopy( pStatic, stack.pPos );
ItemRelease( stack.pPos );
HB_DEBUG( "PopDefStat\n" );
}
double PopDouble( void )
double PopDouble( WORD *pwDec )
{
double d;
StackPop();
switch( stack.pPos->wType & ~IT_BYREF )
switch( stack.pPos->type & ~IT_BYREF )
{
case IT_INTEGER:
d = stack.pPos->value.iNumber;
d = stack.pPos->item.asInteger.value;
*pwDec =0;
break;
case IT_LONG:
d = stack.pPos->value.lNumber;
d = stack.pPos->item.asLong.value;
*pwDec =0;
break;
case IT_DOUBLE:
d = stack.pPos->value.dNumber;
d = stack.pPos->item.asDouble.value;
*pwDec =stack.pPos->item.asDouble.decimal;
break;
default:
@@ -1531,11 +1536,11 @@ void PopLocal( SHORT iLocal )
pLocal = stack.pBase + 1 + iLocal;
if( IS_BYREF( pLocal ) )
{
if( pLocal->value.iNumber >= 0)
ItemCopy( stack.pItems + pLocal->value.wItem, stack.pPos );
if( pLocal->item.asRefer.value >= 0)
ItemCopy( stack.pItems + pLocal->item.asRefer.value, stack.pPos );
else
/* local variable referenced in a codeblock */
ItemCopy( CodeblockGetVar( stack.pItems +pLocal->wBase +1, pLocal->value.wItem ), stack.pPos );
ItemCopy( CodeblockGetVar( stack.pItems +pLocal->item.asRefer.stackbase +1, pLocal->item.asRefer.value ), stack.pPos );
}
else
ItemCopy( pLocal, stack.pPos );
@@ -1555,7 +1560,7 @@ int PopLogical( void )
StackPop();
if( IS_LOGICAL( stack.pPos ) )
return stack.pPos->value.iLogical;
return stack.pPos->item.asLogical.value;
else
{
pError = hb_errNew();
@@ -1573,18 +1578,18 @@ double PopNumber( void )
StackPop();
switch( pItem->wType & ~IT_BYREF )
switch( pItem->type & ~IT_BYREF )
{
case IT_INTEGER:
dNumber = ( double ) pItem->value.iNumber;
dNumber = ( double ) pItem->item.asInteger.value;
break;
case IT_LONG:
dNumber = ( double ) pItem->value.lNumber;
dNumber = ( double ) pItem->item.asLong.value;
break;
case IT_DOUBLE:
dNumber = pItem->value.dNumber;
dNumber = pItem->item.asDouble.value;
break;
default:
@@ -1600,11 +1605,11 @@ void PopStatic( WORD wStatic )
PHB_ITEM pStatic;
StackPop();
pStatic = ( ( PBASEARRAY ) aStatics.value.pBaseArray )->pItems + stack.iStatics +
pStatic = aStatics.item.asArray.value->pItems + stack.iStatics +
wStatic - 1;
if( IS_BYREF( pStatic ) )
ItemCopy( stack.pItems + pStatic->value.wItem, stack.pPos );
ItemCopy( stack.pItems + pStatic->item.asRefer.value, stack.pPos );
else
ItemCopy( pStatic, stack.pPos );
@@ -1614,17 +1619,18 @@ void PopStatic( WORD wStatic )
void Power( void )
{
double d2 = PopDouble();
double d1 = PopDouble();
WORD wDec1, wDec2;
double d2 = PopDouble( &wDec2 );
double d1 = PopDouble( &wDec1 );
PushNumber( pow( d1, d2 ), hb_set.HB_SET_DECIMALS );
PushNumber( pow( d1, d2 ), (wDec1>wDec2) ? wDec1 : wDec2 );
}
void PushLogical( int iTrueFalse )
{
ItemRelease( stack.pPos );
stack.pPos->wType = IT_LOGICAL;
stack.pPos->value.iLogical = iTrueFalse;
stack.pPos->type = IT_LOGICAL;
stack.pPos->item.asLogical.value = iTrueFalse;
StackPush();
HB_DEBUG( "PushLogical\n" );
}
@@ -1639,18 +1645,18 @@ void PushLocal( SHORT iLocal )
pLocal = stack.pBase + 1 + iLocal;
if( IS_BYREF( pLocal ) )
{
if( pLocal->value.iNumber >= 0 )
ItemCopy( stack.pPos, stack.pItems + pLocal->value.wItem );
if( pLocal->item.asRefer.value >= 0 )
ItemCopy( stack.pPos, stack.pItems + pLocal->item.asRefer.value );
else
/* local variable referenced in a codeblock */
ItemCopy( stack.pPos, CodeblockGetVar( stack.pItems + pLocal->wBase +1, pLocal->value.wItem ) );
ItemCopy( stack.pPos, CodeblockGetVar( stack.pItems + pLocal->item.asRefer.stackbase +1, pLocal->item.asRefer.value) );
}
else
ItemCopy( stack.pPos, pLocal );
}
else
/* local variable referenced in a codeblock */
ItemCopy( stack.pPos, CodeblockGetVar( stack.pBase + 1, iLocal ) );
ItemCopy( stack.pPos, CodeblockGetVar( stack.pBase + 1, (LONG)iLocal ) );
StackPush();
HB_DEBUG2( "PushLocal %i\n", iLocal );
}
@@ -1658,16 +1664,17 @@ void PushLocal( SHORT iLocal )
void PushLocalByRef( SHORT iLocal )
{
ItemRelease( stack.pPos );
stack.pPos->wType = IT_BYREF;
stack.pPos->type = IT_BYREF;
/* we store its stack offset instead of a pointer to support a dynamic stack */
if( iLocal >= 0 )
/* local variable or local parameter */
stack.pPos->value.wItem = stack.pBase + 1 + iLocal - stack.pItems;
/* store the position of referenced local variable on the eval stack */
stack.pPos->item.asRefer.value = stack.pBase + 1 + iLocal - stack.pItems;
else
{
/* local variable referenced in a codeblock */
stack.pPos->value.iNumber = iLocal;
stack.pPos->wBase = stack.pBase - stack.pItems;
stack.pPos->item.asRefer.value = iLocal;
stack.pPos->item.asRefer.stackbase = stack.pBase - stack.pItems;
}
StackPush();
@@ -1698,7 +1705,7 @@ void PushNumber( double dNumber, WORD wDec )
void PushStatic( WORD wStatic )
{
ItemCopy( stack.pPos, ( ( PBASEARRAY ) aStatics.value.pBaseArray )->pItems +
ItemCopy( stack.pPos, aStatics.item.asArray.value->pItems +
stack.iStatics + wStatic - 1 );
StackPush();
HB_DEBUG2( "PushStatic %i\n", wStatic );
@@ -1712,9 +1719,9 @@ void PushString( char * szText, WORD wLength )
szTemp[ wLength ] = 0;
ItemRelease( stack.pPos );
stack.pPos->wType = IT_STRING;
stack.pPos->wLength = wLength;
stack.pPos->value.szText = szTemp;
stack.pPos->type = IT_STRING;
stack.pPos->item.asString.length = wLength;
stack.pPos->item.asString.value = szTemp;
StackPush();
HB_DEBUG( "PushString\n" );
}
@@ -1722,9 +1729,9 @@ void PushString( char * szText, WORD wLength )
void PushSymbol( PSYMBOL pSym )
{
ItemRelease( stack.pPos );
stack.pPos->wType = IT_SYMBOL;
stack.pPos->value.pSymbol = pSym;
stack.pPos->wBase = stack.pPos - stack.pItems;
stack.pPos->type = IT_SYMBOL;
stack.pPos->item.asSymbol.value = pSym;
stack.pPos->item.asSymbol.stackbase = stack.pPos - stack.pItems;
StackPush();
HB_DEBUG2( "PushSymbol: %s\n", pSym->szName );
}
@@ -1739,15 +1746,15 @@ void Push( PHB_ITEM pItem )
void PushBlock( BYTE * pCode, WORD wSize, WORD wParam, PSYMBOL pSymbols )
{
ItemRelease( stack.pPos );
stack.pPos->wType = IT_BLOCK;
stack.pPos->value.pCodeblock = CodeblockNew( pCode, wSize, pSymbols,
stack.pPos->type = IT_BLOCK;
stack.pPos->item.asBlock.value = CodeblockNew( pCode, wSize, pSymbols,
stack.iStatics, stack.pBase - stack.pItems );
/* store the stack base of function where the codeblock was defined */
stack.pPos->wBase = stack.pBase - stack.pItems;
stack.pPos->item.asBlock.stackbase = stack.pBase - stack.pItems;
/* store the number of expected parameters */
stack.pPos->wParams = wParam;
stack.pPos->item.asBlock.paramcnt = wParam;
/* store the line number where the codeblock was defined */
stack.pPos->wLine = stack.pBase->wLine;
stack.pPos->item.asBlock.lineno = stack.pBase->item.asSymbol.lineno;
StackPush();
HB_DEBUG( "PushBlock\n" );
}
@@ -1755,8 +1762,8 @@ void PushBlock( BYTE * pCode, WORD wSize, WORD wParam, PSYMBOL pSymbols )
void PushDate( LONG lDate )
{
ItemRelease( stack.pPos );
stack.pPos->wType = IT_DATE;
stack.pPos->value.lDate = lDate;
stack.pPos->type = IT_DATE;
stack.pPos->item.asDate.value = lDate;
StackPush();
HB_DEBUG( "PushDate\n" );
}
@@ -1764,11 +1771,11 @@ void PushDate( LONG lDate )
void PushDouble( double dNumber, WORD wDec )
{
ItemRelease( stack.pPos );
stack.pPos->wType = IT_DOUBLE;
stack.pPos->value.dNumber = dNumber;
if( dNumber >= 10000000000.0 ) stack.pPos->wLength = 20;
else stack.pPos->wLength = 10;
stack.pPos->wDec = (wDec > 9) ? 9 : wDec;
stack.pPos->type = IT_DOUBLE;
stack.pPos->item.asDouble.value = dNumber;
if( dNumber >= 10000000000.0 ) stack.pPos->item.asDouble.length = 20;
else stack.pPos->item.asDouble.length = 10;
stack.pPos->item.asDouble.decimal = (wDec > 9) ? 9 : wDec;
StackPush();
HB_DEBUG( "PushDouble\n" );
}
@@ -1776,10 +1783,10 @@ void PushDouble( double dNumber, WORD wDec )
void PushInteger( int iNumber )
{
ItemRelease( stack.pPos );
stack.pPos->wType = IT_INTEGER;
stack.pPos->value.iNumber = iNumber;
stack.pPos->wLength = 10;
stack.pPos->wDec = 0;
stack.pPos->type = IT_INTEGER;
stack.pPos->item.asInteger.value = iNumber;
stack.pPos->item.asInteger.length = 10;
stack.pPos->item.asInteger.decimal = 0;
StackPush();
HB_DEBUG( "PushInteger\n" );
}
@@ -1787,10 +1794,10 @@ void PushInteger( int iNumber )
void PushLong( long lNumber )
{
ItemRelease( stack.pPos );
stack.pPos->wType = IT_LONG;
stack.pPos->value.lNumber = lNumber;
stack.pPos->wLength = 10;
stack.pPos->wDec = 0;
stack.pPos->type = IT_LONG;
stack.pPos->item.asLong.value = lNumber;
stack.pPos->item.asLong.length = 10;
stack.pPos->item.asLong.decimal = 0;
StackPush();
HB_DEBUG( "PushLong\n" );
}
@@ -1799,8 +1806,8 @@ void RetValue( void )
{
StackPop();
ItemCopy( &stack.Return, stack.pPos );
if( stack.Return.wType == IT_BLOCK )
CodeblockDetach( (PCODEBLOCK)stack.Return.value.pCodeblock );
if( stack.Return.type == IT_BLOCK )
CodeblockDetach( stack.Return.item.asBlock.value );
HB_DEBUG( "RetValue\n" );
}
@@ -1850,7 +1857,7 @@ void StackPush( void )
/* now, push it: */
stack.pPos++;
stack.pPos->wType = IT_NIL;
stack.pPos->type = IT_NIL;
return;
}
@@ -1869,14 +1876,14 @@ void StackInit( void )
for( p = stack.pBase; p <= stack.pPos; p++ )
{
switch( p->wType )
switch( p->type )
{
case IT_NIL:
printf( "NIL " );
break;
case IT_ARRAY:
if( ( ( PBASEARRAY ) p->value.pBaseArray )->wClass )
if( p->item.asArray.value->wClass )
printf( "OBJECT " );
else
printf( "ARRAY " );
@@ -1895,14 +1902,15 @@ void StackInit( void )
break;
case IT_LOGICAL:
printf( "LOGICAL[%i] ", p->value.iLogical );
printf( "LOGICAL[%i] ", p->item.asLogical.value );
break;
case IT_LONG:
printf( "LONG" );
break;
case IT_INTEGER:
printf( "INTEGER[%i] ", p->value.iNumber );
printf( "INTEGER[%i] ", p->item.asInteger.value );
break;
case IT_STRING:
@@ -1910,11 +1918,11 @@ void StackInit( void )
break;
case IT_SYMBOL:
printf( "SYMBOL(%s) ", p->value.pSymbol->szName );
printf( "SYMBOL(%s) ", p->item.asSymbol.value->szName );
break;
default:
printf( "UNKNOWN[%i] ", p->wType );
printf( "UNKNOWN[%i] ", p->type );
break;
}
}
@@ -2069,14 +2077,14 @@ HARBOUR HB_LEN( void )
{
pItem = hb_param( 1, IT_ANY );
switch( pItem->wType )
switch( pItem->type )
{
case IT_ARRAY:
hb_retnl( ( ( PBASEARRAY ) pItem->value.pBaseArray )->ulLen );
hb_retnl( pItem->item.asArray.value->ulLen );
break;
case IT_STRING:
hb_retnl( pItem->wLength );
hb_retnl( pItem->item.asString.length );
break;
default:
@@ -2094,10 +2102,10 @@ HARBOUR HB_EMPTY(void)
if( pItem )
{
switch( pItem->wType & ~IT_BYREF )
switch( pItem->type & ~IT_BYREF )
{
case IT_ARRAY:
hb_retl( ( ( PBASEARRAY ) pItem->value.pBaseArray )->ulLen == 0 );
hb_retl( pItem->item.asArray.value->ulLen == 0 );
break;
case IT_STRING:
@@ -2146,10 +2154,10 @@ HARBOUR HB_VALTYPE( void )
{
pItem = hb_param( 1, IT_ANY );
switch( pItem->wType & ~IT_BYREF )
switch( pItem->type & ~IT_BYREF )
{
case IT_ARRAY:
if( ( ( PBASEARRAY ) pItem->value.pBaseArray )->wClass )
if( pItem->item.asArray.value->wClass )
hb_retc( "O" ); /* it is an object */
else
hb_retc( "A" );
@@ -2192,7 +2200,7 @@ HARBOUR HB_ERRORBLOCK(void)
HB_ITEM oldError;
PHB_ITEM pNewErrorBlock = hb_param( 1, IT_BLOCK );
oldError.wType = IT_NIL;
oldError.type = IT_NIL;
ItemCopy( &oldError, &errorBlock );
if( pNewErrorBlock )
@@ -2208,10 +2216,10 @@ HARBOUR HB_PROCNAME(void)
PHB_ITEM pBase = stack.pBase;
while( ( iLevel-- > 0 ) && pBase != stack.pItems )
pBase = stack.pItems + pBase->wBase;
pBase = stack.pItems + pBase->item.asSymbol.stackbase;
if( ( iLevel == -1 ) )
hb_retc( pBase->value.pSymbol->szName );
hb_retc( pBase->item.asSymbol.value->szName );
else
hb_retc( "" );
}
@@ -2222,10 +2230,10 @@ HARBOUR HB_PROCLINE(void)
PHB_ITEM pBase = stack.pBase;
while( ( iLevel-- > 0 ) && pBase != stack.pItems )
pBase = stack.pItems + pBase->wBase;
pBase = stack.pItems + pBase->item.asSymbol.stackbase;
if( iLevel == -1 )
hb_retni( pBase->wLine );
hb_retni( pBase->item.asSymbol.lineno );
else
hb_retni( 0 );
}
@@ -2247,8 +2255,8 @@ HARBOUR HB_ERRORLEVEL(void)
HARBOUR HB_PCOUNT(void)
{
PHB_ITEM pBase = stack.pItems + stack.pBase->wBase;
WORD wRet = pBase->wParams; /* Skip current function */
PHB_ITEM pBase = stack.pItems + stack.pBase->item.asSymbol.stackbase;
WORD wRet = pBase->item.asSymbol.paramcnt; /* Skip current function */
hb_retni( wRet );
}
@@ -2256,10 +2264,10 @@ HARBOUR HB_PCOUNT(void)
HARBOUR HB_PVALUE(void) /* PValue( <nArg> ) */
{
WORD wParam = hb_parni( 1 ); /* Get parameter */
PHB_ITEM pBase = stack.pItems + stack.pBase->wBase;
PHB_ITEM pBase = stack.pItems + stack.pBase->item.asSymbol.stackbase;
/* Skip function + self */
if( wParam && wParam <= pBase->wParams ) /* Valid number */
if( wParam && wParam <= pBase->item.asSymbol.paramcnt ) /* Valid number */
hb_itemReturn( pBase + 1 + wParam );
else
{

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

@@ -56,8 +56,10 @@ HARBOUR HB_MONTH( void );
HARBOUR HB_PCOUNT( void );
HARBOUR HB_REPLICATE( void );
HARBOUR HB_ROW( void );
HARBOUR HB_ROUND( void );
HARBOUR HB_RTRIM( void );
HARBOUR HB_SECONDS( void );
HARBOUR HB_SETPOS( void );
HARBOUR HB_SPACE( void );
HARBOUR HB_SQRT( void );
HARBOUR HB_STOD( void );
@@ -117,12 +119,12 @@ static SYMBOL symbols[] = {
{ "RECNO" , FS_PUBLIC, NULL , 0 },
{ "REPLICATE" , FS_PUBLIC, HB_REPLICATE , 0 },
{ "RLOCK" , FS_PUBLIC, NULL , 0 },
{ "ROUND" , FS_PUBLIC, NULL , 0 },
{ "ROUND" , FS_PUBLIC, HB_ROUND , 0 },
{ "ROW" , FS_PUBLIC, HB_ROW , 0 },
{ "RTRIM" , FS_PUBLIC, HB_RTRIM , 0 },
{ "SECONDS" , FS_PUBLIC, HB_SECONDS , 0 },
{ "SELECT" , FS_PUBLIC, NULL , 0 },
{ "SETPOS" , FS_PUBLIC, NULL , 0 },
{ "SETPOS" , FS_PUBLIC, HB_SETPOS , 0 },
{ "SPACE" , FS_PUBLIC, HB_SPACE , 0 },
{ "SQRT" , FS_PUBLIC, HB_SQRT , 0 },
{ "STOD" , FS_PUBLIC, HB_STOD , 0 },
@@ -144,8 +146,14 @@ static SYMBOL symbols[] = {
void InitSymbolTable( void )
{
/*
* Place here your <modulename>__InitSymbols functions
* Place here your user defined <modulename>__InitSymbols functions
*/
/*
* The symbol tables from runtime support modules start here
*/
#ifdef HARBOUR_STRICT_ANSI_C
Arrays__InitSymbols();
Classes__InitSymbols();
Console__InitSymbols();
@@ -158,8 +166,12 @@ void InitSymbolTable( void )
Math__InitSymbols();
Memotran__InitSymbols();
Set__InitSymbols();
Strings__InitSymbols();
Strings__InitSymbols();
#ifdef HARBOUR_STRICT_CLIPPER_COMPATIBILITY
Strings__InitInfinity
#endif
Transfrm__InitSymbols();
#endif
/*
* The system symbol table with runtime functions HAVE TO be called last

6
harbour/tests/working/linecont.prg
View File

@@ -80,3 +80,9 @@ b ;
RETURN nil
FUNCTION TEST1() ; LOCAL n; IF n==5; n =4; END; RETURN n
FUNCTION TEST2(); LOCAL n
WHILE n<5; n++; END
RETURN n