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

See ChangeLog 19990604-02:22 rglab@imid.med.pl

Browse Source
This commit is contained in:
Ryszard Glab
1999-06-04 01:28:58 +00:00
parent 2f0eb9c7a1
commit baf69575ea
10 changed files with 746 additions and 60 deletions
Download Patch File Download Diff File Expand all files Collapse all files

28
harbour/ChangeLog
View File

@@ -1,3 +1,31 @@
19990604-02:22 Ryszard Glab <rglab@imid.med.pl>
* source/compiler/harbour.y
* corrected "unmatched END" error if BEGIN/END SEQUENCE was used
+ LOOP now loops to the begginig of FOR/NEXT or WHILE statement
+ EXIT now exits from FOR/NEXT or WHILE statement
* source/compiler/harbour.l
* corrected support for the following keywords:
IF, IIF (90 % compatible with Clipper), IN, INCLUDE, INIT, LOCAL, LOOP
* source/vm/hvm.c
local variables passed by reference in a codeblock are handled
correctly now
* include/hberrors.h
+ added new error message
* tests/working/keywords.prg
+ added some new keywords for compatibility testing
+ tests/working/keywords.ch
+ new file for INCLUDE testing
+ doc/codebloc.txt
+ new file with a short description of a codeblock implementation
19990603-19:00 EDT David G. Holm <dholm@jsd-llc.com>
Thanks go to Ryszard Glab <rglab@imid.med.pl>
* makefile.dos

75
harbour/doc/codebloc.txt Normal file
View File

@@ -0,0 +1,75 @@
The Harbour implementation of codeblocks.
Ryszard Glab <rglab@imid.med.pl>
The compilation of a codeblock.
During compile the codeblock is stored in the following form:
- the header
- the stream of pcode bytes
The header stores information about referenced local variables.
+0: the pcode byte for _PUSHBLOCK
+1: the number of bytes that defines a codeblock
+3: number of codeblock parameters (declared between || in a codeblock)
+5: number of used local variables declared in procedure/function where
the codeblock is created
+7: the list of procedure/function local variables positions on the the eval
stack of procedure/function. Every local variable used in a codeblock
occupies 2 bytes in this list.
+x: The stream of pcode bytes follows the header.
+y: the pcode byte for _ENDBLOCK
The evaluation of a codeblock.
Before a codeblock evaluation the virtual machine creates the eval stack
where all codeblock parameters are stored (just like function parameters).
When a codeblock parameter is referenced then its position on the eval stack
is used. When a procedure local variable is referenced then the index into
the table of local variables positions (copied from the header) is used.
The negative value is used as an index to distinguish it from the reference
to a codeblock parameter. The table of local variables positions is created
during creation of a codeblock (in PushBlock() function).
Detached locals.
If the codeblock is returned from a function and this codeblock refers to
local variables defined in that function then the position of local variable
stored in a codeblock is replaced with the current value of the variable.
In this way the value of local variable can be accessed even outside of the
function where the variable was declared. This proccess is also called
'detaching local variables'
Incompatbility with the Clipper.
There is a little difference between the handling of variables passed by
the reference in a codeblock.
The following code explains it (thanks to David G. Holm)
Function Main()
Local nTest
Local bBlock1 := MakeBlock()
Local bBlock2 := {|| DoThing( @nTest ), qout("From Main: ", nTest ) }
eval( bBlock1 )
eval( bBlock2 )
Return( NIL )
Function MakeBlock()
Local nTest
Return( {|| DoThing( @nTest ), qout("From MakeBlock: ", nTest ) } )
Function DoThing( n )
n := 42
Return( NIL )
In Clipper it produces:
From MakeBlock: NIL
From Main: 42
In Harbour it produces (it is the correct output, IMHO)
From MakeBlock: 42
From Main: 42

1
harbour/include/hberrors.h
View File

@@ -22,5 +22,6 @@
#define ERR_SYNTAX 17
#define ERR_UNCLOSED_STRU 18
#define ERR_UNMATCHED_EXIT 19
#define ERR_SYNTAX2 20
void GenError( int, char*, char * ); /* generic parsing error management function */

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

