int main(void)
{
std::vector<Complex> v;
// Citeste date de test.
v = read_data(".date.in");
std::cout << "Vectorul initial" << std::endl;
write_vector(v);
// Verifica sortarea.
std::vector<Complex> sorted = get_sorted(v);
std::cout << "Vectorul sortat" << std::endl;
write_vector(sorted);
// Verifica maparea.
std::cout << "Maparea" << std::endl;
std::map<Complex, int> mapping = get_mapping(v);
for (unsigned int i = 0; i < sorted.size(); i++)
{
std::cout << sorted[i] << " e pe pozitia "
<< mapping[sorted[i]] << std::endl;
}
return 0;
}
void indexed_force_tri_3D::save(std::ofstream& out)
{
// write the label string
write_label(out, label);
// write the point cloud indices for each vertex
for (int t=0; t<3; t++)
write_int(out, p[t]);
// write the target index
write_int(out, ds_index);
// write the index list - first the length
write_int(out, grid_indices.size());
// now write all the indices
for (std::list<grid_index>::iterator it=grid_indices.begin();
it!=grid_indices.end(); it++)
{
write_int(out, it->i);
write_int(out, it->j);
write_vector(out, it->cart_coord);
}
// write the point and edge adjacency list
for (int a=0; a<2; a++)
{
write_int(out, adjacency[a].size());
for (LABEL_STORE::iterator it=adjacency[a].begin();
it!= adjacency[a].end(); it++)
write_label(out, *it);
}
}
void fsBinaryStream::encode_message(std::string &msg_out, const fsMsgRig &msg) {
Size start = msg_out.size();
BlockHeader header(msg.id());
write_pod(msg_out, header);
write_vector(msg_out, msg.mesh().m_quads); // write quads
write_vector(msg_out, msg.mesh().m_tris);// write triangles
write_vector(msg_out, msg.mesh().m_vertex_data.m_vertices);// write neutral vertices
write_small_vector(msg_out, msg.blendshape_names());// write names
write_pod(msg_out,uint16_t(msg.blendshapes().size()));
for(uint16_t i = 0;i < uint16_t(msg.blendshapes().size()); i++)
write_vector(msg_out, msg.blendshapes()[i].m_vertices); // write blendshapes
update_msg_size(msg_out, start);
}
void write_matrix(double *a, int n, int m)
{
int j;
for (j=0; j<n; j++) {
write_vector(a+j*m, m);
}
}
void write_vector(const T & v){
write_vector(v, v.begin());
/*
write<size_t>(v.size());
for(size_t i = 0; i < v.size(); i++){
write<typename T::value_type>(v[i]);
}
*/
}
void
dm_write (FILE *lp, FILE *ap, double *lambda, double **alpha,
int nmixtures, int nlex)
{
printf("writing model..\n"); fflush(stdout);
write_vector(lp, lambda, nmixtures);
write_matrix_transposed(ap, alpha, nmixtures, nlex);
printf("done.\n"); fflush(stdout);
}
void write_value(scanner& sc, writer& wr, const value& val) {
switch (val.type()) {
case value_type::number_type: {
read_value(sc);
wr.append(stringize_number(val.number_value()));
break;
}
case value_type::string_type: {
read_value(sc);
wr.append("\"");
wr.append(escape_string(val.string_value()));
wr.append("\"");
break;
}
case value_type::bool_type: {
read_value(sc);
wr.append(val.bool_value() ? "true" : "false");
break;
}
case value_type::group_type: {
if (sc.peek_token().is_char('{')) {
write_group(sc, wr, true, val.group_value());
} else {
read_value(sc);
scanner dummy_scanner = make_scanner("{}");
write_group(dummy_scanner, wr, true, val.group_value());
}
break;
}
case value_type::vector_type: {
if (sc.peek_token().is_char('[')) {
write_vector(sc, wr, val.vector_value());
} else {
read_value(sc);
scanner dummy_scanner = make_scanner("[]");
write_vector(dummy_scanner, wr, val.vector_value());
}
break;
}
default: {
break;
}
}
}
static void write_field(FILE *f, const save_field_t *field, void *base)
{
void *p = (byte *)base + field->ofs;
int i;
switch (field->type) {
case F_BYTE:
write_data(p, field->size, f);
break;
case F_SHORT:
for (i = 0; i < field->size; i++) {
write_short(f, ((short *)p)[i]);
}
break;
case F_INT:
for (i = 0; i < field->size; i++) {
write_int(f, ((int *)p)[i]);
}
break;
case F_FLOAT:
for (i = 0; i < field->size; i++) {
write_float(f, ((float *)p)[i]);
}
break;
case F_VECTOR:
write_vector(f, (vec_t *)p);
break;
case F_ZSTRING:
write_string(f, (char *)p);
break;
case F_LSTRING:
write_string(f, *(char **)p);
break;
case F_EDICT:
write_index(f, *(void **)p, sizeof(edict_t), g_edicts, MAX_EDICTS - 1);
break;
case F_CLIENT:
write_index(f, *(void **)p, sizeof(gclient_t), game.clients, game.maxclients - 1);
break;
case F_ITEM:
write_index(f, *(void **)p, sizeof(gitem_t), itemlist, game.num_items - 1);
break;
case F_POINTER:
write_pointer(f, *(void **)p, field->size);
break;
default:
gi.error("%s: unknown field type", __func__);
}
}
void encode(FILE *from, FILE *to) {
char *buffer = reserve(sizeof(char) * 80);
size_t len = 0;
int can_write = false;
BITVEC *vector = initialise_bit_vector();
long count = 0;
while (getline(&buffer, &len, from) != -1) {
long i = strtoul(buffer, NULL, 10);
if (i == -1) {
if (can_write) {
write_vector(to, vector);
} else {
can_write = true;
}
} else {
add_encoding_for(vector, i + 1);
}
count++;
}
write_vector(to, vector);
log_info("read %lu lines", count);
}
int main (int, char *[])
{
int nCount = 1;
while(true)
{
//server ();
write_vector(nCount);
printf("server time:%d, ACE_OS::sleep (2);\n", nCount++);
ACE_OS::sleep (2);
}
shm_allocator.remove();
return 0;
}
int main(int argc, char** args)
{
if (argc < 2) {
std::cerr<<"Not enouht parameters"<<std::endl;
exit(-1);
}
unsigned size = argc - 2;
std::vector<Int> v;
v.reserve(size);
for (unsigned i = 2; i < argc; ++i)
v.push_back(atoi(args[i]));
write_vector(v, args[1]);
}
void OBJMeshFileWriter::write_vertices(const IMeshWalker& walker) const
{
const size_t vertex_count = walker.get_vertex_count();
fprintf(
m_file,
"# %s %s.\n",
pretty_int(vertex_count).c_str(),
plural(vertex_count, "vertex", "vertices").c_str());
for (size_t i = 0; i < vertex_count; ++i)
{
const Vector3d v = walker.get_vertex(i);
write_vector("v", v);
}
}
int main(int argc, char *argv[])
{
struct sparse_matrix_t *sparseA;
struct vector_t *d; /* density */
int c;
double accu;
struct sparse_item_t *item;
/* cmd line arg */
char *matrix_filename = NULL;
char *sol_filename = NULL;
if (argc != 3) {
fprintf(stderr, "%s matrixfile kernel_density_file\n", argv[0]);
exit(1);
}
matrix_filename = strdup(argv[1]);
sol_filename = strdup(argv[2]);
/* read the sparse matrix */
sparseA = read_ijk_sparse_matrix(matrix_filename, SPARSE_COL_LINK);
fprintf(stderr, "read*matrix: ok (size=%ldx%ld, %ld elements)\n",
sparseA->nb_line, sparseA->nb_col,
sparseA->nb_line * sparseA->nb_col);
show_sparse_stats(sparseA);
/* allocation */
d = new_vector(sparseA->nb_col);
fprintf(stderr, "Starting kernel density computation ...\n");
for (c = 0; c < sparseA->nb_col; c++) {
item = sparseA->col[c];
accu = 0.;
while (item) {
accu = accu + item->val;
item = item->next_in_col;
}
d->mat[c] = accu;
}
write_vector((struct vector_t *) d, sol_filename);
free_sparse_matrix(sparseA);
/* free b, rhs */
return (1);
}
void OBJMeshFileWriter::write_vertex_normals(const IMeshWalker& walker) const
{
const size_t vertex_normal_count = walker.get_vertex_normal_count();
if (vertex_normal_count == 0)
return;
fprintf(
m_file,
"# %s %s.\n",
pretty_int(vertex_normal_count).c_str(),
plural(vertex_normal_count, "vertex normal").c_str());
for (size_t i = 0; i < vertex_normal_count; ++i)
{
const Vector3d vn = walker.get_vertex_normal(i);
write_vector("vn", vn);
}
}
void OBJMeshFileWriter::write_texture_coordinates(const IMeshWalker& walker) const
{
const size_t tex_coords_count = walker.get_tex_coords_count();
if (tex_coords_count == 0)
return;
fprintf(
m_file,
"# %s %s.\n",
pretty_int(tex_coords_count).c_str(),
plural(tex_coords_count, "texture coordinate").c_str());
for (size_t i = 0; i < tex_coords_count; ++i)
{
const Vector2d vt = walker.get_tex_coords(i);
write_vector("vt", vt);
}
}
int
driver(const Box& global_box, Box& my_box,
Parameters& params, YAML_Doc& ydoc)
{
int global_nx = global_box[0][1];
int global_ny = global_box[1][1];
int global_nz = global_box[2][1];
int numprocs = 1, myproc = 0;
#ifdef HAVE_MPI
MPI_Comm_size(MPI_COMM_WORLD, &numprocs);
MPI_Comm_rank(MPI_COMM_WORLD, &myproc);
#endif
if (params.load_imbalance > 0) {
add_imbalance<GlobalOrdinal>(global_box, my_box, params.load_imbalance, ydoc);
}
float largest_imbalance = 0, std_dev = 0;
compute_imbalance<GlobalOrdinal>(global_box, my_box, largest_imbalance,
std_dev, ydoc, true);
//Create a representation of the mesh:
//Note that 'simple_mesh_description' is a virtual or conceptual
//mesh that doesn't actually store mesh data.
#ifdef TIME_IT
if (myproc==0) {
std::cout.width(30);
std::cout << "creating/filling mesh...";
std::cout.flush();
}
#endif
timer_type t_start = mytimer();
timer_type t0 = mytimer();
simple_mesh_description<GlobalOrdinal> mesh(global_box, my_box);
timer_type mesh_fill = mytimer() - t0;
timer_type t_total = mytimer() - t_start;
#ifdef TIME_IT
if (myproc==0) {
std::cout << mesh_fill << "s, total time: " << t_total << std::endl;
}
#endif
//next we will generate the matrix structure.
//Declare matrix object:
#if defined(MINIFE_ELL_MATRIX)
typedef ELLMatrix<Scalar,LocalOrdinal,GlobalOrdinal> MatrixType;
#else
typedef CSRMatrix<Scalar,LocalOrdinal,GlobalOrdinal> MatrixType;
#endif
MatrixType A;
timer_type gen_structure;
RUN_TIMED_FUNCTION("generating matrix structure...",
generate_matrix_structure(mesh, A),
gen_structure, t_total);
GlobalOrdinal local_nrows = A.rows.size();
GlobalOrdinal my_first_row = local_nrows > 0 ? A.rows[0] : -1;
Vector<Scalar,LocalOrdinal,GlobalOrdinal> b(my_first_row, local_nrows);
Vector<Scalar,LocalOrdinal,GlobalOrdinal> x(my_first_row, local_nrows);
//Assemble finite-element sub-matrices and sub-vectors into the global
//linear system:
timer_type fe_assembly;
RUN_TIMED_FUNCTION("assembling FE data...",
assemble_FE_data(mesh, A, b, params),
fe_assembly, t_total);
if (myproc == 0) {
ydoc.add("Matrix structure generation","");
ydoc.get("Matrix structure generation")->add("Mat-struc-gen Time",gen_structure);
ydoc.add("FE assembly","");
ydoc.get("FE assembly")->add("FE assembly Time",fe_assembly);
}
#ifdef MINIFE_DEBUG
write_matrix("A_prebc.mtx", A);
write_vector("b_prebc.vec", b);
#endif
//Now apply dirichlet boundary-conditions
//(Apply the 0-valued surfaces first, then the 1-valued surface last.)
timer_type dirbc_time;
RUN_TIMED_FUNCTION("imposing Dirichlet BC...",
impose_dirichlet(0.0, A, b, global_nx+1, global_ny+1, global_nz+1, mesh.bc_rows_0), dirbc_time, t_total);
RUN_TIMED_FUNCTION("imposing Dirichlet BC...",
impose_dirichlet(1.0, A, b, global_nx+1, global_ny+1, global_nz+1, mesh.bc_rows_1), dirbc_time, t_total);
#ifdef MINIFE_DEBUG
write_matrix("A.mtx", A);
write_vector("b.vec", b);
#endif
//Transform global indices to local, set up communication information:
timer_type make_local_time;
RUN_TIMED_FUNCTION("making matrix indices local...",
make_local_matrix(A),
make_local_time, t_total);
#ifdef MINIFE_DEBUG
write_matrix("A_local.mtx", A);
write_vector("b_local.vec", b);
#endif
size_t global_nnz = compute_matrix_stats(A, myproc, numprocs, ydoc);
//Prepare to perform conjugate gradient solve:
LocalOrdinal max_iters = 200;
LocalOrdinal num_iters = 0;
typedef typename TypeTraits<Scalar>::magnitude_type magnitude;
magnitude rnorm = 0;
magnitude tol = std::numeric_limits<magnitude>::epsilon();
timer_type cg_times[NUM_TIMERS];
typedef Vector<Scalar,LocalOrdinal,GlobalOrdinal> VectorType;
t_total = mytimer() - t_start;
bool matvec_with_comm_overlap = params.mv_overlap_comm_comp==1;
int verify_result = 0;
#if MINIFE_KERNELS != 0
if (myproc==0) {
std::cout.width(30);
std::cout << "Starting kernel timing loops ..." << std::endl;
}
max_iters = 500;
x.coefs[0] = 0.9;
if (matvec_with_comm_overlap) {
time_kernels(A, b, x, matvec_overlap<MatrixType,VectorType>(), max_iters, rnorm, cg_times);
}
else {
time_kernels(A, b, x, matvec_std<MatrixType,VectorType>(), max_iters, rnorm, cg_times);
}
num_iters = max_iters;
std::string title("Kernel timings");
#else
if (myproc==0) {
std::cout << "Starting CG solver ... " << std::endl;
}
if (matvec_with_comm_overlap) {
#ifdef MINIFE_CSR_MATRIX
rearrange_matrix_local_external(A);
cg_solve(A, b, x, matvec_overlap<MatrixType,VectorType>(), max_iters, tol,
num_iters, rnorm, cg_times);
#else
std::cout << "ERROR, matvec with overlapping comm/comp only works with CSR matrix."<<std::endl;
#endif
}
else {
cg_solve(A, b, x, matvec_std<MatrixType,VectorType>(), max_iters, tol,
num_iters, rnorm, cg_times);
if (myproc == 0) {
std::cout << "Final Resid Norm: " << rnorm << std::endl;
}
if (params.verify_solution > 0) {
double tolerance = 0.06;
bool verify_whole_domain = false;
#ifdef MINIFE_DEBUG
verify_whole_domain = true;
#endif
if (myproc == 0) {
if (verify_whole_domain) std::cout << "verifying solution..." << std::endl;
else std::cout << "verifying solution at ~ (0.5, 0.5, 0.5) ..." << std::endl;
}
verify_result = verify_solution(mesh, x, tolerance, verify_whole_domain);
}
}
#ifdef MINIFE_DEBUG
write_vector("x.vec", x);
#endif
std::string title("CG solve");
#endif
if (myproc == 0) {
ydoc.get("Global Run Parameters")->add("ScalarType",TypeTraits<Scalar>::name());
ydoc.get("Global Run Parameters")->add("GlobalOrdinalType",TypeTraits<GlobalOrdinal>::name());
ydoc.get("Global Run Parameters")->add("LocalOrdinalType",TypeTraits<LocalOrdinal>::name());
ydoc.add(title,"");
ydoc.get(title)->add("Iterations",num_iters);
ydoc.get(title)->add("Final Resid Norm",rnorm);
GlobalOrdinal global_nrows = global_nx;
global_nrows *= global_ny*global_nz;
//flops-per-mv, flops-per-dot, flops-per-waxpy:
double mv_flops = global_nnz*2.0;
double dot_flops = global_nrows*2.0;
double waxpy_flops = global_nrows*3.0;
#if MINIFE_KERNELS == 0
//if MINIFE_KERNELS == 0 then we did a CG solve, and in that case
//there were num_iters+1 matvecs, num_iters*2 dots, and num_iters*3+2 waxpys.
mv_flops *= (num_iters+1);
dot_flops *= (2*num_iters);
waxpy_flops *= (3*num_iters+2);
#else
//if MINIFE_KERNELS then we did one of each operation per iteration.
mv_flops *= num_iters;
dot_flops *= num_iters;
waxpy_flops *= num_iters;
#endif
double total_flops = mv_flops + dot_flops + waxpy_flops;
double mv_mflops = -1;
if (cg_times[MATVEC] > 1.e-4)
mv_mflops = 1.e-6 * (mv_flops/cg_times[MATVEC]);
double dot_mflops = -1;
if (cg_times[DOT] > 1.e-4)
dot_mflops = 1.e-6 * (dot_flops/cg_times[DOT]);
double waxpy_mflops = -1;
if (cg_times[WAXPY] > 1.e-4)
waxpy_mflops = 1.e-6 * (waxpy_flops/cg_times[WAXPY]);
double total_mflops = -1;
if (cg_times[TOTAL] > 1.e-4)
total_mflops = 1.e-6 * (total_flops/cg_times[TOTAL]);
ydoc.get(title)->add("WAXPY Time",cg_times[WAXPY]);
ydoc.get(title)->add("WAXPY Flops",waxpy_flops);
if (waxpy_mflops >= 0)
ydoc.get(title)->add("WAXPY Mflops",waxpy_mflops);
else
ydoc.get(title)->add("WAXPY Mflops","inf");
ydoc.get(title)->add("DOT Time",cg_times[DOT]);
ydoc.get(title)->add("DOT Flops",dot_flops);
if (dot_mflops >= 0)
ydoc.get(title)->add("DOT Mflops",dot_mflops);
else
ydoc.get(title)->add("DOT Mflops","inf");
ydoc.get(title)->add("MATVEC Time",cg_times[MATVEC]);
ydoc.get(title)->add("MATVEC Flops",mv_flops);
if (mv_mflops >= 0)
ydoc.get(title)->add("MATVEC Mflops",mv_mflops);
else
ydoc.get(title)->add("MATVEC Mflops","inf");
#ifdef MINIFE_FUSED
ydoc.get(title)->add("MATVECDOT Time",cg_times[MATVECDOT]);
ydoc.get(title)->add("MATVECDOT Flops",mv_flops);
if (mv_mflops >= 0)
ydoc.get(title)->add("MATVECDOT Mflops",mv_mflops);
else
ydoc.get(title)->add("MATVECDOT Mflops","inf");
#endif
#if MINIFE_KERNELS == 0
ydoc.get(title)->add("Total","");
ydoc.get(title)->get("Total")->add("Total CG Time",cg_times[TOTAL]);
ydoc.get(title)->get("Total")->add("Total CG Flops",total_flops);
if (total_mflops >= 0)
ydoc.get(title)->get("Total")->add("Total CG Mflops",total_mflops);
else
ydoc.get(title)->get("Total")->add("Total CG Mflops","inf");
ydoc.get(title)->add("Time per iteration",cg_times[TOTAL]/num_iters);
#endif
}
return verify_result;
}
int main(int argc, char *argv[])
{
struct matrix_t *matrixA;
struct sparse_matrix_t *sparseA;
struct vector_t *x, *b;
lsqr_input *input;
lsqr_output *output;
lsqr_work *work; /* zone temoraire de travail */
lsqr_func *func; /* func->mat_vec_prod -> APROD */
/* cmd line arg */
char *matrix_filename = NULL;
char *vector_filename = NULL;
char *sol_filename = NULL;
int max_iter = -1;
float damping = 0;
if (argc != 4) {
fprintf(stderr, "%s matrixfile vectorfile solutionfile\n",
argv[0]);
exit(1);
}
matrix_filename = strdup(argv[1]);
vector_filename = strdup(argv[2]);
sol_filename = strdup(argv[3]);
/* read the matrix */
matrixA = read_matrix(matrix_filename);
fprintf(stderr, "read*matrix: ok (size=%ldx%ld, %ld elements)\n",
matrixA->nb_line, matrixA->nb_col,
matrixA->nb_line * matrixA->nb_col);
sparseA = sparsify(matrixA, SPARSE_COL_LINK);
b = read_simple_vector(vector_filename);
/*************************************************/
/* check compatibility between matrix and vector */
/*************************************************/
if (sparseA->nb_line != b->length) {
fprintf(stderr,
"Error, check your matrix/vector sizes (%ld/%ld)\n",
sparseA->nb_line, b->length);
exit(1);
}
/* init vector solution to zero */
x = new_vector(sparseA->nb_col);
/* catch Ctrl-C signal */
signal(SIGINT, emergency_halt);
/*************************************************************/
/* solve A.x = B */
/*************************************************************/
/* LSQR alloc */
alloc_lsqr_mem(&input, &output, &work, &func,
sparseA->nb_line, sparseA->nb_col);
fprintf(stderr, "alloc_lsqr_mem : ok\n");
/* defines the routine Mat.Vect to use */
func->mat_vec_prod = sparseMATRIXxVECTOR;
/* Set the input parameters for LSQR */
input->num_rows = sparseA->nb_line;
input->num_cols = sparseA->nb_col;
input->rel_mat_err = .0;
input->rel_rhs_err = .0;
input->cond_lim = .0;
input->lsqr_fp_out = stdout;
input->rhs_vec = (dvec *) b;
input->sol_vec = (dvec *) x; /* initial guess */
input->damp_val = damping;
if (max_iter == -1) {
input->max_iter = 4 * (sparseA->nb_col);
} else {
input->max_iter = max_iter;
}
/* resolution du systeme Ax=b */
lsqr(input, output, work, func, sparseA);
write_vector((struct vector_t *) output->sol_vec, sol_filename);
free_lsqr_mem(input, output, work, func);
free_matrix(matrixA);
/* check A^t.A */
/*
* { struct sparse_matrix_t *AtA; AtA = AtransA (sparseA);
* write_sparse_matrix(AtA, "AtA"); write_sparse_matrix(sparseA,
* "A"); free_sparse_matrix (AtA);
*
* } */
free_sparse_matrix(sparseA);
return (1);
}
int main()
{
int n = 0;
char filename[256];
double** matrixA;
clock_t time;
double* vectorB;
n = read_dimension();
printf("Dimensio n=%d\n", n);
printf("Arxiu matriu A? (buit per matriu random) ");
fgets(filename, 255, stdin);
if (filename[0] != '\n') {
if (filename[strlen(filename) - 1] == '\n') {
filename[strlen(filename) - 1] = '\0';
}
printf("\nMatriu de l'arxiu %s\n", filename);
matrixA = read_matrix(filename, n);
} else {
printf("\nMatriu random\n");
matrixA = generate_random_matrix(n);
}
printf("Arxiu vector b? (buit per vector random) ");
fgets(filename, 255, stdin);
if (filename[0] != '\n') {
if (filename[strlen(filename) - 1] == '\n') {
filename[strlen(filename) - 1] = '\0';
}
printf("\nVector de l'arxiu %s\n", filename);
vectorB = read_vector(filename, n);
} else {
printf("\n Vector random\n");
vectorB = generate_random_vector(n);
}
printf("Començant calcul LUx = b...\n");
time = clock();
/*******/
solveLU(n, matrixA, vectorB);
/*******/
time = clock() - time;
printf("Calcul finalitzat.\n");
printf("S'escriura el vector X a l'arxiu output2.txt\n");
write_vector("output2.txt", vectorB, n);
printf("n = %d, t = %.6f, t/n = %.6f\n",
n, ((float)time)/CLOCKS_PER_SEC,
(((float)time) / CLOCKS_PER_SEC)/n
);
free_matrix(matrixA, n);
free(vectorB);
return 0;
}
static void
write_obj(ScmObj port, ScmObj obj, enum ScmOutputType otype)
{
ScmObj sym;
#if SCM_USE_SRFI38
if (INTERESTINGP(obj)) {
scm_intobj_t index = get_shared_index(obj);
if (index > 0) {
/* defined datum */
scm_format(port, SCM_FMT_RAW_C, "#~ZU#", (size_t)index);
return;
}
if (index < 0) {
/* defining datum, with the new index negated */
scm_format(port, SCM_FMT_RAW_C, "#~ZU=", (size_t)-index);
/* Print it; the next time it'll be defined. */
}
}
#endif
switch (SCM_TYPE(obj)) {
#if SCM_USE_INT
case ScmInt:
scm_format(port, SCM_FMT_RAW_C, "~MD", SCM_INT_VALUE(obj));
break;
#endif
case ScmCons:
if (ERROBJP(obj))
write_errobj(port, obj, otype);
else
write_list(port, obj, otype);
break;
case ScmSymbol:
scm_port_puts(port, SCM_SYMBOL_NAME(obj));
break;
#if SCM_USE_CHAR
case ScmChar:
write_char(port, obj, otype);
break;
#endif
#if SCM_USE_STRING
case ScmString:
write_string(port, obj, otype);
break;
#endif
case ScmFunc:
scm_port_puts(port, (SCM_SYNTAXP(obj)) ? "#<syntax " : "#<subr ");
sym = scm_symbol_bound_to(obj);
if (TRUEP(sym))
scm_display(port, sym);
else
scm_format(port, SCM_FMT_RAW_C, "~P", (void *)obj);
scm_port_put_char(port, '>');
break;
#if SCM_USE_HYGIENIC_MACRO
case ScmMacro:
scm_port_puts(port, "#<macro ");
write_obj(port, SCM_HMACRO_RULES(obj), otype);
scm_port_puts(port, ">");
break;
case ScmFarsymbol:
write_farsymbol(port, obj, otype);
break;
case ScmSubpat:
if (SCM_SUBPAT_PVARP(obj)) {
#if SCM_DEBUG_MACRO
scm_port_puts(port, "#<pvar ");
write_obj(port, SCM_SUBPAT_OBJ(obj), otype);
scm_format(port, SCM_FMT_RAW_C, " ~MD>",
SCM_SUBPAT_PVAR_INDEX(obj));
#else /* not SCM_DEBUG_MACRO */
write_obj(port, SCM_SUBPAT_OBJ(obj), otype);
#endif /* not SCM_DEBUG_MACRO */
} else {
SCM_ASSERT(SCM_SUBPAT_REPPATP(obj));
write_obj(port, SCM_SUBPAT_REPPAT_PAT(obj), otype);
#if SCM_DEBUG_MACRO
scm_format(port, SCM_FMT_RAW_C, " ..[~MD]..",
SCM_SUBPAT_REPPAT_PVCOUNT(obj));
#else
scm_port_puts(port, " ...");
#endif
}
break;
#endif /* SCM_USE_HYGIENIC_MACRO */
case ScmClosure:
#if SCM_USE_LEGACY_MACRO
if (SYNTACTIC_CLOSUREP(obj))
scm_port_puts(port, "#<syntactic closure ");
else
#endif
scm_port_puts(port, "#<closure ");
write_obj(port, SCM_CLOSURE_EXP(obj), otype);
scm_port_put_char(port, '>');
break;
#if SCM_USE_VECTOR
case ScmVector:
write_vector(port, obj, otype);
break;
#endif
case ScmPort:
write_port(port, obj, otype);
break;
#if SCM_USE_CONTINUATION
case ScmContinuation:
scm_format(port, SCM_FMT_RAW_C, "#<continuation ~P>", (void *)obj);
break;
#endif
case ScmValuePacket:
scm_port_puts(port, "#<values ");
write_obj(port, SCM_VALUEPACKET_VALUES(obj), otype);
#if SCM_USE_VALUECONS
#if SCM_USE_STORAGE_FATTY
/* SCM_VALUEPACKET_VALUES() changes the type destructively */
SCM_ENTYPE(obj, ScmValuePacket);
#else /* SCM_USE_STORAGE_FATTY */
#error "valuecons is not supported on this storage implementation"
#endif /* SCM_USE_STORAGE_FATTY */
#endif /* SCM_USE_VALUECONS */
scm_port_put_char(port, '>');
break;
case ScmConstant:
write_constant(port, obj, otype);
break;
#if SCM_USE_SSCM_EXTENSIONS
case ScmCPointer:
scm_format(port, SCM_FMT_RAW_C,
"#<c_pointer ~P>", SCM_C_POINTER_VALUE(obj));
break;
case ScmCFuncPointer:
scm_format(port, SCM_FMT_RAW_C,
"#<c_func_pointer ~P>",
(void *)(uintptr_t)SCM_C_FUNCPOINTER_VALUE(obj));
break;
#endif
case ScmRational:
case ScmReal:
case ScmComplex:
default:
SCM_NOTREACHED;
}
}
