Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 258 lines (182 sloc) 5.385 kb
06c4e6d @jnthn Initial commit of minimally functional Blizkost.
authored
1 =head1 TITLE
2
3 perl5.pir - A Perl 5 compatibility interface for Parrot.
4
5 =head2 Description
6
7 This file sets up something that will work with HLLCompiler and
8 allow us to eval Perl 5 code.
9
10 =head2 Functions
11
12 =over 4
13
14 =item onload()
15
16 Creates the compiler using a C<PCT::HLLCompiler> object.
17
18 =cut
19
b6cfbb4 @sorear Use the actual symbolic constants
sorear authored
20 .include "dlopenflags.pasm"
06c4e6d @jnthn Initial commit of minimally functional Blizkost.
authored
21 .namespace [ 'Perl5' ; 'Compiler' ]
22
23 .sub 'onload' :anon :load :init
b6cfbb4 @sorear Use the actual symbolic constants
sorear authored
24 $P0 = box .Parrot_dlopen_global_FLAG
cef64d4 @sorear Use the new (patch pending) interface to load libperl.so globally, fixes...
sorear authored
25 $P1 = loadlib 'blizkost_group', $P0
de1f228 @sorear Don't load all of PCT for PCT::HLLCompiler
sorear authored
26 load_bytecode 'PCT/HLLCompiler.pbc'
06c4e6d @jnthn Initial commit of minimally functional Blizkost.
authored
27
995adc3 @sorear Implement get_exports method
sorear authored
28 $P2 = split ' ', '$!interp $!requirer $!export-lister'
4efce50 @sorear Use an actual attribute for the interpreter cache
sorear authored
29
06c4e6d @jnthn Initial commit of minimally functional Blizkost.
authored
30 $P0 = get_root_global ['parrot'], 'P6metaclass'
4efce50 @sorear Use an actual attribute for the interpreter cache
sorear authored
31 $P1 = $P0.'new_class'('Perl5::Compiler', 'parent'=>'PCT::HLLCompiler', 'attr'=>$P2)
06c4e6d @jnthn Initial commit of minimally functional Blizkost.
authored
32 $P1.'language'('perl5')
4efce50 @sorear Use an actual attribute for the interpreter cache
sorear authored
33
4376dfb @jnthn Few tweaks to make sure we more properly fulfil the HLL compiler interfa...
authored
34 $P0 = split ' ', 'make_interp'
06c4e6d @jnthn Initial commit of minimally functional Blizkost.
authored
35 setattribute $P1, '@stages', $P0
36 .end
37
38
39 =item main(args :slurpy) :main
40
41 Start compilation by passing any command line C<args>
42 to the blizkost compiler.
43
44 =cut
45
46 .sub 'main' :main
47 .param pmc args
48
49 $P0 = compreg 'perl5'
50 $P1 = $P0.'command_line'(args)
51 .end
52
4efce50 @sorear Use an actual attribute for the interpreter cache
sorear authored
53 # We maintain one P5Interpreter (Perl heap) per Parrot heap (compreg object),
54 # to avoid suprising duplication. TODO: locking.
55 .sub '!force' :method
995adc3 @sorear Implement get_exports method
sorear authored
56 .local pmc p5i, requirer, exportlister, support
4efce50 @sorear Use an actual attribute for the interpreter cache
sorear authored
57 p5i = getattribute self, "$!interp"
58 unless null p5i goto have_interp
929684b @sorear Eliminate the deparse-reparse from module loading
sorear authored
59
4efce50 @sorear Use an actual attribute for the interpreter cache
sorear authored
60 p5i = new 'P5Interpreter'
61 setattribute self, "$!interp", p5i
929684b @sorear Eliminate the deparse-reparse from module loading
sorear authored
62
995adc3 @sorear Implement get_exports method
sorear authored
63 # unfortunately, the Perl 5 C API only allows making evals in scalar context
64 support = p5i(<<"End_Init_Code")
65 my $req = sub {
66 my ($module_name) = @_;
67 # Yes, this is portable.
68 $module_name =~ s|::|/|g;
69 $module_name .= ".pm";
70 require $module_name;
71 };
72
73 my $explist = sub {
74 my ($module_name, @tags) = @_;
75 # should already be loaded
76 my @output;
77
78 my %sigils = (SCALAR => '$', ARRAY => '@', HASH => '%', IO => '*');
79
80 %Blizkost::ImportZone:: = ();
81 {
82 package Blizkost::ImportZone;
83 $module_name->import(@tags);
84 }
85
86 for my $name (keys %Blizkost::ImportZone::) {
87 my $gref = \$Blizkost::ImportZone::{$name};
88
9dc204c @sorear Fix importing constants from POSIX
sorear authored
89 # Perl5 has a clever feature where a constant subroutine can be
90 # represented by putting a reference in the symbol table instead
91 # of an actual symbol table entry, saving memory and time. Pity
92 # we have to undo it.
93 if (ref($gref)) {
94 my $val = $$gref;
95 push @output, 'sub', $name, sub () { $val };
96 next;
97 }
98
995adc3 @sorear Implement get_exports method
sorear authored
99 my %things;
100
101 for my $type (qw/SCALAR ARRAY HASH IO/) {
102 my $ref = *{$gref}{$type};
103 next unless defined $ref;
104
105 $things{$type} = $ref;
106 }
107
108 if (keys %things > 1) {
109 for my $used_type (keys %things) {
110 push @output, 'var', ($sigils{$used_type} . $name),
111 $things{$used_type};
112 }
113 } elsif (keys %things == 1) {
114 my $used_type = (keys %things)[0];
115 push @output, 'var', $name, $things{$used_type};
116 }
117
118 if (defined *{$gref}{CODE}) {
119 push @output, 'sub', $name, *{$gref}{CODE};
120 }
121 }
122
123 return @output;
124 };
125
126 { requirer => $req, exportlister => $explist };
127 End_Init_Code
128
129 requirer = support["requirer"]
130 exportlister = support["exportlister"]
131
929684b @sorear Eliminate the deparse-reparse from module loading
sorear authored
132 setattribute self, "$!requirer", requirer
995adc3 @sorear Implement get_exports method
sorear authored
133 setattribute self, "$!export-lister", exportlister
929684b @sorear Eliminate the deparse-reparse from module loading
sorear authored
134
4efce50 @sorear Use an actual attribute for the interpreter cache
sorear authored
135 have_interp:
136 .end
06c4e6d @jnthn Initial commit of minimally functional Blizkost.
authored
137
4376dfb @jnthn Few tweaks to make sure we more properly fulfil the HLL compiler interfa...
authored
138 =item make_interp()
06c4e6d @jnthn Initial commit of minimally functional Blizkost.
authored
139
140 =cut
141
4376dfb @jnthn Few tweaks to make sure we more properly fulfil the HLL compiler interfa...
authored
142 .sub 'make_interp' :method
5d2d9e7 @sorear Use a less insane calling convention for eval
sorear authored
143 .param pmc source
06c4e6d @jnthn Initial commit of minimally functional Blizkost.
authored
144 .param pmc adverbs :slurpy :named
145
4efce50 @sorear Use an actual attribute for the interpreter cache
sorear authored
146 self.'!force'()
147
148 .local pmc p5i
149 p5i = getattribute self, "$!interp"
40db1bc @jnthn Improve itnerpreter life cycle management and fix a GC bug.
authored
150
5d2d9e7 @sorear Use a less insane calling convention for eval
sorear authored
151 .lex "$interp", p5i
152 .lex "$code", source
153 .const 'Sub' $P1 = "interp_stub"
352d8b6 @sorear Add a forgotten newclosure
sorear authored
154 $P1 = newclosure $P1
5d2d9e7 @sorear Use a less insane calling convention for eval
sorear authored
155 capture_lex $P1
156 .return ($P1)
06c4e6d @jnthn Initial commit of minimally functional Blizkost.
authored
157 .end
158
5d2d9e7 @sorear Use a less insane calling convention for eval
sorear authored
159 .sub "interp_stub" :anon :outer("make_interp")
160 $P0 = find_lex "$interp"
161 $P1 = find_lex "$code"
162 .tailcall $P0($P1)
163 .end
4376dfb @jnthn Few tweaks to make sure we more properly fulfil the HLL compiler interfa...
authored
164
165 =item eval
166
167 =cut
168
169 .sub 'eval' :method
170 .param pmc code
171 .param pmc args :slurpy
172 .param pmc adverbs :slurpy :named
4efce50 @sorear Use an actual attribute for the interpreter cache
sorear authored
173
0cc6ea1 @cognominal Creation of dummy pmcs that will wrap Perl5 SVs, AVs and HVs
cognominal authored
174 $P0 = self.'compile'(code, adverbs :flat :named)
3f144cd @sorear Actually use tailcalls instead of slurpy return copying...
sorear authored
175 .tailcall $P0()
d3292fd @jnthn Almost certainly epicly buggy first cut of marshalling and handing back ...
authored
176 .end
177
5145ceb @sorear Switch to PDD-31 style load_module
sorear authored
178 =item load_module(name)
0d25067 @jnthn Add a stub that gives a nicer error if you try and load a Perl 5 module.
authored
179
5145ceb @sorear Switch to PDD-31 style load_module
sorear authored
180 =item get_module(name)
181
182 Implements the PDD-31 library loading interface.
0d25067 @jnthn Add a stub that gives a nicer error if you try and load a Perl 5 module.
authored
183
184 =cut
185
5145ceb @sorear Switch to PDD-31 style load_module
sorear authored
186 .sub 'load_module' :method
187 .param pmc name_str
0d25067 @jnthn Add a stub that gives a nicer error if you try and load a Perl 5 module.
authored
188 .param pmc extra :named :slurpy
3891cf4 @jnthn First cut of library loading, and also support for calling a method on a...
authored
189
929684b @sorear Eliminate the deparse-reparse from module loading
sorear authored
190 self.'!force'()
191 $P0 = getattribute self, '$!requirer'
192 $P0(name_str)
3891cf4 @jnthn First cut of library loading, and also support for calling a method on a...
authored
193
5145ceb @sorear Switch to PDD-31 style load_module
sorear authored
194 .return (name_str)
195 .end
196
197 .sub 'get_module' :method
198 .param pmc name_str
199
200 .return (name_str)
0d25067 @jnthn Add a stub that gives a nicer error if you try and load a Perl 5 module.
authored
201 .end
202
c389906 @sorear Implement foreign namespace protocol
sorear authored
203 .sub 'get_namespace' :method
204 .param pmc name
205
206 self.'!force'()
207
208 $P0 = getattribute self, '$!interp'
209 $P0 = $P0.'get_namespace'(name)
210
211 .return($P0)
212 .end
213
995adc3 @sorear Implement get_exports method
sorear authored
214 .sub 'get_exports' :method
215 .param pmc module_name
216 .param pmc imports :slurpy
217
218 self.'!force'()
219
220 .local pmc expiter, expout
221
222 $P0 = getattribute self, '$!export-lister'
223 ($P0 :slurpy) = $P0(module_name, imports :flat)
224 expiter = iter $P0
225
226 expout = new 'Hash'
227 $P0 = new 'Hash'
228 expout["sub"] = $P0
229 $P0 = new 'Hash'
230 expout["var"] = $P0
231
232 again:
233 unless expiter, the_end
234
235 $P1 = shift expiter
236 $P0 = expout[$P1]
237
238 $P1 = shift expiter
239 $P2 = shift expiter
240 $P0[$P1] = $P2
241
242 goto again
243
244 the_end:
245 .return(expout)
246 .end
247
06c4e6d @jnthn Initial commit of minimally functional Blizkost.
authored
248 =back
249
250 =cut
251
252 # Local Variables:
253 # mode: pir
254 # fill-column: 100
255 # End:
256 # vim: expandtab shiftwidth=4 ft=pir:
257
Something went wrong with that request. Please try again.