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

2001-06-01 10:30 UTC-0800 Ron Pinkas <ron@profit-master.com>

Browse Source 
* contrib/dot/pp.prg
     + PP_RunArray( asLines, aParams )
     + PP_Exec( aProcedures, aInitExit, nProcId, aParams )
     * Modified all PP_RunXXXX() to use PP_Exec()
     * RP_Comp_Err() now repports source line and line number with the sysntax error.

   * contrib/dot/pp_harb.ch
     + Added Tinterpreter() class
         METHOD New()
         METHOD AddLine( cLine )
         METHOD SetScript( cText )
         METHOD Compile()
         METHOD Run()
         METHOD RunFile( cFile, aParams, cPPOExt, bBlanks ) INLINE PP_Run( cFile, aParams, cPPOExt, bBlanks )
         METHOD ClearRules()
         METHOD InitStdRules()
         METHOD LoadClass()
         METHOD LoadFiveWin()

   * contrib/dot/prgscrpt.prg
     * Modified to demonstrate TInterpreter() syntax.

   * include/hbapi.h
   * source/vm/arrays.c
     * Fixed bug, in hb_stackArrayFromParams() and modified to accept a frame base parameter.

   * source/vm/arrayshb.c
     + Added HB_APARAMS() PRG wrapper to hb_stackArrayFromParams() returning array with passed parameter of the function calling HB_APARAMS()

   * source/rtl/do.c
     * Added required frams base parameter in calls to hb_stackArrayFromParams(). This fix population of oErr:Args if error occurs.
This commit is contained in:
Ron Pinkas
2001-06-01 17:42:09 +00:00
parent 6e2e3ff528
commit 6aaecd70e6
8 changed files with 353 additions and 114 deletions
Download Patch File Download Diff File Expand all files Collapse all files

33
harbour/ChangeLog
View File

@@ -1,3 +1,36 @@
2001-06-01 10:30 UTC-0800 Ron Pinkas <ron@profit-master.com>
* contrib/dot/pp.prg
+ PP_RunArray( asLines, aParams )
+ PP_Exec( aProcedures, aInitExit, nProcId, aParams )
* Modified all PP_RunXXXX() to use PP_Exec()
* RP_Comp_Err() now repports source line and line number with the sysntax error.
* contrib/dot/pp_harb.ch
+ Added Tinterpreter() class
METHOD New()
METHOD AddLine( cLine )
METHOD SetScript( cText )
METHOD Compile()
METHOD Run()
METHOD RunFile( cFile, aParams, cPPOExt, bBlanks ) INLINE PP_Run( cFile, aParams, cPPOExt, bBlanks )
METHOD ClearRules()
METHOD InitStdRules()
METHOD LoadClass()
METHOD LoadFiveWin()
* contrib/dot/prgscrpt.prg
* Modified to demonstrate TInterpreter() syntax.
* include/hbapi.h
* source/vm/arrays.c
* Fixed bug, in hb_stackArrayFromParams() and modified to accept a frame base parameter.
* source/vm/arrayshb.c
+ Added HB_APARAMS() PRG wrapper to hb_stackArrayFromParams() returning array with passed parameter of the function calling HB_APARAMS()
* source/rtl/do.c
* Added required frams base parameter in calls to hb_stackArrayFromParams(). This fix population of oErr:Args if error occurs.
2001-05-30 10:49 UTC-0800 Brian Hays <bhays@abacuslaw.com>
* source/rdd/dbcmd.c

275
harbour/contrib/dot/pp.prg
View File

