/* ;@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); }