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

See change log

Browse Source
This commit is contained in:
Eddie Runia
1999-05-19 11:55:04 +00:00
parent ed21ac4d0f
commit d484e5e22e
9 changed files with 328 additions and 104 deletions
Download Patch File Download Diff File Expand all files Collapse all files

12
harbour/ChangeLog
View File

@@ -1,3 +1,15 @@
19990519-12:50 CET Eddie Runia
* source/compiler/harbour.y
Some clean up
* source/tests/broken/runner.c | run_exp.h | stub.bat
removed
* source/tests/working/runner.c | run_exp.h | stub.bat
added runner code
* source/tests/working/spawn.prg
spawn example program
* source/tests/working/readhrb.prg + readhrb.lnk
Clipper program to read .HRB files
19990518-23:15 David G. Holm <dholm@jsd-llc.com>
* makefile.b31
- Put all common BCC options in c_opt macro to make it easy to switch to

7
harbour/source/compiler/harbour.y
View File

@@ -3363,7 +3363,7 @@ char * strupr( char * p )
void GenPortObj( char *szFileName, char *szName )
{
PFUNCTION pFunc = functions.pFirst, pFTemp;
PFUNCTION pFunc = functions.pFirst;
PCOMSYMBOL pSym = symbols.pFirst;
WORD w, wLen, wSym, wVar;
LONG lPCodePos;
@@ -3372,6 +3372,7 @@ void GenPortObj( char *szFileName, char *szName )
char chr;
FILE * yyc; /* file handle for C output */
szName = szName;
if( ! ( yyc = fopen( szFileName, "wb" ) ) )
{
printf( "Error opening file %s\n", szFileName );
@@ -3412,13 +3413,13 @@ void GenPortObj( char *szFileName, char *szName )
/* specify the function address if it is a defined function or a
external called function */
if( ( pFTemp = GetFunction( pSym->szName ) ) ) /* is it a defined function ? */
if( GetFunction( pSym->szName ) ) /* is it a defined function ? */
{
fputc( SYM_FUNC, yyc );
}
else
{
if( ( pFTemp = GetFuncall( pSym->szName ) ) )
if( GetFuncall( pSym->szName ) )
{
fputc( SYM_EXTERN, yyc );
}

78
harbour/tests/broken/run_exp.h
View File

@@ -1,78 +0,0 @@
/*
*
* This file contains the exportable functions available to the Harbour program
*
* Currently being discussed in 'Static initializers'
*
* If the discussion has finished, it can be removed from here.
*
* Currently containing :
*
* Arrays
* Console
* HVM
*
*/
HARBOUR ARRAY();
HARBOUR AADD();
HARBOUR ASIZE();
HARBOUR ATAIL();
HARBOUR AINS();
HARBOUR ADEL();
HARBOUR AFILL();
HARBOUR ASCAN();
HARBOUR AEVAL();
HARBOUR ACOPY();
HARBOUR ACLONE();
HARBOUR __ACCEPT();
HARBOUR OUTSTD();
HARBOUR QQOUT();
HARBOUR QOUT();
HARBOUR ERRORSYS();
HARBOUR ERRORNEW();
HARBOUR EVAL();
HARBOUR VALTYPE();
HARBOUR UPPER();
HARBOUR VAL();
HARBOUR STRDUMP();
HARBOUR TRIM();
HARBOUR LTRIM();
HARBOUR RTRIM();
HARBOUR CHR();
/* Same story.
All the function pointers of the internal functions
Including Runner itself, since the first symbol gets executed by Harbour ;-)
*/
static SYMBOL symbols[] = {
{ "Runner", FS_PUBLIC, Runner , 0 },
{ "ARRAY", FS_PUBLIC, ARRAY , 0 },
{ "AADD", FS_PUBLIC, AADD , 0 },
{ "ASIZE", FS_PUBLIC, ASIZE , 0 },
{ "ATAIL", FS_PUBLIC, ATAIL , 0 },
{ "AINS", FS_PUBLIC, AINS , 0 },
{ "ADEL", FS_PUBLIC, ADEL , 0 },
{ "AFILL", FS_PUBLIC, AFILL , 0 },
{ "ASCAN", FS_PUBLIC, ASCAN , 0 },
{ "AEVAL", FS_PUBLIC, AEVAL , 0 },
{ "ACOPY", FS_PUBLIC, ACOPY , 0 },
{ "ACLONE", FS_PUBLIC, ACLONE , 0 },
{ "__ACCEPT", FS_PUBLIC, __ACCEPT, 0 },
{ "OUTSTD", FS_PUBLIC, OUTSTD , 0 },
{ "QQOUT", FS_PUBLIC, QQOUT , 0 },
{ "QOUT", FS_PUBLIC, QOUT , 0 },
{ "ERRORSYS", FS_PUBLIC, ERRORSYS, 0 },
{ "ERRORNEW", FS_PUBLIC, ERRORNEW, 0 },
{ "EVAL", FS_PUBLIC, EVAL , 0 },
{ "VALTYPE", FS_PUBLIC, VALTYPE , 0 },
{ "UPPER", FS_PUBLIC, UPPER , 0 },
{ "STRDUMP", FS_PUBLIC, STRDUMP , 0 },
{ "TRIM", FS_PUBLIC, TRIM , 0 },
{ "LTRIM", FS_PUBLIC, LTRIM , 0 },
{ "RTRIM", FS_PUBLIC, RTRIM , 0 },
{ "CHR", FS_PUBLIC, CHR , 0 },
{ "VAL", FS_PUBLIC, VAL , 0 }
};

5
harbour/tests/working/readhrb.lnk Normal file
View File

@@ -0,0 +1,5 @@
OUTPUT READHRB.exe
FILE READHRB.OBJ
LIB BLXCLP52, BLXRATEX

102
harbour/tests/working/readhrb.prg Normal file
View File

@@ -0,0 +1,102 @@
/*
ReadHRB
This program will read the .HRB file and shows its contents
ReadHRB <program file> {No .HRB extension please}
*/
function Main( cFrom )
local hFile
local cBlock := " "
local n, m
local nVal
local nSymbols
local nFuncs
local cMode := "SYMBOL"
local cScope
local nLenCount
SET EXACT ON
SET DATE TO BRITISH
SET ALTERNATE TO readhrb.out
SET ALTERNATE ON
if cFrom == NIL
cFrom := "hello.hrb"
else
cFrom := cFrom + ".hrb"
endif
hFile := fOpen( cFrom )
cBlock := fReadStr( hFile, 4 )
nSymbols := asc(substr(cBlock,1,1)) +;
asc(substr(cBlock,2,1)) *256 +;
asc(substr(cBlock,3,1)) *65536 +;
asc(substr(cBlock,4,1)) *16777216
for n := 1 to nSymbols
cBlock := fReadStr( hFile, 1 )
do while asc( cBlock ) != 0
QQOut( cBlock )
cBlock := fReadStr( hFile, 1 )
enddo
cScope := fReadStr( hFile, 1 )
QQOut(" Scope ", Hex2Val(asc(cScope)))
cScope := fReadStr( hFile, 1 )
QQOut(" Type ", { "NOLINK", "FUNC", "EXTERN" }[ asc(cScope)+1 ] )
QOut()
next n
cBlock := fReadStr( hFile, 4 )
nFuncs := asc(substr(cBlock,1,1)) +;
asc(substr(cBlock,2,1)) *256 +;
asc(substr(cBlock,3,1)) *65536 +;
asc(substr(cBlock,4,1)) *16777216
for n := 1 to nFuncs
QOut()
cBlock := fReadStr( hFile, 1 )
do while asc( cBlock ) != 0
QQOut( cBlock )
cBlock := fReadStr( hFile, 1 )
enddo
QOut( "Len = " )
cBlock := fReadStr( hFile, 4 )
nLenCount := asc(substr(cBlock,1,1)) +;
asc(substr(cBlock,2,1)) *256 +;
asc(substr(cBlock,3,1)) *65536 +;
asc(substr(cBlock,4,1)) *16777216 +1
QQOut( str(nLenCount) )
QOut()
for m:=1 to nLenCount
cBlock := fReadStr( hFile, 1 )
nVal := asc( cBlock )
QQOut( Hex2Val( nVal ) )
if nVal > 32 .and. nVal < 128
QQOut( "("+cBlock+")" )
endif
if m != nLenCount
QQOut(",")
endif
next m
next n
fClose( cFrom )
SET ALTERNATE OFF
CLOSE ALTERNATE
return nil
function Hex2Val( nVal )
return HexDigit( int(nVal / 16) ) + HexDigit( int(nVal % 16) )
function HexDigit( nDigit )
return if(nDigit>=10, chr( 55 + nDigit ), chr( 48 + nDigit ) )

118
harbour/tests/working/run_exp.h Normal file
View File

@@ -0,0 +1,118 @@
/*
*
* This file contains the exportable functions available to the Harbour program
*
* Currently being discussed in 'Static initializers'
*
* If the discussion has finished, it can be removed from here.
*
* Currently containing :
*
* Arrays
* ASort
* Classes
* Console
* HVM
*
*/
HARBOUR ARRAY();
HARBOUR AADD();
HARBOUR ASIZE();
HARBOUR ATAIL();
HARBOUR AINS();
HARBOUR ADEL();
HARBOUR AFILL();
HARBOUR ASCAN();
HARBOUR AEVAL();
HARBOUR ACOPY();
HARBOUR ACLONE();
HARBOUR __ACCEPT();
HARBOUR OUTSTD();
HARBOUR QQOUT();
HARBOUR QOUT();
HARBOUR ERRORSYS();
HARBOUR ERRORNEW();
HARBOUR EVAL();
HARBOUR VALTYPE();
HARBOUR UPPER();
HARBOUR VAL();
HARBOUR ASORT();
HARBOUR CLASSCREATE();
HARBOUR CLASSADD();
HARBOUR CLASSNAME();
HARBOUR CLASSINSTANCE();
HARBOUR ISMESSAGE();
HARBOUR OSEND();
HARBOUR CLASSMOD();
HARBOUR CLASSDEL();
HARBOUR OCLONE();
HARBOUR CTOD();
HARBOUR DTOC();
HARBOUR DTOS();
HARBOUR STOD();
HARBOUR DAY();
HARBOUR MONTH();
HARBOUR YEAR();
HARBOUR TIME();
HARBOUR HB_SETCENTURY();
HARBOUR SET();
HARBOUR LTRIM();
HARBOUR RTRIM();
HARBOUR ALLTRIM();
HARBOUR TRIM();
/* Same story.
All the function pointers of the internal functions
Including Runner itself, since the first symbol gets executed by Harbour ;-)
*/
static SYMBOL symbols[] = {
{ "HB_RUN", FS_PUBLIC, HB_RUN , 0 },
{ "ARRAY", FS_PUBLIC, ARRAY , 0 },
{ "AADD", FS_PUBLIC, AADD , 0 },
{ "ASIZE", FS_PUBLIC, ASIZE , 0 },
{ "ATAIL", FS_PUBLIC, ATAIL , 0 },
{ "AINS", FS_PUBLIC, AINS , 0 },
{ "ADEL", FS_PUBLIC, ADEL , 0 },
{ "AFILL", FS_PUBLIC, AFILL , 0 },
{ "ASCAN", FS_PUBLIC, ASCAN , 0 },
{ "AEVAL", FS_PUBLIC, AEVAL , 0 },
{ "ACOPY", FS_PUBLIC, ACOPY , 0 },
{ "ACLONE", FS_PUBLIC, ACLONE , 0 },
{ "__ACCEPT", FS_PUBLIC, __ACCEPT , 0 },
{ "OUTSTD", FS_PUBLIC, OUTSTD , 0 },
{ "QQOUT", FS_PUBLIC, QQOUT , 0 },
{ "QOUT", FS_PUBLIC, QOUT , 0 },
{ "ERRORSYS", FS_PUBLIC, ERRORSYS , 0 },
{ "ERRORNEW", FS_PUBLIC, ERRORNEW , 0 },
{ "EVAL", FS_PUBLIC, EVAL , 0 },
{ "VALTYPE", FS_PUBLIC, VALTYPE , 0 },
{ "UPPER", FS_PUBLIC, UPPER , 0 },
{ "VAL", FS_PUBLIC, VAL , 0 },
{ "ASORT", FS_PUBLIC, ASORT , 0 },
{ "CLASSCREATE", FS_PUBLIC, CLASSCREATE , 0 },
{ "CLASSADD", FS_PUBLIC, CLASSADD , 0 },
{ "CLASSNAME", FS_PUBLIC, CLASSNAME , 0 },
{ "CLASSINSTANCE", FS_PUBLIC, CLASSINSTANCE , 0 },
{ "ISMESSAGE", FS_PUBLIC, ISMESSAGE , 0 },
{ "OSEND", FS_PUBLIC, OSEND , 0 },
{ "CLASSMOD", FS_PUBLIC, CLASSMOD , 0 },
{ "CLASSDEL", FS_PUBLIC, CLASSDEL , 0 },
{ "OCLONE", FS_PUBLIC, OCLONE , 0 },
{ "CTOD", FS_PUBLIC, CTOD , 0 },
{ "DTOC", FS_PUBLIC, DTOC , 0 },
{ "DTOS", FS_PUBLIC, DTOS , 0 },
{ "STOD", FS_PUBLIC, STOD , 0 },
{ "DAY", FS_PUBLIC, DAY , 0 },
{ "MONTH", FS_PUBLIC, MONTH , 0 },
{ "YEAR", FS_PUBLIC, YEAR , 0 },
{ "TIME", FS_PUBLIC, TIME , 0 },
{ "HB_SETCENTURY", FS_PUBLIC, HB_SETCENTURY , 0 },
{ "SET", FS_PUBLIC, SET , 0 },
{ "TRIM", FS_PUBLIC, TIME , 0 },
{ "LTRIM", FS_PUBLIC, LTRIM , 0 },
{ "RTRIM", FS_PUBLIC, RTRIM , 0 },
{ "ALLTRIM", FS_PUBLIC, ALLTRIM , 0 }
};

97
harbour/tests/broken/runner.c → harbour/tests/working/runner.c
View File

@@ -1,6 +1,7 @@
#include "pcode.h"
#include <stdio.h>
/* #if DOS32 */
static BYTE prgFunction[] = { 0x68, 0x00, 0x00, 0x00, 0x00,
0x68, 0x00, 0x00, 0x00, 0x00,
@@ -37,9 +38,14 @@ typedef struct
#define SYM_FUNC 1 /* Defined function */
#define SYM_EXTERN 2 /* Previously defined function */
PASM_CALL CreateFun( PSYMBOL, PBYTE ); /* Create a dynamic function*/
#define SYM_NOT_FOUND 0xFFFFFFFF /* Symbol not found. FindSymbol */
HARBOUR Runner();
PASM_CALL CreateFun( PSYMBOL, PBYTE ); /* Create a dynamic function*/
HARBOUR HB_RUN();
void PushSymbol( PSYMBOL );
void PushNil( void );
void Do( WORD );
ULONG FindSymbol( char *, PDYNFUNC, ULONG );
#include "run_exp.h"
/*
@@ -52,13 +58,10 @@ HARBOUR Runner();
*
*/
/* Same story.
All the function pointers of the internal functions
Including Runner itself, since the first symbol gets executed by Harbour ;-)
*/
#include <init.h>
ULONG ulSymEntry = 0; /* Link enhancement */
/*
Runner
@@ -68,7 +71,7 @@ HARBOUR Runner();
In due time it should also be able to collect the data from the
binary/executable itself
*/
HARBOUR Runner( void )
HARBOUR HB_RUN( void ) /* HB_Run( <cFile> ) */
{
char cLong[4]; /* Temporary long */
char *szFileName;
@@ -80,7 +83,7 @@ HARBOUR Runner( void )
ULONG ulSymbols; /* Number of symbols */
ULONG ulFuncs; /* Number of functions */
ULONG ulSize; /* Size of function */
ULONG ul, ul2;
ULONG ul, ulPos;
BYTE bCont;
@@ -101,7 +104,6 @@ HARBOUR Runner( void )
( (BYTE) cLong[1] ) * 0x100 +
( (BYTE) cLong[2] ) * 0x10000 +
( (BYTE) cLong[3] ) * 0x1000000;
printf("\nNumber of symbols=%li\n", ulSymbols );
pSymRead = _xgrab( ulSymbols * sizeof( SYMBOL ) );
@@ -122,7 +124,6 @@ HARBOUR Runner( void )
pSymRead[ ul ].szName = (char *) _xgrab( szIdx - szTemp + 1 );
strcpy( pSymRead[ ul ].szName, szTemp );
printf("\nName = %s.", pSymRead[ ul].szName );
fread( szTemp, 2, 1, file );
@@ -136,7 +137,6 @@ HARBOUR Runner( void )
( (BYTE) cLong[1] ) * 0x100 +
( (BYTE) cLong[2] ) * 0x10000 +
( (BYTE) cLong[3] ) * 0x1000000;
printf("\nNumber of functions=%li\n", ulFuncs );
pPCode = ( PDYNFUNC ) _xgrab( ulFuncs * sizeof( DYNFUNC ) );
for( ul=0; ul < ulFuncs; ul++) /* Read symbols in .HRB */
@@ -151,7 +151,7 @@ HARBOUR Runner( void )
else
bCont = FALSE;
} while( bCont );
printf("\nName = %s.", szTemp );
printf("\nLoading <%s>", szTemp );
pPCode[ ul ].szName = (char *) _xgrab( szIdx - szTemp + 1);
strcpy( pPCode[ ul ].szName, szTemp );
@@ -160,7 +160,6 @@ HARBOUR Runner( void )
( (BYTE) cLong[1] ) * 0x100 +
( (BYTE) cLong[2] ) * 0x10000 +
( (BYTE) cLong[3] ) * 0x1000000 + 1;
printf("\nSize of function=%li\n", ulSize );
pPCode[ ul ].pCode = _xgrab( ulSize );
fread( pPCode[ ul ].pCode, 1, ulSize, file );
/* Read the block */
@@ -170,15 +169,18 @@ HARBOUR Runner( void )
/* function */
}
ul2 = 0;
for( ul = 0; ul < ulSymbols; ul++ ) /* Quick & Dirty linking */
ulSymEntry = 0;
for( ul = 0; ul < ulSymbols; ul++ ) /* Linker */
{
if( ( (ULONG) pSymRead[ ul ].pFunPtr ) == SYM_FUNC )
{ /* Internal function */
pSymRead[ ul ].pFunPtr = pPCode[ ul2++ ].pAsmCall->pFunPtr;
{
ulPos = FindSymbol( pSymRead[ ul ].szName, pPCode, ulFuncs );
if( ulPos != SYM_NOT_FOUND )
pSymRead[ ul ].pFunPtr = pPCode[ ulPos ].pAsmCall->pFunPtr;
else
pSymRead[ ul ].pFunPtr = (void *) SYM_EXTERN;
}
else if( ( (ULONG) pSymRead[ ul ].pFunPtr ) == SYM_EXTERN )
if( ( (ULONG) pSymRead[ ul ].pFunPtr ) == SYM_EXTERN )
{ /* External function */
pDynSym = FindDynSym( pSymRead[ ul ].szName );
if( !pDynSym )
@@ -191,7 +193,33 @@ HARBOUR Runner( void )
}
}
pSymRead[ 0 ].pFunPtr(); /* Run the thing !!! */
ProcessSymbols( pSymRead, ulSymbols );
for( ul = 0; ul < ulSymbols; ul++ ) /* Check INIT functions */
{
if( pSymRead[ ul ].cScope & FS_INIT )
{
PushSymbol( pSymRead + ul );
PushNil();
Do( 0 ); /* Run init function */
}
}
PushSymbol( pSymRead );
PushNil();
Do( 0 ); /* Run the thing !!! */
for( ul = 0; ul < ulSymbols; ul++ ) /* Check EXIT functions */
{
if( pSymRead[ ul ].cScope & FS_EXIT )
{
PushSymbol( pSymRead + ul );
PushNil();
Do( 0 ); /* Run exit function */
pSymRead[ ul ].cScope = pSymRead[ ul ].cScope & (~FS_EXIT);
/* Exit function cannot be handled by main() in hvm.c */
}
}
for( ul = 0; ul < ulFuncs; ul++ )
{
@@ -218,6 +246,31 @@ HARBOUR Runner( void )
}
}
ULONG FindSymbol( char *szName, PDYNFUNC pPCode, ULONG ulLoaded )
{
ULONG ulRet;
BYTE bFound;
if( ( ulSymEntry < ulLoaded ) && /* Is it a normal list ? */
!strcmp( szName, pPCode[ ulSymEntry ].szName ) )
ulRet = ulSymEntry++;
else
{
bFound = FALSE;
ulRet = 0;
while( !bFound && ulRet < ulLoaded )
{
if( !strcmp( szName, pPCode[ ulRet ].szName ) )
bFound = TRUE;
else
ulRet++;
}
if( !bFound )
ulRet = SYM_NOT_FOUND;
}
return( ulRet );
}
/* Patch an address of the dynamic function */
void Patch( PBYTE pCode, ULONG ulOffset, void *Address )
{
@@ -266,7 +319,7 @@ void PatchRelative( PBYTE pCode, ULONG ulOffset, void *Address, ULONG ulNext )
be create dynamically at run-time.
If a .PRG contains 10 functions, 10 dynamic functions are created which
are all the same :-) except for 1 pointer.
are all the same :-) except for 2 pointers.
*/
PASM_CALL CreateFun( PSYMBOL pSymbols, PBYTE pCode )
{

11
harbour/tests/working/spawn.prg Normal file
View File

@@ -0,0 +1,11 @@
//
// Spawn()
//
// This program adds a .HRB at run-time
//
function Main()
QOut( "We are now in spawn" )
HB_Run( "Hello.hrb" ) // Load & Run Hello.hrb
QOut( "We are back again" )
return nil

2
harbour/tests/broken/hrb.bat → harbour/tests/working/stub.bat
View File

@@ -1,5 +1,5 @@
@echo off
REM From .PRG to .C = Harbour
..\..\bin\harbour %1.prg /n /gh
..\..\bin\harbour %1.prg /n /gHRB
runner %1.hrb