@@ -191,14 +191,13 @@ STATIC s_acFlowType := {}, s_nFlowId := 0
#endif
static s_lRunLoaded := .F., s_lClsLoaded := .F., s_lFWLoaded := .F.
static s_sBlock
//--------------------------------------------------------------//
PROCEDURE PP_Main( sSource, p1, p2, p3, p4, p5, p6, p7, p8, p9 )
LOCAL sIncludePath, nNext, sPath, sSwitch := ""
LOCAL nAt, sParams
LOCAL nAt, sParams, sPPOExt, aParams
IF p1 != NIL
sSwitch += p1
@@ -289,6 +288,9 @@ PROCEDURE PP_Main( sSource, p1, p2, p3, p4, p5, p6, p7, p8, p9 )
IF "-DP" $ sSwitch
bDbgPPO := .T.
ENDIF
IF "-P" $ sSwitch
sPPOExt := ".pp$"
ENDIF
ENDIF
IF bLoadRules
@@ -325,17 +327,17 @@ PROCEDURE PP_Main( sSource, p1, p2, p3, p4, p5, p6, p7, p8, p9 )
sSource := Left( sSource, nAt - 1 )
WHILE ( nAt := At( " ", sParams ) ) > 0
aAdd( s_aParams, Left( sParams, nAt - 1 ) )
aAdd( aParams, Left( sParams, nAt - 1 ) )
sParams := LTrim( SubStr( sParams, nAt + 1 ) )
ENDDO
IF ! sParams == ""
aAdd( s_aParams, sParams )
aAdd( aParams, sParams )
ENDIF
ENDIF
PP_Run( sSource )
PP_Run( sSource, aParams, sPPOExt )
ELSE
PP_PreProFile( sSource )
PP_PreProFile( sSource, sPPOExt )
ENDIF
ELSE
nRow := 1
@@ -1085,7 +1087,6 @@ FUNCTION PP_CompileLine( sPPed, nLine, aProcedures, aInitExit, nProcId )
ELSE
//? nLine, nProcId, sBlock
//TraceLog( sBlock )
s_sBlock := sBlock
aAdd( aProcedures[ nProcId ][2], { 0, &( "{||" + sBlock + "}" ), nLine } )
ENDIF
ENDIF
@@ -1417,7 +1418,6 @@ FUNCTION PP_CompileLine( sPPed, nLine, aProcedures, aInitExit, nProcId )
ELSE
//? nLine, nProcId, sBlock
//TraceLog( sBlock )
s_sBlock := sBlock
aAdd( aProcedures[ nProcId ][2], { 0, &( "{||" + sBlock + "}" ), nLine } )
ENDIF
ENDIF
@@ -1608,15 +1608,14 @@ RETURN
//--------------------------------------------------------------//
PROCEDURE PP_Run( cFile, aParams )
PROCEDURE PP_Run( cFile, aParams, sPPOExt, bBlanks )
LOCAL nBaseProc := s_nProcId, sPresetModule := s_sModule, nProc
IF ValType( aParams ) == 'A'
s_aParams := aParams
ENDIF
//PP_PreProFile( "rp_run.ch" )
IF bBlanks == NIL
bBlanks := .T.
ENDIF
IF ! s_lRunLoaded
s_lRunLoaded := .T.
@@ -1633,36 +1632,12 @@ PROCEDURE PP_Run( cFile, aParams )
ENDIF
ENDIF
ErrorBlock( {|oErr| RP_Comp_Err( oErr ) } )
s_sModule := cFile
bCompile := .T.
PP_PreProFile( cFile )
PP_PreProFile( cFile, sPPOExt, bBlanks )
bCompile := .F.
ErrorBlock( {|oErr| RP_Run_Err( oErr, s_aProcedures, s_sModule ) } )
FOR nProc := 1 TO Len( s_aInitExit[1] )
PP_ExecProcedure( s_aProcedures[ s_aInitExit[1][nProc] ] )
NEXT
aSize( s_aInitExit[1], 0 )
FOR nProc := ( nBaseProc + 1 ) TO s_nProcId
IF aScan( s_aInitExit[1], nProc ) == 0 .AND. aScan( s_aInitExit[2], nProc ) == 0
PP_ExecProcedure( s_aProcedures[nProc] )
EXIT
ENDIF
NEXT
IF nBaseProc == 0
FOR nProc := 1 TO Len( s_aInitExit[2] )
PP_ExecProcedure( s_aProcedures[ s_aInitExit[2][nProc] ] )
NEXT
aSize( s_aProcedures, 0 )
aSize( s_aInitExit[2], 0 )
ENDIF
PP_Exec( s_aProcedures, s_aInitExit, s_nProcId, aParams )
#ifdef __CLIPPER__
Memory(-1)
@@ -1735,7 +1710,7 @@ PROCEDURE RP_Dot_Err( oErr )
//--------------------------------------------------------------//
PROCEDURE RP_Comp_Err( oErr )
PROCEDURE RP_Comp_Err( oErr, sLine, nLine )
LOCAL Counter, xArg, sArgs := ""
@@ -1778,9 +1753,8 @@ PROCEDURE RP_Comp_Err( oErr )
sArgs := Left( sArgs, Len( sArgs ) -2 )
ENDIF
TraceLog( "Sorry, could not compile: '" + s_sBlock +"' Description: " + oErr:Description + sArgs + " " + ProcName(2) + '[' + Str( ProcLine(2) ) + ']')
Alert( "Sorry, could not compile: " + oErr:Description + sArgs + " " + ProcName(2) + '[' + Str( ProcLine(2) ) + ']')
TraceLog( "Line: " + Str( nLine, 4 ) + " could not compile: '" + sLine + ";" + oErr:Description + sArgs + " " + ProcName(2) + '[' + Str( ProcLine(2) ) + ']')
Alert( "Line: " + Str( nLine, 4 ) + " could not compile: '" + sLine + ";" + oErr:Description + sArgs + " " + ProcName(2) + '[' + Str( ProcLine(2) ) + ']')
BREAK
@@ -2076,11 +2050,11 @@ RETURN nIf
//------------------------------- *** END - RP DOT Functions *** -------------------------------//
FUNCTION PP_PreProFile( sSource )
FUNCTION PP_PreProFile( sSource, sPPOExt, bBlanks )
LOCAL hSource, sBuffer, sLine, nPosition, sExt, cPrev
LOCAL nLen, nMaxPos, cChar := '', nClose, nBase, nNext, nLine := 0
LOCAL sRight, nPath := 0, nPaths := Len( s_asPaths ), nNewLine, bBlanks := .T.
LOCAL sRight, nPath := 0, nPaths := Len( s_asPaths ), nNewLine
LOCAL sPath := "", cError, sPrevFile := s_sFile
LOCAL sTmp
@@ -2110,16 +2084,24 @@ FUNCTION PP_PreProFile( sSource )
ENDIF
IF hPP == NIL
sExt := SubStr( sSource, RAt( '.', sSource ) )
IF ! ( sExt == '' )
hPP := FCreate( StrTran( sSource, sExt, ".pp$" ) )
ELSE
hPP := FCreate( sSource + ".pp$" )
IF bBlanks == NIL
bBlanks := .T.
ENDIF
IF hPP == -1
Alert( "ERROR! creating '.pp$' file, O/S Error: " + Str( FError(), 2 ) )
s_sFile := sPrevFile
RETURN .F.
IF sPPOExt == NIL
hPP := 0
ELSE
sExt := SubStr( sSource, RAt( '.', sSource ) )
IF ! ( sExt == '' )
hPP := FCreate( StrTran( sSource, sExt, sPPOExt ) )
ELSE
hPP := FCreate( sSource + sPPOExt )
ENDIF
IF hPP == -1
Alert( "ERROR! creating '.pp$' file, O/S Error: " + Str( FError(), 2 ) )
s_sFile := sPrevFile
RETURN .F.
ENDIF
ENDIF
ELSE
FWrite( hPP, '#line 1 "' + sPath + Upper( sSource ) + '"' + CRLF )
@@ -2129,6 +2111,10 @@ FUNCTION PP_PreProFile( sSource )
sBuffer := Space( PP_BUFFER_SIZE )
sLine := ''
IF bCompile
ErrorBlock( {|oErr| RP_Comp_Err( oErr, sLine, nLine ) } )
ENDIF
BEGIN SEQUENCE
WHILE ( nLen := FRead( hSource, @sBuffer, PP_BUFFER_SIZE ) ) > 2
@@ -4233,14 +4219,22 @@ STATIC FUNCTION NextExp( sLine, cType, aWords, aExp, sNextAnchor, bX )
sExp += sNextToken
sLastToken := sJustNext
sLine := sNextLine
s_bArrayPrefix := .T.
#ifdef __HARBOUR__
SetArrayPrefix( .T. )
#else
s_bArrayPrefix := .T.
#endif
sNextToken := NextToken( @sNextLine, .T. )
IF sNextToken != NIL .AND. Left( sNextToken, 1 ) == '.'
// Get the macro terminator.
sExp += sNextToken
sLastToken := "."
sLine := sNextLine
s_bArrayPrefix := .T.
#ifdef __HARBOUR__
SetArrayPrefix( .T. )
#else
s_bArrayPrefix := .T.
#endif
IF sNextToken == '.' //(Last Token) No space after Macro terminator, so get the suffix.
sNextToken := NextToken( @sNextLine, .T. )
IF sNextToken != NIL
@@ -4250,7 +4244,11 @@ STATIC FUNCTION NextExp( sLine, cType, aWords, aExp, sNextAnchor, bX )
sExp += sNextToken
sLastToken := RTrim( sNextToken )
sLine := sNextLine
s_bArrayPrefix := .T.
#ifdef __HARBOUR__
SetArrayPrefix( .T. )
#else
s_bArrayPrefix := .T.
#endif
ENDIF
ENDIF
ENDIF
@@ -4268,7 +4266,11 @@ STATIC FUNCTION NextExp( sLine, cType, aWords, aExp, sNextAnchor, bX )
IF Left( sNext1, 1 ) == ')'
sExp += sNextToken
sLine := sNextLine
s_bArrayPrefix := .T.
#ifdef __HARBOUR__
SetArrayPrefix( .T. )
#else
s_bArrayPrefix := .T.
#endif
ELSE
//TraceLog( "Content from: " + sLine )
sTemp := NextExp( @sLine, ',', NIL, NIL, NIL ) // Content - Ignoring sNextAnchor !!!
@@ -4304,12 +4306,20 @@ STATIC FUNCTION NextExp( sLine, cType, aWords, aExp, sNextAnchor, bX )
/* Literal block */
sExp += sNextToken
sLine := sNextLine
s_bArrayPrefix := .F.
#ifdef __HARBOUR__
SetArrayPrefix( .F. )
#else
s_bArrayPrefix := .F.
#endif
sNextToken := NextToken( @sNextLine, .T. )
IF sNextToken != NIL .AND. Left( sNextToken, 1 ) == '|'
sExp += sNextToken
sLine := sNextLine
s_bArrayPrefix := .F.
#ifdef __HARBOUR__
SetArrayPrefix( .F. )
#else
s_bArrayPrefix := .F.
#endif
ELSE
sTemp := NextExp( @sLine, ',', NIL, NIL, NIL ) // Content - Ignoring sNextAnchor !!!
IF sTemp == NIL
@@ -4326,7 +4336,11 @@ STATIC FUNCTION NextExp( sLine, cType, aWords, aExp, sNextAnchor, bX )
IF sNextToken != NIL .AND. Left( sNextToken, 1 ) == '|'
sExp += sNextToken
sLine := sNextLine
s_bArrayPrefix := .F.
#ifdef __HARBOUR__
SetArrayPrefix( .F. )
#else
s_bArrayPrefix := .F.
#endif
ELSE
TraceLog( "ERROR! Unbalanced '{|...|' at: " + sExp )
Alert( "ERROR! Unbalanced '{|...|' at: " + sExp )
@@ -4361,7 +4375,11 @@ STATIC FUNCTION NextExp( sLine, cType, aWords, aExp, sNextAnchor, bX )
IF sNext1 == '}'
sExp += sNextToken
sLine := sNextLine
s_bArrayPrefix := .T.
#ifdef __HARBOUR__
SetArrayPrefix( .T. )
#else
s_bArrayPrefix := .T.
#endif
ELSE
sTemp := NextExp( @sLine, ',', NIL, NIL, NIL ) // Content - Ignoring sNextAnchor !!!
IF sTemp == NIL
@@ -4536,12 +4554,16 @@ STATIC FUNCTION NextExp( sLine, cType, aWords, aExp, sNextAnchor, bX )
IF sNext1 == '(' .AND. ( IsAlpha( cLastChar ) .OR. IsDigit( cLastChar ) .OR. cLastChar $ "_." )
LOOP
ELSEIF sNext1 == '[' //.AND. s_bArrayPrefix
ELSEIF sNext1 == '['
LOOP
ELSEIF sNext1 $ "+-*/:=^!><!$%#"
sExp += sNextToken
sLine := sNextLine
s_bArrayPrefix := .F.
#ifdef __HARBOUR__
SetArrayPrefix( .F. )
#else
s_bArrayPrefix := .F.
#endif
LOOP
ENDIF
@@ -4551,12 +4573,20 @@ STATIC FUNCTION NextExp( sLine, cType, aWords, aExp, sNextAnchor, bX )
IF IsAlpha( cLastChar ) .OR. IsDigit( cLastChar ) .OR. cLastChar $ "_.]"
sExp += sNextToken
sLine := sNextLine
s_bArrayPrefix := .F.
#ifdef __HARBOUR__
SetArrayPrefix( .F. )
#else
s_bArrayPrefix := .F.
#endif
ENDIF
ELSEIF sNext2 $ "->\:=\==\!=\<>\>=\<=\+=\-=\*=\/=\^=\**\%="
sExp += sNextToken
sLine := sNextLine
s_bArrayPrefix := .T.
#ifdef __HARBOUR__
SetArrayPrefix( .T. )
#else
s_bArrayPrefix := .T.
#endif
LOOP
ENDIF
@@ -4565,7 +4595,11 @@ STATIC FUNCTION NextExp( sLine, cType, aWords, aExp, sNextAnchor, bX )
IF sNext4 == ".OR."
sExp += sNextToken
sLine := sNextLine
s_bArrayPrefix := .F.
#ifdef __HARBOUR__
SetArrayPrefix( .F. )
#else
s_bArrayPrefix := .F.
#endif
LOOP
ENDIF
@@ -4575,7 +4609,11 @@ STATIC FUNCTION NextExp( sLine, cType, aWords, aExp, sNextAnchor, bX )
sExp += sNextToken
sLine := sNextLine
s_bArrayPrefix := .F.
LOOP
#ifdef __HARBOUR__
SetArrayPrefix( .F. )
#else
s_bArrayPrefix := .F.
#endif
ENDIF
ENDIF
@@ -4588,12 +4626,20 @@ STATIC FUNCTION NextExp( sLine, cType, aWords, aExp, sNextAnchor, bX )
IF cType == ","
sList += ( sExp + sNextToken )
sLine := sNextLine
s_bArrayPrefix := .F.
#ifdef __HARBOUR__
SetArrayPrefix( .F. )
#else
s_bArrayPrefix := .F.
#endif
sExp := ""
ELSEIF cType == "A"
aAdd( aExp, sExp )
sLine := sNextLine
s_bArrayPrefix := .F.
#ifdef __HARBOUR__
SetArrayPrefix( .F. )
#else
s_bArrayPrefix := .F.
#endif
sExp := ""
ELSE
//? "DONT CONTINUE: " + sLine
@@ -7396,7 +7442,7 @@ RETURN ""
FUNCTION PP_QSelf( o )
STATIC s_oSelf := NIL
LOCAL oPreset := s_oSelf
LOCAL oPreset := s_oSelf
IF ValType( o ) == 'O'
s_oSelf := o
@@ -7633,15 +7679,20 @@ STATIC FUNCTION InitRunResults()
RETURN .T.
//--------------------------------------------------------------//
PROCEDURE PP_RunInit( aProcedures )
PROCEDURE PP_RunInit( aProcedures, aInitExit )
IF ValType( aProcedures ) != 'A'
Alert( "Invalid parameter to: " + ProcName() + " must be Array!" )
IF ValType( aProcedures ) != 'A' .OR. ValType( aInitExit ) != 'A'
Alert( "Invalid parameters to: " + ProcName() + " must be Arrays!" )
ELSE
aSize( aProcedures, 0 )
ErrorBlock( {|oErr| RP_Run_Err( oErr, aProcedures ) } )
aSize( aInitExit, 2 )
aInitExit[1] := {}
aInitExit[2] := {}
ENDIF
ErrorBlock( {|oErr| RP_Run_Err( oErr, aProcedures ) } )
InitRules()
InitResults()
@@ -7659,18 +7710,22 @@ FUNCTION PP_PreProText( sLines, asLines )
asLines := {}
ENDIF
sLines := StrTran( sLines, Chr(13), "" )
sLines := StrTran( sLines, Chr(9), " " )
WHILE ( nOpen := nAtSkipStr( "/*", sLines ) ) > 0
sTemp += Left( sLines, nOpen - 1 )
nClose := nAtSkipStr( "*/", sLines, nOpen + 2 )
IF nClose == 0
ENDIF
WHILE ( nOpen := nAtSkipStr( Chr(10), sLines, nOpen + 1 ) ) > 0 .AND. nOpen < nClose
sTemp += Chr(10)
ENDDO
sLines := SubStr( sLines, nClose + 2 )
ENDDO
sLines := ( sTemp += sLines )
sLines := ( sTemp + sLines )
nOpen := 0
nOpen := 0
nClose := 0
WHILE ( nOpen := nAtSkipStr( ";", sLines, nOpen + 1 ) ) > 0
WHILE ( nOpen := nAtSkipStr( Chr(10), sLines, nOpen + 1 ) ) > 0
aAdd( asLines, SubStr( sLines, nClose + 1, nOpen - ( nClose + 1 ) ) )
nClose := nOpen
ENDDO
@@ -7712,26 +7767,22 @@ RETURN sLines
FUNCTION PP_RunText( sLines, bPP, aParams )
LOCAL aProcedures := {}, aInitExit := { {}, {} }, nProcId := 0, ;
nLine, nLines, xRet, asLines := {}, nProc, nOpen, nClose
nLine, nLines, xRet, asLines := {}, nOpen, nClose
IF bPP == NIL
bPP := .T.
ENDIF
IF ValType( aParams ) == 'A'
s_aParams := aParams
ENDIF
PP_RunInit( aProcedures, aInitExit )
ErrorBlock( {|oErr| RP_Comp_Err( oErr ) } )
IF bPP
PP_PreProText( sLines, asLines )
ELSE
nOpen := 0
sLines := StrTran( sLines, Chr(13), "" )
sLines := StrTran( sLines, Chr(9), " " )
nOpen := 0
nClose := 0
WHILE ( nOpen := nAtSkipStr( ";", sLines, nOpen + 1 ) ) > 0
WHILE ( nOpen := nAtSkipStr( Chr(10), sLines, nOpen + 1 ) ) > 0
aAdd( asLines, SubStr( sLines, nClose + 1, nOpen - ( nClose + 1 ) ) )
nClose := nOpen
ENDDO
@@ -7740,23 +7791,65 @@ FUNCTION PP_RunText( sLines, bPP, aParams )
ENDIF
ENDIF
ErrorBlock( {|oErr| RP_Comp_Err( oErr, asLines[nLine], nLine ) } )
nLines := Len( asLines )
FOR nLine := 1 TO nLines
PP_CompileLine( asLines[nLine], nLine, aProcedures, aInitExit, @nProcId )
NEXT
RETURN PP_Exec( aProcedures, aInitExit, nProcId, aParams )
//--------------------------------------------------------------//
FUNCTION PP_RunArray( asLines, aParams )
LOCAL aProcedures := {}, aInitExit := { {}, {} }, nProcId := 0, ;
nLine, nLines, nOpen, nClose
PP_RunInit( aProcedures, aInitExit )
ErrorBlock( {|oErr| RP_Comp_Err( oErr, asLines[nLine], nLine ) } )
nLines := Len( asLines )
FOR nLine := 1 TO nLines
PP_CompileLine( asLines[nLine], nLine, aProcedures, aInitExit, @nProcId )
NEXT
RETURN PP_Exec( aProcedures, aInitExit, nProcId, aParams )
//--------------------------------------------------------------//
FUNCTION PP_Exec( aProcedures, aInitExit, nProcId, aParams )
LOCAL nProc, nProcs, xRet
IF ValType( aParams ) == 'A'
s_aParams := aParams
ELSE
s_aParams := {}
ENDIF
ErrorBlock( {|oErr| RP_Run_Err( oErr, aProcedures ) } )
FOR nProc := 1 TO Len( aInitExit[1] )
InitRules()
InitResults()
InitRunRules()
InitRunResults()
nProcs := Len( aInitExit[1] )
FOR nProc := 1 TO nProcs
PP_ExecProcedure( aProcedures[ aInitExit[1][nProc] ] )
NEXT
FOR nProc := 1 TO nProcId
IF aScan( aInitExit[1], nProc ) == 0 .AND. aScan( aInitExit[2], nProc ) == 0
xRet := PP_ExecProcedure( aProcedures[nProc] )
EXIT
ENDIF
NEXT
FOR nProc := 1 TO Len( aInitExit[2] )
nProcs := Len( aInitExit[2] )
FOR nProc := 1 TO nProcs
PP_ExecProcedure( aProcedures[ aInitExit[2][nProc] ] )
NEXT

