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

19991202-00:54 GMT+1 Victor Szel <info@szelvesz.hu>

Browse Source
This commit is contained in:
Viktor Szakats
1999-12-02 00:17:21 +00:00
parent 06da4c714d
commit c1de180e13
19 changed files with 1300 additions and 370 deletions
Download Patch File Download Diff File Expand all files Collapse all files

53
harbour/ChangeLog
View File

@@ -1,3 +1,56 @@
19991202-00:54 GMT+1 Victor Szel <info@szelvesz.hu>
* source/rtl/Makefile
+ New files added to the GNU make system.
* source/rtl/pvalue.c
tests/multiarg.prg
* HB_ prefix added to the PVALUE() function name.
19991202-00:54 GMT+1 Jose Lalin <dezac@corevia.com>
* source/rdd/dbnubs.c
! Warnings fixed.
* source/vm/hvm.c
- Removed all of this functions.
+ source/rtl/break.c
+ HARBOUR HB_BREAK( void )
+ source/rtl/empty.c
+ HARBOUR HB_EMPTY( void )
% Added support for MEMO type.
+ source/rtl/initexit.c
+ HARBOUR HB___QUIT( void )
+ source/rtl/len.c
+ HARBOUR HB_LEN( void )
% Added support for MEMO type.
+ source/rtl/pcount.c
+ HARBOUR HB_PCOUNT( void )
+ source/rtl/proc.c
+ HARBOUR HB_PROCNAME( void )
+ HARBOUR HB_PROCLINE( void )
+ HARBOUR HB_PROCFILE( void )
+ source/rtl/pvalue.c
+ HARBOUR HB_PVALUE( void )
+ source/rtl/type.c
+ HARBOUR HB_TYPE( void )
+ source/rtl/valtype.c
+ HARBOUR HB_VALTYPE( void )
% Added support for MEMO type.
+ source/rtl/word.c
+ HARBOUR HB_WORD( void )
+ source/rtl/xhelp.c (it should go to harbinit.prg)
+ HARBOUR HB___XHELP( void )
* All of them:
+ Added License agreement.
+ Added documentation.
+ Formatting
* makefile.b32
+ Updated with this new modules.
! WARNING ! Remember to update other makefiles.
* rdd.b32
+ Added dbeval.prg
* doc/pragma.txt
! Some typos fixed.
! Formatting.
(Uploaded by Victor Szel)
19991130-04:30 EST Paul Tucker <ptucker@sympatico.ca>
* source/pp/hbpp.c
* added a cast on xgrab call.

49
harbour/doc/pragma.txt
View File

@@ -4,26 +4,32 @@
INTRODUCTION
============
This file explains what is and how to use #pragma directive in Harbour.
This file explains what is and how to use the #pragma directive
with Harbour.
WHAT IS
=======
The #pragma is a directive used inside the source code in many compilers
to change the behaviour of the compiler at compile time.
PRAGMA
======
The #pragma is a directive used in many compilers to change at compile
time some flags inside the compiler itself.
USAGE
=====
Currently the #pragma directive can be used in two ways: switch mode and
command mode.
Currently the #pragma directive can be used in two ways: the switch mode
and the command mode.
The syntax is: #pragma <Expression>[=On/Off] or
#pragma -CompilerFlag[+|-]
The syntax is: #pragma <Expression>[=On/Off] or
#pragma -CompilerFlag[+|-]
Remember thar you can use both modes mixed in the same module and
upper/lower case without worry.
You can use both modes mixed in the same module and upper/lower case
without worry.
To enable/disable a command you simply do: <CommandName>=On/Off and
for switches you do: /<SwitchName>+/-
To enable or disable a command or a switch you simply do:
* Command mode Switch mode
--------------------------------------------------------------
* #pragma <CommandName>=On/Off #pragma /<SwitchName>+/-
Example: #pragma AddDebugInfo=Off /* Suppress debug info */
#pragma /B+ /* Add debug info from here */
@@ -32,7 +38,7 @@ for switches you do: /<SwitchName>+/-
IMPLEMENTATION
==============
This is the list of the supported commands and switchs:
This is the list of the supported commands and switches:
* Command Switch
-----------------------------------------------
@@ -47,20 +53,22 @@ This is the list of the supported commands and switchs:
* WARNINGLEVEL =<nLevel> /W<nLevel>
* SHORTCUTTING =<On/Off> /Z<+/->
The switchs have the same behaviour as the corresponding compiler ones
and the commands are sinonyms for the switchs.
The switches have the same behaviour as the corresponding compiler ones
and the commands are sinonyms for the switches.
* TRACEPRAGMAS
This command shows pragma activity when enabled.
This command shows pragma activity at compile time when enabled.
NOTE: You can use the abbreviated commands mode by typing only the
first eight chars.
NOTE: you can use the abbreviated commands mode by typing only the
first ten chars.
NOTES
=====
This directive is not supported in the standalone version of the Harbour
preprocessor.
EXAMPLES
========
@@ -74,6 +82,7 @@ This is the same as calling Harbour with the -n switch in the command line,
but with the great benefit that if you forgot to pass the switch if will be
used anyway because it is included inside the source.
=======
===========
Dec 1, 1999
Regards,
Jose Lalin <dezac@corevia.com>

37
harbour/makefile.b32
View File

