This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
add newer malloc.c from Ilya Zakharevich <ilya@math.ohio-state.edu>
[perl5.git] / bytecode.h
index 0fcaa97..3e8a6a9 100644 (file)
@@ -2,14 +2,12 @@ typedef char *pvcontents;
 typedef char *strconst;
 typedef U32 PV;
 typedef char *op_tr_array;
-typedef int comment;
+typedef int comment_t;
 typedef SV *svindex;
 typedef OP *opindex;
 typedef IV IV64;
 
 EXT int iv_overflows INIT(0);
-void *bset_obj_store _((void *, I32));
-void freadpv _((U32, void *));
 
 EXT SV *sv;
 #ifndef USE_THREADS
@@ -21,20 +19,24 @@ EXT void **obj_list;
 EXT I32 obj_list_fill INIT(-1);
 
 #ifdef INDIRECT_BGET_MACROS
-#define FREAD(argp, len, nelem) bs.fread((char*)(argp),(len),(nelem),bs.data)
-#define FGETC() bs.fgetc(bs.data)
+#define BGET_FREAD(argp, len, nelem)   \
+        bs.fread((char*)(argp),(len),(nelem),bs.data)
+#define BGET_FGETC() bs.fgetc(bs.data)
 #else
-#define FREAD(argp, len, nelem) fread((argp), (len), (nelem), fp)
-#define FGETC() getc(fp)
+#define BGET_FREAD(argp, len, nelem) PerlIO_read(fp, (argp), (len)*(nelem))
+#define BGET_FGETC() PerlIO_getc(fp)
 #endif /* INDIRECT_BGET_MACROS */
 
-#define BGET_U32(arg)  FREAD(&arg, sizeof(U32), 1); arg = ntohl((U32)arg)
-#define BGET_I32(arg)  FREAD(&arg, sizeof(I32), 1); arg = (I32)ntohl((U32)arg)
-#define BGET_U16(arg)  FREAD(&arg, sizeof(U16), 1); arg = ntohs((U16)arg)
-#define BGET_U8(arg)   arg = FGETC()
+#define BGET_U32(arg)  \
+       BGET_FREAD(&arg, sizeof(U32), 1); arg = PerlSock_ntohl((U32)arg)
+#define BGET_I32(arg)  \
+       BGET_FREAD(&arg, sizeof(I32), 1); arg = (I32)PerlSock_ntohl((U32)arg)
+#define BGET_U16(arg)  \
+       BGET_FREAD(&arg, sizeof(U16), 1); arg = PerlSock_ntohs((U16)arg)
+#define BGET_U8(arg)   arg = BGET_FGETC()
 
 #if INDIRECT_BGET_MACROS
-#define BGET_PV(arg)   do {            \
+#define BGET_PV(arg)   STMT_START {    \
        BGET_U32(arg);                  \
        if (arg)                        \
            bs.freadpv(arg, bs.data);   \
@@ -43,13 +45,13 @@ EXT I32 obj_list_fill INIT(-1);
            pv.xpv_len = 0;             \
            pv.xpv_cur = 0;             \
        }                               \
-    } while (0)
+    } STMT_END
 #else
-#define BGET_PV(arg)   do {                    \
+#define BGET_PV(arg)   STMT_START {            \
        BGET_U32(arg);                          \
        if (arg) {                              \
            New(666, pv.xpv_pv, arg, char);     \
-           fread(pv.xpv_pv, 1, arg, fp);       \
+           PerlIO_read(fp, pv.xpv_pv, arg);    \
            pv.xpv_len = arg;                   \
            pv.xpv_cur = arg - 1;               \
        } else {                                \
@@ -57,18 +59,18 @@ EXT I32 obj_list_fill INIT(-1);
            pv.xpv_len = 0;                     \
            pv.xpv_cur = 0;                     \
        }                                       \
-    } while (0)
+    } STMT_END
 #endif /* INDIRECT_BGET_MACROS */
 
 #define BGET_comment(arg) \
-       do { arg = FGETC(); } while (arg != '\n' && arg != EOF)
+       do { arg = BGET_FGETC(); } while (arg != '\n' && arg != EOF)
 
 /*
  * In the following, sizeof(IV)*4 is just a way of encoding 32 on 64-bit-IV
  * machines such that 32-bit machine compilers don't whine about the shift
  * count being too high even though the code is never reached there.
  */
-#define BGET_IV64(arg) do {                            \
+#define BGET_IV64(arg) STMT_START {                    \
        U32 hi, lo;                                     \
        BGET_U32(hi);                                   \
        BGET_U32(lo);                                   \
