source: trunk/third/perl/bytecode.pl @ 18450

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