From eb2d8afdb44badedcd50a6bbfe224669cae6f634 Mon Sep 17 00:00:00 2001 From: Ron Pinkas Date: Mon, 22 May 2000 13:53:14 +0000 Subject: [PATCH] 20000522-06:15 GMT-8 Ron Pinkas * source/compiler/harbour.l + Added "as structure", "as stru", "as array of structure", "as array of stru" * source/compiler/hbpcode.c * Improved some logic in hb_StrongType() * source/vm/hvm.c ! Corrected startup symbol when having to use Main() as per Ryszard. * source/pp/pptable.c + Added the equivalent of: #COMMANDS STRUCTURE AS [, AS ] => ; STATIC __ := {|| IF( __ == NIL, , ) , HB_Structure( <"StruName">, { <"Var1"> [, <"VarN">] } )} ;; DECLARE AS [ AS ] ;; #TRANSLATE AS NEW => AS CLASS := ( Eval( __ ), HB_Structure( ) ) #TRANSLATE AS NEW => AS CLASS := ():New() * source/rtl/tclass.prg + Added Function HB_Structure() ( Fully Declared! ) This function is used internally, but may be freely called from Clipper level. It Aceepts Parameter 1 Structure Name, and optional parameter 2, as array of structure variable names. If called with 2nd parameter, returns NIL (just creates the new Structure), if called with just parameter 1, it returns new instance of defined structure. + tests\teststru.prg + Added demo for new structure syntax --- harbour/ChangeLog | 29 +++++++++++++ harbour/source/compiler/harbour.l | 4 ++ harbour/source/compiler/hbpcode.c | 27 +++++++++---- harbour/source/pp/pptable.c | 7 +++- harbour/source/rtl/tclass.prg | 67 +++++++++++++++++++++++++++++++ harbour/source/vm/hvm.c | 2 +- harbour/tests/teststru.prg | 14 +++++++ harbour/tests/testwarn.prg | 1 - 8 files changed, 139 insertions(+), 12 deletions(-) create mode 100644 harbour/tests/teststru.prg diff --git a/harbour/ChangeLog b/harbour/ChangeLog index d8325158fd..0589d38961 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,32 @@ +20000522-06:15 GMT-8 Ron Pinkas + + * source/compiler/harbour.l + + Added "as structure", "as stru", "as array of structure", "as array of stru" + + * source/compiler/hbpcode.c + * Improved some logic in hb_StrongType() + + * source/vm/hvm.c + ! Corrected startup symbol when having to use Main() as per Ryszard. + + * source/pp/pptable.c + + Added the equivalent of: + #COMMANDS STRUCTURE AS [, AS ] => ; + STATIC __ := {|| IF( __ == NIL, , ) , HB_Structure( <"StruName">, { <"Var1"> [, <"VarN">] } )} ;; + DECLARE AS [ AS ] ;; + #TRANSLATE AS NEW => AS CLASS := ( Eval( __ ), HB_Structure( ) ) + + #TRANSLATE AS NEW => AS CLASS := ():New() + + * source/rtl/tclass.prg + + Added Function HB_Structure() ( Fully Declared! ) This function is used internally, but may be freely called from Clipper level. + It Aceepts Parameter 1 Structure Name, and optional parameter 2, as array of structure variable names. + If called with 2nd parameter, returns NIL (just creates the new Structure), if called with just parameter 1, it returns + new instance of defined structure. + + + tests\teststru.prg + + Added demo for new structure syntax + 20000522-01:51 DST Paul Tucker * include/hbcomp.h * adjust declaration of COMCLASS and COMDECLARE diff --git a/harbour/source/compiler/harbour.l b/harbour/source/compiler/harbour.l index 4e960ac5dc..2a9fa12b75 100644 --- a/harbour/source/compiler/harbour.l +++ b/harbour/source/compiler/harbour.l @@ -1439,6 +1439,8 @@ Separator {SpaceTab} "as character" { return AS_CHARACTER; } "as string" { return AS_CHARACTER; } "as class" { return AS_CLASS; } +"as stru" { return AS_CLASS; } +"as structure" { return AS_CLASS; } "as date" { return AS_DATE; } "as logical" { return AS_LOGICAL; } "as bool" { return AS_LOGICAL; } @@ -1458,6 +1460,8 @@ Separator {SpaceTab} "as array of character" { return AS_CHARACTER_ARRAY; } "as array of string" { return AS_CHARACTER_ARRAY; } "as array of class" { return AS_CLASS_ARRAY; } +"as array of stru" { return AS_CLASS_ARRAY; } +"as array of structure" { return AS_CLASS_ARRAY; } "as array of date" { return AS_DATE_ARRAY; } "as array of logical" { return AS_LOGICAL_ARRAY; } "as array of bool" { return AS_LOGICAL_ARRAY; } diff --git a/harbour/source/compiler/hbpcode.c b/harbour/source/compiler/hbpcode.c index 6c4ba4138e..3c87a22294 100644 --- a/harbour/source/compiler/hbpcode.c +++ b/harbour/source/compiler/hbpcode.c @@ -444,7 +444,10 @@ void hb_compStrongType( int iSize ) /*printf( "\nMethod: %s of Class: %s Parameters: %i\n", pSym->szName, pFunc->pStackClasses[ pFunc->iStackClasses - 1 ]->szName, pFunc->pStackFunctions[ pFunc->iStackFunctions - 1 ]->iParamCount );*/ if ( pFunc->pStackFunctions[ pFunc->iStackFunctions - 1 ] == NULL ) - hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_MESSAGE_NOT_FOUND, pSym->szName, pFunc->pStackClasses[ pFunc->iStackClasses - 1 ]->szName ); + if ( pSym->szName[0] == '_' ) + hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_MESSAGE_NOT_FOUND, &( pSym->szName[1] ), pFunc->pStackClasses[ pFunc->iStackClasses - 1 ]->szName ); + else + hb_compGenWarning( hb_comp_szWarnings, 'W', HB_COMP_WARN_MESSAGE_NOT_FOUND, pSym->szName, pFunc->pStackClasses[ pFunc->iStackClasses - 1 ]->szName ); } else { @@ -1250,9 +1253,14 @@ void hb_compStrongType( int iSize ) pVar = hb_compVariableFind( pTmp->pStatics, wVar - pTmp->iStaticsBase ); + /* Will be pushed shortly. */ + pFunc->iStackIndex++; + if ( pVar ) { - /*printf( "\nStatic: %s Function: %s Found in: %s\n", pVar->szName, pFunc->szName, pTmp->szName );*/ + /* + printf( "\nStatic: %s Type: %c Function: %s Found in: %s\n", pVar->szName, pVar->cType, pFunc->szName, pTmp->szName ); + */ /* Only if "private" static, since global static may be intialized elsewhere. */ /* May have been initialized in previous execution of the function. @@ -1264,23 +1272,22 @@ void hb_compStrongType( int iSize ) /* Mark as used */ pVar->iUsed |= VU_USED; - if ( pVar->cType == 'S' && pFunc->iStackClasses < 8 ) + if ( toupper( pVar->cType ) == 'S' && pFunc->iStackClasses < 8 ) { /* Object of declared class */ pFunc->pStackClasses[ pFunc->iStackClasses++ ] = pVar->pClass; - pFunc->pStack[ pFunc->iStackIndex++ ] = 'S'; } if ( pFunc->pCode[ ulPos ] == HB_P_PUSHSTATICREF ) - pFunc->pStack[ pFunc->iStackIndex++ ] = pVar->cType + VT_OFFSET_BYREF; + pFunc->pStack[ pFunc->iStackIndex - 1 ] = pVar->cType + VT_OFFSET_BYREF; else - pFunc->pStack[ pFunc->iStackIndex++ ] = pVar->cType; + pFunc->pStack[ pFunc->iStackIndex - 1 ] = pVar->cType; } else if ( pFunc->pCode[ ulPos ] == HB_P_PUSHSTATICREF ) - pFunc->pStack[ pFunc->iStackIndex++ ] = '@'; + pFunc->pStack[ pFunc->iStackIndex - 1 ] = '@'; else - pFunc->pStack[ pFunc->iStackIndex++ ] = ' '; + pFunc->pStack[ pFunc->iStackIndex - 1 ] = ' '; break; @@ -1439,6 +1446,10 @@ void hb_compStrongType( int iSize ) { BYTE cVarType = pFunc->pStack[ pFunc->iStackIndex - 1 ]; + /* + printf( "\n Base Type: %c\n", cVarType ); + */ + if ( cVarType >= ( 'A' + VT_OFFSET_VARIANT ) ) cVarType -= VT_OFFSET_VARIANT; diff --git a/harbour/source/pp/pptable.c b/harbour/source/pp/pptable.c index 0cec3d805b..b412eb757a 100644 --- a/harbour/source/pp/pptable.c +++ b/harbour/source/pp/pptable.c @@ -389,6 +389,9 @@ static COMMANDS sC___236 = {0,"SET","INDEX TO [ \1A40 [, \1B40]] [\1C20 ADDITIVE static COMMANDS sC___237 = {0,"SET","ORDER TO \1A00 [IN \1B40]","ordSetFocus( \1A00 [, \1B30] )",&sC___236 }; static COMMANDS sC___238 = {0,"SET","ORDER TO TAG \1A40 [IN \1B40]","ordSetFocus( \1A30 [, \1B30] )",&sC___237 }; static COMMANDS sC___239 = {0,"SET","ORDER TO","ordSetFocus(0)",&sC___238 }; +static COMMANDS sC___240 = {0,"STRUCTURE","\1A00 \1B00 AS \1C00 [, \1D00 AS \1E00 ]","STATIC __\1A00 := {|| IF(__\1A00 == NIL, , ) ,hb_structure( \1A20, { \1B20 [, \1D20] } )} ; DECLARE \1A00 \1B00 AS \1C00 [ \1D00 AS \1E00] ; #translate AS NEW \1A00 => AS CLASS \1A00 := ( Eval(__\1A00), hb_Structure( \1A20 ) )",&sC___239 }; -COMMANDS * hb_pp_topCommand = &sC___239; -COMMANDS * hb_pp_topTranslate = NULL; +static COMMANDS sT___1 = {0,"AS","NEW \1A00","AS CLASS \1A00 := \1A00():New()",NULL }; + +COMMANDS * hb_pp_topCommand = &sC___240; +COMMANDS * hb_pp_topTranslate = &sT___1; diff --git a/harbour/source/rtl/tclass.prg b/harbour/source/rtl/tclass.prg index acd1273228..abac15d88f 100644 --- a/harbour/source/rtl/tclass.prg +++ b/harbour/source/rtl/tclass.prg @@ -41,6 +41,10 @@ * Support for inheritance * Support for default DATA values * + * Copyright 2000 Ron Pinkas + * + * HB_Structure() + * * See doc/license.txt for licensing terms. * */ @@ -286,3 +290,66 @@ STATIC FUNCTION SetType( cType ) RETURN NIL //----------------------------------------------------------------------------// + +Function HB_Structure( cStructureName AS Char, aMembers AS Array OF Char ) + + STRUCTURE HB_Structure cName AS Char, hId As Num + + DECLARE __ClsNew( ClassName AS Char, N As Num ) AS Num + DECLARE __ClsAddMsg( H AS Num, Data AS Char, Type As Num, ID As Num ) AS Num + DECLARE __ClsInst( H AS Num ) AS Structure HB_Structure + + LOCAL hStructure AS Num, nCounter AS Num, nMembers AS Num + + STATIC asStructures AS Array OF Structure HB_Structure := {} + + STATIC sStructure AS Stru HB_Structure + + LOCAL hSelf As Num + + cStructureName := Upper( cStructureName ) + + hStructure := aScan( asStructures, { |aStructure| aStructure:cName == cStructureName } ) + + IF aMembers == NIL + IF hStructure == 0 + //hb_Structure( cStructureName, {} ) + RETURN NIL //hb_Structure( cStructureName ) + ELSE + RETURN __ClsInst( asStructures[ hStructure ]:hId ) + ENDIF + ELSE + IF hStructure > 0 + // Duplicate declaration + RETURN NIL + ENDIF + ENDIF + + nMembers := Len( aMembers ) + + hStructure := __ClsNew( cStructureName, nMembers ) + + FOR nCounter := 1 TO nMembers + __clsAddMsg( hStructure, aMembers[nCounter], nCounter, 1 ) + __clsAddMsg( hStructure, '_' + aMembers[nCounter], nCounter, 1 ) + NEXT + + IF sStructure == NIL + hSelf := __ClsNew( "HB_Structure", 2 ) + + __clsAddMsg( hSelf, "cName", 1, 1 ) + __clsAddMsg( hSelf, "_cName", 1, 1 ) + __clsAddMsg( hSelf, "hID", 2, 1 ) + __clsAddMsg( hSelf, "_hID", 2, 1 ) + + sStructure := __ClsInst( hSelf ) + ENDIF + + sStructure:cName := cStructureName + sStructure:hId := hStructure + + aAdd( asStructures, sStructure ) + +RETURN NIL //__clsInst( hStructure ) + +//----------------------------------------------------------------------------// diff --git a/harbour/source/vm/hvm.c b/harbour/source/vm/hvm.c index 0e237ca08b..9f1db2c1dd 100644 --- a/harbour/source/vm/hvm.c +++ b/harbour/source/vm/hvm.c @@ -4070,7 +4070,7 @@ void hb_vmProcessSymbols( PHB_SYMB pModuleSymbols, USHORT uiModuleSymbols ) /* m if( ( ! s_pSymStart ) && ( hSymScope & HB_FS_FIRST ) ) s_pSymStart = pModuleSymbols + ui; /* first public defined symbol to start execution */ - if( ( hSymScope == HB_FS_PUBLIC ) || ( hSymScope & ( HB_FS_MESSAGE | HB_FS_MEMVAR ) ) ) + if( ( hSymScope == HB_FS_PUBLIC ) || ( hSymScope & ( HB_FS_MESSAGE | HB_FS_MEMVAR | HB_FS_FIRST ) ) ) hb_dynsymNew( pModuleSymbols + ui ); } } diff --git a/harbour/tests/teststru.prg b/harbour/tests/teststru.prg new file mode 100644 index 0000000000..a29756869d --- /dev/null +++ b/harbour/tests/teststru.prg @@ -0,0 +1,14 @@ +STRUCTURE MyStruct Var1 As Char, Var2 As Num + +PROCEDURE MAIN() + + LOCAL sTest AS New MyStruct + + sTest:Var1 := 8 // Warning Here as Expected. + sTest:NoSuchVar := "Error" // Warning here as expected. + + sTest:Var1 := 'Working' // No problem here. + + ? sTest:Var1 // Np Problem here. + +RETURN diff --git a/harbour/tests/testwarn.prg b/harbour/tests/testwarn.prg index 0f826bb8e5..f18b846e03 100644 --- a/harbour/tests/testwarn.prg +++ b/harbour/tests/testwarn.prg @@ -6,7 +6,6 @@ #ifdef __HARBOUR__ #pragma -es0 #else - #TRANSLATE AS ARRAY [OF ] => #TRANSLATE AS CHAR =>