1 /* Copyright 2003-2008 Multigig Ltd
2  *
3  * Copied and written by Stefan Jones (stefan.jones@multigig.com) at Multigig Ltd
4  *
5  * Code based on and copied from ScriptEDA ( http://www-cad.eecs.berkeley.edu/~pinhong/scriptEDA )
6  *
7  * Under LGPLv2 licence since 2008, December 1st
8  */
9 
10 /*******************/
11 /*   Defines       */
12 /*******************/
13 
14 #define TCLSPICE_name    "spice"
15 #define TCLSPICE_prefix  "spice::"
16 #define TCLSPICE_namespace "spice"
17 #ifdef _MSC_VER
18 #define TCLSPICE_version "25.1"
19 #define STDIN_FILENO    0
20 #define STDOUT_FILENO   1
21 #define STDERR_FILENO   2
22 #endif
23 
24 /**********************************************************************/
25 /*              Header files for C functions                          */
26 /**********************************************************************/
27 
28 #include "ngspice/ngspice.h"
29 #include "ngspice/randnumb.h"
30 #include "misc/misc_time.h"
31 #include <tcl.h>
32 
33 /*Use Tcl threads if on W32 without pthreads*/
34 #ifndef HAVE_LIBPTHREAD
35 
36 #if defined(__MINGW32__) || defined(_MSC_VER)
37 
38 #define mutex_lock(a) Tcl_MutexLock(a)
39 #define mutex_unlock(a) Tcl_MutexUnlock(a)
40 #define thread_self() Tcl_GetCurrentThread()
41 typedef Tcl_Mutex mutexType;
42 typedef Tcl_ThreadId threadId_t;
43 #define TCL_THREADS
44 #define THREADS
45 
46 #endif
47 
48 #else
49 
50 #include <pthread.h>
51 #define mutex_lock(a) pthread_mutex_lock(a)
52 #define mutex_unlock(a) pthread_mutex_unlock(a)
53 #define thread_self() pthread_self()
54 typedef pthread_mutex_t mutexType;
55 typedef pthread_t threadId_t;
56 #define THREADS
57 
58 #endif
59 
60 
61 /* Copied from main.c in ngspice*/
62 #include <stdio.h>
63 #if defined(__MINGW32__)
64 #include <stdarg.h>
65 /* remove type incompatibility with winnt.h*/
66 #undef BOOLEAN
67 #include <windef.h>
68 #include <winbase.h>  /* Sleep */
69 #elif defined(_MSC_VER)
70 #include <stdarg.h>
71 /* remove type incompatibility with winnt.h*/
72 #undef BOOLEAN
73 #include <windows.h> /* Sleep */
74 #include <process.h> /* _getpid */
75 #define dup _dup
76 #define dup2 _dup2
77 #define open _open
78 #define close _close
79 #else
80 #include <unistd.h> /* usleep */
81 #endif /* __MINGW32__ */
82 
83 #include "ngspice/iferrmsg.h"
84 #include "ngspice/ftedefs.h"
85 #include "ngspice/devdefs.h"
86 #include <spicelib/devices/dev.h>
87 #include <spicelib/analysis/analysis.h>
88 #include <misc/ivars.h>
89 #include <frontend/resource.h>
90 #include <frontend/com_measure2.h>
91 #ifdef _MSC_VER
92 #include <stdio.h>
93 #define snprintf _snprintf
94 #endif
95 #include <frontend/outitf.h>
96 #include "ngspice/memory.h"
97 #include <frontend/com_measure2.h>
98 
99 #ifndef HAVE_GETRUSAGE
100 #ifdef HAVE_FTIME
101 #include <sys/timeb.h>
102 #endif
103 #endif
104 
105 /* To interupt a spice run */
106 #include <signal.h>
107 typedef void (*sighandler)(int);
108 
109 #include <setjmp.h>
110 #include "frontend/signal_handler.h"
111 
112 /*Included for the module to access data*/
113 #include "ngspice/dvec.h"
114 #include "ngspice/plot.h"
115 
116 #ifdef __CYGWIN__
117 #undef WIN32
118 #endif
119 #include <blt.h>
120 #include  "ngspice/sim.h"
121 
122 /* defines for Tcl support
123  * Tcl 8.3 and Tcl 8.4 support,
124  * suggested by http://mini.net/tcl/3669, 07.03.03 */
125 #ifndef CONST84
126 #define CONST84
127 #endif
128 /* Arguments of Tcl_CmpProc for Tcl/Tk 8.4.x */
129 #define TCL_CMDPROCARGS(clientData, interp, argc, argv)                 \
130     (ClientData clientData, Tcl_Interp *interp, int argc, CONST84 char *argv[])
131 
132 /*For get_output*/
133 #include <fcntl.h>
134 #include <sys/stat.h>
135 
136 #ifdef _MSC_VER
137 #define S_IRWXU _S_IWRITE
138 #endif
139 
140 extern IFfrontEnd nutmeginfo;
141 
142 extern struct comm spcp_coms[ ];
143 extern void DevInit(void);
144 extern int SIMinit(IFfrontEnd *frontEnd, IFsimulator **simulator);
145 extern wordlist *cp_varwl(struct variable *var);
146 
147 /*For blt spice to use*/
148 typedef struct {
149     char *name;
150 #ifdef THREADS
151     mutexType mutex;            /*lock for this vector*/
152 #endif
153     double *data;               /* vector data*/
154     int size;                   /*data it can store*/
155     int length;                 /*actual amount of data*/
156 } vector;
157 
158 /*The current run (to get variable names, etc)*/
159 static runDesc *cur_run;
160 
161 static vector *vectors;
162 
163 static int ownVectors;
164 
165 /* save this each time called */
166 static Tcl_Interp *spice_interp;
167 #define save_interp()                           \
168     do {                                        \
169         spice_interp = interp;                  \
170     } while(0)
171 
172 
173 void tcl_stdflush(FILE *f);
174 int  tcl_vfprintf(FILE *f, const char *fmt, va_list args);
175 #if defined(__MINGW32__) || defined(_MSC_VER)
176 __declspec(dllexport)
177 #endif
178 int  Spice_Init(Tcl_Interp *interp);
179 int  Tcl_ExecutePerLoop(void);
180 void triggerEventCheck(ClientData clientData, int flags);
181 void triggerEventSetup(ClientData clientData, int flags);
182 int  triggerEventHandler(Tcl_Event *evPtr, int flags);
183 void stepEventCheck(ClientData clientData, int flags);
184 int  stepEventHandler(Tcl_Event *evPtr, int flags);
185 void stepEventSetup(ClientData clientData, int flags);
186 int  sp_Tk_Update(void);
187 int  sp_Tk_SetColor(int colorid);
188 int  sp_Tk_SetLinestyle(int linestyleid);
189 int  sp_Tk_DefineLinestyle(int linestyleid, int mask);
190 int  sp_Tk_DefineColor(int colorid, double red, double green, double blue);
191 int  sp_Tk_Text(char *text, int x, int y, int angle);
192 int  sp_Tk_Arc(int x0, int y0, int radius, double theta, double delta_theta);
193 int  sp_Tk_DrawLine(int x1, int y1, int x2, int y2);
194 int  sp_Tk_Clear(void);
195 int  sp_Tk_Close(void);
196 int  sp_Tk_NewViewport(GRAPH *graph);
197 int  sp_Tk_Init(void);
198 int  get_mod_param TCL_CMDPROCARGS(clientData, interp, argc, argv);
199 void sighandler_tclspice(int num);
200 void blt_relink(int index, void *tmp);
201 void blt_lockvec(int index);
202 void blt_add(int index, double value);
203 void blt_init(void *run);
204 int  blt_plot(struct dvec *y, struct dvec *x, int new);
205 
206 
207 /****************************************************************************/
208 /*                          BLT and data routines                           */
209 /****************************************************************************/
210 
211 /*helper function*/
212 /*inline*/
213 static struct plot *
get_plot_by_index(int plot)214 get_plot_by_index(int plot)
215 {
216     struct plot *pl;
217     pl = plot_list;
218     for (; 0 < plot; plot--) {
219         pl = pl->pl_next;
220         if (!pl)
221             return NULL;
222     }
223     return pl;
224 }
225 
226 
227 /*this holds the number of time points done (altered by spice)*/
228 int steps_completed;
229 
230 /* number of bltvectors*/
231 static int blt_vnum;
232 
233 
234 /*Native Tcl functions */
235 
236 static int
TCL_CMDPROCARGS(clientData,interp,argc,argv)237 spice_header TCL_CMDPROCARGS(clientData, interp, argc, argv)
238 {
239     char buf[256];
240     char *date, *name, *title;
241     NG_IGNORE(clientData);
242     NG_IGNORE(argv);
243     if (argc != 1) {
244         Tcl_SetResult(interp, "Wrong # args. spice::spice_header", TCL_STATIC);
245         return TCL_ERROR;
246     }
247     if (cur_run) {
248         Tcl_ResetResult(interp);
249         date = datestring();
250         title = cur_run->name;
251         name = cur_run->type;
252         sprintf(buf, "{title \"%s\"} {name \"%s\"} {date \"%s\"} {variables %u}", title, name, date, cur_run->numData);
253         Tcl_AppendResult(interp, buf, TCL_STATIC);
254         return TCL_OK;
255     } else {
256         return TCL_ERROR;
257     }
258 }
259 
260 
261 static int
TCL_CMDPROCARGS(clientData,interp,argc,argv)262 spice_data TCL_CMDPROCARGS(clientData, interp, argc, argv)
263 {
264     char buf[256];
265     int i, type;
266     char *name;
267     NG_IGNORE(clientData);
268     if (argc > 2) {
269         Tcl_SetResult(interp, "Wrong # args. spice::spice_data ?plot?",
270                       TCL_STATIC);
271         return TCL_ERROR;
272     }
273     if (argc == 1) {
274         if (blt_vnum) {
275             Tcl_ResetResult(interp);
276             for (i = 0; i < blt_vnum; i++) {
277                 name = vectors[i].name;
278                 if (substring("#branch", name))
279                     type = SV_CURRENT;
280                 else if (cieq(name, "time"))
281                     type = SV_TIME;
282                 else if (cieq(name, "frequency"))
283                     type = SV_FREQUENCY;
284                 else
285                     type = SV_VOLTAGE;
286                 sprintf(buf, "{%s %s} ", name, ft_typenames(type));
287                 Tcl_AppendResult(interp, buf, TCL_STATIC);
288             }
289             return TCL_OK;
290         } else {
291             return TCL_ERROR;
292         }
293     } else {
294         struct plot *pl;
295         struct dvec *v;
296         if (!(pl = get_plot_by_index(atoi(argv[1])))) {
297             Tcl_SetResult(interp, "Bad plot number", TCL_STATIC);
298             return TCL_ERROR;
299         }
300         for (v = pl->pl_dvecs; v; v = v->v_next) {
301             name = v->v_name;
302             if (substring("#branch", name))
303                 type = SV_CURRENT;
304             else if (cieq(name, "time"))
305                 type = SV_TIME;
306             else if (cieq(name, "frequency"))
307                 type = SV_FREQUENCY;
308             else
309                 type = SV_VOLTAGE;
310             sprintf(buf, "{%s %s} ", name, ft_typenames(type));
311             Tcl_AppendResult(interp, buf, TCL_STATIC);
312         }
313         return TCL_OK;
314     }
315 }
316 
317 
318 static int resetTriggers(void);
319 
320 
321 /*Creates and registers the blt vectors, used by spice*/
322 void
blt_init(void * run)323 blt_init(void *run)
324 {
325     int i;
326     cur_run = NULL;
327     /* reset varaibles and free*/
328     if (vectors) {
329         resetTriggers();
330         for (i = blt_vnum-1, blt_vnum = 0 /*stops vector access*/; i >= 0; i--) {
331             if (ownVectors)
332                 FREE(vectors[i].data);
333             FREE(vectors[i].name);
334 #ifdef HAVE_LIBPTHREAD
335             pthread_mutex_destroy(&vectors[i].mutex);
336 #endif
337         }
338         FREE(vectors);
339     }
340 
341 
342     /* initilise */
343     cur_run = (runDesc *)run;
344     vectors = TMALLOC(vector, cur_run->numData);
345     for (i = 0; i < cur_run->numData; i++) {
346         vectors[i].name = copy((cur_run->data[i]).name);
347 #ifdef HAVE_LIBPTHREAD
348         pthread_mutex_init(&vectors[i].mutex, NULL);
349 #endif
350         vectors[i].data = NULL;
351         vectors[i].size = 0;
352         vectors[i].length = 0;
353     }
354     ownVectors = cur_run->writeOut;
355     blt_vnum = i;               /*allows access to vectors*/
356     return;
357 }
358 
359 
360 /*Adds data to the stored vector*/
361 void
blt_add(int index,double value)362 blt_add(int index, double value)
363 {
364     vector *v;
365     v = &vectors[index];
366 #ifdef THREADS
367     mutex_lock(&vectors[index].mutex);
368 #endif
369     if (!(v->length < v->size)) {
370         v->size += 100;
371         v->data = TREALLOC(double, v->data, v->size);
372     }
373     v->data[v->length] = value;
374     v->length ++;
375 #ifdef THREADS
376     mutex_unlock(&vectors[index].mutex);
377 #endif
378     return;
379 }
380 
381 
382 /* Locks the vector data to stop conflicts*/
383 void
blt_lockvec(int index)384 blt_lockvec(int index)
385 {
386 #ifdef THREADS
387     mutex_lock(&vectors[index].mutex);
388 #else
389     NG_IGNORE(index);
390 #endif
391     return;
392 }
393 
394 
395 /*links a dvec to a blt vector, used to stop duplication of data when writing to a plot,
396   but makes BLT vectors more unsafe */
397 void
blt_relink(int index,void * tmp)398 blt_relink(int index, void *tmp)
399 {
400     struct dvec *v = (struct dvec *)tmp;
401     vectors[index].data = v->v_realdata;
402     vectors[index].length = v->v_length;
403     vectors[index].size = v->v_length; /*silly spice doesn't use v_rlength*/
404 #ifdef THREADS
405     mutex_unlock(&vectors[index].mutex);
406 #endif
407     return;
408 }
409 
410 
411 /*        Tcl functions to access spice data   */
412 
413 /* This copys the last Spice state vector to the given blt_vector
414  * arg1: blt_vector
415  */
416 static int
TCL_CMDPROCARGS(clientData,interp,argc,argv)417 lastVector TCL_CMDPROCARGS(clientData, interp, argc, argv)
418 {
419     Blt_Vector *vec;
420     char *blt;
421     int i;
422     double *V;
423     NG_IGNORE(clientData);
424     if (argc != 2) {
425         Tcl_SetResult(interp, "Wrong # args. spice::lastVector vecName", TCL_STATIC);
426         return TCL_ERROR;
427     }
428     Tcl_SetResult(interp, "test2", TCL_STATIC);
429     return TCL_ERROR;
430     blt = (char *)argv[1];
431     if (Blt_GetVector(interp, blt, &vec)) {
432         Tcl_SetResult(interp, "Bad blt vector ", TCL_STATIC);
433         Tcl_AppendResult(interp, (char *)blt, TCL_STATIC);
434         return TCL_ERROR;
435     }
436     if (!(V = TMALLOC(double, blt_vnum))) {
437         Tcl_SetResult(interp, "Out of Memory", TCL_STATIC);
438         return TCL_ERROR;
439     }
440     Tcl_SetResult(interp, "test1", TCL_STATIC);
441     return TCL_ERROR;
442 
443     for (i = 0; i < blt_vnum; i++) {
444 #ifdef THREADS
445         mutex_lock(&vectors[i].mutex);
446 #endif
447         V[i] = vectors[i].data[vectors[i].length-1];
448 #ifdef THREADS
449         mutex_unlock(&vectors[i].mutex);
450 #endif
451     }
452     Blt_ResetVector(vec, V, blt_vnum, blt_vnum, TCL_VOLATILE);
453     txfree(V);
454     return TCL_OK;
455 }
456 
457 
458 /*agr1: spice variable name
459  *arg2: index
460  */
461 static int
TCL_CMDPROCARGS(clientData,interp,argc,argv)462 get_value TCL_CMDPROCARGS(clientData, interp, argc, argv)
463 {
464     char *var;
465     int i, vindex, j;
466     double val = 0;
467     NG_IGNORE(clientData);
468     if (argc != 3) {
469         Tcl_SetResult(interp,
470                       "Wrong # args. spice::get_value spice_variable index",
471                       TCL_STATIC);
472         return TCL_ERROR;
473     }
474     var = (char *)argv[1];
475 
476     for (i = 0; i < blt_vnum && strcmp(var, vectors[i].name); i++)
477         ;
478 
479     if (i == blt_vnum) {
480         Tcl_SetResult(interp, "Bad spice variable ", TCL_STATIC);
481         Tcl_AppendResult(interp, (char *)var, TCL_STATIC);
482         return TCL_ERROR;
483     } else {
484         vindex = i;
485     }
486 
487     j = atoi(argv[2]);
488 
489 #ifdef THREADS
490     mutex_lock(&vectors[vindex].mutex);
491 #endif
492 
493     if (j < 0 || j >= vectors[vindex].length) {
494         i = 1;
495     } else {
496         i = 0;
497         val = vectors[vindex].data[j];
498     }
499 
500 #ifdef THREADS
501     mutex_unlock(&vectors[vindex].mutex);
502 #endif
503 
504     if (i) {
505         Tcl_SetResult(interp, "Index out of range", TCL_STATIC);
506         return TCL_ERROR;
507     } else {
508         Tcl_SetObjResult(interp, Tcl_NewDoubleObj(val));
509         return TCL_OK;
510     }
511 }
512 
513 
514 /*
515  * arg1: spice vector name
516  * arg2: real data blt vector
517  * arg3: Optional: imaginary data blt vector*/
518 static int
TCL_CMDPROCARGS(clientData,interp,argc,argv)519 vectoblt TCL_CMDPROCARGS(clientData, interp, argc, argv)
520 {
521     Blt_Vector *real_BltVector, *imag_BltVector;
522     char *realBlt, *imagBlt, *var;
523     struct dvec *var_dvec;
524     double *realData, *compData;
525     int compIndex; //index to loop inside the vectors' data
526     NG_IGNORE(clientData);
527 
528     if (argc < 3 || argc > 4) {
529         Tcl_SetResult(interp, "Wrong # args. spice::vectoblt spice_variable real_bltVector [imag_bltVector]", TCL_STATIC);
530         return TCL_ERROR;
531     }
532 
533     real_BltVector = NULL;
534     imag_BltVector = NULL;
535     var = (char *)argv[1];
536     var_dvec = vec_get(var);
537     if (var_dvec == NULL) {
538         Tcl_SetResult(interp, "Bad spice vector ", TCL_STATIC);
539         Tcl_AppendResult(interp, (char *)var, TCL_STATIC);
540         return TCL_ERROR;
541     }
542     realBlt = (char *)argv[2];
543     if (Blt_GetVector(interp, realBlt, &real_BltVector)) {
544         Tcl_SetResult(interp, "Bad real blt vector ", TCL_STATIC);
545         Tcl_AppendResult(interp, (char *)realBlt, TCL_STATIC);
546         return TCL_ERROR;
547     }
548     if (argc == 4) {
549         imagBlt = (char *)argv[3];
550         if (Blt_GetVector(interp, imagBlt, &imag_BltVector)) {
551             Tcl_SetResult(interp, "Bad imag blt vector ", TCL_STATIC);
552             Tcl_AppendResult(interp, (char *)imagBlt, TCL_STATIC);
553             return TCL_ERROR;
554         }
555     }
556 /*If data is complex, it is harder (more complex :) to export...*/
557 //  int compIndex; //index to loop inside the vectors' data
558     if (var_dvec->v_realdata == NULL) {
559         if (var_dvec->v_compdata == NULL) {
560             Tcl_SetResult(interp, "The vector contains no data", TCL_STATIC);
561             Tcl_AppendResult(interp, (char *)var, TCL_STATIC);
562         }
563         else {
564             realData = TMALLOC(double, var_dvec->v_length);
565             for (compIndex = 0; compIndex < var_dvec->v_length; compIndex++)
566                 realData[compIndex] = ((var_dvec->v_compdata+compIndex)->cx_real);
567 
568             Blt_ResetVector(real_BltVector, realData, var_dvec->v_length, var_dvec->v_length, TCL_VOLATILE);
569             if (imag_BltVector != NULL) {
570                 compData = TMALLOC(double, var_dvec->v_length);
571                 for (compIndex = 0; compIndex < var_dvec->v_length; compIndex++)
572                     compData[compIndex] = ((var_dvec->v_compdata+compIndex)->cx_imag);
573 
574                 Blt_ResetVector(imag_BltVector, compData, var_dvec->v_length, var_dvec->v_length, TCL_VOLATILE);
575             }
576         }
577     } else {
578         Blt_ResetVector(real_BltVector, var_dvec->v_realdata, var_dvec->v_length, var_dvec->v_length, TCL_VOLATILE);
579         if (imag_BltVector != NULL) {
580             compData = TMALLOC(double, var_dvec->v_length);
581             for (compIndex = 0; compIndex < var_dvec->v_length; compIndex++)
582                 compData[compIndex] = 0;
583 
584             Blt_ResetVector(imag_BltVector, compData, var_dvec->v_length, var_dvec->v_length, TCL_VOLATILE);
585         }
586     }
587 
588     Tcl_SetResult(interp, "finished!", TCL_STATIC);
589     return TCL_OK;
590 }
591 
592 
593 /*agr1: spice variable name
594  *arg2: blt_vector
595  *arg3: start copy index, optional
596  *arg4: end copy index. optional
597  */
598 static int
TCL_CMDPROCARGS(clientData,interp,argc,argv)599 spicetoblt TCL_CMDPROCARGS(clientData, interp, argc, argv)
600 {
601     Blt_Vector *vec;
602     int j, i;
603     char *blt, *var;
604     int start = 0, end = -1, len;
605 
606     NG_IGNORE(clientData);
607     if (argc < 3 || argc > 5) {
608         Tcl_SetResult(interp, "Wrong # args. spice::spicetoblt spice_variable vecName ?start? ?end?", TCL_STATIC);
609         return TCL_ERROR;
610     }
611 
612     var = (char *)argv[1];
613     blt = (char *)argv[2];
614 
615     for (i = 0; i < blt_vnum && strcmp(var, vectors[i].name); i++)
616         ;
617 
618     if (i == blt_vnum) {
619         Tcl_SetResult(interp, "Bad spice variable ", TCL_STATIC);
620         Tcl_AppendResult(interp, (char *)var, TCL_STATIC);
621         return TCL_ERROR;
622     } else {
623         j = i;
624     }
625 
626     if (Blt_GetVector(interp, blt, &vec)) {
627         Tcl_SetResult(interp, "Bad blt vector ", TCL_STATIC);
628         Tcl_AppendResult(interp, (char *)blt, TCL_STATIC);
629         return TCL_ERROR;
630     }
631 
632 
633     if (argc >= 4)
634         start = atoi(argv[3]);
635     if (argc == 5)
636         end   = atoi(argv[4]);
637     if (vectors[j].length) {
638 #ifdef THREADS
639         mutex_lock(&vectors[j].mutex);
640 #endif
641 
642         len = vectors[j].length;
643 
644         if (start) {
645             start = start % len;
646             if (start < 0)
647                 start += len;
648         }
649 
650         end = end % len;
651         if (end < 0)
652             end += len;
653 
654         len = abs(end - start + 1);
655 
656         Blt_ResetVector(vec, (vectors[j].data + start), len,
657                         len, TCL_VOLATILE);
658 
659 #ifdef THREADS
660         mutex_unlock(&vectors[j].mutex);
661 #endif
662     }
663     return TCL_OK;
664 }
665 
666 
667 /******************************************************************/
668 /*     Main spice command executions and thread control           */
669 /*****************************************************************/
670 
671 #ifdef THREADS
672 static threadId_t tid, bgtid = (threadId_t) 0;
673 
674 static bool fl_running = FALSE;
675 static bool fl_exited = TRUE;
676 
677 #if defined(__MINGW32__) || defined(_MSC_VER)
678 #define EXPORT_FLAVOR WINAPI
679 #else
680 #define EXPORT_FLAVOR
681 #endif
682 
683 static void * EXPORT_FLAVOR
_thread_run(void * string)684 _thread_run(void *string)
685 {
686     fl_exited = FALSE;
687     bgtid = thread_self();
688     cp_evloop((char *)string);
689     FREE(string);
690     bgtid = (threadId_t)0;
691     fl_exited = TRUE;
692     return NULL;
693 }
694 
695 
696 /*Stops a running thread, hopefully */
697 static int EXPORT_FLAVOR
_thread_stop(void)698 _thread_stop(void)
699 {
700     int timeout = 0;
701     if (fl_running) {
702         while (!fl_exited && timeout < 100) {
703             ft_intrpt = TRUE;
704             timeout++;
705 #if defined(__MINGW32__) || defined(_MSC_VER)
706             Sleep(100); /* va: windows native */
707 #else
708             usleep(10000);
709 #endif
710         }
711         if (!fl_exited) {
712             fprintf(stderr, "Couldn't stop tclspice\n");
713             return TCL_ERROR;
714         }
715 #ifdef HAVE_LIBPTHREAD
716         pthread_join(tid, NULL);
717 #endif
718         fl_running = FALSE;
719         ft_intrpt = FALSE;
720         return TCL_OK;
721     } else {
722         fprintf(stderr, "Spice not running\n");
723     }
724     return TCL_OK;
725 }
726 
727 
728 void
sighandler_tclspice(int num)729 sighandler_tclspice(int num)
730 {
731     NG_IGNORE(num);
732     if (fl_running)
733         _thread_stop();
734     return;
735 }
736 
737 #endif /*THREADS*/
738 
739 
740 static int
_run(int argc,char ** argv)741 _run(int argc, char **argv)
742 {
743     char buf[1024] = "";
744     int i;
745     sighandler oldHandler;
746 #ifdef THREADS
747     char *string;
748     bool fl_bg = FALSE;
749     /* run task in background if preceeded by "bg"*/
750     if (!strcmp(argv[0], "bg")) {
751         argc--;
752         argv = &argv[1];
753         fl_bg = TRUE;
754     }
755 #endif
756 
757 
758     /* Catch Ctrl-C to break simulations */
759 #ifndef _MSC_VER_
760     oldHandler = signal(SIGINT, (SIGNAL_FUNCTION) ft_sigintr);
761     if (SETJMP(jbuf, 1) != 0) {
762         ft_sigintr_cleanup();
763         signal(SIGINT, oldHandler);
764         return TCL_OK;
765     }
766 #else
767     oldHandler = SIG_IGN;
768 #endif
769 
770     /*build a char * to pass to cp_evloop */
771     for (i = 0; i < argc; i++) {
772         strcat(buf, argv[i]);
773         strcat(buf, " ");
774     }
775 
776 #ifdef THREADS
777     /* run in the background */
778     if (fl_bg) {
779         if (fl_running)
780             _thread_stop();
781         fl_running = TRUE;
782         string = copy(buf);     /*as buf gets freed fairly quickly*/
783 #ifdef HAVE_LIBPTHREAD
784         pthread_create(&tid, NULL, _thread_run, (void *)string);
785 #else
786         Tcl_CreateThread(&tid, (Tcl_ThreadCreateProc *)_thread_run, string,
787                          TCL_THREAD_STACK_DEFAULT, TCL_THREAD_NOFLAGS);
788 #endif
789     } else
790         /* halt (pause) a bg run */
791         if (!strcmp(argv[0], "halt")) {
792             signal(SIGINT, oldHandler);
793             return _thread_stop();
794         } else
795             /* backwards compatability with old command */
796             if (!strcmp(argv[0], "stop"))
797                 if (argc > 1) {
798                     cp_evloop(buf);
799                 } else {
800                     _thread_stop();
801                     cp_evloop(buf);
802                 }
803             else {
804                 /* cannot do anything if spice is running in the bg*/
805                 if (fl_running) {
806                     if (fl_exited) {
807                         _thread_stop();
808                         cp_evloop(buf);
809                     } else {
810                         fprintf(stderr, "type \"spice stop\" first\n");
811                     }
812                 } else {
813                     /*do the command*/
814                     cp_evloop(buf);
815                 }
816             }
817 #else
818     cp_evloop(buf);
819 #endif /*THREADS*/
820     signal(SIGINT, oldHandler);
821     return TCL_OK;
822 }
823 
824 
825 static int
TCL_CMDPROCARGS(clientData,interp,argc,argv)826 _tcl_dispatch TCL_CMDPROCARGS(clientData, interp, argc, argv)
827 {
828     int i;
829     NG_IGNORE(clientData);
830     save_interp();
831     char *prefix = strstr(argv[0], "spice::");
832     if (prefix)
833         argv[0] = prefix + 7;
834     return _run(argc, (char **)argv);
835 }
836 
837 
838 /* Runs the spice command given in spice <cmd>*/
839 static int
TCL_CMDPROCARGS(clientData,interp,argc,argv)840 _spice_dispatch TCL_CMDPROCARGS(clientData, interp, argc, argv)
841 {
842     NG_IGNORE(clientData);
843     save_interp();
844     if (argc == 1)
845         return TCL_OK;
846     return _run(argc-1, (char **)&argv[1]);
847 }
848 
849 
850 #ifdef THREADS
851 /*Checks if spice is runnuing in the background */
852 static int
TCL_CMDPROCARGS(clientData,interp,argc,argv)853 running TCL_CMDPROCARGS(clientData, interp, argc, argv)
854 {
855     NG_IGNORE(clientData);
856     NG_IGNORE(argc);
857     NG_IGNORE(argv);
858     Tcl_SetObjResult(interp, Tcl_NewIntObj((long) (fl_running && !fl_exited)));
859     return TCL_OK;
860 }
861 #endif
862 
863 
864 /**************************************/
865 /*  plot manipulation functions       */
866 /*  only usefull if plots are saved   */
867 /**************************************/
868 
869 /*Outputs the names of all variables in the plot */
870 static int
TCL_CMDPROCARGS(clientData,interp,argc,argv)871 plot_variables TCL_CMDPROCARGS(clientData, interp, argc, argv)
872 {
873     struct plot *pl;
874     int plot;
875     struct dvec *v;
876     NG_IGNORE(clientData);
877 
878     if (argc != 2) {
879         Tcl_SetResult(interp, "Wrong # args. spice::plot_variables plot", TCL_STATIC);
880         return TCL_ERROR;
881     }
882 
883     plot = atoi(argv[1]);
884 
885     if (!(pl = get_plot_by_index(plot))) {
886         Tcl_SetResult(interp, "Bad plot given", TCL_STATIC);
887         return TCL_ERROR;
888     }
889 
890     for (v = pl->pl_dvecs; v; v = v->v_next)
891         Tcl_AppendElement(interp, v->v_name);
892 
893     return TCL_OK;
894 }
895 
896 
897 static int
TCL_CMDPROCARGS(clientData,interp,argc,argv)898 plot_variablesInfo TCL_CMDPROCARGS(clientData, interp, argc, argv)
899 {
900     struct plot *pl;
901     int plot;
902     struct dvec *v;
903     char buf[256];
904     char *name;
905     int length;
906     NG_IGNORE(clientData);
907 
908     if (argc != 2) {
909         Tcl_SetResult(interp, "Wrong # args. spice::plot_variablesInfo plot", TCL_STATIC);
910         return TCL_ERROR;
911     }
912 
913     plot = atoi(argv[1]);
914 
915     if (!(pl = get_plot_by_index(plot))) {
916         Tcl_SetResult(interp, "Bad plot given", TCL_STATIC);
917         return TCL_ERROR;
918     }
919 
920     Tcl_ResetResult(interp);
921     for (v = pl->pl_dvecs; v; v = v->v_next) {
922         name = v->v_name;
923         length = v->v_length;
924 
925         sprintf(buf, "{%s %s %i} ", name, ft_typenames(v->v_type), length);
926         Tcl_AppendResult(interp, (char *)buf, TCL_STATIC);
927     }
928     return TCL_OK;
929 }
930 
931 
932 /*returns the value of a variable */
933 static int
TCL_CMDPROCARGS(clientData,interp,argc,argv)934 plot_get_value TCL_CMDPROCARGS(clientData, interp, argc, argv)
935 {
936     struct plot *pl;
937     struct dvec *v;
938     char *name;
939     int plot, index;
940     NG_IGNORE(clientData);
941 
942     if (argc != 4) {
943         Tcl_SetResult(interp, "Wrong # args. spice::plot_get_value name plot index", TCL_STATIC);
944         return TCL_ERROR;
945     }
946 
947     name = (char *)argv[1];
948     plot = atoi(argv[2]);
949     index = atoi(argv[3]);
950 
951     if (!(pl = get_plot_by_index(plot))) {
952         Tcl_SetResult(interp, "Bad plot", TCL_STATIC);
953         return TCL_ERROR;
954     }
955     for (v = pl->pl_dvecs; v; v = v->v_next)
956         if (!strcmp(v->v_name, name)) {
957             if (index < v->v_length) {
958                 Tcl_SetObjResult(interp, Tcl_NewDoubleObj((double) v->v_realdata[index]));
959                 return TCL_OK;
960             } else {
961                 Tcl_SetResult(interp, "Bad index", TCL_STATIC);
962                 return TCL_ERROR;
963             }
964         }
965 
966     Tcl_SetResult(interp, "variable not found", TCL_STATIC);
967     return TCL_ERROR;
968 }
969 
970 
971 /*The length of the first vector in a plot*/
972 static int
TCL_CMDPROCARGS(clientData,interp,argc,argv)973 plot_datapoints TCL_CMDPROCARGS(clientData, interp, argc, argv)
974 {
975     struct plot *pl;
976     struct dvec *v;
977     int plot;
978     NG_IGNORE(clientData);
979 
980     if (argc != 2) {
981         Tcl_SetResult(interp, "Wrong # args. spice::plot_datapoints plot", TCL_STATIC);
982         return TCL_ERROR;
983     }
984 
985     plot = atoi(argv[1]);
986 
987     if (!(pl = get_plot_by_index(plot))) {
988         Tcl_SetResult(interp, "Bad plot", TCL_STATIC);
989         return TCL_ERROR;
990     }
991 
992     v = pl->pl_dvecs;
993 
994     Tcl_SetObjResult(interp, Tcl_NewIntObj((long) v->v_length)); // could be very dangeous
995     return TCL_OK;
996 }
997 
998 
999 /*These functions give you infomation about a plot*/
1000 
1001 static int
TCL_CMDPROCARGS(clientData,interp,argc,argv)1002 plot_title TCL_CMDPROCARGS(clientData, interp, argc, argv)
1003 {
1004     struct plot *pl;
1005     int plot;
1006     NG_IGNORE(clientData);
1007     if (argc != 2) {
1008         Tcl_SetResult(interp, "Wrong # args. spice::plot_title plot", TCL_STATIC);
1009         return TCL_ERROR;
1010     }
1011 
1012     plot = atoi(argv[1]);
1013 
1014     if (!(pl = get_plot_by_index(plot))) {
1015         Tcl_SetResult(interp, "Bad plot", TCL_STATIC);
1016         return TCL_ERROR;
1017     }
1018     Tcl_SetObjResult(interp, Tcl_NewStringObj(pl->pl_title, -1));
1019     return TCL_OK;
1020 }
1021 
1022 
1023 static int
TCL_CMDPROCARGS(clientData,interp,argc,argv)1024 plot_date TCL_CMDPROCARGS(clientData, interp, argc, argv)
1025 {
1026     struct plot *pl;
1027 
1028     int plot;
1029     NG_IGNORE(clientData);
1030     if (argc != 2) {
1031         Tcl_SetResult(interp, "Wrong # args. spice::plot_date plot", TCL_STATIC);
1032         return TCL_ERROR;
1033     }
1034 
1035     plot = atoi(argv[1]);
1036 
1037     if (!(pl = get_plot_by_index(plot))) {
1038         Tcl_SetResult(interp, "Bad plot", TCL_STATIC);
1039         return TCL_ERROR;
1040     }
1041     Tcl_SetObjResult(interp, Tcl_NewStringObj(pl->pl_date, -1));
1042     return TCL_OK;
1043 }
1044 
1045 
1046 static int
TCL_CMDPROCARGS(clientData,interp,argc,argv)1047 plot_name TCL_CMDPROCARGS(clientData, interp, argc, argv)
1048 {
1049     struct plot *pl;
1050     int plot;
1051     NG_IGNORE(clientData);
1052     if (argc != 2) {
1053         Tcl_SetResult(interp, "Wrong # args. spice::plot_name plot", TCL_STATIC);
1054         return TCL_ERROR;
1055     }
1056 
1057     plot = atoi(argv[1]);
1058 
1059     if (!(pl = get_plot_by_index(plot))) {
1060         Tcl_SetResult(interp, "Bad plot", TCL_STATIC);
1061         return TCL_ERROR;
1062     }
1063     Tcl_SetObjResult(interp, Tcl_NewStringObj(pl->pl_name, -1));
1064     return TCL_OK;
1065 }
1066 
1067 
1068 static int
TCL_CMDPROCARGS(clientData,interp,argc,argv)1069 plot_typename TCL_CMDPROCARGS(clientData, interp, argc, argv)
1070 {
1071     struct plot *pl;
1072     int plot;
1073     NG_IGNORE(clientData);
1074     if (argc != 2) {
1075         Tcl_SetResult(interp, "Wrong # args. spice::plot_typename plot", TCL_STATIC);
1076         return TCL_ERROR;
1077     }
1078 
1079     plot = atoi(argv[1]);
1080 
1081     if (!(pl = get_plot_by_index(plot))) {
1082         Tcl_SetResult(interp, "Bad plot", TCL_STATIC);
1083         return TCL_ERROR;
1084     }
1085     Tcl_SetObjResult(interp, Tcl_NewStringObj(pl->pl_typename, -1));
1086     return TCL_OK;
1087 }
1088 
1089 
1090 /*number of variables in a plot*/
1091 
1092 static int
TCL_CMDPROCARGS(clientData,interp,argc,argv)1093 plot_nvars TCL_CMDPROCARGS(clientData, interp, argc, argv)
1094 {
1095     struct plot *pl;
1096     struct dvec *v;
1097     int plot;
1098     int i = 0;
1099 
1100     NG_IGNORE(clientData);
1101     if (argc != 2) {
1102         Tcl_SetResult(interp, "Wrong # args. spice::plot_nvars plot", TCL_STATIC);
1103         return TCL_ERROR;
1104     }
1105 
1106     plot = atoi(argv[1]);
1107 
1108     if (!(pl = get_plot_by_index(plot))) {
1109         Tcl_SetResult(interp, "Bad plot", TCL_STATIC);
1110         return TCL_ERROR;
1111     }
1112     for (v = pl->pl_dvecs; v; v = v->v_next)
1113         i++;
1114     Tcl_SetObjResult(interp, Tcl_NewIntObj((long) i));
1115     return TCL_OK;
1116 }
1117 
1118 
1119 static int
TCL_CMDPROCARGS(clientData,interp,argc,argv)1120 plot_defaultscale TCL_CMDPROCARGS(clientData, interp, argc, argv)
1121 {
1122     struct plot *pl;
1123     int plot;
1124 
1125     NG_IGNORE(clientData);
1126     if (argc != 2) {
1127         Tcl_SetResult(interp, "Wrong # args. spice::plot_defaultscale plot",
1128                       TCL_STATIC);
1129         return TCL_ERROR;
1130     }
1131 
1132     plot = atoi(argv[1]);
1133 
1134     if (!(pl = get_plot_by_index(plot))) {
1135         Tcl_SetResult(interp, "Bad plot", TCL_STATIC);
1136         return TCL_ERROR;
1137     }
1138 
1139     if (pl->pl_scale)
1140         Tcl_SetObjResult(interp, Tcl_NewStringObj(pl->pl_scale->v_name, -1));
1141     return TCL_OK;
1142 }
1143 
1144 
1145 /*agr1: plot index
1146  *agr2: spice variable name
1147  *arg3: blt_vector
1148  *arg4: start copy index, optional
1149  *arg5: end copy index. optional
1150  */
1151 static int
TCL_CMDPROCARGS(clientData,interp,argc,argv)1152 plot_getvector TCL_CMDPROCARGS(clientData, interp, argc, argv)
1153 {
1154     Blt_Vector *vec;
1155     char *blt, *var;
1156     int start = 0, end = -1, len;
1157     int plot;
1158     struct dvec *v;
1159     struct plot *pl;
1160 
1161     NG_IGNORE(clientData);
1162     if (argc < 4 || argc > 6) {
1163         Tcl_SetResult(interp,
1164                       "Wrong # args. spice::plot_getvector plot spice_variable vecName ?start? ?end?",
1165                       TCL_STATIC);
1166         return TCL_ERROR;
1167     }
1168 
1169     plot = atoi(argv[1]);
1170 
1171     if (!(pl = get_plot_by_index(plot))) {
1172         Tcl_SetResult(interp, "Bad plot", TCL_STATIC);
1173         return TCL_ERROR;
1174     }
1175 
1176     var = (char *)argv[2];
1177     blt = (char *)argv[3];
1178 
1179     for (v = pl->pl_dvecs; v; v = v->v_next)
1180         if (!strcmp(v->v_name, var))
1181             break;
1182 
1183     if (v == NULL) {
1184         Tcl_SetResult(interp, "variable not found: ", TCL_STATIC);
1185         Tcl_AppendResult(interp, (char *)var, TCL_STATIC);
1186         return TCL_ERROR;
1187     }
1188 
1189     if (Blt_GetVector(interp, blt, &vec)) {
1190         Tcl_SetResult(interp, "Bad blt vector ", TCL_STATIC);
1191         Tcl_AppendResult(interp, (char *)blt, TCL_STATIC);
1192         return TCL_ERROR;
1193     }
1194 
1195     if (argc >= 5)
1196         start = atoi(argv[4]);
1197     if (argc == 6)
1198         end   = atoi(argv[5]);
1199     if (v->v_length) {
1200 
1201         len = v->v_length;
1202 
1203         if (start) {
1204             start = start % len;
1205             if (start < 0)
1206                 start += len;
1207         }
1208 
1209         end = end % len;
1210         if (end < 0)
1211             end += len;
1212 
1213         len = abs(end - start + 1);
1214 
1215         Blt_ResetVector(vec, (v->v_realdata + start), len,
1216                         len, TCL_VOLATILE);
1217     }
1218     return TCL_OK;
1219 }
1220 
1221 
1222 static int
TCL_CMDPROCARGS(clientData,interp,argc,argv)1223 plot_getplot TCL_CMDPROCARGS(clientData, interp, argc, argv)
1224 {
1225     NG_IGNORE(clientData);
1226     NG_IGNORE(argc);
1227     NG_IGNORE(argv);
1228 
1229     if (plot_cur)
1230         Tcl_SetObjResult(interp, Tcl_NewStringObj(plot_cur->pl_typename, -1));
1231 
1232     return TCL_OK;
1233 }
1234 
1235 
1236 /*******************************************/
1237 /*           Misc functions                */
1238 /*******************************************/
1239 
1240 /*Runs a tcl script and returns the output*/
1241 static int
TCL_CMDPROCARGS(clientData,interp,argc,argv)1242 get_output TCL_CMDPROCARGS(clientData, interp, argc, argv)
1243 {
1244     FILE *pipein;
1245     int tmp_1, tmp_2 = 0;
1246     char buf[1024];
1247     int outfd, outfd2 = 0;
1248     NG_IGNORE(clientData);
1249     save_interp();
1250     if ((argc < 2) || (argc > 3)) {
1251         Tcl_SetResult(interp, "Wrong # args. spice::get_output script ?var_for_stderr?", TCL_STATIC);
1252         return TCL_ERROR;
1253     }
1254     tmp_1 = dup(1);
1255     outfd = open("/tmp/tclspice.tmp_out", O_WRONLY|O_CREAT|O_TRUNC, S_IRWXU);
1256     if (argc == 3) {
1257         tmp_2 = dup(2);
1258         outfd2 = open("/tmp/tclspice.tmp_err", O_WRONLY|O_CREAT|O_TRUNC, S_IRWXU);
1259     }
1260     freopen("/tmp/tclspice.tmp_out", "w", stdout);
1261     if (argc == 3)
1262         freopen("/tmp/tclspice.tmp_err", "w", stderr);
1263     dup2(outfd, 1);
1264     if (argc == 3)
1265         dup2(outfd2, 2);
1266 
1267     Tcl_Eval(interp, argv[1]);
1268 
1269     fclose(stdout);
1270     close(outfd);
1271     if (argc == 3) {
1272         fclose(stderr);
1273         close(outfd2);
1274     }
1275     dup2(tmp_1, 1);
1276     close(tmp_1);
1277     if (argc == 3) {
1278         dup2(tmp_2, 2);
1279         close(tmp_2);
1280     }
1281     freopen("/dev/fd/1", "w", stdout);
1282     if (argc == 3)
1283         freopen("/dev/fd/2", "w", stderr);
1284     pipein = fopen("/tmp/tclspice.tmp_out", "r");
1285     if (pipein == NULL)
1286         fprintf(stderr, "pipein==NULL\n");
1287 
1288     Tcl_ResetResult(interp);
1289     while (fgets(buf, 1024, pipein) != NULL)
1290         Tcl_AppendResult(interp, (char *)buf, TCL_STATIC);
1291 
1292     fclose(pipein);
1293     if (argc == 3) {
1294         pipein = fopen("/tmp/tclspice.tmp_err", "r");
1295         Tcl_SetVar(interp, argv[2], "", 0);
1296         while (fgets(buf, 1024, pipein) != NULL)
1297             Tcl_SetVar(interp, argv[2], buf, TCL_APPEND_VALUE);
1298 
1299         fclose(pipein);
1300     }
1301     return TCL_OK;
1302 }
1303 
1304 
1305 /* Returns the current value of a parameter
1306  * has lots of memory leaks
1307  */
1308 static int
TCL_CMDPROCARGS(clientData,interp,argc,argv)1309 get_param TCL_CMDPROCARGS(clientData, interp, argc, argv)
1310 {
1311     wordlist *wl = NULL;
1312     char *device, *param;
1313     struct variable *v;
1314     char buf[128];
1315     NG_IGNORE(clientData);
1316     if (argc != 3) {
1317         Tcl_SetResult(interp, "Wrong # args. spice::get_param device param", TCL_STATIC);
1318         return TCL_ERROR;
1319     }
1320     if (!ft_curckt) {
1321         Tcl_SetResult(interp, "No circuit loaded ", TCL_STATIC);
1322         return TCL_ERROR;
1323     }
1324 
1325     device = (char *)argv[1];
1326     param  = (char *)argv[2];
1327     /* copied from old_show(wordlist *) */
1328     v = if_getparam (ft_curckt->ci_ckt, &device, param, 0, 0);
1329     if (!v)
1330         v = if_getparam (ft_curckt->ci_ckt, &device, param, 0, 1);
1331     if (v) {
1332         wl = cp_varwl(v);
1333         Tcl_SetResult(interp, wl->wl_word, TCL_VOLATILE);
1334         wl_free(wl);
1335         tfree(v);
1336         return TCL_OK;
1337 
1338     } else {
1339         sprintf(buf, "%s in %s not found", param, device);
1340         Tcl_AppendResult(interp, buf, TCL_STATIC);
1341     }
1342     return TCL_ERROR;
1343 }
1344 
1345 
1346 /* va - added
1347    call:    s. errormessage
1348    returns: param == all: list of all model parameters of device/model
1349    param == name: description of given model parameter
1350 */
1351 int
TCL_CMDPROCARGS(clientData,interp,argc,argv)1352 get_mod_param TCL_CMDPROCARGS(clientData, interp, argc, argv)
1353 {
1354     char *name;
1355     char *paramname;
1356     GENinstance *devptr = NULL;
1357     GENmodel *modptr = NULL;
1358     IFdevice *device;
1359     IFparm *opt;
1360     IFvalue pv;
1361     int i, err, typecode = -1;
1362     char buf[128];
1363     bool found;
1364 
1365     NG_IGNORE(clientData);
1366     if (argc < 2 || argc >3) {
1367         Tcl_SetResult(interp,
1368                       "Wrong # args. spice::get_mod_param device|model [all|param]", TCL_STATIC);
1369         return TCL_ERROR;
1370     }
1371     if (ft_curckt == NULL) {
1372         Tcl_SetResult(interp, "No circuit loaded ", TCL_STATIC);
1373         return TCL_ERROR;
1374     }
1375 
1376     name = (char *)argv[1];
1377     if (argc > 2)
1378         paramname = (char *)argv[2];
1379     else
1380         paramname = "all";
1381 
1382     if (name == NULL || name[0] == '\0') {
1383         Tcl_SetResult(interp, "No model or device name provided.", TCL_STATIC);
1384         return TCL_ERROR;
1385     }
1386 
1387     /* get the unique IFuid for name (device/model) */
1388     INPretrieve(&name, ft_curckt->ci_symtab);
1389     devptr = ft_sim->findInstance (ft_curckt->ci_ckt, name);
1390     if (devptr) {
1391         typecode = devptr->GENmodPtr->GENmodType;
1392     } else  {
1393         modptr = ft_sim->findModel (ft_curckt->ci_ckt, name);
1394         if (modptr) {
1395             typecode = modptr->GENmodType;
1396         } else {
1397             sprintf(buf, "No such device or model name %s", name);
1398             Tcl_SetResult(interp, buf, TCL_VOLATILE);
1399             return TCL_ERROR;
1400         }
1401     }
1402     device = ft_sim->devices[typecode];
1403     found = FALSE;
1404     for (i = 0; i < *(device->numModelParms); i++) {
1405         opt = &device->modelParms[i];
1406         if (opt->dataType != (IF_SET|IF_ASK|IF_REAL))
1407             continue; /* only real IO-parameter */
1408         if (strcmp(paramname, "all") == 0) {
1409             Tcl_AppendElement(interp, opt->keyword);
1410             found = TRUE;
1411         } else if (strcmp(paramname, opt->keyword) == 0) {
1412             if (devptr)
1413                 err = ft_sim->askInstanceQuest (ft_curckt->ci_ckt, devptr,
1414                                                 opt->id, &pv, NULL);
1415             else
1416                 err = ft_sim->askModelQuest (ft_curckt->ci_ckt, modptr,
1417                                              opt->id, &pv, NULL);
1418             if (err == OK) {
1419                 sprintf(buf, "%g", pv.rValue); /* dataType is here always real */
1420                 Tcl_SetResult(interp, buf, TCL_VOLATILE);
1421                 return TCL_OK;
1422             }
1423         }
1424     }
1425     if (found != TRUE) {
1426         sprintf(buf, "unknown parameter %s", paramname);
1427         Tcl_SetResult(interp, buf, TCL_VOLATILE);
1428         return TCL_ERROR;
1429     }
1430     return TCL_OK;
1431 }
1432 
1433 
1434 /* Direct control over the step size
1435  * Spice will still adjust it to keep accuracy wuithin reltol and abstol
1436  */
1437 static int
TCL_CMDPROCARGS(clientData,interp,argc,argv)1438 delta TCL_CMDPROCARGS(clientData, interp, argc, argv)
1439 {
1440     NG_IGNORE(clientData);
1441     if (argc < 1 ||argc > 2) {
1442         Tcl_SetResult(interp, "Wrong # args. spice::delta ?value?", TCL_STATIC);
1443         return TCL_ERROR;
1444     }
1445     if (ft_curckt == NULL) {
1446         Tcl_SetResult(interp, "No circuit loaded ", TCL_STATIC);
1447         return TCL_ERROR;
1448     }
1449 
1450     if (argc == 2)
1451         (ft_curckt->ci_ckt)->CKTdelta = atof(argv[1]);
1452 
1453     Tcl_SetObjResult(interp, Tcl_NewDoubleObj((ft_curckt->ci_ckt)->CKTdelta));
1454     return TCL_OK;
1455 }
1456 
1457 
1458 #include "ngspice/trandefs.h"
1459 /* Direct control over the maximum stepsize
1460  * Spice will still adjust it to keep accuracy wuithin reltol and abstol
1461  */
1462 static int
TCL_CMDPROCARGS(clientData,interp,argc,argv)1463 maxstep TCL_CMDPROCARGS(clientData, interp, argc, argv)
1464 {
1465     TRANan *job;
1466     NG_IGNORE(clientData);
1467     if (argc < 1 ||argc > 2) {
1468         Tcl_SetResult(interp, "Wrong # args. spice::maxstep ?value?", TCL_STATIC);
1469         return TCL_ERROR;
1470     }
1471     if (ft_curckt == NULL) {
1472         Tcl_SetResult(interp, "No circuit loaded ", TCL_STATIC);
1473         return TCL_ERROR;
1474     }
1475 
1476     job = (TRANan*)(ft_curckt->ci_ckt)->CKTcurJob;
1477     if (argc == 2)
1478         job->TRANmaxStep = atof(argv[1]);
1479 
1480     Tcl_SetObjResult(interp, Tcl_NewDoubleObj(job->TRANmaxStep));
1481     return TCL_OK;
1482 }
1483 
1484 
1485 /* obtain the initial time of a transient analysis */
1486 static int
TCL_CMDPROCARGS(clientData,interp,argc,argv)1487 get_initTime TCL_CMDPROCARGS(clientData, interp, argc, argv)
1488 {
1489     TRANan *job;
1490     NG_IGNORE(argv);
1491     NG_IGNORE(clientData);
1492 
1493     if (argc < 1 ||argc > 1) {
1494         Tcl_SetResult(interp, "Wrong # args. spice::get_initTime", TCL_STATIC);
1495         return TCL_ERROR;
1496     }
1497     if (ft_curckt == NULL) {
1498         Tcl_SetResult(interp, "No circuit loaded ", TCL_STATIC);
1499         return TCL_ERROR;
1500     }
1501 
1502     job = (TRANan*)(ft_curckt->ci_ckt)->CKTcurJob;
1503     Tcl_SetObjResult(interp, Tcl_NewDoubleObj(job->TRANinitTime));
1504     return TCL_OK;
1505 }
1506 
1507 
1508 /* obtain the final time of a transient analysis */
1509 static int
TCL_CMDPROCARGS(clientData,interp,argc,argv)1510 get_finalTime TCL_CMDPROCARGS(clientData, interp, argc, argv)
1511 {
1512     TRANan *job;
1513     NG_IGNORE(argv);
1514     NG_IGNORE(clientData);
1515 
1516     if (argc < 1 ||argc > 1) {
1517         Tcl_SetResult(interp, "Wrong # args. spice::get_finalTime", TCL_STATIC);
1518         return TCL_ERROR;
1519     }
1520     if (ft_curckt == NULL) {
1521         Tcl_SetResult(interp, "No circuit loaded ", TCL_STATIC);
1522         return TCL_ERROR;
1523     }
1524 
1525     job = (TRANan*)(ft_curckt->ci_ckt)->CKTcurJob;
1526     Tcl_SetObjResult(interp, Tcl_NewDoubleObj(job->TRANfinalTime));
1527     return TCL_OK;
1528 }
1529 
1530 
1531 /****************************************/
1532 /*          The Tk frontend for plot    */
1533 /****************************************/
1534 
1535 /* Use Tcl_GetStringResult to get canvas size etc. from Tcl */
1536 #include "ngspice/ftedev.h"
1537 
1538 int
sp_Tk_Init(void)1539 sp_Tk_Init(void)
1540 {
1541     /* This is hard coded in C at the mo, use X11 values */
1542     dispdev->numlinestyles = 8;
1543     dispdev->numcolors = 20;
1544     dispdev->width = 1280;
1545     dispdev->height = 1024;
1546 
1547     return 0;
1548 }
1549 
1550 
1551 #include "ngspice/graph.h"
1552 
1553 int
sp_Tk_NewViewport(GRAPH * graph)1554 sp_Tk_NewViewport(GRAPH *graph)
1555 {
1556     const char *result;
1557     int width, height, fontwidth, fontheight;
1558     graph->devdep = NULL;
1559 
1560     if (Tcl_GlobalEval(spice_interp, "spice_gr_NewViewport") != TCL_OK) {
1561         Tcl_ResetResult(spice_interp);
1562         return 1;
1563     }
1564 
1565     result = Tcl_GetStringResult(spice_interp);
1566     if (sscanf(result, "%i %i %i %i", &width, &height, &fontwidth, &fontheight) != 4) {
1567         Tcl_ResetResult(spice_interp);
1568         return 1;
1569     }
1570     graph->absolute.xpos = 0; /* these always seem sensible, let Tcl adjust coods */
1571     graph->absolute.ypos = 0;
1572     graph->absolute.width = width;
1573     graph->absolute.height = height;
1574     graph->fontwidth = fontwidth;
1575     graph->fontheight = fontheight;
1576     Tcl_ResetResult(spice_interp);
1577     return 0;
1578 }
1579 
1580 
1581 int
sp_Tk_Close(void)1582 sp_Tk_Close(void)
1583 {
1584     if (Tcl_Eval(spice_interp, "spice_gr_Close") != TCL_OK) {
1585         Tcl_ResetResult(spice_interp);
1586         return 1;
1587     }
1588     Tcl_ResetResult(spice_interp);
1589     return 0;
1590 }
1591 
1592 
1593 int
sp_Tk_Clear(void)1594 sp_Tk_Clear(void)
1595 {
1596     if (Tcl_Eval(spice_interp, "spice_gr_Clear") != TCL_OK) {
1597         Tcl_ResetResult(spice_interp);
1598         return 1;
1599     }
1600     Tcl_ResetResult(spice_interp);
1601     return 0;
1602 }
1603 
1604 
1605 int
sp_Tk_DrawLine(int x1,int y1,int x2,int y2)1606 sp_Tk_DrawLine(int x1, int y1, int x2, int y2)
1607 {
1608     char buf[1024];
1609     sprintf(buf, "spice_gr_DrawLine %i %i %i %i", x1, y1, x2, y2);
1610     if (Tcl_Eval(spice_interp, buf) != TCL_OK) {
1611         Tcl_ResetResult(spice_interp);
1612         return 1;
1613     }
1614     Tcl_ResetResult(spice_interp);
1615     return 0;
1616 }
1617 
1618 
1619 int
sp_Tk_Arc(int x0,int y0,int radius,double theta,double delta_theta)1620 sp_Tk_Arc(int x0, int y0, int radius, double theta, double delta_theta)
1621 {
1622     char buf[1024];
1623     sprintf(buf, "spice_gr_Arc %i %i %i %f %f", x0, y0, radius, theta, delta_theta);
1624     if (Tcl_Eval(spice_interp, buf) != TCL_OK) {
1625         Tcl_ResetResult(spice_interp);
1626         return 1;
1627     }
1628     Tcl_ResetResult(spice_interp);
1629     return 0;
1630 }
1631 
1632 
1633 int
sp_Tk_Text(char * text,int x,int y,int angle)1634 sp_Tk_Text(char *text, int x, int y, int angle)
1635 {
1636     NG_IGNORE(angle);
1637 
1638     char buf[1024];
1639     NG_IGNORE(angle);
1640     sprintf(buf, "spice_gr_Text \"%s\" %i %i", text, x, y);
1641     if (Tcl_Eval(spice_interp, buf) != TCL_OK) {
1642         Tcl_ResetResult(spice_interp);
1643         return 1;
1644     }
1645     Tcl_ResetResult(spice_interp);
1646     return 0;
1647 }
1648 
1649 
1650 int
sp_Tk_DefineColor(int colorid,double red,double green,double blue)1651 sp_Tk_DefineColor(int colorid, double red, double green, double blue)
1652 {
1653     char buf[1024];
1654     sprintf(buf, "spice_gr_DefineColor %i %g %g %g", colorid, red, green, blue);
1655     if (Tcl_Eval(spice_interp, buf) != TCL_OK) {
1656         Tcl_ResetResult(spice_interp);
1657         return 1;
1658     }
1659     Tcl_ResetResult(spice_interp);
1660     return 0;
1661 }
1662 
1663 
1664 int
sp_Tk_DefineLinestyle(int linestyleid,int mask)1665 sp_Tk_DefineLinestyle(int linestyleid, int mask)
1666 {
1667     char buf[1024];
1668     sprintf(buf, "spice_gr_DefineLinestyle %i %i", linestyleid, mask);
1669     if (Tcl_Eval(spice_interp, buf) != TCL_OK) {
1670         Tcl_ResetResult(spice_interp);
1671         return 1;
1672     }
1673     Tcl_ResetResult(spice_interp);
1674     return 0;
1675 }
1676 
1677 
1678 int
sp_Tk_SetLinestyle(int linestyleid)1679 sp_Tk_SetLinestyle(int linestyleid)
1680 {
1681     char buf[1024];
1682     sprintf(buf, "spice_gr_SetLinestyle %i", linestyleid);
1683     if (Tcl_Eval(spice_interp, buf) != TCL_OK) {
1684         Tcl_ResetResult(spice_interp);
1685         return 1;
1686     }
1687     Tcl_ResetResult(spice_interp);
1688     return 0;
1689 }
1690 
1691 
1692 int
sp_Tk_SetColor(int colorid)1693 sp_Tk_SetColor(int colorid)
1694 {
1695     char buf[1024];
1696     sprintf(buf, "spice_gr_SetColor %i", colorid);
1697     if (Tcl_Eval(spice_interp, buf) != TCL_OK) {
1698         Tcl_ResetResult(spice_interp);
1699         return 1;
1700     }
1701     Tcl_ResetResult(spice_interp);
1702     return 0;
1703 }
1704 
1705 
1706 int
sp_Tk_Update(void)1707 sp_Tk_Update(void)
1708 {
1709     if (Tcl_Eval(spice_interp, "spice_gr_Update") != TCL_OK) {
1710         Tcl_ResetResult(spice_interp);
1711         return 1;
1712     }
1713     Tcl_ResetResult(spice_interp);
1714     return 0;
1715 }
1716 
1717 
1718 /********************************************************/
1719 /*           The Blt method for plotting                */
1720 /********************************************************/
1721 
1722 static void
dvecToBlt(Blt_Vector * Data,struct dvec * x)1723 dvecToBlt(Blt_Vector *Data, struct dvec *x)
1724 {
1725     if (x->v_flags & VF_REAL) {
1726         Blt_ResetVector (Data, x->v_realdata , x->v_length,
1727                          x->v_length, TCL_VOLATILE);
1728     } else {
1729         double *data;
1730         int i;
1731 
1732         data = TMALLOC(double, x->v_length);
1733 
1734         for (i = 0; i < x->v_length; i++)
1735             data[i] = realpart(x->v_compdata[i]);
1736 
1737         Blt_ResetVector (Data, data, x->v_length, x->v_length, TCL_VOLATILE);
1738 
1739         tfree(data);
1740     }
1741 
1742     return;
1743 }
1744 
1745 
1746 static void
escape_brackets(char * string)1747 escape_brackets(char *string)
1748 {
1749     int printed = strlen(string), i;
1750 
1751     for (i = 0; i < printed; i++) {
1752         if (string[i] == ']' || string[i] == '[') {
1753             int j;
1754             for (j = printed; j >= i; j--)
1755                 string[j+3] = string[j];
1756 
1757             string[i] = '\\';
1758             string[i+1] = '\\';
1759             string[i+2] = '\\';
1760             i += 3;
1761             printed += 3;
1762         }
1763     }
1764     return;
1765 }
1766 
1767 
1768 int
blt_plot(struct dvec * y,struct dvec * x,int new)1769 blt_plot(struct dvec *y, struct dvec *x, int new)
1770 {
1771     static int ctr = -1;
1772     Blt_Vector *X_Data = NULL, *Y_Data = NULL;
1773     char buf[1024];
1774 
1775     /* A bug in these functions? , crashes if used so make vectors in Tcl
1776        Blt_CreateVector(spice_interp, "::spice::X_Data", 1, &X_Data);
1777        Blt_CreateVector(spice_interp, "::spice::Y_Data", 1, &Y_Data);
1778     */
1779     Blt_GetVector(spice_interp, "::spice::X_Data", &X_Data);
1780     Blt_GetVector(spice_interp, "::spice::Y_Data", &Y_Data);
1781 
1782     if (!X_Data || !Y_Data) {
1783         fprintf(stderr, "Error: Blt vector X_Data or Y_Data not created\n");
1784         return 1;
1785     }
1786 
1787     dvecToBlt(X_Data, x);
1788     dvecToBlt(Y_Data, y);
1789 
1790     if (new)
1791         ctr++;
1792 
1793     sprintf(buf, "spice_gr_Plot %s %s %s %s %s %s %d",
1794             x->v_name, ft_typenames(x->v_type), ft_typabbrev(x->v_type),
1795             y->v_name, ft_typenames(y->v_type), ft_typabbrev(y->v_type), ctr);
1796     escape_brackets(buf);
1797 
1798     if (Tcl_Eval(spice_interp, buf) != TCL_OK) {
1799         Tcl_ResetResult(spice_interp);
1800         return 1;
1801     }
1802 
1803     Tcl_ResetResult(spice_interp);
1804 
1805     return 0;
1806 }
1807 
1808 
1809 /********************************************************/
1810 /*             Triggering stuff                         */
1811 /********************************************************/
1812 
1813 struct triggerEvent {
1814     struct triggerEvent *next;
1815     int vector;
1816     int type;
1817     int stepNumber;
1818     double time;
1819     double voltage;
1820     char ident[16];
1821 };
1822 
1823 
1824 struct triggerEvent *eventQueue;
1825 struct triggerEvent *eventQueueEnd;
1826 
1827 #ifdef THREADS
1828 mutexType triggerMutex;
1829 #endif
1830 
1831 struct watch {
1832     struct watch *next;
1833     char name[16];
1834     int vector;                 /* index of vector to watch */
1835     int type;                   /* +ive or -ive trigger */
1836     int state;                  /* pretriggered or not */
1837     double Vmin;                /* the boundaries */
1838     double Vmax;
1839     /* To get the exact trigger time */
1840     double Vavg;
1841     double oT;
1842     double oV;
1843 };
1844 
1845 struct watch *watches;
1846 
1847 char *triggerCallback;
1848 unsigned int triggerPollTime = 1;
1849 
1850 char *stepCallback;
1851 unsigned int stepPollTime = 1;
1852 unsigned int stepCount = 1;
1853 int stepCallbackPending;
1854 
1855 
1856 void
stepEventSetup(ClientData clientData,int flags)1857 stepEventSetup(ClientData clientData, int flags)
1858 {
1859     Tcl_Time t;
1860     NG_IGNORE(clientData);
1861     NG_IGNORE(flags);
1862     if (stepCallbackPending) {
1863         t.sec  = 0;
1864         t.usec = 0;
1865     } else {
1866         t.sec = stepPollTime / 1000;
1867         t.usec = (stepPollTime % 1000) * 1000;
1868     }
1869     Tcl_SetMaxBlockTime(&t);
1870 }
1871 
1872 
1873 int
stepEventHandler(Tcl_Event * evPtr,int flags)1874 stepEventHandler(Tcl_Event *evPtr, int flags)
1875 {
1876     NG_IGNORE(evPtr);
1877     NG_IGNORE(flags);
1878     if (stepCallbackPending) {
1879         stepCallbackPending = 0;
1880         Tcl_Preserve((ClientData)spice_interp);
1881         Tcl_Eval(spice_interp, stepCallback);
1882         Tcl_ResetResult(spice_interp);
1883         Tcl_Release((ClientData)spice_interp);
1884     }
1885     return TCL_OK;
1886 }
1887 
1888 
1889 void
stepEventCheck(ClientData clientData,int flags)1890 stepEventCheck(ClientData clientData, int flags)
1891 {
1892     NG_IGNORE(clientData);
1893     NG_IGNORE(flags);
1894     if (stepCallbackPending) {
1895         Tcl_Event *tclEvent;
1896         tclEvent = (Tcl_Event *) ckalloc(sizeof(Tcl_Event));
1897         tclEvent->proc = stepEventHandler;
1898         Tcl_QueueEvent(tclEvent, TCL_QUEUE_TAIL);
1899     }
1900 }
1901 
1902 
1903 int
triggerEventHandler(Tcl_Event * evPtr,int flags)1904 triggerEventHandler(Tcl_Event *evPtr, int flags)
1905 {
1906     static char buf[512];
1907     int rtn = TCL_OK;
1908     NG_IGNORE(evPtr);
1909     NG_IGNORE(flags);
1910     Tcl_Preserve((ClientData)spice_interp);
1911 #ifdef THREADS
1912     mutex_lock(&triggerMutex);
1913 #endif
1914     while (eventQueue) {
1915         struct triggerEvent *event = eventQueue;
1916         eventQueue = eventQueue->next;
1917 
1918 
1919         snprintf(buf, 512, "%s %s %g %d %d %g %s", triggerCallback, vectors[event->vector].name,
1920                  event->time, event->stepNumber, event->type, event->voltage, event->ident);
1921 
1922         rtn = Tcl_Eval(spice_interp, buf);
1923         FREE(event);
1924         if (rtn)
1925             goto quit;
1926     }
1927     eventQueueEnd = NULL;
1928 quit:
1929 #ifdef THREADS
1930     mutex_unlock(&triggerMutex);
1931 #endif
1932     Tcl_ResetResult(spice_interp);
1933     Tcl_Release((ClientData)spice_interp);
1934     return TCL_OK;
1935 }
1936 
1937 
1938 void
triggerEventSetup(ClientData clientData,int flags)1939 triggerEventSetup(ClientData clientData, int flags)
1940 {
1941     Tcl_Time t;
1942     NG_IGNORE(clientData);
1943     NG_IGNORE(flags);
1944     if (eventQueue) {
1945         t.sec  = 0;
1946         t.usec = 0;
1947     } else {
1948         t.sec = triggerPollTime / 1000;
1949         t.usec = (triggerPollTime % 1000) * 1000;
1950     }
1951     Tcl_SetMaxBlockTime(&t);
1952 }
1953 
1954 
1955 void
triggerEventCheck(ClientData clientData,int flags)1956 triggerEventCheck(ClientData clientData, int flags)
1957 {
1958     NG_IGNORE(clientData);
1959     NG_IGNORE(flags);
1960 #ifdef THREADS
1961     mutex_lock(&triggerMutex);
1962 #endif
1963     if (eventQueue) {
1964         Tcl_Event *tclEvent;
1965         tclEvent = (Tcl_Event *) ckalloc(sizeof(Tcl_Event));
1966         tclEvent->proc = triggerEventHandler;
1967         Tcl_QueueEvent(tclEvent, TCL_QUEUE_TAIL);
1968     }
1969 #ifdef THREADS
1970     mutex_unlock(&triggerMutex);
1971 #endif
1972 }
1973 
1974 
1975 int
Tcl_ExecutePerLoop(void)1976 Tcl_ExecutePerLoop(void)
1977 {
1978     struct watch *current;
1979 
1980 #ifdef THREADS
1981     mutex_lock(&vectors[0].mutex);
1982     mutex_lock(&triggerMutex);
1983 #endif
1984 
1985     for (current = watches; current; current = current->next) {
1986         vector *v;
1987         v = &vectors[current->vector];
1988 #ifdef THREADS
1989         mutex_lock(&v->mutex);
1990 #endif
1991 
1992         if ((current->type > 0 && current->state && v->data[v->length-1] > current->Vmax) ||
1993             (current->type < 0 && current->state && v->data[v->length-1] < current->Vmin)) {
1994             struct triggerEvent *tmp = TMALLOC(struct triggerEvent, 1);
1995 
1996             tmp->next = NULL;
1997 
1998             if (eventQueue) {
1999                 eventQueueEnd->next = tmp;
2000                 eventQueueEnd = tmp;
2001             } else {
2002                 eventQueue = tmp;
2003             }
2004 
2005             eventQueueEnd = tmp;
2006 
2007             tmp->vector = current->vector;
2008             tmp->type = current->type;
2009             tmp->stepNumber = vectors[0].length;
2010 
2011             {
2012                 double T = vectors[0].data[vectors[0].length-1];
2013                 double V = v->data[v->length-1];
2014 
2015                 tmp->time = current->oT +
2016                     (current->Vavg - current->oV) * (T - current->oT) / (V - current->oV);
2017                 tmp->voltage = current->Vavg;
2018             }
2019 
2020             strcpy(tmp->ident, current->name);
2021             current->state = 0;
2022 
2023         } else
2024             if ((current->type > 0 && v->data[v->length-1] < current->Vmin) ||
2025                 (current->type < 0 && v->data[v->length-1] > current->Vmax))
2026                 current->state = 1;
2027 
2028         current->oT = vectors[0].data[vectors[0].length-1];
2029         current->oV = v->data[v->length-1];
2030 
2031 #ifdef THREADS
2032         mutex_unlock(&v->mutex);
2033 #endif
2034     }
2035 
2036     if (stepCallback && vectors[0].length % stepCount == 0)
2037         stepCallbackPending = 1;
2038 
2039 #ifdef THREADS
2040     mutex_unlock(&triggerMutex);
2041 
2042     mutex_unlock(&vectors[0].mutex);
2043 
2044     if (triggerCallback && eventQueue && bgtid != thread_self())
2045         triggerEventHandler(NULL, 0);
2046 
2047     if (stepCallback && stepCallbackPending && bgtid != thread_self())
2048         stepEventHandler(NULL, 0);
2049 #else
2050     if (triggerCallback && eventQueue)
2051         triggerEventHandler(NULL, 0);
2052 
2053     if (stepCallback && stepCallbackPending)
2054         triggerEventHandler(NULL, 0);
2055 #endif
2056 
2057     return 0;
2058 }
2059 
2060 
2061 static int
resetTriggers(void)2062 resetTriggers(void)
2063 {
2064 #ifdef THREADS
2065     mutex_lock(&triggerMutex);
2066 #endif
2067 
2068     while (watches) {
2069         struct watch *tmp = watches;
2070         watches = tmp->next;
2071         FREE(tmp);
2072     }
2073 
2074     while (eventQueue) {
2075         struct triggerEvent *tmp = eventQueue;
2076         eventQueue = tmp->next;
2077         FREE(tmp);
2078     }
2079 
2080     eventQueueEnd = NULL;
2081 
2082 #ifdef THREADS
2083     mutex_unlock(&triggerMutex);
2084 #endif
2085     return 0;
2086 }
2087 
2088 
2089 /* Registers a watch for a trigger
2090  *arg0: Callback function (optional - none removes callback)
2091  *arg1: Poll interval usec (optional - defaults to 500000 )
2092  */
2093 static int
TCL_CMDPROCARGS(clientData,interp,argc,argv)2094 registerTriggerCallback TCL_CMDPROCARGS(clientData, interp, argc, argv)
2095 {
2096     NG_IGNORE(clientData);
2097     if (argc > 3) {
2098         Tcl_SetResult(interp,
2099                       "Wrong # args. spice::registerTriggerCallback ?proc? ?ms?",
2100                       TCL_STATIC);
2101         return TCL_ERROR;
2102     }
2103 
2104     if (triggerCallback) {
2105         Tcl_DeleteEventSource(triggerEventSetup, triggerEventCheck, NULL);
2106         free(triggerCallback);
2107         triggerCallback = NULL;
2108     }
2109 
2110     if (argc == 1)
2111         return TCL_OK;
2112 
2113     triggerCallback = strdup(argv[1]);
2114     Tcl_CreateEventSource(triggerEventSetup, triggerEventCheck, NULL);
2115 
2116     if (argc == 3) {
2117         triggerPollTime = atoi(argv[2]);
2118         if (triggerPollTime == 0)
2119             triggerPollTime = 500;
2120     }
2121 
2122     return TCL_OK;
2123 }
2124 
2125 
2126 /* Registers step counter callback
2127  *arg0: Callback function (optional - none removes callback)
2128  *arg1: Number of steps per Callback
2129  *arg2: Poll interval usec (optional - defaults to 500000 )
2130  */
2131 static int
TCL_CMDPROCARGS(clientData,interp,argc,argv)2132 registerStepCallback TCL_CMDPROCARGS(clientData, interp, argc, argv)
2133 {
2134     NG_IGNORE(clientData);
2135     if (argc > 4) {
2136         Tcl_SetResult(interp,
2137                       "Wrong # args. spice::registerStepCallback ?proc? ?steps? ?ms?",
2138                       TCL_STATIC);
2139         return TCL_ERROR;
2140     }
2141 
2142     if (stepCallback) {
2143         Tcl_DeleteEventSource(stepEventSetup, stepEventCheck, NULL);
2144         free(stepCallback);
2145         stepCallback = NULL;
2146     }
2147 
2148     if (argc == 1)
2149         return TCL_OK;
2150 
2151     stepCallback = strdup(argv[1]);
2152     Tcl_CreateEventSource(stepEventSetup, stepEventCheck, NULL);
2153 
2154     if (argc >= 3) {
2155         stepCount = atoi(argv[2]);
2156         if (stepCount == 0)
2157             stepCount = 1;
2158     }
2159 
2160     if (argc == 4) {
2161         stepPollTime = atoi(argv[3]);
2162         if (stepPollTime == 0)
2163             stepPollTime = 50;
2164     }
2165 
2166     return TCL_OK;
2167 }
2168 
2169 
2170 /* Registers a watch for a trigger
2171  *arg0: Vector Name to watch
2172  *arg1: Vmin
2173  *arg2: Vmax
2174  *arg3: 1 / -1 for +ive(voltage goes +ive) or -ive trigger
2175  */
2176 static int
TCL_CMDPROCARGS(clientData,interp,argc,argv)2177 registerTrigger TCL_CMDPROCARGS(clientData, interp, argc, argv)
2178 {
2179     int i, index;
2180     const char *var;
2181     char ident[16];
2182     struct watch *tmp;
2183     int type;
2184     double Vavg, Vmin, Vmax;
2185 
2186     NG_IGNORE(clientData);
2187     if (argc < 4 && argc > 6) {
2188         Tcl_SetResult(interp, "Wrong # args. spice::registerTrigger vecName Vmin Vmax ?type? ?string?", TCL_STATIC);
2189         return TCL_ERROR;
2190     }
2191 
2192     var = argv[1];
2193 
2194     for (i = 0; i < blt_vnum && strcmp(var, vectors[i].name); i++)
2195         ;
2196 
2197     if (i == blt_vnum) {
2198         Tcl_SetResult(interp, "Bad spice variable ", TCL_STATIC);
2199         Tcl_AppendResult(interp, (char *)var, TCL_STATIC);
2200         return TCL_ERROR;
2201     } else {
2202         index = i;
2203     }
2204 
2205     if (argc >= 5)
2206         type = atoi(argv[4]);
2207     else
2208         type = 1;
2209 
2210     if (argc >= 6) {
2211         strncpy(ident, argv[5], sizeof(ident));
2212         ident[sizeof(ident)-1] = '\0';
2213     } else {
2214         ident[0] = '\0';
2215     }
2216 
2217     Vmin = atof(argv[2]);
2218     Vmax = atof(argv[3]);
2219     Vavg = (Vmin + Vmax) / 2 ;
2220 
2221 #ifdef THREADS
2222     mutex_lock(&triggerMutex);
2223 #endif
2224 
2225     for (tmp = watches; tmp != NULL; tmp = tmp->next)
2226         if (ident[0] != '\0') {
2227             if (strcmp(ident, tmp->name) == 0) {
2228                 watches->vector = index;
2229                 watches->type = type;
2230                 strcpy(watches->name, ident);
2231 
2232                 watches->state = 0;
2233                 watches->Vmin = Vmin;
2234                 watches->Vmax = Vmax;
2235                 watches->Vavg = Vavg;
2236 
2237                 break;
2238             }
2239         } else {
2240             if (tmp->vector == index && tmp->type == type
2241                 && tmp->Vavg == Vavg) {
2242                 tmp->Vmin = Vmin;
2243                 tmp->Vmax = Vmax;
2244                 break;
2245             }
2246         }
2247 
2248     if (tmp == NULL) {
2249 
2250         tmp = TMALLOC(struct watch, 1);
2251         tmp->next = watches;
2252         watches = tmp;
2253 
2254         watches->vector = index;
2255         watches->type = type;
2256         strcpy(watches->name, ident);
2257 
2258         watches->state = 0;
2259         watches->Vmin = Vmin;
2260         watches->Vmax = Vmax;
2261         watches->Vavg = Vavg;
2262 
2263     }
2264 
2265 #ifdef THREADS
2266     mutex_unlock(&triggerMutex);
2267 #endif
2268 
2269     return TCL_OK;
2270 }
2271 
2272 
2273 /*unregisters a trigger
2274  *arg0: Vector name
2275  *arg1: type
2276  */
2277 static int
TCL_CMDPROCARGS(clientData,interp,argc,argv)2278 unregisterTrigger TCL_CMDPROCARGS(clientData, interp, argc, argv)
2279 {
2280     int i, index, type;
2281     char *var;
2282     struct watch *tmp;
2283     struct watch **cut;
2284 
2285     NG_IGNORE(clientData);
2286     if (argc != 2 && argc != 3) {
2287         Tcl_SetResult(interp, "Wrong # args. spice::unregisterTrigger vecName ?type?", TCL_STATIC);
2288         return TCL_ERROR;
2289     }
2290 
2291     var = (char *)argv[1];
2292 
2293     for (i = 0; i < blt_vnum && strcmp(var, vectors[i].name); i++)
2294         ;
2295 
2296     if (i == blt_vnum)
2297         index = -1;
2298     else
2299         index = i;
2300 
2301     if (argc == 3)
2302         type = atoi(argv[4]);
2303     else
2304         type = 1;
2305 
2306 #ifdef THREADS
2307     mutex_lock(&triggerMutex);
2308 #endif
2309 
2310     cut = &watches;
2311 
2312     tmp = watches;
2313 
2314     while (tmp)
2315         if ((tmp->vector == index && tmp->type == type) || strcmp(var, tmp->name) == 0) {
2316             *cut = tmp->next;
2317             txfree(tmp);
2318             break;
2319         } else {
2320             cut = &tmp->next;
2321             tmp = tmp->next;
2322         }
2323 
2324 #ifdef THREADS
2325     mutex_unlock(&triggerMutex);
2326 #endif
2327 
2328     if (tmp == NULL) {
2329         Tcl_SetResult(interp, "Could not find trigger ", TCL_STATIC);
2330         Tcl_AppendResult(interp, (char *)var, TCL_STATIC);
2331         return TCL_ERROR;
2332     }
2333 
2334     return TCL_OK;
2335 }
2336 
2337 
2338 /* returns:
2339    "vecName" "time" "stepNumber" "type"
2340 */
2341 static int
TCL_CMDPROCARGS(clientData,interp,argc,argv)2342 popTriggerEvent TCL_CMDPROCARGS(clientData, interp, argc, argv)
2343 {
2344     NG_IGNORE(clientData);
2345     NG_IGNORE(argv);
2346     if (argc != 1) {
2347         Tcl_SetResult(interp, "Wrong # args. spice::popTriggerEvent", TCL_STATIC);
2348         return TCL_ERROR;
2349     }
2350 
2351     if (eventQueue) {
2352         struct triggerEvent *popedEvent;
2353         Tcl_Obj *list;
2354 
2355 #ifdef THREADS
2356         mutex_lock(&triggerMutex);
2357 #endif
2358 
2359         popedEvent = eventQueue;
2360 
2361         eventQueue = popedEvent->next;
2362         if (eventQueue == NULL)
2363             eventQueueEnd = NULL;
2364 
2365         list = Tcl_NewListObj(0, NULL);
2366 
2367         Tcl_ListObjAppendElement(interp, list, Tcl_NewStringObj(vectors[popedEvent->vector].name, strlen(vectors[popedEvent->vector].name)));
2368 
2369         Tcl_ListObjAppendElement(interp, list, Tcl_NewDoubleObj(popedEvent->time));
2370 
2371         Tcl_ListObjAppendElement(interp, list, Tcl_NewIntObj(popedEvent->stepNumber));
2372 
2373         Tcl_ListObjAppendElement(interp, list, Tcl_NewIntObj(popedEvent->type));
2374 
2375         Tcl_ListObjAppendElement(interp, list, Tcl_NewDoubleObj(popedEvent->voltage));
2376 
2377         Tcl_ListObjAppendElement(interp, list, Tcl_NewStringObj(popedEvent->ident, strlen(popedEvent->ident)));
2378 
2379         Tcl_SetObjResult(interp, list);
2380 
2381         FREE(popedEvent);
2382 
2383 #ifdef THREADS
2384         mutex_unlock(&triggerMutex);
2385 #endif
2386     }
2387 
2388     return TCL_OK;
2389 }
2390 
2391 
2392 static int
TCL_CMDPROCARGS(clientData,interp,argc,argv)2393 listTriggers TCL_CMDPROCARGS(clientData, interp, argc, argv)
2394 {
2395     struct watch *tmp;
2396     Tcl_Obj *list;
2397 
2398     NG_IGNORE(clientData);
2399     NG_IGNORE(argv);
2400     if (argc != 1) {
2401         Tcl_SetResult(interp, "Wrong # args. spice::listTriggers", TCL_STATIC);
2402         return TCL_ERROR;
2403     }
2404 
2405     list = Tcl_NewListObj(0, NULL);
2406 
2407 #ifdef THREADS
2408     mutex_lock(&triggerMutex);
2409 #endif
2410 
2411     for (tmp = watches; tmp; tmp = tmp->next)
2412         Tcl_ListObjAppendElement(interp, list, Tcl_NewStringObj(vectors[tmp->vector].name, strlen(vectors[tmp->vector].name)));
2413 
2414 #ifdef THREADS
2415     mutex_unlock(&triggerMutex);
2416 #endif
2417 
2418     Tcl_SetObjResult(interp, list);
2419 
2420     return TCL_OK;
2421 }
2422 
2423 
2424 static int
TCL_CMDPROCARGS(clientData,interp,argc,argv)2425 tmeasure TCL_CMDPROCARGS(clientData, interp, argc, argv)
2426 {
2427     wordlist *wl = NULL;
2428     double mvalue;
2429 
2430     NG_IGNORE(clientData);
2431     if (argc <= 2) {
2432         Tcl_SetResult(interp, "Wrong # args. spice::listTriggers", TCL_STATIC);
2433         return TCL_ERROR;
2434     }
2435 
2436     wl = wl_build((char **)argv);
2437 
2438     get_measure2(wl, &mvalue, NULL, FALSE);
2439 
2440     printf(" %e \n", mvalue);
2441 
2442     Tcl_ResetResult(spice_interp);
2443 
2444     Tcl_SetObjResult(interp, Tcl_NewDoubleObj((double) mvalue));
2445 
2446     return TCL_OK;
2447 }
2448 
2449 
2450 /*******************************************************/
2451 /*  Initialise spice and setup native methods          */
2452 /*******************************************************/
2453 
2454 #if defined(__MINGW32__) || defined(_MSC_VER)
2455 __declspec(dllexport)
2456 #endif
2457 int
Spice_Init(Tcl_Interp * interp)2458 Spice_Init(Tcl_Interp *interp)
2459 {
2460     if (interp == 0)
2461         return TCL_ERROR;
2462 
2463 #ifdef USE_TCL_STUBS
2464     if (Tcl_InitStubs(interp, (char *)"8.1", 0) == NULL)
2465         return TCL_ERROR;
2466 #endif
2467 
2468     Tcl_PkgProvide(interp, (char*) TCLSPICE_name, (char*) TCLSPICE_version);
2469 
2470     Tcl_Eval(interp, "namespace eval " TCLSPICE_namespace " { }");
2471 
2472     save_interp();
2473 
2474     {
2475         int i;
2476         char *key;
2477         Tcl_CmdInfo infoPtr;
2478         char buf[256];
2479         sighandler old_sigint;
2480 
2481         ft_rawfile = NULL;
2482         ivars(NULL);
2483 
2484         cp_in = stdin;
2485         cp_out = stdout;
2486         cp_err = stderr;
2487 
2488         /*timer*/
2489         init_time();
2490 
2491         /*IFsimulator struct initilised*/
2492         SIMinit(&nutmeginfo, &ft_sim);
2493 
2494         /* program name*/
2495         cp_program = ft_sim->simulator;
2496 
2497         srand((unsigned int) getpid());
2498         TausSeed();
2499 
2500         /*parameter fetcher, used in show*/
2501         if_getparam = spif_getparam_special;
2502 
2503         /* Get startup system limits */
2504         init_rlimits();
2505 
2506         /*Command prompt stuff */
2507         ft_cpinit();
2508 
2509 
2510         /* Read the user config files */
2511         /* To catch interrupts during .spiceinit... */
2512         old_sigint = signal(SIGINT, (SIGNAL_FUNCTION) ft_sigintr);
2513         if (SETJMP(jbuf, 1) == 1) {
2514             ft_sigintr_cleanup();
2515             fprintf(cp_err, "Warning: error executing .spiceinit.\n");
2516             goto bot;
2517         }
2518 
2519 #ifdef HAVE_PWD_H
2520         /* Try to source either .spiceinit or ~/.spiceinit. */
2521         if (access(".spiceinit", 0) == 0) {
2522             inp_source(".spiceinit");
2523         } else {
2524             char *s;
2525             struct passwd *pw;
2526             pw = getpwuid(getuid());
2527 
2528             s = tprintf("%s" DIR_PATHSEP "%s", pw->pw_dir, INITSTR);
2529 
2530             if (access(s, 0) == 0)
2531                 inp_source(s);
2532         }
2533 #else /* ~ HAVE_PWD_H */
2534         {
2535             FILE *fp;
2536             /* Try to source the file "spice.rc" in the current directory.  */
2537             if ((fp = fopen("spice.rc", "r")) != NULL) {
2538                 (void) fclose(fp);
2539                 inp_source("spice.rc");
2540             }
2541         }
2542 #endif /* ~ HAVE_PWD_H */
2543     bot:
2544         signal(SIGINT, old_sigint);
2545 
2546         /* initilise Tk display */
2547         DevInit();
2548 
2549         /* init the mutex */
2550 #ifdef HAVE_LIBPTHREAD
2551         pthread_mutex_init(&triggerMutex, NULL);
2552 #endif
2553 #ifdef THREADS
2554         signal(SIGINT, sighandler_tclspice);
2555 #endif
2556 
2557         /*register functions*/
2558         for (i = 0; (key = cp_coms[i].co_comname); i++) {
2559             sprintf(buf, "%s%s", TCLSPICE_prefix, key);
2560             if (Tcl_GetCommandInfo(interp, buf, &infoPtr) != 0)
2561                 printf("Command '%s' can not be registered!\n", buf);
2562             else
2563                 Tcl_CreateCommand(interp, buf, _tcl_dispatch, NULL, NULL);
2564         }
2565 
2566         Tcl_CreateCommand(interp, TCLSPICE_prefix "spice_header", spice_header, NULL, NULL);
2567         Tcl_CreateCommand(interp, TCLSPICE_prefix "spice_data", spice_data, NULL, NULL);
2568         Tcl_CreateCommand(interp, TCLSPICE_prefix "spicetoblt", spicetoblt, NULL, NULL);
2569         Tcl_CreateCommand(interp, TCLSPICE_prefix "vectoblt", vectoblt, NULL, NULL);
2570         Tcl_CreateCommand(interp, TCLSPICE_prefix "lastVector", lastVector, NULL, NULL);
2571         Tcl_CreateCommand(interp, TCLSPICE_prefix "get_value", get_value, NULL, NULL);
2572         Tcl_CreateCommand(interp, TCLSPICE_prefix "spice", _spice_dispatch, NULL, NULL);
2573         Tcl_CreateCommand(interp, TCLSPICE_prefix "get_output", get_output, NULL, NULL);
2574         Tcl_CreateCommand(interp, TCLSPICE_prefix "get_param", get_param, NULL, NULL);
2575         Tcl_CreateCommand(interp, TCLSPICE_prefix "get_mod_param", get_mod_param, NULL, NULL);
2576         Tcl_CreateCommand(interp, TCLSPICE_prefix "delta", delta, NULL, NULL);
2577         Tcl_CreateCommand(interp, TCLSPICE_prefix "maxstep", maxstep, NULL, NULL);
2578         Tcl_CreateCommand(interp, TCLSPICE_prefix "get_initTime", get_initTime, NULL, NULL);
2579         Tcl_CreateCommand(interp, TCLSPICE_prefix "get_finalTime", get_finalTime, NULL, NULL);
2580         Tcl_CreateCommand(interp, TCLSPICE_prefix "plot_variables", plot_variables, NULL, NULL);
2581         Tcl_CreateCommand(interp, TCLSPICE_prefix "plot_variablesInfo", plot_variablesInfo, NULL, NULL);
2582         Tcl_CreateCommand(interp, TCLSPICE_prefix "plot_get_value", plot_get_value, NULL, NULL);
2583         Tcl_CreateCommand(interp, TCLSPICE_prefix "plot_datapoints", plot_datapoints, NULL, NULL);
2584         Tcl_CreateCommand(interp, TCLSPICE_prefix "plot_title", plot_title, NULL, NULL);
2585         Tcl_CreateCommand(interp, TCLSPICE_prefix "plot_date", plot_date, NULL, NULL);
2586         Tcl_CreateCommand(interp, TCLSPICE_prefix "plot_name", plot_name, NULL, NULL);
2587         Tcl_CreateCommand(interp, TCLSPICE_prefix "plot_typename", plot_typename, NULL, NULL);
2588         Tcl_CreateCommand(interp, TCLSPICE_prefix "plot_nvars", plot_nvars, NULL, NULL);
2589         Tcl_CreateCommand(interp, TCLSPICE_prefix "plot_defaultscale", plot_defaultscale, NULL, NULL);
2590         Tcl_CreateCommand(interp, TCLSPICE_prefix "plot_getvector", plot_getvector, NULL, NULL);
2591         Tcl_CreateCommand(interp, TCLSPICE_prefix "getplot", plot_getplot, NULL, NULL);
2592 
2593         Tcl_CreateCommand(interp, TCLSPICE_prefix "registerTrigger", registerTrigger, NULL, NULL);
2594         Tcl_CreateCommand(interp, TCLSPICE_prefix "registerTriggerCallback", registerTriggerCallback, NULL, NULL);
2595         Tcl_CreateCommand(interp, TCLSPICE_prefix "popTriggerEvent", popTriggerEvent, NULL, NULL);
2596         Tcl_CreateCommand(interp, TCLSPICE_prefix "unregisterTrigger", unregisterTrigger, NULL, NULL);
2597         Tcl_CreateCommand(interp, TCLSPICE_prefix "listTriggers", listTriggers, NULL, NULL);
2598 
2599         Tcl_CreateCommand(interp, TCLSPICE_prefix "registerStepCallback", registerTriggerCallback, NULL, NULL);
2600 #ifdef THREADS
2601         Tcl_CreateCommand(interp, TCLSPICE_prefix "bg", _tcl_dispatch, NULL, NULL);
2602         Tcl_CreateCommand(interp, TCLSPICE_prefix "halt", _tcl_dispatch, NULL, NULL);
2603         Tcl_CreateCommand(interp, TCLSPICE_prefix "running", running, NULL, NULL);
2604 #endif
2605 
2606         Tcl_CreateCommand(interp, TCLSPICE_prefix "tmeasure", tmeasure, NULL, NULL);
2607 
2608         Tcl_CreateCommand(interp, TCLSPICE_prefix "registerStepCallback", registerStepCallback, NULL, NULL);
2609 
2610         Tcl_LinkVar(interp, TCLSPICE_prefix "steps_completed", (char *)&steps_completed, TCL_LINK_READ_ONLY|TCL_LINK_INT);
2611         Tcl_LinkVar(interp, TCLSPICE_prefix "blt_vnum", (char *)&blt_vnum, TCL_LINK_READ_ONLY|TCL_LINK_INT);
2612     }
2613     return TCL_OK;
2614 }
2615 
2616 
2617 /***************************************/
2618 /* printf wrappers to redirect to puts */
2619 /***************************************/
2620 
2621 /* Contributed by Tim Edwards (tim@stravinsky.jhuapl.edu), 2003 */
2622 
2623 
2624 /*------------------------------------------------------*/
2625 /* Redefine the vfprintf() functions for use with tkcon */
2626 /*------------------------------------------------------*/
2627 
2628 int
tcl_vfprintf(FILE * f,const char * fmt,va_list args)2629 tcl_vfprintf(FILE *f, const char *fmt, va_list args)
2630 {
2631     char buf[1024];
2632     char *p, *s;
2633     int size, nchars, escapes, result;
2634 
2635     const char * const escape_chars = "$[]\"\\";
2636 
2637     const char * const prolog =
2638         (f == stderr)
2639         ? "puts -nonewline stderr \""
2640         : "puts -nonewline stdout \"";
2641 
2642     const char * const epilog = "\"";
2643 
2644     const int prolog_len = strlen(prolog);
2645     const int epilog_len = strlen(epilog);
2646 
2647     if ((fileno(f) != STDOUT_FILENO && fileno(f) != STDERR_FILENO &&
2648          f != stderr && f != stdout)
2649 #ifdef THREADS
2650         || (fl_running && bgtid == thread_self())
2651 #endif
2652         )
2653         return vfprintf(f, fmt, args);
2654 
2655     p = buf;
2656 
2657     // size: how much ist left for chars and terminating '\0'
2658     size = sizeof(buf) - prolog_len - epilog_len;
2659     // assert(size > 0);
2660 
2661     for (;;) {
2662         va_list ap;
2663 
2664         va_copy(ap, args);
2665         nchars = vsnprintf(p + prolog_len, size, fmt, ap);
2666         va_end(ap);
2667 
2668         if(nchars == -1) {           /* compatibility to old implementations */
2669             size *= 2;
2670         } else if (size < nchars + 1) {
2671             size = nchars + 1;
2672         } else {
2673             break;
2674         }
2675 
2676         if(p == buf)
2677             p = Tcl_Alloc(prolog_len + size + epilog_len);
2678         else
2679             p = Tcl_Realloc(p, prolog_len + size + epilog_len);
2680     }
2681 
2682     strncpy(p, prolog, prolog_len);
2683 
2684     s = p + prolog_len;
2685     for (escapes = 0; ; escapes++) {
2686         s = strpbrk(s, escape_chars);
2687         if (!s)
2688             break;
2689         s++;
2690     }
2691 
2692     if (escapes) {
2693 
2694         int new_size = prolog_len + nchars + escapes + epilog_len + 1;
2695         char *src, *dst;
2696 
2697         if (p != buf) {
2698             p = Tcl_Realloc(p, new_size);
2699         } else if (new_size > sizeof(buf)) {
2700             p = Tcl_Alloc(new_size);
2701             strcpy(p, buf);
2702         }
2703 
2704         src = p + prolog_len + nchars;
2705         dst = src + escapes;
2706 
2707         while (dst > src) {
2708             char c = *--src;
2709             *--dst = c;
2710             if (strchr(escape_chars, c))
2711                 *--dst = '\\';
2712         }
2713     }
2714 
2715     strcpy(p + prolog_len + nchars + escapes, epilog);
2716 
2717     result = Tcl_Eval(spice_interp, p);
2718 
2719     if (p != buf)
2720         Tcl_Free(p);
2721 
2722     return nchars;
2723 }
2724 
2725 
2726 /*----------------------------------------------------------------------*/
2727 /* Reimplement fprintf() as a call to Tcl_Eval().                       */
2728 /*----------------------------------------------------------------------*/
2729 
2730 int
tcl_fprintf(FILE * f,const char * format,...)2731 tcl_fprintf(FILE *f, const char *format, ...)
2732 {
2733     va_list args;
2734     int rtn;
2735 
2736     va_start (args, format);
2737     rtn = tcl_vfprintf(f, format, args);
2738     va_end(args);
2739 
2740     return rtn;
2741 }
2742 
2743 
2744 /*----------------------------------------------------------------------*/
2745 /* Reimplement printf() as a call to Tcl_Eval().                       */
2746 /*----------------------------------------------------------------------*/
2747 
2748 int
tcl_printf(const char * format,...)2749 tcl_printf(const char *format, ...)
2750 {
2751     va_list args;
2752     int rtn;
2753 
2754     va_start (args, format);
2755     rtn = tcl_vfprintf(stdout, format, args);
2756     va_end(args);
2757 
2758     return rtn;
2759 }
2760 
2761 
2762 /*------------------------------------------------------*/
2763 /* Console output flushing which goes along with the    */
2764 /* routine tcl_vprintf() above.                         */
2765 /*------------------------------------------------------*/
2766 
2767 void
tcl_stdflush(FILE * f)2768 tcl_stdflush(FILE *f)
2769 {
2770     Tcl_SavedResult state;
2771     static char stdstr[] = "flush stdxxx";
2772     char *stdptr = stdstr + 9;
2773 
2774 #ifdef THREADS
2775     if (fl_running && bgtid == thread_self())
2776         return;
2777 #endif
2778 
2779     Tcl_SaveResult(spice_interp, &state);
2780     strcpy(stdptr, (f == stderr) ? "err" : "out");
2781     Tcl_Eval(spice_interp, stdstr);
2782     Tcl_RestoreResult(spice_interp, &state);
2783 }
2784