This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Byteloader patching from Enache continues;
[perl5.git] / bytecode.pl
CommitLineData
73f0cc2d
GS
1BEGIN {
2 push @INC, './lib';
9ad884cb 3 require 'regen_lib.pl';
73f0cc2d 4}
a8a597b2
MB
5use strict;
6my %alias_to = (
ca337316 7 U32 => [qw(STRLEN line_t)],
d5e9ef99 8 I32 => [qw(SSize_t long)],
dea28490 9 U16 => [qw(OPCODE short)],
d5e9ef99 10 U8 => [qw(char)],
a8a597b2
MB
11);
12
7934575e 13my @optype= qw(OP UNOP BINOP LOGOP LISTOP PMOP SVOP PADOP PVOP LOOP COP);
a8a597b2
MB
14
15# Nullsv *must* come first in the following so that the condition
16# ($$sv == 0) can continue to be used to test (sv == Nullsv).
059a8bb7 17my @specialsv = qw(Nullsv &PL_sv_undef &PL_sv_yes &PL_sv_no pWARN_ALL pWARN_NONE);
a8a597b2
MB
18
19my (%alias_from, $from, $tos);
20while (($from, $tos) = each %alias_to) {
21 map { $alias_from{$_} = $from } @$tos;
22}
23
24my $c_header = <<'EOT';
25/*
4eb8286e 26 * Copyright (c) 1996-1999 Malcolm Beattie
a8a597b2
MB
27 *
28 * You may distribute under the terms of either the GNU General Public
29 * License or the Artistic License, as specified in the README file.
30 *
31 */
32/*
33 * This file is autogenerated from bytecode.pl. Changes made here will be lost.
34 */
35EOT
36
37my $perl_header;
38($perl_header = $c_header) =~ s{[/ ]?\*/?}{#}g;
39
36bb303b 40safer_unlink "ext/ByteLoader/byterun.c", "ext/ByteLoader/byterun.h", "ext/B/B/Asmdata.pm";
a8a597b2
MB
41
42#
43# Start with boilerplate for Asmdata.pm
44#
33b839e2 45open(ASMDATA_PM, ">ext/B/B/Asmdata.pm") or die "ext/B/B/Asmdata.pm: $!";
a8a597b2
MB
46print ASMDATA_PM $perl_header, <<'EOT';
47package B::Asmdata;
28b605d8 48
a0edd7f8 49our $VERSION = '1.01';
28b605d8 50
a8a597b2
MB
51use Exporter;
52@ISA = qw(Exporter);
53@EXPORT_OK = qw(%insn_data @insn_name @optype @specialsv_name);
1b11e67e 54our(%insn_data, @insn_name, @optype, @specialsv_name);
a8a597b2
MB
55
56EOT
57print ASMDATA_PM <<"EOT";
58\@optype = qw(@optype);
59\@specialsv_name = qw(@specialsv);
60
61# XXX insn_data is initialised this way because with a large
62# %insn_data = (foo => [...], bar => [...], ...) initialiser
63# I get a hard-to-track-down stack underflow and segfault.
64EOT
65
66#
67# Boilerplate for byterun.c
68#
e8edd1e6 69open(BYTERUN_C, ">ext/ByteLoader/byterun.c") or die "ext/ByteLoader/byterun.c: $!";
a8a597b2
MB
70print BYTERUN_C $c_header, <<'EOT';
71
c5be433b 72#define PERL_NO_GET_CONTEXT
a8a597b2
MB
73#include "EXTERN.h"
74#include "perl.h"
0cb96387
GS
75#define NO_XSLOCKS
76#include "XSUB.h"
77
e8edd1e6
TH
78#include "byterun.h"
79#include "bytecode.h"
80
0cb96387 81
059a8bb7 82static const int optype_size[] = {
e8edd1e6
TH
83EOT
84my $i = 0;
85for ($i = 0; $i < @optype - 1; $i++) {
86 printf BYTERUN_C " sizeof(%s),\n", $optype[$i], $i;
87}
88printf BYTERUN_C " sizeof(%s)\n", $optype[$i], $i;
89print BYTERUN_C <<'EOT';
90};
91
d613ef02 92void *
acfe0abc 93bset_obj_store(pTHX_ struct byteloader_state *bstate, void *obj, I32 ix)
d613ef02 94{
059a8bb7
JH
95 if (ix > bstate->bs_obj_list_fill) {
96 Renew(bstate->bs_obj_list, ix + 32, void*);
97 bstate->bs_obj_list_fill = ix + 31;
d613ef02 98 }
059a8bb7 99 bstate->bs_obj_list[ix] = obj;
d613ef02
GS
100 return obj;
101}
a8a597b2 102
1df34986 103int
acfe0abc 104byterun(pTHX_ register struct byteloader_state *bstate)
a8a597b2 105{
059a8bb7
JH
106 register int insn;
107 U32 ix;
108 SV *specialsv_list[6];
109
110 BYTECODE_HEADER_CHECK; /* croak if incorrect platform */
111 New(666, bstate->bs_obj_list, 32, void*); /* set op objlist */
112 bstate->bs_obj_list_fill = 31;
1df34986 113 bstate->bs_obj_list[0] = NULL; /* first is always Null */
566ece03 114 bstate->bs_ix = 1;
e8edd1e6
TH
115
116EOT
117
e3751d82 118for my $i ( 0 .. $#specialsv ) {
e8edd1e6
TH
119 print BYTERUN_C " specialsv_list[$i] = $specialsv[$i];\n";
120}
121
122print BYTERUN_C <<'EOT';
123
47358472 124 while ((insn = BGET_FGETC()) != EOF) {
a8a597b2
MB
125 switch (insn) {
126EOT
127
128
129my (@insn_name, $insn_num, $insn, $lvalue, $argtype, $flags, $fundtype);
130
131while (<DATA>) {
1df34986
AE
132 if (/^\s*#/) {
133 print BYTERUN_C if /^\s*#\s*(?:if|endif|el)/;
134 next;
135 }
a8a597b2 136 chop;
a8a597b2
MB
137 next unless length;
138 if (/^%number\s+(.*)/) {
139 $insn_num = $1;
140 next;
141 } elsif (/%enum\s+(.*?)\s+(.*)/) {
142 create_enum($1, $2); # must come before instructions
143 next;
144 }
145 ($insn, $lvalue, $argtype, $flags) = split;
b97332e7
JH
146 my $rvalcast = '';
147 if ($argtype =~ m:(.+)/(.+):) {
148 ($rvalcast, $argtype) = ("($1)", $2);
149 }
a8a597b2
MB
150 $insn_name[$insn_num] = $insn;
151 $fundtype = $alias_from{$argtype} || $argtype;
152
153 #
154 # Add the case statement and code for the bytecode interpreter in byterun.c
155 #
156 printf BYTERUN_C "\t case INSN_%s:\t\t/* %d */\n\t {\n",
157 uc($insn), $insn_num;
158 my $optarg = $argtype eq "none" ? "" : ", arg";
159 if ($optarg) {
160 printf BYTERUN_C "\t\t$argtype arg;\n\t\tBGET_%s(arg);\n", $fundtype;
161 }
162 if ($flags =~ /x/) {
163 print BYTERUN_C "\t\tBSET_$insn($lvalue$optarg);\n";
164 } elsif ($flags =~ /s/) {
e8edd1e6 165 # Store instructions store to bytecode_obj_list[arg]. "lvalue" field is rvalue.
a8a597b2
MB
166 print BYTERUN_C "\t\tBSET_OBJ_STORE($lvalue$optarg);\n";
167 }
168 elsif ($optarg && $lvalue ne "none") {
b97332e7 169 print BYTERUN_C "\t\t$lvalue = ${rvalcast}arg;\n";
a8a597b2
MB
170 }
171 print BYTERUN_C "\t\tbreak;\n\t }\n";
172
173 #
174 # Add the initialiser line for %insn_data in Asmdata.pm
175 #
176 print ASMDATA_PM <<"EOT";
177\$insn_data{$insn} = [$insn_num, \\&PUT_$fundtype, "GET_$fundtype"];
178EOT
179
180 # Find the next unused instruction number
181 do { $insn_num++ } while $insn_name[$insn_num];
182}
183
184#
185# Finish off byterun.c
186#
187print BYTERUN_C <<'EOT';
188 default:
cea2e8a9 189 Perl_croak(aTHX_ "Illegal bytecode instruction %d\n", insn);
a8a597b2
MB
190 /* NOTREACHED */
191 }
192 }
1df34986 193 return 0;
a8a597b2
MB
194}
195EOT
196
197#
198# Write the instruction and optype enum constants into byterun.h
199#
e8edd1e6 200open(BYTERUN_H, ">ext/ByteLoader/byterun.h") or die "ext/ByteLoader/byterun.h: $!";
a8a597b2 201print BYTERUN_H $c_header, <<'EOT';
059a8bb7
JH
202struct byteloader_fdata {
203 SV *datasv;
204 int next_out;
205 int idx;
a8a597b2 206};
a8a597b2 207
059a8bb7
JH
208struct byteloader_state {
209 struct byteloader_fdata *bs_fdata;
210 SV *bs_sv;
211 void **bs_obj_list;
212 int bs_obj_list_fill;
566ece03 213 int bs_ix;
059a8bb7
JH
214 XPV bs_pv;
215 int bs_iv_overflows;
216};
217
218int bl_getc(struct byteloader_fdata *);
219int bl_read(struct byteloader_fdata *, char *, size_t, size_t);
1df34986 220extern int byterun(pTHX_ struct byteloader_state *);
059a8bb7 221
a8a597b2
MB
222enum {
223EOT
224
a8a597b2
MB
225my $add_enum_value = 0;
226my $max_insn;
e3751d82 227for $i ( 0 .. $#insn_name ) {
a8a597b2
MB
228 $insn = uc($insn_name[$i]);
229 if (defined($insn)) {
230 $max_insn = $i;
231 if ($add_enum_value) {
232 print BYTERUN_H " INSN_$insn = $i,\t\t\t/* $i */\n";
233 $add_enum_value = 0;
234 } else {
235 print BYTERUN_H " INSN_$insn,\t\t\t/* $i */\n";
236 }
237 } else {
238 $add_enum_value = 1;
239 }
240}
241
242print BYTERUN_H " MAX_INSN = $max_insn\n};\n";
243
244print BYTERUN_H "\nenum {\n";
245for ($i = 0; $i < @optype - 1; $i++) {
246 printf BYTERUN_H " OPt_%s,\t\t/* %d */\n", $optype[$i], $i;
247}
248printf BYTERUN_H " OPt_%s\t\t/* %d */\n};\n\n", $optype[$i], $i;
a8a597b2 249
a8a597b2
MB
250#
251# Finish off insn_data and create array initialisers in Asmdata.pm
252#
253print ASMDATA_PM <<'EOT';
254
255my ($insn_name, $insn_data);
256while (($insn_name, $insn_data) = each %insn_data) {
257 $insn_name[$insn_data->[0]] = $insn_name;
258}
259# Fill in any gaps
260@insn_name = map($_ || "unused", @insn_name);
261
2621;
42d3a99d
GS
263
264__END__
265
266=head1 NAME
267
268B::Asmdata - Autogenerated data about Perl ops, used to generate bytecode
269
270=head1 SYNOPSIS
271
4162ffa6 272 use B::Asmdata qw(%insn_data @insn_name @optype @specialsv_name);
42d3a99d
GS
273
274=head1 DESCRIPTION
275
4162ffa6
MS
276Provides information about Perl ops in order to generate bytecode via
277a bunch of exported variables. Its mostly used by B::Assembler and
278B::Disassembler.
279
280=over 4
281
282=item %insn_data
283
284 my($bytecode_num, $put_sub, $get_meth) = @$insn_data{$op_name};
285
286For a given $op_name (for example, 'cop_label', 'sv_flags', etc...)
287you get an array ref containing the bytecode number of the op, a
288reference to the subroutine used to 'PUT', and the name of the method
289used to 'GET'.
290
291=for _private
292Add more detail about what $put_sub and $get_meth are and how to use them.
293
294=item @insn_name
295
296 my $op_name = $insn_name[$bytecode_num];
297
298A simple mapping of the bytecode number to the name of the op.
299Suitable for using with %insn_data like so:
300
301 my $op_info = $insn_data{$insn_name[$bytecode_num]};
302
303=item @optype
304
305 my $op_type = $optype[$op_type_num];
306
307A simple mapping of the op type number to its type (like 'COP' or 'BINOP').
308
309=item @specialsv_name
310
311 my $sv_name = $specialsv_name[$sv_index];
312
313Certain SV types are considered 'special'. They're represented by
314B::SPECIAL and are refered to by a number from the specialsv_list.
315This array maps that number back to the name of the SV (like 'Nullsv'
316or '&PL_sv_undef').
317
318=back
42d3a99d
GS
319
320=head1 AUTHOR
321
322Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
323
324=cut
a8a597b2
MB
325EOT
326
36bb303b
NC
327
328close ASMDATA_PM or die "Error closing ASMDATA_PM: $!";
329close BYTERUN_H or die "Error closing BYTERUN_H: $!";
330close BYTERUN_C or die "Error closing BYTERUN_C: $!";
331
a8a597b2
MB
332__END__
333# First set instruction ord("#") to read comment to end-of-line (sneaky)
334%number 35
fe3a57c4 335comment arg comment_t
a8a597b2
MB
336# Then make ord("\n") into a no-op
337%number 10
338nop none none
1df34986 339
a8a597b2
MB
340# Now for the rest of the ordinary ones, beginning with \0 which is
341# ret so that \0-terminated strings can be read properly as bytecode.
342%number 0
343#
b97332e7
JH
344# The argtype is either a single type or "rightvaluecast/argtype".
345#
92742e37 346#opcode lvalue argtype flags
a8a597b2 347#
92742e37 348ret none none x
059a8bb7 349ldsv bstate->bs_sv svindex
92742e37 350ldop PL_op opindex
059a8bb7 351stsv bstate->bs_sv U32 s
92742e37 352stop PL_op U32 s
059a8bb7
JH
353stpv bstate->bs_pv.xpv_pv U32 x
354ldspecsv bstate->bs_sv U8 x
566ece03 355ldspecsvx bstate->bs_sv U8 x
059a8bb7 356newsv bstate->bs_sv U8 x
566ece03 357newsvx bstate->bs_sv U32 x
92742e37 358newop PL_op U8 x
566ece03 359newopx PL_op U16 x
92742e37
GS
360newopn PL_op U8 x
361newpv none PV
059a8bb7
JH
362pv_cur bstate->bs_pv.xpv_cur STRLEN
363pv_free bstate->bs_pv none x
6e21dc91 364sv_upgrade bstate->bs_sv U8 x
059a8bb7
JH
365sv_refcnt SvREFCNT(bstate->bs_sv) U32
366sv_refcnt_add SvREFCNT(bstate->bs_sv) I32 x
367sv_flags SvFLAGS(bstate->bs_sv) U32
368xrv SvRV(bstate->bs_sv) svindex
369xpv bstate->bs_sv none x
1df34986
AE
370xpv_cur SvCUR(bstate->bs_sv) STRLEN
371xpv_len SvLEN(bstate->bs_sv) STRLEN
372xiv SvIVX(bstate->bs_sv) IV
059a8bb7
JH
373xnv SvNVX(bstate->bs_sv) NV
374xlv_targoff LvTARGOFF(bstate->bs_sv) STRLEN
375xlv_targlen LvTARGLEN(bstate->bs_sv) STRLEN
376xlv_targ LvTARG(bstate->bs_sv) svindex
377xlv_type LvTYPE(bstate->bs_sv) char
378xbm_useful BmUSEFUL(bstate->bs_sv) I32
379xbm_previous BmPREVIOUS(bstate->bs_sv) U16
380xbm_rare BmRARE(bstate->bs_sv) U8
11a7ac70
JH
381xfm_lines FmLINES(bstate->bs_sv) IV
382xio_lines IoLINES(bstate->bs_sv) IV
383xio_page IoPAGE(bstate->bs_sv) IV
384xio_page_len IoPAGE_LEN(bstate->bs_sv) IV
385xio_lines_left IoLINES_LEFT(bstate->bs_sv) IV
1df34986 386xio_top_name IoTOP_NAME(bstate->bs_sv) pvindex
059a8bb7 387xio_top_gv *(SV**)&IoTOP_GV(bstate->bs_sv) svindex
1df34986 388xio_fmt_name IoFMT_NAME(bstate->bs_sv) pvindex
059a8bb7 389xio_fmt_gv *(SV**)&IoFMT_GV(bstate->bs_sv) svindex
1df34986 390xio_bottom_name IoBOTTOM_NAME(bstate->bs_sv) pvindex
059a8bb7
JH
391xio_bottom_gv *(SV**)&IoBOTTOM_GV(bstate->bs_sv) svindex
392xio_subprocess IoSUBPROCESS(bstate->bs_sv) short
393xio_type IoTYPE(bstate->bs_sv) char
394xio_flags IoFLAGS(bstate->bs_sv) char
1df34986 395xcv_xsubany *(SV**)&CvXSUBANY(bstate->bs_sv).any_ptr svindex
059a8bb7
JH
396xcv_stash *(SV**)&CvSTASH(bstate->bs_sv) svindex
397xcv_start CvSTART(bstate->bs_sv) opindex
398xcv_root CvROOT(bstate->bs_sv) opindex
399xcv_gv *(SV**)&CvGV(bstate->bs_sv) svindex
400xcv_file CvFILE(bstate->bs_sv) pvindex
401xcv_depth CvDEPTH(bstate->bs_sv) long
402xcv_padlist *(SV**)&CvPADLIST(bstate->bs_sv) svindex
403xcv_outside *(SV**)&CvOUTSIDE(bstate->bs_sv) svindex
f52873be 404xcv_outside_seq CvOUTSIDE_SEQ(bstate->bs_sv) U32
059a8bb7
JH
405xcv_flags CvFLAGS(bstate->bs_sv) U16
406av_extend bstate->bs_sv SSize_t x
1df34986 407av_pushx bstate->bs_sv svindex x
059a8bb7
JH
408av_push bstate->bs_sv svindex x
409xav_fill AvFILLp(bstate->bs_sv) SSize_t
410xav_max AvMAX(bstate->bs_sv) SSize_t
411xav_flags AvFLAGS(bstate->bs_sv) U8
412xhv_riter HvRITER(bstate->bs_sv) I32
1df34986
AE
413xhv_name HvNAME(bstate->bs_sv) pvindex
414xhv_pmroot *(OP**)&HvPMROOT(bstate->bs_sv) opindex
059a8bb7
JH
415hv_store bstate->bs_sv svindex x
416sv_magic bstate->bs_sv char x
417mg_obj SvMAGIC(bstate->bs_sv)->mg_obj svindex
418mg_private SvMAGIC(bstate->bs_sv)->mg_private U16
419mg_flags SvMAGIC(bstate->bs_sv)->mg_flags U8
1df34986
AE
420mg_name SvMAGIC(bstate->bs_sv) pvcontents x
421mg_namex SvMAGIC(bstate->bs_sv) svindex x
059a8bb7
JH
422xmg_stash *(SV**)&SvSTASH(bstate->bs_sv) svindex
423gv_fetchpv bstate->bs_sv strconst x
566ece03 424gv_fetchpvx bstate->bs_sv strconst x
059a8bb7 425gv_stashpv bstate->bs_sv strconst x
566ece03 426gv_stashpvx bstate->bs_sv strconst x
059a8bb7
JH
427gp_sv GvSV(bstate->bs_sv) svindex
428gp_refcnt GvREFCNT(bstate->bs_sv) U32
429gp_refcnt_add GvREFCNT(bstate->bs_sv) I32 x
430gp_av *(SV**)&GvAV(bstate->bs_sv) svindex
431gp_hv *(SV**)&GvHV(bstate->bs_sv) svindex
432gp_cv *(SV**)&GvCV(bstate->bs_sv) svindex
433gp_file GvFILE(bstate->bs_sv) pvindex
434gp_io *(SV**)&GvIOp(bstate->bs_sv) svindex
435gp_form *(SV**)&GvFORM(bstate->bs_sv) svindex
436gp_cvgen GvCVGEN(bstate->bs_sv) U32
437gp_line GvLINE(bstate->bs_sv) line_t
438gp_share bstate->bs_sv svindex x
439xgv_flags GvFLAGS(bstate->bs_sv) U8
92742e37
GS
440op_next PL_op->op_next opindex
441op_sibling PL_op->op_sibling opindex
442op_ppaddr PL_op->op_ppaddr strconst x
443op_targ PL_op->op_targ PADOFFSET
444op_type PL_op OPCODE x
445op_seq PL_op->op_seq U16
446op_flags PL_op->op_flags U8
447op_private PL_op->op_private U8
448op_first cUNOP->op_first opindex
449op_last cBINOP->op_last opindex
450op_other cLOGOP->op_other opindex
92742e37 451op_pmreplroot cPMOP->op_pmreplroot opindex
92742e37
GS
452op_pmreplstart cPMOP->op_pmreplstart opindex
453op_pmnext *(OP**)&cPMOP->op_pmnext opindex
1df34986
AE
454#ifdef USE_ITHREADS
455op_pmstashpv cPMOP->op_pmstashpv pvindex
b97332e7 456op_pmreplrootpo cPMOP->op_pmreplroot OP*/PADOFFSET
1df34986
AE
457#else
458op_pmstash *(SV**)&cPMOP->op_pmstash svindex
459op_pmreplrootgv *(SV**)&cPMOP->op_pmreplroot svindex
460#endif
92742e37
GS
461pregcomp PL_op pvcontents x
462op_pmflags cPMOP->op_pmflags U16
463op_pmpermflags cPMOP->op_pmpermflags U16
1df34986 464op_pmdynflags cPMOP->op_pmdynflags U8
92742e37 465op_sv cSVOP->op_sv svindex
7934575e 466op_padix cPADOP->op_padix PADOFFSET
92742e37
GS
467op_pv cPVOP->op_pv pvcontents
468op_pv_tr cPVOP->op_pv op_tr_array
469op_redoop cLOOP->op_redoop opindex
470op_nextop cLOOP->op_nextop opindex
471op_lastop cLOOP->op_lastop opindex
059a8bb7 472cop_label cCOP->cop_label pvindex
1df34986 473#ifdef USE_ITHREADS
059a8bb7
JH
474cop_stashpv cCOP pvindex x
475cop_file cCOP pvindex x
1df34986
AE
476#else
477cop_stash cCOP svindex x
478cop_filegv cCOP svindex x
479#endif
92742e37
GS
480cop_seq cCOP->cop_seq U32
481cop_arybase cCOP->cop_arybase I32
1df34986
AE
482cop_line cCOP->cop_line line_t
483cop_io cCOP->cop_io svindex
b295d113 484cop_warnings cCOP->cop_warnings svindex
92742e37
GS
485main_start PL_main_start opindex
486main_root PL_main_root opindex
1df34986 487main_cv *(SV**)&PL_main_cv svindex
92742e37 488curpad PL_curpad svindex x
059a8bb7
JH
489push_begin PL_beginav svindex x
490push_init PL_initav svindex x
491push_end PL_endav svindex x
1df34986
AE
492curstash *(SV**)&PL_curstash svindex
493defstash *(SV**)&PL_defstash svindex
494data none U8 x
0ac16f7c 495incav *(SV**)&GvAV(PL_incgv) svindex
1df34986
AE
496load_glob none svindex x
497#ifdef USE_ITHREADS
498regex_padav *(SV**)&PL_regex_padav svindex
499#endif
500dowarn PL_dowarn U8
501comppad_name *(SV**)&PL_comppad_name svindex
502xgv_stash *(SV**)&GvSTASH(bstate->bs_sv) svindex
503signal bstate->bs_sv strconst x
504# to be removed
505formfeed PL_formfeed svindex