tclquadcode

Check-in [d74cb2ac95]
Login

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

Overview
Comment:Support no-argument [info level] as well.
Timelines: family | ancestors | descendants | both | info-level
Files: files | file ages | folders
SHA3-256:d74cb2ac954704e1697e9b36890c60c819661af83b8348c695ff6405e01904a3
User & Date: dkf 2017-10-31 14:43:07
Context
2017-10-31
15:36
Added documentation. Closed-Leaf check-in: bcbfa13992 user: dkf tags: minor change, info-level
14:43
Support no-argument [info level] as well. check-in: d74cb2ac95 user: dkf tags: info-level
11:20
Fix a reference count management issue. check-in: 1741e5a351 user: dkf tags: info-level
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to codegen/build.tcl.

303
304
305
306
307
308
309




310
311
312
313
314
315
316
    method frame.value {callframetuple {name ""}} {
	my extract $callframetuple 1 $name
    }

    method frame.args(INT) {depth callframe {name ""}} {
	my call ${tcl.callframe.getarglist} [list $callframe $depth] $name
    }





    # Builder:frame.create --
    #
    #	Create and initialise a callframe.
    #
    # Parameters:
    #	varlist -







>
>
>
>







303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
    method frame.value {callframetuple {name ""}} {
	my extract $callframetuple 1 $name
    }

    method frame.args(INT) {depth callframe {name ""}} {
	my call ${tcl.callframe.getarglist} [list $callframe $depth] $name
    }

    method frame.depth {callframe {name ""}} {
	my call ${tcl.callframe.depth} [list $callframe] $name
    }

    # Builder:frame.create --
    #
    #	Create and initialise a callframe.
    #
    # Parameters:
    #	varlist -

Changes to codegen/compile.tcl.

786
787
788
789
790
791
792






