1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
|
/**************************************
* Copyright Jean-Philippe Chancelier
* ENPC
**************************************/
#include "../machine.h"
#include "../sun/addinter.h" /* for DynInterfStart */
#include <setjmp.h>
static jmp_buf jmp_env;
extern int C2F(matdsc) __PARAMS((void));
extern int C2F(matdsr) __PARAMS((void));
extern int C2F(userlk) __PARAMS((int *));
extern int C2F(error) __PARAMS((int *));
extern void sciprint __PARAMS((char* ,...));
/***********************************************************
* interface function
***********************************************************/
static int Iflag=0; /* special flag for matdsr matdsc */
void C2F(MatdsRC)()
{
if (Iflag == 1)
C2F(matdsc)();
else
C2F(matdsr)();
}
static int c_local = 9999;
void C2F(NoTksci)()
{
sciprint("tksci interface not loaded \n");
C2F(error)(&c_local);
return;
}
void C2F(NoPvm)()
{
sciprint("pvm interface not loaded \n");
C2F(error)(&c_local);
return;
}
/** table of interfaces **/
typedef struct {
void (*fonc)();} OpTab ;
#include "callinterf.h"
/***********************************************************
* call the apropriate interface according to the value of k
* iflagint is only used inside MatdsRC to switch between
* matdsc or matdsr
***********************************************************/
int C2F(callinterf)(k,iflagint)
int *k,*iflagint;
{
int returned_from_longjump ;
static count = 0;
Iflag=*iflagint;
if ( count == 0)
{
if (( returned_from_longjump = setjmp(jmp_env)) != 0 )
{
count = 0;
return 0;
}
}
count++;
if (*k > DynInterfStart)
C2F(userlk)(k);
else
(*(Interfaces[*k-1].fonc))();
count--;
return 0;
}
/***********************************************************
* Unused function just here to force linker to load some
* functions
***********************************************************/
extern int Blas_contents __PARAMS((int));
extern int Lapack_contents __PARAMS((int));
extern int Calelm_contents __PARAMS((int));
extern int Sun_contents __PARAMS((int));
extern int System2_contents __PARAMS((int));
extern int System_contents __PARAMS((int));
extern int Intersci_contents __PARAMS((int));
int ForceLink()
{
Blas_contents(0);
Lapack_contents(0);
Calelm_contents(0);
Sun_contents(0);
System2_contents(0);
System_contents(0);
Intersci_contents(0);
return 0;
}
extern int errjump()
{
longjmp(jmp_env,-1);
}
|
