tclquadcode
Check-in [305328fa6b]
Login
HomeTimelineBranchesTagsTicketsWiki

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

Overview
Comment:Add the final processing in 'varargs' - next, emit the error path.
Timelines: family | ancestors | descendants | both | notworking | kbk-refactor-callframe
Files: files | file ages | folders
SHA3-256: 305328fa6bb6552669d4f1e16a2f25d4abefe19f4bd35294bed43ff72ef21cb4
User & Date: kbk 2019-01-18 04:22:27.386
Context
2019-01-21
18:14
Enough changes to get through first two 'expandtest' tests check-in: 5557b1e592 user: kbk tags: notworking, kbk-refactor-callframe
2019-01-18
04:22
Add the final processing in 'varargs' - next, emit the error path. check-in: 305328fa6b user: kbk tags: notworking, kbk-refactor-callframe
2019-01-16
02:30
More argument preparation code in 'varargs' check-in: 76b943ad4a user: kbk tags: notworking, kbk-refactor-callframe
Changes
Unified Diff Ignore Whitespace Patch
Changes to quadcode/bb.tcl.
︙︙
337
338
339
340
341
342
343
344
345
346
347
348
349
350

351

352
353
354
355
356
357
358

    #
    # Parameters:
    #	to - Successor of the new block
    #
    # Results:
    #	Returns the new block's block number

    method makeEmptyBB {to} {
	# Create the block
	set newb [llength $bbcontent]
	lappend bbcontent [list [list jump [list bb $to]]]
	lappend bbpred {}

	# Link $to to the new block

	my bblink $newb $to


	return $newb
    }

    # bbcopy --
    #
    #	Makes a copy of a basic block








|






>
|
>








337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360

    #
    # Parameters:
    #	to - Successor of the new block
    #
    # Results:
    #	Returns the new block's block number

    method makeEmptyBB {{to -1}} {
	# Create the block
	set newb [llength $bbcontent]
	lappend bbcontent [list [list jump [list bb $to]]]
	lappend bbpred {}

	# Link $to to the new block
	if {$to >= 0} {
	    my bblink $newb $to
	}

	return $newb
    }

    # bbcopy --
    #
    #	Makes a copy of a basic block
︙︙
Changes to quadcode/builder.tcl.
︙︙
50
51
52
53
54
55
56













































57
58
59
60
61
62
63

oo::define quadcode::builder constructor {xfmr_ b_ bb_} {
    set xfmr $xfmr_
    set b $b_
    set bb $bb_
    set bbindex {}
    set varindex {}
}














































# quadcode::builder method maketemp --
#
#	Makes a temporary variable.
#
# Parameters:
#	name - Base name for the temporary.








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








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

oo::define quadcode::builder constructor {xfmr_ b_ bb_} {
    set xfmr $xfmr_
    set b $b_
    set bb $bb_
    set bbindex {}
    set varindex {}
}

# quadcode::builder method makeblock --
#
#	Makes a new basic block
#
# Parameters:
#	name - Name to give to the block
#
# Results:
#	Returns the basic block number
#
# Side effects:
#	Creates the block. Stores the block index in 'bbindex' if name is
#	supplied

oo::define quadcode::builder method makeblock {{name {}}} {

    # Create the block
    set b [$xfmr makeEmptyBB]

    # Index the block
    if {$name ne {}} {
        dict set bbindex $name $b
    }

    return $b
}

# quadcode::builder method getblock --
#
#	Finds a basic block created by 'makeblock'
#
# Parameters:
#	name - Name of the block
#
# Results:
#	Returns the basic block number, or -1 if there is no such block

oo::define quadcode::builder method getblock {name} {
    if {![dict exists $bbindex $name]} {
        return -1
    } else {
        return [dict get $bbindex $name]
    }
}

# quadcode::builder method maketemp --
#
#	Makes a temporary variable.
#
# Parameters:
#	name - Base name for the temporary.
︙︙
Changes to quadcode/varargs.tcl.
︙︙
113
114
115
116
117
118
119
120
121
122
123
124
125





