Word SSILRCRI(Word a_, Word b_)
{
Word s,a,b,p,c,a1,a2,b1,b2,n,t,m,B,C,r;
Step0: /* Reflect interval if neccesary. */
if (RNSIGN(a_) == -1) {
s = 1; a = RNNEG(b_); b = RNNEG(a_); }
else {
s = 0; a = a_; b = b_; }
Step1: /* Initialize loop. */
RNFCL2(RNDIF(b,a),&p,&c);
if (p == c) p--;
FIRST2(b,&b1,&b2);
if (a == 0)
n = 0;
else {
FIRST2(a,&a1,&a2);
n = IQ(ITRUNC(a1,p),a2); }
Step2: /* Loop until n is even, then increment p and divide n by 2. */
do {
if (ISATOM(n)) t = ODD(n);
else t = ODD(FIRST(n));
p++;
n = IDP2(n,1);
}while(t);
m = ISUM(n,1);
Step3: /* If p is smallest possible, i.e. p = c, check (m+1)2^p > b. */
if (p == c) {
if (p >= 0) {
B = b1;
C = IMP2(IPROD(b2,m),p); }
else {
B = IMP2(b1,-p);
C = IPROD(b2,m); }
if (ICOMP(B,C) >= 1)
goto Step2; }
Return: /* Return, reflecting the output interval if needed. */
if (s) { r = n; n = -m; m = -r; }
return (LIST2(LBRNFIE(n,p),LBRNFIE(m,p)));
}
/*
* action routine for /VECTOR/CREATE
*/
int kxvcreate()
{
char *vspec = ku_getc();
char *vname = strdup( vspec );
int lvname;
char *vtype = ku_getc();
int lvtype = strlen( vtype );
char *value;
int length[4];
INTEGER LENGTH[3];
INTEGER LLOW;
INTEGER LHIGH;
#ifdef CERNLIB_WINNT
REAL rval; /*I move this variable to make Microsoft Bisual C/C++ compiler hally */
#endif
length[0] = 0;
length[1] = 0;
length[2] = 0;
if( strchr( vspec, '(' ) == NULL ) {
/* "V/CRE name" is treated as "V/CRE name(1)" */
length[0] = 1;
}
else {
int ntok = sscanf( vspec, "%[^(](%d,%d,%d,%d)",
vname, &length[0], &length[1], &length[2], &length[3]);
if( ntok < 2 || ntok > 4) {
ku_alfa();
printf( " *** VECTOR/CREATE %s: invalid dimensions\n", vspec );
free( vname );
return -1;
}
}
lvname = strlen( vname );
F77_CALL_Cxx(Kuvect,vname,lvname,&LLOW,&LHIGH);
if( LLOW != 0 ) {
int vlen = LHIGH - LLOW + 1;
F77_CALL_C(Kuvdel,vname,lvname);
ku_alfa();
printf( " *** VECTOR/CREATE %s: existing vector %s(%d) replaced\n",
vspec, vname, vlen );
}
LENGTH[0] = length[0];
LENGTH[1] = length[1];
LENGTH[2] = length[2];
F77_CALL_CCx3(Kuvcre,vname,lvname,vtype,lvtype,LENGTH,&LLOW,&LHIGH);
free( vname );
if( LLOW == 0 ) {
ku_alfa();
printf( " *** VECTOR/CREATE %s: cannot create\n", vspec );
return -1;
}
ku_getc();
while( (value = ku_getl()) != NULL ) {
/* fill vector with initial data */
INTEGER ival;
#ifndef CERNLIB_WINNT
/* by UNKNOWN reason it generates a problem under MS Visual C/C++ v.4.2 */
REAL rval;
#endif
int repeat;
int i;
if( vtype[0] == 'I' )
repeat = repeat_value( "VECTOR/CREATE", vspec, value, &ival, NULL );
else
repeat = repeat_value( "VECTOR/CREATE", vspec, value, NULL, &rval );
if( repeat < 1 )
return -1;
if( LLOW + repeat - 1 > LHIGH ) {
repeat = LHIGH - LLOW + 1;
ku_alfa();
printf( " *** VECTOR/CREATE %s: too many initializers\n", vspec );
break;
}
for( i = 0; i < repeat; i++ ) {
if( vtype[0] == 'I' )
IQ(LLOW) = ival;
else
Q(LLOW) = rval;
LLOW++;
}
}
return 0;
}
/*
* action routine for /VECTOR/PRINT
*/
int kxvprint()
{
char *vspec = ku_getc();
int lvspec = strlen( vspec );
int dense = ku_geti();
char *vname;
char *p;
INTEGER LLOW;
INTEGER LHIGH;
int nval;
int vtype;
int ilo[3];
int ihi[3];
int idx[3];
char dfm[3][8];
int ndim = 1;
int n;
int i;
ku_alfa();
F77_CALL_Cxx(Kuvect,vspec,lvspec,&LLOW,&LHIGH);
if( LLOW == 0 ) {
printf( " *** VECTOR/PRINT: unknown vector %s\n", vspec );
return -1;
}
vtype = IQUEST(14);
for( i = 0; i < 3; i++ ) {
idx[i] = ilo[i] = IQUEST(21+i);
if( (ihi[i] = IQUEST(31+i)) > 1 )
ndim = i + 1;
}
for( i = 0; i < ndim; i++ ) {
int m = ihi[i];
int k = 1;
while( m >= 10 ) {
m /= 10;
k++;
}
sprintf( dfm[i], "%s%%%dd", (i == 0) ? "" : ",", k );
}
nval = LHIGH - LLOW + 1;
vname = strupper( strdup( vspec ) );
if( (p = strchr( vname, '(' )) != NULL )
*p = '\0';
for( n = 0; n < nval; n++ ) {
int same = 0;
if( dense > 0 ) {
if( vtype != 1 ) {
for( i = n + 1; i < nval && IQ(LLOW+i) == IQ(LLOW+n); i++ )
same++;
}
else {
for( i = n + 1; i < nval && Q(LLOW+i) == Q(LLOW+n); i++ )
same++;
}
if( dense == 1 && same == 1 )
same = 0;
}
printf( " %s(", vname );
for( i = 0; i < ndim; i++ )
printf( dfm[i], idx[i] );
printf( ")" );
if( same > 0 ) {
int k;
for( k = 0; k < same; k++ ) {
for( i = 0; i < ndim; i++ ) {
if( ++idx[i] > ihi[i] )
idx[i] = ilo[i];
else
break;
}
}
if( dense == 1 )
printf( " ...\n %s", vname );
else
printf( ".." );
printf( "(" );
for( i = 0; i < ndim; i++ )
printf( dfm[i], idx[i] );
printf( ")" );
n += same;
}
printf( " = " );
if( vtype != 1 )
printf( "%d", IQ(LLOW+n) );
else {
double dval = Q(LLOW+n);
printf( "%s", strfromd( dval, 0 ) );
}
printf( "\n" );
for( i = 0; i < ndim; i++ ) {
if( ++idx[i] > ihi[i] )
idx[i] = ilo[i];
else
break;
}
}
free( vname );
return 0;
}
/*
* decode a input value [rep*]val where val can be numeric or a vector element
*/
static
int repeat_value( const char *cmd,
const char *vname,
const char *rep_value,
INTEGER *ival,
REAL *rval )
{
int repeat;
const char *value;
char *star;
char *tail;
while( (star = strchr( rep_value, '*')) != NULL
&& (repeat = atoi( rep_value )) < 1 ) {
ku_alfa();
printf( " *** %s: invalid repetition factor %s for %s\n",
cmd, rep_value, vname );
rep_value = ku_pros( "Reenter initializer or Q to quit:", NULL );
if( rep_value == NULL || *rep_value == 'q' || *rep_value == 'Q' )
return -1; /* EOF or QUIT */
}
if( star != NULL )
value = star + 1;
else {
value = rep_value;
repeat = 1;
}
if( ival != NULL ) {
*ival = fstrtoi( value, &tail );
if( *tail != '\0' )
*ival = fstrtod( value, &tail );
}
if( rval != NULL ) {
*rval = fstrtod( value, &tail );
}
if( *tail != '\0' ) {
INTEGER LLOW;
INTEGER LHIGH;
F77_CALL_Cxx(Kuvect,value,strlen(value),&LLOW,&LHIGH);
if( LLOW == 0 ) {
ku_alfa();
printf( " *** %s: invalid initializer %s for %s\n", cmd, value, vname );
value = ku_pros( "Reenter initializer or Q to quit:", NULL );
if( value == NULL || *value == 'q' || *value == 'Q' )
return -1; /* EOF or QUIT */
return repeat_value( cmd, vname, value, ival, rval );
}
if( LLOW != LHIGH ) {
ku_alfa();
printf( " *** %s: only first element of %s used as initializer for %s\n",
cmd, value, vname );
}
if( IQUEST(14) != 1 ) {
/* integer vector */
if( ival != NULL )
*ival = IQ(LLOW);
if( rval != NULL )
*rval = IQ(LLOW);
}
else {
/* real vector */
if( ival != NULL )
*ival = Q(LLOW);
if( rval != NULL )
*rval = Q(LLOW);
}
}
return repeat;
}
/*
* action routine for /VECTOR/INPUT
*/
int kxvinput()
{
char *vspec = ku_getc();
int lvspec = strlen( vspec );
char *vname;
char *p;
INTEGER LLOW;
INTEGER LHIGH;
int nval;
int vtype;
int ilo[3];
int ihi[3];
int idx[3];
int ndim = 1;
int status = 0;
int i;
Kcvect.TVECFL = ku_true( 0 ); /* don't make a temporary copy */
F77_CALL_Cxx(Kuvect,vspec,lvspec,&LLOW,&LHIGH);
Kcvect.TVECFL = ku_true( 1 );
if( LLOW == 0 ) {
ku_alfa();
printf( " *** VECTOR/INPUT: unknown vector %s\n", vspec );
return -1;
}
if( IQUEST(20) != 0 ) {
ku_alfa();
printf( " *** VECTOR/INPUT: sub-vector %s not implemented\n",
vspec );
return -1;
}
vtype = IQUEST(14);
for( i = 0; i < 3; i++ ) {
idx[i] = ilo[i] = IQUEST(21+i);
if( (ihi[i] = IQUEST(31+i)) > 1 )
ndim = i + 1;
}
nval = LHIGH - LLOW + 1;
vname = strdup( vspec );
if( (p = strchr( vname, '(' )) != NULL )
*p = '\0';
ku_getc();
while( nval > 0 ) {
const char *value;
INTEGER ival;
REAL rval;
int repeat;
char *prompt = str2dup( vname, "(" );
prompt = mstricat( prompt, idx[0] );
for( i = 1; i < ndim; i++ ) {
prompt = mstrcat( prompt, "," );
prompt = mstricat( prompt, idx[i] );
}
prompt = mstrcat( prompt, ") " );
if( (value = ku_getl()) == NULL ) {
/* prompt for values */
value = ku_proc( prompt, NULL );
if( value == NULL ) {
free( prompt );
status = -1;
break;
}
}
if( *value == '\0' ) {
/* leave value unchanged */
free( prompt );
repeat = 1;
}
else {
if( vtype != 1 )
repeat = repeat_value( "VECTOR/INPUT", prompt, value, &ival, NULL );
else
repeat = repeat_value( "VECTOR/INPUT", prompt, value, NULL, &rval );
free( prompt );
if( repeat < 1 ) {
status = -1;
break;
}
if( repeat > nval ) {
repeat = nval;
ku_alfa();
printf( " *** VECTOR/INPUT: too many initializers for %s\n", vspec );
}
for( i = 0; i < repeat; i++ ) {
if( vtype != 1 )
IQ(LLOW) = ival;
else
Q(LLOW) = rval;
LLOW++;
}
}
nval -= repeat;
for( i = 0; i < repeat; i++ ) {
int k;
for( k = 0; k < ndim; k++ ) {
if( ++idx[k] > ihi[k] )
idx[k] = ilo[k];
else
break;
}
}
}
free( vname );
return status;
}
InitGpio();
InitDma(terminate, skipSignals);
SetupGpioClock(SampleRate,TuningFrequency);
//printf("Timing : 1 cyle=%dns 1sample=%dns\n",NBSAMPLES_PWM_FREQ_MAX*400*3,(int)(1e9/(float)SampleRate));
return 1;
}
void print_usage(void)
{
fprintf(stderr,\
"\nrpitx -%s\n\
Usage:\nrpitx [-i File Input][-m ModeInput] [-f frequency output] [-s Samplerate] [-l] [-p ppm] [-h] \n\
-m {IQ(FileInput is a Stereo Wav contains I on left Channel, Q on right channel)}\n\
{IQFLOAT(FileInput is a Raw float interlaced I,Q)}\n\
{RF(FileInput is a (double)Frequency,Time in nanoseconds}\n\
{RFA(FileInput is a (double)Frequency,(int)Time in nanoseconds,(float)Amplitude}\n\
{VFO (constant frequency)}\n\
-i path to File Input \n\
-f float frequency to output on GPIO_18 pin 12 in khz : (130 kHz to 750 MHz),\n\
-l loop mode for file input\n\
-p float frequency correction in parts per million (ppm), positive or negative, for calibration, default 0.\n\
-d int DMABurstSize (default 1000) but for very short message, could be decrease\n\
-h help (this help).\n\
\n",\
PROGRAM_VERSION);
} /* end function print_usage */
