├── .gitignore ├── microperl-5.10.1 ├── test.pl ├── t.pl ├── test.sh ├── gv.c ├── run.c ├── locale.c ├── perl.c ├── taint.c ├── utf8.c ├── util.c ├── xsutils.c ├── form.h ├── generate_uudmap.c ├── mydtrace.h ├── README.micro ├── globals.c ├── INTERN.h ├── malloc_ctl.h ├── util.h ├── overload.h ├── EXTERN.h ├── fakethr.h ├── cc_runtime.h ├── mg.h ├── overload.c ├── perlsfio.h ├── perlapi.c ├── fakesdio.h ├── nostdio.h ├── parser.h ├── warnings.h ├── av.h ├── unixish.h ├── miniperlmain.c ├── Makefile ├── perlsdio.h ├── patchlevel.h ├── perly.h ├── perlvars.h ├── dosish.h ├── keywords.h ├── gv.h ├── deb.c ├── scope.h ├── cv.h ├── opnames.h ├── perlio.h ├── pp_proto.h ├── pad.h └── utf8.h ├── webdocs ├── bootstrapping_with_microperl.meta └── microperl_simon_cozens.meta ├── get-micro-files.sh ├── cfiles.txt ├── README.txt ├── Readme.txt └── index.html /.gitignore: -------------------------------------------------------------------------------- 1 | .DS_Store 2 | -------------------------------------------------------------------------------- /microperl-5.10.1/test.pl: -------------------------------------------------------------------------------- 1 | 5 + 7; 2 | -------------------------------------------------------------------------------- /microperl-5.10.1/t.pl: -------------------------------------------------------------------------------- 1 | print("jsdf"); 2 | -------------------------------------------------------------------------------- /microperl-5.10.1/test.sh: -------------------------------------------------------------------------------- 1 | for i in $(seq 1 1000); do perl test.pl; done 2 | -------------------------------------------------------------------------------- /webdocs/bootstrapping_with_microperl.meta: -------------------------------------------------------------------------------- 1 | url: http://www.perlmonks.org/?node_id=228040 2 | -------------------------------------------------------------------------------- /webdocs/microperl_simon_cozens.meta: -------------------------------------------------------------------------------- 1 | url: http://www.foo.be/docs/tpj/issues/vol5_3/tpj0503-0003.html 2 | -------------------------------------------------------------------------------- /microperl-5.10.1/gv.c: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bentxt/microperl-standalone/HEAD/microperl-5.10.1/gv.c -------------------------------------------------------------------------------- /microperl-5.10.1/run.c: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bentxt/microperl-standalone/HEAD/microperl-5.10.1/run.c -------------------------------------------------------------------------------- /microperl-5.10.1/locale.c: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bentxt/microperl-standalone/HEAD/microperl-5.10.1/locale.c -------------------------------------------------------------------------------- /microperl-5.10.1/perl.c: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bentxt/microperl-standalone/HEAD/microperl-5.10.1/perl.c -------------------------------------------------------------------------------- /microperl-5.10.1/taint.c: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bentxt/microperl-standalone/HEAD/microperl-5.10.1/taint.c -------------------------------------------------------------------------------- /microperl-5.10.1/utf8.c: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bentxt/microperl-standalone/HEAD/microperl-5.10.1/utf8.c -------------------------------------------------------------------------------- /microperl-5.10.1/util.c: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bentxt/microperl-standalone/HEAD/microperl-5.10.1/util.c -------------------------------------------------------------------------------- /microperl-5.10.1/xsutils.c: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/bentxt/microperl-standalone/HEAD/microperl-5.10.1/xsutils.c -------------------------------------------------------------------------------- /get-micro-files.sh: -------------------------------------------------------------------------------- 1 | 2 | 3 | rm -rf microfiles 4 | 5 | mkdir microfiles 6 | 7 | cp README.micro microfiles 8 | cp Makefile.micro microfiles 9 | 10 | 11 | cat cfiles.txt | while read f ; do 12 | if [ -f "$f" ] ; then 13 | cp $f microfiles/ 14 | else 15 | echo file nok $f 16 | fi 17 | done 18 | 19 | cp *.h microfiles/ 20 | 21 | 22 | 23 | -------------------------------------------------------------------------------- /cfiles.txt: -------------------------------------------------------------------------------- 1 | av.c 2 | deb.c 3 | doio.c 4 | doop.c 5 | dump.c 6 | generate_uudmap.c 7 | globals.c 8 | gv.c 9 | hv.c 10 | locale.c 11 | mg.c 12 | miniperlmain.c 13 | mro.c 14 | numeric.c 15 | op.c 16 | pad.c 17 | perlapi.c 18 | perl.c 19 | perlio.c 20 | perly.c 21 | perly.y 22 | pp.c 23 | pp_ctl.c 24 | pp_pack.c 25 | pp_sort.c 26 | pp_sys.c 27 | reentr.c 28 | regcomp.c 29 | regexec.c 30 | run.c 31 | scope.c 32 | sv.c 33 | taint.c 34 | toke.c 35 | universal.c 36 | utf8.c 37 | util.c 38 | xsutils.c 39 | -------------------------------------------------------------------------------- /microperl-5.10.1/form.h: -------------------------------------------------------------------------------- 1 | /* form.h 2 | * 3 | * Copyright (C) 1991, 1992, 1993, 2000, 2004 by Larry Wall and others 4 | * 5 | * You may distribute under the terms of either the GNU General Public 6 | * License or the Artistic License, as specified in the README file. 7 | * 8 | */ 9 | 10 | #define FF_END 0 11 | #define FF_LINEMARK 1 12 | #define FF_LITERAL 2 13 | #define FF_SKIP 3 14 | #define FF_FETCH 4 15 | #define FF_CHECKNL 5 16 | #define FF_CHECKCHOP 6 17 | #define FF_SPACE 7 18 | #define FF_HALFSPACE 8 19 | #define FF_ITEM 9 20 | #define FF_CHOP 10 21 | #define FF_LINEGLOB 11 22 | #define FF_DECIMAL 12 23 | #define FF_NEWLINE 13 24 | #define FF_BLANK 14 25 | #define FF_MORE 15 26 | #define FF_0DECIMAL 16 27 | #define FF_LINESNGL 17 28 | -------------------------------------------------------------------------------- /README.txt: -------------------------------------------------------------------------------- 1 | # Microperl-Standalone 2 | 3 | A small(er) Perl for simple tasks 4 | 5 | by ben@srctxt.com 6 | id bxt0flqlbfu 7 | 8 | 9 | ## Why 10 | 11 | Perls source code contains a lot of files. Perl is a large language. Sometimes you only need a portable and nicer awk. Maybe Microperl can provide this. 12 | 13 | ## Howto build 14 | 15 | - tar xfvz microperl-standalone.tar.gz 16 | - cd microperl-standalone/microperl-5.10.1 17 | - make 18 | 19 | 20 | 21 | ## Howto rebuild with other Perl version 22 | 23 | This microperl is based on the sources of http://www.cpan.org/src/5.0/perl-5.10.1.tar.gz. 24 | 25 | For upgrading downloading your Perl sources and then: 26 | 27 | 28 | - get cfiles.txt and 'get-micro-files.sh' into the source folder of perl 29 | 30 | 31 | - run sh ./get-micro-files.sh 32 | 33 | 34 | - cd microfiles 35 | 36 | - make -f Makefiles.micro 37 | 38 | 39 | -------------------------------------------------------------------------------- /Readme.txt: -------------------------------------------------------------------------------- 1 | # Microperl-Standalone 2 | 3 | A small(er) Perl for simple tasks 4 | 5 | by ben@srctxt.com 6 | id bxt0flqlbfu 7 | 8 | 9 | ## Why 10 | 11 | Perls source code contains a lot of files. Perl is a large language. Sometimes you only need a portable and nicer awk. Maybe Microperl can provide this. 12 | 13 | ## Howto build 14 | 15 | - tar xfvz microperl-standalone.tar.gz 16 | - cd microperl-standalone/microperl-5.10.1 17 | - make 18 | 19 | 20 | 21 | ## Howto rebuild with other Perl version 22 | 23 | This microperl is based on the sources of http://www.cpan.org/src/5.0/perl-5.10.1.tar.gz. 24 | 25 | For upgrading downloading your Perl sources and then: 26 | 27 | 28 | - get cfiles.txt and 'get-micro-files.sh' into the source folder of perl 29 | 30 | 31 | - run sh ./get-micro-files.sh 32 | 33 | 34 | - cd microfiles 35 | 36 | - make -f Makefiles.micro 37 | 38 | 39 | -------------------------------------------------------------------------------- /index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 |

Microperl-Standalone

12 | 
A small(er) Perl for simple tasks
13 |

The Perl version used: http://www.cpan.org/src/5.0/perl-5.10.1.tar.gz