@@ -101,7 +101,7 @@ Separator {SpaceTab}|{Comment}|{LineCont}
%x COMMENT3 DEFINE DEFINE_PARAMS DEFINE_EXPR
%x IFDEF IFNDEF STRING1 STRING2 STRING3
%x NEXT_ BREAK_ CASE_ DO_ WHILE_ WITH_ END_ EXIT_ EXTERNAL_ FIELD_
%x FOR_ FUNCTION_
%x FOR_ FUNCTION_ IIF_ IF_ IN_ INCLUDE_ INIT_ LOCAL_ LOOP_
%s INDEX
%%
@@ -294,8 +294,17 @@ Separator {SpaceTab}|{Comment}|{LineCont}
yy_lex_count_lf();
if( i_INDEX_STATE ) BEGIN INDEX; else BEGIN 0;
unput( yytext[ yyleng-1 ] );
_iState =BREAK;
return BREAK;
if( _iState == LOOKUP )
{
_iState =BREAK;
return BREAK;
}
else
{
yylval.string = strdup( "BREAK" );
_iState =IDENTIFIER;
return IDENTIFIER;
}
}
<BREAK_>. { if( i_INDEX_STATE ) BEGIN INDEX; else BEGIN 0; unput( yytext[ yyleng-1 ] ); }
%{
@@ -339,6 +348,7 @@ Separator {SpaceTab}|{Comment}|{LineCont}
else
{ /* there is another item in line already */
yylval.string = strdup( "CASE" );
_iState =IDENTIFIER;
return IDENTIFIER;
}
}
@@ -458,6 +468,7 @@ Separator {SpaceTab}|{Comment}|{LineCont}
else
{ /* there is another item in line already */
yylval.string = strdup( "END" );
_iState =IDENTIFIER;
return IDENTIFIER;
}
}
@@ -491,7 +502,7 @@ Separator {SpaceTab}|{Comment}|{LineCont}
if( _iState == LOOKUP )
{ /* it is first item in the line */
if( _wForCounter == 0 && _wWhileCounter == 0 )
GenError( ERR_UNMATCHED_EXIT, NULL, NULL );
GenError( ERR_UNMATCHED_EXIT, "EXIT", NULL );
_iState =EXITLOOP;
return EXITLOOP;
}
@@ -502,7 +513,7 @@ Separator {SpaceTab}|{Comment}|{LineCont}
return IDENTIFIER;
}
}
<EXIT_>{Separator}+[_a-zA-Z] { /* an identifier after the EXIT */
<EXIT_>{Separator}+[fFpP] { /* FUNCTION or PROCEDURE after EXIT */
yy_lex_count_lf();
unput( yytext[ yyleng-1 ] );
if( i_INDEX_STATE ) BEGIN INDEX; else BEGIN 0;
@@ -638,7 +649,7 @@ Separator {SpaceTab}|{Comment}|{LineCont}
"func"|"funct"|"functi"|"functio"|"function" { BEGIN FUNCTION_; }
<FUNCTION_>{Separator}+[_a-zA-Z] {
yy_lex_count_lf();
BEGIN 0;
BEGIN 0; /* we can don't care about INDEX_STATE here */
unput( yytext[ yyleng-1 ] );
_iState=FUNCTION;
return FUNCTION;
@@ -649,13 +660,218 @@ Separator {SpaceTab}|{Comment}|{LineCont}
%{
/* ************************************************************************ */
%}
("if"|"iif"){SpaceTab}*/[(] _iState =IF; return IF;
"if" _iState =IF; return IF;
"in" return IN;
"include" return INCLUDE;
"init" return INIT;
"local" _iState =LOCAL; return LOCAL;
"loop" return LOOP;
"iif" {
if( _iState == FUNCTION || _iState == PROCEDURE )
GenError( ERR_SYNTAX, "IIF", NULL );
else
BEGIN IIF_;
/* Note: In Clipper:
IIF( expression )
ENDIF
is not a valid statement -this is why we have to separate
IF and IIF
*/
}
<IIF_>{Separator}*"(" {
yy_lex_count_lf();
if( i_INDEX_STATE ) BEGIN INDEX; else BEGIN 0;
unput( yytext[ yyleng-1 ] );
_iState=IIF;
return IIF;
}
<IIF_>{Separator}*[^\(] {
GenError( ERR_SYNTAX, ((yytext[ yyleng-1 ]=='\n')?"IIF":yytext), NULL );
}
%{
/* ************************************************************************ */
%}
"if" {
if( _iState == FUNCTION || _iState == PROCEDURE )
GenError( ERR_SYNTAX, "IF", NULL );
else
BEGIN IF_;
}
<IF_>{Separator}*"(" {
yy_lex_count_lf();
if( i_INDEX_STATE ) BEGIN INDEX; else BEGIN 0;
unput( yytext[ yyleng-1 ] );
if( _iState == LOOKUP )
_iState =IF;
else
_iState =IIF;
return _iState;
}
<IF_>{Separator}*[\)\[\]\/\^\*\%\=\$\@] {
GenError( ERR_SYNTAX2, yytext, "IF" );
}
<IF_>{Separator}*"->" {
GenError( ERR_SYNTAX2, yytext, "IF" );
}
<IF_>{Separator}*[\n] {
GenError( ERR_SYNTAX, "IF", NULL );
}
<IF_>{Separator}*("++"|"--")/[\n] {
GenError( ERR_SYNTAX2, yytext, "IF" );
}
<IF_>{Separator}*. {
yy_lex_count_lf();
if( i_INDEX_STATE ) BEGIN INDEX; else BEGIN 0;
unput( yytext[ yyleng-1 ] );
_iState =IF;
return IF;
}
%{
/* ************************************************************************ */
%}
"in" BEGIN IN_;
<IN_>{Separator}+[_a-zA-Z] {
yy_lex_count_lf();
if( i_INDEX_STATE ) BEGIN INDEX; else BEGIN 0;
unput( yytext[ yyleng-1 ] );
if( _iState == IDENTIFIER )
return IN;
else
{
yylval.string =strdup( "IN" );
_iState =IDENTIFIER;
return IDENTIFIER;
}
}
<IN_>{Separator}*\n {
yy_lex_count_lf();
--iLine;
if( i_INDEX_STATE ) BEGIN INDEX; else BEGIN 0;
unput( yytext[ yyleng-1 ] );
yylval.string =strdup( "IN" );
_iState =IDENTIFIER;
return IDENTIFIER;
}
<IN_>{Separator}*[0-9] {
GenError( ERR_SYNTAX, yytext, NULL );
}
<IN_>{Separator}*. {
yy_lex_count_lf();
if( i_INDEX_STATE ) BEGIN INDEX; else BEGIN 0;
unput( yytext[ yyleng-1 ] );
yylval.string =strdup( "IN" );
_iState =IDENTIFIER;
return IDENTIFIER;
}
%{
/* ************************************************************************ */
%}
"include" BEGIN INCLUDE_;
<INCLUDE_>{Separator}+\" { /* only "" are allowed for filename */
yy_lex_count_lf();
if( i_INDEX_STATE ) BEGIN INDEX; else BEGIN 0;
unput( yytext[ yyleng-1 ] );
_iState =INCLUDE;
return INCLUDE;
}
<INCLUDE_>{Separator}*[^\"] {
yy_lex_count_lf();
if( yytext[ yyleng-1 ] == '\n' )
--iLine;
if( i_INDEX_STATE ) BEGIN INDEX; else BEGIN 0;
unput( yytext[ yyleng-1 ] );
yylval.string =strdup( "INCLUDE" );
_iState =IDENTIFIER;
return IDENTIFIER;
}
%{
/* ************************************************************************ */
%}
"init" BEGIN INIT_;
<INIT_>{Separator}+[fFpP] { /* FUNCTION or PROCEDURE after INIT */
yy_lex_count_lf();
unput( yytext[ yyleng-1 ] );
if( i_INDEX_STATE ) BEGIN INDEX; else BEGIN 0;
if( _iState == LOOKUP )
{ /* it is first item in the line */
_iState =INIT;
return INIT;
}
else
{ /* there is another item in line already */
yylval.string = strdup( "INIT" );
_iState =IDENTIFIER;
return IDENTIFIER;
}
}
<INIT_>{Separator}*[^fFpP] { /* any character (not identifier) after EXIT */
yy_lex_count_lf();
if( yytext[ yyleng-1 ] == '\n' )
--iLine;
unput( yytext[ yyleng-1 ] );
yylval.string = strdup( "INIT" );
if( i_INDEX_STATE ) BEGIN INDEX; else BEGIN 0;
_iState =IDENTIFIER;
return IDENTIFIER;
}
%{
/* ************************************************************************ */
%}
"local" BEGIN LOCAL_;
<LOCAL_>{Separator}+[_a-zA-Z] { /* an identifier after LOCAL */
yy_lex_count_lf();
unput( yytext[ yyleng-1 ] );
if( i_INDEX_STATE ) BEGIN INDEX; else BEGIN 0;
if( _iState == LOOKUP )
{ /* it is first item in the line */
_iState =LOCAL;
return LOCAL;
}
else
{ /* there is another item in line already */
yylval.string = strdup( "LOCAL" );
_iState =IDENTIFIER;
return IDENTIFIER;
}
}
<LOCAL_>{Separator}*[^a-zA-Z] { /* any character (not identifier) after LOCAL */
yy_lex_count_lf();
if( yytext[ yyleng-1 ] == '\n' )
--iLine;
unput( yytext[ yyleng-1 ] );
yylval.string = strdup( "LOCAL" );
if( i_INDEX_STATE ) BEGIN INDEX; else BEGIN 0;
_iState =IDENTIFIER;
return IDENTIFIER;
}
%{
/* ************************************************************************ */
%}
"loop" BEGIN LOOP_;
<LOOP_>{Separator}*\n { /* at the end of the line */
yy_lex_count_lf();
--iLine;
unput( yytext[ yyleng-1 ] );
if( i_INDEX_STATE ) BEGIN INDEX; else BEGIN 0;
if( _iState == LOOKUP )
{ /* it is first item in the line */
if( _wWhileCounter == 0 && _wForCounter == 0 )
GenError( ERR_UNMATCHED_EXIT, "LOOP", NULL );
_iState =LOOP;
return LOOP;
}
else
{ /* there is another item in line already */
yylval.string = strdup( "LOOP" );
_iState =IDENTIFIER;
return IDENTIFIER;
}
}
<LOOP_>{Separator}*. { /* any character (not LF) after LOOP */
yy_lex_count_lf();
unput( yytext[ yyleng-1 ] );
yylval.string = strdup( "LOOP" );
if( i_INDEX_STATE ) BEGIN INDEX; else BEGIN 0;
_iState =IDENTIFIER;
return IDENTIFIER;
}
%{
/* ************************************************************************ */
%}
"memvar" _iState =MEMVAR; return MEMVAR;
%{
/* ************************************************************************ */
@@ -663,9 +879,10 @@ Separator {SpaceTab}|{Comment}|{LineCont}
"next" BEGIN NEXT_;
<NEXT_>{Separator}*[\n\;] { /* at the end of line */
if( i_INDEX_STATE ) BEGIN INDEX; else BEGIN 0;
unput( yytext[ yyleng-1 ] );
--iLine;
if( _iState == LOOKUP )
{ /* it is first item in the line */
++iLine;
if( _wForCounter == 0 )
GenError( ERR_NEXTFOR, NULL, NULL );
_iState =NEXT;
@@ -713,11 +930,20 @@ Separator {SpaceTab}|{Comment}|{LineCont}
<NEXT_>{Separator}*. { /* an identifier follows NEXT statement */
yy_lex_count_lf();
if( i_INDEX_STATE ) BEGIN INDEX; else BEGIN 0;
if( _wForCounter == 0 )
GenError( ERR_NEXTFOR, NULL, NULL );
unput( yytext[ yyleng-1 ] );
_iState =NEXT;
return NEXT;
if( _iState == LOOKUP )
{
if( _wForCounter == 0 )
GenError( ERR_NEXTFOR, NULL, NULL );
_iState =NEXT;
return NEXT;
}
else
{
yylval.string = strdup( "NEXT" );
_iState =IDENTIFIER;
return IDENTIFIER;
}
}
%{
/* ************************************************************************ */
@@ -775,16 +1001,16 @@ Separator {SpaceTab}|{Comment}|{LineCont}
<WHILE_>{Separator}*. { /* identifiers and literals */
yy_lex_count_lf();
if( i_INDEX_STATE ) BEGIN INDEX; else BEGIN 0;
unput( yytext[ yyleng-1 ] );
if( _iState == LOOKUP || _iState == DO )
{ /* it is first item in the line or after DO */
unput( yytext[ yyleng-1 ] );
{ /* it is first item in the line or after DO or FIELD */
_iState =WHILE;
return WHILE;
}
else
{ /* there is another item in line already */
unput( yytext[ yyleng-1 ] );
yylval.string = strdup( "WHILE" );
_iState =IDENTIFIER;
return IDENTIFIER;
}
}
@@ -833,6 +1059,7 @@ Separator {SpaceTab}|{Comment}|{LineCont}
else
{
yylval.string = strdup( "WITH" );
_iState =IDENTIFIER;
return IDENTIFIER;
}
}
@@ -1025,7 +1252,6 @@ Separator {SpaceTab}|{Comment}|{LineCont}
yyleng = 10;
}
yylval.string = strupr( strdup( yytext ) );
/*printf( "\nIdentifier = '%s'\n", strupr( strdup( yytext ) ) );*/
return IDENTIFIER;
}
}

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

@@ -85,6 +85,20 @@ typedef struct __RETURN
struct __RETURN * pNext;
} _RETURN, * PRETURN; /* support structure for multiple returns from a function */
typedef struct _LOOPEXIT
{
WORD wOffset;
WORD wLine;
struct _LOOPEXIT *pLoopList;
struct _LOOPEXIT *pExitList;
struct _LOOPEXIT *pNext;
} LOOPEXIT, * PLOOPEXIT; /* support structure for EXIT and LOOP statements */
static void LoopStart( void );
static void LoopEnd( void );
static void LoopLoop( void );
static void LoopExit( void );
static void LoopHere( void );
typedef struct /* support for filenames */
{
char _buffer[ _POSIX_PATH_MAX+3 ];
@@ -244,8 +258,9 @@ char * _szErrors[] = { "Statement not allowed outside of procedure or function",
"ELSE does not match IF",
"ELSEIF does not match IF",
"Syntax error: \'%s\'",
"Unclosed control structures",
"EXIT statement with no loop in sight"
"Unclosed control structures at line: %i",
"%s statement with no loop in sight",
"Syntax error: \'%s\' in: \'%s\'"
};
/* Table with reserved functions names
@@ -366,6 +381,7 @@ int _iObj32 = 0; /* generate OBJ 32 bits */
WORD _wStatics = 0; /* number of defined statics variables on the PRG */
PRETURN pReturns = 0; /* list of multiple returns from a function */
PEXTERN pExterns = 0;
PLOOPEXIT pLoops = 0;
PATHNAMES *_pIncludePath = NULL;
%}
@@ -384,7 +400,7 @@ PATHNAMES *_pIncludePath = NULL;
};
%token FUNCTION PROCEDURE IDENTIFIER RETURN NIL DOUBLE INASSIGN INTEGER INTLONG
%token LOCAL STATIC IF ELSE ELSEIF END ENDIF LITERAL TRUEVALUE FALSEVALUE
%token LOCAL STATIC IIF IF ELSE ELSEIF END ENDIF LITERAL TRUEVALUE FALSEVALUE
%token INCLUDE EXTERN INIT EXIT AND OR NOT PUBLIC EQ NE1 NE2
%token INC DEC ALIAS DOCASE CASE OTHERWISE ENDCASE ENDDO MEMVAR
%token WHILE EXIT LOOP END FOR NEXT TO STEP LE GE FIELD IN PARAMETERS
@@ -506,8 +522,8 @@ Statement : ExecFlow Crlf {}
| PUBLIC VarList Crlf
| PRIVATE VarList Crlf
| PARAMETERS IdentList Crlf
| EXITLOOP Crlf
| LOOP Crlf
| EXITLOOP Crlf { LoopExit(); }
| LOOP Crlf { LoopLoop(); }
| DoProc Crlf
;
@@ -591,7 +607,11 @@ Expression : NIL { PushNil(); }
| SELF { GenPCode1( _PUSHSELF ); }
;
IfInline : IF '(' Expression ',' { $<iNumber>$ = JumpFalse( 0 ); }
IfInline : IIF '(' Expression ',' { $<iNumber>$ = JumpFalse( 0 ); }
IfInlExp ',' { $<iNumber>$ = Jump( 0 ); JumpHere( $<iNumber>5 ); }
IfInlExp ')' { JumpHere( $<iNumber>8 ); }
| IF '(' Expression ',' { $<iNumber>$ = JumpFalse( 0 ); }
IfInlExp ',' { $<iNumber>$ = Jump( 0 ); JumpHere( $<iNumber>5 ); }
IfInlExp ')' { JumpHere( $<iNumber>8 ); }
;
@@ -867,11 +887,11 @@ DoWhile : WhileBegin Expression Crlf { $<lNumber>$ = JumpFalse( 0 ); }
EndWhile { JumpHere( $<lNumber>4 ); --_wWhileCounter; }
| WhileBegin Expression Crlf { $<lNumber>$ = JumpFalse( 0 ); Line(); }
WhileStatements { Jump( $1 - functions.pLast->lPCodePos ); }
EndWhile { JumpHere( $<lNumber>4 ); --_wWhileCounter; }
WhileStatements { LoopHere(); Jump( $1 - functions.pLast->lPCodePos ); }
EndWhile { JumpHere( $<lNumber>4 ); --_wWhileCounter; LoopEnd(); }
;
WhileBegin : WHILE { $$ = functions.pLast->lPCodePos; ++_wWhileCounter; }
WhileBegin : WHILE { $$ = functions.pLast->lPCodePos; ++_wWhileCounter; LoopStart(); }
;
WhileStatements : Statement
@@ -882,10 +902,10 @@ EndWhile : END
| ENDDO
;
ForNext : FOR IDENTIFIER ForAssign Expression { PopId( $2 ); $<iNumber>$ = functions.pLast->lPCodePos; ++_wForCounter; }
ForNext : FOR IDENTIFIER ForAssign Expression { PopId( $2 ); $<iNumber>$ = functions.pLast->lPCodePos; ++_wForCounter; LoopStart(); }
TO Expression { PushId( $2 ); }
StepExpr Crlf { GenPCode1( _FORTEST ); $<iNumber>$ = JumpTrue( 0 ); /*PushId( $2 )*/; }
ForStatements { PushId( $2 ); GenPCode1( _PLUS ); PopId( $2 ); Jump( $<iNumber>5 - functions.pLast->lPCodePos ); JumpHere( $<iNumber>11 ); }
ForStatements { LoopHere(); PushId( $2 ); GenPCode1( _PLUS ); PopId( $2 ); Jump( $<iNumber>5 - functions.pLast->lPCodePos ); JumpHere( $<iNumber>11 ); LoopEnd(); }
;
ForAssign : '='
@@ -905,14 +925,14 @@ ForStatements : ForStat NEXT { --_wForCounter; }
ForStat : Statements { Line(); }
;
BeginSeq : BEGINSEQ Crlf { ++_wSeqCounter; }
BeginSeq : BEGINSEQ { ++_wSeqCounter; } Crlf
SeqStatms
RecoverSeq
END { --_wSeqCounter; }
;
| BEGINSEQ Crlf { ++_wSeqCounter; }
Statements
RecoverSeq
END { --_wSeqCounter; }
SeqStatms : /* empty */
| Statements
;
RecoverSeq : /* no recover */
@@ -3060,9 +3080,19 @@ void FixReturns( void ) /* fixes all last defined function returns jumps offsets
}
pReturns = 0;
}
/* TODO: check why it triggers this error in keywords.prg
if( pLoops )
{
PLOOPEXIT pLoop = pLoops;
char cLine[ 64 ];
if( (_wSeqCounter + _wWhileCounter + _wIfCounter + _wCaseCounter + _wForCounter) > 0 )
GenError( ERR_UNCLOSED_STRU, NULL, NULL );
while( pLoop->pNext )
pLoop =pLoop->pNext;
itoa( pLoop->wLine, cLine, 10 );
GenError( ERR_UNCLOSED_STRU, cLine, NULL );
}
*/
}
void Function( BYTE bParams )
@@ -3337,6 +3367,125 @@ void StaticAssign( void )
_pInitFunc->bFlags |= FUN_ILLEGAL_INIT;
}
/*
* This function stores the position in pcode buffer where the FOR/WHILE
* loop starts. It will be used to fix any LOOP/EXIT statements
*/
static void LoopStart( void )
{
PLOOPEXIT pLoop = OurMalloc( sizeof(LOOPEXIT) );
if( pLoops )
{
PLOOPEXIT pLast =pLoops;
while( pLast->pNext )
pLast =pLast->pNext;
pLast->pNext =pLoop;
}
else
pLoops = pLoop;
pLoop->pNext =NULL;
pLoop->pExitList =NULL;
pLoop->pLoopList =NULL;
pLoop->wOffset =functions.pLast->lPCodePos; /* store the start position */
pLoop->wLine =iLine;
}
/*
* Stores the position of LOOP statement to fix it later at the end of loop
*/
static void LoopLoop( void )
{
PLOOPEXIT pLast, pLoop = (PLOOPEXIT) OurMalloc( sizeof( LOOPEXIT ) );
pLoop->pLoopList =NULL;
pLoop->wOffset =functions.pLast->lPCodePos; /* store the position to fix */
pLast =pLoops;
while( pLast->pNext )
pLast =pLast->pNext;
while( pLast->pLoopList )
pLast =pLast->pLoopList;
pLast->pLoopList =pLoop;
Jump( 0 );
}
/*
* Stores the position of EXIT statement to fix it later at the end of loop
*/
static void LoopExit( void )
{
PLOOPEXIT pLast, pLoop = (PLOOPEXIT) OurMalloc( sizeof( LOOPEXIT ) );
pLoop->pExitList =NULL;
pLoop->wOffset =functions.pLast->lPCodePos; /* store the position to fix */
pLast =pLoops;
while( pLast->pNext )
pLast =pLast->pNext;
while( pLast->pExitList )
pLast =pLast->pExitList;
pLast->pExitList =pLoop;
Jump( 0 );
}
/*
* Fixes the LOOP statement
*/
static void LoopHere( void )
{
PLOOPEXIT pLoop = pLoops, pFree;
while( pLoop->pNext )
pLoop = pLoop->pNext;
pLoop =pLoop->pLoopList;
while( pLoop )
{
JumpHere( pLoop->wOffset +1 );
pFree = pLoop;
pLoop = pLoop->pLoopList;
OurFree( pFree );
}
}
/*
* Fixes the EXIT statements and releases memory allocated for current loop
*/
static void LoopEnd( void )
{
PLOOPEXIT pExit, pLoop = pLoops, pLast = pLoops, pFree;
while( pLoop->pNext )
{
pLast = pLoop;
pLoop = pLoop->pNext;
}
pExit =pLoop->pExitList;
while( pExit )
{
JumpHere( pExit->wOffset +1 );
pFree = pExit;
pExit = pExit->pExitList;
OurFree( pFree );
}
pLast->pNext = NULL;
if( pLoop == pLoops )
pLoops = NULL;
OurFree( pLoop );
}
void * OurMalloc( LONG lSize )
{
void * pMem = malloc( lSize );

7
harbour/source/makefile.dos
View File

@@ -1,9 +1,9 @@
# $Id$
# Makefile for DOS DJGPP
#
.PHONY: compiler vm rtl
.PHONY: compiler vm rtl tools
all: compiler vm rtl
all: compiler vm rtl tools
compiler:
make --directory=./compiler -r -f makefile.dos
@@ -14,6 +14,9 @@ vm:
rtl:
make --directory=./rtl -f makefile.dos
tools:
make --directory=./tools -f makefile.dos
clean:
make --directory=./compiler -f makefile.dos clean
make --directory=./vm -f makefile.dos clean

13
harbour/source/tools/makefile.dos
View File

@@ -3,18 +3,17 @@
#
include ../../makedos.env
SRCPRG:= $(wildcard *.prg)
CPRG=$(SRCPRG:.prg=.c)
OBJPRG=$(CPRG:.c=.o)
SRCC:= $(wildcard *.c)
OBJC=$(SRCC:.c=.o)
all: $(HARBOURLIB)
$(HARBOURLIB): ${OBJC} ${OBJPRG}
ar r $(HARBOURLIB) ${OBJC}
prg:
../../bin/harbour -n error.prg
../../bin/harbour -n errorsys.prg
../../bin/harbour -n tclass.prg
$(HARBOURLIB): ${OBJPRG} $(OBJC)
ar r $(HARBOURLIB) ${OBJC} ${OBJPRG}
clean:
-del *.o

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

@@ -1324,7 +1324,13 @@ void PopLocal( SHORT iLocal )
/* local variable or local parameter */
pLocal = stack.pBase + 1 + iLocal;
if( IS_BYREF( pLocal ) )
{
if( pLocal->value.iNumber >= 0)
ItemCopy( stack.pItems + pLocal->value.wItem, stack.pPos );
else
/* local variable referenced in a codeblock */
ItemCopy( CodeblockGetVar( stack.pItems +pLocal->wBase +1, pLocal->value.wItem ), stack.pPos );
}
else
ItemCopy( pLocal, stack.pPos );
}
@@ -1426,7 +1432,13 @@ void PushLocal( SHORT iLocal )
/* local variable or local parameter */
pLocal = stack.pBase + 1 + iLocal;
if( IS_BYREF( pLocal ) )
{
if( pLocal->value.iNumber >= 0 )
ItemCopy( stack.pPos, stack.pItems + pLocal->value.wItem );
else
/* local variable referenced in a codeblock */
ItemCopy( stack.pPos, CodeblockGetVar( stack.pItems + pLocal->wBase +1, pLocal->value.wItem ) );
}
else
ItemCopy( stack.pPos, pLocal );
}
@@ -1446,8 +1458,11 @@ void PushLocalByRef( SHORT iLocal )
/* local variable or local parameter */
stack.pPos->value.wItem = stack.pBase + 1 + iLocal - stack.pItems;
else
{
/* local variable referenced in a codeblock */
stack.pPos->value.wItem = iLocal;
stack.pPos->value.iNumber = iLocal;
stack.pPos->wBase = stack.pBase - stack.pItems;
}
StackPush();
HBDEBUG2( "PushLocalByRef %i\n", iLocal );

