diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 8fa2572168..d900315b5c 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,36 @@ +2001-06-01 10:30 UTC-0800 Ron Pinkas + * 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 * source/rdd/dbcmd.c diff --git a/harbour/contrib/dot/pp.prg b/harbour/contrib/dot/pp.prg index 0e6f8a9cc5..ee1e1c4327 100644 --- a/harbour/contrib/dot/pp.prg +++ b/harbour/contrib/dot/pp.prg @@ -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 := .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 diff --git a/harbour/contrib/dot/pp_harb.ch b/harbour/contrib/dot/pp_harb.ch index a4fa9e9f63..b2a9f6cac7 100644 --- a/harbour/contrib/dot/pp_harb.ch +++ b/harbour/contrib/dot/pp_harb.ch @@ -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 @@ -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 ); diff --git a/harbour/contrib/dot/prgscrpt.prg b/harbour/contrib/dot/prgscrpt.prg index dc974dfe90..869e966653 100644 --- a/harbour/contrib/dot/prgscrpt.prg +++ b/harbour/contrib/dot/prgscrpt.prg @@ -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 diff --git a/harbour/include/hbapi.h b/harbour/include/hbapi.h index 9547c76a90..ebc4e35aac 100644 --- a/harbour/include/hbapi.h +++ b/harbour/include/hbapi.h @@ -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 */ diff --git a/harbour/source/rtl/do.c b/harbour/source/rtl/do.c index 79fbf10538..f993adb2dd 100644 --- a/harbour/source/rtl/do.c +++ b/harbour/source/rtl/do.c @@ -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 ); } diff --git a/harbour/source/vm/arrays.c b/harbour/source/vm/arrays.c index 7d3b1acdf6..75a7b4f72b 100644 --- a/harbour/source/vm/arrays.c +++ b/harbour/source/vm/arrays.c @@ -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; diff --git a/harbour/source/vm/arrayshb.c b/harbour/source/vm/arrayshb.c index 7d26ab3b81..c7b5e6f31b 100644 --- a/harbour/source/vm/arrayshb.c +++ b/harbour/source/vm/arrayshb.c @@ -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 ) ) ); +} +