develooper Front page | perl.cvs.parrot | Postings from December 2008

[svn:parrot] r33655 - in trunk/languages/WMLScript: runtime src t t/pmc

From:
fperrad
Date:
December 8, 2008 07:50
Subject:
[svn:parrot] r33655 - in trunk/languages/WMLScript: runtime src t t/pmc
Message ID:
20081208155023.09B02CB9AF@x12.develooper.com
Author: fperrad
Date: Mon Dec  8 07:50:21 2008
New Revision: 33655

Modified:
   trunk/languages/WMLScript/runtime/wmlsconsole.pir
   trunk/languages/WMLScript/runtime/wmlsfloat.pir
   trunk/languages/WMLScript/runtime/wmlslang.pir
   trunk/languages/WMLScript/runtime/wmlsstring.pir
   trunk/languages/WMLScript/src/script.pir
   trunk/languages/WMLScript/t/harness
   trunk/languages/WMLScript/t/pmc/float.t
   trunk/languages/WMLScript/t/pmc/integer.t
   trunk/languages/WMLScript/t/pmc/string.t

Log:
[WMLScript] box
refactor with opcode 'box' :
- code generation
- standard libraries
- test PMC

Modified: trunk/languages/WMLScript/runtime/wmlsconsole.pir
==============================================================================
--- trunk/languages/WMLScript/runtime/wmlsconsole.pir	(original)
+++ trunk/languages/WMLScript/runtime/wmlsconsole.pir	Mon Dec  8 07:50:21 2008
@@ -53,8 +53,7 @@
     $S0 = str
     print $S0
     $I0 = length $S0
-    new res, 'WmlsInteger'
-    set res, $I0
+    box res, $I0
     goto L2
   L1:
     new res, 'WmlsInvalid'
@@ -87,8 +86,7 @@
     print $S0
     print "\n"
     $I0 = length $S0
-    new res, 'WmlsInteger'
-    set res, $I0
+    box res, $I0
     goto L2
   L1:
     new res, 'WmlsInvalid'

Modified: trunk/languages/WMLScript/runtime/wmlsfloat.pir
==============================================================================
--- trunk/languages/WMLScript/runtime/wmlsfloat.pir	(original)
+++ trunk/languages/WMLScript/runtime/wmlsfloat.pir	Mon Dec  8 07:50:21 2008
@@ -73,8 +73,7 @@
     $I0 = isa $P0, 'WmlsInvalid'
     if $I0 goto L2
     $I0 = $P0
-    new res, 'WmlsInteger'
-    set res, $I0
+    box res, $I0
     goto L3
   L2:
     new res, 'WmlsInvalid'
@@ -112,8 +111,7 @@
     if $I0 goto L2
     $N0 = $P0
     $I0 = floor $N0
-    new res, 'WmlsInteger'
-    set res, $I0
+    box res, $I0
     goto L3
   L2:
     new res, 'WmlsInvalid'
@@ -151,8 +149,7 @@
     if $I0 goto L2
     $N0 = $P0
     $I0 = ceil $N0
-    new res, 'WmlsInteger'
-    set res, $I0
+    box res, $I0
     goto L3
   L2:
     new res, 'WmlsInvalid'
@@ -209,8 +206,7 @@
     $N2 = $P2
     unless $N1 == 0.0 goto L4
     if $N2 < 0.0 goto L2
-    new res, 'WmlsFloat'
-    set res, 0.0
+    box res, 0.0
     goto L5
   L4:
     unless $N1 < 0.0 goto L6
@@ -218,8 +214,7 @@
     if $I0 goto L2
   L6:
     $N0 = pow $N1, $N2
-    new res, 'WmlsFloat'
-    set res, $N0
+    box res, $N0
     goto L5
   L2:
     new res, 'WmlsInvalid'
@@ -260,8 +255,7 @@
     $N0 = $P0
     $N0 += 0.5
     $I0 = floor $N0
-    new res, 'WmlsInteger'
-    set res, $I0
+    box res, $I0
     goto L3
   L2:
     new res, 'WmlsInvalid'