@@ -25,25 +25,29 @@ PROJECT: harbour.exe harbour.lib lib\b32\terminal.lib lib\b32\termwin.lib
harbour.lib : achoice.obj adir.obj alert.obj arrays.obj \
asort.obj binnum.obj browdb.obj browse.obj \
classes.obj cmdarg.obj codebloc.obj copyfile.obj \
dates.obj dates2.obj datesx.obj dbedit.obj dbstrux.obj \
debug.obj debugger.obj descend.obj devoutp.obj \
dir.obj dircmd.obj do.obj dynsym.obj dummy.obj \
environ.obj errorapi.obj errorsys.obj extend.obj \
break.obj classes.obj cmdarg.obj codebloc.obj \
copyfile.obj dates.obj dates2.obj datesx.obj \
dbedit.obj dbstrux.obj debug.obj debugger.obj \
descend.obj devoutp.obj dir.obj dircmd.obj do.obj \
dynsym.obj dummy.obj empty.obj environ.obj \
errorapi.obj errorsys.obj extend.obj \
fieldbl.obj fileread.obj filesys.obj fm.obj \
harbinit.obj hardcr.obj hbfsapi.obj hbstr.obj hbtrace.obj hb_f.obj hvm.obj \
harbinit.obj hardcr.obj hbfsapi.obj hbstr.obj \
hbtrace.obj hb_f.obj hvm.obj initexit.obj \
initsymb.obj inkey.obj input.obj isprint.obj itemapi.obj \
langapi.obj mainstd.obj mainwin.obj math.obj \
langapi.obj len.obj mainstd.obj mainwin.obj math.obj \
mathx.obj memofile.obj memoline.obj memvars.obj \
memvarbl.obj menuto.obj mlcount.obj mtran.obj msgen.obj \
natmsg.obj net.obj objfunc.obj oldbox.obj oldclear.obj \
readvar.obj readkey.obj \
pcount.obj proc.obj pvalue.obj readvar.obj readkey.obj \
samples.obj set.obj setta.obj setcolor.obj \
setkey.obj setta.obj soundex.obj strfmt.obj \
strings.obj stringp.obj stringsx.obj symbols.obj \
tbcolumn.obj tbrowse.obj tbrwtext.obj tclass.obj \
terror.obj text.obj tget.obj tgetlist.obj tone.obj \
transfrm.obj xsavescr.obj wait.obj
trace.obj transfrm.obj type.obj valtype.obj \
wait.obj word.obj \
xhelp.obj xsavescr.obj
symbols.obj : symbols.asm
@@ -53,6 +57,7 @@ alert.obj : alert.c extend.h hbdefs.h
arrays.obj : arrays.c extend.h hbdefs.h
asort.obj : asort.c extend.h hbdefs.h
binnum.obj : binnum.c extend.h hbdefs.h
break.obj : break.c extend.h hbdefs.h
browdb.obj : browdb.c extend.h hbdefs.h
browse.obj : browse.c extend.h hbdefs.h
classes.obj : classes.c extend.h hbdefs.h
@@ -74,6 +79,7 @@ dircmd.obj : dircmd.c extend.h hbdefs.h
do.obj : do.c extend.h hbdefs.h
dynsym.obj : dynsym.c extend.h hbdefs.h
dummy.obj : dummy.c extend.h hbdefs.h
empty.obj : empty.c extend.h hbdefs.h
environ.obj : environ.c extend.h hbdefs.h
errorapi.obj : errorapi.c extend.h hbdefs.h
errorsys.obj : errorsys.c extend.h hbdefs.h
@@ -89,12 +95,14 @@ hbstr.obj : hbstr.c extend.h hbdefs.h
hbtrace.obj : hbtrace.c extend.h hbdefs.h
hb_f.obj : hb_f.c extend.h hbdefs.h
hvm.obj : hvm.c extend.h hbdefs.h
initexit.obj : initexit.c extend.h hbdefs.h
initsymb.obj : initsymb.c extend.h hbdefs.h
inkey.obj : inkey.c extend.h hbdefs.h
input.obj : input.c extend.h hbdefs.h
isprint.obj : isprint.c extend.h hbdefs.h
itemapi.obj : itemapi.c extend.h hbdefs.h
langapi.obj : langapi.c extend.h hbdefs.h
len.obj : len.c extend.h hbdefs.h
mainstd.obj : mainstd.c extend.h hbdefs.h
mainwin.obj : mainwin.c extend.h hbdefs.h
math.obj : math.c extend.h hbdefs.h
@@ -112,6 +120,9 @@ net.obj : net.c extend.h hbdefs.h
objfunc.obj : objfunc.c extend.h hbdefs.h
oldbox.obj : oldbox.c extend.h hbdefs.h
oldclear.obj : oldclear.c extend.h hbdefs.h
pcount.obj : pcount.c extend.h hbdefs.h
proc.obj : proc.c extend.h hbdefs.h
pvalue.obj : pvalue.c extend.h hbdefs.h
readkey.obj : readkey.c extend.h hbdefs.h
readvar.obj : readvar.c extend.h hbdefs.h
samples.obj : samples.c extend.h hbdefs.h
@@ -133,9 +144,13 @@ text.obj : text.c extend.h hbdefs.h
tget.obj : tget.c extend.h hbdefs.h
tgetlist.obj : tgetlist.c extend.h hbdefs.h
tone.obj : tone.c extend.h init.h inkey.h
trace.obj : trace.c extend.h init.h inkey.h
transfrm.obj : transfrm.c extend.h hbdefs.h
xsavescr.obj : xsavescr.c extend.h hbdefs.h
type.obj : type.c extend.h hbdefs.h
wait.obj : wait.c extend.h hbdefs.h
word.obj : word.c extend.h hbdefs.h
xhelp.obj : xhelp.c extend.h hbdefs.h
xsavescr.obj : xsavescr.c extend.h hbdefs.h
achoice.c : achoice.prg harbour.exe
adir.c : adir.prg harbour.exe
@@ -168,8 +183,8 @@ terror.c : terror.prg harbour.exe
text.c : text.prg harbour.exe
tget.c : tget.prg harbour.exe
tgetlist.c : tgetlist.prg harbour.exe
xsavescr.c : xsavescr.prg harbour.exe
wait.c : wait.prg harbour.exe
xsavescr.c : xsavescr.prg harbour.exe
.asm.obj:
tasm32 $<, $@

4
harbour/rdd.b32
View File

