/[ascend]/trunk/base/generic/solver/slv.c
ViewVC logotype

Contents of /trunk/base/generic/solver/slv.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 945 - (show annotations) (download) (as text)
Sat Nov 25 12:41:03 2006 UTC (14 years ago) by johnpye
File MIME type: text/x-csrc
File size: 47183 byte(s)
Fixed a bug in slv_param_char.
More work on IDA ongoing.
1 /*
2 SLV: Ascend Nonlinear Solver
3 Copyright (C) 1990 Karl Michael Westerberg
4 Copyright (C) 1993 Joseph Zaher
5 Copyright (C) 1994 Joseph Zaher, Benjamin Andrew Allan
6 Copyright (C) 1996 Benjamin Andrew Allan
7 Copyright (C) 2005-2006 Carnegie-Mellon University
8
9 This program is free software; you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation; either version 2 of the License, or
12 (at your option) any later version.
13
14 This program is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License for more details.
18
19 You should have received a copy of the GNU General Public License
20 along with this program; if not, write to the Free Software
21 Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
22 This file is part of the SLV solver.
23 */
24
25 #include <math.h>
26 #include <stdarg.h>
27 #include <utilities/ascConfig.h>
28
29 ASC_EXPORT(int) g_SlvNumberOfRegisteredClients=0; /* see header */
30
31 #include <compiler/instance_enum.h>
32 #include <compiler/fractions.h>
33 #include <compiler/compiler.h>
34 #include <utilities/ascMalloc.h>
35 #include <utilities/ascPanic.h>
36 #include <compiler/dimen.h>
37 #include <compiler/atomvalue.h>
38 #include "mtx.h"
39 #include "linsol.h"
40 #include "linsolqr.h"
41 #include "slv_types.h"
42 #include "var.h"
43 #include "rel.h"
44 #include "logrel.h"
45 #include "discrete.h"
46 #include "conditional.h"
47 #include "bnd.h"
48 #include "bndman.h"
49 #include "system.h"
50 #include "slv_server.h"
51 #include "slv_common.h"
52 #include "analyze.h"
53 #include "slv_client.h"
54
55 #define NEEDSTOBEDONE 0
56
57 /**
58 *** Include all of the solvers involved,
59 *** even if they are not linked later
60 *** Defines are to take care of the unlinked ones.
61 **/
62 #if 0
63 # include "slv0.h"
64 # include "slv1.h"
65 # include "slv2.h"
66 # include "slv3.h"
67 # include "slv4.h"
68 # include "slv5.h"
69 # include "slv6.h"
70 # include "slv7.h"
71 # include "slv8.h"
72 # include "slv9.h"
73 #endif
74
75
76 struct slv_system_structure {
77 int solver;
78
79 int serial_id;
80 /**< Through time, two systems may have the same pointer but never
81 simultaneously. The serial_id provides a unique tag that will
82 never repeat. Clients concerned with identity but not capable
83 of tracking time must use the serial_id for checks. */
84
85 SlvBackendToken instance; /* should be void * in the most generic case */
86
87 /* All solver handles. sysI can't be dereferenced outside slvI.c
88 * should be an array of pointers to arrays of the functions provided
89 * by dynamically loaded clients, or at least by the client which this
90 * system is currently supporting.
91 */
92
93 SlvClientToken ct;
94 /* This is a pointer that the client returns on registration.
95 * If it is not null, the registration was successful.
96 * This token will be handed back to the client code on all calls
97 * originating from here.
98 */
99
100 dof_t dof; /* non linear blocks */
101 dof_t logdof; /* logical blocks */
102
103 /* In the following NULL terminated lists, note that snum and mnum
104 * are the lengths of the arrays WITHOUT the NULL pointer at the end.
105 * Note objs is a list of relations that are objectives
106 * (e_maximize,e_minimize). this list will include the first included obj.
107 */
108 struct {
109 int snum; /* length of the solver list */
110 int mnum; /* length of the master list */
111 struct var_variable **solver;
112 struct var_variable **master;
113 struct var_variable *buf;
114 } vars;
115
116 struct {
117 int snum; /* length of the solver list */
118 int mnum; /* length of the master list */
119 struct dis_discrete **solver;
120 struct dis_discrete **master;
121 struct dis_discrete *buf;
122 int bufnum;
123 } dvars;
124
125 struct {
126 int snum; /* length of the solver list */
127 int mnum; /* length of the master list */
128 struct rel_relation **solver;
129 struct rel_relation **master;
130 struct rel_relation *buf;
131 } rels;
132
133 struct {
134 int snum;
135 int mnum;
136 struct rel_relation **solver;
137 struct rel_relation **master;
138 struct rel_relation *buf;
139 } objs;
140
141 struct {
142 int snum; /* length of the solver list */
143 int mnum; /* length of the master list */
144 struct rel_relation **solver;
145 struct rel_relation **master;
146 struct rel_relation *buf;
147 } condrels;
148
149 struct {
150 int snum; /* length of the solver list */
151 int mnum; /* length of the master list */
152 struct logrel_relation **solver;
153 struct logrel_relation **master;
154 struct logrel_relation *buf;
155 } logrels;
156
157 struct {
158 int snum; /* length of the solver list */
159 int mnum; /* length of the master list */
160 struct logrel_relation **solver;
161 struct logrel_relation **master;
162 struct logrel_relation *buf;
163 } condlogrels;
164
165 struct {
166 int snum; /* length of the solver list */
167 int mnum; /* length of the master list */
168 struct w_when **solver;
169 struct w_when **master;
170 struct w_when *buf;
171 int bufnum;
172 } whens;
173
174 struct {
175 int snum; /* length of the solver list */
176 int mnum; /* length of the master list */
177 struct bnd_boundary **solver;
178 struct bnd_boundary **master;
179 struct bnd_boundary *buf;
180 int bufnum;
181 } bnds;
182
183 struct {
184 int snum;
185 int mnum;
186 struct var_variable **solver;
187 struct var_variable **master;
188 struct var_variable *buf;
189 } pars;
190
191 struct {
192 int snum;
193 int mnum;
194 struct var_variable **solver;
195 struct var_variable **master;
196 struct var_variable *buf;
197 } unattached;
198
199 struct {
200 int snum;
201 int mnum;
202 struct dis_discrete **solver;
203 struct dis_discrete **master;
204 struct dis_discrete *buf;
205 } disunatt;
206
207 /* the data that follows is for internal consumption only. */
208 struct {
209 int num_extrels;
210 struct ExtRelCache **erlist;
211 } extrels;
212
213 struct rel_relation *obj; /* selected for optimization from list */
214 struct var_variable *objvar; /* selected for optimization from list */
215 struct gl_list_t *symbollist; /* list of symbol values struct used to */
216 /* assign an integer value to a symbol value */
217 struct {
218 struct var_variable **incidence; /* all relation incidence list memory */
219 struct rel_relation **varincidence; /* all variable incidence list memory */
220 struct dis_discrete **logincidence; /* all logrel incidence list memory */
221 long incsize; /* size of incidence array */
222 long varincsize; /* size of varincidence array */
223 long logincsize; /* size of discrete incidence array */
224 #if NEEDSTOBEDONE
225 /* we should be group allocating this data, but aren't */
226 struct ExtRelCache *ebuf; /* data space for all extrel caches */
227 #endif
228 } data;
229
230 int32 nmodels;
231 int32 need_consistency; /* consistency analysis required for conditional model ? */
232 real64 objvargrad; /* maximize -1 minimize 1 noobjvar 0 */
233 };
234
235 /**
236 global variable used to communicate information between solvers and
237 an interface, whether a calculation should be halted or not.
238 0 means go on. any other value may contain additional information
239 content.
240 */
241 int Solv_C_CheckHalt_Flag = 0;
242
243
244 /* ASC_EXPORT(int) g_SlvNumberOfRegisteredClients=0; */
245
246 /** making ANSI assumption that RegisteredClients is init to 0/NULLs */
247 static SlvFunctionsT SlvClientsData[SLVMAXCLIENTS];
248
249 /*-----------------------------------------------------------------*/
250 /**
251 Note about g_number_of_whens, g_number_of_dvars and g_number_of_bnds:
252 These numbers are as the same as those given in the solver and master
253 lists, however, these lists are destroyed before the buffers are destroyed,
254 so the information is gone before I can use it.
255 */
256 /*
257 These have been REMOVED and added to the 'sys' type.
258 */
259
260 /*-------------------------------------------------------------------
261 Convenience macros
262 */
263
264 /** Return the solver index for a given slv_system_t */
265 #define SNUM(sys) ((sys)->solver)
266
267 /** Number of registered clients */
268 #define NORC g_SlvNumberOfRegisteredClients
269
270 /** Return the pointer to a registered SLV client's data space. @see SF, related.
271 @param i registered solver ID
272 */
273 #define SCD(i) SlvClientsData[(i)]
274
275 /** Get the solver index for a system and return TRUE if the solver
276 index is in the range [0,NORC). 'sys' should not be null
277 @param sys system, slv_system_t.
278 */
279 #define LS(sys) ( (sys)->solver >= 0 && (sys)->solver < g_SlvNumberOfRegisteredClients )
280
281 /** Boolean test that i is in the range [0,NORC) */
282 #define LSI(i) ( (i) >= 0 && (i) < g_SlvNumberOfRegisteredClients )
283
284 /** Check and return a function pointer. See @SF */
285 #define CF(sys,ptr) ( LS(sys) ? SlvClientsData[(sys)->solver].ptr : NULL )
286
287 /** Return the pointer to the client-supplied function or char if
288 the client supplied one, else NULL. This should only be called
289 with nonNULL sys after CF is happy. @see CF
290 */
291 #define SF(sys,ptr) ( SlvClientsData[(sys)->solver].ptr )
292
293 /** Free a pointer provided it's not NULL */
294 #define SFUN(p) if ((p) != NULL) ascfree(p)
295
296 /*-----------------------------------------------------------------
297 SERVER FUNCTIONS
298 */
299
300 int slv_lookup_client( const char *solverName )
301 {
302 int i;
303 if (solverName == NULL) { return -1; }
304 for (i = 0; i < NORC; i++) {
305 if ( strcmp( SCD(i).name, solverName)==0) {
306 return i;
307 }
308 }
309 return -1;
310 }
311
312 /**
313 Register a new solver.
314
315 @TODO This needs work still, particularly of the dynamic loading
316 sort. it would be good if here we farmed out the dynamic loading
317 to another file so we don't have to crap this one all up.
318 */
319 int slv_register_client(SlvRegistration registerfunc, CONST char *func
320 ,CONST char *file, int *new_client_id)
321 {
322 int status;
323
324 UNUSED_PARAMETER(func);
325 UNUSED_PARAMETER(file);
326
327 status = registerfunc(&( SlvClientsData[NORC]));
328 if (!status) { /* ok */
329 SlvClientsData[NORC].number = NORC;
330 *new_client_id = NORC;
331 NORC++;
332 } else {
333 *new_client_id = -2;
334 ERROR_REPORTER_NOLINE(ASC_PROG_ERR,"Client %d registration failure (%d)!",NORC,status);
335 }
336 return status;
337 }
338
339 slv_system_t slv_create(void)
340 {
341 slv_system_t sys;
342 static unsigned nextid = 1;
343 sys = (slv_system_t)asccalloc(1,sizeof(struct slv_system_structure) );
344 /* all lists, sizes, pointers DEFAULT to 0/NULL */
345 sys->solver = -1; /* a nonregistration */
346 sys->serial_id = nextid++;
347 return(sys);
348 }
349
350 unsigned slv_serial_id(slv_system_t sys)
351 {
352 return sys->serial_id;
353 }
354
355 /*---------------------------------------------------------------
356 Macros to define
357 slv_set_incidence
358 slv_set_var_incidence
359 slv_set_logincidence
360 */
361
362 /* define but with error on null */
363 #define DEFINE_SET_INCIDENCE(NAME,PROP,TYPE,SIZE) \
364 void slv_set_##NAME(slv_system_t sys, struct TYPE **inc, long s){ \
365 if(sys->data.PROP != NULL){ \
366 Asc_Panic(2,"slv_set_" #NAME,"bad call: sys->data." #PROP " is already defined!"); \
367 }else if(inc == NULL){ \
368 ERROR_REPORTER_HERE(ASC_PROG_ERROR,"bad call: 'inc' parameter is NULL"); \
369 /*Asc_Panic(2,"slv_set_" #NAME,"bad call: 'inc' parameter is NULL!");*/ \
370 }else{ \
371 sys->data.PROP = inc; \
372 sys->data.SIZE = s; \
373 } \
374 }
375
376 /* define, no error on null */
377 #define DEFINE_SET_INCIDENCE_NONULLERROR(NAME,PROP,TYPE,SIZE) \
378 void slv_set_##NAME(slv_system_t sys, struct TYPE **inc, long s){ \
379 if(sys->data.PROP != NULL){ \
380 Asc_Panic(2,"slv_set_" #NAME,"bad call: sys->data." #PROP " is already defined!"); \
381 }else{ \
382 sys->data.PROP = inc; \
383 sys->data.SIZE = s; \
384 } \
385 }
386
387
388 #define DEFINE_SET_INCIDENCES(D,D1) \
389 D(incidence, incidence, var_variable, incsize) \
390 D(var_incidence, varincidence, rel_relation, varincsize) \
391 D1(logincidence, logincidence, dis_discrete, incsize)
392
393 DEFINE_SET_INCIDENCES(DEFINE_SET_INCIDENCE, DEFINE_SET_INCIDENCE_NONULLERROR)
394
395 /* see below for the use of this one */
396 #define SLV_FREE_INCIDENCE(NAME,PROP,TYPE,SIZE) \
397 if (sys->data.PROP != NULL) ascfree(sys->data.PROP); \
398 sys->data.PROP = NULL;
399
400 /*----------------------------------------------------
401 destructors
402 */
403
404 #define DEFINE_DESTROY_BUFFER(NAME,PROP,TYPE,DESTROY) \
405 static void slv_destroy_##NAME##_buffer(slv_system_t sys){ \
406 int c; struct TYPE *cur; \
407 struct TYPE *buf; \
408 buf = sys->PROP.buf; \
409 for(c = 0; c < sys->PROP.bufnum; c++){ \
410 cur = &(buf[c]); \
411 DESTROY(cur); \
412 } \
413 ascfree(buf); \
414 sys->PROP.buf = NULL; \
415 sys->PROP.bufnum = 0; \
416 }
417
418 #define DEFINE_DESTROY_BUFFERS(D) \
419 D(dvar, dvars, dis_discrete, dis_destroy) \
420 D(when, whens, w_when, when_destroy) \
421 D(bnd, bnds, bnd_boundary, bnd_destroy)
422
423 DEFINE_DESTROY_BUFFERS(DEFINE_DESTROY_BUFFER)
424
425 #define SLV_FREE_BUF(PROP) \
426 if(sys->PROP.buf !=NULL) ascfree(sys->PROP.buf); \
427 sys->PROP.buf = NULL;
428
429 #define SLV_FREE_BUF_GLOBAL(NAME, PROP) \
430 if (sys->PROP.buf != NULL) { \
431 slv_destroy_##NAME##_buffer(sys); \
432 }
433
434 #define SLV_FREE_BUFS(D,D_GLOBAL) \
435 D(vars) \
436 D(rels) \
437 D(objs) \
438 D(condrels) \
439 D(logrels) \
440 D(condlogrels) \
441 D(pars) \
442 D(unattached) \
443 D(disunatt) \
444 D_GLOBAL(dvar, dvars) \
445 D_GLOBAL(when, whens) \
446 D_GLOBAL(bnd, bnds)
447
448 int slv_destroy(slv_system_t sys)
449 {
450 int ret = 0;
451 if (sys->ct != NULL) {
452 if ( CF(sys,cdestroy) == NULL ) {
453 ERROR_REPORTER_HERE(ASC_PROG_FATAL,"slv_destroy: SlvClientToken 0x%p not freed by %s",
454 sys->ct,SF(sys,name));
455 } else {
456 if ( SF(sys,cdestroy)(sys,sys->ct) ) {
457 ret++;
458 }
459 }
460 }
461 if (ret) {
462 ERROR_REPORTER_HERE(ASC_PROG_FATAL,"slv_destroy: slv_system_t 0x%p not freed.",sys);
463 } else {
464
465 SLV_FREE_BUFS(SLV_FREE_BUF, SLV_FREE_BUF_GLOBAL)
466
467 DEFINE_SET_INCIDENCES(SLV_FREE_INCIDENCE,SLV_FREE_INCIDENCE)
468
469 ascfree( (POINTER)sys );
470 }
471 return ret;
472 }
473
474 /*---------------------------------------------------------------*/
475
476 void slv_destroy_client(slv_system_t sys)
477 {
478
479 if (sys->ct != NULL) {
480 if ( CF(sys,cdestroy) == NULL ) {
481 ERROR_REPORTER_HERE(ASC_PROG_ERR,
482 "SlvClientToken 0x%p not freed in slv_destroy_client",sys->ct);
483 } else {
484 if ( SF(sys,cdestroy)(sys,sys->ct) ) {
485 ERROR_REPORTER_HERE(ASC_PROG_ERR,"slv_destroy_client: SlvClientToken not freed");
486 } else {
487 sys->ct = NULL;
488 }
489 }
490 }
491 }
492
493 /*---------------------------------------------------------
494 get/set instance
495 */
496
497 SlvBackendToken slv_instance(slv_system_t sys)
498 {
499 if (sys == NULL) {
500 ERROR_REPORTER_HERE(ASC_PROG_ERR,"slv_instance: called with NULL system.");
501 return NULL;
502 } else {
503 return sys->instance;
504 }
505 }
506
507 void slv_set_instance(slv_system_t sys,SlvBackendToken instance)
508 {
509 if (sys == NULL) {
510 ERROR_REPORTER_HERE(ASC_PROG_ERR,"slv_set_instance: called with NULL system.");
511 return;
512 } else {
513 sys->instance = instance;
514 }
515 }
516
517 dof_t *slv_get_dofdata(slv_system_t sys)
518 {
519 return &(sys->dof);
520 }
521
522 dof_t *slv_get_log_dofdata(slv_system_t sys)
523 {
524 return &(sys->logdof);
525 }
526
527 int32 slv_get_num_models(slv_system_t sys)
528 {
529 if (sys == NULL) {
530 ERROR_REPORTER_HERE(ASC_PROG_ERR,"slv_get_num_models: called with NULL system.");
531 return 0;
532 } else {
533 return sys->nmodels;
534 }
535 }
536 void slv_set_num_models(slv_system_t sys, int32 nmod)
537 {
538 if (sys == NULL) {
539 ERROR_REPORTER_HERE(ASC_PROG_ERR,"slv_set_num_models: called with NULL system.");
540 } else {
541 sys->nmodels = nmod;
542 }
543 }
544
545
546 void slv_set_symbol_list(slv_system_t sys,
547 struct gl_list_t *sv)
548 {
549 if (sys->symbollist != NULL) {
550 DestroySymbolValuesList(sys->symbollist);
551 }
552 sys->symbollist = sv;
553 }
554
555 /*--------------------------------------------------------]
556 Macros to declare
557
558 slv_set_master_*_list(slv_system_t sys, string var_variable **list, int size)
559 slv_set_*_buf(slv_system_t sys, string var_variable **list, int size)
560 */
561
562 #define DEFINE_SET_MASTER_LIST_METHOD(NAME,PROP,TYPE) \
563 void slv_set_master_##NAME##_list(slv_system_t sys, struct TYPE **vlist, int size){ \
564 SFUN(sys->PROP.master); \
565 sys->PROP.mnum = size; \
566 sys->PROP.master = vlist; \
567 }
568
569
570
571 #define DEFINE_SET_MASTER_LIST_METHODS(D) \
572 D(var,vars,var_variable) \
573 D(par,pars,var_variable) \
574 D(unattached,unattached,var_variable) \
575 D(dvar,dvars,dis_discrete) \
576 D(disunatt,disunatt,dis_discrete) \
577 D(rel,rels,rel_relation) \
578 D(condrel,condrels,rel_relation) \
579 D(obj,objs,rel_relation) \
580 D(logrel,logrels,logrel_relation) \
581 D(condlogrel,condlogrels,logrel_relation) \
582 D(when,whens,w_when) \
583 D(bnd,bnds,bnd_boundary)
584
585 DEFINE_SET_MASTER_LIST_METHODS(DEFINE_SET_MASTER_LIST_METHOD)
586
587 /*------------------------------------------------------------
588 Macros to declare
589
590 slv_set_NAME_buf(slv_system_t sts, struct TYPE *PROP)
591 */
592
593 #define DEFINE_SET_BUF_METHOD(NAME,PROP,TYPE) \
594 void slv_set_##NAME##_buf(slv_system_t sys, struct TYPE *PROP){ \
595 if(sys->PROP.buf !=NULL ){ \
596 Asc_Panic(2,"slv_set_" #NAME "_buf","bad call."); \
597 }else{ \
598 sys->PROP.buf = PROP; \
599 } \
600 }
601
602 #define DEFINE_SET_BUF_METHOD_GLOBAL(NAME,PROP,TYPE) \
603 void slv_set_##NAME##_buf(slv_system_t sys, struct TYPE *buf, int len){ \
604 if(sys->PROP.buf != NULL){ \
605 Asc_Panic(2,"slv_set_" #NAME "_buf","bad call."); \
606 }else{ \
607 sys->PROP.buf = buf; \
608 sys->PROP.bufnum = len; \
609 } \
610 }
611
612 #define DEFINE_SET_BUF_METHODS(D, D_GLOBAL) \
613 D(var,vars,var_variable) \
614 D(par,pars,var_variable) \
615 D(unattached,unattached,var_variable) \
616 D(disunatt,disunatt,dis_discrete) \
617 D(rel,rels,rel_relation) \
618 D(condrel,condrels,rel_relation) \
619 D(obj,objs,rel_relation) \
620 D(logrel,logrels,logrel_relation) \
621 D(condlogrel,condlogrels,logrel_relation) \
622 D_GLOBAL(dvar, dvars, dis_discrete) \
623 D_GLOBAL(when, whens, w_when) \
624 D_GLOBAL(bnd,bnds,bnd_boundary)
625
626
627 DEFINE_SET_BUF_METHODS(DEFINE_SET_BUF_METHOD, DEFINE_SET_BUF_METHOD_GLOBAL)
628
629 void slv_set_extrel_list(slv_system_t sys,struct ExtRelCache **erlist,
630 int size)
631 {
632 if (sys->extrels.erlist !=NULL ) {
633 Asc_Panic(2,"slv_set_extrel_list",
634 "bad call.");
635 }
636 sys->extrels.num_extrels = size;
637 sys->extrels.erlist = erlist;
638 }
639
640 struct ExtRelCache **slv_get_extrel_list(slv_system_t sys)
641 {
642 return sys->extrels.erlist;
643 }
644
645 int slv_get_num_extrels(slv_system_t sys)
646 {
647 return sys->extrels.num_extrels;
648 }
649
650
651 /*********************************************************************\
652 client functions.
653 \*********************************************************************/
654 int Solv_C_CheckHalt()
655 {
656 if (Solv_C_CheckHalt_Flag)
657 return 1;
658 else
659 return 0;
660 }
661
662 const char *slv_solver_name(int sindex)
663 {
664 static char errname[] = "ErrorSolver";
665 if (sindex >= 0 && sindex < NORC) {
666 if ( SlvClientsData[sindex].name == NULL ) {
667 ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"slv_solver_name: unnamed solver: index='%d'",sindex);
668 return errname;
669 } else {
670 return SlvClientsData[sindex].name;
671 }
672 } else {
673 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_solver_name: invalid solver index '%d'", sindex);
674 return errname;
675 }
676 }
677
678 const mtx_block_t *slv_get_solvers_blocks(slv_system_t sys)
679 {
680 if (sys == NULL) {
681 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_get_solvers_blocks called with NULL system");
682 return NULL;
683 } else {
684 return &(sys->dof.blocks);
685 }
686 }
687
688 const mtx_block_t *slv_get_solvers_log_blocks(slv_system_t sys)
689 {
690 if (sys == NULL) {
691 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_get_solvers_log_blocks called with NULL system");
692 return NULL;
693 } else {
694 return &(sys->logdof.blocks);
695 }
696 }
697
698 void slv_set_solvers_blocks(slv_system_t sys,int len, mtx_region_t *data)
699 {
700 if (sys == NULL || len < 0) {
701 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_set_solvers_blocks called with NULL system or bad len.");
702 } else {
703 if (len && data==NULL) {
704 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_set_solvers_blocks called with bad data.");
705 } else {
706 if (sys->dof.blocks.nblocks && sys->dof.blocks.block != NULL) {
707 ascfree(sys->dof.blocks.block);
708 }
709 sys->dof.blocks.block = data;
710 sys->dof.blocks.nblocks = len;
711 }
712 }
713 }
714
715 void slv_set_solvers_log_blocks(slv_system_t sys,int len, mtx_region_t *data)
716 {
717 if (sys == NULL || len < 0) {
718 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_set_solvers_log_blocks called with NULL system or bad len.");
719 } else {
720 if (len && data==NULL) {
721 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_set_solvers_log_blocks called with bad data.");
722 } else {
723 if (sys->logdof.blocks.nblocks && sys->logdof.blocks.block != NULL) {
724 ascfree(sys->logdof.blocks.block);
725 }
726 sys->logdof.blocks.block = data;
727 sys->logdof.blocks.nblocks = len;
728 }
729 }
730 }
731
732 void slv_check_var_initialization(slv_system_t sys){
733 struct var_variable **vp;
734 for (vp = slv_get_solvers_var_list(sys); *vp != NULL; vp++) {
735 if (!AtomAssigned((struct Instance *)var_instance(*vp))) {
736 var_set_value(*vp,var_nominal(*vp));
737 }
738 }
739 }
740
741 void slv_check_dvar_initialization(slv_system_t sys)
742 {
743 struct dis_discrete **vp;
744
745 for (vp = slv_get_solvers_dvar_list(sys); *vp != NULL; vp++) {
746 if (!AtomAssigned((struct Instance *)dis_instance(*vp))) {
747 dis_set_boolean_value(*vp,1);
748 }
749 }
750 }
751
752
753 void slv_bnd_initialization(slv_system_t sys)
754 {
755 struct bnd_boundary **bp;
756 int32 value;
757
758 for (bp = slv_get_solvers_bnd_list(sys); *bp != NULL; bp++) {
759 value = bndman_calc_satisfied(*bp);
760 bnd_set_cur_status(*bp,value);
761 bnd_set_pre_status(*bp,value);
762 bnd_set_crossed(*bp,FALSE);
763 if (bnd_kind(*bp) == e_bnd_rel) {
764 value = bndman_calc_at_zero(*bp);
765 bnd_set_at_zero(*bp,value);
766 } else {
767 bnd_set_at_zero(*bp,FALSE);
768 }
769 }
770 }
771
772 struct gl_list_t *slv_get_symbol_list(slv_system_t sys)
773 {
774 if (sys==NULL) {
775 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_get_symbol_list called with NULL system.");
776 return NULL;
777 }
778 return sys->symbollist;
779 }
780
781 /*---------------------------------------------------------
782 Macros to define
783
784 slv_set_solvers_*_list
785 slv_get_solvers_*_list
786 slv_get_master_*_list
787 */
788 #define DEFINE_SET_SOLVERS_LIST_METHOD(NAME,PROP,TYPE) \
789 void slv_set_solvers_##NAME##_list(slv_system_t sys, struct TYPE **vlist, int size){ \
790 if(sys->PROP.master==NULL){ \
791 ERROR_REPORTER_NOLINE(ASC_PROG_ERR,"slv_set_solvers_" #NAME "_list: called before slv_set_master_" #NAME "_list."); \
792 /* might be ok, no return */ \
793 } \
794 sys->PROP.snum = size; \
795 sys->PROP.solver = vlist; \
796 }
797
798 #define DEFINE_SET_SOLVERS_LIST_METHOD_RETURN(NAME,PROP,TYPE) \
799 void slv_set_solvers_##NAME##_list(slv_system_t sys, struct TYPE **vlist, int size){ \
800 if(sys->PROP.master==NULL){ \
801 ERROR_REPORTER_NOLINE(ASC_PROG_ERR,"slv_set_solvers_" #NAME "_list: called before slv_set_master_" #NAME "_list."); \
802 return; /* can't be OK, so return now */ \
803 } \
804 sys->PROP.snum = size; \
805 sys->PROP.solver = vlist; \
806 }
807
808 #define DEFINE_GET_SOLVERS_LIST_METHOD(NAME,PROP,TYPE) \
809 struct TYPE **slv_get_solvers_##NAME##_list(slv_system_t sys){ \
810 if (sys->PROP.solver == NULL) { \
811 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_get_solvers_" #NAME "_list: returning NULL (?)."); \
812 } \
813 return sys->PROP.solver; \
814 }
815
816 #define DEFINE_GETSET_LIST_METHODS(D,D_RETURN) \
817 D_RETURN(var,vars,var_variable) \
818 D(par,pars,var_variable) \
819 D(unattached,unattached,var_variable) \
820 D_RETURN(dvar,dvars,dis_discrete) \
821 D(disunatt,disunatt,dis_discrete) \
822 D_RETURN(rel,rels,rel_relation) \
823 D_RETURN(obj,objs,rel_relation) \
824 D_RETURN(condrel,condrels,rel_relation) \
825 D_RETURN(logrel,logrels,logrel_relation) \
826 D_RETURN(condlogrel,condlogrels,logrel_relation) \
827 D_RETURN(when,whens,w_when) \
828 D_RETURN(bnd,bnds,bnd_boundary)
829
830 /* the slv_set_solvers_*_list methods: some have a 'return' when sys->PROP.master==NULL; others do not: */
831 DEFINE_GETSET_LIST_METHODS(DEFINE_SET_SOLVERS_LIST_METHOD, DEFINE_SET_SOLVERS_LIST_METHOD_RETURN) /*;*/
832
833 /* the slv_get_solvers_*_list methods: all have the same form so it's DEFINE...(D,D) in this case: */
834 DEFINE_GETSET_LIST_METHODS(DEFINE_GET_SOLVERS_LIST_METHOD, DEFINE_GET_SOLVERS_LIST_METHOD) /*;*/
835
836 #define DEFINE_GET_MASTER_LIST_METHOD(NAME,PROP,TYPE) \
837 struct TYPE **slv_get_master_##NAME##_list(slv_system_t sys){ \
838 if (sys->PROP.master == NULL) { \
839 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_get_master_" #NAME "_list returning NULL (?)."); \
840 } \
841 return sys->PROP.master; \
842 }
843
844 /* the slv_get_master_*_list are also all of the same form, so DEFINE...(D,D) */
845 DEFINE_GETSET_LIST_METHODS(DEFINE_GET_MASTER_LIST_METHOD,DEFINE_GET_MASTER_LIST_METHOD) /*;*/
846
847 /*----------------------------------------------------------------------
848 Macros to define:
849
850 slv_get_num_solvers_TYPE
851 slv_get_num_master_TYPE
852 */
853
854 #define DEFINE_SOLVERS_GET_NUM_METHOD(TYPE) \
855 int slv_get_num_solvers_##TYPE(slv_system_t sys){ \
856 if(sys==NULL){ \
857 ERROR_REPORTER_NOLINE(ASC_PROG_ERR,"slv_get_num_solvers_" #TYPE " called with NULL system."); \
858 return 0; \
859 } \
860 return sys->TYPE.snum; \
861 }
862
863 #define DEFINE_MASTER_GET_NUM_METHOD(TYPE) \
864 int slv_get_num_master_##TYPE(slv_system_t sys){ \
865 if(sys==NULL){ \
866 ERROR_REPORTER_NOLINE(ASC_PROG_ERR,"slv_get_num_master_" #TYPE " called with NULL system."); \
867 return 0; \
868 } \
869 return sys->TYPE.mnum; \
870 }
871
872 #define DEFINE_SLV_METHODS(D) \
873 D(vars) \
874 D(pars) \
875 D(unattached) \
876 D(dvars) \
877 D(disunatt) \
878 D(rels) \
879 D(condrels) \
880 D(objs) \
881 D(logrels) \
882 D(condlogrels) \
883 D(whens) \
884 D(bnds)
885
886 DEFINE_SLV_METHODS(DEFINE_SOLVERS_GET_NUM_METHOD) /*;*/
887 DEFINE_SLV_METHODS(DEFINE_MASTER_GET_NUM_METHOD) /*;*/
888
889 void slv_set_obj_relation(slv_system_t sys,struct rel_relation *obj)
890 {
891 if (sys==NULL) {
892 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_set_obj_relation called with NULL system (?).");
893 return;
894 }
895 sys->obj = obj;
896 }
897
898 struct rel_relation *slv_get_obj_relation(slv_system_t sys)
899 {
900 if (sys==NULL) {
901 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_get_obj_relation called with NULL system (?)");
902 return NULL;
903 }
904 return sys->obj;
905 }
906
907 void slv_set_obj_variable(slv_system_t sys,struct var_variable *objvar,
908 unsigned maximize)
909 {
910 if (sys==NULL) {
911 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_set_obj_variable called with NULL system.");
912 return;
913 }
914 sys->objvar = objvar;
915 if (objvar!=NULL) {
916 if (maximize) {
917 sys->objvargrad = -1;
918 } else {
919 sys->objvargrad = 1;
920 }
921 } else {
922 sys->objvargrad = 0;
923 }
924 }
925
926 struct var_variable *slv_get_obj_variable(slv_system_t sys)
927 {
928 if (sys==NULL) {
929 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_get_obj_variable called with NULL system.");
930 return NULL;
931 }
932 return sys->objvar;
933 }
934
935 real64 slv_get_obj_variable_gradient(slv_system_t sys)
936 {
937 if (sys==NULL) {
938 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_get_obj_variable_gradient called with NULL system.");
939 return 0.0;
940 }
941 return sys->objvargrad;
942 }
943
944
945 void slv_set_need_consistency(slv_system_t sys, int32 need_consistency)
946 {
947 if (sys==NULL) {
948 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_set_need_consistency called with NULL system.");
949 return;
950 }
951
952 sys->need_consistency = need_consistency;
953 }
954
955
956 int32 slv_need_consistency(slv_system_t sys)
957 {
958 if (sys==NULL) {
959 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_need_consistency called with NULL system.");
960 return 0;
961 }
962 return sys->need_consistency;
963 }
964
965 /*----------------------------------------------------------------
966 Macros to define
967
968 slv_count_vars
969 rels
970 dvars
971 logrels
972 whens
973 bnds
974 */
975
976 #define DEFINE_SLV_COUNT_METHOD(NAME,FILTER,TYPE) \
977 static int slv_count_##NAME(FILTER##_filter_t *filter, struct TYPE **list){ \
978 int ret=0; \
979 assert(list!=NULL); \
980 while(*list!=NULL){ \
981 ret += FILTER##_apply_filter(*list,filter); \
982 list++; \
983 } \
984 return ret; \
985 }
986
987 #define DEFINE_SLV_COUNT_METHODS(D) \
988 D(vars,var,var_variable) \
989 D(rels,rel,rel_relation) \
990 D(dvars,dis,dis_discrete) \
991 D(logrels,logrel,logrel_relation) \
992 D(whens,when,w_when) \
993 D(bnds,bnd,bnd_boundary)
994
995 DEFINE_SLV_COUNT_METHODS(DEFINE_SLV_COUNT_METHOD) /*;*/
996
997 /*--------------------------------------------------------------
998 Methods to define
999 slv_count_solvers_*
1000 slv_count_master_*
1001 */
1002
1003 /** This macro automates the declaration of the slv_count_solvers_* methods */
1004 #define DEFINE_SLV_COUNT_SOLVER_METHOD(NAME,PROP,TYPE,COUNT) \
1005 int slv_count_solvers_ ## NAME ( slv_system_t sys, TYPE ##_filter_t *xxx){ \
1006 if(sys==NULL || sys->PROP.solver == NULL || xxx==NULL){ \
1007 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_cound_solvers_" #NAME " called with NULL"); \
1008 return 0; \
1009 } \
1010 return slv_count_##COUNT(xxx,sys->PROP.solver); \
1011 }
1012
1013 /** This macro automates the declaration of the slv_count_master_* methods */
1014 #define DEFINE_SLV_COUNT_MASTER_METHOD(NAME,PROP,TYPE,COUNT) \
1015 int slv_count_master_ ## NAME ( slv_system_t sys, TYPE ##_filter_t *xxx){ \
1016 if(sys==NULL || sys->PROP.master == NULL || xxx==NULL){ \
1017 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_cound_master_" #NAME " called with NULL"); \
1018 return 0; \
1019 } \
1020 return slv_count_##COUNT(xxx,sys->PROP.master); \
1021 }
1022
1023 /** The macro makes all the various * declarations of the methods of type D (master or solvers) */
1024 #define DEFINE_COUNT_METHODS(D) \
1025 D(vars,vars,var,vars) \
1026 D(pars,pars,var,vars) \
1027 D(unattached,unattached,var,vars) \
1028 D(dvars,dvars,dis,dvars) \
1029 D(disunatt,disunatt,dis,dvars) \
1030 D(rels,rels,rel,rels) \
1031 D(condrels,condrels,rel,rels) \
1032 D(objs,objs,rel,rels) \
1033 D(logrels,logrels,logrel,logrels) \
1034 D(condlogrels,condlogrels,logrel,logrels) \
1035 D(whens,whens,when,whens) \
1036 D(bnds,bnds,bnd,bnds)
1037
1038 /** Invoke the DEFINE_COUNT_METHODS macro for SOLVERS methods */
1039 DEFINE_COUNT_METHODS(DEFINE_SLV_COUNT_SOLVER_METHOD) /*;*/
1040 /** Invoke the DEFINE_COUNT_METHODS macro for MASTER methods */
1041 DEFINE_COUNT_METHODS(DEFINE_SLV_COUNT_MASTER_METHOD) /*;*/
1042
1043 /*------------------------------------------------------*/
1044
1045 static void printwarning(const char * fname, slv_system_t sys)
1046 {
1047 ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,
1048 "%s called with bad registered client (%s).",fname,
1049 slv_solver_name(sys->solver));
1050 }
1051
1052 static void printinfo(slv_system_t sys, const char *rname)
1053 {
1054 if (CF(sys,name) == NULL ) {
1055 ERROR_REPORTER_NOLINE(ASC_PROG_NOTE,
1056 "Client %s does not support function '%s'.",
1057 slv_solver_name(sys->solver),rname);
1058 }
1059 }
1060
1061 int slv_eligible_solver(slv_system_t sys)
1062 {
1063 if ( CF(sys,celigible) == NULL ) {
1064 printwarning("slv_eligible_solver",sys);
1065 return 0;
1066 }
1067 return SF(sys,celigible)(sys);
1068 }
1069
1070 int slv_select_solver(slv_system_t sys,int solver){
1071
1072 int status_index;
1073 SlvClientDestroyF *destroy;
1074
1075 if (sys ==NULL) {
1076 ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"slv_select_solver called with NULL system.");
1077 return -1;
1078 }
1079 if ( solver >= 0 && solver < NORC ) {
1080 if (sys->ct != NULL && solver != sys->solver) {
1081 destroy = SlvClientsData[sys->solver].cdestroy;
1082 if(destroy!=NULL) {
1083 (destroy)(sys,sys->ct);
1084 sys->ct = NULL;
1085 } else {
1086 ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"slv_select_solver: 'cdestroy' is undefined on solver '%s' (index %d).",
1087 slv_solver_name(sys->solver), sys->solver);
1088 }
1089 }
1090
1091 if (sys->ct != NULL) {
1092 return sys->solver;
1093 }
1094
1095 status_index = solver;
1096 sys->solver = solver;
1097 if ( CF(sys,ccreate) != NULL) {
1098 sys->ct = SF(sys,ccreate)(sys,&status_index);
1099 } else {
1100 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_select_solver create failed due to bad client '%s'.",
1101 slv_solver_name(sys->solver));
1102 return sys->solver;
1103 }
1104 if (sys->ct==NULL) {
1105 ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"SlvClientCreate failed in slv_select_solver.");
1106 sys->solver = -1;
1107 } else {
1108 if (status_index) {
1109 ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"SlvClientCreate succeeded with warning %d %s.",
1110 status_index," in slv_select_solver");
1111 }
1112 /* we could do a better job explaining the client warnings... */
1113 sys->solver = solver;
1114 }
1115 } else {
1116 ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"slv_select_solver: invalid solver index '%d'.",
1117 solver);
1118 return -1;
1119 }
1120 return sys->solver;
1121 }
1122
1123
1124 int slv_switch_solver(slv_system_t sys,int solver)
1125 {
1126 int status_index;
1127
1128 if (sys ==NULL) {
1129 ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"slv_switch_solver called with NULL system.");
1130 return -1;
1131 }
1132 if( solver >= 0 && solver < g_SlvNumberOfRegisteredClients ){
1133 status_index = solver;
1134 sys->solver = solver;
1135 if ( CF(sys,ccreate) != NULL) {
1136 sys->ct = SF(sys,ccreate)(sys,&status_index);
1137 } else {
1138 ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"slv_switch_solver create failed due to bad client '%s'.",
1139 slv_solver_name(sys->solver));
1140 return sys->solver;
1141 }
1142 if (sys->ct==NULL) {
1143 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"SlvClientCreate failed in slv_switch_solver.");
1144 sys->solver = -1;
1145 } else {
1146 if (status_index) {
1147 ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"SlvClientCreate succeeded with warning %d %s.",
1148 status_index," in slv_switch_solver");
1149 }
1150 sys->solver = solver;
1151 }
1152 } else {
1153 ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"slv_switch_solver called with unknown client '%d'.",solver);
1154 return -1;
1155 }
1156 return sys->solver;
1157 }
1158
1159 void slv_set_char_parameter(char **cp, CONST char *newvalue)
1160 {
1161 if (cp != NULL) {
1162 if (*cp != NULL) {
1163 ascfree(*cp);
1164 }
1165 *cp = ascstrdup(newvalue);
1166 }
1167 }
1168
1169 void slv_destroy_parms(slv_parameters_t *p) {
1170 int32 i,j;
1171 for(i = 0; i < p->num_parms; i++){
1172 switch(p->parms[i].type) {
1173 case char_parm:
1174 ASC_FREE(p->parms[i].info.c.value);
1175 for (j = 0; j < p->parms[i].info.c.high; j++) {
1176 ASC_FREE(p->parms[i].info.c.argv[j]);
1177 }
1178 ASC_FREE(p->parms[i].info.c.argv);
1179 /* FALL THROUGH */
1180 case int_parm:
1181 case bool_parm:
1182 case real_parm:
1183 ASC_FREE(p->parms[i].name);
1184 ASC_FREE(p->parms[i].interface_label);
1185 ASC_FREE(p->parms[i].description);
1186 break;
1187 default:
1188 ERROR_REPORTER_NOLINE(ASC_PROG_WARNING,"Unrecognized parameter type in slv_destroy_parms.");
1189 }
1190 }
1191 if (p->parms && p->dynamic_parms) {
1192 ASC_FREE(p->parms);
1193 }
1194 CONSOLE_DEBUG("Destroyed slv_parameters_t");
1195 }
1196
1197 /*------------------------------------------------------------------------------
1198 IMPROVED (says I) FUNCTIONS FOR DECLARING SOLVER PARAMETERS -- JP
1199 */
1200 /** @page solver-parameters
1201
1202 Additional info on new solver parameter routines. This routine attempts
1203 to make declaration of new parameters possible with simple syntax, without
1204 requiring changes to the underlying data structure. Also aim to eliminate
1205 the extensive #defines used in the old approach, and eliminate the risk of
1206 messing up the parameter list by forgetting to update something.
1207
1208 Usage:
1209 1. declare IDs for the parameters you'll be using via an 'enum'
1210 (last ID is XXXX_PARAMS_COUNT)
1211 2. allocate space for your slv_parameters_t::parms of size XXXX_PARAMS_COUNT
1212 3. for each parameter, call slv_param_* as follows:
1213
1214 slv_param_int(p,XXXX_PARAM_NAME,(SlvParameterInitInt){
1215 {"codename","guiname",3 (==guipagenum) "description"}
1216 ,1 (==default value) ,0 (==min), 100 (==max)
1217 });
1218
1219 4. to access a value from your code, use SLV_PARAM_BOOL(p,XXX_PARAM_NAME) etc
1220 (as defined in slv_common.h)
1221
1222 See example stuff in ida.c
1223 */
1224
1225 static void slv_define_param_meta(struct slv_parameter *p1, const SlvParameterInitMeta *meta, const int index){
1226 /* copy the codename, guiname and description */
1227 asc_assert(meta!=NULL);
1228 asc_assert(p1!=NULL);
1229 p1->name = ascstrdup(meta->codename);
1230 p1->interface_label = ascstrdup(meta->guiname);
1231 p1->description = ascstrdup(meta->description);
1232 p1->display = meta->guipagenum;
1233
1234 /* record the index of this parameter */
1235 p1->number = index;
1236 }
1237
1238 int slv_param_int(slv_parameters_t *p, const int index
1239 ,const SlvParameterInitInt init
1240 ){
1241 struct slv_parameter *p1;
1242 if(p == NULL)return -1;
1243 p1 = &(p->parms[index]);
1244
1245 p1->type = int_parm;
1246 p1->info.i.value = init.val;
1247 p1->info.i.low = init.low;
1248 p1->info.i.high = init.high;
1249
1250 slv_define_param_meta(p1, &(init.meta), index);
1251 return ++(p->num_parms);
1252 }
1253
1254 int slv_param_bool(slv_parameters_t *p, const int index
1255 ,const SlvParameterInitBool init
1256 ){
1257 struct slv_parameter *p1;
1258 if(p == NULL)return -1;
1259 p1 = &(p->parms[index]);
1260
1261 p1->type = bool_parm;
1262 p1->info.b.value = init.val;
1263 p1->info.b.low = 0;
1264 p1->info.b.high = 1;
1265
1266 slv_define_param_meta(p1, &(init.meta), index);
1267 return ++(p->num_parms);
1268 }
1269
1270 int slv_param_real(slv_parameters_t *p, const int index
1271 ,const SlvParameterInitReal init
1272 ){
1273 struct slv_parameter *p1;
1274
1275 if(p == NULL)return -1;
1276 p1 = &(p->parms[index]);
1277
1278 p1->type = real_parm;
1279 p1->info.r.value = init.val;
1280 p1->info.r.low = init.low;
1281 p1->info.r.high = init.high;
1282
1283 slv_define_param_meta(p1, &(init.meta), index);
1284 return ++(p->num_parms);
1285 }
1286
1287 int slv_param_char(slv_parameters_t *p, const int index
1288 ,const SlvParameterInitChar init
1289 ,const char **options
1290 ){
1291 int i, noptions;
1292 struct slv_parameter *p1;
1293 if(p == NULL)return -1;
1294 p1 = &(p->parms[index]);
1295 p1->type = char_parm;
1296
1297 /* find the length by hunting for the NULL at the end */
1298 for(i=0; options[i]!=NULL; ++i);/*
1299 CONSOLE_DEBUG("FOUND init.options[%d]='%s'",i,options[i]);
1300 }*/
1301 noptions = i;
1302 /* CONSOLE_DEBUG("THERE ARE %d CHAR OPTIONS IN PARAMETER '%s'", noptions, init.meta.codename); */
1303
1304 p1->info.c.high = noptions;
1305 p1->info.c.value = strdup(init.val);
1306 p1->info.c.argv = ASC_NEW_ARRAY(char *,noptions);
1307
1308 for(i = 0; i < noptions; ++i){
1309 p1->info.c.argv[i] = ascstrdup(options + i);
1310 }
1311
1312 slv_define_param_meta(p1, &(init.meta), index);
1313 return ++(p->num_parms);
1314 }
1315
1316 int32 slv_define_parm(slv_parameters_t *p,
1317 enum parm_type type,
1318 char *name,
1319 char *interface_label,
1320 char *description,
1321 union parm_arg value,
1322 union parm_arg low,
1323 union parm_arg high,
1324 int32 display)
1325 {
1326 int32 len,length,i, err=1;
1327 if (p == NULL) {
1328 return -1;
1329 }
1330 length = p->num_parms;
1331
1332 switch (type) {
1333 case int_parm:
1334 err = 0;
1335 p->parms[length].info.i.value = value.argi;
1336 p->parms[length].info.i.low = low.argi;
1337 p->parms[length].info.i.high = high.argi;
1338 break;
1339
1340 case bool_parm:
1341 err = 0;
1342 p->parms[length].info.b.value = value.argb;
1343 p->parms[length].info.b.low = low.argb;
1344 p->parms[length].info.b.high = high.argb;
1345 break;
1346
1347 case real_parm:
1348 err = 0;
1349 p->parms[length].info.r.value = value.argr;
1350 p->parms[length].info.r.low = low.argr;
1351 p->parms[length].info.r.high = high.argr;
1352 break;
1353
1354 case char_parm:
1355 err = 0;
1356 p->parms[length].info.c.argv =
1357 (char **)ascmalloc(high.argi*sizeof(char *));
1358 for (i = 0; i < high.argi; i++) {
1359 len = strlen(low.argv[i]);
1360 p->parms[length].info.c.argv[i] =ASC_NEW_ARRAY(char,len+1);
1361 strcpy(p->parms[length].info.c.argv[i],low.argv[i]);
1362 }
1363
1364 p->parms[length].info.c.value =
1365 (char *)ascmalloc(strlen(value.argc)+1*sizeof(char));
1366 strcpy(p->parms[length].info.c.value,value.argc);
1367
1368 p->parms[length].info.c.high = high.argi;
1369 break;
1370
1371 default:
1372 return -1;
1373 }
1374 if (!err) {
1375 p->parms[length].type = type;
1376 p->parms[length].number = length;
1377
1378 len = strlen(name);
1379 p->parms[length].name = ASC_NEW_ARRAY(char,len+1);
1380 strcpy(p->parms[length].name,name);
1381
1382 len = strlen(interface_label);
1383 p->parms[length].interface_label = ASC_NEW_ARRAY(char,len+1);
1384 strcpy(p->parms[length].interface_label,interface_label);
1385
1386 len = strlen(description);
1387 p->parms[length].description = ASC_NEW_ARRAY(char,len+1);
1388 strcpy(p->parms[length].description,description);
1389
1390 p->parms[length].display = display;
1391 } else {
1392 p->parms[length].type = -1;
1393 }
1394 p->num_parms++;
1395 return p->num_parms;
1396 }
1397
1398 /*--------------------------------*/
1399
1400
1401 int slv_get_selected_solver(slv_system_t sys)
1402 {
1403 if (sys!=NULL) return sys->solver;
1404 return -1;
1405 }
1406
1407 int32 slv_get_default_parameters(int sindex,
1408 slv_parameters_t *parameters)
1409 {
1410 if (sindex >= 0 && sindex < NORC) {
1411 if ( SlvClientsData[sindex].getdefparam == NULL ) {
1412 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_get_default_parameters called with parameterless index.");
1413 return 0;
1414 } else {
1415 /* send NULL system when setting up interface */
1416 (SlvClientsData[sindex].getdefparam)(NULL,NULL,parameters);
1417 return 1;
1418 }
1419 } else {
1420 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_get_default_parameters called with unregistered index.");
1421 return 0;
1422 }
1423 }
1424
1425 /*-----------------------------------------------------------
1426 These macros do some more elimination of repetition. Here we're
1427 trying to replace some more complex 'method-like' calls on
1428 slv_system_t:
1429
1430 These macros use macro-argument-concatenation and macro stringification.
1431 Verified that the former works with Visual C++:
1432 getlinso://www.codeproject.com/macro/metamacros.asp
1433 */
1434
1435 /** Define a method like 'void slv_METHODNAME(sys)' */
1436 #define DEFINE_SLV_PROXY_METHOD_VOID(METHOD) \
1437 void slv_ ## METHOD (slv_system_t sys){ \
1438 if(CF(sys,METHOD)==NULL){ \
1439 printwarning(#METHOD,sys); \
1440 return; \
1441 } \
1442 SF(sys,METHOD)(sys,sys->ct); \
1443 }
1444
1445 /** Define a method like 'RETURNTYPE slv_METHOD(sys)'; */
1446 #define DEFINE_SLV_PROXY_METHOD(METHOD,PROP,RETTYPE,ERRVAL) \
1447 RETTYPE slv_ ## METHOD (slv_system_t sys){ \
1448 if(CF(sys,PROP)==NULL){ \
1449 printinfo(sys, #METHOD); \
1450 return ERRVAL; \
1451 } \
1452 return SF(sys,PROP)(sys,sys->ct); \
1453 }
1454
1455 /** Define a method like 'void slv_METHOD(sys,TYPE PARAMNAME)'; */
1456 #define DEFINE_SLV_PROXY_METHOD_PARAM(METHOD,PROP,PARAMTYPE,PARAMNAME) \
1457 void slv_ ## METHOD (slv_system_t sys, PARAMTYPE PARAMNAME){ \
1458 if(CF(sys,PROP)==NULL){ \
1459 printwarning(#METHOD,sys); \
1460 return; \
1461 } \
1462 SF(sys,PROP)(sys,sys->ct, PARAMNAME); \
1463 }
1464
1465 DEFINE_SLV_PROXY_METHOD_PARAM(get_parameters,getparam,slv_parameters_t*,parameters) /*;*/
1466
1467 void slv_set_parameters(slv_system_t sys,slv_parameters_t *parameters)
1468 {
1469 if ( CF(sys,setparam) == NULL ) {
1470 printwarning("slv_set_parameters",sys);
1471 return;
1472 }
1473 if (parameters->whose != sys->solver) {
1474 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,
1475 "slv_set_parameters cannot pass parameters from one solver to a"
1476 " another.");
1477 return;
1478 }
1479 SF(sys,setparam)(sys,sys->ct,parameters);
1480 }
1481
1482 DEFINE_SLV_PROXY_METHOD_PARAM(get_status,getstatus,slv_status_t*,status) /*;*/
1483 DEFINE_SLV_PROXY_METHOD(get_linsol_sys, getlinsol, linsol_system_t, NULL) /*;*/
1484 DEFINE_SLV_PROXY_METHOD(get_sys_mtx, getsysmtx, mtx_matrix_t, NULL) /*;*/
1485 DEFINE_SLV_PROXY_METHOD(get_linsolqr_sys, getlinsys, linsolqr_system_t, NULL) /*;*/
1486 DEFINE_SLV_PROXY_METHOD_PARAM(dump_internals,dumpinternals,int,level) /*;*/
1487 DEFINE_SLV_PROXY_METHOD_VOID(presolve) /*;*/
1488 DEFINE_SLV_PROXY_METHOD_VOID(resolve) /*;*/
1489 DEFINE_SLV_PROXY_METHOD_VOID(iterate) /*;*/
1490 DEFINE_SLV_PROXY_METHOD_VOID(solve) /*;*/
1491
1492 /*-----------------------------------------------------------*/
1493
1494 SlvClientToken slv_get_client_token(slv_system_t sys)
1495 {
1496 if (sys==NULL) {
1497 FPRINTF(stderr,"slv_get_client_token called with NULL system.");
1498 return NULL;
1499 }
1500 return sys->ct;
1501 }
1502
1503
1504 void slv_set_client_token(slv_system_t sys, SlvClientToken ct)
1505 {
1506 if (sys==NULL) {
1507 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_set_client_token called with NULL system.");
1508 return;
1509 }
1510 sys->ct = ct;
1511 }
1512
1513 void slv_set_solver_index(slv_system_t sys, int solver)
1514 {
1515 if (sys==NULL) {
1516 ERROR_REPORTER_NOLINE(ASC_PROG_ERROR,"slv_set_solver_index called with NULL system.");
1517 return;
1518 }
1519 sys->solver = solver;
1520 }
1521
1522 /*********************************************************************\
1523 unregistered client functions that need to go elsewhere(other files).
1524 hereunder are utility calls which are unstandardized
1525 \*********************************************************************/
1526
1527 boolean slv_change_basis(slv_system_t sys, int32 var, mtx_range_t *rng)
1528 {
1529 (void)sys;
1530 (void)var;
1531 (void)rng;
1532 Asc_Panic(2, "slv_change_basis", "fix me");
1533 return 0;
1534 }
1535
1536 /*
1537 * This routine is provided as the start of some report generation
1538 * capabilities. It operates off the main solve system and
1539 * writes out the relation residuals and variable values for
1540 * the entire problem to the named file.
1541 * Isn't very bright.
1542 */
1543
1544 void slv_print_output(FILE *out, slv_system_t sys)
1545 {
1546 struct rel_relation **rp;
1547 struct var_variable **vp;
1548 int nrels, nvars,c;
1549
1550 vp = slv_get_master_var_list(sys);
1551 nvars = slv_get_num_master_vars(sys);
1552 FPRINTF(out,"%-6s %-12s\n",
1553 "INDEX","LEVEL");
1554 for (c=0; c<nvars; c++) {
1555 FPRINTF(out," % -6d % -12.8e\n",c, var_value(vp[c]));
1556 }
1557 PUTC('\n',out);
1558
1559 rp = slv_get_master_rel_list(sys);
1560 nrels = slv_get_num_master_rels(sys);
1561 FPRINTF(out,"%-6s %-12s\n",
1562 "INDEX","RESDUAL");
1563 for (c=0; c<nrels; c++) {
1564 FPRINTF(out," % -6d % -12.8e\n",c, rel_residual(rp[c]));
1565 }
1566 }
1567
1568 int32 slv_obj_select_list(slv_system_t sys,int32 **rip)
1569 {
1570 int32 len,count,i, *ra;
1571 static rel_filter_t rfilter;
1572 struct rel_relation **rlist=NULL;
1573 len = slv_get_num_solvers_objs(sys);
1574 ra = *rip = (int32 *)ascmalloc((len+1)*sizeof(int32 *));
1575 rfilter.matchbits = (REL_INCLUDED);
1576 rfilter.matchvalue =(REL_INCLUDED);
1577 rlist = slv_get_solvers_obj_list(sys);
1578 count = 0;
1579 for (i = 0; i < len; i++) {
1580 if (rel_apply_filter(rlist[i],&rfilter)) {
1581 ra[count] = i;
1582 count++;
1583 }
1584 }
1585 ra[count] = -1;
1586 return count;
1587 }
1588
1589 int32 slv_get_obj_num(slv_system_t sys)
1590 {
1591 int32 len,i;
1592 struct rel_relation *obj;
1593 struct rel_relation **rlist=NULL;
1594 len = slv_get_num_solvers_objs(sys);
1595 rlist = slv_get_solvers_obj_list(sys);
1596 obj = slv_get_obj_relation(sys);
1597 if (obj != NULL) {
1598 for (i = 0; i < len; i++) {
1599 if (rlist[i] == obj) {
1600 return i;
1601 }
1602 }
1603 }
1604 return -1;
1605 }
1606
1607 int32 slv_near_bounds(slv_system_t sys,real64 epsilon,
1608 int32 **vip)
1609 {
1610 int32 len,i, *va, vindex;
1611 real64 comp;
1612 static var_filter_t vfilter;
1613 struct var_variable **vlist=NULL;
1614 len = slv_get_num_solvers_vars(sys);
1615 va = *vip = (int32 *)ascmalloc((2*len+2)*sizeof(int32 *));
1616 vfilter.matchbits = (VAR_FIXED | VAR_INCIDENT | VAR_SVAR | VAR_ACTIVE);
1617 vfilter.matchvalue = (VAR_INCIDENT | VAR_SVAR | VAR_ACTIVE);
1618 vlist = slv_get_solvers_var_list(sys);
1619 va[0] = va[1] = 0;
1620 vindex = 2;
1621 for (i = 0; i < len; i++) {
1622 if (var_apply_filter(vlist[i],&vfilter)) {
1623 comp = (var_value(vlist[i]) - var_lower_bound(vlist[i]))
1624 / var_nominal(vlist[i]);
1625 if (comp < epsilon) {
1626 va[vindex] = i;
1627 vindex++;
1628 va[0]++;
1629 }
1630 }
1631 }
1632 for (i = 0; i < len; i++) {
1633 if (var_apply_filter(vlist[i],&vfilter)) {
1634 comp = (var_upper_bound(vlist[i]) - var_value(vlist[i]))
1635 / var_nominal(vlist[i]);
1636 if (comp < epsilon) {
1637 va[vindex] = i;
1638 vindex++;
1639 va[1]++;
1640 }
1641 }
1642 }
1643 return vindex - 2;
1644 }
1645
1646 int32 slv_far_from_nominals(slv_system_t sys,real64 bignum,
1647 int32 **vip)
1648 {
1649 int32 len,i, *va, vindex;
1650 real64 comp;
1651 static var_filter_t vfilter;
1652 struct var_variable **vlist=NULL;
1653 len = slv_get_num_solvers_vars(sys);
1654 va = *vip = (int32 *)ascmalloc((len+1)*sizeof(int32 *));
1655 vfilter.matchbits = (VAR_FIXED | VAR_INCIDENT | VAR_SVAR | VAR_ACTIVE);
1656 vfilter.matchvalue = (VAR_INCIDENT | VAR_SVAR | VAR_ACTIVE);
1657 vlist = slv_get_solvers_var_list(sys);
1658 vindex = 0;
1659 for (i = 0; i < len; i++) {
1660 if (var_apply_filter(vlist[i],&vfilter)) {
1661 comp = fabs(var_value(vlist[i]) - var_nominal(vlist[i]))
1662 / var_nominal(vlist[i]);
1663 if (comp > bignum) {
1664 va[vindex] = i;
1665 vindex++;
1666 }
1667 }
1668 }
1669 return vindex;
1670 }
1671

john.pye@anu.edu.au
ViewVC Help
Powered by ViewVC 1.1.22