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

20000402-22:32 GMT+1 Victor Szakats <info@szelvesz.hu>

Browse Source
This commit is contained in:
Viktor Szakats
2000-04-02 20:54:13 +00:00
parent 139b263a28
commit b82af55dbf
17 changed files with 205 additions and 93 deletions
Download Patch File Download Diff File Expand all files Collapse all files

33
harbour/ChangeLog
View File

@@ -1,3 +1,36 @@
20000402-22:32 GMT+1 Victor Szakats <info@szelvesz.hu>
* utils/hbtest/rt_hvm.prg
+ TYPE() basic tests added.
One new case fails.
* source/rtl/type.c
! TYPE() runtime error value substitution added.
* include/hbdefs.h
* source/rtl/hardcr.c
* source/rtl/mtran.c
% Repeated CHR_HARD/SOFT macros moved to the global header.
* source/vm/cmdarg.c
% Minor stack space opt.
* source/rtl/strzero.c
* Minor change in comment.
+ source/rtl/setposbs.c
* source/rtl/setpos.c
* source/rtl/Makefile
* makefile.bc
* makefile.vc
* SETPOSBS() separated.
* source/rtl/version.c
! Small memory allocation fix.
* source/rtl/gtapi.c
* Cast
20000402-21:40 GMT+1 Maurilio Longo <maurilio.longo@libero.it>
* utils/hbdoc/MakeFile

8
harbour/include/hbdefs.h
View File

@@ -180,4 +180,12 @@ typedef BYTE HB_ATTR;
#define HB_CHAR_CR '\r' /* 13 - Carriage return */
#define HB_CHAR_EOF '\x1A' /* 26 - End of file marker */
/* Harbour specific character constants */
#define HB_CHAR_HARD1 ( ( char ) HB_CHAR_CR )
#define HB_CHAR_HARD2 ( ( char ) HB_CHAR_LF )
#define HB_CHAR_SOFT1 ( ( char ) 141 )
#define HB_CHAR_SOFT2 ( ( char ) HB_CHAR_LF )
#endif /* HB_DEFS_H_ */

5
harbour/makefile.bc
View File