74
harbour/contrib/dot/pp_harb.ch
View File

@@ -2,6 +2,70 @@
#ifdef __HARBOUR__
#include "hbclass.ch"
CLASS TInterpreter
DATA cText
DATA acPPed
DATA aCompiledProcs
DATA aInitExit
DATA nProcs
METHOD New() INLINE ( ::nProcs := 0, ::cText := "", ::acPPed := {}, ::aCompiledProcs := {}, ::aInitExit := { {}, {} }, Self )
METHOD AddLine( cLine ) INLINE ( ::nProcs := 0, ::acPPed := {}, ::cText += ( cLine + Chr(10) ) )
METHOD SetScript( cText ) INLINE ( ::nProcs := 0, ::acPPed := {}, ::cText := cText )
METHOD Compile()
METHOD Run()
METHOD RunFile( cFile, aParams, cPPOExt, bBlanks ) INLINE PP_Run( cFile, aParams, cPPOExt, bBlanks )
METHOD ClearRules() INLINE PP_ResetRules()
METHOD InitStdRules() INLINE PP_InitStd()
METHOD LoadClass() INLINE PP_LoadClass()
METHOD LoadFiveWin() INLINE PP_LoadFw()
ENDCLASS
METHOD Run( p1, p2, p3, p4, p5, p6, p7, p8, p9 )
LOCAL aParams := HB_aParams(), xRet
IF ::nProcs == 0
::Compile()
ENDIF
IF ::nProcs > 0
xRet := PP_Exec( ::aCompiledProcs, ::aInitExit, ::nProcs, aParams )
ENDIF
RETURN xRet
METHOD Compile()
LOCAL nLine, nLines, nProcId := 0
IF Len( ::acPPed ) == 0
PP_InitStd()
PP_LoadRun()
PP_PreProText( ::cText, ::acPPed )
::aCompiledProcs := {}
::aInitExit := { {}, {} }
ENDIF
IF Len( ::aCompiledProcs ) == 0
ErrorBlock( {|oErr| RP_Comp_Err( oErr, ::acPPed[nLine], nLine ) } )
nLines := Len( ::acPPed )
FOR nLine := 1 TO nLines
PP_CompileLine( ::acPPed[nLine], nLine, ::aCompiledProcs, ::aInitExit, @nProcId )
NEXT
ENDIF
::nProcs := nProcId
RETURN nProcId > 0
#pragma BEGINDUMP
#include <ctype.h>
@@ -15,6 +79,16 @@
static BOOL s_bArrayPrefix = FALSE;
static HB_FUNC( SETARRAYPREFIX )
{
PHB_ITEM pbArrayPrefix = hb_param( 1, HB_IT_LOGICAL );
if( pbArrayPrefix != NULL )
{
s_bArrayPrefix = pbArrayPrefix->item.asLogical.value;
}
}
static HB_FUNC( NEXTTOKEN )
{
PHB_ITEM pLine = hb_param( 1, HB_IT_STRING );

57
harbour/contrib/dot/prgscrpt.prg
View File

@@ -1,21 +1,40 @@
Procedure Main( sMsg )
LOCAL sText, sPPed
LOCAL sText, sPPed, asPPed, oInterpreter := TInterpreter():New()
sText := "/* Sample Script for embedded PP " + ';'
sText += " have fun... */" + ';'
sText += "" + ';'
sText += "Procedure Test( cMacroVar, xValue )" + ';'
sText += "" + ';'
sText += " Local cVar := 'Hi There'" + ';'
sText += "" + ';'
sText += " &cMacroVar := xValue" + ';'
sText += "" + ';'
sText += " ? cVar, &cMacroVar" + ';'
sText += "" + ';'
sText += " WHILE Inkey() == 0 // WAIT" + ';'
sText += " ENDDO" + ';'
sText += "" + ';'
oInterpreter:AddLine( "/* Sample Script for embedded PP " )
oInterpreter:AddLine( "/* Sample Script for embedded PP " )
oInterpreter:AddLine( " have fun... */" )
oInterpreter:AddLine( "" )
oInterpreter:AddLine( "Procedure Test( cMacroVar, xValue )" )
oInterpreter:AddLine( "" )
oInterpreter:AddLine( " Local cVar := 'Hi There'" )
oInterpreter:AddLine( "" )
oInterpreter:AddLine( " &cMacroVar := xValue" )
oInterpreter:AddLine( "" )
oInterpreter:AddLine( " ? cVar, &cMacroVar" )
oInterpreter:AddLine( "" )
oInterpreter:AddLine( " WHILE Inkey() == 0 // WAIT" )
oInterpreter:AddLine( " ENDDO" )
oInterpreter:AddLine( "" )
oInterpreter:AddLine( "RETURN LastKey()" )
Alert( oInterpreter:Run( "Param1", "Param2" ) ) // Will automatically perform a ::Compile() first.
sText := "/* Sample Script for embedded PP " + Chr(10)
sText += " have fun... */" + Chr(10)
sText += "" + Chr(10)
sText += "Procedure Test( cMacroVar, xValue )" + Chr(10)
sText += "" + Chr(10)
sText += " Local cVar := 'Hi There'" + Chr(10)
sText += "" + Chr(10)
sText += " &cMacroVar := xValue" + Chr(10)
sText += "" + Chr(10)
sText += " ? cVar, &cMacroVar" + Chr(10)
sText += "" + Chr(10)
sText += " WHILE Inkey() == 0 // WAIT" + Chr(10)
sText += " ENDDO" + Chr(10)
sText += "" + Chr(10)
sText += "RETURN LastKey()"
Alert( PP_RunText( sText, .T., { "Private_1", 1000 } ) )
@@ -25,12 +44,18 @@ Procedure Main( sMsg )
sPPed := PP_PreProText( sText )
Alert( PP_RunText( sPPed, .F., { "Private_2", 2000 } ) )
//OR ...
asPPed := {}
PP_PreProText( sText, asPPed )
Alert( PP_RunArray( asPPed, { "Private_3", 3000 } ) )
// Now let's have some real fun...
IF sMsg == "Recursively running self"
Alert( "Let's STOP this madness..." )
RETURN
ELSE
PP_Run( "prgscrpt.prg", { "Recursively running self" } )
//PP_Run( "prgscrpt.prg", { "Recursively running self" } )
oInterpreter:RunFile( "prgscrpt.prg", { "Recursively running self" }, ".pp", .F. ) // Output PreProcessed extension .pp wirhout blanks.
ENDIF
return

2
harbour/include/hbapi.h
View File

@@ -388,7 +388,7 @@ extern BOOL hb_arrayCopy( PHB_ITEM pSrcArray, PHB_ITEM pDstArray, ULONG * pu
extern PHB_ITEM hb_arrayClone( PHB_ITEM pArray, PHB_NESTED_CLONED pClonedList ); /* returns a duplicate of an existing array, including all nested items */
extern BOOL hb_arraySort( PHB_ITEM pArray, ULONG * pulStart, ULONG * pulCount, PHB_ITEM pBlock ); /* sorts an array item */
extern PHB_ITEM hb_arrayFromStack( USHORT uiLen ); /* Creates and returns an Array of n Elements from the Eval Stack - Does NOT pop the items. */
extern PHB_ITEM hb_arrayFromParams( void ); /* Creates and returns an Array of current Generic Parameters. */
extern PHB_ITEM hb_arrayFromParams( PHB_ITEM *pBase ); /* Creates and returns an Array of Generic Parameters for specified base symbol. */
/* string management */

7
harbour/source/rtl/do.c
View File

@@ -37,6 +37,7 @@
#include "hbapiitm.h"
#include "hbapierr.h"
#include "hbvm.h"
#include "hbstack.h"
/* NOTE: DO() as a function is a Harbour extension. [vszakats] */
@@ -61,7 +62,8 @@ HB_FUNC( DO )
}
else
{
PHB_ITEM pArgsArray = hb_arrayFromParams();
PHB_ITEM pArgsArray = hb_arrayFromParams( hb_stack.pBase );
hb_errRT_BASE( EG_NOFUNC, 1001, NULL, hb_itemGetCPtr( pItem ), 1, pArgsArray );
hb_itemRelease( pArgsArray );
}
@@ -90,7 +92,8 @@ HB_FUNC( DO )
}
else
{
PHB_ITEM pArgsArray = hb_arrayFromParams();
PHB_ITEM pArgsArray = hb_arrayFromParams( hb_stack.pBase );
hb_errRT_BASE_SubstR( EG_ARG, 3012, NULL, "DO", 1, pArgsArray );
hb_itemRelease( pArgsArray );
}

