OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [rtos/] [ecos-3.0/] [host/] [libcdl/] [interp.cxx] - Blame information for rev 790

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 786 skrzyp
//{{{  Banner                                                   
2
 
3
//============================================================================
4
//
5
//      interp.cxx
6
//
7
//      Provide access to Tcl interpreters
8
//
9
//============================================================================
10
// ####ECOSHOSTGPLCOPYRIGHTBEGIN####                                        
11
// -------------------------------------------                              
12
// This file is part of the eCos host tools.                                
13
// Copyright (C) 1999, 2000, 2001, 2002, 2004, 2005, 2008 Free Software Foundation, Inc.
14
//
15
// This program is free software; you can redistribute it and/or modify     
16
// it under the terms of the GNU General Public License as published by     
17
// the Free Software Foundation; either version 2 or (at your option) any   
18
// later version.                                                           
19
//
20
// This program is distributed in the hope that it will be useful, but      
21
// WITHOUT ANY WARRANTY; without even the implied warranty of               
22
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU        
23
// General Public License for more details.                                 
24
//
25
// You should have received a copy of the GNU General Public License        
26
// along with this program; if not, write to the                            
27
// Free Software Foundation, Inc., 51 Franklin Street,                      
28
// Fifth Floor, Boston, MA  02110-1301, USA.                                
29
// -------------------------------------------                              
30
// ####ECOSHOSTGPLCOPYRIGHTEND####                                          
31
//============================================================================
32
//#####DESCRIPTIONBEGIN####
33
//
34
// Author(s):   bartv
35
// Contact(s):  bartv
36
// Date:        1999/01/20
37
// Version:     0.02
38
//
39
//####DESCRIPTIONEND####
40
//============================================================================
41
 
42
//}}}
43
//{{{  #include's                                               
44
 
45
// ----------------------------------------------------------------------------
46
#include "cdlconfig.h"
47
 
48
// Get the infrastructure types, assertions, tracing and similar
49
// facilities.
50
#include <cyg/infra/cyg_ass.h>
51
#include <cyg/infra/cyg_trac.h>
52
 
53
// <cdl.hxx> defines everything implemented in this module.
54
// It implicitly supplies <string>, <vector> and <map> because
55
// the class definitions rely on these headers. It also brings
56
// in <tcl.h>
57
#include <cdlcore.hxx>
58
 
59
//}}}
60
 
61
//{{{  Statics                                                  
62
 
63
// ----------------------------------------------------------------------------
64
// This key is used for accessing AssocData in the Tcl interpreters,
65
// specifically the CdlInterpreter object.
66
const char* CdlInterpreterBody::cdlinterpreter_assoc_data_key = "__cdlinterpreter";
67
 
68
CYGDBG_DEFINE_MEMLEAK_COUNTER(CdlInterpreterBody);
69
 
70
//}}}
71
//{{{  CdlInterpreter:: creation                                
72
 
73
// ----------------------------------------------------------------------------
74
// Default constructor. This will only get invoked via the make() static
75
// member.
76
 
77
CdlInterpreterBody::CdlInterpreterBody(Tcl_Interp* tcl_interp_arg)
78
{
79
    CYG_REPORT_FUNCNAME("CdlInterpreter:: default constructor");
80
    CYG_REPORT_FUNCARG2XV(this, tcl_interp_arg);
81
    CYG_PRECONDITIONC(0 != tcl_interp_arg);
82
 
83
    tcl_interp          = tcl_interp_arg;
84
    owns_interp         = false;
85
    parent              = 0;
86
    toplevel            = 0;
87
    transaction         = 0;
88
    loadable            = 0;
89
    container           = 0;
90
    node                = 0;
91
    context             = "";
92
    error_fn_ptr        = 0;
93
    warning_fn_ptr      = 0;
94
    current_commands    = 0;
95
    cdl_result          = false;
96
 
97
    CYGDBG_MEMLEAK_CONSTRUCTOR();
98
    cdlinterpreterbody_cookie   = CdlInterpreterBody_Magic;
99
 
100
    Tcl_SetAssocData(tcl_interp, cdlinterpreter_assoc_data_key, 0, static_cast<ClientData>(this));
101
 
102
 
103
    CYG_POSTCONDITION_THISC();
104
    CYG_REPORT_RETURN();
105
}
106
 
107
// ----------------------------------------------------------------------------
108
// Create a new CDL interpreter. The underlying Tcl interpreter can be
109
// supplied by the caller, or else a suitable interpreter will be created
110
// with default settings. This default interpreter will only support Tcl,
111
// not Tk. There is no call to any AppInit() function, no support for
112
// autoloading packages, the "unknown" command is not implemented, and
113
// no command files will be read in.
114
//
115
// It is convenient to provide immediate access to two Tcl variables,
116
// cdl_version and cdl_interactive.
117
 
118
CdlInterpreter
119
CdlInterpreterBody::make(Tcl_Interp* tcl_interp_arg)
120
{
121
    CYG_REPORT_FUNCNAMETYPE("CdlInterpreter::make", "interpreter %p");
122
    CYG_REPORT_FUNCARG1XV(tcl_interp_arg);
123
 
124
    Tcl_Interp* tcl_interp = tcl_interp_arg;
125
    if (0 == tcl_interp) {
126
        tcl_interp = Tcl_CreateInterp();
127
        if (0 == tcl_interp) {
128
            throw std::bad_alloc();
129
        }
130
    } else {
131
        // Make sure that this Tcl interpreter is not already used
132
        // for another CdlInterpreter object.
133
        ClientData tmp = Tcl_GetAssocData(tcl_interp, cdlinterpreter_assoc_data_key, 0);
134
        if (0 != tmp) {
135
            CYG_FAIL("Attempt to use a Tcl interpreter for multiple CDL interpreters");
136
            throw std::bad_alloc();
137
        }
138
    }
139
 
140
    CdlInterpreter result = 0;
141
    try {
142
        result = new CdlInterpreterBody(tcl_interp);
143
 
144
        std::string version = Cdl::get_library_version();
145
        if (0 == Tcl_SetVar(tcl_interp, "cdl_version", CDL_TCL_CONST_CAST(char*,version.c_str()), TCL_GLOBAL_ONLY)) {
146
            throw std::bad_alloc();
147
        }
148
        if (0 == Tcl_SetVar(tcl_interp, "cdl_interactive", CDL_TCL_CONST_CAST(char*, (Cdl::is_interactive() ? "1" : "0")),
149
                            TCL_GLOBAL_ONLY)) {
150
            throw std::bad_alloc();
151
        }
152
    }
153
    catch(std::bad_alloc) {
154
        if (0 == tcl_interp_arg) {
155
            Tcl_DeleteInterp(tcl_interp);
156
        }
157
        throw;
158
    }
159
    if (0 == tcl_interp_arg) {
160
        result->owns_interp     = true;
161
    }
162
    CYG_POSTCONDITION_CLASSC(result);
163
    CYG_REPORT_RETVAL(result);
164
    return result;
165
}
166
 
167
// ----------------------------------------------------------------------------
168
// Given a toplevel and a loadable, create a new slave interpreter
169
// for that loadable. There should be master interpreter associated
170
// with the toplevel already.
171
//
172
// FIXME: do slave interpreters automatically see cdl_version and
173
// cdl_interactive?
174
 