126





127




























128
129
130
131
132
133
134
135
136

    }

    # We are going to be doing major surgery on the basic block.
    # Remove the 'invokeExpanded' and all following instructions
    # from the block. Unlink the block from its successors, and
    # remove ud- and du-chaining for the removed instructions.
    set bb [my va_UnlinkTail $b $pc]
    set B [quadcode::builder new [self] $b $bb]

    # Prepare parameters for the 'invoke' (or 'invokeExpanded') call, and
    # add the call to the instruction sequence under construction.
    my va_PrepareArgs $B $b $pc $q $arginfo
 





    error "NOT FINISHED - rewriting invoke instruction"


































    $B destroy
    $call destroy
    return
}

# quadcode::transformer method va_GetArgInfo --
#
#	Determines the target of an invocation and performs [info args] on
#	that target to get its argument list.








|



|

>
>
>
>
>
|
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

|








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

    }

    # We are going to be doing major surgery on the basic block.
    # Remove the 'invokeExpanded' and all following instructions
    # from the block. Unlink the block from its successors, and
    # remove ud- and du-chaining for the removed instructions.
    set bb [my va_UnlinkTail $b $pc]
    set B [quadcode::builder new [self] $b [lindex $bbcontent $b]]

    # Prepare parameters for the 'invoke' (or 'invokeExpanded') call, and
    # add the call to the instruction sequence under construction.
    set newq [my va_PrepareArgs $B $b $pc $q $arginfo]
 
    # Emit the call
    $B emit $newq
    my debug-varargs {
        $B log-last
    }

    # Check that the return value from the invoke is linked correctly, and
    # bring in the 'retrieveResult'
    set q1 [lindex $bb 0]
    my debug-varargs {
        puts "varargs: result retrieval: $q1"
    }
    if {[lindex $q1 0] ne "retrieveResult" || [lindex $q1 2] ne [lindex $q 1]} {
        error "mislinked invoke: should be followed with 'retrieveResult'"
    }
    set result [lindex $q1 1]
    $B emit [list retrieveResult [$B maketemp "result"] [lindex $q1 1]]
    my debug-varargs {
        $B log-last
    }

    # Check that the extractCallFrame is linked correctly, and bring in
    # the 'extractCallFrame'
    set q2 [lindex $bb 1]
    my debug-varargs {
        puts "varargs: callframe extraction: $q1"
    }
    if {[lindex $q2 0] ne "extractCallFrame"
        || [lindex $q2 2] ne [lindex $q 1]} {
        error "mislinked invole: should be followed with 'extractCallFrame'"
    }
    set cf [lindex $q2 1]
    $B emit [list extractCallFrame [$B maketemp "callframe"] [lindex $q2 1]]
    my debug-varargs {
        $B log-last
    }

    set cfin [lindex $q 1]
    my va_ConvergeErrorPath $B $result $cf $cfin [lreplace $bb[set bb ""] 0 1]

    $B destroy

    return
}

# quadcode::transformer method va_GetArgInfo --
#
#	Determines the target of an invocation and performs [info args] on
#	that target to get its argument list.
︙︙
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

#	B - quadcode::builder where the new invocation sequence is being built.
#	b - Basic block where the original 'invoke' instruction resided
#	pc - Program counter within the basic block
#	q - 'invoke' or 'invokeExpanded' instruction.
#	arginfo - Arguments expected by the invoked command
#
# Results:










#	None.
#
# The command name being invoked, and the expected arguments, ar always known
# at this point.

