VCSI_OBJECT vcsi_list_length(VCSI_CONTEXT vc,
VCSI_OBJECT x) {
int c;
if(eq(vc,listq(vc,x),vc->false))
error(vc,"object passed to length is the wrong type",x);
if((c = get_length(x)) == -1)
error(vc,"object passed to length is the wrong type",x);
return make_long(vc,c);
}
VCSI_OBJECT vcsi_list_ref_i(VCSI_CONTEXT vc,
VCSI_OBJECT x,
int y) {
VCSI_OBJECT tmp;
int i,j;
if(!TYPEP(x,CONS) && x != NULL)
return error(vc,"object passed to list-ref is the wrong type",x);
j = get_length(x);
if(y >= j)
return error(vc,"subscript out of range",cons(vc,x,make_long(vc,y)));
for(tmp=x,i=0;TYPEP(tmp,CONS) && i < j && i < y;tmp=CDR(tmp),i++);
return CAR(tmp);
}
VCSI_OBJECT get_localtime_list(VCSI_CONTEXT vc,
VCSI_OBJECT x) {
struct tm* lt;
time_t tt;
check_arg_type(vc,x,LNGNUM,"localtime->list");
tt = LNGN(x);
lt = localtime(&tt);
return make_list(vc,9,make_long(vc,lt->tm_sec),
make_long(vc,lt->tm_min),
make_long(vc,lt->tm_hour),
make_long(vc,lt->tm_mday),
make_long(vc,lt->tm_mon),
make_long(vc,lt->tm_year+1900),
make_long(vc,lt->tm_wday),
make_long(vc,lt->tm_yday),
make_long(vc,lt->tm_isdst));
}
VCSI_OBJECT randobj(VCSI_CONTEXT vc,
VCSI_OBJECT args,
int length) {
VCSI_OBJECT tmp;
int r_seed;
if(length <= 0)
return error(vc,"random requires at least one argument",args);
if(length == 1) {
tmp = CAR(args);
if(TYPEP(tmp,LNGNUM)) {
r_seed = (int)((float)LNGN(tmp)*rand()/(RAND_MAX));
return make_long(vc,r_seed);
}
else
return tmp;
} else {
r_seed = (int)((float)length*rand()/(RAND_MAX));
return vcsi_list_ref_i(vc,args,r_seed);
}
}
void load_func_params(SYM * func_item)
{
/*
** Parse a shared library function's actual parameter-list
** and call the function.
*/
SHORT i,n;
char ptemp[14][80];
if (sym != lparen) { _error(14); return; }
else
{
/* get parameters */
i=0;
do
{
insymbol();
/*
** Make ALL parameters longints!
*/
if (expr() == shorttype) make_long();
/*
** Store parameter information temporarily
** since expression evaluation may corrupt
** data in registers later if loaded now.
*/
make_temp_long();
strcpy(ptemp[i],templongname); /* later -> move.l srctemp,addrbuf */
/* store it */
gen_pop32_var(templongname);
i++;
}
while ((i < func_item->no_of_params) && (sym == comma));
if ((i < func_item->no_of_params) || (sym == comma))
_error(39); /* parameter count mismatch - too few or too many. */
else
{
/* load parameters into regs */
for (n=0;n<func_item->no_of_params;n++)
{
/* does reg (a4 or a5 ONLY) need to be preserved? */
if (func_item->reg[n] == 13) /* a4 */
{
restore_a4=TRUE;
gen_save32a(4,"_a4_temp");
enter_BSS("_a4_temp:","ds.l 1");
}
else
if (func_item->reg[n] == 14) /* a5 */
{
restore_a5=TRUE;
gen_save32a(5,"_a5_temp");
enter_BSS("_a5_temp:","ds.l 1");
}
/*
** Store value in register.
*/
gen_move32(ptemp[n],reg[func_item->reg[n]]);
}
}
if (sym != rparen) _error(9);
}
}
