← Back to branch summary

~ubuntu-branches/ubuntu/saucy/libctl/saucy

« back to all changes in this revision

Viewing changes to base/main.c

  • Committer: Bazaar Package Importer
  • Author(s): Josselin Mouette
  • Date: 2006-05-01 20:25:01 UTC
  • mfrom: (1.1.2 upstream)
  • Revision ID: james.westby@ubuntu.com-20060501202501-lytbmb3oevyoqzxi
Tags: 3.0.1-1
http://bugs.debian.org/361676
* New upstream release (closes: #361676).
* Major rework of the debian/ directory. Switch to cdbs.
* Migrate Scheme files to a versioned location to allow several
  versions to be installed at once.
* Write a Makefile to put with the example.
* Update copyright, the library is now GPL.
* Use gfortran for the F77 wrappers.
* Standards-version is 3.7.0.

Show diffs side-by-side

added added

removed removed

Lines of Context:
base/main.c
1
1
/* libctl: flexible Guile-based control files for scientific software 
2
 
 * Copyright (C) 1998, 1999, 2000, 2001, 2002, Steven G. Johnson
 
2
 * Copyright (C) 1998, 1999, 2000, 2001, 2002, 2006, Steven G. Johnson
3
3
 *
4
4
 * This file may be used without restriction.  It is in the public
5
5
 * domain, and is NOT restricted by the terms of any GNU license.
32
32
#include <string.h>
33
33
#include <guile/gh.h>
34
34
 
35
 
#include <ctl-io.h>
 
35
/* for basename and dirname functions */
 
36
#include <libgen.h>
 
37
 
 
38
#include "ctl-io.h"
 
39
 
 
40
#ifdef CXX_CTL_IO
 
41
using namespace ctlio;
 
42
#endif
36
43
 
37
44
/* define a global "verbose" variable set by the --verbose command-line opt. */
38
45
int verbose = 0;
102
109
 
103
110
/**************************************************************************/
104
111
 
 
112
static int exists(const char *fname)
 
113
{
 
114
     FILE *f = fopen(fname, "r");
 
115
     if (f) {
 
116
          fclose(f);
 
117
          return 1;
 
118
     }
 
119
     return 0;
 
120
}
 
121
 
 
122
static char *make_name(const char *for_dir, const char *for_base)
 
123
{
 
124
     char *dir0, *dir, *base0, *base, *name = 0;
 
125
     dir0 = (char *) malloc(sizeof(char) * (strlen(for_dir) + 1));
 
126
     base0 = (char *) malloc(sizeof(char) * (strlen(for_base) + 1));
 
127
     strcpy(dir0, for_dir); dir = dirname(dir0);
 
128
     if (strlen(dir)) {
 
129
          strcpy(base0, for_base); base = basename(base0);
 
130
          name = (char *) malloc(sizeof(char) * (strlen(dir) + 1 +
 
131
                                                 strlen(base) + 1));
 
132
          strcpy(name, dir);
 
133
          strcat(name, "/");
 
134
          strcat(name, base);
 
135
          free(base0);
 
136
     }
 
137
     free(dir0);
 
138
     return name;
 
139
}
 
140
 
 
141
/**************************************************************************/
 
142
 
105
143
#ifdef HAVE_CTL_HOOKS
106
144
static int ctl_stop_hook_called = 0;
107
145
 
134
172
  gh_new_procedure ("write-output-vars", write_output_vars, 0, 0, 0);
135
173
 
136
174
  /* Export the subplex minimization routine: */
137
 
  gh_new_procedure ("subplex", subplex_scm, 7, 0, 0);
 
175
  gh_new_procedure ("subplex", (SCM (*)(void)) subplex_scm, 7, 0, 0);
 
176
 
 
177
  /* Export the adaptive integration routines: */
 
178
  gh_new_procedure ("adaptive-integration", 
 
179
                    (SCM (*)(void)) adaptive_integration_scm, 6, 0, 0);
 
180
 
 
181
#ifdef CTL_HAS_COMPLEX_INTEGRATION
 
182
  gh_new_procedure ("cadaptive-integration", 
 
183
                    (SCM (*)(void)) cadaptive_integration_scm, 6, 0, 0);
 
184
#endif
138
185
 
139
186
#ifdef HAVE_CTL_EXPORT_HOOK
140
187
  ctl_export_hook();
152
199
 
153
200
  i = handle_args(argc, argv, &spec_file_loaded, &continue_run);
154
201
 
 
202
  {
 
203
       char definestr[] = "(define verbose? false)";
 
204
       strcpy(definestr, "(define verbose? ");
 
205
       strcat(definestr, verbose ? "true)" : "false)");
 
206
       gh_eval_str(definestr);
 
207
  }
 
208
 
155
209
  if (!continue_run)
156
210
       goto done;
157
211
 
158
212
  /* load the specification file if it was given at compile time,
159
213
     and if it wasn't specified on the command-line: */
160
214
#ifdef SPEC_SCM
161
 
  if (!spec_file_loaded)
162
 
       ctl_include(SPEC_SCM);
 
215
  if (!spec_file_loaded) {
 
216
       /* try first to load it in the program directory if it
 
217
          was specified explicitly (e.g. "./foo"), for cases
 
218
          where we are running a program that has not been installed */
 
219
       char *spec_name = make_name(argv[0], SPEC_SCM);
 
220
       if (spec_name && exists(spec_name))
 
221
            ctl_include(spec_name);
 
222
       else
 
223
            ctl_include(SPEC_SCM);
 
224
       free(spec_name);
 
225
  }
163
226
#endif
164
227
 
165
228
  /* define any variables and load any scheme files specified on the