oo::define quadcode::transformer method va_PrepareArgs {B b pc q arginfo} {
    
    set argl [lassign $q opcode result cfin cmd]

    # Create the first part of the 'invoke' instruction.
    
    set iresult [my newVarInstance $result]
    set newq [list invoke $result $cfin $cmd]

    # Find out how many plain parameters (that is, not 'args') the
    # called command has.
    set nPlainParams [llength $arginfo]
    set haveargs 0
    if {[lindex $arginfo end] eq "args"} {
        set haveargs 1








>
>
>
>
>
>
>
>
>
>
|

|









|








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

#	B - quadcode::builder where the new invocation sequence is being built.
#	b - Basic block where the original 'invoke' instruction resided
#	pc - Program counter within the basic block
#	q - 'invoke' or 'invokeExpanded' instruction.
#	arginfo - Arguments expected by the invoked command
#
# Results:
#	Returns the rewritten 'invoke' instruction
#
# Side effects:
#	Emits code so that the args off the rewritten instruction are
#	known to be available. May emit error handling code, qin which
#	case the following locations will be known to $B:
#		block 'error' - The block to which control transfers on
#	                        an error
#		value 'error' - The FAIL value that is used to report an error
#	The callframe on error is always the callframe input to the 'invoke'
#	instruction.
#
# The command name being invoked, and the expected arguments, are always known
# at this point.

oo::define quadcode::transformer method va_PrepareArgs {B b pc q arginfo} {
    
    set argl [lassign $q opcode result cfin cmd]

    # Create the first part of the 'invoke' instruction.
    
    set iresult [my newVarInstance $result]
    set newq [list invoke $iresult $cfin $cmd]

    # Find out how many plain parameters (that is, not 'args') the
    # called command has.
    set nPlainParams [llength $arginfo]
    set haveargs 0
    if {[lindex $arginfo end] eq "args"} {
        set haveargs 1
︙︙
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

    if {$haveargs} {
        my va_DoArgs $B newq $j
    } else {
        error  "NOT DONE - varargs needs to check for excess args"
        my va_CheckTooMany b bb $lenLoc $compTemp $j $notokb
    }

    error "NOT DONE - varargs needs to emit call:\n    $newq"
}


if 0 {



    # Create the normal invocation sequence.
    # 1. Create moveToCallFrame

    set cfin [$call cfin]
    set invars [$call invars]
    if {[$call pc0] < $pc} {
        set cf2 [my newVarInstance $cfin]
        set q2 [list moveToCallFrame $cf2 $cfin]
        dict for {vname val} $invars {
            lappend q2 [list literal $vname] $val
        }
        my va_EmitAndTrack $b bb $q2
        set cfin $cf2
        lset newq 2 $cfin
    }
    
    # 2. Emit the call as rewritten
    my va_EmitAndTrack $b bb $newq

    # 3. Make the 'retrieveResult'
    set okresult [my newVarInstance [$call retval]]
    my va_EmitAndTrack $b bb [list retrieveResult $okresult $invokeres]
    dict set normphis [$call retval] [list bb $norm0b] $okresult
    dict set errorphis [$call retval] [list bb $err0b] $okresult

    # 4. Make the 'extractCallFrame'
    set okcf [my newVarInstance [$call cfout]]
    my va_EmitAndTrack $b bb [list extractCallFrame $okcf $invokeres]
    dict set normphis [$call cfout] [list bb $norm0b] $okcf
    dict set errorphis [$call cfout] [list bb $err0b] $okcf

    # 5. Make 'moveFromCallFrame' for all output values
    dict for {vname outval} [$call outvars] {
        set okval [my newVarInstance $outval]
        my va_EmitAndTrack $b bb \
            [list moveFromCallFrame $okval $okcf [list literal $vname]]
        dict set normphis $outval [list bb $norm0b] $okval
        dict set errorphis $outval [list bb $err0b] $okval
        set notokval [dict get [$call invars] $vname]
        dict set normphis $outval [list bb $norm1b] $notokval
        dict set errorphis $outval [list bb $err1b] $notokval
    }        

    # 6. Make the terminal jumps
    my va_EmitAndTrack $b bb [list jumpMaybe [list bb $err0b] $okresult]
    my va_EmitAndTrack $b bb [list jump [list bb $norm0b]]

q    # Emit the final basic block rewrite

    lset bbcontent $b $bb

    # toRepair will have the variables that have to be fixed up by
    # repairSSAVariable after this stuff runs
    set toRepair {}

    # Make the block for the normal exit
    set normbb {}
    foreach {v sources} $normphis {
        set val 0
        if {[dict exists $toRepair $v $normb]} {
            set val [dict get $toRepair $v $normb]
        }
        incr val
        dict set toRepair $v $normb $val
        my va_EmitAndTrack $normb normbb [list phi $v {*}$sources]
    }
    my va_EmitAndTrack $normb normbb [list jump [list bb [$call normexit]]]
    lset bbcontent $normb $normbb

    # Make the block for the error exit
    set errorbb {}
    foreach {v sources} $errorphis {
        set val 0
        if {[dict exists $toRepair $v $errorb]} {
            set val [dict get $toRepair $v $errorb]
        }
        incr val
        dict set toRepair $v $errorb $val
        my va_EmitAndTrack $errorb errorbb [list phi $v {*}$sources]
    }
    my va_EmitAndTrack $errorb errorbb [list jump [list bb [$call errexit]]]
    lset bbcontent $errorb $errorbb

    # Restore dominance relationships
    my bbidom; my bblevel

    my debug-varargs {
        puts "Before repairing SSA relationships:"
        my dump-bb
    }

    # Repair variable relationships that have been damaged
    dict for {v defs} $toRepair {
        my debug-varargs {
            puts "Replace $v with reaching definitions $defs"
        }
        my repairSSAVariable $v $defs
        my debug-varargs {
            puts "Replaced $v"
        }
    }

    my debug-varargs {
        puts "After repairing SSA relationships:"
        my dump-bb
    }
    
    $call destroy

    return
}

# quadcode::transformer method va_UnlinkTail --
#
#	Removes the invocation sequence from a basic block in preparation
#	for rewriting it.
#








<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|








338
339
340
341
342
343
344





















































































































345
346
347
348
349
350
351
352

    if {$haveargs} {
        my va_DoArgs $B newq $j
    } else {
        error  "NOT DONE - varargs needs to check for excess args"
        my va_CheckTooMany b bb $lenLoc $compTemp $j $notokb
    }






















































































































    return $newq
}

# quadcode::transformer method va_UnlinkTail --
#
#	Removes the invocation sequence from a basic block in preparation
#	for rewriting it.
#
︙︙
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

#	Variable defs and uses in the invocation sequence are removed
#	from ud- and du-chains. The basic block is unlinked from its
#	successors. 

oo::define quadcode::transformer method va_UnlinkTail {b pc} {

    set bb [lindex $bbcontent $b]

    my debug-varargs {
        puts "varargs: Split basic block $b:"
        puts "   $b:$pc: [lindex $bb $pc]"
    }

    set tail [lrange $bb $pc end]
    set bb [lreplace $bb[set bb {}] $pc end]

    foreach q $tail {
        if {[lindex $q 1 0] in {"temp" "var"}} {
            dict unset udchain [lindex $q 1]
        }
        foreach arg [lrange $q 2 end] {
            if {[lindex $arg 0] in {"temp" "var"}} {
                my removeUse $arg $b
            }
        }
    }
    foreach b2 [my bbsucc $b] {
        my removePred $b2 $b
    }
    return $bb
}

# quadcode::transformer method va_NonExpandedArgument --
#
#	Transfer a leading non-expanded argument into a quad
#	under construction when rewriting 'invokeExpanded'
#








>





|

>













|








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

#	Variable defs and uses in the invocation sequence are removed
#	from ud- and du-chains. The basic block is unlinked from its
#	successors. 

oo::define quadcode::transformer method va_UnlinkTail {b pc} {

    set bb [lindex $bbcontent $b]
    lset bbcontent $b {}
    my debug-varargs {
        puts "varargs: Split basic block $b:"
        puts "   $b:$pc: [lindex $bb $pc]"
    }

    set tail [lrange $bb $pc+1 end]
    set bb [lreplace $bb[set bb {}] $pc end]
    lset bbcontent $b $bb
    foreach q $tail {
        if {[lindex $q 1 0] in {"temp" "var"}} {
            dict unset udchain [lindex $q 1]
        }
        foreach arg [lrange $q 2 end] {
            if {[lindex $arg 0] in {"temp" "var"}} {
                my removeUse $arg $b
            }
        }
    }
    foreach b2 [my bbsucc $b] {
        my removePred $b2 $b
    }
    return $tail
}

# quadcode::transformer method va_NonExpandedArgument --
#
#	Transfer a leading non-expanded argument into a quad
#	under construction when rewriting 'invokeExpanded'
#
︙︙
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090



1091
1092
1093
1094
1095
1096
1097
1098
1099

1100
1101
1102
1103
1104
1105

1106

1107

1108
1109

1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120


1121
1122
1123
1124
1125


1126
1127
1128
1129
1130
1131
1132
1133
1134

    lappend burst $q
    set q [list extractFail $result $intres]
    lappend burst $q
    return $burst

}

# quadcode::transformer method va_EmitAndTrack --
#
#	Emits a quadcode instruction and tracks its effects
#
# Parameters:
#	b - Basic block number
#	bbVar - Variable containing the basic block content
#	q - Quadcode instruction to emit



#
# Results:
#	None.
#
# Side effects:
#	Instruction is added to the basic block, and linked in ud- and du-chains
#	Basic block is linked in control flow if needed.

oo::define quadcode::transformer method va_EmitAndTrack {b bbVar q} {


    upvar 1 $bbVar bb

    set res [lindex $q 1]
    switch -exact -- [lindex $res 0] {
        "bb" {

            my bblink $b [lindex $res 1]

        }

        "temp" - "var" {
            dict set udchain $res $b

        }
    }

    foreach arg [lrange $q 2 end] {
        switch -exact -- [lindex $arg 0] {
            "temp" - "var" {
                my addUse $arg $b
            }
        }
    }



    my debug-varargs {
        puts "--> $b:[llength $bb]: $q"
    }
    lappend bb $q



}

# Local Variables:
# mode: tcl
# fill-column: 78
# auto-fill-function: nil
# buffer-file-coding-system: utf-8-unix
# indent-tabs-mode: nil
# End:








|

|


|
|
|
>
>
>





|
<

|
>

|
|
|
<
|
>
|
>

>
|
<
>

|
|
<
<
<
<
|
|
|
|
>
>
|
|
|
<
|
>
>










1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032

1033
1034
1035
1036
1037
1038
1039

1040
1041
1042
1043
1044
1045
1046

1047
1048
1049
1050




1051
1052
1053
1054
1055
1056
1057
1058
1059

1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071

    lappend burst $q
    set q [list extractFail $result $intres]
    lappend burst $q
    return $burst

}