175
CdlInterpreter
176
CdlInterpreterBody::create_slave(CdlLoadable loadable_arg, bool safe)
177
{
178
    CYG_REPORT_FUNCNAMETYPE("CdlInterpreter::create_slave", "slave %p");
179
    CYG_REPORT_FUNCARG3XV(this, loadable_arg, safe);
180
    CYG_PRECONDITION_THISC();
181
    CYG_PRECONDITION(0 == parent, "slave interpreters cannot be created inside slaves");
182
    CYG_PRECONDITION(0 != toplevel, "CDL's slave interpreters need an associated toplevel");
183
    CYG_PRECONDITION_CLASSC(loadable_arg);
184
 
185
    // Slave interpreters need a name. Use a counter to create them uniquely.
186
    static cdl_int      next_slave = 1;
187
    std::string         slave_name;
188
    Cdl::integer_to_string(next_slave++, slave_name);
189
    slave_name = "slave" + slave_name;
190
 
191
    // FIXME: creating a slave that is not safe appears to fail.
192
#if 0    
193
    Tcl_Interp* slave = Tcl_CreateSlave(interp, CDL_TCL_CONST_CAST(char*, slave_name.c_str()), safe);
194
#else
195
    Tcl_Interp* slave = Tcl_CreateInterp();
196
#endif
197
    if (0 == slave) {
198
        throw std::bad_alloc();
199
    }
200
 
201
    CdlInterpreter result = 0;
202
    try {
203
        result = new CdlInterpreterBody(slave);
204
    }
205
    catch(std::bad_alloc) {
206
        Tcl_DeleteInterp(slave);
207
        throw;
208
    }
209
    result->owns_interp = true;
210
#if 0    
211
    try {
212
        slaves.push_back(result);
213
    }
214
    catch(std::bad_alloc) {
215
        delete result;
216
        throw;
217
    }
218
#endif
219
 
220
    result->parent      = this;
221
    result->set_toplevel(toplevel);
222
    result->loadable    = loadable_arg;
223
    result->set_variable("cdl_version", get_variable("cdl_version"));
224
    result->set_variable("cdl_interactive", get_variable("cdl_interactive"));
225
 
226
    CYG_POSTCONDITION_CLASSC(result);
227
    CYG_REPORT_RETVAL(result);
228
    return result;
229
}
230
 
231
// ----------------------------------------------------------------------------
232
// Given an existing interpreter, turn it into a safe one. This is a one-way
233
// transformation.
234
void
235
CdlInterpreterBody::make_safe(void)
236
{
237
    CYG_REPORT_FUNCNAME("CdlInterpreter::make_safe");
238
    CYG_PRECONDITION_THISC();
239
 
240
    if (0 != Tcl_MakeSafe(tcl_interp)) {
241
        throw std::bad_alloc();
242
    }
243
    CYG_REPORT_RETURN();
244
}
245
 
246
//}}}
247
//{{{  CdlInterpreter:: destructor                              
248
 
249
// ----------------------------------------------------------------------------
250
// Default destructor. It is necessary to worry about any slave
251
// interpreters, but otherwise there are no complications.
252
 
253
CdlInterpreterBody::~CdlInterpreterBody()
254
{
255
    CYG_REPORT_FUNCNAME("CdlInterpreter:: destructor");
256
    CYG_REPORT_FUNCARG1XV(this);
257
    CYG_PRECONDITION_THISC();
258
 
259
    cdlinterpreterbody_cookie   = CdlInterpreterBody_Invalid;
260
    parent                      = 0;
261
    toplevel                    = 0;
262
    transaction                 = 0;
263
    loadable                    = 0;
264
    container                   = 0;
265
    node                        = 0;
266
    context                     = "";
267
    error_fn_ptr                = 0;
268
    warning_fn_ptr              = 0;
269
    current_commands            = 0;
270
    cdl_result                  = false;
271
 
272
    // Make sure slave interpreters get deleted before the current one
273
    for (std::vector<CdlInterpreter>::iterator i = slaves.begin(); i != slaves.end(); i++) {
274
        delete *i;
275
        *i = 0;
276
    }
277
 
278
    Tcl_DeleteAssocData(tcl_interp, cdlinterpreter_assoc_data_key);
279
    if (owns_interp) {
280
        Tcl_DeleteInterp(tcl_interp);
281
    }
282
    owns_interp = false;
283
    tcl_interp  = 0;
284
    CYGDBG_MEMLEAK_DESTRUCTOR();
285
 
286
    CYG_REPORT_RETURN();
287
}
288
 
289
//}}}
290
//{{{  CdlInterpreter:: check_this()                            
291
 
292
// ----------------------------------------------------------------------------
293
// check_this().
294
 
295
bool
296
CdlInterpreterBody::check_this(cyg_assert_class_zeal zeal) const
297
{
298
    if (CdlInterpreterBody_Magic != cdlinterpreterbody_cookie)
299
        return false;
300
 
301
    CYGDBG_MEMLEAK_CHECKTHIS();
302
 
303
    switch(zeal) {
304
      case cyg_system_test  :
305
      case cyg_extreme      :
306
          if (slaves.size() > 0) {
307
              for (std::vector<CdlInterpreter>::const_iterator i = slaves.begin(); i != slaves.end(); i++) {
308
                  if (!(*i)->check_this(cyg_quick)) {
309
                      return false;
310
                  }
311
              }
312
          }
313
      case cyg_thorough     :
314
          if ((0 != toplevel) && !toplevel->check_this(cyg_quick)) {
315
              return false;
316
          }
317
          if ((0 != transaction) && !transaction->check_this(cyg_quick)) {
318
              return false;
319
          }
320
          if ((0 != loadable) && !loadable->check_this(cyg_quick)) {
321
              return false;
322
          }
323
          if ((0 != container) && !container->check_this(cyg_quick)) {
324
              return false;
325
          }
326
          if ((0 != node) && !node->check_this(cyg_quick)) {
327
              return false;
328
          }
329
      case cyg_quick        :
330
          // For now only the toplevel interpreter should have slaves.
331
          if ((0 != parent) && (slaves.size() > 0)) {
332
              return false;
333
          }
334
          if( 0 == tcl_interp) {
335
              return false;
336
          }
337
      case cyg_trivial      :
338
      case cyg_none         :
339
          break;
340
    }
341
    return true;
342
}
343
 
344
//}}}
345
//{{{  CdlInterpreter:: set_toplevel() etc.                     
346
 
347
// ----------------------------------------------------------------------------
348
// Keep track of the current toplevel, container, etc. This gives commands
349
// added to the Tcl interpreter a simple way of figuring out the current
350
// state of the world so that properties get added to the right node, etc.
351
//
352
// set_toplevel() should only be called once, for the master interpreter
353
// associated with a toplevel. All slave interpreters inherit this value.
354
//
355
// There is no set_loadable(), instead the loadable field is filled in
356
// by create_slave() and cannot be changed.
357
 
358
CdlToplevel
359
CdlInterpreterBody::get_toplevel() const
360
{
361
    CYG_REPORT_FUNCNAMETYPE("CdlInterpreter::get_toplevel", "result %p");
362
    CYG_REPORT_FUNCARG1XV(this);
363
    CYG_PRECONDITION_THISC();
364
 
365
    CdlToplevel result = toplevel;
366
    CYG_REPORT_RETVAL(result);
367
    return result;
368
}
369
 
370
CdlTransaction
371
CdlInterpreterBody::get_transaction() const
372
{
373
    CYG_REPORT_FUNCNAMETYPE("CdlInterpreter::get_transaction", "result %p");
374
    CYG_REPORT_FUNCARG1XV(this);
375
    CYG_PRECONDITION_THISC();
376
 
377
    CdlTransaction result = transaction;
378
    CYG_REPORT_RETVAL(result);
379
    return result;
380
}
381
 
