tclrs 0.4.2

Tcl as a fusevm frontend: a parser and compiler to fusevm::Chunk, with no bespoke VM or JIT
Documentation
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
//! `Tcl_UtfToChar16DString` and the two functions under it, ported from
//! `generic/tclUtf.c`.
//!
//! macOS Tk converts every string it hands to Cocoa through this pair: an
//! `NSString` is UTF-16, and Tcl's strings are Tcl's own dialect of UTF-8, so
//! the boundary is exactly here.
//!
//! "Tcl's own dialect" is the reason this is a port rather than a call to
//! `str::encode_utf16`. Tcl's decoder never fails. A lone continuation byte in
//! `0x80..=0x9F` decodes as the *cp1252* character at that position — the table
//! at `generic/tclUtf.c:434-439`, with a citation to Wikipedia in the source —
//! and any other malformed byte decodes as itself. A Rust decoder rejects both,
//! and a host that rejected them would turn a byte string Tk considers
//! printable into an error Tk has no path for.
//!
//! Non-BMP characters are the other subtlety. `Tcl_UtfToChar16` returns *one
//! UTF-16 code unit at a time*: given a four-byte sequence it produces the high
//! surrogate and reports that it consumed **one** byte
//! (`generic/tclUtf.c:520-524`), so the next call re-reads the same sequence
//! from its second byte and, recognising the surrogate it produced last time,
//! emits the low surrogate and consumes three (`generic/tclUtf.c:475-480`).
//! That is why the port keeps `ch` across iterations exactly as the C does.

use std::ffi::c_char;

use super::abi::{RawStub, TclDString, TclStubs};
use super::dstring;
use super::generated::TCL_NAMES;
use super::trace::{record, Table};

macro_rules! entered {
    ($name:literal) => {
        record(
            Table::Tcl,
            TCL_NAMES
                .iter()
                .position(|n| *n == $name)
                .expect("no such slot"),
        )
    };
}

/// `cp1252` (`generic/tclUtf.c:434-439`): what a naked continuation byte in
/// `0x80..=0x9F` decodes to.
const CP1252: [u16; 32] = [
    0x20AC, 0x0081, 0x201A, 0x0192, 0x201E, 0x2026, 0x2020, 0x2021, 0x02C6, 0x2030, 0x0160, 0x2039,
    0x0152, 0x008D, 0x017D, 0x008F, 0x0090, 0x2018, 0x2019, 0x201C, 0x201D, 0x2022, 0x2013, 0x2014,
    0x02DC, 0x2122, 0x0161, 0x203A, 0x0153, 0x009D, 0x017E, 0x0178,
];

/// `UNICODE_SELF` (`generic/tclUtf.c:57`).
const UNICODE_SELF: u16 = 0x80;

/// `complete[]` (`generic/tclUtf.c:87-97`): how many bytes `Tcl_UtfCharComplete`
/// needs to see before the character starting at this byte is whole.
///
/// The two surprises are the C's own, both commented there: a continuation byte
/// asks for 3, because the caller may be pointing at the second byte of a
/// four-byte sequence; and `0xC1` asks for 1, because it can never begin a
/// valid sequence.
fn complete(byte: u8) -> usize {
    match byte {
        0x00..=0x7F => 1,
        0x80..=0xBF => 3,
        0xC1 => 1,
        0xC0 | 0xC2..=0xDF => 2,
        0xE0..=0xEF => 3,
        0xF0..=0xF4 => 4,
        _ => 1,
    }
}

/// `Tcl_UtfCharComplete` (`generic/tclUtf.c:1176-1183`).
fn utf_char_complete(src: &[u8]) -> bool {
    !src.is_empty() && src.len() >= complete(src[0])
}