@@ -82,44 +84,46 @@ EXT I32 obj_list_fill INIT(-1);
            iv_overflows++;                             \
            arg = 0;                                    \
        }                                               \
-    } while (0)
+    } STMT_END
 
 #define BGET_op_tr_array(arg) do {     \
        unsigned short *ary;            \
        int i;                          \
        New(666, ary, 256, unsigned short); \
-       FREAD(ary, 256, 2);             \
+       BGET_FREAD(ary, 256, 2);        \
        for (i = 0; i < 256; i++)       \
-           ary[i] = ntohs(ary[i]);     \
+           ary[i] = PerlSock_ntohs(ary[i]);    \
        arg = (char *) ary;             \
     } while (0)
 
 #define BGET_pvcontents(arg)   arg = pv.xpv_pv
-#define BGET_strconst(arg)     do {    \
-       for (arg = tokenbuf; (*arg = FGETC()); arg++) /* nothing */;    \
+#define BGET_strconst(arg) STMT_START {        \
+       for (arg = tokenbuf; (*arg = BGET_FGETC()); arg++) /* nothing */; \
        arg = tokenbuf;                 \
-    } while (0)
+    } STMT_END
 
-#define BGET_double(arg)       do {    \
+#define BGET_double(arg) STMT_START {  \
        char *str;                      \
        BGET_strconst(str);             \
        arg = atof(str);                \
-    } while (0)
+    } STMT_END
 
-#define BGET_objindex(arg) do {        \
-       U32 ix;                 \
-       BGET_U32(ix);           \
-       arg = obj_list[ix];     \
-    } while (0)
+#define BGET_objindex(arg, type) STMT_START {  \
+       U32 ix;                                 \
+       BGET_U32(ix);                           \
+       arg = (type)obj_list[ix];               \
+    } STMT_END
+#define BGET_svindex(arg) BGET_objindex(arg, svindex)
+#define BGET_opindex(arg) BGET_objindex(arg, opindex)
 
 #define BSET_ldspecsv(sv, arg) sv = specialsv_list[arg]
                                    
 #define BSET_sv_refcnt_add(svrefcnt, arg)      svrefcnt += arg
 #define BSET_gp_refcnt_add(gprefcnt, arg)      gprefcnt += arg
-#define BSET_gp_share(sv, arg) do {    \
-       gp_free((GV*)sv);               \
-       GvGP(sv) = GvGP(arg);           \
-    } while (0)
+#define BSET_gp_share(sv, arg) STMT_START {    \
+       gp_free((GV*)sv);                       \
+       GvGP(sv) = GvGP(arg);                   \
+    } STMT_END
 
 #define BSET_gv_fetchpv(sv, arg)       sv = (SV*)gv_fetchpv(arg, TRUE, SVt_PV)
 #define BSET_gv_stashpv(sv, arg)       sv = (SV*)gv_stashpv(arg, TRUE)
@@ -142,11 +146,11 @@ EXT I32 obj_list_fill INIT(-1);
                pregcomp(arg, arg + pv.xpv_cur, ((PMOP*)o)) : 0
 #define BSET_newsv(sv, arg)    sv = NEWSV(666,0); SvUPGRADE(sv, arg)
 #define BSET_newop(o, arg)     o = (OP*)safemalloc(optype_size[arg])
-#define BSET_newopn(o, arg)    do {    \
-       OP *oldop = o;                  \
-       BSET_newop(o, arg);             \
-       oldop->op_next = o;             \
-    } while (0)
+#define BSET_newopn(o, arg) STMT_START {       \
+       OP *oldop = o;                          \
+       BSET_newop(o, arg);                     \
+       oldop->op_next = o;                     \
+    } STMT_END
 
 #define BSET_ret(foo) return
 
@@ -154,10 +158,12 @@ EXT I32 obj_list_fill INIT(-1);
  * Kludge special-case workaround for OP_MAPSTART
  * which needs the ppaddr for OP_GREPSTART. Blech.
  */
-#define BSET_op_type(o, arg)   do {    \
-       o->op_type = arg;               \
-       o->op_ppaddr = (arg != OP_MAPSTART) ? ppaddr[arg] : pp_grepstart; \
-    } while (0)
+#define BSET_op_type(o, arg) STMT_START {      \
+       o->op_type = arg;                       \
+       if (arg == OP_MAPSTART)                 \
+           arg = OP_GREPSTART;                 \
+       o->op_ppaddr = ppaddr[arg];             \
+    } STMT_END
 #define BSET_op_ppaddr(o, arg) croak("op_ppaddr not yet implemented")
 #define BSET_curpad(pad, arg) pad = AvARRAY(arg)