382
CdlLoadable
383
CdlInterpreterBody::get_loadable() const
384
{
385
    CYG_REPORT_FUNCNAMETYPE("CdlInterpreter:get_loadable", "result %p");
386
    CYG_REPORT_FUNCARG1XV(this);
387
    CYG_PRECONDITION_THISC();
388
 
389
    CdlLoadable result = loadable;
390
    CYG_REPORT_RETVAL(result);
391
    return result;
392
}
393
 
394
CdlContainer
395
CdlInterpreterBody::get_container() const
396
{
397
    CYG_REPORT_FUNCNAMETYPE("CdlInterpreter::get_container", "result %p");
398
    CYG_REPORT_FUNCARG1XV(this);
399
    CYG_PRECONDITION_THISC();
400
 
401
    CdlContainer result = container;
402
    CYG_REPORT_RETVAL(result);
403
    return result;
404
}
405
 
406
CdlNode
407
CdlInterpreterBody::get_node() const
408
{
409
    CYG_REPORT_FUNCNAMETYPE("CdlInterpreter::get_node", "result %p");
410
    CYG_REPORT_FUNCARG1XV(this);
411
    CYG_PRECONDITION_THISC();
412
 
413
    CdlNode result = node;
414
    CYG_REPORT_RETVAL(result);
415
    return result;
416
}
417
 
418
std::string
419
CdlInterpreterBody::get_context() const
420
{
421
    CYG_REPORT_FUNCNAME("CdlInterpreter::get_context");
422
    CYG_REPORT_FUNCARG1XV(this);
423
    CYG_PRECONDITION_THISC();
424
 
425
    CYG_REPORT_RETURN();
426
    return context;
427
}
428
 
429
CdlDiagnosticFnPtr
430
CdlInterpreterBody::get_error_fn_ptr() const
431
{
432
    CYG_REPORT_FUNCNAMETYPE("CdlInterpreter::get_error_fn_ptr", "result %p");
433
    CYG_REPORT_FUNCARG1XV(this);
434
    CYG_PRECONDITION_THISC();
435
 
436
    CdlDiagnosticFnPtr result = error_fn_ptr;
437
    CYG_REPORT_RETVAL(result);
438
    return result;
439
}
440
 
441
CdlDiagnosticFnPtr
442
CdlInterpreterBody::get_warning_fn_ptr() const
443
{
444
    CYG_REPORT_FUNCNAMETYPE("CdlInterpreter::get_warning_fn_ptr", "result %p");
445
    CYG_REPORT_FUNCARG1XV(this);
446
    CYG_PRECONDITION_THISC();
447
 
448
    CdlDiagnosticFnPtr result = warning_fn_ptr;
449
    CYG_REPORT_RETVAL(result);
450
    return result;
451
}
452
 
453
void
454
CdlInterpreterBody::set_toplevel(CdlToplevel new_toplevel)
455
{
456
    CYG_REPORT_FUNCNAME("CdlInterpreter::set_toplevel");
457
    CYG_REPORT_FUNCARG2XV(this, new_toplevel);
458
    CYG_PRECONDITION_THISC();
459
    CYG_PRECONDITION(0 == toplevel, "changing toplevels is not allowed");
460
    CYG_PRECONDITION_CLASSC(new_toplevel);
461
 
462
    toplevel = new_toplevel;
463
    CYG_REPORT_RETURN();
464
}
465
 
466
void
467
CdlInterpreterBody::set_transaction(CdlTransaction new_transaction)
468
{
469
    CYG_REPORT_FUNCNAME("CdlInterpreter::set_transaction");
470
    CYG_REPORT_FUNCARG2XV(this, new_transaction);
471
    CYG_PRECONDITION_THISC();
472
    CYG_PRECONDITION_ZERO_OR_CLASSC(new_transaction);
473
 
474
    transaction = new_transaction;
475
    CYG_REPORT_RETURN();
476
}
477
 
478
CdlContainer
479
CdlInterpreterBody::push_container(CdlContainer new_container)
480
{
481
    CYG_REPORT_FUNCNAMETYPE("CdlInterpreter::push_container", "result %p");
482
    CYG_REPORT_FUNCARG2XV(this, new_container);
483
    CYG_PRECONDITION_THISC();
484
    CYG_PRECONDITION_CLASSC(new_container);
485
 
486
    CdlContainer result = container;
487
    container = new_container;
488
    CYG_REPORT_RETVAL(result);
489
    return result;
490
}
491
 
492
void
493
CdlInterpreterBody::pop_container(CdlContainer old_container)
494
{
495
    CYG_REPORT_FUNCNAME("CdlInterpreter::pop_container");
496
    CYG_REPORT_FUNCARG2XV(this, old_container);
497
    CYG_PRECONDITION_THISC();
498
    CYG_PRECONDITION_ZERO_OR_CLASSC(old_container);
499
    CYG_PRECONDITIONC(0 != container);
500
 
501
    container = old_container;
502
 
503
    CYG_REPORT_RETURN();
504
}
505
 
506
CdlNode
507
CdlInterpreterBody::push_node(CdlNode new_node)
508
{
509
    CYG_REPORT_FUNCNAMETYPE("CdlInterpreter::push_node", "result %p");
510
    CYG_REPORT_FUNCARG2XV(this, new_node);
511
    CYG_PRECONDITION_THISC();
512
    CYG_PRECONDITION_CLASSC(new_node);
513
 
514
    CdlNode result = node;
515
    node = new_node;
516
    CYG_REPORT_RETVAL(result);
517
    return result;
518
}
519
 
520
void
521
CdlInterpreterBody::pop_node(CdlNode old_node)
522
{
523
    CYG_REPORT_FUNCNAME("CdlInterpreter::pop_node");
524
    CYG_REPORT_FUNCARG2XV(this, old_node);
525
    CYG_PRECONDITION_THISC();
526
    CYG_PRECONDITIONC(0 != node);
527
    CYG_PRECONDITION_ZERO_OR_CLASSC(old_node);
528
 
529
    node = old_node;
530
 
531
    CYG_REPORT_RETURN();
532
}
533
 
534
std::string
535
CdlInterpreterBody::push_context(std::string new_context)
536
{
537
    CYG_REPORT_FUNCNAME("CdlInterpreter::push_context");
538
    CYG_REPORT_FUNCARG1XV(this);
539
    CYG_PRECONDITION_THISC();
540
    CYG_PRECONDITIONC("" != new_context);
541
 
542
    std::string result = context;
543
    context = new_context;
544
    return result;
545
}
546
 
547
void
548
CdlInterpreterBody::pop_context(std::string old_context)
549
{
550
    CYG_REPORT_FUNCNAME("CdlInterpreter::pop_context");
551
    CYG_REPORT_FUNCARG1XV(this);
552
    CYG_PRECONDITION_THISC();
553
    CYG_PRECONDITIONC("" != context);
554
 
555
    context = old_context;
556
 
557
    CYG_REPORT_RETURN();
558
}
559
 
560
CdlDiagnosticFnPtr
561
CdlInterpreterBody::push_error_fn_ptr(CdlDiagnosticFnPtr new_fn_ptr)
562
{
563
    CYG_REPORT_FUNCNAMETYPE("CdlInterpreter::push_error_fn_ptr", "result %p");
564
    CYG_REPORT_FUNCARG2XV(this, new_fn_ptr);
565
    CYG_PRECONDITION_THISC();
566
    CYG_PRECONDITIONC(0 != new_fn_ptr);
567
 
568
    CdlDiagnosticFnPtr result = error_fn_ptr;
569
    error_fn_ptr = new_fn_ptr;
570
    CYG_REPORT_RETVAL(result);
571
    return result;
572
}
573
 
