/*
;@cc_solv(a, b, n)
;@ Solve a general linear system A*x = b.
;
; int solv(double a[],double b[],int n)
;
; a = array containing system matrix A in row order
; (altered to L-U factored form by computation)
;
; b = array containing system vector b at entry and
; solution vector x at exit
;
; n = dimension of system
;@
;@
*/
static LISP cc_solv1(LISP a1, LISP a2, LISP b1, LISP b2)
{
int row, col, sheet;
buffer *buf;
int ax1 = get_c_long(CAR(a1)), ay1 = get_c_long(CDR(a1));
int ax2 = get_c_long(CAR(a2)), ay2 = get_c_long(CDR(a2));
int bx1 = get_c_long(CAR(b1)), by1 = get_c_long(CDR(b1));
int bx2 = get_c_long(CDR(b2)), by2 = get_c_long(CDR(b2));
int n = by2-by1+1;
double *a = fetch_array(ax1, ay1, ax2, ay2);
double *b = fetch_array(bx1, by1, bx2, by2);
if (a == NULL || b == NULL || solv(a, b, n) == 0) return NIL;
get_siod_coords(&row, &col, &sheet, &buf);
store_array(row, col, row+n-1, col, b);
return flocons(b[0]);
}
static nialptr
tree_to_array(struct node * root)
{
nialptr newnode;
nialptr children;
int len = 4;
/* create a 5 cell array to hold the node information */
newnode = new_create_array(atype, 1, 0, &len);
/* fill in op name */
if (root->opid == 0) {
store_array(newnode, 0, makephrase("TOPLEVEL"));
}
/* block req'd */
else
store_array(newnode, 0, makephrase(num_to_name(root->opid)));
/* fill in number of calls */
store_array(newnode, 1, createint(root->total_calls));
/* fill in total time */
store_array(newnode, 2, createreal(root->total_time));
/* create array for the children and store it in the last cell */
if (root->num_children > 0) {
int i;
len = root->num_children;
children = new_create_array(atype, 1, 0, &len);
store_array(newnode, 3, children);
/* for each child, call tree_to_array recursively to fill in */
/* each child cell create above */
for (i = 0; i < len; i++) {
store_array(children, i, tree_to_array(root->children[i]));
}
}
else {
store_array(newnode, 3, Null);
}
return (newnode);
}
static apr_status_t store_headers(cache_handle_t *h, request_rec *r, cache_info *info)
{
disk_cache_conf *conf = ap_get_module_config(r->server->module_config,
&disk_cache_module);
apr_status_t rv;
apr_size_t amt;
disk_cache_object_t *dobj = (disk_cache_object_t*) h->cache_obj->vobj;
disk_cache_info_t disk_info;
struct iovec iov[2];
/* This is flaky... we need to manage the cache_info differently */
h->cache_obj->info = *info;
if (r->headers_out) {
const char *tmp;
tmp = apr_table_get(r->headers_out, "Vary");
if (tmp) {
apr_array_header_t* varray;
apr_uint32_t format = VARY_FORMAT_VERSION;
/* If we were initially opened as a vary format, rollback
* that internal state for the moment so we can recreate the
* vary format hints in the appropriate directory.
*/
if (dobj->prefix) {
dobj->hdrsfile = dobj->prefix;
dobj->prefix = NULL;
}
mkdir_structure(conf, dobj->hdrsfile, r->pool);
rv = apr_file_mktemp(&dobj->tfd, dobj->tempfile,
APR_CREATE | APR_WRITE | APR_BINARY | APR_EXCL,
r->pool);
if (rv != APR_SUCCESS) {
return rv;
}
amt = sizeof(format);
apr_file_write(dobj->tfd, &format, &amt);
amt = sizeof(info->expire);
apr_file_write(dobj->tfd, &info->expire, &amt);
varray = apr_array_make(r->pool, 6, sizeof(char*));
tokens_to_array(r->pool, tmp, varray);
store_array(dobj->tfd, varray);
apr_file_close(dobj->tfd);
dobj->tfd = NULL;
rv = safe_file_rename(conf, dobj->tempfile, dobj->hdrsfile,
r->pool);
if (rv != APR_SUCCESS) {
ap_log_error(APLOG_MARK, APLOG_WARNING, rv, r->server,
"disk_cache: rename tempfile to varyfile failed: %s -> %s",
dobj->tempfile, dobj->hdrsfile);
apr_file_remove(dobj->tempfile, r->pool);
return rv;
}
dobj->tempfile = apr_pstrcat(r->pool, conf->cache_root, AP_TEMPFILE, NULL);
tmp = regen_key(r->pool, r->headers_in, varray, dobj->name);
dobj->prefix = dobj->hdrsfile;
dobj->hashfile = NULL;
dobj->datafile = data_file(r->pool, conf, dobj, tmp);
dobj->hdrsfile = header_file(r->pool, conf, dobj, tmp);
}
}
rv = apr_file_mktemp(&dobj->hfd, dobj->tempfile,
APR_CREATE | APR_WRITE | APR_BINARY |
APR_BUFFERED | APR_EXCL, r->pool);
if (rv != APR_SUCCESS) {
return rv;
}
disk_info.format = DISK_FORMAT_VERSION;
disk_info.date = info->date;
disk_info.expire = info->expire;
disk_info.entity_version = dobj->disk_info.entity_version++;
disk_info.request_time = info->request_time;
disk_info.response_time = info->response_time;
disk_info.status = info->status;
disk_info.name_len = strlen(dobj->name);
iov[0].iov_base = (void*)&disk_info;
iov[0].iov_len = sizeof(disk_cache_info_t);
iov[1].iov_base = (void*)dobj->name;
iov[1].iov_len = disk_info.name_len;
rv = apr_file_writev(dobj->hfd, (const struct iovec *) &iov, 2, &amt);
if (rv != APR_SUCCESS) {
return rv;
}
if (r->headers_out) {
apr_table_t *headers_out;
headers_out = ap_cache_cacheable_hdrs_out(r->pool, r->headers_out,
r->server);
if (!apr_table_get(headers_out, "Content-Type")
&& r->content_type) {
apr_table_setn(headers_out, "Content-Type",
ap_make_content_type(r, r->content_type));
}
headers_out = apr_table_overlay(r->pool, headers_out,
r->err_headers_out);
rv = store_table(dobj->hfd, headers_out);
if (rv != APR_SUCCESS) {
return rv;
}
}
/* Parse the vary header and dump those fields from the headers_in. */
/* FIXME: Make call to the same thing cache_select calls to crack Vary. */
if (r->headers_in) {
apr_table_t *headers_in;
headers_in = ap_cache_cacheable_hdrs_out(r->pool, r->headers_in,
r->server);
rv = store_table(dobj->hfd, headers_in);
if (rv != APR_SUCCESS) {
return rv;
}
}
apr_file_close(dobj->hfd); /* flush and close */
/* Remove old file with the same name. If remove fails, then
* perhaps we need to create the directory tree where we are
* about to write the new headers file.
*/
rv = apr_file_remove(dobj->hdrsfile, r->pool);
if (rv != APR_SUCCESS) {
mkdir_structure(conf, dobj->hdrsfile, r->pool);
}
rv = safe_file_rename(conf, dobj->tempfile, dobj->hdrsfile, r->pool);
if (rv != APR_SUCCESS) {
ap_log_error(APLOG_MARK, APLOG_WARNING, rv, r->server,
"disk_cache: rename tempfile to hdrsfile failed: %s -> %s",
dobj->tempfile, dobj->hdrsfile);
apr_file_remove(dobj->tempfile, r->pool);
return rv;
}
dobj->tempfile = apr_pstrcat(r->pool, conf->cache_root, AP_TEMPFILE, NULL);
ap_log_error(APLOG_MARK, APLOG_DEBUG, 0, r->server,
"disk_cache: Stored headers for URL %s", dobj->name);
return APR_SUCCESS;
}
void
iprofiletable()
{
nialptr result; /* result to be returned */
int c1,
c2;
int num_funs = 0; /* total number of used functions */
int pos = 0; /* current count of used fucntions */
if (newprofile) {
buildfault("no profile available");
return;
}
#ifndef OLD_BUILD_SYMBOL_TABLE
if (symtab)
free_symtab();
symtab = NULL;
build_symbol_table();
#endif
/* If profiling is still on, then turn it off */
if (profile == true) {
apush(createbool(0));
isetprofile();
apop();
}
/* traverse the call tree placing nodes in the symbol table entries */
if (!traversed) {
traverse_tree(calltree);
traversed = true;
}
/* count the number of called functions so we know how big to
make the container array. Funcitons in the symbol table that
are not called at all are excluded */
for (c1 = 0; c1 < symtabsize; c1++)
if ((symtab[c1]->num_locs > 0) || (symtab[c1]->num_rcalls > 0))
num_funs++;
/* create the outer most container to hold the table */
result = new_create_array(atype, 1, 0, &num_funs);
for (c1 = 0; c1 < symtabsize; c1++) {
if ((symtab[c1]->num_locs > 0) || (symtab[c1]->num_rcalls > 0)) {
double totaloptime = 0;
int totalopcalls = 0;
int totalropcalls;
int len = 5;
/* create the table entry */
nialptr table_entry = new_create_array(atype, 1, 0, &len);
/* store it in the outer table */
store_array(result, pos, table_entry);
for (c2 = 0; c2 < symtab[c1]->num_locs; c2++) {
if (symtab[c1]->id != symtab[c1]->locations[c2]->parent->opid)
/* omit adding calls and time for direct recursions */
{
totaloptime += symtab[c1]->locations[c2]->total_time;
totalopcalls += symtab[c1]->locations[c2]->total_calls;
}
}
totalropcalls = symtab[c1]->num_rcalls;
/* fill in the cells in the table entry */
store_array(table_entry, 0, makephrase(symtab[c1]->name));
store_array(table_entry, 1, createint(totalopcalls));
store_array(table_entry, 2, createint(totalropcalls));
store_array(table_entry, 3, createreal(totaloptime));
{
struct node **chlist;
nialptr child_array;
int c,
used,
cpos = 0;
int children = 0;
chlist = merge_children(symtab[c1], &used);
for (c = 0; c < used; c++)
if (chlist[c]->opid != symtab[c1]->id) /* recursions only counted */
children++;
child_array = new_create_array(atype, 1, 0, &children);
store_array(table_entry, 4, child_array);
for (c = 0; c < used; c++) {
nialptr child_entry;
int len = 5;
if (chlist[c]->opid == symtab[c1]->id) /* recursions only counted */
break;
/* create each child entry and place it in the child list */
child_entry = new_create_array(atype, 1, 0, &len);
store_array(child_array, cpos, child_entry);
/* fill in the information about the child entry */
store_array(child_entry, 0, makephrase(num_to_name(chlist[c]->opid)));
store_array(child_entry, 1, createint(chlist[c]->total_calls));
store_array(child_entry, 2, createint(0));
store_array(child_entry, 3, createreal(chlist[c]->total_time));
store_array(child_entry, 4, Null);
cpos++;
}
free_merge_list(chlist, used);
}
}
pos++;
}
apush(result);
}