/// `Tcl_UtfToChar16` (`generic/tclUtf.c:449-542`): decode one UTF-16 code unit,
/// returning how many bytes it consumed.
///
/// `ch` is in/out: on entry it holds whatever the previous call produced, which
/// is what lets the second half of a surrogate pair be recognised.
///
/// Reads up to three bytes past `src[0]`; the caller guarantees they exist,
/// which is what `optPtr` and `Tcl_UtfCharComplete` are for at the call site.
fn utf_to_char16(src: &[u8], ch: &mut u16) -> usize {
    let byte = src[0];
    let at = |i: usize| -> u8 { *src.get(i).unwrap_or(&0) };

    if byte < 0xC0 {
        // `generic/tclUtf.c:470-480`: the continuation of a surrogate pair this
        // decoder split in two on the previous call.
        if (byte & 0xC0) == 0x80
            && (at(1) & 0xC0) == 0x80
            && (at(2) & 0xC0) == 0x80
            && ((((byte as u16).wrapping_sub(0x10) << 2) & 0xFC) | 0xD800) == (*ch & 0xFCFC)
            && (at(1) & 0xF0) == (((*ch << 4) & 0x30) as u8 | 0x80)
        {
            *ch = (((at(1) & 0x0F) as u16) << 6) + (at(2) & 0x3F) as u16 + 0xDC00;
            return 3;
        }
        // `generic/tclUtf.c:482-486`.
        *ch = if (byte as u16).wrapping_sub(0x80) < 0x20 {
            CP1252[(byte - 0x80) as usize]
        } else {
            byte as u16
        };
        return 1;
    }
    if byte < 0xE0 {
        // `generic/tclUtf.c:489-499`.
        if byte != 0xC1 && (at(1) & 0xC0) == 0x80 {
            let v = (((byte & 0x1F) as u16) << 6) | (at(1) & 0x3F) as u16;
            if v.wrapping_sub(1) >= UNICODE_SELF - 1 {
                *ch = v;
                return 2;
            }
        }
    } else if byte < 0xF0 {
        // `generic/tclUtf.c:505-516`.
        if (at(1) & 0xC0) == 0x80 && (at(2) & 0xC0) == 0x80 {
            let v = (((byte & 0x0F) as u16) << 12)
                | (((at(1) & 0x3F) as u16) << 6)
                | (at(2) & 0x3F) as u16;
            if v > 0x7FF {
                *ch = v;
                return 3;
            }
        }
    } else if byte < 0xF5 {
        // `generic/tclUtf.c:518-529`. The third trail byte is deliberately not
        // validated — the C cites ticket [ed29806ba] for that.
        if (at(1) & 0xC0) == 0x80 && (at(2) & 0xC0) == 0x80 {
            let high = ((((byte & 0x07) as u16) << 8)
                | (((at(1) & 0x3F) as u16) << 2)
                | ((at(2) & 0x3F) >> 4) as u16)
                .wrapping_sub(0x40);
            if high < 0x400 {
                // One byte consumed, not four: the low surrogate comes from the
                // next call, re-reading from `src[1]`.
                *ch = 0xD800 + high;
                return 1;
            }
        }
    }
    // Anything else represents itself (`generic/tclUtf.c:540-541`).
    *ch = byte as u16;
    1
}

