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

Revision 17035, 11.3 KB checked in by zacheiss, 22 years ago (diff)
This commit was generated by cvs2svn to compensate for changes in r17034, 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;
47use Exporter;
48@ISA = qw(Exporter);
49@EXPORT_OK = qw(%insn_data @insn_name @optype @specialsv_name);
50our(%insn_data, @insn_name, @optype, @specialsv_name);
51
52EOT
53print ASMDATA_PM <<"EOT";
54\@optype = qw(@optype);
55\@specialsv_name = qw(@specialsv);
56
57# XXX insn_data is initialised this way because with a large
58# %insn_data = (foo => [...], bar => [...], ...) initialiser
59# I get a hard-to-track-down stack underflow and segfault.
60EOT
61
62#
63# Boilerplate for byterun.c
64#
65open(BYTERUN_C, ">ext/ByteLoader/byterun.c") or die "ext/ByteLoader/byterun.c: $!";
66print BYTERUN_C $c_header, <<'EOT';
67
68#define PERL_NO_GET_CONTEXT
69#include "EXTERN.h"
70#include "perl.h"
71#define NO_XSLOCKS
72#include "XSUB.h"
73
74#ifdef PERL_OBJECT
75#undef CALL_FPTR
76#define CALL_FPTR(fptr) (pPerl->*fptr)
77#undef PL_ppaddr
78#define PL_ppaddr (*get_ppaddr())
79#endif
80
81#include "byterun.h"
82#include "bytecode.h"
83
84
85static const int optype_size[] = {
86EOT
87my $i = 0;
88for ($i = 0; $i < @optype - 1; $i++) {
89    printf BYTERUN_C "    sizeof(%s),\n", $optype[$i], $i;
90}
91printf BYTERUN_C "    sizeof(%s)\n", $optype[$i], $i;
92print BYTERUN_C <<'EOT';
93};
94
95void *
96bset_obj_store(pTHXo_ struct byteloader_state *bstate, void *obj, I32 ix)
97{
98    if (ix > bstate->bs_obj_list_fill) {
99        Renew(bstate->bs_obj_list, ix + 32, void*);
100        bstate->bs_obj_list_fill = ix + 31;
101    }
102    bstate->bs_obj_list[ix] = obj;
103    return obj;
104}
105
106void
107byterun(pTHXo_ register struct byteloader_state *bstate)
108{
109    register int insn;
110    U32 ix;
111    SV *specialsv_list[6];
112
113    BYTECODE_HEADER_CHECK;      /* croak if incorrect platform */
114    New(666, bstate->bs_obj_list, 32, void*); /* set op objlist */
115    bstate->bs_obj_list_fill = 31;
116
117EOT
118
119for (my $i = 0; $i < @specialsv; $i++) {
120    print BYTERUN_C "    specialsv_list[$i] = $specialsv[$i];\n";
121}
122
123print BYTERUN_C <<'EOT';
124
125    while ((insn = BGET_FGETC()) != EOF) {
126        switch (insn) {
127EOT
128
129
130my (@insn_name, $insn_num, $insn, $lvalue, $argtype, $flags, $fundtype);
131
132while (<DATA>) {
133    chop;
134    s/#.*//;                    # remove comments
135    next unless length;
136    if (/^%number\s+(.*)/) {
137        $insn_num = $1;
138        next;
139    } elsif (/%enum\s+(.*?)\s+(.*)/) {
140        create_enum($1, $2);    # must come before instructions
141        next;
142    }
143    ($insn, $lvalue, $argtype, $flags) = split;
144    $insn_name[$insn_num] = $insn;
145    $fundtype = $alias_from{$argtype} || $argtype;
146
147    #
148    # Add the case statement and code for the bytecode interpreter in byterun.c
149    #
150    printf BYTERUN_C "\t  case INSN_%s:\t\t/* %d */\n\t    {\n",
151        uc($insn), $insn_num;
152    my $optarg = $argtype eq "none" ? "" : ", arg";
153    if ($optarg) {
154        printf BYTERUN_C "\t\t$argtype arg;\n\t\tBGET_%s(arg);\n", $fundtype;
155    }
156    if ($flags =~ /x/) {
157        print BYTERUN_C "\t\tBSET_$insn($lvalue$optarg);\n";
158    } elsif ($flags =~ /s/) {
159        # Store instructions store to bytecode_obj_list[arg]. "lvalue" field is rvalue.
160        print BYTERUN_C "\t\tBSET_OBJ_STORE($lvalue$optarg);\n";
161    }
162    elsif ($optarg && $lvalue ne "none") {
163        print BYTERUN_C "\t\t$lvalue = arg;\n";
164    }
165    print BYTERUN_C "\t\tbreak;\n\t    }\n";
166
167    #
168    # Add the initialiser line for %insn_data in Asmdata.pm
169    #
170    print ASMDATA_PM <<"EOT";
171\$insn_data{$insn} = [$insn_num, \\&PUT_$fundtype, "GET_$fundtype"];
172EOT
173
174    # Find the next unused instruction number
175    do { $insn_num++ } while $insn_name[$insn_num];
176}
177
178#
179# Finish off byterun.c
180#
181print BYTERUN_C <<'EOT';
182          default:
183            Perl_croak(aTHX_ "Illegal bytecode instruction %d\n", insn);
184            /* NOTREACHED */
185        }
186    }
187}
188EOT
189
190#
191# Write the instruction and optype enum constants into byterun.h
192#
193open(BYTERUN_H, ">ext/ByteLoader/byterun.h") or die "ext/ByteLoader/byterun.h: $!";
194print BYTERUN_H $c_header, <<'EOT';
195struct byteloader_fdata {
196    SV  *datasv;
197    int next_out;
198    int idx;
199};
200
201struct byteloader_state {
202    struct byteloader_fdata     *bs_fdata;
203    SV                          *bs_sv;
204    void                        **bs_obj_list;
205    int                         bs_obj_list_fill;
206    XPV                         bs_pv;
207    int                         bs_iv_overflows;
208};
209
210int bl_getc(struct byteloader_fdata *);
211int bl_read(struct byteloader_fdata *, char *, size_t, size_t);
212extern void byterun(pTHXo_ struct byteloader_state *);
213
214enum {
215EOT
216
217my $add_enum_value = 0;
218my $max_insn;
219for ($i = 0; $i < @insn_name; $i++) {
220    $insn = uc($insn_name[$i]);
221    if (defined($insn)) {
222        $max_insn = $i;
223        if ($add_enum_value) {
224            print BYTERUN_H "    INSN_$insn = $i,\t\t\t/* $i */\n";
225            $add_enum_value = 0;
226        } else {
227            print BYTERUN_H "    INSN_$insn,\t\t\t/* $i */\n";
228        }
229    } else {
230        $add_enum_value = 1;
231    }
232}
233
234print BYTERUN_H "    MAX_INSN = $max_insn\n};\n";
235
236print BYTERUN_H "\nenum {\n";
237for ($i = 0; $i < @optype - 1; $i++) {
238    printf BYTERUN_H "    OPt_%s,\t\t/* %d */\n", $optype[$i], $i;
239}
240printf BYTERUN_H "    OPt_%s\t\t/* %d */\n};\n\n", $optype[$i], $i;
241
242#
243# Finish off insn_data and create array initialisers in Asmdata.pm
244#
245print ASMDATA_PM <<'EOT';
246
247my ($insn_name, $insn_data);
248while (($insn_name, $insn_data) = each %insn_data) {
249    $insn_name[$insn_data->[0]] = $insn_name;
250}
251# Fill in any gaps
252@insn_name = map($_ || "unused", @insn_name);
253
2541;
255
256__END__
257
258=head1 NAME
259
260B::Asmdata - Autogenerated data about Perl ops, used to generate bytecode
261
262=head1 SYNOPSIS
263
264        use Asmdata;
265
266=head1 DESCRIPTION
267
268See F<ext/B/B/Asmdata.pm>.
269
270=head1 AUTHOR
271
272Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
273
274=cut
275EOT
276
277__END__
278# First set instruction ord("#") to read comment to end-of-line (sneaky)
279%number 35
280comment         arg                     comment_t
281# Then make ord("\n") into a no-op
282%number 10
283nop             none                    none
284# Now for the rest of the ordinary ones, beginning with \0 which is
285# ret so that \0-terminated strings can be read properly as bytecode.
286%number 0
287#
288#opcode         lvalue                                  argtype         flags   
289#
290ret             none                                    none            x
291ldsv            bstate->bs_sv                           svindex
292ldop            PL_op                                   opindex
293stsv            bstate->bs_sv                           U32             s
294stop            PL_op                                   U32             s
295stpv            bstate->bs_pv.xpv_pv                    U32             x
296ldspecsv        bstate->bs_sv                           U8              x
297newsv           bstate->bs_sv                           U8              x
298newop           PL_op                                   U8              x
299newopn          PL_op                                   U8              x
300newpv           none                                    PV
301pv_cur          bstate->bs_pv.xpv_cur                   STRLEN
302pv_free         bstate->bs_pv                           none            x
303sv_upgrade      bstate->bs_sv                           char            x
304sv_refcnt       SvREFCNT(bstate->bs_sv)                 U32
305sv_refcnt_add   SvREFCNT(bstate->bs_sv)                 I32             x
306sv_flags        SvFLAGS(bstate->bs_sv)                  U32
307xrv             SvRV(bstate->bs_sv)                     svindex
308xpv             bstate->bs_sv                           none            x
309xiv32           SvIVX(bstate->bs_sv)                    I32
310xiv64           SvIVX(bstate->bs_sv)                    IV64
311xnv             SvNVX(bstate->bs_sv)                    NV
312xlv_targoff     LvTARGOFF(bstate->bs_sv)                STRLEN
313xlv_targlen     LvTARGLEN(bstate->bs_sv)                STRLEN
314xlv_targ        LvTARG(bstate->bs_sv)                   svindex
315xlv_type        LvTYPE(bstate->bs_sv)                   char
316xbm_useful      BmUSEFUL(bstate->bs_sv)                 I32
317xbm_previous    BmPREVIOUS(bstate->bs_sv)               U16
318xbm_rare        BmRARE(bstate->bs_sv)                   U8
319xfm_lines       FmLINES(bstate->bs_sv)                  I32
320xio_lines       IoLINES(bstate->bs_sv)                  long
321xio_page        IoPAGE(bstate->bs_sv)                   long
322xio_page_len    IoPAGE_LEN(bstate->bs_sv)               long
323xio_lines_left  IoLINES_LEFT(bstate->bs_sv)             long
324xio_top_name    IoTOP_NAME(bstate->bs_sv)               pvcontents
325xio_top_gv      *(SV**)&IoTOP_GV(bstate->bs_sv)         svindex
326xio_fmt_name    IoFMT_NAME(bstate->bs_sv)               pvcontents
327xio_fmt_gv      *(SV**)&IoFMT_GV(bstate->bs_sv)         svindex
328xio_bottom_name IoBOTTOM_NAME(bstate->bs_sv)            pvcontents
329xio_bottom_gv   *(SV**)&IoBOTTOM_GV(bstate->bs_sv)      svindex
330xio_subprocess  IoSUBPROCESS(bstate->bs_sv)             short
331xio_type        IoTYPE(bstate->bs_sv)                   char
332xio_flags       IoFLAGS(bstate->bs_sv)                  char
333xcv_stash       *(SV**)&CvSTASH(bstate->bs_sv)          svindex
334xcv_start       CvSTART(bstate->bs_sv)                  opindex
335xcv_root        CvROOT(bstate->bs_sv)                   opindex
336xcv_gv          *(SV**)&CvGV(bstate->bs_sv)             svindex
337xcv_file        CvFILE(bstate->bs_sv)                   pvindex
338xcv_depth       CvDEPTH(bstate->bs_sv)                  long
339xcv_padlist     *(SV**)&CvPADLIST(bstate->bs_sv)        svindex
340xcv_outside     *(SV**)&CvOUTSIDE(bstate->bs_sv)        svindex
341xcv_flags       CvFLAGS(bstate->bs_sv)                  U16
342av_extend       bstate->bs_sv                           SSize_t         x
343av_push         bstate->bs_sv                           svindex         x
344xav_fill        AvFILLp(bstate->bs_sv)                  SSize_t
345xav_max         AvMAX(bstate->bs_sv)                    SSize_t
346xav_flags       AvFLAGS(bstate->bs_sv)                  U8
347xhv_riter       HvRITER(bstate->bs_sv)                  I32
348xhv_name        HvNAME(bstate->bs_sv)                   pvcontents
349hv_store        bstate->bs_sv                           svindex         x
350sv_magic        bstate->bs_sv                           char            x
351mg_obj          SvMAGIC(bstate->bs_sv)->mg_obj          svindex
352mg_private      SvMAGIC(bstate->bs_sv)->mg_private      U16
353mg_flags        SvMAGIC(bstate->bs_sv)->mg_flags        U8
354mg_pv           SvMAGIC(bstate->bs_sv)                  pvcontents      x
355xmg_stash       *(SV**)&SvSTASH(bstate->bs_sv)          svindex
356gv_fetchpv      bstate->bs_sv                           strconst        x
357gv_stashpv      bstate->bs_sv                           strconst        x
358gp_sv           GvSV(bstate->bs_sv)                     svindex
359gp_refcnt       GvREFCNT(bstate->bs_sv)                 U32
360gp_refcnt_add   GvREFCNT(bstate->bs_sv)                 I32             x
361gp_av           *(SV**)&GvAV(bstate->bs_sv)             svindex
362gp_hv           *(SV**)&GvHV(bstate->bs_sv)             svindex
363gp_cv           *(SV**)&GvCV(bstate->bs_sv)             svindex
364gp_file         GvFILE(bstate->bs_sv)                   pvindex
365gp_io           *(SV**)&GvIOp(bstate->bs_sv)            svindex
366gp_form         *(SV**)&GvFORM(bstate->bs_sv)           svindex
367gp_cvgen        GvCVGEN(bstate->bs_sv)                  U32
368gp_line         GvLINE(bstate->bs_sv)                   line_t
369gp_share        bstate->bs_sv                           svindex         x
370xgv_flags       GvFLAGS(bstate->bs_sv)                  U8
371op_next         PL_op->op_next                          opindex
372op_sibling      PL_op->op_sibling                       opindex
373op_ppaddr       PL_op->op_ppaddr                        strconst        x
374op_targ         PL_op->op_targ                          PADOFFSET
375op_type         PL_op                                   OPCODE          x
376op_seq          PL_op->op_seq                           U16
377op_flags        PL_op->op_flags                         U8
378op_private      PL_op->op_private                       U8
379op_first        cUNOP->op_first                         opindex
380op_last         cBINOP->op_last                         opindex
381op_other        cLOGOP->op_other                        opindex
382op_pmreplroot   cPMOP->op_pmreplroot                    opindex
383op_pmreplrootgv *(SV**)&cPMOP->op_pmreplroot            svindex
384op_pmreplstart  cPMOP->op_pmreplstart                   opindex
385op_pmnext       *(OP**)&cPMOP->op_pmnext                opindex
386pregcomp        PL_op                                   pvcontents      x
387op_pmflags      cPMOP->op_pmflags                       U16
388op_pmpermflags  cPMOP->op_pmpermflags                   U16
389op_sv           cSVOP->op_sv                            svindex
390op_padix        cPADOP->op_padix                        PADOFFSET
391op_pv           cPVOP->op_pv                            pvcontents
392op_pv_tr        cPVOP->op_pv                            op_tr_array
393op_redoop       cLOOP->op_redoop                        opindex
394op_nextop       cLOOP->op_nextop                        opindex
395op_lastop       cLOOP->op_lastop                        opindex
396cop_label       cCOP->cop_label                         pvindex
397cop_stashpv     cCOP                                    pvindex         x
398cop_file        cCOP                                    pvindex         x
399cop_seq         cCOP->cop_seq                           U32
400cop_arybase     cCOP->cop_arybase                       I32
401cop_line        cCOP                                    line_t          x
402cop_warnings    cCOP->cop_warnings                      svindex
403main_start      PL_main_start                           opindex
404main_root       PL_main_root                            opindex
405curpad          PL_curpad                               svindex         x
406push_begin      PL_beginav                              svindex         x
407push_init       PL_initav                               svindex         x
408push_end        PL_endav                                svindex         x
Note: See TracBrowser for help on using the repository browser.