Author: leo
Date: Tue Oct 11 03:33:55 2005
New Revision: 9444
Modified:
trunk/DEPRECATED
trunk/docs/compiler_faq.pod
trunk/imcc/t/syn/pcc.t
Log:
Update compiler_faq and pcc tests
* new sections WRT subroutine objects
* document :slurpy, :flat, and :optional
* adjust line length
* cleanup imcc/t/syn/pcc.t
* remove a lot of misleading old examples
* reorder and simplify the rest
* change to newer syntax
Modified: trunk/DEPRECATED
==============================================================================
--- trunk/DEPRECATED (original)
+++ trunk/DEPRECATED Tue Oct 11 03:33:55 2005
@@ -9,6 +9,7 @@ Sub object is lacking necessary meta inf
MMD-info, and more.
Use: find_name, find_global, or Sub constants instead.
+See F<docs/compiler_faq.pod> for detailed examples.
=item Register stack opcodes
@@ -61,7 +62,7 @@ a syntax error. For example:
Will have to be:
print $S0
- substr $P0, 1, 2, "x"
+ substr $P0, 1, 2, "x"
Modified: trunk/docs/compiler_faq.pod
==============================================================================
--- trunk/docs/compiler_faq.pod (original)
+++ trunk/docs/compiler_faq.pod Tue Oct 11 03:33:55 2005
@@ -20,21 +20,21 @@ Parrot.
=head2 How can I implement a compiler to use as a compiler object from within
Parrot? (For example, with the C<compile> op.)
-Define a sub that takes as input a string, and returns something invokable. The
-easiest way to create something invokable at the moment is to use the builtin
-C<PIR> or C<PASM> compilers.
+Define a sub that takes as input a string, and returns something
+invokable. The easiest way to create something invokable at the moment
+is to use the builtin C<PIR> or C<PASM> compilers.
See C<languages/tcl/tcl.pir_template>'s C<.sub _tcl_compile> as an example.
=head2 How do I embed source locations in my code for debugging?
-You can do this using either the C<setfile> and C<setline> opcodes or with
-C-like C<#line> comments:
+You can do this using either the C<setfile> and C<setline> opcodes or
+with C-like C<#line> comments:
#line 27 "my_source.file"
-Simply set the source file name or line number whenever it changes. But note
-that currently (Parrot 0.2.x) both are ignored in the lexer.
+Simply set the source file name or line number whenever it changes.
+But note that currently (Parrot 0.3.0) both are ignored in the lexer.
=head1 Subroutines
@@ -44,8 +44,9 @@ If you have a fixed-length parameter lis
$P0( $P1, $P2, $P3 )
-where $P0 is the function object, and $P1, $P2, and $P3 are its parameters. You
-can also use a function's label in place of the object:
+where $P0 is the function object, and $P1, $P2, and $P3 are its
+parameters. You can also use a function's label in place of the
+object:
somefunctionlabel( $P1, $P2, $P3 )
@@ -53,9 +54,13 @@ You can also get return value(s):
($P1,$P2) = $P0( $P1, $P2, $P3 )
+If the function name might collide with a Parrot opcode, quote it:
+
+ i = "new"(42)
+
=head2 How do I generate a method call in PIR?
-Similar to function calls, just append C<.> and the method:
+Similar to function calls, just append C<.> to the object and the method:
ret_val = some_obj."some_meth"(arg)
@@ -65,6 +70,59 @@ The method name may also be a string var
m = "bold"
curses_obj.m()
+=head2 How do I locate or create a subroutine object
+
+There are several ways to achieve this, depending on the location of
+the subroutine.
+
+If the sub is in the same compilation unit use a Sub constant:
+
+ .const .Sub foo = "foo"
+
+If the PIR compiler finds a "foo" function during compiling a file,
+then the syntax:
+
+ foo()
+
+gets translated to above constant declaration.
+
+A more dynamic way is:
+
+ .local pmc foo
+ foo = find_name "foo"
+
+This searches for a subroutine "foo" in the current lexical pad, in
+the current namespace, in the global, and in the builtin namespace in
+that order. This opcode is generated, if I<foo()> is used, but the
+compiler can't figure out, where the function is.
+
+If the subroutine is in a different namespace, use the C<find_global>
+opcode:
+
+ foo = find_global "Foo", "foo"
+
+This searches the sub "foo" in the "Foo" namespace.
+
+=head2 How do I create a Closure or Coroutine
+
+Both carry dynamic state, therefore you use one of the above ways to
+locate the sub object, then you just clone it to get a distinct copy
+of it:
+
+ .local pmc coro
+ coro = find_name "my_coro"
+ coro = clone coro
+
+Any subroutine that contains a C<.yield> directive is automatically
+created as a Coroutine PMC:
+
+ .sub my_coro # automagically a Coroutine PMC
+ ...
+ .yield (result)
+ ...
+ .end
+
+
=head2 How do I generate a tail call in PIR?
.sub foo
@@ -80,51 +138,56 @@ The sub C<bar> will return to the caller
=head2 How do I generate a sub call with a variable-length parameter list in
PIR?
-Use unprototyped calls and functions and pass as many arguments as you have. If
-you have a variable amounts of arguments in an array, you can pass all items of
-that array with the C<.flatten_arg> directive.
+If you have a variable amounts of arguments in an array, you can
+pass all items of that array with the C<:flat> directive.
- ar = new PerlArray
+ ar = new .ResitablePMCArray
push ar, "arg 1\n"
push ar, "arg 2\n"
- .pcc_begin non_prototyped
- .flatten_arg ar
- .pcc_call sub
+ ...
+ foo(ar :flat)
...
=head2 How to I retrieve the contents of a variable-length parameter list
being passed to me?
-You can check the passed PMC parameter count in the subroutine with the argcP
-variable (an alias to I3). Remember, the first eleven PMC parameters are passed
-in P5 through P15, with overflow parameters an array-like PMC in P3.
+Use a slurpy array:
-A simpler way is to use the C<foldup> opcode, which creates an array of all
-passed PMC arguments.
-
- .sub _mysub non_prototyped
- .local pmc argv
+ .sub mysub
+ .param pmc argv :slurpy
.local int argc
- argv = foldup
argc = argv
...
-If you have a few fixed parameters too, you can use a variant of C<foldup> to
-capture variable arguments from that position on.
+If you have a few fixed parameters too, you can use a slurpy array
+to get the rest of the arguments
- .sub _mysub non_prototyped
+ .sub mysub
.param pmc arg0
.param pmc arg1
- .local pmc varargs
+ .param pmc varargs :slurpy
.local int num_varargs
- varargs = foldup, 2
num_varargs = varargs
...
+=head2 How do I pass optional arguments
+
+Use the C<:optional> and C<:opt_flag> pragmas:
+
+ .sub foo
+ .param pmc arg1 :optional
+ .param int has_arg1 :opt_flag
+ .param pmc arg2 :optional
+ .param int has_arg2 :opt_flag
+
+ if has_arg1 goto got_arg1
+ ...
+
=head2 How do I create nested subroutines?
-PIR doesn't support nested subroutines. You have to emit subroutines one by
-one. If lexicals of the outer subroutine are visible inside the nested sub, you
-have to include the outer pad depth in C<new_pad> opcodes.
+PIR doesn't support nested subroutines. You have to emit subroutines
+one by one. If lexicals of the outer subroutine are visible inside the
+nested sub, you have to include the outer pad depth in C<new_pad>
+opcodes.
=head1 Variables
@@ -143,8 +206,8 @@ or the C<find_global> op:
You can retrieve the namespace hash and use the C<delete> opcode. Nested
namespace names have a NULL char prepended to their name.
- .sub main @MAIN
- $P0 = new Integer
+ .sub main :main
+ $P0 = new .Integer
store_global "foo", $P0
store_global "Bar", "baz", $P0
# ...
@@ -246,7 +309,7 @@ You can C<peek_pad> the current pad and
.sub main @MAIN
new_pad 0
- $P0 = new Integer
+ $P0 = new .Integer
store_lex -1, "foo", $P0
.local pmc pad
pad = peek_pad
@@ -313,7 +376,7 @@ keyword appended to the function declara
.namespace [ "Animal" ]
.sub __init method
- $P0 = new Integer
+ $P0 = new .Integer
setattribute self, "legs", $P0
...
.end
@@ -344,19 +407,19 @@ or
=head2 When should I use properties vs. attributes?
-Properties aren't inherited. If you have some additional data that don't fit
-into the classes hierarchy, you could use properties.
+Properties aren't inherited. If you have some additional data that
+don't fit into the classes hierarchy, you could use properties.
=head2 How do I create a class that is a subclass of another class?
-You first have to get the class PMC of the class you want to subclass. Either
-you use the PMC returned by the C<newclass> op if you created the class, or use
-the C<getclass> op:
+You first have to get the class PMC of the class you want to subclass.
+Either you use the PMC returned by the C<newclass> op if you created
+the class, or use the C<getclass> op:
getclass $P0, "Animal"
-Then you can use the C<subclass> op to create a new class that is a subclass of
-this class:
+Then you can use the C<subclass> op to create a new class that is a
+subclass of this class:
subclass $P1, $P0, "Dog"
@@ -364,14 +427,15 @@ This stores the newly created class PMC
=head2 How do I create a class that has more than one parent class?
-First, create a class without a parent class using C<newclass> (or with only
-one subclass, see previous question). Then add the other parent classes to it.
-Please refer to the next question for an example.
+First, create a class without a parent class using C<newclass> (or
+with only one subclass, see previous question). Then add the other
+parent classes to it. Please refer to the next question for an
+example.
=head2 How do I add another parent class to my class?
-If you have a class PMC (created with C<newclass> or by C<subclass>), you can
-add more parent classes to it with the C<addparent> op:
+If you have a class PMC (created with C<newclass> or by C<subclass>),
+you can add more parent classes to it with the C<addparent> op:
getclass $P1, "Dog"
subclass $P2, $P1, "SmallDog"
@@ -390,11 +454,11 @@ Just define a method named C<__init> in
.sub __init method
# ...
-Or you can specify the constructor method by setting the BUILD property of the
-class PMC:
+Or you can specify the constructor method by setting the BUILD
+property of the class PMC:
newclass $P0, "Dog" # create a class named Dog
- new $P1, .PerlString # create a string
+ new $P1, .String # create a string
set $P1, "initialise" # set it to the name of the constructor method
setprop $P0, "BUILD", $P1 # set the BUILD property
@@ -416,9 +480,9 @@ During the C<new> opcode the constructor
=head2 How can I pass arguments to an constructor?
-You can pass only a single argument to a constructor. By convention, a hash
-PMC is passed to the constructor that contains the arguments as key/value
-pairs:
+You can pass only a single argument to a constructor. By convention,
+a hash PMC is passed to the constructor that contains the arguments as
+key/value pairs:
new $P0, .Hash
set $P0["greeting"], "hello"
@@ -438,14 +502,14 @@ pairs:
Create an Exception object and throw it!
- $P0 = new Exception
+ $P0 = new .Exception
throw $P0
Not too hard, is it?
=head2 How do I throw an exception with an error message in PIR?
- $P0 = new Exception
+ $P0 = new .Exception
$P0["_message"] = "something happened"
throw $P0
@@ -454,7 +518,7 @@ Not too hard, is it?
Use C<push_eh> to push an exception handler onto the stack.
push_eh handler
- $P0 = new Exception # or any other code ...
+ $P0 = new .Exception # or any other code ...
throw $P0 # ... that might throw
clear_eh
exit 0
@@ -468,7 +532,7 @@ Use C<push_eh> to push an exception hand
P5 is the register used for the Exception object.
push_eh handler
- $P0 = new Exception
+ $P0 = new .Exception
$P0["_message"] = "something happened"
throw $P0
clear_eh
@@ -497,15 +561,8 @@ Create a new C<Env> PMC and access it li
.local pmc interp, cfg
interp = getinterp
cfg = interp[.IGLOBALS_CONFIG_HASH]
- $S0 = cfg['VERSION'] "0.2.2"
+ $S0 = cfg['VERSION'] "0.3.0"
See F<config_lib.pasm> for all the keys in the config hash - or iterate over
the config hash.
-=head1 VERSION
-
-=over 4
-
-=item Revision 0.5 - 2005.08.03
-
-=back
Modified: trunk/imcc/t/syn/pcc.t
==============================================================================
--- trunk/imcc/t/syn/pcc.t (original)
+++ trunk/imcc/t/syn/pcc.t Tue Oct 11 03:33:55 2005
@@ -3,22 +3,23 @@
# $Id$
use strict;
-use Parrot::Test tests => 45;
+use Parrot::Test tests => 23;
##############################
# Parrot Calling Conventions
-pir_output_is(<<'CODE', <<'OUT', "basic syntax - invokecc, constants");
-.sub test @MAIN
- .local Sub sub
- newsub sub, .Sub, _sub
+pir_output_is(<<'CODE', <<'OUT', "low-level syntax");
+.sub test :main
+ .const .Sub sub = "_sub"
.const int y = 20
.pcc_begin
.arg 10
.arg y
.pcc_call sub
- ret:
+ .local string z
+ .result z
.pcc_end
+ print z
end
.end
.pcc_sub _sub
@@ -28,296 +29,117 @@ pir_output_is(<<'CODE', <<'OUT', "basic
print "\n"
print b
print "\n"
- end
+ .return ("ok\n")
.end
CODE
10
20
+ok
OUT
-pir_output_is(<<'CODE', <<'OUT', "constants, bug 24667");
-.sub _main
- .local Sub sub
- newsub sub, .Sub, _sub
- .pcc_begin
- .arg 5
- .arg 6
- .arg 7
- .pcc_call sub
- .pcc_end
+pir_output_is(<<'CODE', <<'OUT', "func() syntax");
+.sub test :main
+ .const int y = 20
+ .local string z
+ z = _sub(10, y)
+ print z
end
.end
-.sub _sub
+.pcc_sub _sub
.param int a
.param int b
- .param int c
print a
print "\n"
print b
print "\n"
- print c
- print "\n"
- end
-.end
-CODE
-5
-6
-7
-OUT
-
-pir_output_is(<<'CODE', <<'OUT', "basic syntax - order of return values");
-.sub test @MAIN
- .local Sub sub
- newsub sub, .Sub, _sub
- .pcc_begin
- .pcc_call sub
- ret:
- .local int A
- .local int B
- .local int C
- .result A
- .result B
- .result C
- .pcc_end
- print A
- print "\n"
- print B
- print "\n"
- print C
- print "\n"
- end
-.end
-.pcc_sub _sub
- .pcc_begin_return
- .return 10
- .return 20
- .return 30
- .pcc_end_return
- end
+ .return ("ok\n")
.end
CODE
10
20
-30
+ok
OUT
-##############################
-# tail recursion - caller saves - parrot calling convention
-pir_output_is(<<'CODE', <<'OUT', "tail recursive sub");
-.sub test @MAIN
- .local int count
- count = 5
- .local int product
- product = 1
- .local Sub sub
- .local RetContinuation cc
- newsub sub, .Sub, _fact
- newsub cc, .RetContinuation, ret
- .pcc_begin
- .arg product
- .arg count
- .pcc_call sub, cc
- ret:
- .local int result
- .result result
- .pcc_end
- print result
- print "\n"
- end
+
+pir_output_is(<<'CODE', <<'OUT', "quoted sub names");
+.sub main :main
+ "foo"()
+ print "ok\n"
.end
-.pcc_sub _fact
- .param int product
- .param int count
- if count <= 1 goto fin
- product = product * count
- dec count
- product = _fact(product, count)
-fin:
- .pcc_begin_return
- .return product
- .pcc_end_return
+.sub "foo"
+ print "foo\n"
+ "new"()
.end
+.sub "new"
+ print "new\n"
+.end
CODE
-120
+foo
+new
+ok
OUT
-pir_output_is(<<'CODE', <<'OUT', "proto call, proto sub, invokecc, P param");
-.sub test @MAIN
- .local Sub sub
- newsub sub, .Sub, _sub
- $P0 = new Undef
- $P0 = "ok 1\n"
- $P1 = new Undef
- $P1 = "ok 2\n"
- .pcc_begin
- .arg $P0
- .arg $P1
- .pcc_call sub
- ret:
- .pcc_end
- print "back\n"
+pir_output_is(<<'CODE', <<'OUT', "_func() syntax with var - global");
+.sub test :main
+ .local pmc the_sub
+ the_sub = global "_sub"
+ the_sub(10, 20)
end
.end
-.pcc_sub _sub
- .param Undef a
- .param Undef b
+.sub _sub
+ .param int a
+ .param int b
print a
+ print "\n"
print b
- .pcc_begin_return
- .pcc_end_return
-.end
-CODE
-ok 1
-ok 2
-back
-OUT
-pir_output_is(<<'CODE', <<'OUT', "proto call, un proto sub, invokecc, P
param");
-.sub test @MAIN
- .local Sub sub
- newsub sub, .Sub, _sub
- $P0 = new Undef
- $P0 = "ok 1\n"
- $P1 = new Undef
- $P1 = "ok 2\n"
- .pcc_begin
- .arg $P0
- .arg $P1
- .pcc_call sub
- ret:
- .pcc_end
- print "back\n"
+ print "\n"
end
.end
-.pcc_sub _sub
- .param Undef a
- .param Undef b
- print a
- print b
- .pcc_begin_return
- .pcc_end_return
-.end
CODE
-ok 1
-ok 2
-back
+10
+20
OUT
-pir_output_is(<<'CODE', <<'OUT', "proto call, proto sub, invokecc, S param");
-.sub test @MAIN
- .local Sub sub
- newsub sub, .Sub, _sub
- $S0 = "ok 1\n"
- $S1 = "ok 2\n"
- .pcc_begin
- .arg $S0
- .arg $S1
- .pcc_call sub
- ret:
- .pcc_end
- print "back\n"
- end
-.end
-.pcc_sub _sub
- .param string a
- .param string b
- print a
- print b
- .pcc_begin_return
- .pcc_end_return
+pir_output_is(<<'CODE', "42\n", "multiple returns");
+.sub test :main
+.local int a, b
+ (a, b) = _sub()
+ print a
+ print b
+ print "\n"
.end
-CODE
-ok 1
-ok 2
-back
-OUT
-pir_output_is(<<'CODE', <<'OUT', "proto call, nonproto sub, invokecc, S
param");
-.sub test @MAIN
- .local Sub sub
- newsub sub, .Sub, _sub
- $S0 = "ok 1\n"
- $S1 = "ok 2\n"
- .pcc_begin
- .arg $S0
- .arg $S1
- .pcc_call sub
- ret:
- .pcc_end
- print "back\n"
- end
-.end
-.pcc_sub _sub
- .param string a
- .param string b
- print a
- print b
- .pcc_begin_return
- .pcc_end_return
+.sub _sub
+.return ( 4, 2 )
.end
CODE
-ok 1
-ok 2
-back
-OUT
-pir_output_is(<<'CODE', <<'OUT', "proto call, unproto sub, invokecc, S param");
-.sub test @MAIN
- .local Sub sub
- newsub sub, .Sub, _sub
- $S0 = "ok 1\n"
- $S1 = "ok 2\n"
- .pcc_begin
- .arg $S0
- .arg $S1
- .pcc_call sub
- ret:
- .pcc_end
- print "back\n"
+pir_output_is(<<'CODE', <<'OUT', "tail recursive sub");
+.sub test :main
+ .local int count, product, result
+ count = 5
+ product = 1
+ result = _fact(product, count)
+ print result
+ print "\n"
end
.end
-.pcc_sub _sub
- .param string a
- .param string b
- print a
- print b
- .pcc_begin_return
- .pcc_end_return
-.end
-CODE
-ok 1
-ok 2
-back
-OUT
-pir_output_is(<<'CODE', <<'OUT', "non_proto call, unproto sub, invokecc, S
param");
-.sub test @MAIN
- .local Sub sub
- newsub sub, .Sub, _sub
- $S0 = "ok 1\n"
- $S1 = "ok 2\n"
- .pcc_begin
- .arg $S0
- .arg $S1
- .pcc_call sub
- ret:
- .pcc_end
- print "back\n"
- end
-.end
-.pcc_sub _sub
- .param string a
- .param string b
- print a
- print b
- .pcc_begin_return
- .pcc_end_return
+.pcc_sub _fact
+ .param int product
+ .param int count
+ if count > 1 goto recur
+ .return (product)
+recur:
+ product = product * count
+ dec count
+ .return _fact(product, count)
.end
+
CODE
-ok 1
-ok 2
-back
+120
OUT
@@ -343,44 +165,33 @@ OUT
# }
pir_output_is(<<'CODE', <<'OUT', "coroutine iterator");
-.sub test @MAIN
+.sub test :main
.local int i
i=5
- newsub $P0, .Coroutine, _addtwo
newsub $P1, .Continuation, after_loop
- .pcc_begin
- .arg $P1
- .arg i
- .pcc_call $P0
- ret_addr:
- .result $I2
- .pcc_end
+loop:
+ $I2 = _addtwo($P1, i)
print $I2
print "\n"
- invokecc $P0
- goto ret_addr
+ goto loop
after_loop:
print "done in main\n"
- end
.end
-.pcc_sub _addtwo
- .param Continuation when_done
+.sub _addtwo
+ .param pmc when_done
.param int a
.local int i
i = 0
loop:
if i >= 10 goto done
$I5 = a+i
- .pcc_begin_yield
- .return $I5
- .pcc_end_yield
+ .yield($I5)
i = i + 1
goto loop
done:
print "done in coroutine\n"
invokecc when_done
- end
.end
CODE
5
@@ -397,331 +208,52 @@ done in coroutine
done in main
OUT
-pir_output_is(<<'CODE', <<'OUT', "sub calling another sub, SRegs");
-.sub test @MAIN
- .local Sub sub
- newsub sub, .Sub, _sub
- $S0 = "ok 1\n"
- $S1 = "ok 2\n"
- .pcc_begin
- .arg $S0
- .arg $S1
- .pcc_call sub
- ret:
- .pcc_end
- print "back\n"
- end
-.end
-.pcc_sub _sub
- .param string a
- .param string b
- print a
- print b
- .local Sub sub
- newsub sub, .Sub, _sub2
- $S0 = "ok 3\n"
- $S1 = "ok 4\n"
- .pcc_begin
- .arg $S0
- .arg $S1
- .pcc_call sub
- ret:
- .pcc_end
- print a
- print b
- .pcc_begin_return
- .pcc_end_return
-.end
-.pcc_sub _sub2
- .param string a
- .param string b
- print a
- print b
- .pcc_begin_return
- .pcc_end_return
-.end
-CODE
-ok 1
-ok 2
-ok 3
-ok 4
-ok 1
-ok 2
-back
-OUT
-
-pir_output_is(<<'CODE', <<'OUT', "sub calling another sub, PRegs");
-.sub test @MAIN
- .local Sub sub
- newsub sub, .Sub, _sub
- $P0 = new Undef
- $P1 = new Undef
- $P0 = "ok 1\n"
- $P1 = "ok 2\n"
- .pcc_begin
- .arg $P0
- .arg $P1
- .pcc_call sub
- ret:
- .pcc_end
- print "back\n"
- end
-.end
-.pcc_sub _sub
- .param Undef a
- .param Undef b
- print a
- print b
- .local Sub sub
- newsub sub, .Sub, _sub2
- $P0 = new Undef
- $P1 = new Undef
- $P0 = "ok 3\n"
- $P1 = "ok 4\n"
- .pcc_begin
- .arg $P0
- .arg $P1
- .pcc_call sub
- ret:
- .pcc_end
- print a
- print b
- .pcc_begin_return
- .pcc_end_return
-.end
-.pcc_sub _sub2
- .param Undef a
- .param Undef b
- print a
- print b
- .pcc_begin_return
- .pcc_end_return
-.end
-CODE
-ok 1
-ok 2
-ok 3
-ok 4
-ok 1
-ok 2
-back
-OUT
-
-pir_output_is(<<'CODE', <<'OUT', "in, out different P param, 2 subs");
-.sub test @MAIN
- .local Sub sub
- .local Undef x
- x = new Undef
- x = 42
- newsub sub, .Sub, _sub
- .pcc_begin
- .arg x
- .pcc_call sub
- ret:
- .local Undef y
- .result y
- .pcc_end
- .local Undef z
- z = y
- .pcc_begin
- .arg y
- .pcc_call sub
- ret2:
- .result y
- .pcc_end
- print x
- print "\n"
- print y
- print "\n"
- print z
- print "\n"
- end
-.end
-.pcc_sub _sub
- .param Undef a
- .local Undef res
- res = new Undef
- res = a + 1
- .pcc_begin_return
- .return res
- .pcc_end_return
-.end
-CODE
-42
-44
-43
-OUT
-
-pir_output_is(<<'CODE', <<'OUT', "sub calling another");
-# sub g() { return 42; }
-# sub f() { return g(); }
-# print f(), "\n"
-# mostly generated from pirate.py
-
-.sub __main__
- new_pad 0
- newsub $P0, .Sub, _sub0 # (genFunction:378)
- store_lex -1, 'g', $P0 # (genFunction:380)
- newsub $P1, .Sub, _sub1 # (genFunction:378)
- store_lex -1, 'f', $P1 # (genFunction:380)
- find_lex $P5, 'f' # (callingExpression:325)
- newsub $P6, .RetContinuation, ret1 # (callingExpression:331)
- .pcc_begin # (callingExpression:332)
- .pcc_call $P5, $P6 # (callingExpression:335)
-ret1:
- .result $P4 # (callingExpression:338)
- .pcc_end # (callingExpression:339)
- print $P4 # (visitPrint:394)
- print "\n" # (visitPrintnl:403)
- end # (compile:574)
-.end
-
-# g from line 1
-.pcc_sub _sub0
- .local pmc res0 # (visitReturn:528)
- res0 = new Integer # (expressConstant:153)
- res0 = 42 # (expressConstant:154)
- .pcc_begin_return # (visitReturn:530)
- .return res0 # (visitReturn:531)
- .pcc_end_return # (visitReturn:532)
-.end
-
-
-# f from line 3
-.pcc_sub _sub1
- .local pmc res1 # (visitReturn:528)
- find_lex $P2, 'g' # (callingExpression:325)
- newsub $P3, .RetContinuation, ret0 # (callingExpression:331)
- .pcc_begin # (callingExpression:332)
- .pcc_call $P2, $P3 # (callingExpression:335)
-ret0:
- .result res1 # (callingExpression:338)
- .pcc_end # (callingExpression:339)
- .pcc_begin_return # (visitReturn:530)
- .return res1 # (visitReturn:531)
- .pcc_end_return # (visitReturn:532)
-.end
-CODE
-42
-OUT
-
-
-pir_output_is(<<'CODE', <<'OUT', "coroutine generator throwing exception");
-## this is mainly from Michal Wallace
-## generator_try_bug.imc
-
-## this exposes a bug in parrot exception handling
-## a function returns a function and that function
-## throws an error. The error is not caught.
-
-# count returns a generator, which counts down to zero and then
-# throws an exception, which is caught in main
-
-.sub __main__
- new_pad 0
-
- # count() returns a generator
- .local Sub count
- newsub count, .Sub, _count
-
- # here's where we'll store it
- .local pmc generator
-
- # call count and get the generator
- .local Integer start
- start = new Integer
- start = 3
- .pcc_begin
- .arg start
- .pcc_call count
-ret0:
- .result generator
- .pcc_end
-
-
- ## HERE IS where we want the try block to start ####
- .local Sub handler
- push_eh catch0
-
- # now call the generator, until that throws 'StopIteration'
- # protect against endless loops
- set I20, 10
+pir_output_is(<<'CODE', <<'OUT', "coroutine iterator - throw stop");
+.sub test :main
+ .local int i
+ i=5
+ push_eh after_loop
loop:
- dec I20
- unless I20, err
- .pcc_begin
- .arg $P0
- .pcc_call generator
-ret1:
- .result $P0
- .pcc_end
- print $P0
+ $I2 = _addtwo(i)
+ print $I2
print "\n"
goto loop
-
- # end the "try" block (we never get here)
- clear_eh
- goto endtry0
-catch0:
- print "caught it!\n"
-endtry0:
- end
-err:
- print "didn't stop\n"
- end
+ after_loop:
+ print "done in main\n"
.end
-# here is count(), which returns the generator
-.pcc_sub _count
- .param Integer start
- .local pmc gen_fun
- .local pmc gen_obj
- store_lex -1, "start", start
- newsub gen_fun, .Coroutine, _count_g
- .pcc_begin_return
- .return gen_fun
- .pcc_end_return
-.end
-
-# here is the generator itself
-# all it does is throw StopIteration
-.pcc_sub _count_g
- .local Integer c
-count_loop:
- find_lex c, -1, "start"
- lt c, 0, stop
- .pcc_begin_yield
- .return c
- .pcc_end_yield
- c = c - 1
- # this branch was to _coung_g, which isn't quite right
- # code shouldn't branch to the entry label, where some
- # function prologue does exist
- # OTOH there might be some more bugs with coruoutines
- goto count_loop
-
-stop:
- .local pmc ex0
- .local pmc msg0
- ex0 = new Exception
- msg0 = new String
- msg0 = 'StopIteration'
- ex0['_message'] = msg0
- throw ex0
+.sub _addtwo
+ .param int a
+ .local int i
+ i = 0
+ loop:
+ if i >= 10 goto done
+ $I5 = a+i
+ .yield($I5)
+ i = i + 1
+ goto loop
+ done:
+ print "done in coroutine\n"
+ new $P0, .Exception
+ throw $P0
.end
-
-## end of test case ###############################
-
CODE
-3
-2
-1
-0
-caught it!
+5
+6
+7
+8
+9
+10
+11
+12
+13
+14
+done in coroutine
+done in main
OUT
my $template = <<'TEMPLATE';
-.sub test @MAIN
+.sub test :main
=LOCALS=
=INITS=
.local Sub sub
@@ -789,223 +321,55 @@ OUT
$code = repeat($template, 40,
LOCALS => ".local Integer a<index>\n\ta<index> = new Integer",
INITS => 'a<index> = <index>',
- ARGS => '.arg a<index>',
- PARAMS => '.param Integer a<index>',
- TESTS => "set I0, a<index>\nne I0, <index>, fail");
-
-pir_output_is($code, <<'OUT', "overflow pmcs 40");
-all params ok
-OUT
-
-}
-$code = repeat($template, 18,
- LOCALS => ".local Integer a<index>\n\ta<index> = new Integer",
- INITS => 'a<index> = <index>',
- ARGS => '.arg a<index>',
- PARAMS => '.param Integer a<index>',
- TESTS => "set I0, a<index>\nne I0, <index>, fail");
-
-pir_output_is($code, <<'OUT', "overflow pmcs");
-all params ok
-OUT
-
-
-pir_output_is(<<'CODE', <<'OUT', ".arg :flat 1");
-.pcc_sub _main
- .local Sub sub
- newsub sub, .Sub, _sub
- .local pmc ar
- ar = new PerlArray
- push ar, "ok 1\n"
- push ar, "ok 2\n"
- .pcc_begin
- .arg ar :flat
- .pcc_call sub
- ret:
- .pcc_end
- end
-.end
-.pcc_sub _sub
- .param pmc a
- .param pmc b
- print a
- print b
- end
-.end
-CODE
-ok 1
-ok 2
-OUT
-
-pir_output_is(<<'CODE', <<'OUT', ".arg :flat non-prototyped 2");
-.pcc_sub _main
- .local Sub sub
- newsub sub, .Sub, _sub
- .local pmc ar
- .local pmc x
- x = new String
- x = "first\n"
- ar = new PerlArray
- push ar, "ok 1\n"
- push ar, "ok 2\n"
- .pcc_begin
- .arg x
- .arg ar :flat
- .pcc_call sub
- ret:
- .pcc_end
- end
-.end
-.pcc_sub _sub
- .param pmc a
- .param pmc b
- print a
- print b
- end
-.end
-CODE
-first
-ok 1
-OUT
-
-pir_output_is(<<'CODE', <<'OUT', ".arg :flat non-prototyped 3");
-.pcc_sub _main
- .local Sub sub
- newsub sub, .Sub, _sub
- .local pmc ar
- .local pmc x
- x = new String
- x = "first\n"
- .local pmc y
- y = new String
- y = "last\n"
- ar = new PerlArray
- push ar, "ok 1\n"
- push ar, "ok 2\n"
- .pcc_begin
- .arg x
- .arg ar :flat
- .arg y
- .pcc_call sub
- ret:
- .pcc_end
- end
-.end
-.pcc_sub _sub
- .param pmc a
- .param pmc b
- .param pmc c
- .param pmc d
- print a
- print b
- print c
- print d
- end
-.end
-CODE
-first
-ok 1
-ok 2
-last
+ ARGS => '.arg a<index>',
+ PARAMS => '.param Integer a<index>',
+ TESTS => "set I0, a<index>\nne I0, <index>, fail");
+
+pir_output_is($code, <<'OUT', "overflow pmcs 40");
+all params ok
OUT
-pir_output_is(<<'CODE', <<'OUT', ".arg :flat non-prototyped 4");
-.pcc_sub _main
- .local Sub sub
- newsub sub, .Sub, _sub
- .local pmc x
- x = new String
- x = "first\n"
- .local pmc y
- y = new String
- y = "middle\n"
- .local pmc z
- z = new String
- z = "last\n"
- .local pmc ar
- ar = new PerlArray
- push ar, "ok 1\n"
- push ar, "ok 2\n"
- .local pmc ar2
- ar2 = new PerlArray
- push ar2, "ok 3\n"
- push ar2, "ok 4\n"
- push ar2, "ok 5\n"
- .pcc_begin
- .arg x
- .arg ar :flat
- .arg y
- .arg ar2 :flat
- .arg z
- .pcc_call sub
- ret:
- .pcc_end
- end
-.end
-.pcc_sub _sub
- .param pmc a
- .param pmc b
- .param pmc c
- .param pmc d
- .param pmc e
- .param pmc f
- .param pmc g
- .param pmc h
- print a
- print b
- print c
- print d
- print e
- print f
- print g
- print h
- end
-.end
-CODE
-first
-ok 1
-ok 2
-middle
-ok 3
-ok 4
-ok 5
-last
+}
+$code = repeat($template, 18,
+ LOCALS => ".local Integer a<index>\n\ta<index> = new Integer",
+ INITS => 'a<index> = <index>',
+ ARGS => '.arg a<index>',
+ PARAMS => '.param Integer a<index>',
+ TESTS => "set I0, a<index>\nne I0, <index>, fail");
+
+pir_output_is($code, <<'OUT', "overflow pmcs");
+all params ok
OUT
-pir_output_is(<<'CODE', <<'OUT', ".arg :flat prototyped 1");
-.pcc_sub _main
- .local Sub sub
- newsub sub, .Sub, _sub
- .local pmc x
- x = new String
+
+pir_output_is(<<'CODE', <<'OUT', ".arg :flat");
+.sub _main
+ .local pmc x, y, z, ar, ar2, s
+ x = new .String
x = "first\n"
- .local pmc y
- y = new String
+ y = new .String
y = "middle\n"
- .local pmc z
- z = new String
+ z = new .String
z = "last\n"
- .local pmc ar
- ar = new PerlArray
+ ar = new .ResizablePMCArray
push ar, "ok 1\n"
push ar, "ok 2\n"
- .local pmc ar2
- ar2 = new PerlArray
+ ar2 = new .ResizablePMCArray
push ar2, "ok 3\n"
push ar2, "ok 4\n"
push ar2, "ok 5\n"
+ .const .Sub s = "_sub"
.pcc_begin
.arg x
.arg ar :flat
.arg y
.arg ar2 :flat
.arg z
- .pcc_call sub
- ret:
+ .pcc_call s
.pcc_end
end
.end
-.pcc_sub _sub
+.sub _sub
.param pmc a
.param pmc b
.param pmc c
@@ -1022,7 +386,6 @@ pir_output_is(<<'CODE', <<'OUT', ".arg :
print f
print g
print h
- end
.end
CODE
first
@@ -1035,47 +398,27 @@ ok 5
last
OUT
-pir_output_is(<<'CODE', <<'OUT', ".arg :flat - overflow");
-.pcc_sub _main
- .local Sub sub
- newsub sub, .Sub, _sub
- .local pmc x
- x = new String
+pir_output_is(<<'CODE', <<'OUT', "foo (arg :flat)");
+.sub _main
+ .local pmc x, y, z, ar, ar2
+ x = new .String
x = "first\n"
- .local pmc y
- y = new String
+ y = new .String
y = "middle\n"
- .local pmc z
- z = new String
+ z = new .String
z = "last\n"
- .local pmc ar
- ar = new PerlArray
+ ar = new .ResizablePMCArray
push ar, "ok 1\n"
push ar, "ok 2\n"
- .local pmc ar2
- ar2 = new PerlArray
+ ar2 = new .ResizablePMCArray
push ar2, "ok 3\n"
push ar2, "ok 4\n"
push ar2, "ok 5\n"
- push ar2, "ok 6\n"
- push ar2, "ok 7\n"
- push ar2, "ok 8\n"
- push ar2, "ok 9\n"
- push ar2, "ok 10\n"
- push ar2, "ok 11\n"
- push ar2, "ok 12\n"
- .pcc_begin
- .arg x
- .arg ar :flat
- .arg y
- .arg ar2 :flat
- .arg z
- .pcc_call sub
- ret:
- .pcc_end
+ _sub(x, ar :flat, y, ar2 :flat, z)
end
.end
-.pcc_sub _sub
+
+.sub _sub
.param pmc a
.param pmc b
.param pmc c
@@ -1084,13 +427,6 @@ pir_output_is(<<'CODE', <<'OUT', ".arg :
.param pmc f
.param pmc g
.param pmc h
- .param pmc i
- .param pmc j
- .param pmc k
- .param pmc l
- .param pmc m
- .param pmc n
- .param pmc o
print a
print b
print c
@@ -1099,15 +435,8 @@ pir_output_is(<<'CODE', <<'OUT', ".arg :
print f
print g
print h
- print i
- print j
- print k
- print l
- print m
- print n
- print o
- end
.end
+
CODE
first
ok 1
@@ -1116,91 +445,19 @@ middle
ok 3
ok 4
ok 5
-ok 6
-ok 7
-ok 8
-ok 9
-ok 10
-ok 11
-ok 12
last
OUT
-pir_output_is(<<'CODE', <<'OUT', ".arg :flat multiple instances");
-.pcc_sub _main
- .local Sub sub
- newsub sub, .Sub, _sub
- .local pmc ar
- ar = new PerlArray
- push ar, "ok 1\n"
- push ar, "ok 2\n"
- .pcc_begin
- .arg ar :flat
- .pcc_call sub
- ret:
- .pcc_end
- .pcc_begin
- .arg ar :flat
- .pcc_call sub
- ret2:
- .pcc_end
- end
-.end
-.pcc_sub _sub
- .param pmc a
- .param pmc b
- print a
- print b
- .pcc_begin_return
- .pcc_end_return
- end
-.end
-CODE
-ok 1
-ok 2
-ok 1
-ok 2
-OUT
-
-pir_output_is(<<'CODE', <<'OUT', "(regression) comment handling in
pcc_params");
-.sub __main
- .local Sub main_sub
- newsub main_sub, .Sub, _main
- .pcc_begin
- .arg P5
- .pcc_call main_sub
-ret:
- .pcc_end
- print "ok\n"
- end
-.end
-
-.pcc_sub _main
-#Positional parameters:
- .param Array command_line
- .pcc_begin_return
- .pcc_end_return
-.end
-CODE
-ok
-OUT
-
SKIP: {
skip("cant do NCI on $^O", 1) unless ($^O =~ /linux/ || $^O =~ /darwin/);
pir_output_is(<<'CODE', <<'OUT', "nci");
-.sub test @MAIN
- .sym pmc FABS
- .sym pmc NULL
+.sub test :main
+ .local pmc FABS, NULL
null NULL
dlfunc FABS, NULL, "fabs", "dd"
- .sym float d
- .sym float r
+ .local float d, r
d = -42
- .pcc_begin
- .arg d
- .nci_call FABS
- .result r
- .pcc_end
+ r = FABS(d)
print d
print "\n"
print r
@@ -1213,8 +470,8 @@ CODE
OUT
}
-pir_output_is(<<'CODE', <<'OUT', "MAIN pragma, syntax only");
-.sub _main @MAIN
+pir_output_is(<<'CODE', <<'OUT', ":main pragma, syntax only");
+.sub _main :main
print "ok\n"
end
.end
@@ -1226,7 +483,7 @@ OUT
# "-o code.pbc -r -r" command line params.
# Strangely, the same output is written
pir_output_like(<<'CODE', <<'OUT', "more pragmas, syntax only");
-.sub _main @MAIN, @LOAD, @POSTCOMP
+.sub _main :main :load :postcomp
print "ok\n"
end
.end
@@ -1234,194 +491,30 @@ CODE
/(ok\n){1,2}/
OUT
-pir_output_is(<<'CODE', <<'OUT', "_func() syntax");
-.sub test @MAIN
- _sub(10, 20)
- end
-.end
-.pcc_sub _sub
- .param int a
- .param int b
- print a
- print "\n"
- print b
- print "\n"
- end
-.end
-CODE
-10
-20
-OUT
-pir_output_is(<<'CODE', <<'OUT', "_func() syntax with var");
-.sub test @MAIN
- .local pmc the_sub
- the_sub = global "_sub"
- the_sub(10, 20)
- end
-.end
-.pcc_sub _sub
- .param int a
- .param int b
- print a
- print "\n"
- print b
- print "\n"
- end
-.end
-CODE
-10
-20
-OUT
-
-pir_output_is(<<'CODE', <<'OUT', "P3 is NULL - 11 args");
-.sub test @MAIN
- P3 = new .Array
- # call with 11 parameters
- _foo($P1, $P2, $P3, $P4, $P5, $P6, $P7, $P8, $P9, $P10, $P11)
- end
-.end
-
-.sub _foo
- if_null P3, p3_is_null
- print "P3 is not NULL\n"
- goto return
-p3_is_null:
- print "P3 is NULL\n"
-return:
-.end
-CODE
-P3 is NULL
-OUT
-
-
-pir_output_is(<<'CODE', "mongueur\nmonger\n", "multiple declaration in a
.sym/.local directive");
-.sub main
-.sym string s, t
- s = "mongueur\n"
- t = "monger\n"
- print s
- print t
- end
-.end
-CODE
-
-pir_output_is(<<'CODE', "42\n", "oneliner return");
-.sub test @MAIN
-.sym int a, b
- (a, b) = _sub()
- print a
- print b
- print "\n"
- _sub1()
- end
-.end
-
-.sub _sub
-.return ( 4, 2 )
-.end
-
-.sub _sub1
-.return ( )
-.end
-CODE
-
-pir_output_is(<<'CODE', <<'OUT', "oneliner yield");
-.sub test @MAIN
- .local int i
- i=5
- newsub $P0, .Coroutine, _addtwo
- newsub $P1, .Continuation, after_loop
- .pcc_begin
- .arg $P1
- .arg i
- .pcc_call $P0
- ret_addr:
- .result $I2
- .pcc_end
- print $I2
- print "\n"
- invokecc $P0
- goto ret_addr
- after_loop:
- print "done in main\n"
- end
-.end
-
-.pcc_sub _addtwo
- .param Continuation when_done
- .param int a
- .local int i
- i = 0
- loop:
- if i >= 10 goto done
- $I5 = a+i
- .yield ( $I5 )
- i = i + 1
- goto loop
- done:
- print "done in coroutine\n"
- invokecc when_done
- end
-.end
-CODE
-5
-6
-7
-8
-9
-10
-11
-12
-13
-14
-done in coroutine
-done in main
-OUT
-
-pir_output_is(<<'CODE', <<'OUT', "quoted sub names");
-.sub main @MAIN
- "foo"()
- print "ok\n"
-.end
-
-.sub "foo"
- print "foo\n"
- "new"()
-.end
-
-.sub "new"
- print "new\n"
-.end
-CODE
-foo
-new
-ok
-OUT
-
pir_output_is(<<'CODE', <<'OUT', "multi 1");
-.sub foo @MULTI()
+.sub foo :multi()
print "ok 1\n"
.end
-.sub f1 @MULTI(int)
+.sub f1 :multi(int)
.end
-.sub f2 @MULTI(int, float)
+.sub f2 :multi(int, float)
.end
-.sub f3 @MULTI(Integer, Any, _)
+.sub f3 :multi(Integer, Any, _)
.end
CODE
ok 1
OUT
-pir_output_is(<<'CODE', <<'OUT', "[EMAIL PROTECTED] defined twice");
-.sub foo @MAIN
+pir_output_is(<<'CODE', <<'OUT', "\:main defined twice");
+.sub foo :main
set S0, 'not ok'
print S0
print "\r\n"
end
.end
-.sub bar @MAIN
+.sub bar :main
set S0, 'ok'
print S0
print "\r\n"
@@ -1431,31 +524,31 @@ CODE
ok
OUT
-pir_output_is(<<'CODE', <<'OUT', "[EMAIL PROTECTED] subpragma, syntax only");
-.sub anon @ANON
+pir_output_is(<<'CODE', <<'OUT', "\:anon subpragma, syntax only");
+.sub anon :anon
print "ok\n"
.end
CODE
ok
OUT
-pir_output_like(<<'CODE', <<'OUT', "[EMAIL PROTECTED] doesn't install symbol
1");
-.sub main @MAIN
+pir_output_like(<<'CODE', <<'OUT', "\:anon doesn't install symbol 1");
+.sub main :main
.local pmc result
result= find_global 'anon'
result()
print "\n"
.end
-.sub anon @ANON
+.sub anon :anon
print "not ok\n"
.end
CODE
/.*'anon'.*not found/
OUT
-pir_output_is(<<'CODE', <<'OUT', "[EMAIL PROTECTED] doesn't install symbol 2");
-.sub main @MAIN
+pir_output_is(<<'CODE', <<'OUT', "\:anon doesn't install symbol 2");
+.sub main :main
.local pmc result
result= find_global 'anon'
result()
@@ -1465,43 +558,27 @@ pir_output_is(<<'CODE', <<'OUT', "[EMAIL PROTECTED]
print "ok\n"
.end
-.sub anon @ANON
+.sub anon :anon
print "not ok\n"
.end
CODE
ok
OUT
-pir_output_like(<<'CODE', <<'OUT', "multiple [EMAIL PROTECTED] subs with same
name");
-.sub main @MAIN
+pir_output_like(<<'CODE', <<'OUT', "multiple \:anon subs with same name");
+.sub main :main
.local pmc result
result= find_global 'anon'
result()
.end
-.sub anon @ANON
+.sub anon :anon
print "nok 1\n"
.end
-.sub anon @ANON
+.sub anon :anon
print "nok 2\n"
.end
CODE
/.*'anon'.*not found/
OUT
-
-pir_output_is(<<'CODE', <<'OUT', "multi - colon syntax");
-# just parser test - these flags are meaningless
-.sub foo :multi() :main
- print "ok 1\n"
-.end
-.sub f1 :multi(int) :load :postcomp
-.end
-.sub f2 :multi(int, float)
-.end
-.sub f3 :multi(Integer, Any, _)
-.end
-CODE
-ok 1
-OUT
-