8
harbour/source/vm/arrays.c
View File

@@ -859,11 +859,11 @@ PHB_ITEM hb_arrayFromStack( USHORT uiLen )
return pArray;
}
PHB_ITEM hb_arrayFromParams( void )
PHB_ITEM hb_arrayFromParams( PHB_ITEM *pBase )
{
PHB_ITEM pArray = hb_itemNew( NULL );
PHB_BASEARRAY pBaseArray = ( PHB_BASEARRAY ) hb_gcAlloc( sizeof( HB_BASEARRAY ), hb_arrayReleaseGarbage );
USHORT uiPos, uiPCount = hb_pcount();
USHORT uiPos, uiPCount = (* pBase)->item.asSymbol.paramcnt;
HB_TRACE(HB_TR_DEBUG, ("hb_arrayFromParams()"));
@@ -879,9 +879,9 @@ PHB_ITEM hb_arrayFromParams( void )
pBaseArray->uiClass = 0;
pBaseArray->uiPrevCls = 0;
for( uiPos = 2; uiPos <= uiPCount; uiPos++ )
for( uiPos = 0; uiPos < uiPCount; uiPos++ )
{
hb_itemCopy( pBaseArray->pItems + uiPos - 2, hb_stackItemFromBase( uiPos ) );
hb_itemCopy( pBaseArray->pItems + uiPos, *( pBase + uiPos + 2 ) );
}
pArray->item.asArray.value = pBaseArray;

11
harbour/source/vm/arrayshb.c
View File

@@ -302,3 +302,14 @@ HB_FUNC( ACLONE )
hb_itemRelease( hb_itemReturn( hb_arrayClone( pSrcArray, NULL ) ) ); /* AClone() returns the new array */
}
HB_FUNC( HB_APARAMS )
{
PHB_ITEM * pBase = hb_stack.pBase;
HB_TRACE(HB_TR_DEBUG, ("hb_stackDispCall()"));
pBase = hb_stack.pItems + ( *pBase )->item.asSymbol.stackbase;
hb_itemRelease( hb_itemReturn( hb_arrayFromParams( pBase ) ) );
}