@@ -14,7 +14,7 @@
lib\b32\rdd.lib : rddsys.obj dbcmd.obj dbfntx1.obj dbfntx0.obj \
dbf0.obj dbf1.obj delim0.obj delim1.obj \
sdf0.obj sdf1.obj dbfcdx1.obj dbfcdx0.obj \
dbnubs.obj rddord.obj
dbnubs.obj rddord.obj dbeval.obj
dbf0.c : dbf0.prg
dbfntx0.c : dbfntx0.prg
@@ -23,6 +23,7 @@ sdf0.c : sdf0.prg
delim0.c : delim0.prg
dbfcdx0.c : dbfcdx0.prg
rddord.c : rddord.prg
dbeval.c : dbeval.prg
dbcmd.obj : dbcmd.c
rddsys.obj : rddsys.c
@@ -37,6 +38,7 @@ delim1.obj : delim1.c
dbfcdx0.obj : dbfcdx0.c
dbfcdx1.obj : dbfcdx1.c
dbnubs.obj : dbnubs.c
dbeval.obj : dbeval.c
.c.obj :
bcc32 -c -O2 -Iinclude -o$@ -v $<

46
harbour/source/rdd/dbnubs.c
View File

@@ -35,29 +35,29 @@
#include "hbdefs.h"
extern HARBOUR HB_DBSEEK();
extern HARBOUR HB_DBSKIP();
extern HARBOUR HB_DBGOTOP();
extern HARBOUR HB_DBGOBOTTOM();
extern HARBOUR HB_DBGOTO();
extern HARBOUR HB_DBAPPEND();
extern HARBOUR HB_DBDELETE();
extern HARBOUR HB_DBRECALL();
extern HARBOUR HB_DBCOMMITALL();
extern HARBOUR HB_DBUNLOCK();
extern HARBOUR HB_DBUNLOCKALL();
extern HARBOUR HB_DBSETFILTER();
extern HARBOUR HB_DBCLEARRELATION();
extern HARBOUR HB_DBSETRELATION();
extern HARBOUR HB_DBREINDEX();
extern HARBOUR HB_DBCREATEINDEX();
extern HARBOUR HB_DBCLEARINDEX();
extern HARBOUR HB_DBSETINDEX();
extern HARBOUR HB_DBSETORDER();
extern HARBOUR HB_DBCLOSEALL();
extern HARBOUR HB_DBCLOSEAREA();
extern HARBOUR HB_DBUSEAREA();
extern HARBOUR HB_DBSELECTAREA();
extern HARBOUR HB_DBSEEK( void );
extern HARBOUR HB_DBSKIP( void );
extern HARBOUR HB_DBGOTOP( void );
extern HARBOUR HB_DBGOBOTTOM( void );
extern HARBOUR HB_DBGOTO( void );
extern HARBOUR HB_DBAPPEND( void );
extern HARBOUR HB_DBDELETE( void );
extern HARBOUR HB_DBRECALL( void );
extern HARBOUR HB_DBCOMMITALL( void );
extern HARBOUR HB_DBUNLOCK( void );
extern HARBOUR HB_DBUNLOCKALL( void );
extern HARBOUR HB_DBSETFILTER( void );
extern HARBOUR HB_DBCLEARRELATION( void );
extern HARBOUR HB_DBSETRELATION( void );
extern HARBOUR HB_DBREINDEX( void );
extern HARBOUR HB_DBCREATEINDEX( void );
extern HARBOUR HB_DBCLEARINDEX( void );
extern HARBOUR HB_DBSETINDEX( void );
extern HARBOUR HB_DBSETORDER( void );
extern HARBOUR HB_DBCLOSEALL( void );
extern HARBOUR HB_DBCLOSEAREA( void );
extern HARBOUR HB_DBUSEAREA( void );
extern HARBOUR HB_DBSELECTAREA( void );
HARBOUR HB___DBSEEK( void )
{

152
harbour/source/rtl/Makefile
View File

@@ -5,85 +5,97 @@
ROOT = ../../
C_SOURCES=\
arrays.c \
binnum.c \
classes.c \
codebloc.c \
console.c \
copyfile.c \
dates.c \
descend.c \
dir.c \
do.c \
environ.c \
errorapi.c \
extend.c \
filesys.c \
fm.c \
gtapi.c \
hardcr.c \
inkey.c \
isprint.c \
itemapi.c \
langapi.c \
math.c \
memofile.c \
memoline.c \
memvars.c \
mlcount.c \
mouseapi.c \
mtran.c \
natmsg.c \
net.c \
oemansi.c \
oldbox.c \
oldclear.c \
samples.c \
set.c \
setcolor.c \
soundex.c \
strings.c \
tone.c \
trace.c \
transfrm.c \
arrays.c \
binnum.c \
break.c \
classes.c \
codebloc.c \
console.c \
copyfile.c \
dates.c \
descend.c \
dir.c \
do.c \
empty.c \
environ.c \
errorapi.c \
extend.c \
filesys.c \
fm.c \
gtapi.c \
hardcr.c \
initexit.c \
inkey.c \
isprint.c \
itemapi.c \
langapi.c \
len.c \
math.c \
memofile.c \
memoline.c \
memvars.c \
mlcount.c \
mouseapi.c \
mtran.c \
natmsg.c \
net.c \
oemansi.c \
oldbox.c \
oldclear.c \
pcount.c \
proc.c \
pvalue.c \
samples.c \
set.c \
setcolor.c \
soundex.c \
strings.c \
tone.c \
trace.c \
transfrm.c \
type.c \
valtype.c \
word.c \
xhelp.c \
\
gtxxx.c \
mousexxx.c \
msgxxx.c \
gtxxx.c \
mousexxx.c \
msgxxx.c \
PRG_SOURCES=\
achoice.prg \
adir.prg \
alert.prg \
asort.prg \
browdb.prg \
browse.prg \
dbedit.prg \
devoutp.prg \
dircmd.prg \
dummy.prg \
achoice.prg \
adir.prg \
alert.prg \
asort.prg \
browdb.prg \
browse.prg \
dbedit.prg \
devoutp.prg \
dircmd.prg \
dummy.prg \
errorsys.prg \
fieldbl.prg \
fieldbl.prg \
harbinit.prg \
input.prg \
memvarbl.prg \
menuto.prg \
objfunc.prg \
readkey.prg \
readvar.prg \
setfunc.prg \
setkey.prg \
setta.prg \
tclass.prg \
input.prg \
memvarbl.prg \
menuto.prg \
objfunc.prg \
readkey.prg \
readvar.prg \
setfunc.prg \
setkey.prg \
setta.prg \
tclass.prg \
tbcolumn.prg \
tbrowse.prg \
terror.prg \
text.prg \
tget.prg \
tbrowse.prg \
terror.prg \
text.prg \
tget.prg \
tgetlist.prg \
wait.prg \
wait.prg \
xsavescr.prg \
LIBNAME=rtl
include $(TOP)$(ROOT)config/lib.cf

76
harbour/source/rtl/break.c Normal file
View File

@@ -0,0 +1,76 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* BREAK() function
*
* Copyright 1999 {list of individual authors and e-mail addresses}
* 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 "extend.h"
#include "ctoharb.h"
/* $DOC$
* $FUNCNAME$
* BREAK
* $CATEGORY$
*
* $ONELINER$
* Exits from a BEGIN SEQUENCE block
* $SYNTAX$
* BREAK( <xExp> ) --> NIL
* $ARGUMENTS$
* <xExp> is any valid expression. It is allways required.
* If do not want to pass any argument, just use NIL.
* $RETURNS$
* NIL
* $DESCRIPTION$
* This function pass the control to the RECOVER statement in a
* BEGIN SEQUENCE block.
* $EXAMPLES$
* Break( NIL )
* $TESTS$
* $STATUS$
* R
* $COMPLIANCE$
* BREAK() is fully CA-Clipper compliant.
* $SEEALSO$
* BEGIN SEQUENCE
* $END$
*/
/* NOTE: This function should normally have a parameter count check. But
since in Harbour we cannot distinguish between BREAK() function and
the BREAK statement, because both generate a BREAK() function
call on the pcode level, we should drop the checking. */
HARBOUR HB_BREAK( void )
{
hb_vmRequestBreak( hb_param( 1, IT_ANY ) );
}

119
harbour/source/rtl/empty.c Normal file
View File

@@ -0,0 +1,119 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* EMPTY() function
*
* Copyright 1999 {list of individual authors and e-mail addresses}
* 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 "extend.h"
#include "itemapi.h"
/* $DOC$
* $FUNCNAME$
* EMPTY
* $CATEGORY$
*
* $ONELINER$
* Checks if the passed argument is empty.
* $SYNTAX$
* EMPTY( <xExp> ) --> <lIsEmpty>
* $ARGUMENTS$
* <xExp> is any valid expression.
* $RETURNS$
* A logical value. It is true (.T.) if the passed argument is empty
* otherwise it is false (.F.).
* $DESCRIPTION$
* This function checks if an expression has empty value and returns a
* logical indicating whether it the expression is empty or not.
* $EXAMPLES$
* ? Empty( "I'm not empty" )
* $TESTS$
* function Test()
* ? Empty( 1 ) --> .f.
* ? Empty( Date() ) --> .f.
* ? Empty( .f. ) --> .t.
* return nil
* $STATUS$
* R
* $COMPLIANCE$
* EMPTY() is fully CA-Clipper compliant.
* $SEEALSO$
* LEN
* $END$
*/
HARBOUR HB_EMPTY( void )
{
PHB_ITEM pItem = hb_param( 1, IT_ANY );
/* NOTE: pItem cannot be NULL here */
switch( pItem->type & ~IT_BYREF )
{
case IT_ARRAY:
hb_retl( hb_arrayLen( pItem ) == 0 );
break;
case IT_STRING:
case IT_MEMO:
hb_retl( hb_strEmpty( hb_itemGetCPtr( pItem ), hb_itemGetCLen( pItem ) ) );
break;
case IT_INTEGER:
hb_retl( hb_itemGetNI( pItem ) == 0 );
break;
case IT_LONG:
hb_retl( hb_itemGetNL( pItem ) == 0 );
break;
case IT_DOUBLE:
hb_retl( hb_itemGetND( pItem ) == 0.0 );
break;
case IT_DATE:
/* NOTE: This is correct ! Get the date as long value. */
hb_retl( hb_itemGetNL( pItem ) == 0 );
break;
case IT_LOGICAL:
hb_retl( ! hb_itemGetL( pItem ) );
break;
case IT_BLOCK:
hb_retl( FALSE );
break;
default:
hb_retl( TRUE );
break;
}
}

75
harbour/source/rtl/initexit.c Normal file
View File

@@ -0,0 +1,75 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* __QUIT() function
*
* Copyright 1999 {list of individual authors and e-mail addresses}
* 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 "extend.h"
#include "ctoharb.h"
/* $DOC$
* $FUNCNAME$
* __QUIT()
* $CATEGORY$
*
* $ONELINER$
* Terminates an application.
* $SYNTAX$
* __QUIT() --> NIL
* $ARGUMENTS$
* None
* $RETURNS$
* NIL
* $DESCRIPTION$
* This function terminates the current application and returns
* to the system.
* $EXAMPLES$
* See Test
* $TESTS$
* function EndApp( lYesNo )
* if lYesNo
* __Quit()
* endif
* return nil
* $STATUS$
* R
* $COMPLIANCE$
* __QUIT() is fully CA-Clipper compliant.
* $SEEALSO$
* QUIT command
* $END$
*/
HARBOUR HB___QUIT( void )
{
hb_vmRequestQuit();
}

103
harbour/source/rtl/len.c Normal file
View File

@@ -0,0 +1,103 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* LEN() function
*
* Copyright 1999 {list of individual authors and e-mail addresses}
* 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 "extend.h"
#include "errorapi.h"
#include "itemapi.h"
/* $DOC$
* $FUNCNAME$
* LEN
* $CATEGORY$
*
* $ONELINER$
* Returns size of a string or size of an array.
* $SYNTAX$
* LEN( <acString> ) --> <nLength>
* $ARGUMENTS$
* <acString> is a character string or the array to check.
* $RETURNS$
* The length of the string or the number of elements that contains
* an array.
* $DESCRIPTION$
* This function returns the string length or the size of an array. If
* it is used with a multidimensional array it returns the sizee of the
* first dimension.
* $EXAMPLES$
* ? Len( "Harbour" ) --> 7
* $TESTS$
* function Test()
* LOCAL cName := ""
* ACCEPT "Enter your name: " TO cName
* ? Len( cName )
* return nil
* $STATUS$
* R
* $COMPLIANCE$
* LEN() is fully CA-Clipper compliant.
* $SEEALSO$
* EMPTY, RTRIM, LTRIM
* $END$
*/
HARBOUR HB_LEN( void )
{
PHB_ITEM pItem = hb_param( 1, IT_ANY );
/* NOTE: pItem cannot be NULL here */
switch( pItem->type )
{
case IT_ARRAY:
hb_retnl( hb_arrayLen( pItem ) );
break;
case IT_STRING:
case IT_MEMO:
hb_retnl( hb_itemGetCLen( pItem ) );
break;
default:
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1111, NULL, "LEN" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
}

80
harbour/source/rtl/pcount.c Normal file
View File

@@ -0,0 +1,80 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* PCOUNT() function
*
* Copyright 1999 {list of individual authors and e-mail addresses}
* 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 "extend.h"
/* $DOC$
* $FUNCNAME$
* PCOUNT
* $CATEGORY$
*
* $ONELINER$
* Retrieves the number of arguments passed to a function.
* $SYNTAX$
* PCOUNT() --> <nArgs>
* $ARGUMENTS$
* None
* $RETURNS$
* Returns a number that indicates the number of arguments
* passed to a function or procedure.
* $DESCRIPTION$
* This function is useful to check if a function or procedure
* has received the required number of arguments.
* $EXAMPLES$
* See Test
* $TESTS$
* function Test( xExp )
* if PCount() == 0
* ? "This function needs a parameter"
* else
* ? xExp
* endif
* return nil
* $STATUS$
* R
* $COMPLIANCE$
* PCOUNT() is fully CA-Clipper compliant.
* $SEEALSO$
* PVALUE
* $END$
*/
HARBOUR HB_PCOUNT( void )
{
/* Skip current function */
PHB_ITEM pBase = hb_stack.pItems + hb_stack.pBase->item.asSymbol.stackbase;
hb_retni( pBase->item.asSymbol.paramcnt );
}

202
harbour/source/rtl/proc.c Normal file
View File

@@ -0,0 +1,202 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* PROCNAME(), PROCLINE() and PROCFILE() functions
*
* Copyright 1999 {list of individual authors and e-mail addresses}
* 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/).
*
*/
/*
* The following parts are Copyright of the individual authors.
* www - http://www.harbour-project.org
*
* Copyright 1999 Victor Szel <info@szelvesz.hu>
* HB_PROCFILE()
*
* See doc/license.txt for licensing terms.
*
*/
#include "extend.h"
/* $DOC$
* $FUNCNAME$
* PROCNAME
* $CATEGORY$
*
* $ONELINER$
* Gets the name of the current function on the stack
* $SYNTAX$
* PROCNAME( <nLevel> ) --> <cProcName>
* $ARGUMENTS$
* <nLevel> is the function level required.
* $RETURNS$
* Return the name of the function that it is being executed.
* $DESCRIPTION$
* This function look at the top of the stack and gets the current
* executed function if no arguments are passed. Otherwise it returns
* the name of the function or procedure at <nLevel>.
* $EXAMPLES$
* See Test
* $TESTS$
* This test will show the functions and procedures in stack
* before executing it.
* function Test()
* LOCAL n := 1
* while !Empty( ProcName( n ) )
* ? ProcName( n++ )
* end do
* return nil
* $STATUS$
* R
* $COMPLIANCE$
* PROCNAME() is fully CA-Clipper compliant.
* $SEEALSO$
* PROCLINE, PROCFILE
* $END$
*/
HARBOUR HB_PROCNAME( void )
{
int iLevel = hb_parni( 1 ) + 1; /* we are already inside ProcName() */
PHB_ITEM pBase = hb_stack.pBase;
while( ( iLevel-- > 0 ) && pBase != hb_stack.pItems )
pBase = hb_stack.pItems + pBase->item.asSymbol.stackbase;
if( ( iLevel == -1 ) )
{
if( ( pBase + 1 )->type == IT_ARRAY ) /* it is a method name */
{
char * szProcName;
szProcName = ( char * ) hb_xgrab( strlen( hb_objGetClsName( pBase + 1 ) ) + 1 +
strlen( pBase->item.asSymbol.value->szName ) + 1 );
strcpy( szProcName, hb_objGetClsName( pBase + 1 ) );
strcat( szProcName, ":" );
strcat( szProcName, pBase->item.asSymbol.value->szName );
hb_retc( szProcName );
hb_xfree( ( void * ) szProcName );
}
else
hb_retc( pBase->item.asSymbol.value->szName );
}
else
hb_retc( "" );
}
/* $DOC$
* $FUNCNAME$
* PROCLINE
* $CATEGORY$
*
* $ONELINER$
* Gets the line number of the current function on the stack
* $SYNTAX$
* PROCLINE( <nLevel> ) --> <nLine>
* $ARGUMENTS$
* <nLevel> is the function level required.
* $RETURNS$
* Return the line number of the function that it is being executed.
* $DESCRIPTION$
* This function look at the top of the stack and gets the current
* line number of executed function if no arguments are passed.
* Otherwise it returns the line number of the function or procedure
* at <nLevel>.
* $EXAMPLES$
* See Test
* $TESTS$
* function Test()
* ? ProcLine( 0 )
* ? ProcName( 2 )
* return nil
* $STATUS$
* R
* $COMPLIANCE$
* PROCLINE() is fully CA-Clipper compliant.
* $SEEALSO$
* PROCNAME, PROCFILE
* $END$
*/
HARBOUR HB_PROCLINE( void )
{
int iLevel = hb_parni( 1 ) + 1; /* we are already inside ProcName() */
PHB_ITEM pBase = hb_stack.pBase;
while( ( iLevel-- > 0 ) && pBase != hb_stack.pItems )
pBase = hb_stack.pItems + pBase->item.asSymbol.stackbase;
if( iLevel == -1 )
hb_retni( pBase->item.asSymbol.lineno );
else
hb_retni( 0 );
}
/* $DOC$
* $FUNCNAME$
* PROCFILE
* $CATEGORY$
*
* $ONELINER$
* This function allways returns an empty string.
* $SYNTAX$
* PROCFILE( <xExp> ) --> <cEmptyString>
* $ARGUMENTS$
* <xExp> is any valid type.
* $RETURNS$
* Return and empty string
* $DESCRIPTION$
* This function is added to the RTL for full compatibility. It allways
* returns an empty string.
* $EXAMPLES$
* ? ProcFile()
* $TESTS$
* function Test()
* ? ProcFile()
* ? ProcFile( NIL )
* ? ProcFile( 2 )
* return nil
* $STATUS$
* R
* $COMPLIANCE$
* PROCFILE() is fully CA-Clipper compliant.
* $SEEALSO$
* PROCNAME, PROCLINE
* $END$
*/
/* NOTE: Clipper undocumented function, which always returns an empty
string. */
HARBOUR HB_PROCFILE( void )
{
hb_retc( "" );
}

83
harbour/source/rtl/pvalue.c Normal file
View File

@@ -0,0 +1,83 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* HB_PVALUE() function
*
* Copyright 1999 Eddie Runia <eddie@runia.com>
* 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 "extend.h"
#include "errorapi.h"
#include "itemapi.h"
/* $DOC$
* $FUNCNAME$
* HB_PVALUE
* $CATEGORY$
*
* $ONELINER$
* Retrieves the value of an argument.
* $SYNTAX$
* HB_PVALUE( <nArg> ) --> <xExp>
* $ARGUMENTS$
* A number that indicates the argument to check.
* $RETURNS$
* Returns the value stored by an argument.
* $DESCRIPTION$
* This function is useful to check the value stored in an argument.
* $EXAMPLES$
* See Test
* $TESTS$
* function Test( nValue, cString )
* if PCount() == 2
* ? hb_PValue( 1 ), nValue
* ? hb_PValue( 2 ), cString
* endif
* return nil
* $STATUS$
* R
* $COMPLIANCE$
* HB_PVALUE() is a new function and hence not CA-Clipper compliant.
* $SEEALSO$
* PCOUNT
* $END$
*/
HARBOUR HB_HB_PVALUE( void )
{
USHORT uiParam = hb_parni( 1 );
PHB_ITEM pBase = hb_stack.pItems + hb_stack.pBase->item.asSymbol.stackbase; /* Skip function + self */
if( uiParam && uiParam <= pBase->item.asSymbol.paramcnt ) /* Valid number */
hb_itemReturn( pBase + 1 + uiParam );
else
hb_errRT_BASE( EG_ARG, 3011, NULL, "HB_PVALUE" );
}

69
harbour/source/rtl/type.c Normal file
View File

@@ -0,0 +1,69 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* TYPE() function
*
* Copyright 1999 {list of individual authors and e-mail addresses}
* 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 "extend.h"
/* $DOC$
* $FUNCNAME$
* TYPE
* $CATEGORY$
*
* $ONELINER$
* Retrieves the type of an expression
* $SYNTAX$
* TYPE( <cExp> ) --> <cReturnType>
* $ARGUMENTS$
* <cExp> is a character expression.
* $RETURNS$
* Returns a character indicating the type of the passed expression.
* $DESCRIPTION$
* This function returns one character which represents the date type
* of the argument.
* $EXAMPLES$
* See Test
* $TESTS$
* $STATUS$
* S
* $COMPLIANCE$
* TYPE() is
* $SEEALSO$
* VALTYPE
* $END$
*/
HARBOUR HB_TYPE( void )
{
/* TODO: Implement this. */
}

119
harbour/source/rtl/valtype.c Normal file
View File

@@ -0,0 +1,119 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* VALTYPE() function
*
* Copyright 1999 {list of individual authors and e-mail addresses}
* 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 "extend.h"
/* $DOC$
* $FUNCNAME$
* VALTYPE
* $CATEGORY$
*
* $ONELINER$
* Retrieves the data type of an expression
* $SYNTAX$
* VALTYPE( <xExp> ) --> <cReturnType>
* $ARGUMENTS$
* <xExp> is any valid expression.
* $RETURNS$
* Returns a character indicating the type of the passed expression.
* $DESCRIPTION$
* This function returns one character which represents the date type
* of the argument.
* $EXAMPLES$
* See Test
* $TESTS$
* function Test()
* ? ValType( Array( 1 ) ) --> "A"
* ? ValType( {|| 1 + 1 } ) --> "B"
* ? ValType( "HARBOUR" ) --> "C"
* ? ValType( Date() ) --> "D"
* ? ValType( .T. ) --> "L"
* ? ValType( 1 ) --> "N"
* ? ValType( TBrowse() ) --> "O"
* ? ValType( NIL ) --> "U"
* return nil
* $STATUS$
* R
* $COMPLIANCE$
* VALTYPE() is fully CA-Clipper compliant.
* $SEEALSO$
* TYPE
* $END$
*/
HARBOUR HB_VALTYPE( void )
{
PHB_ITEM pItem = hb_param( 1, IT_ANY );
/* NOTE: pItem cannot be NULL here */
switch( pItem->type & ~IT_BYREF )
{
case IT_ARRAY:
hb_retc( hb_arrayIsObject( pItem ) ? "O" : "A" );
break;
case IT_BLOCK:
hb_retc( "B" );
break;
case IT_DATE:
hb_retc( "D" );
break;
case IT_LOGICAL:
hb_retc( "L" );
break;
case IT_INTEGER:
case IT_LONG:
case IT_DOUBLE:
hb_retc( "N" );
break;
case IT_STRING:
hb_retc( "C" );
break;
case IT_MEMOFLAG:
hb_retc( "M" );
break;
case IT_NIL:
default:
hb_retc( "U" );
break;
}
}

77
harbour/source/rtl/word.c Normal file
View File

@@ -0,0 +1,77 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* WORD() function
*
* Copyright 1999 Victor Szel <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 "extend.h"
#include "errorapi.h"
#include "itemapi.h"
/* $DOC$
* $FUNCNAME$
* WORD
* $CATEGORY$
*
* $ONELINER$
* Converts double to integer values.
* $SYNTAX$
* WORD( <nDouble> ) --> <nInteger>
* $ARGUMENTS$
* <nDouble> is a numeric double value.
* $RETURNS$
* An integer in the range +-32767
* $DESCRIPTION$
* This function converts double values to integers to use
* within the CALL command
* $EXAMPLES$
* $TESTS$
* $STATUS$
* R
* $COMPLIANCE$
* WORD() is NOT fully CA-Clipper compliant.
* $SEEALSO$
* CALL command
* $END$
*/
/* INCOMPATIBILITY: The Clipper NG states that WORD() will only work when used
in CALL commands parameter list, otherwise it will return
NIL, in Harbour it will work anywhere. */
HARBOUR HB_WORD( void )
{
if( ISNUM( 1 ) )
hb_retni( hb_parni( 1 ) );
else
hb_errRT_BASE( EG_ARG, 1091, NULL, "WORD" );
}

80
harbour/source/rtl/xhelp.c Normal file
View File

@@ -0,0 +1,80 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* __XHELP() function
*
* Copyright 1999 Victor Szel <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 "extend.h"
#include "ctoharb.h"
/* $DOC$
* $FUNCNAME$
* __XHELP()
* $CATEGORY$
* Internal
* $ONELINER$
* Looks if a Help() user defined function exist.
* $SYNTAX$
* __XHELP() --> <xValue>
* $ARGUMENTS$
* None
* $RETURNS$
* This function returns aleatory values.
* $DESCRIPTION$
* This is an internal undocumented Clipper function, which will
* try to call the user defined function HELP() if it's defined
* in the current application. This is the default SetKey() handler
* for the F1 key.
* $EXAMPLES$
* $TESTS$
* $STATUS$
* R
* $COMPLIANCE$
* __XHELP() is fully CA-Clipper compliant.
* $SEEALSO$
*
* $END$
*/
HARBOUR HB___XHELP( void )
{
PHB_DYNS pDynSym = hb_dynsymFind( "HELP" );
if( pDynSym )
{
hb_vmPushSymbol( pDynSym->pSymbol );
hb_vmPushNil();
hb_vmDo( 0 );
/* NOTE: Leave the return value as it is. */
}
}

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

@@ -37,11 +37,6 @@
* The following parts are Copyright of the individual authors.
* www - http://www.harbour-project.org
*
* Copyright 1999 Victor Szel <info@szelvesz.hu>
* HB_WORD()
* HB___XHELP()
* HB_PROCFILE()
*
* Copyright 1999 Eddie Runia <eddie@runia.com>
* HB___VMVARSGET()
* HB___VMVARSLIST()
@@ -3413,191 +3408,6 @@ void hb_vmForceLink( void )
/* ----------------------------- */
/* TODO: Put these to /source/rtl/?.c */
HARBOUR HB_LEN( void )
{
PHB_ITEM pItem = hb_param( 1, IT_ANY );
/* NOTE: pItem cannot be NULL here */
switch( pItem->type )
{
case IT_ARRAY:
hb_retnl( hb_arrayLen( pItem ) );
break;
case IT_STRING:
hb_retnl( hb_itemGetCLen( pItem ) );
break;
default:
{
PHB_ITEM pResult = hb_errRT_BASE_Subst( EG_ARG, 1111, NULL, "LEN" );
if( pResult )
{
hb_itemReturn( pResult );
hb_itemRelease( pResult );
}
}
}
}
HARBOUR HB_EMPTY( void )
{
PHB_ITEM pItem = hb_param( 1, IT_ANY );
/* NOTE: pItem cannot be NULL here */
switch( pItem->type & ~IT_BYREF )
{
case IT_ARRAY:
hb_retl( hb_arrayLen( pItem ) == 0 );
break;
case IT_STRING:
hb_retl( hb_strEmpty( hb_itemGetCPtr( pItem ), hb_itemGetCLen( pItem ) ) );
break;
case IT_INTEGER:
hb_retl( hb_itemGetNI( pItem ) == 0 );
break;
case IT_LONG:
hb_retl( hb_itemGetNL( pItem ) == 0 );
break;
case IT_DOUBLE:
hb_retl( hb_itemGetND( pItem ) == 0.0 );
break;
case IT_DATE:
/* NOTE: This is correct ! Get the date as long value. */
hb_retl( hb_itemGetNL( pItem ) == 0 );
break;
case IT_LOGICAL:
hb_retl( ! hb_itemGetL( pItem ) );
break;
case IT_BLOCK:
hb_retl( FALSE );
break;
default:
hb_retl( TRUE );
break;
}
}
HARBOUR HB_VALTYPE( void )
{
PHB_ITEM pItem = hb_param( 1, IT_ANY );
/* NOTE: pItem cannot be NULL here */
switch( pItem->type & ~IT_BYREF )
{
case IT_ARRAY:
hb_retc( hb_arrayIsObject( pItem ) ? "O" : "A" );
break;
case IT_BLOCK:
hb_retc( "B" );
break;
case IT_DATE:
hb_retc( "D" );
break;
case IT_LOGICAL:
hb_retc( "L" );
break;
case IT_INTEGER:
case IT_LONG:
case IT_DOUBLE:
hb_retc( "N" );
break;
case IT_STRING:
hb_retc( "C" );
break;
case IT_NIL:
default:
hb_retc( "U" );
break;
}
}
HARBOUR HB_TYPE( void )
{
/* TODO: Implement this. */
}
/* INCOMPATIBILITY: The Clipper NG states that WORD() will only work when used
in CALL commands parameter list, otherwise it will return
NIL, in Harbour it will work anywhere. */
HARBOUR HB_WORD( void )
{
if( ISNUM( 1 ) )
hb_retni( hb_parni( 1 ) );
else
hb_errRT_BASE( EG_ARG, 1091, NULL, "WORD" );
}
HARBOUR HB_PROCNAME( void )
{
int iLevel = hb_parni( 1 ) + 1; /* we are already inside ProcName() */
PHB_ITEM pBase = hb_stack.pBase;
while( ( iLevel-- > 0 ) && pBase != hb_stack.pItems )
pBase = hb_stack.pItems + pBase->item.asSymbol.stackbase;
if( ( iLevel == -1 ) )
{
if( ( pBase + 1 )->type == IT_ARRAY ) /* it is a method name */
{
char * szProcName;
szProcName = ( char * ) hb_xgrab( strlen( hb_objGetClsName( pBase + 1 ) ) + 1 +
strlen( pBase->item.asSymbol.value->szName ) + 1 );
strcpy( szProcName, hb_objGetClsName( pBase + 1 ) );
strcat( szProcName, ":" );
strcat( szProcName, pBase->item.asSymbol.value->szName );
hb_retc( szProcName );
hb_xfree( ( void * ) szProcName );
}
else
hb_retc( pBase->item.asSymbol.value->szName );
}
else
hb_retc( "" );
}
HARBOUR HB_PROCLINE( void )
{
int iLevel = hb_parni( 1 ) + 1; /* we are already inside ProcName() */
PHB_ITEM pBase = hb_stack.pBase;
while( ( iLevel-- > 0 ) && pBase != hb_stack.pItems )
pBase = hb_stack.pItems + pBase->item.asSymbol.stackbase;
if( iLevel == -1 )
hb_retni( pBase->item.asSymbol.lineno );
else
hb_retni( 0 );
}
/* NOTE: Clipper undocumented function, which always returns an empty
string. */
HARBOUR HB_PROCFILE( void )
{
hb_retc( "" );
}
HARBOUR HB_ERRORLEVEL( void )
{
hb_retni( s_byErrorLevel );
@@ -3610,31 +3420,6 @@ HARBOUR HB_ERRORLEVEL( void )
s_byErrorLevel = hb_parni( 1 );
}
HARBOUR HB_PCOUNT( void )
{
/* Skip current function */
PHB_ITEM pBase = hb_stack.pItems + hb_stack.pBase->item.asSymbol.stackbase;
hb_retni( pBase->item.asSymbol.paramcnt );
}
HARBOUR HB_PVALUE( void ) /* PValue( <nArg> ) */
{
USHORT uiParam = hb_parni( 1 ); /* Get parameter */
PHB_ITEM pBase = hb_stack.pItems + hb_stack.pBase->item.asSymbol.stackbase;
/* Skip function + self */
if( uiParam && uiParam <= pBase->item.asSymbol.paramcnt ) /* Valid number */
hb_itemReturn( pBase + 1 + uiParam );
else
hb_errRT_BASE( EG_ARG, 3011, NULL, "PVALUE" );
}
HARBOUR HB___QUIT( void )
{
hb_vmRequestQuit();
}
void hb_vmRequestQuit( void )
{
HB_TRACE(HB_TR_DEBUG, ("hb_vmRequestQuit()"));
@@ -3662,16 +3447,6 @@ USHORT hb_vmRequestQuery( void )
return s_uiActionRequest;
}
/* NOTE: This function should normally have a parameter count check. But
since in Harbour we cannot distinguish between BREAK() function and
the BREAK statement, because both generate a BREAK() function
call on the pcode level, we should drop the checking. */
HARBOUR HB_BREAK( void )
{
hb_vmRequestBreak( hb_param( 1, IT_ANY ) );
}
void hb_vmRequestCancel( void )
{
HB_TRACE(HB_TR_DEBUG, ("hb_vmRequestCancel()"));
@@ -3689,24 +3464,6 @@ void hb_vmRequestCancel( void )
}
}
/* NOTE: This is an internal undocumented Clipper function, which will try
to call the function HELP() if it's defined. This is the default
SetKey() handler for the F1 key. */
HARBOUR HB___XHELP( void )
{
PHB_DYNS pDynSym = hb_dynsymFind( "HELP" );
if( pDynSym )
{
hb_vmPushSymbol( pDynSym->pSymbol );
hb_vmPushNil();
hb_vmDo( 0 );
/* NOTE: Leave the return value as it is. */
}
}
/* $Doc$
* $FuncName$ <aStat> __vmVarSList()
* $Description$ Return the statics array
@@ -3730,4 +3487,3 @@ HARBOUR HB___VMVARSGET( void )
hb_itemReturn( s_aStatics.item.asArray.value->pItems +
hb_stack.iStatics + hb_parni( 1 ) - 1 );
}

2
harbour/tests/multiarg.prg
View File

@@ -26,5 +26,5 @@ return nil
function ShoutArg( nArg, x1,x2,x3,x4,x5,x6,x7,x8,x9,x10 )
QOut( nArg, "==", PValue( nArg ) )
QOut( nArg, "==", hb_PValue( nArg ) )
return nil