← Back to branch summary

~ubuntu-branches/ubuntu/utopic/critcl/utopic

« back to all changes in this revision

Viewing changes to lib/critclf/pkg_wrap.c

  • Committer: Package Import Robot
  • Author(s): Andrew Shadura
  • Date: 2013-05-11 00:08:06 UTC
  • Revision ID: package-import@ubuntu.com-20130511000806-7hq1zc3fnn0gat79
Tags: upstream-3.1.9
Import upstream version 3.1.9

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/critclf/pkg_wrap.c
 
1
/* Simple wrapper
 
2
*/
 
3
/* Include files
 
4
*/
 
5
#include <stdlib.h>
 
6
#include <stdio.h>
 
7
#include <string.h>
 
8
#include <math.h>
 
9
#include <limits.h>
 
10
#include <float.h>
 
11
 
 
12
#include "tcl.h"
 
13
 
 
14
#define EXPORT_FUNC __declspec(dllexport)
 
15
 
 
16
EXPORT_FUNC int PKGINIT_Init( Tcl_Interp *interp ) ;
 
17
 
 
18
#include "wrapfort_lib.c"
 
19
 
 
20
static Tcl_Interp *saved_interp; /* TODO: allow several interpreters! */
 
21
 
 
22
#if defined(__unix)
 
23
#define __stdcall
 
24
#endif
 
25
#include "FILENAME"
 
26
 
 
27
 
 
28
#ifdef CRITCLF
 
29
TclStubs *tclStubsPtr;
 
30
TclPlatStubs *tclPlatStubsPtr;
 
31
struct TclIntStubs *tclIntStubsPtr;
 
32
struct TclIntPlatStubs *tclIntPlatStubsPtr;
 
33
 
 
34
static int
 
35
MyInitTclStubs (Tcl_Interp *ip)
 
36
{
 
37
    typedef struct {
 
38
        char *result;
 
39
        Tcl_FreeProc *freeProc;
 
40
        int errorLine;
 
41
        TclStubs *stubTable;
 
42
    } HeadOfInterp;
 
43
 
 
44
    HeadOfInterp *hoi = (HeadOfInterp*) ip;
 
45
 
 
46
    if (hoi->stubTable == NULL || hoi->stubTable->magic != TCL_STUB_MAGIC) {
 
47
        ip->result = "This extension requires stubs-support.";
 
48
        ip->freeProc = TCL_STATIC;
 
49
        return 0;
 
50
    }
 
51
 
 
52
    tclStubsPtr = hoi->stubTable;
 
53
 
 
54
    if (Tcl_PkgRequire(ip, "Tcl", "8.1", 0) == NULL) {
 
55
        tclStubsPtr = NULL;
 
56
        return 0;
 
57
    }
 
58
 
 
59
    if (tclStubsPtr->hooks != NULL) {
 
60
        tclPlatStubsPtr = tclStubsPtr->hooks->tclPlatStubs;
 
61
        tclIntStubsPtr = tclStubsPtr->hooks->tclIntStubs;
 
62
        tclIntPlatStubsPtr = tclStubsPtr->hooks->tclIntPlatStubs;
 
63
    }
 
64
 
 
65
    return 1;
 
66
}
 
67
#endif
 
68
 
 
69
int PKGINIT_Init( Tcl_Interp *interp )
 
70
{
 
71
   int retcode ;
 
72
   int error   ;
 
73
 
 
74
/* Register the Fortran logical values
 
75
*/
 
76
/* TODO
 
77
   ftcl_init_log( &ftcl_true, &ftcl_false ) ;
 
78
*/
 
79
 
 
80
/* Initialise the stubs
 
81
*/
 
82
#ifdef USE_TCL_STUBS
 
83
#ifndef CRITCLF
 
84
    if (Tcl_InitStubs(interp, "8.0", 0) == NULL) {
 
85
       return TCL_ERROR;
 
86
    }
 
87
#else
 
88
    if (MyInitTclStubs(interp) == 0) {
 
89
       return TCL_ERROR;
 
90
    }
 
91
#endif
 
92
#endif
 
93
 
 
94
 
 
95
/* Inquire about the package's version
 
96
*/
 
97
    if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 0) == NULL)
 
98
    {
 
99
       if (TCL_VERSION[0] == '7')
 
100
       {
 
101
          if (Tcl_PkgRequire(interp, "Tcl", "8.0", 0) == NULL)
 
102
          {
 
103
             return TCL_ERROR;
 
104
          }
 
105
       }
 
106
    }
 
107
 
 
108
    if (Tcl_PkgProvide(interp, "PKGNAME", "1.0") != TCL_OK)
 
109
    {
 
110
       return TCL_ERROR;
 
111
    }
 
112
 
 
113
/* Register the package's commands
 
114
*/
 
115
   retcode = TCL_OK ;
 
116
 
 
117
#include "TCLFNAME"
 
118
 
 
119
   return retcode ;
 
120
}
 
121
 
 
122
/* End of file ftempl.c */