574
void
575
CdlInterpreterBody::pop_error_fn_ptr(CdlDiagnosticFnPtr old_fn_ptr)
576
{
577
    CYG_REPORT_FUNCNAME("CdlInterpreter::pop_error_fn_ptr");
578
    CYG_REPORT_FUNCARG2XV(this, old_fn_ptr);
579
    CYG_PRECONDITION_THISC();
580
    CYG_PRECONDITIONC(0 != error_fn_ptr);
581
 
582
    error_fn_ptr = old_fn_ptr;
583
 
584
    CYG_REPORT_RETURN();
585
}
586
 
587
CdlDiagnosticFnPtr
588
CdlInterpreterBody::push_warning_fn_ptr(CdlDiagnosticFnPtr new_fn_ptr)
589
{
590
    CYG_REPORT_FUNCNAMETYPE("CdlInterpreter::push_warning_fn_ptr", "result %p");
591
    CYG_REPORT_FUNCARG2XV(this, new_fn_ptr);
592
    CYG_PRECONDITION_THISC();
593
    CYG_PRECONDITIONC(0 != new_fn_ptr);
594
 
595
    CdlDiagnosticFnPtr result = warning_fn_ptr;
596
    warning_fn_ptr = new_fn_ptr;
597
    CYG_REPORT_RETVAL(result);
598
    return result;
599
}
600
 
601
void
602
CdlInterpreterBody::pop_warning_fn_ptr(CdlDiagnosticFnPtr old_fn_ptr)
603
{
604
    CYG_REPORT_FUNCNAME("CdlInterpreter::pop_warning_fn_ptr");
605
    CYG_REPORT_FUNCARG2XV(this, old_fn_ptr);
606
    CYG_PRECONDITION_THISC();
607
    CYG_PRECONDITIONC(0 != warning_fn_ptr);
608
 
609
    warning_fn_ptr = old_fn_ptr;
610
 
611
    CYG_REPORT_RETURN();
612
}
613
 
614
//}}}
615
//{{{  CdlInterpreter:: get information                         
616
 
617
// ----------------------------------------------------------------------------
618
// Get hold of the underlying Tcl interpreter. This makes it easier to
619
// use miscellaneous Tcl library facilities such as Tcl_SplitList()
620
Tcl_Interp*
621
CdlInterpreterBody::get_tcl_interpreter(void) const
622
{
623
    CYG_REPORT_FUNCNAMETYPE("CdlInterpreter::get_tcl_interpreter", "interpreter %p");
624
    CYG_REPORT_FUNCARG1XV(this);
625
    CYG_PRECONDITION_THISC();
626
 
627
    Tcl_Interp* result = tcl_interp;
628
    CYG_REPORT_RETVAL(result);
629
    return result;
630
}
631
 
632
//}}}
633
//{{{  CdlInterpreter:: eval()                                  
634
 
635
// ----------------------------------------------------------------------------
636
// Evaluate a Cdl script held in a string. The result of this evaluation, 
637
// e.g. TCL_OK, is returned directly. The string result is made available
638
// in an in-out parameter.
639
//
640
// According to the spec the underlying Tcl_Eval() routine needs to be able
641
// to make temporary changes to the script, so the latter must be held in
642
// writable memory. This requires a copy operation.
643
 
644
int
645
CdlInterpreterBody::eval(std::string script, std::string& str_result)
646
{
647
    CYG_REPORT_FUNCNAMETYPE("CdInterpreter::eval", "result %d");
648
    CYG_REPORT_FUNCARG1XV(this);
649
    CYG_PRECONDITION_THISC();
650
 
651
    int result  = TCL_OK;
652
    int size    = script.size();
653
 
654
    // Distinguish between results set by the Tcl interpreter and results
655
    // set by CDL-related commands running in that interpreter.
656
    cdl_result = false;
657
 
658
    if (size < 2048) {
659
        char buf[2048];
660
        script.copy(buf, size, 0);
661
        buf[size] = '\0';
662
        result = Tcl_Eval(tcl_interp, buf);
663
    } else {
664
        char* buf = static_cast<char*>(malloc(script.size() + 1));
665
        if (0 == buf) {
666
            this->set_result(CdlParse::construct_diagnostic(this, "internal error", "", "Out of memory"));
667
            result = TCL_ERROR;
668
        } else {
669
            script.copy(buf, size, 0);
670
            buf[size] = '\0';
671
            result = Tcl_Eval(tcl_interp, buf);
672
            free(buf);
673
        }
674
    }
675
 
676
    // The distinction between TCL_OK and TCL_RETURN is probably not worth
677
    // worrying about.
678
    if (TCL_RETURN == result) {
679
        result = TCL_OK;
680
    }
681
 
682
    // If we have an error condition that was raised by the Tcl
683
    // interpreter rather than by the library, it needs to be
684
    // raised up to the library level. That way the error count
685
    // etc. are kept accurate.
686
    if ((TCL_OK != result) && !cdl_result) {
687
        const char* tcl_result = Tcl_GetStringResult(tcl_interp);
688
        if ((0 == tcl_result) || ('\0' == tcl_result[0])) {
689
            tcl_result = "Internal error, no additional information available.";
690
        }
691
        CdlParse::report_error(this, "", tcl_result);
692
    }
693
 
694
    str_result = Tcl_GetStringResult(tcl_interp);
695
    CYG_REPORT_RETVAL(result);
696
    return result;
697
}
698
 
699
// Ditto for Tcl Code that comes from a CDL file. Currently this is held
700
// as a string. In future it may be appropriate to store a byte-compiled
701
// version as well.
702
int
703
CdlInterpreterBody::eval_cdl_code(const cdl_tcl_code script, std::string& str_result)
704
{
705
    CYG_REPORT_FUNCNAMETYPE("CdInterpreter::eval_cdl_code", "result %d");
706
    CYG_REPORT_FUNCARG1XV(this);
707
    CYG_PRECONDITION_THISC();
708
 
709
    int result  = TCL_OK;
710
    int size    = script.size();
711
    // Distinguish between results set by the Tcl interpreter and results
712
    // set by CDL-related commands running in that interpreter.
713
    cdl_result = false;
714
 
715
    if (size < 2048) {
716
        char buf[2048];
717
        script.copy(buf, size, 0);
718
        buf[size] = '\0';
719
        result = Tcl_Eval(tcl_interp, buf);
720
    } else {
721
        char* buf = static_cast<char*>(malloc(script.size() + 1));
722
        if (0 == buf) {
723
            this->set_result(CdlParse::construct_diagnostic(this, "internal error", "", "Out of memory"));
724
            result = TCL_ERROR;
725
        } else {
726
            script.copy(buf, size, 0);
727
            buf[size] = '\0';
728
            result = Tcl_Eval(tcl_interp, buf);
729
            free(buf);
730
        }
731
    }
732
    // The distinction between TCL_OK and TCL_RETURN is probably not worth
733
    // worrying about.
734
    if (TCL_RETURN == result) {
735
        result = TCL_OK;
736
    }
737
 
738
    // If we have an error condition that was raised by the Tcl
739
    // interpreter rather than by the library, it needs to be
740
    // raised up to the library level. That way the error count
741
    // etc. are kept accurate.
742
    if ((TCL_OK != result) && !cdl_result) {
743
        const char* tcl_result = Tcl_GetStringResult(tcl_interp);
744
        if ((0 == tcl_result) || ('\0' == tcl_result[0])) {
745
            tcl_result = "Internal error, no additional information available.";
746
        }
747
        CdlParse::report_error(this, "", tcl_result);
748
    }
749
 
750
    str_result = Tcl_GetStringResult(tcl_interp);
751
    CYG_REPORT_RETVAL(result);
752
    return result;
753
}
754
 
