[svn:parrot] r47412 - in trunk: compilers/pct/src/PAST compilers/pct/src/POST t/compilers/pct

[pmichaud at svn.parrot.org]

Author: pmichaud
Date: Sun Jun  6 01:08:23 2010
New Revision: 47412
URL: https://trac.parrot.org/parrot/changeset/47412

Log:
[pct]: Add capability for PAST::Val to generate pasm constants.

Modified:
   trunk/compilers/pct/src/PAST/Compiler.pir
   trunk/compilers/pct/src/POST/Compiler.pir
   trunk/compilers/pct/src/POST/Node.pir
   trunk/t/compilers/pct/past.t
   trunk/t/compilers/pct/post.t

Modified: trunk/compilers/pct/src/PAST/Compiler.pir
==============================================================================
--- trunk/compilers/pct/src/PAST/Compiler.pir	Sun Jun  6 00:46:31 2010	(r47411)
+++ trunk/compilers/pct/src/PAST/Compiler.pir	Sun Jun  6 01:08:23 2010	(r47412)
@@ -126,8 +126,16 @@
     valflags['String']   = 's~*:e'
     valflags['Integer']  = 'i+*:'
     valflags['Float']    = 'n+*:'
+    valflags['!cconst']          = 'i+*:c'
+    valflags['!exception_types'] = 'i+*:c'
     set_global '%valflags', valflags
 
+    .local pmc valconst
+    valconst = new ['Hash']
+    valconst['!cconst']          = '.include "cclass.pasm"'
+    valconst['!exception_types'] = '.include "exception_types.pasm"'
+    set_global '%valconst', valconst
+
     ##  %!controltypes holds the list of exception types for each
     ##  type of exception handler we support
     .local pmc controltypes
@@ -2468,12 +2476,28 @@
     .local string valflags
     $P0 = get_global '%valflags'
     valflags = $P0[returns]
+  
+    .local string valconst 
+    $P0 = get_global '%valconst'
+    valconst = $P0[returns]
+    unless valconst > '' goto valconst_done
+    $P0 = find_dynamic_lex '$*SUB'
+    $P0.'add_directive'(valconst)
+  valconst_done:
 
     $I0 = index valflags, 'e'
     if $I0 < 0 goto escape_done
     value = self.'escape'(value)
   escape_done:
 
+    $I0 = index valflags, 'c'
+    if $I0 < 0 goto const_done
+    $S0 = substr value, 0, 1
+    if $S0 == '.' goto const_done
+    $P0 = box '.'
+    value = concat $P0, value
+  const_done:
+
     .local string rtype
     rtype = options['rtype']
     $I0 = index valflags, rtype

Modified: trunk/compilers/pct/src/POST/Compiler.pir
==============================================================================
--- trunk/compilers/pct/src/POST/Compiler.pir	Sun Jun  6 00:46:31 2010	(r47411)
+++ trunk/compilers/pct/src/POST/Compiler.pir	Sun Jun  6 01:08:23 2010	(r47412)
@@ -368,6 +368,11 @@
     subpir.'append_format'("\n.HLL %0\n", $P0)
   subpir_ns:
     subpir.'append_format'("\n.namespace %0\n", nskey)
+  subpir_directives:
+    $S0 = node['directives']
+    unless $S0 goto subpir_decl
+    subpir.'append_format'("%0", $S0)
+  subpir_decl:
     $S0 = self.'escape'(name)
     subpir.'append_format'(".sub %0 %1\n", $S0, pirflags)
     .local pmc paramlist

Modified: trunk/compilers/pct/src/POST/Node.pir
==============================================================================
--- trunk/compilers/pct/src/POST/Node.pir	Sun Jun  6 00:46:31 2010	(r47411)
+++ trunk/compilers/pct/src/POST/Node.pir	Sun Jun  6 01:08:23 2010	(r47412)
@@ -291,6 +291,21 @@
     .return ()
 .end
 
+
+.sub 'add_directive' :method
+    .param string line
+    .local string dlist
+    dlist = self['directives']
+    $I0 = index dlist, line
+    unless $I0 < 0 goto done
+    dlist = concat dlist, line
+    dlist = concat dlist, "\n"
+    self['directives'] = dlist
+  done:
+    .return ()
+.end
+    
+
 =back
 
 =head1 AUTHOR

Modified: trunk/t/compilers/pct/past.t
==============================================================================
--- trunk/t/compilers/pct/past.t	Sun Jun  6 00:46:31 2010	(r47411)
+++ trunk/t/compilers/pct/past.t	Sun Jun  6 01:08:23 2010	(r47412)
@@ -7,7 +7,7 @@
 use warnings;
 use lib qw(t . lib ../lib ../../lib ../../../lib);
 
-use Parrot::Test tests => 10;
+use Parrot::Test tests => 11;
 
 foreach my $name (qw(Node Val Var Op Block Stmts)) {
     my $module = "'PAST';'$name'";
@@ -133,6 +133,36 @@
 }
 OUT
 
+pir_output_is( <<'CODE', <<'OUT', 'PAST::Val constant nodes' );
+.sub 'main' :main
+    load_bytecode 'PCT.pbc'
+
+    .local pmc block
+    $P0 = get_hll_global ['PAST'], 'Block'
+    block = $P0.'new'('name'=>'xyz', 'subid'=>'xyz')
+
+    .local pmc node
+    $P0 = get_hll_global ['PAST'], 'Val'
+    node = $P0.'new'('value'=> 'CONTROL_NEXT', 'returns'=>'!exception_types')
+    block.'push'(node)
+
+    .local pmc compiler
+    compiler = get_hll_global ['PAST'], 'Compiler'
+    $S0 = compiler.'compile'(block, 'target'=>'pir')
+    say $S0
+.end
+CODE
+
+.namespace []
+.include "exception_types.pasm"
+.sub "xyz"  :subid("xyz")
+.annotate 'line', 0
+    .return (.CONTROL_NEXT)
+.end
+
+
+OUT
+
 # Local Variables:
 #   mode: cperl
 #   cperl-indent-level: 4

Modified: trunk/t/compilers/pct/post.t
==============================================================================
--- trunk/t/compilers/pct/post.t	Sun Jun  6 00:46:31 2010	(r47411)
+++ trunk/t/compilers/pct/post.t	Sun Jun  6 01:08:23 2010	(r47412)
@@ -6,7 +6,7 @@
 use strict;
 use warnings;
 use lib qw(t . lib ../lib ../../lib ../../../lib);
-use Parrot::Test tests => 7;
+use Parrot::Test tests => 8;
 
 foreach my $name (qw(Op Ops Sub Label)) {
     my $module = "'POST';'$name'";
@@ -114,6 +114,35 @@
 
 OUT
 
+
+pir_output_is( <<'CODE', <<'OUT', 'Generate directives' );
+.sub _main
+    load_bytecode 'PCT.pbc'
+    load_bytecode 'dumper.pbc'
+    .local pmc node
+    node = new ['POST';'Sub']
+    node.'name'('foo')
+    node.'add_directive'('.include "cclass.pasm"')
+    node.'add_directive'('.include "exception_types.pasm"')
+
+    .local pmc compiler
+    compiler = new ['POST';'Compiler']
+    $S0 = compiler.'to_pir'(node)
+    say $S0
+    .return ()
+.end
+CODE
+
+.namespace []
+.include "cclass.pasm"
+.include "exception_types.pasm"
+.sub "foo"  :subid("post10")
+.end
+
+
+OUT
+
+
 # Local Variables:
 #   mode: cperl
 #   cperl-indent-level: 4