예제 #1
0
 void mpi_scatterv_ ( void *unknown, ...)
{
void             *sendbuf;
int              *sendcnts;
int              *displs;
MPI_Datatype     *sendtype;
void             *recvbuf;
int		 *recvcnt;
MPI_Datatype     *recvtype;
int		 *root;
MPI_Comm         *comm;
int 		 *__ierr;
int             buflen;
va_list         ap;

va_start(ap, unknown);
sendbuf = unknown;
if (_numargs() == NUMPARAMS+1) {
    /* Note that we can't set __ierr because we don't know where it is! */
    (void) MPIR_ERROR( MPIR_COMM_WORLD, MPI_ERR_ONE_CHAR, "MPI_SCATTERV" );
    return;
}
if (_numargs() == NUMPARAMS+2) {
        buflen = va_arg(ap, int) /8;          /* This is in bits. */
}
예제 #2
0
int
sigtrbk(FILE *stream, int depth)
{
	long	stat;
	FILE	*f;

	if (_numargs() > 0)	/* If stream specified */
		f	= stream;
	else
		f	= stderr;

	MEM_LOCK(&traceback_lock);

	if (_numargs() > 1)	/* If depth specified */
		_trbkdpth	= depth;
	else {
		char	*env;

        	if (env = getenv("TRBKDPTH"))
                	_trbkdpth	= atoi(env);
	}

	/* Flush all files */

	if (LOADED(fflush))
		(void) fflush(NULL);

	stat	= _trbk(fileno(f), _sigarea());

	MEM_UNLOCK(&traceback_lock);

	return((int)stat);
}
예제 #3
0
_f_int
CRI2CRAY(
	_f_int	*type,
	_f_int	*num,
	void	*forn,
	_f_int	*bitoff,
	void	*native,
	_f_int	*stride,
	_fcd	nativech
)
{
	_f_int	extlen;
	_f_int	ierr;
	_f_int	intlen;
	_f_int	strd;
	_f_int	type77;
	_f_int	type90;

	type77	= *type;
	type90	= _f77_to_f90_type_cnvt[type77];
	intlen	= _f77_type_len[type77] << 3;			/* in bits */
	extlen	= __fndc_f77sz[NCV_CRAY]->typlen[type77];	/* in bits */
	strd	= (_numargs() > 5) ? *stride : 1;

	if (_numargs() > 6)
		ierr	= CRI2CRY(&type90, num, forn, bitoff, native, &strd,
				&intlen, &extlen, nativech);
	else
		ierr	= CRI2CRY(&type90, num, forn, bitoff, native, &strd,
				&intlen, &extlen);

	return (ierr);
}
예제 #4
0
파일: rf.c 프로젝트: manojxantony/compiler
int
$RFI(
_fcd		funit,		/* Address of unit number or FCD	*/
_fcd		format,		/* Address of format (FCD or hollerith)	*/
long		*err,		/* Address of error processing address	*/
long		*end,		/* Address of end processing address	*/
_f_int		*iostat,	/* Address of IOSTAT variable		*/
_f_int		*rec,		/* Address of direct access record no.	*/
fmt_type	**pform,	/* Address of address of parsed format	*/
long		*inumelt,	/* Address of int. array element count	*/
long		*inumcfe	/* Address of number of format elements	*/
)
#endif
{
	register int	endf;		/* END processing flag	*/
	register int	errf;		/* ERR processing flag	*/
	register int	errn;		/* Error number		*/
	register int	iost;		/* I/O statement type	*/
	register int	iotp;		/* I/O type		*/
	register recn_t	recn;		/* Record number	*/
	register unum_t	unum;		/* Unit number		*/
	fmt_type	**prsfmt;	/* Parsed format info.	*/
	unit		*cup;		/* Unit table pointer	*/
	FIOSPTR		css;		/* I/O statement state	*/
#ifdef	_CRAYMPP
	va_list	args;
	_fcd	format;		/* Address of format (FCD or hollerith)	*/
	long	*err;		/* Address of error processing address	*/
	long	*end;		/* Address of end processing address	*/
	_f_int	*iostat;	/* Address of IOSTAT variable		*/
	_f_int	*rec;		/* Address of direct access record no.	*/
	fmt_type **pform;	/* Address of address of parsed format	*/
	long	*inumelt;	/* Address of int. array element count	*/
	long	*inumcfe;	/* Address of number of format elements	*/
#endif

	GET_FIOS_PTR(css);

	/* Check if recursive triple-call I/O */

	if (css->f_iostmt != 0)
		_ferr(css, FEIOACTV);

#ifdef	_CRAYMPP
	va_start(args, funit);
	format	= va_arg(args, _fcd);
	err	= va_arg(args, long *);
	end	= va_arg(args, long *);
	iostat	= va_arg(args, _f_int *);
	rec	= va_arg(args, _f_int *);
	if (_numargs() > ARGS_6) {
		pform	= va_arg(args, fmt_type **);
		if (_numargs() > ARGS_7) {
			inumelt	= va_arg(args, long *);
			if (_numargs() > ARGS_8) {
				inumcfe	= va_arg(args, long *);
			}
예제 #5
0
long
TRBK(long *depth)
{
	long	stat;

	MEM_LOCK(&traceback_lock);

	if (_numargs() > 0)	/* If depth specified */
		_trbkdpth	= *depth;
	else {
		char	*env;

        	if (env = getenv("TRBKDPTH"))
                	_trbkdpth	= atoi(env);
	}

	/* Flush all files */

	if (LOADED(fflush))
		(void) fflush(NULL);

	stat	= _trbk(fileno(stderr));

	MEM_UNLOCK(&traceback_lock);

	return(stat);
}
예제 #6
0
void
_RBOUNDS_ERROR(
	char	*file,		/* Fortran routine containing error */
	int	*line,		/* Line number in Fortran routine */
	char	*variable,	/* arrayname with out-of-bounds subscript */
	int	*dim,		/* Dimension number with size mismatch */
	int	*lowerbnd,	/* Lower bound of dimension dim */
	int	*upperbnd,	/* Upper bound of dimension dim */
	int	*start,		/* Out-of-bounds starting subscript */
	int	*end,		/* Out-of-bounds ending subscript */
	int	*incr,		/* Increment between subscript */
	int	*count)		/* Count/flag for number of messages */
{
	int	*retcnt;	/* ptr to static arg count word */
	int	intcnt = 0;	/* local count if no count passed */
#ifdef	_UNICOS
	/* Use local variable if count argument not passed. */
	if (_numargs() < 10)
		retcnt	= &intcnt;
	else
#endif
		retcnt	= count;
	if ((*retcnt)++ == 0) {
		(void) _fwarn(FWARGSBR, *start, *end, *incr, *dim,
			variable, *line, file, *lowerbnd, *upperbnd);
	}
	return;
}
예제 #7
0
파일: f2ccpy.c 프로젝트: sharugupta/OpenUH
/*
 *	_fc_acopy
 *
 *	Returns:
 *	Pointer to a C string, if successful. NULL otherwise.
 *
 *	Copies the Fortran string described by Fortran character
 * 	descriptor "f" to an allocated, NULL-terminated  C string.  The 
 *	string is allocated using malloc().
 *
 *	If the string described by "f" contains a NULL character,
 *	that marks the end of the Fortran string. Trailing blanks
 *	are stripped before the string is copied.
 */
char *
_fc_acopy(_fcd f)
{
	long	len;
	char	*start, *end;
	char	*sptr;
	
#if	defined(_UNICOS)
#if	defined(_ADDR64)
	if (_numargs() * sizeof(long) != sizeof(_fcd))
		return(NULL);
#else
	if (!_isfcd(f))
		return(NULL);
#endif	/* _ADDR64 */
#endif	/* _UNICOS */

	len = _fcdlen(f);
	start = _fcdtocp(f);
	/* see if string contains a NULL */
	if ((end = memchr(start, '\0', len)) != NULL)
		len = end - start;
	/* remove trailing blanks */
	while ((len > 0) && (start[len-1] == ' '))
		len--;
	/* allocate space */
	if ((sptr = malloc(len+1)) == NULL)
		return(NULL);
	(void) strncpy(sptr, start, len);
	*(sptr + len) = '\0';
	return(sptr);
}
예제 #8
0
파일: f2ccpy.c 프로젝트: sharugupta/OpenUH
/*
 *	_fc_copy
 *
 *	Arguments
 *		f	The Fortran character descriptor
 *		sptr	Pointer to the C character array.
 *		slen	Length of the C character array.
 *
 *	Returns:
 *	Pointer to sptr if successful. NULL otherwise.
 *
 *	Copies the Fortran string described by Fortran character
 * 	descriptor "f" to sptr and NULL-terminates it.
 *
 *	If the string described by "f" contains a NULL character,
 *	that marks the end of the Fortran string. Trailing blanks
 *	are stripped before the string is copied.
 */
char *
_fc_copy(_fcd f, char *sptr, int slen)
{
	int	len;
	char	*start, *end;
	
#if	defined(_UNICOS)
#if	defined(_ADDR64)
	if (_numargs() * sizeof(long) != (sizeof(_fcd) + sizeof(int) +
	    sizeof(char*)))
		return(NULL);
#else
	if (!_isfcd(f))
		return(NULL);
#endif	/* _ADDR64 */
#endif	/* _UNICOS */

	len = _fcdlen(f);
	start = _fcdtocp(f);
	/* see if string contains a NULL */
	if ((end = memchr(start, '\0', len)) != NULL)
		len = end - start;
	/* remove trailing blanks */
	while ((len > 0) && (start[len-1] == ' '))
		len--;

	if (len >= slen)
		return(NULL);	/* return NULL if too small */

	(void) strncpy(sptr, start, len);
	*(sptr + len) = '\0';
	return(sptr);
}
예제 #9
0
void
_BOUNDS_ERROR(
	char	*file,		/* Fortran routine containing error */
	int	*line,		/* Line number in Fortran routine */
	char	*variable,	/* arrayname with out-of-bounds subscript */
	int	*dim,		/* Dimension number of the array */
	int	*lowerbnd,	/* Lower bound of dimension dim */
	int	*upperbnd,	/* Upper bound of dimension dim */
	int	sub[1],		/* Out-of-bounds subscript value */
	int	*count)		/* Count/flag for number of messages */
{
	int	*retcnt;	/* ptr to static arg count word */
	int	intcnt = 0;	/* local count if no count passed */
#ifdef	_UNICOS
	/* Use local variable if count argument not passed. */
	if (_numargs() < 8)
		retcnt	= &intcnt;
	else
#endif
		retcnt	= count;
	if ((*retcnt)++ == 0) {
#ifdef KEY /* Bug 7969 */
		if (want_abort()) {
		  (void) _lerror(_LELVL_MSG, FWARGSBV, sub[0], *dim, variable,
		     *line, file, *lowerbnd, *upperbnd);
		  do_abort();
		}
#endif /* KEY Bug 7969 */
		(void) _fwarn(FWARGSBV, sub[0], *dim, variable, *line,
		   file, *lowerbnd, *upperbnd);
	}
	return;
}
예제 #10
0
long
VXMOVE00(
	long	*source,	/* Address of source data	*/
	long	*isb,		/* Starting byte of source data	*/
	long	*num,		/* Number of bytes to move	*/
	long	*dest,		/* Address of destination data	*/
	long	*idb		/* First byte of destination	*/
	)
{
	char	*from, *to;
	int	count;
	long	status;

	status	= -1;

	if (_numargs() >= 5 && *num >= 0 && *isb > 0 && *idb > 0) {

		from	= (char *)source + (*isb - 1);
		to	= (char *)  dest + (*idb - 1);
		count	= *num;

		(void) memcpy(to, from, count);

		status	= 0;
	}

	return(status);
}
예제 #11
0
void
AQWAIT(
    _f_int	*aqp,
    _f_int	*status,
    _f_int	*reply)
{
    AQFIL		*f;
    struct fflistreq *nxtq;
    _f_int		dummy, *lreply;

    /*
     *	UNICOS 8.0 and previous quietly permitted fewer than 2 arguments,
     *	even though our documentatiokn for AQWAIT has required >= 2 args
     *	for some time.  Do the service of printing an error message if a
     *	dusty deck code happens to use < 2 arguments.
     */
    if (_numargs() < 2)
        _lerror(_LELVL_ABORT, FEARGCNT, "AQWAIT", _numargs(), "2 or 3");
    /*
     *	reply is an optional argument.
     */
    lreply = reply;
    if (_numargs() < 3) lreply = &dummy;

    f	= (AQFIL *) *aqp;

    if (f == NULL || f->aq_chk != AQ_CHK) {
        *status = -FEAQBADH;    /* file handle is not valid */
        return;
    }

    if (f->aq_busy == f->aq_nxtq) {
        *status = IDLE;
        return;
    }

    *status = OK;

    AQ_LOCK(aq_lkbusy);
    nxtq = f->aq_nxtq;
    _aqwait(f, status, lreply, nxtq);
    AQ_UNLOCK(aq_lkbusy);
    if (*status < 0 && _numargs() <= 1)
        _lerror(_LELVL_ABORT, -(*status));
    return;
}
예제 #12
0
_f_int
IEG2CRAY@(
	_f_int	*type,
	_f_int	*num,
	void	*forn,
	_f_int	*bitoff,
	void	*native,
	_f_int	*stride,
	_fcd	nativech
)
{
	_f_int	extlen;
	_f_int	ierr;
	_f_int	intlen;
	_f_int	strd;
	_f_int	type77;
	_f_int	type90;

	type77	= *type;

	if (type77 == DT_SPECREAL) {
		type90	= DVTYPE_REAL;
		intlen	= 64;
	}
	else {
		type90	= _f77_to_f90_type_cnvt[type77];
		intlen	= _f77_type_len[type77] << 3;	/* in bits */
	}

	extlen	= __fndc_f77sz[NCV_IEG]->typlen[type77];	/* in bits */

	if (_numargs() > 5)
		strd	= *stride;
	else
		strd	= 1;

	if (_numargs() > 6)
		ierr	= IEG2CRI(&type90, num, forn, bitoff, native, &strd,
				&intlen, &extlen, nativech);
	else
		ierr	= IEG2CRI(&type90, num, forn, bitoff, native, &strd,
				&intlen, &extlen);

	return (ierr);
}
예제 #13
0
_f_int
ISHELL(_fcd cmdarg)
{
	char	*cptr;
	int	ret;
	int	fcdflag;

	/* Check number of arguments */

	if (_numargs() < 1)
		return( (_f_int) -1);

	/* IS cmdarg an _fcd ? */
	fcdflag	= 0;
#ifdef	_ADDR64
	if (_numargs() * sizeof(long) == sizeof(_fcd)) 
#else
	if (_isfcd(cmdarg))
#endif
		fcdflag	= 1;
  
	/* Convert argument to C character string */

	if (fcdflag) {		/* If Fortran character */
		cptr	= _fc_acopy(cmdarg);

		if (cptr == NULL)
			return( (_f_int) -1);
	}
	else
		cptr	= _fcdtocp(cmdarg);

	/* Run command using system() */

	ret	= system(cptr);

	if (ret == -1)
		ret	= -errno;

	if (fcdflag)
		free(cptr);

	return( (_f_int) ret);
}
예제 #14
0
timef_(void)
#endif
{
	static int64	initial_rt = -1; /* Clock value from initial call */
	int64		rt, rtdif;
	double		retval;

#ifdef	_UNICOS
        if (_sec_per_clock == 0.0)
                _sec_per_clock = 1.0 / (double) sysconf(_SC_CLK_TCK);

	rt	= _rtc();
#else
	{
        struct timeval  buf;
	struct timezone	buf2;
	(void) gettimeofday (&buf, &buf2);
        rt = (long long)buf.tv_sec * 1000000LL + buf.tv_usec;
	}
#endif

	if (initial_rt < 0) {
		initial_rt	= rt;
		rtdif		= 0;
		/*
		 * force rtdif to 0 to prevent anomalies due to possible
		 * race conditions between 2 or more tasks calling TIMEF
		 * concurrently on the initial call.
		 */
	}
	else
		rtdif		= rt - initial_rt;

/*
 *	On pre-7.0 UNICOS CX/CEA systems and on all CRAY-2 systems the 
 *	real-time hardware clock is set to 0 on reboot.  If a restarted 
 *	process had called TIMEF before the system was brought down 
 *	and then after reboot, a negative difference in the real-time 
 *	clock value would be observed.  To minimize the impact of
 *	wrong timings being returned, we return 0 when this situation is 
 *	detected.
 */
	if (rtdif < 0) {
		initial_rt	= rt;
		rtdif		= 0;
	}

	retval	= (double) rtdif * MSECPERCLK;

#ifdef	_UNICOS
	if (_numargs() > 0)
		*time	= (_f_real) retval;
#endif

	return( (_f_real) retval);
}
예제 #15
0
파일: rnlutil.c 프로젝트: sharugupta/OpenUH
void
RNLCOMM(_fcd chr, _f_int *mode)
{
	int	thechar;

	if (_numargs() != (sizeof(_fcd) + sizeof(long *))/ sizeof(long))
		_lerror(_LELVL_ABORT,FEARGLST, "RNLCOMM");
	thechar	= _getfchar(chr);
	TOGGLE_CHAR(thechar, MRNLCOMM, *mode);

	return;
}
예제 #16
0
파일: dfi.c 프로젝트: xyuan/Path64
int
$DFI(
long		*len,		/* Address of length (in characters)	*/
_fcd		format,		/* Address of format (FCD or hollerith)	*/
_fcd		fwa,		/* Address of output character string	*/
fmt_type	**_arg4,	/* Unused (old pform arugment)		*/
long		*_arg5,		/* Unused				*/
long		*_arg6,		/* Unused				*/
fmt_type	**pform,	/* Address of address of parsed format	*/
long		*inumelt,	/* Address of int. array element count	*/
long		*inumcfe	/* Address of number of format elements	*/
)
#endif
{
	long	mone = -1L;
	_fcd	fch;
	int nargs;

#ifdef _CRAYMPP
	va_list		args;
	_fcd		format;   /* Address of format (FCD or hollerith)   */
	_fcd		fwa;      /* Address of output character string	    */
	fmt_type	**_arg4;  /* Unused (old pform arugment)	    */
	long		*_arg5;   /* Unused			            */
	long		*_arg6;   /* Unused				    */
	fmt_type	**pform;  /* Address of address of parsed format    */
	long		*inumelt; /* Address of int. array element count    */
	long		*inumcfe; /* Address of number of format elements   */

	va_start(args, len);
	format = va_arg(args, _fcd);
	fwa = va_arg(args, _fcd);
#endif
	

	if (*len <= 0)		/* If length is zero or negative */
		_ferr(NULL, FEDECDRL);	/* Invalid DECODE record length */

	/* Insert length in character descriptor */

	fch	= _cptofcd(_fcdtocp(fwa), *len);
	nargs = _numargs();
#ifdef _CRAYMPP
	if (nargs >= ARGS_7) {
		_arg4 = va_arg(args, fmt_type **);
		_arg5 = va_arg(args, long *);
		_arg6 = va_arg(args, long *);
		pform = va_arg(args, fmt_type **);
		if (nargs >= ARGS_9) {
			inumelt = va_arg(args, long *);
			inumcfe = va_arg(args, long *);
		}
예제 #17
0
파일: rnlutil.c 프로젝트: sharugupta/OpenUH
void
RNLSEP(_fcd chr, _f_int *mode)
{
	int	thechar;

	if (_numargs() != (sizeof(_fcd) + sizeof(long*))/sizeof(long))
		_lerror(_LELVL_ABORT,FEARGLST, "RNLSEP");
	thechar	= _getfchar(chr);
	if (thechar == ' ')
		_BLNKSEP	= *mode;
	TOGGLE_CHAR(thechar, MRNLSEP, *mode);

	return;
}
예제 #18
0
_f_real
SECONDR(_f_real *time)
{
	double	timeval;

	if (_sec_per_clock == 0.0)
		_sec_per_clock = (double)1.0 / (double)__hertz;

	timeval = (double) _rtc() * _sec_per_clock;

	if (_numargs() > 0)
		*time	= (_f_real) timeval;

	return( (_f_real) timeval);
}
예제 #19
0
파일: ssendf.c 프로젝트: hpc/mvapich-cce
 void mpi_ssend_( void *unknown, ...)
{
void             *buf;
int*count,*dest,*tag;
MPI_Datatype     *datatype;
MPI_Comm         *comm;
int *__ierr;
int		buflen;
va_list		ap;

va_start(ap, unknown);
buf = unknown;
if (_numargs() == NUMPARAMS+1) {
	buflen = va_arg(ap, int) / 8;		/* The length is in bits. */
}
예제 #20
0
 void mpi_unpack_ ( void *unknown, ...)
{
void         	*inbuf;
int		*insize;
int          	*position;
void         	*outbuf;
int		*outcount;
MPI_Datatype  	*datatype;
MPI_Comm      	*comm;
int 		*__ierr;
int		buflen;
va_list         ap;

va_start(ap, unknown);
inbuf = unknown;
if (_numargs() == NUMPARAMS+1) {
    /* We can't get at the last variable, since there is a fatal 
       error in passing the wrong number of arguments. */
    MPIR_ERROR( MPIR_COMM_WORLD, MPI_ERR_ONE_CHAR, "MPI_UNPACK" );
    return;
}
if (_numargs() == NUMPARAMS+2) {
        buflen = va_arg(ap, int) / 8;           /* The length is in bits. */
}
예제 #21
0
_f_int
FPUTS(long *buf, ...)
{
	long **fp;
	va_list args;
#ifdef _ADDR64
	long flen;

	va_start(args, buf);
	if (_numargs() * sizeof(long) == sizeof(_fcd) + 
		sizeof(long **)) {
		/* This technique is not recommended. */
		/* It is used only because our documentation says */
		/* that we support both fcds and integers */
		flen = va_arg(args, long);	/* get length of fcd */
	}
예제 #22
0
파일: setpos.c 프로젝트: xyuan/Path64
void
SETPOS(
	_f_int	*unump,
	_f_int	*len,
	_f_int	*pa,
	_f_int	*stat)
{
	register int	errn;
	register int	narg;
	register unum_t	unum;
	unit		*cup;
	struct fiostate	cfs;

	unum	= *unump;

	STMT_BEGIN(unum, 0, T_SETPOS, NULL, &cfs, cup);	/* lock the unit */
/*
 *	If not connected, do an implicit open.  Abort if the open fails.
 */
	if (cup == NULL)
		cup	= _imp_open(&cfs, SEQ, UNF, unum, 0, NULL);

	if (cup->useq == 0)	/* If direct access file */
		_ferr(&cfs, FEBIONDA, "SETPOS");

/*
 *	Do the setpos.
 */
	narg	= _numargs();

	if ( narg == OLD ) {
		errn	= _setpos(&cfs, cup, len, 1);
	}
	else {
		if (*len <= 0)
			errn	= FEBIOSNT;
		else
			errn	= _setpos(&cfs, cup, pa, *len);
	}

	if (narg >= STAT)
		*stat	= errn;
	else if (errn != OK)
		_ferr(&cfs, errn);

	STMT_END(cup, T_SETPOS, NULL, &cfs);	/* unlock the unit */
}
예제 #23
0
void
_PAUSE(_fcd s)
{
	int	len;
	void	_waitpause();
	char	*msg;

#ifdef	_UNICOS
	if (_numargs() == 0) {
		msg	= "";
		len	= 0;
	}
	else 
#endif
	{
		msg	= _fcdtocp(s);
		len	= _fcdlen(s);

		if (len > MAX_PAS_LEN)
			len	= MAX_PAS_LEN;
	}

	(void) fprintf(errfile, " PAUSE %.*s\n", len, msg);
	(void) fprintf(errfile, " To resume execution, type:  ");

	if (isatty(fileno(stdin))) {

		(void) fprintf(errfile, "go\n");
		(void) fprintf(errfile,
			" Any other input will terminate the program\n");

		if (getchar() != 'g' || getchar() != 'o' || getchar() != '\n') {
			(void) fprintf(errfile, " STOP\n");
			exit(0);
		}
	}
	else {
		(void) fprintf(errfile, "kill -%d %d\n", PAUSESIG, getpid());
		signal(PAUSESIG, _waitpause);
		pause();	/* The pause that refreshes */
	}

	(void) fprintf(errfile, " Execution resumed after PAUSE\n");
}
예제 #24
0
/*
 *	_clib_call	- driver routine to call a utility routine or 
 *			  system call after translating one _fcd to
 *			  a C character pointer.
 */
int
_clib_call(
int	(*func)(),
_fcd	arg1,
long	arg2,
long	arg3,
long	arg4,
long	arg5)

{
	char	*charptr;
	int	ret;
	int	num_syscall_args;

#ifndef	_ADDR64
	if (!_isfcd(arg1))	/* If not Fortran character */
		charptr	= *(char **)&arg1;
	else			
#endif
	{
		charptr	= _f2ccpy(arg1);

		if (charptr == NULL)
			return(-1);
	}

	num_syscall_args = _numargs() - sizeof(_fcd)/sizeof(long);

	switch( num_syscall_args ) {
		case 1:  ret = (*func)(charptr);			break;
		case 2:  ret = (*func)(charptr,arg2);			break;
		case 3:  ret = (*func)(charptr,arg2,arg3);		break;
		case 4:  ret = (*func)(charptr,arg2,arg3,arg4);		break;
		case 5:  ret = (*func)(charptr,arg2,arg3,arg4,arg5);	break;
		default: abort();
	}

#ifndef	_ADDR64
	if (_isfcd(arg1))
#endif
		free(charptr);

	return(ret);
}
예제 #25
0
파일: f2ccpy.c 프로젝트: sharugupta/OpenUH
char *
_f2ccpy(_fcd f, ...)
{
	va_list	ap;
	int	slen;
	char	*sptr;
	
	if (_numargs() * sizeof(long) == sizeof(_fcd))
		return ( _fc_acopy(f) );
	else {
		/* get 2nd and 3rd arguments */
		va_start(ap, f);
		sptr = va_arg(ap, char *);
		slen = va_arg(ap, int);
		va_end(ap);

		return ( _fc_copy(f, sptr, slen) );
	}
}
예제 #26
0
void mpi_send_init_( void *unknown, ...)
{
void          *buf;
int*count;
MPI_Datatype  *datatype;
int*dest;
int*tag;
MPI_Comm      *comm;
MPI_Request   *request;
int *__ierr;
MPI_Request lrequest;
int buflen;
va_list ap;

va_start(ap, unknown);
buf = unknown;
if (_numargs() == NUMPARAMS+1) {
        buflen = va_arg(ap, int) /8;          /* This is in bits. */
}
예제 #27
0
/*
 *  Error handler for an of out of bounds substring.
 *
 *  Input:
 *    file     - File name in which error occurred.
 *    line     - Line number in file.
 *    variable - Name of array which had an out of bounds substring.
 *    size     - Substring size.
 *    start    - Out of bounds substring start.
 *    length   - Out of bounds substring length.
 *    count    - Static count/flag to indicate if this message was
 *               already given for this statement.
 */
void
_SBOUNDS_ERROR(
		char *file,
		int *line,
		char *variable,
		int *size,
                int *subst,
                int *subln,
                int *count )
{
	int	*retcnt;	/* ptr to static arg count word */
	int	intcnt = 0;	/* local count if no count passed */
	int	endst;
#ifdef	_UNICOS
	/* Use local variable if count argument not passed. */
	if (_numargs() < 7)
		retcnt	= &intcnt;
	else
#endif
		retcnt	= count;

	/* if substring length is zero or negative, not incorrect */
	if ( *subln > 0) {
		if ((*retcnt)++ == 0) {

			/* calculate substring end.
			 * subln is calculated by (ln = s2 - s1 + 1)
			 * endst is calculated by (s2 = ln + s1 - 1)
			 */
			endst	= *subln + *subst - 1;
#ifdef KEY /* Bug 7969 */
		if (want_abort()) {
		  (void) _lerror(_LELVL_MSG, FWARGSTR, *subst, endst, variable,
		    *line, file, *size);
		  do_abort();
		}
#endif /* KEY Bug 7969 */
			(void) _fwarn (FWARGSTR, *subst, endst, variable,
			   *line, file, *size);
		}
	}
	return;
}
예제 #28
0
파일: lerror.c 프로젝트: sharugupta/OpenUH
void
_lerror(int hndlcode, int errn, ...)
{
	va_list	args;		/* Variable argument list */
  
#ifdef	_CRAY
	if (_numargs() < 1)
		(void) abort();
#endif
	if (hndlcode >= _LELVL_MSG && errn != 0) {
		va_start(args, errn);
		_lmessage(errn, NULL, args);	/* Print error message */
		va_end(args);
	}

	if (hndlcode >= _LELVL_ABORT) {
		(void) abort();	      /* abort causes traceback on CX/CEA */
	}

	if (hndlcode >= _LELVL_EXIT)
		(void) exit(1);
}
예제 #29
0
int
_lwarn(int errn, ...)
{
	va_list		args;		/* Variable argument list	*/

#ifdef	_CRAY
	if (_numargs() < 1)
		return(-1);
#endif

	if (((errn < BASE) || (errn > (BASE+999))) &&
	    ((errn < FDC_ERRB) || (errn > (FDC_ERRB+999))))
		return(-2);

	va_start(args, errn);

	_lmessage(errn, "WARNING", args);

	va_end(args);

	return(0);
}
예제 #30
0
void
_CONFORM_ERROR(
	char	*file,		/* Fortran routine containing error */
	int	*line,		/* Line number in Fortran routine */
	int	*dim,		/* Dimension number with size mismatch */
	int	*count)		/* count/flag to give message once per
				 * statement. */
{
	int	intcnt = 0;	/* local count if no count passed */
	int	*retcnt;	/* ptr to count word */
#ifdef	_UNICOS
	/* Use local variable if count argument not passed. */
	if (_numargs() < 4)
		retcnt = &intcnt;
	else
#endif
		retcnt = count;
	if (*retcnt == 0) {
		*retcnt = 1;
		(void) _fwarn(FWARGDIM, *dim, *line, file);
	}
	return;
}