755
// Ditto for evaluating an entire file.
756
int
757
CdlInterpreterBody::eval_file(std::string script, std::string& str_result)
758
{
759
    CYG_REPORT_FUNCNAMETYPE("CdlInterpreter::eval_file", "result %d");
760
    CYG_REPORT_FUNCARG1XV(this);
761
    CYG_PRECONDITION_THISC();
762
    CYG_PRECONDITIONC("" != script);
763
 
764
    // Distinguish between results set by the Tcl interpreter and results
765
    // set by CDL-related commands running in that interpreter.
766
    cdl_result = false;
767
 
768
    int result = Tcl_EvalFile(tcl_interp, CDL_TCL_CONST_CAST(char*, script.c_str()));
769
    // The distinction between TCL_OK and TCL_RETURN is probably not worth
770
    // worrying about.
771
    if (TCL_RETURN == result) {
772
        result = TCL_OK;
773
    }
774
 
775
    // If we have an error condition that was raised by the Tcl
776
    // interpreter rather than by the library, it needs to be
777
    // raised up to the library level. That way the error count
778
    // etc. are kept accurate.
779
    if ((TCL_OK != result) && !cdl_result) {
780
        const char* tcl_result = Tcl_GetStringResult(tcl_interp);
781
        if ((0 == tcl_result) || ('\0' == tcl_result[0])) {
782
            tcl_result = "Internal error, no additional information available.";
783
        }
784
        CdlParse::report_error(this, "", tcl_result);
785
    }
786
 
787
    str_result = Tcl_GetStringResult(tcl_interp);
788
    CYG_REPORT_RETVAL(result);
789
    return result;
790
}
791
 
792
// Variants for when the result string is of no interest
793
int
794
CdlInterpreterBody::eval(std::string script)
795
{
796
    std::string result_string;
797
    return this->eval(script, result_string);
798
}
799
 
800
int
801
CdlInterpreterBody::eval_cdl_code(const cdl_tcl_code script)
802
{
803
    std::string result_string;
804
    return this->eval_cdl_code(script, result_string);
805
}
806
 
807
int
808
CdlInterpreterBody::eval_file(std::string filename)
809
{
810
    std::string result_string;
811
    return this->eval_file(filename, result_string);
812
}
813
 
814
//}}}
815
//{{{  CdlInterpreter:: set_result()                            
816
 
817
// ----------------------------------------------------------------------------
818
// Provide a way of setting an interpreter's result from a command implemented
819
// in C++.
820
 
821
void
822
CdlInterpreterBody::set_result(std::string result)
823
{
824
    CYG_REPORT_FUNCNAME("CdlInterpreter::set_result");
825
    CYG_PRECONDITION_THISC();
826
 
827
    Tcl_SetResult(tcl_interp, const_cast<char*>(result.c_str()), TCL_VOLATILE);
828
    this->cdl_result = true;
829
 
830
    CYG_REPORT_RETURN();
831
}
832
 
833
bool
834
CdlInterpreterBody::result_set_by_cdl()
835
{
836
    CYG_REPORT_FUNCNAMETYPE("CdlInterpreter::result_set_by_cdl", "result %d");
837
    CYG_PRECONDITION_THISC();
838
 
839
    bool result = this->cdl_result;
840
    CYG_REPORT_RETVAL(result);
841
    return result;
842
}
843
 
844
// ----------------------------------------------------------------------------
845
// Also allow the result to be extracted again.
846
std::string
847
CdlInterpreterBody::get_result()
848
{
849
    CYG_REPORT_FUNCNAME("CdlInterpreter::get_result");
850
    CYG_PRECONDITION_THISC();
851
 
852
    std::string result = Tcl_GetStringResult(tcl_interp);
853
 
854
    CYG_REPORT_RETURN();
855
    return result;
856
}
857
 
858
//}}}
859
//{{{  CdlInterpreter:: add and remove commands                 
860
 
861
// ----------------------------------------------------------------------------
862
// This is the Tcl command proc that gets used for all CdlInterpreter
863
// commands. The ClientData field will be a CdlInterpreterCommand,
864
// i.e. a function pointer. That function needs a pointer to the
865
// CdlInterpreter object, which can be accessed via AssocData.
866
int
867
CdlInterpreterBody::tcl_command_proc(ClientData data, Tcl_Interp* tcl_interp, int argc, const char* argv[])
868
{
869
    CYG_REPORT_FUNCNAMETYPE("CdlInterpreter::tcl_command_proc", "result %d");
870
    CYG_REPORT_FUNCARG3XV(data, tcl_interp, argc);
871
    CYG_PRECONDITIONC(0 != data);
872
 
873
    int result = TCL_OK;
874
 
875
    union {
876
        ClientData            data;
877
        CdlInterpreterCommand command;
878
    } x;
879
    x.data = data;
880
    CdlInterpreterCommand command = x.command;
881
 
882
    data = Tcl_GetAssocData(tcl_interp, cdlinterpreter_assoc_data_key, 0);
883
    CdlInterpreter interp = static_cast<CdlInterpreter>(data);
884
    CYG_ASSERT_CLASSC(interp);
885
 
886
    try {
887
        result = (*command)(interp, argc, argv);
888
    } catch(std::bad_alloc e) {
889
        interp->set_result(CdlParse::construct_diagnostic(interp, "internal error", "", "Out of memory."));
890
        result = TCL_ERROR;
891
    } catch(CdlStringException e) {
892
        interp->set_result(e.get_message());
893
        result = TCL_ERROR;
894
    } catch(...) {
895
        CYG_FAIL("Unexpected C++ exception");
896
        interp->set_result(CdlParse::construct_diagnostic(interp, "internal error", "", "Unexpected C++ exception."));
897
        result = TCL_ERROR;
898
    }
899
 
900
    CYG_REPORT_RETVAL(result);
901
    return result;
902
}
903
 
904
void
905
CdlInterpreterBody::add_command(std::string name, CdlInterpreterCommand command)
906
{
907
    CYG_REPORT_FUNCNAME("CdlInterpreter::add_command");
908
    CYG_REPORT_FUNCARG2XV(this, command);
909
 
910
    CYG_PRECONDITION_THISC();
911
    CYG_PRECONDITIONC("" != name);
912
    CYG_CHECK_FUNC_PTRC(command);
913
 
914
    union {
915
        CdlInterpreterCommand command;
916
        ClientData            data;
917
    } x;
918
    x.command = command;
919
 
920
    // Tcl 8.4 involves some incompatible API changes
921
#if (TCL_MAJOR_VERSION > 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION >= 4))
922
    if (0 == Tcl_CreateCommand(tcl_interp, CDL_TCL_CONST_CAST(char*, name.c_str()), &tcl_command_proc, x.data, 0)) {
923
        throw std::bad_alloc();
924
    }
925
#else
926
    if (0 == Tcl_CreateCommand(tcl_interp, CDL_TCL_CONST_CAST(char*, name.c_str()),
927
                               (int (*)(ClientData,Tcl_Interp*, int, char*[])) &tcl_command_proc,
928
                               x.data, 0)) {
929
        throw std::bad_alloc();
930
    }
931
#endif
932
 
933
    CYG_REPORT_RETURN();
934
}
935
 
936
// ----------------------------------------------------------------------------
937
// Remove a command from an interpreter. This is just a wrapper for the
938
// Tcl_DeleteCommand() routine.
939
 
940
void
941
CdlInterpreterBody::remove_command(std::string name)
942
{
943
    CYG_REPORT_FUNCNAME("CdlInterpreter::remove_command");
944
    CYG_REPORT_FUNCARG1XV(this);
945
    CYG_PRECONDITION_THISC();
946
    CYG_PRECONDITIONC("" != name);
947
 
948
    if (0 != Tcl_DeleteCommand(tcl_interp, CDL_TCL_CONST_CAST(char*, name.c_str()))) {
949
        CYG_FAIL("attempt to delete non-existant command");
950
    }
951
    CYG_REPORT_RETURN();
952
}
953
 
