Skip to content

Instantly share code, notes, and snippets.

View sebres's full-sized avatar
🛠️
WiP

Sergey G. Brester sebres

🛠️
WiP
View GitHub Profile
@sebres
sebres / lpop.tcl
Created May 11, 2020 10:53
lpop -- definition for lpop command (compatible to TIP 523 implementation)
if {[namespace which -command ::lpop] eq {}} {
proc ::lpop {listvar {index end} args} {
upvar $listvar l
if {![info exists l]} {
return -code error "can't read \"$listvar\": no such variable"
}
if {![llength $args]} {
if {$index eq "end"} {
if {![llength $l]} {
return -code error -errorcode {TCL VALUE INDEX OUTOFRANGE} "index \"$index\" out of range"
@sebres
sebres / test-concurrent-ipset.tcl
Last active April 3, 2020 12:30
test-concurrent-ipset.tcl -- test script concurrently flooding IPs in ipset(s)
#!/usr/bin/env tclsh
package require Thread
array set in {-max-threads 4 -single-set 0 -max-ips 255 -iterations 3 -debug 0}
array set in $::argv
set commoncode {
if {$in(-single-set)} {
proc thipset {n} {return "f2b-test"}
@sebres
sebres / threads-communication.tcl
Created March 3, 2020 13:17
threads-communication.tcl -- simplest example how workers can communicate with master
# task params for all threads
tsv::array set params {one 1 two 2}
# worker task:
set th_task {
if {[catch {
# do some work (here sum of params):
set res [expr {[tsv::get params one] + [tsv::get params two]}]
# provide result to master:
thread::send -async $master [list lappend th_res $res]
@sebres
sebres / collatz-conjecture-iter.py
Last active January 8, 2020 01:47
collatz-conjecture-iter.py -- simplest Collatz conjecture iterator in python
# collatz-conjecture-iter.py -- simplest Collatz conjecture iterator in python
# Author: Serg G. Brester aka sebres
import math
f = lambda x: 3*x+1 if x & 1 else x/2
def fcci(x):
"""single collatz conjecture iteration starting by given x
"""
@sebres
sebres / range.tcl
Created October 23, 2019 13:00
(experimental) range -- create a list generating a sequence of numbers or strings
if {[namespace which -command ::tcl::mathfunc::strincr] eq ""} {
proc ::tcl::mathfunc::strincr {v {increment}} {
string trimleft [binary format I* [expr {"0b[binary scan $v B* v; set v]" + $increment}]] \x00
}
}
proc range args {
set op "<"; set step 1
switch -exact -- [llength $args] \
1 { lassign $args to; set from [expr {$to*0}] } \
2 { lassign $args from to;
@sebres
sebres / ldeclare.tcl
Created October 17, 2019 22:13
ldeclare -- multi-line list declaration with simple substitution (and comments)
# -------------------------------------------------------------------------------
# ldeclare -- multi-line list declaration with simple substitution (and comments)
# -------------------------------------------------------------------------------
proc ldeclare l {
uplevel "list [string map [list \n "\\\n"] \
[regsub -all -line {^\s*\#[^\n]*} $l {}]
]"
}
# -------------------------------------------------------------------------------
@sebres
sebres / multi-thread-eval-tcl-vs-python.tcl
Last active November 1, 2021 17:29
Multi-threaded evaluation Tcl vs. Python (with GIL)
#
# IMPORTANT:
# note to get correct results you should warm up Tcl and Python,
# so better execute it 3 times before you take results for
# the comparison
## ============================================================
## Tcl
## ============================================================
@sebres
sebres / uuid-ffidl.tcl
Created September 19, 2019 20:04
Tcl/C ffi -- example illustrating how simple one can create C-binding within tcl using ffidl
## -------------------------------------------------------------------------------
## ::uuid -- Generate UUID
##
## Example illustrating how simple one can create C-binding within tcl using ffidl
## -------------------------------------------------------------------------------
# ::uuid creator (with on demand binding):
proc ::uuid {args} {
# create _fdl_uuid binding to UuidCreate :
ffidl::callout ::_fdl_uuid {pointer-var} int [ffidl::symbol rpcrt4.dll UuidCreate] stdcall
@sebres
sebres / json-encode.c
Created April 11, 2019 15:49
json-encode.c -- small C-module to get native json escape in Tcl
/*
* json-encode.c --
*
* Small module to get native json escape in tcl.
*
* Compile:
* mingw: gcc -O2 -DUSE_TCL_STUBS=1 -I$tcl/win -I$tcl/generic json-encode.c -shared -o json.dll libtclstub87.a
* *nix: gcc -O2 -DUSE_TCL_STUBS=1 -I$tcl/unix -I$tcl/generic json-encode.c -shared -o json.so libtclstub87.a
*
* Usage: