ptr S_unique_id() {
union {UUID uuid; INT foo[4];} u;
u.foo[0] = 0;
u.foo[1] = 0;
u.foo[2] = 0;
u.foo[3] = 0;
UuidCreate(&u.uuid);
return S_add(S_ash(Sunsigned(u.foo[0]), Sinteger(8*3*sizeof(INT))),
S_add(S_ash(Sunsigned(u.foo[1]), Sinteger(8*2*sizeof(INT))),
S_add(S_ash(Sunsigned(u.foo[2]), Sinteger(8*sizeof(INT))),
Sunsigned(u.foo[3]))));
}
ptr S_unique_id() {
struct timeval tp;
time_t sec;
pid_t pid;
INT ip;
(void) gettimeofday(&tp,NULL);
pid = getpid();
ip = gethostip();
sec = tp.tv_sec;
return S_add(S_ash(Sunsigned(pid), Sinteger(8*(sizeof(sec)+sizeof(ip)))),
S_add(S_ash(Sunsigned(ip), Sinteger(8*(sizeof(sec)))),
Sunsigned(sec)));
}
ptr S_cputime(void) {
struct timespec tp;
s_gettime(time_process, &tp);
return S_add(S_mul(S_integer_time_t(tp.tv_sec), FIX(1000)),
Sinteger((tp.tv_nsec + 500000) / 1000000));
}
static INT read_int(ptr *v, ptr n, INT r, IBOOL sign) {
INT i, c;
for (;;) {
if ((i = digit_value((c = getchar()), r)) == -1) {
ungetc(c, stdin);
break;
}
n = S_add(S_mul(n, FIX(r)), FIX(i));
}
*v = sign ? S_sub(FIX(0), n) : n;
return r_CONST;
}
ptr S_realtime(void) {
struct timespec tp;
time_t sec; I32 nsec;
s_gettime(time_monotonic, &tp);
sec = tp.tv_sec - starting_mono_tp.tv_sec;
nsec = tp.tv_nsec - starting_mono_tp.tv_nsec;
if (nsec < 0) {
sec -= 1;
nsec += 1000000000;
}
return S_add(S_mul(S_integer_time_t(sec), FIX(1000)),
Sinteger((nsec + 500000) / 1000000));
}
static ptr eval(ptr x) {
if (Spairp(x)) {
switch (Schar_value(Scar(x))) {
case '+': return S_add(First(x), Second(x));
case '-': return S_sub(First(x), Second(x));
case '*': return S_mul(First(x), Second(x));
case '/': return S_div(First(x), Second(x));
case 'q': return S_trunc(First(x), Second(x));
case 'r': return S_rem(First(x), Second(x));
case 'g': return S_gcd(First(x), Second(x));
case '=': {
ptr x1 = First(x), x2 = Second(x);
if (Sfixnump(x1) && Sfixnump(x2))
return Sboolean(x1 == x2);
else if (Sbignump(x1) && Sbignump(x2))
return Sboolean(S_big_eq(x1, x2));
else return Sfalse;
}
case '<': {
ptr x1 = First(x), x2 = Second(x);
if (Sfixnump(x1))
if (Sfixnump(x2))
return Sboolean(x1 < x2);
else
return Sboolean(!BIGSIGN(x2));
else
if (Sfixnump(x2))
return Sboolean(BIGSIGN(x1));
else
return Sboolean(S_big_lt(x1, x2));
}
case 'f': return Sflonum(S_floatify(First(x)));
case 'c':
S_gc(get_thread_context(), UNFIX(First(x)),UNFIX(Second(x)));
return Svoid;
case 'd': return S_decode_float(Sflonum_value(First(x)));
default:
S_prin1(x);
putchar('\n');
printf("unrecognized operator, returning zero\n");
return FIX(0);
}
} else
return x;
}
static void S4mex_Simulation_New(int nlhs, mxArray *plhs[], int nrhs, const mxArray *prhs[]){
S4_real Lr[4] = { 0, 0, 0, 0 };
int nbases = 1;
int is1d = 0;
if(3 != nrhs){
mexErrMsgIdAndTxt("S4:invalidInput", "Expected two additional arguments to 'new'.");
}
if(!mxIsNumeric(prhs[1]) || mxIsComplex(prhs[1]) || !((is1d = mxIsScalar(prhs[1])) || (2 == mxGetM(prhs[1]) && 2 == mxGetN(prhs[1])))){
mexErrMsgIdAndTxt("S4:invalidInput", "First additional argument (lattice) must be scalar or a 2x2 matrix.");
}
if(is1d){
Lr[0] = mxGetScalar(prhs[1]);
}else{
double *p = mxGetPr(prhs[1]);
Lr[0] = p[0];
Lr[1] = p[1];
Lr[2] = p[2];
Lr[3] = p[3];
if(0 == Lr[1] && 0 == Lr[2] && 0 == Lr[3]){
is1d = 1;
}
}
if(!mxIsNumeric(prhs[2]) || mxIsComplex(prhs[2]) || !mxIsScalar(prhs[2])){
mexErrMsgIdAndTxt("S4:invalidInput", "Second additional argument (#bases) must be a positive real integer.");
}
if(mxIsDouble(prhs[2])){
double *p = mxGetPr(prhs[2]);
nbases = (int)p[0];
}else{
void *p = mxGetData(prhs[2]);
switch(mxGetClassID(prhs[2])){
case mxSINGLE_CLASS:
{ float *pp = (float*)p; nbases = (int)pp[0]; break; }
case mxINT8_CLASS:
{ char *pp = (char*)p; nbases = (int)pp[0]; break; }
case mxUINT8_CLASS:
{ unsigned char *pp = (unsigned char*)p; nbases = (int)pp[0]; break; }
case mxINT16_CLASS:
{ short *pp = (short*)p; nbases = (int)pp[0]; break; }
case mxUINT16_CLASS:
{ unsigned short *pp = (unsigned short*)p; nbases = (int)pp[0]; break; }
case mxINT32_CLASS:
{ int *pp = (int*)p; nbases = (int)pp[0]; break; }
case mxUINT32_CLASS:
{ unsigned int *pp = (unsigned int*)p; nbases = (int)pp[0]; break; }
case mxINT64_CLASS:
{ long long *pp = (long long*)p; nbases = (int)pp[0]; break; }
case mxUINT64_CLASS:
{ unsigned long long *pp = (unsigned long long*)p; nbases = (int)pp[0]; break; }
default:
mexErrMsgIdAndTxt("S4:invalidInput", "Second additional argument (#bases) is an unknown class.");
break;
}
}
if(nbases < 1){
mexErrMsgIdAndTxt("S4:invalidInput", "Second additional argument (#bases) must be a positive integer.");
}
MEX_TRACE("> S4mex_Simulation_New(lattice = [%f, %f; %f, %f], bases = %d)\n", Lr[0], Lr[1], Lr[2], Lr[3], nbases);
{
int *p;
S4_Simulation *S = S4_Simulation_New(Lr, nbases, NULL);
plhs[0] = mxCreateNumericMatrix(1, 1, mxINT32_CLASS, mxREAL);
p = mxGetData(plhs[0]);
p[0] = S_add(S);
SS[p[0]].is1d = is1d;
MEX_TRACE("< S4mex_Simulation_New %d\n", p[0]);
}
}