954
// ----------------------------------------------------------------------------
955
// It is also possible to add and remove whole sets of commands in one go,
956
// keeping track of the current set.
957
 
958
std::vector<CdlInterpreterCommandEntry>*
959
CdlInterpreterBody::push_commands(std::vector<CdlInterpreterCommandEntry>& new_commands)
960
{
961
    CYG_REPORT_FUNCNAMETYPE("CdlInterpreter::push_commands", "result %p");
962
    CYG_REPORT_FUNCARG2XV(this, &new_commands);
963
    CYG_PRECONDITION_THISC();
964
 
965
    std::vector<CdlInterpreterCommandEntry>* result = current_commands;
966
    std::vector<CdlInterpreterCommandEntry>::iterator i;
967
 
968
    // First uninstall all the old commands, if any
969
    if (0 != current_commands) {
970
        for (i = current_commands->begin(); i != current_commands->end(); i++) {
971
            remove_command(i->name);
972
        }
973
    }
974
 
975
    // Now install the new commands
976
    for (i = new_commands.begin(); i != new_commands.end(); i++) {
977
        add_command(i->name, i->command);
978
    }
979
 
980
    // Remember the current set in case of a subsequent push operation
981
    current_commands = &new_commands;
982
 
983
    CYG_REPORT_RETVAL(result);
984
    return result;
985
}
986
 
987
void
988
CdlInterpreterBody::pop_commands(std::vector<CdlInterpreterCommandEntry>* original_commands)
989
{
990
    CYG_REPORT_FUNCNAME("CdlInterpreter::pop_commands");
991
    CYG_REPORT_FUNCARG2XV(this, &original_commands);
992
    CYG_PRECONDITION_THISC();
993
    CYG_PRECONDITION(0 != current_commands, "no pop without a previous push please");
994
 
995
    std::vector<CdlInterpreterCommandEntry>::iterator i;
996
    // Uninstall the most recent set of commands
997
    for (i = current_commands->begin(); i != current_commands->end(); i++) {
998
        remove_command(i->name);
999
    }
1000
 
1001
    // Reinstall the previous set, if any
1002
    if (0 != original_commands) {
1003
        for (i = original_commands->begin(); i != original_commands->end(); i++) {
1004
            add_command(i->name, i->command);
1005
        }
1006
    }
1007
    current_commands = original_commands;
1008
    CYG_REPORT_RETURN();
1009
}
1010
 
1011
std::vector<CdlInterpreterCommandEntry>*
1012
CdlInterpreterBody::get_pushed_commands() const
1013
{
1014
    CYG_REPORT_FUNCNAME("CdlInterpreter::get_pushed_commands");
1015
    CYG_REPORT_FUNCARG1XV(this);
1016
    CYG_PRECONDITION_THISC();
1017
 
1018
    CYG_REPORT_RETURN();
1019
    return current_commands;
1020
}
1021
 
1022
//}}}
1023
//{{{  CdlInterpreter:: variables                               
1024
 
1025
// ----------------------------------------------------------------------------
1026
// Provide some more stubs, this time for accessing Tcl global variables.
1027
void
1028
CdlInterpreterBody::set_variable(std::string name, std::string value)
1029
{
1030
    CYG_REPORT_FUNCNAME("CdlInterpreter::set_variable");
1031
    CYG_REPORT_FUNCARG2("this %p, name %s", this, name.c_str());
1032
    CYG_PRECONDITION_THISC();
1033
    CYG_PRECONDITIONC("" != name);
1034
    if (0 == Tcl_SetVar(tcl_interp, CDL_TCL_CONST_CAST(char*, name.c_str()), CDL_TCL_CONST_CAST(char*, value.c_str()), TCL_GLOBAL_ONLY)) {
1035
        throw std::bad_alloc();
1036
    }
1037
    CYG_REPORT_RETURN();
1038
}
1039
 
1040
void
1041
CdlInterpreterBody::unset_variable(std::string name)
1042
{
1043
    CYG_REPORT_FUNCNAME("CdlInterpreter::unset_variable");
1044
    CYG_REPORT_FUNCARG2("this %p, name %s", this, name.c_str());
1045
    CYG_PRECONDITION_THISC();
1046
    CYG_PRECONDITIONC("" != name);
1047
 
1048
    Tcl_UnsetVar(tcl_interp, CDL_TCL_CONST_CAST(char*, name.c_str()), TCL_GLOBAL_ONLY);
1049
    CYG_REPORT_RETURN();
1050
}
1051
 
1052
std::string
1053
CdlInterpreterBody::get_variable(std::string name)
1054
{
1055
    CYG_REPORT_FUNCNAME("CdlInterpreter::get_variable");
1056
    CYG_REPORT_FUNCARG2("this %p, name %s", this, name.c_str());
1057
    CYG_PRECONDITION_THISC();
1058
    CYG_PRECONDITIONC("" != name);
1059
 
1060
    std::string result = "";
1061
    const char *tmp = Tcl_GetVar(tcl_interp, CDL_TCL_CONST_CAST(char*, name.c_str()), TCL_GLOBAL_ONLY);
1062
    if (0 != tmp) {
1063
        result = tmp;
1064
    }
1065
 
1066
    CYG_REPORT_RETURN();
1067
    return result;
1068
}
1069
 
1070
//}}}
1071
//{{{  CdlInterpreter:: assoc data                              
1072
 
1073
// ----------------------------------------------------------------------------
1074
// Associated data. It is useful to be able to store some C++ data with
1075
// Tcl interpreters, so that the implementations of various commands
1076
// can retrieve details of the current state. Tcl provides the necessary
1077
// underlying support via routines Tcl_SetAssocData() etc., and the
1078
// routines here are just stubs for the underlying Tcl ones.
1079
 
1080
void
1081
CdlInterpreterBody::set_assoc_data(const char* key, ClientData data, Tcl_InterpDeleteProc* del_proc)
1082
{
1083
    CYG_REPORT_FUNCNAME("CdlInterpreter::set_assoc_data");
1084
    CYG_REPORT_FUNCARG3("this %p, key %s, data %p", this, key, data);
1085
    CYG_PRECONDITION_THISC();
1086
    CYG_PRECONDITIONC((0 != key) && ('\0' != key[0]));
1087
 
1088
    Tcl_SetAssocData(tcl_interp, CDL_TCL_CONST_CAST(char*, key), del_proc, data);
1089
    CYG_REPORT_RETURN();
1090
}
1091
 
1092
ClientData
1093
CdlInterpreterBody::get_assoc_data(const char* key)
1094
{
1095
    CYG_REPORT_FUNCNAMETYPE("CdlInterpreter::get_assoc_data", "result %p");
1096
    CYG_REPORT_FUNCARG2("this %p, key %s", this, key);
1097
    CYG_PRECONDITION_THISC();
1098
    CYG_PRECONDITIONC((0 != key) && ('\0' != key[0]));
1099
 
1100
    ClientData result = Tcl_GetAssocData(tcl_interp, CDL_TCL_CONST_CAST(char*, key), 0);
1101
    CYG_REPORT_RETVAL(result);
1102
    return result;
1103
}
1104
 
1105
void
1106
CdlInterpreterBody::delete_assoc_data(const char* key)
1107
{
1108
    CYG_REPORT_FUNCNAME("CdlInterpreter::delete_assoc_data");
1109
    CYG_REPORT_FUNCARG2("this %p, key %s", this, key);
1110
    CYG_PRECONDITION_THISC();
1111
    CYG_PRECONDITIONC((0 != key) && ('\0' != key[0]));
1112
 
1113
    Tcl_DeleteAssocData(tcl_interp, CDL_TCL_CONST_CAST(char*, key));
1114
    CYG_REPORT_RETURN();
1115
}
1116
 
