• Home
  • Features
  • Pricing
  • Docs
  • Announcements
  • Sign In

nickg / nvc / 13728091583

07 Mar 2025 07:43PM UTC coverage: 92.275% (-0.01%) from 92.285%
13728091583

push

github

web-flow
Update TCL channels and fix ARM_CRYPTO attributes (#1166)

0 of 2 new or added lines in 1 file covered. (0.0%)

7 existing lines in 1 file now uncovered.

68022 of 73717 relevant lines covered (92.27%)

483341.96 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

74.45
/src/rt/shell.c
1
//
2
//  Copyright (C) 2011-2024  Nick Gasson
3
//
4
//  This program is free software: you can redistribute it and/or modify
5
//  it under the terms of the GNU General Public License as published by
6
//  the Free Software Foundation, either version 3 of the License, or
7
//  (at your option) any later version.
8
//
9
//  This program is distributed in the hope that it will be useful,
10
//  but WITHOUT ANY WARRANTY; without even the implied warranty of
11
//  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12
//  GNU General Public License for more details.
13
//
14
//  You should have received a copy of the GNU General Public License
15
//  along with this program.  If not, see <http://www.gnu.org/licenses/>.
16
//
17

18
#include "util.h"
19
#include "common.h"
20
#include "diag.h"
21
#include "eval.h"
22
#include "hash.h"
23
#include "lib.h"
24
#include "lower.h"
25
#include "phase.h"
26
#include "printer.h"
27
#include "rt/assert.h"
28
#include "rt/model.h"
29
#include "rt/structs.h"
30
#include "scan.h"
31
#include "shell.h"
32
#include "tree.h"
33
#include "type.h"
34

35
#include <assert.h>
36
#include <errno.h>
37
#include <inttypes.h>
38
#include <stdarg.h>
39
#include <stdio.h>
40
#include <stdlib.h>
41
#include <string.h>
42
#include <unistd.h>
43

44
#include <readline/readline.h>
45
#include <readline/history.h>
46

47
#undef DLLEXPORT
48
#include <tcl.h>
49

50
#define TIME_BUFSZ 32
51

52
#if TCL_MAJOR_VERSION < 9
53
typedef int Tcl_Size;
54
#endif
55

56
typedef struct {
57
   const char     *name;
58
   Tcl_ObjCmdProc *fn;
59
   const char     *help;
60
} shell_cmd_t;
61

62
typedef enum {
63
   SHELL_SIGNAL,
64
   SHELL_REGION,
65
} object_kind_t;
66

67
typedef struct {
68
   object_kind_t kind;
69
   ident_t       name;
70
   ident_t       path;
71
} shell_object_t;
72

73
typedef struct {
74
   shell_object_t  obj;
75
   rt_signal_t    *signal;
76
   print_func_t   *printer;
77
   rt_watch_t     *watch;
78
   tcl_shell_t    *owner;
79
} shell_signal_t;
80

81
typedef struct {
82
   shell_object_t  obj;
83
   rt_scope_t     *scope;
84
} shell_region_t;
85

86
typedef char *(*get_line_fn_t)(tcl_shell_t *);
87

88
typedef struct _tcl_shell {
89
   char            *prompt;
90
   Tcl_Interp      *interp;
91
   shell_cmd_t     *cmds;
92
   size_t           ncmds;
93
   size_t           cmdalloc;
94
   rt_model_t      *model;
95
   tree_t           top;
96
   rt_scope_t      *root;
97
   shell_signal_t  *signals;
98
   unsigned         nsignals;
99
   shell_region_t  *regions;
100
   unsigned         nregions;
101
   hash_t          *namemap;
102
   jit_t           *jit;
103
   int64_t          now_var;
104
   unsigned         deltas_var;
105
   printer_t       *printer;
106
   get_line_fn_t    getline;
107
   jit_factory_t    make_jit;
108
   unit_registry_t *registry;
109
   shell_handler_t  handler;
110
   bool             quit;
111
   char            *datadir;
112
} tcl_shell_t;
113

114
static __thread tcl_shell_t *rl_shell = NULL;
115

116
__attribute__((format(printf, 2, 3)))
117
static int tcl_error(tcl_shell_t *sh, const char *fmt, ...)
4✔
118
{
119
   va_list ap;
4✔
120
   va_start(ap, fmt);
4✔
121
   char *buf LOCAL = color_vasprintf(fmt, ap);
4✔
122
   va_end(ap);
4✔
123

124
   Tcl_SetObjResult(sh->interp, Tcl_NewStringObj(buf, -1));
4✔
125
   return TCL_ERROR;
4✔
126
}
127

128
static void tcl_dict_put(tcl_shell_t *sh, Tcl_Obj *dict, const char *key,
14✔
129
                         Tcl_Obj *value)
130
{
131
   Tcl_DictObjPut(sh->interp, dict, Tcl_NewStringObj(key, -1), value);
14✔
132
}
14✔
133

134
static Tcl_Obj *tcl_ident_string(ident_t ident)
23✔
135
{
136
   return Tcl_NewStringObj(istr(ident), ident_len(ident));
23✔
137
}
138

139
static int syntax_error(tcl_shell_t *sh, Tcl_Obj *const objv[])
×
140
{
141
   return tcl_error(sh, "syntax error, enter $bold$help %s$$ for usage",
×
142
                    Tcl_GetString(objv[0]));
143
}
144

145
__attribute__((format(printf, 2, 3)))
146
static void shell_printf(tcl_shell_t *sh, const char *fmt, ...)
3✔
147
{
148
   va_list ap;
3✔
149
   va_start(ap, fmt);
3✔
150

151
   if (sh->handler.stdout_write != NULL) {
3✔
152
      char *buf LOCAL = color_vasprintf(fmt, ap);
6✔
153
      (*sh->handler.stdout_write)(buf, strlen(buf), sh->handler.context);
3✔
154
   }
155
   else
156
      wrapped_vprintf(fmt, ap);
×
157

158
   va_end(ap);
3✔
159
}
3✔
160

161
static bool shell_has_model(tcl_shell_t *sh)
73✔
162
{
163
   if (sh->model == NULL) {
73✔
164
      tcl_error(sh, "no simulation loaded, try the $bold$elaborate$$ "
×
165
                "command first");
166
      return false;
×
167
   }
168

169
   return true;
170
}
171

172
static void shell_clear_model(tcl_shell_t *sh)
29✔
173
{
174
   if (sh->model == NULL)
29✔
175
      return;
176

177
   model_free(sh->model);
8✔
178
   hash_free(sh->namemap);
8✔
179

180
   sh->model = NULL;
8✔
181
   sh->namemap = NULL;
8✔
182

183
   if (sh->handler.quit_sim != NULL)
8✔
184
      (*sh->handler.quit_sim)(sh->handler.context);
2✔
185
}
186

187
static void shell_next_time_step(rt_model_t *m, void *user)
5✔
188
{
189
   tcl_shell_t *sh = user;
5✔
190
   assert(sh->handler.next_time_step != NULL);
5✔
191

192
   uint64_t now = model_now(m, NULL);
5✔
193
   (*sh->handler.next_time_step)(now, sh->handler.context);
5✔
194

195
   model_set_global_cb(sh->model, RT_NEXT_TIME_STEP, shell_next_time_step, sh);
5✔
196
}
5✔
197

198
static void shell_create_model(tcl_shell_t *sh)
21✔
199
{
200
   assert(sh->model == NULL);
21✔
201

202
   sh->model = model_new(sh->jit, NULL);
21✔
203
   create_scope(sh->model, sh->top, NULL);
21✔
204

205
   if (sh->handler.next_time_step != NULL)
21✔
206
      model_set_global_cb(sh->model, RT_NEXT_TIME_STEP,
3✔
207
                          shell_next_time_step, sh);
208

209
   model_reset(sh->model);
21✔
210

211
   if ((sh->root = find_scope(sh->model, tree_stmt(sh->top, 0))) == NULL)
21✔
212
      fatal_trace("cannot find root scope");
213
}
21✔
214

215
static void shell_update_now(tcl_shell_t *sh)
37✔
216
{
217
   sh->now_var = model_now(sh->model, &sh->deltas_var);
37✔
218

219
   Tcl_UpdateLinkedVar(sh->interp, "now");
37✔
220
   Tcl_UpdateLinkedVar(sh->interp, "deltas");
37✔
221
}
37✔
222

223
static bool shell_get_printer(tcl_shell_t *sh, shell_signal_t *ss)
36✔
224
{
225
   if (ss->printer == NULL)
36✔
226
      ss->printer = printer_for(sh->printer, tree_type(ss->signal->where));
18✔
227

228
   if (ss->printer == NULL) {
36✔
229
      tcl_error(sh, "cannot display type %s",
×
230
                type_pp(tree_type(ss->signal->where)));
×
231
      return false;
×
232
   }
233

234
   return true;
235
}
236

237
static void shell_add_cmd(tcl_shell_t *sh, const char *name, Tcl_ObjCmdProc fn,
384✔
238
                          const char *help)
239
{
240
   shell_cmd_t cmd = { name, fn, help };
384✔
241

242
   if (sh->cmdalloc == sh->ncmds) {
384✔
243
      sh->cmdalloc = MAX(sh->cmdalloc * 2, 16);
24✔
244
      sh->cmds = xrealloc_array(sh->cmds, sh->cmdalloc, sizeof(shell_cmd_t));
24✔
245
   }
246

247
   sh->cmds[sh->ncmds++] = cmd;
384✔
248

249
   Tcl_CreateObjCommand(sh->interp, name, fn, sh, NULL);
384✔
250
}
384✔
251

252
static void shell_event_cb(uint64_t now, rt_signal_t *s, rt_watch_t *w,
5✔
253
                           void *user)
254
{
255
   shell_signal_t *ss = user;
5✔
256
   shell_handler_t *h = &(ss->owner->handler);
5✔
257

258
   if (h->signal_update != NULL) {
5✔
259
      const char *enc = print_signal(ss->printer, ss->signal, PRINT_F_ENCODE);
5✔
260
      (*h->signal_update)(ss->obj.path, now, s, enc, h->context);
5✔
261
   }
262
}
5✔
263

264
static void watch_signal(shell_signal_t *ss)
5✔
265
{
266
   ss->watch = watch_new(ss->owner->model, shell_event_cb, ss,
5✔
267
                         WATCH_POSTPONED, 1);
268
   model_set_event_cb(ss->owner->model, ss->signal, ss->watch);
5✔
269
}
5✔
270

271
static void recreate_objects(tcl_shell_t *sh, rt_scope_t *scope,
8✔
272
                             shell_signal_t **sptr, shell_region_t **rptr)
273
{
274
   shell_region_t *r = (*rptr)++;
8✔
275
   assert(r->obj.name == ident_downcase(tree_ident(scope->where)));
8✔
276
   r->scope = scope;
8✔
277

278
   for (int i = 0; i < scope->signals.count; i++) {
19✔
279
      shell_signal_t *ss = (*sptr)++;
11✔
280
      ss->signal = scope->signals.items[i];
11✔
281
      assert(ss->obj.name == ident_downcase(tree_ident(ss->signal->where)));
11✔
282

283
      if (ss->watch != NULL)
11✔
284
         watch_signal(ss);
1✔
285
   }
286

287
   for (int i = 0; i < scope->aliases.count; i++) {
12✔
288
      rt_alias_t *a = scope->aliases.items[i];
4✔
289

290
      shell_signal_t *ss = (*sptr)++;
4✔
291
      assert(ss->obj.name == ident_downcase(tree_ident(a->where)));
4✔
292
      ss->signal = a->signal;
4✔
293

294
      if (ss->watch != NULL)
4✔
295
         watch_signal(ss);
×
296
   }
297

298
   for (int i = 0; i < scope->children.count; i++)
12✔
299
      recreate_objects(sh, scope->children.items[i], sptr, rptr);
4✔
300
}
8✔
301

302
const char *next_option(int *pos, int objc, Tcl_Obj *const objv[])
52✔
303
{
304
   if (*pos >= objc)
52✔
305
      return NULL;
306

307
   const char *opt = Tcl_GetString(objv[*pos]);
49✔
308
   if (opt[0] != '-')
49✔
309
      return NULL;
310

311
   (*pos)++;
7✔
312
   return opt;
7✔
313
}
314

315
static shell_object_t *get_object(tcl_shell_t *sh, const char *name)
40✔
316
{
317
   shell_object_t *obj = hash_get(sh->namemap, ident_new(name));
40✔
318
   if (obj == NULL)
40✔
319
      tcl_error(sh, "cannot find name '%s'", name);
1✔
320

321
   return obj;
40✔
322
}
323

324
static shell_signal_t *get_signal(tcl_shell_t *sh, const char *name)
35✔
325
{
326
   shell_object_t *obj = get_object(sh, name);
35✔
327
   if (obj == NULL)
35✔
328
      return NULL;
329
   else if (obj->kind != SHELL_SIGNAL) {
35✔
330
      tcl_error(sh, "'%s' is not a signal", name);
×
331
      return NULL;
×
332
   }
333

334
   return container_of(obj, shell_signal_t, obj);
335
}
336

337
static const char restart_help[] =
338
   "Restart the simulation";
339

340
static int shell_cmd_restart(ClientData cd, Tcl_Interp *interp,
4✔
341
                             int objc, Tcl_Obj *const objv[])
342
{
343
   tcl_shell_t *sh = cd;
4✔
344

345
   if (!shell_has_model(sh))
4✔
346
      return TCL_ERROR;
347

348
   model_free(sh->model);
4✔
349
   sh->model = NULL;
4✔
350

351
   jit_reset(sh->jit);
4✔
352

353
   clear_vhdl_assert();
4✔
354
   for (vhdl_severity_t s = SEVERITY_NOTE; s <= SEVERITY_FAILURE; s++)
20✔
355
      set_vhdl_assert_enable(s, true);
16✔
356

357
   shell_create_model(sh);
4✔
358

359
   shell_signal_t *wptr = sh->signals;
4✔
360
   shell_region_t *rptr = sh->regions;
4✔
361
   recreate_objects(sh, sh->root, &wptr, &rptr);
4✔
362
   assert(wptr == sh->signals + sh->nsignals);
4✔
363
   assert(rptr == sh->regions + sh->nregions);
4✔
364

365
   shell_update_now(sh);
4✔
366

367
   if (sh->handler.restart_sim != NULL)
4✔
368
      (*sh->handler.restart_sim)(sh->handler.context);
1✔
369

370
   return TCL_OK;
371
}
372

373
static const char run_help[] =
374
   "Start or resume the simulation";
375

376
static int shell_cmd_run(ClientData cd, Tcl_Interp *interp,
16✔
377
                         int objc, Tcl_Obj *const objv[])
378
{
379
   tcl_shell_t *sh = cd;
16✔
380
   static bool sim_running = false;
16✔
381

382
   if (!shell_has_model(sh))
16✔
383
      return TCL_ERROR;
384
   else if (sim_running)
16✔
385
      return tcl_error(sh, "simulation already running");
×
386

387
   uint64_t stop_time = UINT64_MAX;
16✔
388
   if (objc == 3) {
16✔
389
      Tcl_WideInt base;
5✔
390
      int error = Tcl_GetWideIntFromObj(interp, objv[1], &base);
5✔
391
      if (error != TCL_OK || base <= 0)
5✔
392
         return tcl_error(sh, "invalid time");
×
393

394
      const char *unit = Tcl_GetString(objv[2]);
5✔
395

396
      uint64_t mult;
5✔
397
      if      (strcmp(unit, "fs") == 0) mult = 1;
5✔
398
      else if (strcmp(unit, "ps") == 0) mult = 1000;
5✔
399
      else if (strcmp(unit, "ns") == 0) mult = 1000000;
5✔
400
      else if (strcmp(unit, "us") == 0) mult = 1000000000;
×
401
      else if (strcmp(unit, "ms") == 0) mult = 1000000000000;
×
402
      else
403
         return tcl_error(sh, "invalid time unit %s", unit);
×
404

405
      stop_time = model_now(sh->model, NULL) + (base * mult);
5✔
406
   }
407
   else if (objc != 1)
11✔
408
      return tcl_error(sh, "usage: $bold$run [time units]$$");
×
409

410

411
   sim_running = true;
16✔
412
   model_run(sh->model, stop_time);
16✔
413
   sim_running = false;
16✔
414

415
   shell_update_now(sh);
16✔
416

417
   return TCL_OK;
16✔
418
}
419

420
static const char find_help[] =
421
   "Find signals and other objects in the design\n"
422
   "\n"
423
   "Syntax:\n"
424
   "  find signals [options] <pattern>\n"
425
   "  find regions [options] <pattern>\n"
426
   "\n"
427
   "Options:\n"
428
   "  -r, -recursive\tInclude subregions in wildcard search.\n"
429
   "\n"
430
   "Examples:\n"
431
   "  find signals -r /*\tList all signals in the design\n"
432
   "  find signals /uut/x*\tAll signals in instance UUT that start with X\n"
433
   "  find regions -r *\tList all regions in the design\n";
434

435
static int shell_cmd_find(ClientData cd, Tcl_Interp *interp,
6✔
436
                          int objc, Tcl_Obj *const objv[])
437
{
438
   tcl_shell_t *sh = cd;
6✔
439

440
   enum { SIGNALS, REGIONS } what;
6✔
441
   if (!shell_has_model(sh))
6✔
442
      return TCL_ERROR;
443
   else if (objc < 3)
6✔
444
      goto usage;
×
445
   else if (strcmp(Tcl_GetString(objv[1]), "signals") == 0)
6✔
446
      what = SIGNALS;
447
   else if (strcmp(Tcl_GetString(objv[1]), "regions") == 0)
×
448
      what = REGIONS;
449
   else
450
      goto usage;
×
451

452
   int pos = 2;
6✔
453
   for (const char *opt; (opt = next_option(&pos, objc, objv)); ) {
6✔
454
      if (strcmp(opt, "-recursive") == 0 || strcmp(opt, "-r") == 0) {
×
455
         // Always recursive for now...
456
      }
457
      else
458
         goto usage;
×
459
   }
460

461
   const char *glob = Tcl_GetString(objv[pos]);
6✔
462
   Tcl_Obj *result = Tcl_NewListObj(0, NULL);
6✔
463

464
   switch (what) {
6✔
465
   case SIGNALS:
466
      {
467
         for (int i = 0; i < sh->nsignals; i++) {
21✔
468
            if (!ident_glob(sh->signals[i].obj.path, glob, -1))
15✔
469
               continue;
×
470

471
            Tcl_Obj *obj = tcl_ident_string(sh->signals[i].obj.path);
15✔
472
            Tcl_ListObjAppendElement(interp, result, obj);
15✔
473
         }
474
      }
475
      break;
476

477
   case REGIONS:
478
      {
479
         for (int i = 0; i < sh->nregions; i++) {
×
480
            if (!ident_glob(sh->regions[i].obj.path, glob, -1))
×
481
               continue;
×
482

483
            Tcl_Obj *obj = tcl_ident_string(sh->regions[i].obj.path);
×
484
            Tcl_ListObjAppendElement(interp, result, obj);
×
485
         }
486
         break;
487
      }
488
      break;
489
   }
490

491
   Tcl_SetObjResult(interp, result);
6✔
492
   return TCL_OK;
6✔
493

494
 usage:
×
495
   return syntax_error(sh, objv);
×
496
}
497

498
static const char elaborate_help[] =
499
   "Elaborate a design hierarchy\n"
500
   "\n"
501
   "Syntax:\n"
502
   "  elaborate [options] <toplevel>\n"
503
   "\n"
504
   "Note \"vsim\" is an alias of this command.\n"
505
   "\n"
506
   "Options:\n"
507
   "\n"
508
   "Examples:\n"
509
   "  elaborate toplevel\n"
510
   "  vsim toplevel\n";
511

512
static int shell_cmd_elaborate(ClientData cd, Tcl_Interp *interp,
10✔
513
                               int objc, Tcl_Obj *const objv[])
514
{
515
   tcl_shell_t *sh = cd;
10✔
516
   LOCAL_TEXT_BUF tb = tb_new();
20✔
517

518
   int pos = 1;
10✔
519
   for (const char *opt; (opt = Tcl_GetString(objv[pos]))[0] == '-'; pos++)
10✔
520
      goto usage;
×
521

522
   if (pos + 1 != objc)
10✔
523
      goto usage;
×
524

525
   lib_t work = lib_work();
10✔
526

527
   tb_istr(tb, lib_name(work));
10✔
528
   tb_append(tb, '.');
10✔
529
   tb_cat(tb, Tcl_GetString(objv[pos]));
10✔
530
   tb_upcase(tb);
10✔
531

532
   tree_t unit = lib_get(lib_work(), ident_new(tb_get(tb)));
10✔
533
   if (unit == NULL)
10✔
534
      return tcl_error(sh, "cannot find unit %s in library %s",
×
535
                       Tcl_GetString(objv[pos]), istr(lib_name(work)));
536

537
   shell_clear_model(sh);
10✔
538

539
   reset_error_count();
10✔
540

541
   // Recreate the JIT instance and unit registry as it may have
542
   // references to stale code
543
   jit_free(sh->jit);
10✔
544
   unit_registry_free(sh->registry);
10✔
545
   sh->registry = unit_registry_new();
10✔
546
   sh->jit = (*sh->make_jit)(sh->registry);
10✔
547

548
   rt_model_t *m = model_new(sh->jit, NULL);
10✔
549
   tree_t top = elab(tree_to_object(unit), sh->jit, sh->registry,
10✔
550
                     NULL, NULL, m);
551
   model_free(m);   // XXX: reuse
10✔
552
   if (top == NULL)
10✔
553
      return TCL_ERROR;
554

555
   shell_reset(sh, top);
10✔
556
   return TCL_OK;
10✔
557

558
 usage:
×
559
   return syntax_error(sh, objv);
×
560
}
561

562
static const char examine_help[] =
563
   "Display current value of one of more signals\n"
564
   "\n"
565
   "Syntax:\n"
566
   "  examine [options] <name>...\n"
567
   "\n"
568
   "Note \"exa\" is an alias of this command.\n"
569
   "\n"
570
   "Options:\n"
571
   "  -radix <type>\tFormat as hexadecimal, decimal, or binary.\n"
572
   "  -<radix>\tAlias of \"-radix <radix>\".\n"
573
   "\n"
574
   "Examples:\n"
575
   "  examine /uut/foo\n"
576
   "  exa -hex sig\n";
577

578
static bool parse_radix(const char *str, print_flags_t *flags)
5✔
579
{
580
   if (strcmp(str, "binary") == 0 || strcmp(str, "bin") == 0
5✔
581
       || strcmp(str, "b") == 0) {
4✔
582
      *flags &= ~PRINT_F_RADIX;
1✔
583
      *flags |= PRINT_F_BIN;
1✔
584
      return true;
1✔
585
   }
586
   else if (strcmp(str, "-hexadecimal") == 0 || strcmp(str, "hex") == 0
4✔
587
            || strcmp(str, "h") == 0) {
1✔
588
      *flags &= ~PRINT_F_RADIX;
3✔
589
      *flags |= PRINT_F_HEX;
3✔
590
      return true;
3✔
591
   }
592
   else
593
      return false;
594
}
595

596
static int shell_cmd_examine(ClientData cd, Tcl_Interp *interp,
27✔
597
                             int objc, Tcl_Obj *const objv[])
598
{
599
   tcl_shell_t *sh = cd;
27✔
600

601
   if (!shell_has_model(sh))
27✔
602
      return TCL_ERROR;
603

604
   print_flags_t flags = 0;
27✔
605
   int pos = 1;
27✔
606
   for (const char *opt; (opt = next_option(&pos, objc, objv)); ) {
31✔
607
      if (parse_radix(opt + 1, &flags))
4✔
608
         continue;
3✔
609
      else if (strcmp(opt, "-radix") == 0 && pos + 1 < objc) {
1✔
610
         const char *arg = Tcl_GetString(objv[pos++]);
1✔
611
         if (!parse_radix(arg, &flags))
1✔
612
            goto usage;
×
613
      }
614
      else
615
         goto usage;
×
616
   }
617

618
   if (pos == objc)
27✔
619
      goto usage;
×
620

621
   const int count = objc - pos;
27✔
622
   Tcl_Obj *single[1], **result = single;
27✔
623

624
   if (count > 1)
27✔
625
      result = xmalloc_array(count, sizeof(Tcl_Obj *));
1✔
626

627
   for (int i = 0; pos < objc; pos++, i++) {
55✔
628
      const char *name = Tcl_GetString(objv[pos]);
28✔
629
      shell_signal_t *ss = get_signal(sh, name);
28✔
630
      if (ss == NULL)
28✔
631
         return TCL_ERROR;
632

633
      if (!shell_get_printer(sh, ss))
28✔
634
         return TCL_ERROR;
635

636
      const char *str = print_signal(ss->printer, ss->signal, flags);
28✔
637
      result[i] = Tcl_NewStringObj(str, -1);
28✔
638
   }
639

640
   if (count > 1) {
27✔
641
      Tcl_Obj *list = Tcl_NewListObj(count, result);
1✔
642
      Tcl_SetObjResult(interp, list);
1✔
643
      free(result);
1✔
644
   }
645
   else
646
      Tcl_SetObjResult(interp, result[0]);
26✔
647

648
   return TCL_OK;
649

650
 usage:
×
651
   return syntax_error(sh, objv);
×
652
}
653

654
static const char describe_help[] =
655
   "Return information about an object or region\n"
656
   "\n"
657
   "Syntax:\n"
658
   "  describe <name>...\n"
659
   "\n"
660
   "Examples:\n"
661
   "  describe /uut/foo\n"
662
   "  describe /uut\n";
663

664
static int shell_cmd_describe(ClientData cd, Tcl_Interp *interp,
5✔
665
                              int objc, Tcl_Obj *const objv[])
666
{
667
   tcl_shell_t *sh = cd;
5✔
668

669
   if (!shell_has_model(sh))
5✔
670
      return TCL_ERROR;
671

672
   int pos = 1;
5✔
673
   for (const char *opt; (opt = next_option(&pos, objc, objv)); ) {
5✔
674
      goto usage;
×
675
   }
676

677
   if (pos == objc)
5✔
678
      goto usage;
×
679

680
   const int count = objc - pos;
5✔
681
   Tcl_Obj *single[1], **result = single;
5✔
682

683
   if (count > 1)
5✔
684
      result = xmalloc_array(count, sizeof(Tcl_Obj *));
×
685

686
   for (int i = 0; pos < objc; pos++, i++) {
9✔
687
      const char *name = Tcl_GetString(objv[pos]);
5✔
688
      shell_object_t *obj = get_object(sh, name);
5✔
689
      if (obj == NULL)
5✔
690
         return TCL_ERROR;
691

692
      Tcl_Obj *d = result[i] = Tcl_NewDictObj();
4✔
693

694
      tcl_dict_put(sh, d, "name", tcl_ident_string(obj->name));
4✔
695
      tcl_dict_put(sh, d, "path", tcl_ident_string(obj->path));
4✔
696

697
      switch (obj->kind) {
4✔
698
      case SHELL_SIGNAL:
2✔
699
         {
700
            tcl_dict_put(sh, d, "kind", Tcl_NewStringObj("signal", -1));
2✔
701

702
            shell_signal_t *ss = container_of(obj, shell_signal_t, obj);
2✔
703
            type_t type = tree_type(ss->signal->where);
2✔
704
            tcl_dict_put(sh, d, "type", Tcl_NewStringObj(type_pp(type), -1));
2✔
705
         }
706
         break;
2✔
707
      case SHELL_REGION:
2✔
708
         tcl_dict_put(sh, d, "kind", Tcl_NewStringObj("region", -1));
2✔
709
         break;
2✔
710
      }
711
   }
712

713
   if (count > 1) {
4✔
714
      Tcl_Obj *list = Tcl_NewListObj(count, result);
×
715
      Tcl_SetObjResult(interp, list);
×
716
      free(result);
×
717
   }
718
   else
719
      Tcl_SetObjResult(interp, result[0]);
4✔
720

721
   return TCL_OK;
722

723
 usage:
×
724
   return syntax_error(sh, objv);
×
725
}
726

727
static const char force_help[] =
728
   "Force the value of a signal\n"
729
   "\n"
730
   "Syntax:\n"
731
   "  force [<signal> <value>]\n"
732
   "\n"
733
   "Value can be either an enumeration literal ('1', true), an integer "
734
   "(42, 0), or a bit string literal (\"10111\") and must be appropriate "
735
   "for the signal type. Without arguments lists all currently forced "
736
   "signals.\n"
737
   "\n"
738
   "Examples:\n"
739
   "  force /uut/foo '1'\n"
740
   "  force /bitvec \"10011\"\n";
741

742
static int shell_cmd_force(ClientData cd, Tcl_Interp *interp,
6✔
743
                           int objc, Tcl_Obj *const objv[])
744
{
745
   tcl_shell_t *sh = cd;
6✔
746

747
   if (!shell_has_model(sh))
6✔
748
      return TCL_ERROR;
749
   else if (objc != 3 && objc != 1)
6✔
750
      return syntax_error(sh, objv);
×
751

752
   if (objc == 1) {
6✔
753
      for (int i = 0; i < sh->nsignals; i++) {
4✔
754
         shell_signal_t *ss = &(sh->signals[i]);
3✔
755
         if (!(ss->signal->nexus.flags & NET_F_FORCED))
3✔
756
            continue;
×
757

758
         if (!shell_get_printer(sh, ss))
3✔
759
            return TCL_ERROR;
×
760

761
         const size_t nbytes = ss->signal->shared.size;
3✔
762
         uint8_t *value LOCAL = xmalloc(nbytes);
6✔
763
         get_forcing_value(ss->signal, value);
3✔
764

765
         shell_printf(sh, "force %s %s\n", istr(ss->obj.path),
3✔
766
                      print_raw(ss->printer, value, nbytes, 0));
767
      }
768

769
      return TCL_OK;
770
   }
771

772
   const char *signame = Tcl_GetString(objv[1]);
5✔
773
   const char *valstr = Tcl_GetString(objv[2]);
5✔
774

775
   shell_signal_t *ss = get_signal(sh, signame);
5✔
776
   if (ss == NULL)
5✔
777
      return TCL_ERROR;
778

779
   type_t type = tree_type(ss->signal->where);
5✔
780

781
   parsed_value_t value;
5✔
782
   if (!parse_value(type, valstr, &value))
5✔
783
      return tcl_error(sh, "value '%s' is not valid for type %s",
1✔
784
                       valstr, type_pp(type));
785

786
   if (type_is_scalar(type))
4✔
787
      force_signal(sh->model, ss->signal, &value.integer, 0, 1);
2✔
788
   else if (type_is_character_array(type)) {
2✔
789
      const int width = signal_width(ss->signal);
2✔
790
      if (value.enums->count != width) {
2✔
791
         tcl_error(sh, "expected %d elements for signal %s but have %d", width,
1✔
792
                   signame, value.enums->count);
793
         free(value.enums);
1✔
794
         return TCL_ERROR;
1✔
795
      }
796

797
      force_signal(sh->model, ss->signal, value.enums->values, 0, width);
1✔
798
      free(value.enums);
1✔
799
   }
800
   else
801
      return tcl_error(sh, "cannot force signals of type %s", type_pp(type));
×
802

803
   return TCL_OK;
804
}
805

806
static const char noforce_help[] =
807
   "Stop forcing the value of signals\n"
808
   "\n"
809
   "Syntax:\n"
810
   "  noforce <signal>...\n"
811
   "  noforce *\n"
812
   "\n"
813
   "The second form stops forcing all currently forced signals.\n"
814
   "\n"
815
   "Examples:\n"
816
   "  noforce /uut/foo /baz\n";
817

818
static int shell_cmd_noforce(ClientData cd, Tcl_Interp *interp,
3✔
819
                             int objc, Tcl_Obj *const objv[])
820
{
821
   tcl_shell_t *sh = cd;
3✔
822

823
   if (!shell_has_model(sh))
3✔
824
      return TCL_ERROR;
825
   else if (objc == 1)
3✔
826
      return syntax_error(sh, objv);
×
827

828
   for (int i = 1; i < objc; i++) {
5✔
829
      const char *signame = Tcl_GetString(objv[i]);
3✔
830
      if (strcmp(signame, "*") == 0) {
3✔
831
         for (int i = 0; i < sh->nsignals; i++) {
4✔
832
            shell_signal_t *ss = &(sh->signals[i]);
3✔
833
            if (ss->signal->nexus.flags & NET_F_FORCED)
3✔
834
               release_signal(sh->model, ss->signal, 0,
2✔
835
                              signal_width(ss->signal));
2✔
836
         }
837
      }
838
      else {
839
         shell_signal_t *ss = get_signal(sh, signame);
2✔
840
         if (ss == NULL)
2✔
841
            return TCL_ERROR;
842

843
         if (!(ss->signal->nexus.flags & NET_F_FORCED))
2✔
844
            return tcl_error(sh, "signal %s is not forced", signame);
1✔
845

846
         release_signal(sh->model, ss->signal, 0, signal_width(ss->signal));
1✔
847
      }
848
   }
849

850
   return TCL_OK;
851
}
852

853
static const char add_help[] =
854
   "Add signals and other objects to the display\n"
855
   "\n"
856
   "Syntax:\n"
857
   "  add wave [options] <name>...\n"
858
   "\n"
859
   "Options:\n"
860
   "  -r, -recursive\tInclude subregions in wildcard search.\n"
861
   "\n"
862
   "Examples:\n"
863
   "  add wave /*\tAdd all signals to waveform\n";
864

865
static int shell_cmd_add(ClientData cd, Tcl_Interp *interp,
4✔
866
                         int objc, Tcl_Obj *const objv[])
867
{
868
   tcl_shell_t *sh = cd;
4✔
869
   char **globs LOCAL = NULL;
8✔
870

871
   if (objc < 3 || strcmp(Tcl_GetString(objv[1]), "wave") != 0)
4✔
872
      goto usage;
×
873
   else if (!shell_has_model(sh))
4✔
874
      return TCL_ERROR;
875

876
   int pos = 2;
4✔
877
   for (const char *opt; (opt = next_option(&pos, objc, objv)); ) {
4✔
878
      if (strcmp(opt, "-recursive") == 0 || strcmp(opt, "-r") == 0) {
×
879
         // Always recursive for now...
880
      }
881
      else
882
         goto usage;
×
883
   }
884

885
   const int nglobs = objc - pos;
4✔
886
   globs = xmalloc_array(nglobs, sizeof(char *));
4✔
887
   for (int i = 0; i < nglobs; i++)
9✔
888
      globs[i] = Tcl_GetString(objv[pos++]);
5✔
889

890
   for (int i = 0; i < sh->nsignals; i++) {
16✔
891
      shell_signal_t *ss = &(sh->signals[i]);
12✔
892

893
      bool match = false;
12✔
894
      for (int j = 0; j < nglobs; j++)
27✔
895
         match |= ident_glob(ss->obj.path, globs[j], -1);
15✔
896

897
      if (!match || !shell_get_printer(sh, ss))
12✔
898
         continue;
7✔
899

900
      if (sh->handler.add_wave != NULL) {
5✔
901
         const char *enc =
5✔
902
            print_signal(ss->printer, ss->signal, PRINT_F_ENCODE);
5✔
903
         (*sh->handler.add_wave)(ss->obj.path, enc, sh->handler.context);
5✔
904
      }
905

906
      if (ss->watch == NULL)
5✔
907
         watch_signal(ss);
4✔
908
   }
909

910
   return TCL_OK;
911

912
 usage:
×
913
   return syntax_error(sh, objv);
×
914
}
915

916
static const char quit_help[] =
917
   "Exit the simulator or unload the current design\n"
918
   "\n"
919
   "Syntax:\n"
920
   "  quit [-sim]\n"
921
   "\n"
922
   "Options:\n"
923
   "  -sim\t\tUnload the current simulation but do not exit the program.\n";
924

925
static int shell_cmd_quit(ClientData cd, Tcl_Interp *interp,
2✔
926
                          int objc, Tcl_Obj *const objv[])
927
{
928
   tcl_shell_t *sh = cd;
2✔
929

930
   bool quit_sim = false;
2✔
931
   int pos = 1;
2✔
932
   for (const char *opt; (opt = next_option(&pos, objc, objv)); ) {
4✔
933
      if (strcmp(opt, "-sim") == 0)
2✔
934
         quit_sim = true;
935
      else
936
         goto usage;
×
937
   }
938

939
   if (pos != objc)
2✔
940
      goto usage;
×
941

942
   if (quit_sim) {
2✔
943
      if (!shell_has_model(sh))
2✔
944
         return TCL_ERROR;
945
      else
946
         shell_clear_model(sh);
2✔
947
   }
948
   else {
949
      sh->quit = true;
×
950

951
      if (sh->handler.exit != NULL)
×
952
         (*sh->handler.exit)(0, sh->handler.context);
×
953
   }
954

955
   return TCL_OK;
956

957
 usage:
×
958
   return syntax_error(sh, objv);
×
959
}
960

961
static const char exit_help[] =
962
   "Exit the simulator and return a status code\n"
963
   "\n"
964
   "Syntax:\n"
965
   "  exit [-code <integer>]\n"
966
   "\n"
967
   "Options:\n"
968
   "  -code <integer>\tStatus code to return to shell.\n";
969

970
static int shell_cmd_exit(ClientData cd, Tcl_Interp *interp,
1✔
971
                          int objc, Tcl_Obj *const objv[])
972
{
973
   tcl_shell_t *sh = cd;
1✔
974

975
   int pos = 1, status = EXIT_SUCCESS;
1✔
976
   for (const char *opt; (opt = next_option(&pos, objc, objv)); ) {
2✔
977
      if (strcmp(opt, "-code") == 0 && pos < objc)
1✔
978
         status = atoi(Tcl_GetString(objv[pos++]));
1✔
979
      else
980
         goto usage;
×
981
   }
982

983
   if (pos != objc)
1✔
984
      goto usage;
×
985

986
   if (sh->handler.exit != NULL)
1✔
987
      (*sh->handler.exit)(status, sh->handler.context);
1✔
988

989
   Tcl_Exit(status);
1✔
990

991
 usage:
×
992
   return syntax_error(sh, objv);
×
993
}
994

995
static const char help_help[] =
996
   "Display list of commands or detailed help\n"
997
   "\n"
998
   "Use $bold$help <command>$$ to display detailed usage of a particular\n"
999
   "command.\n";
1000

1001
static int shell_cmd_help(ClientData cd, Tcl_Interp *interp,
×
1002
                          int objc, Tcl_Obj *const objv[])
1003
{
1004
   tcl_shell_t *sh = cd;
×
1005

1006
   if (objc == 2) {
×
1007
      const char *which = Tcl_GetString(objv[1]);
×
1008
      for (int i = 0; i < sh->ncmds; i++) {
×
1009
         if (strcmp(sh->cmds[i].name, which) == 0) {
×
1010
            shell_printf(sh, "%s", sh->cmds[i].help);
×
1011
            return TCL_OK;
×
1012
         }
1013
      }
1014

1015
      return tcl_error(sh, "invalid command '%s'", which);
×
1016
   }
1017
   else if (objc != 1)
×
1018
      return tcl_error(sh, "syntax error, try $bold$help$$");
×
1019

1020
   shell_printf(sh, "List of supported commands:\n");
×
1021

1022
   for (shell_cmd_t *c = sh->cmds; c < sh->cmds + sh->ncmds; c++) {
×
1023
      const int linelen = strchrnul(c->help, '\n') - c->help;
×
1024
      shell_printf(sh, "  $bold$%-16s$$%.*s\n", c->name, linelen, c->help);
×
1025
   }
1026

1027
   shell_printf(sh, "\n");
×
1028
   shell_printf(sh, "Use $bold$help <command>$$ for detailed usage "
×
1029
                "of a particular command. Standard TCL commands are "
1030
                "also accepted.\n");
1031

1032
   return TCL_OK;
×
1033
}
1034

1035
static const char copyright_help[] = "Display copyright information";
1036

1037
static int shell_cmd_copyright(ClientData cd, Tcl_Interp *interp,
×
1038
                               int objc, Tcl_Obj *const objv[])
1039
{
1040
   Tcl_Channel channel = Tcl_GetStdChannel(TCL_STDOUT);
×
1041

1042
   extern char copy_string[];
×
1043
   Tcl_WriteChars(channel, copy_string, -1);
×
1044
   Tcl_WriteChars(channel, "\n", 1);
×
1045
   Tcl_Flush(channel);
×
1046

1047
   return TCL_OK;
×
1048
}
1049

1050
static const char echo_help[] = "Display value of arguments";
1051

1052
static int shell_cmd_echo(ClientData cd, Tcl_Interp *interp,
1✔
1053
                          int objc, Tcl_Obj *const objv[])
1054
{
1055
   Tcl_Channel channel = Tcl_GetStdChannel(TCL_STDOUT);
1✔
1056

1057
   for (int i = 1; i < objc; i++) {
3✔
1058
      if (i > 1) Tcl_WriteChars(channel, " ", 1);
2✔
1059
      Tcl_WriteObj(channel, objv[i]);
2✔
1060
   }
1061

1062
   Tcl_WriteChars(channel, "\n", 1);
1✔
1063
   Tcl_Flush(channel);
1✔
1064

1065
   return TCL_OK;
1✔
1066
}
1067

1068
static char *shell_list_generator(const char *script, const char *text,
×
1069
                                  int state, int prefix)
1070
{
1071
   static Tcl_Obj *list = NULL;
×
NEW
1072
   static int index, len;
×
NEW
1073
   static Tcl_Size max;
×
1074

1075
   if (!state) {
×
1076
      if (Tcl_Eval(rl_shell->interp, script) != TCL_OK)
×
1077
         return NULL;
1078

1079
      list = Tcl_GetObjResult(rl_shell->interp);
×
1080

1081
      if (Tcl_ListObjLength(rl_shell->interp, list, &max) != TCL_OK)
×
1082
         return NULL;
1083

1084
      index = 0;
×
1085
      len = strlen(text);
×
1086
   }
1087

1088
   while (index < max) {
×
1089
      Tcl_Obj *obj;
×
1090
      if (Tcl_ListObjIndex(rl_shell->interp, list, index++, &obj) != TCL_OK)
×
1091
         return NULL;
×
1092

1093
      const char *str = Tcl_GetString(obj);
×
1094
      if (strncmp(str, text + prefix, len - prefix) == 0) {
×
1095
         if (prefix == 0)
×
1096
            return xstrdup(str);
×
1097
         else {
1098
            assert(len >= prefix);
×
1099
            const size_t complen = strlen(str);
×
1100
            char *buf = xmalloc(prefix + complen + 1);
×
1101
            memcpy(buf, text, prefix);
×
1102
            memcpy(buf + prefix, str, complen + 1);
×
1103
            return buf;
×
1104
         }
1105
      }
1106
   }
1107

1108
   return NULL;
1109
}
1110

1111
static char *shell_command_generator(const char *text, int state)
×
1112
{
1113
   return shell_list_generator("info commands", text, state, 0);
×
1114
}
1115

1116
static char *shell_variable_generator(const char *text, int state)
×
1117
{
1118
   return shell_list_generator("info vars", text, state, 1);
×
1119
}
1120

1121
static char **shell_tab_completion(const char *text, int start, int end)
×
1122
{
1123
   rl_attempted_completion_over = 0;
×
1124

1125
   if (text[0] == '$')
×
1126
      return rl_completion_matches(text, shell_variable_generator);
×
1127

1128
   // Determine if we are completing a TCL command or not
1129
   int pos = start - 1;
×
1130
   for (; pos >= 0 && isspace_iso88591(rl_line_buffer[pos]); pos--);
×
1131

1132
   if (pos == -1 || rl_line_buffer[pos] == '[')
×
1133
      return rl_completion_matches(text, shell_command_generator);
×
1134

1135
   return NULL;
1136
}
1137

1138
static char *shell_completing_get_line(tcl_shell_t *sh)
×
1139
{
1140
   rl_attempted_completion_function = shell_tab_completion;
×
1141
   rl_completer_quote_characters = "\"'";
×
1142
   rl_completer_word_break_characters = " \t\r\n[]{}";
×
1143
   rl_special_prefixes = "$";
×
1144
   rl_shell = sh;
×
1145

1146
   char *buf = readline(sh->prompt);
×
1147
   if ((buf != NULL) && (*buf != '\0'))
×
1148
      add_history(buf);
×
1149

1150
   rl_shell = NULL;
×
1151
   return buf;
×
1152
}
1153

1154

1155
static char *shell_raw_get_line(tcl_shell_t *sh)
×
1156
{
1157
   fputs(sh->prompt, stdout);
×
1158
   fflush(stdout);
×
1159

1160
   LOCAL_TEXT_BUF tb = tb_new();
×
1161

1162
   size_t off = 0;
×
1163
   for (;;) {
×
1164
      int ch = fgetc(stdin);
×
1165
      fputc(ch, stdout);
×
1166
      switch (ch) {
×
1167
      case EOF:
1168
         return (off > 0) ? tb_claim(tb) : NULL;
1169
      case '\n':
×
1170
         return tb_claim(tb);
×
1171
      default:
×
1172
         tb_append(tb, ch);
×
1173
      }
1174
   }
1175
}
1176

1177
void shell_print_banner(tcl_shell_t *sh)
×
1178
{
1179
   extern const char version_string[];
×
1180
   shell_printf(sh, "\n");
×
1181

1182
   if (sh->handler.stdout_write == NULL)
×
1183
      print_centred(version_string);
×
1184
   else
1185
      shell_printf(sh, "\t%s", version_string);
×
1186

1187
   static const char blurb[] =
×
1188
      "\n\nThis program comes with ABSOLUTELY NO WARRANTY. This is free "
1189
      "software, and you are welcome to redistribute it under certain "
1190
      "conditions; type $bold$copyright$$ for details.\n\n"
1191
      "Type $bold$help$$ for a list of supported commands.\n\n";
1192

1193
   shell_printf(sh, blurb);
×
1194
}
×
1195

1196
static int compare_shell_cmd(const void *a, const void *b)
1,416✔
1197
{
1198
   return strcmp(((shell_cmd_t *)a)->name, ((shell_cmd_t *)b)->name);
1,416✔
1199
}
1200

1201
tcl_shell_t *shell_new(jit_factory_t make_jit, unit_registry_t *registry)
24✔
1202
{
1203
   tcl_shell_t *sh = xcalloc(sizeof(tcl_shell_t));
24✔
1204
#ifdef RL_VERSION_MAJOR
1205
   sh->prompt   = color_asprintf("\001$+cyan$\002%%\001$$\002 ");
24✔
1206
#else
1207
   sh->prompt   = color_asprintf("$+cyan$%%$$ ");
1208
#endif
1209
   sh->interp   = Tcl_CreateInterp();
24✔
1210
   sh->make_jit = make_jit;
24✔
1211
   sh->registry = registry ?: unit_registry_new();
24✔
1212
   sh->jit      = make_jit ? (*make_jit)(sh->registry) : NULL;
24✔
1213
   sh->printer  = printer_new();
24✔
1214

1215
   if (isatty(fileno(stdin)))
24✔
1216
      sh->getline = shell_completing_get_line;
×
1217
   else
1218
      sh->getline = shell_raw_get_line;
24✔
1219

1220
   if (Tcl_Init(sh->interp) != 0)
24✔
1221
      fatal("%s", Tcl_GetStringResult(sh->interp));
×
1222

1223
   Tcl_LinkVar(sh->interp, "now", (char *)&sh->now_var,
24✔
1224
               TCL_LINK_WIDE_INT | TCL_LINK_READ_ONLY);
1225
   Tcl_LinkVar(sh->interp, "deltas", (char *)&sh->deltas_var,
24✔
1226
               TCL_LINK_UINT | TCL_LINK_READ_ONLY);
1227

1228
   {
1229
      LOCAL_TEXT_BUF tb = tb_new();
24✔
1230
      get_data_dir(tb);
24✔
1231
      sh->datadir = tb_claim(tb);
24✔
1232
   }
1233
   Tcl_LinkVar(sh->interp, "nvc_dataDir", (char *)&sh->datadir,
24✔
1234
               TCL_LINK_READ_ONLY | TCL_LINK_STRING);
1235

1236
   atexit(Tcl_Finalize);
24✔
1237

1238
   Tcl_DeleteCommand(sh->interp, "exit");
24✔
1239

1240
   shell_add_cmd(sh, "help", shell_cmd_help, help_help);
24✔
1241
   shell_add_cmd(sh, "exit", shell_cmd_exit, exit_help);
24✔
1242
   shell_add_cmd(sh, "copyright", shell_cmd_copyright, copyright_help);
24✔
1243
   shell_add_cmd(sh, "find", shell_cmd_find, find_help);
24✔
1244
   shell_add_cmd(sh, "run", shell_cmd_run, run_help);
24✔
1245
   shell_add_cmd(sh, "restart", shell_cmd_restart, restart_help);
24✔
1246
   shell_add_cmd(sh, "elaborate", shell_cmd_elaborate, elaborate_help);
24✔
1247
   shell_add_cmd(sh, "vsim", shell_cmd_elaborate, elaborate_help);
24✔
1248
   shell_add_cmd(sh, "examine", shell_cmd_examine, examine_help);
24✔
1249
   shell_add_cmd(sh, "exa", shell_cmd_examine, examine_help);
24✔
1250
   shell_add_cmd(sh, "add", shell_cmd_add, add_help);
24✔
1251
   shell_add_cmd(sh, "quit", shell_cmd_quit, quit_help);
24✔
1252
   shell_add_cmd(sh, "force", shell_cmd_force, force_help);
24✔
1253
   shell_add_cmd(sh, "noforce", shell_cmd_noforce, noforce_help);
24✔
1254
   shell_add_cmd(sh, "echo", shell_cmd_echo, echo_help);
24✔
1255
   shell_add_cmd(sh, "describe", shell_cmd_describe, describe_help);
24✔
1256

1257
   qsort(sh->cmds, sh->ncmds, sizeof(shell_cmd_t), compare_shell_cmd);
24✔
1258

1259
   return sh;
24✔
1260
}
1261

1262
void shell_free(tcl_shell_t *sh)
13✔
1263
{
1264
   if (sh->model != NULL) {
13✔
1265
      model_free(sh->model);
9✔
1266
      hash_free(sh->namemap);
9✔
1267
      free(sh->signals);
9✔
1268
      free(sh->regions);
9✔
1269
   }
1270

1271
   if (sh->jit != NULL)
13✔
1272
      jit_free(sh->jit);
10✔
1273

1274
   unit_registry_free(sh->registry);
13✔
1275
   printer_free(sh->printer);
13✔
1276
   Tcl_DeleteInterp(sh->interp);
13✔
1277

1278
   free(sh->datadir);
13✔
1279
   free(sh->prompt);
13✔
1280
   free(sh->cmds);
13✔
1281
   free(sh);
13✔
1282
}
13✔
1283

1284
bool shell_eval(tcl_shell_t *sh, const char *script, const char **result)
54✔
1285
{
1286
   const int code = Tcl_Eval(sh->interp, script);
54✔
1287

1288
   switch (code) {
53✔
1289
   case TCL_OK:
49✔
1290
      if (result != NULL)
49✔
1291
         *result = Tcl_GetStringResult(sh->interp);
49✔
1292
      return true;
1293
   case TCL_ERROR:
4✔
1294
      {
1295
         const char *info = Tcl_GetVar(sh->interp, "::errorInfo", 0);
4✔
1296
         if (info != NULL && *info != '\n')
4✔
1297
            errorf("%s", info);
4✔
1298

1299
         *result = Tcl_GetStringResult(sh->interp);
4✔
1300
         if (info == NULL && *result != NULL && **result != '\0')
4✔
1301
            errorf("%s", *result);
×
1302
      }
1303
      return false;
1304
   default:
×
1305
      warnf("Tcl_Eval returned unknown code %d", code);
×
1306
      return false;
×
1307
   }
1308
}
1309

1310
static void count_objects(rt_scope_t *scope, unsigned *nsignals,
26✔
1311
                          unsigned *nregions)
1312
{
1313
   *nsignals += scope->signals.count + scope->aliases.count;
26✔
1314
   *nregions += 1;
26✔
1315

1316
   for (int i = 0; i < scope->children.count;i ++)
35✔
1317
      count_objects(scope->children.items[i], nsignals, nregions);
9✔
1318
}
26✔
1319

1320
static void recurse_objects(tcl_shell_t *sh, rt_scope_t *scope,
26✔
1321
                            text_buf_t *path, shell_signal_t **sptr,
1322
                            shell_region_t **rptr)
1323
{
1324
   const int base = tb_len(path);
26✔
1325

1326
   shell_region_t *r = (*rptr)++;
26✔
1327
   r->scope = scope;
26✔
1328
   r->obj.kind = SHELL_REGION;
26✔
1329
   r->obj.name = ident_downcase(tree_ident(scope->where));
26✔
1330
   r->obj.path = ident_new(tb_get(path));
26✔
1331

1332
   hash_put(sh->namemap, r->obj.path, &(r->obj));
26✔
1333

1334
   for (int i = 0; i < scope->signals.count; i++) {
67✔
1335
      shell_signal_t *ss = (*sptr)++;
41✔
1336
      ss->signal = scope->signals.items[i];
41✔
1337
      ss->obj.kind = SHELL_SIGNAL;
41✔
1338
      ss->obj.name = ident_downcase(tree_ident(ss->signal->where));
41✔
1339
      ss->owner = sh;
41✔
1340

1341
      tb_istr(path, ss->obj.name);
41✔
1342
      ss->obj.path = ident_new(tb_get(path));
41✔
1343
      tb_trim(path, base);
41✔
1344

1345
      hash_put(sh->namemap, ss->obj.path, &(ss->obj));
41✔
1346
   }
1347

1348
   for (int i = 0; i < scope->aliases.count; i++) {
34✔
1349
      rt_alias_t *a = scope->aliases.items[i];
8✔
1350

1351
      shell_signal_t *ss = (*sptr)++;
8✔
1352
      ss->signal = a->signal;
8✔
1353
      ss->obj.kind = SHELL_SIGNAL;
8✔
1354
      ss->obj.name = ident_downcase(tree_ident(a->where));
8✔
1355
      ss->owner = sh;
8✔
1356

1357
      tb_istr(path, ss->obj.name);
8✔
1358
      ss->obj.path = ident_new(tb_get(path));
8✔
1359
      tb_trim(path, base);
8✔
1360

1361
      hash_put(sh->namemap, ss->obj.path, &(ss->obj));
8✔
1362
   }
1363

1364
   for (int i = 0; i < scope->children.count; i++) {
35✔
1365
      rt_scope_t *child = scope->children.items[i];
9✔
1366
      ident_t name = ident_downcase(tree_ident(child->where));
9✔
1367
      tb_istr(path, name);
9✔
1368
      tb_append(path, '/');
9✔
1369
      recurse_objects(sh, child, path, sptr, rptr);
9✔
1370
      tb_trim(path, base);
9✔
1371
   }
1372
}
26✔
1373

1374
void shell_reset(tcl_shell_t *sh, tree_t top)
17✔
1375
{
1376
   shell_clear_model(sh);
17✔
1377

1378
   jit_reset(sh->jit);
17✔
1379

1380
   sh->top = top;
17✔
1381

1382
   shell_create_model(sh);
17✔
1383

1384
   sh->nsignals = sh->nregions = 0;
17✔
1385
   count_objects(sh->root, &sh->nsignals, &sh->nregions);
17✔
1386

1387
   sh->signals = xcalloc_array(sh->nsignals, sizeof(shell_signal_t));
17✔
1388
   sh->regions = xcalloc_array(sh->nregions, sizeof(shell_region_t));
17✔
1389
   sh->namemap = hash_new(1 + sh->nsignals * 2);
17✔
1390

1391
   text_buf_t *path = tb_new();
17✔
1392
   shell_signal_t *sptr = sh->signals;
17✔
1393
   shell_region_t *rptr = sh->regions;
17✔
1394
   tb_cat(path, "/");
17✔
1395
   recurse_objects(sh, sh->root, path, &sptr, &rptr);
17✔
1396
   assert(sptr == sh->signals + sh->nsignals);
17✔
1397
   assert(rptr == sh->regions + sh->nregions);
17✔
1398
   tb_free(path);
17✔
1399

1400
   shell_update_now(sh);
17✔
1401

1402
   if (sh->handler.start_sim != NULL)
17✔
1403
      (*sh->handler.start_sim)(tree_ident(top), sh->handler.context);
2✔
1404
}
17✔
1405

1406
void shell_interact(tcl_shell_t *sh)
×
1407
{
1408
   shell_print_banner(sh);
×
1409

1410
   char *line;
×
1411
   while (!sh->quit && (line = (*sh->getline)(sh))) {
×
1412
      const char *result = NULL;
×
1413
      if (shell_eval(sh, line, &result) && *result != '\0')
×
1414
         color_printf("$+black$%s$$\n", result);
×
1415

1416
      free(line);
×
1417
   }
1418
}
×
1419

1420
bool shell_do(tcl_shell_t *sh, const char *file)
9✔
1421
{
1422
   const int code = Tcl_EvalFile(sh->interp, file);
9✔
1423

1424
   switch (code) {
9✔
1425
   case TCL_OK:
1426
      return true;
1427
   case TCL_ERROR:
3✔
1428
      {
1429
         const char *info = Tcl_GetVar(sh->interp, "::errorInfo", 0);
3✔
1430
         if (info != NULL && *info != '\n')
3✔
1431
            errorf("%s", info);
3✔
1432
         else {
1433
            const char *str = Tcl_GetStringResult(sh->interp);
×
1434
            if (str != NULL && *str != '\0')
×
1435
               errorf("%s", str);
×
1436
         }
1437

1438
         return false;
1439
      }
1440
   default:
×
1441
      warnf("Tcl_Eval returned unknown code %d", code);
×
1442
      return false;
×
1443
   }
1444
}
1445

1446
static int shell_redirect_close(ClientData cd, Tcl_Interp *interp)
26✔
1447
{
1448
   return EINVAL;
26✔
1449
}
1450

1451
static void shell_redirect_watch(ClientData cd, int mask)
26✔
1452
{
1453
}
26✔
1454

1455
static int shell_redirect_output(ClientData cd, const char *buf, int nchars,
5✔
1456
                                 int *error)
1457
{
1458
   tcl_shell_t *sh = untag_pointer(cd, tcl_shell_t);
5✔
1459
   switch (pointer_tag(cd)) {
5✔
1460
   case 0:
2✔
1461
      (*sh->handler.stdout_write)(buf, nchars, sh->handler.context);
2✔
1462
      break;
2✔
1463
   case 1:
2✔
1464
      (*sh->handler.stderr_write)(buf, nchars, sh->handler.context);
2✔
1465
      break;
2✔
1466
   case 2:
1✔
1467
      (*sh->handler.backchannel_write)(buf, nchars, sh->handler.context);
1✔
1468
      break;
1✔
1469
   default:
×
1470
      fatal_trace("invalid channel number %"PRIiPTR, pointer_tag(cd));
1471
   }
1472

1473
   return nchars;
5✔
1474
}
1475

1476
static const Tcl_ChannelType redirect_funcs = {
1477
   .typeName = "redirect",
1478
   .version = TCL_CHANNEL_VERSION_5,
1479
   .closeProc = shell_redirect_close,
1480
   .watchProc = shell_redirect_watch,
1481
   .outputProc = shell_redirect_output,
1482
};
1483

1484
void shell_set_handler(tcl_shell_t *sh, const shell_handler_t *h)
12✔
1485
{
1486
   sh->handler = *h;
12✔
1487

1488
   if (h->stdout_write != NULL) {
12✔
1489
      Tcl_Channel chan = Tcl_CreateChannel(&redirect_funcs, "redirect0",
30✔
1490
                                           tag_pointer(sh, 0), TCL_WRITABLE);
10✔
1491
      Tcl_SetChannelOption(NULL, chan, "-translation", "lf");
10✔
1492
      Tcl_SetChannelOption(NULL, chan, "-buffering", "line");
10✔
1493
      Tcl_SetChannelOption(NULL, chan, "-encoding", "utf-8");
10✔
1494

1495
      Tcl_RegisterChannel(sh->interp, chan);
10✔
1496
      Tcl_SetStdChannel(chan, TCL_STDOUT);
10✔
1497
   }
1498

1499
   if (h->stderr_write != NULL) {
12✔
1500
      Tcl_Channel chan = Tcl_CreateChannel(&redirect_funcs, "redirect1",
24✔
1501
                                           tag_pointer(sh, 1), TCL_WRITABLE);
8✔
1502
      Tcl_SetChannelOption(NULL, chan, "-translation", "lf");
8✔
1503
      Tcl_SetChannelOption(NULL, chan, "-buffering", "none");
8✔
1504
      Tcl_SetChannelOption(NULL, chan, "-encoding", "utf-8");
8✔
1505

1506
      Tcl_RegisterChannel(sh->interp, chan);
8✔
1507
      Tcl_SetStdChannel(chan, TCL_STDERR);
8✔
1508
   }
1509

1510
   if (h->backchannel_write != NULL) {
12✔
1511
      Tcl_Channel chan = Tcl_CreateChannel(&redirect_funcs, "backchannel",
24✔
1512
                                           tag_pointer(sh, 2), TCL_WRITABLE);
8✔
1513
      Tcl_SetChannelOption(NULL, chan, "-translation", "lf");
8✔
1514
      Tcl_SetChannelOption(NULL, chan, "-buffering", "full");
8✔
1515
      Tcl_SetChannelOption(NULL, chan, "-encoding", "utf-8");
8✔
1516

1517
      Tcl_RegisterChannel(sh->interp, chan);
8✔
1518
   }
1519
}
12✔
STATUS · Troubleshooting · Open an Issue · Sales · Support · CAREERS · ENTERPRISE · START FREE · SCHEDULE DEMO
ANNOUNCEMENTS · TWITTER · TOS & SLA · Supported CI Services · What's a CI service? · Automated Testing

© 2026 Coveralls, Inc