The Jim Interpreter

still

set bin [binary format I2sH2a* {0x123 0x456} 17 ab "testing"]

# This returns 4 (number of conversions)
binary scan $bin I2sH2a* intlist intval hexval str

    Executable Size     +1%
          PI digits     -4%
    [for] busy loop       .
       [local] loop       .
  [while] busy loop     -1%
                ary    -10%
         ary [dict]    -20%
       ary [static]     -1%
       dynamic code     -3%
dynamic code (list)       .
             expand     -1%
      fibonacci(25)     +1%
           heapsort     -4%
             mandel     -9%
         mini loops       .
       nested loops       .
             repeat       .
             rotate       .
              sieve    -20%
       sieve [dict]    -20%
              upvar    -16%
   wiki.tcl.tk/8566       .

--- dns.tcl.orig	2012-03-05 13:02:36.000000000 +1000
+++ dns.tcl	2012-03-05 13:02:56.000000000 +1000
@@ -1,3 +1,15 @@
+# dns.tcl - Steve Bennett <steveb@workware.net.au>
+#
+# Modified for Jim Tcl to:
+# - use udp transport by default
+# - use sendto/recvfrom
+# - don't try to determine local nameservers
+# - remove support for dns uris and finding local nameservers
+# - remove logging calls
+#   (both of these in order to remove dependencies on tcllib)
+
+# Based on:
+
 # dns.tcl - Copyright (C) 2002 Pat Thoyts <patthoyts@users.sourceforge.net>
 #
 # Provide a Tcl only Domain Name Service client. See RFC 1034 and RFC 1035

@@ -31,14 +43,11 @@
 #
 # $Id: dns.tcl,v 1.36 2008/11/22 12:28:54 mic42 Exp $
 
-package require Tcl 8.2;                # tcl minimum version
-package require logger;                 # tcllib 1.3
-package require uri;                    # tcllib 1.1
-package require uri::urn;               # tcllib 1.2
-package require ip;                     # tcllib 1.7
+package require binary
+package require namespace
 
 namespace eval ::dns {
-    variable version 1.3.3
+    variable version 1.3.3-jim2
     variable rcsid {$Id: dns.tcl,v 1.36 2008/11/22 12:28:54 mic42 Exp $}
 
     namespace export configure resolve name address cname \

@@ -49,23 +58,13 @@
         array set options {
             port       53
             timeout    30000
-            protocol   tcp
+            protocol   udp
             search     {}
             nameserver {localhost}
             loglevel   warn
         }
-        variable log [logger::init dns]
-        ${log}::setlevel $options(loglevel)
-    }
-
-    # We can use either ceptcl or tcludp for UDP support.
-    if {![catch {package require udp 1.0.4} msg]} { ;# tcludp 1.0.4+
-        # If TclUDP 1.0.4 or better is available, use it.
-        set options(protocol) udp
-    } else {
-        if {![catch {package require ceptcl} msg]} {
-            set options(protocol) udp
-        }
+        #variable log [logger::init dns]
+        #${log}::setlevel $options(loglevel)
     }
 
     variable types

@@ -248,14 +237,6 @@
         return -code error "no nameserver specified"
     }
 
-    if {$state(-protocol) == "udp"} {
-        if {[llength [package provide ceptcl]] == 0 \
-                && [llength [package provide udp]] == 0} {
-            return -code error "udp support is not available,\
-                get ceptcl or tcludp"
-        }
-    }
-    
     # Check for reverse lookups
     if {[regexp {^(?:\d{0,3}\.){3}\d{0,3}$} $state(query)]} {
         set addr [lreverse [split $state(query) .]]

@@ -273,6 +254,7 @@
         }
     } else {
         UdpTransmit $token
+        wait $token
     }
     
     return $token

@@ -668,9 +650,9 @@
                                    "operation timed out"]]
     }
 