1117
//}}}
1118
//{{{  CdlInterpreter:: file I/O                                
1119
 
1120
// ----------------------------------------------------------------------------
1121
// Tcl provides file I/O facilities that are already known to be portable
1122
// to the platforms of interest.
1123
 
1124
bool
1125
CdlInterpreterBody::is_directory(std::string name)
1126
{
1127
    CYG_REPORT_FUNCNAMETYPE("CdlInterpreter::is_directory", "result %d");
1128
    CYG_REPORT_FUNCARG1XV(this);
1129
    CYG_PRECONDITION_THISC();
1130
    CYG_PRECONDITIONC("" != name);
1131
 
1132
    bool result = false;
1133
    std::string command = "file isdirectory \"" + name + "\"";
1134
    std::string tcl_result;
1135
    if ((TCL_OK == this->eval(command, tcl_result)) && ("1" == tcl_result)) {
1136
        result = true;
1137
    }
1138
 
1139
    CYG_REPORT_RETVAL(result);
1140
    return result;
1141
}
1142
 
1143
bool
1144
CdlInterpreterBody::is_file(std::string name)
1145
{
1146
    CYG_REPORT_FUNCNAMETYPE("CdlInterpreter::is_file", "result %d");
1147
    CYG_REPORT_FUNCARG1XV(this);
1148
    CYG_PRECONDITION_THISC();
1149
    CYG_PRECONDITIONC("" != name);
1150
 
1151
    bool result = false;
1152
    std::string command = "file isfile \"" + name + "\"";
1153
    std::string tcl_result;
1154
    if ((TCL_OK == this->eval(command, tcl_result)) && ("1" == tcl_result)) {
1155
        result = true;
1156
    }
1157
 
1158
    CYG_REPORT_RETVAL(result);
1159
    return result;
1160
}
1161
 
1162
// ----------------------------------------------------------------------------
1163
 
