Skip to content

Commit

Permalink
Revert "PIR cleanup and some refactoring of call_chain manipulation"
Browse files Browse the repository at this point in the history 
This reverts commit 2d301e4.
  • Loading branch information
@coke
coke committed Oct 13, 2009
1 parent 9bade3a commit b455eb2
Show file tree
Hide file tree
Showing 5 changed files with 566 additions and 581 deletions.
4 changes: 2 additions & 2 deletions runtime/builtin/info.pir
View file
Expand Up @@ -20,7 +20,6 @@
.const 'Sub' readVar = 'readVar'
.const 'Sub' options = 'info_options'
.const 'Sub' getCallDepth = 'getCallDepth'
.const 'Sub' getCallLevel = 'getCallLevel'
.const 'Sub' getLexPad = 'getLexPad'

.If(argc==0, {
Expand Down Expand Up @@ -430,8 +429,9 @@ compile:
.return($I0)
})
# argc ==1
.local pmc toInteger
.local pmc toInteger, getCallLevel
toInteger = get_root_global ['_tcl'], 'toInteger'
getCallLevel = get_root_global ['_tcl'], 'getCallLevel'

.local pmc level
level = shift argv
Expand Down
90 changes: 66 additions & 24 deletions runtime/builtin/uplevel.pir
View file
Expand Up @@ -2,42 +2,84 @@
.namespace []

.sub '&uplevel'
.param pmc argv :slurpy
.argc()
.param pmc argv :slurpy
.argc()

.const 'Sub' getCallLevel = 'getCallLevel'
.const 'Sub' getCallDepth = 'getCallDepth'
.const 'Sub' runUpLevel = 'runUpLevel'
if argc == 0 goto bad_args

if argc == 0 goto bad_args
.local pmc compileTcl, getCallLevel
compileTcl = get_root_global ['_tcl'], 'compileTcl'
getCallLevel = get_root_global ['_tcl'], 'getCallLevel'
.local int rethrow_flag

.local int call_level
call_level = getCallDepth()
# save the old call level
.local pmc call_chain
.local int call_level
call_chain = get_root_global ['_tcl'], 'call_chain'
call_level = elements call_chain

.local pmc argv0
argv0 = argv[0]
.local pmc new_call_level
new_call_level = argv[0]

.local int new_call_level, defaulted
(new_call_level,defaulted) = getCallLevel(argv0)
.local int defaulted
(new_call_level,defaulted) = getCallLevel(new_call_level)
if defaulted == 1 goto skip

.Unless(defaulted, {
# if we only have a level, then we don't have a command to run!
if argc == 1 goto bad_args
# if we only have a level, then we don't have a command to run!
if argc == 1 goto bad_args
# pop the call level argument
$P1 = shift argv

# pop the call level argument
$P1 = shift argv
})
skip:
.local int difference
$I0 = new_call_level
difference = call_level - $I0

.local string code
code = join ' ', argv
.list(saved_call_chain)
$I0 = 0
save_chain_loop:
if $I0 == difference goto save_chain_end
$P0 = pop call_chain
push saved_call_chain, $P0
inc $I0
goto save_chain_loop
save_chain_end:

.local int difference
difference = call_level - new_call_level
$S0 = join ' ', argv
# if we get an exception, we have to reset the environment
.local pmc retval
push_eh restore_and_rethrow
$P0 = compileTcl($S0)
retval = $P0()
pop_eh

.tailcall runUpLevel(difference,code)
rethrow_flag = 0
goto restore

restore_and_rethrow:
.catch()
rethrow_flag = 1
goto restore

restore:
# restore the old level
$I0 = 0
restore_chain_loop:
if $I0 == difference goto restore_chain_end
$P0 = pop saved_call_chain
push call_chain, $P0
inc $I0
goto restore_chain_loop
restore_chain_end:
if rethrow_flag goto rethrow
retval = clone retval
.return(retval)

rethrow:
.rethrow()

bad_args:
tcl_error 'wrong # args: should be "uplevel ?level? command ?arg ...?"'
die 'wrong # args: should be "uplevel ?level? command ?arg ...?"'
.end

# Local Variables:
Expand Down
189 changes: 99 additions & 90 deletions runtime/builtin/upvar.pir
View file
Expand Up @@ -2,98 +2,107 @@
.namespace []

.sub '&upvar'
.param pmc argv :slurpy
.argc()

.const 'Sub' makeVar = 'makeVar'
.const 'Sub' findVar = 'findVar'
.const 'Sub' getCallLevel = 'getCallLevel'
.const 'Sub' getCallDepth = 'getCallDepth'
.const 'Sub' getLexPad = 'getLexPad'

