source: tol/vbtol/source/vbtol.cpp @ a1ba204

1941-docker-image-to-testdevel
Last change on this file since a1ba204 was d445cda, checked in by Víctor de Buen <vdebuen@…>, 15 years ago

Refs #1259
Fixes #1275

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

  • Property mode set to 100644
File size: 4.7 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#include <config.h>
24#include <tol_init.h>
25#include <tol_bout.h>
26#include <tol_list.h>
27
28#include "VButils.h"
29
30/*
31 *  Decompile all Tol objects
32 *
33 *  returns 1 if there was some object to be decompiled, otherwise returns 0
34 */
35//---------------------------------------------------------------------------
36short __declspec(dllexport) CALLBACK TolDecompileAll()
37//---------------------------------------------------------------------------
38{
39  BList *P = VB_stack.Cdr();
40  short ret = P!=NULL;
41 
42  while (P) {
43    BSyntaxObject * so = (BSyntaxObject*)(P->Car());
44        VB_stack.PutCdr(P->Cdr());
45    delete P;
46    DESTROY(so);
47        P = VB_stack.Cdr();
48  }
49  return ret;
50}
51
52/*
53 *  Decompile a Tol object
54 *
55 *  name - string that contains the name of the object
56 *
57 *  returns 1 if an object whith that name was found and decompiled, otherwise returns 0
58 */
59//---------------------------------------------------------------------------
60short __declspec(dllexport) CALLBACK TolDecompile(BSTR name)
61//---------------------------------------------------------------------------
62{
63  LPSTR str_name = (LPSTR)name;
64  BList *P = VB_stack.Cdr(), *prev = &VB_stack;
65  short found = 0;
66 
67  while (!found && P) {
68    BSyntaxObject * so = (BSyntaxObject*)(P->Car());
69    const char* object_name = so->Name().String();
70    if (!strcmp(object_name, str_name)) {
71          prev->PutCdr(P->Cdr());
72      delete P;
73      DESTROY(so);
74      found = 1;
75          break;
76    }
77        prev = P;
78    P = P->Cdr();
79  }
80  return found;
81}
82
83int VBTol_EvalExpr(char * expr, short* nerror, short* nwarning)
84{
85  BList * tol_result;
86
87  BDat& bderror = TOLErrorNumber();
88  BDat& bdwarning = TOLWarningNumber();
89
90  *nerror = (int)(bderror.Value());
91  *nwarning = (int)(bdwarning.Value());
92  tol_result = MultyEvaluate(expr);
93  *nerror = (int)(bderror.Value()) - *nerror;
94  *nwarning = (int)(bdwarning.Value()) - *nwarning;
95  if (tol_result) {
96    VB_concat(&VB_stack, tol_result);
97    return 1;
98  }
99  return 0;
100}
101
102/*
103 *  Evaluates a Tol expresion
104 *
105 *  expr - string that contains the expresion
106 *
107 *  returns 1 if an object was created by the evaluation, otherwise 0
108 */
109//---------------------------------------------------------------------------
110short __declspec(dllexport) CALLBACK TolEval(BSTR expr, short* nerror, short* nwarning)
111//---------------------------------------------------------------------------
112{
113  LPSTR str_expr;
114
115  str_expr = (LPSTR)expr;    // The address is coerced into an LPSTR.
116
117  return VBTol_EvalExpr(str_expr, nerror, nwarning);
118}
119
120void VBTol_InstallHciWriter()
121{
122  BOut::PutHciWriter(VBTol_HciWriter);
123  BOut::PutLogHciWriter(VBTol_HciWriter);
124}
125
126/*
127 * Initialize TOL
128 *
129 * addr - the address of a Visual Basic function that will catch all the Tol output
130 * vmode - VerboseMode
131 * initlib - if it's non zero the InitLibrary will be loaded
132 */
133//---------------------------------------------------------------------------
134void __declspec(dllexport) CALLBACK TolInit(long addr, BSTR vmode, short initlib)
135//---------------------------------------------------------------------------
136{
137  VB_Writer = (FN_PTR)addr;
138
139  VBTol_InstallHciWriter();
140
141  Tol_gsl_set_error_handler(&VBTol_gsl_error_handler);
142
143  LPSTR str_vmode;
144  str_vmode = (LPSTR)vmode;
145  InitTolKernel(NULL, 0, str_vmode);
146
147  if (initlib)
148    LoadInitLibrary(true);
149}
150
151// VC++ DLL entry point routine. Called during certain system events.
152
153//---------------------------------------------------------------------------
154BOOL APIENTRY DllMain(HANDLE hModule,
155                      DWORD  ul_reason_for_call,
156                      LPVOID lpReserved
157                                         )
158//---------------------------------------------------------------------------
159{
160  switch(ul_reason_for_call) {
161        case DLL_PROCESS_ATTACH:
162//        ::MessageBox(NULL, "Initializing the DLL.", "C++ DLL", 0);
163          break;
164        case DLL_PROCESS_DETACH:
165//        ::MessageBox(NULL, "Closing down the DLL.", "C++ DLL", 0);
166          break;
167  }
168  return TRUE;
169}
Note: See TracBrowser for help on using the repository browser.