1164
void
1165
CdlInterpreterBody::locate_subdirs(std::string directory, std::vector<std::string>& result)
1166
{
1167
    CYG_REPORT_FUNCNAME("CdlInterpreter::locate_subdirs");
1168
    CYG_REPORT_FUNCARG2XV(this, &result);
1169
    CYG_PRECONDITION_THISC();
1170
 
1171
    static char locate_subdirs_script[] = "\
1172
set pattern [file join \"$::cdl_locate_subdirs_path\" *]    \n\
1173
set result {}                                               \n\
1174
foreach entry [glob -nocomplain -- $pattern] {              \n\
1175
    if ([file isdirectory $entry]) {                        \n\
1176
        set entry [file tail $entry]                        \n\
1177
        if {($entry != \"CVS\") && ($entry != \"cvs\") &&     \
1178
            ([string index $entry 0] != \".\")} {           \n\
1179
            lappend result $entry                           \n\
1180
        }                                                   \n\
1181
    }                                                       \n\
1182
}                                                           \n\
1183
return $result                                              \n\
1184
";
1185
 
1186
    std::string                 tcl_result = "";
1187
    set_variable("::cdl_locate_subdirs_path", directory);
1188
    if (TCL_OK != eval(locate_subdirs_script, tcl_result)) {
1189
        CYG_FAIL("Internal error evaluating Tcl script");
1190
    }
1191
 
1192
    int             count;
1193
    const char**    array;
1194
    if (TCL_OK != Tcl_SplitList(tcl_interp, CDL_TCL_CONST_CAST(char*, tcl_result.c_str()), &count, CDL_TCL_CONST_CAST(char***, &array))) {
1195
        throw std::bad_alloc();
1196
    }
1197
    for (int i = 0; i < count; i++) {
1198
        result.push_back(array[i]);
1199
    }
1200
    Tcl_Free((char*) array);
1201
 
1202
    CYG_REPORT_RETURN();
1203
}
1204
 
1205
// ----------------------------------------------------------------------------
1206
// Locating all subdirs requires some simple recursion
1207
void
1208
CdlInterpreterBody::locate_all_subdirs(std::string directory, std::vector<std::string>& result)
1209
{
1210
    CYG_REPORT_FUNCNAME("CdlInterpreter::locate_all_subdirs");
1211
    CYG_REPORT_FUNCARG2XV(this, &result);
1212
    CYG_PRECONDITION_THISC();
1213
    CYG_PRECONDITIONC("" != directory);
1214
 
1215
    std::vector<std::string> subdirs;
1216
    locate_subdirs(directory, subdirs);
1217
    std::vector<std::string>::const_iterator i, j;
1218
 
1219
    for (i = subdirs.begin(); i != subdirs.end(); i++) {
1220
        result.push_back(*i);
1221
        std::vector<std::string> its_subdirs;
1222
        locate_all_subdirs(directory + "/" + *i, its_subdirs);
1223
        for (j = its_subdirs.begin(); j != its_subdirs.end(); j++) {
1224
            result.push_back(*i + "/" + *j);
1225
        }
1226
    }
1227
 
1228
    CYG_REPORT_RETURN();
1229
}
1230
 
1231
// ----------------------------------------------------------------------------
1232
// Locating the files in a particular subdirectory. This requires another
1233
// simple Tcl script.
1234
void
1235
CdlInterpreterBody::locate_files(std::string directory, std::vector<std::string>& result)
1236
{
1237
    CYG_REPORT_FUNCNAME("CdlInterpreter::locate_files");
1238
    CYG_REPORT_FUNCARG2XV(this, &result);
1239
    CYG_PRECONDITION_THISC();
1240
    CYG_PRECONDITIONC("" != directory);
1241
 
1242
    static char locate_files_script[] = "\
1243
set pattern [file join \"$::cdl_locate_files_path\" *]  \n\
1244
set result {}                                           \n\
1245
foreach entry [glob -nocomplain -- $pattern] {          \n\
1246
    if ([file isdirectory $entry]) {                    \n\
1247
        continue                                        \n\
1248
    }                                                   \n\
1249
    set entry [file tail $entry]                        \n\
1250
    if {[string index $entry 0] != \".\"} {             \n\
1251
        lappend result $entry                           \n\
1252
    }                                                   \n\
1253
 }                                                      \n\
1254
return $result                                          \n\
1255
";
1256
 
1257
    std::string                 tcl_result;
1258
    set_variable("::cdl_locate_files_path", directory);
1259
    if (TCL_OK != eval(locate_files_script, tcl_result)) {
1260
        CYG_FAIL("Internal error evaluating Tcl script");
1261
    }
1262
    int             count;
1263
    const char**    array;
1264
    if (TCL_OK != Tcl_SplitList(tcl_interp, CDL_TCL_CONST_CAST(char*, tcl_result.c_str()), &count, CDL_TCL_CONST_CAST(char***, &array))) {
1265
        throw std::bad_alloc();
1266
    }
1267
    for (int i = 0; i < count; i++) {
1268
        result.push_back(array[i]);
1269
    }
1270
    Tcl_Free((char*) array);
1271
 
1272
    CYG_REPORT_RETURN();
1273
}
1274
 
1275
// ----------------------------------------------------------------------------
1276
// Locating all files can be achieved by combining locate_all_subdirs()
1277
// and locate_files().
1278
void
1279
CdlInterpreterBody::locate_all_files(std::string directory, std::vector<std::string>& result)
1280
{
1281
    CYG_REPORT_FUNCNAME("CdlInterpreter::locate_all_files");
1282
    CYG_REPORT_FUNCARG2XV(this, &result);
1283
    CYG_PRECONDITION_THISC();
1284
    CYG_PRECONDITIONC("" != directory);
1285
 
1286
    std::vector<std::string> files;
1287
    std::vector<std::string>::const_iterator i, j;
1288
    locate_files(directory, files);
1289
    for (i = files.begin(); i != files.end(); i++) {
1290
        result.push_back(*i);
1291
    }
1292
 
1293
    std::vector<std::string> all_subdirs;
1294
    locate_all_subdirs(directory, all_subdirs);
1295
    for (i = all_subdirs.begin(); i != all_subdirs.end(); i++) {
1296
        std::vector<std::string> subdir_files;
1297
        locate_files(directory + "/" + *i, subdir_files);
1298
        for (j = subdir_files.begin(); j != subdir_files.end(); j++) {
1299
            result.push_back(*i + "/" + *j);
1300
        }
1301
    }
1302
 
1303
    CYG_REPORT_RETURN();
1304
}
1305
 
1306
// ----------------------------------------------------------------------------
1307
// Write some data to a file, throwing an I/O exception on failure. This
1308
// functionality is needed whenever savefile data is generated, it is
1309
// convenient to have a utility function to do the job. Also, performing
1310
// the Tcl_Write involves passing const data as a non-const argument:
1311
// if this ever causes problems in future it is a good idea to isolate
1312
// the problem here.
1313
 
1314
void
1315
CdlInterpreterBody::write_data(Tcl_Channel chan, std::string data)
1316
{
1317
    CYG_REPORT_FUNCNAME("CdlInterpreter::write_data");
1318
    CYG_REPORT_FUNCARG2XV(this, chan);
1319
    CYG_PRECONDITION_THISC();
1320
 
1321
    if (-1 == Tcl_Write(chan, CDL_TCL_CONST_CAST(char*, data.data()), data.size())) {
1322
        std::string msg = "Unexpected error writing to file " + this->get_context() + " : " + Tcl_PosixError(tcl_interp);
1323
        throw CdlInputOutputException(msg);
1324
    }
1325
 
1326
    CYG_REPORT_RETURN();
1327
}
1328
 
1329
//}}}
1330
//{{{  CdlInterpreter:: quote() etc.                            
1331
 
1332
// ----------------------------------------------------------------------------
1333
// Given a string, quote it in such a way that the Tcl interpreter will
1334
// process it as a single word, but keep the result as human-readable
1335
// as possible. If there are no special characters then just return the
1336
// string itself. Otherwise quoting is necessary.
1337
//
1338
// The choice is between braces and double quotes. Generally braces
1339
// are better and more consistent, but there is a problem if the
1340
// string argument itself contains braces. These could be
1341
// backslash-escaped, but the Tcl interpreter will not automatically
1342
// remove the backslashes so we would end up with a discrepancy
1343
// between the original data and what is seen by the parser. In this
1344
// case quote marks have to be used instead.
1345
//
1346
// NOTE: this code may not behave sensibly when it comes to i18n
1347
// issues.
1348
 
1349
std::string
1350
CdlInterpreterBody::quote(std::string src)
1351
{
1352
    CYG_REPORT_FUNCNAME("CdlInterpreter::quote");
1353
 
1354
    std::string  result = "";
1355
    bool         contains_specials = false;
1356
    unsigned int i;
1357
 
1358
    if (0 == src.size()) {
1359
        // An empty string. The best way to represent this is an empty
1360
        // set of quotes.
1361
        result = "\"\"";
1362
        CYG_REPORT_RETURN();
1363
        return result;
1364
    }
1365
 
1366
    if ('#' == src[0]) {
1367
        contains_specials = true;
1368
    }
1369
 
1370
    for (i = 0; (i < src.size()) && !contains_specials; i++) {
1371
        if (isspace(src[i])) {
1372
            contains_specials = true;
1373
            break;
1374
        }
1375
        switch(src[i]) {
1376
          case '{':
1377
          case '}':
1378
          case '\\':
1379
          case '$':
1380
          case '"':
1381
          case '[':
1382
          case ']':
1383
          case '#':
1384
          case ';':
1385
              contains_specials = true;
1386
              break;
1387
 
1388
          default:
1389
              break;
1390
        }
1391
    }
1392
 
1393
    if (!contains_specials) {
1394
        result = src;
1395
    } else{
1396
        // If the data is a multiline item, it is better to start it in column 0.
1397
        // Unfortunately there is the question of what to do with the opening
1398
        // quote. Putting it on the current line, followed by a backslash-escaped
1399
        // newline, introduces a space into the string. If the string begins with
1400
        // a space anyway then arguably this would be harmless, but it could
1401
        // be confusing to the user. Putting the opening double quote into column 0
1402
        // means that the first line of data is indented relative to the rest of
1403
        // the data, but still appears to be the best alternative.
1404
        if (src.find('\n') != std::string::npos) {
1405
            result += "\\\n";
1406
        }
1407
        result += '\"';
1408
        for (i = 0; i < src.size(); i++) {
1409
            switch(src[i]) {
1410
              case '\\':
1411
              case '$':
1412
              case '"':
1413
              case '[':
1414
              case ']':
1415
                  result += '\\';
1416
                  result += src[i];
1417
                  break;
1418
 
1419
              default:
1420
                result += src[i];
1421
                break;
1422
            }
1423
        }
1424
        result += '\"';
1425
    }
1426
 
1427
    CYG_REPORT_RETURN();
1428
    return result;
1429
}
1430
 
1431
// ----------------------------------------------------------------------------
1432
// Given some data which may be multiline, return a string which corresponds
1433
// to that data turned into a comment.
1434
 
1435
std::string
1436
CdlInterpreterBody::multiline_comment(const std::string& orig, int first_indent, int second_indent)
1437
{
1438
    CYG_REPORT_FUNCNAME("CdlInterpreter::multiline_comment");
1439
 
1440
    std::string indent  = std::string(first_indent, ' ') + "# " + std::string(second_indent, ' ');
1441
    std::string result  = "";
1442
    bool indent_needed = true;
1443
 
1444
    std::string::const_iterator str_i;
1445
    for (str_i = orig.begin(); str_i != orig.end(); str_i++) {
1446
        if (indent_needed) {
1447
            result += indent;
1448
            indent_needed = false;
1449
        }
1450
        result += *str_i;
1451
        if ('\n' == *str_i) {
1452
            indent_needed = true;
1453
        }
1454
    }
1455
 
1456
    CYG_REPORT_RETURN();
1457
    return result;
1458
}
1459
 
1460
// ----------------------------------------------------------------------------
1461
// Given some data, append it to the current line and add additional commented
1462
// and indented lines as required.
1463
std::string
1464
CdlInterpreterBody::extend_comment(const std::string& orig, int first_indent, int second_indent)
1465
{
1466
    CYG_REPORT_FUNCNAME("CdlInterpreter::extend_comment");
1467
 
1468
    std::string indent  = std::string(first_indent, ' ') + "# " + std::string(second_indent, ' ');
1469
    std::string result = "";
1470
    bool indent_needed = false;
1471
 
1472
    std::string::const_iterator str_i;
1473
    for (str_i = orig.begin(); str_i != orig.end(); str_i++) {
1474
        if (indent_needed) {
1475
            result += indent;
1476
            indent_needed = false;
1477
        }
1478
        result += *str_i;
1479
        if ('\n' == *str_i) {
1480
            indent_needed = true;
1481
        }
1482
    }
1483
 
1484
    CYG_REPORT_RETURN();
1485
    return result;
1486
}
1487
 
1488
//}}}

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.