diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Remove debugging code.

Browse Source 
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@838 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
stasinos 2003-06-26 14:35:52 +00:00
parent d81fffeec9
commit 6fed2c7be5
1 changed files with 33 additions and 161 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

190
library/mpi/mpi.c
View File

@ -9,14 +9,14 @@
************************************************************************** **************************************************************************
* * * *
* File: mpi.c * * File: mpi.c *
* Last rev: $Date: 2002-11-21 15:57:23 $ * * Last rev: $Date: 2003-06-26 14:35:52 $ *
* mods: * * mods: *
* comments: Interface to an MPI library * * comments: Internal interface to MPI libraries *
* * * *
*************************************************************************/ *************************************************************************/
#ifndef lint #ifndef lint
static char *rcsid = "$Header: /Users/vitor/Yap/yap-cvsbackup/library/mpi/mpi.c,v 1.18 2002-11-21 15:57:23 stasinos Exp $"; static char *rcsid = "$Header: /Users/vitor/Yap/yap-cvsbackup/library/mpi/mpi.c,v 1.19 2003-06-26 14:35:52 stasinos Exp $";
#endif #endif
#include "Yap.h" #include "Yap.h"
@ -76,29 +76,16 @@ expand_buffer( int space )
char *tmp; char *tmp;
#if 0
printf( "expanding by %d (to %d)...", space, (bufsize+space));
#endif
tmp = malloc( bufsize + space ); tmp = malloc( bufsize + space );
if( tmp == NULL ) { if( tmp == NULL ) {
Yap_Error(SYSTEM_ERROR, TermNil, "out of memory" ); Yap_Error(SYSTEM_ERROR, TermNil, "out of memory" );
Yap_exit( EXIT_FAILURE ); Yap_exit( EXIT_FAILURE );
} }
memcpy( tmp, buf, bufsize ); memcpy( tmp, buf, bufsize );
#if 0
printf("memcpy'd...");
#endif
free( buf ); free( buf );
#if 0
printf("free'd...");
#endif
buf = tmp; buf = tmp;
#else /* use realloc */ #else /* use realloc */
buf = realloc( buf, bufsize + space ); buf = realloc( buf, bufsize + space );
#if 0
printf("realloc'ed space...");
#endif
if( buf == NULL ) { if( buf == NULL ) {
Yap_Error(SYSTEM_ERROR, TermNil, "out of memory"); Yap_Error(SYSTEM_ERROR, TermNil, "out of memory");
Yap_exit( EXIT_FAILURE ); Yap_exit( EXIT_FAILURE );
@ -106,21 +93,11 @@ expand_buffer( int space )
#endif #endif
bufsize += space; bufsize += space;
#if 0
printf("SUCCESS\n");
printf( "New bufsize: %d\n", bufsize );
buf[bufsize-space] = 0;
printf("Buffer contents: %s\n", buf);
#endif
} }
static int static int
mpi_putc(Int stream, Int ch) mpi_putc(Int stream, Int ch)
{ {
#if 0
printf("%d: PUTC %d a.k.a. %c at %d\n", rank, ch, (char)ch, bufptr);
#endif
if( ch > 0 ) { if( ch > 0 ) {
if( bufptr >= bufsize ) expand_buffer( RECV_BUF_SIZE ); if( bufptr >= bufsize ) expand_buffer( RECV_BUF_SIZE );
buf[bufptr++] = ch; buf[bufptr++] = ch;
@ -131,9 +108,6 @@ mpi_putc(Int stream, Int ch)
static Int static Int
mpi_getc(Int stream) mpi_getc(Int stream)
{ {
#if 0
printf("%d: GETC %c at %d\n", rank, buf[bufptr], bufptr);
#endif
return buf[bufptr++]; return buf[bufptr++];
} }
@ -186,7 +160,7 @@ mpi_parse(void)
} }
repeat_cycle: repeat_cycle:
TR_before_parse = TR; TR_before_parse = TR;
if( Yap_ErrorMessage || (t = Yap_Parse())==0 ) { if( (t = Yap_Parse())==0 || Yap_ErrorMessage ) {
if (Yap_ErrorMessage && (strcmp(Yap_ErrorMessage,"Stack Overflow") == 0)) { if (Yap_ErrorMessage && (strcmp(Yap_ErrorMessage,"Stack Overflow") == 0)) {
/* ignore term we just built */ /* ignore term we just built */
TR = TR_before_parse; TR = TR_before_parse;
@ -204,7 +178,8 @@ mpi_parse(void)
behave as if ParserErrorStyle were QUIET_ON_PARSER_ERROR, behave as if ParserErrorStyle were QUIET_ON_PARSER_ERROR,
(see iopreds.c), except with bombing Yap instead of simply (see iopreds.c), except with bombing Yap instead of simply
failing the predicate: the parse cannot fail unless there failing the predicate: the parse cannot fail unless there
is a problem with MPI or the pretty printer. is a problem with the transmission that went unnoticed or
a bug in the pretty printer.
*/ */
Yap_Error(SYSTEM_ERROR, TermNil, "Failed to parse MPI_Recv()'ed term" ); Yap_Error(SYSTEM_ERROR, TermNil, "Failed to parse MPI_Recv()'ed term" );
Yap_exit( EXIT_FAILURE ); Yap_exit( EXIT_FAILURE );
@ -246,12 +221,11 @@ for a suggested workaround:
*/ */
/* /*
Note that if MPI_Init() fails, Yap/MPICH and Yap/LAM bahave differently: Note that if MPI_Init() fails, Yap/MPICH and Yap/LAM behave differently:
in Yap/MPICH we are still at the Yap initialisation phase, so we let in Yap/MPICH we are still at the Yap initialisation phase, so we get
Yap exit(FAILURE), whereas in Yap/LAM mpi_open/3 simply fails. Yap exit(FAILURE), whereas in Yap/LAM mpi_open/3 simply fails.
*/ */
#if ! HAVE_LIBMPICH
retv = MPI_Init( &mpi_argc, &mpi_argv ); retv = MPI_Init( &mpi_argc, &mpi_argv );
if( retv ) { if( retv ) {
Term t; Term t;
@ -260,7 +234,6 @@ Yap exit(FAILURE), whereas in Yap/LAM mpi_open/3 simply fails.
Yap_Error( SYSTEM_ERROR, t, "MPI_Init() returned non-zero" ); Yap_Error( SYSTEM_ERROR, t, "MPI_Init() returned non-zero" );
return FALSE; return FALSE;
} }
#endif
MPI_Comm_size( MPI_COMM_WORLD, &numprocs ); MPI_Comm_size( MPI_COMM_WORLD, &numprocs );
MPI_Comm_rank( MPI_COMM_WORLD, &rank ); MPI_Comm_rank( MPI_COMM_WORLD, &rank );
MPI_Get_processor_name( processor_name, &namelen ); MPI_Get_processor_name( processor_name, &namelen );
@ -327,29 +300,10 @@ p_mpi_send() /* mpi_send(+data, +destination, +tag) */
bufstrlen = bufptr + 1; bufstrlen = bufptr + 1;
bufptr = 0; bufptr = 0;
#if 0
{
FILE *debug_out;
debug_out = fopen("debug.out", "a");
fprintf(debug_out, "%d: About to send %d chars to %d\n",
rank, bufstrlen, dest);
fclose(debug_out);
}
#endif
/* send the data */ /* send the data */
retv = MPI_Send( &buf[bufptr], bufstrlen, MPI_CHAR, dest, tag, MPI_COMM_WORLD ); retv = MPI_Send( &buf[bufptr], bufstrlen, MPI_CHAR, dest, tag, MPI_COMM_WORLD );
if( retv != MPI_SUCCESS ) return FALSE; if( retv != MPI_SUCCESS ) return FALSE;
#if 0
{
FILE *debug_out;
debug_out = fopen("debug.out", "a");
fprintf(debug_out, "%d: Sent %s to %d\n", rank, &buf[bufptr], dest);
fclose(debug_out);
}
#endif
return TRUE; return TRUE;
} }
@ -357,7 +311,7 @@ p_mpi_send() /* mpi_send(+data, +destination, +tag) */
static Int static Int
p_mpi_receive() /* mpi_receive(-data, ?orig, ?tag) */ p_mpi_receive() /* mpi_receive(-data, ?orig, ?tag) */
{ {
Term t_data = Deref(ARG1), t_orig = Deref(ARG2), t_tag = Deref(ARG3); Term t, t_data = Deref(ARG1), t_orig = Deref(ARG2), t_tag = Deref(ARG3);
int tag, orig, retv; int tag, orig, retv;
MPI_Status status; MPI_Status status;
@ -396,16 +350,6 @@ p_mpi_receive() /* mpi_receive(-data, ?orig, ?tag) */
} }
MPI_Get_count( &status, MPI_CHAR, &bufstrlen ); MPI_Get_count( &status, MPI_CHAR, &bufstrlen );
#if 0
{
FILE *debug_out;
debug_out = fopen("debug.out", "a");
fprintf(debug_out, "%d: About to receive %d chars from %d\n",
rank, bufstrlen, orig);
fclose(debug_out);
}
#endif
/* adjust the buffer */ /* adjust the buffer */
if( bufsize < bufstrlen ) expand_buffer(bufstrlen-bufsize); if( bufsize < bufstrlen ) expand_buffer(bufstrlen-bufsize);
@ -437,39 +381,16 @@ p_mpi_receive() /* mpi_receive(-data, ?orig, ?tag) */
return FALSE; return FALSE;
} }
#if 0
{
int aa;
FILE *debug_out;
MPI_Get_count( &status, MPI_CHAR, &aa );
debug_out = fopen("debug.out", "a");
fprintf(debug_out, "%d: Received %d chars from %d\n\
%d: The message was: %s\n", rank, aa, orig, rank, &buf[bufptr]);
fclose(debug_out);
}
#endif
/* parse received string into a Prolog term */ /* parse received string into a Prolog term */
bufptr = 0; bufptr = 0;
retv = Yap_unify(ARG1, mpi_parse()); t = mpi_parse();
#if 0 if( t == TermNil ) {
/* check up on mpi_parse(): retv = FALSE;
convert the newly-parsed term back to text and print */ }
bufptr = 0; else {
Yap_plwrite( t_data, mpi_putc, Quote_illegal_f|Handle_vars_f ); retv = Yap_unify(t, ARG1);
mpi_putc( 0, '.' );
mpi_putc( 0, ' ' );
buf[bufptr] = 0;
bufptr = 0;
{
FILE *debug_out;
debug_out = fopen("debug.out", "a");
fprintf(debug_out, "%d: mpi_receive: t_data == %d, retv == %d term == %s\n",
rank, t_data, retv, buf);
fclose(debug_out);
} }
#endif
return retv; return retv;
} }
@ -515,19 +436,15 @@ p_mpi_bcast3() /* mpi_bcast( ?data, +root, +max_size ) */
/* allow for the ". " bit and the NULL at the end */ /* allow for the ". " bit and the NULL at the end */
max_size = IntOfTerm( t_max_size ) + 3; max_size = IntOfTerm( t_max_size ) + 3;
#if 0 if( max_size < bufstrlen ) {
if( (rank == root) && (max_size < bufstrlen) )
/* issue a warning? explode? bcast s'thing unparsable? */ /* issue a warning? explode? bcast s'thing unparsable? */
printf( "MAYDAY: max_size == %d, bufstrlen == %d\n", max_size, bufstrlen ); printf( "MAYDAY: max_size == %d, bufstrlen == %d\n ", max_size, bufstrlen);
return FALSE; return FALSE;
} }
#endif
printf( "%d: About to Bcast(): max_size == %d, bufstrlen == %d\n",
rank, max_size, bufstrlen );
/* adjust the buffer size, if necessary */ /* adjust the buffer size, if necessary */
if( max_size > bufsize ) { if( max_size > bufsize ) {
expand_buffer( max_size - bufsize ); expand_buffer( max_size-bufsize );
} }
retv = MPI_Bcast( buf, max_size, MPI_CHAR, root, MPI_COMM_WORLD ); retv = MPI_Bcast( buf, max_size, MPI_CHAR, root, MPI_COMM_WORLD );
@ -536,9 +453,6 @@ p_mpi_bcast3() /* mpi_bcast( ?data, +root, +max_size ) */
return FALSE; return FALSE;
} }
printf( "%d: I'm just after Bcast()ing. strlen(buf) == %d\n",
rank, strlen(buf) );
if( root == rank ) return TRUE; if( root == rank ) return TRUE;
else { else {
/* ARG1 must be unbound so that it can receive data */ /* ARG1 must be unbound so that it can receive data */
@ -561,6 +475,7 @@ p_mpi_bcast3() /* mpi_bcast( ?data, +root, +max_size ) */
It is implemented as two broadcasts, the first being the size It is implemented as two broadcasts, the first being the size
and the second the actual data. and the second the actual data.
*/ */
static Int static Int
p_mpi_bcast2() /* mpi_bcast( ?data, +root ) */ p_mpi_bcast2() /* mpi_bcast( ?data, +root ) */
{ {
@ -610,16 +525,8 @@ p_mpi_bcast2() /* mpi_bcast( ?data, +root ) */
/* adjust the buffer size, if necessary */ /* adjust the buffer size, if necessary */
if( bufstrlen > bufsize ) { if( bufstrlen > bufsize ) {
#if 1
printf("expanding by %d\n", (bufstrlen-bufsize) );
#endif
expand_buffer( bufstrlen - bufsize ); expand_buffer( bufstrlen - bufsize );
} }
#if 1
else {
printf("bufstrlen: %d, bufsize %d: not expanding\n",bufstrlen,bufsize);
}
#endif
/* Broadcast the data */ /* Broadcast the data */
retv = MPI_Bcast( buf, bufstrlen, MPI_CHAR, root, MPI_COMM_WORLD ); retv = MPI_Bcast( buf, bufstrlen, MPI_CHAR, root, MPI_COMM_WORLD );
if( retv != MPI_SUCCESS ) { if( retv != MPI_SUCCESS ) {
@ -639,7 +546,13 @@ p_mpi_bcast2() /* mpi_bcast( ?data, +root ) */
bufptr = 0; bufptr = 0;
/* parse received string into a Prolog term */ /* parse received string into a Prolog term */
return Yap_unify(ARG1, mpi_parse()); {
Term t_tmp;
t_tmp = mpi_parse();
Yap_unify(ARG1, t_tmp);
}
return TRUE;
} }
} }
@ -682,54 +595,13 @@ Yap_InitMPI(void)
mpi_argv[0] = strdup( Yap_argv[0] ); mpi_argv[0] = strdup( Yap_argv[0] );
#if 0 Yap_InitCPred( "mpi_open", 3, p_mpi_open, SafePredFlag|SyncPredFlag );
/* DEBUG */
printf( "Yap_argc = %d\n", Yap_argc );
for( i=0; i<Yap_argc; ++i ) {
printf( "%d %s\n", i, Yap_argv[i] );
}
#endif
#if 0
/* DEBUG */
printf( "mpi_argc = %d\n", mpi_argc );
for( i=0; i<mpi_argc; ++i ) {
printf( "%d %s\n", i, mpi_argv[i] );
}
#endif
/* With MPICH MPI_Yap_Init() must be called during initialisation,
but with LAM it can be called from Prolog (mpi_open/3).
See also the comment at "if ! HAVE_LIBMPICH" above!
*/
#if HAVE_LIBMPICH
{
int retv;
retv = MPI_Init(&mpi_argc, &mpi_argv);
if( retv ) {
Term t;
t = MkIntegerTerm(retv);
Yap_Error(SYSTEM_ERROR, t, "MPI_Init() returned non-zero");
Yap_exit( EXIT_FAILURE );
}
#if 0
/* DEBUG */
else {
puts("MPI_Init() is happy!");
}
#endif
}
#endif
Yap_InitCPred( "mpi_open", 3, p_mpi_open, SyncPredFlag );
Yap_InitCPred( "mpi_close", 0, p_mpi_close, SafePredFlag|SyncPredFlag ); Yap_InitCPred( "mpi_close", 0, p_mpi_close, SafePredFlag|SyncPredFlag );
Yap_InitCPred( "mpi_send", 3, p_mpi_send, SafePredFlag|SyncPredFlag ); Yap_InitCPred( "mpi_send", 3, p_mpi_send, SafePredFlag|SyncPredFlag );
Yap_InitCPred( "mpi_receive", 3, p_mpi_receive, SyncPredFlag ); Yap_InitCPred( "mpi_receive", 3, p_mpi_receive, SafePredFlag|SyncPredFlag );
Yap_InitCPred( "mpi_bcast", 3, p_mpi_bcast3, SyncPredFlag ); Yap_InitCPred( "mpi_bcast", 3, p_mpi_bcast3, SafePredFlag|SyncPredFlag );
Yap_InitCPred( "mpi_bcast", 2, p_mpi_bcast2, SyncPredFlag ); Yap_InitCPred( "mpi_bcast", 2, p_mpi_bcast2, SafePredFlag|SyncPredFlag );
Yap_InitCPred( "mpi_barrier", 0, p_mpi_barrier, SyncPredFlag ); Yap_InitCPred( "mpi_barrier", 0, p_mpi_barrier, SafePredFlag|SyncPredFlag );
} }
#endif /* HAVE_MPI */ #endif /* HAVE_MPI */