source: tol/vbtol/source/vbtol.cpp @ 171e6a0

1941-docker-image-to-testdevel
Last change on this file since 171e6a0 was 171e6a0, checked in by Pedro Gea <pgea@…>, 11 years ago

Refs #1910
Se incorporan los CMakeLists.txt
Se modifica el código para incorpora rlas diferencias entre los dos compiladores en Windows.

git-svn-id: ​https://www.tol-project.org/svn/tolp/trunk@7188 be4846ae-f051-483a-831f-b64e7d08527f

  • Property mode set to 100644
File size: 4.8 KB
Line 
1/* VBTol.cpp: This file implements a Visual Basic interface to Tol.
2               GNU/tolTcl Library
3
4   Copyright (C) 2001, 2002, 2003 - Bayes Decisión, SL
5
6   This program is free software; you can redistribute it and/or modify
7   it under the terms of the GNU General Public License as published by
8   the Free Software Foundation; either version 2, or (at your option)
9   any later version.
10
11   This program is distributed in the hope that it will be useful,
12   but WITHOUT ANY WARRANTY; without even the implied warranty of
13   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14   GNU General Public License for more details.
15
16   You should have received a copy of the GNU General Public License
17   along with this program; if not, write to the Free Software
18   Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
19   USA.
20 */
21
22#include <windows.h>
23#if defined(_MSC_VER)
24  #include <config.h>
25  #include <tol_init.h>
26  #include <tol_bout.h>
27  #include <tol_list.h>
28#else
29  #include <tol/config.h>
30  #include <tol/tol_init.h>
31  #include <tol/tol_bout.h>
32  #include <tol/tol_list.h>
33#endif
34
35#include "vbutils.h"
36
37/*
38 *  Decompile all Tol objects
39 *
40 *  returns 1 if there was some object to be decompiled, otherwise returns 0
41 */
42//---------------------------------------------------------------------------
43DLLEXPORT(short) TolDecompileAll()
44//---------------------------------------------------------------------------
45{
46  BList *P = VB_stack.Cdr();
47  short ret = P!=NULL;
48 
49  while (P) {
50    BSyntaxObject * so = (BSyntaxObject*)(P->Car());
51        VB_stack.PutCdr(P->Cdr());
52    delete P;
53    DESTROY(so);
54        P = VB_stack.Cdr();
55  }
56  return ret;
57}
58
59/*
60 *  Decompile a Tol object
61 *
62 *  name - string that contains the name of the object
63 *
64 *  returns 1 if an object whith that name was found and decompiled, otherwise returns 0
65 */
66//---------------------------------------------------------------------------
67DLLEXPORT(short) TolDecompile(BSTR name)
68//---------------------------------------------------------------------------
69{
70  LPSTR str_name = (LPSTR)name;
71  BList *P = VB_stack.Cdr(), *prev = &VB_stack;
72  short found = 0;
73 
74  while (!found && P) {
75    BSyntaxObject * so = (BSyntaxObject*)(P->Car());
76    const char* object_name = so->Name().String();
77    if (!strcmp(object_name, str_name)) {
78          prev->PutCdr(P->Cdr());
79      delete P;
80      DESTROY(so);
81      found = 1;
82          break;
83    }
84        prev = P;
85    P = P->Cdr();
86  }
87  return found;
88}
89
90int VBTol_EvalExpr(char * expr, short* nerror, short* nwarning)
91{
92  BList * tol_result;
93
94  BDat& bderror = TOLErrorNumber();
95  BDat& bdwarning = TOLWarningNumber();
96
97  *nerror = (int)(bderror.Value());
98  *nwarning = (int)(bdwarning.Value());
99  tol_result = MultyEvaluate(expr);
100  *nerror = (int)(bderror.Value()) - *nerror;
101  *nwarning = (int)(bdwarning.Value()) - *nwarning;
102  if (tol_result) {
103    VB_concat(&VB_stack, tol_result);
104    return 1;
105  }
106  return 0;
107}
108
109/*
110 *  Evaluates a Tol expresion
111 *
112 *  expr - string that contains the expresion
113 *
114 *  returns 1 if an object was created by the evaluation, otherwise 0
115 */
116//---------------------------------------------------------------------------
117DLLEXPORT(short) TolEval(BSTR expr, short* nerror, short* nwarning)
118//---------------------------------------------------------------------------
119{
120  LPSTR str_expr;
121
122  str_expr = (LPSTR)expr;    // The address is coerced into an LPSTR.
123
124  return VBTol_EvalExpr(str_expr, nerror, nwarning);
125}
126
127void VBTol_InstallHciWriter()
128{
129  BOut::PutHciWriter(VBTol_HciWriter);
130  BOut::PutLogHciWriter(VBTol_HciWriter);
131}
132
133/*
134 * Initialize TOL
135 *
136 * addr - the address of a Visual Basic function that will catch all the Tol output
137 * vmode - VerboseMode
138 * initlib - if it's non zero the InitLibrary will be loaded
139 */
140//---------------------------------------------------------------------------
141DLLEXPORT(void) TolInit(long addr, BSTR vmode, short initlib)
142//---------------------------------------------------------------------------
143{
144  VB_Writer = (FN_PTR)addr;
145
146  VBTol_InstallHciWriter();
147
148  Tol_gsl_set_error_handler(&VBTol_gsl_error_handler);
149
150  LPSTR str_vmode;
151  str_vmode = (LPSTR)vmode;
152  InitTolKernel(NULL, 0, str_vmode);
153
154  if (initlib)
155    LoadInitLibrary(true,true);
156}
157
158// VC++ DLL entry point routine. Called during certain system events.
159
160//---------------------------------------------------------------------------
161BOOL APIENTRY DllMain(HANDLE hModule,
162                      DWORD  ul_reason_for_call,
163                      LPVOID lpReserved
164                                         )
165//---------------------------------------------------------------------------
166{
167  switch(ul_reason_for_call) {
168        case DLL_PROCESS_ATTACH:
169//        ::MessageBox(NULL, "Initializing the DLL.", "C++ DLL", 0);
170          break;
171        case DLL_PROCESS_DETACH:
172//        ::MessageBox(NULL, "Closing down the DLL.", "C++ DLL", 0);
173          break;
174  }
175  return TRUE;
176}
Note: See TracBrowser for help on using the repository browser.