/// Slot 355. `unsigned short *Tcl_UtfToChar16DString(const char *src,
/// Tcl_Size length, Tcl_DString *dsPtr)` (`generic/tclUtf.c:1698-1755`).
///
/// Appends to `dsPtr` and returns the start of what it appended. The two-pass
/// length handling is the C's: over-allocate at one code unit per input byte,
/// which is always enough, then shrink to what was written
/// (`generic/tclUtf.c:1724-1727`, `:1751-1752`).
///
/// # Safety
/// `src` is null or points at `length` readable bytes (or a NUL-terminated
/// string when `length` is negative); `ds` is an initialised `Tcl_DString`.
pub unsafe extern "C" fn utf_to_char16_dstring(
    src: *const c_char,
    length: isize,
    ds: *mut TclDString,
) -> *mut u16 {
    entered!("tcl_UtfToChar16DString");
    if src.is_null() {
        return std::ptr::null_mut();
    }
    let len = if length < 0 {
        libc::strlen(src)
    } else {
        length as usize
    };
    let bytes = std::slice::from_raw_parts(src as *const u8, len);

    // `Tcl_DStringLength` and `Tcl_DStringValue` are field reads
    // (`generic/tcl.h:892-893`), not slots, so they are field reads here too.
    let old_length = (*ds).length as usize;
    dstring::set_length(ds, (old_length + (len + 1) * size_of::<u16>()) as isize);
    let w_start = (*ds).string.add(old_length) as *mut u16;

    let mut w = w_start;
    let mut ch: u16 = 0;
    let mut p = 0usize;
    // The two loops are the C's split at `optPtr = endPtr - 3`
    // (`generic/tclUtf.c:1737-1749`): while at least four bytes remain the
    // decoder may read ahead freely; after that every character has to be
    // checked for completeness, and an incomplete tail is copied byte for byte.
    let opt = len.saturating_sub(3);
    while p <= opt && p < len {
        p += utf_to_char16(&bytes[p..], &mut ch);
        *w = ch;
        w = w.add(1);
    }
    while p < len {
        if utf_char_complete(&bytes[p..]) {
            p += utf_to_char16(&bytes[p..], &mut ch);
            *w = ch;
        } else {
            *w = bytes[p] as u16;
            p += 1;
        }
        w = w.add(1);
    }
    *w = 0;
    let written = w as usize - w_start as usize;
    dstring::set_length(ds, (old_length + written) as isize);
    w_start
}

/// `Tcl_UtfToUniChar` (`generic/tclUtf.c:551-625`): decode one *code point*,
/// returning how many bytes it consumed.
///
/// The 32-bit sibling of [`utf_to_char16`], and the only difference that
/// matters is the four-byte case: this one produces the whole character and
/// consumes four bytes, where the 16-bit decoder produces a high surrogate and
/// consumes one. Everything else — the cp1252 table, the overlong rejections,
/// "represents itself" — is the same, and is the same code path in the C too.
fn utf_to_uni_char(src: &[u8], ch: &mut i32) -> usize {
    let byte = src[0];
    let at = |i: usize| -> u8 { *src.get(i).unwrap_or(&0) };

    if byte < 0xC0 {
        // `generic/tclUtf.c:563-573`.
        *ch = if (byte as u32).wrapping_sub(0x80) < 0x20 {
            CP1252[(byte - 0x80) as usize] as i32
        } else {
            byte as i32
        };
        return 1;
    }
    if byte < 0xE0 {
        // `generic/tclUtf.c:576-586`.
        if byte != 0xC1 && (at(1) & 0xC0) == 0x80 {
            let v = (((byte & 0x1F) as i32) << 6) | (at(1) & 0x3F) as i32;
            if (v - 1) as u32 >= (UNICODE_SELF as u32) - 1 {
                *ch = v;
                return 2;
            }
        }
    } else if byte < 0xF0 {
        // `generic/tclUtf.c:592-603`.
        if (at(1) & 0xC0) == 0x80 && (at(2) & 0xC0) == 0x80 {
            let v = (((byte & 0x0F) as i32) << 12)
                | (((at(1) & 0x3F) as i32) << 6)
                | (at(2) & 0x3F) as i32;
            if v > 0x7FF {
                *ch = v;
                return 3;
            }
        }
    } else if byte < 0xF5 {
        // `generic/tclUtf.c:609-620`. All three trail bytes are checked here,
        // unlike the 16-bit decoder.
        if (at(1) & 0xC0) == 0x80 && (at(2) & 0xC0) == 0x80 && (at(3) & 0xC0) == 0x80 {
            let v = (((byte & 0x07) as i32) << 18)
                | (((at(1) & 0x3F) as i32) << 12)
                | (((at(2) & 0x3F) as i32) << 6)
                | (at(3) & 0x3F) as i32;
            if (v - 0x10000) as u32 <= 0xFFFFF {
                *ch = v;
                return 4;
            }
        }
    }
    *ch = byte as i32;
    1
}