14 | 20 | 21 | 22 | -------------------------------------------------------------------------------- /microperl-5.10.1/generate_uudmap.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | 4 | static const char PL_uuemap[] 5 | = "`!\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_"; 6 | 7 | typedef unsigned char U8; 8 | 9 | /* This will ensure it is all zeros. */ 10 | static char PL_uudmap[256]; 11 | 12 | int main() { 13 | size_t i; 14 | char *p; 15 | 16 | for (i = 0; i < sizeof(PL_uuemap) - 1; ++i) 17 | PL_uudmap[(U8)PL_uuemap[i]] = (char)i; 18 | /* 19 | * Because ' ' and '`' map to the same value, 20 | * we need to decode them both the same. 21 | */ 22 | PL_uudmap[(U8)' '] = 0; 23 | 24 | i = sizeof(PL_uudmap); 25 | p = PL_uudmap; 26 | 27 | fputs("{\n ", stdout); 28 | while (i--) { 29 | printf("%d", *p); 30 | p++; 31 | if (i) { 32 | fputs(", ", stdout); 33 | if (!(i & 15)) { 34 | fputs("\n ", stdout); 35 | } 36 | } 37 | } 38 | puts("\n}"); 39 | 40 | return 0; 41 | } 42 | 43 | 44 | -------------------------------------------------------------------------------- /microperl-5.10.1/mydtrace.h: -------------------------------------------------------------------------------- 1 | /* mydtrace.h 2 | * 3 | * Copyright (C) 2008, by Larry Wall and others 4 | * 5 | * You may distribute under the terms of either the GNU General Public 6 | * License or the Artistic License, as specified in the README file. 7 | * 8 | * Provides macros that wrap the various DTrace probes we use. We add 9 | * an extra level of wrapping to encapsulate the _ENABLED tests. 10 | */ 11 | 12 | #if defined(USE_DTRACE) && defined(PERL_CORE) 13 | 14 | # include "perldtrace.h" 15 | 16 | # define ENTRY_PROBE(func, file, line) \ 17 | if (PERL_SUB_ENTRY_ENABLED()) { \ 18 | PERL_SUB_ENTRY(func, file, line); \ 19 | } 20 | 21 | # define RETURN_PROBE(func, file, line) \ 22 | if (PERL_SUB_RETURN_ENABLED()) { \ 23 | PERL_SUB_RETURN(func, file, line); \ 24 | } 25 | 26 | #else 27 | 28 | /* NOPs */ 29 | # define ENTRY_PROBE(func, file, line) 30 | # define RETURN_PROBE(func, file, line) 31 | 32 | #endif 33 | 34 | /* 35 | * Local variables: 36 | * c-indentation-style: bsd 37 | * c-basic-offset: 4 38 | * indent-tabs-mode: t 39 | * End: 40 | * 41 | * ex: set ts=8 sts=4 sw=4 noet: 42 | */ 43 | -------------------------------------------------------------------------------- /microperl-5.10.1/README.micro: -------------------------------------------------------------------------------- 1 | microperl is supposed to be a really minimal perl, even more 2 | minimal than miniperl. No Configure is needed to build microperl, 3 | on the other hand this means that interfaces between Perl and your 4 | operating system are left very -- minimal. 5 | 6 | All this is experimental. If you don't know what to do with microperl 7 | you probably shouldn't. Do not report bugs in microperl; fix the bugs. 8 | 9 | We assume ANSI C89 plus the following: 10 | - 11 | - rename() 12 | - opendir(), readdir(), closedir() (via dirent.h) 13 | - memchr(), memcmp(), memcpy() (via string.h) 14 | - (a safe) putenv() (via stdlib.h) 15 | - strtoul() (via stdlib.h) 16 | (grep for 'define' in uconfig.sh.) 17 | Also, Perl times() is defined to always return zeroes. 18 | 19 | If you are still reading this and you are itching to try out microperl: 20 | 21 | make -f Makefile.micro 22 | 23 | If you make changes to uconfig.sh, run 24 | 25 | make -f Makefile.micro regen_uconfig 26 | 27 | to regenerate uconfig.h. If your compilation platform is not 32-bit 28 | little-endian (like x86), you might want to try 29 | 30 | make -f Makefile.micro patch_uconfig 31 | 32 | *before* the "make -f Makefile.micro". This tries to minimally patch 33 | the uconfig.sh using your *current* Perl so that your microperl has 34 | the correct basic types and sizes and byteorder. 35 | 36 | -------------------------------------------------------------------------------- /microperl-5.10.1/globals.c: -------------------------------------------------------------------------------- 1 | /* globals.c 2 | * 3 | * Copyright (C) 1995, 1999, 2000, 2001, by Larry Wall and others 4 | * 5 | * You may distribute under the terms of either the GNU General Public 6 | * License or the Artistic License, as specified in the README file. 7 | * 8 | */ 9 | 10 | /* 11 | * 'For the rest, they shall represent the other Free Peoples of the World: 12 | * Elves, Dwarves, and Men.' --Elrond 13 | * 14 | * [p.275 of _The Lord of the Rings_, II/iii: "The Ring Goes South"] 15 | */ 16 | 17 | /* This file exists to #include "perl.h" _ONCE_ with 18 | * PERL_IN_GLOBALS_C defined. That causes various global varaiables 19 | * in perl.h and other files it includes to be _defined_ (and initialized) 20 | * rather than just declared. 21 | * 22 | * There is a #include "perlapi.h" which makes use of the fact 23 | * that the object file created from this file will be included by linker 24 | * (to resolve global variables). perlapi.h mention various other "API" 25 | * functions not used by perl itself, but the functions get 26 | * pulled into the perl executable via the refrerence here. 27 | * 28 | */ 29 | 30 | #include "INTERN.h" 31 | #define PERL_IN_GLOBALS_C 32 | #include "perl.h" 33 | 34 | #include "perlapi.h" /* bring in PL_force_link_funcs */ 35 | 36 | /* 37 | * Local variables: 38 | * c-indentation-style: bsd 39 | * c-basic-offset: 4 40 | * indent-tabs-mode: t 41 | * End: 42 | * 43 | * ex: set ts=8 sts=4 sw=4 noet: 44 | */ 45 | -------------------------------------------------------------------------------- /microperl-5.10.1/INTERN.h: -------------------------------------------------------------------------------- 1 | /* INTERN.h 2 | * 3 | * Copyright (C) 1991, 1992, 1993, 1995, 1996, 1998, 2000, 2001, 4 | * by Larry Wall and others 5 | * 6 | * You may distribute under the terms of either the GNU General Public 7 | * License or the Artistic License, as specified in the README file. 8 | * 9 | */ 10 | 11 | /* 12 | * EXT designates a global var which is defined in perl.h 13 | * dEXT designates a global var which is defined in another 14 | * file, so we can't count on finding it in perl.h 15 | * (this practice should be avoided). 16 | */ 17 | #undef EXT 18 | #undef dEXT 19 | #undef EXTCONST 20 | #undef dEXTCONST 21 | #if defined(VMS) && !defined(__GNUC__) 22 | /* Suppress portability warnings from DECC for VMS-specific extensions */ 23 | # ifdef __DECC 24 | # pragma message disable (GLOBALEXT,NOSHAREEXT,READONLYEXT) 25 | # endif 26 | # define EXT globaldef {"$GLOBAL_RW_VARS"} noshare 27 | # define dEXT globaldef {"$GLOBAL_RW_VARS"} noshare 28 | # define EXTCONST globaldef {"$GLOBAL_RO_VARS"} readonly 29 | # define dEXTCONST globaldef {"$GLOBAL_RO_VARS"} readonly 30 | #else 31 | # if (defined(WIN32) && defined(__MINGW32__)) || defined(__SYMBIAN32__) 32 | # define EXT __declspec(dllexport) 33 | # define dEXT 34 | # define EXTCONST __declspec(dllexport) const 35 | # define dEXTCONST const 36 | # else 37 | # ifdef __cplusplus 38 | # define EXT 39 | # define dEXT 40 | # define EXTCONST extern const 41 | # define dEXTCONST const 42 | # else 43 | # define EXT 44 | # define dEXT 45 | # define EXTCONST const 46 | # define dEXTCONST const 47 | # endif 48 | # endif 49 | #endif 50 | 51 | #undef INIT 52 | #define INIT(x) = x 53 | 54 | #define DOINIT 55 | -------------------------------------------------------------------------------- /microperl-5.10.1/malloc_ctl.h: -------------------------------------------------------------------------------- 1 | #ifndef MALLOC_CTL_H 2 | # define MALLOC_CTL_H 3 | 4 | struct perl_mstats { 5 | UV *nfree; 6 | UV *ntotal; 7 | IV topbucket, topbucket_ev, topbucket_odd, totfree, total, total_chain; 8 | IV total_sbrk, sbrks, sbrk_good, sbrk_slack, start_slack, sbrked_remains; 9 | IV minbucket; 10 | /* Level 1 info */ 11 | UV *bucket_mem_size; 12 | UV *bucket_available_size; 13 | UV nbuckets; 14 | }; 15 | typedef struct perl_mstats perl_mstats_t; 16 | 17 | START_EXTERN_C 18 | Malloc_t Perl_malloc (MEM_SIZE nbytes); 19 | Malloc_t Perl_calloc (MEM_SIZE elements, MEM_SIZE size); 20 | Malloc_t Perl_realloc (Malloc_t where, MEM_SIZE nbytes); 21 | /* 'mfree' rather than 'free', since there is already a 'perl_free' 22 | * that causes clashes with case-insensitive linkers */ 23 | Free_t Perl_mfree (Malloc_t where); 24 | END_EXTERN_C 25 | 26 | #ifndef NO_MALLOC_DYNAMIC_CFG 27 | 28 | /* IV configuration data */ 29 | enum { 30 | MallocCfg_FIRST_SBRK, 31 | MallocCfg_MIN_SBRK, 32 | MallocCfg_MIN_SBRK_FRAC1000, 33 | MallocCfg_SBRK_ALLOW_FAILURES, 34 | MallocCfg_SBRK_FAILURE_PRICE, 35 | MallocCfg_sbrk_goodness, 36 | 37 | MallocCfg_filldead, 38 | MallocCfg_fillalive, 39 | MallocCfg_fillcheck, 40 | 41 | MallocCfg_skip_cfg_env, 42 | MallocCfg_cfg_env_read, 43 | 44 | MallocCfg_emergency_buffer_size, 45 | MallocCfg_emergency_buffer_last_req, 46 | 47 | MallocCfg_emergency_buffer_prepared_size, 48 | 49 | MallocCfg_last 50 | }; 51 | /* char* configuration data */ 52 | enum { 53 | MallocCfgP_emergency_buffer, 54 | MallocCfgP_emergency_buffer_prepared, 55 | MallocCfgP_last 56 | }; 57 | START_EXTERN_C 58 | extern IV *MallocCfg_ptr; 59 | extern char **MallocCfgP_ptr; 60 | END_EXTERN_C 61 | 62 | #endif 63 | 64 | #endif 65 | -------------------------------------------------------------------------------- /microperl-5.10.1/util.h: -------------------------------------------------------------------------------- 1 | /* util.h 2 | * 3 | * Copyright (C) 1991, 1992, 1993, 1999, 2001, 2002, 2003, 2004, 2005, 4 | * 2007, by Larry Wall and others 5 | * 6 | * You may distribute under the terms of either the GNU General Public 7 | * License or the Artistic License, as specified in the README file. 8 | * 9 | */ 10 | 11 | #ifdef VMS 12 | # define PERL_FILE_IS_ABSOLUTE(f) \ 13 | (*(f) == '/' \ 14 | || (strchr(f,':') \ 15 | || ((*(f) == '[' || *(f) == '<') \ 16 | && (isALNUM((f)[1]) || strchr("$-_]>",(f)[1]))))) 17 | 18 | #else /* !VMS */ 19 | # if defined(WIN32) || defined(__CYGWIN__) 20 | # define PERL_FILE_IS_ABSOLUTE(f) \ 21 | (*(f) == '/' || *(f) == '\\' /* UNC/rooted path */ \ 22 | || ((f)[0] && (f)[1] == ':')) /* drive name */ 23 | # else /* !WIN32 */ 24 | # ifdef NETWARE 25 | # define PERL_FILE_IS_ABSOLUTE(f) \ 26 | (((f)[0] && (f)[1] == ':') /* drive name */ \ 27 | || ((f)[0] == '\\' && (f)[1] == '\\') /* UNC path */ \ 28 | || ((f)[3] == ':')) /* volume name, currently only sys */ 29 | # else /* !NETWARE */ 30 | # if defined(DOSISH) || defined(EPOC) || defined(__SYMBIAN32__) 31 | # define PERL_FILE_IS_ABSOLUTE(f) \ 32 | (*(f) == '/' \ 33 | || ((f)[0] && (f)[1] == ':')) /* drive name */ 34 | # else /* NEITHER DOSISH NOR EPOCISH NOR SYMBIANISH */ 35 | # ifdef MACOS_TRADITIONAL 36 | # define PERL_FILE_IS_ABSOLUTE(f) (strchr(f, ':') && *(f) != ':') 37 | # else /* !MACOS_TRADITIONAL */ 38 | # define PERL_FILE_IS_ABSOLUTE(f) (*(f) == '/') 39 | # endif /* MACOS_TRADITIONAL */ 40 | # endif /* DOSISH */ 41 | # endif /* NETWARE */ 42 | # endif /* WIN32 */ 43 | #endif /* VMS */ 44 | 45 | /* 46 | * Local variables: 47 | * c-indentation-style: bsd 48 | * c-basic-offset: 4 49 | * indent-tabs-mode: t 50 | * End: 51 | * 52 | * ex: set ts=8 sts=4 sw=4 noet: 53 | */ 54 | -------------------------------------------------------------------------------- /microperl-5.10.1/overload.h: -------------------------------------------------------------------------------- 1 | /* -*- buffer-read-only: t -*- 2 | * 3 | * overload.h 4 | * 5 | * Copyright (C) 1997, 1998, 2000, 2001, 2005, 2006, 2007 by Larry Wall 6 | * and others 7 | * 8 | * You may distribute under the terms of either the GNU General Public 9 | * License or the Artistic License, as specified in the README file. 10 | * 11 | * !!!!!!! DO NOT EDIT THIS FILE !!!!!!! 12 | * This file is built by overload.pl 13 | */ 14 | 15 | enum { 16 | fallback_amg, 17 | to_sv_amg, 18 | to_av_amg, 19 | to_hv_amg, 20 | to_gv_amg, 21 | to_cv_amg, 22 | inc_amg, 23 | dec_amg, 24 | bool__amg, 25 | numer_amg, 26 | string_amg, 27 | not_amg, 28 | copy_amg, 29 | abs_amg, 30 | neg_amg, 31 | iter_amg, 32 | int_amg, 33 | lt_amg, 34 | le_amg, 35 | gt_amg, 36 | ge_amg, 37 | eq_amg, 38 | ne_amg, 39 | slt_amg, 40 | sle_amg, 41 | sgt_amg, 42 | sge_amg, 43 | seq_amg, 44 | sne_amg, 45 | nomethod_amg, 46 | add_amg, 47 | add_ass_amg, 48 | subtr_amg, 49 | subtr_ass_amg, 50 | mult_amg, 51 | mult_ass_amg, 52 | div_amg, 53 | div_ass_amg, 54 | modulo_amg, 55 | modulo_ass_amg, 56 | pow_amg, 57 | pow_ass_amg, 58 | lshift_amg, 59 | lshift_ass_amg, 60 | rshift_amg, 61 | rshift_ass_amg, 62 | band_amg, 63 | band_ass_amg, 64 | bor_amg, 65 | bor_ass_amg, 66 | bxor_amg, 67 | bxor_ass_amg, 68 | ncmp_amg, 69 | scmp_amg, 70 | compl_amg, 71 | atan2_amg, 72 | cos_amg, 73 | sin_amg, 74 | exp_amg, 75 | log_amg, 76 | sqrt_amg, 77 | repeat_amg, 78 | repeat_ass_amg, 79 | concat_amg, 80 | concat_ass_amg, 81 | smart_amg, 82 | DESTROY_amg, 83 | max_amg_code 84 | /* Do not leave a trailing comma here. C9X allows it, C89 doesn't. */ 85 | }; 86 | 87 | #define NofAMmeth max_amg_code 88 | 89 | -------------------------------------------------------------------------------- /microperl-5.10.1/EXTERN.h: -------------------------------------------------------------------------------- 1 | /* EXTERN.h 2 | * 3 | * Copyright (C) 1991, 1992, 1993, 1995, 1996, 1997, 1998, 1999, 4 | * 2000, 2001, by Larry Wall and others 5 | * 6 | * You may distribute under the terms of either the GNU General Public 7 | * License or the Artistic License, as specified in the README file. 8 | * 9 | */ 10 | 11 | /* 12 | * EXT designates a global var which is defined in perl.h 13 | * dEXT designates a global var which is defined in another 14 | * file, so we can't count on finding it in perl.h 15 | * (this practice should be avoided). 16 | */ 17 | #undef EXT 18 | #undef dEXT 19 | #undef EXTCONST 20 | #undef dEXTCONST 21 | #if defined(VMS) && !defined(__GNUC__) 22 | /* Suppress portability warnings from DECC for VMS-specific extensions */ 23 | # ifdef __DECC 24 | # pragma message disable (GLOBALEXT,NOSHAREEXT,READONLYEXT) 25 | # endif 26 | # define EXT globalref 27 | # define dEXT globaldef {"$GLOBAL_RW_VARS"} noshare 28 | # define EXTCONST globalref 29 | # define dEXTCONST globaldef {"$GLOBAL_RO_VARS"} readonly 30 | #else 31 | # if (defined(WIN32) || defined(__SYMBIAN32__)) && !defined(PERL_STATIC_SYMS) 32 | # if defined(PERLDLL) || defined(__SYMBIAN32__) 33 | # define EXT extern __declspec(dllexport) 34 | # define dEXT 35 | # define EXTCONST extern __declspec(dllexport) const 36 | # define dEXTCONST const 37 | # else 38 | # define EXT extern __declspec(dllimport) 39 | # define dEXT 40 | # define EXTCONST extern __declspec(dllimport) const 41 | # define dEXTCONST const 42 | # endif 43 | # else 44 | # if defined(__CYGWIN__) && defined(USEIMPORTLIB) 45 | # define EXT extern __declspec(dllimport) 46 | # define dEXT 47 | # define EXTCONST extern __declspec(dllimport) const 48 | # define dEXTCONST const 49 | # else 50 | # define EXT extern 51 | # define dEXT 52 | # define EXTCONST extern const 53 | # define dEXTCONST const 54 | # endif 55 | # endif 56 | #endif 57 | 58 | #undef INIT 59 | #define INIT(x) 60 | 61 | #undef DOINIT 62 | -------------------------------------------------------------------------------- /microperl-5.10.1/fakethr.h: -------------------------------------------------------------------------------- 1 | /* fakethr.h 2 | * 3 | * Copyright (C) 1999, by Larry Wall and others 4 | * 5 | * You may distribute under the terms of either the GNU General Public 6 | * License or the Artistic License, as specified in the README file. 7 | * 8 | */ 9 | 10 | typedef int perl_mutex; 11 | typedef int perl_key; 12 | 13 | typedef struct perl_thread *perl_os_thread; 14 | /* With fake threads, thr is global(ish) so we don't need dTHR */ 15 | #define dTHR extern int errno 16 | 17 | struct perl_wait_queue { 18 | struct perl_thread * thread; 19 | struct perl_wait_queue * next; 20 | }; 21 | typedef struct perl_wait_queue *perl_cond; 22 | 23 | /* Ask thread.h to include our per-thread extras */ 24 | #define HAVE_THREAD_INTERN 25 | struct thread_intern { 26 | perl_os_thread next_run, prev_run; /* Linked list of runnable threads */ 27 | perl_cond wait_queue; /* Wait queue that we are waiting on */ 28 | IV private; /* Holds data across time slices */ 29 | I32 savemark; /* Holds MARK for thread join values */ 30 | }; 31 | 32 | #define init_thread_intern(t) \ 33 | STMT_START { \ 34 | t->self = (t); \ 35 | (t)->i.next_run = (t)->i.prev_run = (t); \ 36 | (t)->i.wait_queue = 0; \ 37 | (t)->i.private = 0; \ 38 | } STMT_END 39 | 40 | /* 41 | * Note that SCHEDULE() is only callable from pp code (which 42 | * must be expecting to be restarted). We'll have to do 43 | * something a bit different for XS code. 44 | */ 45 | 46 | #define SCHEDULE() return schedule(), PL_op 47 | 48 | #define MUTEX_LOCK(m) 49 | #define MUTEX_UNLOCK(m) 50 | #define MUTEX_INIT(m) 51 | #define MUTEX_DESTROY(m) 52 | #define COND_INIT(c) perl_cond_init(c) 53 | #define COND_SIGNAL(c) perl_cond_signal(c) 54 | #define COND_BROADCAST(c) perl_cond_broadcast(c) 55 | #define COND_WAIT(c, m) \ 56 | STMT_START { \ 57 | perl_cond_wait(c); \ 58 | SCHEDULE(); \ 59 | } STMT_END 60 | #define COND_DESTROY(c) 61 | 62 | #define THREAD_CREATE(t, f) f((t)) 63 | #define THREAD_POST_CREATE(t) NOOP 64 | 65 | #define YIELD NOOP 66 | 67 | /* 68 | * Local variables: 69 | * c-indentation-style: bsd 70 | * c-basic-offset: 4 71 | * indent-tabs-mode: t 72 | * End: 73 | * 74 | * ex: set ts=8 sts=4 sw=4 noet: 75 | */ 76 | -------------------------------------------------------------------------------- /microperl-5.10.1/cc_runtime.h: -------------------------------------------------------------------------------- 1 | /* cc_runtime.h 2 | * 3 | * Copyright (C) 1999, 2000, 2001, 2004, 2006, 2008 by Larry Wall and others 4 | * 5 | * You may distribute under the terms of either the GNU General Public 6 | * License or the Artistic License, as specified in the README file. 7 | * 8 | */ 9 | 10 | #define DOOP(ppname) PUTBACK; PL_op = ppname(aTHX); SPAGAIN 11 | #define CCPP(s) OP * s(pTHX) 12 | 13 | #define PP_LIST(g) do { \ 14 | dMARK; \ 15 | if (g != G_ARRAY) { \ 16 | if (++MARK <= SP) \ 17 | *MARK = *SP; \ 18 | else \ 19 | *MARK = &PL_sv_undef; \ 20 | SP = MARK; \ 21 | } \ 22 | } while (0) 23 | 24 | #define MAYBE_TAINT_SASSIGN_SRC(sv) \ 25 | if (PL_tainting && PL_tainted && (!SvGMAGICAL(left) || !SvSMAGICAL(left) || \ 26 | !((mg=mg_find(left, PERL_MAGIC_taint)) && mg->mg_len & 1)))\ 27 | TAINT_NOT 28 | 29 | #define PP_PREINC(sv) do { \ 30 | if (SvIOK(sv)) { \ 31 | ++SvIVX(sv); \ 32 | SvFLAGS(sv) &= ~(SVf_NOK|SVf_POK|SVp_NOK|SVp_POK); \ 33 | } \ 34 | else \ 35 | sv_inc(sv); \ 36 | SvSETMAGIC(sv); \ 37 | } while (0) 38 | 39 | #define PP_UNSTACK do { \ 40 | TAINT_NOT; \ 41 | PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp; \ 42 | FREETMPS; \ 43 | oldsave = PL_scopestack[PL_scopestack_ix - 1]; \ 44 | LEAVE_SCOPE(oldsave); \ 45 | SPAGAIN; \ 46 | } while(0) 47 | 48 | /* Anyone using eval "" deserves this mess */ 49 | #define PP_EVAL(ppaddr, nxt) do { \ 50 | dJMPENV; \ 51 | int ret; \ 52 | PUTBACK; \ 53 | JMPENV_PUSH(ret); \ 54 | switch (ret) { \ 55 | case 0: \ 56 | PL_op = ppaddr(aTHX); \ 57 | if (PL_op != nxt) CALLRUNOPS(aTHX); \ 58 | JMPENV_POP; \ 59 | break; \ 60 | case 1: JMPENV_POP; JMPENV_JUMP(1); \ 61 | case 2: JMPENV_POP; JMPENV_JUMP(2); \ 62 | case 3: \ 63 | JMPENV_POP; \ 64 | if (PL_restartop && PL_restartop != nxt) \ 65 | JMPENV_JUMP(3); \ 66 | } \ 67 | PL_op = nxt; \ 68 | SPAGAIN; \ 69 | } while (0) 70 | 71 | 72 | #define PP_ENTERTRY(jmpbuf,label) \ 73 | STMT_START { \ 74 | int ret; \ 75 | JMPENV_PUSH_ENV(jmpbuf,ret); \ 76 | switch (ret) { \ 77 | case 1: JMPENV_POP_ENV(jmpbuf); JMPENV_JUMP(1);\ 78 | case 2: JMPENV_POP_ENV(jmpbuf); JMPENV_JUMP(2);\ 79 | case 3: JMPENV_POP_ENV(jmpbuf); SPAGAIN; goto label;\ 80 | } \ 81 | } STMT_END 82 | #define PP_LEAVETRY \ 83 | STMT_START{ PL_top_env=PL_top_env->je_prev; }STMT_END 84 | -------------------------------------------------------------------------------- /microperl-5.10.1/mg.h: -------------------------------------------------------------------------------- 1 | /* mg.h 2 | * 3 | * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1999, 4 | * 2000, 2002, 2005, 2006, 2007, 2008 by Larry Wall and others 5 | * 6 | * You may distribute under the terms of either the GNU General Public 7 | * License or the Artistic License, as specified in the README file. 8 | * 9 | */ 10 | 11 | #ifdef STRUCT_MGVTBL_DEFINITION 12 | STRUCT_MGVTBL_DEFINITION; 13 | #else 14 | struct mgvtbl { 15 | int (CPERLscope(*svt_get)) (pTHX_ SV *sv, MAGIC* mg); 16 | int (CPERLscope(*svt_set)) (pTHX_ SV *sv, MAGIC* mg); 17 | U32 (CPERLscope(*svt_len)) (pTHX_ SV *sv, MAGIC* mg); 18 | int (CPERLscope(*svt_clear))(pTHX_ SV *sv, MAGIC* mg); 19 | int (CPERLscope(*svt_free)) (pTHX_ SV *sv, MAGIC* mg); 20 | int (CPERLscope(*svt_copy)) (pTHX_ SV *sv, MAGIC* mg, 21 | SV *nsv, const char *name, int namlen); 22 | int (CPERLscope(*svt_dup)) (pTHX_ MAGIC *mg, CLONE_PARAMS *param); 23 | int (CPERLscope(*svt_local))(pTHX_ SV *nsv, MAGIC *mg); 24 | }; 25 | #endif 26 | 27 | struct magic { 28 | MAGIC* mg_moremagic; 29 | MGVTBL* mg_virtual; /* pointer to magic functions */ 30 | U16 mg_private; 31 | char mg_type; 32 | U8 mg_flags; 33 | I32 mg_len; 34 | SV* mg_obj; 35 | char* mg_ptr; 36 | }; 37 | 38 | #define MGf_TAINTEDDIR 1 /* PERL_MAGIC_envelem only */ 39 | #define MGf_MINMATCH 1 /* PERL_MAGIC_regex_global only */ 40 | #define MGf_REFCOUNTED 2 41 | #define MGf_GSKIP 4 42 | #define MGf_COPY 8 /* has an svt_copy MGVTBL entry */ 43 | #define MGf_DUP 0x10 /* has an svt_dup MGVTBL entry */ 44 | #define MGf_LOCAL 0x20 /* has an svt_local MGVTBL entry */ 45 | 46 | #define MgTAINTEDDIR(mg) (mg->mg_flags & MGf_TAINTEDDIR) 47 | #define MgTAINTEDDIR_on(mg) (mg->mg_flags |= MGf_TAINTEDDIR) 48 | #define MgTAINTEDDIR_off(mg) (mg->mg_flags &= ~MGf_TAINTEDDIR) 49 | 50 | #define MgPV(mg,lp) ((((int)(lp = (mg)->mg_len)) == HEf_SVKEY) ? \ 51 | SvPV(MUTABLE_SV((mg)->mg_ptr),lp) : \ 52 | (mg)->mg_ptr) 53 | #define MgPV_const(mg,lp) ((((int)(lp = (mg)->mg_len)) == HEf_SVKEY) ? \ 54 | SvPV_const(MUTABLE_SV((mg)->mg_ptr),lp) : \ 55 | (const char*)(mg)->mg_ptr) 56 | #define MgPV_nolen_const(mg) (((((int)(mg)->mg_len)) == HEf_SVKEY) ? \ 57 | SvPV_nolen_const(MUTABLE_SV((mg)->mg_ptr)) : \ 58 | (const char*)(mg)->mg_ptr) 59 | 60 | #define SvTIED_mg(sv,how) (SvRMAGICAL(sv) ? mg_find((sv),(how)) : NULL) 61 | #define SvTIED_obj(sv,mg) \ 62 | ((mg)->mg_obj ? (mg)->mg_obj : sv_2mortal(newRV(sv))) 63 | 64 | /* 65 | * Local variables: 66 | * c-indentation-style: bsd 67 | * c-basic-offset: 4 68 | * indent-tabs-mode: t 69 | * End: 70 | * 71 | * ex: set ts=8 sts=4 sw=4 noet: 72 | */ 73 | -------------------------------------------------------------------------------- /microperl-5.10.1/overload.c: -------------------------------------------------------------------------------- 1 | /* -*- buffer-read-only: t -*- 2 | * 3 | * overload.c 4 | * 5 | * Copyright (C) 1997, 1998, 2000, 2001, 2005, 2006, 2007 by Larry Wall 6 | * and others 7 | * 8 | * You may distribute under the terms of either the GNU General Public 9 | * License or the Artistic License, as specified in the README file. 10 | * 11 | * !!!!!!! DO NOT EDIT THIS FILE !!!!!!! 12 | * This file is built by overload.pl 13 | */ 14 | 15 | #define AMG_id2name(id) (PL_AMG_names[id]+1) 16 | #define AMG_id2namelen(id) (PL_AMG_namelens[id]-1) 17 | 18 | const U8 PL_AMG_namelens[NofAMmeth] = { 19 | 2, 20 | 4, 21 | 4, 22 | 4, 23 | 4, 24 | 4, 25 | 3, 26 | 3, 27 | 5, 28 | 3, 29 | 3, 30 | 2, 31 | 2, 32 | 4, 33 | 4, 34 | 3, 35 | 4, 36 | 2, 37 | 3, 38 | 2, 39 | 3, 40 | 3, 41 | 3, 42 | 3, 43 | 3, 44 | 3, 45 | 3, 46 | 3, 47 | 3, 48 | 9, 49 | 2, 50 | 3, 51 | 2, 52 | 3, 53 | 2, 54 | 3, 55 | 2, 56 | 3, 57 | 2, 58 | 3, 59 | 3, 60 | 4, 61 | 3, 62 | 4, 63 | 3, 64 | 4, 65 | 2, 66 | 3, 67 | 2, 68 | 3, 69 | 2, 70 | 3, 71 | 4, 72 | 4, 73 | 2, 74 | 6, 75 | 4, 76 | 4, 77 | 4, 78 | 4, 79 | 5, 80 | 2, 81 | 3, 82 | 2, 83 | 3, 84 | 3, 85 | 7 86 | }; 87 | 88 | const char * const PL_AMG_names[NofAMmeth] = { 89 | /* Names kept in the symbol table. fallback => "()", the rest has 90 | "(" prepended. The only other place in perl which knows about 91 | this convention is AMG_id2name (used for debugging output and 92 | 'nomethod' only), the only other place which has it hardwired is 93 | overload.pm. */ 94 | "()", 95 | "(${}", 96 | "(@{}", 97 | "(%{}", 98 | "(*{}", 99 | "(&{}", 100 | "(++", 101 | "(--", 102 | "(bool", 103 | "(0+", 104 | "(\"\"", 105 | "(!", 106 | "(=", 107 | "(abs", 108 | "(neg", 109 | "(<>", 110 | "(int", 111 | "(<", 112 | "(<=", 113 | "(>", 114 | "(>=", 115 | "(==", 116 | "(!=", 117 | "(lt", 118 | "(le", 119 | "(gt", 120 | "(ge", 121 | "(eq", 122 | "(ne", 123 | "(nomethod", 124 | "(+", 125 | "(+=", 126 | "(-", 127 | "(-=", 128 | "(*", 129 | "(*=", 130 | "(/", 131 | "(/=", 132 | "(%", 133 | "(%=", 134 | "(**", 135 | "(**=", 136 | "(<<", 137 | "(<<=", 138 | "(>>", 139 | "(>>=", 140 | "(&", 141 | "(&=", 142 | "(|", 143 | "(|=", 144 | "(^", 145 | "(^=", 146 | "(<=>", 147 | "(cmp", 148 | "(~", 149 | "(atan2", 150 | "(cos", 151 | "(sin", 152 | "(exp", 153 | "(log", 154 | "(sqrt", 155 | "(x", 156 | "(x=", 157 | "(.", 158 | "(.=", 159 | "(~~", 160 | "DESTROY" 161 | }; 162 | -------------------------------------------------------------------------------- /microperl-5.10.1/perlsfio.h: -------------------------------------------------------------------------------- 1 | /* perlsfio.h 2 | * 3 | * Copyright (C) 1996, 1999, 2000, 2001, 2002, 2003, 2005, 2007, 4 | * by Larry Wall and others 5 | * 6 | * You may distribute under the terms of either the GNU General Public 7 | * License or the Artistic License, as specified in the README file. 8 | * 9 | */ 10 | 11 | /* The next #ifdef should be redundant if Configure behaves ... */ 12 | #ifndef FILE 13 | #define FILE FILE 14 | #endif 15 | #ifdef I_SFIO 16 | #include 17 | #endif 18 | 19 | /* sfio 2000 changed _stdopen to _stdfdopen */ 20 | #if SFIO_VERSION >= 20000101L 21 | #define _stdopen _stdfdopen 22 | #endif 23 | 24 | extern Sfio_t* _stdopen _ARG_((int, const char*)); 25 | extern int _stdprintf _ARG_((const char*, ...)); 26 | 27 | #define PerlIO Sfio_t 28 | #define PerlIO_stderr() sfstderr 29 | #define PerlIO_stdout() sfstdout 30 | #define PerlIO_stdin() sfstdin 31 | 32 | #define PerlIO_isutf8(f) 0 33 | 34 | #define PerlIO_printf sfprintf 35 | #define PerlIO_stdoutf _stdprintf 36 | #define PerlIO_vprintf(f,fmt,a) sfvprintf(f,fmt,a) 37 | #define PerlIO_read(f,buf,count) sfread(f,buf,count) 38 | #define PerlIO_write(f,buf,count) sfwrite(f,buf,count) 39 | #define PerlIO_open(path,mode) sfopen(NULL,path,mode) 40 | #define PerlIO_fdopen(fd,mode) _stdopen(fd,mode) 41 | #define PerlIO_reopen(path,mode,f) sfopen(f,path,mode) 42 | #define PerlIO_close(f) sfclose(f) 43 | #define PerlIO_puts(f,s) sfputr(f,s,-1) 44 | #define PerlIO_putc(f,c) sfputc(f,c) 45 | #define PerlIO_ungetc(f,c) sfungetc(f,c) 46 | #define PerlIO_sprintf sfsprintf 47 | #define PerlIO_getc(f) sfgetc(f) 48 | #define PerlIO_eof(f) sfeof(f) 49 | #define PerlIO_error(f) sferror(f) 50 | #define PerlIO_fileno(f) sffileno(f) 51 | #define PerlIO_clearerr(f) sfclrerr(f) 52 | #define PerlIO_flush(f) sfsync(f) 53 | #define PerlIO_tell(f) sftell(f) 54 | #define PerlIO_seek(f,o,w) sfseek(f,o,w) 55 | #define PerlIO_rewind(f) (void) sfseek((f),0L,0) 56 | #define PerlIO_tmpfile() sftmp(0) 57 | #define PerlIO_exportFILE(f,fl) Perl_croak(aTHX_ "Export to FILE * unimplemented") 58 | #define PerlIO_releaseFILE(p,f) Perl_croak(aTHX_ "Release of FILE * unimplemented") 59 | 60 | #define PerlIO_setlinebuf(f) sfset(f,SF_LINE,1) 61 | 62 | /* Now our interface to equivalent of Configure's FILE_xxx macros */ 63 | 64 | #define PerlIO_has_cntptr(f) 1 65 | #define PerlIO_get_ptr(f) ((f)->next) 66 | #define PerlIO_get_cnt(f) ((f)->endr - (f)->next) 67 | #define PerlIO_canset_cnt(f) 1 68 | #define PerlIO_fast_gets(f) 1 69 | #define PerlIO_set_ptrcnt(f,p,c) STMT_START {(f)->next = (unsigned char *)(p); assert(PerlIO_get_cnt(f) == (c));} STMT_END 70 | #define PerlIO_set_cnt(f,c) STMT_START {(f)->next = (f)->endr - (c);} STMT_END 71 | 72 | #define PerlIO_has_base(f) 1 73 | #define PerlIO_get_base(f) ((f)->data) 74 | #define PerlIO_get_bufsiz(f) ((f)->endr - (f)->data) 75 | 76 | /* 77 | * Local variables: 78 | * c-indentation-style: bsd 79 | * c-basic-offset: 4 80 | * indent-tabs-mode: t 81 | * End: 82 | * 83 | * ex: set ts=8 sts=4 sw=4 noet: 84 | */ 85 | -------------------------------------------------------------------------------- /microperl-5.10.1/perlapi.c: -------------------------------------------------------------------------------- 1 | /* -*- buffer-read-only: t -*- 2 | * 3 | * perlapi.c 4 | * 5 | * Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 6 | * 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, by Larry Wall and others 7 | * 8 | * You may distribute under the terms of either the GNU General Public 9 | * License or the Artistic License, as specified in the README file. 10 | * 11 | * !!!!!!! DO NOT EDIT THIS FILE !!!!!!! 12 | * This file is built by embed.pl from data in embed.fnc, embed.pl, 13 | * pp.sym, intrpvar.h, and perlvars.h. 14 | * Any changes made here will be lost! 15 | * 16 | * Edit those files and run 'make regen_headers' to effect changes. 17 | * 18 | * 19 | * Up to the threshold of the door there mounted a flight of twenty-seven 20 | * broad stairs, hewn by some unknown art of the same black stone. This 21 | * was the only entrance to the tower; ... 22 | * 23 | * [p.577 of _The Lord of the Rings_, III/x: "The Voice of Saruman"] 24 | * 25 | */ 26 | 27 | #include "EXTERN.h" 28 | #include "perl.h" 29 | #include "perlapi.h" 30 | 31 | #if defined (MULTIPLICITY) 32 | 33 | /* accessor functions for Perl variables (provides binary compatibility) */ 34 | START_EXTERN_C 35 | 36 | #undef PERLVAR 37 | #undef PERLVARA 38 | #undef PERLVARI 39 | #undef PERLVARIC 40 | #undef PERLVARISC 41 | 42 | #define PERLVAR(v,t) t* Perl_##v##_ptr(pTHX) \ 43 | { dVAR; PERL_UNUSED_CONTEXT; return &(aTHX->v); } 44 | #define PERLVARA(v,n,t) PL_##v##_t* Perl_##v##_ptr(pTHX) \ 45 | { dVAR; PERL_UNUSED_CONTEXT; return &(aTHX->v); } 46 | 47 | #define PERLVARI(v,t,i) PERLVAR(v,t) 48 | #define PERLVARIC(v,t,i) PERLVAR(v, const t) 49 | #define PERLVARISC(v,i) PL_##v##_t* Perl_##v##_ptr(pTHX) \ 50 | { dVAR; PERL_UNUSED_CONTEXT; return &(aTHX->v); } 51 | 52 | #include "intrpvar.h" 53 | 54 | #undef PERLVAR 55 | #undef PERLVARA 56 | #define PERLVAR(v,t) t* Perl_##v##_ptr(pTHX) \ 57 | { dVAR; PERL_UNUSED_CONTEXT; return &(PL_##v); } 58 | #define PERLVARA(v,n,t) PL_##v##_t* Perl_##v##_ptr(pTHX) \ 59 | { dVAR; PERL_UNUSED_CONTEXT; return &(PL_##v); } 60 | #undef PERLVARIC 61 | #undef PERLVARISC 62 | #define PERLVARIC(v,t,i) \ 63 | const t* Perl_##v##_ptr(pTHX) \ 64 | { PERL_UNUSED_CONTEXT; return (const t *)&(PL_##v); } 65 | #define PERLVARISC(v,i) PL_##v##_t* Perl_##v##_ptr(pTHX) \ 66 | { dVAR; PERL_UNUSED_CONTEXT; return &(PL_##v); } 67 | #include "perlvars.h" 68 | 69 | #undef PERLVAR 70 | #undef PERLVARA 71 | #undef PERLVARI 72 | #undef PERLVARIC 73 | #undef PERLVARISC 74 | 75 | #ifndef PERL_GLOBAL_STRUCT 76 | /* A few evil special cases. Could probably macrofy this. */ 77 | #undef PL_ppaddr 78 | #undef PL_check 79 | #undef PL_fold_locale 80 | Perl_ppaddr_t** Perl_Gppaddr_ptr(pTHX) { 81 | static Perl_ppaddr_t* const ppaddr_ptr = PL_ppaddr; 82 | PERL_UNUSED_CONTEXT; 83 | return (Perl_ppaddr_t**)&ppaddr_ptr; 84 | } 85 | Perl_check_t** Perl_Gcheck_ptr(pTHX) { 86 | static Perl_check_t* const check_ptr = PL_check; 87 | PERL_UNUSED_CONTEXT; 88 | return (Perl_check_t**)&check_ptr; 89 | } 90 | unsigned char** Perl_Gfold_locale_ptr(pTHX) { 91 | static unsigned char* const fold_locale_ptr = PL_fold_locale; 92 | PERL_UNUSED_CONTEXT; 93 | return (unsigned char**)&fold_locale_ptr; 94 | } 95 | #endif 96 | 97 | END_EXTERN_C 98 | 99 | #endif /* MULTIPLICITY */ 100 | 101 | /* ex: set ro: */ 102 | -------------------------------------------------------------------------------- /microperl-5.10.1/fakesdio.h: -------------------------------------------------------------------------------- 1 | /* fakestdio.h 2 | * 3 | * Copyright (C) 2000, by Larry Wall and others 4 | * 5 | * You may distribute under the terms of either the GNU General Public 6 | * License or the Artistic License, as specified in the README file. 7 | * 8 | */ 9 | 10 | /* 11 | * This is "source level" stdio compatibility mode. 12 | * We try and #define stdio functions in terms of PerlIO. 13 | */ 14 | #define _CANNOT "CANNOT" 15 | #undef FILE 16 | #define FILE PerlIO 17 | #undef clearerr 18 | #undef fclose 19 | #undef fdopen 20 | #undef feof 21 | #undef ferror 22 | #undef fflush 23 | #undef fgetc 24 | #undef fgetpos 25 | #undef fgets 26 | #undef fileno 27 | #undef flockfile 28 | #undef fopen 29 | #undef fprintf 30 | #undef fputc 31 | #undef fputs 32 | #undef fread 33 | #undef freopen 34 | #undef fscanf 35 | #undef fseek 36 | #undef fsetpos 37 | #undef ftell 38 | #undef ftrylockfile 39 | #undef funlockfile 40 | #undef fwrite 41 | #undef getc 42 | #undef getc_unlocked 43 | #undef getw 44 | #undef pclose 45 | #undef popen 46 | #undef putc 47 | #undef putc_unlocked 48 | #undef putw 49 | #undef rewind 50 | #undef setbuf 51 | #undef setvbuf 52 | #undef stderr 53 | #undef stdin 54 | #undef stdout 55 | #undef tmpfile 56 | #undef ungetc 57 | #undef vfprintf 58 | #undef printf 59 | 60 | /* printf used to live in perl.h like this - more sophisticated 61 | than the rest 62 | */ 63 | #if defined(__GNUC__) && !defined(__STRICT_ANSI__) && !defined(PERL_GCC_PEDANTIC) 64 | #define printf(fmt,args...) PerlIO_stdoutf(fmt,##args) 65 | #else 66 | #define printf PerlIO_stdoutf 67 | #endif 68 | 69 | #define fprintf PerlIO_printf 70 | #define stdin PerlIO_stdin() 71 | #define stdout PerlIO_stdout() 72 | #define stderr PerlIO_stderr() 73 | #define tmpfile() PerlIO_tmpfile() 74 | #define fclose(f) PerlIO_close(f) 75 | #define fflush(f) PerlIO_flush(f) 76 | #define fopen(p,m) PerlIO_open(p,m) 77 | #define vfprintf(f,fmt,a) PerlIO_vprintf(f,fmt,a) 78 | #define fgetc(f) PerlIO_getc(f) 79 | #define fputc(c,f) PerlIO_putc(f,c) 80 | #define fputs(s,f) PerlIO_puts(f,s) 81 | #define getc(f) PerlIO_getc(f) 82 | #define getc_unlocked(f) PerlIO_getc(f) 83 | #define putc(c,f) PerlIO_putc(f,c) 84 | #define putc_unlocked(c,f) PerlIO_putc(c,f) 85 | #define ungetc(c,f) PerlIO_ungetc(f,c) 86 | #if 0 87 | /* return values of read/write need work */ 88 | #define fread(b,s,c,f) PerlIO_read(f,b,(s*c)) 89 | #define fwrite(b,s,c,f) PerlIO_write(f,b,(s*c)) 90 | #else 91 | #define fread(b,s,c,f) _CANNOT fread 92 | #define fwrite(b,s,c,f) _CANNOT fwrite 93 | #endif 94 | #define fseek(f,o,w) PerlIO_seek(f,o,w) 95 | #define ftell(f) PerlIO_tell(f) 96 | #define rewind(f) PerlIO_rewind(f) 97 | #define clearerr(f) PerlIO_clearerr(f) 98 | #define feof(f) PerlIO_eof(f) 99 | #define ferror(f) PerlIO_error(f) 100 | #define fdopen(fd,p) PerlIO_fdopen(fd,p) 101 | #define fileno(f) PerlIO_fileno(f) 102 | #define popen(c,m) my_popen(c,m) 103 | #define pclose(f) my_pclose(f) 104 | 105 | #define fsetpos(f,p) _CANNOT _fsetpos_ 106 | #define fgetpos(f,p) _CANNOT _fgetpos_ 107 | 108 | #define __filbuf(f) _CANNOT __filbuf_ 109 | #define _filbuf(f) _CANNOT _filbuf_ 110 | #define __flsbuf(c,f) _CANNOT __flsbuf_ 111 | #define _flsbuf(c,f) _CANNOT _flsbuf_ 112 | #define getw(f) _CANNOT _getw_ 113 | #define putw(v,f) _CANNOT _putw_ 114 | #if SFIO_VERSION < 20000101L 115 | #define flockfile(f) _CANNOT _flockfile_ 116 | #define ftrylockfile(f) _CANNOT _ftrylockfile_ 117 | #define funlockfile(f) _CANNOT _funlockfile_ 118 | #endif 119 | #define freopen(p,m,f) _CANNOT _freopen_ 120 | #define setbuf(f,b) _CANNOT _setbuf_ 121 | #define setvbuf(f,b,x,s) _CANNOT _setvbuf_ 122 | #define fscanf _CANNOT _fscanf_ 123 | #define fgets(s,n,f) _CANNOT _fgets_ 124 | 125 | /* 126 | * Local variables: 127 | * c-indentation-style: bsd 128 | * c-basic-offset: 4 129 | * indent-tabs-mode: t 130 | * End: 131 | * 132 | * ex: set ts=8 sts=4 sw=4 noet: 133 | */ 134 | -------------------------------------------------------------------------------- /microperl-5.10.1/nostdio.h: -------------------------------------------------------------------------------- 1 | /* nostdio.h 2 | * 3 | * Copyright (C) 1996, 2000, 2001, 2005, by Larry Wall and others 4 | * 5 | * You may distribute under the terms of either the GNU General Public 6 | * License or the Artistic License, as specified in the README file. 7 | * 8 | */ 9 | 10 | /* 11 | * Strong denial of stdio - make all stdio calls (we can think of) errors 12 | */ 13 | /* This is a 1st attempt to stop other include files pulling 14 | in real . 15 | A more ambitious set of possible symbols can be found in 16 | sfio.h (inside an _cplusplus gard). 17 | It is completely pointless as we have already included it ourselves. 18 | */ 19 | 20 | #if !defined(_STDIO_H) && !defined(FILE) && !defined(_STDIO_INCLUDED) && !defined(__STDIO_LOADED) 21 | #define _STDIO_H 22 | #define _STDIO_INCLUDED 23 | #define __STDIO_LOADED 24 | struct _FILE; 25 | #define FILE struct _FILE 26 | #endif 27 | 28 | #define _CANNOT "CANNOT" 29 | 30 | #undef clearerr 31 | #undef fclose 32 | #undef fdopen 33 | #undef feof 34 | #undef ferror 35 | #undef fflush 36 | #undef fgetc 37 | #undef fgetpos 38 | #undef fgets 39 | #undef fileno 40 | #undef flockfile 41 | #undef fopen 42 | #undef fprintf 43 | #undef fputc 44 | #undef fputs 45 | #undef fread 46 | #undef freopen 47 | #undef fscanf 48 | #undef fseek 49 | #undef fsetpos 50 | #undef ftell 51 | #undef ftrylockfile 52 | #undef funlockfile 53 | #undef fwrite 54 | #undef getc 55 | #undef getc_unlocked 56 | #undef getw 57 | #undef pclose 58 | #undef popen 59 | #undef putc 60 | #undef putc_unlocked 61 | #undef putw 62 | #undef rewind 63 | #undef setbuf 64 | #undef setvbuf 65 | #undef stderr 66 | #undef stdin 67 | #undef stdout 68 | #undef tmpfile 69 | #undef ungetc 70 | #undef vfprintf 71 | #undef printf 72 | 73 | #define fprintf _CANNOT _fprintf_ 74 | #define printf _CANNOT _printf_ 75 | #define stdin _CANNOT _stdin_ 76 | #define stdout _CANNOT _stdout_ 77 | #define stderr _CANNOT _stderr_ 78 | #ifndef OS2 79 | #define tmpfile() _CANNOT _tmpfile_ 80 | #endif 81 | #define fclose(f) _CANNOT _fclose_ 82 | #define fflush(f) _CANNOT _fflush_ 83 | #define fopen(p,m) _CANNOT _fopen_ 84 | #define freopen(p,m,f) _CANNOT _freopen_ 85 | #define setbuf(f,b) _CANNOT _setbuf_ 86 | #define setvbuf(f,b,x,s) _CANNOT _setvbuf_ 87 | #define fscanf _CANNOT _fscanf_ 88 | #define vfprintf(f,fmt,a) _CANNOT _vfprintf_ 89 | #define fgetc(f) _CANNOT _fgetc_ 90 | #define fgets(s,n,f) _CANNOT _fgets_ 91 | #define fputc(c,f) _CANNOT _fputc_ 92 | #define fputs(s,f) _CANNOT _fputs_ 93 | #define getc(f) _CANNOT _getc_ 94 | #define putc(c,f) _CANNOT _putc_ 95 | #ifndef OS2 96 | #define ungetc(c,f) _CANNOT _ungetc_ 97 | #endif 98 | #define fread(b,s,c,f) _CANNOT _fread_ 99 | #define fwrite(b,s,c,f) _CANNOT _fwrite_ 100 | #define fgetpos(f,p) _CANNOT _fgetpos_ 101 | #define fseek(f,o,w) _CANNOT _fseek_ 102 | #define fsetpos(f,p) _CANNOT _fsetpos_ 103 | #define ftell(f) _CANNOT _ftell_ 104 | #define rewind(f) _CANNOT _rewind_ 105 | #define clearerr(f) _CANNOT _clearerr_ 106 | #define feof(f) _CANNOT _feof_ 107 | #define ferror(f) _CANNOT _ferror_ 108 | #define __filbuf(f) _CANNOT __filbuf_ 109 | #define __flsbuf(c,f) _CANNOT __flsbuf_ 110 | #define _filbuf(f) _CANNOT _filbuf_ 111 | #define _flsbuf(c,f) _CANNOT _flsbuf_ 112 | #define fdopen(fd,p) _CANNOT _fdopen_ 113 | #define fileno(f) _CANNOT _fileno_ 114 | #if defined(SFIO_VERSION) && SFIO_VERSION < 20000101L 115 | #define flockfile(f) _CANNOT _flockfile_ 116 | #define ftrylockfile(f) _CANNOT _ftrylockfile_ 117 | #define funlockfile(f) _CANNOT _funlockfile_ 118 | #endif 119 | #define getc_unlocked(f) _CANNOT _getc_unlocked_ 120 | #define putc_unlocked(c,f) _CANNOT _putc_unlocked_ 121 | #define popen(c,m) _CANNOT _popen_ 122 | #define getw(f) _CANNOT _getw_ 123 | #define putw(v,f) _CANNOT _putw_ 124 | #ifndef OS2 125 | #define pclose(f) _CANNOT _pclose_ 126 | #endif 127 | 128 | /* 129 | * Local variables: 130 | * c-indentation-style: bsd 131 | * c-basic-offset: 4 132 | * indent-tabs-mode: t 133 | * End: 134 | * 135 | * ex: set ts=8 sts=4 sw=4 noet: 136 | */ 137 | -------------------------------------------------------------------------------- /microperl-5.10.1/parser.h: -------------------------------------------------------------------------------- 1 | /* parser.h 2 | * 3 | * Copyright (c) 2006, 2007, Larry Wall and others 4 | * 5 | * You may distribute under the terms of either the GNU General Public 6 | * License or the Artistic License, as specified in the README file. 7 | * 8 | * This file defines the layout of the parser object used by the parser 9 | * and lexer (perly.c, toke,c). 10 | */ 11 | 12 | #define YYEMPTY (-2) 13 | 14 | typedef struct { 15 | YYSTYPE val; /* semantic value */ 16 | short state; 17 | I32 savestack_ix; /* size of savestack at this state */ 18 | AV *comppad; /* value of PL_comppad when this value was created */ 19 | #ifdef DEBUGGING 20 | const char *name; /* token/rule name for -Dpv */ 21 | #endif 22 | } yy_stack_frame; 23 | 24 | typedef struct yy_parser { 25 | 26 | /* parser state */ 27 | 28 | struct yy_parser *old_parser; /* previous value of PL_parser */ 29 | YYSTYPE yylval; /* value of lookahead symbol, set by yylex() */ 30 | int yychar; /* The lookahead symbol. */ 31 | 32 | /* Number of tokens to shift before error messages enabled. */ 33 | int yyerrstatus; 34 | 35 | int stack_size; 36 | int yylen; /* length of active reduction */ 37 | yy_stack_frame *stack; /* base of stack */ 38 | yy_stack_frame *ps; /* current stack frame */ 39 | 40 | /* lexer state */ 41 | 42 | I32 lex_brackets; /* bracket count */ 43 | I32 lex_casemods; /* casemod count */ 44 | char *lex_brackstack;/* what kind of brackets to pop */ 45 | char *lex_casestack; /* what kind of case mods in effect */ 46 | U8 lex_defer; /* state after determined token */ 47 | bool lex_dojoin; /* doing an array interpolation */ 48 | U8 lex_expect; /* expect after determined token */ 49 | U8 expect; /* how to interpret ambiguous tokens */ 50 | I32 lex_formbrack; /* bracket count at outer format level */ 51 | OP *lex_inpat; /* in pattern $) and $| are special */ 52 | OP *lex_op; /* extra info to pass back on op */ 53 | SV *lex_repl; /* runtime replacement from s/// */ 54 | U16 lex_inwhat; /* what kind of quoting are we in */ 55 | OPCODE last_lop_op; /* last list operator */ 56 | I32 lex_starts; /* how many interps done on level */ 57 | SV *lex_stuff; /* runtime pattern from m// or s/// */ 58 | I32 multi_start; /* 1st line of multi-line string */ 59 | I32 multi_end; /* last line of multi-line string */ 60 | char multi_open; /* delimiter of said string */ 61 | char multi_close; /* delimiter of said string */ 62 | char pending_ident; /* pending identifier lookup */ 63 | bool preambled; 64 | /* XXX I32 space */ 65 | SUBLEXINFO sublex_info; 66 | SV *linestr; /* current chunk of src text */ 67 | char *bufptr; 68 | char *oldbufptr; 69 | char *oldoldbufptr; 70 | char *bufend; 71 | char *linestart; /* beginning of most recently read line */ 72 | char *last_uni; /* position of last named-unary op */ 73 | char *last_lop; /* position of last list operator */ 74 | line_t copline; /* current line number */ 75 | U16 in_my; /* we're compiling a "my"/"our" declaration */ 76 | U8 lex_state; /* next token is determined */ 77 | U8 error_count; /* how many compile errors so far, max 10 */ 78 | HV *in_my_stash; /* declared class of this "my" declaration */ 79 | PerlIO *rsfp; /* current source file pointer */ 80 | AV *rsfp_filters; /* holds chain of active source filters */ 81 | 82 | #ifdef PERL_MAD 83 | SV *endwhite; 84 | I32 faketokens; 85 | I32 lasttoke; 86 | SV *nextwhite; 87 | I32 realtokenstart; 88 | SV *skipwhite; 89 | SV *thisclose; 90 | MADPROP * thismad; 91 | SV *thisopen; 92 | SV *thisstuff; 93 | SV *thistoken; 94 | SV *thiswhite; 95 | 96 | /* What we know when we're in LEX_KNOWNEXT state. */ 97 | NEXTTOKE nexttoke[5]; /* value of next token, if any */ 98 | I32 curforce; 99 | #else 100 | YYSTYPE nextval[5]; /* value of next token, if any */ 101 | I32 nexttype[5]; /* type of next token */ 102 | I32 nexttoke; 103 | #endif 104 | 105 | COP *saved_curcop; /* the previous PL_curcop */ 106 | char tokenbuf[256]; 107 | 108 | } yy_parser; 109 | 110 | /* 111 | * Local variables: 112 | * c-indentation-style: bsd 113 | * c-basic-offset: 4 114 | * indent-tabs-mode: t 115 | * End: 116 | * 117 | * ex: set ts=8 sts=4 sw=4 noet: 118 | */ 119 | -------------------------------------------------------------------------------- /microperl-5.10.1/warnings.h: -------------------------------------------------------------------------------- 1 | /* -*- buffer-read-only: t -*- 2 | !!!!!!! DO NOT EDIT THIS FILE !!!!!!! 3 | This file is built by warnings.pl 4 | Any changes made here will be lost! 5 | */ 6 | 7 | 8 | #define Off(x) ((x) / 8) 9 | #define Bit(x) (1 << ((x) % 8)) 10 | #define IsSet(a, x) ((a)[Off(x)] & Bit(x)) 11 | 12 | 13 | #define G_WARN_OFF 0 /* $^W == 0 */ 14 | #define G_WARN_ON 1 /* -w flag and $^W != 0 */ 15 | #define G_WARN_ALL_ON 2 /* -W flag */ 16 | #define G_WARN_ALL_OFF 4 /* -X flag */ 17 | #define G_WARN_ONCE 8 /* set if 'once' ever enabled */ 18 | #define G_WARN_ALL_MASK (G_WARN_ALL_ON|G_WARN_ALL_OFF) 19 | 20 | #define pWARN_STD NULL 21 | #define pWARN_ALL (((STRLEN*)0)+1) /* use warnings 'all' */ 22 | #define pWARN_NONE (((STRLEN*)0)+2) /* no warnings 'all' */ 23 | 24 | #define specialWARN(x) ((x) == pWARN_STD || (x) == pWARN_ALL || \ 25 | (x) == pWARN_NONE) 26 | 27 | /* if PL_warnhook is set to this value, then warnings die */ 28 | #define PERL_WARNHOOK_FATAL (&PL_sv_placeholder) 29 | 30 | /* Warnings Categories added in Perl 5.008 */ 31 | 32 | #define WARN_ALL 0 33 | #define WARN_CLOSURE 1 34 | #define WARN_DEPRECATED 2 35 | #define WARN_EXITING 3 36 | #define WARN_GLOB 4 37 | #define WARN_IO 5 38 | #define WARN_CLOSED 6 39 | #define WARN_EXEC 7 40 | #define WARN_LAYER 8 41 | #define WARN_NEWLINE 9 42 | #define WARN_PIPE 10 43 | #define WARN_UNOPENED 11 44 | #define WARN_MISC 12 45 | #define WARN_NUMERIC 13 46 | #define WARN_ONCE 14 47 | #define WARN_OVERFLOW 15 48 | #define WARN_PACK 16 49 | #define WARN_PORTABLE 17 50 | #define WARN_RECURSION 18 51 | #define WARN_REDEFINE 19 52 | #define WARN_REGEXP 20 53 | #define WARN_SEVERE 21 54 | #define WARN_DEBUGGING 22 55 | #define WARN_INPLACE 23 56 | #define WARN_INTERNAL 24 57 | #define WARN_MALLOC 25 58 | #define WARN_SIGNAL 26 59 | #define WARN_SUBSTR 27 60 | #define WARN_SYNTAX 28 61 | #define WARN_AMBIGUOUS 29 62 | #define WARN_BAREWORD 30 63 | #define WARN_DIGIT 31 64 | #define WARN_PARENTHESIS 32 65 | #define WARN_PRECEDENCE 33 66 | #define WARN_PRINTF 34 67 | #define WARN_PROTOTYPE 35 68 | #define WARN_QW 36 69 | #define WARN_RESERVED 37 70 | #define WARN_SEMICOLON 38 71 | #define WARN_TAINT 39 72 | #define WARN_THREADS 40 73 | #define WARN_UNINITIALIZED 41 74 | #define WARN_UNPACK 42 75 | #define WARN_UNTIE 43 76 | #define WARN_UTF8 44 77 | #define WARN_VOID 45 78 | 79 | #define WARNsize 12 80 | #define WARN_ALLstring "\125\125\125\125\125\125\125\125\125\125\125\125" 81 | #define WARN_NONEstring "\0\0\0\0\0\0\0\0\0\0\0\0" 82 | 83 | #define isLEXWARN_on (PL_curcop->cop_warnings != pWARN_STD) 84 | #define isLEXWARN_off (PL_curcop->cop_warnings == pWARN_STD) 85 | #define isWARN_ONCE (PL_dowarn & (G_WARN_ON|G_WARN_ONCE)) 86 | #define isWARN_on(c,x) (IsSet((U8 *)(c + 1), 2*(x))) 87 | #define isWARNf_on(c,x) (IsSet((U8 *)(c + 1), 2*(x)+1)) 88 | 89 | #define DUP_WARNINGS(p) \ 90 | (specialWARN(p) ? (STRLEN*)(p) \ 91 | : (STRLEN*)CopyD(p, PerlMemShared_malloc(sizeof(*p)+*p), sizeof(*p)+*p, \ 92 | char)) 93 | 94 | #define ckWARN(w) Perl_ckwarn(aTHX_ packWARN(w)) 95 | #define ckWARN2(w1,w2) Perl_ckwarn(aTHX_ packWARN2(w1,w2)) 96 | #define ckWARN3(w1,w2,w3) Perl_ckwarn(aTHX_ packWARN3(w1,w2,w3)) 97 | #define ckWARN4(w1,w2,w3,w4) Perl_ckwarn(aTHX_ packWARN4(w1,w2,w3,w4)) 98 | 99 | #define ckWARN_d(w) Perl_ckwarn_d(aTHX_ packWARN(w)) 100 | #define ckWARN2_d(w1,w2) Perl_ckwarn_d(aTHX_ packWARN2(w1,w2)) 101 | #define ckWARN3_d(w1,w2,w3) Perl_ckwarn_d(aTHX_ packWARN3(w1,w2,w3)) 102 | #define ckWARN4_d(w1,w2,w3,w4) Perl_ckwarn_d(aTHX_ packWARN4(w1,w2,w3,w4)) 103 | 104 | #define packWARN(a) (a ) 105 | #define packWARN2(a,b) ((a) | ((b)<<8) ) 106 | #define packWARN3(a,b,c) ((a) | ((b)<<8) | ((c)<<16) ) 107 | #define packWARN4(a,b,c,d) ((a) | ((b)<<8) | ((c)<<16) | ((d) <<24)) 108 | 109 | #define unpackWARN1(x) ((x) & 0xFF) 110 | #define unpackWARN2(x) (((x) >>8) & 0xFF) 111 | #define unpackWARN3(x) (((x) >>16) & 0xFF) 112 | #define unpackWARN4(x) (((x) >>24) & 0xFF) 113 | 114 | #define ckDEAD(x) \ 115 | ( ! specialWARN(PL_curcop->cop_warnings) && \ 116 | ( isWARNf_on(PL_curcop->cop_warnings, WARN_ALL) || \ 117 | isWARNf_on(PL_curcop->cop_warnings, unpackWARN1(x)) || \ 118 | isWARNf_on(PL_curcop->cop_warnings, unpackWARN2(x)) || \ 119 | isWARNf_on(PL_curcop->cop_warnings, unpackWARN3(x)) || \ 120 | isWARNf_on(PL_curcop->cop_warnings, unpackWARN4(x)))) 121 | 122 | /* end of file warnings.h */ 123 | /* ex: set ro: */ 124 | -------------------------------------------------------------------------------- /microperl-5.10.1/av.h: -------------------------------------------------------------------------------- 1 | /* av.h 2 | * 3 | * Copyright (C) 1991, 1992, 1993, 1995, 1996, 1997, 1998, 1999, 2000, 4 | * 2001, 2002, 2005, 2006, 2007, 2008, by Larry Wall and others 5 | * 6 | * You may distribute under the terms of either the GNU General Public 7 | * License or the Artistic License, as specified in the README file. 8 | * 9 | */ 10 | 11 | struct xpvav { 12 | union { 13 | NV xnv_nv; /* numeric value, if any */ 14 | HV * xgv_stash; 15 | struct { 16 | U32 xlow; 17 | U32 xhigh; 18 | } xpad_cop_seq; /* used by pad.c for cop_sequence */ 19 | struct { 20 | U32 xbm_previous; /* how many characters in string before rare? */ 21 | U8 xbm_flags; 22 | U8 xbm_rare; /* rarest character in string */ 23 | } xbm_s; /* fields from PVBM */ 24 | } xnv_u; 25 | SSize_t xav_fill; /* Index of last element present */ 26 | SSize_t xav_max; /* max index for which array has space */ 27 | union { 28 | IV xivu_iv; /* integer value or pv offset */ 29 | UV xivu_uv; 30 | void * xivu_p1; 31 | I32 xivu_i32; 32 | HEK * xivu_namehek; 33 | } xiv_u; 34 | union { 35 | MAGIC* xmg_magic; /* linked list of magicalness */ 36 | HV* xmg_ourstash; /* Stash for our (when SvPAD_OUR is true) */ 37 | } xmg_u; 38 | HV* xmg_stash; /* class package */ 39 | }; 40 | 41 | typedef struct { 42 | SSize_t xav_fill; /* Index of last element present */ 43 | SSize_t xav_max; /* max index for which array has space */ 44 | union { 45 | IV xivu_iv; /* integer value or pv offset */ 46 | UV xivu_uv; 47 | void * xivu_p1; 48 | I32 xivu_i32; 49 | HEK * xivu_namehek; 50 | } xiv_u; 51 | union { 52 | MAGIC* xmg_magic; /* linked list of magicalness */ 53 | HV* xmg_ourstash; /* Stash for our (when SvPAD_OUR is true) */ 54 | } xmg_u; 55 | HV* xmg_stash; /* class package */ 56 | } xpvav_allocated; 57 | 58 | /* SV** xav_alloc; */ 59 | #define xav_alloc xiv_u.xivu_p1 60 | /* SV* xav_arylen; */ 61 | 62 | /* SVpav_REAL is set for all AVs whose xav_array contents are refcounted. 63 | * Some things like "@_" and the scratchpad list do not set this, to 64 | * indicate that they are cheating (for efficiency) by not refcounting 65 | * the AV's contents. 66 | * 67 | * SVpav_REIFY is only meaningful on such "fake" AVs (i.e. where SVpav_REAL 68 | * is not set). It indicates that the fake AV is capable of becoming 69 | * real if the array needs to be modified in some way. Functions that 70 | * modify fake AVs check both flags to call av_reify() as appropriate. 71 | * 72 | * Note that the Perl stack and @DB::args have neither flag set. (Thus, 73 | * items that go on the stack are never refcounted.) 74 | * 75 | * These internal details are subject to change any time. AV 76 | * manipulations external to perl should not care about any of this. 77 | * GSAR 1999-09-10 78 | */ 79 | 80 | /* 81 | =head1 Handy Values 82 | 83 | =for apidoc AmU||Nullav 84 | Null AV pointer. 85 | 86 | =head1 Array Manipulation Functions 87 | 88 | =for apidoc Am|int|AvFILL|AV* av 89 | Same as C. Deprecated, use C instead. 90 | 91 | =cut 92 | */ 93 | 94 | #define Nullav Null(AV*) 95 | 96 | #define AvARRAY(av) ((av)->sv_u.svu_array) 97 | #define AvALLOC(av) (*((SV***)&((XPVAV*) SvANY(av))->xav_alloc)) 98 | #define AvMAX(av) ((XPVAV*) SvANY(av))->xav_max 99 | #define AvFILLp(av) ((XPVAV*) SvANY(av))->xav_fill 100 | #define AvARYLEN(av) (*Perl_av_arylen_p(aTHX_ MUTABLE_AV(av))) 101 | 102 | #define AvREAL(av) (SvFLAGS(av) & SVpav_REAL) 103 | #define AvREAL_on(av) (SvFLAGS(av) |= SVpav_REAL) 104 | #define AvREAL_off(av) (SvFLAGS(av) &= ~SVpav_REAL) 105 | #define AvREAL_only(av) (AvREIFY_off(av), SvFLAGS(av) |= SVpav_REAL) 106 | #define AvREIFY(av) (SvFLAGS(av) & SVpav_REIFY) 107 | #define AvREIFY_on(av) (SvFLAGS(av) |= SVpav_REIFY) 108 | #define AvREIFY_off(av) (SvFLAGS(av) &= ~SVpav_REIFY) 109 | #define AvREIFY_only(av) (AvREAL_off(av), SvFLAGS(av) |= SVpav_REIFY) 110 | 111 | #define AvREALISH(av) (SvFLAGS(av) & (SVpav_REAL|SVpav_REIFY)) 112 | 113 | #define AvFILL(av) ((SvRMAGICAL((const SV *) (av))) \ 114 | ? mg_size(MUTABLE_SV(av)) : AvFILLp(av)) 115 | 116 | #define NEGATIVE_INDICES_VAR "NEGATIVE_INDICES" 117 | 118 | /* 119 | =for apidoc newAV 120 | 121 | Creates a new AV. The reference count is set to 1. 122 | 123 | =cut 124 | */ 125 | 126 | #define newAV() MUTABLE_AV(newSV_type(SVt_PVAV)) 127 | 128 | /* 129 | * Local variables: 130 | * c-indentation-style: bsd 131 | * c-basic-offset: 4 132 | * indent-tabs-mode: t 133 | * End: 134 | * 135 | * ex: set ts=8 sts=4 sw=4 noet: 136 | */ 137 | -------------------------------------------------------------------------------- /microperl-5.10.1/unixish.h: -------------------------------------------------------------------------------- 1 | /* unixish.h 2 | * 3 | * Copyright (C) 1993, 1994, 1995, 1996, 1997, 1999, 2000, 2001, 2002, 4 | * 2003, 2006, 2007, by Larry Wall and others 5 | * 6 | * You may distribute under the terms of either the GNU General Public 7 | * License or the Artistic License, as specified in the README file. 8 | * 9 | */ 10 | 11 | /* 12 | * The following symbols are defined if your operating system supports 13 | * functions by that name. All Unixes I know of support them, thus they 14 | * are not checked by the configuration script, but are directly defined 15 | * here. 16 | */ 17 | 18 | #ifndef PERL_MICRO 19 | 20 | /* HAS_IOCTL: 21 | * This symbol, if defined, indicates that the ioctl() routine is 22 | * available to set I/O characteristics 23 | */ 24 | #define HAS_IOCTL /**/ 25 | 26 | /* HAS_UTIME: 27 | * This symbol, if defined, indicates that the routine utime() is 28 | * available to update the access and modification times of files. 29 | */ 30 | #define HAS_UTIME /**/ 31 | 32 | /* HAS_GROUP 33 | * This symbol, if defined, indicates that the getgrnam() and 34 | * getgrgid() routines are available to get group entries. 35 | * The getgrent() has a separate definition, HAS_GETGRENT. 36 | */ 37 | #define HAS_GROUP /**/ 38 | 39 | /* HAS_PASSWD 40 | * This symbol, if defined, indicates that the getpwnam() and 41 | * getpwuid() routines are available to get password entries. 42 | * The getpwent() has a separate definition, HAS_GETPWENT. 43 | */ 44 | #define HAS_PASSWD /**/ 45 | 46 | #define HAS_KILL 47 | #define HAS_WAIT 48 | 49 | #endif /* !PERL_MICRO */ 50 | 51 | /* USEMYBINMODE 52 | * This symbol, if defined, indicates that the program should 53 | * use the routine my_binmode(FILE *fp, char iotype) to insure 54 | * that a file is in "binary" mode -- that is, that no translation 55 | * of bytes occurs on read or write operations. 56 | */ 57 | #undef USEMYBINMODE 58 | 59 | /* Stat_t: 60 | * This symbol holds the type used to declare buffers for information 61 | * returned by stat(). It's usually just struct stat. It may be necessary 62 | * to include and to get any typedef'ed 63 | * information. 64 | */ 65 | #define Stat_t struct stat 66 | 67 | /* USE_STAT_RDEV: 68 | * This symbol is defined if this system has a stat structure declaring 69 | * st_rdev 70 | */ 71 | #define USE_STAT_RDEV /**/ 72 | 73 | /* ACME_MESS: 74 | * This symbol, if defined, indicates that error messages should be 75 | * should be generated in a format that allows the use of the Acme 76 | * GUI/editor's autofind feature. 77 | */ 78 | #undef ACME_MESS /**/ 79 | 80 | /* UNLINK_ALL_VERSIONS: 81 | * This symbol, if defined, indicates that the program should arrange 82 | * to remove all versions of a file if unlink() is called. This is 83 | * probably only relevant for VMS. 84 | */ 85 | /* #define UNLINK_ALL_VERSIONS / **/ 86 | 87 | /* VMS: 88 | * This symbol, if defined, indicates that the program is running under 89 | * VMS. It is currently automatically set by cpps running under VMS, 90 | * and is included here for completeness only. 91 | */ 92 | /* #define VMS / **/ 93 | 94 | /* ALTERNATE_SHEBANG: 95 | * This symbol, if defined, contains a "magic" string which may be used 96 | * as the first line of a Perl program designed to be executed directly 97 | * by name, instead of the standard Unix #!. If ALTERNATE_SHEBANG 98 | * begins with a character other then #, then Perl will only treat 99 | * it as a command line if it finds the string "perl" in the first 100 | * word; otherwise it's treated as the first line of code in the script. 101 | * (IOW, Perl won't hand off to another interpreter via an alternate 102 | * shebang sequence that might be legal Perl code.) 103 | */ 104 | /* #define ALTERNATE_SHEBANG "#!" / **/ 105 | 106 | # include 107 | 108 | #ifndef SIGABRT 109 | # define SIGABRT SIGILL 110 | #endif 111 | #ifndef SIGILL 112 | # define SIGILL 6 /* blech */ 113 | #endif 114 | #define ABORT() kill(PerlProc_getpid(),SIGABRT); 115 | 116 | /* 117 | * fwrite1() should be a routine with the same calling sequence as fwrite(), 118 | * but which outputs all of the bytes requested as a single stream (unlike 119 | * fwrite() itself, which on some systems outputs several distinct records 120 | * if the number_of_items parameter is >1). 121 | */ 122 | #define fwrite1 fwrite 123 | 124 | #define Stat(fname,bufptr) stat((fname),(bufptr)) 125 | #define Fstat(fd,bufptr) fstat((fd),(bufptr)) 126 | #define Fflush(fp) fflush(fp) 127 | #define Mkdir(path,mode) mkdir((path),(mode)) 128 | 129 | #ifndef PERL_SYS_INIT_BODY 130 | # define PERL_SYS_INIT_BODY(c,v) \ 131 | MALLOC_CHECK_TAINT2(*c,*v) PERL_FPU_INIT; PERLIO_INIT; MALLOC_INIT 132 | #endif 133 | 134 | #ifndef PERL_SYS_TERM_BODY 135 | # define PERL_SYS_TERM_BODY() \ 136 | HINTS_REFCNT_TERM; OP_REFCNT_TERM; PERLIO_TERM; MALLOC_TERM; 137 | 138 | #endif 139 | 140 | #define BIT_BUCKET "/dev/null" 141 | 142 | #define dXSUB_SYS 143 | 144 | #ifndef NO_ENVIRON_ARRAY 145 | #define USE_ENVIRON_ARRAY 146 | #endif 147 | 148 | /* 149 | * Local variables: 150 | * c-indentation-style: bsd 151 | * c-basic-offset: 4 152 | * indent-tabs-mode: t 153 | * End: 154 | * 155 | * ex: set ts=8 sts=4 sw=4 noet: 156 | */ 157 | -------------------------------------------------------------------------------- /microperl-5.10.1/miniperlmain.c: -------------------------------------------------------------------------------- 1 | /* miniperlmain.c 2 | * 3 | * Copyright (C) 1994, 1995, 1996, 1997, 1999, 2000, 2001, 2002, 2003, 4 | * 2004, 2005, 2006, 2007, by Larry Wall and others 5 | * 6 | * You may distribute under the terms of either the GNU General Public 7 | * License or the Artistic License, as specified in the README file. 8 | * 9 | */ 10 | 11 | /* 12 | * The Road goes ever on and on 13 | * Down from the door where it began. 14 | * 15 | * [Bilbo on p.35 of _The Lord of the Rings_, I/i: "A Long-Expected Party"] 16 | * [Frodo on p.73 of _The Lord of the Rings_, I/iii: "Three Is Company"] 17 | */ 18 | 19 | /* This file contains the main() function for the perl interpreter. 20 | * Note that miniperlmain.c contains main() for the 'miniperl' binary, 21 | * while perlmain.c contains main() for the 'perl' binary. 22 | * 23 | * Miniperl is like perl except that it does not support dynamic loading, 24 | * and in fact is used to build the dynamic modules needed for the 'real' 25 | * perl executable. 26 | */ 27 | 28 | #ifdef OEMVS 29 | #ifdef MYMALLOC 30 | /* sbrk is limited to first heap segment so make it big */ 31 | #pragma runopts(HEAP(8M,500K,ANYWHERE,KEEP,8K,4K) STACK(,,ANY,) ALL31(ON)) 32 | #else 33 | #pragma runopts(HEAP(2M,500K,ANYWHERE,KEEP,8K,4K) STACK(,,ANY,) ALL31(ON)) 34 | #endif 35 | #endif 36 | 37 | 38 | #include "EXTERN.h" 39 | #define PERL_IN_MINIPERLMAIN_C 40 | #include "perl.h" 41 | 42 | static void xs_init (pTHX); 43 | static PerlInterpreter *my_perl; 44 | 45 | #if defined (__MINT__) || defined (atarist) 46 | /* The Atari operating system doesn't have a dynamic stack. The 47 | stack size is determined from this value. */ 48 | long _stksize = 64 * 1024; 49 | #endif 50 | 51 | #if defined(PERL_GLOBAL_STRUCT_PRIVATE) 52 | /* The static struct perl_vars* may seem counterproductive since the 53 | * whole idea PERL_GLOBAL_STRUCT_PRIVATE was to avoid statics, but note 54 | * that this static is not in the shared perl library, the globals PL_Vars 55 | * and PL_VarsPtr will stay away. */ 56 | static struct perl_vars* my_plvarsp; 57 | struct perl_vars* Perl_GetVarsPrivate(void) { return my_plvarsp; } 58 | #endif 59 | 60 | #ifdef NO_ENV_ARRAY_IN_MAIN 61 | extern char **environ; 62 | int 63 | main(int argc, char **argv) 64 | #else 65 | int 66 | main(int argc, char **argv, char **env) 67 | #endif 68 | { 69 | dVAR; 70 | int exitstatus; 71 | #ifdef PERL_GLOBAL_STRUCT 72 | struct perl_vars *plvarsp = init_global_struct(); 73 | # ifdef PERL_GLOBAL_STRUCT_PRIVATE 74 | my_vars = my_plvarsp = plvarsp; 75 | # endif 76 | #endif /* PERL_GLOBAL_STRUCT */ 77 | (void)env; 78 | #ifndef PERL_USE_SAFE_PUTENV 79 | PL_use_safe_putenv = 0; 80 | #endif /* PERL_USE_SAFE_PUTENV */ 81 | 82 | /* if user wants control of gprof profiling off by default */ 83 | /* noop unless Configure is given -Accflags=-DPERL_GPROF_CONTROL */ 84 | PERL_GPROF_MONCONTROL(0); 85 | 86 | #ifdef NO_ENV_ARRAY_IN_MAIN 87 | PERL_SYS_INIT3(&argc,&argv,&environ); 88 | #else 89 | PERL_SYS_INIT3(&argc,&argv,&env); 90 | #endif 91 | 92 | #if defined(USE_ITHREADS) 93 | /* XXX Ideally, this should really be happening in perl_alloc() or 94 | * perl_construct() to keep libperl.a transparently fork()-safe. 95 | * It is currently done here only because Apache/mod_perl have 96 | * problems due to lack of a call to cancel pthread_atfork() 97 | * handlers when shared objects that contain the handlers may 98 | * be dlclose()d. This forces applications that embed perl to 99 | * call PTHREAD_ATFORK() explicitly, but if and only if it hasn't 100 | * been called at least once before in the current process. 101 | * --GSAR 2001-07-20 */ 102 | PTHREAD_ATFORK(Perl_atfork_lock, 103 | Perl_atfork_unlock, 104 | Perl_atfork_unlock); 105 | #endif 106 | 107 | if (!PL_do_undump) { 108 | my_perl = perl_alloc(); 109 | if (!my_perl) 110 | exit(1); 111 | perl_construct(my_perl); 112 | PL_perl_destruct_level = 0; 113 | } 114 | PL_exit_flags |= PERL_EXIT_DESTRUCT_END; 115 | exitstatus = perl_parse(my_perl, xs_init, argc, argv, (char **)NULL); 116 | if (!exitstatus) 117 | perl_run(my_perl); 118 | 119 | exitstatus = perl_destruct(my_perl); 120 | 121 | perl_free(my_perl); 122 | 123 | #if defined(USE_ENVIRON_ARRAY) && defined(PERL_TRACK_MEMPOOL) && !defined(NO_ENV_ARRAY_IN_MAIN) 124 | /* 125 | * The old environment may have been freed by perl_free() 126 | * when PERL_TRACK_MEMPOOL is defined, but without having 127 | * been restored by perl_destruct() before (this is only 128 | * done if destruct_level > 0). 129 | * 130 | * It is important to have a valid environment for atexit() 131 | * routines that are eventually called. 132 | */ 133 | environ = env; 134 | #endif 135 | 136 | #ifdef PERL_GLOBAL_STRUCT 137 | free_global_struct(plvarsp); 138 | #endif /* PERL_GLOBAL_STRUCT */ 139 | 140 | PERL_SYS_TERM(); 141 | 142 | exit(exitstatus); 143 | return exitstatus; 144 | } 145 | 146 | /* Register any extra external extensions */ 147 | 148 | /* Do not delete this line--writemain depends on it */ 149 | 150 | static void 151 | xs_init(pTHX) 152 | { 153 | PERL_UNUSED_CONTEXT; 154 | dXSUB_SYS; 155 | } 156 | 157 | /* 158 | * Local variables: 159 | * c-indentation-style: bsd 160 | * c-basic-offset: 4 161 | * indent-tabs-mode: t 162 | * End: 163 | * 164 | * ex: set ts=8 sts=4 sw=4 noet: 165 | */ 166 | -------------------------------------------------------------------------------- /microperl-5.10.1/Makefile: -------------------------------------------------------------------------------- 1 | LD = $(CC) 2 | CCFLAGS = -c 3 | DEFINES = -DPERL_CORE -DPERL_MICRO -DSTANDARD_C -DPERL_USE_SAFE_PUTENV 4 | OPTIMIZE = -O3 5 | CFLAGS = $(DEFINES) $(OPTIMIZE) 6 | LDFLAGS = 7 | LIBS = -lm 8 | _O = .o 9 | ENV = env 10 | PERL = perl 11 | _X = 12 | RUN = 13 | 14 | all: microperl 15 | 16 | O = uav$(_O) udeb$(_O) udoio$(_O) udoop$(_O) udump$(_O) \ 17 | uglobals$(_O) ugv$(_O) uhv$(_O) umro$(_O)\ 18 | umg$(_O) uperlmain$(_O) uop$(_O) ureentr$(_O) \ 19 | upad$(_O) uperl$(_O) uperlio$(_O) uperly$(_O) upp$(_O) \ 20 | upp_ctl$(_O) upp_hot$(_O) upp_sys$(_O) upp_pack$(_O) upp_sort$(_O) \ 21 | uregcomp$(_O) uregexec$(_O) urun$(_O) \ 22 | uscope$(_O) usv$(_O) utaint$(_O) utoke$(_O) \ 23 | unumeric$(_O) ulocale$(_O) umathoms$(_O) \ 24 | uuniversal$(_O) uutf8$(_O) uutil$(_O) uperlapi$(_O) uxsutils$(_O) 25 | 26 | microperl: $(O) 27 | $(LD) -o $@ $(O) $(LDFLAGS) $(LIBS) 28 | 29 | H = av.h uconfig.h cop.h cv.h embed.h embedvar.h form.h gv.h handy.h \ 30 | hv.h intrpvar.h iperlsys.h mg.h op.h opcode.h opnames.h pad.h \ 31 | patchlevel.h perl.h perlsdio.h perlvars.h perly.h pp.h \ 32 | pp_proto.h proto.h reentr.h regexp.h scope.h sv.h \ 33 | thread.h unixish.h utf8.h util.h uudmap.h warnings.h 34 | 35 | HE = $(H) EXTERN.h 36 | 37 | clean: 38 | rm -f $(O) microperl generate_uudmap$(_X) uudmap.h 39 | rm -f *.o 40 | 41 | distclean: clean 42 | 43 | # The microconfiguration. 44 | 45 | # Cannot use $$ in the command line itself, so using var expansion instead. 46 | Config = '$$Config{$$1}' 47 | patch_uconfig: 48 | $(PERL) -MConfig -pi -e "s/^((?:short|int|long(?:dbl|long)?|ptr|double|[iun]v|u?quad|[iu]\d+|fpos|lseek)(?:size|type)|byteorder|d_quad|quadkind|use64.+)=.*/\\1='"$(Config)"'/g" uconfig.shx 49 | 50 | regen_uconfig uconfig.h: uconfig.sh 51 | $(ENV) CONFIG_SH=uconfig.sh CONFIG_H=uconfig.h sh ./config_h.SH 52 | 53 | # Do not regenerate perly.c and perly.h. 54 | 55 | perly.c: perly.y 56 | -@echo perly.c is uptodate 57 | 58 | perly.h: perly.y 59 | -@echo perly.h is uptodate 60 | 61 | # The microperl objects. 62 | 63 | uav$(_O): $(HE) av.c 64 | $(CC) $(CCFLAGS) -o $@ $(CFLAGS) av.c 65 | 66 | udeb$(_O): $(HE) deb.c 67 | $(CC) $(CCFLAGS) -o $@ $(CFLAGS) deb.c 68 | 69 | udoio$(_O): $(HE) doio.c 70 | $(CC) $(CCFLAGS) -o $@ $(CFLAGS) doio.c 71 | 72 | udoop$(_O): $(HE) doop.c 73 | $(CC) $(CCFLAGS) -o $@ $(CFLAGS) doop.c 74 | 75 | udump$(_O): $(HE) dump.c regcomp.h regnodes.h 76 | $(CC) $(CCFLAGS) -o $@ $(CFLAGS) dump.c 77 | 78 | uglobals$(_O): $(H) globals.c INTERN.h perlapi.h 79 | $(CC) $(CCFLAGS) -o $@ $(CFLAGS) globals.c 80 | 81 | ugv$(_O): $(HE) gv.c 82 | $(CC) $(CCFLAGS) -o $@ $(CFLAGS) gv.c 83 | 84 | umro$(_O): $(HE) mro.c 85 | $(CC) $(CCFLAGS) -o $@ $(CFLAGS) mro.c 86 | 87 | uhv$(_O): $(HE) hv.c 88 | $(CC) $(CCFLAGS) -o $@ $(CFLAGS) hv.c 89 | 90 | umg$(_O): $(HE) mg.c 91 | $(CC) $(CCFLAGS) -o $@ $(CFLAGS) mg.c 92 | 93 | uperlmain$(_O): $(HE) miniperlmain.c 94 | $(CC) $(CCFLAGS) -o $@ $(CFLAGS) miniperlmain.c 95 | 96 | uop$(_O): $(HE) op.c keywords.h 97 | $(CC) $(CCFLAGS) -o $@ $(CFLAGS) -DPERL_EXTERNAL_GLOB op.c 98 | 99 | ureentr$(_O): $(HE) reentr.c 100 | $(CC) $(CCFLAGS) -o $@ $(CFLAGS) reentr.c 101 | 102 | upad$(_O): $(HE) pad.c 103 | $(CC) $(CCFLAGS) -o $@ $(CFLAGS) pad.c 104 | 105 | uperl$(_O): $(HE) perl.c 106 | $(CC) $(CCFLAGS) -o $@ $(CFLAGS) perl.c 107 | 108 | uperlio$(_O): $(HE) perlio.c 109 | $(CC) $(CCFLAGS) -o $@ $(CFLAGS) perlio.c 110 | 111 | uperly$(_O): $(HE) perly.c 112 | $(CC) $(CCFLAGS) -o $@ $(CFLAGS) perly.c 113 | 114 | upp$(_O): $(HE) pp.c 115 | $(CC) $(CCFLAGS) -o $@ $(CFLAGS) pp.c 116 | 117 | upp_ctl$(_O): $(HE) pp_ctl.c 118 | $(CC) $(CCFLAGS) -o $@ $(CFLAGS) pp_ctl.c 119 | 120 | upp_hot$(_O): $(HE) pp_hot.c 121 | $(CC) $(CCFLAGS) -o $@ $(CFLAGS) pp_hot.c 122 | 123 | upp_sys$(_O): $(HE) pp_sys.c 124 | $(CC) $(CCFLAGS) -o $@ $(CFLAGS) pp_sys.c 125 | 126 | upp_pack$(_O): $(HE) pp_pack.c 127 | $(CC) $(CCFLAGS) -o $@ $(CFLAGS) pp_pack.c 128 | 129 | upp_sort$(_O): $(HE) pp_sort.c 130 | $(CC) $(CCFLAGS) -o $@ $(CFLAGS) pp_sort.c 131 | 132 | uregcomp$(_O): $(HE) regcomp.c regcomp.h regnodes.h INTERN.h 133 | $(CC) $(CCFLAGS) -o $@ $(CFLAGS) regcomp.c 134 | 135 | uregexec$(_O): $(HE) regexec.c regcomp.h regnodes.h 136 | $(CC) $(CCFLAGS) -o $@ $(CFLAGS) regexec.c 137 | 138 | urun$(_O): $(HE) run.c 139 | $(CC) $(CCFLAGS) -o $@ $(CFLAGS) run.c 140 | 141 | uscope$(_O): $(HE) scope.c 142 | $(CC) $(CCFLAGS) -o $@ $(CFLAGS) scope.c 143 | 144 | usv$(_O): $(HE) sv.c 145 | $(CC) $(CCFLAGS) -o $@ $(CFLAGS) sv.c 146 | 147 | utaint$(_O): $(HE) taint.c 148 | $(CC) $(CCFLAGS) -o $@ $(CFLAGS) taint.c 149 | 150 | utoke$(_O): $(HE) toke.c keywords.h 151 | $(CC) $(CCFLAGS) -o $@ $(CFLAGS) toke.c 152 | 153 | ulocale$(_O): $(HE) locale.c 154 | $(CC) $(CCFLAGS) -o $@ $(CFLAGS) locale.c 155 | 156 | unumeric$(_O): $(HE) numeric.c 157 | $(CC) $(CCFLAGS) -o $@ $(CFLAGS) numeric.c 158 | 159 | umathoms$(_O): $(HE) mathoms.c 160 | $(CC) $(CCFLAGS) -o $@ $(CFLAGS) mathoms.c 161 | 162 | uuniversal$(_O): $(HE) universal.c XSUB.h 163 | $(CC) $(CCFLAGS) -o $@ $(CFLAGS) universal.c 164 | 165 | uutf8$(_O): $(HE) utf8.c 166 | $(CC) $(CCFLAGS) -o $@ $(CFLAGS) utf8.c 167 | 168 | uutil$(_O): $(HE) util.c 169 | $(CC) $(CCFLAGS) -o $@ $(CFLAGS) util.c 170 | 171 | uperlapi$(_O): $(HE) perlapi.c perlapi.h 172 | $(CC) $(CCFLAGS) -o $@ $(CFLAGS) perlapi.c 173 | 174 | uxsutils$(_O): $(HE) xsutils.c 175 | $(CC) $(CCFLAGS) -o $@ $(CFLAGS) xsutils.c 176 | 177 | uudmap.h: generate_uudmap$(_X) 178 | $(RUN) ./generate_uudmap$(_X) >uudmap.h 179 | 180 | generate_uudmap$(_O): generate_uudmap.c 181 | $(CC) $(CCFLAGS) -o $@ $(CFLAGS) generate_uudmap.c 182 | 183 | generate_uudmap$(_X): generate_uudmap$(_O) 184 | $(LD) -o generate_uudmap $(LDFLAGS) generate_uudmap$(_O) $(LIBS) 185 | 186 | # That's it, folks! 187 | -------------------------------------------------------------------------------- /microperl-5.10.1/perlsdio.h: -------------------------------------------------------------------------------- 1 | /* perlsdio.h 2 | * 3 | * Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 4 | * 2002, 2003, 2006, 2007, 2008 by Larry Wall and others 5 | * 6 | * You may distribute under the terms of either the GNU General Public 7 | * License or the Artistic License, as specified in the README file. 8 | * 9 | */ 10 | 11 | #ifdef PERLIO_IS_STDIO 12 | 13 | #ifdef NETWARE 14 | #include "nwstdio.h" 15 | #else 16 | 17 | /* 18 | * This file #define-s the PerlIO_xxx abstraction onto stdio functions. 19 | * Make this as close to original stdio as possible. 20 | */ 21 | #define PerlIO FILE 22 | #define PerlIO_stderr() PerlSIO_stderr 23 | #define PerlIO_stdout() PerlSIO_stdout 24 | #define PerlIO_stdin() PerlSIO_stdin 25 | 26 | #define PerlIO_isutf8(f) 0 27 | 28 | #define PerlIO_printf PerlSIO_printf 29 | #define PerlIO_stdoutf PerlSIO_stdoutf 30 | #define PerlIO_vprintf(f,fmt,a) PerlSIO_vprintf(f,fmt,a) 31 | #define PerlIO_write(f,buf,count) PerlSIO_fwrite(buf,1,count,f) 32 | #define PerlIO_unread(f,buf,count) (-1) 33 | #define PerlIO_open PerlSIO_fopen 34 | #define PerlIO_fdopen PerlSIO_fdopen 35 | #define PerlIO_reopen PerlSIO_freopen 36 | #define PerlIO_close(f) PerlSIO_fclose(f) 37 | #define PerlIO_puts(f,s) PerlSIO_fputs(f,s) 38 | #define PerlIO_putc(f,c) PerlSIO_fputc(f,c) 39 | #if defined(VMS) 40 | # if defined(__DECC) 41 | /* Unusual definition of ungetc() here to accomodate fast_sv_gets()' 42 | * belief that it can mix getc/ungetc with reads from stdio buffer */ 43 | int decc$ungetc(int __c, FILE *__stream); 44 | # define PerlIO_ungetc(f,c) ((c) == EOF ? EOF : \ 45 | ((*(f) && !((*(f))->_flag & _IONBF) && \ 46 | ((*(f))->_ptr > (*(f))->_base)) ? \ 47 | ((*(f))->_cnt++, *(--(*(f))->_ptr) = (c)) : decc$ungetc(c,f))) 48 | # else 49 | # define PerlIO_ungetc(f,c) ungetc(c,f) 50 | # endif 51 | /* Work around bug in DECCRTL/AXP (DECC v5.x) and some versions of old 52 | * VAXCRTL which causes read from a pipe after EOF has been returned 53 | * once to hang. 54 | */ 55 | # define PerlIO_getc(f) \ 56 | (feof(f) ? EOF : getc(f)) 57 | # define PerlIO_read(f,buf,count) \ 58 | (feof(f) ? 0 : (SSize_t)fread(buf,1,count,f)) 59 | # define PerlIO_tell(f) ftell(f) 60 | #else 61 | # define PerlIO_getc(f) PerlSIO_fgetc(f) 62 | # define PerlIO_ungetc(f,c) PerlSIO_ungetc(c,f) 63 | # define PerlIO_read(f,buf,count) (SSize_t)PerlSIO_fread(buf,1,count,f) 64 | # define PerlIO_tell(f) PerlSIO_ftell(f) 65 | #endif 66 | #define PerlIO_eof(f) PerlSIO_feof(f) 67 | #define PerlIO_getname(f,b) fgetname(f,b) 68 | #define PerlIO_error(f) PerlSIO_ferror(f) 69 | #define PerlIO_fileno(f) PerlSIO_fileno(f) 70 | #define PerlIO_clearerr(f) PerlSIO_clearerr(f) 71 | #define PerlIO_flush(f) PerlSIO_fflush(f) 72 | #if defined(VMS) && !defined(__DECC) 73 | /* Old VAXC RTL doesn't reset EOF on seek; Perl folk seem to expect this */ 74 | #define PerlIO_seek(f,o,w) (((f) && (*f) && ((*f)->_flag &= ~_IOEOF)),fseek(f,o,w)) 75 | #else 76 | # define PerlIO_seek(f,o,w) PerlSIO_fseek(f,o,w) 77 | #endif 78 | 79 | #define PerlIO_rewind(f) PerlSIO_rewind(f) 80 | #define PerlIO_tmpfile() PerlSIO_tmpfile() 81 | 82 | #define PerlIO_importFILE(f,fl) (f) 83 | #define PerlIO_exportFILE(f,fl) (f) 84 | #define PerlIO_findFILE(f) (f) 85 | #define PerlIO_releaseFILE(p,f) ((void) 0) 86 | 87 | #ifdef HAS_SETLINEBUF 88 | #define PerlIO_setlinebuf(f) PerlSIO_setlinebuf(f); 89 | #else 90 | #define PerlIO_setlinebuf(f) PerlSIO_setvbuf(f, NULL, _IOLBF, 0); 91 | #endif 92 | 93 | /* Now our interface to Configure's FILE_xxx macros */ 94 | 95 | #ifdef USE_STDIO_PTR 96 | #define PerlIO_has_cntptr(f) 1 97 | #define PerlIO_get_ptr(f) PerlSIO_get_ptr(f) 98 | #define PerlIO_get_cnt(f) PerlSIO_get_cnt(f) 99 | 100 | #ifdef STDIO_CNT_LVALUE 101 | #define PerlIO_canset_cnt(f) 1 102 | #define PerlIO_set_cnt(f,c) PerlSIO_set_cnt(f,c) 103 | #ifdef STDIO_PTR_LVALUE 104 | #ifdef STDIO_PTR_LVAL_NOCHANGE_CNT 105 | #define PerlIO_fast_gets(f) 1 106 | #endif 107 | #endif /* STDIO_PTR_LVALUE */ 108 | #else /* STDIO_CNT_LVALUE */ 109 | #define PerlIO_canset_cnt(f) 0 110 | #define PerlIO_set_cnt(f,c) abort() 111 | #endif 112 | 113 | #ifdef STDIO_PTR_LVALUE 114 | #ifdef STDIO_PTR_LVAL_NOCHANGE_CNT 115 | #define PerlIO_set_ptrcnt(f,p,c) STMT_START {PerlSIO_set_ptr(f,p), PerlIO_set_cnt(f,c);} STMT_END 116 | #else 117 | #ifdef STDIO_PTR_LVAL_SETS_CNT 118 | /* assert() may pre-process to ""; potential syntax error (FILE_ptr(), ) */ 119 | #define PerlIO_set_ptrcnt(f,p,c) STMT_START {PerlSIO_set_ptr(f,p); assert(PerlSIO_get_cnt(f) == (c));} STMT_END 120 | #define PerlIO_fast_gets(f) 1 121 | #else 122 | #define PerlIO_set_ptrcnt(f,p,c) abort() 123 | #endif 124 | #endif 125 | #endif 126 | 127 | #else /* USE_STDIO_PTR */ 128 | 129 | #define PerlIO_has_cntptr(f) 0 130 | #define PerlIO_canset_cnt(f) 0 131 | #define PerlIO_get_cnt(f) (abort(),0) 132 | #define PerlIO_get_ptr(f) (abort(),(void *)0) 133 | #define PerlIO_set_cnt(f,c) abort() 134 | #define PerlIO_set_ptrcnt(f,p,c) abort() 135 | 136 | #endif /* USE_STDIO_PTR */ 137 | 138 | #ifndef PerlIO_fast_gets 139 | #define PerlIO_fast_gets(f) 0 140 | #endif 141 | 142 | 143 | #ifdef FILE_base 144 | #define PerlIO_has_base(f) 1 145 | #define PerlIO_get_base(f) PerlSIO_get_base(f) 146 | #define PerlIO_get_bufsiz(f) PerlSIO_get_bufsiz(f) 147 | #else 148 | #define PerlIO_has_base(f) 0 149 | #define PerlIO_get_base(f) (abort(),(void *)0) 150 | #define PerlIO_get_bufsiz(f) (abort(),0) 151 | #endif 152 | 153 | #endif /* NETWARE */ 154 | #endif /* PERLIO_IS_STDIO */ 155 | 156 | /* 157 | * Local variables: 158 | * c-indentation-style: bsd 159 | * c-basic-offset: 4 160 | * indent-tabs-mode: t 161 | * End: 162 | * 163 | * ex: set ts=8 sts=4 sw=4 noet: 164 | */ 165 | -------------------------------------------------------------------------------- /microperl-5.10.1/patchlevel.h: -------------------------------------------------------------------------------- 1 | /* patchlevel.h 2 | * 3 | * Copyright (C) 1993, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 4 | * 2003, 2004, 2005, 2006, 2007, 2008, 2009, by Larry Wall and others 5 | * 6 | * You may distribute under the terms of either the GNU General Public 7 | * License or the Artistic License, as specified in the README file. 8 | * 9 | */ 10 | 11 | #ifndef __PATCHLEVEL_H_INCLUDED__ 12 | 13 | /* do not adjust the whitespace! Configure expects the numbers to be 14 | * exactly on the third column */ 15 | 16 | #define PERL_REVISION 5 /* age */ 17 | #define PERL_VERSION 10 /* epoch */ 18 | #define PERL_SUBVERSION 1 /* generation */ 19 | 20 | /* The following numbers describe the earliest compatible version of 21 | Perl ("compatibility" here being defined as sufficient binary/API 22 | compatibility to run XS code built with the older version). 23 | Normally this should not change across maintenance releases. 24 | 25 | Note that this only refers to an out-of-the-box build. Many non-default 26 | options such as usemultiplicity tend to break binary compatibility 27 | more often. 28 | 29 | This is used by Configure et al to figure out 30 | PERL_INC_VERSION_LIST, which lists version libraries 31 | to include in @INC. See INSTALL for how this works. 32 | */ 33 | #define PERL_API_REVISION 5 /* Adjust manually as needed. */ 34 | #define PERL_API_VERSION 10 /* Adjust manually as needed. */ 35 | #define PERL_API_SUBVERSION 0 /* Adjust manually as needed. */ 36 | /* 37 | XXX Note: The selection of non-default Configure options, such 38 | as -Duselonglong may invalidate these settings. Currently, Configure 39 | does not adequately test for this. A.D. Jan 13, 2000 40 | */ 41 | 42 | #define __PATCHLEVEL_H_INCLUDED__ 43 | #endif 44 | 45 | /* 46 | local_patches -- list of locally applied less-than-subversion patches. 47 | If you're distributing such a patch, please give it a name and a 48 | one-line description, placed just before the last NULL in the array 49 | below. If your patch fixes a bug in the perlbug database, please 50 | mention the bugid. If your patch *IS* dependent on a prior patch, 51 | please place your applied patch line after its dependencies. This 52 | will help tracking of patch dependencies. 53 | 54 | Please either use 'diff --unified=0' if your diff supports 55 | that or edit the hunk of the diff output which adds your patch 56 | to this list, to remove context lines which would give patch 57 | problems. For instance, if the original context diff is 58 | 59 | *** patchlevel.h.orig 60 | --- patchlevel.h 61 | *** 38,43 *** 62 | --- 38,44 --- 63 | ,"FOO1235 - some patch" 64 | ,"BAR3141 - another patch" 65 | ,"BAZ2718 - and another patch" 66 | + ,"MINE001 - my new patch" 67 | ,NULL 68 | }; 69 | 70 | please change it to 71 | *** patchlevel.h.orig 72 | --- patchlevel.h 73 | *** 41,43 *** 74 | --- 41,44 --- 75 | + ,"MINE001 - my new patch" 76 | ,NULL 77 | }; 78 | 79 | (Note changes to line numbers as well as removal of context lines.) 80 | This will prevent patch from choking if someone has previously 81 | applied different patches than you. 82 | 83 | History has shown that nobody distributes patches that also 84 | modify patchlevel.h. Do it yourself. The following perl 85 | program can be used to add a comment to patchlevel.h: 86 | 87 | #!perl 88 | die "Usage: perl -x patchlevel.h comment ..." unless @ARGV; 89 | open PLIN, "patchlevel.h" or die "Couldn't open patchlevel.h : $!"; 90 | open PLOUT, ">patchlevel.new" or die "Couldn't write on patchlevel.new : $!"; 91 | my $seen=0; 92 | while () { 93 | if (/\t,NULL/ and $seen) { 94 | while (my $c = shift @ARGV){ 95 | print PLOUT qq{\t,"$c"\n}; 96 | } 97 | } 98 | $seen++ if /local_patches\[\]/; 99 | print PLOUT; 100 | } 101 | close PLOUT or die "Couldn't close filehandle writing to patchlevel.new : $!"; 102 | close PLIN or die "Couldn't close filehandle reading from patchlevel.h : $!"; 103 | close DATA; # needed to allow unlink to work win32. 104 | unlink "patchlevel.bak" or warn "Couldn't unlink patchlevel.bak : $!" 105 | if -e "patchlevel.bak"; 106 | rename "patchlevel.h", "patchlevel.bak" or 107 | die "Couldn't rename patchlevel.h to patchlevel.bak : $!"; 108 | rename "patchlevel.new", "patchlevel.h" or 109 | die "Couldn't rename patchlevel.new to patchlevel.h : $!"; 110 | __END__ 111 | 112 | Please keep empty lines below so that context diffs of this file do 113 | not ever collect the lines belonging to local_patches() into the same 114 | hunk. 115 | 116 | */ 117 | 118 | #if !defined(PERL_PATCHLEVEL_H_IMPLICIT) && !defined(LOCAL_PATCH_COUNT) 119 | # if defined(PERL_IS_MINIPERL) 120 | # define PERL_PATCHNUM "UNKNOWN-miniperl" 121 | # define PERL_GIT_UNCOMMITTED_CHANGES ,"UNKNOWN" 122 | # define PERL_GIT_UNPUSHED_COMMITS /*leave-this-comment*/ 123 | # elif defined(PERL_MICRO) 124 | # define PERL_PATCHNUM "UNKNOWN-microperl" 125 | # define PERL_GIT_UNCOMMITTED_CHANGES ,"UNKNOWN" 126 | # define PERL_GIT_UNPUSHED_COMMITS /*leave-this-comment*/ 127 | # else 128 | #include "git_version.h" 129 | # endif 130 | static const char * const local_patches[] = { 131 | NULL 132 | PERL_GIT_UNPUSHED_COMMITS /* do not remove this line */ 133 | PERL_GIT_UNCOMMITTED_CHANGES /* do not remove this line */ 134 | ,NULL 135 | }; 136 | 137 | 138 | 139 | /* Initial space prevents this variable from being inserted in config.sh */ 140 | # define LOCAL_PATCH_COUNT \ 141 | ((int)(sizeof(local_patches)/sizeof(local_patches[0])-2)) 142 | 143 | /* the old terms of reference, add them only when explicitly included */ 144 | #define PATCHLEVEL PERL_VERSION 145 | #undef SUBVERSION /* OS/390 has a SUBVERSION in a system header */ 146 | #define SUBVERSION PERL_SUBVERSION 147 | #endif 148 | -------------------------------------------------------------------------------- /microperl-5.10.1/perly.h: -------------------------------------------------------------------------------- 1 | #ifdef PERL_CORE 2 | /* A Bison parser, made by GNU Bison 2.3. */ 3 | 4 | /* Skeleton interface for Bison's Yacc-like parsers in C 5 | 6 | Copyright (C) 1984, 1989, 1990, 2000, 2001, 2002, 2003, 2004, 2005, 2006 7 | Free Software Foundation, Inc. 8 | 9 | This program is free software; you can redistribute it and/or modify 10 | it under the terms of the GNU General Public License as published by 11 | the Free Software Foundation; either version 2, or (at your option) 12 | any later version. 13 | 14 | This program is distributed in the hope that it will be useful, 15 | but WITHOUT ANY WARRANTY; without even the implied warranty of 16 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 17 | GNU General Public License for more details. 18 | 19 | You should have received a copy of the GNU General Public License 20 | along with this program; if not, write to the Free Software 21 | Foundation, Inc., 51 Franklin Street, Fifth Floor, 22 | Boston, MA 02110-1301, USA. */ 23 | 24 | /* As a special exception, you may create a larger work that contains 25 | part or all of the Bison parser skeleton and distribute that work 26 | under terms of your choice, so long as that work isn't itself a 27 | parser generator using the skeleton or a modified version thereof 28 | as a parser skeleton. Alternatively, if you modify or redistribute 29 | the parser skeleton itself, you may (at your option) remove this 30 | special exception, which will cause the skeleton and the resulting 31 | Bison output files to be licensed under the GNU General Public 32 | License without this special exception. 33 | 34 | This special exception was added by the Free Software Foundation in 35 | version 2.2 of Bison. */ 36 | 37 | /* Tokens. */ 38 | #ifndef YYTOKENTYPE 39 | # define YYTOKENTYPE 40 | /* Put the tokens into the symbol table, so that GDB and other debuggers 41 | know about them. */ 42 | enum yytokentype { 43 | WORD = 258, 44 | METHOD = 259, 45 | FUNCMETH = 260, 46 | THING = 261, 47 | PMFUNC = 262, 48 | PRIVATEREF = 263, 49 | FUNC0SUB = 264, 50 | UNIOPSUB = 265, 51 | LSTOPSUB = 266, 52 | LABEL = 267, 53 | FORMAT = 268, 54 | SUB = 269, 55 | ANONSUB = 270, 56 | PACKAGE = 271, 57 | USE = 272, 58 | WHILE = 273, 59 | UNTIL = 274, 60 | IF = 275, 61 | UNLESS = 276, 62 | ELSE = 277, 63 | ELSIF = 278, 64 | CONTINUE = 279, 65 | FOR = 280, 66 | GIVEN = 281, 67 | WHEN = 282, 68 | DEFAULT = 283, 69 | LOOPEX = 284, 70 | DOTDOT = 285, 71 | FUNC0 = 286, 72 | FUNC1 = 287, 73 | FUNC = 288, 74 | UNIOP = 289, 75 | LSTOP = 290, 76 | RELOP = 291, 77 | EQOP = 292, 78 | MULOP = 293, 79 | ADDOP = 294, 80 | DOLSHARP = 295, 81 | DO = 296, 82 | HASHBRACK = 297, 83 | NOAMP = 298, 84 | LOCAL = 299, 85 | MY = 300, 86 | MYSUB = 301, 87 | REQUIRE = 302, 88 | COLONATTR = 303, 89 | PREC_LOW = 304, 90 | DOROP = 305, 91 | OROP = 306, 92 | ANDOP = 307, 93 | NOTOP = 308, 94 | ASSIGNOP = 309, 95 | DORDOR = 310, 96 | OROR = 311, 97 | ANDAND = 312, 98 | BITOROP = 313, 99 | BITANDOP = 314, 100 | SHIFTOP = 315, 101 | MATCHOP = 316, 102 | REFGEN = 317, 103 | UMINUS = 318, 104 | POWOP = 319, 105 | POSTDEC = 320, 106 | POSTINC = 321, 107 | PREDEC = 322, 108 | PREINC = 323, 109 | ARROW = 324, 110 | PEG = 325 111 | }; 112 | #endif 113 | /* Tokens. */ 114 | #define WORD 258 115 | #define METHOD 259 116 | #define FUNCMETH 260 117 | #define THING 261 118 | #define PMFUNC 262 119 | #define PRIVATEREF 263 120 | #define FUNC0SUB 264 121 | #define UNIOPSUB 265 122 | #define LSTOPSUB 266 123 | #define LABEL 267 124 | #define FORMAT 268 125 | #define SUB 269 126 | #define ANONSUB 270 127 | #define PACKAGE 271 128 | #define USE 272 129 | #define WHILE 273 130 | #define UNTIL 274 131 | #define IF 275 132 | #define UNLESS 276 133 | #define ELSE 277 134 | #define ELSIF 278 135 | #define CONTINUE 279 136 | #define FOR 280 137 | #define GIVEN 281 138 | #define WHEN 282 139 | #define DEFAULT 283 140 | #define LOOPEX 284 141 | #define DOTDOT 285 142 | #define FUNC0 286 143 | #define FUNC1 287 144 | #define FUNC 288 145 | #define UNIOP 289 146 | #define LSTOP 290 147 | #define RELOP 291 148 | #define EQOP 292 149 | #define MULOP 293 150 | #define ADDOP 294 151 | #define DOLSHARP 295 152 | #define DO 296 153 | #define HASHBRACK 297 154 | #define NOAMP 298 155 | #define LOCAL 299 156 | #define MY 300 157 | #define MYSUB 301 158 | #define REQUIRE 302 159 | #define COLONATTR 303 160 | #define PREC_LOW 304 161 | #define DOROP 305 162 | #define OROP 306 163 | #define ANDOP 307 164 | #define NOTOP 308 165 | #define ASSIGNOP 309 166 | #define DORDOR 310 167 | #define OROR 311 168 | #define ANDAND 312 169 | #define BITOROP 313 170 | #define BITANDOP 314 171 | #define SHIFTOP 315 172 | #define MATCHOP 316 173 | #define REFGEN 317 174 | #define UMINUS 318 175 | #define POWOP 319 176 | #define POSTDEC 320 177 | #define POSTINC 321 178 | #define PREDEC 322 179 | #define PREINC 323 180 | #define ARROW 324 181 | #define PEG 325 182 | 183 | 184 | 185 | 186 | #endif /* PERL_CORE */ 187 | #if ! defined YYSTYPE && ! defined YYSTYPE_IS_DECLARED 188 | typedef union YYSTYPE 189 | { 190 | I32 ival; /* __DEFAULT__ (marker for regen_perly.pl; 191 | must always be 1st union member) */ 192 | char *pval; 193 | OP *opval; 194 | GV *gvval; 195 | #ifdef PERL_IN_MADLY_C 196 | TOKEN* p_tkval; 197 | TOKEN* i_tkval; 198 | #else 199 | char *p_tkval; 200 | I32 i_tkval; 201 | #endif 202 | #ifdef PERL_MAD 203 | TOKEN* tkval; 204 | #endif 205 | } 206 | /* Line 1489 of yacc.c. */ 207 | YYSTYPE; 208 | # define yystype YYSTYPE /* obsolescent; will be withdrawn */ 209 | # define YYSTYPE_IS_DECLARED 1 210 | # define YYSTYPE_IS_TRIVIAL 1 211 | #endif 212 | 213 | 214 | 215 | -------------------------------------------------------------------------------- /microperl-5.10.1/perlvars.h: -------------------------------------------------------------------------------- 1 | /* perlvars.h 2 | * 3 | * Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 4 | * by Larry Wall and others 5 | * 6 | * You may distribute under the terms of either the GNU General Public 7 | * License or the Artistic License, as specified in the README file. 8 | * 9 | */ 10 | 11 | /****************/ 12 | /* Truly global */ 13 | /****************/ 14 | 15 | /* Don't forget to re-run embed.pl to propagate changes! */ 16 | 17 | /* This file describes the "global" variables used by perl 18 | * This used to be in perl.h directly but we want to abstract out into 19 | * distinct files which are per-thread, per-interpreter or really global, 20 | * and how they're initialized. 21 | * 22 | * The 'G' prefix is only needed for vars that need appropriate #defines 23 | * generated in embed*.h. Such symbols are also used to generate 24 | * the appropriate export list for win32. */ 25 | 26 | /* global state */ 27 | PERLVAR(Gcurinterp, PerlInterpreter *) 28 | /* currently running interpreter 29 | * (initial parent interpreter under 30 | * useithreads) */ 31 | #if defined(USE_ITHREADS) 32 | PERLVAR(Gthr_key, perl_key) /* key to retrieve per-thread struct */ 33 | #endif 34 | 35 | /* constants (these are not literals to facilitate pointer comparisons) 36 | * (PERLVARISC really does create variables, despite its looks) */ 37 | PERLVARISC(GYes, "1") 38 | PERLVARISC(GNo, "") 39 | PERLVARISC(Ghexdigit, "0123456789abcdef0123456789ABCDEF") 40 | PERLVARISC(Gpatleave, "\\.^$@dDwWsSbB+*?|()-nrtfeaxc0123456789[{]}") 41 | 42 | /* XXX does anyone even use this? */ 43 | PERLVARI(Gdo_undump, bool, FALSE) /* -u or dump seen? */ 44 | 45 | #if defined(MYMALLOC) && defined(USE_ITHREADS) 46 | PERLVAR(Gmalloc_mutex, perl_mutex) /* Mutex for malloc */ 47 | #endif 48 | 49 | #if defined(USE_ITHREADS) 50 | PERLVAR(Gop_mutex, perl_mutex) /* Mutex for op refcounting */ 51 | #endif 52 | 53 | #ifdef USE_ITHREADS 54 | PERLVAR(Gdollarzero_mutex, perl_mutex) /* Modifying $0 */ 55 | #endif 56 | 57 | 58 | /* This is constant on most architectures, a global on OS/2 */ 59 | #ifdef OS2 60 | # define PERL___C 61 | #else 62 | # define PERL___C const 63 | #endif 64 | PERLVARI(Gsh_path, PERL___C char *, SH_PATH) /* full path of shell */ 65 | #undef PERL___C 66 | 67 | #ifndef PERL_MICRO 68 | /* If Perl has to ignore SIGPFE, this is its saved state. 69 | * See perl.h macros PERL_FPU_INIT and PERL_FPU_{PRE,POST}_EXEC. */ 70 | PERLVAR(Gsigfpe_saved, Sighandler_t) 71 | #endif 72 | 73 | /* Restricted hashes placeholder value. 74 | * The contents are never used, only the address. */ 75 | PERLVAR(Gsv_placeholder, SV) 76 | 77 | #ifndef PERL_MICRO 78 | PERLVARI(Gcsighandlerp, Sighandler_t, Perl_csighandler) /* Pointer to C-level sighandler */ 79 | #endif 80 | 81 | #ifndef PERL_USE_SAFE_PUTENV 82 | PERLVARI(Guse_safe_putenv, int, 1) 83 | #endif 84 | 85 | #ifdef USE_PERLIO 86 | PERLVARI(Gperlio_fd_refcnt, int*, 0) /* Pointer to array of fd refcounts. */ 87 | PERLVARI(Gperlio_fd_refcnt_size, int, 0) /* Size of the array */ 88 | PERLVARI(Gperlio_debug_fd, int, 0) /* the fd to write perlio debug into, 0 means not set yet */ 89 | #endif 90 | 91 | #ifdef HAS_MMAP 92 | PERLVARI(Gmmap_page_size, IV, 0) 93 | #endif 94 | 95 | #if defined(FAKE_PERSISTENT_SIGNAL_HANDLERS)||defined(FAKE_DEFAULT_SIGNAL_HANDLERS) 96 | PERLVARI(Gsig_handlers_initted, int, 0) 97 | #endif 98 | #ifdef FAKE_PERSISTENT_SIGNAL_HANDLERS 99 | PERLVARA(Gsig_ignoring, SIG_SIZE, int) /* which signals we are ignoring */ 100 | #endif 101 | #ifdef FAKE_DEFAULT_SIGNAL_HANDLERS 102 | PERLVARA(Gsig_defaulting, SIG_SIZE, int) 103 | #endif 104 | 105 | #ifndef PERL_IMPLICIT_CONTEXT 106 | PERLVAR(Gsig_sv, SV*) 107 | #endif 108 | 109 | /* XXX signals are process-wide anyway, so we 110 | * ignore the implications of this for threading */ 111 | #ifndef HAS_SIGACTION 112 | PERLVARI(Gsig_trapped, int, 0) 113 | #endif 114 | 115 | #ifdef DEBUGGING 116 | PERLVAR(Gwatch_pvx, char*) 117 | #endif 118 | 119 | #ifdef PERL_GLOBAL_STRUCT 120 | PERLVAR(Gppaddr, Perl_ppaddr_t*) /* or opcode.h */ 121 | PERLVAR(Gcheck, Perl_check_t *) /* or opcode.h */ 122 | PERLVARA(Gfold_locale, 256, unsigned char) /* or perl.h */ 123 | #endif 124 | 125 | #ifdef PERL_NEED_APPCTX 126 | PERLVAR(Gappctx, void*) /* the application context */ 127 | #endif 128 | 129 | PERLVAR(Gop_sequence, HV*) /* dump.c */ 130 | PERLVARI(Gop_seq, UV, 0) /* dump.c */ 131 | 132 | #if defined(HAS_TIMES) && defined(PERL_NEED_TIMESBASE) 133 | PERLVAR(Gtimesbase, struct tms) 134 | #endif 135 | 136 | /* allocate a unique index to every module that calls MY_CXT_INIT */ 137 | 138 | #ifdef PERL_IMPLICIT_CONTEXT 139 | # ifdef USE_ITHREADS 140 | PERLVAR(Gmy_ctx_mutex, perl_mutex) 141 | # endif 142 | PERLVARI(Gmy_cxt_index, int, 0) 143 | #endif 144 | 145 | #if defined(USE_ITHREADS) 146 | PERLVAR(Ghints_mutex, perl_mutex) /* Mutex for refcounted he refcounting */ 147 | #endif 148 | 149 | #if defined(USE_ITHREADS) 150 | PERLVAR(Gperlio_mutex, perl_mutex) /* Mutex for perlio fd refcounts */ 151 | #endif 152 | 153 | /* this is currently set without MUTEX protection, so keep it a type which 154 | * can be set atomically (ie not a bit field) */ 155 | PERLVARI(Gveto_cleanup, int, FALSE) /* exit without cleanup */ 156 | 157 | /* dummy variables that hold pointers to both runops functions, thus forcing 158 | * them *both* to get linked in (useful for Peek.xs, debugging etc) */ 159 | 160 | PERLVARI(Grunops_std, runops_proc_t, MEMBER_TO_FPTR(Perl_runops_standard)) 161 | PERLVARI(Grunops_dbg, runops_proc_t, MEMBER_TO_FPTR(Perl_runops_debug)) 162 | 163 | 164 | /* These are baked at compile time into any shared perl library. 165 | In future 5.10.x releases this will allow us in main() to sanity test the 166 | library we're linking against. */ 167 | 168 | PERLVARI(Grevision, U8, PERL_REVISION) 169 | PERLVARI(Gversion, U8, PERL_VERSION) 170 | PERLVARI(Gsubversion, U8, PERL_SUBVERSION) 171 | 172 | #if defined(MULTIPLICITY) 173 | # define PERL_INTERPRETER_SIZE_UPTO_MEMBER(member) \ 174 | STRUCT_OFFSET(struct interpreter, member) + \ 175 | sizeof(((struct interpreter*)0)->member) 176 | 177 | /* These might be useful. */ 178 | PERLVARI(Ginterp_size, U16, sizeof(struct interpreter)) 179 | #if defined(PERL_GLOBAL_STRUCT) 180 | PERLVARI(Gglobal_struct_size, U16, sizeof(struct perl_vars)) 181 | #endif 182 | 183 | /* This will be useful for subsequent releases, because this has to be the 184 | same in your libperl as in main(), else you have a mismatch and must abort. 185 | */ 186 | PERLVARI(Ginterp_size_5_10_0, U16, 187 | PERL_INTERPRETER_SIZE_UPTO_MEMBER(PERL_LAST_5_10_0_INTERP_MEMBER)) 188 | #endif 189 | -------------------------------------------------------------------------------- /microperl-5.10.1/dosish.h: -------------------------------------------------------------------------------- 1 | /* dosish.h 2 | * 3 | * Copyright (C) 1993, 1994, 1996, 1997, 1998, 1999, 4 | * 2000, 2001, 2002, 2007, by Larry Wall and others 5 | * 6 | * You may distribute under the terms of either the GNU General Public 7 | * License or the Artistic License, as specified in the README file. 8 | * 9 | */ 10 | #define ABORT() abort(); 11 | 12 | #ifndef SH_PATH 13 | #define SH_PATH "/bin/sh" 14 | #endif 15 | 16 | #ifdef DJGPP 17 | # define BIT_BUCKET "nul" 18 | # define OP_BINARY O_BINARY 19 | # define PERL_SYS_INIT_BODY(c,v) \ 20 | MALLOC_CHECK_TAINT2(*c,*v) Perl_DJGPP_init(c,v); PERLIO_INIT 21 | # define init_os_extras Perl_init_os_extras 22 | # define HAS_UTIME 23 | # define HAS_KILL 24 | char *djgpp_pathexp (const char*); 25 | void Perl_DJGPP_init (int *argcp,char ***argvp); 26 | # if (DJGPP==2 && DJGPP_MINOR < 2) 27 | # define NO_LOCALECONV_MON_THOUSANDS_SEP 28 | # endif 29 | # ifndef PERL_CORE 30 | # define PERL_FS_VER_FMT "%d_%d_%d" 31 | # endif 32 | # define PERL_FS_VERSION STRINGIFY(PERL_REVISION) "_" \ 33 | STRINGIFY(PERL_VERSION) "_" \ 34 | STRINGIFY(PERL_SUBVERSION) 35 | #else /* DJGPP */ 36 | # ifdef WIN32 37 | # define PERL_SYS_INIT_BODY(c,v) \ 38 | MALLOC_CHECK_TAINT2(*c,*v) Perl_win32_init(c,v); PERLIO_INIT 39 | # define PERL_SYS_TERM_BODY() Perl_win32_term() 40 | # define BIT_BUCKET "nul" 41 | # else 42 | # ifdef NETWARE 43 | # define PERL_SYS_INIT_BODY(c,v) \ 44 | MALLOC_CHECK_TAINT2(*c,*v) Perl_nw5_init(c,v); PERLIO_INIT 45 | # define BIT_BUCKET "nwnul" 46 | # else 47 | # define PERL_SYS_INIT_BODY(c,v) \ 48 | MALLOC_CHECK_TAINT2(*c,*v); PERLIO_INIT 49 | # define BIT_BUCKET "\\dev\\nul" /* "wanna be like, umm, Newlined, or somethin?" */ 50 | # endif /* NETWARE */ 51 | # endif 52 | #endif /* DJGPP */ 53 | 54 | #ifndef PERL_SYS_TERM_BODY 55 | # define PERL_SYS_TERM_BODY() HINTS_REFCNT_TERM; OP_REFCNT_TERM; PERLIO_TERM; MALLOC_TERM 56 | #endif 57 | #define dXSUB_SYS 58 | 59 | /* 60 | * 5.003_07 and earlier keyed on #ifdef MSDOS for determining if we were 61 | * running on DOS, *and* if we had to cope with 16 bit memory addressing 62 | * constraints, *and* we need to have memory allocated as unsigned long. 63 | * 64 | * with the advent of *real* compilers for DOS, they are not locked together. 65 | * MSDOS means "I am running on MSDOS". HAS_64K_LIMIT means "I have 66 | * 16 bit memory addressing constraints". 67 | * 68 | * if you need the last, try #DEFINE MEM_SIZE unsigned long. 69 | */ 70 | #ifdef MSDOS 71 | # ifndef DJGPP 72 | # define HAS_64K_LIMIT 73 | # endif 74 | #endif 75 | 76 | /* USEMYBINMODE 77 | * This symbol, if defined, indicates that the program should 78 | * use the routine my_binmode(FILE *fp, char iotype, int mode) to insure 79 | * that a file is in "binary" mode -- that is, that no translation 80 | * of bytes occurs on read or write operations. 81 | */ 82 | #undef USEMYBINMODE 83 | 84 | /* Stat_t: 85 | * This symbol holds the type used to declare buffers for information 86 | * returned by stat(). It's usually just struct stat. It may be necessary 87 | * to include and to get any typedef'ed 88 | * information. 89 | */ 90 | #if defined(WIN64) || defined(USE_LARGE_FILES) 91 | # if defined(__BORLANDC__) /* buk */ 92 | # include 93 | # define Stat_t struct stati64 94 | # else 95 | #define Stat_t struct _stati64 96 | # endif 97 | #else 98 | #if defined(UNDER_CE) 99 | #define Stat_t struct xcestat 100 | #else 101 | #define Stat_t struct stat 102 | #endif 103 | #endif 104 | 105 | /* USE_STAT_RDEV: 106 | * This symbol is defined if this system has a stat structure declaring 107 | * st_rdev 108 | */ 109 | #define USE_STAT_RDEV /**/ 110 | 111 | /* ACME_MESS: 112 | * This symbol, if defined, indicates that error messages should be 113 | * should be generated in a format that allows the use of the Acme 114 | * GUI/editor's autofind feature. 115 | */ 116 | #undef ACME_MESS /**/ 117 | 118 | /* ALTERNATE_SHEBANG: 119 | * This symbol, if defined, contains a "magic" string which may be used 120 | * as the first line of a Perl program designed to be executed directly 121 | * by name, instead of the standard Unix #!. If ALTERNATE_SHEBANG 122 | * begins with a character other then #, then Perl will only treat 123 | * it as a command line if it finds the string "perl" in the first 124 | * word; otherwise it's treated as the first line of code in the script. 125 | * (IOW, Perl won't hand off to another interpreter via an alternate 126 | * shebang sequence that might be legal Perl code.) 127 | */ 128 | /* #define ALTERNATE_SHEBANG "#!" / **/ 129 | 130 | #include 131 | 132 | /* 133 | * fwrite1() should be a routine with the same calling sequence as fwrite(), 134 | * but which outputs all of the bytes requested as a single stream (unlike 135 | * fwrite() itself, which on some systems outputs several distinct records 136 | * if the number_of_items parameter is >1). 137 | */ 138 | #define fwrite1 fwrite 139 | 140 | #define Fstat(fd,bufptr) fstat((fd),(bufptr)) 141 | #ifdef DJGPP 142 | # define Fflush(fp) djgpp_fflush(fp) 143 | #else 144 | # define Fflush(fp) fflush(fp) 145 | #endif 146 | #define Mkdir(path,mode) mkdir((path),(mode)) 147 | 148 | #ifndef WIN32 149 | # define Stat(fname,bufptr) stat((fname),(bufptr)) 150 | #else 151 | # define HAS_IOCTL 152 | # define HAS_UTIME 153 | # define HAS_KILL 154 | # define HAS_WAIT 155 | # define HAS_CHOWN 156 | #endif /* WIN32 */ 157 | 158 | /* 159 | * : The DJGPP port has code that converts 160 | * the return code of system() into the form that Unixy wait usually 161 | * returns: 162 | * 163 | * - signal number in bits 0-6; 164 | * - core dump flag in bit 7; 165 | * - exit code in bits 8-15. 166 | * 167 | * Bits 0-7 are always zero for DJGPP, because it uses system(). 168 | * See djgpp.c. 169 | * 170 | * POSIX::W* use the W* macros from to decode 171 | * the return code. Unfortunately the W* macros for DJGPP use 172 | * a different format than Unixy wait does. So there's a mismatch 173 | * and, say, WEXITSTATUS($?) will return bogus values. 174 | * 175 | * So here we add hack to redefine the W* macros from DJGPP's 176 | * to work with our return-code conversion. 177 | */ 178 | 179 | #ifdef DJGPP 180 | 181 | #include 182 | 183 | #undef WEXITSTATUS 184 | #undef WIFEXITED 185 | #undef WIFSIGNALED 186 | #undef WIFSTOPPED 187 | #undef WNOHANG 188 | #undef WSTOPSIG 189 | #undef WTERMSIG 190 | #undef WUNTRACED 191 | 192 | #define WEXITSTATUS(stat_val) ((stat_val) >> 8) 193 | #define WIFEXITED(stat_val) 0 194 | #define WIFSIGNALED(stat_val) 0 195 | #define WIFSTOPPED(stat_val) 0 196 | #define WNOHANG 0 197 | #define WSTOPSIG(stat_val) 0 198 | #define WTERMSIG(stat_val) 0 199 | #define WUNTRACED 0 200 | 201 | #endif 202 | 203 | /* Don't go reading from /dev/urandom */ 204 | #define PERL_NO_DEV_RANDOM 205 | 206 | /* 207 | * Local variables: 208 | * c-indentation-style: bsd 209 | * c-basic-offset: 4 210 | * indent-tabs-mode: t 211 | * End: 212 | * 213 | * ex: set ts=8 sts=4 sw=4 noet: 214 | */ 215 | -------------------------------------------------------------------------------- /microperl-5.10.1/keywords.h: -------------------------------------------------------------------------------- 1 | /* -*- buffer-read-only: t -*- 2 | * 3 | * keywords.h 4 | * 5 | * Copyright (C) 1994, 1995, 1996, 1997, 1999, 2000, 2001, 2002, 2005, 6 | * 2006, 2007, by Larry Wall and others 7 | * 8 | * You may distribute under the terms of either the GNU General Public 9 | * License or the Artistic License, as specified in the README file. 10 | * 11 | * !!!!!!! DO NOT EDIT THIS FILE !!!!!!! 12 | * This file is built by keywords.pl from its data. Any changes made here 13 | * will be lost! 14 | */ 15 | #define KEY_NULL 0 16 | #define KEY___FILE__ 1 17 | #define KEY___LINE__ 2 18 | #define KEY___PACKAGE__ 3 19 | #define KEY___DATA__ 4 20 | #define KEY___END__ 5 21 | #define KEY_AUTOLOAD 6 22 | #define KEY_BEGIN 7 23 | #define KEY_UNITCHECK 8 24 | #define KEY_CORE 9 25 | #define KEY_DESTROY 10 26 | #define KEY_END 11 27 | #define KEY_INIT 12 28 | #define KEY_CHECK 13 29 | #define KEY_abs 14 30 | #define KEY_accept 15 31 | #define KEY_alarm 16 32 | #define KEY_and 17 33 | #define KEY_atan2 18 34 | #define KEY_bind 19 35 | #define KEY_binmode 20 36 | #define KEY_bless 21 37 | #define KEY_break 22 38 | #define KEY_caller 23 39 | #define KEY_chdir 24 40 | #define KEY_chmod 25 41 | #define KEY_chomp 26 42 | #define KEY_chop 27 43 | #define KEY_chown 28 44 | #define KEY_chr 29 45 | #define KEY_chroot 30 46 | #define KEY_close 31 47 | #define KEY_closedir 32 48 | #define KEY_cmp 33 49 | #define KEY_connect 34 50 | #define KEY_continue 35 51 | #define KEY_cos 36 52 | #define KEY_crypt 37 53 | #define KEY_dbmclose 38 54 | #define KEY_dbmopen 39 55 | #define KEY_default 40 56 | #define KEY_defined 41 57 | #define KEY_delete 42 58 | #define KEY_die 43 59 | #define KEY_do 44 60 | #define KEY_dump 45 61 | #define KEY_each 46 62 | #define KEY_else 47 63 | #define KEY_elsif 48 64 | #define KEY_endgrent 49 65 | #define KEY_endhostent 50 66 | #define KEY_endnetent 51 67 | #define KEY_endprotoent 52 68 | #define KEY_endpwent 53 69 | #define KEY_endservent 54 70 | #define KEY_eof 55 71 | #define KEY_eq 56 72 | #define KEY_eval 57 73 | #define KEY_exec 58 74 | #define KEY_exists 59 75 | #define KEY_exit 60 76 | #define KEY_exp 61 77 | #define KEY_fcntl 62 78 | #define KEY_fileno 63 79 | #define KEY_flock 64 80 | #define KEY_for 65 81 | #define KEY_foreach 66 82 | #define KEY_fork 67 83 | #define KEY_format 68 84 | #define KEY_formline 69 85 | #define KEY_ge 70 86 | #define KEY_getc 71 87 | #define KEY_getgrent 72 88 | #define KEY_getgrgid 73 89 | #define KEY_getgrnam 74 90 | #define KEY_gethostbyaddr 75 91 | #define KEY_gethostbyname 76 92 | #define KEY_gethostent 77 93 | #define KEY_getlogin 78 94 | #define KEY_getnetbyaddr 79 95 | #define KEY_getnetbyname 80 96 | #define KEY_getnetent 81 97 | #define KEY_getpeername 82 98 | #define KEY_getpgrp 83 99 | #define KEY_getppid 84 100 | #define KEY_getpriority 85 101 | #define KEY_getprotobyname 86 102 | #define KEY_getprotobynumber 87 103 | #define KEY_getprotoent 88 104 | #define KEY_getpwent 89 105 | #define KEY_getpwnam 90 106 | #define KEY_getpwuid 91 107 | #define KEY_getservbyname 92 108 | #define KEY_getservbyport 93 109 | #define KEY_getservent 94 110 | #define KEY_getsockname 95 111 | #define KEY_getsockopt 96 112 | #define KEY_given 97 113 | #define KEY_glob 98 114 | #define KEY_gmtime 99 115 | #define KEY_goto 100 116 | #define KEY_grep 101 117 | #define KEY_gt 102 118 | #define KEY_hex 103 119 | #define KEY_if 104 120 | #define KEY_index 105 121 | #define KEY_int 106 122 | #define KEY_ioctl 107 123 | #define KEY_join 108 124 | #define KEY_keys 109 125 | #define KEY_kill 110 126 | #define KEY_last 111 127 | #define KEY_lc 112 128 | #define KEY_lcfirst 113 129 | #define KEY_le 114 130 | #define KEY_length 115 131 | #define KEY_link 116 132 | #define KEY_listen 117 133 | #define KEY_local 118 134 | #define KEY_localtime 119 135 | #define KEY_lock 120 136 | #define KEY_log 121 137 | #define KEY_lstat 122 138 | #define KEY_lt 123 139 | #define KEY_m 124 140 | #define KEY_map 125 141 | #define KEY_mkdir 126 142 | #define KEY_msgctl 127 143 | #define KEY_msgget 128 144 | #define KEY_msgrcv 129 145 | #define KEY_msgsnd 130 146 | #define KEY_my 131 147 | #define KEY_ne 132 148 | #define KEY_next 133 149 | #define KEY_no 134 150 | #define KEY_not 135 151 | #define KEY_oct 136 152 | #define KEY_open 137 153 | #define KEY_opendir 138 154 | #define KEY_or 139 155 | #define KEY_ord 140 156 | #define KEY_our 141 157 | #define KEY_pack 142 158 | #define KEY_package 143 159 | #define KEY_pipe 144 160 | #define KEY_pop 145 161 | #define KEY_pos 146 162 | #define KEY_print 147 163 | #define KEY_printf 148 164 | #define KEY_prototype 149 165 | #define KEY_push 150 166 | #define KEY_q 151 167 | #define KEY_qq 152 168 | #define KEY_qr 153 169 | #define KEY_quotemeta 154 170 | #define KEY_qw 155 171 | #define KEY_qx 156 172 | #define KEY_rand 157 173 | #define KEY_read 158 174 | #define KEY_readdir 159 175 | #define KEY_readline 160 176 | #define KEY_readlink 161 177 | #define KEY_readpipe 162 178 | #define KEY_recv 163 179 | #define KEY_redo 164 180 | #define KEY_ref 165 181 | #define KEY_rename 166 182 | #define KEY_require 167 183 | #define KEY_reset 168 184 | #define KEY_return 169 185 | #define KEY_reverse 170 186 | #define KEY_rewinddir 171 187 | #define KEY_rindex 172 188 | #define KEY_rmdir 173 189 | #define KEY_s 174 190 | #define KEY_say 175 191 | #define KEY_scalar 176 192 | #define KEY_seek 177 193 | #define KEY_seekdir 178 194 | #define KEY_select 179 195 | #define KEY_semctl 180 196 | #define KEY_semget 181 197 | #define KEY_semop 182 198 | #define KEY_send 183 199 | #define KEY_setgrent 184 200 | #define KEY_sethostent 185 201 | #define KEY_setnetent 186 202 | #define KEY_setpgrp 187 203 | #define KEY_setpriority 188 204 | #define KEY_setprotoent 189 205 | #define KEY_setpwent 190 206 | #define KEY_setservent 191 207 | #define KEY_setsockopt 192 208 | #define KEY_shift 193 209 | #define KEY_shmctl 194 210 | #define KEY_shmget 195 211 | #define KEY_shmread 196 212 | #define KEY_shmwrite 197 213 | #define KEY_shutdown 198 214 | #define KEY_sin 199 215 | #define KEY_sleep 200 216 | #define KEY_socket 201 217 | #define KEY_socketpair 202 218 | #define KEY_sort 203 219 | #define KEY_splice 204 220 | #define KEY_split 205 221 | #define KEY_sprintf 206 222 | #define KEY_sqrt 207 223 | #define KEY_srand 208 224 | #define KEY_stat 209 225 | #define KEY_state 210 226 | #define KEY_study 211 227 | #define KEY_sub 212 228 | #define KEY_substr 213 229 | #define KEY_symlink 214 230 | #define KEY_syscall 215 231 | #define KEY_sysopen 216 232 | #define KEY_sysread 217 233 | #define KEY_sysseek 218 234 | #define KEY_system 219 235 | #define KEY_syswrite 220 236 | #define KEY_tell 221 237 | #define KEY_telldir 222 238 | #define KEY_tie 223 239 | #define KEY_tied 224 240 | #define KEY_time 225 241 | #define KEY_times 226 242 | #define KEY_tr 227 243 | #define KEY_truncate 228 244 | #define KEY_uc 229 245 | #define KEY_ucfirst 230 246 | #define KEY_umask 231 247 | #define KEY_undef 232 248 | #define KEY_unless 233 249 | #define KEY_unlink 234 250 | #define KEY_unpack 235 251 | #define KEY_unshift 236 252 | #define KEY_untie 237 253 | #define KEY_until 238 254 | #define KEY_use 239 255 | #define KEY_utime 240 256 | #define KEY_values 241 257 | #define KEY_vec 242 258 | #define KEY_wait 243 259 | #define KEY_waitpid 244 260 | #define KEY_wantarray 245 261 | #define KEY_warn 246 262 | #define KEY_when 247 263 | #define KEY_while 248 264 | #define KEY_write 249 265 | #define KEY_x 250 266 | #define KEY_xor 251 267 | #define KEY_y 252 268 | 269 | /* ex: set ro: */ 270 | -------------------------------------------------------------------------------- /microperl-5.10.1/gv.h: -------------------------------------------------------------------------------- 1 | /* gv.h 2 | * 3 | * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 4 | * 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 by Larry Wall and others 5 | * 6 | * You may distribute under the terms of either the GNU General Public 7 | * License or the Artistic License, as specified in the README file. 8 | * 9 | */ 10 | 11 | struct gp { 12 | SV * gp_sv; /* scalar value */ 13 | struct io * gp_io; /* filehandle value */ 14 | CV * gp_cv; /* subroutine value */ 15 | U32 gp_cvgen; /* generational validity of cached gv_cv */ 16 | U32 gp_refcnt; /* how many globs point to this? */ 17 | HV * gp_hv; /* hash value */ 18 | AV * gp_av; /* array value */ 19 | CV * gp_form; /* format value */ 20 | GV * gp_egv; /* effective gv, if *glob */ 21 | line_t gp_line; /* line first declared at (for -w) */ 22 | HEK * gp_file_hek; /* file first declared in (for -w) */ 23 | }; 24 | 25 | #define GvXPVGV(gv) ((XPVGV*)SvANY(gv)) 26 | 27 | 28 | #if defined (DEBUGGING) && defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__INTEL_COMPILER) 29 | # define GvGP(gv) \ 30 | (*({GV *const _gvgp = (GV *) (gv); \ 31 | assert(SvTYPE(_gvgp) == SVt_PVGV || SvTYPE(_gvgp) == SVt_PVLV); \ 32 | assert(isGV_with_GP(_gvgp)); \ 33 | &((_gvgp)->sv_u.svu_gp);})) 34 | # define GvFLAGS(gv) \ 35 | (*({GV *const _gvflags = (GV *) (gv); \ 36 | assert(SvTYPE(_gvflags) == SVt_PVGV || SvTYPE(_gvflags) == SVt_PVLV); \ 37 | assert(isGV_with_GP(_gvflags)); \ 38 | &(GvXPVGV(_gvflags)->xpv_cur);})) 39 | # define GvSTASH(gv) \ 40 | (*({ GV * const _gvstash = (GV *) (gv); \ 41 | assert(isGV_with_GP(_gvstash)); \ 42 | assert(SvTYPE(_gvstash) == SVt_PVGV || SvTYPE(_gvstash) >= SVt_PVLV); \ 43 | &(GvXPVGV(_gvstash)->xnv_u.xgv_stash); \ 44 | })) 45 | # define GvNAME_HEK(gv) \ 46 | (*({ GV * const _gvname_hek = (GV *) (gv); \ 47 | assert(isGV_with_GP(_gvname_hek)); \ 48 | assert(SvTYPE(_gvname_hek) == SVt_PVGV || SvTYPE(_gvname_hek) >= SVt_PVLV); \ 49 | assert(!SvVALID(_gvname_hek)); \ 50 | &(GvXPVGV(_gvname_hek)->xiv_u.xivu_namehek); \ 51 | })) 52 | # define GvNAME_get(gv) ({ assert(GvNAME_HEK(gv)); HEK_KEY(GvNAME_HEK(gv)); }) 53 | # define GvNAMELEN_get(gv) ({ assert(GvNAME_HEK(gv)); HEK_LEN(GvNAME_HEK(gv)); }) 54 | #else 55 | # define GvGP(gv) ((gv)->sv_u.svu_gp) 56 | # define GvFLAGS(gv) (GvXPVGV(gv)->xpv_cur) 57 | # define GvSTASH(gv) (GvXPVGV(gv)->xnv_u.xgv_stash) 58 | # define GvNAME_HEK(gv) (GvXPVGV(gv)->xiv_u.xivu_namehek) 59 | # define GvNAME_get(gv) HEK_KEY(GvNAME_HEK(gv)) 60 | # define GvNAMELEN_get(gv) HEK_LEN(GvNAME_HEK(gv)) 61 | #endif 62 | 63 | #define GvNAME(gv) GvNAME_get(gv) 64 | #define GvNAMELEN(gv) GvNAMELEN_get(gv) 65 | 66 | #define GvASSIGN_GENERATION(gv) (0 + ((XPV*) SvANY(gv))->xpv_len) 67 | #define GvASSIGN_GENERATION_set(gv,val) \ 68 | STMT_START { assert(SvTYPE(gv) == SVt_PVGV); \ 69 | (((XPV*) SvANY(gv))->xpv_len = (val)); } STMT_END 70 | 71 | /* 72 | =head1 GV Functions 73 | 74 | =for apidoc Am|SV*|GvSV|GV* gv 75 | 76 | Return the SV from the GV. 77 | 78 | =cut 79 | */ 80 | 81 | #define GvSV(gv) (GvGP(gv)->gp_sv) 82 | #ifdef PERL_DONT_CREATE_GVSV 83 | #define GvSVn(gv) (*(GvGP(gv)->gp_sv ? \ 84 | &(GvGP(gv)->gp_sv) : \ 85 | &(GvGP(gv_SVadd(gv))->gp_sv))) 86 | #else 87 | #define GvSVn(gv) GvSV(gv) 88 | #endif 89 | 90 | #define GvREFCNT(gv) (GvGP(gv)->gp_refcnt) 91 | #define GvIO(gv) ((gv) && SvTYPE((const SV*)gv) == SVt_PVGV && GvGP(gv) ? GvIOp(gv) : NULL) 92 | #define GvIOp(gv) (GvGP(gv)->gp_io) 93 | #define GvIOn(gv) (GvIO(gv) ? GvIOp(gv) : GvIOp(gv_IOadd(gv))) 94 | 95 | #define GvFORM(gv) (GvGP(gv)->gp_form) 96 | #define GvAV(gv) (GvGP(gv)->gp_av) 97 | 98 | /* This macro is deprecated. Do not use! */ 99 | #define GvREFCNT_inc(gv) ((GV*)SvREFCNT_inc(gv)) /* DO NOT USE */ 100 | 101 | #define GvAVn(gv) (GvGP(gv)->gp_av ? \ 102 | GvGP(gv)->gp_av : \ 103 | GvGP(gv_AVadd(gv))->gp_av) 104 | #define GvHV(gv) ((GvGP(gv))->gp_hv) 105 | 106 | #define GvHVn(gv) (GvGP(gv)->gp_hv ? \ 107 | GvGP(gv)->gp_hv : \ 108 | GvGP(gv_HVadd(gv))->gp_hv) 109 | 110 | #define GvCV(gv) (GvGP(gv)->gp_cv) 111 | #define GvCVGEN(gv) (GvGP(gv)->gp_cvgen) 112 | #define GvCVu(gv) (GvGP(gv)->gp_cvgen ? NULL : GvGP(gv)->gp_cv) 113 | 114 | #define GvLINE(gv) (GvGP(gv)->gp_line) 115 | #define GvFILE_HEK(gv) (GvGP(gv)->gp_file_hek) 116 | #define GvFILE(gv) (GvFILE_HEK(gv) ? HEK_KEY(GvFILE_HEK(gv)) : NULL) 117 | #define GvFILEGV(gv) (gv_fetchfile(GvFILE(gv))) 118 | 119 | #define GvEGV(gv) (GvGP(gv)->gp_egv) 120 | #define GvENAME(gv) GvNAME(GvEGV(gv) ? GvEGV(gv) : gv) 121 | #define GvESTASH(gv) GvSTASH(GvEGV(gv) ? GvEGV(gv) : gv) 122 | 123 | #define GVf_INTRO 0x01 124 | #define GVf_MULTI 0x02 125 | #define GVf_ASSUMECV 0x04 126 | #define GVf_IN_PAD 0x08 127 | #define GVf_IMPORTED 0xF0 128 | #define GVf_IMPORTED_SV 0x10 129 | #define GVf_IMPORTED_AV 0x20 130 | #define GVf_IMPORTED_HV 0x40 131 | #define GVf_IMPORTED_CV 0x80 132 | 133 | #define GvINTRO(gv) (GvFLAGS(gv) & GVf_INTRO) 134 | #define GvINTRO_on(gv) (GvFLAGS(gv) |= GVf_INTRO) 135 | #define GvINTRO_off(gv) (GvFLAGS(gv) &= ~GVf_INTRO) 136 | 137 | #define GvMULTI(gv) (GvFLAGS(gv) & GVf_MULTI) 138 | #define GvMULTI_on(gv) (GvFLAGS(gv) |= GVf_MULTI) 139 | #define GvMULTI_off(gv) (GvFLAGS(gv) &= ~GVf_MULTI) 140 | 141 | #define GvASSUMECV(gv) (GvFLAGS(gv) & GVf_ASSUMECV) 142 | #define GvASSUMECV_on(gv) (GvFLAGS(gv) |= GVf_ASSUMECV) 143 | #define GvASSUMECV_off(gv) (GvFLAGS(gv) &= ~GVf_ASSUMECV) 144 | 145 | #define GvIMPORTED(gv) (GvFLAGS(gv) & GVf_IMPORTED) 146 | #define GvIMPORTED_on(gv) (GvFLAGS(gv) |= GVf_IMPORTED) 147 | #define GvIMPORTED_off(gv) (GvFLAGS(gv) &= ~GVf_IMPORTED) 148 | 149 | #define GvIMPORTED_SV(gv) (GvFLAGS(gv) & GVf_IMPORTED_SV) 150 | #define GvIMPORTED_SV_on(gv) (GvFLAGS(gv) |= GVf_IMPORTED_SV) 151 | #define GvIMPORTED_SV_off(gv) (GvFLAGS(gv) &= ~GVf_IMPORTED_SV) 152 | 153 | #define GvIMPORTED_AV(gv) (GvFLAGS(gv) & GVf_IMPORTED_AV) 154 | #define GvIMPORTED_AV_on(gv) (GvFLAGS(gv) |= GVf_IMPORTED_AV) 155 | #define GvIMPORTED_AV_off(gv) (GvFLAGS(gv) &= ~GVf_IMPORTED_AV) 156 | 157 | #define GvIMPORTED_HV(gv) (GvFLAGS(gv) & GVf_IMPORTED_HV) 158 | #define GvIMPORTED_HV_on(gv) (GvFLAGS(gv) |= GVf_IMPORTED_HV) 159 | #define GvIMPORTED_HV_off(gv) (GvFLAGS(gv) &= ~GVf_IMPORTED_HV) 160 | 161 | #define GvIMPORTED_CV(gv) (GvFLAGS(gv) & GVf_IMPORTED_CV) 162 | #define GvIMPORTED_CV_on(gv) (GvFLAGS(gv) |= GVf_IMPORTED_CV) 163 | #define GvIMPORTED_CV_off(gv) (GvFLAGS(gv) &= ~GVf_IMPORTED_CV) 164 | 165 | #define GvIN_PAD(gv) (GvFLAGS(gv) & GVf_IN_PAD) 166 | #define GvIN_PAD_on(gv) (GvFLAGS(gv) |= GVf_IN_PAD) 167 | #define GvIN_PAD_off(gv) (GvFLAGS(gv) &= ~GVf_IN_PAD) 168 | 169 | #define GvUNIQUE(gv) 0 170 | #define GvUNIQUE_on(gv) NOOP 171 | #define GvUNIQUE_off(gv) NOOP 172 | 173 | #ifdef USE_ITHREADS 174 | #define GV_UNIQUE_CHECK 175 | #else 176 | #undef GV_UNIQUE_CHECK 177 | #endif 178 | 179 | #define Nullgv Null(GV*) 180 | 181 | #define DM_UID 0x003 182 | #define DM_RUID 0x001 183 | #define DM_EUID 0x002 184 | #define DM_ARRAY 0x004 185 | #define DM_GID 0x030 186 | #define DM_RGID 0x010 187 | #define DM_EGID 0x020 188 | #define DM_DELAY 0x100 189 | 190 | /* 191 | * symbol creation flags, for use in gv_fetchpv() and get_*v() 192 | */ 193 | #define GV_ADD 0x01 /* add, if symbol not already there 194 | For gv_name_set, adding a HEK for the first 195 | time, so don't try to free what's there. */ 196 | #define GV_ADDMULTI 0x02 /* add, pretending it has been added already */ 197 | #define GV_ADDWARN 0x04 /* add, but warn if symbol wasn't already there */ 198 | #define GV_ADDINEVAL 0x08 /* add, as though we're doing so within an eval */ 199 | #define GV_NOINIT 0x10 /* add, but don't init symbol, if type != PVGV */ 200 | /* This is used by toke.c to avoid turing placeholder constants in the symbol 201 | table into full PVGVs with attached constant subroutines. */ 202 | #define GV_NOADD_NOINIT 0x20 /* Don't add the symbol if it's not there. 203 | Don't init it if it is there but ! PVGV */ 204 | #define GV_NOEXPAND 0x40 /* Don't expand SvOK() entries to PVGV */ 205 | #define GV_NOTQUAL 0x80 /* A plain symbol name, not qualified with a 206 | package (so skip checks for :: and ') */ 207 | 208 | /* SVf_UTF8 (more accurately the return value from SvUTF8) is also valid 209 | as a flag to gv_fetch_pvn_flags, so ensure it lies outside this range. 210 | */ 211 | 212 | #define GV_NOADD_MASK (SVf_UTF8|GV_NOADD_NOINIT|GV_NOEXPAND|GV_NOTQUAL) 213 | /* The bit flags that don't cause gv_fetchpv() to add a symbol if not found */ 214 | 215 | #define gv_fullname3(sv,gv,prefix) gv_fullname4(sv,gv,prefix,TRUE) 216 | #define gv_efullname3(sv,gv,prefix) gv_efullname4(sv,gv,prefix,TRUE) 217 | #define gv_fetchmethod(stash, name) gv_fetchmethod_autoload(stash, name, TRUE) 218 | 219 | /* 220 | * Local variables: 221 | * c-indentation-style: bsd 222 | * c-basic-offset: 4 223 | * indent-tabs-mode: t 224 | * End: 225 | * 226 | * ex: set ts=8 sts=4 sw=4 noet: 227 | */ 228 | -------------------------------------------------------------------------------- /microperl-5.10.1/deb.c: -------------------------------------------------------------------------------- 1 | /* deb.c 2 | * 3 | * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, 4 | * 2002, 2003, 2004, 2005, 2006, 2007, 2008 by Larry Wall and others 5 | * 6 | * You may distribute under the terms of either the GNU General Public 7 | * License or the Artistic License, as specified in the README file. 8 | * 9 | */ 10 | 11 | /* 12 | * 'Didst thou think that the eyes of the White Tower were blind? Nay, 13 | * I have seen more than thou knowest, Grey Fool.' --Denethor 14 | * 15 | * [p.853 of _The Lord of the Rings_, V/vii: "The Pyre of Denethor"] 16 | */ 17 | 18 | /* 19 | * This file contains various utilities for producing debugging output 20 | * (mainly related to displaying the stack) 21 | */ 22 | 23 | #include "EXTERN.h" 24 | #define PERL_IN_DEB_C 25 | #include "perl.h" 26 | 27 | #if defined(PERL_IMPLICIT_CONTEXT) 28 | void 29 | Perl_deb_nocontext(const char *pat, ...) 30 | { 31 | #ifdef DEBUGGING 32 | dTHX; 33 | va_list args; 34 | PERL_ARGS_ASSERT_DEB_NOCONTEXT; 35 | va_start(args, pat); 36 | vdeb(pat, &args); 37 | va_end(args); 38 | #else 39 | PERL_UNUSED_ARG(pat); 40 | #endif /* DEBUGGING */ 41 | } 42 | #endif 43 | 44 | void 45 | Perl_deb(pTHX_ const char *pat, ...) 46 | { 47 | va_list args; 48 | PERL_ARGS_ASSERT_DEB; 49 | va_start(args, pat); 50 | #ifdef DEBUGGING 51 | vdeb(pat, &args); 52 | #else 53 | PERL_UNUSED_CONTEXT; 54 | #endif /* DEBUGGING */ 55 | va_end(args); 56 | } 57 | 58 | void 59 | Perl_vdeb(pTHX_ const char *pat, va_list *args) 60 | { 61 | #ifdef DEBUGGING 62 | dVAR; 63 | const char* const file = PL_curcop ? OutCopFILE(PL_curcop) : ""; 64 | const char* const display_file = file ? file : ""; 65 | const long line = PL_curcop ? (long)CopLINE(PL_curcop) : 0; 66 | 67 | PERL_ARGS_ASSERT_VDEB; 68 | 69 | if (DEBUG_v_TEST) 70 | PerlIO_printf(Perl_debug_log, "(%ld:%s:%ld)\t", 71 | (long)PerlProc_getpid(), display_file, line); 72 | else 73 | PerlIO_printf(Perl_debug_log, "(%s:%ld)\t", display_file, line); 74 | (void) PerlIO_vprintf(Perl_debug_log, pat, *args); 75 | #else 76 | PERL_UNUSED_CONTEXT; 77 | PERL_UNUSED_ARG(pat); 78 | PERL_UNUSED_ARG(args); 79 | #endif /* DEBUGGING */ 80 | } 81 | 82 | I32 83 | Perl_debstackptrs(pTHX) 84 | { 85 | #ifdef DEBUGGING 86 | dVAR; 87 | PerlIO_printf(Perl_debug_log, 88 | "%8"UVxf" %8"UVxf" %8"IVdf" %8"IVdf" %8"IVdf"\n", 89 | PTR2UV(PL_curstack), PTR2UV(PL_stack_base), 90 | (IV)*PL_markstack_ptr, (IV)(PL_stack_sp-PL_stack_base), 91 | (IV)(PL_stack_max-PL_stack_base)); 92 | PerlIO_printf(Perl_debug_log, 93 | "%8"UVxf" %8"UVxf" %8"UVuf" %8"UVuf" %8"UVuf"\n", 94 | PTR2UV(PL_mainstack), PTR2UV(AvARRAY(PL_curstack)), 95 | PTR2UV(PL_mainstack), PTR2UV(AvFILLp(PL_curstack)), 96 | PTR2UV(AvMAX(PL_curstack))); 97 | #endif /* DEBUGGING */ 98 | return 0; 99 | } 100 | 101 | 102 | /* dump the contents of a particular stack 103 | * Display stack_base[stack_min+1 .. stack_max], 104 | * and display the marks whose offsets are contained in addresses 105 | * PL_markstack[mark_min+1 .. mark_max] and whose values are in the range 106 | * of the stack values being displayed 107 | * 108 | * Only displays top 30 max 109 | */ 110 | 111 | STATIC void 112 | S_deb_stack_n(pTHX_ SV** stack_base, I32 stack_min, I32 stack_max, 113 | I32 mark_min, I32 mark_max) 114 | { 115 | #ifdef DEBUGGING 116 | dVAR; 117 | register I32 i = stack_max - 30; 118 | const I32 *markscan = PL_markstack + mark_min; 119 | 120 | PERL_ARGS_ASSERT_DEB_STACK_N; 121 | 122 | if (i < stack_min) 123 | i = stack_min; 124 | 125 | while (++markscan <= PL_markstack + mark_max) 126 | if (*markscan >= i) 127 | break; 128 | 129 | if (i > stack_min) 130 | PerlIO_printf(Perl_debug_log, "... "); 131 | 132 | if (stack_base[0] != &PL_sv_undef || stack_max < 0) 133 | PerlIO_printf(Perl_debug_log, " [STACK UNDERFLOW!!!]\n"); 134 | do { 135 | ++i; 136 | if (markscan <= PL_markstack + mark_max && *markscan < i) { 137 | do { 138 | ++markscan; 139 | PerlIO_putc(Perl_debug_log, '*'); 140 | } 141 | while (markscan <= PL_markstack + mark_max && *markscan < i); 142 | PerlIO_printf(Perl_debug_log, " "); 143 | } 144 | if (i > stack_max) 145 | break; 146 | PerlIO_printf(Perl_debug_log, "%-4s ", SvPEEK(stack_base[i])); 147 | } 148 | while (1); 149 | PerlIO_printf(Perl_debug_log, "\n"); 150 | #else 151 | PERL_UNUSED_CONTEXT; 152 | PERL_UNUSED_ARG(stack_base); 153 | PERL_UNUSED_ARG(stack_min); 154 | PERL_UNUSED_ARG(stack_max); 155 | PERL_UNUSED_ARG(mark_min); 156 | PERL_UNUSED_ARG(mark_max); 157 | #endif /* DEBUGGING */ 158 | } 159 | 160 | 161 | /* dump the current stack */ 162 | 163 | I32 164 | Perl_debstack(pTHX) 165 | { 166 | #ifndef SKIP_DEBUGGING 167 | dVAR; 168 | if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_) 169 | return 0; 170 | 171 | PerlIO_printf(Perl_debug_log, " => "); 172 | deb_stack_n(PL_stack_base, 173 | 0, 174 | PL_stack_sp - PL_stack_base, 175 | PL_curstackinfo->si_markoff, 176 | PL_markstack_ptr - PL_markstack); 177 | 178 | 179 | #endif /* SKIP_DEBUGGING */ 180 | return 0; 181 | } 182 | 183 | 184 | #ifdef DEBUGGING 185 | static const char * const si_names[] = { 186 | "UNKNOWN", 187 | "UNDEF", 188 | "MAIN", 189 | "MAGIC", 190 | "SORT", 191 | "SIGNAL", 192 | "OVERLOAD", 193 | "DESTROY", 194 | "WARNHOOK", 195 | "DIEHOOK", 196 | "REQUIRE" 197 | }; 198 | #endif 199 | 200 | /* display all stacks */ 201 | 202 | 203 | void 204 | Perl_deb_stack_all(pTHX) 205 | { 206 | #ifdef DEBUGGING 207 | dVAR; 208 | I32 si_ix; 209 | const PERL_SI *si; 210 | 211 | /* rewind to start of chain */ 212 | si = PL_curstackinfo; 213 | while (si->si_prev) 214 | si = si->si_prev; 215 | 216 | si_ix=0; 217 | for (;;) 218 | { 219 | const size_t si_name_ix = si->si_type+1; /* -1 is a valid index */ 220 | const char * const si_name = (si_name_ix >= sizeof(si_names)) ? "????" : si_names[si_name_ix]; 221 | I32 ix; 222 | PerlIO_printf(Perl_debug_log, "STACK %"IVdf": %s\n", 223 | (IV)si_ix, si_name); 224 | 225 | for (ix=0; ix<=si->si_cxix; ix++) { 226 | 227 | const PERL_CONTEXT * const cx = &(si->si_cxstack[ix]); 228 | PerlIO_printf(Perl_debug_log, 229 | " CX %"IVdf": %-6s => ", 230 | (IV)ix, PL_block_type[CxTYPE(cx)] 231 | ); 232 | /* substitution contexts don't save stack pointers etc) */ 233 | if (CxTYPE(cx) == CXt_SUBST) 234 | PerlIO_printf(Perl_debug_log, "\n"); 235 | else { 236 | 237 | /* Find the the current context's stack range by searching 238 | * forward for any higher contexts using this stack; failing 239 | * that, it will be equal to the size of the stack for old 240 | * stacks, or PL_stack_sp for the current stack 241 | */ 242 | 243 | I32 i, stack_min, stack_max, mark_min, mark_max; 244 | const PERL_CONTEXT *cx_n = NULL; 245 | const PERL_SI *si_n; 246 | 247 | /* there's a separate stack per SI, so only search 248 | * this one */ 249 | 250 | for (i=ix+1; i<=si->si_cxix; i++) { 251 | if (CxTYPE(cx) == CXt_SUBST) 252 | continue; 253 | cx_n = &(si->si_cxstack[i]); 254 | break; 255 | } 256 | 257 | stack_min = cx->blk_oldsp; 258 | 259 | if (cx_n) { 260 | stack_max = cx_n->blk_oldsp; 261 | } 262 | else if (si == PL_curstackinfo) { 263 | stack_max = PL_stack_sp - AvARRAY(si->si_stack); 264 | } 265 | else { 266 | stack_max = AvFILLp(si->si_stack); 267 | } 268 | 269 | /* for the other stack types, there's only one stack 270 | * shared between all SIs */ 271 | 272 | si_n = si; 273 | i = ix; 274 | cx_n = NULL; 275 | for (;;) { 276 | i++; 277 | if (i > si_n->si_cxix) { 278 | if (si_n == PL_curstackinfo) 279 | break; 280 | else { 281 | si_n = si_n->si_next; 282 | i = 0; 283 | } 284 | } 285 | if (CxTYPE(&(si_n->si_cxstack[i])) == CXt_SUBST) 286 | continue; 287 | cx_n = &(si_n->si_cxstack[i]); 288 | break; 289 | } 290 | 291 | mark_min = cx->blk_oldmarksp; 292 | if (cx_n) { 293 | mark_max = cx_n->blk_oldmarksp; 294 | } 295 | else { 296 | mark_max = PL_markstack_ptr - PL_markstack; 297 | } 298 | 299 | deb_stack_n(AvARRAY(si->si_stack), 300 | stack_min, stack_max, mark_min, mark_max); 301 | 302 | if (CxTYPE(cx) == CXt_EVAL || CxTYPE(cx) == CXt_SUB 303 | || CxTYPE(cx) == CXt_FORMAT) 304 | { 305 | const OP * const retop = (CxTYPE(cx) == CXt_EVAL) 306 | ? cx->blk_eval.retop : cx->blk_sub.retop; 307 | 308 | PerlIO_printf(Perl_debug_log, " retop=%s\n", 309 | retop ? OP_NAME(retop) : "(null)" 310 | ); 311 | } 312 | } 313 | } /* next context */ 314 | 315 | 316 | if (si == PL_curstackinfo) 317 | break; 318 | si = si->si_next; 319 | si_ix++; 320 | if (!si) 321 | break; /* shouldn't happen, but just in case.. */ 322 | } /* next stackinfo */ 323 | 324 | PerlIO_printf(Perl_debug_log, "\n"); 325 | #else 326 | PERL_UNUSED_CONTEXT; 327 | #endif /* DEBUGGING */ 328 | } 329 | 330 | /* 331 | * Local variables: 332 | * c-indentation-style: bsd 333 | * c-basic-offset: 4 334 | * indent-tabs-mode: t 335 | * End: 336 | * 337 | * ex: set ts=8 sts=4 sw=4 noet: 338 | */ 339 | -------------------------------------------------------------------------------- /microperl-5.10.1/scope.h: -------------------------------------------------------------------------------- 1 | /* scope.h 2 | * 3 | * Copyright (C) 1993, 1994, 1996, 1997, 1998, 1999, 2000, 2001, 4 | * 2002, 2004, 2005, 2006, 2007, 2008 by Larry Wall and others 5 | * 6 | * You may distribute under the terms of either the GNU General Public 7 | * License or the Artistic License, as specified in the README file. 8 | * 9 | */ 10 | 11 | #define SAVEt_ITEM 0 12 | #define SAVEt_SV 1 13 | #define SAVEt_AV 2 14 | #define SAVEt_HV 3 15 | #define SAVEt_INT 4 16 | #define SAVEt_LONG 5 17 | #define SAVEt_I32 6 18 | #define SAVEt_IV 7 19 | #define SAVEt_SPTR 8 20 | #define SAVEt_APTR 9 21 | #define SAVEt_HPTR 10 22 | #define SAVEt_PPTR 11 23 | #define SAVEt_NSTAB 12 24 | #define SAVEt_SVREF 13 25 | #define SAVEt_GP 14 26 | #define SAVEt_FREESV 15 27 | #define SAVEt_FREEOP 16 28 | #define SAVEt_FREEPV 17 29 | #define SAVEt_CLEARSV 18 30 | #define SAVEt_DELETE 19 31 | #define SAVEt_DESTRUCTOR 20 32 | #define SAVEt_REGCONTEXT 21 33 | #define SAVEt_STACK_POS 22 34 | #define SAVEt_I16 23 35 | #define SAVEt_AELEM 24 36 | #define SAVEt_HELEM 25 37 | #define SAVEt_OP 26 38 | #define SAVEt_HINTS 27 39 | #define SAVEt_ALLOC 28 40 | #define SAVEt_GENERIC_SVREF 29 41 | #define SAVEt_DESTRUCTOR_X 30 42 | #define SAVEt_VPTR 31 43 | #define SAVEt_I8 32 44 | #define SAVEt_COMPPAD 33 45 | #define SAVEt_GENERIC_PVREF 34 46 | #define SAVEt_PADSV 35 47 | #define SAVEt_MORTALIZESV 36 48 | #define SAVEt_SHARED_PVREF 37 49 | #define SAVEt_BOOL 38 50 | #define SAVEt_SET_SVFLAGS 39 51 | #define SAVEt_SAVESWITCHSTACK 40 52 | #define SAVEt_COP_ARYBASE 41 53 | #define SAVEt_RE_STATE 42 54 | #define SAVEt_COMPILE_WARNINGS 43 55 | #define SAVEt_STACK_CXPOS 44 56 | #define SAVEt_PARSER 45 57 | #define SAVEt_PADSV_AND_MORTALIZE 46 58 | 59 | #ifndef SCOPE_SAVES_SIGNAL_MASK 60 | #define SCOPE_SAVES_SIGNAL_MASK 0 61 | #endif 62 | 63 | #define SSCHECK(need) if (PL_savestack_ix + (I32)(need) > PL_savestack_max) savestack_grow() 64 | #define SSGROW(need) if (PL_savestack_ix + (I32)(need) > PL_savestack_max) savestack_grow_cnt(need) 65 | #define SSPUSHINT(i) (PL_savestack[PL_savestack_ix++].any_i32 = (I32)(i)) 66 | #define SSPUSHLONG(i) (PL_savestack[PL_savestack_ix++].any_long = (long)(i)) 67 | #define SSPUSHBOOL(p) (PL_savestack[PL_savestack_ix++].any_bool = (p)) 68 | #define SSPUSHIV(i) (PL_savestack[PL_savestack_ix++].any_iv = (IV)(i)) 69 | #define SSPUSHPTR(p) (PL_savestack[PL_savestack_ix++].any_ptr = (void*)(p)) 70 | #define SSPUSHDPTR(p) (PL_savestack[PL_savestack_ix++].any_dptr = (p)) 71 | #define SSPUSHDXPTR(p) (PL_savestack[PL_savestack_ix++].any_dxptr = (p)) 72 | #define SSPOPINT (PL_savestack[--PL_savestack_ix].any_i32) 73 | #define SSPOPLONG (PL_savestack[--PL_savestack_ix].any_long) 74 | #define SSPOPBOOL (PL_savestack[--PL_savestack_ix].any_bool) 75 | #define SSPOPIV (PL_savestack[--PL_savestack_ix].any_iv) 76 | #define SSPOPPTR (PL_savestack[--PL_savestack_ix].any_ptr) 77 | #define SSPOPDPTR (PL_savestack[--PL_savestack_ix].any_dptr) 78 | #define SSPOPDXPTR (PL_savestack[--PL_savestack_ix].any_dxptr) 79 | 80 | /* 81 | =head1 Callback Functions 82 | 83 | =for apidoc Ams||SAVETMPS 84 | Opening bracket for temporaries on a callback. See C and 85 | L. 86 | 87 | =for apidoc Ams||FREETMPS 88 | Closing bracket for temporaries on a callback. See C and 89 | L. 90 | 91 | =for apidoc Ams||ENTER 92 | Opening bracket on a callback. See C and L. 93 | 94 | =for apidoc Ams||LEAVE 95 | Closing bracket on a callback. See C and L. 96 | 97 | =cut 98 | */ 99 | 100 | #define SAVETMPS save_int((int*)&PL_tmps_floor), PL_tmps_floor = PL_tmps_ix 101 | #define FREETMPS if (PL_tmps_ix > PL_tmps_floor) free_tmps() 102 | 103 | #ifdef DEBUGGING 104 | #define ENTER \ 105 | STMT_START { \ 106 | push_scope(); \ 107 | DEBUG_SCOPE("ENTER") \ 108 | } STMT_END 109 | #define LEAVE \ 110 | STMT_START { \ 111 | DEBUG_SCOPE("LEAVE") \ 112 | pop_scope(); \ 113 | } STMT_END 114 | #else 115 | #define ENTER push_scope() 116 | #define LEAVE pop_scope() 117 | #endif 118 | #define LEAVE_SCOPE(old) if (PL_savestack_ix > old) leave_scope(old) 119 | 120 | #define SAVEI8(i) save_I8((I8*)&(i)) 121 | #define SAVEI16(i) save_I16((I16*)&(i)) 122 | #define SAVEI32(i) save_I32((I32*)&(i)) 123 | #define SAVEINT(i) save_int((int*)&(i)) 124 | #define SAVEIV(i) save_iv((IV*)&(i)) 125 | #define SAVELONG(l) save_long((long*)&(l)) 126 | #define SAVEBOOL(b) save_bool((bool*)&(b)) 127 | #define SAVESPTR(s) save_sptr((SV**)&(s)) 128 | #define SAVEPPTR(s) save_pptr((char**)&(s)) 129 | #define SAVEVPTR(s) save_vptr((void*)&(s)) 130 | #define SAVEPADSV(s) save_padsv(s) 131 | #define SAVEPADSVANDMORTALIZE(s) save_padsv_and_mortalize(s) 132 | #define SAVEFREESV(s) save_freesv(MUTABLE_SV(s)) 133 | #define SAVEMORTALIZESV(s) save_mortalizesv(MUTABLE_SV(s)) 134 | #define SAVEFREEOP(o) save_freeop((OP*)(o)) 135 | #define SAVEFREEPV(p) save_freepv((char*)(p)) 136 | #define SAVECLEARSV(sv) save_clearsv((SV**)&(sv)) 137 | #define SAVEGENERICSV(s) save_generic_svref((SV**)&(s)) 138 | #define SAVEGENERICPV(s) save_generic_pvref((char**)&(s)) 139 | #define SAVESHAREDPV(s) save_shared_pvref((char**)&(s)) 140 | #define SAVESETSVFLAGS(sv,mask,val) save_set_svflags(sv,mask,val) 141 | #define SAVEDELETE(h,k,l) \ 142 | save_delete(MUTABLE_HV(h), (char*)(k), (I32)(l)) 143 | #define SAVEDESTRUCTOR(f,p) \ 144 | save_destructor((DESTRUCTORFUNC_NOCONTEXT_t)(f), (void*)(p)) 145 | 146 | #define SAVEDESTRUCTOR_X(f,p) \ 147 | save_destructor_x((DESTRUCTORFUNC_t)(f), (void*)(p)) 148 | 149 | #define SAVESTACK_POS() \ 150 | STMT_START { \ 151 | SSCHECK(2); \ 152 | SSPUSHINT(PL_stack_sp - PL_stack_base); \ 153 | SSPUSHINT(SAVEt_STACK_POS); \ 154 | } STMT_END 155 | 156 | #define SAVEOP() save_op() 157 | 158 | #define SAVEHINTS() save_hints() 159 | 160 | #define SAVECOMPPAD() save_pushptr(MUTABLE_SV(PL_comppad), SAVEt_COMPPAD) 161 | 162 | #define SAVESWITCHSTACK(f,t) \ 163 | STMT_START { \ 164 | save_pushptrptr(MUTABLE_SV(f), MUTABLE_SV(t), SAVEt_SAVESWITCHSTACK); \ 165 | SWITCHSTACK((f),(t)); \ 166 | PL_curstackinfo->si_stack = (t); \ 167 | } STMT_END 168 | 169 | #define SAVECOPARYBASE(c) save_pushi32ptr(CopARYBASE_get(c), c, SAVEt_COP_ARYBASE); 170 | 171 | /* Need to do the cop warnings like this, rather than a "SAVEFREESHAREDPV", 172 | because realloc() means that the value can actually change. Possibly 173 | could have done savefreesharedpvREF, but this way actually seems cleaner, 174 | as it simplifies the code that does the saves, and reduces the load on the 175 | save stack. */ 176 | #define SAVECOMPILEWARNINGS() save_pushptr(PL_compiling.cop_warnings, SAVEt_COMPILE_WARNINGS) 177 | 178 | #define SAVESTACK_CXPOS() \ 179 | STMT_START { \ 180 | SSCHECK(3); \ 181 | SSPUSHINT(cxstack[cxstack_ix].blk_oldsp); \ 182 | SSPUSHINT(cxstack_ix); \ 183 | SSPUSHINT(SAVEt_STACK_CXPOS); \ 184 | } STMT_END 185 | 186 | #define SAVEPARSER(p) save_pushptr((p), SAVEt_PARSER) 187 | 188 | #ifdef USE_ITHREADS 189 | # define SAVECOPSTASH(c) SAVEPPTR(CopSTASHPV(c)) 190 | # define SAVECOPSTASH_FREE(c) SAVESHAREDPV(CopSTASHPV(c)) 191 | # define SAVECOPFILE(c) SAVEPPTR(CopFILE(c)) 192 | # define SAVECOPFILE_FREE(c) SAVESHAREDPV(CopFILE(c)) 193 | # define SAVECOPLABEL(c) SAVEPPTR(CopLABEL(c)) 194 | # define SAVECOPLABEL_FREE(c) SAVESHAREDPV(CopLABEL(c)) 195 | #else 196 | # define SAVECOPSTASH(c) SAVESPTR(CopSTASH(c)) 197 | # define SAVECOPSTASH_FREE(c) SAVECOPSTASH(c) /* XXX not refcounted */ 198 | # define SAVECOPFILE(c) SAVESPTR(CopFILEGV(c)) 199 | # define SAVECOPFILE_FREE(c) SAVEGENERICSV(CopFILEGV(c)) 200 | # define SAVECOPLABEL(c) SAVEPPTR(CopLABEL(c)) 201 | # define SAVECOPLABEL_FREE(c) SAVEPPTR(CopLABEL(c)) 202 | #endif 203 | 204 | #define SAVECOPLINE(c) SAVEI32(CopLINE(c)) 205 | 206 | /* SSNEW() temporarily allocates a specified number of bytes of data on the 207 | * savestack. It returns an integer index into the savestack, because a 208 | * pointer would get broken if the savestack is moved on reallocation. 209 | * SSNEWa() works like SSNEW(), but also aligns the data to the specified 210 | * number of bytes. MEM_ALIGNBYTES is perhaps the most useful. The 211 | * alignment will be preserved therough savestack reallocation *only* if 212 | * realloc returns data aligned to a size divisible by "align"! 213 | * 214 | * SSPTR() converts the index returned by SSNEW/SSNEWa() into a pointer. 215 | */ 216 | 217 | #define SSNEW(size) Perl_save_alloc(aTHX_ (size), 0) 218 | #define SSNEWt(n,t) SSNEW((n)*sizeof(t)) 219 | #define SSNEWa(size,align) Perl_save_alloc(aTHX_ (size), \ 220 | (I32)(align - ((size_t)((caddr_t)&PL_savestack[PL_savestack_ix]) % align)) % align) 221 | #define SSNEWat(n,t,align) SSNEWa((n)*sizeof(t), align) 222 | 223 | #define SSPTR(off,type) ((type) ((char*)PL_savestack + off)) 224 | #define SSPTRt(off,type) ((type*) ((char*)PL_savestack + off)) 225 | 226 | #define save_freesv(op) save_pushptr((void *)(op), SAVEt_FREESV) 227 | #define save_mortalizesv(op) save_pushptr((void *)(op), SAVEt_MORTALIZESV) 228 | #define save_freeop(op) save_pushptr((void *)(op), SAVEt_FREEOP) 229 | #define save_freepv(pv) save_pushptr((void *)(pv), SAVEt_FREEPV) 230 | #define save_op() save_pushptr((void *)(PL_op), SAVEt_OP) 231 | 232 | /* 233 | * Local variables: 234 | * c-indentation-style: bsd 235 | * c-basic-offset: 4 236 | * indent-tabs-mode: t 237 | * End: 238 | * 239 | * ex: set ts=8 sts=4 sw=4 noet: 240 | */ 241 | -------------------------------------------------------------------------------- /microperl-5.10.1/cv.h: -------------------------------------------------------------------------------- 1 | /* cv.h 2 | * 3 | * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1999, 2000, 2001, 4 | * 2002, 2003, 2004, 2005, 2006, 2007, 2008 by Larry Wall and others 5 | * 6 | * You may distribute under the terms of either the GNU General Public 7 | * License or the Artistic License, as specified in the README file. 8 | * 9 | */ 10 | 11 | /* This structure must the beginning of XPVFM in sv.h */ 12 | 13 | struct xpvcv { 14 | union { 15 | NV xnv_nv; /* numeric value, if any */ 16 | HV * xgv_stash; 17 | struct { 18 | U32 xlow; 19 | U32 xhigh; 20 | } xpad_cop_seq; /* used by pad.c for cop_sequence */ 21 | struct { 22 | U32 xbm_previous; /* how many characters in string before rare? */ 23 | U8 xbm_flags; 24 | U8 xbm_rare; /* rarest character in string */ 25 | } xbm_s; /* fields from PVBM */ 26 | } xnv_u; 27 | STRLEN xpv_cur; /* length of xp_pv as a C string */ 28 | STRLEN xpv_len; /* allocated size */ 29 | union { 30 | IV xivu_iv; 31 | UV xivu_uv; 32 | void * xivu_p1; 33 | I32 xivu_i32; /* depth, >= 2 indicates recursive call */ 34 | HEK * xivu_namehek; 35 | } xiv_u; 36 | union { 37 | MAGIC* xmg_magic; /* linked list of magicalness */ 38 | HV* xmg_ourstash; /* Stash for our (when SvPAD_OUR is true) */ 39 | } xmg_u; 40 | HV* xmg_stash; /* class package */ 41 | 42 | HV * xcv_stash; 43 | union { 44 | OP * xcv_start; 45 | ANY xcv_xsubany; 46 | } xcv_start_u; 47 | union { 48 | OP * xcv_root; 49 | void (*xcv_xsub) (pTHX_ CV*); 50 | } xcv_root_u; 51 | GV * xcv_gv; 52 | char * xcv_file; 53 | PADLIST * xcv_padlist; 54 | CV * xcv_outside; 55 | U32 xcv_outside_seq; /* the COP sequence (at the point of our 56 | * compilation) in the lexically enclosing 57 | * sub */ 58 | cv_flags_t xcv_flags; 59 | }; 60 | 61 | typedef struct { 62 | STRLEN xpv_cur; /* length of xp_pv as a C string */ 63 | STRLEN xpv_len; /* allocated size */ 64 | union { 65 | IV xivu_iv; 66 | UV xivu_uv; 67 | void * xivu_p1; 68 | I32 xivu_i32; /* depth, >= 2 indicates recursive call */ 69 | HEK * xivu_namehek; 70 | } xiv_u; 71 | union { 72 | MAGIC* xmg_magic; /* linked list of magicalness */ 73 | HV* xmg_ourstash; /* Stash for our (when SvPAD_OUR is true) */ 74 | } xmg_u; 75 | HV* xmg_stash; /* class package */ 76 | 77 | HV * xcv_stash; 78 | union { 79 | OP * xcv_start; 80 | ANY xcv_xsubany; 81 | } xcv_start_u; 82 | union { 83 | OP * xcv_root; 84 | void (*xcv_xsub) (pTHX_ CV*); 85 | } xcv_root_u; 86 | GV * xcv_gv; 87 | char * xcv_file; 88 | PADLIST * xcv_padlist; 89 | CV * xcv_outside; 90 | U32 xcv_outside_seq; /* the COP sequence (at the point of our 91 | * compilation) in the lexically enclosing 92 | * sub */ 93 | cv_flags_t xcv_flags; 94 | } xpvcv_allocated; 95 | 96 | /* 97 | =head1 Handy Values 98 | 99 | =for apidoc AmU||Nullcv 100 | Null CV pointer. 101 | 102 | =head1 CV Manipulation Functions 103 | 104 | =for apidoc Am|HV*|CvSTASH|CV* cv 105 | Returns the stash of the CV. 106 | 107 | =cut 108 | */ 109 | 110 | #define Nullcv Null(CV*) 111 | 112 | #define CvSTASH(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_stash 113 | #define CvSTART(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_start_u.xcv_start 114 | #define CvROOT(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_root_u.xcv_root 115 | #define CvXSUB(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_root_u.xcv_xsub 116 | #define CvXSUBANY(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_start_u.xcv_xsubany 117 | #define CvGV(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_gv 118 | #define CvFILE(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_file 119 | #ifdef USE_ITHREADS 120 | # define CvFILE_set_from_cop(sv, cop) (CvFILE(sv) = savepv(CopFILE(cop))) 121 | #else 122 | # define CvFILE_set_from_cop(sv, cop) (CvFILE(sv) = CopFILE(cop)) 123 | #endif 124 | #define CvFILEGV(sv) (gv_fetchfile(CvFILE(sv))) 125 | #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) 126 | # define CvDEPTH(sv) (*({const CV *const _cvdepth = (const CV *)sv; \ 127 | assert(SvTYPE(_cvdepth) == SVt_PVCV); \ 128 | &((XPVCV*)SvANY(_cvdepth))->xiv_u.xivu_i32; \ 129 | })) 130 | #else 131 | # define CvDEPTH(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xiv_u.xivu_i32 132 | #endif 133 | #define CvPADLIST(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_padlist 134 | #define CvOUTSIDE(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_outside 135 | #define CvFLAGS(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_flags 136 | #define CvOUTSIDE_SEQ(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_outside_seq 137 | 138 | #define CVf_METHOD 0x0001 /* CV is explicitly marked as a method */ 139 | #define CVf_LOCKED 0x0002 /* CV locks itself or first arg on entry */ 140 | #define CVf_LVALUE 0x0004 /* CV return value can be used as lvalue */ 141 | 142 | #define CVf_WEAKOUTSIDE 0x0010 /* CvOUTSIDE isn't ref counted */ 143 | #define CVf_CLONE 0x0020 /* anon CV uses external lexicals */ 144 | #define CVf_CLONED 0x0040 /* a clone of one of those */ 145 | #define CVf_ANON 0x0080 /* CvGV() can't be trusted */ 146 | #define CVf_UNIQUE 0x0100 /* sub is only called once (eg PL_main_cv, 147 | * require, eval). */ 148 | #define CVf_NODEBUG 0x0200 /* no DB::sub indirection for this CV 149 | (esp. useful for special XSUBs) */ 150 | #define CVf_CONST 0x0400 /* inlinable sub */ 151 | #define CVf_ISXSUB 0x0800 /* CV is an XSUB, not pure perl. */ 152 | 153 | /* This symbol for optimised communication between toke.c and op.c: */ 154 | #define CVf_BUILTIN_ATTRS (CVf_METHOD|CVf_LOCKED|CVf_LVALUE) 155 | 156 | #define CvCLONE(cv) (CvFLAGS(cv) & CVf_CLONE) 157 | #define CvCLONE_on(cv) (CvFLAGS(cv) |= CVf_CLONE) 158 | #define CvCLONE_off(cv) (CvFLAGS(cv) &= ~CVf_CLONE) 159 | 160 | #define CvCLONED(cv) (CvFLAGS(cv) & CVf_CLONED) 161 | #define CvCLONED_on(cv) (CvFLAGS(cv) |= CVf_CLONED) 162 | #define CvCLONED_off(cv) (CvFLAGS(cv) &= ~CVf_CLONED) 163 | 164 | #define CvANON(cv) (CvFLAGS(cv) & CVf_ANON) 165 | #define CvANON_on(cv) (CvFLAGS(cv) |= CVf_ANON) 166 | #define CvANON_off(cv) (CvFLAGS(cv) &= ~CVf_ANON) 167 | 168 | #define CvUNIQUE(cv) (CvFLAGS(cv) & CVf_UNIQUE) 169 | #define CvUNIQUE_on(cv) (CvFLAGS(cv) |= CVf_UNIQUE) 170 | #define CvUNIQUE_off(cv) (CvFLAGS(cv) &= ~CVf_UNIQUE) 171 | 172 | #define CvNODEBUG(cv) (CvFLAGS(cv) & CVf_NODEBUG) 173 | #define CvNODEBUG_on(cv) (CvFLAGS(cv) |= CVf_NODEBUG) 174 | #define CvNODEBUG_off(cv) (CvFLAGS(cv) &= ~CVf_NODEBUG) 175 | 176 | #define CvMETHOD(cv) (CvFLAGS(cv) & CVf_METHOD) 177 | #define CvMETHOD_on(cv) (CvFLAGS(cv) |= CVf_METHOD) 178 | #define CvMETHOD_off(cv) (CvFLAGS(cv) &= ~CVf_METHOD) 179 | 180 | #define CvLOCKED(cv) (CvFLAGS(cv) & CVf_LOCKED) 181 | #define CvLOCKED_on(cv) (CvFLAGS(cv) |= CVf_LOCKED) 182 | #define CvLOCKED_off(cv) (CvFLAGS(cv) &= ~CVf_LOCKED) 183 | 184 | #define CvLVALUE(cv) (CvFLAGS(cv) & CVf_LVALUE) 185 | #define CvLVALUE_on(cv) (CvFLAGS(cv) |= CVf_LVALUE) 186 | #define CvLVALUE_off(cv) (CvFLAGS(cv) &= ~CVf_LVALUE) 187 | 188 | #define CvEVAL(cv) (CvUNIQUE(cv) && !SvFAKE(cv)) 189 | #define CvEVAL_on(cv) (CvUNIQUE_on(cv),SvFAKE_off(cv)) 190 | #define CvEVAL_off(cv) CvUNIQUE_off(cv) 191 | 192 | /* BEGIN|CHECK|INIT|UNITCHECK|END */ 193 | #define CvSPECIAL(cv) (CvUNIQUE(cv) && SvFAKE(cv)) 194 | #define CvSPECIAL_on(cv) (CvUNIQUE_on(cv),SvFAKE_on(cv)) 195 | #define CvSPECIAL_off(cv) (CvUNIQUE_off(cv),SvFAKE_off(cv)) 196 | 197 | #define CvCONST(cv) (CvFLAGS(cv) & CVf_CONST) 198 | #define CvCONST_on(cv) (CvFLAGS(cv) |= CVf_CONST) 199 | #define CvCONST_off(cv) (CvFLAGS(cv) &= ~CVf_CONST) 200 | 201 | #define CvWEAKOUTSIDE(cv) (CvFLAGS(cv) & CVf_WEAKOUTSIDE) 202 | #define CvWEAKOUTSIDE_on(cv) (CvFLAGS(cv) |= CVf_WEAKOUTSIDE) 203 | #define CvWEAKOUTSIDE_off(cv) (CvFLAGS(cv) &= ~CVf_WEAKOUTSIDE) 204 | 205 | #define CvISXSUB(cv) (CvFLAGS(cv) & CVf_ISXSUB) 206 | #define CvISXSUB_on(cv) (CvFLAGS(cv) |= CVf_ISXSUB) 207 | #define CvISXSUB_off(cv) (CvFLAGS(cv) &= ~CVf_ISXSUB) 208 | 209 | /* Flags for newXS_flags */ 210 | #define XS_DYNAMIC_FILENAME 0x01 /* The filename isn't static */ 211 | 212 | /* 213 | =head1 CV reference counts and CvOUTSIDE 214 | 215 | =for apidoc m|bool|CvWEAKOUTSIDE|CV *cv 216 | 217 | Each CV has a pointer, C, to its lexically enclosing 218 | CV (if any). Because pointers to anonymous sub prototypes are 219 | stored in C<&> pad slots, it is a possible to get a circular reference, 220 | with the parent pointing to the child and vice-versa. To avoid the 221 | ensuing memory leak, we do not increment the reference count of the CV 222 | pointed to by C in the I that the parent 223 | has a C<&> pad slot pointing back to us. In this case, we set the 224 | C flag in the child. This allows us to determine under what 225 | circumstances we should decrement the refcount of the parent when freeing 226 | the child. 227 | 228 | There is a further complication with non-closure anonymous subs (i.e. those 229 | that do not refer to any lexicals outside that sub). In this case, the 230 | anonymous prototype is shared rather than being cloned. This has the 231 | consequence that the parent may be freed while there are still active 232 | children, eg 233 | 234 | BEGIN { $a = sub { eval '$x' } } 235 | 236 | In this case, the BEGIN is freed immediately after execution since there 237 | are no active references to it: the anon sub prototype has 238 | C set since it's not a closure, and $a points to the same 239 | CV, so it doesn't contribute to BEGIN's refcount either. When $a is 240 | executed, the C causes the chain of Cs to be followed, 241 | and the freed BEGIN is accessed. 242 | 243 | To avoid this, whenever a CV and its associated pad is freed, any 244 | C<&> entries in the pad are explicitly removed from the pad, and if the 245 | refcount of the pointed-to anon sub is still positive, then that 246 | child's C is set to point to its grandparent. This will only 247 | occur in the single specific case of a non-closure anon prototype 248 | having one or more active references (such as C<$a> above). 249 | 250 | One other thing to consider is that a CV may be merely undefined 251 | rather than freed, eg C. In this case, its refcount may 252 | not have reached zero, but we still delete its pad and its C etc. 253 | Since various children may still have their C pointing at this 254 | undefined CV, we keep its own C for the time being, so that 255 | the chain of lexical scopes is unbroken. For example, the following 256 | should print 123: 257 | 258 | my $x = 123; 259 | sub tmp { sub { eval '$x' } } 260 | my $a = tmp(); 261 | undef &tmp; 262 | print $a->(); 263 | 264 | =cut 265 | */ 266 | 267 | /* 268 | * Local variables: 269 | * c-indentation-style: bsd 270 | * c-basic-offset: 4 271 | * indent-tabs-mode: t 272 | * End: 273 | * 274 | * ex: set ts=8 sts=4 sw=4 noet: 275 | */ 276 | -------------------------------------------------------------------------------- /microperl-5.10.1/opnames.h: -------------------------------------------------------------------------------- 1 | /* -*- buffer-read-only: t -*- 2 | * 3 | * opnames.h 4 | * 5 | * Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 6 | * 2007, 2008 by Larry Wall and others 7 | * 8 | * You may distribute under the terms of either the GNU General Public 9 | * License or the Artistic License, as specified in the README file. 10 | * 11 | * 12 | * !!!!!!! DO NOT EDIT THIS FILE !!!!!!! 13 | * This file is built by opcode.pl from its data. Any changes made here 14 | * will be lost! 15 | */ 16 | 17 | typedef enum opcode { 18 | OP_NULL, /* 0 */ 19 | OP_STUB, /* 1 */ 20 | OP_SCALAR, /* 2 */ 21 | OP_PUSHMARK, /* 3 */ 22 | OP_WANTARRAY, /* 4 */ 23 | OP_CONST, /* 5 */ 24 | OP_GVSV, /* 6 */ 25 | OP_GV, /* 7 */ 26 | OP_GELEM, /* 8 */ 27 | OP_PADSV, /* 9 */ 28 | OP_PADAV, /* 10 */ 29 | OP_PADHV, /* 11 */ 30 | OP_PADANY, /* 12 */ 31 | OP_PUSHRE, /* 13 */ 32 | OP_RV2GV, /* 14 */ 33 | OP_RV2SV, /* 15 */ 34 | OP_AV2ARYLEN, /* 16 */ 35 | OP_RV2CV, /* 17 */ 36 | OP_ANONCODE, /* 18 */ 37 | OP_PROTOTYPE, /* 19 */ 38 | OP_REFGEN, /* 20 */ 39 | OP_SREFGEN, /* 21 */ 40 | OP_REF, /* 22 */ 41 | OP_BLESS, /* 23 */ 42 | OP_BACKTICK, /* 24 */ 43 | OP_GLOB, /* 25 */ 44 | OP_READLINE, /* 26 */ 45 | OP_RCATLINE, /* 27 */ 46 | OP_REGCMAYBE, /* 28 */ 47 | OP_REGCRESET, /* 29 */ 48 | OP_REGCOMP, /* 30 */ 49 | OP_MATCH, /* 31 */ 50 | OP_QR, /* 32 */ 51 | OP_SUBST, /* 33 */ 52 | OP_SUBSTCONT, /* 34 */ 53 | OP_TRANS, /* 35 */ 54 | OP_SASSIGN, /* 36 */ 55 | OP_AASSIGN, /* 37 */ 56 | OP_CHOP, /* 38 */ 57 | OP_SCHOP, /* 39 */ 58 | OP_CHOMP, /* 40 */ 59 | OP_SCHOMP, /* 41 */ 60 | OP_DEFINED, /* 42 */ 61 | OP_UNDEF, /* 43 */ 62 | OP_STUDY, /* 44 */ 63 | OP_POS, /* 45 */ 64 | OP_PREINC, /* 46 */ 65 | OP_I_PREINC, /* 47 */ 66 | OP_PREDEC, /* 48 */ 67 | OP_I_PREDEC, /* 49 */ 68 | OP_POSTINC, /* 50 */ 69 | OP_I_POSTINC, /* 51 */ 70 | OP_POSTDEC, /* 52 */ 71 | OP_I_POSTDEC, /* 53 */ 72 | OP_POW, /* 54 */ 73 | OP_MULTIPLY, /* 55 */ 74 | OP_I_MULTIPLY, /* 56 */ 75 | OP_DIVIDE, /* 57 */ 76 | OP_I_DIVIDE, /* 58 */ 77 | OP_MODULO, /* 59 */ 78 | OP_I_MODULO, /* 60 */ 79 | OP_REPEAT, /* 61 */ 80 | OP_ADD, /* 62 */ 81 | OP_I_ADD, /* 63 */ 82 | OP_SUBTRACT, /* 64 */ 83 | OP_I_SUBTRACT, /* 65 */ 84 | OP_CONCAT, /* 66 */ 85 | OP_STRINGIFY, /* 67 */ 86 | OP_LEFT_SHIFT, /* 68 */ 87 | OP_RIGHT_SHIFT, /* 69 */ 88 | OP_LT, /* 70 */ 89 | OP_I_LT, /* 71 */ 90 | OP_GT, /* 72 */ 91 | OP_I_GT, /* 73 */ 92 | OP_LE, /* 74 */ 93 | OP_I_LE, /* 75 */ 94 | OP_GE, /* 76 */ 95 | OP_I_GE, /* 77 */ 96 | OP_EQ, /* 78 */ 97 | OP_I_EQ, /* 79 */ 98 | OP_NE, /* 80 */ 99 | OP_I_NE, /* 81 */ 100 | OP_NCMP, /* 82 */ 101 | OP_I_NCMP, /* 83 */ 102 | OP_SLT, /* 84 */ 103 | OP_SGT, /* 85 */ 104 | OP_SLE, /* 86 */ 105 | OP_SGE, /* 87 */ 106 | OP_SEQ, /* 88 */ 107 | OP_SNE, /* 89 */ 108 | OP_SCMP, /* 90 */ 109 | OP_BIT_AND, /* 91 */ 110 | OP_BIT_XOR, /* 92 */ 111 | OP_BIT_OR, /* 93 */ 112 | OP_NEGATE, /* 94 */ 113 | OP_I_NEGATE, /* 95 */ 114 | OP_NOT, /* 96 */ 115 | OP_COMPLEMENT, /* 97 */ 116 | OP_SMARTMATCH, /* 98 */ 117 | OP_ATAN2, /* 99 */ 118 | OP_SIN, /* 100 */ 119 | OP_COS, /* 101 */ 120 | OP_RAND, /* 102 */ 121 | OP_SRAND, /* 103 */ 122 | OP_EXP, /* 104 */ 123 | OP_LOG, /* 105 */ 124 | OP_SQRT, /* 106 */ 125 | OP_INT, /* 107 */ 126 | OP_HEX, /* 108 */ 127 | OP_OCT, /* 109 */ 128 | OP_ABS, /* 110 */ 129 | OP_LENGTH, /* 111 */ 130 | OP_SUBSTR, /* 112 */ 131 | OP_VEC, /* 113 */ 132 | OP_INDEX, /* 114 */ 133 | OP_RINDEX, /* 115 */ 134 | OP_SPRINTF, /* 116 */ 135 | OP_FORMLINE, /* 117 */ 136 | OP_ORD, /* 118 */ 137 | OP_CHR, /* 119 */ 138 | OP_CRYPT, /* 120 */ 139 | OP_UCFIRST, /* 121 */ 140 | OP_LCFIRST, /* 122 */ 141 | OP_UC, /* 123 */ 142 | OP_LC, /* 124 */ 143 | OP_QUOTEMETA, /* 125 */ 144 | OP_RV2AV, /* 126 */ 145 | OP_AELEMFAST, /* 127 */ 146 | OP_AELEM, /* 128 */ 147 | OP_ASLICE, /* 129 */ 148 | OP_EACH, /* 130 */ 149 | OP_VALUES, /* 131 */ 150 | OP_KEYS, /* 132 */ 151 | OP_DELETE, /* 133 */ 152 | OP_EXISTS, /* 134 */ 153 | OP_RV2HV, /* 135 */ 154 | OP_HELEM, /* 136 */ 155 | OP_HSLICE, /* 137 */ 156 | OP_UNPACK, /* 138 */ 157 | OP_PACK, /* 139 */ 158 | OP_SPLIT, /* 140 */ 159 | OP_JOIN, /* 141 */ 160 | OP_LIST, /* 142 */ 161 | OP_LSLICE, /* 143 */ 162 | OP_ANONLIST, /* 144 */ 163 | OP_ANONHASH, /* 145 */ 164 | OP_SPLICE, /* 146 */ 165 | OP_PUSH, /* 147 */ 166 | OP_POP, /* 148 */ 167 | OP_SHIFT, /* 149 */ 168 | OP_UNSHIFT, /* 150 */ 169 | OP_SORT, /* 151 */ 170 | OP_REVERSE, /* 152 */ 171 | OP_GREPSTART, /* 153 */ 172 | OP_GREPWHILE, /* 154 */ 173 | OP_MAPSTART, /* 155 */ 174 | OP_MAPWHILE, /* 156 */ 175 | OP_RANGE, /* 157 */ 176 | OP_FLIP, /* 158 */ 177 | OP_FLOP, /* 159 */ 178 | OP_AND, /* 160 */ 179 | OP_OR, /* 161 */ 180 | OP_XOR, /* 162 */ 181 | OP_DOR, /* 163 */ 182 | OP_COND_EXPR, /* 164 */ 183 | OP_ANDASSIGN, /* 165 */ 184 | OP_ORASSIGN, /* 166 */ 185 | OP_DORASSIGN, /* 167 */ 186 | OP_METHOD, /* 168 */ 187 | OP_ENTERSUB, /* 169 */ 188 | OP_LEAVESUB, /* 170 */ 189 | OP_LEAVESUBLV, /* 171 */ 190 | OP_CALLER, /* 172 */ 191 | OP_WARN, /* 173 */ 192 | OP_DIE, /* 174 */ 193 | OP_RESET, /* 175 */ 194 | OP_LINESEQ, /* 176 */ 195 | OP_NEXTSTATE, /* 177 */ 196 | OP_DBSTATE, /* 178 */ 197 | OP_UNSTACK, /* 179 */ 198 | OP_ENTER, /* 180 */ 199 | OP_LEAVE, /* 181 */ 200 | OP_SCOPE, /* 182 */ 201 | OP_ENTERITER, /* 183 */ 202 | OP_ITER, /* 184 */ 203 | OP_ENTERLOOP, /* 185 */ 204 | OP_LEAVELOOP, /* 186 */ 205 | OP_RETURN, /* 187 */ 206 | OP_LAST, /* 188 */ 207 | OP_NEXT, /* 189 */ 208 | OP_REDO, /* 190 */ 209 | OP_DUMP, /* 191 */ 210 | OP_GOTO, /* 192 */ 211 | OP_EXIT, /* 193 */ 212 | OP_SETSTATE, /* 194 */ 213 | OP_METHOD_NAMED,/* 195 */ 214 | OP_ENTERGIVEN, /* 196 */ 215 | OP_LEAVEGIVEN, /* 197 */ 216 | OP_ENTERWHEN, /* 198 */ 217 | OP_LEAVEWHEN, /* 199 */ 218 | OP_BREAK, /* 200 */ 219 | OP_CONTINUE, /* 201 */ 220 | OP_OPEN, /* 202 */ 221 | OP_CLOSE, /* 203 */ 222 | OP_PIPE_OP, /* 204 */ 223 | OP_FILENO, /* 205 */ 224 | OP_UMASK, /* 206 */ 225 | OP_BINMODE, /* 207 */ 226 | OP_TIE, /* 208 */ 227 | OP_UNTIE, /* 209 */ 228 | OP_TIED, /* 210 */ 229 | OP_DBMOPEN, /* 211 */ 230 | OP_DBMCLOSE, /* 212 */ 231 | OP_SSELECT, /* 213 */ 232 | OP_SELECT, /* 214 */ 233 | OP_GETC, /* 215 */ 234 | OP_READ, /* 216 */ 235 | OP_ENTERWRITE, /* 217 */ 236 | OP_LEAVEWRITE, /* 218 */ 237 | OP_PRTF, /* 219 */ 238 | OP_PRINT, /* 220 */ 239 | OP_SAY, /* 221 */ 240 | OP_SYSOPEN, /* 222 */ 241 | OP_SYSSEEK, /* 223 */ 242 | OP_SYSREAD, /* 224 */ 243 | OP_SYSWRITE, /* 225 */ 244 | OP_SEND, /* 226 */ 245 | OP_RECV, /* 227 */ 246 | OP_EOF, /* 228 */ 247 | OP_TELL, /* 229 */ 248 | OP_SEEK, /* 230 */ 249 | OP_TRUNCATE, /* 231 */ 250 | OP_FCNTL, /* 232 */ 251 | OP_IOCTL, /* 233 */ 252 | OP_FLOCK, /* 234 */ 253 | OP_SOCKET, /* 235 */ 254 | OP_SOCKPAIR, /* 236 */ 255 | OP_BIND, /* 237 */ 256 | OP_CONNECT, /* 238 */ 257 | OP_LISTEN, /* 239 */ 258 | OP_ACCEPT, /* 240 */ 259 | OP_SHUTDOWN, /* 241 */ 260 | OP_GSOCKOPT, /* 242 */ 261 | OP_SSOCKOPT, /* 243 */ 262 | OP_GETSOCKNAME, /* 244 */ 263 | OP_GETPEERNAME, /* 245 */ 264 | OP_LSTAT, /* 246 */ 265 | OP_STAT, /* 247 */ 266 | OP_FTRREAD, /* 248 */ 267 | OP_FTRWRITE, /* 249 */ 268 | OP_FTREXEC, /* 250 */ 269 | OP_FTEREAD, /* 251 */ 270 | OP_FTEWRITE, /* 252 */ 271 | OP_FTEEXEC, /* 253 */ 272 | OP_FTIS, /* 254 */ 273 | OP_FTSIZE, /* 255 */ 274 | OP_FTMTIME, /* 256 */ 275 | OP_FTATIME, /* 257 */ 276 | OP_FTCTIME, /* 258 */ 277 | OP_FTROWNED, /* 259 */ 278 | OP_FTEOWNED, /* 260 */ 279 | OP_FTZERO, /* 261 */ 280 | OP_FTSOCK, /* 262 */ 281 | OP_FTCHR, /* 263 */ 282 | OP_FTBLK, /* 264 */ 283 | OP_FTFILE, /* 265 */ 284 | OP_FTDIR, /* 266 */ 285 | OP_FTPIPE, /* 267 */ 286 | OP_FTSUID, /* 268 */ 287 | OP_FTSGID, /* 269 */ 288 | OP_FTSVTX, /* 270 */ 289 | OP_FTLINK, /* 271 */ 290 | OP_FTTTY, /* 272 */ 291 | OP_FTTEXT, /* 273 */ 292 | OP_FTBINARY, /* 274 */ 293 | OP_CHDIR, /* 275 */ 294 | OP_CHOWN, /* 276 */ 295 | OP_CHROOT, /* 277 */ 296 | OP_UNLINK, /* 278 */ 297 | OP_CHMOD, /* 279 */ 298 | OP_UTIME, /* 280 */ 299 | OP_RENAME, /* 281 */ 300 | OP_LINK, /* 282 */ 301 | OP_SYMLINK, /* 283 */ 302 | OP_READLINK, /* 284 */ 303 | OP_MKDIR, /* 285 */ 304 | OP_RMDIR, /* 286 */ 305 | OP_OPEN_DIR, /* 287 */ 306 | OP_READDIR, /* 288 */ 307 | OP_TELLDIR, /* 289 */ 308 | OP_SEEKDIR, /* 290 */ 309 | OP_REWINDDIR, /* 291 */ 310 | OP_CLOSEDIR, /* 292 */ 311 | OP_FORK, /* 293 */ 312 | OP_WAIT, /* 294 */ 313 | OP_WAITPID, /* 295 */ 314 | OP_SYSTEM, /* 296 */ 315 | OP_EXEC, /* 297 */ 316 | OP_KILL, /* 298 */ 317 | OP_GETPPID, /* 299 */ 318 | OP_GETPGRP, /* 300 */ 319 | OP_SETPGRP, /* 301 */ 320 | OP_GETPRIORITY, /* 302 */ 321 | OP_SETPRIORITY, /* 303 */ 322 | OP_TIME, /* 304 */ 323 | OP_TMS, /* 305 */ 324 | OP_LOCALTIME, /* 306 */ 325 | OP_GMTIME, /* 307 */ 326 | OP_ALARM, /* 308 */ 327 | OP_SLEEP, /* 309 */ 328 | OP_SHMGET, /* 310 */ 329 | OP_SHMCTL, /* 311 */ 330 | OP_SHMREAD, /* 312 */ 331 | OP_SHMWRITE, /* 313 */ 332 | OP_MSGGET, /* 314 */ 333 | OP_MSGCTL, /* 315 */ 334 | OP_MSGSND, /* 316 */ 335 | OP_MSGRCV, /* 317 */ 336 | OP_SEMOP, /* 318 */ 337 | OP_SEMGET, /* 319 */ 338 | OP_SEMCTL, /* 320 */ 339 | OP_REQUIRE, /* 321 */ 340 | OP_DOFILE, /* 322 */ 341 | OP_ENTEREVAL, /* 323 */ 342 | OP_LEAVEEVAL, /* 324 */ 343 | OP_ENTERTRY, /* 325 */ 344 | OP_LEAVETRY, /* 326 */ 345 | OP_GHBYNAME, /* 327 */ 346 | OP_GHBYADDR, /* 328 */ 347 | OP_GHOSTENT, /* 329 */ 348 | OP_GNBYNAME, /* 330 */ 349 | OP_GNBYADDR, /* 331 */ 350 | OP_GNETENT, /* 332 */ 351 | OP_GPBYNAME, /* 333 */ 352 | OP_GPBYNUMBER, /* 334 */ 353 | OP_GPROTOENT, /* 335 */ 354 | OP_GSBYNAME, /* 336 */ 355 | OP_GSBYPORT, /* 337 */ 356 | OP_GSERVENT, /* 338 */ 357 | OP_SHOSTENT, /* 339 */ 358 | OP_SNETENT, /* 340 */ 359 | OP_SPROTOENT, /* 341 */ 360 | OP_SSERVENT, /* 342 */ 361 | OP_EHOSTENT, /* 343 */ 362 | OP_ENETENT, /* 344 */ 363 | OP_EPROTOENT, /* 345 */ 364 | OP_ESERVENT, /* 346 */ 365 | OP_GPWNAM, /* 347 */ 366 | OP_GPWUID, /* 348 */ 367 | OP_GPWENT, /* 349 */ 368 | OP_SPWENT, /* 350 */ 369 | OP_EPWENT, /* 351 */ 370 | OP_GGRNAM, /* 352 */ 371 | OP_GGRGID, /* 353 */ 372 | OP_GGRENT, /* 354 */ 373 | OP_SGRENT, /* 355 */ 374 | OP_EGRENT, /* 356 */ 375 | OP_GETLOGIN, /* 357 */ 376 | OP_SYSCALL, /* 358 */ 377 | OP_LOCK, /* 359 */ 378 | OP_ONCE, /* 360 */ 379 | OP_CUSTOM, /* 361 */ 380 | OP_max 381 | } opcode; 382 | 383 | #define MAXO 362 384 | #define OP_phoney_INPUT_ONLY -1 385 | #define OP_phoney_OUTPUT_ONLY -2 386 | 387 | 388 | #define OP_IS_SOCKET(op) \ 389 | ((op) == OP_ACCEPT || \ 390 | (op) == OP_BIND || \ 391 | (op) == OP_CONNECT || \ 392 | (op) == OP_GETPEERNAME || \ 393 | (op) == OP_GETSOCKNAME || \ 394 | (op) == OP_GSOCKOPT || \ 395 | (op) == OP_LISTEN || \ 396 | (op) == OP_RECV || \ 397 | (op) == OP_SEND || \ 398 | (op) == OP_SHUTDOWN || \ 399 | (op) == OP_SOCKET || \ 400 | (op) == OP_SOCKPAIR || \ 401 | (op) == OP_SSOCKOPT) 402 | 403 | 404 | #define OP_IS_FILETEST(op) \ 405 | ((op) == OP_FTATIME || \ 406 | (op) == OP_FTBINARY || \ 407 | (op) == OP_FTBLK || \ 408 | (op) == OP_FTCHR || \ 409 | (op) == OP_FTCTIME || \ 410 | (op) == OP_FTDIR || \ 411 | (op) == OP_FTEEXEC || \ 412 | (op) == OP_FTEOWNED || \ 413 | (op) == OP_FTEREAD || \ 414 | (op) == OP_FTEWRITE || \ 415 | (op) == OP_FTFILE || \ 416 | (op) == OP_FTIS || \ 417 | (op) == OP_FTLINK || \ 418 | (op) == OP_FTMTIME || \ 419 | (op) == OP_FTPIPE || \ 420 | (op) == OP_FTREXEC || \ 421 | (op) == OP_FTROWNED || \ 422 | (op) == OP_FTRREAD || \ 423 | (op) == OP_FTRWRITE || \ 424 | (op) == OP_FTSGID || \ 425 | (op) == OP_FTSIZE || \ 426 | (op) == OP_FTSOCK || \ 427 | (op) == OP_FTSUID || \ 428 | (op) == OP_FTSVTX || \ 429 | (op) == OP_FTTEXT || \ 430 | (op) == OP_FTTTY || \ 431 | (op) == OP_FTZERO) 432 | 433 | /* ex: set ro: */ 434 | -------------------------------------------------------------------------------- /microperl-5.10.1/perlio.h: -------------------------------------------------------------------------------- 1 | /* perlio.h 2 | * 3 | * Copyright (C) 1996, 1997, 1999, 2000, 2001, 2002, 2003, 4 | * 2004, 2005, 2006, 2007, by Larry Wall and others 5 | * 6 | * You may distribute under the terms of either the GNU General Public 7 | * License or the Artistic License, as specified in the README file. 8 | * 9 | */ 10 | 11 | #ifndef _PERLIO_H 12 | #define _PERLIO_H 13 | /* 14 | Interface for perl to IO functions. 15 | There is a hierarchy of Configure determined #define controls: 16 | USE_STDIO - forces PerlIO_xxx() to be #define-d onto stdio functions. 17 | This is used for x2p subdirectory and for conservative 18 | builds - "just like perl5.00X used to be". 19 | This dominates over the others. 20 | 21 | USE_PERLIO - The primary Configure variable that enables PerlIO. 22 | If USE_PERLIO is _NOT_ set 23 | then USE_STDIO above will be set to be conservative. 24 | If USE_PERLIO is set 25 | then there are two modes determined by USE_SFIO: 26 | 27 | USE_SFIO - If set causes PerlIO_xxx() to be #define-d onto sfio functions. 28 | A backward compatability mode for some specialist applications. 29 | 30 | If USE_SFIO is not set then PerlIO_xxx() are real functions 31 | defined in perlio.c which implement extra functionality 32 | required for utf8 support. 33 | 34 | One further note - the table-of-functions scheme controlled 35 | by PERL_IMPLICIT_SYS turns on USE_PERLIO so that iperlsys.h can 36 | #define PerlIO_xxx() to go via the function table, without having 37 | to #undef them from (say) stdio forms. 38 | 39 | */ 40 | 41 | #if defined(PERL_IMPLICIT_SYS) 42 | #ifndef USE_PERLIO 43 | #ifndef NETWARE 44 | /* # define USE_PERLIO */ 45 | #endif 46 | #endif 47 | #endif 48 | 49 | #ifndef USE_PERLIO 50 | # define USE_STDIO 51 | #endif 52 | 53 | #ifdef USE_STDIO 54 | # ifndef PERLIO_IS_STDIO 55 | # define PERLIO_IS_STDIO 56 | # endif 57 | #endif 58 | 59 | /* -------------------- End of Configure controls ---------------------------- */ 60 | 61 | /* 62 | * Although we may not want stdio to be used including here 63 | * avoids issues where stdio.h has strange side effects 64 | */ 65 | #include 66 | 67 | #ifdef __BEOS__ 68 | int fseeko(FILE *stream, off_t offset, int whence); 69 | off_t ftello(FILE *stream); 70 | #endif 71 | 72 | #if defined(USE_64_BIT_STDIO) && defined(HAS_FTELLO) && !defined(USE_FTELL64) 73 | #define ftell ftello 74 | #endif 75 | 76 | #if defined(USE_64_BIT_STDIO) && defined(HAS_FSEEKO) && !defined(USE_FSEEK64) 77 | #define fseek fseeko 78 | #endif 79 | 80 | /* BS2000 includes are sometimes a bit non standard :-( */ 81 | #if defined(POSIX_BC) && defined(O_BINARY) && !defined(O_TEXT) 82 | #undef O_BINARY 83 | #endif 84 | 85 | #ifdef PERLIO_IS_STDIO 86 | /* #define PerlIO_xxxx() as equivalent stdio function */ 87 | #include "perlsdio.h" 88 | #else /* PERLIO_IS_STDIO */ 89 | #ifdef USE_SFIO 90 | /* #define PerlIO_xxxx() as equivalent sfio function */ 91 | #include "perlsfio.h" 92 | #endif /* USE_SFIO */ 93 | #endif /* PERLIO_IS_STDIO */ 94 | 95 | #ifndef PerlIO 96 | /* ----------- PerlIO implementation ---------- */ 97 | /* PerlIO not #define-d to something else - define the implementation */ 98 | 99 | typedef struct _PerlIO PerlIOl; 100 | typedef struct _PerlIO_funcs PerlIO_funcs; 101 | typedef PerlIOl *PerlIO; 102 | #define PerlIO PerlIO 103 | #define PERLIO_LAYERS 1 104 | 105 | /* Making the big PerlIO_funcs vtables const is good (enables placing 106 | * them in the const section which is good for speed, security, and 107 | * embeddability) but this cannot be done by default because of 108 | * backward compatibility. */ 109 | #ifdef PERLIO_FUNCS_CONST 110 | #define PERLIO_FUNCS_DECL(funcs) const PerlIO_funcs funcs 111 | #define PERLIO_FUNCS_CAST(funcs) (PerlIO_funcs*)(funcs) 112 | #else 113 | #define PERLIO_FUNCS_DECL(funcs) PerlIO_funcs funcs 114 | #define PERLIO_FUNCS_CAST(funcs) (funcs) 115 | #endif 116 | 117 | PERL_EXPORT_C void PerlIO_define_layer(pTHX_ PerlIO_funcs *tab); 118 | PERL_EXPORT_C PerlIO_funcs *PerlIO_find_layer(pTHX_ const char *name, 119 | STRLEN len, 120 | int load); 121 | PERL_EXPORT_C PerlIO *PerlIO_push(pTHX_ PerlIO *f, PERLIO_FUNCS_DECL(*tab), 122 | const char *mode, SV *arg); 123 | PERL_EXPORT_C void PerlIO_pop(pTHX_ PerlIO *f); 124 | PERL_EXPORT_C AV* PerlIO_get_layers(pTHX_ PerlIO *f); 125 | PERL_EXPORT_C void PerlIO_clone(pTHX_ PerlInterpreter *proto, 126 | CLONE_PARAMS *param); 127 | 128 | #endif /* PerlIO */ 129 | 130 | /* ----------- End of implementation choices ---------- */ 131 | 132 | #ifndef PERLIO_IS_STDIO 133 | /* Not using stdio _directly_ as PerlIO */ 134 | 135 | /* We now need to determine what happens if source trys to use stdio. 136 | * There are three cases based on PERLIO_NOT_STDIO which XS code 137 | * can set how it wants. 138 | */ 139 | 140 | #ifdef PERL_CORE 141 | /* Make a choice for perl core code 142 | - currently this is set to try and catch lingering raw stdio calls. 143 | This is a known issue with some non UNIX ports which still use 144 | "native" stdio features. 145 | */ 146 | #ifndef PERLIO_NOT_STDIO 147 | #define PERLIO_NOT_STDIO 1 148 | #endif 149 | #else 150 | #ifndef PERLIO_NOT_STDIO 151 | #define PERLIO_NOT_STDIO 0 152 | #endif 153 | #endif 154 | 155 | #ifdef PERLIO_NOT_STDIO 156 | #if PERLIO_NOT_STDIO 157 | /* 158 | * PERLIO_NOT_STDIO #define'd as 1 159 | * Case 1: Strong denial of stdio - make all stdio calls (we can think of) errors 160 | */ 161 | #include "nostdio.h" 162 | #else /* if PERLIO_NOT_STDIO */ 163 | /* 164 | * PERLIO_NOT_STDIO #define'd as 0 165 | * Case 2: Declares that both PerlIO and stdio can be used 166 | */ 167 | #endif /* if PERLIO_NOT_STDIO */ 168 | #else /* ifdef PERLIO_NOT_STDIO */ 169 | /* 170 | * PERLIO_NOT_STDIO not defined 171 | * Case 3: Try and fake stdio calls as PerlIO calls 172 | */ 173 | #include "fakesdio.h" 174 | #endif /* ifndef PERLIO_NOT_STDIO */ 175 | #endif /* PERLIO_IS_STDIO */ 176 | 177 | /* ----------- fill in things that have not got #define'd ---------- */ 178 | 179 | #ifndef Fpos_t 180 | #define Fpos_t Off_t 181 | #endif 182 | 183 | #ifndef EOF 184 | #define EOF (-1) 185 | #endif 186 | 187 | /* This is to catch case with no stdio */ 188 | #ifndef BUFSIZ 189 | #define BUFSIZ 1024 190 | #endif 191 | 192 | #ifndef SEEK_SET 193 | #define SEEK_SET 0 194 | #endif 195 | 196 | #ifndef SEEK_CUR 197 | #define SEEK_CUR 1 198 | #endif 199 | 200 | #ifndef SEEK_END 201 | #define SEEK_END 2 202 | #endif 203 | 204 | #define PERLIO_DUP_CLONE 1 205 | #define PERLIO_DUP_FD 2 206 | 207 | /* --------------------- Now prototypes for functions --------------- */ 208 | 209 | START_EXTERN_C 210 | #ifndef __attribute__format__ 211 | # ifdef HASATTRIBUTE_FORMAT 212 | # define __attribute__format__(x,y,z) __attribute__((format(x,y,z))) 213 | # else 214 | # define __attribute__format__(x,y,z) 215 | # endif 216 | #endif 217 | #ifndef PerlIO_init 218 | PERL_EXPORT_C void PerlIO_init(pTHX); 219 | #endif 220 | #ifndef PerlIO_stdoutf 221 | PERL_EXPORT_C int PerlIO_stdoutf(const char *, ...) 222 | __attribute__format__(__printf__, 1, 2); 223 | #endif 224 | #ifndef PerlIO_puts 225 | PERL_EXPORT_C int PerlIO_puts(PerlIO *, const char *); 226 | #endif 227 | #ifndef PerlIO_open 228 | PERL_EXPORT_C PerlIO *PerlIO_open(const char *, const char *); 229 | #endif 230 | #ifndef PerlIO_openn 231 | PERL_EXPORT_C PerlIO *PerlIO_openn(pTHX_ const char *layers, const char *mode, 232 | int fd, int imode, int perm, PerlIO *old, 233 | int narg, SV **arg); 234 | #endif 235 | #ifndef PerlIO_eof 236 | PERL_EXPORT_C int PerlIO_eof(PerlIO *); 237 | #endif 238 | #ifndef PerlIO_error 239 | PERL_EXPORT_C int PerlIO_error(PerlIO *); 240 | #endif 241 | #ifndef PerlIO_clearerr 242 | PERL_EXPORT_C void PerlIO_clearerr(PerlIO *); 243 | #endif 244 | #ifndef PerlIO_getc 245 | PERL_EXPORT_C int PerlIO_getc(PerlIO *); 246 | #endif 247 | #ifndef PerlIO_putc 248 | PERL_EXPORT_C int PerlIO_putc(PerlIO *, int); 249 | #endif 250 | #ifndef PerlIO_ungetc 251 | PERL_EXPORT_C int PerlIO_ungetc(PerlIO *, int); 252 | #endif 253 | #ifndef PerlIO_fdopen 254 | PERL_EXPORT_C PerlIO *PerlIO_fdopen(int, const char *); 255 | #endif 256 | #ifndef PerlIO_importFILE 257 | PERL_EXPORT_C PerlIO *PerlIO_importFILE(FILE *, const char *); 258 | #endif 259 | #ifndef PerlIO_exportFILE 260 | PERL_EXPORT_C FILE *PerlIO_exportFILE(PerlIO *, const char *); 261 | #endif 262 | #ifndef PerlIO_findFILE 263 | PERL_EXPORT_C FILE *PerlIO_findFILE(PerlIO *); 264 | #endif 265 | #ifndef PerlIO_releaseFILE 266 | PERL_EXPORT_C void PerlIO_releaseFILE(PerlIO *, FILE *); 267 | #endif 268 | #ifndef PerlIO_read 269 | PERL_EXPORT_C SSize_t PerlIO_read(PerlIO *, void *, Size_t); 270 | #endif 271 | #ifndef PerlIO_unread 272 | PERL_EXPORT_C SSize_t PerlIO_unread(PerlIO *, const void *, Size_t); 273 | #endif 274 | #ifndef PerlIO_write 275 | PERL_EXPORT_C SSize_t PerlIO_write(PerlIO *, const void *, Size_t); 276 | #endif 277 | #ifndef PerlIO_setlinebuf 278 | PERL_EXPORT_C void PerlIO_setlinebuf(PerlIO *); 279 | #endif 280 | #ifndef PerlIO_printf 281 | PERL_EXPORT_C int PerlIO_printf(PerlIO *, const char *, ...) 282 | __attribute__format__(__printf__, 2, 3); 283 | #endif 284 | #ifndef PerlIO_sprintf 285 | PERL_EXPORT_C int PerlIO_sprintf(char *, int, const char *, ...) 286 | __attribute__format__(__printf__, 3, 4); 287 | #endif 288 | #ifndef PerlIO_vprintf 289 | PERL_EXPORT_C int PerlIO_vprintf(PerlIO *, const char *, va_list); 290 | #endif 291 | #ifndef PerlIO_tell 292 | PERL_EXPORT_C Off_t PerlIO_tell(PerlIO *); 293 | #endif 294 | #ifndef PerlIO_seek 295 | PERL_EXPORT_C int PerlIO_seek(PerlIO *, Off_t, int); 296 | #endif 297 | #ifndef PerlIO_rewind 298 | PERL_EXPORT_C void PerlIO_rewind(PerlIO *); 299 | #endif 300 | #ifndef PerlIO_has_base 301 | PERL_EXPORT_C int PerlIO_has_base(PerlIO *); 302 | #endif 303 | #ifndef PerlIO_has_cntptr 304 | PERL_EXPORT_C int PerlIO_has_cntptr(PerlIO *); 305 | #endif 306 | #ifndef PerlIO_fast_gets 307 | PERL_EXPORT_C int PerlIO_fast_gets(PerlIO *); 308 | #endif 309 | #ifndef PerlIO_canset_cnt 310 | PERL_EXPORT_C int PerlIO_canset_cnt(PerlIO *); 311 | #endif 312 | #ifndef PerlIO_get_ptr 313 | PERL_EXPORT_C STDCHAR *PerlIO_get_ptr(PerlIO *); 314 | #endif 315 | #ifndef PerlIO_get_cnt 316 | PERL_EXPORT_C int PerlIO_get_cnt(PerlIO *); 317 | #endif 318 | #ifndef PerlIO_set_cnt 319 | PERL_EXPORT_C void PerlIO_set_cnt(PerlIO *, int); 320 | #endif 321 | #ifndef PerlIO_set_ptrcnt 322 | PERL_EXPORT_C void PerlIO_set_ptrcnt(PerlIO *, STDCHAR *, int); 323 | #endif 324 | #ifndef PerlIO_get_base 325 | PERL_EXPORT_C STDCHAR *PerlIO_get_base(PerlIO *); 326 | #endif 327 | #ifndef PerlIO_get_bufsiz 328 | PERL_EXPORT_C int PerlIO_get_bufsiz(PerlIO *); 329 | #endif 330 | #ifndef PerlIO_tmpfile 331 | PERL_EXPORT_C PerlIO *PerlIO_tmpfile(void); 332 | #endif 333 | #ifndef PerlIO_stdin 334 | PERL_EXPORT_C PerlIO *PerlIO_stdin(void); 335 | #endif 336 | #ifndef PerlIO_stdout 337 | PERL_EXPORT_C PerlIO *PerlIO_stdout(void); 338 | #endif 339 | #ifndef PerlIO_stderr 340 | PERL_EXPORT_C PerlIO *PerlIO_stderr(void); 341 | #endif 342 | #ifndef PerlIO_getpos 343 | PERL_EXPORT_C int PerlIO_getpos(PerlIO *, SV *); 344 | #endif 345 | #ifndef PerlIO_setpos 346 | PERL_EXPORT_C int PerlIO_setpos(PerlIO *, SV *); 347 | #endif 348 | #ifndef PerlIO_fdupopen 349 | PERL_EXPORT_C PerlIO *PerlIO_fdupopen(pTHX_ PerlIO *, CLONE_PARAMS *, int); 350 | #endif 351 | #if !defined(PerlIO_modestr) && !defined(PERLIO_IS_STDIO) 352 | PERL_EXPORT_C char *PerlIO_modestr(PerlIO *, char *buf); 353 | #endif 354 | #ifndef PerlIO_isutf8 355 | PERL_EXPORT_C int PerlIO_isutf8(PerlIO *); 356 | #endif 357 | #ifndef PerlIO_apply_layers 358 | PERL_EXPORT_C int PerlIO_apply_layers(pTHX_ PerlIO *f, const char *mode, 359 | const char *names); 360 | #endif 361 | #ifndef PerlIO_binmode 362 | PERL_EXPORT_C int PerlIO_binmode(pTHX_ PerlIO *f, int iotype, int omode, 363 | const char *names); 364 | #endif 365 | #ifndef PerlIO_getname 366 | PERL_EXPORT_C char *PerlIO_getname(PerlIO *, char *); 367 | #endif 368 | 369 | PERL_EXPORT_C void PerlIO_destruct(pTHX); 370 | 371 | PERL_EXPORT_C int PerlIO_intmode2str(int rawmode, char *mode, int *writing); 372 | 373 | #ifdef PERLIO_LAYERS 374 | PERL_EXPORT_C void PerlIO_cleanup(pTHX); 375 | 376 | PERL_EXPORT_C void PerlIO_debug(const char *fmt, ...) 377 | __attribute__format__(__printf__, 1, 2); 378 | typedef struct PerlIO_list_s PerlIO_list_t; 379 | 380 | 381 | #endif 382 | 383 | END_EXTERN_C 384 | #endif /* _PERLIO_H */ 385 | 386 | /* 387 | * Local variables: 388 | * c-indentation-style: bsd 389 | * c-basic-offset: 4 390 | * indent-tabs-mode: t 391 | * End: 392 | * 393 | * ex: set ts=8 sts=4 sw=4 noet: 394 | */ 395 | -------------------------------------------------------------------------------- /microperl-5.10.1/pp_proto.h: -------------------------------------------------------------------------------- 1 | /* -*- buffer-read-only: t -*- 2 | !!!!!!! DO NOT EDIT THIS FILE !!!!!!! 3 | This file is built by opcode.pl from its data. Any changes made here 4 | will be lost! 5 | */ 6 | 7 | PERL_CKDEF(Perl_ck_anoncode) 8 | PERL_CKDEF(Perl_ck_bitop) 9 | PERL_CKDEF(Perl_ck_chdir) 10 | PERL_CKDEF(Perl_ck_concat) 11 | PERL_CKDEF(Perl_ck_defined) 12 | PERL_CKDEF(Perl_ck_delete) 13 | PERL_CKDEF(Perl_ck_die) 14 | PERL_CKDEF(Perl_ck_eof) 15 | PERL_CKDEF(Perl_ck_eval) 16 | PERL_CKDEF(Perl_ck_exec) 17 | PERL_CKDEF(Perl_ck_exists) 18 | PERL_CKDEF(Perl_ck_exit) 19 | PERL_CKDEF(Perl_ck_ftst) 20 | PERL_CKDEF(Perl_ck_fun) 21 | PERL_CKDEF(Perl_ck_glob) 22 | PERL_CKDEF(Perl_ck_grep) 23 | PERL_CKDEF(Perl_ck_index) 24 | PERL_CKDEF(Perl_ck_join) 25 | PERL_CKDEF(Perl_ck_lengthconst) 26 | PERL_CKDEF(Perl_ck_lfun) 27 | PERL_CKDEF(Perl_ck_listiob) 28 | PERL_CKDEF(Perl_ck_match) 29 | PERL_CKDEF(Perl_ck_method) 30 | PERL_CKDEF(Perl_ck_null) 31 | PERL_CKDEF(Perl_ck_open) 32 | PERL_CKDEF(Perl_ck_readline) 33 | PERL_CKDEF(Perl_ck_repeat) 34 | PERL_CKDEF(Perl_ck_require) 35 | PERL_CKDEF(Perl_ck_return) 36 | PERL_CKDEF(Perl_ck_rfun) 37 | PERL_CKDEF(Perl_ck_rvconst) 38 | PERL_CKDEF(Perl_ck_sassign) 39 | PERL_CKDEF(Perl_ck_select) 40 | PERL_CKDEF(Perl_ck_shift) 41 | PERL_CKDEF(Perl_ck_smartmatch) 42 | PERL_CKDEF(Perl_ck_sort) 43 | PERL_CKDEF(Perl_ck_spair) 44 | PERL_CKDEF(Perl_ck_split) 45 | PERL_CKDEF(Perl_ck_subr) 46 | PERL_CKDEF(Perl_ck_substr) 47 | PERL_CKDEF(Perl_ck_svconst) 48 | PERL_CKDEF(Perl_ck_trunc) 49 | PERL_CKDEF(Perl_ck_unpack) 50 | 51 | 52 | PERL_PPDEF(Perl_pp_null) 53 | PERL_PPDEF(Perl_pp_stub) 54 | PERL_PPDEF(Perl_pp_scalar) 55 | PERL_PPDEF(Perl_pp_pushmark) 56 | PERL_PPDEF(Perl_pp_wantarray) 57 | PERL_PPDEF(Perl_pp_const) 58 | PERL_PPDEF(Perl_pp_gvsv) 59 | PERL_PPDEF(Perl_pp_gv) 60 | PERL_PPDEF(Perl_pp_gelem) 61 | PERL_PPDEF(Perl_pp_padsv) 62 | PERL_PPDEF(Perl_pp_padav) 63 | PERL_PPDEF(Perl_pp_padhv) 64 | PERL_PPDEF(Perl_pp_padany) 65 | PERL_PPDEF(Perl_pp_pushre) 66 | PERL_PPDEF(Perl_pp_rv2gv) 67 | PERL_PPDEF(Perl_pp_rv2sv) 68 | PERL_PPDEF(Perl_pp_av2arylen) 69 | PERL_PPDEF(Perl_pp_rv2cv) 70 | PERL_PPDEF(Perl_pp_anoncode) 71 | PERL_PPDEF(Perl_pp_prototype) 72 | PERL_PPDEF(Perl_pp_refgen) 73 | PERL_PPDEF(Perl_pp_srefgen) 74 | PERL_PPDEF(Perl_pp_ref) 75 | PERL_PPDEF(Perl_pp_bless) 76 | PERL_PPDEF(Perl_pp_backtick) 77 | PERL_PPDEF(Perl_pp_glob) 78 | PERL_PPDEF(Perl_pp_readline) 79 | PERL_PPDEF(Perl_pp_rcatline) 80 | PERL_PPDEF(Perl_pp_regcmaybe) 81 | PERL_PPDEF(Perl_pp_regcreset) 82 | PERL_PPDEF(Perl_pp_regcomp) 83 | PERL_PPDEF(Perl_pp_match) 84 | PERL_PPDEF(Perl_pp_qr) 85 | PERL_PPDEF(Perl_pp_subst) 86 | PERL_PPDEF(Perl_pp_substcont) 87 | PERL_PPDEF(Perl_pp_trans) 88 | PERL_PPDEF(Perl_pp_sassign) 89 | PERL_PPDEF(Perl_pp_aassign) 90 | PERL_PPDEF(Perl_pp_chop) 91 | PERL_PPDEF(Perl_pp_schop) 92 | PERL_PPDEF(Perl_pp_chomp) 93 | PERL_PPDEF(Perl_pp_schomp) 94 | PERL_PPDEF(Perl_pp_defined) 95 | PERL_PPDEF(Perl_pp_undef) 96 | PERL_PPDEF(Perl_pp_study) 97 | PERL_PPDEF(Perl_pp_pos) 98 | PERL_PPDEF(Perl_pp_preinc) 99 | PERL_PPDEF(Perl_pp_predec) 100 | PERL_PPDEF(Perl_pp_postinc) 101 | PERL_PPDEF(Perl_pp_postdec) 102 | PERL_PPDEF(Perl_pp_pow) 103 | PERL_PPDEF(Perl_pp_multiply) 104 | PERL_PPDEF(Perl_pp_i_multiply) 105 | PERL_PPDEF(Perl_pp_divide) 106 | PERL_PPDEF(Perl_pp_i_divide) 107 | PERL_PPDEF(Perl_pp_modulo) 108 | PERL_PPDEF(Perl_pp_i_modulo) 109 | PERL_PPDEF(Perl_pp_repeat) 110 | PERL_PPDEF(Perl_pp_add) 111 | PERL_PPDEF(Perl_pp_i_add) 112 | PERL_PPDEF(Perl_pp_subtract) 113 | PERL_PPDEF(Perl_pp_i_subtract) 114 | PERL_PPDEF(Perl_pp_concat) 115 | PERL_PPDEF(Perl_pp_stringify) 116 | PERL_PPDEF(Perl_pp_left_shift) 117 | PERL_PPDEF(Perl_pp_right_shift) 118 | PERL_PPDEF(Perl_pp_lt) 119 | PERL_PPDEF(Perl_pp_i_lt) 120 | PERL_PPDEF(Perl_pp_gt) 121 | PERL_PPDEF(Perl_pp_i_gt) 122 | PERL_PPDEF(Perl_pp_le) 123 | PERL_PPDEF(Perl_pp_i_le) 124 | PERL_PPDEF(Perl_pp_ge) 125 | PERL_PPDEF(Perl_pp_i_ge) 126 | PERL_PPDEF(Perl_pp_eq) 127 | PERL_PPDEF(Perl_pp_i_eq) 128 | PERL_PPDEF(Perl_pp_ne) 129 | PERL_PPDEF(Perl_pp_i_ne) 130 | PERL_PPDEF(Perl_pp_ncmp) 131 | PERL_PPDEF(Perl_pp_i_ncmp) 132 | PERL_PPDEF(Perl_pp_slt) 133 | PERL_PPDEF(Perl_pp_sgt) 134 | PERL_PPDEF(Perl_pp_sle) 135 | PERL_PPDEF(Perl_pp_sge) 136 | PERL_PPDEF(Perl_pp_seq) 137 | PERL_PPDEF(Perl_pp_sne) 138 | PERL_PPDEF(Perl_pp_scmp) 139 | PERL_PPDEF(Perl_pp_bit_and) 140 | PERL_PPDEF(Perl_pp_bit_xor) 141 | PERL_PPDEF(Perl_pp_bit_or) 142 | PERL_PPDEF(Perl_pp_negate) 143 | PERL_PPDEF(Perl_pp_i_negate) 144 | PERL_PPDEF(Perl_pp_not) 145 | PERL_PPDEF(Perl_pp_complement) 146 | PERL_PPDEF(Perl_pp_smartmatch) 147 | PERL_PPDEF(Perl_pp_atan2) 148 | PERL_PPDEF(Perl_pp_sin) 149 | PERL_PPDEF(Perl_pp_cos) 150 | PERL_PPDEF(Perl_pp_rand) 151 | PERL_PPDEF(Perl_pp_srand) 152 | PERL_PPDEF(Perl_pp_exp) 153 | PERL_PPDEF(Perl_pp_log) 154 | PERL_PPDEF(Perl_pp_sqrt) 155 | PERL_PPDEF(Perl_pp_int) 156 | PERL_PPDEF(Perl_pp_hex) 157 | PERL_PPDEF(Perl_pp_oct) 158 | PERL_PPDEF(Perl_pp_abs) 159 | PERL_PPDEF(Perl_pp_length) 160 | PERL_PPDEF(Perl_pp_substr) 161 | PERL_PPDEF(Perl_pp_vec) 162 | PERL_PPDEF(Perl_pp_index) 163 | PERL_PPDEF(Perl_pp_rindex) 164 | PERL_PPDEF(Perl_pp_sprintf) 165 | PERL_PPDEF(Perl_pp_formline) 166 | PERL_PPDEF(Perl_pp_ord) 167 | PERL_PPDEF(Perl_pp_chr) 168 | PERL_PPDEF(Perl_pp_crypt) 169 | PERL_PPDEF(Perl_pp_ucfirst) 170 | PERL_PPDEF(Perl_pp_lcfirst) 171 | PERL_PPDEF(Perl_pp_uc) 172 | PERL_PPDEF(Perl_pp_lc) 173 | PERL_PPDEF(Perl_pp_quotemeta) 174 | PERL_PPDEF(Perl_pp_rv2av) 175 | PERL_PPDEF(Perl_pp_aelemfast) 176 | PERL_PPDEF(Perl_pp_aelem) 177 | PERL_PPDEF(Perl_pp_aslice) 178 | PERL_PPDEF(Perl_pp_each) 179 | PERL_PPDEF(Perl_pp_values) 180 | PERL_PPDEF(Perl_pp_keys) 181 | PERL_PPDEF(Perl_pp_delete) 182 | PERL_PPDEF(Perl_pp_exists) 183 | PERL_PPDEF(Perl_pp_rv2hv) 184 | PERL_PPDEF(Perl_pp_helem) 185 | PERL_PPDEF(Perl_pp_hslice) 186 | PERL_PPDEF(Perl_pp_unpack) 187 | PERL_PPDEF(Perl_pp_pack) 188 | PERL_PPDEF(Perl_pp_split) 189 | PERL_PPDEF(Perl_pp_join) 190 | PERL_PPDEF(Perl_pp_list) 191 | PERL_PPDEF(Perl_pp_lslice) 192 | PERL_PPDEF(Perl_pp_anonlist) 193 | PERL_PPDEF(Perl_pp_anonhash) 194 | PERL_PPDEF(Perl_pp_splice) 195 | PERL_PPDEF(Perl_pp_push) 196 | PERL_PPDEF(Perl_pp_pop) 197 | PERL_PPDEF(Perl_pp_shift) 198 | PERL_PPDEF(Perl_pp_unshift) 199 | PERL_PPDEF(Perl_pp_sort) 200 | PERL_PPDEF(Perl_pp_reverse) 201 | PERL_PPDEF(Perl_pp_grepstart) 202 | PERL_PPDEF(Perl_pp_grepwhile) 203 | PERL_PPDEF(Perl_pp_mapstart) 204 | PERL_PPDEF(Perl_pp_mapwhile) 205 | PERL_PPDEF(Perl_pp_range) 206 | PERL_PPDEF(Perl_pp_flip) 207 | PERL_PPDEF(Perl_pp_flop) 208 | PERL_PPDEF(Perl_pp_and) 209 | PERL_PPDEF(Perl_pp_or) 210 | PERL_PPDEF(Perl_pp_xor) 211 | PERL_PPDEF(Perl_pp_dor) 212 | PERL_PPDEF(Perl_pp_cond_expr) 213 | PERL_PPDEF(Perl_pp_andassign) 214 | PERL_PPDEF(Perl_pp_orassign) 215 | PERL_PPDEF(Perl_pp_dorassign) 216 | PERL_PPDEF(Perl_pp_method) 217 | PERL_PPDEF(Perl_pp_entersub) 218 | PERL_PPDEF(Perl_pp_leavesub) 219 | PERL_PPDEF(Perl_pp_leavesublv) 220 | PERL_PPDEF(Perl_pp_caller) 221 | PERL_PPDEF(Perl_pp_warn) 222 | PERL_PPDEF(Perl_pp_die) 223 | PERL_PPDEF(Perl_pp_reset) 224 | PERL_PPDEF(Perl_pp_lineseq) 225 | PERL_PPDEF(Perl_pp_nextstate) 226 | PERL_PPDEF(Perl_pp_dbstate) 227 | PERL_PPDEF(Perl_pp_unstack) 228 | PERL_PPDEF(Perl_pp_enter) 229 | PERL_PPDEF(Perl_pp_leave) 230 | PERL_PPDEF(Perl_pp_scope) 231 | PERL_PPDEF(Perl_pp_enteriter) 232 | PERL_PPDEF(Perl_pp_iter) 233 | PERL_PPDEF(Perl_pp_enterloop) 234 | PERL_PPDEF(Perl_pp_leaveloop) 235 | PERL_PPDEF(Perl_pp_return) 236 | PERL_PPDEF(Perl_pp_last) 237 | PERL_PPDEF(Perl_pp_next) 238 | PERL_PPDEF(Perl_pp_redo) 239 | PERL_PPDEF(Perl_pp_dump) 240 | PERL_PPDEF(Perl_pp_goto) 241 | PERL_PPDEF(Perl_pp_exit) 242 | PERL_PPDEF(Perl_pp_setstate) 243 | PERL_PPDEF(Perl_pp_method_named) 244 | PERL_PPDEF(Perl_pp_entergiven) 245 | PERL_PPDEF(Perl_pp_leavegiven) 246 | PERL_PPDEF(Perl_pp_enterwhen) 247 | PERL_PPDEF(Perl_pp_leavewhen) 248 | PERL_PPDEF(Perl_pp_break) 249 | PERL_PPDEF(Perl_pp_continue) 250 | PERL_PPDEF(Perl_pp_open) 251 | PERL_PPDEF(Perl_pp_close) 252 | PERL_PPDEF(Perl_pp_pipe_op) 253 | PERL_PPDEF(Perl_pp_fileno) 254 | PERL_PPDEF(Perl_pp_umask) 255 | PERL_PPDEF(Perl_pp_binmode) 256 | PERL_PPDEF(Perl_pp_tie) 257 | PERL_PPDEF(Perl_pp_untie) 258 | PERL_PPDEF(Perl_pp_tied) 259 | PERL_PPDEF(Perl_pp_dbmopen) 260 | PERL_PPDEF(Perl_pp_dbmclose) 261 | PERL_PPDEF(Perl_pp_sselect) 262 | PERL_PPDEF(Perl_pp_select) 263 | PERL_PPDEF(Perl_pp_getc) 264 | PERL_PPDEF(Perl_pp_read) 265 | PERL_PPDEF(Perl_pp_enterwrite) 266 | PERL_PPDEF(Perl_pp_leavewrite) 267 | PERL_PPDEF(Perl_pp_prtf) 268 | PERL_PPDEF(Perl_pp_print) 269 | PERL_PPDEF(Perl_pp_say) 270 | PERL_PPDEF(Perl_pp_sysopen) 271 | PERL_PPDEF(Perl_pp_sysseek) 272 | PERL_PPDEF(Perl_pp_sysread) 273 | PERL_PPDEF(Perl_pp_syswrite) 274 | PERL_PPDEF(Perl_pp_send) 275 | PERL_PPDEF(Perl_pp_recv) 276 | PERL_PPDEF(Perl_pp_eof) 277 | PERL_PPDEF(Perl_pp_tell) 278 | PERL_PPDEF(Perl_pp_seek) 279 | PERL_PPDEF(Perl_pp_truncate) 280 | PERL_PPDEF(Perl_pp_fcntl) 281 | PERL_PPDEF(Perl_pp_ioctl) 282 | PERL_PPDEF(Perl_pp_flock) 283 | PERL_PPDEF(Perl_pp_socket) 284 | PERL_PPDEF(Perl_pp_sockpair) 285 | PERL_PPDEF(Perl_pp_bind) 286 | PERL_PPDEF(Perl_pp_connect) 287 | PERL_PPDEF(Perl_pp_listen) 288 | PERL_PPDEF(Perl_pp_accept) 289 | PERL_PPDEF(Perl_pp_shutdown) 290 | PERL_PPDEF(Perl_pp_gsockopt) 291 | PERL_PPDEF(Perl_pp_ssockopt) 292 | PERL_PPDEF(Perl_pp_getsockname) 293 | PERL_PPDEF(Perl_pp_getpeername) 294 | PERL_PPDEF(Perl_pp_lstat) 295 | PERL_PPDEF(Perl_pp_stat) 296 | PERL_PPDEF(Perl_pp_ftrread) 297 | PERL_PPDEF(Perl_pp_ftrwrite) 298 | PERL_PPDEF(Perl_pp_ftrexec) 299 | PERL_PPDEF(Perl_pp_fteread) 300 | PERL_PPDEF(Perl_pp_ftewrite) 301 | PERL_PPDEF(Perl_pp_fteexec) 302 | PERL_PPDEF(Perl_pp_ftis) 303 | PERL_PPDEF(Perl_pp_ftsize) 304 | PERL_PPDEF(Perl_pp_ftmtime) 305 | PERL_PPDEF(Perl_pp_ftatime) 306 | PERL_PPDEF(Perl_pp_ftctime) 307 | PERL_PPDEF(Perl_pp_ftrowned) 308 | PERL_PPDEF(Perl_pp_fteowned) 309 | PERL_PPDEF(Perl_pp_ftzero) 310 | PERL_PPDEF(Perl_pp_ftsock) 311 | PERL_PPDEF(Perl_pp_ftchr) 312 | PERL_PPDEF(Perl_pp_ftblk) 313 | PERL_PPDEF(Perl_pp_ftfile) 314 | PERL_PPDEF(Perl_pp_ftdir) 315 | PERL_PPDEF(Perl_pp_ftpipe) 316 | PERL_PPDEF(Perl_pp_ftsuid) 317 | PERL_PPDEF(Perl_pp_ftsgid) 318 | PERL_PPDEF(Perl_pp_ftsvtx) 319 | PERL_PPDEF(Perl_pp_ftlink) 320 | PERL_PPDEF(Perl_pp_fttty) 321 | PERL_PPDEF(Perl_pp_fttext) 322 | PERL_PPDEF(Perl_pp_ftbinary) 323 | PERL_PPDEF(Perl_pp_chdir) 324 | PERL_PPDEF(Perl_pp_chown) 325 | PERL_PPDEF(Perl_pp_chroot) 326 | PERL_PPDEF(Perl_pp_unlink) 327 | PERL_PPDEF(Perl_pp_chmod) 328 | PERL_PPDEF(Perl_pp_utime) 329 | PERL_PPDEF(Perl_pp_rename) 330 | PERL_PPDEF(Perl_pp_link) 331 | PERL_PPDEF(Perl_pp_symlink) 332 | PERL_PPDEF(Perl_pp_readlink) 333 | PERL_PPDEF(Perl_pp_mkdir) 334 | PERL_PPDEF(Perl_pp_rmdir) 335 | PERL_PPDEF(Perl_pp_open_dir) 336 | PERL_PPDEF(Perl_pp_readdir) 337 | PERL_PPDEF(Perl_pp_telldir) 338 | PERL_PPDEF(Perl_pp_seekdir) 339 | PERL_PPDEF(Perl_pp_rewinddir) 340 | PERL_PPDEF(Perl_pp_closedir) 341 | PERL_PPDEF(Perl_pp_fork) 342 | PERL_PPDEF(Perl_pp_wait) 343 | PERL_PPDEF(Perl_pp_waitpid) 344 | PERL_PPDEF(Perl_pp_system) 345 | PERL_PPDEF(Perl_pp_exec) 346 | PERL_PPDEF(Perl_pp_kill) 347 | PERL_PPDEF(Perl_pp_getppid) 348 | PERL_PPDEF(Perl_pp_getpgrp) 349 | PERL_PPDEF(Perl_pp_setpgrp) 350 | PERL_PPDEF(Perl_pp_getpriority) 351 | PERL_PPDEF(Perl_pp_setpriority) 352 | PERL_PPDEF(Perl_pp_time) 353 | PERL_PPDEF(Perl_pp_tms) 354 | PERL_PPDEF(Perl_pp_localtime) 355 | PERL_PPDEF(Perl_pp_gmtime) 356 | PERL_PPDEF(Perl_pp_alarm) 357 | PERL_PPDEF(Perl_pp_sleep) 358 | PERL_PPDEF(Perl_pp_shmget) 359 | PERL_PPDEF(Perl_pp_shmctl) 360 | PERL_PPDEF(Perl_pp_shmread) 361 | PERL_PPDEF(Perl_pp_shmwrite) 362 | PERL_PPDEF(Perl_pp_msgget) 363 | PERL_PPDEF(Perl_pp_msgctl) 364 | PERL_PPDEF(Perl_pp_msgsnd) 365 | PERL_PPDEF(Perl_pp_msgrcv) 366 | PERL_PPDEF(Perl_pp_semop) 367 | PERL_PPDEF(Perl_pp_semget) 368 | PERL_PPDEF(Perl_pp_semctl) 369 | PERL_PPDEF(Perl_pp_require) 370 | PERL_PPDEF(Perl_pp_dofile) 371 | PERL_PPDEF(Perl_pp_entereval) 372 | PERL_PPDEF(Perl_pp_leaveeval) 373 | PERL_PPDEF(Perl_pp_entertry) 374 | PERL_PPDEF(Perl_pp_leavetry) 375 | PERL_PPDEF(Perl_pp_ghbyname) 376 | PERL_PPDEF(Perl_pp_ghbyaddr) 377 | PERL_PPDEF(Perl_pp_ghostent) 378 | PERL_PPDEF(Perl_pp_gnbyname) 379 | PERL_PPDEF(Perl_pp_gnbyaddr) 380 | PERL_PPDEF(Perl_pp_gnetent) 381 | PERL_PPDEF(Perl_pp_gpbyname) 382 | PERL_PPDEF(Perl_pp_gpbynumber) 383 | PERL_PPDEF(Perl_pp_gprotoent) 384 | PERL_PPDEF(Perl_pp_gsbyname) 385 | PERL_PPDEF(Perl_pp_gsbyport) 386 | PERL_PPDEF(Perl_pp_gservent) 387 | PERL_PPDEF(Perl_pp_shostent) 388 | PERL_PPDEF(Perl_pp_snetent) 389 | PERL_PPDEF(Perl_pp_sprotoent) 390 | PERL_PPDEF(Perl_pp_sservent) 391 | PERL_PPDEF(Perl_pp_ehostent) 392 | PERL_PPDEF(Perl_pp_enetent) 393 | PERL_PPDEF(Perl_pp_eprotoent) 394 | PERL_PPDEF(Perl_pp_eservent) 395 | PERL_PPDEF(Perl_pp_gpwnam) 396 | PERL_PPDEF(Perl_pp_gpwuid) 397 | PERL_PPDEF(Perl_pp_gpwent) 398 | PERL_PPDEF(Perl_pp_spwent) 399 | PERL_PPDEF(Perl_pp_epwent) 400 | PERL_PPDEF(Perl_pp_ggrnam) 401 | PERL_PPDEF(Perl_pp_ggrgid) 402 | PERL_PPDEF(Perl_pp_ggrent) 403 | PERL_PPDEF(Perl_pp_sgrent) 404 | PERL_PPDEF(Perl_pp_egrent) 405 | PERL_PPDEF(Perl_pp_getlogin) 406 | PERL_PPDEF(Perl_pp_syscall) 407 | PERL_PPDEF(Perl_pp_lock) 408 | PERL_PPDEF(Perl_pp_once) 409 | 410 | /* ex: set ro: */ 411 | -------------------------------------------------------------------------------- /microperl-5.10.1/pad.h: -------------------------------------------------------------------------------- 1 | /* pad.h 2 | * 3 | * Copyright (C) 2002, 2003, 2005, 2006, 2007, 2008 by Larry Wall and others 4 | * 5 | * You may distribute under the terms of either the GNU General Public 6 | * License or the Artistic License, as specified in the README file. 7 | * 8 | * This file defines the types and macros associated with the API for 9 | * manipulating scratchpads, which are used by perl to store lexical 10 | * variables, op targets and constants. 11 | */ 12 | 13 | 14 | 15 | 16 | /* a padlist is currently just an AV; but that might change, 17 | * so hide the type. Ditto a pad. */ 18 | 19 | typedef AV PADLIST; 20 | typedef AV PAD; 21 | 22 | 23 | /* offsets within a pad */ 24 | 25 | #if PTRSIZE == 4 26 | typedef U32TYPE PADOFFSET; 27 | #else 28 | # if PTRSIZE == 8 29 | typedef U64TYPE PADOFFSET; 30 | # endif 31 | #endif 32 | #define NOT_IN_PAD ((PADOFFSET) -1) 33 | 34 | /* B.xs needs these for the benefit of B::Deparse */ 35 | /* Low range end is exclusive (valid from the cop seq after this one) */ 36 | /* High range end is inclusive (valid up to this cop seq) */ 37 | 38 | #if defined (DEBUGGING) && defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) 39 | # define COP_SEQ_RANGE_LOW(sv) \ 40 | (({ const SV *const _sv_cop_seq_range_low = (const SV *) (sv); \ 41 | assert(SvTYPE(_sv_cop_seq_range_low) == SVt_NV \ 42 | || SvTYPE(_sv_cop_seq_range_low) >= SVt_PVNV); \ 43 | assert(SvTYPE(_sv_cop_seq_range_low) != SVt_PVAV); \ 44 | assert(SvTYPE(_sv_cop_seq_range_low) != SVt_PVHV); \ 45 | assert(SvTYPE(_sv_cop_seq_range_low) != SVt_PVCV); \ 46 | assert(SvTYPE(_sv_cop_seq_range_low) != SVt_PVFM); \ 47 | assert(!isGV_with_GP(_sv_cop_seq_range_low)); \ 48 | ((XPVNV*) MUTABLE_PTR(SvANY(_sv_cop_seq_range_low)))->xnv_u.xpad_cop_seq.xlow; \ 49 | })) 50 | # define COP_SEQ_RANGE_HIGH(sv) \ 51 | (({ const SV *const _sv_cop_seq_range_high = (const SV *) (sv); \ 52 | assert(SvTYPE(_sv_cop_seq_range_high) == SVt_NV \ 53 | || SvTYPE(_sv_cop_seq_range_high) >= SVt_PVNV); \ 54 | assert(SvTYPE(_sv_cop_seq_range_high) != SVt_PVAV); \ 55 | assert(SvTYPE(_sv_cop_seq_range_high) != SVt_PVHV); \ 56 | assert(SvTYPE(_sv_cop_seq_range_high) != SVt_PVCV); \ 57 | assert(SvTYPE(_sv_cop_seq_range_high) != SVt_PVFM); \ 58 | assert(!isGV_with_GP(_sv_cop_seq_range_high)); \ 59 | ((XPVNV*) MUTABLE_PTR(SvANY(_sv_cop_seq_range_high)))->xnv_u.xpad_cop_seq.xhigh; \ 60 | })) 61 | # define PARENT_PAD_INDEX(sv) \ 62 | (({ const SV *const _sv_parent_pad_index = (const SV *) (sv); \ 63 | assert(SvTYPE(_sv_parent_pad_index) == SVt_NV \ 64 | || SvTYPE(_sv_parent_pad_index) >= SVt_PVNV); \ 65 | assert(SvTYPE(_sv_parent_pad_index) != SVt_PVAV); \ 66 | assert(SvTYPE(_sv_parent_pad_index) != SVt_PVHV); \ 67 | assert(SvTYPE(_sv_parent_pad_index) != SVt_PVCV); \ 68 | assert(SvTYPE(_sv_parent_pad_index) != SVt_PVFM); \ 69 | assert(!isGV_with_GP(_sv_parent_pad_index)); \ 70 | ((XPVNV*) MUTABLE_PTR(SvANY(_sv_parent_pad_index)))->xnv_u.xpad_cop_seq.xlow; \ 71 | })) 72 | # define PARENT_FAKELEX_FLAGS(sv) \ 73 | (({ const SV *const _sv_parent_fakelex_flags = (const SV *) (sv); \ 74 | assert(SvTYPE(_sv_parent_fakelex_flags) == SVt_NV \ 75 | || SvTYPE(_sv_parent_fakelex_flags) >= SVt_PVNV); \ 76 | assert(SvTYPE(_sv_parent_fakelex_flags) != SVt_PVAV); \ 77 | assert(SvTYPE(_sv_parent_fakelex_flags) != SVt_PVHV); \ 78 | assert(SvTYPE(_sv_parent_fakelex_flags) != SVt_PVCV); \ 79 | assert(SvTYPE(_sv_parent_fakelex_flags) != SVt_PVFM); \ 80 | assert(!isGV_with_GP(_sv_parent_fakelex_flags)); \ 81 | ((XPVNV*) MUTABLE_PTR(SvANY(_sv_parent_fakelex_flags)))->xnv_u.xpad_cop_seq.xhigh; \ 82 | })) 83 | #else 84 | # define COP_SEQ_RANGE_LOW(sv) \ 85 | (0 + (((XPVNV*) SvANY(sv))->xnv_u.xpad_cop_seq.xlow)) 86 | # define COP_SEQ_RANGE_HIGH(sv) \ 87 | (0 + (((XPVNV*) SvANY(sv))->xnv_u.xpad_cop_seq.xhigh)) 88 | 89 | 90 | # define PARENT_PAD_INDEX(sv) \ 91 | (0 + (((XPVNV*) SvANY(sv))->xnv_u.xpad_cop_seq.xlow)) 92 | # define PARENT_FAKELEX_FLAGS(sv) \ 93 | (0 + (((XPVNV*) SvANY(sv))->xnv_u.xpad_cop_seq.xhigh)) 94 | #endif 95 | 96 | /* Flags set in the SvIVX field of FAKE namesvs */ 97 | 98 | #define PAD_FAKELEX_ANON 1 /* the lex is declared in an ANON, or ... */ 99 | #define PAD_FAKELEX_MULTI 2 /* the lex can be instantiated multiple times */ 100 | 101 | /* flags for the pad_new() function */ 102 | 103 | #define padnew_CLONE 1 /* this pad is for a cloned CV */ 104 | #define padnew_SAVE 2 /* save old globals */ 105 | #define padnew_SAVESUB 4 /* also save extra stuff for start of sub */ 106 | 107 | /* values for the pad_tidy() function */ 108 | 109 | typedef enum { 110 | padtidy_SUB, /* tidy up a pad for a sub, */ 111 | padtidy_SUBCLONE, /* a cloned sub, */ 112 | padtidy_FORMAT /* or a format */ 113 | } padtidy_type; 114 | 115 | /* ASSERT_CURPAD_LEGAL and ASSERT_CURPAD_ACTIVE respectively determine 116 | * whether PL_comppad and PL_curpad are consistent and whether they have 117 | * active values */ 118 | 119 | #ifndef PERL_MAD 120 | # define pad_peg(label) 121 | #endif 122 | 123 | #ifdef DEBUGGING 124 | # define ASSERT_CURPAD_LEGAL(label) \ 125 | pad_peg(label); \ 126 | if (PL_comppad ? (AvARRAY(PL_comppad) != PL_curpad) : (PL_curpad != 0)) \ 127 | Perl_croak(aTHX_ "panic: illegal pad in %s: 0x%"UVxf"[0x%"UVxf"]",\ 128 | label, PTR2UV(PL_comppad), PTR2UV(PL_curpad)); 129 | 130 | 131 | # define ASSERT_CURPAD_ACTIVE(label) \ 132 | pad_peg(label); \ 133 | if (!PL_comppad || (AvARRAY(PL_comppad) != PL_curpad)) \ 134 | Perl_croak(aTHX_ "panic: invalid pad in %s: 0x%"UVxf"[0x%"UVxf"]",\ 135 | label, PTR2UV(PL_comppad), PTR2UV(PL_curpad)); 136 | #else 137 | # define ASSERT_CURPAD_LEGAL(label) 138 | # define ASSERT_CURPAD_ACTIVE(label) 139 | #endif 140 | 141 | 142 | 143 | /* Note: the following three macros are actually defined in scope.h, but 144 | * they are documented here for completeness, since they directly or 145 | * indirectly affect pads. 146 | 147 | =for apidoc m|void|SAVEPADSV |PADOFFSET po 148 | Save a pad slot (used to restore after an iteration) 149 | 150 | XXX DAPM it would make more sense to make the arg a PADOFFSET 151 | =for apidoc m|void|SAVECLEARSV |SV **svp 152 | Clear the pointed to pad value on scope exit. (i.e. the runtime action of 'my') 153 | 154 | =for apidoc m|void|SAVECOMPPAD 155 | save PL_comppad and PL_curpad 156 | 157 | 158 | 159 | 160 | 161 | =for apidoc m|SV *|PAD_SETSV |PADOFFSET po|SV* sv 162 | Set the slot at offset C in the current pad to C 163 | 164 | =for apidoc m|void|PAD_SV |PADOFFSET po 165 | Get the value at offset C in the current pad 166 | 167 | =for apidoc m|SV *|PAD_SVl |PADOFFSET po 168 | Lightweight and lvalue version of C. 169 | Get or set the value at offset C in the current pad. 170 | Unlike C, does not print diagnostics with -DX. 171 | For internal use only. 172 | 173 | =for apidoc m|SV *|PAD_BASE_SV |PADLIST padlist|PADOFFSET po 174 | Get the value from slot C in the base (DEPTH=1) pad of a padlist 175 | 176 | =for apidoc m|void|PAD_SET_CUR |PADLIST padlist|I32 n 177 | Set the current pad to be pad C in the padlist, saving 178 | the previous current pad. NB currently this macro expands to a string too 179 | long for some compilers, so it's best to replace it with 180 | 181 | SAVECOMPPAD(); 182 | PAD_SET_CUR_NOSAVE(padlist,n); 183 | 184 | 185 | =for apidoc m|void|PAD_SET_CUR_NOSAVE |PADLIST padlist|I32 n 186 | like PAD_SET_CUR, but without the save 187 | 188 | =for apidoc m|void|PAD_SAVE_SETNULLPAD 189 | Save the current pad then set it to null. 190 | 191 | =for apidoc m|void|PAD_SAVE_LOCAL|PAD *opad|PAD *npad 192 | Save the current pad to the local variable opad, then make the 193 | current pad equal to npad 194 | 195 | =for apidoc m|void|PAD_RESTORE_LOCAL|PAD *opad 196 | Restore the old pad saved into the local variable opad by PAD_SAVE_LOCAL() 197 | 198 | =cut 199 | */ 200 | 201 | #ifdef DEBUGGING 202 | # define PAD_SV(po) pad_sv(po) 203 | # define PAD_SETSV(po,sv) pad_setsv(po,sv) 204 | #else 205 | # define PAD_SV(po) (PL_curpad[po]) 206 | # define PAD_SETSV(po,sv) PL_curpad[po] = (sv) 207 | #endif 208 | 209 | #define PAD_SVl(po) (PL_curpad[po]) 210 | 211 | #define PAD_BASE_SV(padlist, po) \ 212 | (AvARRAY(padlist)[1]) \ 213 | ? AvARRAY(MUTABLE_AV((AvARRAY(padlist)[1])))[po] : NULL; 214 | 215 | 216 | #define PAD_SET_CUR_NOSAVE(padlist,nth) \ 217 | PL_comppad = (PAD*) (AvARRAY(padlist)[nth]); \ 218 | PL_curpad = AvARRAY(PL_comppad); \ 219 | DEBUG_Xv(PerlIO_printf(Perl_debug_log, \ 220 | "Pad 0x%"UVxf"[0x%"UVxf"] set_cur depth=%d\n", \ 221 | PTR2UV(PL_comppad), PTR2UV(PL_curpad), (int)(nth))); 222 | 223 | 224 | #define PAD_SET_CUR(padlist,nth) \ 225 | SAVECOMPPAD(); \ 226 | PAD_SET_CUR_NOSAVE(padlist,nth); 227 | 228 | 229 | #define PAD_SAVE_SETNULLPAD() SAVECOMPPAD(); \ 230 | PL_comppad = NULL; PL_curpad = NULL; \ 231 | DEBUG_Xv(PerlIO_printf(Perl_debug_log, "Pad set_null\n")); 232 | 233 | #define PAD_SAVE_LOCAL(opad,npad) \ 234 | opad = PL_comppad; \ 235 | PL_comppad = (npad); \ 236 | PL_curpad = PL_comppad ? AvARRAY(PL_comppad) : NULL; \ 237 | DEBUG_Xv(PerlIO_printf(Perl_debug_log, \ 238 | "Pad 0x%"UVxf"[0x%"UVxf"] save_local\n", \ 239 | PTR2UV(PL_comppad), PTR2UV(PL_curpad))); 240 | 241 | #define PAD_RESTORE_LOCAL(opad) \ 242 | PL_comppad = opad && SvIS_FREED(opad) ? NULL : opad; \ 243 | PL_curpad = PL_comppad ? AvARRAY(PL_comppad) : NULL; \ 244 | DEBUG_Xv(PerlIO_printf(Perl_debug_log, \ 245 | "Pad 0x%"UVxf"[0x%"UVxf"] restore_local\n", \ 246 | PTR2UV(PL_comppad), PTR2UV(PL_curpad))); 247 | 248 | 249 | /* 250 | =for apidoc m|void|CX_CURPAD_SAVE|struct context 251 | Save the current pad in the given context block structure. 252 | 253 | =for apidoc m|SV *|CX_CURPAD_SV|struct context|PADOFFSET po 254 | Access the SV at offset po in the saved current pad in the given 255 | context block structure (can be used as an lvalue). 256 | 257 | =cut 258 | */ 259 | 260 | #define CX_CURPAD_SAVE(block) (block).oldcomppad = PL_comppad 261 | #define CX_CURPAD_SV(block,po) (AvARRAY(MUTABLE_AV(((block).oldcomppad)))[po]) 262 | 263 | 264 | /* 265 | =for apidoc m|U32|PAD_COMPNAME_FLAGS|PADOFFSET po 266 | Return the flags for the current compiling pad name 267 | at offset C. Assumes a valid slot entry. 268 | 269 | =for apidoc m|char *|PAD_COMPNAME_PV|PADOFFSET po 270 | Return the name of the current compiling pad name 271 | at offset C. Assumes a valid slot entry. 272 | 273 | =for apidoc m|HV *|PAD_COMPNAME_TYPE|PADOFFSET po 274 | Return the type (stash) of the current compiling pad name at offset 275 | C. Must be a valid name. Returns null if not typed. 276 | 277 | =for apidoc m|HV *|PAD_COMPNAME_OURSTASH|PADOFFSET po 278 | Return the stash associated with an C variable. 279 | Assumes the slot entry is a valid C lexical. 280 | 281 | =for apidoc m|STRLEN|PAD_COMPNAME_GEN|PADOFFSET po 282 | The generation number of the name at offset C in the current 283 | compiling pad (lvalue). Note that C is hijacked for this purpose. 284 | 285 | =for apidoc m|STRLEN|PAD_COMPNAME_GEN_set|PADOFFSET po|int gen 286 | Sets the generation number of the name at offset C in the current 287 | ling pad (lvalue) to C. Note that C is hijacked for this purpose. 288 | 289 | =cut 290 | 291 | */ 292 | 293 | #define PAD_COMPNAME_SV(po) (*av_fetch(PL_comppad_name, (po), FALSE)) 294 | #define PAD_COMPNAME_FLAGS(po) SvFLAGS(PAD_COMPNAME_SV(po)) 295 | #define PAD_COMPNAME_FLAGS_isOUR(po) \ 296 | ((PAD_COMPNAME_FLAGS(po) & (SVpad_NAME|SVpad_OUR)) == (SVpad_NAME|SVpad_OUR)) 297 | #define PAD_COMPNAME_PV(po) SvPV_nolen(PAD_COMPNAME_SV(po)) 298 | 299 | #define PAD_COMPNAME_TYPE(po) pad_compname_type(po) 300 | 301 | #define PAD_COMPNAME_OURSTASH(po) \ 302 | (SvOURSTASH(PAD_COMPNAME_SV(po))) 303 | 304 | #define PAD_COMPNAME_GEN(po) ((STRLEN)SvUVX(AvARRAY(PL_comppad_name)[po])) 305 | 306 | #define PAD_COMPNAME_GEN_set(po, gen) SvUV_set(AvARRAY(PL_comppad_name)[po], (UV)(gen)) 307 | 308 | 309 | /* 310 | =for apidoc m|void|PAD_DUP|PADLIST dstpad|PADLIST srcpad|CLONE_PARAMS* param 311 | Clone a padlist. 312 | 313 | =for apidoc m|void|PAD_CLONE_VARS|PerlInterpreter *proto_perl|CLONE_PARAMS* param 314 | Clone the state variables associated with running and compiling pads. 315 | 316 | =cut 317 | */ 318 | 319 | 320 | #define PAD_DUP(dstpad, srcpad, param) \ 321 | if ((srcpad) && !AvREAL(srcpad)) { \ 322 | /* XXX padlists are real, but pretend to be not */ \ 323 | AvREAL_on(srcpad); \ 324 | (dstpad) = av_dup_inc((srcpad), param); \ 325 | AvREAL_off(srcpad); \ 326 | AvREAL_off(dstpad); \ 327 | } \ 328 | else \ 329 | (dstpad) = av_dup_inc((srcpad), param); 330 | 331 | /* NB - we set PL_comppad to null unless it points at a value that 332 | * has already been dup'ed, ie it points to part of an active padlist. 333 | * Otherwise PL_comppad ends up being a leaked scalar in code like 334 | * the following: 335 | * threads->create(sub { threads->create(sub {...} ) } ); 336 | * where the second thread dups the outer sub's comppad but not the 337 | * sub's CV or padlist. */ 338 | 339 | #define PAD_CLONE_VARS(proto_perl, param) \ 340 | PL_comppad = MUTABLE_AV(ptr_table_fetch(PL_ptr_table, proto_perl->Icomppad)); \ 341 | PL_curpad = PL_comppad ? AvARRAY(PL_comppad) : NULL; \ 342 | PL_comppad_name = av_dup(proto_perl->Icomppad_name, param); \ 343 | PL_comppad_name_fill = proto_perl->Icomppad_name_fill; \ 344 | PL_comppad_name_floor = proto_perl->Icomppad_name_floor; \ 345 | PL_min_intro_pending = proto_perl->Imin_intro_pending; \ 346 | PL_max_intro_pending = proto_perl->Imax_intro_pending; \ 347 | PL_padix = proto_perl->Ipadix; \ 348 | PL_padix_floor = proto_perl->Ipadix_floor; \ 349 | PL_pad_reset_pending = proto_perl->Ipad_reset_pending; \ 350 | PL_cop_seqmax = proto_perl->Icop_seqmax; 351 | 352 | /* 353 | * Local variables: 354 | * c-indentation-style: bsd 355 | * c-basic-offset: 4 356 | * indent-tabs-mode: t 357 | * End: 358 | * 359 | * ex: set ts=8 sts=4 sw=4 noet: 360 | */ 361 | -------------------------------------------------------------------------------- /microperl-5.10.1/utf8.h: -------------------------------------------------------------------------------- 1 | /* utf8.h 2 | * 3 | * Copyright (C) 2000, 2001, 2002, 2005, 2006, 2007, 2009 by Larry Wall and others 4 | * 5 | * You may distribute under the terms of either the GNU General Public 6 | * License or the Artistic License, as specified in the README file. 7 | * 8 | */ 9 | 10 | /* Use UTF-8 as the default script encoding? 11 | * Turning this on will break scripts having non-UTF-8 binary 12 | * data (such as Latin-1) in string literals. */ 13 | #ifdef USE_UTF8_SCRIPTS 14 | # define USE_UTF8_IN_NAMES (!IN_BYTES) 15 | #else 16 | # define USE_UTF8_IN_NAMES (PL_hints & HINT_UTF8) 17 | #endif 18 | 19 | /* Source backward compatibility. */ 20 | #define uvuni_to_utf8(d, uv) uvuni_to_utf8_flags(d, uv, 0) 21 | #define is_utf8_string_loc(s, len, ep) is_utf8_string_loclen(s, len, ep, 0) 22 | 23 | #ifdef EBCDIC 24 | /* The equivalent of these macros but implementing UTF-EBCDIC 25 | are in the following header file: 26 | */ 27 | 28 | #include "utfebcdic.h" 29 | 30 | #else 31 | START_EXTERN_C 32 | 33 | #ifdef DOINIT 34 | EXTCONST unsigned char PL_utf8skip[] = { 35 | 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, /* ascii */ 36 | 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, /* ascii */ 37 | 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, /* ascii */ 38 | 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, /* ascii */ 39 | 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, /* bogus */ 40 | 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, /* bogus */ 41 | 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2, /* scripts */ 42 | 3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,4,4,4,4,4,4,4,4,5,5,5,5,6,6, /* cjk etc. */ 43 | 7,13, /* Perl extended (not UTF-8). Up to 72bit allowed (64-bit + reserved). */ 44 | }; 45 | #else 46 | EXTCONST unsigned char PL_utf8skip[]; 47 | #endif 48 | 49 | END_EXTERN_C 50 | #define UTF8SKIP(s) PL_utf8skip[*(const U8*)(s)] 51 | 52 | /* Native character to iso-8859-1 */ 53 | #define NATIVE_TO_ASCII(ch) (ch) 54 | #define ASCII_TO_NATIVE(ch) (ch) 55 | /* Transform after encoding */ 56 | #define NATIVE_TO_UTF(ch) (ch) 57 | #define UTF_TO_NATIVE(ch) (ch) 58 | /* Transforms in wide UV chars */ 59 | #define UNI_TO_NATIVE(ch) (ch) 60 | #define NATIVE_TO_UNI(ch) (ch) 61 | /* Transforms in invariant space */ 62 | #define NATIVE_TO_NEED(enc,ch) (ch) 63 | #define ASCII_TO_NEED(enc,ch) (ch) 64 | 65 | /* As there are no translations avoid the function wrapper */ 66 | #define utf8n_to_uvchr utf8n_to_uvuni 67 | #define uvchr_to_utf8 uvuni_to_utf8 68 | 69 | /* 70 | 71 | The following table is from Unicode 3.2. 72 | 73 | Code Points 1st Byte 2nd Byte 3rd Byte 4th Byte 74 | 75 | U+0000..U+007F 00..7F 76 | U+0080..U+07FF C2..DF 80..BF 77 | U+0800..U+0FFF E0 A0..BF 80..BF 78 | U+1000..U+CFFF E1..EC 80..BF 80..BF 79 | U+D000..U+D7FF ED 80..9F 80..BF 80 | U+D800..U+DFFF ******* ill-formed ******* 81 | U+E000..U+FFFF EE..EF 80..BF 80..BF 82 | U+10000..U+3FFFF F0 90..BF 80..BF 80..BF 83 | U+40000..U+FFFFF F1..F3 80..BF 80..BF 80..BF 84 | U+100000..U+10FFFF F4 80..8F 80..BF 80..BF 85 | 86 | Note the A0..BF in U+0800..U+0FFF, the 80..9F in U+D000...U+D7FF, 87 | the 90..BF in U+10000..U+3FFFF, and the 80...8F in U+100000..U+10FFFF. 88 | The "gaps" are caused by legal UTF-8 avoiding non-shortest encodings: 89 | it is technically possible to UTF-8-encode a single code point in different 90 | ways, but that is explicitly forbidden, and the shortest possible encoding 91 | should always be used (and that is what Perl does). 92 | 93 | */ 94 | 95 | /* 96 | Another way to look at it, as bits: 97 | 98 | Code Points 1st Byte 2nd Byte 3rd Byte 4th Byte 99 | 100 | 0aaaaaaa 0aaaaaaa 101 | 00000bbbbbaaaaaa 110bbbbb 10aaaaaa 102 | ccccbbbbbbaaaaaa 1110cccc 10bbbbbb 10aaaaaa 103 | 00000dddccccccbbbbbbaaaaaa 11110ddd 10cccccc 10bbbbbb 10aaaaaa 104 | 105 | As you can see, the continuation bytes all begin with C<10>, and the 106 | leading bits of the start byte tell how many bytes the are in the 107 | encoded character. 108 | 109 | */ 110 | 111 | 112 | #define UNI_IS_INVARIANT(c) (((UV)c) < 0x80) 113 | #define UTF8_IS_INVARIANT(c) UNI_IS_INVARIANT(NATIVE_TO_UTF(c)) 114 | #define NATIVE_IS_INVARIANT(c) UNI_IS_INVARIANT(NATIVE_TO_ASCII(c)) 115 | #define UTF8_IS_START(c) (((U8)c) >= 0xc0 && (((U8)c) <= 0xfd)) 116 | #define UTF8_IS_CONTINUATION(c) (((U8)c) >= 0x80 && (((U8)c) <= 0xbf)) 117 | #define UTF8_IS_CONTINUED(c) (((U8)c) & 0x80) 118 | #define UTF8_IS_DOWNGRADEABLE_START(c) (((U8)c & 0xfc) == 0xc0) 119 | 120 | #define UTF_START_MARK(len) ((len > 7) ? 0xFF : (0xFE << (7-len))) 121 | #define UTF_START_MASK(len) ((len >= 7) ? 0x00 : (0x1F >> (len-2))) 122 | 123 | #define UTF_CONTINUATION_MARK 0x80 124 | #define UTF_ACCUMULATION_SHIFT 6 125 | #define UTF_CONTINUATION_MASK ((U8)0x3f) 126 | #define UTF8_ACCUMULATE(old, new) (((old) << UTF_ACCUMULATION_SHIFT) | (((U8)new) & UTF_CONTINUATION_MASK)) 127 | 128 | #define UTF8_EIGHT_BIT_HI(c) ((((U8)(c))>>UTF_ACCUMULATION_SHIFT)|UTF_START_MARK(2)) 129 | #define UTF8_EIGHT_BIT_LO(c) (((((U8)(c)))&UTF_CONTINUATION_MASK)|UTF_CONTINUATION_MARK) 130 | 131 | #ifdef HAS_QUAD 132 | #define UNISKIP(uv) ( (uv) < 0x80 ? 1 : \ 133 | (uv) < 0x800 ? 2 : \ 134 | (uv) < 0x10000 ? 3 : \ 135 | (uv) < 0x200000 ? 4 : \ 136 | (uv) < 0x4000000 ? 5 : \ 137 | (uv) < 0x80000000 ? 6 : \ 138 | (uv) < UTF8_QUAD_MAX ? 7 : 13 ) 139 | #else 140 | /* No, I'm not even going to *TRY* putting #ifdef inside a #define */ 141 | #define UNISKIP(uv) ( (uv) < 0x80 ? 1 : \ 142 | (uv) < 0x800 ? 2 : \ 143 | (uv) < 0x10000 ? 3 : \ 144 | (uv) < 0x200000 ? 4 : \ 145 | (uv) < 0x4000000 ? 5 : \ 146 | (uv) < 0x80000000 ? 6 : 7 ) 147 | #endif 148 | 149 | /* 150 | * Note: we try to be careful never to call the isXXX_utf8() functions 151 | * unless we're pretty sure we've seen the beginning of a UTF-8 character 152 | * (that is, the two high bits are set). Otherwise we risk loading in the 153 | * heavy-duty swash_init and swash_fetch routines unnecessarily. 154 | */ 155 | #define isIDFIRST_lazy_if(p,c) ((IN_BYTES || (!c || (*((const U8*)p) < 0xc0))) \ 156 | ? isIDFIRST(*(p)) \ 157 | : isIDFIRST_utf8((const U8*)p)) 158 | #define isALNUM_lazy_if(p,c) ((IN_BYTES || (!c || (*((const U8*)p) < 0xc0))) \ 159 | ? isALNUM(*(p)) \ 160 | : isALNUM_utf8((const U8*)p)) 161 | 162 | 163 | #endif /* EBCDIC vs ASCII */ 164 | 165 | /* Rest of these are attributes of Unicode and perl's internals rather than the encoding */ 166 | 167 | #define isIDFIRST_lazy(p) isIDFIRST_lazy_if(p,1) 168 | #define isALNUM_lazy(p) isALNUM_lazy_if(p,1) 169 | 170 | #define UTF8_MAXBYTES 13 171 | /* How wide can a single UTF-8 encoded character become in bytes. 172 | * NOTE: Strictly speaking Perl's UTF-8 should not be called UTF-8 173 | * since UTF-8 is an encoding of Unicode and given Unicode's current 174 | * upper limit only four bytes is possible. Perl thinks of UTF-8 175 | * as a way to encode non-negative integers in a binary format. */ 176 | #define UTF8_MAXLEN UTF8_MAXBYTES 177 | 178 | #define UTF8_MAXLEN_UCLC 3 /* Obsolete, do not use. */ 179 | #define UTF8_MAXLEN_UCLC_MULT 39 /* Obsolete, do not use. */ 180 | #define UTF8_MAXLEN_FOLD 3 /* Obsolete, do not use. */ 181 | #define UTF8_MAXLEN_FOLD_MULT 39 /* Obsolete, do not use. */ 182 | 183 | /* The maximum number of UTF-8 bytes a single Unicode character can 184 | * uppercase/lowercase/fold into; this number depends on the Unicode 185 | * version. An example of maximal expansion is the U+03B0 which 186 | * uppercases to U+03C5 U+0308 U+0301. The Unicode databases that 187 | * tell these things are UnicodeDatabase.txt, CaseFolding.txt, and 188 | * SpecialCasing.txt. */ 189 | #define UTF8_MAXBYTES_CASE 6 190 | 191 | #define IN_BYTES (CopHINTS_get(PL_curcop) & HINT_BYTES) 192 | #define DO_UTF8(sv) (SvUTF8(sv) && !IN_BYTES) 193 | 194 | #define UTF8_ALLOW_EMPTY 0x0001 195 | #define UTF8_ALLOW_CONTINUATION 0x0002 196 | #define UTF8_ALLOW_NON_CONTINUATION 0x0004 197 | #define UTF8_ALLOW_FE_FF 0x0008 /* Allow above 0x7fffFFFF */ 198 | #define UTF8_ALLOW_SHORT 0x0010 199 | #define UTF8_ALLOW_SURROGATE 0x0020 200 | #define UTF8_ALLOW_FFFF 0x0040 /* Allow UNICODE_ILLEGAL */ 201 | #define UTF8_ALLOW_LONG 0x0080 202 | #define UTF8_ALLOW_ANYUV (UTF8_ALLOW_EMPTY|UTF8_ALLOW_FE_FF|\ 203 | UTF8_ALLOW_SURROGATE|UTF8_ALLOW_FFFF) 204 | #define UTF8_ALLOW_ANY 0x00FF 205 | #define UTF8_CHECK_ONLY 0x0200 206 | #define UTF8_ALLOW_DEFAULT (ckWARN(WARN_UTF8) ? 0 : \ 207 | UTF8_ALLOW_ANYUV) 208 | 209 | #define UNICODE_SURROGATE_FIRST 0xD800 210 | #define UNICODE_SURROGATE_LAST 0xDFFF 211 | #define UNICODE_REPLACEMENT 0xFFFD 212 | #define UNICODE_BYTE_ORDER_MARK 0xFEFF 213 | #define UNICODE_ILLEGAL 0xFFFF 214 | 215 | /* Though our UTF-8 encoding can go beyond this, 216 | * let's be conservative and do as Unicode 3.2 says. */ 217 | #define PERL_UNICODE_MAX 0x10FFFF 218 | 219 | #define UNICODE_ALLOW_SURROGATE 0x0001 /* Allow UTF-16 surrogates (EVIL) */ 220 | #define UNICODE_ALLOW_FDD0 0x0002 /* Allow the U+FDD0...U+FDEF */ 221 | #define UNICODE_ALLOW_FFFF 0x0004 /* Allow U+FFF[EF], U+1FFF[EF], ... */ 222 | #define UNICODE_ALLOW_SUPER 0x0008 /* Allow past 0x10FFFF */ 223 | #define UNICODE_ALLOW_ANY 0x000F 224 | 225 | #define UNICODE_IS_SURROGATE(c) ((c) >= UNICODE_SURROGATE_FIRST && \ 226 | (c) <= UNICODE_SURROGATE_LAST) 227 | #define UNICODE_IS_REPLACEMENT(c) ((c) == UNICODE_REPLACEMENT) 228 | #define UNICODE_IS_BYTE_ORDER_MARK(c) ((c) == UNICODE_BYTE_ORDER_MARK) 229 | #define UNICODE_IS_ILLEGAL(c) ((c) == UNICODE_ILLEGAL) 230 | 231 | #ifdef HAS_QUAD 232 | # define UTF8_QUAD_MAX UINT64_C(0x1000000000) 233 | #endif 234 | 235 | #define UTF8_IS_ASCII(c) UTF8_IS_INVARIANT(c) 236 | 237 | #define UNICODE_LATIN_SMALL_LETTER_SHARP_S 0x00DF 238 | #define UNICODE_GREEK_CAPITAL_LETTER_SIGMA 0x03A3 239 | #define UNICODE_GREEK_SMALL_LETTER_FINAL_SIGMA 0x03C2 240 | #define UNICODE_GREEK_SMALL_LETTER_SIGMA 0x03C3 241 | 242 | #define EBCDIC_LATIN_SMALL_LETTER_SHARP_S 0x0059 243 | 244 | #define UNI_DISPLAY_ISPRINT 0x0001 245 | #define UNI_DISPLAY_BACKSLASH 0x0002 246 | #define UNI_DISPLAY_QQ (UNI_DISPLAY_ISPRINT|UNI_DISPLAY_BACKSLASH) 247 | #define UNI_DISPLAY_REGEX (UNI_DISPLAY_ISPRINT|UNI_DISPLAY_BACKSLASH) 248 | 249 | #ifdef EBCDIC 250 | # define ANYOF_FOLD_SHARP_S(node, input, end) \ 251 | (ANYOF_BITMAP_TEST(node, EBCDIC_LATIN_SMALL_LETTER_SHARP_S) && \ 252 | (ANYOF_FLAGS(node) & ANYOF_UNICODE) && \ 253 | (ANYOF_FLAGS(node) & ANYOF_FOLD) && \ 254 | ((end) > (input) + 1) && \ 255 | toLOWER((input)[0]) == 's' && \ 256 | toLOWER((input)[1]) == 's') 257 | #else 258 | # define ANYOF_FOLD_SHARP_S(node, input, end) \ 259 | (ANYOF_BITMAP_TEST(node, UNICODE_LATIN_SMALL_LETTER_SHARP_S) && \ 260 | (ANYOF_FLAGS(node) & ANYOF_UNICODE) && \ 261 | (ANYOF_FLAGS(node) & ANYOF_FOLD) && \ 262 | ((end) > (input) + 1) && \ 263 | toLOWER((input)[0]) == 's' && \ 264 | toLOWER((input)[1]) == 's') 265 | #endif 266 | #define SHARP_S_SKIP 2 267 | 268 | #ifdef EBCDIC 269 | /* IS_UTF8_CHAR() is not ported to EBCDIC */ 270 | #else 271 | #define IS_UTF8_CHAR_1(p) \ 272 | ((p)[0] <= 0x7F) 273 | #define IS_UTF8_CHAR_2(p) \ 274 | ((p)[0] >= 0xC2 && (p)[0] <= 0xDF && \ 275 | (p)[1] >= 0x80 && (p)[1] <= 0xBF) 276 | #define IS_UTF8_CHAR_3a(p) \ 277 | ((p)[0] == 0xE0 && \ 278 | (p)[1] >= 0xA0 && (p)[1] <= 0xBF && \ 279 | (p)[2] >= 0x80 && (p)[2] <= 0xBF) 280 | #define IS_UTF8_CHAR_3b(p) \ 281 | ((p)[0] >= 0xE1 && (p)[0] <= 0xEC && \ 282 | (p)[1] >= 0x80 && (p)[1] <= 0xBF && \ 283 | (p)[2] >= 0x80 && (p)[2] <= 0xBF) 284 | #define IS_UTF8_CHAR_3c(p) \ 285 | ((p)[0] == 0xED && \ 286 | (p)[1] >= 0x80 && (p)[1] <= 0xBF && \ 287 | (p)[2] >= 0x80 && (p)[2] <= 0xBF) 288 | /* In IS_UTF8_CHAR_3c(p) one could use 289 | * (p)[1] >= 0x80 && (p)[1] <= 0x9F 290 | * if one wanted to exclude surrogates. */ 291 | #define IS_UTF8_CHAR_3d(p) \ 292 | ((p)[0] >= 0xEE && (p)[0] <= 0xEF && \ 293 | (p)[1] >= 0x80 && (p)[1] <= 0xBF && \ 294 | (p)[2] >= 0x80 && (p)[2] <= 0xBF) 295 | #define IS_UTF8_CHAR_4a(p) \ 296 | ((p)[0] == 0xF0 && \ 297 | (p)[1] >= 0x90 && (p)[1] <= 0xBF && \ 298 | (p)[2] >= 0x80 && (p)[2] <= 0xBF && \ 299 | (p)[3] >= 0x80 && (p)[3] <= 0xBF) 300 | #define IS_UTF8_CHAR_4b(p) \ 301 | ((p)[0] >= 0xF1 && (p)[0] <= 0xF3 && \ 302 | (p)[1] >= 0x80 && (p)[1] <= 0xBF && \ 303 | (p)[2] >= 0x80 && (p)[2] <= 0xBF && \ 304 | (p)[3] >= 0x80 && (p)[3] <= 0xBF) 305 | /* In IS_UTF8_CHAR_4c(p) one could use 306 | * (p)[0] == 0xF4 307 | * if one wanted to stop at the Unicode limit U+10FFFF. 308 | * The 0xF7 allows us to go to 0x1fffff (0x200000 would 309 | * require five bytes). Not doing any further code points 310 | * since that is not needed (and that would not be strict 311 | * UTF-8, anyway). The "slow path" in Perl_is_utf8_char() 312 | * will take care of the "extended UTF-8". */ 313 | #define IS_UTF8_CHAR_4c(p) \ 314 | ((p)[0] == 0xF4 && (p)[0] <= 0xF7 && \ 315 | (p)[1] >= 0x80 && (p)[1] <= 0xBF && \ 316 | (p)[2] >= 0x80 && (p)[2] <= 0xBF && \ 317 | (p)[3] >= 0x80 && (p)[3] <= 0xBF) 318 | 319 | #define IS_UTF8_CHAR_3(p) \ 320 | (IS_UTF8_CHAR_3a(p) || \ 321 | IS_UTF8_CHAR_3b(p) || \ 322 | IS_UTF8_CHAR_3c(p) || \ 323 | IS_UTF8_CHAR_3d(p)) 324 | #define IS_UTF8_CHAR_4(p) \ 325 | (IS_UTF8_CHAR_4a(p) || \ 326 | IS_UTF8_CHAR_4b(p) || \ 327 | IS_UTF8_CHAR_4c(p)) 328 | 329 | /* IS_UTF8_CHAR(p) is strictly speaking wrong (not UTF-8) because it 330 | * (1) allows UTF-8 encoded UTF-16 surrogates 331 | * (2) it allows code points past U+10FFFF. 332 | * The Perl_is_utf8_char() full "slow" code will handle the Perl 333 | * "extended UTF-8". */ 334 | #define IS_UTF8_CHAR(p, n) \ 335 | ((n) == 1 ? IS_UTF8_CHAR_1(p) : \ 336 | (n) == 2 ? IS_UTF8_CHAR_2(p) : \ 337 | (n) == 3 ? IS_UTF8_CHAR_3(p) : \ 338 | (n) == 4 ? IS_UTF8_CHAR_4(p) : 0) 339 | 340 | #define IS_UTF8_CHAR_FAST(n) ((n) <= 4) 341 | 342 | #endif /* IS_UTF8_CHAR() for UTF-8 */ 343 | 344 | /* 345 | * Local variables: 346 | * c-indentation-style: bsd 347 | * c-basic-offset: 4 348 | * indent-tabs-mode: t 349 | * End: 350 | * 351 | * ex: set ts=8 sts=4 sw=4 noet: 352 | */ 353 | --------------------------------------------------------------------------------