# oo::transformer method va_ConvergeErrorPath --
#
#	Converges the code for the error and normal paths after an 'invoke'.
#
# Parameters:
#	B - Builder that is emitting code
#	result - Quadcode variable that will hold the result
#	cf - Quadcode variable that will hold the callframe
#	cfin - Callframe on input to the 'invoke'
#	bb - Remainder of the basic block following 'invoke', 'retrieveResult'
#	     and 'extractCallFrame'.
#
# Results:
#	None.
#
# Side effects:
#	Emits all the remaining code.


oo::define quadcode::transformer method va_ConvergeErrorPath {B result
                                                              cf cfin bb} {

    set errorb [$B getblock "error"]
    set normresult [$B gettemp "result"]
    set normcf [$B gettemp "callframe"]

    if {$errorb <  00} {
        $B emit [list copy $cf $normcf]
        my debug-varargs {
            $B log-last
        }
        $B emit [list copy $result $normresult]
        my debug-varargs {

            $B log-last
        }
    } else {
        error "Need to emit convergence from error handling at block $errorb"




        
    }

    # Put back the instructions that followed the 'invoke'
    foreach q $bb {
        $B emit $q
        my debug-varargs {
            $B log-last
        }

    }
    
    return
}

# Local Variables:
# mode: tcl
# fill-column: 78
# auto-fill-function: nil
# buffer-file-coding-system: utf-8-unix
# indent-tabs-mode: nil
# End:
Powered by Fossil · RSS