/// Slot 646. `Tcl_Size Tcl_UtfToUniChar(const char *src, int *chPtr)`
/// (`generic/tclDecls.h:2537`).
///
/// # Safety
/// `src` must have at least one readable byte, and up to three more when the
/// first is a lead byte.
pub unsafe extern "C" fn utf_to_uni_char_slot(src: *const c_char, ch: *mut i32) -> isize {
    entered!("tcl_UtfToUniChar");
    let bytes = std::slice::from_raw_parts(src as *const u8, 4.min(libc::strlen(src) + 1));
    let mut v: i32 = 0;
    let n = utf_to_uni_char(bytes, &mut v);
    if !ch.is_null() {
        *ch = v;
    }
    n as isize
}

/// Slot 669. `Tcl_Size Tcl_NumUtfChars(const char *src, Tcl_Size length)`
/// (`generic/tclUtf.c:1013-1044`).
///
/// Not the same function as slot 312. This one counts **code points**, because
/// it walks with `TclUtfToUniChar`; slot 312 counts UTF-16 code units. Tk uses
/// both, for different purposes, and installing one body at both slots would
/// miscount every non-BMP string by exactly the number of such characters in
/// it.
///
/// # Safety
/// As [`num_utf_chars`].
pub unsafe extern "C" fn num_utf_chars_cp(src: *const c_char, length: isize) -> isize {
    entered!("tcl_NumUtfChars");
    if src.is_null() {
        return 0;
    }
    let len = if length < 0 {
        libc::strlen(src)
    } else {
        length as usize
    };
    let bytes = std::slice::from_raw_parts(src as *const u8, len);
    let mut ch: i32 = 0;
    let mut p = 0usize;
    let mut count: isize = 0;
    let opt = len.saturating_sub(4);
    while p <= opt && p < len {
        p += utf_to_uni_char(&bytes[p..], &mut ch);
        count += 1;
    }
    while p < len {
        if utf_char_complete(&bytes[p..]) {
            p += utf_to_uni_char(&bytes[p..], &mut ch);
        } else {
            p += 1;
        }
        count += 1;
    }
    count
}

/// Slot 671. `const char *Tcl_UtfAtIndex(const char *src, Tcl_Size index)`
/// (`generic/tclUtf.c:1150-1160`).
///
/// The code-point sibling of [`utf_at_index`], and simpler for it: with no
/// surrogates to produce there is no trailing correction to make.
///
/// # Safety
/// As [`utf_at_index`].
pub unsafe extern "C" fn utf_at_index_cp(src: *const c_char, index: isize) -> *const c_char {
    entered!("tcl_UtfAtIndex");
    if src.is_null() {
        return src;
    }
    let mut at = 0usize;
    let mut ch: i32 = 0;
    let mut remaining = index;
    while remaining > 0 {
        let rest =
            std::slice::from_raw_parts(src.add(at) as *const u8, libc::strlen(src.add(at)) + 1);
        at += utf_to_uni_char(rest, &mut ch);
        remaining -= 1;
    }
    src.add(at)
}

/// Slot 312. `Tcl_Size TclNumUtfChars(const char *src, Tcl_Size length)`
/// (`generic/tclUtf.c:1050-1101`), reached through the `Tcl_NumUtfChars` macro
/// (`generic/tclDecls.h:3873`).
///
/// It counts UTF-16 *code units*, not code points: the decoder it walks with is
/// `Tcl_UtfToChar16`, so a non-BMP character counts as two. That is the number
/// Tk wants — every index it computes with it is an index into an `NSString`.
///
/// An incomplete sequence at the end counts as one character and advances one
/// byte (`generic/tclUtf.c:1090-1096`), which is not what the decoder would do
/// with it, and is deliberate in the C.
///
/// # Safety
/// `src` points at `length` readable bytes, or at a NUL-terminated string when
/// `length` is negative.
pub unsafe extern "C" fn num_utf_chars(src: *const c_char, length: isize) -> isize {
    entered!("tclNumUtfChars");
    if src.is_null() {
        return 0;
    }
    let len = if length < 0 {
        libc::strlen(src)
    } else {
        length as usize
    };
    let bytes = std::slice::from_raw_parts(src as *const u8, len);
    let mut ch: u16 = 0;
    let mut p = 0usize;
    let mut count: isize = 0;
    // The C's split at `optPtr = endPtr - 4` (`generic/tclUtf.c:1074-1086`).
    let opt = len.saturating_sub(4);
    while p <= opt && p < len {
        p += utf_to_char16(&bytes[p..], &mut ch);
        count += 1;
    }
    while p < len {
        if utf_char_complete(&bytes[p..]) {
            p += utf_to_char16(&bytes[p..], &mut ch);
        } else {
            p += 1;
        }
        count += 1;
    }
    count
}

