int glp_write_mip(glp_prob *mip, const char *fname)
{ glp_file *fp;
int i, j, ret = 0;
xprintf("Writing MIP solution to '%s'...\n", fname);
fp = glp_open(fname, "w");
if (fp == NULL)
{ xprintf("Unable to create '%s' - %s\n", fname, get_err_msg());
ret = 1;
goto done;
}
/* number of rows, number of columns */
xfprintf(fp, "%d %d\n", mip->m, mip->n);
/* solution status, objective value */
xfprintf(fp, "%d %.*g\n", mip->mip_stat, DBL_DIG, mip->mip_obj);
/* rows (auxiliary variables) */
for (i = 1; i <= mip->m; i++)
xfprintf(fp, "%.*g\n", DBL_DIG, mip->row[i]->mipx);
/* columns (structural variables) */
for (j = 1; j <= mip->n; j++)
xfprintf(fp, "%.*g\n", DBL_DIG, mip->col[j]->mipx);
#if 0 /* FIXME */
xfflush(fp);
#endif
if (glp_ioerr(fp))
{ xprintf("Write error on '%s' - %s\n", fname, get_err_msg());
ret = 1;
goto done;
}
xprintf("%d lines were written\n", 2 + mip->m + mip->n);
done:
if (fp != NULL) glp_close(fp);
return ret;
}
int glp_write_graph(glp_graph *G, const char *fname)
{ XFILE *fp;
glp_vertex *v;
glp_arc *a;
int i, count, ret;
xprintf("Writing graph to `%s'...\n", fname);
fp = xfopen(fname, "w"), count = 0;
if (fp == NULL)
{ xprintf("Unable to create `%s' - %s\n", fname, xerrmsg());
ret = 1;
goto done;
}
xfprintf(fp, "%d %d\n", G->nv, G->na), count++;
for (i = 1; i <= G->nv; i++)
{ v = G->v[i];
for (a = v->out; a != NULL; a = a->t_next)
xfprintf(fp, "%d %d\n", a->tail->i, a->head->i), count++;
}
xfflush(fp);
if (xferror(fp))
{ xprintf("Write error on `%s' - %s\n", fname, xerrmsg());
ret = 1;
goto done;
}
xprintf("%d lines were written\n", count);
ret = 0;
done: if (fp != NULL) xfclose(fp);
return ret;
}
void
pic_print_backtrace(pic_state *pic, xFILE *file)
{
assert(! pic_invalid_p(pic->err));
if (! pic_error_p(pic->err)) {
xfprintf(file, "raise: ");
pic_fwrite(pic, pic->err, file);
} else {
struct pic_error *e;
e = pic_error_ptr(pic->err);
if (e->type != pic_intern_cstr(pic, "")) {
pic_fwrite(pic, pic_obj_value(e->type), file);
xfprintf(file, " ");
}
xfprintf(file, "error: ");
pic_fwrite(pic, pic_obj_value(e->msg), file);
xfprintf(file, "\n");
/* TODO: print error irritants */
xfputs(pic_str_cstr(pic, e->stack), file);
}
}
static void M4_GNUC_UNUSED
include_dump (void)
{
includes *incl;
xfprintf (stderr, "include_dump:\n");
for (incl = dir_list; incl != NULL; incl = incl->next)
xfprintf (stderr, "\t%s\n", incl->dir);
}
static void
write_pair(struct writer_control *p, struct pic_pair *pair)
{
pic_state *pic = p->pic;
xFILE *file = p->file;
pic_sym *tag;
if (pic_pair_p(pair->cdr) && pic_nil_p(pic_cdr(pic, pair->cdr)) && pic_sym_p(pair->car)) {
tag = pic_sym_ptr(pair->car);
if (tag == pic->sQUOTE) {
xfprintf(pic, file, "'");
write_core(p, pic_car(pic, pair->cdr));
return;
}
else if (tag == pic->sUNQUOTE) {
xfprintf(pic, file, ",");
write_core(p, pic_car(pic, pair->cdr));
return;
}
else if (tag == pic->sUNQUOTE_SPLICING) {
xfprintf(pic, file, ",@");
write_core(p, pic_car(pic, pair->cdr));
return;
}
else if (tag == pic->sQUASIQUOTE) {
xfprintf(pic, file, "`");
write_core(p, pic_car(pic, pair->cdr));
return;
}
else if (tag == pic->sSYNTAX_QUOTE) {
xfprintf(pic, file, "#'");
write_core(p, pic_car(pic, pair->cdr));
return;
}
else if (tag == pic->sSYNTAX_UNQUOTE) {
xfprintf(pic, file, "#,");
write_core(p, pic_car(pic, pair->cdr));
return;
}
else if (tag == pic->sSYNTAX_UNQUOTE_SPLICING) {
xfprintf(pic, file, "#,@");
write_core(p, pic_car(pic, pair->cdr));
return;
}
else if (tag == pic->sSYNTAX_QUASIQUOTE) {
xfprintf(pic, file, "#`");
write_core(p, pic_car(pic, pair->cdr));
return;
}
}
xfprintf(pic, file, "(");
write_pair_help(p, pair);
xfprintf(pic, file, ")");
}
void
debug_message_prefix (void)
{
xfprintf (debug, "m4debug:");
if (current_line)
{
if (debug_level & DEBUG_TRACE_FILE)
xfprintf (debug, "%s:", current_file);
if (debug_level & DEBUG_TRACE_LINE)
xfprintf (debug, "%d:", current_line);
}
putc (' ', debug);
}
static void
write_dict(struct writer_control *p, struct pic_dict *dict)
{
pic_state *pic = p->pic;
xFILE *file = p->file;
pic_sym *sym;
khiter_t it;
xfprintf(pic, file, "#.(dictionary");
pic_dict_for_each (sym, dict, it) {
xfprintf(pic, file, " '%s ", pic_symbol_name(pic, sym));
write_core(p, pic_dict_ref(pic, dict, sym));
}
static void
write_float(pic_state *pic, double f, xFILE *file)
{
if (f != f) {
xfprintf(pic, file, "+nan.0");
} else if (f == 1.0 / 0.0) {
xfprintf(pic, file, "+inf.0");
} else if (f == -1.0 / 0.0) {
xfprintf(pic, file, "-inf.0");
} else {
xfprintf(pic, file, "%f", f);
}
}
/* do_tell for profiled xfiles */
static afs_uint32
xf_PROFILE_do_tell(XFILE * X, u_int64 * offset)
{
PFILE *PF = X->refcon;
afs_uint32 err;
err = xftell(&PF->content, offset);
if (err)
xfprintf(&PF->profile, "TELL ERR =%ld\n", (long)err);
else
xfprintf(&PF->profile, "TELL %s =0\n", hexify_int64(offset, 0));
return err;
}
static void
write_blob(pic_state *pic, pic_blob *blob, xFILE *file)
{
size_t i;
xfprintf(pic, file, "#u8(");
for (i = 0; i < blob->len; ++i) {
xfprintf(pic, file, "%d", blob->data[i]);
if (i + 1 < blob->len) {
xfprintf(pic, file, " ");
}
}
xfprintf(pic, file, ")");
}
void
freeze_diversions (FILE *file)
{
int saved_number;
int last_inserted;
gl_oset_iterator_t iter;
const void *elt;
saved_number = current_diversion;
last_inserted = 0;
make_diversion (0);
output_file = file; /* kludge in the frozen file */
iter = gl_oset_iterator (diversion_table);
while (gl_oset_iterator_next (&iter, &elt))
{
m4_diversion *diversion = (m4_diversion *) elt;
if (diversion->size || diversion->used)
{
if (diversion->size)
xfprintf (file, "D%d,%d\n", diversion->divnum, diversion->used);
else
{
struct stat file_stat;
diversion->u.file = m4_tmpopen (diversion->divnum, true);
if (fstat (fileno (diversion->u.file), &file_stat) < 0)
M4ERROR ((EXIT_FAILURE, errno, "cannot stat diversion"));
if (file_stat.st_size < 0
|| (file_stat.st_size + 0UL
!= (unsigned long int) file_stat.st_size))
M4ERROR ((EXIT_FAILURE, 0, "diversion too large"));
xfprintf (file, "D%d,%lu\n", diversion->divnum,
(unsigned long int) file_stat.st_size);
}
insert_diversion_helper (diversion);
putc ('\n', file);
last_inserted = diversion->divnum;
}
}
gl_oset_iterator_free (&iter);
/* Save the active diversion number, if not already. */
if (saved_number != last_inserted)
xfprintf (file, "D%d,0\n\n", saved_number);
}
static void
write_vec(struct writer_control *p, pic_vec *vec)
{
pic_state *pic = p->pic;
xFILE *file = p->file;
size_t i;
xfprintf(pic, file, "#(");
for (i = 0; i < vec->len; ++i) {
write_core(p, vec->data[i]);
if (i + 1 < vec->len) {
xfprintf(pic, file, " ");
}
}
xfprintf(pic, file, ")");
}
void
add_include_directory (const char *dir)
{
includes *incl;
if (no_gnu_extensions)
return;
if (*dir == '\0')
dir = ".";
incl = (includes *) xmalloc (sizeof (struct includes));
incl->next = NULL;
incl->len = strlen (dir);
incl->dir = xstrdup (dir);
if (incl->len > dir_max_length) /* remember len of longest directory */
dir_max_length = incl->len;
if (dir_list_end == NULL)
dir_list = incl;
else
dir_list_end->next = incl;
dir_list_end = incl;
#ifdef DEBUG_INCL
xfprintf (stderr, "add_include_directory (%s);\n", dir);
#endif
}
void write_char(MPL *mpl, int c)
{ xassert(mpl->out_fp != NULL);
/* if (mpl->out_fp == (void *)stdout) */
/* xprintf("%c", c); */
/* else */
xfprintf(mpl->out_fp, "%c", c);
return;
}
void write_char(MPL *mpl, int c)
{ xassert(mpl->out_fp != NULL);
if (mpl->out_fp == (void *)stdout)
xprintf("%c", c);
else
xfprintf(mpl->out_fp, "%c", c);
return;
}
static void
write_pair_help(struct writer_control *p, struct pic_pair *pair)
{
pic_state *pic = p->pic;
khash_t(l) *lh = &p->labels;
khash_t(v) *vh = &p->visited;
khiter_t it;
int ret;
write_core(p, pair->car);
if (pic_nil_p(pair->cdr)) {
return;
}
else if (pic_pair_p(pair->cdr)) {
/* shared objects */
if ((it = kh_get(l, lh, pic_ptr(pair->cdr))) != kh_end(lh) && kh_val(lh, it) != -1) {
xfprintf(pic, p->file, " . ");
kh_put(v, vh, pic_ptr(pair->cdr), &ret);
if (ret == 0) { /* if exists */
xfprintf(pic, p->file, "#%d#", kh_val(lh, it));
return;
}
xfprintf(pic, p->file, "#%d=", kh_val(lh, it));
}
else {
xfprintf(pic, p->file, " ");
}
write_pair_help(p, pic_pair_ptr(pair->cdr));
if (p->op == OP_WRITE) {
if ((it = kh_get(l, lh, pic_ptr(pair->cdr))) != kh_end(lh) && kh_val(lh, it) != -1) {
it = kh_get(v, vh, pic_ptr(pair->cdr));
kh_del(v, vh, it);
}
}
return;
}
else {
xfprintf(pic, p->file, " . ");
write_core(p, pair->cdr);
}
}
static void
print_token (const char *s, token_type t, token_data *td)
{
xfprintf (stderr, "%s: ", s);
switch (t)
{ /* TOKSW */
case TOKEN_OPEN:
case TOKEN_COMMA:
case TOKEN_CLOSE:
case TOKEN_SIMPLE:
xfprintf (stderr, "char:");
break;
case TOKEN_WORD:
xfprintf (stderr, "word:");
break;
case TOKEN_STRING:
xfprintf (stderr, "string:");
break;
case TOKEN_MACDEF:
xfprintf (stderr, "macro: %p\n", TOKEN_DATA_FUNC (td));
break;
case TOKEN_EOF:
xfprintf (stderr, "eof\n");
break;
}
xfprintf (stderr, "\t\"%s\"\n", TOKEN_DATA_TEXT (td));
}
/* Print the header of a one-line debug message, starting with "m4debug:". */
void
m4_debug_message_prefix (m4 *context)
{
FILE *debug_file;
assert (context);
debug_file = m4_get_debug_file (context);
fputs ("m4debug:", debug_file);
if (m4_get_current_line (context))
{
if (m4_is_debug_bit (context, M4_DEBUG_TRACE_FILE))
xfprintf (debug_file, "%s:", m4_get_current_file (context));
if (m4_is_debug_bit (context, M4_DEBUG_TRACE_LINE))
xfprintf (debug_file, "%d:", m4_get_current_line (context));
}
putc (' ', debug_file);
}
void show_MAT ( XFILE * fp, const MAT mat, const int mrow, const int mcol){
if(NULL==fp){ return;}
if(NULL==mat){ return;}
const int nrow = mat->nrow;
const int ncol = mat->ncol;
const int maxrow = (mrow!=0 && mrow<nrow)?mrow:nrow;
const int maxcol = (mcol!=0 && mcol<ncol)?mcol:ncol;
for( int row=0 ; row<maxrow ; row++){
xfprintf(fp,"%d:",row+1);
for ( int col=0 ; col<maxcol ; col++){
xfprintf(fp," %#8.2f",mat->x[col*nrow+row]);
}
if(maxcol<ncol){ xfprintf(fp,"\t... (%u others)",ncol-maxcol); }
xfputc('\n',fp);
}
if( maxrow<nrow){ xfprintf(fp,"... (%u others)\n",nrow-maxrow); }
}
FILE *
m4_path_search (const char *file, char **result)
{
FILE *fp;
includes *incl;
char *name; /* buffer for constructed name */
int e;
if (result)
*result = NULL;
/* Reject empty file. */
if (!*file)
{
errno = ENOENT;
return NULL;
}
/* Look in current working directory first. */
fp = m4_fopen (file);
if (fp != NULL)
{
if (result)
*result = xstrdup (file);
return fp;
}
/* If file not found, and filename absolute, fail. */
if (IS_ABSOLUTE_FILE_NAME (file) || no_gnu_extensions)
return NULL;
e = errno;
for (incl = dir_list; incl != NULL; incl = incl->next)
{
name = mfile_name_concat (incl->dir, file, NULL);
#ifdef DEBUG_INCL
xfprintf (stderr, "m4_path_search (%s) -- trying %s\n", file, name);
#endif
fp = m4_fopen (name);
if (fp != NULL)
{
if (debug_level & DEBUG_TRACE_PATH)
DEBUG_MESSAGE2 ("path search for `%s' found `%s'", file, name);
if (result)
*result = name;
else
free (name);
return fp;
}
free (name);
}
errno = e;
return fp;
}
/* do_skip for profiled xfiles */
static afs_uint32
xf_PROFILE_do_skip(XFILE * X, afs_uint32 count)
{
PFILE *PF = X->refcon;
afs_uint32 err;
err = xfskip(&PF->content, count);
xfprintf(&PF->profile, "SKIP %ld =%ld\n", (long)count, (long)err);
return err;
}
/* do_write for profiled xfiles */
static afs_uint32
xf_PROFILE_do_write(XFILE * X, void *buf, afs_uint32 count)
{
PFILE *PF = X->refcon;
afs_uint32 err;
err = xfwrite(&PF->content, buf, count);
xfprintf(&PF->profile, "W %ld =%ld\n", (long)count, (long)err);
return err;
}
static void
write_str(pic_state *pic, pic_str *str, xFILE *file, int mode)
{
size_t i;
const char *cstr = pic_str_cstr(pic, str);
if (mode == DISPLAY_MODE) {
xfprintf(pic, file, "%s", pic_str_cstr(pic, str));
return;
}
xfprintf(pic, file, "\"");
for (i = 0; i < pic_str_len(str); ++i) {
if (cstr[i] == '"' || cstr[i] == '\\') {
xfputc(pic, '\\', file);
}
xfputc(pic, cstr[i], file);
}
xfprintf(pic, file, "\"");
}
static void
include_dump (m4 *context)
{
m4__search_path *incl;
fputs ("include_dump:\n", stderr);
for (incl = m4__get_search_path (context)->list;
incl != NULL; incl = incl->next)
xfprintf (stderr, "\t'%s'\n", incl->dir);
}
int yylval_token (int symbol) {
int offset = scan_offset - yyleng;
yylval = new_astree (symbol, filename_stack.last_filenr,
scan_linenr, offset, yytext);
// print token info to "program.tok"
xfprintf (tokfile, " %2d %4d.%.3d %3d %-16s (%s)\n",
filename_stack.last_filenr, scan_linenr, offset,
symbol, get_yytname (symbol), yytext);
return symbol;
}
int glp_write_sol(glp_prob *lp, const char *fname)
{ glp_file *fp;
int i, j, ret = 0;
xprintf("Writing basic solution to '%s'...\n", fname);
fp = glp_open(fname, "w");
if (fp == NULL)
{ xprintf("Unable to create '%s' - %s\n", fname, get_err_msg());
ret = 1;
goto done;
}
/* number of rows, number of columns */
xfprintf(fp, "%d %d\n", lp->m, lp->n);
/* primal status, dual status, objective value */
xfprintf(fp, "%d %d %.*g\n", lp->pbs_stat, lp->dbs_stat, DBL_DIG,
lp->obj_val);
/* rows (auxiliary variables) */
for (i = 1; i <= lp->m; i++)
{ GLPROW *row = lp->row[i];
/* status, primal value, dual value */
xfprintf(fp, "%d %.*g %.*g\n", row->stat, DBL_DIG, row->prim,
DBL_DIG, row->dual);
}
/* columns (structural variables) */
for (j = 1; j <= lp->n; j++)
{ GLPCOL *col = lp->col[j];
/* status, primal value, dual value */
xfprintf(fp, "%d %.*g %.*g\n", col->stat, DBL_DIG, col->prim,
DBL_DIG, col->dual);
}
#if 0 /* FIXME */
xfflush(fp);
#endif
if (glp_ioerr(fp))
{ xprintf("Write error on '%s' - %s\n", fname, get_err_msg());
ret = 1;
goto done;
}
xprintf("%d lines were written\n", 2 + lp->m + lp->n);
done:
if (fp != NULL) glp_close(fp);
return ret;
}
/* do_seek for profiled xfiles */
static afs_uint32
xf_PROFILE_do_seek(XFILE * X, u_int64 * offset)
{
PFILE *PF = X->refcon;
afs_uint32 err;
err = xfseek(&PF->content, offset);
xfprintf(&PF->profile, "SEEK %s =%ld\n", hexify_int64(offset, 0),
(long)err);
return err;
}
void veprintf (char *format, va_list args) {
assert (execname != NULL);
assert (format != NULL);
xfflush (NULL);
if (strstr (format, "%:") == format) {
xfprintf (stderr, "%s: ", get_execname ());
format += 2;
}
xvfprintf (stderr, format, args);
xfflush (NULL);
}
void
pic_warnf(pic_state *pic, const char *fmt, ...)
{
va_list ap;
pic_value err_line;
va_start(ap, fmt);
err_line = pic_xvformat(pic, fmt, ap);
va_end(ap);
xfprintf(pic, pic_stderr(pic)->file, "warn: %s\n", pic_str_cstr(pic, pic_str_ptr(pic_car(pic, err_line))));
}
void __debugprintf (char flag, char *file, int line, const char *func,
char *format, ...) {
va_list args;
if (! is_debugflag (flag)) return;
xfflush (NULL);
va_start (args, format);
xfprintf (stderr, "DEBUGF(%c): %s[%d] %s():\n",
flag, file, line, func);
xvfprintf (stderr, format, args);
va_end (args);
xfflush (NULL);
}