793
794
795
796
797
798
799
		    set name [my LocalVarName $tgt]
		    set opcode frame.args
		    append opcode ( [my ValueTypes $src] )
		    set val [my LoadOrLiteral $src]
		    set result [$b $opcode $val $theframe $name]
		    my StoreResult $tgt $result
		}






		"strcat" {
		    set srcs [lassign $l opcode tgt src1]
		    set name [my LocalVarName $tgt]
		    set type [my OperandType $src1]
		    set val [my LoadOrLiteral $src1]
		    if {!refType($type)} {
			set result [$b stringify($type) $val $name]







>
>
>
>
>
>







786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
		    set name [my LocalVarName $tgt]
		    set opcode frame.args
		    append opcode ( [my ValueTypes $src] )
		    set val [my LoadOrLiteral $src]
		    set result [$b $opcode $val $theframe $name]
		    my StoreResult $tgt $result
		}
		"frameDepth" {
		    lassign $l opcode tgt
		    set name [my LocalVarName $tgt]
		    set result [$b frame.depth $theframe $name]
		    my StoreResult $tgt $result
		}
		"strcat" {
		    set srcs [lassign $l opcode tgt src1]
		    set name [my LocalVarName $tgt]
		    set type [my OperandType $src1]
		    set val [my LoadOrLiteral $src1]
		    if {!refType($type)} {
			set result [$b stringify($type) $val $name]

Changes to codegen/varframe.tcl.

18
19
20
21
22
23
24
25

26
27
28
29
30
31
32
...
124
125
126
127
128
129
130

131
132
133
134
135
136
137
...
169
170
171
172
173
174
175







176
177
178
179
180
181
182
 
oo::define Builder {
    # Variables holding implementations of Tcl's callframe handling
    variable tcl.callframe.init tcl.callframe.makevar tcl.callframe.clear
    variable tcl.callframe.store.string tcl.callframe.store.numeric
    variable tcl.callframe.load tcl.callframe.bindvar
    variable tcl.callframe.lookup.varns tcl.callframe.lookup.var
    variable tcl.callframe.lookup.upvar tcl.callframe.getarglist


    # Helper functions
    variable var.hash.getValue var.setNamespaceVar var.clearNamespaceVar
    variable tcl.read.var.ptr tcl.write.var.ptr tcl.unset.var.ptr
    variable tcl.write.var.ptr.numeric
    variable var.isTraced var.defined var.isLink var.link var.isInHash
    variable var.hash.refCount var.flag.set var.link.set var.hash.getKey
................................................................................
	    # library is deleted. And we don't do that anyway...
	    my ret
	}

	set f [$m local "tcl.callframe.getarglist" STRING?<-CALLFRAME,INT]
	params frame level
	build {

	    set interp [$api tclInterp]
	    set level0 [my cast(int) [my getInt64 $level] "level"]
	    set f0 $frame
	    my condBr [my eq $level0 $0] $found $search
	label search:
	    set lPtr [my alloc int]
	    set fPtr [my alloc CALLFRAME]
................................................................................
		Tcl_ObjPrintf [my constString "bad level \"%s\""] $levelstr]
	    $api Tcl_SetErrorCode $interp \
		[my constString TCL] [my constString LOOKUP] \
		[my constString STACK_LEVEL] $levelstr {}
	    $api Tcl_DecrRefCount $levelobj
	    my ret [my fail STRING]
	}








	##### var.followLinks #####
	#
	# Type signature: var:Var* -> Var*
	#
	# Given a particular variable, follow its chain of links (which might
	# be none at all) to get to the actual variable holding the real







|
>







 







>







 







>
>
>
>
>
>
>







18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
...
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
...
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
 
oo::define Builder {
    # Variables holding implementations of Tcl's callframe handling
    variable tcl.callframe.init tcl.callframe.makevar tcl.callframe.clear
    variable tcl.callframe.store.string tcl.callframe.store.numeric
    variable tcl.callframe.load tcl.callframe.bindvar
    variable tcl.callframe.lookup.varns tcl.callframe.lookup.var
    variable tcl.callframe.lookup.upvar
    variable tcl.callframe.getarglist tcl.callframe.depth

    # Helper functions
    variable var.hash.getValue var.setNamespaceVar var.clearNamespaceVar
    variable tcl.read.var.ptr tcl.write.var.ptr tcl.unset.var.ptr
    variable tcl.write.var.ptr.numeric
    variable var.isTraced var.defined var.isLink var.link var.isInHash
    variable var.hash.refCount var.flag.set var.link.set var.hash.getKey
................................................................................
	    # library is deleted. And we don't do that anyway...
	    my ret
	}

	set f [$m local "tcl.callframe.getarglist" STRING?<-CALLFRAME,INT]
	params frame level
	build {
	    nonnull $frame
	    set interp [$api tclInterp]
	    set level0 [my cast(int) [my getInt64 $level] "level"]
	    set f0 $frame
	    my condBr [my eq $level0 $0] $found $search
	label search:
	    set lPtr [my alloc int]
	    set fPtr [my alloc CALLFRAME]
................................................................................
		Tcl_ObjPrintf [my constString "bad level \"%s\""] $levelstr]
	    $api Tcl_SetErrorCode $interp \
		[my constString TCL] [my constString LOOKUP] \
		[my constString STACK_LEVEL] $levelstr {}
	    $api Tcl_DecrRefCount $levelobj
	    my ret [my fail STRING]
	}

	set f [$m local "tcl.callframe.depth" INT<-CALLFRAME]
	params frame
	build {
	    nonnull $frame
	    my ret [my packInt32 [my dereference $frame 0 CallFrame.level]]
	}

	##### var.followLinks #####
	#
	# Type signature: var:Var* -> Var*
	#
	# Given a particular variable, follow its chain of links (which might
	# be none at all) to get to the actual variable holding the real

Changes to quadcode/translate.tcl.

1100
1101
1102
1103
1104
1105
1106




1107
1108
1109
1110
1111
1112
1113
	    infoLevelArgs {
		set value [list temp [incr depth -1]]
		set r [list temp $depth]
		generate-arith-domain-check [lindex $insn 0] $value
		quads purify {temp opd0} $value
		error-quads frameArgs $r {temp opd0} {temp @callframe}
	    }




	    default {
		# TODO - Many more instructions
		lappend errors $sourcefile $currentline $currentscript \
		    "Bytecode instruction '[lindex $insn 0]'\
                     is not implemented."
	    }
	}







>
>
>
>







1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
	    infoLevelArgs {
		set value [list temp [incr depth -1]]
		set r [list temp $depth]
		generate-arith-domain-check [lindex $insn 0] $value
		quads purify {temp opd0} $value
		error-quads frameArgs $r {temp opd0} {temp @callframe}
	    }
	    infoLevelNumber {
		set r [list temp $depth]
		quads frameDepth $r {temp @callframe}
	    }
	    default {
		# TODO - Many more instructions
		lappend errors $sourcefile $currentline $currentscript \
		    "Bytecode instruction '[lindex $insn 0]'\
                     is not implemented."
	    }
	}

Changes to quadcode/types.tcl.

544
545
546
547
548
549
550
551

552
553
554
555
556
557
558
	lshift -
	maptoint -
	returnCode -
	rshift -
	strcmp -
	strfind -
	strlen -
	strrfind {

	    return $INT
	}
	copy {
	    return [typeOfOperand $types [lindex $q 2]]
	}
	purify {
	    return [expr {[typeOfOperand $types [lindex $q 2]] & ~$IMPURE}]







|
>







544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
	lshift -
	maptoint -
	returnCode -
	rshift -
	strcmp -
	strfind -
	strlen -
	strrfind -
	frameDepth {
	    return $INT
	}
	copy {
	    return [typeOfOperand $types [lindex $q 2]]
	}
	purify {
	    return [expr {[typeOfOperand $types [lindex $q 2]] & ~$IMPURE}]