home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.ncsa.uiuc.edu
/
ftp.ncsa.uiuc.edu.zip
/
ftp.ncsa.uiuc.edu
/
DataScope
/
misc
/
DS_serve.c
next >
Wrap
C/C++ Source or Header
|
2017-03-03
|
15KB
|
687 lines
/**************************************************************************/
/* NCSA DataScope
* An experiment with real numbers.
* by Tim Krauskopf
*
* National Center for Supercomputing Applications
* University of Illinois at Urbana-Champaign
* 605 E. Springfield Ave.
* Champaign, IL 61820
*
* email: softdev@ncsa.uiuc.edu
* bug reports: bugs@ncsa.uiuc.edu
* server: ftp.ncsa.uiuc.edu (128.174.20.50)
*
* NCSA DataScope is in the public domain. See the manual for a complete
* permissions statement. We ask that the following message be included
* in all derivative works:
* Portions developed at the National Center for Supercomputing Applications
* University of Illinois at Urbana-Champaign.
*
* version comments
* ----------- -------------
* 1.0 TKK December 1988
* 1.1 TKK May 1989 -- new polar, computations, interpolation
* 1.2 TKK January 1990 -- networking additions
*/
/*
* DS_serve
*
* This server sits on a unix machine and waits
* for a DataScope client to send it work to do.
*
* It is run from rexecd, so it reads and writes to/from stdin
* and stdout.
*
* Calls are made to C or FORTRAN subroutines to execute user-declared
* functions. See dsfn.h and documentation for declaration of functions.
*
*
* September, 1989
* Tim Krauskopf
*/
#include <stdio.h>
#ifdef UNICOS
#define INTOFF 4 /* distance from beginning of int to 32 bit half */
#define FLOFF 4 /* offset for floating point length diff */
#define FLEN 8 /* floating point number length, for readability */
#endif
#ifdef SUN
#define INTOFF 0
#define FLOFF 0
#define FLEN 4
#endif SUN
/********************************************************************/
main(argc,argv)
int argc;
char *argv[];
{
int i,cd,ret;
char *malloc();
char dowhat[5];
cd = 0;
/*
* Send the first byte to indicate that we are ready to receive.
*/
fullmsg("\0");
/*
* Check the first four characters to make sure they aren't coming from some
* other client who doesn't know what is going on.
*/
if (4 == read(cd,dowhat,4)) {
if (!strncmp("DSfn",dowhat,4))
{
DSfn(cd); /* DataScope fn */
}
else
fullmsg("DS_serve: Unsupported function for this server");
}
fullmsg("DS_serve: Cannot read startup code.");
}
#include "DScope.h"
#include "dsfn.h"
#define DS_ERROR -1
#define DS_CONSTANT 0
#define DS_ARRAY 1
DSfn(cd)
int cd;
{
scope_array lft,rgt,answer;
int i,j,cnt,atemp;
char *malloc(),fn[256];
float *f,*fr,*fc;
if (0 > readtonul(cd,fn)) /* get name of function */
return(-1);
/*
* Read parameter information, first left, then right.
* The 13 bytes are required, then an optional array, depending upon
* the setting of the "kind" subfield.
*/
read(cd,&lft.kind,1);
lft.cval = 0.0;
read(cd,(char *)&lft.cval,4);
flconvert(&lft.cval,1);
lft.nrows = 0;
read(cd,INTOFF + (char *)&lft.nrows,4);
lft.ncols = 0;
read(cd,INTOFF + (char *)&lft.ncols,4);
if (lft.kind == DS_ARRAY) { /* read array in */
lft.rows = (float *)malloc(FLEN*lft.nrows);
lft.cols = (float *)malloc(FLEN*lft.ncols);
lft.vals = (float *)malloc(FLEN*lft.ncols*lft.nrows);
if (0 > fullread(cd,(char *)lft.rows,4*lft.nrows))
return(-1);
flconvert(lft.rows,lft.nrows);
if (0 > fullread(cd,(char *)lft.cols,4*lft.ncols))
return(-1);
flconvert(lft.cols,lft.ncols);
if (0 > fullread(cd,(char *)lft.vals,4*lft.nrows*lft.ncols))
return(-1);
flconvert(lft.vals,lft.ncols*lft.nrows);
}
read(cd,&rgt.kind,1);
rgt.cval = 0.0;
read(cd,(char *)&rgt.cval,4);
flconvert(&rgt.cval,1);
rgt.nrows = 0;
read(cd,INTOFF + (char *)&rgt.nrows,4);
rgt.ncols = 0;
read(cd,INTOFF + (char *)&rgt.ncols,4);
if (rgt.kind == DS_ARRAY) { /* read array in */
rgt.rows = (float *)malloc(FLEN*rgt.nrows);
rgt.cols = (float *)malloc(FLEN*rgt.ncols);
rgt.vals = (float *)malloc(FLEN*rgt.ncols*rgt.nrows);
if (0 > fullread(cd,(char *)rgt.rows,4*rgt.nrows))
return(-1);
flconvert(rgt.rows,rgt.nrows);
if (0 > fullread(cd,(char *)rgt.cols,4*rgt.ncols))
return(-1);
flconvert(rgt.cols,rgt.ncols);
if (0 > fullread(cd,(char *)rgt.vals,4*rgt.nrows*rgt.ncols))
return(-1);
flconvert(rgt.vals,rgt.nrows*rgt.ncols);
}
answer.kind = DS_CONSTANT;
if (lft.kind == DS_ARRAY) {
answer.kind = DS_ARRAY;
answer.nrows = lft.nrows;
answer.ncols = lft.ncols;
fr = lft.rows;
fc = lft.cols;
}
else if (rgt.kind == DS_ARRAY) {
answer.kind = DS_ARRAY;
answer.nrows = rgt.nrows;
answer.ncols = rgt.ncols;
fr = rgt.rows;
fc = rgt.cols;
}
atemp = 0;
if (answer.kind == DS_ARRAY) {
atemp = 1; /* we malloced for answer */
answer.rows = (float *)malloc(FLEN*answer.nrows);
answer.cols = (float *)malloc(FLEN*answer.ncols);
answer.vals = (float *)malloc(FLEN*answer.ncols*answer.nrows);
f = answer.rows; /* copy row and col labels */
for (i=0; i<answer.nrows; i++)
*f++ = *fr++;
f = answer.cols;
for (i=0; i<answer.ncols; i++)
*f++ = *fc++;
}
/*
* call processing routine
*/
doDSfn(fn,&lft,&rgt,&answer);
/*
* write answer back
*/
cd = 1;
write(cd,"DSfn",4);
write(cd,&answer.kind,1);
flbackconvert(&answer.cval,1);
write(cd,(char *)&answer.cval,4);
write(cd,INTOFF + (char *)&answer.nrows,4);
write(cd,INTOFF + (char *)&answer.ncols,4);
if (answer.kind == DS_ARRAY) {
flbackconvert(answer.rows,answer.nrows);
if (0 > fullwrite(cd,(char *)answer.rows,4*answer.nrows))
return(-1);
flbackconvert(answer.cols,answer.ncols);
if (0 > fullwrite(cd,(char *)answer.cols,4*answer.ncols))
return(-1);
flbackconvert(answer.vals,answer.nrows*answer.ncols);
if (0 > fullwrite(cd,(char *)answer.vals,4*answer.nrows*answer.ncols))
return(-1);
}
if (lft.kind == DS_ARRAY) {
free(lft.rows);
free(lft.cols);
free(lft.vals);
}
if (rgt.kind == DS_ARRAY) {
free(rgt.rows);
free(rgt.cols);
free(rgt.vals);
}
if (atemp) {
free(answer.rows);
free(answer.cols);
free(answer.vals);
}
return(0);
}
/**********************************************************************/
/* doDSfn
* perform the function we are here to do.
*/
doDSfn(fn,lft,rgt,answer)
char *fn;
scope_array *lft,*rgt,*answer;
{
int i,lim;
float *fl,*fr;
char msg[256];
/*
* First, check the C routines
*/
i = 0;
while ( dsc[i].namestring[0] ) {
/*
* If we find a match, make the function call and then return.
*/
if (!strcmp(dsc[i].namestring,fn)) {
(*dsc[i].fncall)(lft,rgt,answer);
return;
}
i++;
}
/*
* Now, the FORTRAN routines
*/
i = 0;
while ( dsf[i].namestring[0] ) {
/*
* If we find a match, make the function call and then return.
* For FORTRAN, use the call:
* subr(vals,rows,cols,nrows,ncols,maxr,maxc,p)
* INTEGER maxr,maxc,p // array limits, uses extra space sometimes
* REAL vals(maxc,maxr,0:p) // the array values for answer, parms
* REAL rows(maxr,0:p),cols(maxc,0:p) // the scale values for answer, parms
* REAL nrows(0:p),ncols(0:p) // the number of rows,cols, use 1 for constants
*
*/
if (!strcmp(dsf[i].namestring,fn)) {
register int a,b;
float *vals,*rows,*cols;
register float *f,*ft;
int nrows[3],ncols[3],maxr,maxc,p; /* p will always be 2, even if one unused */
/*
* set up master arrays, first find largest row and column girth for multiple array
*/
maxr = 0;
maxc = 0;
p = 2;
if (lft->kind == DS_CONSTANT) {
if (maxr < 1) maxr = 1;
if (maxc < 1) maxc = 1;
nrows[1] = 1;
ncols[1] = 1;
} else {
if (maxr < lft->nrows) maxr = lft->nrows;
if (maxc < lft->ncols) maxc = lft->ncols;
nrows[1] = lft->nrows;
ncols[1] = lft->ncols;
}
if (rgt->kind == DS_CONSTANT) {
if (maxr < 1) maxr = 1;
if (maxc < 1) maxc = 1;
nrows[2] = 1;
ncols[2] = 1;
} else {
if (maxr < rgt->nrows) maxr = rgt->nrows;
if (maxc < rgt->ncols) maxc = rgt->ncols;
nrows[2] = rgt->nrows;
ncols[2] = rgt->ncols;
}
if (answer->kind == DS_CONSTANT) {
if (maxr < 1) maxr = 1;
if (maxc < 1) maxc = 1;
nrows[0] = 1;
ncols[0] = 1;
} else {
if (maxr < answer->nrows) maxr = answer->nrows;
if (maxc < answer->ncols) maxc = answer->ncols;
nrows[0] = answer->nrows;
ncols[0] = answer->ncols;
}
if ((NULL == (vals = (float *)malloc(3*maxr*maxc*sizeof(float)))) ||
(NULL == (rows = (float *)malloc(3*maxr*sizeof(float)))) ||
(NULL == (cols = (float *)malloc(3*maxc*sizeof(float))))) {
answer->kind = DS_ERROR;
return;
}
/*
* fill in those master arrays, first the data values
*/
f = lft->vals;
if (lft->kind == DS_CONSTANT) f = &lft->cval;
ft = vals + maxr*maxc; /* skip to left parm array */
for (a=0; a < nrows[1]; a++) {
for (b=0; b < ncols[1]; b++)
*ft++ = *f++;
ft += maxc - ncols[1]; /* skip space */
}
f = rgt->vals;
if (rgt->kind == DS_CONSTANT) f = &rgt->cval;
ft = vals + 2*maxr*maxc; /* skip to right parm array */
for (a=0; a < nrows[2]; a++) {
for (b=0; b < ncols[2]; b++)
*ft++ = *f++;
ft += maxc - ncols[2]; /* skip space */
}
/*
* Now the scale values for each of the rows and columns
*/
if (answer->kind == DS_ARRAY) {
f = answer->rows;
ft = rows;
for (a=0; a < nrows[0]; a++)
*ft++ = *f++;
f = answer->cols;
ft = cols;
for (a=0; a < ncols[0]; a++)
*ft++ = *f++;
}
if (lft->kind == DS_ARRAY) {
f = lft->rows;
ft = rows + maxr;
for (a=0; a < nrows[1]; a++)
*ft++ = *f++;
f = lft->cols;
ft = cols + maxc;
for (a=0; a < ncols[1]; a++)
*ft++ = *f++;
}
if (rgt->kind == DS_ARRAY) {
f = rgt->rows;
ft = rows + 2*maxr;
for (a=0; a < nrows[2]; a++)
*ft++ = *f++;
f = rgt->cols;
ft = cols + 2*maxc;
for (a=0; a < ncols[2]; a++)
*ft++ = *f++;
}
/*
* now finally make the call
*/
(*dsf[i].fncall)(vals,rows,cols,nrows,ncols,
&maxr,&maxc,&p);
/*
* put the answer where it belongs and free the temp memory
*/
f = answer->vals;
if (nrows[0] <= 1 && ncols[0] <= 1) {
answer->kind = DS_CONSTANT;
f = &answer->cval;
}
ft = vals;
for (a=0; a < nrows[0]; a++) { /* data values themselves */
for (b=0; b < ncols[0]; b++)
*f++ = *ft++;
ft += maxc - ncols[0]; /* skip space */
}
if (answer->kind == DS_ARRAY) { /* row and column scales */
f = answer->rows;
ft = rows;
for (a=0; a < nrows[0]; a++)
*f++ = *ft++;
f = answer->cols;
ft = cols;
for (a=0; a < ncols[0]; a++)
*f++ = *ft++;
}
free(vals);
free(rows);
free(cols);
return;
}
i++;
}
/*
* We did not find the function name in either the FORTRAN or C lists.
*/
sprintf(msg,"DS_serve: Function not found \n> %s",fn);
fullmsg(msg);
answer->kind = DS_ERROR;
return;
}
/**********************************************************************/
/* fullread
* read a full segment from the network.
* returns 0 for successful read, -1 for error
*/
fullread(skt,whereread,toread)
int skt,toread;
char *whereread;
{
int cnt;
while (toread > 0) { /* count of remaining bytes to read */
cnt = read(skt,whereread,toread); /* read a chunk */
if (cnt < 0) /* connection broken */
return(-1);
toread -= cnt; /* adjust counters for what was read */
whereread += cnt;
}
return(0);
}
/**********************************************************************/
/* fullmsg
* Send a message to the Macintosh, probably an error message.
* Mac messages go to stdout.
* Includes the terminating zero in the string that it sends.
*/
fullmsg(s)
char *s;
{
return(fullwrite(1,s,strlen(s)+1));
}
/**********************************************************************/
/* fullwrite
* write a full segment to the network.
* returns 0 for successful write, -1 for error
*/
fullwrite(skt,wherewrite,towrite)
int skt,towrite;
char *wherewrite;
{
int cnt;
while (towrite > 0) { /* count of remaining bytes to read */
cnt = write(skt,wherewrite,towrite); /* write a chunk */
if (cnt < 0) /* connection broken */
return(-1);
towrite -= cnt; /* adjust counters for what was write */
wherewrite += cnt;
}
return(0);
}
/**********************************************************************/
/* readtonul
* read from the stream until reaching a NUL
*/
readtonul(skt,p)
int skt;
char *p;
{
char cc;
int ret;
do {
if (0 >= (ret = read(skt,&cc,1)))
return(-1);
*p++ = cc;
} while (ret && cc);
return(0);
}
/**********************************************************************/
#ifdef SUN
flconvert()
{
}
flbackconvert()
{
}
#endif
#ifdef UNICOS
/*
* Convert floats from 4 bytes IEEE-32 to/from Cray-64 8 bytes.
* Also responsible for unpacking and packing the 4 byte numbers.
*
* These routines are not responsible for space allocation whatsoever.
* They are assured that the space given is 8-bytes per float for as
* many floats are given. When extra space is generated in backconvert,
* it lets the calling routine still take care of it.
*/
#define MINEXP 0x3f81000000000000 /* min valid Cray masked exponent */
#define MAXEXP 0x407e000000000000 /* max valid Cray masked exponent */
#define C_FMASK 0x00007fffff000000 /* Cray fraction mask (1st 23 bits)*/
#define C_EMASK 0x7fff000000000000 /* Cray exponent mask */
#define C_SMASK 0x8000000000000000 /* Cray sign mask */
#define C_IMPLICIT 0x0000800000000000 /* Cray implicit bit */
#define I_FMASK 0x007fffff /* IEEE fraction mask */
#define I_EMASK 0x7f800000 /* IEEE exponent mask */
#define I_SMASK 0x80000000 /* IEEE sign mask */
#define IEEE_BIAS 0177
#define CRAY_BIAS 040000
static long C2I_diff;
static long I2C_diff;
flbackconvert(farr,nf)
char *farr;
int nf;
{
int i;
long tmp,newnum;
char *to,*p;
to = farr; /* counts 4 byte IEEE numbers */
for (i=0; i< nf; i++) {
bcopy(farr, &newnum, 8);
farr += 8;
if (!newnum)
tmp = 0;
else {
tmp = (C_EMASK & newnum);
if (tmp < MINEXP) {
newnum = 1e-30; /* should be -INF */
tmp = (C_EMASK & newnum);
}
else if (tmp > MAXEXP) {
newnum = 1e30; /* should be +INF */
tmp = (C_EMASK & newnum);
}
C2I_diff = (IEEE_BIAS - CRAY_BIAS - 1) << 48;
tmp = (( tmp + C2I_diff ) << 7)
| ( (newnum & C_FMASK) << 8 )
| ( (newnum & C_SMASK));
}
bcopy(&tmp,to,4);
to += 4;
}
}
/* Conversion from IEEE floating point format to Cray format */
flconvert(farr,nf)
char *farr;
int nf;
{
int i;
long tmp,targ;
char *from,*to;
from = farr + 4*(nf-1); /* end of IEEE array, work backwards */
to = farr + 8*(nf-1); /* end of Cray array, work backwards */
for (i=0; i<nf; i++) { /* for each float */
tmp = 0;
bcopy(from, FLOFF+(char *)&tmp, 4);
from -= 4;
if (!(targ = (tmp & I_EMASK))) {
targ = 0;
}
else {
I2C_diff = (CRAY_BIAS - IEEE_BIAS + 1) << 23;
targ += I2C_diff;
targ = (targ<< 25) | ( (tmp & I_FMASK) << 24)
| ( (tmp & I_SMASK) << 32) | C_IMPLICIT;
}
bcopy(&targ, to, 8);
to -= 8; /* room for next one */
}
}
#endif