Check-in [c2b79891aa]

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Use llvmtcl 3.9 (release) features to provide the target platform information before starting to generate code in a module, and to do 'sizeof' and 'alignof' correctly. mrtest::* now compile correctly.
Timelines: family | ancestors | descendants | both | kbk-nre
Files: files | file ages | folders
SHA3-256:c2b79891aa4f21c519f9d55cd6dd8a38bd2f8935c06eda2c74cc32aa3391cab6
User & Date: kbk 2018-04-24 03:39:06
Original Comment: Use llvmtcl 3.10 features to provide the target platform information before starting to generate code in a module, and to do 'sizeof' and 'alignof' correctly. mrtest::* now compile correctly.
Context
2018-04-25
00:47
Streamline returnFromInvoke a tiny bit. check-in: 020581c952 user: kbk tags: kbk-nre
2018-04-24
03:39
Use llvmtcl 3.9 (release) features to provide the target platform information before starting to generate code in a module, and to do 'sizeof' and 'alignof' correctly. mrtest::* now compile correctly. check-in: c2b79891aa user: kbk tags: kbk-nre
2018-04-23
03:10
Force alignment of coroutine promise to 2*sizeof(pointer), in hopes of getting consistent alignment between coro.begin and later references to the coro frame. (Didn't help, alas, but it doesn't hurt to specify the alignment that's required in any case. check-in: bc3db1940d user: kbk tags: notworking, kbk-nre
Changes

Changes to codegen/config.tcl.

7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
# Copyright (c) 2014-2017 by Donal K. Fellows
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
#------------------------------------------------------------------------------
 
package require llvmtcl 3.9
package require platform

namespace eval ::LLVM {
    namespace path ::llvmtcl
    variable THIS_SCRIPT [info script]

    variable counter 0







|







7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
# Copyright (c) 2014-2017 by Donal K. Fellows
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
#------------------------------------------------------------------------------
 
package require llvmtcl 3.10
package require platform

namespace eval ::LLVM {
    namespace path ::llvmtcl
    variable THIS_SCRIPT [info script]

    variable counter 0

Changes to codegen/coro.tcl.

71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
...
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
...
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
...
398
399
400
401
402
403
404
405




406
407
408
409
410
411
412
413
414
415
416
417

	$api Tcl_NRAddCallback $interp ${tcl.coro.runner} ${coro.handle} \
	    [my null char*] [my null char*] [my null char*]
    
	# Transfer the interpreter status into the coroutine promise
	# so that the body of the coroutine can see it.

	set alignment [expr {2 * $::tcl_platform(pointerSize)}]
	set llvm.coro.promise [$m intrinsic coro.promise]
	set promise.addr.raw \
	    [my call ${llvm.coro.promise} \
		 [list ${coro.handle} \
		      [Const $alignment int32] \
		      [Const false bool]] \
		 "promise.addr.raw"]
................................................................................
    set trap [$func block "coro.trap"]
    set cleanup [$func block "coro.cleanup"]
    set free_frame [$func block "coro.free.frame"]
    set suspend [$func block "coro.suspend"]

    # Allocate the coroutine promise

    set alignment [expr {2 * $::tcl_platform(pointerSize)}]
    set promise [$b alloc [my CoroPromiseType] "coro,promise"]
    $b align $promise $::tcl_platform(pointerSize)
    set clientData [$b cast(ptr) $promise char]

    # Get a coroutine ID

    set llvm.coro.id [$m intrinsic coro.id]
    set coro_id [$b call ${llvm.coro.id} \
		     [list [Const $alignment int32] $clientData \
................................................................................
#
# Results:
#	Returns a list of two LLVM value refs: the status code and the
#	return value.

oo::define TclCompiler method returnedFromCoro {rettype callee corohandle} {

    # TODO - How to determine alignment to pass to coro,promise?

    # Retrieve the coroutine promise from the coroutine handle

    set handle [my LoadOrLiteral $corohandle]
    set ptype [my CoroPromiseType $rettype $callee]
    set alignment [Const $::tcl_platform(pointerSize) int32]
    set paddr_raw [$b call [$m intrinsic coro.promise] \
		       [list $handle $alignment [Const false bool]] \
		       "promise.addr.raw"]
    set paddr [$b cast(ptr) $paddr_raw $ptype "promise.addr"]

    # Retrieve the return code and return value of the called procedure

................................................................................
#		 wrapped function invocation
#	restype - Type of the result that is stored in the coroutine promise
#
# Results:
#	Returns the LLVM value reference to the result of the wrapped function

oo::define Builder method NRReturnToThunk {handle resType} {
    set alignment [expr {2 * $::tcl_platform(pointerSize)}]




    set llvm.coro.promise [$m intrinsic coro.promise]
    set promiseAddrRaw [my call ${llvm.coro.promise} \
			    [list $handle [Const $alignment int32] \
				 [Const false bool]] "promise.addr.raw"]
    set promiseType named{$resType.promise,int32,$resType}
    set promiseAddr [my cast(ptr) $promiseAddrRaw $promiseType]
    set value [my load [my gep $promiseAddr 0 1] "value"]
    set llvm.coro.destroy [$m intrinsic coro.destroy]
    my call ${llvm.coro.destroy} $handle
    return $value
}
oo::define Builder export NRReturnToThunk







|







 







|

|







 







<
<




|







 







|
>
>
>
>




<







71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
...
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
...
356
357
358
359
360
361
362


363
364
365
366
367
368
369
370
371
372
373
374
...
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411

412
413
414
415
416
417
418

	$api Tcl_NRAddCallback $interp ${tcl.coro.runner} ${coro.handle} \
	    [my null char*] [my null char*] [my null char*]
    
	# Transfer the interpreter status into the coroutine promise
	# so that the body of the coroutine can see it.

	set alignment [expr {2 * [$m alignof [Type char*]]}]
	set llvm.coro.promise [$m intrinsic coro.promise]
	set promise.addr.raw \
	    [my call ${llvm.coro.promise} \
		 [list ${coro.handle} \
		      [Const $alignment int32] \
		      [Const false bool]] \
		 "promise.addr.raw"]
................................................................................
    set trap [$func block "coro.trap"]
    set cleanup [$func block "coro.cleanup"]
    set free_frame [$func block "coro.free.frame"]
    set suspend [$func block "coro.suspend"]

    # Allocate the coroutine promise

    set alignment [$m alignof [Type [my CoroPromiseType]]]
    set promise [$b alloc [my CoroPromiseType] "coro,promise"]
    $b align $promise $alignment
    set clientData [$b cast(ptr) $promise char]

    # Get a coroutine ID

    set llvm.coro.id [$m intrinsic coro.id]
    set coro_id [$b call ${llvm.coro.id} \
		     [list [Const $alignment int32] $clientData \
................................................................................
#
# Results:
#	Returns a list of two LLVM value refs: the status code and the
#	return value.

oo::define TclCompiler method returnedFromCoro {rettype callee corohandle} {



    # Retrieve the coroutine promise from the coroutine handle

    set handle [my LoadOrLiteral $corohandle]
    set ptype [my CoroPromiseType $rettype $callee]
    set alignment [Const [$m alignof $ptype] int32]
    set paddr_raw [$b call [$m intrinsic coro.promise] \
		       [list $handle $alignment [Const false bool]] \
		       "promise.addr.raw"]
    set paddr [$b cast(ptr) $paddr_raw $ptype "promise.addr"]

    # Retrieve the return code and return value of the called procedure

................................................................................
#		 wrapped function invocation
#	restype - Type of the result that is stored in the coroutine promise
#
# Results:
#	Returns the LLVM value reference to the result of the wrapped function

oo::define Builder method NRReturnToThunk {handle resType} {
    set promiseType named{$resType.promise,int32,$resType}
    set alignment [$m alignof [Type $promiseType]]
    puts "promise = $promiseType"
    puts "alignof(promise) = $alignment"
    puts "sizeof(promise) = [$m sizeof [Type $promiseType]]"
    set llvm.coro.promise [$m intrinsic coro.promise]
    set promiseAddrRaw [my call ${llvm.coro.promise} \
			    [list $handle [Const $alignment int32] \
				 [Const false bool]] "promise.addr.raw"]

    set promiseAddr [my cast(ptr) $promiseAddrRaw $promiseType]
    set value [my load [my gep $promiseAddr 0 1] "value"]
    set llvm.coro.destroy [$m intrinsic coro.destroy]
    my call ${llvm.coro.destroy} $handle
    return $value
}
oo::define Builder export NRReturnToThunk

Changes to codegen/jit.tcl.

100
101
102
103
104
105
106


107
108
109
110
111
112
113
...
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
...
259
260
261
262
263
264
265

266
267
268
269
270
271
272
...
436
437
438
439
440
441
442

443
444
445
446
447
448
449
	    set cmds [lsort -unique $cmds]
	}

	timeit init-module {
	    set ns [uplevel 1 {namespace current}]
	    set name [SelectModuleName $ns]
	    set module [Module new $name]



	    # Get an instance of the system that glues things to the Tcl
	    # runtime.
	    set thunkBuilder [ThunkBuilder new $module]
	    set sp [quadcode::specializer new]
	}

................................................................................
		variable dumpPost [$module dump]
		variable bitcodePost [$module bitcode]
	    }

	    timeit assemble {
		# Call the package init function. This causes native code to
		# be issued and linked.
		$module mcjit
		$thunkBuilder install
	    }

	    # Return the LLVM handle to the module, just in case.
	    #
	    # Note that it is *UNSAFE* to uninstall this package (unless all
	    # commands it creates are deleted, since we don't do any custom
................................................................................
	set cmds [lmap p $cmds {uplevel 1 [list namespace which $p]}]
	# Strip any duplicates
	set cmds [lsort -unique $cmds]

	set ns [uplevel 1 {namespace current}]
	set name [SelectModuleName $ns]
	set module [Module new $name]


	# Get an instance of the system that glues things to the Tcl runtime.
	set thunkBuilder [ThunkBuilder new $module]
	set sp [quadcode::specializer new]

	try {
	    set required {}
................................................................................

	# Convert list of commands and package name into what the compiler
	# really wants.
	set cmds [lsort -unique $packageProcedures($p_id)]
	unset -nocomplain packageProcedures($p_id)
	set name [SelectModuleName $packageName]
	set module [Module new $name $pkgfile]


	# Get an instance of the system that glues things to the Tcl runtime.
	set thunkBuilder [ThunkBuilder new $module]
	set sp [quadcode::specializer new]

	try {
	    set required {}







>
>







 







<







 







>







 







>







100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
...
196
197
198
199
200
201
202

203
204
205
206
207
208
209
...
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
...
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
	    set cmds [lsort -unique $cmds]
	}

	timeit init-module {
	    set ns [uplevel 1 {namespace current}]
	    set name [SelectModuleName $ns]
	    set module [Module new $name]

	    $module mcjit

	    # Get an instance of the system that glues things to the Tcl
	    # runtime.
	    set thunkBuilder [ThunkBuilder new $module]
	    set sp [quadcode::specializer new]
	}

................................................................................
		variable dumpPost [$module dump]
		variable bitcodePost [$module bitcode]
	    }

	    timeit assemble {
		# Call the package init function. This causes native code to
		# be issued and linked.

		$thunkBuilder install
	    }

	    # Return the LLVM handle to the module, just in case.
	    #
	    # Note that it is *UNSAFE* to uninstall this package (unless all
	    # commands it creates are deleted, since we don't do any custom
................................................................................
	set cmds [lmap p $cmds {uplevel 1 [list namespace which $p]}]
	# Strip any duplicates
	set cmds [lsort -unique $cmds]

	set ns [uplevel 1 {namespace current}]
	set name [SelectModuleName $ns]
	set module [Module new $name]
	$module prepareToCompile

	# Get an instance of the system that glues things to the Tcl runtime.
	set thunkBuilder [ThunkBuilder new $module]
	set sp [quadcode::specializer new]

	try {
	    set required {}
................................................................................

	# Convert list of commands and package name into what the compiler
	# really wants.
	set cmds [lsort -unique $packageProcedures($p_id)]
	unset -nocomplain packageProcedures($p_id)
	set name [SelectModuleName $packageName]
	set module [Module new $name $pkgfile]
	$module prepareToCompile 

	# Get an instance of the system that glues things to the Tcl runtime.
	set thunkBuilder [ThunkBuilder new $module]
	set sp [quadcode::specializer new]

	try {
	    set required {}

Changes to codegen/llvmbuilder.tcl.

1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
    #	type -	The type (as type name or LLVM type reference) to get the size
    #		of.
    #
    # Results:
    #	LLVM constant int reference.

    method sizeof {type} {
	SizeOf [Type $type]
    }

    # Builder:store --
    #
    #	Generate code to write a value to a memory location. The value MUST be
    #	the same type as the memory location being pointed at.
    #







|







1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
    #	type -	The type (as type name or LLVM type reference) to get the size
    #		of.
    #
    # Results:
    #	LLVM constant int reference.

    method sizeof {type} {
	Const [$m sizeof [Type $type]] int64
    }

    # Builder:store --
    #
    #	Generate code to write a value to a memory location. The value MUST be
    #	the same type as the memory location being pointed at.
    #

Changes to codegen/struct.tcl.

33
34
35
36
37
38
39

40
41
42
43
44
45
46
...
143
144
145
146
147
148
149




































150
151
152
153
154
155
156
...
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
478
479


480

481
482
483
484
485
486
487
...
509
510
511
512
513
514
515





















516
517
518
519
520
521
522
...
615
616
617
618
619
620
621
622
623

624
625
626
627
628
629
630
#		The execution engine associated with the module. Only
#		available after one of the engine-construction methods (e.g.,
#		'mcjit', 'interpreter') has been called.

oo::class create Module {
    superclass llvmEntity
    variable module counter funcs builder myname globals externs engine

    variable dbty mainNS thunkNS initFunction dbbuild

    constructor {name {filename "/dev/null"}} {
	next
	variable ::LLVM::debugmeta
#	set status [ParseCommandLineOptions -print-before-all -time-passes]
#		Had also tried:		-debug-pass=Structure
................................................................................
	} on error {} {
	    my Warn "no debugging type for %s in '%s'" \
		[PrintTypeToString $type] [lindex [info level -1] 2]
	    return $dbty([Type void*])
	}
    }





































    # Module:function.create --
    #
    #	Create an instance of the Function class.
    #
    # Parameters:
    #	name -	The suggested name of the function. This is used to generate
    #		both the *actual* name of the function and the name of the
................................................................................
    #		0 to 3.
    #
    # Results:
    #	None.

    method optimize {{level 3}} {
	set level [expr {max(0, min(3, int($level)))}]



	set bld [PassManagerBuilderCreate]
	AddCoroutinePassesToExtensionPoints $bld
	set pm [CreatePassManager] ; # Module pass manager
	set fpm [CreateFunctionPassManagerForModule $module]
	catch {set td [CreateTargetData ""]}
	my verify
	my FinalizeDebuggingMetadata
	try {
	    if {[info exist td]} {
		SetDataLayout $module [CopyStringRepOfTargetData $td]
		AddTargetData $td $pm
		AddTargetData $td $fpm
	    }
	    PassManagerBuilderSetOptLevel $bld $level
	    PassManagerBuilderSetDisableUnrollLoops $bld [expr {!$level}]
	    if {$level > 1} {
		PassManagerBuilderUseInlinerWithThreshold $bld \
		    [expr {$level > 2 ? 275 : 225 }]
	    }
	    PassManagerBuilderPopulateModulePassManager $bld $pm
	    PassManagerBuilderPopulateFunctionPassManager $bld $fpm


	    InitializeFunctionPassManager $fpm
	    for {set fn [GetFirstFunction $module]} \
		{$fn ne ""} \
		{set fn [GetNextFunction $fn]} {
		    VerifyFunction $fn LLVMPrintMessageAction
#		    DumpValue $fn
		    RunFunctionPassManager $fpm $fn
		}
	    FinalizeFunctionPassManager $fpm


	    RunPassManager $pm $module

	} finally {
	    DisposePassManager $fpm
	    DisposePassManager $pm
	    PassManagerBuilderDispose $bld
	}
    }

................................................................................
    #	code from this module.

    method mcjit {{optimisationLevel 2}} {
	if {[info exists engine]} {
	    return -code error "an engine has already been initialised"
	}
	set engine [CreateMCJITCompilerForModule $module $optimisationLevel]





















    }

    # Module:simple --
    #
    #	Set the execution engine for the module to be the simple execution
    #	engine. Note that it is an error for there to be multiple execution
    #	engines set.
................................................................................
    #		(or .asm) format files instead.
    #
    # Results:
    #	None.

    method writeobject {filename {type object}} {
	WriteModuleMachineCodeToFile $module \
	    [file nativename [file normalize $filename]] \
	    $::llvmtcl::host_triple $type

    }

    # Module:engine (property) --
    #
    #	Get the execution engine for the module.

    method engine {} {







>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







>
>
|




<



<
|
|
|
|









>









>
>

>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







|
<
>







33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
...
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
...
478
479
480
481
482
483
484
485
486
487
488
489
490
491

492
493
494

495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
...
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
...
677
678
679
680
681
682
683
684

685
686
687
688
689
690
691
692
#		The execution engine associated with the module. Only
#		available after one of the engine-construction methods (e.g.,
#		'mcjit', 'interpreter') has been called.

oo::class create Module {
    superclass llvmEntity
    variable module counter funcs builder myname globals externs engine
    variable machine layout
    variable dbty mainNS thunkNS initFunction dbbuild

    constructor {name {filename "/dev/null"}} {
	next
	variable ::LLVM::debugmeta
#	set status [ParseCommandLineOptions -print-before-all -time-passes]
#		Had also tried:		-debug-pass=Structure
................................................................................
	} on error {} {
	    my Warn "no debugging type for %s in '%s'" \
		[PrintTypeToString $type] [lindex [info level -1] 2]
	    return $dbty([Type void*])
	}
    }

    # Module:sizeof --
    #
    #	Returns the ABI size of the given type
    #
    # Parameters:
    #	type - The LLVM type handle
    #
    # Results:
    #	An integer giving the size of the given type

    method sizeof {type} {
	if {![info exists layout]} {
	    return -code error "No data layout has been set for this module."
	} else {
	    return [ABISizeOfType $layout $type]
	}
    }

    # Module:alignof --
    #
    #	Returns the ABI alignment of the given type
    #
    # Parameters:
    #	type - The LLVM type handle
    #
    # Results:
    #	An integer giving the alignment of the given type

    method alignof {type} {
	if {![info exists layout]} {
	    return -code error "No data layout has been set for this module."
	} else {
	    return [ABIAlignmentOfType $layout $type]
	}
    }
    
    # Module:function.create --
    #
    #	Create an instance of the Function class.
    #
    # Parameters:
    #	name -	The suggested name of the function. This is used to generate
    #		both the *actual* name of the function and the name of the
................................................................................
    #		0 to 3.
    #
    # Results:
    #	None.

    method optimize {{level 3}} {
	set level [expr {max(0, min(3, int($level)))}]
	if {![info exists machine] || ![info exists layout]} {
	    return -code error "Target machine has not been set."
	}
	set bld [PassManagerBuilderCreate]
	AddCoroutinePassesToExtensionPoints $bld
	set pm [CreatePassManager] ; # Module pass manager
	set fpm [CreateFunctionPassManagerForModule $module]

	my verify
	my FinalizeDebuggingMetadata
	try {

	    # SetDataLayout $module $layout
	    # AddTargetData $td $pm
	    # AddTargetData $td $fpm

	    PassManagerBuilderSetOptLevel $bld $level
	    PassManagerBuilderSetDisableUnrollLoops $bld [expr {!$level}]
	    if {$level > 1} {
		PassManagerBuilderUseInlinerWithThreshold $bld \
		    [expr {$level > 2 ? 275 : 225 }]
	    }
	    PassManagerBuilderPopulateModulePassManager $bld $pm
	    PassManagerBuilderPopulateFunctionPassManager $bld $fpm

	    AddAnalysisPasses $machine $fpm
	    InitializeFunctionPassManager $fpm
	    for {set fn [GetFirstFunction $module]} \
		{$fn ne ""} \
		{set fn [GetNextFunction $fn]} {
		    VerifyFunction $fn LLVMPrintMessageAction
#		    DumpValue $fn
		    RunFunctionPassManager $fpm $fn
		}
	    FinalizeFunctionPassManager $fpm

	    AddAnalysisPasses $machine $pm
	    RunPassManager $pm $module

	} finally {
	    DisposePassManager $fpm
	    DisposePassManager $pm
	    PassManagerBuilderDispose $bld
	}
    }

................................................................................
    #	code from this module.

    method mcjit {{optimisationLevel 2}} {
	if {[info exists engine]} {
	    return -code error "an engine has already been initialised"
	}
	set engine [CreateMCJITCompilerForModule $module $optimisationLevel]
	set machine [GetExecutionEngineTargetMachine $engine]
	set layout [GetExecutionEngineTargetData $engine]
	puts "Compiling for [GetTarget $module]"
	puts "Data Layout = [GetDataLayout $module]"
    }

    # Module:prepareToCompile --
    #
    #	Set the machine and layout to the current target triple, or the
    #	target triple passed as a parameter
    #
    # Parameters:
    #	triple - Target triple

    method prepareToCompile {{triple {}}} {
	set machine [MakeTargetMachine $triple]
	set triple [GetTargetMachineTriple $machine]
	set layout [CreateTargetDataLayout $machine]
	puts "prepareToCompile: Target data layout: [CopyStringRepOfTargetData $layout]"
	SetTarget $module $triple
	SetDataLayout $module [CopyStringRepOfTargetData $layout]
    }

    # Module:simple --
    #
    #	Set the execution engine for the module to be the simple execution
    #	engine. Note that it is an error for there to be multiple execution
    #	engines set.
................................................................................
    #		(or .asm) format files instead.
    #
    # Results:
    #	None.

    method writeobject {filename {type object}} {
	WriteModuleMachineCodeToFile $module \
	    [file nativename [file normalize $filename]]


    }

    # Module:engine (property) --
    #
    #	Get the execution engine for the module.

    method engine {} {

Changes to codegen/thunk.tcl.

194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
	    set block [$metathunk block leave]
	    $metathunkblock build $b {
		$b br $block
	    }
	    $block build $b {
		if {$version ne ""} {
		    set pkgname tclquadcoded::[string trimleft [$m name] ":"]
		    $b call [$m intrinsic debugtrap] {}
		    $b ret [my Tcl_PkgProvideEx $interp \
			    [$b constString $pkgname "pkg.name"] \
			    [$b constString $version "pkg.version"] {}]
		} else {
		    $b ret $OK
		}
	    }







<







194
195
196
197
198
199
200

201
202
203
204
205
206
207
	    set block [$metathunk block leave]
	    $metathunkblock build $b {
		$b br $block
	    }
	    $block build $b {
		if {$version ne ""} {
		    set pkgname tclquadcoded::[string trimleft [$m name] ":"]

		    $b ret [my Tcl_PkgProvideEx $interp \
			    [$b constString $pkgname "pkg.name"] \
			    [$b constString $version "pkg.version"] {}]
		} else {
		    $b ret $OK
		}
	    }