/*************************************************************************
* f_sql_handles( void )
*
* returns an array containing the IDs of the currently opened connections
*************************************************************************/
svalue_t *
f_sql_handles( svalue_t * argv, int argc )
{
#if ODBC_DEBUG & DEBUG_FUNC
printf( "call f_sql_handles( )\n" );
#endif
int cnt, i;
hDBC * tmp;
vector_t * vec;
argv++;
if ( !hODBCEnv )
init_odbc_environment();
if ( !hODBCEnv ) {
put_number( argv, 0 );
return( argv );
}
if ( !hODBCEnv->hDBCons ) {
vec = allocate_array( 0 );
MEM_CHECK( vec );
put_array( argv, vec );
return( argv );
}
tmp = hODBCEnv->hDBCons;
cnt = 1;
while( (tmp = tmp->next ) )
cnt++;
vec = allocate_array( cnt );
MEM_CHECK( vec );
tmp = hODBCEnv->hDBCons;
for ( i = 0; i < cnt; ++i ) {
put_number( vec->item + i, tmp->ID );
tmp = tmp->next;
}
put_array( argv, vec );
#if ODBC_DEBUG & DEBUG_FUNC
printf( "ret f_sql_handles( )\n" );
#endif
return( argv );
}
void Options::Flush() const {
json::Object obj_out;
for (auto const& ov : values) {
switch (ov.second->GetType()) {
case OptionValue::Type_String:
put_option(obj_out, ov.first, ov.second->GetString());
break;
case OptionValue::Type_Int:
put_option(obj_out, ov.first, ov.second->GetInt());
break;
case OptionValue::Type_Double:
put_option(obj_out, ov.first, ov.second->GetDouble());
break;
case OptionValue::Type_Color:
put_option(obj_out, ov.first, ov.second->GetColor().GetRgbFormatted());
break;
case OptionValue::Type_Bool:
put_option(obj_out, ov.first, ov.second->GetBool());
break;
case OptionValue::Type_List_String:
put_array(obj_out, ov.first, "string", ov.second->GetListString());
break;
case OptionValue::Type_List_Int:
put_array(obj_out, ov.first, "int", ov.second->GetListInt());
break;
case OptionValue::Type_List_Double:
put_array(obj_out, ov.first, "double", ov.second->GetListDouble());
break;
case OptionValue::Type_List_Color:
put_array(obj_out, ov.first, "color", ov.second->GetListColor());
break;
case OptionValue::Type_List_Bool:
put_array(obj_out, ov.first, "bool", ov.second->GetListBool());
break;
}
}
json::Writer::Write(obj_out, io::Save(config_file).Get());
}
void f_db_fetch (void)
{
db_t *db;
array_t *ret;
valid_database("fetch", &the_null_array);
db = find_db_conn((sp-1)->u.number);
if (!db) {
error("Attempt to fetch from an invalid database handle\n");
}
if (db->type->fetch) {
ret = db->type->fetch(&(db->c), sp->u.number);
} else {
ret = &the_null_array;
}
pop_stack();
if (!ret) {
if (db->type->error) {
char *errormsg;
errormsg = db->type->error(&(db->c));
put_malloced_string(errormsg);
} else {
sp->u.number = 0;
}
} else {
put_array(ret);
}
}
/*-------------------------------------------------------------------------*/
void
finalize_arraylist (svalue_t * list)
/* Turn the arraylist in <list> into a proper array.
*/
{
arraylist_t * data = (arraylist_t *) list->u.lvalue;
arraylist_element_t * element;
vector_t * result;
svalue_t * item;
result = allocate_array(data->num);
element = data->first;
item = result->item;
while (element)
{
arraylist_element_t * temp = element;
*item = element->value;
item++;
element = element->next;
xfree(temp);
}
xfree(data);
put_array(list, result);
} /* finalize_arraylist() */
/*************************************************************************
* f_sql_column_names( int handle )
*
* returns the returned column names of the last executed statement
*************************************************************************/
svalue_t *
f_sql_column_names( svalue_t * argv, int argc )
{
#if ODBC_DEBUG & DEBUG_FUNC
printf( "call f_sql_column_names( )\n" );
#endif
int id, cnt, i;
hDBC * handle;
vector_t * vec;
TYPE_TEST1( argv, T_NUMBER );
id = argv->u.number;
free_svalue( argv );
if ( !(handle = get_db_connection_by_id( id )) ) {
errorf( "Illegal handle for database.\n" );
return( NULL );
}
if ( !handle->columns ) {
vec = allocate_array( 0 );
MEM_CHECK( vec );
put_array( argv, vec );
return( argv );
}
cnt = handle->colcnt;
vec = allocate_array( cnt );
MEM_CHECK( vec );
for ( i = 0; i < cnt; ++i ) {
if ( handle->columns[ i ] )
put_malloced_string(vec->item + i, string_copy( handle->columns[ i ]->name ) );
}
put_array( argv, vec );
#if ODBC_DEBUG & DEBUG_FUNC
printf( "ret f_sql_column_names( )\n" );
#endif
return( argv );
}
int put_game_state(FILE *fout)
{
if (game_state)
{
/* Write the view and tilt state. */
put_float(fout, &game_rx);
put_float(fout, &game_rz);
put_array(fout, view_c, 3);
put_array(fout, view_p, 3);
/* Write the game simulation state. */
put_file_state(fout, &file);
return 1;
}
return 0;
}
/*-------------------------------------------------------------------------*/
svalue_t *
f_tls_query_connection_info (svalue_t *sp)
/* EFUN tls_query_connection_info()
*
*
* #include <sys/tls.h>
* int *tls_query_connection_info (object ob)
*
* If <ob> does not have a TLS connection, or if the TLS connection is
* still being set up, the efun returns 0.
*
* If <ob> has a TLS connection, tls_query_connection_info() returns an array
* that contains some parameters of <ob>'s connection:
*
* int|string [TLS_CIPHER]: the cipher used
* int [TLS_COMP]: the compression used
* int [TLS_KX]: the key-exchange used
* int [TLS_MAC]: the digest algorithm used
* int|string [TLS_PROT]: the protocol used
*
* To translate these numbers into strings, <tls.h> offers a number of macros:
*
* TLS_xxx_TABLE: a literal array of strings describing the value in
* question.
* TLS_xxx_NAME(x): a macro translating the numeric result value into a
* string.
*
* xxx: CIPHER, COMP, KX, MAC, PROT
*/
{
interactive_t *ip;
if (O_SET_INTERACTIVE(ip, sp->u.ob) && ip->tls_status == TLS_ACTIVE)
{
vector_t * rc;
rc = tls_query_connection_info(ip);
free_svalue(sp);
put_array(sp, rc);
}
else
{
free_svalue(sp);
put_number(sp, 0);
}
return sp;
} /* tls_query_connection_info() */
void f_str_to_arr(){
static struct translation *newt = 0;
if(!newt){
newt = get_translator("UTF-32");
translate_easy(newt->outgoing, " ");
}
int len;
int *trans = (int *)translate(newt->outgoing, sp->u.string, SVALUE_STRLEN(sp)+1, &len);
len/=4;
array_t *arr = allocate_array(len);
while(len--)
arr->item[len].u.number = trans[len];
free_svalue(sp, "str_to_arr");
put_array(arr);
}
/*-------------------------------------------------------------------------*/
static vector_t *
single_struct_info (struct_type_t * st, Bool include_base)
/* Create the struct_info() result array for a single struct and return it.
* If <include_base> is TRUE, all members defined in a possible base
* struct are included as if they were top-level members.
*/
{
vector_t * rc;
size_t offset;
size_t i;
offset = 0;
if (!include_base && st->base != NULL)
offset = struct_t_size(st->base);
rc = allocate_array(struct_t_size(st) - offset + SI_MAX);
put_ref_string(&rc->item[SI_NAME], struct_t_name(st));
put_ref_string(&rc->item[SI_PROG_NAME], struct_t_pname(st));
put_number(&rc->item[SI_PROG_ID], st->prog_id);
for (i = offset; i < struct_t_size(st); i++)
{
vector_t * member;
struct_member_t * pMember;
pMember = &st->member[i];
member = allocate_array(SIM_MAX);
put_array(&rc->item[SI_MEMBER+i-offset], member);
put_ref_string(&member->item[SIM_NAME], pMember->name);
put_number(&member->item[SIM_TYPE], 0); /* TODO: Convert pMember->type to int */
if (pMember->type->t_class == TCLASS_STRUCT)
put_ref_string(&member->item[SIM_EXTRA]
, pMember->type->t_struct.name->name
);
}
return rc;
} /* single_struct_info() */
/*-------------------------------------------------------------------------*/
svalue_t *
f_tls_check_certificate(svalue_t *sp)
/* EFUN tls_check_certificate()
*
* mixed *tls_check_certificate(object obj);
* mixed *tls_check_certificate(object obj, int extra);
*
* tls_check_certificate() checks the certificate of the secured
* connection bound to <obj> (default is the current object). If
* <obj> is not interactive, or if TLS is not available, an error
* is thrown.
*
* If <obj> doesn't have a secure connection up and running, an
* error is thrown.
* Otherwise, the result is an array with these values:
*
* int [0] : Result code of SSL_get_verify_result (see man 1 verify
* subsection DIAGNOSTICS for possible values)
* array [1] : array with 3*n entries of extra x509 data.
* structure is:
* 3*i : numerical form of object name, e.g. "2.5.4.3"
* 3*i + 1: long or short name if available, e.g. "commonName"
* 3*i + 2: value
* array [2] : if extra is set:
* array with 3*n entries of x509 extension data
* data structure is:
* 3*i : numerical form of extension name
* 3*i + 1: long or short name of extension name if available
* 3*i + 2: array of strings with the data structure of [1]
*
* Note: a x509 certificate can have more than one object with the same name
*
* See associated documentation for code that generates more convient mapping
* data structures
*/
{
vector_t *v = NULL;
interactive_t *ip;
int more;
/* more information requested */
more = sp->u.number;
free_svalue(sp--);
if (!tls_available())
errorf("tls_check_certificate(): TLS layer hasn't been initialized.\n");
if (!O_SET_INTERACTIVE(ip, sp->u.ob))
errorf("Bad arg 1 to tls_check_certificate(): "
"object not interactive.\n");
if (ip->tls_status != TLS_ACTIVE)
errorf("tls_check_certificate(): object doesn't have a secure connection.\n");
if (more < 0 || more > 1)
errorf("tls_check_certificate(): invalid flag passed as second argument.\n");
v = tls_check_certificate(ip, (more == 1) ? MY_TRUE : MY_FALSE);
free_svalue(sp);
if (v != NULL)
put_array(sp, v);
else
put_number(sp, 0);
return sp;
} /* tls_check_certificate() */
svalue_t *
f_sql_fetch( svalue_t * argv, int argc )
{
#if ODBC_DEBUG & DEBUG_FUNC
printf( "call f_sql_fetch( )\n" );
#endif
int id, method = 0;
hDBC * handle;
SQLRETURN ret;
STORE_DOUBLE_USED;
switch( argc ) {
case 2 :
TYPE_TEST2( argv, T_NUMBER );
method = argv->u.number;
free_svalue( argv );
argv--;
case 1 :
TYPE_TEST1( argv, T_NUMBER );
id = argv->u.number;
free_svalue( argv );
break;
default:
errorf( "Too many arguments to sql_fetch().\n" );
return( NULL );
}
if ( !(handle = get_db_connection_by_id( id )) ) {
errorf( "Illegal handle for database.\n" );
return( NULL );
}
if ( !handle->hStmt ) {
put_number( argv, 0 );
return( argv );
}
//printf( "\nFetching ....\n" );
ret = SQLFetch( handle->hStmt );
if ( ret == SQL_NO_DATA ) {
//printf( "NO_DATA\n" );
put_number( argv, 0 );
return( argv );
} else if ( !SQL_SUCCEEDED( ret ) ) {
put_number( argv, 0 );
return( argv );
}
if ( !handle->columns ) {
put_number( argv, 0 );
return( argv );
}
if ( !method ) { //fetch as array
put_array( argv, fetch_into_vector( handle ) );
} else { //fetch as mapping
put_mapping( argv, fetch_into_mapping( handle ) );
}
#if ODBC_DEBUG & DEBUG_FUNC
printf( "ret f_sql_fetch( )\n" );
#endif
return( argv );
}
/*-------------------------------------------------------------------------*/
svalue_t *
f_struct_info (svalue_t *sp)
/* EFUN struct_info()
*
* mixed * struct_info(struct s, int type)
*
* Return an array with information about the struct <s>. The
* type of information returned is determined by <type>.
*/
{
struct_type_t *st;
int rtype;
svalue_t result;
/* Get the arguments from the stack */
st = sp[-1].u.strct->type;
rtype = sp[0].u.number;
/* Get the basic result information */
put_array(&result, single_struct_info(st, rtype != SINFO_NESTED));
if (st->base != NULL)
{
/* Depending on the <rtype> argument, determine the how to handle
* the base structs (if any).
*/
switch(rtype)
{
case SINFO_FLAT:
put_ref_string(&result.u.vec->item[SI_BASE], struct_t_name(st->base));
break;
case SINFO_NESTED:
{
svalue_t *rc;
for ( rc = &result.u.vec->item[SI_BASE], st = st->base
; st != NULL
; st = st->base, rc = &rc->u.vec->item[SI_BASE]
)
{
put_array(rc, single_struct_info(st, MY_FALSE));
}
break;
}
default:
free_svalue(&result);
errorf("Bad arg 2 to struct_info(): illegal value %"PRIdPINT"\n"
, sp->u.number);
/* NOTREACHED */
return sp;
}
}
free_svalue(sp); sp--; /* type */
free_svalue(sp); /* struct */
/* Assign the result */
transfer_svalue_no_free(sp, &result);
return sp;
} /* f_struct_info() */
CORBA_boolean
porbit_put_sv (GIOPSendBuffer *buf, CORBA_TypeCode tc, SV *sv)
{
switch (tc->kind) {
case CORBA_tk_null:
case CORBA_tk_void:
return CORBA_TRUE;
case CORBA_tk_short:
return put_short (buf, sv);
case CORBA_tk_long:
return put_long (buf, sv);
case CORBA_tk_ushort:
return put_ushort (buf, sv);
case CORBA_tk_ulong:
return put_ulong (buf, sv);
case CORBA_tk_float:
return put_float (buf, sv);
case CORBA_tk_double:
return put_double (buf, sv);
case CORBA_tk_char:
return put_char (buf, sv);
case CORBA_tk_boolean:
return put_boolean (buf, sv);
case CORBA_tk_octet:
return put_octet (buf, sv);
case CORBA_tk_enum:
return put_enum (buf, tc, sv);
case CORBA_tk_struct:
return put_struct (buf, tc, sv);
case CORBA_tk_sequence:
return put_sequence (buf, tc, sv);
case CORBA_tk_except:
return put_except (buf, tc, sv);
case CORBA_tk_objref:
return put_objref (buf, tc, sv);
case CORBA_tk_union:
return put_union (buf, tc, sv);
case CORBA_tk_alias:
return put_alias (buf, tc, sv);
case CORBA_tk_string:
return put_string (buf, tc, sv);
case CORBA_tk_array:
return put_array (buf, tc, sv);
case CORBA_tk_longlong:
return put_longlong (buf, sv);
case CORBA_tk_ulonglong:
return put_ulonglong (buf, sv);
case CORBA_tk_longdouble:
return put_longdouble (buf, sv);
case CORBA_tk_TypeCode:
return put_typecode (buf, tc, sv);
case CORBA_tk_any:
return put_any (buf, tc, sv);
case CORBA_tk_fixed:
return put_fixed (buf, tc, sv);
case CORBA_tk_wchar:
case CORBA_tk_wstring:
case CORBA_tk_Principal:
default:
warn ("Unsupported output typecode %d\n", tc->kind);
return CORBA_FALSE;
}
}
/*-------------------------------------------------------------------------*/
svalue_t *
v_sl_exec (svalue_t * sp, int num_arg)
/* EFUN sl_exec()
*
* mixed* sl_exec(string statement, ...)
*
* Executes the SQL statement <statement> for the current
* SQLite database. The SQL statement may contain wildcards like
* '?' and '?nnn', where 'nnn' is an integer. These wildcards
* can be given as further parameters to sl_exec. With '?nnn'
* the number of a specific parameter can be given, the first
* parameter has number 1.
*
* If the statement returns data, sl_exec returns an array
* with each row (which is itself an array of columns) as
* an element.
*/
{
svalue_t *argp;
sqlite_dbs_t *db;
sqlite3_stmt *stmt;
const char* tail;
int err, rows, cols, num;
struct sl_exec_cleanup_s * rec_data;
vector_t * result;
argp = sp - num_arg + 1; /* First argument: the SQL query */
db = find_db (current_object);
if (!db)
errorf("The current object doesn't have a database open.\n");
err = sqlite3_prepare(db->db, get_txt(argp->u.str), mstrsize(argp->u.str),
&stmt, &tail);
if(err)
{
const char* msg = sqlite3_errmsg(db->db);
if(stmt)
sqlite3_finalize(stmt);
errorf("sl_exec: %s\n", msg);
/* NOTREACHED */
}
/* Now bind all parameters. */
for(argp++, num=1; argp <= sp; argp++, num++)
{
switch(argp->type)
{
default:
sqlite3_finalize(stmt);
errorf("Bad argument %d to sl_exec(): type %s\n",
num+1, typename(argp->type));
break; /* NOTREACHED */
case T_FLOAT:
sqlite3_bind_double(stmt, num, READ_DOUBLE(argp));
break;
case T_NUMBER:
if (sizeof(argp->u.number) > 4)
sqlite3_bind_int64(stmt, num, argp->u.number);
else
sqlite3_bind_int(stmt, num, argp->u.number);
break;
case T_STRING:
sqlite3_bind_text(stmt, num, get_txt(argp->u.str),
mstrsize(argp->u.str), SQLITE_STATIC);
break;
}
}
rows = 0;
cols = sqlite3_column_count(stmt);
rec_data = xalloc(sizeof(*rec_data));
if(!rec_data)
{
sqlite3_finalize(stmt);
errorf("(sl_exec) Out of memory: (%lu bytes) for cleanup structure\n",
(unsigned long) sizeof(*rec_data));
}
rec_data->rows = NULL;
rec_data->stmt = stmt;
sp = push_error_handler(sl_exec_cleanup, &(rec_data->head));
while((err = sqlite3_step(stmt)) == SQLITE_ROW)
{
int col;
sqlite_rows_t *this_row;
rows++;
this_row = pxalloc(sizeof(*this_row));
if(!this_row)
errorf("(sl_exec) Out of memory: (%lu bytes)\n",
(unsigned long) sizeof(*this_row));
this_row->last = rec_data->rows;
rec_data->rows = this_row;
this_row->row = NULL; /* Because allocate_array may throw an error. */
this_row->row = allocate_array(cols);
if(!this_row->row)
errorf("(sl_exec) Out of memory: row vector\n");
for(col = 0; col < cols; col++)
{
svalue_t * entry;
STORE_DOUBLE_USED;
entry = this_row->row->item + col;
switch(sqlite3_column_type(stmt, col))
{
default:
errorf( "sl_exec: Unknown type %d.\n"
, sqlite3_column_type(stmt, col));
break;
case SQLITE_BLOB:
errorf("sl_exec: Blob columns are not supported.\n");
break;
case SQLITE_INTEGER:
if (sizeof(entry->u.number) >= 8)
put_number(entry, sqlite3_column_int64(stmt, col));
else
put_number(entry, sqlite3_column_int(stmt, col));
break;
case SQLITE_FLOAT:
entry->type = T_FLOAT;
STORE_DOUBLE(entry, sqlite3_column_double(stmt, col));
break;
case SQLITE_TEXT:
put_c_n_string( entry
, (char *)sqlite3_column_text(stmt, col)
, sqlite3_column_bytes(stmt, col));
break;
case SQLITE_NULL:
/* All elements from this_row->row are initialized to 0. */
break;
}
}
}
sqlite3_finalize(stmt);
rec_data->stmt = NULL;
switch(err)
{
default:
errorf("sl_exec: Unknown return code from sqlite3_step: %d.\n", err);
break;
case SQLITE_BUSY:
errorf("sl_exec: Database is locked.\n");
break;
case SQLITE_ERROR:
errorf("sl_exec: %s\n", sqlite3_errmsg(db->db));
break;
case SQLITE_MISUSE:
errorf("sl_exec: sqlite3_step was called inappropriately.\n");
break;
case SQLITE_DONE:
break;
}
if(rows)
{
sqlite_rows_t *this_row;
result = allocate_array(rows);
if(!result)
errorf("(sl_exec) Out of memory: result vector\n");
this_row = rec_data->rows;
while(rows--)
{
put_array(result->item + rows, this_row->row);
this_row->row = NULL;
this_row = this_row->last;
}
}
else
result = NULL;
// Pop arguments and our error handler.
// Our error handler gets called and cleans the row stuff.
sp = pop_n_elems(num_arg + 1, sp) + 1;
if(rows)
put_array(sp,result);
else
put_number(sp, 0);
return sp;
} /* v_sl_exec() */
/*-------------------------------------------------------------------------*/
svalue_t *
f_get_error_file (svalue_t *sp)
/* EFUN get_error_file()
*
* mixed * get_error_file(string name, int set_forget_flag)
*
* Return information about the last error which occured for
* <name> (where <name> is a valid name from the wiz list).
*
* Result is an array of four elements: the filename of the
* program where the error occured, the linenumber in the
* program, the error message (runtime error messages usually
* start with a '*'), and a numerical flag (the 'forget flag') if
* the error information has been queried already.
*
* If there is no error stored for the given <name>, 0 is
* returned.
*
* If <set_forget_flag> is non-zero, the 'forget' flag is set
* for the error message after it has been returned.
*/
{
string_t *name;
int forget;
wiz_list_t *wl;
vector_t *vec;
svalue_t *v;
# define FORGET_FLAG 0x4000000 /* 0x80...0 would be the sign! */
/* Get the function arguments */
name = sp[-1].u.str;
forget = sp->u.number;
wl = find_wiz(name);
sp--;
free_string_svalue(sp);
/* The error_message is used as a flag if there has been any error.
*/
if (!wl || !wl->error_message)
{
put_number(sp, 0);
return sp;
}
vec = allocate_array(4);
v = vec->item;
put_ref_string(v, wl->file_name);
put_number(v+1, wl->line_number & ~0x40000000);
put_ref_string(v+2, wl->error_message);
put_number(v+3, (wl->line_number & 0x40000000) != 0);
if (forget)
wl->line_number |= 0x40000000;
put_array(sp, vec);
return sp;
# undef FORGET_FLAG
} /* f_get_error_file() */
/* FIXME: most of the #ifdefs here should be based on configure checks
instead. Same for rusage() */
void
f_localtime (void)
{
struct tm *tm;
array_t *vec;
time_t lt;
#ifdef sequent
struct timezone tz;
#endif
lt = sp->u.number;
tm = localtime(<);
vec = allocate_empty_array(11);
vec->item[LT_SEC].type = T_NUMBER;
vec->item[LT_SEC].u.number = tm->tm_sec;
vec->item[LT_MIN].type = T_NUMBER;
vec->item[LT_MIN].u.number = tm->tm_min;
vec->item[LT_HOUR].type = T_NUMBER;
vec->item[LT_HOUR].u.number = tm->tm_hour;
vec->item[LT_MDAY].type = T_NUMBER;
vec->item[LT_MDAY].u.number = tm->tm_mday;
vec->item[LT_MON].type = T_NUMBER;
vec->item[LT_MON].u.number = tm->tm_mon;
vec->item[LT_YEAR].type = T_NUMBER;
vec->item[LT_YEAR].u.number = tm->tm_year + 1900;
vec->item[LT_WDAY].type = T_NUMBER;
vec->item[LT_WDAY].u.number = tm->tm_wday;
vec->item[LT_YDAY].type = T_NUMBER;
vec->item[LT_YDAY].u.number = tm->tm_yday;
vec->item[LT_GMTOFF].type = T_NUMBER;
vec->item[LT_ZONE].type = T_STRING;
vec->item[LT_ZONE].subtype = STRING_MALLOC;
vec->item[LT_ISDST].type = T_NUMBER;
#if defined(BSD42) || defined(apollo) || defined(_AUX_SOURCE) \
|| defined(OLD_ULTRIX)
/* 4.2 BSD doesn't seem to provide any way to get these last three values */
vec->item[LT_GMTOFF].u.number = 0;
vec->item[LT_ZONE].type = T_NUMBER;
vec->item[LT_ZONE].u.number = 0;
vec->item[LT_ISDST].u.number = -1;
#else /* BSD42 */
vec->item[LT_ISDST].u.number = tm->tm_isdst;
#if defined(sequent)
vec->item[LT_GMTOFF].u.number = 0;
gettimeofday(NULL, &tz);
vec->item[LT_GMTOFF].u.number = tz.tz_minuteswest;
vec->item[LT_ZONE].u.string =
string_copy(timezone(tz.tz_minuteswest, tm->tm_isdst), "f_localtime");
#else /* sequent */
#if (defined(hpux) || defined(_SEQUENT_) || defined(_AIX) || defined(SunOS_5) \
|| defined(SVR4) || defined(sgi) || defined(linux) || defined(cray) \
|| defined(LATTICE) || defined(SCO))
if (!tm->tm_isdst) {
vec->item[LT_GMTOFF].u.number = timezone;
vec->item[LT_ZONE].u.string = string_copy(tzname[0], "f_localtime");
} else {
#if (defined(_AIX) || defined(hpux) || defined(linux) || defined(cray) \
|| defined(LATTICE))
vec->item[LT_GMTOFF].u.number = timezone;
#else
vec->item[LT_GMTOFF].u.number = altzone;
#endif
vec->item[LT_ZONE].u.string = string_copy(tzname[1], "f_localtime");
}
#else
#ifndef WIN32
vec->item[LT_GMTOFF].u.number = tm->tm_gmtoff;
vec->item[LT_ZONE].u.string = string_copy(tm->tm_zone, "f_localtime");
#else
vec->item[LT_GMTOFF].u.number = _timezone;
vec->item[LT_ZONE].u.string = string_copy(_tzname[_daylight?1:0],"f_localtime");
#endif
#endif
#endif /* sequent */
#endif /* BSD42 */
put_array(vec);
}
svalue_t *
f_psyc_parse (svalue_t *sp) {
char *buffer = NULL;
svalue_t *sv;
vector_t *v, *list;
mapping_t *map;
char oper = 0;
psycString name = {0,0}, value = {0,0}, elems[MAX_LIST_SIZE], elem;
psycParseListState listState;
int ret, retl, type = -1, error = 0;
size_t size, i;
ssize_t n;
time_t timmy;
if (!psyc_dispatch_callback)
psyc_dispatch_callback = new_tabled("psyc_dispatch");
if (!psyc_error_callback)
psyc_error_callback = new_tabled("psyc_error");
assert_shadow_sent(current_object);
psyc_state_t *state = O_GET_PSYC_STATE(current_object);
if (!state) {
state = pxalloc(sizeof(psyc_state_t));
if (!state) {
errorf("Out of memory for psyc state struct.\n");
return sp; // not reached
}
O_GET_PSYC_STATE(current_object) = state;
memset(state, 0, sizeof(psyc_state_t));
state->parser = pxalloc(sizeof(psycParseState));
if (!state->parser) {
errorf("Out of memory for psyc parse state struct.\n");
return sp; // not reached
}
psyc_initParseState(state->parser);
}
v = state->packet;
if (sp->type == T_POINTER) {
errorf("\npsyc_parse got %ld int* bytes... not supported yet\n",
VEC_SIZE(sp->u.vec));
return sp; // not reached
} else if (sp->type == T_STRING) {
#ifdef DEBUG
printf("\npsyc_parse got a %ld bytes long string...\n", mstrsize(sp->u.str));
#endif
if (state->remaining) {
// there are remaining bytes from the previous call to psyc_parse,
// copy them together with the newly arrived data
buffer = pxalloc(state->remaining_len + mstrsize(sp->u.str));
if (!buffer) {
errorf("Out of memory for psyc_parse buffer.\n");
return sp; // not reached
}
memcpy(buffer, state->remaining, state->remaining_len);
memcpy(buffer + state->remaining_len, get_txt(sp->u.str),
mstrsize(sp->u.str));
psyc_setParseBuffer2(state->parser, buffer,
state->remaining_len + mstrsize(sp->u.str));
pfree(state->remaining);
state->remaining = NULL;
state->remaining_len = 0;
} else {
psyc_setParseBuffer2(state->parser, get_txt(sp->u.str),
mstrsize(sp->u.str));
}
} else {
errorf("\npsyc_parse got type %d, not supported\n", sp->type);
return sp; // not reached
}
do {
ret = psyc_parse(state->parser, &oper, &name, &value);
#ifdef DEBUG
printf("#%2d %c%.*s = %.*s\n", ret, oper ? oper : ' ',
(int)name.length, name.ptr, (int)value.length, value.ptr);
#endif
if (!state->packet) {
state->packet = allocate_array(4);
if (!state->packet) {
errorf("Out of memory for psyc_parse array.\n");
return sp; // not reached
}
v = state->packet;
map = allocate_mapping(0, 2); // empty mapping
if (!map) {
errorf("Out of memory for psyc_parse routing header.\n");
return sp; // not reached
}
put_mapping(&v->item[PACKET_ROUTING], map);
map = allocate_mapping(0, 2); // empty mapping
if (!map) {
errorf("Out of memory for psyc_parse entity header.\n");
return sp; // not reached
}
put_mapping(&v->item[PACKET_ENTITY], map);
}
switch (ret) {
case PSYC_PARSE_ENTITY_START: case PSYC_PARSE_BODY_START:
// save oper, name & value in state at the start of
// incomplete entity or body
state->oper = oper;
state->name = mstring_alloc_string(name.length);
memcpy(get_txt(state->name), name.ptr, name.length);
if (!state->name) {
errorf("Out of memory for name.\n");
return sp; // not reached
}
// allocate memory for the total length of the value
state->value_len = 0;
state->value = mstring_alloc_string(psyc_getParseValueLength(state->parser));
if (!state->value) {
errorf("Out of memory for value.\n");
return sp; // not reached
}
// fall thru
case PSYC_PARSE_ENTITY_CONT: case PSYC_PARSE_BODY_CONT:
case PSYC_PARSE_ENTITY_END: case PSYC_PARSE_BODY_END:
// append value to tmp buffer in state
memcpy(get_txt(state->value) + state->value_len, value.ptr, value.length);
state->value_len += value.length;
}
if (ret == PSYC_PARSE_ENTITY_END || ret == PSYC_PARSE_BODY_END) {
// incomplete entity or body parsing done,
// set oper/name/value to the ones saved in state
oper = state->oper;
name.ptr = get_txt(state->name);
name.length = mstrsize(state->name);
value.ptr = get_txt(state->value);
value.length = mstrsize(state->value);
}
switch (ret) {
case PSYC_PARSE_ROUTING:
sv = pxalloc(sizeof(svalue_t));
// new_n_tabled fetches a reference of a probably existing
// shared string
put_string(sv, new_n_tabled(name.ptr, name.length));
sv = get_map_lvalue(v->item[PACKET_ROUTING].u.map, sv);
put_number(&sv[1], oper);
// strings are capable of containing 0 so we can do this
// for binary data too. let's use a tabled string even
// for values of routing variables as they repeat a lot
put_string(sv, new_n_tabled(value.ptr, value.length));
break;
case PSYC_PARSE_ENTITY_START:
case PSYC_PARSE_ENTITY_CONT:
break;
case PSYC_PARSE_ENTITY_END:
case PSYC_PARSE_ENTITY:
sv = pxalloc(sizeof(svalue_t));
if (ret == PSYC_PARSE_ENTITY)
put_string(sv, new_n_tabled(name.ptr, name.length));
else // PSYC_PARSE_ENTITY_END
put_string(sv, make_tabled(state->name));
sv = get_map_lvalue(v->item[PACKET_ENTITY].u.map, sv);
put_number(&sv[1], oper);
type = psyc_getVarType(&name);
switch (type) {
case PSYC_TYPE_DATE: // number + PSYC_EPOCH
if (psyc_parseDate(&value, &timmy))
put_number(sv, timmy);
else
error = PSYC_PARSE_ERROR_DATE;
break;
case PSYC_TYPE_TIME: // number
if (psyc_parseTime(&value, &timmy))
put_number(sv, timmy);
else
error = PSYC_PARSE_ERROR_TIME;
break;
case PSYC_TYPE_AMOUNT: // number
if (psyc_parseNumber(&value, &n))
put_number(sv, n);
else
error = PSYC_PARSE_ERROR_AMOUNT;
break;
case PSYC_TYPE_DEGREE: // first digit
if (value.length && value.ptr[0] >= '0' && value.ptr[0] <= '9')
put_number(sv, value.ptr[0] - '0');
else
error = PSYC_PARSE_ERROR_DEGREE;
break;
case PSYC_TYPE_FLAG: // 0 or 1
if (value.length && value.ptr[0] >= '0' && value.ptr[0] <= '1')
put_number(sv, value.ptr[0] - '0');
else
error = PSYC_PARSE_ERROR_FLAG;
break;
case PSYC_TYPE_LIST: // array
size = 0;
if (value.length) {
psyc_initParseListState(&listState);
psyc_setParseListBuffer(&listState, value);
elem = (psycString){0, 0};
do {
retl = psyc_parseList(&listState, &elem);
switch (retl) {
case PSYC_PARSE_LIST_END:
retl = 0;
case PSYC_PARSE_LIST_ELEM:
if (size >= MAX_LIST_SIZE) {
error = PSYC_PARSE_ERROR_LIST_TOO_LARGE;
break;
}
elems[size++] = elem;
break;
default:
error = PSYC_PARSE_ERROR_LIST;
}
} while (retl > 0 && !error);
}
if (error) break;
list = allocate_array(size);
for (i = 0; i < size; i++)
put_string(&list->item[i], new_n_tabled(elems[i].ptr,
elems[i].length));
put_array(sv, list);
break;
default: // string
if (ret == PSYC_PARSE_ENTITY)
// is it good to put entity variable values into the
// shared string table? probably yes.. but it's a guess
//t_string(sv, new_n_mstring(value.ptr, value.length));
put_string(sv, new_n_tabled(value.ptr, value.length));
else // PSYC_PARSE_ENTITY_END
put_string(sv, state->value);
}
break;
case PSYC_PARSE_BODY_START:
case PSYC_PARSE_BODY_CONT:
break;
case PSYC_PARSE_BODY_END:
put_string(&v->item[PACKET_METHOD], make_tabled(state->name));
put_string(&v->item[PACKET_BODY], state->value);
break;
case PSYC_PARSE_BODY:
// new_n_tabled gets the shared string for the method
put_string(&v->item[PACKET_METHOD],
new_n_tabled(name.ptr, name.length));
// allocate an untabled string for the packet body
put_string(&v->item[PACKET_BODY],
new_n_mstring(value.ptr, value.length));
break;
case PSYC_PARSE_COMPLETE:
put_array(inter_sp, v);
sapply(psyc_dispatch_callback, current_object, 1);
state->packet = NULL;
break;
case PSYC_PARSE_INSUFFICIENT:
// insufficient data, save remaining bytes
state->remaining_len = psyc_getParseRemainingLength(state->parser);
if (state->remaining_len) {
state->remaining = pxalloc(state->remaining_len);
memcpy(state->remaining,
psyc_getParseRemainingBuffer(state->parser),
state->remaining_len);
} else
state->remaining = NULL;
ret = 0;
break;
default:
error = ret;
}
switch (ret) {
case PSYC_PARSE_BODY_END:
case PSYC_PARSE_ENTITY_END:
// reset tmp buffers in state when incomplete
// entity or body parsing is finished
state->oper = 0;
state->name = NULL;
state->value = NULL;
}
} while (ret && !error);
if (buffer)
pfree(buffer);
free_svalue(sp);
put_number(sp, error);
return sp;
} /* f_psyc_parse */
/*-------------------------------------------------------------------------*/
svalue_t *
f_wizlist_info (svalue_t *sp)
/* EFUN wizlist_info()
*
* mixed *wizlist_info()
*
* Returns an array with the interesting entries of the wizlist.
* Raises a privilege_violation (wizlist_info, this_object(), 0).
*
* The result is an array with one entry for every wizard (uid).
* Every entry is an array itself:
*
* string w[WL_NAME] = Name of the wizard.
* int w[WL_COMMANDS] = Weighted number of commands execute by objects
* of this wizard.
* int w[WL_COST] and w[WL_GIGACOST] = Weighted sum of eval_costs.
* int w[WL_TOTAL_COST] and w[WL_TOTAL_GIGACOST] = Total sum of
* eval_costs.
* int w[WL_HEART_BEATS] = Weighted count of heart_beats.
* int w[WL_CALL_OUT] = Reserved for call_out() (unused yet).
* int w[WL_ARRAY_TOTAL] = Total size of arrays in elements.
* int w[WL_MAPPING_TOTAL] = Total size of mappings in elements.
#ifdef USE_STRUCTS
* int w[WL_STRUCT_TOTAL] = Total size of mappings in elements.
#endif
* mixed w[WL_EXTRA] = Extra wizlist-info if set.
*/
{
vector_t *all, *entry;
svalue_t *wsvp, *svp;
wiz_list_t *w;
if (!privilege_violation(STR_WIZLIST_INFO, &const0, sp))
{
all = allocate_array(0);
}
else
{
all = allocate_array(number_of_wiz);
wsvp = all->item;
for (w = all_wiz; w; w = w->next)
{
entry = allocate_array(WL_SIZE);
put_array(wsvp, entry);
wsvp++;
svp = entry->item;
put_ref_string(&(svp[WL_NAME]), w->name);
put_number(&(svp[WL_COMMANDS]), w->score);
put_number(&(svp[WL_COST]), w->cost);
put_number(&(svp[WL_GIGACOST]), w->gigacost);
put_number(&(svp[WL_TOTAL_COST]), w->total_cost);
put_number(&(svp[WL_TOTAL_GIGACOST]), w->total_gigacost);
put_number(&(svp[WL_HEART_BEATS]), w->heart_beats);
put_number(&(svp[WL_CALL_OUT]), 0); /* TODO: Implement me */
put_number(&(svp[WL_ARRAY_TOTAL]), w->size_array);
put_number(&(svp[WL_MAPPING_TOTAL]), w->mapping_total);
#ifdef USE_STRUCTS
put_number(&(svp[WL_STRUCT_TOTAL]), w->struct_total);
#else
put_number(&(svp[WL_STRUCT_TOTAL]), 0);
#endif /* USE_STRUCTS */
if (w->extra.type == T_POINTER)
{
vector_t *v = w->extra.u.vec;
put_array(&(svp[WL_EXTRA]), slice_array(v, 0, VEC_SIZE(v) - 1));
}
else
assign_svalue_no_free(&(svp[WL_EXTRA]), &w->extra);
} /* end for */
} /* end if */
push_array(sp, all);
return sp;
} /* f_wizlist_info() */
void HASH_put_array(hash_t *hash, const char *key, const dynvec_t dynvec){
put_array(hash, key, 0, dynvec);
}
int main(int argc, char *argv[]) {
char endServer[100];
int fd,fdx, novofd,nbytes,j,fdmax;
struct sockaddr_in addr, client_addr, serverdei;
int client_addr_size;
struct hostent *hostPtr;
char buffer[BUF_SIZE];
int clientes_fd[MAX];// array com o fds dos clientes
if (argc != 4) {
printf("cliente <port> <nome servidor central> <Porto servidor central>\n");
exit(-1);
}
fd_set master; // descritor de arquivo mestre
fd_set ler_fds; // descritor de arquivo para temporario
FD_ZERO(&master); //limpa os conjuntos mestre e temporário
FD_ZERO(&ler_fds);
int yes=1;
bzero((void *) &addr, sizeof(addr));
addr.sin_family = AF_INET;
addr.sin_addr.s_addr = htonl(INADDR_ANY);
addr.sin_port = htons((short) atoi(argv[1]));
if ( (fd = socket(AF_INET, SOCK_STREAM, 0)) < 0)
erro("na funcao socket");
if (setsockopt(fd, SOL_SOCKET, SO_REUSEADDR, &yes, sizeof (int)) == -1) {
perror ("setsockopt");
exit (1);
}
if ( bind(fd,(struct sockaddr*)&addr,sizeof(addr)) < 0)
erro("na funcao bind");
if( listen(fd, MAX) < 0) //servidor a escuta de max clientes
erro("na funcao listen");
FD_SET(fd, &master);
clientes_fd[0]=fd;
fdmax=fd;
strcpy(endServer, argv[2]);
if ((hostPtr = gethostbyname(endServer)) != 0) {
bzero((void *) &addr, sizeof(addr));
serverdei.sin_family = AF_INET;
serverdei.sin_addr.s_addr = *((unsigned long*) hostPtr->h_addr_list[0]);
serverdei.sin_port = htons((short) atoi(argv[3]));
printf("entrei"); //sucesso
if((fdx = socket(AF_INET,SOCK_STREAM,0)) == -1)
erro("socket2");
printf("%s",hostPtr->h_addr);
if( connect(fdx,(struct sockaddr *)&serverdei,sizeof (serverdei))< 0) //liga ao servidor do dei
erro("Connect2");
FD_SET(fdx, &master);
clientes_fd[put_array(clientes_fd)]=fdx;
fdmax=fdx;
}
while(1){
ler_fds = master; // copia os master para o temporario
if (select (fdmax+1, &ler_fds, NULL, NULL, NULL)== -1) {
perror ("select");
exit(1);
}
int i;// percorre as conexões existentes em busca de dados
for ( i = 0; i <=fdmax; i++) {
if ( FD_ISSET ( i, &ler_fds)) {
if ( i == clientes_fd[0]) {
//trata novas conexões
client_addr_size = sizeof(client_addr);
if (( novofd = accept(fd,(struct sockaddr *)&client_addr, &client_addr_size)) == -1) {
perror ("accept");
} else {
FD_SET ( novofd , &master);//adiciona ao mestre
char print[150]="->";
char t[5];
strcat(print,"servidor : nova conexão de ");
strcat(print, inet_ntoa(client_addr.sin_addr));
strcat(print," no socket ");
sprintf(t, "%d", novofd);
strcat(print, t);
strcat(print, "\n");
for (j = 0; j<MAX; j++) {
//envia a todos os clientes
if (FD_ISSET (j, &master)) {
// exceto a nós e ao socket em escuta
if (j != fd &&j != novofd) {
if (write(j,print,strlen(print)) == -1) {
perror ("write");
}}}}
print[0]='\0';
if(fdmax<novofd){
fdmax=novofd;
novofd=0;
}
clientes_fd[put_array(clientes_fd)]=novofd;
}} else {
// cuida dos dados do cliente
if ( (nbytes=(read (i, buffer, BUF_SIZE-1)))>= 0) {
// recebeu erro ou a conexão foi fechada pelo cliente
if (nbytes == 0) {
char printR[150]="->";
char p[5];
strcat(printR,"servidor : o Cliente foi desligado ");
strcat(printR, inet_ntoa(client_addr.sin_addr));
strcat(printR," no socket ");
sprintf(p, "%d", i);
strcat(printR, p);
strcat(printR, "\n");
for (j = 0; j<MAX; j++) {
//envia a todos os clientes
if (FD_ISSET (j, &master)) {
// exceto a nós e ao socket em escuta
if (j != fd &&j != novofd) {
if (write(j,printR,strlen(printR)) == -1) {
perror ("write");
}}}}
printR[0]='\0';
FD_CLR( i , &master); // remove do conjunto mestre
search(clientes_fd, i);
} else if(nbytes==-1) {
perror ("read");
}
}
strcat(buffer, "\n");
// temos alguns dados do cliente
for (j = 0; j<MAX; j++) {
//envia a todos os clientes
if (FD_ISSET (j, &master)) {
// exceto a nós e ao socket em escuta
if (j != fd &&j!=i ) {
if (write(j,buffer,nbytes) == -1) {
perror ("write");
}
}
}
}
}
}
}
}
return 0;
}
/*-------------------------------------------------------------------------*/
static svalue_t *
insert_alist (svalue_t *key, svalue_t * /* TODO: bool */ key_data, vector_t *list)
/* Implementation of efun insert_alist()
*
* The function can be used in two ways:
*
* 1. Insert/replace a (new) <key>:<keydata> tuple into the alist <list>.
* <key> and <key_data> have to point to an array of svalues. The first
* element is the key value, the following values the associated
* data values. The function will read as many elements from the
* array as necessary to fill the alist <list>.
* Result is a fresh copy of the modified alist.
*
* 2. Lookup a <key> in the alist <list> and return its index. If the key
* is not found, return the position at which it would be inserted.
* <key_data> must be NULL, <key> points to the svalue to be looked
* up, and <list> points to an alist with at least the key vector.
*
* If <list> is no alist, the result can be wrong (case 2.) or not
* an alist either (case 1.).
*
* If the <key> is a string, it is made shared.
*
* TODO: Make the hidden flag 'key_data' a real flag.
*/
{
static svalue_t stmp; /* Result value */
mp_int i,j,ix;
mp_int keynum, list_size; /* Number of keys, number of alist vectors */
int new_member; /* Flag if a new tuple is given */
/* If key is a string, make it shared */
if (key->type == T_STRING && !mstr_tabled(key->u.str))
{
key->u.str = make_tabled(key->u.str);
}
keynum = (mp_int)VEC_SIZE(list->item[0].u.vec);
/* Locate the key */
ix = lookup_key(key, list->item[0].u.vec);
/* If its just a lookup: return the result.
*/
if (key_data == NULL) {
put_number(&stmp, ix < 0 ? -ix-1 : ix);
return &stmp;
}
/* Prepare the result alist vector */
put_array(&stmp, allocate_array(list_size = (mp_int)VEC_SIZE(list)));
new_member = ix < 0;
if (new_member)
ix = -ix-1;
/* Loop over all key/data vectors in <list>, insert/replace the
* new value and put the new vector into <stmp>.
*/
for (i = 0; i < list_size; i++) {
vector_t *vtmp;
if (new_member) {
svalue_t *pstmp = list->item[i].u.vec->item;
vtmp = allocate_array(keynum+1);
for (j=0; j < ix; j++) {
assign_svalue_no_free(&vtmp->item[j], pstmp++);
}
assign_svalue_no_free(&vtmp->item[ix], i ? &key_data[i] : key );
for (j = ix+1; j <= keynum; j++) {
assign_svalue_no_free(&vtmp->item[j], pstmp++);
}
} else {
vtmp = slice_array(list->item[i].u.vec, 0, keynum-1);
if (i)
assign_svalue(&vtmp->item[ix], &key_data[i]);
/* No need to assign the key value: it's already there. */
}
stmp.u.vec->item[i].type=T_POINTER;
stmp.u.vec->item[i].u.vec=vtmp;
}
/* Done */
return &stmp;
} /* insert_alist() */
/*-------------------------------------------------------------------------*/
vector_t *
order_alist (svalue_t *inlists, int listnum, Bool reuse)
/* Order the alist <inlists> and return a new vector with it. The sorting
* order is the internal order defined by alist_cmp().
*
* <inlists> is a vector of <listnum> vectors:
* <inlists> = ({ ({ keys }), ({ data1 }), ..., ({ data<listnum-1> }) })
*
* If <reuse> is true, the vectors of <inlists> are reused for the
* vectors of the result when possible, and their entries in <inlists> are
* set to T_INVALID.
*
* As a side effect, strings in the key vector are made shared, and
* destructed objects in key and data vectors are replaced by svalue 0s.
*
* This function is also called by the compiler for constant expressions.
*/
{
vector_t *outlist; /* The result vector of vectors */
vector_t *v; /* Aux vector pointer */
svalue_t *outlists; /* Next element in outlist to fill in */
ptrdiff_t * sorted; /* The vector elements in sorted order */
svalue_t *inpnt; /* Pointer to the value to copy into the result */
mp_int keynum; /* Number of keys */
int i, j;
keynum = (mp_int)VEC_SIZE(inlists[0].u.vec);
/* Get the sorting order */
sorted = get_array_order(inlists[0].u.vec);
/* Generate the result vectors from the sorting order.
*/
outlist = allocate_array(listnum);
outlists = outlist->item;
/* Copy the elements from all inlist vectors into the outlist
* vectors.
*
* At the beginning of every loop v points to the vector to
* use as the next 'out' vector. It may be a re-used 'in' vector
* from the previous run.
*/
v = allocate_array(keynum);
for (i = listnum; --i >= 0; ) {
svalue_t *outpnt; /* Next result value element to fill in */
/* Set the new array v as the next 'out' vector, and init outpnt
* and offs.
*/
put_array(outlists + i, v);
outpnt = v->item;
v = inlists[i].u.vec; /* Next vector to fill if reusable */
/* Copy the elements.
* For a reusable 'in' vector, a simple memory copy is sufficient.
* For a new vector, a full assignment is due to keep the refcounters
* happy.
*/
if (reuse && inlists[i].u.vec->ref == 1) {
if (i) /* not the last iteration */
inlists[i].type = T_INVALID;
for (j = keynum; --j >= 0; ) {
inpnt = inlists[i].u.vec->item + sorted[j];
if (destructed_object_ref(inpnt))
{
free_svalue(inpnt);
put_number(outpnt, 0);
outpnt++;
} else {
*outpnt++ = *inpnt;
}
inpnt->type = T_INVALID;
}
} else {
if (i) /* Not the last iteration: get new out-vector */
v = allocate_array(keynum);
for (j = keynum; --j >= 0; ) {
inpnt = inlists[i].u.vec->item + sorted[j];
if (destructed_object_ref(inpnt))
{
put_number(outpnt, 0);
outpnt++;
} else {
assign_svalue_no_free(outpnt++, inpnt);
}
}
} /* if (reuse) */
} /* for (listnum) */
xfree(sorted);
return outlist;
} /* order_alist() */
/*-------------------------------------------------------------------------*/
svalue_t *
v_order_alist (svalue_t *sp, int num_arg)
/* EFUN order_alist()
*
* mixed *order_alist(mixed *keys, mixed *|void data, ...)
*
* Creates an alist.
*
* Either takes an array containing keys, and others containing
* the associated data, where all arrays are to be of the same
* length, or takes a single array that contains as first member
* the array of keys and has an arbitrary number of other members
* containing data, each of wich has to be of the same length as
* the key array. Returns an array holding the sorted key array
* and the data arrays; the same permutation that is applied to
* the key array is applied to all data arrays.
*/
{
int i;
svalue_t *args;
vector_t *list;
long listsize;
Bool reuse;
size_t keynum;
args = sp-num_arg+1;
/* Get the key array to order */
if (num_arg == 1
&& ((list = args->u.vec), (listsize = (long)VEC_SIZE(list)))
&& list->item[0].type == T_POINTER)
{
args = list->item;
reuse = (list->ref == 1);
}
else
{
listsize = num_arg;
reuse = MY_TRUE;
}
keynum = VEC_SIZE(args[0].u.vec);
/* Get the data arrays to order */
for (i = 0; i < listsize; i++)
{
if (args[i].type != T_POINTER
|| (size_t)VEC_SIZE(args[i].u.vec) != keynum)
{
errorf("bad data array %d in call to order_alist\n",i);
}
}
/* Create the alist */
list = order_alist(args, listsize, reuse);
sp = pop_n_elems(num_arg, sp);
sp++;
put_array(sp, list);
return sp;
} /* v_order_alist() */
void HASH_put_array_at(hash_t *hash, const char *key, int i, const dynvec_t val){
put_array(hash, key, i, val);
int new_size = i+1;
if(new_size>hash->num_array_elements)
hash->num_array_elements = new_size;
}
/*-------------------------------------------------------------------------*/
wiz_list_t *
add_name (string_t * str)
/* Check if an entry for wizard <str> exists; add it, if it doesn't.
* Return the pointer to the wiz_list entry.
* Must not change refcount of <str>.
*/
{
wiz_list_t *wl;
wiz_list_t *prev, *this;
wl = find_wiz(str);
if (wl)
return wl;
number_of_wiz++;
wl = xalloc(sizeof (wiz_list_t));
str = make_tabled_from(str);
wl->next = NULL;
wl->name = str;
wl->score = 0;
wl->cost = 0;
wl->gigacost = 0;
wl->total_cost = 0;
wl->total_gigacost = 0;
wl->heart_beats = 0;
wl->size_array = 0;
wl->mapping_total = 0;
#ifdef USE_STRUCTS
wl->struct_total = 0;
#endif /* USE_STRUCTS */
#if 0
wl->quota_allowance = 0;
wl->quota_usage = 0;
#endif
wl->file_name = NULL;
wl->error_message = NULL;
if (wiz_info_extra_size >= 0)
put_array(&(wl->extra), allocate_array(wiz_info_extra_size));
else
wl->extra = const0;
wl->last_call_out = 0;
/* Find the insertion point and insert the new entry */
for ( prev = NULL, this = all_wiz
; this && mstrcmp(this->name, str) < 0
; prev = this, this = this->next
)
{ NOOP; }
if (!prev)
{
wl->next = all_wiz;
all_wiz = wl;
}
else
{
wl->next = this;
prev->next = wl;
}
return wl;
} /* add_name() */