Expect

Changes On Branch 8b3a054d3555d4cd
Login

Changes On Branch 8b3a054d3555d4cd

Patch Side-by-Side Diff

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Changes In Branch telco-tec-win32-branch Through [8b3a054d35] Excluding Merge-Ins

This is equivalent to a diff from be6c4ae2c3 to 8b3a054d35

2001-11-22
08:50
A working set of code against Tcl8.4! check-in: 4bac78b859 user: davygrvy tags: trunk, win32-jump-point-1
2001-10-29
02:46
had to put the !error directive back in place. check-in: d63fd90ba3 user: davygrvy tags: trunk, telco-tec-win32-branch
02:44
was moved to compat/ check-in: 8b3a054d35 user: davygrvy tags: trunk, telco-tec-win32-branch
2001-10-28
11:12
Stubs has begun check-in: 2ba656b7e6 user: davygrvy tags: trunk, telco-tec-win32-branch
2001-09-13
23:00
the catalog of my changes in this branch check-in: 6f871d0b9e user: davygrvy tags: trunk, telco-tec-win32-branch
03:43
a notice of nothing. check-in: be6c4ae2c3 user: davygrvy tags: trunk, win32-jump-point-1
03:33
moved from root check-in: e629beeecd user: davygrvy tags: trunk, win32-jump-point-1

Changes to .gitignore.
︙
22
23
24
25
26
27
28




22
23
24
25
26
27
28
29
30
31








+
+
+

*.so
*.exe
*.Z
*.elc
*.ln
core
# CVS default ignores end
*.ncb
*.opt
*.plg
Added ChangeLog.win32. 








































































































































































































































































































































































































































































































































































































































































































































































































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

2001-10-28  davygrvy
	* generic/exp.h (new):
	* generic/expDecls.h (new):
	* generic/expInt.h (new):
	* generic/expIntDecls.h (new):
	* generic/expPort.h:
	* generic/exp_command.h (removed):
	* generic/exp_event.h (removed):
		reworking the header files for a more core style and structure.

	* generic/exp.decls:
		(new) Stubs table

	* expect.dsw:
	* win/genStubs.dsp (new):
		IDE file for rebuilding the Stubs table.

	* win/expWinLog.c:
		removed the check to when not to call DebugBreak().  Always
		call it.

	* generic/expCommand.c:
	* generic/expCommand.c:
	* generic/exp_event.c:
		large amount of edits to make it work (again).  Needs to be checked against
		the snap29 mods.

	* generic/exp_main_sub.c:
		no more custom shells

	* win/buildfiles.dsp:
	* win/expect.dsp:
	* win/makefile.vc32:
	* win/mkfiles.mif:
		build instruction changes

	* makefile.win:
		extension target changed from 'release' to 'expect'

2001-10-26  davygrvy
	* unix/expUnixSpawnChan.c:
		a "merge" of the older Gordon port to 5.32.2's

	* win/expWinLog.c:
	* win/expWinProcess.c:
	* win/expWinSlaveDbg.c:
	* win/expWinSlaveDrv.c:
	* win/spawndrvmc.mc:
		adding more calls to ExpSyslog() where needed.

	* win/expWin.h:
	* win/expWinDynloadTclStubs.c:
	* win/expWinLog.c:
	* win/expWinProcess.c:
	* win/expWinSlaveDbg.c:
	* win/expWinSlaveDrv.c:
	* win/spawndrvmc.mc:
		ExpSyslog() is finally doing what I want.  More work to do, but the
		groundwork is now set.

	* expect.dsw:
	* win/buildfiles.dsp:
	* win/expect.dsp:
		a couple more IDE project files for MsDev

2001-10-22  davygrvy
	* win/msjexhnd.cpp:
	* win/msjexhnd.h:
		simple formatting changes.

	* win/makefile.vc32:
		Needed to include the temp directory in the include path so spawndrvmc.h
		is picked-up.

	* win/expWinSlaveDbg.c:
		removed #include "tclInt.h".  tclPort.h brings it in anyways.

	* win/slavedrv.dsp:
		MSVC++ v6 project file.  Calls the makefile anyways..  Just a shortcut
		when working in the IDE so the debugger knows what is what and who
		is who and everyone can co-exist all peacefully.

	* expect.dsw:
		MSVC++ v6 workspace file for the IDE.

	* .cvsignore:
	* win/.cvsignore:
		globs to ignore by CVS.

2001-10-14  davygrvy
	* win/expect.rc:
	* win/spawndrv.rc:
	* win/spawndrvmc.mc:
		Added #define RESOURCE_INCLUDED because tcl.h doesn't
		use RC_INVOKED.  Which it should, but doesn't.

	* mkconfig.mif:
	* win/makefile.vc32:
	* win/mkfiles.mif:
	* win/mkprepvc32.mif:
	* win/mkvc32.mif:
		Changed the build files to be run from the /win directory instead
		of the top-root.  This will help get MS project .dsp files working.

2001-10-12  davygrvy
	* win/spawndrv.rc:
	* win/spawndrv.rc:
	* win/spawndrvmc.mc:
		spawndrv.exe needed a resource script and a message catalog.

	* win/spawndrv.rc:
	* win/spawndrvmc.mc:
		getting closer to building the message catalog.

	* win/spawndrvmc.mc:
		corrected title block text.

2001-10-11  davygrvy
	* win/expWin.h:
	* win/expWinDynloadTclStubs.c:
	* win/expWinProcess.c:
	* win/expWinSlaveDrv.c:
	* win/mkfiles.mif:
		Added Stubs dynloading stuff.  slavedrv.exe appears to be
		working thus far,

	* win/expWinProcess.c:
		Added ExpInitWinProcessAPI() to setup the ascii/unicode proc
		switching.

	* win/expWinProcess.c:
		l'il bugfix

	* win/expWin.h:
	* win/expWin.h:
	* win/expWinCommand.c:
	* win/expWinPort.h:
	* win/expWinProcess.c:
	* win/expWinProcess.c:
	* win/expWinSlave.h:
	* win/expWinSlaveDbg.c:
	* win/expWinSlaveDrv.c:
	* win/expWinSpawnChan.c:
	* win/expWinTty.c:
	* win/expect.rc:
	* win/makefile.vc32:
	* win/makefile.vc32:
	* win/mkfiles.mif:
	* win/mkvc32.mif:
	* win/mkvc32.mif:
		slavedrv.exe is building..  need to add Stubs startup code.

	* win/expWinProcess.c:
		updated ExpCreateProcess() to match 8.4 imp.  I wish I could use the core for
		this function, but can't as the changes are deep.

	* win/expWinProcess.c:
		Ack!  bigger bugfix repaired.  Had some doubleup during some edits for
		comparisons and forget to delete the old half.

2001-10-05  davygrvy
	* generic/exp_main_exp.c:
	* generic/exp_main_tk.c:
		motion toward a pure extension.  No custom shells.

	* generic/expSpawnChan.c:
		Mostly adapted to the ExpState structure...

	* generic/exp_regexp.c:
	* generic/exp_regexp.h:
		won't be used anymore in favor of the core RE engine.

	* generic/expChannel.c:
		pertinent code moved to expSpawnChan.c instead.

	* generic/exp_memmove.c:
		moved to the compat/ directory

2001-10-04  davygrvy
	* win/expectlib.rc:
		There will be no more expectLib

2001-10-03  davygrvy
	* exp_tty_in.h:
		Top-level source files removed.

2001-10-02  davygrvy
	* win/panic.c:
	* win/tclHash.c:
		not needed.  We'll be using the core for this.  NO COPIES!

	* win/Dbg_cf.h:
		not needed here.

	* generic/expect.c:
	* generic/expect.h:
		fixed numerous warnings and errors.  code is from 5.32.2

	* Dbg.c:
	* expTcl.c:
	* expTcl.h:
	* exp_chan.c:
	* exp_clib.c:
	* exp_closetcl.c:
	* exp_command.c:
	* exp_command.h:
	* exp_console.c:
	* exp_event.c:
	* exp_event.h:
	* exp_glob.c:
	* exp_int.h:
	* exp_inter.c:
	* exp_log.c:
	* exp_log.h:
	* exp_main_exp.c:
	* exp_main_sub.c:
	* exp_main_tk.c:
	* exp_noevent.c:
	* exp_poll.c:
	* exp_prog.h:
	* exp_pty.c:
	* exp_pty.h:
	* exp_regexp.c:
	* exp_regexp.h:
	* exp_rename.h:
	* exp_simple.c:
	* exp_trap.c:
	* exp_tstamp.h:
	* exp_tty.c:
	* exp_tty.h:
	* exp_tty_comm.c:
	* exp_win.c:
	* exp_win.h:
	* expect.c:
	* expect.h:
	* expect_comm.h:
	* expect_tcl.h:
	* pty_sgttyb.c:
	* pty_termios.c:
	* pty_unicos.c:
	* tcldbg.h:
		Top-level source files removed.

	* generic/Dbg.c:
	* generic/Dbg.h:
	* generic/tcldbg.h:
		Brought in 5.32.2 and fixed compiler warnings about
		inappropriate casts.

2001-09-28  davygrvy
	* win/mkfiles.mif:
		Common list of target object files for all make implimentations.

	* makefile.win:
		Added list of expected (pun intended) targets that will be used.

	* win/mkprepvc32.mif:
	* win/mkvc32.mif:
		Moved the makefile prep work to a seperate file.

	* mkconfig.mif:
		Added more config info the build system will need.

2001-09-26  davygrvy
	* win/expAlloc.c:
	* win/expDString.c:
		already found in the core.  NO COPIES ALLOWED!

	* makefile.win:
	* mkconfig.mif:
	* win/makefile.vc32:
	* win/mkbc32.mif:
	* win/mkmgw32.mif:
	* win/mkvc32.mif:
	* win/mkwc32.mif:
		New top-root makefile under windows.

2001-09-13  davygrvy
	* generic/Dbg.c:
	* generic/Dbg.h:
	* generic/expChan.c:
	* generic/expChannel.c:
	* generic/expCommand.c:
	* generic/expSpawnChan.c:
	* generic/expTrap.c:
	* generic/exp_clib.c:
	* generic/exp_closetcl.c:
	* generic/exp_command.h:
	* generic/exp_event.c:
	* generic/exp_event.h:
	* generic/exp_glob.c:
	* generic/exp_int.h:
	* generic/exp_inter.c:
	* generic/exp_log.c:
	* generic/exp_log.h:
	* generic/exp_main_exp.c:
	* generic/exp_main_sub.c:
	* generic/exp_main_tk.c:
	* generic/exp_memmove.c:
	* generic/exp_noevent.c:
	* generic/exp_port.h:
	* generic/exp_printify.c:
	* generic/exp_printify.h:
	* generic/exp_prog.h:
	* generic/exp_regexp.c:
	* generic/exp_regexp.h:
	* generic/exp_rename.h:
	* generic/exp_strf.c:
	* generic/exp_tstamp.h:
	* generic/exp_tty.h:
	* generic/exp_version.h:
	* generic/exp_win.c:
	* generic/exp_win.h:
	* generic/expect.c:
	* generic/expect.h:
	* generic/expect_comm.h:
	* generic/expect_tcl.h:
	* generic/getopt.c:
	* generic/getopt.h:
	* unix/DbgMkfl.in:
	* unix/Dbg_cf.h.in:
	* unix/Dbgconfig.in:
	* unix/Makefile.in:
	* unix/aclocal.m4:
	* unix/config.guess:
	* unix/config.sub:
	* unix/configure:
	* unix/configure.in:
	* unix/expUnixCommand.c:
	* unix/expUnixPort.h:
	* unix/expUnixSpawnChan.c:
	* unix/expUnixTty.c:
	* unix/expUnixTty.h:
	* unix/exp_clib_orig.c:
	* unix/exp_command.c:
	* unix/exp_console.c:
	* unix/exp_poll.c:
	* unix/exp_pty.c:
	* unix/exp_pty.h:
	* unix/exp_select.c:
	* unix/exp_simple.c:
	* unix/exp_trap.c:
	* unix/exp_tty_comm.c:
	* unix/exp_tty_in.h:
	* unix/expect_cf.h.in:
	* unix/fixcat:
	* unix/fixline1:
	* unix/install-sh:
	* unix/pkgIndex.in:
	* unix/pty_sgttyb.c:
	* unix/pty_termios.c:
	* unix/pty_unicos.c:
	* unix/vgrindefs:
	* win/Dbg_cf.h:
	* win/debugger.c:
	* win/etest.tcl:
	* win/expAlloc.c:
	* win/expDString.c:
	* win/expWin.h:
	* win/expWinCLib.c:
	* win/expWinCommand.c:
	* win/expWinLog.c:
	* win/expWinPort.h:
	* win/expWinProcess.c:
	* win/expWinSlave.h:
	* win/expWinSlaveDbg.c:
	* win/expWinSlaveDrv.c:
	* win/expWinSlaveKey.c:
	* win/expWinSpawnChan.c:
	* win/expWinTrap.c:
	* win/expWinTty.c:
	* win/expWinTty.h:
	* win/expect.rc:
	* win/expectlib.rc:
	* win/makefile:
	* win/msjexhnd.cpp:
	* win/msjexhnd.h:
	* win/panic.c:
	* win/pkgIndex.tcl:
	* win/tclHash.c:
	* win/testa2.c:
	* win/testcalc.c:
	* win/testcalc.h:
	* win/testcat.c:
	* win/testcat.mak:
	* win/testclib.c:
	* win/testclib2.c:
	* win/testconsout.c:
	* win/testcrash.c:
	* win/testmodem.c:
	* win/tests/all:
	* win/tests/basic.test:
	* win/tests/cmd.test:
	* win/tests/crash.tcl:
	* win/tests/crash.test:
	* win/tests/defs:
	* win/tests/emacs.test:
	* win/tests/ftp.test:
	* win/tests/modemtest.exp:
	* win/tests/pipe.test:
	* win/tests/script.test:
	* win/tests/suite.tcl:
	* win/tests/telnet.test:
	* win/tests/test.pl:
	* win/tests/test_suite.tcl:
	* win/tests/testtcl:
	* win/tests/trap.tcl:
	* win/tests/trap.test:
	* win/tests/trap2.tcl:
	* win/testsig.c:
	* win/testwprog.c:
	* win/testwstation.c:
	* win/testwstation.tcl:
		snap29 "import"

	* exp_clib.c:
		<eol> mishandling repaired

	* mac/README.mac.txt:
		a notice of nothing.

	* exp_clib.c:
		umm.. fixed bad fix...  ignore last mistake ;)

	* compat/exp_memmove.c:
	* compat/exp_select.c:
	* compat/exp_strf.c:
	* doc/expect.man:
	* doc/expectk.man:
	* doc/libexpect.man:
	* exp_memmove.c:
	* exp_select.c:
	* exp_strf.c:
	* expect.man:
	* expectk.man:
	* libexpect.man:
		moved from root

2000-01-06  wart
	* exp_printify.c:
	* exp_printify.h:
		Merge of expect5-31-branch to mainline

1999-09-01  jenn
	* tests/all:
	* tests/defs:
		Removed all and defs, added all.tcl.

1999-08-31  jenn
	* tests/all:
	* tests/defs:
		* Makefile.in: Changed test target to source tests/all.tcl instead
		of tests/all
		
		* tests/README: Modified documentation to reflect the change from
		usage of a defs file to the use of package tcltest to run the tests
		
		* tests/all:
		* tests/defs:
		* tests/all.tcl:
		* tests/cat.test:
		* tests/expect.test:
		* tests/logfile.test:
		* tests/pid.test:
		* tests/send.test:
		* tests/spawn.test
		* tests/stty.test: Modified test files to use package tcltest,
		removed tests/all and tests/defs, and added tests/all.tcl

1999-06-15  stanton
	* exp_printify.c:
	* exp_printify.h:
		regenerated configure script
		removed exp_printify files
		changed Dbg.c to use new regexp interfaces

1999-06-14  don
	* exp_printify.h:
		made stuff compile

	* exp_printify.c:
		fixed Log/Diag and ExpectCmd

1999-06-11  stanton
	* exp_printify.c:
		modified expect command to use new regexp interfaces, made various
		I18N changes

1998-10-14  cvsadmin
	* exp_printify.c:
	* exp_printify.h:
	* tests/all:
	* tests/defs:
		Import of Expect v. 5.28.1

2001-10-14  davygrvy
	* win/expect.rc:
	* win/spawndrv.rc:
	* win/spawndrvmc.mc:
		Added #define RESOURCE_INCLUDED because tcl.h doesn't
		use RC_INVOKED.  Which it should, but doesn't.

	* mkconfig.mif:
	* win/makefile.vc32:
	* win/mkfiles.mif:
	* win/mkprepvc32.mif:
	* win/mkvc32.mif:
		Changed the build files to be run from the /win directory instead
		of the top-root.  This will help get MS project .dsp files working.

2001-10-12  davygrvy
	* win/spawndrv.rc:
	* win/spawndrv.rc:
	* win/spawndrvmc.mc:
		spawndrv.exe needed a resource script and a message catalog.

	* win/spawndrv.rc:
	* win/spawndrvmc.mc:
		getting closer to building the message catalog.

	* win/spawndrvmc.mc:
		corrected title block text.

2001-10-11  davygrvy
	* win/expWin.h:
	* win/expWinDynloadTclStubs.c:
	* win/expWinProcess.c:
	* win/expWinSlaveDrv.c:
	* win/mkfiles.mif:
		Added Stubs dynloading stuff.  slavedrv.exe appears to be
		working thus far,

	* win/expWinProcess.c:
		Added ExpInitWinProcessAPI() to setup the ascii/unicode proc
		switching.

	* win/expWinProcess.c:
		l'il bugfix

	* win/expWin.h:
	* win/expWin.h:
	* win/expWinCommand.c:
	* win/expWinPort.h:
	* win/expWinProcess.c:
	* win/expWinProcess.c:
	* win/expWinSlave.h:
	* win/expWinSlaveDbg.c:
	* win/expWinSlaveDrv.c:
	* win/expWinSpawnChan.c:
	* win/expWinTty.c:
	* win/expect.rc:
	* win/makefile.vc32:
	* win/makefile.vc32:
	* win/mkfiles.mif:
	* win/mkvc32.mif:
	* win/mkvc32.mif:
		slavedrv.exe is building..  need to add Stubs startup code.

	* win/expWinProcess.c:
		updated ExpCreateProcess() to match 8.4 imp.  I wish I could use the core for
		this function, but can't as the changes are deep.

	* win/expWinProcess.c:
		Ack!  bigger bugfix repaired.  Had some doubleup during some edits for
		comparisons and forget to delete the old half.

2001-10-05  davygrvy
	* generic/exp_main_exp.c:
	* generic/exp_main_tk.c:
		motion toward a pure extension.  No custom shells.

	* generic/expSpawnChan.c:
		Mostly adapted to the ExpState structure...

	* generic/exp_regexp.c:
	* generic/exp_regexp.h:
		won't be used anymore in favor of the core RE engine.

	* generic/expChannel.c:
		pertinent code moved to expSpawnChan.c instead.

	* generic/exp_memmove.c:
		moved to the compat/ directory

2001-10-04  davygrvy
	* win/expectlib.rc:
		There will be no more expectLib

2001-10-03  davygrvy
	* exp_tty_in.h:
		Top-level source files removed.

2001-10-02  davygrvy
	* win/panic.c:
	* win/tclHash.c:
		not needed.  We'll be using the core for this.  NO COPIES!

	* win/Dbg_cf.h:
		not needed here.

	* generic/expect.c:
	* generic/expect.h:
		fixed numerous warnings and errors.  code is from 5.32.2

	* Dbg.c:
	* expTcl.c:
	* expTcl.h:
	* exp_chan.c:
	* exp_clib.c:
	* exp_closetcl.c:
	* exp_command.c:
	* exp_command.h:
	* exp_console.c:
	* exp_event.c:
	* exp_event.h:
	* exp_glob.c:
	* exp_int.h:
	* exp_inter.c:
	* exp_log.c:
	* exp_log.h:
	* exp_main_exp.c:
	* exp_main_sub.c:
	* exp_main_tk.c:
	* exp_noevent.c:
	* exp_poll.c:
	* exp_prog.h:
	* exp_pty.c:
	* exp_pty.h:
	* exp_regexp.c:
	* exp_regexp.h:
	* exp_rename.h:
	* exp_simple.c:
	* exp_trap.c:
	* exp_tstamp.h:
	* exp_tty.c:
	* exp_tty.h:
	* exp_tty_comm.c:
	* exp_win.c:
	* exp_win.h:
	* expect.c:
	* expect.h:
	* expect_comm.h:
	* expect_tcl.h:
	* pty_sgttyb.c:
	* pty_termios.c:
	* pty_unicos.c:
	* tcldbg.h:
		Top-level source files removed.

	* generic/Dbg.c:
	* generic/Dbg.h:
	* generic/tcldbg.h:
		Brought in 5.32.2 and fixed compiler warnings about
		inappropriate casts.

2001-09-28  davygrvy
	* win/mkfiles.mif:
		Common list of target object files for all make implimentations.

	* makefile.win:
		Added list of expected (pun intended) targets that will be used.

	* win/mkprepvc32.mif:
	* win/mkvc32.mif:
		Moved the makefile prep work to a seperate file.

	* mkconfig.mif:
		Added more config info the build system will need.

2001-09-26  davygrvy
	* win/expAlloc.c:
	* win/expDString.c:
		already found in the core.  NO COPIES ALLOWED!

	* makefile.win:
	* mkconfig.mif:
	* win/makefile.vc32:
	* win/mkbc32.mif:
	* win/mkmgw32.mif:
	* win/mkvc32.mif:
	* win/mkwc32.mif:
		New top-root makefile under windows.

2001-09-12  David Gravereaux <[email protected]>

	* makefile.win:
	* mkconfig.mif:
	* win/mkvc32.mif:
	* win/makefile.vc32:

2001-09-13  David Gravereaux <[email protected]>

	* generic/Dbg.c:
	* generic/Dbg.h:
	* generic/expChan.c:
	* generic/expChannel.c:
	* generic/expCommand.c:
	* generic/expSpawnChan.c:
	* generic/expTrap.c:
	* generic/exp_clib.c:
	* generic/exp_closetcl.c:
	* generic/exp_command.h:
	* generic/exp_event.c:
	* generic/exp_event.h:
	* generic/exp_glob.c:
	* generic/exp_int.h:
	* generic/exp_inter.c:
	* generic/exp_log.c:
	* generic/exp_log.h:
	* generic/exp_main_exp.c:
	* generic/exp_main_sub.c:
	* generic/exp_main_tk.c:
	* generic/exp_memmove.c:
	* generic/exp_noevent.c:
	* generic/exp_port.h:
	* generic/exp_printify.c:
	* generic/exp_printify.h:
	* generic/exp_prog.h:
	* generic/exp_regexp.c:
	* generic/exp_regexp.h:
	* generic/exp_rename.h:
	* generic/exp_strf.c:
	* generic/exp_tstamp.h:
	* generic/exp_tty.h:
	* generic/exp_version.h:
	* generic/exp_win.c:
	* generic/exp_win.h:
	* generic/expect.c:
	* generic/expect.h:
	* generic/expect_comm.h:
	* generic/expect_tcl.h:
	* generic/getopt.c:
	* generic/getopt.h:
	* unix/DbgMkfl.in:
	* unix/Dbg_cf.h.in:
	* unix/Dbgconfig.in:
	* unix/Makefile.in:
	* unix/aclocal.m4:
	* unix/config.guess:
	* unix/config.sub:
	* unix/configure:
	* unix/configure.in:
	* unix/expUnixCommand.c:
	* unix/expUnixPort.h:
	* unix/expUnixSpawnChan.c:
	* unix/expUnixTty.c:
	* unix/expUnixTty.h:
	* unix/exp_clib_orig.c:
	* unix/exp_command.c:
	* unix/exp_console.c:
	* unix/exp_poll.c:
	* unix/exp_pty.c:
	* unix/exp_pty.h:
	* unix/exp_select.c:
	* unix/exp_simple.c:
	* unix/exp_trap.c:
	* unix/exp_tty_comm.c:
	* unix/exp_tty_in.h:
	* unix/expect_cf.h.in:
	* unix/fixcat:
	* unix/fixline1:
	* unix/install-sh:
	* unix/pkgIndex.in:
	* unix/pty_sgttyb.c:
	* unix/pty_termios.c:
	* unix/pty_unicos.c:
	* unix/vgrindefs:
	* win/Dbg_cf.h:
	* win/debugger.c:
	* win/etest.tcl:
	* win/expAlloc.c:
	* win/expDString.c:
	* win/expWin.h:
	* win/expWinCLib.c:
	* win/expWinCommand.c:
	* win/expWinLog.c:
	* win/expWinPort.h:
	* win/expWinProcess.c:
	* win/expWinSlave.h:
	* win/expWinSlaveDbg.c:
	* win/expWinSlaveDrv.c:
	* win/expWinSlaveKey.c:
	* win/expWinSpawnChan.c:
	* win/expWinTrap.c:
	* win/expWinTty.c:
	* win/expWinTty.h:
	* win/expect.rc:
	* win/expectlib.rc:
	* win/makefile:
	* win/msjexhnd.cpp:
	* win/msjexhnd.h:
	* win/panic.c:
	* win/pkgIndex.tcl:
	* win/tclHash.c:
	* win/testa2.c:
	* win/testcalc.c:
	* win/testcalc.h:
	* win/testcat.c:
	* win/testcat.mak:
	* win/testclib.c:
	* win/testclib2.c:
	* win/testconsout.c:
	* win/testcrash.c:
	* win/testmodem.c:
	* win/tests/all:
	* win/tests/basic.test:
	* win/tests/cmd.test:
	* win/tests/crash.tcl:
	* win/tests/crash.test:
	* win/tests/defs:
	* win/tests/emacs.test:
	* win/tests/ftp.test:
	* win/tests/modemtest.exp:
	* win/tests/pipe.test:
	* win/tests/script.test:
	* win/tests/suite.tcl:
	* win/tests/telnet.test:
	* win/tests/test.pl:
	* win/tests/test_suite.tcl:
	* win/tests/testtcl:
	* win/tests/trap.tcl:
	* win/tests/trap.test:
	* win/tests/trap2.tcl:
	* win/testsig.c:
	* win/testwprog.c:
	* win/testwstation.c:
	* win/testwstation.tcl:
		snap29 "import"

	* exp_clib.c:
		<eol> mishandling repaired

	* mac/README.mac.txt:
		a notice of nothing.

	* exp_clib.c:
		umm.. fixed bad fix...  ignore last mistake ;)

	* compat/exp_memmove.c (new):
	* compat/exp_select.c (new):
	* compat/exp_strf.c (new):
	* doc/expect.man (new):
	* doc/expectk.man (new):
	* doc/libexpect.man (new):
	* exp_memmove.c (deleted):
	* exp_select.c (deleted):
	* exp_strf.c (deleted):
	* expect.man (deleted):
	* expectk.man (deleted):
	* libexpect.man (deleted):
		moved from root


2001-09-12  David Gravereaux <[email protected]>

	* Created the 'telco-tec-win32-branch' from the HEAD.

	* `Imported`, as it were, Gordon Chaffe's snap29.  The root
	directory is still 5.32.2, and the sub directories for generic,
	win, and unix are Gordon's 5.21-snap29.

	* Moved the 5.32.2 .man scripts into doc/

	* Plans include full `Stubs compliance` for both importing Tcl's
	and exporting itself.  expectlib is to be discarded as the direction
	problem with it needing core function COPIES is a maintenence
	nightmare.  When one will want the C library, it will be housed
	in the extension itself, the outside interface will not mention Tcl,
	but the inside usage will require the Tcl library.  This backward
	reverse loading issue is identical in the pattern the TclPlugin
	has, and similar to TclBlend as well.






Deleted Dbg.c.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339





























































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

/* Dbg.c - Tcl Debugger - See cmdHelp() for commands

Written by: Don Libes, NIST, 3/23/93

Design and implementation of this program was paid for by U.S. tax
dollars.  Therefore it is public domain.  However, the author and NIST
would appreciate credit if this program or parts of it are used.

 RCS: @(#) $Id:  Exp $

*/

#include <stdio.h>

#include "tcldbgcf.h"
#if 0
/* tclInt.h drags in stdlib.  By claiming no-stdlib, force it to drag in */
/* Tcl's compat version.  This avoids having to test for its presence */
/* which is too tricky - configure can't generate two cf files, so when */
/* Expect (or any app) uses the debugger, there's no way to get the info */
/* about whether stdlib exists or not, except pointing the debugger at */
/* an app-dependent .h file and I don't want to do that. */
#define NO_STDLIB_H
#endif


#include "tclInt.h"
/*#include <varargs.h>		tclInt.h drags in varargs.h.  Since Pyramid */
/*				objects to including varargs.h twice, just */
/*				omit this one. */
/*#include "string.h"		tclInt.h drags this in, too! */
#include "tcldbg.h"

#ifndef TRUE
#define TRUE 1
#define FALSE 0
#endif

static int simple_interactor();
static int zero();

/* most of the static variables in this file may be */
/* moved into Tcl_Interp */

static Dbg_InterProc *interactor = simple_interactor;
static ClientData interdata = 0;
static Dbg_IgnoreFuncsProc *ignoreproc = zero;
static Dbg_OutputProc *printproc = 0;
static ClientData printdata = 0;

static void print _ANSI_ARGS_(TCL_VARARGS(Tcl_Interp *,interp));

static int debugger_active = FALSE;

/* this is not externally documented anywhere as of yet */
char *Dbg_VarName = "dbg";

#define DEFAULT_COMPRESS	0
static int compress = DEFAULT_COMPRESS;
#define DEFAULT_WIDTH		75	/* leave a little space for printing */
					/*  stack level */
static int buf_width = DEFAULT_WIDTH;

static int main_argc = 1;
static char *default_argv = "application";
static char **main_argv = &default_argv;

static Tcl_Trace debug_handle;
static int step_count = 1;	/* count next/step */

#define FRAMENAMELEN 10		/* enough to hold strings like "#4" */
static char viewFrameName[FRAMENAMELEN];/* destination frame name for up/down */

static CallFrame *goalFramePtr;	/* destination for next/return */
static int goalNumLevel;	/* destination for Next */

static enum debug_cmd {
	none, step, next, ret, cont, up, down, where, Next
} debug_cmd = step;

/* info about last action to use as a default */
static enum debug_cmd last_action_cmd = next;
static int last_step_count = 1;

/* this acts as a strobe (while testing breakpoints).  It is set to true */
/* every time a new debugger command is issued that is an action */
static debug_new_action;

#define NO_LINE -1	/* if break point is not set by line number */

struct breakpoint {
	int id;
	Tcl_Obj *file;	/* file where breakpoint is */
	int line;	/* line where breakpoint is */
	int re;		/* 1 if this is regexp pattern */
	Tcl_Obj *pat;	/* pattern defining where breakpoint can be */
	Tcl_Obj *expr;	/* expr to trigger breakpoint */
	Tcl_Obj *cmd;	/* cmd to eval at breakpoint */
	struct breakpoint *next, *previous;
};

static struct breakpoint *break_base = 0;
static int breakpoint_max_id = 0;

static struct breakpoint *
breakpoint_new()
{
	struct breakpoint *b = (struct breakpoint *)ckalloc(sizeof(struct breakpoint));
	if (break_base) break_base->previous = b;
	b->next = break_base;
	b->previous = 0;
	b->id = breakpoint_max_id++;
	b->file = 0;
	b->line = NO_LINE;
	b->pat = 0;
	b->re = 0;
	b->expr = 0;
	b->cmd = 0;
	break_base = b;
	return(b);
}

static
void
breakpoint_print(interp,b)
Tcl_Interp *interp;
struct breakpoint *b;
{
    print(interp,"breakpoint %d: ",b->id);

    if (b->re) {
	print(interp,"-re \"%s\" ",Tcl_GetString(b->pat));
    } else if (b->pat) {
	print(interp,"-glob \"%s\" ",Tcl_GetString(b->pat));
    } else if (b->line != NO_LINE) {
	if (b->file) {
	    print(interp,"%s:",Tcl_GetString(b->file));
	}
	print(interp,"%d ",b->line);
    }

    if (b->expr)
	print(interp,"if {%s} ",Tcl_GetString(b->expr));

    if (b->cmd)
	print(interp,"then {%s}",Tcl_GetString(b->cmd));

    print(interp,"\n");
}

static void
save_re_matches(interp, re, objPtr)
Tcl_Interp *interp;
Tcl_RegExp re;
Tcl_Obj *objPtr;
{
    Tcl_RegExpInfo info;
    int i, start;
    char name[20];

    Tcl_RegExpGetInfo(re, &info); 
    for (i=0;i<=info.nsubs;i++) {
	start = info.matches[i].start;
	/* end = info.matches[i].end-1;*/

	if (start == -1) continue;

	sprintf(name,"%d",i);
	Tcl_SetVar2Ex(interp, Dbg_VarName, name, Tcl_GetRange(objPtr,
		info.matches[i].start, info.matches[i].end-1), 0);
    }
}

/* return 1 to break, 0 to continue */
static int
breakpoint_test(interp,cmd,bp)
Tcl_Interp *interp;
char *cmd;		/* command about to be executed */
struct breakpoint *bp;	/* breakpoint to test */
{
    if (bp->re) {
        int found = 0;
	Tcl_Obj *cmdObj;
	Tcl_RegExp re = Tcl_GetRegExpFromObj(NULL, bp->pat,
		TCL_REG_ADVANCED);
	cmdObj = Tcl_NewStringObj(cmd,-1);
	Tcl_IncrRefCount(cmdObj);
	if (Tcl_RegExpExecObj(NULL, re, cmdObj, 0 /* offset */,
		-1 /* nmatches */, 0 /* eflags */) > 0) {
	    save_re_matches(interp, re, cmdObj);
	    found = 1;
	}
	Tcl_DecrRefCount(cmdObj);
	if (!found) return 0;
    } else if (bp->pat) {
	if (0 == Tcl_StringMatch(cmd,
		Tcl_GetString(bp->pat))) return 0;
    } else if (bp->line != NO_LINE) {
	/* not yet implemented - awaiting support from Tcl */
	return 0;
    }

    if (bp->expr) {
	int value;

	/* ignore errors, since they are likely due to */
	/* simply being out of scope a lot */
	if (TCL_OK != Tcl_ExprBooleanObj(interp,bp->expr,&value)
		|| (value == 0)) return 0;
    }

    if (bp->cmd) {
	Tcl_EvalObjEx(interp, bp->cmd, 0);
    } else {
	breakpoint_print(interp,bp);
    }

    return 1;
}

static char *already_at_top_level = "already at top level";

/* similar to TclGetFrame but takes two frame ptrs and a direction.
If direction is up,   search up stack from curFrame
If direction is down, simulate searching down stack by
		      seaching up stack from origFrame
*/
static
int
TclGetFrame2(interp, origFramePtr, string, framePtrPtr, dir)
    Tcl_Interp *interp;
    CallFrame *origFramePtr;	/* frame that is true top-of-stack */
    char *string;		/* String describing frame. */
    CallFrame **framePtrPtr;	/* Store pointer to frame here (or NULL
				 * if global frame indicated). */
    enum debug_cmd dir;	/* look up or down the stack */
{
    Interp *iPtr = (Interp *) interp;
    int level, result;
    CallFrame *framePtr;	/* frame currently being searched */

    CallFrame *curFramePtr = iPtr->varFramePtr;

    /*
     * Parse string to figure out which level number to go to.
     */

    result = 1;
    if (*string == '#') {
	if (Tcl_GetInt(interp, string+1, &level) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (level < 0) {
	    levelError:
	    Tcl_AppendResult(interp, "bad level \"", string, "\"",
		    (char *) NULL);
	    return TCL_ERROR;
	}
	framePtr = origFramePtr; /* start search here */
	
    } else if (isdigit(*string)) {
	if (Tcl_GetInt(interp, string, &level) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (dir == up) {
		if (curFramePtr == 0) {
			Tcl_SetResult(interp,already_at_top_level,TCL_STATIC);
			return TCL_ERROR;
		}
		level = curFramePtr->level - level;
		framePtr = curFramePtr; /* start search here */
	} else {
		if (curFramePtr != 0) {
			level = curFramePtr->level + level;
		}
		framePtr = origFramePtr; /* start search here */
	}
    } else {
	level = curFramePtr->level - 1;
	result = 0;
    }

    /*
     * Figure out which frame to use.
     */

    if (level == 0) {
	framePtr = NULL;
    } else {
	for (;framePtr != NULL;	framePtr = framePtr->callerVarPtr) {
	    if (framePtr->level == level) {
		break;
	    }
	}
	if (framePtr == NULL) {
	    goto levelError;
	}
    }
    *framePtrPtr = framePtr;
    return result;
}


static char *printify(s)
char *s;
{
    static int destlen = 0;
    char *d;		/* ptr into dest */
    unsigned int need;
    static char buf_basic[DEFAULT_WIDTH+1];
    static char *dest = buf_basic;
    Tcl_UniChar ch;

    if (s == 0) return("<null>");

    /* worst case is every character takes 4 to printify */
    need = strlen(s)*6;
    if (need > destlen) {
	if (dest && (dest != buf_basic)) ckfree(dest);
	dest = (char *)ckalloc(need+1);
	destlen = need;
    }

    for (d = dest;*s;) {
	s += Tcl_UtfToUniChar(s, &ch);
	if (ch == '\b') {
	    strcpy(d,"\\b");		d += 2;
	} else if (ch == '\f') {
	    strcpy(d,"\\f");		d += 2;
	} else if (ch == '\v') {
	    strcpy(d,"\\v");		d += 2;
	} else if (ch == '\r') {
	    strcpy(d,"\\r");		d += 2;
	} else if (ch == '\n') {
	    strcpy(d,"\\n");		d += 2;
	} else if (ch == '\t') {
	    strcpy(d,"\\t");		d += 2;
	} else if ((unsigned)ch < 0x20) { /* unsigned strips parity */
	    sprintf(d,"\\%03o",ch);		d += 4;
	} else if (ch == 0177) {
	    strcpy(d,"\\177");		d += 4;
	} else if ((ch < 0x80) && isprint(UCHAR(ch))) {
	    *d = (char)ch;		d += 1;
	} else {
	    sprintf(d,"\\u%04x",ch);	d += 6;
	}
    }
    *d = '\0';
    return(dest);
}

static
char *
print_argv(interp,argc,argv)
Tcl_Interp *interp;
int argc;
char *argv[];
{
	static int buf_width_max = DEFAULT_WIDTH;
	static char buf_basic[DEFAULT_WIDTH+1];	/* basic buffer */
	static char *buf = buf_basic;
	int space;		/* space remaining in buf */
	int len;
	char *bufp;
	int proc;		/* if current command is "proc" */
	int arg_index;

	if (buf_width > buf_width_max) {
		if (buf && (buf != buf_basic)) ckfree(buf);
		buf = (char *)ckalloc(buf_width + 1);
		buf_width_max = buf_width;
	}

	proc = (0 == strcmp("proc",argv[0]));
	sprintf(buf,"%.*s",buf_width,argv[0]);
	len = strlen(buf);
	space = buf_width - len;
	bufp = buf + len;
	argc--; argv++;
	arg_index = 1;
	
	while (argc && (space > 0)) {
		CONST char *elementPtr;
		CONST char *nextPtr;
		int wrap;

		/* braces/quotes have been stripped off arguments */
		/* so put them back.  We wrap everything except lists */
		/* with one argument.  One exception is to always wrap */
		/* proc's 2nd arg (the arg list), since people are */
		/* used to always seeing it this way. */

		if (proc && (arg_index > 1)) wrap = TRUE;
		else {
			(void) TclFindElement(interp,*argv,
#if TCL_MAJOR_VERSION >= 8
					      -1,
#endif
				&elementPtr,&nextPtr,(int *)0,(int *)0);
			if (*elementPtr == '\0') wrap = TRUE;
			else if (*nextPtr == '\0') wrap = FALSE;
			else wrap = TRUE;
		}

		/* wrap lists (or null) in braces */
		if (wrap) {
			sprintf(bufp," {%.*s}",space-3,*argv);
		} else {
			sprintf(bufp," %.*s",space-1,*argv);
		}
		len = strlen(buf);
		space = buf_width - len;
		bufp = buf + len;
		argc--; argv++;
		arg_index++;
	}

	if (compress) {
		/* this copies from our static buf to printify's static buf */
		/* and back to our static buf */
		strncpy(buf,printify(buf),buf_width);
	}

	/* usually but not always right, but assume truncation if buffer is */
	/* full.  this avoids tiny but odd-looking problem of appending "}" */
	/* to truncated lists during {}-wrapping earlier */
	if (strlen(buf) == buf_width) {
		buf[buf_width-1] = buf[buf_width-2] = buf[buf_width-3] = '.';
	}

	return(buf);
}

#if TCL_MAJOR_VERSION >= 8
static
char *
print_objv(interp,objc,objv)
Tcl_Interp *interp;
int objc;
Tcl_Obj *objv[];
{
    char **argv;
    int argc;
    int len;
    argv = (char **)ckalloc(objc+1 * sizeof(char *));
    for (argc=0 ; argc<objc ; argc++) {
	argv[argc] = Tcl_GetStringFromObj(objv[argc],&len);
    }
    argv[argc] = NULL;
    return(print_argv(interp,argc,argv));
}
#endif

static
void
PrintStackBelow(interp,curf,viewf)
Tcl_Interp *interp;
CallFrame *curf;	/* current FramePtr */
CallFrame *viewf;	/* view FramePtr */
{
	char ptr;	/* graphically indicate where we are in the stack */

	/* indicate where we are in the stack */
	ptr = ((curf == viewf)?'*':' ');

	if (curf == 0) {
		print(interp,"%c0: %s\n",
				ptr,print_argv(interp,main_argc,main_argv));
	} else {
		PrintStackBelow(interp,curf->callerVarPtr,viewf);
		print(interp,"%c%d: %s\n",ptr,curf->level,
#if TCL_MAJOR_VERSION >= 8
			print_objv(interp,curf->objc,curf->objv));
#else
			print_argv(interp,curf->argc,curf->argv));
#endif
	}
}

static
void
PrintStack(interp,curf,viewf,argc,argv,level)
Tcl_Interp *interp;
CallFrame *curf;	/* current FramePtr */
CallFrame *viewf;	/* view FramePtr */
int argc;
char *argv[];
char *level;
{
	PrintStackBelow(interp,curf,viewf);
	
	print(interp," %s: %s\n",level,print_argv(interp,argc,argv));
}

/* return 0 if goal matches current frame or goal can't be found */
/*	anywere in frame stack */
/* else return 1 */
/* This catches things like a proc called from a Tcl_Eval which in */
/* turn was not called from a proc but some builtin such as source */
/* or Tcl_Eval.  These builtin calls to Tcl_Eval lose any knowledge */
/* the FramePtr from the proc, so we have to search the entire */
/* stack frame to see if it's still there. */
static int
GoalFrame(goal,iptr)
CallFrame *goal;
Interp *iptr;
{
	CallFrame *cf = iptr->varFramePtr;

	/* if at current level, return success immediately */
	if (goal == cf) return 0;

	while (cf) {
		cf = cf->callerVarPtr;
		if (goal == cf) {
			/* found, but since it's above us, fail */
			return 1;
		}
	}
	return 0;
}

static char *cmd_print(cmdtype)
enum debug_cmd cmdtype;
{
	switch (cmdtype) {
	case none:  return "cmd: none";
	case step:  return "cmd: step";
	case next:  return "cmd: next";
	case ret:   return "cmd: ret";
	case cont:  return "cmd: cont";
	case up:    return "cmd: up";
	case down:  return "cmd: down";
	case where: return "cmd: where";
	case Next:  return "cmd: Next";
	}
	return "cmd: Unknown";
}

/* debugger's trace handler */
/*ARGSUSED*/
static void
debugger_trap(clientData,interp,level,command,cmdProc,cmdClientData,argc,argv)
ClientData clientData;		/* not used */
Tcl_Interp *interp;
int level;			/* positive number if called by Tcl, -1 if */
				/* called by Dbg_On in which case we don't */
				/* know the level */
char *command;
int (*cmdProc)();		/* not used */
ClientData cmdClientData;
int argc;
char *argv[];
{
	char level_text[6];	/* textual representation of level */

	int break_status;
	Interp *iPtr = (Interp *)interp;

	CallFrame *trueFramePtr;	/* where the pc is */
	CallFrame *viewFramePtr;	/* where up/down are */

	int print_command_first_time = TRUE;
	static int debug_suspended = FALSE;

	struct breakpoint *b;

	/* skip commands that are invoked interactively */
	if (debug_suspended) return;

	/* skip debugger commands */
	if (argv[0][1] == '\0') {
		switch (argv[0][0]) {
		case 'n':
		case 's':
		case 'c':
		case 'r':
		case 'w':
		case 'b':
		case 'u':
		case 'd': return;
		}
	}

	if ((*ignoreproc)(interp,argv[0])) return;

	/* if level is unknown, use "?" */
	sprintf(level_text,(level == -1)?"?":"%d",level);

	/* save so we can restore later */
	trueFramePtr = iPtr->varFramePtr;

	/* do not allow breaking while testing breakpoints */
	debug_suspended = TRUE;

	/* test all breakpoints to see if we should break */
	/* if any successful breakpoints, start interactor */
	debug_new_action = FALSE;	/* reset strobe */
	break_status = FALSE;		/* no successful breakpoints yet */
	for (b = break_base;b;b=b->next) {
		break_status |= breakpoint_test(interp,command,b);
	}
	if (break_status) {
		if (!debug_new_action) {
			goto start_interact;
		}

		/* if s or n triggered by breakpoint, make "s 1" */
		/* (and so on) refer to next command, not this one */
		/* step_count++;*/
		goto end_interact;
	}

	switch (debug_cmd) {
	case cont:
		goto finish;
	case step:
		step_count--;
		if (step_count > 0) goto finish;
		goto start_interact;
	case next:
		/* check if we are back at the same level where the next */
		/* command was issued.  Also test */
		/* against all FramePtrs and if no match, assume that */
		/* we've missed a return, and so we should break  */
/*		if (goalFramePtr != iPtr->varFramePtr) goto finish;*/
		if (GoalFrame(goalFramePtr,iPtr)) goto finish;
		step_count--;
		if (step_count > 0) goto finish;
		goto start_interact;
	case Next:
		/* check if we are back at the same level where the next */
		/* command was issued.  */
		if (goalNumLevel < iPtr->numLevels) goto finish;
		step_count--;
		if (step_count > 0) goto finish;
		goto start_interact;
	case ret:
		/* same comment as in "case next" */
		if (goalFramePtr != iPtr->varFramePtr) goto finish;
		goto start_interact;
	}

start_interact:
	if (print_command_first_time) {
		print(interp,"%s: %s\n",
				level_text,print_argv(interp,1,&command));
		print_command_first_time = FALSE;
	}
	/* since user is typing a command, don't interrupt it immediately */
	debug_cmd = cont;
	debug_suspended = TRUE;

	/* interactor won't return until user gives a debugger cmd */
	(*interactor)(interp,interdata);
end_interact:

	/* save this so it can be restored after "w" command */
	viewFramePtr = iPtr->varFramePtr;

	if (debug_cmd == up || debug_cmd == down) {
		/* calculate new frame */
		if (-1 == TclGetFrame2(interp,trueFramePtr,viewFrameName,
					&iPtr->varFramePtr,debug_cmd)) {
			print(interp,"%s\n",interp->result);
			Tcl_ResetResult(interp);
		}
		goto start_interact;
	}

	/* reset view back to normal */
	iPtr->varFramePtr = trueFramePtr;

#if 0
	/* allow trapping */
	debug_suspended = FALSE;
#endif

	switch (debug_cmd) {
	case cont:
	case step:
		goto finish;
	case next:
		goalFramePtr = iPtr->varFramePtr;
		goto finish;
	case Next:
		goalNumLevel = iPtr->numLevels;
		goto finish;
	case ret:
		goalFramePtr = iPtr->varFramePtr;
		if (goalFramePtr == 0) {
			print(interp,"nowhere to return to\n");
			break;
		}
		goalFramePtr = goalFramePtr->callerVarPtr;
		goto finish;
	case where:
		PrintStack(interp,iPtr->varFramePtr,viewFramePtr,argc,argv,level_text);
		break;
	}

	/* restore view and restart interactor */
	iPtr->varFramePtr = viewFramePtr;
	goto start_interact;

 finish:
	debug_suspended = FALSE;
}

/*ARGSUSED*/
static
int
cmdNext(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
	debug_new_action = TRUE;
	debug_cmd = *(enum debug_cmd *)clientData;

	last_action_cmd = debug_cmd;

	step_count = (argc == 1)?1:atoi(argv[1]);
	last_step_count = step_count;
	return(TCL_RETURN);
}

/*ARGSUSED*/
static
int
cmdDir(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
	debug_cmd = *(enum debug_cmd *)clientData;

	if (argc == 1) argv[1] = "1";
	strncpy(viewFrameName,argv[1],FRAMENAMELEN);

	return TCL_RETURN;
}

/*ARGSUSED*/
static
int
cmdSimple(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
	debug_new_action = TRUE;
	debug_cmd = *(enum debug_cmd *)clientData;
	last_action_cmd = debug_cmd;

	return TCL_RETURN;
}

static
void
breakpoint_destroy(b)
struct breakpoint *b;
{
	if (b->file) Tcl_DecrRefCount(b->file);
	if (b->pat) Tcl_DecrRefCount(b->pat);
	if (b->cmd) Tcl_DecrRefCount(b->cmd);
	if (b->expr) Tcl_DecrRefCount(b->expr);

	/* unlink from chain */
	if ((b->previous == 0) && (b->next == 0)) {
		break_base = 0;
	} else if (b->previous == 0) {
		break_base = b->next;
		b->next->previous = 0;
	} else if (b->next == 0) {
		b->previous->next = 0;
	} else {
		b->previous->next = b->next;
		b->next->previous = b->previous;
	}

	ckfree((char *)b);
}

static void
savestr(objPtr,str)
Tcl_Obj **objPtr;
char *str;
{
    *objPtr = Tcl_NewStringObj(str, -1);
    Tcl_IncrRefCount(*objPtr);
}

/* return 1 if a string is substring of a flag */
static int
flageq(flag,string,minlen)
char *flag;
char *string;
int minlen;		/* at least this many chars must match */
{
	for (;*flag;flag++,string++,minlen--) {
		if (*string == '\0') break;
		if (*string != *flag) return 0;
	}
	if (*string == '\0' && minlen <= 0) return 1;
	return 0;
}

/*ARGSUSED*/
static
int
cmdWhere(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
	if (argc == 1) {
		debug_cmd = where;
		return TCL_RETURN;
	}

	argc--; argv++;

	while (argc) {
		if (flageq("-width",*argv,2)) {
			argc--; argv++;
			if (*argv) {
				buf_width = atoi(*argv);
				argc--; argv++;
			} else print(interp,"%d\n",buf_width);
		} else if (flageq("-compress",*argv,2)) {
			argc--; argv++;
			if (*argv) {
				compress = atoi(*argv);
				argc--; argv++;
			} else print(interp,"%d\n",compress);
		} else {
			print(interp,"usage: w [-width #] [-compress 0|1]\n");
			return TCL_ERROR;
		}
	}
	return TCL_OK;
}

#define breakpoint_fail(msg) {error_msg = msg; goto break_fail;}

/*ARGSUSED*/
static
int
cmdBreak(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
	struct breakpoint *b;
	char *error_msg;

	argc--; argv++;

	if (argc < 1) {
		for (b = break_base;b;b=b->next) breakpoint_print(interp,b);
		return(TCL_OK);
	}

	if (argv[0][0] == '-') {
		if (argv[0][1] == '\0') {
			while (break_base) {
				breakpoint_destroy(break_base);
			}
			breakpoint_max_id = 0;
			return(TCL_OK);
		} else if (isdigit(argv[0][1])) {
			int id = atoi(argv[0]+1);

			for (b = break_base;b;b=b->next) {
				if (b->id == id) {
					breakpoint_destroy(b);
					if (!break_base) breakpoint_max_id = 0;
					return(TCL_OK);
				}
			}
			Tcl_SetResult(interp,"no such breakpoint",TCL_STATIC);
			return(TCL_ERROR);
		}
	}

	b = breakpoint_new();

	if (flageq("-regexp",argv[0],2)) {
		argc--; argv++;
		if (argc > 0) {
		    b->re = 1;
		    savestr(&b->pat,argv[0]);
		    if (Tcl_GetRegExpFromObj(interp, b->pat, TCL_REG_ADVANCED)
			    == NULL) {
			breakpoint_destroy(b);
			return TCL_ERROR;
		    }
		    argc--; argv++;
		} else {
			breakpoint_fail("bad regular expression")
		}
	} else if (flageq("-glob",argv[0],2)) {
		argc--; argv++;
		if (argc > 0) {
			savestr(&b->pat,argv[0]);
			argc--; argv++;
		} else {
			breakpoint_fail("no pattern?");
		}
	} else if ((!(flageq("if",*argv,1)) && (!(flageq("then",*argv,1))))) {
		/* look for [file:]line */
		char *colon;
		char *linep;	/* pointer to beginning of line number */

		colon = strchr(argv[0],':');
		if (colon) {
			*colon = '\0';
			savestr(&b->file,argv[0]);
			*colon = ':';
			linep = colon + 1;
		} else {
			linep = argv[0];
			/* get file from current scope */
			/* savestr(&b->file, ?); */
		}

		if (TCL_OK == Tcl_GetInt(interp,linep,&b->line)) {
			argc--; argv++;
			print(interp,"setting breakpoints by line number is currently unimplemented - use patterns or expressions\n");
		} else {
			/* not an int? - unwind & assume it is an expression */

			if (b->file) Tcl_DecrRefCount(b->file);
		}
	}

	if (argc > 0) {
		int do_if = FALSE;

		if (flageq("if",argv[0],1)) {
			argc--; argv++;
			do_if = TRUE;
		} else if (!flageq("then",argv[0],1)) {
			do_if = TRUE;
		}

		if (do_if) {
			if (argc < 1) {
				breakpoint_fail("if what");
			}

			savestr(&b->expr,argv[0]);
			argc--; argv++;
		}
	}

	if (argc > 0) {
		if (flageq("then",argv[0],1)) {
			argc--; argv++;
		}

		if (argc < 1) {
			breakpoint_fail("then what?");
		}

		savestr(&b->cmd,argv[0]);
	}

	sprintf(interp->result,"%d",b->id);
	return(TCL_OK);

 break_fail:
	breakpoint_destroy(b);
	Tcl_SetResult(interp,error_msg,TCL_STATIC);
	return(TCL_ERROR);
}

static char *help[] = {
"s [#]		step into procedure",
"n [#]		step over procedure",
"N [#]		step over procedures, commands, and arguments",
"c		continue",
"r		continue until return to caller",
"u [#]		move scope up level",
"d [#]		move scope down level",
"		go to absolute frame if # is prefaced by \"#\"",
"w		show stack (\"where\")",
"w -w [#]	show/set width",
"w -c [0|1]	show/set compress",
"b		show breakpoints",
"b [-r regexp-pattern] [if expr] [then command]",
"b [-g glob-pattern]   [if expr] [then command]",
"b [[file:]#]          [if expr] [then command]",
"		if pattern given, break if command resembles pattern",
"		if # given, break on line #",
"		if expr given, break if expr true",
"		if command given, execute command at breakpoint",
"b -#		delete breakpoint",
"b -		delete all breakpoints",
0};

/*ARGSUSED*/
static
int
cmdHelp(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
	char **hp;

	for (hp=help;*hp;hp++) {
		print(interp,"%s\n",*hp);
	}

	return(TCL_OK);
}

/* occasionally, we print things larger buf_max but not by much */
/* see print statements in PrintStack routines for examples */
#define PAD 80

/*VARARGS*/
static void
print TCL_VARARGS_DEF(Tcl_Interp *,arg1)
{
	Tcl_Interp *interp;
	char *fmt;
	va_list args;

	interp = TCL_VARARGS_START(Tcl_Interp *,arg1,args);
	fmt = va_arg(args,char *);
	if (!printproc) vprintf(fmt,args);
	else {
		static int buf_width_max = DEFAULT_WIDTH+PAD;
		static char buf_basic[DEFAULT_WIDTH+PAD+1];
		static char *buf = buf_basic;

		if (buf_width+PAD > buf_width_max) {
			if (buf && (buf != buf_basic)) ckfree(buf);
			buf = (char *)ckalloc(buf_width+PAD+1);
			buf_width_max = buf_width+PAD;
		}

		vsprintf(buf,fmt,args);
		(*printproc)(interp,buf,printdata);
	}
	va_end(args);
}

/*ARGSUSED*/
Dbg_InterStruct
Dbg_Interactor(interp,inter_proc,data)
Tcl_Interp *interp;
Dbg_InterProc *inter_proc;
ClientData data;
{
	Dbg_InterStruct tmp;

	tmp.func = interactor;
	tmp.data = interdata;
	interactor = (inter_proc?inter_proc:simple_interactor);
	interdata = data;
	return tmp;
}

/*ARGSUSED*/
Dbg_IgnoreFuncsProc *
Dbg_IgnoreFuncs(interp,proc)
Tcl_Interp *interp;
Dbg_IgnoreFuncsProc *proc;
{
	Dbg_IgnoreFuncsProc *tmp = ignoreproc;
	ignoreproc = (proc?proc:zero);
	return tmp;
}

/*ARGSUSED*/
Dbg_OutputStruct
Dbg_Output(interp,proc,data)
Tcl_Interp *interp;
Dbg_OutputProc *proc;
ClientData data;
{
	Dbg_OutputStruct tmp;

	tmp.func = printproc;
	tmp.data = printdata;
	printproc = proc;
	printdata = data;
	return tmp;
}

/*ARGSUSED*/
int
Dbg_Active(interp)
Tcl_Interp *interp;
{
	return debugger_active;
}

char **
Dbg_ArgcArgv(argc,argv,copy)
int argc;
char *argv[];
int copy;
{
	char **alloc;

	main_argc = argc;

	if (!copy) {
		main_argv = argv;
		alloc = 0;
	} else {
		main_argv = alloc = (char **)ckalloc((argc+1)*sizeof(char *));
		while (argc-- >= 0) {
			*main_argv++ = *argv++;
		}
		main_argv = alloc;
	}
	return alloc;
}

static struct cmd_list {
	char *cmdname;
	Tcl_CmdProc *cmdproc;
	enum debug_cmd cmdtype;
} cmd_list[]  = {
		{"n", cmdNext,   next},
		{"s", cmdNext,   step},
		{"N", cmdNext,   Next},
		{"c", cmdSimple, cont},
		{"r", cmdSimple, ret},
		{"w", cmdWhere,  none},
		{"b", cmdBreak,  none},
		{"u", cmdDir,    up},
		{"d", cmdDir,    down},
		{"h", cmdHelp,   none},
		{0}
};

/* this may seem excessive, but this avoids the explicit test for non-zero */
/* in the caller, and chances are that that test will always be pointless */
/*ARGSUSED*/
static int zero(interp,string)
Tcl_Interp *interp;
char *string;
{
	return 0;
}

static int
simple_interactor(interp)
Tcl_Interp *interp;
{
	int rc;
	char *ccmd;		/* pointer to complete command */
	char line[BUFSIZ+1];	/* space for partial command */
	int newcmd = TRUE;
	Interp *iPtr = (Interp *)interp;

	Tcl_DString dstring;
	Tcl_DStringInit(&dstring);

	newcmd = TRUE;
	while (TRUE) {
		struct cmd_list *c;

		if (newcmd) {
#if TCL_MAJOR_VERSION < 8
			print(interp,"dbg%d.%d> ",iPtr->numLevels,iPtr->curEventNum+1);
#else
			/* unncessarily tricky coding - if nextid
			   isn't defined, maintain our own static
			   version */

			static int nextid = 0;
			char *nextidstr = Tcl_GetVar2(interp,"tcl::history","nextid",0);
			if (nextidstr) {
				sscanf(nextidstr,"%d",&nextid);
			}
			print(interp,"dbg%d.%d> ",iPtr->numLevels,nextid++);
#endif
		} else {
			print(interp,"dbg+> ");
		}
		fflush(stdout);

		if (0 >= (rc = read(0,line,BUFSIZ))) {
			if (!newcmd) line[0] = 0;
			else exit(0);
		} else line[rc] = '\0';

		ccmd = Tcl_DStringAppend(&dstring,line,rc);
		if (!Tcl_CommandComplete(ccmd)) {
			newcmd = FALSE;
			continue;	/* continue collecting command */
		}
		newcmd = TRUE;

		/* if user pressed return with no cmd, use previous one */
		if ((ccmd[0] == '\n' || ccmd[0] == '\r') && ccmd[1] == '\0') {

			/* this loop is guaranteed to exit through break */
			for (c = cmd_list;c->cmdname;c++) {
				if (c->cmdtype == last_action_cmd) break;
			}

			/* recreate textual version of command */
			Tcl_DStringAppend(&dstring,c->cmdname,-1);

			if (c->cmdtype == step ||
			    c->cmdtype == next ||
			    c->cmdtype == Next) {
				char num[10];

				sprintf(num," %d",last_step_count);
				Tcl_DStringAppend(&dstring,num,-1);
			}
		}

#if TCL_MAJOR_VERSION == 7 && TCL_MINOR_VERSION < 4
		rc = Tcl_RecordAndEval(interp,ccmd,0);
#else
		rc = Tcl_RecordAndEval(interp,ccmd,TCL_NO_EVAL);
		rc = Tcl_Eval(interp,ccmd);
#endif
		Tcl_DStringFree(&dstring);

		switch (rc) {
		case TCL_OK:
			if (*interp->result != 0)
				print(interp,"%s\n",interp->result);
			continue;
		case TCL_ERROR:
			print(interp,"%s\n",Tcl_GetVar(interp,"errorInfo",TCL_GLOBAL_ONLY));
			/* since user is typing by hand, we expect lots
			   of errors, and want to give another chance */
			continue;
		case TCL_BREAK:
		case TCL_CONTINUE:
#define finish(x)	{rc = x; goto done;}
			finish(rc);
		case TCL_RETURN:
			finish(TCL_OK);
		default:
			/* note that ccmd has trailing newline */
			print(interp,"error %d: %s\n",rc,ccmd);
			continue;
		}
	}
	/* cannot fall thru here, must jump to label */
 done:
	Tcl_DStringFree(&dstring);

	return(rc);
}

static char init_auto_path[] = "lappend auto_path $dbg_library";

static void
init_debugger(interp)
Tcl_Interp *interp;
{
	struct cmd_list *c;

	for (c = cmd_list;c->cmdname;c++) {
		Tcl_CreateCommand(interp,c->cmdname,c->cmdproc,
			(ClientData)&c->cmdtype,(Tcl_CmdDeleteProc *)0);
	}

	debug_handle = Tcl_CreateTrace(interp,
				10000,debugger_trap,(ClientData)0);

	debugger_active = TRUE;
	Tcl_SetVar2(interp,Dbg_VarName,"active","1",0);
#ifdef DBG_SCRIPTDIR
	Tcl_SetVar(interp,"dbg_library",DBG_SCRIPTDIR,0);
#endif
	Tcl_Eval(interp,init_auto_path);

}

/* allows any other part of the application to jump to the debugger */
/*ARGSUSED*/
void
Dbg_On(interp,immediate)
Tcl_Interp *interp;
int immediate;		/* if true, stop immediately */
			/* should only be used in safe places */
			/* i.e., when Tcl_Eval can be called */
{
	if (!debugger_active) init_debugger(interp);

	/* Initialize debugger in single-step mode.
	 *
	 * Note: if the command reader is already active, it's too late
	 * which is why we also statically initialize debug_cmd to step.
	 */
	debug_cmd = step; 
	step_count = 1;

	if (immediate) {
		static char *fake_cmd = "--interrupted-- (command_unknown)";

		debugger_trap((ClientData)0,interp,-1,fake_cmd,(int (*)())0,
					(ClientData)0,1,&fake_cmd);
/*		(*interactor)(interp);*/
	}
}

void
Dbg_Off(interp)
Tcl_Interp *interp;
{
	struct cmd_list *c;

	if (!debugger_active) return;

	for (c = cmd_list;c->cmdname;c++) {
		Tcl_DeleteCommand(interp,c->cmdname);
	}

	Tcl_DeleteTrace(interp,debug_handle);
	debugger_active = FALSE;
	Tcl_UnsetVar(interp,Dbg_VarName,TCL_GLOBAL_ONLY);

	/* initialize for next use */
	debug_cmd = step;
	step_count = 1;
}






Deleted expTcl.c.








Deleted expTcl.h.








Deleted exp_chan.c.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557















































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

/* 
 * tclUnixChan.c
 *
 *	Channel driver for Expect channels.
 *      Based on UNIX File channel from TclUnixChan.c
 *
 */

#include <sys/types.h>
#include <stdio.h>
#include <signal.h>
#include <errno.h>
#include <ctype.h>	/* for isspace */
#include <time.h>	/* for time(3) */

#include "expect_cf.h"

#ifdef HAVE_SYS_WAIT_H
#include <sys/wait.h>
#endif

#ifdef HAVE_UNISTD_H
# include <unistd.h>
#endif

#include	"tclInt.h"	/* Internal definitions for Tcl. */

#include "tcl.h"

#include "string.h"

#include "exp_rename.h"
#include "exp_prog.h"
#include "exp_command.h"
#include "exp_log.h"

static int		ExpCloseProc _ANSI_ARGS_((ClientData instanceData,
			    Tcl_Interp *interp));
static int		ExpInputProc _ANSI_ARGS_((ClientData instanceData,
		            char *buf, int toRead, int *errorCode));
static int		ExpOutputProc _ANSI_ARGS_((
			    ClientData instanceData, char *buf, int toWrite,
                            int *errorCode));
static void		ExpWatchProc _ANSI_ARGS_((ClientData instanceData,
		            int mask));
static int		ExpGetHandleProc _ANSI_ARGS_((ClientData instanceData,
		            int direction, ClientData *handlePtr));

/*
 * This structure describes the channel type structure for Expect-based IO:
 */

Tcl_ChannelType expChannelType = {
    "exp",				/* Type name. */
    /* Expect channels are always blocking */
    NULL,				/* Set blocking/nonblocking mode.*/
    ExpCloseProc,			/* Close proc. */
    ExpInputProc,			/* Input proc. */
    ExpOutputProc,			/* Output proc. */
    NULL,				/* Seek proc. */
    NULL,				/* Set option proc. */
    NULL,				/* Get option proc. */
    ExpWatchProc,			/* Initialize notifier. */
    ExpGetHandleProc,			/* Get OS handles out of channel. */
    NULL,				/* Close2 proc */
};

typedef struct ThreadSpecificData {
    /*
     * List of all exp channels currently open.  This is per thread and is
     * used to match up fd's to channels, which rarely occurs.
     */
    
    ExpState *firstExpPtr;
    int channelCount;	 /* this is process-wide as it is used to
			     give user some hint as to why a spawn has failed
			     by looking at process-wide resource usage */
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;


/*
 *----------------------------------------------------------------------
 *
 * ExpInputProc --
 *
 *	This procedure is invoked from the generic IO level to read
 *	input from an exp-based channel.
 *
 * Results:
 *	The number of bytes read is returned or -1 on error. An output
 *	argument contains a POSIX error code if an error occurs, or zero.
 *
 * Side effects:
 *	Reads input from the input device of the channel.
 *
 *----------------------------------------------------------------------
 */

static int
ExpInputProc(instanceData, buf, toRead, errorCodePtr)
    ClientData instanceData;		/* Exp state. */
    char *buf;				/* Where to store data read. */
    int toRead;				/* How much space is available
                                         * in the buffer? */
    int *errorCodePtr;			/* Where to store error code. */
{
    ExpState *esPtr = (ExpState *) instanceData;
    int bytesRead;			/* How many bytes were actually
                                         * read from the input device? */

    *errorCodePtr = 0;
    
    /*
     * Assume there is always enough input available. This will block
     * appropriately, and read will unblock as soon as a short read is
     * possible, if the channel is in blocking mode. If the channel is
     * nonblocking, the read will never block.
     */

    bytesRead = read(esPtr->fdin, buf, (size_t) toRead);
    /*printf("ExpInputProc: read(%d,,) = %d\r\n",esPtr->fdin,bytesRead);*/
    if (bytesRead > -1) {
	/* strip parity if requested */
	if (esPtr->parity == 0) {
	    char *end = buf+bytesRead;
	    for (;buf < end;buf++) {
		*buf &= 0x7f;
	    }
	}
        return bytesRead;
    }
    *errorCodePtr = errno;
    return -1;
}

/*
 *----------------------------------------------------------------------
 *
 * ExpOutputProc--
 *
 *	This procedure is invoked from the generic IO level to write
 *	output to an exp channel.
 *
 * Results:
 *	The number of bytes written is returned or -1 on error. An
 *	output argument	contains a POSIX error code if an error occurred,
 *	or zero.
 *
 * Side effects:
 *	Writes output on the output device of the channel.
 *
 *----------------------------------------------------------------------
 */

static int
ExpOutputProc(instanceData, buf, toWrite, errorCodePtr)
    ClientData instanceData;		/* Exp state. */
    char *buf;				/* The data buffer. */
    int toWrite;			/* How many bytes to write? */
    int *errorCodePtr;			/* Where to store error code. */
{
    ExpState *esPtr = (ExpState *) instanceData;
    int written = 0;

    *errorCodePtr = 0;

    if (toWrite < 0) Tcl_Panic("ExpOutputProc: called with negative char count");

    while (toWrite > 0) {
	written = write(esPtr->fdout, buf, (size_t) toWrite);
	if (written == 0) {
	    /* This shouldn't happen but I'm told that it does
	     * nonetheless (at least on SunOS 4.1.3).  Since this is
	     * not a documented return value, the most reasonable
	     * thing is to complain here and retry in the hopes that
	     * it is some transient condition.  */
	    sleep(1);
	    expDiagLogU("write() failed to write anything - will sleep(1) and retry...\n");
	} else if (written < 0) {
	    *errorCodePtr = errno;
	    return -1;
	}
	buf += written;
	toWrite -= written;
    }
    return written;
}

/*
 *----------------------------------------------------------------------
 *
 * ExpCloseProc --
 *
 *	This procedure is called from the generic IO level to perform
 *	channel-type-specific cleanup when an exp-based channel is closed.
 *
 * Results:
 *	0 if successful, errno if failed.
 *
 * Side effects:
 *	Closes the device of the channel.
 *
 *----------------------------------------------------------------------
 */

/*ARGSUSED*/
static int
ExpCloseProc(instanceData, interp)
    ClientData instanceData;	/* Exp state. */
    Tcl_Interp *interp;		/* For error reporting - unused. */
{
    ExpState *esPtr = (ExpState *) instanceData;
    ExpState **nextPtrPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    esPtr->registered = FALSE;

#if 0
    /*
      Really should check that we created one first.  Since we're sharing fds
      with Tcl, perhaps a filehandler was created with a plain tcl file - we
      wouldn't want to delete that.  Although if user really close Expect's
      user_spawn_id, it probably doesn't matter anyway.
    */

    Tcl_DeleteFileHandler(esPtr->fdin);
#endif /*0*/

    Tcl_DecrRefCount(esPtr->buffer);

    /* Actually file descriptor should have been closed earlier. */
    /* So do nothing here */

    /*
     * Conceivably, the process may not yet have been waited for.  If this
     * becomes a requirement, we'll have to revisit this code.  But for now, if
     * it's just Tcl exiting, the processes will exit on their own soon
     * anyway.
     */

    for (nextPtrPtr = &(tsdPtr->firstExpPtr); (*nextPtrPtr) != NULL;
	 nextPtrPtr = &((*nextPtrPtr)->nextPtr)) {
	if ((*nextPtrPtr) == esPtr) {
	    (*nextPtrPtr) = esPtr->nextPtr;
	    break;
	}
    }
    tsdPtr->channelCount--;

    if (esPtr->bg_status == blocked ||
	    esPtr->bg_status == disarm_req_while_blocked) {
	esPtr->freeWhenBgHandlerUnblocked = 1;
	/*
	 * If we're in the middle of a bg event handler, then the event
	 * handler will have to take care of freeing esPtr.
	 */
    } else {
	expStateFree(esPtr);
    }
    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * ExpWatchProc --
 *
 *	Initialize the notifier to watch the fd from this channel.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Sets up the notifier so that a future event on the channel will
 *	be seen by Tcl.
 *
 *----------------------------------------------------------------------
 */

static void
ExpWatchProc(instanceData, mask)
    ClientData instanceData;		/* The exp state. */
    int mask;				/* Events of interest; an OR-ed
                                         * combination of TCL_READABLE,
                                         * TCL_WRITABLE and TCL_EXCEPTION. */
{
    ExpState *esPtr = (ExpState *) instanceData;

    /*
     * Make sure we only register for events that are valid on this exp.
     * Note that we are passing Tcl_NotifyChannel directly to
     * Tcl_CreateExpHandler with the channel pointer as the client data.
     */

    mask &= esPtr->validMask;
    if (mask) {
	/*printf("  CreateFileHandler: %d (mask = %d)\r\n",esPtr->fdin,mask);*/
	Tcl_CreateFileHandler(esPtr->fdin, mask,
		(Tcl_FileProc *) Tcl_NotifyChannel,
		(ClientData) esPtr->channel);
    } else {
	/*printf("  DeleteFileHandler: %d (mask = %d)\r\n",esPtr->fdin,mask);*/
	Tcl_DeleteFileHandler(esPtr->fdin);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * ExpGetHandleProc --
 *
 *	Called from Tcl_GetChannelHandle to retrieve OS handles from
 *	an exp-based channel.
 *
 * Results:
 *	Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if
 *	there is no handle for the specified direction. 
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
ExpGetHandleProc(instanceData, direction, handlePtr)
    ClientData instanceData;	/* The exp state. */
    int direction;		/* TCL_READABLE or TCL_WRITABLE */
    ClientData *handlePtr;	/* Where to store the handle.  */
{
    ExpState *esPtr = (ExpState *) instanceData;

    if (direction & TCL_WRITABLE) {
	*handlePtr = (ClientData) esPtr->fdin;
    }
    if (direction & TCL_READABLE) {
	*handlePtr = (ClientData) esPtr->fdin;
    } else {
	return TCL_ERROR;
    }
    return TCL_OK;
}

int
expChannelCountGet()
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    return tsdPtr->channelCount;
}

int
expSizeGet(esPtr)
    ExpState *esPtr;
{
    int len;
    Tcl_GetStringFromObj(esPtr->buffer,&len);
    return len;
}

int
expSizeZero(esPtr)
    ExpState *esPtr;
{
    int len;
    Tcl_GetStringFromObj(esPtr->buffer,&len);
    return (len == 0);
}

void
expStateFree(esPtr)
    ExpState *esPtr;
{
  if (esPtr->fdBusy) {
    close(esPtr->fdin);
  }

    esPtr->valid = FALSE;
    
    if (!esPtr->keepForever) {
	ckfree((char *)esPtr);
    }
}

/* close all connections
 * 
 * The kernel would actually do this by default, however Tcl is going to come
 * along later and try to reap its exec'd processes.  If we have inherited any
 * via spawn -open, Tcl can hang if we don't close the connections first.
 */
void
exp_close_all(interp)
Tcl_Interp *interp;
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    ExpState *esPtr;

    /* no need to keep things in sync (i.e., tsdPtr, count) since we could only
       be doing this if we're exiting.  Just close everything down. */

    for (esPtr = tsdPtr->firstExpPtr;esPtr;esPtr = esPtr->nextPtr) {
	exp_close(interp,esPtr);
    }
}

/* wait for any of our own spawned processes we call waitpid rather
 * than wait to avoid running into someone else's processes.  Yes,
 * according to Ousterhout this is the best way to do it.
 * returns the ExpState or 0 if nothing to wait on */
ExpState *
expWaitOnAny()
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    int result;
    ExpState *esPtr;

    for (esPtr = tsdPtr->firstExpPtr;esPtr;esPtr = esPtr->nextPtr) {
	if (esPtr->pid == exp_getpid) continue; /* skip ourself */
	if (esPtr->user_waited) continue;	/* one wait only! */
	if (esPtr->sys_waited) break;
      restart:
	result = waitpid(esPtr->pid,&esPtr->wait,WNOHANG);
	if (result == esPtr->pid) break;
	if (result == 0) continue;	/* busy, try next */
	if (result == -1) {
	    if (errno == EINTR) goto restart;
	    else break;
	}
    }
    return esPtr;
}

ExpState *
expWaitOnOne() {
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    ExpState *esPtr;
    int pid;
    /* should really be recoded using the common wait code in command.c */
    WAIT_STATUS_TYPE status;

    pid = wait(&status);
    for (esPtr = tsdPtr->firstExpPtr;esPtr;esPtr = esPtr->nextPtr) {
	if (esPtr->pid == pid) {
	    esPtr->sys_waited = TRUE;
	    esPtr->wait = status;
	    return esPtr;
	}
    }
}

void
exp_background_channelhandlers_run_all()
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    ExpState *esPtr;

    /* kick off any that already have input waiting */
    for (esPtr = tsdPtr->firstExpPtr;esPtr;esPtr = esPtr->nextPtr) {
	/* is bg_interp the best way to check if armed? */
	if (esPtr->bg_interp && !expSizeZero(esPtr)) {
	    exp_background_channelhandler((ClientData)esPtr,0);
	}
    }
}

ExpState *
expCreateChannel(interp,fdin,fdout,pid)
    Tcl_Interp *interp;
    int fdin;
    int fdout;
    int pid;
{
    ExpState *esPtr;
    int mask;
    Tcl_ChannelType *channelTypePtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    channelTypePtr = &expChannelType;

    esPtr = (ExpState *) ckalloc((unsigned) sizeof(ExpState));

    esPtr->nextPtr = tsdPtr->firstExpPtr;
    tsdPtr->firstExpPtr = esPtr;

    sprintf(esPtr->name,"exp%d",fdin);

    /*
     * For now, stupidly assume this.  We we will likely have to revisit this
     * later to prevent people from doing stupid things.
     */
    mask = TCL_READABLE | TCL_WRITABLE;

    /* not sure about this - what about adopted channels */
    esPtr->validMask = mask | TCL_EXCEPTION;
    esPtr->fdin = fdin;
    esPtr->fdout = fdout;

    /* set close-on-exec for everything but std channels */
    /* (system and stty commands need access to std channels) */
    if (fdin != 0 && fdin != 2) {
      expCloseOnExec(fdin);
      if (fdin != fdout) expCloseOnExec(fdout);
    }

    esPtr->fdBusy = FALSE;
    esPtr->channel = Tcl_CreateChannel(channelTypePtr, esPtr->name,
	    (ClientData) esPtr, mask);
    Tcl_RegisterChannel(interp,esPtr->channel);
    esPtr->registered = TRUE;
    Tcl_SetChannelOption(interp,esPtr->channel,"-buffering","none");
    Tcl_SetChannelOption(interp,esPtr->channel,"-blocking","0");
    Tcl_SetChannelOption(interp,esPtr->channel,"-translation","lf");

    esPtr->pid = pid;
    esPtr->msize = 0;

    /* initialize a dummy buffer */
    esPtr->buffer = Tcl_NewStringObj("",0);
    Tcl_IncrRefCount(esPtr->buffer);
    esPtr->umsize = exp_default_match_max;
    /* this will reallocate object with an appropriate sized buffer */
    expAdjust(esPtr);

    esPtr->printed = 0;
    esPtr->echoed = 0;
    esPtr->rm_nulls = exp_default_rm_nulls;
    esPtr->parity = exp_default_parity;
    esPtr->key = expect_key++;
    esPtr->force_read = FALSE;
    esPtr->fg_armed = FALSE;
    esPtr->channel_orig = 0;
    esPtr->fd_slave = EXP_NOFD;
#ifdef HAVE_PTYTRAP
    esPtr->slave_name = 0;
#endif /* HAVE_PTYTRAP */
    esPtr->open = TRUE;
    esPtr->notified = FALSE;
    esPtr->user_waited = FALSE;
    esPtr->sys_waited = FALSE;
    esPtr->bg_interp = 0;
    esPtr->bg_status = unarmed;
    esPtr->bg_ecount = 0;
    esPtr->freeWhenBgHandlerUnblocked = FALSE;
    esPtr->keepForever = FALSE;
    esPtr->valid = TRUE;
    tsdPtr->channelCount++;

    return esPtr;
}

void
expChannelInit() {
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    tsdPtr->channelCount = 0;
}






Deleted exp_clib.c.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096
3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
3297
3298
3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
3314
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
3325
3326
3327
3328
3329
3330
3331
3332
3333
3334
3335
3336
3337
3338
3339
3340
3341
3342
3343
3344
3345
3346
3347
3348
3349
3350
3351
3352
3353
3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388
3389
3390
3391
3392
3393
3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
3423

































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

/* exp_clib.c - top-level functions in the expect C library, libexpect.a

Written by: Don Libes, [email protected], NIST, 12/3/90

Design and implementation of this program was paid for by U.S. tax
dollars.  Therefore it is public domain.  However, the author and NIST
would appreciate credit if this program or parts of it are used.
*/

#include "expect_cf.h"
#include <stdio.h>
#include <setjmp.h>
#ifdef HAVE_INTTYPES_H
#  include <inttypes.h>
#endif
#include <sys/types.h>
#include <sys/ioctl.h>

#ifdef TIME_WITH_SYS_TIME
# include <sys/time.h>
# include <time.h>
#else
# if HAVE_SYS_TIME_H
#  include <sys/time.h>
# else
#  include <time.h>
# endif
#endif

#ifdef CRAY
# ifndef TCSETCTTY
#  if defined(HAVE_TERMIOS)
#   include <termios.h>
#  else
#   include <termio.h>
#  endif
# endif
#endif

#ifdef HAVE_SYS_FCNTL_H
#  include <sys/fcntl.h>
#else
#  include <fcntl.h>
#endif

#ifdef HAVE_STRREDIR_H
#include <sys/strredir.h>
# ifdef SRIOCSREDIR
#  undef TIOCCONS
# endif
#endif

#include <signal.h>
/*#include <memory.h> - deprecated - ANSI C moves them into string.h */
#include "string.h"

#include <errno.h>

#ifdef NO_STDLIB_H

/*
 * Tcl's compat/stdlib.h
 */

/*
 * stdlib.h --
 *
 *	Declares facilities exported by the "stdlib" portion of
 *	the C library.  This file isn't complete in the ANSI-C
 *	sense;  it only declares things that are needed by Tcl.
 *	This file is needed even on many systems with their own
 *	stdlib.h (e.g. SunOS) because not all stdlib.h files
 *	declare all the procedures needed here (such as strtod).
 *
 * Copyright (c) 1991 The Regents of the University of California.
 * Copyright (c) 1994 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: exp_clib.c,v 5.29 2000/01/06 23:22:02 wart Exp $
 */

#ifndef _STDLIB
#define _STDLIB

#include <tcl.h>

extern void		abort _ANSI_ARGS_((void));
extern double		atof _ANSI_ARGS_((CONST char *string));
extern int		atoi _ANSI_ARGS_((CONST char *string));
extern long		atol _ANSI_ARGS_((CONST char *string));
extern char *		calloc _ANSI_ARGS_((unsigned int numElements,
			    unsigned int size));
extern void		exit _ANSI_ARGS_((int status));
extern int		free _ANSI_ARGS_((char *blockPtr));
extern char *		getenv _ANSI_ARGS_((CONST char *name));
extern char *		malloc _ANSI_ARGS_((unsigned int numBytes));
extern void		qsort _ANSI_ARGS_((VOID *base, int n, int size,
			    int (*compar)(CONST VOID *element1, CONST VOID
			    *element2)));
extern char *		realloc _ANSI_ARGS_((char *ptr, unsigned int numBytes));
extern double		strtod _ANSI_ARGS_((CONST char *string, char **endPtr));
extern long		strtol _ANSI_ARGS_((CONST char *string, char **endPtr,
			    int base));
extern unsigned long	strtoul _ANSI_ARGS_((CONST char *string,
			    char **endPtr, int base));

#endif /* _STDLIB */

/*
 * end of Tcl's compat/stdlib.h
 */

#else
#include <stdlib.h>		/* for malloc */
#endif

#include "expect.h"
#define TclRegError exp_TclRegError

/*
 * regexp code - from tcl8.0.4/generic/regexp.c
 */

/*
 * TclRegComp and TclRegExec -- TclRegSub is elsewhere
 *
 *	Copyright (c) 1986 by University of Toronto.
 *	Written by Henry Spencer.  Not derived from licensed software.
 *
 *	Permission is granted to anyone to use this software for any
 *	purpose on any computer system, and to redistribute it freely,
 *	subject to the following restrictions:
 *
 *	1. The author is not responsible for the consequences of use of
 *		this software, no matter how awful, even if they arise
 *		from defects in it.
 *
 *	2. The origin of this software must not be misrepresented, either
 *		by explicit claim or by omission.
 *
 *	3. Altered versions must be plainly marked as such, and must not
 *		be misrepresented as being the original software.
 *
 * Beware that some of this code is subtly aware of the way operator
 * precedence is structured in regular expressions.  Serious changes in
 * regular-expression syntax might require a total rethink.
 *
 * *** NOTE: this code has been altered slightly for use in Tcl: ***
 * *** 1. Use ckalloc and ckfree instead of  malloc and free.	 ***
 * *** 2. Add extra argument to regexp to specify the real	 ***
 * ***    start of the string separately from the start of the	 ***
 * ***    current search. This is needed to search for multiple	 ***
 * ***    matches within a string.				 ***
 * *** 3. Names have been changed, e.g. from regcomp to		 ***
 * ***    TclRegComp, to avoid clashes with other 		 ***
 * ***    regexp implementations used by applications. 		 ***
 * *** 4. Added errMsg declaration and TclRegError procedure	 ***
 * *** 5. Various lint-like things, such as casting arguments	 ***
 * ***	  in procedure calls.					 ***
 *
 * *** NOTE: This code has been altered for use in MT-Sturdy Tcl ***
 * *** 1. All use of static variables has been changed to access ***
 * ***    fields of a structure.                                 ***
 * *** 2. This in addition to changes to TclRegError makes the   ***
 * ***    code multi-thread safe.                                ***
 *
 * RCS: @(#) $Id: exp_clib.c,v 5.29 2000/01/06 23:22:02 wart Exp $
 */

#if 0
#include "tclInt.h"
#include "tclPort.h"
#endif

/*
 * The variable below is set to NULL before invoking regexp functions
 * and checked after those functions.  If an error occurred then TclRegError
 * will set the variable to point to a (static) error message.  This
 * mechanism unfortunately does not support multi-threading, but the
 * procedures TclRegError and TclGetRegError can be modified to use
 * thread-specific storage for the variable and thereby make the code
 * thread-safe.
 */

static char *errMsg = NULL;

/*
 * The "internal use only" fields in regexp.h are present to pass info from
 * compile to execute that permits the execute phase to run lots faster on
 * simple cases.  They are:
 *
 * regstart	char that must begin a match; '\0' if none obvious
 * reganch	is the match anchored (at beginning-of-line only)?
 * regmust	string (pointer into program) that match must include, or NULL
 * regmlen	length of regmust string
 *
 * Regstart and reganch permit very fast decisions on suitable starting points
 * for a match, cutting down the work a lot.  Regmust permits fast rejection
 * of lines that cannot possibly match.  The regmust tests are costly enough
 * that TclRegComp() supplies a regmust only if the r.e. contains something
 * potentially expensive (at present, the only such thing detected is * or +
 * at the start of the r.e., which can involve a lot of backup).  Regmlen is
 * supplied because the test in TclRegExec() needs it and TclRegComp() is
 * computing it anyway.
 */

/*
 * Structure for regexp "program".  This is essentially a linear encoding
 * of a nondeterministic finite-state machine (aka syntax charts or
 * "railroad normal form" in parsing technology).  Each node is an opcode
 * plus a "next" pointer, possibly plus an operand.  "Next" pointers of
 * all nodes except BRANCH implement concatenation; a "next" pointer with
 * a BRANCH on both ends of it is connecting two alternatives.  (Here we
 * have one of the subtle syntax dependencies:  an individual BRANCH (as
 * opposed to a collection of them) is never concatenated with anything
 * because of operator precedence.)  The operand of some types of node is
 * a literal string; for others, it is a node leading into a sub-FSM.  In
 * particular, the operand of a BRANCH node is the first node of the branch.
 * (NB this is *not* a tree structure:  the tail of the branch connects
 * to the thing following the set of BRANCHes.)  The opcodes are:
 */

/* definition	number	opnd?	meaning */
#define	END	0	/* no	End of program. */
#define	BOL	1	/* no	Match "" at beginning of line. */
#define	EOL	2	/* no	Match "" at end of line. */
#define	ANY	3	/* no	Match any one character. */
#define	ANYOF	4	/* str	Match any character in this string. */
#define	ANYBUT	5	/* str	Match any character not in this string. */
#define	BRANCH	6	/* node	Match this alternative, or the next... */
#define	BACK	7	/* no	Match "", "next" ptr points backward. */
#define	EXACTLY	8	/* str	Match this string. */
#define	NOTHING	9	/* no	Match empty string. */
#define	STAR	10	/* node	Match this (simple) thing 0 or more times. */
#define	PLUS	11	/* node	Match this (simple) thing 1 or more times. */
#define	OPEN	20	/* no	Mark this point in input as start of #n. */
			/*	OPEN+1 is number 1, etc. */
#define	CLOSE	(OPEN+NSUBEXP)	/* no	Analogous to OPEN. */

/*
 * Opcode notes:
 *
 * BRANCH	The set of branches constituting a single choice are hooked
 *		together with their "next" pointers, since precedence prevents
 *		anything being concatenated to any individual branch.  The
 *		"next" pointer of the last BRANCH in a choice points to the
 *		thing following the whole choice.  This is also where the
 *		final "next" pointer of each individual branch points; each
 *		branch starts with the operand node of a BRANCH node.
 *
 * BACK		Normal "next" pointers all implicitly point forward; BACK
 *		exists to make loop structures possible.
 *
 * STAR,PLUS	'?', and complex '*' and '+', are implemented as circular
 *		BRANCH structures using BACK.  Simple cases (one character
 *		per match) are implemented with STAR and PLUS for speed
 *		and to minimize recursive plunges.
 *
 * OPEN,CLOSE	...are numbered at compile time.
 */

/*
 * A node is one char of opcode followed by two chars of "next" pointer.
 * "Next" pointers are stored as two 8-bit pieces, high order first.  The
 * value is a positive offset from the opcode of the node containing it.
 * An operand, if any, simply follows the node.  (Note that much of the
 * code generation knows about this implicit relationship.)
 *
 * Using two bytes for the "next" pointer is vast overkill for most things,
 * but allows patterns to get big without disasters.
 */
#define	OP(p)	(*(p))
#define	NEXT(p)	(((*((p)+1)&0377)<<8) + (*((p)+2)&0377))
#define	OPERAND(p)	((p) + 3)

/*
 * See regmagic.h for one further detail of program structure.
 */


/*
 * Utility definitions.
 */
#ifndef CHARBITS
#define	UCHARAT(p)	((int)*(unsigned char *)(p))
#else
#define	UCHARAT(p)	((int)*(p)&CHARBITS)
#endif

#define	FAIL(m)	{ TclRegError(m); return(NULL); }
#define	ISMULT(c)	((c) == '*' || (c) == '+' || (c) == '?')
#define	META	"^$.[()|?+*\\"

/*
 * Flags to be passed up and down.
 */
#define	HASWIDTH	01	/* Known never to match null string. */
#define	SIMPLE		02	/* Simple enough to be STAR/PLUS operand. */
#define	SPSTART		04	/* Starts with * or +. */
#define	WORST		0	/* Worst case. */

/*
 * Global work variables for TclRegComp().
 */
struct regcomp_state  {
    char *regparse;		/* Input-scan pointer. */
    int regnpar;		/* () count. */
    char *regcode;		/* Code-emit pointer; &regdummy = don't. */
    long regsize;		/* Code size. */
};

static char regdummy;

/*
 * The first byte of the regexp internal "program" is actually this magic
 * number; the start node begins in the second byte.
 */
#define	MAGIC	0234


/*
 * Forward declarations for TclRegComp()'s friends.
 */

static char *		reg _ANSI_ARGS_((int paren, int *flagp,
			    struct regcomp_state *rcstate));
static char *		regatom _ANSI_ARGS_((int *flagp,
			    struct regcomp_state *rcstate));
static char *		regbranch _ANSI_ARGS_((int *flagp,
			    struct regcomp_state *rcstate));
static void		regc _ANSI_ARGS_((int b,
			    struct regcomp_state *rcstate));
static void		reginsert _ANSI_ARGS_((int op, char *opnd,
			    struct regcomp_state *rcstate));
static char *		regnext _ANSI_ARGS_((char *p));
static char *		regnode _ANSI_ARGS_((int op,
			    struct regcomp_state *rcstate));
static void 		regoptail _ANSI_ARGS_((char *p, char *val));
static char *		regpiece _ANSI_ARGS_((int *flagp,
			    struct regcomp_state *rcstate));
static void 		regtail _ANSI_ARGS_((char *p, char *val));

#ifdef STRCSPN
static int strcspn _ANSI_ARGS_((char *s1, char *s2));
#endif

/*
 - TclRegComp - compile a regular expression into internal code
 *
 * We can't allocate space until we know how big the compiled form will be,
 * but we can't compile it (and thus know how big it is) until we've got a
 * place to put the code.  So we cheat:  we compile it twice, once with code
 * generation turned off and size counting turned on, and once "for real".
 * This also means that we don't allocate space until we are sure that the
 * thing really will compile successfully, and we never have to move the
 * code and thus invalidate pointers into it.  (Note that it has to be in
 * one piece because free() must be able to free it all.)
 *
 * Beware that the optimization-preparation code in here knows about some
 * of the structure of the compiled regexp.
 */
regexp *
TclRegComp(exp)
char *exp;
{
	register regexp *r;
	register char *scan;
	register char *longest;
	register int len;
	int flags;
	struct regcomp_state state;
	struct regcomp_state *rcstate= &state;

	if (exp == NULL)
		FAIL("NULL argument");

	/* First pass: determine size, legality. */
	rcstate->regparse = exp;
	rcstate->regnpar = 1;
	rcstate->regsize = 0L;
	rcstate->regcode = &regdummy;
	regc(MAGIC, rcstate);
	if (reg(0, &flags, rcstate) == NULL)
		return(NULL);

	/* Small enough for pointer-storage convention? */
	if (rcstate->regsize >= 32767L)		/* Probably could be 65535L. */
		FAIL("regexp too big");

	/* Allocate space. */
	r = (regexp *)ckalloc(sizeof(regexp) + (unsigned)rcstate->regsize);
	if (r == NULL)
		FAIL("out of space");

	/* Second pass: emit code. */
	rcstate->regparse = exp;
	rcstate->regnpar = 1;
	rcstate->regcode = r->program;
	regc(MAGIC, rcstate);
	if (reg(0, &flags, rcstate) == NULL)
		return(NULL);

	/* Dig out information for optimizations. */
	r->regstart = '\0';	/* Worst-case defaults. */
	r->reganch = 0;
	r->regmust = NULL;
	r->regmlen = 0;
	scan = r->program+1;			/* First BRANCH. */
	if (OP(regnext(scan)) == END) {		/* Only one top-level choice. */
		scan = OPERAND(scan);

		/* Starting-point info. */
		if (OP(scan) == EXACTLY)
			r->regstart = *OPERAND(scan);
		else if (OP(scan) == BOL)
			r->reganch++;

		/*
		 * If there's something expensive in the r.e., find the
		 * longest literal string that must appear and make it the
		 * regmust.  Resolve ties in favor of later strings, since
		 * the regstart check works with the beginning of the r.e.
		 * and avoiding duplication strengthens checking.  Not a
		 * strong reason, but sufficient in the absence of others.
		 */
		if (flags&SPSTART) {
			longest = NULL;
			len = 0;
			for (; scan != NULL; scan = regnext(scan))
				if (OP(scan) == EXACTLY && ((int) strlen(OPERAND(scan))) >= len) {
					longest = OPERAND(scan);
					len = strlen(OPERAND(scan));
				}
			r->regmust = longest;
			r->regmlen = len;
		}
	}

	return(r);
}

/*
 - reg - regular expression, i.e. main body or parenthesized thing
 *
 * Caller must absorb opening parenthesis.
 *
 * Combining parenthesis handling with the base level of regular expression
 * is a trifle forced, but the need to tie the tails of the branches to what
 * follows makes it hard to avoid.
 */
static char *
reg(paren, flagp, rcstate)
int paren;			/* Parenthesized? */
int *flagp;
struct regcomp_state *rcstate;
{
	register char *ret;
	register char *br;
	register char *ender;
	register int parno = 0;
	int flags;

	*flagp = HASWIDTH;	/* Tentatively. */

	/* Make an OPEN node, if parenthesized. */
	if (paren) {
		if (rcstate->regnpar >= NSUBEXP)
			FAIL("too many ()");
		parno = rcstate->regnpar;
		rcstate->regnpar++;
		ret = regnode(OPEN+parno,rcstate);
	} else
		ret = NULL;

	/* Pick up the branches, linking them together. */
	br = regbranch(&flags,rcstate);
	if (br == NULL)
		return(NULL);
	if (ret != NULL)
		regtail(ret, br);	/* OPEN -> first. */
	else
		ret = br;
	if (!(flags&HASWIDTH))
		*flagp &= ~HASWIDTH;
	*flagp |= flags&SPSTART;
	while (*rcstate->regparse == '|') {
		rcstate->regparse++;
		br = regbranch(&flags,rcstate);
		if (br == NULL)
			return(NULL);
		regtail(ret, br);	/* BRANCH -> BRANCH. */
		if (!(flags&HASWIDTH))
			*flagp &= ~HASWIDTH;
		*flagp |= flags&SPSTART;
	}

	/* Make a closing node, and hook it on the end. */
	ender = regnode((paren) ? CLOSE+parno : END,rcstate);	
	regtail(ret, ender);

	/* Hook the tails of the branches to the closing node. */
	for (br = ret; br != NULL; br = regnext(br))
		regoptail(br, ender);

	/* Check for proper termination. */
	if (paren && *rcstate->regparse++ != ')') {
		FAIL("unmatched ()");
	} else if (!paren && *rcstate->regparse != '\0') {
		if (*rcstate->regparse == ')') {
			FAIL("unmatched ()");
		} else
			FAIL("junk on end");	/* "Can't happen". */
		/* NOTREACHED */
	}

	return(ret);
}

/*
 - regbranch - one alternative of an | operator
 *
 * Implements the concatenation operator.
 */
static char *
regbranch(flagp, rcstate)
int *flagp;
struct regcomp_state *rcstate;
{
	register char *ret;
	register char *chain;
	register char *latest;
	int flags;

	*flagp = WORST;		/* Tentatively. */

	ret = regnode(BRANCH,rcstate);
	chain = NULL;
	while (*rcstate->regparse != '\0' && *rcstate->regparse != '|' &&
				*rcstate->regparse != ')') {
		latest = regpiece(&flags, rcstate);
		if (latest == NULL)
			return(NULL);
		*flagp |= flags&HASWIDTH;
		if (chain == NULL)	/* First piece. */
			*flagp |= flags&SPSTART;
		else
			regtail(chain, latest);
		chain = latest;
	}
	if (chain == NULL)	/* Loop ran zero times. */
		(void) regnode(NOTHING,rcstate);

	return(ret);
}

/*
 - regpiece - something followed by possible [*+?]
 *
 * Note that the branching code sequences used for ? and the general cases
 * of * and + are somewhat optimized:  they use the same NOTHING node as
 * both the endmarker for their branch list and the body of the last branch.
 * It might seem that this node could be dispensed with entirely, but the
 * endmarker role is not redundant.
 */
static char *
regpiece(flagp, rcstate)
int *flagp;
struct regcomp_state *rcstate;
{
	register char *ret;
	register char op;
	register char *next;
	int flags;

	ret = regatom(&flags,rcstate);
	if (ret == NULL)
		return(NULL);

	op = *rcstate->regparse;
	if (!ISMULT(op)) {
		*flagp = flags;
		return(ret);
	}

	if (!(flags&HASWIDTH) && op != '?')
		FAIL("*+ operand could be empty");
	*flagp = (op != '+') ? (WORST|SPSTART) : (WORST|HASWIDTH);

	if (op == '*' && (flags&SIMPLE))
		reginsert(STAR, ret, rcstate);
	else if (op == '*') {
		/* Emit x* as (x&|), where & means "self". */
		reginsert(BRANCH, ret, rcstate);			/* Either x */
		regoptail(ret, regnode(BACK,rcstate));		/* and loop */
		regoptail(ret, ret);			/* back */
		regtail(ret, regnode(BRANCH,rcstate));		/* or */
		regtail(ret, regnode(NOTHING,rcstate));		/* null. */
	} else if (op == '+' && (flags&SIMPLE))
		reginsert(PLUS, ret, rcstate);
	else if (op == '+') {
		/* Emit x+ as x(&|), where & means "self". */
		next = regnode(BRANCH,rcstate);			/* Either */
		regtail(ret, next);
		regtail(regnode(BACK,rcstate), ret);		/* loop back */
		regtail(next, regnode(BRANCH,rcstate));		/* or */
		regtail(ret, regnode(NOTHING,rcstate));		/* null. */
	} else if (op == '?') {
		/* Emit x? as (x|) */
		reginsert(BRANCH, ret, rcstate);			/* Either x */
		regtail(ret, regnode(BRANCH,rcstate));		/* or */
		next = regnode(NOTHING,rcstate);		/* null. */
		regtail(ret, next);
		regoptail(ret, next);
	}
	rcstate->regparse++;
	if (ISMULT(*rcstate->regparse))
		FAIL("nested *?+");

	return(ret);
}

/*
 - regatom - the lowest level
 *
 * Optimization:  gobbles an entire sequence of ordinary characters so that
 * it can turn them into a single node, which is smaller to store and
 * faster to run.  Backslashed characters are exceptions, each becoming a
 * separate node; the code is simpler that way and it's not worth fixing.
 */
static char *
regatom(flagp, rcstate)
int *flagp;
struct regcomp_state *rcstate;
{
	register char *ret;
	int flags;

	*flagp = WORST;		/* Tentatively. */

	switch (*rcstate->regparse++) {
	case '^':
		ret = regnode(BOL,rcstate);
		break;
	case '$':
		ret = regnode(EOL,rcstate);
		break;
	case '.':
		ret = regnode(ANY,rcstate);
		*flagp |= HASWIDTH|SIMPLE;
		break;
	case '[': {
			register int clss;
			register int classend;

			if (*rcstate->regparse == '^') {	/* Complement of range. */
				ret = regnode(ANYBUT,rcstate);
				rcstate->regparse++;
			} else
				ret = regnode(ANYOF,rcstate);
			if (*rcstate->regparse == ']' || *rcstate->regparse == '-')
				regc(*rcstate->regparse++,rcstate);
			while (*rcstate->regparse != '\0' && *rcstate->regparse != ']') {
				if (*rcstate->regparse == '-') {
					rcstate->regparse++;
					if (*rcstate->regparse == ']' || *rcstate->regparse == '\0')
						regc('-',rcstate);
					else {
						clss = UCHARAT(rcstate->regparse-2)+1;
						classend = UCHARAT(rcstate->regparse);
						if (clss > classend+1)
							FAIL("invalid [] range");
						for (; clss <= classend; clss++)
							regc((char)clss,rcstate);
						rcstate->regparse++;
					}
				} else
					regc(*rcstate->regparse++,rcstate);
			}
			regc('\0',rcstate);
			if (*rcstate->regparse != ']')
				FAIL("unmatched []");
			rcstate->regparse++;
			*flagp |= HASWIDTH|SIMPLE;
		}
		break;
	case '(':
		ret = reg(1, &flags, rcstate);
		if (ret == NULL)
			return(NULL);
		*flagp |= flags&(HASWIDTH|SPSTART);
		break;
	case '\0':
	case '|':
	case ')':
		FAIL("internal urp");	/* Supposed to be caught earlier. */
		/* NOTREACHED */
	case '?':
	case '+':
	case '*':
		FAIL("?+* follows nothing");
		/* NOTREACHED */
	case '\\':
		if (*rcstate->regparse == '\0')
			FAIL("trailing \\");
		ret = regnode(EXACTLY,rcstate);
		regc(*rcstate->regparse++,rcstate);
		regc('\0',rcstate);
		*flagp |= HASWIDTH|SIMPLE;
		break;
	default: {
			register int len;
			register char ender;

			rcstate->regparse--;
			len = strcspn(rcstate->regparse, META);
			if (len <= 0)
				FAIL("internal disaster");
			ender = *(rcstate->regparse+len);
			if (len > 1 && ISMULT(ender))
				len--;		/* Back off clear of ?+* operand. */
			*flagp |= HASWIDTH;
			if (len == 1)
				*flagp |= SIMPLE;
			ret = regnode(EXACTLY,rcstate);
			while (len > 0) {
				regc(*rcstate->regparse++,rcstate);
				len--;
			}
			regc('\0',rcstate);
		}
		break;
	}

	return(ret);
}

/*
 - regnode - emit a node
 */
static char *			/* Location. */
regnode(op, rcstate)
int op;
struct regcomp_state *rcstate;
{
	register char *ret;
	register char *ptr;

	ret = rcstate->regcode;
	if (ret == &regdummy) {
		rcstate->regsize += 3;
		return(ret);
	}

	ptr = ret;
	*ptr++ = (char)op;
	*ptr++ = '\0';		/* Null "next" pointer. */
	*ptr++ = '\0';
	rcstate->regcode = ptr;

	return(ret);
}

/*
 - regc - emit (if appropriate) a byte of code
 */
static void
regc(b, rcstate)
int b;
struct regcomp_state *rcstate;
{
	if (rcstate->regcode != &regdummy)
		*rcstate->regcode++ = (char)b;
	else
		rcstate->regsize++;
}

/*
 - reginsert - insert an operator in front of already-emitted operand
 *
 * Means relocating the operand.
 */
static void
reginsert(op, opnd, rcstate)
int op;
char *opnd;
struct regcomp_state *rcstate;
{
	register char *src;
	register char *dst;
	register char *place;

	if (rcstate->regcode == &regdummy) {
		rcstate->regsize += 3;
		return;
	}

	src = rcstate->regcode;
	rcstate->regcode += 3;
	dst = rcstate->regcode;
	while (src > opnd)
		*--dst = *--src;

	place = opnd;		/* Op node, where operand used to be. */
	*place++ = (char)op;
	*place++ = '\0';
	*place = '\0';
}

/*
 - regtail - set the next-pointer at the end of a node chain
 */
static void
regtail(p, val)
char *p;
char *val;
{
	register char *scan;
	register char *temp;
	register int offset;

	if (p == &regdummy)
		return;

	/* Find last node. */
	scan = p;
	for (;;) {
		temp = regnext(scan);
		if (temp == NULL)
			break;
		scan = temp;
	}

	if (OP(scan) == BACK)
		offset = scan - val;
	else
		offset = val - scan;
	*(scan+1) = (char)((offset>>8)&0377);
	*(scan+2) = (char)(offset&0377);
}

/*
 - regoptail - regtail on operand of first argument; nop if operandless
 */
static void
regoptail(p, val)
char *p;
char *val;
{
	/* "Operandless" and "op != BRANCH" are synonymous in practice. */
	if (p == NULL || p == &regdummy || OP(p) != BRANCH)
		return;
	regtail(OPERAND(p), val);
}

/*
 * TclRegExec and friends
 */

/*
 * Global work variables for TclRegExec().
 */
struct regexec_state  {
    char *reginput;		/* String-input pointer. */
    char *regbol;		/* Beginning of input, for ^ check. */
    char **regstartp;	/* Pointer to startp array. */
    char **regendp;		/* Ditto for endp. */
};

/*
 * Forwards.
 */
static int 		regtry _ANSI_ARGS_((regexp *prog, char *string,
			    struct regexec_state *restate));
static int 		regmatch _ANSI_ARGS_((char *prog,
			    struct regexec_state *restate));
static int 		regrepeat _ANSI_ARGS_((char *p,
			    struct regexec_state *restate));

#ifdef DEBUG
int regnarrate = 0;
void regdump _ANSI_ARGS_((regexp *r));
static char *regprop _ANSI_ARGS_((char *op));
#endif

/*
 - TclRegExec - match a regexp against a string
 */
int
TclRegExec(prog, string, start)
register regexp *prog;
register char *string;
char *start;
{
	register char *s;
	struct regexec_state state;
	struct regexec_state *restate= &state;

	/* Be paranoid... */
	if (prog == NULL || string == NULL) {
		TclRegError("NULL parameter");
		return(0);
	}

	/* Check validity of program. */
	if (UCHARAT(prog->program) != MAGIC) {
		TclRegError("corrupted program");
		return(0);
	}

	/* If there is a "must appear" string, look for it. */
	if (prog->regmust != NULL) {
		s = string;
		while ((s = strchr(s, prog->regmust[0])) != NULL) {
			if (strncmp(s, prog->regmust, (size_t) prog->regmlen)
			    == 0)
				break;	/* Found it. */
			s++;
		}
		if (s == NULL)	/* Not present. */
			return(0);
	}

	/* Mark beginning of line for ^ . */
	restate->regbol = start;

	/* Simplest case:  anchored match need be tried only once. */
	if (prog->reganch)
		return(regtry(prog, string, restate));

	/* Messy cases:  unanchored match. */
	s = string;
	if (prog->regstart != '\0')
		/* We know what char it must start with. */
		while ((s = strchr(s, prog->regstart)) != NULL) {
			if (regtry(prog, s, restate))
				return(1);
			s++;
		}
	else
		/* We don't -- general case. */
		do {
			if (regtry(prog, s, restate))
				return(1);
		} while (*s++ != '\0');

	/* Failure. */
	return(0);
}

/*
 - regtry - try match at specific point
 */
static int			/* 0 failure, 1 success */
regtry(prog, string, restate)
regexp *prog;
char *string;
struct regexec_state *restate;
{
	register int i;
	register char **sp;
	register char **ep;

	restate->reginput = string;
	restate->regstartp = prog->startp;
	restate->regendp = prog->endp;

	sp = prog->startp;
	ep = prog->endp;
	for (i = NSUBEXP; i > 0; i--) {
		*sp++ = NULL;
		*ep++ = NULL;
	}
	if (regmatch(prog->program + 1,restate)) {
		prog->startp[0] = string;
		prog->endp[0] = restate->reginput;
		return(1);
	} else
		return(0);
}

/*
 - regmatch - main matching routine
 *
 * Conceptually the strategy is simple:  check to see whether the current
 * node matches, call self recursively to see whether the rest matches,
 * and then act accordingly.  In practice we make some effort to avoid
 * recursion, in particular by going through "ordinary" nodes (that don't
 * need to know whether the rest of the match failed) by a loop instead of
 * by recursion.
 */
static int			/* 0 failure, 1 success */
regmatch(prog, restate)
char *prog;
struct regexec_state *restate;
{
    register char *scan;	/* Current node. */
    char *next;		/* Next node. */

    scan = prog;
#ifdef DEBUG
    if (scan != NULL && regnarrate)
	fprintf(stderr, "%s(\n", regprop(scan));
#endif
    while (scan != NULL) {
#ifdef DEBUG
	if (regnarrate)
	    fprintf(stderr, "%s...\n", regprop(scan));
#endif
	next = regnext(scan);

	switch (OP(scan)) {
	    case BOL:
		if (restate->reginput != restate->regbol) {
		    return 0;
		}
		break;
	    case EOL:
		if (*restate->reginput != '\0') {
		    return 0;
		}
		break;
	    case ANY:
		if (*restate->reginput == '\0') {
		    return 0;
		}
		restate->reginput++;
		break;
	    case EXACTLY: {
		register int len;
		register char *opnd;

		opnd = OPERAND(scan);
		/* Inline the first character, for speed. */
		if (*opnd != *restate->reginput) {
		    return 0 ;
		}
		len = strlen(opnd);
		if (len > 1 && strncmp(opnd, restate->reginput, (size_t) len)
			!= 0) {
		    return 0;
		}
		restate->reginput += len;
		break;
	    }
	    case ANYOF:
		if (*restate->reginput == '\0'
			|| strchr(OPERAND(scan), *restate->reginput) == NULL) {
		    return 0;
		}
		restate->reginput++;
		break;
	    case ANYBUT:
		if (*restate->reginput == '\0'
			|| strchr(OPERAND(scan), *restate->reginput) != NULL) {
		    return 0;
		}
		restate->reginput++;
		break;
	    case NOTHING:
		break;
	    case BACK:
		break;
	    case OPEN+1:
	    case OPEN+2:
	    case OPEN+3:
	    case OPEN+4:
	    case OPEN+5:
	    case OPEN+6:
	    case OPEN+7:
	    case OPEN+8:
	    case OPEN+9: {
		register int no;
		register char *save;

	doOpen:
		no = OP(scan) - OPEN;
		save = restate->reginput;

		if (regmatch(next,restate)) {
		    /*
		     * Don't set startp if some later invocation of the
		     * same parentheses already has.
		     */
		    if (restate->regstartp[no] == NULL) {
			restate->regstartp[no] = save;
		    }
		    return 1;
		} else {
		    return 0;
		}
	    }
	    case CLOSE+1:
	    case CLOSE+2:
	    case CLOSE+3:
	    case CLOSE+4:
	    case CLOSE+5:
	    case CLOSE+6:
	    case CLOSE+7:
	    case CLOSE+8:
	    case CLOSE+9: {
		register int no;
		register char *save;

	doClose:
		no = OP(scan) - CLOSE;
		save = restate->reginput;

		if (regmatch(next,restate)) {
				/*
				 * Don't set endp if some later
				 * invocation of the same parentheses
				 * already has.
				 */
		    if (restate->regendp[no] == NULL)
			restate->regendp[no] = save;
		    return 1;
		} else {
		    return 0;
		}
	    }
	    case BRANCH: {
		register char *save;

		if (OP(next) != BRANCH) { /* No choice. */
		    next = OPERAND(scan); /* Avoid recursion. */
		} else {
		    do {
			save = restate->reginput;
			if (regmatch(OPERAND(scan),restate))
			    return(1);
			restate->reginput = save;
			scan = regnext(scan);
		    } while (scan != NULL && OP(scan) == BRANCH);
		    return 0;
		}
		break;
	    }
	    case STAR:
	    case PLUS: {
		register char nextch;
		register int no;
		register char *save;
		register int min;

		/*
		 * Lookahead to avoid useless match attempts
		 * when we know what character comes next.
		 */
		nextch = '\0';
		if (OP(next) == EXACTLY)
		    nextch = *OPERAND(next);
		min = (OP(scan) == STAR) ? 0 : 1;
		save = restate->reginput;
		no = regrepeat(OPERAND(scan),restate);
		while (no >= min) {
		    /* If it could work, try it. */
		    if (nextch == '\0' || *restate->reginput == nextch)
			if (regmatch(next,restate))
			    return(1);
		    /* Couldn't or didn't -- back up. */
		    no--;
		    restate->reginput = save + no;
		}
		return(0);
	    }
	    case END:
		return(1);	/* Success! */
	    default:
		if (OP(scan) > OPEN && OP(scan) < OPEN+NSUBEXP) {
		    goto doOpen;
		} else if (OP(scan) > CLOSE && OP(scan) < CLOSE+NSUBEXP) {
		    goto doClose;
		}
		TclRegError("memory corruption");
		return 0;
	}

	scan = next;
    }

    /*
     * We get here only if there's trouble -- normally "case END" is
     * the terminating point.
     */
    TclRegError("corrupted pointers");
    return(0);
}

/*
 - regrepeat - repeatedly match something simple, report how many
 */
static int
regrepeat(p, restate)
char *p;
struct regexec_state *restate;
{
	register int count = 0;
	register char *scan;
	register char *opnd;

	scan = restate->reginput;
	opnd = OPERAND(p);
	switch (OP(p)) {
	case ANY:
		count = strlen(scan);
		scan += count;
		break;
	case EXACTLY:
		while (*opnd == *scan) {
			count++;
			scan++;
		}
		break;
	case ANYOF:
		while (*scan != '\0' && strchr(opnd, *scan) != NULL) {
			count++;
			scan++;
		}
		break;
	case ANYBUT:
		while (*scan != '\0' && strchr(opnd, *scan) == NULL) {
			count++;
			scan++;
		}
		break;
	default:		/* Oh dear.  Called inappropriately. */
		TclRegError("internal foulup");
		count = 0;	/* Best compromise. */
		break;
	}
	restate->reginput = scan;

	return(count);
}

/*
 - regnext - dig the "next" pointer out of a node
 */
static char *
regnext(p)
register char *p;
{
	register int offset;

	if (p == &regdummy)
		return(NULL);

	offset = NEXT(p);
	if (offset == 0)
		return(NULL);

	if (OP(p) == BACK)
		return(p-offset);
	else
		return(p+offset);
}

#ifdef DEBUG

static char *regprop();

/*
 - regdump - dump a regexp onto stdout in vaguely comprehensible form
 */
void
regdump(r)
regexp *r;
{
	register char *s;
	register char op = EXACTLY;	/* Arbitrary non-END op. */
	register char *next;


	s = r->program + 1;
	while (op != END) {	/* While that wasn't END last time... */
		op = OP(s);
		printf("%2d%s", s-r->program, regprop(s));	/* Where, what. */
		next = regnext(s);
		if (next == NULL)		/* Next ptr. */
			printf("(0)");
		else 
			printf("(%d)", (s-r->program)+(next-s));
		s += 3;
		if (op == ANYOF || op == ANYBUT || op == EXACTLY) {
			/* Literal string, where present. */
			while (*s != '\0') {
				putchar(*s);
				s++;
			}
			s++;
		}
		putchar('\n');
	}

	/* Header fields of interest. */
	if (r->regstart != '\0')
		printf("start `%c' ", r->regstart);
	if (r->reganch)
		printf("anchored ");
	if (r->regmust != NULL)
		printf("must have \"%s\"", r->regmust);
	printf("\n");
}

/*
 - regprop - printable representation of opcode
 */
static char *
regprop(op)
char *op;
{
	register char *p;
	static char buf[50];

	(void) strcpy(buf, ":");

	switch (OP(op)) {
	case BOL:
		p = "BOL";
		break;
	case EOL:
		p = "EOL";
		break;
	case ANY:
		p = "ANY";
		break;
	case ANYOF:
		p = "ANYOF";
		break;
	case ANYBUT:
		p = "ANYBUT";
		break;
	case BRANCH:
		p = "BRANCH";
		break;
	case EXACTLY:
		p = "EXACTLY";
		break;
	case NOTHING:
		p = "NOTHING";
		break;
	case BACK:
		p = "BACK";
		break;
	case END:
		p = "END";
		break;
	case OPEN+1:
	case OPEN+2:
	case OPEN+3:
	case OPEN+4:
	case OPEN+5:
	case OPEN+6:
	case OPEN+7:
	case OPEN+8:
	case OPEN+9:
		sprintf(buf+strlen(buf), "OPEN%d", OP(op)-OPEN);
		p = NULL;
		break;
	case CLOSE+1:
	case CLOSE+2:
	case CLOSE+3:
	case CLOSE+4:
	case CLOSE+5:
	case CLOSE+6:
	case CLOSE+7:
	case CLOSE+8:
	case CLOSE+9:
		sprintf(buf+strlen(buf), "CLOSE%d", OP(op)-CLOSE);
		p = NULL;
		break;
	case STAR:
		p = "STAR";
		break;
	case PLUS:
		p = "PLUS";
		break;
	default:
		if (OP(op) > OPEN && OP(op) < OPEN+NSUBEXP) {
		    sprintf(buf+strlen(buf), "OPEN%d", OP(op)-OPEN);
		    p = NULL;
		    break;
		} else if (OP(op) > CLOSE && OP(op) < CLOSE+NSUBEXP) {
		    sprintf(buf+strlen(buf), "CLOSE%d", OP(op)-CLOSE);
		    p = NULL;
		} else {
		    TclRegError("corrupted opcode");
		}
		break;
	}
	if (p != NULL)
		(void) strcat(buf, p);
	return(buf);
}
#endif

/*
 * The following is provided for those people who do not have strcspn() in
 * their C libraries.  They should get off their butts and do something
 * about it; at least one public-domain implementation of those (highly
 * useful) string routines has been published on Usenet.
 */
#ifdef STRCSPN
/*
 * strcspn - find length of initial segment of s1 consisting entirely
 * of characters not from s2
 */

static int
strcspn(s1, s2)
char *s1;
char *s2;
{
	register char *scan1;
	register char *scan2;
	register int count;

	count = 0;
	for (scan1 = s1; *scan1 != '\0'; scan1++) {
		for (scan2 = s2; *scan2 != '\0';)	/* ++ moved down. */
			if (*scan1 == *scan2++)
				return(count);
		count++;
	}
	return(count);
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * TclRegError --
 *
 *	This procedure is invoked by the regexp code when an error
 *	occurs.  It saves the error message so it can be seen by the
 *	code that called Spencer's code.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The value of "string" is saved in "errMsg".
 *
 *----------------------------------------------------------------------
 */

void
exp_TclRegError(string)
    char *string;			/* Error message. */
{
    errMsg = string;
}

char *
TclGetRegError()
{
    return errMsg;
}

/*
 * end of regexp definitions and code
 */

/*
 * following stolen from tcl8.0.4/generic/tclPosixStr.c
 */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_ErrnoMsg --
 *
 *	Return a human-readable message corresponding to a given
 *	errno value.
 *
 * Results:
 *	The return value is the standard POSIX error message for
 *	errno.  This procedure is used instead of strerror because
 *	strerror returns slightly different values on different
 *	machines (e.g. different capitalizations), which cause
 *	problems for things such as regression tests.  This procedure
 *	provides messages for most standard errors, then it calls
 *	strerror for things it doesn't understand.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static
char *
Tcl_ErrnoMsg(err)
    int err;			/* Error number (such as in errno variable). */
{
    switch (err) {
#ifdef E2BIG
	case E2BIG: return "argument list too long";
#endif
#ifdef EACCES
	case EACCES: return "permission denied";
#endif
#ifdef EADDRINUSE
	case EADDRINUSE: return "address already in use";
#endif
#ifdef EADDRNOTAVAIL
	case EADDRNOTAVAIL: return "can't assign requested address";
#endif
#ifdef EADV
	case EADV: return "advertise error";
#endif
#ifdef EAFNOSUPPORT
	case EAFNOSUPPORT: return "address family not supported by protocol family";
#endif
#ifdef EAGAIN
	case EAGAIN: return "resource temporarily unavailable";
#endif
#ifdef EALIGN
	case EALIGN: return "EALIGN";
#endif
#if defined(EALREADY) && (!defined(EBUSY) || (EALREADY != EBUSY ))
	case EALREADY: return "operation already in progress";
#endif
#ifdef EBADE
	case EBADE: return "bad exchange descriptor";
#endif
#ifdef EBADF
	case EBADF: return "bad file number";
#endif
#ifdef EBADFD
	case EBADFD: return "file descriptor in bad state";
#endif
#ifdef EBADMSG
	case EBADMSG: return "not a data message";
#endif
#ifdef EBADR
	case EBADR: return "bad request descriptor";
#endif
#ifdef EBADRPC
	case EBADRPC: return "RPC structure is bad";
#endif
#ifdef EBADRQC
	case EBADRQC: return "bad request code";
#endif
#ifdef EBADSLT
	case EBADSLT: return "invalid slot";
#endif
#ifdef EBFONT
	case EBFONT: return "bad font file format";
#endif
#ifdef EBUSY
	case EBUSY: return "file busy";
#endif
#ifdef ECHILD
	case ECHILD: return "no children";
#endif
#ifdef ECHRNG
	case ECHRNG: return "channel number out of range";
#endif
#ifdef ECOMM
	case ECOMM: return "communication error on send";
#endif
#ifdef ECONNABORTED
	case ECONNABORTED: return "software caused connection abort";
#endif
#ifdef ECONNREFUSED
	case ECONNREFUSED: return "connection refused";
#endif
#ifdef ECONNRESET
	case ECONNRESET: return "connection reset by peer";
#endif
#if defined(EDEADLK) && (!defined(EWOULDBLOCK) || (EDEADLK != EWOULDBLOCK))
	case EDEADLK: return "resource deadlock avoided";
#endif
#if defined(EDEADLOCK) && (!defined(EDEADLK) || (EDEADLOCK != EDEADLK))
	case EDEADLOCK: return "resource deadlock avoided";
#endif
#ifdef EDESTADDRREQ
	case EDESTADDRREQ: return "destination address required";
#endif
#ifdef EDIRTY
	case EDIRTY: return "mounting a dirty fs w/o force";
#endif
#ifdef EDOM
	case EDOM: return "math argument out of range";
#endif
#ifdef EDOTDOT
	case EDOTDOT: return "cross mount point";
#endif
#ifdef EDQUOT
	case EDQUOT: return "disk quota exceeded";
#endif
#ifdef EDUPPKG
	case EDUPPKG: return "duplicate package name";
#endif
#ifdef EEXIST
	case EEXIST: return "file already exists";
#endif
#ifdef EFAULT
	case EFAULT: return "bad address in system call argument";
#endif
#ifdef EFBIG
	case EFBIG: return "file too large";
#endif
#ifdef EHOSTDOWN
	case EHOSTDOWN: return "host is down";
#endif
#ifdef EHOSTUNREACH
	case EHOSTUNREACH: return "host is unreachable";
#endif
#if defined(EIDRM) && (!defined(EINPROGRESS) || (EIDRM != EINPROGRESS))
	case EIDRM: return "identifier removed";
#endif
#ifdef EINIT
	case EINIT: return "initialization error";
#endif
#ifdef EINPROGRESS
	case EINPROGRESS: return "operation now in progress";
#endif
#ifdef EINTR
	case EINTR: return "interrupted system call";
#endif
#ifdef EINVAL
	case EINVAL: return "invalid argument";
#endif
#ifdef EIO
	case EIO: return "I/O error";
#endif
#ifdef EISCONN
	case EISCONN: return "socket is already connected";
#endif
#ifdef EISDIR
	case EISDIR: return "illegal operation on a directory";
#endif
#ifdef EISNAME
	case EISNAM: return "is a name file";
#endif
#ifdef ELBIN
	case ELBIN: return "ELBIN";
#endif
#ifdef EL2HLT
	case EL2HLT: return "level 2 halted";
#endif
#ifdef EL2NSYNC
	case EL2NSYNC: return "level 2 not synchronized";
#endif
#ifdef EL3HLT
	case EL3HLT: return "level 3 halted";
#endif
#ifdef EL3RST
	case EL3RST: return "level 3 reset";
#endif
#ifdef ELIBACC
	case ELIBACC: return "can not access a needed shared library";
#endif
#ifdef ELIBBAD
	case ELIBBAD: return "accessing a corrupted shared library";
#endif
#ifdef ELIBEXEC
	case ELIBEXEC: return "can not exec a shared library directly";
#endif
#ifdef ELIBMAX
	case ELIBMAX: return
		"attempting to link in more shared libraries than system limit";
#endif
#ifdef ELIBSCN
	case ELIBSCN: return ".lib section in a.out corrupted";
#endif
#ifdef ELNRNG
	case ELNRNG: return "link number out of range";
#endif
#if defined(ELOOP) && (!defined(ENOENT) || (ELOOP != ENOENT))
	case ELOOP: return "too many levels of symbolic links";
#endif
#ifdef EMFILE
	case EMFILE: return "too many open files";
#endif
#ifdef EMLINK
	case EMLINK: return "too many links";
#endif
#ifdef EMSGSIZE
	case EMSGSIZE: return "message too long";
#endif
#ifdef EMULTIHOP
	case EMULTIHOP: return "multihop attempted";
#endif
#ifdef ENAMETOOLONG
	case ENAMETOOLONG: return "file name too long";
#endif
#ifdef ENAVAIL
	case ENAVAIL: return "not available";
#endif
#ifdef ENET
	case ENET: return "ENET";
#endif
#ifdef ENETDOWN
	case ENETDOWN: return "network is down";
#endif
#ifdef ENETRESET
	case ENETRESET: return "network dropped connection on reset";
#endif
#ifdef ENETUNREACH
	case ENETUNREACH: return "network is unreachable";
#endif
#ifdef ENFILE
	case ENFILE: return "file table overflow";
#endif
#ifdef ENOANO
	case ENOANO: return "anode table overflow";
#endif
#if defined(ENOBUFS) && (!defined(ENOSR) || (ENOBUFS != ENOSR))
	case ENOBUFS: return "no buffer space available";
#endif
#ifdef ENOCSI
	case ENOCSI: return "no CSI structure available";
#endif
#if defined(ENODATA) && (!defined(ECONNREFUSED) || (ENODATA != ECONNREFUSED))
	case ENODATA: return "no data available";
#endif
#ifdef ENODEV
	case ENODEV: return "no such device";
#endif
#ifdef ENOENT
	case ENOENT: return "no such file or directory";
#endif
#ifdef ENOEXEC
	case ENOEXEC: return "exec format error";
#endif
#ifdef ENOLCK
	case ENOLCK: return "no locks available";
#endif
#ifdef ENOLINK
	case ENOLINK: return "link has be severed";
#endif
#ifdef ENOMEM
	case ENOMEM: return "not enough memory";
#endif
#ifdef ENOMSG
	case ENOMSG: return "no message of desired type";
#endif
#ifdef ENONET
	case ENONET: return "machine is not on the network";
#endif
#ifdef ENOPKG
	case ENOPKG: return "package not installed";
#endif
#ifdef ENOPROTOOPT
	case ENOPROTOOPT: return "bad proocol option";
#endif
#ifdef ENOSPC
	case ENOSPC: return "no space left on device";
#endif
#if defined(ENOSR) && (!defined(ENAMETOOLONG) || (ENAMETOOLONG != ENOSR))
	case ENOSR: return "out of stream resources";
#endif
#if defined(ENOSTR) && (!defined(ENOTTY) || (ENOTTY != ENOSTR))
	case ENOSTR: return "not a stream device";
#endif
#ifdef ENOSYM
	case ENOSYM: return "unresolved symbol name";
#endif
#ifdef ENOSYS
	case ENOSYS: return "function not implemented";
#endif
#ifdef ENOTBLK
	case ENOTBLK: return "block device required";
#endif
#ifdef ENOTCONN
	case ENOTCONN: return "socket is not connected";
#endif
#ifdef ENOTDIR
	case ENOTDIR: return "not a directory";
#endif
#if defined(ENOTEMPTY) && (!defined(EEXIST) || (ENOTEMPTY != EEXIST))
	case ENOTEMPTY: return "directory not empty";
#endif
#ifdef ENOTNAM
	case ENOTNAM: return "not a name file";
#endif
#ifdef ENOTSOCK
	case ENOTSOCK: return "socket operation on non-socket";
#endif
#ifdef ENOTSUP
	case ENOTSUP: return "operation not supported";
#endif
#ifdef ENOTTY
	case ENOTTY: return "inappropriate device for ioctl";
#endif
#ifdef ENOTUNIQ
	case ENOTUNIQ: return "name not unique on network";
#endif
#ifdef ENXIO
	case ENXIO: return "no such device or address";
#endif
#if defined(EOPNOTSUPP) &&  (!defined(ENOTSUP) || (ENOTSUP != EOPNOTSUPP))
	case EOPNOTSUPP: return "operation not supported on socket";
#endif
#ifdef EPERM
	case EPERM: return "not owner";
#endif
#if defined(EPFNOSUPPORT) && (!defined(ENOLCK) || (ENOLCK != EPFNOSUPPORT))
	case EPFNOSUPPORT: return "protocol family not supported";
#endif
#ifdef EPIPE
	case EPIPE: return "broken pipe";
#endif
#ifdef EPROCLIM
	case EPROCLIM: return "too many processes";
#endif
#ifdef EPROCUNAVAIL
	case EPROCUNAVAIL: return "bad procedure for program";
#endif
#ifdef EPROGMISMATCH
	case EPROGMISMATCH: return "program version wrong";
#endif
#ifdef EPROGUNAVAIL
	case EPROGUNAVAIL: return "RPC program not available";
#endif
#ifdef EPROTO
	case EPROTO: return "protocol error";
#endif
#ifdef EPROTONOSUPPORT
	case EPROTONOSUPPORT: return "protocol not suppored";
#endif
#ifdef EPROTOTYPE
	case EPROTOTYPE: return "protocol wrong type for socket";
#endif
#ifdef ERANGE
	case ERANGE: return "math result unrepresentable";
#endif
#if defined(EREFUSED) && (!defined(ECONNREFUSED) || (EREFUSED != ECONNREFUSED))
	case EREFUSED: return "EREFUSED";
#endif
#ifdef EREMCHG
	case EREMCHG: return "remote address changed";
#endif
#ifdef EREMDEV
	case EREMDEV: return "remote device";
#endif
#ifdef EREMOTE
	case EREMOTE: return "pathname hit remote file system";
#endif
#ifdef EREMOTEIO
	case EREMOTEIO: return "remote i/o error";
#endif
#ifdef EREMOTERELEASE
	case EREMOTERELEASE: return "EREMOTERELEASE";
#endif
#ifdef EROFS
	case EROFS: return "read-only file system";
#endif
#ifdef ERPCMISMATCH
	case ERPCMISMATCH: return "RPC version is wrong";
#endif
#ifdef ERREMOTE
	case ERREMOTE: return "object is remote";
#endif
#ifdef ESHUTDOWN
	case ESHUTDOWN: return "can't send afer socket shutdown";
#endif
#ifdef ESOCKTNOSUPPORT
	case ESOCKTNOSUPPORT: return "socket type not supported";
#endif
#ifdef ESPIPE
	case ESPIPE: return "invalid seek";
#endif
#ifdef ESRCH
	case ESRCH: return "no such process";
#endif
#ifdef ESRMNT
	case ESRMNT: return "srmount error";
#endif
#ifdef ESTALE
	case ESTALE: return "stale remote file handle";
#endif
#ifdef ESUCCESS
	case ESUCCESS: return "Error 0";
#endif
#if defined(ETIME) && (!defined(ELOOP) || (ETIME != ELOOP))
	case ETIME: return "timer expired";
#endif
#if defined(ETIMEDOUT) && (!defined(ENOSTR) || (ETIMEDOUT != ENOSTR))
	case ETIMEDOUT: return "connection timed out";
#endif
#ifdef ETOOMANYREFS
	case ETOOMANYREFS: return "too many references: can't splice";
#endif
#ifdef ETXTBSY
	case ETXTBSY: return "text file or pseudo-device busy";
#endif
#ifdef EUCLEAN
	case EUCLEAN: return "structure needs cleaning";
#endif
#ifdef EUNATCH
	case EUNATCH: return "protocol driver not attached";
#endif
#ifdef EUSERS
	case EUSERS: return "too many users";
#endif
#ifdef EVERSION
	case EVERSION: return "version mismatch";
#endif
#if defined(EWOULDBLOCK) && (!defined(EAGAIN) || (EWOULDBLOCK != EAGAIN))
	case EWOULDBLOCK: return "operation would block";
#endif
#ifdef EXDEV
	case EXDEV: return "cross-domain link";
#endif
#ifdef EXFULL
	case EXFULL: return "message tables full";
#endif
	default:
#ifdef NO_STRERROR
	    return "unknown POSIX error";
#else
	    return strerror(errno);
#endif
    }
}

/*
 * end of excerpt from tcl8.0.X/generic/tclPosixStr.c
 */

/*
 * stolen from exp_log.c - this function is called from the Expect library
 * but the one that the library supplies calls Tcl functions.  So we supply
 * our own.
 */

static
void
expDiagLogU(str)
     char *str;
{
  if (exp_is_debugging) {
    fprintf(stderr,str);
    if (exp_logfile) fprintf(exp_logfile,str);
  }
}

/*
 * expect-specific definitions and code
 */

#include "expect.h"
#include "exp_int.h"

/* exp_glob.c - expect functions for doing glob
 *
 * Based on Tcl's glob functions but modified to support anchors and to
 * return information about the possibility of future matches
 *
 * Modifications by: Don Libes, NIST, 2/6/90
 */

/* The following functions implement expect's glob-style string
 * matching Exp_StringMatch allow's implements the unanchored front
 * (or conversely the '^') feature.  Exp_StringMatch2 does the rest of
 * the work.
 */

/* Exp_StringMatch2 --
 *
 * Like Tcl_StringMatch except that
 * 1) returns number of characters matched, -1 if failed.
 *	(Can return 0 on patterns like "" or "$")
 * 2) does not require pattern to match to end of string
 * 3) much of code is stolen from Tcl_StringMatch
 * 4) front-anchor is assumed (Tcl_StringMatch retries for non-front-anchor)
 */
static
int
Exp_StringMatch2(string,pattern)
    register char *string;	/* String. */
    register char *pattern;	/* Pattern, which may contain
				 * special characters. */
{
    char c2;
    int match = 0;	/* # of chars matched */

    while (1) {
	/* If at end of pattern, success! */
	if (*pattern == 0) {
		return match;
	}

	/* If last pattern character is '$', verify that entire
	 * string has been matched.
	 */
	if ((*pattern == '$') && (pattern[1] == 0)) {
		if (*string == 0) return(match);
		else return(-1);		
	}

	/* Check for a "*" as the next pattern character.  It matches
	 * any substring.  We handle this by calling ourselves
	 * recursively for each postfix of string, until either we
	 * match or we reach the end of the string.
	 */
	
	if (*pattern == '*') {
	    int head_len;
	    char *tail;
	    pattern += 1;
	    if (*pattern == 0) {
		return(strlen(string)+match); /* DEL */
	    }
	    /* find longest match - switched to this on 12/31/93 */
	    head_len = strlen(string);	/* length before tail */
	    tail = string + head_len;
	    while (head_len >= 0) {
		int rc;

		if (-1 != (rc = Exp_StringMatch2(tail, pattern))) {
		    return rc + match + head_len;	/* DEL */
		}
		tail--;
		head_len--;
	    }
	    return -1;					/* DEL */
	}
    
	/*
	 * after this point, all patterns must match at least one
	 * character, so check this
	 */

	if (*string == 0) return -1;

	/* Check for a "?" as the next pattern character.  It matches
	 * any single character.
	 */

	if (*pattern == '?') {
	    goto thisCharOK;
	}

	/* Check for a "[" as the next pattern character.  It is followed
	 * by a list of characters that are acceptable, or by a range
	 * (two characters separated by "-").
	 */
	
	if (*pattern == '[') {
	    pattern += 1;
	    while (1) {
		if ((*pattern == ']') || (*pattern == 0)) {
		    return -1;			/* was 0; DEL */
		}
		if (*pattern == *string) {
		    break;
		}
		if (pattern[1] == '-') {
		    c2 = pattern[2];
		    if (c2 == 0) {
			return -1;		/* DEL */
		    }
		    if ((*pattern <= *string) && (c2 >= *string)) {
			break;
		    }
		    if ((*pattern >= *string) && (c2 <= *string)) {
			break;
		    }
		    pattern += 2;
		}
		pattern += 1;
	    }

	    while (*pattern != ']') {
		if (*pattern == 0) {
		    pattern--;
		    break;
	        }
		pattern += 1;
	    }
	    goto thisCharOK;
	}
    
	/* If the next pattern character is backslash, strip it off
	 * so we do exact matching on the character that follows.
	 */
	
	if (*pattern == '\\') {
	    pattern += 1;
	    if (*pattern == 0) {
		return -1;
	    }
	}

	/* There's no special character.  Just make sure that the next
	 * characters of each string match.
	 */
	
	if (*pattern != *string) {
	    return -1;
	}

	thisCharOK: pattern += 1;
	string += 1;
	match++;
    }
}


static
int	/* returns # of chars that matched */
Exp_StringMatch(string, pattern,offset)
char *string;
char *pattern;
int *offset;	/* offset from beginning of string where pattern matches */
{
	char *s;
	int sm;	/* count of chars matched or -1 */
	int caret = FALSE;
	int star = FALSE;

	*offset = 0;

	if (pattern[0] == '^') {
		caret = TRUE;
		pattern++;
	} else if (pattern[0] == '*') {
		star = TRUE;
	}

	/*
	 * test if pattern matches in initial position.
	 * This handles front-anchor and 1st iteration of non-front-anchor.
	 * Note that 1st iteration must be tried even if string is empty.
	 */

	sm = Exp_StringMatch2(string,pattern);
	if (sm >= 0) return(sm);

	if (caret) return -1;
	if (star) return -1;

	if (*string == '\0') return -1;

	for (s = string+1;*s;s++) {
 		sm = Exp_StringMatch2(s,pattern);
		if (sm != -1) {
			*offset = s-string;
			return(sm);
		}
	}
	return -1;
}


#define EXP_MATCH_MAX	2000
/* public */
char *exp_buffer = 0;
char *exp_buffer_end = 0;
char *exp_match = 0;
char *exp_match_end = 0;
int exp_match_max = EXP_MATCH_MAX;	/* bytes */
int exp_full_buffer = FALSE;		/* don't return on full buffer */
int exp_remove_nulls = TRUE;
int exp_timeout = 10;			/* seconds */
int exp_pty_timeout = 5;		/* seconds - see CRAY below */
int exp_autoallocpty = TRUE;		/* if TRUE, we do allocation */
int exp_pty[2];				/* master is [0], slave is [1] */
int exp_pid;
char *exp_stty_init = 0;		/* initial stty args */
int exp_ttycopy = TRUE;			/* copy tty parms from /dev/tty */
int exp_ttyinit = TRUE;			/* set tty parms to sane state */
int exp_console = FALSE;		/* redirect console */
void (*exp_child_exec_prelude)() = 0;
void (*exp_close_in_child)() = 0;

#ifdef HAVE_SIGLONGJMP
sigjmp_buf exp_readenv;		/* for interruptable read() */
#else
jmp_buf exp_readenv;		/* for interruptable read() */
#endif /* HAVE_SIGLONGJMP */

int exp_reading = FALSE;	/* whether we can longjmp or not */

int exp_is_debugging = FALSE;
FILE *exp_debugfile = 0;

FILE *exp_logfile = 0;
int exp_logfile_all = FALSE;	/* if TRUE, write log of all interactions */
int exp_loguser = TRUE;		/* if TRUE, user sees interactions on stdout */


char *exp_printify();
int exp_getptymaster();
int exp_getptyslave();

#define sysreturn(x)	return(errno = x, -1)

void exp_init_pty();

/*
   The following functions are linked from the Tcl library.  They
   don't cause anything else in the library to be dragged in, so it
   shouldn't cause any problems (e.g., bloat).

   The functions are relatively small but painful enough that I don't care
   to recode them.  You may, if you absolutely want to get rid of any
   vestiges of Tcl.
*/

static unsigned int bufsiz = 2*EXP_MATCH_MAX;

static struct f {
	int valid;

	char *buffer;		/* buffer of matchable chars */
	char *buffer_end;	/* one beyond end of matchable chars */
	char *match_end;	/* one beyond end of matched string */
	int msize;		/* size of allocate space */
				/* actual size is one larger for null */
} *fs = 0;

static int fd_alloc_max = -1;	/* max fd allocated */

/* translate fd or fp to fd */
static struct f *
fdfp2f(fd,fp)
int fd;
FILE *fp;
{
	if (fd == -1) return(fs + fileno(fp));
	else return(fs + fd);
}

static struct f *
fd_new(fd)
int fd;
{
	int i, low;
	struct f *fp;
	struct f *newfs;	/* temporary, so we don't lose old fs */

	if (fd > fd_alloc_max) {
		if (!fs) {	/* no fd's yet allocated */
			newfs = (struct f *)malloc(sizeof(struct f)*(fd+1));
			low = 0;
		} else {		/* enlarge fd table */
			newfs = (struct f *)realloc((char *)fs,sizeof(struct f)*(fd+1));
			low = fd_alloc_max+1;
		}
		fs = newfs;
		fd_alloc_max = fd;
		for (i = low; i <= fd_alloc_max; i++) { /* init new entries */
			fs[i].valid = FALSE;
		}
	}

	fp = fs+fd;

	if (!fp->valid) {
		/* initialize */
		fp->buffer = malloc((unsigned)(bufsiz+1));
		if (!fp->buffer) return 0;
		fp->msize = bufsiz;
		fp->valid = TRUE;
	}
	fp->buffer_end = fp->buffer;
	fp->match_end = fp->buffer;
	return fp;

}

static
void
exp_setpgrp()
{
#ifdef MIPS_BSD
    /* required on BSD side of MIPS OS <[email protected]> */
#   include <sysv/sys.s>
    syscall(SYS_setpgrp);
#endif

#ifdef SETPGRP_VOID
    (void) setpgrp();
#else
    (void) setpgrp(0,0);
#endif
}

/* returns fd of master side of pty */
int
exp_spawnv(file,argv)
char *file;
char *argv[];	/* some compiler complains about **argv? */
{
	int cc;
	int errorfd;	/* place to stash fileno(stderr) in child */
			/* while we're setting up new stderr */
	int ttyfd;
	int sync_fds[2];
	int sync2_fds[2];
	int status_pipe[2];
	int child_errno;
	char sync_byte;
#ifdef PTYTRAP_DIES
	int slave_write_ioctls = 1;
		/* by default, slave will be write-ioctled this many times */
#endif

	static int first_time = TRUE;

	if (first_time) {
		first_time = FALSE;
		exp_init_pty();
		exp_init_tty();
		expDiagLogPtrSet(expDiagLogU);
		expErrnoMsgSet(Tcl_ErrnoMsg);
	}

	if (!file || !argv) sysreturn(EINVAL);
	if (!argv[0] || strcmp(file,argv[0])) {
		exp_debuglog("expect: warning: file (%s) != argv[0] (%s)\n",
			file,
			argv[0]?argv[0]:"");
	}

#ifdef PTYTRAP_DIES
/* any extraneous ioctl's that occur in slave must be accounted for
when trapping, see below in child half of fork */
#if defined(TIOCSCTTY) && !defined(CIBAUD) && !defined(sun) && !defined(hp9000s300)
	slave_write_ioctls++;
#endif
#endif /*PTYTRAP_DIES*/

	if (exp_autoallocpty) {
		if (0 > (exp_pty[0] = exp_getptymaster())) sysreturn(ENODEV);
	}
	fcntl(exp_pty[0],F_SETFD,1);	/* close on exec */
#ifdef PTYTRAP_DIES
	exp_slave_control(exp_pty[0],1);*/
#endif

	if (!fd_new(exp_pty[0])) {
		errno = ENOMEM;
		return -1;
	}

	if (-1 == (pipe(sync_fds))) {
		return -1;
	}
	if (-1 == (pipe(sync2_fds))) {
		close(sync_fds[0]);
		close(sync_fds[1]);
		return -1;
	}

	if (-1 == pipe(status_pipe)) {
		close(sync_fds[0]);
		close(sync_fds[1]);
		close(sync2_fds[0]);
		close(sync2_fds[1]);
		return -1;
	}

	if ((exp_pid = fork()) == -1) return(-1);
	if (exp_pid) {
		/* parent */
		close(sync_fds[1]);
		close(sync2_fds[0]);
		close(status_pipe[1]);

		if (!exp_autoallocpty) close(exp_pty[1]);

#ifdef PTYTRAP_DIES
#ifdef HAVE_PTYTRAP
		if (exp_autoallocpty) {
			/* trap initial ioctls in a feeble attempt to not */
			/* block the initially.  If the process itself */
			/* ioctls /dev/tty, such blocks will be trapped */
			/* later during normal event processing */

			while (slave_write_ioctls) {
				int cc;

				cc = exp_wait_for_slave_open(exp_pty[0]);
#if defined(TIOCSCTTY) && !defined(CIBAUD) && !defined(sun) && !defined(hp9000s300)
				if (cc == TIOCSCTTY) slave_write_ioctls = 0;
#endif
				if (cc & IOC_IN) slave_write_ioctls--;
				else if (cc == -1) {
					printf("failed to trap slave pty");
					return -1;
				}
			}
		}
#endif
#endif /*PTYTRAP_DIES*/

		/*
		 * wait for slave to initialize pty before allowing
		 * user to send to it
		 */ 

		exp_debuglog("parent: waiting for sync byte\r\n");
		cc = read(sync_fds[0],&sync_byte,1);
		if (cc == -1) {
		  exp_errorlog("parent sync byte read: %s\r\n",Tcl_ErrnoMsg(errno));
		  return -1;
		}

		/* turn on detection of eof */
		exp_slave_control(exp_pty[0],1);

		/*
		 * tell slave to go on now now that we have initialized pty
		 */

		exp_debuglog("parent: telling child to go ahead\r\n");
		cc = write(sync2_fds[1]," ",1);
		if (cc == -1) {
		  exp_errorlog("parent sync byte write: %s\r\n",Tcl_ErrnoMsg(errno));
		  return -1;
		}

		exp_debuglog("parent: now unsynchronized from child\r\n");

		close(sync_fds[0]);
		close(sync2_fds[1]);

		/* see if child's exec worked */

	retry:
		switch (read(status_pipe[0],&child_errno,sizeof child_errno)) {
		case -1:
			if (errno == EINTR) goto retry;
			/* well it's not really the child's errno */
			/* but it can be treated that way */
			child_errno = errno;
			break;
		case 0:
			/* child's exec succeeded */
			child_errno = 0;
			break;
		default:
			/* child's exec failed; err contains exec's errno  */
			waitpid(exp_pid, NULL, 0);
			errno = child_errno;
			exp_pty[0] = -1;
		}
		close(status_pipe[0]);
		return(exp_pty[0]);
	}

	/*
	 * child process - do not return from here!  all errors must exit()
	 */

	close(sync_fds[0]);
	close(sync2_fds[1]);
	close(status_pipe[0]);
	fcntl(status_pipe[1],F_SETFD,1);	/* close on exec */

#ifdef CRAY
	(void) close(exp_pty[0]);
#endif

/* ultrix (at least 4.1-2) fails to obtain controlling tty if setsid */
/* is called.  setpgrp works though.  */
#if defined(POSIX) && !defined(ultrix)
#define DO_SETSID
#endif
#ifdef __convex__
#define DO_SETSID
#endif

#ifdef DO_SETSID
	setsid();
#else
#ifdef SYSV3
#ifndef CRAY
	exp_setpgrp();
#endif /* CRAY */
#else /* !SYSV3 */
	exp_setpgrp();

#ifdef TIOCNOTTY
	ttyfd = open("/dev/tty", O_RDWR);
	if (ttyfd >= 0) {
		(void) ioctl(ttyfd, TIOCNOTTY, (char *)0);
		(void) close(ttyfd);
	}
#endif /* TIOCNOTTY */

#endif /* SYSV3 */
#endif /* DO_SETSID */

	/* save error fd while we're setting up new one */
	errorfd = fcntl(2,F_DUPFD,3);
	/* and here is the macro to restore it */
#define restore_error_fd {close(2);fcntl(errorfd,F_DUPFD,2);}

	if (exp_autoallocpty) {

	    close(0);
	    close(1);
	    close(2);

	    /* since we closed fd 0, open of pty slave must return fd 0 */

	    if (0 > (exp_pty[1] = exp_getptyslave(exp_ttycopy,exp_ttyinit,
						exp_stty_init))) {
		restore_error_fd
		fprintf(stderr,"open(slave pty): %s\n",Tcl_ErrnoMsg(errno));
		exit(-1);
	    }
	    /* sanity check */
	    if (exp_pty[1] != 0) {
		restore_error_fd
		fprintf(stderr,"exp_getptyslave: slave = %d but expected 0\n",
								exp_pty[1]);
		exit(-1);
	    }
	} else {
		if (exp_pty[1] != 0) {
			close(0);	fcntl(exp_pty[1],F_DUPFD,0);
		}
		close(1);		fcntl(0,F_DUPFD,1);
		close(2);		fcntl(0,F_DUPFD,1);
		close(exp_pty[1]);
	}



/* The test for hpux may have to be more specific.  In particular, the */
/* code should be skipped on the hp9000s300 and hp9000s720 (but there */
/* is no documented define for the 720!) */

#if defined(TIOCSCTTY) && !defined(sun) && !defined(hpux)
	/* 4.3+BSD way to acquire controlling terminal */
	/* according to Stevens - Adv. Prog..., p 642 */
#ifdef __QNX__ /* posix in general */
	if (tcsetct(0, getpid()) == -1) {
	  restore_error_fd
	  expErrorLog("failed to get controlling terminal using TIOCSCTTY");
	  exit(-1);
	}
#else
	(void) ioctl(0,TIOCSCTTY,(char *)0);
	/* ignore return value - on some systems, it is defined but it
	 * fails and it doesn't seem to cause any problems.  Or maybe
	 * it works but returns a bogus code.  Noone seems to be able
	 * to explain this to me.  The systems are an assortment of
	 * different linux systems (and FreeBSD 2.5), RedHat 5.2 and
	 * Debian 2.0
	 */
#endif
#endif

#ifdef CRAY
 	(void) setsid();
 	(void) ioctl(0,TCSETCTTY,0);
 	(void) close(0);
 	if (open("/dev/tty", O_RDWR) < 0) {
		restore_error_fd
 		fprintf(stderr,"open(/dev/tty): %s\r\n",Tcl_ErrnoMsg(errno));
 		exit(-1);
 	}
 	(void) close(1);
 	(void) close(2);
 	(void) dup(0);
 	(void) dup(0);
	setptyutmp();	/* create a utmp entry */

	/* _CRAY2 code from Hal Peterson <[email protected]>, Cray Research, Inc. */
#ifdef _CRAY2
	/*
	 * Interpose a process between expect and the spawned child to
	 * keep the slave side of the pty open to allow time for expect
	 * to read the last output.  This is a workaround for an apparent
	 * bug in the Unicos pty driver on Cray-2's under Unicos 6.0 (at
	 * least).
	 */
	if ((pid = fork()) == -1) {
		restore_error_fd
		fprintf(stderr,"second fork: %s\r\n",Tcl_ErrnoMsg(errno));
		exit(-1);
	}

	if (pid) {
 		/* Intermediate process. */
		int status;
		int timeout;
		char *t;

		/* How long should we wait? */
		timeout = exp_pty_timeout;

		/* Let the spawned process run to completion. */
 		while (wait(&status) < 0 && errno == EINTR)
			/* empty body */;

		/* Wait for the pty to clear. */
		sleep(timeout);

		/* Duplicate the spawned process's status. */
		if (WIFSIGNALED(status))
			kill(getpid(), WTERMSIG(status));

		/* The kill may not have worked, but this will. */
 		exit(WEXITSTATUS(status));
	}
#endif /* _CRAY2 */
#endif /* CRAY */

	if (exp_console) {
#ifdef SRIOCSREDIR
		int fd;

		if ((fd = open("/dev/console", O_RDONLY)) == -1) {
			restore_error_fd
			fprintf(stderr, "spawn %s: cannot open console, check permissions of /dev/console\n",argv[0]);
			exit(-1);
		}
		if (ioctl(fd, SRIOCSREDIR, 0) == -1) {
			restore_error_fd
			fprintf(stderr, "spawn %s: cannot redirect console, check permissions of /dev/console\n",argv[0]);
		}
		close(fd);
#endif

#ifdef TIOCCONS
		int on = 1;
		if (ioctl(0,TIOCCONS,(char *)&on) == -1) {
			restore_error_fd
			fprintf(stderr, "spawn %s: cannot open console, check permissions of /dev/console\n",argv[0]);
			exit(-1);
		}
#endif /* TIOCCONS */
	}

	/* tell parent that we are done setting up pty */
	/* The actual char sent back is irrelevant. */

	/* exp_debuglog("child: telling parent that pty is initialized\r\n");*/
	cc = write(sync_fds[1]," ",1);
	if (cc == -1) {
		restore_error_fd
		fprintf(stderr,"child: sync byte write: %s\r\n",Tcl_ErrnoMsg(errno));
		exit(-1);
	}
	close(sync_fds[1]);

	/* wait for master to let us go on */
	cc = read(sync2_fds[0],&sync_byte,1);
	if (cc == -1) {
		restore_error_fd
		exp_errorlog("child: sync byte read: %s\r\n",Tcl_ErrnoMsg(errno));
		exit(-1);
	}
	close(sync2_fds[0]);

	/* exp_debuglog("child: now unsynchronized from parent\r\n"); */

	/* (possibly multiple) masters are closed automatically due to */
	/* earlier fcntl(,,CLOSE_ON_EXEC); */

	/* just in case, allow user to explicitly close other files */
	if (exp_close_in_child) (*exp_close_in_child)();

	/* allow user to do anything else to child */
	if (exp_child_exec_prelude) (*exp_child_exec_prelude)();

        (void) execvp(file,argv);

	/* Unfortunately, by now we've closed fd's to stderr, logfile
	 * and debugfile.  The only reasonable thing to do is to send
	 * *back the error as part of the program output.  This will
	 * be *picked up in an expect or interact command.
	 */

	write(status_pipe[1], &errno, sizeof errno);
	exit(-1);
	/*NOTREACHED*/
}

/* returns fd of master side of pty */
/*VARARGS*/
int
exp_spawnl TCL_VARARGS_DEF(char *,arg1)
/*exp_spawnl(va_alist)*/
/*va_dcl*/
{
	va_list args; /* problematic line here */
	int i;
	char *arg, **argv;

	arg = TCL_VARARGS_START(char *,arg1,args);
	/*va_start(args);*/
	for (i=1;;i++) {
		arg = va_arg(args,char *);
		if (!arg) break;
	}
	va_end(args);
	if (i == 0) sysreturn(EINVAL);
	if (!(argv = (char **)malloc((i+1)*sizeof(char *)))) sysreturn(ENOMEM);
	argv[0] = TCL_VARARGS_START(char *,arg1,args);
	/*va_start(args);*/
	for (i=1;;i++) {
		argv[i] = va_arg(args,char *);
		if (!argv[i]) break;
	}
	i = exp_spawnv(argv[0],argv+1);
	free((char *)argv);
	return(i);
}

/* allow user-provided fd to be passed to expect funcs */
int
exp_spawnfd(fd)
int fd;
{
	if (!fd_new(fd)) {
		errno = ENOMEM;
		return -1;
	}
	return fd;	
}

/* remove nulls from s.  Initially, the number of chars in s is c, */
/* not strlen(s).  This count does not include the trailing null. */
/* returns number of nulls removed. */
static int
rm_nulls(s,c)
char *s;
int c;
{
	char *s2 = s;	/* points to place in original string to put */
			/* next non-null character */
	int count = 0;
	int i;

	for (i=0;i<c;i++,s++) {
		if (0 == *s) {
			count++;
			continue;
		}
		if (count) *s2 = *s;
		s2++;
	}
	return(count);
}

static int i_read_errno;/* place to save errno, if i_read() == -1, so it
			   doesn't get overwritten before we get to read it */

/*ARGSUSED*/
static void
sigalarm_handler(n)
int n;			/* signal number, unused by us */
{
#ifdef REARM_SIG
	signal(SIGALRM,sigalarm_handler);
#endif

#ifdef HAVE_SIGLONGJMP
	siglongjmp(exp_readenv,1);
#else
	longjmp(exp_readenv,1);
#endif /* HAVE_SIGLONGJMP */
}

/* interruptable read */
static int
i_read(fd,fp,buffer,length,timeout)
int fd;
FILE *fp;
char *buffer;
int length;
int timeout;
{
	int cc = -2;

	/* since setjmp insists on returning 1 upon longjmp(,0), */
	/* longjmp(,2 (EXP_RESTART)) instead. */

	/* no need to set alarm if -1 (infinite) or 0 (poll with */
	/* guaranteed data) */

	if (timeout > 0) alarm(timeout);

	/* restart read if setjmp returns 0 (first time) or 2 (EXP_RESTART). */
	/* abort if setjmp returns 1 (EXP_ABORT). */
#ifdef HAVE_SIGLONGJMP
        if (EXP_ABORT != sigsetjmp(exp_readenv,1)) {
#else
	if (EXP_ABORT != setjmp(exp_readenv)) {
#endif /* HAVE_SIGLONGJMP */
		exp_reading = TRUE;
		if (fd == -1) {
			int c;
			c = getc(fp);
			if (c == EOF) {
/*fprintf(stderr,"<<EOF>>",c);fflush(stderr);*/
				if (feof(fp)) cc = 0;
				else cc = -1;
			} else {
/*fprintf(stderr,"<<%c>>",c);fflush(stderr);*/
				buffer[0] = c;
				cc = 1;
			}
		} else {
#ifndef HAVE_PTYTRAP
			cc = read(fd,buffer,length);
#else
#  include <sys/ptyio.h>

			fd_set rdrs;
			fd_set excep;

		restart:
			FD_ZERO(&rdrs);
			FD_ZERO(&excep);
			FD_SET(fd,&rdrs);
			FD_SET(fd,&excep);
			if (-1 == (cc = select(fd+1,
					 (SELECT_MASK_TYPE *)&rdrs,
					 (SELECT_MASK_TYPE *)0,
					 (SELECT_MASK_TYPE *)&excep,
					 (struct timeval *)0))) {
				/* window refreshes trigger EINTR, ignore */
				if (errno == EINTR) goto restart;
			}
			if (FD_ISSET(fd,&rdrs)) {
				cc = read(fd,buffer,length);
			} else if (FD_ISSET(fd,&excep)) {
				struct request_info ioctl_info;
				ioctl(fd,TIOCREQCHECK,&ioctl_info);
				if (ioctl_info.request == TIOCCLOSE) {
					cc = 0; /* indicate eof */
				} else {
					ioctl(fd, TIOCREQSET, &ioctl_info);
					/* presumably, we trapped an open here */
					goto restart;
				}
			}
#endif /* HAVE_PTYTRAP */
		}
#if 0
		/* can't get fread to return early! */
		else {
			if (!(cc = fread(buffer,1,length,fp))) {
				if (ferror(fp)) cc = -1;
			}
		}
#endif
		i_read_errno = errno;	/* errno can be overwritten by the */
					/* time we return */
	}
	exp_reading = FALSE;

	if (timeout > 0) alarm(0);
	return(cc);
}

/* I tried really hard to make the following two functions share the code */
/* that makes the ecase array, but I kept running into a brick wall when */
/* passing var args into the funcs and then again into a make_cases func */
/* I would very much appreciate it if someone showed me how to do it right */

/* takes triplets of args, with a final "exp_last" arg */
/* triplets are type, pattern, and then int to return */
/* returns negative value if error (or EOF/timeout) occurs */
/* some negative values can also have an associated errno */

/* the key internal variables that this function depends on are:
	exp_buffer
	exp_buffer_end
	exp_match_end
*/
static int
expectv(fd,fp,ecases)
int fd;
FILE *fp;
struct exp_case *ecases;
{
	int cc = 0;		/* number of chars returned in a single read */
	int buf_length;		/* numbers of chars in exp_buffer */
	int old_length;		/* old buf_length */
	int first_time = TRUE;	/* force old buffer to be tested before */
				/* additional reads */
	int polled = 0;		/* true if poll has caused read() to occur */

	struct exp_case *ec;	/* points to current ecase */

	time_t current_time;	/* current time (when we last looked)*/
	time_t end_time;	/* future time at which to give up */
	int remtime;		/* remaining time in timeout */

	struct f *f;
	int return_val;
	int sys_error = 0;
#define return_normally(x)	{return_val = x; goto cleanup;}
#define return_errno(x)	{sys_error = x; goto cleanup;}

	f = fdfp2f(fd,fp);
	if (!f) return_errno(ENOMEM);

	exp_buffer = f->buffer;
	exp_buffer_end = f->buffer_end;
	exp_match_end = f->match_end;

	buf_length = exp_buffer_end - exp_match_end;
	if (buf_length) {
		/*
		 * take end of previous match to end of buffer
		 * and copy to beginning of buffer
		 */
		memmove(exp_buffer,exp_match_end,buf_length);
	}			
	exp_buffer_end = exp_buffer + buf_length;
	*exp_buffer_end = '\0';

	if (!ecases) return_errno(EINVAL);

	/* compile if necessary */
	for (ec=ecases;ec->type != exp_end;ec++) {
		if ((ec->type == exp_regexp) && !ec->re) {
			TclRegError((char *)0);
			if (!(ec->re = TclRegComp(ec->pattern))) {
				fprintf(stderr,"regular expression %s is bad: %s",ec->pattern,TclGetRegError());
				return_errno(EINVAL);
			  }
		  }
	}

	/* get the latest buffer size.  Double the user input for two */
	/* reasons.  1) Need twice the space in case the match */
	/* straddles two bufferfuls, 2) easier to hack the division by */
	/* two when shifting the buffers later on */

	bufsiz = 2*exp_match_max;
	if (f->msize != bufsiz) {
		/* if truncated, forget about some data */
		if (buf_length > bufsiz) {
			/* copy end of buffer down */

			/* copy one less than what buffer can hold to avoid */
			/* triggering buffer-full handling code below */
			/* which will immediately dump the first half */
			/* of the buffer */
			memmove(exp_buffer,exp_buffer+(buf_length - bufsiz)+1,
				bufsiz-1);
			buf_length = bufsiz-1;
		}
		exp_buffer = realloc(exp_buffer,bufsiz+1);
		if (!exp_buffer) return_errno(ENOMEM);
		exp_buffer[buf_length] = '\0';
		exp_buffer_end = exp_buffer + buf_length;
		f->msize = bufsiz;
	}

	/* some systems (i.e., Solaris) require fp be flushed when switching */
	/* directions - do this again afterwards */
	if (fd == -1) fflush(fp);

	if (exp_timeout != -1) signal(SIGALRM,sigalarm_handler);

	/* remtime and current_time updated at bottom of loop */
	remtime = exp_timeout;

	time(&current_time);
	end_time = current_time + remtime;

	for (;;) {
		/* when buffer fills, copy second half over first and */
		/* continue, so we can do matches over multiple buffers */
		if (buf_length == bufsiz) {
			int first_half, second_half;

			if (exp_full_buffer) {
				exp_debuglog("expect: full buffer\r\n");
				exp_match = exp_buffer;
				exp_match_end = exp_buffer + buf_length;
				exp_buffer_end = exp_match_end;
				return_normally(EXP_FULLBUFFER);
			}
			first_half = bufsiz/2;
			second_half = bufsiz - first_half;

			memcpy(exp_buffer,exp_buffer+first_half,second_half);
			buf_length = second_half;
			exp_buffer_end = exp_buffer + second_half;
		}

		/*
		 * always check first if pattern is already in buffer
		 */
		if (first_time) {
			first_time = FALSE;
			goto after_read;
		}

		/*
		 * check for timeout
		 */
		if ((exp_timeout >= 0) && ((remtime < 0) || polled)) {
			exp_debuglog("expect: timeout\r\n");
			exp_match_end = exp_buffer;
			return_normally(EXP_TIMEOUT);
		}

		/*
		 * if timeout == 0, indicate a poll has
		 * occurred so that next time through loop causes timeout
		 */
		if (exp_timeout == 0) {
			polled = 1;
		}

		cc = i_read(fd,fp,
				exp_buffer_end,
				bufsiz - buf_length,
				remtime);

		if (cc == 0) {
			exp_debuglog("expect: eof\r\n");
			return_normally(EXP_EOF);	/* normal EOF */
		} else if (cc == -1) {			/* abnormal EOF */
			/* ptys produce EIO upon EOF - sigh */
			if (i_read_errno == EIO) {
				/* convert to EOF indication */
				exp_debuglog("expect: eof\r\n");
				return_normally(EXP_EOF);
			}
			exp_debuglog("expect: error (errno = %d)\r\n",i_read_errno);
			return_errno(i_read_errno);
		} else if (cc == -2) {
			exp_debuglog("expect: timeout\r\n");
			exp_match_end = exp_buffer;
			return_normally(EXP_TIMEOUT);
		}

		old_length = buf_length;
		buf_length += cc;
		exp_buffer_end += buf_length;

		if (exp_logfile_all || (exp_loguser && exp_logfile)) {
			fwrite(exp_buffer + old_length,1,cc,exp_logfile);
		}
		if (exp_loguser) fwrite(exp_buffer + old_length,1,cc,stdout);
		if (exp_debugfile) fwrite(exp_buffer + old_length,1,cc,exp_debugfile);

		/* if we wrote to any logs, flush them */
		if (exp_debugfile) fflush(exp_debugfile);
		if (exp_loguser) {
			fflush(stdout);
			if (exp_logfile) fflush(exp_logfile);
		}

		/* remove nulls from input, so we can use C-style strings */
		/* doing it here lets them be sent to the screen, just */
		/*  in case they are involved in formatting operations */
		if (exp_remove_nulls) {
			buf_length -= rm_nulls(exp_buffer + old_length, cc);
		}
		/* cc should be decremented as well, but since it will not */
		/* be used before being set again, there is no need */
		exp_buffer_end = exp_buffer + buf_length;
		*exp_buffer_end = '\0';
                exp_match_end = exp_buffer;

	after_read:
		exp_debuglog("expect: does {%s} match ",exp_printify(exp_buffer));
		/* pattern supplied */
		for (ec=ecases;ec->type != exp_end;ec++) {
			int matched = -1;

			exp_debuglog("{%s}? ",exp_printify(ec->pattern));
			if (ec->type == exp_glob) {
				int offset;
				matched = Exp_StringMatch(exp_buffer,ec->pattern,&offset);
				if (matched >= 0) {
					exp_match = exp_buffer + offset;
					exp_match_end = exp_match + matched;
				}
			} else if (ec->type == exp_exact) {
				char *p = strstr(exp_buffer,ec->pattern);
				if (p) {
					matched = 1;
					exp_match = p;
					exp_match_end = p + strlen(ec->pattern);
				}
			} else if (ec->type == exp_null) {
				char *p;

				for (p=exp_buffer;p<exp_buffer_end;p++) {
					if (*p == 0) {
						matched = 1;
						exp_match = p;
						exp_match_end = p+1;
					}
				}
			} else {
				TclRegError((char *)0);
				if (TclRegExec(ec->re,exp_buffer,exp_buffer)) {
					matched = 1;
					exp_match = ec->re->startp[0];
					exp_match_end = ec->re->endp[0];
				} else if (TclGetRegError()) {
			    		fprintf(stderr,"r.e. match (pattern %s) failed: %s",ec->pattern,TclGetRegError());
				}
			}

			if (matched != -1) {
				exp_debuglog("yes\nexp_buffer is {%s}\n",
						exp_printify(exp_buffer));
				return_normally(ec->value);
			} else exp_debuglog("no\n");
		}

		/*
		 * Update current time and remaining time.
		 * Don't bother if we are waiting forever or polling.
		 */
		if (exp_timeout > 0) {
			time(&current_time);
			remtime = end_time - current_time;
		}
	}
 cleanup:
	f->buffer     = exp_buffer;
	f->buffer_end = exp_buffer_end;
	f->match_end  = exp_match_end;

	/* some systems (i.e., Solaris) require fp be flushed when switching */
	/* directions - do this before as well */
	if (fd == -1) fflush(fp);

	if (sys_error) {
		errno = sys_error;
		return -1;
	}
	return return_val;
}

int
exp_fexpectv(fp,ecases)
FILE *fp;
struct exp_case *ecases;
{
	return(expectv(-1,fp,ecases));
}

int
exp_expectv(fd,ecases)
int fd;
struct exp_case *ecases;
{
	return(expectv(fd,(FILE *)0,ecases));
}

/*VARARGS*/
int
exp_expectl TCL_VARARGS_DEF(int,arg1)
/*exp_expectl(va_alist)*/
/*va_dcl*/
{
	va_list args;
	int fd;
	struct exp_case *ec, *ecases;
	int i;
	enum exp_type type;

	fd = TCL_VARARGS_START(int,arg1,args);
	/* va_start(args);*/
	/* fd = va_arg(args,int);*/
	/* first just count the arg sets */
	for (i=0;;i++) {
		type = va_arg(args,enum exp_type);
		if (type == exp_end) break;

		/* Ultrix 4.2 compiler refuses enumerations comparison!? */
		if ((int)type < 0 || (int)type >= (int)exp_bogus) {
			fprintf(stderr,"bad type (set %d) in exp_expectl\n",i);
			sysreturn(EINVAL);
		}

		va_arg(args,char *);		/* COMPUTED BUT NOT USED */
		if (type == exp_compiled) {
			va_arg(args,regexp *);	/* COMPUTED BUT NOT USED */
		}
		va_arg(args,int);		/* COMPUTED BUT NOT USED*/
	}
	va_end(args);

	if (!(ecases = (struct exp_case *)
				malloc((1+i)*sizeof(struct exp_case))))
		sysreturn(ENOMEM);

	/* now set up the actual cases */
	fd = TCL_VARARGS_START(int,arg1,args);
	/*va_start(args);*/
	/*va_arg(args,int);*/		/*COMPUTED BUT NOT USED*/
	for (ec=ecases;;ec++) {
		ec->type = va_arg(args,enum exp_type);
		if (ec->type == exp_end) break;
		ec->pattern = va_arg(args,char *);
		if (ec->type == exp_compiled) {
			ec->re = va_arg(args,regexp *);
		} else {
			ec->re = 0;
		}
		ec->value = va_arg(args,int);
	}
	va_end(args);
	i = expectv(fd,(FILE *)0,ecases);

	for (ec=ecases;ec->type != exp_end;ec++) {
		/* free only if regexp and we compiled it for user */
		if (ec->type == exp_regexp) {
			free((char *)ec->re);
		}
	}
	free((char *)ecases);
	return(i);
}

int
exp_fexpectl TCL_VARARGS_DEF(FILE *,arg1)
/*exp_fexpectl(va_alist)*/
/*va_dcl*/
{
	va_list args;
	FILE *fp;
	struct exp_case *ec, *ecases;
	int i;
	enum exp_type type;

	fp = TCL_VARARGS_START(FILE *,arg1,args);
	/*va_start(args);*/
	/*fp = va_arg(args,FILE *);*/
	/* first just count the arg-pairs */
	for (i=0;;i++) {
		type = va_arg(args,enum exp_type);
		if (type == exp_end) break;

		/* Ultrix 4.2 compiler refuses enumerations comparison!? */
		if ((int)type < 0 || (int)type >= (int)exp_bogus) {
			fprintf(stderr,"bad type (set %d) in exp_expectl\n",i);
			sysreturn(EINVAL);
		}

		va_arg(args,char *);		/* COMPUTED BUT NOT USED */
		if (type == exp_compiled) {
			va_arg(args,regexp *);	/* COMPUTED BUT NOT USED */
		}
		va_arg(args,int);		/* COMPUTED BUT NOT USED*/
	}
	va_end(args);

	if (!(ecases = (struct exp_case *)
					malloc((1+i)*sizeof(struct exp_case))))
		sysreturn(ENOMEM);

#if 0
	va_start(args);
	va_arg(args,FILE *);		/*COMPUTED, BUT NOT USED*/
#endif
	(void) TCL_VARARGS_START(FILE *,arg1,args);

	for (ec=ecases;;ec++) {
		ec->type = va_arg(args,enum exp_type);
		if (ec->type == exp_end) break;
		ec->pattern = va_arg(args,char *);
		if (ec->type == exp_compiled) {
			ec->re = va_arg(args,regexp *);
		} else {
			ec->re = 0;
		}
		ec->value = va_arg(args,int);
	}
	va_end(args);
	i = expectv(-1,fp,ecases);

	for (ec=ecases;ec->type != exp_end;ec++) {
		/* free only if regexp and we compiled it for user */
		if (ec->type == exp_regexp) {
			free((char *)ec->re);
		}
	}
	free((char *)ecases);
	return(i);
}

/* like popen(3) but works in both directions */
FILE *
exp_popen(program)
char *program;
{
	FILE *fp;
	int ec;

	if (0 > (ec = exp_spawnl("sh","sh","-c",program,(char *)0))) return(0);
	if (!(fp = fdopen(ec,"r+"))) return(0);
	setbuf(fp,(char *)0);
	return(fp);
}

int
exp_disconnect()
{
	int ttyfd;

#ifndef EALREADY
#define EALREADY 37
#endif

	/* presumably, no stderr, so don't bother with error message */
	if (exp_disconnected) sysreturn(EALREADY);
	exp_disconnected = TRUE;

	freopen("/dev/null","r",stdin);
	freopen("/dev/null","w",stdout);
	freopen("/dev/null","w",stderr);

#ifdef POSIX
	setsid();
#else
#ifdef SYSV3
	/* put process in our own pgrp, and lose controlling terminal */
	exp_setpgrp();
	signal(SIGHUP,SIG_IGN);
	if (fork()) exit(0);	/* first child exits (as per Stevens, */
	/* UNIX Network Programming, p. 79-80) */
	/* second child process continues as daemon */
#else /* !SYSV3 */
	exp_setpgrp();
/* Pyramid lacks this defn */
#ifdef TIOCNOTTY
	ttyfd = open("/dev/tty", O_RDWR);
	if (ttyfd >= 0) {
		/* zap controlling terminal if we had one */
		(void) ioctl(ttyfd, TIOCNOTTY, (char *)0);
		(void) close(ttyfd);
	}
#endif /* TIOCNOTTY */
#endif /* SYSV3 */
#endif /* POSIX */
	return(0);
}

/* send to log if open and debugging enabled */
/* send to stderr if debugging enabled */
/* use this function for recording unusual things in the log */
/*VARARGS*/
void
exp_debuglog TCL_VARARGS_DEF(char *,arg1)
{
    char *fmt;
    va_list args;

    fmt = TCL_VARARGS_START(char *,arg1,args);
    if (exp_debugfile) vfprintf(exp_debugfile,fmt,args);
    if (exp_is_debugging) {
	vfprintf(stderr,fmt,args);
	if (exp_logfile) vfprintf(exp_logfile,fmt,args);
    }

    va_end(args);
}


/* send to log if open */
/* send to stderr */
/* use this function for error conditions */
/*VARARGS*/
void
exp_errorlog TCL_VARARGS_DEF(char *,arg1)
{
    char *fmt;
    va_list args;
    
    fmt = TCL_VARARGS_START(char *,arg1,args);
    vfprintf(stderr,fmt,args);
    if (exp_debugfile) vfprintf(exp_debugfile,fmt,args);
    if (exp_logfile) vfprintf(exp_logfile,fmt,args);
    va_end(args);
}

#include <ctype.h>

char *
exp_printify(s)
char *s;
{
	static int destlen = 0;
	static char *dest = 0;
	char *d;		/* ptr into dest */
	unsigned int need;

	if (s == 0) return("<null>");

	/* worst case is every character takes 4 to printify */
	need = strlen(s)*4 + 1;
	if (need > destlen) {
		if (dest) ckfree(dest);
		dest = ckalloc(need);
		destlen = need;
	}

	for (d = dest;*s;s++) {
		if (*s == '\r') {
			strcpy(d,"\\r");		d += 2;
		} else if (*s == '\n') {
			strcpy(d,"\\n");		d += 2;
		} else if (*s == '\t') {
			strcpy(d,"\\t");		d += 2;
		} else if (isascii(*s) && isprint(*s)) {
			*d = *s;			d += 1;
		} else {
			sprintf(d,"\\x%02x",*s & 0xff);	d += 4;
		}
	}
	*d = '\0';
	return(dest);
}






Deleted exp_closetcl.c.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16


















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

#if OBSOLETE
/* exp_closetcl.c - close tcl files */

/* isolated in it's own file since it has hooks into Tcl and exp_clib user */
/* might like to avoid dragging it in */

#include "expect_cf.h"

void (*exp_close_in_child)() = 0;

void
exp_close_tcl_files() {
    /* I don't believe this function is used any longer, at least in
       the Expect program.*/
}
#endif /* OBSOLETE */






Deleted exp_command.c.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096
3097
3098
3099
3100
3101































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

/* exp_command.c - the bulk of the Expect commands

Written by: Don Libes, NIST, 2/6/90

Design and implementation of this program was paid for by U.S. tax
dollars.  Therefore it is public domain.  However, the author and NIST
would appreciate credit if this program or parts of it are used.

*/

#include "expect_cf.h"

#include <stdio.h>
#include <sys/types.h>
/*#include <sys/time.h> seems to not be present on SVR3 systems */
/* and it's not used anyway as far as I can tell */

/* AIX insists that stropts.h be included before ioctl.h, because both */
/* define _IO but only ioctl.h checks first.  Oddly, they seem to be */
/* defined differently! */
#ifdef HAVE_STROPTS_H
#  include <sys/stropts.h>
#endif
#include <sys/ioctl.h>

#ifdef HAVE_SYS_FCNTL_H
#  include <sys/fcntl.h>
#else
#  include <fcntl.h>
#endif
#include <sys/file.h>
#include "exp_tty.h"

#include <errno.h>
#include <signal.h>

#if defined(SIGCLD) && !defined(SIGCHLD)
#define SIGCHLD SIGCLD
#endif

#ifdef HAVE_PTYTRAP
#include <sys/ptyio.h>
#endif

#ifdef CRAY
# ifndef TCSETCTTY
#  if defined(HAVE_TERMIOS)
#   include <termios.h>
#  else
#   include <termio.h>
#  endif
# endif
#endif

#ifdef HAVE_UNISTD_H
# include <unistd.h>
#endif

#include <math.h>		/* for log/pow computation in send -h */
#include <ctype.h>		/* all this for ispunct! */

#include "tclInt.h"		/* need OpenFile */
/*#include <varargs.h>		tclInt.h drags in varargs.h.  Since Pyramid */
/*				objects to including varargs.h twice, just */
/*				omit this one. */

#include "tcl.h"
#include "string.h"
#include "expect_tcl.h"
#include "exp_rename.h"
#include "exp_prog.h"
#include "exp_command.h"
#include "exp_log.h"
#include "exp_event.h"
#include "exp_pty.h"
#ifdef TCL_DEBUGGER
#include "tcldbg.h"
#endif

/*
 * These constants refer to the UTF string that encodes a null character.
 */

#define NULL_STRING "\300\200" /* hex C080 */
#define NULL_LENGTH 2

#define SPAWN_ID_VARNAME "spawn_id"

int exp_getptymaster();
int exp_getptyslave();

int exp_forked = FALSE;		/* whether we are child process */

/* the following are use to create reserved addresses, to be used as ClientData */
/* args to be used to tell commands how they were called. */
/* The actual values won't be used, only the addresses, but I give them */
/* values out of my irrational fear the compiler might collapse them all. */
static int sendCD_error = 2;	/* called as send_error */
static int sendCD_user = 3;	/* called as send_user */
static int sendCD_proc = 4;	/* called as send or send_spawn */
static int sendCD_tty = 6;	/* called as send_tty */

/*
 * expect_key is just a source for generating a unique stamp.  As each
 * expect/interact command begins, it generates a new key and marks all
 * the spawn ids of interest with it.  Then, if someone comes along and
 * marks them with yet a newer key, the old command will recognize this
 * reexamine the state of the spawned process.
 */
int expect_key = 0;

/*
 * exp_configure_count is incremented whenever a spawned process is closed
 * or an indirect list is modified.  This forces any (stack of) expect or
 * interact commands to reexamine the state of the world and adjust
 * accordingly.
 */
int exp_configure_count = 0;

#ifdef HAVE_PTYTRAP
/* slaveNames provides a mapping from the pty slave names to our */
/* spawn id entry.  This is needed only on HPs for stty, sigh. */
static Tcl_HashTable slaveNames;
#endif /* HAVE_PTYTRAP */

typedef struct ThreadSpecificData {
    /*
     * List of all exp channels currently open.  This is per thread and is
     * used to match up fd's to channels, which rarely occurs.
     */
    
    ExpState *stdinout;
    ExpState *stderrX;   /* grr....stderr is a macro */
    ExpState *devtty;
    ExpState *any; /* for any_spawn_id */

    Tcl_Channel *diagChannel;
    Tcl_DString diagDString;
    int diagEnabled;
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;

#ifdef FULLTRAPS
static void
init_traps(traps)
RETSIGTYPE (*traps[])();
{
	int i;

	for (i=1;i<NSIG;i++) {
		traps[i] = SIG_ERR;
	}
}
#endif

/* Do not terminate format strings with \n!!! */
/*VARARGS*/
void
exp_error TCL_VARARGS_DEF(Tcl_Interp *,arg1)
/*exp_error(va_alist)*/
/*va_dcl*/
{
	Tcl_Interp *interp;
	char *fmt;
	va_list args;
	char buffer[2000];

	interp = TCL_VARARGS_START(Tcl_Interp *,arg1,args);
	fmt = va_arg(args,char *);
	vsprintf(buffer,fmt,args);
	Tcl_SetResult(interp,buffer,TCL_VOLATILE);
	va_end(args);
}

/* returns current ExpState or 0.  If 0, may be immediately followed by return TCL_ERROR. */
struct ExpState *
expStateCurrent(interp,opened,adjust,any)
Tcl_Interp *interp;
int opened;
int adjust;
int any;
{
    static char *user_spawn_id = "exp0";

    char *name = exp_get_var(interp,SPAWN_ID_VARNAME);
    if (!name) name = user_spawn_id;

    return expStateFromChannelName(interp,name,opened,adjust,any,SPAWN_ID_VARNAME);
}

ExpState *
expStateCheck(interp,esPtr,open,adjust,msg)
    Tcl_Interp *interp;
    ExpState *esPtr;
    int open;
    int adjust;
    char *msg;
{
    if (open && !esPtr->open) {
	exp_error(interp,"%s: spawn id %s not open",msg,esPtr->name);
	return(0);
    }
    if (adjust) expAdjust(esPtr);
    return esPtr;
}

ExpState *
expStateFromChannelName(interp,name,open,adjust,any,msg)
    Tcl_Interp *interp;
    char *name;
    int open;
    int adjust;
    char *msg;
{
    ExpState *esPtr;
    Tcl_Channel channel;
    char *chanName;

    if (any) {
	if (0 == strcmp(name,EXP_SPAWN_ID_ANY_LIT)) {
	    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
	    return tsdPtr->any;
	}
    }

    channel = Tcl_GetChannel(interp,name,(int *)0);
    if (!channel) return(0);

    chanName = Tcl_GetChannelName(channel);
    if (!isExpChannelName(chanName)) {
	exp_error(interp,"%s: %s is not an expect channel - use spawn -open to convert",msg,chanName);
	return(0);
    }

    esPtr = (ExpState *)Tcl_GetChannelInstanceData(channel);

    return expStateCheck(interp,esPtr,open,adjust,msg);
}

/* zero out the wait status field */
static void
exp_wait_zero(status)
WAIT_STATUS_TYPE *status;
{
	int i;

	for (i=0;i<sizeof(WAIT_STATUS_TYPE);i++) {
		((char *)status)[i] = 0;
	}
}

/* called just before an ExpState entry is about to be invalidated */
void
exp_state_prep_for_invalidation(interp,esPtr)
Tcl_Interp *interp;
ExpState *esPtr;
{
    exp_ecmd_remove_state_direct_and_indirect(interp,esPtr);

    exp_configure_count++;

    if (esPtr->fg_armed) {
	exp_event_disarm_fg(esPtr);
    }
}

/*ARGSUSED*/
void
exp_trap_on(master)
int master;
{
#ifdef HAVE_PTYTRAP
	if (master == -1) return;
	exp_slave_control(master,1);
#endif /* HAVE_PTYTRAP */
}

int
exp_trap_off(name)
char *name;
{
#ifdef HAVE_PTYTRAP
    ExpState *esPtr;
    int enable = 0;

    Tcl_HashEntry *entry = Tcl_FindHashEntry(&slaveNames,name);
    if (!entry) {
	expDiagLog("exp_trap_off: no entry found for %s\n",name);
	return -1;
    }

    esPtr = (ExpState *)Tcl_GetHashValue(entry);
    
    exp_slave_control(esPtr->fdin,0);

    return esPtr->fdin;
#else
    return name[0];	/* pacify lint, use arg and return something */
#endif
}

static
void
expBusy(esPtr)
     ExpState *esPtr;
{     
  int x = open("/dev/null",0);
  if (x != esPtr->fdin) {
    fcntl(x,F_DUPFD,esPtr->fdin);
    close(x);
  }
  expCloseOnExec(esPtr->fdin);
  esPtr->fdBusy = TRUE;
}

int
exp_close(interp,esPtr)
Tcl_Interp *interp;
ExpState *esPtr;
{
    if (0 == expStateCheck(interp,esPtr,1,0,"close")) return TCL_ERROR;
    esPtr->open = FALSE;

    /*
     * Ignore close errors from ptys.  Ptys on some systems return errors for
     * no evident reason.  Anyway, receiving an error upon pty-close doesn't
     * mean anything anyway as far as I know.  
     */

    close(esPtr->fdin);
    if (esPtr->fd_slave != EXP_NOFD) close(esPtr->fd_slave);
    if (esPtr->fdin != esPtr->fdout) close(esPtr->fdout);

    if (esPtr->channel_orig && !esPtr->leaveopen) {
	/*
	 * Ignore close errors from Tcl channels.  They indicate things
	 * like broken pipelines, etc, which don't affect our
	 * subsequent handling.
	 */
	Tcl_VarEval(interp,"close ",Tcl_GetChannelName(esPtr->channel_orig),
		(char *)0);
    }

#ifdef HAVE_PTYTRAP
    if (esPtr->slave_name) {
	Tcl_HashEntry *entry;
	
	entry = Tcl_FindHashEntry(&slaveNames,esPtr->slave_name);
	Tcl_DeleteHashEntry(entry);

	ckfree(esPtr->slave_name);
	esPtr->slave_name = 0;
    }
#endif

    exp_state_prep_for_invalidation(interp,esPtr);

    if (esPtr->user_waited) {
	if (esPtr->registered) {
	    Tcl_UnregisterChannel(interp,esPtr->channel);
	    /* at this point esPtr may have been freed so don't touch it
               any longer */
	}
    } else {
      expBusy(esPtr);
    }

    return(TCL_OK);
}

/* report whether this ExpState represents special spawn_id_any */
/* we need a separate function because spawn_id_any is thread-specific */
/* and can't be seen outside this file */
expStateAnyIs(esPtr)
    ExpState *esPtr;
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    return (esPtr == tsdPtr->any);
}

expDevttyIs(esPtr)
    ExpState *esPtr;
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    return (esPtr == tsdPtr->devtty);
}

int
expStdinoutIs(esPtr)
ExpState *esPtr;
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    return (tsdPtr->stdinout == esPtr);
}

ExpState *
expStdinoutGet()
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    return tsdPtr->stdinout;
}

ExpState *
expDevttyGet()
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    return tsdPtr->devtty;
}

void
exp_init_spawn_id_vars(interp)
Tcl_Interp *interp;
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    Tcl_SetVar(interp, "user_spawn_id", tsdPtr->stdinout->name,0);
    Tcl_SetVar(interp,"error_spawn_id",  tsdPtr->stderrX->name,0);
    Tcl_SetVar(interp,  "any_spawn_id",   EXP_SPAWN_ID_ANY_LIT,0);

    /* user_spawn_id is NOT /dev/tty which could (at least in theory
     * anyway) be later re-opened on a different fd, while stdin might
     * have been redirected away from /dev/tty
     */

    if (exp_dev_tty != -1) {
	Tcl_SetVar(interp,"tty_spawn_id",tsdPtr->devtty->name,0);
    }
}

void
exp_init_spawn_ids(interp)
    Tcl_Interp *interp;
{
    static ExpState any_placeholder;  /* can be shared process-wide */
    
    /* note whether 0,1,2 are connected to a terminal so that if we */
    /* disconnect, we can shut these down.  We would really like to */
    /* test if 0,1,2 are our controlling tty, but I don't know any */
    /* way to do that portably.  Anyway, the likelihood of anyone */
    /* disconnecting after redirecting to a non-controlling tty is */
    /* virtually zero. */

    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    tsdPtr->stdinout = expCreateChannel(interp,0,1,isatty(0)?exp_getpid:EXP_NOPID);
    tsdPtr->stdinout->keepForever = 1;
    /* hmm, now here's an example of a output-only descriptor!! */
    tsdPtr->stderrX = expCreateChannel(interp,2,2,isatty(2)?exp_getpid:EXP_NOPID);
    tsdPtr->stderrX->keepForever = 1;

    if (exp_dev_tty != -1) {
	tsdPtr->devtty = expCreateChannel(interp,exp_dev_tty,exp_dev_tty,exp_getpid);
	tsdPtr->devtty->keepForever = 1;
    }

    /* set up a dummy channel to give us something when we need to find out if
       people have passed us "any_spawn_id" */
    tsdPtr->any = &any_placeholder;
}

void
expCloseOnExec(fd)
int fd;
{
     (void) fcntl(fd,F_SETFD,1);
}

#define STTY_INIT	"stty_init"

#if 0
/*
 * DEBUGGING UTILITIES - DON'T DELETE */
static void
show_pgrp(fd,string)
int fd;
char *string;
{
	int pgrp;

	fprintf(stderr,"getting pgrp for %s\n",string);
	if (-1 == ioctl(fd,TIOCGETPGRP,&pgrp)) perror("TIOCGETPGRP");
	else fprintf(stderr,"%s pgrp = %d\n",string,pgrp);
	if (-1 == ioctl(fd,TIOCGPGRP,&pgrp)) perror("TIOCGPGRP");
	else fprintf(stderr,"%s pgrp = %d\n",string,pgrp);
	if (-1 == tcgetpgrp(fd,pgrp)) perror("tcgetpgrp");
	else fprintf(stderr,"%s pgrp = %d\n",string,pgrp);
}

static void
set_pgrp(fd)
int fd;
{
	int pgrp = getpgrp(0);
	if (-1 == ioctl(fd,TIOCSETPGRP,&pgrp)) perror("TIOCSETPGRP");
	if (-1 == ioctl(fd,TIOCSPGRP,&pgrp)) perror("TIOCSPGRP");
	if (-1 == tcsetpgrp(fd,pgrp)) perror("tcsetpgrp");
}
#endif

static
void
expSetpgrp()
{
#ifdef MIPS_BSD
    /* required on BSD side of MIPS OS <[email protected]> */
#   include <sysv/sys.s>
    syscall(SYS_setpgrp);
#endif

#ifdef SETPGRP_VOID
    (void) setpgrp();
#else
    (void) setpgrp(0,0);
#endif
}


/*ARGSUSED*/
static void
set_slave_name(esPtr,name)
ExpState *esPtr;
char *name;
{
#ifdef HAVE_PTYTRAP
	int newptr;
	Tcl_HashEntry *entry;

	/* save slave name */
	esPtr->slave_name = ckalloc(strlen(exp_pty_slave_name)+1);
	strcpy(esPtr->slave_name,exp_pty_slave_name);

	entry = Tcl_CreateHashEntry(&slaveNames,exp_pty_slave_name,&newptr);
	Tcl_SetHashValue(entry,(ClientData)esPtr);
#endif /* HAVE_PTYTRAP */
}

/* arguments are passed verbatim to execvp() */
/*ARGSUSED*/
static int
Exp_SpawnCmd(clientData,interp,argc,argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
    ExpState *esPtr = 0;
    int slave;
    int pid;
    char **a;
    /* tell Saber to ignore non-use of ttyfd */
    /*SUPPRESS 591*/
    int errorfd;	/* place to stash fileno(stderr) in child */
			/* while we're setting up new stderr */
    int ttyfd;
    int master;
    int write_master;	/* write fd of Tcl-opened files */
    int ttyinit = TRUE;
    int ttycopy = TRUE;
    int echo = TRUE;
    int console = FALSE;
    int pty_only = FALSE;

#ifdef FULLTRAPS
				/* Allow user to reset signals in child */
				/* The following array contains indicates */
				/* whether sig should be DFL or IGN */
				/* ERR is used to indicate no initialization */
    RETSIGTYPE (*traps[NSIG])();
#endif
    int ignore[NSIG];		/* if true, signal in child is ignored */
				/* if false, signal gets default behavior */
    int i;			/* trusty overused temporary */

    char *argv0 = argv[0];
    char *chanName = 0;
    int leaveopen = FALSE;
    int rc, wc;
    char *stty_init;
    int slave_write_ioctls = 1;
		/* by default, slave will be write-ioctled this many times */
    int slave_opens = 3;
		/* by default, slave will be opened this many times */
		/* first comes from initial allocation */
		/* second comes from stty */
		/* third is our own signal that stty is done */

    int sync_fds[2];
    int sync2_fds[2];
    int status_pipe[2];
    int child_errno;
    char sync_byte;

    Tcl_Channel channel;
    Tcl_DString dstring;
    Tcl_DStringInit(&dstring);

#ifdef FULLTRAPS
    init_traps(&traps);
#endif
    /* don't ignore any signals in child by default */
    for (i=1;i<NSIG;i++) {
	ignore[i] = FALSE;
    }

    argc--; argv++;

    for (;argc>0;argc--,argv++) {
	if (streq(*argv,"-nottyinit")) {
	    ttyinit = FALSE;
	    slave_write_ioctls--;
	    slave_opens--;
	} else if (streq(*argv,"-nottycopy")) {
	    ttycopy = FALSE;
	} else if (streq(*argv,"-noecho")) {
	    echo = FALSE;
	} else if (streq(*argv,"-console")) {
	    console = TRUE;
	} else if (streq(*argv,"-pty")) {
	    pty_only = TRUE;
	} else if (streq(*argv,"-open")) {
	    if (argc < 2) {
		exp_error(interp,"usage: -open file-identifier");
		return TCL_ERROR;
	    }
	    chanName = argv[1];
	    argc--; argv++;
	} else if (streq(*argv,"-leaveopen")) {
	    if (argc < 2) {
		exp_error(interp,"usage: -open file-identifier");
		return TCL_ERROR;
	    }
	    chanName = argv[1];
	    leaveopen = TRUE;
	    argc--; argv++;
	} else if (streq(*argv,"-ignore")) {
	    int sig;

	    if (argc < 2) {
		exp_error(interp,"usage: -ignore signal");
		return TCL_ERROR;
	    }
	    sig = exp_string_to_signal(interp,argv[1]);
	    if (sig == -1) {
		exp_error(interp,"usage: -ignore %s: unknown signal name",argv[1]);
		return TCL_ERROR;
	    }
	    ignore[sig] = TRUE;
	    argc--; argv++;
#ifdef FULLTRAPS
	} else if (streq(*argv,"-trap")) {
	    /* argv[1] is action */
	    /* argv[2] is list of signals */

	    RETSIGTYPE (*sig_handler)();
	    int n;		/* number of signals in list */
	    char **list;	/* list of signals */
	    
	    if (argc < 3) {
		exp_error(interp,"usage: -trap siglist SIG_DFL or SIG_IGN");
		return TCL_ERROR;
	    }

	    if (0 == strcmp(argv[2],"SIG_DFL")) {
		sig_handler = SIG_DFL;
	    } else if (0 == strcmp(argv[2],"SIG_IGN")) {
		sig_handler = SIG_IGN;
	    } else {
		exp_error(interp,"usage: -trap siglist SIG_DFL or SIG_IGN");
		return TCL_ERROR;
	    }

	    if (TCL_OK != Tcl_SplitList(interp,argv[1],&n,&list)) {
		expErrorLogU(interp->result);
		expErrorLogU("\r\n");
		exp_error(interp,"usage: -trap {siglist} ...");
		return TCL_ERROR;
	    }
	    for (i=0;i<n;i++) {
		int sig = exp_string_to_signal(interp,list[i]);
		if (sig == -1) {
		    ckfree((char *)&list);
		    return TCL_ERROR;
		}
		traps[sig] = sig_handler;
	    }
	    ckfree((char *)&list);

	    argc--; argv++;
	    argc--; argv++;
#endif /*FULLTRAPS*/
	} else break;
    }

    if (chanName && (argc != 0)) {
	exp_error(interp,"usage: -[leave]open [fileXX]");
	return TCL_ERROR;
    }

    if (!pty_only && !chanName && (argc == 0)) {
	exp_error(interp,"usage: spawn [spawn-args] program [program-args]");
	return(TCL_ERROR);
    }

    stty_init = exp_get_var(interp,STTY_INIT);
    if (stty_init) {
	slave_write_ioctls++;
	slave_opens++;
    }

/* any extraneous ioctl's that occur in slave must be accounted for
when trapping, see below in child half of fork */
#if defined(TIOCSCTTY) && !defined(CIBAUD) && !defined(sun) && !defined(hp9000s300)
    slave_write_ioctls++;
    slave_opens++;
#endif

    exp_pty_slave_name = 0;
    
    Tcl_ReapDetachedProcs();

    if (!chanName) {
	if (echo) {
	    expStdoutLogU(argv0,0);
	    for (a = argv;*a;a++) {
		expStdoutLogU(" ",0);
		expStdoutLogU(*a,0);
	    }
	    expStdoutLogU("\r\n",0);
	}

	if (0 > (master = exp_getptymaster())) {
	    /*
	     * failed to allocate pty, try and figure out why
	     * so we can suggest to user what to do about it.
	     */

	    int testfd;
		
	    if (exp_pty_error) {
		exp_error(interp,"%s",exp_pty_error);
		return TCL_ERROR;
	    }

	    if (expChannelCountGet() > 10) {
		exp_error(interp,"The system only has a finite number of ptys and you have many of them in use.  The usual reason for this is that you forgot (or didn't know) to call \"wait\" after closing each of them.");
		return TCL_ERROR;
	    }

	    testfd = open("/",0);
	    close(testfd);

	    if (testfd != -1) {
		exp_error(interp,"The system has no more ptys.  Ask your system administrator to create more.");
	    } else {
		exp_error(interp,"- You have too many files are open.  Close some files or increase your per-process descriptor limit.");
	    }
	    return(TCL_ERROR);
	}

	/* ordinarily channel creation takes care of close-on-exec
	 * but because that will occur *after* fork, force close-on-exec
	 * now in this case.
	 */
	expCloseOnExec(master);

#define SPAWN_OUT "spawn_out"
	Tcl_SetVar2(interp,SPAWN_OUT,"slave,name",exp_pty_slave_name,0);

	if (pty_only) {
	  write_master = master;
	}
    } else {
	/*
	 * process "-open $channel"
	 */
	int mode;
	int rfd, wfd;
	
	if (echo) {
	    expStdoutLogU(argv0,0);
	    expStdoutLogU(" [open ...]\r\n",0);
	}
	if (!(channel = Tcl_GetChannel(interp,chanName,&mode))) {
	    return TCL_ERROR;
	}
	if (!mode) {
	    exp_error(interp,"channel is neither readable nor writable");
	    return TCL_ERROR;
	}
	if (mode & TCL_READABLE) {
	    if (TCL_ERROR == Tcl_GetChannelHandle(channel, TCL_READABLE, (ClientData) &rfd)) {
		return TCL_ERROR;
	    }
	}
	if (mode & TCL_WRITABLE) {
	    if (TCL_ERROR == Tcl_GetChannelHandle(channel, TCL_WRITABLE, (ClientData) &wfd)) {
		return TCL_ERROR;
	    }    
	}
	master = ((mode & TCL_READABLE)?rfd:wfd);

	/* make a new copy of file descriptor */
	if (-1 == (write_master = master = dup(master))) {
	    exp_error(interp,"fdopen: %s",Tcl_PosixError(interp));
	    return TCL_ERROR;
	}

	/* if writefilePtr is different, dup that too */
	if ((mode & TCL_READABLE) && (mode & TCL_WRITABLE) && (wfd != rfd)) {
	    if (-1 == (write_master = dup(wfd))) {
		exp_error(interp,"fdopen: %s",Tcl_PosixError(interp));
		return TCL_ERROR;
	    }
	}

	/*
	 * It would be convenient now to tell Tcl to close its
	 * file descriptor.  Alas, if involved in a pipeline, Tcl
	 * will be unable to complete a wait on the process.
	 * So simply remember that we meant to close it.  We will
	 * do so later in our own close routine.
	 */
    }
	
    if (chanName || pty_only) {
	esPtr = expCreateChannel(interp,master,write_master,EXP_NOPID);
	    
	if (chanName) {
	    esPtr->channel_orig = channel;
	    esPtr->leaveopen = leaveopen;
	}

	if (exp_pty_slave_name) set_slave_name(esPtr,exp_pty_slave_name);

	/* make it appear as if process has been waited for */
	esPtr->sys_waited = TRUE;
	exp_wait_zero(&esPtr->wait);

	/* tell user of new spawn id */
	Tcl_SetVar(interp,SPAWN_ID_VARNAME,esPtr->name,0);

	if (!chanName) {
	    char value[20];

	    /*
	     * open the slave side in the same process to support
	     * the -pty flag.
	     */

	    if (0 > (esPtr->fd_slave = exp_getptyslave(ttycopy,ttyinit,
		    stty_init))) {
		exp_error(interp,"open(slave pty): %s\r\n",Tcl_PosixError(interp));
		return TCL_ERROR;
	    }

	    exp_slave_control(master,1);
	    
	    sprintf(value,"%d",esPtr->fd_slave);
	    Tcl_SetVar2(interp,SPAWN_OUT,"slave,fd",value,0);
	}
	sprintf(interp->result,"%d",EXP_NOPID);
	expDiagLog("spawn: returns {%s}\r\n",interp->result);

	return TCL_OK;
    }

    if (NULL == (argv[0] = Tcl_TranslateFileName(interp,argv[0],&dstring))) {
	goto parent_error;
    }

    if (-1 == pipe(sync_fds)) {
	exp_error(interp,"too many programs spawned?  could not create pipe: %s",Tcl_PosixError(interp));
	goto parent_error;
    }

    if (-1 == pipe(sync2_fds)) {
	close(sync_fds[0]);
	close(sync_fds[1]);
	exp_error(interp,"too many programs spawned?  could not create pipe: %s",Tcl_PosixError(interp));
	goto parent_error;
    }

    if (-1 == pipe(status_pipe)) {
	close(sync_fds[0]);
	close(sync_fds[1]);
	close(sync2_fds[0]);
	close(sync2_fds[1]);
    }

    if ((pid = fork()) == -1) {
	exp_error(interp,"fork: %s",Tcl_PosixError(interp));
	goto parent_error;
    }

    if (pid) { /* parent */
	    close(sync_fds[1]);
	    close(sync2_fds[0]);
	    close(status_pipe[1]);

	    esPtr = expCreateChannel(interp,master,master,pid);

	    if (exp_pty_slave_name) set_slave_name(esPtr,exp_pty_slave_name);

#ifdef CRAY
	    setptypid(pid);
#endif

	    /*
	     * wait for slave to initialize pty before allowing
	     * user to send to it
	     */ 

	    expDiagLog("parent: waiting for sync byte\r\n");
	    while (((rc = read(sync_fds[0],&sync_byte,1)) < 0) && (errno == EINTR)) {
		/* empty */;
	    }
	    if (rc == -1) {
		expErrorLogU("parent: sync byte read: ");
		expErrorLogU(Tcl_ErrnoMsg(errno));
		expErrorLogU("\r\n");
		exit(-1);
	    }

	    /* turn on detection of eof */
	    exp_slave_control(master,1);

	    /*
	     * tell slave to go on now now that we have initialized pty
	     */

	    expDiagLog("parent: telling child to go ahead\r\n");
	    wc = write(sync2_fds[1]," ",1);
	    if (wc == -1) {
		expErrorLog("parent: sync byte write: %s\r\n",Tcl_ErrnoMsg(errno));
		exit(-1);
	    }

	    expDiagLog("parent: now unsynchronized from child\r\n");
	    close(sync_fds[0]);
	    close(sync2_fds[1]);

	    /* see if child's exec worked */
	retry:
	    switch (read(status_pipe[0],&child_errno,sizeof child_errno)) {
		case -1:
		    if (errno == EINTR) goto retry;
		    /* well it's not really the child's errno */
		    /* but it can be treated that way */
		    child_errno = errno;
		    break;
		case 0:
		    /* child's exec succeeded */
		    child_errno = 0;
		    break;
		default:
		    /* child's exec failed; err contains exec's errno  */
		    waitpid(pid, NULL, 0);
		    /* in order to get Tcl to set errorcode, we must */
		    /* hand set errno */
		    errno = child_errno;
		    exp_error(interp, "couldn't execute \"%s\": %s",
			    argv[0],Tcl_PosixError(interp));
		    goto parent_error;
	    }
	    close(status_pipe[0]);

	    /* tell user of new spawn id */
	    Tcl_SetVar(interp,SPAWN_ID_VARNAME,esPtr->name,0);

	    sprintf(interp->result,"%d",pid);
	    expDiagLog("spawn: returns {%s}\r\n",interp->result);

	    Tcl_DStringFree(&dstring);
	    return(TCL_OK);
	}

	/* child process - do not return from here!  all errors must exit() */

	close(sync_fds[0]);
	close(sync2_fds[1]);
	close(status_pipe[0]);
	expCloseOnExec(status_pipe[1]);

	if (exp_dev_tty != -1) {
		close(exp_dev_tty);
		exp_dev_tty = -1;
	}

#ifdef CRAY
	(void) close(master);
#endif

/* ultrix (at least 4.1-2) fails to obtain controlling tty if setsid */
/* is called.  setpgrp works though.  */
#if defined(POSIX) && !defined(ultrix)
#define DO_SETSID
#endif
#ifdef __convex__
#define DO_SETSID
#endif

#ifdef DO_SETSID
	setsid();
#else
#ifdef SYSV3
#ifndef CRAY
	expSetpgrp();
#endif /* CRAY */
#else /* !SYSV3 */
	expSetpgrp();

/* Pyramid lacks this defn */
#ifdef TIOCNOTTY
	ttyfd = open("/dev/tty", O_RDWR);
	if (ttyfd >= 0) {
		(void) ioctl(ttyfd, TIOCNOTTY, (char *)0);
		(void) close(ttyfd);
	}
#endif /* TIOCNOTTY */

#endif /* SYSV3 */
#endif /* DO_SETSID */

	/* save stderr elsewhere to avoid BSD4.4 bogosity that warns */
	/* if stty finds dev(stderr) != dev(stdout) */

	/* save error fd while we're setting up new one */
	errorfd = fcntl(2,F_DUPFD,3);
	/* and here is the macro to restore it */
#define restore_error_fd {close(2);fcntl(errorfd,F_DUPFD,2);}

	close(0);
	close(1);
	close(2);

	/* since we closed fd 0, open of pty slave must return fd 0 */

	/* since exp_getptyslave may have to run stty, (some of which work on fd */
	/* 0 and some of which work on 1) do the dup's inside exp_getptyslave. */

	if (0 > (slave = exp_getptyslave(ttycopy,ttyinit,stty_init))) {
		restore_error_fd

		if (exp_pty_error) {
			expErrorLog("open(slave pty): %s\r\n",exp_pty_error);
		} else {
			expErrorLog("open(slave pty): %s\r\n",Tcl_ErrnoMsg(errno));
		}
		exit(-1);
	}
	/* sanity check */
	if (slave != 0) {
		restore_error_fd
		expErrorLog("exp_getptyslave: slave = %d but expected 0\n",slave);
		exit(-1);
	}

/* The test for hpux may have to be more specific.  In particular, the */
/* code should be skipped on the hp9000s300 and hp9000s720 (but there */
/* is no documented define for the 720!) */

/*#if defined(TIOCSCTTY) && !defined(CIBAUD) && !defined(sun) && !defined(hpux)*/
#if defined(TIOCSCTTY) && !defined(sun) && !defined(hpux)
	/* 4.3+BSD way to acquire controlling terminal */
	/* according to Stevens - Adv. Prog..., p 642 */
	/* Oops, it appears that the CIBAUD is on Linux also */
	/* so let's try without... */
#ifdef __QNX__
	if (tcsetct(0, getpid()) == -1) {
	  restore_error_fd
	  expErrorLog("failed to get controlling terminal using TIOCSCTTY");
	  exit(-1);
	}
#else
	(void) ioctl(0,TIOCSCTTY,(char *)0);
	/* ignore return value - on some systems, it is defined but it
	 * fails and it doesn't seem to cause any problems.  Or maybe
	 * it works but returns a bogus code.  Noone seems to be able
	 * to explain this to me.  The systems are an assortment of
	 * different linux systems (and FreeBSD 2.5), RedHat 5.2 and
	 * Debian 2.0
	 */
#endif
#endif

#ifdef CRAY
 	(void) setsid();
 	(void) ioctl(0,TCSETCTTY,0);
 	(void) close(0);
 	if (open("/dev/tty", O_RDWR) < 0) {
		restore_error_fd
 		expErrorLog("open(/dev/tty): %s\r\n",Tcl_ErrnoMsg(errno));
 		exit(-1);
 	}
 	(void) close(1);
 	(void) close(2);
 	(void) dup(0);
 	(void) dup(0);
	setptyutmp();	/* create a utmp entry */

	/* _CRAY2 code from Hal Peterson <[email protected]>, Cray Research, Inc. */
#ifdef _CRAY2
	/*
	 * Interpose a process between expect and the spawned child to
	 * keep the slave side of the pty open to allow time for expect
	 * to read the last output.  This is a workaround for an apparent
	 * bug in the Unicos pty driver on Cray-2's under Unicos 6.0 (at
	 * least).
	 */
	if ((pid = fork()) == -1) {
		restore_error_fd
		expErrorLog("second fork: %s\r\n",Tcl_ErrnoMsg(errno));
		exit(-1);
	}

	if (pid) {
 		/* Intermediate process. */
		int status;
		int timeout;
		char *t;

		/* How long should we wait? */
		if (t = exp_get_var(interp,"pty_timeout"))
			timeout = atoi(t);
		else if (t = exp_get_var(interp,"timeout"))
			timeout = atoi(t)/2;
		else
			timeout = 5;

		/* Let the spawned process run to completion. */
 		while (wait(&status) < 0 && errno == EINTR)
			/* empty body */;

		/* Wait for the pty to clear. */
		sleep(timeout);

		/* Duplicate the spawned process's status. */
		if (WIFSIGNALED(status))
			kill(getpid(), WTERMSIG(status));

		/* The kill may not have worked, but this will. */
 		exit(WEXITSTATUS(status));
	}
#endif /* _CRAY2 */
#endif /* CRAY */

	if (console) exp_console_set();

#ifdef FULLTRAPS
	for (i=1;i<NSIG;i++) {
		if (traps[i] != SIG_ERR) {
			signal(i,traps[i]);
		}
	}
#endif /* FULLTRAPS */

	for (i=1;i<NSIG;i++) {
		signal(i,ignore[i]?SIG_IGN:SIG_DFL);
	}

	/*
	 * avoid fflush of cmdfile, logfile, & diagfile since this screws up
	 * the parents seek ptr.  There is no portable way to fclose a shared
	 * read-stream!!!!
	 */

	/* (possibly multiple) masters are closed automatically due to */
	/* earlier fcntl(,,CLOSE_ON_EXEC); */

	/* tell parent that we are done setting up pty */
	/* The actual char sent back is irrelevant. */

	/* expDiagLog("child: telling parent that pty is initialized\r\n");*/
	wc = write(sync_fds[1]," ",1);
	if (wc == -1) {
		restore_error_fd
		expErrorLog("child: sync byte write: %s\r\n",Tcl_ErrnoMsg(errno));
		exit(-1);
	}
	close(sync_fds[1]);

	/* wait for master to let us go on */
	while (((rc = read(sync2_fds[0],&sync_byte,1)) < 0) && (errno == EINTR)) {
		/* empty */;
	}

	if (rc == -1) {
		restore_error_fd
		expErrorLog("child: sync byte read: %s\r\n",Tcl_ErrnoMsg(errno));
		exit(-1);
	}
	close(sync2_fds[0]);

	/* expDiagLog("child: now unsynchronized from parent\r\n"); */

        (void) execvp(argv[0],argv);

	/* Alas, by now we've closed fd's to stderr, logfile and diagfile.
	 * The only reasonable thing to do is to send back the error as part of
	 * the program output.  This will be picked up in an expect or interact
	 * command.
	 */

	/* if exec failed, communicate the reason back to the parent */
	write(status_pipe[1], &errno, sizeof errno);
	exit(-1);
	/*NOTREACHED*/
parent_error:
    Tcl_DStringFree(&dstring);
    if (esPtr) {
        exp_close(interp,esPtr);
	waitpid(esPtr->pid,&esPtr->wait,0);
	if (esPtr->registered) {
	    Tcl_UnregisterChannel(interp,esPtr->channel);
	}
    }
    return TCL_ERROR;
}

/*ARGSUSED*/
static int
Exp_ExpPidCmd(clientData,interp,argc,argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
    char *chanName = 0;
    ExpState *esPtr = 0;

    argc--; argv++;

    for (;argc>0;argc--,argv++) {
	if (streq(*argv,"-i")) {
	    argc--; argv++;
	    if (!*argv) goto usage;
	    chanName = *argv;
	} else goto usage;
    }

    if (chanName) {
	if (!(esPtr = expStateFromChannelName(interp,chanName,0,0,0,"exp_pid"))) return TCL_ERROR;
    } else {
	if (!(esPtr = expStateCurrent(interp,0,0,0))) return TCL_ERROR;
    }
    
    sprintf(interp->result,"%d",esPtr->pid);
    return TCL_OK;
  usage:
    exp_error(interp,"usage: -i spawn_id");
    return TCL_ERROR;
}

/*ARGSUSED*/
static int
Exp_GetpidDeprecatedCmd(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
	expDiagLog("getpid is deprecated, use pid\r\n");
	sprintf(interp->result,"%d",getpid());
	return(TCL_OK);
}

/*ARGSUSED*/
static int
Exp_SleepCmd(clientData,interp,argc,argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
	argc--; argv++;

	if (argc != 1) {
		exp_error(interp,"must have one arg: seconds");
		return TCL_ERROR;
	}

	return(exp_dsleep(interp,(double)atof(*argv)));
}

/* if this works, exact_write should disappear and function should
   call Tcl_WriteChars directly */
static int
exact_write(esPtr,buffer,rembytes) /* INTL */
ExpState *esPtr;
char *buffer;
int rembytes;
{
    Tcl_WriteChars(esPtr->channel,buffer,rembytes);
    return(0);
}

struct slow_arg {
    int size;
    double time;
};

/* returns 0 for success, -1 for failure */
static int
get_slow_args(interp,x)
Tcl_Interp *interp;
struct slow_arg *x;
{
	int sc;		/* return from scanf */
	char *s = exp_get_var(interp,"send_slow");
	if (!s) {
		exp_error(interp,"send -s: send_slow has no value");
		return(-1);
	}
	if (2 != (sc = sscanf(s,"%d %lf",&x->size,&x->time))) {
		exp_error(interp,"send -s: found %d value(s) in send_slow but need 2",sc);
		return(-1);
	}
	if (x->size <= 0) {
		exp_error(interp,"send -s: size (%d) in send_slow must be positive", x->size);
		return(-1);
	}
	if (x->time <= 0) {
		exp_error(interp,"send -s: time (%f) in send_slow must be larger",x->time);
		return(-1);
	}
	return(0);
}

/* returns 0 for success, -1 for failure, pos. for Tcl return value */
static int
slow_write(interp,esPtr,buffer,rembytes,arg) /* INTL */
Tcl_Interp *interp;
ExpState *esPtr;
char *buffer;
int rembytes;
struct slow_arg *arg;
{
	int rc;

	while (rembytes > 0) {
		int len;
		
		len = (arg->size<rembytes?arg->size:rembytes);
		if (0 > exact_write(esPtr,buffer,len)) return(-1);
		rembytes -= arg->size;
		buffer += arg->size;

		/* skip sleep after last write */
		if (rembytes > 0) {
			rc = exp_dsleep(interp,arg->time);
			if (rc>0) return rc;
		}
	}
	return(0);
}

struct human_arg {
	float alpha;		/* average interarrival time in seconds */
	float alpha_eow;	/* as above but for eow transitions */
	float c;		/* shape */
	float min, max;
};

/* returns -1 if error, 0 if success */
static int
get_human_args(interp,x)
Tcl_Interp *interp;
struct human_arg *x;
{
	int sc;		/* return from scanf */
	char *s = exp_get_var(interp,"send_human");

	if (!s) {
		exp_error(interp,"send -h: send_human has no value");
		return(-1);
	}
	if (5 != (sc = sscanf(s,"%f %f %f %f %f",
			&x->alpha,&x->alpha_eow,&x->c,&x->min,&x->max))) {
		if (sc == EOF) sc = 0;	/* make up for overloaded return */
		exp_error(interp,"send -h: found %d value(s) in send_human but need 5",sc);
		return(-1);
	}
	if (x->alpha < 0 || x->alpha_eow < 0) {
		exp_error(interp,"send -h: average interarrival times (%f %f) must be non-negative in send_human", x->alpha,x->alpha_eow);
		return(-1);
	}
	if (x->c <= 0) {
		exp_error(interp,"send -h: variability (%f) in send_human must be positive",x->c);
		return(-1);
	}
	x->c = 1/x->c;

	if (x->min < 0) {
		exp_error(interp,"send -h: minimum (%f) in send_human must be non-negative",x->min);
		return(-1);
	}
	if (x->max < 0) {
		exp_error(interp,"send -h: maximum (%f) in send_human must be non-negative",x->max);
		return(-1);
	}
	if (x->max < x->min) {
		exp_error(interp,"send -h: maximum (%f) must be >= minimum (%f) in send_human",x->max,x->min);
		return(-1);
	}
	return(0);
}

/* Compute random numbers from 0 to 1, for expect's send -h */
/* This implementation sacrifices beauty for portability */
static float
unit_random()
{
	/* current implementation is pathetic but works */
	/* 99991 is largest prime in my CRC - can't hurt, eh? */
	return((float)(1+(rand()%99991))/99991.0);
}

void
exp_init_unit_random()
{
	srand(getpid());
}

/* This function is my implementation of the Weibull distribution. */
/* I've added a max time and an "alpha_eow" that captures the slight */
/* but noticable change in human typists when hitting end-of-word */
/* transitions. */
/* returns 0 for success, -1 for failure, pos. for Tcl return value */
static int
human_write(interp,esPtr,buffer,arg) /* INTL */
Tcl_Interp *interp;
ExpState *esPtr;
char *buffer;
struct human_arg *arg;
{
    char *sp;
    int size;
    float t;
    float alpha;
    int wc;
    int in_word = TRUE;
    Tcl_UniChar ch;

    expDiagLog("human_write: avg_arr=%f/%f  1/shape=%f  min=%f  max=%f\r\n",
	    arg->alpha,arg->alpha_eow,arg->c,arg->min,arg->max);

    for (sp = buffer;*sp;sp += size) {
	size = Tcl_UtfToUniChar(sp, &ch);
	/* use the end-of-word alpha at eow transitions */
	if (in_word && (Tcl_UniCharIsPunct(ch) || Tcl_UniCharIsSpace(ch)))
	    alpha = arg->alpha_eow;
	else alpha = arg->alpha;
	in_word = !(Tcl_UniCharIsPunct(ch) || Tcl_UniCharIsSpace(ch));

	t = alpha * pow(-log((double)unit_random()),arg->c);

	/* enforce min and max times */
	if (t<arg->min) t = arg->min;
	else if (t>arg->max) t = arg->max;

		/* skip sleep before writing first character */
	if (sp != buffer) {
	    wc = exp_dsleep(interp,(double)t);
	    if (wc > 0) return wc;
	}

	wc = Tcl_WriteChars(esPtr->channel, sp, size);
	if (0 > wc) return(wc);
    }
    return(0);
}

struct exp_i *exp_i_pool = 0;
struct exp_state_list *exp_state_list_pool = 0;

#define EXP_I_INIT_COUNT	10
#define EXP_FD_INIT_COUNT	10

struct exp_i *
exp_new_i()
{
	int n;
	struct exp_i *i;

	if (!exp_i_pool) {
		/* none avail, generate some new ones */
		exp_i_pool = i = (struct exp_i *)ckalloc(
			EXP_I_INIT_COUNT * sizeof(struct exp_i));
		for (n=0;n<EXP_I_INIT_COUNT-1;n++,i++) {
			i->next = i+1;
		}
		i->next = 0;
	}

	/* now that we've made some, unlink one and give to user */

	i = exp_i_pool;
	exp_i_pool = exp_i_pool->next;
	i->value = 0;
	i->variable = 0;
	i->state_list = 0;
	i->ecount = 0;
	i->next = 0;
	return i;
}

struct exp_state_list *
exp_new_state(esPtr)
ExpState *esPtr;
{
    int n;
    struct exp_state_list *fd;

    if (!exp_state_list_pool) {
	/* none avail, generate some new ones */
	exp_state_list_pool = fd = (struct exp_state_list *)ckalloc(
	    EXP_FD_INIT_COUNT * sizeof(struct exp_state_list));
	for (n=0;n<EXP_FD_INIT_COUNT-1;n++,fd++) {
	    fd->next = fd+1;
	}
	fd->next = 0;
    }

    /* now that we've made some, unlink one and give to user */

    fd = exp_state_list_pool;
    exp_state_list_pool = exp_state_list_pool->next;
    fd->esPtr = esPtr;
    /* fd->next is assumed to be changed by caller */
    return fd;
}

void
exp_free_state(fd_first)
struct exp_state_list *fd_first;
{
	struct exp_state_list *fd, *penultimate;

	if (!fd_first) return;

	/* link entire chain back in at once by first finding last pointer */
	/* making that point back to pool, and then resetting pool to this */

	/* run to end */
	for (fd = fd_first;fd;fd=fd->next) {
		penultimate = fd;
	}
	penultimate->next = exp_state_list_pool;
	exp_state_list_pool = fd_first;
}

/* free a single fd */
void
exp_free_state_single(fd)
struct exp_state_list *fd;
{
	fd->next = exp_state_list_pool;
	exp_state_list_pool = fd;
}

void
exp_free_i(interp,i,updateproc)
Tcl_Interp *interp;
struct exp_i *i;
Tcl_VarTraceProc *updateproc;	/* proc to invoke if indirect is written */
{
	if (i->next) exp_free_i(interp,i->next,updateproc);

	exp_free_state(i->state_list);

	if (i->direct == EXP_INDIRECT) {
		Tcl_UntraceVar(interp,i->variable,
			TCL_GLOBAL_ONLY|TCL_TRACE_WRITES,
			updateproc,(ClientData)i);
	}

	/* here's the long form
	   if duration & direct	free(var)  free(val)
		PERM	  DIR	    		1
		PERM	  INDIR	    1		1
		TMP	  DIR
		TMP	  INDIR			1
	   Also if i->variable was a bogus variable name, i->value might not be
	   set, so test i->value to protect this
	   TMP in this case does NOT mean from the "expect" command.  Rather
	   it means "an implicit spawn id from any expect or expect_XXX
	   command".  In other words, there was no variable name provided.
	*/
	if (i->value
	   && (((i->direct == EXP_DIRECT) && (i->duration == EXP_PERMANENT))
		|| ((i->direct == EXP_INDIRECT) && (i->duration == EXP_TEMPORARY)))) {
		ckfree(i->value);
	} else if (i->duration == EXP_PERMANENT) {
		if (i->value) ckfree(i->value);
		if (i->variable) ckfree(i->variable);
	}

	i->next = exp_i_pool;
	exp_i_pool = i;
}

/* generate a descriptor for a "-i" flag */
/* cannot fail */
struct exp_i *
exp_new_i_complex(interp,arg,duration,updateproc)
Tcl_Interp *interp;
char *arg;		/* spawn id list or a variable containing a list */
int duration;		/* if we have to copy the args */
			/* should only need do this in expect_before/after */
Tcl_VarTraceProc *updateproc;	/* proc to invoke if indirect is written */
{
	struct exp_i *i;
	char **stringp;

	i = exp_new_i();

	i->direct = (isExpChannelName(arg)?EXP_DIRECT:EXP_INDIRECT);
#if OBSOLETE
	i->direct = (isdigit(arg[0]) || (arg[0] == '-'))?EXP_DIRECT:EXP_INDIRECT;
#endif
	if (i->direct == EXP_DIRECT) {
		stringp = &i->value;
	} else {
		stringp = &i->variable;
	}

	i->duration = duration;
	if (duration == EXP_PERMANENT) {
		*stringp = ckalloc(strlen(arg)+1);
		strcpy(*stringp,arg);
	} else {
		*stringp = arg;
	}

	i->state_list = 0;
	exp_i_update(interp,i);

	/* if indirect, ask Tcl to tell us when variable is modified */

	if (i->direct == EXP_INDIRECT) {
		Tcl_TraceVar(interp, i->variable,
			TCL_GLOBAL_ONLY|TCL_TRACE_WRITES,
			updateproc, (ClientData) i);
	}

	return i;
}

void
exp_i_add_state(i,esPtr)
struct exp_i *i;
ExpState *esPtr;
{
	struct exp_state_list *new_state;

	new_state = exp_new_state(esPtr);
	new_state->next = i->state_list;
	i->state_list = new_state;
}

/* this routine assumes i->esPtr is meaningful */
static void
exp_i_parse_states(interp,i) /* INTL */
Tcl_Interp *interp;
struct exp_i *i;
{
    struct ExpState *esPtr;
    char *p = i->value;
    int argc;
    char **argv;
    int j;

    if (Tcl_SplitList(NULL, p, &argc, &argv) != TCL_OK) goto error;

    for (j = 0; j < argc; j++) {
        esPtr = expStateFromChannelName(interp,argv[j],1,0,0,"");
	if (!esPtr) goto error;
	exp_i_add_state(i,esPtr);
    }
    ckfree((char*)argv);
    return;
error:
    expDiagLogU("exp_i_parse_states: ");
    expDiagLogU(Tcl_GetStringResult(interp));
    return;
}
	
/* updates a single exp_i struct */
void
exp_i_update(interp,i)
Tcl_Interp *interp;
struct exp_i *i;
{
  char *p;	/* string representation of list of spawn ids */

  if (i->direct == EXP_INDIRECT) {
    p = Tcl_GetVar(interp,i->variable,TCL_GLOBAL_ONLY);
    if (!p) {
      p = "";
      /* *really* big variable names could blow up expDiagLog! */
      expDiagLog("warning: indirect variable %s undefined",i->variable);
    }
    
    if (i->value) {
      if (streq(p,i->value)) return;
      
      /* replace new value with old */
      ckfree(i->value);
    }
    i->value = ckalloc(strlen(p)+1);
    strcpy(i->value,p);

    exp_free_state(i->state_list);
    i->state_list = 0;
  } else {
    /* no free, because this should only be called on */
    /* "direct" i's once */
    i->state_list = 0;
  }
  exp_i_parse_states(interp, i);
  return;
}

struct exp_i *
exp_new_i_simple(esPtr,duration)
ExpState *esPtr;
int duration;		/* if we have to copy the args */
			/* should only need do this in expect_before/after */
{
	struct exp_i *i;

	i = exp_new_i();

	i->direct = EXP_DIRECT;
	i->duration = duration;

	exp_i_add_state(i,esPtr);

	return i;
}

/*ARGSUSED*/
static int
Exp_SendLogCmd(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
	argv++;
	argc--;
	if (argc) {
		if (streq(*argv,"--")) {
			argc--; argv++;
		}
	}

	if (argc != 1) {
		exp_error(interp,"usage: send [args] string");
		return TCL_ERROR;
	}

	expLogDiagU(*argv);
	return(TCL_OK);
}


/* I've rewritten this to be unbuffered.  I did this so you could shove */
/* large files through "send".  If you are concerned about efficiency */
/* you should quote all your send args to make them one single argument. */
/*ARGSUSED*/
static int
Exp_SendObjCmd(clientData, interp, objc, objv) /* INTL */
ClientData clientData;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    ExpState *esPtr = 0;
    int rc; 	/* final result of this procedure */
    struct human_arg human_args;
    struct slow_arg slow_args;
#define SEND_STYLE_STRING_MASK	0x07	/* mask to detect a real string arg */
#define SEND_STYLE_PLAIN	0x01
#define SEND_STYLE_HUMAN	0x02
#define SEND_STYLE_SLOW		0x04
#define SEND_STYLE_ZERO		0x10
#define SEND_STYLE_BREAK	0x20
    int send_style = SEND_STYLE_PLAIN;
    int want_cooked = TRUE;
    char *string;		/* string to send */
    int len = -1;		/* length of string to send */
    int zeros;		/* count of how many ascii zeros to send */

    char *chanName = 0;
    struct exp_state_list *state_list;
    struct exp_i *i;
    int j;

    static char *options[] = {
	"-i", "-h", "-s", "-null", "-0", "-raw", "-break", "--", (char *)0
    };
    enum options {
	SEND_SPAWNID, SEND_HUMAN, SEND_SLOW, SEND_NULL, SEND_ZERO,
	SEND_RAW, SEND_BREAK, SEND_LAST
    };

    for (j = 1; j < objc; j++) {
	char *name;
	int index;

	name = Tcl_GetString(objv[j]);
	if (name[0] != '-') {
	    break;
	}
	if (Tcl_GetIndexFromObj(interp, objv[j], options, "flag", 0,
		&index) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch ((enum options) index) {
	    case SEND_SPAWNID:
		j++;
		chanName = Tcl_GetString(objv[j]);
		break;

	    case SEND_LAST:
		j++;
		goto getString;

	    case SEND_HUMAN:
		if (-1 == get_human_args(interp,&human_args))
		    return(TCL_ERROR);
		send_style = SEND_STYLE_HUMAN;
		break;

	    case SEND_SLOW:
		if (-1 == get_slow_args(interp,&slow_args))
		    return(TCL_ERROR);
		send_style = SEND_STYLE_SLOW;
		break;

	    case SEND_NULL:
	    case SEND_ZERO:
		j++;
		if (j >= objc) {
		    zeros = 1;
		} else if (Tcl_GetIntFromObj(interp, objv[j], &zeros)
			!= TCL_OK) {
		    return TCL_ERROR;
		}
		if (zeros < 1) return TCL_OK;
		send_style = SEND_STYLE_ZERO;
		string = "<zero(s)>";
		break;

	    case SEND_RAW:
		want_cooked = FALSE;
		break;

	    case SEND_BREAK:
		send_style = SEND_STYLE_BREAK;
		string = "<break>";
		break;
	}
    }

    if (send_style & SEND_STYLE_STRING_MASK) {
	if (j != objc-1) {
	    exp_error(interp,"usage: send [args] string");
	    return TCL_ERROR;
	}
getString:
	string = Tcl_GetStringFromObj(objv[j], &len);
    } else {
	len = strlen(string);
    }

    if (clientData == &sendCD_user) esPtr = tsdPtr->stdinout;
    else if (clientData == &sendCD_error) esPtr = tsdPtr->stderrX;
    else if (clientData == &sendCD_tty) esPtr = tsdPtr->devtty;
    else if (!chanName) {
	/* we want to check if it is open */
	/* but since stdin could be closed, we have to first */
	/* get the fd and then convert it from 0 to 1 if necessary */
	if (!(esPtr = expStateCurrent(interp,0,0,0))) return(TCL_ERROR);
    }

    if (esPtr) {
	i = exp_new_i_simple(esPtr,EXP_TEMPORARY);
    } else {
	i = exp_new_i_complex(interp,chanName,FALSE,(Tcl_VarTraceProc *)0);
    }

#define send_to_stderr	(clientData == &sendCD_error)
#define send_to_proc	(clientData == &sendCD_proc)
#define send_to_user	((clientData == &sendCD_user) || \
			 (clientData == &sendCD_tty))

    if (send_to_proc) {
	want_cooked = FALSE;
	expDiagLogU("send: sending \"");
	expDiagLogU(expPrintify(string));
	expDiagLogU("\" to {");
	/* if closing brace doesn't appear, that's because an error */
	/* was encountered before we could send it */
    } else {
	expLogDiagU(string);
    }

    for (state_list=i->state_list;state_list;state_list=state_list->next) {
	esPtr = state_list->esPtr;

	if (send_to_proc) {
	    expDiagLog(" %s ",esPtr->name);
	}

	/* check validity of each - i.e., are they open */
	if (0 == expStateCheck(interp,esPtr,1,0,"send")) {
	    rc = TCL_ERROR;
	    goto finish;
	}
	if (want_cooked) string = exp_cook(string,&len);

	switch (send_style) {
	    case SEND_STYLE_PLAIN:
		rc = exact_write(esPtr,string,len);
		break;
	    case SEND_STYLE_SLOW:
		rc = slow_write(interp,esPtr,string,len,&slow_args);
		break;
	    case SEND_STYLE_HUMAN:
		rc = human_write(interp,esPtr,string,&human_args);
		break;
	    case SEND_STYLE_ZERO:
		for (;zeros>0;zeros--) {
		    rc = Tcl_WriteChars(esPtr->channel,
			    NULL_STRING, NULL_LENGTH);
		}
		/* catching error on last write is sufficient */
		rc = ((rc==1) ? 0 : -1);   /* normal is 1 not 0 */
		break;
	    case SEND_STYLE_BREAK:
		exp_tty_break(interp,esPtr->fdout);
		rc = 0;
		break;
	}

	if (rc != 0) {
	    if (rc == -1) {
		exp_error(interp,"write(spawn_id=%d): %s",esPtr->fdout,Tcl_PosixError(interp));
		rc = TCL_ERROR;
	    }
	    goto finish;
	}
    }
    if (send_to_proc) expDiagLogU("}\r\n");

    rc = TCL_OK;
 finish:
    exp_free_i(interp,i,(Tcl_VarTraceProc *)0);
    return rc;
}

/*ARGSUSED*/
static int
Exp_LogFileCmd(clientData, interp, argc, argv)
    ClientData clientData;
    Tcl_Interp *interp;
    int argc;
    char **argv;
{
    static char resultbuf[1000];
    char *chanName = 0;
    int leaveOpen = FALSE;
    int logAll = FALSE;
    int append = TRUE;
    char *filename = 0;

    argv++;
    argc--;
    for (;argc>0;argc--,argv++) {
	if (streq(*argv,"-open")) {
	    if (!argv[1]) goto usage_error;
	    chanName = argv[1];
	    argc--; argv++;
	} else if (streq(*argv,"-leaveopen")) {
	    if (!argv[1]) goto usage_error;
	    chanName = argv[1];
	    leaveOpen = TRUE;
	    argc--; argv++;
	} else if (streq(*argv,"-a")) {
	    logAll = TRUE;
	} else if (streq(*argv,"-info")) {
	    resultbuf[0] = '\0';
	    if (expLogChannelGet()) {
		if (expLogAllGet()) strcat(resultbuf,"-a ");
		if (!expLogAppendGet()) strcat(resultbuf,"-noappend ");
		if (expLogFilenameGet()) {
		    strcat(resultbuf,expLogFilenameGet());
		} else {
		    if (expLogLeaveOpenGet()) {
			strcat(resultbuf,"-leaveopen ");
		    }
		    strcat(resultbuf,Tcl_GetChannelName(expLogChannelGet()));
		}
		Tcl_SetResult(interp,resultbuf,TCL_STATIC);
	    }
	    return TCL_OK;
	} else if (streq(*argv,"-noappend")) {
	    append = FALSE;
	} else break;
    }
    
    if (argc == 1) {
	filename = argv[0];
    } else if (argc > 1) {
	/* too many arguments */
	goto usage_error;
    } 
    
    if (chanName && filename) {
	goto usage_error;
    }

    /* check if user merely wants to change logAll (-a) */
    if (expLogChannelGet() && (chanName || filename)) {
	if (filename && (0 == strcmp(filename,expLogFilenameGet()))) {
	    expLogAllSet(logAll);
	    return TCL_OK;
	} else if (chanName && (0 == strcmp(filename,Tcl_GetChannelName(expLogChannelGet())))) {
	    expLogAllSet(logAll);
	    return TCL_OK;
	} else {
	    exp_error(interp,"cannot start logging without first stopping logging");
	    return TCL_ERROR;
	}
    }

    if (filename) {
	if (TCL_ERROR == expLogChannelOpen(interp,filename,append)) {
	    return TCL_ERROR;
	}
    } else if (chanName) {
	if (TCL_ERROR == expLogChannelSet(interp,chanName)) {
	    return TCL_ERROR;
	}
    } else {
	expLogChannelClose(interp);
	if (logAll) {
	    exp_error(interp,"cannot use -a without a file or channel");
	    return TCL_ERROR;
	}
    }
    expLogAllSet(logAll);
    expLogLeaveOpenSet(leaveOpen);

    return TCL_OK;

 usage_error:
    exp_error(interp,"usage: log_file [-info] [-noappend] [[-a] file] [-[leave]open [open ...]]");
    return TCL_ERROR;
}

/*ARGSUSED*/
static int
Exp_LogUserCmd(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
    int old_loguser = expLogUserGet();

    if (argc == 0 || (argc == 2 && streq(argv[1],"-info"))) {
	/* do nothing */
    } else if (argc == 2) {
	expLogUserSet(atoi(argv[1]));
    } else {
	exp_error(interp,"usage: [-info|1|0]");
    }

    sprintf(interp->result,"%d",old_loguser);

    return(TCL_OK);
}

#ifdef TCL_DEBUGGER
/*ARGSUSED*/
static int
Exp_DebugCmd(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
    int now = FALSE;	/* soon if FALSE, now if TRUE */
    int exp_tcl_debugger_was_available = exp_tcl_debugger_available;

    if (argc > 3) goto usage;

    if (argc == 1) {
	sprintf(interp->result,"%d",exp_tcl_debugger_available);
	return TCL_OK;
    }

    argv++;

    while (*argv) {
	if (streq(*argv,"-now")) {
	    now = TRUE;
	    argv++;
	}
	else break;
    }

    if (!*argv) {
	if (now) {
	    Dbg_On(interp,1);
	    exp_tcl_debugger_available = 1;
	} else {
	    goto usage;
	}
    } else if (streq(*argv,"0")) {
	Dbg_Off(interp);
	exp_tcl_debugger_available = 0;
    } else {
	Dbg_On(interp,now);
	exp_tcl_debugger_available = 1;
    }
    sprintf(interp->result,"%d",exp_tcl_debugger_was_available);
    return(TCL_OK);
 usage:
    exp_error(interp,"usage: [[-now] 1|0]");
    return TCL_ERROR;
}
#endif


/*ARGSUSED*/
static int
Exp_ExpInternalCmd(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
    int newChannel = FALSE;
    Tcl_Channel oldChannel;
    static char resultbuf[1000];

    if ((argc > 1) && streq(argv[1],"-info")) {
	resultbuf[0] = '\0';
	oldChannel = expDiagChannelGet();
	if (oldChannel) {
	    sprintf(resultbuf,"-f %s ",expDiagFilename());
	}
	strcat(resultbuf,expDiagToStderrGet()?"1":"0");
	Tcl_SetResult(interp,resultbuf,TCL_STATIC);
	return TCL_OK;
    }

    argv++;
    argc--;

    while (argc) {
	if (!streq(*argv,"-f")) break;
	argc--;argv++;
	if (argc < 1) goto usage;
	expDiagChannelClose(interp);
	if (TCL_OK != expDiagChannelOpen(interp,argv[0])) {
	    return TCL_ERROR;
	}
	newChannel = TRUE;
	argc--;argv++;
    }

    if (argc != 1) goto usage;
    
    /* if no -f given, close file */
    if (!newChannel) {
	expDiagChannelClose(interp);
    }
    expDiagToStderrSet(atoi(*argv));
    return(TCL_OK);
 usage:
    exp_error(interp,"usage: [-f file] 0|1");
    return TCL_ERROR;
}

char *exp_onexit_action = 0;

/*ARGSUSED*/
static int
Exp_ExitCmd(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
	int value = 0;

	argv++;

	if (*argv) {
		if (exp_flageq(*argv,"-onexit",3)) {
			argv++;
			if (*argv) {
				int len = strlen(*argv);
				if (exp_onexit_action)
					ckfree(exp_onexit_action);
				exp_onexit_action = ckalloc(len + 1);
				strcpy(exp_onexit_action,*argv);
			} else if (exp_onexit_action) {
				Tcl_AppendResult(interp,exp_onexit_action,(char *)0);
			}
			return TCL_OK;
		} else if (exp_flageq(*argv,"-noexit",3)) {
			argv++;
			exp_exit_handlers((ClientData)interp);
			return TCL_OK;
		}
	}

	if (*argv) {
		if (Tcl_GetInt(interp, *argv, &value) != TCL_OK) {
			return TCL_ERROR;
		}
	}

	Tcl_Exit(value);
	/*NOTREACHED*/
}

/*ARGSUSED*/
static int
Exp_CloseObjCmd(clientData, interp, objc, objv)
ClientData clientData;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];	/* Argument objects. */
{
    int onexec_flag = FALSE;	/* true if -onexec seen */
    int close_onexec;
    int slave_flag = FALSE;
    ExpState *esPtr = 0;
    char *chanName = 0;

    int objc_orig = objc;
    Tcl_Obj *CONST *objv_orig = objv;

    objc--; objv++;

    for (;objc>0;objc--,objv++) {
	if (streq("-i",Tcl_GetString(*objv))) {
	    objc--; objv++;
	    if (objc == 0) {
		exp_error(interp,"usage: -i spawn_id");
		return(TCL_ERROR);
	    }
	    chanName = Tcl_GetString(*objv);
	} else if (streq(Tcl_GetString(*objv),"-slave")) {
	    slave_flag = TRUE;
	} else if (streq(Tcl_GetString(*objv),"-onexec")) {
	    objc--; objv++;
	    if (objc == 0) {
		exp_error(interp,"usage: -onexec 0|1");
		return(TCL_ERROR);
	    }
	    onexec_flag = TRUE;
	    close_onexec = atoi(Tcl_GetString(*objv));
	} else break;
    }

    if (objc) {
	/* doesn't look like our format, it must be a Tcl-style file */
	/* handle.  Lucky that formats are easily distinguishable. */
	/* Historical note: we used "close"  long before there was a */
	/* Tcl builtin by the same name. */

	Tcl_CmdInfo info;
	Tcl_ResetResult(interp);
	if (0 == Tcl_GetCommandInfo(interp,"close",&info)) {
	    info.clientData = 0;
	}
	return(Tcl_CloseObjCmd(info.clientData,interp,objc_orig,objv_orig));
    }

    if (chanName) {
	if (!(esPtr = expStateFromChannelName(interp,chanName,1,0,0,"close"))) return TCL_ERROR;
    } else {
	if (!(esPtr = expStateCurrent(interp,1,0,0))) return TCL_ERROR;
    }

    if (slave_flag) {
	if (esPtr->fd_slave != EXP_NOFD) {
	    close(esPtr->fd_slave);
	    esPtr->fd_slave = EXP_NOFD;

	    exp_slave_control(esPtr->fdin,1);

	    return TCL_OK;
	} else {
	    exp_error(interp,"no such slave");
	    return TCL_ERROR;
	}
    }

    if (onexec_flag) {
	/* heck, don't even bother to check if fd is open or a real */
	/* spawn id, nothing else depends on it */
	fcntl(esPtr->fdin,F_SETFD,close_onexec);
	return TCL_OK;
    }

    return(exp_close(interp,esPtr));
}

/*ARGSUSED*/
static void
tcl_tracer(clientData,interp,level,command,cmdProc,cmdClientData,argc,argv)
ClientData clientData;
Tcl_Interp *interp;
int level;
char *command;
int (*cmdProc)();
ClientData cmdClientData;
int argc;
char *argv[];
{
	int i;

	/* come out on stderr, by using expErrorLog */
	expErrorLog("%2d",level);
	for (i = 0;i<level;i++) expErrorLogU("  ");
	expErrorLogU(command);
	expErrorLogU("\r\n");
}

/*ARGSUSED*/
static int
Exp_StraceCmd(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
	static int trace_level = 0;
	static Tcl_Trace trace_handle;

	if (argc > 1 && streq(argv[1],"-info")) {
		sprintf(interp->result,"%d",trace_level);
		return TCL_OK;
	}

	if (argc != 2) {
		exp_error(interp,"usage: trace level");
		return(TCL_ERROR);
	}
	/* tracing already in effect, undo it */
	if (trace_level > 0) Tcl_DeleteTrace(interp,trace_handle);

	/* get and save new trace level */
	trace_level = atoi(argv[1]);
	if (trace_level > 0)
		trace_handle = Tcl_CreateTrace(interp,
				trace_level,tcl_tracer,(ClientData)0);
	return(TCL_OK);
}

/* following defn's are stolen from tclUnix.h */

/*
 * The type of the status returned by wait varies from UNIX system
 * to UNIX system.  The macro below defines it:
 */

#if 0
#ifndef NO_UNION_WAIT
#   define WAIT_STATUS_TYPE union wait
#else
#   define WAIT_STATUS_TYPE int
#endif
#endif /* 0 */

/*
 * following definitions stolen from tclUnix.h
 * (should have been made public!)

 * Supply definitions for macros to query wait status, if not already
 * defined in header files above.
 */

#if 0
#ifndef WIFEXITED
#   define WIFEXITED(stat)  (((*((int *) &(stat))) & 0xff) == 0)
#endif

#ifndef WEXITSTATUS
#   define WEXITSTATUS(stat) (((*((int *) &(stat))) >> 8) & 0xff)
#endif

#ifndef WIFSIGNALED
#   define WIFSIGNALED(stat) (((*((int *) &(stat)))) && ((*((int *) &(stat))) == ((*((int *) &(stat))) & 0x00ff)))
#endif

#ifndef WTERMSIG
#   define WTERMSIG(stat)    ((*((int *) &(stat))) & 0x7f)
#endif

#ifndef WIFSTOPPED
#   define WIFSTOPPED(stat)  (((*((int *) &(stat))) & 0xff) == 0177)
#endif

#ifndef WSTOPSIG
#   define WSTOPSIG(stat)    (((*((int *) &(stat))) >> 8) & 0xff)
#endif
#endif /* 0 */

/* end of stolen definitions */

/* Describe the processes created with Expect's fork.
This allows us to wait on them later.

This is maintained as a linked list.  As additional procs are forked,
new links are added.  As procs disappear, links are marked so that we
can reuse them later.
*/

struct forked_proc {
	int pid;
	WAIT_STATUS_TYPE wait_status;
	enum {not_in_use, wait_done, wait_not_done} link_status;
	struct forked_proc *next;
} *forked_proc_base = 0;

void
fork_clear_all()
{
	struct forked_proc *f;

	for (f=forked_proc_base;f;f=f->next) {
		f->link_status = not_in_use;
	}
}

void
fork_init(f,pid)
struct forked_proc *f;
int pid;
{
	f->pid = pid;
	f->link_status = wait_not_done;
}

/* make an entry for a new proc */
void
fork_add(pid)
int pid;
{
	struct forked_proc *f;

	for (f=forked_proc_base;f;f=f->next) {
		if (f->link_status == not_in_use) break;
	}

	/* add new entry to the front of the list */
	if (!f) {
		f = (struct forked_proc *)ckalloc(sizeof(struct forked_proc));
		f->next = forked_proc_base;
		forked_proc_base = f;
	}
	fork_init(f,pid);
}

/* Provide a last-chance guess for this if not defined already */
#ifndef WNOHANG
#define WNOHANG WNOHANG_BACKUP_VALUE
#endif

/* wait returns are a hodgepodge of things
 If wait fails, something seriously has gone wrong, for example:
   bogus arguments (i.e., incorrect, bogus spawn id)
   no children to wait on
   async event failed
 If wait succeeeds, something happened on a particular pid
   3rd arg is 0 if successfully reaped (if signal, additional fields supplied)
   3rd arg is -1 if unsuccessfully reaped (additional fields supplied)
*/
/*ARGSUSED*/
static int
Exp_WaitCmd(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
    char *chanName = 0;
    struct ExpState *esPtr;
    struct forked_proc *fp = 0;	/* handle to a pure forked proc */
    struct ExpState esTmp;	/* temporary memory for either f or fp */
    char spawn_id[20];

    int nowait = FALSE;
    int result = 0;		/* 0 means child was successfully waited on */
				/* -1 means an error occurred */
				/* -2 means no eligible children to wait on */
#define NO_CHILD -2

    argv++;
    argc--;
    for (;argc>0;argc--,argv++) {
	if (streq(*argv,"-i")) {
	    argc--; argv++;
	    if (argc==0) {
		exp_error(interp,"usage: -i spawn_id");
		return(TCL_ERROR);
	    }
	    chanName = *argv;
	} else if (streq(*argv,"-nowait")) {
	    nowait = TRUE;
	}
    }

    if (!chanName) {
	if (!(esPtr = expStateCurrent(interp,0,0,1))) return TCL_ERROR;
    } else {
	if (!(esPtr = expStateFromChannelName(interp,chanName,0,0,1,"wait")))
	    return TCL_ERROR;
    }

    if (!expStateAnyIs(esPtr)) {
	/* check if waited on already */
	/* things opened by "open" or set with -nowait */
	/* are marked sys_waited already */
	if (!esPtr->sys_waited) {
	    if (nowait) {
		/* should probably generate an error */
		/* if SIGCHLD is trapped. */

		/* pass to Tcl, so it can do wait */
		/* in background */
		Tcl_DetachPids(1,(Tcl_Pid *)&esPtr->pid);
		exp_wait_zero(&esPtr->wait);
	    } else {
		while (1) {
		    if (Tcl_AsyncReady()) {
			int rc = Tcl_AsyncInvoke(interp,TCL_OK);
			if (rc != TCL_OK) return(rc);
		    }

		    result = waitpid(esPtr->pid,&esPtr->wait,0);
		    if (result == esPtr->pid) break;
		    if (result == -1) {
			if (errno == EINTR) continue;
			else break;
		    }
		}
	    }
	}

	/*
	 * Now have Tcl reap anything we just detached. 
	 * This also allows procs user has created with "exec &"
	 * and and associated with an "exec &" process to be reaped.
	 */
	
	Tcl_ReapDetachedProcs();
	exp_rearm_sigchld(interp); /* new */

	strcpy(spawn_id,esPtr->name);
    } else {
	/* wait for any of our own spawned processes */
	/* we call waitpid rather than wait to avoid running into */
	/* someone else's processes.  Yes, according to Ousterhout */
	/* this is the best way to do it. */

	int waited_on_forked_process = 0;

	esPtr = expWaitOnAny();
	if (!esPtr) {
	    /* if it's not a spawned process, maybe its a forked process */
	    for (fp=forked_proc_base;fp;fp=fp->next) {
		if (fp->link_status == not_in_use) continue;
	restart:
		result = waitpid(fp->pid,&fp->wait_status,WNOHANG);
		if (result == fp->pid) {
		    waited_on_forked_process = 1;
		    break;
		}
		if (result == 0) continue;	/* busy, try next */
		if (result == -1) {
		    if (errno == EINTR) goto restart;
		    else break;
		}
	    }

	    if (waited_on_forked_process) {
		/*
		 * The literal spawn id in the return value from wait appears
		 * as a -1 to indicate a forked process was waited on.  
		 */
		strcpy(spawn_id,"-1");
	    } else {
		result = NO_CHILD;	/* no children */
		Tcl_ReapDetachedProcs();
	    }
	    exp_rearm_sigchld(interp);
	}
    }

    /*  sigh, wedge forked_proc into an ExpState structure so we don't
     *  have to rewrite remaining code (too much)
     */
    if (fp) {
	esPtr = &esTmp;
	esPtr->pid = fp->pid;
	esPtr->wait = fp->wait_status;
    }

    /* non-portable assumption that pid_t can be printed with %d */

    if (result == -1) {
	sprintf(interp->result,"%d %s -1 %d POSIX %s %s",
		esPtr->pid,spawn_id,errno,Tcl_ErrnoId(),Tcl_ErrnoMsg(errno));
	result = TCL_OK;
    } else if (result == NO_CHILD) {
	exp_error(interp,"no children");
	return TCL_ERROR;
    } else {
	sprintf(interp->result,"%d %s 0 %d",
		esPtr->pid,spawn_id,WEXITSTATUS(esPtr->wait));
	if (WIFSIGNALED(esPtr->wait)) {
	    Tcl_AppendElement(interp,"CHILDKILLED");
	    Tcl_AppendElement(interp,Tcl_SignalId((int)(WTERMSIG(esPtr->wait))));
	    Tcl_AppendElement(interp,Tcl_SignalMsg((int) (WTERMSIG(esPtr->wait))));
	} else if (WIFSTOPPED(esPtr->wait)) {
	    Tcl_AppendElement(interp,"CHILDSUSP");
	    Tcl_AppendElement(interp,Tcl_SignalId((int) (WSTOPSIG(esPtr->wait))));
	    Tcl_AppendElement(interp,Tcl_SignalMsg((int) (WSTOPSIG(esPtr->wait))));
	}
    }
			
    if (fp) {
	fp->link_status = not_in_use;
	return ((result == -1)?TCL_ERROR:TCL_OK);		
    }

    esPtr->sys_waited = TRUE;
    esPtr->user_waited = TRUE;

    /* if user has already called close, forget about this entry entirely */
    if (!esPtr->open) {
      if (esPtr->registered) {
	Tcl_UnregisterChannel(interp,esPtr->channel);
      }
    }

    return ((result == -1)?TCL_ERROR:TCL_OK);
}

/*ARGSUSED*/
static int
Exp_ForkCmd(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
	int rc;
	if (argc > 1) {
		exp_error(interp,"usage: fork");
		return(TCL_ERROR);
	}

	rc = fork();
	if (rc == -1) {
		exp_error(interp,"fork: %s",Tcl_PosixError(interp));
		return TCL_ERROR;
	} else if (rc == 0) {
		/* child */
		exp_forked = TRUE;
		exp_getpid = getpid();
		fork_clear_all();
	} else {
		/* parent */
		fork_add(rc);
	}

	/* both child and parent follow remainder of code */
	sprintf(interp->result,"%d",rc);
	expDiagLog("fork: returns {%s}\r\n",interp->result);
	return(TCL_OK);
}

/*ARGSUSED*/
static int
Exp_DisconnectCmd(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    

    /* tell CenterLine to ignore non-use of ttyfd */
    /*SUPPRESS 591*/
    int ttyfd;

    if (argc > 1) {
	exp_error(interp,"usage: disconnect");
	return(TCL_ERROR);
    }

    if (exp_disconnected) {
	exp_error(interp,"already disconnected");
	return(TCL_ERROR);
    }
    if (!exp_forked) {
	exp_error(interp,"can only disconnect child process");
	return(TCL_ERROR);
    }
    exp_disconnected = TRUE;

    /* ignore hangup signals generated by testing ptys in getptymaster */
    /* and other places */
    signal(SIGHUP,SIG_IGN);

    /* reopen prevents confusion between send/expect_user */
    /* accidentally mapping to a real spawned process after a disconnect */

    /* if we're in a child that's about to be disconnected from the
       controlling tty, close and reopen 0, 1, and 2 but associated
       with /dev/null.  This prevents send and expect_user doing
       special things if newly spawned processes accidentally
       get allocated 0, 1, and 2.
    */
	   
    if (isatty(0)) {
	ExpState *stdinout = tsdPtr->stdinout;
	if (stdinout->valid) {
	    exp_close(interp,stdinout);
	    if (stdinout->registered) {
		Tcl_UnregisterChannel(interp,stdinout->channel);
	    }
	}
	open("/dev/null",0);
	open("/dev/null",1);
	/* tsdPtr->stdinout = expCreateChannel(interp,0,1,EXP_NOPID);*/
	/* tsdPtr->stdinout->keepForever = 1;*/
	}
    if (isatty(2)) {
	ExpState *devtty = tsdPtr->devtty;
	
	/* reopen stderr saves error checking in error/log routines. */
	if (devtty->valid) {
	    exp_close(interp,devtty);
	    if (devtty->registered) {
		Tcl_UnregisterChannel(interp,devtty->channel);
	    }
	}
	open("/dev/null",1);
	/* tsdPtr->devtty = expCreateChannel(interp,2,2,EXP_NOPID);*/
	/* tsdPtr->devtty->keepForever = 1;*/
    }

    Tcl_UnsetVar(interp,"tty_spawn_id",TCL_GLOBAL_ONLY);

#ifdef DO_SETSID
    setsid();
#else
#ifdef SYSV3
    /* put process in our own pgrp, and lose controlling terminal */
#ifdef sysV88
    /* With setpgrp first, child ends up with closed stdio */
    /* according to Dave Schmitt <[email protected]> */
    if (fork()) exit(0);
    expSetpgrp();
#else
    expSetpgrp();
    /*signal(SIGHUP,SIG_IGN); moved out to above */
    if (fork()) exit(0);	/* first child exits (as per Stevens, */
    /* UNIX Network Programming, p. 79-80) */
    /* second child process continues as daemon */
#endif
#else /* !SYSV3 */
    expSetpgrp();

/* Pyramid lacks this defn */
#ifdef TIOCNOTTY
    ttyfd = open("/dev/tty", O_RDWR);
    if (ttyfd >= 0) {
	/* zap controlling terminal if we had one */
	(void) ioctl(ttyfd, TIOCNOTTY, (char *)0);
	(void) close(ttyfd);
    }
#endif /* TIOCNOTTY */

#endif /* SYSV3 */
#endif /* DO_SETSID */
    return(TCL_OK);
}

/*ARGSUSED*/
static int
Exp_OverlayCmd(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
	int newfd, oldfd;
	int dash_name = 0;
	char *command;

	argc--; argv++;
	while (argc) {
		if (*argv[0] != '-') break;	/* not a flag */
		if (streq(*argv,"-")) {		/* - by itself */
			argc--; argv++;
			dash_name = 1;
			continue;
		}
		newfd = atoi(argv[0]+1);
		argc--; argv++;
		if (argc == 0) {
			exp_error(interp,"overlay -# requires additional argument");
			return(TCL_ERROR);
		}
		oldfd = atoi(argv[0]);
		argc--; argv++;
		expDiagLog("overlay: mapping fd %d to %d\r\n",oldfd,newfd);
		if (oldfd != newfd) (void) dup2(oldfd,newfd);
		else expDiagLog("warning: overlay: old fd == new fd (%d)\r\n",oldfd);
	}
	if (argc == 0) {
		exp_error(interp,"need program name");
		return(TCL_ERROR);
	}
	command = argv[0];
	if (dash_name) {
		argv[0] = ckalloc(1+strlen(command));
		sprintf(argv[0],"-%s",command);
	}

	signal(SIGINT, SIG_DFL);
	signal(SIGQUIT, SIG_DFL);
        (void) execvp(command,argv);
	exp_error(interp,"execvp(%s): %s\r\n",argv[0],Tcl_PosixError(interp));
	return(TCL_ERROR);
}

/*ARGSUSED*/
int
Exp_InterpreterObjCmd(clientData, interp, objc, objv)
ClientData clientData;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];		/* Argument objects. */
{
    Tcl_Obj *eofObj = 0;
    int i;
    int index;
    int rc;

    static char *options[] = {
	"-eof", (char *)0
    };
    enum options {
	FLAG_EOF
    };

    for (i = 1; i < objc; i++) {
	if (Tcl_GetIndexFromObj(interp, objv[i], options, "flag", 0,
				&index) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch ((enum options) index) {
	case FLAG_EOF:
	    i++;
	    if (i >= objc) {
		Tcl_WrongNumArgs(interp, 1, objv,"-eof cmd");
		return TCL_ERROR;
	    }
	    eofObj = objv[i];
	    Tcl_IncrRefCount(eofObj);
	    break;
	}
    }

    /* errors and ok, are caught by exp_interpreter() and discarded */
    /* to return TCL_OK, type "return" */
    rc = exp_interpreter(interp,eofObj);
    if (eofObj) Tcl_DecrRefCount(eofObj);
    return rc;
}

/* this command supercede's Tcl's builtin CONTINUE command */
/*ARGSUSED*/
int
Exp_ExpContinueCmd(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
    if (argc == 1) {
	return EXP_CONTINUE;
    } else if ((argc == 2) && (0 == strcmp(argv[1],"-continue_timer"))) {
	return EXP_CONTINUE_TIMER;
    }

    exp_error(interp,"usage: exp_continue [-continue_timer]\n");
    return(TCL_ERROR);
}

/* most of this is directly from Tcl's definition for return */
/*ARGSUSED*/
int
Exp_InterReturnObjCmd(clientData, interp, objc, objv)
ClientData clientData;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
    /* let Tcl's return command worry about args */
    /* if successful (i.e., TCL_RETURN is returned) */
    /* modify the result, so that we will handle it specially */

    int result = Tcl_ReturnObjCmd(clientData,interp,objc,objv);
    if (result == TCL_RETURN)
        result = EXP_TCL_RETURN;
    return result;
}

/*ARGSUSED*/
int
Exp_OpenCmd(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
    ExpState *esPtr;
    char *chanName = 0;
    int newfd;
    int leaveopen = FALSE;
    Tcl_Channel channel;

    argc--; argv++;

    for (;argc>0;argc--,argv++) {
	if (streq(*argv,"-i")) {
	    argc--; argv++;
	    if (!*argv) {
		exp_error(interp,"usage: -i spawn_id");
		return TCL_ERROR;
	    }
	    chanName = *argv;
	} else if (streq(*argv,"-leaveopen")) {
	    leaveopen = TRUE;
	    argc--; argv++;
	} else break;
    }

    if (!chanName) {
	if (!(esPtr = expStateCurrent(interp,1,0,0))) return TCL_ERROR;
    } else {
	if (!(esPtr = expStateFromChannelName(interp,chanName,1,0,0,"exp_open")))
return TCL_ERROR;
    }

    /* make a new copy of file descriptor */
    if (-1 == (newfd = dup(esPtr->fdin))) {
	exp_error(interp,"dup: %s",Tcl_PosixError(interp));
	return TCL_ERROR;
    }

    if (!leaveopen) {
	/* remove from Expect's memory in anticipation of passing to Tcl */
	if (esPtr->pid != EXP_NOPID) {
	    Tcl_DetachPids(1,(Tcl_Pid *)&esPtr->pid);
	    esPtr->pid = EXP_NOPID;
	    esPtr->sys_waited = esPtr->user_waited = TRUE;
	}
	exp_close(interp,esPtr);
    }

    /*
     * Tcl's MakeFileChannel only allows us to pass a single file descriptor
     * but that shouldn't be a problem in practice since all of the channels
     * that Expect generates only have one fd.  Of course, this code won't
     * work if someone creates a pipeline, then passes it to spawn, and then
     * again to exp_open.  For that to work, Tcl would need a new API.
     * Oh, and we're also being rather cavalier with the permissions here,
     * but they're likely to be right for the same reasons.
     */
    channel = Tcl_MakeFileChannel((ClientData)newfd,TCL_READABLE|TCL_WRITABLE);
    Tcl_RegisterChannel(interp, channel);
    Tcl_AppendResult(interp, Tcl_GetChannelName(channel), (char *) NULL);
    return TCL_OK;
}

/* return 1 if a string is substring of a flag */
/* this version is the code used by the macro that everyone calls */
int
exp_flageq_code(flag,string,minlen)
char *flag;
char *string;
int minlen;		/* at least this many chars must match */
{
	for (;*flag;flag++,string++,minlen--) {
		if (*string == '\0') break;
		if (*string != *flag) return 0;
	}
	if (*string == '\0' && minlen <= 0) return 1;
	return 0;
}

void
exp_create_commands(interp,c)
Tcl_Interp *interp;
struct exp_cmd_data *c;
{
	Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
	Namespace *currNsPtr   = (Namespace *) Tcl_GetCurrentNamespace(interp);
	char cmdnamebuf[80];

	for (;c->name;c++) {
		/* if already defined, don't redefine */
		if ((c->flags & EXP_REDEFINE) ||
		    !(Tcl_FindHashEntry(&globalNsPtr->cmdTable,c->name) ||
		      Tcl_FindHashEntry(&currNsPtr->cmdTable,c->name))) {
			if (c->objproc)
				Tcl_CreateObjCommand(interp,c->name,
						     c->objproc,c->data,exp_deleteObjProc);
			else
				Tcl_CreateCommand(interp,c->name,c->proc,
						  c->data,exp_deleteProc);
		}
		if (!(c->name[0] == 'e' &&
		      c->name[1] == 'x' &&
		      c->name[2] == 'p')
		    && !(c->flags & EXP_NOPREFIX)) {
			sprintf(cmdnamebuf,"exp_%s",c->name);
			if (c->objproc)
				Tcl_CreateObjCommand(interp,cmdnamebuf,c->objproc,c->data,
						     exp_deleteObjProc);
			else
				Tcl_CreateCommand(interp,cmdnamebuf,c->proc,
						  c->data,exp_deleteProc);
		}
	}
}

static struct exp_cmd_data cmd_data[]  = {
{"close",	Exp_CloseObjCmd,	0,	0,	EXP_REDEFINE},
#ifdef TCL_DEBUGGER
{"debug",	exp_proc(Exp_DebugCmd),	0,	0},
#endif
{"exp_internal",exp_proc(Exp_ExpInternalCmd),	0,	0},
{"disconnect",	exp_proc(Exp_DisconnectCmd),	0,	0},
{"exit",	exp_proc(Exp_ExitCmd),	0,	EXP_REDEFINE},
{"exp_continue",exp_proc(Exp_ExpContinueCmd),0,	0},
{"fork",	exp_proc(Exp_ForkCmd),	0,	0},
{"exp_pid",	exp_proc(Exp_ExpPidCmd),	0,	0},
{"getpid",	exp_proc(Exp_GetpidDeprecatedCmd),0,	0},
{"interpreter",	Exp_InterpreterObjCmd,	0,	0,	0},
{"log_file",	exp_proc(Exp_LogFileCmd),	0,	0},
{"log_user",	exp_proc(Exp_LogUserCmd),	0,	0},
{"exp_open",	exp_proc(Exp_OpenCmd),	0,	0},
{"overlay",	exp_proc(Exp_OverlayCmd),	0,	0},
{"inter_return",Exp_InterReturnObjCmd,	0,	0,	0},
{"send",	Exp_SendObjCmd,		0,	(ClientData)&sendCD_proc,0},
{"send_error",	Exp_SendObjCmd,		0,	(ClientData)&sendCD_error,0},
{"send_log",	exp_proc(Exp_SendLogCmd),	0,	0},
{"send_tty",	Exp_SendObjCmd,		0,	(ClientData)&sendCD_tty,0},
{"send_user",	Exp_SendObjCmd,		0,	(ClientData)&sendCD_user,0},
{"sleep",	exp_proc(Exp_SleepCmd),	0,	0},
{"spawn",	exp_proc(Exp_SpawnCmd),	0,	0},
{"strace",	exp_proc(Exp_StraceCmd),	0,	0},
{"wait",	exp_proc(Exp_WaitCmd),	0,	0},
{0}};

void
exp_init_most_cmds(interp)
Tcl_Interp *interp;
{
    exp_create_commands(interp,cmd_data);

#ifdef HAVE_PTYTRAP
    Tcl_InitHashTable(&slaveNames,TCL_STRING_KEYS);
#endif /* HAVE_PTYTRAP */
}






Deleted exp_command.h.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312


























































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

/* command.h - definitions for expect commands

Written by: Don Libes, NIST, 2/6/90

Design and implementation of this program was paid for by U.S. tax
dollars.  Therefore it is public domain.  However, the author and NIST
would appreciate credit if this program or parts of it are used.
*/

#ifdef HAVE_SYS_WAIT_H
  /* ISC doesn't def WNOHANG unless _POSIX_SOURCE is def'ed */
# ifdef WNOHANG_REQUIRES_POSIX_SOURCE
#  define _POSIX_SOURCE
# endif
# include <sys/wait.h>
# ifdef WNOHANG_REQUIRES_POSIX_SOURCE
#  undef _POSIX_SOURCE
# endif
#endif

#include <tclPort.h>

#define EXP_CHANNELNAMELEN (16 + TCL_INTEGER_SPACE)

EXTERN char *		exp_get_var _ANSI_ARGS_((Tcl_Interp *,char *));

EXTERN int exp_default_match_max;
EXTERN int exp_default_parity;
EXTERN int exp_default_rm_nulls;

EXTERN int		exp_one_arg_braced _ANSI_ARGS_((Tcl_Obj *));
EXTERN int		exp_eval_with_one_arg _ANSI_ARGS_((ClientData,
				Tcl_Interp *, struct Tcl_Obj * CONST objv[]));
EXTERN void		exp_lowmemcpy _ANSI_ARGS_((char *,char *,int));

EXTERN int exp_flageq_code _ANSI_ARGS_((char *,char *,int));

#define exp_flageq(flag,string,minlen) \
(((string)[0] == (flag)[0]) && (exp_flageq_code(((flag)+1),((string)+1),((minlen)-1))))

/* exp_flageq for single char flags */
#define exp_flageq1(flag,string) \
	((string[0] == flag) && (string[1] == '\0'))

#define EXP_SPAWN_ID_USER		0
#define EXP_SPAWN_ID_ANY_LIT		"-1"

#define EXP_CHANNEL_PREFIX "exp"
#define EXP_CHANNEL_PREFIX_LENGTH 3
#define isExpChannelName(name) \
    (0 == strncmp(name,EXP_CHANNEL_PREFIX,EXP_CHANNEL_PREFIX_LENGTH))

#define exp_is_stdinfd(x)	((x) == 0)
#define exp_is_devttyfd(x)	((x) == exp_dev_tty)

#define EXP_NOPID	0	/* Used when there is no associated pid to */
				/* wait for.  For example: */
				/* 1) When fd opened by someone else, e.g., */
				/* Tcl's open */
				/* 2) When entry not in use */
				/* 3) To tell user pid of "spawn -open" */
				/* 4) stdin, out, error */

#define EXP_NOFD	-1

/* these are occasionally useful to distinguish between various expect */
/* commands and are also used as array indices into the per-fd eg[] arrays */
#define EXP_CMD_BEFORE	0
#define EXP_CMD_AFTER	1
#define EXP_CMD_BG	2
#define EXP_CMD_FG	3

/*
 * This structure describes per-instance state of an Exp channel.
 */

typedef struct ExpState {
    Tcl_Channel channel;	/* Channel associated with this file. */
    char name[EXP_CHANNELNAMELEN+1]; /* expect and interact set variables
				   to channel name, so for efficiency
				   cache it here */
    int fdin;		/* input fd */
    int fdout;		/* output fd - usually the same as fdin, although
			   may be different if channel opened by tcl::open */
    Tcl_Channel channel_orig;   /* If opened by someone else, i.e. tcl::open */
    int fd_slave;	/* slave fd if "spawn -pty" used */

    /* this may go away if we find it is not needed */
    /* it might be needed by inherited channels */
    int validMask;		/* OR'ed combination of TCL_READABLE,
				 * TCL_WRITABLE, or TCL_EXCEPTION: indicates
				 * which operations are valid on the file. */

    int pid;		/* pid or EXP_NOPID if no pid */
    Tcl_Obj *buffer;	/* input buffer */

    int msize;	        /* # of bytes that buffer can hold (max) */
    int umsize;	        /* # of bytes (min) that is guaranteed to match */
			/* this comes from match_max command */
    int printed;	/* # of bytes written to stdout (if logging on) */
                        /* but not actually returned via a match yet */
    int echoed;	        /* additional # of bytes (beyond "printed" above) */
                        /* echoed back but not actually returned via a match */
                        /* yet.  This supports interact -echo */

    int rm_nulls;	/* if nulls should be stripped before pat matching */
    int open;		/* if fdin/fdout open */
    int user_waited;    /* if user has issued "wait" command */
    int sys_waited;	/* if wait() (or variant) has been called */
    int registered;	/* if channel registered */
    WAIT_STATUS_TYPE wait;	/* raw status from wait() */
    int parity;	        /* if parity should be preserved */
    int key;	        /* unique id that identifies what command instance */
                        /* last touched this buffer */
    int force_read;	/* force read to occur (even if buffer already has */
                        /* data).  This supports interact CAN_MATCH */
    int notified;	/* If Tcl_NotifyChannel has been called and we */
		        /* have not yet read from the channel. */
    int notifiedMask;	/* Mask reported when notified. */
    int fg_armed;	/* If Tk_CreateFileHandler is active for responding */
                        /* to foreground events */	   
#ifdef HAVE_PTYTRAP
    char *slave_name;   /* Full name of slave, i.e., /dev/ttyp0 */
#endif /* HAVE_PTYTRAP */
    /* may go away */
    int leaveopen;	/* If we should not call Tcl's close when we close - */
                        /* only relevant if Tcl does the original open */

    Tcl_Interp *bg_interp;	/* interp to process the bg cases */
    int bg_ecount;		/* number of background ecases */
    enum {
	blocked,	/* blocked because we are processing the */
			/* file handler */
	armed,		/* normal state when bg handler in use */
	unarmed,	/* no bg handler in use */
	disarm_req_while_blocked	/* while blocked, a request */
				/* was received to disarm it.  Rather than */
				/* processing the request immediately, defer */
				/* it so that when we later try to unblock */
				/* we will see at that time that it should */
				/* instead be disarmed */
    } bg_status;

    /*
     * If the channel is freed while in the middle of a bg event handler,
     * remember that and defer freeing of the ExpState structure until
     * it is safe.
     */
    int freeWhenBgHandlerUnblocked;

    /* If channel is closed but not yet waited on, we tie up the fd by
     * attaching it to /dev/null.  We play this little game so that we
     * can embed the fd in the channel name.  If we didn't tie up the
     * fd, we'd get channel name collisions.  I'd consider naming the
     * channels independently of the fd, but this makes debugging easier.
     */
    int fdBusy;

    /* 
     * stdinout and stderr never go away so that our internal refs to them
     * don't have to be invalidated.  Having to worry about invalidating them
     * would be a major pain.  */
    int keepForever;

    /*  Remember that "reserved" esPtrs are no longer in use. */
    int valid;
    
    struct ExpState *nextPtr;	/* Pointer to next file in list of all
				 * file channels. */
} ExpState;

#define EXP_SPAWN_ID_BAD	((ExpState *)0)

#define EXP_TIME_INFINITY	-1

extern Tcl_ChannelType expChannelType;

#define EXP_TEMPORARY	1	/* expect */
#define EXP_PERMANENT	2	/* expect_after, expect_before, expect_bg */

#define EXP_DIRECT	1
#define EXP_INDIRECT	2

EXTERN void		expAdjust _ANSI_ARGS_((ExpState *));
EXTERN void		exp_buffer_shuffle _ANSI_ARGS_((Tcl_Interp *,ExpState *,int,char *,char *));
EXTERN int		exp_close _ANSI_ARGS_((Tcl_Interp *,ExpState *));
EXTERN void		exp_close_all _ANSI_ARGS_((Tcl_Interp *));
EXTERN void		exp_ecmd_remove_fd_direct_and_indirect 
				_ANSI_ARGS_((Tcl_Interp *,int));
EXTERN void		exp_trap_on _ANSI_ARGS_((int));
EXTERN int		exp_trap_off _ANSI_ARGS_((char *));

EXTERN void		exp_strftime();

#define exp_deleteProc (void (*)())0
#define exp_deleteObjProc (void (*)())0

EXTERN int expect_key;
EXTERN int exp_configure_count;	/* # of times descriptors have been closed */
				/* or indirect lists have been changed */
EXTERN int exp_nostack_dump;	/* TRUE if user has requested unrolling of */
				/* stack with no trace */

EXTERN void		exp_init_pty _ANSI_ARGS_((void));
EXTERN void		exp_pty_exit _ANSI_ARGS_((void));
EXTERN void		exp_init_tty _ANSI_ARGS_((void));
EXTERN void		exp_init_stdio _ANSI_ARGS_((void));
/*EXTERN void		exp_init_expect _ANSI_ARGS_((Tcl_Interp *));*/
EXTERN void		exp_init_spawn_ids _ANSI_ARGS_((Tcl_Interp *));
EXTERN void		exp_init_spawn_id_vars _ANSI_ARGS_((Tcl_Interp *));
EXTERN void		exp_init_trap _ANSI_ARGS_((void));
EXTERN void		exp_init_send _ANSI_ARGS_((void));
EXTERN void		exp_init_unit_random _ANSI_ARGS_((void));
EXTERN void		exp_init_sig _ANSI_ARGS_((void));
EXTERN void		expChannelInit _ANSI_ARGS_((void));
EXTERN int		expChannelCountGet _ANSI_ARGS_((void));

EXTERN int		exp_tcl2_returnvalue _ANSI_ARGS_((int));
EXTERN int		exp_2tcl_returnvalue _ANSI_ARGS_((int));

EXTERN void		exp_rearm_sigchld _ANSI_ARGS_((Tcl_Interp *));
EXTERN int		exp_string_to_signal _ANSI_ARGS_((Tcl_Interp *,char *));

EXTERN char *exp_onexit_action;

#define exp_new(x)	(x *)malloc(sizeof(x))

struct exp_state_list {
	ExpState *esPtr;
	struct exp_state_list *next;
};

/* describes a -i flag */
struct exp_i {
	int cmdtype;	/* EXP_CMD_XXX.  When an indirect update is */
			/* triggered by Tcl, this helps tell us in what */
			/* exp_i list to look in. */
	int direct;	/* if EXP_DIRECT, then the spawn ids have been given */
			/* literally, else indirectly through a variable */
	int duration;	/* if EXP_PERMANENT, char ptrs here had to be */
			/* malloc'd because Tcl command line went away - */
			/* i.e., in expect_before/after */
	char *variable;
	char *value;	/* if type == direct, this is the string that the */
			/* user originally supplied to the -i flag.  It may */
			/* lose relevance as the fd_list is manipulated */
			/* over time.  If type == direct, this is  the */
			/* cached value of variable use this to tell if it */
			/* has changed or not, and ergo whether it's */
			/* necessary to reparse. */

	int ecount;	/* # of ecases this is used by */

	struct exp_state_list *state_list;
	struct exp_i *next;
};

EXTERN struct exp_i *	exp_new_i_complex _ANSI_ARGS_((Tcl_Interp *,
					char *, int, Tcl_VarTraceProc *));
EXTERN struct exp_i *	exp_new_i_simple _ANSI_ARGS_((ExpState *,int));
EXTERN struct exp_state_list *exp_new_state _ANSI_ARGS_((ExpState *));
EXTERN void		exp_free_i _ANSI_ARGS_((Tcl_Interp *,struct exp_i *,
					Tcl_VarTraceProc *));
EXTERN void		exp_free_state _ANSI_ARGS_((struct exp_state_list *));
EXTERN void		exp_free_state_single _ANSI_ARGS_((struct exp_state_list *));
EXTERN void		exp_i_update _ANSI_ARGS_((Tcl_Interp *,
					struct exp_i *));

/*
 * definitions for creating commands
 */

#define EXP_NOPREFIX	1	/* don't define with "exp_" prefix */
#define EXP_REDEFINE	2	/* stomp on old commands with same name */

#define exp_proc(cmdproc) 0, cmdproc

struct exp_cmd_data {
	char		*name;
	Tcl_ObjCmdProc	*objproc;
	Tcl_CmdProc	*proc;
	ClientData	data;
	int 		flags;
};

EXTERN void		exp_create_commands _ANSI_ARGS_((Tcl_Interp *,
						struct exp_cmd_data *));
EXTERN void		exp_init_main_cmds _ANSI_ARGS_((Tcl_Interp *));
EXTERN void		exp_init_expect_cmds _ANSI_ARGS_((Tcl_Interp *));
EXTERN void		exp_init_most_cmds _ANSI_ARGS_((Tcl_Interp *));
EXTERN void		exp_init_trap_cmds _ANSI_ARGS_((Tcl_Interp *));
EXTERN void		exp_init_interact_cmds _ANSI_ARGS_((Tcl_Interp *));
EXTERN void		exp_init_tty_cmds();

EXTERN ExpState *	expStateCheck _ANSI_ARGS_((Tcl_Interp *,ExpState *,int,int,char *));
EXTERN ExpState *       expStateCurrent _ANSI_ARGS_((Tcl_Interp *,int,int,int));
EXTERN ExpState *       expStateFromChannelName _ANSI_ARGS_((Tcl_Interp *,char *,int,int,int,char *));
EXTERN void		expStateFree _ANSI_ARGS_((ExpState *));

EXTERN ExpState *	expCreateChannel _ANSI_ARGS_((Tcl_Interp *,int,int,int));
EXTERN ExpState *	expWaitOnAny _ANSI_ARGS_((void));
EXTERN ExpState *	expWaitOnOne _ANSI_ARGS_((void));
EXTERN void		expExpectVarsInit _ANSI_ARGS_((void));
EXTERN int		expStateAnyIs _ANSI_ARGS_((ExpState *));
EXTERN int		expDevttyIs _ANSI_ARGS_((ExpState *));
EXTERN int		expStdinOutIs _ANSI_ARGS_((ExpState *));
EXTERN ExpState *	expStdinoutGet _ANSI_ARGS_((void));
EXTERN ExpState *	expDevttyGet _ANSI_ARGS_((void));

/* generic functions that really should be provided by Tcl */
EXTERN int		expSizeGet _ANSI_ARGS_((ExpState *));
EXTERN int		expSizeZero _ANSI_ARGS_((ExpState *));






Deleted exp_console.c.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69







































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

/* exp_console.c - grab console.  This stuff is in a separate file to
avoid unpleasantness of AIX (3.2.4) .h files which provide no way to
reference TIOCCONS and include both sys/ioctl.h and sys/sys/stropts.h
without getting some sort of warning from the compiler.  The problem
is that both define _IO but only ioctl.h checks to see if it is
defined first.  This would suggest that it is sufficient to include
ioctl.h after stropts.h.  Unfortunately, ioctl.h, having seen that _IO
is defined, then fails to define other important things (like _IOW).

Written by: Don Libes, NIST, 2/6/90

Design and implementation of this program was paid for by U.S. tax
dollars.  Therefore it is public domain.  However, the author and NIST
would appreciate credit if this program or parts of it are used.
*/

#include "expect_cf.h"
#include <stdio.h>
#include <sys/types.h>
#include <sys/ioctl.h>

#ifdef HAVE_STRREDIR_H
#include <sys/strredir.h>
# ifdef SRIOCSREDIR
#  undef TIOCCONS
# endif
#endif

#ifdef HAVE_SYS_FCNTL_H
#include <sys/fcntl.h>
#endif

#include "tcl.h"
#include "exp_rename.h"
#include "exp_prog.h"
#include "exp_command.h"
#include "exp_log.h"

static void
exp_console_manipulation_failed(s)
char *s;
{
    expErrorLog("expect: spawn: cannot %s console, check permissions of /dev/console\n",s);
    exit(-1);
}

void
exp_console_set()
{
#ifdef SRIOCSREDIR
	int fd;

	if ((fd = open("/dev/console", O_RDONLY)) == -1) {
		exp_console_manipulation_failed("open");
	}
	if (ioctl(fd, SRIOCSREDIR, 0) == -1) {
		exp_console_manipulation_failed("redirect");
	}
	close(fd);
#endif

#ifdef TIOCCONS
	int on = 1;

	if (ioctl(0,TIOCCONS,(char *)&on) == -1) {
		exp_console_manipulation_failed("redirect");
	}
#endif /*TIOCCONS*/
}






Deleted exp_event.c.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351

































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

/* exp_event.c - event interface for Expect

Written by: Don Libes, NIST, 2/6/90

I hereby place this software in the public domain.  However, the author and
NIST would appreciate credit if this program or parts of it are used.

*/

#include "expect_cf.h"
#include <stdio.h>
#include <errno.h>
#include <sys/types.h>

#ifdef HAVE_SYS_WAIT_H
#include <sys/wait.h>
#endif

#ifdef HAVE_PTYTRAP
#  include <sys/ptyio.h>
#endif

#include "tcl.h"
#include "exp_prog.h"
#include "exp_command.h"	/* for ExpState defs */
#include "exp_event.h"

typedef struct ThreadSpecificData {
    int rr;		/* round robin ptr */
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;

void
exp_event_disarm_bg(esPtr)
ExpState *esPtr;
{
    Tcl_DeleteChannelHandler(esPtr->channel,exp_background_channelhandler,(ClientData)esPtr);
}

static void
exp_arm_background_channelhandler_force(esPtr)
ExpState *esPtr;
{
    Tcl_CreateChannelHandler(esPtr->channel,
	    TCL_READABLE|TCL_EXCEPTION,
	    exp_background_channelhandler,
	    (ClientData)esPtr);

    esPtr->bg_status = armed;
}

void
exp_arm_background_channelhandler(esPtr)
ExpState *esPtr;
{
    switch (esPtr->bg_status) {
	case unarmed:
	    exp_arm_background_channelhandler_force(esPtr);
	    break;
	case disarm_req_while_blocked:
	    esPtr->bg_status = blocked;	/* forget request */
	    break;
	case armed:
	case blocked:
	    /* do nothing */
	    break;
    }
}

void
exp_disarm_background_channelhandler(esPtr)
ExpState *esPtr;
{
    switch (esPtr->bg_status) {
	case blocked:
	    esPtr->bg_status = disarm_req_while_blocked;
	    break;
	case armed:
	    esPtr->bg_status = unarmed;
	    exp_event_disarm_bg(esPtr);
	    break;
	case disarm_req_while_blocked:
	case unarmed:
	    /* do nothing */
	    break;
    }
}

/* ignore block status and forcibly disarm handler - called from exp_close. */
/* After exp_close returns, we will not have an opportunity to disarm */
/* because the fd will be invalid, so we force it here. */
void
exp_disarm_background_channelhandler_force(esPtr)
ExpState *esPtr;
{
    switch (esPtr->bg_status) {
	case blocked:
	case disarm_req_while_blocked:
	case armed:
	    esPtr->bg_status = unarmed;
	    exp_event_disarm_bg(esPtr);
	    break;
	case unarmed:
	    /* do nothing */
	    break;
    }
}

/* this can only be called at the end of the bg handler in which */
/* case we know the status is some kind of "blocked" */
void
exp_unblock_background_channelhandler(esPtr)
    ExpState *esPtr;
{
    switch (esPtr->bg_status) {
	case blocked:
	    exp_arm_background_channelhandler_force(esPtr);
	    break;
	case disarm_req_while_blocked:
	    exp_disarm_background_channelhandler_force(esPtr);
	    break;
    }
}

/* this can only be called at the beginning of the bg handler in which */
/* case we know the status must be "armed" */
void
exp_block_background_channelhandler(esPtr)
ExpState *esPtr;
{
    esPtr->bg_status = blocked;
    exp_event_disarm_bg(esPtr);
}


/*ARGSUSED*/
static void
exp_timehandler(clientData)
ClientData clientData;
{
    *(int *)clientData = TRUE;	
}

static void exp_channelhandler(clientData,mask)
ClientData clientData;
int mask;
{
    ExpState *esPtr = (ExpState *)clientData;

    esPtr->notified = TRUE;
    esPtr->notifiedMask = mask;

    exp_event_disarm_fg(esPtr);
}

void
exp_event_disarm_fg(esPtr)
ExpState *esPtr;
{
    /*printf("DeleteChannelHandler: %s\r\n",esPtr->name);*/
    Tcl_DeleteChannelHandler(esPtr->channel,exp_channelhandler,(ClientData)esPtr);

    /* remember that ChannelHandler has been disabled so that */
    /* it can be turned on for fg expect's as well as bg */
    esPtr->fg_armed = FALSE;
}

/* returns status, one of EOF, TIMEOUT, ERROR or DATA */
/* can now return RECONFIGURE, too */
/*ARGSUSED*/
int exp_get_next_event(interp,esPtrs,n,esPtrOut,timeout,key)
Tcl_Interp *interp;
ExpState *(esPtrs[]);
int n;			/* # of esPtrs */
ExpState **esPtrOut;	/* 1st ready esPtr, not set if none */
int timeout;		/* seconds */
int key;
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    ExpState *esPtr;
    int i;	/* index into in-array */
#ifdef HAVE_PTYTRAP
    struct request_info ioctl_info;
#endif

    int old_configure_count = exp_configure_count;

    int timerFired = FALSE;
    Tcl_TimerToken timerToken = 0;/* handle to Tcl timehandler descriptor */
    /* We must delete any timer before returning.  Doing so throughout
     * the code makes it unreadable; isolate the unreadable nonsense here.
     */
#define RETURN(x) { \
	if (timerToken) Tcl_DeleteTimerHandler(timerToken); \
	return(x); \
    }

    for (;;) {
	/* if anything has been touched by someone else, report that */
	/* an event has been received */

	for (i=0;i<n;i++) {
	    tsdPtr->rr++;
	    if (tsdPtr->rr >= n) tsdPtr->rr = 0;

	    esPtr = esPtrs[tsdPtr->rr];

	    if (esPtr->key != key) {
		esPtr->key = key;
		esPtr->force_read = FALSE;
		*esPtrOut = esPtr;
		RETURN(EXP_DATA_OLD);
	    } else if ((!esPtr->force_read) && (!expSizeZero(esPtr))) {
		*esPtrOut = esPtr;
		RETURN(EXP_DATA_OLD);
	    } else if (esPtr->notified) {
		/* this test of the mask should be redundant but SunOS */
		/* raises both READABLE and EXCEPTION (for no */
		/* apparent reason) when selecting on a plain file */
		if (esPtr->notifiedMask & TCL_READABLE) {
		    *esPtrOut = esPtr;
		    esPtr->notified = FALSE;
		    RETURN(EXP_DATA_NEW);
		}
		/*
		 * at this point we know that the event must be TCL_EXCEPTION
		 * indicating either EOF or HP ptytrap.
		 */
#ifndef HAVE_PTYTRAP
		RETURN(EXP_EOF);
#else
		if (ioctl(esPtr->fdin,TIOCREQCHECK,&ioctl_info) < 0) {
		    expDiagLog("ioctl error on TIOCREQCHECK: %s", Tcl_PosixError(interp));
		    RETURN(EXP_TCLERROR);
		}
		if (ioctl_info.request == TIOCCLOSE) {
		    RETURN(EXP_EOF);
		}
		if (ioctl(esPtr->fdin, TIOCREQSET, &ioctl_info) < 0) {
		    expDiagLog("ioctl error on TIOCREQSET after ioctl or open on slave: %s", Tcl_ErrnoMsg(errno));
		}
		/* presumably, we trapped an open here */
		/* so simply continue by falling thru */
#endif /* !HAVE_PTYTRAP */
	    }
	}

	if (!timerToken) {
	    if (timeout >= 0) {
		timerToken = Tcl_CreateTimerHandler(1000*timeout,
			exp_timehandler,
			(ClientData)&timerFired);
	    }
	}

	/* make sure that all fds that should be armed are */
	for (i=0;i<n;i++) {
	    esPtr = esPtrs[i];
	    if (!esPtr->fg_armed) {
		/*printf("CreateChannelHandler: %s\r\n",esPtr->name);*/
		Tcl_CreateChannelHandler(
					 esPtr->channel,
					 TCL_READABLE | TCL_EXCEPTION,
					 exp_channelhandler,
					 (ClientData)esPtr);
		esPtr->fg_armed = TRUE;
	    }
	}

	Tcl_DoOneEvent(0);	/* do any event */
	
	if (timerFired) return(EXP_TIMEOUT);
	
	if (old_configure_count != exp_configure_count) {
	    RETURN(EXP_RECONFIGURE);
	}
    }
}

/* Having been told there was an event for a specific ExpState, get it */
/* This returns status, one of EOF, TIMEOUT, ERROR or DATA */
/*ARGSUSED*/
int
exp_get_next_event_info(interp,esPtr)
Tcl_Interp *interp;
ExpState *esPtr;
{
#ifdef HAVE_PTYTRAP
    struct request_info ioctl_info;
#endif

    if (esPtr->notifiedMask & TCL_READABLE) return EXP_DATA_NEW;

    /* ready_mask must contain TCL_EXCEPTION */
#ifndef HAVE_PTYTRAP
    return(EXP_EOF);
#else
    if (ioctl(esPtr->fdin,TIOCREQCHECK,&ioctl_info) < 0) {
	expDiagLog("ioctl error on TIOCREQCHECK: %s",
		Tcl_PosixError(interp));
	return(EXP_TCLERROR);
    }
    if (ioctl_info.request == TIOCCLOSE) {
	return(EXP_EOF);
    }
    if (ioctl(esPtr->fdin, TIOCREQSET, &ioctl_info) < 0) {
	expDiagLog("ioctl error on TIOCREQSET after ioctl or open on slave: %s", Tcl_ErrnoMsg(errno));
    }
    /* presumably, we trapped an open here */
    /* call it an error for lack of anything more descriptive */
    /* it will be thrown away by caller anyway */
    return EXP_TCLERROR;
#endif
}

/*ARGSUSED*/
int	/* returns TCL_XXX */
exp_dsleep(interp,sec)
Tcl_Interp *interp;
double sec;
{
    int timerFired = FALSE;

    Tcl_CreateTimerHandler((int)(sec*1000),exp_timehandler,(ClientData)&timerFired);

    while (!timerFired) {
	Tcl_DoOneEvent(0);
    }
    return TCL_OK;
}

static char destroy_cmd[] = "destroy .";

static void
exp_event_exit_real(interp)
Tcl_Interp *interp;
{
    Tcl_Eval(interp,destroy_cmd);
}

/* set things up for later calls to event handler */
void
exp_init_event()
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    tsdPtr->rr = 0;

    exp_event_exit = exp_event_exit_real;
}






Deleted exp_event.h.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21























-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

/* exp_event.h - event definitions */

int exp_get_next_event _ANSI_ARGS_((Tcl_Interp *,ExpState **, int, ExpState **, int, int));
int exp_get_next_event_info _ANSI_ARGS_((Tcl_Interp *, ExpState *));
int exp_dsleep _ANSI_ARGS_((Tcl_Interp *, double));
void exp_init_event _ANSI_ARGS_((void));

extern void (*exp_event_exit) _ANSI_ARGS_((Tcl_Interp *));

void exp_event_disarm _ANSI_ARGS_((ExpState *,Tcl_FileProc *));
void exp_event_disarm_bg _ANSI_ARGS_((ExpState *));
void exp_event_disarm_fg _ANSI_ARGS_((ExpState *));

void exp_arm_background_channelhandler _ANSI_ARGS_((ExpState *));
void exp_disarm_background_channelhandler _ANSI_ARGS_((ExpState *));
void exp_disarm_background_channelhandler_force _ANSI_ARGS_((ExpState *));
void exp_unblock_background_channelhandler _ANSI_ARGS_((ExpState *));
void exp_block_background_channelhandler _ANSI_ARGS_((ExpState *));

void exp_background_channelhandler _ANSI_ARGS_((ClientData,int));







Deleted exp_glob.c.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234












































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

/* exp_glob.c - expect functions for doing glob

Based on Tcl's glob functions but modified to support anchors and to
return information about the possibility of future matches

Modifications by: Don Libes, NIST, 2/6/90

Design and implementation of this program was paid for by U.S. tax
dollars.  Therefore it is public domain.  However, the author and NIST
would appreciate credit if this program or parts of it are used.

*/

#include "expect_cf.h"
#include "tcl.h"
#include "exp_int.h"

/* The following functions implement expect's glob-style string matching */
/* Exp_StringMatch allow's implements the unanchored front (or conversely */
/* the '^') feature.  Exp_StringMatch2 does the rest of the work. */
int	/* returns # of BYTES that matched */
Exp_StringCaseMatch(string, pattern, nocase, offset)		/* INTL */
char *string;
char *pattern;
int nocase;
int *offset;	/* offset in bytes from beginning of string where pattern matches */
{
	char *s;
	int sm;	/* count of bytes matched or -1 */
	int caret = FALSE;
	int star = FALSE;

	*offset = 0;

	if (pattern[0] == '^') {
		caret = TRUE;
		pattern++;
	} else if (pattern[0] == '*') {
		star = TRUE;
	}

	/*
	 * test if pattern matches in initial position.
	 * This handles front-anchor and 1st iteration of non-front-anchor.
	 * Note that 1st iteration must be tried even if string is empty.
	 */

	sm = Exp_StringCaseMatch2(string,pattern, nocase);
	if (sm >= 0) return(sm);

	if (caret) return -1;
	if (star) return -1;

	if (*string == '\0') return -1;

	for (s = Tcl_UtfNext(string);*s;s = Tcl_UtfNext(s)) {
 		sm = Exp_StringCaseMatch2(s,pattern, nocase);
		if (sm != -1) {
			*offset = s-string;
			return(sm);
		}
	}
	return -1;
}

/* Exp_StringCaseMatch2 --

Like Tcl_StringCaseMatch except that
1) returns number of characters matched, -1 if failed.
	(Can return 0 on patterns like "" or "$")
2) does not require pattern to match to end of string
3) much of code is stolen from Tcl_StringMatch
4) front-anchor is assumed (Tcl_StringMatch retries for non-front-anchor)
*/

int Exp_StringCaseMatch2(string,pattern, nocase)	/* INTL */
    register char *string;	/* String. */
    register char *pattern;	/* Pattern, which may contain
				 * special characters. */
    int nocase;
{
    Tcl_UniChar ch1, ch2;
    int match = 0;	/* # of bytes matched */
    char *oldString;

    char *pstart = pattern;

    while (1) {
	/* If at end of pattern, success! */
	if (*pattern == 0) {
		return match;
	}

	/* If last pattern character is '$', verify that entire
	 * string has been matched.
	 */
	if ((*pattern == '$') && (pattern[1] == 0)) {
		if (*string == 0) return(match);
		else return(-1);		
	}

	/* Check for a "*" as the next pattern character.  It matches
	 * any substring.  We handle this by calling ourselves
	 * recursively for each postfix of string, until either we
	 * match or we reach the end of the string.
	 */
	
	if (*pattern == '*') {
	    char *tail;

	    pattern += 1;
	    if (*pattern == 0) {
		return(strlen(string)+match); /* DEL */
	    }

	    /* find LONGEST match */
	    tail = string + strlen(string);
	    while (1) {
		int rc;

		if (-1 != (rc = Exp_StringCaseMatch2(tail, pattern, nocase))) {
		    return match + (tail - string) + rc;
		    /* match = # of bytes we've skipped before this */
		    /* (...) = # of bytes we've skipped due to "*" */
		    /* rc    = # of bytes we've matched after "*" */
		}

		/* if we've backed up to beginning of string, give up */
		if (tail == string) break;
		tail = Tcl_UtfPrev(tail,string);
	    }
	    return -1;					/* DEL */
	}
    
	/*
	 * after this point, all patterns must match at least one
	 * character, so check this
	 */

	if (*string == 0) return -1;

	/* Check for a "?" as the next pattern character.  It matches
	 * any single character.
	 */

	if (*pattern == '?') {
	    pattern++;
	    oldString = string;
	    string = Tcl_UtfNext(string);
	    match += (string - oldString); /* incr by # of bytes in char */
	    continue;
	}

	/* Check for a "[" as the next pattern character.  It is followed
	 * by a list of characters that are acceptable, or by a range
	 * (two characters separated by "-").
	 */
	
	if (*pattern == '[') {
	    Tcl_UniChar ch, startChar, endChar;

	    pattern++;
	    oldString = string;
	    string += Tcl_UtfToUniChar(string, &ch);

	    while (1) {
		if ((*pattern == ']') || (*pattern == '\0')) {
		    return -1;			/* was 0; DEL */
		}
		pattern += Tcl_UtfToUniChar(pattern, &startChar);
		if (nocase) {
		    startChar = Tcl_UniCharToLower(startChar);
		}
		if (*pattern == '-') {
		    pattern++;
		    if (*pattern == '\0') {
			return -1;		/* DEL */
		    }
		    pattern += Tcl_UtfToUniChar(pattern, &endChar);
		    if (nocase) {
			endChar = Tcl_UniCharToLower(endChar);
		    }
		    if (((startChar <= ch) && (ch <= endChar))
			    || ((endChar <= ch) && (ch <= startChar))) {
			/*
			 * Matches ranges of form [a-z] or [z-a].
			 */

			break;
		    }
		} else if (startChar == ch) {
		    break;
		}
	    }
	    while (*pattern != ']') {
		if (*pattern == '\0') {
		    pattern = Tcl_UtfPrev(pattern, pstart);
		    break;
		}
		pattern = Tcl_UtfNext(pattern);
	    }
	    pattern++;
	    match += (string - oldString); /* incr by # of bytes in char */
	    continue;
	}
 
	/* If the next pattern character is backslash, strip it off
	 * so we do exact matching on the character that follows.
	 */
	
	if (*pattern == '\\') {
	    pattern += 1;
	    if (*pattern == 0) {
		return -1;
	    }
	}

	/* There's no special character.  Just make sure that the next
	 * characters of each string match.
	 */
	
	oldString = string;
	string  += Tcl_UtfToUniChar(string, &ch1);
	pattern += Tcl_UtfToUniChar(pattern, &ch2);
	if (nocase) {
	    if (Tcl_UniCharToLower(ch1) != Tcl_UniCharToLower(ch2)) {
		return -1;
	    }
	} else if (ch1 != ch2) {
	    return -1;
	}
	match += (string - oldString);  /* incr by # of bytes in char */
    }
}






Deleted exp_int.h.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39









































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

/* exp_int.h - private symbols common to both expect program and library

Written by: Don Libes, [email protected], NIST, 12/3/90

Design and implementation of this program was paid for by U.S. tax
dollars.  Therefore it is public domain.  However, the author and NIST
would appreciate credit if this program or parts of it are used.
*/

#ifndef _EXPECT_INT_H
#define _EXPECT_INT_H

#ifndef TRUE
#define FALSE 0
#define TRUE 1
#endif

#ifndef HAVE_MEMCPY
#define memcpy(x,y,len) bcopy(y,x,len)
#endif

#include <errno.h>

void	exp_console_set     _ANSI_ARGS_((void));
void	expDiagLogPtrSet    _ANSI_ARGS_((void (*)_ANSI_ARGS_((char *))));
void	expDiagLogPtr       _ANSI_ARGS_((char *));
void	expDiagLogPtrX      _ANSI_ARGS_((char *,int));
void	expDiagLogPtrStr    _ANSI_ARGS_((char *,char *));
void	expDiagLogPtrStrStr _ANSI_ARGS_((char *,char *,char *));
void	expErrnoMsgSet      _ANSI_ARGS_((char * (*) _ANSI_ARGS_((int))));
char *	expErrnoMsg         _ANSI_ARGS_((int));

#ifdef NO_STDLIB_H
#  include "../compat/stdlib.h"
#else
#  include <stdlib.h>		/* for malloc */
#endif /*NO_STDLIB_H*/

#endif /* _EXPECT_INT_H */






Deleted exp_inter.c.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175

































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

/* interact (using select) - give user keyboard control

Written by: Don Libes, NIST, 2/6/90

Design and implementation of this program was paid for by U.S. tax
dollars.  Therefore it is public domain.  However, the author and NIST
would appreciate credit if this program or parts of it are used.

*/

#include "expect_cf.h"
#include <stdio.h>
#ifdef HAVE_INTTYPES_H
#  include <inttypes.h>
#endif
#include <sys/types.h>
#ifdef HAVE_UNISTD_H
# include <unistd.h>
#endif

#ifdef TIME_WITH_SYS_TIME
# include <sys/time.h>
# include <time.h>
#else
# if HAVE_SYS_TIME_H
#  include <sys/time.h>
# else
#  include <time.h>
# endif
#endif
  
#ifdef HAVE_SYS_WAIT_H
#include <sys/wait.h>
#endif

#include <ctype.h>

#include "tcl.h"
#include "string.h"

#include "exp_tty_in.h"
#include "exp_rename.h"
#include "exp_prog.h"
#include "exp_command.h"
#include "exp_log.h"

typedef struct ThreadSpecificData {
    Tcl_Obj *cmdObjReturn;
    Tcl_Obj *cmdObjInterpreter;
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;

#define INTER_OUT "interact_out"
#define out(var,val) \
 expDiagLog("interact: set %s(%s) ",INTER_OUT,var); \
 expDiagLogU(expPrintify(val)); \
 expDiagLogU("\"\r\n"); \
 Tcl_SetVar2(interp,INTER_OUT,var,val,0);

/*
 * tests if we are running this using a real tty
 *
 * these tests are currently only used to control what gets written to the
 * logfile.  Note that removal of the test of "..._is_tty" means that stdin
 * or stdout could be redirected and yet stdout would still be logged.
 * However, it's not clear why anyone would use log_file when these are
 * redirected in the first place.  On the other hand, it is reasonable to
 * run expect as a daemon in which case, stdin/out do not appear to be
 * ttys, yet it makes sense for them to be logged with log_file as if they
 * were.
 */
#if 0
#define real_tty_output(x) (exp_stdout_is_tty && (((x)==1) || ((x)==exp_dev_tty)))
#define real_tty_input(x) (exp_stdin_is_tty && (((x)==0) || ((x)==exp_dev_tty)))
#endif

#define real_tty_output(x) ((x->fdout == 1) || (expDevttyIs(x)))
#define real_tty_input(x) (exp_stdin_is_tty && ((x->fdin==0) || (expDevttyIs(x))))

#define new(x)	(x *)ckalloc(sizeof(x))

struct action {
	Tcl_Obj *statement;
	int tty_reset;		/* if true, reset tty mode upon action */
	int iread;		/* if true, reread indirects */
	int iwrite;		/* if true, write spawn_id element */
	struct action *next;	/* chain only for later for freeing */
};

struct keymap {
	Tcl_Obj *keys;	/* original pattern provided by user */
	int re;		/* true if looking to match a regexp. */
	int null;	/* true if looking to match 0 byte */
	int case_sensitive;
	int echo;	/* if keystrokes should be echoed */
	int writethru;	/* if keystrokes should go through to process */
	int indices;	/* true if should write indices */
	struct action action;
	struct keymap *next;
};

struct output {
	struct exp_i *i_list;
	struct action *action_eof;
	struct output *next;
};

struct input {
	struct exp_i *i_list;
	struct output *output;
	struct action *action_eof;
	struct action *action_timeout;
	struct keymap *keymap;
	int timeout_nominal;		/* timeout nominal */
	int timeout_remaining;		/* timeout remaining */
	struct input *next;
};

/*
 * Once we are handed an ExpState from the event handler, we can figure out
 * which "struct input *" it references by using expStateToInput.  This has is
 * populated by expCreateStateToInput.
 */

struct input *
expStateToInput(hash,esPtr)
    ExpState *esPtr;
    Tcl_HashTable *hash;
{
    Tcl_HashEntry *entry = Tcl_FindHashEntry(hash,(char *)esPtr);

    if (!entry) {
	/* should never happen */
	return 0;
    }
    return ((struct input *)Tcl_GetHashValue(entry));
}

void
expCreateStateToInput(hash,esPtr,inp)
    ExpState *esPtr;
    Tcl_HashTable *hash;
    struct input *inp;
{
    Tcl_HashEntry *entry;
    int newPtr;

    entry = Tcl_CreateHashEntry(hash,(char *)esPtr,&newPtr);
    Tcl_SetHashValue(entry,(ClientData)inp);
}

static void free_input();
static void free_keymap();
static void free_output();
static void free_action();
static struct action *new_action();
static int inter_eval();

/* intMatch() accepts user keystrokes and returns one of MATCH,
CANMATCH, or CANTMATCH.  These describe whether the keystrokes match a
key sequence, and could or can't if more characters arrive.  The
function assigns a matching keymap if there is a match or can-match.
A matching keymap is assigned on can-match so we know whether to echo
or not.

intMatch is optimized (if you can call it that) towards a small
number of key mappings, but still works well for large maps, since no
function calls are made, and we stop as soon as there is a single-char
mismatch, and go on to the next one.  A hash table or compiled DFA
probably would not buy very much here for most maps.

The basic idea of how this works is it does a smart sequential search.
At each position of the input string, we attempt to match each of the
keymaps.  If at least one matches, the first match is returned.

If there is a CANMATCH and there are more keymaps to try, we continue
trying.  If there are no more keymaps to try, we stop trying and
return with an indication of the first keymap that can match.

Note that I've hacked up the regexp pattern matcher in two ways.  One
is to force the pattern to always be anchored at the front.  That way,
it doesn't waste time attempting to match later in the string (before
we're ready).  The other is to return can-match.

*/

static int
intMatch(esPtr,keymap,km_match,matchLen,skip,info)
    ExpState *esPtr;
    struct keymap *keymap;	/* linked list of keymaps */
    struct keymap **km_match;	/* keymap that matches or can match */
    int *matchLen;		/* # of bytes that matched */
    int *skip;			/* # of chars to skip */
    Tcl_RegExpInfo *info;
{
    char *string;
    struct keymap *km;
    char *ks;		/* string from a keymap */

    char *start_search;	/* where in string to start searching */
    int offset;		/* # of chars from string to start searching */

    char *string_end;
    int stringBytes, bytesThisChar;
    int rm_nulls;		/* skip nulls if true */
    Tcl_UniChar ch;

    string = Tcl_GetStringFromObj(esPtr->buffer,&stringBytes);

    /* assert (*km == 0) */

    /* a shortcut that should help master output which typically */
    /* is lengthy and has no key maps.  Otherwise it would mindlessly */
    /* iterate on each character anyway. */
    if (!keymap) {
	*skip = stringBytes;
	return(EXP_CANTMATCH);
    }

    rm_nulls = esPtr->rm_nulls;

    string_end = string + stringBytes;

    /*
     * Maintain both a character index and a string pointer so we
     * can easily index into either the UTF or the Unicode representations.
     */

    for (start_search = string, offset = 0;
	 start_search < string_end;
	 start_search += bytesThisChar, offset++) {

	bytesThisChar = Tcl_UtfToUniChar(start_search, &ch);
	
	if (*km_match) break; /* if we've already found a CANMATCH */
			/* don't bother starting search from positions */
			/* further along the string */

	for (km=keymap;km;km=km->next) {
	    char *s;	/* current character being examined */

	    if (km->null) {
		if (ch == 0) {
		    *skip = start_search-string;
		    *matchLen = 1;	/* s - start_search == 1 */
		    *km_match = km;
		    return(EXP_MATCH);
	        }
	    } else if (!km->re) {
		int slen, kslen;
		Tcl_UniChar sch, ksch;
		
		/* fixed string */

		ks = Tcl_GetString(km->keys);
		for (s = start_search;; s += slen, ks += kslen) {
		    /* if we hit the end of this map, must've matched! */
		    if (*ks == 0) {
			*skip = start_search-string;
			*matchLen = s-start_search;
			*km_match = km;
			return(EXP_MATCH);
		    }

		    /* if we ran out of user-supplied characters, and */
		    /* still haven't matched, it might match if the user */
		    /* supplies more characters next time */

		    if (s == string_end) {
			/* skip to next key entry, but remember */
			/* possibility that this entry might match */
			if (!*km_match) *km_match = km;
			break;
		    }

		    slen = Tcl_UtfToUniChar(s, &sch);
		    kslen = Tcl_UtfToUniChar(ks, &ksch);
		    
		    if (sch == ksch) continue;
		    if ((sch == '\0') && rm_nulls) {
			kslen = 0;
			continue;
		    }
		    break;
		}
	    } else {
		/* regexp */
		Tcl_RegExp re;
		int flags;
		int result;

		re = Tcl_GetRegExpFromObj(NULL, km->keys,
			TCL_REG_ADVANCED|TCL_REG_BOSONLY);
		flags = (offset > 0) ? TCL_REG_NOTBOL : 0;

		result = Tcl_RegExpExecObj(NULL, re, esPtr->buffer, offset,
			-1 /* nmatches */, flags);
		if (result > 0) {
		    *km_match = km;
		    *skip = start_search-string;
		    Tcl_RegExpGetInfo(re, info);
		    *matchLen = Tcl_UtfAtIndex(start_search,info->matches[0].end) - start_search;
		    return EXP_MATCH;
		} else if (result == 0) {
		    Tcl_RegExpGetInfo(re, info);

		    /*
		     * Check to see if there was a partial match starting
		     * at the current character.
		     */
		    if (info->extendStart == 0) {
			if (!*km_match) *km_match = km;
		    }
		}		    
	    }
	}
    }

    if (*km_match) {
	/* report CANMATCH for -re and -ex */

	/*
	 * since canmatch is only detected after we've advanced too far,
	 * adjust start_search back to make other computations simpler
	 */
	start_search--;

	*skip = start_search - string;
	*matchLen = string_end - start_search;
	return(EXP_CANMATCH);
    }
    
    *skip = start_search-string;
    return(EXP_CANTMATCH);
}

/* put regexp result in variables */
static void
intRegExpMatchProcess(interp,esPtr,km,info)
     Tcl_Interp *interp;
     ExpState *esPtr;
     struct keymap *km;	/* ptr for above while parsing */
     Tcl_RegExpInfo *info;
{
    char name[20], value[20];
    int i;

    for (i=0;i<=info->nsubs;i++) {
	int start, end;
	Tcl_Obj *val;

	start = info->matches[i].start;
	if (start == -1) continue;
	end = info->matches[i].end-1;

	if (km->indices) {
	    /* start index */
	    sprintf(name,"%d,start",i);
	    sprintf(value,"%d",start);
	    out(name,value);
		    
	    /* end index */
	    sprintf(name,"%d,end",i);
	    sprintf(value,"%d",end);
	    out(name,value);
	}

	/* string itself */
	sprintf(name,"%d,string",i);
	val = Tcl_GetRange(esPtr->buffer, start, end);
	expDiagLog("expect_background: set %s(%s) \"",INTER_OUT,name);
	expDiagLogU(expPrintifyObj(val));
	expDiagLogU("\"\r\n");
	Tcl_SetVar2Ex(interp,INTER_OUT,name,val,0);
    }
}

/*
 * echo chars
 */ 
static void
intEcho(esPtr,skipBytes,matchBytes)
    ExpState *esPtr;
    int skipBytes;
    int matchBytes;
{
    int seenBytes;	/* either printed or echoed */
    int echoBytes;
    int offsetBytes;

    /* write is unlikely to fail, since we just read from same descriptor */
    seenBytes = esPtr->printed + esPtr->echoed;
    if (skipBytes >= seenBytes) {
	echoBytes = matchBytes;
	offsetBytes = skipBytes;
    } else if ((matchBytes + skipBytes - seenBytes) > 0) {
	echoBytes = matchBytes + skipBytes - seenBytes;
	offsetBytes = seenBytes;
    }

    Tcl_WriteChars(esPtr->channel,
		   Tcl_GetString(esPtr->buffer) + offsetBytes,
		   echoBytes);

    esPtr->echoed = matchBytes + skipBytes - esPtr->printed;
}

/*
 * intRead() does the logical equivalent of a read() for the interact command.
 * Returns # of bytes read or negative number (EXP_XXX) indicating unusual event.
 */
static int
intRead(interp,esPtr,warnOnBufferFull,interruptible,key)
    Tcl_Interp *interp;
    ExpState *esPtr;
    int warnOnBufferFull;
    int interruptible;
    int key;
{
    char *eobOld;  /* old end of buffer */
    int cc;
    int size;
    char *str;

    str = Tcl_GetStringFromObj(esPtr->buffer,&size);
    eobOld = str+size;

    if (size + TCL_UTF_MAX >= esPtr->msize) {
	/*
	 * In theory, interact could be invoked when this situation
	 * already exists, hence the "probably" in the warning below
	 */
	if (warnOnBufferFull) {
	    expDiagLogU("WARNING: interact buffer is full, probably because your\r\n");
	    expDiagLogU("patterns have matched all of it but require more chars\r\n");
	    expDiagLogU("in order to complete the match.\r\n");
	    expDiagLogU("Dumping first half of buffer in order to continue\r\n");
	    expDiagLogU("Recommend you enlarge the buffer or fix your patterns.\r\n");
	}
	exp_buffer_shuffle(interp,esPtr,0,INTER_OUT,"interact");
    }
    if (!interruptible) {
	cc = Tcl_ReadChars(esPtr->channel,
		esPtr->buffer,
		esPtr->msize - (size / TCL_UTF_MAX),
		1 /* append */);
    } else {
#ifdef SIMPLE_EVENT
	cc = intIRead(esPtr->channel,
		esPtr->buffer,
		esPtr->msize - (size / TCL_UTF_MAX),
		1 /* append */);
#endif
    }

    if (cc > 0) {
	expDiagLog("spawn id %s sent <",esPtr->name);
	expDiagLogU(expPrintify(eobOld));
	expDiagLogU(">\r\n");

	esPtr->key = key;
    }
    return cc;
}



#ifdef SIMPLE_EVENT

/*

The way that the "simple" interact works is that the original Expect
process reads from the tty and writes to the spawned process.  A child
process is forked to read from the spawned process and write to the
tty.  It looks like this:

                        user
                    --> tty >--
                   /           \
                  ^             v
                child        original
               process        Expect
                  ^          process
                  |             v
                   \           /
                    < spawned <
                      process

*/



#ifndef WEXITSTATUS
#define WEXITSTATUS(stat) (((*((int *) &(stat))) >> 8) & 0xff)
#endif

#include <setjmp.h>

#ifdef HAVE_SIGLONGJMP
static sigjmp_buf env;                /* for interruptable read() */
#else
static jmp_buf env;		/* for interruptable read() */
#endif  /* HAVE_SIGLONGJMP */

static int reading;		/* while we are reading */
				/* really, while "env" is valid */
static int deferred_interrupt = FALSE;	/* if signal is received, but not */
				/* in expIRead record this here, so it will */
				/* be handled next time through expIRead */

static void
sigchld_handler()
{
  if (reading) {
#ifdef HAVE_SIGLONGJMP
     siglongjmp(env,1);
#else
    longjmp(env,1);
#endif  /* HAVE_SIGLONGJMP */
  }
  deferred_interrupt = TRUE;
}

#define EXP_CHILD_EOF -100

/*
 * Name: expIRead, do an interruptable read
 *
 * intIRead() reads from chars from the user.
 *
 * It returns early if it detects the death of a proc (either the spawned
 * process or the child (surrogate).
 */
static int
intIRead(channel,obj,size,flags);
Tcl_Channel channel;
Tcl_Obj *obj;
int size;
int flags;
{
    int cc = EXP_CHILD_EOF;

    if (deferred_interrupt) return(cc);

#ifdef HAVE_SIGLONGJMP
    if (0 == sigsetjmp(env,1)) {
#else
    if (0 == setjmp(env)) {
#endif  /* HAVE_SIGLONGJMP */
	reading = TRUE;
	cc = Tcl_ReadChars(channel,obj,size,flags);
    }
    reading = FALSE;
    return(cc);
}

/* exit status for the child process created by cmdInteract */
#define CHILD_DIED		-2
#define SPAWNED_PROCESS_DIED	-3

static void
clean_up_after_child(interp,esPtr)
Tcl_Interp *interp;
ExpState *esPtr;
{
    expWaitOnOne(); /* wait for slave */
    expWaitOnOne(); /* wait for child */

    deferred_interrupt = FALSE;
    exp_close(interp,esPtr);
}
#endif /*SIMPLE_EVENT*/

static int
update_interact_fds(interp,esPtrCount,esPtrToInput,esPtrs,input_base,
			do_indirect,config_count,real_tty_caller)
Tcl_Interp *interp;
int *esPtrCount;
Tcl_HashTable **esPtrToInput;	/* map from ExpStates to "struct inputs" */
ExpState ***esPtrs;
struct input *input_base;
int do_indirect;		/* if true do indirects */
int *config_count;
int *real_tty_caller;
{
	struct input *inp;
	struct output *outp;
	struct exp_state_list *fdp;
	int count;

	int real_tty = FALSE;

	*config_count = exp_configure_count;

	count = 0;
	for (inp = input_base;inp;inp=inp->next) {

		if (do_indirect) {
			/* do not update "direct" entries (again) */
			/* they were updated upon creation */
			if (inp->i_list->direct == EXP_INDIRECT) {
				exp_i_update(interp,inp->i_list);
			}
			for (outp = inp->output;outp;outp=outp->next) {
				if (outp->i_list->direct == EXP_INDIRECT) {
					exp_i_update(interp,outp->i_list);
				}
			}
		}

		/* revalidate all input descriptors */
		for (fdp = inp->i_list->state_list;fdp;fdp=fdp->next) {
		    count++;
		    /* have to "adjust" just in case spawn id hasn't had */
		    /* a buffer sized yet */
		    if (!expStateCheck(interp,fdp->esPtr,1,1,"interact")) {
			return(TCL_ERROR);
		    }
		}

		/* revalidate all output descriptors */
		for (outp = inp->output;outp;outp=outp->next) {
			for (fdp = outp->i_list->state_list;fdp;fdp=fdp->next) {
				/* make user_spawn_id point to stdout */
			    if (!expStdinoutIs(fdp->esPtr)) {
				if (!expStateCheck(interp,fdp->esPtr,1,0,"interact"))
				    return(TCL_ERROR);
			    }
			}
		}
	}
	if (!do_indirect) return TCL_OK;

	if (*esPtrToInput == 0) {
	    *esPtrToInput = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
	    *esPtrs = (ExpState **)ckalloc(count * sizeof(ExpState *));
	} else {
	    /* if hash table already exists, delete it and start over */
	    Tcl_DeleteHashTable(*esPtrToInput);
	    *esPtrs = (ExpState **)ckrealloc((char *)*esPtrs,count * sizeof(ExpState *));
	}
	Tcl_InitHashTable(*esPtrToInput,TCL_ONE_WORD_KEYS);

	count = 0;
	for (inp = input_base;inp;inp=inp->next) {
	    for (fdp = inp->i_list->state_list;fdp;fdp=fdp->next) {
		/* build map to translate from spawn_id to struct input */
		expCreateStateToInput(*esPtrToInput,fdp->esPtr,inp);

		/* build input to ready() */
		(*esPtrs)[count] = fdp->esPtr;

		if (real_tty_input(fdp->esPtr)) real_tty = TRUE;

		count++;
	    }
	}
	*esPtrCount = count;

	*real_tty_caller = real_tty; /* tell caller if we have found that */
					/* we are using real tty */

	return TCL_OK;
}

/*ARGSUSED*/
static char *
inter_updateproc(clientData, interp, name1, name2, flags)
ClientData clientData;
Tcl_Interp *interp;	/* Interpreter containing variable. */
char *name1;		/* Name of variable. */
char *name2;		/* Second part of variable name. */
int flags;		/* Information about what happened. */
{
	exp_configure_count++;
	return 0;
}
			
#define finish(x)	{ status = x; goto done; }

static char return_cmd[] = "return";
static char interpreter_cmd[] = "interpreter";

/*ARGSUSED*/
int
Exp_InteractObjCmd(clientData, interp, objc, objv)
ClientData clientData;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];		/* Argument objects. */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    Tcl_Obj *CONST *objv_copy;	/* original, for error messages */
    char *string;
#ifdef SIMPLE_EVENT
    int pid;
#endif /*SIMPLE_EVENT*/

    /*declarations*/
    int input_count;	/* count of struct input descriptors */

    Tcl_HashTable *esPtrToInput = 0;	/* map from ExpState to "struct inputs" */
    ExpState **esPtrs;
    struct keymap *km;	/* ptr for above while parsing */
    Tcl_RegExpInfo reInfo;
    ExpState *u = 0;
    ExpState *esPtr = 0;
    Tcl_Obj *chanName = 0;
    int need_to_close_master = FALSE;	/* if an eof is received */
				/* we use this to defer close until later */

    int next_tty_reset = FALSE;	/* if we've seen a single -reset */
    int next_iread = FALSE;/* if we've seen a single -iread */
    int next_iwrite = FALSE;/* if we've seen a single -iread */
    int next_re = FALSE;	/* if we've seen a single -re */
    int next_null = FALSE;	/* if we've seen the null keyword */
    int next_writethru = FALSE;/*if macros should also go to proc output */
    int next_indices = FALSE;/* if we should write indices */
    int next_echo = FALSE;	/* if macros should be echoed */
    int status = TCL_OK;	/* final return value */
    int i;			/* misc temp */
    int size;			/* size temp */

    int timeout_simple = TRUE;	/* if no or global timeout */

    int real_tty;		/* TRUE if we are interacting with real tty */
    int tty_changed = FALSE;/* true if we had to change tty modes for */
				/* interact to work (i.e., to raw, noecho) */
    int was_raw;
    int was_echo;
    exp_tty tty_old;

    Tcl_Obj *replace_user_by_process = 0; /* for -u flag */

    struct input *input_base;
#define input_user input_base
    struct input *input_default;
    struct input *inp;	/* overused ptr to struct input */
    struct output *outp;	/* overused ptr to struct output */

    int dash_input_count = 0; /* # of "-input"s seen */
    int arbitrary_timeout;
    int default_timeout;
    struct action action_timeout;	/* common to all */
    struct action action_eof;	/* common to all */
    struct action **action_eof_ptr;	/* allow -input/ouput to */
		/* leave their eof-action assignable by a later */
		/* -eof */
    struct action *action_base = 0;
    struct keymap **end_km;

    int key;
    int configure_count;	/* monitor reconfigure events */

    if ((objc == 2) && exp_one_arg_braced(objv[1])) {
	return(exp_eval_with_one_arg(clientData,interp,objv));
    } else if ((objc == 3) && streq(Tcl_GetString(objv[1]),"-brace")) {
	Tcl_Obj *new_objv[2];
	new_objv[0] = objv[0];
	new_objv[1] = objv[2];
	return(exp_eval_with_one_arg(clientData,interp,new_objv));
    }

    objv_copy = objv;

    objv++;
    objc--;

    default_timeout = EXP_TIME_INFINITY;
    arbitrary_timeout = EXP_TIME_INFINITY;	/* if user specifies */
		/* a bunch of timeouts with EXP_TIME_INFINITY, this will be */
		/* left around for us to find. */

    input_user = new(struct input);
    input_user->i_list = exp_new_i_simple(expStdinoutGet(),EXP_TEMPORARY); /* stdin by default */
    input_user->output = 0;
    input_user->action_eof = &action_eof;
    input_user->timeout_nominal = EXP_TIME_INFINITY;
    input_user->action_timeout = 0;
    input_user->keymap = 0;

    end_km = &input_user->keymap;
    inp = input_user;
    action_eof_ptr = &input_user->action_eof;

    input_default = new(struct input);
    input_default->i_list = exp_new_i_simple((ExpState *)0,EXP_TEMPORARY); /* fix up later */
    input_default->output = 0;
    input_default->action_eof = &action_eof;
    input_default->timeout_nominal = EXP_TIME_INFINITY;
    input_default->action_timeout = 0;
    input_default->keymap = 0;
    input_default->next = 0;		/* no one else */
    input_user->next = input_default;

    /* default and common -eof action */
    action_eof.statement = tsdPtr->cmdObjReturn;
    action_eof.tty_reset = FALSE;
    action_eof.iread = FALSE;
    action_eof.iwrite = FALSE;

    /*
     * Parse the command arguments.
     */
    for (;objc>0;objc--,objv++) {
	string = Tcl_GetString(*objv);
	if (string[0] == '-') {
	    static char *switches[] = {
		"--",		"-exact",	"-re",		"-input",
		"-output",	"-u",		"-o",		"-i",
		"-echo",	"-nobuffer",	"-indices",	"-f",
		"-reset",	"-F",		"-iread",	"-iwrite",
		"-eof",		"-timeout",	"-nobrace",	(char *)0
	    };
	    enum switches {
		EXP_SWITCH_DASH,	EXP_SWITCH_EXACT,
		EXP_SWITCH_REGEXP,	EXP_SWITCH_INPUT,
		EXP_SWITCH_OUTPUT,	EXP_SWITCH_USER,
		EXP_SWITCH_OPPOSITE,	EXP_SWITCH_SPAWN_ID,
		EXP_SWITCH_ECHO,	EXP_SWITCH_NOBUFFER,
		EXP_SWITCH_INDICES,	EXP_SWITCH_FAST,
		EXP_SWITCH_RESET,	EXP_SWITCH_CAPFAST,
		EXP_SWITCH_IREAD,	EXP_SWITCH_IWRITE,
		EXP_SWITCH_EOF,		EXP_SWITCH_TIMEOUT,
		EXP_SWITCH_NOBRACE
	    };
	    int index;

	    /*
	     * Allow abbreviations of switches and report an error if we
	     * get an invalid switch.
	     */

	    if (Tcl_GetIndexFromObj(interp, *objv, switches, "switch", 0,
		    &index) != TCL_OK) {
		return TCL_ERROR;
	    }
	    switch ((enum switches) index) {
		case EXP_SWITCH_DASH:
		case EXP_SWITCH_EXACT:
		    objc--;
		    objv++;
		    goto pattern;
		case EXP_SWITCH_REGEXP:
		    if (objc < 1) {
			Tcl_WrongNumArgs(interp,1,objv_copy,"-re pattern");
			return(TCL_ERROR);
		    }
		    next_re = TRUE;
		    objc--;
		    objv++;

		    /*
		     * Try compiling the expression so we can report
		     * any errors now rather then when we first try to
		     * use it.
		     */

		    if (!(Tcl_GetRegExpFromObj(interp, *objv,
			    TCL_REG_ADVANCED|TCL_REG_BOSONLY))) {
			return TCL_ERROR;
		    }
		    goto pattern;
		case EXP_SWITCH_INPUT:
		    dash_input_count++;
		    if (dash_input_count == 2) {
			inp = input_default;
			input_user->next = input_default;
		    } else if (dash_input_count > 2) {
			struct input *previous_input = inp;
			inp = new(struct input);
			previous_input->next = inp;
		    }
		    inp->output = 0;
		    inp->action_eof = &action_eof;
		    action_eof_ptr = &inp->action_eof;
		    inp->timeout_nominal = default_timeout;
		    inp->action_timeout = &action_timeout;
		    inp->keymap = 0;
		    end_km = &inp->keymap;
		    inp->next = 0;
		    objc--;objv++;
		    if (objc < 1) {
			Tcl_WrongNumArgs(interp,1,objv_copy,"-input spawn_id");
			return(TCL_ERROR);
		    }
		    inp->i_list = exp_new_i_complex(interp,Tcl_GetString(*objv),
			    EXP_TEMPORARY,inter_updateproc);
		    break;
		case EXP_SWITCH_OUTPUT: {
		    struct output *tmp;

		    /* imply a "-input" */
		    if (dash_input_count == 0) dash_input_count = 1;

		    outp = new(struct output);

				/* link new output in front of others */
		    tmp = inp->output;
		    inp->output = outp;
		    outp->next = tmp;

		    objc--;objv++;
		    if (objc < 1) {
			Tcl_WrongNumArgs(interp,1,objv_copy,"-output spawn_id");
			return(TCL_ERROR);
		    }
		    outp->i_list = exp_new_i_complex(interp,Tcl_GetString(*objv),
			    EXP_TEMPORARY,inter_updateproc);

		    outp->action_eof = &action_eof;
		    action_eof_ptr = &outp->action_eof;
		    break;
		}
		case EXP_SWITCH_USER:
		    objc--;objv++;
		    if (objc < 1) {
			Tcl_WrongNumArgs(interp,1,objv_copy,"-u spawn_id");
			return(TCL_ERROR);
		    }
		    replace_user_by_process = *objv;

		    /* imply a "-input" */
		    if (dash_input_count == 0) dash_input_count = 1;
		    break;
		case EXP_SWITCH_OPPOSITE:
		    /* apply following patterns to opposite side */
		    /* of interaction */

		    end_km = &input_default->keymap;

		    /* imply two "-input" */
		    if (dash_input_count < 2) {
			dash_input_count = 2;
			inp = input_default;
			action_eof_ptr = &inp->action_eof;
		    }
		    break;
		case EXP_SWITCH_SPAWN_ID:
		    /* substitute master */

		    objc--;objv++;
		    chanName = *objv;
		    /* will be used later on */

		    end_km = &input_default->keymap;

		    /* imply two "-input" */
		    if (dash_input_count < 2) {
			dash_input_count = 2;
			inp = input_default;
			action_eof_ptr = &inp->action_eof;
		    }
		    break;
		case EXP_SWITCH_ECHO:
		    next_echo = TRUE;
		    break;
		case EXP_SWITCH_NOBUFFER:
		    next_writethru = TRUE;
		    break;
		case EXP_SWITCH_INDICES:
		    next_indices = TRUE;
		    break;
		case EXP_SWITCH_RESET:
		    next_tty_reset = TRUE;
		    break;
		case EXP_SWITCH_IREAD:
		    next_iread = TRUE;
		    break;
		case EXP_SWITCH_IWRITE:
			next_iwrite= TRUE;
		    break;
		case EXP_SWITCH_EOF: {
		    struct action *action;

		    objc--;objv++;
		    expDiagLogU("-eof is deprecated, use eof\r\n");
		    *action_eof_ptr = action = new_action(&action_base);
		    action->statement = *objv;
		    action->tty_reset = next_tty_reset;
		    next_tty_reset = FALSE;
		    action->iwrite = next_iwrite;
		    next_iwrite = FALSE;
		    action->iread = next_iread;
		    next_iread = FALSE;
		    break;
		}
		case EXP_SWITCH_TIMEOUT: {
		    int t;
		    struct action *action;
		    expDiagLogU("-timeout is deprecated, use timeout\r\n");

		    objc--;objv++;
		    if (objc < 1) {
			Tcl_WrongNumArgs(interp,1,objv_copy,"-timeout time");
			return(TCL_ERROR);
		    }

		    if (Tcl_GetIntFromObj(interp, *objv, &t) != TCL_OK) {
			return TCL_ERROR;
		    }
		    objc--;objv++;
		    if (t != -1)
			arbitrary_timeout = t;
		    /* we need an arbitrary timeout to start */
		    /* search for lowest one later */

		    timeout_simple = FALSE;
		    action = inp->action_timeout = new_action(&action_base);
		    inp->timeout_nominal = t;

		    action->statement = *objv;
		    action->tty_reset = next_tty_reset;
		    next_tty_reset = FALSE;
		    action->iwrite = next_iwrite;
		    next_iwrite = FALSE;
		    action->iread = next_iread;
		    next_iread = FALSE;
		    break;
		}
		case EXP_SWITCH_FAST:
		case EXP_SWITCH_CAPFAST:
		    /* noop compatibility switches for fast mode */
		    break;
		case EXP_SWITCH_NOBRACE:
		    /* nobrace does nothing but take up space */
		    /* on the command line which prevents */
		    /* us from re-expanding any command lines */
		    /* of one argument that looks like it should */
		    /* be expanded to multiple arguments. */
		    break;
	    }
	    continue;
    	} else {
	    static char *options[] = {
		"eof", "timeout", "null", (char *)0
	    };
	    enum options {
		EXP_OPTION_EOF, EXP_OPTION_TIMEOUT, EXP_OPTION_NULL
	    };
	    int index;

	    /*
	     * Match keywords exactly, otherwise they are patterns.
	     */

	    if (Tcl_GetIndexFromObj(interp, *objv, options, "option",
		    1 /* exact */, &index) != TCL_OK) {
		Tcl_ResetResult(interp);
		goto pattern;
	    }
	    switch ((enum options) index) {
		case EXP_OPTION_EOF: {
		    struct action *action;

		    objc--;objv++;
		    *action_eof_ptr = action = new_action(&action_base);

		    action->statement = *objv;

		    action->tty_reset = next_tty_reset;
		    next_tty_reset = FALSE;
		    action->iwrite = next_iwrite;
		    next_iwrite = FALSE;
		    action->iread = next_iread;
		    next_iread = FALSE;
		    break;
		}
		case EXP_OPTION_TIMEOUT: {
		    int t;
		    struct action *action;

		    objc--;objv++;
		    if (objc < 1) {
			Tcl_WrongNumArgs(interp,1,objv_copy,"timeout time");
			return(TCL_ERROR);
		    }
		    if (Tcl_GetIntFromObj(interp, *objv, &t) != TCL_OK) {
			return TCL_ERROR;
		    }
		    objc--;objv++;

		    /* we need an arbitrary timeout to start */
		    /* search for lowest one later */
		    if (t != -1) arbitrary_timeout = t;

		    timeout_simple = FALSE;
		    action = inp->action_timeout = new_action(&action_base);
		    inp->timeout_nominal = t;

		    action->statement = *objv;

		    action->tty_reset = next_tty_reset;
		    next_tty_reset = FALSE;
		    action->iwrite = next_iwrite;
		    next_iwrite = FALSE;
		    action->iread = next_iread;
		    next_iread = FALSE;
		    break;
		}
		case EXP_OPTION_NULL:
		    next_null = TRUE;
		    goto pattern;
	    }
	    continue;
	}
    
	/*
	 * pick up the pattern
	 */

	pattern:
	km = new(struct keymap);

	/* so that we can match in order user specified */
	/* link to end of keymap list */
	*end_km = km;
	km->next = 0;
	end_km = &km->next;

	km->echo = next_echo;
	km->writethru = next_writethru;
	km->indices = next_indices;
	km->action.tty_reset = next_tty_reset;
	km->action.iwrite = next_iwrite;
	km->action.iread = next_iread;

	next_indices = next_echo = next_writethru = FALSE;
	next_tty_reset = FALSE;
	next_iwrite = next_iread = FALSE;

	km->keys = *objv;

	km->null = FALSE;
	km->re = 0;
	if (next_re) {
	    km->re = TRUE;
	    next_re = FALSE;
	}
	if (next_null) {
	    km->null = TRUE;
	    next_null = FALSE;
	}

	objc--;objv++;
	if (objc >= 1) {
	    km->action.statement = *objv;
	} else {
	    km->action.statement = 0;
	}

	expDiagLogU("defining key ");
	expDiagLogU(Tcl_GetString(km->keys));
	expDiagLogU(", action ");
	expDiagLogU(km->action.statement?expPrintify(Tcl_GetString(km->action.statement)):"interpreter");
	expDiagLogU("\r\n");

	/* imply a "-input" */
	if (dash_input_count == 0) dash_input_count = 1;
    }

    /* if the user has not supplied either "-output" for the */
    /* default two "-input"s, fix them up here */

    if (!input_user->output) {
	struct output *o = new(struct output);
	if (!chanName) {
	    if (!(esPtr = expStateCurrent(interp,1,1,0))) {
		return(TCL_ERROR);
	    }
	    o->i_list = exp_new_i_simple(esPtr,EXP_TEMPORARY);
	} else {
	    o->i_list = exp_new_i_complex(interp,Tcl_GetString(chanName),
		    EXP_TEMPORARY,inter_updateproc);
	}
	o->next = 0;	/* no one else */
	o->action_eof = &action_eof;
	input_user->output = o;
    }

    if (!input_default->output) {
	struct output *o = new(struct output);
	o->i_list = exp_new_i_simple(expStdinoutGet(),EXP_TEMPORARY);/* stdout by default */
	o->next = 0;	/* no one else */
	o->action_eof = &action_eof;
	input_default->output = o;
    }

    /* if user has given "-u" flag, substitute process for user */
    /* in first two -inputs */
    if (replace_user_by_process) {
	/* through away old ones */
	exp_free_i(interp,input_user->i_list,   inter_updateproc);
	exp_free_i(interp,input_default->output->i_list,inter_updateproc);

	/* replace with arg to -u */
	input_user->i_list = exp_new_i_complex(interp,
		Tcl_GetString(replace_user_by_process),
		EXP_TEMPORARY,inter_updateproc);
	input_default->output->i_list = exp_new_i_complex(interp,
		Tcl_GetString(replace_user_by_process),
		EXP_TEMPORARY,inter_updateproc);
    }

    /*
     * now fix up for default spawn id
     */

    /* user could have replaced it with an indirect, so force update */
    if (input_default->i_list->direct == EXP_INDIRECT) {
	exp_i_update(interp,input_default->i_list);
    }

    if (input_default->i_list->state_list
	    && (input_default->i_list->state_list->esPtr == EXP_SPAWN_ID_BAD)) {
	if (!chanName) {
	    if (!(esPtr = expStateCurrent(interp,1,1,0))) {
		return(TCL_ERROR);
	    }
	    input_default->i_list->state_list->esPtr = esPtr;
	} else {
	    /* discard old one and install new one */
	    exp_free_i(interp,input_default->i_list,inter_updateproc);
	    input_default->i_list = exp_new_i_complex(interp,Tcl_GetString(chanName),
		    EXP_TEMPORARY,inter_updateproc);
	}
    }

    /*
     * check for user attempting to interact with self
     * they're almost certainly just fooling around
     */

    /* user could have replaced it with an indirect, so force update */
    if (input_user->i_list->direct == EXP_INDIRECT) {
	exp_i_update(interp,input_user->i_list);
    }

    if (input_user->i_list->state_list && input_default->i_list->state_list
	    && (input_user->i_list->state_list->esPtr == input_default->i_list->state_list->esPtr)) {
	exp_error(interp,"cannot interact with self - set spawn_id to a spawned process");
	return(TCL_ERROR);
    }

    esPtrs = 0;

    /*
     * all data structures are sufficiently set up that we can now
     * "finish()" to terminate this procedure
     */

    status = update_interact_fds(interp,&input_count,&esPtrToInput,&esPtrs,input_base,1,&configure_count,&real_tty);
    if (status == TCL_ERROR) finish(TCL_ERROR);

    if (real_tty) {
	tty_changed = exp_tty_raw_noecho(interp,&tty_old,&was_raw,&was_echo);
    }

    for (inp = input_base,i=0;inp;inp=inp->next,i++) {
	/* start timers */
	inp->timeout_remaining = inp->timeout_nominal;
    }

    key = expect_key++;

    /* declare ourselves "in sync" with external view of close/indirect */
    configure_count = exp_configure_count;
    
#ifndef SIMPLE_EVENT
    /* loop waiting (in event handler) for input */
    for (;;) {
	int te;	/* result of Tcl_Eval */
	int rc;	/* return code from ready.  This is further refined by matcher. */
	int cc;			/* # of chars from read() */
	struct action *action = 0;
	time_t previous_time;
	time_t current_time;
	int matchLen;	/* # of chars matched */
	int skip;		/* # of chars not involved in match */
	int print;		/* # of chars to print */
	int oldprinted;		/* old version of u->printed */
	int change;		/* if action requires cooked mode */
	int attempt_match = TRUE;
	struct input *soonest_input;
	int timeout;	/* current as opposed to default_timeout */

	/* calculate how long to wait */
	/* by finding shortest remaining timeout */
	if (timeout_simple) {
	    timeout = default_timeout;
	} else {
	    timeout = arbitrary_timeout;

	    for (inp=input_base;inp;inp=inp->next) {
		if ((inp->timeout_remaining != EXP_TIME_INFINITY) &&
			(inp->timeout_remaining <= timeout)) {
		    soonest_input = inp;
		    timeout = inp->timeout_remaining;
		}
	    }

	    time(&previous_time);
	    /* timestamp here rather than simply saving old */
	    /* current time (after ready()) to account for */
	    /* possibility of slow actions */
	    
	    /* timeout can actually be EXP_TIME_INFINITY here if user */
	    /* explicitly supplied it in a few cases (or */
	    /* the count-down code is broken) */
	}

	/* update the world, if necessary */
	if (configure_count != exp_configure_count) {
	    status = update_interact_fds(interp,&input_count,
		    &esPtrToInput,&esPtrs,input_base,1,
		    &configure_count,&real_tty);
	    if (status) finish(status);
	}

	rc = exp_get_next_event(interp,esPtrs,input_count,&u,timeout,key);
	if (rc == EXP_TCLERROR) return(TCL_ERROR);
	if (rc == EXP_RECONFIGURE) continue;
	if (rc == EXP_TIMEOUT) {
	    if (timeout_simple) {
		action = &action_timeout;
		goto got_action;
	    } else {
		action = soonest_input->action_timeout;
		/* arbitrarily pick first fd out of list */
		u = soonest_input->i_list->state_list->esPtr;
	    }
	}
	if (!timeout_simple) {
	    int time_diff;

	    time(&current_time);
	    time_diff = current_time - previous_time;

	    /* update all timers */
	    for (inp=input_base;inp;inp=inp->next) {
		if (inp->timeout_remaining != EXP_TIME_INFINITY) {
		    inp->timeout_remaining -= time_diff;
		    if (inp->timeout_remaining < 0)
			inp->timeout_remaining = 0;
		}
	    }
	}

	/* at this point, we have some kind of event which can be */
	/* immediately processed - i.e. something that doesn't block */

	/* figure out who we are */
	inp = expStateToInput(esPtrToInput,u);

	/* reset timer */
	inp->timeout_remaining = inp->timeout_nominal;

	switch (rc) {
	    case EXP_DATA_NEW:
		cc = intRead(interp,u,1,0,key);
		if (cc > 0) break;

		rc = EXP_EOF;
		/*
		 * FALLTHRU
		 *
		 * Most systems have read() return 0, allowing
		 * control to fall thru and into this code.  On some
		 * systems (currently HP and new SGI), read() does
		 * see eof, and it must be detected earlier.  Then
		 * control jumps directly to this EXP_EOF label.
		 */
	    case EXP_EOF:
		action = inp->action_eof;
		attempt_match = FALSE;
		skip = expSizeGet(u);
		expDiagLog("interact: received eof from spawn_id %s\r\n",u->name);
		/* actual close is done later so that we have a */
		/* chance to flush out any remaining characters */
		need_to_close_master = TRUE;
		break;
	    case EXP_DATA_OLD:
		cc = 0;
		break;
	    case EXP_TIMEOUT:
		action = inp->action_timeout;
		attempt_match = FALSE;
		skip = expSizeGet(u);
		break;
	}

	km = 0;

	if (attempt_match) {
	    rc = intMatch(u,inp->keymap,&km,&matchLen,&skip,&reInfo);
	    if ((rc == EXP_MATCH) && km && km->re) {
		intRegExpMatchProcess(interp,u,km,&reInfo);
	    }
	} else {
	    attempt_match = TRUE;
	}

	/*
	 * dispose of chars that should be skipped
	 * i.e., chars that cannot possibly be part of a match.
	 */
	if (km && km->writethru) {
	    print = skip + matchLen;
	} else print = skip;

	if (km && km->echo) {
	    intEcho(u,skip,matchLen);
	}
	oldprinted = u->printed;

	/*
	 * If expect has left characters in buffer, it has
	 * already echoed them to the screen, thus we must
	 * prevent them being rewritten.  Unfortunately this
	 * gives the possibility of matching chars that have
	 * already been output, but we do so since the user
	 * could have avoided it by flushing the output
	 * buffers directly.
	 */
	if (print > u->printed) {	/* usual case */
	    for (outp = inp->output;outp;outp=outp->next) {
		struct exp_state_list *fdp;
		for (fdp = outp->i_list->state_list;fdp;fdp=fdp->next) {
		    /* send to channel (and log if chan is stdout or devtty) */
		    /*
		     * Following should eventually be rewritten to ...WriteCharsAnd...
		     */
		    int wc = expWriteBytesAndLogIfTtyU(fdp->esPtr,
			    Tcl_GetString(u->buffer) + u->printed,
			    print - u->printed);
		    if (wc <= 0) {
			expDiagLog("interact: write on spawn id %s failed (%s)\r\n",fdp->esPtr->name,Tcl_PosixError(interp));
			action = outp->action_eof;
			change = (action && action->tty_reset);
			
			if (change && tty_changed)
			    exp_tty_set(interp,&tty_old,was_raw,was_echo);
			te = inter_eval(interp,action,u);

			if (change && real_tty) tty_changed =
						    exp_tty_raw_noecho(interp,&tty_old,&was_raw,&was_echo);
			switch (te) {
			    case TCL_BREAK:
			    case TCL_CONTINUE:
				finish(te);
			    case EXP_TCL_RETURN:
				finish(TCL_RETURN);
			    case TCL_RETURN:
				finish(TCL_OK);
			    case TCL_OK:
				/* god knows what the user might */
				/* have done to us in the way of */
				/* closed fds, so .... */
				action = 0;	/* reset action */
				continue;
			    default:
				finish(te);
			}
		    }
		}
	    }
	    u->printed = print;
	}
	
	/* u->printed is now accurate with respect to the buffer */
	/* However, we're about to shift the old data out of the */
	/* buffer.  Thus size, printed, and echoed must be */
	/* updated */
	
	/* first update size based on skip information */
	/* then set skip to the total amount skipped */

	size = expSizeGet(u);
	if (rc == EXP_MATCH) {
	    action = &km->action;

	    skip += matchLen;
	    size -= skip;
	    if (size) {
		string = Tcl_GetString(u->buffer);
		memmove(string, string + skip, size);
	    }
	} else {
	    string = Tcl_GetString(u->buffer);
	    if (skip) {
		size -= skip;
		memcpy(string, string + skip, size);
	    }
	}
	Tcl_SetObjLength(u->buffer,size);

	/* now update printed based on total amount skipped */

	u->printed -= skip;
	/* if more skipped than printed (i.e., keymap encountered) */
	/* for printed positive */
	if (u->printed < 0) u->printed = 0;

	/* if we are in the middle of a match, force the next event */
	/* to wait for more data to arrive */
	u->force_read = (rc == EXP_CANMATCH);

	/* finally reset echoed if necessary */
	if (rc != EXP_CANMATCH) {
	    if (skip >= oldprinted + u->echoed) u->echoed = 0;
	}

	if (rc == EXP_EOF) {
	    exp_close(interp,u);
	    need_to_close_master = FALSE;
	}

	if (action) {
got_action:
	    change = (action && action->tty_reset);
	    if (change && tty_changed)
		exp_tty_set(interp,&tty_old,was_raw,was_echo);

	    te = inter_eval(interp,action,u);

	    if (change && real_tty) tty_changed =
					exp_tty_raw_noecho(interp,&tty_old,&was_raw,&was_echo);
	    switch (te) {
		case TCL_BREAK:
		case TCL_CONTINUE:
		    finish(te);
		case EXP_TCL_RETURN:
		    finish(TCL_RETURN);
		case TCL_RETURN:
		    finish(TCL_OK);
		case TCL_OK:
		    /* god knows what the user might */
		    /* have done to us in the way of */
		    /* closed fds, so .... */
		    action = 0;	/* reset action */
		    continue;
		default:
		    finish(te);
	    }
	}
    }

#else /* SIMPLE_EVENT */
/*	deferred_interrupt = FALSE;*/
{
		int te;	/* result of Tcl_Eval */
		ExpState *u;    /*master*/
		int rc;	/* return code from ready.  This is further */
			/* refined by matcher. */
		int cc;	/* chars count from read() */
		struct action *action = 0;
		time_t previous_time;
		time_t current_time;
		int matchLen, skip;
		int change;	/* if action requires cooked mode */
		int attempt_match = TRUE;
		struct input *soonest_input;
		int print;		/* # of chars to print */
		int oldprinted;		/* old version of u->printed */

		int timeout;	/* current as opposed to default_timeout */

	if (-1 == (pid = fork())) {
		exp_error(interp,"fork: %s",Tcl_PosixError(interp));
		finish(TCL_ERROR);
	}
	if (pid == 0) {
	    /*
	     * This is a new child process.
	     * It exists only for this interact command and will go away when
	     * the interact returns.
	     *
	     * The purpose of this child process is to read output from the
	     * spawned process and send it to the user tty.
	     * (See diagram above.)
	     */

	    exp_close(interp,expStdinoutGet());

	    u = esPtrs[1];  /* get 2nd ExpState */
	    input_count = 1;

	    while (1) {

		/* calculate how long to wait */
		/* by finding shortest remaining timeout */
		if (timeout_simple) {
			timeout = default_timeout;
		} else {
			timeout = arbitrary_timeout;

			for (inp=input_base;inp;inp=inp->next) {
				if ((inp->timeout_remaining != EXP_TIME_INFINITY) &&
				    (inp->timeout_remaining < timeout))
					soonest_input = inp;
					timeout = inp->timeout_remaining;
			}

			time(&previous_time);
			/* timestamp here rather than simply saving old */
			/* current time (after ready()) to account for */
			/* possibility of slow actions */

			/* timeout can actually be EXP_TIME_INFINITY here if user */
			/* explicitly supplied it in a few cases (or */
			/* the count-down code is broken) */
		}

		/* +1 so we can look at the "other" file descriptor */
		rc = exp_get_next_event(interp,esPtrs+1,input_count,&u,timeout,key);
		if (!timeout_simple) {
			int time_diff;

			time(&current_time);
			time_diff = current_time - previous_time;

			/* update all timers */
			for (inp=input_base;inp;inp=inp->next) {
				if (inp->timeout_remaining != EXP_TIME_INFINITY) {
					inp->timeout_remaining -= time_diff;
					if (inp->timeout_remaining < 0)
						inp->timeout_remaining = 0;
				}
			}
		}

		/* at this point, we have some kind of event which can be */
		/* immediately processed - i.e. something that doesn't block */

		/* figure out who we are */
		inp = expStateToInput(esPtrToInput,u);

		switch (rc) {
		case EXP_DATA_NEW:
		    cc = intRead(interp,u,0,0,key);
		    if (cc > 0) break;
		    /*
		     * FALLTHRU
		     *
		     * Most systems have read() return 0, allowing
		     * control to fall thru and into this code.  On some
		     * systems (currently HP and new SGI), read() does
		     * see eof, and it must be detected earlier.  Then
		     * control jumps directly to this EXP_EOF label.
		     */
		case EXP_EOF:
			action = inp->action_eof;
			attempt_match = FALSE;
			skip = expSizeGet(u);
			rc = EXP_EOF;
			expDiagLog("interact: child received eof from spawn_id %s\r\n",u->name);
			exp_close(interp,u);
			break;
		case EXP_DATA_OLD:
			cc = 0;
			break;
		}

		km = 0;

		if (attempt_match) {
		    rc = intMatch(u,inp->keymap,&km,&matchLen,&skip,&reInfo);
		    if ((rc == EXP_MATCH) && km && km->re) {
			intRegExpMatchProcess(interp,u,km,&reInfo);
		    }
		} else {
		    attempt_match = TRUE;
		}

		/* dispose of chars that should be skipped */
		
		/* skip is chars not involved in match */
		/* print is with chars involved in match */

		if (km && km->writethru) {
			print = skip + matchLen;
		} else print = skip;

		if (km && km->echo) {
		    intEcho(u,skip,matchLen);
		}
		oldprinted = u->printed;

		/* If expect has left characters in buffer, it has */
		/* already echoed them to the screen, thus we must */
		/* prevent them being rewritten.  Unfortunately this */
		/* gives the possibility of matching chars that have */
		/* already been output, but we do so since the user */
		/* could have avoided it by flushing the output */
		/* buffers directly. */
		if (print > u->printed) {	/* usual case */
		    for (outp = inp->output;outp;outp=outp->next) {
			struct exp_state_list *fdp;
			for (fdp = outp->i_list->state_list;fdp;fdp=fdp->next) {
			    /* send to channel (and log if chan is stdout or devtty) */
			    int wc = expWriteBytesAndLogIfTtyU(fdp->esPtr,
				    Tcl_GetString(u->buffer) + u->printed,
				    print - u->printed);
			    if (wc <= 0) {
				expDiagLog("interact: write on spawn id %s failed (%s)\r\n",fdp->esPtr->name,Tcl_PosixError(interp));
				action = outp->action_eof;

				te = inter_eval(interp,action,u);

				switch (te) {
				    case TCL_BREAK:
				    case TCL_CONTINUE:
					finish(te);
				    case EXP_TCL_RETURN:
					finish(TCL_RETURN);
				    case TCL_RETURN:
					finish(TCL_OK);
				    case TCL_OK:
					/* god knows what the user might */
					/* have done to us in the way of */
					/* closed fds, so .... */
					action = 0;	/* reset action */
					continue;
				    default:
					finish(te);
				}
			    }
			}
		    }
		    u->printed = print;
		}

		/* u->printed is now accurate with respect to the buffer */
		/* However, we're about to shift the old data out of the */
		/* buffer.  Thus size, printed, and echoed must be */
		/* updated */

		/* first update size based on skip information */
		/* then set skip to the total amount skipped */

		size = expSizeGet(u);
		if (rc =n= EXP_MATCH) {
		    action = &km->action;

		    skip += matchLen;
		    size -= skip;
		    if (size) {
			memcpy(u->buffer, u->buffer + skip, size);
		    }
		} else {
		    if (skip) {
			size -= skip;
			memcpy(u->buffer, u->buffer + skip, size);
		    }
		}
		Tcl_SetObjLength(size);

		/* now update printed based on total amount skipped */

		u->printed -= skip;
		/* if more skipped than printed (i.e., keymap encountered) */
		/* for printed positive */
		if (u->printed < 0) u->printed = 0;

		/* if we are in the middle of a match, force the next event */
		/* to wait for more data to arrive */
		u->force_read = (rc == EXP_CANMATCH);

		/* finally reset echoed if necessary */
		if (rc != EXP_CANMATCH) {
			if (skip >= oldprinted + u->echoed) u->echoed = 0;
		}

		if (action) {
			te = inter_eval(interp,action,u);
			switch (te) {
			case TCL_BREAK:
			case TCL_CONTINUE:
				finish(te);
			case EXP_TCL_RETURN:
				finish(TCL_RETURN);
			case TCL_RETURN:
				finish(TCL_OK);
			case TCL_OK:
				/* god knows what the user might */
				/* have done to us in the way of */
				/* closed fds, so .... */
				action = 0;	/* reset action */
				continue;
			default:
				finish(te);
			}
		}
	    }
	} else {
	    /*
	     * This is the original Expect process.
	     *
	     * It now loops, reading keystrokes from the user tty
	     * and sending them to the spawned process.
	     * (See diagram above.)
	     */

#include <signal.h>

#if defined(SIGCLD) && !defined(SIGCHLD)
#define SIGCHLD SIGCLD
#endif
		expDiagLog("fork = %d\r\n",pid);
		signal(SIGCHLD,sigchld_handler);
/*	restart:*/
/*		tty_changed = exp_tty_raw_noecho(interp,&tty_old,&was_raw,&was_echo);*/

	    u = esPtrs[0];  /* get 1st ExpState */
	    input_count = 1;

	    while (1) {
		/* calculate how long to wait */
		/* by finding shortest remaining timeout */
		if (timeout_simple) {
			timeout = default_timeout;
		} else {
			timeout = arbitrary_timeout;

			for (inp=input_base;inp;inp=inp->next) {
				if ((inp->timeout_remaining != EXP_TIME_INFINITY) &&
				    (inp->timeout_remaining < timeout))
					soonest_input = inp;
					timeout = inp->timeout_remaining;
			}

			time(&previous_time);
			/* timestamp here rather than simply saving old */
			/* current time (after ready()) to account for */
			/* possibility of slow actions */

			/* timeout can actually be EXP_TIME_INFINITY here if user */
			/* explicitly supplied it in a few cases (or */
			/* the count-down code is broken) */
		}

		rc = exp_get_next_event(interp,esPtrs,input_count,&u,timeout,key);
		if (!timeout_simple) {
			int time_diff;

			time(&current_time);
			time_diff = current_time - previous_time;

			/* update all timers */
			for (inp=input_base;inp;inp=inp->next) {
				if (inp->timeout_remaining != EXP_TIME_INFINITY) {
					inp->timeout_remaining -= time_diff;
					if (inp->timeout_remaining < 0)
						inp->timeout_remaining = 0;
				}
			}
		}

		/* at this point, we have some kind of event which can be */
		/* immediately processed - i.e. something that doesn't block */

		/* figure out who we are */
		inp = expStateToInput(esPtrToInput,u);

		switch (rc) {
		case EXP_DATA_NEW:
		        cc = intRead(interp,u,0,1,key);
		        if (cc > 0) {
				break;
			} else if (cc == EXP_CHILD_EOF) {
				/* user could potentially have two outputs in which */
				/* case we might be looking at the wrong one, but */
				/* the likelihood of this is nil */
				action = inp->output->action_eof;
				attempt_match = FALSE;
				skip = expSizeGet(u);
				rc = EXP_EOF;
				expDiagLogU("interact: process died/eof\r\n");
				clean_up_after_child(interp,esPtrs[1]);
				break;
			}
			/*
			 * FALLTHRU
			 *
			 * Most systems have read() return 0, allowing
			 * control to fall thru and into this code.  On some
			 * systems (currently HP and new SGI), read() does
			 * see eof, and it must be detected earlier.  Then
			 * control jumps directly to this EXP_EOF label.
			 */
		case EXP_EOF:
			action = inp->action_eof;
			attempt_match = FALSE;
			skip = expSizeGet(u);
			rc = EXP_EOF;
			expDiagLogU("user sent EOF or disappeared\n\n");
			break;
		case EXP_DATA_OLD:
			cc = 0;
			break;
		}

		km = 0;

		if (attempt_match) {
		    rc = intMatch(u,inp->keymap,&km,&matchLen,&skip,&reInfo);
		    if ((rc == EXP_MATCH) && km && km->re) {
			intRegExpMatchProcess(interp,u,km,&reInfo);
		    }
		} else {
		    attempt_match = TRUE;
		}

		/* dispose of chars that should be skipped */
		
		/* skip is chars not involved in match */
		/* print is with chars involved in match */

		if (km && km->writethru) {
			print = skip + matchLen;
		} else print = skip;

		if (km && km->echo) {
		    intEcho(u,skip,matchLen);
		}
		oldprinted = u->printed;

		/* If expect has left characters in buffer, it has */
		/* already echoed them to the screen, thus we must */
		/* prevent them being rewritten.  Unfortunately this */
		/* gives the possibility of matching chars that have */
		/* already been output, but we do so since the user */
		/* could have avoided it by flushing the output */
		/* buffers directly. */
		if (print > u->printed) {	/* usual case */
		    for (outp = inp->output;outp;outp=outp->next) {
			struct exp_state_list *fdp;
			for (fdp = outp->i_list->state_list;fdp;fdp=fdp->next) {
			    /* send to channel (and log if chan is stdout or devtty) */
			    int wc = expWriteBytesAndLogIfTtyU(fdp->esPtr,
				    Tcl_GetString(u->buffer) + u->printed,
				    print - u->printed);
			    if (wc <= 0) {
				expDiagLog("interact: write on spawn id %s failed (%s)\r\n",fdp->esPtr->name,Tcl_PosixError(interp));
				clean_up_after_child(interp,fdp->esPtr);
				action = outp->action_eof;
				change = (action && action->tty_reset);
				if (change && tty_changed)
				    exp_tty_set(interp,&tty_old,was_raw,was_echo);
				te = inter_eval(interp,action,u);

				if (change && real_tty) tty_changed =
							    exp_tty_raw_noecho(interp,&tty_old,&was_raw,&was_echo);
				switch (te) {
				    case TCL_BREAK:
				    case TCL_CONTINUE:
					finish(te);
				    case EXP_TCL_RETURN:
					finish(TCL_RETURN);
				    case TCL_RETURN:
					finish(TCL_OK);
				    case TCL_OK:
					/* god knows what the user might */
					/* have done to us in the way of */
					/* closed fds, so .... */
					action = 0;	/* reset action */
					continue;
				    default:
					finish(te);
				}
			    }
			}
		    }
		    u->printed = print;
		}

		/* u->printed is now accurate with respect to the buffer */
		/* However, we're about to shift the old data out of the */
		/* buffer.  Thus size, printed, and echoed must be */
		/* updated */

		/* first update size based on skip information */
		/* then set skip to the total amount skipped */

		size = expSizeGet(u);
		if (rc == EXP_MATCH) {
		    action = &km->action;

		    skip += matchLen;
		    size -= skip;
		    if (size) {
			memcpy(u->buffer, u->buffer + skip, size);
		    }
		} else {
		    if (skip) {
			size -= skip;
			memcpy(u->buffer, u->buffer + skip, size);
		    }
		}
		Tcl_SetObjLength(size);

		/* now update printed based on total amount skipped */

		u->printed -= skip;
		/* if more skipped than printed (i.e., keymap encountered) */
		/* for printed positive */
		if (u->printed < 0) u->printed = 0;

		/* if we are in the middle of a match, force the next event */
		/* to wait for more data to arrive */
		u->force_read = (rc == EXP_CANMATCH);

		/* finally reset echoed if necessary */
		if (rc != EXP_CANMATCH) {
			if (skip >= oldprinted + u->echoed) u->echoed = 0;
		}

		if (action) {
			change = (action && action->tty_reset);
			if (change && tty_changed)
				exp_tty_set(interp,&tty_old,was_raw,was_echo);

			te = inter_eval(interp,action,u);

			if (change && real_tty) tty_changed =
			   exp_tty_raw_noecho(interp,&tty_old,&was_raw,&was_echo);
			switch (te) {
			case TCL_BREAK:
			case TCL_CONTINUE:
				finish(te);
			case EXP_TCL_RETURN:
				finish(TCL_RETURN);
			case TCL_RETURN:
				finish(TCL_OK);
			case TCL_OK:
				/* god knows what the user might */
				/* have done to us in the way of */
				/* closed fds, so .... */
				action = 0;	/* reset action */
				continue;
			default:
				finish(te);
			}
		}
	    }
	}
}
#endif /* SIMPLE_EVENT */

 done:
#ifdef SIMPLE_EVENT
    /* force child to exit upon eof from master */
    if (pid == 0) {
	exit(SPAWNED_PROCESS_DIED);
    }
#endif /* SIMPLE_EVENT */

    if (need_to_close_master) exp_close(interp,u);

    if (tty_changed) exp_tty_set(interp,&tty_old,was_raw,was_echo);
    if (esPtrs) ckfree((char *)esPtrs);
    if (esPtrToInput) Tcl_DeleteHashTable(esPtrToInput);
    free_input(interp,input_base);
    free_action(action_base);

    return(status);
}

/* version of Tcl_Eval for interact */ 
static int
inter_eval(interp,action,esPtr)
Tcl_Interp *interp;
struct action *action;
ExpState *esPtr;
{
    int status;

    if (action->iwrite) {
	out("spawn_id",esPtr->name);
    }

    if (action->statement) {
	status = Tcl_EvalObjEx(interp,action->statement,0);
    } else {
	expStdoutLogU("\r\n",1);
	status = exp_interpreter(interp,(Tcl_Obj *)0);
    }

    return status;
}

static void
free_keymap(km)
struct keymap *km;
{
	if (km == 0) return;
	free_keymap(km->next);

	ckfree((char *)km);
}

static void
free_action(a)
struct action *a;
{
	struct action *next;

	while (a) {
		next = a->next;
		ckfree((char *)a);
		a = next;
	}
}

static void
free_input(interp,i)
Tcl_Interp *interp;
struct input *i;
{
	if (i == 0) return;
	free_input(interp,i->next);

	exp_free_i(interp,i->i_list,inter_updateproc);
	free_output(interp,i->output);
	free_keymap(i->keymap);
	ckfree((char *)i);
}

static struct action *
new_action(base)
struct action **base;
{
	struct action *o = new(struct action);

	/* stick new action into beginning of list of all actions */
	o->next = *base;
	*base = o;

	return o;
}

static void
free_output(interp,o)
Tcl_Interp *interp;
struct output *o;
{
	if (o == 0) return;
	free_output(interp,o->next);
	exp_free_i(interp,o->i_list,inter_updateproc);

	ckfree((char *)o);
}


static struct exp_cmd_data cmd_data[]  = {
{"interact",	Exp_InteractObjCmd,	0,	0,	0},
{0}};

void
exp_init_interact_cmds(interp)
Tcl_Interp *interp;
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    exp_create_commands(interp,cmd_data);

    tsdPtr->cmdObjReturn = Tcl_NewStringObj("return",6);
    Tcl_IncrRefCount(tsdPtr->cmdObjReturn);
#if 0
    tsdPtr->cmdObjInterpreter = Tcl_NewStringObj("interpreter",11);
    Tcl_IncrRefCount(tsdPtr->cmdObjInterpreter);
#endif
}






Deleted exp_log.c.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
















































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

/* exp_log.c - logging routines and other things common to both Expect
   program and library.  Note that this file must NOT have any
   references to Tcl except for including tclInt.h
*/

#include "expect_cf.h"
#include <stdio.h>
/*#include <varargs.h>		tclInt.h drags in varargs.h.  Since Pyramid */
/*				objects to including varargs.h twice, just */
/*				omit this one. */
#include "tclInt.h"
#ifdef NO_STDLIB_H
#include "../compat/stdlib.h"
#else
#include <stdlib.h>		/* for malloc */
#endif
#include <ctype.h>

#include "expect_comm.h"
#include "exp_int.h"
#include "exp_rename.h"
#include "exp_command.h"
#include "exp_log.h"

typedef struct ThreadSpecificData {
    Tcl_Channel diagChannel;
    Tcl_DString diagFilename;
    int diagToStderr;

    Tcl_Channel logChannel;
    Tcl_DString logFilename;	/* if no name, then it came from -open or -leaveopen */
    int logAppend;
    int logLeaveOpen;
    int logAll;			/* if TRUE, write log of all interactions
				 * despite value of logUser - i.e., even if
				 * user is not seeing it (via stdout)
				 */
    int logUser;		/* TRUE if user sees interactions on stdout */
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;

/*
 * create a reasonably large buffer for the bulk of the output routines
 * that are not too large
 */
static char bigbuf[2000];

/*
 * Following this are several functions that log the conversation.  Some
 * general notes on all of them:
 */

/*
 * ignore sprintf return value ("character count") because it's not
 * defined in terms of UTF so it would be misinterpreted if we passed
 * it on.
 */

/*
 * if necessary, they could be made more efficient by skipping vsprintf based
 * on booleans
 */

/* Most of them have multiple calls to printf-style functions.  */
/* At first glance, it seems stupid to reformat the same arguments again */
/* but we have no way of telling how long the formatted output will be */
/* and hence cannot allocate a buffer to do so. */
/* Fortunately, in production code, most of the duplicate reformatting */
/* will be skipped, since it is due to handling errors and debugging. */

/*
 * Name: expWriteBytesAndLogIfTtyU
 *
 * Output to channel (and log if channel is stdout or devtty)
 *
 * Returns: TCL_OK or TCL_ERROR;
 */

int
expWriteBytesAndLogIfTtyU(esPtr,buf,lenBytes)
    ExpState *esPtr;
    char *buf;
    int lenBytes;
{
    int wc;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (esPtr->valid)
	wc = Tcl_WriteChars(esPtr->channel,buf,lenBytes);

    if (tsdPtr->logChannel && ((esPtr->fdout == 1) || expDevttyIs(esPtr))) {
	Tcl_WriteChars(tsdPtr->logChannel,buf,lenBytes);
    }
    return wc;
}

/*
 * Name: expLogDiagU
 *
 * Send to the Log (and Diag if open).  This is for writing to the log.
 * (In contrast, expDiagLog... is for writing diagnostics.)
 */

void
expLogDiagU(buf)
char *buf;
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    expDiagWriteChars(buf,-1);
    if (tsdPtr->logChannel) {
	Tcl_WriteChars(tsdPtr->logChannel, buf, -1);
    }
}

/*
 * Name: expLogInteractionU
 *
 * Show chars to user if they've requested it, UNLESS they're seeing it
 * already because they're typing it and tty driver is echoing it.
 * Also send to Diag and Log if appropriate.
 */
void
expLogInteractionU(esPtr,buf)
    ExpState *esPtr;
    char *buf;
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (tsdPtr->logAll || (tsdPtr->logUser && tsdPtr->logChannel)) {
	Tcl_WriteChars(tsdPtr->logChannel,buf,-1);
    }

    /* hmm.... if stdout is closed such as by disconnect, loguser
       should be forced FALSE */

    /* don't write to user if they're seeing it already, i.e., typing it! */
    if (tsdPtr->logUser && (!expStdinoutIs(esPtr)) && (!expDevttyIs(esPtr))) {
	ExpState *stdinout = expStdinoutGet();
	if (stdinout->valid) {
	    Tcl_WriteChars(stdinout->channel,buf,-1);
	}
    }
    expDiagWriteChars(buf,-1);
}

/* send to log if open */
/* send to stderr if debugging enabled */
/* use this for logging everything but the parent/child conversation */
/* (this turns out to be almost nothing) */
/* uppercase L differentiates if from math function of same name */
#define LOGUSER		(tsdPtr->logUser || force_stdout)
/*VARARGS*/
void
expStdoutLog TCL_VARARGS_DEF(int,arg1)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    int force_stdout;
    char *fmt;
    va_list args;

    force_stdout = TCL_VARARGS_START(int,arg1,args);
    fmt = va_arg(args,char *);

    if ((!tsdPtr->logUser) && (!force_stdout) && (!tsdPtr->logAll)) return;

    (void) vsprintf(bigbuf,fmt,args);
    expDiagWriteBytes(bigbuf,-1);
    if (tsdPtr->logAll || (LOGUSER && tsdPtr->logChannel)) Tcl_WriteChars(tsdPtr->logChannel,bigbuf,-1);
    if (LOGUSER) fprintf(stdout,"%s",bigbuf);
    va_end(args);
}

/* just like log but does no formatting */
/* send to log if open */
/* use this function for logging the parent/child conversation */
void
expStdoutLogU(buf,force_stdout)
char *buf;
int force_stdout;	/* override value of logUser */
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    int length;

    if ((!tsdPtr->logUser) && (!force_stdout) && (!tsdPtr->logAll)) return;

    length = strlen(buf);
    expDiagWriteBytes(buf,length);
    if (tsdPtr->logAll || (LOGUSER && tsdPtr->logChannel)) Tcl_WriteChars(tsdPtr->logChannel,bigbuf,-1);
    if (LOGUSER) fwrite(buf,1,length,stdout);
}

/* send to log if open */
/* send to stderr */
/* use this function for error conditions */
/*VARARGS*/
void
expErrorLog TCL_VARARGS_DEF(char *,arg1)
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    char *fmt;
    va_list args;

    fmt = TCL_VARARGS_START(char *,arg1,args);
    (void) vsprintf(bigbuf,fmt,args);

    expDiagWriteChars(bigbuf,-1);
    fprintf(stderr,"%s",bigbuf);
    if (tsdPtr->logChannel) Tcl_WriteChars(tsdPtr->logChannel,bigbuf,-1);
    
    va_end(args);
}

/* just like errorlog but does no formatting */
/* send to log if open */
/* use this function for logging the parent/child conversation */
/*ARGSUSED*/
void
expErrorLogU(buf)
char *buf;
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    int length = strlen(buf);
    fwrite(buf,1,length,stderr);
    expDiagWriteChars(buf,-1);
    if (tsdPtr->logChannel) Tcl_WriteChars(tsdPtr->logChannel,buf,-1);
}



/* send diagnostics to Diag, Log, and stderr */
/* use this function for recording unusual things in the log */
/*VARARGS*/
void
expDiagLog TCL_VARARGS_DEF(char *,arg1)
{
    char *fmt;
    va_list args;

    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if ((tsdPtr->diagToStderr == 0) && (tsdPtr->diagChannel == 0)) return;

    fmt = TCL_VARARGS_START(char *,arg1,args);

    (void) vsprintf(bigbuf,fmt,args);

    expDiagWriteBytes(bigbuf,-1);
    if (tsdPtr->diagToStderr) {
	fprintf(stderr,"%s",bigbuf);
	if (tsdPtr->logChannel) Tcl_WriteChars(tsdPtr->logChannel,bigbuf,-1);
    }

    va_end(args);
}


/* expDiagLog for unformatted strings
   this also takes care of arbitrary large strings */
void
expDiagLogU(str)
    char *str;
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if ((tsdPtr->diagToStderr == 0) && (tsdPtr->diagChannel == 0)) return;

    expDiagWriteBytes(str,-1);

    if (tsdPtr->diagToStderr) {
	fprintf(stderr,"%s",str);
	if (tsdPtr->logChannel) Tcl_WriteChars(tsdPtr->logChannel,str,-1);
    }
}

void
expDiagToStderrSet(val)
    int val;
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    tsdPtr->diagToStderr = val;
}
    

int
expDiagToStderrGet() {
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    return tsdPtr->diagToStderr;
}

Tcl_Channel
expDiagChannelGet()
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    return tsdPtr->diagChannel;
}

void
expDiagChannelClose(interp)
    Tcl_Interp *interp;
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (!tsdPtr->diagChannel) return;
    Tcl_UnregisterChannel(interp,tsdPtr->diagChannel);
    Tcl_DStringFree(&tsdPtr->diagFilename);
    tsdPtr->diagChannel = 0;
}

/* currently this registers the channel, however the exp_internal
   command doesn't currently give the channel name to the user so
   this is kind of useless - but we might change this someday */
int
expDiagChannelOpen(interp,filename)
    Tcl_Interp *interp;
    char *filename;
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    char *newfilename;

    Tcl_ResetResult(interp);
    newfilename = Tcl_TranslateFileName(interp,filename,&tsdPtr->diagFilename);
    if (!newfilename) return TCL_ERROR;

    /* Tcl_TildeSubst doesn't store into dstring */
    /* if no ~, so force string into dstring */
    /* this is only needed so that next time around */
    /* we can get dstring for -info if necessary */
    if (Tcl_DStringValue(&tsdPtr->diagFilename)[0] == '\0') {
	Tcl_DStringAppend(&tsdPtr->diagFilename,filename,-1);
    }

    tsdPtr->diagChannel = Tcl_OpenFileChannel(interp,newfilename,"a",0777);
    if (!tsdPtr->diagChannel) {
	Tcl_DStringFree(&tsdPtr->diagFilename);
	return TCL_ERROR;
    }
    Tcl_RegisterChannel(interp,tsdPtr->diagChannel);
    Tcl_SetChannelOption(interp,tsdPtr->diagChannel,"-buffering","none");
    return TCL_OK;
}

void
expDiagWriteObj(obj)
    Tcl_Obj *obj;
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (!tsdPtr->diagChannel) return;

    Tcl_WriteObj(tsdPtr->diagChannel,obj);
}

/* write 8-bit bytes */
void
expDiagWriteBytes(str,len)
    char *str;
    int len;
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (!tsdPtr->diagChannel) return;

    Tcl_Write(tsdPtr->diagChannel,str,len);
}

/* write UTF chars */
void
expDiagWriteChars(str,len)
    char *str;
    int len;
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (!tsdPtr->diagChannel) return;

    Tcl_WriteChars(tsdPtr->diagChannel,str,len);
}

char *
expDiagFilename()
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    return Tcl_DStringValue(&tsdPtr->diagFilename);
}

void
expLogChannelClose(interp)
    Tcl_Interp *interp;
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    if (!tsdPtr->logChannel) return;

    if (Tcl_DStringLength(&tsdPtr->logFilename)) {
	/* it's a channel that we created */
	Tcl_UnregisterChannel(interp,tsdPtr->logChannel);
	Tcl_DStringFree(&tsdPtr->logFilename);
    } else {
	/* it's a channel that tcl::open created */
	if (!tsdPtr->logLeaveOpen) {
	    Tcl_UnregisterChannel(interp,tsdPtr->logChannel);
	}
    }
    tsdPtr->logChannel = 0;
    tsdPtr->logAll = 0; /* can't write to log if none open! */
}

/* currently this registers the channel, however the exp_log_file
   command doesn't currently give the channel name to the user so
   this is kind of useless - but we might change this someday */
int
expLogChannelOpen(interp,filename,append)
    Tcl_Interp *interp;
    char *filename;
    int append;
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    char *newfilename;
    char mode[2];

    if (append) {
      strcpy(mode,"a");
    } else {
      strcpy(mode,"w");
    }

    Tcl_ResetResult(interp);
    newfilename = Tcl_TranslateFileName(interp,filename,&tsdPtr->logFilename);
    if (!newfilename) return TCL_ERROR;

    /* Tcl_TildeSubst doesn't store into dstring */
    /* if no ~, so force string into dstring */
    /* this is only needed so that next time around */
    /* we can get dstring for -info if necessary */
    if (Tcl_DStringValue(&tsdPtr->logFilename)[0] == '\0') {
	Tcl_DStringAppend(&tsdPtr->logFilename,filename,-1);
    }

    tsdPtr->logChannel = Tcl_OpenFileChannel(interp,newfilename,mode,0777);
    if (!tsdPtr->logChannel) {
	Tcl_DStringFree(&tsdPtr->logFilename);
	return TCL_ERROR;
    }
    Tcl_RegisterChannel(interp,tsdPtr->logChannel);
    Tcl_SetChannelOption(interp,tsdPtr->logChannel,"-buffering","none");
    return TCL_OK;
}

int
expLogAppendGet()
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    return tsdPtr->logAppend;
}

void
expLogAppendSet(app)
    int app;
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    tsdPtr->logAppend = app;
}

int
expLogAllGet()
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    return tsdPtr->logAll;
}

void
expLogAllSet(app)
    int app;
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    tsdPtr->logAll = app;
    /* should probably confirm logChannel != 0 */
}

int
expLogToStdoutGet()
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    return tsdPtr->logUser;
}

void
expLogToStdoutSet(app)
    int app;
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    tsdPtr->logUser = app;
}

int
expLogLeaveOpenGet()
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    return tsdPtr->logLeaveOpen;
}

void
expLogLeaveOpenSet(app)
    int app;
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    tsdPtr->logLeaveOpen = app;
}

Tcl_Channel
expLogChannelGet()
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    return tsdPtr->logChannel;
}

/* to set to a pre-opened channel (presumably by tcl::open) */
int
expLogChannelSet(interp,name)
    Tcl_Interp *interp;
    char *name;
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    int mode;
    
    if (0 == (tsdPtr->logChannel = Tcl_GetChannel(interp,name,&mode))) {
	return TCL_ERROR;
    }
    if (!(mode & TCL_WRITABLE)) {
	tsdPtr->logChannel = 0;
	Tcl_SetResult(interp,"channel is not writable",TCL_VOLATILE);
	return TCL_ERROR;
    }
    return TCL_OK;
}

char *
expLogFilenameGet()
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    return Tcl_DStringValue(&tsdPtr->logFilename);
}

int
expLogUserGet()
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    return tsdPtr->logUser;
}

void
expLogUserSet(logUser)
    int logUser;
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    tsdPtr->logUser = logUser;
}



/* generate printable versions of random ASCII strings.  Primarily used */
/* in diagnostic mode, "expect -d" */
static char *
expPrintifyReal(s)
char *s;
{
	static int destlen = 0;
	static char *dest = 0;
	char *d;		/* ptr into dest */
	unsigned int need;
	Tcl_UniChar ch;

	if (s == 0) return("<null>");

	/* worst case is every character takes 4 to printify */
	need = strlen(s)*6 + 1;
	if (need > destlen) {
		if (dest) ckfree(dest);
		dest = ckalloc(need);
		destlen = need;
	}

	for (d = dest;*s;) {
	    s += Tcl_UtfToUniChar(s, &ch);
	    if (ch == '\r') {
		strcpy(d,"\\r");		d += 2;
	    } else if (ch == '\n') {
		strcpy(d,"\\n");		d += 2;
	    } else if (ch == '\t') {
		strcpy(d,"\\t");		d += 2;
	    } else if ((ch < 0x80) && isprint(UCHAR(ch))) {
		*d = (char)ch;			d += 1;
	    } else {
		sprintf(d,"\\u%04x",ch);	d += 6;
	    }
	}
	*d = '\0';
	return(dest);
}

char *
expPrintifyObj(obj)
    Tcl_Obj *obj;
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    /* don't bother writing into bigbuf if we're not going to ever use it */
    if ((!tsdPtr->diagToStderr) && (!tsdPtr->diagChannel)) return((char *)0);
    
    return expPrintifyReal(Tcl_GetString(obj));
}

char *
expPrintify(s) /* INTL */
char *s;
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    /* don't bother writing into bigbuf if we're not going to ever use it */
    if ((!tsdPtr->diagToStderr) && (!tsdPtr->diagChannel)) return((char *)0);

    return expPrintifyReal(s);
}
 
void
expDiagInit()
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    Tcl_DStringInit(&tsdPtr->diagFilename);
    tsdPtr->diagChannel = 0;
    tsdPtr->diagToStderr = 0;
}

void
expLogInit()
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    Tcl_DStringInit(&tsdPtr->logFilename);
    tsdPtr->logChannel = 0;
    tsdPtr->logAll = FALSE;
    tsdPtr->logUser = TRUE;
}






Deleted exp_log.h.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45















































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

/* exp_log.h */

extern void		expErrorLog _ANSI_ARGS_(TCL_VARARGS(char *,fmt));
extern void		expErrorLogU _ANSI_ARGS_((char *));

extern void		expStdoutLog _ANSI_ARGS_(TCL_VARARGS(int,force_stdout));
extern void		expStdoutLogU _ANSI_ARGS_((char *buf, int force_stdout));

EXTERN void		expDiagInit _ANSI_ARGS_((void));
EXTERN int		expDiagChannelOpen _ANSI_ARGS_((Tcl_Interp *,char *));
EXTERN Tcl_Channel	expDiagChannelGet _ANSI_ARGS_((void));
EXTERN void		expDiagChannelClose _ANSI_ARGS_((Tcl_Interp *));
EXTERN char *		expDiagFilename _ANSI_ARGS_((void));
EXTERN int		expDiagToStderrGet _ANSI_ARGS_((void));
EXTERN void		expDiagToStderrSet _ANSI_ARGS_((int));
EXTERN void		expDiagWriteBytes _ANSI_ARGS_((char *,int));
EXTERN void		expDiagWriteChars _ANSI_ARGS_((char *,int));
EXTERN void		expDiagWriteObj _ANSI_ARGS_((Tcl_Obj *));
EXTERN void		expDiagLog _ANSI_ARGS_(TCL_VARARGS(char *,fmt));
EXTERN void		expDiagLogU _ANSI_ARGS_((char *));

EXTERN char *		expPrintify _ANSI_ARGS_((char *));
EXTERN char *		expPrintifyObj _ANSI_ARGS_((Tcl_Obj *));

EXTERN void		expLogInit _ANSI_ARGS_((void));
EXTERN int		expLogChannelOpen _ANSI_ARGS_((Tcl_Interp *,char *,int));
EXTERN Tcl_Channel 	expLogChannelGet _ANSI_ARGS_((void));
EXTERN int		expLogChannelSet _ANSI_ARGS_((Tcl_Interp *,char *));
EXTERN void		expLogChannelClose _ANSI_ARGS_((Tcl_Interp *));
EXTERN char *		expLogFilenameGet _ANSI_ARGS_((void));
EXTERN void		expLogAppendSet _ANSI_ARGS_((int));
EXTERN int		expLogAppendGet _ANSI_ARGS_((void));
EXTERN void		expLogLeaveOpenSet _ANSI_ARGS_((int));
EXTERN int		expLogLeaveOpenGet _ANSI_ARGS_((void));
EXTERN void		expLogAllSet _ANSI_ARGS_((int));
EXTERN int		expLogAllGet _ANSI_ARGS_((void));
EXTERN void		expLogToStdoutSet _ANSI_ARGS_((int));
EXTERN int		expLogToStdoutGet _ANSI_ARGS_((void));
EXTERN void		expLogDiagU _ANSI_ARGS_((char *));
EXTERN int		expWriteBytesAndLogIfTtyU _ANSI_ARGS_((ExpState *,char *,int));

EXTERN int		expLogUserGet _ANSI_ARGS_((void));
EXTERN void		expLogUserSet _ANSI_ARGS_((int));

EXTERN void		expLogInteractionU _ANSI_ARGS_((ExpState *,char *));






Deleted exp_main_exp.c.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50




















































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

/* main.c - main() and some logging routines for expect

Written by: Don Libes, NIST, 2/6/90

Design and implementation of this program was paid for by U.S. tax
dollars.  Therefore it is public domain.  However, the author and NIST
would appreciate credit if this program or parts of it are used.
*/

#include "expect_cf.h"
#include <stdio.h>
#include "tcl.h"
#include "expect_tcl.h"

int
main(argc, argv)
int argc;
char *argv[];
{
	int rc = 0;
	Tcl_Interp *interp = Tcl_CreateInterp();
	Tcl_FindExecutable(argv[0]);

	if (Tcl_Init(interp) == TCL_ERROR) {
	    fprintf(stderr,"Tcl_Init failed: %s\n",interp->result);
	    (void) exit(1);
	}

	if (Expect_Init(interp) == TCL_ERROR) {
	    fprintf(stderr,"Expect_Init failed: %s\n",interp->result);
	    (void) exit(1);
	}

	exp_parse_argv(interp,argc,argv);

	/* become interactive if requested or "nothing to do" */
	if (exp_interactive)
		(void) exp_interpreter(interp,(Tcl_Obj *)0);
	else if (exp_cmdfile)
		rc = exp_interpret_cmdfile(interp,exp_cmdfile);
	else if (exp_cmdfilename)
		rc = exp_interpret_cmdfilename(interp,exp_cmdfilename);

	/* assert(exp_cmdlinecmds != 0) */

	Tcl_Exit(rc);
	/*NOTREACHED*/
	return 0;		/* Needed only to prevent compiler warning. */
}







Deleted exp_main_sub.c.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

/* exp_main_sub.c - miscellaneous subroutines for Expect or Tk main() */

#include "expect_cf.h"
#include <stdio.h>
#include <errno.h>
#ifdef HAVE_INTTYPES_H
#  include <inttypes.h>
#endif
#include <sys/types.h>

#ifdef HAVE_UNISTD_H
# include <unistd.h>
#endif

#ifdef HAVE_SYS_WAIT_H
#include <sys/wait.h>
#endif

#include "tcl.h"
#include "tclInt.h"
#include "exp_rename.h"
#include "exp_prog.h"
#include "exp_command.h"
#include "exp_tty_in.h"
#include "exp_log.h"
#include "exp_event.h"
#ifdef TCL_DEBUGGER
#include "tcldbg.h"
#endif

#ifdef __CENTERLINE__
#undef	EXP_VERSION
#define	EXP_VERSION		"5.0.3"		/* I give up! */
					/* It is not necessary that number */
					/* be accurate.  It is just here to */
					/* pacify Centerline which doesn't */
					/* seem to be able to get it from */
					/* the Makefile. */
#undef	SCRIPTDIR
#define SCRIPTDIR	"example/"
#undef	EXECSCRIPTDIR
#define EXECSCRIPTDIR	"example/"
#endif
char exp_version[] = EXP_VERSION;
#define NEED_TCL_MAJOR		7
#define NEED_TCL_MINOR		5

char *exp_argv0 = "this program";	/* default program name */
void (*exp_app_exit)() = 0;
void (*exp_event_exit)() = 0;
FILE *exp_cmdfile = 0;
char *exp_cmdfilename = 0;
int exp_cmdlinecmds = FALSE;
int exp_interactive =  FALSE;
int exp_buffer_command_input = FALSE;/* read in entire cmdfile at once */
int exp_fgets();

Tcl_Interp *exp_interp;	/* for use by signal handlers who can't figure out */
			/* the interpreter directly */
int exp_tcl_debugger_available = FALSE;

int exp_getpid;

static void
usage(interp)
Tcl_Interp *interp;
{
  expErrorLog("usage: expect [-div] [-c cmds] [[-f] cmdfile] [args]\r\n");
  Tcl_Exit(1);
}

/* this clumsiness because pty routines don't know Tcl definitions */
/*ARGSUSED*/
static
void
exp_pty_exit_for_tcl(clientData)
ClientData clientData;
{
  exp_pty_exit();
}

static
void
exp_init_pty_exit()
{
  Tcl_CreateExitHandler(exp_pty_exit_for_tcl,(ClientData)0);
}

/* This can be called twice or even recursively - it's safe. */
void
exp_exit_handlers(clientData)
ClientData clientData;
{
	extern int exp_forked;

	Tcl_Interp *interp = (Tcl_Interp *)clientData;

	/* use following checks to prevent recursion in exit handlers */
	/* if this code ever supports multiple interps, these should */
	/* become interp-specific */

	static int did_app_exit = FALSE;
	static int did_expect_exit = FALSE;

	if (!did_expect_exit) {
		did_expect_exit = TRUE;
		/* called user-defined exit routine if one exists */
		if (exp_onexit_action) {
			int result = Tcl_GlobalEval(interp,exp_onexit_action);
			if (result != TCL_OK) Tcl_BackgroundError(interp);
		}
	} else {
		expDiagLogU("onexit handler called recursively - forcing exit\r\n");
	}

	if (exp_app_exit) {
		if (!did_app_exit) {
			did_app_exit = TRUE;
			(*exp_app_exit)(interp);
		} else {
			expDiagLogU("application exit handler called recursively - forcing exit\r\n");
		}
	}

	if (!exp_disconnected
	    && !exp_forked
	    && (exp_dev_tty != -1)
	    && isatty(exp_dev_tty)
	    && exp_ioctled_devtty) {
		exp_tty_set(interp,&exp_tty_original,exp_dev_tty,0);
	}
	/* all other files either don't need to be flushed or will be
	   implicitly closed at exit.  Spawned processes are free to continue
	   running, however most will shutdown after seeing EOF on stdin.
	   Some systems also deliver SIGHUP and other sigs to idle processes
	   which will blow them away if not prepared.
	*/

	exp_close_all(interp);
}

static int
history_nextid(interp)
Tcl_Interp *interp;
{
    /* unncessarily tricky coding - if nextid isn't defined,
       maintain our own static version */

    static int nextid = 0;
    char *nextidstr = Tcl_GetVar2(interp,"tcl::history","nextid",0);
    if (nextidstr) {
	/* intentionally ignore failure */
	(void) sscanf(nextidstr,"%d",&nextid);
    }
    return ++nextid;
}

/* this stupidity because Tcl needs commands in writable space */
static char prompt1[] = "prompt1";
static char prompt2[] = "prompt2";

static char *prompt2_default = "+> ";
static char prompt1_default[] = "expect%d.%d> ";

/*ARGSUSED*/
int
Exp_Prompt1Cmd(clientData, interp, objc, objv)
ClientData clientData;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];		/* Argument objects. */
{
    static char buffer[200];

    Interp *iPtr = (Interp *)interp;

    sprintf(buffer,prompt1_default,iPtr->numLevels,history_nextid(interp));
    Tcl_SetResult(interp,buffer,TCL_STATIC);
    return(TCL_OK);
}

/*ARGSUSED*/
int
Exp_Prompt2Cmd(clientData, interp, objc, objv)
ClientData clientData;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
    Tcl_SetResult(interp,prompt2_default,TCL_STATIC);
    return(TCL_OK);
}

/*ARGSUSED*/
static int
ignore_procs(interp,s)
Tcl_Interp *interp;
char *s;		/* function name */
{
	return ((s[0] == 'p') &&
		(s[1] == 'r') &&
		(s[2] == 'o') &&
		(s[3] == 'm') &&
		(s[4] == 'p') &&
		(s[5] == 't') &&
		((s[6] == '1') ||
		 (s[6] == '2')) &&
		(s[7] == '\0')
	       );
}

/* handle an error from Tcl_Eval or Tcl_EvalFile */
static void
handle_eval_error(interp,check_for_nostack)
Tcl_Interp *interp;
int check_for_nostack;
{
	char *msg;

	/* if errorInfo has something, print it */
	/* else use what's in interp->result */

	msg = Tcl_GetVar(interp,"errorInfo",TCL_GLOBAL_ONLY);
	if (!msg) msg = interp->result;
	else if (check_for_nostack) {
		/* suppress errorInfo if generated via */
		/* error ... -nostack */
		if (0 == strncmp("-nostack",msg,8)) return;

		/*
		 * This shouldn't be necessary, but previous test fails
		 * because of recent change John made - see eval_trap_action()
		 * in exp_trap.c for more info
		 */
		if (exp_nostack_dump) {
			exp_nostack_dump = FALSE;
			return;
		}
	}

	/* no \n at end, since ccmd will already have one. */
	/* Actually, this is not true if command is last in */
	/* file and has no newline after it, oh well */
	expErrorLogU(exp_cook(msg,(int *)0));
	expErrorLogU("\r\n");
}

/* user has pressed escape char from interact or somehow requested expect.
If a user-supplied command returns:

TCL_ERROR,	assume user is experimenting and reprompt
TCL_OK,		ditto
TCL_RETURN,	return TCL_OK (assume user just wants to escape() to return)
EXP_TCL_RETURN,	return TCL_RETURN
anything else	return it
*/
int
exp_interpreter(interp,eofObj)
Tcl_Interp *interp;
Tcl_Obj *eofObj;
{
    Tcl_Obj *commandPtr = NULL;
    int code;
    int gotPartial;
    Interp *iPtr = (Interp *)interp;
    int tty_changed = FALSE;
    exp_tty tty_old;
    int was_raw, was_echo;

    Tcl_Channel inChannel, outChannel;
    ExpState *esPtr = expStdinoutGet();
    /*	int fd = fileno(stdin);*/
	
    expect_key++;

    commandPtr = Tcl_NewObj();
    Tcl_IncrRefCount(commandPtr);

    gotPartial = 0;
    while (TRUE) {
	outChannel = expStdinoutGet()->channel;
	if (outChannel) {
	    Tcl_Flush(outChannel);
	}
	if (!esPtr->open) {
	  code = EXP_EOF;
	  goto eof;
	}

	/* force terminal state */
	tty_changed = exp_tty_cooked_echo(interp,&tty_old,&was_raw,&was_echo);

	if (!gotPartial) {
	    code = Tcl_Eval(interp,prompt1);
	    if (code == TCL_OK) {
		expStdoutLogU(Tcl_GetStringResult(interp),1);
	    }
	    else expStdoutLog(1,prompt1_default,iPtr->numLevels,history_nextid(interp));
	} else {
	    code = Tcl_Eval(interp,prompt2);
	    if (code == TCL_OK) {
		expStdoutLogU(Tcl_GetStringResult(interp),1);
	    }
	    else expStdoutLogU(prompt2_default,1);
	}

	esPtr->force_read = 1;
	code = exp_get_next_event(interp,&esPtr,1,&esPtr,EXP_TIME_INFINITY,
		esPtr->key);
	/*  check for code == EXP_TCLERROR? */

	if (code != EXP_EOF) {
	    inChannel = expStdinoutGet()->channel;
	    code = Tcl_GetsObj(inChannel, commandPtr);
#ifdef SIMPLE_EVENT
	    if (code == -1 && errno == EINTR) {
		if (Tcl_AsyncReady()) {
		    (void) Tcl_AsyncInvoke(interp,TCL_OK);
		}
		continue;
	    }
#endif
	    if (code < 0) code = EXP_EOF;
	    if ((code == 0) && Tcl_Eof(inChannel) && !gotPartial) code = EXP_EOF;
	}

    eof:
	if (code == EXP_EOF) {
	    if (eofObj) {
		code = Tcl_EvalObjEx(interp,eofObj,0);
	    } else {
		code = TCL_OK;
	    }
	    goto done;
	}

	expDiagWriteObj(commandPtr);
	/* intentionally always write to logfile */
	if (expLogChannelGet()) {
	    Tcl_WriteObj(expLogChannelGet(),commandPtr);
	}
	/* no need to write to stdout, since they will see */
	/* it just from it having been echoed as they are */
	/* typing it */

        /*
         * Add the newline removed by Tcl_GetsObj back to the string.
         */

	Tcl_AppendToObj(commandPtr, "\n", 1);
	if (!TclObjCommandComplete(commandPtr)) {
	    gotPartial = 1;
	    continue;
	}	

	Tcl_AppendToObj(commandPtr, "\n", 1);
	if (!TclObjCommandComplete(commandPtr)) {
	    gotPartial = 1;
	    continue;
	}

	gotPartial = 0;

	if (tty_changed) exp_tty_set(interp,&tty_old,was_raw,was_echo);

	code = Tcl_RecordAndEvalObj(interp, commandPtr, 0);
	Tcl_SetObjLength(commandPtr, 0);
	switch (code) {
	    char *str;

	    case TCL_OK:
	        str = Tcl_GetStringResult(interp);
		if (*str != 0) {
		    expStdoutLogU(exp_cook(str,(int *)0),1);
		    expStdoutLogU("\r\n",1);
		}
		continue;
	    case TCL_ERROR:
		handle_eval_error(interp,1);
		/* since user is typing by hand, we expect lots */
		/* of errors, and want to give another chance */
		continue;
#define finish(x)	{code = x; goto done;}
	    case TCL_BREAK:
	    case TCL_CONTINUE:
		finish(code);
	    case EXP_TCL_RETURN:
		finish(TCL_RETURN);
	    case TCL_RETURN:
		finish(TCL_OK);
	    default:
		/* note that ccmd has trailing newline */
		expErrorLog("error %d: ",code);
		expErrorLogU(Tcl_GetString(Tcl_GetObjResult(interp)));
		expErrorLogU("\r\n");
		continue;
	}
    }
    /* cannot fall thru here, must jump to label */
 done:
    if (tty_changed) exp_tty_set(interp,&tty_old,was_raw,was_echo);

    Tcl_DecrRefCount(commandPtr);
    return(code);
}

/*ARGSUSED*/
int
Exp_ExpVersionCmd(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
	int emajor, umajor;
	char *user_version;	/* user-supplied version string */

	if (argc == 1) {
		Tcl_SetResult(interp,exp_version,TCL_STATIC);
		return(TCL_OK);
	}
	if (argc > 3) {
		exp_error(interp,"usage: expect_version [[-exit] version]");
		return(TCL_ERROR);
	}

	user_version = argv[argc==2?1:2];
	emajor = atoi(exp_version);
	umajor = atoi(user_version);

	/* first check major numbers */
	if (emajor == umajor) {
		int u, e;

		/* now check minor numbers */
		char *dot = strchr(user_version,'.');
		if (!dot) {
			exp_error(interp,"version number must include a minor version number");
			return TCL_ERROR;
		}

		u = atoi(dot+1);
		dot = strchr(exp_version,'.');
		e = atoi(dot+1);
		if (e >= u) return(TCL_OK);
	}

	if (argc == 2) {
		exp_error(interp,"%s requires Expect version %s (but using %s)",
			exp_argv0,user_version,exp_version);
		return(TCL_ERROR);
	}
	expErrorLog("%s: requires Expect version %s (but using %s)\r\n",
		exp_argv0,user_version,exp_version);
	Tcl_Exit(1);
	/*NOTREACHED*/
}

static char init_auto_path[] = "\
if {$exp_library != \"\"} {\n\
    lappend auto_path $exp_library\n\
}\n\
if {$exp_exec_library != \"\"} {\n\
    lappend auto_path $exp_exec_library\n\
}";

int
Expect_Init(interp)
Tcl_Interp *interp;
{
    static int first_time = TRUE;

    if (first_time) {
	int tcl_major = atoi(TCL_VERSION);
	char *dot = strchr(TCL_VERSION,'.');
	int tcl_minor = atoi(dot+1);

	if (tcl_major < NEED_TCL_MAJOR || 
	    (tcl_major == NEED_TCL_MAJOR && tcl_minor < NEED_TCL_MINOR)) {
	    sprintf(interp->result,
		    "%s compiled with Tcl %d.%d but needs at least Tcl %d.%d\n",
		    exp_argv0,tcl_major,tcl_minor,
		    NEED_TCL_MAJOR,NEED_TCL_MINOR);
	    return TCL_ERROR;
	}

	if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 0) == NULL) {
	    return TCL_ERROR;
	}
	if (Tcl_PkgProvide(interp, "Expect", EXP_VERSION) != TCL_OK) {
	    return TCL_ERROR;
	}

	Tcl_Preserve(interp);
	Tcl_CreateExitHandler(Tcl_Release,(ClientData)interp);

	exp_getpid = getpid();
	exp_init_pty();
	exp_init_pty_exit();
	exp_init_tty(); /* do this only now that we have looked at */
	/* original tty state */
	exp_init_stdio();
	exp_init_sig();
	exp_init_event();
	exp_init_trap();
	exp_init_unit_random();
	exp_init_spawn_ids(interp);
	expChannelInit();
	expDiagInit();
	expLogInit();
	expDiagLogPtrSet(expDiagLogU);
	expErrnoMsgSet(Tcl_ErrnoMsg);

	Tcl_CreateExitHandler(exp_exit_handlers,(ClientData)interp);

	first_time = FALSE;
    }

    /* save last known interp for emergencies */
    exp_interp = interp;

    /* initialize commands */
    exp_init_most_cmds(interp);		/* add misc     cmds to interpreter */
    exp_init_expect_cmds(interp);	/* add expect   cmds to interpreter */
    exp_init_main_cmds(interp);		/* add main     cmds to interpreter */
    exp_init_trap_cmds(interp);		/* add trap     cmds to interpreter */
    exp_init_tty_cmds(interp);		/* add tty      cmds to interpreter */
    exp_init_interact_cmds(interp);	/* add interact cmds to interpreter */

    /* initialize variables */
    exp_init_spawn_id_vars(interp);
    expExpectVarsInit();

    /*
     * For each of the the Tcl variables, "expect_library",
     *"exp_library", and "exp_exec_library", set the variable
     * if it does not already exist.  This mechanism allows the
     * application calling "Expect_Init()" to set these varaibles
     * to alternate locations from where Expect was built.
     */

    if (Tcl_GetVar(interp, "expect_library", TCL_GLOBAL_ONLY) == NULL) {
	Tcl_SetVar(interp,"expect_library",SCRIPTDIR,0);/* deprecated */
    }
    if (Tcl_GetVar(interp, "exp_library", TCL_GLOBAL_ONLY) == NULL) {
	Tcl_SetVar(interp,"exp_library",SCRIPTDIR,0);
    }
    if (Tcl_GetVar(interp, "exp_exec_library", TCL_GLOBAL_ONLY) == NULL) {
	Tcl_SetVar(interp,"exp_exec_library",EXECSCRIPTDIR,0);
    }

    Tcl_Eval(interp,init_auto_path);
    Tcl_ResetResult(interp);

#ifdef TCL_DEBUGGER
    Dbg_IgnoreFuncs(interp,ignore_procs);
#endif

    return TCL_OK;
}

static char sigexit_init_default[] = "trap exit {SIGINT SIGTERM}";
static char debug_init_default[] = "trap {exp_debug 1} SIGINT";

void
exp_parse_argv(interp,argc,argv)
Tcl_Interp *interp;
int argc;
char **argv;
{
	char argc_rep[10]; /* enough space for storing literal rep of argc */

	int sys_rc = TRUE;	/* read system rc file */
	int my_rc = TRUE;	/* read personal rc file */

	int c;
	int rc;

	extern int optind;
	extern char *optarg;
	char *args;		/* ptr to string-rep of all args */
	char *debug_init;

	exp_argv0 = argv[0];

#ifdef TCL_DEBUGGER
	Dbg_ArgcArgv(argc,argv,1);
#endif

	/* initially, we must assume we are not interactive */
	/* this prevents interactive weirdness courtesy of unknown via -c */
	/* after handling args, we can change our mind */
	Tcl_SetVar(interp, "tcl_interactive", "0", TCL_GLOBAL_ONLY);

	Tcl_Eval(interp,sigexit_init_default);

	while ((c = getopt(argc, argv, "b:c:dD:f:inN-v")) != EOF) {
		switch(c) {
		case '-':
			/* getopt already handles -- internally, however */
			/* this allows us to abort getopt when dash is at */
			/* the end of another option which is required */
			/* in order to allow things like -n- on #! line */
			goto abort_getopt;
		case 'c': /* command */
			exp_cmdlinecmds = TRUE;
			rc = Tcl_Eval(interp,optarg);
			if (rc != TCL_OK) {
			    expErrorLogU(exp_cook(Tcl_GetVar(interp,"errorInfo",TCL_GLOBAL_ONLY),(int *)0));
			    expErrorLogU("\r\n");
			}
			break;
		case 'd': expDiagToStderrSet(TRUE);
			expDiagLog("expect version %s\r\n",exp_version);
			break;
#ifdef TCL_DEBUGGER
		case 'D':
			exp_tcl_debugger_available = TRUE;
			if (Tcl_GetInt(interp,optarg,&rc) != TCL_OK) {
			    expErrorLog("%s: -D argument must be 0 or 1\r\n",exp_argv0);
			    Tcl_Exit(1);
			}

			/* set up trap handler before Dbg_On so user does */
			/* not have to see it at first debugger prompt */
			if (0 == (debug_init = getenv("EXPECT_DEBUG_INIT"))) {
				debug_init = debug_init_default;
			}
			Tcl_Eval(interp,debug_init);
			if (rc == 1) Dbg_On(interp,0);
			break;
#endif
		case 'f': /* name of cmd file */
			exp_cmdfilename = optarg;
			break;
		case 'b': /* read cmdfile one part at a time */
			exp_cmdfilename = optarg;
			exp_buffer_command_input = TRUE;
			break;
		case 'i': /* interactive */
			exp_interactive = TRUE;
			break;
		case 'n': /* don't read personal rc file */
			my_rc = FALSE;
			break;
		case 'N': /* don't read system-wide rc file */
			sys_rc = FALSE;
			break;
		case 'v':
			printf("expect version %s\n", exp_version);
			Tcl_Exit(0);
			break;
		default: usage(interp);
		}
	}

 abort_getopt:

	for (c = 0;c<argc;c++) {
	    expDiagLog("argv[%d] = ",c);
	    expDiagLogU(argv[c]);
	    expDiagLogU("  ");
	}
	expDiagLogU("\r\n");

	/* if user hasn't explicitly requested we be interactive */
	/* look for a file or some other source of commands */
	if (!exp_interactive) {
		/* get cmd file name, if we haven't got it already */
		if (!exp_cmdfilename && (optind < argc)) {
			exp_cmdfilename = argv[optind];
			optind++;
		}

		if (exp_cmdfilename) {
			if (streq(exp_cmdfilename,"-")) {
				exp_cmdfile = stdin;
				exp_cmdfilename = 0;
			} else if (exp_buffer_command_input) {
				errno = 0;
				exp_cmdfile = fopen(exp_cmdfilename,"r");
				if (exp_cmdfile) {
					exp_cmdfilename = 0;
					expCloseOnExec(fileno(exp_cmdfile));
				} else {
					char *msg;

					if (errno == 0) {
						msg = "could not read - odd file name?";
					} else {
						msg = Tcl_ErrnoMsg(errno);
					}
					expErrorLog("%s: %s\r\n",exp_cmdfilename,msg);
					Tcl_Exit(1);
				}
			}
		} else if (!exp_cmdlinecmds) {
			if (isatty(0)) {
				/* no other source of commands, force interactive */
				exp_interactive = TRUE;
			} else {
				/* read cmds from redirected stdin */
				exp_cmdfile = stdin;
			}
		}
	}

	if (exp_interactive) {
		Tcl_SetVar(interp, "tcl_interactive","1",TCL_GLOBAL_ONLY);
	}

	/* collect remaining args and make into argc, argv0, and argv */
	sprintf(argc_rep,"%d",argc-optind);
	Tcl_SetVar(interp,"argc",argc_rep,0);
	expDiagLog("set argc %s\r\n",argc_rep);

	if (exp_cmdfilename) {
		Tcl_SetVar(interp,"argv0",exp_cmdfilename,0);
		expDiagLog("set argv0 \"%s\"\r\n",exp_cmdfilename);
	} else {
		Tcl_SetVar(interp,"argv0",exp_argv0,0);
		expDiagLog("set argv0 \"%s\"\r\n",exp_argv0);
	}

	args = Tcl_Merge(argc-optind,argv+optind);
	expDiagLogU("set argv \"");
	expDiagLogU(args);
	expDiagLogU("\"\r\n");
	Tcl_SetVar(interp,"argv",args,0);
	Tcl_Free(args);

	exp_interpret_rcfiles(interp,my_rc,sys_rc);
}

/* read rc files */
void
exp_interpret_rcfiles(interp,my_rc,sys_rc)
Tcl_Interp *interp;
int my_rc;
int sys_rc;
{
	int rc;

	if (sys_rc) {
	    char file[200];
	    int fd;

	    sprintf(file,"%s/expect.rc",SCRIPTDIR);
	    if (-1 != (fd = open(file,0))) {
		if (TCL_ERROR == (rc = Tcl_EvalFile(interp,file))) {
		    expErrorLog("error executing system initialization file: %s\r\n",file);
		    if (rc != TCL_ERROR)
			expErrorLog("Tcl_Eval = %d\r\n",rc);
		    if (*interp->result != 0) {
			expErrorLogU(interp->result);
			expErrorLogU("\r\n");
		    }
		    Tcl_Exit(1);
		}
		close(fd);
	    }
	}
	if (my_rc) {
	    char file[200];
	    char *home;
	    int fd;
	    char *getenv();

	    if ((NULL != (home = getenv("DOTDIR"))) ||
		(NULL != (home = getenv("HOME")))) {
		sprintf(file,"%s/.expect.rc",home);
		if (-1 != (fd = open(file,0))) {
		    if (TCL_ERROR == (rc = Tcl_EvalFile(interp,file))) {
			expErrorLog("error executing file: %s\r\n",file);
			if (rc != TCL_ERROR)
				expErrorLog("Tcl_Eval = %d\r\n",rc);
			if (*interp->result != 0) {
			    expErrorLogU(interp->result);
			    expErrorLogU("\r\n");
			}
			Tcl_Exit(1);
		    }
		    close(fd);
	        }
	    }
	}
}

int
exp_interpret_cmdfilename(interp,filename)
Tcl_Interp *interp;
char *filename;
{
	int rc;

	expDiagLog("executing commands from command file %s\r\n",filename);

	Tcl_ResetResult(interp);
	if (TCL_OK != (rc = Tcl_EvalFile(interp,filename))) {
		/* EvalFile doesn't bother to copy error to errorInfo */
		/* so force it */
		Tcl_AddErrorInfo(interp, "");
		handle_eval_error(interp,0);
	}
	return rc;
}

int
exp_interpret_cmdfile(interp,fp)
Tcl_Interp *interp;
FILE *fp;
{
	int rc = 0;
	int gotPartial;
	int eof;

	Tcl_DString dstring;
	Tcl_DStringInit(&dstring);

	expDiagLogU("executing commands from command file\r\n");

	gotPartial = 0;
	eof = FALSE;
	while (1) {
		char line[BUFSIZ];/* buffer for partial Tcl command */
		char *ccmd;	/* pointer to complete Tcl command */

		if (fgets(line,BUFSIZ,fp) == NULL) {
			if (!gotPartial) break;
			eof = TRUE;
		}
		ccmd = Tcl_DStringAppend(&dstring,line,-1);
		if (!Tcl_CommandComplete(ccmd) && !eof) {
			gotPartial = 1;
			continue;	/* continue collecting command */
		}
		gotPartial = 0;

		rc = Tcl_Eval(interp,ccmd);
		Tcl_DStringFree(&dstring);
		if (rc != TCL_OK) {
			handle_eval_error(interp,0);
			break;
		}
		if (eof) break;
	}
	Tcl_DStringFree(&dstring);
	return rc;
}

static struct exp_cmd_data cmd_data[]  = {
{"exp_version",	exp_proc(Exp_ExpVersionCmd),	0,	0},
{"prompt1",	exp_proc(Exp_Prompt1Cmd),	0,	EXP_NOPREFIX},
{"prompt2",	exp_proc(Exp_Prompt2Cmd),	0,	EXP_NOPREFIX},
{0}};

void
exp_init_main_cmds(interp)
Tcl_Interp *interp;
{
	exp_create_commands(interp,cmd_data);
}






Deleted exp_main_tk.c.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454








































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

/* exp_main_tk.c - main for expectk

   This file consists of three pieces:
   1) AppInit for Expectk.  This has been suitably modified to invoke
      a modified version of Tk_Init.
   2) Tk_Init for Expectk.  What's wrong with the normal Tk_Init is that
      removes the -- in the cmd-line arg list, so Expect cannot know
      whether args are flags to Expectk or data for the script.  Sigh.
   3) Additions and supporting utilities to Tk's Argv parse table to
      support Expectk's flags.

   Author: Don Libes, NIST, 2/20/96

*/

/* Expectk's AppInit */

/* 
 * tkAppInit.c --
 *
 *	Provides a default version of the Tcl_AppInit procedure for
 *	use in wish and similar Tk-based applications.
 *
 * Copyright (c) 1993 The Regents of the University of California.
 * Copyright (c) 1994 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifndef lint
static char sccsid[] = "@(#) tkAppInit.c 1.19 95/12/23 17:09:24";
#endif /* not lint */

#include <ctype.h>

#include "tk.h"

#include "expect_tcl.h"
#include "tcldbg.h"

/*
 * The following variable is a special hack that is needed in order for
 * Sun shared libraries to be used for Tcl.
 */

extern int matherr();
int *tclDummyMathPtr = (int *) matherr;

#ifdef TK_TEST
EXTERN int		Tktest_Init _ANSI_ARGS_((Tcl_Interp *interp));
#endif /* TK_TEST */

/*
 *----------------------------------------------------------------------
 *
 * main --
 *
 *	This is the main program for the application.
 *
 * Results:
 *	None: Tk_Main never returns here, so this procedure never
 *	returns either.
 *
 * Side effects:
 *	Whatever the application does.
 *
 *----------------------------------------------------------------------
 */

int
main(argc, argv)
    int argc;			/* Number of command-line arguments. */
    char **argv;		/* Values of command-line arguments. */
{
    Tk_Main(argc, argv, Tcl_AppInit);
    return 0;			/* Needed only to prevent compiler warning. */
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AppInit --
 *
 *	This procedure performs application-specific initialization.
 *	Most applications, especially those that incorporate additional
 *	packages, will have their own version of this procedure.
 *
 * Results:
 *	Returns a standard Tcl completion code, and leaves an error
 *	message in interp->result if an error occurs.
 *
 * Side effects:
 *	Depends on the startup script.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_AppInit(interp)
    Tcl_Interp *interp;		/* Interpreter for application. */
{
    if (Tcl_Init(interp) == TCL_ERROR) {
	return TCL_ERROR;
    }

    /* do Expect first so we can get access to Expect commands when */
    /* Tk_Init does the argument parsing of -c */
    if (Expect_Init(interp) == TCL_ERROR) {
	return TCL_ERROR;
    }
    Tcl_StaticPackage(interp, "Expect", Expect_Init, (Tcl_PackageInitProc *)NULL);

    if (Tk_Init2(interp) == TCL_ERROR) {	/* DEL */
	return TCL_ERROR;
    }
    Tcl_StaticPackage(interp, "Tk", Tk_Init, (Tcl_PackageInitProc *) NULL);

    /*
     * Call the init procedures for included packages.  Each call should
     * look like this:
     *
     * if (Mod_Init(interp) == TCL_ERROR) {
     *     return TCL_ERROR;
     * }
     *
     * where "Mod" is the name of the module.
     */

    /*
     * Call Tcl_CreateCommand for application-specific commands, if
     * they weren't already created by the init procedures called above.
     */

    /*
     * Specify a user-specific startup file to invoke if the application
     * is run interactively.  Typically the startup file is "~/.apprc"
     * where "app" is the name of the application.  If this line is deleted
     * then no user-specific startup file will be run under any conditions.
     */

    Tcl_SetVar(interp, "tcl_rcFileName", "~/.wishrc", TCL_GLOBAL_ONLY);
    return TCL_OK;
}




/*
 * Count of number of main windows currently open in this process.
 */

static int numMainWindows;

/*
 * The variables and table below are used to parse arguments from
 * the "argv" variable in Tk_Init.
 */

static int synchronize;
static char *name;
static char *display;
static char *geometry;
static char *colormap;
static char *visual;
static int rest = 0;

/* for Expect */
int my_rc = 1;
int sys_rc = 1;
static int optcmd_eval();
static int optcmd_diagToStderr();
#ifdef TCL_DEBUGGER
static int optcmd_debug();
#endif
int print_version = 0;

static Tk_ArgvInfo argTable[] = {
    {"-colormap", TK_ARGV_STRING, (char *) NULL, (char *) &colormap,
	"Colormap for main window"},
    {"-display", TK_ARGV_STRING, (char *) NULL, (char *) &display,
	"Display to use"},
    {"-geometry", TK_ARGV_STRING, (char *) NULL, (char *) &geometry,
	"Initial geometry for window"},
    {"-name", TK_ARGV_STRING, (char *) NULL, (char *) &name,
	"Name to use for application"},
    {"-sync", TK_ARGV_CONSTANT, (char *) 1, (char *) &synchronize,
	"Use synchronous mode for display server"},
    {"-visual", TK_ARGV_STRING, (char *) NULL, (char *) &visual,
	"Visual for main window"},
    {"--", TK_ARGV_REST, (char *) 1, (char *) &rest,
	"Pass all remaining arguments through to script"},
/* for Expect */
    {"-command", TK_ARGV_GENFUNC, (char *) optcmd_eval, (char *)0,
	"Command(s) to execute immediately"},
    {"-diag", TK_ARGV_CONSTANT, (char *) optcmd_diagToStderr, (char *)0,
	"Enable diagnostics"},
    {"-norc", TK_ARGV_CONSTANT, (char *) 0, (char *) &my_rc,
	"Don't read ~/.expect.rc"},
    {"-NORC", TK_ARGV_CONSTANT, (char *) 0, (char *) &sys_rc,
	"Don't read system-wide expect.rc"},
    {"-version", TK_ARGV_CONSTANT, (char *) 1, (char *) &print_version,
	"Print version and exit"},
#if TCL_DEBUGGER
    {"-Debug", TK_ARGV_GENFUNC, (char *) optcmd_debug, (char *)0, 
	"Enable debugger"},
#endif
    {(char *) NULL, TK_ARGV_END, (char *) NULL, (char *) NULL,
	(char *) NULL}
};

/*
 *----------------------------------------------------------------------
 *
 * Tk_Init --
 *
 *	This procedure is invoked to add Tk to an interpreter.  It
 *	incorporates all of Tk's commands into the interpreter and
 *	creates the main window for a new Tk application.  If the
 *	interpreter contains a variable "argv", this procedure
 *	extracts several arguments from that variable, uses them
 *	to configure the main window, and modifies argv to exclude
 *	the arguments (see the "wish" documentation for a list of
 *	the arguments that are extracted).
 *
 * Results:
 *	Returns a standard Tcl completion code and sets interp->result
 *	if there is an error.
 *
 * Side effects:
 *	Depends on various initialization scripts that get invoked.
 *
 *----------------------------------------------------------------------
 */

int
Tk_Init2(interp)
    Tcl_Interp *interp;		/* Interpreter to initialize. */
{
    char *p;
    int argc, code;
    char **argv, *args[20];
    Tcl_DString class;
    char buffer[30];

    /*
     * If there is an "argv" variable, get its value, extract out
     * relevant arguments from it, and rewrite the variable without
     * the arguments that we used.
     */

    synchronize = 0;
    name = display = geometry = colormap = visual = NULL; 
    p = Tcl_GetVar2(interp, "argv", (char *) NULL, TCL_GLOBAL_ONLY);
    argv = NULL;
    if (p != NULL) {
	if (Tcl_SplitList(interp, p, &argc, &argv) != TCL_OK) {
	    argError:
	    Tcl_AddErrorInfo(interp,
		    "\n    (processing arguments in argv variable)");
	    return TCL_ERROR;
	}
	if (Tk_ParseArgv(interp, (Tk_Window) NULL, &argc, argv,
		argTable, TK_ARGV_DONT_SKIP_FIRST_ARG|TK_ARGV_NO_DEFAULTS)
		!= TCL_OK) {
	    ckfree((char *) argv);
	    goto argError;
	}

	if (print_version) {
	    extern char exp_version[];
	    printf ("expectk version %s\n", exp_version);
	    Tcl_Exit(0);
	}

	p = Tcl_Merge(argc, argv);
	Tcl_SetVar2(interp, "argv", (char *) NULL, p, TCL_GLOBAL_ONLY);
	sprintf(buffer, "%d", argc);
	Tcl_SetVar2(interp, "argc", (char *) NULL, buffer, TCL_GLOBAL_ONLY);
	ckfree(p);
    }

    /*
     * Figure out the application's name and class.
     */

    if (name == NULL) {
	name = Tcl_GetVar(interp, "argv0", TCL_GLOBAL_ONLY);
	if ((name == NULL) || (*name == 0)) {
	    name = "tk";
	} else {
	    p = (char *)strrchr(name, '/');     /* added cast - DEL */
	    if (p != NULL) {
		name = p+1;
	    }
	}
    }
    Tcl_DStringInit(&class);
    Tcl_DStringAppend(&class, name, -1);
    p = Tcl_DStringValue(&class);
    if (islower(*p)) {
	*p = toupper((unsigned char) *p);
    }

    /*
     * Create an argument list for creating the top-level window,
     * using the information parsed from argv, if any.
     */

    args[0] = "toplevel";
    args[1] = ".";
    args[2] = "-class";
    args[3] = Tcl_DStringValue(&class);
    argc = 4;
    if (display != NULL) {
	args[argc] = "-screen";
	args[argc+1] = display;
	argc += 2;

	/*
	 * If this is the first application for this process, save
	 * the display name in the DISPLAY environment variable so
	 * that it will be available to subprocesses created by us.
	 */

	if (numMainWindows == 0) {
	    Tcl_SetVar2(interp, "env", "DISPLAY", display, TCL_GLOBAL_ONLY);
	}
    }
    if (colormap != NULL) {
	args[argc] = "-colormap";
	args[argc+1] = colormap;
	argc += 2;
    }
    if (visual != NULL) {
	args[argc] = "-visual";
	args[argc+1] = visual;
	argc += 2;
    }
    args[argc] = NULL;
    code = TkCreateFrame((ClientData) NULL, interp, argc, args, 1, name);
    Tcl_DStringFree(&class);
    if (code != TCL_OK) {
	goto done;
    }
    Tcl_ResetResult(interp);
    if (synchronize) {
	XSynchronize(Tk_Display(Tk_MainWindow(interp)), True);
    }

    /*
     * Set the geometry of the main window, if requested.  Put the
     * requested geometry into the "geometry" variable.
     */

    if (geometry != NULL) {
	Tcl_SetVar(interp, "geometry", geometry, TCL_GLOBAL_ONLY);
	code = Tcl_VarEval(interp, "wm geometry . ", geometry, (char *) NULL);
	if (code != TCL_OK) {
	    goto done;
	}
    }
    if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 1) == NULL) {
	code = TCL_ERROR;
	goto done;
    }
    code = Tcl_PkgProvide(interp, "Tk", TK_VERSION);
    if (code != TCL_OK) {
	goto done;
    }

    /*
     * Invoke platform-specific initialization.
     */

    code = TkpInit(interp, 0);

    done:
    if (argv != NULL) {
	ckfree((char *) argv);
    }
    return code;
}

/*ARGSUSED*/
static int
optcmd_eval(dst,interp,key,argc,argv)
char *dst;
Tcl_Interp *interp;
char *key;
int argc;
char **argv;
{
	int i;
	int rc;

	exp_cmdlinecmds = 1;

	rc = Tcl_Eval(interp,argv[0]);
	if (rc == TCL_ERROR) return -1;

	argc--;
	for (i=0;i<argc;i++) {
		argv[i] = argv[i+1];
	}

	return argc;
}

static int
optcmd_diagToStderr(dst,interp,key,argc,argv)
    char *dst;
    Tcl_Interp *interp;
    char *key;
    int argc;
    char **argv;
{
    expDiagToStderrSet(1);
    return --argc;  /* what the heck is the convention here!! */
}

#ifdef TCL_DEBUGGER
/*ARGSUSED*/
static int
optcmd_debug(dst,interp,key,argc,argv)
char *dst;
Tcl_Interp *interp;
char *key;
int argc;
char **argv;
{
	int i;

	if (argc == 0) {
		strcpy(interp->result,"-Debug flag needs 1 or 0 argument");
		return -1;
	}

	if (Tcl_GetInt(interp,argv[0],&i) != TCL_OK) {
		return -1;
	}

	if (i) {
		Dbg_On(interp,0);
	}

	argc--;
	for (i=0;i<argc;i++) {
		argv[i] = argv[i+1];
	}

	return argc;
}
#endif /*TCL_DEBUGGER*/






Deleted exp_noevent.c.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176


















































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

/* interact (with only one process) - give user keyboard control

Written by: Don Libes, NIST, 2/6/90

Design and implementation of this program was paid for by U.S. tax
dollars.  Therefore it is public domain.  However, the author and NIST
would appreciate credit if this program or parts of it are used.
*/

/* This file exists for deficient versions of UNIX that lack select,
poll, or some other multiplexing hook.  Instead, this code uses two
processes per spawned process.  One sends characters from the spawnee
to the spawner; a second send chars the other way.

This will work on any UNIX system.  The only sacrifice is that it
doesn't support multiple processes.  Eventually, it should catch
SIGCHLD on dead processes and do the right thing.  But it is pretty
gruesome to imagine so many processes to do all this.  If you change
it successfully, please mail back the changes to me.  - Don
*/

#include "expect_cf.h"
#include <stdio.h>
#include <sys/types.h>
#include <sys/time.h>

#ifdef HAVE_SYS_WAIT_H
#include <sys/wait.h>
#endif

#include "tcl.h"
#include "exp_prog.h"
#include "exp_command.h"	/* for struct ExpState defs */
#include "exp_event.h"

/*ARGSUSED*/
void
exp_arm_background_filehandler(esPtr)
ExpState *esPtr;
{
}

/*ARGSUSED*/
void
exp_disarm_background_filehandler(esPtr)
ExpState *esPtr;
{
}

/*ARGSUSED*/
void
exp_disarm_background_filehandler_force(esPtr)
ExpState *esPtr;
{
}

/*ARGSUSED*/
void
exp_unblock_background_filehandler(esPtr)
ExpState *esPtr;
{
}

/*ARGSUSED*/
void
exp_block_background_filehandler(esPtr)
ExpState *esPtr;
{
}

/*ARGSUSED*/
void
exp_event_disarm(fd)
int fd;
{
}

/* returns status, one of EOF, TIMEOUT, ERROR or DATA */
/*ARGSUSED*/
int
exp_get_next_event(interp,esPtrs, n,esPtrOut,timeout,key)
Tcl_Interp *interp;
ExpState (*esPtrs)[];
int n;			/* # of esPtrs */
ExpState **esPtrOut;	/* 1st event master, not set if none */
int timeout;		/* seconds */
int key;
{
    if (n > 1) {
	exp_error(interp,"expect not compiled with multiprocess support");
	/* select a different INTERACT_TYPE in Makefile */
	return(TCL_ERROR);
    }

    esPtr = *esPtrOut = esPtrs[0];

    if (esPtr->key != key) {
	esPtr->key = key;
	esPtr->force_read = FALSE;
	return(EXP_DATA_OLD);
    } else if ((!esPtr->force_read) && (esPtr->size != 0)) {
	return(EXP_DATA_OLD);
    }

    return(EXP_DATA_NEW);
}

/*ARGSUSED*/
int
exp_get_next_event_info(interp,esPtr,ready_mask)
Tcl_Interp *interp;
ExpState *esPtr;
int ready_mask;
{
}

/* There is no portable way to do sub-second sleeps on such a system, so */
/* do the next best thing (without a busy loop) and fake it: sleep the right */
/* amount of time over the long run.  Note that while "subtotal" isn't */
/* reinitialized, it really doesn't matter for such a gross hack as random */
/* scheduling pauses will easily introduce occasional one second delays. */
int	/* returns TCL_XXX */
exp_dsleep(interp,sec)
Tcl_Interp *interp;
double sec;
{
	static double subtotal = 0;
	int seconds;

	subtotal += sec;
	if (subtotal < 1) return TCL_OK;
	seconds = subtotal;
	subtotal -= seconds;
 restart:
	if (Tcl_AsyncReady()) {
		int rc = Tcl_AsyncInvoke(interp,TCL_OK);
		if (rc != TCL_OK) return(rc);
	}
	sleep(seconds);
	return TCL_OK;
}

#if 0
/* There is no portable way to do sub-second sleeps on such a system, so */
/* do the next best thing (without a busy loop) and fake it: sleep the right */
/* amount of time over the long run.  Note that while "subtotal" isn't */
/* reinitialized, it really doesn't matter for such a gross hack as random */
/* scheduling pauses will easily introduce occasional one second delays. */
int	/* returns TCL_XXX */
exp_usleep(interp,usec)
Tcl_Interp *interp;
long usec;		/* microseconds */
{
	static subtotal = 0;
	int seconds;

	subtotal += usec;
	if (subtotal < 1000000) return TCL_OK;
	seconds = subtotal/1000000;
	subtotal = subtotal%1000000;
 restart:
	if (Tcl_AsyncReady()) {
		int rc = Tcl_AsyncInvoke(interp,TCL_OK);
		if (rc != TCL_OK) return(exp_tcl2_returnvalue(rc));
	}
	sleep(seconds);
	return TCL_OK;
}
#endif /*0*/

/* set things up for later calls to event handler */
void
exp_init_event()
{
	exp_event_exit = 0;
}






Deleted exp_poll.c.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
















































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

/* exp_poll.c - This file contains UNIX specific procedures for
 * poll-based notifier, which is the lowest-level part of the Tcl
 * event loop.  This file works together with ../generic/tclNotify.c.
 *
 * Design and implementation of this program was paid for by U.S. tax
 * dollars.  Therefore it is public domain.  However, the author and
 * NIST would appreciate credit if this program or parts of it are
 * used.
 *
 * Written by Don Libes, NIST, 2/6/90
 * Rewritten by Don Libes, 2/96 for new Tcl notifier paradigm.
 * Rewritten again by Don Libes, 8/97 for yet another Tcl notifier paradigm.
 */

#include "tclInt.h"
#include "tclPort.h"
#include <signal.h> 

#include <poll.h>
#include <sys/types.h>

#ifdef HAVE_UNISTD_H
#  include <unistd.h>
#endif

/* Some systems require that the poll array be non-empty so provide a
 * 1-elt array for starters.  It will be ignored as soon as it grows
 * larger.
 */

static struct pollfd initialFdArray;
static struct pollfd *fdArray = &initialFdArray;
static int fdsInUse = 0;	/* space in use */
static int fdsMaxSpace = 1;	/* space that has actually been allocated */

/*
 * tclUnixNotify.c --
 *
 *	This file contains the implementation of the select-based
 *	Unix-specific notifier, which is the lowest-level part of the
 *	Tcl event loop.  This file works together with
 *	../generic/tclNotify.c.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tclUnixNotfy.c 1.42 97/07/02 20:55:44
 */

/*
 * This structure is used to keep track of the notifier info for a 
 * a registered file.
 */

typedef struct FileHandler {
    int fd;
    int mask;			/* Mask of desired events: TCL_READABLE,
				 * etc. */
    int readyMask;		/* Mask of events that have been seen since the
				 * last time file handlers were invoked for
				 * this file. */
    Tcl_FileProc *proc;		/* Procedure to call, in the style of
				 * Tcl_CreateFileHandler. */
    ClientData clientData;	/* Argument to pass to proc. */
    int pollArrayIndex;		/* index into poll array */
    struct FileHandler *nextPtr;/* Next in list of all files we care about. */
} FileHandler;

/*
 * The following structure is what is added to the Tcl event queue when
 * file handlers are ready to fire.
 */

typedef struct FileHandlerEvent {
    Tcl_Event header;		/* Information that is standard for
				 * all events. */
    int fd;			/* File descriptor that is ready.  Used
				 * to find the FileHandler structure for
				 * the file (can't point directly to the
				 * FileHandler structure because it could
				 * go away while the event is queued). */
} FileHandlerEvent;

/*
 * The following static structure contains the state information for the
 * select based implementation of the Tcl notifier.
 */

static struct {
    FileHandler *firstFileHandlerPtr;
				/* Pointer to head of file handler list. */
    fd_mask checkMasks[3*MASK_SIZE];
				/* This array is used to build up the masks
				 * to be used in the next call to select.
				 * Bits are set in response to calls to
				 * Tcl_CreateFileHandler. */
    fd_mask readyMasks[3*MASK_SIZE];
				/* This array reflects the readable/writable
				 * conditions that were found to exist by the
				 * last call to select. */
    int numFdBits;		/* Number of valid bits in checkMasks
				 * (one more than highest fd for which
				 * Tcl_WatchFile has been called). */
} notifier;

/*
 * The following static indicates whether this module has been initialized.
 */

static int initialized = 0;

/*
 * Static routines defined in this file.
 */

static void		InitNotifier _ANSI_ARGS_((void));
static void		NotifierExitHandler _ANSI_ARGS_((
			    ClientData clientData));
static int		FileHandlerEventProc _ANSI_ARGS_((Tcl_Event *evPtr,
			    int flags));

/*
 *----------------------------------------------------------------------
 *
 * InitNotifier --
 *
 *	Initializes the notifier state.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Creates a new exit handler.
 *
 *----------------------------------------------------------------------
 */

static void
InitNotifier()
{
    initialized = 1;
    memset(&notifier, 0, sizeof(notifier));
    Tcl_CreateExitHandler(NotifierExitHandler, NULL);
}

/*
 *----------------------------------------------------------------------
 *
 * NotifierExitHandler --
 *
 *	This function is called to cleanup the notifier state before
 *	Tcl is unloaded.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Destroys the notifier window.
 *
 *----------------------------------------------------------------------
 */

static void
NotifierExitHandler(clientData)
    ClientData clientData;		/* Not used. */
{
    initialized = 0;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetTimer --
 *
 *	This procedure sets the current notifier timer value.  This
 *	interface is not implemented in this notifier because we are
 *	always running inside of Tcl_DoOneEvent.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_SetTimer(timePtr)
    Tcl_Time *timePtr;		/* Timeout value, may be NULL. */
{
    /*
     * The interval timer doesn't do anything in this implementation,
     * because the only event loop is via Tcl_DoOneEvent, which passes
     * timeout values to Tcl_WaitForEvent.
     */
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_CreateFileHandler --
 *
 *	This procedure registers a file handler with the Xt notifier.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Creates a new file handler structure and registers one or more
 *	input procedures with Xt.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_CreateFileHandler(fd, mask, proc, clientData)
    int fd;			/* Handle of stream to watch. */
    int mask;			/* OR'ed combination of TCL_READABLE,
				 * TCL_WRITABLE, and TCL_EXCEPTION:
				 * indicates conditions under which
				 * proc should be called. */
    Tcl_FileProc *proc;		/* Procedure to call for each
				 * selected event. */
    ClientData clientData;	/* Arbitrary data to pass to proc. */
{
    FileHandler *filePtr;
    int index, bit;
    int cur_fd_index;
    
    if (!initialized) {
	InitNotifier();
    }

    for (filePtr = notifier.firstFileHandlerPtr; filePtr != NULL;
	    filePtr = filePtr->nextPtr) {
	if (filePtr->fd == fd) {
	    break;
	}
    }
    if (filePtr == NULL) {
	filePtr = (FileHandler*) ckalloc(sizeof(FileHandler)); /* MLK */
	filePtr->fd = fd;
	filePtr->readyMask = 0;
	filePtr->nextPtr = notifier.firstFileHandlerPtr;
	notifier.firstFileHandlerPtr = filePtr;
    }
    filePtr->proc = proc;
    filePtr->clientData = clientData;
    filePtr->pollArrayIndex = fdsInUse;
    cur_fd_index = fdsInUse;

    fdsInUse++;
    if (fdsInUse > fdsMaxSpace) {
	if (fdArray != &initialFdArray) ckfree((char *)fdArray);
	fdArray = (struct pollfd *)ckalloc(fdsInUse*sizeof(struct pollfd));
	fdsMaxSpace = fdsInUse;
    }

    fdArray[cur_fd_index].fd = fd;

    /* I know that POLLIN/OUT is right.  But I have no idea if POLLPRI
     * corresponds well to TCL_EXCEPTION.
     */

    if (mask & TCL_READABLE) {
        fdArray[cur_fd_index].events = POLLIN;
    }
    if (mask & TCL_WRITABLE) {
        fdArray[cur_fd_index].events = POLLOUT;
    }
    if (mask & TCL_EXCEPTION) {
        fdArray[cur_fd_index].events = POLLPRI;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DeleteFileHandler --
 *
 *	Cancel a previously-arranged callback arrangement for
 *	a file.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	If a callback was previously registered on file, remove it.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_DeleteFileHandler(fd)
    int fd;		/* Stream id for which to remove callback procedure. */
{
    FileHandler *filePtr, *prevPtr, *lastPtr;
    int index, bit, mask, i;
    int cur_fd_index;

    if (!initialized) {
	InitNotifier();
    }

    /*
     * Find the entry for the given file (and return if there
     * isn't one).
     */

    for (prevPtr = NULL, filePtr = notifier.firstFileHandlerPtr; ;
	    prevPtr = filePtr, filePtr = filePtr->nextPtr) {
	if (filePtr == NULL) {
	    return;
	}
	if (filePtr->fd == fd) {
	    break;
	}
    }

    /*
     * Clean up information in the callback record.
     */

    if (prevPtr == NULL) {
	notifier.firstFileHandlerPtr = filePtr->nextPtr;
    } else {
	prevPtr->nextPtr = filePtr->nextPtr;
    }

    /* back to poll-specific code - DEL */

    cur_fd_index = filePtr->pollArrayIndex;
    fdsInUse--;

    /* if this one is last, do nothing special */
    /* else swap with one at end of array */

    if (cur_fd_index != fdsInUse) {
	int lastfd_in_array = fdArray[fdsInUse].fd;
	memcpy(&fdArray[cur_fd_index],&fdArray[fdsInUse],sizeof(struct pollfd));

	/* update index to reflect new location in array */
	/* first find link corresponding to last element in array */
	    
	for (lastPtr = notifier.firstFileHandlerPtr; filePtr; lastPtr = lastPtr->nextPtr) {
	    if (lastPtr->fd == lastfd_in_array) {
		lastPtr->pollArrayIndex = cur_fd_index;
		break;
	    }
	}
    }

    fdsInUse--;

    ckfree((char *) filePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * FileHandlerEventProc --
 *
 *	This procedure is called by Tcl_ServiceEvent when a file event
 *	reaches the front of the event queue.  This procedure is
 *	responsible for actually handling the event by invoking the
 *	callback for the file handler.
 *
 * Results:
 *	Returns 1 if the event was handled, meaning it should be removed
 *	from the queue.  Returns 0 if the event was not handled, meaning
 *	it should stay on the queue.  The only time the event isn't
 *	handled is if the TCL_FILE_EVENTS flag bit isn't set.
 *
 * Side effects:
 *	Whatever the file handler's callback procedure does.
 *
 *----------------------------------------------------------------------
 */

static int
FileHandlerEventProc(evPtr, flags)
    Tcl_Event *evPtr;		/* Event to service. */
    int flags;			/* Flags that indicate what events to
				 * handle, such as TCL_FILE_EVENTS. */
{
    FileHandler *filePtr;
    FileHandlerEvent *fileEvPtr = (FileHandlerEvent *) evPtr;
    int mask;

    if (!(flags & TCL_FILE_EVENTS)) {
	return 0;
    }

    /*
     * Search through the file handlers to find the one whose handle matches
     * the event.  We do this rather than keeping a pointer to the file
     * handler directly in the event, so that the handler can be deleted
     * while the event is queued without leaving a dangling pointer.
     */

    for (filePtr = notifier.firstFileHandlerPtr; filePtr != NULL;
	    filePtr = filePtr->nextPtr) {
	if (filePtr->fd != fileEvPtr->fd) {
	    continue;
	}

	/*
	 * The code is tricky for two reasons:
	 * 1. The file handler's desired events could have changed
	 *    since the time when the event was queued, so AND the
	 *    ready mask with the desired mask.
	 * 2. The file could have been closed and re-opened since
	 *    the time when the event was queued.  This is why the
	 *    ready mask is stored in the file handler rather than
	 *    the queued event:  it will be zeroed when a new
	 *    file handler is created for the newly opened file.
	 */

	mask = filePtr->readyMask & filePtr->mask;
	filePtr->readyMask = 0;
	if (mask != 0) {
	    (*filePtr->proc)(filePtr->clientData, mask);
	}
	break;
    }
    return 1;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_WaitForEvent --
 *
 *	This function is called by Tcl_DoOneEvent to wait for new
 *	events on the message queue.  If the block time is 0, then
 *	Tcl_WaitForEvent just polls without blocking.
 *
 * Results:
 *	Returns -1 if the select would block forever, otherwise
 *	returns 0.
 *
 * Side effects:
 *	Queues file events that are detected by the select.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_WaitForEvent(timePtr)
    Tcl_Time *timePtr;		/* Maximum block time, or NULL. */
{
    FileHandler *filePtr;
    FileHandlerEvent *fileEvPtr;
    int timeout;
    struct timeval *timeoutPtr;

    int bit, index, mask, numFound;

    if (!initialized) {
	InitNotifier();
    }

    /*
     * Set up the timeout structure.  Note that if there are no events to
     * check for, we return with a negative result rather than blocking
     * forever.
     */

    if (timePtr) {
        timeout = timePtr->sec*1000 + timePtr->usec/1000;

    } else if (notifier.numFdBits == 0) {
	return -1;
    } else {
	timeoutPtr = NULL;
    }

    numFound = poll(fdArray,fdsInUse,timeout);

    /*
     * Queue all detected file events before returning.
     */

    for (filePtr = notifier.firstFileHandlerPtr;
	    (filePtr != NULL) && (numFound > 0);
	    filePtr = filePtr->nextPtr) {
	index = filePtr->pollArrayIndex;
        mask = 0;

        if (fdArray[index].revents & POLLIN) {
	    mask |= TCL_READABLE;
        }
        if (fdArray[index].revents & POLLOUT) {
	    mask |= TCL_WRITABLE;
        }
        /* I have no idea if this is right ... */
        if (fdArray[index].revents & (POLLPRI|POLLERR|POLLHUP|POLLNVAL)) {
	    mask |= TCL_EXCEPTION;
        }

	if (!mask) {
	    continue;
	} else {
	    numFound--;
	}

	/*
	 * Don't bother to queue an event if the mask was previously
	 * non-zero since an event must still be on the queue.
	 */

	if (filePtr->readyMask == 0) {
	    fileEvPtr = (FileHandlerEvent *) ckalloc(
		sizeof(FileHandlerEvent));
	    fileEvPtr->header.proc = FileHandlerEventProc;
	    fileEvPtr->fd = filePtr->fd;
	    Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
	}
	filePtr->readyMask = mask;
    }
    return 0;
}







Deleted exp_prog.h.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19





















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

/* exp_prog.h - private symbols common to both expect program and library

Written by: Don Libes, [email protected], NIST, 12/3/90

Design and implementation of this program was paid for by U.S. tax
dollars.  Therefore it is public domain.  However, the author and NIST
would appreciate credit if this program or parts of it are used.
*/

#ifndef _EXPECT_PROG_H
#define _EXPECT_PROG_H

#include "expect_tcl.h"
#include "exp_int.h"

/* yes, I have a weak mind */
#define streq(x,y)	(0 == strcmp((x),(y)))

#endif /* _EXPECT_PROG_H */






Deleted exp_pty.c.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368


















































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

/* exp_pty.c - generic routines to allocate and test ptys

Written by: Don Libes, NIST,  3/9/93

Design and implementation of this program was paid for by U.S. tax
dollars.  Therefore it is public domain.  However, the author and NIST
would appreciate credit if this program or parts of it are used.

*/

#include "expect_cf.h"
#ifdef HAVE_UNISTD_H
#  include <unistd.h>
#endif
#ifdef HAVE_SYS_FCNTL_H
#  include <sys/fcntl.h>
#else
#  include <fcntl.h>
#endif
#include <sys/types.h>
#include <sys/stat.h>

#ifdef TIME_WITH_SYS_TIME
# include <sys/time.h>
# include <time.h>
#else
# if HAVE_SYS_TIME_H
#  include <sys/time.h>
# else
#  include <time.h>
# endif
#endif

#include <signal.h>
#include <setjmp.h>
#include <sys/file.h>
#include "tcl.h"
#include "exp_int.h"
#include "expect_comm.h"
#include "exp_rename.h"
#include "exp_pty.h"

#include <errno.h>

#if 0
void expDiagLog();
void expDiagLogU();
void expDiagLogPtrSet();
#endif

#ifndef TRUE
#define TRUE 1
#define FALSE 0
#endif

#ifdef O_NOCTTY
#define RDWR ((O_RDWR)|(O_NOCTTY))
#else
#define RDWR O_RDWR
#endif

static int locked = FALSE;
static char lock[] = "/tmp/ptylock.XXXX";	/* XX is replaced by pty id */
static char locksrc[50] = "/tmp/expect.pid"; /* pid is replaced by real pid */
	/* locksrc is used as the link source, i.e., something to link from */

static int i_read_errno;/* place to save errno, if i_read() == -1, so it
			   doesn't get overwritten before we get to read it */
#ifdef HAVE_SIGLONGJMP
static sigjmp_buf env;                /* for interruptable read() */
#else
static jmp_buf env;		/* for interruptable read() */
#endif  /* HAVE_SIGLONGJMP */

static int env_valid = FALSE;	/* whether we can longjmp or not */

/* sigalarm_handler and i_read are here just for supporting the sanity */
/* checking of pty slave devices.  I have only seen this happen on BSD */
/* systems, but it may need to be done to the other pty implementations */
/* as well. */

/* Note that this code is virtually replicated from other code in expect */
/* At some point, I'll dump one, but not until I'm satisfied no other */
/* changes are needed */

/*ARGSUSED*/
static RETSIGTYPE
sigalarm_handler(n)
int n;		/* unused, for compatibility with STDC */
{
#ifdef REARM_SIG
	signal(SIGALRM,sigalarm_handler);
#endif

	/* check env_valid first to protect us from the alarm occurring */
	/* in the window between i_read and alarm(0) */
#ifdef HAVE_SIGLONGJMP
	if (env_valid) siglongjmp(env,1);
#else
	if (env_valid) longjmp(env,1);
#endif  /* HAVE_SIGLONGJMP */
}

/* interruptable read */
static int
i_read(fd,buffer,length,timeout)
int fd;
char *buffer;
int length;
int timeout;
{
	int cc = -2;

	/* since setjmp insists on returning 1 upon longjmp(,0), */
	/* longjmp(,2) instead. */

	/* restart read if setjmp returns 0 (first time) or 2. */
	/* abort if setjmp returns 1. */

	alarm(timeout);

#ifdef HAVE_SIGLONGJMP
	if (1 != sigsetjmp(env,1)) {
#else
	if (1 != setjmp(env)) {
#endif  /* HAVE_SIGLONGJMP */
		env_valid = TRUE;
		cc = read(fd,buffer,length);
	}
	env_valid = FALSE;
	i_read_errno = errno;	/* errno can be overwritten by the */
				/* time we return */
	alarm(0);
	return(cc);
}

static RETSIGTYPE (*oldAlarmHandler)();
static RETSIGTYPE (*oldHupHandler)();
static time_t current_time;	/* time when testing began */

/* if TRUE, begin testing, else end testing */
/* returns -1 for failure, 0 for success */
int
exp_pty_test_start()
{
	int lfd;	/* locksrc file descriptor */

	oldAlarmHandler = signal(SIGALRM,sigalarm_handler);
#ifndef O_NOCTTY
	/* Ignore hangup signals generated by pty testing */
	/* when running in background with no control tty. */
	/* Very few systems don't define O_NOCTTY.  Only one */
	/* I know of is Next. */
	oldAlarmHandler = signal(SIGHUP,SIG_IGN);
#endif

	time(&current_time);

	/* recreate locksrc to prevent locks from 'looking old', so */
	/* that they are not deleted (later on in this code) */
	sprintf(locksrc,"/tmp/expect.%d",getpid());
	(void) unlink(locksrc);
	/* stanislav shalunov <[email protected]> notes that creat allows */
	/* race - someone could link to important file which root could then */
	/* smash. */
/*	if (-1 == (lfd = creat(locksrc,0777))) { */
       if (-1 == (lfd = open(locksrc,O_RDWR|O_CREAT|O_EXCL,0777))) {
		static char buf[256];
		exp_pty_error = buf;
		sprintf(exp_pty_error,"can't create %s, errno = %d\n",locksrc, errno);
		return(-1);
	}
	close(lfd);
	return 0;
}

void
exp_pty_test_end()
{
	signal(SIGALRM,oldAlarmHandler);
#ifndef O_NOCTTY
	signal(SIGALRM,oldHupHandler);
#endif
	(void) unlink(locksrc);
}

/* returns non-negative if successful */
int
exp_pty_test(master_name,slave_name,bank,num)
char *master_name;
char *slave_name;
char bank;
char *num;	/* string representation of number */
{
	int master, slave;
	int cc;
	char c;

	/* make a lock file to prevent others (for now only */
	/* expects) from allocating pty while we are playing */
	/* with it.  This allows us to rigorously test the */
	/* pty is usable. */
	if (exp_pty_lock(bank,num) == 0) {
		expDiagLogPtrStr("pty master (%s) is locked...skipping\r\n",master_name);
		return(-1);
	}
	/* verify no one else is using slave by attempting */
	/* to read eof from master side */
	if (0 > (master = open(master_name,RDWR))) return(-1);

#ifdef __QNX__

	/* QNX ptys don't have a lot of the same properties such as
           read 0 at EOF, etc */
	/* if 1 should pacify C compiler without using nested ifdefs */
 	if (1) return master;
#endif

#ifdef HAVE_PTYTRAP
	if (access(slave_name, R_OK|W_OK) != 0) {
		expDiagLogPtrStr("could not open slave for pty master (%s)...skipping\r\n",
			master_name);
		(void) close(master);
		return -1;
	}
	return(master);
#else
	if (0 > (slave = open(slave_name,RDWR))) {
		(void) close(master);
		return -1;
	}
	(void) close(slave);
	cc = i_read(master,&c,1,10);
	(void) close(master);
	if (!(cc == 0 || cc == -1)) {
		expDiagLogPtrStr("%s slave open, skipping\r\n",slave_name);
		locked = FALSE;	/* leave lock file around so Expect's avoid */
				/* retrying this pty for near future */
		return -1;
	}

	/* verify no one else is using master by attempting */
	/* to read eof from slave side */
	if (0 > (master = open(master_name,RDWR))) return(-1);
	if (0 > (slave = open(slave_name,RDWR))) {
		(void) close(master);
		return -1;
	}
	(void) close(master);
	cc = i_read(slave,&c,1,10);
	(void) close(slave);
	if (!(cc == 0 || cc == -1)) {
		expDiagLogPtrStr("%s master open, skipping\r\n",master_name);
		return -1;
	}

	/* seems ok, let's use it */
	expDiagLogPtrStr("using master pty %s\n",master_name);
	return(open(master_name,RDWR));
#endif
}

void
exp_pty_unlock()
{
	if (locked) {
		(void) unlink(lock);
		locked = FALSE;
	}
}

/* returns 1 if successfully locked, 0 otherwise */
int
exp_pty_lock(bank,num)
char bank;
char *num;	/* string representation of number */
{
	struct stat statbuf;

	if (locked) {
		unlink(lock);
		locked = FALSE;
	}

	sprintf(lock,"/tmp/ptylock.%c%s",bank,num);

	if ((0 == stat(lock,&statbuf)) &&
	    (statbuf.st_mtime+3600 < current_time)) {
		(void) unlink(lock);
	}

	if (-1 == (link(locksrc,lock))) locked = FALSE;
	else locked = TRUE;

	return locked;
}

/* 
 * expDiagLog needs a different definition, depending on whether its
 * called inside of Expect or the clib.  Allow it to be set using this
 * function.  It's done here because this file (and pty_XXX.c) are the 
 * ones that call expDiagLog from the two different environments.
 */

static void		(*expDiagLogPtrVal) _ANSI_ARGS_((char *));

void
expDiagLogPtrSet(fn)
     void (*fn) _ANSI_ARGS_((char *));
{
  expDiagLogPtrVal = fn;
}

void
expDiagLogPtr(str)
     char *str;
{
  (*expDiagLogPtrVal)(str);
}



void
expDiagLogPtrX(fmt,num)
     char *fmt;
     int num;
{
  static char buf[1000];
  sprintf(buf,fmt,num);
  (*expDiagLogPtrVal)(buf);
}


void
expDiagLogPtrStr(fmt,str1)
     char *fmt;
     char *str1;
{
  static char buf[1000];
  sprintf(buf,fmt,str1);
  (*expDiagLogPtrVal)(buf);
}

void
expDiagLogPtrStrStr(fmt,str1,str2)
     char *fmt;
     char *str1, *str2;
{
  static char buf[1000];
  sprintf(buf,fmt,str1,str2);
  (*expDiagLogPtrVal)(buf);
}

static char *		(*expErrnoMsgVal) _ANSI_ARGS_((int));

char *
expErrnoMsg(errorNo)
int errorNo;
{
  return (*expErrnoMsgVal)(errorNo);
}

void
expErrnoMsgSet(fn)
     char * (*fn) _ANSI_ARGS_((int));
{
  expErrnoMsgVal = fn;
}






Deleted exp_pty.h.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17



















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

/* exp_pty.h - declarations for pty allocation and testing

Written by: Don Libes, NIST,  3/9/93

Design and implementation of this program was paid for by U.S. tax
dollars.  Therefore it is public domain.  However, the author and NIST
would appreciate credit if this program or parts of it are used.

*/

int exp_pty_test_start();
void exp_pty_test_end();
int exp_pty_test();
void exp_pty_unlock();
int exp_pty_lock();

extern char *exp_pty_slave_name;






Deleted exp_regexp.c.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265



















































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

#if 0 /*WHOLE FILE*/

/*
 * regcomp and regexec -- regsub and regerror are elsewhere
 *
 *	Copyright (c) 1986 by University of Toronto.
 *	Written by Henry Spencer.  Not derived from licensed software.
 *
 *	Permission is granted to anyone to use this software for any
 *	purpose on any computer system, and to redistribute it freely,
 *	subject to the following restrictions:
 *
 *	1. The author is not responsible for the consequences of use of
 *		this software, no matter how awful, even if they arise
 *		from defects in it.
 *
 *	2. The origin of this software must not be misrepresented, either
 *		by explicit claim or by omission.
 *
 *	3. Altered versions must be plainly marked as such, and must not
 *		be misrepresented as being the original software.
 *
 * Beware that some of this code is subtly aware of the way operator
 * precedence is structured in regular expressions.  Serious changes in
 * regular-expression syntax might require a total rethink.
 *
 * *** NOTE: this code has been altered slightly for use in Tcl. ***
 * *** The only change is to use ckalloc and ckfree instead of   ***
 * *** malloc and free.						 ***

 * *** and again for Expect!!! - DEL

 * *** More minor corrections stolen from tcl7.5p1/regexp.c - DEL

 */

#include "tcl.h"
#include "expect_cf.h"
#include "exp_prog.h"
#include "tclRegexp.h"
#include "exp_regexp.h"
#include "string.h"

#define NOTSTATIC	/* was at one time, but Expect needs access */

/*
 * The "internal use only" fields in regexp.h are present to pass info from
 * compile to execute that permits the execute phase to run lots faster on
 * simple cases.  They are:
 *
 * regstart	char that must begin a match; '\0' if none obvious
 * reganch	is the match anchored (at beginning-of-line only)?
 * regmust	string (pointer into program) that match must include, or NULL
 * regmlen	length of regmust string
 *
 * Regstart and reganch permit very fast decisions on suitable starting points
 * for a match, cutting down the work a lot.  Regmust permits fast rejection
 * of lines that cannot possibly match.  The regmust tests are costly enough
 * that regcomp() supplies a regmust only if the r.e. contains something
 * potentially expensive (at present, the only such thing detected is * or +
 * at the start of the r.e., which can involve a lot of backup).  Regmlen is
 * supplied because the test in regexec() needs it and regcomp() is computing
 * it anyway.
 */

/*
 * Structure for regexp "program".  This is essentially a linear encoding
 * of a nondeterministic finite-state machine (aka syntax charts or
 * "railroad normal form" in parsing technology).  Each node is an opcode
 * plus a "next" pointer, possibly plus an operand.  "Next" pointers of
 * all nodes except BRANCH implement concatenation; a "next" pointer with
 * a BRANCH on both ends of it is connecting two alternatives.  (Here we
 * have one of the subtle syntax dependencies:  an individual BRANCH (as
 * opposed to a collection of them) is never concatenated with anything
 * because of operator precedence.)  The operand of some types of node is
 * a literal string; for others, it is a node leading into a sub-FSM.  In
 * particular, the operand of a BRANCH node is the first node of the branch.
 * (NB this is *not* a tree structure:  the tail of the branch connects
 * to the thing following the set of BRANCHes.)  The opcodes are:
 */

/* definition	number	opnd?	meaning */
#define	END	0	/* no	End of program. */
#define	BOL	1	/* no	Match "" at beginning of line. */
#define	EOL	2	/* no	Match "" at end of line. */
#define	ANY	3	/* no	Match any one character. */
#define	ANYOF	4	/* str	Match any character in this string. */
#define	ANYBUT	5	/* str	Match any character not in this string. */
#define	BRANCH	6	/* node	Match this alternative, or the next... */
#define	BACK	7	/* no	Match "", "next" ptr points backward. */
#define	EXACTLY	8	/* str	Match this string. */
#define	NOTHING	9	/* no	Match empty string. */
#define	STAR	10	/* node	Match this (simple) thing 0 or more times. */
#define	PLUS	11	/* node	Match this (simple) thing 1 or more times. */
#define	OPEN	20	/* no	Mark this point in input as start of #n. */
			/*	OPEN+1 is number 1, etc. */
#define	CLOSE	(OPEN+NSUBEXP)	/* no	Analogous to OPEN. */

/*
 * Opcode notes:
 *
 * BRANCH	The set of branches constituting a single choice are hooked
 *		together with their "next" pointers, since precedence prevents
 *		anything being concatenated to any individual branch.  The
 *		"next" pointer of the last BRANCH in a choice points to the
 *		thing following the whole choice.  This is also where the
 *		final "next" pointer of each individual branch points; each
 *		branch starts with the operand node of a BRANCH node.
 *
 * BACK		Normal "next" pointers all implicitly point forward; BACK
 *		exists to make loop structures possible.
 *
 * STAR,PLUS	'?', and complex '*' and '+', are implemented as circular
 *		BRANCH structures using BACK.  Simple cases (one character
 *		per match) are implemented with STAR and PLUS for speed
 *		and to minimize recursive plunges.
 *
 * OPEN,CLOSE	...are numbered at compile time.
 */

/*
 * A node is one char of opcode followed by two chars of "next" pointer.
 * "Next" pointers are stored as two 8-bit pieces, high order first.  The
 * value is a positive offset from the opcode of the node containing it.
 * An operand, if any, simply follows the node.  (Note that much of the
 * code generation knows about this implicit relationship.)
 *
 * Using two bytes for the "next" pointer is vast overkill for most things,
 * but allows patterns to get big without disasters.
 */
#define	OP(p)	(*(p))
#define	NEXT(p)	(((*((p)+1)&0377)<<8) + (*((p)+2)&0377))
#define	OPERAND(p)	((p) + 3)

/*
 * See regmagic.h for one further detail of program structure.
 */


/*
 * Utility definitions.
 */
#ifndef CHARBITS
#define	UCHARAT(p)	((int)*(unsigned char *)(p))
#else
#define	UCHARAT(p)	((int)*(p)&CHARBITS)
#endif

#define	FAIL(m)	{ regerror(m); return(NULL); }
#define	ISMULT(c)	((c) == '*' || (c) == '+' || (c) == '?')
#define	META	"^$.[()|?+*\\"

/*
 * Flags to be passed up and down.
 */
#define	HASWIDTH	01	/* Known never to match null string. */
#define	SIMPLE		02	/* Simple enough to be STAR/PLUS operand. */
#define	SPSTART		04	/* Starts with * or +. */
#define	WORST		0	/* Worst case. */

/*
 * Global work variables for regcomp().
 */
static char *regparse;		/* Input-scan pointer. */
static int regnpar;		/* () count. */
static char regdummy;
static char *regcode;		/* Code-emit pointer; &regdummy = don't. */
static long regsize;		/* Code size. */

/*
 * The first byte of the regexp internal "program" is actually this magic
 * number; the start node begins in the second byte.
 */
#define	MAGIC	0234


/*
 * Forward declarations for regcomp()'s friends.
 */
#ifndef STATIC
#define	STATIC	static
#endif
STATIC char *reg();
STATIC char *regbranch();
STATIC char *regpiece();
STATIC char *regatom();
STATIC char *regnode();
STATIC char *regnext();
STATIC void regc();
STATIC void reginsert();
STATIC void regtail();
STATIC void regoptail();
#ifdef STRCSPN
STATIC int strcspn();
#endif

/* regcomp originally appeared here - DEL */

/*
 - reg - regular expression, i.e. main body or parenthesized thing
 *
 * Caller must absorb opening parenthesis.
 *
 * Combining parenthesis handling with the base level of regular expression
 * is a trifle forced, but the need to tie the tails of the branches to what
 * follows makes it hard to avoid.
 */
static char *
reg(paren, flagp)
int paren;			/* Parenthesized? */
int *flagp;
{
	register char *ret;
	register char *br;
	register char *ender;
	register int parno = 0;
	int flags;

	*flagp = HASWIDTH;	/* Tentatively. */

	/* Make an OPEN node, if parenthesized. */
	if (paren) {
		if (regnpar >= NSUBEXP)
			FAIL("too many ()");
		parno = regnpar;
		regnpar++;
		ret = regnode(OPEN+parno);
	} else
		ret = NULL;

	/* Pick up the branches, linking them together. */
	br = regbranch(&flags);
	if (br == NULL)
		return(NULL);
	if (ret != NULL)
		regtail(ret, br);	/* OPEN -> first. */
	else
		ret = br;
	if (!(flags&HASWIDTH))
		*flagp &= ~HASWIDTH;
	*flagp |= flags&SPSTART;
	while (*regparse == '|') {
		regparse++;
		br = regbranch(&flags);
		if (br == NULL)
			return(NULL);
		regtail(ret, br);	/* BRANCH -> BRANCH. */
		if (!(flags&HASWIDTH))
			*flagp &= ~HASWIDTH;
		*flagp |= flags&SPSTART;
	}

	/* Make a closing node, and hook it on the end. */
	ender = regnode((paren) ? CLOSE+parno : END);	
	regtail(ret, ender);

	/* Hook the tails of the branches to the closing node. */
	for (br = ret; br != NULL; br = regnext(br))
		regoptail(br, ender);

	/* Check for proper termination. */
	if (paren && *regparse++ != ')') {
		FAIL("unmatched ()");
	} else if (!paren && *regparse != '\0') {
		if (*regparse == ')') {
			FAIL("unmatched ()");
		} else
			FAIL("junk on end");	/* "Can't happen". */
		/* NOTREACHED */
	}

	return(ret);
}

/*
 - regbranch - one alternative of an | operator
 *
 * Implements the concatenation operator.
 */
static char *
regbranch(flagp)
int *flagp;
{
	register char *ret;
	register char *chain;
	register char *latest;
	int flags;

	*flagp = WORST;		/* Tentatively. */

	ret = regnode(BRANCH);
	chain = NULL;
	while (*regparse != '\0' && *regparse != '|' && *regparse != ')') {
		latest = regpiece(&flags);
		if (latest == NULL)
			return(NULL);
		*flagp |= flags&HASWIDTH;
		if (chain == NULL)	/* First piece. */
			*flagp |= flags&SPSTART;
		else
			regtail(chain, latest);
		chain = latest;
	}
	if (chain == NULL)	/* Loop ran zero times. */
		(void) regnode(NOTHING);

	return(ret);
}

/*
 - regpiece - something followed by possible [*+?]
 *
 * Note that the branching code sequences used for ? and the general cases
 * of * and + are somewhat optimized:  they use the same NOTHING node as
 * both the endmarker for their branch list and the body of the last branch.
 * It might seem that this node could be dispensed with entirely, but the
 * endmarker role is not redundant.
 */
static char *
regpiece(flagp)
int *flagp;
{
	register char *ret;
	register char op;
	register char *next;
	int flags;

	ret = regatom(&flags);
	if (ret == NULL)
		return(NULL);

	op = *regparse;
	if (!ISMULT(op)) {
		*flagp = flags;
		return(ret);
	}

	if (!(flags&HASWIDTH) && op != '?')
		FAIL("*+ operand could be empty");
	*flagp = (op != '+') ? (WORST|SPSTART) : (WORST|HASWIDTH);

	if (op == '*' && (flags&SIMPLE))
		reginsert(STAR, ret);
	else if (op == '*') {
		/* Emit x* as (x&|), where & means "self". */
		reginsert(BRANCH, ret);			/* Either x */
		regoptail(ret, regnode(BACK));		/* and loop */
		regoptail(ret, ret);			/* back */
		regtail(ret, regnode(BRANCH));		/* or */
		regtail(ret, regnode(NOTHING));		/* null. */
	} else if (op == '+' && (flags&SIMPLE))
		reginsert(PLUS, ret);
	else if (op == '+') {
		/* Emit x+ as x(&|), where & means "self". */
		next = regnode(BRANCH);			/* Either */
		regtail(ret, next);
		regtail(regnode(BACK), ret);		/* loop back */
		regtail(next, regnode(BRANCH));		/* or */
		regtail(ret, regnode(NOTHING));		/* null. */
	} else if (op == '?') {
		/* Emit x? as (x|) */
		reginsert(BRANCH, ret);			/* Either x */
		regtail(ret, regnode(BRANCH));		/* or */
		next = regnode(NOTHING);		/* null. */
		regtail(ret, next);
		regoptail(ret, next);
	}
	regparse++;
	if (ISMULT(*regparse))
		FAIL("nested *?+");

	return(ret);
}

/*
 - regatom - the lowest level
 *
 * Optimization:  gobbles an entire sequence of ordinary characters so that
 * it can turn them into a single node, which is smaller to store and
 * faster to run.  Backslashed characters are exceptions, each becoming a
 * separate node; the code is simpler that way and it's not worth fixing.
 */
static char *
regatom(flagp)
int *flagp;
{
	register char *ret;
	int flags;

	*flagp = WORST;		/* Tentatively. */

	switch (*regparse++) {
	case '^':
		ret = regnode(BOL);
		break;
	case '$':
		ret = regnode(EOL);
		break;
	case '.':
		ret = regnode(ANY);
		*flagp |= HASWIDTH|SIMPLE;
		break;
	case '[': {
			register int clss;
			register int classend;

			if (*regparse == '^') {	/* Complement of range. */
				ret = regnode(ANYBUT);
				regparse++;
			} else
				ret = regnode(ANYOF);
			if (*regparse == ']' || *regparse == '-')
				regc(*regparse++);
			while (*regparse != '\0' && *regparse != ']') {
				if (*regparse == '-') {
					regparse++;
					if (*regparse == ']' || *regparse == '\0')
						regc('-');
					else {
						clss = UCHARAT(regparse-2)+1;
						classend = UCHARAT(regparse);
						if (clss > classend+1)
							FAIL("invalid [] range");
						for (; clss <= classend; clss++)
							regc((char)clss);
						regparse++;
					}
				} else
					regc(*regparse++);
			}
			regc('\0');
			if (*regparse != ']')
				FAIL("unmatched []");
			regparse++;
			*flagp |= HASWIDTH|SIMPLE;
		}
		break;
	case '(':
		ret = reg(1, &flags);
		if (ret == NULL)
			return(NULL);
		*flagp |= flags&(HASWIDTH|SPSTART);
		break;
	case '\0':
	case '|':
	case ')':
		FAIL("internal urp");	/* Supposed to be caught earlier. */
		/* NOTREACHED */
		break;
	case '?':
	case '+':
	case '*':
		FAIL("?+* follows nothing");
		/* NOTREACHED */
		break;
	case '\\':
		if (*regparse == '\0')
			FAIL("trailing \\");
		ret = regnode(EXACTLY);
		regc(*regparse++);
		regc('\0');
		*flagp |= HASWIDTH|SIMPLE;
		break;
	default: {
			register int len;
			register char ender;

			regparse--;
			len = strcspn(regparse, META);
			if (len <= 0)
				FAIL("internal disaster");
			ender = *(regparse+len);
			if (len > 1 && ISMULT(ender))
				len--;		/* Back off clear of ?+* operand. */
			*flagp |= HASWIDTH;
			if (len == 1)
				*flagp |= SIMPLE;
			ret = regnode(EXACTLY);
			while (len > 0) {
				regc(*regparse++);
				len--;
			}
			regc('\0');
		}
		break;
	}

	return(ret);
}

/*
 - regnode - emit a node
 */
static char *			/* Location. */
regnode(op)
int op;
{
	register char *ret;
	register char *ptr;

	ret = regcode;
	if (ret == &regdummy) {
		regsize += 3;
		return(ret);
	}

	ptr = ret;
	*ptr++ = (char)op;
	*ptr++ = '\0';		/* Null "next" pointer. */
	*ptr++ = '\0';
	regcode = ptr;

	return(ret);
}

/*
 - regc - emit (if appropriate) a byte of code
 */
static void
regc(b)
int b;
{
	if (regcode != &regdummy)
		*regcode++ = (char)b;
	else
		regsize++;
}

/*
 - reginsert - insert an operator in front of already-emitted operand
 *
 * Means relocating the operand.
 */
static void
reginsert(op, opnd)
int op;
char *opnd;
{
	register char *src;
	register char *dst;
	register char *place;

	if (regcode == &regdummy) {
		regsize += 3;
		return;
	}

	src = regcode;
	regcode += 3;
	dst = regcode;
	while (src > opnd)
		*--dst = *--src;

	place = opnd;		/* Op node, where operand used to be. */
	*place++ = (char)op;
	*place++ = '\0';
	*place = '\0';
}

/*
 - regtail - set the next-pointer at the end of a node chain
 */
static void
regtail(p, val)
char *p;
char *val;
{
	register char *scan;
	register char *temp;
	register int offset;

	if (p == &regdummy)
		return;

	/* Find last node. */
	scan = p;
	for (;;) {
		temp = regnext(scan);
		if (temp == NULL)
			break;
		scan = temp;
	}

	if (OP(scan) == BACK)
		offset = scan - val;
	else
		offset = val - scan;
	*(scan+1) = (char)(offset>>8)&0377;
	*(scan+2) = (char)offset&0377;
}

/*
 - regoptail - regtail on operand of first argument; nop if operandless
 */
static void
regoptail(p, val)
char *p;
char *val;
{
	/* "Operandless" and "op != BRANCH" are synonymous in practice. */
	if (p == NULL || p == &regdummy || OP(p) != BRANCH)
		return;
	regtail(OPERAND(p), val);
}

/*
 * regexec and friends
 */

/*
 * Global work variables for regexec().
 */
static char *reginput;		/* String-input pointer. */
NOTSTATIC char *regbol;		/* Beginning of input, for ^ check. */
static char **regstartp;	/* Pointer to startp array. */
static char **regendp;		/* Ditto for endp. */

/*
 * Forwards.
 */

NOTSTATIC int regtry();
STATIC int regmatch();
STATIC int regrepeat();

#ifdef DEBUG
int regnarrate = 0;
void regdump();
STATIC char *regprop();
#endif

#if 0
/*
 - regexec - match a regexp against a string
 */
int
regexec(prog, string, stringlength, matchlength)
register regexp *prog;
register char *string;	/* note: CURRENTLY ASSUMED TO BE NULL-TERMINATED!!! */
int stringlength;	/* length of string */
int *matchlength;	/* number of chars matched (or to be skipped) */
			/* set when MATCH or CANT_MATCH */
{
	register char *s;
	extern char *strchr();

	/* Be paranoid... */
	if (prog == NULL || string == NULL) {
		regerror("NULL parameter");
		return(EXP_TCLERROR);
	}

	/* Check validity of program. */
	if (UCHARAT(prog->program) != MAGIC) {
		regerror("corrupted program");
		return(EXP_KM_ERROR);
	}

#if THIS_RUINS_EXP
/* no need for this shortcut anyway */
	/* If there is a "must appear" string, look for it. */
	if (prog->regmust != NULL) {
		s = string;
		while ((s = strchr(s, prog->regmust[0])) != NULL) {
			if (strncmp(s, prog->regmust, prog->regmlen) == 0)
				break;	/* Found it. */
			s++;
		}
		if (s == NULL)	/* Not present. */
			return(0);
	}
#endif

	/* Mark beginning of line for ^ . */
	regbol = string;

	/* Simplest case:  anchored match need be tried only once. */
	if (prog->reganch) {
		int r = regtry(prog,string,matchlength);
		if (r == CANT_MATCH) *matchlength = stringlength;
		return(r);
	}

	/* Messy cases:  unanchored match. */
	s = string;
	if (prog->regstart != '\0') {
		register char *s2 = s;

		/* We know what char it must start with. */
		while (1) {
			int r;

			s2 = strchr(s2,prog->regstart);
			if (s2 == 0) {
				*matchlength = stringlength;
				return(CANT_MATCH);
			}
			r = regtry(prog,s2,matchlength);
			if (r == CANT_MATCH) {
				s2++;
				continue;
			}
			if (s2 == s) return(r);
			*matchlength = s2-s;
			return CANT_MATCH;
		}
	} else {
		/* We don't -- general case. */
		register char *s2 = s;
		int r = regtry(prog,s,matchlength);
		if (r == EXP_MATCH) return(r);
		else if (r == EXP_CANMATCH) return(r);
		/* at this point, we know some characters at front */
		/* of string don't match */
		for (s2++;*s2;s2++) {
			r = regtry(prog,s2,matchlength);
			if (r == CANT_MATCH) continue;
			/* if we match or can_match, say cant_match and */
			/* record the number of chars at front that don't match */
			*matchlength = s2-s;
			return(CANT_MATCH);
		}
		/* made it thru string with CANT_MATCH all the way */
		*matchlength = stringlength;
		return(CANT_MATCH);
	}
}
#endif

/*
 - regtry - try match at specific point
 */
/* return CAN_MATCH, CANT_MATCH or MATCH */
int			/* 0 failure, 1 success */
regtry(prog, string, matchlength)
regexp *prog;
char *string;
int *matchlength;	/* only set for MATCH */
{
	register int i;
	register char **sp;
	register char **ep;
	int r;		/* result of regmatch */

	reginput = string;
	regstartp = prog->startp;
	regendp = prog->endp;

	sp = prog->startp;
	ep = prog->endp;
	for (i = NSUBEXP; i > 0; i--) {
		*sp++ = NULL;
		*ep++ = NULL;
	}
	r = regmatch(prog->program + 1);
	if (EXP_MATCH == r) {
		prog->startp[0] = string;
		prog->endp[0] = reginput;
		*matchlength = reginput-string;
		return(EXP_MATCH);
	}
	return(r);	/* CAN_MATCH or CANT_MATCH */
}

/*
 - regmatch - main matching routine
 *
 * Conceptually the strategy is simple:  check to see whether the current
 * node matches, call self recursively to see whether the rest matches,
 * and then act accordingly.  In practice we make some effort to avoid
 * recursion, in particular by going through "ordinary" nodes (that don't
 * need to know whether the rest of the match failed) by a loop instead of
 * by recursion.
 */
/* returns CAN, CANT or MATCH */
static int			/* 0 failure, 1 success */
regmatch(prog)
char *prog;
{
	register char *scan;	/* Current node. */
	char *next;		/* Next node. */
#ifndef strchr	/* May be #defined to something else */
	extern char *strchr();
#endif

	scan = prog;
#ifdef DEBUG
	if (scan != NULL && regnarrate)
		fprintf(stderr, "%s(\n", regprop(scan));
#endif
	while (scan != NULL) {
#ifdef DEBUG
		if (regnarrate)
			fprintf(stderr, "%s...\n", regprop(scan));
#endif
		next = regnext(scan);

		switch (OP(scan)) {
		case BOL:
			if (reginput != regbol)
/*				return(0);*/
				return(EXP_CANTMATCH);
			break;
		case EOL:
			if (*reginput != '\0')
/*				return(0);*/
/* note this implies that "$" must match everything received to this point! */
				return(EXP_CANTMATCH);
			break;
		case ANY:
			if (*reginput == '\0')
/*				return(0);*/
				return(EXP_CANMATCH);
			reginput++;
			break;
		case EXACTLY: {
/*				register int len;*/
				register char *opnd;

				opnd = OPERAND(scan);

				/* this section of code is totally rewritten - DEL */
				/* group of literal chars in pattern */
				/* compare each one */
				do {
					if (*opnd != *reginput) {
						if (*reginput == '\0') {
							return EXP_CANMATCH;
						} else 	return EXP_CANTMATCH;
					}

					reginput++;
					opnd++;
				} while (*opnd != '\0');
			}
			break;
		case ANYOF:
/* 			if (*reginput == '\0' || strchr(OPERAND(scan), *reginput) == NULL)
				return(0);
*/
			if (*reginput == '\0')
				return(EXP_CANMATCH);
			if (strchr(OPERAND(scan),*reginput) == NULL)
				return(EXP_CANTMATCH);
			reginput++;
			break;
		case ANYBUT:
/* 			if (*reginput == '\0' || strchr(OPERAND(scan), *reginput) != NULL)
				return(0);
*/
			if (*reginput == '\0')
				return(EXP_CANMATCH);
			if (strchr(OPERAND(scan),*reginput) != NULL)
				return(EXP_CANTMATCH);
			reginput++;
			break;
		case NOTHING:
			break;
		case BACK:
			break;
		case OPEN+1:
		case OPEN+2:
		case OPEN+3:
		case OPEN+4:
		case OPEN+5:
		case OPEN+6:
		case OPEN+7:
		case OPEN+8:
		case OPEN+9: {
				register int no;
				register char *save;
				int r;	/* result of regmatch */

	doOpen:
				no = OP(scan) - OPEN;
				save = reginput;

				r = regmatch(next);
				if (r == EXP_MATCH) {
					/*
					 * Don't set startp if some later
					 * invocation of the same parentheses
					 * already has.
					 */
					if (regstartp[no] == NULL)
						regstartp[no] = save;
				}
				return(r);
			}
			/* NOTREACHED */
			break;
		case CLOSE+1:
		case CLOSE+2:
		case CLOSE+3:
		case CLOSE+4:
		case CLOSE+5:
		case CLOSE+6:
		case CLOSE+7:
		case CLOSE+8:
		case CLOSE+9: {
				register int no;
				register char *save;
				int r;	/* result of regmatch */

	doClose:
				no = OP(scan) - CLOSE;
				save = reginput;

				r = regmatch(next);
				if (r == EXP_MATCH) {
					/*
					 * Don't set endp if some later
					 * invocation of the same parentheses
					 * already has.
					 */
					if (regendp[no] == NULL)
						regendp[no] = save;
				}
				return(r);
			}
			/* NOTREACHED */
			break;
		case BRANCH: {
				register char *save;
				int match_status;

				if (OP(next) != BRANCH)		/* No choice. */
					next = OPERAND(scan);	/* Avoid recursion. */
				else {
					match_status = EXP_CANTMATCH;

					do {
						int r;

						save = reginput;
						r = regmatch(OPERAND(scan));
						if (r == EXP_MATCH) return(r);
						if (r == EXP_CANMATCH) {
							match_status = r;
						}
						reginput = save;
						scan = regnext(scan);
					} while (scan != NULL && OP(scan) == BRANCH);
					return(match_status);
					/* NOTREACHED */
				}
			}
			/* NOTREACHED */
			break;
		case STAR:
		case PLUS: {
				register char nextch;
				register int no;
				register char *save;
				register int min;
				int match_status;

				if (*reginput == '\0') return EXP_CANMATCH;

				/*
				 * Lookahead to avoid useless match attempts
				 * when we know what character comes next.
				 */
				match_status = EXP_CANTMATCH;
				nextch = '\0';
				if (OP(next) == EXACTLY)
					nextch = *OPERAND(next);
				min = (OP(scan) == STAR) ? 0 : 1;
				save = reginput;
				no = regrepeat(OPERAND(scan));
				while (no >= min) {
					/* If it could work, try it. */
					/* 3rd condition allows for CAN_MATCH */
					if (nextch == '\0' || *reginput == nextch || *reginput == '\0') {
						int r = regmatch(next);
						if (r == EXP_MATCH)
							return(EXP_MATCH);
						if (r == EXP_CANMATCH)
/*							match_status = r;*/
							return(EXP_CANMATCH);
					}
					/* Couldn't or didn't -- back up. */
					no--;
					reginput = save + no;
				}
				return(match_status);
			}
			/* NOTREACHED */
			break;
		case END:
			/* Success! */
			if (*reginput == '\0') {
				return(EXP_CANMATCH);
			} else {
				return(EXP_MATCH);
			}
			/* return(EXP_CANMATCH);  Success! */
			/* NOTREACHED */
			break;
		default:
			if (OP(scan) > OPEN && OP(scan) < OPEN+NSUBEXP) {
				goto doOpen;
			} else if (OP(scan) > CLOSE && OP(scan) < CLOSE+NSUBEXP) {
				goto doClose;
			}
			regerror("memory corruption");
			return(EXP_TCLERROR);
			/* NOTREACHED */
			break;
		}

		scan = next;
	}

	/*
	 * We get here only if there's trouble -- normally "case END" is
	 * the terminating point.
	 */
	regerror("corrupted pointers");
	return(EXP_TCLERROR);
}

/*
 - regrepeat - repeatedly match something simple, report how many
 */
static int
regrepeat(p)
char *p;
{
	register int count = 0;
	register char *scan;
	register char *opnd;
#ifndef strchr	/* May be #defined to something else */
/*DEL*/	extern char *strchr();
#endif

	scan = reginput;
	opnd = OPERAND(p);
	switch (OP(p)) {
	case ANY:
		count = strlen(scan);
		scan += count;
		break;
	case EXACTLY:
		while (*opnd == *scan) {
			count++;
			scan++;
		}
		break;
	case ANYOF:
		while (*scan != '\0' && strchr(opnd, *scan) != NULL) {
			count++;
			scan++;
		}
		break;
	case ANYBUT:
		while (*scan != '\0' && strchr(opnd, *scan) == NULL) {
			count++;
			scan++;
		}
		break;
	default:		/* Oh dear.  Called inappropriately. */
		regerror("internal foulup");
		count = 0;	/* Best compromise. */
		break;
	}
	reginput = scan;

	return(count);
}

/*
 - regnext - dig the "next" pointer out of a node
 */
static char *
regnext(p)
register char *p;
{
	register int offset;

	if (p == &regdummy)
		return(NULL);

	offset = NEXT(p);
	if (offset == 0)
		return(NULL);

	if (OP(p) == BACK)
		return(p-offset);
	else
		return(p+offset);
}

#ifdef DEBUG

STATIC char *regprop();

/*
 - regdump - dump a regexp onto stdout in vaguely comprehensible form
 */
void
regdump(r)
regexp *r;
{
	register char *s;
	register char op = EXACTLY;	/* Arbitrary non-END op. */
	register char *next;
	extern char *strchr();


	s = r->program + 1;
	while (op != END) {	/* While that wasn't END last time... */
		op = OP(s);
		printf("%2d%s", s-r->program, regprop(s));	/* Where, what. */
		next = regnext(s);
		if (next == NULL)		/* Next ptr. */
			printf("(0)");
		else 
			printf("(%d)", (s-r->program)+(next-s));
		s += 3;
		if (op == ANYOF || op == ANYBUT || op == EXACTLY) {
			/* Literal string, where present. */
			while (*s != '\0') {
				putchar(*s);
				s++;
			}
			s++;
		}
		putchar('\n');
	}

	/* Header fields of interest. */
	if (r->regstart != '\0')
		printf("start `%c' ", r->regstart);
	if (r->reganch)
		printf("anchored ");
	if (r->regmust != NULL)
		printf("must have \"%s\"", r->regmust);
	printf("\n");
}

/*
 - regprop - printable representation of opcode
 */
static char *
regprop(op)
char *op;
{
	register char *p;
	static char buf[50];

	(void) strcpy(buf, ":");

	switch (OP(op)) {
	case BOL:
		p = "BOL";
		break;
	case EOL:
		p = "EOL";
		break;
	case ANY:
		p = "ANY";
		break;
	case ANYOF:
		p = "ANYOF";
		break;
	case ANYBUT:
		p = "ANYBUT";
		break;
	case BRANCH:
		p = "BRANCH";
		break;
	case EXACTLY:
		p = "EXACTLY";
		break;
	case NOTHING:
		p = "NOTHING";
		break;
	case BACK:
		p = "BACK";
		break;
	case END:
		p = "END";
		break;
	case OPEN+1:
	case OPEN+2:
	case OPEN+3:
	case OPEN+4:
	case OPEN+5:
	case OPEN+6:
	case OPEN+7:
	case OPEN+8:
	case OPEN+9:
		sprintf(buf+strlen(buf), "OPEN%d", OP(op)-OPEN);
		p = NULL;
		break;
	case CLOSE+1:
	case CLOSE+2:
	case CLOSE+3:
	case CLOSE+4:
	case CLOSE+5:
	case CLOSE+6:
	case CLOSE+7:
	case CLOSE+8:
	case CLOSE+9:
		sprintf(buf+strlen(buf), "CLOSE%d", OP(op)-CLOSE);
		p = NULL;
		break;
	case STAR:
		p = "STAR";
		break;
	case PLUS:
		p = "PLUS";
		break;
	default:
		if (OP(op) > OPEN && OP(op) < OPEN+NSUBEXP) {
		    sprintf(buf+strlen(buf), "OPEN%d", OP(op)-OPEN);
		    p = NULL;
		    break;
		} else if (OP(op) > CLOSE && OP(op) < CLOSE+NSUBEXP) {
		    sprintf(buf+strlen(buf), "CLOSE%d", OP(op)-CLOSE);
		    p = NULL;
		} else {
		    TclRegError("corrupted opcode");
		}
		break;
	}
	if (p != NULL)
		(void) strcat(buf, p);
	return(buf);
}
#endif

/*
 * The following is provided for those people who do not have strcspn() in
 * their C libraries.  They should get off their butts and do something
 * about it; at least one public-domain implementation of those (highly
 * useful) string routines has been published on Usenet.
 */
#ifdef STRCSPN
/*
 * strcspn - find length of initial segment of s1 consisting entirely
 * of characters not from s2
 */

static int
strcspn(s1, s2)
char *s1;
char *s2;
{
	register char *scan1;
	register char *scan2;
	register int count;

	count = 0;
	for (scan1 = s1; *scan1 != '\0'; scan1++) {
		for (scan2 = s2; *scan2 != '\0';)	/* ++ moved down. */
			if (*scan1 == *scan2++)
				return(count);
		count++;
	}
	return(count);
}
#endif
#endif /* 0 WHOLE FILE */






Deleted exp_regexp.h.





1
2
3
4
5
6
7
8
9
10












-
-
-
-
-
-
-
-
-
-

#if 0 /* WHOLE FILE */
/* access to regexp internals */
#define regbol		exp_regbol
#define regtry		exp_regtry
#define regexec		exp_regexec
#define regerror	TclRegError
extern char *regbol;
int regtry();

#endif /*0 WHOLE FILE */






Deleted exp_rename.h.





1
2
3
4
5
6
7
8
9
10
11













-
-
-
-
-
-
-
-
-
-
-

/* exp_rename.h - preface globals that appear in the expect library with "exp_"
so we don't conflict with the user.  This saves me having to use exp_XXX
throughout the expect program itself, which was written well before the library
when I didn't have to worry about name conflicts.

Written by: Don Libes, NIST, 12/3/90

Design and implementation of this program was paid for by U.S. tax
dollars.  Therefore it is public domain.  However, the author and NIST
would appreciate credit if this program or parts of it are used.  */







Deleted exp_simple.c.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465



















































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

/* 
 * tclUnixNotify.c --
 *
 *	This file contains Unix-specific procedures for the notifier,
 *	which is the lowest-level part of the Tcl event loop.  This file
 *	works together with ../generic/tclNotify.c.
 *
 * Copyright (c) 1995 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

static char sccsid[] = "@(#) tclUnixNotify.c 1.27 96/01/19 10:30:23";

#include "tclInt.h"
#include "tclPort.h"
#include <signal.h> 

/*
 * The information below is used to provide read, write, and
 * exception masks to select during calls to Tcl_DoOneEvent.
 */

static fd_mask checkMasks[3*MASK_SIZE];
				/* This array is used to build up the masks
				 * to be used in the next call to select.
				 * Bits are set in response to calls to
				 * Tcl_WatchFile. */
static fd_mask readyMasks[3*MASK_SIZE];
				/* This array reflects the readable/writable
				 * conditions that were found to exist by the
				 * last call to select. */
static int numFdBits;		/* Number of valid bits in checkMasks
				 * (one more than highest fd for which
				 * Tcl_WatchFile has been called). */

/*
 *----------------------------------------------------------------------
 *
 * Tcl_WatchFile --
 *
 *	Arrange for Tcl_DoOneEvent to include this file in the masks
 *	for the next call to select.  This procedure is invoked by
 *	event sources, which are in turn invoked by Tcl_DoOneEvent
 *	before it invokes select.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	
 *	The notifier will generate a file event when the I/O channel
 *	given by fd next becomes ready in the way indicated by mask.
 *	If fd is already registered then the old mask will be replaced
 *	with the new one.  Once the event is sent, the notifier will
 *	not send any more events about the fd until the next call to
 *	Tcl_NotifyFile. 
 *
 *----------------------------------------------------------------------
 */

void
Tcl_WatchFile(file, mask)
    Tcl_File file;	/* Generic file handle for a stream. */
    int mask;			/* OR'ed combination of TCL_READABLE,
				 * TCL_WRITABLE, and TCL_EXCEPTION:
				 * indicates conditions to wait for
				 * in select. */
{
    int fd, type, index;
    fd_mask bit;

    fd = (int) Tcl_GetFileInfo(file, &type);

    if (type != TCL_UNIX_FD) {
	panic("Tcl_WatchFile: unexpected file type");
    }

    if (fd >= FD_SETSIZE) {
	panic("Tcl_WatchFile can't handle file id %d", fd);
    }

    index = fd/(NBBY*sizeof(fd_mask));
    bit = 1 << (fd%(NBBY*sizeof(fd_mask)));
    if (mask & TCL_READABLE) {
	checkMasks[index] |= bit;
    }
    if (mask & TCL_WRITABLE) {
	(checkMasks+MASK_SIZE)[index] |= bit;
    }
    if (mask & TCL_EXCEPTION) {
	(checkMasks+2*(MASK_SIZE))[index] |= bit;
    }
    if (numFdBits <= fd) {
	numFdBits = fd+1;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FileReady --
 *
 *	Indicates what conditions (readable, writable, etc.) were
 *	present on a file the last time the notifier invoked select.
 *	This procedure is typically invoked by event sources to see
 *	if they should queue events.
 *
 * Results:
 *	The return value is 0 if none of the conditions specified by mask
 *	was true for fd the last time the system checked.  If any of the
 *	conditions were true, then the return value is a mask of those
 *	that were true.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_FileReady(file, mask)
    Tcl_File file;	/* Generic file handle for a stream. */
    int mask;			/* OR'ed combination of TCL_READABLE,
				 * TCL_WRITABLE, and TCL_EXCEPTION:
				 * indicates conditions caller cares about. */
{
    int index, result, type, fd;
    fd_mask bit;

    fd = (int) Tcl_GetFileInfo(file, &type);
    if (type != TCL_UNIX_FD) {
	panic("Tcl_FileReady: unexpected file type");
    }

    index = fd/(NBBY*sizeof(fd_mask));
    bit = 1 << (fd%(NBBY*sizeof(fd_mask)));
    result = 0;
    if ((mask & TCL_READABLE) && (readyMasks[index] & bit)) {
	result |= TCL_READABLE;
    }
    if ((mask & TCL_WRITABLE) && ((readyMasks+MASK_SIZE)[index] & bit)) {
	result |= TCL_WRITABLE;
    }
    if ((mask & TCL_EXCEPTION) && ((readyMasks+(2*MASK_SIZE))[index] & bit)) {
	result |= TCL_EXCEPTION;
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_WaitForEvent --
 *
 *	This procedure does the lowest level wait for events in a
 *	platform-specific manner.  It uses information provided by
 *	previous calls to Tcl_WatchFile, plus the timePtr argument,
 *	to determine what to wait for and how long to wait.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	May put the process to sleep for a while, depending on timePtr.
 *	When this procedure returns, an event of interest to the application
 *	has probably, but not necessarily, occurred.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_WaitForEvent(timePtr)
    Tcl_Time *timePtr;		/* Specifies the maximum amount of time
				 * that this procedure should block before
				 * returning.  The time is given as an
				 * interval, not an absolute wakeup time.
				 * NULL means block forever. */
{
    struct timeval timeout, *timeoutPtr;
    int numFound;

    memcpy((VOID *) readyMasks, (VOID *) checkMasks,
	    3*MASK_SIZE*sizeof(fd_mask));
    if (timePtr == NULL) {
	timeoutPtr = NULL;
    } else {
	timeoutPtr = &timeout;
	timeout.tv_sec = timePtr->sec;
	timeout.tv_usec = timePtr->usec;
    }
    numFound = select(numFdBits, (SELECT_MASK *) &readyMasks[0],
	    (SELECT_MASK *) &readyMasks[MASK_SIZE],
	    (SELECT_MASK *) &readyMasks[2*MASK_SIZE], timeoutPtr);

    /*
     * Some systems don't clear the masks after an error, so
     * we have to do it here.
     */

    if (numFound == -1) {
	memset((VOID *) readyMasks, 0, 3*MASK_SIZE*sizeof(fd_mask));
    }

    /*
     * Reset the check masks in preparation for the next call to
     * select.
     */

    numFdBits = 0;
    memset((VOID *) checkMasks, 0, 3*MASK_SIZE*sizeof(fd_mask));
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_Sleep --
 *
 *	Delay execution for the specified number of milliseconds.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Time passes.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_Sleep(ms)
    int ms;			/* Number of milliseconds to sleep. */
{
    static struct timeval delay;
    Tcl_Time before, after;

    /*
     * The only trick here is that select appears to return early
     * under some conditions, so we have to check to make sure that
     * the right amount of time really has elapsed.  If it's too
     * early, go back to sleep again.
     */

    TclGetTime(&before);
    after = before;
    after.sec += ms/1000;
    after.usec += (ms%1000)*1000;
    if (after.usec > 1000000) {
	after.usec -= 1000000;
	after.sec += 1;
    }
    while (1) {
	delay.tv_sec = after.sec - before.sec;
	delay.tv_usec = after.usec - before.usec;
	if (delay.tv_usec < 0) {
	    delay.tv_usec += 1000000;
	    delay.tv_sec -= 1;
	}

	/*
	 * Special note:  must convert delay.tv_sec to int before comparing
	 * to zero, since delay.tv_usec is unsigned on some platforms.
	 */

	if ((((int) delay.tv_sec) < 0)
		|| ((delay.tv_usec == 0) && (delay.tv_sec == 0))) {
	    break;
	}
	(void) select(0, (SELECT_MASK *) 0, (SELECT_MASK *) 0,
		(SELECT_MASK *) 0, &delay);
	TclGetTime(&before);
    }
}







#if 0 /* WHOLE FILE */



/* interact (with only one process) - give user keyboard control

Written by: Don Libes, NIST, 2/6/90

Design and implementation of this program was paid for by U.S. tax
dollars.  Therefore it is public domain.  However, the author and NIST
would appreciate credit if this program or parts of it are used.
*/

/* This file exists for deficient versions of UNIX that lack select,
poll, or some other multiplexing hook.  Instead, this code uses two
processes per spawned process.  One sends characters from the spawnee
to the spawner; a second send chars the other way.

This will work on any UNIX system.  The only sacrifice is that it
doesn't support multiple processes.  Eventually, it should catch
SIGCHLD on dead processes and do the right thing.  But it is pretty
gruesome to imagine so many processes to do all this.  If you change
it successfully, please mail back the changes to me.  - Don
*/

#include "expect_cf.h"
#include <stdio.h>
#include <sys/types.h>
#include <sys/time.h>

#ifdef HAVE_SYS_WAIT_H
#include <sys/wait.h>
#endif

#include "tcl.h"
#include "exp_prog.h"
#include "exp_command.h"	/* for struct ExpState defs */
#include "exp_event.h"

/*ARGSUSED*/
void
exp_arm_background_channelhandler(esPtr)
ExpState *esPtr;
{
}

/*ARGSUSED*/
void
exp_disarm_background_channelhandler(esPtr)
ExpState *esPtr;
{
}

/*ARGSUSED*/
void
exp_disarm_background_channelhandler_force(esPtr)
ExpState *esPtr;
{
}

/*ARGSUSED*/
void
exp_unblock_background_channelhandler(esPtr)
ExpState *esPtr;
{
}

/*ARGSUSED*/
void
exp_block_background_channelhandler(esPtr)
ExpState *esPtr;
{
}

/*ARGSUSED*/
void
exp_event_disarm(fd)
int fd;
{
}

/* returns status, one of EOF, TIMEOUT, ERROR or DATA */
/*ARGSUSED*/
int
exp_get_next_event(interp,esPtrs, n,esPtrOut,timeout,key)
Tcl_Interp *interp;
ExpState (*esPtrs)[];
int n;			/* # of esPtrs */
ExpState **esPtrOut;	/* 1st event master, not set if none */
int timeout;		/* seconds */
int key;
{
    ExpState *esPtr;

    if (n > 1) {
	exp_error(interp,"expect not compiled with multiprocess support");
	/* select a different INTERACT_TYPE in Makefile */
	return(TCL_ERROR);
    }

    esPtr = *esPtrOut = esPtrs[0];

    if (esPtr->key != key) {
	esPtr->key = key;
	esPtr->force_read = FALSE;
	return(EXP_DATA_OLD);
    } else if ((!esPtr->force_read) && (esPtr->size != 0)) {
	return(EXP_DATA_OLD);
    }

    return(EXP_DATA_NEW);
}

/*ARGSUSED*/
int
exp_get_next_event_info(interp,esPtr,ready_mask)
Tcl_Interp *interp;
ExpState *esPtr;
int ready_mask;
{
}

/* There is no portable way to do sub-second sleeps on such a system, so */
/* do the next best thing (without a busy loop) and fake it: sleep the right */
/* amount of time over the long run.  Note that while "subtotal" isn't */
/* reinitialized, it really doesn't matter for such a gross hack as random */
/* scheduling pauses will easily introduce occasional one second delays. */
int	/* returns TCL_XXX */
exp_dsleep(interp,sec)
Tcl_Interp *interp;
double sec;
{
	static double subtotal = 0;
	int seconds;

	subtotal += sec;
	if (subtotal < 1) return TCL_OK;
	seconds = subtotal;
	subtotal -= seconds;
 restart:
	if (Tcl_AsyncReady()) {
		int rc = Tcl_AsyncInvoke(interp,TCL_OK);
		if (rc != TCL_OK) return(rc);
	}
	sleep(seconds);
	return TCL_OK;
}

#if 0
/* There is no portable way to do sub-second sleeps on such a system, so */
/* do the next best thing (without a busy loop) and fake it: sleep the right */
/* amount of time over the long run.  Note that while "subtotal" isn't */
/* reinitialized, it really doesn't matter for such a gross hack as random */
/* scheduling pauses will easily introduce occasional one second delays. */
int	/* returns TCL_XXX */
exp_usleep(interp,usec)
Tcl_Interp *interp;
long usec;		/* microseconds */
{
	static subtotal = 0;
	int seconds;

	subtotal += usec;
	if (subtotal < 1000000) return TCL_OK;
	seconds = subtotal/1000000;
	subtotal = subtotal%1000000;
 restart:
	if (Tcl_AsyncReady()) {
		int rc = Tcl_AsyncInvoke(interp,TCL_OK);
		if (rc != TCL_OK) return(exp_tcl2_returnvalue(rc));
	}
	sleep(seconds);
	return TCL_OK;
}
#endif /*0*/

/* set things up for later calls to event handler */
void
exp_init_event()
{
	exp_event_exit = 0;
}

#endif /* WHOLE FILE! */






Deleted exp_trap.c.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549







































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

/* exp_trap.c - Expect's trap command

Written by: Don Libes, NIST, 9/1/93

Design and implementation of this program was paid for by U.S. tax
dollars.  Therefore it is public domain.  However, the author and NIST
would appreciate credit if this program or parts of it are used.

*/

#include "expect_cf.h"

#include <stdio.h>
#include <signal.h>
#include <sys/types.h>

#ifdef HAVE_SYS_WAIT_H
#include <sys/wait.h>
#endif

#if defined(SIGCLD) && !defined(SIGCHLD)
#define SIGCHLD SIGCLD
#endif

#include "tcl.h"

#include "exp_rename.h"
#include "exp_prog.h"
#include "exp_command.h"
#include "exp_log.h"

#ifdef TCL_DEBUGGER
#include "tcldbg.h"
#endif

#define NO_SIG 0

static struct trap {
	char *action;		/* Tcl command to execute upon sig */
				/* Each is handled by the eval_trap_action */
	int mark;		/* TRUE if signal has occurred */
	Tcl_Interp *interp;	/* interp to use or 0 if we should use the */
				/* interpreter active at the time the sig */
				/* is processed */
	int code;		/* return our new code instead of code */
				/* available when signal is processed */
	char *name;		/* name of signal */
	int reserved;		/* if unavailable for trapping */
} traps[NSIG];

int sigchld_count = 0;	/* # of sigchlds caught but not yet processed */

static int eval_trap_action();

static int got_sig;		/* this records the last signal received */
				/* it is only a hint and can be wiped out */
				/* by multiple signals, but it will always */
				/* be left with a valid signal that is */
				/* pending */

static Tcl_AsyncHandler async_handler;

static char *
signal_to_string(sig)
int sig;
{
	if (sig <= 0 || sig > NSIG) return("SIGNAL OUT OF RANGE");
	return(traps[sig].name);
}

/* current sig being processed by user sig handler */
static int current_sig = NO_SIG;

int exp_nostack_dump = FALSE;	/* TRUE if user has requested unrolling of */
				/* stack with no trace */



/*ARGSUSED*/
static int
tophalf(clientData,interp,code)
ClientData clientData;
Tcl_Interp *interp;
int code;
{
	struct trap *trap;	/* last trap processed */
	int rc;
	int i;
	Tcl_Interp *sig_interp;

	expDiagLog("sighandler: handling signal(%d)\r\n",got_sig);

	if (got_sig <= 0 || got_sig >= NSIG) {
		expErrorLog("caught impossible signal %d\r\n",got_sig);
		abort();
	}

	/* start to work on this sig.  got_sig can now be overwritten */
	/* and it won't cause a problem */
	current_sig = got_sig;
	trap = &traps[current_sig];

	trap->mark = FALSE;

	/* decrement below looks dangerous */
	/* Don't we need to temporarily block bottomhalf? */
	if (current_sig == SIGCHLD) {
		sigchld_count--;
		expDiagLog("sigchld_count-- == %d\n",sigchld_count);
	}

	if (!trap->action) {
		/* In this one case, we let ourselves be called when no */
		/* signaler predefined, since we are calling explicitly */
		/* from another part of the program, and it is just simpler */
		if (current_sig == 0) return code;
		expErrorLog("caught unexpected signal: %s (%d)\r\n",
			signal_to_string(current_sig),current_sig);
		abort();
	}

	if (trap->interp) {
		/* if trap requested original interp, use it */
		sig_interp = trap->interp;
	} else if (!interp) {
		/* else if another interp is available, use it */
		sig_interp = interp;
	} else {
		/* fall back to exp_interp */
		sig_interp = exp_interp;
	}

	rc = eval_trap_action(sig_interp,current_sig,trap,code);
	current_sig = NO_SIG;

	/*
	 * scan for more signals to process
	 */

	/* first check for additional SIGCHLDs */
	if (sigchld_count) {
		got_sig = SIGCHLD;
		traps[SIGCHLD].mark = TRUE;
		Tcl_AsyncMark(async_handler);
	} else {
		got_sig = -1;
		for (i=1;i<NSIG;i++) {
			if (traps[i].mark) {
				got_sig = i;
				Tcl_AsyncMark(async_handler);
				break;
			}
		}
	}
	return rc;
}

#ifdef REARM_SIG
int sigchld_sleep;
static int rearm_sigchld = FALSE;	/* TRUE if sigchld needs to be */
					/* rearmed (i.e., because it has */
					/* just gone off) */
static int rearming_sigchld = FALSE;
#endif

/* called upon receipt of a user-declared signal */
static void
bottomhalf(sig)
int sig;
{
#ifdef REARM_SIG
	/*
	 * tiny window of death if same signal should arrive here
	 * before we've reinstalled it
	 */

	/* In SV, sigchld must be rearmed after wait to avoid recursion */
	if (sig != SIGCHLD) {
		signal(sig,bottomhalf);
	} else {
		/* request rearm */
		rearm_sigchld = TRUE;
		if (rearming_sigchld) sigchld_sleep = TRUE;
	}
#endif

	traps[sig].mark = TRUE;
	got_sig = sig;		/* just a hint - can be wiped out by another */
	Tcl_AsyncMark(async_handler);

	/* if we are called while this particular async is being processed */
	/* original async_proc will turn off "mark" so that when async_proc */
	/* is recalled, it will see that nothing was left to do */

	/* In case of SIGCHLD though, we must recall it as many times as
	 * we have received it.
	 */
	if (sig == SIGCHLD) {
		sigchld_count++;
	}
#if 0
	/* if we are doing an i_read, restart it */
#ifdef HAVE_SIGLONGJMP
      if (env_valid && (sig != 0)) siglongjmp(env,2);
#else
      if (env_valid && (sig != 0)) longjmp(env,2);
#endif  /* HAVE_SIGLONGJMP */
#endif /* 0 */
}

/*ARGSUSED*/
void
exp_rearm_sigchld(interp)
Tcl_Interp *interp;
{
#ifdef REARM_SIG
	if (rearm_sigchld) {
		rearm_sigchld = FALSE;
		rearming_sigchld = TRUE;
		signal(SIGCHLD,bottomhalf);
	}

	rearming_sigchld = FALSE;

	/* if the rearming immediately caused another SIGCHLD, slow down */
	/* It's probably one of Tcl's intermediary pipeline processes that */
	/* Tcl hasn't caught up with yet. */
	if (sigchld_sleep) {
		exp_dsleep(interp,0.2);
		sigchld_sleep = FALSE;
	}
#endif
}


void
exp_init_trap()
{
	int i;

	for (i=1;i<NSIG;i++) {
		traps[i].name = Tcl_SignalId(i);
		traps[i].action = 0;
		traps[i].reserved = FALSE;
	}

	/*
	 * fix up any special cases
	 */

#if defined(SIGCLD)
	/* Tcl names it SIGCLD, not good for portable scripts */
	traps[SIGCLD].name = "SIGCHLD";
#endif
#if defined(SIGALRM)
	traps[SIGALRM].reserved = TRUE;
#endif
#if defined(SIGKILL)
	traps[SIGKILL].reserved = TRUE;
#endif
#if defined(SIGSTOP)
	traps[SIGSTOP].reserved = TRUE;
#endif

	async_handler = Tcl_AsyncCreate(tophalf,(ClientData)0);

}

/* given signal index or name as string, */
/* returns signal index or -1 if bad arg */
int
exp_string_to_signal(interp,s)
Tcl_Interp *interp;
char *s;
{
	int sig;
	char *name;

	/* try interpreting as an integer */
	if (1 == sscanf(s,"%d",&sig)) {
		if (sig > 0 && sig < NSIG) return sig;
	} else {
		/* try interpreting as a string */
		for (sig=1;sig<NSIG;sig++) {
			name = traps[sig].name;
			if (streq(s,name) || streq(s,name+3)) return(sig);
		}
	}

	exp_error(interp,"invalid signal %s",s);
	
	return -1;
}

/*ARGSUSED*/
int
Exp_TrapObjCmd(clientData, interp, objc, objv)
ClientData clientData;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];
{
	char *action = 0;
	int n;		/* number of signals in list */
	Tcl_Obj **list;	/* list of signals */
	char *arg;
	int len;	/* length of action */
	int i;
	int show_name = FALSE;	/* if user asked for current sig by name */
	int show_number = FALSE;/* if user asked for current sig by number */
	int show_max = FALSE;	/* if user asked for NSIG-1 */
	int rc = TCL_OK;
	int new_code = FALSE;	/* if action result should overwrite orig */
	Tcl_Interp *new_interp = interp;/* interp in which to evaluate */
					/* action when signal occurs */

	objc--; objv++;

	while (objc) {
	  arg = Tcl_GetString(*objv);

		if (streq(arg,"-code")) {
			objc--; objv++; 
			new_code = TRUE;
		} else if (streq(arg,"-interp")) {
			objc--; objv++; 
			new_interp = 0;
		} else if (streq(arg,"-name")) {
			objc--; objv++;
			show_name = TRUE;
		} else if (streq(arg,"-number")) {
			objc--; objv++;
			show_number = TRUE;
		} else if (streq(arg,"-max")) {
			objc--; objv++;
			show_max = TRUE;
		} else break;
	}

	if (show_name || show_number || show_max) {
		if (objc > 0) goto usage_error;
		if (show_max) {
		  Tcl_SetObjResult(interp,Tcl_NewIntObj(NSIG-1));
		}

		if (current_sig == NO_SIG) {
		  Tcl_SetResult(interp,"no signal in progress",TCL_STATIC);
		  return TCL_ERROR;
		}
		if (show_name) {
		  /* skip over "SIG" */
		  Tcl_SetResult(interp,signal_to_string(current_sig) + 3,TCL_STATIC);
		} else {
		  Tcl_SetObjResult(interp,Tcl_NewIntObj(current_sig));
		}
		return TCL_OK;
	}

	if (objc == 0 || objc > 2) goto usage_error;

	if (objc == 1) {
		int sig = exp_string_to_signal(interp,arg);
		if (sig == -1) return TCL_ERROR;

		if (traps[sig].action) {
			Tcl_SetResult(interp,traps[sig].action,TCL_STATIC);
		} else {
			Tcl_SetResult(interp,"SIG_DFL",TCL_STATIC);
		}
		return TCL_OK;
	}

	action = arg;

	/* objv[1] is the list of signals - crack it open */
	if (TCL_OK != Tcl_ListObjGetElements(interp,objv[1],&n,&list)) {
	  return TCL_ERROR;
	}

	for (i=0;i<n;i++) {
	  char *s;
	  int sig;

	  s = Tcl_GetString(list[i]);

		sig = exp_string_to_signal(interp,s);
		if (sig == -1) {
			rc = TCL_ERROR;
			break;
		}

		if (traps[sig].reserved) {
			exp_error(interp,"cannot trap %s",signal_to_string(sig));
			rc = TCL_ERROR;
			break;
		}

		expDiagLog("trap: setting up signal %d (\"%s\")\r\n",sig,s);
		if (traps[sig].action) ckfree(traps[sig].action);
		if (streq(action,"SIG_DFL")) {
			/* should've been free'd by now if nec. */
			traps[sig].action = 0;
			signal(sig,SIG_DFL);
#ifdef REARM_SIG
			if (sig == SIGCHLD)
				rearm_sigchld = FALSE;
#endif /*REARM_SIG*/
		} else {
			len = 1 + strlen(action);
			traps[sig].action = ckalloc(len);
			memcpy(traps[sig].action,action,len);
			traps[sig].interp = new_interp;
			traps[sig].code = new_code;
			if (streq(action,"SIG_IGN")) {
				signal(sig,SIG_IGN);
			} else signal(sig,bottomhalf);
		}
	}
	/* It is no longer necessary to free the split list since it */
	/* is still owned by Tcl, yes? */
	/*	ckfree((char *)list); */
	return(rc);
 usage_error:
	exp_error(interp,"usage: trap [command or SIG_DFL or SIG_IGN] {list of signals}");
	return TCL_ERROR;
}

/* called by tophalf() to process the given signal */
static int
eval_trap_action(interp,sig,trap,oldcode)
Tcl_Interp *interp;
int sig;
struct trap *trap;
int oldcode;
{
	int code_flag;
	int newcode;
	Tcl_Obj *eip;   /* errorInfo */
	Tcl_Obj *ecp;	/* errorCode */
	Tcl_Obj *irp;	/* interp->result */

	expDiagLogU("async event handler: Tcl_Eval(");
	expDiagLogU(trap->action);
	expDiagLogU(")\r\n");

	/* save to prevent user from redefining trap->code while trap */
	/* is executing */
	code_flag = trap->code;

	if (!code_flag) {
		/* 
		 * save return values
		 */

		eip = Tcl_GetVar2Ex(interp,"errorInfo","",TCL_GLOBAL_ONLY);
		if (eip) eip = Tcl_DuplicateObj(eip);
		ecp = Tcl_GetVar2Ex(interp,"errorCode","",TCL_GLOBAL_ONLY);
		if (ecp) ecp = Tcl_DuplicateObj(ecp);
		irp = Tcl_GetObjResult(interp);
		if (irp) irp = Tcl_DuplicateObj(irp);
	}

	newcode = Tcl_GlobalEval(interp,trap->action);

	/*
	 * if new code is to be ignored (usual case - see "else" below)
	 *	allow only OK/RETURN from trap, otherwise complain
	 */

	if (code_flag) {
		expDiagLog("return value = %d for trap %s, action ",newcode,signal_to_string(sig));
		expDiagLogU(trap->action);
		expDiagLogU("\r\n");
		if (0 != strcmp(Tcl_GetStringResult(interp),"")) {

			/*
			 * Check errorinfo and see if it contains -nostack.
			 * This shouldn't be necessary, but John changed the
			 * top level interp so that it distorts arbitrary
			 * return values into TCL_ERROR, so by the time we
			 * get back, we'll have lost the value of errorInfo
			 */

			eip = Tcl_GetVar2Ex(interp,"errorInfo","",TCL_GLOBAL_ONLY);
			if (eip) {
			  exp_nostack_dump = (0 == strncmp("-nostack",Tcl_GetString(eip),8));
			}
		}
	} else if (newcode != TCL_OK && newcode != TCL_RETURN) {
	  if (newcode != TCL_ERROR) {
	    exp_error(interp,"return value = %d for trap %s, action %s\r\n",newcode,signal_to_string(sig),trap->action);
	  }
	  Tcl_BackgroundError(interp);
	}

	if (!code_flag) {
		/*
		 * restore values
		 */
		Tcl_ResetResult(interp);	/* turns off Tcl's internal */
		   /* flags: ERR_IN_PROGRESS, ERROR_CODE_SET */
		   /* This also wipes clean errorInfo/Code/result which is why */
		   /* all the calls to Tcl_Dup earlier */

		if (eip) {
		  /* odd that Tcl doesn't have a call that does all this at once */
		  int len;
		  char *s = Tcl_GetStringFromObj(eip,&len);
		  Tcl_AddObjErrorInfo(interp,s,len);
		  Tcl_DecrRefCount(eip);
		  /* we never incr'd it, but the code allows this */
		} else {
		  Tcl_UnsetVar(interp,"errorInfo",0);
		}

		/* restore errorCode.  Note that Tcl_AddErrorInfo (above) */
		/* resets it to NONE.  If the previous value is NONE, it's */
		/* important to avoid calling Tcl_SetErrorCode since this */
		/* with cause Tcl to set its internal ERROR_CODE_SET flag. */
		if (ecp) {
		  if (!streq("NONE",Tcl_GetString(ecp)))
		    Tcl_SetErrorCode(interp,ecp);
		  /* we're just passing on the errorcode obj */
		  /* presumably, Tcl will incr ref count */
		} else {
		  Tcl_UnsetVar(interp,"errorCode",0);
		}

		newcode = oldcode;

		/* note that since newcode gets overwritten here by old code */
		/* it is possible to return in the middle of a trap by using */
		/* "return" (or "continue" for that matter)! */
	}
	return newcode;
}

static struct exp_cmd_data
cmd_data[]  = {
{"trap",	Exp_TrapObjCmd, 0,	(ClientData)EXP_SPAWN_ID_BAD,	0},
{0}};

void
exp_init_trap_cmds(interp)
Tcl_Interp *interp;
{
	exp_create_commands(interp,cmd_data);
}







Deleted exp_tstamp.h.





1
2




-
-

EXTERN void		exp_timestamp _ANSI_ARGS_((Tcl_Interp *,time_t *,
				char *));






Deleted exp_tty.c.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768


































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

/* exp_tty.c - tty support routines */

#include "expect_cf.h"
#include <stdio.h>
#include <signal.h>
#include "string.h"

#ifdef HAVE_SYS_FCNTL_H
#  include <sys/fcntl.h>
#else
#  include <fcntl.h>
#endif

#include <sys/stat.h>

#ifdef HAVE_INTTYPES_H
#  include <inttypes.h>
#endif
#include <sys/types.h>

#ifdef HAVE_UNISTD_H
# include <unistd.h>
#endif

#ifdef HAVE_SYS_WAIT_H
#include <sys/wait.h>
#endif

#if defined(SIGCLD) && !defined(SIGCHLD)
#define SIGCHLD SIGCLD
#endif

#include "tcl.h"
#include "exp_prog.h"
#include "exp_rename.h"
#include "exp_tty_in.h"
#include "exp_command.h"
#include "exp_log.h"

static int is_raw = FALSE;
static int is_noecho = FALSE;

int exp_ioctled_devtty = FALSE;
int exp_stdin_is_tty;
int exp_stdout_is_tty;

/*static*/ extern exp_tty exp_tty_current, exp_tty_cooked;
#define tty_current exp_tty_current
#define tty_cooked exp_tty_cooked

int
exp_israw()
{
	return is_raw;
}

int
exp_isecho()
{
	return !is_noecho;
}

/* if set == 1, set it to raw, else unset it */
void
exp_tty_raw(set)
int set;
{
	if (set == 1) {
		is_raw = TRUE;
#if defined(HAVE_TERMIOS) || defined(HAVE_TERMIO) /* had POSIX too */
		tty_current.c_iflag = 0;
		tty_current.c_oflag = 0;
		tty_current.c_lflag &= ECHO;  /* disable everything but echo */
		tty_current.c_cc[VMIN] = 1;
		tty_current.c_cc[VTIME] = 0;
	} else {
		tty_current.c_iflag = tty_cooked.c_iflag;
		tty_current.c_oflag = tty_cooked.c_oflag;
/*		tty_current.c_lflag = tty_cooked.c_lflag;*/
/* attempt 2	tty_current.c_lflag = tty_cooked.c_lflag & ~ECHO;*/
		/* retain current echo setting */
		tty_current.c_lflag = (tty_cooked.c_lflag & ~ECHO) | (tty_current.c_lflag & ECHO);
		tty_current.c_cc[VMIN] = tty_cooked.c_cc[VMIN];
		tty_current.c_cc[VTIME] = tty_cooked.c_cc[VTIME];
#else
#  if defined(HAVE_SGTTYB)
		tty_current.sg_flags |= RAW;
	} else {
		tty_current.sg_flags = tty_cooked.sg_flags;
#  endif
#endif
		is_raw = FALSE;
	}
}
	
void
exp_tty_echo(set)
int set;
{
	if (set == 1) {
		is_noecho = FALSE;
#if defined(HAVE_TERMIOS) || defined(HAVE_TERMIO) /* had POSIX too */
		tty_current.c_lflag |= ECHO;
	} else {
		tty_current.c_lflag &= ~ECHO;
#else
		tty_current.sg_flags |= ECHO;
	} else {
		tty_current.sg_flags &= ~ECHO;
#endif
		is_noecho = TRUE;
	}
}

int
exp_tty_set_simple(tty)
exp_tty *tty;
{
#ifdef HAVE_TCSETATTR
	return(tcsetattr(exp_dev_tty, TCSADRAIN,tty));
#else
	return(ioctl    (exp_dev_tty, TCSETSW  ,tty));
#endif
}

int
exp_tty_get_simple(tty)
exp_tty *tty;
{
#ifdef HAVE_TCSETATTR
	return(tcgetattr(exp_dev_tty,         tty));
#else
	return(ioctl    (exp_dev_tty, TCGETS, tty));
#endif
}

/* returns 0 if nothing changed */
/* if something changed, the out parameters are changed as well */
int
exp_tty_raw_noecho(interp,tty_old,was_raw,was_echo)
Tcl_Interp *interp;
exp_tty *tty_old;
int *was_raw, *was_echo;
{
	if (exp_disconnected) return(0);
	if (is_raw && is_noecho) return(0);
	if (exp_dev_tty == -1) return(0);

	*tty_old = tty_current;		/* save old parameters */
	*was_raw = is_raw;
	*was_echo = !is_noecho;
	expDiagLog("tty_raw_noecho: was raw = %d  echo = %d\r\n",is_raw,!is_noecho);

	exp_tty_raw(1);
	exp_tty_echo(-1);

	if (exp_tty_set_simple(&tty_current) == -1) {
		expErrorLog("ioctl(raw): %s\r\n",Tcl_PosixError(interp));
		Tcl_Exit(1);
	}

	exp_ioctled_devtty = TRUE;
	return(1);
}

/* returns 0 if nothing changed */
/* if something changed, the out parameters are changed as well */
int
exp_tty_cooked_echo(interp,tty_old,was_raw,was_echo)
Tcl_Interp *interp;
exp_tty *tty_old;
int *was_raw, *was_echo;
{
	if (exp_disconnected) return(0);
	if (!is_raw && !is_noecho) return(0);
	if (exp_dev_tty == -1) return(0);

	*tty_old = tty_current;		/* save old parameters */
	*was_raw = is_raw;
	*was_echo = !is_noecho;
	expDiagLog("tty_cooked_echo: was raw = %d  echo = %d\r\n",is_raw,!is_noecho);

	exp_tty_raw(-1);
	exp_tty_echo(1);

	if (exp_tty_set_simple(&tty_current) == -1) {
		expErrorLog("ioctl(noraw): %s\r\n",Tcl_PosixError(interp));
		Tcl_Exit(1);
	}
	exp_ioctled_devtty = TRUE;

	return(1);
}

void
exp_tty_set(interp,tty,raw,echo)
Tcl_Interp *interp;
exp_tty *tty;
int raw;
int echo;
{
	if (exp_tty_set_simple(tty) == -1) {
		expErrorLog("ioctl(set): %s\r\n",Tcl_PosixError(interp));
		Tcl_Exit(1);
	}
	is_raw = raw;
	is_noecho = !echo;
	tty_current = *tty;
	expDiagLog("tty_set: raw = %d, echo = %d\r\n",is_raw,!is_noecho);
	exp_ioctled_devtty = TRUE;
}	

#if 0
/* avoids scoping problems */
void
exp_update_cooked_from_current() {
	tty_cooked = tty_current;
}

int
exp_update_real_tty_from_current() {
	return(exp_tty_set_simple(&tty_current));
}

int
exp_update_current_from_real_tty() {
	return(exp_tty_get_simple(&tty_current));
}
#endif

void
exp_init_stdio()
{
	exp_stdin_is_tty = isatty(0);
	exp_stdout_is_tty = isatty(1);

	setbuf(stdout,(char *)0);	/* unbuffer stdout */
}

/*ARGSUSED*/
void
exp_tty_break(interp,fd)
Tcl_Interp *interp;
int fd;
{
#ifdef POSIX
	tcsendbreak(fd,0);
#else
# ifdef TIOCSBRK
	ioctl(fd,TIOCSBRK,0);
	exp_dsleep(interp,0.25); /* sleep for at least a quarter of a second */
	ioctl(fd,TIOCCBRK,0);
# else
	/* dunno how to do this - ignore */
# endif
#endif
}

/* take strings with newlines and insert carriage-returns.  This allows user */
/* to write send_user strings without always putting in \r. */
/* If len == 0, use strlen to compute it */
/* NB: if terminal is not in raw mode, nothing is done. */
char *
exp_cook(s,len)
char *s;
int *len;	/* current and new length of s */
{
	static int destlen = 0;
	static char *dest = 0;
	char *d;		/* ptr into dest */
	unsigned int need;

	if (s == 0) return("<null>");

	if (!is_raw) return(s);

	/* worst case is every character takes 2 to represent */
	need = 1 + 2*(len?*len:strlen(s));
	if (need > destlen) {
		if (dest) ckfree(dest);
		dest = ckalloc(need);
		destlen = need;
	}

	for (d = dest;*s;s++) {
		if (*s == '\n') {
			*d++ = '\r';
			*d++ = '\n';
		} else {
			*d++ = *s;
		}
	}
	*d = '\0';
	if (len) *len = d-dest;
	return(dest);
}

/* this stupidity because Tcl needs commands in writable space */
static char exec_cmd[] = "exec";
static char stty_cmd[] = "/bin/stty";

static int		/* returns TCL_whatever */
exec_stty(interp,argc,argv,devtty)
Tcl_Interp *interp;
int argc;
char **argv;
int devtty;		/* if true, redirect to /dev/tty */
{
	char **new_argv;
	int i;
	int rc;

	Tcl_Obj *cmdObj = Tcl_NewStringObj("",0);
	Tcl_IncrRefCount(cmdObj);

	Tcl_AppendStringsToObj(cmdObj,"exec /bin/stty",(char *)0);
	for (i=1;i<argc;i++) {
	    Tcl_AppendStringsToObj(cmdObj," ",argv[i],(char *)0);
	}
	if (devtty) Tcl_AppendStringsToObj(cmdObj,
#ifdef STTY_READS_STDOUT
		" >/dev/tty",
#else
		" </dev/tty",
#endif
		(char *)0);

	Tcl_ResetResult(interp);

	/*
	 * normally, I wouldn't set one of Tcl's own variables, but in this
	 * case, I only want to see if Tcl resets it to non-NONE, and I don't
	 * know any other way of doing it
	 */

	Tcl_SetVar(interp,"errorCode","NONE",0);
	rc = Tcl_EvalObjEx(interp,cmdObj,TCL_EVAL_DIRECT);

	Tcl_DecrRefCount(cmdObj);

	/* if stty-reads-stdout, stty will fail since Exec */
	/* will detect the stderr.  Only by examining errorCode */
	/* can we tell if a real error occurred. */	

#ifdef STTY_READS_STDOUT
	if (rc == TCL_ERROR) {
		char *ec = Tcl_GetVar(interp,"errorCode",TCL_GLOBAL_ONLY);
		if (ec && !streq(ec,"NONE")) return TCL_ERROR;
	}
#endif
	return TCL_OK;
}

/*ARGSUSED*/
static int
Exp_SttyCmd(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
	/* redirection symbol is not counted as a stty arg in terms */
	/* of recognition. */
	int saw_unknown_stty_arg = FALSE;
	int saw_known_stty_arg = FALSE;
	int no_args = TRUE;

	int rc = TCL_OK;
	int cooked = FALSE;
	int was_raw, was_echo;


	char **redirect;	/* location of "<" */
	char *infile = 0;
	int fd;			/* (slave) fd of infile */
	int master = -1;	/* master fd of infile */
	char **argv0 = argv;

	for (argv=argv0+1;*argv;argv++) {
		if (argv[0][0] == '<') {
			redirect = argv;
			infile = *(argv+1);
			if (!infile) {
				expErrorLog("usage: < ttyname");
				return TCL_ERROR;
			}
			if (streq(infile,"/dev/tty")) {
				infile = 0;
				*argv = 0;
				*(argv+1) = 0;
				argc -= 2;
			} else {
				master = exp_trap_off(infile);
				if (-1 == (fd = open(infile,2))) {
					expErrorLog("couldn't open %s: %s",
					 infile,Tcl_PosixError(interp));
					return TCL_ERROR;
				}
			}
			break;
		}
	}

	if (!infile) {		/* work on /dev/tty */
		was_raw = exp_israw();
		was_echo = exp_isecho();

		exp_ioctled_devtty = TRUE;

		for (argv=argv0+1;*argv;argv++) {
			if (streq(*argv,"raw") ||
			    streq(*argv,"-cooked")) {
				exp_tty_raw(1);
				saw_known_stty_arg = TRUE;
				no_args = FALSE;
			} else if (streq(*argv,"-raw") ||
				   streq(*argv,"cooked")) {
				cooked = TRUE;
				exp_tty_raw(-1);
				saw_known_stty_arg = TRUE;
				no_args = FALSE;
			} else if (streq(*argv,"echo")) {
				exp_tty_echo(1);
				saw_known_stty_arg = TRUE;
				no_args = FALSE;
			} else if (streq(*argv,"-echo")) {
				exp_tty_echo(-1);
				saw_known_stty_arg = TRUE;
				no_args = FALSE;
			} else if (streq(*argv,"rows")) {
				if (*(argv+1)) {
					exp_win_rows_set(*(argv+1));
					argv++;
					no_args = FALSE;
				} else {
					exp_win_rows_get(interp->result);
					return TCL_OK;
				}
			} else if (streq(*argv,"columns")) {
				if (*(argv+1)) {
					exp_win_columns_set(*(argv+1));
					argv++;
					no_args = FALSE;
				} else {
					exp_win_columns_get(interp->result);
					return TCL_OK;
				}
			} else {
				saw_unknown_stty_arg = TRUE;
			}
		}
		/* if any unknown args, let real stty try */
		if (saw_unknown_stty_arg || no_args) {
			/* let real stty try */
			rc = exec_stty(interp,argc,argv0,1);

			/* find out what weird options user asked for */
			if (exp_tty_get_simple(&tty_current) == -1) {
				exp_error(interp,"stty: ioctl(get): %s\r\n",Tcl_PosixError(interp));
				rc = TCL_ERROR;
			}
			if (cooked) {
				/* find out user's new defn of 'cooked' */
				tty_cooked = tty_current;
			}
		} else if (saw_known_stty_arg) {
			if (exp_tty_set_simple(&tty_current) == -1) {
			    if (exp_disconnected || (exp_dev_tty == -1) || !isatty(exp_dev_tty)) {
				expErrorLog("stty: impossible in this context\n");
				expErrorLog("are you disconnected or in a batch, at, or cron script?");
				/* user could've conceivably closed /dev/tty as well */
			    }
			    exp_error(interp,"stty: ioctl(user): %s\r\n",Tcl_PosixError(interp));
			    rc = TCL_ERROR;
			}
		}

		/* if no result, make a crude one */
		if (interp->result[0] == '\0') {
			sprintf(interp->result,"%sraw %secho",
				(was_raw?"":"-"),
				(was_echo?"":"-"));
		}
	} else {
		/* a different tty */

		/* temporarily zap redirect */
		char *redirect_save = *redirect;
		*redirect = 0;

		for (argv=argv0+1;*argv;argv++) {
			if (streq(*argv,"rows")) {
				if (*(argv+1)) {
					exp_win2_rows_set(fd,*(argv+1));
					argv++;
					no_args = FALSE;
				} else {
					exp_win2_rows_get(fd,interp->result);
					goto done;
				}
			} else if (streq(*argv,"columns")) {
				if (*(argv+1)) {
					exp_win2_columns_set(fd,*(argv+1));
					argv++;
					no_args = FALSE;
				} else {
					exp_win2_columns_get(fd,interp->result);
					goto done;
				}
			} else if (streq(*argv,"<")) {
				break;
			} else {
				saw_unknown_stty_arg = TRUE;
				break;
			}
		}

		/* restore redirect */
		*redirect = redirect_save;

		close(fd);	/* no more use for this, from now on */
				/* pass by name */

		if (saw_unknown_stty_arg || no_args) {
#ifdef STTY_READS_STDOUT
			/* switch "<" to ">" */
			char original_redirect_char = (*redirect)[0];
			(*redirect)[0] = '>';
			/* stderr unredirected so we can get it directly! */
#endif
			rc = exec_stty(interp,argc,argv0,0);
#ifdef STTY_READS_STDOUT
			/* restore redirect - don't know if necessary */
			(*redirect)[0] = original_redirect_char;
#endif
		}
	}
 done:
	exp_trap_on(master);

	return rc;
}

/*ARGSUSED*/
static int
Exp_SystemCmd(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
	int result = TCL_OK;
	RETSIGTYPE (*old)();	/* save old sigalarm handler */
#define MAX_ARGLIST 10240
	int i;

	WAIT_STATUS_TYPE waitStatus;
	int systemStatus
;
	int abnormalExit = FALSE;
	char buf[MAX_ARGLIST];
	char *bufp = buf;
	int total_len = 0, arg_len;

	int stty_args_recognized = TRUE;
	int cmd_is_stty = FALSE;
	int cooked = FALSE;
	int was_raw, was_echo;

	if (argc == 1) return TCL_OK;

	if (streq(argv[1],"stty")) {
		expDiagLogU("system stty is deprecated, use stty\r\n");

		cmd_is_stty = TRUE;
		was_raw = exp_israw();
		was_echo = exp_isecho();
	}

	if (argc > 2 && cmd_is_stty) {
		exp_ioctled_devtty = TRUE;

		for (i=2;i<argc;i++) {
			if (streq(argv[i],"raw") ||
			    streq(argv[i],"-cooked")) {
				exp_tty_raw(1);
			} else if (streq(argv[i],"-raw") ||
				   streq(argv[i],"cooked")) {
				cooked = TRUE;
				exp_tty_raw(-1);
			} else if (streq(argv[i],"echo")) {
				exp_tty_echo(1);
			} else if (streq(argv[i],"-echo")) {
				exp_tty_echo(-1);
			} else stty_args_recognized = FALSE;
		}

		/* if unknown args, fall thru and let real stty have a go */
		if (stty_args_recognized) {
#ifdef HAVE_TCSETATTR
 			if (tcsetattr(exp_dev_tty,TCSADRAIN, &tty_current) == -1) {
#else
		        if (ioctl(exp_dev_tty, TCSETSW, &tty_current) == -1) {
#endif
			    if (exp_disconnected || (exp_dev_tty == -1) || !isatty(exp_dev_tty)) {
				expErrorLog("system stty: impossible in this context\n");
				expErrorLog("are you disconnected or in a batch, at, or cron script?");
				/* user could've conceivably closed /dev/tty as well */
			    }
			    exp_error(interp,"system stty: ioctl(user): %s\r\n",Tcl_PosixError(interp));
			    return(TCL_ERROR);
			}
			if (cmd_is_stty) {
				sprintf(interp->result,"%sraw %secho",
					(was_raw?"":"-"),
					(was_echo?"":"-"));
			}
			return(TCL_OK);
		}
	}

	for (i = 1;i<argc;i++) {
		total_len += (1 + (arg_len = strlen(argv[i])));
		if (total_len > MAX_ARGLIST) {
			exp_error(interp,"args too long (>=%d chars)",
				total_len);
			return(TCL_ERROR);
		}
		memcpy(bufp,argv[i],arg_len);
		bufp += arg_len;
		/* no need to check bounds, we accted for it earlier */
		memcpy(bufp," ",1);
		bufp += 1;
	}

	*(bufp-1) = '\0';

	old = signal(SIGCHLD, SIG_DFL);
	systemStatus = system(buf);
	signal(SIGCHLD, old);	/* restore signal handler */
	expDiagLogU("system(");
	expDiagLogU(buf);
	expDiagLog(") = %d\r\n",i);

	if (systemStatus == -1) {
		exp_error(interp,Tcl_PosixError(interp));
		return TCL_ERROR;
	}
	*(int *)&waitStatus = systemStatus;

	if (!stty_args_recognized) {
		/* find out what weird options user asked for */
#ifdef HAVE_TCSETATTR
		if (tcgetattr(exp_dev_tty, &tty_current) == -1) {
#else
	        if (ioctl(exp_dev_tty, TCGETS, &tty_current) == -1) {
#endif
			expErrorLog("ioctl(get): %s\r\n",Tcl_PosixError(interp));
			Tcl_Exit(1);
		}
		if (cooked) {
			/* find out user's new defn of 'cooked' */
			tty_cooked = tty_current;
		}
	}

	if (cmd_is_stty) {
		sprintf(interp->result,"%sraw %secho",
			(was_raw?"":"-"),
			(was_echo?"":"-"));
	}

/* following macros stolen from Tcl's tclUnix.h file */
/* we can't include the whole thing because it depends on other macros */
/* that come out of Tcl's Makefile, sigh */

#if 0

#undef WIFEXITED
#ifndef WIFEXITED
#   define WIFEXITED(stat)  (((*((int *) &(stat))) & 0xff) == 0)
#endif

#undef WEXITSTATUS
#ifndef WEXITSTATUS
#   define WEXITSTATUS(stat) (((*((int *) &(stat))) >> 8) & 0xff)
#endif

#undef WIFSIGNALED
#ifndef WIFSIGNALED
#   define WIFSIGNALED(stat) (((*((int *) &(stat)))) && ((*((int *) &(stat))) == ((*((int *) &(stat))) & 0x00ff)))
#endif

#undef WTERMSIG
#ifndef WTERMSIG
#   define WTERMSIG(stat)    ((*((int *) &(stat))) & 0x7f)
#endif

#undef WIFSTOPPED
#ifndef WIFSTOPPED
#   define WIFSTOPPED(stat)  (((*((int *) &(stat))) & 0xff) == 0177)
#endif

#undef WSTOPSIG
#ifndef WSTOPSIG
#   define WSTOPSIG(stat)    (((*((int *) &(stat))) >> 8) & 0xff)
#endif

#endif /* 0 */

/* stolen from Tcl.    Again, this is embedded in another routine */
/* (CleanupChildren in tclUnixAZ.c) that we can't use directly. */

	if (!WIFEXITED(waitStatus) || (WEXITSTATUS(waitStatus) != 0)) {
	    char msg1[20], msg2[20];
	    int pid = 0;	/* fake a pid, since system() won't tell us */ 

	    result = TCL_ERROR;
	    sprintf(msg1, "%d", pid);
	    if (WIFEXITED(waitStatus)) {
		sprintf(msg2, "%d", WEXITSTATUS(waitStatus));
		Tcl_SetErrorCode(interp, "CHILDSTATUS", msg1, msg2,
			(char *) NULL);
		abnormalExit = TRUE;
	    } else if (WIFSIGNALED(waitStatus)) {
		char *p;
	
		p = Tcl_SignalMsg((int) (WTERMSIG(waitStatus)));
		Tcl_SetErrorCode(interp, "CHILDKILLED", msg1,
			Tcl_SignalId((int) (WTERMSIG(waitStatus))), p,
			(char *) NULL);
		Tcl_AppendResult(interp, "child killed: ", p, "\n",
			(char *) NULL);
	    } else if (WIFSTOPPED(waitStatus)) {
		char *p;

		p = Tcl_SignalMsg((int) (WSTOPSIG(waitStatus)));
		Tcl_SetErrorCode(interp, "CHILDSUSP", msg1,
			Tcl_SignalId((int) (WSTOPSIG(waitStatus))), p, (char *) NULL);
		Tcl_AppendResult(interp, "child suspended: ", p, "\n",
			(char *) NULL);
	    } else {
		Tcl_AppendResult(interp,
			"child wait status didn't make sense\n",
			(char *) NULL);
	    }
	}

    if (abnormalExit && (*interp->result == 0)) {
	Tcl_AppendResult(interp, "child process exited abnormally",
		(char *) NULL);
    }

    return result;
}

static struct exp_cmd_data
cmd_data[]  = {
{"stty",	exp_proc(Exp_SttyCmd),	0,	0},
{"system",	exp_proc(Exp_SystemCmd),	0,	0},
{0}};

void
exp_init_tty_cmds(interp)
struct Tcl_Interp *interp;
{
	exp_create_commands(interp,cmd_data);
}






Deleted exp_tty.h.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

/* exp_tty.h - tty support definitions

Design and implementation of this program was paid for by U.S. tax
dollars.  Therefore it is public domain.  However, the author and NIST
would appreciate credit if this program or parts of it are used.
*/

#ifndef __EXP_TTY_H__
#define __EXP_TTY_H__

#include "expect_cf.h"

extern int exp_dev_tty;
extern int exp_ioctled_devtty;
extern int exp_stdin_is_tty;
extern int exp_stdout_is_tty;

void exp_tty_raw();
void exp_tty_echo();
void exp_tty_break();
int exp_tty_raw_noecho();
int exp_israw();
int exp_isecho();

void exp_tty_set();
int exp_tty_set_simple();
int exp_tty_get_simple();

#endif	/* __EXP_TTY_H__ */






Deleted exp_tty_comm.c.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37







































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

/* exp_tty_comm.c - tty support routines common to both Expect program
   and library */

#include "expect_cf.h"
#include <stdio.h>

#include "tcl.h"
#include "exp_tty_in.h"
#include "exp_rename.h"
#include "expect_comm.h"
#include "exp_command.h"
#include "exp_log.h"

#ifndef TRUE
#define FALSE 0
#define TRUE 1
#endif

int exp_disconnected = FALSE;		/* not disc. from controlling tty */

/*static*/ exp_tty exp_tty_current, exp_tty_cooked;
#define tty_current exp_tty_current
#define tty_cooked exp_tty_cooked

void
exp_init_tty()
{
	extern exp_tty exp_tty_original;

	/* save original user tty-setting in 'cooked', just in case user */
	/* asks for it without earlier telling us what cooked means to them */
	tty_cooked = exp_tty_original;

	/* save our current idea of the terminal settings */
	tty_current = exp_tty_original;
}







Deleted exp_tty_in.h.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100






































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

/* exp_tty_in.h - internal tty support definitions */

/* Definitions for handling termio inclusion are localized here */
/* This file should be included only if direct access to tty structures are */
/* required.  This file is necessary to avoid  mismatch between gcc's and */
/* vendor's include files */

/* Written by Rob Savoye <[email protected]>. Mon Feb 22 11:16:53 RMT 1993 */

#ifndef __EXP_TTY_IN_H__
#define __EXP_TTY_IN_H__

#include "expect_cf.h"

#ifdef __MACHTEN__
#include "sys/types.h"
#endif

/*
 * Set up some macros to isolate tty differences
 */

/* On some hosts, termio is incomplete (broken) and sgtty is a better
choice.  At the same time, termio has some definitions for modern
stuff like window sizes that sgtty lacks - that's why termio.h
is included even when we claim the basic style is sgtty
*/

/* test for pyramid may be unnecessary, but only Pyramid people have */
/* complained - notably [email protected] (Rick) */
#if defined(pyr) && defined(HAVE_TERMIO) && defined(HAVE_SGTTYB)
#undef HAVE_SGTTYB
#endif

/* on ISC SVR3.2, termios is skeletal and termio is a better choice.  */
/* sgttyb must also be avoided because it redefines same things that */
/* termio does */
/* note that both SVR3.2 and AIX lacks TCGETS or TCGETA in termios.h */
/* but SVR3.2 lacks both TCSETATTR and TCGETS/A */
#if defined(HAVE_TERMIO) && defined(HAVE_TERMIOS) && !defined(HAVE_TCGETS_OR_TCGETA_IN_TERMIOS_H) && !defined(HAVE_TCSETATTR)
# undef HAVE_TERMIOS
# undef HAVE_SGTTYB
#endif

#if defined(HAVE_TERMIO) && !defined(HAVE_TERMIOS)
#  include <termio.h>
#  undef POSIX
#  define TERMINAL termio
#  ifndef TCGETS
#    define TCGETS	TCGETA
#    define TCSETS	TCSETA
#    define TCSETSW	TCSETAW
#    define TCSETSF	TCSETAF
#  endif
#endif

#if defined(HAVE_SGTTYB) && !defined(HAVE_TERMIOS)
#  undef HAVE_TERMIO
#  undef POSIX
#ifndef TCGETS
#  define TCGETS	TIOCGETP
#  define TCSETS	TIOCSETP
#endif
#ifndef TCSETSW
#  define TCSETSW	TIOCSETN
#endif
#  define TERMINAL sgttyb
#  ifdef HAVE_SYS_FCNTL_H
#    include <sys/fcntl.h>
#  else
#    include <fcntl.h>
#  endif
#  include <sgtty.h>
#  include <sys/ioctl.h>
#endif


#if defined(HAVE_TERMIOS)
#  undef HAVE_TERMIO
#  undef HAVE_SGTTYB
#  include <termios.h>
#  define TERMINAL termios
#  if !defined(TCGETS) || !defined(TCSETS)
#    define TCGETS	TCGETA
#    define TCSETS	TCSETA
#    define TCSETSW	TCSETAW
#    define TCSETSF	TCSETAF
#  endif
#endif

/* This section was written by: Don Libes, NIST, 2/6/90 */

typedef struct TERMINAL exp_tty;
extern exp_tty exp_tty_original;
extern exp_tty exp_tty_current;
extern exp_tty exp_tty_cooked;

#include "exp_tty.h"

#endif	/* __EXP_TTY_IN_H__ */






Deleted exp_win.c.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205















































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

/* exp_win.c - window support

Written by: Don Libes, NIST, 10/25/93

This file is in the public domain.  However, the author and NIST
would appreciate credit if you use this file or parts of it.

*/

#include "expect_cf.h"
#include "tcl.h"

#ifdef NO_STDLIB_H
#include "../compat/stdlib.h"
#else
#include <stdlib.h>
#endif

/* _IBCS2 required on some Intel platforms to allow the include files */
/* to produce a definition for winsize. */
#define _IBCS2 1

/*
 * get everyone's window size definitions
 *
note that this is tricky because (of course) everyone puts them in
different places.  Worse, on some systems, some .h files conflict
and cannot both be included even though both exist.  This is the
case, for example, on SunOS 4.1.3 using gcc where termios.h
conflicts with sys/ioctl.h
 */

#ifdef HAVE_TERMIOS
#  include <termios.h>
#else
#  include <sys/ioctl.h>
#endif

/* Sigh.  On AIX 2.3, termios.h exists but does not define TIOCGWINSZ */
/* Instead, it has to come from ioctl.h.  However, As I said above, this */
/* can't be cavalierly included on all machines, even when it exists. */
#if defined(HAVE_TERMIOS) && !defined(HAVE_TIOCGWINSZ_IN_TERMIOS_H)
#  include <sys/ioctl.h>
#endif

/* SCO defines window size structure in PTEM and TIOCGWINSZ in termio.h */
/* Sigh... */
#if defined(HAVE_SYS_PTEM_H)
#   include <sys/types.h>   /* for stream.h's caddr_t */
#   include <sys/stream.h>  /* for ptem.h's mblk_t */
#   include <sys/ptem.h>
#endif /* HAVE_SYS_PTEM_H */

#include "exp_tty.h"
#include "exp_win.h"

#ifdef TIOCGWINSZ
typedef struct winsize exp_winsize;
#define columns ws_col
#define rows ws_row
#define EXP_WIN
#endif

#if !defined(EXP_WIN) && defined(TIOCGSIZE)
typedef struct ttysize exp_winsize;
#define columns ts_cols
#define rows ts_lines
#define EXP_WIN
#endif

#if !defined(EXP_WIN)
typedef struct {
	int columns;
	int rows;
} exp_winsize;
#endif

static exp_winsize winsize = {0, 0};
static exp_winsize win2size = {0, 0};

int exp_window_size_set(fd)
int fd;
{
#ifdef TIOCSWINSZ
	ioctl(fd,TIOCSWINSZ,&winsize);
#endif
#if defined(TIOCSSIZE) && !defined(TIOCSWINSZ)
	ioctl(fd,TIOCSSIZE,&winsize);
#endif
}

int exp_window_size_get(fd)
int fd;
{
#ifdef TIOCGWINSZ
	ioctl(fd,TIOCGWINSZ,&winsize);
#endif
#if defined(TIOCGSIZE) && !defined(TIOCGWINSZ)
	ioctl(fd,TIOCGSIZE,&winsize);
#endif
#if !defined(EXP_WIN)
	winsize.rows = 0;
	winsize.columns = 0;
#endif
}

void
exp_win_rows_set(rows)
char *rows;
{
	winsize.rows = atoi(rows);
	exp_window_size_set(exp_dev_tty);
}

void
exp_win_rows_get(rows)
char *rows;
{
	exp_window_size_get(exp_dev_tty);
	sprintf(rows,"%d",winsize.rows);
}

void
exp_win_columns_set(columns)
char *columns;
{
	winsize.columns = atoi(columns);
	exp_window_size_set(exp_dev_tty);
}

void
exp_win_columns_get(columns)
char *columns;
{
	exp_window_size_get(exp_dev_tty);
	sprintf(columns,"%d",winsize.columns);
}

/*
 * separate copy of everything above - used for handling user stty requests
 */

int exp_win2_size_set(fd)
int fd;
{
#ifdef TIOCSWINSZ
			ioctl(fd,TIOCSWINSZ,&win2size);
#endif
#if defined(TIOCSSIZE) && !defined(TIOCSWINSZ)
			ioctl(fd,TIOCSSIZE,&win2size);
#endif
}

int exp_win2_size_get(fd)
int fd;
{
#ifdef TIOCGWINSZ
	ioctl(fd,TIOCGWINSZ,&win2size);
#endif
#if defined(TIOCGSIZE) && !defined(TIOCGWINSZ)
	ioctl(fd,TIOCGSIZE,&win2size);
#endif
}

void
exp_win2_rows_set(fd,rows)
int fd;
char *rows;
{
	exp_win2_size_get(fd);
	win2size.rows = atoi(rows);
	exp_win2_size_set(fd);
}

void
exp_win2_rows_get(fd,rows)
int fd;
char *rows;
{
	exp_win2_size_get(fd);
	sprintf(rows,"%d",win2size.rows);
#if !defined(EXP_WIN)
	win2size.rows = 0;
	win2size.columns = 0;
#endif
}

void
exp_win2_columns_set(fd,columns)
int fd;
char *columns;
{
	exp_win2_size_get(fd);
	win2size.columns = atoi(columns);
	exp_win2_size_set(fd);
}

void
exp_win2_columns_get(fd,columns)
int fd;
char *columns;
{
	exp_win2_size_get(fd);
	sprintf(columns,"%d",win2size.columns);
}






Deleted exp_win.h.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20






















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

/* exp_win.h - window support

Written by: Don Libes, NIST, 10/25/93

This file is in the public domain.  However, the author and NIST
would appreciate credit if you use this file or parts of it.
*/

int exp_window_size_set();
int exp_window_size_get();

void exp_win_rows_set();
void exp_win_rows_get();
void exp_win_columns_set();
void exp_win_columns_get();

void exp_win2_rows_set();
void exp_win2_rows_get();
void exp_win2_columns_set();
void exp_win2_columns_get();






Deleted expect.c.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844
2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
3012
3013







































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

/* expect.c - expect commands

Written by: Don Libes, NIST, 2/6/90

Design and implementation of this program was paid for by U.S. tax
dollars.  Therefore it is public domain.  However, the author and NIST
would appreciate credit if this program or parts of it are used.

*/

#include <sys/types.h>
#include <stdio.h>
#include <signal.h>
#include <errno.h>
#include <ctype.h>	/* for isspace */
#include <time.h>	/* for time(3) */

#include "expect_cf.h"

#ifdef HAVE_SYS_WAIT_H
#include <sys/wait.h>
#endif

#ifdef HAVE_UNISTD_H
# include <unistd.h>
#endif

#include "tcl.h"

#include "string.h"

#include "exp_rename.h"
#include "exp_prog.h"
#include "exp_command.h"
#include "exp_log.h"
#include "exp_event.h"
#include "exp_tty.h"
#include "exp_tstamp.h"	/* this should disappear when interact */
			/* loses ref's to it */
#ifdef TCL_DEBUGGER
#include "tcldbg.h"
#endif

/* initial length of strings that we can guarantee patterns can match */
int exp_default_match_max =	2000;
#define INIT_EXPECT_TIMEOUT_LIT	"10"	/* seconds */
#define INIT_EXPECT_TIMEOUT	10	/* seconds */
int exp_default_parity =	TRUE;
int exp_default_rm_nulls =	TRUE;

/* user variable names */
#define EXPECT_TIMEOUT		"timeout"
#define EXPECT_OUT		"expect_out"

typedef struct ThreadSpecificData {
    int timeout;
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;

/*
 * addr of these placeholders appear as clientData in ExpectCmd * when called
 * as expect_user and expect_tty.  It would be nicer * to invoked
 * expDevttyGet() but C doesn't allow this in an array initialization, sigh.
 */
static ExpState StdinoutPlaceholder;
static ExpState DevttyPlaceholder;

/* 1 ecase struct is reserved for each case in the expect command.  Note that
eof/timeout don't use any of theirs, but the algorithm is simpler this way. */

struct ecase {	/* case for expect command */
	struct exp_i	*i_list;
	Tcl_Obj *pat;	/* original pattern spec */
	Tcl_Obj *body;	/* ptr to body to be executed upon match */
#define PAT_EOF		1
#define PAT_TIMEOUT	2
#define PAT_DEFAULT	3
#define PAT_FULLBUFFER	4
#define PAT_GLOB	5 /* glob-style pattern list */
#define PAT_RE		6 /* regular expression */
#define PAT_EXACT	7 /* exact string */
#define PAT_NULL	8 /* ASCII 0 */
#define PAT_TYPES	9 /* used to size array of pattern type descriptions */
	int use;	/* PAT_XXX */
	int simple_start;/* offset from start of buffer denoting where a */
			/* glob or exact match begins */
	int transfer;	/* if false, leave matched chars in input stream */
	int indices;	/* if true, write indices */
	int iread;	/* if true, reread indirects */
	int timestamp;	/* if true, write timestamps */
#define CASE_UNKNOWN	0
#define CASE_NORM	1
#define CASE_LOWER	2
	int Case;	/* convert case before doing match? */
};

/* descriptions of the pattern types, used for debugging */
char *pattern_style[PAT_TYPES];

struct exp_cases_descriptor {
	int count;
	struct ecase **cases;
};

/* This describes an Expect command */
static
struct exp_cmd_descriptor {
	int cmdtype;			/* bg, before, after */
	int duration;			/* permanent or temporary */
	int timeout_specified_by_flag;	/* if -timeout flag used */
	int timeout;			/* timeout period if flag used */
	struct exp_cases_descriptor ecd;
	struct exp_i *i_list;
} exp_cmds[4];
/* note that exp_cmds[FG] is just a fake, the real contents is stored
   in some dynamically-allocated variable.  We use exp_cmds[FG] mostly
   as a well-known address and also as a convenience and so we allocate
   just a few of its fields that we need. */

static void
exp_cmd_init(cmd,cmdtype,duration)
struct exp_cmd_descriptor *cmd;
int duration;
int cmdtype;
{
	cmd->duration = duration;
	cmd->cmdtype = cmdtype;
	cmd->ecd.cases = 0;
	cmd->ecd.count = 0;
	cmd->i_list = 0;
}

static int i_read_errno;/* place to save errno, if i_read() == -1, so it
			   doesn't get overwritten before we get to read it */

#ifdef SIMPLE_EVENT
static int alarm_fired;	/* if alarm occurs */
#endif

void exp_background_channelhandlers_run_all();

/* exp_indirect_updateX is called by Tcl when an indirect variable is set */
static char *exp_indirect_update1();	/* 1-part Tcl variable names */
static char *exp_indirect_update2();	/* 2-part Tcl variable names */

#ifdef SIMPLE_EVENT
/*ARGSUSED*/
static RETSIGTYPE
sigalarm_handler(n)
int n;		       	/* unused, for compatibility with STDC */
{
	alarm_fired = TRUE;
}
#endif /*SIMPLE_EVENT*/

/* free up everything in ecase */
static void
free_ecase(interp,ec,free_ilist)
Tcl_Interp *interp;
struct ecase *ec;
int free_ilist;		/* if we should free ilist */
{
    if (ec->i_list->duration == EXP_PERMANENT) {
	if (ec->pat) Tcl_DecrRefCount(ec->pat);
	if (ec->body) Tcl_DecrRefCount(ec->body);
    }

    if (free_ilist) {
	ec->i_list->ecount--;
	if (ec->i_list->ecount == 0)
	    exp_free_i(interp,ec->i_list,exp_indirect_update2);
    }

    ckfree((char *)ec);	/* NEW */
}

/* free up any argv structures in the ecases */
static void
free_ecases(interp,eg,free_ilist)
Tcl_Interp *interp;
struct exp_cmd_descriptor *eg;
int free_ilist;		/* if true, free ilists */
{
	int i;

	if (!eg->ecd.cases) return;

	for (i=0;i<eg->ecd.count;i++) {
		free_ecase(interp,eg->ecd.cases[i],free_ilist);
	}
	ckfree((char *)eg->ecd.cases);

	eg->ecd.cases = 0;
	eg->ecd.count = 0;
}


#if 0
/* no standard defn for this, and some systems don't even have it, so avoid */
/* the whole quagmire by calling it something else */
static char *exp_strdup(s)
char *s;
{
	char *news = ckalloc(strlen(s) + 1);
	strcpy(news,s);
	return(news);
}
#endif

/* In many places, there is no need to malloc a copy of a string, since it */
/* will be freed before we return to Tcl */
static void
save_str(lhs,rhs,nosave)
char **lhs;	/* left hand side */
char *rhs;	/* right hand side */
int nosave;
{
	if (nosave || (rhs == 0)) {
		*lhs = rhs;
	} else {
		*lhs = ckalloc(strlen(rhs) + 1);
		strcpy(*lhs,rhs);
	}
}

/* return TRUE if string appears to be a set of arguments
   The intent of this test is to support the ability of commands to have
   all their args braced as one.  This conflicts with the possibility of
   actually intending to have a single argument.
   The bad case is in expect which can have a single argument with embedded
   \n's although it's rare.  Examples that this code should handle:
   \n		FALSE (pattern)
   \n\n		FALSE
   \n  \n \n	FALSE
   foo		FALSE
   foo\n	FALSE
   \nfoo\n	TRUE  (set of args)
   \nfoo\nbar	TRUE

   Current test is very cheap and almost always right :-)
*/
int 
exp_one_arg_braced(objPtr)	/* INTL */
Tcl_Obj *objPtr;
{
	int seen_nl = FALSE;
	char *p = Tcl_GetString(objPtr);

	for (;*p;p++) {
		if (*p == '\n') {
			seen_nl = TRUE;
			continue;
		}

		if (!isspace(*p)) { /* INTL: ISO space */
			return(seen_nl);
		}
	}
	return FALSE;
}

/* called to execute a command of only one argument - a hack to commands */
/* to be called with all args surrounded by an outer set of braces */
/* returns TCL_whatever */
/*ARGSUSED*/
int
exp_eval_with_one_arg(clientData,interp,objv) /* INTL */
ClientData clientData;
Tcl_Interp *interp;
Tcl_Obj *CONST objv[];		/* Argument objects. */
{
#define NUM_STATIC_OBJS 20
    Tcl_Obj *staticObjArray[NUM_STATIC_OBJS];
    int maxobjs = NUM_STATIC_OBJS;
    Tcl_Token *tokenPtr;
    char *p, *next;
    int rc;
    Tcl_Obj **objs = staticObjArray;
    int objc, bytesLeft, numWords, i;
    Tcl_Parse parse;

    /*
     * Prepend the command name and the -nobrace switch so we can
     * reinvoke without recursing.
     */
    objc = 2;
    objs[0] = objv[0];
    objs[1] = Tcl_NewStringObj("-nobrace", -1);
    Tcl_IncrRefCount(objs[0]);
    Tcl_IncrRefCount(objs[1]);

    p = Tcl_GetStringFromObj(objv[1], &bytesLeft);

    /*
     * Treat the pattern/action block like a series of Tcl commands.
     * For each command, parse the command words, perform substititions
     * on each word, and add the words to an array of values.  We don't
     * actually evaluate the individual commands, just the substitutions.
     */

    do {
	if (Tcl_ParseCommand(interp, p, bytesLeft, 0, &parse)
	        != TCL_OK) {
	    rc = TCL_ERROR;
	    goto done;
	}
	numWords = parse.numWords;
 	if (numWords > 0) {
	    /*
	     * Generate an array of objects for the words of the command.
	     */
    
	    if (objc + numWords > maxobjs) {
		Tcl_Obj ** newobjs;
		maxobjs = (objc + numWords) * 2;
		newobjs = (Tcl_Obj **)ckalloc(maxobjs * sizeof (Tcl_Obj *));
		memcpy(newobjs, objs, objc*sizeof(Tcl_Obj *));
		if (objs != staticObjArray) {
		    ckfree((char*)objs);
		}
		objs = newobjs;   
	    }

	    /*
	     * For each word, perform substitutions then store the
	     * result in the objs array.
	     */
	    
	    for (tokenPtr = parse.tokenPtr; numWords > 0;
		 numWords--, tokenPtr += (tokenPtr->numComponents + 1)) {
		objs[objc] = Tcl_EvalTokens(interp, tokenPtr+1,
			tokenPtr->numComponents);
		if (objs[objc] == NULL) {
		    rc = TCL_ERROR;
		    goto done;
		}
		objc++;
	    }
	}

	/*
	 * Advance to the next command in the script.
	 */
	next = parse.commandStart + parse.commandSize;
	bytesLeft -= next - p;
	p = next;
	Tcl_FreeParse(&parse);
    } while (bytesLeft > 0);

    /*
     * Now evaluate the entire command with no further substitutions.
     */

    rc = Tcl_EvalObjv(interp, objc, objs, 0);
 done:
    for (i = 0; i < objc; i++) {
	Tcl_DecrRefCount(objs[i]);
    }
    if (objs != staticObjArray) {
	ckfree((char *) objs);
    }
    return(rc);
#undef NUM_STATIC_OBJS
}

static void
ecase_clear(ec)
struct ecase *ec;
{
	ec->i_list = 0;
	ec->pat = 0;
	ec->body = 0;
	ec->transfer = TRUE;
	ec->indices = FALSE;
	ec->iread = FALSE;
	ec->timestamp = FALSE;
	ec->Case = CASE_NORM;
	ec->use = PAT_GLOB;
}

static struct ecase *
ecase_new()
{
	struct ecase *ec = (struct ecase *)ckalloc(sizeof(struct ecase));

	ecase_clear(ec);
	return ec;
}

/*

parse_expect_args parses the arguments to expect or its variants. 
It normally returns TCL_OK, and returns TCL_ERROR for failure.
(It can't return i_list directly because there is no way to differentiate
between clearing, say, expect_before and signalling an error.)

eg (expect_global) is initialized to reflect the arguments parsed
eg->ecd.cases is an array of ecases
eg->ecd.count is the # of ecases
eg->i_list is a linked list of exp_i's which represent the -i info

Each exp_i is chained to the next so that they can be easily free'd if
necessary.  Each exp_i has a reference count.  If the -i is not used
(e.g., has no following patterns), the ref count will be 0.

Each ecase points to an exp_i.  Several ecases may point to the same exp_i.
Variables named by indirect exp_i's are read for the direct values.

If called from a foreground expect and no patterns or -i are given, a
default exp_i is forced so that the command "expect" works right.

The exp_i chain can be broken by the caller if desired.

*/

static int
parse_expect_args(interp,eg,default_esPtr,objc,objv)
Tcl_Interp *interp;
struct exp_cmd_descriptor *eg;
ExpState *default_esPtr;	/* suggested ExpState if called as expect_user or _tty */
int objc;
Tcl_Obj *CONST objv[];		/* Argument objects. */
{
    int i;
    char *string;
    struct ecase ec;	/* temporary to collect args */

    eg->timeout_specified_by_flag = FALSE;

    ecase_clear(&ec);

    /* Allocate an array to store the ecases.  Force array even if 0 */
    /* cases.  This will often be too large (i.e., if there are flags) */
    /* but won't affect anything. */

    eg->ecd.cases = (struct ecase **)ckalloc(sizeof(struct ecase *) * (1+(objc/2)));

    eg->ecd.count = 0;

    for (i = 1;i<objc;i++) {
	int index;
	string = Tcl_GetString(objv[i]);
	if (string[0] == '-') {
	    static char *flags[] = {
		"-glob", "-regexp", "-exact", "-notransfer", "-nocase",
		"-i", "-indices", "-iread", "-timestamp", "-timeout",
		"-nobrace", "--", (char *)0
	    };
	    enum flags {
		EXP_ARG_GLOB, EXP_ARG_REGEXP, EXP_ARG_EXACT,
		EXP_ARG_NOTRANSFER, EXP_ARG_NOCASE, EXP_ARG_SPAWN_ID,
		EXP_ARG_INDICES, EXP_ARG_IREAD, EXP_ARG_TIMESTAMP,
		EXP_ARG_DASH_TIMEOUT, EXP_ARG_NOBRACE, EXP_ARG_DASH
	    };

	    /*
	     * Allow abbreviations of switches and report an error if we
	     * get an invalid switch.
	     */

	    if (Tcl_GetIndexFromObj(interp, objv[i], flags, "flag", 0,
		    &index) != TCL_OK) {
		return TCL_ERROR;
	    }
	    switch ((enum flags) index) {
	    case EXP_ARG_GLOB:
	    case EXP_ARG_DASH:
		i++;
		/* assignment here is not actually necessary */
		/* since cases are initialized this way above */
		/* ec.use = PAT_GLOB; */
		if (i >= objc) {
		    Tcl_WrongNumArgs(interp, 1, objv,"-glob pattern");
		    return TCL_ERROR;
		}
		goto pattern;
	    case EXP_ARG_REGEXP:
		i++;
		if (i >= objc) {
		    Tcl_WrongNumArgs(interp, 1, objv,"-regexp regexp");
		    return TCL_ERROR;
		}
		ec.use = PAT_RE;

		/*
		 * Try compiling the expression so we can report
		 * any errors now rather then when we first try to
		 * use it.
		 */

		if (!(Tcl_GetRegExpFromObj(interp, objv[i],
					   TCL_REG_ADVANCED))) {
		    goto error;
		}
		goto pattern;
	    case EXP_ARG_EXACT:
		i++;
		if (i >= objc) {
		    Tcl_WrongNumArgs(interp, 1, objv, "-exact string");
		    return TCL_ERROR;
		}
		ec.use = PAT_EXACT;
		goto pattern;
	    case EXP_ARG_NOTRANSFER:
		ec.transfer = 0;
		break;
	    case EXP_ARG_NOCASE:
		ec.Case = CASE_LOWER;
		break;
	    case EXP_ARG_SPAWN_ID:
		i++;
		if (i>=objc) {
		    Tcl_WrongNumArgs(interp, 1, objv, "-i spawn_id");
		    goto error;
		}
		ec.i_list = exp_new_i_complex(interp,
				      Tcl_GetString(objv[i]),
				      eg->duration, exp_indirect_update2);
		ec.i_list->cmdtype = eg->cmdtype;

		/* link new i_list to head of list */
		ec.i_list->next = eg->i_list;
		eg->i_list = ec.i_list;
		break;
	    case EXP_ARG_INDICES:
		ec.indices = TRUE;
		break;
	    case EXP_ARG_IREAD:
		ec.iread = TRUE;
		break;
	    case EXP_ARG_TIMESTAMP:
		ec.timestamp = TRUE;
		break;
	    case EXP_ARG_DASH_TIMEOUT:
		i++;
		if (i>=objc) {
		    Tcl_WrongNumArgs(interp, 1, objv, "-timeout seconds");
		    goto error;
		}
		if (Tcl_GetIntFromObj(interp, objv[i],
				      &eg->timeout) != TCL_OK) {
		    goto error;
		}
		eg->timeout_specified_by_flag = TRUE;
		break;
	    case EXP_ARG_NOBRACE:
		/* nobrace does nothing but take up space */
		/* on the command line which prevents */
		/* us from re-expanding any command lines */
		/* of one argument that looks like it should */
		/* be expanded to multiple arguments. */
		break;
	    }
	    /*
	     * Keep processing arguments, we aren't ready for the
	     * pattern yet.
	     */
	    continue;
	} else {
	    /*
	     * We have a pattern or keyword.
	     */

	    static char *keywords[] = {
		"timeout", "eof", "full_buffer", "default", "null",
		(char *)NULL
	    };
	    enum keywords {
		EXP_ARG_TIMEOUT, EXP_ARG_EOF, EXP_ARG_FULL_BUFFER,
		EXP_ARG_DEFAULT, EXP_ARG_NULL
	    };

	    /*
	     * Match keywords exactly, otherwise they are patterns.
	     */

	    if (Tcl_GetIndexFromObj(interp, objv[i], keywords, "keyword",
		    1 /* exact */, &index) != TCL_OK) {
		Tcl_ResetResult(interp);
		goto pattern;
	    }
	    switch ((enum keywords) index) {
	    case EXP_ARG_TIMEOUT:
		ec.use = PAT_TIMEOUT;
		break;
	    case EXP_ARG_EOF:
		ec.use = PAT_EOF;
		break;
	    case EXP_ARG_FULL_BUFFER:
		ec.use = PAT_FULLBUFFER;
		break;
	    case EXP_ARG_DEFAULT:
		ec.use = PAT_DEFAULT;
		break;
	    case EXP_ARG_NULL:
		ec.use = PAT_NULL;
		break;
	    }
pattern:
	    /* if no -i, use previous one */
	    if (!ec.i_list) {
		/* if no -i flag has occurred yet, use default */
		if (!eg->i_list) {
		    if (default_esPtr != EXP_SPAWN_ID_BAD) {
			eg->i_list = exp_new_i_simple(default_esPtr,eg->duration);
		    } else {
		        default_esPtr = expStateCurrent(interp,0,0,1);
		        if (!default_esPtr) goto error;
		        eg->i_list = exp_new_i_simple(default_esPtr,eg->duration);
		    }
		}
		ec.i_list = eg->i_list;
	    }
	    ec.i_list->ecount++;

	    /* save original pattern spec */
	    /* keywords such as "-timeout" are saved as patterns here */
	    /* useful for debugging but not otherwise used */

	    ec.pat = objv[i];
	    if (eg->duration == EXP_PERMANENT) Tcl_IncrRefCount(ec.pat);

	    i++;
	    if (i < objc) {
		ec.body = objv[i];
		if (eg->duration == EXP_PERMANENT) Tcl_IncrRefCount(ec.body);
	    } else {
		ec.body = NULL;
	    }

	    *(eg->ecd.cases[eg->ecd.count] = ecase_new()) = ec;

		/* clear out for next set */
	    ecase_clear(&ec);

	    eg->ecd.count++;
	}
    }

    /* if no patterns at all have appeared force the current */
    /* spawn id to be added to list anyway */

    if (eg->i_list == 0) {
	if (default_esPtr != EXP_SPAWN_ID_BAD) {
	    eg->i_list = exp_new_i_simple(default_esPtr,eg->duration);
	} else {
	    default_esPtr = expStateCurrent(interp,0,0,1);
	    if (!default_esPtr) goto error;
	    eg->i_list = exp_new_i_simple(default_esPtr,eg->duration);
	}
    }

    return(TCL_OK);

 error:
    /* very hard to free case_master_list here if it hasn't already */
    /* been attached to a case, ugh */

    /* note that i_list must be avail to free ecases! */
    free_ecases(interp,eg,0);

    if (eg->i_list)
	exp_free_i(interp,eg->i_list,exp_indirect_update2);
    return(TCL_ERROR);
}

#define EXP_IS_DEFAULT(x)	((x) == EXP_TIMEOUT || (x) == EXP_EOF)

static char yes[] = "yes\r\n";
static char no[] = "no\r\n";

/* this describes status of a successful match */
struct eval_out {
    struct ecase *e;		/* ecase that matched */
    ExpState *esPtr;		/* ExpState that matched */
    Tcl_Obj *buffer;		/* buffer that matched */
    int match;			/* # of bytes in buffer that matched */
			        /* or # of bytes in buffer at EOF */
};




/*
 *----------------------------------------------------------------------
 *
 * string_case_first --
 *
 *	Find the first instance of a pattern in a string.
 *
 * Results:
 *	Returns the pointer to the first instance of the pattern
 *	in the given string, or NULL if no match was found.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

char *
string_case_first(string,pattern)	/* INTL */
    register char *string;	/* String. */
    register char *pattern;	/* Pattern, which may contain
				 * special characters. */
{
    char *s, *p;
    int offset;
    Tcl_UniChar ch1, ch2;
    
    while (*string != 0) {
	s = string;
	p = pattern;
	while (*s) {
	    s += Tcl_UtfToUniChar(s, &ch1);
	    offset = Tcl_UtfToUniChar(p, &ch2);
	    if (Tcl_UniCharToLower(ch1) != Tcl_UniCharToLower(ch2)) {
		break;
	    }
	    p += offset;
	}
	if (*p == '\0') {
	    return string;
	}
	string++;
    }
    return NULL;
}

/* like eval_cases, but handles only a single cases that needs a real */
/* string match */
/* returns EXP_X where X is MATCH, NOMATCH, FULLBUFFER, TCLERRROR */
static int
eval_case_string(interp,e,esPtr,o,last_esPtr,last_case,suffix)
Tcl_Interp *interp;
struct ecase *e;
ExpState *esPtr;
struct eval_out *o;		/* 'output' - i.e., final case of interest */
/* next two args are for debugging, when they change, reprint buffer */
ExpState **last_esPtr;
int *last_case;
char *suffix;
{
    Tcl_Obj *buffer;
    Tcl_RegExp re;
    Tcl_RegExpInfo info;
    char *str;
    int length, flags;
    int result;

    buffer = esPtr->buffer;
    str = Tcl_GetStringFromObj(buffer, &length);

    /* if ExpState or case changed, redisplay debug-buffer */
    if ((esPtr != *last_esPtr) || e->Case != *last_case) {
	expDiagLog("\r\nexpect%s: does \"",suffix);
	expDiagLogU(expPrintify(str));
	expDiagLog("\" (spawn_id %s) match %s ",esPtr->name,pattern_style[e->use]);
	*last_esPtr = esPtr;
	*last_case = e->Case;
    }

    if (e->use == PAT_RE) {
	expDiagLog("\"");
	expDiagLogU(expPrintify(Tcl_GetString(e->pat)));
	expDiagLog("\"? ");
	if (e->Case == CASE_NORM) {
	    flags = TCL_REG_ADVANCED;
	} else {
	    flags = TCL_REG_ADVANCED | TCL_REG_NOCASE;
	}
		    
	re = Tcl_GetRegExpFromObj(interp, e->pat, flags);

	result = Tcl_RegExpExecObj(interp, re, buffer, 0 /* offset */,
		-1 /* nmatches */, 0 /* eflags */);
	if (result > 0) {

	    o->e = e;

	    /*
	     * Retrieve the byte offset of the end of the
	     * matched string.  
	     */

	    Tcl_RegExpGetInfo(re, &info);
	    o->match = Tcl_UtfAtIndex(str, info.matches[0].end) - str;
	    o->buffer = buffer;
	    o->esPtr = esPtr;
	    expDiagLogU(yes);
	    return(EXP_MATCH);
	} else if (result == 0) {
	    expDiagLogU(no);
	} else { /* result < 0 */
	    return(EXP_TCLERROR);
	}
    } else if (e->use == PAT_GLOB) {
	int match; /* # of bytes that matched */

	expDiagLog("\"");
	expDiagLogU(expPrintify(Tcl_GetString(e->pat)));
	expDiagLog("\"? ");
	if (buffer) {
	    match = Exp_StringCaseMatch(Tcl_GetString(buffer),
		    Tcl_GetString(e->pat),
		    (e->Case == CASE_NORM) ? 0 : 1,
		    &e->simple_start);
	    if (match != -1) {
		o->e = e;
		o->match = match;
		o->buffer = buffer;
		o->esPtr = esPtr;
		expDiagLogU(yes);
		return(EXP_MATCH);
	    }
	}
	expDiagLogU(no);
    } else if (e->use == PAT_EXACT) {
	int patLength;
	char *pat = Tcl_GetStringFromObj(e->pat, &patLength);
	char *p;

	if (e->Case == CASE_NORM) {
	    p = strstr(str, pat);
	} else {
	    p = string_case_first(str, pat);
	}	    

	expDiagLog("\"");
	expDiagLogU(expPrintify(Tcl_GetString(e->pat)));
	expDiagLog("\"? ");
	if (p) {
	    e->simple_start = p - str;
	    o->e = e;
	    o->match = patLength;
	    o->buffer = buffer;
	    o->esPtr = esPtr;
	    expDiagLogU(yes);
	    return(EXP_MATCH);
	} else expDiagLogU(no);
    } else if (e->use == PAT_NULL) {
	char *p;
	expDiagLogU("null? ");
	p = Tcl_UtfFindFirst(str, 0);

	if (p) {
	    o->e = e;
	    o->match = p-str;
	    o->buffer = buffer;
	    o->esPtr = esPtr;
	    expDiagLogU(yes);
	    return EXP_MATCH;
	}
	expDiagLogU(no);
    } else if ((Tcl_GetCharLength(esPtr->buffer) == esPtr->msize)
	    && (length > 0)) {
	expDiagLogU(Tcl_GetString(e->pat));
	expDiagLogU("? ");
	o->e = e;
	o->match = length;
	o->buffer = esPtr->buffer;
	o->esPtr = esPtr;
	expDiagLogU(yes);
	return(EXP_FULLBUFFER);
    }
    return(EXP_NOMATCH);
}

/* sets o.e if successfully finds a matching pattern, eof, timeout or deflt */
/* returns original status arg or EXP_TCLERROR */
static int
eval_cases(interp,eg,esPtr,o,last_esPtr,last_case,status,esPtrs,mcount,suffix)
Tcl_Interp *interp;
struct exp_cmd_descriptor *eg;
ExpState *esPtr;
struct eval_out *o;		/* 'output' - i.e., final case of interest */
/* next two args are for debugging, when they change, reprint buffer */
ExpState **last_esPtr;
int *last_case;
int status;
ExpState *(esPtrs[]);
int mcount;
char *suffix;
{
    int i;
    ExpState *em;   /* ExpState of ecase */
    struct ecase *e;

    if (o->e || status == EXP_TCLERROR || eg->ecd.count == 0) return(status);

    if (status == EXP_TIMEOUT) {
	for (i=0;i<eg->ecd.count;i++) {
	    e = eg->ecd.cases[i];
	    if (e->use == PAT_TIMEOUT || e->use == PAT_DEFAULT) {
		o->e = e;
		break;
	    }
	}
	return(status);
    } else if (status == EXP_EOF) {
	for (i=0;i<eg->ecd.count;i++) {
	    e = eg->ecd.cases[i];
	    if (e->use == PAT_EOF || e->use == PAT_DEFAULT) {
		struct exp_state_list *slPtr;

		for (slPtr=e->i_list->state_list; slPtr ;slPtr=slPtr->next) {
		    em = slPtr->esPtr;
		    if (expStateAnyIs(em) || em == esPtr) {
			o->e = e;
			return(status);
		    }
		}
	    }
	}
	return(status);
    }

    /* the top loops are split from the bottom loop only because I can't */
    /* split'em further. */

    /* The bufferful condition does not prevent a pattern match from */
    /* occurring and vice versa, so it is scanned with patterns */
    for (i=0;i<eg->ecd.count;i++) {
	struct exp_state_list *slPtr;
	int j;

	e = eg->ecd.cases[i];
	if (e->use == PAT_TIMEOUT ||
		e->use == PAT_DEFAULT ||
		e->use == PAT_EOF) continue;

	for (slPtr = e->i_list->state_list; slPtr; slPtr = slPtr->next) {
	    em = slPtr->esPtr;
	    /* if em == EXP_SPAWN_ID_ANY, then user is explicitly asking */
	    /* every case to be checked against every ExpState */
	    if (expStateAnyIs(em)) {
		/* test against each spawn_id */
		for (j=0;j<mcount;j++) {
		    status = eval_case_string(interp,e,esPtrs[j],o,
			    last_esPtr,last_case,suffix);
		    if (status != EXP_NOMATCH) return(status);
		}
	    } else {
		/* reject things immediately from wrong spawn_id */
		if (em != esPtr) continue;

		status = eval_case_string(interp,e,esPtr,o,last_esPtr,last_case,suffix);
		if (status != EXP_NOMATCH) return(status);
	    }
	}
    }
    return(EXP_NOMATCH);
}

static void
ecases_remove_by_expi(interp,ecmd,exp_i)
Tcl_Interp *interp;
struct exp_cmd_descriptor *ecmd;
struct exp_i *exp_i;
{
	int i;

	/* delete every ecase dependent on it */
	for (i=0;i<ecmd->ecd.count;) {
		struct ecase *e = ecmd->ecd.cases[i];
		if (e->i_list == exp_i) {
			free_ecase(interp,e,0);

			/* shift remaining elements down */
			/* but only if there are any left */
			if (i+1 != ecmd->ecd.count) {
				memcpy(&ecmd->ecd.cases[i],
				       &ecmd->ecd.cases[i+1],
					((ecmd->ecd.count - i) - 1) * 
					sizeof(struct exp_cmd_descriptor *));
			}
			ecmd->ecd.count--;
			if (0 == ecmd->ecd.count) {
				ckfree((char *)ecmd->ecd.cases);
				ecmd->ecd.cases = 0;
			}
		} else {
			i++;
		}
	}
}

/* remove exp_i from list */
static void
exp_i_remove(interp,ei,exp_i)
Tcl_Interp *interp;
struct exp_i **ei;	/* list to remove from */
struct exp_i *exp_i;	/* element to remove */
{
	/* since it's in middle of list, free exp_i by hand */
	for (;*ei; ei = &(*ei)->next) {
		if (*ei == exp_i) {
			*ei = exp_i->next;
			exp_i->next = 0;
			exp_free_i(interp,exp_i,exp_indirect_update2);
			break;
		}
	}
}

/* remove exp_i from list and remove any dependent ecases */
static void
exp_i_remove_with_ecases(interp,ecmd,exp_i)
Tcl_Interp *interp;
struct exp_cmd_descriptor *ecmd;
struct exp_i *exp_i;
{
	ecases_remove_by_expi(interp,ecmd,exp_i);
	exp_i_remove(interp,&ecmd->i_list,exp_i);
}

/* remove ecases tied to a single direct spawn id */
static void
ecmd_remove_state(interp,ecmd,esPtr,direct)
Tcl_Interp *interp;
struct exp_cmd_descriptor *ecmd;
ExpState *esPtr;
int direct;
{
    struct exp_i *exp_i, *next;
    struct exp_state_list **slPtr;

    for (exp_i=ecmd->i_list;exp_i;exp_i=next) {
	next = exp_i->next;

	if (!(direct & exp_i->direct)) continue;

	for (slPtr = &exp_i->state_list;*slPtr;) {
	    if (esPtr == ((*slPtr)->esPtr)) {
		struct exp_state_list *tmp = *slPtr;
		*slPtr = (*slPtr)->next;
		exp_free_state_single(tmp);

		/* if last bg ecase, disarm spawn id */
		if ((ecmd->cmdtype == EXP_CMD_BG) && (expStateAnyIs(esPtr))) {
		    esPtr->bg_ecount--;
		    if (esPtr->bg_ecount == 0) {
			exp_disarm_background_channelhandler(esPtr);
			esPtr->bg_interp = 0;
		    }
		}
		
		continue;
	    }
	    slPtr = &(*slPtr)->next;
	}

	/* if left with no ExpStates (and is direct), get rid of it */
	/* and any dependent ecases */
	if (exp_i->direct == EXP_DIRECT && !exp_i->state_list) {
	    exp_i_remove_with_ecases(interp,ecmd,exp_i);
	}
    }
}

/* this is called from exp_close to clean up the ExpState */
void
exp_ecmd_remove_state_direct_and_indirect(interp,esPtr)
Tcl_Interp *interp;
ExpState *esPtr;
{
	ecmd_remove_state(interp,&exp_cmds[EXP_CMD_BEFORE],esPtr,EXP_DIRECT|EXP_INDIRECT);
	ecmd_remove_state(interp,&exp_cmds[EXP_CMD_AFTER],esPtr,EXP_DIRECT|EXP_INDIRECT);
	ecmd_remove_state(interp,&exp_cmds[EXP_CMD_BG],esPtr,EXP_DIRECT|EXP_INDIRECT);

	/* force it - explanation in exp_tk.c where this func is defined */
	exp_disarm_background_channelhandler_force(esPtr);
}

/* arm a list of background ExpState's */
static void
state_list_arm(interp,slPtr)
Tcl_Interp *interp;
struct exp_state_list *slPtr;
{
    /* for each spawn id in list, arm if necessary */
    for (;slPtr;slPtr=slPtr->next) {
	ExpState *esPtr = slPtr->esPtr;    
	if (expStateAnyIs(esPtr)) continue;

	if (esPtr->bg_ecount == 0) {
	    exp_arm_background_channelhandler(esPtr);
	    esPtr->bg_interp = interp;
	}
	esPtr->bg_ecount++;
    }
}

/* return TRUE if this ecase is used by this fd */
static int
exp_i_uses_state(exp_i,esPtr)
struct exp_i *exp_i;
ExpState *esPtr;
{
	struct exp_state_list *fdp;

	for (fdp = exp_i->state_list;fdp;fdp=fdp->next) {
		if (fdp->esPtr == esPtr) return 1;
	}
	return 0;
}

static void
ecase_append(interp,ec)
Tcl_Interp *interp;
struct ecase *ec;
{
	if (!ec->transfer) Tcl_AppendElement(interp,"-notransfer");
	if (ec->indices) Tcl_AppendElement(interp,"-indices");
	if (!ec->Case) Tcl_AppendElement(interp,"-nocase");

	if (ec->use == PAT_RE) Tcl_AppendElement(interp,"-re");
	else if (ec->use == PAT_GLOB) Tcl_AppendElement(interp,"-gl");
	else if (ec->use == PAT_EXACT) Tcl_AppendElement(interp,"-ex");
	Tcl_AppendElement(interp,Tcl_GetString(ec->pat));
	Tcl_AppendElement(interp,ec->body?Tcl_GetString(ec->body):"");
}

/* append all ecases that match this exp_i */
static void
ecase_by_exp_i_append(interp,ecmd,exp_i)
Tcl_Interp *interp;
struct exp_cmd_descriptor *ecmd;
struct exp_i *exp_i;
{
	int i;
	for (i=0;i<ecmd->ecd.count;i++) {
		if (ecmd->ecd.cases[i]->i_list == exp_i) {
			ecase_append(interp,ecmd->ecd.cases[i]);
		}
	}
}

static void
exp_i_append(interp,exp_i)
Tcl_Interp *interp;
struct exp_i *exp_i;
{
	Tcl_AppendElement(interp,"-i");
	if (exp_i->direct == EXP_INDIRECT) {
		Tcl_AppendElement(interp,exp_i->variable);
	} else {
		struct exp_state_list *fdp;

		/* if more than one element, add braces */
		if (exp_i->state_list->next)
			Tcl_AppendResult(interp," {",(char *)0);

		for (fdp = exp_i->state_list;fdp;fdp=fdp->next) {
			char buf[10];	/* big enough for a small int */
			sprintf(buf,"%d",fdp->esPtr);
			Tcl_AppendElement(interp,buf);
		}

		if (exp_i->state_list->next)
			Tcl_AppendResult(interp,"} ",(char *)0);
	}
}

/* return current setting of the permanent expect_before/after/bg */
int
expect_info(interp,ecmd,objc,objv)
Tcl_Interp *interp;
struct exp_cmd_descriptor *ecmd;
int objc;
Tcl_Obj *CONST objv[];		/* Argument objects. */
{
    struct exp_i *exp_i;
    int i;
    int direct = EXP_DIRECT|EXP_INDIRECT;
    char *iflag = 0;
    int all = FALSE;	/* report on all fds */
    ExpState *esPtr = 0;

    static char *flags[] = {"-i", "-all", "-noindirect", (char *)0};
    enum flags {EXP_ARG_I, EXP_ARG_ALL, EXP_ARG_NOINDIRECT};

    /* start with 2 to skip over "cmdname -info" */
    for (i = 2;i<objc;i++) {
	/*
	 * Allow abbreviations of switches and report an error if we
	 * get an invalid switch.
	 */

	int index;
	if (Tcl_GetIndexFromObj(interp, objv[i], flags, "flag", 0,
				&index) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch ((enum flags) index) {
	case EXP_ARG_I:
	    i++;
	    if (i >= objc) {
		Tcl_WrongNumArgs(interp, 1, objv,"-i spawn_id");
		return TCL_ERROR;
	    }
	    break;
	case EXP_ARG_ALL:
	    all = TRUE;
	    break;
	case EXP_ARG_NOINDIRECT:
	    direct &= ~EXP_INDIRECT;
	    break;
	}
    }

    if (all) {
	/* avoid printing out -i when redundant */
	struct exp_i *previous = 0;

	for (i=0;i<ecmd->ecd.count;i++) {
	    if (previous != ecmd->ecd.cases[i]->i_list) {
		exp_i_append(interp,ecmd->ecd.cases[i]->i_list);
		previous = ecmd->ecd.cases[i]->i_list;
	    }
	    ecase_append(interp,ecmd->ecd.cases[i]);
	}
	return TCL_OK;
    }

    if (!iflag) {
	if (!(esPtr = expStateCurrent(interp,0,0,0))) {
	    return TCL_ERROR;
	}
    } else if (!(esPtr = expStateFromChannelName(interp,iflag,0,0,0,"dummy"))) {
	/* not a valid ExpState so assume it is an indirect variable */
	Tcl_ResetResult(interp);
	for (i=0;i<ecmd->ecd.count;i++) {
	    if (ecmd->ecd.cases[i]->i_list->direct == EXP_INDIRECT &&
		    streq(ecmd->ecd.cases[i]->i_list->variable,iflag)) {
		ecase_append(interp,ecmd->ecd.cases[i]);
	    }
	}
	return TCL_OK;
    }
    
    /* print ecases of this direct_fd */
    for (exp_i=ecmd->i_list;exp_i;exp_i=exp_i->next) {
	if (!(direct & exp_i->direct)) continue;
	if (!exp_i_uses_state(exp_i,esPtr)) continue;
	ecase_by_exp_i_append(interp,ecmd,exp_i);
    }

    return TCL_OK;
}

/* Exp_ExpectGlobalObjCmd is invoked to process expect_before/after/background */
/*ARGSUSED*/
int
Exp_ExpectGlobalObjCmd(clientData, interp, objc, objv)
ClientData clientData;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];		/* Argument objects. */
{
    int result = TCL_OK;
    struct exp_i *exp_i, **eip;
    struct exp_state_list *slPtr;   /* temp for interating over state_list */
    struct exp_cmd_descriptor eg;
    int count;

    struct exp_cmd_descriptor *ecmd = (struct exp_cmd_descriptor *) clientData;

    if ((objc == 2) && exp_one_arg_braced(objv[1])) {
	return(exp_eval_with_one_arg(clientData,interp,objv));
    } else if ((objc == 3) && streq(Tcl_GetString(objv[1]),"-brace")) {
	Tcl_Obj *new_objv[2];
	new_objv[0] = objv[0];
	new_objv[1] = objv[2];
	return(exp_eval_with_one_arg(clientData,interp,new_objv));
    }

    if (objc > 1 && (Tcl_GetString(objv[1])[0] == '-')) {
	if (exp_flageq("info",Tcl_GetString(objv[1])+1,4)) {
	    return(expect_info(interp,ecmd,objc,objv));
	} 
    }

    exp_cmd_init(&eg,ecmd->cmdtype,EXP_PERMANENT);

    if (TCL_ERROR == parse_expect_args(interp,&eg,EXP_SPAWN_ID_BAD,
	    objc,objv)) {
	return TCL_ERROR;
    }

    /*
     * visit each NEW direct exp_i looking for spawn ids.
     * When found, remove them from any OLD exp_i's.
     */

    /* visit each exp_i */
    for (exp_i=eg.i_list;exp_i;exp_i=exp_i->next) {
	if (exp_i->direct == EXP_INDIRECT) continue;

	/* for each spawn id, remove it from ecases */
	for (slPtr=exp_i->state_list;slPtr;slPtr=slPtr->next) {
	    ExpState *esPtr = slPtr->esPtr;

	    /* validate all input descriptors */
	    if (!expStateAnyIs(esPtr)) {
		if (!expStateCheck(interp,esPtr,1,1,"expect")) {
		    result = TCL_ERROR;
		    goto cleanup;
		}
	    }
	    
	    /* remove spawn id from exp_i */
	    ecmd_remove_state(interp,ecmd,esPtr,EXP_DIRECT);
	}
    }
	
    /*
     * For each indirect variable, release its old ecases and 
     * clean up the matching spawn ids.
     * Same logic as in "expect_X delete" command.
     */

    for (exp_i=eg.i_list;exp_i;exp_i=exp_i->next) {
	struct exp_i **old_i;

	if (exp_i->direct == EXP_DIRECT) continue;

	for (old_i = &ecmd->i_list;*old_i;) {
	    struct exp_i *tmp;

	    if (((*old_i)->direct == EXP_DIRECT) ||
		    (!streq((*old_i)->variable,exp_i->variable))) {
		old_i = &(*old_i)->next;
		continue;
	    }

	    ecases_remove_by_expi(interp,ecmd,*old_i);
	    
	    /* unlink from middle of list */
	    tmp = *old_i;
	    *old_i = tmp->next;
	    tmp->next = 0;
	    exp_free_i(interp,tmp,exp_indirect_update2);
	}

	/* if new one has ecases, update it */
	if (exp_i->ecount) {
	    char *msg = exp_indirect_update1(interp,ecmd,exp_i);
	    if (msg) {
		/* unusual way of handling error return */
		/* because of Tcl's variable tracing */
		strcpy(interp->result,msg);
		result = TCL_ERROR;
		goto indirect_update_abort;
	    }
	}
    }
    /* empty i_lists have to be removed from global eg.i_list */
    /* before returning, even if during error */
 indirect_update_abort:

    /*
     * New exp_i's that have 0 ecases indicate fd/vars to be deleted.
     * Now that the deletions have been done, discard the new exp_i's.
     */

    for (exp_i=eg.i_list;exp_i;) {
	struct exp_i *next = exp_i->next;

	if (exp_i->ecount == 0) {
	    exp_i_remove(interp,&eg.i_list,exp_i);
	}
	exp_i = next;
    }
    if (result == TCL_ERROR) goto cleanup;

    /*
     * arm all new bg direct fds
     */

    if (ecmd->cmdtype == EXP_CMD_BG) {
	for (exp_i=eg.i_list;exp_i;exp_i=exp_i->next) {
	    if (exp_i->direct == EXP_DIRECT) {
		state_list_arm(interp,exp_i->state_list);
	    }
	}
    }

    /*
     * now that old ecases are gone, add new ecases and exp_i's (both
     * direct and indirect).
     */

    /* append ecases */

    count = ecmd->ecd.count + eg.ecd.count;
    if (eg.ecd.count) {
	int start_index; /* where to add new ecases in old list */

	if (ecmd->ecd.count) {
	    /* append to end */
	    ecmd->ecd.cases = (struct ecase **)ckrealloc((char *)ecmd->ecd.cases, count * sizeof(struct ecase *));
	    start_index = ecmd->ecd.count;
	} else {
	    /* append to beginning */
	    ecmd->ecd.cases = (struct ecase **)ckalloc(eg.ecd.count * sizeof(struct ecase *));
	    start_index = 0;
	}
	memcpy(&ecmd->ecd.cases[start_index],eg.ecd.cases,
		eg.ecd.count*sizeof(struct ecase *));
	ecmd->ecd.count = count;
    }

    /* append exp_i's */
    for (eip = &ecmd->i_list;*eip;eip = &(*eip)->next) {
	/* empty loop to get to end of list */
    }
    /* *exp_i now points to end of list */

    *eip = eg.i_list;	/* connect new list to end of current list */

  cleanup:
    if (result == TCL_ERROR) {
	/* in event of error, free any unreferenced ecases */
	/* but first, split up i_list so that exp_i's aren't */
	/* freed twice */

	for (exp_i=eg.i_list;exp_i;) {
	    struct exp_i *next = exp_i->next;
	    exp_i->next = 0;
	    exp_i = next;
	}
	free_ecases(interp,&eg,1);
    } else {
	if (eg.ecd.cases) ckfree((char *)eg.ecd.cases);
    }

    if (ecmd->cmdtype == EXP_CMD_BG) {
	exp_background_channelhandlers_run_all();
    }

    return(result);
}

/* adjusts file according to user's size request */
void
expAdjust(esPtr)
ExpState *esPtr;
{
    int new_msize;
    int length;
    Tcl_Obj *newObj;
    char *string;
    int excessBytes;
    char *excessGuess;
    char *p;

    /*
     * Resize buffer to user's request * 2 + 1.
     * x2: in case the match straddles two bufferfuls.
     * +1: for trailing null.
     */

    new_msize = esPtr->umsize*2 + 1;

    if (new_msize != esPtr->msize) {
	string = Tcl_GetStringFromObj(esPtr->buffer, &length);
	if (length > new_msize) {
	    /*
	     * too much data, forget about data at beginning of buffer
	     */

	    excessBytes = length - new_msize;	/* initial guess */

	    /*
	     * Alas, string + excessBytes may be in the middle of a UTF char.
	     * Find out for sure.
	     */
	    excessGuess = string + excessBytes;
	    for (p=string;;p=Tcl_UtfNext(p)) {
		if (p >= excessGuess) break;
	    }

	    /* now we can calculate a valid # of excess bytes */
	    excessBytes = p - string;
	    newObj = Tcl_NewStringObj(string + excessBytes,length - excessBytes);
	} else {
	    /*
	     * too little data
	     */

	    /* first copy what's there */
	    newObj = Tcl_NewStringObj(string,length);

	    /*
	     * Force object to allocate a buffer at least new_msize bytes long,
	     * then reset correct string length.
	     */

	    Tcl_SetObjLength(newObj,new_msize);
	    Tcl_SetObjLength(newObj,length);
	}
	Tcl_IncrRefCount(newObj);
	Tcl_DecrRefCount(esPtr->buffer);
	esPtr->buffer = newObj;

	esPtr->key = expect_key++;
	esPtr->msize = new_msize;
    }
}

#if OBSOLETE
/* Strip parity */
static void
expParityStrip(obj,offsetBytes)
    Tcl_Obj *obj;
    int offsetBytes;
{
    char *p, ch;
    
    int changed = FALSE;
    
    for (p = Tcl_GetString(obj) + offsetBytes;*p;p++) {
	ch = *p & 0x7f;
	if (ch != *p) changed = TRUE;
	else *p &= 0x7f;
    }

    if (changed) {
	/* invalidate the unicode rep */
	if (obj->typePtr->freeIntRepProc) {
	    obj->typePtr->freeIntRepProc(obj);
	}
    }
}
#endif /*OBSOLETE*/

/* This function is only used when debugging.  It checks when a string's
   internal UTF is sane and whether an offset into the string appears to
   be at a UTF boundary.
*/
static void
expValid(obj,offset)
     Tcl_Obj *obj;
     int offset;
{
  char *s, *end;
  int len;

  s = Tcl_GetStringFromObj(obj,&len);

  if (offset > len) {
    printf("offset (%d) > length (%d)\n",offset,len);
    fflush(stdout);
    abort();
  }

  /* first test for null terminator */
  end = s + len;
  if (*end != '\0') {
    printf("obj lacks null terminator\n");
    fflush(stdout);
    abort();
  }

  /* check for valid UTF sequence */
  while (*s) {
    Tcl_UniChar uc;

    s += Tcl_UtfToUniChar(s,&uc);
    if (s > end) {
      printf("UTF out of sync with terminator\n");
      fflush(stdout);
      abort();
    }
  }
  s += offset;
  while (*s) {
    Tcl_UniChar uc;

    s += Tcl_UtfToUniChar(s,&uc);
    if (s > end) {
      printf("UTF from offset out of sync with terminator\n");
      fflush(stdout);
      abort();
    }
  }
}

/* Strip UTF-encoded nulls from object, beginning at offset */
static int
expNullStrip(obj,offsetBytes)
    Tcl_Obj *obj;
    int offsetBytes;
{
    char *src, *src2;
    char *dest;
    Tcl_UniChar uc;
    int newsize;       /* size of obj after all nulls removed */

    src2 = src = dest = Tcl_GetString(obj) + offsetBytes;

    while (*src) {
	src += Tcl_UtfToUniChar(src,&uc);
	if (uc != 0) {
	    dest += Tcl_UniCharToUtf(uc,dest);
	}
    }
    newsize = offsetBytes + (dest - src2);
    Tcl_SetObjLength(obj,newsize);
    return newsize;
}

/* returns # of bytes read or (non-positive) error of form EXP_XXX */
/* returns 0 for end of file */
/* If timeout is non-zero, set an alarm before doing the read, else assume */
/* the read will complete immediately. */
/*ARGSUSED*/
static int
expIRead(interp,esPtr,timeout,save_flags) /* INTL */
Tcl_Interp *interp;
ExpState *esPtr;
int timeout;
int save_flags;
{
    int cc = EXP_TIMEOUT;
    int size = expSizeGet(esPtr);

    if (size + TCL_UTF_MAX >= esPtr->msize) 
	exp_buffer_shuffle(interp,esPtr,save_flags,EXPECT_OUT,"expect");
    size = expSizeGet(esPtr);

#ifdef SIMPLE_EVENT
 restart:

    alarm_fired = FALSE;

    if (timeout > -1) {
	signal(SIGALRM,sigalarm_handler);
	alarm((timeout > 0)?timeout:1);
    }
#endif

    
    cc = Tcl_ReadChars(esPtr->channel,
	    esPtr->buffer,
	    esPtr->msize - (size / TCL_UTF_MAX),
	    1 /* append */);
    i_read_errno = errno;

#ifdef SIMPLE_EVENT
    alarm(0);

    if (cc == -1) {
	/* check if alarm went off */
	if (i_read_errno == EINTR) {
	    if (alarm_fired) {
		return EXP_TIMEOUT;
	    } else {
		if (Tcl_AsyncReady()) {
		    int rc = Tcl_AsyncInvoke(interp,TCL_OK);
		    if (rc != TCL_OK) return(exp_tcl2_returnvalue(rc));
		}
		goto restart;
	    }
	}
    }
#endif
    return cc;	
}

/*
 * expRead() does the logical equivalent of a read() for the expect command.
 * This includes figuring out which descriptor should be read from.
 *
 * The result of the read() is left in a spawn_id's buffer rather than
 * explicitly passing it back.  Note that if someone else has modified a buffer
 * either before or while this expect is running (i.e., if we or some event has
 * called Tcl_Eval which did another expect/interact), expRead will also call
 * this a successful read (for the purposes if needing to pattern match against
 * it).
 */

/* if it returns a negative number, it corresponds to a EXP_XXX result */
/* if it returns a non-negative number, it means there is data */
/* (0 means nothing new was actually read, but it should be looked at again) */
int
expRead(interp,esPtrs,esPtrsMax,esPtrOut,timeout,key)
Tcl_Interp *interp;
ExpState *(esPtrs[]);		/* If 0, then esPtrOut already known and set */
int esPtrsMax;			/* number of esPtrs */
ExpState **esPtrOut;		/* Out variable to leave new ExpState. */
int timeout;
int key;
{
    ExpState *esPtr;

    int size;
    int cc;
    int write_count;
    int tcl_set_flags;	/* if we have to discard chars, this tells */
			/* whether to show user locally or globally */

    if (esPtrs == 0) {
	/* we already know the ExpState, just find out what happened */
	cc = exp_get_next_event_info(interp,*esPtrOut);
	tcl_set_flags = TCL_GLOBAL_ONLY;
    } else {
	cc = exp_get_next_event(interp,esPtrs,esPtrsMax,esPtrOut,timeout,key);
	tcl_set_flags = 0;
    }
    esPtr = *esPtrOut;

    if (cc == EXP_DATA_NEW) {
	/* try to read it */
	cc = expIRead(interp,esPtr,timeout,tcl_set_flags);
	
	/* the meaning of 0 from i_read means eof.  Muck with it a */
	/* little, so that from now on it means "no new data arrived */
	/* but it should be looked at again anyway". */
	if (cc == 0) {
	    cc = EXP_EOF;
	} else if (cc > 0) {
	    /* successfully read data */
	} else {
	    /* failed to read data - some sort of error was encountered such as
	     * an interrupt with that forced an error return
	     */
	}
    } else if (cc == EXP_DATA_OLD) {
	cc = 0;
    } else if (cc == EXP_RECONFIGURE) {
	return EXP_RECONFIGURE;
    }

    if (cc == EXP_ABEOF) {	/* abnormal EOF */
	/* On many systems, ptys produce EIO upon EOF - sigh */
	if (i_read_errno == EIO) {
	    /* Sun, Cray, BSD, and others */
	    cc = EXP_EOF;
	} else if (i_read_errno == EINVAL) {
	    /* Solaris 2.4 occasionally returns this */
	    cc = EXP_EOF;
	} else {
	    if (i_read_errno == EBADF) {
		exp_error(interp,"bad spawn_id (process died earlier?)");
	    } else {
		exp_error(interp,"i_read(spawn_id fd=%d): %s",esPtr->fdin,
			Tcl_PosixError(interp));
		exp_close(interp,esPtr);
	    }
	    return(EXP_TCLERROR);
	    /* was goto error; */
	}
    }

    /* EOF, TIMEOUT, and ERROR return here */
    /* In such cases, there is no need to update screen since, if there */
    /* was prior data read, it would have been sent to the screen when */
    /* it was read. */
    if (cc < 0) return (cc);

    /*
     * update display
     */

    size = expSizeGet(esPtr);
    if (size) write_count = size - esPtr->printed;
    else write_count = 0;
    
    if (write_count) {
	/*
	 * Show chars to user if they've requested it, UNLESS they're seeing it
	 * already because they're typing it and tty driver is echoing it.
	 * Also send to Diag and Log if appropriate.
	 */
	expLogInteractionU(esPtr,Tcl_GetString(esPtr->buffer) + esPtr->printed);
	    
	/*
	 * strip nulls from input, since there is no way for Tcl to deal with
	 * such strings.  Doing it here lets them be sent to the screen, just
	 * in case they are involved in formatting operations
	 */
	if (esPtr->rm_nulls) size = expNullStrip(esPtr->buffer,esPtr->printed);
	esPtr->printed = size; /* count'm even if not logging */
    }
    return(cc);
}

/* when buffer fills, copy second half over first and */
/* continue, so we can do matches over multiple buffers */
void
exp_buffer_shuffle(interp,esPtr,save_flags,array_name,caller_name) /* INTL */
Tcl_Interp *interp;
ExpState *esPtr;
int save_flags;
char *array_name;
char *caller_name;
{
    char *str;
    char *middleGuess;
    char *p;
    int length, newlen;
    int skiplen;
    char lostByte;

    /*
     * allow user to see data we are discarding
     */

    expDiagLog("%s: set %s(spawn_id) \"%s\"\r\n",
	    caller_name,array_name,esPtr->name);
    Tcl_SetVar2(interp,array_name,"spawn_id",esPtr->name,save_flags);

    /*
     * The internal storage buffer object should only be referred
     * to by the channel that uses it.  We always copy the contents
     * out of the object before passing the data to anyone outside
     * of these routines.  This ensures that the object always has
     * a refcount of 1 so we can safely modify the contents in place.
     */

    if (Tcl_IsShared(esPtr->buffer)) {
	panic("exp_buffer_shuffle called with shared buffer object");
    }

    str = Tcl_GetStringFromObj(esPtr->buffer,&length);

    /* guess at the middle */
    middleGuess = str + length/2;

    /* crawl our way into the middle of the string
     * to make sure we are at a UTF char boundary
     */
    for (p=str;*p;p = Tcl_UtfNext(p)) {
	if (p > middleGuess) break;   /* ok, that's enough */
    }

    /*
     * p is now at the beginning of a UTF char in the middle of the string
     */

    /*
     * before doing move, show user data we are discarding
     */
    skiplen = p-str;
    lostByte = *p;
    /* temporarily stick null in middle of string */
    Tcl_SetObjLength(esPtr->buffer,skiplen);

    expDiagLog("%s: set %s(buffer) \"",caller_name,array_name);
    expDiagLogU(expPrintify(Tcl_GetString(esPtr->buffer)));
    expDiagLogU("\"\r\n");
    Tcl_SetVar2(interp,array_name,"buffer",Tcl_GetString(esPtr->buffer),
	    save_flags);

    /*
     * restore damage
     */
    *p = lostByte;

    /*
     * move 2nd half of string down to 1st half
     */

    newlen = length - skiplen;
    memmove(str,p, newlen);

    Tcl_SetObjLength(esPtr->buffer,newlen);

    esPtr->printed -= skiplen;
    if (esPtr->printed < 0) esPtr->printed = 0;
}

/* map EXP_ style return value to TCL_ style return value */
/* not defined to work on TCL_OK */
int
exp_tcl2_returnvalue(x)
int x;
{
	switch (x) {
	case TCL_ERROR:			return EXP_TCLERROR;
	case TCL_RETURN:		return EXP_TCLRET;
	case TCL_BREAK:			return EXP_TCLBRK;
	case TCL_CONTINUE:		return EXP_TCLCNT;
	case EXP_CONTINUE:		return EXP_TCLCNTEXP;
	case EXP_CONTINUE_TIMER:	return EXP_TCLCNTTIMER;
	case EXP_TCL_RETURN:		return EXP_TCLRETTCL;
	}
}

/* map from EXP_ style return value to TCL_ style return values */
int
exp_2tcl_returnvalue(x)
int x;
{
	switch (x) {
	case EXP_TCLERROR:		return TCL_ERROR;
	case EXP_TCLRET:		return TCL_RETURN;
	case EXP_TCLBRK:		return TCL_BREAK;
	case EXP_TCLCNT:		return TCL_CONTINUE;
	case EXP_TCLCNTEXP:		return EXP_CONTINUE;
	case EXP_TCLCNTTIMER:		return EXP_CONTINUE_TIMER;
	case EXP_TCLRETTCL:		return EXP_TCL_RETURN;
	}
}

/* variables predefined by expect are retrieved using this routine
which looks in the global space if they are not in the local space.
This allows the user to localize them if desired, and also to
avoid having to put "global" in procedure definitions.
*/
char *
exp_get_var(interp,var)
Tcl_Interp *interp;
char *var;
{
    char *val;

    if (NULL != (val = Tcl_GetVar(interp,var,0 /* local */)))
	return(val);
    return(Tcl_GetVar(interp,var,TCL_GLOBAL_ONLY));
}

static int
get_timeout(interp)
Tcl_Interp *interp;
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    char *t;

    if (NULL != (t = exp_get_var(interp,EXPECT_TIMEOUT))) {
	tsdPtr->timeout = atoi(t);
    }
    return(tsdPtr->timeout);
}

/* make a copy of a linked list (1st arg) and attach to end of another (2nd
arg) */
static int
update_expect_states(i_list,i_union)
struct exp_i *i_list;
struct exp_state_list **i_union;
{
    struct exp_i *p;

    /* for each i_list in an expect statement ... */
    for (p=i_list;p;p=p->next) {
	struct exp_state_list *slPtr;

	/* for each esPtr in the i_list */
	for (slPtr=p->state_list;slPtr;slPtr=slPtr->next) {
	    struct exp_state_list *tmpslPtr;
	    struct exp_state_list *u;

	    if (expStateAnyIs(slPtr->esPtr)) continue;
	    
	    /* check this one against all so far */
	    for (u = *i_union;u;u=u->next) {
		if (slPtr->esPtr == u->esPtr) goto found;
	    }
	    /* if not found, link in as head of list */
	    tmpslPtr = exp_new_state(slPtr->esPtr);
	    tmpslPtr->next = *i_union;
	    *i_union = tmpslPtr;
	    found:;
	}
    }
    return TCL_OK;
}

char *
exp_cmdtype_printable(cmdtype)
int cmdtype;
{
	switch (cmdtype) {
	case EXP_CMD_FG: return("expect");
	case EXP_CMD_BG: return("expect_background");
	case EXP_CMD_BEFORE: return("expect_before");
	case EXP_CMD_AFTER: return("expect_after");
	}
#ifdef LINT
	return("unknown expect command");
#endif
}

/* exp_indirect_update2 is called back via Tcl's trace handler whenever */
/* an indirect spawn id list is changed */
/*ARGSUSED*/
static char *
exp_indirect_update2(clientData, interp, name1, name2, flags)
ClientData clientData;
Tcl_Interp *interp;	/* Interpreter containing variable. */
char *name1;		/* Name of variable. */
char *name2;		/* Second part of variable name. */
int flags;		/* Information about what happened. */
{
	char *msg;

	struct exp_i *exp_i = (struct exp_i *)clientData;
	exp_configure_count++;
	msg = exp_indirect_update1(interp,&exp_cmds[exp_i->cmdtype],exp_i);

	exp_background_channelhandlers_run_all();

	return msg;
}

static char *
exp_indirect_update1(interp,ecmd,exp_i)
Tcl_Interp *interp;
struct exp_cmd_descriptor *ecmd;
struct exp_i *exp_i;
{
	struct exp_state_list *slPtr;	/* temp for interating over state_list */

	/*
	 * disarm any ExpState's that lose all their ecases
	 */

	if (ecmd->cmdtype == EXP_CMD_BG) {
		/* clean up each spawn id used by this exp_i */
		for (slPtr=exp_i->state_list;slPtr;slPtr=slPtr->next) {
			ExpState *esPtr = slPtr->esPtr;

			if (expStateAnyIs(esPtr)) continue;

			/* silently skip closed or preposterous fds */
			/* since we're just disabling them anyway */
			/* preposterous fds will have been reported */
			/* by code in next section already */
			if (!expStateCheck(interp,slPtr->esPtr,1,0,"")) continue;

			/* check before decrementing, ecount may not be */
			/* positive if update is called before ecount is */
			/* properly synchronized */
			if (esPtr->bg_ecount > 0) {
				esPtr->bg_ecount--;
			}
			if (esPtr->bg_ecount == 0) {
				exp_disarm_background_channelhandler(esPtr);
				esPtr->bg_interp = 0;
			}
		}
	}

	/*
	 * reread indirect variable
	 */

	exp_i_update(interp,exp_i);

	/*
	 * check validity of all fd's in variable
	 */

	for (slPtr=exp_i->state_list;slPtr;slPtr=slPtr->next) {
	    /* validate all input descriptors */

	    if (expStateAnyIs(slPtr->esPtr)) continue;

	    if (!expStateCheck(interp,slPtr->esPtr,1,1,
		    exp_cmdtype_printable(ecmd->cmdtype))) {
		static char msg[200];
		sprintf(msg,"%s from indirect variable (%s)",
			interp->result,exp_i->variable);
		return msg;
	    }
	}

	/* for each spawn id in list, arm if necessary */
	if (ecmd->cmdtype == EXP_CMD_BG) {
		state_list_arm(interp,exp_i->state_list);
	}

	return (char *)0;
}

int
expMatchProcess(interp, eo, cc, bg, detail)
    Tcl_Interp *interp;
    struct eval_out *eo;	/* final case of interest */
    int cc;			/* EOF, TIMEOUT, etc... */
    int bg;			/* 1 if called from background handler, */
				/* else 0 */
    char *detail;
{
    ExpState *esPtr = 0;
    Tcl_Obj *body = 0;
    Tcl_Obj *buffer;
    struct ecase *e = 0;	/* points to current ecase */
    int match = -1;		/* characters matched */
    char match_char;	/* place to hold char temporarily */
    /* uprooted by a NULL */
    int result = TCL_OK;

#define out(indexName, value) \
 expDiagLog("%s: set %s(%s) \"",detail,EXPECT_OUT,indexName); \
 expDiagLogU(expPrintify(value)); \
 expDiagLogU("\"\r\n"); \
 Tcl_SetVar2(interp, EXPECT_OUT,indexName,value,(bg ? TCL_GLOBAL_ONLY : 0));

    if (eo->e) {
	e = eo->e;
	body = e->body;
	if (cc != EXP_TIMEOUT) {
	    esPtr = eo->esPtr;
	    match = eo->match;
	    buffer = eo->buffer;
	}
    } else if (cc == EXP_EOF) {
	/* read an eof but no user-supplied case */
	esPtr = eo->esPtr;
	match = eo->match;
	buffer = eo->buffer;
    }			

    if (match >= 0) {
	char name[20], value[20];
	int i;

	if (e && e->use == PAT_RE) {
	    Tcl_RegExp re;
	    int flags;
	    Tcl_RegExpInfo info;

	    if (e->Case == CASE_NORM) {
		flags = TCL_REG_ADVANCED;
	    } else {
		flags = TCL_REG_ADVANCED | TCL_REG_NOCASE;
	    }
		    
	    re = Tcl_GetRegExpFromObj(interp, e->pat, flags);
	    Tcl_RegExpGetInfo(re, &info);

	    for (i=0;i<=info.nsubs;i++) {
		int start, end;
		Tcl_Obj *val;

		start = info.matches[i].start;
		end = info.matches[i].end-1;
		if (start == -1) continue;

		if (e->indices) {
		    /* start index */
		    sprintf(name,"%d,start",i);
		    sprintf(value,"%d",start);
		    out(name,value);

		    /* end index */
		    sprintf(name,"%d,end",i);
		    sprintf(value,"%d",end);
		    out(name,value);
		}

				/* string itself */
		sprintf(name,"%d,string",i);
		val = Tcl_GetRange(buffer, start, end);
		expDiagLog("%s: set %s(%s) \"",detail,EXPECT_OUT,name);
		expDiagLogU(expPrintifyObj(val));
		expDiagLogU("\"\r\n");
		Tcl_SetVar2Ex(interp,EXPECT_OUT,name,val,(bg ? TCL_GLOBAL_ONLY : 0));
	    }
	} else if (e && (e->use == PAT_GLOB || e->use == PAT_EXACT)) {
	    char *str;

	    if (e->indices) {
		/* start index */
		sprintf(value,"%d",e->simple_start);
		out("0,start",value);

		/* end index */
		sprintf(value,"%d",e->simple_start + match - 1);
		out("0,end",value);
	    }

	    /* string itself */
	    str = Tcl_GetString(esPtr->buffer) + e->simple_start;
	    /* temporarily null-terminate in middle */
	    match_char = str[match];
	    str[match] = 0;
	    out("0,string",str);
	    str[match] = match_char;

				/* redefine length of string that */
				/* matched for later extraction */
	    match += e->simple_start;
	} else if (e && e->use == PAT_NULL && e->indices) {
				/* start index */
	    sprintf(value,"%d",match-1);
	    out("0,start",value);
				/* end index */
	    sprintf(value,"%d",match-1);
	    out("0,end",value);
	} else if (e && e->use == PAT_FULLBUFFER) {
	    expDiagLogU("expect_background: full buffer\r\n");
	}
    }

    /* this is broken out of (match > 0) (above) since it can */
    /* that an EOF occurred with match == 0 */
    if (eo->esPtr) {
	char *str;
	int length;

	out("spawn_id",esPtr->name);

	str = Tcl_GetStringFromObj(esPtr->buffer, &length);
	/* Save buf[0..match] */
	/* temporarily null-terminate string in middle */
	match_char = str[match];
	str[match] = 0;
	out("buffer",str);
	/* remove middle-null-terminator */
	str[match] = match_char;

	/* "!e" means no case matched - transfer by default */
	if (!e || e->transfer) {
	    /* delete matched chars from input buffer */
	    esPtr->printed -= match;
	    if (length != 0) {
		memmove(str,str+match,length-match);
	    }
	    Tcl_SetObjLength(esPtr->buffer, length-match);
	}

	if (cc == EXP_EOF) {
	    /* exp_close() deletes all background bodies */
	    /* so save eof body temporarily */
	    if (body) Tcl_IncrRefCount(body);
	    exp_close(interp,esPtr);
	}
    }

    if (body) {
	if (!bg) {
	    result = Tcl_EvalObjEx(interp,body,0);
	} else {
	    result = Tcl_EvalObjEx(interp,body,TCL_EVAL_GLOBAL);
	    if (result != TCL_OK) Tcl_BackgroundError(interp);
	}
	if (cc == EXP_EOF) Tcl_DecrRefCount(body);
    }
    return result;
}

/* this function is called from the background when input arrives */
/*ARGSUSED*/
void
exp_background_channelhandler(clientData,mask) /* INTL */
ClientData clientData;
int mask;
{
    ExpState *esPtr;
    Tcl_Interp *interp;
    int cc;			/* number of bytes returned in a single read */
				/* or negative EXP_whatever */
    struct eval_out eo;		/* final case of interest */
    ExpState *last_esPtr;	/* for differentiating when multiple esPtrs */
				/* to print out better debugging messages */
    int last_case;		/* as above but for case */

    /* restore our environment */
    esPtr = (ExpState *)clientData;
    interp = esPtr->bg_interp;

    /* temporarily prevent this handler from being invoked again */
    exp_block_background_channelhandler(esPtr);

    /*
     * if mask == 0, then we've been called because the patterns changed not
     * because the waiting data has changed, so don't actually do any I/O
     */
    if (mask == 0) {
	cc = 0;
    } else {
	esPtr->notifiedMask = mask;
	esPtr->notified = FALSE;
	cc = expRead(interp,(ExpState **)0,0,&esPtr,EXP_TIME_INFINITY,0);
    }

do_more_data:
    eo.e = 0;		/* no final case yet */
    eo.esPtr = 0;		/* no final file selected yet */
    eo.match = 0;		/* nothing matched yet */

    /* force redisplay of buffer when debugging */
    last_esPtr = 0;

    if (cc == EXP_EOF) {
	/* do nothing */
    } else if (cc < 0) { /* EXP_TCLERROR or any other weird value*/
	goto finish;
	/* 
	 * if we were going to do this right, we should differentiate between
	 * things like HP ioctl-open-traps that fall out here and should
	 * rightfully be ignored and real errors that should be reported.  Come
	 * to think of it, the only errors will come from HP ioctl handshake
	 * botches anyway.
	 */
    } else {
	/* normal case, got data */
	/* new data if cc > 0, same old data if cc == 0 */

	/* below here, cc as general status */
	cc = EXP_NOMATCH;
    }

    cc = eval_cases(interp,&exp_cmds[EXP_CMD_BEFORE],
	    esPtr,&eo,&last_esPtr,&last_case,cc,&esPtr,1,"_background");
    cc = eval_cases(interp,&exp_cmds[EXP_CMD_BG],
	    esPtr,&eo,&last_esPtr,&last_case,cc,&esPtr,1,"_background");
    cc = eval_cases(interp,&exp_cmds[EXP_CMD_AFTER],
	    esPtr,&eo,&last_esPtr,&last_case,cc,&esPtr,1,"_background");
    if (cc == EXP_TCLERROR) {
		/* only likely problem here is some internal regexp botch */
		Tcl_BackgroundError(interp);
		goto finish;
    }
    /* special eof code that cannot be done in eval_cases */
    /* or above, because it would then be executed several times */
    if (cc == EXP_EOF) {
	eo.esPtr = esPtr;
	eo.match = expSizeGet(eo.esPtr);
	eo.buffer = eo.esPtr->buffer;
	expDiagLogU("expect_background: read eof\r\n");
	goto matched;
    }
    if (!eo.e) {
	/* if we get here, there must not have been a match */
	goto finish;
    }

 matched:
    expMatchProcess(interp, &eo, cc, 1 /* bg */,"expect_background");

    /*
     * Event handler will not call us back if there is more input
     * pending but it has already arrived.  bg_status will be
     * "blocked" only if armed.
     */

    /*
     * Connection could have been closed on us.  In this case,
     * exitWhenBgStatusUnblocked will be 1 and we should disable the channel
     * handler and release the esPtr.
     */

    if ((!esPtr->freeWhenBgHandlerUnblocked) && (esPtr->bg_status == blocked)) {
	if (0 != (cc = expSizeGet(esPtr))) {
	    goto do_more_data;
	}
    }
 finish:
    exp_unblock_background_channelhandler(esPtr);
    if (esPtr->freeWhenBgHandlerUnblocked)
	expStateFree(esPtr);
}

/*ARGSUSED*/
int
Exp_ExpectObjCmd(clientData, interp, objc, objv)
ClientData clientData;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];		/* Argument objects. */
{
    int cc;			/* number of chars returned in a single read */
				/* or negative EXP_whatever */
    ExpState *esPtr = 0;

    int i;			/* misc temporary */
    struct exp_cmd_descriptor eg;
    struct exp_state_list *state_list;	/* list of ExpStates to watch */
    struct exp_state_list *slPtr;	/* temp for interating over state_list */
    ExpState **esPtrs;
    int mcount;			/* number of esPtrs to watch */

    struct eval_out eo;		/* final case of interest */

    int result;			/* Tcl result */
    
    time_t start_time_total;	/* time at beginning of this procedure */
    time_t start_time = 0;	/* time when restart label hit */
    time_t current_time = 0;	/* current time (when we last looked)*/
    time_t end_time;		/* future time at which to give up */

    ExpState *last_esPtr;	/* for differentiating when multiple f's */
				/* to print out better debugging messages */
    int last_case;		/* as above but for case */
    int first_time = 1;		/* if not "restarted" */
    
    int key;			/* identify this expect command instance */
    int configure_count;	/* monitor exp_configure_count */

    int timeout;		/* seconds */
    int remtime;		/* remaining time in timeout */
    int reset_timer;		/* should timer be reset after continue? */

    if ((objc == 2) && exp_one_arg_braced(objv[1])) {
	return(exp_eval_with_one_arg(clientData,interp,objv));
    } else if ((objc == 3) && streq(Tcl_GetString(objv[1]),"-brace")) {
	Tcl_Obj *new_objv[2];
	new_objv[0] = objv[0];
	new_objv[1] = objv[2];
	return(exp_eval_with_one_arg(clientData,interp,new_objv));
    }

    time(&start_time_total);
    start_time = start_time_total;
    reset_timer = TRUE;
    
    if (&StdinoutPlaceholder == (ExpState *)clientData) {
	clientData = (ClientData) expStdinoutGet();
    } else if (&DevttyPlaceholder == (ExpState *)clientData) {
	clientData = (ClientData) expDevttyGet();
    }
	
    /* make arg list for processing cases */
    /* do it dynamically, since expect can be called recursively */

    exp_cmd_init(&eg,EXP_CMD_FG,EXP_TEMPORARY);
    state_list = 0;
    esPtrs = 0;
    if (TCL_ERROR == parse_expect_args(interp,&eg,
	    (ExpState *)clientData,objc,objv))
	return TCL_ERROR;

 restart_with_update:
    /* validate all descriptors and flatten ExpStates into array */

    if ((TCL_ERROR == update_expect_states(exp_cmds[EXP_CMD_BEFORE].i_list,&state_list))
	    || (TCL_ERROR == update_expect_states(exp_cmds[EXP_CMD_AFTER].i_list, &state_list))
	    || (TCL_ERROR == update_expect_states(eg.i_list,&state_list))) {
	result = TCL_ERROR;
	goto cleanup;
    }

    /* declare ourselves "in sync" with external view of close/indirect */
    configure_count = exp_configure_count;

    /* count and validate state_list */
    mcount = 0;
    for (slPtr=state_list;slPtr;slPtr=slPtr->next) {
	mcount++;
	/* validate all input descriptors */
	if (!expStateCheck(interp,slPtr->esPtr,1,1,"expect")) {
	    result = TCL_ERROR;
	    goto cleanup;
	}
    }

    /* make into an array */
    esPtrs = (ExpState **)ckalloc(mcount * sizeof(ExpState *));
    for (slPtr=state_list,i=0;slPtr;slPtr=slPtr->next,i++) {
	esPtrs[i] = slPtr->esPtr;
    }

  restart:
    if (first_time) first_time = 0;
    else time(&start_time);

    if (eg.timeout_specified_by_flag) {
	timeout = eg.timeout;
    } else {
	/* get the latest timeout */
	timeout = get_timeout(interp);
    }

    key = expect_key++;

    result = TCL_OK;
    last_esPtr = 0;

    /*
     * end of restart code
     */

    eo.e = 0;		/* no final case yet */
    eo.esPtr = 0;	/* no final ExpState selected yet */
    eo.match = 0;	/* nothing matched yet */

    /* timeout code is a little tricky, be very careful changing it */
    if (timeout != EXP_TIME_INFINITY) {
	/* if exp_continue -continue_timer, do not update end_time */
	if (reset_timer) {
	    time(&current_time);
	    end_time = current_time + timeout;
	} else {
	    reset_timer = TRUE;
	}
    }

    /* remtime and current_time updated at bottom of loop */
    remtime = timeout;

    for (;;) {
	if ((timeout != EXP_TIME_INFINITY) && (remtime < 0)) {
	    cc = EXP_TIMEOUT;
	} else {
	    cc = expRead(interp,esPtrs,mcount,&esPtr,remtime,key);
	}

	/*SUPPRESS 530*/
	if (cc == EXP_EOF) {
	    /* do nothing */
	} else if (cc == EXP_TIMEOUT) {
	    expDiagLogU("expect: timed out\r\n");
	} else if (cc == EXP_RECONFIGURE) {
	    reset_timer = FALSE;
	    goto restart_with_update;
	} else if (cc < 0) { /* EXP_TCLERROR or any other weird value*/
	    goto error;
	} else {
	    /* new data if cc > 0, same old data if cc == 0 */
	    
	    /* below here, cc as general status */
	    cc = EXP_NOMATCH;

	    /* force redisplay of buffer when debugging */
	    last_esPtr = 0;
	}

	cc = eval_cases(interp,&exp_cmds[EXP_CMD_BEFORE],
		esPtr,&eo,&last_esPtr,&last_case,cc,esPtrs,mcount,"");
	cc = eval_cases(interp,&eg,
		esPtr,&eo,&last_esPtr,&last_case,cc,esPtrs,mcount,"");
	cc = eval_cases(interp,&exp_cmds[EXP_CMD_AFTER],
		esPtr,&eo,&last_esPtr,&last_case,cc,esPtrs,mcount,"");
	if (cc == EXP_TCLERROR) goto error;
	/* special eof code that cannot be done in eval_cases */
	/* or above, because it would then be executed several times */
	if (cc == EXP_EOF) {
	    eo.esPtr = esPtr;
	    eo.match = expSizeGet(eo.esPtr);
	    eo.buffer = eo.esPtr->buffer;
	    expDiagLogU("expect: read eof\r\n");
	    break;
	} else if (cc == EXP_TIMEOUT) break;
	/* break if timeout or eof and failed to find a case for it */

	if (eo.e) break;

	/* no match was made with current data, force a read */
	esPtr->force_read = TRUE;

	if (timeout != EXP_TIME_INFINITY) {
	    time(&current_time);
	    remtime = end_time - current_time;
	}
    }

    goto done;

error:
    result = exp_2tcl_returnvalue(cc);
 done:
    if (result != TCL_ERROR) {
	result = expMatchProcess(interp, &eo, cc, 0 /* not bg */,"expect");
    }

 cleanup:
    if (result == EXP_CONTINUE_TIMER) {
	reset_timer = FALSE;
	result = EXP_CONTINUE;
    }

    if ((result == EXP_CONTINUE) && (configure_count == exp_configure_count)) {
	expDiagLogU("expect: continuing expect\r\n");
	goto restart;
    }

    if (state_list) {
	exp_free_state(state_list);
	state_list = 0;
    }
    if (esPtrs) {
	ckfree((char *)esPtrs);
	esPtrs = 0;
    }

    if (result == EXP_CONTINUE) {
	expDiagLogU("expect: continuing expect after update\r\n");
	goto restart_with_update;
    }

    free_ecases(interp,&eg,0);	/* requires i_lists to be avail */
    exp_free_i(interp,eg.i_list,exp_indirect_update2);

    return(result);
}

/*ARGSUSED*/
static int
Exp_TimestampCmd(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
	char *format = 0;
	time_t seconds = -1;
	int gmt = FALSE;	/* local time by default */
	struct tm *tm;
	Tcl_DString dstring;

	argc--; argv++;

	while (*argv) {
		if (streq(*argv,"-format")) {
			argc--; argv++;
			if (!*argv) goto usage_error;
			format = *argv;
			argc--; argv++;
		} else if (streq(*argv,"-seconds")) {
			argc--; argv++;
			if (!*argv) goto usage_error;
			seconds = atoi(*argv);
			argc--; argv++;
		} else if (streq(*argv,"-gmt")) {
			gmt = TRUE;
			argc--; argv++;
		} else break;
	}

	if (argc) goto usage_error;

	if (seconds == -1) {
		time(&seconds);
	}

	Tcl_DStringInit(&dstring);

	if (format) {
		if (gmt) {
			tm = gmtime(&seconds);
		} else {
			tm = localtime(&seconds);
		}
/*		exp_strftime(interp->result,TCL_RESULT_SIZE,format,tm);*/
		exp_strftime(format,tm,&dstring);
		Tcl_DStringResult(interp,&dstring);
	} else {
		sprintf(interp->result,"%ld",seconds);
	}
	
	return TCL_OK;
 usage_error:
	exp_error(interp,"args: [-seconds #] [-format format]");
	return TCL_ERROR;

}

/*ARGSUSED*/
int
Exp_MatchMaxCmd(clientData,interp,argc,argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
    int size = -1;
    ExpState *esPtr = 0;
    char *chanName = 0;
    int Default = FALSE;

    argc--; argv++;

    for (;argc>0;argc--,argv++) {
	if (streq(*argv,"-d")) {
	    Default = TRUE;
	} else if (streq(*argv,"-i")) {
	    argc--;argv++;
	    if (argc < 1) {
		exp_error(interp,"-i needs argument");
		return(TCL_ERROR);
	    }
	    chanName = *argv;
	} else break;
    }

    if (Default && chanName) {
	exp_error(interp,"cannot do -d and -i at the same time");
	return(TCL_ERROR);
    }

    if (!Default) {
	if (!chanName) {
	    if (!(esPtr = expStateCurrent(interp,0,0,0))) {
		return(TCL_ERROR);
	    }
	} else {
	    
	    if (!(esPtr = expStateFromChannelName(interp,chanName,0,0,0,"match_max")))
		return(TCL_ERROR);
	}
    }

    if (argc == 0) {
	if (Default) {
	    size = exp_default_match_max;
	} else {
	    size = esPtr->umsize;
	}
	sprintf(interp->result,"%d",size);
	return(TCL_OK);
    }

    if (argc > 1) {
	exp_error(interp,"too many arguments");
	return(TCL_OK);
    }
    
    /*
     * All that's left is to set the size
     */

    size = atoi(argv[0]);
    if (size <= 0) {
	exp_error(interp,"must be positive");
	return(TCL_ERROR);
    }

    if (Default) exp_default_match_max = size;
    else esPtr->umsize = size;

    return(TCL_OK);
}

/*ARGSUSED*/
int
Exp_RemoveNullsCmd(clientData,interp,argc,argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
    int value = -1;
    ExpState *esPtr = 0;
    char *chanName = 0;
    int Default = FALSE;

    argc--; argv++;

    for (;argc>0;argc--,argv++) {
	if (streq(*argv,"-d")) {
	    Default = TRUE;
	} else if (streq(*argv,"-i")) {
	    argc--;argv++;
	    if (argc < 1) {
		exp_error(interp,"-i needs argument");
		return(TCL_ERROR);
	    }
	    chanName = *argv;
	} else break;
    }

    if (Default && chanName) {
	exp_error(interp,"cannot do -d and -i at the same time");
	return(TCL_ERROR);
    }

    if (!Default) {
	if (!chanName) {
	    if (!(esPtr = expStateCurrent(interp,0,0,0)))
		return(TCL_ERROR);
	} else {
	    if (!(esPtr = expStateFromChannelName(interp,chanName,0,0,0,"remove_nulls")))
		return(TCL_ERROR);
	}
    }

    if (argc == 0) {
	if (Default) {
	  value = exp_default_rm_nulls;
	} else {
	  value = esPtr->rm_nulls;
	}
	sprintf(interp->result,"%d",value);
	return(TCL_OK);
    }

    if (argc > 1) {
	exp_error(interp,"too many arguments");
	return(TCL_OK);
    }

    /* all that's left is to set the value */
    value = atoi(argv[0]);
    if (value != 0 && value != 1) {
	exp_error(interp,"must be 0 or 1");
	return(TCL_ERROR);
    }

    if (Default) exp_default_rm_nulls = value;
    else esPtr->rm_nulls = value;

    return(TCL_OK);
}

/*ARGSUSED*/
int
Exp_ParityCmd(clientData,interp,argc,argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
    int parity;
    ExpState *esPtr = 0;
    char *chanName = 0;
    int Default = FALSE;

    argc--; argv++;

    for (;argc>0;argc--,argv++) {
	if (streq(*argv,"-d")) {
	    Default = TRUE;
	} else if (streq(*argv,"-i")) {
	    argc--;argv++;
	    if (argc < 1) {
		exp_error(interp,"-i needs argument");
		return(TCL_ERROR);
	    }
	    chanName = *argv;
	} else break;
    }

    if (Default && chanName) {
	exp_error(interp,"cannot do -d and -i at the same time");
	return(TCL_ERROR);
    }

    if (!Default) {
	if (!chanName) {
	    if (!(esPtr = expStateCurrent(interp,0,0,0))) {
		return(TCL_ERROR);
	    }
	} else {
	    if (!(esPtr = expStateFromChannelName(interp,chanName,0,0,0,"parity"))) {
		return(TCL_ERROR);
	    }
	}
    }

    if (argc == 0) {
	if (Default) {
	    parity = exp_default_parity;
	} else {
	    parity = esPtr->parity;
	}
	sprintf(interp->result,"%d",parity);
	return(TCL_OK);
    }

    if (argc > 1) {
	exp_error(interp,"too many arguments");
	return(TCL_OK);
    }

    /* all that's left is to set the parity */
    parity = atoi(argv[0]);

    if (Default) exp_default_parity = parity;
    else esPtr->parity = parity;

    return(TCL_OK);
}

#if DEBUG_PERM_ECASES
/* This big chunk of code is just for debugging the permanent */
/* expect cases */
void
exp_fd_print(slPtr)
struct exp_state_list *slPtr;
{
	if (!slPtr) return;
	printf("%d ",slPtr->esPtr);
	exp_fd_print(slPtr->next);
}

void
exp_i_print(exp_i)
struct exp_i *exp_i;
{
	if (!exp_i) return;
	printf("exp_i %x",exp_i);
	printf((exp_i->direct == EXP_DIRECT)?" direct":" indirect");
	printf((exp_i->duration == EXP_PERMANENT)?" perm":" tmp");
	printf("  ecount = %d\n",exp_i->ecount);
	printf("variable %s, value %s\n",
		((exp_i->variable)?exp_i->variable:"--"),
		((exp_i->value)?exp_i->value:"--"));
	printf("ExpStates: ");
	exp_fd_print(exp_i->state_list); printf("\n");
	exp_i_print(exp_i->next);
}

void
exp_ecase_print(ecase)
struct ecase *ecase;
{
	printf("pat <%s>\n",ecase->pat);
	printf("exp_i = %x\n",ecase->i_list);
}

void
exp_ecases_print(ecd)
struct exp_cases_descriptor *ecd;
{
	int i;

	printf("%d cases\n",ecd->count);
	for (i=0;i<ecd->count;i++) exp_ecase_print(ecd->cases[i]);
}

void
exp_cmd_print(ecmd)
struct exp_cmd_descriptor *ecmd;
{
	printf("expect cmd type: %17s",exp_cmdtype_printable(ecmd->cmdtype));
	printf((ecmd->duration==EXP_PERMANENT)?" perm ": "tmp ");
	/* printdict */
	exp_ecases_print(&ecmd->ecd);
	exp_i_print(ecmd->i_list);
}

void
exp_cmds_print()
{
	exp_cmd_print(&exp_cmds[EXP_CMD_BEFORE]);
	exp_cmd_print(&exp_cmds[EXP_CMD_AFTER]);
	exp_cmd_print(&exp_cmds[EXP_CMD_BG]);
}

/*ARGSUSED*/
int
cmdX(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
	exp_cmds_print();
	return TCL_OK;
}
#endif /*DEBUG_PERM_ECASES*/

void
expExpectVarsInit()
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    tsdPtr->timeout = INIT_EXPECT_TIMEOUT;
}

static struct exp_cmd_data
cmd_data[]  = {
{"expect",	Exp_ExpectObjCmd,	0,	(ClientData)0,	0},
{"expect_after",Exp_ExpectGlobalObjCmd, 0,	(ClientData)&exp_cmds[EXP_CMD_AFTER],0},
{"expect_before",Exp_ExpectGlobalObjCmd,0,	(ClientData)&exp_cmds[EXP_CMD_BEFORE],0},
{"expect_user",	Exp_ExpectObjCmd,	0,	(ClientData)&StdinoutPlaceholder,0},
{"expect_tty",	Exp_ExpectObjCmd,	0,	(ClientData)&DevttyPlaceholder,0},
{"expect_background",Exp_ExpectGlobalObjCmd,0,	(ClientData)&exp_cmds[EXP_CMD_BG],0},
{"match_max",	exp_proc(Exp_MatchMaxCmd),	0,	0},
{"remove_nulls",exp_proc(Exp_RemoveNullsCmd),	0,	0},
{"parity",	exp_proc(Exp_ParityCmd),	0,	0},
{"timestamp",	exp_proc(Exp_TimestampCmd),	0,	0},
{0}};

void
exp_init_expect_cmds(interp)
Tcl_Interp *interp;
{
	exp_create_commands(interp,cmd_data);



	Tcl_SetVar(interp,EXPECT_TIMEOUT,INIT_EXPECT_TIMEOUT_LIT,0);

	exp_cmd_init(&exp_cmds[EXP_CMD_BEFORE],EXP_CMD_BEFORE,EXP_PERMANENT);
	exp_cmd_init(&exp_cmds[EXP_CMD_AFTER ],EXP_CMD_AFTER, EXP_PERMANENT);
	exp_cmd_init(&exp_cmds[EXP_CMD_BG    ],EXP_CMD_BG,    EXP_PERMANENT);
	exp_cmd_init(&exp_cmds[EXP_CMD_FG    ],EXP_CMD_FG,    EXP_TEMPORARY);

	/* preallocate to one element, so future realloc's work */
	exp_cmds[EXP_CMD_BEFORE].ecd.cases = 0;
	exp_cmds[EXP_CMD_AFTER ].ecd.cases = 0;
	exp_cmds[EXP_CMD_BG    ].ecd.cases = 0;

	pattern_style[PAT_EOF] = "eof";
	pattern_style[PAT_TIMEOUT] = "timeout";
	pattern_style[PAT_DEFAULT] = "default";
	pattern_style[PAT_FULLBUFFER] = "full buffer";
	pattern_style[PAT_GLOB] = "glob pattern";
	pattern_style[PAT_RE] = "regular expression";
	pattern_style[PAT_EXACT] = "exact string";
	pattern_style[PAT_NULL] = "null";

#if 0
	Tcl_CreateCommand(interp,"x",
		cmdX,(ClientData)0,exp_deleteProc);
#endif
}

void
exp_init_sig() {
#if 0
	signal(SIGALRM,sigalarm_handler);
	signal(SIGINT,sigint_handler);
#endif
}






Added expect.dsw.







































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

Microsoft Developer Studio Workspace File, Format Version 6.00
# WARNING: DO NOT EDIT OR DELETE THIS WORKSPACE FILE!

###############################################################################

Project: "buildfiles"=.\win\buildfiles.dsp - Package Owner=<4>

Package=<5>
{{{
}}}

Package=<4>
{{{
}}}

###############################################################################

Project: "expect"=.\win\expect.dsp - Package Owner=<4>

Package=<5>
{{{
}}}

Package=<4>
{{{
}}}

###############################################################################

Project: "genStubs"=.\win\genStubs.dsp - Package Owner=<4>

Package=<5>
{{{
}}}

Package=<4>
{{{
}}}

###############################################################################

Project: "slavedrv"=.\win\slavedrv.dsp - Package Owner=<4>

Package=<5>
{{{
}}}

Package=<4>
{{{
}}}

###############################################################################

Global:

Package=<5>
{{{
}}}

Package=<3>
{{{
}}}

###############################################################################







Deleted expect.h.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466




















































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

/* expect.h - include file for using the expect library, libexpect.a
from C or C++ (i.e., without Tcl)

Written by: Don Libes, [email protected], NIST, 12/3/90

Design and implementation of this program was paid for by U.S. tax
dollars.  Therefore it is public domain.  However, the author and NIST
would appreciate credit if this program or parts of it are used.
*/

#ifndef _EXPECT_H
#define _EXPECT_H

#include <stdio.h>
#include <setjmp.h>

/*
 * tcl.h --
 *
 *	This header file describes the externally-visible facilities
 *	of the Tcl interpreter.
 *
 * Copyright (c) 1987-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1993-1996 Lucent Technologies.
 * Copyright (c) 1998-1999 Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: expect.h,v 5.28.1.1.2.4 1999/12/04 06:18:25 libes Exp $
 */

#ifndef _TCL
#define _TCL

#ifndef __WIN32__
#   if defined(_WIN32) || defined(WIN32)
#	define __WIN32__
#   endif
#endif

#ifdef __WIN32__
#   ifndef STRICT
#	define STRICT
#   endif
#   ifndef USE_PROTOTYPE
#	define USE_PROTOTYPE 1
#   endif
#   ifndef HAS_STDARG
#	define HAS_STDARG 1
#   endif
#   ifndef USE_PROTOTYPE
#	define USE_PROTOTYPE 1
#   endif

/*
 * Under Windows we need to call Tcl_Alloc in all cases to avoid competing
 * C run-time library issues.
 */

#   ifndef USE_TCLALLOC
#	define USE_TCLALLOC 1
#   endif
#endif /* __WIN32__ */

/*
 * The following definitions set up the proper options for Macintosh
 * compilers.  We use this method because there is no autoconf equivalent.
 */

#ifdef MAC_TCL
#   ifndef HAS_STDARG
#	define HAS_STDARG 1
#   endif
#   ifndef USE_TCLALLOC
#	define USE_TCLALLOC 1
#   endif
#   ifndef NO_STRERROR
#	define NO_STRERROR 1
#   endif
#endif

/*
 * Utility macros: STRINGIFY takes an argument and wraps it in "" (double
 * quotation marks), JOIN joins two arguments.
 */

#define VERBATIM(x) x
#ifdef _MSC_VER
# define STRINGIFY(x) STRINGIFY1(x)
# define STRINGIFY1(x) #x
# define JOIN(a,b) JOIN1(a,b)
# define JOIN1(a,b) a##b
#else
# ifdef RESOURCE_INCLUDED
#  define STRINGIFY(x) STRINGIFY1(x)
#  define STRINGIFY1(x) #x
#  define JOIN(a,b) JOIN1(a,b)
#  define JOIN1(a,b) a##b
# else
#  ifdef __STDC__
#   define STRINGIFY(x) #x
#   define JOIN(a,b) a##b
#  else
#   define STRINGIFY(x) "x"
#   define JOIN(a,b) VERBATIM(a)VERBATIM(b)
#  endif
# endif
#endif

/* 
 * A special definition used to allow this header file to be included 
 * in resource files so that they can get obtain version information from
 * this file.  Resource compilers don't like all the C stuff, like typedefs
 * and procedure declarations, that occur below.
 */

#ifndef RESOURCE_INCLUDED

#ifndef BUFSIZ
#include <stdio.h>
#endif

/*
 * Definitions that allow Tcl functions with variable numbers of
 * arguments to be used with either varargs.h or stdarg.h.  TCL_VARARGS
 * is used in procedure prototypes.  TCL_VARARGS_DEF is used to declare
 * the arguments in a function definiton: it takes the type and name of
 * the first argument and supplies the appropriate argument declaration
 * string for use in the function definition.  TCL_VARARGS_START
 * initializes the va_list data structure and returns the first argument.
 */

#if defined(__STDC__) || defined(HAS_STDARG)
#   include <stdarg.h>

#   define TCL_VARARGS(type, name) (type name, ...)
#   define TCL_VARARGS_DEF(type, name) (type name, ...)
#   define TCL_VARARGS_START(type, name, list) (va_start(list, name), name)
#else
#   include <varargs.h>

#   ifdef __cplusplus
#	define TCL_VARARGS(type, name) (type name, ...)
#	define TCL_VARARGS_DEF(type, name) (type va_alist, ...)
#   else
#	define TCL_VARARGS(type, name) ()
#	define TCL_VARARGS_DEF(type, name) (va_alist)
#   endif
#   define TCL_VARARGS_START(type, name, list) \
	(va_start(list), va_arg(list, type))
#endif

/*
 * Macros used to declare a function to be exported by a DLL.
 * Used by Windows, maps to no-op declarations on non-Windows systems.
 * The default build on windows is for a DLL, which causes the DLLIMPORT
 * and DLLEXPORT macros to be nonempty. To build a static library, the
 * macro STATIC_BUILD should be defined.
 */

#ifdef STATIC_BUILD
# define DLLIMPORT
# define DLLEXPORT
#else
# if defined(__WIN32__) && (defined(_MSC_VER) || (defined(__GNUC__) && defined(__declspec)))
#   define DLLIMPORT __declspec(dllimport)
#   define DLLEXPORT __declspec(dllexport)
# else
#  define DLLIMPORT
#  define DLLEXPORT
# endif
#endif

/*
 * These macros are used to control whether functions are being declared for
 * import or export.  If a function is being declared while it is being built
 * to be included in a shared library, then it should have the DLLEXPORT
 * storage class.  If is being declared for use by a module that is going to
 * link against the shared library, then it should have the DLLIMPORT storage
 * class.  If the symbol is beind declared for a static build or for use from a
 * stub library, then the storage class should be empty.
 *
 * The convention is that a macro called BUILD_xxxx, where xxxx is the
 * name of a library we are building, is set on the compile line for sources
 * that are to be placed in the library.  When this macro is set, the
 * storage class will be set to DLLEXPORT.  At the end of the header file, the
 * storage class will be reset to DLLIMPORt.
 */

#undef TCL_STORAGE_CLASS
#ifdef BUILD_tcl
# define TCL_STORAGE_CLASS DLLEXPORT
#else
# ifdef USE_TCL_STUBS
#  define TCL_STORAGE_CLASS
# else
#  define TCL_STORAGE_CLASS DLLIMPORT
# endif
#endif

/*
 * Definitions that allow this header file to be used either with or
 * without ANSI C features like function prototypes.  */

#undef _ANSI_ARGS_
#undef CONST

#if ((defined(__STDC__) || defined(SABER)) && !defined(NO_PROTOTYPE)) || defined(__cplusplus) || defined(USE_PROTOTYPE)
#   define _USING_PROTOTYPES_ 1
#   define _ANSI_ARGS_(x)	x
#   define CONST const
#else
#   define _ANSI_ARGS_(x)	()
#   define CONST
#endif

#ifdef __cplusplus
#   define EXTERN extern "C" TCL_STORAGE_CLASS
#else
#   define EXTERN extern TCL_STORAGE_CLASS
#endif

/*
 * Macro to use instead of "void" for arguments that must have
 * type "void *" in ANSI C;  maps them to type "char *" in
 * non-ANSI systems.
 */
#ifndef __WIN32__
#ifndef VOID
#   ifdef __STDC__
#       define VOID void
#   else
#       define VOID char
#   endif
#endif
#else /* __WIN32__ */
/*
 * The following code is copied from winnt.h
 */
#ifndef VOID
#define VOID void
typedef char CHAR;
typedef short SHORT;
typedef long LONG;
#endif
#endif /* __WIN32__ */

/*
 * Miscellaneous declarations.
 */

#ifndef NULL
#define NULL 0
#endif

typedef struct Tcl_RegExp_ *Tcl_RegExp;

/*
 * The following declarations either map ckalloc and ckfree to
 * malloc and free, or they map them to procedures with all sorts
 * of debugging hooks defined in tclCkalloc.c.
 */

#ifdef TCL_MEM_DEBUG

#  define Tcl_Alloc(x) Tcl_DbCkalloc(x, __FILE__, __LINE__)
#  define Tcl_Free(x)  Tcl_DbCkfree(x, __FILE__, __LINE__)
#  define Tcl_Realloc(x,y) Tcl_DbCkrealloc((x), (y),__FILE__, __LINE__)
#  define ckalloc(x) Tcl_DbCkalloc(x, __FILE__, __LINE__)
#  define ckfree(x)  Tcl_DbCkfree(x, __FILE__, __LINE__)
#  define ckrealloc(x,y) Tcl_DbCkrealloc((x), (y),__FILE__, __LINE__)

#else

/*
 * If USE_TCLALLOC is true, then we need to call Tcl_Alloc instead of
 * the native malloc/free.  The only time USE_TCLALLOC should not be
 * true is when compiling the Tcl/Tk libraries on Unix systems.  In this
 * case we can safely call the native malloc/free directly as a performance
 * optimization.
 */

#  if USE_TCLALLOC
#     define ckalloc(x) Tcl_Alloc(x)
#     define ckfree(x) Tcl_Free(x)
#     define ckrealloc(x,y) Tcl_Realloc(x,y)
#  else
#     define ckalloc(x) malloc(x)
#     define ckfree(x)  free(x)
#     define ckrealloc(x,y) realloc(x,y)
#  endif
#  define Tcl_DumpActiveMemory(x)
#  define Tcl_ValidateAllMemory(x,y)

#endif /* !TCL_MEM_DEBUG */


/*
 * These function have been renamed. The old names are deprecated, but we
 * define these macros for backwards compatibilty.
 */

#define Tcl_Ckalloc Tcl_Alloc
#define Tcl_Ckfree Tcl_Free
#define Tcl_Ckrealloc Tcl_Realloc
#define Tcl_Return Tcl_SetResult
#define Tcl_TildeSubst Tcl_TranslateFileName

/*
 * In later releases, Tcl_Panic will be the correct name to use.  For now
 * we leave it as panic to avoid breaking existing binaries.
 */

#define Tcl_Panic panic
#define Tcl_PanicVA panicVA

#endif /* RESOURCE_INCLUDED */

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT

#endif /* _TCL */

/*
 * end of tcl.h definitions
 */


/*
 * regexp definitions - from tcl8.0/tclRegexp.h
 */

/*
 * Definitions etc. for regexp(3) routines.
 *
 * Caveat:  this is V8 regexp(3) [actually, a reimplementation thereof],
 * not the System V one.
 *
 * RCS: @(#) $Id: expect.h,v 5.28.1.1.2.4 1999/12/04 06:18:25 libes Exp $
 */

#ifndef _REGEXP
#define _REGEXP 1

#ifdef BUILD_tcl
# undef TCL_STORAGE_CLASS
# define TCL_STORAGE_CLASS DLLEXPORT
#endif

/*
 * NSUBEXP must be at least 10, and no greater than 117 or the parser
 * will not work properly.
 */

#define NSUBEXP  20

typedef struct regexp {
	char *startp[NSUBEXP];
	char *endp[NSUBEXP];
	char regstart;		/* Internal use only. */
	char reganch;		/* Internal use only. */
	char *regmust;		/* Internal use only. */
	int regmlen;		/* Internal use only. */
	char program[1];	/* Unwarranted chumminess with compiler. */
} regexp;

EXTERN regexp *TclRegComp _ANSI_ARGS_((char *exp));
EXTERN int TclRegExec _ANSI_ARGS_((regexp *prog, char *string, char *start));
EXTERN void TclRegSub _ANSI_ARGS_((regexp *prog, char *source, char *dest));
EXTERN void exp_TclRegError _ANSI_ARGS_((char *msg));
EXTERN char *TclGetRegError _ANSI_ARGS_((void));

# undef TCL_STORAGE_CLASS
# define TCL_STORAGE_CLASS DLLIMPORT

#endif /* REGEXP */


/*
 * end of regexp definitions
 */


/*
 * finally - expect-specific definitions
 */

#include "expect_comm.h"

enum exp_type {
	exp_end = 0,		/* placeholder - no more cases */
	exp_glob,		/* glob-style */
	exp_exact,		/* exact string */
	exp_regexp,		/* regexp-style, uncompiled */
	exp_compiled,		/* regexp-style, compiled */
	exp_null,		/* matches binary 0 */
	exp_bogus		/* aid in reporting compatibility problems */
};

struct exp_case {		/* case for expect command */
	char *pattern;
	regexp *re;
	enum exp_type type;
	int value;		/* value to be returned upon match */
};

EXTERN char *exp_buffer;		/* buffer of matchable chars */
EXTERN char *exp_buffer_end;		/* one beyond end of matchable chars */
EXTERN char *exp_match;			/* start of matched string */
EXTERN char *exp_match_end;		/* one beyond end of matched string */
EXTERN int exp_match_max;		/* bytes */
EXTERN int exp_timeout;			/* seconds */
EXTERN int exp_full_buffer;		/* if true, return on full buffer */
EXTERN int exp_remove_nulls;		/* if true, remove nulls */

EXTERN int exp_pty_timeout;		/* see Cray hooks in source */
EXTERN int exp_pid;			/* process-id of spawned process */
EXTERN int exp_autoallocpty;		/* if TRUE, we do allocation */
EXTERN int exp_pty[2];			/* master is [0], slave is [1] */
EXTERN char *exp_pty_slave_name;	/* name of pty slave device if we */
					/* do allocation */
EXTERN char *exp_stty_init;		/* initial stty args */
EXTERN int exp_ttycopy;			/* copy tty parms from /dev/tty */
EXTERN int exp_ttyinit;			/* set tty parms to sane state */
EXTERN int exp_console;			/* redirect console */

#ifdef HAVE_SIGLONGJMP
sigjmp_buf exp_readenv;		/* for interruptable read() */
#else
jmp_buf exp_readenv;		/* for interruptable read() */
#endif /* HAVE_SIGLONGJMP */

EXTERN int exp_reading;			/* whether we can longjmp or not */
#define EXP_ABORT	1		/* abort read */
#define EXP_RESTART	2		/* restart read */

EXTERN int exp_is_debugging;
EXTERN int exp_loguser;

EXTERN void (*exp_close_in_child)();	/* procedure to close files in child */
EXTERN void exp_slave_control _ANSI_ARGS_((int,int));
EXTERN int exp_logfile_all;
EXTERN FILE *exp_debugfile;
EXTERN FILE *exp_logfile;
extern void exp_debuglog _ANSI_ARGS_(TCL_VARARGS(char *,fmt));
extern void exp_errorlog _ANSI_ARGS_(TCL_VARARGS(char *,fmt));

EXTERN int exp_disconnect _ANSI_ARGS_((void));
EXTERN FILE *exp_popen	_ANSI_ARGS_((char *command));
EXTERN void (*exp_child_exec_prelude) _ANSI_ARGS_((void));

#ifndef EXP_DEFINE_FNS
EXTERN int exp_spawnl	_ANSI_ARGS_(TCL_VARARGS(char *,file));
EXTERN int exp_expectl	_ANSI_ARGS_(TCL_VARARGS(int,fd));
EXTERN int exp_fexpectl	_ANSI_ARGS_(TCL_VARARGS(FILE *,fp));
#endif

EXTERN int exp_spawnv	_ANSI_ARGS_((char *file, char *argv[]));
EXTERN int exp_expectv	_ANSI_ARGS_((int fd, struct exp_case *cases));
EXTERN int exp_fexpectv	_ANSI_ARGS_((FILE *fp, struct exp_case *cases));

EXTERN int exp_spawnfd	_ANSI_ARGS_((int fd));

#endif /* _EXPECT_H */






Deleted expect_comm.h.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65



































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

/* expectcomm.h - public symbols common to both expect.h and expect_tcl.h

Written by: Don Libes, [email protected], NIST, 12/3/90

Design and implementation of this program was paid for by U.S. tax
dollars.  Therefore it is public domain.  However, the author and NIST
would appreciate credit if this program or parts of it are used.
*/

#ifndef _EXPECT_COMM_H
#define _EXPECT_COMM_H

/* common return codes for Expect functions */
/* The library actually only uses TIMEOUT and EOF */
#define EXP_ABEOF	-1	/* abnormal eof in Expect */
				/* when in library, this define is not used. */
				/* Instead "-1" is used literally in the */
				/* usual sense to check errors in system */
				/* calls */
#define EXP_TIMEOUT	-2
#define EXP_TCLERROR	-3
#define EXP_FULLBUFFER	-5
#define EXP_MATCH	-6
#define EXP_NOMATCH	-7
#define EXP_CANTMATCH	EXP_NOMATCH
#define EXP_CANMATCH	-8
#define EXP_DATA_NEW	-9	/* if select says there is new data */
#define EXP_DATA_OLD	-10	/* if we already read data in another cmd */
#define EXP_EOF		-11
#define EXP_RECONFIGURE	-12	/* changes to indirect spawn id lists */
				/* require us to reconfigure things */

/* in the unlikely event that a signal handler forces us to return this */
/* through expect's read() routine, we temporarily convert it to this. */
#define EXP_TCLRET	-20
#define EXP_TCLCNT	-21
#define EXP_TCLCNTTIMER	-22
#define EXP_TCLBRK	-23
#define EXP_TCLCNTEXP	-24
#define EXP_TCLRETTCL	-25

/* yet more TCL return codes */
/* Tcl does not safely provide a way to define the values of these, so */
/* use ridiculously different numbers for safety */
#define EXP_CONTINUE		-101	/* continue expect command */
					/* and restart timer */
#define EXP_CONTINUE_TIMER	-102	/* continue expect command */
					/* and continue timer */
#define EXP_TCL_RETURN		-103	/* converted by interact */
					/* and interpeter from */
					/* inter_return into */
					/* TCL_RETURN*/

/*
 * Everything below here should eventually be moved into expect.h
 * and Expect-thread-safe variables.
 */

EXTERN char *exp_pty_error;		/* place to pass a string generated */
					/* deep in the innards of the pty */
					/* code but needed by anyone */
EXTERN int exp_disconnected;		/* proc. disc'd from controlling tty */


#endif /* _EXPECT_COMM_H */






Deleted expect_tcl.h.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
























































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

/* expect_tcl.h - include file for using the expect library, libexpect.a
with Tcl (and optionally Tk)

Written by: Don Libes, [email protected], NIST, 12/3/90

Design and implementation of this program was paid for by U.S. tax
dollars.  Therefore it is public domain.  However, the author and NIST
would appreciate credit if this program or parts of it are used.

*/

#ifndef _EXPECT_TCL_H
#define _EXPECT_TCL_H

#include "expect_comm.h"

/*
 * This is a convenience macro used to initialize a thread local storage ptr.
 * Stolen from tclInt.h
 */
#ifndef TCL_TSD_INIT
#define TCL_TSD_INIT(keyPtr)	(ThreadSpecificData *)Tcl_GetThreadData((keyPtr), sizeof(ThreadSpecificData))
#endif

EXTERN int exp_cmdlinecmds;
EXTERN int exp_interactive;
EXTERN FILE *exp_cmdfile;
EXTERN char *exp_cmdfilename;
EXTERN int exp_getpid;	/* pid of Expect itself */
EXTERN int exp_buffer_command_input;

EXTERN int exp_tcl_debugger_available;

EXTERN Tcl_Interp *exp_interp;

#define Exp_Init Expect_Init
EXTERN int	Expect_Init _ANSI_ARGS_((Tcl_Interp *));	/* for Tcl_AppInit apps */
EXTERN void	exp_parse_argv _ANSI_ARGS_((Tcl_Interp *,int argc,char **argv));
EXTERN int	exp_interpreter _ANSI_ARGS_((Tcl_Interp *,Tcl_Obj *));
EXTERN int	exp_interpret_cmdfile _ANSI_ARGS_((Tcl_Interp *,FILE *));
EXTERN int	exp_interpret_cmdfilename _ANSI_ARGS_((Tcl_Interp *,char *));
EXTERN void	exp_interpret_rcfiles _ANSI_ARGS_((Tcl_Interp *,int my_rc,int sys_rc));

EXTERN char *	exp_cook _ANSI_ARGS_((char *s,int *len));

EXTERN void	expCloseOnExec _ANSI_ARGS_((int));

			/* app-specific exit handler */
EXTERN void	(*exp_app_exit)_ANSI_ARGS_((Tcl_Interp *));
EXTERN void	exp_exit_handlers _ANSI_ARGS_((ClientData));

EXTERN void	exp_error _ANSI_ARGS_(TCL_VARARGS(Tcl_Interp *,interp));

#endif /* _EXPECT_TCL_H */






Changes to generic/Dbg.c.





1
2
3
4
5
6
7
8


9
10
11
12
13

14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30

31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54

55
56

57
58
59
60
61
62
63
64
65
66
67
68
69
70
71










72
73
74
75
76
77
78

1
2
3
4
5
6
7
8
9
10
11
12
13
14

15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31

32
33
34
35
36
37
38


















39


40






41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66









+
+




-
+
















-
+






-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
+
-
-
-
-
-
-









+
+
+
+
+
+
+
+
+
+








/* Dbg.c - Tcl Debugger - See cmdHelp() for commands

Written by: Don Libes, NIST, 3/23/93

Design and implementation of this program was paid for by U.S. tax
dollars.  Therefore it is public domain.  However, the author and NIST
would appreciate credit if this program or parts of it are used.

 RCS: @(#) $Id: Dbg.c,v 5.31 2001/08/02 00:30:14 hobbs Exp $

*/

#include <stdio.h>

#include "Dbg_cf.h"
#include "tcldbgcf.h"
#if 0
/* tclInt.h drags in stdlib.  By claiming no-stdlib, force it to drag in */
/* Tcl's compat version.  This avoids having to test for its presence */
/* which is too tricky - configure can't generate two cf files, so when */
/* Expect (or any app) uses the debugger, there's no way to get the info */
/* about whether stdlib exists or not, except pointing the debugger at */
/* an app-dependent .h file and I don't want to do that. */
#define NO_STDLIB_H
#endif


#include "tclInt.h"
/*#include <varargs.h>		tclInt.h drags in varargs.h.  Since Pyramid */
/*				objects to including varargs.h twice, just */
/*				omit this one. */
/*#include "string.h"		tclInt.h drags this in, too! */
#include "Dbg.h"
#include "tcldbg.h"

#ifndef TRUE
#define TRUE 1
#define FALSE 0
#endif


/*
 * Declarations for local procedures defined in this file:
 */

static int		cmdBreak _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
static int		cmdDir _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
static int		cmdHelp _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
static int		cmdNext _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
static int		cmdSimple _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
static int		cmdWhere _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
static int		simple_interactor _ANSI_ARGS_((Tcl_Interp *interp,
static int simple_interactor _ANSI_ARGS_((Tcl_Interp *interp, ClientData data));
			    ClientData data));
static int		zero _ANSI_ARGS_((Tcl_Interp *interp, char *string));
static int zero _ANSI_ARGS_((Tcl_Interp *interp, char *funcname));
static void		print _ANSI_ARGS_(TCL_VARARGS(Tcl_Interp *,interp));
static void		debugger_trap _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int level, char *command,
			    Tcl_CmdProc *cmdProc, ClientData cmdClientData,
			    int argc, char **argv));


/* most of the static variables in this file may be */
/* moved into Tcl_Interp */

static Dbg_InterProc *interactor = simple_interactor;
static ClientData interdata = 0;
static Dbg_IgnoreFuncsProc *ignoreproc = zero;
static Dbg_OutputProc *printproc = 0;
static ClientData printdata = 0;

static void print _ANSI_ARGS_(TCL_VARARGS(Tcl_Interp *,interp));
static Tcl_CmdProc cmdNext;
static Tcl_CmdProc cmdSimple;
static Tcl_CmdProc cmdWhere;
static Tcl_CmdProc cmdBreak;
static Tcl_CmdProc cmdDir;
static Tcl_CmdProc cmdHelp;
static Tcl_CmdTraceProc debugger_trap;


static int debugger_active = FALSE;

/* this is not externally documented anywhere as of yet */
char *Dbg_VarName = "dbg";

#define DEFAULT_COMPRESS	0




︙


92
93
94
95
96
97
98
99

100
101
102
103
104
105
106
107
108
109
110
111
112
113

114

115

116
117
118


119
120
121
122
123
124
125
126
127
128
129
130
131
132

80
81
82
83
84
85
86

87
88
89
90
91
92
93
94
95
96
97
98
99
100

101
102
103

104



105
106
107
108
109
110
111


112
113
114
115
116
117
118








-
+













-
+

+
-
+
-
-
-
+
+





-
-








static char viewFrameName[FRAMENAMELEN];/* destination frame name for up/down */

static CallFrame *goalFramePtr;	/* destination for next/return */
static int goalNumLevel;	/* destination for Next */

static enum debug_cmd {
	none, step, next, ret, cont, up, down, where, Next
} debug_cmd;
} debug_cmd = step;

/* info about last action to use as a default */
static enum debug_cmd last_action_cmd = next;
static int last_step_count = 1;

/* this acts as a strobe (while testing breakpoints).  It is set to true */
/* every time a new debugger command is issued that is an action */
static debug_new_action;

#define NO_LINE -1	/* if break point is not set by line number */

struct breakpoint {
	int id;
	char *file;	/* file where breakpoint is */
	Tcl_Obj *file;	/* file where breakpoint is */
	int line;	/* line where breakpoint is */
	int re;		/* 1 if this is regexp pattern */
	char *pat;	/* pattern defining where breakpoint can be */
	Tcl_Obj *pat;	/* pattern defining where breakpoint can be */
	regexp *re;	/* regular expression to trigger breakpoint */
	char *expr;	/* expr to trigger breakpoint */
	char *cmd;	/* cmd to eval at breakpoint */
	Tcl_Obj *expr;	/* expr to trigger breakpoint */
	Tcl_Obj *cmd;	/* cmd to eval at breakpoint */
	struct breakpoint *next, *previous;
};

static struct breakpoint *break_base = 0;
static int breakpoint_max_id = 0;



static struct breakpoint *
breakpoint_new()
{
	struct breakpoint *b = (struct breakpoint *)ckalloc(sizeof(struct breakpoint));
	if (break_base) break_base->previous = b;
	b->next = break_base;




︙


144
145
146
147
148
149
150
151

152
153
154
155
156
157
158
159
160
161
162










163
164
165


166
167
168


169
170

171
172
173
174

175
176


177

178
179


180
181
182

183
184





185
186

187
188
189
190
191


192
193
194

195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212





















213
214
215


216
217
218
219
220
221





222
223
224
225
226
227





228
229

230
231
232
233
234
235
236

130
131
132
133
134
135
136

137
138










139
140
141
142
143
144
145
146
147
148
149


150
151
152


153
154
155

156
157
158
159

160
161

162
163
164
165


166
167


168
169


170
171
172
173
174
175

176





177
178



179
180
181
182
183
184
185
186
187
188









189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210


211
212
213





214
215
216
217
218
219





220
221
222
223
224
225

226
227
228
229
230
231
232
233








-
+

-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+

-
-
+
+

-
-
+
+

-
+



-
+

-
+
+

+
-
-
+
+
-
-

+
-
-
+
+
+
+
+

-
+
-
-
-
-
-
+
+
-
-
-
+









-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
+
+

-
-
-
-
-
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+

-
+









static
void
breakpoint_print(interp,b)
Tcl_Interp *interp;
struct breakpoint *b;
{
	print(interp,"breakpoint %d: ",b->id);
    print(interp,"breakpoint %d: ",b->id);

	if (b->re) {
		print(interp,"-re \"%s\" ",b->pat);
	} else if (b->pat) {
		print(interp,"-glob \"%s\" ",b->pat);
	} else if (b->line != NO_LINE) {
		if (b->file) {
			print(interp,"%s:",b->file);
		}
		print(interp,"%d ",b->line);
	}
    if (b->re) {
	print(interp,"-re \"%s\" ",Tcl_GetString(b->pat));
    } else if (b->pat) {
	print(interp,"-glob \"%s\" ",Tcl_GetString(b->pat));
    } else if (b->line != NO_LINE) {
	if (b->file) {
	    print(interp,"%s:",Tcl_GetString(b->file));
	}
	print(interp,"%d ",b->line);
    }

	if (b->expr)
		print(interp,"if {%s} ",b->expr);
    if (b->expr)
	print(interp,"if {%s} ",Tcl_GetString(b->expr));

	if (b->cmd)
		print(interp,"then {%s}",b->cmd);
    if (b->cmd)
	print(interp,"then {%s}",Tcl_GetString(b->cmd));

	print(interp,"\n");
    print(interp,"\n");
}

static void
save_re_matches(interp,re)
save_re_matches(interp, re, objPtr)
Tcl_Interp *interp;
regexp *re;
Tcl_RegExp re;
Tcl_Obj *objPtr;
{
    Tcl_RegExpInfo info;
	int i;
	char name[20];
    int i, start;
    char name[20];
	char match_char;/* place to hold char temporarily */
			/* uprooted by a NULL */

    Tcl_RegExpGetInfo(re, &info); 
	for (i=0;i<NSUBEXP;i++) {
		if (re->startp[i] == 0) break;
    for (i=0;i<=info.nsubs;i++) {
	start = info.matches[i].start;
	/* end = info.matches[i].end-1;*/

	if (start == -1) continue;

		sprintf(name,"%d",i);
	sprintf(name,"%d",i);
		/* temporarily null-terminate in middle */
		match_char = *re->endp[i];
		*re->endp[i] = 0;
		Tcl_SetVar2(interp,Dbg_VarName,name,re->startp[i],0);

	Tcl_SetVar2Ex(interp, Dbg_VarName, name, Tcl_GetRange(objPtr,
		info.matches[i].start, info.matches[i].end-1), 0);
		/* undo temporary null-terminator */
		*re->endp[i] = match_char;
	}
    }
}

/* return 1 to break, 0 to continue */
static int
breakpoint_test(interp,cmd,bp)
Tcl_Interp *interp;
char *cmd;		/* command about to be executed */
struct breakpoint *bp;	/* breakpoint to test */
{
	if (bp->re) {
		if (0 == TclRegExec(bp->re,cmd,cmd)) return 0;
		save_re_matches(interp,bp->re);
	} else if (bp->pat) {
		if (0 == Tcl_StringMatch(cmd,bp->pat)) return 0;
	} else if (bp->line != NO_LINE) {
		/* not yet implemented - awaiting support from Tcl */
		return 0;
	}
    if (bp->re) {
        int found = 0;
	Tcl_Obj *cmdObj;
	Tcl_RegExp re = Tcl_GetRegExpFromObj(NULL, bp->pat,
		TCL_REG_ADVANCED);
	cmdObj = Tcl_NewStringObj(cmd,-1);
	Tcl_IncrRefCount(cmdObj);
	if (Tcl_RegExpExecObj(NULL, re, cmdObj, 0 /* offset */,
		-1 /* nmatches */, 0 /* eflags */) > 0) {
	    save_re_matches(interp, re, cmdObj);
	    found = 1;
	}
	Tcl_DecrRefCount(cmdObj);
	if (!found) return 0;
    } else if (bp->pat) {
	if (0 == Tcl_StringMatch(cmd,
		Tcl_GetString(bp->pat))) return 0;
    } else if (bp->line != NO_LINE) {
	/* not yet implemented - awaiting support from Tcl */
	return 0;
    }

	if (bp->expr) {
		int value;
    if (bp->expr) {
	int value;

		/* ignore errors, since they are likely due to */
		/* simply being out of scope a lot */
		if (TCL_OK != Tcl_ExprBoolean(interp,bp->expr,&value)
		    || (value == 0)) return 0;
	}
	/* ignore errors, since they are likely due to */
	/* simply being out of scope a lot */
	if (TCL_OK != Tcl_ExprBooleanObj(interp,bp->expr,&value)
		|| (value == 0)) return 0;
    }

	if (bp->cmd) {
		Tcl_Eval(interp,bp->cmd);
	} else {
		breakpoint_print(interp,bp);
	}
    if (bp->cmd) {
	Tcl_EvalObjEx(interp, bp->cmd, 0);
    } else {
	breakpoint_print(interp,bp);
    }

	return 1;
    return 1;
}

static char *already_at_top_level = "already at top level";

/* similar to TclGetFrame but takes two frame ptrs and a direction.
If direction is up,   search up stack from curFrame
If direction is down, simulate searching down stack by




︙


311
312
313
314
315
316
317
318
319
320
321
322






323
324

325
326
327
328
329
330
331
332







333
334

335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360

























361
362
363
364
365
366
367

308
309
310
311
312
313
314





315
316
317
318
319
320
321

322
323







324
325
326
327
328
329
330
331

332


























333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364








-
-
-
-
-
+
+
+
+
+
+

-
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+

-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








    return result;
}


static char *printify(s)
char *s;
{
	static int destlen = 0;
	char *d;		/* ptr into dest */
	int need;
	static char buf_basic[DEFAULT_WIDTH+1];
	static char *dest = buf_basic;
    static int destlen = 0;
    char *d;		/* ptr into dest */
    unsigned int need;
    static char buf_basic[DEFAULT_WIDTH+1];
    static char *dest = buf_basic;
    Tcl_UniChar ch;

	if (s == 0) return("<null>");
    if (s == 0) return("<null>");

	/* worst case is every character takes 4 to printify */
	need = strlen(s)*4;
	if (need > destlen) {
		if (dest && (dest != buf_basic)) ckfree(dest);
		dest = (char *)ckalloc(need+1);
		destlen = need;
	}
    /* worst case is every character takes 4 to printify */
    need = strlen(s)*6;
    if (need > destlen) {
	if (dest && (dest != buf_basic)) ckfree(dest);
	dest = (char *)ckalloc(need+1);
	destlen = need;
    }

	for (d = dest;*s;s++) {
    for (d = dest;*s;) {
		/* since we check at worst by every 4 bytes, play */
		/* conservative and subtract 4 from the limit */
		if (d-dest > destlen-4) break;

		if (*s == '\b') {
			strcpy(d,"\\b");		d += 2;
		} else if (*s == '\f') {
			strcpy(d,"\\f");		d += 2;
		} else if (*s == '\v') {
			strcpy(d,"\\v");		d += 2;
		} else if (*s == '\r') {
			strcpy(d,"\\r");		d += 2;
		} else if (*s == '\n') {
			strcpy(d,"\\n");		d += 2;
		} else if (*s == '\t') {
			strcpy(d,"\\t");		d += 2;
		} else if ((unsigned)*s < 0x20) { /* unsigned strips parity */
			sprintf(d,"\\%03o",*s);		d += 4;
		} else if (*s == 0177) {
			strcpy(d,"\\177");		d += 4;
		} else {
			*d = *s;			d += 1;
		}
	}
	*d = '\0';
	return(dest);
	s += Tcl_UtfToUniChar(s, &ch);
	if (ch == '\b') {
	    strcpy(d,"\\b");		d += 2;
	} else if (ch == '\f') {
	    strcpy(d,"\\f");		d += 2;
	} else if (ch == '\v') {
	    strcpy(d,"\\v");		d += 2;
	} else if (ch == '\r') {
	    strcpy(d,"\\r");		d += 2;
	} else if (ch == '\n') {
	    strcpy(d,"\\n");		d += 2;
	} else if (ch == '\t') {
	    strcpy(d,"\\t");		d += 2;
	} else if ((unsigned)ch < 0x20) { /* unsigned strips parity */
	    sprintf(d,"\\%03o",ch);		d += 4;
	} else if (ch == 0177) {
	    strcpy(d,"\\177");		d += 4;
	} else if ((ch < 0x80) && isprint(UCHAR(ch))) {
	    *d = (char)ch;		d += 1;
	} else {
	    sprintf(d,"\\u%04x",ch);	d += 6;
	}
    }
    *d = '\0';
    return(dest);
}

static
char *
print_argv(interp,argc,argv)
Tcl_Interp *interp;
int argc;




︙


387
388
389
390
391
392
393
394
395


396
397
398
399
400
401
402
403
404
405
406
407
408

409
410
411

412
413
414
415
416
417
418

384
385
386
387
388
389
390


391
392
393
394
395
396
397
398
399
400
401
402
403
404

405
406


407
408
409
410
411
412
413
414








-
-
+
+












-
+

-
-
+








	len = strlen(buf);
	space = buf_width - len;
	bufp = buf + len;
	argc--; argv++;
	arg_index = 1;
	
	while (argc && (space > 0)) {
		char *elementPtr;
		char *nextPtr;
		CONST char *elementPtr;
		CONST char *nextPtr;
		int wrap;

		/* braces/quotes have been stripped off arguments */
		/* so put them back.  We wrap everything except lists */
		/* with one argument.  One exception is to always wrap */
		/* proc's 2nd arg (the arg list), since people are */
		/* used to always seeing it this way. */

		if (proc && (arg_index > 1)) wrap = TRUE;
		else {
			(void) TclFindElement(interp,*argv,
#if TCL_MAJOR_VERSION >= 8
				        strlen(*argv),
					      -1,
#endif
					&elementPtr,
					&nextPtr,(int *)0,(int *)0);
				&elementPtr,&nextPtr,(int *)0,(int *)0);
			if (*elementPtr == '\0') wrap = TRUE;
			else if (*nextPtr == '\0') wrap = FALSE;
			else wrap = TRUE;
		}

		/* wrap lists (or null) in braces */
		if (wrap) {




︙


432
433
434
435
436
437
438
439

440
441
442
443
444




















445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464

465

466
467
468
469
470
471
472
473
474
475
476

477
478
479
480
481
482
483
484
485

428
429
430
431
432
433
434

435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478

479
480

481
482










483


484
485
486
487
488
489
490








-
+





+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


















-

+
-
+

-
-
-
-
-
-
-
-
-
-
+
-
-








		/* and back to our static buf */
		strncpy(buf,printify(buf),buf_width);
	}

	/* usually but not always right, but assume truncation if buffer is */
	/* full.  this avoids tiny but odd-looking problem of appending "}" */
	/* to truncated lists during {}-wrapping earlier */
	if (strlen(buf) == (size_t) buf_width) {
	if (strlen(buf) == buf_width) {
		buf[buf_width-1] = buf[buf_width-2] = buf[buf_width-3] = '.';
	}

	return(buf);
}

#if TCL_MAJOR_VERSION >= 8
static
char *
print_objv(interp,objc,objv)
Tcl_Interp *interp;
int objc;
Tcl_Obj *objv[];
{
    char **argv;
    int argc;
    int len;
    argv = (char **)ckalloc(objc+1 * sizeof(char *));
    for (argc=0 ; argc<objc ; argc++) {
	argv[argc] = Tcl_GetStringFromObj(objv[argc],&len);
    }
    argv[argc] = NULL;
    return(print_argv(interp,argc,argv));
}
#endif

static
void
PrintStackBelow(interp,curf,viewf)
Tcl_Interp *interp;
CallFrame *curf;	/* current FramePtr */
CallFrame *viewf;	/* view FramePtr */
{
	char ptr;	/* graphically indicate where we are in the stack */

	/* indicate where we are in the stack */
	ptr = ((curf == viewf)?'*':' ');

	if (curf == 0) {
		print(interp,"%c0: %s\n",
				ptr,print_argv(interp,main_argc,main_argv));
	} else {
		PrintStackBelow(interp,curf->callerVarPtr,viewf);
#if TCL_MAJOR_VERSION < 8
		print(interp,"%c%d: %s\n",ptr,curf->level,
#if TCL_MAJOR_VERSION >= 8
			print_argv(interp,curf->argc,curf->argv));
			print_objv(interp,curf->objc,curf->objv));
#else
		if (1) {
			char **argv;
			int i, length;
			argv = (char **) ckalloc(curf->objc * sizeof(char *));
			for (i = 0; i < curf->objc; i++) {
				argv[i] = Tcl_GetStringFromObj(curf->objv[i],
							       &length);
			}
			print(interp,"%c%d: %s\n",ptr,curf->level,
			      print_argv(interp,curf->objc, argv));
			print_argv(interp,curf->argc,curf->argv));
			ckfree((char *) argv);
		}
#endif
	}
}

static
void
PrintStack(interp,curf,viewf,argc,argv,level)




︙


518
519
520
521
522
523
524

















525
526
527
528
529
530
531

523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553








+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








		if (goal == cf) {
			/* found, but since it's above us, fail */
			return 1;
		}
	}
	return 0;
}

static char *cmd_print(cmdtype)
enum debug_cmd cmdtype;
{
	switch (cmdtype) {
	case none:  return "cmd: none";
	case step:  return "cmd: step";
	case next:  return "cmd: next";
	case ret:   return "cmd: ret";
	case cont:  return "cmd: cont";
	case up:    return "cmd: up";
	case down:  return "cmd: down";
	case where: return "cmd: where";
	case Next:  return "cmd: Next";
	}
	return "cmd: Unknown";
}

/* debugger's trace handler */
/*ARGSUSED*/
static void
debugger_trap(clientData,interp,level,command,cmdProc,cmdClientData,argc,argv)
ClientData clientData;		/* not used */
Tcl_Interp *interp;




︙


583
584
585
586
587
588
589
590



591
592
593
594

595
596
597
598
599
600
601

605
606
607
608
609
610
611

612
613
614
615
616
617

618
619
620
621
622
623
624
625








-
+
+
+



-
+








	/* if any successful breakpoints, start interactor */
	debug_new_action = FALSE;	/* reset strobe */
	break_status = FALSE;		/* no successful breakpoints yet */
	for (b = break_base;b;b=b->next) {
		break_status |= breakpoint_test(interp,command,b);
	}
	if (break_status) {
		if (!debug_new_action) goto start_interact;
		if (!debug_new_action) {
			goto start_interact;
		}

		/* if s or n triggered by breakpoint, make "s 1" */
		/* (and so on) refer to next command, not this one */
/*		step_count++;*/
		/* step_count++;*/
		goto end_interact;
	}

	switch (debug_cmd) {
	case cont:
		goto finish;
	case step:




︙


698
699
700
701
702
703
704

705
706
707
708
709
710
711

722
723
724
725
726
727
728
729
730
731
732
733
734
735
736








+








ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
	debug_new_action = TRUE;
	debug_cmd = *(enum debug_cmd *)clientData;

	last_action_cmd = debug_cmd;

	step_count = (argc == 1)?1:atoi(argv[1]);
	last_step_count = step_count;
	return(TCL_RETURN);
}





︙


743
744
745
746
747
748
749
750
751
752
753




754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773


774
775
776
777


778
779
780
781
782
783
784

768
769
770
771
772
773
774




775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796


797
798
799
800


801
802
803
804
805
806
807
808
809








-
-
-
-
+
+
+
+


















-
-
+
+


-
-
+
+








}

static
void
breakpoint_destroy(b)
struct breakpoint *b;
{
	if (b->file) ckfree(b->file);
	if (b->pat) ckfree(b->pat);
	if (b->re) ckfree((char *)b->re);			
	if (b->cmd) ckfree(b->cmd);
	if (b->file) Tcl_DecrRefCount(b->file);
	if (b->pat) Tcl_DecrRefCount(b->pat);
	if (b->cmd) Tcl_DecrRefCount(b->cmd);
	if (b->expr) Tcl_DecrRefCount(b->expr);

	/* unlink from chain */
	if ((b->previous == 0) && (b->next == 0)) {
		break_base = 0;
	} else if (b->previous == 0) {
		break_base = b->next;
		b->next->previous = 0;
	} else if (b->next == 0) {
		b->previous->next = 0;
	} else {
		b->previous->next = b->next;
		b->next->previous = b->previous;
	}

	ckfree((char *)b);
}

static void
savestr(straddr,str)
char **straddr;
savestr(objPtr,str)
Tcl_Obj **objPtr;
char *str;
{
	*straddr = ckalloc(strlen(str)+1);
	strcpy(*straddr,str);
    *objPtr = Tcl_NewStringObj(str, -1);
    Tcl_IncrRefCount(*objPtr);
}

/* return 1 if a string is substring of a flag */
static int
flageq(flag,string,minlen)
char *flag;
char *string;




︙


872
873
874
875
876
877
878
879
880
881









882
883
884
885
886
887
888

897
898
899
900
901
902
903



904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919








-
-
-
+
+
+
+
+
+
+
+
+








		}
	}

	b = breakpoint_new();

	if (flageq("-regexp",argv[0],2)) {
		argc--; argv++;
		if ((argc > 0) && (b->re = TclRegComp(argv[0]))) {
			savestr(&b->pat,argv[0]);
			argc--; argv++;
		if (argc > 0) {
		    b->re = 1;
		    savestr(&b->pat,argv[0]);
		    if (Tcl_GetRegExpFromObj(interp, b->pat, TCL_REG_ADVANCED)
			    == NULL) {
			breakpoint_destroy(b);
			return TCL_ERROR;
		    }
		    argc--; argv++;
		} else {
			breakpoint_fail("bad regular expression")
		}
	} else if (flageq("-glob",argv[0],2)) {
		argc--; argv++;
		if (argc > 0) {
			savestr(&b->pat,argv[0]);




︙


909
910
911
912
913
914
915
916

917
918
919
920
921
922
923

940
941
942
943
944
945
946

947
948
949
950
951
952
953
954








-
+









		if (TCL_OK == Tcl_GetInt(interp,linep,&b->line)) {
			argc--; argv++;
			print(interp,"setting breakpoints by line number is currently unimplemented - use patterns or expressions\n");
		} else {
			/* not an int? - unwind & assume it is an expression */

			if (b->file) ckfree(b->file);
			if (b->file) Tcl_DecrRefCount(b->file);
		}
	}

	if (argc > 0) {
		int do_if = FALSE;

		if (flageq("if",argv[0],1)) {




︙


1131
1132
1133
1134
1135
1136
1137
1138

1139
1140

1141
1142
1143

1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155












1156


1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192

1193
1194
1195
1196
1197
1198
1199

1162
1163
1164
1165
1166
1167
1168

1169
1170

1171
1172
1173

1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198

1199
1200
1201
1202
1203
1204
1205
























1206
1207
1208
1209

1210

1211
1212
1213
1214
1215
1216
1217
1218








-
+

-
+


-
+












+
+
+
+
+
+
+
+
+
+
+
+
-
+
+





-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-




-

-
+








Tcl_Interp *interp;
char *string;
{
	return 0;
}

static int
simple_interactor(interp, clientData)
simple_interactor(interp,data)
Tcl_Interp *interp;
ClientData clientData;
ClientData data;
{
	int rc;
	char *ccmd;		/* pointer to complete command */
	char *ccmd;	/* pointer to complete command */
	char line[BUFSIZ+1];	/* space for partial command */
	int newcmd = TRUE;
	Interp *iPtr = (Interp *)interp;

	Tcl_DString dstring;
	Tcl_DStringInit(&dstring);

	newcmd = TRUE;
	while (TRUE) {
		struct cmd_list *c;

		if (newcmd) {
#if TCL_MAJOR_VERSION < 8
			print(interp,"dbg%d.%d> ",iPtr->numLevels,iPtr->curEventNum+1);
#else
			/* unncessarily tricky coding - if nextid
			   isn't defined, maintain our own static
			   version */

			static int nextid = 0;
			char *nextidstr = Tcl_GetVar2(interp,"tcl::history","nextid",0);
			if (nextidstr) {
				sscanf(nextidstr,"%d",&nextid);
			}
			print(interp,"dbg%d> ",iPtr->numLevels);
			print(interp,"dbg%d.%d> ",iPtr->numLevels,nextid++);
#endif
		} else {
			print(interp,"dbg+> ");
		}
		fflush(stdout);

#ifdef __WIN32__
		if (1) {
			Tcl_Obj *objv[3];
			char *end;

			objv[0] = Tcl_NewStringObj("gets", -1);
			objv[1] = Tcl_NewStringObj("stdin", -1);
			objv[2] = Tcl_NewStringObj("ExpectTmpDbgVarX0X0X0Y", -1);
			rc = Tcl_GetsObjCmd(NULL, interp, 3, objv);
			Tcl_DecrRefCount(objv[0]);
			Tcl_DecrRefCount(objv[1]);
			Tcl_DecrRefCount(objv[2]);
			if (rc == TCL_ERROR) {
				return TCL_ERROR;
			}
			if (interp->result[0] == '-') {
				Tcl_AppendResult(interp,
						 "error: stdin is non-blocking, can't debug", NULL);
				return TCL_ERROR;
			}
			rc = strtoul(interp->result, &end, 10);
			strcpy(line, interp->result);
		}
#else
		if (0 >= (rc = read(0,line,BUFSIZ))) {
			if (!newcmd) line[0] = 0;
			else exit(0);
		} else line[rc] = '\0';
#endif

		ccmd = Tcl_DStringAppend(&dstring,line,rc);
		(CONST char *) ccmd = Tcl_DStringAppend(&dstring,line,rc);
		if (!Tcl_CommandComplete(ccmd)) {
			newcmd = FALSE;
			continue;	/* continue collecting command */
		}
		newcmd = TRUE;

		/* if user pressed return with no cmd, use previous one */




︙


1286
1287
1288
1289
1290
1291
1292





1293

1294
1295
1296
1297
1298
1299

1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320






1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316

1317
1318
1319
1320
1321
1322

1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343

1344
1345
1346
1347
1348








+
+
+
+
+
-
+





-
+




















-
+
+
+
+
+

Tcl_Interp *interp;
int immediate;		/* if true, stop immediately */
			/* should only be used in safe places */
			/* i.e., when Tcl_Eval can be called */
{
	if (!debugger_active) init_debugger(interp);

	/* Initialize debugger in single-step mode.
	 *
	 * Note: if the command reader is already active, it's too late
	 * which is why we also statically initialize debug_cmd to step.
	 */
	debug_cmd = step;
	debug_cmd = step; 
	step_count = 1;

	if (immediate) {
		static char *fake_cmd = "--interrupted-- (command_unknown)";

		debugger_trap((ClientData)0,interp,-1,fake_cmd,(Tcl_CmdProc *)0,
		debugger_trap((ClientData)0,interp,-1,fake_cmd,0,
					(ClientData)0,1,&fake_cmd);
/*		(*interactor)(interp);*/
	}
}

void
Dbg_Off(interp)
Tcl_Interp *interp;
{
	struct cmd_list *c;

	if (!debugger_active) return;

	for (c = cmd_list;c->cmdname;c++) {
		Tcl_DeleteCommand(interp,c->cmdname);
	}

	Tcl_DeleteTrace(interp,debug_handle);
	debugger_active = FALSE;
	Tcl_UnsetVar(interp,Dbg_VarName,TCL_GLOBAL_ONLY);
}

	/* initialize for next use */
	debug_cmd = step;
	step_count = 1;
}






Changes to generic/Dbg.h.






︙


9
10
11
12
13
14
15















16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37


38
39
40

41
42

43
44
45


46
47
48


49
50
51
52

53
54
55

56
57
58
59
60

9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50


51
52
53
54

55
56

57
58


59
60
61


62
63
64
65
66

67
68
69

70
71
72
73
74
75








+
+
+
+
+
+
+
+
+
+
+
+
+
+
+




















-
-
+
+


-
+

-
+

-
-
+
+

-
-
+
+



-
+


-
+






*/

/* _DEBUG or _DBG is just too likely, use something more unique */
#ifndef _NIST_DBG
#define _NIST_DBG

#include "tcl.h"

#ifndef TCL_NEWEXTERN
#   ifdef __cplusplus
#	define OLDEXTERN    extern "C" TCL_STORAGE_CLASS
#   else
#	define OLDEXTERN    extern TCL_STORAGE_CLASS
#   endif
#   undef EXTERN
#   define EXTERN(a) OLDEXTERN a
#endif


#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLEXPORT


typedef int (Dbg_InterProc) _ANSI_ARGS_((Tcl_Interp *interp, ClientData data));
typedef int (Dbg_IgnoreFuncsProc) _ANSI_ARGS_((
			Tcl_Interp *interp,
			char *funcname));
typedef void (Dbg_OutputProc) _ANSI_ARGS_((
			Tcl_Interp *interp,
			char *output,
			ClientData data));

typedef struct {
  Dbg_InterProc *func;
  ClientData data;
} Dbg_InterStruct;

typedef struct {
  Dbg_OutputProc *func;
  ClientData data;
} Dbg_OutputStruct;

EXTERN char *Dbg_VarName;
EXTERN char *Dbg_DefaultCmdName;
char * Dbg_VarName;
char * Dbg_DefaultCmdName;

/* trivial interface, creates a "debug" command in your interp */
EXTERN int Dbg_Init _ANSI_ARGS_((Tcl_Interp *));
EXTERN(int) Dbg_Init _ANSI_ARGS_((Tcl_Interp *));

EXTERN void Dbg_On _ANSI_ARGS_((Tcl_Interp *interp,
void Dbg_On _ANSI_ARGS_((Tcl_Interp *interp,
					int immediate));
EXTERN void Dbg_Off _ANSI_ARGS_((Tcl_Interp *interp));
EXTERN char **Dbg_ArgcArgv _ANSI_ARGS_((int argc,char *argv[],
void Dbg_Off _ANSI_ARGS_((Tcl_Interp *interp));
char ** Dbg_ArgcArgv _ANSI_ARGS_((int argc,char *argv[],
					int copy));
EXTERN int Dbg_Active _ANSI_ARGS_((Tcl_Interp *interp));
EXTERN Dbg_InterStruct Dbg_Interactor _ANSI_ARGS_((
int Dbg_Active _ANSI_ARGS_((Tcl_Interp *interp));
Dbg_InterStruct Dbg_Interactor _ANSI_ARGS_((
					Tcl_Interp *interp,
					Dbg_InterProc *interactor,
					ClientData data));
EXTERN Dbg_IgnoreFuncsProc *Dbg_IgnoreFuncs _ANSI_ARGS_((
Dbg_IgnoreFuncsProc * Dbg_IgnoreFuncs _ANSI_ARGS_((
					Tcl_Interp *interp,
					Dbg_IgnoreFuncsProc *));
EXTERN Dbg_OutputStruct Dbg_Output _ANSI_ARGS_((
Dbg_OutputStruct Dbg_Output _ANSI_ARGS_((
					Tcl_Interp *interp,
					Dbg_OutputProc *,
					ClientData data));

#endif /* _NIST_DBG */






Added generic/exp.decls.





















































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

# exp.decls --
#
#	This file contains the declarations for all supported public
#	functions that are exported by the Expect library via the stubs table.
#	This file is used to generate the expDecls.h, expPlatDecls.h,
#	expIntDecls.h, and expStub.c files.
#
# RCS: @(#) $Id: tcl.decls,v 1.63 2001/09/28 01:21:53 dgp Exp $

library exp

# Define the tcl interface with several sub interfaces:
#     expPlat	 - platform specific public
#     expInt	 - generic private
#     expPlatInt - platform specific private

interface exp
hooks {expPlat expInt expIntPlat}

# Declare each of the functions in the public Expect interface.  Note that
# the an index should never be reused for a different function in order
# to preserve backwards compatibility.

declare 0 generic {
	int Expect_Init (Tcl_Interp *interp)
}
declare 1 generic {
	int Expect_SafeInit (Tcl_Interp *interp)
}

interface expPlat

#====================================================================================
# UNIX specific publics.

declare 0 unix {
}

#====================================================================================
# WIN32 specific publics.



#====================================================================================
# MAC specific publics.

### You nutts!!  can't do Mac... sorry..






Added generic/exp.h.






























































































































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/*
 * exp.h --
 *
 *	Public include file for using the Expect extension.
 * 
 * Written by: Don Libes, [email protected], NIST, 12/3/90
 * 
 * Design and implementation of this program was paid for by U.S. tax
 * dollars.  Therefore it is public domain.  However, the author and NIST
 * would appreciate credit if this program or parts of it are used.
 * 
 * Modified in October, 2001 by David Gravereaux for windows.
 *
 * RCS: @(#) $Id: exp.h,v 1.1.2.2 2001/10/28 01:46:31 davygrvy Exp $
 */

#ifndef _EXP
#define _EXP

#ifndef _TCL
#   include "tcl.h"
#endif

/*
 *  Version stuff.
 */

#define EXP_MAJOR_VERSION   6
#define EXP_MINOR_VERSION   0
#define EXP_RELEASE_LEVEL   TCL_ALPHA_RELEASE
#define EXP_RELEASE_SERIAL  1

#define EXP_VERSION	   STRINGIFY(JOIN(EXP_MAJOR_VERSION,JOIN(.,EXP_MINOR_VERSION)))

#if	EXP_RELEASE_LEVEL == TCL_ALPHA_RELEASE
#	define EXP_PATCH_LEVEL \
		STRINGIFY( \
			JOIN(JOIN(EXP_MAJOR_VERSION, \
			JOIN(., EXP_MINOR_VERSION)), \
			JOIN(a, EXP_RELEASE_SERIAL)))

#elif	EXP_RELEASE_LEVEL == TCL_BETA_RELEASE
#	define EXP_PATCH_LEVEL \
		STRINGIFY( \
			JOIN(JOIN(EXP_MAJOR_VERSION, \
			JOIN(., EXP_MINOR_VERSION)), \
			JOIN(b, EXP_RELEASE_SERIAL)))

#elif	EXP_RELEASE_LEVEL == TCL_FINAL_RELEASE
#	define EXP_PATCH_LEVEL \
		STRINGIFY( \
			JOIN(JOIN(EXP_MAJOR_VERSION, \
			JOIN(., EXP_MINOR_VERSION)), \
			JOIN(., EXP_RELEASE_SERIAL)))

#else
#	include "bad/release/level/used"
#endif

/*
 * The resource compiler defines this by default.  Skip the rest of this
 * file when included from an rc script.
 */
#ifndef RC_INVOKED


#undef TCL_STORAGE_CLASS
#ifdef BUILD_exp
#   define TCL_STORAGE_CLASS DLLEXPORT
#else
#   ifdef USE_EXP_STUBS
#	define TCL_STORAGE_CLASS
#   else
#	define TCL_STORAGE_CLASS DLLIMPORT
#   endif
#endif


/*
 * Fix the Borland bug that's been in Tcl since when dinosaurs roamed the
 * earth.
 */
#ifndef TCL_EXTERN
#   undef DLLIMPORT
#   undef DLLEXPORT
#   if defined(__WIN32__) && (defined(_MSC_VER) || (defined(__GNUC__) && defined(__declspec)))
#	define DLLIMPORT __declspec(dllimport)
#	define DLLEXPORT __declspec(dllexport)
#   elif defined(__BORLANDC__)
#	define DLLIMPORT __import
#	define DLLEXPORT __export
#   else
#	define DLLIMPORT
#	define DLLEXPORT
#   endif
    /*
     * Make sure name mangling won't happen when the c++ language extensions
     * are used.
     */
#   ifdef __cplusplus
#	define TCL_CPP "C"
#   else
#	define TCL_CPP
#   endif
    /*
     * Borland requires the attributes be placed after the return type.
     */
#   ifdef __BORLANDC__
#	define TCL_EXTERN(rtnType) extern TCL_CPP rtnType TCL_STORAGE_CLASS
#   else
#	define TCL_EXTERN(rtnType) extern TCL_CPP TCL_STORAGE_CLASS rtnType
#   endif
#endif


/* common return codes for Expect functions */
/* The library actually only uses TIMEOUT and EOF */
#define EXP_ABEOF	-1	/* abnormal eof in Expect */
				/* when in library, this define is not used. */
				/* Instead "-1" is used literally in the */
				/* usual sense to check errors in system */
				/* calls */
#define EXP_TIMEOUT	-2
#define EXP_TCLERROR	-3
#define EXP_FULLBUFFER	-5
#define EXP_MATCH	-6
#define EXP_NOMATCH	-7
#define EXP_CANTMATCH	EXP_NOMATCH
#define EXP_CANMATCH	-8
#define EXP_DATA_NEW	-9	/* if select says there is new data */
#define EXP_DATA_OLD	-10	/* if we already read data in another cmd */
#define EXP_EOF		-11
#define EXP_RECONFIGURE	-12	/* changes to indirect spawn id lists */
				/* require us to reconfigure things */

/* in the unlikely event that a signal handler forces us to return this */
/* through expect's read() routine, we temporarily convert it to this. */
#define EXP_TCLRET	-20
#define EXP_TCLCNT	-21
#define EXP_TCLCNTTIMER	-22
#define EXP_TCLBRK	-23
#define EXP_TCLCNTEXP	-24
#define EXP_TCLRETTCL	-25

/* yet more TCL return codes */
/* Tcl does not safely provide a way to define the values of these, so */
/* use ridiculously different numbers for safety */
#define EXP_CONTINUE		-101	/* continue expect command */
					/* and restart timer */
#define EXP_CONTINUE_TIMER	-102	/* continue expect command */
					/* and continue timer */
#define EXP_TCL_RETURN		-103	/* converted by interact */
					/* and interpeter from */
					/* inter_return into */
					/* TCL_RETURN*/


/* Protos for exp_win.c, not yet move to the Stubs table. */
TCL_EXTERN(int)	    exp_window_size_set	    _ANSI_ARGS_((int fd));
TCL_EXTERN(int)	    exp_window_size_get	    _ANSI_ARGS_((int fd));
TCL_EXTERN(void)    exp_win_rows_set	    _ANSI_ARGS_((char *rows));
TCL_EXTERN(void)    exp_win_rows_get	    _ANSI_ARGS_((char *rows));
TCL_EXTERN(void)    exp_win_columns_set	    _ANSI_ARGS_((char *columns));
TCL_EXTERN(void)    exp_win_columns_get	    _ANSI_ARGS_((char *columns));
TCL_EXTERN(int)	    exp_win2_size_get	    _ANSI_ARGS_((int fd));
TCL_EXTERN(int)	    exp_win2_size_set	    _ANSI_ARGS_((int fd));
TCL_EXTERN(void)    exp_win2_rows_set	    _ANSI_ARGS_((int fd, char *rows));
TCL_EXTERN(void)    exp_win2_rows_get	    _ANSI_ARGS_((int fd, char *rows));
TCL_EXTERN(void)    exp_win2_columns_set    _ANSI_ARGS_((int fd, char *columns));
TCL_EXTERN(void)    exp_win2_columns_get    _ANSI_ARGS_((int fd, char *columns));

/* from expect_tcl.h */
TCL_EXTERN(int)	Expect_Init _ANSI_ARGS_((Tcl_Interp *));	/* for Tcl_AppInit apps */
TCL_EXTERN(void)	exp_parse_argv _ANSI_ARGS_((Tcl_Interp *,int argc,char **argv));
TCL_EXTERN(int)	exp_interpreter _ANSI_ARGS_((Tcl_Interp *,Tcl_Obj *));
TCL_EXTERN(int)	exp_interpret_cmdfile _ANSI_ARGS_((Tcl_Interp *,FILE *));
TCL_EXTERN(int)	exp_interpret_cmdfilename _ANSI_ARGS_((Tcl_Interp *,char *));
TCL_EXTERN(void)	exp_interpret_rcfiles _ANSI_ARGS_((Tcl_Interp *,int my_rc,int sys_rc));

TCL_EXTERN(char *)	exp_cook _ANSI_ARGS_((char *s,int *len));
TCL_EXTERN(void)	expCloseOnExec _ANSI_ARGS_((int));

			/* app-specific exit handler */
//TCL_EXTERN(void)	*exp_app_exit _ANSI_ARGS_((Tcl_Interp *));
//TCL_EXTERN(void)	exp_exit_handlers _ANSI_ARGS_((ClientData));
TCL_EXTERN(void)	exp_error _ANSI_ARGS_(TCL_VARARGS(Tcl_Interp *,interp));
TCL_EXTERN(int)		exp_getpidproc _ANSI_ARGS_((void));



/*
 * Include the public function declarations that are accessible via
 * the stubs table.
 */

#include "expDecls.h"


/*
 * Exp_InitStubs is used by apps/extensions that want to link
 * against the expect stubs library.  If we are not using stubs,
 * then this won't be declared.
 */

#ifdef USE_EXP_STUBS
extern TCL_CPP
CONST char *Exp_InitStubs _ANSI_ARGS_((Tcl_Interp *interp, char *version,
		int exact));
#endif


#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT

#endif /* RC_INVOKED */
#endif /* _EXP */






Deleted generic/expChannel.c.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386




































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

/*
 * expChannel.c --
 *
 *	Implements the Expect_Channel
 *
 *	XXX: This has not been implemented yet but the idea is this:
 *	Change expect to use channel ids instead of just expect ids.
 *	This allows more flexibility.
 *
 * Copyright (c) 1997 by Mitel Corporation
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 */

#include "exp_port.h"
#include "tclInt.h"
#include "tclPort.h"

int		 ExpectBlock _ANSI_ARGS_((ClientData instanceData,
                                int mode));
int              ExpectInput _ANSI_ARGS_((ClientData instanceData,
                                char *bufPtr, int bufSize, int *errorPtr));
int              ExpectOutput _ANSI_ARGS_((ClientData instanceData,
				char *bufPtr, int toWrite, int *errorPtr));
int              ExpectClose _ANSI_ARGS_((ClientData instanceData,
                                Tcl_Interp *interp));
int              ExpectSetOption _ANSI_ARGS_((ClientData instanceData,
                                Tcl_Interp *interp, char *nameStr, char *val));
int              ExpectGetOption _ANSI_ARGS_((ClientData instanceData,
                                char *nameStr, Tcl_DString *dsPtr));
Tcl_File         ExpectGetFile _ANSI_ARGS_((ClientData instanceData,
                                int direction));
int              ExpectReady _ANSI_ARGS_((ClientData instanceData,
                                int direction));
void             ExpectWatch _ANSI_ARGS_((ClientData instanceData,
                                int mask));

static Tcl_ChannelType expectChannelType = {
    "expect",
    ExpectBlock,
    ExpectClose,
    ExpectInput,
    ExpectOutput,
    NULL,         		/* Can't seek! */
    ExpectSetOption,
    ExpectGetOption,
    ExpectWatch,
    ExpectReady,
    ExpectGetFile
};


/*
 *----------------------------------------------------------------------
 *
 * ExpOpenExpectChannel --
 *
 *	Generic routine to open a expect channel
 *
 * Results:
 *	A Tcl_Channel.
 *    
 * Side Effects:
 *	Allocates memory.
 *
 * Notes:
 *	XXX: This will be called from Exp_SpawnCmd() to create a new
 *	channel.
 *
 *----------------------------------------------------------------------
 */

Tcl_Channel
ExpOpenExpectChannel(interp, argc, argv)
    Tcl_Interp *interp;
    int argc;
    char **argv;
{
    Tcl_Channel chan;
    ExpectState *ssPtr;
    char devStr[15];
    char channelNameStr[10];

    /*
     * XXX: A bunch of other stuff should be done here first
     */

    ssPtr = (ExpectState *) ckalloc(sizeof(ExpectState));
    if (ExppOpenExpectChannel(interp, (ClientData)ssPtr, devStr, flags)
	    != TCL_OK) {
	ckfree((char *)ssPtr);
	return NULL;
    }
    ssPtr->theFile = Tcl_GetFile((ClientData)ssPtr->fd, EXPECT_HANDLE);

    /*
     * Setup the expect channel to always flush immediately
     */

    sprintf(channelNameStr, "expect%d", expectCount++);
    chan = Tcl_CreateChannel(&expectChannelType, channelNameStr,
	    (ClientData) ssPtr, mode);
     
    if (Tcl_SetChannelOption(interp, chan, "-buffering", "none")
	    != TCL_OK) {
        ExpClose(interp, chan);
	return NULL;
    }

    return chan;

arg_missing:
    Tcl_AppendResult(interp, "Value for \"", argv[i],
    	"\" missing", NULL);
    return NULL;
}


/*
 *----------------------------------------------------------------------
 *
 * ExpectBlock --
 *
 *	Generic routine to set I/O to blocking or non-blocking.
 *
 * Results:
 *	TCL_OK or TCL_ERROR.
 *    
 * Side Effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
ExpectBlock(instanceData, mode)
    ClientData instanceData;
    int mode;			/* (in) Block or not */
{
    return ExppExpectBlock(instanceData, mode);
}


/*
 *----------------------------------------------------------------------
 *
 * ExpectInput --
 *
 *	Generic read routine for expect ports
 *
 * Returns:
 *	Amount read or -1 with errorcode in errorPtr.
 *    
 * Side Effects:
 *	Buffer is updated. 
 *
 *----------------------------------------------------------------------
 */

int
ExpectInput(instanceData, bufPtr, bufSize, errorPtr)
    ClientData instanceData;
    char *bufPtr;		/* (in) Ptr to buffer */
    int bufSize;		/* (in) sizeof buffer */
    int *errorPtr;		/* (out) error code */
{
    Tcl_Channel channelPtr = ((PlugFInfo *)instanceData)->channelPtr;

    return (Tcl_GetChannelType(channelPtr)->inputProc)
	(Tcl_GetChannelInstanceData(channelPtr), bufPtr, bufSize, errorPtr);
}


/*
 *----------------------------------------------------------------------
 *
 * ExpectOutput --
 *
 *	Generic write routine for expect ports
 *
 * Results:
 *	Amount written or -1 with errorcode in errorPtr
 *    
 * Side Effects:
 *	None. 
 *
 *----------------------------------------------------------------------
 */

int
ExpectOutput(instanceData, bufPtr, toWrite, errorPtr)
    ClientData instanceData;
    char *bufPtr;		/* (in) Ptr to buffer */
    int toWrite;		/* (in) amount to write */
    int *errorPtr;		/* (out) error code */
{
    Tcl_Channel channelPtr = ((PlugFInfo *)instanceData)->channelPtr;

    return (Tcl_GetChannelType(channelPtr)->outputProc)
	(Tcl_GetChannelInstanceData(channelPtr), bufPtr, toWrite, errorPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * ExpectClose --
 *
 *	Generic routine to close the expect port
 *
 * Results:
 *      0 if successful or a POSIX errorcode with
 *      interp updated.
 *    
 * Side Effects:
 *	Channel is deleted.
 *
 *----------------------------------------------------------------------
 */

int
ExpectClose(instanceData, interp)
    ClientData instanceData;
    Tcl_Interp *interp;
{
    ExpectState *ssPtr = (ExpectState *) instanceData;
    int rc = TCL_OK;

    rc = ExppExpectClose(instanceData);
    if ((rc != 0) && (interp != NULL)) {
    	Tcl_SetErrno(rc);
    	Tcl_SetResult(interp, Tcl_PosixError(interp), TCL_VOLATILE);
    }
    Tcl_FreeFile(ssPtr->theFile);
    ckfree((char *)ssPtr);
    return rc; 
}


/*
 *----------------------------------------------------------------------
 *
 * ExpectSetOption --
 *
 *	Set the value of an expect channel option
 *
 * Results:
 *	TCL_OK and dsPtr updated with the value or TCL_ERROR.
 *
 * Side Effects
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
ExpectSetOption(instanceData, interp, nameStr, valStr)
    ClientData instanceData;
    Tcl_Interp *interp;
    char *nameStr;		/* (in) Name of option */
    char *valStr;		/* (in) New value of option */
{
    ExpectState *ssPtr = (ExpectState *) instanceData;
    int optVal, option;
    char errorStr[80];
    int optBool;

    Tcl_AppendResult (interp, "Illegal option \"", nameStr,
		      "\" -- must be a standard channel option", NULL);
    return TCL_ERROR;
}


/*
 *----------------------------------------------------------------------
 *
 * ExpectGetOption --
 *
 *	Queries expect channel for the current value of
 *      the given option.
 *
 * Results:
 *	TCL_OK and dsPtr updated with the value or TCL_ERROR.
 *
 * Side Effects
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
ExpectGetOption(instanceData, nameStr, dsPtr)
    ClientData instanceData;
    char *nameStr;		/* (in) Name of option to retrieve */		
    Tcl_DString *dsPtr;		/* (in) String to place value */
{
    ExpectState *ssPtr = (ExpectState *) instanceData;

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * ExpectGetFile --
 *
 *	Get the Tcl_File for the appropriate direction in from the
 *	Tcl_Channel.
 *
 * Results:
 *	NULL because expect ids are handled through other channel
 *	types.
 *
 * Side Effects
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_File
ExpectGetFile(instanceData, direction)
    ClientData instanceData;
    int direction;
{
    return (Tcl_File)NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * ExpectReady --
 *
 *	Determines whether expect port has data to be
 *	read or is OK for writing.
 *
 * Results:
 *	A bitmask of the events that were found by checking the
 *	underlying channel.
 *
 * Side Effects
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
ExpectReady(instanceData, direction)
    ClientData instanceData;
    int direction;
{
    Tcl_Channel channelPtr = ((PlugFInfo *)instanceData)->channelPtr;

    return (Tcl_GetChannelType(channelPtr)->channelReadyProc)
                         (Tcl_GetChannelInstanceData(channelPtr), mask);
}

/*
 *----------------------------------------------------------------------
 *
 * ExpectWatch --
 *
 *	Sets up event handling on a expect port Tcl_Channel using
 *	the underlying channel type.
 *
 * Results:
 *	Nothing
 *
 * Side Effects
 *	None.
 *
 *----------------------------------------------------------------------
 */

void
ExpectWatch(instanceData, mask)
    ClientData instanceData;
    int mask;
{
    Tcl_Channel channelPtr = ((PlugFInfo *)instanceData)->channelPtr;

    (Tcl_GetChannelType(channelPtr)->watchChannelProc) 
                         (Tcl_GetChannelInstanceData(channelPtr), mask);
    return;
}







Changes to generic/expCommand.c.






︙


14
15
16
17
18
19
20
21
22
23



24
25


26
27
28
29
30
31

32
33
34


35
36
37
38
39
40

41
42



43

44
45
46








47
48

49
50
51
52
53
54
55
56
57
58
59
60




61





62


63

64
65


























66



67




68


69

70
71
72
73
74
75





























76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100


























































































101






102
103
104
105













106
107
108
109
110
111
112
113

114
115
116
117
118
119
120

121
122
123
124
125
126

127
128
129
130
131
132
133
134

135
136

137
138










139
140
141
















142
143
144
145









146














147
148
149
150

151
152
153

154
155
156
157
158
159








160
161

162
163







164
165
166
167
168
169

170
171

172
173
174
175
176
177
178
179
180
181



182
183
184
185




186
187
188
189
190
191
192













193
194
195
196
197
198
199
200
201
202
203
204
205
206























207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225

226
227

228



229
230



231
232
233
234
235




236


237
238
239








240
241

242
243
244
245
246
247
248
249
250
251
252
253


















254

255

256
257
258
259
260
261
262
263
264

265
266



267
268
269
270


271
272

















273
274



275
276
277



278

279
280


281
282
283
284
285



















286
287
288
289
290
291

292
293

294
295
296
297
298
299
300
301


302
303
304

305
306
307
308
309
310
311
312
313
314
315

316
317
318
319

320
321
322
323
324
325
326
327

328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371

372
373
374
375
376
377

378
379

380
381
382
383

384
385
386

387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425

426
427

428
429
430
431

432
433

434
435
436
437
438
439
440
441
442
443
444
445
446

14
15
16
17
18
19
20



21
22
23


24
25






26
27


28
29
30
31




32
33

34
35
36
37
38



39
40
41
42
43
44
45
46


47
48
49
50
51
52
53
54
55
56
57
58

59
60
61
62
63
64
65
66
67
68

69
70
71
72


73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102

103
104
105
106
107
108
109

110
111
112
113



114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160

161
162
163



164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260




261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280

281
282
283
284
285
286
287

288
289
290
291
292
293

294
295
296
297
298
299
300
301

302
303

304
305
306
307
308
309
310
311
312
313
314
315
316



317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345

346
347
348
349
350
351
352
353
354
355
356
357
358
359
360



361



362
363





364
365
366
367
368
369
370
371
372
373
374


375
376
377
378
379
380
381
382
383
384
385
386

387
388

389

390
391



392
393
394
395
396
397
398




399
400
401
402







403
404
405
406
407
408
409
410
411
412
413
414
415
416













417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455

456

457
458

459
460
461
462
463
464

465
466
467
468




469
470
471
472
473
474
475



476
477
478
479
480
481
482
483


484












485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504

505
506
507
508
509
510
511
512
513

514
515

516
517
518
519
520


521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541


542
543
544



545
546
547
548
549


550
551





552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575

576
577

578




579
580


581
582
583
584

585











586




587








588












































589
590
591
592
593
594

595
596

597
598
599


600



601


























602










603

604


605

606


607


608






609
610
611
612
613
614
615








-
-
-
+
+
+
-
-
+
+
-
-
-
-
-
-
+

-
-
+
+


-
-
-
-
+

-
+
+
+

+
-
-
-
+
+
+
+
+
+
+
+
-
-
+











-
+
+
+
+

+
+
+
+
+
-
+
+

+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
-
+
+
+
+

+
+
-
+



-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


















-



-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
+
+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+







-
+






-
+





-
+







-
+

-
+


+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+




+
+
+
+
+
+
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
+
-
-
-
+

-
-
-
-
-
+
+
+
+
+
+
+
+


+
-
-
+
+
+
+
+
+
+





-
+

-
+
-


-
-
-




+
+
+
-
-
-
-
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
















-

-
+

-
+

+
+
+

-
+
+
+

-
-
-
-
+
+
+
+

+
+
-
-
-
+
+
+
+
+
+
+
+
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
-
+








-
+

-
+
+
+


-
-
+
+


+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
+
-
-
-
+
+
+

+
-
-
+
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+





-
+

-
+
-
-
-
-


-
-
+
+


-
+
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
+
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+





-
+

-
+


-
-
+
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
-
-
-
-
-
-
-
-
-

-
+
-
-
+
-

-
-
+
-
-
+
-
-
-
-
-
-








 * Copyright (c) 1997 by Mitel Corporation
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 */

#include <math.h>
#include "exp_port.h"
#include "tclInt.h"
#include <math.h>		/* for log/pow computation in send -h */
#include "expInt.h"

#include "tclPort.h"
#include "expect_tcl.h"
/*
 * These constants refer to the UTF string that encodes a null character.
#include "exp_command.h"
#include "exp_rename.h"
#include "exp_log.h"
#include "exp_event.h"
#include "exp_prog.h"
#include "exp_tty.h"
 */

/* Tcl needs commands in writable space (or at least used to) */
static char close_cmd[] = "close";
#define NULL_STRING "\300\200" /* hex C080 */
#define NULL_LENGTH 2

/*
 * exp_configure_count is incremented whenever a spawned process is closed
 * or an indirect list is modified.  This forces any (stack of) expect or
 * interact commands to reexamine the state of the world and adjust
 * accordingly.
 *  Found in either pty_sgtttyb.c, pty_termios.c, or pty_unicos.c
 */
int exp_configure_count = 0;

extern int exp_getptymaster();
extern int exp_getptyslave();

int exp_forked = FALSE;		/* whether we are child process */
/* this message is required because fopen sometimes fails to set errno */
/* Apparently, it "does the user a favor" and doesn't even call open */
/* if the file name is bizarre enough.  This means we can't handle fopen */

/* the following are use to create reserved addresses, to be used as ClientData */
/* args to be used to tell commands how they were called. */
/* The actual values won't be used, only the addresses, but I give them */
/* values out of my irrational fear the compiler might collapse them all. */
static int sendCD_error = 2;	/* called as send_error */
static int sendCD_user = 3;	/* called as send_user */
static int sendCD_proc = 4;	/* called as send or send_spawn */
/* with the obvious trivial logic. */
static char *open_failed = "could not open - odd file name?";
static int sendCD_tty = 6;	/* called as send_tty */

/*
 * expect_key is just a source for generating a unique stamp.  As each
 * expect/interact command begins, it generates a new key and marks all
 * the spawn ids of interest with it.  Then, if someone comes along and
 * marks them with yet a newer key, the old command will recognize this
 * reexamine the state of the spawned process.
 */
int expect_key = 0;

/*
 * The table is used to map channels to exp_f structures.
 * exp_configure_count is incremented whenever a spawned process is closed
 * or an indirect list is modified.  This forces any (stack of) expect or
 * interact commands to reexamine the state of the world and adjust
 * accordingly.
 */
int exp_configure_count = 0;

#ifdef HAVE_PTYTRAP
/* slaveNames provides a mapping from the pty slave names to our */
/* spawn id entry.  This is needed only on HPs for stty, sigh. */
Tcl_HashTable *exp_f_table = NULL;
static Tcl_HashTable slaveNames;
#endif /* HAVE_PTYTRAP */

typedef struct ThreadSpecificData {
/*
 * The 'exp_any' spawn identifier
    /*
     * List of all exp channels currently open.  This is per thread and is
     * used to match up fd's to channels, which rarely occurs.
     */
    
    ExpState *stdinout;
    ExpState *stderrX;   /* grr....stderr is a macro */
    ExpState *devtty;
    ExpState *any; /* for any_spawn_id */

    Tcl_Channel *diagChannel;
    Tcl_DString diagDString;
    int diagEnabled;
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;


struct slow_arg {
    int size;
    double time;
};


/*
 * Local prototypes for functions used only in this file and are not shared.
 */
static void	exp_wait_zero _ANSI_ARGS_((WAIT_STATUS_TYPE *status));
static void	expBusy _ANSI_ARGS_((ExpState *esPtr));
static int	exact_write _ANSI_ARGS_((ExpState *esPtr,char *buffer,int rembytes));
struct exp_f *exp_f_any = NULL;

static int	human_write _ANSI_ARGS_((Tcl_Interp *interp, ExpState *esPtr,
			char *buffer, struct human_arg *arg));
static int	get_slow_args _ANSI_ARGS_((Tcl_Interp *interp, struct slow_arg *x));



static void		tcl_tracer _ANSI_ARGS_((ClientData clientData,
static void	tcl_tracer _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int level, char *command,
			    Tcl_CmdProc *cmdProc, ClientData cmdClientData,
			    int argc, char *argv[]));
static void		exp_i_add_f _ANSI_ARGS_((struct exp_i *,
			    struct exp_f *fs));
static void		exp_f_closed _ANSI_ARGS_((struct exp_f *));

/*
 *----------------------------------------------------------------------
 *
 * init_traps --
 *
 *	Not sure what this does.
 *
 * Results:
 *	None
 *
 * Side Effects:
 *	No clue.
 *
 *----------------------------------------------------------------------
 */

#ifdef FULLTRAPS
static void
init_traps(traps)
RETSIGTYPE (*traps[])();
{
	int i;

	for (i=1;i<NSIG;i++) {
		traps[i] = SIG_ERR;
	}
}
#endif


/*
 *----------------------------------------------------------------------
 *
 * exp_error --
 *
 *	Formats an error message into the interp.  Do not terminate
 *	format strings with \n!!!.
 *
 * Results:
 *	None
 *
 * Side Effects:
 *	An error message is written into interp->result
 *
 *----------------------------------------------------------------------
 */

void
exp_error TCL_VARARGS_DEF(Tcl_Interp *,arg1)
{
    Tcl_Interp *interp;
    char *fmt;
    va_list args;
	Tcl_Interp *interp;
	char *fmt;
	va_list args;
	char buffer[2000];

	interp = TCL_VARARGS_START(Tcl_Interp *,arg1,args);
	fmt = va_arg(args,char *);
	vsprintf(buffer,fmt,args);
	Tcl_SetResult(interp,buffer,TCL_VOLATILE);
	va_end(args);
}

/*
 *----------------------------------------------------------------------
 *
 * expStateCurrent --
 *
 *	If 0, may be immediately followed by return TCL_ERROR.
 *
 * Results:
 *	current ExpState or 0
 *
 *----------------------------------------------------------------------
 */
struct ExpState *
expStateCurrent(interp,opened,adjust,any)
    Tcl_Interp *interp;
    int opened;
    int adjust;
    int any;
{
    static char *user_spawn_id = "exp0";

    char *name = exp_get_var(interp,EXP_SPAWN_ID_VARNAME);
    if (!name) name = user_spawn_id;

    return expStateFromChannelName(interp,name,opened,adjust,any,EXP_SPAWN_ID_VARNAME);
}

/*
 *----------------------------------------------------------------------
 *
 * expStateCheck --
 *
 *	Add comment here.
 *
 * Results:
 *	
 *
 *----------------------------------------------------------------------
 */
ExpState *
expStateCheck(interp,esPtr,open,adjust,msg)
    Tcl_Interp *interp;
    ExpState *esPtr;
    int open;
    int adjust;
    char *msg;
{
    if (open && !esPtr->open) {
	exp_error(interp,"%s: spawn id %s not open",msg,esPtr->name);
	return(0);
    }
    if (adjust) expAdjust(esPtr);
    return esPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * expStateFromChannelName --
 *
 *	Add comment here.
 *
 * Results:
 *	
 *
 *----------------------------------------------------------------------
 */
ExpState *
expStateFromChannelName(interp,name,open,adjust,any,msg)
    Tcl_Interp *interp;
    char *name;
    int open;
    int adjust;
    char *msg;
{
    ExpState *esPtr;
    Tcl_Channel channel;
    char *chanName;

    if (any) {
	if (0 == strcmp(name,EXP_SPAWN_ID_ANY_LIT)) {
	    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
	    return tsdPtr->any;
	}
    }
    interp = TCL_VARARGS_START(Tcl_Interp *,arg1,args);
    fmt = va_arg(args,char *);
    vsprintf(interp->result,fmt,args);
    va_end(args);

    channel = Tcl_GetChannel(interp,name,(int *)0);
    if (!channel) return(0);

    chanName = Tcl_GetChannelName(channel);
    if (!isExpChannelName(chanName)) {
	exp_error(interp,"%s: %s is not an expect channel - use spawn -open to convert",msg,chanName);
	return(0);
    }

    esPtr = (ExpState *)Tcl_GetChannelInstanceData(channel);

    return expStateCheck(interp,esPtr,open,adjust,msg);
}

/*
 *----------------------------------------------------------------------
 *
 * exp_wait_zero --
 *
 *	Zero out the wait status field
 *	Zero out the wait status field.
 *
 * Results:
 *	None
 *
 *----------------------------------------------------------------------
 */
static void
void
exp_wait_zero(status)
    WAIT_STATUS_TYPE *status;
{
    int i;

    for (i=0;i<sizeof(WAIT_STATUS_TYPE);i++) {
    for (i = 0; i < sizeof(WAIT_STATUS_TYPE); i++) {
	((char *)status)[i] = 0;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * exp_fcheck --
 * exp_state_prep_for_invalidation --
 *
 *	Check and possibly adjust the status of the exp_f.
 *	called just before an ExpState entry is about to be invalidated.
 *
 * Results:
 *	None
 *
 *----------------------------------------------------------------------
 */
void
exp_state_prep_for_invalidation(interp,esPtr)
    Tcl_Interp *interp;
    ExpState *esPtr;
{
    exp_ecmd_remove_state_direct_and_indirect(interp,esPtr);
 *	0 if not valid, 1 if good.
 *
 * Side Effects:

    exp_configure_count++;

    if (esPtr->fg_armed) {
	exp_event_disarm_fg(esPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * exp_trap_on --
 *
 *	Add comment here.
 *
 * Results:
 *	None
 *
 *----------------------------------------------------------------------
 */
/*ARGSUSED*/
void
exp_trap_on(master)
    int master;
{
#ifdef HAVE_PTYTRAP
    if (master == -1) return;
    exp_slave_control(master,1);
#endif /* HAVE_PTYTRAP */

}

/*
 *----------------------------------------------------------------------
 *
 * exp_trap_off --
 *
 *	Add comment here.
 *
 * Results:
 *	None
 *
 *----------------------------------------------------------------------
 */
int
exp_fcheck(interp,f,opened,adjust,msg)
    Tcl_Interp *interp;
    struct exp_f *f;
exp_trap_off(name)
    int opened;		/* check not closed */
    int adjust;		/* adjust buffer sizes */
    char *msg;
    char *name;
{
    if ((!opened) || (!f->user_closed)) {
	if (adjust) {
	    exp_adjust(f);
	}
	return 1;
#ifdef HAVE_PTYTRAP
    ExpState *esPtr;
    int enable = 0;

    Tcl_HashEntry *entry = Tcl_FindHashEntry(&slaveNames,name);
    if (!entry) {
	expDiagLog("exp_trap_off: no entry found for %s\n",name);
	return -1;
    }

    esPtr = (ExpState *)Tcl_GetHashValue(entry);
    exp_error(interp,"%s: invalid spawn id (%s)", msg, f->spawnId);
    return(0);
    
    exp_slave_control(esPtr->fdin,0);

    return esPtr->fdin;
#else
    return name[0];	/* pacify lint, use arg and return something */
#endif
}

/*
 *----------------------------------------------------------------------
 *
 * exp_chan2f --
 * expBusy --
 *
 *	For a given channel name, returns the exp_f structure
 *	Add comment here.  Has OS depedancies.
 *	for that channel.
 *
 * Results:
 *	An exp_f structure if found and usable, NULL if not.
 *
 * Side Effects:
 *	None
 *
 *----------------------------------------------------------------------
 */
void
expBusy(esPtr)
     ExpState *esPtr;

struct exp_f *
exp_chan2f(interp,chan,opened,adjust,msg)
    Tcl_Interp *interp;
{
#ifndef __WIN32__
    int x = open("/dev/null",0);
    if (x != esPtr->fdin) {
    char *chan;			/* Channel name */
    int opened;			/* check not closed */
    int adjust;			/* adjust buffer sizes */
    char *msg;
{
    Tcl_HashEntry *hPtr;
    struct exp_f *f;
	fcntl(x,F_DUPFD,esPtr->fdin);
	close(x);
    }
    expCloseOnExec(esPtr->fdin);
    esPtr->fdBusy = TRUE;
#else
    /* what goes here? */
#endif
}





    hPtr = Tcl_FindHashEntry(exp_f_table, chan);
    if (hPtr != NULL) {
	f = (struct exp_f *) Tcl_GetHashValue(hPtr);
	if ((!opened) || !f->user_closed) {
	    if (adjust) {
		exp_adjust(f);
	    }
	    return f;
	}
    }
    exp_error(interp,"%s: invalid spawn id (%s)",msg,chan);
    return NULL;
}
























/*
 *----------------------------------------------------------------------
 *
 * exp_close --
 *
 *	Close a connection.
 *
 * Results:
 *	None
 *
 * Side Effects:
 *	A native file handle is closed
 *
 *----------------------------------------------------------------------
 */

int
exp_close(interp, f)
exp_close(interp, esPtr)
    Tcl_Interp *interp;
    struct exp_f *f;
    ExpState *esPtr;
{
    if (0 == expStateCheck(interp,esPtr,1,0,"close")) return TCL_ERROR;
    esPtr->open = FALSE;

    /*
     * Check if this is an id that should never be deleted
     * Ignore close errors from ptys.  Ptys on some systems return errors for
     * no evident reason.  Anyway, receiving an error upon pty-close doesn't
     * mean anything anyway as far as I know.  
     */
    if (f->alwaysopen) {
	exp_error(interp, "cannot close permanent id %s", f->spawnId);
	return TCL_ERROR;
    }

    close(esPtr->fdin);
    if (esPtr->fd_slave != EXP_NOFD) close(esPtr->fd_slave);
    if (esPtr->fdin != esPtr->fdout) close(esPtr->fdout);

    if (esPtr->channel_orig && !esPtr->leaveopen) {
	/*
    f->user_closed = TRUE;

    if (! f->leaveopen) {
	 * Ignore close errors from Tcl channels.  They indicate things
	 * like broken pipelines, etc, which don't affect our
	 * subsequent handling.
	 */
	Tcl_VarEval(interp,"close ",Tcl_GetChannelName(esPtr->channel_orig),
		(char *)0);
    }

	/*
	 * Tcl_UnregisterChannel() will call Tcl_Close() if needed
#ifdef HAVE_PTYTRAP
	 */
	if (f->channel) {
	    return Tcl_UnregisterChannel(interp, f->channel);
	}
	return TCL_OK;
    } else {
	if (--f->leaveopen >= 0) {
	    return TCL_OK;
	}
	if (f->channel) {
	    Tcl_DeleteCloseHandler(f->channel, (Tcl_CloseProc *) exp_f_closed,
				   (ClientData) f);
    if (esPtr->slave_name) {
	Tcl_HashEntry *entry;
	
	entry = Tcl_FindHashEntry(&slaveNames,esPtr->slave_name);
	Tcl_DeleteHashEntry(entry);

	ckfree(esPtr->slave_name);
	esPtr->slave_name = 0;
    }
#endif

    exp_state_prep_for_invalidation(interp,esPtr);

    if (esPtr->user_waited) {
	if (esPtr->registered) {
	    Tcl_UnregisterChannel(interp,esPtr->channel);
	    /* at this point esPtr may have been freed so don't touch it
               any longer */
	}
    } else {
	exp_f_closed(f);
      expBusy(esPtr);
    }

    return(TCL_OK);
}

/*
 *----------------------------------------------------------------------
 *
 * exp_f_find --
 * expStateAnyIs --
 *
 *	Try to find an existing exp_f structure in the spawn id table.
 *	report whether this ExpState represents special spawn_id_any
 *	we need a separate function because spawn_id_any is thread-specific
 *	and can't be seen outside this file.
 *
 * Results:
 *	The structure if found, NULL if not.
 *
 *	
 *
 *----------------------------------------------------------------------
 */
int
expStateAnyIs(esPtr)
    ExpState *esPtr;
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    return (esPtr == tsdPtr->any);
}

/*
 *----------------------------------------------------------------------
 *
 * expDevttyIs --
 *
 *	Add comment here.
 *
 * Results:
 *	

struct exp_f *
 *
 *----------------------------------------------------------------------
 */
exp_f_find(interp,spawnId)
    Tcl_Interp *interp;
    char *spawnId;
int
expDevttyIs(esPtr)
    ExpState *esPtr;
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    Tcl_HashEntry *hPtr;

    return (esPtr == tsdPtr->devtty);
}
    hPtr = Tcl_FindHashEntry(exp_f_table, spawnId);
    if (! hPtr) {
	return NULL;
    }
    return (struct exp_f *) Tcl_GetHashValue(hPtr);

/*
 *----------------------------------------------------------------------
 *
 * expStdinoutIs --
 *
 *	Add comment here.
 *
 * Results:
 *	
 *
 *----------------------------------------------------------------------
 */
int
expStdinoutIs(esPtr)
ExpState *esPtr;
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    return (tsdPtr->stdinout == esPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * exp_f_new --
 * expStdinoutGet --
 *
 *	Create a new exp_f structure for a given channel and enter
 *	Add comment here.
 *	it into the spawn id hash table.  If spawnId is given, it
 *	is entered under that name.  If not, it is entered under
 *	the channel identifier.  This means that either a channel
 *	and/or a spawnId must be passed in.
 *
 * Results:
 *	The new structure if successful, NULL if not.
 *
 *	
 *
 *----------------------------------------------------------------------
 */

ExpState *
struct exp_f *
exp_f_new(interp,chan,spawnId,pid)
    Tcl_Interp *interp;
    Tcl_Channel chan;
    char *spawnId;
    int pid;
{
    struct exp_f *f;
    Tcl_HashEntry *hPtr;
    int new;

expStdinoutGet()
    if (!chan && !spawnId) {
	return NULL;
    }

{
    spawnId = spawnId ? spawnId : Tcl_GetChannelName(chan);
    hPtr = Tcl_CreateHashEntry(exp_f_table, spawnId, &new);
    if (!new) {
	panic("Exp_SpawnCmd: old entry found in table");
	f = (struct exp_f *) Tcl_GetHashValue(hPtr);
	return f;
    }

    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    f = (struct exp_f *) ckalloc(sizeof(struct exp_f));
    f->interp = interp;
    f->pid = pid;
    f->size = 0;
    f->msize = 0;
    f->buffer = 0;
    f->printed = 0;
    f->echoed = 0;
    f->rm_nulls = exp_default_rm_nulls;
    f->parity = exp_default_parity;
    f->key = expect_key++;
    f->force_read = FALSE;
    f->fg_armed = FALSE;
    f->umsize = exp_default_match_max;
    f->valid = TRUE;
    f->user_closed = FALSE;
    f->user_waited = (EXP_NOPID == pid) ? TRUE : FALSE;
    f->sys_waited = (EXP_NOPID == pid) ? TRUE : FALSE;
    if (f->sys_waited) {
	exp_wait_zero(&f->wait);
    }
    f->bg_interp = 0;
    f->bg_status = unarmed;
    f->bg_ecount = 0;
    f->channel = chan;
    f->leaveopen = 0;
    f->alwaysopen = 0;
    f->matched = 0;		/* Used only by expectlib */
    f->Master = NULL;
    f->event_proc = NULL;
    f->event_data = 0;
    exp_f_new_platform(f);

    Tcl_SetHashValue(hPtr, f);
    f->hashPtr = hPtr;
    f->spawnId = ckalloc(strlen(spawnId) + 1);
    strcpy(f->spawnId, spawnId);

    if (chan) {
	Tcl_CreateCloseHandler(chan, (Tcl_CloseProc *) exp_f_closed,
			       (ClientData) f);
    }

    return f;
    return tsdPtr->stdinout;
}

/*
 *----------------------------------------------------------------------
 *
 * exp_f_free --
 * expDevttyGet --
 *
 *	Frees an exp_f structure.
 *	Add comment here.
 *
 * Results:
 *	None
 *
 *	
 *----------------------------------------------------------------------
 */

 *
void
exp_f_free(f)
    struct exp_f *f;
{
    if (f->buffer) {
	ckfree(f->buffer);
	f->buffer = 0;
	f->msize = 0;
	f->size = 0;
	f->printed = 0;
	f->echoed = 0;
	if (f->fg_armed) {
	    exp_event_disarm(f);
	    f->fg_armed = FALSE;
	}
	ckfree(f->lower);
    }
    ckfree(f->spawnId);
    f->fg_armed = FALSE;
    Tcl_DeleteHashEntry(f->hashPtr);

    exp_f_free_platform(f);
    ckfree((char *) f);
}

/*
 *----------------------------------------------------------------------
 *
 * exp_f_closed --
 *
 *	A channel was closed, so we need to make it unavailable
 *	for anything except the wait command.
 *
 * Results:
 *	None
 *
 *----------------------------------------------------------------------
 */

ExpState *
static void
exp_f_closed(f)
expDevttyGet()
    struct exp_f *f;
{
    exp_ecmd_remove_f_direct_and_indirect(f->interp,f);

    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    exp_configure_count++;

    return tsdPtr->devtty;
    f->fg_armed = FALSE;
    f->valid = FALSE;

    if (f->user_waited) {
	exp_f_free(f);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * Exp_ExpPidCmd --
 *




︙


455
456
457
458
459
460
461
462

463
464
465
466
467
468
469
470
471
472



473
474

475
476
477
478
479

480
481
482
483
484



485
486
487
488
489

490
491
492


493
494

495
496
497
498
499
500
501

624
625
626
627
628
629
630

631
632
633
634
635
636
637




638
639
640
641

642
643
644
645
646

647
648
649



650
651
652
653




654
655


656
657
658

659
660
661
662
663
664
665
666








-
+






-
-
-
-
+
+
+

-
+




-
+


-
-
-
+
+
+

-
-
-
-
+

-
-
+
+

-
+








 * Notes:
 *	OS independent
 *
 *----------------------------------------------------------------------
 */

/*ARGSUSED*/
static int
int
Exp_ExpPidCmd(clientData,interp,argc,argv)
    ClientData clientData;
    Tcl_Interp *interp;
    int argc;
    char **argv;
{
    struct exp_f *f;
    char *chanId = NULL;
    char *argv0 = argv[0];
    
    char *chanName = 0;
    ExpState *esPtr = 0;

    argc--; argv++;
    

    for (;argc>0;argc--,argv++) {
	if (streq(*argv,"-i")) {
	    argc--; argv++;
	    if (!*argv) goto usage;
	    chanId = *argv;
	    chanName = *argv;
	} else goto usage;
    }
    
    if (chanId == NULL) {
	f = exp_update_master(interp,0,0);

    if (chanName) {
	if (!(esPtr = expStateFromChannelName(interp,chanName,0,0,0,"exp_pid"))) return TCL_ERROR;
    } else {
	f = exp_chan2f(interp, chanId, 1, 0, argv0);
    }
    if (f == NULL) {
	return(TCL_ERROR);
	if (!(esPtr = expStateCurrent(interp,0,0,0))) return TCL_ERROR;
    }

    sprintf(interp->result,"%d",f->pid);
    
    sprintf(interp->result,"%d",esPtr->pid);
    return TCL_OK;
 usage:
  usage:
    exp_error(interp,"usage: -i spawn_id");
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *




︙


520
521
522
523
524
525
526
527
528


529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570

685
686
687
688
689
690
691


692
693
694
695
696
































697
698
699
700
701
702
703








-
-
+
+



-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-








static int
Exp_GetpidDeprecatedCmd(clientData, interp, argc, argv)
    ClientData clientData;
    Tcl_Interp *interp;
    int argc;
    char **argv;
{
    debuglog("getpid is deprecated, use pid\r\n");
    sprintf(interp->result,"%d",exp_getpidproc());
    expDiagLog("getpid is deprecated, use pid\r\n");
    sprintf(interp->result,"%d",getpid());
    return(TCL_OK);
}

/*
 *----------------------------------------------------------------------
 *
 * exp_update_master --
 *
 *	Get the current master (via out-parameter)
 *
 * Results:
 *	An exp_f structure or NULL if not found
 *	
 * Note: Since exp_chan2f calls tcl_error, this may be
 *	immediately followed by a "return(TCL_ERROR)"!!!
 *
 * Notes:
 *	OS independent
 *
 *----------------------------------------------------------------------
 */

struct exp_f *
exp_update_master(interp,opened,adjust)
    Tcl_Interp *interp;
    int opened;
    int adjust;
{
    char *s = exp_get_var(interp,EXP_SPAWN_ID_VARNAME);
    if (s == NULL) {
	s = EXP_SPAWN_ID_USER;
    }
    return exp_chan2f(interp,s,opened,adjust,s);
}

/*
 *----------------------------------------------------------------------
 *
 * Exp_SleepCmd --
 *
 *	Implements the 'sleep' (alias 'exp_sleep') command.
 *	Can sleep for fractional seconds.




︙


596
597
598
599
600
601
602



603
604
605
606




















607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625

626
627
628
629
630

631
632
633
634
635
636
637

729
730
731
732
733
734
735
736
737
738




739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775


776
777
778
779
780

781
782
783
784
785
786
787
788








+
+
+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

















-
-
+




-
+








	exp_error(interp,"must have one arg: seconds");
	return TCL_ERROR;
    }

    return(exp_dsleep(interp,(double)atof(*argv)));
}

/*
 *----------------------------------------------------------------------
 *
struct slow_arg {
    int size;
    double time;
};
 * exact_write --
 *
 *	If this works, exact_write should disappear and function should
 *	call Tcl_WriteChars directly.
 *
 * Notes:
 *	OS independent
 *
 *----------------------------------------------------------------------
 */
int
exact_write(esPtr,buffer,rembytes) /* INTL */
    ExpState *esPtr;
    char *buffer;
    int rembytes;
{
    Tcl_WriteChars(esPtr->channel,buffer,rembytes);
    return(0);
}


/*
 *----------------------------------------------------------------------
 *
 * get_slow_args --
 *
 *	Get the arguments the the 'send -s' command
 *
 * Results:
 *	0 on success, -1 on failure
 *	
 * Side Effects:
 *	The slow_arg structure is filled in
 *
 *----------------------------------------------------------------------
 */

/* returns 0 for success, -1 for failure */
static int
int
get_slow_args(interp,x)
    Tcl_Interp *interp;
    struct slow_arg *x;
{
    int sc;			/* return from scanf */
    int sc;		/* return from scanf */
    char *s = exp_get_var(interp,"send_slow");
    if (!s) {
	exp_error(interp,"send -s: send_slow has no value");
	return(-1);
    }
    if (2 != (sc = sscanf(s,"%d %lf",&x->size,&x->time))) {
	exp_error(interp,"send -s: found %d value(s) in send_slow but need 2",sc);




︙


663
664
665
666
667
668
669

670
671

672
673

674
675
676
677
678
679
680
681
682

683
684

685
686
687
688
689
690
691

692
693
694

695
696
697
698
699
700
701

814
815
816
817
818
819
820
821
822

823
824

825
826
827
828
829
830
831
832
833

834
835

836
837
838
839
840
841
842

843
844
845

846
847
848
849
850
851
852
853








+

-
+

-
+








-
+

-
+






-
+


-
+








 *
 * Notes:
 *	OS independent
 *
 *----------------------------------------------------------------------
 */

/* returns 0 for success, -1 for failure, pos. for Tcl return value */
static int
slow_write(interp,f,buffer,rembytes,arg)
slow_write(interp,esPtr,buffer,rembytes,arg) /* INTL */
    Tcl_Interp *interp;
    struct exp_f *f;
    ExpState *esPtr;
    char *buffer;
    int rembytes;
    struct slow_arg *arg;
{
    int rc;

    while (rembytes > 0) {
	int len;

		
	len = (arg->size<rembytes?arg->size:rembytes);
	if (0 > exp_exact_write(f,buffer,len)) return(-1);
	if (0 > Tcl_WriteChars(esPtr->channel,buffer,len)) return -1;
	rembytes -= arg->size;
	buffer += arg->size;

	/* skip sleep after last write */
	if (rembytes > 0) {
	    rc = exp_dsleep(interp,arg->time);
	    if (rc>0) return rc;
	    if (rc > 0) return rc;
	}
    }
    return(0);
    return 0;
}

struct human_arg {
    float alpha;		/* average interarrival time in seconds */
    float alpha_eow;		/* as above but for eow transitions */
    float c;			/* shape */
    float min, max;




︙


816
817
818
819
820
821
822
823

824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840

841
842

843
844
845
846

847
848
849
850


851
852
853


854
855


856
857

858
859
860

861
862

863
864
865
866
867
868
869

870
871
872
873
874
875

876
877

878
879
880
881
882
883
884

885
886
887

888
889
890
891
892
893
894
895
896
897
898

899
900
901
902
903
904
905
906
907
908
909
910
911

912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936



937
938
939

940
941
942
943
944
945






946
947

948
949


950
951
952
953





954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971


972
973

974
975

976
977
978
979


980
981
982
983
984


985
986
987


988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003

1004
1005
1006


1007
1008
1009


1010
1011
1012
1013
1014
1015
1016

1017
1018
1019
1020

1021
1022
1023
1024
1025


1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040












1041
1042
1043


1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060

1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077

1078
1079

1080
1081
1082
1083

1084
1085
1086
1087
1088
1089
1090

1091
1092
1093
1094
1095
1096
1097
1098
1099









1100
1101
1102
1103
1104
1105
1106
1107

1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118


1119
1120

1121
1122

1123
1124
1125



1126
1127

1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139









1140
1141
1142
1143



1144
1145
1146

1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162

1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180

1181
1182
1183


1184
1185

1186
1187
1188
1189
1190


1191
1192
1193
1194

1195
1196
1197


1198
1199
1200
1201
1202




1203
1204
1205







1206
1207
1208
1209
1210
1211
1212

1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225

1226
1227
1228
1229
1230

1231

1232
1233

1234
1235
1236

1237
1238
1239
1240
1241
1242
1243
1244


1245
1246
1247
1248

1249
1250


1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270




1271
1272
1273
1274
1275
1276
1277
1278
1279

1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419

1420
1421
1422
1423
1424
1425

1426
1427
1428
1429
1430

1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441



1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454


1455
1456
1457
1458


1459


1460

1461
1462
1463

1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476





1477
1478
1479
1480
1481










1482
1483
1484
1485

1486
1487

1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499














1500
1501
1502


1503
1504

1505
1506
1507
1508


1509
1510
1511
1512
1513
1514
1515
1516


















1517
1518
1519
1520
1521
1522
1523









1524
1525


1526
1527
1528
1529
1530





1531
1532
1533
1534
1535
1536
1537

1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551


1552
1553
1554
1555
1556
1557



1558




1559
1560

1561
1562

1563
1564
1565


1566
1567

1568
1569
1570
1571
1572










1573
1574
1575
1576







1577
1578



1579
1580
1581
1582
1583
1584


1585
1586
1587
1588
1589
1590
1591
1592

1593
1594
1595
1596


1597
1598
1599
1600
1601


1602
1603
1604
1605

1606
1607
1608

1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630





















1631
1632
1633
1634
1635

1636
1637
1638
1639
1640
1641
1642
1643

1644
1645

1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682

1683
1684

1685
1686
1687
1688
1689
1690


1691
1692
1693
1694
1695

1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713

1714
1715

1716
1717
1718

1719
1720
1721


1722
1723
1724

1725

1726
1727
1728
1729












1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741

1742
1743
1744
1745


1746
1747
1748
1749
1750


1751
1752
1753

1754
1755

1756
1757

1758
1759
1760
1761
1762
1763
1764
1765
1766

1767
1768
1769
1770



1771
1772
1773
1774
1775
1776
1777
1778
1779


1780
1781
1782

1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794


1795
1796
1797


1798
1799
1800



1801
1802
1803
1804
1805






1806
1807
1808
1809
1810


1811
1812


1813
1814
1815
1816
1817



1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842

1843
1844
1845
1846
1847
1848
1849
1850


1851
1852
1853
1854

1855
1856
1857
1858
1859

1860
1861

1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880

1881
1882
1883
1884
1885
1886
1887

1888
1889
1890
1891
1892
1893
1894

968
969
970
971
972
973
974

975
976
977
978
979
980
981
982
983
984
985
986
987
988
989

990

991
992

993
994
995
996
997
998
999
1000

1001
1002
1003
1004


1005
1006
1007

1008
1009
1010

1011
1012
1013

1014
1015

1016
1017
1018
1019
1020
1021


1022
1023
1024
1025
1026
1027

1028


1029

1030
1031
1032
1033
1034

1035
1036
1037

1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048

1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061

1062
1063
1064
1065
1066
1067




















1068
1069
1070
1071
1072

1073
1074





1075
1076
1077
1078
1079
1080
1081

1082
1083
1084
1085
1086




1087
1088
1089
1090
1091
1092













1093
1094


1095
1096
1097

1098
1099

1100
1101



1102
1103

1104
1105


1106
1107
1108


1109
1110
1111
1112














1113
1114


1115
1116
1117


1118
1119
1120
1121
1122
1123
1124
1125

1126
1127
1128
1129

1130
1131
1132
1133


1134
1135
1136
1137













1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150


1151
1152

1153
1154
1155
1156
1157
1158
1159
1160
1161
1162






1163

















1164
1165

1166
1167
1168
1169

1170
1171

1172
1173
1174


1175









1176
1177
1178
1179
1180
1181
1182
1183
1184








1185
1186
1187
1188
1189
1190
1191
1192
1193
1194


1195
1196
1197

1198
1199

1200
1201


1202
1203
1204
1205

1206
1207
1208
1209









1210
1211
1212
1213
1214
1215
1216
1217
1218




1219
1220
1221



1222
1223















1224















1225
1226
1227
1228
1229


1230
1231


1232





1233
1234




1235



1236
1237





1238
1239
1240
1241



1242
1243
1244
1245
1246
1247
1248







1249







1250
1251
1252
1253
1254

1255
1256
1257
1258
1259
1260
1261

1262
1263

1264
1265
1266

1267
1268
1269
1270
1271
1272
1273


1274
1275
1276
1277
1278

1279
1280

1281
1282
1283
1284













1285




1286
1287
1288
1289
1290
1291
1292
1293

1294
1295


1296

1297
1298
1299













































































































1300
1301
1302
1303
1304
1305
1306
1307



1308
1309

1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320


1321






1322
1323
1324



1325











1326
1327
1328










1329


1330
1331
1332
1333


1334
1335
1336
1337
1338

1339
1340
1341

1342
1343
1344
1345
1346
1347
1348
1349
1350





1351
1352
1353
1354
1355
1356




1357
1358
1359
1360
1361
1362
1363
1364
1365
1366




1367


1368












1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382



1383
1384


1385




1386
1387








1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405







1406
1407
1408
1409
1410
1411
1412
1413
1414


1415
1416





1417
1418
1419
1420
1421







1422




1423

1424







1425
1426






1427
1428
1429
1430
1431
1432
1433
1434
1435

1436


1437



1438
1439


1440





1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451



1452
1453
1454
1455
1456
1457
1458
1459

1460
1461
1462
1463
1464
1465



1466
1467








1468




1469
1470

1471



1472
1473
1474
1475
1476

1477
1478
1479
1480
1481
1482


1483


















1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508

1509

1510
1511
1512
1513
1514


1515


1516

1517
1518
1519
1520
1521


















1522
1523
1524
1525
1526
1527
1528
1529
1530




1531


1532






1533
1534
1535
1536



1537













1538
1539
1540
1541

1542


1543
1544
1545

1546



1547
1548
1549
1550

1551
1552
1553




1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576

1577
1578
1579


1580
1581
1582




1583
1584



1585


1586


1587









1588




1589
1590
1591







1592

1593
1594
1595


1596












1597
1598



1599
1600
1601


1602
1603
1604
1605




1606
1607
1608
1609
1610
1611




1612
1613
1614


1615
1616





1617
1618
1619


1620
1621
1622


















1623

1624
1625
1626
1627
1628
1629
1630


1631
1632
1633
1634
1635

1636

1637
1638
1639

1640
1641

1642
1643
1644
1645
1646













1647

1648
1649
1650
1651
1652
1653
1654

1655
1656
1657
1658
1659
1660
1661
1662








-
+














-

-
+

-
+




+


-

+
+

-
-
+
+

-
+
+

-
+


-
+

-
+





-
-
+





-
+
-
-
+
-





-
+


-
+










-
+












-
+





-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+


-
+

-
-
-
-
-
+
+
+
+
+
+

-
+


+
+
-
-
-
-
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-


-
-
+
+

-
+

-
+

-
-
-
+
+
-


-
-
+
+

-
-
+
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
+

-
-
+
+

-
-
+
+






-
+



-
+



-
-
+
+


-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+

-
-
+
+
-










-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+

-
+



-
+

-



-
-
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
+









-
-
+
+

-
+

-
+

-
-
+
+
+

-
+



-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
-
-
-
-
+
+
+
-
-
-
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-



+

-
-
+
+
-
-
+
-
-
-
-
-
+
+
-
-
-
-
+
-
-
-
+
+
-
-
-
-
-
+
+
+
+
-
-
-
+
+
+
+
+
+
+
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-





-
+





+
-
+

-
+


-
+






-
-
+
+



-
+

-
+
+


-
-
-
-
-
-
-
-
-
-
-
-
-

-
-
-
-
+
+
+
+




-


-
-
+
-



-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-








-
-
-


-











-
-
+
-
-
-
-
-
-
+


-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-

-
-
+
+


-
-
+
+

+
+
-
+


-
+








-
-
-
-
-
+
+
+
+
+

-
-
-
-
+
+
+
+
+
+
+
+
+
+
-
-
-
-
+
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
-
-
+
-
-
-
-
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
-
-
+
+
-
-
-
-
-
+
+
+
+
+
-
-
-
-
-
-
-
+
-
-
-
-

-

-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
+

+
+
+
+

-
+
-
-
+
-
-
-
+
+
-
-
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+

-
-
-
+
+
+
+
+
+
+

-
+
+
+



-
-
-
+
+
-
-
-
-
-
-
-
-
+
-
-
-
-
+
+
-

-
-
-
+
+



-
+



+

-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+




-
+
-





-
-
+
-
-
+
-





-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-









-
-
-
-
+
-
-
+
-
-
-
-
-
-
+
+


-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-




-
+
-
-
+


-
+
-
-
-
+
+


-
+

+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+











-
+


-
-
+
+

-
-
-
-
+
+
-
-
-
+
-
-
+
-
-
+
-
-
-
-
-
-
-
-
-
+
-
-
-
-
+
+
+
-
-
-
-
-
-
-

-
+
+

-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
+
+

-
-
+
+
+

-
-
-
-
+
+
+
+
+
+
-
-
-
-

+
+
-
-
+
+
-
-
-
-
-
+
+
+
-
-



-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
+






-
-
+
+



-
+
-



-
+

-
+




-
-
-
-
-
-
-
-
-
-
-
-
-

-
+






-
+








{
    srand(exp_getpidproc());
}

/*
 *----------------------------------------------------------------------
 *
 * exp_init_unit_random --
 * human_write --
 *
 *	This function is my implementation of the Weibull distribution.
 *	I've added a max time and an "alpha_eow" that captures the slight
 *	but noticable change in human typists when hitting end-of-word
 *	transitions.
 *
 * Results:
 *	0 for success, -1 for failure, positive for standard Tcl result
 *
 * Side Effects:
 *	None
 *
 *----------------------------------------------------------------------
 */

static int
human_write(interp,f,buffer,arg)
human_write(interp,esPtr,buffer,arg) /* INTL */
    Tcl_Interp *interp;
    struct exp_f *f;
    ExpState *esPtr;
    char *buffer;
    struct human_arg *arg;
{
    char *sp;
    int size;
    float t;
    float alpha;
    int in_word = TRUE;
    int wc;
    int in_word = TRUE;
    Tcl_UniChar ch;

    debuglog("human_write: avg_arr=%f/%f  1/shape=%f  min=%f  max=%f\r\n",
	     arg->alpha,arg->alpha_eow,arg->c,arg->min,arg->max);
    expDiagLog("human_write: avg_arr=%f/%f  1/shape=%f  min=%f  max=%f\r\n",
	    arg->alpha,arg->alpha_eow,arg->c,arg->min,arg->max);

    for (sp = buffer;*sp;sp++) {
    for (sp = buffer;*sp;sp += size) {
	size = Tcl_UtfToUniChar(sp, &ch);
	/* use the end-of-word alpha at eow transitions */
	if (in_word && (ispunct(*sp) || isspace(*sp)))
	if (in_word && (Tcl_UniCharIsPunct(ch) || Tcl_UniCharIsSpace(ch)))
	    alpha = arg->alpha_eow;
	else alpha = arg->alpha;
	in_word = !(ispunct(*sp) || isspace(*sp));
	in_word = !(Tcl_UniCharIsPunct(ch) || Tcl_UniCharIsSpace(ch));

	t = alpha * (float) pow(-log((double)unit_random()),arg->c);
	t = alpha * pow(-log((double)unit_random()),arg->c);

	/* enforce min and max times */
	if (t<arg->min) t = arg->min;
	else if (t>arg->max) t = arg->max;

	/*fprintf(stderr,"\nwriting <%c> but first sleep %f seconds\n",*sp,t);*/
	/* skip sleep before writing first character */
		/* skip sleep before writing first character */
	if (sp != buffer) {
	    wc = exp_dsleep(interp,(double)t);
	    if (wc > 0) return wc;
	}

	wc = exp_exact_write(f, sp, 1);
	wc = Tcl_WriteChars(esPtr->channel, sp, size);
	if (wc == -1) {
	    return -1;
	if (0 > wc) return(wc);
	}
    }
    return(0);
}

struct exp_i *exp_i_pool = 0;
struct exp_fs_list *exp_fs_list_pool = 0;
struct exp_state_list *exp_state_list_pool = 0;

#define EXP_I_INIT_COUNT	10
#define EXP_FS_INIT_COUNT	10
#define EXP_FD_INIT_COUNT	10

struct exp_i *
exp_new_i()
{
    int n;
    struct exp_i *i;

    if (!exp_i_pool) {
	/* none avail, generate some new ones */
	exp_i_pool = i = (struct exp_i *)ckalloc(
						 EXP_I_INIT_COUNT * sizeof(struct exp_i));
		EXP_I_INIT_COUNT * sizeof(struct exp_i));
	for (n=0;n<EXP_I_INIT_COUNT-1;n++,i++) {
	    i->next = i+1;
	}
	i->next = 0;
    }

    /* now that we've made some, unlink one and give to user */

    i = exp_i_pool;
    exp_i_pool = exp_i_pool->next;
    i->value = 0;
    i->variable = 0;
    i->fs_list = 0;
    i->state_list = 0;
    i->ecount = 0;
    i->next = 0;
    return i;
}

/*
 *----------------------------------------------------------------------
 *
 * exp_new_fs --
 *
 *	Get a new exp_f structure.
 *
 * Results:
 *	A structure pointer if successful.
 *
 * Side Effects:
 *	Removes one from the pool if there are any in the pool.
 *	If none are in pool, more are allocated for the pool.
 *
 *----------------------------------------------------------------------
 */

struct exp_fs_list *
exp_new_fs(f)
    struct exp_f *f;
struct exp_state_list *
exp_new_state(esPtr)
    ExpState *esPtr;
{
    int n;
    struct exp_fs_list *fs;
    struct exp_state_list *fd;

    if (!exp_fs_list_pool) {
	exp_fs_list_pool = fs = (struct exp_fs_list *)
	    ckalloc(EXP_FS_INIT_COUNT * sizeof(struct exp_fs_list));
	for (n=0;n<EXP_FS_INIT_COUNT-1;n++,fs++) {
	    fs->next = fs+1;
    if (!exp_state_list_pool) {
	/* none avail, generate some new ones */
	exp_state_list_pool = fd = (struct exp_state_list *)ckalloc(
	    EXP_FD_INIT_COUNT * sizeof(struct exp_state_list));
	for (n=0;n<EXP_FD_INIT_COUNT-1;n++,fd++) {
	    fd->next = fd+1;
	}
	fs->next = 0;
	fd->next = 0;
    }

    /* now that we've made some, unlink one and give to user */

    fs = exp_fs_list_pool;
    exp_fs_list_pool = exp_fs_list_pool->next;
    fs->f = f;
    return fs;
    fd = exp_state_list_pool;
    exp_state_list_pool = exp_state_list_pool->next;
    fd->esPtr = esPtr;
    /* fd->next is assumed to be changed by caller */
    return fd;
}

/*
 *----------------------------------------------------------------------
 *
 * exp_free_fs --
 *
 *	Add an exp_f structure list to the free pool.
 *
 * Results:
 *	None
 *
 *----------------------------------------------------------------------
 */

void
exp_free_fs(fs_first)
    struct exp_fs_list *fs_first;
exp_free_state(fd_first)
    struct exp_state_list *fd_first;
{
    struct exp_fs_list *fs, *penultimate;
    struct exp_state_list *fd, *penultimate;

    if (!fs_first) return;
    if (!fd_first) return;

    /*
     * link entire chain back in at once by first finding last pointer
     * making that point back to pool, and then resetting pool to this
    /* link entire chain back in at once by first finding last pointer */
    /* making that point back to pool, and then resetting pool to this */
     */

    /* run to end */
    for (fs = fs_first;fs;fs=fs->next) {
	penultimate = fs;
    for (fd = fd_first;fd;fd=fd->next) {
	penultimate = fd;
    }
    penultimate->next = exp_fs_list_pool;
    exp_fs_list_pool = fs_first;
    penultimate->next = exp_state_list_pool;
    exp_state_list_pool = fd_first;
}

/*
 *----------------------------------------------------------------------
 *
 * exp_free_fs_single --
 *
 *	Remove an exp_f structure from the list and put it back
 *	in the free pool
 *
 * Results:
 *	None
 *
 *----------------------------------------------------------------------
 */

/* free a single fd */
void
exp_free_fs_single(fs)
    struct exp_fs_list *fs;
exp_free_state_single(fd)
    struct exp_state_list *fd;
{
    fs->next = exp_fs_list_pool;
    exp_fs_list_pool = fs;
    fd->next = exp_state_list_pool;
    exp_state_list_pool = fd;
}

void
exp_free_i(interp,i,updateproc)
    Tcl_Interp *interp;
    struct exp_i *i;
    Tcl_VarTraceProc *updateproc; /* proc to invoke if indirect is written */
    Tcl_VarTraceProc *updateproc;	/* proc to invoke if indirect is written */
{
    if (i->next) exp_free_i(interp,i->next,updateproc);

    exp_free_fs(i->fs_list);
    exp_free_state(i->state_list);

    if (i->direct == EXP_INDIRECT) {
	Tcl_UntraceVar(interp,i->variable,
		       TCL_GLOBAL_ONLY|TCL_TRACE_WRITES,
		       updateproc,(ClientData)i);
		TCL_GLOBAL_ONLY|TCL_TRACE_WRITES,
		updateproc,(ClientData)i);
    }

    /*
     * here's the long form
     * if duration & direct	free(var)  free(val)
     * PERM	  DIR	    		1
     * PERM	  INDIR	    1		1
     * TMP	  DIR
     * TMP	  INDIR			1
     * Also if i->variable was a bogus variable name, i->value might not be
     * set, so test i->value to protect this
     * TMP in this case does NOT mean from the "expect" command.  Rather
     * it means "an implicit spawn id from any expect or expect_XXX
     *  command".  In other words, there was no variable name provided.
     */
    /* here's the long form
       if duration & direct	free(var)  free(val)
	PERM	  DIR	    		1
	PERM	  INDIR	    1		1
	TMP	  DIR
	TMP	  INDIR			1
	Also if i->variable was a bogus variable name, i->value might not be
	set, so test i->value to protect this
	TMP in this case does NOT mean from the "expect" command.  Rather
	it means "an implicit spawn id from any expect or expect_XXX
	command".  In other words, there was no variable name provided.
    */
    if (i->value
	&& (((i->direct == EXP_DIRECT) && (i->duration == EXP_PERMANENT))
	    || ((i->direct == EXP_INDIRECT) && (i->duration == EXP_TEMPORARY))))
	    && (((i->direct == EXP_DIRECT) && (i->duration == EXP_PERMANENT))
	    || ((i->direct == EXP_INDIRECT) && (i->duration == EXP_TEMPORARY)))) {
    {
	ckfree(i->value);
    } else if (i->duration == EXP_PERMANENT) {
	if (i->value) ckfree(i->value);
	if (i->variable) ckfree(i->variable);
    }

    i->next = exp_i_pool;
    exp_i_pool = i;
}

/*
 *----------------------------------------------------------------------
 *
 * exp_new_i_complex --
 *
 *	Generate a descriptor for a "-i" flag.  This tries to
/* generate a descriptor for a "-i" flag */
 *	be backward compatible, but it can't be perfect.  If
 *	a channel exists, it assumes that the channel is what
 *	was intended.  If it doesn't, it checks the identifier
 *	as a variable.  If the variable exists, the it uses
 *	the variable name as an indirect pointer to the channel
 *	to use.  If the variable doesn't exist, it falls back
 *	to assuming the identifier is a channel identifier.
 *
 * Results:
 *	A new descriptor structure.  Cannot fail currently.
 *
 * Side Effects:
 *	Memory is allocated and a Tcl variable trace may be setup
 *
 *----------------------------------------------------------------------
 */
 
/* cannot fail */
struct exp_i *
exp_new_i_complex(interp,arg,duration,updateproc,msg)
exp_new_i_complex(interp,arg,duration,updateproc)
    Tcl_Interp *interp;
    char *arg;		/* spawn id list or a variable containing a list */
    int duration;	/* if we have to copy the args */
    /* should only need do this in expect_before/after */
			/* should only need do this in expect_before/after */
    Tcl_VarTraceProc *updateproc;	/* proc to invoke if indirect is written */
    char *msg;		/* Error message identifier */
{
    struct exp_i *i;
    char **stringp;
    Tcl_DString dString;
    

    if (!exp_chan2f(interp, arg, 1, 0, msg)) {
	Tcl_DStringInit(&dString);
	Tcl_DStringGetResult(interp, &dString);
	if (Tcl_GetVar(interp, arg, 0)) {
	    Tcl_DStringFree(&dString);
	    i = exp_new_i();
	    i->direct = EXP_INDIRECT;
	    stringp = &i->variable;
	} else {
    i = exp_new_i();

    i->direct = (isExpChannelName(arg)?EXP_DIRECT:EXP_INDIRECT);
#if OBSOLETE
    i->direct = (isdigit(arg[0]) || (arg[0] == '-'))?EXP_DIRECT:EXP_INDIRECT;
#endif
    if (i->direct == EXP_DIRECT) {
	stringp = &i->value;
    } else {
	    Tcl_DStringResult(interp, &dString);
	    Tcl_DStringFree(&dString);
	    return NULL;
	}
    } else {
	i = exp_new_i();
	i->direct = EXP_DIRECT;
	stringp = &i->value;
	stringp = &i->variable;
    }

    i->duration = duration;
    if (duration == EXP_PERMANENT) {
	*stringp = ckalloc(strlen(arg)+1);
	strcpy(*stringp,arg);
    } else {
	*stringp = arg;
    }
    
    i->fs_list = 0;

    i->state_list = 0;
    exp_i_update(interp,i);
    

    /* if indirect, ask Tcl to tell us when variable is modified */
    

    if (i->direct == EXP_INDIRECT) {
	Tcl_TraceVar(interp, i->variable, TCL_GLOBAL_ONLY|TCL_TRACE_WRITES,
		     updateproc, (ClientData) i);
	Tcl_TraceVar(interp, i->variable,
		TCL_GLOBAL_ONLY|TCL_TRACE_WRITES,
		updateproc, (ClientData) i);
    }
    

    return i;
}

/*
 *----------------------------------------------------------------------
 *
 * exp_i_add_f --
 *
 *	Add to a list of descriptors
 *
 * Results:
 *	None
void
exp_i_add_state(i,esPtr)
    struct exp_i *i;
    ExpState *esPtr;
{
    struct exp_state_list *new_state;

    new_state = exp_new_state(esPtr);
    new_state->next = i->state_list;
 *
 * Side Effects:
 *	A list grows
 *
    i->state_list = new_state;
}

 *----------------------------------------------------------------------
 */

/* this routine assumes i->esPtr is meaningful */
static void
exp_i_add_f(i,f)
    struct exp_i *i;
    struct exp_f *f;
{
    struct exp_fs_list *new_fs;

    new_fs = exp_new_fs(f);
    new_fs->next = i->fs_list;
    i->fs_list = new_fs;
}

/*
 *----------------------------------------------------------------------
 *
 * exp_i_parse_channels
exp_i_parse_states(interp,i) /* INTL */
 *
 *	Parses a string containing a list of channel identifiers and
 *	adds the resulting exp_f structures to a list.
 *
 * Results:
 *	None
 *
 * Side Effects:
 *	A list grows
 *
 *----------------------------------------------------------------------
 */
 
void
exp_i_parse_channels(interp, i)
    Tcl_Interp *interp;
    struct exp_i *i;
{
    struct ExpState *esPtr;
    char *p = i->value;
    char *b;
    char s;
    int argc;
    char **argv;
    struct exp_f *f;

    int j;
    while (1) {
	while (isspace(*p)) {
	    p++;
	}
	if (*p == 0) break;

    if (Tcl_SplitList(NULL, p, &argc, &argv) != TCL_OK) goto error;
	b = p;
	while (*p && !isspace(*p)) {
	    p++;
	}

	s = *p;
	*p = 0;

    for (j = 0; j < argc; j++) {
        esPtr = expStateFromChannelName(interp,argv[j],1,0,0,"");
	f = exp_chan2f(interp, b, 1, 0, "");
	if (f) {
	    exp_i_add_f(i,f);
	}

	if (!esPtr) goto error;
	exp_i_add_state(i,esPtr);
    }
    ckfree((char*)argv);
	*p = s;
    }
}
    return;
error:
    expDiagLogU("exp_i_parse_states: ");
    expDiagLogU(Tcl_GetStringResult(interp));
    return;
}
	
	
/*
 *----------------------------------------------------------------------
 *
 * exp_i_update --
 *
 *	updates a single exp_i struct
/* updates a single exp_i struct */
 *
 * Results:
 *	None
 *
 *----------------------------------------------------------------------
 */

void
exp_i_update(interp,i)
    Tcl_Interp *interp;
    struct exp_i *i;
{
    char *p;			/* string representation of list of spawn ids*/
    char *p;	/* string representation of list of spawn ids */

    if (i->direct == EXP_INDIRECT) {
	p = Tcl_GetVar(interp,i->variable,TCL_GLOBAL_ONLY);
	if (!p) {
	    p = "";
	    /* *really* big variable names could blow up expDiagLog! */
	    exp_debuglog("warning: indirect variable %s undefined",i->variable);
	    expDiagLog("warning: indirect variable %s undefined",i->variable);
	}

    
	if (i->value) {
	    if (streq(p,i->value)) return;

      
	    /* replace new value with old */
	    ckfree(i->value);
	}
	i->value = ckalloc(strlen(p)+1);
	strcpy(i->value,p);

	exp_free_fs(i->fs_list);
	i->fs_list = 0;
	exp_free_state(i->state_list);
	i->state_list = 0;
    } else {
	/* no free, because this should only be called on */
	/* "direct" i's once */
	i->fs_list = 0;
	i->state_list = 0;
    }
    exp_i_parse_channels(interp, i);
    exp_i_parse_states(interp, i);
    return;
}

/*
 *----------------------------------------------------------------------
 *
 * exp_new_i_simple --
 *
 *	Not quite sure what this does (GCC)
 *
 * Results:
 *	An exp_i structure
 *
 *----------------------------------------------------------------------
 */

struct exp_i *
exp_new_i_simple(f,duration)
    struct exp_f *f;
    int duration;		/* if we have to copy the args */
    /* should only need do this in expect_before/after */
exp_new_i_simple(esPtr,duration)
    ExpState *esPtr;
    int duration;   /* if we have to copy the args */
		    /* should only need do this in expect_before/after */
{
    struct exp_i *i;

    i = exp_new_i();

    i->direct = EXP_DIRECT;
    i->duration = duration;

    exp_i_add_f(i,f);
    exp_i_add_state(i,esPtr);

    return i;
}

/*
 *----------------------------------------------------------------------
 *
 * exp_exact_write --
 *
 *	Write exactly this many bytes, i.e. retry partial writes.
 *
 * Results:
 *	0 on success, -1 on failure
 *	
 * Side Effects:
 *	Data is written to an output object
 *
 *----------------------------------------------------------------------
 */

int
exp_exact_write(f,buffer,rembytes)
    struct exp_f *f;
    char *buffer;
    int rembytes;
{
    int n;
    while (rembytes) {
	n = Tcl_Write(f->channel, buffer, rembytes);
	if (-1 == n) {
	    return -1;
	}
	if (0 == n) {
	    Tcl_Sleep(1000);
	    exp_debuglog("write() failed to write anything but returned - sleeping and retrying...\n");
	}
	buffer += n;
	rembytes -= n;
    }
    return(0);
}

/*
 *----------------------------------------------------------------------
 *
 * ExpSpawnOpen --
 *
 *	Handle the 'spawn -open' command.  Called from Exp_SpawnCmd.
 *
 * Results:
 *	A standard Tcl result
 *
 *----------------------------------------------------------------------
 */

int
ExpSpawnOpen(interp, chanId, leaveopen)
    Tcl_Interp *interp;
    char *chanId;
    int leaveopen;
{
    Tcl_Channel chan;
    int mode;
    struct exp_f *f;
    
    if (!(chan = Tcl_GetChannel(interp, chanId, &mode))) {
	return TCL_ERROR;
    }
    if (!mode) {
	exp_error(interp,"%s: channel is neither readable nor writable",
		  chanId);
	return TCL_ERROR;
    }

    f = exp_f_find(interp, chanId);
    if (! f) {
	f = exp_f_new(interp, chan, NULL, EXP_NOPID);
	f->leaveopen = leaveopen;

	exp_wait_zero(&f->wait);
    } else {
	/*
	 * Reference count this thing
	 */

	f->leaveopen += leaveopen;
    }

    /* tell user id of new process */
    Tcl_SetVar(interp,EXP_SPAWN_ID_VARNAME,chanId,0);

    sprintf(interp->result,"%d",EXP_NOPID);
    debuglog("spawn: returns {%s}\r\n",interp->result);

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Exp_SendLogCmd --
 *
 *	Implements the send_log command.
 *
 * Results:
 *	A standard Tcl result
 *
 * Side Effects:
 *	Messages are written to a log file
 *
 *----------------------------------------------------------------------
 */

/*ARGSUSED*/
static int
Exp_SendLogCmd(clientData, interp, argc, argv)
    ClientData clientData;
    Tcl_Interp *interp;
    int argc;
    char **argv;
{
    char *string;
    int len;

    argv++;
    argc--;

    if (argc) {
	if (streq(*argv,"--")) {
	    argc--; argv++;
	}
    }

    if (argc != 1) {
	exp_error(interp,"usage: send [args] string");
	return TCL_ERROR;
    }

    string = *argv;

    expLogDiagU(*argv);
    len = strlen(string);

    if (debugfile) Tcl_Write(debugfile, string, len);
    if (logfile) Tcl_Write(logfile, string, len);

    return(TCL_OK);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *

 * Exp_SendCmd --
 *
 *	Sends data to a subprocess or over some channel
 *
 * Results:
 *	Standard Tcl result
 *
 * Notes:
 *	(Don) I've rewritten this to be unbuffered.  I did this so you
 *	could shove large files through "send".  If you are concerned
 *	about efficiency, you should quote all your send args to make
/* I've rewritten this to be unbuffered.  I did this so you could shove */
/* large files through "send".  If you are concerned about efficiency */
/* you should quote all your send args to make them one single argument. */
 *	them one single argument.
 *
 *	(GCC) This uses Tcl channels.  By default, the channel
 *	translation will be binary for channels created with
 *	spawn <program>.  The clientData argument, if non-NULL,
 *	holds the name of the channel to use.
 *
 *----------------------------------------------------------------------
 */

/*ARGSUSED*/
static int
Exp_SendCmd(clientData, interp, argc, argv)
int
Exp_SendObjCmd(clientData, interp, objc, objv) /* INTL */
    ClientData clientData;
    Tcl_Interp *interp;
    int argc;
    char **argv;
    int objc;
    Tcl_Obj *CONST objv[];
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    ExpState *esPtr = 0;
    int rc;			/* final result of this procedure */
    int rc; 	/* final result of this procedure */
    struct human_arg human_args;
    struct slow_arg slow_args;
#define SEND_STYLE_STRING_MASK	0x07 /* mask to detect a real string arg */
#define SEND_STYLE_STRING_MASK	0x07	/* mask to detect a real string arg */
#define SEND_STYLE_PLAIN	0x01
#define SEND_STYLE_HUMAN	0x02
#define SEND_STYLE_SLOW		0x04
#define SEND_STYLE_ZERO		0x10
#define SEND_STYLE_BREAK	0x20
    int send_style = SEND_STYLE_PLAIN;
    int want_cooked = TRUE;
    char *string;		/* string to send */
    int len;			/* length of string to send */
    int zeros;			/* count of how many ascii zeros to send */
    
    char *i_masters = 0;
    struct exp_fs_list *fs;
    int len = -1;		/* length of string to send */
    int zeros;		/* count of how many ascii zeros to send */

    char *chanName = 0;
    struct exp_state_list *state_list;
    struct exp_i *i;
    char *arg;
    struct exp_f *f = NULL;
    char *argv0 = argv[0];
    
    int j;

    static char *options[] = {
	"-i", "-h", "-s", "-null", "-0", "-raw", "-break", "--", (char *)0
    };
    enum options {
	SEND_SPAWNID, SEND_HUMAN, SEND_SLOW, SEND_NULL, SEND_ZERO,
	SEND_RAW, SEND_BREAK, SEND_LAST
    };

    argv++;
    argc--;
    while (argc) {
	arg = *argv;
    for (j = 1; j < objc; j++) {
	if (arg[0] != '-') break;
	arg++;
	char *name;
	if (exp_flageq1('-',arg)) { /* "--" */
	    argc--; argv++;
	    break;
	} else if (exp_flageq1('i',arg)) { /* "-i" */
	    argc--; argv++;
	    if (argc==0) {
		exp_error(interp,"usage: %s -i spawn_id", argv0);
		return(TCL_ERROR);
	    }
	    i_masters = *argv;
	    argc--; argv++;
	    continue;
	int index;

	name = Tcl_GetString(objv[j]);
	if (name[0] != '-') {
	    break;
	}
	if (Tcl_GetIndexFromObj(interp, objv[j], options, "flag", 0,
		&index) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch ((enum options) index) {
	    case SEND_SPAWNID:
		j++;
		chanName = Tcl_GetString(objv[j]);
	} else if (exp_flageq1('h',arg)) { /* "-h" */
	    argc--; argv++;
	    if (-1 == get_human_args(interp,&human_args))
		break;

		return(TCL_ERROR);
	    send_style = SEND_STYLE_HUMAN;
	    case SEND_LAST:
	    continue;
	} else if (exp_flageq1('s',arg)) { /* "-s" */
	    argc--; argv++;
	    if (-1 == get_slow_args(interp,&slow_args))
		j++;
		goto getString;
		return(TCL_ERROR);
	    send_style = SEND_STYLE_SLOW;
	    continue;
	} else if (exp_flageq("null",arg,1) || exp_flageq1('0',arg)) {
	    argc--; argv++;	/* "-null" */
	    if (!*argv) zeros = 1;
	    else {
		zeros = atoi(*argv);

	    case SEND_HUMAN:
		if (-1 == get_human_args(interp,&human_args))
		    return(TCL_ERROR);
		send_style = SEND_STYLE_HUMAN;
		break;

	    case SEND_SLOW:
		if (-1 == get_slow_args(interp,&slow_args))
		    return(TCL_ERROR);
		send_style = SEND_STYLE_SLOW;
		break;

	    case SEND_NULL:
	    case SEND_ZERO:
		j++;
		if (j >= objc) {
		    zeros = 1;
		argc--; argv++;
		if (zeros < 1) return TCL_OK;
	    }
	    send_style = SEND_STYLE_ZERO;
	    string = "<zero(s)>";
	    continue;
	} else if (exp_flageq("raw",arg,1)) { /* "-raw" */
		} else if (Tcl_GetIntFromObj(interp, objv[j], &zeros)
			!= TCL_OK) {
		    return TCL_ERROR;
		}
		if (zeros < 1) return TCL_OK;
		send_style = SEND_STYLE_ZERO;
		string = "<zero(s)>";
		break;

	    argc--; argv++;
	    want_cooked = FALSE;
	    case SEND_RAW:
		want_cooked = FALSE;
	    continue;
	} else if (exp_flageq("break",arg,1)) {	/* "-break" */
	    argc--; argv++;
	    send_style = SEND_STYLE_BREAK;
	    string = "<break>";
		break;

	    case SEND_BREAK:
		send_style = SEND_STYLE_BREAK;
		string = "<break>";
	    continue;
	} else {
	    exp_error(interp,"usage: unrecognized flag <-%.80s>",arg);
	    return TCL_ERROR;
	}
    }
    
		break;
    if (send_style & SEND_STYLE_STRING_MASK) {
	if (argc != 1) {
	    exp_error(interp,"usage: %s [args] string", argv0);
	    return TCL_ERROR;
	}
	string = *argv;
    }
    len = strlen(string);
    
    if (clientData != NULL) {
	f = exp_chan2f(interp, (char *) clientData, 1, 0, argv0);
    } else if (!i_masters) {
	/*
	 * we really do want to check if it is open

    if (send_style & SEND_STYLE_STRING_MASK) {
	 * but since stdin could be closed, we have to first
	 * get the fs and then convert it from 0 to 1 if necessary
	 */
	f = exp_update_master(interp,0,0);
	if (f == NULL) {
	    return(TCL_ERROR);
	if (j != objc-1) {
	    exp_error(interp,"usage: send [args] string");
	    return TCL_ERROR;
	}
getString:
	string = Tcl_GetStringFromObj(objv[j], &len);
    } else {
	len = strlen(string);
    }
    

    /*
     * if f != NULL, then it holds desired master, else i_masters does
    if (clientData == &sendCD_user) esPtr = tsdPtr->stdinout;
     */
    
    if (f) {
    else if (clientData == &sendCD_error) esPtr = tsdPtr->stderrX;
    else if (clientData == &sendCD_tty) esPtr = tsdPtr->devtty;
	i = exp_new_i_simple(f,EXP_TEMPORARY);
    } else {
    else if (!chanName) {
	i = exp_new_i_complex(interp,i_masters,FALSE,
			      (Tcl_VarTraceProc *)NULL,argv0);
	if (i == NULL) {
	    return TCL_ERROR;
	}
	/* we want to check if it is open */
	/* but since stdin could be closed, we have to first */
	/* get the fd and then convert it from 0 to 1 if necessary */
	if (!(esPtr = expStateCurrent(interp,0,0,0))) return(TCL_ERROR);
    }

    if (esPtr) {
	i = exp_new_i_simple(esPtr,EXP_TEMPORARY);
    } else {
	i = exp_new_i_complex(interp,chanName,FALSE,(Tcl_VarTraceProc *)0);
    }
    
    if (clientData == NULL) {
	/* This seems to be the standard send call (send_to_proc) */

#define send_to_stderr	(clientData == &sendCD_error)
#define send_to_proc	(clientData == &sendCD_proc)
#define send_to_user	((clientData == &sendCD_user) || \
			 (clientData == &sendCD_tty))

    if (send_to_proc) {
	want_cooked = FALSE;
	debuglog("send: sending \"%s\" to {",dprintify(string));
	expDiagLogU("send: sending \"");
	expDiagLogU(expPrintify(string));
	expDiagLogU("\" to {");
	/* if closing brace doesn't appear, that's because an error */
	/* was encountered before we could send it */
    } else {
	if (debugfile) {
	    Tcl_Write(debugfile, string, len);
	}
	expLogDiagU(string);
    }
	/* send_to_user ? */
	if (((strcmp((char *) clientData, "exp_user") == 0 ||
	      strcmp((char *) clientData, exp_dev_tty_id) == 0 ||
	      strcmp((char *) clientData, "exp_tty") == 0) && logfile_all) ||
	    logfile) {
	    if (logfile) {
		Tcl_Write(logfile, string, len);
	    }

	}
    }
    
    for (fs=i->fs_list;fs;fs=fs->next) {
    for (state_list=i->state_list;state_list;state_list=state_list->next) {
	esPtr = state_list->esPtr;
	f = fs->f;

	if (clientData == NULL) {
	    /* send_to_proc */
	    debuglog(" %s ", f->spawnId);
	if (send_to_proc) {
	    expDiagLog(" %s ",esPtr->name);
	}

	/* check validity of each - i.e., are they open */
	if (! exp_fcheck(interp, f, 1, 0, "send")) {
	if (0 == expStateCheck(interp,esPtr,1,0,"send")) {
	    rc = TCL_ERROR;
	    goto finish;
	}
	if (want_cooked) string = exp_cook(string,&len);

	if (want_cooked) string = exp_cook(string,&len);

	switch (send_style) {
	case SEND_STYLE_PLAIN:
	    rc = exp_exact_write(f,string,len);
	    break;
	case SEND_STYLE_SLOW:
	    rc = slow_write(interp,f,string,len,&slow_args);
	    break;
	case SEND_STYLE_HUMAN:
	    rc = human_write(interp,f,string,&human_args);
	    break;
	case SEND_STYLE_ZERO:
	    for (;zeros>0;zeros--)
		rc = exp_exact_write(f, "", 1);
	    /* catching error on last write is sufficient */
	    break;
	case SEND_STYLE_BREAK:
	    exp_tty_break(interp,f);
	    rc = 0;
	    break;
	    case SEND_STYLE_PLAIN:
		rc = exact_write(esPtr,string,len);
		break;
	    case SEND_STYLE_SLOW:
		rc = slow_write(interp,esPtr,string,len,&slow_args);
		break;
	    case SEND_STYLE_HUMAN:
		rc = human_write(interp,esPtr,string,&human_args);
		break;
	    case SEND_STYLE_ZERO:
		for (;zeros>0;zeros--) {
		    rc = Tcl_WriteChars(esPtr->channel,
			    NULL_STRING, NULL_LENGTH);
		}
		/* catching error on last write is sufficient */
		rc = ((rc==1) ? 0 : -1);   /* normal is 1 not 0 */
		break;
	    case SEND_STYLE_BREAK:
		exp_tty_break(interp,esPtr->fdout);
		rc = 0;
		break;
	}

	if (rc != 0) {
	    if (rc == -1) {
		exp_error(interp,"write(spawn_id=%s): %s", f->spawnId,
		exp_error(interp,"write(spawn_id=%d): %s",esPtr->fdout,Tcl_PosixError(interp));
			  Tcl_PosixError(interp));
		rc = TCL_ERROR;
	    }
	    goto finish;
	}
    }
    if (clientData == NULL) {
	/* send_to_proc */
    if (send_to_proc) expDiagLogU("}\r\n");
	debuglog("}\r\n");
    }

    
    rc = TCL_OK;
 finish:
    exp_free_i(interp,i,(Tcl_VarTraceProc *)0);
    return rc;
}

/*
 *----------------------------------------------------------------------
 *
 * Exp_LogFileCmd --
 *
 *	Implements the 'log_file' and 'exp_log_file' commands.
 *	Opens a logfile.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side Effects:
 *	A file may be opened, or a currently open file may be
 *	changed to unbuffered
 *
 *----------------------------------------------------------------------
 */

/*ARGSUSED*/
static int
Exp_LogFileCmd(clientData, interp, argc, argv)
    ClientData clientData;
    Tcl_Interp *interp;
    int argc;
    char **argv;
{
    static Tcl_DString dstring;
    static int first_time = TRUE;
    static int current_append;	/* true if currently appending */
    static char *openarg = 0;	/* Tcl file identifier from -open */
    static char resultbuf[1000];
    static int leaveopen = FALSE;	/* true if -leaveopen was used */
    
    char *chanName = 0;
    int old_logfile_all = logfile_all;
    Tcl_Channel old_logfile = logfile;
    char *old_openarg = openarg;
    int old_leaveopen = leaveopen;
    
    int aflag = FALSE;
    int leaveOpen = FALSE;
    int logAll = FALSE;
    int append = TRUE;
    char *filename = 0;
    char *type;
    int usage_error_occurred = FALSE;
    

    openarg = 0;
    leaveopen = FALSE;
    
    if (first_time) {
	Tcl_DStringInit(&dstring);
	first_time = FALSE;
    }
    
#define usage_error {usage_error_occurred = TRUE; goto error; }
    
    /* when this function returns, we guarantee that if logfile_all */
    /* is TRUE, then logfile is non-zero */
    
    argv++;
    argc--;
    for (;argc>0;argc--,argv++) {
	if (streq(*argv,"-open")) {
	    if (!argv[1]) usage_error;
	    if (!argv[1]) goto usage_error;
	    openarg = ckalloc(strlen(argv[1])+1);
	    strcpy(openarg,argv[1]);
	    chanName = argv[1];
	    argc--; argv++;
	} else if (streq(*argv,"-leaveopen")) {
	    if (!argv[1]) usage_error;
	    if (!argv[1]) goto usage_error;
	    openarg = ckalloc(strlen(argv[1])+1);
	    strcpy(openarg,argv[1]);
	    leaveopen = TRUE;
	    chanName = argv[1];
	    leaveOpen = TRUE;
	    argc--; argv++;
	} else if (streq(*argv,"-a")) {
	    aflag = TRUE;
	    logAll = TRUE;
	} else if (streq(*argv,"-info")) {
	    resultbuf[0] = '\0';
	    if (logfile) {
		if (logfile_all) strcat(interp->result,"-a ");
		if (!current_append) strcat(interp->result,"-noappend ");
		strcat(interp->result,Tcl_DStringValue(&dstring));
	    if (expLogChannelGet()) {
		if (expLogAllGet()) strcat(resultbuf,"-a ");
		if (!expLogAppendGet()) strcat(resultbuf,"-noappend ");
		if (expLogFilenameGet()) {
		    strcat(resultbuf,expLogFilenameGet());
		} else {
		    if (expLogLeaveOpenGet()) {
			strcat(resultbuf,"-leaveopen ");
		    }
		    strcat(resultbuf,Tcl_GetChannelName(expLogChannelGet()));
		}
		Tcl_SetResult(interp,resultbuf,TCL_STATIC);
	    }
	    return TCL_OK;
	} else if (streq(*argv,"-noappend")) {
	    append = FALSE;
	} else break;
    }
    
    if (argc == 1) {
	filename = argv[0];
    } else if (argc > 1) {
	/* too many arguments */
	usage_error
	goto usage_error;
    } 
    
    if (openarg && filename) {
	usage_error
    if (chanName && filename) {
	goto usage_error;
    }
    if (aflag && !(openarg || filename)) {
	usage_error
    }
    

    /* check if user merely wants to change logAll (-a) */
    logfile = 0;
    logfile_all = aflag;
    
    if (expLogChannelGet() && (chanName || filename)) {
    current_append = append;
    
	if (filename && (0 == strcmp(filename,expLogFilenameGet()))) {
    type = (append?"a":"w");
    
	    expLogAllSet(logAll);
    if (filename) {
	logfile = Tcl_OpenFileChannel(interp, filename, type, O_CREAT|S_IWRITE);
	if (logfile == (Tcl_Channel) NULL) {
	    exp_error(interp,"%s: %s",filename,Tcl_PosixError(interp));
	    goto error;
	}
    } else if (openarg) {
	int mode;
	
	    return TCL_OK;
	Tcl_DStringTrunc(&dstring,0);
	
	if (!(logfile = Tcl_GetChannel(interp,openarg,&mode))) {
	    return TCL_ERROR;
	} else if (chanName && (0 == strcmp(filename,Tcl_GetChannelName(expLogChannelGet())))) {
	    expLogAllSet(logAll);
	    return TCL_OK;
	}
	if (!(mode & TCL_WRITABLE)) {
	    exp_error(interp,"channel is not writable");
	}

	if (leaveopen) {
	    Tcl_DStringAppend(&dstring,"-leaveopen ",-1);
	} else {
	    Tcl_DStringAppend(&dstring,"-open ",-1);
	    exp_error(interp,"cannot start logging without first stopping logging");
	    return TCL_ERROR;
	}
	Tcl_DStringAppend(&dstring,openarg,-1);
	
    }
	/*
	 * It would be convenient now to tell Tcl to close its
	 * file descriptor.  Alas, if involved in a pipeline, Tcl
	 * will be unable to complete a wait on the process.
	 * So simply remember that we meant to close it.  We will
	 * do so later in our own close routine.
	 */
    }
    if (logfile) {
	Tcl_SetChannelOption(interp, logfile, "-buffering", "none");
    }
    

    if (filename) {
    if (old_logfile) {
	if (!old_openarg || !old_leaveopen) { 
	    Tcl_Close(interp, old_logfile);
	if (TCL_ERROR == expLogChannelOpen(interp,filename,append)) {
	    return TCL_ERROR;
	}
	if (old_openarg) {
	    ckfree(old_openarg);
    } else if (chanName) {
	if (TCL_ERROR == expLogChannelSet(interp,chanName)) {
	    return TCL_ERROR;
	}
    }
    
    return TCL_OK;
    
    } else {
	expLogChannelClose(interp);
	if (logAll) {
	    exp_error(interp,"cannot use -a without a file or channel");
	    return TCL_ERROR;
	}
 error:
    if (old_logfile) {
	logfile = old_logfile;
	logfile_all = old_logfile_all;
    }
    expLogAllSet(logAll);
    expLogLeaveOpenSet(leaveOpen);
    
    if (openarg) ckfree(openarg);

    return TCL_OK;
    openarg = old_openarg;
    leaveopen = old_leaveopen;
    
    if (usage_error_occurred) {
	exp_error(interp,"usage: log_file [-info] [-noappend] [[-a] file] [-[leave]open [open ...]]");

 usage_error:
    exp_error(interp,"usage: log_file [-info] [-noappend] [[-a] file] [-[leave]open [open ...]]");
    }
    
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * Exp_LogUserCmd --
 *
 *	Implements the 'loguser' and 'exp_loguser' commands.
 *	Can turn logging to stdout on or off, and returns the
 *	previous logging status.
 *
 * Results:
 *	A standard TCL result
 *
 * Side Effects:
 *	Logging can be enabled or disabled.
 *
 *----------------------------------------------------------------------
 */

/*ARGSUSED*/
static int
int
Exp_LogUserCmd(clientData, interp, argc, argv)
    ClientData clientData;
    Tcl_Interp *interp;
    int argc;
    char **argv;
{
    int old_loguser = loguser;
    
    int old_loguser = expLogUserGet();

    if (argc == 0 || (argc == 2 && streq(argv[1],"-info"))) {
	/* do nothing */
    } else if (argc == 2) {
	if (0 == atoi(argv[1])) loguser = FALSE;
	expLogUserSet(atoi(argv[1]));
	else loguser = TRUE;
    } else {
	exp_error(interp,"usage: [-info|1|0]");
    }
    

    sprintf(interp->result,"%d",old_loguser);
    

    return(TCL_OK);
}

#ifdef TCL_DEBUGGER
/*
 *----------------------------------------------------------------------
 *
 * Exp_DebugCmd --
 *
 *	Implements the 'debug' and 'exp_debug' commands
 *
 * Results:
 *	A standard Tcl result
 *
 *----------------------------------------------------------------------
 */

/*ARGSUSED*/
static int
int
Exp_DebugCmd(clientData, interp, argc, argv)
    ClientData clientData;
    Tcl_Interp *interp;
    int argc;
    char **argv;
{
    int now = FALSE;		/* soon if FALSE, now if TRUE */
    int now = FALSE;	/* soon if FALSE, now if TRUE */
    int exp_tcl_debugger_was_available = exp_tcl_debugger_available;

    if (argc > 3) goto usage;

    if (argc == 1) {
	sprintf(interp->result,"%d",exp_tcl_debugger_available);
	return TCL_OK;




︙


1920
1921
1922
1923
1924
1925
1926
1927

1928

1929
1930

1931
1932
1933
1934
1935
1936
1937
1938
1939
1940


1941
1942
1943
1944


1945
1946
1947
1948





1949
1950

1951

1952
1953
1954
1955
1956

1957
1958
1959
1960
1961
1962

1963
1964

1965
1966
1967
1968

1969
1970
1971
1972
1973

1974
1975
1976
1977
1978

1979
1980
1981


1982
1983
1984
1985

1986
1987
1988
1989

1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011

2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028

2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048


2049

2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071




2072

2073

2074

2075
2076
2077
2078

2079
2080
2081

2082
2083
2084


2085
2086

2087
2088
2089
2090
2091




2092
2093
2094
2095
2096


2097
2098
2099
2100
2101




2102
2103

2104

2105
2106
2107
2108

2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125

2126
2127
2128

2129
2130
2131

2132
2133
2134

2135
2136

2137
2138
2139

2140
2141
2142
2143
2144

2145
2146
2147
2148

2149
2150
2151


2152
2153
2154


2155
2156
2157
2158
2159
2160
2161






2162
2163
2164
2165

2166
2167
2168
2169
2170

2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190






2191
2192
2193
2194
2195
2196
2197

1688
1689
1690
1691
1692
1693
1694

1695
1696
1697
1698

1699
1700
1701
1702
1703
1704
1705




1706
1707




1708
1709




1710
1711
1712
1713
1714

1715
1716

1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727


1728


1729




1730
1731




1732
1733
1734
1735
1736

1737
1738


1739
1740


1741

1742

1743
1744

1745


1746
1747
1748













1749
1750
1751

1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768

1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788

1789
1790
1791
1792
1793
1794














1795
1796




1797
1798
1799
1800

1801
1802
1803

1804
1805



1806



1807
1808


1809
1810
1811

1812
1813




1814
1815
1816
1817
1818
1819
1820


1821
1822
1823




1824
1825
1826
1827
1828
1829
1830

1831
1832
1833
1834

1835
1836
1837
1838
1839
1840


1841

1842







1843
1844
1845

1846



1847



1848


1849



1850
1851




1852
1853
1854
1855

1856



1857
1858
1859


1860
1861
1862






1863
1864
1865
1866
1867
1868
1869
1870
1871

1872
1873
1874

1875

1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891





1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904








-
+

+

-
+






-
-
-
-
+
+
-
-
-
-
+
+
-
-
-
-
+
+
+
+
+
-

+
-
+





+




-
-
+
-
-
+
-
-
-
-
+

-
-
-
-
+




-
+

-
-
+
+
-
-

-
+
-


-
+
-
-



-
-
-
-
-
-
-
-
-
-
-
-
-



-
+
















-
+



















-
+
+

+


-
-
-
-
-
-
-
-
-
-
-
-
-
-


-
-
-
-
+
+
+
+
-
+

+
-
+

-
-
-
+
-
-
-
+

-
-
+
+

-
+

-
-
-
-
+
+
+
+



-
-
+
+

-
-
-
-
+
+
+
+


+
-
+



-
+





-
-

-

-
-
-
-
-
-
-
+


-
+
-
-
-
+
-
-
-
+
-
-
+
-
-
-
+

-
-
-
-
+



-
+
-
-
-
+
+

-
-
+
+

-
-
-
-
-
-
+
+
+
+
+
+



-
+


-

-
+















-
-
-
-
-
+
+
+
+
+
+








    }
    sprintf(interp->result,"%d",exp_tcl_debugger_was_available);
    return(TCL_OK);
 usage:
    exp_error(interp,"usage: [[-now] 1|0]");
    return TCL_ERROR;
}
#endif /* TCL_DEBUGGER */
#endif


/*ARGSUSED*/
static int
int
Exp_ExpInternalCmd(clientData, interp, argc, argv)
    ClientData clientData;
    Tcl_Interp *interp;
    int argc;
    char **argv;
{
    static Tcl_DString dstring;
    static int first_time = TRUE;
    int fopened = FALSE;

    int newChannel = FALSE;
    Tcl_Channel oldChannel;
    if (first_time) {
	Tcl_DStringInit(&dstring);
	first_time = FALSE;
    }
    static char resultbuf[1000];


    if (argc > 1 && streq(argv[1],"-info")) {
	if (debugfile) {
	    sprintf(interp->result,"-f %s ",
    if ((argc > 1) && streq(argv[1],"-info")) {
	resultbuf[0] = '\0';
	oldChannel = expDiagChannelGet();
	if (oldChannel) {
	    sprintf(resultbuf,"-f %s ",expDiagFilename());
		    Tcl_DStringValue(&dstring));
	}
	strcat(resultbuf,expDiagToStderrGet()?"1":"0");
	strcat(interp->result,((exp_is_debugging==0)?"0":"1"));
	Tcl_SetResult(interp,resultbuf,TCL_STATIC);
	return TCL_OK;
    }

    argv++;
    argc--;

    while (argc) {
	if (!streq(*argv,"-f")) break;
	argc--;argv++;
	if (argc < 1) goto usage;
	if (debugfile) {
	    Tcl_Close(interp, debugfile);
	expDiagChannelClose(interp);
	}

	if (TCL_OK != expDiagChannelOpen(interp,argv[0])) {
	debugfile = Tcl_OpenFileChannel(interp, argv[0], "a", O_APPEND|S_IWRITE);
	if (debugfile == (Tcl_Channel) NULL) {
	    exp_error(interp,"%s: %s",argv[0],Tcl_PosixError(interp));
	    goto error;
	    return TCL_ERROR;
	}
	Tcl_DStringAppend(&dstring,argv[0],-1);

	Tcl_SetChannelOption(interp, debugfile, "-buffering", "none");
	fopened = TRUE;
	newChannel = TRUE;
	argc--;argv++;
    }

    if (argc != 1) goto usage;

    
    /* if no -f given, close file */
    if (fopened == FALSE && debugfile) {
	Tcl_Close(interp, debugfile);
    if (!newChannel) {
	expDiagChannelClose(interp);
	debugfile = NULL;
	Tcl_DStringFree(&dstring);
    }

    expDiagToStderrSet(atoi(*argv));
    exp_is_debugging = atoi(*argv);
    return(TCL_OK);
 usage:
    exp_error(interp,"usage: [-f file] expr");
    exp_error(interp,"usage: [-f file] 0|1");
 error:
    Tcl_DStringFree(&dstring);
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * Exp_ExitCmd --
 *
 *	Called on exit to do cleanup.
 *
 * Results:
 *	A standard Tcl result
 *
 *----------------------------------------------------------------------
 */

char *exp_onexit_action = 0;

/*ARGSUSED*/
static int
int
Exp_ExitCmd(clientData, interp, argc, argv)
    ClientData clientData;
    Tcl_Interp *interp;
    int argc;
    char **argv;
{
    int value = 0;

    argv++;

    if (*argv) {
	if (exp_flageq(*argv,"-onexit",3)) {
	    argv++;
	    if (*argv) {
		int len = strlen(*argv);
		if (exp_onexit_action)
		    ckfree(exp_onexit_action);
			ckfree(exp_onexit_action);
		exp_onexit_action = ckalloc(len + 1);
		strcpy(exp_onexit_action,*argv);
	    } else if (exp_onexit_action) {
		Tcl_AppendResult(interp,exp_onexit_action,(char *)0);
	    }
	    return TCL_OK;
	} else if (exp_flageq(*argv,"-noexit",3)) {
	    argv++;
	    exp_exit_handlers((ClientData)interp);
	    return TCL_OK;
	}
    }

    if (*argv) {
	if (Tcl_GetInt(interp, *argv, &value) != TCL_OK) {
	    return TCL_ERROR;
	}
    }

    exp_exit(interp,value);
    Tcl_Exit(value);

    /*NOTREACHED*/
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Exp_CloseCmd --
 *
 *	Currently closes a channel or sets up handlers for
 *	when the channel closes.
 *
 * Results:
 *	A standard Tcl result
 *
 *----------------------------------------------------------------------
 */

/*ARGSUSED*/
static int
Exp_CloseCmd(clientData, interp, argc, argv)
    ClientData clientData;
    Tcl_Interp *interp;
    int argc;
Exp_CloseObjCmd(clientData, interp, objc, objv)
ClientData clientData;
Tcl_Interp *interp;
int objc;
    char **argv;
Tcl_Obj *CONST objv[];	/* Argument objects. */
{
    int onexec_flag = FALSE;	/* true if -onexec seen */
    char *close_onexec = NULL;
    int close_onexec;
    int slave_flag = FALSE;
    char *argv0 = argv[0];
    struct exp_f *f;
#if 0
    ExpState *esPtr = 0;
    int slave;
#endif
    char *chanId = NULL;
    char *chanName = 0;

    int argc_orig = argc;
    char **argv_orig = argv;
    int objc_orig = objc;
    Tcl_Obj *CONST *objv_orig = objv;

    argc--; argv++;
    objc--; objv++;

    for (;argc>0;argc--,argv++) {
	if (streq(*argv,"-i")) {
	    argc--; argv++;
	    if (!*argv) {
    for (;objc>0;objc--,objv++) {
	if (streq("-i",Tcl_GetString(*objv))) {
	    objc--; objv++;
	    if (objc == 0) {
		exp_error(interp,"usage: -i spawn_id");
		return(TCL_ERROR);
	    }
	    chanId = *argv;
	} else if (streq(*argv,"-slave")) {
	    chanName = Tcl_GetString(*objv);
	} else if (streq(Tcl_GetString(*objv),"-slave")) {
	    slave_flag = TRUE;
	} else if (streq(*argv,"-onexec")) {
	    argc--; argv++;
	    if (!*argv) {
		exp_error(interp,"usage: -onexec channelId");
	} else if (streq(Tcl_GetString(*objv),"-onexec")) {
	    objc--; objv++;
	    if (objc == 0) {
		exp_error(interp,"usage: -onexec 0|1");
		return(TCL_ERROR);
	    }
	    onexec_flag = TRUE;
	    close_onexec = *argv;
	    close_onexec = atoi(Tcl_GetString(*objv));
	} else break;
    }

    if (argc) {
    if (objc) {
	/* doesn't look like our format, it must be a Tcl-style file */
	/* handle.  Lucky that formats are easily distinguishable. */
	/* Historical note: we used "close"  long before there was a */
	/* Tcl builtin by the same name. */

	Tcl_Obj **objv;
	int i, result;
	Tcl_CmdInfo info;

	Tcl_ResetResult(interp);
	objv = (Tcl_Obj **) ckalloc((argc+1)*sizeof(Tcl_Obj *));
	objv[0] = Tcl_NewStringObj("exp_tcl_close", -1);
	for (i = 0; i < argc; i++) {
	    objv[i+1] = Tcl_NewStringObj(argv[i], -1);
	}

	if (0 == Tcl_GetCommandInfo(interp,"exp_tcl_close",&info)) {
	if (0 == Tcl_GetCommandInfo(interp,"close",&info)) {
	    info.clientData = 0;
	}
	result = info.objProc(info.objClientData,interp,argc+1,objv);
	return(Tcl_CloseObjCmd(info.clientData,interp,objc_orig,objv_orig));
	for (i = 0; i < argc+1; i++) {
	    Tcl_DecrRefCount(objv[i]);
	}
    }
	ckfree((char *) objv);
	return result;
    }


    if (chanId == NULL) {
    if (chanName) {
	f = exp_update_master(interp, 1, 0);
    } else if (slave_flag) {
	f = exp_chan2f(interp, chanId, 1, 0, "-slave");
	if (!(esPtr = expStateFromChannelName(interp,chanName,1,0,0,"close"))) return TCL_ERROR;
    } else {
	f = exp_chan2f(interp, chanId, 1, 0, argv0);
    }
    if (f == NULL) {
	return TCL_ERROR;
	if (!(esPtr = expStateCurrent(interp,1,0,0))) return TCL_ERROR;
    }

    if (slave_flag) {
	if (f->slave_fd) {
	if (esPtr->fd_slave != EXP_NOFD) {
#ifndef __WIN32__ /* XXX: This still needs some looking at */
	    close(f->slave_fd);
	    f->slave_fd = EXP_NOFD;
	    close(esPtr->fd_slave);
	    esPtr->fd_slave = EXP_NOFD;

	    exp_slave_control(f,1);
#endif
	    exp_slave_control(esPtr->fdin,1);

	    return TCL_OK;
	}
	exp_error(interp,"no such slave");
	return TCL_ERROR;
    }

#ifdef XXX /* I'm not sure this is a good idea to support */
	} else {
	    exp_error(interp,"no such slave");
	    return TCL_ERROR;
	}
    }

    if (onexec_flag) {
	/* heck, don't even bother to check if fd is open or a real */
	/* spawn id, nothing else depends on it */
	fcntl(m,F_SETFD,close_onexec);
//	fcntl(esPtr->fdin,F_SETFD,close_onexec);
	return TCL_OK;
    }
#endif

    return exp_close(interp, f);
    return(exp_close(interp,esPtr));
}

/*ARGSUSED*/
static void
tcl_tracer(clientData,interp,level,command,cmdProc,cmdClientData,argc,argv)
    ClientData clientData;
    Tcl_Interp *interp;
    int level;
    char *command;
    Tcl_CmdProc *cmdProc;
    ClientData cmdClientData;
    int argc;
    char *argv[];
{
    int i;
    
    /* come out on stderr, by using errorlog */
    errorlog("%2d",level);
    for (i = 0;i<level;i++) exp_nferrorlog("  ",0/*ignored - satisfy lint*/);
    errorlog("%s\r\n",command);

    /* come out on stderr, by using expErrorLog */
    expErrorLog("%2d",level);
    for (i = 0;i<level;i++) expErrorLogU("  ");
    expErrorLogU(command);
    expErrorLogU("\r\n");
}

/*ARGSUSED*/
static int
Exp_StraceCmd(clientData, interp, argc, argv)
    ClientData clientData;
    Tcl_Interp *interp;




︙


2212
2213
2214
2215
2216
2217
2218
2219

2220
2221
2222
2223


2224
2225
2226



2227
2228

2229
2230
2231

2232
2233
2234
2235







2236
2237
2238
2239
2240




2241


2242
2243
































































































2244
2245
2246
2247
2248
2249
2250
2251
2252
2253


2254
2255
2256
2257
2258
2259

2260
2261


2262
2263
2264
2265
2266

2267
2268
2269
2270
2271




2272
2273
2274
2275
2276
2277
2278
2279
2280
2281

2282
2283
2284
2285
2286
2287
2288
2289
2290



2291
2292
2293
2294
2295


2296
2297
2298


2299
2300
2301
2302



2303
2304

2305
2306
2307
2308


2309
2310
2311
2312
2313
2314
2315




2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333



2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346

2347
2348


2349
2350
2351
2352
2353




2354
2355
2356
2357

2358
2359

2360
2361
2362
2363




2364
2365
2366
2367
2368
2369
2370
2371
2372
2373










2374
2375
2376
2377
2378






2379
2380
2381


2382
2383
2384
2385
2386
2387
2388
2389
2390

2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403








2404
2405
2406
2407
2408
2409



2410
2411

2412






































2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446































































































2447
2448
2449
2450
2451
2452
2453
2454
2455
2456










































2457

2458




2459
2460
2461
2462
2463


2464
2465
2466
2467
2468














2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480

























2481
2482
2483
2484
2485
2486

2487
2488




2489
2490
2491
2492
2493
2494




















2495
2496
2497
2498
2499
2500














2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514

2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525

2526
2527
2528
2529


2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544

2545
2546
2547
2548
2549
2550
2551
2552
2553
2554

2555
2556

2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582


2583

2584
2585

2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597

2598
2599
2600
2601
2602
2603
2604
2605


2606
2607


2608
2609
2610
2611
2612
2613




2614
2615
2616
2617

2618

2619
2620
2621
2622
2623
2624



2625


2626
2627

2628
2629











2630

2631
2632
2633
2634
2635
2636
2637
2638
2639
2640



2641
2642
2643
2644
2645
2646
2647






2648
2649
2650
2651
2652
2653
2654
2655


2656
2657
2658
2659
2660
2661
2662


2663
2664
2665


2666
2667
2668
2669





2670
2671
2672
2673
2674



2675
2676




2677
2678


2679
2680
2681
2682
2683
2684

2685
2686

2687
2688

2689
2690

2691
2692

2693
2694

2695
2696

2697
2698
2699
2700



2701
2702
2703
2704



2705
2706

2707
2708
2709


2710
2711
2712
2713
2714
2715
2716
2717
2718
2719









2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743

2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757
2758
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774

2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827

2828

1919
1920
1921
1922
1923
1924
1925

1926

1927
1928
1929
1930
1931
1932


1933
1934
1935


1936



1937




1938
1939
1940
1941
1942
1943
1944





1945
1946
1947
1948

1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056


2057
2058


2059



2060


2061
2062
2063




2064





2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077

2078
2079
2080


2081
2082



2083
2084
2085
2086




2087
2088
2089


2090
2091




2092
2093
2094


2095
2096



2097
2098

2099





2100
2101
2102
2103







2104
2105
2106
2107
2108
2109
2110




2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125

2126
2127
2128
2129
2130
2131




2132
2133
2134
2135

2136


2137

2138
2139




2140
2141
2142
2143

2144








2145
2146
2147
2148
2149
2150
2151
2152
2153
2154





2155
2156
2157
2158
2159
2160



2161
2162









2163













2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174



2175
2176
2177
2178

2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218


































2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313










2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357

2358
2359
2360
2361
2362
2363
2364


2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385












2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412

2413
2414

2415
2416
2417
2418
2419
2420
2421






2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441






2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468

2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479

2480
2481
2482


2483
2484
2485
2486
2487
2488
2489










2490








2491

2492
2493

2494

















2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505

2506
2507

2508

2509
2510
2511
2512
2513
2514
2515
2516
2517
2518

2519
2520
2521
2522
2523
2524
2525


2526
2527
2528

2529
2530
2531





2532
2533
2534
2535


2536
2537
2538

2539






2540
2541
2542

2543
2544
2545

2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559

2560
2561
2562
2563
2564
2565
2566
2567



2568
2569
2570
2571






2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584

2585
2586
2587
2588
2589

2590


2591
2592



2593
2594




2595
2596
2597
2598
2599
2600
2601



2602
2603
2604

2605
2606
2607
2608
2609


2610
2611
2612
2613
2614
2615
2616

2617
2618

2619
2620

2621


2622


2623


2624


2625




2626
2627
2628




2629
2630
2631


2632



2633
2634










2635
2636
2637
2638
2639
2640
2641
2642
2643














2644
2645
2646
2647
2648
2649
2650



2651































2652





















































2653
2654








-
+
-



+
+

-
-
+
+
+
-
-
+
-
-
-
+
-
-
-
-
+
+
+
+
+
+
+
-
-
-
-
-
+
+
+
+
-
+
+


+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








-
-
+
+
-
-

-
-
-
+
-
-
+
+

-
-
-
-
+
-
-
-
-
-
+
+
+
+









-
+


-
-


-
-
-
+
+
+

-
-
-
-
+
+

-
-
+
+
-
-
-
-
+
+
+
-
-
+

-
-
-
+
+
-

-
-
-
-
-
+
+
+
+
-
-
-
-
-
-
-







-
-
-
-
+
+
+












-
+


+
+

-
-
-
-
+
+
+
+
-

-
-
+
-

+
-
-
-
-
+
+
+
+
-

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
+
+
+
+
+
+
-
-
-
+
+
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+



-
-
-
+
+
+

-
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
-
+
+
+
+



-
-
+
+





+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-


-
+


+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+













-
+










-
+


-
-
+
+





-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-

-
+

-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-









+
+
-
+

-
+
-










-
+






-
-
+
+

-
+
+

-
-
-
-
-
+
+
+
+
-
-


+
-
+
-
-
-
-
-
-
+
+
+
-
+
+

-
+


+
+
+
+
+
+
+
+
+
+
+
-
+







-
-
-
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+







-
+
+



-

-
-
+
+
-
-
-
+
+
-
-
-
-
+
+
+
+
+


-
-
-
+
+
+
-

+
+
+
+
-
-
+
+





-
+

-
+

-
+
-
-
+
-
-
+
-
-
+
-
-
+
-
-
-
-
+
+
+
-
-
-
-
+
+
+
-
-
+
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-







-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+


    }
    /* tracing already in effect, undo it */
    if (trace_level > 0) Tcl_DeleteTrace(interp,trace_handle);

    /* get and save new trace level */
    trace_level = atoi(argv[1]);
    if (trace_level > 0)
	trace_handle = Tcl_CreateTrace(interp,
	trace_handle = Tcl_CreateTrace(interp, trace_level, tcl_tracer, NULL);
				       trace_level,tcl_tracer,(ClientData)0);
    return(TCL_OK);
}

/* following defn's are stolen from tclUnix.h */

/*
 *----------------------------------------------------------------------
 *
 * The type of the status returned by wait varies from UNIX system
 * to UNIX system.  The macro below defines it:
 */
 * Exp_WaitCmd --
 *

 *	Implements the 'wait' and 'exp_wait' commands.  When a process
 *	has been spawned, the wait call must be made before it will
 *	go away.
#if 0
 *
 * Results:
 *	A standard Tcl result
 *
#ifndef NO_UNION_WAIT
#   define WAIT_STATUS_TYPE union wait
#else
#   define WAIT_STATUS_TYPE int
#endif
#endif /* 0 */

 * Notes:
 *	XXX: This might need to go into the platform specific file.
 *	Need to make sure that we do the right thing when exp_open
 *	has been called on an identifier.
 *
/*
 * following definitions stolen from tclUnix.h
 * (should have been made public!)

 *----------------------------------------------------------------------
 * Supply definitions for macros to query wait status, if not already
 * defined in header files above.
 */

#if 0
#ifndef WIFEXITED
#   define WIFEXITED(stat)  (((*((int *) &(stat))) & 0xff) == 0)
#endif

#ifndef WEXITSTATUS
#   define WEXITSTATUS(stat) (((*((int *) &(stat))) >> 8) & 0xff)
#endif

#ifndef WIFSIGNALED
#   define WIFSIGNALED(stat) (((*((int *) &(stat)))) && ((*((int *) &(stat))) == ((*((int *) &(stat))) & 0x00ff)))
#endif

#ifndef WTERMSIG
#   define WTERMSIG(stat)    ((*((int *) &(stat))) & 0x7f)
#endif

#ifndef WIFSTOPPED
#   define WIFSTOPPED(stat)  (((*((int *) &(stat))) & 0xff) == 0177)
#endif

#ifndef WSTOPSIG
#   define WSTOPSIG(stat)    (((*((int *) &(stat))) >> 8) & 0xff)
#endif
#endif /* 0 */

/* end of stolen definitions */

/* Describe the processes created with Expect's fork.
This allows us to wait on them later.

This is maintained as a linked list.  As additional procs are forked,
new links are added.  As procs disappear, links are marked so that we
can reuse them later.
*/

struct forked_proc {
	int pid;
	WAIT_STATUS_TYPE wait_status;
	enum {not_in_use, wait_done, wait_not_done} link_status;
	struct forked_proc *next;
} *forked_proc_base = 0;

void
fork_clear_all()
{
	struct forked_proc *f;

	for (f=forked_proc_base;f;f=f->next) {
		f->link_status = not_in_use;
	}
}

void
fork_init(f,pid)
struct forked_proc *f;
int pid;
{
	f->pid = pid;
	f->link_status = wait_not_done;
}

/* make an entry for a new proc */
void
fork_add(pid)
int pid;
{
	struct forked_proc *f;

	for (f=forked_proc_base;f;f=f->next) {
		if (f->link_status == not_in_use) break;
	}

	/* add new entry to the front of the list */
	if (!f) {
		f = (struct forked_proc *)ckalloc(sizeof(struct forked_proc));
		f->next = forked_proc_base;
		forked_proc_base = f;
	}
	fork_init(f,pid);
}

/* Provide a last-chance guess for this if not defined already */
#ifndef WNOHANG
#define WNOHANG WNOHANG_BACKUP_VALUE
#endif

/* wait returns are a hodgepodge of things
 If wait fails, something seriously has gone wrong, for example:
   bogus arguments (i.e., incorrect, bogus spawn id)
   no children to wait on
   async event failed
 If wait succeeeds, something happened on a particular pid
   3rd arg is 0 if successfully reaped (if signal, additional fields supplied)
   3rd arg is -1 if unsuccessfully reaped (additional fields supplied)
*/
/*ARGSUSED*/
static int
Exp_WaitCmd(clientData, interp, argc, argv)
    ClientData clientData;
    Tcl_Interp *interp;
    int argc;
    char **argv;
{
    int master_supplied = FALSE;
    struct exp_f *f;	/* ditto */
    char *chanName = 0;
    struct ExpState *esPtr;
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    struct forked_proc *fp = 0;	/* handle to a pure forked proc */
    
#ifdef XXX
    struct exp_f ftmp;	/* temporary memory for either f or fp */
    struct ExpState esTmp;	/* temporary memory for either f or fp */
#endif
    
    char spawn_id[20];

    int nowait = FALSE;
    int nohang = FALSE;
    char *chanId = NULL;
    char *argv0 = argv[0];
    Tcl_Pid result = 0;		/* 0 means child was successfully waited on */
    int result = 0;		/* 0 means child was successfully waited on */

    /* -1 means an error occurred */
    /* -2 means no eligible children to wait on */
#define NO_CHILD ((Tcl_Pid) -2)
    
				/* -1 means an error occurred */
				/* -2 means no eligible children to wait on */
#define NO_CHILD -2

    argv++;
    argc--;
    for (;argc>0;argc--,argv++) {
	if (streq(*argv,"-i")) {
	    argc--; argv++;
	    if (argc==0) {
		exp_error(interp,"usage: -i spawn_id");
		return(TCL_ERROR);
	    }
	    chanId = *argv;
	    chanName = *argv;
	} else if (streq(*argv,"-nowait")) {
	    nowait = TRUE;
	} else if (streq(*argv,"-nohang")) {
	    nohang = TRUE;
	}
    }
    
    if (chanId == NULL) {
	f = exp_update_master(interp, 0, 0);

    if (!chanName) {
	if (!(esPtr = expStateCurrent(interp,0,0,1))) return TCL_ERROR;
    } else {
	f = exp_chan2f(interp, chanId, 0, 0, argv0);
    }
    if (f == NULL) {
	return TCL_ERROR;
	if (!(esPtr = expStateFromChannelName(interp,chanName,0,0,1,"wait")))
	    return TCL_ERROR;
    }
    
    if (f != exp_f_any) {

    if (!expStateAnyIs(esPtr)) {
	/*
	 * Check if waited on already.  Things opened by "open", set
	 * with -nowait, or are special expect ids are marked sys_waited
	 * already
	/* check if waited on already */
	/* things opened by "open" or set with -nowait */
	/* are marked sys_waited already */
	 */
	if (!f->sys_waited) {
	if (!esPtr->sys_waited) {
	    if (nowait) {
		/*
		 * should probably generate an error
		 * if SIGCHLD is trapped.
		/* should probably generate an error */
		/* if SIGCHLD is trapped. */
		 */

		/*
		 * pass to Tcl, so it can do wait in background.
		 */
		Tcl_DetachPids(1,&f->tclPid);
		exp_wait_zero(&f->wait);
		/* pass to Tcl, so it can do wait */
		/* in background */
		Tcl_DetachPids(1,(Tcl_Pid *)&esPtr->pid);
		exp_wait_zero(&esPtr->wait);
		f->sys_waited = 1;
		f->user_waited = 1;

	    } else if (nohang) {
		exp_wait_zero(&f->wait);
		result = Tcl_WaitPid(f->tclPid,&f->wait,WNOHANG);

	    } else {
		while (1) {
		    if (Tcl_AsyncReady()) {
			int rc = Tcl_AsyncInvoke(interp,TCL_OK);
			if (rc != TCL_OK) return(rc);
		    }

		    exp_wait_zero(&f->wait);
		    result = Tcl_WaitPid(f->tclPid,&f->wait,0);
		    if (result == f->tclPid) break;
		    if (result == (Tcl_Pid) -1) {
		    result = waitpid(esPtr->pid,&esPtr->wait,0);
		    if (result == esPtr->pid) break;
		    if (result == -1) {
			if (errno == EINTR) continue;
			else break;
		    }
		}
	    }
	}

	/*
	 * Now have Tcl reap anything we just detached. 
	 * This also allows procs user has created with "exec &"
	 * and and associated with an "exec &" process to be reaped.
	 */

	
	Tcl_ReapDetachedProcs();
	exp_rearm_sigchld(interp); /* new */

	strcpy(spawn_id,esPtr->name);
    } else {
	/*
	 * Wait for any of our own spawned processes. We call waitpid
	 * rather than wait to avoid running into someone else's processes.
	 * Yes, according to Ousterhout this is the best way to do it.
	/* wait for any of our own spawned processes */
	/* we call waitpid rather than wait to avoid running into */
	/* someone else's processes.  Yes, according to Ousterhout */
	/* this is the best way to do it. */
	 */

	hPtr = Tcl_FirstHashEntry(exp_f_table, &search);
	while (hPtr) {
	int waited_on_forked_process = 0;
	    f = (struct exp_f *) Tcl_GetHashValue(hPtr);

	esPtr = expWaitOnAny();
	    if (!f->valid) continue;
	    if (f->pid == EXP_NOPID) continue;
	    if (f->pid == exp_getpid) continue; /* skip ourself */
	    if (f->user_waited) continue; /* one wait only! */
	if (!esPtr) {
	    /* if it's not a spawned process, maybe its a forked process */
	    for (fp=forked_proc_base;fp;fp=fp->next) {
		if (fp->link_status == not_in_use) continue;
	    if (f->sys_waited) break;
	restart:
	    exp_wait_zero(&f->wait);
	    result = Tcl_WaitPid(f->tclPid,&f->wait,WNOHANG);
	    if (result == f->tclPid) break;
	    if (result == 0) continue; /* busy, try next */
	    if (result == (Tcl_Pid) -1) {
		if (errno == EINTR) goto restart;
		else break;
	    }
		result = waitpid(fp->pid,&fp->wait_status,WNOHANG);
		if (result == fp->pid) {
		    waited_on_forked_process = 1;
		    break;
		}
		if (result == 0) continue;	/* busy, try next */
		if (result == -1) {
		    if (errno == EINTR) goto restart;
		    else break;
		}
	    hPtr = Tcl_NextHashEntry(&search);
	}
	
#ifdef XXX
	/* if it's not a spawned process, maybe its a forked process */
	    }

	    if (waited_on_forked_process) {
		/*
		 * The literal spawn id in the return value from wait appears
		 * as a -1 to indicate a forked process was waited on.  
	for (fp=forked_proc_base;fp;fp=fp->next) {
	    if (fp->link_status == not_in_use) continue;
	restart2:
		 */
		strcpy(spawn_id,"-1");
	    result = waitpid(fp->pid,&fp->wait_status,WNOHANG);
	    if (result == fp->pid) {
		m = -1;		/* DOCUMENT THIS! */
		break;
	    }
	    if (result == 0) continue; /* busy, try next */
	    if (result == -1) {
		if (errno == EINTR) goto restart2;
		else break;
	    } else {
	    }
	}
#endif /* XXX */
	
	if (hPtr == NULL && fp == NULL) {
	    result = NO_CHILD;	/* no children */
	    Tcl_ReapDetachedProcs();
	}
	exp_rearm_sigchld(interp);
    }
    
#ifdef XXX
    /*  sigh, wedge forked_proc into an exp_f structure so we don't
		result = NO_CHILD;	/* no children */
		Tcl_ReapDetachedProcs();
	    }
	    exp_rearm_sigchld(interp);
	}
    }

    /*  sigh, wedge forked_proc into an ExpState structure so we don't
     *  have to rewrite remaining code (too much)
     */
    if (fp) {
	f = &ftmp;
	f->tclPid = fp->pid;
	f->wait = fp->wait_status;
	esPtr = &esTmp;
	esPtr->pid = fp->pid;
	esPtr->wait = fp->wait_status;
    }
#endif

    /* non-portable assumption that pid_t can be printed with %d */

    if (result == -1) {
	sprintf(interp->result,"%d %s -1 %d POSIX %s %s",
		esPtr->pid,spawn_id,errno,Tcl_ErrnoId(),Tcl_ErrnoMsg(errno));
	result = TCL_OK;
    } else if (result == NO_CHILD) {
	exp_error(interp,"no children");
	return TCL_ERROR;
    } else {
	sprintf(interp->result,"%d %s 0 %d",
		esPtr->pid,spawn_id,WEXITSTATUS(esPtr->wait));
	if (WIFSIGNALED(esPtr->wait)) {
	    Tcl_AppendElement(interp,"CHILDKILLED");
	    Tcl_AppendElement(interp,Tcl_SignalId((int)(WTERMSIG(esPtr->wait))));
	    Tcl_AppendElement(interp,Tcl_SignalMsg((int) (WTERMSIG(esPtr->wait))));
	} else if (WIFSTOPPED(esPtr->wait)) {
	    Tcl_AppendElement(interp,"CHILDSUSP");
	    Tcl_AppendElement(interp,Tcl_SignalId((int) (WSTOPSIG(esPtr->wait))));
	    Tcl_AppendElement(interp,Tcl_SignalMsg((int) (WSTOPSIG(esPtr->wait))));
	}
    }
			
    if (fp) {
	fp->link_status = not_in_use;
	return ((result == -1)?TCL_ERROR:TCL_OK);		
    }

    esPtr->sys_waited = TRUE;
    esPtr->user_waited = TRUE;

    /* if user has already called close, forget about this entry entirely */
    if (!esPtr->open) {
      if (esPtr->registered) {
	Tcl_UnregisterChannel(interp,esPtr->channel);
      }
    }

    return ((result == -1)?TCL_ERROR:TCL_OK);

    if (result == (Tcl_Pid) -1) {
	sprintf(interp->result,"%d %s -1 %d POSIX %s %s",
		f->pid,f->spawnId,errno,Tcl_ErrnoId(),Tcl_ErrnoMsg(errno));
	result = TCL_OK;
	f->sys_waited = TRUE;
	f->user_waited = TRUE;
    } else if (result == NO_CHILD) {
	interp->result = "no children";
	return TCL_ERROR;
    } else {
	sprintf(interp->result,"%d %s 0 %d",
		f->pid,f->spawnId,WEXITSTATUS(f->wait));
	if (WIFSIGNALED(f->wait)) {
	    Tcl_AppendElement(interp,"CHILDKILLED");
	    Tcl_AppendElement(interp,Tcl_SignalId((int)(WTERMSIG(f->wait))));
	    Tcl_AppendElement(interp,Tcl_SignalMsg((int) (WTERMSIG(f->wait))));
	} else if (WIFSTOPPED(f->wait)) {
	    Tcl_AppendElement(interp,"CHILDSUSP");
	    Tcl_AppendElement(interp,Tcl_SignalId((int) (WSTOPSIG(f->wait))));
	    Tcl_AppendElement(interp,Tcl_SignalMsg((int) (WSTOPSIG(f->wait))));
	}
	if (nohang && result == 0) {
	    Tcl_AppendElement(interp,"NOEXIT");
	}
	if (result > 0 && WIFEXITED(f->wait)) {
	    f->sys_waited = TRUE;
	    f->user_waited = TRUE;
	}
    }

#ifdef XXX
    if (fp) {
	fp->link_status = not_in_use;
}

/*ARGSUSED*/
static int
Exp_ForkCmd(clientData, interp, argc, argv)
    ClientData clientData;
    Tcl_Interp *interp;
    int argc;
    char **argv;
{
	int rc;
	if (argc > 1) {
		exp_error(interp,"usage: fork");
		return(TCL_ERROR);
	}

//	rc = fork();
	if (rc == -1) {
		exp_error(interp,"fork: %s",Tcl_PosixError(interp));
		return TCL_ERROR;
	} else if (rc == 0) {
		/* child */
		exp_forked = TRUE;
		exp_getpid = getpid();
		fork_clear_all();
	} else {
		/* parent */
		fork_add(rc);
	}

	/* both child and parent follow remainder of code */
	sprintf(interp->result,"%d",rc);
	expDiagLog("fork: returns {%s}\r\n",interp->result);
	return(TCL_OK);
}

/*ARGSUSED*/
static int
Exp_DisconnectCmd(clientData, interp, argc, argv)
    ClientData clientData;
    Tcl_Interp *interp;
    int argc;
    char **argv;
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    

    /* tell CenterLine to ignore non-use of ttyfd */
    /*SUPPRESS 591*/
    int ttyfd;

    if (argc > 1) {
	exp_error(interp,"usage: disconnect");
	return(TCL_ERROR);
    }

    if (exp_disconnected) {
	exp_error(interp,"already disconnected");
	return(TCL_ERROR);
    }
    if (!exp_forked) {
	exp_error(interp,"can only disconnect child process");
	return(TCL_ERROR);
    }
    exp_disconnected = TRUE;

    /* ignore hangup signals generated by testing ptys in getptymaster */
    /* and other places */
//    signal(SIGHUP,SIG_IGN);

    /* reopen prevents confusion between send/expect_user */
    /* accidentally mapping to a real spawned process after a disconnect */

    /* if we're in a child that's about to be disconnected from the
       controlling tty, close and reopen 0, 1, and 2 but associated
       with /dev/null.  This prevents send and expect_user doing
       special things if newly spawned processes accidentally
       get allocated 0, 1, and 2.
    */
	   
    if (isatty(0)) {
	ExpState *stdinout = tsdPtr->stdinout;
	if (stdinout->valid) {
	    exp_close(interp,stdinout);
	    if (stdinout->registered) {
		Tcl_UnregisterChannel(interp,stdinout->channel);
	    }
	}
	open("/dev/null",0);
	open("/dev/null",1);
	/* tsdPtr->stdinout = expCreateChannel(interp,0,1,EXP_NOPID);*/
	/* tsdPtr->stdinout->keepForever = 1;*/
	}
    if (isatty(2)) {
	ExpState *devtty = tsdPtr->devtty;
	return ((result == -1)?TCL_ERROR:TCL_OK);		
    }
#endif
    
    /*
     * if user has already called close, make sure fd really is closed
     * and forget about this entry entirely
     */
    if (f->user_closed) {
	exp_f_free(f);
	
	/* reopen stderr saves error checking in error/log routines. */
	if (devtty->valid) {
	    exp_close(interp,devtty);
	    if (devtty->registered) {
		Tcl_UnregisterChannel(interp,devtty->channel);
	    }
	}
	open("/dev/null",1);
	/* tsdPtr->devtty = expCreateChannel(interp,2,2,EXP_NOPID);*/
	/* tsdPtr->devtty->keepForever = 1;*/
    }

    Tcl_UnsetVar(interp,"tty_spawn_id",TCL_GLOBAL_ONLY);

#ifdef DO_SETSID
    setsid();
#else
#ifdef SYSV3
    /* put process in our own pgrp, and lose controlling terminal */
#ifdef sysV88
    /* With setpgrp first, child ends up with closed stdio */
    /* according to Dave Schmitt <[email protected]> */
    if (fork()) exit(0);
    expSetpgrp();
#else
    expSetpgrp();
    /*signal(SIGHUP,SIG_IGN); moved out to above */
    if (fork()) exit(0);	/* first child exits (as per Stevens, */
    /* UNIX Network Programming, p. 79-80) */
    /* second child process continues as daemon */
#endif
#else /* !SYSV3 */
    expSetpgrp();

/* Pyramid lacks this defn */
#ifdef TIOCNOTTY
    ttyfd = open("/dev/tty", O_RDWR);
    if (ttyfd >= 0) {
	/* zap controlling terminal if we had one */
	(void) ioctl(ttyfd, TIOCNOTTY, (char *)0);
	(void) close(ttyfd);
    }
#endif /* TIOCNOTTY */
    return ((result == (Tcl_Pid) -1)?TCL_ERROR:TCL_OK);

#endif /* SYSV3 */
#endif /* DO_SETSID */
    return(TCL_OK);
}

/*ARGSUSED*/
int
Exp_InterpreterCmd(clientData, interp, argc, argv)
static int
Exp_OverlayCmd(clientData, interp, argc, argv)
    ClientData clientData;
    Tcl_Interp *interp;
    int argc;
    char **argv;
{
    int newfd, oldfd;
    int dash_name = 0;
    char *command;

    argc--; argv++;
    while (argc) {
	if (*argv[0] != '-') break;	/* not a flag */
	if (streq(*argv,"-")) {		/* - by itself */
	    argc--; argv++;
	    dash_name = 1;
	    continue;
	}
	newfd = atoi(argv[0]+1);
	argc--; argv++;
    if (argc != 1) {
	exp_error(interp,"no arguments allowed");
	return(TCL_ERROR);
    }
    
#ifdef __WIN32__
    exp_error(interp, "not implemented on Windows NT");
    return TCL_ERROR;
#endif
    return(exp_interpreter(interp));
    /* errors and ok, are caught by exp_interpreter() and discarded */
    /* to return TCL_OK, type "return" */
	if (argc == 0) {
	    exp_error(interp,"overlay -# requires additional argument");
	    return(TCL_ERROR);
	}
	oldfd = atoi(argv[0]);
	argc--; argv++;
	expDiagLog("overlay: mapping fd %d to %d\r\n",oldfd,newfd);
	if (oldfd != newfd) (void) dup2(oldfd,newfd);
	else expDiagLog("warning: overlay: old fd == new fd (%d)\r\n",oldfd);
    }
    if (argc == 0) {
	exp_error(interp,"need program name");
	return(TCL_ERROR);
    }
    command = argv[0];
    if (dash_name) {
	argv[0] = ckalloc(1+strlen(command));
	sprintf(argv[0],"-%s",command);
    }

    signal(SIGINT, SIG_DFL);
//	signal(SIGQUIT, SIG_DFL);
    execvp(command,argv);
    exp_error(interp,"execvp(%s): %s\r\n",argv[0],Tcl_PosixError(interp));
    return(TCL_ERROR);
}

/* this command supercede's Tcl's builtin CONTINUE command */
/*ARGSUSED*/
int
Exp_ExpContinueDeprecatedCmd(clientData, interp, argc, argv)
Exp_InterpreterObjCmd(clientData, interp, objc, objv)
    ClientData clientData;
    Tcl_Interp *interp;
    int objc;
    Tcl_Obj *CONST objv[];		/* Argument objects. */
{
    Tcl_Obj *eofObj = 0;
    int argc;
    char **argv;
{
    if (argc == 1) return(TCL_CONTINUE);
    else if (argc == 2) {
	if (streq(argv[1],"-expect")) {
    int i;
    int index;
    int rc;

    static char *options[] = {
	"-eof", (char *)0
    };
    enum options {
	FLAG_EOF
    };

    for (i = 1; i < objc; i++) {
	if (Tcl_GetIndexFromObj(interp, objv[i], options, "flag", 0,
				&index) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch ((enum options) index) {
	case FLAG_EOF:
	    i++;
	    if (i >= objc) {
	    debuglog("continue -expect is deprecated, use exp_continue\r\n");
	    return(EXP_CONTINUE);
	}
    }
    exp_error(interp,"usage: continue [-expect]\n");
    return(TCL_ERROR);
		Tcl_WrongNumArgs(interp, 1, objv,"-eof cmd");
		return TCL_ERROR;
	    }
	    eofObj = objv[i];
	    Tcl_IncrRefCount(eofObj);
	    break;
	}
    }

    /* errors and ok, are caught by exp_interpreter() and discarded */
    /* to return TCL_OK, type "return" */
    rc = exp_interpreter(interp,eofObj);
    if (eofObj) Tcl_DecrRefCount(eofObj);
    return rc;
}

/* this command supercede's Tcl's builtin CONTINUE command */
/*ARGSUSED*/
int
Exp_ExpContinueCmd(clientData, interp, argc, argv)
    ClientData clientData;
    Tcl_Interp *interp;
    int argc;
    char **argv;
{
    if (argc == 1) {
	return EXP_CONTINUE;
    } else if ((argc == 2) && (streq(argv[1],"-continue_timer"))) {
    } else if ((argc == 2) && (0 == strcmp(argv[1],"-continue_timer"))) {
	return EXP_CONTINUE_TIMER;
    }

    exp_error(interp,"usage: exp_continue [-continue_timer]\n");
    return(TCL_ERROR);
}

/* most of this is directly from Tcl's definition for return */
/*ARGSUSED*/
int
Exp_InterReturnCmd(clientData, interp, argc, argv)
Exp_InterReturnObjCmd(clientData, interp, objc, objv)
    ClientData clientData;
    Tcl_Interp *interp;
    int argc;
    char **argv;
    int objc;
    Tcl_Obj *CONST objv[];
{
    /* let Tcl's return command worry about args */
    /* if successful (i.e., TCL_RETURN is returned) */
    /* modify the result, so that we will handle it specially */

    int result;
#if TCL_MAJOR_VERSION >= 8
    Tcl_Obj **objv;
    int i;

    objv = (Tcl_Obj **) ckalloc(argc*sizeof(Tcl_Obj *));
    for (i = 0; i < argc; i++) {
	objv[i] = Tcl_NewStringObj(argv[i], -1);
    }
    result = Tcl_ReturnObjCmd(clientData,interp,argc,objv);
    int result = Tcl_ReturnObjCmd(clientData,interp,objc,objv);
    for (i = 0; i < argc; i++) {
	Tcl_DecrRefCount(objv[i]);
    }
    ckfree((char *) objv);
#else
    result = Tcl_ReturnCmd(clientData,interp,argc,argv);
#endif

    if (result == TCL_RETURN)
	result = EXP_TCL_RETURN;
        result = EXP_TCL_RETURN;
    return result;

}
}

/*
 *----------------------------------------------------------------------
 *
 * Exp_OpenCmd --
 *
 *	Implements the exp_open command.  Makes a spawn id available
 *	to Tcl.  Since this happens by default, we don't have to do
 *	anything in the -leaveopen case.  In the normal case, we
 *	need to clean up the spawn identifier and that is all.
 *
 * Results:
 *	A standard Tcl result
 *
 *----------------------------------------------------------------------
 */

/*ARGSUSED*/
int
Exp_OpenCmd(clientData, interp, argc, argv)
    ClientData clientData;
    Tcl_Interp *interp;
    int argc;
    char **argv;
{
    ExpState *esPtr;
    char *chanName = 0;
    struct exp_f *f;
    int newfd;
    int leaveopen = FALSE;
    char *chanId = NULL;
    Tcl_Channel channel;
    char *argv0 = argv[0];

    argc--; argv++;

    for (;argc>0;argc--,argv++) {
	if (streq(*argv,"-i")) {
	    argc--; argv++;
	    if (!*argv) {
		exp_error(interp,"usage: -i spawn_id");
		return TCL_ERROR;
	    }
	    chanId = *argv;
	    chanName = *argv;
	} else if (streq(*argv,"-leaveopen")) {
	    leaveopen = TRUE;
	    argc--; argv++;
	} else break;
    }

    if (chanId == NULL) {
	f = exp_update_master(interp,0,0);
    if (!chanName) {
	if (!(esPtr = expStateCurrent(interp,1,0,0))) return TCL_ERROR;
    } else {
	f = exp_chan2f(interp, chanId, 1, 0, argv0);
	if (!(esPtr = expStateFromChannelName(interp,chanName,1,0,0,"exp_open")))
	    return TCL_ERROR;
    }
    if (f == NULL) {
	return(TCL_ERROR);
    }
    if (f->channel == NULL) {
	exp_error(interp,

    /* make a new copy of file descriptor */
    if (-1 == (newfd = dup(esPtr->fdin))) {
	exp_error(interp,"dup: %s",Tcl_PosixError(interp));
		  "%s: %s is an internal spawn id that cannot be expected as a channel id",
		  argv0, chanId);
	return TCL_ERROR;
    }

    if (! leaveopen) {
    if (!leaveopen) {
	/*
	 * Don't do any reference count check on f->leaveopen.  Just force
	 * the spawn id closed
	 */
	if (f->channel) {
	    Tcl_DeleteCloseHandler(f->channel, (Tcl_CloseProc *) exp_f_free,
	/* remove from Expect's memory in anticipation of passing to Tcl */
	if (esPtr->pid != EXP_NOPID) {
	    Tcl_DetachPids(1,(Tcl_Pid *)&esPtr->pid);
				   (ClientData) f);
	    esPtr->pid = EXP_NOPID;
	    esPtr->sys_waited = esPtr->user_waited = TRUE;
	}
	exp_f_free(f);
	exp_close(interp,esPtr);
    }

    /*
     * Tcl's MakeFileChannel only allows us to pass a single file descriptor
     * but that shouldn't be a problem in practice since all of the channels
     * that Expect generates only have one fd.  Of course, this code won't
     * work if someone creates a pipeline, then passes it to spawn, and then
     * again to exp_open.  For that to work, Tcl would need a new API.
     * Oh, and we're also being rather cavalier with the permissions here,
     * but they're likely to be right for the same reasons.
     */
    channel = Tcl_MakeFileChannel((ClientData)newfd,TCL_READABLE|TCL_WRITABLE);
    Tcl_RegisterChannel(interp, channel);
    Tcl_AppendResult(interp, Tcl_GetChannelName(f->channel), (char *) NULL);
    Tcl_AppendResult(interp, Tcl_GetChannelName(channel), (char *) NULL);
    return TCL_OK;
}

/* return 1 if a string is substring of a flag */
/* this version is the code used by the macro that everyone calls */
int
exp_flageq_code(flag,string,minlen)
char *flag;
char *string;
int minlen;		/* at least this many chars must match */
    char *flag;
    char *string;
    int minlen;		/* at least this many chars must match */
{
	for (;*flag;flag++,string++,minlen--) {
		if (*string == '\0') break;
		if (*string != *flag) return 0;
	}
	if (*string == '\0' && minlen <= 0) return 1;
	return 0;
    for (;*flag;flag++,string++,minlen--) {
	if (*string == '\0') break;
	if (*string != *flag) return 0;
    }
    if (*string == '\0' && minlen <= 0) return 1;
    return 0;
}

void
exp_create_commands(interp,c)
    Tcl_Interp *interp;
    struct exp_cmd_data *c;
{
    Interp *iPtr = (Interp *) interp;
    Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp);
    Namespace *currNsPtr   = (Namespace *) Tcl_GetCurrentNamespace(interp);
    char cmdnamebuf[80];

    for (;c->name;c++) {
	int create = FALSE;
	/* if already defined, don't redefine */
	if (c->flags & EXP_REDEFINE) create = TRUE;
	else if (!Tcl_FindHashEntry(&iPtr->globalNsPtr->cmdTable,c->name)) {
	if ((c->flags & EXP_REDEFINE) ||
		!(Tcl_FindHashEntry(&globalNsPtr->cmdTable,c->name) ||
	    create = TRUE;
	}
	if (create) {
		Tcl_FindHashEntry(&currNsPtr->cmdTable,c->name))) {
	    if (c->objproc)
	    sprintf(cmdnamebuf, "rename %s exp_tcl_%s", c->name, c->name);
	    Tcl_GlobalEval(interp, cmdnamebuf);
	    Tcl_CreateCommand(interp,c->name,c->proc,
			      c->data, (Tcl_CmdDeleteProc *) NULL);
		Tcl_CreateObjCommand(interp,c->name,
			c->objproc,c->data,exp_deleteObjProc);
	    else
		Tcl_CreateCommand(interp,c->name,c->proc,
			c->data,exp_deleteProc);
	}
	if (!(c->name[0] == 'e' &&
	      c->name[1] == 'x' &&
	      c->name[2] == 'p')
	    && !(c->flags & EXP_NOPREFIX))
		c->name[1] == 'x' &&
		c->name[2] == 'p')
		&& !(c->flags & EXP_NOPREFIX)) {
	{
	    sprintf(cmdnamebuf,"exp_%s",c->name);
	    if (c->objproc)
		Tcl_CreateObjCommand(interp,cmdnamebuf,c->objproc,c->data,
			exp_deleteObjProc);
	    else
	    Tcl_CreateCommand(interp,cmdnamebuf,c->proc,
			      c->data, (Tcl_CmdDeleteProc *) NULL);
		Tcl_CreateCommand(interp,cmdnamebuf,c->proc,
			c->data,exp_deleteProc);
	}
    }
}

static struct exp_cmd_data cmd_data[]  = {
{"close",	Exp_CloseCmd,	0,	EXP_REDEFINE},
    {"close",	Exp_CloseObjCmd,	0,	0,	EXP_REDEFINE},
#ifdef TCL_DEBUGGER
{"debug",	Exp_DebugCmd,	0,	0},
    {"debug",	exp_proc(Exp_DebugCmd),	0,	0},
#endif
{"exp_internal",Exp_ExpInternalCmd,	0,	0},
    {"exp_internal",exp_proc(Exp_ExpInternalCmd),	0,	0},
#ifdef XXX
{"disconnect",	Exp_DisconnectCmd,	0,	0},
    {"disconnect",	exp_proc(Exp_DisconnectCmd),	0,	0},
#endif
{"exit",	Exp_ExitCmd,	0,	EXP_REDEFINE},
    {"exit",	exp_proc(Exp_ExitCmd),	0,	EXP_REDEFINE},
{"continue",	Exp_ExpContinueDeprecatedCmd,0,EXP_NOPREFIX|EXP_REDEFINE},
{"exp_continue",Exp_ExpContinueCmd,0,	0},
    {"exp_continue",exp_proc(Exp_ExpContinueCmd),0,	0},
#ifdef XXX
{"fork",	Exp_ForkCmd,	0,	0},
    {"fork",	exp_proc(Exp_ForkCmd),	0,	0},
#endif
{"exp_pid",	Exp_ExpPidCmd,	0,	0},
{"getpid",	Exp_GetpidDeprecatedCmd,0,	0},
{"interpreter",	Exp_InterpreterCmd,	0,	0},
    {"exp_pid",	exp_proc(Exp_ExpPidCmd),	0,	0},
    {"getpid",	exp_proc(Exp_GetpidDeprecatedCmd),0,	0},
    {"interpreter",	Exp_InterpreterObjCmd,	0,	0,	0},
{"kill",	Exp_KillCmd,	0,	0},
{"log_file",	Exp_LogFileCmd,	0,	0},
{"log_user",	Exp_LogUserCmd,	0,	0},
{"exp_open",	Exp_OpenCmd,	0,	0},
    {"log_file",	exp_proc(Exp_LogFileCmd),	0,	0},
    {"log_user",	exp_proc(Exp_LogUserCmd),	0,	0},
    {"exp_open",	exp_proc(Exp_OpenCmd),	0,	0},
#ifdef XXX
{"overlay",	Exp_OverlayCmd,	0,	0},
    {"overlay",	exp_proc(Exp_OverlayCmd),	0,	0},
#endif
{"inter_return",Exp_InterReturnCmd,	0,	0},
{"send",	Exp_SendCmd,	(ClientData)NULL,	0},
    {"inter_return",Exp_InterReturnObjCmd,	0,	0,	0},
    {"send",	Exp_SendObjCmd,		0,	(ClientData)&sendCD_proc,0},
{"send_spawn",	Exp_SendCmd,	(ClientData)NULL,	0},/*deprecat*/
{"send_error",	Exp_SendCmd,	(ClientData)"stderr",	0},
{"send_log",	Exp_SendLogCmd,	0,	0},
{"send_tty",	Exp_SendCmd,	(ClientData)"exp_tty",	0},
{"send_user",	Exp_SendCmd,	(ClientData)"exp_user",	0},
{"sleep",	Exp_SleepCmd,	0,	0},
{"spawn",	Exp_SpawnCmd,	0,	0},
{"strace",	Exp_StraceCmd,	0,	0},
{"wait",	Exp_WaitCmd,	0,	0},
{0}};
    {"send_error",	Exp_SendObjCmd,		0,	(ClientData)&sendCD_error,0},
    {"send_log",	exp_proc(Exp_SendLogCmd),	0,	0},
    {"send_tty",	Exp_SendObjCmd,		0,	(ClientData)&sendCD_tty,0},
    {"send_user",	Exp_SendObjCmd,		0,	(ClientData)&sendCD_user,0},
    {"sleep",	exp_proc(Exp_SleepCmd),	0,	0},
    {"spawn",	exp_proc(Exp_SpawnCmd),	0,	0},
    {"strace",	exp_proc(Exp_StraceCmd),	0,	0},
    {"wait",	exp_proc(Exp_WaitCmd),	0,	0},
    {0}};

/*
 *----------------------------------------------------------------------
 *
 * exp_init_most_cmds --
 *
 *	Initialize the large majority of commands that are used
 *	in expect
 *
 * Results:
 *	None
 *
 *----------------------------------------------------------------------
 */

void
exp_init_most_cmds(interp)
    Tcl_Interp *interp;
{
    exp_create_commands(interp,cmd_data);

    exp_close_in_child = exp_close_tcl_files;
}

#ifdef HAVE_PTYTRAP
void
exp_init_spawn_id_vars(interp)
    Tcl_Interp *interp;
{
    Tcl_SetVar(interp,"user_spawn_id",EXP_SPAWN_ID_USER,0);
    Tcl_SetVar(interp,"error_spawn_id",EXP_SPAWN_ID_ERROR,0);
    Tcl_SetVar(interp,"tty_spawn_id","exp_tty",0);
}

/*
 *----------------------------------------------------------------------
 *
 * exp_init_spawn_ids --
 *
 *	Create the structures for the standard spawn ids.
 *
 * Results:
 *	None
 *
 *----------------------------------------------------------------------
 */

void
exp_init_spawn_ids(interp)
    Tcl_Interp *interp;
{
    Tcl_Channel chan, chanIn, chanOut;
    struct exp_f *f;

    exp_f_table = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
    Tcl_InitHashTable(exp_f_table, TCL_STRING_KEYS);
    Tcl_InitHashTable(&slaveNames,TCL_STRING_KEYS);

    chan = ExpCreatePairChannel(interp, "stdin", "stdout", "exp_user");
    f = exp_f_new(interp, chan, NULL, EXP_NOPID);
    Tcl_RegisterChannel(interp, chan);

    chan = Tcl_GetStdChannel(TCL_STDIN);
    f = exp_f_new(interp, chan, NULL,
		  (isatty(0) ? exp_getpid : EXP_NOPID));
    f->leaveopen = 1;
    if (strcmp(Tcl_GetChannelName(chan), "stdin") != 0) {
	f = exp_f_new(interp, chan, "stdin",
		      (isatty(0) ? exp_getpid : EXP_NOPID));
	f->leaveopen = 1;
    }
    chanIn = chan;

    chan = Tcl_GetStdChannel(TCL_STDOUT);
    if (chan != chanIn) {
	f = exp_f_new(interp, chan, NULL,
		      (isatty(1) ? exp_getpid : EXP_NOPID));
	f->leaveopen = 1;
    }
    if (strcmp(Tcl_GetChannelName(chan), "stdout") != 0) {
	f = exp_f_new(interp, chan, "stdout",
		      (isatty(1) ? exp_getpid : EXP_NOPID));
	f->leaveopen = 1;
    }
    chanOut = chan;

    chan = Tcl_GetStdChannel(TCL_STDERR);
    if ((chan != chanIn) && (chan != chanOut)) {
	f = exp_f_new(interp, chan, NULL,
		      (isatty(2) ? exp_getpid : EXP_NOPID));
	f->leaveopen = 1;
    }
    if (strcmp(Tcl_GetChannelName(chan), "stderr") != 0) {
	f = exp_f_new(interp, chan, "stderr",
		      (isatty(2) ? exp_getpid : EXP_NOPID));
	f->leaveopen = 1;
    }

    /*
     * Create the 'exp_any' spawn id that is meant to many any spawn ids.
     */

    f = exp_f_new(interp, NULL, "exp_any", exp_getpid);
    f->alwaysopen = 1;
    exp_f_any = f;

#ifdef XXX
    /* really should be in interpreter() but silly to do on every call */
    exp_adjust(&exp_fs[0]);
#endif
#endif /* HAVE_PTYTRAP */
}






Added generic/expDecls.h.













































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/*
 * expDecls.h --
 *
 *	Declarations of functions in the platform independent public
 *	Expect API.
 *
 * RCS: $Id: expDecls.h,v 1.1.2.2 2001/10/28 08:56:51 davygrvy Exp $
 */

#ifndef _EXPDECLS
#define _EXPDECLS

/*
 * WARNING: This file is automatically generated by the $(TCLROOT)/tools/genStubs.tcl
 * script.  Any modifications to the function declarations below should be made
 * in the generic/exp.decls script.
 */

/* !BEGIN!: Do not edit below this line. */

/*
 * Exported function declarations:
 */

/* 0 */
EXTERN int		Expect_Init _ANSI_ARGS_((Tcl_Interp * interp));
/* 1 */
EXTERN int		Expect_SafeInit _ANSI_ARGS_((Tcl_Interp * interp));

typedef struct ExpStubHooks {
    struct ExpPlatStubs *expPlatStubs;
    struct ExpIntStubs *expIntStubs;
    struct ExpIntPlatStubs *expIntPlatStubs;
} ExpStubHooks;

typedef struct ExpStubs {
    int magic;
    struct ExpStubHooks *hooks;

    int (*expect_Init) _ANSI_ARGS_((Tcl_Interp * interp)); /* 0 */
    int (*expect_SafeInit) _ANSI_ARGS_((Tcl_Interp * interp)); /* 1 */
} ExpStubs;

#ifdef __cplusplus
extern "C" {
#endif
extern ExpStubs *expStubsPtr;
#ifdef __cplusplus
}
#endif

#if defined(USE_EXP_STUBS) && !defined(USE_EXP_STUB_PROCS)

/*
 * Inline function declarations:
 */

#ifndef Expect_Init
#define Expect_Init \
	(expStubsPtr->expect_Init) /* 0 */
#endif
#ifndef Expect_SafeInit
#define Expect_SafeInit \
	(expStubsPtr->expect_SafeInit) /* 1 */
#endif

#endif /* defined(USE_EXP_STUBS) && !defined(USE_EXP_STUB_PROCS) */

/* !END!: Do not edit above this line. */

#endif /* _EXPDECLS */






Added generic/expInt.h.






























































































































































































































































































































































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/*
 * expInt.h --
 *
 *	Declarations of things used internally by Expect.
 *
 * Written by: Don Libes, [email protected], NIST, 12/3/90
 *
 * Design and implementation of this program was paid for by U.S. tax
 * dollars.  Therefore it is public domain.  However, the author and NIST
 * would appreciate credit if this program or parts of it are used.
 *
 * Modified in October, 2001 by David Gravereaux for windows.
 *
 * RCS: @(#) $Id: expInt.h,v 1.1.2.2 2001/10/28 01:46:31 davygrvy Exp $
 */

#ifndef _EXPINT
#define _EXPINT

#ifndef _EXP
#   include "exp.h"
#endif

#ifndef _TCLPORT
#   include "tclPort.h"
#endif


#undef TCL_STORAGE_CLASS
#ifdef BUILD_exp
#   define TCL_STORAGE_CLASS DLLEXPORT
#else
#   ifdef USE_EXP_STUBS
#	define TCL_STORAGE_CLASS
#   else
#	define TCL_STORAGE_CLASS DLLIMPORT
#   endif
#endif


#define EXP_CHANNELNAMELEN	    (16 + TCL_INTEGER_SPACE)
#define exp_flageq(flag,string,minlen) \
	(((string)[0] == (flag)[0]) && (exp_flageq_code(((flag)+1), \
	((string)+1), ((minlen)-1))))

/* exp_flageq for single char flags */
#define exp_flageq1(flag,string) \
	((string[0] == flag) && (string[1] == '\0'))

#define EXP_SPAWN_ID_USER	    0
#define EXP_SPAWN_ID_ANY_LIT	    "-1"
#define EXP_SPAWN_ID_VARNAME	    "spawn_id"

#define EXP_CHANNEL_PREFIX	    "exp"
#define EXP_CHANNEL_PREFIX_LENGTH   3
#define isExpChannelName(name) \
    (0 == strncmp(name,EXP_CHANNEL_PREFIX,EXP_CHANNEL_PREFIX_LENGTH))

#define exp_is_stdinfd(x)	((x) == 0)
#define exp_is_devttyfd(x)	((x) == exp_dev_tty)

#define EXP_NOPID	0	/* Used when there is no associated pid to */
				/* wait for.  For example: */
				/* 1) When fd opened by someone else, e.g., */
				/* Tcl's open */
				/* 2) When entry not in use */
				/* 3) To tell user pid of "spawn -open" */
				/* 4) stdin, out, error */

#define EXP_NOFD	-1

/* these are occasionally useful to distinguish between various expect */
/* commands and are also used as array indices into the per-fd eg[] arrays */
#define EXP_CMD_BEFORE	0
#define EXP_CMD_AFTER	1
#define EXP_CMD_BG	2
#define EXP_CMD_FG	3

/*
 * This structure describes per-instance state of an Exp channel.
 */

typedef struct ExpState {
    Tcl_Channel channel;	    /* Channel associated with this file. */
    char name[EXP_CHANNELNAMELEN+1]; /* expect and interact set variables
					to channel name, so for efficiency
					cache it here */
    int fdin;			    /* input fd */
    int fdout;			    /* output fd - usually the same as fdin,
				       although may be different if channel
				       opened by tcl::open */
    Tcl_Channel channel_orig;	    /* If opened by someone else, i.e. tcl::open */
    int fd_slave;		    /* slave fd if "spawn -pty" used */

    /* this may go away if we find it is not needed */
    /* it might be needed by inherited channels */
    int validMask;		/* OR'ed combination of TCL_READABLE,
				 * TCL_WRITABLE, or TCL_EXCEPTION: indicates
				 * which operations are valid on the file. */

    int pid;		/* pid or EXP_NOPID if no pid */
    Tcl_Obj *buffer;	/* input buffer */

    int msize;	        /* # of bytes that buffer can hold (max) */
    int umsize;	        /* # of bytes (min) that is guaranteed to match */
			/* this comes from match_max command */
    int printed;	/* # of bytes written to stdout (if logging on) */
                        /* but not actually returned via a match yet */
    int echoed;	        /* additional # of bytes (beyond "printed" above) */
                        /* echoed back but not actually returned via a match */
                        /* yet.  This supports interact -echo */

    int rm_nulls;	/* if nulls should be stripped before pat matching */
    int open;		/* if fdin/fdout open */
    int user_waited;    /* if user has issued "wait" command */
    int sys_waited;	/* if wait() (or variant) has been called */
    int registered;	/* if channel registered */
    WAIT_STATUS_TYPE wait;	/* raw status from wait() */
    int parity;	        /* if parity should be preserved */
    int key;	        /* unique id that identifies what command instance */
                        /* last touched this buffer */
    int force_read;	/* force read to occur (even if buffer already has */
                        /* data).  This supports interact CAN_MATCH */
    int notified;	/* If Tcl_NotifyChannel has been called and we */
		        /* have not yet read from the channel. */
    int notifiedMask;	/* Mask reported when notified. */
    int fg_armed;	/* If Tcl_CreateFileHandler is active for responding */
                        /* to foreground events */	   
#ifdef HAVE_PTYTRAP
    char *slave_name;   /* Full name of slave, i.e., /dev/ttyp0 */
#endif /* HAVE_PTYTRAP */
    /* may go away */
    int leaveopen;	/* If we should not call Tcl's close when we close - */
                        /* only relevant if Tcl does the original open */

    Tcl_Interp *bg_interp;	/* interp to process the bg cases */
    int bg_ecount;		/* number of background ecases */
    enum {
	blocked,	/* blocked because we are processing the */
			/* file handler */
	armed,		/* normal state when bg handler in use */
	unarmed,	/* no bg handler in use */
	disarm_req_while_blocked /* while blocked, a request 
				    was received to disarm it.  Rather than 
				    processing the request immediately, defer
				    it so that when we later try to unblock
				    we will see at that time that it should
				    instead be disarmed */
    } bg_status;

    /*
     * If the channel is freed while in the middle of a bg event handler,
     * remember that and defer freeing of the ExpState structure until
     * it is safe.
     */
    int freeWhenBgHandlerUnblocked;

    /* If channel is closed but not yet waited on, we tie up the fd by
     * attaching it to /dev/null.  We play this little game so that we
     * can embed the fd in the channel name.  If we didn't tie up the
     * fd, we'd get channel name collisions.  I'd consider naming the
     * channels independently of the fd, but this makes debugging easier.
     */
    int fdBusy;

    /* 
     * stdinout and stderr never go away so that our internal refs to them
     * don't have to be invalidated.  Having to worry about invalidating them
     * would be a major pain.  */
    int keepForever;

    /*  Remember that "reserved" esPtrs are no longer in use. */
    int valid;
    
    struct ExpState *nextPtr;	/* Pointer to next file in list of all
				 * file channels. */
} ExpState;

#define EXP_SPAWN_ID_BAD	((ExpState *)0)
#define EXP_TIME_INFINITY	-1

#define exp_new(x)		(x *)ckalloc(sizeof(x))

struct exp_state_list {
	ExpState *esPtr;
	struct exp_state_list *next;
};

/* describes a -i flag */
struct exp_i {
	int cmdtype;	/* EXP_CMD_XXX.  When an indirect update is */
			/* triggered by Tcl, this helps tell us in what */
			/* exp_i list to look in. */
	int direct;	/* if EXP_DIRECT, then the spawn ids have been given */
			/* literally, else indirectly through a variable */
	int duration;	/* if EXP_PERMANENT, char ptrs here had to be */
			/* malloc'd because Tcl command line went away - */
			/* i.e., in expect_before/after */
	char *variable;
	char *value;	/* if type == direct, this is the string that the */
			/* user originally supplied to the -i flag.  It may */
			/* lose relevance as the fd_list is manipulated */
			/* over time.  If type == direct, this is  the */
			/* cached value of variable use this to tell if it */
			/* has changed or not, and ergo whether it's */
			/* necessary to reparse. */

	int ecount;	/* # of ecases this is used by */

	struct exp_state_list *state_list;
	struct exp_i *next;
};

#define EXP_TEMPORARY	1	/* expect */
#define EXP_PERMANENT	2	/* expect_after, expect_before, expect_bg */
#define EXP_DIRECT	1
#define EXP_INDIRECT	2


/*
 * definitions for creating commands
 */

#define EXP_NOPREFIX	1	/* don't define with "exp_" prefix */
#define EXP_REDEFINE	2	/* stomp on old commands with same name */

#define exp_proc(cmdproc) 0, cmdproc

struct exp_cmd_data {
	char		*name;
	Tcl_ObjCmdProc	*objproc;
	Tcl_CmdProc	*proc;
	ClientData	data;
	int 		flags;
};
#define exp_deleteProc	    NULL
#define exp_deleteObjProc   NULL


#define streq(x,y)	(0 == strcmp((x),(y)))


/* Global variables */
extern int exp_default_match_max;
extern int exp_default_parity;
extern int exp_default_rm_nulls;
extern Tcl_ChannelType expSpawnChanType;
extern int expect_key;
extern int exp_configure_count;	/* # of times descriptors have been closed
				   or indirect lists have been changed */
extern int exp_nostack_dump;	/* TRUE if user has requested unrolling of
				   stack with no trace */
extern char *exp_onexit_action;
extern int exp_cmdlinecmds;
extern int exp_interactive;
extern FILE *exp_cmdfile;
extern char *exp_cmdfilename;
extern int exp_getpid;	/* pid of Expect itself */
extern int exp_buffer_command_input;
extern int exp_tcl_debugger_available;
extern Tcl_Interp *exp_interp;
extern void (*exp_event_exit) _ANSI_ARGS_((Tcl_Interp *));
/*
 * Everything below here should eventually be moved into expect.h
 * and Expect-thread-safe variables.
 */

extern char *exp_pty_error;		/* place to pass a string generated */
					/* deep in the innards of the pty */
					/* code but needed by anyone */
extern int exp_disconnected;		/* proc. disc'd from controlling tty */


/* protos not yet moved to the Stubs table */
TCL_EXTERN(int)		exp_getpidproc _ANSI_ARGS_((void));
TCL_EXTERN(char *)	exp_get_var _ANSI_ARGS_((Tcl_Interp *,char *));
TCL_EXTERN(int)		exp_one_arg_braced _ANSI_ARGS_((Tcl_Obj *));
TCL_EXTERN(int)		exp_eval_with_one_arg _ANSI_ARGS_((ClientData,
				Tcl_Interp *, struct Tcl_Obj * CONST objv[]));
TCL_EXTERN(void)	exp_lowmemcpy _ANSI_ARGS_((char *,char *,int));
TCL_EXTERN(int)		exp_flageq_code _ANSI_ARGS_((char *,char *,int));
TCL_EXTERN(void)	expAdjust _ANSI_ARGS_((ExpState *));
TCL_EXTERN(void)	exp_buffer_shuffle _ANSI_ARGS_((Tcl_Interp *,ExpState *,int,char *,char *));
TCL_EXTERN(int)		exp_close _ANSI_ARGS_((Tcl_Interp *,ExpState *));
TCL_EXTERN(void)	exp_close_all _ANSI_ARGS_((Tcl_Interp *));
//TCL_EXTERN(void)	exp_ecmd_remove_fd_direct_and_indirect 
//				_ANSI_ARGS_((Tcl_Interp *,int));
TCL_EXTERN(void)	exp_trap_on _ANSI_ARGS_((int));
TCL_EXTERN(int)		exp_trap_off _ANSI_ARGS_((char *));
TCL_EXTERN(void)	exp_strftime _ANSI_ARGS_((char *format, const struct tm *timeptr,Tcl_DString *dstring));
TCL_EXTERN(void)	exp_init_pty _ANSI_ARGS_((void));
TCL_EXTERN(void)	exp_pty_exit _ANSI_ARGS_((void));
TCL_EXTERN(void)	exp_init_tty _ANSI_ARGS_((void));
TCL_EXTERN(void)	exp_init_stdio _ANSI_ARGS_((void));
//TCL_EXTERN(void)	exp_init_expect _ANSI_ARGS_((Tcl_Interp *));
TCL_EXTERN(void)	exp_init_spawn_ids _ANSI_ARGS_((Tcl_Interp *));
TCL_EXTERN(void)	exp_init_spawn_id_vars _ANSI_ARGS_((Tcl_Interp *));
TCL_EXTERN(void)	exp_init_trap _ANSI_ARGS_((void));
TCL_EXTERN(void)	exp_init_send _ANSI_ARGS_((void));
TCL_EXTERN(void)	exp_init_unit_random _ANSI_ARGS_((void));
TCL_EXTERN(void)	exp_init_sig _ANSI_ARGS_((void));
TCL_EXTERN(void)	expChannelInit _ANSI_ARGS_((void));
TCL_EXTERN(int)		expChannelCountGet _ANSI_ARGS_((void));
TCL_EXTERN(int)		exp_tcl2_returnvalue _ANSI_ARGS_((int));
TCL_EXTERN(int)		exp_2tcl_returnvalue _ANSI_ARGS_((int));
TCL_EXTERN(void)	exp_rearm_sigchld _ANSI_ARGS_((Tcl_Interp *));
TCL_EXTERN(int)		exp_string_to_signal _ANSI_ARGS_((Tcl_Interp *,char *));
TCL_EXTERN(struct exp_i *) exp_new_i_complex _ANSI_ARGS_((Tcl_Interp *,
					char *, int, Tcl_VarTraceProc *));
TCL_EXTERN(struct exp_i *) exp_new_i_simple _ANSI_ARGS_((ExpState *,int));
TCL_EXTERN(struct exp_state_list *) exp_new_state _ANSI_ARGS_((ExpState *));
TCL_EXTERN(void)	exp_free_i _ANSI_ARGS_((Tcl_Interp *,struct exp_i *,
					Tcl_VarTraceProc *));
TCL_EXTERN(void)	exp_free_state _ANSI_ARGS_((struct exp_state_list *));
TCL_EXTERN(void)	exp_free_state_single _ANSI_ARGS_((struct exp_state_list *));
TCL_EXTERN(void)	exp_i_update _ANSI_ARGS_((Tcl_Interp *,
					struct exp_i *));
TCL_EXTERN(void)	exp_create_commands _ANSI_ARGS_((Tcl_Interp *,
						struct exp_cmd_data *));
TCL_EXTERN(void)	exp_init_main_cmds _ANSI_ARGS_((Tcl_Interp *));
TCL_EXTERN(void)	exp_init_expect_cmds _ANSI_ARGS_((Tcl_Interp *));
TCL_EXTERN(void)	exp_init_most_cmds _ANSI_ARGS_((Tcl_Interp *));
TCL_EXTERN(void)	exp_init_trap_cmds _ANSI_ARGS_((Tcl_Interp *));
TCL_EXTERN(void)	exp_init_interact_cmds _ANSI_ARGS_((Tcl_Interp *));
TCL_EXTERN(void)	exp_init_tty_cmds();

TCL_EXTERN(ExpState *)	expStateCheck _ANSI_ARGS_((Tcl_Interp *,ExpState *,int,int,char *));
TCL_EXTERN(ExpState *)  expStateCurrent _ANSI_ARGS_((Tcl_Interp *,int,int,int));
TCL_EXTERN(ExpState *)  expStateFromChannelName _ANSI_ARGS_((Tcl_Interp *,char *,int,int,int,char *));
TCL_EXTERN(void)	expStateFree _ANSI_ARGS_((ExpState *));

TCL_EXTERN(ExpState *)	expCreateChannel _ANSI_ARGS_((Tcl_Interp *,int,int,int));
TCL_EXTERN(ExpState *)	expWaitOnAny _ANSI_ARGS_((void));
TCL_EXTERN(ExpState *)	expWaitOnOne _ANSI_ARGS_((void));
TCL_EXTERN(void)	expExpectVarsInit _ANSI_ARGS_((void));
TCL_EXTERN(int)		expStateAnyIs _ANSI_ARGS_((ExpState *));
TCL_EXTERN(int)		expDevttyIs _ANSI_ARGS_((ExpState *));
TCL_EXTERN(int)		expStdinOutIs _ANSI_ARGS_((ExpState *));
TCL_EXTERN(ExpState *)	expStdinoutGet _ANSI_ARGS_((void));
TCL_EXTERN(ExpState *)	expDevttyGet _ANSI_ARGS_((void));
TCL_EXTERN(int)		expSizeGet _ANSI_ARGS_((ExpState *));
TCL_EXTERN(int)		expSizeZero _ANSI_ARGS_((ExpState *));

/* for exp_event.c */
TCL_EXTERN(int)		exp_get_next_event _ANSI_ARGS_((Tcl_Interp *,ExpState **, int, ExpState **, int, int));
TCL_EXTERN(int)		exp_get_next_event_info _ANSI_ARGS_((Tcl_Interp *, ExpState *));
TCL_EXTERN(int)		exp_dsleep _ANSI_ARGS_((Tcl_Interp *, double));
TCL_EXTERN(void)	exp_init_event _ANSI_ARGS_((void));
//extern void (*exp_event_exit) _ANSI_ARGS_((Tcl_Interp *));
TCL_EXTERN(void)	exp_event_disarm _ANSI_ARGS_((ExpState *,Tcl_FileProc *));
TCL_EXTERN(void)	exp_event_disarm_bg _ANSI_ARGS_((ExpState *));
TCL_EXTERN(void)	exp_event_disarm_fg _ANSI_ARGS_((ExpState *));
TCL_EXTERN(void)	exp_arm_background_channelhandler _ANSI_ARGS_((ExpState *));
TCL_EXTERN(void)	exp_disarm_background_channelhandler _ANSI_ARGS_((ExpState *));
TCL_EXTERN(void)	exp_disarm_background_channelhandler_force _ANSI_ARGS_((ExpState *));
TCL_EXTERN(void)	exp_unblock_background_channelhandler _ANSI_ARGS_((ExpState *));
TCL_EXTERN(void)	exp_block_background_channelhandler _ANSI_ARGS_((ExpState *));
TCL_EXTERN(void)	exp_background_channelhandler _ANSI_ARGS_((ClientData,int));


/* for exp_log.h */
TCL_EXTERN(void)	expDiagInit _ANSI_ARGS_((void));
TCL_EXTERN(int)		expDiagChannelOpen _ANSI_ARGS_((Tcl_Interp *,char *));
TCL_EXTERN(Tcl_Channel)	expDiagChannelGet _ANSI_ARGS_((void));
TCL_EXTERN(void)	expDiagChannelClose _ANSI_ARGS_((Tcl_Interp *));
TCL_EXTERN(char *)	expDiagFilename _ANSI_ARGS_((void));
TCL_EXTERN(int)		expDiagToStderrGet _ANSI_ARGS_((void));
TCL_EXTERN(void)	expDiagToStderrSet _ANSI_ARGS_((int));
TCL_EXTERN(void)	expDiagWriteBytes _ANSI_ARGS_((char *,int));
TCL_EXTERN(void)	expDiagWriteChars _ANSI_ARGS_((char *,int));
TCL_EXTERN(void)	expDiagWriteObj _ANSI_ARGS_((Tcl_Obj *));
TCL_EXTERN(void)	expDiagLog _ANSI_ARGS_(TCL_VARARGS(char *,fmt));
TCL_EXTERN(void)	expDiagLogU _ANSI_ARGS_((char *));
TCL_EXTERN(char *)	expPrintify _ANSI_ARGS_((char *));
TCL_EXTERN(char *)	expPrintifyObj _ANSI_ARGS_((Tcl_Obj *));
TCL_EXTERN(void)	expLogInit _ANSI_ARGS_((void));
TCL_EXTERN(int)		expLogChannelOpen _ANSI_ARGS_((Tcl_Interp *,char *,int));
TCL_EXTERN(Tcl_Channel)	expLogChannelGet _ANSI_ARGS_((void));
TCL_EXTERN(int)		expLogChannelSet _ANSI_ARGS_((Tcl_Interp *,char *));
TCL_EXTERN(void)	expLogChannelClose _ANSI_ARGS_((Tcl_Interp *));
TCL_EXTERN(char *)	expLogFilenameGet _ANSI_ARGS_((void));
TCL_EXTERN(void)	expLogAppendSet _ANSI_ARGS_((int));
TCL_EXTERN(int)		expLogAppendGet _ANSI_ARGS_((void));
TCL_EXTERN(void)	expLogLeaveOpenSet _ANSI_ARGS_((int));
TCL_EXTERN(int)		expLogLeaveOpenGet _ANSI_ARGS_((void));
TCL_EXTERN(void)	expLogAllSet _ANSI_ARGS_((int));
TCL_EXTERN(int)		expLogAllGet _ANSI_ARGS_((void));
TCL_EXTERN(void)	expLogToStdoutSet _ANSI_ARGS_((int));
TCL_EXTERN(int)		expLogToStdoutGet _ANSI_ARGS_((void));
TCL_EXTERN(void)	expLogDiagU _ANSI_ARGS_((char *));
TCL_EXTERN(int)		expWriteBytesAndLogIfTtyU _ANSI_ARGS_((ExpState *,char *,int));
TCL_EXTERN(int)		expLogUserGet _ANSI_ARGS_((void));
TCL_EXTERN(void)	expLogUserSet _ANSI_ARGS_((int));
TCL_EXTERN(void)	expLogInteractionU _ANSI_ARGS_((ExpState *,char *));



TCL_EXTERN(void)	exp_ecmd_remove_state_direct_and_indirect _ANSI_ARGS_((
			    Tcl_Interp *interp, ExpState *esPtr));

Tcl_ObjCmdProc Exp_CloseObjCmd;
Tcl_CmdProc Exp_ExpInternalCmd;
Tcl_CmdProc Exp_DisconnectCmd;
Tcl_CmdProc Exp_ExitCmd;
Tcl_CmdProc Exp_ExpContinueCmd;
Tcl_CmdProc Exp_ForkCmd;
Tcl_CmdProc Exp_ExpPidCmd;
Tcl_CmdProc Exp_GetpidDeprecatedCmd;
Tcl_ObjCmdProc Exp_InterpreterObjCmd;
Tcl_CmdProc Exp_LogFileCmd;
Tcl_CmdProc Exp_LogUserCmd;
Tcl_CmdProc Exp_OpenCmd;
Tcl_CmdProc Exp_OverlayCmd;
Tcl_ObjCmdProc Exp_InterReturnObjCmd;
Tcl_ObjCmdProc Exp_SendObjCmd;
Tcl_CmdProc Exp_SendLogCmd;
Tcl_CmdProc Exp_SleepCmd;
Tcl_CmdProc Exp_SpawnCmd;
Tcl_CmdProc Exp_StraceCmd;
Tcl_CmdProc Exp_WaitCmd;


/*
 *----------------------------------------------------------------
 * Functions shared among Exp modules but not used by the outside
 * world:
 *----------------------------------------------------------------
 */
extern void	expErrorLog _ANSI_ARGS_(TCL_VARARGS(char *,fmt));
extern void	expErrorLogU _ANSI_ARGS_((char *));
extern void	expStdoutLog _ANSI_ARGS_(TCL_VARARGS(int,force_stdout));
extern void	expStdoutLogU _ANSI_ARGS_((char *buf, int force_stdout));
extern void	exp_debuglog _ANSI_ARGS_(TCL_VARARGS(char *,fmt));

#include "expIntDecls.h"

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT

#endif /* _EXPINT */






Added generic/expIntDecls.h.































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/*
 * expIntDecls.h --
 *
 *	Declarations of functions in the platform independent public
 *	Expect API.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: $Id: expIntDecls.h,v 1.1.2.1 2001/10/28 01:46:31 davygrvy Exp $
 */

#ifndef _EXPINTDECLS_H__
#define _EXPINTDECLS_H__

/*
 * WARNING: This file is automatically generated by the tools/genStubs.tcl
 * script.  Any modifications to the function declarations below should be made
 * in the exp.decls script.
 */

/* !BEGIN!: Do not edit below this line. */
/* !END!: Do not edit above this line. */

#endif /* _EXPINTDECLS_H__ */






Added generic/expPlatDecls.h.




















































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/*
 * expPlatDecls.h --
 *
 *	Declarations of platform specific Expect APIs.
 *
 * RCS: @(#) $Id: tclPlatDecls.h,v 1.12 2001/09/09 22:45:13 davygrvy Exp $
 */

#ifndef _EXPPLATDECLS
#define _EXPPLATDECLS

/* !BEGIN!: Do not edit below this line. */

/*
 * Exported function declarations:
 */


typedef struct ExpPlatStubs {
    int magic;
    struct ExpPlatStubHooks *hooks;

} ExpPlatStubs;

#ifdef __cplusplus
extern "C" {
#endif
extern ExpPlatStubs *expPlatStubsPtr;
#ifdef __cplusplus
}
#endif

#if defined(USE_EXP_STUBS) && !defined(USE_EXP_STUB_PROCS)

/*
 * Inline function declarations:
 */


#endif /* defined(USE_EXP_STUBS) && !defined(USE_EXP_STUB_PROCS) */

/* !END!: Do not edit above this line. */

#endif /* _EXPPLATDECLS */








Added generic/expPort.h.
































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/*
 * expPort.h --
 *
 *	This header file handles porting issues that occur because
 *	of differences between systems.  It reads in platform specific
 *	portability files.
 *
 * RCS: @(#) $Id: tclPort.h,v 1.5 1999/05/25 01:00:27 stanton Exp $
 */

#ifndef _EXPPORT_H__
#define _EXPPORT_H__

#define HAVE_MEMCPY

#ifdef __WIN32__
#   include "../win/expWinPort.h"
#else
#   if defined(MAC_TCL)
#	include "../mac/expPort.h"
#    else
#	include "../unix/expUnixPort.h"
#    endif
#endif

#endif /* _EXPPORT_H__ */






Changes to generic/expSpawnChan.c.





1
2

3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18



19
20
21
22

23
24



25
26

27
28
29
30



31
32

33
34


35
36

37



38
39
40


41
42
43
44
45
46
47
48
49












50
51


































52
53
























































































































































































































































54
55
56
57
58
59
60

1

2
3
4
5
6
7
8
9
10
11
12
13
14
15



16
17
18
19
20
21

22
23

24
25
26
27

28
29



30
31
32
33

34


35
36
37

38

39
40
41
42


43
44









45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92


93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347


-
+













-
-
-
+
+
+



-
+

-
+
+
+

-
+

-
-
-
+
+
+

-
+
-
-
+
+

-
+
-
+
+
+

-
-
+
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+


+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








/*
 * expWinChan.c --
 * expSpawnChan.c --
 *
 *	Implements the exp_spawn channel id.  This wraps a normal
 *	file channel in another channel so we can close the file
 *	channel normally but still have another id to wait on.
 *	The file channel is not exposed in any interps.
 *
 * Copyright (c) 1997 by Mitel Corporation
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 */

#include "exp_port.h"
#include "tclInt.h"
#include "tclPort.h"
#include "tclInt.h"
#include "tclPort.h"
#include "expect_tcl.h"
#include "exp_command.h"
#include "expWin.h"

static int	ExpSpawnBlock _ANSI_ARGS_((ClientData instanceData,
static int	ExpSpawnBlockProc _ANSI_ARGS_((ClientData instanceData,
		    int mode));
static int	ExpSpawnInput _ANSI_ARGS_((ClientData instanceData,
static int	ExpSpawnCloseProc _ANSI_ARGS_((ClientData instanceData,
		    Tcl_Interp *interp));
static int	ExpSpawnInputProc _ANSI_ARGS_((ClientData instanceData,
		    char *bufPtr, int bufSize, int *errorPtr));
static int	ExpSpawnOutput _ANSI_ARGS_((ClientData instanceData,
static int	ExpSpawnOutputProc _ANSI_ARGS_((ClientData instanceData,
		    char *bufPtr, int toWrite, int *errorPtr));
static int	ExpSpawnClose _ANSI_ARGS_((ClientData instanceData,
		    Tcl_Interp *interp));
static int	ExpSpawnSetOption _ANSI_ARGS_((ClientData instanceData,
static int	ExpSpawnGetOptionProc _ANSI_ARGS_((ClientData instanceData,
		    Tcl_Interp *interp, char *nameStr, Tcl_DString *dsPtr));
static int	ExpSpawnSetOptionProc _ANSI_ARGS_((ClientData instanceData,
		    Tcl_Interp *interp, char *nameStr, char *val));
static int	ExpSpawnGetOption _ANSI_ARGS_((ClientData instanceData,
static void	ExpSpawnWatchProc _ANSI_ARGS_((ClientData instanceData,
		    Tcl_Interp *interp, char *nameStr, Tcl_DString *dsPtr));
static int	ExpSpawnGetHandle _ANSI_ARGS_((ClientData instanceData,
		    int mask));
static int	ExpSpawnGetHandleProc _ANSI_ARGS_((ClientData instanceData,
		    int direction, ClientData *handlePtr));
static void	ExpSpawnWatch _ANSI_ARGS_((ClientData instanceData,

		    int mask));
/*
 * This structure describes the channel type structure for Expect-based IO:
 */

static Tcl_ChannelType ExpSpawnChannelType = {
    "exp_spawn",
Tcl_ChannelType expSpawnChanType = {
    "exp_spawn",			/* Type name. */
    ExpSpawnBlock,
    ExpSpawnClose,
    ExpSpawnInput,
    ExpSpawnOutput,
    NULL,         		/* Can't seek! */
    ExpSpawnSetOption,
    ExpSpawnGetOption,
    ExpSpawnWatch,
    ExpSpawnGetHandle
    TCL_CHANNEL_VERSION_1,		/* Version of the channel type. */
    ExpSpawnCloseProc,			/* Close proc. */
    ExpSpawnInputProc,			/* Input proc. */
    ExpSpawnOutputProc,			/* Output proc. */
    NULL,				/* Seek proc. */
    ExpSpawnSetOptionProc,		/* Set option proc. */
    ExpSpawnGetOptionProc,		/* Get option proc. */
    ExpSpawnWatchProc,			/* Initialize notifier. */
    ExpSpawnGetHandleProc,		/* Get OS handles out of channel. */
    NULL,				/* Close2 proc */
    ExpSpawnBlockProc			/* Set blocking/nonblocking mode.
					 * Expect channels are always blocking */
};

typedef struct ThreadSpecificData {
    /*
     * List of all exp channels currently open.  This is per thread and is
     * used to match up fd's to channels, which rarely occurs.
     */
    
    ExpState *firstExpPtr;
    int channelCount;	 /* this is process-wide as it is used to
			     give user some hint as to why a spawn has failed
			     by looking at process-wide resource usage */
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;


/*
 *----------------------------------------------------------------------
 *
 * expChannelInit --
 *
 *	Inits the TSD structure for the calling thread context.
 *
 * Results:
 *	nothing
 *
 * Side Effects:
 *	A datakey and associated TSD structure now exists for the
 *	calling thread context.
 *
 *----------------------------------------------------------------------
 */
void
expChannelInit() {
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
static int expSpawnCount = 0;

    tsdPtr->channelCount = 0;
}

/*
 *----------------------------------------------------------------------
 *
 * expChannelCountGet --
 *
 *	.
 *
 * Results:
 *	Count of how many spawn channels are open.
 *
 * Side Effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */
int
expChannelCountGet()
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    return tsdPtr->channelCount;
}

/*
 *----------------------------------------------------------------------
 *
 * expSizeGet --
 *
 *	Get how much data is currently in the channel's buffer.
 *
 * Results:
 *	bytes in use.
 *
 * Side Effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */
int
expSizeGet(esPtr)
    ExpState *esPtr;
{
    int len;
    Tcl_GetStringFromObj(esPtr->buffer,&len);
    return len;
}

/*
 *----------------------------------------------------------------------
 *
 * expSizeZero --
 *
 *	Asks if the buffer is empty.
 *
 * Results:
 *	Boolean.
 *
 * Side Effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */
int
expSizeZero(esPtr)
    ExpState *esPtr;
{
    int len;
    Tcl_GetStringFromObj(esPtr->buffer,&len);
    return (len == 0);
}

/*
 *----------------------------------------------------------------------
 *
 * expStateFree --
 *
 *	Asks if the buffer is empty.
 *
 * Results:
 *	Boolean.
 *
 * Side Effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void
expStateFree(esPtr)
    ExpState *esPtr;
{
    if (esPtr->fdBusy) {
//    close(esPtr->fdin);    /* BUG: not OS neutral */
//      expPlatformStateFree(esPtr);
    }

    esPtr->valid = FALSE;
    
    if (!esPtr->keepForever) {
	ckfree((char *)esPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * exp_close_all --
 *
 *	close all connections
 * 
 *	The kernel would actually do this by default, however Tcl is going to
 *	come along later and try to reap its exec'd processes.  If we have
 *	inherited any via spawn -open, Tcl can hang if we don't close the
 *	connections first.
 *
 * Results:
 *	A Tcl channel
 *
 * Side Effects:
 *	Allocates and registers a channel
 *
 *----------------------------------------------------------------------
 */

void
exp_close_all(interp)
    Tcl_Interp *interp;
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    ExpState *esPtr;

    /* no need to keep things in sync (i.e., tsdPtr, count) since we could only
       be doing this if we're exiting.  Just close everything down. */

    for (esPtr = tsdPtr->firstExpPtr; esPtr; esPtr = esPtr->nextPtr) {
	exp_close(interp, esPtr);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * expWaitOnAny --
 *
 *	Wait for any of our own spawned processes we call waitpid rather than
 *	wait to avoid running into someone else's processes.  Yes, according
 *	to Ousterhout this is the best way to do it.
 *
 * Results:
 *	returns the ExpState or 0 if nothing to wait on
 *
 * Side Effects:
 *	
 *
 *----------------------------------------------------------------------
 */

ExpState *
expWaitOnAny()
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    int result;
    ExpState *esPtr;

    for (esPtr = tsdPtr->firstExpPtr; esPtr; esPtr = esPtr->nextPtr) {
	if (esPtr->pid == exp_getpid) continue; /* skip ourself */
	if (esPtr->user_waited) continue;	/* one wait only! */
	if (esPtr->sys_waited) break;
      restart:
	result = waitpid(esPtr->pid, &esPtr->wait, WNOHANG);  /* BUG: not OS neutral */
	if (result == esPtr->pid) break;
	if (result == 0) continue;	/* busy, try next */
	if (result == -1) {
	    if (errno == EINTR) goto restart;
	    else break;
	}
    }
    return esPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * expWaitOnOne --
 *
 *	Add comment here.
 *
 * Results:
 *	
 *
 * Side Effects:
 *	
 *
 *----------------------------------------------------------------------
 */

ExpState *
expWaitOnOne()
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    ExpState *esPtr;
    int pid;
    /* should really be recoded using the common wait code in command.c */
    WAIT_STATUS_TYPE status;

    pid = wait(&status);   /* BUG: not OS neutral */
    for (esPtr = tsdPtr->firstExpPtr; esPtr; esPtr = esPtr->nextPtr) {
	if (esPtr->pid == pid) {
	    esPtr->sys_waited = TRUE;
	    esPtr->wait = status;
	    return esPtr;
	}
    }
    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * ExpCreateSpawnChannel --
 *
 *	Create an expect spawn identifier
 *
 * Results:
 *	A Tcl channel
 *
 * Side Effects:
 *	Allocates and registers a channel
 *
 *----------------------------------------------------------------------
 */

void
exp_background_channelhandlers_run_all()
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    ExpState *esPtr;

    /* kick off any that already have input waiting */
    for (esPtr = tsdPtr->firstExpPtr; esPtr; esPtr = esPtr->nextPtr) {
	/* is bg_interp the best way to check if armed? */
	if (esPtr->bg_interp && !expSizeZero(esPtr)) {
	    exp_background_channelhandler((ClientData)esPtr,0);
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 * ExpCreateSpawnChannel --
 *
 *	Create an expect spawn identifier




︙


70
71
72
73
74
75
76
77


78



79
80
81






82
83
84
85
86
87

88
89
90



91
92
93


































94
95
96
97
98
99
100

101
102
103
104
105
106
107
108
109
110
111
112
113
114


115
116
117
118
119

120
121
122
123
124
125
126
127
128

129
130
131
132
133
134
135
136
137
138
139
140
141
142


143
144
145
146



147
148
149


150
151
152
153
154
155
156
157
158

159
160
161
162
163
164
165
166
167
168
169
170
171
172


173
174
175
176
177
178
179
180
181
182
183
184

185
186


187
188
189

190
191
192
193



194
195
196
197
198
199


200
201
202



203
204
205













206

207



208






209
210
211





















212
213
214
215
216
217
218

219
220
221
222
223
224
225
226
227
228
229
230
231
232


233
234
235
236
237
238
239
240
241
242
243
244
245
246
247

248
249
250
251
252
253
254
255
256
257
258
259
260
261
262


263
264
265
266
267
268
269
270
271
272
273
274
275
276
277

278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293

294
295
296
297
298
299
300
301
302
303
304
305
306
307

308
309
310
311
312
313
314
315
316
317
318
319
320
321
322

323
324
325
326
327
328
329
330
331

357
358
359
360
361
362
363

364
365
366
367
368
369



370
371
372
373
374
375
376
377
378
379
380

381
382


383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428

429
430
431
432
433
434
435
436
437
438
439
440
441


442
443
444
445
446


447


448

449
450
451
452

453
454
455
456
457
458
459
460
461
462
463
464
465


466
467
468



469
470
471
472


473
474


475
476
477
478
479
480

481
482
483
484
485
486
487
488
489
490
491
492
493


494
495
496
497
498
499
500
501
502
503
504
505
506

507
508

509
510
511
512

513




514
515
516
517
518
519
520


521
522
523
524
525
526
527
528



529
530
531
532
533
534
535
536
537
538
539
540
541
542
543

544
545
546
547
548
549
550
551
552
553



554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580

581
582
583
584
585
586
587
588
589
590
591
592
593


594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609

610
611
612
613
614
615
616
617
618
619
620
621
622
623


624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639

640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655

656
657
658
659
660
661
662
663
664
665
666
667
668
669

670
671
672
673
674
675
676
677
678
679
680
681
682
683
684

685
686
687
688
689
690
691
692
693
694








-
+
+

+
+
+
-
-
-
+
+
+
+
+
+





-
+

-
-
+
+
+



+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+






-
+












-
-
+
+



-
-
+
-
-

-




-
+












-
-
+
+

-
-
-
+
+
+

-
-
+
+
-
-






-
+












-
-
+
+











-
+

-
+
+


-
+
-
-
-
-
+
+
+




-
-
+
+



+
+
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+

+
-
+
+
+

+
+
+
+
+
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+






-
+












-
-
+
+














-
+













-
-
+
+














-
+















-
+













-
+














-
+











Tcl_Channel
ExpCreateSpawnChannel(interp, chan)
    Tcl_Interp *interp;
    Tcl_Channel chan;
{
    ExpSpawnState *ssPtr;
    char channelNameStr[20];
    ExpState *esPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    esPtr = (ExpState *) ckalloc((unsigned) sizeof(ExpState));
    esPtr->nextPtr = tsdPtr->firstExpPtr;
    tsdPtr->firstExpPtr = esPtr;
    ssPtr = (ExpSpawnState *) ckalloc(sizeof(ExpSpawnState));
    ssPtr->channelPtr = chan;
    ssPtr->toWrite = 0;

    //ssPtr->channelPtr = chan;
    //ssPtr->toWrite = 0;

    esPtr->fdBusy = FALSE;


    /*
     * Setup the expect channel to always flush immediately
     */

    sprintf(channelNameStr, "exp_spawn%d", expSpawnCount++);
    sprintf(esPtr->name, "exp_spawn%d", tsdPtr->channelCount++);

    chan = Tcl_CreateChannel(&ExpSpawnChannelType, channelNameStr,
			     (ClientData) ssPtr, TCL_READABLE|TCL_WRITABLE);
    chan = Tcl_CreateChannel(&expSpawnChanType, esPtr->name,
			     (ClientData) esPtr, TCL_READABLE|TCL_WRITABLE);
    Tcl_RegisterChannel(interp, chan);
    Tcl_SetChannelOption(interp, chan, "-blocking", "0");
    Tcl_SetChannelOption(interp, chan, "-buffering", "none");
    Tcl_SetChannelOption(interp, chan, "-translation","binary");

    esPtr->msize = 0;

    /* initialize a dummy buffer */
    esPtr->buffer = Tcl_NewStringObj("",0);
    Tcl_IncrRefCount(esPtr->buffer);
    esPtr->umsize = exp_default_match_max;

    /* this will reallocate object with an appropriate sized buffer */
    expAdjust(esPtr);

    esPtr->printed = 0;
    esPtr->echoed = 0;
    esPtr->rm_nulls = exp_default_rm_nulls;
    esPtr->parity = exp_default_parity;
    esPtr->key = expect_key++;
    esPtr->force_read = FALSE;
    esPtr->fg_armed = FALSE;
    esPtr->channel_orig = 0;
    esPtr->fd_slave = EXP_NOFD;
#ifdef HAVE_PTYTRAP
    esPtr->slave_name = 0;
#endif /* HAVE_PTYTRAP */
    esPtr->open = TRUE;
    esPtr->notified = FALSE;
    esPtr->user_waited = FALSE;
    esPtr->sys_waited = FALSE;
    esPtr->bg_interp = 0;
    esPtr->bg_status = unarmed;
    esPtr->bg_ecount = 0;
    esPtr->freeWhenBgHandlerUnblocked = FALSE;
    esPtr->keepForever = FALSE;
    esPtr->valid = TRUE;

    return chan;
}

/*
 *----------------------------------------------------------------------
 *
 * ExpSpawnBlock --
 * ExpSpawnBlockProc --
 *
 *	Generic routine to set I/O to blocking or non-blocking.
 *
 * Results:
 *	TCL_OK or TCL_ERROR.
 *    
 * Side Effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
ExpSpawnBlock(instanceData, mode)
int
ExpSpawnBlockProc(instanceData, mode)
    ClientData instanceData;
    int mode;			/* (in) Block or not */
{
    Tcl_Channel channelPtr = ((ExpSpawnState *)instanceData)->channelPtr;

    return 0;   /* BUG: fix me! */
    return (Tcl_GetChannelType(channelPtr)->blockModeProc)
	(Tcl_GetChannelInstanceData(channelPtr), mode);
}


/*
 *----------------------------------------------------------------------
 *
 * ExpSpawnInput --
 * ExpSpawnInputProc --
 *
 *	Generic read routine for expect console
 *
 * Returns:
 *	Amount read or -1 with errorcode in errorPtr.
 *    
 * Side Effects:
 *	Buffer is updated. 
 *
 *----------------------------------------------------------------------
 */

static int
ExpSpawnInput(instanceData, bufPtr, bufSize, errorPtr)
int
ExpSpawnInputProc(instanceData, buf, toRead, errorCodePtr)
    ClientData instanceData;
    char *bufPtr;		/* (in) Ptr to buffer */
    int bufSize;		/* (in) sizeof buffer */
    int *errorPtr;		/* (out) error code */
    char *buf;		/* (in) Ptr to buffer */
    int toRead;		/* (in) sizeof buffer */
    int *errorCodePtr;		/* (out) error code */
{
    Tcl_Channel channelPtr = ((ExpSpawnState *)instanceData)->channelPtr;

    ExpState *esPtr = (ExpState *) instanceData;
    return ExpPlatformSpawnInput(esPtr, buf, toRead, errorCodePtr);
    return (Tcl_GetChannelType(channelPtr)->inputProc)
	(Tcl_GetChannelInstanceData(channelPtr), bufPtr, bufSize, errorPtr);
}


/*
 *----------------------------------------------------------------------
 *
 * ExpSpawnOutput --
 * ExpSpawnOutputProc --
 *
 *	Write routine for expect console
 *
 * Results:
 *	Amount written or -1 with errorcode in errorPtr
 *    
 * Side Effects:
 *	None. 
 *
 *----------------------------------------------------------------------
 */

static int
ExpSpawnOutput(instanceData, bufPtr, toWrite, errorPtr)
int
ExpSpawnOutputProc(instanceData, bufPtr, toWrite, errorPtr)
    ClientData instanceData;
    char *bufPtr;		/* (in) Ptr to buffer */
    int toWrite;		/* (in) amount to write */
    int *errorPtr;		/* (out) error code */
{
    return ExpPlatformSpawnOutput(instanceData, bufPtr, toWrite, errorPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * ExpSpawnClose --
 * ExpSpawnCloseProc --
 *
 *	Generic routine to close the expect console
 *	This procedure is called from the generic IO level to perform
 *	channel-type-specific cleanup when an exp-based channel is closed.
 *
 * Results:
 *      0 if successful or a POSIX errorcode with
 *	0 if successful, errno if failed.
 *      interp updated.
 *    
 * Side Effects:
 *	Channel is deleted.
 *
 * Side effects:
 *	Closes the device of the channel.
 *
 *----------------------------------------------------------------------
 */

static int
ExpSpawnClose(instanceData, interp)
int
ExpSpawnCloseProc(instanceData, interp)
    ClientData instanceData;
    Tcl_Interp *interp;
{
    ExpState *esPtr = (ExpState *) instanceData;
    ExpState **nextPtrPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    ExpSpawnState *ssPtr = (ExpSpawnState *) instanceData;
    Tcl_Channel channelPtr = ssPtr->channelPtr;
    int ret;

    esPtr->registered = FALSE;

#if 0
    /*
      Really should check that we created one first.  Since we're sharing fds
      with Tcl, perhaps a filehandler was created with a plain tcl file - we
      wouldn't want to delete that.  Although if user really close Expect's
      user_spawn_id, it probably doesn't matter anyway.
    */

    Tcl_DeleteFileHandler(esPtr->fdin);
#endif /*0*/

    Tcl_DecrRefCount(esPtr->buffer);
    ret = Tcl_Close(interp, channelPtr);

    /* Actually file descriptor should have been closed earlier. */
    /* So do nothing here */

    /*
     * Conceivably, the process may not yet have been waited for.  If this
     * becomes a requirement, we'll have to revisit this code.  But for now, if
     * it's just Tcl exiting, the processes will exit on their own soon
     * anyway.
     */
    ckfree((char *)ssPtr);

    return ret;

    for (nextPtrPtr = &(tsdPtr->firstExpPtr); (*nextPtrPtr) != NULL;
	 nextPtrPtr = &((*nextPtrPtr)->nextPtr)) {
	if ((*nextPtrPtr) == esPtr) {
	    (*nextPtrPtr) = esPtr->nextPtr;
	    break;
	}
    }
    tsdPtr->channelCount--;

    if (esPtr->bg_status == blocked ||
	    esPtr->bg_status == disarm_req_while_blocked) {
	esPtr->freeWhenBgHandlerUnblocked = 1;
	/*
	 * If we're in the middle of a bg event handler, then the event
	 * handler will have to take care of freeing esPtr.
	 */
    } else {
	expStateFree(esPtr);
    }
    return 0;
}


/*
 *----------------------------------------------------------------------
 *
 * ExpSpawnSetOption --
 * ExpSpawnSetOptionProc --
 *
 *	Set the value of an ExpSpawn channel option
 *
 * Results:
 *	TCL_OK and dsPtr updated with the value or TCL_ERROR.
 *
 * Side Effects
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
ExpSpawnSetOption(instanceData, interp, nameStr, valStr)
int
ExpSpawnSetOptionProc(instanceData, interp, nameStr, valStr)
    ClientData instanceData;
    Tcl_Interp *interp;
    char *nameStr;		/* (in) Name of option */
    char *valStr;		/* (in) New value of option */
{
    Tcl_Channel channelPtr = ((ExpSpawnState *)instanceData)->channelPtr;

    return (Tcl_GetChannelType(channelPtr)->setOptionProc)
	(Tcl_GetChannelInstanceData(channelPtr), interp, nameStr, valStr);
}

/*
 *----------------------------------------------------------------------
 *
 * ExpSpawnGetOption --
 * ExpSpawnGetOptionProc --
 *
 *	Queries ExpSpawn channel for the current value of
 *      the given option.
 *
 * Results:
 *	TCL_OK and dsPtr updated with the value or TCL_ERROR.
 *
 * Side Effects
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
ExpSpawnGetOption(instanceData, interp, nameStr, dsPtr)
int
ExpSpawnGetOptionProc(instanceData, interp, nameStr, dsPtr)
    ClientData instanceData;
    Tcl_Interp *interp;
    char *nameStr;		/* (in) Name of option to retrieve */		
    Tcl_DString *dsPtr;		/* (in) String to place value */
{
    Tcl_Channel channelPtr = ((ExpSpawnState *)instanceData)->channelPtr;

    return (Tcl_GetChannelType(channelPtr)->getOptionProc)
	(Tcl_GetChannelInstanceData(channelPtr), interp, nameStr, dsPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * ExpSpawnGetHandle --
 * ExpSpawnGetHandleProc --
 *
 *	Get the Tcl_File for the appropriate direction in from the
 *	Tcl_Channel.
 *
 * Results:
 *	NULL because ExpSpawn ids are handled through other channel
 *	types.
 *
 * Side Effects
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
ExpSpawnGetHandle(instanceData, direction, handlePtr)
ExpSpawnGetHandleProc(instanceData, direction, handlePtr)
    ClientData instanceData;
    int direction;
    ClientData *handlePtr;
{
    Tcl_Channel channelPtr = ((ExpSpawnState *)instanceData)->channelPtr;

    return (Tcl_GetChannelType(channelPtr)->getHandleProc)
	(Tcl_GetChannelInstanceData(channelPtr), direction, handlePtr);
}

/*
 *----------------------------------------------------------------------
 *
 * ExpSpawnWatch --
 * ExpSpawnWatchProc --
 *
 *	Sets up event handling on a expect console Tcl_Channel using
 *	the underlying channel type.
 *
 * Results:
 *	Nothing
 *
 * Side Effects
 *	None.
 *
 *----------------------------------------------------------------------
 */

void
ExpSpawnWatch(instanceData, mask)
ExpSpawnWatchProc(instanceData, mask)
    ClientData instanceData;
    int mask;
{
    Tcl_Channel channelPtr = ((ExpSpawnState *)instanceData)->channelPtr;

    (Tcl_GetChannelType(channelPtr)->watchProc)
	(Tcl_GetChannelInstanceData(channelPtr), mask);
    return;
}






Added generic/expStubInit.c.












































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/* 
 * expStubInit.c --
 *
 *	This file contains the initializers for the Expect stub vectors.
 *
 * RCS: @(#) $Id: tclStubInit.c,v 1.62 2001/10/15 20:26:58 andreas_kupries Exp $
 */

#include "expInt.h"
#include "expPort.h"

/*
 * WARNING: The contents of this file is automatically generated by the
 * $(TCLROOT)/tools/genStubs.tcl script. Any modifications to the function declarations
 * below should be made in the generic/exp.decls script.
 */

/* !BEGIN!: Do not edit below this line. */

ExpPlatStubs expPlatStubs = {
    TCL_STUB_MAGIC,
    NULL,
};

static ExpStubHooks expStubHooks = {
    &expPlatStubs,
    &expIntStubs,
    &expIntPlatStubs
};

ExpStubs expStubs = {
    TCL_STUB_MAGIC,
    &expStubHooks,
    Expect_Init, /* 0 */
    Expect_SafeInit, /* 1 */
};

/* !END!: Do not edit above this line. */






Deleted generic/exp_command.h.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410




























































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

/*
 * exp_command.h --
 *
 *	Definitions for expect commands
 *
 * Written by: Don Libes, NIST, 2/6/90
 *
 * Design and implementation of this program was paid for by U.S. tax
 * dollars.  Therefore it is public domain.  However, the author and NIST
 * would appreciate credit if this program or parts of it are used.
 */

#ifndef _EXP_COMMAND_H
#define _EXP_COMMAND_H

EXTERN struct exp_f *	exp_update_master _ANSI_ARGS_((Tcl_Interp *,int,int));
EXTERN char *		exp_get_var _ANSI_ARGS_((Tcl_Interp *,char *));

EXTERN int exp_default_match_max;
EXTERN int exp_default_parity;
EXTERN int exp_default_rm_nulls;

EXTERN int		exp_one_arg_braced _ANSI_ARGS_((char *));
EXTERN int		exp_eval_with_one_arg _ANSI_ARGS_((ClientData,
				Tcl_Interp *,char **));
EXTERN void		exp_lowmemcpy _ANSI_ARGS_((char *,char *,int));

EXTERN int exp_flageq_code _ANSI_ARGS_((char *,char *,int));

#define exp_flageq(flag,string,minlen) \
(((string)[0] == (flag)[0]) && (exp_flageq_code(((flag)+1),((string)+1),((minlen)-1))))

/* exp_flageq for single char flags */
#define exp_flageq1(flag,string) \
	((string[0] == flag) && (string[1] == '\0'))

/*
 * The type of the status returned by wait varies from UNIX system
 * to UNIX system.  The macro below defines it:
 * (stolen from tclUnix.h)
 */

#define WAIT_STATUS_TYPE int
#if 0
#ifdef AIX
#   define WAIT_STATUS_TYPE pid_t
#else
#ifndef NO_UNION_WAIT
#   define WAIT_STATUS_TYPE union wait
#else
#   define WAIT_STATUS_TYPE int
#endif
#endif /* AIX */

#endif /* 0 */

/* These macros are suggested by the autoconf documentation. */

#undef WIFEXITED
#ifndef WIFEXITED
#   define WIFEXITED(stat)  (((stat) & 0xff) == 0)
#endif

#undef WEXITSTATUS
#ifndef WEXITSTATUS
#   define WEXITSTATUS(stat) (((stat) >> 8) & 0xff)
#endif

#undef WIFSIGNALED
#ifndef WIFSIGNALED
#   define WIFSIGNALED(stat) ((stat) && ((stat) == ((stat) & 0x00ff)))
#endif

#undef WTERMSIG
#ifndef WTERMSIG
#   define WTERMSIG(stat)    ((stat) & 0x7f)
#endif

#undef WIFSTOPPED
#ifndef WIFSTOPPED
#   define WIFSTOPPED(stat)  (((stat) & 0xff) == 0177)
#endif

#undef WSTOPSIG
#ifndef WSTOPSIG
#   define WSTOPSIG(stat)    (((stat) >> 8) & 0xff)
#endif



#define EXP_SPAWN_ID_VARNAME		"spawn_id"
#define EXP_SPAWN_OUT			"spawn_out"

#define EXP_SPAWN_ID_ANY_VARNAME	"any_spawn_id"
#define EXP_SPAWN_ID_ANY		"exp_any"

#define EXP_SPAWN_ID_ERROR		"stderr"
#define EXP_SPAWN_ID_USER		"exp_user"

#define EXP_NOPID	0	/* Used when there is no associated pid to */
				/* wait for.  For example: */
				/* 1) When fd opened by someone else, e.g., */
				/* Tcl's open */
				/* 2) When entry not in use */
				/* 3) To tell user pid of "spawn -open" */
				/* 4) stdin, out, error */

#define EXP_NOFD	-1

/* these are occasionally useful to distinguish between various expect */
/* commands and are also used as array indices into the per-fd eg[] arrays */
#define EXP_CMD_BEFORE	0
#define EXP_CMD_AFTER	1
#define EXP_CMD_BG	2
#define EXP_CMD_FG	3

/* each process is associated with a 'struct exp_f'.  An array of these */
/* ('exp_fs') keeps track of all processes.  They are indexed by the true fd */
/* to the master side of the pty */
struct exp_f {
	char *spawnId;	/* Spawn identifier name */
	Tcl_HashEntry *hashPtr;	/* The hash entry with this structure */
	Tcl_Interp *interp;
	int pid;	/* pid or EXP_NOPID if no pid */
	Tcl_Pid tclPid;	/* The pid that tcl wants */
	char *buffer;	/* input buffer */
	char *lower;	/* input buffer in lowercase */
	int size;	/* current size of data */
	int msize;	/* size of buffer (true size is one greater
			 * for trailing null) */
	int umsize;	/* user view of size of buffer */
	int rm_nulls;	/* if nulls should be stripped before pat matching */
	int valid;	/* if any of the other fields should be believed */
	int user_closed;/* if user has issued "close" command or close has */
			/* occurred implicitly */
	int user_waited;/* if user has issued "wait" command */
	int sys_waited;	/* if wait() (or variant) has been called */
	WAIT_STATUS_TYPE wait;	/* raw status from wait() */
	int parity;	/* strip parity if false */
	int printed;	/* # of characters written to stdout (if logging on) */
			/* but not actually returned via a match yet */
	int echoed;	/* additional # of chars (beyond "printed" above) */
			/* echoed back but not actually returned via a match */
			/* yet.  This supports interact -echo */
	int key;	/* unique id that identifies what command instance */
			/* last touched this buffer */
	int force_read;	/* force read to occur (even if buffer already has */
			/* data).  This supports interact CAN_MATCH */
	int fg_armed;	/* If Tk_CreateFileHandler is active for responding */
			/* to foreground events */
#ifdef _WIN32
	OVERLAPPED over;	/* Overlapped result */
#endif
	Tcl_Channel channel;	/* Tcl channel */
	Tcl_Channel Master;	/* corresponds to master fd */
	/*
	 *  explicit fds aren't necessary now, but since the code is already
	 *  here from before Tcl required TclFile, we'll continue using
	 *  the old fds.  If we ever port this code to a non-UNIX system,
	 *  we'll dump the fds totally.
	 */
	   
	int slave_fd;	/* slave fd if "spawn -pty" used */
#ifdef HAVE_PTYTRAP
	char *slave_name;/* Full name of slave, i.e., /dev/ttyp0 */
#endif /* HAVE_PTYTRAP */
	int leaveopen;	/* If we should not call Tcl's close when we close -
			 * only relevant if Tcl does the original open.  It
			 * also serves as a ref count to how many times this
			 * channel has been opened with spawn -leaveopen */
	int alwaysopen;	/* Set if this is identifier that should always exist */
	Tcl_Interp *bg_interp;	/* interp to process the bg cases */
	int bg_ecount;		/* number of background ecases */
	enum {
		blocked,	/* blocked because we are processing the */
				/* file handler */
		armed,		/* normal state when bg handler in use */
		unarmed,	/* no bg handler in use */
		disarm_req_while_blocked	/* while blocked, a request */
				/* was received to disarm it.  Rather than */
				/* processing the request immediately, defer */
				/* it so that when we later try to unblock */
				/* we will see at that time that it should */
				/* instead be disarmed */
	} bg_status;

	int matched;		/* Chars matched.  Used by expectlib */
	Tcl_ChannelProc *event_proc; /* Currently installed channel handler */
	ClientData event_data; /* Argument that was installed */
};

#define EXP_TEMPORARY	1	/* expect */
#define EXP_PERMANENT	2	/* expect_after, expect_before, expect_bg */

#define EXP_DIRECT	1
#define EXP_INDIRECT	2

/*
 * Table of struct exp_f
 */
EXTERN Tcl_HashTable *exp_f_table;

EXTERN struct exp_f *exp_f_any;

EXTERN struct exp_f *	exp_chan2f _ANSI_ARGS_((Tcl_Interp *,char *,int,int,char *));
EXTERN int		exp_fcheck _ANSI_ARGS_((Tcl_Interp *, struct exp_f *,
			    int,int,char *));
EXTERN void		exp_adjust _ANSI_ARGS_((struct exp_f *));
EXTERN void		exp_buffer_shuffle _ANSI_ARGS_((Tcl_Interp *,struct exp_f *,int,char *,char *));
EXTERN int		exp_close_fd _ANSI_ARGS_((Tcl_Interp *,int));
EXTERN int		exp_close _ANSI_ARGS_((Tcl_Interp *,struct exp_f *));
EXTERN void		exp_close_all _ANSI_ARGS_((Tcl_Interp *));
EXTERN void		exp_ecmd_remove_f_direct_and_indirect 
				_ANSI_ARGS_((Tcl_Interp *,struct exp_f *));
EXTERN void		exp_trap_on _ANSI_ARGS_((int));
EXTERN int		exp_trap_off _ANSI_ARGS_((char *));

EXTERN void		exp_strftime();

#define exp_deleteProc ((Tcl_CmdDeleteProc *) NULL)

EXTERN int expect_key;
EXTERN int exp_configure_count;	/* # of times descriptors have been closed */
				/* or indirect lists have been changed */
EXTERN int exp_nostack_dump;	/* TRUE if user has requested unrolling of */
				/* stack with no trace */

EXTERN void		exp_init_pty _ANSI_ARGS_((Tcl_Interp *));
EXTERN void		exp_pty_exit _ANSI_ARGS_((void));
EXTERN void		exp_init_tty _ANSI_ARGS_((Tcl_Interp *));
EXTERN void		exp_init_stdio _ANSI_ARGS_((void));
/*EXTERN void		exp_init_expect _ANSI_ARGS_((Tcl_Interp *));*/
EXTERN void		exp_init_spawn_ids _ANSI_ARGS_((Tcl_Interp *));
EXTERN void		exp_init_spawn_id_vars _ANSI_ARGS_((Tcl_Interp *));
EXTERN void		exp_init_trap _ANSI_ARGS_((void));
EXTERN void		exp_init_unit_random _ANSI_ARGS_((void));
EXTERN void		exp_init_sig _ANSI_ARGS_((void));

EXTERN int		exp_tcl2_returnvalue _ANSI_ARGS_((int));
EXTERN int		exp_2tcl_returnvalue _ANSI_ARGS_((int));

EXTERN void		exp_rearm_sigchld _ANSI_ARGS_((Tcl_Interp *));
EXTERN int		exp_string_to_signal _ANSI_ARGS_((Tcl_Interp *,char *));

EXTERN char *exp_onexit_action;

#define exp_new(x)	(x *)malloc(sizeof(x))

struct exp_fs_list {
	struct exp_f *f;
	struct exp_fs_list *next;
};

/* describes a -i flag */
struct exp_i {
	int cmdtype;	/* EXP_CMD_XXX.  When an indirect update is */
			/* triggered by Tcl, this helps tell us in what */
			/* exp_i list to look in. */
	int direct;	/* if EXP_DIRECT, then the spawn ids have been given */
			/* literally, else indirectly through a variable */
	int duration;	/* if EXP_PERMANENT, char ptrs here had to be */
			/* malloc'd because Tcl command line went away - */
			/* i.e., in expect_before/after */
	char *variable;
	char *value;	/* if type == direct, this is the string that the */
			/* user originally supplied to the -i flag.  It may */
			/* lose relevance as the fs_list is manipulated */
			/* over time.  If type == direct, this is  the */
			/* cached value of variable use this to tell if it */
			/* has changed or not, and ergo whether it's */
			/* necessary to reparse. */

	int ecount;	/* # of ecases this is used by */

	struct exp_fs_list *fs_list;
	struct exp_i *next;
};

EXTERN struct exp_i *	exp_new_i_complex _ANSI_ARGS_((Tcl_Interp *,
			    char *, int, Tcl_VarTraceProc *, char *));
EXTERN struct exp_i *	exp_new_i_simple _ANSI_ARGS_((struct exp_f *,int));
EXTERN struct exp_fs_list *exp_new_fs _ANSI_ARGS_((struct exp_f *));
EXTERN void		exp_free_i _ANSI_ARGS_((Tcl_Interp *,struct exp_i *,
			    Tcl_VarTraceProc *));
EXTERN void		exp_free_fs _ANSI_ARGS_((struct exp_fs_list *));
EXTERN void		exp_free_fs_single _ANSI_ARGS_((struct exp_fs_list *));
EXTERN void		exp_i_update _ANSI_ARGS_((Tcl_Interp *,
			    struct exp_i *));

/*
 * definitions for creating commands
 */

#define EXP_NOPREFIX	1	/* don't define with "exp_" prefix */
#define EXP_REDEFINE	2	/* stomp on old commands with same name */

struct exp_cmd_data {
	char		*name;
	Tcl_CmdProc	*proc;
	ClientData	data;
	int 		flags;
};

EXTERN int		ExpPlatformSpawnOutput _ANSI_ARGS_((
			    ClientData instanceData, char *bufPtr,
			    int toWrite, int *errorPtr));
EXTERN void		exp_create_commands _ANSI_ARGS_((Tcl_Interp *,
			    struct exp_cmd_data *));
EXTERN void		exp_init_main_cmds _ANSI_ARGS_((Tcl_Interp *));
EXTERN void		exp_init_expect_cmds _ANSI_ARGS_((Tcl_Interp *));
EXTERN void		exp_init_most_cmds _ANSI_ARGS_((Tcl_Interp *));
EXTERN void		exp_init_trap_cmds _ANSI_ARGS_((Tcl_Interp *));
EXTERN void		exp_init_interact_cmds _ANSI_ARGS_((Tcl_Interp *));
EXTERN int		exp_init_tty_cmds _ANSI_ARGS_((Tcl_Interp *));
EXTERN int		exp_getpidproc _ANSI_ARGS_((void));
EXTERN void		exp_busy _ANSI_ARGS_((int));
EXTERN int		exp_exact_write _ANSI_ARGS_((struct exp_f *,
			    char *, int));
EXTERN void		exp_sys_close _ANSI_ARGS_((int, struct exp_f *));
EXTERN struct exp_f *	exp_f_find _ANSI_ARGS_ ((Tcl_Interp *, char *));
EXTERN struct exp_f *	exp_f_new _ANSI_ARGS_((Tcl_Interp *, Tcl_Channel,
			    char *, int));
EXTERN int		exp_f_new_platform _ANSI_ARGS_((struct exp_f *));
EXTERN void		exp_f_free _ANSI_ARGS_((struct exp_f *));
EXTERN void		exp_f_free_platform _ANSI_ARGS_((struct exp_f *));

EXTERN Tcl_Channel	ExpCreatePairChannel _ANSI_ARGS_((Tcl_Interp *,
			    char *, char *, char *chanName));
EXTERN int		ExpSpawnOpen _ANSI_ARGS_((Tcl_Interp *, char *, int));

EXTERN int		Exp_CloseCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Exp_DebugCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Exp_DisconnectCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Exp_ExitCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Exp_ExpContinueCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Exp_ExpContinueDeprecatedCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Exp_ExpInternalCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Exp_ExpPidCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Exp_ExpectCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Exp_ExpectGlobalCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Exp_ExpVersionCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Exp_ForkCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Exp_GetpidDeprecatedCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Exp_InterReturnCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Exp_InterpreterCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Exp_KillCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Exp_LogFileCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Exp_LogUserCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Exp_MatchMaxCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Exp_OpenCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Exp_OverlayCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Exp_ParityCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Exp_Prompt1Cmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Exp_Prompt2Cmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Exp_RemoveNullsCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Exp_SendCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Exp_SendCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Exp_SendCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Exp_SendCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Exp_SendCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Exp_SendLogCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Exp_SleepCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Exp_SpawnCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Exp_StraceCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Exp_SttyCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Exp_SystemCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Exp_TimestampCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Exp_TrapCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));
EXTERN int		Exp_WaitCmd _ANSI_ARGS_((ClientData clientData,
			    Tcl_Interp *interp, int argc, char **argv));

#endif /* _EXP_COMMAND_H */






Changes to generic/exp_event.c.





1
2
3
4
5
6
7


8
9
10
11
12
13
14
15
16

17
18
19
20
21
22
23
24
25
26
27
28



29
30
31
32
33
34
35
36
37

38
39
40
41
42
43


44
45
46
47
48
49
50
51
52
53
54


55
56
57
58
59
60
61
62
63
64



65
66

67
68
69

70
71
72
73
74
75

76
77
78
79
80
81
82

83
84
85
86
87


88
89
90

91
92
93
94





95
96
97
98
99

100
101
102

103
104
105
106
107
108



109
110
111
112

113
114
115
116

117
118
119
120

121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148


149
150
151

152
153
154
155
156
157
158
159

160
161
162


163
164

165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186


187
188
189
190
191
192
193
194
195
196
197
198











199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221


222
223
224
225
226
227
228
229
230
231
232
233
234












235
236
237
238
239
240
241
242
243
244
245
246



247
248
249
250
251
252
253
254
255
256
257
258
259


260
261
262
263
264
265
266
267
268
269
270










271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313


314
315
316
317
318
319
320
321














322
323
324


325
326
327


328
329
330


331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349

350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375


376
377
378
379
380
381
382
383
384
385






386







387
388
389


390
391
392
393
394
395



396
397

398
399
400
401
402
403
404
405
406
407

408
409

410
411
412
413



414
415
416

417


418
419
420
421
422

423
424

425
426
427
428









429
430
431

432
433
434
435
436
437


438

439
440
441
442
443
444
445
446
447
448


















449
450
451












452
453
454
455
456
457
458
459









460
461
462

463
464
465
466
467
468
469






470
471
472
473

474



475
476


477
478
479
480
481
482
483
484
485








486
487
488
489
490
491





492
493
494
495
496



497
498

499
500
501
502
503
504
505




506
507
508
509
510



511
512


513



514
515
516
517
518
519

520
521
522

523
524

525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581



582
583
584
585
586
587
588


589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621

622
623

624
625

626
627
628

629
630

631
632
633
634


635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672

673
674
675
676
677
678
679
680
681
682
683
684
685



686
687

1
2
3
4



5
6
7
8
9






10












11
12
13



14





15






16
17








18


19
20










21
22
23


24



25






26







27





28
29



30




31
32
33
34
35





36



37


38



39
40
41

42


43




44




45

























46


47
48
49


50








51



52
53
54

55
56
57

















58


59
60
61











62
63
64
65
66
67
68
69
70
71
72
73
74
75

















76


77
78
79












80
81
82
83
84
85
86
87
88
89
90
91
92
93
94









95
96
97










98


99
100
101










102
103
104
105
106
107
108
109
110
111
112
113
114








































115
116








117
118
119
120
121
122
123
124
125
126
127
128
129
130



131
132
133


134
135
136


137
138
139
140
141
















142
143
144
145
146
147
148
149



















150
151
152
153
154







155
156
157
158
159
160
161
162
163
164
165
166
167
168
169


170
171






172
173
174


175










176
177

178
179



180
181
182
183
184
185
186

187
188
189
190
191
192

193
194

195




196
197
198
199
200
201
202
203
204


205
206
207
208
209
210


211
212
213
214










215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232



233
234
235
236
237
238
239
240
241
242
243
244








245
246
247
248
249
250
251
252
253



254



255



256
257
258
259
260
261




262
263
264
265
266


267
268









269
270
271
272
273
274
275
276
277





278
279
280
281
282





283
284
285


286







287
288
289
290





291
292
293


294
295

296
297
298
299





300

301

302
303

304
305
























































306
307
308
309
310
311
312
313


314
315
316
317
318
319
320
321
322
323


















324
325
326
327
328
329

330
331

332
333

334
335


336


337




338
339






340

















341
342
343
344
345
346
347
348






349










350
351
352
353
354
355
356
357





-
-
-
+
+



-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
-
-
-

-
-
-
-
-
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-

-
-
+
+
-
-
-
-
-
-
-
-
-
-
+
+
+
-
-
+
-
-
-
+
-
-
-
-
-
-
+
-
-
-
-
-
-
-
+
-
-
-
-
-
+
+
-
-
-
+
-
-
-
-
+
+
+
+
+
-
-
-
-
-
+
-
-
-
+
-
-

-
-
-
+
+
+
-

-
-
+
-
-
-
-
+
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
-
+
+

-
-
+
-
-
-
-
-
-
-
-
+
-
-
-
+
+

-
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
-
+
+

-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+



-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
-
+
+

-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+



-
-
-
-
-
-
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-

-
-
+
+

-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+



-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+

-
-
+
+

-
-
+
+



-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+







-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+



-
-
-
-
-
-
-
+
+
+
+
+
+

+
+
+
+
+
+
+

-
-
+
+
-
-
-
-
-
-
+
+
+
-
-
+
-
-
-
-
-
-
-
-
-
-
+

-
+

-
-
-
+
+
+



+
-
+
+




-
+

-
+
-
-
-
-
+
+
+
+
+
+
+
+
+
-
-

+




-
-
+
+

+
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
-
-
-
+
-
-
-

-
-
-
+
+
+
+
+
+
-
-
-
-
+

+
+
+
-
-
+
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+
-
-
-
-
-
+
+
+
-
-
+
-
-
-
-
-
-
-
+
+
+
+
-
-
-
-
-
+
+
+
-
-
+
+
-
+
+
+

-
-
-
-
-
+
-

-
+

-
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+





-
-
+
+








-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-






-
+

-
+

-
+

-
-
+
-
-
+
-
-
-
-
+
+
-
-
-
-
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-








-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-



+
+
+



/* exp_event.c - event interface for Expect

Written by: Don Libes, NIST, 2/6/90

Design and implementation of this program was paid for by U.S. tax
dollars.  Therefore it is public domain.  However, the author and NIST
would appreciate credit if this program or parts of it are used.
I hereby place this software in the public domain.  However, the author and
NIST would appreciate credit if this program or parts of it are used.

*/

/* Notes:
I'm only a little worried because Tk does not check for errno == EBADF
after calling select.  I imagine that if the user passes in a bad file
descriptor, we'll never get called back, and thus, we'll hang forever
- it would be better to at least issue a diagnostic to the user.

//#include "expect_cf.h"
Another possible problem: Tk does not do file callbacks round-robin.

Another possible problem: Calling Create/DeleteChannelHandler
before/after every Tcl_Eval... in expect/interact could be very
expensive.

*/


#include "tcl.h"
#include "tclPort.h"
#include "exp_port.h"
#include <stdio.h>
#include <errno.h>
#include <sys/types.h>
#include "exp_prog.h"
#include "exp_command.h"	/* for struct exp_f defs */
#include "exp_event.h"

/* Tcl_DoOneEvent will call our filehandler which will set the following */
/* vars enabling us to know where and what kind of I/O we can do */
/*#define EXP_SPAWN_ID_BAD	-1*/
/*#define EXP_SPAWN_ID_TIMEOUT	-2*/	/* really indicates a timeout */

#ifdef HAVE_SYS_WAIT_H
static struct exp_f *ready_fs = NULL;
/* static int ready_fd = EXP_SPAWN_ID_BAD; */
static int ready_mask;
static int default_mask = TCL_READABLE | TCL_EXCEPTION;


#include <sys/wait.h>
#endif
/*
 * Declarations for functions used only in this file.
 */

static void		exp_timehandler _ANSI_ARGS_ ((ClientData clientData));
static void		exp_filehandler _ANSI_ARGS_ ((ClientData clientData,
			    int mask));
static void		exp_event_exit_real _ANSI_ARGS_ ((Tcl_Interp *interp));


/*
#ifdef HAVE_PTYTRAP
#  include <sys/ptyio.h>
 *----------------------------------------------------------------------
 *
 * exp_event_disarm --
 *
 *	Completely remove the filehandler for this process
 *
 * Results:
 *	None
 *
 * Side Effects:
#endif

#include "expInt.h"
 *	Events will no longer be reported for this process
 *

 *----------------------------------------------------------------------
 */

typedef struct ThreadSpecificData {
void
exp_event_disarm(f)
    struct exp_f *f;
{
    Tcl_Channel channel;

    int rr;		/* round robin ptr */
    channel = f->Master;
    if (! channel) {
	channel = f->channel;
    }
    Tcl_DeleteChannelHandler(channel, f->event_proc, f->event_data);
    f->event_proc = NULL;

} ThreadSpecificData;
    /* remember that filehandler has been disabled so that */
    /* it can be turned on for fg expect's as well as bg */
    f->fg_armed = FALSE;
}


static Tcl_ThreadDataKey dataKey;
/*
 *----------------------------------------------------------------------
 *

 * exp_event_disarm_fast --
 *
 *	Temporarily disable the filehandler for this process.  This
 *	is quicker than calling exp_event_disasrm as it reduces the

/* Local Prototypes used only in this file */
static Tcl_FileProc	exp_channelhandler;
static Tcl_TimerProc	exp_timehandler;
static void exp_event_exit_real _ANSI_ARGS_((Tcl_Interp *interp));
 *	calls to malloc() and free() inside Tcl_...FileHandler.
 *
 * Results:
 *	None
 *

 * Side Effects:
 *	Events will no longer be reported for this process
 *

 *----------------------------------------------------------------------
 */

static void
exp_event_disarm_fast(f,filehandler)
    struct exp_f *f;
void
exp_event_disarm_bg(esPtr)
    ExpState *esPtr;
    Tcl_ChannelProc *filehandler;
{
    Tcl_Channel channel;

    Tcl_DeleteChannelHandler(esPtr->channel,exp_background_channelhandler,(ClientData)esPtr);
    channel = f->Master;
    if (! channel) {
	channel = f->channel;
    }
}
    /* Tk insists on having a valid proc here even though it isn't used */
    if (f->event_proc) {
	Tcl_DeleteChannelHandler(channel,f->event_proc,f->event_data);
    }

    Tcl_CreateChannelHandler(channel,0,filehandler,(ClientData)0);
    f->event_proc = filehandler;
    f->event_data = 0;

    /* remember that filehandler has been disabled so that */
    /* it can be turned on for fg expect's as well as bg */
    f->fg_armed = FALSE;
}

/*
 *----------------------------------------------------------------------
 *
 * exp_arm_background_filehandler_force --
 *
 *	Always installs a background filehander
 *
 * Results:
 *	None
 *
 * Side Effects:
 *	Background events will be reported for this process
 *
 *----------------------------------------------------------------------
 */

static void
exp_arm_background_filehandler_force(f)
    struct exp_f *f;
exp_arm_background_channelhandler_force(esPtr)
    ExpState *esPtr;
{
    Tcl_Channel channel;

    Tcl_CreateChannelHandler(esPtr->channel,
    channel = f->Master;
    if (! channel) {
	channel = f->channel;
    }
    if (f->event_proc) {
	Tcl_DeleteChannelHandler(channel,f->event_proc,f->event_data);
    }
    Tcl_CreateChannelHandler(channel, TCL_READABLE|TCL_EXCEPTION,
	    TCL_READABLE|TCL_EXCEPTION,
	exp_background_filehandler, (ClientData) f);
    f->event_proc = exp_background_filehandler;
    f->event_data = (ClientData) f;
	    exp_background_channelhandler,
	    (ClientData)esPtr);

    f->bg_status = armed;
    esPtr->bg_status = armed;
}

/*
 *----------------------------------------------------------------------
 *
 * exp_arm_background_filehandler --
 *
 *	Installs a background filehandler if it hasn't already been
 *	installed or if it was disabled.
 *
 * Results:
 *	None
 *
 * Side Effects:
 *	Background events will be reported for this process
 *
 *----------------------------------------------------------------------
 */

void
exp_arm_background_filehandler(f)
    struct exp_f *f;
exp_arm_background_channelhandler(esPtr)
    ExpState *esPtr;
{
    switch (f->bg_status) {
    case unarmed:
	exp_arm_background_filehandler_force(f);
	break;
    case disarm_req_while_blocked:
	f->bg_status = blocked;	/* forget request */
	break;
    case armed:
    case blocked:
	/* do nothing */
	break;
    switch (esPtr->bg_status) {
	case unarmed:
	    exp_arm_background_channelhandler_force(esPtr);
	    break;
	case disarm_req_while_blocked:
	    esPtr->bg_status = blocked;	/* forget request */
	    break;
	case armed:
	case blocked:
	    /* do nothing */
	    break;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * exp_disarm_background_filehandler --
 *
 *	Removes a background filehandler if it was previously installed
 *	and armed.
 *
 * Results:
 *	None
 *
 * Side Effects:
 *	Background events will no longer be reported for this process
 *
 *----------------------------------------------------------------------
 */

void
exp_disarm_background_filehandler(f)
    struct exp_f *f;
exp_disarm_background_channelhandler(esPtr)
    ExpState *esPtr;
{
    switch (f->bg_status) {
    case blocked:
	f->bg_status = disarm_req_while_blocked;
	break;
    case armed:
	f->bg_status = unarmed;
	exp_event_disarm(f);
	break;
    case disarm_req_while_blocked:
    case unarmed:
	/* do nothing */
	break;
    switch (esPtr->bg_status) {
	case blocked:
	    esPtr->bg_status = disarm_req_while_blocked;
	    break;
	case armed:
	    esPtr->bg_status = unarmed;
	    exp_event_disarm_bg(esPtr);
	    break;
	case disarm_req_while_blocked:
	case unarmed:
	    /* do nothing */
	    break;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * exp_disarm_background_filehandler_force --
 *
 *	Removes a background filehandler if it was previously installed,
 *	ignoring block status.  Called from exp_close().  After exp_close
 *	returns, we will not have an opportunity to disarm because the fd
 *	will be invalid, so we force it here.
/* ignore block status and forcibly disarm handler - called from exp_close. */
/* After exp_close returns, we will not have an opportunity to disarm */
/* because the fd will be invalid, so we force it here. */
 *
 * Results:
 *	None
 *
 * Side Effects:
 *	Background events will no longer be reported for this process
 *
 *----------------------------------------------------------------------
 */

void
exp_disarm_background_filehandler_force(f)
    struct exp_f *f;
exp_disarm_background_channelhandler_force(esPtr)
    ExpState *esPtr;
{
    switch (f->bg_status) {
    case blocked:
    case disarm_req_while_blocked:
    case armed:
	f->bg_status = unarmed;
	exp_event_disarm(f);
	break;
    case unarmed:
	/* do nothing */
	break;
    switch (esPtr->bg_status) {
	case blocked:
	case disarm_req_while_blocked:
	case armed:
	    esPtr->bg_status = unarmed;
	    exp_event_disarm_bg(esPtr);
	    break;
	case unarmed:
	    /* do nothing */
	    break;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * exp_unblock_background_filehandler --
 *
 *	Unblocks the background filehandler.
 *	This can only be called at the end of the bg handler in which
 *	case we know the status is some kind of "blocked"
 *
 * Results:
 *	None
 *
 * Side Effects:
 *
 *
 *----------------------------------------------------------------------
 */

void
exp_unblock_background_filehandler(f)
    struct exp_f *f;
{
    switch (f->bg_status) {
    case blocked:
	exp_arm_background_filehandler_force(f);
	break;
    case disarm_req_while_blocked:
	exp_disarm_background_filehandler_force(f);
	break;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * exp_block_background_filehandler --
 *
 *	Blocks the background filehandler.
 *	This can only be called at the end of the bg handler in which
 *	case we know the status is some kind of "armed"
/* this can only be called at the end of the bg handler in which */
/* case we know the status is some kind of "blocked" */
 *
 * Results:
 *	None
 *
 * Side Effects:
 *	Temporarily removes the filehandler, so events will stop
 *	being reported for this process.
 *
void
exp_unblock_background_channelhandler(esPtr)
    ExpState *esPtr;
{
    switch (esPtr->bg_status) {
	case blocked:
	    exp_arm_background_channelhandler_force(esPtr);
	    break;
	case disarm_req_while_blocked:
	    exp_disarm_background_channelhandler_force(esPtr);
	    break;
    }
}

 *----------------------------------------------------------------------
 */

/* this can only be called at the beginning of the bg handler in which */
/* case we know the status must be "armed" */
void
exp_block_background_filehandler(f)
    struct exp_f *f;
exp_block_background_channelhandler(esPtr)
    ExpState *esPtr;
{
    f->bg_status = blocked;
    exp_event_disarm_fast(f,exp_background_filehandler);
    esPtr->bg_status = blocked;
    exp_event_disarm_bg(esPtr);
}


/*
 *----------------------------------------------------------------------
 *
 * exp_timehandler --
 *
 *	Tcl calls this routine when timer we have set has expired.
 *
 * Results:
 *	None
 *
 * Side Effects:
 *	A flag is set.
 *
 *----------------------------------------------------------------------
 */

/*ARGSUSED*/
static void
exp_timehandler(clientData)
    ClientData clientData;
{
    *(int *)clientData = TRUE;	
}

/*
 *----------------------------------------------------------------------
 *
 * exp_filehandler --
 *
 *	Tcl calls this routine when some data is available on a
 *	channel.
 *
 * Results:
 *	None
 *
 * Side Effects:
 *	Sets the global value of what process is ready.  This is
 *	checked at the return of Tcl_DoOneEvent().
 *
 *----------------------------------------------------------------------
 */

static void exp_filehandler(clientData,mask)
static void
exp_channelhandler(clientData,mask)
    ClientData clientData;
    int mask;
{
    /*
     * if input appears, record the fd on which it appeared
     */
    ready_fs = (struct exp_f *) clientData;
    /* ready_fd = *(int *)clientData; */
    ready_mask = mask;
    exp_event_disarm_fast(ready_fs,exp_filehandler);
    ExpState *esPtr = (ExpState *)clientData;

    esPtr->notified = TRUE;
    esPtr->notifiedMask = mask;

    exp_event_disarm_fg(esPtr);
}

void
exp_event_disarm_fg(esPtr)
    ExpState *esPtr;
{
    /*printf("DeleteChannelHandler: %s\r\n",esPtr->name);*/
    Tcl_DeleteChannelHandler(esPtr->channel,exp_channelhandler,(ClientData)esPtr);

/*
 *----------------------------------------------------------------------
    /* remember that ChannelHandler has been disabled so that */
    /* it can be turned on for fg expect's as well as bg */
 *
 * exp_get_next_event --
 *
 *	Waits for the next event that expect is registered an
 *	interest in.
 *
    esPtr->fg_armed = FALSE;
}

 * Results:
 *	Returns status, one of EOF, TIMEOUT, ERROR, DATA or RECONFIGURE
/* returns status, one of EOF, TIMEOUT, ERROR or DATA */
 *
 * Side Effects: 
 *	Other event handlers outside of Expect may be run as well
 *
 * Notes:
 *	This still needs some work to run properly under NT
 *
 *----------------------------------------------------------------------
 */

/* can now return RECONFIGURE, too */
/*ARGSUSED*/
int exp_get_next_event(interp,masters, n,master_out,timeout,key)
int exp_get_next_event(interp,esPtrs,n,esPtrOut,timeout,key)
    Tcl_Interp *interp;
    struct exp_f **masters;	/* Array of expect process structures */
    int n;			/* # of masters */
    struct exp_f **master_out;	/* 1st ready master, not set if none */
    ExpState *(esPtrs[]);
    int n;			/* # of esPtrs */
    ExpState **esPtrOut;	/* 1st ready esPtr, not set if none */
    int timeout;		/* seconds */
    int key;
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    static rr = 0;	/* round robin ptr */

    ExpState *esPtr;
    int i;	/* index into in-array */
#ifdef HAVE_PTYTRAP
    struct request_info ioctl_info;
#endif
    

    int old_configure_count = exp_configure_count;
    

    int timer_created = FALSE;
    int timer_fired = FALSE;
    Tcl_TimerToken timetoken;/* handle to Tcl timehandler descriptor */
    
    int timerFired = FALSE;
    Tcl_TimerToken timerToken = 0;/* handle to Tcl timehandler descriptor */
    /* We must delete any timer before returning.  Doing so throughout
     * the code makes it unreadable; isolate the unreadable nonsense here.
     */
#define RETURN(x) { \
	if (timerToken) Tcl_DeleteTimerHandler(timerToken); \
	return(x); \
    }
    for (;;) {
	struct exp_f *f;

    for (;;) {
	/* if anything has been touched by someone else, report that */
	/* an event has been received */

	for (i=0;i<n;i++) {
	    rr++;
	    if (rr >= n) rr = 0;
	    tsdPtr->rr++;
	    if (tsdPtr->rr >= n) tsdPtr->rr = 0;

	    esPtr = esPtrs[tsdPtr->rr];
	    f = masters[rr];
	    if (f->key != key) {
		f->key = key;
		f->force_read = FALSE;
		*master_out = f;
		return(EXP_DATA_OLD);
	    } else if ((!f->force_read) && (f->size != 0)) {
		*master_out = f;
		return(EXP_DATA_OLD);
	    }

	    if (esPtr->key != key) {
		esPtr->key = key;
		esPtr->force_read = FALSE;
		*esPtrOut = esPtr;
		RETURN(EXP_DATA_OLD);
	    } else if ((!esPtr->force_read) && (!expSizeZero(esPtr))) {
		*esPtrOut = esPtr;
		RETURN(EXP_DATA_OLD);
	    } else if (esPtr->notified) {
		/* this test of the mask should be redundant but SunOS */
		/* raises both READABLE and EXCEPTION (for no */
		/* apparent reason) when selecting on a plain file */
		if (esPtr->notifiedMask & TCL_READABLE) {
		    *esPtrOut = esPtr;
		    esPtr->notified = FALSE;
		    RETURN(EXP_DATA_NEW);
		}
	}

	if (!timer_created) {
		/*
		 * at this point we know that the event must be TCL_EXCEPTION
		 * indicating either EOF or HP ptytrap.
		 */
#ifndef HAVE_PTYTRAP
		RETURN(EXP_EOF);
#else
		if (ioctl(esPtr->fdin,TIOCREQCHECK,&ioctl_info) < 0) {
		    expDiagLog("ioctl error on TIOCREQCHECK: %s", Tcl_PosixError(interp));
		    RETURN(EXP_TCLERROR);
		}
		if (ioctl_info.request == TIOCCLOSE) {
	    if (timeout >= 0) {
		timetoken = Tcl_CreateTimerHandler(1000*timeout,
						   exp_timehandler,
						   (ClientData)&timer_fired);
		timer_created = TRUE;
	    }
	}

		    RETURN(EXP_EOF);
		}
		if (ioctl(esPtr->fdin, TIOCREQSET, &ioctl_info) < 0) {
		    expDiagLog("ioctl error on TIOCREQSET after ioctl or open on slave: %s", Tcl_ErrnoMsg(errno));
		}
		/* presumably, we trapped an open here */
		/* so simply continue by falling thru */
#endif /* !HAVE_PTYTRAP */
	    }
	for (;;) {
	    int j;

	}
	    /* make sure that all fds that should be armed are */
	    for (j=0;j<n;j++) {
		f = masters[j];

		if (!f->fg_armed) {
		    Tcl_Channel channel;

	if (!timerToken) {
	    if (timeout >= 0) {
		timerToken = Tcl_CreateTimerHandler(1000*timeout,
			exp_timehandler,
			(ClientData)&timerFired);
	    }
		    channel = f->Master;
		    if (! channel) {
			channel = f->channel;
		    }
	}

	/* make sure that all fds that should be armed are */
	for (i=0;i<n;i++) {
	    esPtr = esPtrs[i];
		    if (f->event_proc) {
			Tcl_DeleteChannelHandler(channel,f->event_proc,
	    if (!esPtr->fg_armed) {
		/*printf("CreateChannelHandler: %s\r\n",esPtr->name);*/
			    f->event_data);
		    }
		    Tcl_CreateChannelHandler(channel, default_mask,
			exp_filehandler, (ClientData)f);
		    f->event_proc = exp_filehandler;
		    f->event_data = (ClientData) f;
		    f->fg_armed = TRUE;
		}
	    }
		Tcl_CreateChannelHandler(
					 esPtr->channel,
					 TCL_READABLE | TCL_EXCEPTION,
					 exp_channelhandler,
					 (ClientData)esPtr);
		esPtr->fg_armed = TRUE;
	    }
	}

	    Tcl_DoOneEvent(0);	/* do any event */

	    if (timer_fired) return(EXP_TIMEOUT);

	    if (old_configure_count != exp_configure_count) {
	Tcl_DoOneEvent(0);	/* do any event */
	
	if (timerFired) return(EXP_TIMEOUT);
	
	if (old_configure_count != exp_configure_count) {
		if (timer_created)
		    Tcl_DeleteTimerHandler(timetoken);
		return EXP_RECONFIGURE;
	    }

	    RETURN(EXP_RECONFIGURE);
	}
    }
	    if (ready_fs == NULL) continue;

}
	    /* if it was from something we're not looking for at */
	    /* the moment, ignore it */
	    for (j=0;j<n;j++) {
		if (ready_fs == masters[j]) goto found;
	    }

	    /* not found */

/* Having been told there was an event for a specific ExpState, get it */
/* This returns status, one of EOF, TIMEOUT, ERROR or DATA */
/*ARGSUSED*/
	    exp_event_disarm_fast(ready_fs,exp_filehandler);
	    ready_fs = NULL;
	    continue;
	found:
	    *master_out = ready_fs;
int
exp_get_next_event_info(interp,esPtr)
    Tcl_Interp *interp;
	    ready_fs = NULL;

    ExpState *esPtr;
{
	    if (timer_created) Tcl_DeleteTimerHandler(timetoken);
#ifdef HAVE_PTYTRAP
    struct request_info ioctl_info;
#endif

	    /* this test should be redundant but SunOS */
	    /* raises both READABLE and EXCEPTION (for no */
	    /* apparent reason) when selecting on a plain file */
	    if (ready_mask & TCL_READABLE) {
		return EXP_DATA_NEW;
    if (esPtr->notifiedMask & TCL_READABLE) return EXP_DATA_NEW;
	    }

	    /* ready_mask must contain TCL_EXCEPTION */
    /* ready_mask must contain TCL_EXCEPTION */
#ifndef HAVE_PTYTRAP
	    return(EXP_EOF);
    return(EXP_EOF);
#else
	    if (ioctl(*master_out,TIOCREQCHECK,&ioctl_info) < 0) {
		exp_debuglog("ioctl error on TIOCREQCHECK: %s", Tcl_PosixError(interp));
		return(EXP_TCLERROR);
	    }
	    if (ioctl_info.request == TIOCCLOSE) {
		return(EXP_EOF);
	    }
	    if (ioctl(*master_out, TIOCREQSET, &ioctl_info) < 0) {
		exp_debuglog("ioctl error on TIOCREQSET after ioctl or open on slave: %s", Tcl_ErrnoMsg(errno));
	    }
	    /* presumably, we trapped an open here */
	    continue;
#endif /* !HAVE_PTYTRAP */
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 * exp_get_next_event_info --
 *
 *	Having been told there was an event for a specific fd, get it
 *	returns status, one of EOF, TIMEOUT, ERROR or DATA
 *
 * Results:
 *	Returns EXP_DATA_NEW, EXP_EOF, of EXP_TCLERROR
 *
 * Side Effects: 
 *	None on NT or most Unices.  On HPUX, it looks like there might
 *	be some.
 *
 *----------------------------------------------------------------------
 */

/*ARGSUSED*/
int
exp_get_next_event_info(interp,f,ready_mask)
    Tcl_Interp *interp;
    struct exp_f *f;
    int ready_mask;
{
#ifdef HAVE_PTYTRAP
    struct request_info ioctl_info;
#endif
    
    if (ready_mask & TCL_READABLE) return EXP_DATA_NEW;
    
    /* ready_mask must contain TCL_EXCEPTION */
    
#ifndef HAVE_PTYTRAP
    return(EXP_EOF);
#else
    if (ioctl(f->fd,TIOCREQCHECK,&ioctl_info) < 0) {
	exp_debuglog("ioctl error on TIOCREQCHECK: %s",
		     Tcl_PosixError(interp));
    if (ioctl(esPtr->fdin,TIOCREQCHECK,&ioctl_info) < 0) {
	expDiagLog("ioctl error on TIOCREQCHECK: %s",
		Tcl_PosixError(interp));
	return(EXP_TCLERROR);
    }
    if (ioctl_info.request == TIOCCLOSE) {
	return(EXP_EOF);
    }
    if (ioctl(f->fd, TIOCREQSET, &ioctl_info) < 0) {
	exp_debuglog("ioctl error on TIOCREQSET after ioctl or open on slave: %s", Tcl_ErrnoMsg(errno));
    if (ioctl(esPtr->fdin, TIOCREQSET, &ioctl_info) < 0) {
	expDiagLog("ioctl error on TIOCREQSET after ioctl or open on slave: %s", Tcl_ErrnoMsg(errno));
    }
    /* presumably, we trapped an open here */
    /* call it an error for lack of anything more descriptive */
    /* it will be thrown away by caller anyway */
    return EXP_TCLERROR;
#endif
}

/*
 *----------------------------------------------------------------------
 *
 * exp_dsleep --
 *
 *	Waits for at least a certain amount of time.  In general, 
 *	the length of time will be a little bit longer.
 *
 * Results:
 *	Returns TCL_OK;
 *
 * Side Effects: 
 *	Event handlers can fire during this period, so other actions
 *	are taken.
 *
 *----------------------------------------------------------------------
 */

/*ARGSUSED*/
int	/* returns TCL_XXX */
exp_dsleep(interp,sec)
    Tcl_Interp *interp;
    double sec;
{
    int timer_fired = FALSE;
    int timerFired = FALSE;

    Tcl_CreateTimerHandler((int)(sec*1000),exp_timehandler,(ClientData)&timer_fired);
    Tcl_CreateTimerHandler((int)(sec*1000),exp_timehandler,(ClientData)&timerFired);

    while (1) {
    while (!timerFired) {
	Tcl_DoOneEvent(0);
	if (timer_fired) return TCL_OK;

    }
	if (ready_fs == NULL) continue;

    return TCL_OK;
	exp_event_disarm_fast(ready_fs,exp_filehandler);
	ready_fs = NULL;
    }
}
}


/*
 * Tcl used to require commands to be in writeable memory.  This
 * probably doesn't apply anymore
 */

static char destroy_cmd[] = "destroy .";

/*
 *----------------------------------------------------------------------
 *
 * exp_event_exit_real --
 *
 *	Function to call to destroy the main window, causing
 *	the program to exit.
 *
 * Results:
 *	None
 *
 * Side Effects: 
 *	Program exits.
 *
 *----------------------------------------------------------------------
 */

static void
exp_event_exit_real(interp)
    Tcl_Interp *interp;
{
    Tcl_Eval(interp,destroy_cmd);
}

/*
 *----------------------------------------------------------------------
 *
 * exp_init_event --
 *
 *	Set things up for later calls to the event handler
/* set things up for later calls to event handler */
 *
 * Results:
 *	None
 *
 * Side Effects: 
 *	None
 *
 *----------------------------------------------------------------------
 */

void
exp_init_event()
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    tsdPtr->rr = 0;

    exp_event_exit = exp_event_exit_real;
}






Deleted generic/exp_event.h.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23

























-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

/* exp_event.h - event definitions */

extern int		exp_get_next_event _ANSI_ARGS_((Tcl_Interp *,
			    struct exp_f **, int, struct exp_f **, int, int));
extern int		exp_get_next_event_info _ANSI_ARGS_((Tcl_Interp *,
			    struct exp_f *, int));
extern int		exp_dsleep _ANSI_ARGS_((Tcl_Interp *, double));
extern void		exp_init_event _ANSI_ARGS_((void));
extern void		(*exp_event_exit) _ANSI_ARGS_((Tcl_Interp *));
extern void		exp_event_disarm _ANSI_ARGS_((struct exp_f *));
extern void		exp_arm_background_filehandler _ANSI_ARGS_((
			    struct exp_f *));
extern void		exp_disarm_background_filehandler _ANSI_ARGS_((
			    struct exp_f *));
extern void		exp_disarm_background_filehandler_force _ANSI_ARGS_((
			    struct exp_f *));
extern void		exp_unblock_background_filehandler _ANSI_ARGS_((
			    struct exp_f *));
extern void		exp_block_background_filehandler _ANSI_ARGS_((
			    struct exp_f *));
extern void		exp_background_filehandler _ANSI_ARGS_((ClientData,
			    int));







Deleted generic/exp_main_exp.c.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60






























































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

/* main.c - main() and some logging routines for expect

Written by: Don Libes, NIST, 2/6/90

Design and implementation of this program was paid for by U.S. tax
dollars.  Therefore it is public domain.  However, the author and NIST
would appreciate credit if this program or parts of it are used.
*/

#ifdef __WIN32__
/*
 * We are going to import a couple of data elements from expect52.dll
 * We need this defined here so that we import the data properly.
 */
#define EXPECTIMP     __declspec(dllimport)
#else
#define EXPECTIMP
#endif

#include "exp_port.h"
#include <stdio.h>
#include <stdlib.h>
#include "tcl.h"
#include "expect_tcl.h"

int
main(argc, argv)
int argc;
char *argv[];
{
	int rc = 0;
	Tcl_Interp *interp = Tcl_CreateInterp();

	if (Tcl_Init(interp) == TCL_ERROR) {
		fprintf(stderr,"Tcl_Init failed: %s\n",interp->result);
		exit(1);
	}

	if (Expect_Init(interp) == TCL_ERROR) {
		fprintf(stderr,"Expect_Init failed: %s\n",interp->result);
		exit(1);
	}

	exp_parse_argv(interp,argc,argv);

	/* become interactive if requested or "nothing to do" */
	if (exp_interactive)
		(void) exp_interpreter(interp);
	else if (exp_cmdfile)
		rc = exp_interpret_cmdfile(interp,exp_cmdfile);
	else if (exp_cmdfilename)
		rc = exp_interpret_cmdfilename(interp,exp_cmdfilename);

	/* assert(exp_cmdlinecmds != 0) */

	exp_exit(interp,rc);
	/*NOTREACHED*/
	return 0;		/* Needed only to prevent compiler warning. */
}







Deleted generic/exp_main_sub.c.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966








































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

/*
 * exp_main_sub.c --
 *
 *	miscellaneous subroutines for Expect or Tk main()
 *
 * Written by Don Libes
 *
 *
 * Windows NT port by Gordon Chaffee
 * Copyright (c) 1997 by Mitel Corporations
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 */

#include <stdio.h>
#include <errno.h>
#include <sys/types.h>

#include "exp_port.h"

#include "tcl.h"
#include "tclInt.h"
#include "exp_tty.h"
#include "exp_rename.h"
#include "exp_prog.h"
#include "exp_command.h"
#include "exp_log.h"
#include "exp_event.h"
#include "exp_version.h"
#ifdef TCL_DEBUGGER
#include "Dbg.h"
#endif

#ifdef __CENTERLINE__
#undef	EXP_VERSION
#define	EXP_VERSION		"5.0.3"		/* I give up! */
					/* It is not necessary that number */
					/* be accurate.  It is just here to */
					/* pacify Centerline which doesn't */
					/* seem to be able to get it from */
					/* the Makefile. */
#undef	SCRIPTDIR
#define SCRIPTDIR	"example/"
#undef	EXECSCRIPTDIR
#define EXECSCRIPTDIR	"example/"
#endif
char exp_version[] = EXP_VERSION;
#define NEED_TCL_MAJOR		7
#define NEED_TCL_MINOR		5

char *exp_argv0 = "this program";	/* default program name */
void (*exp_app_exit)() = 0;
void (*exp_event_exit)() = 0;
FILE *exp_cmdfile = 0;
char *exp_cmdfilename = 0;
int exp_cmdlinecmds = FALSE;
int exp_interactive =  FALSE;
int exp_buffer_command_input = FALSE;/* read in entire cmdfile at once */
int exp_fgets();

Tcl_Interp *exp_interp;	/* for use by signal handlers who can't figure out */
			/* the interpreter directly */
int exp_tcl_debugger_available = FALSE;

int exp_getpid;

/*
 * Declarations for local procedures defined in this file:
 */

static void		exp_pty_exit_for_tcl _ANSI_ARGS_((
			    ClientData clientData));


static void
usage(interp)
Tcl_Interp *interp;
{
	errorlog("usage: expect [-div] [-c cmds] [[-f] cmdfile] [args]\r\n");
	exp_exit(interp,1);
}

/*ARGSUSED*/
void
exp_exit(interp,status)
Tcl_Interp *interp;     /* historic */
int status;
{
	Tcl_Exit(status);
}

/* this clumsiness because pty routines don't know Tcl definitions */
static
void
exp_pty_exit_for_tcl(clientData)
ClientData clientData;
{
	exp_pty_exit();
}

static
void
exp_init_pty_exit()
{
	Tcl_CreateExitHandler(exp_pty_exit_for_tcl,(ClientData)0);
}

/* This can be called twice or even recursively - it's safe. */
void
exp_exit_handlers(clientData)
ClientData clientData;
{
	extern int exp_forked;

	Tcl_Interp *interp = (Tcl_Interp *)clientData;

	/* use following checks to prevent recursion in exit handlers */
	/* if this code ever supports multiple interps, these should */
	/* become interp-specific */

	static int did_app_exit = FALSE;
	static int did_expect_exit = FALSE;

	/* don't think this code is relevant any longer, but not positive! */
	if (!interp) {
		/* if no interp handy (i.e., called from interrupt handler) */
		/* use last one created - it's a hack but we're exiting */
		/* ungracefully to begin with */
		interp = exp_interp;
	}

	if (!did_expect_exit) {
		did_expect_exit = TRUE;
		/* called user-defined exit routine if one exists */
		if (exp_onexit_action) {
			int result = Tcl_GlobalEval(interp,exp_onexit_action);
			if (result != TCL_OK) Tcl_BackgroundError(interp);
		}
	} else {
		debuglog("onexit handler called recursively - forcing exit\r\n");
	}

	if (exp_app_exit) {
		if (!did_app_exit) {
			did_app_exit = TRUE;
			(*exp_app_exit)(interp);
		} else {
			debuglog("application exit handler called recursively - forcing exit\r\n");
		}
	}

#ifndef __WIN32__
	if (!exp_disconnected
	    && !exp_forked
	    && (exp_dev_tty != -1)
	    && isatty(exp_dev_tty)
	    && exp_ioctled_devtty) {
		exp_tty_set(interp,&exp_tty_original,exp_dev_tty,0);
	}
#endif
#if 0 /* GCC: I don't think this is necessary anymore */
	/* all other files either don't need to be flushed or will be
	   implicitly closed at exit.  Spawned processes are free to continue
	   running, however most will shutdown after seeing EOF on stdin.
	   Some systems also deliver SIGHUP and other sigs to idle processes
	   which will blow them away if not prepared.
	*/

	exp_close_all(interp);
#endif
}

/* this stupidity because Tcl needs commands in writable space */
static char prompt1[] = "prompt1";
static char prompt2[] = "prompt2";

static char *prompt2_default = "+> ";
static char prompt1_default[] = "expect%d> ";

/*ARGSUSED*/
int
Exp_Prompt1Cmd(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
	Interp *iPtr = (Interp *)interp;

	sprintf(interp->result,prompt1_default, iPtr->numLevels);
	return(TCL_OK);
}

/*ARGSUSED*/
int
Exp_Prompt2Cmd(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
	strcpy(interp->result,prompt2_default);
	return(TCL_OK);
}

/*ARGSUSED*/
static int
ignore_procs(interp,s)
Tcl_Interp *interp;
char *s;		/* function name */
{
	return ((s[0] == 'p') &&
		(s[1] == 'r') &&
		(s[2] == 'o') &&
		(s[3] == 'm') &&
		(s[4] == 'p') &&
		(s[5] == 't') &&
		((s[6] == '1') ||
		 (s[6] == '2')) &&
		(s[7] == '\0')
	       );
}

/* handle an error from Tcl_Eval or Tcl_EvalFile */
static void
handle_eval_error(interp,check_for_nostack)
Tcl_Interp *interp;
int check_for_nostack;
{
	char *msg;

	/* if errorInfo has something, print it */
	/* else use what's in interp->result */

	msg = Tcl_GetVar(interp,"errorInfo",TCL_GLOBAL_ONLY);
	if (!msg) msg = interp->result;
	else if (check_for_nostack) {
		/* suppress errorInfo if generated via */
		/* error ... -nostack */
		if (0 == strncmp("-nostack",msg,8)) return;

		/*
		 * This shouldn't be necessary, but previous test fails
		 * because of recent change John made - see eval_trap_action()
		 * in exp_trap.c for more info
		 */
		if (exp_nostack_dump) {
			exp_nostack_dump = FALSE;
			return;
		}
	}

	/* no \n at end, since ccmd will already have one. */
	/* Actually, this is not true if command is last in */
	/* file and has no newline after it, oh well */
	errorlog("%s\r\n",exp_cook(msg,(int *)0));
}

/* user has pressed escape char from interact or somehow requested expect.
If a user-supplied command returns:

TCL_ERROR,	assume user is experimenting and reprompt
TCL_OK,		ditto
TCL_RETURN,	return TCL_OK (assume user just wants to escape() to return)
EXP_TCL_RETURN,	return TCL_RETURN
anything else	return it
*/
int
exp_interpreter(interp)
Tcl_Interp *interp;
{
#ifdef __WIN32__
	fprintf(stderr, "expect.exe does not run in interactive mode.  Use tclsh80.exe instead\n");
	exit(1);
	return 0;
#else
	int rc;
	char *ccmd;		/* pointer to complete command */
	char line[BUFSIZ+1];	/* space for partial command */
	int newcmd = TRUE;
	Tcl_DString dstring;
	Interp *iPtr = (Interp *)interp;
	int tty_changed = FALSE;

#ifndef __WIN32__
	exp_tty tty_old;
#endif
	int was_raw, was_echo;

	int dummy;
	int fd = fileno(stdin);
	
	expect_key++;

	Tcl_DStringInit(&dstring);

	newcmd = TRUE;
	while (TRUE) {
		/* force terminal state */
#ifndef __WIN32__
		tty_changed = exp_tty_cooked_echo(interp,&tty_old,&was_raw,&was_echo);
#endif

		if (newcmd) {
			rc = Tcl_Eval(interp,prompt1);
			if (rc == TCL_OK) exp_log(1,"%s",interp->result);
			else exp_log(1,prompt1_default,iPtr->numLevels);
		} else {
			rc = Tcl_Eval(interp,prompt2);
			if (rc == TCL_OK) exp_log(1,"%s",interp->result);
			else exp_log(1,prompt2_default,1);
		}

#ifdef SHARE_CMD_BUFFER
		if (exp_fgets(interp,line,BUFSIZ) == EXP_EOF) {
			if (!newcmd) line[0] = 0;
			else exp_exit(interp,0);
		}
#else
		exp_fs[fd].force_read = 1;
		rc = exp_get_next_event(interp,&fd,1,&dummy,EXP_TIME_INFINITY,
			exp_fs[fd].key);
		/*  check for rc == EXP_TCLERROR? */

		if (rc != EXP_EOF) {
			rc = read(0,line,BUFSIZ);
#ifdef SIMPLE_EVENT
			if (rc == -1 && errno == EINTR) {
				if (Tcl_AsyncReady()) {
					(void) Tcl_AsyncInvoke(interp,TCL_OK);
				}
				continue;
			}
#endif
			if (rc <= 0) {
				if (!newcmd) line[0] = 0;
				else rc = EXP_EOF;
			} else line[rc] = '\0';
		}

#ifdef BEFORE_ASYNC
		if (rc != EXP_EOF) {
			if (0 >= (rc = read(0,line,BUFSIZ))) {
				if (!newcmd) line[0] = 0;
				else rc = EXP_EOF;
			} else line[rc] = '\0';
		}
#endif

		if (rc == EXP_EOF) exp_exit(interp,0);

		if (debugfile) fwrite(line,1,strlen(line),debugfile);
		/* intentionally always write to logfile */
		if (logfile) fwrite(line,1,strlen(line),logfile);
		/* no need to write to stdout, since they will see */
		/* it just from it having been echoed as they are */
		/* typing it */
#endif /*SHARE_CMD_BUFFER*/

		ccmd = Tcl_DStringAppend(&dstring,line,rc);
		if (!Tcl_CommandComplete(ccmd)) {
			newcmd = FALSE;
			continue;	/* continue collecting command */
		}
		newcmd = TRUE;

		if (tty_changed) exp_tty_set(interp,&tty_old,was_raw,was_echo);

		/* Ousterhout says he fixed this, so that we no longer need
		   the ifdefs */
		rc = Tcl_RecordAndEval(interp,ccmd,0);
#if 0
#if TCL_MAJOR_VERSION == 7 && TCL_MINOR_VERSION < 4
		rc = Tcl_RecordAndEval(interp,ccmd,0);
#else
		rc = Tcl_RecordAndEval(interp,ccmd,TCL_NO_EVAL);
		rc = Tcl_Eval(interp,ccmd);
#endif
#endif
		Tcl_DStringFree(&dstring);
		switch (rc) {
		case TCL_OK:
			if (*interp->result != 0)
				exp_log(1,"%s\r\n",exp_cook(interp->result,(int *)0));
			continue;
		case TCL_ERROR:
			handle_eval_error(interp,1);
			/* since user is typing by hand, we expect lots */
			/* of errors, and want to give another chance */
			continue;
#define finish(x)	{rc = x; goto done;}
		case TCL_BREAK:
		case TCL_CONTINUE:
			finish(rc);
		case EXP_TCL_RETURN:
			finish(TCL_RETURN);
		case TCL_RETURN:
			finish(TCL_OK);
		default:
			/* note that ccmd has trailing newline */
			errorlog("error %d: %s\r\n",rc,ccmd);
			continue;
		}
	}
	/* cannot fall thru here, must jump to label */
 done:
	if (tty_changed) exp_tty_set(interp,&tty_old,was_raw,was_echo);

	Tcl_DStringFree(&dstring);

	return(rc);
#endif /* ifdef __WIN32__ */
}

/*ARGSUSED*/
int
Exp_ExpVersionCmd(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
	int emajor, umajor;
	char *user_version;	/* user-supplied version string */

	if (argc == 1) {
		Tcl_SetResult(interp,exp_version,TCL_STATIC);
		return(TCL_OK);
	}
	if (argc > 3) {
		exp_error(interp,"usage: expect_version [[-exit] version]");
		return(TCL_ERROR);
	}

	user_version = argv[argc==2?1:2];
	emajor = atoi(exp_version);
	umajor = atoi(user_version);

	/* first check major numbers */
	if (emajor == umajor) {
		int u, e;

		/* now check minor numbers */
		char *dot = strchr(user_version,'.');
		if (!dot) {
			exp_error(interp,"version number must include a minor version number");
			return TCL_ERROR;
		}

		u = atoi(dot+1);
		dot = strchr(exp_version,'.');
		e = atoi(dot+1);
		if (e >= u) return(TCL_OK);
	}

	if (argc == 2) {
		exp_error(interp,"%s requires Expect version %s (but using %s)",
			exp_argv0,user_version,exp_version);
		return(TCL_ERROR);
	}
	errorlog("%s: requires Expect version %s (but using %s)\r\n",
		exp_argv0,user_version,exp_version);
	exp_exit(interp,1);
	/*NOTREACHED*/
}

/*
 * The following string is the startup script executed in new
 * interpreters.  It looks on disk in several different directories
 * for a script "dpinit.tcl" that is compatible with this version of Dp.
 * The dpinit.tcl script does all of the real work of initialization.
 */

static char initScript[] =
"proc expectInit {} {\n\
    global exp_library env\n\
    rename expectInit {}\n\
    set version [exp_version]\n\
    set dirs [list [file join .. examples] [file join . examples]]\n\
    if [info exists env(EXP_LIBRARY)] {\n\
	lappend dirs $env(EXP_LIBRARY)\n\
    }\n\
    set parentDir [file dirname [file dirname [info nameofexecutable]]]\n\
    lappend dirs [file join [file join $parentDir lib] exp$version]\n\
    set lib exp$version\n\
    lappend dirs [file join [file join [file dirname $parentDir] $lib] library]\n\
    lappend dirs [file join $parentDir library]\n\
    set parentDir [file dirname [pwd]]\n\
    lappend dirs [file join $parentDir library]\n\
    foreach i $dirs {\n\
	set exp_library $i\n\
	set expect_library $i\n\
	set exp_exec_library $i\n\
	if [file isfile [file join $i expect.rc]] {\n\
	    lappend auto_path $exp_library\n\
	    return\n\
	}\n\
    }\n\
    foreach i $dirs {\n\
	set exp_library $i\n\
	set expect_library $i\n\
	set exp_exec_library $i\n\
	if [file isfile [file join $i beer.exp]] {\n\
	    lappend auto_path $exp_library\n\
	    return\n\
	}\n\
    }\n\
    set msg \"Can't find expect.rc or beer.exp in the following directories: \n\"\n\
    append msg \"    $dirs\n\"\n\
    append msg \"This probably means that Expect wasn't installed properly.\n\"\n\
    #error $msg\n\
}\n\
expectInit";


static char init_auto_path[] = "lappend auto_path $exp_library $exp_exec_library";

int
Expect_Init(interp)
Tcl_Interp *interp;
{
	static int first_time = TRUE;

	if (first_time) {
		int tcl_major = atoi(TCL_VERSION);
		char *dot = strchr(TCL_VERSION,'.');
		int tcl_minor = atoi(dot+1);

		if (tcl_major < NEED_TCL_MAJOR || 
		    (tcl_major == NEED_TCL_MAJOR && tcl_minor < NEED_TCL_MINOR)) {
			sprintf(interp->result,
			   "%s compiled with Tcl %d.%d but needs at least Tcl %d.%d\n",
				exp_argv0,tcl_major,tcl_minor,
				NEED_TCL_MAJOR,NEED_TCL_MINOR);
			return TCL_ERROR;
		}

		if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 0) == NULL) {
			return TCL_ERROR;
		}
		if (Tcl_PkgProvide(interp, "Expect", EXP_VERSION) != TCL_OK) {
			return TCL_ERROR;
		}

		exp_getpid = getpid();
		exp_init_spawn_ids(interp);
		exp_init_pty(interp);
		exp_init_pty_exit();
		exp_init_tty(interp); /* do this only now that we have
				       * looked at original tty state */
		exp_init_stdio();
		exp_init_sig();
		exp_init_event();
		exp_init_trap();
		exp_init_unit_random();

		Tcl_CreateExitHandler(exp_exit_handlers,(ClientData)interp);

		first_time = FALSE;
	}

	/* save last known interp for emergencies */
	exp_interp = interp;

	/* initialize commands */
	exp_init_most_cmds(interp);	/* add misc     cmds to interpreter */
	exp_init_expect_cmds(interp);	/* add expect   cmds to interpreter */
	exp_init_main_cmds(interp);	/* add main     cmds to interpreter */
	exp_init_trap_cmds(interp);	/* add trap     cmds to interpreter */
	exp_init_tty_cmds(interp);	/* add tty      cmds to interpreter */
	exp_init_interact_cmds(interp);	/* add interact cmds to interpreter */

	exp_init_spawn_id_vars(interp);

	if (Tcl_Eval(interp, initScript) != TCL_OK) {
		return TCL_ERROR;
	}

#ifdef TCL_DEBUGGER
	Dbg_IgnoreFuncs(interp,ignore_procs);
#endif

	return TCL_OK;
}

static char sigexit_init_default[] = "trap exit {SIGINT SIGTERM}";
static char debug_init_default[] = "trap {exp_debug 1} SIGINT";

void
exp_parse_argv(interp,argc,argv)
Tcl_Interp *interp;
int argc;
char **argv;
{
	char argc_rep[10]; /* enough space for storing literal rep of argc */

	int sys_rc = TRUE;	/* read system rc file */
	int my_rc = TRUE;	/* read personal rc file */

	int c;
	int rc;

	extern int optind;
	extern char *optarg;
	char *args;		/* ptr to string-rep of all args */
#ifdef __WIN32__
	extern int getopt _ANSI_ARGS_((int argc,char **nargv, char *ostr));
#endif

	exp_argv0 = argv[0];

#ifdef TCL_DEBUGGER
	Dbg_ArgcArgv(argc,argv,1);
#endif

	/* initially, we must assume we are not interactive */
	/* this prevents interactive weirdness courtesy of unknown via -c */
	/* after handling args, we can change our mind */
	Tcl_SetVar(interp, "tcl_interactive", "0", TCL_GLOBAL_ONLY);

	Tcl_Eval(interp,sigexit_init_default);

	while ((c = getopt(argc, argv, "b:c:dD:f:inN-v")) != EOF) {
		switch(c) {
		case '-':
			/* getopt already handles -- internally, however */
			/* this allows us to abort getopt when dash is at */
			/* the end of another option which is required */
			/* in order to allow things like -n- on #! line */
			goto abort_getopt;
		case 'c': /* command */
			exp_cmdlinecmds = TRUE;
			rc = Tcl_Eval(interp,optarg);
			if (rc != TCL_OK) {
			    errorlog("%s\r\n",exp_cook(Tcl_GetVar(interp,"errorInfo",TCL_GLOBAL_ONLY),(int *)0));
			}
			break;
		case 'd': exp_is_debugging = TRUE;
			debuglog("expect version %s\r\n",exp_version);
			break;
#ifdef TCL_DEBUGGER
		case 'D': {
			char *debug_init;
			exp_tcl_debugger_available = TRUE;
			if (Tcl_GetInt(interp,optarg,&rc) != TCL_OK) {
				errorlog("%s: -D argument must be 0 or 1\r\n",
					exp_argv0);
				exp_exit(interp,1);
			}

			/* set up trap handler before Dbg_On so user does */
			/* not have to see it at first debugger prompt */
			if (0 == (debug_init = getenv("EXPECT_DEBUG_INIT"))) {
				debug_init = debug_init_default;
			}
			Tcl_Eval(interp,debug_init);
			if (rc == 1) Dbg_On(interp,0);
			break;
		}
#endif
		case 'f': /* name of cmd file */
			exp_cmdfilename = optarg;
			break;
		case 'b': /* read cmdfile one part at a time */
			exp_cmdfilename = optarg;
			exp_buffer_command_input = TRUE;
			break;
		case 'i': /* interactive */
			exp_interactive = TRUE;
			break;
		case 'n': /* don't read personal rc file */
			my_rc = FALSE;
			break;
		case 'N': /* don't read system-wide rc file */
			sys_rc = FALSE;
			break;
		case 'v':
			printf("expect version %s\n", exp_version);
			exp_exit (interp, 0);
			break;
		default: usage(interp);
		}
	}

 abort_getopt:

	for (c = 0;c<argc;c++) {
		debuglog("argv[%d] = %s  ",c,argv[c]);
	}
	debuglog("\r\n");

	/* if user hasn't explicitly requested we be interactive */
	/* look for a file or some other source of commands */
	if (!exp_interactive) {
		/* get cmd file name, if we haven't got it already */
		if (!exp_cmdfilename && (optind < argc)) {
			exp_cmdfilename = argv[optind];
			optind++;
		}

		if (exp_cmdfilename) {
			if (streq(exp_cmdfilename,"-")) {
				exp_cmdfile = stdin;
				exp_cmdfilename = 0;
			} else if (exp_buffer_command_input) {
				errno = 0;
				exp_cmdfile = fopen(exp_cmdfilename,"r");
				if (exp_cmdfile) {
					exp_cmdfilename = 0;
					exp_close_on_exec(fileno(exp_cmdfile));
				} else {
					char *msg;

					if (errno == 0) {
						msg = "could not read - odd file name?";
					} else {
						msg = Tcl_ErrnoMsg(errno);
					}
					errorlog("%s: %s\r\n",exp_cmdfilename,msg);
					exp_exit(interp,1);
				}
			}
		} else if (!exp_cmdlinecmds) {
			if (isatty(0)) {
				/* no other source of commands, force interactive */
				exp_interactive = TRUE;
			} else {
				/* read cmds from redirected stdin */
				exp_cmdfile = stdin;
			}
		}
	}

	if (exp_interactive) {
		Tcl_SetVar(interp, "tcl_interactive","1",TCL_GLOBAL_ONLY);
	}

	/* collect remaining args and make into argc, argv0, and argv */
	sprintf(argc_rep,"%d",argc-optind);
	Tcl_SetVar(interp,"argc",argc_rep,0);
	debuglog("set argc %s\r\n",argc_rep);

	if (exp_cmdfilename) {
		Tcl_SetVar(interp,"argv0",exp_cmdfilename,0);
		debuglog("set argv0 \"%s\"\r\n",exp_cmdfilename);
	} else {
		Tcl_SetVar(interp,"argv0",exp_argv0,0);
		debuglog("set argv0 \"%s\"\r\n",exp_argv0);
	}

	args = Tcl_Merge(argc-optind,argv+optind);
	debuglog("set argv \"%s\"\r\n",args);
	Tcl_SetVar(interp,"argv",args,0);
	ckfree(args);

	exp_interpret_rcfiles(interp,my_rc,sys_rc);
}

/* read rc files */
void
exp_interpret_rcfiles(interp,my_rc,sys_rc)
Tcl_Interp *interp;
int my_rc;
int sys_rc;
{
	int rc;

	if (sys_rc) {
	    char file[200];
	    int fd;

	    sprintf(file,"%s/expect.rc",Tcl_GetVar(interp, "exp_library", TCL_GLOBAL_ONLY));
	    if (-1 != (fd = open(file,0))) {
		if (TCL_ERROR == (rc = Tcl_EvalFile(interp,file))) {
		    errorlog("error executing system initialization file: %s\r\n",file);
		    if (rc != TCL_ERROR)
				errorlog("Tcl_Eval = %d\r\n",rc);
		    if (*interp->result != 0)
				errorlog("%s\r\n",interp->result);
		    exp_exit(interp,1);
		}
		close(fd);
	    }
	}
	if (my_rc) {
	    char file[200];
	    char *home;
	    int fd;
	    char *getenv();

	    if ((NULL != (home = getenv("DOTDIR"))) ||
		(NULL != (home = getenv("HOME")))) {
		sprintf(file,"%s/.expect.rc",home);
		if (-1 != (fd = open(file,0))) {
		    if (TCL_ERROR == (rc = Tcl_EvalFile(interp,file))) {
			errorlog("error executing file: %s\r\n",file);
			if (rc != TCL_ERROR)
				errorlog("Tcl_Eval = %d\r\n",rc);
			if (*interp->result != 0)
				errorlog("%s\r\n",interp->result);
			exp_exit(interp,1);
		    }
		    close(fd);
	        }
	    }
	}
}

int
exp_interpret_cmdfilename(interp,filename)
Tcl_Interp *interp;
char *filename;
{
	int rc;

	debuglog("executing commands from command file %s\r\n",filename);

	Tcl_ResetResult(interp);
	if (TCL_OK != (rc = Tcl_EvalFile(interp,filename))) {
		/* EvalFile doesn't bother to copy error to errorInfo */
		/* so force it */
		Tcl_AddErrorInfo(interp, "");
		handle_eval_error(interp,0);
	}
	return rc;
}

int
exp_interpret_cmdfile(interp,fp)
Tcl_Interp *interp;
FILE *fp;
{
	int rc = 0;
	int newcmd;
	int eof;

	Tcl_DString dstring;
	Tcl_DStringInit(&dstring);

	debuglog("executing commands from command file\r\n");

	newcmd = TRUE;
	eof = FALSE;
	while (1) {
		char line[BUFSIZ];/* buffer for partial Tcl command */
		char *ccmd;	/* pointer to complete Tcl command */

		if (fgets(line,BUFSIZ,fp) == NULL) {
			if (newcmd) break;
			eof = TRUE;
		}
		ccmd = Tcl_DStringAppend(&dstring,line,-1);
		if (!Tcl_CommandComplete(ccmd) && !eof) {
			newcmd = FALSE;
			continue;	/* continue collecting command */
		}
		newcmd = TRUE;

		rc = Tcl_Eval(interp,ccmd);
		Tcl_DStringFree(&dstring);
		if (rc != TCL_OK) {
			handle_eval_error(interp,0);
			break;
		}
		if (eof) break;
	}
	Tcl_DStringFree(&dstring);
	return rc;
}

#ifdef SHARE_CMD_BUFFER
/* fgets that shared input buffer with expect_user */
int
exp_fgets(interp,buf,max)
Tcl_Interp *interp;
char *buf;
int max;
{
	char *nl;	/* position of newline which signifies end of line */
	int write_count;/* length of first line of incoming data */

	int m = fileno(stdin);
	struct exp_f *f;
	int cc;

	int dummy;

	/* avoid returning no data, just because someone else read it in by */
	/* passing most recent key */
	cc = exp_get_next_event(interp,&m,1,&dummy,EXP_TIME_INFINITY,exp_fs[m].key);

	if (cc == EXP_DATA_NEW) {
		/* try to read it */

		cc = exp_i_read(m,EXP_TIME_INFINITY);

		/* the meaning of 0 from i_read means eof.  Muck with it a */
		/* little, so that from now on it means "no new data arrived */
		/* but it should be looked at again anyway". */
		if (cc == 0) {
			cc = EXP_EOF;
		} else if (cc > 0) {
			f = exp_fs + m;
			f->buffer[f->size += cc] = '\0';
		}
	} else if (cc == EXP_DATA_OLD) {
		f = exp_fs + m;
		cc = 0;
	}

	/* EOF and TIMEOUT return here */
	/* In such cases, there is no need to update screen since, if there */
	/* was prior data read, it would have been sent to the screen when */
	/* it was read. */
	if (cc < 0) return (cc);

	/* copy up to end of first line */

	/* calculate end of first line */
	nl = strchr(f->buffer,'\n');
	if (nl) write_count = 1+nl-f->buffer;
	else write_count = f->size;

	/* make sure line fits in buffer area */
	if (write_count > max) write_count = max;

	/* copy it */
	memcpy(buf,f->buffer,write_count);
	buf[write_count] = '\0';

	/* update display and f */

	f->printed = 0;
	/* for simplicity force f->printed = 0.  This way, the user gets */
	/* to see the commands that are about to be executed.  Not seeing */
	/* commands you are supposedly typing sounds very uncomfortable! */

	if (logfile_all || (loguser && logfile)) {
		fwrite(f->buffer,1,write_count,logfile);
	}
	if (debugfile) fwrite(f->buffer,1,write_count,debugfile);

	f->size -= write_count;
	memcpy(f->buffer,f->buffer+write_count,1+f->size);
	/* copy to lowercase buffer */
	exp_lowmemcpy(f->lower,f->buffer,1+f->size);

	return(write_count);
}
#endif /*SHARE_CMD_BUFFER*/

static struct exp_cmd_data cmd_data[]  = {
{"expect_version",Exp_ExpVersionCmd,	0,	0},	/* deprecated */
{"exp_version",	Exp_ExpVersionCmd,	0,	0},
{"prompt1",	Exp_Prompt1Cmd,		0,	EXP_NOPREFIX},
{"prompt2",	Exp_Prompt2Cmd,		0,	EXP_NOPREFIX},
{0}};

void
exp_init_main_cmds(interp)
Tcl_Interp *interp;
{
	exp_create_commands(interp,cmd_data);
}






Deleted generic/exp_main_tk.c.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441



























































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

/* exp_main_tk.c - main for expectk

   This file consists of three pieces:
   1) AppInit for Expectk.  This has been suitably modified to invoke
      a modified version of Tk_Init.
   2) Tk_Init for Expectk.  What's wrong with the normal Tk_Init is that
      removes the -- in the cmd-line arg list, so Expect cannot know
      whether args are flags to Expectk or data for the script.  Sigh.
   3) Additions and supporting utilities to Tk's Argv parse table to
      support Expectk's flags.

   Author: Don Libes, NIST, 2/20/96

*/

/* Expectk's AppInit */

/* 
 * tkAppInit.c --
 *
 *	Provides a default version of the Tcl_AppInit procedure for
 *	use in wish and similar Tk-based applications.
 *
 * Copyright (c) 1993 The Regents of the University of California.
 * Copyright (c) 1994 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifndef lint
static char sccsid[] = "@(#) tkAppInit.c 1.19 95/12/23 17:09:24";
#endif /* not lint */

#include <ctype.h>

#include "tk.h"

#include "expect_tcl.h"
#include "Dbg.h"

/*
 * The following variable is a special hack that is needed in order for
 * Sun shared libraries to be used for Tcl.
 */

extern int matherr();
int *tclDummyMathPtr = (int *) matherr;

#ifdef TK_TEST
EXTERN int		Tktest_Init _ANSI_ARGS_((Tcl_Interp *interp));
#endif /* TK_TEST */

/*
 *----------------------------------------------------------------------
 *
 * main --
 *
 *	This is the main program for the application.
 *
 * Results:
 *	None: Tk_Main never returns here, so this procedure never
 *	returns either.
 *
 * Side effects:
 *	Whatever the application does.
 *
 *----------------------------------------------------------------------
 */

int
main(argc, argv)
    int argc;			/* Number of command-line arguments. */
    char **argv;		/* Values of command-line arguments. */
{
    Tk_Main(argc, argv, Tcl_AppInit);
    return 0;			/* Needed only to prevent compiler warning. */
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_AppInit --
 *
 *	This procedure performs application-specific initialization.
 *	Most applications, especially those that incorporate additional
 *	packages, will have their own version of this procedure.
 *
 * Results:
 *	Returns a standard Tcl completion code, and leaves an error
 *	message in interp->result if an error occurs.
 *
 * Side effects:
 *	Depends on the startup script.
 *
 *----------------------------------------------------------------------
 */

int
Tcl_AppInit(interp)
    Tcl_Interp *interp;		/* Interpreter for application. */
{
    if (Tcl_Init(interp) == TCL_ERROR) {
	return TCL_ERROR;
    }

    /* do Expect first so we can get access to Expect commands when */
    /* Tk_Init does the argument parsing of -c */
    if (Expect_Init(interp) == TCL_ERROR) {
	return TCL_ERROR;
    }
    Tcl_StaticPackage(interp, "Expect", Expect_Init, (Tcl_PackageInitProc *)NULL);

    if (Tk_Init2(interp) == TCL_ERROR) {	/* DEL */
	return TCL_ERROR;
    }
    Tcl_StaticPackage(interp, "Tk", Tk_Init, (Tcl_PackageInitProc *) NULL);

    /*
     * Call the init procedures for included packages.  Each call should
     * look like this:
     *
     * if (Mod_Init(interp) == TCL_ERROR) {
     *     return TCL_ERROR;
     * }
     *
     * where "Mod" is the name of the module.
     */

    /*
     * Call Tcl_CreateCommand for application-specific commands, if
     * they weren't already created by the init procedures called above.
     */

    /*
     * Specify a user-specific startup file to invoke if the application
     * is run interactively.  Typically the startup file is "~/.apprc"
     * where "app" is the name of the application.  If this line is deleted
     * then no user-specific startup file will be run under any conditions.
     */

    Tcl_SetVar(interp, "tcl_rcFileName", "~/.wishrc", TCL_GLOBAL_ONLY);
    return TCL_OK;
}




/*
 * Count of number of main windows currently open in this process.
 */

static int numMainWindows;

/*
 * The variables and table below are used to parse arguments from
 * the "argv" variable in Tk_Init.
 */

static int synchronize;
static char *name;
static char *display;
static char *geometry;
static char *colormap;
static char *visual;
static int rest = 0;

/* for Expect */
int my_rc = 1;
int sys_rc = 1;
int optcmd_eval();
#ifdef TCL_DEBUGGER
int optcmd_debug();
#endif
int print_version = 0;

static Tk_ArgvInfo argTable[] = {
    {"-colormap", TK_ARGV_STRING, (char *) NULL, (char *) &colormap,
	"Colormap for main window"},
    {"-display", TK_ARGV_STRING, (char *) NULL, (char *) &display,
	"Display to use"},
    {"-geometry", TK_ARGV_STRING, (char *) NULL, (char *) &geometry,
	"Initial geometry for window"},
    {"-name", TK_ARGV_STRING, (char *) NULL, (char *) &name,
	"Name to use for application"},
    {"-sync", TK_ARGV_CONSTANT, (char *) 1, (char *) &synchronize,
	"Use synchronous mode for display server"},
    {"-visual", TK_ARGV_STRING, (char *) NULL, (char *) &visual,
	"Visual for main window"},
    {"--", TK_ARGV_REST, (char *) 1, (char *) &rest,
	"Pass all remaining arguments through to script"},
/* for Expect */
    {"-command", TK_ARGV_GENFUNC, (char *) optcmd_eval, (char *)0,
	"Command(s) to execute immediately"},
    {"-diag", TK_ARGV_CONSTANT, (char *) 1, (char *) &exp_is_debugging,
	"Enable diagnostics"},
    {"-norc", TK_ARGV_CONSTANT, (char *) 0, (char *) &my_rc,
	"Don't read ~/.expect.rc"},
    {"-NORC", TK_ARGV_CONSTANT, (char *) 0, (char *) &sys_rc,
	"Don't read system-wide expect.rc"},
    {"-version", TK_ARGV_CONSTANT, (char *) 1, (char *) &print_version,
	"Print version and exit"},
#if TCL_DEBUGGER
    {"-Debug", TK_ARGV_GENFUNC, (char *) optcmd_debug, (char *)0, 
	"Enable debugger"},
#endif
    {(char *) NULL, TK_ARGV_END, (char *) NULL, (char *) NULL,
	(char *) NULL}
};

/*
 *----------------------------------------------------------------------
 *
 * Tk_Init --
 *
 *	This procedure is invoked to add Tk to an interpreter.  It
 *	incorporates all of Tk's commands into the interpreter and
 *	creates the main window for a new Tk application.  If the
 *	interpreter contains a variable "argv", this procedure
 *	extracts several arguments from that variable, uses them
 *	to configure the main window, and modifies argv to exclude
 *	the arguments (see the "wish" documentation for a list of
 *	the arguments that are extracted).
 *
 * Results:
 *	Returns a standard Tcl completion code and sets interp->result
 *	if there is an error.
 *
 * Side effects:
 *	Depends on various initialization scripts that get invoked.
 *
 *----------------------------------------------------------------------
 */

int
Tk_Init2(interp)
    Tcl_Interp *interp;		/* Interpreter to initialize. */
{
    char *p;
    int argc, code;
    char **argv, *args[20];
    Tcl_DString class;
    char buffer[30];

    /*
     * If there is an "argv" variable, get its value, extract out
     * relevant arguments from it, and rewrite the variable without
     * the arguments that we used.
     */

    synchronize = 0;
    name = display = geometry = colormap = visual = NULL; 
    p = Tcl_GetVar2(interp, "argv", (char *) NULL, TCL_GLOBAL_ONLY);
    argv = NULL;
    if (p != NULL) {
	if (Tcl_SplitList(interp, p, &argc, &argv) != TCL_OK) {
	    argError:
	    Tcl_AddErrorInfo(interp,
		    "\n    (processing arguments in argv variable)");
	    return TCL_ERROR;
	}
	if (Tk_ParseArgv(interp, (Tk_Window) NULL, &argc, argv,
		argTable, TK_ARGV_DONT_SKIP_FIRST_ARG|TK_ARGV_NO_DEFAULTS)
		!= TCL_OK) {
	    ckfree((char *) argv);
	    goto argError;
	}

	if (print_version) {
	    extern char exp_version[];
	    printf ("expectk version %s\n", exp_version);
	    exp_exit (interp, 0);
	}

	p = Tcl_Merge(argc, argv);
	Tcl_SetVar2(interp, "argv", (char *) NULL, p, TCL_GLOBAL_ONLY);
	sprintf(buffer, "%d", argc);
	Tcl_SetVar2(interp, "argc", (char *) NULL, buffer, TCL_GLOBAL_ONLY);
	ckfree(p);
    }

    /*
     * Figure out the application's name and class.
     */

    if (name == NULL) {
	name = Tcl_GetVar(interp, "argv0", TCL_GLOBAL_ONLY);
	if ((name == NULL) || (*name == 0)) {
	    name = "tk";
	} else {
	    p = (char *)strrchr(name, '/');     /* added cast - DEL */
	    if (p != NULL) {
		name = p+1;
	    }
	}
    }
    Tcl_DStringInit(&class);
    Tcl_DStringAppend(&class, name, -1);
    p = Tcl_DStringValue(&class);
    if (islower(*p)) {
	*p = toupper((unsigned char) *p);
    }

    /*
     * Create an argument list for creating the top-level window,
     * using the information parsed from argv, if any.
     */

    args[0] = "toplevel";
    args[1] = ".";
    args[2] = "-class";
    args[3] = Tcl_DStringValue(&class);
    argc = 4;
    if (display != NULL) {
	args[argc] = "-screen";
	args[argc+1] = display;
	argc += 2;

	/*
	 * If this is the first application for this process, save
	 * the display name in the DISPLAY environment variable so
	 * that it will be available to subprocesses created by us.
	 */

	if (numMainWindows == 0) {
	    Tcl_SetVar2(interp, "env", "DISPLAY", display, TCL_GLOBAL_ONLY);
	}
    }
    if (colormap != NULL) {
	args[argc] = "-colormap";
	args[argc+1] = colormap;
	argc += 2;
    }
    if (visual != NULL) {
	args[argc] = "-visual";
	args[argc+1] = visual;
	argc += 2;
    }
    args[argc] = NULL;
    code = TkCreateFrame((ClientData) NULL, interp, argc, args, 1, name);
    Tcl_DStringFree(&class);
    if (code != TCL_OK) {
	goto done;
    }
    Tcl_ResetResult(interp);
    if (synchronize) {
	XSynchronize(Tk_Display(Tk_MainWindow(interp)), True);
    }

    /*
     * Set the geometry of the main window, if requested.  Put the
     * requested geometry into the "geometry" variable.
     */

    if (geometry != NULL) {
	Tcl_SetVar(interp, "geometry", geometry, TCL_GLOBAL_ONLY);
	code = Tcl_VarEval(interp, "wm geometry . ", geometry, (char *) NULL);
	if (code != TCL_OK) {
	    goto done;
	}
    }
    if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 1) == NULL) {
	code = TCL_ERROR;
	goto done;
    }
    code = Tcl_PkgProvide(interp, "Tk", TK_VERSION);
    if (code != TCL_OK) {
	goto done;
    }

    /*
     * Invoke platform-specific initialization.
     */

    code = TkPlatformInit(interp);

    done:
    if (argv != NULL) {
	ckfree((char *) argv);
    }
    return code;
}

/*ARGSUSED*/
int
optcmd_eval(dst,interp,key,argc,argv)
char *dst;
Tcl_Interp *interp;
char *key;
int argc;
char **argv;
{
	int i;
	int rc;

	exp_cmdlinecmds = 1;

	rc = Tcl_Eval(interp,argv[0]);
	if (rc == TCL_ERROR) return -1;

	argc--;
	for (i=0;i<argc;i++) {
		argv[i] = argv[i+1];
	}

	return argc;
}

#ifdef TCL_DEBUGGER
/*ARGSUSED*/
int
optcmd_debug(dst,interp,key,argc,argv)
char *dst;
Tcl_Interp *interp;
char *key;
int argc;
char **argv;
{
	int i;

	if (argc == 0) {
		strcpy(interp->result,"-Debug flag needs 1 or 0 argument");
		return -1;
	}

	if (Tcl_GetInt(interp,argv[0],&i) != TCL_OK) {
		return -1;
	}

	if (i) {
		Dbg_On(interp,0);
	}

	argc--;
	for (i=0;i<argc;i++) {
		argv[i] = argv[i+1];
	}

	return argc;
}
#endif /*TCL_DEBUGGER*/






Deleted generic/exp_memmove.c.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25



























-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

/* memmove - some systems lack this */

#include "expect_cf.h"
#include "tcl.h"

/* like memcpy but can handle overlap */
#ifndef HAVE_MEMMOVE
char *
memmove(dest,src,n)
VOID *dest;
CONST VOID *src;
int n;
{
	char *d;
	CONST char *s;

	d = dest;
	s = src;
	if (s<d && (d < s+n)) {
		for (d+=n, s+=n; 0<n; --n)
			*--d = *--s;
	} else for (;0<n;--n) *d++ = *s++;
	return dest;
}
#endif /* HAVE_MEMMOVE */






Deleted generic/exp_regexp.c.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253







































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

/*
 * regcomp and regexec -- regsub and regerror are elsewhere
 *
 *	Copyright (c) 1986 by University of Toronto.
 *	Written by Henry Spencer.  Not derived from licensed software.
 *
 *	Permission is granted to anyone to use this software for any
 *	purpose on any computer system, and to redistribute it freely,
 *	subject to the following restrictions:
 *
 *	1. The author is not responsible for the consequences of use of
 *		this software, no matter how awful, even if they arise
 *		from defects in it.
 *
 *	2. The origin of this software must not be misrepresented, either
 *		by explicit claim or by omission.
 *
 *	3. Altered versions must be plainly marked as such, and must not
 *		be misrepresented as being the original software.
 *
 * Beware that some of this code is subtly aware of the way operator
 * precedence is structured in regular expressions.  Serious changes in
 * regular-expression syntax might require a total rethink.
 *
 * *** NOTE: this code has been altered slightly for use in Tcl. ***
 * *** The only change is to use ckalloc and ckfree instead of   ***
 * *** malloc and free.						 ***

 * *** and again for Expect!!! - DEL

 * *** More minor corrections stolen from tcl7.5p1/regexp.c - DEL

 */

#include "exp_port.h"
#include "tcl.h"
#include "exp_prog.h"
#include "tclRegexp.h"
#include "exp_regexp.h"
#include "string.h"

#define NOTSTATIC	/* was at one time, but Expect needs access */

/*
 * The "internal use only" fields in regexp.h are present to pass info from
 * compile to execute that permits the execute phase to run lots faster on
 * simple cases.  They are:
 *
 * regstart	char that must begin a match; '\0' if none obvious
 * reganch	is the match anchored (at beginning-of-line only)?
 * regmust	string (pointer into program) that match must include, or NULL
 * regmlen	length of regmust string
 *
 * Regstart and reganch permit very fast decisions on suitable starting points
 * for a match, cutting down the work a lot.  Regmust permits fast rejection
 * of lines that cannot possibly match.  The regmust tests are costly enough
 * that regcomp() supplies a regmust only if the r.e. contains something
 * potentially expensive (at present, the only such thing detected is * or +
 * at the start of the r.e., which can involve a lot of backup).  Regmlen is
 * supplied because the test in regexec() needs it and regcomp() is computing
 * it anyway.
 */

/*
 * Structure for regexp "program".  This is essentially a linear encoding
 * of a nondeterministic finite-state machine (aka syntax charts or
 * "railroad normal form" in parsing technology).  Each node is an opcode
 * plus a "next" pointer, possibly plus an operand.  "Next" pointers of
 * all nodes except BRANCH implement concatenation; a "next" pointer with
 * a BRANCH on both ends of it is connecting two alternatives.  (Here we
 * have one of the subtle syntax dependencies:  an individual BRANCH (as
 * opposed to a collection of them) is never concatenated with anything
 * because of operator precedence.)  The operand of some types of node is
 * a literal string; for others, it is a node leading into a sub-FSM.  In
 * particular, the operand of a BRANCH node is the first node of the branch.
 * (NB this is *not* a tree structure:  the tail of the branch connects
 * to the thing following the set of BRANCHes.)  The opcodes are:
 */

/* definition	number	opnd?	meaning */
#define	END	0	/* no	End of program. */
#define	BOL	1	/* no	Match "" at beginning of line. */
#define	EOL	2	/* no	Match "" at end of line. */
#define	ANY	3	/* no	Match any one character. */
#define	ANYOF	4	/* str	Match any character in this string. */
#define	ANYBUT	5	/* str	Match any character not in this string. */
#define	BRANCH	6	/* node	Match this alternative, or the next... */
#define	BACK	7	/* no	Match "", "next" ptr points backward. */
#define	EXACTLY	8	/* str	Match this string. */
#define	NOTHING	9	/* no	Match empty string. */
#define	STAR	10	/* node	Match this (simple) thing 0 or more times. */
#define	PLUS	11	/* node	Match this (simple) thing 1 or more times. */
#define	OPEN	20	/* no	Mark this point in input as start of #n. */
			/*	OPEN+1 is number 1, etc. */
#define	CLOSE	(OPEN+NSUBEXP)	/* no	Analogous to OPEN. */

/*
 * Opcode notes:
 *
 * BRANCH	The set of branches constituting a single choice are hooked
 *		together with their "next" pointers, since precedence prevents
 *		anything being concatenated to any individual branch.  The
 *		"next" pointer of the last BRANCH in a choice points to the
 *		thing following the whole choice.  This is also where the
 *		final "next" pointer of each individual branch points; each
 *		branch starts with the operand node of a BRANCH node.
 *
 * BACK		Normal "next" pointers all implicitly point forward; BACK
 *		exists to make loop structures possible.
 *
 * STAR,PLUS	'?', and complex '*' and '+', are implemented as circular
 *		BRANCH structures using BACK.  Simple cases (one character
 *		per match) are implemented with STAR and PLUS for speed
 *		and to minimize recursive plunges.
 *
 * OPEN,CLOSE	...are numbered at compile time.
 */

/*
 * A node is one char of opcode followed by two chars of "next" pointer.
 * "Next" pointers are stored as two 8-bit pieces, high order first.  The
 * value is a positive offset from the opcode of the node containing it.
 * An operand, if any, simply follows the node.  (Note that much of the
 * code generation knows about this implicit relationship.)
 *
 * Using two bytes for the "next" pointer is vast overkill for most things,
 * but allows patterns to get big without disasters.
 */
#define	OP(p)	(*(p))
#define	NEXT(p)	(((*((p)+1)&0377)<<8) + (*((p)+2)&0377))
#define	OPERAND(p)	((p) + 3)

/*
 * See regmagic.h for one further detail of program structure.
 */


/*
 * Utility definitions.
 */
#ifndef CHARBITS
#define	UCHARAT(p)	((int)*(unsigned char *)(p))
#else
#define	UCHARAT(p)	((int)*(p)&CHARBITS)
#endif

#define	FAIL(m)	{ regerror(m); return(NULL); }
#define	ISMULT(c)	((c) == '*' || (c) == '+' || (c) == '?')
#define	META	"^$.[()|?+*\\"

/*
 * Flags to be passed up and down.
 */
#define	HASWIDTH	01	/* Known never to match null string. */
#define	SIMPLE		02	/* Simple enough to be STAR/PLUS operand. */
#define	SPSTART		04	/* Starts with * or +. */
#define	WORST		0	/* Worst case. */

/*
 * Global work variables for regcomp().
 */
static char *regparse;		/* Input-scan pointer. */
static int regnpar;		/* () count. */
static char regdummy;
static char *regcode;		/* Code-emit pointer; &regdummy = don't. */
static long regsize;		/* Code size. */

/*
 * The first byte of the regexp internal "program" is actually this magic
 * number; the start node begins in the second byte.
 */
#define	MAGIC	0234


/*
 * Forward declarations for regcomp()'s friends.
 */
#ifndef STATIC
#define	STATIC	static
#endif
STATIC char *reg();
STATIC char *regbranch();
STATIC char *regpiece();
STATIC char *regatom();
STATIC char *regnode();
STATIC char *regnext();
STATIC void regc();
STATIC void reginsert();
STATIC void regtail();
STATIC void regoptail();
#ifdef STRCSPN
STATIC int strcspn();
#endif

/* regcomp originally appeared here - DEL */

/*
 - reg - regular expression, i.e. main body or parenthesized thing
 *
 * Caller must absorb opening parenthesis.
 *
 * Combining parenthesis handling with the base level of regular expression
 * is a trifle forced, but the need to tie the tails of the branches to what
 * follows makes it hard to avoid.
 */
static char *
reg(paren, flagp)
int paren;			/* Parenthesized? */
int *flagp;
{
	register char *ret;
	register char *br;
	register char *ender;
	register int parno = 0;
	int flags;

	*flagp = HASWIDTH;	/* Tentatively. */

	/* Make an OPEN node, if parenthesized. */
	if (paren) {
		if (regnpar >= NSUBEXP)
			FAIL("too many ()");
		parno = regnpar;
		regnpar++;
		ret = regnode(OPEN+parno);
	} else
		ret = NULL;

	/* Pick up the branches, linking them together. */
	br = regbranch(&flags);
	if (br == NULL)
		return(NULL);
	if (ret != NULL)
		regtail(ret, br);	/* OPEN -> first. */
	else
		ret = br;
	if (!(flags&HASWIDTH))
		*flagp &= ~HASWIDTH;
	*flagp |= flags&SPSTART;
	while (*regparse == '|') {
		regparse++;
		br = regbranch(&flags);
		if (br == NULL)
			return(NULL);
		regtail(ret, br);	/* BRANCH -> BRANCH. */
		if (!(flags&HASWIDTH))
			*flagp &= ~HASWIDTH;
		*flagp |= flags&SPSTART;
	}

	/* Make a closing node, and hook it on the end. */
	ender = regnode((paren) ? CLOSE+parno : END);	
	regtail(ret, ender);

	/* Hook the tails of the branches to the closing node. */
	for (br = ret; br != NULL; br = regnext(br))
		regoptail(br, ender);

	/* Check for proper termination. */
	if (paren && *regparse++ != ')') {
		FAIL("unmatched ()");
	} else if (!paren && *regparse != '\0') {
		if (*regparse == ')') {
			FAIL("unmatched ()");
		} else
			FAIL("junk on end");	/* "Can't happen". */
		/* NOTREACHED */
	}

	return(ret);
}

/*
 - regbranch - one alternative of an | operator
 *
 * Implements the concatenation operator.
 */
static char *
regbranch(flagp)
int *flagp;
{
	register char *ret;
	register char *chain;
	register char *latest;
	int flags;

	*flagp = WORST;		/* Tentatively. */

	ret = regnode(BRANCH);
	chain = NULL;
	while (*regparse != '\0' && *regparse != '|' && *regparse != ')') {
		latest = regpiece(&flags);
		if (latest == NULL)
			return(NULL);
		*flagp |= flags&HASWIDTH;
		if (chain == NULL)	/* First piece. */
			*flagp |= flags&SPSTART;
		else
			regtail(chain, latest);
		chain = latest;
	}
	if (chain == NULL)	/* Loop ran zero times. */
		(void) regnode(NOTHING);

	return(ret);
}

/*
 - regpiece - something followed by possible [*+?]
 *
 * Note that the branching code sequences used for ? and the general cases
 * of * and + are somewhat optimized:  they use the same NOTHING node as
 * both the endmarker for their branch list and the body of the last branch.
 * It might seem that this node could be dispensed with entirely, but the
 * endmarker role is not redundant.
 */
static char *
regpiece(flagp)
int *flagp;
{
	register char *ret;
	register char op;
	register char *next;
	int flags;

	ret = regatom(&flags);
	if (ret == NULL)
		return(NULL);

	op = *regparse;
	if (!ISMULT(op)) {
		*flagp = flags;
		return(ret);
	}

	if (!(flags&HASWIDTH) && op != '?')
		FAIL("*+ operand could be empty");
	*flagp = (op != '+') ? (WORST|SPSTART) : (WORST|HASWIDTH);

	if (op == '*' && (flags&SIMPLE))
		reginsert(STAR, ret);
	else if (op == '*') {
		/* Emit x* as (x&|), where & means "self". */
		reginsert(BRANCH, ret);			/* Either x */
		regoptail(ret, regnode(BACK));		/* and loop */
		regoptail(ret, ret);			/* back */
		regtail(ret, regnode(BRANCH));		/* or */
		regtail(ret, regnode(NOTHING));		/* null. */
	} else if (op == '+' && (flags&SIMPLE))
		reginsert(PLUS, ret);
	else if (op == '+') {
		/* Emit x+ as x(&|), where & means "self". */
		next = regnode(BRANCH);			/* Either */
		regtail(ret, next);
		regtail(regnode(BACK), ret);		/* loop back */
		regtail(next, regnode(BRANCH));		/* or */
		regtail(ret, regnode(NOTHING));		/* null. */
	} else if (op == '?') {
		/* Emit x? as (x|) */
		reginsert(BRANCH, ret);			/* Either x */
		regtail(ret, regnode(BRANCH));		/* or */
		next = regnode(NOTHING);		/* null. */
		regtail(ret, next);
		regoptail(ret, next);
	}
	regparse++;
	if (ISMULT(*regparse))
		FAIL("nested *?+");

	return(ret);
}

/*
 - regatom - the lowest level
 *
 * Optimization:  gobbles an entire sequence of ordinary characters so that
 * it can turn them into a single node, which is smaller to store and
 * faster to run.  Backslashed characters are exceptions, each becoming a
 * separate node; the code is simpler that way and it's not worth fixing.
 */
static char *
regatom(flagp)
int *flagp;
{
	register char *ret;
	int flags;

	*flagp = WORST;		/* Tentatively. */

	switch (*regparse++) {
	case '^':
		ret = regnode(BOL);
		break;
	case '$':
		ret = regnode(EOL);
		break;
	case '.':
		ret = regnode(ANY);
		*flagp |= HASWIDTH|SIMPLE;
		break;
	case '[': {
			register int clss;
			register int classend;

			if (*regparse == '^') {	/* Complement of range. */
				ret = regnode(ANYBUT);
				regparse++;
			} else
				ret = regnode(ANYOF);
			if (*regparse == ']' || *regparse == '-')
				regc(*regparse++);
			while (*regparse != '\0' && *regparse != ']') {
				if (*regparse == '-') {
					regparse++;
					if (*regparse == ']' || *regparse == '\0')
						regc('-');
					else {
						clss = UCHARAT(regparse-2)+1;
						classend = UCHARAT(regparse);
						if (clss > classend+1)
							FAIL("invalid [] range");
						for (; clss <= classend; clss++)
							regc((char)clss);
						regparse++;
					}
				} else
					regc(*regparse++);
			}
			regc('\0');
			if (*regparse != ']')
				FAIL("unmatched []");
			regparse++;
			*flagp |= HASWIDTH|SIMPLE;
		}
		break;
	case '(':
		ret = reg(1, &flags);
		if (ret == NULL)
			return(NULL);
		*flagp |= flags&(HASWIDTH|SPSTART);
		break;
	case '\0':
	case '|':
	case ')':
		FAIL("internal urp");	/* Supposed to be caught earlier. */
		/* NOTREACHED */
		break;
	case '?':
	case '+':
	case '*':
		FAIL("?+* follows nothing");
		/* NOTREACHED */
		break;
	case '\\':
		if (*regparse == '\0')
			FAIL("trailing \\");
		ret = regnode(EXACTLY);
		regc(*regparse++);
		regc('\0');
		*flagp |= HASWIDTH|SIMPLE;
		break;
	default: {
			register int len;
			register char ender;

			regparse--;
			len = strcspn(regparse, META);
			if (len <= 0)
				FAIL("internal disaster");
			ender = *(regparse+len);
			if (len > 1 && ISMULT(ender))
				len--;		/* Back off clear of ?+* operand. */
			*flagp |= HASWIDTH;
			if (len == 1)
				*flagp |= SIMPLE;
			ret = regnode(EXACTLY);
			while (len > 0) {
				regc(*regparse++);
				len--;
			}
			regc('\0');
		}
		break;
	}

	return(ret);
}

/*
 - regnode - emit a node
 */
static char *			/* Location. */
regnode(op)
int op;
{
	register char *ret;
	register char *ptr;

	ret = regcode;
	if (ret == &regdummy) {
		regsize += 3;
		return(ret);
	}

	ptr = ret;
	*ptr++ = (char)op;
	*ptr++ = '\0';		/* Null "next" pointer. */
	*ptr++ = '\0';
	regcode = ptr;

	return(ret);
}

/*
 - regc - emit (if appropriate) a byte of code
 */
static void
regc(b)
int b;
{
	if (regcode != &regdummy)
		*regcode++ = (char)b;
	else
		regsize++;
}

/*
 - reginsert - insert an operator in front of already-emitted operand
 *
 * Means relocating the operand.
 */
static void
reginsert(op, opnd)
int op;
char *opnd;
{
	register char *src;
	register char *dst;
	register char *place;

	if (regcode == &regdummy) {
		regsize += 3;
		return;
	}

	src = regcode;
	regcode += 3;
	dst = regcode;
	while (src > opnd)
		*--dst = *--src;

	place = opnd;		/* Op node, where operand used to be. */
	*place++ = (char)op;
	*place++ = '\0';
	*place = '\0';
}

/*
 - regtail - set the next-pointer at the end of a node chain
 */
static void
regtail(p, val)
char *p;
char *val;
{
	register char *scan;
	register char *temp;
	register int offset;

	if (p == &regdummy)
		return;

	/* Find last node. */
	scan = p;
	for (;;) {
		temp = regnext(scan);
		if (temp == NULL)
			break;
		scan = temp;
	}

	if (OP(scan) == BACK)
		offset = scan - val;
	else
		offset = val - scan;
	*(scan+1) = (char)(offset>>8)&0377;
	*(scan+2) = (char)offset&0377;
}

/*
 - regoptail - regtail on operand of first argument; nop if operandless
 */
static void
regoptail(p, val)
char *p;
char *val;
{
	/* "Operandless" and "op != BRANCH" are synonymous in practice. */
	if (p == NULL || p == &regdummy || OP(p) != BRANCH)
		return;
	regtail(OPERAND(p), val);
}

/*
 * regexec and friends
 */

/*
 * Global work variables for regexec().
 */
static char *reginput;		/* String-input pointer. */
NOTSTATIC char *regbol;		/* Beginning of input, for ^ check. */
static char **regstartp;	/* Pointer to startp array. */
static char **regendp;		/* Ditto for endp. */

/*
 * Forwards.
 */

NOTSTATIC int regtry();
STATIC int regmatch();
STATIC int regrepeat();

#ifdef DEBUG
int regnarrate = 0;
void regdump();
STATIC char *regprop();
#endif

#if 0
/*
 - regexec - match a regexp against a string
 */
int
regexec(prog, string, stringlength, matchlength)
register regexp *prog;
register char *string;	/* note: CURRENTLY ASSUMED TO BE NULL-TERMINATED!!! */
int stringlength;	/* length of string */
int *matchlength;	/* number of chars matched (or to be skipped) */
			/* set when MATCH or CANT_MATCH */
{
	register char *s;
	extern char *strchr();

	/* Be paranoid... */
	if (prog == NULL || string == NULL) {
		regerror("NULL parameter");
		return(EXP_TCLERROR);
	}

	/* Check validity of program. */
	if (UCHARAT(prog->program) != MAGIC) {
		regerror("corrupted program");
		return(EXP_KM_ERROR);
	}

#if THIS_RUINS_EXP
/* no need for this shortcut anyway */
	/* If there is a "must appear" string, look for it. */
	if (prog->regmust != NULL) {
		s = string;
		while ((s = strchr(s, prog->regmust[0])) != NULL) {
			if (strncmp(s, prog->regmust, prog->regmlen) == 0)
				break;	/* Found it. */
			s++;
		}
		if (s == NULL)	/* Not present. */
			return(0);
	}
#endif

	/* Mark beginning of line for ^ . */
	regbol = string;

	/* Simplest case:  anchored match need be tried only once. */
	if (prog->reganch) {
		int r = regtry(prog,string,matchlength);
		if (r == CANT_MATCH) *matchlength = stringlength;
		return(r);
	}

	/* Messy cases:  unanchored match. */
	s = string;
	if (prog->regstart != '\0') {
		register char *s2 = s;

		/* We know what char it must start with. */
		while (1) {
			int r;

			s2 = strchr(s2,prog->regstart);
			if (s2 == 0) {
				*matchlength = stringlength;
				return(CANT_MATCH);
			}
			r = regtry(prog,s2,matchlength);
			if (r == CANT_MATCH) {
				s2++;
				continue;
			}
			if (s2 == s) return(r);
			*matchlength = s2-s;
			return CANT_MATCH;
		}
	} else {
		/* We don't -- general case. */
		register char *s2 = s;
		int r = regtry(prog,s,matchlength);
		if (r == EXP_MATCH) return(r);
		else if (r == EXP_CANMATCH) return(r);
		/* at this point, we know some characters at front */
		/* of string don't match */
		for (s2++;*s2;s2++) {
			r = regtry(prog,s2,matchlength);
			if (r == CANT_MATCH) continue;
			/* if we match or can_match, say cant_match and */
			/* record the number of chars at front that don't match */
			*matchlength = s2-s;
			return(CANT_MATCH);
		}
		/* made it thru string with CANT_MATCH all the way */
		*matchlength = stringlength;
		return(CANT_MATCH);
	}
}
#endif

/*
 - regtry - try match at specific point
 */
/* return CAN_MATCH, CANT_MATCH or MATCH */
int			/* 0 failure, 1 success */
regtry(prog, string, matchlength)
regexp *prog;
char *string;
int *matchlength;	/* only set for MATCH */
{
	register int i;
	register char **sp;
	register char **ep;
	int r;		/* result of regmatch */

	reginput = string;
	regstartp = prog->startp;
	regendp = prog->endp;

	sp = prog->startp;
	ep = prog->endp;
	for (i = NSUBEXP; i > 0; i--) {
		*sp++ = NULL;
		*ep++ = NULL;
	}
	r = regmatch(prog->program + 1);
	if (EXP_MATCH == r) {
		prog->startp[0] = string;
		prog->endp[0] = reginput;
		*matchlength = reginput-string;
		return(EXP_MATCH);
	}
	return(r);	/* CAN_MATCH or CANT_MATCH */
}

/*
 - regmatch - main matching routine
 *
 * Conceptually the strategy is simple:  check to see whether the current
 * node matches, call self recursively to see whether the rest matches,
 * and then act accordingly.  In practice we make some effort to avoid
 * recursion, in particular by going through "ordinary" nodes (that don't
 * need to know whether the rest of the match failed) by a loop instead of
 * by recursion.
 */
/* returns CAN, CANT or MATCH */
static int			/* 0 failure, 1 success */
regmatch(prog)
char *prog;
{
	register char *scan;	/* Current node. */
	char *next;		/* Next node. */
#ifndef strchr	/* May be #defined to something else */
	extern char *strchr();
#endif

	scan = prog;
#ifdef DEBUG
	if (scan != NULL && regnarrate)
		fprintf(stderr, "%s(\n", regprop(scan));
#endif
	while (scan != NULL) {
#ifdef DEBUG
		if (regnarrate)
			fprintf(stderr, "%s...\n", regprop(scan));
#endif
		next = regnext(scan);

		switch (OP(scan)) {
		case BOL:
			if (reginput != regbol)
/*				return(0);*/
				return(EXP_CANTMATCH);
			break;
		case EOL:
			if (*reginput != '\0')
/*				return(0);*/
/* note this implies that "$" must match everything received to this point! */
				return(EXP_CANTMATCH);
			break;
		case ANY:
			if (*reginput == '\0')
/*				return(0);*/
				return(EXP_CANMATCH);
			reginput++;
			break;
		case EXACTLY: {
/*				register int len;*/
				register char *opnd;

				opnd = OPERAND(scan);

				/* this section of code is totally rewritten - DEL */
				/* group of literal chars in pattern */
				/* compare each one */
				do {
					if (*opnd != *reginput) {
						if (*reginput == '\0') {
							return EXP_CANMATCH;
						} else 	return EXP_CANTMATCH;
					}

					reginput++;
					opnd++;
				} while (*opnd != '\0');
			}
			break;
		case ANYOF:
/* 			if (*reginput == '\0' || strchr(OPERAND(scan), *reginput) == NULL)
				return(0);
*/
			if (*reginput == '\0')
				return(EXP_CANMATCH);
			if (strchr(OPERAND(scan),*reginput) == NULL)
				return(EXP_CANTMATCH);
			reginput++;
			break;
		case ANYBUT:
/* 			if (*reginput == '\0' || strchr(OPERAND(scan), *reginput) != NULL)
				return(0);
*/
			if (*reginput == '\0')
				return(EXP_CANMATCH);
			if (strchr(OPERAND(scan),*reginput) != NULL)
				return(EXP_CANTMATCH);
			reginput++;
			break;
		case NOTHING:
			break;
		case BACK:
			break;
		case OPEN+1:
		case OPEN+2:
		case OPEN+3:
		case OPEN+4:
		case OPEN+5:
		case OPEN+6:
		case OPEN+7:
		case OPEN+8:
		case OPEN+9: {
				register int no;
				register char *save;
				int r;	/* result of regmatch */

	doOpen:
				no = OP(scan) - OPEN;
				save = reginput;

				r = regmatch(next);
				if (r == EXP_MATCH) {
					/*
					 * Don't set startp if some later
					 * invocation of the same parentheses
					 * already has.
					 */
					if (regstartp[no] == NULL)
						regstartp[no] = save;
				}
				return(r);
			}
			/* NOTREACHED */
			break;
		case CLOSE+1:
		case CLOSE+2:
		case CLOSE+3:
		case CLOSE+4:
		case CLOSE+5:
		case CLOSE+6:
		case CLOSE+7:
		case CLOSE+8:
		case CLOSE+9: {
				register int no;
				register char *save;
				int r;	/* result of regmatch */

	doClose:
				no = OP(scan) - CLOSE;
				save = reginput;

				r = regmatch(next);
				if (r == EXP_MATCH) {
					/*
					 * Don't set endp if some later
					 * invocation of the same parentheses
					 * already has.
					 */
					if (regendp[no] == NULL)
						regendp[no] = save;
				}
				return(r);
			}
			/* NOTREACHED */
			break;
		case BRANCH: {
				register char *save;
				int match_status;

				if (OP(next) != BRANCH)		/* No choice. */
					next = OPERAND(scan);	/* Avoid recursion. */
				else {
					match_status = EXP_CANTMATCH;

					do {
						int r;

						save = reginput;
						r = regmatch(OPERAND(scan));
						if (r == EXP_MATCH) return(r);
						if (r == EXP_CANMATCH) {
							match_status = r;
						}
						reginput = save;
						scan = regnext(scan);
					} while (scan != NULL && OP(scan) == BRANCH);
					return(match_status);
					/* NOTREACHED */
				}
			}
			/* NOTREACHED */
			break;
		case STAR:
		case PLUS: {
				register char nextch;
				register int no;
				register char *save;
				register int min;
				int match_status;

				/*
				 * Lookahead to avoid useless match attempts
				 * when we know what character comes next.
				 */
				match_status = EXP_CANTMATCH;
				nextch = '\0';
				if (OP(next) == EXACTLY)
					nextch = *OPERAND(next);
				min = (OP(scan) == STAR) ? 0 : 1;
				save = reginput;
				no = regrepeat(OPERAND(scan));
				while (no >= min) {
					/* If it could work, try it. */
					/* 3rd condition allows for CAN_MATCH */
					if (nextch == '\0' || *reginput == nextch || *reginput == '\0') {
						int r = regmatch(next);
						if (r == EXP_MATCH)
							return(EXP_MATCH);
						if (r == EXP_CANMATCH)
							match_status = r;
					}
					/* Couldn't or didn't -- back up. */
					no--;
					reginput = save + no;
				}
				return(match_status);
			}
			/* NOTREACHED */
			break;
		case END:
			return(EXP_MATCH);	/* Success! */
			/* NOTREACHED */
			break;
		default:
			if (OP(scan) > OPEN && OP(scan) < OPEN+NSUBEXP) {
				goto doOpen;
			} else if (OP(scan) > CLOSE && OP(scan) < CLOSE+NSUBEXP) {
				goto doClose;
			}
			regerror("memory corruption");
			return(EXP_TCLERROR);
			/* NOTREACHED */
			break;
		}

		scan = next;
	}

	/*
	 * We get here only if there's trouble -- normally "case END" is
	 * the terminating point.
	 */
	regerror("corrupted pointers");
	return(EXP_TCLERROR);
}

/*
 - regrepeat - repeatedly match something simple, report how many
 */
static int
regrepeat(p)
char *p;
{
	register int count = 0;
	register char *scan;
	register char *opnd;
#ifndef strchr	/* May be #defined to something else */
/*DEL*/	extern char *strchr();
#endif

	scan = reginput;
	opnd = OPERAND(p);
	switch (OP(p)) {
	case ANY:
		count = strlen(scan);
		scan += count;
		break;
	case EXACTLY:
		while (*opnd == *scan) {
			count++;
			scan++;
		}
		break;
	case ANYOF:
		while (*scan != '\0' && strchr(opnd, *scan) != NULL) {
			count++;
			scan++;
		}
		break;
	case ANYBUT:
		while (*scan != '\0' && strchr(opnd, *scan) == NULL) {
			count++;
			scan++;
		}
		break;
	default:		/* Oh dear.  Called inappropriately. */
		regerror("internal foulup");
		count = 0;	/* Best compromise. */
		break;
	}
	reginput = scan;

	return(count);
}

/*
 - regnext - dig the "next" pointer out of a node
 */
static char *
regnext(p)
register char *p;
{
	register int offset;

	if (p == &regdummy)
		return(NULL);

	offset = NEXT(p);
	if (offset == 0)
		return(NULL);

	if (OP(p) == BACK)
		return(p-offset);
	else
		return(p+offset);
}

#ifdef DEBUG

STATIC char *regprop();

/*
 - regdump - dump a regexp onto stdout in vaguely comprehensible form
 */
void
regdump(r)
regexp *r;
{
	register char *s;
	register char op = EXACTLY;	/* Arbitrary non-END op. */
	register char *next;
	extern char *strchr();


	s = r->program + 1;
	while (op != END) {	/* While that wasn't END last time... */
		op = OP(s);
		printf("%2d%s", s-r->program, regprop(s));	/* Where, what. */
		next = regnext(s);
		if (next == NULL)		/* Next ptr. */
			printf("(0)");
		else 
			printf("(%d)", (s-r->program)+(next-s));
		s += 3;
		if (op == ANYOF || op == ANYBUT || op == EXACTLY) {
			/* Literal string, where present. */
			while (*s != '\0') {
				putchar(*s);
				s++;
			}
			s++;
		}
		putchar('\n');
	}

	/* Header fields of interest. */
	if (r->regstart != '\0')
		printf("start `%c' ", r->regstart);
	if (r->reganch)
		printf("anchored ");
	if (r->regmust != NULL)
		printf("must have \"%s\"", r->regmust);
	printf("\n");
}

/*
 - regprop - printable representation of opcode
 */
static char *
regprop(op)
char *op;
{
	register char *p;
	static char buf[50];

	(void) strcpy(buf, ":");

	switch (OP(op)) {
	case BOL:
		p = "BOL";
		break;
	case EOL:
		p = "EOL";
		break;
	case ANY:
		p = "ANY";
		break;
	case ANYOF:
		p = "ANYOF";
		break;
	case ANYBUT:
		p = "ANYBUT";
		break;
	case BRANCH:
		p = "BRANCH";
		break;
	case EXACTLY:
		p = "EXACTLY";
		break;
	case NOTHING:
		p = "NOTHING";
		break;
	case BACK:
		p = "BACK";
		break;
	case END:
		p = "END";
		break;
	case OPEN+1:
	case OPEN+2:
	case OPEN+3:
	case OPEN+4:
	case OPEN+5:
	case OPEN+6:
	case OPEN+7:
	case OPEN+8:
	case OPEN+9:
		sprintf(buf+strlen(buf), "OPEN%d", OP(op)-OPEN);
		p = NULL;
		break;
	case CLOSE+1:
	case CLOSE+2:
	case CLOSE+3:
	case CLOSE+4:
	case CLOSE+5:
	case CLOSE+6:
	case CLOSE+7:
	case CLOSE+8:
	case CLOSE+9:
		sprintf(buf+strlen(buf), "CLOSE%d", OP(op)-CLOSE);
		p = NULL;
		break;
	case STAR:
		p = "STAR";
		break;
	case PLUS:
		p = "PLUS";
		break;
	default:
		if (OP(op) > OPEN && OP(op) < OPEN+NSUBEXP) {
		    sprintf(buf+strlen(buf), "OPEN%d", OP(op)-OPEN);
		    p = NULL;
		    break;
		} else if (OP(op) > CLOSE && OP(op) < CLOSE+NSUBEXP) {
		    sprintf(buf+strlen(buf), "CLOSE%d", OP(op)-CLOSE);
		    p = NULL;
		} else {
		    TclRegError("corrupted opcode");
		}
		break;
	}
	if (p != NULL)
		(void) strcat(buf, p);
	return(buf);
}
#endif

/*
 * The following is provided for those people who do not have strcspn() in
 * their C libraries.  They should get off their butts and do something
 * about it; at least one public-domain implementation of those (highly
 * useful) string routines has been published on Usenet.
 */
#ifdef STRCSPN
/*
 * strcspn - find length of initial segment of s1 consisting entirely
 * of characters not from s2
 */

static int
strcspn(s1, s2)
char *s1;
char *s2;
{
	register char *scan1;
	register char *scan2;
	register int count;

	count = 0;
	for (scan1 = s1; *scan1 != '\0'; scan1++) {
		for (scan2 = s2; *scan2 != '\0';)	/* ++ moved down. */
			if (*scan1 == *scan2++)
				return(count);
		count++;
	}
	return(count);
}
#endif






Deleted generic/exp_regexp.h.





1
2
3
4
5
6
7
8










-
-
-
-
-
-
-
-

/* access to regexp internals */
#define regbol		exp_regbol
#define regtry		exp_regtry
#define regexec		exp_regexec
#define regerror	TclRegError
extern char *regbol;
int regtry();







Deleted generic/exp_strf.c.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614








































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

/* exp_strp.c - functions for exp_timestamp */
/*
 * strftime.c
 *
 * Public-domain implementation of ANSI C library routine.
 *
 * It's written in old-style C for maximal portability.
 * However, since I'm used to prototypes, I've included them too.
 *
 * If you want stuff in the System V ascftime routine, add the SYSV_EXT define.
 * For extensions from SunOS, add SUNOS_EXT.
 * For stuff needed to implement the P1003.2 date command, add POSIX2_DATE.
 * For VMS dates, add VMS_EXT.
 * For complete POSIX semantics, add POSIX_SEMANTICS.
 *
 * The code for %c, %x, and %X now follows the 1003.2 specification for
 * the POSIX locale.
 * This version ignores LOCALE information.
 * It also doesn't worry about multi-byte characters.
 * So there.
 *
 * This file is also shipped with GAWK (GNU Awk), gawk specific bits of
 * code are included if GAWK is defined.
 *
 * Arnold Robbins <[email protected]>
 * January, February, March, 1991
 * Updated March, April 1992
 * Updated April, 1993
 * Updated February, 1994
 * Updated May, 1994
 * Updated January 1995
 * Updated September 1995
 *
 * Fixes from [email protected]
 * February 1991, May 1992
 * Fixes from Tor Lillqvist [email protected]
 * May, 1993
 * Further fixes from [email protected]
 * February 1994
 * %z code from [email protected]
 * Applied September 1995
 *
 *
 * Modified by Don Libes for Expect, 10/93 and 12/95.
 * Forced POSIX semantics.
 * Replaced inline/min/max stuff with a single range function.
 * Removed tzset stuff.
 * Commented out tzname stuff.
 *
 * According to Arnold, the current version of this code can ftp'd from
 * ftp.mathcs.emory.edu:/pub/arnold/strftime.shar.gz
 *
 */

#include "exp_port.h"
#include "tcl.h"

#include <stdio.h>
#include <ctype.h>
#include "string.h"

/* according to Karl Vogel, time.h is insufficient on Pyramid */
/* following is recommended by autoconf */

#ifdef TIME_WITH_SYS_TIME
# include <sys/time.h>
# include <time.h>
#else
# ifdef HAVE_SYS_TIME_H
#  include <sys/time.h>
# else
#  include <time.h>
# endif
#endif



#include <sys/types.h>

#define SYSV_EXT	1	/* stuff in System V ascftime routine */
#define POSIX2_DATE	1	/* stuff in Posix 1003.2 date command */

#if defined(POSIX2_DATE) && ! defined(SYSV_EXT)
#define SYSV_EXT	1
#endif

#if defined(POSIX2_DATE)
#define adddecl(stuff)	stuff
#else
#define adddecl(stuff)
#endif

#ifndef __STDC__
#define const

static int weeknumber();
adddecl(static int iso8601wknum();)
#else

extern char *strchr(const char *str, int ch);
static int weeknumber(const struct tm *timeptr, int firstweekday);
adddecl(static int iso8601wknum(const struct tm *timeptr);)
#endif

/* attempt to use strftime to compute timezone, else fallback to */
/* less portable ways */
#if !defined(HAVE_STRFTIME)
# if defined(HAVE_SV_TIMEZONE)
#ifndef __WIN32__
extern char *tzname[2];
extern int daylight;
#endif
# else
#  if defined(HAVE_TIMEZONE)

char           *
zone_name (tp)
struct tm      *tp;
{
	char           *timezone ();
	struct timeval  tv;
	struct timezone tz;

	gettimeofday (&tv, &tz);

	return timezone (tz.tz_minuteswest, tp->tm_isdst);
}

#  endif /* HAVE_TIMEZONE */
# endif /* HAVE_SV_TIMEZONE */
#endif /* HAVE_STRFTIME */

static int
range(low,item,hi)
int low, item, hi;
{
	if (item < low) return low;
	if (item > hi) return hi;
	return item;
}

/* strftime --- produce formatted time */

void
/*size_t*/
#ifndef __STDC__
exp_strftime(/*s,*/ format, timeptr, dstring)
/*char *s;*/
char *format;
const struct tm *timeptr;
Tcl_DString *dstring;
#else
/*exp_strftime(char *s, size_t maxsize, const char *format, const struct tm *timeptr)*/
exp_strftime(char *format, const struct tm *timeptr,Tcl_DString *dstring)
#endif
{
	int copied;	/* used to suppress copying when called recursively */

#if 0
	char *endp = s + maxsize;
	char *start = s;
#endif
	char *percentptr;

	char tbuf[100];
	int i;

	/* various tables, useful in North America */
	static char *days_a[] = {
		"Sun", "Mon", "Tue", "Wed",
		"Thu", "Fri", "Sat",
	};
	static char *days_l[] = {
		"Sunday", "Monday", "Tuesday", "Wednesday",
		"Thursday", "Friday", "Saturday",
	};
	static char *months_a[] = {
		"Jan", "Feb", "Mar", "Apr", "May", "Jun",
		"Jul", "Aug", "Sep", "Oct", "Nov", "Dec",
	};
	static char *months_l[] = {
		"January", "February", "March", "April",
		"May", "June", "July", "August", "September",
		"October", "November", "December",
	};
	static char *ampm[] = { "AM", "PM", };

/*	for (; *format && s < endp - 1; format++) {*/
	for (; *format ; format++) {
		tbuf[0] = '\0';
		copied = 0;		/* has not been copied yet */
		percentptr = strchr(format,'%');
		if (percentptr == 0) {
			Tcl_DStringAppend(dstring,format,-1);
			goto out;
		} else if (percentptr != format) {
			Tcl_DStringAppend(dstring,format,percentptr - format);
			format = percentptr;
	        }
#if 0
		if (*format != '%') {
			*s++ = *format;
			continue;
		}
#endif
	again:
		switch (*++format) {
		case '\0':
			Tcl_DStringAppend(dstring,"%",1);
#if 0
			*s++ = '%';
#endif
			goto out;

		case '%':
			Tcl_DStringAppend(dstring,"%",1);
			copied = 1;
			break;
#if 0
			*s++ = '%';
			continue;
#endif

		case 'a':	/* abbreviated weekday name */
			if (timeptr->tm_wday < 0 || timeptr->tm_wday > 6)
				strcpy(tbuf, "?");
			else
				strcpy(tbuf, days_a[timeptr->tm_wday]);
			break;

		case 'A':	/* full weekday name */
			if (timeptr->tm_wday < 0 || timeptr->tm_wday > 6)
				strcpy(tbuf, "?");
			else
				strcpy(tbuf, days_l[timeptr->tm_wday]);
			break;

#ifdef SYSV_EXT
		case 'h':	/* abbreviated month name */
#endif
		case 'b':	/* abbreviated month name */
			if (timeptr->tm_mon < 0 || timeptr->tm_mon > 11)
				strcpy(tbuf, "?");
			else
				strcpy(tbuf, months_a[timeptr->tm_mon]);
			break;

		case 'B':	/* full month name */
			if (timeptr->tm_mon < 0 || timeptr->tm_mon > 11)
				strcpy(tbuf, "?");
			else
				strcpy(tbuf, months_l[timeptr->tm_mon]);
			break;

		case 'c':	/* appropriate date and time representation */
			sprintf(tbuf, "%s %s %2d %02d:%02d:%02d %d",
				days_a[range(0, timeptr->tm_wday, 6)],
				months_a[range(0, timeptr->tm_mon, 11)],
				range(1, timeptr->tm_mday, 31),
				range(0, timeptr->tm_hour, 23),
				range(0, timeptr->tm_min, 59),
				range(0, timeptr->tm_sec, 61),
				timeptr->tm_year + 1900);
			break;

		case 'd':	/* day of the month, 01 - 31 */
			i = range(1, timeptr->tm_mday, 31);
			sprintf(tbuf, "%02d", i);
			break;

		case 'H':	/* hour, 24-hour clock, 00 - 23 */
			i = range(0, timeptr->tm_hour, 23);
			sprintf(tbuf, "%02d", i);
			break;

		case 'I':	/* hour, 12-hour clock, 01 - 12 */
			i = range(0, timeptr->tm_hour, 23);
			if (i == 0)
				i = 12;
			else if (i > 12)
				i -= 12;
			sprintf(tbuf, "%02d", i);
			break;

		case 'j':	/* day of the year, 001 - 366 */
			sprintf(tbuf, "%03d", timeptr->tm_yday + 1);
			break;

		case 'm':	/* month, 01 - 12 */
			i = range(0, timeptr->tm_mon, 11);
			sprintf(tbuf, "%02d", i + 1);
			break;

		case 'M':	/* minute, 00 - 59 */
			i = range(0, timeptr->tm_min, 59);
			sprintf(tbuf, "%02d", i);
			break;

		case 'p':	/* am or pm based on 12-hour clock */
			i = range(0, timeptr->tm_hour, 23);
			if (i < 12)
				strcpy(tbuf, ampm[0]);
			else
				strcpy(tbuf, ampm[1]);
			break;

		case 'S':	/* second, 00 - 61 */
			i = range(0, timeptr->tm_sec, 61);
			sprintf(tbuf, "%02d", i);
			break;

		case 'U':	/* week of year, Sunday is first day of week */
			sprintf(tbuf, "%02d", weeknumber(timeptr, 0));
			break;

		case 'w':	/* weekday, Sunday == 0, 0 - 6 */
			i = range(0, timeptr->tm_wday, 6);
			sprintf(tbuf, "%d", i);
			break;

		case 'W':	/* week of year, Monday is first day of week */
			sprintf(tbuf, "%02d", weeknumber(timeptr, 1));
			break;

		case 'x':	/* appropriate date representation */
			sprintf(tbuf, "%s %s %2d %d",
				days_a[range(0, timeptr->tm_wday, 6)],
				months_a[range(0, timeptr->tm_mon, 11)],
				range(1, timeptr->tm_mday, 31),
				timeptr->tm_year + 1900);
			break;

		case 'X':	/* appropriate time representation */
			sprintf(tbuf, "%02d:%02d:%02d",
				range(0, timeptr->tm_hour, 23),
				range(0, timeptr->tm_min, 59),
				range(0, timeptr->tm_sec, 61));
			break;

		case 'y':	/* year without a century, 00 - 99 */
			i = timeptr->tm_year % 100;
			sprintf(tbuf, "%02d", i);
			break;

		case 'Y':	/* year with century */
			sprintf(tbuf, "%d", 1900 + timeptr->tm_year);
			break;

		case 'Z':	/* time zone name or abbrevation */
#if defined(HAVE_STRFTIME)
			strftime(tbuf,sizeof tbuf,"%Z",timeptr);
#else
# if defined(HAVE_SV_TIMEZONE)
			i = 0;
			if (daylight && timeptr->tm_isdst)
				i = 1;
			strcpy(tbuf, tzname[i]);
# else
			strcpy(tbuf, zone_name (timeptr));
#  if defined(HAVE_TIMEZONE)
#  endif /* HAVE_TIMEZONE */
			/* no timezone available */
			/* feel free to add others here */
# endif /* HAVE_SV_TIMEZONE */
#endif /* HAVE STRFTIME */
			break;

#ifdef SYSV_EXT
		case 'n':	/* same as \n */
			tbuf[0] = '\n';
			tbuf[1] = '\0';
			break;

		case 't':	/* same as \t */
			tbuf[0] = '\t';
			tbuf[1] = '\0';
			break;

		case 'D':	/* date as %m/%d/%y */
			exp_strftime("%m/%d/%y", timeptr, dstring);
			copied = 1;
/*			exp_strftime(tbuf, sizeof tbuf, "%m/%d/%y", timeptr);*/
			break;

		case 'e':	/* day of month, blank padded */
			sprintf(tbuf, "%2d", range(1, timeptr->tm_mday, 31));
			break;

		case 'r':	/* time as %I:%M:%S %p */
			exp_strftime("%I:%M:%S %p", timeptr, dstring);
			copied = 1;
/*			exp_strftime(tbuf, sizeof tbuf, "%I:%M:%S %p", timeptr);*/
			break;

		case 'R':	/* time as %H:%M */
			exp_strftime("%H:%M", timeptr, dstring);
			copied = 1;
/*			exp_strftime(tbuf, sizeof tbuf, "%H:%M", timeptr);*/
			break;

		case 'T':	/* time as %H:%M:%S */
			exp_strftime("%H:%M:%S", timeptr, dstring);
			copied = 1;
/*			exp_strftime(tbuf, sizeof tbuf, "%H:%M:%S", timeptr);*/
			break;
#endif

#ifdef POSIX2_DATE
		case 'C':
			sprintf(tbuf, "%02d", (timeptr->tm_year + 1900) / 100);
			break;


		case 'E':
		case 'O':
			/* POSIX locale extensions, ignored for now */
			goto again;
		case 'V':	/* week of year according ISO 8601 */
			sprintf(tbuf, "%02d", iso8601wknum(timeptr));
			break;

		case 'u':
		/* ISO 8601: Weekday as a decimal number [1 (Monday) - 7] */
			sprintf(tbuf, "%d", timeptr->tm_wday == 0 ? 7 :
					timeptr->tm_wday);
			break;
#endif	/* POSIX2_DATE */
		default:
			tbuf[0] = '%';
			tbuf[1] = *format;
			tbuf[2] = '\0';
			break;
		}
		if (!copied)
			Tcl_DStringAppend(dstring,tbuf,-1);
#if 0
		i = strlen(tbuf);
		if (i) {
			if (s + i < endp - 1) {
				strcpy(s, tbuf);
				s += i;
			} else
				return 0;
#endif
	}
out:;
#if 0
	if (s < endp && *format == '\0') {
		*s = '\0';
		return (s - start);
	} else
		return 0;
#endif
}

/* isleap --- is a year a leap year? */

#ifndef __STDC__
static int
isleap(year)
int year;
#else
static int
isleap(int year)
#endif
{
	return ((year % 4 == 0 && year % 100 != 0) || year % 400 == 0);
}

#ifdef POSIX2_DATE
/* iso8601wknum --- compute week number according to ISO 8601 */

#ifndef __STDC__
static int
iso8601wknum(timeptr)
const struct tm *timeptr;
#else
static int
iso8601wknum(const struct tm *timeptr)
#endif
{
	/*
	 * From 1003.2:
	 *	If the week (Monday to Sunday) containing January 1
	 *	has four or more days in the new year, then it is week 1;
	 *	otherwise it is the highest numbered week of the previous
	 *	(52 or 53) year, and the next week is week 1.
	 *
	 * ADR: This means if Jan 1 was Monday through Thursday,
	 *	it was week 1, otherwise week 53.
	 * 
	 * XPG4 erroneously included POSIX.2 rationale text in the
	 * main body of the standard. Thus it requires week 53.
	 */

	int weeknum, jan1day;

	/* get week number, Monday as first day of the week */
	weeknum = weeknumber(timeptr, 1);

	/*
	 * With thanks and tip of the hatlo to [email protected]
	 *
	 * What day of the week does January 1 fall on?
	 * We know that
	 *	(timeptr->tm_yday - jan1.tm_yday) MOD 7 ==
	 *		(timeptr->tm_wday - jan1.tm_wday) MOD 7
	 * and that
	 * 	jan1.tm_yday == 0
	 * and that
	 * 	timeptr->tm_wday MOD 7 == timeptr->tm_wday
	 * from which it follows that. . .
 	 */
	jan1day = timeptr->tm_wday - (timeptr->tm_yday % 7);
	if (jan1day < 0)
		jan1day += 7;

	/*
	 * If Jan 1 was a Monday through Thursday, it was in
	 * week 1.  Otherwise it was last year's highest week, which is
	 * this year's week 0.
	 *
	 * What does that mean?
	 * If Jan 1 was Monday, the week number is exactly right, it can
	 *	never be 0.
	 * If it was Tuesday through Thursday, the weeknumber is one
	 *	less than it should be, so we add one.
	 * Otherwise, Friday, Saturday or Sunday, the week number is
	 * OK, but if it is 0, it needs to be 52 or 53.
	 */
	switch (jan1day) {
	case 1:		/* Monday */
		break;
	case 2:		/* Tuesday */
	case 3:		/* Wednesday */
	case 4:		/* Thursday */
		weeknum++;
		break;
	case 5:		/* Friday */
	case 6:		/* Saturday */
	case 0:		/* Sunday */
		if (weeknum == 0) {
#ifdef USE_BROKEN_XPG4
			/* XPG4 (as of March 1994) says 53 unconditionally */
			weeknum = 53;
#else
			/* get week number of last week of last year */
			struct tm dec31ly;	/* 12/31 last year */
			dec31ly = *timeptr;
			dec31ly.tm_year--;
			dec31ly.tm_mon = 11;
			dec31ly.tm_mday = 31;
			dec31ly.tm_wday = (jan1day == 0) ? 6 : jan1day - 1;
			dec31ly.tm_yday = 364 + isleap(dec31ly.tm_year + 1900);
			weeknum = iso8601wknum(& dec31ly);
#endif
		}
		break;
	}

	if (timeptr->tm_mon == 11) {
		/*
		 * The last week of the year
		 * can be in week 1 of next year.
		 * Sigh.
		 *
		 * This can only happen if
		 *	M   T  W
		 *	29  30 31
		 *	30  31
		 *	31
		 */
		int wday, mday;

		wday = timeptr->tm_wday;
		mday = timeptr->tm_mday;
		if (   (wday == 1 && (mday >= 29 && mday <= 31))
		    || (wday == 2 && (mday == 30 || mday == 31))
		    || (wday == 3 &&  mday == 31))
			weeknum = 1;
	}

	return weeknum;
}
#endif

/* weeknumber --- figure how many weeks into the year */

/* With thanks and tip of the hatlo to [email protected] */

#ifndef __STDC__
static int
weeknumber(timeptr, firstweekday)
const struct tm *timeptr;
int firstweekday;
#else
static int
weeknumber(const struct tm *timeptr, int firstweekday)
#endif
{
	int wday = timeptr->tm_wday;
	int ret;

	if (firstweekday == 1) {
		if (wday == 0)	/* sunday */
			wday = 6;
		else
			wday--;
	}
	ret = ((timeptr->tm_yday + 7 - wday) / 7);
	if (ret < 0)
		ret = 0;
	return ret;
}






Changes to generic/expect.c.





1
2
3


4
5
6
7
8
9
10
11






12
13
14
15
16
17
18
19

20
21
22
23
24
25
26
27
28

29








30
31
32

33


34
35
36
37
38

39
40
41
42

43
44
45
46
47
48
49
50
51
52
53
54














55
56
57
58
59
60
61
62



63
64
65
66
67
68
69
70
71
72
73
74
75
76





77
78
79


80
81
82
83

84
85
86
87
88
89
90
91
92


93
94
95
96
97
98
99
100
101
102
103






104
105
106
107
108
109
110
111
112
113
114



115
116
117
118
119
120





121
122
123
124
125
126



127
128
129
130

131
132
133
134
135
136







137
138

139
140
141
142
143


144
145
146
147
148
149
150
151
152
153
154
155
156
157

158
159
160
161
162
163
164
165







166
167

168
169
170
171
172

173
174
175
176








177
178

179
180
181

182
183
184

185
186
187
188
189
190
191
192
193
194
195
196



197
198
199
200
201
202


203
204
205
206
207
208
209
210
211

212
213
214
215
216
217
218
219

220
221
222
223
224
225
226
227
228
229
230
231



232
233

234
235

236
237
238
239
240




241
242
243


244
245
246
247
248
249
250
251












252
253
254


255
256
257
258
259
260
261
262
263
264
265
266
267
268
269



270
271
272
273
274
275
276






277
278
279

280
281
282
283
284
285


286
287
288
289



290
291
292
293
294
295
296
297
298
299









300
301
302
303
304
305

306
307
308


309
310


311
312
313
314
315
316





317
318
319
320
321
322





323
324
325
326
327
328
329
330
331
332
333
334
335
336




















337
338









339

340

341
342
343
344
345
346
347
348
349
350



























351
352
353
354
355
356
357
358
359


















360
361
362
363
364
365
366
367
368
369













370
371
372
373








374

375
376
377
378
379

380
381
382
383
384
385





386
387
388


389
390
391


392
393
394
395
396
397

398
399
400


401
402
403
404
405

406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
















424
425
426
427
428
429
430






431
432
433
434
435

436
437
438
439
440



441
442
443


444
445

446
447
448
449


450
451
452
453
454
455
456
457
458
459
460
461
462

463
464
465
466
467
468
469
470
471























472
473
474



475
476
477

478
479

480
481
482
483
484
485
486
487
488






489




490
491
492







493
494


495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510






511
512
513
514
515
516












517
518



519
520
521
522
523
524

525
526

527
528
529


530
531
532
533
534

535

536
537

538

539
540
541


542
543



544

545
546
547
548


549
550
551
552
553






554
555
556
557
558
559
560
561
562
563
564
565
566
567

















































568
569
570
571
572
573
574
575








576
577
578
579
580
581
582
583
584
585
















586
587
588


589
590


591
592
593
594
595
596
597
598


599
600
601
602



603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640




641
642



643
644
645
646

647
648
649

650
651
652





653
654
655
656
657
658
659
660
661
662







663
664
665
666
667
668
669
670
671
672
673
674
675
676
677





















































678
679
680

681








682
683
684







685
686








687
688
689


690
691
692


693
694
695


696
697
698
699
700
701
702
703
704
705
706
707
708
709
710




















711


712
713











714
715

716
717

718
719
720


721
722

723
724
725
726
727
728
729







730
731
732
733
734
735
736





737
738
739
740





741
742
743
744
745




746
747
748
749
750
751
752
753
754
755
756

757
758
759
760

761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778












779
780
781

782
783

784
785

786
787
788
789
790
791
792
793
794
795
796
797
798
799

800
801
802
803



804
805
806
807
808
809
810
811
812

813
814
815

816
817
818
819

820
821
822
823
824
825


826
827
828
829
830
831





832
833
834


835
836
837
838
839

840
841

842
843
844
845
846
847
848
849
850
851
852
853



854
855

856
857
858
859
860
861





862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879

















880
881
882
883
884
885
886
887



888
889
890
891
892
893
894
895
896
897









898
899
900
901
902
903
904
905



906
907
908


909
910
911
912
913
914
915
916
917





918
919
920

921
922
923
924
925
926
927
928
929
930
931





932
933
934
935
936
937
938





939
940
941

942
943
944

945
946
947

948
949

950
951
952
953
954
955

956
957
958
959



960
961
962
963



964
965
966


967
968
969

970
971
972


973
974
975
976


977
978
979
980



981
982
983
984



985
986

987
988
989
990

991
992
993
994



995
996

997
998
999
1000
1001




1002
1003
1004
1005
1006
1007


1008
1009
1010


1011
1012

1013
1014
1015
1016
1017
1018





1019
1020
1021
1022
1023
1024
1025
1026



1027
1028
1029
1030
1031
1032
1033






1034
1035
1036
1037
1038
1039


1040
1041
1042
1043
1044
1045





1046
1047
1048
1049



1050
1051
1052
1053
1054
1055





1056
1057
1058
1059



1060
1061
1062
1063
1064
1065
1066
1067

1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080





1081
1082
1083
1084

1085
1086
1087
1088





1089





1090
1091
1092
1093
1094
















1095
1096

1097

1098
1099
1100
1101
1102

1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120

1121
1122
1123


1124
1125

1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138











1139
1140
1141
1142
1143

1144
1145
1146
1147
1148
1149
1150

1151
1152
1153
1154
1155
1156
1157





1158
1159
1160
1161

1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174







1175
1176
1177
1178
1179



1180
1181
1182
1183
1184
1185
1186


1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201


1202
1203
1204
1205


1206
1207
1208
1209
1210

1211
1212

1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231

1232
1233
1234
1235
1236
1237

1238
1239
1240
1241
1242
1243
1244




1
2








3
4
5
6
7
8








9
10
11
12
13

14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31

32
33
34
35
36
37
38
39
40
41
42

43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74



75
76
77
78
79
80
81
82
83
84
85
86





87
88
89
90
91



92
93
94
95
96

97

98
99
100
101
102
103


104
105
106
107
108
109
110






111
112
113
114
115
116
117
118
119
120
121
122
123
124



125
126
127
128





129
130
131
132
133
134
135
136
137
138

139
140
141
142



143
144





145
146
147
148
149
150
151


152





153
154














155








156
157
158
159
160
161
162


163





164




165
166
167
168
169
170
171
172
173

174



175



176







177
178



179
180
181
182


183


184
185
186
187
188
189
190
191
192
193

194
195
196






197







198
199



200
201
202
203

204
205

206
207




208
209
210
211
212


213
214
215
216
217





218
219
220
221
222
223
224
225
226
227
228
229



230
231










232
233



234
235
236
237






238
239
240
241
242
243
244
245

246






247
248




249
250
251










252
253
254
255
256
257
258
259
260






261
262


263
264
265

266
267
268





269
270
271
272
273
274





275
276
277
278
279
280
281












282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301


302
303
304
305
306
307
308
309
310
311
312

313










314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340









341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358







359


360
361
362
363
364
365
366
367
368
369
370
371
372
373



374
375
376
377
378
379
380
381
382
383
384
385
386
387

388
389





390
391
392
393
394



395
396



397
398
399
400
401
402
403

404
405


406
407
408
409
410


411


















412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427







428
429
430
431
432
433





434
435
436



437
438
439



440
441


442
443
444


445
446



447
448
449
450
451
452
453
454
455

456

457
458
459





460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482



483
484
485



486


487




488
489
490
491

492
493
494
495
496
497
498
499
500
501
502
503


504
505
506
507
508
509
510


511
512
513
514














515
516
517
518
519
520
521





522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543

544


545
546


547
548



549

550

551
552

553

554
555


556
557
558
559
560
561
562

563

564


565
566
567
568
569
570
571
572
573
574
575
576
577














578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626








627
628
629
630
631
632
633
634
635









636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652


653
654
655

656
657
658
659
660
661
662
663


664
665
666



667
668
669
670
671
672
673
674
675
676
677
678
679
680
681








682
683
684
685
686
687
688
689
690
691

692
693
694




695
696
697
698
699
700
701
702
703
704
705
706

707
708


709
710
711

712
713
714
715
716
717
718
719







720
721
722
723
724
725
726















727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781

782
783
784
785
786
787
788
789
790
791



792
793
794
795
796
797
798
799

800
801
802
803
804
805
806
807
808


809
810
811


812
813



814
815

816
817












818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840


841
842
843
844
845
846
847
848
849
850
851
852

853
854

855
856


857
858
859

860
861






862
863
864
865
866
867
868







869
870
871
872
873




874
875
876
877
878
879




880
881
882
883
884
885
886
887
888






889




890





891












892
893
894
895
896
897
898
899
900
901
902
903
904
905

906
907

908
909

910
911
912
913
914
915
916
917
918
919
920
921
922
923

924
925



926
927
928
929
930
931
932
933
934
935
936

937
938
939

940
941
942
943

944
945
946
947
948


949
950
951





952
953
954
955
956
957
958

959
960
961
962
963
964

965
966

967
968
969
970
971
972
973
974
975
976



977
978
979
980

981
982





983
984
985
986
987
988

















989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010



1011
1012
1013
1014









1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028



1029
1030
1031
1032


1033
1034
1035
1036
1037
1038





1039
1040
1041
1042
1043
1044
1045

1046
1047
1048
1049
1050
1051
1052





1053
1054
1055
1056
1057
1058
1059





1060
1061
1062
1063
1064
1065
1066

1067
1068
1069

1070
1071
1072

1073
1074

1075
1076
1077
1078
1079
1080

1081
1082



1083
1084
1085
1086



1087
1088
1089
1090


1091
1092
1093
1094

1095
1096


1097
1098




1099
1100
1101



1102
1103
1104
1105



1106
1107
1108
1109

1110
1111
1112
1113

1114
1115



1116
1117
1118
1119

1120
1121




1122
1123
1124
1125
1126
1127
1128
1129


1130
1131
1132


1133
1134


1135
1136





1137
1138
1139
1140
1141
1142
1143
1144
1145
1146



1147
1148
1149
1150






1151
1152
1153
1154
1155
1156
1157
1158
1159
1160


1161
1162
1163





1164
1165
1166
1167
1168
1169



1170
1171
1172
1173





1174
1175
1176
1177
1178
1179



1180
1181
1182
1183
1184






1185







1186





1187
1188
1189
1190
1191
1192
1193
1194
1195
1196




1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207





1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224

1225

1226
1227




1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245

1246



1247
1248
1249

1250













1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261

1262
1263
1264

1265
1266
1267
1268
1269
1270
1271

1272
1273
1274





1275
1276
1277
1278
1279
1280
1281
1282

1283
1284
1285

1286
1287
1288







1289
1290
1291
1292
1293
1294
1295
1296
1297



1298
1299
1300
1301
1302
1303

1304
1305

1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320


1321
1322
1323
1324


1325
1326
1327
1328
1329
1330

1331
1332

1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351

1352
1353
1354
1355
1356
1357

1358
1359
1360
1361
1362
1363
1364
1365

-
-
-
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
-
-
-
-
+




-




+

+
+
+
+
+
+
+
+



+
-
+
+





+



-
+












+
+
+
+
+
+
+
+
+
+
+
+
+
+





-
-
-
+
+
+









-
-
-
-
-
+
+
+
+
+
-
-
-
+
+



-
+
-






-
-
+
+





-
-
-
-
-
-
+
+
+
+
+
+








-
-
-
+
+
+

-
-
-
-
-
+
+
+
+
+





-
+
+
+

-
-
-
+

-
-
-
-
-
+
+
+
+
+
+
+
-
-
+
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
+
-
-
-
-
-
+
-
-
-
-
+
+
+
+
+
+
+
+

-
+
-
-
-
+
-
-
-
+
-
-
-
-
-
-
-


-
-
-
+
+
+

-
-

-
-
+
+








-
+


-
-
-
-
-
-
+
-
-
-
-
-
-
-


-
-
-
+
+
+

-
+

-
+

-
-
-
-
+
+
+
+

-
-
+
+



-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-


-
-
-
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+


-
+
-
-
-
-
-
-
+
+
-
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
+

-
-
+
+

-
+
+

-
-
-
-
-
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+


-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
+
+
+
+
+
+
+

+
-
+
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-

-
-
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
+
+
+
+
+
+
+
+

+




-
+

-
-
-
-
-
+
+
+
+
+
-
-
-
+
+
-
-
-
+
+





-
+

-
-
+
+



-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
-
+


-
-
-
+
+
+
-
-
-
+
+
-
-
+


-
-
+
+
-
-
-









-
+
-



-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+
-
-
-
+
-
-
+
-
-
-
-




-
+
+
+
+
+
+

+
+
+
+

-
-
+
+
+
+
+
+
+
-
-
+
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+


+
+
+





-
+
-
-
+

-
-
+
+
-
-
-

-
+
-
+

-
+
-
+

-
-
+
+


+
+
+
-
+
-

-
-
+
+





+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
+
+

-
+
+






-
-
+
+

-
-
-
+
+
+












-
-
-
-
-
-
-
-










-



-
-
-
-
+
+
+
+


+
+
+



-
+

-
-
+


-
+
+
+
+
+



-
-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
+

+
+
+
+
+
+
+
+
-
-
-
+
+
+
+
+
+
+

-
+
+
+
+
+
+
+
+

-
-
+
+

-
-
+
+
-
-
-
+
+
-


-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
-
-
+
+
+
+
+
+
+
+
+
+
+

-
+

-
+

-
-
+
+

-
+

-
-
-
-
-
-
+
+
+
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
-
-
-
-
+
+
+
+
+

-
-
-
-
+
+
+
+





-
-
-
-
-
-
+
-
-
-
-
+
-
-
-
-
-

-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+


-
+

-
+

-
+













-
+

-
-
-
+
+
+








-
+


-
+



-
+




-
-
+
+

-
-
-
-
-
+
+
+
+
+


-
+
+




-
+

-
+









-
-
-
+
+
+

-
+

-
-
-
-
-
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+





-
-
-
+
+
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+





-
-
-
+
+
+

-
-
+
+




-
-
-
-
-
+
+
+
+
+


-
+






-
-
-
-
-
+
+
+
+
+


-
-
-
-
-
+
+
+
+
+


-
+


-
+


-
+

-
+





-
+

-
-
-
+
+
+

-
-
-
+
+
+

-
-
+
+


-
+

-
-
+
+
-
-
-
-
+
+

-
-
-
+
+
+

-
-
-
+
+
+

-
+



-
+

-
-
-
+
+
+

-
+

-
-
-
-
+
+
+
+




-
-
+
+

-
-
+
+
-
-
+

-
-
-
-
-
+
+
+
+
+





-
-
-
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+




-
-
+
+

-
-
-
-
-
+
+
+
+
+

-
-
-
+
+
+

-
-
-
-
-
+
+
+
+
+

-
-
-
+
+
+


-
-
-
-
-
-
+
-
-
-
-
-
-
-

-
-
-
-
-
+
+
+
+
+




+
-
-
-
-
+
+
+
+
+

+
+
+
+
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+
-
+

-
-
-
-
+

















-
+
-
-
-
+
+

-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
-



-
+






-
+


-
-
-
-
-
+
+
+
+
+



-
+


-



-
-
-
-
-
-
-
+
+
+
+
+
+
+


-
-
-
+
+
+



-


-
+
+













-
-
+
+


-
-
+
+




-
+

-
+


















-
+





-
+








/*
 * expect.c --
 *
/* expect.c - expect commands

 *	expect commands
 *
 * Written by: Don Libes, NIST, 2/6/90
 *
 * Design and implementation of this program was paid for by U.S. tax
 * dollars.  Therefore it is public domain.  However, the author and NIST
 * would appreciate credit if this program or parts of it are used.
 *
Written by: Don Libes, NIST, 2/6/90

Design and implementation of this program was paid for by U.S. tax
dollars.  Therefore it is public domain.  However, the author and NIST
would appreciate credit if this program or parts of it are used.

 *
 * Windows NT by Gordon Chaffee
 * Copyright (c) 1997 by Mitel Corporations
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 */
*/

#include <sys/types.h>
#include <stdio.h>
#include <signal.h>
#include <string.h>
#include <errno.h>
#include <ctype.h>	/* for isspace */
#include <time.h>	/* for time(3) */

//#include "expect_cf.h"
#include "exp_port.h"

#ifdef HAVE_SYS_WAIT_H
#include <sys/wait.h>
#endif

#ifdef HAVE_UNISTD_H
# include <unistd.h>
#endif

#include "tclInt.h"
#include "tclPort.h"

#include "tclRegexp.h"
#include "string.h"

#include "exp_rename.h"
#include "exp_prog.h"
#include "exp_command.h"
#include "exp_log.h"
#include "exp_event.h"
#include "exp_tty.h"
#include "exp_tstamp.h"	/* this should disappear when interact */
			/* loses ref's to it */
#ifdef TCL_DEBUGGER
#include "Dbg.h"
#include "tcldbg.h"
#endif

/* initial length of strings that we can guarantee patterns can match */
int exp_default_match_max =	2000;
#define INIT_EXPECT_TIMEOUT_LIT	"10"	/* seconds */
#define INIT_EXPECT_TIMEOUT	10	/* seconds */
int exp_default_parity =	TRUE;
int exp_default_rm_nulls =	TRUE;

/* user variable names */
#define EXPECT_TIMEOUT		"timeout"
#define EXPECT_OUT		"expect_out"

typedef struct ThreadSpecificData {
    int timeout;
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;

/*
 * addr of these placeholders appear as clientData in ExpectCmd * when called
 * as expect_user and expect_tty.  It would be nicer * to invoked
 * expDevttyGet() but C doesn't allow this in an array initialization, sigh.
 */
static ExpState StdinoutPlaceholder;
static ExpState DevttyPlaceholder;

/* 1 ecase struct is reserved for each case in the expect command.  Note that
eof/timeout don't use any of theirs, but the algorithm is simpler this way. */

struct ecase {	/* case for expect command */
    struct exp_i	*i_list;
    char *pat;	/* original pattern spec */
    char *body;	/* ptr to body to be executed upon match */
	struct exp_i	*i_list;
	Tcl_Obj *pat;	/* original pattern spec */
	Tcl_Obj *body;	/* ptr to body to be executed upon match */
#define PAT_EOF		1
#define PAT_TIMEOUT	2
#define PAT_DEFAULT	3
#define PAT_FULLBUFFER	4
#define PAT_GLOB	5 /* glob-style pattern list */
#define PAT_RE		6 /* regular expression */
#define PAT_EXACT	7 /* exact string */
#define PAT_NULL	8 /* ASCII 0 */
#define PAT_TYPES	9 /* used to size array of pattern type descriptions */
    int use;	/* PAT_XXX */
    int simple_start;/* offset from start of buffer denoting where a */
    /* glob or exact match begins */
    int transfer;	/* if false, leave matched chars in input stream */
    int indices;	/* if true, write indices */
	int use;	/* PAT_XXX */
	int simple_start;/* offset from start of buffer denoting where a */
			/* glob or exact match begins */
	int transfer;	/* if false, leave matched chars in input stream */
	int indices;	/* if true, write indices */
    /*	int iwrite;*/	/* if true write spawn_id */
    int iread;	/* if true, reread indirects */
    int timestamp;	/* if true, write timestamps */
	int iread;	/* if true, reread indirects */
	int timestamp;	/* if true, write timestamps */
#define CASE_UNKNOWN	0
#define CASE_NORM	1
#define CASE_LOWER	2
    int Case;	/* convert case before doing match? */
	int Case;	/* convert case before doing match? */
    regexp *re;	/* if this is 0, then pattern match via glob */
};

/* descriptions of the pattern types, used for debugging */
char *pattern_style[PAT_TYPES];

struct exp_cases_descriptor {
    int count;
    struct ecase **cases;
	int count;
	struct ecase **cases;
};

/* This describes an Expect command */
static
struct exp_cmd_descriptor {
    int cmdtype;			/* bg, before, after */
    int duration;			/* permanent or temporary */
    int timeout_specified_by_flag;	/* if -timeout flag used */
    int timeout;			/* timeout period if flag used */
    struct exp_cases_descriptor ecd;
    struct exp_i *i_list;
	int cmdtype;			/* bg, before, after */
	int duration;			/* permanent or temporary */
	int timeout_specified_by_flag;	/* if -timeout flag used */
	int timeout;			/* timeout period if flag used */
	struct exp_cases_descriptor ecd;
	struct exp_i *i_list;
} exp_cmds[4];
/* note that exp_cmds[FG] is just a fake, the real contents is stored
   in some dynamically-allocated variable.  We use exp_cmds[FG] mostly
   as a well-known address and also as a convenience and so we allocate
   just a few of its fields that we need. */

static void
exp_cmd_init(cmd,cmdtype,duration)
    struct exp_cmd_descriptor *cmd;
    int duration;
    int cmdtype;
struct exp_cmd_descriptor *cmd;
int duration;
int cmdtype;
{
    cmd->duration = duration;
    cmd->cmdtype = cmdtype;
    cmd->ecd.cases = 0;
    cmd->ecd.count = 0;
    cmd->i_list = 0;
	cmd->duration = duration;
	cmd->cmdtype = cmdtype;
	cmd->ecd.cases = 0;
	cmd->ecd.count = 0;
	cmd->i_list = 0;
}

static int i_read_errno;/* place to save errno, if i_read() == -1, so it
			   doesn't get overwritten before we get to read it */

void exp_background_filehandlers_run_all();
#ifdef SIMPLE_EVENT
static int alarm_fired;	/* if alarm occurs */
#endif

/*
 * Declarations for local procedures defined in this file:
 */
//extern void exp_background_channelhandlers_run_all();

/*exp_indirect_updateX is called by Tcl when an indirect variable is set */
static char *		exp_indirect_update1 _ANSI_ARGS_((Tcl_Interp *interp,
			    struct exp_cmd_descriptor *ecmd,
			    struct exp_i *exp_i));
static char *		exp_indirect_update2 _ANSI_ARGS_((
/* exp_indirect_updateX is called by Tcl when an indirect variable is set */
/* 1-part Tcl variable names */
static char *exp_indirect_update1 _ANSI_ARGS_((Tcl_Interp *interp,
					       struct exp_cmd_descriptor *ecmd,
					       struct exp_i *exp_i));
/* 2-part Tcl variable names */
static char *exp_indirect_update2 _ANSI_ARGS_((ClientData clientData,
			    ClientData clientData,
			    Tcl_Interp *interp, char *name1, char *name2,
					      Tcl_Interp *interp,
			    int flags)); /* 2-part Tcl variable names */
static int		exp_i_read _ANSI_ARGS_((Tcl_Interp *,struct exp_f *,
			    int,int));


					      char *name1,
					      char *name2,
/*
 *----------------------------------------------------------------------
 *
 * rm_nulls --
 *
 *	Remove nulls from s.  Initially, the number of chars in s is c,
 *	not strlen(s).  This count does not include the trailing null.
 *
 * Results:
 *	Returns number of nulls removed.
 *
 *----------------------------------------------------------------------
 */

					      int flags));
static int
rm_nulls(s,c)
    char *s;
    int c;
{
    char *s2 = s;		/* points to place in original string to put */
    /* next non-null character */
    int count = 0;

static Tcl_ObjCmdProc Exp_ExpectObjCmd;
static Tcl_ObjCmdProc Exp_ExpectGlobalObjCmd;
static Tcl_ObjCmdProc Exp_ExpectObjCmd;
static Tcl_CmdProc Exp_MatchMaxCmd;
static Tcl_CmdProc Exp_RemoveNullsCmd;
static Tcl_CmdProc Exp_ParityCmd;
    int i;

static Tcl_CmdProc Exp_TimestampCmd;
    for (i=0;i<c;i++,s++) {
	if (0 == *s) {
	    count++;
	    continue;
	}

	if (count) *s2 = *s;
	s2++;
    }
    return(count);

#ifdef SIMPLE_EVENT
/*ARGSUSED*/
static RETSIGTYPE
sigalarm_handler(n)
int n;		       	/* unused, for compatibility with STDC */
{
	alarm_fired = TRUE;
}

#endif /*SIMPLE_EVENT*/
/*
 *----------------------------------------------------------------------
 *

 * free_ecase --
 *
 *	Free up everything in ecase
/* free up everything in ecase */
 *
 * Results:
 *	None
 *
 *----------------------------------------------------------------------
 */

static void
free_ecase(interp,ec,free_ilist)
    Tcl_Interp *interp;
    struct ecase *ec;
    int free_ilist;		/* if we should free ilist */
Tcl_Interp *interp;
struct ecase *ec;
int free_ilist;		/* if we should free ilist */
{
    if (ec->re) ckfree((char *)ec->re);

    if (ec->i_list->duration == EXP_PERMANENT) {
	if (ec->pat) ckfree(ec->pat);
	if (ec->body) ckfree(ec->body);
	if (ec->pat) Tcl_DecrRefCount(ec->pat);
	if (ec->body) Tcl_DecrRefCount(ec->body);
    }

    if (free_ilist) {
	ec->i_list->ecount--;
	if (ec->i_list->ecount == 0)
	    exp_free_i(interp,ec->i_list,exp_indirect_update2);
    }

    ckfree((char *)ec);		/* NEW */
    ckfree((char *)ec);	/* NEW */
}

/*
 *----------------------------------------------------------------------
 *
 * free_ecases --
 *
 *	Free up any argv structures in the ecases
/* free up any argv structures in the ecases */
 *
 * Results:
 *	None
 *
 *----------------------------------------------------------------------
 */

static void
free_ecases(interp,eg,free_ilist)
    Tcl_Interp *interp;
    struct exp_cmd_descriptor *eg;
    int free_ilist;		/* if true, free ilists */
Tcl_Interp *interp;
struct exp_cmd_descriptor *eg;
int free_ilist;		/* if true, free ilists */
{
    int i;
	int i;

    if (!eg->ecd.cases) return;
	if (!eg->ecd.cases) return;

    for (i=0;i<eg->ecd.count;i++) {
	free_ecase(interp,eg->ecd.cases[i],free_ilist);
    }
    ckfree((char *)eg->ecd.cases);
	for (i=0;i<eg->ecd.count;i++) {
		free_ecase(interp,eg->ecd.cases[i],free_ilist);
	}
	ckfree((char *)eg->ecd.cases);

    eg->ecd.cases = 0;
    eg->ecd.count = 0;
	eg->ecd.cases = 0;
	eg->ecd.count = 0;
}


/*
 *----------------------------------------------------------------------
 *
 * save_str --
 *
#if 0
/* no standard defn for this, and some systems don't even have it, so avoid */
/* the whole quagmire by calling it something else */
static char *exp_strdup(s)
char *s;
{
	char *news = ckalloc(strlen(s) + 1);
	strcpy(news,s);
	return(news);
}
#endif

 *	Make a copy of a string if necessary.  In many places, there
 *	is no need to malloc a copy of a string, since it will be
 *	freed before we return to Tcl
/* In many places, there is no need to malloc a copy of a string, since it */
/* will be freed before we return to Tcl */
 *
 * Results:
 *	String is set through lhs
 *
 * Side Effects:
 *	Memory may be allocated for a copy of the string
 *
 *---------------------------------------------------------------------- 
 */

static void
save_str(lhs,rhs,nosave)
    char **lhs;	/* left hand side */
    char *rhs;	/* right hand side */
    int nosave;
char **lhs;	/* left hand side */
char *rhs;	/* right hand side */
int nosave;
{
    if (nosave || (rhs == 0)) {
	*lhs = rhs;
    } else {
	*lhs = ckalloc(strlen(rhs) + 1);
	strcpy(*lhs,rhs);
    }
	if (nosave || (rhs == 0)) {
		*lhs = rhs;
	} else {
		*lhs = ckalloc(strlen(rhs) + 1);
		strcpy(*lhs,rhs);
	}
}

/*
/* return TRUE if string appears to be a set of arguments
 *----------------------------------------------------------------------
 *
 * exp_one_arg_braced --
 *
 *	The intent of this test is to support the ability of
 *	commands to have all their args braced as one.  This
   The intent of this test is to support the ability of commands to have
   all their args braced as one.  This conflicts with the possibility of
 *	conflicts with the possibility of actually intending
 *	to have a single argument. The bad case is in expect
 *	which can have a single argument with embedded \n's
 *	although it's rare.  Examples that this code should handle:
   actually intending to have a single argument.
   The bad case is in expect which can have a single argument with embedded
   \n's although it's rare.  Examples that this code should handle:
 *
 *	\n		FALSE (pattern)
 *	\n\n		FALSE
 *	\n  \n \n	FALSE
 *	foo		FALSE
 *	foo\n		FALSE
 *	\nfoo\n		TRUE  (set of args)
 *	\nfoo\nbar	TRUE
 *
 *	Current test is very cheap and almost always right :-)
   \n		FALSE (pattern)
   \n\n		FALSE
   \n  \n \n	FALSE
   foo		FALSE
   foo\n	FALSE
   \nfoo\n	TRUE  (set of args)
   \nfoo\nbar	TRUE

   Current test is very cheap and almost always right :-)
 *
 * Results:
 * 	TRUE if string appears to be a set of arguments
 *
 *----------------------------------------------------------------------
 */
*/
int 
exp_one_arg_braced(p)
    char *p;
exp_one_arg_braced(objPtr)	/* INTL */
Tcl_Obj *objPtr;
{
    int seen_nl = FALSE;
	int seen_nl = FALSE;
	char *p = Tcl_GetString(objPtr);

    for (;*p;p++) {
	if (*p == '\n') {
	    seen_nl = TRUE;
	    continue;
	}
	for (;*p;p++) {
		if (*p == '\n') {
			seen_nl = TRUE;
			continue;
		}

	if (!isspace(*p)) {
	    return(seen_nl);
	}
    }
    return FALSE;
		if (!isspace(*p)) { /* INTL: ISO space */
			return(seen_nl);
		}
	}
	return FALSE;
}

/*
 *----------------------------------------------------------------------
 *
 * exp_eval_with_one_arg --
 *
 *	Called to execute a command of only one argument - a hack
 *	to commands to be called with all args surrounded by an
 *	outer set of braces
 *
 * Results:
 *	A standard Tcl result
 *
/* called to execute a command of only one argument - a hack to commands */
/* to be called with all args surrounded by an outer set of braces */
/* returns TCL_whatever */
/*ARGSUSED*/
int
exp_eval_with_one_arg(clientData,interp,objv) /* INTL */
ClientData clientData;
Tcl_Interp *interp;
Tcl_Obj *CONST objv[];		/* Argument objects. */
{
#define NUM_STATIC_OBJS 20
    Tcl_Obj *staticObjArray[NUM_STATIC_OBJS];
    int maxobjs = NUM_STATIC_OBJS;
    Tcl_Token *tokenPtr;
    char *p, *next;
    int rc;
    Tcl_Obj **objs = staticObjArray;
    int objc, bytesLeft, numWords, i;
    Tcl_Parse parse;

 *----------------------------------------------------------------------
 */
    /*
     * Prepend the command name and the -nobrace switch so we can
     * reinvoke without recursing.
     */
    objc = 2;
    objs[0] = objv[0];
    objs[1] = Tcl_NewStringObj("-nobrace", -1);
    Tcl_IncrRefCount(objs[0]);
    Tcl_IncrRefCount(objs[1]);

    p = Tcl_GetStringFromObj(objv[1], &bytesLeft);
/*ARGSUSED*/

int
exp_eval_with_one_arg(clientData,interp,argv)
    ClientData clientData;
    Tcl_Interp *interp;
    char **argv;
{
    char *buf;
    int rc;
    char *a;

    /*
     * Treat the pattern/action block like a series of Tcl commands.
     * For each command, parse the command words, perform substititions
     * on each word, and add the words to an array of values.  We don't
     * actually evaluate the individual commands, just the substitutions.
     */

    do {
	if (Tcl_ParseCommand(interp, p, bytesLeft, 0, &parse)
	        != TCL_OK) {
	    rc = TCL_ERROR;
	    goto done;
	}
	numWords = parse.numWords;
 	if (numWords > 0) {
	    /*
	     * Generate an array of objects for the words of the command.
	     */
    
	    if (objc + numWords > maxobjs) {
		Tcl_Obj ** newobjs;
		maxobjs = (objc + numWords) * 2;
		newobjs = (Tcl_Obj **)ckalloc(maxobjs * sizeof (Tcl_Obj *));
		memcpy(newobjs, objs, objc*sizeof(Tcl_Obj *));
		if (objs != staticObjArray) {
		    ckfree((char*)objs);
		}
    /* + 11 is for " -nobrace " and null at end */
    buf = ckalloc(strlen(argv[0]) + strlen(argv[1]) + 11);
    /* recreate statement (with -nobrace to prevent recursion) */
    sprintf(buf,"%s -nobrace %s",argv[0],argv[1]);

    /*
     * replace top-level newlines with blanks
     */

		objs = newobjs;   
	    }

	    /*
	     * For each word, perform substitutions then store the
	     * result in the objs array.
	     */
	    
	    for (tokenPtr = parse.tokenPtr; numWords > 0;
		 numWords--, tokenPtr += (tokenPtr->numComponents + 1)) {
		objs[objc] = Tcl_EvalTokens(interp, tokenPtr+1,
			tokenPtr->numComponents);
		if (objs[objc] == NULL) {
		    rc = TCL_ERROR;
		    goto done;
		}
		objc++;
	    }
    /* Should only be necessary to run over argv[1] and then sprintf */
    /* that into the buffer, but the ICEM guys insist that writing */
    /* back over the original arguments makes their Tcl compiler very */
    /* unhappy. */
    for (a=buf;*a;) {
	for (;isspace(*a);a++) {
	    if (*a == '\n') *a = ' ';
	}
	a = TclWordEnd(a,a+strlen(a),0,(int *)0)+1;
    }

	/*
	 * Advance to the next command in the script.
	 */
	next = parse.commandStart + parse.commandSize;
	bytesLeft -= next - p;
	p = next;
	Tcl_FreeParse(&parse);
    } while (bytesLeft > 0);

    /*
     * Now evaluate the entire command with no further substitutions.
     */

    rc = Tcl_Eval(interp,buf);

    ckfree(buf);
    rc = Tcl_EvalObjv(interp, objc, objs, 0);
 done:
    for (i = 0; i < objc; i++) {
	Tcl_DecrRefCount(objs[i]);
    }
    if (objs != staticObjArray) {
	ckfree((char *) objs);
    }
    return(rc);
#undef NUM_STATIC_OBJS
}

static void
ecase_clear(ec)
    struct ecase *ec;
struct ecase *ec;
{
    ec->i_list = 0;
    ec->pat = 0;
    ec->body = 0;
    ec->transfer = TRUE;
    ec->indices = FALSE;
	ec->i_list = 0;
	ec->pat = 0;
	ec->body = 0;
	ec->transfer = TRUE;
	ec->indices = FALSE;
    /*	ec->iwrite = FALSE;*/
    ec->iread = FALSE;
    ec->timestamp = FALSE;
	ec->iread = FALSE;
	ec->timestamp = FALSE;
    ec->re = 0;
    ec->Case = CASE_NORM;
    ec->use = PAT_GLOB;
	ec->Case = CASE_NORM;
	ec->use = PAT_GLOB;
}

static struct ecase *
ecase_new()
{
    struct ecase *ec = (struct ecase *)ckalloc(sizeof(struct ecase));
	struct ecase *ec = (struct ecase *)ckalloc(sizeof(struct ecase));

    ecase_clear(ec);
    return ec;
	ecase_clear(ec);
	return ec;
}

/*
 *----------------------------------------------------------------------
 *

 * parse_expect_args --
 *
 *	Parses the arguments to expect or its variants. It normally
 *	returns TCL_OK, and returns TCL_ERROR for failure. (It can't
 *	return i_list directly because there is no way to differentiate
 *	between clearing, say, expect_before and signalling an error.)
 *
 *	eg (expect_global) is initialized to reflect the arguments parsed
 *	eg->ecd.cases is an array of ecases
 *	eg->ecd.count is the # of ecases
 *	eg->i_list is a linked list of exp_i's which represent the -i info
 * 
 *	Each exp_i is chained to the next so that they can be easily free'd
 *	if necessary.  Each exp_i has a reference count.  If the -i is not
 *	used (e.g., has no following patterns), the ref count will be 0.
 * 
 *	Each ecase points to an exp_i.  Several ecases may point to the
 *	same exp_i. Variables named by indirect exp_i's are read for the
parse_expect_args parses the arguments to expect or its variants. 
It normally returns TCL_OK, and returns TCL_ERROR for failure.
(It can't return i_list directly because there is no way to differentiate
between clearing, say, expect_before and signalling an error.)

eg (expect_global) is initialized to reflect the arguments parsed
eg->ecd.cases is an array of ecases
eg->ecd.count is the # of ecases
eg->i_list is a linked list of exp_i's which represent the -i info

Each exp_i is chained to the next so that they can be easily free'd if
necessary.  Each exp_i has a reference count.  If the -i is not used
(e.g., has no following patterns), the ref count will be 0.

Each ecase points to an exp_i.  Several ecases may point to the same exp_i.
Variables named by indirect exp_i's are read for the direct values.
 *	direct values.
 * 
 *	If called from a foreground expect and no patterns or -i are given,
 *	a default exp_i is forced so that the command "expect" works right.
 * 
 *	The exp_i chain can be broken by the caller if desired.
 *

If called from a foreground expect and no patterns or -i are given, a
default exp_i is forced so that the command "expect" works right.

The exp_i chain can be broken by the caller if desired.

 * Results:
 *	A standard TCL result.
 *
 *----------------------------------------------------------------------
 */
*/

static int
parse_expect_args(interp,eg,default_spawn_id,argc,argv,argv0)
    Tcl_Interp *interp;
    struct exp_cmd_descriptor *eg;
parse_expect_args(interp,eg,default_esPtr,objc,objv)
Tcl_Interp *interp;
struct exp_cmd_descriptor *eg;
    struct exp_f *default_spawn_id; /* suggested master if called as
				     * expect_user or _tty */
    int argc;
ExpState *default_esPtr;	/* suggested ExpState if called as expect_user or _tty */
int objc;
    char **argv;
    char *argv0;
Tcl_Obj *CONST objv[];		/* Argument objects. */
{
    int i;
    char *arg;
    struct ecase ec;		/* temporary to collect args */
    char *string;
    struct ecase ec;	/* temporary to collect args */

    argv++;
    argc--;

    eg->timeout_specified_by_flag = FALSE;

    ecase_clear(&ec);

    /* Allocate an array to store the ecases.  Force array even if 0 */
    /* cases.  This will often be too large (i.e., if there are flags) */
    /* but won't affect anything. */

    eg->ecd.cases = (struct ecase **)
    eg->ecd.cases = (struct ecase **)ckalloc(sizeof(struct ecase *) * (1+(objc/2)));
	ckalloc(sizeof(struct ecase *) * (1+(argc/2)));

    eg->ecd.count = 0;

    for (i = 0;i<argc;i++) {
	arg = argv[i];
	
	if (exp_flageq("timeout",arg,7)) {
	    ec.use = PAT_TIMEOUT;
    for (i = 1;i<objc;i++) {
	int index;
	string = Tcl_GetString(objv[i]);
	if (string[0] == '-') {
	    static char *flags[] = {
		"-glob", "-regexp", "-exact", "-notransfer", "-nocase",
		"-i", "-indices", "-iread", "-timestamp", "-timeout",
		"-nobrace", "--", (char *)0
	    };
	    enum flags {
		EXP_ARG_GLOB, EXP_ARG_REGEXP, EXP_ARG_EXACT,
		EXP_ARG_NOTRANSFER, EXP_ARG_NOCASE, EXP_ARG_SPAWN_ID,
		EXP_ARG_INDICES, EXP_ARG_IREAD, EXP_ARG_TIMESTAMP,
		EXP_ARG_DASH_TIMEOUT, EXP_ARG_NOBRACE, EXP_ARG_DASH
	    };

	    /*
	     * Allow abbreviations of switches and report an error if we
	     * get an invalid switch.
	     */

	    if (Tcl_GetIndexFromObj(interp, objv[i], flags, "flag", 0,
		    &index) != TCL_OK) {
	} else if (exp_flageq("eof",arg,3)) {
	    ec.use = PAT_EOF;
	} else if (exp_flageq("full_buffer",arg,11)) {
		return TCL_ERROR;
	    }
	    switch ((enum flags) index) {
	    ec.use = PAT_FULLBUFFER;
	} else if (exp_flageq("default",arg,7)) {
	    ec.use = PAT_DEFAULT;
	    case EXP_ARG_GLOB:
	} else if (exp_flageq("null",arg,4)) {
	    ec.use = PAT_NULL;
	    case EXP_ARG_DASH:
	} else if (arg[0] == '-') {
	    arg++;
	    if (exp_flageq1('-',arg) /* "--" is deprecated */
		|| exp_flageq("glob",arg,2)) {
		i++;
		/* assignment here is not actually necessary */
		/* since cases are initialized this way above */
		/* ec.use = PAT_GLOB; */
	    } else if (exp_flageq("regexp",arg,2)) {
		if (i >= objc) {
		    Tcl_WrongNumArgs(interp, 1, objv,"-glob pattern");
		    return TCL_ERROR;
		}
		goto pattern;
	    case EXP_ARG_REGEXP:
		i++;
		if (i >= objc) {
		    Tcl_WrongNumArgs(interp, 1, objv,"-regexp regexp");
		    return TCL_ERROR;
		}
		ec.use = PAT_RE;
		TclRegError((char *)0);
		if (!(ec.re = TclRegComp(argv[i]))) {

		/*
		 * Try compiling the expression so we can report
		 * any errors now rather then when we first try to
		 * use it.
		 */

		    exp_error(interp,"bad regular expression: %s",
			      TclGetRegError());
		if (!(Tcl_GetRegExpFromObj(interp, objv[i],
					   TCL_REG_ADVANCED))) {
		    goto error;
		}
	    } else if (exp_flageq("exact",arg,2)) {
		i++;
		ec.use = PAT_EXACT;
	    } else if (exp_flageq("notransfer",arg,1)) {
		ec.transfer = 0;
		continue;
	    } else if (exp_flageq("nocase",arg,3)) {
		ec.Case = CASE_LOWER;
		continue;
	    } else if (exp_flageq1('i',arg)) {
		i++;
		if (i>=argc) {
		    exp_error(interp,"-i requires following spawn_id");
		    goto error;
		goto pattern;
	    case EXP_ARG_EXACT:
		i++;
		if (i >= objc) {
		    Tcl_WrongNumArgs(interp, 1, objv, "-exact string");
		    return TCL_ERROR;
		}

		ec.i_list = exp_new_i_complex(interp,argv[i],
					      eg->duration,exp_indirect_update2,
					      argv0);
		if (ec.i_list == NULL) {
		ec.use = PAT_EXACT;
		goto pattern;
	    case EXP_ARG_NOTRANSFER:
		ec.transfer = 0;
		break;
	    case EXP_ARG_NOCASE:
		ec.Case = CASE_LOWER;
		break;
	    case EXP_ARG_SPAWN_ID:
		i++;
		if (i>=objc) {
		    Tcl_WrongNumArgs(interp, 1, objv, "-i spawn_id");
		    goto error;
		}
		ec.i_list = exp_new_i_complex(interp,
				      Tcl_GetString(objv[i]),
				      eg->duration, exp_indirect_update2);
		ec.i_list->cmdtype = eg->cmdtype;

		/* link new i_list to head of list */
		ec.i_list->next = eg->i_list;
		eg->i_list = ec.i_list;

		break;
		continue;
	    } else if (exp_flageq("indices",arg,2)) {
	    case EXP_ARG_INDICES:
		ec.indices = TRUE;
		continue;
	    } else if (exp_flageq("iwrite",arg,2)) {
		break;
	    case EXP_ARG_IREAD:
		/*				ec.iwrite = TRUE;*/
		continue;
	    } else if (exp_flageq("iread",arg,2)) {
		ec.iread = TRUE;
		continue;
		break;
	    } else if (exp_flageq("timestamp",arg,2)) {
	    case EXP_ARG_TIMESTAMP:
		ec.timestamp = TRUE;
		continue;
		break;
	    } else if (exp_flageq("timeout",arg,2)) {
	    case EXP_ARG_DASH_TIMEOUT:
		i++;
		if (i>=argc) {
		    exp_error(interp,"-timeout requires following # of seconds");
		if (i>=objc) {
		    Tcl_WrongNumArgs(interp, 1, objv, "-timeout seconds");
		    goto error;
		}
		if (Tcl_GetIntFromObj(interp, objv[i],
				      &eg->timeout) != TCL_OK) {
		    goto error;

		}
		eg->timeout = atoi(argv[i]);
		eg->timeout_specified_by_flag = TRUE;
		continue;
	    } else if (exp_flageq("nobrace",arg,7)) {
		break;
	    case EXP_ARG_NOBRACE:
		/* nobrace does nothing but take up space */
		/* on the command line which prevents */
		/* us from re-expanding any command lines */
		/* of one argument that looks like it should */
		/* be expanded to multiple arguments. */
		break;
	    }
	    /*
	     * Keep processing arguments, we aren't ready for the
	     * pattern yet.
	     */
		continue;
	    } else {
		exp_error(interp,"usage: unrecognized flag <%s>",arg);
		goto error;
	    }
	}

	/* if no -i, use previous one */
	if (!ec.i_list) {
	    /* if no -i flag has occurred yet, use default */
	    if (!eg->i_list) {
		if (default_spawn_id != NULL) {
		    eg->i_list = exp_new_i_simple(default_spawn_id,eg->duration);
		} else {
	    continue;
	} else {
	    /*
	     * We have a pattern or keyword.
	     */

	    static char *keywords[] = {
		"timeout", "eof", "full_buffer", "default", "null",
		(char *)NULL
	    };
	    enum keywords {
		EXP_ARG_TIMEOUT, EXP_ARG_EOF, EXP_ARG_FULL_BUFFER,
		EXP_ARG_DEFAULT, EXP_ARG_NULL
	    };

	    /*
	     * Match keywords exactly, otherwise they are patterns.
	     */

	    if (Tcl_GetIndexFromObj(interp, objv[i], keywords, "keyword",
		    1 /* exact */, &index) != TCL_OK) {
		Tcl_ResetResult(interp);
		goto pattern;
	    }
	    switch ((enum keywords) index) {
	    case EXP_ARG_TIMEOUT:
		ec.use = PAT_TIMEOUT;
		break;
	    case EXP_ARG_EOF:
		ec.use = PAT_EOF;
		break;
	    case EXP_ARG_FULL_BUFFER:
		ec.use = PAT_FULLBUFFER;
		break;
	    case EXP_ARG_DEFAULT:
		ec.use = PAT_DEFAULT;
		break;
	    case EXP_ARG_NULL:
		ec.use = PAT_NULL;
		break;
	    }
pattern:
	    /* if no -i, use previous one */
	    if (!ec.i_list) {
		/* if no -i flag has occurred yet, use default */
		if (!eg->i_list) {
		    if (default_esPtr != EXP_SPAWN_ID_BAD) {
			eg->i_list = exp_new_i_simple(default_esPtr,eg->duration);
		    } else {
		    /* it'll be checked later, if used */
		    default_spawn_id = exp_update_master(interp,0,0);
		    eg->i_list = exp_new_i_simple(default_spawn_id,eg->duration);
		}
	    }
	    ec.i_list = eg->i_list;
	}
	ec.i_list->ecount++;
		        default_esPtr = expStateCurrent(interp,0,0,1);
		        if (!default_esPtr) goto error;
		        eg->i_list = exp_new_i_simple(default_esPtr,eg->duration);
		    }
		}
		ec.i_list = eg->i_list;
	    }
	    ec.i_list->ecount++;

	/* save original pattern spec */
	/* keywords such as "-timeout" are saved as patterns here */
	/* useful for debugging but not otherwise used */
	save_str(&ec.pat,argv[i],eg->duration == EXP_TEMPORARY);
	save_str(&ec.body,argv[i+1],eg->duration == EXP_TEMPORARY);
			
	i++;

	*(eg->ecd.cases[eg->ecd.count] = ecase_new()) = ec;
	    /* save original pattern spec */
	    /* keywords such as "-timeout" are saved as patterns here */
	    /* useful for debugging but not otherwise used */

	    ec.pat = objv[i];
	    if (eg->duration == EXP_PERMANENT) Tcl_IncrRefCount(ec.pat);

	    i++;
	    if (i < objc) {
		ec.body = objv[i];
		if (eg->duration == EXP_PERMANENT) Tcl_IncrRefCount(ec.body);
	    } else {
		ec.body = NULL;
	    }

	    *(eg->ecd.cases[eg->ecd.count] = ecase_new()) = ec;

	/* clear out for next set */
	ecase_clear(&ec);
		/* clear out for next set */
	    ecase_clear(&ec);

	eg->ecd.count++;
	    eg->ecd.count++;
	}
    }

    /* if no patterns at all have appeared force the current */
    /* spawn id to be added to list anyway */

    if (eg->i_list == 0) {
	if (default_spawn_id != NULL) {
	    eg->i_list = exp_new_i_simple(default_spawn_id,eg->duration);
	if (default_esPtr != EXP_SPAWN_ID_BAD) {
	    eg->i_list = exp_new_i_simple(default_esPtr,eg->duration);
	} else {
	    /* it'll be checked later, if used */
	    default_spawn_id = exp_update_master(interp,0,0);
	    eg->i_list = exp_new_i_simple(default_spawn_id,eg->duration);
	    default_esPtr = expStateCurrent(interp,0,0,1);
	    if (!default_esPtr) goto error;
	    eg->i_list = exp_new_i_simple(default_esPtr,eg->duration);
	}
    }

    return(TCL_OK);

 error:
    /* very hard to free case_master_list here if it hasn't already */
    /* been attached to a case, ugh */

    /* note that i_list must be avail to free ecases! */
    free_ecases(interp,eg,0);

    /* undo temporary ecase */
    /* free_ecase doesn't quite handle this right, so do it by hand */
    if (ec.re) ckfree((char *)ec.re);
    if (eg->duration == EXP_PERMANENT) {
	if (ec.pat) ckfree(ec.pat);
	if (ec.body) ckfree(ec.body);
    }

    if (eg->i_list)
	exp_free_i(interp,eg->i_list,exp_indirect_update2);
    return(TCL_ERROR);
}

#define EXP_IS_DEFAULT(x)	((x) == EXP_TIMEOUT || (x) == EXP_EOF)

static char yes[] = "yes\r\n";
static char no[] = "no\r\n";


/* this describes status of a successful match */
struct eval_out {
    struct ecase *e;		/* ecase that matched */
    struct exp_f *f;		/* struct exp_f that matched */
    char *buffer;		/* buffer that matched */
    int match;			/* # of chars in buffer that matched */
    /* or # of chars in buffer at EOF */
    ExpState *esPtr;		/* ExpState that matched */
    Tcl_Obj *buffer;		/* buffer that matched */
    int match;			/* # of bytes in buffer that matched */
			        /* or # of bytes in buffer at EOF */
};




/*
 *----------------------------------------------------------------------
 *
 * eval_case_string --
 * string_case_first --
 *
 *	Like eval_cases, but handles only a single cases that needs a real
 *	string match
 *	Find the first instance of a pattern in a string.
 *
 * Results:
 *	Returns EXP_X where X is MATCH, NOMATCH, FULLBUFFER, TCL_ERRROR
 *	Returns the pointer to the first instance of the pattern
 *	in the given string, or NULL if no match was found.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */
static int
eval_case_string(interp,e,f,o,last_f,last_case,suffix)
    Tcl_Interp *interp;
    struct ecase *e;
    struct exp_f *f;
    struct eval_out *o;		/* 'output' - i.e., final case of interest */


char *
string_case_first(string,pattern)	/* INTL */
    register char *string;	/* String. */
    register char *pattern;	/* Pattern, which may contain
				 * special characters. */
{
    /* next two args are for debugging, when they change, reprint buffer */
    struct exp_f **last_f;
    int *last_case;
    char *suffix;
{
    char *buffer;
    
    /* if -nocase, use the lowerized buffer */
    buffer = ((e->Case == CASE_NORM)?f->buffer:f->lower);
    
    /* if master or case changed, redisplay debug-buffer */
    if ((f != *last_f) || e->Case != *last_case) {
	debuglog("\r\nexpect%s: does \"%s\" (spawn_id %s) match %s ",
		 suffix, dprintify(buffer),f->spawnId, pattern_style[e->use]);
	*last_f = f;
    char *s, *p;
    int offset;
    Tcl_UniChar ch1, ch2;
    
    while (*string != 0) {
	s = string;
	p = pattern;
	while (*s) {
	    s += Tcl_UtfToUniChar(s, &ch1);
	    offset = Tcl_UtfToUniChar(p, &ch2);
	    if (Tcl_UniCharToLower(ch1) != Tcl_UniCharToLower(ch2)) {
		break;
	    }
	    p += offset;
	}
	if (*p == '\0') {
	    return string;
	}
	string++;
    }
    return NULL;
}

/* like eval_cases, but handles only a single cases that needs a real */
/* string match */
/* returns EXP_X where X is MATCH, NOMATCH, FULLBUFFER, TCLERRROR */
static int
eval_case_string(interp,e,esPtr,o,last_esPtr,last_case,suffix)
Tcl_Interp *interp;
struct ecase *e;
ExpState *esPtr;
struct eval_out *o;		/* 'output' - i.e., final case of interest */
/* next two args are for debugging, when they change, reprint buffer */
ExpState **last_esPtr;
int *last_case;
char *suffix;
{
    Tcl_Obj *buffer;
    Tcl_RegExp re;
    Tcl_RegExpInfo info;
    char *str;
    int length, flags;
    int result;

    buffer = esPtr->buffer;
    str = Tcl_GetStringFromObj(buffer, &length);

    /* if ExpState or case changed, redisplay debug-buffer */
    if ((esPtr != *last_esPtr) || e->Case != *last_case) {
	expDiagLog("\r\nexpect%s: does \"",suffix);
	expDiagLogU(expPrintify(str));
	expDiagLog("\" (spawn_id %s) match %s ",esPtr->name,pattern_style[e->use]);
	*last_esPtr = esPtr;
	*last_case = e->Case;
    }
    

    if (e->use == PAT_RE) {
	expDiagLog("\"");
	expDiagLogU(expPrintify(Tcl_GetString(e->pat)));
	expDiagLog("\"? ");
	if (e->Case == CASE_NORM) {
	    flags = TCL_REG_ADVANCED;
	} else {
	    flags = TCL_REG_ADVANCED | TCL_REG_NOCASE;
	}
	debuglog("\"%s\"? ",dprintify(e->pat));
	TclRegError((char *)0);
	if (buffer && TclRegExec(e->re,buffer,buffer)) {
		    
	re = Tcl_GetRegExpFromObj(interp, e->pat, flags);

	result = Tcl_RegExpExecObj(interp, re, buffer, 0 /* offset */,
		-1 /* nmatches */, 0 /* eflags */);
	if (result > 0) {

	    o->e = e;
	    o->match = e->re->endp[0]-buffer;

	    /*
	     * Retrieve the byte offset of the end of the
	     * matched string.  
	     */

	    Tcl_RegExpGetInfo(re, &info);
	    o->match = Tcl_UtfAtIndex(str, info.matches[0].end) - str;
	    o->buffer = buffer;
	    o->f = f;
	    debuglog(yes);
	    o->esPtr = esPtr;
	    expDiagLogU(yes);
	    return(EXP_MATCH);
	} else {
	    debuglog(no);
	} else if (result == 0) {
	    expDiagLogU(no);
	    if (TclGetRegError()) {
		exp_error(interp,"-re failed: %s",TclGetRegError());
		return(EXP_TCLERROR);
	} else { /* result < 0 */
	    return(EXP_TCLERROR);
	    }
	}
    } else if (e->use == PAT_GLOB) {
	int match;		/* # of chars that matched */
	
	debuglog("\"%s\"? ",dprintify(e->pat));
	if (buffer && (-1 != (match = Exp_StringMatch(
						      buffer,e->pat,&e->simple_start)))) {
	    o->e = e;
	    o->match = match;
	    o->buffer = buffer;
	    o->f = f;
	    debuglog(yes);
	    return(EXP_MATCH);
	} else debuglog(no);
	int match; /* # of bytes that matched */

	expDiagLog("\"");
	expDiagLogU(expPrintify(Tcl_GetString(e->pat)));
	expDiagLog("\"? ");
	if (buffer) {
	    match = Exp_StringCaseMatch(Tcl_GetString(buffer),
		    Tcl_GetString(e->pat),
		    (e->Case == CASE_NORM) ? 0 : 1,
		    &e->simple_start);
	    if (match != -1) {
		o->e = e;
		o->match = match;
		o->buffer = buffer;
		o->esPtr = esPtr;
		expDiagLogU(yes);
		return(EXP_MATCH);
	    }
	}
	expDiagLogU(no);
    } else if (e->use == PAT_EXACT) {
	int patLength;
	char *pat = Tcl_GetStringFromObj(e->pat, &patLength);
	char *p = strstr(buffer,e->pat);
	debuglog("\"%s\"? ",dprintify(e->pat));
	char *p;

	if (e->Case == CASE_NORM) {
	    p = strstr(str, pat);
	} else {
	    p = string_case_first(str, pat);
	}	    

	expDiagLog("\"");
	expDiagLogU(expPrintify(Tcl_GetString(e->pat)));
	expDiagLog("\"? ");
	if (p) {
	    e->simple_start = p - buffer;
	    e->simple_start = p - str;
	    o->e = e;
	    o->match = strlen(e->pat);
	    o->match = patLength;
	    o->buffer = buffer;
	    o->f = f;
	    debuglog(yes);
	    o->esPtr = esPtr;
	    expDiagLogU(yes);
	    return(EXP_MATCH);
	} else debuglog(no);
	} else expDiagLogU(no);
    } else if (e->use == PAT_NULL) {
	int i = 0;
	debuglog("null? ");
	for (;i<f->size;i++) {
	    if (buffer[i] == 0) {
		o->e = e;
		o->match = i+1;	/* in this case, match is */
	char *p;
	expDiagLogU("null? ");
	p = Tcl_UtfFindFirst(str, 0);

	if (p) {
	    o->e = e;
	    o->match = p-str;
		/* just the # of chars + 1 */
		/* before the null */
		o->buffer = buffer;
		o->f = f;
		debuglog(yes);
		return EXP_MATCH;
	    }
	    o->buffer = buffer;
	    o->esPtr = esPtr;
	    expDiagLogU(yes);
	    return EXP_MATCH;
	}
	}
	debuglog(no);
    } else if ((f->size == f->msize) && (f->size > 0)) {
	debuglog("%s? ",e->pat);
	expDiagLogU(no);
    } else if ((Tcl_GetCharLength(esPtr->buffer) == esPtr->msize)
	    && (length > 0)) {
	expDiagLogU(Tcl_GetString(e->pat));
	expDiagLogU("? ");
	o->e = e;
	o->match = f->umsize;
	o->buffer = f->buffer;
	o->f = f;
	debuglog(yes);
	o->match = length;
	o->buffer = esPtr->buffer;
	o->esPtr = esPtr;
	expDiagLogU(yes);
	return(EXP_FULLBUFFER);
    }
    return(EXP_NOMATCH);
}

/*
 *----------------------------------------------------------------------
 *
 * eval_cases --
 *
 *	Sets o.e if successfully finds a matching pattern, eof,
/* sets o.e if successfully finds a matching pattern, eof, timeout or deflt */
 *	timeout or deflt.
 *
 * Results:
 *	Original status arg or EXP_TCLERROR
/* returns original status arg or EXP_TCLERROR */
 *
 * Side Effects:
 *
 *----------------------------------------------------------------------
 */
static int
eval_cases(interp,eg,f,o,last_f,last_case,status,masters,mcount,suffix)
    Tcl_Interp *interp;
    struct exp_cmd_descriptor *eg;
    struct exp_f *f;
    struct eval_out *o;		/* 'output' - i.e., final case of interest */
    /* next two args are for debugging, when they change, reprint buffer */
    struct exp_f **last_f;
    int *last_case;
    int status;
    struct exp_fs **masters;
    int mcount;
    char *suffix;
eval_cases(interp,eg,esPtr,o,last_esPtr,last_case,status,esPtrs,mcount,suffix)
Tcl_Interp *interp;
struct exp_cmd_descriptor *eg;
ExpState *esPtr;
struct eval_out *o;		/* 'output' - i.e., final case of interest */
/* next two args are for debugging, when they change, reprint buffer */
ExpState **last_esPtr;
int *last_case;
int status;
ExpState *(esPtrs[]);
int mcount;
char *suffix;
{
    int i;
    struct exp_f *em;		/* master of ecase */
    ExpState *em;   /* ExpState of ecase */
    struct ecase *e;
    

    if (o->e || status == EXP_TCLERROR || eg->ecd.count == 0) return(status);
    

    if (status == EXP_TIMEOUT) {
	for (i=0;i<eg->ecd.count;i++) {
	    e = eg->ecd.cases[i];
	    if (e->use == PAT_TIMEOUT || e->use == PAT_DEFAULT) {
		o->e = e;
		break;
	    }
	}
	return(status);
    } else if (status == EXP_EOF) {
	for (i=0;i<eg->ecd.count;i++) {
	    e = eg->ecd.cases[i];
	    if (e->use == PAT_EOF || e->use == PAT_DEFAULT) {
		struct exp_fs_list *fsl;
		struct exp_state_list *slPtr;

		for (fsl=e->i_list->fs_list; fsl ;fsl=fsl->next) {
		    em = fsl->f;
		    if (em == NULL || em == exp_f_any || em == f) {
		for (slPtr=e->i_list->state_list; slPtr ;slPtr=slPtr->next) {
		    em = slPtr->esPtr;
		    if (expStateAnyIs(em) || em == esPtr) {
			o->e = e;
			return(status);
		    }
		}
	    }
	}
	return(status);
    }
    

    /* the top loops are split from the bottom loop only because I can't */
    /* split'em further. */
    

    /* The bufferful condition does not prevent a pattern match from */
    /* occurring and vice versa, so it is scanned with patterns */
    for (i=0;i<eg->ecd.count;i++) {
	struct exp_fs_list *fsl;
	struct exp_state_list *slPtr;
	int j;

	e = eg->ecd.cases[i];
	if (e->use == PAT_TIMEOUT ||
	    e->use == PAT_DEFAULT ||
	    e->use == PAT_EOF) continue;
		e->use == PAT_DEFAULT ||
		e->use == PAT_EOF) continue;

	for (fsl = e->i_list->fs_list; fsl; fsl = fsl->next) {
	    em = fsl->f;
	    /* if em == exp_f_any, then user is explicitly asking */
	    /* every case to be checked against every master */
	    if (em == NULL || em == exp_f_any) {
	for (slPtr = e->i_list->state_list; slPtr; slPtr = slPtr->next) {
	    em = slPtr->esPtr;
	    /* if em == EXP_SPAWN_ID_ANY, then user is explicitly asking */
	    /* every case to be checked against every ExpState */
	    if (expStateAnyIs(em)) {
		/* test against each spawn_id */
		for (j=0;j<mcount;j++) {
		    status = eval_case_string(interp,e,masters[j],o,last_f,last_case,suffix);
		    status = eval_case_string(interp,e,esPtrs[j],o,
			    last_esPtr,last_case,suffix);
		    if (status != EXP_NOMATCH) return(status);
		}
	    } else {
		/* reject things immediately from wrong spawn_id */
		if (em != f) continue;
		if (em != esPtr) continue;

		status = eval_case_string(interp,e,f,o,last_f,last_case,suffix);
		status = eval_case_string(interp,e,esPtr,o,last_esPtr,last_case,suffix);
		if (status != EXP_NOMATCH) return(status);
	    }
	}
    }
    return(EXP_NOMATCH);
}

static void
ecases_remove_by_expi(interp,ecmd,exp_i)
    Tcl_Interp *interp;
    struct exp_cmd_descriptor *ecmd;
    struct exp_i *exp_i;
Tcl_Interp *interp;
struct exp_cmd_descriptor *ecmd;
struct exp_i *exp_i;
{
    int i;
	int i;

    /* delete every ecase dependent on it */
    for (i=0;i<ecmd->ecd.count;) {
	struct ecase *e = ecmd->ecd.cases[i];
	if (e->i_list == exp_i) {
	    free_ecase(interp,e,0);
	/* delete every ecase dependent on it */
	for (i=0;i<ecmd->ecd.count;) {
		struct ecase *e = ecmd->ecd.cases[i];
		if (e->i_list == exp_i) {
			free_ecase(interp,e,0);

	    /* shift remaining elements down */
	    /* but only if there are any left */
	    if (i+1 != ecmd->ecd.count) {
		memcpy(&ecmd->ecd.cases[i],
		       &ecmd->ecd.cases[i+1],
		       ((ecmd->ecd.count - i) - 1) * 
		       sizeof(struct exp_cmd_descriptor *));
	    }
	    ecmd->ecd.count--;
	    if (0 == ecmd->ecd.count) {
		ckfree((char *)ecmd->ecd.cases);
		ecmd->ecd.cases = 0;
	    }
	} else {
	    i++;
	}
    }
			/* shift remaining elements down */
			/* but only if there are any left */
			if (i+1 != ecmd->ecd.count) {
				memcpy(&ecmd->ecd.cases[i],
				       &ecmd->ecd.cases[i+1],
					((ecmd->ecd.count - i) - 1) * 
					sizeof(struct exp_cmd_descriptor *));
			}
			ecmd->ecd.count--;
			if (0 == ecmd->ecd.count) {
				ckfree((char *)ecmd->ecd.cases);
				ecmd->ecd.cases = 0;
			}
		} else {
			i++;
		}
	}
}

/* remove exp_i from list */
static void
exp_i_remove(interp,ei,exp_i)
    Tcl_Interp *interp;
    struct exp_i **ei;	/* list to remove from */
    struct exp_i *exp_i;	/* element to remove */
Tcl_Interp *interp;
struct exp_i **ei;	/* list to remove from */
struct exp_i *exp_i;	/* element to remove */
{
    /* since it's in middle of list, free exp_i by hand */
    for (;*ei; ei = &(*ei)->next) {
	if (*ei == exp_i) {
	    *ei = exp_i->next;
	    exp_i->next = 0;
	    exp_free_i(interp,exp_i,exp_indirect_update2);
	    break;
	}
    }
	/* since it's in middle of list, free exp_i by hand */
	for (;*ei; ei = &(*ei)->next) {
		if (*ei == exp_i) {
			*ei = exp_i->next;
			exp_i->next = 0;
			exp_free_i(interp,exp_i,exp_indirect_update2);
			break;
		}
	}
}

/* remove exp_i from list and remove any dependent ecases */
static void
exp_i_remove_with_ecases(interp,ecmd,exp_i)
    Tcl_Interp *interp;
    struct exp_cmd_descriptor *ecmd;
    struct exp_i *exp_i;
Tcl_Interp *interp;
struct exp_cmd_descriptor *ecmd;
struct exp_i *exp_i;
{
    ecases_remove_by_expi(interp,ecmd,exp_i);
    exp_i_remove(interp,&ecmd->i_list,exp_i);
	ecases_remove_by_expi(interp,ecmd,exp_i);
	exp_i_remove(interp,&ecmd->i_list,exp_i);
}

/* remove ecases tied to a single direct spawn id */
static void
ecmd_remove_f(interp,ecmd,f,direct)
    Tcl_Interp *interp;
    struct exp_cmd_descriptor *ecmd;
    struct exp_f *f;
    int direct;
ecmd_remove_state(interp,ecmd,esPtr,direct)
Tcl_Interp *interp;
struct exp_cmd_descriptor *ecmd;
ExpState *esPtr;
int direct;
{
    struct exp_i *exp_i, *next;
    struct exp_fs_list **fsl;
    struct exp_state_list **slPtr;

    for (exp_i=ecmd->i_list;exp_i;exp_i=next) {
	next = exp_i->next;

	if (!(direct & exp_i->direct)) continue;

	for (fsl = &exp_i->fs_list;*fsl;) {
	    if (f == ((*fsl)->f)) {
		struct exp_fs_list *tmp = *fsl;
		*fsl = (*fsl)->next;
		exp_free_fs_single(tmp);
	for (slPtr = &exp_i->state_list;*slPtr;) {
	    if (esPtr == ((*slPtr)->esPtr)) {
		struct exp_state_list *tmp = *slPtr;
		*slPtr = (*slPtr)->next;
		exp_free_state_single(tmp);

		/* if last bg ecase, disarm spawn id */
		if (ecmd->cmdtype == EXP_CMD_BG) {
		    f->bg_ecount--;
		    if (f->bg_ecount == 0) {
			exp_disarm_background_filehandler(f);
			f->bg_interp = 0;
		if ((ecmd->cmdtype == EXP_CMD_BG) && (expStateAnyIs(esPtr))) {
		    esPtr->bg_ecount--;
		    if (esPtr->bg_ecount == 0) {
			exp_disarm_background_channelhandler(esPtr);
			esPtr->bg_interp = 0;
		    }
		}

		
		continue;
	    }
	    fsl = &(*fsl)->next;
	    slPtr = &(*slPtr)->next;
	}

	/* if left with no fds (and is direct), get rid of it */
	/* if left with no ExpStates (and is direct), get rid of it */
	/* and any dependent ecases */
	if (exp_i->direct == EXP_DIRECT && !exp_i->fs_list) {
	if (exp_i->direct == EXP_DIRECT && !exp_i->state_list) {
	    exp_i_remove_with_ecases(interp,ecmd,exp_i);
	}
    }
}

/* this is called from exp_close to clean up f */
/* this is called from exp_close to clean up the ExpState */
void
exp_ecmd_remove_f_direct_and_indirect(interp,f)
    Tcl_Interp *interp;
    struct exp_f *f;
exp_ecmd_remove_state_direct_and_indirect(interp,esPtr)
Tcl_Interp *interp;
ExpState *esPtr;
{
    ecmd_remove_f(interp,&exp_cmds[EXP_CMD_BEFORE],f,EXP_DIRECT|EXP_INDIRECT);
    ecmd_remove_f(interp,&exp_cmds[EXP_CMD_AFTER],f,EXP_DIRECT|EXP_INDIRECT);
    ecmd_remove_f(interp,&exp_cmds[EXP_CMD_BG],f,EXP_DIRECT|EXP_INDIRECT);
	ecmd_remove_state(interp,&exp_cmds[EXP_CMD_BEFORE],esPtr,EXP_DIRECT|EXP_INDIRECT);
	ecmd_remove_state(interp,&exp_cmds[EXP_CMD_AFTER],esPtr,EXP_DIRECT|EXP_INDIRECT);
	ecmd_remove_state(interp,&exp_cmds[EXP_CMD_BG],esPtr,EXP_DIRECT|EXP_INDIRECT);

    /* force it - explanation in exp_tk.c where this func is defined */
    exp_disarm_background_filehandler_force(f);
	/* force it - explanation in exp_tk.c where this func is defined */
	exp_disarm_background_channelhandler_force(esPtr);
}

/* arm a list of background f's */
/* arm a list of background ExpState's */
static void
fs_list_arm(interp,fsl)
    Tcl_Interp *interp;
state_list_arm(interp,slPtr)
Tcl_Interp *interp;
    struct exp_fs_list *fsl;
{
    struct exp_f *f;

struct exp_state_list *slPtr;
{
    /* for each spawn id in list, arm if necessary */
    for (;fsl;fsl=fsl->next) {
	f = fsl->f;
	if (f == NULL || f == exp_f_any) continue;
    for (;slPtr;slPtr=slPtr->next) {
	ExpState *esPtr = slPtr->esPtr;    
	if (expStateAnyIs(esPtr)) continue;

	if (f->bg_ecount == 0) {
	    exp_arm_background_filehandler(f);
	    f->bg_interp = interp;
	if (esPtr->bg_ecount == 0) {
	    exp_arm_background_channelhandler(esPtr);
	    esPtr->bg_interp = interp;
	}
	f->bg_ecount++;
	esPtr->bg_ecount++;
    }
}

/* return TRUE if this ecase is used by this f */
/* return TRUE if this ecase is used by this fd */
static int
exp_i_uses_f(exp_i,f)
    struct exp_i *exp_i;
    struct exp_f *f;
exp_i_uses_state(exp_i,esPtr)
struct exp_i *exp_i;
ExpState *esPtr;
{
    struct exp_fs_list *fsp;
	struct exp_state_list *fdp;

    for (fsp = exp_i->fs_list;fsp;fsp=fsp->next) {
	if (fsp->f == f) return 1;
    }
    return 0;
	for (fdp = exp_i->state_list;fdp;fdp=fdp->next) {
		if (fdp->esPtr == esPtr) return 1;
	}
	return 0;
}

static void
ecase_append(interp,ec)
    Tcl_Interp *interp;
    struct ecase *ec;
Tcl_Interp *interp;
struct ecase *ec;
{
    if (!ec->transfer) Tcl_AppendElement(interp,"-notransfer");
    if (ec->indices) Tcl_AppendElement(interp,"-indices");
	if (!ec->transfer) Tcl_AppendElement(interp,"-notransfer");
	if (ec->indices) Tcl_AppendElement(interp,"-indices");
    /*	if (ec->iwrite) Tcl_AppendElement(interp,"-iwrite");*/
    if (!ec->Case) Tcl_AppendElement(interp,"-nocase");
	if (!ec->Case) Tcl_AppendElement(interp,"-nocase");

    if (ec->re) Tcl_AppendElement(interp,"-re");
    else if (ec->use == PAT_GLOB) Tcl_AppendElement(interp,"-gl");
    else if (ec->use == PAT_EXACT) Tcl_AppendElement(interp,"-ex");
    Tcl_AppendElement(interp,ec->pat);
    Tcl_AppendElement(interp,ec->body?ec->body:"");
	if (ec->use == PAT_RE) Tcl_AppendElement(interp,"-re");
	else if (ec->use == PAT_GLOB) Tcl_AppendElement(interp,"-gl");
	else if (ec->use == PAT_EXACT) Tcl_AppendElement(interp,"-ex");
	Tcl_AppendElement(interp,Tcl_GetString(ec->pat));
	Tcl_AppendElement(interp,ec->body?Tcl_GetString(ec->body):"");
}

/* append all ecases that match this exp_i */
static void
ecase_by_exp_i_append(interp,ecmd,exp_i)
    Tcl_Interp *interp;
    struct exp_cmd_descriptor *ecmd;
    struct exp_i *exp_i;
Tcl_Interp *interp;
struct exp_cmd_descriptor *ecmd;
struct exp_i *exp_i;
{
    int i;
    for (i=0;i<ecmd->ecd.count;i++) {
	if (ecmd->ecd.cases[i]->i_list == exp_i) {
	    ecase_append(interp,ecmd->ecd.cases[i]);
	}
    }
	int i;
	for (i=0;i<ecmd->ecd.count;i++) {
		if (ecmd->ecd.cases[i]->i_list == exp_i) {
			ecase_append(interp,ecmd->ecd.cases[i]);
		}
	}
}

static void
exp_i_append(interp,exp_i)
    Tcl_Interp *interp;
    struct exp_i *exp_i;
Tcl_Interp *interp;
struct exp_i *exp_i;
{
    Tcl_AppendElement(interp,"-i");
    if (exp_i->direct == EXP_INDIRECT) {
	Tcl_AppendElement(interp,exp_i->variable);
    } else {
	struct exp_fs_list *fsp;
	Tcl_AppendElement(interp,"-i");
	if (exp_i->direct == EXP_INDIRECT) {
		Tcl_AppendElement(interp,exp_i->variable);
	} else {
		struct exp_state_list *fdp;

	/* if more than one element, add braces */
	if (exp_i->fs_list->next)
	    Tcl_AppendResult(interp," {",(char *)0);
		/* if more than one element, add braces */
		if (exp_i->state_list->next)
			Tcl_AppendResult(interp," {",(char *)0);

	for (fsp = exp_i->fs_list;fsp;fsp=fsp->next) {
	    char buf[10];	/* big enough for a small int */
	    sprintf(buf,"%s",fsp->f->spawnId);
	    Tcl_AppendElement(interp,buf);
	}
		for (fdp = exp_i->state_list;fdp;fdp=fdp->next) {
			char buf[10];	/* big enough for a small int */
			sprintf(buf,"%d",fdp->esPtr);
			Tcl_AppendElement(interp,buf);
		}

	if (exp_i->fs_list->next)
	    Tcl_AppendResult(interp,"} ",(char *)0);
    }
		if (exp_i->state_list->next)
			Tcl_AppendResult(interp,"} ",(char *)0);
	}
}

/*
 *----------------------------------------------------------------------
 *
 * expect_info --
 *
 *	Return current setting of the permanent expect_before/after/bg
/* return current setting of the permanent expect_before/after/bg */
 *
 * Results:
 *	A standard Tcl result
 *
 *----------------------------------------------------------------------
 */

int
expect_info(interp,ecmd,argc,argv)
    Tcl_Interp *interp;
    struct exp_cmd_descriptor *ecmd;
    int argc;
    char **argv;
expect_info(interp,ecmd,objc,objv)
Tcl_Interp *interp;
struct exp_cmd_descriptor *ecmd;
int objc;
Tcl_Obj *CONST objv[];		/* Argument objects. */
{
    struct exp_i *exp_i;
    int i;
    int direct = EXP_DIRECT|EXP_INDIRECT;
    char *iflag = 0;
    int all = FALSE;		/* report on all fds */
    char *chanId = NULL;
    struct exp_f *f;
    char *argv0 = argv[0];
    int all = FALSE;	/* report on all fds */
    ExpState *esPtr = 0;

    static char *flags[] = {"-i", "-all", "-noindirect", (char *)0};
    enum flags {EXP_ARG_I, EXP_ARG_ALL, EXP_ARG_NOINDIRECT};

    /* start with 2 to skip over "cmdname -info" */
    for (i = 2;i<objc;i++) {
	/*
	 * Allow abbreviations of switches and report an error if we
	 * get an invalid switch.
    while (*argv) {
	if (streq(argv[0],"-i") && argv[1]) {
	    chanId = argv[1];
	    argc-=2; argv+=2;
	} else if (streq(argv[0],"-all")) {
	 */

	int index;
	if (Tcl_GetIndexFromObj(interp, objv[i], flags, "flag", 0,
				&index) != TCL_OK) {
	    return TCL_ERROR;
	}
	switch ((enum flags) index) {
	case EXP_ARG_I:
	    i++;
	    if (i >= objc) {
		Tcl_WrongNumArgs(interp, 1, objv,"-i spawn_id");
		return TCL_ERROR;
	    }
	    break;
	case EXP_ARG_ALL:
	    all = TRUE;
	    argc--; argv++;
	    break;
	} else if (streq(argv[0],"-noindirect")) {
	case EXP_ARG_NOINDIRECT:
	    direct &= ~EXP_INDIRECT;
	    argc--; argv++;
	} else {
	    exp_error(interp,"usage: -info [-all | -i spawn_id]\n");
	    return TCL_ERROR;
	    break;
	}
    }

    if (all) {
	/* avoid printing out -i when redundant */
	struct exp_i *previous = 0;

	for (i=0;i<ecmd->ecd.count;i++) {
	    if (previous != ecmd->ecd.cases[i]->i_list) {
		exp_i_append(interp,ecmd->ecd.cases[i]->i_list);
		previous = ecmd->ecd.cases[i]->i_list;
	    }
	    ecase_append(interp,ecmd->ecd.cases[i]);
	}
	return TCL_OK;
    }

    if (chanId == NULL) {
    if (!iflag) {
	f = exp_update_master(interp,0,0);
	if (f == NULL) {
	    return(TCL_ERROR);
	if (!(esPtr = expStateCurrent(interp,0,0,0))) {
	    return TCL_ERROR;
	}
    } else {
    } else if (!(esPtr = expStateFromChannelName(interp,iflag,0,0,0,"dummy"))) {
	f = exp_chan2f(interp, chanId, 1, 0, argv0);
	if (f == NULL) {
	    /* handle as in indirect */
	    Tcl_ResetResult(interp);
	    for (i=0;i<ecmd->ecd.count;i++) {
		if (ecmd->ecd.cases[i]->i_list->direct == EXP_INDIRECT &&
		    streq(ecmd->ecd.cases[i]->i_list->variable,chanId)) {
		    ecase_append(interp,ecmd->ecd.cases[i]);
		}
	    }
	    return TCL_OK;
	}
    }
	/* not a valid ExpState so assume it is an indirect variable */
	Tcl_ResetResult(interp);
	for (i=0;i<ecmd->ecd.count;i++) {
	    if (ecmd->ecd.cases[i]->i_list->direct == EXP_INDIRECT &&
		    streq(ecmd->ecd.cases[i]->i_list->variable,iflag)) {
		ecase_append(interp,ecmd->ecd.cases[i]);
	    }
	}
	return TCL_OK;
    }
    

    /* print ecases of this direct_fd */
    for (exp_i=ecmd->i_list;exp_i;exp_i=exp_i->next) {
	if (!(direct & exp_i->direct)) continue;
	if (!exp_i_uses_f(exp_i,f)) continue;
	if (!exp_i_uses_state(exp_i,esPtr)) continue;
	ecase_by_exp_i_append(interp,ecmd,exp_i);
    }

    return TCL_OK;
}

/* Exp_ExpectGlobalCmd is invoked to process expect_before/after */
/* Exp_ExpectGlobalObjCmd is invoked to process expect_before/after/background */
/*ARGSUSED*/
int
Exp_ExpectGlobalCmd(clientData, interp, argc, argv)
    ClientData clientData;
    Tcl_Interp *interp;
    int argc;
    char **argv;
Exp_ExpectGlobalObjCmd(clientData, interp, objc, objv)
ClientData clientData;
Tcl_Interp *interp;
int objc;
Tcl_Obj *CONST objv[];		/* Argument objects. */
{
    int result = TCL_OK;
    struct exp_i *exp_i, **eip;
    struct exp_fs_list *fsl;	/* temp for interating over fs_list */
    struct exp_state_list *slPtr;   /* temp for interating over state_list */
    struct exp_cmd_descriptor eg;
    int count;
    char *argv0;

    struct exp_cmd_descriptor *ecmd = (struct exp_cmd_descriptor *) clientData;

    if ((argc == 2) && exp_one_arg_braced(argv[1])) {
	return(exp_eval_with_one_arg(clientData,interp,argv));
    } else if ((argc == 3) && streq(argv[1],"-brace")) {
	char *new_argv[2];
	new_argv[0] = argv[0];
	new_argv[1] = argv[2];
	return(exp_eval_with_one_arg(clientData,interp,new_argv));
    if ((objc == 2) && exp_one_arg_braced(objv[1])) {
	return(exp_eval_with_one_arg(clientData,interp,objv));
    } else if ((objc == 3) && streq(Tcl_GetString(objv[1]),"-brace")) {
	Tcl_Obj *new_objv[2];
	new_objv[0] = objv[0];
	new_objv[1] = objv[2];
	return(exp_eval_with_one_arg(clientData,interp,new_objv));
    }

    if (argc > 1 && (argv[1][0] == '-')) {
	if (exp_flageq("info",&argv[1][1],4)) {
	    return(expect_info(interp,ecmd,argc-2,argv+2));
    if (objc > 1 && (Tcl_GetString(objv[1])[0] == '-')) {
	if (exp_flageq("info",Tcl_GetString(objv[1])+1,4)) {
	    return(expect_info(interp,ecmd,objc,objv));
	} 
    }

    argv0 = argv[0];
    exp_cmd_init(&eg,ecmd->cmdtype,EXP_PERMANENT);

    if (TCL_ERROR == parse_expect_args(interp,&eg,NULL,argc,argv,argv0)) {
    if (TCL_ERROR == parse_expect_args(interp,&eg,EXP_SPAWN_ID_BAD,
	    objc,objv)) {
	return TCL_ERROR;
    }

    /*
     * visit each NEW direct exp_i looking for spawn ids.
     * When found, remove them from any OLD exp_i's.
     */

    /* visit each exp_i */
    for (exp_i=eg.i_list;exp_i;exp_i=exp_i->next) {
	if (exp_i->direct == EXP_INDIRECT) continue;

	/* for each spawn id, remove it from ecases */
	for (fsl=exp_i->fs_list;fsl;fsl=fsl->next) {
	    struct exp_f *f = fsl->f;
	for (slPtr=exp_i->state_list;slPtr;slPtr=slPtr->next) {
	    ExpState *esPtr = slPtr->esPtr;

	    /* validate all input descriptors */
	    if (f != exp_f_any) {
		if (!exp_fcheck(interp,f,1,1,argv0)) {
	    if (!expStateAnyIs(esPtr)) {
		if (!expStateCheck(interp,esPtr,1,1,"expect")) {
		    result = TCL_ERROR;
		    goto cleanup;
		}
	    }

	    
	    /* remove spawn id from exp_i */
	    ecmd_remove_f(interp,ecmd,f,EXP_DIRECT);
	    ecmd_remove_state(interp,ecmd,esPtr,EXP_DIRECT);
	}
    }
	
    /*
     * For each indirect variable, release its old ecases and 
     * clean up the matching spawn ids.
     * Same logic as in "expect_X delete" command.
     */

    for (exp_i=eg.i_list;exp_i;exp_i=exp_i->next) {
	struct exp_i **old_i;

	if (exp_i->direct == EXP_DIRECT) continue;

	for (old_i = &ecmd->i_list;*old_i;) {
	    struct exp_i *tmp;

	    if (((*old_i)->direct == EXP_DIRECT) ||
		(!streq((*old_i)->variable,exp_i->variable))) {
		    (!streq((*old_i)->variable,exp_i->variable))) {
		old_i = &(*old_i)->next;
		continue;
	    }

	    ecases_remove_by_expi(interp,ecmd,*old_i);

	    
	    /* unlink from middle of list */
	    tmp = *old_i;
	    *old_i = tmp->next;
	    tmp->next = 0;
	    exp_free_i(interp,tmp,exp_indirect_update2);
	}





︙


1276
1277
1278
1279
1280
1281
1282
1283

1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297

1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309

1310
1311
1312
1313
1314
1315
1316
1317
1318
1319

1320
1321

1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338

1339
1340
1341
1342
1343













1344

1345
1346




1347
1348
1349
1350
1351
1352
1353
1354










1355
1356


1357
1358
1359
1360
1361
1362
1363
1364
1365
1366





































1367
1368
1369
1370
1371
1372
1373






1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388








































1389
1390
1391
1392
1393
1394
1395
1396























1397
1398
1399
1400
1401
1402
1403
1404



























1405
1406
1407
1408
1409





















1410
1411
1412
1413


1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428























1429
1430

































1431
1432
1433
1434



1435
1436

1437
1438
1439
1440
1441
1442



1443

1444


1445
1446
1447
1448
1449
1450
1451
1452





1453
1454
1455

1456
1457

1458

1459
1460
1461
1462
1463


1464
1465
1466
1467
1468
1469
1470
1471
1472

1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484



1485
1486


1487
1488
1489
1490
1491
1492
1493

1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508



1509
1510
1511
1512
1513
1514

1515
1516
1517
1518
1519
1520
1521
1522
1523







1524
1525
1526
1527
1528
1529
1530
1531
1532



1533
1534
1535
1536

1537
1538

1539
1540
1541
1542
1543
1544


1545
1546
1547


1548
1549
1550
1551
1552

1553
1554
1555
1556
1557


1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570






1571
1572
1573
1574
1575
1576
1577






1578
1579
1580
1581
1582
1583
1584
1585
1586



1587







1588
1589
1590




















1591







1592
1593
1594






1595

1596
1597



1598



1599
1600
1601
1602
1603








1604
1605
1606
1607



1608
1609
1610

1611
1612
1613
1614
1615
1616
1617
1618
1619
1620









1621
1622
1623
1624
1625
1626

1627
1628
1629
1630
1631
1632
1633
1634
1635
1636









1637
1638

1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656

1657
1658
1659
1660
1661
1662
1663
1664
1665
1666

1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689




1690
1691
1692
1693
1694
1695

1696
1697
1698
1699
1700


1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724

1725
1726

1727
1728
1729
1730

1731
1732

1733
1734
1735
1736

1737
1738
1739
1740



1741
1742
1743
1744
1745
1746

1747
1748
1749
1750
1751




1752
1753
1754


1755
1756
1757


1758
1759
1760
1761
1762
1763




1764
1765
1766
1767
1768



1769
1770
1771

1772
1773
1774
1775
1776
1777
1778






1779
1780

1781
1782
1783

1784
1785
1786
1787
1788
1789
1790





1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805





1806
1807
1808
1809
1810
1811
1812
1813
1814
1815









1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835



1836
1837

1838
1839
1840
1841



1842
1843
1844
1845
1846




1847
1848

1849
1850
1851
1852
1853
1854





1855




1856
1857
1858
1859
1860
1861
1862








1863
1864
1865
1866



1867
1868

1869
1870
1871
1872



1873
1874
1875
1876




1877
1878
1879
1880
1881
1882
1883
1884
1885








1886
1887
1888
1889
1890




1891
1892

1893
1894






1895

1896
1897

1898
1899










1900
1901
1902
1903
1904
1905





















1906
1907
1908




1909
1910
1911
1912



1913
1914


1915
1916
1917
1918
1919






1920
1921


1922



1923
1924




1925
1926
1927
1928
1929
1930
1931
1932



























1933
1934

1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945



































1946
1947
1948
1949


1950
1951
1952
1953
1954
1955











1956
1957
1958
1959
1960
1961





































1962
1963
1964


1965
1966

1967
1968
1969
1970



1971
1972
1973


1974
1975
1976


1977
1978
1979
1980
1981
1982


1983

1984
1985
1986


1987
1988

1989
1990

1991
1992
1993


1994
1995
1996

1997

1998
1999


2000
2001
2002
2003




2004
2005
2006
2007

2008
2009
2010
2011

2012
2013

2014
2015

2016
2017

2018
2019
2020
2021



2022
2023
2024
2025
2026
2027
2028
2029




2030
2031
2032
2033
2034
2035
2036

2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050

2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202

















2203
2204
2205
2206



2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236




2237

2238
2239
2240


2241

2242
2243

2244
2245
2246


2247
2248


2249
2250
2251
2252
2253

2254
2255
2256
2257
2258
2259
2260
2261
2262


2263
2264
2265

2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280







2281
2282
2283
2284
2285
2286
2287







2288
2289
2290
2291
2292
2293


2294
2295
2296
2297
2298
2299
2300
2301
2302


2303
2304
2305
2306

2307
2308
2309
2310
2311



2312
2313
2314
2315
2316
2317
2318
2319

2320
2321

2322
2323
2324

2325
2326
2327
2328
2329
2330
2331
2332
2333



2334
2335
2336

2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350

2351

2352


2353
2354
2355
2356



2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376

2377
2378
2379
2380
2381
2382
2383

2384
2385
2386
2387

2388
2389
2390

2391
2392
2393
2394
2395

2396
2397
2398
2399

2400
2401

2402
2403

2404
2405
2406
2407
2408
2409
2410
2411




2412
2413
2414
2415
2416
2417
2418
2419

2420
2421
2422
2423
2424
2425
2426
2427
2428
2429

2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445

2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608

2609
2610

2611
2612
2613
2614
2615
2616



2617
2618
2619
2620



2621
2622
2623
2624

2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682

1397
1398
1399
1400
1401
1402
1403

1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417

1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429

1430
1431
1432
1433
1434
1435
1436
1437
1438
1439

1440
1441

1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458

1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477

1478


1479
1480
1481
1482








1483
1484
1485
1486
1487
1488
1489
1490
1491
1492


1493
1494










1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531







1532
1533
1534
1535
1536
1537















1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577








1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600








1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627





1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648




1649
1650















1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673


1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707



1708
1709
1710


1711






1712
1713
1714
1715
1716

1717
1718
1719
1720
1721





1722
1723
1724
1725
1726
1727
1728

1729
1730
1731
1732

1733
1734
1735



1736
1737
1738
1739
1740
1741
1742
1743



1744












1745
1746
1747


1748
1749
1750

1751
1752
1753
1754

1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767



1768
1769
1770
1771
1772
1773
1774
1775

1776
1777
1778
1779
1780
1781




1782
1783
1784
1785
1786
1787
1788
1789
1790
1791



1792


1793
1794
1795
1796



1797


1798






1799
1800



1801
1802





1803





1804
1805
1806
1807
1808
1809
1810
1811
1812






1813
1814
1815
1816
1817
1818
1819






1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830




1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841



1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869



1870
1871
1872
1873
1874
1875
1876
1877


1878
1879
1880
1881
1882
1883
1884





1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901

1902
1903









1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917

1918
1919









1920
1921
1922
1923
1924
1925
1926
1927
1928
1929

1930


















1931










1932


1933




















1934
1935
1936
1937






1938

1939
1940


1941
1942
1943
1944
1945
1946
1947
1948
1949
1950













1951
1952

1953
1954

1955
1956
1957
1958

1959
1960

1961
1962
1963
1964

1965
1966



1967
1968
1969
1970
1971
1972
1973
1974

1975
1976




1977
1978
1979
1980
1981


1982
1983
1984


1985
1986
1987
1988




1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002

2003
2004






2005
2006
2007
2008
2009
2010
2011

2012
2013
2014

2015







2016
2017
2018
2019
2020







2021
2022
2023





2024
2025
2026
2027
2028
2029









2030
2031
2032
2033
2034
2035
2036
2037
2038
2039













2040
2041
2042



2043
2044
2045
2046

2047
2048



2049
2050
2051
2052




2053
2054
2055
2056
2057

2058
2059





2060
2061
2062
2063
2064
2065
2066
2067
2068
2069







2070
2071
2072
2073
2074
2075
2076
2077
2078



2079
2080
2081
2082

2083
2084



2085
2086
2087
2088



2089
2090
2091
2092
2093








2094
2095
2096
2097
2098
2099
2100
2101
2102




2103
2104
2105
2106
2107

2108
2109
2110
2111
2112
2113
2114
2115
2116

2117


2118


2119
2120
2121
2122
2123
2124
2125
2126
2127
2128






2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149



2150
2151
2152
2153




2154
2155
2156


2157
2158





2159
2160
2161
2162
2163
2164


2165
2166
2167
2168
2169
2170


2171
2172
2173
2174
2175







2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203

2204











2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239




2240
2241






2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252






2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290


2291
2292
2293

2294
2295



2296
2297
2298
2299


2300
2301
2302


2303
2304

2305

2306
2307
2308
2309
2310

2311
2312


2313
2314
2315

2316
2317

2318
2319


2320
2321
2322
2323

2324
2325
2326


2327
2328




2329
2330
2331
2332
2333
2334
2335

2336
2337
2338
2339

2340
2341

2342
2343

2344
2345

2346
2347



2348
2349
2350
2351
2352
2353
2354




2355
2356
2357
2358
2359
2360
2361
2362
2363
2364

2365
2366













2367












































































































































2368











2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386



2387
2388
2389
2390

2391





















2392
2393




2394
2395
2396
2397

2398
2399


2400
2401

2402
2403

2404
2405


2406
2407


2408
2409
2410
2411
2412
2413

2414
2415
2416
2417
2418


2419


2420
2421
2422
2423

2424
2425
2426
2427
2428
2429
2430

2431







2432
2433
2434
2435
2436
2437
2438
2439
2440

2441
2442
2443

2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454


2455
2456









2457
2458
2459
2460
2461

2462

2463



2464
2465
2466
2467
2468
2469
2470
2471
2472
2473

2474
2475

2476
2477
2478

2479
2480
2481
2482
2483
2484
2485



2486
2487
2488
2489
2490

2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504

2505
2506
2507

2508
2509
2510



2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532

2533
2534
2535
2536
2537
2538
2539

2540
2541
2542
2543

2544
2545
2546
2547
2548
2549
2550
2551
2552

2553
2554
2555
2556

2557
2558

2559
2560

2561
2562
2563
2564
2565




2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576

2577
2578
2579
2580
2581
2582
2583
2584
2585
2586

2587
2588
2589




2590









2591


























































































































































2592
2593
2594
2595
2596
2597
2598
2599

2600


2601
2602
2603
2604



2605
2606
2607
2608



2609
2610
2611
2612
2613
2614

2615
2616
2617
2618
2619
2620
2621
2622
2623











































2624
2625
2626
2627
2628
2629
2630








-
+













-
+











-
+









-
+

-
+
















-
+





+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
-
-
+
+
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
-
-
+
+
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
+
+
+
-
-
+
-
-
-
-
-
-
+
+
+

+
-
+
+



-
-
-
-
-
+
+
+
+
+


-
+


+
-
+


-
-
-
+
+






-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
-
-
+
+

-




-
+












-
-
-
+
+
+





-
+





-
-
-
-
+
+
+
+
+
+
+



-
-
-

-
-
+
+
+

-
-
-
+
-
-
+
-
-
-
-
-
-
+
+
-
-
-
+
+
-
-
-
-
-
+
-
-
-
-
-
+
+







-
-
-
-
-
-
+
+
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+





-
-
-
-
+
+
+

+
+
+
+
+
+
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
+
+
+
-
-
-
+
+
+
+
+
+

+
-
-
+
+
+

+
+
+
-
-
-
-
-
+
+
+
+
+
+
+
+




+
+
+


-
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+





-
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+

-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
+
-
-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
-
-
-
-
-
-
+
-


-
-
+
+








-
-
-
-
-
-
-
-
-
-
-
-
-


-
+

-
+



-
+

-
+



-
+

-
-
-
+
+
+





-
+

-
-
-
-
+
+
+
+

-
-
+
+

-
-
+
+


-
-
-
-
+
+
+
+





+
+
+


-
+

-
-
-
-
-
-
+
+
+
+
+
+

-
+


-
+
-
-
-
-
-
-
-
+
+
+
+
+
-
-
-
-
-
-
-



-
-
-
-
-
+
+
+
+
+

-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
-
-
-
-
-



-
-
-
+
+
+

-
+

-
-
-
+
+
+

-
-
-
-
+
+
+
+

-
+

-
-
-
-
-
+
+
+
+
+

+
+
+
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
-
-
+
+
+

-
+

-
-
-
+
+
+

-
-
-
+
+
+
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
-
-
-
+
+
+
+

-
+


+
+
+
+
+
+
-
+
-
-
+
-
-
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
+
+
+
+
-
-
-
-
+
+
+
-
-
+
+
-
-
-
-
-
+
+
+
+
+
+
-
-
+
+

+
+
+
-
-
+
+
+
+

-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
+
+
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
+
+

-
+

-
-
-
+
+
+

-
-
+
+

-
-
+
+
-

-



+
+
-
+

-
-
+
+

-
+

-
+

-
-
+
+


-
+

+
-
-
+
+
-
-
-
-
+
+
+
+



-
+



-
+

-
+

-
+

-
+

-
-
-
+
+
+




-
-
-
-
+
+
+
+






-
+

-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
+
+
+

-

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


-
-
-
-
+
+
+
+
-
+

-
-
+
+
-
+

-
+

-
-
+
+
-
-
+
+




-
+




-
-

-
-
+
+


-
+






-

-
-
-
-
-
-
-
+
+
+
+
+
+
+


-



-
+
+
+
+
+
+
+




-
-
+
+
-
-
-
-
-
-
-
-
-
+
+



-
+
-

-
-
-
+
+
+







-
+

-
+


-
+






-
-
-
+
+
+


-
+













-
+

+
-
+
+

-
-
-
+
+
+



















-
+






-
+



-
+



+




-
+



-
+

-
+

-
+




-
-
-
-
+
+
+
+







-
+









-
+


-
-
-
-

-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-








-
+
-
-
+



-
-
-
+
+
+

-
-
-
+
+
+



-
+








-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-








    /*
     * arm all new bg direct fds
     */

    if (ecmd->cmdtype == EXP_CMD_BG) {
	for (exp_i=eg.i_list;exp_i;exp_i=exp_i->next) {
	    if (exp_i->direct == EXP_DIRECT) {
		fs_list_arm(interp,exp_i->fs_list);
		state_list_arm(interp,exp_i->state_list);
	    }
	}
    }

    /*
     * now that old ecases are gone, add new ecases and exp_i's (both
     * direct and indirect).
     */

    /* append ecases */

    count = ecmd->ecd.count + eg.ecd.count;
    if (eg.ecd.count) {
	int start_index;	/* where to add new ecases in old list */
	int start_index; /* where to add new ecases in old list */

	if (ecmd->ecd.count) {
	    /* append to end */
	    ecmd->ecd.cases = (struct ecase **)ckrealloc((char *)ecmd->ecd.cases, count * sizeof(struct ecase *));
	    start_index = ecmd->ecd.count;
	} else {
	    /* append to beginning */
	    ecmd->ecd.cases = (struct ecase **)ckalloc(eg.ecd.count * sizeof(struct ecase *));
	    start_index = 0;
	}
	memcpy(&ecmd->ecd.cases[start_index],eg.ecd.cases,
	       eg.ecd.count*sizeof(struct ecase *));
		eg.ecd.count*sizeof(struct ecase *));
	ecmd->ecd.count = count;
    }

    /* append exp_i's */
    for (eip = &ecmd->i_list;*eip;eip = &(*eip)->next) {
	/* empty loop to get to end of list */
    }
    /* *exp_i now points to end of list */

    *eip = eg.i_list;		/* connect new list to end of current list */
    *eip = eg.i_list;	/* connect new list to end of current list */

 cleanup:
  cleanup:
    if (result == TCL_ERROR) {
	/* in event of error, free any unreferenced ecases */
	/* but first, split up i_list so that exp_i's aren't */
	/* freed twice */

	for (exp_i=eg.i_list;exp_i;) {
	    struct exp_i *next = exp_i->next;
	    exp_i->next = 0;
	    exp_i = next;
	}
	free_ecases(interp,&eg,1);
    } else {
	if (eg.ecd.cases) ckfree((char *)eg.ecd.cases);
    }

    if (ecmd->cmdtype == EXP_CMD_BG) {
	exp_background_filehandlers_run_all();
	exp_background_channelhandlers_run_all();
    }

    return(result);
}

/* adjusts file according to user's size request */
void
expAdjust(esPtr)
ExpState *esPtr;
{
    int new_msize;
    int length;
    Tcl_Obj *newObj;
    char *string;
    int excessBytes;
    char *excessGuess;
    char *p;

/*
    /*
 *----------------------------------------------------------------------
 *
     * Resize buffer to user's request * 2 + 1.
     * x2: in case the match straddles two bufferfuls.
     * +1: for trailing null.
     */
 * exp_adjust --
 *
 *	Adjusts file according to user's size request
 *
 * Results:
 *	None
 *
 * Side Effects:

    new_msize = esPtr->umsize*2 + 1;

    if (new_msize != esPtr->msize) {
	string = Tcl_GetStringFromObj(esPtr->buffer, &length);
	if (length > new_msize) {
	    /*
	     * too much data, forget about data at beginning of buffer
	     */

 *	Memory may be allocated or reallocated
 *
	    excessBytes = length - new_msize;	/* initial guess */

 *---------------------------------------------------------------------- 
 */

void
exp_adjust(f)
    struct exp_f *f;
{
    int new_msize;

    /*
	    /*
	     * Alas, string + excessBytes may be in the middle of a UTF char.
	     * Find out for sure.
	     */
	    excessGuess = string + excessBytes;
	    for (p=string;;p=Tcl_UtfNext(p)) {
		if (p >= excessGuess) break;
	    }

	    /* now we can calculate a valid # of excess bytes */
	    excessBytes = p - string;
	    newObj = Tcl_NewStringObj(string + excessBytes,length - excessBytes);
	} else {
	    /*
	     * too little data
	     */

	    /* first copy what's there */
	    newObj = Tcl_NewStringObj(string,length);

	    /*
	     * Force object to allocate a buffer at least new_msize bytes long,
	     * then reset correct string length.
	     */

	    Tcl_SetObjLength(newObj,new_msize);
	    Tcl_SetObjLength(newObj,length);
	}
	Tcl_IncrRefCount(newObj);
	Tcl_DecrRefCount(esPtr->buffer);
	esPtr->buffer = newObj;

	esPtr->key = expect_key++;
	esPtr->msize = new_msize;
    }
}

     * get the latest buffer size.  Double the user input for
     * two reasons.  1) Need twice the space in case the match
     * straddles two bufferfuls, 2) easier to hack the division
     * by two when shifting the buffers later on.  The extra
     * byte in the malloc's is just space for a null we can slam on the
     * end.  It makes the logic easier later.  The -1 here is so that
     * requests actually come out to even/word boundaries (if user
#if OBSOLETE
/* Strip parity */
static void
expParityStrip(obj,offsetBytes)
    Tcl_Obj *obj;
    int offsetBytes;
     * gives "reasonable" requests)
     */
    new_msize = f->umsize*2 - 1;
    if (new_msize != f->msize) {
	if (!f->buffer) {
	    /* allocate buffer space for 1st time */
	    f->buffer = ckalloc((unsigned)new_msize+1);
	    f->lower = ckalloc((unsigned)new_msize+1);
	    f->size = 0;
	} else {
	    /* buffer already exists - resize */

	    /* if truncated, forget about some data */
	    if (f->size > new_msize) {
		/* copy end of buffer down */
{
    char *p, ch;
    
    int changed = FALSE;
    
    for (p = Tcl_GetString(obj) + offsetBytes;*p;p++) {
	ch = *p & 0x7f;
	if (ch != *p) changed = TRUE;
	else *p &= 0x7f;
    }

    if (changed) {
	/* invalidate the unicode rep */
	if (obj->typePtr->freeIntRepProc) {
	    obj->typePtr->freeIntRepProc(obj);
	}
    }
}
#endif /*OBSOLETE*/

/* This function is only used when debugging.  It checks when a string's
   internal UTF is sane and whether an offset into the string appears to
   be at a UTF boundary.
*/
static void
expValid(obj,offset)
     Tcl_Obj *obj;
     int offset;
{
  char *s, *end;
  int len;

  s = Tcl_GetStringFromObj(obj,&len);

  if (offset > len) {
    printf("offset (%d) > length (%d)\n",offset,len);
    fflush(stdout);
    abort();
  }

		memmove(f->buffer,f->buffer+(f->size - new_msize),new_msize);
		memmove(f->lower, f->lower +(f->size - new_msize),new_msize);
		f->size = new_msize;

		f->key = expect_key++;
	    }

	    f->buffer = ckrealloc(f->buffer,new_msize+1);
  /* first test for null terminator */
  end = s + len;
  if (*end != '\0') {
    printf("obj lacks null terminator\n");
    fflush(stdout);
    abort();
  }

  /* check for valid UTF sequence */
  while (*s) {
    Tcl_UniChar uc;

    s += Tcl_UtfToUniChar(s,&uc);
    if (s > end) {
      printf("UTF out of sync with terminator\n");
      fflush(stdout);
      abort();
    }
  }
  s += offset;
  while (*s) {
    Tcl_UniChar uc;

	    f->lower = ckrealloc(f->lower,new_msize+1);
	}
	f->msize = new_msize;
	f->buffer[f->size] = '\0';
	f->lower[f->size] = '\0';
    }
}

    s += Tcl_UtfToUniChar(s,&uc);
    if (s > end) {
      printf("UTF from offset out of sync with terminator\n");
      fflush(stdout);
      abort();
    }
  }
}

/* Strip UTF-encoded nulls from object, beginning at offset */
static int
expNullStrip(obj,offsetBytes)
    Tcl_Obj *obj;
    int offsetBytes;
{
    char *src, *src2;
    char *dest;
    Tcl_UniChar uc;
    int newsize;       /* size of obj after all nulls removed */

    src2 = src = dest = Tcl_GetString(obj) + offsetBytes;

    while (*src) {
	src += Tcl_UtfToUniChar(src,&uc);
	if (uc != 0) {
	    dest += Tcl_UniCharToUtf(uc,dest);
	}
/*
 *----------------------------------------------------------------------
 *
 * expect_read --
 *
    }
    newsize = offsetBytes + (dest - src2);
    Tcl_SetObjLength(obj,newsize);
    return newsize;
}

/* returns # of bytes read or (non-positive) error of form EXP_XXX */
/* returns 0 for end of file */
/* If timeout is non-zero, set an alarm before doing the read, else assume */
/* the read will complete immediately. */
/*ARGSUSED*/
static int
expIRead(interp,esPtr,timeout,save_flags) /* INTL */
Tcl_Interp *interp;
ExpState *esPtr;
int timeout;
int save_flags;
{
    int cc = EXP_TIMEOUT;
    int size = expSizeGet(esPtr);

 *	Does the logical equivalent of a read() for the expect
 *	command.  This includes figuring out which descriptor should
 *	be read from.  The result of the read() is left in a spawn_id's
 *	buffer rather than explicitly passing it back.  Note that if
    if (size + TCL_UTF_MAX >= esPtr->msize) 
	exp_buffer_shuffle(interp,esPtr,save_flags,EXPECT_OUT,"expect");
 *	someone else has modified a buffer either before or while this
 *	expect is running (i.e., if we or some event has called Tcl_Eval
 *	which did another expect/interact), expect_read will also call
 *	this a successful read (for the purposes if needing to pattern
 *	match against it).
 *
 *
 * Results:
 *	If it returns a negative number, it corresponds to a EXP_XXX result
 *	If it returns a non-negative number, it means there is data
 *	0 means nothing new was actually read, but it should be looked at again
 *
 * Side Effects
 *
 *----------------------------------------------------------------------
    size = expSizeGet(esPtr);

#ifdef SIMPLE_EVENT
 restart:

    alarm_fired = FALSE;

    if (timeout > -1) {
	signal(SIGALRM,sigalarm_handler);
	alarm((timeout > 0)?timeout:1);
    }
#endif

    
    cc = Tcl_ReadChars(esPtr->channel,
	    esPtr->buffer,
	    esPtr->msize - (size / TCL_UTF_MAX),
	    1 /* append */);
    i_read_errno = errno;

#ifdef SIMPLE_EVENT
    alarm(0);

 */

    if (cc == -1) {
	/* check if alarm went off */
	if (i_read_errno == EINTR) {
	    if (alarm_fired) {
		return EXP_TIMEOUT;
	    } else {
		if (Tcl_AsyncReady()) {
		    int rc = Tcl_AsyncInvoke(interp,TCL_OK);
		    if (rc != TCL_OK) return(exp_tcl2_returnvalue(rc));
		}
		goto restart;
	    }
	}
    }
#endif
    return cc;	
}

/*
 * expRead() does the logical equivalent of a read() for the expect command.
 * This includes figuring out which descriptor should be read from.
 *
 * The result of the read() is left in a spawn_id's buffer rather than
 * explicitly passing it back.  Note that if someone else has modified a buffer
 * either before or while this expect is running (i.e., if we or some event has
 * called Tcl_Eval which did another expect/interact), expRead will also call
 * this a successful read (for the purposes if needing to pattern match against
 * it).
 */

/* if it returns a negative number, it corresponds to a EXP_XXX result */
/* if it returns a non-negative number, it means there is data */
/* (0 means nothing new was actually read, but it should be looked at again) */
int
expect_read(interp,masters,masters_max,m,timeout,key)
    Tcl_Interp *interp;
    struct exp_f **masters;	/* If NULL, then m is already known and set. */
expRead(interp,esPtrs,esPtrsMax,esPtrOut,timeout,key)
Tcl_Interp *interp;
ExpState *(esPtrs[]);		/* If 0, then esPtrOut already known and set */
    int masters_max;		/* If *masters is not-zero, then masters_max
				 * is the number of masters.
int esPtrsMax;			/* number of esPtrs */
				 * If *masters is zero, then masters_max
				 * is used as the mask (ready vs except).
				 * Crude but simplifies the interface. */
    struct exp_f **m;		/* Out variable to leave new master. */
    int timeout;
    int key;
ExpState **esPtrOut;		/* Out variable to leave new ExpState. */
int timeout;
int key;
{
    ExpState *esPtr;
    struct exp_f *f;

    int size;
    int cc;
    int write_count;
    int tcl_set_flags;	/* if we have to discard chars, this tells */
    /* whether to show user locally or globally */
    
    if (masters == 0) {
	/* we already know the master, just find out what happened */
	cc = exp_get_next_event_info(interp,*m,masters_max);
			/* whether to show user locally or globally */

    if (esPtrs == 0) {
	/* we already know the ExpState, just find out what happened */
	cc = exp_get_next_event_info(interp,*esPtrOut);
	tcl_set_flags = TCL_GLOBAL_ONLY;
    } else {
	cc = exp_get_next_event(interp,masters,masters_max,m,timeout,key);
	cc = exp_get_next_event(interp,esPtrs,esPtrsMax,esPtrOut,timeout,key);
	tcl_set_flags = 0;
    }
    esPtr = *esPtrOut;
    

    if (cc == EXP_DATA_NEW) {
	/* try to read it */

	cc = exp_i_read(interp,*m,timeout,tcl_set_flags);

	cc = expIRead(interp,esPtr,timeout,tcl_set_flags);
	
	/* the meaning of 0 from i_read means eof.  Muck with it a */
	/* little, so that from now on it means "no new data arrived */
	/* but it should be looked at again anyway". */
	if (cc == 0) {
	    cc = EXP_EOF;
	} else if (cc > 0) {
	    f = *m;
	    f->buffer[f->size += cc] = '\0';

	    /* successfully read data */
	    /* strip parity if requested */
	    if (f->parity == 0) {
		/* do it from end backwards */
		char *p = f->buffer + f->size - 1;
		int count = cc;
		while (count--) {
		    *p-- &= 0x7f;
		}
	    }
	} /* else {
	     assert(cc < 0) in which case some sort of error was
	     encountered such as an interrupt with that forced an
	} else {
	    /* failed to read data - some sort of error was encountered such as
	     * an interrupt with that forced an error return
	     error return
	     } */
	     */
	}
    } else if (cc == EXP_DATA_OLD) {
	f = *m;
	cc = 0;
    } else if (cc == EXP_RECONFIGURE) {
	return EXP_RECONFIGURE;
    }
    

    if (cc == EXP_ABEOF) {	/* abnormal EOF */
	/* On many systems, ptys produce EIO upon EOF - sigh */
	if (i_read_errno == EIO) {
	    /* Sun, Cray, BSD, and others */
	    cc = EXP_EOF;
	} else if (i_read_errno == EINVAL) {
	    /* Solaris 2.4 occasionally returns this */
	    cc = EXP_EOF;
	} else {
	    if (i_read_errno == EBADF) {
		exp_error(interp,"bad spawn_id (process died earlier?)");
	    } else {
		exp_error(interp,"i_read(spawn_id=%d): %s",*m,
			  Tcl_PosixError(interp));
		exp_close(interp,*m);
		exp_error(interp,"i_read(spawn_id fd=%d): %s",esPtr->fdin,
			Tcl_PosixError(interp));
		exp_close(interp,esPtr);
	    }
	    return(EXP_TCLERROR);
	    /* was goto error; */
	}
    }
    

    /* EOF, TIMEOUT, and ERROR return here */
    /* In such cases, there is no need to update screen since, if there */
    /* was prior data read, it would have been sent to the screen when */
    /* it was read. */
    if (cc < 0) return (cc);
    
    /* update display */
    
    if (f->size) write_count = f->size - f->printed;

    /*
     * update display
     */

    size = expSizeGet(esPtr);
    if (size) write_count = size - esPtr->printed;
    else write_count = 0;
    
    if (write_count) {
	if (logfile_all || (loguser && logfile)) {
	    Tcl_Write(logfile, f->buffer + f->printed, write_count);
	}
	/*
	 * don't write to user if they're seeing it already,
	 * that is, typing it!
	 * Show chars to user if they've requested it, UNLESS they're seeing it
	 * already because they're typing it and tty driver is echoing it.
	 * Also send to Diag and Log if appropriate.
	 */
	if (loguser) {
	    if (strcmp("stdin", (*m)->spawnId) != 0) {
		Tcl_Write(Tcl_GetStdChannel(TCL_STDOUT),
	expLogInteractionU(esPtr,Tcl_GetString(esPtr->buffer) + esPtr->printed);
			  f->buffer + f->printed, write_count);
	    }
	    
	}
	if (debugfile) {
	    Tcl_Write(debugfile, f->buffer + f->printed, write_count);
	}

	/* remove nulls from input, since there is no way */
	/*
	 * strip nulls from input, since there is no way for Tcl to deal with
	/* for Tcl to deal with such strings.  Doing it here */
	/* lets them be sent to the screen, just in case */
	/* they are involved in formatting operations */
	 * such strings.  Doing it here lets them be sent to the screen, just
	 * in case they are involved in formatting operations
	if (f->rm_nulls) {
	    f->size -= rm_nulls(f->buffer + f->printed,write_count);
	}
	f->buffer[f->size] = '\0';

	 */
	/* copy to lowercase buffer */
	exp_lowmemcpy(f->lower+f->printed, f->buffer+f->printed,
		      1 + f->size - f->printed);

	f->printed = f->size;	/* count'm even if not logging */
	if (esPtr->rm_nulls) size = expNullStrip(esPtr->buffer,esPtr->printed);
	esPtr->printed = size; /* count'm even if not logging */
    }
    return(cc);
}

/* when buffer fills, copy second half over first and */
/* continue, so we can do matches over multiple buffers */
void
exp_buffer_shuffle(interp,f,save_flags,array_name,caller_name)
    Tcl_Interp *interp;
    struct exp_f *f;
    int save_flags;
    char *array_name;
    char *caller_name;
exp_buffer_shuffle(interp,esPtr,save_flags,array_name,caller_name) /* INTL */
Tcl_Interp *interp;
ExpState *esPtr;
int save_flags;
char *array_name;
char *caller_name;
{
    char spawn_id[10];		/* enough for a %d */
    char match_char;		/* place to hold char temporarily */
    /* uprooted by a NULL */

    int first_half = f->size/2;
    int second_half = f->size - first_half;
    char *str;
    char *middleGuess;
    char *p;
    int length, newlen;
    int skiplen;
    char lostByte;

    /*
     * allow user to see data we are discarding
     */

    sprintf(spawn_id,"%s",f->spawnId);
    debuglog("%s: set %s(spawn_id) \"%s\"\r\n",
	     caller_name,array_name,dprintify(spawn_id));
    Tcl_SetVar2(interp,array_name,"spawn_id",spawn_id,save_flags);
    expDiagLog("%s: set %s(spawn_id) \"%s\"\r\n",
	    caller_name,array_name,esPtr->name);
    Tcl_SetVar2(interp,array_name,"spawn_id",esPtr->name,save_flags);

    /*
     * The internal storage buffer object should only be referred
     * to by the channel that uses it.  We always copy the contents
     * out of the object before passing the data to anyone outside
     * of these routines.  This ensures that the object always has
     * a refcount of 1 so we can safely modify the contents in place.
     */
    /* temporarily null-terminate buffer in middle */
    match_char = f->buffer[first_half];
    f->buffer[first_half] = 0;

    if (Tcl_IsShared(esPtr->buffer)) {
	panic("exp_buffer_shuffle called with shared buffer object");
    }

    str = Tcl_GetStringFromObj(esPtr->buffer,&length);

    /* guess at the middle */
    middleGuess = str + length/2;

    /* crawl our way into the middle of the string
     * to make sure we are at a UTF char boundary
     */
    for (p=str;*p;p = Tcl_UtfNext(p)) {
	if (p > middleGuess) break;   /* ok, that's enough */
    }

    /*
     * p is now at the beginning of a UTF char in the middle of the string
     */

    /*
     * before doing move, show user data we are discarding
     */
    skiplen = p-str;
    lostByte = *p;
    /* temporarily stick null in middle of string */
    Tcl_SetObjLength(esPtr->buffer,skiplen);
    debuglog("%s: set %s(buffer) \"%s\"\r\n",
	     caller_name,array_name,dprintify(f->buffer));
    Tcl_SetVar2(interp,array_name,"buffer",f->buffer,save_flags);

    expDiagLog("%s: set %s(buffer) \"",caller_name,array_name);
    expDiagLogU(expPrintify(Tcl_GetString(esPtr->buffer)));
    expDiagLogU("\"\r\n");
    Tcl_SetVar2(interp,array_name,"buffer",Tcl_GetString(esPtr->buffer),
	    save_flags);

    /*
    /* remove middle-null-terminator */
    f->buffer[first_half] = match_char;
     * restore damage
     */
    *p = lostByte;

    /*
     * move 2nd half of string down to 1st half
     */
    memcpy(f->buffer,f->buffer+first_half,second_half);
    memcpy(f->lower, f->lower +first_half,second_half);
    f->size = second_half;
    f->printed -= first_half;
    if (f->printed < 0) f->printed = 0;

    newlen = length - skiplen;
    memmove(str,p, newlen);

    Tcl_SetObjLength(esPtr->buffer,newlen);

    esPtr->printed -= skiplen;
    if (esPtr->printed < 0) esPtr->printed = 0;
}

/* map EXP_ style return value to TCL_ style return value */
/* not defined to work on TCL_OK */
#ifdef _MSC_VER
#   pragma warning(disable: 4715)
#endif
int
exp_tcl2_returnvalue(x)
    int x;
int x;
{
    switch (x) {
    case TCL_ERROR:			return EXP_TCLERROR;
    case TCL_RETURN:		return EXP_TCLRET;
    case TCL_BREAK:			return EXP_TCLBRK;
    case TCL_CONTINUE:		return EXP_TCLCNT;
    case EXP_CONTINUE:		return EXP_TCLCNTEXP;
    case EXP_CONTINUE_TIMER:	return EXP_TCLCNTTIMER;
    case EXP_TCL_RETURN:		return EXP_TCLRETTCL;
    }
	switch (x) {
	case TCL_ERROR:			return EXP_TCLERROR;
	case TCL_RETURN:		return EXP_TCLRET;
	case TCL_BREAK:			return EXP_TCLBRK;
	case TCL_CONTINUE:		return EXP_TCLCNT;
	case EXP_CONTINUE:		return EXP_TCLCNTEXP;
	case EXP_CONTINUE_TIMER:	return EXP_TCLCNTTIMER;
	case EXP_TCL_RETURN:		return EXP_TCLRETTCL;
	}
}

/* map from EXP_ style return value to TCL_ style return values */
int
exp_2tcl_returnvalue(x)
    int x;
int x;
{
    switch (x) {
    case EXP_TCLERROR:		return TCL_ERROR;
    case EXP_TCLRET:		return TCL_RETURN;
    case EXP_TCLBRK:		return TCL_BREAK;
    case EXP_TCLCNT:		return TCL_CONTINUE;
    case EXP_TCLCNTEXP:		return EXP_CONTINUE;
    case EXP_TCLCNTTIMER:		return EXP_CONTINUE_TIMER;
    case EXP_TCLRETTCL:		return EXP_TCL_RETURN;
    }
	switch (x) {
	case EXP_TCLERROR:		return TCL_ERROR;
	case EXP_TCLRET:		return TCL_RETURN;
	case EXP_TCLBRK:		return TCL_BREAK;
	case EXP_TCLCNT:		return TCL_CONTINUE;
	case EXP_TCLCNTEXP:		return EXP_CONTINUE;
	case EXP_TCLCNTTIMER:		return EXP_CONTINUE_TIMER;
	case EXP_TCLRETTCL:		return EXP_TCL_RETURN;
	}
}

#ifdef _MSC_VER
/*
 *----------------------------------------------------------------------
 *
 * exp_i_read --
 *
 *	Reads from the input channel. Returns # of chars read or
 *	(non-positive) error of form EXP_XXX.
 * Results:
 *	returns 0 for end of file
 *	If timeout is non-zero, assume the read will complete immediately
 *	because data is known to be available.
 *
 * Side Effects:
 *	Data is read from a channel
 *
 *----------------------------------------------------------------------
 */

#   pragma warning(default: 4715)
/*ARGSUSED*/
static int
exp_i_read(interp,f,timeout,save_flags)
    Tcl_Interp *interp;
    struct exp_f *f;
    int timeout;
    int save_flags;
{
    int nread;

#endif
    if (f->size == f->msize) 
	exp_buffer_shuffle(interp,f,save_flags,EXPECT_OUT,"expect");

    nread = Tcl_Read(f->channel, f->buffer+f->size, f->msize-f->size);
    if (nread == -1) {
	i_read_errno = errno;
    } else {
	/* {DWORD x; f->buffer[f->size] = 0; WriteConsole(GetStdHandle(STD_OUTPUT_HANDLE), f->buffer+f->size, nread, &x, NULL); printf("exp_i_read: Got %d bytes\n", nread);} */
	nread = nread;
    }

    return(nread);
}

/*
 *----------------------------------------------------------------------
 *
 * exp_get_var --
 *
 *	Variables predefined by expect are retrieved using this routine
 *	which looks in the global space if they are not in the local space.
 *	This allows the user to localize them if desired, and also to
 *	avoid having to put "global" in procedure definitions.
/* variables predefined by expect are retrieved using this routine
which looks in the global space if they are not in the local space.
This allows the user to localize them if desired, and also to
avoid having to put "global" in procedure definitions.
 *
 * Results:
 *	The value of the variable if it exists
 *
 *----------------------------------------------------------------------
 */
*/

char *
exp_get_var(interp,var)
    Tcl_Interp *interp;
    char *var;
Tcl_Interp *interp;
char *var;
{
    char *val;

    if (NULL != (val = Tcl_GetVar(interp,var,0 /* local */)))
	return(val);
    return(Tcl_GetVar(interp,var,TCL_GLOBAL_ONLY));
}

/*
 *----------------------------------------------------------------------
 *
 * get_timeout --
 *
 *	Gets the value of the 'timeout' variable
 *
 * Results:
 *	The value of the variable if it exists
 *
 *----------------------------------------------------------------------
 */

static int
get_timeout(interp)
    Tcl_Interp *interp;
Tcl_Interp *interp;
{
    static int timeout = INIT_EXPECT_TIMEOUT;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    char *t;

    if (NULL != (t = exp_get_var(interp,EXPECT_TIMEOUT))) {
	timeout = atoi(t);
	tsdPtr->timeout = atoi(t);
    }
    return(timeout);
    return(tsdPtr->timeout);
}

/* make a copy of a linked list (1st arg) and attach to end of another (2nd
   arg) */
arg) */
static int
update_expect_fds(i_list,fd_union)
    struct exp_i *i_list;
    struct exp_fs_list **fd_union;
update_expect_states(i_list,i_union)
struct exp_i *i_list;
struct exp_state_list **i_union;
{
    struct exp_i *p;

    /* for each i_list in an expect statement ... */
    for (p=i_list;p;p=p->next) {
	struct exp_fs_list *fsl;
	struct exp_state_list *slPtr;

	/* for each fd in the i_list */
	for (fsl=p->fs_list;fsl;fsl=fsl->next) {
	    struct exp_fs_list *tmpfsl;
	    struct exp_fs_list *u;
	/* for each esPtr in the i_list */
	for (slPtr=p->state_list;slPtr;slPtr=slPtr->next) {
	    struct exp_state_list *tmpslPtr;
	    struct exp_state_list *u;

	    if (fsl->f == exp_f_any || fsl->f == NULL) continue;

	    if (expStateAnyIs(slPtr->esPtr)) continue;
	    
	    /* check this one against all so far */
	    for (u = *fd_union;u;u=u->next) {
		if (fsl->f == u->f) goto found;
	    for (u = *i_union;u;u=u->next) {
		if (slPtr->esPtr == u->esPtr) goto found;
	    }
	    /* if not found, link in as head of list */
	    tmpfsl = exp_new_fs(fsl->f);
	    tmpfsl->next = *fd_union;
	    *fd_union = tmpfsl;
	found:;
	    tmpslPtr = exp_new_state(slPtr->esPtr);
	    tmpslPtr->next = *i_union;
	    *i_union = tmpslPtr;
	    found:;
	}
    }
    return TCL_OK;
}

#ifdef _MSC_VER
#   pragma warning(disable: 4715)
#endif
char *
exp_cmdtype_printable(cmdtype)
    int cmdtype;
int cmdtype;
{
    switch (cmdtype) {
    case EXP_CMD_FG: return("expect");
    case EXP_CMD_BG: return("expect_background");
    case EXP_CMD_BEFORE: return("expect_before");
    case EXP_CMD_AFTER: return("expect_after");
    }
	switch (cmdtype) {
	case EXP_CMD_FG: return("expect");
	case EXP_CMD_BG: return("expect_background");
	case EXP_CMD_BEFORE: return("expect_before");
	case EXP_CMD_AFTER: return("expect_after");
	}
#ifdef LINT
    return("unknown expect command");
	return("unknown expect command");
#endif
}

#ifdef _MSC_VER
/*
 *----------------------------------------------------------------------
 *
 * exp_indirect_update2 --
 *
 *	This is called back via Tcl's trace handler whenever
 *	an indirect spawn id list is changed
#   pragma warning(default: 4715)
#endif

/* exp_indirect_update2 is called back via Tcl's trace handler whenever */
/* an indirect spawn id list is changed */
 *
 * Results:
 *	A string
 *
 *----------------------------------------------------------------------
 */

/*ARGSUSED*/
static char *
exp_indirect_update2(clientData, interp, name1, name2, flags)
    ClientData clientData;
    Tcl_Interp *interp;	/* Interpreter containing variable. */
    char *name1;		/* Name of variable. */
    char *name2;		/* Second part of variable name. */
    int flags;		/* Information about what happened. */
ClientData clientData;
Tcl_Interp *interp;	/* Interpreter containing variable. */
char *name1;		/* Name of variable. */
char *name2;		/* Second part of variable name. */
int flags;		/* Information about what happened. */
{
    char *msg;
    
    struct exp_i *exp_i = (struct exp_i *)clientData;
    exp_configure_count++;
    msg = exp_indirect_update1(interp,&exp_cmds[exp_i->cmdtype],exp_i);
    
    exp_background_filehandlers_run_all();
    
    return msg;
	char *msg;

	struct exp_i *exp_i = (struct exp_i *)clientData;
	exp_configure_count++;
	msg = exp_indirect_update1(interp,&exp_cmds[exp_i->cmdtype],exp_i);

	exp_background_channelhandlers_run_all();

	return msg;
}

/*
 *----------------------------------------------------------------------
 *
 * exp_indirect_update1 --
 *
 *	Get the updated value of a variable
 *
 * Results:
 *	A string
 *
 *----------------------------------------------------------------------
 */

static char *
exp_indirect_update1(interp,ecmd,exp_i)
    Tcl_Interp *interp;
    struct exp_cmd_descriptor *ecmd;
    struct exp_i *exp_i;
Tcl_Interp *interp;
struct exp_cmd_descriptor *ecmd;
struct exp_i *exp_i;
{
    struct exp_fs_list *fsl;	/* temp for interating over fs_list */
	struct exp_state_list *slPtr;	/* temp for interating over state_list */

    /*
     * disarm any fd's that lose all their ecases
     */
	/*
	 * disarm any ExpState's that lose all their ecases
	 */

    if (ecmd->cmdtype == EXP_CMD_BG) {
	/* clean up each spawn id used by this exp_i */
	for (fsl=exp_i->fs_list;fsl;fsl=fsl->next) {
	    struct exp_f *f = fsl->f;
	if (ecmd->cmdtype == EXP_CMD_BG) {
		/* clean up each spawn id used by this exp_i */
		for (slPtr=exp_i->state_list;slPtr;slPtr=slPtr->next) {
			ExpState *esPtr = slPtr->esPtr;

	    if (f == NULL || f == exp_f_any) continue;
			if (expStateAnyIs(esPtr)) continue;

	    /* silently skip closed or preposterous fds */
	    /* since we're just disabling them anyway */
	    /* preposterous fds will have been reported */
	    /* by code in next section already */
	    if (! exp_fcheck(interp, f, 1, 0, "")) continue;
			/* silently skip closed or preposterous fds */
			/* since we're just disabling them anyway */
			/* preposterous fds will have been reported */
			/* by code in next section already */
			if (!expStateCheck(interp,slPtr->esPtr,1,0,"")) continue;

			/* check before decrementing, ecount may not be */
			/* positive if update is called before ecount is */
			/* properly synchronized */
			if (esPtr->bg_ecount > 0) {
	    f->bg_ecount--;
	    if (f->bg_ecount == 0) {
		exp_disarm_background_filehandler(f);
		f->bg_interp = 0;
	    }
	}
    }
				esPtr->bg_ecount--;
			}
			if (esPtr->bg_ecount == 0) {
				exp_disarm_background_channelhandler(esPtr);
				esPtr->bg_interp = 0;
			}
		}
	}

    /*
     * reread indirect variable
     */
	/*
	 * reread indirect variable
	 */

    exp_i_update(interp,exp_i);
	exp_i_update(interp,exp_i);

    /*
     * check validity of all fd's in variable
     */
	/*
	 * check validity of all fd's in variable
	 */

    for (fsl=exp_i->fs_list;fsl;fsl=fsl->next) {
	/* validate all input descriptors */
	if (fsl->f == NULL || fsl->f == exp_f_any) continue;
	for (slPtr=exp_i->state_list;slPtr;slPtr=slPtr->next) {
	    /* validate all input descriptors */

	    if (expStateAnyIs(slPtr->esPtr)) continue;

	if (!exp_fcheck(interp,fsl->f,1,1,
			exp_cmdtype_printable(ecmd->cmdtype))) {
	    static char msg[200];
	    sprintf(msg,"%s from indirect variable (%s)",
		    interp->result,exp_i->variable);
	    return msg;
	}
    }
	    if (!expStateCheck(interp,slPtr->esPtr,1,1,
		    exp_cmdtype_printable(ecmd->cmdtype))) {
		static char msg[200];
		sprintf(msg,"%s from indirect variable (%s)",
			interp->result,exp_i->variable);
		return msg;
	    }
	}

    /* for each spawn id in list, arm if necessary */
    if (ecmd->cmdtype == EXP_CMD_BG) {
	fs_list_arm(interp,exp_i->fs_list);
    }
	/* for each spawn id in list, arm if necessary */
	if (ecmd->cmdtype == EXP_CMD_BG) {
		state_list_arm(interp,exp_i->state_list);
	}

    return (char *)0;
	return (char *)0;
}

int
expMatchProcess(interp, eo, cc, bg, detail)
    Tcl_Interp *interp;
    struct eval_out *eo;	/* final case of interest */
    int cc;			/* EOF, TIMEOUT, etc... */
    int bg;			/* 1 if called from background handler, */
/*
				/* else 0 */
 *----------------------------------------------------------------------
 *
    char *detail;
 * exp_background_filehandlers_run_all --
 *
{
    ExpState *esPtr = 0;
    Tcl_Obj *body = 0;
    Tcl_Obj *buffer;
    struct ecase *e = 0;	/* points to current ecase */
    int match = -1;		/* characters matched */
    char match_char;	/* place to hold char temporarily */
    /* uprooted by a NULL */
    int result = TCL_OK;

 *	See which channels need to be checked for events and
 *	start up an event handler
 *
 * Results:
 *	None
 *
#define out(indexName, value) \
 expDiagLog("%s: set %s(%s) \"",detail,EXPECT_OUT,indexName); \
 expDiagLogU(expPrintify(value)); \
 expDiagLogU("\"\r\n"); \
 Tcl_SetVar2(interp, EXPECT_OUT,indexName,value,(bg ? TCL_GLOBAL_ONLY : 0));

    if (eo->e) {
	e = eo->e;
	body = e->body;
	if (cc != EXP_TIMEOUT) {
	    esPtr = eo->esPtr;
	    match = eo->match;
	    buffer = eo->buffer;
	}
    } else if (cc == EXP_EOF) {
	/* read an eof but no user-supplied case */
	esPtr = eo->esPtr;
	match = eo->match;
	buffer = eo->buffer;
    }			

 * Side Effects:
 *	Event handlers are put in place
 *
    if (match >= 0) {
	char name[20], value[20];
	int i;

 *----------------------------------------------------------------------
 */

void
	if (e && e->use == PAT_RE) {
	    Tcl_RegExp re;
	    int flags;
exp_background_filehandlers_run_all()
{
	    Tcl_RegExpInfo info;

    struct exp_f *f;
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;

    hPtr = Tcl_FirstHashEntry(exp_f_table, &search);
	    if (e->Case == CASE_NORM) {
		flags = TCL_REG_ADVANCED;
	    } else {
		flags = TCL_REG_ADVANCED | TCL_REG_NOCASE;
	    }
		    
    while (hPtr) {
	f = (struct exp_f *) Tcl_GetHashValue(hPtr);
	    re = Tcl_GetRegExpFromObj(interp, e->pat, flags);
	    Tcl_RegExpGetInfo(re, &info);

	    for (i=0;i<=info.nsubs;i++) {
		int start, end;
		Tcl_Obj *val;
	/* kick off any that already have input waiting */
	if (!f->valid) continue;

		start = info.matches[i].start;
		end = info.matches[i].end-1;
		if (start == -1) continue;

	/* is bg_interp the best way to check if armed? */
	if (f->bg_interp && (f->size > 0)) {
	    exp_background_filehandler((ClientData)f, 0 /*ignored*/);
	}
	hPtr = Tcl_NextHashEntry(&search);
    }
}
		if (e->indices) {
		    /* start index */
		    sprintf(name,"%d,start",i);
		    sprintf(value,"%d",start);
		    out(name,value);

		    /* end index */
		    sprintf(name,"%d,end",i);
		    sprintf(value,"%d",end);
		    out(name,value);
		}

				/* string itself */
		sprintf(name,"%d,string",i);
		val = Tcl_GetRange(buffer, start, end);
		expDiagLog("%s: set %s(%s) \"",detail,EXPECT_OUT,name);
		expDiagLogU(expPrintifyObj(val));
		expDiagLogU("\"\r\n");
		Tcl_SetVar2Ex(interp,EXPECT_OUT,name,val,(bg ? TCL_GLOBAL_ONLY : 0));
	    }
	} else if (e && (e->use == PAT_GLOB || e->use == PAT_EXACT)) {
	    char *str;

	    if (e->indices) {
		/* start index */
		sprintf(value,"%d",e->simple_start);
		out("0,start",value);

/*
		/* end index */
 *----------------------------------------------------------------------
 *
 * exp_background_filehandler --
 *
 *	This function is called from the background when input arrives
 *
 * Results:
 *	None
 *
 * Side Effects:
 *
		sprintf(value,"%d",e->simple_start + match - 1);
		out("0,end",value);
	    }

	    /* string itself */
	    str = Tcl_GetString(esPtr->buffer) + e->simple_start;
	    /* temporarily null-terminate in middle */
	    match_char = str[match];
	    str[match] = 0;
	    out("0,string",str);
	    str[match] = match_char;

				/* redefine length of string that */
				/* matched for later extraction */
	    match += e->simple_start;
	} else if (e && e->use == PAT_NULL && e->indices) {
				/* start index */
	    sprintf(value,"%d",match-1);
	    out("0,start",value);
				/* end index */
	    sprintf(value,"%d",match-1);
	    out("0,end",value);
	} else if (e && e->use == PAT_FULLBUFFER) {
	    expDiagLogU("expect_background: full buffer\r\n");
	}
    }

    /* this is broken out of (match > 0) (above) since it can */
    /* that an EOF occurred with match == 0 */
    if (eo->esPtr) {
	char *str;
	int length;

	out("spawn_id",esPtr->name);

 *---------------------------------------------------------------------- 
 */

/*ARGSUSED*/
	str = Tcl_GetStringFromObj(esPtr->buffer, &length);
	/* Save buf[0..match] */
void
exp_background_filehandler(clientData,mask)
    ClientData clientData;
    int mask;
{
    Tcl_Interp *interp;
	/* temporarily null-terminate string in middle */
	match_char = str[match];
	str[match] = 0;
	out("buffer",str);
	/* remove middle-null-terminator */
	str[match] = match_char;

	/* "!e" means no case matched - transfer by default */
	if (!e || e->transfer) {
	    /* delete matched chars from input buffer */
	    esPtr->printed -= match;
    int cc;			/* number of chars returned in a single read
				 * or negative EXP_whatever */
    struct exp_f *f;		/* file associated with master */
    
    int i;			/* trusty temporary */
    
	    if (length != 0) {
		memmove(str,str+match,length-match);
	    }
	    Tcl_SetObjLength(esPtr->buffer, length-match);
	}

	if (cc == EXP_EOF) {
	    /* exp_close() deletes all background bodies */
	    /* so save eof body temporarily */
	    if (body) Tcl_IncrRefCount(body);
	    exp_close(interp,esPtr);
	}
    }

    if (body) {
	if (!bg) {
	    result = Tcl_EvalObjEx(interp,body,0);
	} else {
	    result = Tcl_EvalObjEx(interp,body,TCL_EVAL_GLOBAL);
	    if (result != TCL_OK) Tcl_BackgroundError(interp);
	}
	if (cc == EXP_EOF) Tcl_DecrRefCount(body);
    }
    return result;
}

/* this function is called from the background when input arrives */
/*ARGSUSED*/
void
exp_background_channelhandler(clientData,mask) /* INTL */
ClientData clientData;
int mask;
{
    ExpState *esPtr;
    Tcl_Interp *interp;
    int cc;			/* number of bytes returned in a single read */
				/* or negative EXP_whatever */
    struct eval_out eo;		/* final case of interest */
    struct exp_f *last_f;	/* for differentiating when multiple f's
				 * to print out better debugging messages */
    ExpState *last_esPtr;	/* for differentiating when multiple esPtrs */
				/* to print out better debugging messages */
    int last_case;		/* as above but for case */
    

    /* restore our environment */
    f = (struct exp_f *) clientData;
    interp = f->bg_interp;
    
    esPtr = (ExpState *)clientData;
    interp = esPtr->bg_interp;

    /* temporarily prevent this handler from being invoked again */
    exp_block_background_filehandler(f);
    
    exp_block_background_channelhandler(esPtr);

    /*
     * if mask == 0, then we've been called because the patterns changed
     * not because the waiting data has changed, so don't actually do
     * if mask == 0, then we've been called because the patterns changed not
     * because the waiting data has changed, so don't actually do any I/O
     * any I/O
     */
    
    if (mask == 0) {
	cc = 0;
    } else {
	esPtr->notifiedMask = mask;
	esPtr->notified = FALSE;
	cc = expect_read(interp,NULL,mask,&f,EXP_TIME_INFINITY,0);
	cc = expRead(interp,(ExpState **)0,0,&esPtr,EXP_TIME_INFINITY,0);
    }
    
 do_more_data:

do_more_data:
    eo.e = 0;		/* no final case yet */
    eo.f = 0;		/* no final file selected yet */
    eo.esPtr = 0;		/* no final file selected yet */
    eo.match = 0;		/* nothing matched yet */
    

    /* force redisplay of buffer when debugging */
    last_f = NULL;
    
    last_esPtr = 0;

    if (cc == EXP_EOF) {
	/* do nothing */
    } else if (cc < 0) {	/* EXP_TCLERROR or any other weird value*/
    } else if (cc < 0) { /* EXP_TCLERROR or any other weird value*/
	goto finish;
	/* 
	/* if we were going to do this right, we should */
	/* differentiate between things like HP ioctl-open-traps */
	 * if we were going to do this right, we should differentiate between
	 * things like HP ioctl-open-traps that fall out here and should
	/* that fall out here and should rightfully be ignored */
	/* and real errors that should be reported.  Come to */
	/* think of it, the only errors will come from HP */
	/* ioctl handshake botches anyway. */
	 * rightfully be ignored and real errors that should be reported.  Come
	 * to think of it, the only errors will come from HP ioctl handshake
	 * botches anyway.
	 */
    } else {
	/* normal case, got data */
	/* new data if cc > 0, same old data if cc == 0 */
	

	/* below here, cc as general status */
	cc = EXP_NOMATCH;
    }
    

    cc = eval_cases(interp,&exp_cmds[EXP_CMD_BEFORE],
		    f,&eo,&last_f,&last_case,cc,&f,1,"_background");
	    esPtr,&eo,&last_esPtr,&last_case,cc,&esPtr,1,"_background");
    cc = eval_cases(interp,&exp_cmds[EXP_CMD_BG],
		    f,&eo,&last_f,&last_case,cc,&f,1,"_background");
	    esPtr,&eo,&last_esPtr,&last_case,cc,&esPtr,1,"_background");
    cc = eval_cases(interp,&exp_cmds[EXP_CMD_AFTER],
		    f,&eo,&last_f,&last_case,cc,&f,1,"_background");
	    esPtr,&eo,&last_esPtr,&last_case,cc,&esPtr,1,"_background");
    if (cc == EXP_TCLERROR) {
	/* only likely problem here is some internal regexp botch */
	Tcl_BackgroundError(interp);
	goto finish;
		/* only likely problem here is some internal regexp botch */
		Tcl_BackgroundError(interp);
		goto finish;
    }
    /* special eof code that cannot be done in eval_cases */
    /* or above, because it would then be executed several times */
    if (cc == EXP_EOF) {
	eo.f = f;
	eo.match = eo.f->size;
	eo.buffer = eo.f->buffer;
	debuglog("expect_background: read eof\r\n");
	eo.esPtr = esPtr;
	eo.match = expSizeGet(eo.esPtr);
	eo.buffer = eo.esPtr->buffer;
	expDiagLogU("expect_background: read eof\r\n");
	goto matched;
    }
    if (!eo.e) {
	/* if we get here, there must not have been a match */
	goto finish;
    }
    

 matched:
#define out(i,val)  debuglog("expect_background: set %s(%s) \"%s\"\r\n",EXPECT_OUT,i, \
			     dprintify(val)); \
     Tcl_SetVar2(interp,EXPECT_OUT,i,val,TCL_GLOBAL_ONLY);
 {
     /*		int iwrite = FALSE;*/	/* write spawn_id? */
     char *body = 0;
     char *buffer;		/* pointer to normal or lowercased data */
     struct ecase *e = 0;	/* points to current ecase */
     int match = -1;		/* characters matched */
     char match_char;		/* place to hold char temporarily */
     /* uprooted by a NULL */
     char *eof_body = 0;

    expMatchProcess(interp, &eo, cc, 1 /* bg */,"expect_background");
     if (eo.e) {
	 e = eo.e;
	 body = e->body;
	 /*			iwrite = e->iwrite;*/
	 if (cc != EXP_TIMEOUT) {
	     f = eo.f;
	     match = eo.match;
	     buffer = eo.buffer;
	 }
     } else if (cc == EXP_EOF) {
	 /* read an eof but no user-supplied case */
	 f = eo.f;
	 match = eo.match;
	 buffer = eo.buffer;
     }			

     if (match >= 0) {
	 char name[20], value[20];

	 if (e && e->use == PAT_RE) {
	     regexp *re = e->re;

	     for (i=0;i<NSUBEXP;i++) {
		 int offset;

		 if (re->startp[i] == 0) continue;

		 if (e->indices) {
		     /* start index */
		     sprintf(name,"%d,start",i);
		     offset = re->startp[i]-buffer;
		     sprintf(value,"%d",offset);
		     out(name,value);

		     /* end index */
		     sprintf(name,"%d,end",i);
		     sprintf(value,"%d",
			     re->endp[i]-buffer-1);
		     out(name,value);
		 }

		 /* string itself */
		 sprintf(name,"%d,string",i);

		 /* temporarily null-terminate in */
		 /* middle */
		 match_char = *re->endp[i];
		 *re->endp[i] = 0;
		 out(name,re->startp[i]);
		 *re->endp[i] = match_char;
	     }
	     /* redefine length of string that */
	     /* matched for later extraction */
	     match = re->endp[0]-buffer;
	 } else if (e && (e->use == PAT_GLOB || e->use == PAT_EXACT)) {
	     char *str;

	     if (e->indices) {
		 /* start index */
		 sprintf(value,"%d",e->simple_start);
		 out("0,start",value);

		 /* end index */
		 sprintf(value,"%d",e->simple_start + match - 1);
		 out("0,end",value);
	     }

	     /* string itself */
	     str = f->buffer + e->simple_start;
	     /* temporarily null-terminate in middle */
	     match_char = str[match];
	     str[match] = 0;
	     out("0,string",str);
	     str[match] = match_char;

	     /* redefine length of string that */
	     /* matched for later extraction */
	     match += e->simple_start;
	 } else if (e && e->use == PAT_NULL && e->indices) {
	     /* start index */
	     sprintf(value,"%d",match-1);
	     out("0,start",value);
	     /* end index */
	     sprintf(value,"%d",match-1);
	     out("0,end",value);
	 } else if (e && e->use == PAT_FULLBUFFER) {
	     debuglog("expect_background: full buffer\r\n");
	 }
     }

     /* this is broken out of (match > 0) (above) since it can */
     /* that an EOF occurred with match == 0 */
     if (eo.f) {
	 char spawn_id[10];	/* enough for a %d */

	 sprintf(spawn_id,"%s",f->spawnId);
	 out("spawn_id",spawn_id);

	 /* save buf[0..match] */
	 /* temporarily null-terminate string in middle */
	 match_char = f->buffer[match];
	 f->buffer[match] = 0;
	 out("buffer",f->buffer);
	 /* remove middle-null-terminator */
	 f->buffer[match] = match_char;

	 /* "!e" means no case matched - transfer by default */
	 if (!e || e->transfer) {
	     /* delete matched chars from input buffer */
	     f->size -= match;
	     f->printed -= match;
	     if (f->size != 0) {
		 memmove(f->buffer,f->buffer+match,f->size);
		 memmove(f->lower,f->lower+match,f->size);
	     }
	     f->buffer[f->size] = '\0';
	     f->lower[f->size] = '\0';
	 }

	 if (cc == EXP_EOF) {
	     /* exp_close() deletes all background bodies */
	     /* so save eof body temporarily */
	     if (body) {
		 eof_body = ckalloc(strlen(body)+1);
		 strcpy(eof_body,body);
		 body = eof_body;
	     }

	     exp_close(interp,f);
	 }

     }

     if (body) {
	 int result = Tcl_GlobalEval(interp,body);
	 if (result != TCL_OK) Tcl_BackgroundError(interp);

	 if (eof_body) ckfree(eof_body);
     }


     /*
      * Event handler will not call us back if there is more input
      * pending but it has already arrived.  bg_status will be
      * "blocked" only if armed.
      */
     if (f->valid && (f->bg_status == blocked)
	 && (f->size > 0)) {
	 cc = f->size;
	 goto do_more_data;
     }
 }
    /*
     * Event handler will not call us back if there is more input
     * pending but it has already arrived.  bg_status will be
     * "blocked" only if armed.
     */

    /*
     * Connection could have been closed on us.  In this case,
     * exitWhenBgStatusUnblocked will be 1 and we should disable the channel
     * handler and release the esPtr.
     */

    if ((!esPtr->freeWhenBgHandlerUnblocked) && (esPtr->bg_status == blocked)) {
	if (0 != (cc = expSizeGet(esPtr))) {
	    goto do_more_data;
	}
    }
 finish:
    /* fd could have gone away, so check before using */
    if (f->valid)
	exp_unblock_background_filehandler(f);
    exp_unblock_background_channelhandler(esPtr);
    if (esPtr->freeWhenBgHandlerUnblocked)
	expStateFree(esPtr);
}
#undef out

/*
 *----------------------------------------------------------------------
 *
 * Exp_ExpectCmd --
 *
 *	Implements the 'expect', 'expect_user', and 'expect_tty'
 *	commands.
 *
 * Results:
 *	A standard Tcl result
 *
 * Side Effects:
 *	Input is likely to be read
 *
 * Notes:
 *	If non-null, clientData holds the name of the channel to
 *	use.
 *
 *----------------------------------------------------------------------
 */

/*ARGSUSED*/
int
Exp_ExpectCmd(clientData, interp, argc, argv)
    ClientData clientData;
    Tcl_Interp *interp;
    int argc;
Exp_ExpectObjCmd(clientData, interp, objc, objv)
ClientData clientData;
Tcl_Interp *interp;
int objc;
    char **argv;
Tcl_Obj *CONST objv[];		/* Argument objects. */
{
    int cc;			/* number of chars returned in a single read
				 * or negative EXP_whatever */
    int cc;			/* number of chars returned in a single read */
				/* or negative EXP_whatever */
    struct exp_f *f;		/* file associated with master */
    ExpState *esPtr = 0;

    int i;			/* trusty temporary */
    int i;			/* misc temporary */
    struct exp_cmd_descriptor eg;
    struct exp_fs_list *fs_list; /* list of masters to watch */
    struct exp_fs_list *fsl;	/* temp for interating over fs_list */
    struct exp_state_list *state_list;	/* list of ExpStates to watch */
    struct exp_state_list *slPtr;	/* temp for interating over state_list */
    struct exp_f **masters;	/* array of masters to watch */
    int mcount;			/* number of masters to watch */
    ExpState **esPtrs;
    int mcount;			/* number of esPtrs to watch */

    struct eval_out eo;		/* final case of interest */

    int result;			/* Tcl result */

    
    time_t start_time_total;	/* time at beginning of this procedure */
    time_t start_time = 0;	/* time when restart label hit */
    time_t current_time = 0;	/* current time (when we last looked)*/
    time_t end_time;		/* future time at which to give up */
    time_t elapsed_time_total;	/* time from now to match/fail/timeout */
    time_t elapsed_time;	/* time from restart to (ditto) */

    struct exp_f *last_f;	/* for differentiating when multiple f's
				 * to print out better debugging messages */
    ExpState *last_esPtr;	/* for differentiating when multiple f's */
				/* to print out better debugging messages */
    int last_case;		/* as above but for case */
    int first_time = 1;		/* if not "restarted" */

    
    int key;			/* identify this expect command instance */
    int configure_count;	/* monitor exp_configure_count */

    int timeout;		/* seconds */
    int remtime;		/* remaining time in timeout */
    int reset_timer;		/* should timer be reset after continue? */
    char *argv0;		/* Command name */

    if ((argc == 2) && exp_one_arg_braced(argv[1])) {
	return(exp_eval_with_one_arg(clientData,interp,argv));
    } else if ((argc == 3) && streq(argv[1],"-brace")) {
	char *new_argv[2];
	new_argv[0] = argv[0];
	new_argv[1] = argv[2];
	return(exp_eval_with_one_arg(clientData,interp,new_argv));
    if ((objc == 2) && exp_one_arg_braced(objv[1])) {
	return(exp_eval_with_one_arg(clientData,interp,objv));
    } else if ((objc == 3) && streq(Tcl_GetString(objv[1]),"-brace")) {
	Tcl_Obj *new_objv[2];
	new_objv[0] = objv[0];
	new_objv[1] = objv[2];
	return(exp_eval_with_one_arg(clientData,interp,new_objv));
    }

    argv0 = argv[0];
    time(&start_time_total);
    start_time = start_time_total;
    reset_timer = TRUE;

    
    if (&StdinoutPlaceholder == (ExpState *)clientData) {
	clientData = (ClientData) expStdinoutGet();
    } else if (&DevttyPlaceholder == (ExpState *)clientData) {
	clientData = (ClientData) expDevttyGet();
    }
	
    /* make arg list for processing cases */
    /* do it dynamically, since expect can be called recursively */

    exp_cmd_init(&eg,EXP_CMD_FG,EXP_TEMPORARY);
    fs_list = NULL;
    masters = NULL;
    state_list = 0;
    esPtrs = 0;
    if (clientData) {
	f = exp_chan2f(interp,(char *) clientData,1,0,argv0);
	if (f == NULL) {
	    return TCL_ERROR;
	}
    } else {
	f = NULL;
    }
    if (TCL_ERROR == parse_expect_args(interp,&eg,f,argc,argv,argv0))
    if (TCL_ERROR == parse_expect_args(interp,&eg,
	    (ExpState *)clientData,objc,objv))
	return TCL_ERROR;

 restart_with_update:
    /* validate all descriptors */
    /* validate all descriptors and flatten ExpStates into array */
    /* and flatten fds into array */

    if ((TCL_ERROR == update_expect_fds(exp_cmds[EXP_CMD_BEFORE].i_list,&fs_list))
	|| (TCL_ERROR == update_expect_fds(exp_cmds[EXP_CMD_AFTER].i_list, &fs_list))
	|| (TCL_ERROR == update_expect_fds(eg.i_list,&fs_list))) {
    if ((TCL_ERROR == update_expect_states(exp_cmds[EXP_CMD_BEFORE].i_list,&state_list))
	    || (TCL_ERROR == update_expect_states(exp_cmds[EXP_CMD_AFTER].i_list, &state_list))
	    || (TCL_ERROR == update_expect_states(eg.i_list,&state_list))) {
	result = TCL_ERROR;
	goto cleanup;
    }

    /* declare ourselves "in sync" with external view of close/indirect */
    configure_count = exp_configure_count;

    /* count and validate fs_list */
    /* count and validate state_list */
    mcount = 0;
    for (fsl=fs_list;fsl;fsl=fsl->next) {
    for (slPtr=state_list;slPtr;slPtr=slPtr->next) {
	mcount++;
	/* validate all input descriptors */
	if (!exp_fcheck(interp,fsl->f,1,1,argv0)) {
	if (!expStateCheck(interp,slPtr->esPtr,1,1,"expect")) {
	    result = TCL_ERROR;
	    goto cleanup;
	}
    }

    /* make into an array */
    masters = (struct exp_f **)ckalloc(mcount * sizeof(struct exp_f *));
    for (fsl=fs_list,i=0;fsl;fsl=fsl->next,i++) {
	masters[i] = fsl->f;
    esPtrs = (ExpState **)ckalloc(mcount * sizeof(ExpState *));
    for (slPtr=state_list,i=0;slPtr;slPtr=slPtr->next,i++) {
	esPtrs[i] = slPtr->esPtr;
    }

 restart:
  restart:
    if (first_time) first_time = 0;
    else time(&start_time);

    if (eg.timeout_specified_by_flag) {
	timeout = eg.timeout;
    } else {
	/* get the latest timeout */
	timeout = get_timeout(interp);
    }

    key = expect_key++;

    result = TCL_OK;
    last_f = 0;
    last_esPtr = 0;

    /*
    /* end of restart code */
     * end of restart code
     */

    eo.e = 0;			/* no final case yet */
    eo.f = 0;			/* no final file selected yet */
    eo.match = 0;		/* nothing matched yet */
    eo.e = 0;		/* no final case yet */
    eo.esPtr = 0;	/* no final ExpState selected yet */
    eo.match = 0;	/* nothing matched yet */

    /* timeout code is a little tricky, be very careful changing it */
    if (timeout != EXP_TIME_INFINITY) {
	/* if exp_continue -continue_timer, do not update end_time */
	if (reset_timer) {
	    time(&current_time);
	    end_time = current_time + timeout;
	} else {
	    reset_timer = TRUE;
	}
    }

    /* remtime and current_time updated at bottom of loop */
    remtime = timeout;

    for (;;) {
	if ((timeout != EXP_TIME_INFINITY) && (remtime < 0)) {
	    cc = EXP_TIMEOUT;
	} else {
	    cc = expect_read(interp,masters,mcount,&f,remtime,key);
	    cc = expRead(interp,esPtrs,mcount,&esPtr,remtime,key);
	}

	/*SUPPRESS 530*/
	if (cc == EXP_EOF) {
	    /* do nothing */
	} else if (cc == EXP_TIMEOUT) {
	    debuglog("expect: timed out\r\n");
	    expDiagLogU("expect: timed out\r\n");
	} else if (cc == EXP_RECONFIGURE) {
	    reset_timer = FALSE;
	    goto restart_with_update;
	} else if (cc < 0) {	/* EXP_TCLERROR or any other weird value*/
	} else if (cc < 0) { /* EXP_TCLERROR or any other weird value*/
	    goto error;
	} else {
	    /* new data if cc > 0, same old data if cc == 0 */
	    
	    /* below here, cc as general status */
	    cc = EXP_NOMATCH;

	    /* force redisplay of buffer when debugging */
	    last_f = 0;
	    last_esPtr = 0;
	}

	cc = eval_cases(interp,&exp_cmds[EXP_CMD_BEFORE],
			f,&eo,&last_f,&last_case,cc,masters,mcount,"");
		esPtr,&eo,&last_esPtr,&last_case,cc,esPtrs,mcount,"");
	cc = eval_cases(interp,&eg,
			f,&eo,&last_f,&last_case,cc,masters,mcount,"");
		esPtr,&eo,&last_esPtr,&last_case,cc,esPtrs,mcount,"");
	cc = eval_cases(interp,&exp_cmds[EXP_CMD_AFTER],
			f,&eo,&last_f,&last_case,cc,masters,mcount,"");
		esPtr,&eo,&last_esPtr,&last_case,cc,esPtrs,mcount,"");
	if (cc == EXP_TCLERROR) goto error;
	/* special eof code that cannot be done in eval_cases */
	/* or above, because it would then be executed several times */
	if (cc == EXP_EOF) {
	    eo.f = f;
	    eo.match = eo.f->size;
	    eo.buffer = eo.f->buffer;
	    debuglog("expect: read eof\r\n");
	    eo.esPtr = esPtr;
	    eo.match = expSizeGet(eo.esPtr);
	    eo.buffer = eo.esPtr->buffer;
	    expDiagLogU("expect: read eof\r\n");
	    break;
	} else if (cc == EXP_TIMEOUT) break;
	/* break if timeout or eof and failed to find a case for it */

	if (eo.e) break;

	/* no match was made with current data, force a read */
	f->force_read = TRUE;
	esPtr->force_read = TRUE;

	if (timeout != EXP_TIME_INFINITY) {
	    time(&current_time);
	    remtime = end_time - current_time;
	}
    }

    goto done;

 error:
error:
    result = exp_2tcl_returnvalue(cc);
 done:
#define out(i,val)  debuglog("expect: set %s(%s) \"%s\"\r\n",EXPECT_OUT,i, \
			     dprintify(val)); \
				 Tcl_SetVar2(interp,EXPECT_OUT,i,val,0);

    if (result != TCL_ERROR) {
	/*		int iwrite = FALSE;*/	/* write spawn_id? */
	char *body = 0;
	char *buffer;		/* pointer to normal or lowercased data */
	struct ecase *e = 0;	/* points to current ecase */
	int match = -1;		/* characters matched */
	char match_char;	/* place to hold char temporarily */
	/* uprooted by a NULL */
	char *eof_body = 0;

	result = expMatchProcess(interp, &eo, cc, 0 /* not bg */,"expect");
	if (eo.e) {
	    e = eo.e;
	    body = e->body;
	    /*			iwrite = e->iwrite;*/
	    if (cc != EXP_TIMEOUT) {
		f = eo.f;
		match = eo.match;
		buffer = eo.buffer;
	    }
	    if (e->timestamp) {
		char value[20];

		time(&current_time);
		elapsed_time = current_time - start_time;
		elapsed_time_total = current_time - start_time_total;
		sprintf(value,"%d",elapsed_time);
		out("seconds",value);
		sprintf(value,"%d",elapsed_time_total);
		out("seconds_total",value);

		/* deprecated */
		exp_timestamp(interp,&current_time,EXPECT_OUT);
	    }
	} else if (cc == EXP_EOF) {
	    /* read an eof but no user-supplied case */
	    f = eo.f;
	    match = eo.match;
	    buffer = eo.buffer;
	}			

	if (match >= 0) {
	    char name[20], value[20];

	    if (e && e->use == PAT_RE) {
		regexp *re = e->re;

		for (i=0;i<NSUBEXP;i++) {
		    int offset;

		    if (re->startp[i] == 0) continue;

		    if (e->indices) {
			/* start index */
			sprintf(name,"%d,start",i);
			offset = re->startp[i]-buffer;
			sprintf(value,"%d",offset);
			out(name,value);

			/* end index */
			sprintf(name,"%d,end",i);
			sprintf(value,"%d",
				re->endp[i]-buffer-1);
			out(name,value);
		    }

		    /* string itself */
		    sprintf(name,"%d,string",i);

		    /* temporarily null-terminate in */
		    /* middle */
		    match_char = *re->endp[i];
		    *re->endp[i] = 0;
		    out(name,re->startp[i]);
		    *re->endp[i] = match_char;
		}
		/* redefine length of string that */
		/* matched for later extraction */
		match = re->endp[0]-buffer;
	    } else if (e && (e->use == PAT_GLOB || e->use == PAT_EXACT)) {
		char *str;

		if (e->indices) {
		    /* start index */
		    sprintf(value,"%d",e->simple_start);
		    out("0,start",value);

		    /* end index */
		    sprintf(value,"%d",e->simple_start + match - 1);
		    out("0,end",value);
		}

		/* string itself */
		str = f->buffer + e->simple_start;
		/* temporarily null-terminate in middle */
		match_char = str[match];
		str[match] = 0;
		out("0,string",str);
		str[match] = match_char;

		/* redefine length of string that */
		/* matched for later extraction */
		match += e->simple_start;
	    } else if (e && e->use == PAT_NULL && e->indices) {
		/* start index */
		sprintf(value,"%d",match-1);
		out("0,start",value);
		/* end index */
		sprintf(value,"%d",match-1);
		out("0,end",value);
	    } else if (e && e->use == PAT_FULLBUFFER) {
		debuglog("expect: full buffer\r\n");
	    }
	}

	/* this is broken out of (match > 0) (above) since it can */
	/* that an EOF occurred with match == 0 */
	if (eo.f) {
	    char spawn_id[10];	/* enough for a %d */

	    /*			if (iwrite) {*/
	    sprintf(spawn_id,"%s",f->spawnId);
	    out("spawn_id",spawn_id);
	    /*			}*/

	    /* save buf[0..match] */
	    /* temporarily null-terminate string in middle */
	    match_char = f->buffer[match];
	    f->buffer[match] = 0;
	    out("buffer",f->buffer);
	    /* remove middle-null-terminator */
	    f->buffer[match] = match_char;

	    /* "!e" means no case matched - transfer by default */
	    if (!e || e->transfer) {
		/* delete matched chars from input buffer */
		f->size -= match;
		f->printed -= match;
		if (f->size != 0) {
		    memmove(f->buffer,f->buffer+match,f->size);
		    memmove(f->lower,f->lower+match,f->size);
		}
		f->buffer[f->size] = '\0';
		f->lower[f->size] = '\0';
	    }

	    if (cc == EXP_EOF) {
		/* exp_close() deletes all background bodies */
		/* so save eof body temporarily */
		if (body) {
		    eof_body = ckalloc(strlen(body)+1);
		    strcpy(eof_body,body);
		    body = eof_body;
		}

		exp_close(interp,f);
	    }

	}

	if (body) {
	    result = Tcl_Eval(interp,body);

	    if (eof_body) ckfree(eof_body);
	}
    }

 cleanup:
    if (result == EXP_CONTINUE_TIMER) {
	reset_timer = FALSE;
	result = EXP_CONTINUE;
    }

    if ((result == EXP_CONTINUE)
    if ((result == EXP_CONTINUE) && (configure_count == exp_configure_count)) {
	&& (configure_count == exp_configure_count)) {
	debuglog("expect: continuing expect\r\n");
	expDiagLogU("expect: continuing expect\r\n");
	goto restart;
    }

    if (fs_list) {
	exp_free_fs(fs_list);
	fs_list = 0;
    if (state_list) {
	exp_free_state(state_list);
	state_list = 0;
    }
    if (masters) {
	ckfree((char *)masters);
	masters = 0;
    if (esPtrs) {
	ckfree((char *)esPtrs);
	esPtrs = 0;
    }

    if (result == EXP_CONTINUE) {
	debuglog("expect: continuing expect after update\r\n");
	expDiagLogU("expect: continuing expect after update\r\n");
	goto restart_with_update;
    }

    free_ecases(interp,&eg,0);	/* requires i_lists to be avail */
    exp_free_i(interp,eg.i_list,exp_indirect_update2);

    return(result);
}
#undef out

/* beginning of deprecated code */

#define out(elt)		Tcl_SetVar2(interp,array,elt,ascii,0);
void
exp_timestamp(interp,timeval,array)
Tcl_Interp *interp;
time_t *timeval;
char *array;
{
	struct tm *tm;
	char *ascii;

	tm = localtime(timeval);	/* split */
	ascii = asctime(tm);		/* print */
	ascii[24] = '\0';		/* zap trailing \n */

	out("timestamp");

	sprintf(ascii,"%ld",*timeval);
	out("epoch");

	sprintf(ascii,"%d",tm->tm_sec);
	out("sec");
	sprintf(ascii,"%d",tm->tm_min);
	out("min");
	sprintf(ascii,"%d",tm->tm_hour);
	out("hour");
	sprintf(ascii,"%d",tm->tm_mday);
	out("mday");
	sprintf(ascii,"%d",tm->tm_mon);
	out("mon");
	sprintf(ascii,"%d",tm->tm_year);
	out("year");
	sprintf(ascii,"%d",tm->tm_wday);
	out("wday");
	sprintf(ascii,"%d",tm->tm_yday);
	out("yday");
	sprintf(ascii,"%d",tm->tm_isdst);
	out("isdst");
}
/* end of deprecated code */

/*ARGSUSED*/
static int
Exp_TimestampCmd(clientData, interp, argc, argv)
ClientData clientData;
Tcl_Interp *interp;
int argc;




︙


2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
2755
2756
2757




2758
2759

2760

2761
2762
2763

2764
2765

2766
2767
2768
2769
2770
2771
2772
2773
2774
2775

2776
2777
2778
2779


2780
2781
2782
2783
2784







2785
2786
2787
2788
2789
2790
2791








2792
2793
2794
2795
2796

2797
2798
2799
2800
2801

2802
2803
2804
2805
2806

2807



2808
2809
2810
2811
2812
2813

2814
2815
2816


2817
2818
2819
2820
2821
2822
2823
2824
2825
2826




2827
2828

2829

2830
2831
2832
2833
2834
2835
2836
2837
2838
2839
2840
2841
2842
2843
2844

2845
2846
2847





2848
2849
2850


2851
2852
2853

2854
2855
2856
2857
2858
2859
2860
2861
2862
2863

2864
2865

2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884

2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895




2896
2897
2898
2899


2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914

2915
2916
2917
2918

2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
2929












2930
2931
2932
2933
2934
2935

2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
2948
2949
2950

2951
2952
2953
2954
2955
2956
2957
2958
2959
2960


2961
2962
2963
2964



2965
2966
2967
2968
2969

2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981











2982
2983
2984
2985
2986

2987
2988
2989


2990
2991
2992
2993
2994

2995
2996

2997
2998
2999


3000
3001
3002
3003
3004

3005
3006
3007
3008
3009
3010





3011
3012
3013
3014
3015
3016
3017
3018



3019
3020
3021
3022
3023
3024
3025
3026
3027




3028
3029
3030


3031
3032
3033








3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045










3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066

3067
3068

3069


3070

3071
3072
3073
3074
3075
3076




3077
3078
3079
3080
3081




3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092















3093
3094




3095

2679
2680
2681
2682
2683
2684
2685













2686
2687
2688




2689
2690
2691
2692
2693
2694
2695

2696
2697


2698
2699

2700
2701
2702
2703
2704
2705
2706
2707
2708
2709

2710
2711
2712


2713
2714





2715
2716
2717
2718
2719
2720
2721
2722






2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734

2735
2736
2737
2738
2739

2740
2741
2742
2743
2744
2745
2746

2747
2748
2749
2750
2751
2752
2753
2754

2755
2756


2757
2758
2759
2760
2761
2762
2763
2764




2765
2766
2767
2768
2769
2770
2771

2772
2773

2774
2775
2776
2777
2778
2779
2780
2781
2782
2783
2784
2785

2786
2787
2788
2789
2790
2791
2792
2793
2794
2795


2796
2797
2798
2799

2800
2801
2802



2803
2804
2805
2806

2807
2808

2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827

2828
2829
2830
2831
2832
2833
2834
2835




2836
2837
2838
2839
2840
2841


2842
2843
2844

2845
2846
2847
2848
2849
2850
2851
2852
2853
2854
2855
2856

2857
2858
2859
2860

2861








2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881

2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896

2897
2898
2899
2900
2901
2902
2903
2904
2905


2906
2907
2908



2909
2910
2911
2912
2913
2914
2915

2916
2917











2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
2930
2931
2932

2933
2934


2935
2936
2937
2938
2939
2940

2941
2942

2943
2944


2945
2946
2947
2948
2949
2950

2951
2952





2953
2954
2955
2956
2957
2958
2959
2960
2961
2962



2963
2964
2965
2966
2967
2968
2969
2970




2971
2972
2973
2974
2975


2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990










2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
















3003
3004

3005
3006

3007
3008
3009
3010

3011

3012




3013
3014
3015
3016
3017




3018
3019
3020
3021
3022










3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044








-
-
-
-
-
-
-
-
-
-
-
-
-



-
-
-
-
+
+
+
+


+
-
+

-
-
+

-
+









-
+


-
-
+
+
-
-
-
-
-
+
+
+
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+
+
+




-
+




-
+





+
-
+
+
+





-
+

-
-
+
+






-
-
-
-
+
+
+
+


+
-
+

-












-
+



+
+
+
+
+

-
-
+
+


-
+


-
-
-




-
+

-
+


















-
+







-
-
-
-
+
+
+
+


-
-
+
+

-












-
+



-
+
-
-
-
-
-
-
-
-



+
+
+
+
+
+
+
+
+
+
+
+





-
+














-
+








-
-
+
+

-
-
-
+
+
+




-
+

-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+




-
+

-
-
+
+




-
+

-
+

-
-
+
+




-
+

-
-
-
-
-
+
+
+
+
+





-
-
-
+
+
+





-
-
-
-
+
+
+
+

-
-
+
+



+
+
+
+
+
+
+
+


-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+


-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-


-
+

-
+

+
+
-
+
-

-
-
-
-
+
+
+
+

-
-
-
-
+
+
+
+

-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


+
+
+
+


	return TCL_OK;
 usage_error:
	exp_error(interp,"args: [-seconds #] [-format format]");
	return TCL_ERROR;

}

/* lowmemcpy - like memcpy but it lowercases result */
void
exp_lowmemcpy(dest,src,n)
    char *dest;
    char *src;
    int n;
{
    for (;n>0;n--) {
	*dest = ((isascii(*src) && isupper(*src))?tolower(*src):*src);
	src++;	dest++;
    }
}

/*ARGSUSED*/
int
Exp_MatchMaxCmd(clientData,interp,argc,argv)
    ClientData clientData;
    Tcl_Interp *interp;
    int argc;
    char **argv;
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
    int size = -1;
    ExpState *esPtr = 0;
    struct exp_f *f;
    char *chanName = 0;
    int Default = FALSE;
    char *chan = NULL;
    

    argc--; argv++;
    

    for (;argc>0;argc--,argv++) {
	if (streq(*argv,"-d")) {
	    Default = TRUE;
	} else if (streq(*argv,"-i")) {
	    argc--;argv++;
	    if (argc < 1) {
		exp_error(interp,"-i needs argument");
		return(TCL_ERROR);
	    }
	    chan = *argv;
	    chanName = *argv;
	} else break;
    }
    
    if (!Default) {

    if (Default && chanName) {
	if (chan == NULL) {
	    if (!(f = exp_update_master(interp,0,0)))
		return(TCL_ERROR);
	} else {
	    if (!(f = exp_chan2f(interp,chan,0,0,"match_max")))
	exp_error(interp,"cannot do -d and -i at the same time");
	return(TCL_ERROR);
    }

    if (!Default) {
	if (!chanName) {
	    if (!(esPtr = expStateCurrent(interp,0,0,0))) {
		return(TCL_ERROR);
	}
    } else if (chan != NULL) {
	exp_error(interp,"cannot do -d and -i at the same time");
	return(TCL_ERROR);
    }
    
	    }
	} else {
	    
	    if (!(esPtr = expStateFromChannelName(interp,chanName,0,0,0,"match_max")))
		return(TCL_ERROR);
	}
    }

    if (argc == 0) {
	if (Default) {
	    size = exp_default_match_max;
	} else {
	    size = f->umsize;
	    size = esPtr->umsize;
	}
	sprintf(interp->result,"%d",size);
	return(TCL_OK);
    }
    

    if (argc > 1) {
	exp_error(interp,"too many arguments");
	return(TCL_OK);
    }
    
    /*
    /* all that's left is to set the size */
     * All that's left is to set the size
     */

    size = atoi(argv[0]);
    if (size <= 0) {
	exp_error(interp,"must be positive");
	return(TCL_ERROR);
    }
    

    if (Default) exp_default_match_max = size;
    else f->umsize = size;
    
    else esPtr->umsize = size;

    return(TCL_OK);
}

/*ARGSUSED*/
int
Exp_RemoveNullsCmd(clientData,interp,argc,argv)
    ClientData clientData;
    Tcl_Interp *interp;
    int argc;
    char **argv;
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
    int value = -1;
    ExpState *esPtr = 0;
    struct exp_f *f;
    char *chanName = 0;
    int Default = FALSE;
    char *chan = NULL;

    argc--; argv++;

    for (;argc>0;argc--,argv++) {
	if (streq(*argv,"-d")) {
	    Default = TRUE;
	} else if (streq(*argv,"-i")) {
	    argc--;argv++;
	    if (argc < 1) {
		exp_error(interp,"-i needs argument");
		return(TCL_ERROR);
	    }
	    chan = *argv;
	    chanName = *argv;
	} else break;
    }

    if (Default && chanName) {
	exp_error(interp,"cannot do -d and -i at the same time");
	return(TCL_ERROR);
    }

    if (!Default) {
	if (chan == NULL) {
	    if (!(f = exp_update_master(interp,0,0)))
	if (!chanName) {
	    if (!(esPtr = expStateCurrent(interp,0,0,0)))
		return(TCL_ERROR);
	} else {
	    if (!(f = exp_chan2f(interp,chan,0,0,"remove_nulls")))
	    if (!(esPtr = expStateFromChannelName(interp,chanName,0,0,0,"remove_nulls")))
		return(TCL_ERROR);
	}
    } else if (chan != NULL) {
	exp_error(interp,"cannot do -d and -i at the same time");
	return(TCL_ERROR);
    }

    if (argc == 0) {
	if (Default) {
	    value = exp_default_match_max;
	  value = exp_default_rm_nulls;
	} else {
	    value = f->rm_nulls;
	  value = esPtr->rm_nulls;
	}
	sprintf(interp->result,"%d",value);
	return(TCL_OK);
    }

    if (argc > 1) {
	exp_error(interp,"too many arguments");
	return(TCL_OK);
    }

    /* all that's left is to set the value */
    value = atoi(argv[0]);
    if (value != 0 && value != 1) {
	exp_error(interp,"must be 0 or 1");
	return(TCL_ERROR);
    }

    if (Default) exp_default_rm_nulls = value;
    else f->rm_nulls = value;
    else esPtr->rm_nulls = value;

    return(TCL_OK);
}

/*ARGSUSED*/
int
Exp_ParityCmd(clientData,interp,argc,argv)
    ClientData clientData;
    Tcl_Interp *interp;
    int argc;
    char **argv;
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
    int parity;
    int m = -1;
    struct exp_f *f;
    ExpState *esPtr = 0;
    char *chanName = 0;
    int Default = FALSE;
    char *chan = NULL;

    argc--; argv++;

    for (;argc>0;argc--,argv++) {
	if (streq(*argv,"-d")) {
	    Default = TRUE;
	} else if (streq(*argv,"-i")) {
	    argc--;argv++;
	    if (argc < 1) {
		exp_error(interp,"-i needs argument");
		return(TCL_ERROR);
	    }
	    chan = *argv;
	    chanName = *argv;
	} else break;
    }

    if (!Default) {
    if (Default && chanName) {
	if (chan == NULL) {
	    if (!(f = exp_update_master(interp,0,0)))
		return(TCL_ERROR);
	} else {
	    if (!(f = exp_chan2f(interp,chan,0,0,"parity")))
		return(TCL_ERROR);
	}
    } else if (chan != NULL) {
	exp_error(interp,"cannot do -d and -i at the same time");
	return(TCL_ERROR);
    }

    if (!Default) {
	if (!chanName) {
	    if (!(esPtr = expStateCurrent(interp,0,0,0))) {
		return(TCL_ERROR);
	    }
	} else {
	    if (!(esPtr = expStateFromChannelName(interp,chanName,0,0,0,"parity"))) {
		return(TCL_ERROR);
	    }
	}
    }

    if (argc == 0) {
	if (Default) {
	    parity = exp_default_parity;
	} else {
	    parity = f->parity;
	    parity = esPtr->parity;
	}
	sprintf(interp->result,"%d",parity);
	return(TCL_OK);
    }

    if (argc > 1) {
	exp_error(interp,"too many arguments");
	return(TCL_OK);
    }

    /* all that's left is to set the parity */
    parity = atoi(argv[0]);

    if (Default) exp_default_parity = parity;
    else f->parity = parity;
    else esPtr->parity = parity;

    return(TCL_OK);
}

#if DEBUG_PERM_ECASES
/* This big chunk of code is just for debugging the permanent */
/* expect cases */
void
exp_fd_print(fsl)
    struct exp_fs_list *fsl;
exp_fd_print(slPtr)
struct exp_state_list *slPtr;
{
    if (!fsl) return;
    printf("%s ",fsl->spawnId);
    exp_fd_print(fsl->next);
	if (!slPtr) return;
	printf("%d ",slPtr->esPtr);
	exp_fd_print(slPtr->next);
}

void
exp_i_print(exp_i)
    struct exp_i *exp_i;
struct exp_i *exp_i;
{
    if (!exp_i) return;
    printf("exp_i %x",exp_i);
    printf((exp_i->direct == EXP_DIRECT)?" direct":" indirect");
    printf((exp_i->duration == EXP_PERMANENT)?" perm":" tmp");
    printf("  ecount = %d\n",exp_i->ecount);
    printf("variable %s, value %s\n",
	   ((exp_i->variable)?exp_i->variable:"--"),
	   ((exp_i->value)?exp_i->value:"--"));
    printf("fds: ");
    exp_fd_print(exp_i->fs_list); printf("\n");
    exp_i_print(exp_i->next);
	if (!exp_i) return;
	printf("exp_i %x",exp_i);
	printf((exp_i->direct == EXP_DIRECT)?" direct":" indirect");
	printf((exp_i->duration == EXP_PERMANENT)?" perm":" tmp");
	printf("  ecount = %d\n",exp_i->ecount);
	printf("variable %s, value %s\n",
		((exp_i->variable)?exp_i->variable:"--"),
		((exp_i->value)?exp_i->value:"--"));
	printf("ExpStates: ");
	exp_fd_print(exp_i->state_list); printf("\n");
	exp_i_print(exp_i->next);
}

void
exp_ecase_print(ecase)
    struct ecase *ecase;
struct ecase *ecase;
{
    printf("pat <%s>\n",ecase->pat);
    printf("exp_i = %x\n",ecase->i_list);
	printf("pat <%s>\n",ecase->pat);
	printf("exp_i = %x\n",ecase->i_list);
}

void
exp_ecases_print(ecd)
    struct exp_cases_descriptor *ecd;
struct exp_cases_descriptor *ecd;
{
    int i;
	int i;

    printf("%d cases\n",ecd->count);
    for (i=0;i<ecd->count;i++) exp_ecase_print(ecd->cases[i]);
	printf("%d cases\n",ecd->count);
	for (i=0;i<ecd->count;i++) exp_ecase_print(ecd->cases[i]);
}

void
exp_cmd_print(ecmd)
    struct exp_cmd_descriptor *ecmd;
struct exp_cmd_descriptor *ecmd;
{
    printf("expect cmd type: %17s",exp_cmdtype_printable(ecmd->cmdtype));
    printf((ecmd->duration==EXP_PERMANENT)?" perm ": "tmp ");
    /* printdict */
    exp_ecases_print(&ecmd->ecd);
    exp_i_print(ecmd->i_list);
	printf("expect cmd type: %17s",exp_cmdtype_printable(ecmd->cmdtype));
	printf((ecmd->duration==EXP_PERMANENT)?" perm ": "tmp ");
	/* printdict */
	exp_ecases_print(&ecmd->ecd);
	exp_i_print(ecmd->i_list);
}

void
exp_cmds_print()
{
    exp_cmd_print(&exp_cmds[EXP_CMD_BEFORE]);
    exp_cmd_print(&exp_cmds[EXP_CMD_AFTER]);
    exp_cmd_print(&exp_cmds[EXP_CMD_BG]);
	exp_cmd_print(&exp_cmds[EXP_CMD_BEFORE]);
	exp_cmd_print(&exp_cmds[EXP_CMD_AFTER]);
	exp_cmd_print(&exp_cmds[EXP_CMD_BG]);
}

/*ARGSUSED*/
int
cmdX(clientData, interp, argc, argv)
    ClientData clientData;
    Tcl_Interp *interp;
    int argc;
    char **argv;
ClientData clientData;
Tcl_Interp *interp;
int argc;
char **argv;
{
    exp_cmds_print();
    return TCL_OK;
	exp_cmds_print();
	return TCL_OK;
}
#endif /*DEBUG_PERM_ECASES*/

void
expExpectVarsInit()
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    tsdPtr->timeout = INIT_EXPECT_TIMEOUT;
}

static struct exp_cmd_data
cmd_data[]  = {
{"expect",	Exp_ExpectCmd,	(ClientData) NULL,	0},
{"expect_after",Exp_ExpectGlobalCmd,(ClientData)&exp_cmds[EXP_CMD_AFTER],0},
{"expect_before",Exp_ExpectGlobalCmd,(ClientData)&exp_cmds[EXP_CMD_BEFORE],0},
{"expect_user",	Exp_ExpectCmd,	(ClientData)"exp_user",	0},
{"expect_tty",	Exp_ExpectCmd,	(ClientData)"exp_tty",	0},
{"expect_background",Exp_ExpectGlobalCmd,(ClientData)&exp_cmds[EXP_CMD_BG],0},
{"match_max",	Exp_MatchMaxCmd,	0,	0},
{"remove_nulls",Exp_RemoveNullsCmd,	0,	0},
{"parity",	Exp_ParityCmd,		0,	0},
{"timestamp",	Exp_TimestampCmd,	0,	0},
{"expect",	Exp_ExpectObjCmd,	0,	(ClientData)0,	0},
{"expect_after",Exp_ExpectGlobalObjCmd, 0,	(ClientData)&exp_cmds[EXP_CMD_AFTER],0},
{"expect_before",Exp_ExpectGlobalObjCmd,0,	(ClientData)&exp_cmds[EXP_CMD_BEFORE],0},
{"expect_user",	Exp_ExpectObjCmd,	0,	(ClientData)&StdinoutPlaceholder,0},
{"expect_tty",	Exp_ExpectObjCmd,	0,	(ClientData)&DevttyPlaceholder,0},
{"expect_background",Exp_ExpectGlobalObjCmd,0,	(ClientData)&exp_cmds[EXP_CMD_BG],0},
{"match_max",	exp_proc(Exp_MatchMaxCmd),	0,	0},
{"remove_nulls",exp_proc(Exp_RemoveNullsCmd),	0,	0},
{"parity",	exp_proc(Exp_ParityCmd),	0,	0},
{"timestamp",	exp_proc(Exp_TimestampCmd),	0,	0},
{0}};

/*
 *----------------------------------------------------------------------
 *
 * exp_init_expect_cmds --
 *
 *	Initialize all the 'expect' type commands.
 *
 * Results:
 *	None
 *
 * Side Effects:
 *	Commands are added to and variables are set in the interpreter.
 *
 *----------------------------------------------------------------------
 */

void
exp_init_expect_cmds(interp)
    Tcl_Interp *interp;
Tcl_Interp *interp;
{
    exp_create_commands(interp,cmd_data);
	exp_create_commands(interp,cmd_data);



    Tcl_SetVar(interp,EXPECT_TIMEOUT,INIT_EXPECT_TIMEOUT_LIT,0);
	Tcl_SetVar(interp,EXPECT_TIMEOUT,INIT_EXPECT_TIMEOUT_LIT,0);
    Tcl_SetVar(interp,EXP_SPAWN_ID_ANY_VARNAME,EXP_SPAWN_ID_ANY,0);

    exp_cmd_init(&exp_cmds[EXP_CMD_BEFORE],EXP_CMD_BEFORE,EXP_PERMANENT);
    exp_cmd_init(&exp_cmds[EXP_CMD_AFTER ],EXP_CMD_AFTER, EXP_PERMANENT);
    exp_cmd_init(&exp_cmds[EXP_CMD_BG    ],EXP_CMD_BG,    EXP_PERMANENT);
    exp_cmd_init(&exp_cmds[EXP_CMD_FG    ],EXP_CMD_FG,    EXP_TEMPORARY);
	exp_cmd_init(&exp_cmds[EXP_CMD_BEFORE],EXP_CMD_BEFORE,EXP_PERMANENT);
	exp_cmd_init(&exp_cmds[EXP_CMD_AFTER ],EXP_CMD_AFTER, EXP_PERMANENT);
	exp_cmd_init(&exp_cmds[EXP_CMD_BG    ],EXP_CMD_BG,    EXP_PERMANENT);
	exp_cmd_init(&exp_cmds[EXP_CMD_FG    ],EXP_CMD_FG,    EXP_TEMPORARY);

    /* preallocate to one element, so future realloc's work */
    exp_cmds[EXP_CMD_BEFORE].ecd.cases = 0;
    exp_cmds[EXP_CMD_AFTER ].ecd.cases = 0;
    exp_cmds[EXP_CMD_BG    ].ecd.cases = 0;
	/* preallocate to one element, so future realloc's work */
	exp_cmds[EXP_CMD_BEFORE].ecd.cases = 0;
	exp_cmds[EXP_CMD_AFTER ].ecd.cases = 0;
	exp_cmds[EXP_CMD_BG    ].ecd.cases = 0;

    pattern_style[PAT_EOF] = "eof";
    pattern_style[PAT_TIMEOUT] = "timeout";
    pattern_style[PAT_DEFAULT] = "default";
    pattern_style[PAT_FULLBUFFER] = "full buffer";
    pattern_style[PAT_GLOB] = "glob pattern";
    pattern_style[PAT_RE] = "regular expression";
    pattern_style[PAT_EXACT] = "exact string";
    pattern_style[PAT_NULL] = "null";
}

	pattern_style[PAT_EOF] = "eof";
	pattern_style[PAT_TIMEOUT] = "timeout";
	pattern_style[PAT_DEFAULT] = "default";
	pattern_style[PAT_FULLBUFFER] = "full buffer";
	pattern_style[PAT_GLOB] = "glob pattern";
	pattern_style[PAT_RE] = "regular expression";
	pattern_style[PAT_EXACT] = "exact string";
	pattern_style[PAT_NULL] = "null";

#if 0
	Tcl_CreateCommand(interp,"x",
		cmdX,(ClientData)0,exp_deleteProc);
#endif
}

void
exp_init_sig() {
#if 0
	signal(SIGALRM,sigalarm_handler);
	signal(SIGINT,sigint_handler);
#endif
}






Changes to generic/expect.h.





1
2
3
4
5
6
7
8
9
10
11
12
13





















14

15





16














17




18


















































19






20
21
22



































23
24







25
26
27












28









29
30
31
32































































33

34



35
36
37



38










39






40
41
42
43



















































44



45
46
47





















48
49
50
51
52


53
54

55
56
57
58
59
60

































61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92








93
94
95
96
97
98





99
100
101
102
103




104
105
106
107



108
109

110
111

112
113

114
115
116
117


118
119
120
121
122
123
124
125
126









127
128

129
130
131
132
133
134
135
136


137
138

139
140
141
142

143
144

145
146

147
148
149

150
151
152
153
154
155


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34

35
36
37
38
39
40
41

42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60

61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117



118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161



162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183




184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252



253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273




274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328



329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352


353
354
355
356
357






358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408














409
410
411
412
413
414
415
416
417





418
419
420
421
422
423




424
425
426
427
428



429
430
431


432


433

434
435
436
437
438

439
440
441








442
443
444
445
446
447
448
449
450


451



452
453
454


455
456


457
458

459

460


461


462

463

464

465




466














+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+

+
+
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
+
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


+
+
+
+
+
+
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
+
+
+
+
+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+

+
+
+
-
-
-
+
+
+

+
+
+
+
+
+
+
+
+
+

+
+
+
+
+
+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+



-
-
+
+


+
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


















-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
-
-
-
-
+
+
+
+
+

-
-
-
-
+
+
+
+

-
-
-
+
+
+
-
-
+
-
-
+
-

+



-
+
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
-
-
+
-
-
-



-
-
+
+
-
-
+

-

-
+
-
-
+
-
-
+
-

-
+
-

-
-
-
-
+

/* expect.h - include file for using the expect library, libexpect.a
from C or C++ (i.e., without Tcl)

Written by: Don Libes, [email protected], NIST, 12/3/90

Design and implementation of this program was paid for by U.S. tax
dollars.  Therefore it is public domain.  However, the author and NIST
would appreciate credit if this program or parts of it are used.
*/

#ifndef _EXPECT_H
#define _EXPECT_H

#include <stdio.h>
#include <setjmp.h>

/*
 * tcl.h --
 *
 *	This header file describes the externally-visible facilities
 *	of the Tcl interpreter.
 *
 * Copyright (c) 1987-1994 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 1993-1996 Lucent Technologies.
 * Copyright (c) 1998-1999 Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: expect.h,v 5.29 2000/01/06 23:22:05 wart Exp $
 */

#ifndef _TCL
#define __EXPECTLIBUSER__
#define _TCL

#ifndef __WIN32__
#   if defined(_WIN32) || defined(WIN32)
#	define __WIN32__
#   endif
#endif
#include "expect_comm.h"

#ifdef __WIN32__
#   ifndef STRICT
#	define STRICT
#   endif
#   ifndef USE_PROTOTYPE
#	define USE_PROTOTYPE 1
#   endif
#   ifndef HAS_STDARG
#	define HAS_STDARG 1
#   endif
#   ifndef USE_PROTOTYPE
#	define USE_PROTOTYPE 1
#   endif

/*
 * Under Windows we need to call Tcl_Alloc in all cases to avoid competing
 * C run-time library issues.
 */
/* These macros are suggested by the autoconf documentation. */

#   ifndef USE_TCLALLOC
#	define USE_TCLALLOC 1
#   endif
#endif /* __WIN32__ */

/*
 * The following definitions set up the proper options for Macintosh
 * compilers.  We use this method because there is no autoconf equivalent.
 */

#ifdef MAC_TCL
#   ifndef HAS_STDARG
#	define HAS_STDARG 1
#   endif
#   ifndef USE_TCLALLOC
#	define USE_TCLALLOC 1
#   endif
#   ifndef NO_STRERROR
#	define NO_STRERROR 1
#   endif
#endif

/*
 * Utility macros: STRINGIFY takes an argument and wraps it in "" (double
 * quotation marks), JOIN joins two arguments.
 */

#define VERBATIM(x) x
#ifdef _MSC_VER
# define STRINGIFY(x) STRINGIFY1(x)
# define STRINGIFY1(x) #x
# define JOIN(a,b) JOIN1(a,b)
# define JOIN1(a,b) a##b
#else
# ifdef RESOURCE_INCLUDED
#  define STRINGIFY(x) STRINGIFY1(x)
#  define STRINGIFY1(x) #x
#  define JOIN(a,b) JOIN1(a,b)
#  define JOIN1(a,b) a##b
# else
#  ifdef __STDC__
#   define STRINGIFY(x) #x
#   define JOIN(a,b) a##b
#  else
#   define STRINGIFY(x) "x"
#   define JOIN(a,b) VERBATIM(a)VERBATIM(b)
#  endif
# endif
#endif

/* 
 * A special definition used to allow this header file to be included 
 * in resource files so that they can get obtain version information from
 * this file.  Resource compilers don't like all the C stuff, like typedefs
 * and procedure declarations, that occur below.
 */
#undef WIFEXITED
#ifndef WIFEXITED
#   define WIFEXITED(stat)  (((stat) & 0xff) == 0)

#ifndef RESOURCE_INCLUDED

#ifndef BUFSIZ
#include <stdio.h>
#endif

/*
 * Definitions that allow Tcl functions with variable numbers of
 * arguments to be used with either varargs.h or stdarg.h.  TCL_VARARGS
 * is used in procedure prototypes.  TCL_VARARGS_DEF is used to declare
 * the arguments in a function definiton: it takes the type and name of
 * the first argument and supplies the appropriate argument declaration
 * string for use in the function definition.  TCL_VARARGS_START
 * initializes the va_list data structure and returns the first argument.
 */

#if defined(__STDC__) || defined(HAS_STDARG)
#   include <stdarg.h>

#   define TCL_VARARGS(type, name) (type name, ...)
#   define TCL_VARARGS_DEF(type, name) (type name, ...)
#   define TCL_VARARGS_START(type, name, list) (va_start(list, name), name)
#else
#   include <varargs.h>

#   ifdef __cplusplus
#	define TCL_VARARGS(type, name) (type name, ...)
#	define TCL_VARARGS_DEF(type, name) (type va_alist, ...)
#   else
#	define TCL_VARARGS(type, name) ()
#	define TCL_VARARGS_DEF(type, name) (va_alist)
#   endif
#   define TCL_VARARGS_START(type, name, list) \
	(va_start(list), va_arg(list, type))
#endif

/*
 * Macros used to declare a function to be exported by a DLL.
 * Used by Windows, maps to no-op declarations on non-Windows systems.
 * The default build on windows is for a DLL, which causes the DLLIMPORT
 * and DLLEXPORT macros to be nonempty. To build a static library, the
 * macro STATIC_BUILD should be defined.
 */
#undef WEXITSTATUS
#ifndef WEXITSTATUS
#   define WEXITSTATUS(stat) (((stat) >> 8) & 0xff)

#ifdef STATIC_BUILD
# define DLLIMPORT
# define DLLEXPORT
#else
# if defined(__WIN32__) && (defined(_MSC_VER) || (defined(__GNUC__) && defined(__declspec)))
#   define DLLIMPORT __declspec(dllimport)
#   define DLLEXPORT __declspec(dllexport)
# else
#  define DLLIMPORT
#  define DLLEXPORT
# endif
#endif

/*
 * These macros are used to control whether functions are being declared for
 * import or export.  If a function is being declared while it is being built
 * to be included in a shared library, then it should have the DLLEXPORT
 * storage class.  If is being declared for use by a module that is going to
 * link against the shared library, then it should have the DLLIMPORT storage
 * class.  If the symbol is beind declared for a static build or for use from a
 * stub library, then the storage class should be empty.

#undef WIFSIGNALED
#ifndef WIFSIGNALED
#   define WIFSIGNALED(stat) ((stat) && ((stat) == ((stat) & 0x00ff)))
 *
 * The convention is that a macro called BUILD_xxxx, where xxxx is the
 * name of a library we are building, is set on the compile line for sources
 * that are to be placed in the library.  When this macro is set, the
 * storage class will be set to DLLEXPORT.  At the end of the header file, the
 * storage class will be reset to DLLIMPORt.
 */

#undef TCL_STORAGE_CLASS
#ifdef BUILD_tcl
# define TCL_STORAGE_CLASS DLLEXPORT
#else
# ifdef USE_TCL_STUBS
#  define TCL_STORAGE_CLASS
# else
#  define TCL_STORAGE_CLASS DLLIMPORT
# endif
#endif

/*
 * Definitions that allow this header file to be used either with or
 * without ANSI C features like function prototypes.  */

#undef _ANSI_ARGS_
#undef CONST

#if ((defined(__STDC__) || defined(SABER)) && !defined(NO_PROTOTYPE)) || defined(__cplusplus) || defined(USE_PROTOTYPE)
#   define _USING_PROTOTYPES_ 1
#   define _ANSI_ARGS_(x)	x
#   define CONST const
#else
#   define _ANSI_ARGS_(x)	()
#   define CONST
#endif

#ifdef __cplusplus
#   define EXTERN extern "C" TCL_STORAGE_CLASS
#else
#   define EXTERN extern TCL_STORAGE_CLASS
#endif

/*
 * Macro to use instead of "void" for arguments that must have
 * type "void *" in ANSI C;  maps them to type "char *" in
 * non-ANSI systems.
 */
#ifndef __WIN32__
#ifndef VOID
#   ifdef __STDC__
#       define VOID void
#   else
#       define VOID char
#   endif
#endif
#else /* __WIN32__ */
/*
 * The following code is copied from winnt.h
 */
#ifndef VOID
#define VOID void
typedef char CHAR;
typedef short SHORT;
typedef long LONG;
#endif
#endif /* __WIN32__ */

/*
 * Miscellaneous declarations.
 */
#undef WTERMSIG
#ifndef WTERMSIG
#   define WTERMSIG(stat)    ((stat) & 0x7f)

#ifndef NULL
#define NULL 0
#endif

typedef struct Tcl_RegExp_ *Tcl_RegExp;

/*
 * The following declarations either map ckalloc and ckfree to
 * malloc and free, or they map them to procedures with all sorts
 * of debugging hooks defined in tclCkalloc.c.
 */

#ifdef TCL_MEM_DEBUG

#  define Tcl_Alloc(x) Tcl_DbCkalloc(x, __FILE__, __LINE__)
#  define Tcl_Free(x)  Tcl_DbCkfree(x, __FILE__, __LINE__)
#  define Tcl_Realloc(x,y) Tcl_DbCkrealloc((x), (y),__FILE__, __LINE__)
#  define ckalloc(x) Tcl_DbCkalloc(x, __FILE__, __LINE__)
#  define ckfree(x)  Tcl_DbCkfree(x, __FILE__, __LINE__)
#  define ckrealloc(x,y) Tcl_DbCkrealloc((x), (y),__FILE__, __LINE__)
#undef WIFSTOPPED
#ifndef WIFSTOPPED
#   define WIFSTOPPED(stat)  (((stat) & 0xff) == 0177)
#endif

#else

/*
 * If USE_TCLALLOC is true, then we need to call Tcl_Alloc instead of
 * the native malloc/free.  The only time USE_TCLALLOC should not be
 * true is when compiling the Tcl/Tk libraries on Unix systems.  In this
 * case we can safely call the native malloc/free directly as a performance
 * optimization.
 */

#  if USE_TCLALLOC
#     define ckalloc(x) Tcl_Alloc(x)
#     define ckfree(x) Tcl_Free(x)
#     define ckrealloc(x,y) Tcl_Realloc(x,y)
#  else
#     define ckalloc(x) malloc(x)
#     define ckfree(x)  free(x)
#     define ckrealloc(x,y) realloc(x,y)
#  endif
#  define Tcl_DumpActiveMemory(x)
#  define Tcl_ValidateAllMemory(x,y)

#endif /* !TCL_MEM_DEBUG */


/*
 * These function have been renamed. The old names are deprecated, but we
 * define these macros for backwards compatibilty.
 */

#define Tcl_Ckalloc Tcl_Alloc
#define Tcl_Ckfree Tcl_Free
#define Tcl_Ckrealloc Tcl_Realloc
#define Tcl_Return Tcl_SetResult
#define Tcl_TildeSubst Tcl_TranslateFileName

/*
 * In later releases, Tcl_Panic will be the correct name to use.  For now
 * we leave it as panic to avoid breaking existing binaries.
 */

#define Tcl_Panic panic
#define Tcl_PanicVA panicVA

#endif /* RESOURCE_INCLUDED */

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT

#endif /* _TCL */

/*
 * end of tcl.h definitions
 */
#undef WSTOPSIG
#ifndef WSTOPSIG
#   define WSTOPSIG(stat)    (((stat) >> 8) & 0xff)


/*
 * regexp definitions - from tcl8.0/tclRegexp.h
 */

/*
 * Definitions etc. for regexp(3) routines.
 *
 * Caveat:  this is V8 regexp(3) [actually, a reimplementation thereof],
 * not the System V one.
 *
 * RCS: @(#) $Id: expect.h,v 5.29 2000/01/06 23:22:05 wart Exp $
 */

#ifndef _REGEXP
#define _REGEXP 1

#ifdef BUILD_tcl
# undef TCL_STORAGE_CLASS
# define TCL_STORAGE_CLASS DLLEXPORT
#endif

/*
 * Define constants for waitpid() system call if they aren't defined
 * by a system header file.  Taken from Tcl include files
 * NSUBEXP must be at least 10, and no greater than 117 or the parser
 * will not work properly.
 */

#define NSUBEXP  20
#ifndef WNOHANG
#   define WNOHANG 1
#endif
#ifndef WUNTRACED
#   define WUNTRACED 2
#endif

typedef struct regexp {
	char *startp[NSUBEXP];
	char *endp[NSUBEXP];
	char regstart;		/* Internal use only. */
	char reganch;		/* Internal use only. */
	char *regmust;		/* Internal use only. */
	int regmlen;		/* Internal use only. */
	char program[1];	/* Unwarranted chumminess with compiler. */
} regexp;

EXTERN regexp *TclRegComp _ANSI_ARGS_((char *exp));
EXTERN int TclRegExec _ANSI_ARGS_((regexp *prog, char *string, char *start));
EXTERN void TclRegSub _ANSI_ARGS_((regexp *prog, char *source, char *dest));
EXTERN void exp_TclRegError _ANSI_ARGS_((char *msg));
EXTERN char *TclGetRegError _ANSI_ARGS_((void));

# undef TCL_STORAGE_CLASS
# define TCL_STORAGE_CLASS DLLIMPORT

#endif /* REGEXP */


/*
 * end of regexp definitions
 */


/*
 * finally - expect-specific definitions
 */

#include "expect_comm.h"

enum exp_type {
	exp_end = 0,		/* placeholder - no more cases */
	exp_glob,		/* glob-style */
	exp_exact,		/* exact string */
	exp_regexp,		/* regexp-style, uncompiled */
	exp_compiled,		/* regexp-style, compiled */
	exp_null,		/* matches binary 0 */
	exp_bogus		/* aid in reporting compatibility problems */
};

struct exp_case {		/* case for expect command */
	char *pattern;
	regexp *re;
	enum exp_type type;
	int value;		/* value to be returned upon match */
};

#if defined(__WIN32__) && !defined(__EXPECTLIB__)
#define DLLIMP __declspec(dllimport)
#else
#define DLLIMP
#endif

EXTERN DLLIMP char *exp_buffer;		/* buffer of matchable chars */
EXTERN DLLIMP char *exp_buffer_end;	/* one beyond end of matchable chars */
EXTERN DLLIMP char *exp_match;		/* start of matched string */
EXTERN DLLIMP char *exp_match_end;	/* one beyond end of matched string */
EXTERN DLLIMP int exp_match_max;	/* bytes */
EXTERN DLLIMP int exp_timeout;		/* seconds */
EXTERN DLLIMP int exp_full_buffer;	/* if true, return on full buffer */
EXTERN DLLIMP int exp_remove_nulls;	/* if true, remove nulls */
EXTERN char *exp_buffer;		/* buffer of matchable chars */
EXTERN char *exp_buffer_end;		/* one beyond end of matchable chars */
EXTERN char *exp_match;			/* start of matched string */
EXTERN char *exp_match_end;		/* one beyond end of matched string */
EXTERN int exp_match_max;		/* bytes */
EXTERN int exp_timeout;			/* seconds */
EXTERN int exp_full_buffer;		/* if true, return on full buffer */
EXTERN int exp_remove_nulls;		/* if true, remove nulls */

EXTERN DLLIMP int exp_pty_timeout;	/* see Cray hooks in source */
EXTERN DLLIMP int exp_pid;		/* process-id of spawned process */
EXTERN DLLIMP int exp_autoallocpty;	/* if TRUE, we do allocation */
EXTERN DLLIMP int exp_pty[2];		/* master is [0], slave is [1] */
EXTERN DLLIMP char *exp_pty_slave_name;	/* name of pty slave device if we */
EXTERN int exp_pty_timeout;		/* see Cray hooks in source */
EXTERN int exp_pid;			/* process-id of spawned process */
EXTERN int exp_autoallocpty;		/* if TRUE, we do allocation */
EXTERN int exp_pty[2];			/* master is [0], slave is [1] */
EXTERN char *exp_pty_slave_name;	/* name of pty slave device if we */
					/* do allocation */
EXTERN DLLIMP char *exp_stty_init;	/* initial stty args */
EXTERN DLLIMP int exp_ttycopy;		/* copy tty parms from /dev/tty */
EXTERN DLLIMP int exp_ttyinit;		/* set tty parms to sane state */
EXTERN DLLIMP int exp_console;		/* redirect console */
EXTERN char *exp_stty_init;		/* initial stty args */
EXTERN int exp_ttycopy;			/* copy tty parms from /dev/tty */
EXTERN int exp_ttyinit;			/* set tty parms to sane state */
EXTERN int exp_console;			/* redirect console */

#ifdef __WIN32__
EXTERN DLLIMP int exp_nt_debug;		/* Expose subprocesses consoles */
#endif
#ifdef HAVE_SIGLONGJMP
sigjmp_buf exp_readenv;		/* for interruptable read() */
#else

EXTERN jmp_buf exp_readenv;		/* for interruptable read() */
jmp_buf exp_readenv;		/* for interruptable read() */
EXTERN DLLIMP int exp_reading;		/* whether we can longjmp or not */

#endif /* HAVE_SIGLONGJMP */
#undef DLLIMP

EXTERN int exp_reading;			/* whether we can longjmp or not */
#define EXP_ABORT	1		/* abort read */
#define EXP_RESTART	2		/* restart read */

typedef void *ExpHandle;
EXTERN int exp_is_debugging;
EXTERN int exp_loguser;

EXTERN void      exp_closefd	_ANSI_ARGS_((ExpHandle handle));
EXTERN int       exp_disconnect	_ANSI_ARGS_((void));
EXTERN int       exp_kill	_ANSI_ARGS_((int pid, int sig));
EXTERN ExpHandle exp_popen	_ANSI_ARGS_((char *command));
EXTERN int       exp_printf	_ANSI_ARGS_(TCL_VARARGS(ExpHandle ,handle));
EXTERN int       exp_putc	_ANSI_ARGS_(TCL_VARARGS(ExpHandle ,handle));
EXTERN int       exp_puts	_ANSI_ARGS_((ExpHandle handle, char *s));
EXTERN int       exp_read	_ANSI_ARGS_((ExpHandle handle, void *buffer,
EXTERN void (*exp_close_in_child)();	/* procedure to close files in child */
EXTERN void exp_slave_control _ANSI_ARGS_((int,int));
EXTERN int exp_logfile_all;
EXTERN FILE *exp_debugfile;
EXTERN FILE *exp_logfile;
extern void exp_debuglog _ANSI_ARGS_(TCL_VARARGS(char *,fmt));
extern void exp_errorlog _ANSI_ARGS_(TCL_VARARGS(char *,fmt));

EXTERN int exp_disconnect _ANSI_ARGS_((void));
					int n));
EXTERN int       exp_waitpid	_ANSI_ARGS_((int pid, int *statusPtr,
EXTERN FILE *exp_popen	_ANSI_ARGS_((char *command));
					int flags));
EXTERN int       exp_write	_ANSI_ARGS_((ExpHandle handle, void *buffer,
					int n));
EXTERN void (*exp_child_exec_prelude) _ANSI_ARGS_((void));

#ifndef EXP_DEFINE_FNS
EXTERN ExpHandle exp_spawnl	_ANSI_ARGS_(TCL_VARARGS(char *,file));
EXTERN int exp_expectl		_ANSI_ARGS_(TCL_VARARGS(ExpHandle ,handle));
EXTERN int exp_spawnl	_ANSI_ARGS_(TCL_VARARGS(char *,file));
EXTERN int exp_expectl	_ANSI_ARGS_(TCL_VARARGS(int,fd));
#ifndef __WIN32__
EXTERN void *exp_fexpectl	_ANSI_ARGS_(TCL_VARARGS(FILE *,fp));
EXTERN int exp_fexpectl	_ANSI_ARGS_(TCL_VARARGS(FILE *,fp));
#endif
#endif

EXTERN ExpHandle exp_spawnv	_ANSI_ARGS_((char *file, char *argv[]));
EXTERN int exp_spawnv	_ANSI_ARGS_((char *file, char *argv[]));
EXTERN int exp_expectv		_ANSI_ARGS_((ExpHandle handle,
    					struct exp_case *cases));
EXTERN int exp_expectv	_ANSI_ARGS_((int fd, struct exp_case *cases));
#ifndef __WIN32__
EXTERN void *exp_fexpectv	_ANSI_ARGS_((FILE *fp,struct exp_case *cases));
EXTERN int exp_fexpectv	_ANSI_ARGS_((FILE *fp, struct exp_case *cases));
#endif

EXTERN ExpHandle exp_spawnfd	_ANSI_ARGS_((int filehandle));
EXTERN int exp_spawnfd	_ANSI_ARGS_((int fd));
#endif /* _EXPECT_H */

EXTERN void exp_perror		_ANSI_ARGS_((char *string));
EXTERN char *exp_strerror	_ANSI_ARGS_((void));
EXTERN int exp_setblocking	_ANSI_ARGS_((ExpHandle handle, int mode));
EXTERN void exp_setdebug	_ANSI_ARGS_((char *file, int mode));
#endif /* _EXPECT_H */






Added generic/tcldbg.h.

















































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

/* Dbg.h - Tcl Debugger include file

Written by: Don Libes, NIST, 3/23/93

Design and implementation of this program was paid for by U.S. tax
dollars.  Therefore it is public domain.  However, the author and NIST
would appreciate credit if this program or parts of it are used.

*/

/* _DEBUG or _DBG is just too likely, use something more unique */
#ifndef _NIST_DBG
#define _NIST_DBG

#include "tcl.h"

#ifndef TCL_NEWEXTERN
#   ifdef __cplusplus
#	define OLDEXTERN    extern "C" TCL_STORAGE_CLASS
#   else
#	define OLDEXTERN    extern TCL_STORAGE_CLASS
#   endif
#   undef EXTERN
#   define EXTERN(a) OLDEXTERN a
#endif


#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLEXPORT


typedef int (Dbg_InterProc) _ANSI_ARGS_((Tcl_Interp *interp, ClientData data));
typedef int (Dbg_IgnoreFuncsProc) _ANSI_ARGS_((
			Tcl_Interp *interp,
			char *funcname));
typedef void (Dbg_OutputProc) _ANSI_ARGS_((
			Tcl_Interp *interp,
			char *output,
			ClientData data));

typedef struct {
  Dbg_InterProc *func;
  ClientData data;
} Dbg_InterStruct;

typedef struct {
  Dbg_OutputProc *func;
  ClientData data;
} Dbg_OutputStruct;

char * Dbg_VarName;
char * Dbg_DefaultCmdName;

/* trivial interface, creates a "debug" command in your interp */
EXTERN(int) Tcldbg_Init _ANSI_ARGS_((Tcl_Interp *));

void Dbg_On _ANSI_ARGS_((Tcl_Interp *interp,
					int immediate));
void Dbg_Off _ANSI_ARGS_((Tcl_Interp *interp));
char ** Dbg_ArgcArgv _ANSI_ARGS_((int argc,char *argv[],
					int copy));
int Dbg_Active _ANSI_ARGS_((Tcl_Interp *interp));
Dbg_InterStruct Dbg_Interactor _ANSI_ARGS_((
					Tcl_Interp *interp,
					Dbg_InterProc *interactor,
					ClientData data));
Dbg_IgnoreFuncsProc * Dbg_IgnoreFuncs _ANSI_ARGS_((
					Tcl_Interp *interp,
					Dbg_IgnoreFuncsProc *));
Dbg_OutputStruct Dbg_Output _ANSI_ARGS_((
					Tcl_Interp *interp,
					Dbg_OutputProc *,
					ClientData data));

#endif /* _NIST_DBG */






Added makefile.win.































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

#==============================================================================
#   The Tcl/Tk SuperDuty Win32 Common-Denominator Makefile Multiplexor for:
#
#	    Microsoft NMAKE  v1.62+	[MSVC++ v5+]
#	    Borland MAKE     v5.2	[Borland C++ Builder 5.5]
#	    Watcom WMAKE     v11.0	[OpenWatcom]
#	    MinGW MAKE	     v3.79.1    [MinGW: Minimalist GNU For Windows]
#
#   Tool specific syntax is NOT allowed in this file.  We assume the brand of
#   'make' follows the compiler to be used.  This is not a perfect assumption,
#   but, I feel, is an excellent default.
#
#==============================================================================
# RCS: @(#) $Id: makefile.win,v 1.1.2.3 2001/09/28 02:12:46 davygrvy Exp $
#==============================================================================

### Remove all '!' for MinGW..  Sorry, couldn't find another way to do this.

#==============================================
# Load the user info.
#==============================================

!include mkconfig.mif

#==============================================
# Within what context are we ?
#==============================================

!ifdef _NMAKE_VER
!include "win\mkprepvc32.mif"	# Microsoft Toolset
!else
!ifdef __LOADDLL__
!include "win\mkwc32.mif"	# Watcom Toolset
!else
!ifdef __MAKE__
!include "win\mkbc32.mif"	# Borland Toolset
!else
!ifdef BUILDLIB
				# Lcc-Win32 doesn't have an include directive...  oh well.
!else
!ifdef MAKE_VERSION
!include win/mkmgw32.mif	# MinGW Toolset
!else
!error Unknown make tool.  Toolset cannot be determined.
!endif
!endif
!endif
!endif
!endif

!ifndef BAILOUT

#==============================================
#  Targets.
#==============================================

all : $(SYM)
	$(MAKECMD) all

release : $(SYM)
	$(MAKECMD) expect

test : $(SYM)
	$(MAKECMD) test

debugger : $(SYM)
	$(MAKECMD) debugger

slavedrv : $(SYM)
	$(MAKECMD) slavedrv

telnet : $(SYM)
	$(MAKECMD) telnet

genstubs : $(SYM)
	$(MAKECMD) genstubs

install : $(SYM)
	$(MAKECMD) install

winhelp : $(SYM)
	$(MAKECMD) winhelp


cvsupdate : $(SYM)
	set CVS_RSH=$(CVS_RSH)
	$(CVSCMD) update $(CVS_OPTS)

!endif






Added mkconfig.mif.










































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

#==============================================================================
#
#  Edit for your local configuration.  This should be the only file
#  that needs editing to build Expect.
#
#==============================================================================
# RCS: @(#) $Id: mkconfig.mif,v 1.1.2.2 2001/09/28 00:41:50 davygrvy Exp $
#==============================================================================


#!error Please set the user defaults in this file before using this build system.


#==============================================
# CVS info
#==============================================
CVSCMD		= c:\dev\wincvs\cvs.exe
CVS_RSH		= c:\cygwin\bin\ssh.exe


#==============================================
# Where is Tcl ?
# This needs to be the source location.
#==============================================
TCLROOT		= D:\thread_ws\Tcl

### We can't set this to 1, so don't try.  Expect needs to know some
### deep internals and it's only available with the source dist.
### Expect CANNOT build from the distribution.
ISTCLINSTALL	= 0


#==============================================
# Where should we install to ?  Use $(TCLROOT)
# when ISTCLINSTALL == 1
#==============================================
INSTALLDIR	= C:\program Files\Tcl


#==============================================
# What Tcl version are we grabbing ?
#==============================================
TCLMAJOR	= 8
TCLMINOR	= 4

TCL_VERSION	= $(TCLMAJOR)$(TCLMINOR)
TCL_DOTVERSION	= $(TCLMAJOR).$(TCLMINOR)


#==============================================
# Toolset information
#==============================================

#### Microsoft Visual C++
TOOLSETvc32	= c:\dev\devstudio60
TOOLSETvc32VER	= 6

#### Borland C++ Builder Commandline tools
TOOLSETbc32	= c:\dev\bcc55
TOOLSETbc32VER	= 55

#### OpenWatcom C/C++
TOOLSETwc32	= c:\dev\watcom
TOOLSETwc32VER	= 11

#### MinGW
TOOLSETmgw32	= c:\dev\mingw
TOOLSETmgw32VER	= 29535






Deleted pty_sgttyb.c.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249



























































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

/* pty_bsd.c - routines to allocate ptys - BSD version

Written by: Don Libes, NIST, 2/6/90

Design and implementation of this program was paid for by U.S. tax
dollars.  Therefore it is public domain.  However, the author and NIST
would appreciate credit if this program or parts of it are used.

*/

#include <stdio.h>		/* tmp for debugging */
#include <signal.h>

#if defined(SIGCLD) && !defined(SIGCHLD)
#define SIGCHLD SIGCLD
#endif

#include <sys/types.h>
#include <sys/stat.h>
/*** #include <sys/ioctl.h> ***/
#include <sys/file.h>
#include <signal.h>
#include <setjmp.h>
#include "expect_cf.h"
#include "exp_rename.h"
#include "exp_tty_in.h"
#include "exp_pty.h"

void expDiagLog();
void expDiagLogU();

#ifndef TRUE
#define TRUE 1
#define FALSE 0
#endif

static char	master_name[] = "/dev/ptyXX";	/* master */
static char	 slave_name[] = "/dev/ttyXX";	/* slave */
static char	*tty_type;		/* ptr to char [pt] denoting
					   whether it is a pty or tty */
static char	*tty_bank;		/* ptr to char [p-z] denoting
					   which bank it is */
static char	*tty_num;		/* ptr to char [0-f] denoting
					   which number it is */
char *exp_pty_slave_name;
char *exp_pty_error;

static void
pty_stty(s,name)
char *s;		/* args to stty */
char *name;		/* name of pty */
{
#define MAX_ARGLIST 10240
	char buf[MAX_ARGLIST];	/* overkill is easier */
	RETSIGTYPE (*old)();	/* save old sigalarm handler */

#ifdef STTY_READS_STDOUT
	sprintf(buf,"/bin/stty %s > %s",s,name);
#else
	sprintf(buf,"/bin/stty %s < %s",s,name);
#endif
	old = signal(SIGCHLD, SIG_DFL);
	system(buf);
	signal(SIGCHLD, old);	/* restore signal handler */
}

int exp_dev_tty;	/* file descriptor to /dev/tty or -1 if none */
static int knew_dev_tty;/* true if we had our hands on /dev/tty at any time */

#ifdef TIOCGWINSZ
static struct winsize winsize = {0, 0};
#endif
#if defined(TIOCGSIZE) && !defined(TIOCGWINSZ)
static struct ttysize winsize = {0, 0};
#endif

exp_tty exp_tty_original;

#define GET_TTYTYPE	0
#define SET_TTYTYPE	1
static void
ttytype(request,fd,ttycopy,ttyinit,s)
int request;
int fd;
		/* following are used only if request == SET_TTYTYPE */
int ttycopy;	/* if true, copy from /dev/tty */
int ttyinit;	/* if true, initialize to sane state */
char *s;	/* stty args */
{
	static struct	tchars tc;		/* special characters */
	static struct	ltchars lc;		/* local special characters */
	static struct	winsize win;		/* window size */
	static int	lb;			/* local modes */
	static int	l;			/* line discipline */

	if (request == GET_TTYTYPE) {
		if (-1 == ioctl(fd, TIOCGETP, (char *)&exp_tty_original)
		 || -1 == ioctl(fd, TIOCGETC, (char *)&tc)
		 || -1 == ioctl(fd, TIOCGETD, (char *)&l)
		 || -1 == ioctl(fd, TIOCGLTC, (char *)&lc)
		 || -1 == ioctl(fd, TIOCLGET, (char *)&lb)
		 || -1 == ioctl(fd, TIOCGWINSZ, (char *)&win)) {
			knew_dev_tty = FALSE;
			exp_dev_tty = -1;
		}
#ifdef TIOCGWINSZ
		ioctl(fd,TIOCGWINSZ,&winsize);
#endif
#if defined(TIOCGSIZE) && !defined(TIOCGWINSZ)
		ioctl(fd,TIOCGSIZE,&winsize);
#endif
	} else {	/* type == SET_TTYTYPE */
		if (ttycopy && knew_dev_tty) {
			(void) ioctl(fd, TIOCSETP, (char *)&exp_tty_current);
			(void) ioctl(fd, TIOCSETC, (char *)&tc);
			(void) ioctl(fd, TIOCSLTC, (char *)&lc);
			(void) ioctl(fd, TIOCLSET, (char *)&lb);
			(void) ioctl(fd, TIOCSETD, (char *)&l);
			(void) ioctl(fd, TIOCSWINSZ, (char *)&win);
#ifdef TIOCSWINSZ
			ioctl(fd,TIOCSWINSZ,&winsize);
#endif
#if defined(TIOCSSIZE) && !defined(TIOCSWINSZ)
			ioctl(fd,TIOCGSIZE,&winsize);
#endif
		}

#ifdef __CENTERLINE__
#undef DFLT_STTY
#define DFLT_STTY "sane"
#endif

/* Apollo Domain doesn't need this */
#ifdef DFLT_STTY
		if (ttyinit) {
			/* overlay parms originally supplied by Makefile */
			pty_stty(DFLT_STTY,slave_name);
		}
#endif

		/* lastly, give user chance to override any terminal parms */
		if (s) {
			pty_stty(s,slave_name);
		}
	}
}

void
exp_init_pty()
{
	tty_type = & slave_name[strlen("/dev/")];
	tty_bank = &master_name[strlen("/dev/pty")];
	tty_num  = &master_name[strlen("/dev/ptyp")];

	exp_dev_tty = open("/dev/tty",O_RDWR);

#if experimental
	/* code to allocate force expect to get a controlling tty */
	/* even if it doesn't start with one (i.e., under cron). */
	/* This code is not necessary, but helpful for testing odd things. */
	if (exp_dev_tty == -1) {
		/* give ourselves a controlling tty */
		int master = exp_getptymaster();
		fcntl(master,F_SETFD,1);	/* close-on-exec */
		setpgrp(0,0);
		close(0);
		close(1);
		exp_getptyslave(exp_get_var(exp_interp,"stty_init"));
		close(2);
		fcntl(0,F_DUPFD,2);		/* dup 0 onto 2 */
	}
#endif

	knew_dev_tty = (exp_dev_tty != -1);
	if (knew_dev_tty) ttytype(GET_TTYTYPE,exp_dev_tty,0,0,(char *)0);
}

/* returns fd of master end of pseudotty */
int
exp_getptymaster()
{
	int master = -1;
	char *hex, *bank;
	struct stat statbuf;

	exp_pty_error = 0;

	if (exp_pty_test_start() == -1) return -1;

	for (bank = "pqrstuvwxyzPQRSTUVWXYZ";*bank;bank++) {
		*tty_bank = *bank;
		*tty_num = '0';
		if (stat(master_name, &statbuf) < 0) break;
		for (hex = "0123456789abcdef";*hex;hex++) {
			*tty_num = *hex;

			/* generate slave name from master */
			strcpy(slave_name,master_name);
			*tty_type = 't';

			master = exp_pty_test(master_name,slave_name,
						*tty_bank,tty_num);
			if (master >= 0) goto done;
		}
	}
 done:
	exp_pty_test_end();
	exp_pty_slave_name = slave_name;
	return(master);
}

/* see comment in pty_termios.c */
/*ARGSUSED*/
void
exp_slave_control(master,control)
int master;
int control;
{
}

int
exp_getptyslave(ttycopy,ttyinit,stty_args)
int ttycopy;
int ttyinit;
char *stty_args;
{
	int slave;

	if (0 > (slave = open(slave_name, O_RDWR))) return(-1);

	if (0 == slave) {
		/* if opened in a new process, slave will be 0 (and */
		/* ultimately, 1 and 2 as well) */

		/* duplicate 0 onto 1 and 2 to prepare for stty */
		fcntl(0,F_DUPFD,1);
		fcntl(0,F_DUPFD,2);
	}

	ttytype(SET_TTYTYPE,slave,ttycopy,ttyinit,stty_args);
	(void) exp_pty_unlock();
	return(slave);
}

void
exp_pty_exit()
{
	/* a stub so we can do weird things on the cray */
}






Deleted pty_termios.c.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770




































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

/* pty_termios.c - routines to allocate ptys - termios version

Written by: Don Libes, NIST, 2/6/90

This file is in the public domain.  However, the author and NIST
would appreciate credit if you use this file or parts of it.

*/

#include <stdio.h>
#include <signal.h>

#if defined(SIGCLD) && !defined(SIGCHLD)
#define SIGCHLD SIGCLD
#endif

#include "expect_cf.h"

/*
   The following functions are linked from the Tcl library.  They
   don't cause anything else in the library to be dragged in, so it
   shouldn't cause any problems (e.g., bloat).

   The functions are relatively small but painful enough that I don't care
   to recode them.  You may, if you absolutely want to get rid of any
   vestiges of Tcl.
*/
extern char *TclGetRegError();

#if defined(HAVE_PTMX_BSD) && defined(HAVE_PTMX)
/*
 * Some systems have both PTMX and PTMX_BSD.
 * In fact, alphaev56-dec-osf4.0e has /dev/pts, /dev/pty, /dev/ptym,
 * /dev/ptm, /dev/ptmx, and /dev/ptmx_bsd
 * Suggestion from Martin Buchholz <[email protected]> is that BSD
 * is usually deprecated and so should be here.
 */
#undef HAVE_PTMX_BSD
#endif

/* Linux and Digital systems can be configured to have both.
According to Ashley Pittman <[email protected]>, Digital works better
with openpty which supports 4000 while ptmx supports 60. */
#if defined(HAVE_OPENPTY) && defined(HAVE_PTMX)
#undef HAVE_PTMX
#endif

#if defined(HAVE_PTYM) && defined(HAVE_PTMX)
/*
 * HP-UX 10.0 with streams (optional) have both PTMX and PTYM.  I don't
 * know which is preferred but seeing as how the HP trap stuff is so
 * unusual, it is probably safer to stick with the native HP pty support,
 * too.
 */
#undef HAVE_PTMX
#endif

#ifdef HAVE_UNISTD_H
#  include <unistd.h>
#endif
#ifdef HAVE_INTTYPES_H
#  include <inttypes.h>
#endif
#include <sys/types.h>
#include <sys/stat.h>

#ifdef NO_STDLIB_H
#include "../compat/stdlib.h"
#else
#include <stdlib.h>
#endif

#ifdef HAVE_SYSMACROS_H
#include <sys/sysmacros.h>
#endif

#ifdef HAVE_PTYTRAP
#include <sys/ptyio.h>
#endif

#include <sys/file.h>

#ifdef HAVE_SYS_FCNTL_H
#  include <sys/fcntl.h>
#else
#  include <fcntl.h>
#endif

#if defined(_SEQUENT_)
#  include <sys/strpty.h>
#endif

#if defined(HAVE_PTMX) && defined(HAVE_STROPTS_H)
#  include <sys/stropts.h>
#endif

#include "exp_win.h"

#include "exp_tty_in.h"
#include "exp_rename.h"
#include "exp_pty.h"

void expDiagLog();
void expDiagLogPtr();

#include <errno.h>
/*extern char *sys_errlist[];*/

#ifndef TRUE
#define TRUE 1
#define FALSE 0
#endif

/* Convex getpty is different than older-style getpty */
/* Convex getpty is really just a cover function that does the traversal */
/* across the domain of pty names.  It makes no attempt to verify that */
/* they can actually be used.  Indded, the logic in the man page is */
/* wrong because it will allow you to allocate ptys that your own account */
/* already has in use. */
#if defined(HAVE_GETPTY) && defined(CONVEX)
#undef HAVE_GETPTY
#define HAVE_CONVEX_GETPTY
extern char *getpty();
static char *master_name;
static char slave_name[] = "/dev/ptyXX";
static char	*tty_bank;		/* ptr to char [p-z] denoting
					   which bank it is */
static char	*tty_num;		/* ptr to char [0-f] denoting
					   which number it is */
#endif

#if defined(_SEQUENT_) && !defined(HAVE_PTMX)
/* old-style SEQUENT, new-style uses ptmx */
static char *master_name, *slave_name;
#endif /* _SEQUENT */

/* very old SGIs prefer _getpty over ptc */
#if defined(HAVE__GETPTY) && defined(HAVE_PTC) && !defined(HAVE_GETPTY)
#undef HAVE_PTC
#endif

#if defined(HAVE_PTC)
static char slave_name[] = "/dev/ttyqXXX";
/* some machines (e.g., SVR4.0 StarServer) have all of these and */
/* HAVE_PTC works best */
#undef HAVE_GETPTY
#undef HAVE__GETPTY
#endif

#if defined(HAVE__GETPTY) || defined(HAVE_PTC_PTS) || defined(HAVE_PTMX)
static char *slave_name;
#endif

#if defined(HAVE_GETPTY)
#include <sys/vty.h>
static char master_name[MAXPTYNAMELEN];
static char slave_name[MAXPTYNAMELEN];
#endif

#if !defined(HAVE_GETPTY) && !defined(HAVE__GETPTY) && !defined(HAVE_PTC) && !defined(HAVE_PTC_PTS) && !defined(HAVE_PTMX) && !defined(HAVE_CONVEX_GETPTY) && !defined(_SEQUENT_) && !defined(HAVE_SCO_CLIST_PTYS) && !defined(HAVE_OPENPTY)
#ifdef HAVE_PTYM
			/* strange order and missing d is intentional */
static char	banks[] = "pqrstuvwxyzabcefghijklo";
static char	master_name[] = "/dev/ptym/ptyXXXX";
static char	slave_name[] = "/dev/pty/ttyXXXX";
static char	*slave_bank;
static char	*slave_num;
#else
static char	banks[] = "pqrstuvwxyzPQRSTUVWXYZ";
static char	master_name[] = "/dev/ptyXX";
static char	slave_name [] = "/dev/ttyXX";
#endif /* HAVE_PTYM */

static char	*tty_type;		/* ptr to char [pt] denoting
					   whether it is a pty or tty */
static char	*tty_bank;		/* ptr to char [p-z] denoting
					   which bank it is */
static char	*tty_num;		/* ptr to char [0-f] denoting
					   which number it is */
#endif

#if defined(HAVE_SCO_CLIST_PTYS)
#  define MAXPTYNAMELEN 64
static char master_name[MAXPTYNAMELEN];
static char slave_name[MAXPTYNAMELEN];
#endif /* HAVE_SCO_CLIST_PTYS */

#ifdef HAVE_OPENPTY
static char master_name[64];
static char slave_name[64];
#endif

char *exp_pty_slave_name;
char *exp_pty_error;

#if 0
static void
pty_stty(s,name)
char *s;		/* args to stty */
char *name;		/* name of pty */
{
#define MAX_ARGLIST 10240
	char buf[MAX_ARGLIST];	/* overkill is easier */
	RETSIGTYPE (*old)();	/* save old sigalarm handler */
	int pid;
	
	old = signal(SIGCHLD, SIG_DFL);
	switch (pid = fork()) {
	case 0: /* child */
		exec_stty("/bin/stty","/bin/stty",s);
		break;
	case -1: /* fail */
	default: /* parent */
		waitpid(pid);
		break;
	}

	signal(SIGCHLD, old);	/* restore signal handler */
}

exec_stty(s)
char *s;
{
	char *args[50];
	char *cp;
	int argi = 0;
	int quoting = FALSE;
	int in_token = FALSE;	/* TRUE if we are reading a token */

	args[0] = cp = s;
	while (*s) {
		if (quoting) {
			if (*s == '\\' && *(s+1) == '"') { /* quoted quote */
				s++;	/* get past " */
				*cp++ = *s++;
			} else 	if (*s == '\"') { /* close quote */
				end_token
				quoting = FALSE;
			} else *cp++ = *s++; /* suck up anything */
		} else if (*s == '\"') { /* open quote */
			in_token = TRUE;
			quoting = TRUE;
			s++;
		} else if (isspace(*s)) {
			end_token
		} else {
			*cp++ = *s++;
			in_token = TRUE;
		}
	}
	end_token
	args[argi] = (char *) 0; /* terminate argv */
	execvp(args[0],args);
}
#endif /*0*/

static void
pty_stty(s,name)
char *s;		/* args to stty */
char *name;		/* name of pty */
{
#define MAX_ARGLIST 10240
	char buf[MAX_ARGLIST];	/* overkill is easier */
	RETSIGTYPE (*old)();	/* save old sigalarm handler */

#ifdef STTY_READS_STDOUT
	sprintf(buf,"/bin/stty %s > %s",s,name);
#else
	sprintf(buf,"/bin/stty %s < %s",s,name);
#endif
	old = signal(SIGCHLD, SIG_DFL);
	system(buf);
	signal(SIGCHLD, old);	/* restore signal handler */
}

int exp_dev_tty;	/* file descriptor to /dev/tty or -1 if none */
static int knew_dev_tty;/* true if we had our hands on /dev/tty at any time */

exp_tty exp_tty_original;

#define GET_TTYTYPE	0
#define SET_TTYTYPE	1
static void
ttytype(request,fd,ttycopy,ttyinit,s)
int request;
int fd;
		/* following are used only if request == SET_TTYTYPE */
int ttycopy;	/* true/false, copy from /dev/tty */
int ttyinit;	/* if true, initialize to sane state */
char *s;	/* stty args */
{
	if (request == GET_TTYTYPE) {
#ifdef HAVE_TCSETATTR
		if (-1 == tcgetattr(fd, &exp_tty_original)) {
#else
		if (-1 == ioctl(fd, TCGETS, (char *)&exp_tty_original)) {
#endif
			knew_dev_tty = FALSE;
			exp_dev_tty = -1;
		}
		exp_window_size_get(fd);
	} else {	/* type == SET_TTYTYPE */
		if (ttycopy && knew_dev_tty) {
#ifdef HAVE_TCSETATTR
			(void) tcsetattr(fd, TCSADRAIN, &exp_tty_current);
#else
			(void) ioctl(fd, TCSETS, (char *)&exp_tty_current);
#endif

			exp_window_size_set(fd);
		}

#ifdef __CENTERLINE__
#undef DFLT_STTY
#define DFLT_STTY "sane"
#endif

/* Apollo Domain doesn't need this */
#ifdef DFLT_STTY
		if (ttyinit) {
			/* overlay parms originally supplied by Makefile */
/* As long as BSD stty insists on stdout == stderr, we can no longer write */
/* diagnostics to parent stderr, since stderr has is now child's */
/* Maybe someday they will fix stty? */
/*			expDiagLogPtrStr("exp_getptyslave: (default) stty %s\n",DFLT_STTY);*/
			pty_stty(DFLT_STTY,slave_name);
		}
#endif

		/* lastly, give user chance to override any terminal parms */
		if (s) {
			/* give user a chance to override any terminal parms */
/*			expDiagLogPtrStr("exp_getptyslave: (user-requested) stty %s\n",s);*/
			pty_stty(s,slave_name);
		}
	}
}

void
exp_init_pty()
{
#if !defined(HAVE_GETPTY) && !defined(HAVE__GETPTY) && !defined(HAVE_PTC) && !defined(HAVE_PTC_PTS) && !defined(HAVE_PTMX) && !defined(HAVE_CONVEX_GETPTY) && !defined(_SEQUENT_) && !defined(HAVE_SCO_CLIST_PTYS) && !defined(HAVE_OPENPTY)
#ifdef HAVE_PTYM
	static char dummy;
	tty_bank =  &master_name[strlen("/dev/ptym/pty")];
	tty_num  =  &master_name[strlen("/dev/ptym/ptyX")];
	slave_bank = &slave_name[strlen("/dev/pty/tty")];
	slave_num  = &slave_name[strlen("/dev/pty/ttyX")];
#else
	tty_bank =  &master_name[strlen("/dev/pty")];
	tty_num  =  &master_name[strlen("/dev/ptyp")];
	tty_type =   &slave_name[strlen("/dev/")];
#endif

#endif /* HAVE_PTYM */


	exp_dev_tty = open("/dev/tty",O_RDWR);
	knew_dev_tty = (exp_dev_tty != -1);
	if (knew_dev_tty) ttytype(GET_TTYTYPE,exp_dev_tty,0,0,(char *)0);
}

#ifndef R_OK
/* 3b2 doesn't define these according to [email protected]. */
#define R_OK 04
#define W_OK 02
#endif

int
exp_getptymaster()
{
	char *hex, *bank;
	struct stat stat_buf;
	int master = -1;
	int slave = -1;
	int num;

	exp_pty_error = 0;

#define TEST_PTY 1

#if defined(HAVE_PTMX) || defined(HAVE_PTMX_BSD)
#undef TEST_PTY
#if defined(HAVE_PTMX_BSD)
        if ((master = open("/dev/ptmx_bsd", O_RDWR)) == -1) return(-1);
#else
	if ((master = open("/dev/ptmx", O_RDWR)) == -1) return(-1);
#endif
	if ((slave_name = (char *)ptsname(master)) == NULL || unlockpt(master)) {
		close(master);
		return(-1);
	} else if (grantpt(master)) {
		static char buf[500];
		exp_pty_error = buf;
		sprintf(exp_pty_error,"grantpt(%s) failed - likely reason is that your system administrator (in a rage of blind passion to rid the system of security holes) removed setuid from the utility used internally by grantpt to change pty permissions.  Tell your system admin to reestablish setuid on the utility.  Get the utility name by running Expect under truss or trace.", expErrnoMsg(errno));
		close(master);
		return(-1);
	}
#ifdef TIOCFLUSH
	(void) ioctl(master,TIOCFLUSH,(char *)0);
#endif /* TIOCFLUSH */

	exp_pty_slave_name = slave_name;
	return(master);
#endif

#if defined(HAVE__GETPTY)		/* SGI needs it this way */
#undef TEST_PTY
	slave_name = _getpty(&master, O_RDWR, 0600, 0);
	if (slave_name == NULL)
		return (-1);	
	exp_pty_slave_name = slave_name;
	return(master);
#endif

#if defined(HAVE_PTC) && !defined(HAVE__GETPTY)	/* old SGI, version 3 */
#undef TEST_PTY
	master = open("/dev/ptc", O_RDWR);
	if (master >= 0) {
		int ptynum;

		if (fstat(master, &stat_buf) < 0) {
			close(master);
			return(-1);
		}
		ptynum = minor(stat_buf.st_rdev);
		sprintf(slave_name,"/dev/ttyq%d",ptynum);
	}
	exp_pty_slave_name = slave_name;
	return(master);
#endif

#if defined(HAVE_GETPTY) && !defined(HAVE__GETPTY)
#undef TEST_PTY
	master = getpty(master_name, slave_name, O_RDWR);
	/* is it really necessary to verify slave side is usable? */
	exp_pty_slave_name = slave_name;
	return master;
#endif

#if defined(HAVE_PTC_PTS)
#undef TEST_PTY
	master = open("/dev/ptc",O_RDWR);
	if (master >= 0) {
		/* never fails */
		slave_name = ttyname(master);
	}
	exp_pty_slave_name = slave_name;
	return(master);
#endif

#if defined(_SEQUENT_) && !defined(HAVE_PTMX)
#undef TEST_PTY
	/* old-style SEQUENT, new-style uses ptmx */
	master = getpseudotty(&slave_name, &master_name);
	exp_pty_slave_name = slave_name;
	return(master);
#endif /* _SEQUENT_ */

#if defined(HAVE_OPENPTY)
#undef TEST_PTY
	if (openpty(&master, &slave, master_name, 0, 0) != 0) {
		close(master);
		close(slave);
		return -1;
	}
	strcpy(slave_name, ttyname(slave));
	exp_pty_slave_name = slave_name;
	close(slave);
	return master;
#endif /* HAVE_OPENPTY */

#if defined(TEST_PTY)
	/*
	 * all pty allocation mechanisms after this require testing
	 */
	if (exp_pty_test_start() == -1) return -1;

#if !defined(HAVE_CONVEX_GETPTY) && !defined(HAVE_PTYM) && !defined(HAVE_SCO_CLIST_PTYS)
	for (bank = banks;*bank;bank++) {
		*tty_bank = *bank;
		*tty_num = '0';
		if (stat(master_name, &stat_buf) < 0) break;
		for (hex = "0123456789abcdef";*hex;hex++) {
			*tty_num = *hex;
			strcpy(slave_name,master_name);
			*tty_type = 't';
			master = exp_pty_test(master_name,slave_name,*tty_bank,tty_num);
			if (master >= 0) goto done;
		}
	}
#endif

#ifdef HAVE_SCO_CLIST_PTYS
        for (num = 0; ; num++) {
            char num_str [16];

            sprintf (num_str, "%d", num);
            sprintf (master_name, "%s%s", "/dev/ptyp", num_str);
            if (stat (master_name, &stat_buf) < 0)
                break;
            sprintf (slave_name, "%s%s", "/dev/ttyp", num_str);

            master = exp_pty_test(master_name,slave_name,'0',num_str);
            if (master >= 0)
                goto done;
        }
#endif

#ifdef HAVE_PTYM
	/* systems with PTYM follow this idea:

	   /dev/ptym/pty[a-ce-z][0-9a-f]                master pseudo terminals
	   /dev/pty/tty[a-ce-z][0-9a-f]                 slave pseudo terminals
	   /dev/ptym/pty[a-ce-z][0-9][0-9]              master pseudo terminals
	   /dev/pty/tty[a-ce-z][0-9][0-9]               slave pseudo terminals

	   SPPUX (Convex's HPUX compatible) follows the PTYM convention but
	   extends it:

	   /dev/ptym/pty[a-ce-z][0-9][0-9][0-9]         master pseudo terminals
	   /dev/pty/tty[a-ce-z][0-9][0-9][0-9]          slave pseudo terminals

	   The code does not distinguish between HPUX and SPPUX because there
	   is no reason to.  HPUX will merely fail the extended SPPUX tests.
	   In fact, most SPPUX systems will fail simply because few systems
	   will actually have the extended ptys.  However, the tests are
	   fast so it is no big deal.
	 */

	/*
	 * pty[a-ce-z][0-9a-f]
	 */

	for (bank = banks;*bank;bank++) {
		*tty_bank = *bank;
		sprintf(tty_num,"0");
		if (stat(master_name, &stat_buf) < 0) break;
		*(slave_num+1) = '\0';
		for (hex = "0123456789abcdef";*hex;hex++) {
			*tty_num = *hex;
			*slave_bank = *tty_bank;
			*slave_num = *tty_num;
			master = exp_pty_test(master_name,slave_name,*tty_bank,tty_num);
			if (master >= 0) goto done;
		}
	}

	/*
	 * tty[p-za-ce-o][0-9][0-9]
	 */

	for (bank = banks;*bank;bank++) {
		*tty_bank = *bank;
		sprintf(tty_num,"00");
		if (stat(master_name, &stat_buf) < 0) break;
		for (num = 0; num<100; num++) {
			*slave_bank = *tty_bank;
			sprintf(tty_num,"%02d",num);
			strcpy(slave_num,tty_num);
			master = exp_pty_test(master_name,slave_name,*tty_bank,tty_num);
			if (master >= 0) goto done;
		}
	}

	/*
	 * tty[p-za-ce-o][0-9][0-9][0-9]
	 */
	for (bank = banks;*bank;bank++) {
		*tty_bank = *bank;
		sprintf(tty_num,"000");
		if (stat(master_name, &stat_buf) < 0) break;
		for (num = 0; num<1000; num++) {
			*slave_bank = *tty_bank;
			sprintf(tty_num,"%03d",num);
			strcpy(slave_num,tty_num);
			master = exp_pty_test(master_name,slave_name,*tty_bank,tty_num);
			if (master >= 0) goto done;
		}
	}

#endif /* HAVE_PTYM */

#if defined(HAVE_CONVEX_GETPTY)
	for (;;) {
		if ((master_name = getpty()) == NULL) return -1;
 
		strcpy(slave_name,master_name);
		slave_name[5] = 't';/* /dev/ptyXY ==> /dev/ttyXY */

		tty_bank = &slave_name[8];
		tty_num = &slave_name[9];
		master = exp_pty_test(master_name,slave_name,*tty_bank,tty_num);
		if (master >= 0) goto done;
	}
#endif

 done:
	exp_pty_test_end();
	exp_pty_slave_name = slave_name;
	return(master);

#endif /* defined(TEST_PTY) */
}

/* if slave is opened in a child, slave_control(1) must be executed after */
/*   master is opened (when child is opened is irrelevent) */
/* if slave is opened in same proc as master, slave_control(1) must executed */
/*   after slave is opened */
/*ARGSUSED*/
void
exp_slave_control(master,control)
int master;
int control;	/* if 1, enable pty trapping of close/open/ioctl */
{
#ifdef HAVE_PTYTRAP
	ioctl(master, TIOCTRAP, &control);
#endif /* HAVE_PTYTRAP */
}

int
exp_getptyslave(ttycopy,ttyinit,stty_args)
int ttycopy;
int ttyinit;
char *stty_args;
{
	int slave, slave2;
	char buf[10240];

	if (0 > (slave = open(slave_name, O_RDWR))) {
		static char buf[500];
		exp_pty_error = buf;
		sprintf(exp_pty_error,"open(%s,rw) = %d (%s)",slave_name,slave,expErrnoMsg(errno));
		return(-1);
	}

#if defined(HAVE_PTMX_BSD)
	if (ioctl (slave, I_LOOK, buf) != 0)
		if (ioctl (slave, I_PUSH, "ldterm")) {
			expDiagLogPtrStrStr("ioctl(%d,I_PUSH,\"ldterm\") = %s\n",slave,expErrnoMsg(errno));
	}
#else
#if defined(HAVE_PTMX)
	if (ioctl(slave, I_PUSH, "ptem")) {
		expDiagLogPtrStrStr("ioctl(%d,I_PUSH,\"ptem\") = %s\n",slave,expErrnoMsg(errno));
	}
	if (ioctl(slave, I_PUSH, "ldterm")) {
		expDiagLogPtrStrStr("ioctl(%d,I_PUSH,\"ldterm\") = %s\n",slave,expErrnoMsg(errno));
	}
	if (ioctl(slave, I_PUSH, "ttcompat")) {
		expDiagLogPtrStrStr("ioctl(%d,I_PUSH,\"ttcompat\") = %s\n",slave,expErrnoMsg(errno));
	}
#endif
#endif

	if (0 == slave) {
		/* if opened in a new process, slave will be 0 (and */
		/* ultimately, 1 and 2 as well) */

		/* duplicate 0 onto 1 and 2 to prepare for stty */
		fcntl(0,F_DUPFD,1);
		fcntl(0,F_DUPFD,2);
	}

	ttytype(SET_TTYTYPE,slave,ttycopy,ttyinit,stty_args);

#if 0
#ifdef HAVE_PTYTRAP
	/* do another open, to tell master that slave is done fiddling */
	/* with pty and master does not have to wait to do further acks */
	if (0 > (slave2 = open(slave_name, O_RDWR))) return(-1);
	close(slave2);
#endif /* HAVE_PTYTRAP */
#endif

	(void) exp_pty_unlock();
	return(slave);
}

#ifdef HAVE_PTYTRAP
#include <sys/ptyio.h>
#include <sys/time.h>

/* This function attempts to deal with HP's pty interface.  This
function simply returns an indication of what was trapped (or -1 for
failure), the parent deals with the details.

Originally, I tried to just trap open's but that is not enough.  When
the pty is initialized, ioctl's are generated and if not trapped will
hang the child if no further trapping is done.  (This could occur if
parent spawns a process and then immediatley does a close.)  So
instead, the parent must trap the ioctl's.  It probably suffices to
trap the write ioctl's (and tiocsctty which some hp's need) -
conceivably, stty could be smart enough not to do write's if the tty
settings are already correct.  In that case, we'll have to rethink
this.

Suggestions from HP engineers encouraged.  I cannot imagine how this
interface was intended to be used!

*/
   
int
exp_wait_for_slave_open(fd)
int fd;
{
	fd_set excep;
	struct timeval t;
	struct request_info ioctl_info;
	int rc;
	int found = 0;

	int maxfds = sysconf(_SC_OPEN_MAX);

	t.tv_sec = 30;	/* 30 seconds */
	t.tv_usec = 0;

	FD_ZERO(&excep);
	FD_SET(fd,&excep);

	rc = select(maxfds,
		(SELECT_MASK_TYPE *)0,
		(SELECT_MASK_TYPE *)0,
		(SELECT_MASK_TYPE *)&excep,
		&t);
	if (rc != 1) {
		expDiagLogPtrStr("spawned process never started: %s\r\n",expErrnoMsg(errno));
		return(-1);
	}
	if (ioctl(fd,TIOCREQCHECK,&ioctl_info) < 0) {
		expDiagLogPtrStr("ioctl(TIOCREQCHECK) failed: %s\r\n",expErrnoMsg(errno));
		return(-1);
	}

	found = ioctl_info.request;

	expDiagLogPtrX("trapped pty op = %x",found);
	if (found == TIOCOPEN) {
		expDiagLogPtr(" TIOCOPEN");
	} else if (found == TIOCCLOSE) {
		expDiagLogPtr(" TIOCCLOSE");
	}

#ifdef TIOCSCTTY
	if (found == TIOCSCTTY) {
		expDiagLogPtr(" TIOCSCTTY");
	}
#endif

	if (found & IOC_IN) {
		expDiagLogPtr(" IOC_IN (set)");
	} else if (found & IOC_OUT) {
		expDiagLogPtr(" IOC_OUT (get)");
	}

	expDiagLogPtr("\n");

	if (ioctl(fd, TIOCREQSET, &ioctl_info) < 0) {
		expDiagLogPtrStr("ioctl(TIOCREQSET) failed: %s\r\n",expErrnoMsg(errno));
		return(-1);
	}
	return(found);
}
#endif

void
exp_pty_exit()
{
	/* a stub so we can do weird things on the cray */
}






Deleted pty_unicos.c.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419





































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

/* pty_unicos.c - routines to allocate ptys - for CRAY UNICOS 5.1 and 6.0 */

/*

Original by: Don Libes, NIST, 2/6/90
Hacked for Unicos 5.1 by: Frank Terhaar-Yonkers, US EPA,  1/10/91
Hacked for Unicos 6.0 by: Pete TerMaat, [email protected], 3/27/91

Design and implementation of this program was paid for by U.S. tax
dollars.  Therefore it is public domain.  However, the author and NIST
would appreciate credit if this program or parts of it are used.

*/

#include "expect_cf.h"
#include <stdio.h>
#include <signal.h>

#if defined(SIGCLD) && !defined(SIGCHLD)
#define SIGCHLD SIGCLD
#endif

#ifdef HAVE_UNISTD_H
#include <unistd.h>
#else
extern int fork(), execl(), wait();
#endif
#include <errno.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <sys/ioctl.h>
#include <sys/file.h>
#ifdef HAVE_SYS_FCNTL_H
#  include <sys/fcntl.h>
#else
#  include <fcntl.h>
#endif
/*#if CRAY>=60*/
#if defined(HAVE_TERMIOS)
# include <sys/termios.h>
#else
# include <sys/termio.h>
/*#endif /* 60 */*/
#endif /* defined(HAVE_TERMIOS) */
#if CRAY>=70 && defined(_CRAY2)
#include <sys/session.h>
#endif /* 70 */
#include <sys/pty.h>
#include <pwd.h>
#include <utmp.h>
#include <signal.h>
#include "exp_tty_in.h"
#include "exp_rename.h"

#ifdef HAVE_SYSCONF_H
#include <sys/sysconfig.h>
#endif

void expDiagLog();

#ifndef TRUE
#define TRUE 1
#define FALSE 0
#endif

#ifndef MAXHOSTNAMELEN
#define MAXHOSTNAMELEN 64
#endif /* MAXHOSTNAMELEN */

static char	linep[] = "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0";
static char	linet[] = "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0";
static int	lowpty;
static int	highpty;
static int	realuid;
static int	realgid;
static int 	*ptys;
static char myname[32];
static char hostname[MAXHOSTNAMELEN];
char *exp_pty_slave_name;
char *exp_pty_error;

static void
pty_stty(s,name)
char *s;		/* args to stty */
char *name;		/* name of pty */
{
#define MAX_ARGLIST 10240
	char buf[MAX_ARGLIST];	/* overkill is easier */
	RETSIGTYPE (*old)();	/* save old sigalarm handler */

#ifdef STTY_READS_STDOUT
	sprintf(buf,"/bin/stty %s > %s",s,name);
#else
	sprintf(buf,"/bin/stty %s < %s",s,name);
#endif
	old = signal(SIGCHLD, SIG_DFL);
	system(buf);
	signal(SIGCHLD, old);	/* restore signal handler */
}

int exp_dev_tty;	/* file descriptor to /dev/tty or -1 if none */
static int knew_dev_tty;/* true if we had our hands on /dev/tty at any time */

#ifdef TIOCGWINSZ
static struct winsize winsize = {0, 0};
#endif
#if defined(TIOCGSIZE) && !defined(TIOCGWINSZ)
static struct ttysize winsize = {0, 0};
#endif

/*struct	termio exp_tty_original;*/
exp_tty exp_tty_original;

#define GET_TTYTYPE	0
#define SET_TTYTYPE	1
static void
ttytype(request,fd,ttycopy,ttyinit,s)
int request;
int fd;
		/* following are used only if request == SET_TTYTYPE */
int ttycopy;	/* true/false, copy from /dev/tty */
int ttyinit;	/* if true, initialize to sane state */
char *s;	/* stty args, used only if request == SET_TTYTYPE */
{
	if (request == GET_TTYTYPE) {
		if (-1 == ioctl(fd, TCGETA, (char *)&exp_tty_original)) {
			knew_dev_tty = FALSE;
			exp_dev_tty = -1;
		}
#ifdef TIOCGWINSZ
		ioctl(fd,TIOCGWINSZ,&winsize);
#endif
#if defined(TIOCGSIZE) && !defined(TIOCGWINSZ)
		ioctl(fd,TIOCGSIZE,&winsize);
#endif
	} else {	/* type == SET_TTYTYPE */
		if (ttycopy && knew_dev_tty) {
			(void) ioctl(fd, TCSETA, (char *)&exp_tty_current);
#ifdef TIOCSWINSZ
			ioctl(fd,TIOCSWINSZ,&winsize);
#endif
#if defined(TIOCSSIZE) && !defined(TIOCSWINSZ)
			ioctl(fd,TIOCGSIZE,&winsize);
#endif
		}

		if (ttyinit) {
			/* overlay parms originally supplied by Makefile */
			pty_stty(DFLT_STTY,linet);
		}

		/* lastly, give user chance to override any terminal parms */
		if (s) {
			pty_stty(s,linet);
		}
	}
}

void
exp_init_pty()
{
	int npty;
	char *myline;

	lowpty=0;
#ifdef _SC_CRAY_NPTY
	highpty=sysconf(_SC_CRAY_NPTY);
#else
	highpty=128;
#endif /* _SC_CRAY_NPTY */

	ptys = (int *) malloc(sizeof(int)*(highpty+1));
	if (ptys == NULL) {
		fprintf(stderr,"exp_init_pty:  couldn't allocate pty array\n");
		exit(1);
	}
	for (npty = lowpty;npty <= highpty;npty++)
		ptys[npty] = 0;

 	realuid=getuid();	/* get REAL uid */
 	realgid=getgid();	/* get REAL uid */

	exp_dev_tty = open("/dev/tty",O_RDWR);
	knew_dev_tty = (exp_dev_tty != -1);
	if (knew_dev_tty) ttytype(GET_TTYTYPE,exp_dev_tty,0,0,(char *)0);

	/*
	 * Acquire (as root) current user name and host.
	 */
	(void) cuserid(myname);
	(void) gethostname(hostname,sizeof(hostname));

	/*
	 * Set the real and effective userids to root using 'setuid'.  Then
	 * set the real and effective userids to the actual user using
	 * 'setreuid'.  This allows using 'seteuid' to go back and forth from
	 * root and the actual userid.  Don't ask me why it works.
	 */
	setuid(0);
	setreuid(realuid,realuid);
}

/* returns fd of master end of pseudotty */
int
exp_getptymaster()
{
	struct stat sb;
	int master;
	int npty;

	exp_pty_error = 0;

	expDiagLog("exp_getptymaster:  lowpty=%d  highpty=%d\n",lowpty,highpty);
	for (npty = lowpty; npty <= highpty; npty++) {
		if (seteuid(0) == -1) {		/* we need to be root! */
			expDiagLog("exp_getptymaster:  seteuid root errno=%d\n",
				errno);
		}
		(void) sprintf(linep, "/dev/pty/%03d", npty);
		master = open(linep, O_RDWR);

		if (master < 0) {
			expDiagLog("exp_getptymaster:  open linep=%s errno=%d\n",
				linep,errno);
			continue;
		}

		(void) sprintf(linet, "/dev/ttyp%03d", npty);
		if(stat(linet, &sb) < 0) {
			expDiagLog("exp_getptymaster:  stat linet=%s errno=%d\n",
				linet,errno);
			(void) close(master);
			continue;
		}
		if (sb.st_uid || sb.st_gid || sb.st_mode != 0600) {
                        if (chown(linet, realuid, realgid) == -1) {
				expDiagLog("exp_getptymaster:  chown linet=%s errno=%d\n",
					linet,errno);
			}
                        if (chmod(linet, 0600) == -1) {
				expDiagLog("exp_getptymaster:  chmod linet=%s errno=%d\n",
					linet,errno);
			}
                        (void)close(master);
                        master = open(linep, 2);
                        if (master < 0) {
				expDiagLog("exp_getptymaster:  reopen linep=%s errno=%d\n",
					linep,errno);
                                continue;
			}
                }
		if (seteuid(realuid) == -1) {	/* back to who we are! */
			expDiagLog("exp_getptymaster:  seteuid user errno=%d\n",
				errno);
		}
		if (access(linet, R_OK|W_OK) != 0) {
			expDiagLog("exp_getptymaster:  access linet=%s errno=%d\n",
				linet,errno);
			(void) close(master);
			continue;
		}
		expDiagLog("exp_getptymaster:  allocated %s\n",linet);
		ptys[npty] = -1;
		exp_pty_slave_name = linet;
		return(master);
	}
	if (seteuid(realuid) == -1) {		/* back to who we are! */
		expDiagLog("exp_getptymaster:  seteuid user errno=%d\n",errno);
	}
	return(-1);
}

/* see comment in pty_termios.c */
/*ARGSUSED*/
void
exp_slave_control(master,control)
int master;
int control;
{
}

int
exp_getptyslave(ttycopy,ttyinit,stty_args)
int ttycopy;
int ttyinit;
char *stty_args;
{
	int slave;

	if (0 > (slave = open(linet, O_RDWR))) {
		expDiagLog("exp_getptyslave:  open linet=%s errno=%d\n",linet,errno);
		return(-1);
	}

	/* sanity check - if slave not 0, skip rest of this and return */
	/* to what will later be detected as an error in caller */
	if (0 != slave) {
		expDiagLog("exp_getptyslave:  slave fd not 0\n");
		 return(slave);
	}

	if (0 == slave) {
		/* if opened in a new process, slave will be 0 (and */
		/* ultimately, 1 and 2 as well) */

		/* duplicate 0 onto 1 and 2 to prepare for stty */
		fcntl(0,F_DUPFD,1);
		fcntl(0,F_DUPFD,2);
	}

	ttytype(SET_TTYTYPE,slave,ttycopy,ttyinit,stty_args);
	return(slave);
}

setptyutmp()
{
	struct utmp utmp;

	if (seteuid(0) == -1) {		/* Need to be root */
		expDiagLog("setptyutmp:  setuid root errno=%d\n",errno);
		return(-1);
	}
	(void) time(&utmp.ut_time);
	utmp.ut_type = USER_PROCESS;
	utmp.ut_pid = getpid();
	strncpy(utmp.ut_user,myname,sizeof(utmp.ut_user));
	strncpy(utmp.ut_host,hostname,sizeof(utmp.ut_host));
	strncpy(utmp.ut_line,linet+5,sizeof(utmp.ut_line));
	strncpy(utmp.ut_id,linet+8,sizeof(utmp.ut_id));
	if (pututline(&utmp) == NULL) {
		expDiagLog("setptyutmp:  pututline failed\n");
	}
	endutent();
	if (seteuid(realuid) == -1)
		expDiagLog("setptyutmp:  seteuid user errno=%d\n",errno);
	return(0);
}

setptypid(pid)
int pid;
{
        int npty;

        for (npty = lowpty; npty <= highpty; npty++) {
                if (ptys[npty] < 0) {
                        expDiagLog("setptypid:  ttyp%03d pid=%d\n",npty,pid);
                        ptys[npty] = pid;
                        break;
                }
        }
}

ttyp_reset()
{
        int npty;

        if (seteuid(0) == -1) {		/* we need to be root! */
                expDiagLog("ttyp_reset:  seteuid root errno=%d\n",errno);
        }
        for (npty = lowpty; npty <= highpty; npty++) {
                if (ptys[npty] <= 0)
                        continue;

                (void) sprintf(linet, "/dev/ttyp%03d", npty);
                expDiagLog("ttyp_reset:  resetting %s, killing %d\n",
			linet,ptys[npty]);
                if (chown(linet,0,0) == -1) {
                        expDiagLog("ttyp_reset: chown %s errno=%d\n",linet,errno);
                }
                if (chmod(linet, 0666) == -1) {
                        expDiagLog("ttyp_reset: chmod %s errno=%d\n",linet,errno);
                }
                resetptyutmp();
                if (kill(ptys[npty],SIGKILL) == -1) {
                        expDiagLog("ttyp_reset:  kill pid=%d errno=%d\n",
                                ptys[npty],errno);
                }
        }
        if (seteuid(realuid) == -1) {   /* Back to who we really are */
                expDiagLog("ttyp_reset:  seteuid user errno=%d\n",errno);
        }
}

void
exp_pty_exit()
{
	ttyp_reset();
}

resetptyutmp()
{
        struct utmp utmp;

        (void) setutent ();
        /* set up entry to search for */
        (void) strncpy(utmp.ut_id, linet + strlen(linet) - 4,
                 sizeof (utmp.ut_id));
        utmp.ut_type = USER_PROCESS;

        /* position to entry in utmp file */
        if(getutid(&utmp) == NULL) {
                expDiagLog("resetptyutmp:  no utmp entry for %s\n",linet);
                return(-1);     /* no utmp entry for this line ??? */
        }

        /* set up the new entry */
        strncpy(utmp.ut_name,"",sizeof(utmp.ut_name));
        strncpy(utmp.ut_host,"",sizeof(utmp.ut_host));
        time(&utmp.ut_time);
        utmp.ut_type = DEAD_PROCESS;
        utmp.ut_exit.e_exit = 0;

        /* write out the entry */
        pututline(&utmp);

        /* close the file */
        (void) endutent();
        return(0);
}






Deleted tcldbg.h.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60






























































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

/* Dbg.h - Tcl Debugger include file

Written by: Don Libes, NIST, 3/23/93

Design and implementation of this program was paid for by U.S. tax
dollars.  Therefore it is public domain.  However, the author and NIST
would appreciate credit if this program or parts of it are used.

*/

/* _DEBUG or _DBG is just too likely, use something more unique */
#ifndef _NIST_DBG
#define _NIST_DBG

#include "tcl.h"

typedef int (Dbg_InterProc) _ANSI_ARGS_((Tcl_Interp *interp, ClientData data));
typedef int (Dbg_IgnoreFuncsProc) _ANSI_ARGS_((
			Tcl_Interp *interp,
			char *funcname));
typedef void (Dbg_OutputProc) _ANSI_ARGS_((
			Tcl_Interp *interp,
			char *output,
			ClientData data));

typedef struct {
  Dbg_InterProc *func;
  ClientData data;
} Dbg_InterStruct;

typedef struct {
  Dbg_OutputProc *func;
  ClientData data;
} Dbg_OutputStruct;

EXTERN char *Dbg_VarName;
EXTERN char *Dbg_DefaultCmdName;

/* trivial interface, creates a "debug" command in your interp */
EXTERN int Tcldbg_Init _ANSI_ARGS_((Tcl_Interp *));

EXTERN void Dbg_On _ANSI_ARGS_((Tcl_Interp *interp,
					int immediate));
EXTERN void Dbg_Off _ANSI_ARGS_((Tcl_Interp *interp));
EXTERN char **Dbg_ArgcArgv _ANSI_ARGS_((int argc,char *argv[],
					int copy));
EXTERN int Dbg_Active _ANSI_ARGS_((Tcl_Interp *interp));
EXTERN Dbg_InterStruct Dbg_Interactor _ANSI_ARGS_((
					Tcl_Interp *interp,
					Dbg_InterProc *interactor,
					ClientData data));
EXTERN Dbg_IgnoreFuncsProc *Dbg_IgnoreFuncs _ANSI_ARGS_((
					Tcl_Interp *interp,
					Dbg_IgnoreFuncsProc *));
EXTERN Dbg_OutputStruct Dbg_Output _ANSI_ARGS_((
					Tcl_Interp *interp,
					Dbg_OutputProc *,
					ClientData data));

#endif /* _NIST_DBG */






Changes to unix/expUnixSpawnChan.c.





1
2


3




4
5











































6





























7
8
9
10
11
12
13
























































































































































































14
15
16

17
18

19
20








21
22
23
24










































25
26
27
28



















29





30
31
32
33
34
35
36
37
38
39
40













































































































































































































41



1
2
3
4
5
6
7


8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81






82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267

268
269

270
271
272
273
274
275
276
277
278
279
280




281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351











352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557

-
-
+
+

+
+
+
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


-
+

-
+


+
+
+
+
+
+
+
+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+




+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


/*
 * expUnixSpawnChan.c --
/* 
 * expUnixChan.c
 *
 *	Channel driver for Expect channels.
 *      Based on UNIX File channel from tclUnixChan.c
 *
 */
 *	Implements the Unix specific portion of the exp_spawn
 *	channel id.

#include <sys/types.h>
#include <stdio.h>
#include <signal.h>
#include <errno.h>
#include <ctype.h>	/* for isspace */
#include <time.h>	/* for time(3) */

#include "expect_cf.h"

#ifdef HAVE_SYS_WAIT_H
#include <sys/wait.h>
#endif

#ifdef HAVE_UNISTD_H
# include <unistd.h>
#endif

#include	"tclInt.h"	/* Internal definitions for Tcl. */

#include "tcl.h"

#include "string.h"

#include "exp_rename.h"
#include "exp_prog.h"
#include "exp_command.h"
#include "exp_log.h"

static int		ExpCloseProc _ANSI_ARGS_((ClientData instanceData,
			    Tcl_Interp *interp));
static int		ExpInputProc _ANSI_ARGS_((ClientData instanceData,
		            char *buf, int toRead, int *errorCode));
static int		ExpOutputProc _ANSI_ARGS_((
			    ClientData instanceData, char *buf, int toWrite,
                            int *errorCode));
static void		ExpWatchProc _ANSI_ARGS_((ClientData instanceData,
		            int mask));
static int		ExpGetHandleProc _ANSI_ARGS_((ClientData instanceData,
		            int direction, ClientData *handlePtr));

/*
 * This structure describes the channel type structure for Expect-based IO:
 */

Tcl_ChannelType expChannelType = {
    "exp_spawn",				/* Type name. */
    /* Expect channels are always blocking */
    NULL,				/* Set blocking/nonblocking mode.*/
    ExpCloseProc,			/* Close proc. */
    ExpInputProc,			/* Input proc. */
    ExpOutputProc,			/* Output proc. */
    NULL,				/* Seek proc. */
    NULL,				/* Set option proc. */
    NULL,				/* Get option proc. */
    ExpWatchProc,			/* Initialize notifier. */
    ExpGetHandleProc,			/* Get OS handles out of channel. */
    NULL,				/* Close2 proc */
};

typedef struct ThreadSpecificData {
    /*
     * List of all exp channels currently open.  This is per thread and is
     * used to match up fd's to channels, which rarely occurs.
     */
    
    ExpState *firstExpPtr;
    int channelCount;	 /* this is process-wide as it is used to
			     give user some hint as to why a spawn has failed
			     by looking at process-wide resource usage */
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;

#include "exp_port.h"
#include "tclInt.h"
#include "tclPort.h"
#include "exp_command.h"

/*

/*
 *----------------------------------------------------------------------
 *
 * ExpInputProc --
 *
 *	This procedure is invoked from the generic IO level to read
 *	input from an exp-based channel.
 *
 * Results:
 *	The number of bytes read is returned or -1 on error. An output
 *	argument contains a POSIX error code if an error occurs, or zero.
 *
 * Side effects:
 *	Reads input from the input device of the channel.
 *
 *----------------------------------------------------------------------
 */

static int
ExpInputProc(instanceData, buf, toRead, errorCodePtr)
    ClientData instanceData;		/* Exp state. */
    char *buf;				/* Where to store data read. */
    int toRead;				/* How much space is available
                                         * in the buffer? */
    int *errorCodePtr;			/* Where to store error code. */
{
    ExpState *esPtr = (ExpState *) instanceData;
    int bytesRead;			/* How many bytes were actually
                                         * read from the input device? */

    *errorCodePtr = 0;
    
    /*
     * Assume there is always enough input available. This will block
     * appropriately, and read will unblock as soon as a short read is
     * possible, if the channel is in blocking mode. If the channel is
     * nonblocking, the read will never block.
     */

    bytesRead = read(esPtr->fdin, buf, (size_t) toRead);
    /*printf("ExpInputProc: read(%d,,) = %d\r\n",esPtr->fdin,bytesRead);*/
    if (bytesRead > -1) {
	/* strip parity if requested */
	if (esPtr->parity == 0) {
	    char *end = buf+bytesRead;
	    for (;buf < end;buf++) {
		*buf &= 0x7f;
	    }
	}
        return bytesRead;
    }
    *errorCodePtr = errno;
    return -1;
}

/*
 *----------------------------------------------------------------------
 *
 * ExpOutputProc--
 *
 *	This procedure is invoked from the generic IO level to write
 *	output to an exp channel.
 *
 * Results:
 *	The number of bytes written is returned or -1 on error. An
 *	output argument	contains a POSIX error code if an error occurred,
 *	or zero.
 *
 * Side effects:
 *	Writes output on the output device of the channel.
 *
 *----------------------------------------------------------------------
 */

static int
ExpOutputProc(instanceData, buf, toWrite, errorCodePtr)
    ClientData instanceData;		/* Exp state. */
    char *buf;				/* The data buffer. */
    int toWrite;			/* How many bytes to write? */
    int *errorCodePtr;			/* Where to store error code. */
{
    ExpState *esPtr = (ExpState *) instanceData;
    int written = 0;

    *errorCodePtr = 0;

    if (toWrite < 0) Tcl_Panic("ExpOutputProc: called with negative char count");

    while (toWrite > 0) {
	written = write(esPtr->fdout, buf, (size_t) toWrite);
	if (written == 0) {
	    /* This shouldn't happen but I'm told that it does
	     * nonetheless (at least on SunOS 4.1.3).  Since this is
	     * not a documented return value, the most reasonable
	     * thing is to complain here and retry in the hopes that
	     * it is some transient condition.  */
	    sleep(1);
	    expDiagLogU("write() failed to write anything - will sleep(1) and retry...\n");
	} else if (written < 0) {
	    *errorCodePtr = errno;
	    return -1;
	}
	buf += written;
	toWrite -= written;
    }
    return written;
}

/*
 *----------------------------------------------------------------------
 *
 * ExpCloseProc --
 *
 *	This procedure is called from the generic IO level to perform
 *	channel-type-specific cleanup when an exp-based channel is closed.
 *
 * Results:
 *	0 if successful, errno if failed.
 *
 * Side effects:
 *	Closes the device of the channel.
 *
 *----------------------------------------------------------------------
 */

/*ARGSUSED*/
static int
ExpCloseProc(instanceData, interp)
    ClientData instanceData;	/* Exp state. */
    Tcl_Interp *interp;		/* For error reporting - unused. */
{
    ExpState *esPtr = (ExpState *) instanceData;
    ExpState **nextPtrPtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    esPtr->registered = FALSE;

#if 0
    /*
      Really should check that we created one first.  Since we're sharing fds
      with Tcl, perhaps a filehandler was created with a plain tcl file - we
      wouldn't want to delete that.  Although if user really close Expect's
      user_spawn_id, it probably doesn't matter anyway.
    */

    Tcl_DeleteFileHandler(esPtr->fdin);
#endif /*0*/

    Tcl_DecrRefCount(esPtr->buffer);

    /* Actually file descriptor should have been closed earlier. */
    /* So do nothing here */

    /*
     * Conceivably, the process may not yet have been waited for.  If this
     * becomes a requirement, we'll have to revisit this code.  But for now, if
     * it's just Tcl exiting, the processes will exit on their own soon
     * anyway.
     */

    for (nextPtrPtr = &(tsdPtr->firstExpPtr); (*nextPtrPtr) != NULL;
	 nextPtrPtr = &((*nextPtrPtr)->nextPtr)) {
	if ((*nextPtrPtr) == esPtr) {
	    (*nextPtrPtr) = esPtr->nextPtr;
	    break;
	}
    }
    tsdPtr->channelCount--;

    if (esPtr->bg_status == blocked ||
	    esPtr->bg_status == disarm_req_while_blocked) {
	esPtr->freeWhenBgHandlerUnblocked = 1;
	/*
	 * If we're in the middle of a bg event handler, then the event
	 * handler will have to take care of freeing esPtr.
	 */
    } else {
	expStateFree(esPtr);
    }
    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * ExpPlatformSpawnOutput --
 * ExpWatchProc --
 *
 *	Write routine for exp_spawn channel
 *	Initialize the notifier to watch the fd from this channel.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Sets up the notifier so that a future event on the channel will
 *	be seen by Tcl.
 *
 *----------------------------------------------------------------------
 */
 *	Amount written or -1 with errorcode in errorPtr
 *    
 * Side Effects:
 *	None. 

static void
ExpWatchProc(instanceData, mask)
    ClientData instanceData;		/* The exp state. */
    int mask;				/* Events of interest; an OR-ed
                                         * combination of TCL_READABLE,
                                         * TCL_WRITABLE and TCL_EXCEPTION. */
{
    ExpState *esPtr = (ExpState *) instanceData;

    /*
     * Make sure we only register for events that are valid on this exp.
     * Note that we are passing Tcl_NotifyChannel directly to
     * Tcl_CreateExpHandler with the channel pointer as the client data.
     */

    mask &= esPtr->validMask;
    if (mask) {
	/*printf("  CreateFileHandler: %d (mask = %d)\r\n",esPtr->fdin,mask);*/
	Tcl_CreateFileHandler(esPtr->fdin, mask,
		(Tcl_FileProc *) Tcl_NotifyChannel,
		(ClientData) esPtr->channel);
    } else {
	/*printf("  DeleteFileHandler: %d (mask = %d)\r\n",esPtr->fdin,mask);*/
	Tcl_DeleteFileHandler(esPtr->fdin);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * ExpGetHandleProc --
 *
 *	Called from Tcl_GetChannelHandle to retrieve OS handles from
 *	an exp-based channel.
 *
 * Results:
 *	Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if
 *	there is no handle for the specified direction. 
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static int
ExpGetHandleProc(instanceData, direction, handlePtr)
    ClientData instanceData;	/* The exp state. */
    int direction;		/* TCL_READABLE or TCL_WRITABLE */
    ClientData *handlePtr;	/* Where to store the handle.  */
{
    ExpState *esPtr = (ExpState *) instanceData;

    if (direction & TCL_WRITABLE) {
	*handlePtr = (ClientData) esPtr->fdin;
    }
    if (direction & TCL_READABLE) {
	*handlePtr = (ClientData) esPtr->fdin;
    } else {
	return TCL_ERROR;
    }
    return TCL_OK;
}

int
expChannelCountGet()
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    return tsdPtr->channelCount;
}
ExpPlatformSpawnOutput(instanceData, bufPtr, toWrite, errorPtr)
    ClientData instanceData;
    char *bufPtr;		/* (in) Ptr to buffer */
    int toWrite;		/* (in) amount to write */
    int *errorPtr;		/* (out) error code */
{
    ExpSpawnState *ssPtr = (ExpSpawnState *) instanceData;
    Tcl_Channel channelPtr = ssPtr->channelPtr;

    return (Tcl_GetChannelType(channelPtr)->outputProc)
	(Tcl_GetChannelInstanceData(channelPtr), bufPtr, toWrite, errorPtr);

int
expSizeGet(esPtr)
    ExpState *esPtr;
{
    int len;
    Tcl_GetStringFromObj(esPtr->buffer,&len);
    return len;
}

int
expSizeZero(esPtr)
    ExpState *esPtr;
{
    int len;
    Tcl_GetStringFromObj(esPtr->buffer,&len);
    return (len == 0);
}

void
expStateFree(esPtr)
    ExpState *esPtr;
{
  if (esPtr->fdBusy) {
    close(esPtr->fdin);
  }

    esPtr->valid = FALSE;
    
    if (!esPtr->keepForever) {
	ckfree((char *)esPtr);
    }
}

/* close all connections
 * 
 * The kernel would actually do this by default, however Tcl is going to come
 * along later and try to reap its exec'd processes.  If we have inherited any
 * via spawn -open, Tcl can hang if we don't close the connections first.
 */
void
exp_close_all(interp)
Tcl_Interp *interp;
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    ExpState *esPtr;

    /* no need to keep things in sync (i.e., tsdPtr, count) since we could only
       be doing this if we're exiting.  Just close everything down. */

    for (esPtr = tsdPtr->firstExpPtr;esPtr;esPtr = esPtr->nextPtr) {
	exp_close(interp,esPtr);
    }
}

/* wait for any of our own spawned processes we call waitpid rather
 * than wait to avoid running into someone else's processes.  Yes,
 * according to Ousterhout this is the best way to do it.
 * returns the ExpState or 0 if nothing to wait on */
ExpState *
expWaitOnAny()
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    int result;
    ExpState *esPtr;

    for (esPtr = tsdPtr->firstExpPtr;esPtr;esPtr = esPtr->nextPtr) {
	if (esPtr->pid == exp_getpid) continue; /* skip ourself */
	if (esPtr->user_waited) continue;	/* one wait only! */
	if (esPtr->sys_waited) break;
      restart:
	result = waitpid(esPtr->pid,&esPtr->wait,WNOHANG);
	if (result == esPtr->pid) break;
	if (result == 0) continue;	/* busy, try next */
	if (result == -1) {
	    if (errno == EINTR) goto restart;
	    else break;
	}
    }
    return esPtr;
}

ExpState *
expWaitOnOne() {
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    ExpState *esPtr;
    int pid;
    /* should really be recoded using the common wait code in command.c */
    WAIT_STATUS_TYPE status;

    pid = wait(&status);
    for (esPtr = tsdPtr->firstExpPtr;esPtr;esPtr = esPtr->nextPtr) {
	if (esPtr->pid == pid) {
	    esPtr->sys_waited = TRUE;
	    esPtr->wait = status;
	    return esPtr;
	}
    }
}

void
exp_background_channelhandlers_run_all()
{
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    ExpState *esPtr;

    /* kick off any that already have input waiting */
    for (esPtr = tsdPtr->firstExpPtr;esPtr;esPtr = esPtr->nextPtr) {
	/* is bg_interp the best way to check if armed? */
	if (esPtr->bg_interp && !expSizeZero(esPtr)) {
	    exp_background_channelhandler((ClientData)esPtr,0);
	}
    }
}

ExpState *
expCreateChannel(interp,fdin,fdout,pid)
    Tcl_Interp *interp;
    int fdin;
    int fdout;
    int pid;
{
    ExpState *esPtr;
    int mask;
    Tcl_ChannelType *channelTypePtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    channelTypePtr = &expChannelType;

    esPtr = (ExpState *) ckalloc((unsigned) sizeof(ExpState));

    esPtr->nextPtr = tsdPtr->firstExpPtr;
    tsdPtr->firstExpPtr = esPtr;

    sprintf(esPtr->name,"exp%d",fdin);

    /*
     * For now, stupidly assume this.  We we will likely have to revisit this
     * later to prevent people from doing stupid things.
     */
    mask = TCL_READABLE | TCL_WRITABLE;

    /* not sure about this - what about adopted channels */
    esPtr->validMask = mask | TCL_EXCEPTION;
    esPtr->fdin = fdin;
    esPtr->fdout = fdout;

    /* set close-on-exec for everything but std channels */
    /* (system and stty commands need access to std channels) */
    if (fdin != 0 && fdin != 2) {
      expCloseOnExec(fdin);
      if (fdin != fdout) expCloseOnExec(fdout);
    }

    esPtr->fdBusy = FALSE;
    esPtr->channel = Tcl_CreateChannel(channelTypePtr, esPtr->name,
	    (ClientData) esPtr, mask);
    Tcl_RegisterChannel(interp,esPtr->channel);
    esPtr->registered = TRUE;
    Tcl_SetChannelOption(interp,esPtr->channel,"-buffering","none");
    Tcl_SetChannelOption(interp,esPtr->channel,"-blocking","0");
    Tcl_SetChannelOption(interp,esPtr->channel,"-translation","lf");

    esPtr->pid = pid;
    esPtr->msize = 0;

    /* initialize a dummy buffer */
    esPtr->buffer = Tcl_NewStringObj("",0);
    Tcl_IncrRefCount(esPtr->buffer);
    esPtr->umsize = exp_default_match_max;
    /* this will reallocate object with an appropriate sized buffer */
    expAdjust(esPtr);

    esPtr->printed = 0;
    esPtr->echoed = 0;
    esPtr->rm_nulls = exp_default_rm_nulls;
    esPtr->parity = exp_default_parity;
    esPtr->key = expect_key++;
    esPtr->force_read = FALSE;
    esPtr->fg_armed = FALSE;
    esPtr->channel_orig = 0;
    esPtr->fd_slave = EXP_NOFD;
#ifdef HAVE_PTYTRAP
    esPtr->slave_name = 0;
#endif /* HAVE_PTYTRAP */
    esPtr->open = TRUE;
    esPtr->notified = FALSE;
    esPtr->user_waited = FALSE;
    esPtr->sys_waited = FALSE;
    esPtr->bg_interp = 0;
    esPtr->bg_status = unarmed;
    esPtr->bg_ecount = 0;
    esPtr->freeWhenBgHandlerUnblocked = FALSE;
    esPtr->keepForever = FALSE;
    esPtr->valid = TRUE;
    tsdPtr->channelCount++;

    return esPtr;
}

void
expChannelInit() {
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    tsdPtr->channelCount = 0;
}






Added win/.gitignore.











1
2
3
4
5

+
+
+
+
+

*.ncb
*.opt
*.plg
Debug
Release






Deleted win/Dbg_cf.h.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17



















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

/* This file is only to be included by the Debugger itself. */
/* Applications should only include Dbg.h. */

/*
 * Check for headers
 */
#ifndef __NIST_DBG_CF_H__
#define __NIST_DBG_CF_H__

#undef NO_STDLIB_H		/* Tcl requires this name */

/*
 * Check for functions
 */
#define HAVE_STRCHR

#endif	/* __NIST_DBG_CF_H__ */






Added win/buildfiles.dsp.




















































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

# Microsoft Developer Studio Project File - Name="buildfiles" - Package Owner=<4>
# Microsoft Developer Studio Generated Build File, Format Version 6.00
# ** DO NOT EDIT **

# TARGTYPE "Win32 (x86) Generic Project" 0x010a

CFG=buildfiles - Win32 Release
!MESSAGE This is not a valid makefile. To build this project using NMAKE,
!MESSAGE use the Export Makefile command and run
!MESSAGE 
!MESSAGE NMAKE /f "buildfiles.mak".
!MESSAGE 
!MESSAGE You can specify a configuration when running NMAKE
!MESSAGE by defining the macro CFG on the command line. For example:
!MESSAGE 
!MESSAGE NMAKE /f "buildfiles.mak" CFG="buildfiles - Win32 Release"
!MESSAGE 
!MESSAGE Possible choices for configuration are:
!MESSAGE 
!MESSAGE "buildfiles - Win32 Release" (based on "Win32 (x86) Generic Project")
!MESSAGE 

# Begin Project
# PROP AllowPerConfigDependencies 0
# PROP Scc_ProjName ""
# PROP Scc_LocalPath ""
MTL=midl.exe
# PROP BASE Use_MFC 0
# PROP BASE Use_Debug_Libraries 0
# PROP BASE Output_Dir ""
# PROP BASE Intermediate_Dir ""
# PROP BASE Target_Dir ""
# PROP Use_MFC 0
# PROP Use_Debug_Libraries 0
# PROP Output_Dir ""
# PROP Intermediate_Dir ""
# PROP Target_Dir ""
# Begin Target

# Name "buildfiles - Win32 Release"
# Begin Source File

SOURCE=.\makefile.vc32
# End Source File
# Begin Source File

SOURCE=..\makefile.win
# End Source File
# Begin Source File

SOURCE=.\mkbc32.mif
# End Source File
# Begin Source File

SOURCE=..\mkconfig.mif
# End Source File
# Begin Source File

SOURCE=.\mkfiles.mif
# End Source File
# Begin Source File

SOURCE=.\mkmgw32.mif
# End Source File
# Begin Source File

SOURCE=.\mkprepvc32.mif
# End Source File
# Begin Source File

SOURCE=.\mkvc32.mif
# End Source File
# Begin Source File

SOURCE=.\mkwc32.mif
# End Source File
# End Target
# End Project






Deleted win/expAlloc.c.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27





























-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

#include <tcl.h>
#include <stdlib.h>

#undef ckalloc
#undef ckfree
#undef ckrealloc

char *
Tcl_Alloc(size)
    unsigned int size;
{
    return (char *) malloc(size);
}

void
Tcl_Free(char *ptr)
{
    free(ptr);
}

char *
Tcl_Realloc(ptr, size)
    char *ptr;
    unsigned int size;
{
    return (char *) realloc(ptr, size);
}






Deleted win/expDString.c.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147





















































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

/* 
 * tclUtil.c --
 *
 *	This file contains utility procedures that are used by many Tcl
 *	commands.
 *
 * Copyright (c) 1987-1993 The Regents of the University of California.
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tclUtil.c 1.129 97/01/21 14:06:35
 */

#include <tclInt.h>
#include <stdlib.h>
#include <string.h>

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DStringInit --
 *
 *	Initializes a dynamic string, discarding any previous contents
 *	of the string (Tcl_DStringFree should have been called already
 *	if the dynamic string was previously in use).
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The dynamic string is initialized to be empty.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_DStringInit(dsPtr)
    register Tcl_DString *dsPtr;	/* Pointer to structure for
					 * dynamic string. */
{
    dsPtr->string = dsPtr->staticSpace;
    dsPtr->length = 0;
    dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
    dsPtr->staticSpace[0] = 0;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DStringAppend --
 *
 *	Append more characters to the current value of a dynamic string.
 *
 * Results:
 *	The return value is a pointer to the dynamic string's new value.
 *
 * Side effects:
 *	Length bytes from string (or all of string if length is less
 *	than zero) are added to the current value of the string. Memory
 *	gets reallocated if needed to accomodate the string's new size.
 *
 *----------------------------------------------------------------------
 */

char *
Tcl_DStringAppend(dsPtr, string, length)
    register Tcl_DString *dsPtr;	/* Structure describing dynamic
					 * string. */
    CONST char *string;			/* String to append.  If length is
					 * -1 then this must be
					 * null-terminated. */
    int length;				/* Number of characters from string
					 * to append.  If < 0, then append all
					 * of string, up to null at end. */
{
    int newSize;
    char *newString, *dst, *end;

    if (length < 0) {
	length = strlen(string);
    }
    newSize = length + dsPtr->length;

    /*
     * Allocate a larger buffer for the string if the current one isn't
     * large enough. Allocate extra space in the new buffer so that there
     * will be room to grow before we have to allocate again.
     */

    if (newSize >= dsPtr->spaceAvl) {
	dsPtr->spaceAvl = newSize*2;
	newString = (char *) ckalloc((unsigned) dsPtr->spaceAvl);
	memcpy((VOID *) newString, (VOID *) dsPtr->string,
		(size_t) dsPtr->length);
	if (dsPtr->string != dsPtr->staticSpace) {
	    ckfree(dsPtr->string);
	}
	dsPtr->string = newString;
    }

    /*
     * Copy the new string into the buffer at the end of the old
     * one.
     */

    for (dst = (char *) dsPtr->string + dsPtr->length, end = (char *) string+length;
	    string < end; string++, dst++) {
	*dst = *string;
    }
    *dst = 0;
    dsPtr->length += length;
    return dsPtr->string;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DStringFree --
 *
 *	Frees up any memory allocated for the dynamic string and
 *	reinitializes the string to an empty state.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The previous contents of the dynamic string are lost, and
 *	the new value is an empty string.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_DStringFree(dsPtr)
    register Tcl_DString *dsPtr;	/* Structure describing dynamic
					 * string. */
{
    if (dsPtr->string != dsPtr->staticSpace) {
	ckfree(dsPtr->string);
    }
    dsPtr->string = dsPtr->staticSpace;
    dsPtr->length = 0;
    dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
    dsPtr->staticSpace[0] = 0;
}






Changes to win/expWin.h.






︙


20
21
22
23
24
25
26




27
28



29
30
31
32
33
34
35
36
37
38


39
40
41
42
43
44
45
46
47



48
49
50
51
52

53
54
55
56








20
21
22
23
24
25
26
27
28
29
30


31
32
33
34
35
36
37
38
39
40
41
42

43
44
45
46
47
48
49
50



51
52
53
54
55
56
57

58




59
60
61
62
63
64
65








+
+
+
+
-
-
+
+
+









-
+
+






-
-
-
+
+
+




-
+
-
-
-
-
+
+
+
+
+
+
+

/*
 * Define the types of attempts to use to kill the subprocess
 */
#define EXP_KILL_TERMINATE  0x1
#define EXP_KILL_CTRL_C     0x2
#define EXP_KILL_CTRL_BREAK 0x4

/*
 * Errors and logging
 */
#define FILEPOSINFO			__FILE__ "(" STRINGIFY(__LINE__) ")"
#define EXP_LOG(format, args) \
    ExpSyslog("Expect SlaveDriver (%s: %d): " format, __FILE__, __LINE__, args)
#define EXP_LOG0(errCode)		ExpSyslog(errCode, FILEPOSINFO, 0)
#define EXP_LOG1(errCode, arg1)		ExpSyslog(errCode, FILEPOSINFO, arg1, 0)
#define EXP_LOG2(errCode, arg1, arg2)	ExpSyslog(errCode, FILEPOSINFO, arg1, arg2, 0)

/*
 * The following defines identify the various types of applications that 
 * run under windows.  There is special case code for the various types.
 */

#define EXP_APPL_NONE	0
#define EXP_APPL_DOS	1
#define EXP_APPL_WIN3X	2
#define EXP_APPL_WIN32	3
#define EXP_APPL_WIN32CUI	3
#define EXP_APPL_WIN32GUI	4

typedef struct {
    Tcl_Channel channelPtr;
    int toWrite;
} ExpSpawnState;

extern DWORD		ExpApplicationType(const char *originalName,
			    char *fullPath, char *imageName);
extern DWORD		ExpCreateProcess(int argc, char **argv,
extern DWORD		ExpApplicationType (const char *originalName,
			    char *fullPath);
extern DWORD		ExpCreateProcess (int argc, char **argv,
			    HANDLE inputHandle, HANDLE outputHandle,
			    HANDLE errorHandle, int allocConsole,
			    int hideConsole, int debug, int newProcessGroup,
			    Tcl_Pid *pidPtr, PDWORD globalPidPtr);
EXTERN Tcl_Channel	ExpCreateSpawnChannel _ANSI_ARGS_((Tcl_Interp *,
extern Tcl_Channel	ExpCreateSpawnChannel (Tcl_Interp *, Tcl_Channel chan);
			    Tcl_Channel chan));
extern void		ExpSyslog TCL_VARARGS(char *,fmt);
extern Tcl_Pid		Exp_WaitPid(Tcl_Pid pid, int *statPtr, int options);
extern void		Exp_KillProcess(Tcl_Pid pid);
extern void		ExpSyslog TCL_VARARGS(DWORD,arg1);
extern TCHAR*		ExpSyslogGetSysMsg (DWORD);
extern Tcl_Pid		Exp_WaitPid (Tcl_Pid pid, int *statPtr, int options);
extern void		Exp_KillProcess (Tcl_Pid pid);
extern void		ExpInitWinProcessAPI (void);
extern int		ExpDynloadTclStubs (void);







Changes to win/expWinCommand.c.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18



19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106

1
2
3
4
5
6
7
8
9
10
11
12

13
14



15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37





























































38
39
40
41
42
43
44













-


-
-
-
+
+
+




















-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-








/*
 * expWinCommand.c --
 *
 *	Implements Windows NT specific parts required by expCommand.c.
 *
 * Copyright (c) 1997 by Mitel Corporation
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 */

#include "exp_port.h"
#include "tclInt.h"
#include "tclPort.h"
#include "tclWinInt.h"
#include "expWin.h"
#include "expect_tcl.h"
//#include "tclWinInt.h"
#include "expect_tcl.h"
#include "expWin.h"
#include "exp_command.h"
#include "exp_rename.h"
#include "exp_log.h"
#include "exp_event.h"
#include "exp_prog.h"
#include "exp_tty.h"

#ifdef TCL_DEBUGGER
#include "Dbg.h"
#endif

/*
 * Arbitrary, but this is the port we are going to use for communicating
 * with the slave driver.
 */
#define SLAVE_PORT	9877

static void ExpSockAcceptProc _ANSI_ARGS_((ClientData callbackData,
        Tcl_Channel chan, char *address, int port));

/*
 *----------------------------------------------------------------------
 *
 * exp_f_new_platform --
 *
 *	Platform specific initialization of exp_f structure
 *
 * Results:
 *	TRUE if successful, FALSE if unsuccessful.
 *
 * Side Effects:
 *	None
 *
 *----------------------------------------------------------------------
 */

int
exp_f_new_platform(f)
    struct exp_f *f;
{
    if (EXP_NOPID != f->pid) {
	f->tclPid = (Tcl_Pid)
	    OpenProcess(PROCESS_ALL_ACCESS, FALSE, f->pid);
	TclWinAddProcess((HANDLE) f->tclPid, f->pid);
    } else {
	f->tclPid = (Tcl_Pid) INVALID_HANDLE_VALUE;
    }

    /* WIN32 only fields */
    f->over.hEvent = NULL;
    return TRUE;
}

/*
 *----------------------------------------------------------------------
 *
 * exp_f_free_platform --
 *
 *	Frees any platform specific pieces of the exp_f structure.
 *
 * Results:
 *	None
 *
 *----------------------------------------------------------------------
 */

void
exp_f_free_platform(f)
    struct exp_f *f;
{
    if (f->tclPid != (Tcl_Pid) INVALID_HANDLE_VALUE) {
	__try {
	    CloseHandle((HANDLE) f->tclPid);
	}
	__except (GetExceptionCode()) {};
    }
    if (f->over.hEvent) {
	CloseHandle(f->over.hEvent);
	f->over.hEvent = NULL;
    }
}

void
exp_close_on_exec(fd)
    int fd;
{
    /* This is here for place keeping purposes */
}




︙


142
143
144
145
146
147
148
149

150
151
152
153
154
155
156

80
81
82
83
84
85
86

87
88
89
90
91
92
93
94








-
+








 * NT Notes:
 *	This whole thing is complicated immensely by NT's lack of
 *	flexibility when dealing with console processes.  For one,
 *	a console process cannot have simultaneous access to more
 *	than once console.  There is no way to call DuplicateHandle()
 *	on a console handle so a single executable could control
 *	multiple consoles.  This leaves one option: execute slave
 *	controllers who allocate their own consoles and then control.
 *	controllers who allocate their own consoles and then control
 *	the actual slave.  The normal expect process communicates
 *	with these slave drivers over pipes.  There is still one
 *	remaining problem: consoles pop up on the screen.  When
 *	creating the subprocesses, force them to allocate new
 *	consoles, but tell them to hide the consoles.  This should
 *	make everyone happy.  For debugging, leave the consoles
 *	visible as this shows us that something is happening.  Another




︙


541
542
543
544
545
546
547
548

549
550
551
552
553
554
555

479
480
481
482
483
484
485

486
487
488
489
490
491
492
493








-
+








    f->over.hEvent = hEvent;
    f->channel = spawnChan;
    f->Master = channel;

    debuglog("parent: now unsynchronized from child\r\n");

    /* tell user id of new process */
    Tcl_SetVar(interp, EXP_SPAWN_ID_VARNAME, Tcl_GetChannelName(spawnChan), 0);
    Tcl_SetVar(interp, SPAWN_ID_VARNAME, Tcl_GetChannelName(spawnChan), 0);

    Tcl_RegisterChannel(interp, spawnChan);

    sprintf(interp->result,"%d",(int) globalPid);
    debuglog("spawn: returns {%s}\r\n",interp->result);
    ckfree((char *) nargv);
    return(TCL_OK);




︙





Added win/expWinDynloadTclStubs.c.





















































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

#include "tclPort.h"
#include "expWin.h"
#include "spawndrvmc.h"

int
ExpDynloadTclStubs (void)
{
    TCHAR TclDLLPath[MAX_PATH+1];
    HMODULE hTclMod;
    typedef Tcl_Interp *(*LPFN_createInterpProc) ();
    LPFN_createInterpProc createInterpProc;
    Tcl_Interp *interp;
    char appname[MAX_PATH+1];


    if (GetEnvironmentVariable(_T("EXP_TCLDLL"), TclDLLPath, MAX_PATH)) {
	/* Load it */
	if (!(hTclMod = LoadLibrary(TclDLLPath))) {
	    EXP_LOG1(MSG_STUBS_TCLDLLCANTFIND, TclDLLPath);
	}

	/* LoadLibrary() loaded the module correctly.
	 * Get the location of Tcl_CreateInterp. */
	
	if ((createInterpProc = (LPFN_createInterpProc) GetProcAddress(hTclMod,
	    _T("Tcl_CreateInterp"))) == NULL) {
	    EXP_LOG1(MSG_STUBS_NOCREATEINTERP, TclDLLPath);
	}
	interp = createInterpProc();
	if (Tcl_InitStubs(interp, "8.1", 0) == NULL) {
	    EXP_LOG1(MSG_STUBS_INITSTUBS, interp->result);
	}

	/* Discover the calling application.
	 * Use the ascii API to be safe. */
	GetModuleFileNameA(NULL, appname, MAX_PATH);
	Tcl_FindExecutable(appname);

	/* we're done initializing the core, and now don't need this
	 * interp anymore. */
	Tcl_DeleteInterp(interp);
    } else {
	/* envar not found */
	EXP_LOG0(MSG_STUBS_ENVARNOTSET);
    }
    return 1;
}






Changes to win/expWinLog.c.






︙


8
9
10
11
12
13
14

15
16
17



18




19












20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38

39
40

41
42
43





44

45
46
47
48



































49



50



51
52



53
54
55
56
























































































































































8
9
10
11
12
13
14
15



16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54

55
56

57
58


59
60
61
62
63
64
65




66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104

105
106
107
108
109
110
111
112




113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263








+
-
-
-
+
+
+

+
+
+
+

+
+
+
+
+
+
+
+
+
+
+
+


















-
+

-
+

-
-
+
+
+
+
+

+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
-
+
+
+


+
+
+
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

 * Copyright (c) 1997 Mitel Corporation
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 */

#define STRICT    /* ask windows.h to be agressive about the HANDLE type */
#include "tcl.h"
#include "tclPort.h"
#include "expWin.h"
#include "tclPort.h"
#include "expWin.h"
#include "spawndrvmc.h"

#ifdef _MSC_VER
#   pragma comment (lib, "advapi32.lib")
#endif

static HANDLE hSyslog = NULL;
static HANDLE hToken;
static TOKEN_USER *hUserTokPtr;
static TCHAR sysMsgSpace[1024];

/* local protos */
static void ExpNTLog (DWORD errCode, char *errData[], int cnt);
static TCHAR *Exp95Log (DWORD errCode, char *errData[], int cnt);
static void AddEventSource();

#define GETSEVERITY(code)   (UCHAR)((code >> 30) & 0x3) 
#define GETFACILITY(code)   (WORD)((code >> 16) & 0x0FFF)
#define GETCODE(code)	    (WORD)(code & 0xFFFF)

/*
 *----------------------------------------------------------------------
 *
 * ExpSyslog --
 *
 *	Logs error messages to the system application event log.
 *	It is normally called through the macro EXP_LOG() when
 *	errors occur in the slave driver process, but it can be
 *	used elsewhere.
 *
 * Results:
 *	None
 *
 *----------------------------------------------------------------------
 */

void
ExpSyslog TCL_VARARGS_DEF(char *,arg1)
ExpSyslog TCL_VARARGS_DEF(DWORD,arg1)
{
    char *fmt;
    DWORD errCode;
    va_list args;
    char buf[16384];
    char *strings[1];
    char *errData[10];
    int cnt = 0;
    TCHAR *errMsg;
    static TCHAR codeBuf[33];
    DWORD dwWritten;

    /* Get the error code */
    fmt = TCL_VARARGS_START(char *,arg1,args);
    
    if (hSyslog == NULL) {
	hSyslog = OpenEventLog(NULL, "ExpectSlaveDrv");
    errCode = TCL_VARARGS_START(DWORD,arg1,args);

    /* Get the file info */
    errData[cnt++] = va_arg(args, char *);

    /* Set the textual severity */
    switch(GETSEVERITY(errCode)) {
	case STATUS_SEVERITY_WARNING:
	    errData[cnt++] = _T("Warning"); break;
	case STATUS_SEVERITY_SUCCESS:
	    errData[cnt++] = _T("Success"); break;
	case STATUS_SEVERITY_INFORMATIONAL:
	    errData[cnt++] = _T("Info"); break;
	case STATUS_SEVERITY_FATAL:
	    errData[cnt++] = _T("Fatal"); break;
    }

    /* Set the textual Facility */
    switch(GETFACILITY(errCode)) {
	case FACILITY_WINSOCK:
	    errData[cnt++] = _T("Winsock IPC"); break;
	case FACILITY_SYSTEM:
	    errData[cnt++] = _T("System"); break;
	case FACILITY_STUBS:
	    errData[cnt++] = _T("Stubs"); break;
	case FACILITY_NAMEDPIPE:
	    errData[cnt++] = _T("NamedPipe IPC"); break;
	case FACILITY_MSPROTO:
	    errData[cnt++] = _T("Master/Slave Protocol"); break;
	case FACILITY_MAILBOX:
	    errData[cnt++] = _T("MailBoxing IPC"); break;
	case FACILITY_IO:
	    errData[cnt++] = _T("I/O general"); break;
	case FACILITY_DBGTRAP:
	    errData[cnt++] = _T("Debug/Trap"); break;
    }
    /* Set the textual Code */
    errData[cnt++] = codeBuf;
    wsprintf(codeBuf, "0x%04X", GETCODE(errCode));
    vsprintf(buf, fmt, args);

    /* set everyone else */
    while ((errData[cnt] = va_arg(args, char *)) != NULL) cnt++;
    va_end(args);

    /* format this error according to the message catalog contained in the exe. */
    errMsg = Exp95Log(errCode, errData, cnt);
    OutputDebugString(errMsg);
    strings[0] = buf;
    ReportEvent(hSyslog, EVENTLOG_ERROR_TYPE, 0, 0, NULL, 1, 0,
		strings, NULL);
}

    /* If running under NT, also save this error in the event log. */
    /* TODO: add platform test */
    ExpNTLog(errCode, errData, cnt);

    if (GETSEVERITY(errCode) & STATUS_SEVERITY_FATAL) {
	/* I could have used printf() and fflush(), but chose the direct
	 * route instead */
	WriteFile(GetStdHandle(STD_OUTPUT_HANDLE), errMsg, _tcslen(errMsg),
		&dwWritten, NULL);

	/* Stop the world, I want to get off. */
	DebugBreak();

	Sleep(5000);
	ExitProcess(255);
    }

    LocalFree(errMsg);
}

TCHAR *ExpSyslogGetSysMsg (DWORD id)
{
    int chars;

    chars = wsprintf(sysMsgSpace, "[%d] ", id);

    FormatMessage(
	    FORMAT_MESSAGE_FROM_SYSTEM |
	    FORMAT_MESSAGE_MAX_WIDTH_MASK,
	    NULL,
	    id,
	    0,
	    (LPVOID) &sysMsgSpace[chars],
	    (1024-chars),
	    0);

    return sysMsgSpace;
}

TCHAR *Exp95Log(DWORD errCode, char *errData[], int cnt)
{
    TCHAR *msg;

    FormatMessage(
	    FORMAT_MESSAGE_FROM_HMODULE |
	    FORMAT_MESSAGE_ALLOCATE_BUFFER |
	    FORMAT_MESSAGE_ARGUMENT_ARRAY,
	    GetModuleHandle(NULL),
	    errCode,
	    0,
	    (LPVOID) &msg,
	    0,
	    errData);

    return msg;
}

void ExpNTLog (DWORD errCode, char *errData[], int cnt)
{
    DWORD dwSize = 0;
    WORD wSev;

    /* Write-out the registry data each time */
    AddEventSource();
    hSyslog = RegisterEventSource(NULL, _T("ExpectSlaveDrv"));

    /* aquire the user SID */
    OpenProcessToken(GetCurrentProcess(), TOKEN_READ, &hToken);
    GetTokenInformation(hToken, TokenUser, NULL, dwSize, &dwSize);
    hUserTokPtr = (PTOKEN_USER) GlobalAlloc(GPTR, dwSize);
    GetTokenInformation(hToken, TokenUser, hUserTokPtr, dwSize, &dwSize);

    switch(GETSEVERITY(errCode)) {
	case STATUS_SEVERITY_WARNING:
	    wSev = EVENTLOG_WARNING_TYPE; break;
	case STATUS_SEVERITY_SUCCESS:
	case STATUS_SEVERITY_INFORMATIONAL:
	    wSev = EVENTLOG_INFORMATION_TYPE; break;
	case STATUS_SEVERITY_FATAL:
	    wSev = EVENTLOG_ERROR_TYPE; break;
    }

    ReportEvent(hSyslog, wSev, GETFACILITY(errCode), errCode,
	    hUserTokPtr->User.Sid, cnt, 0, errData, NULL);
    GlobalFree(hUserTokPtr);
    DeregisterEventSource(hSyslog);
}

void AddEventSource()
{
    HKEY hk; 
    DWORD dwData; 
    TCHAR szBuf[MAX_PATH];
    int len;
 
    /*
     * Add your source name as a subkey under the Application 
     * key in the EventLog registry key. 
     */
    RegCreateKey(HKEY_LOCAL_MACHINE, 
	_T("SYSTEM\\CurrentControlSet\\Services\\EventLog\\Application\\ExpectSlaveDrv"),
	&hk); 

    /*
     * Set the name of the message file.  This is us, literally.
     */
    len = GetModuleFileName(GetModuleHandle(NULL), szBuf, MAX_PATH);

    /*
     * Add the name to the EventMessageFile subkey.
     */
    RegSetValueEx(hk,
            _T("EventMessageFile"),
            0,
            REG_EXPAND_SZ,
            (LPBYTE) szBuf,
            (len + 1));

    /* We also do catagories, too. */
    RegSetValueEx(hk,
            _T("CategoryMessageFile"),
            0,
            REG_EXPAND_SZ,
            (LPBYTE) szBuf,
            (len + 1));

    /* Last catagory (facility) */
    dwData = FACILITY_MSPROTO; 

    RegSetValueEx(hk,
            _T("CategoryCount"),
            0,
            REG_DWORD,
            (LPBYTE) &dwData,
            sizeof(DWORD));

    /* Set the supported event types in the TypesSupported subkey. */

    dwData = EVENTLOG_ERROR_TYPE | EVENTLOG_WARNING_TYPE | 
        EVENTLOG_INFORMATION_TYPE; 

    RegSetValueEx(hk,
            _T("TypesSupported"),
            0,
            REG_DWORD,
            (LPBYTE) &dwData,
            sizeof(DWORD));

    RegCloseKey(hk); 
}






Changes to win/expWinPort.h.






︙


10
11
12
13
14
15
16

17
18
19
20
21
22

10
11
12
13
14
15
16
17
18
19
20
21
22
23








+







 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 */

#ifndef _EXPWINPORT_H
#define _EXPWINPORT_H

#define _WINSOCKAPI_  /* avoid sourcing winsock.h, so winsock2.h can be used instead. */
#include <windows.h>
#include <time.h>

#define HAVE_SV_TIMEZONE 1

#endif /* _EXPWINPORT_H */






Changes to win/expWinProcess.c.






︙


9
10
11
12
13
14
15
16

17
18
19
20
21
22
23
24
25
26
27
28
29
30
31





























































32
33
34
35
36
37
38
39
40
41
42
43
44


45
46
47
48
49
50
51

9
10
11
12
13
14
15

16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114








-
+















+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+













+
+








 * Copyright (c) 1997 Mitel Corporation
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 */

#include "tcl.h"
#define STRICT    /* ask windows.h to agressive about the HANDLE type */
#include "tclPort.h"
#include "expWin.h"

/*
 * This list is used to map from pids to process handles.
 */

typedef struct ProcInfo {
    HANDLE hProcess;
    DWORD dwProcessId;
    struct ProcInfo *nextPtr;
} ProcInfo;

static ProcInfo *procList = NULL;


typedef struct {
    int useWide;
    HANDLE (WINAPI *createFileProc)(CONST TCHAR *, DWORD, DWORD, 
	    LPSECURITY_ATTRIBUTES, DWORD, DWORD, HANDLE);
    BOOL (WINAPI *createProcessProc)(CONST TCHAR *, TCHAR *, 
	    LPSECURITY_ATTRIBUTES, LPSECURITY_ATTRIBUTES, BOOL, DWORD, 
	    LPVOID, CONST TCHAR *, LPSTARTUPINFOA, LPPROCESS_INFORMATION);
    DWORD (WINAPI *getFileAttributesProc)(CONST TCHAR *);
    DWORD (WINAPI *getShortPathNameProc)(CONST TCHAR *, WCHAR *, DWORD); 
    DWORD (WINAPI *searchPathProc)(CONST TCHAR *, CONST TCHAR *, 
	    CONST TCHAR *, DWORD, WCHAR *, TCHAR **);
} ExpWinProcs;

static ExpWinProcs asciiProcs = {
    0,
    (HANDLE (WINAPI *)(CONST TCHAR *, DWORD, DWORD, SECURITY_ATTRIBUTES *, 
	    DWORD, DWORD, HANDLE)) CreateFileA,
    (BOOL (WINAPI *)(CONST TCHAR *, TCHAR *, LPSECURITY_ATTRIBUTES, 
	    LPSECURITY_ATTRIBUTES, BOOL, DWORD, LPVOID, CONST TCHAR *, 
	    LPSTARTUPINFOA, LPPROCESS_INFORMATION)) CreateProcessA,
    (DWORD (WINAPI *)(CONST TCHAR *)) GetFileAttributesA,
    (DWORD (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD)) GetShortPathNameA,
    (DWORD (WINAPI *)(CONST TCHAR *, CONST TCHAR *, CONST TCHAR *, DWORD, 
	    WCHAR *, TCHAR **)) SearchPathA
};

static ExpWinProcs unicodeProcs = {
    1,
    (HANDLE (WINAPI *)(CONST TCHAR *, DWORD, DWORD, SECURITY_ATTRIBUTES *, 
	    DWORD, DWORD, HANDLE)) CreateFileW,
    (BOOL (WINAPI *)(CONST TCHAR *, TCHAR *, LPSECURITY_ATTRIBUTES, 
	    LPSECURITY_ATTRIBUTES, BOOL, DWORD, LPVOID, CONST TCHAR *, 
	    LPSTARTUPINFOA, LPPROCESS_INFORMATION)) CreateProcessW,
    (DWORD (WINAPI *)(CONST TCHAR *)) GetFileAttributesW,
    (DWORD (WINAPI *)(CONST TCHAR *, WCHAR *, DWORD)) GetShortPathNameW,
    (DWORD (WINAPI *)(CONST TCHAR *, CONST TCHAR *, CONST TCHAR *, DWORD, 
	    WCHAR *, TCHAR **)) SearchPathW
};

static ExpWinProcs *expWinProcs = &asciiProcs;

/* add this change here instead to help minimize the code changes. */
#define tclWinProcs expWinProcs

void
ExpInitWinProcessAPI (void)
{
    OSVERSIONINFO os;
    os.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
    
    if (GetVersionEx(&os) != 0) {    
	switch (os.dwPlatformId) {
	    case VER_PLATFORM_WIN32_WINDOWS:
		expWinProcs = &asciiProcs; break;
	    case VER_PLATFORM_WIN32_NT:
		expWinProcs = &unicodeProcs; break;
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 * HasConsole --
 *
 *	Determines whether the current application is attached to a
 *	console.
 *
 * Results:
 *	Returns TRUE if this application has a console, else FALSE.
 *
 * Side effects:
 *	None.
 *
 * Comment: COPY OF NON_PUBLIC CORE FUNCTION!
 *
 *----------------------------------------------------------------------
 */

static BOOL
HasConsole()
{




︙


88
89
90
91
92
93
94


95
96
97
98
99
100
101
102



103
104
105
106

107
108

109
110
111
112











113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130





131
132
133
134
135
136








137
138
139
140
141
142
143
144

145

146
147


148
149
150



151
152
153
154
155
156




157
158
159
160
161

162
163

164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228

229
230
231
232
233
234
235
236



















237
238

239
240
241
242
243
244

245
246

247
248
249
250
251
252
253
254
255
256
257


258
259

260
261
262


263
264











265
266
267
268
269
270
























































271




272


273
274
275

276
277
278
279
280
281
282
283

284
285

286
287
288

289



290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309


310
311
312
313
314
315
316
317
318








319
320

321

322








323
324
325





326
327
328



329
330
331



332
333


334
335


336
337
338




339
340
341

342
343
344
345
346
347
348
349
350
351

352
353
354
355
356
357
358

359
360
361
362
363


364
365
366
367
368
369
370
371

372
373

374
375



376
377
378
379
380
381
382

151
152
153
154
155
156
157
158
159
160
161
162
163
164



165
166
167
168

169

170

171
172
173



174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199



200
201
202
203
204

205




206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222

223
224
225
226
227
228


229
230
231
232
233
234



235
236
237
238
239
240
241
242

243


244

































































245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273

274
275
276
277
278
279

280
281

282


283
284
285
286
287
288
289
290

291
292
293

294



295
296
297
298
299
300
301
302
303
304
305
306
307
308
309






310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370

371
372
373
374
375
376
377
378
379
380
381
382
383

384
385

386
387
388
389
390

391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417







418
419
420
421
422
423
424
425
426

427
428
429
430
431
432
433
434
435
436
437
438
439


440
441
442
443
444
445
446
447
448
449
450



451
452
453


454
455
456
457
458
459



460
461
462
463
464
465

466
467
468
469
470
471
472
473
474
475

476
477
478
479
480
481
482

483
484
485
486


487
488
489
490
491
492
493
494
495

496
497

498
499
500
501
502
503
504
505
506
507
508
509
510








+
+





-
-
-
+
+
+

-

-
+
-

+

-
-
-
+
+
+
+
+
+
+
+
+
+
+















-
-
-
+
+
+
+
+
-

-
-
-
-
+
+
+
+
+
+
+
+








+
-
+


+
+

-
-
+
+
+



-
-
-
+
+
+
+




-
+
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+








+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

-
+





-
+

-
+
-
-








-
+
+

-
+
-
-
-
+
+


+
+
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

+
+
+
+
-
+
+



+







-
+

-
+



+
-
+
+
+




















+
+


-
-
-
-
-
-
-
+
+
+
+
+
+
+
+

-
+

+

+
+
+
+
+
+
+
+

-
-
+
+
+
+
+



+
+
+
-
-
-
+
+
+
-
-
+
+


+
+
-
-
-
+
+
+
+


-
+









-
+






-
+



-
-
+
+







-
+

-
+


+
+
+








 *	if the filename referred to the corresponding application type.
 *	If the file name could not be found or did not refer to any known 
 *	application type, EXP_APPL_NONE is returned and the caller can use
 *	GetLastError() to find out what went wrong.
 *
 * Side effects:
 *	None.
 *
 * Comment: COPY OF NON_PUBLIC CORE FUNCTION!
 *
 *----------------------------------------------------------------------
 */

DWORD
ExpApplicationType(originalName, fullPath, imagePath)
    const char *originalName;	/* Name of the application to find. */
    char fullPath[MAX_PATH];	/* Filled with complete path to 
ExpApplicationType(
    const char *originalName,	/* Name of the application to find. */
    char fullName[])		/* Filled with complete path to 
				 * application. */
    char *imagePath;
{
    DWORD applType;
    int applType, i, nameLen, found;
    int i;
    HANDLE hFile;
    TCHAR *rest;
    char *ext;
    char buf[2];
    DWORD read;
    IMAGE_DOS_HEADER header;
    DWORD attr, read;
    IMAGE_DOS_HEADER p236;  /* p236, DOS (old-style) executable-file header */
    union {
	BYTE buf[200];
	IMAGE_NT_HEADERS pe;
	IMAGE_OS2_HEADER ne;
	IMAGE_VXD_HEADER le;
    } header;
    Tcl_DString nameBuf, ds;
    TCHAR *nativeName;
    WCHAR nativeFullPath[MAX_PATH];
    static char extensions[][5] = {"", ".com", ".exe", ".bat", ".cmd"};

    /* Look for the program as an external program.  First try the name
     * as it is, then try adding .com, .exe, and .bat, in that order, to
     * the name, looking for an executable.
     *
     * Using the raw SearchPath() procedure doesn't do quite what is 
     * necessary.  If the name of the executable already contains a '.' 
     * character, it will not try appending the specified extension when
     * searching (in other words, SearchPath will not find the program 
     * "a.b.exe" if the arguments specified "a.b" and ".exe").   
     * So, first look for the file as it is named.  Then manually append 
     * the extensions, looking for a match.  
     */

    if (imagePath) {
	imagePath[0] = 0;
    }
    applType = EXP_APPL_NONE;
    Tcl_DStringInit(&nameBuf);
    Tcl_DStringAppend(&nameBuf, originalName, -1);
    nameLen = Tcl_DStringLength(&nameBuf);

    applType = EXP_APPL_NONE;
    for (i = 0; i < (int) (sizeof(extensions) / sizeof(extensions[0])); i++) {
	lstrcpyn(fullPath, originalName, MAX_PATH - 5);
        lstrcat(fullPath, extensions[i]);
	
	if (SearchPath(NULL, fullPath, NULL, MAX_PATH, fullPath, NULL) == 0) {
	Tcl_DStringSetLength(&nameBuf, nameLen);
	Tcl_DStringAppend(&nameBuf, extensions[i], -1);
        nativeName = Tcl_WinUtfToTChar(Tcl_DStringValue(&nameBuf), 
		Tcl_DStringLength(&nameBuf), &ds);
	found = (*tclWinProcs->searchPathProc)(NULL, nativeName, NULL, 
		MAX_PATH, nativeFullPath, &rest);
	Tcl_DStringFree(&ds);
	if (found == 0) {
	    continue;
	}

	/*
	 * Ignore matches on directories or data files, return if identified
	 * a known type.
	 */

	attr = (*tclWinProcs->getFileAttributesProc)((TCHAR *) nativeFullPath);
	if (GetFileAttributes(fullPath) & FILE_ATTRIBUTE_DIRECTORY) {
	if ((attr == 0xffffffff) || (attr & FILE_ATTRIBUTE_DIRECTORY)) {
	    continue;
	}
	strcpy(fullName, Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds));
	Tcl_DStringFree(&ds);

	ext = strrchr(fullPath, '.');
	if ((ext != NULL) && (strcmpi(ext, ".bat") == 0)) {
	ext = strrchr(fullName, '.');
	if ((ext != NULL) && (stricmp(ext, ".bat") == 0 ||
		stricmp(ext, ".cmd") == 0)) {
	    applType = EXP_APPL_DOS;
	    break;
	}

	hFile = CreateFile(fullPath, GENERIC_READ, FILE_SHARE_READ, NULL, 
		OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);
	
	hFile = (*tclWinProcs->createFileProc)((TCHAR *) nativeFullPath, 
		GENERIC_READ, FILE_SHARE_READ, NULL, OPEN_EXISTING, 
		FILE_ATTRIBUTE_NORMAL, NULL);
	if (hFile == INVALID_HANDLE_VALUE) {
	    continue;
	}

	header.e_magic = 0;
	p236.e_magic = 0;
	ReadFile(hFile, (void *) &header, sizeof(header), &read, NULL);

	ReadFile(hFile, &p236, sizeof(IMAGE_DOS_HEADER), &read, NULL);
	/*
	 * A bit of a hack.  Look for a '#!' at the start of the file.  If we
	 * see it, it indicates the presence of a shell script or something
	 * along those lines (i.e. perl, tcl, etc).  We extract the name of the
	 * image that it is looking for, and we try and turn it into the name
	 * of the Win32 image that needs to be run.
	 */
	if (header.e_magic == 0x2123) { /* #! */
	    char *cpnt;
	    char *dpnt;
	    char scriptName[MAX_PATH];
	    char shellPath[MAX_PATH];
	    char tmpBuf[MAX_PATH];

	    buf[0] = '\0';
	    SetFilePointer(hFile, 0, NULL, FILE_BEGIN);
	    ReadFile(hFile, (void *) tmpBuf, MAX_PATH, &read, NULL);
	    /*
	     * Extract the name of the script interpreter.
	     */
	    cpnt = tmpBuf + 2;
	    while (isspace(*cpnt) && *cpnt != '\n') {
		cpnt++;
	    }
	    dpnt = scriptName;
	    
	    while (*cpnt && !isspace(*cpnt)) {
		*dpnt++ = *cpnt++;
	    }
	    *dpnt = '\0';
	    
	    /*
	     * First try and normalize the name to a Win32 name.
	     */
	    for (cpnt = scriptName; *cpnt != 0; cpnt++) {
		if (*cpnt == '/') {
		    *cpnt = '\\';
		}
	    }
	    applType = ExpApplicationType(scriptName, shellPath, NULL);
	    
	    if (applType == EXP_APPL_NONE) {
		if (strcmp(scriptName, "/bin/sh") == 0) {
		    cpnt = getenv("SHELL");
		    if (cpnt == NULL) {
			continue;
		    }
		    strcpy(scriptName, cpnt);
		    for (cpnt = scriptName; *cpnt != 0; cpnt++) {
			if (*cpnt == '/') {
			    *cpnt = '\\';
			}
		    }
		    applType = ExpApplicationType(scriptName, shellPath, NULL);
		}
	    }
	    if (applType != EXP_APPL_NONE && imagePath != NULL) {
		strcpy(imagePath, shellPath);
	    }

	    CloseHandle(hFile);
	    return applType;
	}

	if (header.e_magic != IMAGE_DOS_SIGNATURE) {
	if (p236.e_magic != IMAGE_DOS_SIGNATURE) {
	    /* 
	     * Doesn't have the magic number for relocatable executables.  If 
	     * filename ends with .com, assume it's a DOS application anyhow.
	     * Note that we didn't make this assumption at first, because some
	     * supposed .com files are really 32-bit executables with all the
	     * magic numbers and everything.  
	     */

	    /*
	     * Additional notes from Ralf Brown's interupt list:
	     *
	     * The COM files are raw binary executables and are a leftover
	     * from the old CP/M machines with 64K RAM.  A COM program can
	     * only have a size of less than one segment (64K), including code
	     * and static data since no fixups for segment relocation or
	     * anything else is included. One method to check for a COM file
	     * is to check if the first byte in the file could be a valid jump
	     * or call opcode, but this is a very weak test since a COM file
	     * is not required to start with a jump or a call. In principle,
	     * a COM file is just loaded at offset 100h in the segment and
	     * then executed.
	     *
	     * OFFSET              Count TYPE   Description
	     * 0000h                   1 byte   ID=0E9h
	     *                                  ID=0EBh
	     */

	    CloseHandle(hFile);
	    if ((ext != NULL) && (strcmpi(ext, ".com") == 0)) {
	    if ((ext != NULL) && (strcmp(ext, ".com") == 0)) {
		applType = EXP_APPL_DOS;
		break;
	    }
	    continue;
	}
	if (header.e_lfarlc != sizeof(header)) {
	if (p236.e_lfarlc < 0x40 || p236.e_lfanew == 0 /* reserved */) {
	    /* 
	     * All Windows 3.X and Win32 and some DOS programs have this value
	     * Old-style header only.  Can't be more than a DOS executable.
	     * set here.  If it doesn't, assume that since it already had the 
	     * other magic number it was a DOS application.
	     */

	    CloseHandle(hFile);
	    applType = EXP_APPL_DOS;
	    break;
	}

	/* 
	 * The DWORD at header.e_lfanew points to yet another magic number.
	 * The LONG at p236.e_lfanew points to the real exe header only
	 * when p236.e_lfarlc is set to 40h (or greater).
	 */

	
	buf[0] = '\0';
	SetFilePointer(hFile, header.e_lfanew, NULL, FILE_BEGIN);
	ReadFile(hFile, (void *) buf, 2, &read, NULL);
	SetFilePointer(hFile, p236.e_lfanew, NULL, FILE_BEGIN);
	ReadFile(hFile, header.buf, 200, &read, NULL);
	CloseHandle(hFile);

	/*
	 * Check the sigs against the following list:
	 *  'PE\0\0'  Win32 (Windows NT and Win32s) portable executable based
	 *	    on Unix COFF.
	 *  'NE'  Windows or OS/2 1.x segmented ("new") executable.
	 *  'LE'  Windows virtual device driver (VxD) linear executable.
	 *  'LX'  variant of LE used in OS/2 2.x
	 *  'W3'  Windows WIN386.EXE file; a collection of LE files
	 *	    (protected mode windows).
	 *  'MZ'  old-style p236 DOS executable.
	 */
	if ((buf[0] == 'L') && (buf[1] == 'E')) {
	    applType = EXP_APPL_DOS;
	} else if ((buf[0] == 'N') && (buf[1] == 'E')) {
	    applType = EXP_APPL_WIN3X;
	} else if ((buf[0] == 'P') && (buf[1] == 'E')) {
	    applType = EXP_APPL_WIN32;

	if (header.pe.Signature == IMAGE_NT_SIGNATURE) {
	    /*
	     * Win32, "PE\0\0" which is short for "Portable Executable".
	     */

	    if (header.pe.OptionalHeader.Magic != IMAGE_NT_OPTIONAL_HDR_MAGIC
		    || !(header.pe.FileHeader.Characteristics &
		    IMAGE_FILE_EXECUTABLE_IMAGE)) {
		/*
		 * Not an executable. Might be a dll or a COMDAT library.
		 */

		applType = EXP_APPL_NONE;
		break;
	    }

	    switch (header.pe.OptionalHeader.Subsystem) {
		case IMAGE_SUBSYSTEM_WINDOWS_CUI:
		case IMAGE_SUBSYSTEM_OS2_CUI:
		case IMAGE_SUBSYSTEM_POSIX_CUI:
		    /* 
		     * image runs in the Windows, OS/2, or Posix character
		     * subsystem.
		     */

		    applType = EXP_APPL_WIN32CUI;
		    break;

		default:
		    /*
		     * Non-CUI applications are run detached.  Return a flag
		     * that will indicate this error.
		     */

		    applType = EXP_APPL_WIN32GUI;
	    }
	} else if (header.ne.ne_magic == IMAGE_OS2_SIGNATURE) {
	    switch (header.ne.ne_exetyp) {
		case 0x1:  /* Microsoft/IBM OS/2 (default)  */
		case 0x3:  /* Microsoft (European?) MS-DOS 4.x */
		    /* Only these might be character-mode. */
		    applType = EXP_APPL_DOS;
		    break;

		default:
		    applType = EXP_APPL_NONE;
	    }
	} else if (header.le.e32_magic == IMAGE_OS2_SIGNATURE_LE ||
		header.le.e32_magic == 0x584C /* 'LX' */ ||
		header.le.e32_magic == 0x3357 /* 'W3' */) {
	    /*
	     * Virtual device drivers are not executables, per se.
	     */

	    applType = EXP_APPL_NONE;
	} else {
	    /*
	     * NOTE: The Lahey Fortran90 compiler might make executables
	     * that have a bogus signature and end-up here.
	     */
	    continue;

	    applType = EXP_APPL_DOS;
	}
	break;
    }
    Tcl_DStringFree(&nameBuf);

    if (applType == EXP_APPL_NONE) {
	return EXP_APPL_NONE;
    }

    if ((applType == EXP_APPL_DOS) || (applType == EXP_APPL_WIN3X)) {
	/* 
	 * Replace long path name of executable with short path name for 
	 * Replace long path name of executable with short path name for
	 * 16-bit applications.  Otherwise the application may not be able
	 * to correctly parse its own command line to separate off the 
	 * to correctly parse its own command line to separate off the
	 * application name from the arguments.
	 */

	(*tclWinProcs->getShortPathNameProc)((TCHAR *) nativeFullPath,
	GetShortPathName(fullPath, fullPath, MAX_PATH);
		nativeFullPath, MAX_PATH);
	strcpy(fullName, Tcl_WinTCharToUtf((TCHAR *) nativeFullPath, -1, &ds));
	Tcl_DStringFree(&ds);
    }
    return applType;
}

/*    
 *----------------------------------------------------------------------
 *
 * BuildCommandLine --
 *
 *	The command line arguments are stored in linePtr separated
 *	by spaces, in a form that CreateProcess() understands.  Special 
 *	characters in individual arguments from argv[] must be quoted 
 *	when being stored in cmdLine.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 * Comment: COPY OF NON_PUBLIC CORE FUNCTION!
 *
 *----------------------------------------------------------------------
 */

static void
BuildCommandLine(argc, argv, linePtr)
    int argc;			/* Number of arguments. */
    char **argv;		/* Argument strings. */
    Tcl_DString *linePtr;	/* Initialized Tcl_DString that receives the
				 * command line. */
void
BuildCommandLine(
    CONST char *executable,	/* Full path of executable (including 
				 * extension).  Replacement for argv[0]. */
    int argc,			/* Number of arguments. */
    char **argv,		/* Argument strings in UTF. */
    Tcl_DString *linePtr)	/* Initialized Tcl_DString that receives the
				 * command line (TCHAR). */
{
    char *start, *special;
    CONST char *arg, *start, *special;
    int quote, i;
    Tcl_DString ds;

    Tcl_DStringInit(&ds);

    /*
     * Prime the path.
     */
    
    Tcl_DStringAppend(&ds, Tcl_DStringValue(linePtr), -1);
    
    for (i = 0; i < argc; i++) {
	if (i > 0) {
	    Tcl_DStringAppend(linePtr, " ", 1);	
	if (i == 0) {
	    arg = executable;
	} else {
	    arg = argv[i];
	    Tcl_DStringAppend(&ds, " ", 1);
	}

	quote = 0;
	if (arg[0] == '\0') {
	    quote = 1;
	} else {
	for (start = argv[i]; *start != '\0'; start++) {
	    if (isspace(*start)) {
		quote = 1;
	    for (start = arg; *start != '\0'; start++) {
		if (isspace(*start)) { /* INTL: ISO space. */
		    quote = 1;
		Tcl_DStringAppend(linePtr, "\"", 1);
    		break;
		    break;
		}
	    }
	}
	if (quote) {
	    Tcl_DStringAppend(&ds, "\"", 1);

	start = argv[i];	    
	for (special = argv[i]; ; ) {
	}

	start = arg;	    
	for (special = arg; ; ) {
	    if ((*special == '\\') && 
		    (special[1] == '\\' || special[1] == '"')) {
		Tcl_DStringAppend(linePtr, start, special - start);
		Tcl_DStringAppend(&ds, start, special - start);
		start = special;
		while (1) {
		    special++;
		    if (*special == '"') {
			/* 
			 * N backslashes followed a quote -> insert 
			 * N * 2 + 1 backslashes then a quote.
			 */

			Tcl_DStringAppend(linePtr, start, special - start);
			Tcl_DStringAppend(&ds, start, special - start);
			break;
		    }
		    if (*special != '\\') {
			break;
		    }
		}
		Tcl_DStringAppend(linePtr, start, special - start);
		Tcl_DStringAppend(&ds, start, special - start);
		start = special;
	    }
	    if (*special == '"') {
		Tcl_DStringAppend(linePtr, start, special - start);
		Tcl_DStringAppend(linePtr, "\\\"", 2);
		Tcl_DStringAppend(&ds, start, special - start);
		Tcl_DStringAppend(&ds, "\\\"", 2);
		start = special + 1;
	    }
	    if (*special == '\0') {
		break;
	    }
	    special++;
	}
	Tcl_DStringAppend(linePtr, start, special - start);
	Tcl_DStringAppend(&ds, start, special - start);
	if (quote) {
	    Tcl_DStringAppend(linePtr, "\"", 1);
	    Tcl_DStringAppend(&ds, "\"", 1);
	}
    }
    Tcl_DStringFree(linePtr);
    Tcl_WinUtfToTChar(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds), linePtr);
    Tcl_DStringFree(&ds);
}

/*
 *----------------------------------------------------------------------
 *
 * Exp_WaitPid --
 *




︙


496
497
498
499
500
501
502


503
504
505
506
507
508
509

624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639








+
+








 *	the executable name.
 *
 * Results:
 *	0 on success, an error value otherwise.
 * 
 * Side effects:
 *	A process is created.
 *
 * Comment: *ALMOST* A COPY OF NON_PUBLIC CORE FUNCTION!
 *
 *----------------------------------------------------------------------
 */

DWORD
ExpCreateProcess(argc, argv, inputHandle, outputHandle, errorHandle,
		 allocConsole, hideConsole, debug, newProcessGroup,




︙


537
538
539
540
541
542
543

544
545


546
547
548
549
550
551
552
553

554
555


556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571




572
573
574
575
576
577
578

667
668
669
670
671
672
673
674


675
676

677
678

679
680


681
682
683
684
685
686
687
688
689
690

691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711








+
-
-
+
+
-


-


-
-
+


+
+





-










+
+
+
+








    PDWORD globalPidPtr;	/* Globally unique pid */
{
    DWORD applType;
    int createFlags;
    Tcl_DString cmdLine;
    STARTUPINFO startInfo;
    PROCESS_INFORMATION procInfo;
    SECURITY_ATTRIBUTES secAtts;
    HANDLE hProcess;
    char execPath[MAX_PATH];
    HANDLE hProcess, h;
    char execPath[MAX_PATH * TCL_UTF_MAX];
    char imagePath[MAX_PATH];
    char *originalName;
    LONG result;
    BOOL b;

    result = 0;
    /* XXX: This isn't quite right */
    applType = ExpApplicationType(argv[0], execPath, imagePath);
    applType = ExpApplicationType(argv[0], execPath);
    if (applType == EXP_APPL_NONE) {
	return GetLastError();
    } else if (applType == EXP_APPL_WIN32GUI) {
	return ERROR_BAD_PIPE;  /* GUI applications can't use pipes. */
    }
    originalName = argv[0];
    argv[0] = execPath;

    Tcl_DStringInit(&cmdLine);

    hProcess = GetCurrentProcess();

    /*
     * STARTF_USESTDHANDLES must be used to pass handles to child process.
     * Using SetStdHandle() and/or dup2() only works when a console mode 
     * parent process is spawning an attached console mode child process.
     */

    ZeroMemory(&startInfo, sizeof(startInfo));
    startInfo.cb = sizeof(startInfo);

    secAtts.nLength = sizeof(SECURITY_ATTRIBUTES);
    secAtts.lpSecurityDescriptor = NULL;
    secAtts.bInheritHandle = TRUE;

    if (inputHandle || outputHandle || errorHandle) {
	startInfo.dwFlags   = STARTF_USESTDHANDLES;
	if (! inputHandle) {
	    inputHandle = GetStdHandle(STD_INPUT_HANDLE);
	}
	if (! outputHandle) {




︙


589
590
591
592
593
594
595
596












597
598
599
600

601
602
603
604
605
606




















607
608
609
610

611
612
613
614
615
616









617
618
619
620

621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640

641
642
643
644
645
646
647
648
649
650










651
652
653
654
655
656
657
658
659








660
661


662

663





664














































665
666
667
668
669
670
671
672

673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692

693

694
695


696
697

698
699









700
701
702
703
704
705
706

722
723
724
725
726
727
728

729
730
731
732
733
734
735
736
737
738
739
740
741
742
743

744
745
746
747
748
749

750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772

773
774
775
776
777
778

779
780
781
782
783
784
785
786
787
788
789
790

791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812










813
814
815
816
817
818
819
820
821
822
823








824
825
826
827
828
829
830
831

832
833
834

835
836
837
838
839
840
841

842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894

895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914

915
916
917


918
919


920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938








-
+
+
+
+
+
+
+
+
+
+
+
+



-
+





-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+



-
+





-
+
+
+
+
+
+
+
+
+



-
+




















+
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+

-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
-

+
+
-
+

+
+
+
+
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







-
+



















-
+

+
-
-
+
+
-
-
+


+
+
+
+
+
+
+
+
+









    /*
     * Duplicate all the handles which will be passed off as stdin, stdout
     * and stderr of the child process. The duplicate handles are set to
     * be inheritable, so the child process can use them.
     */

    if (inputHandle != NULL) {
    if (inputHandle == NULL || inputHandle == INVALID_HANDLE_VALUE) {
	/* 
	 * If handle was not set, stdin should return immediate EOF.
	 * Under Windows95, some applications (both 16 and 32 bit!) 
	 * cannot read from the NUL device; they read from console
	 * instead.
	 */

	if (CreatePipe(&startInfo.hStdInput, &h, &secAtts, 0) != FALSE) {
	    CloseHandle(h);
	}
    } else {
	DuplicateHandle(hProcess, inputHandle, hProcess, &startInfo.hStdInput,
			0, TRUE, DUPLICATE_SAME_ACCESS);
	if (startInfo.hStdInput == INVALID_HANDLE_VALUE) {
	    EXP_LOG("couldn't duplicate input handle: 0x%x", GetLastError());
	    //EXP_LOG("couldn't duplicate input handle: 0x%x", GetLastError());
	    result = GetLastError();
	    goto end;
	}
    }

    if (outputHandle != NULL) {
    if (outputHandle == NULL || outputHandle == INVALID_HANDLE_VALUE) {
	/*
	 * If handle was not set, output should be sent to an infinitely 
	 * deep sink.  Under Windows 95, some 16 bit applications cannot
	 * have stdout redirected to NUL; they send their output to
	 * the console instead.  Some applications, like "more" or "dir /p", 
	 * when outputting multiple pages to the console, also then try and
	 * read from the console to go the next page.
	 */

	if ((TclWinGetPlatformId() == VER_PLATFORM_WIN32_WINDOWS) 
		&& (applType == EXP_APPL_DOS)) {
	    if (CreatePipe(&h, &startInfo.hStdOutput, &secAtts, 0) != FALSE) {
		CloseHandle(h);
	    }
	} else {
	    startInfo.hStdOutput = CreateFileA("NUL:", GENERIC_WRITE, 0,
		    &secAtts, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, NULL);
	}
    } else {
	DuplicateHandle(hProcess, outputHandle, hProcess,
			&startInfo.hStdOutput, 0, TRUE, DUPLICATE_SAME_ACCESS);
	if (startInfo.hStdOutput == INVALID_HANDLE_VALUE) {
	    EXP_LOG("couldn't duplicate output handle: 0x%x", GetLastError());
	    //EXP_LOG("couldn't duplicate output handle: 0x%x", GetLastError());
	    result = GetLastError();
	    goto end;
	}
    }

    if (errorHandle != NULL) {
    if (errorHandle == NULL || errorHandle == INVALID_HANDLE_VALUE) {
	/*
	 * If handle was not set, errors should be sent to an infinitely
	 * deep sink.
	 */

	startInfo.hStdError = CreateFileA("NUL:", GENERIC_WRITE, 0,
		&secAtts, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL);
    } else {
	DuplicateHandle(hProcess, errorHandle, hProcess,
			&startInfo.hStdError, 0, TRUE, DUPLICATE_SAME_ACCESS);
	if (startInfo.hStdError == INVALID_HANDLE_VALUE) {
	    EXP_LOG("couldn't duplicate error handle: 0x%x", GetLastError());
	    //EXP_LOG("couldn't duplicate error handle: 0x%x", GetLastError());
	    result = GetLastError();
	    goto end;
	}
    }

    /* 
     * If we do not have a console window, then we must run DOS and
     * WIN32 console mode applications as detached processes. This tells
     * the loader that the child application should not inherit the
     * console, and that it should not create a new console window for
     * the child application.  The child application should get its stdio 
     * from the redirection handles provided by this application, and run
     * in the background.
     *
     * If we are starting a GUI process, they don't automatically get a 
     * console, so it doesn't matter if they are started as foreground or
     * detached processes.  The GUI window will still pop up to the
     * foreground.
     */

    if (TclWinGetPlatformId() == VER_PLATFORM_WIN32_NT) {
    if (!allocConsole && HasConsole()) {
	createFlags = 0;
    } else if (applType == EXP_APPL_DOS || allocConsole) {
	/*
	 * Under NT, 16-bit DOS applications will not run unless they
	 * can be attached to a console.  If we are running without a
	 * console, run the 16-bit program as an normal process inside
	 * of a hidden console application, and then run that hidden
	 * console as a detached process.
	 */
	if (!allocConsole && HasConsole()) {
	    createFlags = 0;
	} else if (applType == EXP_APPL_DOS || allocConsole) {
	    /*
	     * Under NT, 16-bit DOS applications will not run unless they
	     * can be attached to a console.  If we are running without a
	     * console, run the 16-bit program as an normal process inside
	     * of a hidden console application, and then run that hidden
	     * console as a detached process.
	     */

	if (hideConsole) {
	    startInfo.wShowWindow = SW_HIDE;
	} else {
	    /* For debugging, show the sub process console */
	    startInfo.wShowWindow = SW_SHOW;
	}
	startInfo.dwFlags |= STARTF_USESHOWWINDOW;
	createFlags = CREATE_NEW_CONSOLE;
	    if (hideConsole) {
		startInfo.wShowWindow = SW_HIDE;
	    } else {
		/* For debugging, show the sub process console */
		startInfo.wShowWindow = SW_SHOW;
	    }
	    startInfo.dwFlags |= STARTF_USESHOWWINDOW;
	    createFlags = CREATE_NEW_CONSOLE;
	if (applType == EXP_APPL_DOS) {
	    Tcl_DStringAppend(&cmdLine, "cmd.exe /c ", -1);
	} else {
	    createFlags = DETACHED_PROCESS;
	}
	} 
    } else {
	if (!allocConsole && HasConsole()) {
	    createFlags = 0;
	} else if (allocConsole) {
	    createFlags = CREATE_NEW_CONSOLE;
	} else {
	createFlags = DETACHED_PROCESS;
	    createFlags = DETACHED_PROCESS;
	}
	
	if (applType == EXP_APPL_DOS) {
	    /*
	     * Under Windows 95, 16-bit DOS applications do not work well 
	     * with pipes:
	     *
	     * 1. EOF on a pipe between a detached 16-bit DOS application 
	     * and another application is not seen at the other
	     * end of the pipe, so the listening process blocks forever on 
	     * reads.  This inablity to detect EOF happens when either a 
	     * 16-bit app or the 32-bit app is the listener.  
	     *
	     * 2. If a 16-bit DOS application (detached or not) blocks when 
	     * writing to a pipe, it will never wake up again, and it
	     * eventually brings the whole system down around it.
	     *
	     * The 16-bit application is run as a normal process inside
	     * of a hidden helper console app, and this helper may be run
	     * as a detached process.  If any of the stdio handles is
	     * a pipe, the helper application accumulates information 
	     * into temp files and forwards it to or from the DOS 
	     * application as appropriate.  This means that DOS apps 
	     * must receive EOF from a stdin pipe before they will actually
	     * begin, and must finish generating stdout or stderr before 
	     * the data will be sent to the next stage of the pipe.
	     *
	     * The helper app should be located in the same directory as
	     * the tcl dll.
	     */

	    if (createFlags != 0) {
		if (hideConsole) {
		    startInfo.wShowWindow = SW_HIDE;
		} else {
		    /* For debugging, show the sub process console */
		    startInfo.wShowWindow = SW_SHOW;
		}
		startInfo.dwFlags |= STARTF_USESHOWWINDOW;
		createFlags = CREATE_NEW_CONSOLE;
	    }
	    // BUG: Fixme!  Where is tclpipXX.dll ?????  Set it!
	    Tcl_DStringAppend(&cmdLine, "tclpip" STRINGIFY(TCL_MAJOR_VERSION) 
		    STRINGIFY(TCL_MINOR_VERSION) ".dll ", -1);
	}
    }
    if (debug) {
	createFlags |= DEBUG_PROCESS;
    }
    if (newProcessGroup) {
	createFlags |= CREATE_NEW_PROCESS_GROUP;
    }
    

    /*
     * cmdLine gets the full command line used to invoke the executable,
     * including the name of the executable itself.  The command line
     * arguments in argv[] are stored in cmdLine separated by spaces. 
     * Special characters in individual arguments from argv[] must be 
     * quoted when being stored in cmdLine.
     *
     * When calling any application, bear in mind that arguments that 
     * specify a path name are not converted.  If an argument contains 
     * forward slashes as path separators, it may or may not be 
     * recognized as a path name, depending on the program.  In general,
     * most applications accept forward slashes only as option 
     * delimiters and backslashes only as paths.
     *
     * Additionally, when calling a 16-bit dos or windows application, 
     * all path names must use the short, cryptic, path format (e.g., 
     * using ab~1.def instead of "a b.default").  
     */

    BuildCommandLine(argc, argv, &cmdLine);
    BuildCommandLine(execPath, argc, argv, &cmdLine);

    if ((*tclWinProcs->createProcessProc)(NULL, 
    b = CreateProcess(NULL, Tcl_DStringValue(&cmdLine), NULL, NULL, TRUE,
	    createFlags, NULL, NULL, &startInfo, &procInfo);
	    (TCHAR *) Tcl_DStringValue(&cmdLine), NULL, NULL, TRUE, 
	    (DWORD) createFlags, NULL, NULL, &startInfo, &procInfo) == 0) {
    if (! b) {
	result = GetLastError();
	//EXP_LOG("couldn't CreateProcess(): 0x%x", (result = GetLastError()));
	goto end;
    }

    /*
     * This wait is used to force the OS to give some time to the DOS
     * process.
     */

    if (applType == EXP_APPL_DOS) {
	WaitForSingleObject(procInfo.hProcess, 50);
    }

    /* 
     * "When an application spawns a process repeatedly, a new thread 
     * instance will be created for each process but the previous 
     * instances may not be cleaned up.  This results in a significant 
     * virtual memory loss each time the process is spawned.  If there 
     * is a WaitForInputIdle() call between CreateProcess() and




︙





Changes to win/expWinSlave.h.






︙


92
93
94
95
96
97
98
99

100
101

102
103
104
105
106


92
93
94
95
96
97
98

99
100

101
102
103
104
105

106








-
+

-
+




-
+

extern DWORD WINAPI		ExpSlaveDebugThread(LPVOID *arg);
extern DWORD WINAPI		ExpGetExecutablePathA(PSTR pathInOut);
extern DWORD WINAPI		ExpGetExecutablePathW(PWSTR pathInOut);
extern BOOL			ExpWriteMaster(int useSocket, HANDLE hFile,
				    LPCVOID buf, DWORD n, LPOVERLAPPED over);
extern BOOL			ExpReadMaster(int useSocket, HANDLE hFile,
				    void *buf, DWORD n, PDWORD pCount,
				    LPOVERLAPPED over, PDWORD pError);
				    LPWSAOVERLAPPED over, PDWORD pError);
extern void			ExpNewConsoleSequences(int useSocket,
				    HANDLE hMaster, LPOVERLAPPED over);
				    HANDLE hMaster, LPWSAOVERLAPPED over);
extern void			ExpProcessFreeByHandle(HANDLE hProcess);
extern void			ExpSetConsoleSize(HANDLE hConsoleInW,
				    HANDLE hConsoleOut,
				    int w, int h, int useSocket,
				    HANDLE hMaster, LPOVERLAPPED over);
				    HANDLE hMaster, LPWSAOVERLAPPED over);






Changes to win/expWinSlaveDbg.c.






︙


41
42
43
44
45
46
47
48

49
50
51
52
53
54



55
56
57
58
59
60
61

41
42
43
44
45
46
47

48



49
50
51
52
53
54
55
56
57
58
59
60
61








-
+
-
-
-



+
+
+








 */

/*
 * Even though we won't have access to most of the commands, use the
 * same headers 
 */

#include <windows.h>
#define STRICT    /* ask windows.h to agressive about the HANDLE type */
#include <imagehlp.h>
#include <stddef.h>
#include "tclInt.h"
#include "tclPort.h"
#include "expWin.h"
#include "expWinSlave.h"
#include "spawndrvmc.h"
#include <imagehlp.h>
#include <stddef.h>
#include <assert.h>

#if 0
#  define LOG_ENTRY(function) ExpSyslog("Expect SlaveDriver: " function)
#  define LOG_EXIT(function) ExpSyslog("Expect SlaveDriver: " function " exited")
#else
#  define LOG_ENTRY(function)




︙


70
71
72
73
74
75
76
77

78
79
80

81
82

83
84
85

86
87
88
89
90
91
92

70
71
72
73
74
75
76

77



78
79

80



81
82
83
84
85
86
87
88








-
+
-
-
-
+

-
+
-
-
-
+








#define EXP_FLAG_THREAD_ATTRS		0x08
#define EXP_FLAG_ENVIRONMENT		0x10
#define EXP_FLAG_CURR_DIR		0x20
#define EXP_FLAG_SI			0x40
#define EXP_FLAG_PI			0x80

#ifndef UNICODE
#  define ExpCreateProcessInfo	ExpCreateProcessInfoA
//#  define ExpCreateProcessInfo	ExpCreateProcessInfoA
#  define OnWriteConsoleOutput	OnWriteConsoleOutputA
#  define ReadSubprocessString	ReadSubprocessStringA
#  define StartSubprocess	StartSubprocessW
//#  define StartSubprocess	StartSubprocessA
#else
#  define ExpCreateProcessInfo	ExpCreateProcessInfoW
//#  define ExpCreateProcessInfo	ExpCreateProcessInfoW
#  define OnWriteConsoleOutput	OnWriteConsoleOutputW
#  define ReadSubprocessString	ReadSubprocessStringW
#  define StartSubprocess	StartSubprocessA
//#  define StartSubprocess	StartSubprocessW
#endif

typedef struct _ExpProcess ExpProcess;
typedef struct _ExpBreakpoint ExpBreakpoint;

typedef struct _ExpCreateProcessInfo {
    TCHAR appName[8192];




︙


203
204
205
206
207
208
209
210
211


212
213

214
215

216
217

218
219
220
221

222
223

224
225
226
227



228
229
230
231
232
233
234

199
200
201
202
203
204
205


206
207
208

209
210

211
212

213
214
215
216

217
218

219
220



221
222
223
224
225
226
227
228
229
230








-
-
+
+

-
+

-
+

-
+



-
+

-
+

-
-
-
+
+
+









static char *SymbolPath;

/*
 * Static functions in this file:
 */

extern void		ExpCommonDebugger();
extern BOOL		ReadSubprocessMemory(ExpProcess *proc, LPVOID addr,
static void		ExpCommonDebugger();
static BOOL		ReadSubprocessMemory(ExpProcess *proc, LPVOID addr,
			    LPVOID buf, DWORD len);
extern int		ReadSubprocessStringA(ExpProcess *proc, PVOID base,
static int		ReadSubprocessStringA(ExpProcess *proc, PVOID base,
			    PCHAR buf, int buflen);
extern int		ReadSubprocessStringW(ExpProcess *proc, PVOID base,
static int		ReadSubprocessStringW(ExpProcess *proc, PVOID base,
			    PWCHAR buf, int buflen);
extern BOOL		WriteSubprocessMemory(ExpProcess *proc, LPVOID addr,
static BOOL		WriteSubprocessMemory(ExpProcess *proc, LPVOID addr,
			    LPVOID buf, DWORD len);

static DWORD WINAPI	CreateProcessThread(LPVOID *lparg);
extern void		CreateVtSequence(ExpProcess *, COORD newPos, DWORD n);
static void		CreateVtSequence(ExpProcess *, COORD newPos, DWORD n);
static BOOL		SetBreakpoint(ExpProcess *, ExpBreakInfo *);
extern ExpBreakpoint *	SetBreakpointAtAddr(ExpProcess *, ExpBreakInfo *,
static ExpBreakpoint *	SetBreakpointAtAddr(ExpProcess *, ExpBreakInfo *,
			    PVOID funcPtr);
static void		StartSubprocessA(ExpProcess *, ExpThreadInfo *);
static void		StartSubprocessW(ExpProcess *, ExpThreadInfo *);
static void		RefreshScreen(LPOVERLAPPED over);
//static void		StartSubprocessA(ExpProcess *, ExpThreadInfo *);
//static void		StartSubprocessW(ExpProcess *, ExpThreadInfo *);
static void		RefreshScreen(LPWSAOVERLAPPED over);

static void		OnBeep(ExpProcess *,
			    ExpThreadInfo *, ExpBreakpoint *, PDWORD, DWORD);
static void		OnFillConsoleOutputCharacter(ExpProcess *,
			    ExpThreadInfo *, ExpBreakpoint *, PDWORD, DWORD);
static void		OnGetStdHandle(ExpProcess *,
			    ExpThreadInfo *, ExpBreakpoint *, PDWORD, DWORD);




︙


250
251
252
253
254
255
256
257

258
259
260
261
262
263
264

246
247
248
249
250
251
252

253
254
255
256
257
258
259
260








-
+








			    ExpThreadInfo *, ExpBreakpoint *, PDWORD, DWORD);
static void		OnWriteConsoleA(ExpProcess *,
			    ExpThreadInfo *, ExpBreakpoint *, PDWORD, DWORD);
static void		OnWriteConsoleW(ExpProcess *,
			    ExpThreadInfo *, ExpBreakpoint *, PDWORD, DWORD);
static void		OnWriteConsoleOutputA(ExpProcess *,
			    ExpThreadInfo *, ExpBreakpoint *, PDWORD, DWORD);
extern void		OnWriteConsoleOutputW(ExpProcess *,
static void		OnWriteConsoleOutputW(ExpProcess *,
			    ExpThreadInfo *, ExpBreakpoint *, PDWORD, DWORD);
static void		OnWriteConsoleOutputCharacterA(ExpProcess *,
			    ExpThreadInfo *, ExpBreakpoint *, PDWORD, DWORD);
static void		OnWriteConsoleOutputCharacterW(ExpProcess *,
			    ExpThreadInfo *, ExpBreakpoint *, PDWORD, DWORD);
#if 1 /* XXX: Testing purposes only */
static void		OnExpGetExecutablePathA(ExpProcess *, ExpThreadInfo *,




︙


282
283
284
285
286
287
288
289

290
291
292
293
294
295
296

278
279
280
281
282
283
284

285
286
287
288
289
290
291
292








-
+








static void		OnXFirstBreakpoint(ExpProcess *, LPDEBUG_EVENT);
static void		OnXLoadDll(ExpProcess *, LPDEBUG_EVENT);
static void		OnXUnloadDll(ExpProcess *, LPDEBUG_EVENT);
static void		OnXSecondBreakpoint(ExpProcess *, LPDEBUG_EVENT);
static void		OnXSecondChanceException(ExpProcess *,LPDEBUG_EVENT);
static void		OnXSingleStep(ExpProcess *, LPDEBUG_EVENT);

#ifndef UNICODE
//#ifndef UNICODE

/*
 * Functions where we set breakpoints
 */

ExpBreakInfo BreakArrayKernel32[] = {
    {"FillConsoleOutputCharacterA", 5, OnFillConsoleOutputCharacter, EXP_BREAK_OUT},




︙


325
326
327
328
329
330
331
332

333
334

335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353

354
355
356
357
358
359
360

321
322
323
324
325
326
327

328
329

330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348

349
350
351
352
353
354
355
356








-
+

-
+


















-
+








 */
ExpDllBreakpoints BreakPoints[] = {
    {"kernel32.dll", BreakArrayKernel32},
    {"user32.dll", BreakArrayUser32},
    {NULL, NULL}
};

#endif /* !UNICODE */
//#endif /* !UNICODE */

#ifndef UNICODE
//#ifndef UNICODE

/*
 *----------------------------------------------------------------------
 *
 * ExpProcessNew --
 *
 *	Allocates a new structure for debugging a process and
 *	initializes it.
 *
 * Results:
 *	A new structure
 *
 * Side Effects:
 *	Memory is allocated, an event is created.
 *
 *----------------------------------------------------------------------
 */

static ExpProcess *
ExpProcess *
ExpProcessNew(void)
{
    ExpProcess *proc;
    proc = malloc(sizeof(ExpProcess));
    proc->threadList = NULL;
    proc->threadCount = 0;
    proc->brkptList = NULL;




︙


389
390
391
392
393
394
395
396

397
398
399
400
401
402
403

385
386
387
388
389
390
391

392
393
394
395
396
397
398
399








-
+








 *
 * Results:
 *	None
 *
 *----------------------------------------------------------------------
 */

static void
void
ExpProcessFree(ExpProcess *proc)
{
    ExpThreadInfo *tcurr, *tnext;
    ExpBreakpoint *bcurr, *bnext;
    ExpProcess *pcurr, *pprev;
    
    for (tcurr = proc->threadList; tcurr != NULL; tcurr = tnext) {




︙


623
624
625
626
627
628
629
630

631
632
633

634
635
636



637
638
639
640
641
642
643

619
620
621
622
623
624
625

626
627
628

629
630


631
632
633
634
635
636
637
638
639
640








-
+


-
+

-
-
+
+
+








	    if (proc->hPid == debEvent.dwProcessId) {
		break;
	    }
	}

	if (!proc && debEvent.dwDebugEventCode != CREATE_PROCESS_DEBUG_EVENT) {
	    char buf[50];
	    sprintf(buf, "%d/%d (%d)", 
	    wsprintfA(buf, "%d/%d (%d)", 
		    debEvent.dwProcessId, debEvent.dwThreadId,
		    debEvent.dwDebugEventCode);
	    EXP_LOG("Unexpected debug event for %s", buf);
	    EXP_LOG1(MSG_DT_UNEXPECTEDDBGEVENT, buf);
	    if (debEvent.dwDebugEventCode == EXCEPTION_DEBUG_EVENT) {
		EXP_LOG("ExceptionCode: 0x%08x",
			debEvent.u.Exception.ExceptionRecord.ExceptionCode);
		char buf[50];
		wsprintfA(buf, "0x%08x", debEvent.u.Exception.ExceptionRecord.ExceptionCode);
		EXP_LOG1(MSG_DT_EXCEPTIONDBGEVENT, buf);
		dwContinueStatus = DBG_EXCEPTION_NOT_HANDLED;
	    }
	    goto skip;
	}

	/* Process the debugging event code. */





︙


769
770
771
772
773
774
775
776

777
778
779
780
781
782
783

766
767
768
769
770
771
772

773
774
775
776
777
778
779
780








-
+








 *
 * Results:
 *	If the module is known, return TRUE.  Otherwise, return FALSE
 *
 *----------------------------------------------------------------------
 */

static int
int
LoadedModule(ExpProcess *proc, HANDLE hFile, LPVOID modname, int isUnicode,
    LPVOID baseAddr, DWORD debugOffset)
{
#undef PRINTF
#if 0
#define PRINTF(x) printf x
#else




︙


849
850
851
852
853
854
855
856

857
858
859
860
861
862
863

846
847
848
849
850
851
852

853
854
855
856
857
858
859
860








-
+








 *
 * Results:
 *	None
 *
 *----------------------------------------------------------------------
 */

static void
void
OnXCreateProcess(ExpProcess *proc, LPDEBUG_EVENT pDebEvent)
{
    ExpThreadInfo *threadInfo;
    CREATE_PROCESS_DEBUG_INFO *info = &pDebEvent->u.CreateProcessInfo;
    int known;

    if (proc == NULL) {




︙


908
909
910
911
912
913
914
915

916
917
918
919
920
921
922

905
906
907
908
909
910
911

912
913
914
915
916
917
918
919








-
+








 *
 * Results:
 *	None
 *
 *----------------------------------------------------------------------
 */

static void
void
OnXCreateThread(ExpProcess *proc, LPDEBUG_EVENT pDebEvent)
{
    /*
     * As needed, examine or change the thread's registers
     * with the GetThreadContext and SetThreadContext functions;
     * and suspend and resume thread execution with the
     * SuspendThread and ResumeThread functions.




︙


941
942
943
944
945
946
947
948

949
950
951
952
953
954
955

938
939
940
941
942
943
944

945
946
947
948
949
950
951
952








-
+








 *
 * Results:
 *	None
 *
 *----------------------------------------------------------------------
 */

static void
void
OnXDeleteThread(ExpProcess *proc, LPDEBUG_EVENT pDebEvent)
{
    /*
     * As needed, examine or change the thread's registers
     * with the GetThreadContext and SetThreadContext functions;
     * and suspend and resume thread execution with the
     * SuspendThread and ResumeThread functions.




︙


1007
1008
1009
1010
1011
1012
1013
1014

1015
1016
1017
1018
1019
1020
1021

1004
1005
1006
1007
1008
1009
1010

1011
1012
1013
1014
1015
1016
1017
1018








-
+








    DWORD argMemAddr;
    UCHAR instCall;
    DWORD argCallAddr;
    DWORD instIntr;
} InjectCode;
#pragma pack(pop)

static void
void
OnXFirstBreakpoint(ExpProcess *proc, LPDEBUG_EVENT pDebEvent)
{
    DWORD base;
    ExpThreadInfo *tinfo;

#if 0
    fprintf(stderr, "OnXFirstBreakpoint: proc=0x%08x\n", proc);




︙


1039
1040
1041
1042
1043
1044
1045
1046

1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065

1066
1067
1068

1069
1070
1071
1072
1073
1074
1075

1036
1037
1038
1039
1040
1041
1042

1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061

1062
1063
1064

1065
1066
1067
1068
1069
1070
1071
1072








-
+


















-
+


-
+








	FirstThread = tinfo->hThread;
	FirstContext.ContextFlags = CONTEXT_FULL;
	GetThreadContext(FirstThread, &FirstContext);

	tclEntry = Tcl_FindHashEntry(proc->funcTable, "VirtualAlloc");
	if (tclEntry == NULL) {
	    proc->nBreakCount++;	/* Don't stop at second breakpoint */
	    EXP_LOG("Unable to find entry for VirtualAlloc", NULL);
	    EXP_LOG0(MSG_DT_NOVIRT);
	    return;
	}
	addr = (DWORD) Tcl_GetHashValue(tclEntry);

	code.instPush1     = 0x68;
	code.argMemProtect = PAGE_EXECUTE_READWRITE;
	code.instPush2     = 0x68;
	code.argMemType    = MEM_COMMIT;
	code.instPush3     = 0x68;
	code.argMemSize    = 2048;
	code.instPush4     = 0x68;
	code.argMemAddr    = 0;
	code.instCall      = 0xe8;
	code.argCallAddr   = addr - FirstContext.Eip - offsetof(InjectCode, instCall) - 5;
	code.instIntr      = 0xCC;

	base = FirstContext.Eip;
	if (!ReadSubprocessMemory(proc, (PVOID) base, FirstPage, sizeof(InjectCode))) {
	    EXP_LOG("Error reading subprocess memory", NULL);
	    EXP_LOG0(MSG_DT_CANTREADSPMEM);
	}
	if (!WriteSubprocessMemory(proc, (PVOID) base, &code, sizeof(InjectCode))) {
	    EXP_LOG("Error reading subprocess memory", NULL);
	    EXP_LOG0(MSG_DT_CANTWRITESPMEM);
	}
    }
    return;
}

/*
 *----------------------------------------------------------------------




︙


1084
1085
1086
1087
1088
1089
1090
1091

1092
1093
1094
1095
1096
1097
1098

1081
1082
1083
1084
1085
1086
1087

1088
1089
1090
1091
1092
1093
1094
1095








-
+








 *
 * Results:
 *	None
 *
 *----------------------------------------------------------------------
 */

static void
void
OnXSecondBreakpoint(ExpProcess *proc, LPDEBUG_EVENT pDebEvent)
{
    CONTEXT context;
    UCHAR retbuf[2048];
    DWORD base;
    LPEXCEPTION_DEBUG_INFO exceptInfo;
    ExpBreakInfo *info;




︙


1106
1107
1108
1109
1110
1111
1112
1113

1114
1115
1116
1117
1118
1119
1120

1103
1104
1105
1106
1107
1108
1109

1110
1111
1112
1113
1114
1115
1116
1117








-
+









    memset(retbuf, 0xCC, sizeof(retbuf));	/* All breakpoints */
    WriteSubprocessMemory(proc, (PVOID) proc->pSubprocessMemory,
			  retbuf, sizeof(retbuf));

    base = FirstContext.Eip;
    if (!WriteSubprocessMemory(proc, (PVOID) base, FirstPage, sizeof(InjectCode))) {
	EXP_LOG("Error writing subprocess memory", NULL);
	EXP_LOG0(MSG_DT_CANTWRITESPMEM);
    }
    SetThreadContext(FirstThread, &FirstContext);

    /*
     * Set all breakpoints
     */
    for (i = 0; BreakPoints[i].dllName; i++) {




︙


1134
1135
1136
1137
1138
1139
1140
1141

1142
1143
1144
1145
1146
1147
1148

1131
1132
1133
1134
1135
1136
1137

1138
1139
1140
1141
1142
1143
1144
1145








-
+








 *
 * Results:
 *	None
 *
 *----------------------------------------------------------------------
 */

static void
void
OnXBreakpoint(ExpProcess *proc, LPDEBUG_EVENT pDebEvent)
{
    LPEXCEPTION_DEBUG_INFO exceptInfo;
    CONTEXT context;
    ExpThreadInfo *tinfo;
    ExpBreakpoint *pbrkpt, *brkpt;
    PDWORD pdw;




︙


1258
1259
1260
1261
1262
1263
1264
1265

1266
1267
1268
1269
1270
1271
1272

1255
1256
1257
1258
1259
1260
1261

1262
1263
1264
1265
1266
1267
1268
1269








-
+








 * OnXSecondChanceException --
 *
 *	Handle a second chance exception
 *
 *----------------------------------------------------------------------
 */

static void
void
OnXSecondChanceException(ExpProcess *proc,  LPDEBUG_EVENT pDebEvent)
{
    BOOL b;
    STACKFRAME frame;
    CONTEXT context;
    ExpThreadInfo *tinfo;
    Tcl_HashEntry *tclEntry;




︙


1362
1363
1364
1365
1366
1367
1368
1369

1370
1371
1372
1373
1374
1375
1376

1359
1360
1361
1362
1363
1364
1365

1366
1367
1368
1369
1370
1371
1372
1373








-
+








	proc->exeModule->dbgInfo->ImageFileName) {
	s = proc->exeModule->dbgInfo->ImageFileName;
    } else {
	s = "";
    }
    fprintf(stderr, "Backtrace for %s\n", s);
    fprintf(stderr, "-------------------------------------\n");
    EXP_LOG("Backtrace for %s", s);
    //EXP_LOG("Backtrace for %s", s);
    while (1) {
        pSymbol->SizeOfStruct = sizeof(symbolBuffer);
        pSymbol->MaxNameLength = 512;

	b = StackWalk(IMAGE_FILE_MACHINE_I386, proc->hProcess,
	    tinfo->hThread, &frame, &context, NULL,
	    SymFunctionTableAccess, SymGetModuleBase,




︙


1394
1395
1396
1397
1398
1399
1400
1401

1402
1403
1404

1405
1406
1407
1408
1409
1410
1411

1391
1392
1393
1394
1395
1396
1397

1398
1399
1400

1401
1402
1403
1404
1405
1406
1407
1408








-
+


-
+








	    } else {
		s = "";
	    }
            fprintf(stderr, "%.20s %08x\t%s+%X\n", s, frame.AddrPC.Offset,
		pSymbol->Name, displacement);
	    sprintf(buf, "%.20s %08x\t%s+%X", s, frame.AddrPC.Offset,
		pSymbol->Name, displacement);
	    EXP_LOG("%s", buf);
	    //EXP_LOG("%s", buf);
	} else {
	    fprintf(stderr, "%08x\n", frame.AddrPC.Offset);
	    EXP_LOG("%08x\t", frame.AddrPC.Offset);
	    //EXP_LOG("%08x\t", frame.AddrPC.Offset);
	}
    }

error:
    if (ExpDebug) {
	Sleep(10000);
    }




︙


1424
1425
1426
1427
1428
1429
1430
1431

1432
1433
1434
1435
1436
1437
1438

1421
1422
1423
1424
1425
1426
1427

1428
1429
1430
1431
1432
1433
1434
1435








-
+








 *
 * Results:
 *	None
 *
 *----------------------------------------------------------------------
 */

static void
void
OnXSingleStep(ExpProcess *proc, LPDEBUG_EVENT pDebEvent)
{
    UCHAR code;
    /*
     * Now, we need to restore the breakpoint that we had removed.
     */
    code = 0xcc;




︙


1451
1452
1453
1454
1455
1456
1457
1458

1459
1460
1461
1462
1463
1464
1465

1448
1449
1450
1451
1452
1453
1454

1455
1456
1457
1458
1459
1460
1461
1462








-
+








 *
 * Side Effects:
 *	Some information is printed
 *
 *----------------------------------------------------------------------
 */

static void
void
OnXLoadDll(ExpProcess *proc, LPDEBUG_EVENT pDebEvent)
{
    WORD w;
    DWORD dw;
    DWORD ImageHdrOffset;
    PIMAGE_FILE_HEADER pfh;	/* File header image in subprocess memory */
    PIMAGE_SECTION_HEADER psh;




︙


1615
1616
1617
1618
1619
1620
1621
1622

1623
1624
1625
1626
1627
1628
1629

1612
1613
1614
1615
1616
1617
1618

1619
1620
1621
1622
1623
1624
1625
1626








-
+








 *
 * Side Effects:
 *	Some information is printed
 *
 *----------------------------------------------------------------------
 */

static void
void
OnXUnloadDll(ExpProcess *proc, LPDEBUG_EVENT pDebEvent)
{
    Tcl_HashEntry *tclEntry;
    ExpModule *modPtr;

    /*
     * Display a message that the DLL has




︙


1661
1662
1663
1664
1665
1666
1667
1668

1669
1670
1671
1672
1673
1674
1675
1676

1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688

1689
1690
1691
1692
1693
1694
1695

1658
1659
1660
1661
1662
1663
1664

1665
1666
1667
1668
1669
1670
1671
1672

1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693








-
+







-
+












+








 *
 * Results:
 *	TRUE if successful, FALSE if unsuccessful.
 *
 *----------------------------------------------------------------------
 */

static BOOL
BOOL
SetBreakpoint(ExpProcess *proc, ExpBreakInfo *info)
{
    Tcl_HashEntry *tclEntry;
    PVOID funcPtr;

    tclEntry = Tcl_FindHashEntry(proc->funcTable, info->funcName);
    if (tclEntry == NULL) {
	EXP_LOG("Unable to set breakpoint at %s", info->funcName);
	//EXP_LOG("Unable to set breakpoint at %s", info->funcName);
	return FALSE;
    }

#if 0
    fprintf(stderr, "%s: ", info->funcName);
#endif
    /*
     * Set a breakpoint at the function start in the subprocess and
     * save the original code at the function start.
     */
    funcPtr = Tcl_GetHashValue(tclEntry);
    SetBreakpointAtAddr(proc, info, funcPtr);
    return TRUE;
}

/*
 *----------------------------------------------------------------------
 *
 * SetBreakpointAtAddr --
 *




︙


1755
1756
1757
1758
1759
1760
1761
1762

1763
1764
1765
1766
1767
1768
1769

1753
1754
1755
1756
1757
1758
1759

1760
1761
1762
1763
1764
1765
1766
1767








-
+








 * Side Effects:
 *	Save the return value in an array of known console handles
 *	with their statuses.
 *
 *----------------------------------------------------------------------
 */

static void
void
OnOpenConsoleW(ExpProcess *proc, ExpThreadInfo *threadInfo,
    ExpBreakpoint *brkpt, PDWORD returnValue, DWORD direction)
{
    WCHAR name[256];
    PVOID ptr;

    LOG_ENTRY("OpenConsoleW");




︙


1802
1803
1804
1805
1806
1807
1808
1809

1810
1811
1812
1813
1814
1815
1816

1800
1801
1802
1803
1804
1805
1806

1807
1808
1809
1810
1811
1812
1813
1814








-
+








 *
 * Side Effects:
 *	Prints some output.
 *
 *----------------------------------------------------------------------
 */

static void
void
OnWriteConsoleA(ExpProcess *proc, ExpThreadInfo *threadInfo,
    ExpBreakpoint *brkpt, PDWORD returnValue, DWORD direction)
{
    CHAR buf[1024];
    PVOID ptr;
    DWORD n;
    PCHAR p;




︙


1861
1862
1863
1864
1865
1866
1867
1868

1869
1870
1871
1872
1873
1874
1875

1859
1860
1861
1862
1863
1864
1865

1866
1867
1868
1869
1870
1871
1872
1873








-
+








 *
 * Side Effects:
 *	Prints some output.
 *
 *----------------------------------------------------------------------
 */

static void
void
OnWriteConsoleW(ExpProcess *proc, ExpThreadInfo *threadInfo,
    ExpBreakpoint *brkpt, PDWORD returnValue, DWORD direction)
{
    WCHAR buf[1024];
    CHAR ansi[2048];
    PVOID ptr;
    DWORD n;




︙


1927
1928
1929
1930
1931
1932
1933
1934

1935
1936
1937
1938
1939
1940
1941

1925
1926
1927
1928
1929
1930
1931

1932
1933
1934
1935
1936
1937
1938
1939








-
+








 *
 * Side Effects:
 *	Prints some output.
 *
 *----------------------------------------------------------------------
 */

static void
void
OnFillConsoleOutputCharacter(ExpProcess *proc, ExpThreadInfo *threadInfo,
    ExpBreakpoint *brkpt, PDWORD returnValue, DWORD direction)
{
    CHAR buf[4096];
    int bufpos;
    UCHAR c;
    PVOID ptr;




︙


2052
2053
2054
2055
2056
2057
2058
2059
2060


2061
2062
2063
2064
2065
2066
2067

2050
2051
2052
2053
2054
2055
2056


2057
2058
2059
2060
2061
2062
2063
2064
2065








-
-
+
+








	    bufpos += strlen(&buf[bufpos]);
	    memset(&buf[bufpos], c, postCols);
	    bufpos += postCols;
	}
    }
    if (GetConsoleScreenBufferInfo(HConsole, &info) == FALSE) {
	char errbuf[200];
	wsprintfA(errbuf, "Call to GetConsoleScreenBufferInfo failed: handle=0x%08x, err=0x%08x", HConsole, GetLastError());
	EXP_LOG("%s", errbuf);
	wsprintfA(errbuf, "handle=0x%08x", HConsole);
	EXP_LOG2(MSG_DT_SCREENBUF, errbuf, ExpSyslogGetSysMsg(GetLastError()));
    } else {
	CursorPosition = info.dwCursorPosition;
	wsprintfA(&buf[bufpos], "\033[%d;%dH",
		  CursorPosition.Y+1, CursorPosition.X+1);
	bufpos += strlen(&buf[bufpos]);
	CursorKnown = TRUE;
    }




︙


2217
2218
2219
2220
2221
2222
2223
2224

2225
2226
2227
2228
2229
2230
2231

2215
2216
2217
2218
2219
2220
2221

2222
2223
2224
2225
2226
2227
2228
2229








-
+








 *
 * Side Effects:
 *	Prints some output.
 *
 *----------------------------------------------------------------------
 */

static void
void
OnWriteConsoleOutputCharacterA(ExpProcess *proc, ExpThreadInfo *threadInfo,
    ExpBreakpoint *brkpt, PDWORD returnValue, DWORD direction)
{
    CHAR buf[1024];
    PVOID ptr;
    DWORD n;
    PCHAR p;




︙


2279
2280
2281
2282
2283
2284
2285
2286

2287
2288
2289
2290
2291
2292
2293

2277
2278
2279
2280
2281
2282
2283

2284
2285
2286
2287
2288
2289
2290
2291








-
+








 *
 * Side Effects:
 *	Prints some output.
 *
 *----------------------------------------------------------------------
 */

static void
void
OnWriteConsoleOutputCharacterW(ExpProcess *proc, ExpThreadInfo *threadInfo,
    ExpBreakpoint *brkpt, PDWORD returnValue, DWORD direction)
{
    WCHAR buf[1024];
    CHAR ansi[2048];
    PVOID ptr;
    DWORD n;




︙


2366
2367
2368
2369
2370
2371
2372
2373

2374
2375
2376
2377
2378
2379
2380

2364
2365
2366
2367
2368
2369
2370

2371
2372
2373
2374
2375
2376
2377
2378








-
+








 * Notes:
 *	If this is ever used for real, there need to be ASCII
 *	and UNICODE versions.
 *
 *----------------------------------------------------------------------
 */

static void
void
OnReadConsoleInput(ExpProcess *proc, ExpThreadInfo *threadInfo,
    ExpBreakpoint *brkpt, PDWORD returnValue, DWORD direction)
{
    LOG_ENTRY("ReadConsoleInput");
}

/*




︙


2391
2392
2393
2394
2395
2396
2397
2398

2399
2400
2401
2402
2403
2404
2405

2389
2390
2391
2392
2393
2394
2395

2396
2397
2398
2399
2400
2401
2402
2403








-
+








 * Side Effects:
 *	Sets some flags that are used in determining echoing
 *	characteristics of the slave driver.
 *
 *----------------------------------------------------------------------
 */

static void
void
OnSetConsoleMode(ExpProcess *proc, ExpThreadInfo *threadInfo,
    ExpBreakpoint *brkpt, PDWORD returnValue, DWORD direction)
{
    DWORD i;
    BOOL found;

    LOG_ENTRY("SetConsoleMode");




︙


2433
2434
2435
2436
2437
2438
2439
2440

2441
2442
2443
2444
2445
2446
2447

2431
2432
2433
2434
2435
2436
2437

2438
2439
2440
2441
2442
2443
2444
2445








-
+








 * Side Effects:
 *	We reread the entire console and send it to the master.
 *	Updates the current console cursor position
 *
 *----------------------------------------------------------------------
 */

static void
void
OnSetConsoleActiveScreenBuffer(ExpProcess *proc, ExpThreadInfo *threadInfo,
    ExpBreakpoint *brkpt, PDWORD returnValue, DWORD direction)
{
    LOG_ENTRY("SetConsoleActiveScreenBuffer");

    if (*returnValue == FALSE) {
	return;




︙


2463
2464
2465
2466
2467
2468
2469
2470

2471
2472
2473
2474
2475
2476
2477

2461
2462
2463
2464
2465
2466
2467

2468
2469
2470
2471
2472
2473
2474
2475








-
+








 *
 * Side Effects:
 *	Updates the current console cursor position
 *
 *----------------------------------------------------------------------
 */

static void
void
OnSetConsoleCursorPosition(ExpProcess *proc, ExpThreadInfo *threadInfo,
    ExpBreakpoint *brkpt, PDWORD returnValue, DWORD direction)
{
    BOOL b;
    CHAR buf[50];
    DWORD count;





︙


2500
2501
2502
2503
2504
2505
2506
2507

2508
2509
2510
2511
2512
2513
2514

2498
2499
2500
2501
2502
2503
2504

2505
2506
2507
2508
2509
2510
2511
2512








-
+








 *
 * Side Effects:
 *	Updates the current console cursor position
 *
 *----------------------------------------------------------------------
 */

static void
void
OnSetConsoleWindowInfo(ExpProcess *proc, ExpThreadInfo *threadInfo,
    ExpBreakpoint *brkpt, PDWORD returnValue, DWORD direction)
{
    LOG_ENTRY("SetConsoleWindowInfo");
}

/*




︙


2601
2602
2603
2604
2605
2606
2607
2608

2609
2610
2611
2612
2613
2614
2615

2599
2600
2601
2602
2603
2604
2605

2606
2607
2608
2609
2610
2611
2612
2613








-
+








 * Side Effects:
 *	Sets some flags that are used in determining echoing
 *	characteristics of the slave driver.
 *
 *----------------------------------------------------------------------
 */

static void
void
OnGetStdHandle(ExpProcess *proc, ExpThreadInfo *threadInfo,
    ExpBreakpoint *brkpt, PDWORD returnValue, DWORD direction)
{
    DWORD i;
    BOOL found;

    if (*returnValue == (DWORD) INVALID_HANDLE_VALUE) {




︙


2649
2650
2651
2652
2653
2654
2655
2656

2657
2658
2659
2660
2661
2662
2663

2647
2648
2649
2650
2651
2652
2653

2654
2655
2656
2657
2658
2659
2660
2661








-
+








 *	XXX: Setting the duration to 0 doesn't seem to make the local
 *	beep go away.  It seems we need to stop the call at this point
 *	(or point it to some other call with the same number of arguments)
 *
 *----------------------------------------------------------------------
 */

static void
void
OnBeep(ExpProcess *proc, ExpThreadInfo *threadInfo,
    ExpBreakpoint *brkpt, PDWORD returnValue, DWORD direction)
{
    CHAR buf[50];

    LOG_ENTRY("Beep");





︙


2680
2681
2682
2683
2684
2685
2686
2687

2688
2689
2690
2691
2692
2693
2694

2678
2679
2680
2681
2682
2683
2684

2685
2686
2687
2688
2689
2690
2691
2692








-
+








 *	Redraw the entire screen
 *
 * Results:
 *	None
 *
 *----------------------------------------------------------------------
 */
static void
void
RefreshScreen(LPOVERLAPPED over)
{
    CONSOLE_SCREEN_BUFFER_INFO info;
    UCHAR buf[4096];
    DWORD bufpos = 0;
    CHAR_INFO consoleBuf[4096];
    COORD size = {ConsoleSize.X, ConsoleSize.Y};




︙


2770
2771
2772
2773
2774
2775
2776
2777

2778
2779
2780
2781
2782
2783
2784

2768
2769
2770
2771
2772
2773
2774

2775
2776
2777
2778
2779
2780
2781
2782








-
+








 *
 * Results:
 *	None
 *
 *----------------------------------------------------------------------
 */

static void
void
OnIsWindowVisible(ExpProcess *proc, ExpThreadInfo *threadInfo,
    ExpBreakpoint *brkpt, PDWORD returnValue, DWORD direction)
{
    LOG_ENTRY("IsWindowVisible");

    *returnValue = TRUE;
}




︙


2801
2802
2803
2804
2805
2806
2807
2808

2809
2810
2811
2812
2813
2814
2815

2799
2800
2801
2802
2803
2804
2805

2806
2807
2808
2809
2810
2811
2812
2813








-
+








 *	since the test suite fails when run with this code
 *	enabled.  When it works, it should be much faster than
 *	the current safe but slow implementation.
 *
 *----------------------------------------------------------------------
 */

#ifdef XXX
#if 0
BOOL
ReadSubprocessMemory(ExpProcess *proc, LPVOID addr, LPVOID buf, DWORD len)
{
    DWORD oldProtection = 0;
    MEMORY_BASIC_INFORMATION mbi;
    BOOL ret = TRUE;
    DWORD offset;




︙


2961
2962
2963
2964
2965
2966
2967
2968

2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979

2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995

2996
2997
2998
2999
3000
3001































































































3002
3003
3004
3005
3006
3007
3008
3009
3010
3011

3012
3013
3014
3015
3016
3017
3018

2959
2960
2961
2962
2963
2964
2965

2966
2967





2968
2969
2970
2971

2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987

2988
2989
2990
2991
2992
2993

2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096
3097

3098
3099
3100
3101
3102
3103
3104
3105








-
+

-
-
-
-
-




-
+















-
+





-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+









-
+








#if 0 /* Debugging purposes only */
    if (ret == FALSE) {
	assert(ret != FALSE); 
    }
#endif
    return ret;
}
#endif /* !UNICODE */
//#endif /* !UNICODE */

/*
 * Everything after this point gets compiled twice, once with the UNICODE flag
 * and once without.  This gets us the Unicode and non-Unicode versions
 * of the code that we need
 */
 
/*
 *----------------------------------------------------------------------
 *
 * OnWriteConsoleOutput --
 * OnWriteConsoleOutputA --
 *
 *	This function gets called when an WriteConsoleOutputA breakpoint
 *	is hit.  The data is also redirected to expect since expect
 *	normally couldn't see any output going through this interface.
 *
 * Results:
 *	None
 *
 * Side Effects:
 *	Prints some output.
 *
 *----------------------------------------------------------------------
 */

void
OnWriteConsoleOutput(ExpProcess *proc, ExpThreadInfo *threadInfo,
OnWriteConsoleOutputA(ExpProcess *proc, ExpThreadInfo *threadInfo,
    ExpBreakpoint *brkpt, PDWORD returnValue, DWORD direction)
{
    CHAR buf[1024];
    PVOID ptr;
    DWORD n;
    PCHAR p, end;
    CHAR *p, *end;
    int maxbuf;
    BOOL b;
    COORD bufferSize;
    COORD bufferCoord;
    COORD curr;
    SMALL_RECT writeRegion;
    CHAR_INFO *charBuf, *pcb;
    SHORT x, y;

    LOG_ENTRY("WriteConsoleOutputA");

    if (*returnValue == 0) {
	return;
    }

    bufferSize = *((PCOORD) &threadInfo->args[2]);
    bufferCoord = *((PCOORD) &threadInfo->args[3]);
    ptr = (PVOID) threadInfo->args[4]; /* Get the rectangle written */
    if (ptr == NULL) return;
    ReadSubprocessMemory(proc, ptr, &writeRegion,sizeof(SMALL_RECT));

    ptr = (PVOID) threadInfo->args[1]; /* Get character array */
    if (ptr == NULL) return;

    n = bufferSize.X * bufferSize.Y * sizeof(CHAR_INFO);
    charBuf = malloc(n);

#if 0
    wsprintfA((char *) charBuf, "writeRegion: (%d,%d) to (%d,%d)   bufferCoord: (%d,%d)   bufferSize: (%d,%d)", writeRegion.Left, writeRegion.Top, writeRegion.Right, writeRegion.Bottom, bufferCoord.X, bufferCoord.Y, bufferSize.X, bufferSize.Y);
    ExpSyslog("Debug 0: %s", charBuf);
#endif

    ReadSubprocessMemory(proc, ptr, charBuf, n);

    pcb = charBuf;
    for (y = 0; y <= writeRegion.Bottom - writeRegion.Top; y++) {
	pcb = charBuf;
	pcb += (y + bufferCoord.Y) * bufferSize.X;
	pcb += bufferCoord.X;
	p = buf;
	maxbuf = sizeof(buf);
	end = buf + maxbuf;
	for (x = 0; x <= writeRegion.Right - writeRegion.Left; x++, pcb++) {
	    *p++ = pcb->Char.AsciiChar;
	    if (p == end) {
		ResetEvent(proc->overlapped.hEvent);
		b = ExpWriteMaster(UseSocket, HMaster, buf, maxbuf, &proc->overlapped);
		p = buf;
	    }
	}
	curr.X = writeRegion.Left;
	curr.Y = writeRegion.Top + y;
	n = writeRegion.Right - writeRegion.Left;
	CreateVtSequence(proc, curr, n);
	ResetEvent(proc->overlapped.hEvent);

	maxbuf = p - buf;
	b = ExpWriteMaster(UseSocket, HMaster, buf, maxbuf, &proc->overlapped);
	buf[maxbuf] = 0;
#if 0
	ExpSyslog("Writing %s", buf);
#endif
    }

    free(charBuf);
    LOG_EXIT("WriteConsoleOutputA");
}

/*
 *----------------------------------------------------------------------
 *
 * OnWriteConsoleOutputW --
 *
 *	This function gets called when an WriteConsoleOutputW breakpoint
 *	is hit.  The data is also redirected to expect since expect
 *	normally couldn't see any output going through this interface.
 *
 * Results:
 *	None
 *
 * Side Effects:
 *	Prints some output.
 *
 *----------------------------------------------------------------------
 */

void
OnWriteConsoleOutputW(ExpProcess *proc, ExpThreadInfo *threadInfo,
    ExpBreakpoint *brkpt, PDWORD returnValue, DWORD direction)
{
    WCHAR buf[1024];
    PVOID ptr;
    DWORD n;
    WCHAR *p, *end;
    int maxbuf;
    BOOL b;
    COORD bufferSize;
    COORD bufferCoord;
    COORD curr;
    SMALL_RECT writeRegion;
    CHAR_INFO *charBuf, *pcb;
    SHORT x, y;

    LOG_ENTRY("WriteConsoleOutput");
    LOG_ENTRY("WriteConsoleOutputW");

    if (*returnValue == 0) {
	return;
    }

    bufferSize = *((PCOORD) &threadInfo->args[2]);
    bufferCoord = *((PCOORD) &threadInfo->args[3]);




︙


3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056

3125
3126
3127
3128
3129
3130
3131

3132



3133
3134
3135
3136
3137
3138
3139








-

-
-
-








	pcb = charBuf;
	pcb += (y + bufferCoord.Y) * bufferSize.X;
	pcb += bufferCoord.X;
	p = buf;
	maxbuf = sizeof(buf);
	end = buf + maxbuf;
	for (x = 0; x <= writeRegion.Right - writeRegion.Left; x++, pcb++) {
#ifdef UNICODE
	    *p++ = (CHAR) (pcb->Char.UnicodeChar & 0xff);
#else
	    *p++ = pcb->Char.AsciiChar;
#endif
	    if (p == end) {
		ResetEvent(proc->overlapped.hEvent);
		b = ExpWriteMaster(UseSocket, HMaster, buf, maxbuf, &proc->overlapped);
		p = buf;
	    }
	}
	curr.X = writeRegion.Left;




︙


3064
3065
3066
3067
3068
3069
3070
3071

3072
3073
3074
3075
3076
3077

































3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088

3089
3090

3091
3092
3093
3094
3095
3096
3097

3098
3099
3100
3101
3102
3103
3104
3105

3147
3148
3149
3150
3151
3152
3153

3154
3155
3156
3157
3158
3159

3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202

3203
3204

3205
3206
3207
3208
3209
3210
3211

3212
3213
3214
3215
3216
3217
3218
3219
3220








-
+





-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+










-
+

-
+






-
+









	buf[maxbuf] = 0;
#if 0
	ExpSyslog("Writing %s", buf);
#endif
    }

    free(charBuf);
    LOG_EXIT("WriteConsoleOutput");
    LOG_EXIT("WriteConsoleOutputW");
}

/*
 *----------------------------------------------------------------------
 *
 * ReadSubprocessString --
 * ReadSubprocessStringA --
 *
 *	Read a character string from the subprocess
 *
 * Results:
 *	The length of the string
 *
 *----------------------------------------------------------------------
 */

int
ReadSubprocessStringA(ExpProcess *proc, PVOID base, PCHAR buf, int buflen)
{
    CHAR *ip, *op;
    int i;
    
    ip = base;
    op = buf;
    i = 0;
    while (i < buflen-1) {
	if (! ReadSubprocessMemory(proc, ip, op, sizeof(CHAR))) {
	    break;
	}
	if (*op == 0) break;
	op++; ip++; i++;
    }
    *op = 0;
    return i;
}
/*
 *----------------------------------------------------------------------
 *
 * ReadSubprocessStringW --
 *
 *	Read a character string from the subprocess
 *
 * Results:
 *	The length of the string
 *
 *----------------------------------------------------------------------
 */

int
ReadSubprocessString(ExpProcess *proc, PVOID base, PTCHAR buf, int buflen)
ReadSubprocessStringW(ExpProcess *proc, PVOID base, PWCHAR buf, int buflen)
{
    PTCHAR ip, op;
    WCHAR *ip, *op;
    int i;
    
    ip = base;
    op = buf;
    i = 0;
    while (i < buflen-1) {
	if (! ReadSubprocessMemory(proc, ip, op, sizeof(TCHAR))) {
	if (! ReadSubprocessMemory(proc, ip, op, sizeof(WCHAR))) {
	    break;
	}
	if (*op == 0) break;
	op++; ip++; i++;
    }
    *op = 0;
    return i;
}






Changes to win/expWinSlaveDrv.c.






︙


51
52
53
54
55
56
57
58

59
60
61
62

63
64
65
66
67
68
69

51
52
53
54
55
56
57

58

59
60
61
62
63
64
65
66
67
68
69








-
+
-



+








 */

/*
 * Even though we won't have access to most of the commands, use the
 * normal headers 
 */

#include <winsock2.h>
#define STRICT    /* ask windows.h to agressive about the HANDLE type */
#include "tcl.h"
#include "tclPort.h"
#include "expWin.h"
#include "expWinSlave.h"
#include "spawndrvmc.h"

#define STATE_WAIT_CMD   0	/* Waiting for the next command */
#define STATE_CREATE     1	/* Doesn't happen currently */
#define STATE_KEY        2	/* Waiting for key params */
#define STATE_KILL       3	/* 1 Param: type of kill to do */
#define STATE_MOUSE      4	/*  */
#define STATE_WRITE      5	/* Wait for the length of the data */




︙


191
192
193
194
195
196
197
198

199
200
201
202
203




204
205
206
207
208
209
210
211
212
213
214

215
216
217
218
219
220
221
222



223
224

225
226
227
228
229
230
231

191
192
193
194
195
196
197

198
199




200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227

228
229
230
231
232
233
234
235








-
+

-
-
-
-
+
+
+
+











+








+
+
+

-
+








 */

void
main(argc, argv)
    int argc;
    char **argv;
{
    HANDLE hConsoleInW;		/* Console, writeable input handle */
    HANDLE hConsoleInW;	/* Console, writeable input handle */
    HANDLE hConsoleOut;	/* Console, readable output handle */
    HANDLE hMaster;		/* Pipe between master and us */
    HANDLE hSlaveOut;		/* Pipe from slave's STDOUT to us */
    HANDLE hSlaveOutW;		/* Pipe from slave's STDOUT to us */
    HANDLE hProcess;		/* Current process handle */
    HANDLE hMaster;	/* Pipe between master and us */
    HANDLE hSlaveOut;	/* Pipe from slave's STDOUT to us */
    HANDLE hSlaveOutW;	/* Pipe from slave's STDOUT to us */
    HANDLE hProcess;	/* Current process handle */
    UCHAR cmdline[BUFSIZE];
    BOOL bRet;
    DWORD dwResult;
    HANDLE hThread;
    DWORD threadId;
    ExpSlaveDebugArg debugInfo;
    PassThrough thruSlaveOut;
    int passThrough = 0;
    int useSocket = 0;
    int n;
    int sshd = 0;
    int port = 0;

    struct sockaddr_in sin;
    WSADATA	SockData;

#if 0
    Sleep(22000);		/* XXX: For debugging purposes */
#endif

    ExpInitWinProcessAPI();
    ExpDynloadTclStubs();

    if (argc < 2) {
	exit(1);
	EXP_LOG0(MSG_IO_ARGSWRONG);
    }
    if (argc == 2) {
	/* This is how we use it from sshd */
	useSocket = 1;
	sshd = 1;
    } else {
	if (argv[2][0] == '1') {




︙


241
242
243
244
245
246
247
248
249





250
251
252
253
254
255

256
257
258

259
260
261
262
263
264



265
266
267
268
269






270
271



272
273

274
275
276
277
278
279
280
281
282
283

245
246
247
248
249
250
251


252
253
254
255
256


257
258
259

260
261


262


263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280


281
282
283
284

285



286
287
288
289
290
291
292








-
-
+
+
+
+
+
-
-



-
+

-
-
+
-
-




+
+
+





+
+
+
+
+
+
-
-
+
+
+

-
+
-
-
-








	    useSocket = 0;
	}
    }

    if (!useSocket) {
	hMaster = CreateFile(argv[1], GENERIC_READ | GENERIC_WRITE,
			     0, NULL, OPEN_EXISTING, FILE_FLAG_OVERLAPPED, NULL);
	if (hMaster == NULL) {
	    EXP_LOG("Unexpected error 0x%x", GetLastError());
	if (hMaster == INVALID_HANDLE_VALUE) {
	    EXP_LOG2(MSG_NP_CANTOPEN, argv[1], ExpSyslogGetSysMsg(GetLastError()));
	}
	if (GetFileType(hMaster) != FILE_TYPE_PIPE) {
	    EXP_LOG1(MSG_NP_BADTYPE, argv[1]);
	    Sleep(5000);
	    ExitProcess(255);
	}
    } else {
	SOCKET fdmaster;
	dwResult = WSAStartup(MAKEWORD(2, 0), &SockData);
	dwResult = WSAStartup(WINSOCK_VERSION, &SockData);
	if (dwResult != 0) {
	    fprintf(stderr, "Unexpected error 0x%x\n", WSAGetLastError());
	    EXP_LOG("Unexpected error 0x%x", WSAGetLastError());
	    EXP_LOG2(MSG_WS_CANTSTART, "2.2", ExpSyslogGetSysMsg(dwResult));
	    Sleep(5000);
	    ExitProcess(255);
	}

	fdmaster = WSASocket(PF_INET, SOCK_STREAM, IPPROTO_TCP, NULL, 0,
			     WSA_FLAG_OVERLAPPED);
	if (fdmaster == INVALID_SOCKET) {
	    EXP_LOG1(MSG_WS_CANTCREATEMASTERSOCK, ExpSyslogGetSysMsg(WSAGetLastError()));
	}

	/*
	 * Now attach this to a specific port.
	 */
	sin.sin_family = AF_INET;

	/* get the port */
	if (Tcl_GetInt(NULL, argv[1], &port) != TCL_OK || port < 0 || port > 65536) {
	    EXP_LOG1(MSG_WS_PORTOUTOFRANGE, argv[1]);
	}

	sin.sin_port = htons((short) strtoul(argv[1], NULL, 10));
	sin.sin_addr.s_addr = inet_addr("127.0.0.1");
	sin.sin_port = (short) port;
	sin.sin_addr.s_addr = INADDR_LOOPBACK;

	if (connect(fdmaster, (struct sockaddr *) &sin, sizeof(sin)) == SOCKET_ERROR) {
	    fprintf(stderr, "Unexpected error 0x%x\n", WSAGetLastError());
	    EXP_LOG2(MSG_WS_CANTCONNECTMASTERSOCK, argv[1], ExpSyslogGetSysMsg(WSAGetLastError()));
	    EXP_LOG("Unexpected error 0x%x", WSAGetLastError());
	    Sleep(5000);
	    ExitProcess(255);
	}
	hMaster = (HANDLE) fdmaster;
    }

    ExpConsoleOut = CreateFile("CONOUT$", GENERIC_WRITE, FILE_SHARE_WRITE, NULL, 
			  OPEN_EXISTING, 0, NULL);





︙


302
303
304
305
306
307
308
309
310


311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331

332
333
334
335
336
337
338

339
340
341
342
343
344
345
346

311
312
313
314
315
316
317


318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339

340

341
342
343
344
345

346

347
348
349
350
351
352
353








-
-
+
+




















-
+
-





-
+
-








	PipeRespondToMaster(useSocket, hMaster, GetLastError(), 0);
	ExitProcess(255);
    }

    InitializeWaitQueue();

    if (sshd) {
	OVERLAPPED over;
	memset(&over, 0, sizeof(over));
	WSAOVERLAPPED over;
	ZeroMemory(&over, sizeof(WSAOVERLAPPED));
	over.hEvent = CreateEvent(NULL, TRUE, FALSE, NULL);

	bRet = ExpReadMaster(useSocket, hMaster, cmdline, BUFSIZE, &n, &over,
			     &dwResult);
	CloseHandle(over.hEvent);
	cmdline[n] = 0;
	SetArgv(cmdline, &debugInfo.argc, &debugInfo.argv);
    } else {
	debugInfo.argc = argc-4;
	debugInfo.argv = &argv[4];
    }

    /*
     * The subprocess needs to be created in the debugging thread.
     * Set all the args in debugInfo and start it up.
     */
     
    hConsoleInW = CreateFile("CONIN$", GENERIC_WRITE, FILE_SHARE_WRITE, NULL, 
			     OPEN_EXISTING, 0, NULL);
    if (hConsoleInW == NULL) {
	EXP_LOG("Unexpected error 0x%x", GetLastError());
	EXP_LOG2(MSG_DT_CANTGETCONSOLEHANDLE, "CONIN$", ExpSyslogGetSysMsg(GetLastError()));
	ExitProcess(255);
    }
    hConsoleOut = CreateFile("CONOUT$", GENERIC_READ|GENERIC_WRITE,
			      FILE_SHARE_READ|FILE_SHARE_WRITE, NULL, 
			      OPEN_EXISTING, 0, NULL);
    if (hConsoleOut == NULL) {
	EXP_LOG("Unexpected error 0x%x", GetLastError());
	EXP_LOG2(MSG_DT_CANTGETCONSOLEHANDLE, "CONOUT$", ExpSyslogGetSysMsg(GetLastError()));
	ExitProcess(255);
    }

    ExpConsoleInputMode = ENABLE_LINE_INPUT|ENABLE_ECHO_INPUT|
	ENABLE_PROCESSED_INPUT|ENABLE_MOUSE_INPUT;

    debugInfo.passThrough = passThrough;
    debugInfo.useSocket = useSocket;




︙


403
404
405
406
407
408
409
410

411
412
413
414
415
416
417
418
419
420
421
422
423
424

425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441


442
443
444
445
446
447
448

410
411
412
413
414
415
416

417
418
419
420
421
422
423
424
425
426
427
428
429
430

431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446


447
448
449
450
451
452
453
454
455








-
+













-
+















-
-
+
+








 *----------------------------------------------------------------------
 */

static void
ExpProcessInput(HANDLE hMaster, HANDLE hConsoleInW, HANDLE hConsoleOut,
		int useSocket, ExpSlaveDebugArg *debugInfo)
{
    OVERLAPPED over;
    WSAOVERLAPPED over;
    UCHAR buffer[BUFSIZE];
    DWORD dwState;
    DWORD dwHave;
    DWORD dwNeeded;
    DWORD dwTotalNeeded;
    BOOL bRet;
    DWORD dwResult;
    DWORD driverInCnt;		/* Number of bytes read from expect pipe */

    dwHave = 0;
    dwState = STATE_WAIT_CMD;
    dwNeeded = 1;

    memset(&over, 0, sizeof(over));
    ZeroMemory(&over, sizeof(WSAOVERLAPPED));
    over.hEvent = CreateEvent(NULL, TRUE, FALSE, NULL);
    while (1) {
	bRet = ExpReadMaster(useSocket, hMaster, &buffer[dwHave],
			     dwNeeded-dwHave, &driverInCnt, &over, &dwResult);
	if ((bRet == TRUE && driverInCnt == 0) ||
	    (bRet == FALSE && dwResult == ERROR_BROKEN_PIPE))
	{
	    if( useSocket )
	    {
		/*
		 * We should always break out because the hShutdown event got set
		 * as the wait queue thread exited.
		 */
		if( WaitForSingleObject(hShutdown, 0) == WAIT_OBJECT_0 )
		{
		    fd_set		   monitor;
		    int			   sts;
		    fd_set monitor;
		    int	sts;
		    /*
		     * This means that all of the other threads have shut down cleanly.
		     */
		    
		    /*
		     * This will signal shutdown to the other end, by sending the
		     * FD_CLOSE.  We need to hold the connection open until the




︙


457
458
459
460
461
462
463
464

465
466
467
468
469
470
471
472

473
474
475
476
477
478
479

464
465
466
467
468
469
470

471
472
473
474
475
476

477

478
479
480
481
482
483
484
485








-
+





-

-
+








		     * Once we get the FD_CLOSE back from the master, then it is
		     * safe to close the socket.
		     */
		    closesocket((SOCKET) hMaster);
		}
		else
		{
		    EXP_LOG("Unclean shutdown 0x%x", dwResult);
		    EXP_LOG1(MSG_IO_BADSHUTDOWN, ExpSyslogGetSysMsg(dwResult));
		}
	    }
	    ExpKillProcessList();
	    ExitProcess(0);
	} else if (bRet == FALSE) {
	    EXP_LOG("Unexpected error 0x%x", dwResult);
	    ExpKillProcessList();
	    ExitProcess(255);
	    EXP_LOG1(MSG_IO_UNEXPECTED, ExpSyslogGetSysMsg(dwResult));
	}

	dwHave += driverInCnt;
	if (dwHave != dwNeeded) {
	    continue;
	}
	dwHave = 0;




︙


519
520
521
522
523
524
525
526

527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543

544
545
546
547
548
549
550

525
526
527
528
529
530
531

532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548

549
550
551
552
553
554
555
556








-
+
















-
+








	    dwState = STATE_WRITE_DATA;
	    break;
	case STATE_WRITE_DATA:
	    if (WriteBufferToSlave(FALSE, useSocket, FALSE, hMaster,
				   hConsoleInW, hConsoleOut,
				   buffer, dwNeeded, &over) == FALSE)
	    {
		EXP_LOG("Unable to write to slave: 0x%x", GetLastError());
		EXP_LOG1(MSG_MS_SLAVENOWRITABLE, ExpSyslogGetSysMsg(GetLastError()));
	    }
	    dwTotalNeeded -= dwNeeded;
	    if (dwTotalNeeded) {
		dwNeeded = (dwTotalNeeded > BUFSIZE) ?
		    BUFSIZE : dwTotalNeeded;
	    } else {
		dwNeeded = 1;
		dwState = STATE_WAIT_CMD;
	    }
	    break;
	case STATE_KEY:
	case STATE_MOUSE:
	    /* XXX: To be implemented */
	    break;
	default:
	    /* If we ever get here, there is a problem */
	    EXP_LOG("Unexpected state\n", 0);
	    EXP_LOG0(MSG_MS_BADSTATE);
	    break;
	}
    }
}

/*
 *----------------------------------------------------------------------




︙


561
562
563
564
565
566
567
568

569
570

571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590

591
592
593
594
595
596
597
598
599
600

567
568
569
570
571
572
573

574
575

576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595

596
597
598

599
600
601
602
603
604
605








-
+

-
+



















-
+


-








static void
SshdProcessInput(HANDLE hMaster, HANDLE hConsoleInW, HANDLE hConsoleOut)
{
    int n;
    UCHAR buffer[BUFSIZE];
    BOOL b;
    DWORD dwError;
    OVERLAPPED over;
    WSAOVERLAPPED over;

    memset(&over, 0, sizeof(over));
    ZeroMemory(&over, sizeof(WSAOVERLAPPED));
    over.hEvent = CreateEvent(NULL, TRUE, FALSE, NULL);

    ExpNewConsoleSequences(TRUE, hMaster, &over);

    while (1) {
	ResetEvent(over.hEvent);
	b = ExpReadMaster(TRUE, hMaster, buffer, BUFSIZE, &n, &over, &dwError);
	/*
	 * FIXME(eric) - the changes I put in for process shutdown have probably broken
	 * this.
	 */
	if (!b) {
	    ExpKillProcessList();
	    ExitProcess(0);
	}

	if (WriteBufferToSlave(TRUE, TRUE, FALSE, hMaster, hConsoleInW,
			       hConsoleOut, buffer, n, &over) == FALSE)
	{
	    EXP_LOG("Unable to write to slave: 0x%x", GetLastError());
	    EXP_LOG1(MSG_MS_SLAVENOWRITABLE, ExpSyslogGetSysMsg(GetLastError()));
	}
    }

}


/*
 *----------------------------------------------------------------------
 *
 * InitializeWaitQueue --




︙





Changes to win/expWinSpawnChan.c.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16



17
18
19
20
21
22
23

1
2
3
4
5
6
7
8
9
10
11
12
13



14
15
16
17
18
19
20
21
22
23














-
-
-
+
+
+








/*
 * expWinSpawnChan.c --
 *
 *	Implements the Windows specific portion of the exp_spawn
 *	channel id.
 *
 * Copyright (c) 1997 by Mitel Corporation
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 */

#include "exp_port.h"
#include "tclInt.h"
#include "tclPort.h"
#include "tclInt.h"
#include "tclPort.h"
#include "expect_tcl.h"
#include "exp_command.h"
#include "expWin.h"

/*
 *----------------------------------------------------------------------
 *
 * ExpPlatformSpawnOutput --




︙





Changes to win/expWinTty.c.





1
2
3
4
5

6
7
8
9
10
11
12

1
2
3
4

5
6
7
8
9
10
11
12





-
+








/*
 * expWinTty.c --
 *
 *	Implements some tty related functions.  Handles interaction with
 *	the console
 *	the console.  This file uses only ANSI function headers.
 *
 * Copyright (c) 1997 by Mitel Corporation
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 */




︙


65
66
67
68
69
70
71
72

73
74
75
76
77
78
79
80

65
66
67
68
69
70
71

72

73
74
75
76
77
78
79








-
+
-








 * Side Effects:
 *	May change the current console settings
 *
 *----------------------------------------------------------------------
 */

void
exp_tty_raw(set)
exp_tty_raw(int set)
    int set;
{
    if (! consoleInitialized) {
	return;
    }
    if (set == 1) {
	consoleOutMode &= ~ENABLE_PROCESSED_OUTPUT;
    } else {




︙


97
98
99
100
101
102
103
104

105
106
107
108
109
110
111
112

96
97
98
99
100
101
102

103

104
105
106
107
108
109
110








-
+
-








 * Side Effects:
 *	May change the current console settings
 *
 *----------------------------------------------------------------------
 */

void
exp_tty_echo(set)
exp_tty_echo(int set)
    int set;
{
    if (! consoleInitialized) {
	return;
    }
    if (set == 1) {
	consoleInMode |= ENABLE_ECHO_INPUT;
    } else {




︙


128
129
130
131
132
133
134
135

136
137
138
139
140
141
142
143
144

126
127
128
129
130
131
132

133


134
135
136
137
138
139
140








-
+
-
-








 * Results:
 *	The same string if in raw mode, the modified string otherwise
 *
 *----------------------------------------------------------------------
 */

char *
exp_cook(s,len)
exp_cook(char *s, int *len)
    char *s;
    int *len;	/* current and new length of s */
{
    static unsigned int destlen = 0;
    static char *dest = 0;
    char *d;		/* ptr into dest */
    unsigned int need;

    if (s == 0) return("<null>");




︙





Added win/expect.dsp.



























































































































































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

# Microsoft Developer Studio Project File - Name="expect" - Package Owner=<4>
# Microsoft Developer Studio Generated Build File, Format Version 6.00
# ** DO NOT EDIT **

# TARGTYPE "Win32 (x86) External Target" 0x0106

CFG=expect - Win32 Debug
!MESSAGE This is not a valid makefile. To build this project using NMAKE,
!MESSAGE use the Export Makefile command and run
!MESSAGE 
!MESSAGE NMAKE /f "expect.mak".
!MESSAGE 
!MESSAGE You can specify a configuration when running NMAKE
!MESSAGE by defining the macro CFG on the command line. For example:
!MESSAGE 
!MESSAGE NMAKE /f "expect.mak" CFG="expect - Win32 Debug"
!MESSAGE 
!MESSAGE Possible choices for configuration are:
!MESSAGE 
!MESSAGE "expect - Win32 Release" (based on "Win32 (x86) External Target")
!MESSAGE "expect - Win32 Debug" (based on "Win32 (x86) External Target")
!MESSAGE 

# Begin Project
# PROP AllowPerConfigDependencies 0
# PROP Scc_ProjName ""
# PROP Scc_LocalPath ""

!IF  "$(CFG)" == "expect - Win32 Release"

# PROP BASE Use_MFC 0
# PROP BASE Use_Debug_Libraries 0
# PROP BASE Output_Dir "Release"
# PROP BASE Intermediate_Dir "Release"
# PROP BASE Cmd_Line "NMAKE /f expect.mak"
# PROP BASE Rebuild_Opt "/a"
# PROP BASE Target_File "expect.exe"
# PROP BASE Bsc_Name "expect.bsc"
# PROP BASE Target_Dir ""
# PROP Use_MFC 0
# PROP Use_Debug_Libraries 0
# PROP Output_Dir "Release"
# PROP Intermediate_Dir "Release"
# PROP Cmd_Line "nmake -nologo -f makefile.vc32 expect"
# PROP Rebuild_Opt "-a"
# PROP Target_File "Release\expect532.dll"
# PROP Bsc_Name ""
# PROP Target_Dir ""

!ELSEIF  "$(CFG)" == "expect - Win32 Debug"

# PROP BASE Use_MFC 0
# PROP BASE Use_Debug_Libraries 1
# PROP BASE Output_Dir "Debug"
# PROP BASE Intermediate_Dir "Debug"
# PROP BASE Cmd_Line "NMAKE /f expect.mak"
# PROP BASE Rebuild_Opt "/a"
# PROP BASE Target_File "expect.exe"
# PROP BASE Bsc_Name "expect.bsc"
# PROP BASE Target_Dir ""
# PROP Use_MFC 0
# PROP Use_Debug_Libraries 1
# PROP Output_Dir "Debug"
# PROP Intermediate_Dir "Debug"
# PROP Cmd_Line "nmake -nologo -f makefile.vc32 expect DEBUG=1"
# PROP Rebuild_Opt "-a"
# PROP Target_File "Debug\expect532d.dll"
# PROP Bsc_Name ""
# PROP Target_Dir ""

!ENDIF 

# Begin Target

# Name "expect - Win32 Release"
# Name "expect - Win32 Debug"

!IF  "$(CFG)" == "expect - Win32 Release"

!ELSEIF  "$(CFG)" == "expect - Win32 Debug"

!ENDIF 

# Begin Group "compat"

# PROP Default_Filter ""
# Begin Source File

SOURCE=..\compat\exp_memmove.c
# End Source File
# Begin Source File

SOURCE=..\compat\exp_select.c
# End Source File
# Begin Source File

SOURCE=..\compat\exp_strf.c
# End Source File
# End Group
# Begin Group "generic"

# PROP Default_Filter ""
# Begin Group "headers"

# PROP Default_Filter "h"
# Begin Source File

SOURCE=..\generic\exp.h
# End Source File
# Begin Source File

SOURCE=..\generic\exp_command.h
# End Source File
# Begin Source File

SOURCE=..\generic\exp_log.h
# End Source File
# Begin Source File

SOURCE=..\generic\exp_printify.h
# End Source File
# Begin Source File

SOURCE=..\generic\expDecls.h
# End Source File
# Begin Source File

SOURCE=..\generic\expect.h
# End Source File
# Begin Source File

SOURCE=..\generic\expect_comm.h
# End Source File
# Begin Source File

SOURCE=..\generic\expect_tcl.h
# End Source File
# Begin Source File

SOURCE=..\generic\expInt.h
# End Source File
# Begin Source File

SOURCE=..\generic\expIntDecls.h
# End Source File
# Begin Source File

SOURCE=..\generic\getopt.h
# End Source File
# End Group
# Begin Source File

SOURCE=..\generic\exp_clib.c
# End Source File
# Begin Source File

SOURCE=..\generic\exp_closetcl.c
# End Source File
# Begin Source File

SOURCE=..\generic\exp_command.c
# End Source File
# Begin Source File

SOURCE=..\generic\exp_glob.c
# End Source File
# Begin Source File

SOURCE=..\generic\exp_log.c
# End Source File
# Begin Source File

SOURCE=..\generic\exp_port.h
# End Source File
# Begin Source File

SOURCE=..\generic\exp_printify.c
# End Source File
# Begin Source File

SOURCE=..\generic\expChan.c
# End Source File
# Begin Source File

SOURCE=..\generic\expCommand.c
# End Source File
# Begin Source File

SOURCE=..\generic\expect.c
# End Source File
# Begin Source File

SOURCE=..\generic\expTrap.c
# End Source File
# Begin Source File

SOURCE=..\generic\getopt.c
# End Source File
# End Group
# Begin Group "win"

# PROP Default_Filter ""
# Begin Group "headers No. 1"

# PROP Default_Filter ""
# Begin Source File

SOURCE=.\expWin.h
# End Source File
# Begin Source File

SOURCE=.\expWinPort.h
# End Source File
# Begin Source File

SOURCE=.\expWinTty.h
# End Source File
# End Group
# Begin Source File

SOURCE=.\expWinCLib.c
# End Source File
# Begin Source File

SOURCE=.\expWinCommand.c
# End Source File
# Begin Source File

SOURCE=.\expWinLog.c
# End Source File
# Begin Source File

SOURCE=.\expWinSpawnChan.c
# End Source File
# Begin Source File

SOURCE=.\expWinTrap.c
# End Source File
# Begin Source File

SOURCE=.\expWinTty.c
# End Source File
# End Group
# End Target
# End Project






Changes to win/expect.rc.





1

2

3
4



5
6
7
8
9
10
11
12
13











14
15
16
17

18
19

20
21
22
23



24
25
26


27
28
29
30
31

32
33
34
35


1
2
3


4
5
6
7
8







9
10
11
12
13
14
15
16
17
18
19
20
21
22

23
24

25
26



27
28
29
30


31
32
33
34
35
36

37
38
39



-
+

+
-
-
+
+
+


-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+



-
+

-
+

-
-
-
+
+
+

-
-
+
+




-
+


-
-

// Used Sun tcl.rc file as an example
// RCS: @(#) $Id: expect.rc,v 1.1.2.2 2001/10/11 02:41:47 davygrvy Exp $

#include <winver.h>
#define RESOURCE_INCLUDED
#include <exp_version.h>
#define RESOURCE_INCLUDED   /* needed by tcl.h because it doesn't use RC_INVOKED */
#include "tcl.h"
#include "exp_version.h"

VS_VERSION_INFO VERSIONINFO
 FILEVERSION 	EXP_MAJOR_VERSION,EXP_MINOR_VERSION,EXP_RELEASE_LEVEL,EXP_RELEASE_SERIAL
 PRODUCTVERSION EXP_MAJOR_VERSION,EXP_MINOR_VERSION,EXP_RELEASE_LEVEL,EXP_RELEASE_SERIAL
 FILEFLAGSMASK 	0x3fL
 FILEFLAGS 	0x0L
 FILEOS 	0x4L
 FILETYPE 	0x2L
 FILESUBTYPE 	0x0L
    FILEVERSION	    EXP_MAJOR_VERSION,EXP_MINOR_VERSION,EXP_RELEASE_LEVEL,EXP_RELEASE_SERIAL
    PRODUCTVERSION  EXP_MAJOR_VERSION,EXP_MINOR_VERSION,EXP_RELEASE_LEVEL,EXP_RELEASE_SERIAL
    FILEFLAGSMASK   VS_FFI_FILEFLAGSMASK
#if DEBUG
    FILEFLAGS	    VS_FF_DEBUG
#else
    FILEFLAGS	    VS_FF_PRERELEASE   /* 0x0L */
#endif
    FILEOS	    VOS__WINDOWS32
    FILETYPE	    VFT_DLL
    FILESUBTYPE     VFT2_UNKNOWN
BEGIN
    BLOCK "StringFileInfo"
    BEGIN
        BLOCK "040a04b0"
        BLOCK "040904b0" /* LANG_ENGLISH/SUBLANG_ENGLISH_US, Unicode CP */
        BEGIN
            VALUE "FileDescription", "Expect DLL\0"
            VALUE "FileDescription", "Expect Tcl extension for Windows.  Interacts with console applications\0"
            VALUE "OriginalFilename", "expect" STRINGIFY(EXP_MAJOR_VERSION) STRINGIFY(EXP_MINOR_VERSION) ".dll\0"
            VALUE "CompanyName", "Mitel, Inc\0"
            VALUE "FileVersion", EXP_PATCH_LEVEL
            VALUE "LegalCopyright", "Copyright \251 Mitel Corporation 1997\0"
            VALUE "CompanyName", "Telindustrie, LLC\0"
            VALUE "FileVersion", EXP_PATCH_LEVEL "\0"
            VALUE "LegalCopyright", "Copyright \251 Telindustrie, LLC 2001\0"
            VALUE "ProductName", "Expect " EXP_VERSION " for Windows NT\0"
            VALUE "ProductVersion", EXP_PATCH_LEVEL
	    VALUE "Comments", "Expect was written for Unix by Don Libes at NIST.  This is a Windows NT only port.\0"
            VALUE "ProductVersion", EXP_PATCH_LEVEL "\0"
	    VALUE "Comments", "Expect was written for Unix by Don Libes at NIST.\r\n" "Gordon Chaffee ported it to WinNT for Mitel Corporation in 1997.\r\n" "David Gravereaux merged Gordon's port back into the official sources for Telindustrie LLC in Oct. 2001.\0"
        END
    END
    BLOCK "VarFileInfo"
    BEGIN
        VALUE "Translation", 0x40a, 1200
        VALUE "Translation", 0x409, 1200
    END
END

// init SCRIPT "initscript.tcl"






Deleted win/expectlib.rc.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35





































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

// Used Sun tcl.rc file as an example

#define RESOURCE_INCLUDED
#include <exp_version.h>

VS_VERSION_INFO VERSIONINFO
 FILEVERSION 	EXP_MAJOR_VERSION,EXP_MINOR_VERSION,EXP_RELEASE_LEVEL,EXP_RELEASE_SERIAL
 PRODUCTVERSION EXP_MAJOR_VERSION,EXP_MINOR_VERSION,EXP_RELEASE_LEVEL,EXP_RELEASE_SERIAL
 FILEFLAGSMASK 	0x3fL
 FILEFLAGS 	0x0L
 FILEOS 	0x4L
 FILETYPE 	0x2L
 FILESUBTYPE 	0x0L
BEGIN
    BLOCK "StringFileInfo"
    BEGIN
        BLOCK "040a04b0"
        BEGIN
            VALUE "FileDescription", "Expectlib DLL\0"
            VALUE "OriginalFilename", "expectlib" STRINGIFY(EXP_MAJOR_VERSION) STRINGIFY(EXP_MINOR_VERSION) ".dll\0"
            VALUE "CompanyName", "Mitel, Inc\0"
            VALUE "FileVersion", EXP_PATCH_LEVEL
            VALUE "LegalCopyright", "Copyright \251 Mitel Corporation 1997\0"
            VALUE "ProductName", "Expectlib " EXP_VERSION " for Windows NT\0"
            VALUE "ProductVersion", EXP_PATCH_LEVEL
	    VALUE "Comments", "Expect was written for Unix by Don Libes at NIST.  This is a Windows NT only port.\0"
        END
    END
    BLOCK "VarFileInfo"
    BEGIN
        VALUE "Translation", 0x40a, 1200
    END
END

// init SCRIPT "initscript.tcl"






Added win/genStubs.dsp.




























































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

# Microsoft Developer Studio Project File - Name="genStubs" - Package Owner=<4>
# Microsoft Developer Studio Generated Build File, Format Version 6.00
# ** DO NOT EDIT **

# TARGTYPE "Win32 (x86) External Target" 0x0106

CFG=genStubs - Win32 Release
!MESSAGE This is not a valid makefile. To build this project using NMAKE,
!MESSAGE use the Export Makefile command and run
!MESSAGE 
!MESSAGE NMAKE /f "genStubs.mak".
!MESSAGE 
!MESSAGE You can specify a configuration when running NMAKE
!MESSAGE by defining the macro CFG on the command line. For example:
!MESSAGE 
!MESSAGE NMAKE /f "genStubs.mak" CFG="genStubs - Win32 Release"
!MESSAGE 
!MESSAGE Possible choices for configuration are:
!MESSAGE 
!MESSAGE "genStubs - Win32 Release" (based on "Win32 (x86) External Target")
!MESSAGE 

# Begin Project
# PROP AllowPerConfigDependencies 0
# PROP Scc_ProjName ""
# PROP Scc_LocalPath ""
# PROP BASE Use_MFC
# PROP BASE Use_Debug_Libraries 0
# PROP BASE Output_Dir ""
# PROP BASE Intermediate_Dir ""
# PROP BASE Cmd_Line "NMAKE -nologo /f makefile.vc32 genstubs"
# PROP BASE Rebuild_Opt ""
# PROP BASE Target_File ""
# PROP BASE Bsc_Name ""
# PROP BASE Target_Dir ""
# PROP Use_MFC
# PROP Use_Debug_Libraries 0
# PROP Output_Dir ""
# PROP Intermediate_Dir ""
# PROP Cmd_Line "NMAKE -nologo /f makefile.vc32 genstubs"
# PROP Rebuild_Opt ""
# PROP Target_File ""
# PROP Bsc_Name ""
# PROP Target_Dir ""
# Begin Target

# Name "genStubs - Win32 Release"

!IF  "$(CFG)" == "genStubs - Win32 Release"

!ENDIF 

# End Target
# End Project






Added win/makefile.vc32.













































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

!include ..\mkconfig.mif
!include .\mkvc32.mif
!include .\mkfiles.mif
TARGETOS = BOTH
APPVER = 4.0
!include <win32.mak>

### Bring in the dependancies if we have them available.
!if exist(.\win\mkfiles.d)
!include .\win\mkfiles.d
!endif

expect : setup $(EXPLIB)
slavedrv : setup $(SLAVEDRV)

setup :
	@if not exist $(TMP_DIR)\nul mkdir $(TMP_DIR) &\
		echo Created directory '$(TMP_DIR)'
	@if not exist $(OUT_DIR)\nul mkdir $(OUT_DIR) &\
		echo Created directory '$(OUT_DIR)'

$(EXPLIB) : $(EXPLIB_OBJs)
!if $(STATIC_BUILD)
	lib -nologo -out:$@ @<<
!else
	link -nologo -out:$@ $(dlllflags) $(guilibsdll) $(TCLSTUBSLIB) @<<
!endif
$(EXPLIB_OBJs)
<<

$(SLAVEDRV) : $(SLAVEDRV_OBJs)
	link -out:$@ $(conlflags) $(ldebug) $(conlibsdll) $(optlibs) \
	    imagehlp.lib user32.lib $(TCLSTUBSLIB) @<<
$(SLAVEDRV_OBJs)
<<


depends : mkfiles.d

mkfiles.d :
	@echo $(TCLSH) $(TOOLSDIR)\mkinfrdeps.tcl -vc32 -out:$@ $(COMPATDIR) $(GENERICDIR) $(WINDIR) @<<
$(EXPLIB_OBJs)
<<


expcflags   = -DBUILD_exp -DTCL_THREADS -DUSE_TCL_STUBS -I$(GENERICDIR) -I$(WINDIR) \
	-I$(TMP_DIR) $(TCL_INCLUDES) -Fo$(TMP_DIR)^\ -Fp$(TMP_DIR)^\

{$(COMPATDIR)}.c{$(TMP_DIR)}.obj ::
    $(cc32) $(cflags) -MD$(DBGX) $(cdebug) $(expcflags) @<<
$<
<<

{$(GENERICDIR)}.c{$(TMP_DIR)}.obj ::
    $(cc32) $(cflags) -MD$(DBGX) $(cdebug) $(expcflags) @<<
$<
<<

{$(WINDIR)}.c{$(TMP_DIR)}.obj ::
    $(cc32) $(cflags) -MD$(DBGX) $(cdebug) $(expcflags) @<<
$<
<<

{$(WINDIR)}.rc{$(TMP_DIR)}.res :
	$(rc32) -fo "$@" -r -i "$(GENERICDIR)" -i "$(TMP_DIR)" $(TCL_INCLUDES) $<


$(TMP_DIR)\spawndrvmc.rc : $(WINDIR)\spawndrvmc.mc
	mc -w -h "$(TMP_DIR)" -r "$(TMP_DIR)" $?

.SUFFIXES: .c






Added win/mkbc32.mif.





















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

#==============================================================================
#
#   Make information file for the Borland 32-bit tools.
#
#
#   MAKE specific syntax is allowed in this file.
#
#==============================================================================
# RCS: @(#) $Id: mkbc32.mif,v 1.1.2.2 2001/09/09 04:20:04 davygrvy Exp $
#==============================================================================

TOOLSET	    = bc32
MAKECMD	    = make.exe -s -N $(MAKEFLAGS) -f makefile.bc

SYM	    =






Added win/mkfiles.mif.



















































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

EXP_MAJOR   = 5
EXP_MINOR   = 32

EXPLIBBASE  = $(OUT_DIR)\expect$(EXP_MAJOR)$(EXP_MINOR)$(STCX)$(DBGX)
EXPLIB	    = "$(EXPLIBBASE).$(OUTEXT)"

SLAVEDRV    = "$(OUT_DIR)\slavedrv.exe"

EXPLIB_OBJs = \
#	$(TMP_DIR)\expCommand.obj \
#	$(TMP_DIR)\exp_command.obj \
#	$(TMP_DIR)\expWinCommand.obj \
#	$(TMP_DIR)\expWinLog.obj \
#	$(TMP_DIR)\expWinProcess.obj \
#	$(TMP_DIR)\expWinTty.obj \
#	$(TMP_DIR)\exp_log.obj \
#	$(TMP_DIR)\exp_glob.obj \
#	$(TMP_DIR)\Dbg.obj \
#	$(TMP_DIR)\exp_closetcl.obj \
#	$(TMP_DIR)\exp_regexp.obj \
#	$(TMP_DIR)\exp_printify.obj \
#	$(TMP_DIR)\getopt.obj \
#	$(TMP_DIR)\exp_main_sub.obj \
#	$(TMP_DIR)\exp_inter.obj \
#	$(TMP_DIR)\expect.obj \
	$(TMP_DIR)\exp_event.obj \
	$(TMP_DIR)\exp_strf.obj \
#	$(TMP_DIR)\expSpawnChan.obj \
#	$(TMP_DIR)\expWinSpawnChan.obj \
#	$(TMP_DIR)\expChan.obj \
#	$(TMP_DIR)\expTrap.obj \
#	$(TMP_DIR)\exp_clib.obj


SLAVEDRV_OBJs = \
	$(TMP_DIR)\expWinSlaveDrv.obj \
	$(TMP_DIR)\expWinSlaveKey.obj \
	$(TMP_DIR)\expWinSlaveDbg.obj \
	$(TMP_DIR)\expWinDynloadTclStubs.obj \
	$(TMP_DIR)\expWinProcess.obj \
	$(TMP_DIR)\expWinLog.obj \
	$(TMP_DIR)\spawndrv.res


$(TMP_DIR)\spawndrv.res : $(TMP_DIR)\spawndrvmc.rc






Added win/mkmgw32.mif.





















1
2
3
4
5
6
7
8
9
10
11
12
13
14
15

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

#==============================================================================
#
#   Make information file for the MinGW 32-bit C/C++ tools.
#
#
#   GMAKE specific syntax is allowed in this file.
#
#==============================================================================
# RCS: @(#) $Id: mkwc32.mif,v 1.1.2.1 2001/09/26 14:24:21 davygrvy Exp $
#==============================================================================

TOOLSET	    = mgw32
MAKECMD	    = ???

SYM	    = 






Added win/mkprepvc32.mif.









































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

#==============================================================================
#
#   mkprepvc32.mif --
#
#   Make preparation file for the Microsoft Visual C++ 32-bit tools.
#   NMAKE specific syntax is allowed in this file.  This file prepares the 
#   environment.
#
#==============================================================================
# RCS: @(#) $Id: mkprepvc32.mif,v 1.1.2.1 2001/09/28 02:15:55 davygrvy Exp $
#==============================================================================

!ifndef _MKPREPVC32_MIF
_MKPREPVC32_MIF = 1

#==============================================
# check for local.
#==============================================
!if !exist(.\win\mkvc32.mif)
!error The current working directory must be the top root of Expect before running 'makefile.win'
!endif


MAKECMD	    = cd win & nmake.exe -nologo /$(MAKEFLAGS) -f makefile.vc32
SYM	    =


#==============================================
# Are the tools in the path already?
#==============================================

###  Unfortunetly, we can't just source this into the parent
###  environment just once and have it affect all targets.

!if !defined(MSVCDIR)
!if     $(TOOLSETvc32VER) == 5
vcvars	    = "$(TOOLSETvc32)\vc\bin\vcvars32.bat"
!elseif $(TOOLSETvc32VER) == 6
vcvars	    = "$(TOOLSETvc32)\vc98\bin\vcvars32.bat"
!endif
!message +++ Microsoft Visual C++ tools are NOT in the path and
!message +++    $(vcvars) will be used.


### We now need to recurse back into ourselves to fix the environment,
### then bail on this run.
!if [ $(vcvars) & nmake -nologo /$(MAKEFLAGS) -f makefile.win ] != 0
!endif

BAILOUT = 1
all :
release :
test :
debugger :
slavedrv :
telnet :
genstubs :
install :
winhelp :
cvsupdate :

!else

!message +++ Microsoft Visual C++ tools are in the path.

!endif
!endif






Added win/mkvc32.mif.































































































































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

#==============================================================================
#
#   Make information file for the Microsoft Visual C++ 32-bit tools.
#
#
#   NMAKE specific syntax is allowed in this file.
#
#==============================================================================
# RCS: @(#) $Id: mkvc32.mif,v 1.1.2.4 2001/10/11 03:59:36 davygrvy Exp $
#==============================================================================

!ifndef _MKVC32_MIF
_MKVC32_MIF = 1

!include ..\mkconfig.mif


TOOLSET	    = vc32

rc32	    = $(RC)
cc32	    = $(CC)
link32	    = link
lib32	    = lib
cvtres32    = cvtres

!ifndef OUT_DIR
OUT_DIR	    = $(TMP_DIR)
!endif

!if !defined(DEBUG)
DEBUG		= 0
NODEBUG		= 1
!elseif $(DEBUG) == 1
!undef NODEBUG
!else
NODEBUG		= 1
!endif

!ifndef STATIC_BUILD
STATIC_BUILD	= 0
!endif

!ifndef USE_TCL_STUBS
USE_TCL_STUBS	= 1
!endif

# Set NOMSVCRT to 1 to use libcmt(d).lib instead of the
# dynamic run-time.
#
!ifndef NOMSVCRT
!if $(STATIC_BUILD)
NOMSVCRT	= 1
!else
NOMSVCRT	= 0
!endif
!endif

!if $(STATIC_BUILD) == 0 && $(NOMSVCRT) == 1
!error The static runtime in a loadable (dll) extension is a useless configuration that will cause abnormal and unnecessary code bloat.
!endif

!if $(DEBUG)
TMPDIRNAMEPREFIX = Debug
DBGX = d
!else
TMPDIRNAMEPREFIX = Release
DBGX =
!endif

TMPDIRNAME	=

!if $(STATIC_BUILD)
!if $(NOMSVCRT) == 0
TMPDIRNAME = $(TMPDIRNAMEPREFIX)_StaticX
STCX	= x
!else
TMPDIRNAME = $(TMPDIRNAMEPREFIX)_Static
STCX	= s
!endif
OUTEXT	= lib
!else
STCX	=
OUTEXT	= dll
!endif

!if "$(TMPDIRNAME)" == ""
TMPDIRNAME	= $(TMPDIRNAMEPREFIX)
!endif

SOURCEROOT	= ..
COMPATDIR	= $(SOURCEROOT)\compat
GENERICDIR	= $(SOURCEROOT)\generic
TESTDIR		= $(SOURCEROOT)\tests
TOOLSDIR	= $(SOURCEROOT)\tools
WINDIR		= $(SOURCEROOT)\win
TMP_DIR		= $(WINDIR)\$(TMPDIRNAME)

!ifndef OUT_DIR
OUT_DIR		= $(WINDIR)\$(TMPDIRNAME)
!endif

# Is TCLROOT pointing to the sources or the install ?
#
!if $(ISTCLINSTALL)
TCLSTUBSLIB	= "$(TCLROOT)\lib\tclstub$(TCLMAJOR)$(TCLMINOR).lib"
TCLLIB		= "$(TCLROOT)\lib\tcl$(TCLMAJOR)$(TCLMINOR).lib"
TCLSH_PROG	= "$(TCLROOT)\bin\tclsh$(TCLMAJOR)$(TCLMINOR).exe"
!else
TCLSTUBSLIB	= "$(TCLROOT)\win\$(TMPDIRNAMEPREFIX)\tclstub$(TCLMAJOR)$(TCLMINOR)$(DBGX).lib"
TCLLIB		= "$(TCLROOT)\win\$(TMPDIRNAMEPREFIX)\tcl$(TCLMAJOR)$(TCLMINOR)$(DBGX).lib"
TCLSH_PROG	= "$(TCLROOT)\win\$(TMPDIRNAMEPREFIX)\tclsh$(TCLMAJOR)$(TCLMINOR)$(DBGX).exe"
!endif

!if $(ISTCLINSTALL)
TCL_INCLUDES	= -I"$(TCLROOT)\include"
TCL_INTINCLUDES	= -I"$(TCLROOT)\include"
!else
TCL_INCLUDES	= -I"$(TCLROOT)\generic"
TCL_INTINCLUDES	= -I"$(TCLROOT)\generic" -I"$(TCLROOT)\win"
!endif

#==============================================
# Test for compiler features
#==============================================

### Win95 doesn't support "2>&1".
### Anyone got a work-around?

!if [ $(cc32) -c -Zs -TC nul 2>&1 | find "(R)" ] == 0

!if [ $(cc32) -nologo -ZI -c -Zs -TC -Fdtemp nul 2>&1 | find /c "D4002" > nul ] != 0
!message +++ compiler has `edit and continue`
!else
!message +++ compiler doesn't have `edit and continue`
!endif

!if [ $(cc32) -nologo -Ox -c -Zs -TC -Fdtemp nul 2>&1 | find /c "D4002" > nul ] != 0
!message +++ compiler has `optimizations`
COPTS	= -Ox
!else
!message +++ compiler doesn't have `optimizations`
COPTS	=
!endif

### Force a chariage return.
!if [ echo. ] != 0
!endif

### Clean-up temp files after tests.
!if [ @for %d in (temp.idb temp.pdb) do @if exist %d erase %d ] != 0
!endif

CFLAGS	= -nologo -c $(COPTS) -MD$(DBGX) -YX -Fo$(TMP_DIR)^\ -Fp$(TMP_DIR)^\

!else
!error "$(cc32)" is STILL not available in the path.
!endif

#==============================================
# a bug fix needed for VC++ 6.0's nmake tool.
#
# Reset the version *string* back to the integer
# it's supposed to be.  More entries will have
# to be made here for all subsiquent nmake
# releases until Microsoft fixes it.
#
# Please log your displeasure with their product
# by sending an email to [email protected]
#
_NMAKE_VER  = $(_NMAKE_VER:6.00.8168.0=600)
#==============================================


# Win95 doesn't support "&" on command line.
#MkDest=@for %d in ($(PLATFORM) $(ObjDir)) do $(COMSPEC) /c if not exist %d md %d

#clean:
# $(MkDest)
#!if "$(OS)" == "Windows_NT"
# del /q $(ObjDir)\*.obj \
#        $(ObjDir)\*.out \
#        $(ObjDir)\*.h   \
#        $(ObjDir)\*.dbg \
#        $(ObjDir)\*.ocx \
#        $(ObjDir)\*.log \
#        $(ObjDir)\*.lib \
#        $(ObjDir)\*.exe \
#        $(ObjDir)\*.dll \
#        $(ObjDir)\*.map \
#        $(ObjDir)\*.res \
#        $(ObjDir)\*.bin \
#        $(ObjDir)\*.lst \
#        $(ObjDir)\*.blt \
#        $(ObjDir)\*.hlp \
#        $(ObjDir)\*.srl \
#        $(ObjDir)\*.exp >NUL 2>NUL
#!else  # Win95 doesn't support "2>" on command line, multiple files on a Del command, or /q
# erase  $(ObjDir)\*.obj >NUL
# erase  $(ObjDir)\*.out >NUL
# erase  $(ObjDir)\*.h   >NUL
# erase  $(ObjDir)\*.dbg >NUL
# erase  $(ObjDir)\*.ocx >NUL
# erase  $(ObjDir)\*.log >NUL
# erase  $(ObjDir)\*.lib >NUL
# erase  $(ObjDir)\*.exe >NUL
# erase  $(ObjDir)\*.dll >NUL
# erase  $(ObjDir)\*.map >NUL
# erase  $(ObjDir)\*.res >NUL
# erase  $(ObjDir)\*.bin >NUL
# erase  $(ObjDir)\*.lst >NUL
# erase  $(ObjDir)\*.blt >NUL
# erase  $(ObjDir)\*.hlp >NUL
# erase  $(ObjDir)\*.srl >NUL
# erase  $(ObjDir)\*.exp >NUL
#!endif  # OS == Windows_NT

!endif  # _MKVC32_MIF






Added win/mkwc32.mif.




































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

#==============================================================================
#
#   Make information file for the Watcom 32-bit C/C++ tools.
#
#
#   WMAKE specific syntax is allowed in this file.
#
#==============================================================================
# RCS: @(#) $Id: mkwc32.mif,v 1.1.2.2 2001/09/09 04:20:04 davygrvy Exp $
#==============================================================================

TOOLSET	    = wc32
MAKECMD	    = wmake.exe -h -ms $(__MAKEOPTS__) -f makefile.wc32

SYM	    = .SYMBOLIC

!ifdef __LOADDLL__
!  loaddll $(TOOLSETwc32)\bin\wcc386   wccd386
!  loaddll $(TOOLSETwc32)\bin\wpp386   wppd386
!  loaddll $(TOOLSETwc32)\bin\wlink    wlink
!  loaddll $(TOOLSETwc32)\bin\wlib     wlibd
!endif


.AFTER
	@echo.
	@echo Thank you for choosing Tcl.

.ERROR
	@echo lalala






Changes to win/msjexhnd.cpp.






︙


130
131
132
133
134
135
136
137

138
139
140
141
142
143
144
145
146
147
148
149
150

151
152
153
154
155
156

157
158
159

160
161
162
163
164
165
166

130
131
132
133
134
135
136

137
138
139
140
141
142
143
144
145
146
147
148
149

150
151
152
153
154
155

156
157
158

159
160
161
162
163
164
165
166








-
+












-
+





-
+


-
+








    _tprintf( _T("Fault address:  %08X %02X:%08X %s\n"),
              pExceptionRecord->ExceptionAddress,
              section, offset, szFaultingModule );

    PCONTEXT pCtx = pExceptionInfo->ContextRecord;

    // Show the registers
    #ifdef _M_IX86  // Intel Only!
#ifdef _M_IX86  // Intel Only!
    _tprintf( _T("\nRegisters:\n") );

    _tprintf(_T("EAX:%08X\nEBX:%08X\nECX:%08X\nEDX:%08X\nESI:%08X\nEDI:%08X\n"),
             pCtx->Eax, pCtx->Ebx, pCtx->Ecx, pCtx->Edx, pCtx->Esi, pCtx->Edi );

    _tprintf( _T("CS:EIP:%04X:%08X\n"), pCtx->SegCs, pCtx->Eip );
    _tprintf( _T("SS:ESP:%04X:%08X  EBP:%08X\n"),
              pCtx->SegSs, pCtx->Esp, pCtx->Ebp );
    _tprintf( _T("DS:%04X  ES:%04X  FS:%04X  GS:%04X\n"),
              pCtx->SegDs, pCtx->SegEs, pCtx->SegFs, pCtx->SegGs );
    _tprintf( _T("Flags:%08X\n"), pCtx->EFlags );

    #endif
#endif

    if ( !InitImagehlpFunctions() )
    {
        OutputDebugString(_T("IMAGEHLP.DLL or its exported procs not found"));
        
        #ifdef _M_IX86  // Intel Only!
#ifdef _M_IX86  // Intel Only!
        // Walk the stack using x86 specific code
        IntelStackWalk( pCtx );
        #endif
#endif

        return;
    }

    ImagehlpStackWalk( pCtx );

    _SymCleanup( GetCurrentProcess() );




︙





Changes to win/msjexhnd.h.






︙


24
25
26
27
28
29
30
31

32
33

34
35
36

37
38

39
40
41
42
43
44
45

46
47
48
49
50
51
52

24
25
26
27
28
29
30

31
32

33
34
35

36
37

38
39
40
41
42
43
44

45
46
47
48
49
50
51
52








-
+

-
+


-
+

-
+






-
+








      static void GenerateExceptionReport( PEXCEPTION_POINTERS pExceptionInfo );

      // Helper functions
      static LPTSTR GetExceptionString( DWORD dwCode );
      static BOOL GetLogicalAddress(PVOID addr, PTSTR szModule, DWORD len,
                                    DWORD& section, DWORD& offset );
      static void IntelStackWalk( PCONTEXT pContext );
      #if 1
#if 1
      static void ImagehlpStackWalk( PCONTEXT pContext );
      #endif
#endif
      static int __cdecl _tprintf(const TCHAR * format, ...);

      #if 1
#if 1
      static BOOL InitImagehlpFunctions( void );
      #endif
#endif
          
      // Variables used by the class
      static TCHAR m_szLogFileName[MAX_PATH];
      static LPTOP_LEVEL_EXCEPTION_FILTER m_previousFilter;
      static HANDLE m_hReportFile;

      #if 1
#if 1
      // Make typedefs for some IMAGEHLP.DLL functions so that we can use them
      // with GetProcAddress
      typedef BOOL (__stdcall * SYMINITIALIZEPROC)( HANDLE, LPSTR, BOOL );
      typedef BOOL (__stdcall *SYMCLEANUPPROC)( HANDLE );

      typedef BOOL (__stdcall * STACKWALKPROC)
                   ( DWORD, HANDLE, HANDLE, LPSTACKFRAME, LPVOID,




︙


63
64
65
66
67
68
69
70

71
72
73
74
75
76

63
64
65
66
67
68
69

70
71
72
73
74
75
76








-
+







      static SYMINITIALIZEPROC _SymInitialize;
      static SYMCLEANUPPROC _SymCleanup;
      static STACKWALKPROC _StackWalk;
      static SYMFUNCTIONTABLEACCESSPROC _SymFunctionTableAccess;
      static SYMGETMODULEBASEPROC _SymGetModuleBase;
      static SYMGETSYMFROMADDRPROC _SymGetSymFromAddr;

      #endif
#endif

};

extern MSJExceptionHandler g_MSJExceptionHandler;  // global instance of class

#endif






Deleted win/panic.c.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96


































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

/* 
 * panic.c --
 *
 *	Source code for the "panic" library procedure for Tcl;
 *	individual applications will probably override this with
 *	an application-specific panic procedure.
 *
 * Copyright (c) 1988-1993 The Regents of the University of California.
 * Copyright (c) 1994 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) panic.c 1.15 96/09/12 14:55:25
 */

#include <stdio.h>
#ifdef NO_STDLIB_H
#   include "../compat/stdlib.h"
#else
#   include <stdlib.h>
#endif

#define panic panicDummy
#include "tcl.h"
#undef panic

EXTERN void		panic _ANSI_ARGS_((char *format, char *arg1,
			    char *arg2, char *arg3, char *arg4, char *arg5,
			    char *arg6, char *arg7, char *arg8));

/*
 * The panicProc variable contains a pointer to an application
 * specific panic procedure.
 */

void (*panicProc) _ANSI_ARGS_(TCL_VARARGS(char *,format)) = NULL;

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetPanicProc --
 *
 *	Replace the default panic behavior with the specified functiion.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Sets the panicProc variable.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_SetPanicProc(proc)
    void (*proc) _ANSI_ARGS_(TCL_VARARGS(char *,format));
{
    panicProc = proc;
}

/*
 *----------------------------------------------------------------------
 *
 * panic --
 *
 *	Print an error message and kill the process.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The process dies, entering the debugger if possible.
 *
 *----------------------------------------------------------------------
 */

	/* VARARGS ARGSUSED */
void
panic(format, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8)
    char *format;		/* Format string, suitable for passing to
				 * fprintf. */
    char *arg1, *arg2, *arg3;	/* Additional arguments (variable in number)
				 * to pass to fprintf. */
    char *arg4, *arg5, *arg6, *arg7, *arg8;
{
    if (panicProc != NULL) {
	(void) (*panicProc)(format, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8);
    } else {
	(void) fprintf(stderr, format, arg1, arg2, arg3, arg4, arg5, arg6,
		arg7, arg8);
	(void) fprintf(stderr, "\n");
	(void) fflush(stderr);
	abort();
    }
}






Added win/slavedrv.dsp.







































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

# Microsoft Developer Studio Project File - Name="slavedrv" - Package Owner=<4>
# Microsoft Developer Studio Generated Build File, Format Version 6.00
# ** DO NOT EDIT **

# TARGTYPE "Win32 (x86) External Target" 0x0106

CFG=slavedrv - Win32 Debug
!MESSAGE This is not a valid makefile. To build this project using NMAKE,
!MESSAGE use the Export Makefile command and run
!MESSAGE 
!MESSAGE NMAKE /f "slavedrv.mak".
!MESSAGE 
!MESSAGE You can specify a configuration when running NMAKE
!MESSAGE by defining the macro CFG on the command line. For example:
!MESSAGE 
!MESSAGE NMAKE /f "slavedrv.mak" CFG="slavedrv - Win32 Debug"
!MESSAGE 
!MESSAGE Possible choices for configuration are:
!MESSAGE 
!MESSAGE "slavedrv - Win32 Release" (based on "Win32 (x86) External Target")
!MESSAGE "slavedrv - Win32 Debug" (based on "Win32 (x86) External Target")
!MESSAGE 

# Begin Project
# PROP AllowPerConfigDependencies 0
# PROP Scc_ProjName ""
# PROP Scc_LocalPath ""

!IF  "$(CFG)" == "slavedrv - Win32 Release"

# PROP BASE Use_MFC 0
# PROP BASE Use_Debug_Libraries 0
# PROP BASE Output_Dir ""
# PROP BASE Intermediate_Dir ""
# PROP BASE Cmd_Line "NMAKE /f slavedrv.mak"
# PROP BASE Rebuild_Opt "/a"
# PROP BASE Target_File "slavedrv.exe"
# PROP BASE Bsc_Name "slavedrv.bsc"
# PROP BASE Target_Dir ""
# PROP Use_MFC 0
# PROP Use_Debug_Libraries 0
# PROP Output_Dir ""
# PROP Intermediate_Dir ""
# PROP Cmd_Line "nmake -nologo -f makefile.vc32 slavedrv DEBUG=1"
# PROP Rebuild_Opt "/a"
# PROP Target_File "Release/slavedrv.exe"
# PROP Bsc_Name ""
# PROP Target_Dir ""

!ELSEIF  "$(CFG)" == "slavedrv - Win32 Debug"

# PROP BASE Use_MFC 0
# PROP BASE Use_Debug_Libraries 1
# PROP BASE Output_Dir ""
# PROP BASE Intermediate_Dir ""
# PROP BASE Cmd_Line "NMAKE /f slavedrv.mak"
# PROP BASE Rebuild_Opt "/a"
# PROP BASE Target_File "slavedrv.exe"
# PROP BASE Bsc_Name "slavedrv.bsc"
# PROP BASE Target_Dir ""
# PROP Use_MFC 0
# PROP Use_Debug_Libraries 1
# PROP Output_Dir ""
# PROP Intermediate_Dir ""
# PROP Cmd_Line "nmake -nologo -f makefile.vc32 slavedrv DEBUG=1"
# PROP Rebuild_Opt "/a"
# PROP Target_File "Debug/slavedrv.exe"
# PROP Bsc_Name ""
# PROP Target_Dir ""

!ENDIF 

# Begin Target

# Name "slavedrv - Win32 Release"
# Name "slavedrv - Win32 Debug"

!IF  "$(CFG)" == "slavedrv - Win32 Release"

!ELSEIF  "$(CFG)" == "slavedrv - Win32 Debug"

!ENDIF 

# Begin Group "Resource Files"

# PROP Default_Filter ""
# Begin Source File

SOURCE=.\spawndrv.rc
# End Source File
# Begin Source File

SOURCE=.\spawndrvmc.mc
# End Source File
# End Group
# Begin Source File

SOURCE=.\expWin.h
# End Source File
# Begin Source File

SOURCE=.\expWinDynloadTclStubs.c
# End Source File
# Begin Source File

SOURCE=.\expWinLog.c
# End Source File
# Begin Source File

SOURCE=.\expWinProcess.c
# End Source File
# Begin Source File

SOURCE=.\expWinSlave.h
# End Source File
# Begin Source File

SOURCE=.\expWinSlaveDbg.c
# End Source File
# Begin Source File

SOURCE=.\expWinSlaveDrv.c
# End Source File
# Begin Source File

SOURCE=.\expWinSlaveKey.c
# End Source File
# End Target
# End Project






Added win/spawndrv.rc.


















































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

// RCS: @(#) $Id: spawndrv.rc,v 1.1.2.3 2001/10/12 19:59:09 davygrvy Exp $

#include <winver.h>
#define RESOURCE_INCLUDED   /* needed by tcl.h because it doesn't use RC_INVOKED */
#include "tcl.h"
#include "exp_version.h"

VS_VERSION_INFO VERSIONINFO
    FILEVERSION	    EXP_MAJOR_VERSION,EXP_MINOR_VERSION,EXP_RELEASE_LEVEL,EXP_RELEASE_SERIAL
    PRODUCTVERSION  EXP_MAJOR_VERSION,EXP_MINOR_VERSION,EXP_RELEASE_LEVEL,EXP_RELEASE_SERIAL
    FILEFLAGSMASK   VS_FFI_FILEFLAGSMASK
#if DEBUG
    FILEFLAGS	    VS_FF_DEBUG
#else
    FILEFLAGS	    VS_FF_PRERELEASE   /* 0x0L */
#endif
    FILEOS	    VOS__WINDOWS32
    FILETYPE	    VFT_DLL
    FILESUBTYPE     VFT2_UNKNOWN
BEGIN
    BLOCK "StringFileInfo"
    BEGIN
        BLOCK "040904b0" /* LANG_ENGLISH/SUBLANG_ENGLISH_US, Unicode CP */
        BEGIN
            VALUE "FileDescription", "Spawn Driver helper application for overseeing Win32 consoles.\0"
            VALUE "OriginalFilename", "spawndrv.exe\0"
            VALUE "CompanyName", "Telindustrie, LLC\0"
            VALUE "FileVersion", EXP_PATCH_LEVEL "\0"
            VALUE "LegalCopyright", "Copyright \251 Telindustrie, LLC 2001\0"
            VALUE "ProductName", "Expect " EXP_VERSION " for Win32\0"
            VALUE "ProductVersion", EXP_PATCH_LEVEL "\0"
	    VALUE "Comments", "Expect was written for Unix by Don Libes at NIST.\r\n" "Gordon Chaffee ported it to WinNT for Mitel Corporation in 1997.\r\n" "David Gravereaux merged Gordon's port back into the official sources for Telindustrie LLC in Oct. 2001.\0"
        END
    END
    BLOCK "VarFileInfo"
    BEGIN
        VALUE "Translation", 0x409, 1200
    END
END


// Include the Message Table that lists the error codes and textual replies.
// This is output from the message compiler and found in the temp build directory.
#include "spawndrvmc.rc"






Added win/spawndrvmc.mc.




































































































































































































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286

+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+

;/* ----------------------------------------------------------------------------
; * spawndrvmc.mc --
; *
; *	This file contains the message catalog for use with Win32 error
; *	reporting through ReportEvent() and FormatMessage().
; *
; * Copyright (c) 2001 Telindustrie, LLC
; *
; * Authors: David Gravereaux <[email protected]>
; *
; * See the file "license.terms" for information on usage and redistribution
; * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
; * ----------------------------------------------------------------------------
; */

MessageIdTypedef = DWORD
OutputBase = 16

SeverityNames = (
    Success=0x0:STATUS_SEVERITY_SUCCESS
    Informational=0x1:STATUS_SEVERITY_INFORMATIONAL
    Warning=0x2:STATUS_SEVERITY_WARNING
    Fatal=0x3:STATUS_SEVERITY_FATAL
)

FacilityNames = (
    Catagories=0x0
    System=0x0:FACILITY_SYSTEM
    Stubs=0x1:FACILITY_STUBS
    Io=0x2:FACILITY_IO
    Mailbox=0x3:FACILITY_MAILBOX
    NamedPipe=0x4:FACILITY_NAMEDPIPE
    WinSock=0x5:FACILITY_WINSOCK
    DbgTrap=0x6:FACILITY_DBGTRAP
    MasterSlave_Protocol=0x7:FACILITY_MSPROTO
)

LanguageNames=(English=0x409:MSG00409)

MessageId=0x1
Severity=Success
Facility=Catagories
Language=English
Stubs
.

MessageId=0x2
Severity=Success
Facility=Catagories
Language=English
General I/O
.

MessageId=0x3
Severity=Success
Facility=Catagories
Language=English
MailBoxing IPC
.

MessageId=0x4
Severity=Success
Facility=Catagories
Language=English
NamedPipe IPC
.

MessageId=0x5
Severity=Success
Facility=Catagories
Language=English
WinSock IPC
.

MessageId=0x6
Severity=Success
Facility=Catagories
Language=English
Console API traps
.

MessageId=0x7
Severity=Success
Facility=Catagories
Language=English
Master/Slave protocol
.

MessageId=0x1
Severity=Error
Facility=System
SymbolicName=MSG_BYPASS
Language=English
%1
.



MessageId=0x1
Severity=Error
Facility=Io
SymbolicName=MSG_IO_ARGSWRONG
Language=English
%1 : %2 (%3,%4): No commandline arguements to slavedrv.exe.  No work to do.
.

MessageId=0x2
Severity=Warning
Facility=Io
SymbolicName=MSG_IO_BADSHUTDOWN
Language=English
%1 : %2 (%3,%4): Unclean shutdown: %5
.

MessageId=0x2
Severity=Error
Facility=Io
SymbolicName=MSG_IO_UNEXPECTED
Language=English
%1 : %2 (%3,%4): Unexpected error: %5
.




MessageId=0x1
Severity=Fatal
Facility=Stubs
SymbolicName=MSG_STUBS_TCLDLLCANTFIND
Language=English
%1 : %2 (%3,%4): Tcl is not available.  The Tcl Dll as specified in the environment variable EXP_TCLDLL as "%5" could not be loaded by LoadLibrary().  Check that EXP_TCLDLL has the correct filename and is the fullpath. ex: "C:\Program Files\Tcl\bin\tcl84.dll"
.

MessageId=0x2
Severity=Fatal
Facility=Stubs
SymbolicName=MSG_STUBS_NOCREATEINTERP
Language=English
%1 : %2 (%3,%4): Tcl API function, Tcl_CreateInterp(), not found in "%5".
.

MessageId=0x3
Severity=Fatal
Facility=Stubs
SymbolicName=MSG_STUBS_ENVARNOTSET
Language=English
%1 : %2 (%3,%4): EXP_TCLDLL was not found in the environment.  It is required for slavedrv.exe to know where the Tcl DLL is to use its services.  The channel driver in the Expect extension should be setting this before launching spawndrv.exe.  This executable was not intended to be used outside of the Expect extension.
.

MessageId=0x4
Severity=Fatal
Facility=Stubs
SymbolicName=MSG_STUBS_INITSTUBS
Language=English
%1 : %2 (%3,%4): Tcl_InitStubs() failed with "%5".
.




MessageId=0x1
Severity=Warning
Facility=MasterSlave_Protocol
SymbolicName=MSG_MS_SLAVENOWRITABLE
Language=English
%1 : %2 (%3,%4): Unable to write to slave: %5
.

MessageId=0x2
Severity=Error
Facility=MasterSlave_Protocol
SymbolicName=MSG_MS_BADSTATE
Language=English
%1 : %2 (%3,%4): Unexpected state
.




MessageId=0x1
Severity=Error
Facility=NamedPipe
SymbolicName=MSG_NP_CANTOPEN
Language=English
%1 : %2 (%3,%4): Can't open argv[1], "%5", for read/write.  CreateFile() returned: %6
.

MessageId=0x2
Severity=Error
Facility=NamedPipe
SymbolicName=MSG_NP_BADTYPE
Language=English
%1 : %2 (%3,%4): NamedPipe specified as, "%5", was found not to be a pipe filetype.
.


MessageId=0x1
Severity=Error
Facility=WinSock
SymbolicName=MSG_WS_CANTSTART
Language=English
%1 : %2 (%3,%4): WinSock system was unable to start.  slavedrv.exe requested version %5.  WSAStartup() returned: %6
.

MessageId=0x2
Severity=Error
Facility=WinSock
SymbolicName=MSG_WS_CANTCREATEMASTERSOCK
Language=English
%1 : %2 (%3,%4): Master socket was unable to be created.  WSASocket() returned: %6
.

MessageId=0x3
Severity=Error
Facility=WinSock
SymbolicName=MSG_WS_CANTCONNECTMASTERSOCK
Language=English
%1 : %2 (%3,%4): Can't connect to local loopback on port %5.  connect() returned: %6
.

MessageId=0x4
Severity=Error
Facility=WinSock
SymbolicName=MSG_WS_PORTOUTOFRANGE
Language=English
%1 : %2 (%3,%4): Local loopback port out-of-range at "%5".  Must be greater than zero and less than 65536.
.




MessageId=0x1
Severity=Error
Facility=DbgTrap
SymbolicName=MSG_DT_CANTGETCONSOLEHANDLE
Language=English
%1 : %2 (%3,%4): Can't open a console handle. CreateFile("%5") returned: %6
.

MessageId=0x2
Severity=Warning
Facility=DbgTrap
SymbolicName=MSG_DT_UNEXPECTEDDBGEVENT
Language=English
%1 : %2 (%3,%4): Unexpected debug event for %5
.

MessageId=0x3
Severity=Warning
Facility=DbgTrap
SymbolicName=MSG_DT_EXCEPTIONDBGEVENT
Language=English
%1 : %2 (%3,%4): Exception code is %5
.

MessageId=0x4
Severity=Warning
Facility=DbgTrap
SymbolicName=MSG_DT_NOVIRT
Language=English
%1 : %2 (%3,%4): Unable to find entry for VirtualAlloc
.

MessageId=0x5
Severity=Warning
Facility=DbgTrap
SymbolicName=MSG_DT_CANTREADSPMEM
Language=English
%1 : %2 (%3,%4): Error reading from subprocess memory
.

MessageId=0x6
Severity=Warning
Facility=DbgTrap
SymbolicName=MSG_DT_CANTWRITESPMEM
Language=English
%1 : %2 (%3,%4): Error writing to subprocess memory
.

MessageId=0x7
Severity=Warning
Facility=DbgTrap
SymbolicName=MSG_DT_SCREENBUF
Language=English
%1 : %2 (%3,%4): Call to GetConsoleScreenBufferInfo() failed with %5, %6
.






Deleted win/tclHash.c.





1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921



























































































































































































































































































































































































































































































































































































































































































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-

/* 
 * tclHash.c --
 *
 *	Implementation of in-memory hash tables for Tcl and Tcl-based
 *	applications.
 *
 * Copyright (c) 1991-1993 The Regents of the University of California.
 * Copyright (c) 1994 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * SCCS: @(#) tclHash.c 1.16 96/04/29 10:30:49
 */

#include "tclInt.h"

/*
 * When there are this many entries per bucket, on average, rebuild
 * the hash table to make it larger.
 */

#define REBUILD_MULTIPLIER	3


/*
 * The following macro takes a preliminary integer hash value and
 * produces an index into a hash tables bucket list.  The idea is
 * to make it so that preliminary values that are arbitrarily similar
 * will end up in different buckets.  The hash function was taken
 * from a random-number generator.
 */

#define RANDOM_INDEX(tablePtr, i) \
    (((((long) (i))*1103515245) >> (tablePtr)->downShift) & (tablePtr)->mask)

/*
 * Procedure prototypes for static procedures in this file:
 */

static Tcl_HashEntry *	ArrayFind _ANSI_ARGS_((Tcl_HashTable *tablePtr,
			    CONST char *key));
static Tcl_HashEntry *	ArrayCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr,
			    CONST char *key, int *newPtr));
static Tcl_HashEntry *	BogusFind _ANSI_ARGS_((Tcl_HashTable *tablePtr,
			    CONST char *key));
static Tcl_HashEntry *	BogusCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr,
			    CONST char *key, int *newPtr));
static unsigned int	HashString _ANSI_ARGS_((CONST char *string));
static void		RebuildTable _ANSI_ARGS_((Tcl_HashTable *tablePtr));
static Tcl_HashEntry *	StringFind _ANSI_ARGS_((Tcl_HashTable *tablePtr,
			    CONST char *key));
static Tcl_HashEntry *	StringCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr,
			    CONST char *key, int *newPtr));
static Tcl_HashEntry *	OneWordFind _ANSI_ARGS_((Tcl_HashTable *tablePtr,
			    CONST char *key));
static Tcl_HashEntry *	OneWordCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr,
			    CONST char *key, int *newPtr));

/*
 *----------------------------------------------------------------------
 *
 * Tcl_InitHashTable --
 *
 *	Given storage for a hash table, set up the fields to prepare
 *	the hash table for use.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	TablePtr is now ready to be passed to Tcl_FindHashEntry and
 *	Tcl_CreateHashEntry.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_InitHashTable(tablePtr, keyType)
    register Tcl_HashTable *tablePtr;	/* Pointer to table record, which
					 * is supplied by the caller. */
    int keyType;			/* Type of keys to use in table:
					 * TCL_STRING_KEYS, TCL_ONE_WORD_KEYS,
					 * or an integer >= 2. */
{
    tablePtr->buckets = tablePtr->staticBuckets;
    tablePtr->staticBuckets[0] = tablePtr->staticBuckets[1] = 0;
    tablePtr->staticBuckets[2] = tablePtr->staticBuckets[3] = 0;
    tablePtr->numBuckets = TCL_SMALL_HASH_TABLE;
    tablePtr->numEntries = 0;
    tablePtr->rebuildSize = TCL_SMALL_HASH_TABLE*REBUILD_MULTIPLIER;
    tablePtr->downShift = 28;
    tablePtr->mask = 3;
    tablePtr->keyType = keyType;
    if (keyType == TCL_STRING_KEYS) {
	tablePtr->findProc = StringFind;
	tablePtr->createProc = StringCreate;
    } else if (keyType == TCL_ONE_WORD_KEYS) {
	tablePtr->findProc = OneWordFind;
	tablePtr->createProc = OneWordCreate;
    } else {
	tablePtr->findProc = ArrayFind;
	tablePtr->createProc = ArrayCreate;
    };
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DeleteHashEntry --
 *
 *	Remove a single entry from a hash table.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The entry given by entryPtr is deleted from its table and
 *	should never again be used by the caller.  It is up to the
 *	caller to free the clientData field of the entry, if that
 *	is relevant.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_DeleteHashEntry(entryPtr)
    Tcl_HashEntry *entryPtr;
{
    register Tcl_HashEntry *prevPtr;

    if (*entryPtr->bucketPtr == entryPtr) {
	*entryPtr->bucketPtr = entryPtr->nextPtr;
    } else {
	for (prevPtr = *entryPtr->bucketPtr; ; prevPtr = prevPtr->nextPtr) {
	    if (prevPtr == NULL) {
		panic("malformed bucket chain in Tcl_DeleteHashEntry");
	    }
	    if (prevPtr->nextPtr == entryPtr) {
		prevPtr->nextPtr = entryPtr->nextPtr;
		break;
	    }
	}
    }
    entryPtr->tablePtr->numEntries--;
    ckfree((char *) entryPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_DeleteHashTable --
 *
 *	Free up everything associated with a hash table except for
 *	the record for the table itself.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The hash table is no longer useable.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_DeleteHashTable(tablePtr)
    register Tcl_HashTable *tablePtr;		/* Table to delete. */
{
    register Tcl_HashEntry *hPtr, *nextPtr;
    int i;

    /*
     * Free up all the entries in the table.
     */

    for (i = 0; i < tablePtr->numBuckets; i++) {
	hPtr = tablePtr->buckets[i];
	while (hPtr != NULL) {
	    nextPtr = hPtr->nextPtr;
	    ckfree((char *) hPtr);
	    hPtr = nextPtr;
	}
    }

    /*
     * Free up the bucket array, if it was dynamically allocated.
     */

    if (tablePtr->buckets != tablePtr->staticBuckets) {
	ckfree((char *) tablePtr->buckets);
    }

    /*
     * Arrange for panics if the table is used again without
     * re-initialization.
     */

    tablePtr->findProc = BogusFind;
    tablePtr->createProc = BogusCreate;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_FirstHashEntry --
 *
 *	Locate the first entry in a hash table and set up a record
 *	that can be used to step through all the remaining entries
 *	of the table.
 *
 * Results:
 *	The return value is a pointer to the first entry in tablePtr,
 *	or NULL if tablePtr has no entries in it.  The memory at
 *	*searchPtr is initialized so that subsequent calls to
 *	Tcl_NextHashEntry will return all of the entries in the table,
 *	one at a time.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_HashEntry *
Tcl_FirstHashEntry(tablePtr, searchPtr)
    Tcl_HashTable *tablePtr;		/* Table to search. */
    Tcl_HashSearch *searchPtr;		/* Place to store information about
					 * progress through the table. */
{
    searchPtr->tablePtr = tablePtr;
    searchPtr->nextIndex = 0;
    searchPtr->nextEntryPtr = NULL;
    return Tcl_NextHashEntry(searchPtr);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_NextHashEntry --
 *
 *	Once a hash table enumeration has been initiated by calling
 *	Tcl_FirstHashEntry, this procedure may be called to return
 *	successive elements of the table.
 *
 * Results:
 *	The return value is the next entry in the hash table being
 *	enumerated, or NULL if the end of the table is reached.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

Tcl_HashEntry *
Tcl_NextHashEntry(searchPtr)
    register Tcl_HashSearch *searchPtr;	/* Place to store information about
					 * progress through the table.  Must
					 * have been initialized by calling
					 * Tcl_FirstHashEntry. */
{
    Tcl_HashEntry *hPtr;

    while (searchPtr->nextEntryPtr == NULL) {
	if (searchPtr->nextIndex >= searchPtr->tablePtr->numBuckets) {
	    return NULL;
	}
	searchPtr->nextEntryPtr =
		searchPtr->tablePtr->buckets[searchPtr->nextIndex];
	searchPtr->nextIndex++;
    }
    hPtr = searchPtr->nextEntryPtr;
    searchPtr->nextEntryPtr = hPtr->nextPtr;
    return hPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_HashStats --
 *
 *	Return statistics describing the layout of the hash table
 *	in its hash buckets.
 *
 * Results:
 *	The return value is a malloc-ed string containing information
 *	about tablePtr.  It is the caller's responsibility to free
 *	this string.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

char *
Tcl_HashStats(tablePtr)
    Tcl_HashTable *tablePtr;		/* Table for which to produce stats. */
{
#define NUM_COUNTERS 10
    int count[NUM_COUNTERS], overflow, i, j;
    double average, tmp;
    register Tcl_HashEntry *hPtr;
    char *result, *p;

    /*
     * Compute a histogram of bucket usage.
     */

    for (i = 0; i < NUM_COUNTERS; i++) {
	count[i] = 0;
    }
    overflow = 0;
    average = 0.0;
    for (i = 0; i < tablePtr->numBuckets; i++) {
	j = 0;
	for (hPtr = tablePtr->buckets[i]; hPtr != NULL; hPtr = hPtr->nextPtr) {
	    j++;
	}
	if (j < NUM_COUNTERS) {
	    count[j]++;
	} else {
	    overflow++;
	}
	tmp = j;
	average += (tmp+1.0)*(tmp/tablePtr->numEntries)/2.0;
    }

    /*
     * Print out the histogram and a few other pieces of information.
     */

    result = (char *) ckalloc((unsigned) ((NUM_COUNTERS*60) + 300));
    sprintf(result, "%d entries in table, %d buckets\n",
	    tablePtr->numEntries, tablePtr->numBuckets);
    p = result + strlen(result);
    for (i = 0; i < NUM_COUNTERS; i++) {
	sprintf(p, "number of buckets with %d entries: %d\n",
		i, count[i]);
	p += strlen(p);
    }
    sprintf(p, "number of buckets with %d or more entries: %d\n",
	    NUM_COUNTERS, overflow);
    p += strlen(p);
    sprintf(p, "average search distance for entry: %.1f", average);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * HashString --
 *
 *	Compute a one-word summary of a text string, which can be
 *	used to generate a hash index.
 *
 * Results:
 *	The return value is a one-word summary of the information in
 *	string.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static unsigned int
HashString(string)
    register CONST char *string;/* String from which to compute hash value. */
{
    register unsigned int result;
    register int c;

    /*
     * I tried a zillion different hash functions and asked many other
     * people for advice.  Many people had their own favorite functions,
     * all different, but no-one had much idea why they were good ones.
     * I chose the one below (multiply by 9 and add new character)
     * because of the following reasons:
     *
     * 1. Multiplying by 10 is perfect for keys that are decimal strings,
     *    and multiplying by 9 is just about as good.
     * 2. Times-9 is (shift-left-3) plus (old).  This means that each
     *    character's bits hang around in the low-order bits of the
     *    hash value for ever, plus they spread fairly rapidly up to
     *    the high-order bits to fill out the hash value.  This seems
     *    works well both for decimal and non-decimal strings.
     */

    result = 0;
    while (1) {
	c = *string;
	string++;
	if (c == 0) {
	    break;
	}
	result += (result<<3) + c;
    }
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * StringFind --
 *
 *	Given a hash table with string keys, and a string key, find
 *	the entry with a matching key.
 *
 * Results:
 *	The return value is a token for the matching entry in the
 *	hash table, or NULL if there was no matching entry.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static Tcl_HashEntry *
StringFind(tablePtr, key)
    Tcl_HashTable *tablePtr;	/* Table in which to lookup entry. */
    CONST char *key;		/* Key to use to find matching entry. */
{
    register Tcl_HashEntry *hPtr;
    register CONST char *p1, *p2;
    int index;

    index = HashString(key) & tablePtr->mask;

    /*
     * Search all of the entries in the appropriate bucket.
     */

    for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
	    hPtr = hPtr->nextPtr) {
	for (p1 = key, p2 = hPtr->key.string; ; p1++, p2++) {
	    if (*p1 != *p2) {
		break;
	    }
	    if (*p1 == '\0') {
		return hPtr;
	    }
	}
    }
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * StringCreate --
 *
 *	Given a hash table with string keys, and a string key, find
 *	the entry with a matching key.  If there is no matching entry,
 *	then create a new entry that does match.
 *
 * Results:
 *	The return value is a pointer to the matching entry.  If this
 *	is a newly-created entry, then *newPtr will be set to a non-zero
 *	value;  otherwise *newPtr will be set to 0.  If this is a new
 *	entry the value stored in the entry will initially be 0.
 *
 * Side effects:
 *	A new entry may be added to the hash table.
 *
 *----------------------------------------------------------------------
 */

static Tcl_HashEntry *
StringCreate(tablePtr, key, newPtr)
    Tcl_HashTable *tablePtr;	/* Table in which to lookup entry. */
    CONST char *key;		/* Key to use to find or create matching
				 * entry. */
    int *newPtr;		/* Store info here telling whether a new
				 * entry was created. */
{
    register Tcl_HashEntry *hPtr;
    register CONST char *p1, *p2;
    int index;

    index = HashString(key) & tablePtr->mask;

    /*
     * Search all of the entries in this bucket.
     */

    for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
	    hPtr = hPtr->nextPtr) {
	for (p1 = key, p2 = hPtr->key.string; ; p1++, p2++) {
	    if (*p1 != *p2) {
		break;
	    }
	    if (*p1 == '\0') {
		*newPtr = 0;
		return hPtr;
	    }
	}
    }

    /*
     * Entry not found.  Add a new one to the bucket.
     */

    *newPtr = 1;
    hPtr = (Tcl_HashEntry *) ckalloc((unsigned)
	    (sizeof(Tcl_HashEntry) + strlen(key) - (sizeof(hPtr->key) -1)));
    hPtr->tablePtr = tablePtr;
    hPtr->bucketPtr = &(tablePtr->buckets[index]);
    hPtr->nextPtr = *hPtr->bucketPtr;
    hPtr->clientData = 0;
    strcpy(hPtr->key.string, key);
    *hPtr->bucketPtr = hPtr;
    tablePtr->numEntries++;

    /*
     * If the table has exceeded a decent size, rebuild it with many
     * more buckets.
     */

    if (tablePtr->numEntries >= tablePtr->rebuildSize) {
	RebuildTable(tablePtr);
    }
    return hPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * OneWordFind --
 *
 *	Given a hash table with one-word keys, and a one-word key, find
 *	the entry with a matching key.
 *
 * Results:
 *	The return value is a token for the matching entry in the
 *	hash table, or NULL if there was no matching entry.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static Tcl_HashEntry *
OneWordFind(tablePtr, key)
    Tcl_HashTable *tablePtr;	/* Table in which to lookup entry. */
    register CONST char *key;	/* Key to use to find matching entry. */
{
    register Tcl_HashEntry *hPtr;
    int index;

    index = RANDOM_INDEX(tablePtr, key);

    /*
     * Search all of the entries in the appropriate bucket.
     */

    for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
	    hPtr = hPtr->nextPtr) {
	if (hPtr->key.oneWordValue == key) {
	    return hPtr;
	}
    }
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * OneWordCreate --
 *
 *	Given a hash table with one-word keys, and a one-word key, find
 *	the entry with a matching key.  If there is no matching entry,
 *	then create a new entry that does match.
 *
 * Results:
 *	The return value is a pointer to the matching entry.  If this
 *	is a newly-created entry, then *newPtr will be set to a non-zero
 *	value;  otherwise *newPtr will be set to 0.  If this is a new
 *	entry the value stored in the entry will initially be 0.
 *
 * Side effects:
 *	A new entry may be added to the hash table.
 *
 *----------------------------------------------------------------------
 */

static Tcl_HashEntry *
OneWordCreate(tablePtr, key, newPtr)
    Tcl_HashTable *tablePtr;	/* Table in which to lookup entry. */
    register CONST char *key;	/* Key to use to find or create matching
				 * entry. */
    int *newPtr;		/* Store info here telling whether a new
				 * entry was created. */
{
    register Tcl_HashEntry *hPtr;
    int index;

    index = RANDOM_INDEX(tablePtr, key);

    /*
     * Search all of the entries in this bucket.
     */

    for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
	    hPtr = hPtr->nextPtr) {
	if (hPtr->key.oneWordValue == key) {
	    *newPtr = 0;
	    return hPtr;
	}
    }

    /*
     * Entry not found.  Add a new one to the bucket.
     */

    *newPtr = 1;
    hPtr = (Tcl_HashEntry *) ckalloc(sizeof(Tcl_HashEntry));
    hPtr->tablePtr = tablePtr;
    hPtr->bucketPtr = &(tablePtr->buckets[index]);
    hPtr->nextPtr = *hPtr->bucketPtr;
    hPtr->clientData = 0;
    hPtr->key.oneWordValue = (char *) key;	/* CONST XXXX */
    *hPtr->bucketPtr = hPtr;
    tablePtr->numEntries++;

    /*
     * If the table has exceeded a decent size, rebuild it with many
     * more buckets.
     */

    if (tablePtr->numEntries >= tablePtr->rebuildSize) {
	RebuildTable(tablePtr);
    }
    return hPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * ArrayFind --
 *
 *	Given a hash table with array-of-int keys, and a key, find
 *	the entry with a matching key.
 *
 * Results:
 *	The return value is a token for the matching entry in the
 *	hash table, or NULL if there was no matching entry.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

static Tcl_HashEntry *
ArrayFind(tablePtr, key)
    Tcl_HashTable *tablePtr;	/* Table in which to lookup entry. */
    CONST char *key;		/* Key to use to find matching entry. */
{
    register Tcl_HashEntry *hPtr;
    int *arrayPtr = (int *) key;
    register int *iPtr1, *iPtr2;
    int index, count;

    for (index = 0, count = tablePtr->keyType, iPtr1 = arrayPtr;
	    count > 0; count--, iPtr1++) {
	index += *iPtr1;
    }
    index = RANDOM_INDEX(tablePtr, index);

    /*
     * Search all of the entries in the appropriate bucket.
     */

    for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
	    hPtr = hPtr->nextPtr) {
	for (iPtr1 = arrayPtr, iPtr2 = hPtr->key.words,
		count = tablePtr->keyType; ; count--, iPtr1++, iPtr2++) {
	    if (count == 0) {
		return hPtr;
	    }
	    if (*iPtr1 != *iPtr2) {
		break;
	    }
	}
    }
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * ArrayCreate --
 *
 *	Given a hash table with one-word keys, and a one-word key, find
 *	the entry with a matching key.  If there is no matching entry,
 *	then create a new entry that does match.
 *
 * Results:
 *	The return value is a pointer to the matching entry.  If this
 *	is a newly-created entry, then *newPtr will be set to a non-zero
 *	value;  otherwise *newPtr will be set to 0.  If this is a new
 *	entry the value stored in the entry will initially be 0.
 *
 * Side effects:
 *	A new entry may be added to the hash table.
 *
 *----------------------------------------------------------------------
 */

static Tcl_HashEntry *
ArrayCreate(tablePtr, key, newPtr)
    Tcl_HashTable *tablePtr;	/* Table in which to lookup entry. */
    register CONST char *key;	/* Key to use to find or create matching
				 * entry. */
    int *newPtr;		/* Store info here telling whether a new
				 * entry was created. */
{
    register Tcl_HashEntry *hPtr;
    int *arrayPtr = (int *) key;
    register int *iPtr1, *iPtr2;
    int index, count;

    for (index = 0, count = tablePtr->keyType, iPtr1 = arrayPtr;
	    count > 0; count--, iPtr1++) {
	index += *iPtr1;
    }
    index = RANDOM_INDEX(tablePtr, index);

    /*
     * Search all of the entries in the appropriate bucket.
     */

    for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
	    hPtr = hPtr->nextPtr) {
	for (iPtr1 = arrayPtr, iPtr2 = hPtr->key.words,
		count = tablePtr->keyType; ; count--, iPtr1++, iPtr2++) {
	    if (count == 0) {
		*newPtr = 0;
		return hPtr;
	    }
	    if (*iPtr1 != *iPtr2) {
		break;
	    }
	}
    }

    /*
     * Entry not found.  Add a new one to the bucket.
     */

    *newPtr = 1;
    hPtr = (Tcl_HashEntry *) ckalloc((unsigned) (sizeof(Tcl_HashEntry)
	    + (tablePtr->keyType*sizeof(int)) - 4));
    hPtr->tablePtr = tablePtr;
    hPtr->bucketPtr = &(tablePtr->buckets[index]);
    hPtr->nextPtr = *hPtr->bucketPtr;
    hPtr->clientData = 0;
    for (iPtr1 = arrayPtr, iPtr2 = hPtr->key.words, count = tablePtr->keyType;
	    count > 0; count--, iPtr1++, iPtr2++) {
	*iPtr2 = *iPtr1;
    }
    *hPtr->bucketPtr = hPtr;
    tablePtr->numEntries++;

    /*
     * If the table has exceeded a decent size, rebuild it with many
     * more buckets.
     */

    if (tablePtr->numEntries >= tablePtr->rebuildSize) {
	RebuildTable(tablePtr);
    }
    return hPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * BogusFind --
 *
 *	This procedure is invoked when an Tcl_FindHashEntry is called
 *	on a table that has been deleted.
 *
 * Results:
 *	If panic returns (which it shouldn't) this procedure returns
 *	NULL.
 *
 * Side effects:
 *	Generates a panic.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
static Tcl_HashEntry *
BogusFind(tablePtr, key)
    Tcl_HashTable *tablePtr;	/* Table in which to lookup entry. */
    CONST char *key;		/* Key to use to find matching entry. */
{
    panic("called Tcl_FindHashEntry on deleted table");
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * BogusCreate --
 *
 *	This procedure is invoked when an Tcl_CreateHashEntry is called
 *	on a table that has been deleted.
 *
 * Results:
 *	If panic returns (which it shouldn't) this procedure returns
 *	NULL.
 *
 * Side effects:
 *	Generates a panic.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
static Tcl_HashEntry *
BogusCreate(tablePtr, key, newPtr)
    Tcl_HashTable *tablePtr;	/* Table in which to lookup entry. */
    CONST char *key;		/* Key to use to find or create matching
				 * entry. */
    int *newPtr;		/* Store info here telling whether a new
				 * entry was created. */
{
    panic("called Tcl_CreateHashEntry on deleted table");
    return NULL;
}

/*
 *----------------------------------------------------------------------
 *
 * RebuildTable --
 *
 *	This procedure is invoked when the ratio of entries to hash
 *	buckets becomes too large.  It creates a new table with a
 *	larger bucket array and moves all of the entries into the
 *	new table.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Memory gets reallocated and entries get re-hashed to new
 *	buckets.
 *
 *----------------------------------------------------------------------
 */

static void
RebuildTable(tablePtr)
    register Tcl_HashTable *tablePtr;	/* Table to enlarge. */
{
    int oldSize, count, index;
    Tcl_HashEntry **oldBuckets;
    register Tcl_HashEntry **oldChainPtr, **newChainPtr;
    register Tcl_HashEntry *hPtr;

    oldSize = tablePtr->numBuckets;
    oldBuckets = tablePtr->buckets;

    /*
     * Allocate and initialize the new bucket array, and set up
     * hashing constants for new array size.
     */

    tablePtr->numBuckets *= 4;
    tablePtr->buckets = (Tcl_HashEntry **) ckalloc((unsigned)
	    (tablePtr->numBuckets * sizeof(Tcl_HashEntry *)));
    for (count = tablePtr->numBuckets, newChainPtr = tablePtr->buckets;
	    count > 0; count--, newChainPtr++) {
	*newChainPtr = NULL;
    }
    tablePtr->rebuildSize *= 4;
    tablePtr->downShift -= 2;
    tablePtr->mask = (tablePtr->mask << 2) + 3;

    /*
     * Rehash all of the existing entries into the new bucket array.
     */

    for (oldChainPtr = oldBuckets; oldSize > 0; oldSize--, oldChainPtr++) {
	for (hPtr = *oldChainPtr; hPtr != NULL; hPtr = *oldChainPtr) {
	    *oldChainPtr = hPtr->nextPtr;
	    if (tablePtr->keyType == TCL_STRING_KEYS) {
		index = HashString(hPtr->key.string) & tablePtr->mask;
	    } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
		index = RANDOM_INDEX(tablePtr, hPtr->key.oneWordValue);
	    } else {
		register int *iPtr;
		int count;

		for (index = 0, count = tablePtr->keyType,
			iPtr = hPtr->key.words; count > 0; count--, iPtr++) {
		    index += *iPtr;
		}
		index = RANDOM_INDEX(tablePtr, index);
	    }
	    hPtr->bucketPtr = &(tablePtr->buckets[index]);
	    hPtr->nextPtr = *hPtr->bucketPtr;
	    *hPtr->bucketPtr = hPtr;
	}
    }

    /*
     * Free up the old bucket array, if it was dynamically allocated.
     */

    if (oldBuckets != tablePtr->staticBuckets) {
	ckfree((char *) oldBuckets);
    }
}