int main(int argc, char ** argv) {
void * libptr;
const char * (*ssl_version)(int t);
const char * version;
if (argc < 1) {
puts("report_openssl_version filename");
exit(1);
}
libptr = dlopen(argv[1], 0);
ssl_version = (const char * (*)(int))dlsym(libptr, "SSLeay_version");
if ((void *)ssl_version == NULL) {
ssl_version = (const char * (*)(int))dlsym(libptr, "ssleay_version");
if ((void *)ssl_version == NULL) {
ssl_version = (const char * (*)(int))dlsym(libptr, "SSLEAY_VERSION");
}
}
dlclose(libptr);
if ((void *)ssl_version == NULL) {
puts("Unable to lookup version of OpenSSL");
exit(1);
}
version = ssl_version(SSLEAY_VERSION);
puts(version);
/* Was a symbol argument given? */
if (argc > 1) {
int status;
struct dsc$descriptor_s symbol_dsc;
struct dsc$descriptor_s value_dsc;
const unsigned long table_type = LIB$K_CLI_LOCAL_SYM;
symbol_dsc.dsc$a_pointer = argv[2];
symbol_dsc.dsc$w_length = strlen(argv[2]);
symbol_dsc.dsc$b_dtype = DSC$K_DTYPE_T;
symbol_dsc.dsc$b_class = DSC$K_CLASS_S;
value_dsc.dsc$a_pointer = (char *)version; /* Cast ok */
value_dsc.dsc$w_length = strlen(version);
value_dsc.dsc$b_dtype = DSC$K_DTYPE_T;
value_dsc.dsc$b_class = DSC$K_CLASS_S;
status = LIB$SET_SYMBOL(&symbol_dsc, &value_dsc, &table_type);
if (!$VMS_STATUS_SUCCESS(status)) {
exit(status);
}
}
exit(0);
}
LispObject GC_MakeSymbol(char *name)
{
LispObject o;
struct LispSymbol *s = SYMBOL_NEW();
s->name = StringAlloc(name);
SET_SYMBOL(o, s);
return o;
}
LispObject Alloc_MakeSymbol(char *name)
{
LispObject o;
struct LispSymbol *s = (struct LispSymbol *)Malloc(sizeof(struct LispSymbol));
s->name = StringAlloc(name);
SET_SYMBOL(o, s);
return o;
}
/*---------------------------------------
| |
| init_wt2()/7 |
| |
+--------------------------------------*/
int init_wt2(struct wtparams *wtpar, register float *wtfunc,
register int n, int rftflag, int fdimname, double fpmult, int rdwtflag)
{
char wtfname[MAXSTR],
wtfilename[MAXPATHL],
parfilename[MAXPATHL],
run_usrwt[MAXSTR];
int maxpoint,
sinesquared,
wtfile,
wtfileflag,
sa_first, sa_last,
res;
float sind,
cosd,
ph,
phi,
awc;
register int i;
register float lbconst,
lbvar,
gfconst,
gfvar,
f,
max,
sinc,
cosc,
*fpnt,
lastwtval,
sbfunc;
FILE *fopen(),
*fileres;
if (wtpar->sw == 0.0)
{
Werrprintf("Error: sw is zero.");
return(ERROR);
}
/**************************************************
* Section for user-defined weighting functions. *
**************************************************/
strcpy(wtfname, "");
if (fdimname & S_NI2)
{
res = P_getstring(CURRENT, "wtfile2", wtfname, 1, MAXPATHL-1);
}
else if (fdimname & (S_NF|S_NI))
{
res = P_getstring(CURRENT, "wtfile1", wtfname, 1, MAXPATHL-1);
}
else
{
res = P_getstring(CURRENT, "wtfile", wtfname, 1, MAXPATHL-1);
}
wtfileflag = ((res == 0) && (strcmp(wtfname, "") != 0));
/***********************************************
* Initialize weighting function data. It is *
* necessary to do this even if no weighting *
* is active because of WTI. *
***********************************************/
fpnt = wtfunc;
for (i = 0; i < n; i++)
*fpnt++ = 1.0;
/************************
* Set weighting flag. *
************************/
if ( !(wtpar->lb_active || wtpar->sb_active || wtpar->gf_active || wtpar->sa_active ||
wtfileflag) )
{
wtpar->wtflag = FALSE;
return(COMPLETE);
}
/***************************************************************
* Initiate user-defined weighting routines. The executable *
* "wtfile" is found in the user's "wtlib" directory and the *
* corresponding parameter set, in the current experiment *
* directory with the extension ".wtp". The file containing *
* the user-written, formatted weighting data is found in the *
* current experiment directory. *
***************************************************************/
fpnt = wtfunc;
if (wtfileflag)
{
strcpy(parfilename, curexpdir);
#ifdef UNIX
strcat(parfilename, "/");
#endif
strcat(parfilename, wtfname);
strcat(parfilename, ".wtp");
strcpy(wtfilename, userdir);
#ifdef UNIX
strcat(wtfilename, "/wtlib/");
#else
vms_fname_cat(wtfilename, "[.wtlib]");
#endif
strcat(wtfilename, wtfname);
#ifndef UNIX /* Presumably VMS */
strcat(wtfilename, ".exe" );
#endif
fileres = fopen(wtfilename, "r");
/*****************************************************************
* If there is no user-weighting program in the user's wtlib, *
* look for a file containing the user-weighting function written *
* out explicitly in the current experiment directory *
*****************************************************************/
if (fileres == 0)
{
strcpy(wtfilename, curexpdir);
#ifdef UNIX
strcat(wtfilename, "/");
#endif
strcat(wtfilename, wtfname);
fileres = fopen(wtfilename, "r");
if (fileres == 0)
{
Werrprintf("Unable to find requested user-weighting files");
return(ERROR);
}
/****************************************************
* Read in user-defined, formatted weighting data. *
****************************************************/
i = 0;
while (fscanf(fileres, "%f", fpnt) != EOF)
{
fpnt++;
if (++i == n)
break;
}
lastwtval = *(fpnt - 1);
for ( ; i < n; i++)
*fpnt++ = lastwtval;
fclose(fileres);
}
else
{
fclose(fileres);
if (!rdwtflag)
{
#ifdef UNIX
/* The UNIX command includes the complete path. */
sprintf( &run_usrwt[ 0 ],
"%s %s %s %s %14d %7d %d",
wtfilename, curexpdir, wtfname, parfilename,
(int) (wtpar->sw*1000.0), n, rftflag);
#else
/*
* For VMS, necessary to define a DCL symbol
* to reference the user's program.
*/
{
char wt_sym_value[ MAXPATHL ];
int symbol_descr[ 2 ], value_descr[ 2 ], one;
wt_sym_value[ 0 ] = '$';
wt_sym_value[ 1 ] = '\0';
strcat( &wt_sym_value[ 0 ], wtfilename );
symbol_descr[ 0 ] = strlen( wtfname );
symbol_descr[ 1 ] = (int) wtfname;
value_descr[ 0 ] = strlen( &wt_sym_value[ 0 ] );
value_descr[ 1 ] = (int) &wt_sym_value[ 0 ];
one = 1; /* because LIB$GETSYMBOL wants a reference */
LIB$SET_SYMBOL( &symbol_descr[ 0 ], &value_descr[ 0 ], &one );
/*
* The VMS command only has the command name and arguments,
* and not the complete path.
*/
sprintf( &run_usrwt[ 0 ],
"%s %s %s %s %14d %7d %d",
wtfname, curexpdir, wtfname, parfilename,
(int) (wtpar->sw*1000.0), n, rftflag);
}
#endif
/**********************************************************
* Now execute the user's program to produce the desired *
* weighting function. The weighting function will be *
* written out to disk by the user's program. *
**********************************************************/
system( &run_usrwt[ 0 ] );
}
/********************************************************
* Read user-calculated weighting data in from the ap- *
* propriate file in the current experiment directory. *
********************************************************/
strcpy(wtfilename, curexpdir);
#ifdef UNIX
strcat(wtfilename, "/");
#endif
strcat(wtfilename, wtfname);
strcat(wtfilename, ".wtf");
wtfile = open(wtfilename, O_RDONLY, 0666);
if (wtfile == 0)
{
Werrprintf("Error opening user-calculated weighting file");
return(ERROR);
}
if ((res = read(wtfile, fpnt, sizeof(float)*n)) < 0)
{
Werrprintf("Error in reading user-calculated weighting data");
close(wtfile);
return(ERROR);
}
close(wtfile);
}
}
/************************************************
* Section for exponential weighting functions *
************************************************/
lbconst = 0.0;
if (wtpar->lb_active)
{
if (wtpar->lb < -1e6)
wtpar->lb = -1e6;
if (wtpar->lb > 1e6)
wtpar->lb = 1e6;
lbconst = wtpar->lb/(0.31831*wtpar->sw);
if (rftflag)
lbconst /= 2.0;
}
if (wtpar->sa_active)
{
sa_first = (wtpar->sas_active) ? wtpar->sas : 0;
sa_last = wtpar->sa + sa_first;
}
else
{
sa_first = 0;
sa_last = n;
}
/*****************************************
* Section for sine weighting functions *
*****************************************/
sinesquared = 0;
ph = phi = 0.0;
cosc = sinc = cosd = sind = 0.0;
if (wtpar->sb_active)
{
sinesquared = (wtpar->sb < 0.0);
if (sinesquared)
wtpar->sb *= (-1);
if (wtpar->sb > 1000.0)
{
wtpar->sb = 1000.0;
}
else if (wtpar->sb < (1.0/wtpar->sw))
{
wtpar->sb = 1.0/wtpar->sw;
}
ph = M_PI_2/(wtpar->sw*wtpar->sb);
if (rftflag)
ph /= 2.0;
phi = ph;
sind = sin((double) (ph));
cosd = cos((double) (ph));
if (wtpar->sbs_active)
{
if (wtpar->sbs < -1000.0)
{
wtpar->sbs = -1000.0;
}
else if (wtpar->sbs > 1000.0)
{
wtpar->sbs = 1000.0;
}
ph = -M_PI_2*wtpar->sbs/wtpar->sb;
if ((ph > 0.0) && (ph < M_PI))
{
sinc = sin((double) (ph));
cosc = cos((double) (ph));
}
else
{
sinc = 0.0;
cosc = 1.0;
}
}
else
{
ph = 0.0;
sinc = 0.0;
cosc = 1;
}
sbfunc = sinc;
if (sinesquared)
wtpar->sb *= (-1);
}
else
{
sbfunc = 1.0;
}
/*********************************************
* Section for gaussian weighting functions *
*********************************************/
maxpoint = 0;
gfconst = 0.0;
if (wtpar->gf_active)
{
if (wtpar->gf < -1000.0)
{
wtpar->gf = -1000;
}
else if (wtpar->gf > 1000.0)
{
wtpar->gf = 1000.0;
}
if (wtpar->gf == 0.0)
{
wtpar->gf = 0.1;
}
gfconst = 1.0/( wtpar->sw*wtpar->gf);
if (rftflag)
gfconst /= 2.0;
if (wtpar->gfs_active)
{
if (wtpar->gfs < -1000.0)
{
wtpar->gfs = -1000.0;
}
else if (wtpar->gfs > 1000.0)
{
wtpar->gfs = 1000.0;
}
maxpoint = wtpar->sw*wtpar->gfs;
if (rftflag)
maxpoint *= 2;
if (maxpoint < 0)
{
maxpoint = 0;
}
else if (maxpoint >= n)
{
maxpoint = n-1;
}
}
}
/********************************************
* Section for additive weighting constant *
********************************************/
if (wtpar->awc_active)
{
awc = wtpar->awc;
}
else
{
awc = 0.0;
}
/************************************************
* Create weighting function in weight buffer. *
************************************************/
max = 0.0;
fpnt = wtfunc;
for (i = 0; i < n; i++)
{
f = (*fpnt) * sbfunc;
if (wtpar->lb_active)
{
lbvar = i*lbconst;
if (lbvar > MAX_WTVAL)
{
f *= MIN_WTFUNC;
}
else if (lbvar < MIN_WTVAL)
{
f *= MAX_WTFUNC;
}
else
{
f *= (float) (exp( -lbvar ));
}
}
f += awc;
if (wtpar->gf_active)
{
gfvar = (i - maxpoint)*gfconst;
gfvar *= gfvar;
if (gfvar > MAX_WTVAL)
{
f *= MIN_WTFUNC;
}
else
{
f *= (float) (exp( -gfvar ));
}
}
if (wtpar->sa_active)
{
if (i < sa_first)
f = 0.0;
if (i > sa_last)
f = 0.0;
}
if (f < 0.0)
{
f = 0.0;
}
else if (f > max)
{
max = f;
}
*fpnt++ = f;
if (wtpar->sb_active)
{
if ((ph > 0.0) && (ph < M_PI))
{
/* cordic rotation */
sbfunc = sinc*cosd + cosc*sind;
cosc = cosc*cosd - sinc*sind;
sinc = sbfunc;
if (sinesquared)
sbfunc *= sbfunc;
}
else
{
sbfunc = 0.0;
}
ph += phi;
}
}
/*************************************************
* Scale weighting function so that the maximum *
* value therein is 1.0, neglecting the effect *
* "fpmult". *
*************************************************/
fpnt = wtfunc; /* Reset "fpnt" pointer */
if ((max > 0.0) && (max != 1.0))
{
f = 1/max;
for (i = 0; i < n; i++)
{
*fpnt *= f;
fpnt++;
}
}
*wtfunc *= (float) fpmult; /* Scales first point in weighting function */
return(COMPLETE);
}