@@ -304,8 +298,7 @@
     $N0 = $P0
     if $N0 < 0.0 goto L2
     $N1 = sqrt $N0
-    new res, 'WmlsFloat'
-    set res, $N1
+    box res, $N1
     goto L3
   L2:
     new res, 'WmlsInvalid'
@@ -329,8 +322,7 @@
 
 .sub '_float_maxFloat' :anon
     .local pmc res
-    new res, 'WmlsFloat'
-    set res, 3.40282347e+38
+    box res, 3.40282347e+38
     .return (res)
 .end
 
@@ -351,8 +343,7 @@
 
 .sub '_float_minFloat' :anon
     .local pmc res
-    new res, 'WmlsFloat'
-    set res, 1.17549435e-38
+    box res, 1.17549435e-38
     .return (res)
 .end
 

Modified: trunk/languages/WMLScript/runtime/wmlslang.pir
==============================================================================
--- trunk/languages/WMLScript/runtime/wmlslang.pir	(original)
+++ trunk/languages/WMLScript/runtime/wmlslang.pir	Mon Dec  8 07:50:21 2008
@@ -427,8 +427,7 @@
 
 .sub '_lang_maxInt' :anon
     .local pmc res
-    new res, 'WmlsInteger'
-    set res, 2147483647
+    box res, 2147483647
     .return (res)
 .end
 
@@ -447,8 +446,7 @@
 
 .sub '_lang_minInt' :anon
     .local pmc res
-    new res, 'WmlsInteger'
-    set res, -2147483648
+    box res, -2147483648
     .return (res)
 .end
 
@@ -577,8 +575,7 @@
     $N0 = $P0
     $N0 = mul $I0
     $I0 = $N0
-    new res, 'WmlsInteger'
-    set res, $I0
+    box res, $I0
     goto L3
   L2:
     new res, 'WmlsInvalid'
@@ -654,8 +651,7 @@
 
 .sub '_lang_characterSet' :anon
     .local pmc res
-    new res, 'WmlsInteger'
-    res = 4     # latin1
+    box res, 4     # latin1
     .return (res)
 .end
 

Modified: trunk/languages/WMLScript/runtime/wmlsstring.pir
==============================================================================
--- trunk/languages/WMLScript/runtime/wmlsstring.pir	(original)
+++ trunk/languages/WMLScript/runtime/wmlsstring.pir	Mon Dec  8 07:50:21 2008
@@ -110,8 +110,7 @@
     if $I0 goto L1
     $S1 = str
     $I1 = length $S1
-    new res, 'WmlsInteger'
-    set res, $I1
+    box res, $I1
     .return (res)
   L1:
     new res, 'WmlsInvalid'
@@ -196,12 +195,13 @@
     $S1 = str
     $I1 = length $S1
     $I2 = index_
-    new res, 'WmlsString'
     if $I2 < 0 goto L3
     if $I2 >= $I1 goto L3
     $S0 = substr $S1, $I2, 1
-    set res, $S0
+    box res, $S0
+    .return (res)
   L3:
+    new res, 'WmlsString'
     .return (res)
   L1:
     new res, 'WmlsInvalid'
@@ -267,13 +267,14 @@
     if $I2 >= 0 goto L4
     $I2 = 0
   L4:
-    new res, 'WmlsString'
     if $I2 >= $I1 goto L5
     $I3 = Length
     if $I3 <= 0 goto L5
     $S0 = substr $S1, $I2, $I3
-    set res, $S0
+    box res, $S0
+    .return (res)
   L5:
+    new res, 'WmlsString'
     .return (res)
   L1:
     new res, 'WmlsInvalid'
@@ -321,8 +322,7 @@
     $I2 = length $S2
     if $I2 == 0 goto L1
     $I0 = index $S1, $S2
-    new res, 'WmlsInteger'
-    set res, $I0
+    box res, $I0
     .return (res)
   L1:
     new res, 'WmlsInvalid'
