void prin_immed(void)
{
int i,j;
double g;
fprintf(debug_prn_file,"\n\nImmediate results, after forcer........");
fprintf(debug_prn_file,"\n\nIteration %3d Iterations since last evaluation of STOICH. %3d",iter,it1-1);
fprintf(debug_prn_file,"\nNumber of basis optimisations = %3d Immediate counter iti = %3d",nopt,iti);
fprintf(debug_prn_file,"\nSpecies Initial moles Final moles MU/RT delta G/RT\n");
for (i = 1; i <= nc; i++) {
for(j = 0; j < 7; j++) fprintf(debug_prn_file,"%c",comp_array[VCS_specie[ind[i]]].name[j]);
fprintf(debug_prn_file," ");
fprintf(debug_prn_file,"%+.7e %+.7e %+.7e\n",wt[i],w[i],fe[i]);
}
for (i = nc+1; i <= mr; i++) {
for(j = 0; j < 7; j++) fprintf(debug_prn_file,"%c",comp_array[VCS_specie[ind[i]]].name[j]);
fprintf(debug_prn_file," ");
fprintf(debug_prn_file,"%+.7e %+.7e %+.7e %+.7e\n",wt[i],w[i],fe[i],dg[i-nc]);
}
g = 0.0;
for (i = 1; i <= no_phases; i++)
if ( tmole[i] > 0.0 && tinert[i] > 0.0 ) g += tinert[i]*log((double)tinert[i]/tmole[i]);
for (i =1; i <= mr; i++) g += w[i] * fe[i];
fprintf(debug_prn_file,"\nDG/RT = %+.7e",g);
elab();
fprintf(debug_prn_file,"\n\nElemental abundances");
for (i =1; i <= ne; i++) fprintf(debug_prn_file,"\n %1d %+.7e",i,ga[i]);
}
static tree_t run_elab(void)
{
tree_t t, last_ent = NULL;
while ((t = parse())) {
sem_check(t);
fail_if(sem_errors() > 0);
simplify(t);
if (tree_kind(t) == T_ENTITY)
last_ent = t;
}
return elab(last_ent);
}
bool
compile(Path const& in, Path const& out)
{
try {
// Read the input source.
File src = in.c_str();
Input_buffer buf = src;
// Lex the input source.
Token_stream ts;
Location_map locs;
Lexer lex(syms, buf);
if (!lex.lex(ts))
return -1;
// Parse the token stream.
Parser parse(syms, ts, locs);
Decl* m = parse.module();
if (!parse)
return -1;
// Perform semantic analysis.
Elaborator elab(locs, syms);
elab.elaborate(m);
// Translate to LLVM.
Generator gen;
llvm::Module* mod = gen(m);
std::error_code err;
llvm::raw_fd_ostream ofs(out.string(), err, llvm::sys::fs::F_None);
ofs << *mod;
return true;
}
// Diagnose uncaught translation errors and exit
// gracefully. All other uncaught exceptions are
// ICEs and we want those to fail noisily. Note
// that re-throwing does not re-establish the
// origin of the error for the purpose of debugging.
catch (Translation_error& err) {
diagnose(err);
return false;
}
}
bool
parse(Path_seq const& in, Path const& out, Config const& conf)
{
bool ok = true;
for (Path const& p : in) {
if (get_file_kind(p) == beaker_file)
ok &= parse(p, conf);
else {
// FIXME: LLVM IR/BC or assembly could (should?) be
// lowered and passed through to the link phase. That
// would allow a module to contain native assembly,
// and used internally via foreign declarations.
std::cerr << "error: unknown input file\n";
return -1;
}
}
if (!ok)
return -1;
// Elaborate the parse result.
Elaborator elab(locs, syms);
elab.elaborate(&mod);
// Translate to LLVM.
Generator gen;
llvm::Module* ir = gen(&mod);
// Write the output to an IR file, not the requested
// output. That happens later.
Path p = to_ir_file(out);
// Write the result to the output file.
std::error_code err;
llvm::raw_fd_ostream ofs(p.string(), err, llvm::sys::fs::F_None);
ofs << *ir;
return true;
}
static int elaborate(int argc, char **argv)
{
set_work_lib();
static struct option long_options[] = {
{"disable-opt", no_argument, 0, 'o'},
{"dump-llvm", no_argument, 0, 'd'},
{"native", no_argument, 0, 'n'},
{"cover", no_argument, 0, 'c'},
{0, 0, 0, 0}
};
int c, index = 0;
const char *spec = "";
optind = 1;
while ((c = getopt_long(argc, argv, spec, long_options, &index)) != -1) {
switch (c) {
case 'o':
opt_set_int("optimise", 0);
break;
case 'd':
opt_set_int("dump-llvm", 1);
break;
case 'n':
opt_set_int("native", 1);
break;
case 'c':
opt_set_int("cover", 1);
break;
case 0:
// Set a flag
break;
case '?':
// getopt_long already printed an error message
exit(EXIT_FAILURE);
default:
abort();
}
}
if (optind == argc)
fatal("missing top-level unit name");
ident_t unit_i = to_unit_name(argv[optind]);
tree_t unit = lib_get(lib_work(), unit_i);
if (unit == NULL)
fatal("cannot find unit %s in library %s",
istr(unit_i), istr(lib_name(lib_work())));
tree_t e = elab(unit);
if (e == NULL)
return EXIT_FAILURE;
opt(e);
group_nets(e);
// Save the library now so the code generator can attach temporary
// meta data to trees
lib_save(lib_work());
cgen(e);
link_bc(e);
return EXIT_SUCCESS;
}
static int elaborate(int argc, char **argv)
{
set_work_lib();
static struct option long_options[] = {
{ "disable-opt", no_argument, 0, 'o' },
{ "dump-llvm", no_argument, 0, 'd' },
{ "dump-vcode", optional_argument, 0, 'V' },
{ "native", no_argument, 0, 'n' },
{ "cover", no_argument, 0, 'c' },
{ "verbose", no_argument, 0, 'v' },
{ 0, 0, 0, 0 }
};
bool verbose = false;
int c, index = 0;
const char *spec = "v";
optind = 1;
while ((c = getopt_long(argc, argv, spec, long_options, &index)) != -1) {
switch (c) {
case 'o':
opt_set_int("optimise", 0);
break;
case 'd':
opt_set_int("dump-llvm", 1);
break;
case 'V':
opt_set_str("dump-vcode", optarg ?: "");
break;
case 'n':
opt_set_int("native", 1);
break;
case 'c':
opt_set_int("cover", 1);
break;
case 'v':
verbose = true;
break;
case 0:
// Set a flag
break;
case '?':
fatal("unrecognised elaborate option %s", argv[optind - 1]);
default:
abort();
}
}
if (optind == argc)
fatal("missing top-level unit name");
elab_verbose(verbose, "initialising");
ident_t unit_i = to_unit_name(argv[optind]);
tree_t unit = lib_get(lib_work(), unit_i);
if (unit == NULL)
fatal("cannot find unit %s in library %s",
istr(unit_i), istr(lib_name(lib_work())));
elab_verbose(verbose, "loading top-level unit");
tree_t e = elab(unit);
if (e == NULL)
return EXIT_FAILURE;
elab_verbose(verbose, "elaborating design");
opt(e);
elab_verbose(verbose, "optimising design");
group_nets(e);
elab_verbose(verbose, "grouping nets");
// Save the library now so the code generator can attach temporary
// meta data to trees
lib_save(lib_work());
elab_verbose(verbose, "saving library");
lower_unit(e);
elab_verbose(verbose, "generating intermediate code");
cgen(e);
elab_verbose(verbose, "generating LLVM");
link_bc(e);
elab_verbose(verbose, "linking");
return EXIT_SUCCESS;
}
void initial_data(void)
{
int i,j;
iter = 0;
nopt = 0;
nc = ne;
IM = FALSE;
ICONV = FALSE;
for (i = 1; i <= m; i++)
index2[i] = ind[i] = i;
/*++++++++ Watch out for this +++++++*/
for (j = 1; j <= no_phases; j++) {
if ( no_specie_phase[j] == 1 && tinert[j] == 0.0) { /* only one specie in the phase - make it SINGLE */
no_specie_phase[0]++; /* increase SINGLE specie phase count */
no_specie_phase[j] = 0;
for (i = 1; i <= m; i++) {
if ( j == GAS && si[i] == GAS ) {
ff[i] += GASCONST * tempt * log((double)press);
si[i] = SINGLE;
}
else if ( j == si[i] )
si[i] = SINGLE;
}
}
}
n = m - nc;
nr = n;
mr = m;
TEST = -1e-10;
if ( iest != 0 ) {
for (i = 1; i <= mr; i++) w[i] = -ff[i];
TEST = -1e20;
}
for (i = 1; i <= m; i++) {
ir[i] = nc + i;
ff[i] /= (GASCONST * tempt);
if ( si[i] == GAS )
ff[i] += log((double)press);
if ( si[i] == SINGLE )
fe[i] = ff[i];
initial_chem_pot[i] = ff[i]; /* initialise orginal chemical pot (activity) */
}
if ( iest != 0 ) { /* do machine starting estimate */
inest();
elab();
elcorr();
}
else {
#ifdef DEBUG
fprintf(debug_prn_file,"\nCalling 'basopt(TRUE)' from initial_data()");
#endif
basopt(TRUE); /* only calculate optimum basis but not the stioch. matrix */
elab();
}
#ifdef DEBUG3
fprintf(debug_prn_file, CONDENSED_ON );
fprintf(debug_prn_file,"\n\nVCS - algorithm version 1.4");
fprintf(debug_prn_file,"\n %3d Species %3d Elements %3d Components",m,ne,nc);
for (i = 0; i <= no_phases; i++)
fprintf(debug_prn_file,"\n %3d Phase %1d Species ",no_specie_phase[i],i);
fprintf(debug_prn_file,"\nPressure %8.3f atm\nTemperature %8.3f Kelvin\n",press,tempt);
fprintf(debug_prn_file,"Alpha = %8.3f\n",alpha);
for (i = 1; i <= no_phases; i++)
fprintf(debug_prn_file,"Phase %1d inerts %5.2f\n",i,tinert[i]);
//#endif
//#ifdef DEBUG2
fprintf(debug_prn_file,"\n Elemental abundances Correct From estimate\n");
for (i = 1; i <= ne; i++) {
fprintf(debug_prn_file," %2d %s %+.7e %+.7e\n",i, Elem_txt[VCS_elem[i]],gai[i],ga[i]);
}
if ( iest == 0 ) fprintf(debug_prn_file,"\nUser estimate of equilibrium");
else fprintf(debug_prn_file,"\nModified linear programming estimate of equilibrium");
switch (type) {
case -1 : fprintf(debug_prn_file,"\nStandard chemical potential in kcal/mole\n");
break;
case 0 : fprintf(debug_prn_file,"\nStandard chemical potential in MU/RT\n");
break;
case 1 : fprintf(debug_prn_file,"\nStandard chemical potential in kJ/mole\n");
break;
case 2 : fprintf(debug_prn_file,"\nStandard chemical potential in kJ/kmole\n");
break;
}
fprintf(debug_prn_file,"\nSpecies Stan. Chem. Pot. Equilibrium est. Formula vector");
fprintf(debug_prn_file,"\n ");
for(j = 1; j <= ne; j++) fprintf(debug_prn_file," %s", Elem_txt[VCS_elem[j]]);
fprintf(debug_prn_file," Phase\n");
for (i = 1; i <= m; i++) {
for(j = 0; j < 10; j++) fprintf(debug_prn_file,"%c",comp_array[VCS_specie[ind[i]]].name[j]);
fprintf(debug_prn_file," ");
fprintf(debug_prn_file,"%+.7e %+.7e ",da[i],w[i]);
for(j = 1; j <= ne; j++) fprintf(debug_prn_file,"%2.1f ",bm[i][j]);
fprintf(debug_prn_file," %1d\n",(int)si[i]);
}
#endif
}
/* ------------ correct elemental abundances ----------------- */
void elcorr(void)
{
int i,j,k,L,ip1;
double par,xx,r;
#ifdef DEBUG
fprintf(debug_prn_file,"\nEntered into 'elcorr()'");
#endif
for (i = 1; i <= nc; i++)
{
sa[i] = ga[i] - gai[i];
for(j = 1; j <= nc; j++)
sm[j][i] = bm[i][j]; /* get a temporary transpose of bm(i,j) */
}
#ifdef DEBUG
fprintf(debug_prn_file,"\nData for bm[i,j] to use in mlequ() in 'basopt(FALSE)'\n");
for (i = 1; i <= m; i++)
{
for (j = 1; j <= ne; j++)
fprintf(debug_prn_file,"%4.2g ",bm[i][j]);
fprintf(debug_prn_file,"\n");
}
fprintf(debug_prn_file,"\nData for sm[i,j] (Transformed bm[i,j])'\n");
for (i = 1; i <= ne; i++)
{
for (j = 1; j <= m; j++)
fprintf(debug_prn_file,"%4.2g ",sm[i][j]);
fprintf(debug_prn_file,"\n");
}
#endif
/* ------- mlequ() --------- */
for ( i = 1; i <= nc; i++) {
if ( sm[i][i] == 0.0 ) {
ip1 = i+1;
for (k = ip1; k <= nc; k++)
if (sm[k][i] != 0.0 ) goto JUMP1;
strcpy( error, "\n No unique solution - Number of components < Number of elements.\nAborting VCS solver ....");
longjmp( e_buf, 1 );
JUMP1: for (j = i; j <= nc; j++) sm[i][j] += sm[k][j];
sa[i] += sa[k];
}
for (L = 1; L <= nc; L++) {
if ( L == i || sm[L][i] == 0.0 ) {
}
else {
r = sm[L][i]/sm[i][i];
for (j = i; j <= nc; j++) sm[L][j] -= sm[i][j]*r;
sa[L] -= sa[i]*r;
}
}
}
for (i = 1; i <= nc; i++)
sa[i] = -sa[i]/sm[i][i];
/* --------- end mlequ() ------------ */
par = 0.5;
for (i = 1; i <= nc; i++) {
xx = -sa[i]/w[i];
if (par < xx) par = xx;
}
par = 1.0/par;
if ( par <= 1.01 && par > 0.0 ) par = .99*par;
else par = 1.0;
for (i = 1; i <= nc; i++)
w[i] += par*sa[i];
#ifdef DEBUG
elab();
fprintf(debug_prn_file,"\n\nElemental abundances");
for (i =1; i <= ne; i++) fprintf(debug_prn_file,"\n %1d %10.5g",i,ga[i]);
#endif
}