/// Slot 325. `const char *TclUtfAtIndex(const char *src, Tcl_Size index)`
/// (`generic/tclUtf.c:1116-1140`), reached through the `Tcl_UtfAtIndex` macro.
///
/// `index` counts UTF-16 code units, matching [`num_utf_chars`]. The trailing
/// correction is what makes that consistent: if the walk stopped on a high
/// surrogate that the decoder produced from a single byte, the position asked
/// for is the *second* unit of that pair, and the answer is one more decode on
/// (`generic/tclUtf.c:1130-1135`).
///
/// The string is walked as NUL-terminated — the C has no length to stop at —
/// so a caller asking for an index past the end walks off it, there and here.
///
/// # Safety
/// `src` must be NUL-terminated and `index` must be within its length in code
/// units.
pub unsafe extern "C" fn utf_at_index(src: *const c_char, index: isize) -> *const c_char {
    entered!("tclUtfAtIndex");
    if src.is_null() {
        return src;
    }
    let mut at = 0usize;
    let mut ch: u16 = 0;
    let mut len = 0usize;
    let rest = |p: usize| -> &'static [u8] {
        std::slice::from_raw_parts(src.add(p) as *const u8, libc::strlen(src.add(p)) + 1)
    };
    let mut remaining = index;
    while remaining > 0 {
        len = utf_to_char16(rest(at), &mut ch);
        at += len;
        remaining -= 1;
    }
    if index > 0 && ch >= 0xD800 && len < 3 {
        at += utf_to_char16(rest(at), &mut ch);
    }
    src.add(at)
}

/// Patch this module's slots into `t`, returning their indices.
///
/// # Safety
/// Each erased signature is the one `tclDecls.h` gives the slot, quoted on the
/// line above it.
pub unsafe fn install_impls(t: &mut TclStubs) -> Vec<usize> {
    vec![
        // unsigned short *(*tcl_UtfToChar16DString)(const char *, Tcl_Size,
        //     Tcl_DString *) /* 355 */
        install(
            t,
            "tcl_UtfToChar16DString",
            utf_to_char16_dstring as *const (),
        ),
        // Tcl_Size (*tclNumUtfChars)(const char *src, Tcl_Size length) /* 312 */
        install(t, "tclNumUtfChars", num_utf_chars as *const ()),
        // const char *(*tclUtfAtIndex)(const char *src, Tcl_Size index) /* 325 */
        install(t, "tclUtfAtIndex", utf_at_index as *const ()),
        // Tcl_Size (*tcl_UtfToUniChar)(const char *src, int *chPtr) /* 646 */
        install(t, "tcl_UtfToUniChar", utf_to_uni_char_slot as *const ()),
        // Tcl_Size (*tcl_NumUtfChars)(const char *src, Tcl_Size length) /* 669 */
        install(t, "tcl_NumUtfChars", num_utf_chars_cp as *const ()),
        // const char *(*tcl_UtfAtIndex)(const char *src, Tcl_Size index) /* 671 */
        install(t, "tcl_UtfAtIndex", utf_at_index_cp as *const ()),
    ]
}

/// As [`super::host`]'s own installer: by name, never by literal index.
///
/// # Safety
/// `f` must have the signature `tclDecls.h` gives the named slot.
unsafe fn install(t: &mut TclStubs, name: &str, f: *const ()) -> usize {
    let i = TCL_NAMES
        .iter()
        .position(|n| *n == name)
        .unwrap_or_else(|| panic!("no slot named {name} in TclStubs"));
    t.slots[i] = std::mem::transmute::<*const (), RawStub>(f);
    i
}