@@ -377,8 +377,7 @@
     $S3 = newSubString
     $P0 = split $S2, $S1
     $S0 = join $S3, $P0
-    new res, 'WmlsString'
-    set res, $S0
+    box res, $S0
     .return (res)
   L1:
     new res, 'WmlsInvalid'
@@ -423,15 +422,14 @@
     $I2 = length $S2
     if $I2 == 0 goto L1
     $S2 = substr $S2, 0, 1
-    new res, 'WmlsInteger'
     $I1 = length $S1
     if $I1 != 0 goto L2
-    set res, 1
+    box res, 1
     .return (res)
   L2:
     $P0 = split $S2, $S1
     $I0 = elements $P0
-    set res, $I0
+    box res, $I0
     .return (res)
   L1:
     new res, 'WmlsInvalid'
@@ -494,9 +492,9 @@
     $I3 = length $S3
     if $I3 == 0 goto L1
     $S3 = substr $S3, 0, 1
-    new res, 'WmlsString'
     $I1 = length $S1
     if $I1 != 0 goto L4
+    new res, 'WmlsString'
     .return (res)
   L4:
     $P0 = split $S3, $S1
@@ -505,7 +503,7 @@
     $I2 = $I0 - 1
   L5:
     $S0 = $P0[$I2]
-    set res, $S0
+    box res, $S0
     .return (res)
   L1:
     new res, 'WmlsInvalid'
@@ -568,9 +566,9 @@
     $I3 = length $S3
     if $I3 == 0 goto L1
     $S3 = substr $S3, 0, 1
-    new res, 'WmlsString'
     $I1 = length $S1
     if $I1 != 0 goto L4
+    new res, 'WmlsString'
     .return (res)
   L4:
     $P0 = split $S3, $S1
@@ -594,7 +592,7 @@
     goto L6
   L7:
     $S0 = join $S3, $P1
-    set res, $S0
+    box res, $S0
     .return (res)
   L1:
     new res, 'WmlsInvalid'
@@ -663,10 +661,9 @@
     $I4 = length $S4
     if $I4 == 0 goto L1
     $S4 = substr $S4, 0, 1
-    new res, 'WmlsString'
     $I1 = length $S1
     if $I1 != 0 goto L4
-    set res, $S2
+    box res, $S2
     .return (res)
   L4:
     $P0 = split $S4, $S1
@@ -676,7 +673,7 @@
   L5:
     $P0[$I3] = $S2
     $S0 = join $S4, $P0
-    set res, $S0
+    box res, $S0
     .return (res)
   L1:
     new res, 'WmlsInvalid'
@@ -745,10 +742,9 @@
     $I4 = length $S4
     if $I4 == 0 goto L1
     $S4 = substr $S4, 0, 1
-    new res, 'WmlsString'
     $I1 = length $S1
     if $I1 != 0 goto L4
-    set res, $S2
+    box res, $S2
     .return (res)
   L4:
     $P0 = split $S4, $S1
@@ -774,7 +770,7 @@
   L7:
     $P1[$I3] = $S2
     $S0 = join $S4, $P1
-    set res, $S0
+    box res, $S0
     .return (res)
   L1:
     new res, 'WmlsInvalid'
@@ -832,10 +828,9 @@
     .local pmc res
     $I0 = isa str, 'WmlsInvalid'
     if $I0 goto L1
-    new res, 'WmlsString'
     $S1 = str
     $S0 = squeeze($S1)
-    set res, $S0
+    box res, $S0
     .return (res)
   L1:
     new res, 'WmlsInvalid'
@@ -886,10 +881,9 @@
     .local pmc res
     $I0 = isa str, 'WmlsInvalid'
     if $I0 goto L1
-    new res, 'WmlsString'
     $S1 = str
     $S0 = trim($S1)
-    set res, $S0
+    box res, $S0
     .return (res)
   L1:
     new res, 'WmlsInvalid'
@@ -928,16 +922,15 @@
     if $I0 goto L1
     $S1 = string1
     $S2 = string2