if argc < 2 goto bad_args

.local pmc call_chain
call_chain = get_root_global ['_tcl'], 'call_chain'

.local int call_level
call_level = getCallDepth()

.local int new_call_level, defaulted
$S0 = argv[0]
(new_call_level,defaulted) = getCallLevel($S0)
.Unless(defaulted, {
delete argv[0]
dec argc
})

$I0 = argc % 2
if $I0 == 1 goto bad_args

# for each othervar/myvar pair, created a mapping from
.int(counter,0)
.local int difference
difference = call_level - new_call_level
.While(counter < argc, {
.local string old_var, new_var
old_var = argv[counter]
inc counter
new_var = argv[counter]

.If(new_call_level, {
$P0 = findVar(new_var, 'depth'=>1)
.Unless(null $P0, {
$S0 = 'variable "'
$S0 .= new_var
$S0 .= '" already exists'
tcl_error $S0
})
})

.list(saved_call_chain)
$I0 = 0
.While($I0 != difference, {
$P0 = pop call_chain
push saved_call_chain, $P0
inc $I0
})

$P1 = makeVar(old_var, 'depth'=>1)

# restore the old level
$I0 = 0
.While($I0 != difference, {
$P0 = pop saved_call_chain
push call_chain, $P0
inc $I0
})

# because we don't want to use assign here (we want to provide a new
# alias, not use an existing one), do this work by hand

.IfElse(call_level, {
.local pmc lexpad
lexpad = getLexPad(-1)
$S0 = '$' . new_var
lexpad[$S0] = $P1
inc counter
},{
.local pmc ns
.local string name
ns = splitNamespace(new_var, 1)
name = pop ns
name = '$' . name

unshift ns, 'tcl'
ns = get_root_namespace ns
ns[name] = $P1
inc counter
})
})
.return('')
.param pmc argv :slurpy
.argc()

.const 'Sub' makeVar = 'makeVar'
.const 'Sub' findVar = 'findVar'

if argc < 2 goto bad_args

.local pmc getCallLevel, call_chain
getCallLevel = get_root_global ['_tcl'], 'getCallLevel'
call_chain = get_root_global ['_tcl'], 'call_chain'
.const 'Sub' getCallDepth = 'getCallDepth'

.local int call_level
call_level = getCallDepth()

.local int new_call_level, defaulted
$P0 = argv[0]
(new_call_level,defaulted) = getCallLevel($P0)
if defaulted == 1 goto skip
$P1 = shift argv
dec argc

skip:
$I0 = argc % 2
if $I0 == 1 goto bad_args

# for each othervar/myvar pair, created a mapping from
.argc()
.local int counter
counter = 0
.local int difference
difference = call_level - new_call_level
loop:
if counter >= argc goto done

.local string old_var, new_var
old_var = argv[counter]
inc counter
new_var = argv[counter]

if new_call_level == 0 goto store_var
$P0 = findVar(new_var, 'depth'=>1)
if null $P0 goto store_var
$S0 = 'variable "'
$S0 .= new_var
$S0 .= '" already exists'
die $S0

store_var:
.list(saved_call_chain)
$I0 = 0
save_chain_loop:
if $I0 == difference goto save_chain_end
$P0 = pop call_chain
push saved_call_chain, $P0
inc $I0
goto save_chain_loop
save_chain_end:

$P1 = makeVar(old_var, 'depth'=>1)

# restore the old level
$I0 = 0
restore_chain_loop:
if $I0 == difference goto restore_chain_end
$P0 = pop saved_call_chain
push call_chain, $P0
inc $I0
goto restore_chain_loop
restore_chain_end:

# because we don't want to use assign here (we want to provide a new
# alias, not use an existing one), do this work by hand

if call_level goto lexical

.local pmc ns
.local string name
ns = splitNamespace(new_var, 1)
name = pop ns
name = '$' . name

unshift ns, 'tcl'
ns = get_root_namespace ns
ns[name] = $P1
inc counter
goto loop

lexical:
$P0 = call_chain[-1]
$S0 = '$' . new_var
$P0[$S0] = $P1
inc counter
goto loop

done:
.return('')

bad_args:
tcl_error 'wrong # args: should be "upvar ?level? otherVar localVar ?otherVar localVar ...?"'
die 'wrong # args: should be "upvar ?level? otherVar localVar ?otherVar localVar ...?"'
.end


Expand Down

0 comments on commit b455eb2

Please sign in to comment.