@@ -224,6 +224,7 @@ RTL_LIB_OBJS = \
$(OBJ_DIR)\setcolor.obj \
$(OBJ_DIR)\setcurs.obj \
$(OBJ_DIR)\setpos.obj \
$(OBJ_DIR)\setposbs.obj \
$(OBJ_DIR)\shadow.obj \
$(OBJ_DIR)\soundex.obj \
$(OBJ_DIR)\space.obj \
@@ -1352,6 +1353,10 @@ $(OBJ_DIR)\setpos.obj : $(RTL_DIR)\setpos.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\setposbs.obj : $(RTL_DIR)\setposbs.c
$(CC) $(CLIBFLAGS) -o$@ $**
tlib $(RTL_LIB) -+$@,,
$(OBJ_DIR)\setta.c : $(RTL_DIR)\setta.prg
$(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@

1
harbour/makefile.vc
View File

@@ -263,6 +263,7 @@ RTL_LIB_OBJS = \
$(OBJ_DIR)\setcolor.obj \
$(OBJ_DIR)\setcurs.obj \
$(OBJ_DIR)\setpos.obj \
$(OBJ_DIR)\setposbs.obj \
$(OBJ_DIR)\shadow.obj \
$(OBJ_DIR)\soundex.obj \
$(OBJ_DIR)\space.obj \

3
harbour/source/common/hbver.c
View File

@@ -56,11 +56,8 @@
be ahead of any and all #include statements!
*/
/* 02/04/2000 - maurilio.longo@libero.it
DosXXX apis are needed by GCC as well */
#if defined(__IBMCPP__) || defined(HARBOUR_GCC_OS2)
#define INCL_DOSMISC
#include <os2.h>
#endif
#define HB_OS_WIN_32_USED

1
harbour/source/rtl/Makefile
View File

@@ -82,6 +82,7 @@ C_SOURCES=\
setcolor.c \
setcurs.c \
setpos.c \
setposbs.c \
shadow.c \
soundex.c \
space.c \

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

@@ -430,7 +430,8 @@ USHORT hb_gtGetColorStr( char * fpColorString )
USHORT hb_gtSetColorStr( char * fpColorString )
{
char c, buff[ 6 ];
char c;
char buff[ 6 ];
BOOL bHasI = FALSE;
BOOL bHasU = FALSE;
BOOL bHasX = FALSE;
@@ -442,7 +443,7 @@ USHORT hb_gtSetColorStr( char * fpColorString )
HB_TRACE(HB_TR_DEBUG, ("hb_gtSetColorStr(%s)", fpColorString));
if( fpColorString == NULL )
if( fpColorString == ( char * ) NULL )
return 1;
if( *fpColorString == '\0' )

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

@@ -36,11 +36,6 @@
#include "hbapi.h"
#include "hbapiitm.h"
#define CHR_HARD1 ( ( char ) HB_CHAR_CR )
#define CHR_SOFT1 ( ( char ) 141 )
#define CHR_SOFT2 ( ( char ) HB_CHAR_LF )
char * hb_strHardCR( char * pszString, ULONG ulStringLen )
{
ULONG ulStringPos;
@@ -49,10 +44,10 @@ char * hb_strHardCR( char * pszString, ULONG ulStringLen )
for( ulStringPos = 0; ulStringPos < ulStringLen; ulStringPos++ )
{
if( pszString[ ulStringPos ] == CHR_SOFT1 &&
pszString[ ulStringPos + 1 ] == CHR_SOFT2 )
if( pszString[ ulStringPos ] == HB_CHAR_SOFT1 &&
pszString[ ulStringPos + 1 ] == HB_CHAR_SOFT2 )
{
pszString[ ulStringPos ] = CHR_HARD1;
pszString[ ulStringPos ] = HB_CHAR_HARD1;
}
}

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

@@ -36,14 +36,7 @@
#include "hbapi.h"
#include "hbapiitm.h"
#define CHR_HARD1 ( ( char ) HB_CHAR_CR )
#define CHR_HARD2 ( ( char ) HB_CHAR_LF )
#define CHR_SOFT1 ( ( char ) 141 )
#define CHR_SOFT2 ( ( char ) HB_CHAR_LF )
/* NOTE: pszResult must have an allocated buffer of at least */
/* ulStringLen */
/* NOTE: pszResult must have an allocated buffer of at least ulStringLen */
char * hb_strMemotran( char * pszResult, ULONG * ulResultLen, const char * pszString, ULONG ulStringLen, char cHardcr, char cSoftcr )
{
@@ -54,14 +47,14 @@ char * hb_strMemotran( char * pszResult, ULONG * ulResultLen, const char * pszSt
while( ulStringPos < ulStringLen )
{
if( pszString[ ulStringPos ] == CHR_HARD1 &&
pszString[ ulStringPos + 1 ] == CHR_HARD2 )
if( pszString[ ulStringPos ] == HB_CHAR_HARD1 &&
pszString[ ulStringPos + 1 ] == HB_CHAR_HARD2 )
{
pszResult[ ulResultPos++ ] = cHardcr;
ulStringPos += 2;
}
else if( pszString[ ulStringPos ] == CHR_SOFT1 &&
pszString[ ulStringPos + 1 ] == CHR_SOFT2 )
else if( pszString[ ulStringPos ] == HB_CHAR_SOFT1 &&
pszString[ ulStringPos + 1 ] == HB_CHAR_SOFT2 )
{
pszResult[ ulResultPos++ ] = cSoftcr;
ulStringPos += 2;

21
harbour/source/rtl/setpos.c
View File

@@ -4,10 +4,9 @@
/*
* Harbour Project source code:
* SETPOS(), SETPOSBS() functions
* SETPOS(), ROW(), COL() functions
*
* Copyright 1999 David G. Holm <dholm@jsd-llc.com>
* Copyright 1999 Victor Szakats <info@szelvesz.hu>
* Copyright 1999 Bil Simser <bsimser@home.com>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
@@ -41,9 +40,6 @@
* Copyright 1999 David G. Holm <dholm@jsd-llc.com>
* SETPOS()
*
* Copyright 1999 Victor Szakats <info@szelvesz.hu>
* SETPOSBS()
*
* See doc/license.txt for licensing terms.
*
*/
@@ -57,19 +53,6 @@ HB_FUNC( SETPOS ) /* Sets the screen position */
hb_gtSetPos( hb_parni( 1 ), hb_parni( 2 ) );
}
/* NOTE: CA-Cl*pper undocumented */
HB_FUNC( SETPOSBS ) /* Move the screen position to the right by one column */
{
SHORT iRow, iCol;
/* NOTE: CA-Cl*pper does no checks about reaching the border or anything.
[vszakats] */
hb_gtGetPos( &iRow, &iCol );
hb_gtSetPos( iRow, iCol + 1 );
}
HB_FUNC( ROW ) /* Return the current screen row position (zero origin) */
{
SHORT iRow;

52
harbour/source/rtl/setposbs.c Normal file
View File

@@ -0,0 +1,52 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* SETPOSBS() function
*
* Copyright 1999 Victor Szakats <info@szelvesz.hu>
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version, with one exception:
*
* The exception is that if you link the Harbour Runtime Library (HRL)
* and/or the Harbour Virtual Machine (HVM) with other files to produce
* an executable, this does not by itself cause the resulting executable
* to be covered by the GNU General Public License. Your use of that
* executable is in no way restricted on account of linking the HRL
* and/or HVM code into it.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA (or visit
* their web site at http://www.gnu.org/).
*
*/
#include "hbapi.h"
#include "hbapigt.h"
/* NOTE: CA-Cl*pper undocumented */
HB_FUNC( SETPOSBS ) /* Move the screen position to the right by one column */
{
SHORT iRow;
SHORT iCol;
/* NOTE: CA-Cl*pper does no checks about reaching the border or anything.
[vszakats] */
hb_gtGetPos( &iRow, &iCol );
hb_gtSetPos( iRow, iCol + 1 );
}

3
harbour/source/rtl/strzero.c
View File

@@ -80,8 +80,7 @@ HB_FUNC( STRZERO )
if( szResult[ ulPos ] == '-' )
{
/* Negative sign found, put the negative sign to the first */
/* position */
/* NOTE: Negative sign found, put it to the first position */
szResult[ ulPos ] = ' ';

11
harbour/source/rtl/type.c
View File

@@ -43,5 +43,14 @@ HB_FUNC( TYPE )
if( pItem )
hb_retc( hb_macroGetType( pItem ) );
else
hb_errRT_BASE( EG_ARG, 1121, NULL, "TYPE" );
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1121, NULL, "TYPE" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}

2
harbour/source/rtl/version.c
View File

@@ -70,7 +70,7 @@ HB_FUNC( VERSION )
{
char * pszCompiler = hb_verCompiler();
pszVersion = ( char * ) hb_xrealloc( pszVersion, strlen( pszVersion ) + strlen( pszCompiler ) + 3 );
pszVersion = ( char * ) hb_xrealloc( pszVersion, strlen( pszVersion ) + strlen( pszCompiler ) + ( 4 * sizeof( char ) ) );
strcat( pszVersion, " (" );
strcat( pszVersion, pszCompiler );

49
harbour/source/vm/cmdarg.c
View File

@@ -110,7 +110,6 @@ static char * hb_cmdargGet( const char * pszName, BOOL bRetValue )
if( pszEnvVar != NULL )
{
static const char * szSeparator = " ;,\t";
char * pszNext;
/* Step through all envvar switches. */
@@ -123,6 +122,7 @@ static char * hb_cmdargGet( const char * pszName, BOOL bRetValue )
while( *pszNext )
{
static const char * szSeparator = " ;,\t";
char * pszEnd;
/* Search for the end of this switch */
@@ -278,38 +278,42 @@ void hb_cmdargProcessVM( void )
{
if( hb_cmdargCheck( "INFO" ) )
{
char * pszVersion;
char buffer[ 128 ];
{
char * pszVersion = hb_verHarbour();
hb_conOutErr( pszVersion, 0 );
hb_conOutErr( hb_conNewLine(), 0 );
hb_xfree( pszVersion );
}
pszVersion = hb_verHarbour();
hb_conOutErr( pszVersion, 0 );
hb_conOutErr( hb_conNewLine(), 0 );
hb_xfree( pszVersion );
{
char * pszVersion = hb_verPlatform();
hb_conOutErr( pszVersion, 0 );
hb_conOutErr( hb_conNewLine(), 0 );
hb_xfree( pszVersion );
}
pszVersion = hb_verPlatform();
hb_conOutErr( pszVersion, 0 );
hb_conOutErr( hb_conNewLine(), 0 );
hb_xfree( pszVersion );
sprintf( buffer, "DS avail=%luKB OS avail=%luKB EMM avail=%luKB", hb_xquery( HB_MEM_BLOCK ), hb_xquery( HB_MEM_VM ), hb_xquery( HB_MEM_EMS ) );
hb_conOutErr( buffer, 0 );
hb_conOutErr( hb_conNewLine(), 0 );
{
char buffer[ 128 ];
sprintf( buffer, "DS avail=%luKB OS avail=%luKB EMM avail=%luKB", hb_xquery( HB_MEM_BLOCK ), hb_xquery( HB_MEM_VM ), hb_xquery( HB_MEM_EMS ) );
hb_conOutErr( buffer, 0 );
hb_conOutErr( hb_conNewLine(), 0 );
}
}
if( hb_cmdargCheck( "BUILD" ) )
{
char * pszCompiler;
hb_conOutErr( "Harbour Compiler Build Info", 0 );
hb_conOutErr( hb_conNewLine(), 0 );
hb_conOutErr( "---------------------------", 0 );
hb_conOutErr( hb_conNewLine(), 0 );
pszCompiler = hb_verCompiler();
hb_conOutErr( "Compiler: ", 0 );
hb_conOutErr( pszCompiler, 0 );
hb_conOutErr( hb_conNewLine(), 0 );
hb_xfree( pszCompiler );
{
char * pszVersion = hb_verCompiler();
hb_conOutErr( "Compiler: ", 0 );
hb_conOutErr( pszVersion, 0 );
hb_conOutErr( hb_conNewLine(), 0 );
hb_xfree( pszVersion );
}
hb_conOutErr( "Strict CA-Clipper compatibility: ", 0 );
#if defined( HARBOUR_STRICT_CLIPPER_COMPATIBILITY )
@@ -369,7 +373,6 @@ void hb_cmdargProcessVM( void )
{
char buffer[ 64 ];
sprintf( buffer, "Maximum symbol name length: %i", HB_SYMBOL_NAME_LEN );
hb_conOutErr( buffer, 0 );
hb_conOutErr( hb_conNewLine(), 0 );

44
harbour/utils/hbdoc/Makefile
View File

@@ -12,32 +12,32 @@ PRG_SOURCES=\
hbdoc.prg \
genos2.prg \
gentrf.prg \
genng.prg \
genhtm.prg \
genrtf.prg \
genhpc.prg \
genasc.prg \
html.prg \
ng.prg \
os2.prg \
rtf.prg \
troff.prg \
fclass1.prg \
ffile1.prg \
ft_funcs.prg \
genng.prg \
genhtm.prg \
genrtf.prg \
genhpc.prg \
genasc.prg \
html.prg \
ng.prg \
os2.prg \
rtf.prg \
troff.prg \
fclass1.prg \
ffile1.prg \
ft_funcs.prg \
PRG_MAIN=hbdoc.prg
LIBS=\
debug \
vm \
rtl \
rdd \
rtl \
vm \
macro \
pp \
common \
debug \
vm \
rtl \
rdd \
rtl \
vm \
macro \
pp \
common \
include $(TOP)$(ROOT)config/bin.cf

32
harbour/utils/hbtest/rt_hvm.prg
View File

@@ -137,6 +137,38 @@ FUNCTION Main_HVM()
TEST_LINE( ValType( @maArray ) , "A" ) /* Bug in CA-Cl*pper, it will return "U" */
#endif
/* TYPE() */
TEST_LINE( Type( NIL ) , "E BASE 1121 Argument error TYPE F:S" )
TEST_LINE( Type( 100 ) , "E BASE 1121 Argument error TYPE F:S" )
TEST_LINE( Type( {} ) , "E BASE 1121 Argument error TYPE F:S" )
TEST_LINE( Type( "w_TEST->TYPE_C" ) , "C" )
TEST_LINE( Type( "w_TEST->TYPE_D" ) , "D" )
TEST_LINE( Type( "w_TEST->TYPE_M" ) , "M" )
TEST_LINE( Type( "w_TEST->TYPE_N_I" ) , "N" )
TEST_LINE( Type( "w_TEST->TYPE_N_D" ) , "N" )
TEST_LINE( Type( "w_TEST->TYPE_L" ) , "L" )
TEST_LINE( Type( "mxNotHere" ) , "U" )
TEST_LINE( Type( "mcString" ) , "C" )
TEST_LINE( Type( "mcStringE" ) , "C" )
TEST_LINE( Type( "mcStringZ" ) , "C" )
TEST_LINE( Type( "mnIntZ" ) , "N" )
TEST_LINE( Type( "mnDoubleZ" ) , "N" )
TEST_LINE( Type( "mnIntP" ) , "N" )
TEST_LINE( Type( "mnLongP" ) , "N" )
TEST_LINE( Type( "mnDoubleP" ) , "N" )
TEST_LINE( Type( "mnIntN" ) , "N" )
TEST_LINE( Type( "mnLongN" ) , "N" )
TEST_LINE( Type( "mnDoubleN" ) , "N" )
TEST_LINE( Type( "mnDoubleI" ) , "N" )
TEST_LINE( Type( "mdDateE" ) , "D" )
TEST_LINE( Type( "mlFalse" ) , "L" )
TEST_LINE( Type( "mlTrue" ) , "L" )
TEST_LINE( Type( "moObject" ) , "O" )
TEST_LINE( Type( "muNIL" ) , "U" )
TEST_LINE( Type( "mbBlock" ) , "B" )
TEST_LINE( Type( "maArray" ) , "A" )
/* Special internal messages */
/* Harbour compiler not yet handles these */