3
harbour/tests/working/keywords.ch Normal file
View File

@@ -0,0 +1,3 @@
//This is test file for KEYWORDS.PRG
//
//This file is needed to test #include keyword

207
harbour/tests/working/keywords.prg
View File

@@ -4,9 +4,11 @@
*/
//DO NOT RUN THIS PROGRAM - ITS PURPOSE IS THE SYNTAX CHECK ONLY!
#include "keywords.ch" //INCLUDE test
EXTERNAL __case, __begin
STATIC nExt, bEgin, bReak, cAse, do, wHile, wIth, eXit, eXternal, fIeld
STATIC for
STATIC for, in, include, init, loop, local
Function Main()
@@ -49,6 +51,16 @@ Function Main()
for :=FOR( for )
in( in )
include( include )
Init( init )
LOCAL( local )
LOOP( loop )
RETURN nil
/*================================================================
@@ -103,28 +115,26 @@ RETURN( nExt * /*next*/ nExt )
**/
FUNCTION BEGIN( BEGIN_BEGIN )
LOCAL bEgin
LOCAL xbEgin
LOCAL bEginBEGIN
//LOCAL bEgin0, /* BEGIN OF BEGIN */ ; /* in Clipper: Incomplete statement */
// bEgin1
LOCAL xbEginBEGIN := 100
BEGIN SEQUENCE
bEgin0 :=0
bEgin :=0
FOR bEgin:=1 TO 10
QOUT( bEgin )
xbEgin :=bEgin
bEginBEGIN :=xbEgin * 10
bEgin0 +=bEginBEGIN
--xbEginBEGIN
bEgin :=bEgin[ 1 ]
bEgin[ 1 ] :=bEgin
bEgin :=bEgin * 10
bEgin++
--bEgin
( begin )->( begin () )
NEXT bEgin
bEgin :=begin->begin
// begin->begin :=begin->begin +; /************************/
// begin->begin
bEgin :=BEGIN( xbegin +bEgin +bEginBEGIN -bEgin0 * xbEginBEGIN ) +;
bEgin :=BEGIN( begin +bEgin ) +;
bEgin[ bEgin ]
END SEQUENCE
@@ -308,6 +318,8 @@ LOCAL with
while->while :=while() +while->while
enddo
do->do :=while->while
// while[ 1 ] :=while
// while[ 2 ] +=2
// while( while )
@@ -548,6 +560,9 @@ FUNCTION FOR( for )
for :=for()
for :=for( for( for ) )
for :={|for| for}
EVAL( {|for| for}, for )
for->for :=for
for :=for->for
for->for :=for->for
@@ -560,3 +575,175 @@ FUNCTION FOR( for )
ENDDO
RETURN for
/*====================================================================
* Test for IN
*/
FUNCTION IN( _in )
FIELD begin IN begin
FIELD break IN break
FIELD case IN case
FIELD do IN do
FIELD for IN for
FIELD in IN in
FIELD next IN next
FIELD while IN while
FIELD end IN end
FIELD with IN with
FIELD exit IN exit
FIELD external IN external
FIELD field IN field
IN( in )
in++
--in
in->in :=in
in[ 1 ] :=1
in[ in ] :=in[ in ]
( in )->in :=in
in :={|in| in}
EVAL( {|in| in}, in )
DO in
DO in WITH in
RETURN in
/*====================================================================
* Test for INCLUDE
*/
FUNCTION include( include )
FOR include:=1 TO 10
include++
--include
NEXT include
WHILE include
ENDDO
include[ 1 ] :=1
include := include[ include ]
include :={|include| include}
EVAL( {|include| include}, include )
DO include
DO include WITH include
include->include :=1
include->include :=include->include +1
( include )->include :=INCLUDE( include->include )
RETURN include
/*====================================================================
* Test for INIT
*/
INIT fUNCTION Init( init )
FOR init:=1 TO 10
init++
--init
NEXT init
WHILE init
init :=!init
END
init[ 1 ] :=1
init :=init[ init ]
init->init :=init->init +1
( init )->init :=INIT( init[ init->init ] )
init :={|init| init}
EVAL( {|init| init}, init )
DO INIT WITH init
DO INIT
RETURN init
/*====================================================================
* Test for LOCAL
*/
FUNCTION local( _local )
LOCAL local
FOR local:=1 TO 10
local++
--local
NEXT local
local :={|local| local}
EVAL( {|local| local}, local )
WHILE local
ENDDO
local[ 1 ] :=1
local :=local[ local ]
local->local :=local->local
( local )->local :=LOCAL( local[ local->local ] )
DO local
DO local WITH local
RETURN local
/*====================================================================
* Test for LOOP
*/
FUNCTION loop( loop )
FOR loop:=1 TO 10
loop++
--loop
QOut( loop )
IF( loop == 5 )
Qout( "LOOP to begginig" )
loop
ENDIF
IF( loop == 9 )
Qout( "EXIT from FOR statement" )
EXIT
ENDIF
NEXT loop
Qout( "After ", loop, "loops" )
// LOOP
loop :={|loop| loop}
EVAL( {|loop| loop}, loop )
loop =1
WHILE loop <= 10
Qout( loop )
IF( loop == 5 )
Qout( "LOOP to 7" )
loop :=7
LOOP
ENDIF
IF( loop == 9 )
Qout( "EXIT form while" )
EXIT
ENDIF
++loop
ENDDO
Qout( "After ", loop, " loops" )
loop[ 1 ] :=1
loop :=loop[ loop ]
loop->loop :=loop->loop
( loop )->loop :=loop( loop[ loop->loop ] )
DO loop
DO loop WITH loop
RETURN loop