Hex Artifact Content

Artifact 7f2fbfc8a7e0ff6e15d345fb17625ab9f5e90c9a:


0000: 23 20 74 63 63 2e 74 63 6c 20 2d 20 6c 69 62 72  # tcc.tcl - libr
0010: 61 72 79 20 72 6f 75 74 69 6e 65 73 20 66 6f 72  ary routines for
0020: 20 74 68 65 20 74 63 63 20 77 72 61 70 70 65 72   the tcc wrapper
0030: 20 28 4d 61 72 6b 20 4a 61 6e 73 73 65 6e 29 0a   (Mark Janssen).
0040: 0a 6e 61 6d 65 73 70 61 63 65 20 65 76 61 6c 20  .namespace eval 
0050: 74 63 63 34 74 63 6c 20 7b 0a 09 76 61 72 69 61  tcc4tcl {..varia
0060: 62 6c 65 20 64 69 72 20 0a 09 76 61 72 69 61 62  ble dir ..variab
0070: 6c 65 20 6c 69 62 73 0a 09 76 61 72 69 61 62 6c  le libs..variabl
0080: 65 20 69 6e 63 6c 75 64 65 73 0a 09 76 61 72 69  e includes..vari
0090: 61 62 6c 65 20 63 6f 75 6e 74 0a 09 76 61 72 69  able count..vari
00a0: 61 62 6c 65 20 63 6f 6d 6d 61 6e 64 5f 63 6f 75  able command_cou
00b0: 6e 74 0a 09 76 61 72 69 61 62 6c 65 20 63 6f 6d  nt..variable com
00c0: 6d 61 6e 64 73 0a 0a 09 73 65 74 20 64 69 72 20  mands...set dir 
00d0: 5b 66 69 6c 65 20 64 69 72 6e 61 6d 65 20 5b 69  [file dirname [i
00e0: 6e 66 6f 20 73 63 72 69 70 74 5d 5d 0a 09 69 66  nfo script]]..if
00f0: 20 7b 5b 69 6e 66 6f 20 63 6f 6d 6d 61 6e 64 20   {[info command 
0100: 3a 3a 74 63 63 34 74 63 6c 5d 20 3d 3d 20 22 22  ::tcc4tcl] == ""
0110: 7d 20 7b 0a 09 09 63 61 74 63 68 20 7b 20 6c 6f  } {...catch { lo
0120: 61 64 20 7b 7d 20 74 63 63 34 74 63 6c 20 7d 0a  ad {} tcc4tcl }.
0130: 09 7d 0a 09 69 66 20 7b 5b 69 6e 66 6f 20 63 6f  .}..if {[info co
0140: 6d 6d 61 6e 64 20 3a 3a 74 63 63 34 74 63 6c 5d  mmand ::tcc4tcl]
0150: 20 3d 3d 20 22 22 7d 20 7b 0a 09 09 6c 6f 61 64   == ""} {...load
0160: 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 64 69 72   [file join $dir
0170: 20 74 63 63 34 74 63 6c 5b 69 6e 66 6f 20 73 68   tcc4tcl[info sh
0180: 61 72 65 64 6c 69 62 65 78 74 65 6e 73 69 6f 6e  aredlibextension
0190: 5d 5d 20 74 63 63 34 74 63 6c 0a 09 7d 0a 0a 09  ]] tcc4tcl..}...
01a0: 73 65 74 20 6c 69 62 73 20 24 64 69 72 2f 6c 69  set libs $dir/li
01b0: 62 0a 09 73 65 74 20 69 6e 63 6c 75 64 65 73 20  b..set includes 
01c0: 24 64 69 72 2f 69 6e 63 6c 75 64 65 0a 09 73 65  $dir/include..se
01d0: 74 20 63 6f 75 6e 74 20 30 0a 09 73 65 74 20 63  t count 0..set c
01e0: 6f 6d 6d 61 6e 64 5f 63 6f 75 6e 74 20 30 0a 09  ommand_count 0..
01f0: 61 72 72 61 79 20 73 65 74 20 63 6f 6d 6d 61 6e  array set comman
0200: 64 73 20 7b 7d 0a 0a 09 70 72 6f 63 20 6e 65 77  ds {}...proc new
0210: 20 7b 7b 6f 75 74 70 75 74 20 22 6d 65 6d 6f 72   {{output "memor
0220: 79 22 7d 7d 20 7b 0a 09 09 76 61 72 69 61 62 6c  y"}} {...variabl
0230: 65 20 64 69 72 0a 09 09 76 61 72 69 61 62 6c 65  e dir...variable
0240: 20 63 6f 75 6e 74 0a 0a 09 09 73 65 74 20 68 61   count....set ha
0250: 6e 64 6c 65 20 74 63 63 5f 5b 69 6e 63 72 20 63  ndle tcc_[incr c
0260: 6f 75 6e 74 5d 0a 09 09 74 63 63 34 74 63 6c 20  ount]...tcc4tcl 
0270: 24 64 69 72 20 24 6f 75 74 70 75 74 20 24 68 61  $dir $output $ha
0280: 6e 64 6c 65 0a 0a 09 09 72 65 74 75 72 6e 20 24  ndle....return $
0290: 68 61 6e 64 6c 65 0a 09 7d 0a 0a 09 70 72 6f 63  handle..}...proc
02a0: 20 74 63 6c 63 6f 6d 6d 61 6e 64 20 7b 68 61 6e   tclcommand {han
02b0: 64 6c 65 20 6e 61 6d 65 20 63 63 6f 64 65 7d 20  dle name ccode} 
02c0: 7b 0a 09 09 76 61 72 69 61 62 6c 65 20 63 6f 6d  {...variable com
02d0: 6d 61 6e 64 73 0a 09 09 76 61 72 69 61 62 6c 65  mands...variable
02e0: 20 63 6f 6d 6d 61 6e 64 5f 63 6f 75 6e 74 0a 0a   command_count..
02f0: 09 09 73 65 74 20 63 6e 61 6d 65 20 5f 74 63 63  ..set cname _tcc
0300: 5f 74 63 6c 5f 63 6f 6d 6d 61 6e 64 5f 5b 69 6e  _tcl_command_[in
0310: 63 72 20 63 6f 6d 6d 61 6e 64 5f 63 6f 75 6e 74  cr command_count
0320: 5d 0a 0a 09 09 73 65 74 20 63 6f 64 65 20 20 20  ]....set code   
0330: 20 7b 23 69 6e 63 6c 75 64 65 20 22 74 63 6c 2e   {#include "tcl.
0340: 68 22 7d 0a 09 09 61 70 70 65 6e 64 20 63 6f 64  h"}...append cod
0350: 65 20 22 5c 6e 69 6e 74 20 24 63 6e 61 6d 65 28  e "\nint $cname(
0360: 43 6c 69 65 6e 74 44 61 74 61 20 63 64 61 74 61  ClientData cdata
0370: 2c 54 63 6c 5f 49 6e 74 65 72 70 20 2a 69 6e 74  ,Tcl_Interp *int
0380: 65 72 70 2c 69 6e 74 20 6f 62 6a 63 2c 54 63 6c  erp,int objc,Tcl
0390: 5f 4f 62 6a 2a 20 43 4f 4e 53 54 20 6f 62 6a 76  _Obj* CONST objv
03a0: 5c 5b 5c 5d 29 20 5c 7b 22 0a 09 09 61 70 70 65  \[\]) \{"...appe
03b0: 6e 64 20 63 6f 64 65 20 22 5c 6e 24 63 63 6f 64  nd code "\n$ccod
03c0: 65 22 0a 09 09 61 70 70 65 6e 64 20 63 6f 64 65  e"...append code
03d0: 20 22 5c 7d 22 0a 0a 09 09 24 68 61 6e 64 6c 65   "\}"....$handle
03e0: 20 63 6f 6d 70 69 6c 65 20 24 63 6f 64 65 0a 0a   compile $code..
03f0: 09 09 73 65 74 20 63 6f 6d 6d 61 6e 64 73 28 24  ..set commands($
0400: 68 61 6e 64 6c 65 2c 24 6e 61 6d 65 29 20 24 63  handle,$name) $c
0410: 6e 61 6d 65 0a 0a 09 09 72 65 74 75 72 6e 0a 09  name....return..
0420: 7d 0a 0a 09 70 72 6f 63 20 63 6f 6d 70 69 6c 65  }...proc compile
0430: 20 7b 68 61 6e 64 6c 65 7d 20 7b 0a 09 09 76 61   {handle} {...va
0440: 72 69 61 62 6c 65 20 63 6f 6d 6d 61 6e 64 73 0a  riable commands.
0450: 0a 09 09 66 6f 72 65 61 63 68 20 63 6d 64 20 5b  ...foreach cmd [
0460: 61 72 72 61 79 20 6e 61 6d 65 73 20 63 6f 6d 6d  array names comm
0470: 61 6e 64 73 20 24 7b 68 61 6e 64 6c 65 7d 2c 2a  ands ${handle},*
0480: 5d 20 7b 0a 09 09 09 73 65 74 20 63 6e 61 6d 65  ] {....set cname
0490: 20 24 63 6f 6d 6d 61 6e 64 73 28 24 63 6d 64 29   $commands($cmd)
04a0: 0a 09 09 09 73 65 74 20 74 63 6c 63 6f 6d 6d 61  ....set tclcomma
04b0: 6e 64 20 5b 6a 6f 69 6e 20 5b 6c 72 61 6e 67 65  nd [join [lrange
04c0: 20 5b 73 70 6c 69 74 20 24 63 6d 64 20 2c 5d 20   [split $cmd ,] 
04d0: 31 20 65 6e 64 5d 20 7b 7d 5d 0a 0a 09 09 09 73  1 end] {}].....s
04e0: 65 74 20 68 61 6e 64 6c 65 20 5b 6c 69 6e 64 65  et handle [linde
04f0: 78 20 5b 73 70 6c 69 74 20 24 63 6d 64 20 2c 5d  x [split $cmd ,]
0500: 20 30 5d 0a 0a 09 09 09 24 68 61 6e 64 6c 65 20   0].....$handle 
0510: 63 6f 6d 6d 61 6e 64 20 24 74 63 6c 63 6f 6d 6d  command $tclcomm
0520: 61 6e 64 20 24 63 6e 61 6d 65 0a 09 09 7d 0a 0a  and $cname...}..
0530: 09 09 72 65 74 75 72 6e 0a 09 7d 0a 7d 0a 0a 70  ..return..}.}..p
0540: 72 6f 63 20 74 63 63 34 74 63 6c 3a 3a 74 6f 5f  roc tcc4tcl::to_
0550: 64 6c 6c 20 7b 63 6f 64 65 20 64 6c 6c 20 7b 6c  dll {code dll {l
0560: 69 62 73 20 7b 7d 7d 7d 20 7b 0a 09 73 65 74 20  ibs {}}} {..set 
0570: 68 61 6e 64 6c 65 20 5b 3a 3a 74 63 63 34 74 63  handle [::tcc4tc
0580: 6c 3a 3a 6e 65 77 20 64 6c 6c 5d 0a 09 66 6f 72  l::new dll]..for
0590: 65 61 63 68 20 6c 69 62 20 24 6c 69 62 73 20 7b  each lib $libs {
05a0: 0a 09 09 24 68 61 6e 64 6c 65 20 61 64 64 5f 6c  ...$handle add_l
05b0: 69 62 72 61 72 79 20 24 6c 69 62 0a 09 7d 0a 0a  ibrary $lib..}..
05c0: 09 69 66 20 7b 24 3a 3a 74 63 6c 5f 70 6c 61 74  .if {$::tcl_plat
05d0: 66 6f 72 6d 28 70 6c 61 74 66 6f 72 6d 29 20 65  form(platform) e
05e0: 71 20 22 77 69 6e 64 6f 77 73 22 7d 20 7b 0a 09  q "windows"} {..
05f0: 09 24 68 61 6e 64 6c 65 20 64 65 66 69 6e 65 20  .$handle define 
0600: 44 4c 4c 5f 45 58 50 4f 52 54 20 7b 5f 5f 64 65  DLL_EXPORT {__de
0610: 63 6c 73 70 65 63 28 64 6c 6c 65 78 70 6f 72 74  clspec(dllexport
0620: 29 7d 20 0a 0a 09 09 73 65 74 20 66 20 5b 6f 70  )} ....set f [op
0630: 65 6e 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 3a  en [file join $:
0640: 3a 74 63 63 34 74 63 6c 3a 3a 64 69 72 20 6c 69  :tcc4tcl::dir li
0650: 62 20 64 6c 6c 63 72 74 31 2e 63 5d 5d 0a 09 09  b dllcrt1.c]]...
0660: 24 68 61 6e 64 6c 65 20 63 6f 6d 70 69 6c 65 20  $handle compile 
0670: 5b 72 65 61 64 20 24 66 5d 0a 09 09 63 6c 6f 73  [read $f]...clos
0680: 65 20 24 66 0a 0a 09 09 73 65 74 20 66 20 5b 6f  e $f....set f [o
0690: 70 65 6e 20 5b 66 69 6c 65 20 6a 6f 69 6e 20 24  pen [file join $
06a0: 3a 3a 74 63 63 34 74 63 6c 3a 3a 64 69 72 20 6c  ::tcc4tcl::dir l
06b0: 69 62 20 64 6c 6c 6d 61 69 6e 2e 63 5d 5d 0a 09  ib dllmain.c]]..
06c0: 09 24 68 61 6e 64 6c 65 20 63 6f 6d 70 69 6c 65  .$handle compile
06d0: 20 5b 72 65 61 64 20 24 66 5d 0a 09 09 63 6c 6f   [read $f]...clo
06e0: 73 65 20 24 66 0a 09 7d 20 65 6c 73 65 20 7b 0a  se $f..} else {.
06f0: 09 09 24 68 61 6e 64 6c 65 20 64 65 66 69 6e 65  ..$handle define
0700: 20 44 4c 4c 5f 45 58 50 4f 52 54 20 22 22 0a 09   DLL_EXPORT ""..
0710: 7d 0a 0a 09 24 68 61 6e 64 6c 65 20 63 6f 6d 70  }...$handle comp
0720: 69 6c 65 20 24 63 6f 64 65 0a 09 24 68 61 6e 64  ile $code..$hand
0730: 6c 65 20 6f 75 74 70 75 74 5f 66 69 6c 65 20 24  le output_file $
0740: 64 6c 6c 0a 0a 09 72 65 6e 61 6d 65 20 24 68 61  dll...rename $ha
0750: 6e 64 6c 65 20 7b 7d 0a 7d 0a 0a 70 72 6f 63 20  ndle {}.}..proc 
0760: 3a 3a 74 63 63 34 74 63 6c 3a 3a 4c 6f 67 20 7b  ::tcc4tcl::Log {
0770: 61 72 67 73 7d 20 7b 0a 09 23 20 70 75 74 73 20  args} {..# puts 
0780: 24 61 72 67 73 0a 7d 0a 0a 70 72 6f 63 20 3a 3a  $args.}..proc ::
0790: 74 63 63 34 74 63 6c 3a 3a 72 65 73 65 74 20 7b  tcc4tcl::reset {
07a0: 7d 20 7b 0a 09 76 61 72 69 61 62 6c 65 20 74 63  } {..variable tc
07b0: 63 0a 09 73 65 74 20 74 63 63 28 63 6f 64 65 29  c..set tcc(code)
07c0: 20 20 20 22 22 0a 09 73 65 74 20 74 63 63 28 63     ""..set tcc(c
07d0: 66 69 6c 65 73 29 20 5b 6c 69 73 74 5d 0a 09 73  files) [list]..s
07e0: 65 74 20 74 63 63 28 74 6b 29 20 30 0a 7d 0a 0a  et tcc(tk) 0.}..
07f0: 23 20 43 75 73 74 6f 6d 20 68 65 6c 70 65 72 73  # Custom helpers
0800: 0a 70 72 6f 63 20 3a 3a 74 63 63 34 74 63 6c 3a  .proc ::tcc4tcl:
0810: 3a 63 68 65 63 6b 6e 61 6d 65 20 7b 6e 7d 20 7b  :checkname {n} {
0820: 65 78 70 72 20 7b 5b 72 65 67 65 78 70 20 7b 5e  expr {[regexp {^
0830: 5b 61 2d 7a 41 2d 5a 30 2d 39 5f 5d 2b 24 7d 20  [a-zA-Z0-9_]+$} 
0840: 24 6e 5d 20 3e 20 30 7d 7d 0a 70 72 6f 63 20 3a  $n] > 0}}.proc :
0850: 3a 74 63 63 34 74 63 6c 3a 3a 63 6c 65 61 6e 6e  :tcc4tcl::cleann
0860: 61 6d 65 20 7b 6e 7d 20 7b 72 65 67 73 75 62 20  ame {n} {regsub 
0870: 2d 61 6c 6c 20 7b 5b 5e 61 2d 7a 41 2d 5a 30 2d  -all {[^a-zA-Z0-
0880: 39 5f 5d 2b 7d 20 24 6e 20 5f 7d 0a 0a 70 72 6f  9_]+} $n _}..pro
0890: 63 20 3a 3a 74 63 63 34 74 63 6c 3a 3a 63 63 6f  c ::tcc4tcl::cco
08a0: 64 65 20 7b 63 6f 64 65 7d 20 7b 0a 09 76 61 72  de {code} {..var
08b0: 69 61 62 6c 65 20 74 63 63 0a 0a 09 4c 6f 67 20  iable tcc...Log 
08c0: 22 49 4e 4a 45 43 54 49 4e 47 20 43 43 4f 44 45  "INJECTING CCODE
08d0: 22 0a 0a 09 61 70 70 65 6e 64 20 74 63 63 28 63  "...append tcc(c
08e0: 6f 64 65 29 20 24 63 6f 64 65 20 5c 6e 0a 7d 0a  ode) $code \n.}.
08f0: 0a 70 72 6f 63 20 3a 3a 74 63 63 34 74 63 6c 3a  .proc ::tcc4tcl:
0900: 3a 63 63 20 7b 63 6f 64 65 7d 20 7b 0a 09 76 61  :cc {code} {..va
0910: 72 69 61 62 6c 65 20 74 63 63 0a 0a 09 69 66 20  riable tcc...if 
0920: 7b 21 5b 69 6e 66 6f 20 65 78 69 73 74 73 20 74  {![info exists t
0930: 63 63 28 63 63 29 5d 7d 20 7b 0a 09 09 73 65 74  cc(cc)]} {...set
0940: 20 74 63 63 28 63 63 29 20 5b 3a 3a 74 63 63 34   tcc(cc) [::tcc4
0950: 74 63 6c 3a 3a 6e 65 77 5d 0a 09 7d 0a 0a 09 24  tcl::new]..}...$
0960: 74 63 63 28 63 63 29 20 63 6f 6d 70 69 6c 65 20  tcc(cc) compile 
0970: 24 63 6f 64 65 0a 7d 0a 0a 23 2d 2d 2d 2d 2d 2d  $code.}..#------
0980: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d  ----------------
0990: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d  ----------------
09a0: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d  ----------------
09b0: 2d 2d 2d 2d 2d 20 4e 65 77 20 44 4c 4c 20 41 50  ----- New DLL AP
09c0: 49 0a 6e 61 6d 65 73 70 61 63 65 20 65 76 61 6c  I.namespace eval
09d0: 20 3a 3a 74 63 63 34 74 63 6c 3a 3a 64 6c 6c 20   ::tcc4tcl::dll 
09e0: 7b 7d 0a 70 72 6f 63 20 3a 3a 74 63 63 34 74 63  {}.proc ::tcc4tc
09f0: 6c 3a 3a 64 6c 6c 20 7b 7b 6e 61 6d 65 20 22 22  l::dll {{name ""
0a00: 7d 7d 20 7b 0a 09 76 61 72 69 61 62 6c 65 20 63  }} {..variable c
0a10: 6f 75 6e 74 0a 0a 09 69 66 20 7b 24 6e 61 6d 65  ount...if {$name
0a20: 20 65 71 20 22 22 7d 20 7b 0a 09 09 73 65 74 20   eq ""} {...set 
0a30: 6e 61 6d 65 20 64 6c 6c 5b 69 6e 63 72 20 63 6f  name dll[incr co
0a40: 75 6e 74 5d 0a 09 7d 0a 0a 09 6e 61 6d 65 73 70  unt]..}...namesp
0a50: 61 63 65 20 65 76 61 6c 20 3a 3a 74 63 63 34 74  ace eval ::tcc4t
0a60: 63 6c 3a 3a 64 6c 6c 3a 3a 24 6e 61 6d 65 20 7b  cl::dll::$name {
0a70: 0a 09 09 76 61 72 69 61 62 6c 65 20 63 6f 64 65  ...variable code
0a80: 20 22 23 69 6e 63 6c 75 64 65 20 3c 74 63 6c 2e   "#include <tcl.
0a90: 68 3e 5c 6e 22 20 3b 23 20 61 6c 77 61 79 73 20  h>\n" ;# always 
0aa0: 6e 65 65 64 65 64 0a 09 09 76 61 72 69 61 62 6c  needed...variabl
0ab0: 65 20 63 6d 64 73 20 7b 7d 0a 09 7d 0a 0a 09 70  e cmds {}..}...p
0ac0: 72 6f 63 20 3a 3a 24 6e 61 6d 65 20 7b 63 6d 64  roc ::$name {cmd
0ad0: 20 61 72 67 73 7d 20 22 3a 3a 74 63 63 34 74 63   args} "::tcc4tc
0ae0: 6c 3a 3a 64 6c 6c 3a 3a 5c 24 63 6d 64 20 24 6e  l::dll::\$cmd $n
0af0: 61 6d 65 20 5c 24 61 72 67 73 22 0a 09 72 65 74  ame \$args"..ret
0b00: 75 72 6e 20 24 6e 61 6d 65 0a 7d 0a 0a 70 72 6f  urn $name.}..pro
0b10: 63 20 3a 3a 74 63 63 34 74 63 6c 3a 3a 64 6c 6c  c ::tcc4tcl::dll
0b20: 3a 3a 63 63 6f 64 65 20 7b 6e 61 6d 65 20 61 72  ::ccode {name ar
0b30: 67 6c 7d 20 7b 0a 09 61 70 70 65 6e 64 20 24 7b  gl} {..append ${
0b40: 6e 61 6d 65 7d 3a 3a 63 6f 64 65 20 22 5c 6e 22  name}::code "\n"
0b50: 20 5b 6c 69 6e 64 65 78 20 24 61 72 67 6c 20 30   [lindex $argl 0
0b60: 5d 0a 0a 09 72 65 74 75 72 6e 0a 7d 0a 0a 70 72  ]...return.}..pr
0b70: 6f 63 20 3a 3a 74 63 63 34 74 63 6c 3a 3a 64 6c  oc ::tcc4tcl::dl
0b80: 6c 3a 3a 63 70 72 6f 63 20 7b 6e 61 6d 65 20 61  l::cproc {name a
0b90: 72 67 6c 7d 20 7b 0a 09 66 6f 72 65 61 63 68 20  rgl} {..foreach 
0ba0: 7b 70 6e 61 6d 65 20 70 61 72 67 73 20 72 74 79  {pname pargs rty
0bb0: 70 65 20 62 6f 64 79 7d 20 24 61 72 67 6c 20 62  pe body} $argl b
0bc0: 72 65 61 6b 0a 0a 09 73 65 74 20 63 6f 64 65 20  reak...set code 
0bd0: 5b 3a 3a 74 63 63 34 74 63 6c 3a 3a 77 72 61 70  [::tcc4tcl::wrap
0be0: 43 6d 64 20 24 70 6e 61 6d 65 20 24 70 61 72 67  Cmd $pname $parg
0bf0: 73 20 24 72 74 79 70 65 20 63 78 5f 24 70 6e 61  s $rtype cx_$pna
0c00: 6d 65 20 24 62 6f 64 79 5d 0a 0a 09 6c 61 70 70  me $body]...lapp
0c10: 65 6e 64 20 24 7b 6e 61 6d 65 7d 3a 3a 63 6d 64  end ${name}::cmd
0c20: 73 20 24 70 6e 61 6d 65 20 63 78 5f 24 70 6e 61  s $pname cx_$pna
0c30: 6d 65 0a 09 61 70 70 65 6e 64 20 24 7b 6e 61 6d  me..append ${nam
0c40: 65 7d 3a 3a 63 6f 64 65 20 22 5c 6e 22 20 24 63  e}::code "\n" $c
0c50: 6f 64 65 0a 0a 09 72 65 74 75 72 6e 0a 7d 0a 0a  ode...return.}..
0c60: 70 72 6f 63 20 3a 3a 74 63 63 34 74 63 6c 3a 3a  proc ::tcc4tcl::
0c70: 64 6c 6c 3a 3a 77 72 69 74 65 20 7b 6e 61 6d 65  dll::write {name
0c80: 20 61 72 67 6c 7d 20 7b 0a 09 73 65 74 20 28 2d   argl} {..set (-
0c90: 64 69 72 29 20 2e 0a 09 73 65 74 20 28 2d 63 6f  dir) ...set (-co
0ca0: 64 65 29 20 22 22 20 3b 23 20 70 6f 73 73 69 62  de) "" ;# possib
0cb0: 6c 65 20 65 78 74 72 61 20 63 6f 64 65 20 74 6f  le extra code to
0cc0: 20 67 6f 20 69 6e 74 6f 20 74 68 65 20 5f 49 6e   go into the _In
0cd0: 69 74 20 66 75 6e 63 74 69 6f 6e 0a 09 73 65 74  it function..set
0ce0: 20 28 2d 6c 69 62 73 29 20 22 22 0a 09 73 65 74   (-libs) ""..set
0cf0: 20 28 2d 6e 61 6d 65 29 20 5b 73 74 72 69 6e 67   (-name) [string
0d00: 20 74 6f 6c 6f 77 65 72 20 24 6e 61 6d 65 5d 0a   tolower $name].
0d10: 09 61 72 72 61 79 20 73 65 74 20 22 22 20 24 61  .array set "" $a
0d20: 72 67 6c 0a 0a 09 61 70 70 65 6e 64 20 24 7b 6e  rgl...append ${n
0d30: 61 6d 65 7d 3a 3a 63 6f 64 65 20 22 5c 6e 22 20  ame}::code "\n" 
0d40: 5c 0a 09 09 5b 3a 3a 74 63 63 34 74 63 6c 3a 3a  \...[::tcc4tcl::
0d50: 77 72 61 70 45 78 70 6f 72 74 20 24 28 2d 6e 61  wrapExport $(-na
0d60: 6d 65 29 20 5b 73 65 74 20 24 7b 6e 61 6d 65 7d  me) [set ${name}
0d70: 3a 3a 63 6d 64 73 5d 20 24 28 2d 63 6f 64 65 29  ::cmds] $(-code)
0d80: 5d 0a 0a 09 73 65 74 20 6f 75 74 66 69 6c 65 20  ]...set outfile 
0d90: 24 28 2d 64 69 72 29 2f 24 28 2d 6e 61 6d 65 29  $(-dir)/$(-name)
0da0: 5b 69 6e 66 6f 20 73 68 61 72 65 64 6c 69 62 65  [info sharedlibe
0db0: 78 74 65 6e 73 69 6f 6e 5d 0a 0a 09 3a 3a 74 63  xtension]...::tc
0dc0: 63 34 74 63 6c 3a 3a 74 6f 5f 64 6c 6c 20 5b 73  c4tcl::to_dll [s
0dd0: 65 74 20 24 7b 6e 61 6d 65 7d 3a 3a 63 6f 64 65  et ${name}::code
0de0: 5d 20 24 6f 75 74 66 69 6c 65 20 24 28 2d 6c 69  ] $outfile $(-li
0df0: 62 73 29 0a 7d 0a 0a 23 2d 2d 2d 2d 2d 2d 2d 2d  bs).}..#--------
0e00: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d  ----------------
0e10: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d  ----------------
0e20: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d  ----------------
0e30: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 0a 70 72  -------------.pr
0e40: 6f 63 20 3a 3a 74 63 63 34 74 63 6c 3a 3a 77 72  oc ::tcc4tcl::wr
0e50: 61 70 20 7b 6e 61 6d 65 20 61 64 65 66 73 20 72  ap {name adefs r
0e60: 74 79 70 65 20 7b 62 6f 64 79 20 22 23 22 7d 7d  type {body "#"}}
0e70: 20 7b 0a 09 73 65 74 20 63 6e 61 6d 65 20 63 5f   {..set cname c_
0e80: 5b 74 63 63 34 74 63 6c 3a 3a 63 6c 65 61 6e 6e  [tcc4tcl::cleann
0e90: 61 6d 65 20 24 6e 61 6d 65 5d 0a 09 73 65 74 20  ame $name]..set 
0ea0: 77 6e 61 6d 65 20 74 63 6c 5f 24 6e 61 6d 65 0a  wname tcl_$name.
0eb0: 09 61 72 72 61 79 20 73 65 74 20 74 79 70 65 73  .array set types
0ec0: 20 7b 7d 0a 09 73 65 74 20 76 61 72 6e 61 6d 65   {}..set varname
0ed0: 73 20 7b 7d 0a 09 73 65 74 20 63 61 72 67 73 20  s {}..set cargs 
0ee0: 7b 7d 0a 09 73 65 74 20 63 6e 61 6d 65 73 20 7b  {}..set cnames {
0ef0: 7d 20 20 0a 09 73 65 74 20 63 62 6f 64 79 20 7b  }  ..set cbody {
0f00: 7d 0a 09 73 65 74 20 63 6f 64 65 20 7b 7d 0a 0a  }..set code {}..
0f10: 09 23 20 69 66 20 66 69 72 73 74 20 61 72 67 20  .# if first arg 
0f20: 69 73 20 22 54 63 6c 5f 49 6e 74 65 72 70 2a 22  is "Tcl_Interp*"
0f30: 2c 20 70 61 73 73 20 69 74 20 77 69 74 68 6f 75  , pass it withou
0f40: 74 20 63 6f 75 6e 74 69 6e 67 20 69 74 20 61 73  t counting it as
0f50: 20 61 20 63 6d 64 20 61 72 67 0a 09 69 66 20 7b   a cmd arg..if {
0f60: 5b 6c 69 6e 64 65 78 20 24 61 64 65 66 73 20 30  [lindex $adefs 0
0f70: 5d 20 65 71 20 22 54 63 6c 5f 49 6e 74 65 72 70  ] eq "Tcl_Interp
0f80: 2a 22 7d 20 7b 0a 09 09 6c 61 70 70 65 6e 64 20  *"} {...lappend 
0f90: 63 6e 61 6d 65 73 20 69 70 0a 09 09 6c 61 70 70  cnames ip...lapp
0fa0: 65 6e 64 20 63 61 72 67 73 20 5b 6c 72 61 6e 67  end cargs [lrang
0fb0: 65 20 24 61 64 65 66 73 20 30 20 31 5d 0a 09 09  e $adefs 0 1]...
0fc0: 73 65 74 20 61 64 65 66 73 20 5b 6c 72 61 6e 67  set adefs [lrang
0fd0: 65 20 24 61 64 65 66 73 20 32 20 65 6e 64 5d 0a  e $adefs 2 end].
0fe0: 09 7d 0a 0a 09 66 6f 72 65 61 63 68 20 7b 74 20  .}...foreach {t 
0ff0: 6e 7d 20 24 61 64 65 66 73 20 7b 0a 09 09 73 65  n} $adefs {...se
1000: 74 20 74 79 70 65 73 28 24 6e 29 20 24 74 0a 09  t types($n) $t..
1010: 09 6c 61 70 70 65 6e 64 20 76 61 72 6e 61 6d 65  .lappend varname
1020: 73 20 24 6e 0a 09 09 6c 61 70 70 65 6e 64 20 63  s $n...lappend c
1030: 6e 61 6d 65 73 20 5f 24 6e 0a 09 09 6c 61 70 70  names _$n...lapp
1040: 65 6e 64 20 63 61 72 67 73 20 22 24 74 20 24 6e  end cargs "$t $n
1050: 22 0a 09 7d 0a 0a 09 23 20 48 61 6e 64 6c 65 20  "..}...# Handle 
1060: 72 65 74 75 72 6e 20 74 79 70 65 0a 09 73 77 69  return type..swi
1070: 74 63 68 20 2d 2d 20 24 72 74 79 70 65 20 7b 0a  tch -- $rtype {.
1080: 09 09 6f 6b 20 20 20 20 20 20 7b 0a 09 09 09 73  ..ok      {....s
1090: 65 74 20 72 74 79 70 65 32 20 22 69 6e 74 22 0a  et rtype2 "int".
10a0: 09 09 7d 0a 09 09 73 74 72 69 6e 67 20 2d 20 64  ..}...string - d
10b0: 73 74 72 69 6e 67 20 2d 20 76 73 74 72 69 6e 67  string - vstring
10c0: 20 7b 0a 09 09 09 73 65 74 20 72 74 79 70 65 32   {....set rtype2
10d0: 20 22 63 68 61 72 2a 22 0a 09 09 7d 0a 09 09 64   "char*"...}...d
10e0: 65 66 61 75 6c 74 20 7b 0a 09 09 09 73 65 74 20  efault {....set 
10f0: 72 74 79 70 65 32 20 24 72 74 79 70 65 0a 09 09  rtype2 $rtype...
1100: 7d 0a 09 7d 0a 0a 09 61 70 70 65 6e 64 20 63 6f  }..}...append co
1110: 64 65 20 22 23 69 6e 63 6c 75 64 65 20 3c 74 63  de "#include <tc
1120: 6c 2e 68 3e 5c 6e 22 0a 09 69 66 20 7b 5b 69 6e  l.h>\n"..if {[in
1130: 66 6f 20 65 78 69 73 74 73 20 74 63 63 28 74 6b  fo exists tcc(tk
1140: 29 5d 20 26 26 20 24 74 63 63 28 74 6b 29 7d 20  )] && $tcc(tk)} 
1150: 7b 0a 09 09 61 70 70 65 6e 64 20 63 6f 64 65 20  {...append code 
1160: 22 23 69 6e 63 6c 75 64 65 20 3c 74 6b 2e 68 3e  "#include <tk.h>
1170: 5c 6e 22 0a 09 7d 0a 0a 09 23 20 43 72 65 61 74  \n"..}...# Creat
1180: 65 20 77 72 61 70 70 65 64 20 66 75 6e 63 74 69  e wrapped functi
1190: 6f 6e 0a 09 69 66 20 7b 24 62 6f 64 79 20 6e 65  on..if {$body ne
11a0: 20 22 23 22 7d 20 7b 0a 09 09 61 70 70 65 6e 64   "#"} {...append
11b0: 20 63 6f 64 65 20 22 73 74 61 74 69 63 20 24 72   code "static $r
11c0: 74 79 70 65 32 20 24 7b 63 6e 61 6d 65 7d 28 5b  type2 ${cname}([
11d0: 6a 6f 69 6e 20 24 63 61 72 67 73 20 7b 2c 20 7d  join $cargs {, }
11e0: 5d 29 20 5c 7b 5c 6e 22 0a 09 09 61 70 70 65 6e  ]) \{\n"...appen
11f0: 64 20 63 6f 64 65 20 24 62 6f 64 79 0a 09 09 61  d code $body...a
1200: 70 70 65 6e 64 20 63 6f 64 65 20 22 5c 7d 5c 6e  ppend code "\}\n
1210: 22 0a 09 7d 20 65 6c 73 65 20 7b 0a 09 09 61 70  "..} else {...ap
1220: 70 65 6e 64 20 63 6f 64 65 20 22 23 64 65 66 69  pend code "#defi
1230: 6e 65 20 24 63 6e 61 6d 65 20 24 6e 61 6d 65 22  ne $cname $name"
1240: 20 22 5c 6e 22 0a 09 7d 0a 0a 09 23 20 43 72 65   "\n"..}...# Cre
1250: 61 74 65 20 77 72 61 70 70 65 72 20 66 75 6e 63  ate wrapper func
1260: 74 69 6f 6e 0a 09 23 23 20 53 75 70 70 6f 72 74  tion..## Support
1270: 65 64 20 69 6e 70 75 74 20 74 79 70 65 73 0a 09  ed input types..
1280: 23 23 20 20 20 54 63 6c 5f 49 6e 74 65 72 70 2a  ##   Tcl_Interp*
1290: 0a 09 23 23 20 20 20 69 6e 74 0a 09 23 23 20 20  ..##   int..##  
12a0: 20 6c 6f 6e 67 0a 09 23 23 20 20 20 66 6c 6f 61   long..##   floa
12b0: 74 0a 09 23 23 20 20 20 64 6f 75 62 6c 65 0a 09  t..##   double..
12c0: 23 23 20 20 20 63 68 61 72 2a 0a 09 23 23 20 20  ##   char*..##  
12d0: 20 54 63 6c 5f 4f 62 6a 2a 0a 09 23 23 20 20 20   Tcl_Obj*..##   
12e0: 76 6f 69 64 2a 0a 09 66 6f 72 65 61 63 68 20 78  void*..foreach x
12f0: 20 24 76 61 72 6e 61 6d 65 73 20 7b 0a 09 09 73   $varnames {...s
1300: 65 74 20 74 20 24 74 79 70 65 73 28 24 78 29 0a  et t $types($x).
1310: 0a 09 09 73 77 69 74 63 68 20 2d 2d 20 24 74 20  ...switch -- $t 
1320: 7b 0a 09 09 09 69 6e 74 20 2d 20 6c 6f 6e 67 20  {....int - long 
1330: 2d 20 66 6c 6f 61 74 20 2d 20 64 6f 75 62 6c 65  - float - double
1340: 20 2d 20 63 68 61 72 2a 20 2d 20 54 63 6c 5f 4f   - char* - Tcl_O
1350: 62 6a 2a 20 7b 0a 09 09 09 09 61 70 70 65 6e 64  bj* {.....append
1360: 20 63 62 6f 64 79 20 22 20 20 24 74 79 70 65 73   cbody "  $types
1370: 28 24 78 29 20 5f 24 78 3b 22 20 22 5c 6e 22 0a  ($x) _$x;" "\n".
1380: 09 09 09 7d 0a 09 09 09 64 65 66 61 75 6c 74 20  ...}....default 
1390: 7b 0a 09 09 09 09 61 70 70 65 6e 64 20 63 62 6f  {.....append cbo
13a0: 64 79 20 22 20 20 76 6f 69 64 20 2a 5f 24 78 3b  dy "  void *_$x;
13b0: 22 20 22 5c 6e 22 0a 09 09 09 7d 0a 09 09 7d 0a  " "\n"....}...}.
13c0: 09 7d 0a 0a 09 69 66 20 7b 24 72 74 79 70 65 20  .}...if {$rtype 
13d0: 6e 65 20 22 76 6f 69 64 22 7d 20 7b 0a 09 09 61  ne "void"} {...a
13e0: 70 70 65 6e 64 20 63 62 6f 64 79 20 20 22 20 20  ppend cbody  "  
13f0: 24 72 74 79 70 65 32 20 72 76 3b 22 20 22 5c 6e  $rtype2 rv;" "\n
1400: 22 0a 09 7d 20 20 0a 0a 09 61 70 70 65 6e 64 20  "..}  ...append 
1410: 63 62 6f 64 79 20 22 20 20 69 66 20 28 6f 62 6a  cbody "  if (obj
1420: 63 20 21 3d 20 5b 65 78 70 72 20 7b 5b 6c 6c 65  c != [expr {[lle
1430: 6e 67 74 68 20 24 76 61 72 6e 61 6d 65 73 5d 20  ngth $varnames] 
1440: 2b 20 31 7d 5d 29 20 7b 22 20 22 5c 6e 22 0a 09  + 1}]) {" "\n"..
1450: 61 70 70 65 6e 64 20 63 62 6f 64 79 20 22 20 20  append cbody "  
1460: 20 20 54 63 6c 5f 57 72 6f 6e 67 4e 75 6d 41 72    Tcl_WrongNumAr
1470: 67 73 28 69 70 2c 20 31 2c 20 6f 62 6a 76 2c 20  gs(ip, 1, objv, 
1480: 5c 22 5b 6a 6f 69 6e 20 24 76 61 72 6e 61 6d 65  \"[join $varname
1490: 73 20 7b 20 7d 5d 5c 22 29 3b 5c 6e 22 0a 09 61  s { }]\");\n"..a
14a0: 70 70 65 6e 64 20 63 62 6f 64 79 20 22 20 20 20  ppend cbody "   
14b0: 20 72 65 74 75 72 6e 20 54 43 4c 5f 45 52 52 4f   return TCL_ERRO
14c0: 52 3b 22 20 22 5c 6e 22 0a 09 61 70 70 65 6e 64  R;" "\n"..append
14d0: 20 63 62 6f 64 79 20 22 20 20 7d 22 20 22 5c 6e   cbody "  }" "\n
14e0: 22 0a 0a 09 73 65 74 20 6e 20 30 0a 09 66 6f 72  "...set n 0..for
14f0: 65 61 63 68 20 78 20 24 76 61 72 6e 61 6d 65 73  each x $varnames
1500: 20 7b 0a 09 09 69 6e 63 72 20 6e 0a 09 09 73 77   {...incr n...sw
1510: 69 74 63 68 20 2d 2d 20 24 74 79 70 65 73 28 24  itch -- $types($
1520: 78 29 20 7b 0a 09 09 09 69 6e 74 20 7b 0a 09 09  x) {....int {...
1530: 09 09 61 70 70 65 6e 64 20 63 62 6f 64 79 20 22  ..append cbody "
1540: 20 20 69 66 20 28 54 63 6c 5f 47 65 74 49 6e 74    if (Tcl_GetInt
1550: 46 72 6f 6d 4f 62 6a 28 69 70 2c 20 6f 62 6a 76  FromObj(ip, objv
1560: 5c 5b 24 6e 5d 2c 20 26 5f 24 78 29 20 21 3d 20  \[$n], &_$x) != 
1570: 54 43 4c 5f 4f 4b 29 22 0a 09 09 09 09 61 70 70  TCL_OK)".....app
1580: 65 6e 64 20 63 62 6f 64 79 20 22 20 20 20 20 72  end cbody "    r
1590: 65 74 75 72 6e 20 54 43 4c 5f 45 52 52 4f 52 3b  eturn TCL_ERROR;
15a0: 22 20 22 5c 6e 22 0a 09 09 09 7d 0a 09 09 09 6c  " "\n"....}....l
15b0: 6f 6e 67 20 7b 0a 09 09 09 09 61 70 70 65 6e 64  ong {.....append
15c0: 20 63 62 6f 64 79 20 22 20 20 69 66 20 28 54 63   cbody "  if (Tc
15d0: 6c 5f 47 65 74 4c 6f 6e 67 46 72 6f 6d 4f 62 6a  l_GetLongFromObj
15e0: 28 69 70 2c 20 6f 62 6a 76 5c 5b 24 6e 5d 2c 20  (ip, objv\[$n], 
15f0: 26 5f 24 78 29 20 21 3d 20 54 43 4c 5f 4f 4b 29  &_$x) != TCL_OK)
1600: 22 0a 09 09 09 09 61 70 70 65 6e 64 20 63 62 6f  ".....append cbo
1610: 64 79 20 22 20 20 20 20 72 65 74 75 72 6e 20 54  dy "    return T
1620: 43 4c 5f 45 52 52 4f 52 3b 22 20 22 5c 6e 22 0a  CL_ERROR;" "\n".
1630: 09 09 09 7d 0a 09 09 09 66 6c 6f 61 74 20 7b 0a  ...}....float {.
1640: 09 09 09 09 61 70 70 65 6e 64 20 63 62 6f 64 79  ....append cbody
1650: 20 22 20 20 7b 22 20 22 5c 6e 22 0a 09 09 09 09   "  {" "\n".....
1660: 61 70 70 65 6e 64 20 63 62 6f 64 79 20 22 20 20  append cbody "  
1670: 20 20 64 6f 75 62 6c 65 20 74 3b 22 20 22 5c 6e    double t;" "\n
1680: 22 0a 09 09 09 09 61 70 70 65 6e 64 20 63 62 6f  ".....append cbo
1690: 64 79 20 22 20 20 20 20 69 66 20 28 54 63 6c 5f  dy "    if (Tcl_
16a0: 47 65 74 44 6f 75 62 6c 65 46 72 6f 6d 4f 62 6a  GetDoubleFromObj
16b0: 28 69 70 2c 20 6f 62 6a 76 5c 5b 24 6e 5d 2c 20  (ip, objv\[$n], 
16c0: 26 74 29 20 21 3d 20 54 43 4c 5f 4f 4b 29 22 0a  &t) != TCL_OK)".
16d0: 09 09 09 09 61 70 70 65 6e 64 20 63 62 6f 64 79  ....append cbody
16e0: 20 22 20 20 20 20 20 20 72 65 74 75 72 6e 20 54   "      return T
16f0: 43 4c 5f 45 52 52 4f 52 3b 22 20 22 5c 6e 22 0a  CL_ERROR;" "\n".
1700: 09 09 09 09 61 70 70 65 6e 64 20 63 62 6f 64 79  ....append cbody
1710: 20 22 20 20 20 20 5f 24 78 20 3d 20 28 66 6c 6f   "    _$x = (flo
1720: 61 74 29 20 74 3b 22 20 22 5c 6e 22 0a 09 09 09  at) t;" "\n"....
1730: 09 61 70 70 65 6e 64 20 63 62 6f 64 79 20 22 20  .append cbody " 
1740: 20 7d 22 20 22 5c 6e 22 0a 09 09 09 7d 0a 09 09   }" "\n"....}...
1750: 09 64 6f 75 62 6c 65 20 7b 0a 09 09 09 09 61 70  .double {.....ap
1760: 70 65 6e 64 20 63 62 6f 64 79 20 22 20 20 69 66  pend cbody "  if
1770: 20 28 54 63 6c 5f 47 65 74 44 6f 75 62 6c 65 46   (Tcl_GetDoubleF
1780: 72 6f 6d 4f 62 6a 28 69 70 2c 20 6f 62 6a 76 5c  romObj(ip, objv\
1790: 5b 24 6e 5d 2c 20 26 5f 24 78 29 20 21 3d 20 54  [$n], &_$x) != T
17a0: 43 4c 5f 4f 4b 29 22 0a 09 09 09 09 61 70 70 65  CL_OK)".....appe
17b0: 6e 64 20 63 62 6f 64 79 20 22 20 20 20 20 72 65  nd cbody "    re
17c0: 74 75 72 6e 20 54 43 4c 5f 45 52 52 4f 52 3b 22  turn TCL_ERROR;"
17d0: 20 22 5c 6e 22 0a 09 09 09 7d 0a 09 09 09 63 68   "\n"....}....ch
17e0: 61 72 2a 20 7b 0a 09 09 09 09 61 70 70 65 6e 64  ar* {.....append
17f0: 20 63 62 6f 64 79 20 22 20 20 5f 24 78 20 3d 20   cbody "  _$x = 
1800: 54 63 6c 5f 47 65 74 53 74 72 69 6e 67 28 6f 62  Tcl_GetString(ob
1810: 6a 76 5c 5b 24 6e 5d 29 3b 22 20 22 5c 6e 22 0a  jv\[$n]);" "\n".
1820: 09 09 09 7d 0a 09 09 09 64 65 66 61 75 6c 74 20  ...}....default 
1830: 7b 0a 09 09 09 09 61 70 70 65 6e 64 20 63 62 6f  {.....append cbo
1840: 64 79 20 22 20 20 5f 24 78 20 3d 20 6f 62 6a 76  dy "  _$x = objv
1850: 5c 5b 24 6e 5d 3b 22 20 22 5c 6e 22 0a 09 09 09  \[$n];" "\n"....
1860: 7d 0a 09 09 7d 0a 09 7d 0a 09 61 70 70 65 6e 64  }...}..}..append
1870: 20 63 62 6f 64 79 20 22 5c 6e 22 0a 0a 09 23 20   cbody "\n"...# 
1880: 43 61 6c 6c 20 77 72 61 70 70 65 64 20 66 75 6e  Call wrapped fun
1890: 63 74 69 6f 6e 0a 09 69 66 20 7b 24 72 74 79 70  ction..if {$rtyp
18a0: 65 20 21 3d 20 22 76 6f 69 64 22 7d 20 7b 0a 09  e != "void"} {..
18b0: 09 61 70 70 65 6e 64 20 63 62 6f 64 79 20 22 72  .append cbody "r
18c0: 76 20 3d 20 22 0a 09 7d 0a 09 61 70 70 65 6e 64  v = "..}..append
18d0: 20 63 62 6f 64 79 20 22 24 7b 63 6e 61 6d 65 7d   cbody "${cname}
18e0: 28 5b 6a 6f 69 6e 20 24 63 6e 61 6d 65 73 20 7b  ([join $cnames {
18f0: 2c 20 7d 5d 29 3b 22 20 22 5c 6e 22 0a 0a 09 23  , }]);" "\n"...#
1900: 20 52 65 74 75 72 6e 20 74 79 70 65 73 20 73 75   Return types su
1910: 70 70 6f 72 74 65 64 20 62 79 20 63 72 69 74 63  pported by critc
1920: 6c 0a 09 23 20 20 20 76 6f 69 64 0a 09 23 20 20  l..#   void..#  
1930: 20 6f 6b 0a 09 23 20 20 20 69 6e 74 0a 09 23 20   ok..#   int..# 
1940: 20 20 6c 6f 6e 67 0a 09 23 20 20 20 66 6c 6f 61    long..#   floa
1950: 74 0a 09 23 20 20 20 64 6f 75 62 6c 65 0a 09 23  t..#   double..#
1960: 20 20 20 63 68 61 72 2a 20 20 20 20 20 28 54 43     char*     (TC
1970: 4c 5f 53 54 41 54 49 43 20 63 68 61 72 2a 29 0a  L_STATIC char*).
1980: 09 23 20 20 20 73 74 72 69 6e 67 20 20 20 20 28  .#   string    (
1990: 54 43 4c 5f 44 59 4e 41 4d 49 43 20 63 68 61 72  TCL_DYNAMIC char
19a0: 2a 29 0a 09 23 20 20 20 64 73 74 72 69 6e 67 20  *)..#   dstring 
19b0: 20 20 28 54 43 4c 5f 44 59 4e 41 4d 49 43 20 63    (TCL_DYNAMIC c
19c0: 68 61 72 2a 29 0a 09 23 20 20 20 76 73 74 72 69  har*)..#   vstri
19d0: 6e 67 20 20 20 28 54 43 4c 5f 56 4f 4c 41 54 49  ng   (TCL_VOLATI
19e0: 4c 45 20 63 68 61 72 2a 29 0a 09 23 20 20 20 64  LE char*)..#   d
19f0: 65 66 61 75 6c 74 20 20 20 28 54 63 6c 5f 4f 62  efault   (Tcl_Ob
1a00: 6a 2a 29 0a 09 23 20 20 20 77 69 64 65 0a 09 73  j*)..#   wide..s
1a10: 77 69 74 63 68 20 2d 2d 20 24 72 74 79 70 65 20  witch -- $rtype 
1a20: 7b 0a 09 09 76 6f 69 64 20 20 20 20 20 20 20 20  {...void        
1a30: 20 20 20 7b 20 7d 0a 09 09 6f 6b 20 20 20 20 20     { }...ok     
1a40: 20 20 20 20 20 20 20 20 7b 20 61 70 70 65 6e 64          { append
1a50: 20 63 62 6f 64 79 20 22 20 20 72 65 74 75 72 6e   cbody "  return
1a60: 20 72 76 3b 22 20 22 5c 6e 22 20 7d 0a 09 09 69   rv;" "\n" }...i
1a70: 6e 74 20 20 20 20 20 20 20 20 20 20 20 20 7b 20  nt            { 
1a80: 61 70 70 65 6e 64 20 63 62 6f 64 79 20 22 20 20  append cbody "  
1a90: 54 63 6c 5f 53 65 74 49 6e 74 4f 62 6a 28 54 63  Tcl_SetIntObj(Tc
1aa0: 6c 5f 47 65 74 4f 62 6a 52 65 73 75 6c 74 28 69  l_GetObjResult(i
1ab0: 70 29 2c 20 72 76 29 3b 22 20 22 5c 6e 22 20 7d  p), rv);" "\n" }
1ac0: 0a 09 09 6c 6f 6e 67 20 20 20 20 20 20 20 20 20  ...long         
1ad0: 20 20 7b 20 61 70 70 65 6e 64 20 63 62 6f 64 79    { append cbody
1ae0: 20 22 20 20 54 63 6c 5f 53 65 74 4c 6f 6e 67 4f   "  Tcl_SetLongO
1af0: 62 6a 28 54 63 6c 5f 47 65 74 4f 62 6a 52 65 73  bj(Tcl_GetObjRes
1b00: 75 6c 74 28 69 70 29 2c 20 72 76 29 3b 22 20 22  ult(ip), rv);" "
1b10: 5c 6e 22 20 7d 0a 09 09 66 6c 6f 61 74 20 20 20  \n" }...float   
1b20: 20 20 20 20 20 20 20 2d 0a 09 09 64 6f 75 62 6c         -...doubl
1b30: 65 20 20 20 20 20 20 20 20 20 7b 20 61 70 70 65  e         { appe
1b40: 6e 64 20 63 62 6f 64 79 20 22 20 20 54 63 6c 5f  nd cbody "  Tcl_
1b50: 53 65 74 44 6f 75 62 6c 65 4f 62 6a 28 54 63 6c  SetDoubleObj(Tcl
1b60: 5f 47 65 74 4f 62 6a 52 65 73 75 6c 74 28 69 70  _GetObjResult(ip
1b70: 29 2c 20 72 76 29 3b 22 20 22 5c 6e 22 20 7d 0a  ), rv);" "\n" }.
1b80: 09 09 63 68 61 72 2a 20 20 20 20 20 20 20 20 20  ..char*         
1b90: 20 7b 20 61 70 70 65 6e 64 20 63 62 6f 64 79 20   { append cbody 
1ba0: 22 20 20 54 63 6c 5f 53 65 74 52 65 73 75 6c 74  "  Tcl_SetResult
1bb0: 28 69 70 2c 20 72 76 2c 20 54 43 4c 5f 53 54 41  (ip, rv, TCL_STA
1bc0: 54 49 43 29 3b 22 20 22 5c 6e 22 20 7d 0a 09 09  TIC);" "\n" }...
1bd0: 73 74 72 69 6e 67 20 20 20 20 20 20 20 20 20 2d  string         -
1be0: 0a 09 09 64 73 74 72 69 6e 67 20 20 20 20 20 20  ...dstring      
1bf0: 20 20 7b 20 61 70 70 65 6e 64 20 63 62 6f 64 79    { append cbody
1c00: 20 22 20 20 54 63 6c 5f 53 65 74 52 65 73 75 6c   "  Tcl_SetResul
1c10: 74 28 69 70 2c 20 72 76 2c 20 54 43 4c 5f 44 59  t(ip, rv, TCL_DY
1c20: 4e 41 4d 49 43 29 3b 22 20 22 5c 6e 22 20 7d 0a  NAMIC);" "\n" }.
1c30: 09 09 76 73 74 72 69 6e 67 20 20 20 20 20 20 20  ..vstring       
1c40: 20 7b 20 61 70 70 65 6e 64 20 63 62 6f 64 79 20   { append cbody 
1c50: 22 20 20 54 63 6c 5f 53 65 74 52 65 73 75 6c 74  "  Tcl_SetResult
1c60: 28 69 70 2c 20 72 76 2c 20 54 43 4c 5f 56 4f 4c  (ip, rv, TCL_VOL
1c70: 41 54 49 4c 45 29 3b 22 20 22 5c 6e 22 20 7d 0a  ATILE);" "\n" }.
1c80: 09 09 64 65 66 61 75 6c 74 20 20 20 20 20 20 20  ..default       
1c90: 20 7b 20 61 70 70 65 6e 64 20 63 62 6f 64 79 20   { append cbody 
1ca0: 22 20 20 54 63 6c 5f 53 65 74 4f 62 6a 52 65 73  "  Tcl_SetObjRes
1cb0: 75 6c 74 28 69 70 2c 20 72 76 29 3b 20 54 63 6c  ult(ip, rv); Tcl
1cc0: 5f 44 65 63 72 52 65 66 43 6f 75 6e 74 28 72 76  _DecrRefCount(rv
1cd0: 29 3b 22 20 22 5c 6e 22 20 7d 0a 09 7d 0a 0a 09  );" "\n" }..}...
1ce0: 69 66 20 7b 24 72 74 79 70 65 20 21 3d 20 22 6f  if {$rtype != "o
1cf0: 6b 22 7d 20 7b 0a 09 09 61 70 70 65 6e 64 20 63  k"} {...append c
1d00: 62 6f 64 79 20 22 20 20 72 65 74 75 72 6e 20 54  body "  return T
1d10: 43 4c 5f 4f 4b 3b 5c 6e 22 0a 09 7d 0a 0a 09 72  CL_OK;\n"..}...r
1d20: 65 74 75 72 6e 20 5b 6c 69 73 74 20 24 63 6f 64  eturn [list $cod
1d30: 65 20 24 63 62 6f 64 79 5d 0a 7d 0a 0a 70 72 6f  e $cbody].}..pro
1d40: 63 20 3a 3a 74 63 63 34 74 63 6c 3a 3a 77 72 61  c ::tcc4tcl::wra
1d50: 70 43 6d 64 20 7b 74 63 6c 6e 61 6d 65 20 61 72  pCmd {tclname ar
1d60: 67 6c 20 72 74 79 70 65 20 63 6e 61 6d 65 20 62  gl rtype cname b
1d70: 6f 64 79 7d 20 7b 0a 09 66 6f 72 65 61 63 68 20  ody} {..foreach 
1d80: 7b 63 6f 64 65 20 63 62 6f 64 79 7d 20 5b 77 72  {code cbody} [wr
1d90: 61 70 20 24 74 63 6c 6e 61 6d 65 20 24 61 72 67  ap $tclname $arg
1da0: 6c 20 24 72 74 79 70 65 20 24 62 6f 64 79 5d 20  l $rtype $body] 
1db0: 62 72 65 61 6b 0a 0a 09 61 70 70 65 6e 64 20 63  break...append c
1dc0: 6f 64 65 20 22 5c 6e 73 74 61 74 69 63 20 69 6e  ode "\nstatic in
1dd0: 74 20 24 63 6e 61 6d 65 28 43 6c 69 65 6e 74 44  t $cname(ClientD
1de0: 61 74 61 20 63 64 61 74 61 2c 54 63 6c 5f 49 6e  ata cdata,Tcl_In
1df0: 74 65 72 70 20 2a 69 70 2c 20 69 6e 74 20 6f 62  terp *ip, int ob
1e00: 6a 63 2c 54 63 6c 5f 4f 62 6a 2a 20 43 4f 4e 53  jc,Tcl_Obj* CONS
1e10: 54 20 6f 62 6a 76 5c 5b 5c 5d 29 20 5c 7b 5c 6e  T objv\[\]) \{\n
1e20: 22 0a 09 61 70 70 65 6e 64 20 63 6f 64 65 20 22  "..append code "
1e30: 5c 6e 24 63 62 6f 64 79 5c 6e 5c 7d 5c 6e 22 0a  \n$cbody\n\}\n".
1e40: 0a 09 72 65 74 75 72 6e 20 24 63 6f 64 65 0a 7d  ..return $code.}
1e50: 0a 0a 70 72 6f 63 20 3a 3a 74 63 63 34 74 63 6c  ..proc ::tcc4tcl
1e60: 3a 3a 77 72 61 70 45 78 70 6f 72 74 20 7b 6e 61  ::wrapExport {na
1e70: 6d 65 20 63 6d 64 73 20 7b 62 6f 64 79 20 22 22  me cmds {body ""
1e80: 7d 7d 20 7b 0a 09 73 65 74 20 63 6f 64 65 20 22  }} {..set code "
1e90: 44 4c 4c 5f 45 58 50 4f 52 54 20 69 6e 74 20 5b  DLL_EXPORT int [
1ea0: 73 74 72 69 6e 67 20 74 6f 74 69 74 6c 65 20 24  string totitle $
1eb0: 6e 61 6d 65 5d 5f 49 6e 69 74 28 54 63 6c 5f 49  name]_Init(Tcl_I
1ec0: 6e 74 65 72 70 20 2a 69 6e 74 65 72 70 29 20 5c  nterp *interp) \
1ed0: 7b 5c 6e 22 0a 0a 09 66 6f 72 65 61 63 68 20 7b  {\n"...foreach {
1ee0: 74 63 6c 6e 61 6d 65 20 63 6e 61 6d 65 7d 20 24  tclname cname} $
1ef0: 63 6d 64 73 20 7b 0a 09 09 61 70 70 65 6e 64 20  cmds {...append 
1f00: 63 6f 64 65 20 22 54 63 6c 5f 43 72 65 61 74 65  code "Tcl_Create
1f10: 4f 62 6a 43 6f 6d 6d 61 6e 64 28 69 6e 74 65 72  ObjCommand(inter
1f20: 70 2c 20 5c 22 24 74 63 6c 6e 61 6d 65 5c 22 2c  p, \"$tclname\",
1f30: 20 24 63 6e 61 6d 65 2c 20 4e 55 4c 4c 2c 20 4e   $cname, NULL, N
1f40: 55 4c 4c 29 3b 5c 6e 22 0a 09 7d 0a 0a 09 61 70  ULL);\n"..}...ap
1f50: 70 65 6e 64 20 63 6f 64 65 20 24 62 6f 64 79 0a  pend code $body.
1f60: 09 61 70 70 65 6e 64 20 63 6f 64 65 20 22 5c 6e  .append code "\n
1f70: 72 65 74 75 72 6e 20 54 43 4c 5f 4f 4b 3b 5c 6e  return TCL_OK;\n
1f80: 5c 7d 22 0a 0a 09 72 65 74 75 72 6e 20 24 63 6f  \}"...return $co
1f90: 64 65 0a 7d 0a 0a 23 2d 2d 2d 2d 2d 2d 2d 2d 2d  de.}..#---------
1fa0: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d  ----------------
1fb0: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d  ----------------
1fc0: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d  ----------------
1fd0: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 0a 70 72 6f  ------------.pro
1fe0: 63 20 3a 3a 74 63 63 34 74 63 6c 3a 3a 63 70 72  c ::tcc4tcl::cpr
1ff0: 6f 63 20 7b 6e 61 6d 65 20 61 64 65 66 73 20 72  oc {name adefs r
2000: 74 79 70 65 20 7b 62 6f 64 79 20 22 23 22 7d 7d  type {body "#"}}
2010: 20 7b 0a 09 66 6f 72 65 61 63 68 20 7b 63 6f 64   {..foreach {cod
2020: 65 20 63 62 6f 64 79 7d 20 5b 77 72 61 70 20 24  e cbody} [wrap $
2030: 6e 61 6d 65 20 24 61 64 65 66 73 20 24 72 74 79  name $adefs $rty
2040: 70 65 20 24 62 6f 64 79 5d 20 62 72 65 61 6b 0a  pe $body] break.
2050: 0a 09 3a 3a 74 63 63 34 74 63 6c 3a 3a 63 63 6f  ..::tcc4tcl::cco
2060: 64 65 20 24 63 6f 64 65 0a 0a 09 75 70 6c 65 76  de $code...uplev
2070: 65 6c 20 31 20 5b 6c 69 73 74 20 3a 3a 74 63 63  el 1 [list ::tcc
2080: 34 74 63 6c 3a 3a 63 63 6f 6d 6d 61 6e 64 20 24  4tcl::ccommand $
2090: 6e 61 6d 65 20 7b 64 75 6d 6d 79 20 69 70 20 6f  name {dummy ip o
20a0: 62 6a 63 20 6f 62 6a 76 7d 20 24 63 62 6f 64 79  bjc objv} $cbody
20b0: 5d 0a 7d 0a 0a 23 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d  ].}..#----------
20c0: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d  ----------------
20d0: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d  ----------------
20e0: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d  ----------------
20f0: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 0a 70 72 6f 63  -----------.proc
2100: 20 3a 3a 74 63 63 34 74 63 6c 3a 3a 63 64 61 74   ::tcc4tcl::cdat
2110: 61 20 7b 6e 61 6d 65 20 64 61 74 61 7d 20 7b 0a  a {name data} {.
2120: 09 23 20 45 78 74 72 61 63 74 20 62 79 74 65 73  .# Extract bytes
2130: 20 66 72 6f 6d 20 64 61 74 61 0a 09 62 69 6e 61   from data..bina
2140: 72 79 20 73 63 61 6e 20 24 64 61 74 61 20 63 2a  ry scan $data c*
2150: 20 62 79 74 65 73 0a 0a 09 73 65 74 20 69 6e 69   bytes...set ini
2160: 74 74 65 78 74 20 22 5c 6e 22 0a 09 73 65 74 20  ttext "\n"..set 
2170: 6c 69 6e 65 20 22 22 0a 09 73 65 74 20 6e 20 30  line ""..set n 0
2180: 0a 09 73 65 74 20 6c 20 30 0a 09 66 6f 72 65 61  ..set l 0..forea
2190: 63 68 20 63 20 24 62 79 74 65 73 20 7b 0a 09 09  ch c $bytes {...
21a0: 69 66 20 7b 24 6e 20 3e 20 30 7d 20 7b 0a 09 09  if {$n > 0} {...
21b0: 09 61 70 70 65 6e 64 20 69 6e 69 74 74 65 78 74  .append inittext
21c0: 20 22 2c 22 0a 09 09 7d 0a 09 09 69 66 20 7b 24   ","...}...if {$
21d0: 6c 20 3e 20 32 30 7d 20 7b 0a 09 09 09 61 70 70  l > 20} {....app
21e0: 65 6e 64 20 69 6e 69 74 74 65 78 74 20 22 5c 6e  end inittext "\n
21f0: 22 0a 09 09 09 73 65 74 20 6c 20 30 0a 09 09 7d  "....set l 0...}
2200: 0a 0a 09 09 69 66 20 7b 24 6c 3d 3d 30 7d 20 7b  ....if {$l==0} {
2210: 0a 09 09 09 61 70 70 65 6e 64 20 69 6e 69 74 74  ....append initt
2220: 65 78 74 20 22 20 20 22 0a 09 09 7d 0a 0a 09 09  ext "  "...}....
2230: 61 70 70 65 6e 64 20 69 6e 69 74 74 65 78 74 20  append inittext 
2240: 5b 66 6f 72 6d 61 74 20 22 30 78 25 30 32 58 22  [format "0x%02X"
2250: 20 5b 65 78 70 72 20 7b 24 63 20 26 20 30 78 66   [expr {$c & 0xf
2260: 66 7d 5d 5d 0a 09 09 69 6e 63 72 20 6e 0a 09 09  f}]]...incr n...
2270: 69 6e 63 72 20 6c 0a 09 7d 0a 0a 09 61 70 70 65  incr l..}...appe
2280: 6e 64 20 69 6e 69 74 74 65 78 74 20 22 5c 6e 22  nd inittext "\n"
2290: 0a 0a 09 73 65 74 20 63 6f 75 6e 74 20 5b 6c 6c  ...set count [ll
22a0: 65 6e 67 74 68 20 24 62 79 74 65 73 5d 20 20 0a  ength $bytes]  .
22b0: 0a 09 73 65 74 20 63 62 6f 64 79 20 22 22 0a 09  ..set cbody ""..
22c0: 61 70 70 65 6e 64 20 63 62 6f 64 79 20 22 73 74  append cbody "st
22d0: 61 74 69 63 20 75 6e 73 69 67 6e 65 64 20 63 68  atic unsigned ch
22e0: 61 72 20 73 63 72 69 70 74 5c 5b 24 63 6f 75 6e  ar script\[$coun
22f0: 74 5c 5d 20 3d 20 5c 7b 22 20 22 5c 6e 22 0a 09  t\] = \{" "\n"..
2300: 61 70 70 65 6e 64 20 63 62 6f 64 79 20 24 69 6e  append cbody $in
2310: 69 74 74 65 78 74 0a 09 61 70 70 65 6e 64 20 63  ittext..append c
2320: 62 6f 64 79 20 22 5c 7d 3b 22 20 22 5c 6e 22 0a  body "\};" "\n".
2330: 0a 09 61 70 70 65 6e 64 20 63 62 6f 64 79 20 22  ..append cbody "
2340: 54 63 6c 5f 53 65 74 42 79 74 65 41 72 72 61 79  Tcl_SetByteArray
2350: 4f 62 6a 28 54 63 6c 5f 47 65 74 4f 62 6a 52 65  Obj(Tcl_GetObjRe
2360: 73 75 6c 74 28 69 70 29 2c 20 28 75 6e 73 69 67  sult(ip), (unsig
2370: 6e 65 64 20 63 68 61 72 2a 29 20 73 63 72 69 70  ned char*) scrip
2380: 74 2c 20 24 63 6f 75 6e 74 29 3b 5c 6e 22 0a 09  t, $count);\n"..
2390: 61 70 70 65 6e 64 20 63 62 6f 64 79 20 22 72 65  append cbody "re
23a0: 74 75 72 6e 20 54 43 4c 5f 4f 4b 3b 22 20 22 5c  turn TCL_OK;" "\
23b0: 6e 22 0a 0a 09 75 70 6c 65 76 65 6c 20 31 20 5b  n"...uplevel 1 [
23c0: 6c 69 73 74 20 74 63 63 34 74 63 6c 3a 3a 63 63  list tcc4tcl::cc
23d0: 6f 6d 6d 61 6e 64 20 24 6e 61 6d 65 20 7b 64 75  ommand $name {du
23e0: 6d 6d 79 20 69 70 20 6f 62 6a 63 20 6f 62 6a 76  mmy ip objc objv
23f0: 7d 20 24 63 62 6f 64 79 5d 0a 0a 09 72 65 74 75  } $cbody]...retu
2400: 72 6e 20 24 6e 61 6d 65 0a 7d 0a 0a 23 2d 2d 2d  rn $name.}..#---
2410: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d  ----------------
2420: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d  ----------------
2430: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d  ----------------
2440: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d  ----------------
2450: 0a 70 72 6f 63 20 3a 3a 74 63 63 34 74 63 6c 3a  .proc ::tcc4tcl:
2460: 3a 63 63 6f 6d 6d 61 6e 64 20 7b 70 72 6f 63 6e  :ccommand {procn
2470: 61 6d 65 20 61 6e 61 6d 65 73 20 62 6f 64 79 7d  ame anames body}
2480: 20 7b 0a 09 76 61 72 69 61 62 6c 65 20 74 63 63   {..variable tcc
2490: 0a 0a 09 23 20 46 75 6c 6c 79 20 71 75 61 6c 69  ...# Fully quali
24a0: 66 69 65 64 20 70 72 6f 63 20 6e 61 6d 65 0a 09  fied proc name..
24b0: 69 66 20 7b 5b 73 74 72 69 6e 67 20 6d 61 74 63  if {[string matc
24c0: 68 20 22 3a 3a 2a 22 20 24 70 72 6f 63 6e 61 6d  h "::*" $procnam
24d0: 65 5d 7d 20 7b 0a 09 09 23 20 70 72 6f 63 6e 61  e]} {...# procna
24e0: 6d 65 20 69 73 20 61 6c 72 65 61 64 79 20 61 62  me is already ab
24f0: 73 6f 6c 75 74 65 0a 09 7d 20 65 6c 73 65 20 7b  solute..} else {
2500: 0a 09 09 73 65 74 20 6e 73 66 72 6f 6d 20 5b 75  ...set nsfrom [u
2510: 70 6c 65 76 65 6c 20 31 20 7b 6e 61 6d 65 73 70  plevel 1 {namesp
2520: 61 63 65 20 63 75 72 72 65 6e 74 7d 5d 20 20 20  ace current}]   
2530: 20 0a 09 09 69 66 20 7b 24 6e 73 66 72 6f 6d 20   ...if {$nsfrom 
2540: 65 71 20 22 3a 3a 22 7d 20 7b 0a 09 09 09 73 65  eq "::"} {....se
2550: 74 20 6e 73 66 72 6f 6d 20 22 22 0a 09 09 7d 0a  t nsfrom ""...}.
2560: 0a 09 09 73 65 74 20 70 72 6f 63 6e 61 6d 65 20  ...set procname 
2570: 22 24 7b 6e 73 66 72 6f 6d 7d 3a 3a 24 7b 70 72  "${nsfrom}::${pr
2580: 6f 63 6e 61 6d 65 7d 22 0a 09 7d 0a 0a 09 73 65  ocname}"..}...se
2590: 74 20 76 28 63 6c 69 65 6e 74 64 61 74 61 29 20  t v(clientdata) 
25a0: 63 6c 69 65 6e 74 64 61 74 61 0a 09 73 65 74 20  clientdata..set 
25b0: 76 28 69 6e 74 65 72 70 29 20 20 20 20 20 69 6e  v(interp)     in
25c0: 74 65 72 70 0a 09 73 65 74 20 76 28 6f 62 6a 63  terp..set v(objc
25d0: 29 20 20 20 20 20 20 20 6f 62 6a 63 0a 09 73 65  )       objc..se
25e0: 74 20 76 28 6f 62 6a 76 29 20 20 20 20 20 20 20  t v(objv)       
25f0: 6f 62 6a 76 0a 0a 09 73 65 74 20 69 64 20 30 0a  objv...set id 0.
2600: 0a 09 66 6f 72 65 61 63 68 20 64 65 66 6e 61 6d  ..foreach defnam
2610: 65 20 7b 63 6c 69 65 6e 74 64 61 74 61 20 69 6e  e {clientdata in
2620: 74 65 72 70 20 6f 62 6a 63 20 6f 62 6a 76 7d 20  terp objc objv} 
2630: 7b 0a 09 09 69 66 20 7b 5b 6c 6c 65 6e 67 74 68  {...if {[llength
2640: 20 24 61 6e 61 6d 65 73 5d 20 3e 20 24 69 64 7d   $anames] > $id}
2650: 20 7b 0a 09 09 09 73 65 74 20 76 6e 61 6d 65 20   {....set vname 
2660: 5b 6c 69 6e 64 65 78 20 24 61 6e 61 6d 65 73 20  [lindex $anames 
2670: 24 69 64 5d 0a 0a 09 09 09 69 66 20 7b 21 5b 63  $id].....if {![c
2680: 68 65 63 6b 6e 61 6d 65 20 24 76 6e 61 6d 65 5d  heckname $vname]
2690: 7d 20 7b 0a 09 09 09 09 65 72 72 6f 72 20 22 69  } {.....error "i
26a0: 6e 76 61 6c 69 64 20 76 61 72 69 61 62 6c 65 20  nvalid variable 
26b0: 6e 61 6d 65 20 5c 22 24 76 6e 61 6d 65 5c 22 22  name \"$vname\""
26c0: 0a 09 09 09 7d 0a 09 09 7d 20 65 6c 73 65 20 7b  ....}...} else {
26d0: 0a 09 09 09 73 65 74 20 76 6e 61 6d 65 20 24 64  ....set vname $d
26e0: 65 66 6e 61 6d 65 0a 09 09 7d 0a 0a 09 09 73 65  efname...}....se
26f0: 74 20 76 28 24 64 65 66 6e 61 6d 65 29 20 24 76  t v($defname) $v
2700: 6e 61 6d 65 0a 0a 09 09 69 6e 63 72 20 69 64 0a  name....incr id.
2710: 09 7d 0a 0a 09 73 65 74 20 63 6e 61 6d 65 20 43  .}...set cname C
2720: 6d 64 5f 4e 24 7b 69 64 7d 5f 5b 63 6c 65 61 6e  md_N${id}_[clean
2730: 6e 61 6d 65 20 24 70 72 6f 63 6e 61 6d 65 5d 0a  name $procname].
2740: 09 73 65 74 20 63 6f 64 65 20 22 22 0a 0a 09 69  .set code ""...i
2750: 66 20 7b 5b 69 6e 66 6f 20 65 78 69 73 74 73 20  f {[info exists 
2760: 74 63 63 28 74 6b 29 5d 20 26 26 20 24 74 63 63  tcc(tk)] && $tcc
2770: 28 74 6b 29 7d 20 7b 0a 09 09 61 70 70 65 6e 64  (tk)} {...append
2780: 20 63 6f 64 65 20 22 5c 23 69 6e 63 6c 75 64 65   code "\#include
2790: 20 3c 74 6b 2e 68 3e 22 20 22 5c 6e 22 0a 09 7d   <tk.h>" "\n"..}
27a0: 0a 0a 09 69 66 20 7b 5b 69 6e 66 6f 20 65 78 69  ...if {[info exi
27b0: 73 74 73 20 74 63 63 28 63 6f 64 65 29 5d 7d 20  sts tcc(code)]} 
27c0: 7b 0a 09 09 61 70 70 65 6e 64 20 63 6f 64 65 20  {...append code 
27d0: 24 74 63 63 28 63 6f 64 65 29 0a 09 09 61 70 70  $tcc(code)...app
27e0: 65 6e 64 20 63 6f 64 65 20 22 5c 6e 22 0a 09 7d  end code "\n"..}
27f0: 0a 09 73 65 74 20 74 63 63 28 63 6f 64 65 29 20  ..set tcc(code) 
2800: 22 22 0a 0a 09 61 70 70 65 6e 64 20 63 6f 64 65  ""...append code
2810: 20 22 69 6e 74 20 24 63 6e 61 6d 65 20 28 43 6c   "int $cname (Cl
2820: 69 65 6e 74 44 61 74 61 20 24 76 28 63 6c 69 65  ientData $v(clie
2830: 6e 74 64 61 74 61 29 2c 54 63 6c 5f 49 6e 74 65  ntdata),Tcl_Inte
2840: 72 70 20 2a 24 76 28 69 6e 74 65 72 70 29 2c 22  rp *$v(interp),"
2850: 0a 09 61 70 70 65 6e 64 20 63 6f 64 65 20 22 69  ..append code "i
2860: 6e 74 20 24 76 28 6f 62 6a 63 29 2c 54 63 6c 5f  nt $v(objc),Tcl_
2870: 4f 62 6a 20 2a 43 4f 4e 53 54 20 24 76 28 6f 62  Obj *CONST $v(ob
2880: 6a 76 29 5c 5b 5c 5d 29 20 7b 22 20 22 5c 6e 22  jv)\[\]) {" "\n"
2890: 0a 09 61 70 70 65 6e 64 20 63 6f 64 65 20 24 62  ..append code $b
28a0: 6f 64 79 20 22 5c 6e 22 0a 09 61 70 70 65 6e 64  ody "\n"..append
28b0: 20 63 6f 64 65 20 22 7d 22 20 22 5c 6e 22 0a 0a   code "}" "\n"..
28c0: 09 69 66 20 7b 5b 63 61 74 63 68 20 7b 0a 09 09  .if {[catch {...
28d0: 75 70 6c 65 76 65 6c 20 31 20 5b 6c 69 73 74 20  uplevel 1 [list 
28e0: 74 63 63 34 74 63 6c 3a 3a 63 63 20 24 63 6f 64  tcc4tcl::cc $cod
28f0: 65 5d 0a 09 7d 20 65 72 72 5d 7d 20 7b 0a 09 09  e]..} err]} {...
2900: 75 6e 73 65 74 20 74 63 63 28 63 63 29 0a 09 09  unset tcc(cc)...
2910: 74 63 63 34 74 63 6c 3a 3a 72 65 73 65 74 0a 0a  tcc4tcl::reset..
2920: 09 09 72 65 74 75 72 6e 20 2d 63 6f 64 65 20 65  ..return -code e
2930: 72 72 6f 72 20 24 65 72 72 0a 09 7d 0a 0a 09 4c  rror $err..}...L
2940: 6f 67 20 22 43 52 45 41 54 49 4e 47 20 54 43 4c  og "CREATING TCL
2950: 20 43 4f 4d 4d 41 4e 44 20 24 70 72 6f 63 6e 61   COMMAND $procna
2960: 6d 65 20 2f 20 24 63 6e 61 6d 65 22 0a 09 75 70  me / $cname"..up
2970: 6c 65 76 65 6c 20 31 20 5b 6c 69 73 74 20 24 74  level 1 [list $t
2980: 63 63 28 63 63 29 20 63 6f 6d 6d 61 6e 64 20 24  cc(cc) command $
2990: 70 72 6f 63 6e 61 6d 65 20 24 63 6e 61 6d 65 5d  procname $cname]
29a0: 0a 0a 09 75 6e 73 65 74 20 74 63 63 28 63 63 29  ...unset tcc(cc)
29b0: 20 3b 23 20 63 61 6e 27 74 20 62 65 20 75 73 65   ;# can't be use
29c0: 64 20 66 6f 72 20 63 6f 6d 70 69 6c 69 6e 67 20  d for compiling 
29d0: 61 6e 79 6d 6f 72 65 0a 09 74 63 63 34 74 63 6c  anymore..tcc4tcl
29e0: 3a 3a 72 65 73 65 74 0a 7d 0a 0a 70 72 6f 63 20  ::reset.}..proc 
29f0: 3a 3a 74 63 63 34 74 63 6c 3a 3a 74 6b 20 7b 61  ::tcc4tcl::tk {a
2a00: 72 67 73 7d 20 7b 0a 09 76 61 72 69 61 62 6c 65  rgs} {..variable
2a10: 20 74 63 63 0a 09 73 65 74 20 74 63 63 28 74 6b   tcc..set tcc(tk
2a20: 29 20 31 0a 7d 0a 0a 3a 3a 74 63 63 34 74 63 6c  ) 1.}..::tcc4tcl
2a30: 3a 3a 72 65 73 65 74 0a 6e 61 6d 65 73 70 61 63  ::reset.namespac
2a40: 65 20 65 76 61 6c 20 74 63 63 34 74 63 6c 20 7b  e eval tcc4tcl {
2a50: 6e 61 6d 65 73 70 61 63 65 20 65 78 70 6f 72 74  namespace export
2a60: 20 63 70 72 6f 63 20 63 63 6f 64 65 20 63 64 61   cproc ccode cda
2a70: 74 61 7d 0a                                      ta}.