-    new res, 'WmlsInteger'
     if $S1 >= $S2 goto L2
-    set res, -1
+    box res, -1
     .return (res)
   L2:
     if $S1 > $S2 goto L3
-    set res, 0
+    box res, 0
     .return (res)
   L3:
-    set res, 1
+    box res, 1
     .return (res)
   L1:
     new res, 'WmlsInvalid'
@@ -968,8 +961,7 @@
     .param pmc value
     $S1 = value
     .local pmc res
-    new res, 'WmlsString'
-    set res, $S1
+    box res, $S1
     .return (res)
 .end
 
@@ -1094,8 +1086,7 @@
     $P0[0] = value
   L2:
     $S1 = sprintf $S0, $P0
-    new res, 'WmlsString'
-    set res, $S1
+    box res, $S1
     .return (res)
   L1:
     new res, 'WmlsInvalid'

Modified: trunk/languages/WMLScript/src/script.pir
==============================================================================
--- trunk/languages/WMLScript/src/script.pir	(original)
+++ trunk/languages/WMLScript/src/script.pir	Mon Dec  8 07:50:21 2008
@@ -183,9 +183,7 @@
     pir = "  .local pmc const"
     $S0 = idx
     pir .= $S0
-    pir .= "\n  new const"
-    pir .= $S0
-    pir .= ", 'WmlsInteger'\n  set const"
+    pir .= "\n  box const"
     pir .= $S0
     pir .= ", "
     $S0 = self
@@ -207,12 +205,15 @@
     pir = "  .local pmc const"
     $S0 = idx
     pir .= $S0
-    pir .= "\n  new const"
-    pir .= $S0
-    pir .= ", 'WmlsFloat'\n  set const"
+    pir .= "\n  box const"
     pir .= $S0
     pir .= ", "
-    $S0 = self
+    # need a representation that always contains a dot,
+    # unless box a WmlsInteger
+    new $P0, 'FixedPMCArray'
+    set $P0, 1
+    $P0[0] = self
+    $S0 = sprintf "%f", $P0 # need a better precision
     pir .= $S0
     pir .= "\n"
     .return (pir)
@@ -235,9 +236,7 @@
     pir = "  .local pmc const"
     $S0 = idx
     pir .= $S0
-    pir .= "\n  new const"
-    pir .= $S0
-    pir .= ", 'WmlsString'\n  set const"
+    pir .= "\n  box const"
     pir .= $S0
     pir .= ", unicode:\""
     $S0 = self
@@ -282,9 +281,7 @@
     pir = "  .local pmc const"
     $S0 = idx
     pir .= $S0
-    pir .= "\n  new const"
-    pir .= $S0
-    pir .= ", 'WmlsString'\n  set const"
+    pir .= "\n  box const"
     pir .= $S0
     pir .= ", \""
     $S0 = self
@@ -545,14 +542,12 @@
     goto L5
   L6:
 
-    unless number_of_local_variables goto L7
-    pir .= "  new $P0, 'WmlsString'\n"
   L7:
     unless idx < number_of_variables goto L8
-    pir .= "  local"
+    pir .= "  new local"
     $S0 = idx
     pir .= $S0
-    pir .= " = $P0\n"
+    pir .= ", 'WmlsString'\n"
     inc idx
     goto L7
   L8:

Modified: trunk/languages/WMLScript/t/harness
==============================================================================
--- trunk/languages/WMLScript/t/harness	(original)
+++ trunk/languages/WMLScript/t/harness	Mon Dec  8 07:50:21 2008
@@ -7,7 +7,7 @@
     # Check that we have the WMLScript compiler.
     my $check = `wmlsc -h`;
     unless ($check =~ /wmlsc/) {
-        die "You need the WMLScript compiler in your path to build the test.\n";
+        die "You need the WMLScript compiler in your path to build the test.\n\tcpan WAP::wmls\n";
     }
 }
 

