From 2b2837728b4ebb99ac20cb4e43921bf461e731385b08c8bc5ab429b10812fb77 Mon Sep 17 00:00:00 2001 From: Sergey Matveev Date: Wed, 9 Apr 2025 11:37:44 +0300 Subject: [PATCH] No hard-coded single buffer --- tcl/keks.tcl | 64 ++++++++++++++++++++++++++++++++++++--------- tcl/test-vector.tcl | 3 ++- 2 files changed, 54 insertions(+), 13 deletions(-) diff --git a/tcl/keks.tcl b/tcl/keks.tcl index a1afda1..2416517 100644 --- a/tcl/keks.tcl +++ b/tcl/keks.tcl @@ -15,26 +15,47 @@ namespace eval KEKS { -variable buf {} - proc add {v} { - variable buf + upvar buf buf set buf [string cat $buf $v] } -proc char {v} {add [binary format c $v]} +proc char {v} { + upvar buf buf + add [binary format c $v] +} + +proc RAW {v} { + upvar buf buf + add $v +} + +proc EOC {} { + upvar buf buf + char [expr 0x00] +} + +proc NIL {} { + upvar buf buf + char [expr 0x01] +} + +proc FALSE {} { + upvar buf buf + char [expr 0x02] +} -proc RAW {v} {add $v} -proc EOC {} {char [expr 0x00]} -proc NIL {} {char [expr 0x01]} -proc FALSE {} {char [expr 0x02]} -proc TRUE {} {char [expr 0x03]} +proc TRUE {} { + upvar buf buf + char [expr 0x03] +} proc HEXLET {v} { set v [binary decode hex [string map {- ""} $v]] if {[string length $v] != 16} { error "bad len" } + upvar buf buf char [expr 0x04] add $v } @@ -44,6 +65,7 @@ proc MAGIC {v} { if {$l > 12} { error "too long" } + upvar buf buf add "KEKS" add $v add [string repeat [binary format c 0] [expr {12 - $l}]] @@ -58,9 +80,13 @@ proc toBEbin {l v} { return [join $a ""] } -proc toBE {l v} {add [toBEbin $l $v]} +proc toBE {l v} { + upvar buf buf + add [toBEbin $l $v] +} proc INT {v} { + upvar buf buf if {$v >= 0} { char [expr 0x0C] } { @@ -98,6 +124,7 @@ proc _str {atom v} { set ll 1 set vl [expr {$vl - 61}] } + upvar buf buf char [expr {$atom | $lv}] if {$ll > 0} { toBE $ll $vl @@ -105,10 +132,18 @@ proc _str {atom v} { add $v } -proc BIN {v} {_str [expr 0x80] $v} -proc STR {v} {_str [expr {0x80 | 0x40}] [encoding convertto utf-8 $v]} +proc BIN {v} { + upvar buf buf + _str [expr 0x80] $v +} + +proc STR {v} { + upvar buf buf + _str [expr {0x80 | 0x40}] [encoding convertto utf-8 $v] +} proc LIST {v} { + upvar buf buf char [expr 0x08] foreach i $v { eval $i @@ -148,6 +183,7 @@ proc MAP {pairs} { dict set d $k $v } set keys [lsort -command LenFirstSort $keys] + upvar buf buf char [expr 0x09] foreach k $keys { STR $k @@ -161,10 +197,12 @@ proc SET {v} { foreach k $v { lappend args $k NIL } + upvar buf buf MAP $args } proc BLOB {chunkLen v} { + upvar buf buf char [expr 0x0B] toBE 8 [expr {$chunkLen - 1}] set vl [string length $v] @@ -235,10 +273,12 @@ proc toTAI64 {v} { incr v } set v [expr {$v + 0x4000000000000000}] + upvar buf buf toBE 8 $v } proc TAI64 {v {n 0} {a 0}} { + upvar buf buf if {$a != 0} { char [expr 0x1A] toTAI64 $v diff --git a/tcl/test-vector.tcl b/tcl/test-vector.tcl index 27609bc..2b47135 100644 --- a/tcl/test-vector.tcl +++ b/tcl/test-vector.tcl @@ -1,5 +1,6 @@ source keks.tcl namespace import KEKS::* +set buf "" MAGIC test-vector MAP { @@ -69,4 +70,4 @@ MAP { ip {HEXLET 20010db8-85a3-08d3-1319-8a2e03707348} } -puts [binary encode hex $::KEKS::buf] +puts [binary encode hex $buf] -- 2.48.1