-    # Sometimes DNS servers drop TCP requests. So it's better to
-    # use asynchronous connect
-    set s [socket -async $state(-nameserver) $state(-port)]
+    # Jim Tcl has no async connect ...
+
+    set s [socket stream $state(-nameserver):$state(-port)]
     fileevent $s writable [list [namespace origin TcpConnected] $token $s]
     set state(sock) $s
     set state(status) connect

@@ -683,11 +665,13 @@
     upvar 0 $token state
 
     fileevent $s writable {}
-    if {[catch {fconfigure $s -peername}]} {
-	# TCP connection failed
-        Finish $token "can't connect to server"
-	return
-    }
+
+    # Jim Tcl has no async connect ...
+#    if {[catch {fconfigure $s -peername}]} {
+#	# TCP connection failed
+#        Finish $token "can't connect to server"
+#	return
+#    }
 
     fconfigure $s -blocking 0 -translation binary -buffering none
 

@@ -722,18 +706,10 @@
                                   "operation timed out"]]
     }
     
-    if {[llength [package provide ceptcl]] > 0} {
-        # using ceptcl
-        set state(sock) [cep -type datagram $state(-nameserver) $state(-port)]
-        fconfigure $state(sock) -blocking 0
-    } else {
-        # using tcludp
-        set state(sock) [udp_open]
-        udp_conf $state(sock) $state(-nameserver) $state(-port)
-    }
-    fconfigure $state(sock) -translation binary -buffering none
+    set state(sock) [socket dgram]
+    #fconfigure $state(sock) -translation binary -buffering none
     set state(status) connect
-    puts -nonewline $state(sock) $state(request)
+    $state(sock) sendto $state(request) $state(-nameserver):$state(-port)
     
     fileevent $state(sock) readable [list [namespace current]::UdpEvent $token]
     

@@ -879,7 +855,7 @@
     upvar 0 $token state
     set s $state(sock)
 
-    set payload [read $state(sock)]
+    set payload [$state(sock) recvfrom 1500]
     append state(reply) $payload
 
     binary scan $payload S id

@@ -1011,17 +987,6 @@
 }
 
 # -------------------------------------------------------------------------
-# Description:
-#   Reverse a list. Code from http://wiki.tcl.tk/tcl/43
-#
-proc ::dns::lreverse {lst} {
-    set res {}
-    set i [llength $lst]
-    while {$i} {lappend res [lindex $lst [incr i -1]]}
-    return $res
-}
-
-# -------------------------------------------------------------------------
 
 proc ::dns::KeyOf {arrayname value {default {}}} {
     upvar $arrayname array


	Endian
Little	Big	Host	Type	Notes
`a`			byte string	format pads with nulls
`A`			byte string	format pads with spaces, scan strips trailing spaces/nulls
`b`	`B`		binary digits
`h`	`H`		hex digits
`c`			8 bit integer list	In other words, ASCII chars
`s`	`S`	`t`	16 bit integer list
`i`	`I`	`n`	32 bit integer list
`w`	`W`	`m`	64 bit integer list
`r`	`R`	`f`	single prec. float list
`q`	`Q`	`d`	double prec. float list
`x`			null bytes	count is number of bytes
`X`			move cursor back	count is number of bytes to back up
`@`			move cursor to location	count is byte position, zero based

The Jim Interpreter

Jim Tcl version 0.77

ANNOUNCE: Jim Tcl version 0.77

CHANGES SINCE VERSION 0.76

Jim Tcl version 0.76

ANNOUNCE: Jim Tcl version 0.76

CHANGES SINCE VERSION 0.75

Jim Tcl version 0.75

ANNOUNCE: Jim Tcl version 0.75

CHANGES SINCE VERSION 0.74

Binary Cheatsheet

Jim Tcl version 0.74

ANNOUNCE: Jim Tcl version 0.74

CHANGES SINCE VERSION 0.73

Coping without Namespaces - Revisited

About Jim Tcl

Community