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

Revision 14545, 11.0 KB checked in by ghudson, 25 years ago (diff)
This commit was generated by cvs2svn to compensate for changes in r14544, 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);
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 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
95static SV *specialsv_list[4];
96
97static int bytecode_iv_overflows = 0;
98static SV *bytecode_sv;
99static XPV bytecode_pv;
100static void **bytecode_obj_list;
101static I32 bytecode_obj_list_fill = -1;
102
103void *
104bset_obj_store(pTHXo_ void *obj, I32 ix)
105{
106    if (ix > bytecode_obj_list_fill) {
107        if (bytecode_obj_list_fill == -1)
108            New(666, bytecode_obj_list, ix + 1, void*);
109        else
110            Renew(bytecode_obj_list, ix + 1, void*);
111        bytecode_obj_list_fill = ix;
112    }
113    bytecode_obj_list[ix] = obj;
114    return obj;
115}
116
117void
118byterun(pTHXo_ struct bytestream bs)
119{
120    dTHR;
121    int insn;
122
123EOT
124
125for (my $i = 0; $i < @specialsv; $i++) {
126    print BYTERUN_C "    specialsv_list[$i] = $specialsv[$i];\n";
127}
128
129print BYTERUN_C <<'EOT';
130
131    while ((insn = BGET_FGETC()) != EOF) {
132        switch (insn) {
133EOT
134
135
136my (@insn_name, $insn_num, $insn, $lvalue, $argtype, $flags, $fundtype);
137
138while (<DATA>) {
139    chop;
140    s/#.*//;                    # remove comments
141    next unless length;
142    if (/^%number\s+(.*)/) {
143        $insn_num = $1;
144        next;
145    } elsif (/%enum\s+(.*?)\s+(.*)/) {
146        create_enum($1, $2);    # must come before instructions
147        next;
148    }
149    ($insn, $lvalue, $argtype, $flags) = split;
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/) {
165        # Store instructions store to bytecode_obj_list[arg]. "lvalue" field is rvalue.
166        print BYTERUN_C "\t\tBSET_OBJ_STORE($lvalue$optarg);\n";
167    }
168    elsif ($optarg && $lvalue ne "none") {
169        print BYTERUN_C "\t\t$lvalue = arg;\n";
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:
189            Perl_croak(aTHX_ "Illegal bytecode instruction %d\n", insn);
190            /* NOTREACHED */
191        }
192    }
193}
194EOT
195
196#
197# Write the instruction and optype enum constants into byterun.h
198#
199open(BYTERUN_H, ">ext/ByteLoader/byterun.h") or die "ext/ByteLoader/byterun.h: $!";
200print BYTERUN_H $c_header, <<'EOT';
201struct bytestream {
202    void *data;
203    int (*pfgetc)(void *);
204    int (*pfread)(char *, size_t, size_t, void *);
205    void (*pfreadpv)(U32, void *, XPV *);
206};
207
208enum {
209EOT
210
211my $add_enum_value = 0;
212my $max_insn;
213for ($i = 0; $i < @insn_name; $i++) {
214    $insn = uc($insn_name[$i]);
215    if (defined($insn)) {
216        $max_insn = $i;
217        if ($add_enum_value) {
218            print BYTERUN_H "    INSN_$insn = $i,\t\t\t/* $i */\n";
219            $add_enum_value = 0;
220        } else {
221            print BYTERUN_H "    INSN_$insn,\t\t\t/* $i */\n";
222        }
223    } else {
224        $add_enum_value = 1;
225    }
226}
227
228print BYTERUN_H "    MAX_INSN = $max_insn\n};\n";
229
230print BYTERUN_H "\nenum {\n";
231for ($i = 0; $i < @optype - 1; $i++) {
232    printf BYTERUN_H "    OPt_%s,\t\t/* %d */\n", $optype[$i], $i;
233}
234printf BYTERUN_H "    OPt_%s\t\t/* %d */\n};\n\n", $optype[$i], $i;
235
236print BYTERUN_H <<'EOT';
237extern void byterun(pTHXo_ struct bytestream bs);
238
239#define INIT_SPECIALSV_LIST STMT_START { \
240EOT
241for ($i = 0; $i < @specialsv; $i++) {
242    print BYTERUN_H "\tPL_specialsv_list[$i] = $specialsv[$i]; \\\n";
243}
244print BYTERUN_H <<'EOT';
245    } STMT_END
246EOT
247
248#
249# Finish off insn_data and create array initialisers in Asmdata.pm
250#
251print ASMDATA_PM <<'EOT';
252
253my ($insn_name, $insn_data);
254while (($insn_name, $insn_data) = each %insn_data) {
255    $insn_name[$insn_data->[0]] = $insn_name;
256}
257# Fill in any gaps
258@insn_name = map($_ || "unused", @insn_name);
259
2601;
261
262__END__
263
264=head1 NAME
265
266B::Asmdata - Autogenerated data about Perl ops, used to generate bytecode
267
268=head1 SYNOPSIS
269
270        use Asmdata;
271
272=head1 DESCRIPTION
273
274See F<ext/B/B/Asmdata.pm>.
275
276=head1 AUTHOR
277
278Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
279
280=cut
281EOT
282
283__END__
284# First set instruction ord("#") to read comment to end-of-line (sneaky)
285%number 35
286comment         arg                     comment_t
287# Then make ord("\n") into a no-op
288%number 10
289nop             none                    none
290# Now for the rest of the ordinary ones, beginning with \0 which is
291# ret so that \0-terminated strings can be read properly as bytecode.
292%number 0
293#
294#opcode         lvalue                                  argtype         flags   
295#
296ret             none                                    none            x
297ldsv            bytecode_sv                             svindex
298ldop            PL_op                                   opindex
299stsv            bytecode_sv                             U32             s
300stop            PL_op                                   U32             s
301ldspecsv        bytecode_sv                             U8              x
302newsv           bytecode_sv                             U8              x
303newop           PL_op                                   U8              x
304newopn          PL_op                                   U8              x
305newpv           none                                    PV
306pv_cur          bytecode_pv.xpv_cur                     STRLEN
307pv_free         bytecode_pv                             none            x
308sv_upgrade      bytecode_sv                             char            x
309sv_refcnt       SvREFCNT(bytecode_sv)                   U32
310sv_refcnt_add   SvREFCNT(bytecode_sv)                   I32             x
311sv_flags        SvFLAGS(bytecode_sv)                    U32
312xrv             SvRV(bytecode_sv)                       svindex
313xpv             bytecode_sv                             none            x
314xiv32           SvIVX(bytecode_sv)                      I32
315xiv64           SvIVX(bytecode_sv)                      IV64
316xnv             SvNVX(bytecode_sv)                      NV
317xlv_targoff     LvTARGOFF(bytecode_sv)                  STRLEN
318xlv_targlen     LvTARGLEN(bytecode_sv)                  STRLEN
319xlv_targ        LvTARG(bytecode_sv)                     svindex
320xlv_type        LvTYPE(bytecode_sv)                     char
321xbm_useful      BmUSEFUL(bytecode_sv)                   I32
322xbm_previous    BmPREVIOUS(bytecode_sv)                 U16
323xbm_rare        BmRARE(bytecode_sv)                     U8
324xfm_lines       FmLINES(bytecode_sv)                    I32
325xio_lines       IoLINES(bytecode_sv)                    long
326xio_page        IoPAGE(bytecode_sv)                     long
327xio_page_len    IoPAGE_LEN(bytecode_sv)                 long
328xio_lines_left  IoLINES_LEFT(bytecode_sv)               long
329xio_top_name    IoTOP_NAME(bytecode_sv)                 pvcontents
330xio_top_gv      *(SV**)&IoTOP_GV(bytecode_sv)           svindex
331xio_fmt_name    IoFMT_NAME(bytecode_sv)                 pvcontents
332xio_fmt_gv      *(SV**)&IoFMT_GV(bytecode_sv)           svindex
333xio_bottom_name IoBOTTOM_NAME(bytecode_sv)              pvcontents
334xio_bottom_gv   *(SV**)&IoBOTTOM_GV(bytecode_sv)        svindex
335xio_subprocess  IoSUBPROCESS(bytecode_sv)               short
336xio_type        IoTYPE(bytecode_sv)                     char
337xio_flags       IoFLAGS(bytecode_sv)                    char
338xcv_stash       *(SV**)&CvSTASH(bytecode_sv)            svindex
339xcv_start       CvSTART(bytecode_sv)                    opindex
340xcv_root        CvROOT(bytecode_sv)                     opindex
341xcv_gv          *(SV**)&CvGV(bytecode_sv)               svindex
342xcv_file        CvFILE(bytecode_sv)                     pvcontents
343xcv_depth       CvDEPTH(bytecode_sv)                    long
344xcv_padlist     *(SV**)&CvPADLIST(bytecode_sv)          svindex
345xcv_outside     *(SV**)&CvOUTSIDE(bytecode_sv)          svindex
346xcv_flags       CvFLAGS(bytecode_sv)                    U16
347av_extend       bytecode_sv                             SSize_t         x
348av_push         bytecode_sv                             svindex         x
349xav_fill        AvFILLp(bytecode_sv)                    SSize_t
350xav_max         AvMAX(bytecode_sv)                      SSize_t
351xav_flags       AvFLAGS(bytecode_sv)                    U8
352xhv_riter       HvRITER(bytecode_sv)                    I32
353xhv_name        HvNAME(bytecode_sv)                     pvcontents
354hv_store        bytecode_sv                             svindex         x
355sv_magic        bytecode_sv                             char            x
356mg_obj          SvMAGIC(bytecode_sv)->mg_obj            svindex
357mg_private      SvMAGIC(bytecode_sv)->mg_private        U16
358mg_flags        SvMAGIC(bytecode_sv)->mg_flags          U8
359mg_pv           SvMAGIC(bytecode_sv)                    pvcontents      x
360xmg_stash       *(SV**)&SvSTASH(bytecode_sv)            svindex
361gv_fetchpv      bytecode_sv                             strconst        x
362gv_stashpv      bytecode_sv                             strconst        x
363gp_sv           GvSV(bytecode_sv)                       svindex
364gp_refcnt       GvREFCNT(bytecode_sv)                   U32
365gp_refcnt_add   GvREFCNT(bytecode_sv)                   I32             x
366gp_av           *(SV**)&GvAV(bytecode_sv)               svindex
367gp_hv           *(SV**)&GvHV(bytecode_sv)               svindex
368gp_cv           *(SV**)&GvCV(bytecode_sv)               svindex
369gp_file         GvFILE(bytecode_sv)                     pvcontents
370gp_io           *(SV**)&GvIOp(bytecode_sv)              svindex
371gp_form         *(SV**)&GvFORM(bytecode_sv)             svindex
372gp_cvgen        GvCVGEN(bytecode_sv)                    U32
373gp_line         GvLINE(bytecode_sv)                     line_t
374gp_share        bytecode_sv                             svindex         x
375xgv_flags       GvFLAGS(bytecode_sv)                    U8
376op_next         PL_op->op_next                          opindex
377op_sibling      PL_op->op_sibling                       opindex
378op_ppaddr       PL_op->op_ppaddr                        strconst        x
379op_targ         PL_op->op_targ                          PADOFFSET
380op_type         PL_op                                   OPCODE          x
381op_seq          PL_op->op_seq                           U16
382op_flags        PL_op->op_flags                         U8
383op_private      PL_op->op_private                       U8
384op_first        cUNOP->op_first                         opindex
385op_last         cBINOP->op_last                         opindex
386op_other        cLOGOP->op_other                        opindex
387op_children     cLISTOP->op_children                    U32
388op_pmreplroot   cPMOP->op_pmreplroot                    opindex
389op_pmreplrootgv *(SV**)&cPMOP->op_pmreplroot            svindex
390op_pmreplstart  cPMOP->op_pmreplstart                   opindex
391op_pmnext       *(OP**)&cPMOP->op_pmnext                opindex
392pregcomp        PL_op                                   pvcontents      x
393op_pmflags      cPMOP->op_pmflags                       U16
394op_pmpermflags  cPMOP->op_pmpermflags                   U16
395op_sv           cSVOP->op_sv                            svindex
396op_padix        cPADOP->op_padix                        PADOFFSET
397op_pv           cPVOP->op_pv                            pvcontents
398op_pv_tr        cPVOP->op_pv                            op_tr_array
399op_redoop       cLOOP->op_redoop                        opindex
400op_nextop       cLOOP->op_nextop                        opindex
401op_lastop       cLOOP->op_lastop                        opindex
402cop_label       cCOP->cop_label                         pvcontents
403cop_stashpv     cCOP                                    pvcontents      x
404cop_file        cCOP                                    pvcontents      x
405cop_seq         cCOP->cop_seq                           U32
406cop_arybase     cCOP->cop_arybase                       I32
407cop_line        cCOP                                    line_t          x
408cop_warnings    cCOP->cop_warnings                      svindex
409main_start      PL_main_start                           opindex
410main_root       PL_main_root                            opindex
411curpad          PL_curpad                               svindex         x
Note: See TracBrowser for help on using the repository browser.