Modified: trunk/languages/WMLScript/t/pmc/float.t
==============================================================================
--- trunk/languages/WMLScript/t/pmc/float.t	(original)
+++ trunk/languages/WMLScript/t/pmc/float.t	Mon Dec  8 07:50:21 2008
@@ -1,5 +1,5 @@
 #! perl
-# Copyright (C) 2006-2007, The Perl Foundation.
+# Copyright (C) 2006-2008, The Perl Foundation.
 # $Id$
 
 =head1 NAME
@@ -19,7 +19,7 @@
 
 use strict;
 use warnings;
-use Parrot::Test tests => 10;
+use Parrot::Test tests => 11;
 use Test::More;
 
 pir_output_is( << 'CODE', << 'OUTPUT', 'check inheritance' );
@@ -228,6 +228,23 @@
 WmlsBoolean
 OUTPUT
 
+pir_output_is( << 'CODE', << 'OUTPUT', 'check box' );
+.HLL "WMLScript"
+.loadlib "wmls_group"
+.loadlib "wmls_ops"
+.sub _main
+    $P0 = box 3.14
+    print $P0
+    print "\n"
+    $S0 = typeof $P0
+    print $S0
+    print "\n"
+.end
+CODE
+3.14
+WmlsFloat
+OUTPUT
+
 # Local Variables:
 #   mode: cperl
 #   cperl-indent-level: 4

Modified: trunk/languages/WMLScript/t/pmc/integer.t
==============================================================================
--- trunk/languages/WMLScript/t/pmc/integer.t	(original)
+++ trunk/languages/WMLScript/t/pmc/integer.t	Mon Dec  8 07:50:21 2008
@@ -1,5 +1,5 @@
 #! perl
-# Copyright (C) 2006-2007, The Perl Foundation.
+# Copyright (C) 2006-2008, The Perl Foundation.
 # $Id$
 
 =head1 NAME
@@ -19,7 +19,7 @@
 
 use strict;
 use warnings;
-use Parrot::Test tests => 10;
+use Parrot::Test tests => 11;
 use Test::More;
 
 pir_output_is( << 'CODE', << 'OUTPUT', 'check inheritance' );
@@ -228,6 +228,23 @@
 WmlsBoolean
 OUTPUT
 
+pir_output_is( << 'CODE', << 'OUTPUT', 'check box' );
+.HLL "WMLScript"
+.loadlib "wmls_group"
+.loadlib "wmls_ops"
+.sub _main
+    $P0 = box 42
+    print $P0
+    print "\n"
+    $S0 = typeof $P0
+    print $S0
+    print "\n"
+.end
+CODE
+42
+WmlsInteger
+OUTPUT
+
 # Local Variables:
 #   mode: cperl
 #   cperl-indent-level: 4

Modified: trunk/languages/WMLScript/t/pmc/string.t
==============================================================================
--- trunk/languages/WMLScript/t/pmc/string.t	(original)
+++ trunk/languages/WMLScript/t/pmc/string.t	Mon Dec  8 07:50:21 2008
@@ -1,5 +1,5 @@
 #! perl
-# Copyright (C) 2006-2007, The Perl Foundation.
+# Copyright (C) 2006-2008, The Perl Foundation.
 # $Id$
 
 =head1 NAME
@@ -19,7 +19,7 @@
 
 use strict;
 use warnings;
-use Parrot::Test tests => 12;
+use Parrot::Test tests => 13;
 use Test::More;
 
 pir_output_is( << 'CODE', << 'OUTPUT', 'check inheritance' );
@@ -260,6 +260,23 @@
 WmlsBoolean
 OUTPUT
 
+pir_output_is( << 'CODE', << 'OUTPUT', 'check box' );
+.HLL "WMLScript"
+.loadlib "wmls_group"
+.loadlib "wmls_ops"
+.sub _main
+    $P0 = box "simple string"
+    print $P0
+    print "\n"
+    $S0 = typeof $P0
+    print $S0
+    print "\n"
+.end
+CODE
+simple string
+WmlsString
+OUTPUT
+
 # Local Variables:
 #   mode: cperl
 #   cperl-indent-level: 4



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About