[svn:parrot] r39377 - in branches/pmc_pct: . compilers/imcc compilers/json compilers/nqp/src/Grammar compilers/pct/src/PAST compilers/pct/src/PCT compilers/pge/PGE config/auto config/auto/sizes config/gen config/gen/call_list config/gen/config_pm config/gen/makefiles config/gen/platform/generic config/init config/init/hints config/inter docs docs/book docs/book/draft docs/dev docs/imcc docs/pct docs/pdds docs/pdds/draft docs/pmc docs/project docs/user/pir examples/benchmarks examples/json examples/languages/abc examples/languages/abc/config/makefiles examples/languages/abc/src/parser examples/languages/squaak examples/languages/squaak/config/makefiles examples/library examples/namespace examples/nci examples/pir/befunge/config/makefiles examples/streams examples/tcl ext/SQLite3 include/parrot lib/Parrot lib/Parrot/Configure lib/Parrot/Docs lib/Parrot/Docs/Section lib/Parrot/Pmc2c ports/cpan ports/cygwin ports/debian ports/fedora ports/mandriva ports/suse ports/ubuntu runtime/parrot/include runtime/parrot/languages runtime/parrot/languages/parrot runtime/parrot/library runtime/parrot/library/Config runtime/parrot/library/Math runtime/parrot/library/PGE src src/call src/gc src/interp src/io src/jit/amd64 src/jit/hppa src/jit/i386 src/jit/ppc src/jit/skeleton src/jit/sun4 src/ops src/packfile src/pmc src/runcore src/string src/string/charset src/string/encoding t/benchmark t/codingstd t/compilers/imcc/syn t/compilers/json t/compilers/pge t/compilers/tge t/dynpmc t/examples t/library t/manifest t/native_pbc t/oo t/op t/pmc t/pmc/testlib t/src t/steps t/tools t/tools/install t/tools/install/testlib t/tools/install/testlib/compilers t/tools/install/testlib/compilers/nqp t/tools/install/testlib/compilers/nqp/bootstrap t/tools/install/testlib/compilers/pge t/tools/install/testlib/docs t/tools/install/testlib/docs/pct t/tools/install/testlib/docs/resources t/tools/install/testlib/include t/tools/install/testlib/include/parrot t/tools/install/tes tlib/lib t/tools/install/testlib/lib/Parrot t/tools/install/testlib/runtime t/tools/install/testlib/runtime/parrot t/tools/install/testlib/runtime/parrot/include t/tools/install/testlib/runtime/parrot/library t/tools/install/testlib/src t/tools/install/testlib/src/ops t/tools/install/testlib/src/pmc t/tools/install/testlib/tools t/tools/install/testlib/tools/build t/tools/ops2pm tools/build tools/dev tools/install tools/util
cotto at svn.parrot.org
cotto at svn.parrot.org
Thu Jun 4 02:33:13 UTC 2009
Author: cotto
Date: Thu Jun 4 02:32:48 2009
New Revision: 39377
URL: https://trac.parrot.org/parrot/changeset/39377
Log:
[pmcc] bring branch up-to-date with trunk
Added:
branches/pmc_pct/examples/json/
- copied from r39376, trunk/examples/json/
branches/pmc_pct/lib/Parrot/Install.pm
- copied unchanged from r39376, trunk/lib/Parrot/Install.pm
branches/pmc_pct/ports/ubuntu/lpia_no_aligned_funcptr.patch
- copied unchanged from r39376, trunk/ports/ubuntu/lpia_no_aligned_funcptr.patch
branches/pmc_pct/runtime/parrot/languages/
- copied from r39376, trunk/runtime/parrot/languages/
branches/pmc_pct/src/gc/alloc_memory.c
- copied unchanged from r39376, trunk/src/gc/alloc_memory.c
branches/pmc_pct/src/gc/alloc_register.c
- copied unchanged from r39376, trunk/src/gc/alloc_register.c
branches/pmc_pct/src/gc/alloc_resources.c
- copied unchanged from r39376, trunk/src/gc/alloc_resources.c
branches/pmc_pct/src/gc/gc_ms.c
- copied unchanged from r39376, trunk/src/gc/gc_ms.c
branches/pmc_pct/src/gc/malloc.c
- copied unchanged from r39376, trunk/src/gc/malloc.c
branches/pmc_pct/src/gc/malloc_trace.c
- copied unchanged from r39376, trunk/src/gc/malloc_trace.c
branches/pmc_pct/t/oo/root_new.t
- copied unchanged from r39376, trunk/t/oo/root_new.t
branches/pmc_pct/t/op/arithmetics_pmc.t
- copied unchanged from r39376, trunk/t/op/arithmetics_pmc.t
branches/pmc_pct/t/tools/install/01-create_directories.t
- copied unchanged from r39376, trunk/t/tools/install/01-create_directories.t
branches/pmc_pct/t/tools/install/02-install_files.t
- copied unchanged from r39376, trunk/t/tools/install/02-install_files.t
branches/pmc_pct/t/tools/install/03-lines_to_files.t
- copied unchanged from r39376, trunk/t/tools/install/03-lines_to_files.t
branches/pmc_pct/t/tools/install/dev_overall.t
- copied unchanged from r39376, trunk/t/tools/install/dev_overall.t
branches/pmc_pct/t/tools/install/overall.t
- copied unchanged from r39376, trunk/t/tools/install/overall.t
branches/pmc_pct/t/tools/install/testlib/
- copied from r39376, trunk/t/tools/install/testlib/
Replaced:
branches/pmc_pct/examples/json/postalcodes.pir
- copied unchanged from r39376, trunk/examples/json/postalcodes.pir
branches/pmc_pct/examples/json/test.pir
- copied unchanged from r39376, trunk/examples/json/test.pir
branches/pmc_pct/runtime/parrot/languages/parrot/
- copied from r39376, trunk/runtime/parrot/languages/parrot/
branches/pmc_pct/runtime/parrot/languages/parrot/parrot.pir
- copied unchanged from r39376, trunk/runtime/parrot/languages/parrot/parrot.pir
branches/pmc_pct/t/tools/install/testlib/LICENSE
- copied unchanged from r39376, trunk/t/tools/install/testlib/LICENSE
branches/pmc_pct/t/tools/install/testlib/MANIFEST.1defective
- copied unchanged from r39376, trunk/t/tools/install/testlib/MANIFEST.1defective
branches/pmc_pct/t/tools/install/testlib/README
- copied unchanged from r39376, trunk/t/tools/install/testlib/README
branches/pmc_pct/t/tools/install/testlib/compilers/
- copied from r39376, trunk/t/tools/install/testlib/compilers/
branches/pmc_pct/t/tools/install/testlib/compilers/nqp/
- copied from r39376, trunk/t/tools/install/testlib/compilers/nqp/
branches/pmc_pct/t/tools/install/testlib/compilers/nqp/bootstrap/
- copied from r39376, trunk/t/tools/install/testlib/compilers/nqp/bootstrap/
branches/pmc_pct/t/tools/install/testlib/compilers/nqp/bootstrap/actions.pm
- copied unchanged from r39376, trunk/t/tools/install/testlib/compilers/nqp/bootstrap/actions.pm
branches/pmc_pct/t/tools/install/testlib/compilers/pge/
- copied from r39376, trunk/t/tools/install/testlib/compilers/pge/
branches/pmc_pct/t/tools/install/testlib/compilers/pge/PGE.pir
- copied unchanged from r39376, trunk/t/tools/install/testlib/compilers/pge/PGE.pir
branches/pmc_pct/t/tools/install/testlib/dev_generated_pseudo
- copied unchanged from r39376, trunk/t/tools/install/testlib/dev_generated_pseudo
branches/pmc_pct/t/tools/install/testlib/dev_manifest_pseudo
- copied unchanged from r39376, trunk/t/tools/install/testlib/dev_manifest_pseudo
branches/pmc_pct/t/tools/install/testlib/docs/
- copied from r39376, trunk/t/tools/install/testlib/docs/
branches/pmc_pct/t/tools/install/testlib/docs/compiler_faq.pod
- copied unchanged from r39376, trunk/t/tools/install/testlib/docs/compiler_faq.pod
branches/pmc_pct/t/tools/install/testlib/docs/gettingstarted.pod
- copied unchanged from r39376, trunk/t/tools/install/testlib/docs/gettingstarted.pod
branches/pmc_pct/t/tools/install/testlib/docs/pct/
- copied from r39376, trunk/t/tools/install/testlib/docs/pct/
branches/pmc_pct/t/tools/install/testlib/docs/pct/past_building_blocks.pod
- copied unchanged from r39376, trunk/t/tools/install/testlib/docs/pct/past_building_blocks.pod
branches/pmc_pct/t/tools/install/testlib/docs/resources/
- copied from r39376, trunk/t/tools/install/testlib/docs/resources/
branches/pmc_pct/t/tools/install/testlib/docs/resources/phony_resource
- copied unchanged from r39376, trunk/t/tools/install/testlib/docs/resources/phony_resource
branches/pmc_pct/t/tools/install/testlib/generated_pseudo
- copied unchanged from r39376, trunk/t/tools/install/testlib/generated_pseudo
branches/pmc_pct/t/tools/install/testlib/generated_pseudo_with_dupe
- copied unchanged from r39376, trunk/t/tools/install/testlib/generated_pseudo_with_dupe
branches/pmc_pct/t/tools/install/testlib/include/
- copied from r39376, trunk/t/tools/install/testlib/include/
branches/pmc_pct/t/tools/install/testlib/include/parrot/
- copied from r39376, trunk/t/tools/install/testlib/include/parrot/
branches/pmc_pct/t/tools/install/testlib/include/parrot/charset.h
- copied unchanged from r39376, trunk/t/tools/install/testlib/include/parrot/charset.h
branches/pmc_pct/t/tools/install/testlib/install_config.fpmc
- copied unchanged from r39376, trunk/t/tools/install/testlib/install_config.fpmc
branches/pmc_pct/t/tools/install/testlib/lib/
- copied from r39376, trunk/t/tools/install/testlib/lib/
branches/pmc_pct/t/tools/install/testlib/lib/Parrot/
- copied from r39376, trunk/t/tools/install/testlib/lib/Parrot/
branches/pmc_pct/t/tools/install/testlib/lib/Parrot/Configure.pm
- copied unchanged from r39376, trunk/t/tools/install/testlib/lib/Parrot/Configure.pm
branches/pmc_pct/t/tools/install/testlib/manifest_pseudo
- copied unchanged from r39376, trunk/t/tools/install/testlib/manifest_pseudo
branches/pmc_pct/t/tools/install/testlib/parrot.pc
- copied unchanged from r39376, trunk/t/tools/install/testlib/parrot.pc
branches/pmc_pct/t/tools/install/testlib/phony
- copied unchanged from r39376, trunk/t/tools/install/testlib/phony
branches/pmc_pct/t/tools/install/testlib/phony.exe
- copied unchanged from r39376, trunk/t/tools/install/testlib/phony.exe
branches/pmc_pct/t/tools/install/testlib/runtime/
- copied from r39376, trunk/t/tools/install/testlib/runtime/
branches/pmc_pct/t/tools/install/testlib/runtime/parrot/
- copied from r39376, trunk/t/tools/install/testlib/runtime/parrot/
branches/pmc_pct/t/tools/install/testlib/runtime/parrot/include/
- copied from r39376, trunk/t/tools/install/testlib/runtime/parrot/include/
branches/pmc_pct/t/tools/install/testlib/runtime/parrot/include/sockets.pasm
- copied unchanged from r39376, trunk/t/tools/install/testlib/runtime/parrot/include/sockets.pasm
branches/pmc_pct/t/tools/install/testlib/runtime/parrot/library/
- copied from r39376, trunk/t/tools/install/testlib/runtime/parrot/library/
branches/pmc_pct/t/tools/install/testlib/runtime/parrot/library/TGE.pbc
- copied unchanged from r39376, trunk/t/tools/install/testlib/runtime/parrot/library/TGE.pbc
branches/pmc_pct/t/tools/install/testlib/src/
- copied from r39376, trunk/t/tools/install/testlib/src/
branches/pmc_pct/t/tools/install/testlib/src/ops/
- copied from r39376, trunk/t/tools/install/testlib/src/ops/
branches/pmc_pct/t/tools/install/testlib/src/ops/ops.num
- copied unchanged from r39376, trunk/t/tools/install/testlib/src/ops/ops.num
branches/pmc_pct/t/tools/install/testlib/src/pmc/
- copied from r39376, trunk/t/tools/install/testlib/src/pmc/
branches/pmc_pct/t/tools/install/testlib/src/pmc/pmc_object.h
- copied unchanged from r39376, trunk/t/tools/install/testlib/src/pmc/pmc_object.h
branches/pmc_pct/t/tools/install/testlib/tools/
- copied from r39376, trunk/t/tools/install/testlib/tools/
branches/pmc_pct/t/tools/install/testlib/tools/build/
- copied from r39376, trunk/t/tools/install/testlib/tools/build/
branches/pmc_pct/t/tools/install/testlib/tools/build/ops2c.pl
- copied unchanged from r39376, trunk/t/tools/install/testlib/tools/build/ops2c.pl
branches/pmc_pct/t/tools/install/testlib/vtable.dump
- copied unchanged from r39376, trunk/t/tools/install/testlib/vtable.dump
Deleted:
branches/pmc_pct/compilers/json/postalcodes.pir
branches/pmc_pct/compilers/json/test.pir
branches/pmc_pct/docs/book/ch09_pasm.pod
branches/pmc_pct/runtime/parrot/include/sockets.pasm
branches/pmc_pct/runtime/parrot/library/tcpstream.pir
branches/pmc_pct/src/gc/memory.c
branches/pmc_pct/src/gc/pools.c
branches/pmc_pct/src/gc/register.c
branches/pmc_pct/src/gc/resources.c
branches/pmc_pct/src/io/io_string.c
branches/pmc_pct/src/malloc-trace.c
branches/pmc_pct/src/malloc.c
branches/pmc_pct/src/pmc/packfileannotationkeys.pmc
branches/pmc_pct/t/pmc/packfileannotationkeys.t
Modified:
branches/pmc_pct/ (props changed)
branches/pmc_pct/CREDITS
branches/pmc_pct/ChangeLog
branches/pmc_pct/DEPRECATED.pod
branches/pmc_pct/MANIFEST
branches/pmc_pct/MANIFEST.generated
branches/pmc_pct/META.yml
branches/pmc_pct/NEWS
branches/pmc_pct/PBC_COMPAT
branches/pmc_pct/PLATFORMS
branches/pmc_pct/README
branches/pmc_pct/README_win32.pod
branches/pmc_pct/RESPONSIBLE_PARTIES
branches/pmc_pct/VERSION
branches/pmc_pct/compilers/imcc/imc.c
branches/pmc_pct/compilers/imcc/imcc.l
branches/pmc_pct/compilers/imcc/imcc.y
branches/pmc_pct/compilers/imcc/imclexer.c
branches/pmc_pct/compilers/imcc/imcparser.c
branches/pmc_pct/compilers/imcc/pbc.c
branches/pmc_pct/compilers/nqp/src/Grammar/Actions.pir
branches/pmc_pct/compilers/pct/src/PAST/Compiler.pir
branches/pmc_pct/compilers/pct/src/PCT/HLLCompiler.pir
branches/pmc_pct/compilers/pge/PGE/Exp.pir
branches/pmc_pct/config/auto/gc.pm
branches/pmc_pct/config/auto/gcc.pm
branches/pmc_pct/config/auto/icu.pm
branches/pmc_pct/config/auto/sizes/intval_maxmin_c.in (props changed)
branches/pmc_pct/config/gen/call_list/core.in
branches/pmc_pct/config/gen/config_pm.pm
branches/pmc_pct/config/gen/config_pm/config_pir.in
branches/pmc_pct/config/gen/makefiles/dynoplibs.in
branches/pmc_pct/config/gen/makefiles/dynpmc.in
branches/pmc_pct/config/gen/makefiles/parrot_embed_pl.in
branches/pmc_pct/config/gen/makefiles/pirc.in
branches/pmc_pct/config/gen/makefiles/root.in
branches/pmc_pct/config/gen/platform/generic/memexec.c
branches/pmc_pct/config/init/defaults.pm
branches/pmc_pct/config/init/hints/cygwin.pm
branches/pmc_pct/config/init/hints/mswin32.pm
branches/pmc_pct/config/init/install.pm
branches/pmc_pct/config/inter/libparrot.pm
branches/pmc_pct/docs/book/appb_patch_submission.pod (props changed)
branches/pmc_pct/docs/book/ch01_introduction.pod (props changed)
branches/pmc_pct/docs/book/ch02_getting_started.pod
branches/pmc_pct/docs/book/ch03_pir.pod (contents, props changed)
branches/pmc_pct/docs/book/ch04_compiler_tools.pod (contents, props changed)
branches/pmc_pct/docs/book/ch05_pge.pod
branches/pmc_pct/docs/book/ch06_nqp.pod
branches/pmc_pct/docs/book/ch07_dynpmcs.pod (props changed)
branches/pmc_pct/docs/book/ch08_dynops.pod (props changed)
branches/pmc_pct/docs/book/ch10_opcode_reference.pod (contents, props changed)
branches/pmc_pct/docs/book/draft/chXX_hlls.pod (props changed)
branches/pmc_pct/docs/book/draft/chXX_library.pod (props changed)
branches/pmc_pct/docs/book/draft/chXX_testing_and_debugging.pod (props changed)
branches/pmc_pct/docs/compiler_faq.pod
branches/pmc_pct/docs/dev/byteorder.pod
branches/pmc_pct/docs/dev/c_functions.pod (contents, props changed)
branches/pmc_pct/docs/dev/jit_i386.pod
branches/pmc_pct/docs/dev/pmc_obj_design_meeting_notes.pod
branches/pmc_pct/docs/imcc/imcfaq.pod
branches/pmc_pct/docs/imcc/operation.pod
branches/pmc_pct/docs/intro.pod
branches/pmc_pct/docs/parrothist.pod
branches/pmc_pct/docs/pct/past_building_blocks.pod
branches/pmc_pct/docs/pct/pct_optable_guide.pod
branches/pmc_pct/docs/pdds/draft/pdd08_keys.pod
branches/pmc_pct/docs/pdds/draft/pdd16_native_call.pod
branches/pmc_pct/docs/pdds/draft/pdd29_compiler_tools.pod
branches/pmc_pct/docs/pdds/pdd03_calling_conventions.pod
branches/pmc_pct/docs/pdds/pdd13_bytecode.pod
branches/pmc_pct/docs/pdds/pdd15_objects.pod
branches/pmc_pct/docs/pdds/pdd17_pmc.pod
branches/pmc_pct/docs/pdds/pdd19_pir.pod
branches/pmc_pct/docs/pdds/pdd20_lexical_vars.pod
branches/pmc_pct/docs/pdds/pdd21_namespaces.pod
branches/pmc_pct/docs/pdds/pdd22_io.pod
branches/pmc_pct/docs/pdds/pdd23_exceptions.pod
branches/pmc_pct/docs/pdds/pdd24_events.pod
branches/pmc_pct/docs/pdds/pdd25_concurrency.pod
branches/pmc_pct/docs/pdds/pdd27_multiple_dispatch.pod
branches/pmc_pct/docs/pdds/pdd30_install.pod (props changed)
branches/pmc_pct/docs/pmc/array.pod
branches/pmc_pct/docs/pmc/documentation.pod
branches/pmc_pct/docs/pmc/struct.pod
branches/pmc_pct/docs/pmc/subs.pod
branches/pmc_pct/docs/project/release_manager_guide.pod
branches/pmc_pct/docs/project/ubuntu_packaging_guide.pod
branches/pmc_pct/docs/tests.pod
branches/pmc_pct/docs/user/pir/exceptions.pod
branches/pmc_pct/docs/user/pir/intro.pod
branches/pmc_pct/docs/user/pir/objects.pod
branches/pmc_pct/examples/benchmarks/addit.pasm
branches/pmc_pct/examples/benchmarks/addit.pir
branches/pmc_pct/examples/benchmarks/addit.pl
branches/pmc_pct/examples/benchmarks/addit.rb
branches/pmc_pct/examples/benchmarks/addit2.pir
branches/pmc_pct/examples/benchmarks/oo2.pasm
branches/pmc_pct/examples/benchmarks/oo5.pir
branches/pmc_pct/examples/benchmarks/oofib.pir
branches/pmc_pct/examples/benchmarks/oofib.pl
branches/pmc_pct/examples/benchmarks/oofib.py
branches/pmc_pct/examples/benchmarks/oofib.rb
branches/pmc_pct/examples/benchmarks/overload.pir
branches/pmc_pct/examples/benchmarks/overload.pl
branches/pmc_pct/examples/benchmarks/primes.pasm
branches/pmc_pct/examples/benchmarks/primes.pl
branches/pmc_pct/examples/benchmarks/primes2.c
branches/pmc_pct/examples/benchmarks/primes2.pir
branches/pmc_pct/examples/benchmarks/primes2.pl
branches/pmc_pct/examples/benchmarks/primes2.py
branches/pmc_pct/examples/benchmarks/primes2.rb
branches/pmc_pct/examples/languages/abc/ (props changed)
branches/pmc_pct/examples/languages/abc/config/makefiles/root.in
branches/pmc_pct/examples/languages/abc/src/parser/actions.pm
branches/pmc_pct/examples/languages/squaak/ (props changed)
branches/pmc_pct/examples/languages/squaak/config/makefiles/root.in
branches/pmc_pct/examples/library/pcre.pir
branches/pmc_pct/examples/namespace/namespace_dump.pir
branches/pmc_pct/examples/nci/xlibtest.pir
branches/pmc_pct/examples/pir/befunge/config/makefiles/root.in
branches/pmc_pct/examples/streams/Bytes.pir
branches/pmc_pct/examples/tcl/tcltkdemo.pir
branches/pmc_pct/ext/SQLite3/Makefile.in
branches/pmc_pct/include/parrot/call.h (props changed)
branches/pmc_pct/include/parrot/charset.h
branches/pmc_pct/include/parrot/compiler.h
branches/pmc_pct/include/parrot/datatypes.h
branches/pmc_pct/include/parrot/encoding.h
branches/pmc_pct/include/parrot/exceptions.h
branches/pmc_pct/include/parrot/gc_api.h (contents, props changed)
branches/pmc_pct/include/parrot/interpreter.h
branches/pmc_pct/include/parrot/io.h
branches/pmc_pct/include/parrot/io_win32.h
branches/pmc_pct/include/parrot/memory.h
branches/pmc_pct/include/parrot/oo.h
branches/pmc_pct/include/parrot/packfile.h
branches/pmc_pct/include/parrot/pmc.h
branches/pmc_pct/include/parrot/pmc_freeze.h
branches/pmc_pct/include/parrot/pobj.h
branches/pmc_pct/include/parrot/register.h
branches/pmc_pct/include/parrot/runcore_api.h (contents, props changed)
branches/pmc_pct/include/parrot/runcore_trace.h (contents, props changed)
branches/pmc_pct/include/parrot/string_funcs.h
branches/pmc_pct/include/parrot/sub.h
branches/pmc_pct/lib/Parrot/Configure/Compiler.pm
branches/pmc_pct/lib/Parrot/Distribution.pm
branches/pmc_pct/lib/Parrot/Docs/File.pm
branches/pmc_pct/lib/Parrot/Docs/Group.pm
branches/pmc_pct/lib/Parrot/Docs/Item.pm
branches/pmc_pct/lib/Parrot/Docs/POD2HTML.pm
branches/pmc_pct/lib/Parrot/Docs/Section/Developer.pm
branches/pmc_pct/lib/Parrot/Docs/Section/Parrot.pm
branches/pmc_pct/lib/Parrot/Headerizer.pm
branches/pmc_pct/lib/Parrot/Manifest.pm
branches/pmc_pct/lib/Parrot/OpsRenumber.pm
branches/pmc_pct/lib/Parrot/Pmc2c/Attribute.pm
branches/pmc_pct/lib/Parrot/Pmc2c/PMCEmitter.pm
branches/pmc_pct/lib/Parrot/Pmc2c/Parser.pm
branches/pmc_pct/lib/Parrot/Pmc2c/Pmc2cMain.pm
branches/pmc_pct/lib/Parrot/Test.pm
branches/pmc_pct/lib/Parrot/Vtable.pm
branches/pmc_pct/ports/cpan/pause_guide.pod (props changed)
branches/pmc_pct/ports/cygwin/README
branches/pmc_pct/ports/cygwin/parrot-1.0.0-1.cygport (props changed)
branches/pmc_pct/ports/debian/libparrot-dev.install.in (props changed)
branches/pmc_pct/ports/debian/libparrot.install.in (props changed)
branches/pmc_pct/ports/debian/parrot-doc.install.in (props changed)
branches/pmc_pct/ports/debian/parrot.install.in (props changed)
branches/pmc_pct/ports/fedora/parrot.spec.fedora (contents, props changed)
branches/pmc_pct/ports/mandriva/parrot.spec.mandriva (props changed)
branches/pmc_pct/ports/suse/parrot.spec.suse (props changed)
branches/pmc_pct/ports/ubuntu/changelog
branches/pmc_pct/runtime/parrot/library/Config/JSON.pir
branches/pmc_pct/runtime/parrot/library/JSON.pir
branches/pmc_pct/runtime/parrot/library/Math/Rand.pir (props changed)
branches/pmc_pct/runtime/parrot/library/PGE/Perl6Grammar.pir
branches/pmc_pct/runtime/parrot/library/TclLibrary.pir
branches/pmc_pct/runtime/parrot/library/libpcre.pir
branches/pmc_pct/runtime/parrot/library/pcre.pir
branches/pmc_pct/src/call/ops.c (props changed)
branches/pmc_pct/src/call/pcc.c (contents, props changed)
branches/pmc_pct/src/datatypes.c
branches/pmc_pct/src/dynext.c
branches/pmc_pct/src/exceptions.c
branches/pmc_pct/src/gc/api.c (contents, props changed)
branches/pmc_pct/src/gc/gc_malloc.c
branches/pmc_pct/src/gc/gc_private.h
branches/pmc_pct/src/gc/generational_ms.c (contents, props changed)
branches/pmc_pct/src/gc/incremental_ms.c (contents, props changed)
branches/pmc_pct/src/gc/mark_sweep.c (contents, props changed)
branches/pmc_pct/src/gc/res_lea.c
branches/pmc_pct/src/gc/system.c (contents, props changed)
branches/pmc_pct/src/global.c
branches/pmc_pct/src/hash.c
branches/pmc_pct/src/interp/inter_cb.c (props changed)
branches/pmc_pct/src/interp/inter_create.c (contents, props changed)
branches/pmc_pct/src/interp/inter_misc.c (contents, props changed)
branches/pmc_pct/src/io/api.c
branches/pmc_pct/src/io/core.c
branches/pmc_pct/src/io/unix.c
branches/pmc_pct/src/io/win32.c
branches/pmc_pct/src/jit.c
branches/pmc_pct/src/jit/amd64/jit_defs.c
branches/pmc_pct/src/jit/amd64/jit_emit.h
branches/pmc_pct/src/jit/hppa/jit_emit.h
branches/pmc_pct/src/jit/i386/jit_defs.c
branches/pmc_pct/src/jit/i386/jit_emit.h
branches/pmc_pct/src/jit/ppc/jit_emit.h
branches/pmc_pct/src/jit/skeleton/jit_emit.h
branches/pmc_pct/src/jit/sun4/jit_emit.h
branches/pmc_pct/src/key.c
branches/pmc_pct/src/list.c
branches/pmc_pct/src/multidispatch.c
branches/pmc_pct/src/oo.c
branches/pmc_pct/src/ops/cmp.ops
branches/pmc_pct/src/ops/io.ops
branches/pmc_pct/src/ops/ops.num
branches/pmc_pct/src/ops/pmc.ops
branches/pmc_pct/src/ops/set.ops
branches/pmc_pct/src/packfile.c
branches/pmc_pct/src/packfile/pf_items.c
branches/pmc_pct/src/pic.c
branches/pmc_pct/src/pmc.c
branches/pmc_pct/src/pmc/array.pmc
branches/pmc_pct/src/pmc/bigint.pmc
branches/pmc_pct/src/pmc/bignum.pmc
branches/pmc_pct/src/pmc/callsignature.pmc
branches/pmc_pct/src/pmc/class.pmc
branches/pmc_pct/src/pmc/codestring.pmc
branches/pmc_pct/src/pmc/complex.pmc
branches/pmc_pct/src/pmc/continuation.pmc
branches/pmc_pct/src/pmc/coroutine.pmc
branches/pmc_pct/src/pmc/cpointer.pmc
branches/pmc_pct/src/pmc/default.pmc
branches/pmc_pct/src/pmc/eventhandler.pmc
branches/pmc_pct/src/pmc/exception.pmc
branches/pmc_pct/src/pmc/exporter.pmc
branches/pmc_pct/src/pmc/filehandle.pmc
branches/pmc_pct/src/pmc/fixedintegerarray.pmc
branches/pmc_pct/src/pmc/fixedpmcarray.pmc
branches/pmc_pct/src/pmc/float.pmc
branches/pmc_pct/src/pmc/hash.pmc
branches/pmc_pct/src/pmc/integer.pmc
branches/pmc_pct/src/pmc/key.pmc
branches/pmc_pct/src/pmc/lexpad.pmc
branches/pmc_pct/src/pmc/managedstruct.pmc
branches/pmc_pct/src/pmc/namespace.pmc
branches/pmc_pct/src/pmc/nci.pmc
branches/pmc_pct/src/pmc/object.pmc
branches/pmc_pct/src/pmc/packfile.pmc
branches/pmc_pct/src/pmc/packfileannotation.pmc
branches/pmc_pct/src/pmc/packfileannotations.pmc
branches/pmc_pct/src/pmc/packfileconstanttable.pmc
branches/pmc_pct/src/pmc/packfiledirectory.pmc
branches/pmc_pct/src/pmc/packfilefixuptable.pmc
branches/pmc_pct/src/pmc/packfilerawsegment.pmc
branches/pmc_pct/src/pmc/parrotinterpreter.pmc
branches/pmc_pct/src/pmc/parrotlibrary.pmc
branches/pmc_pct/src/pmc/pmcproxy.pmc
branches/pmc_pct/src/pmc/resizablepmcarray.pmc
branches/pmc_pct/src/pmc/retcontinuation.pmc
branches/pmc_pct/src/pmc/scalar.pmc
branches/pmc_pct/src/pmc/string.pmc
branches/pmc_pct/src/pmc/stringhandle.pmc
branches/pmc_pct/src/pmc/sub.pmc
branches/pmc_pct/src/pmc/undef.pmc
branches/pmc_pct/src/pmc/unmanagedstruct.pmc
branches/pmc_pct/src/pmc_freeze.c
branches/pmc_pct/src/runcore/cores.c (props changed)
branches/pmc_pct/src/runcore/main.c (contents, props changed)
branches/pmc_pct/src/runcore/trace.c (contents, props changed)
branches/pmc_pct/src/scheduler.c
branches/pmc_pct/src/string/api.c
branches/pmc_pct/src/string/charset.c
branches/pmc_pct/src/string/charset/ascii.c
branches/pmc_pct/src/string/charset/iso-8859-1.c
branches/pmc_pct/src/string/encoding.c
branches/pmc_pct/src/string/encoding/fixed_8.c
branches/pmc_pct/src/string/encoding/ucs2.c
branches/pmc_pct/src/string/encoding/utf16.c
branches/pmc_pct/src/string/encoding/utf8.c
branches/pmc_pct/src/sub.c
branches/pmc_pct/src/vtables.c
branches/pmc_pct/t/benchmark/benchmarks.t
branches/pmc_pct/t/codingstd/c_function_docs.t
branches/pmc_pct/t/codingstd/c_returns.t
branches/pmc_pct/t/codingstd/copyright.t
branches/pmc_pct/t/compilers/imcc/syn/regressions.t
branches/pmc_pct/t/compilers/json/from_parrot.t
branches/pmc_pct/t/compilers/pge/pge_examples.t
branches/pmc_pct/t/compilers/tge/NoneGrammar.tg (props changed)
branches/pmc_pct/t/dynpmc/pair.t (props changed)
branches/pmc_pct/t/examples/pod.t
branches/pmc_pct/t/examples/streams.t
branches/pmc_pct/t/library/pcre.t
branches/pmc_pct/t/manifest/01-basic.t
branches/pmc_pct/t/manifest/02-regenerate_file.t
branches/pmc_pct/t/manifest/03-regenerate_skip.t
branches/pmc_pct/t/manifest/04-alt_file.t
branches/pmc_pct/t/manifest/05-alt_skip.t
branches/pmc_pct/t/native_pbc/annotations.pbc
branches/pmc_pct/t/native_pbc/integer_1.pbc
branches/pmc_pct/t/native_pbc/number_1.pbc
branches/pmc_pct/t/native_pbc/number_2.pbc
branches/pmc_pct/t/native_pbc/string_1.pbc
branches/pmc_pct/t/oo/proxy.t
branches/pmc_pct/t/op/copy.t
branches/pmc_pct/t/op/io.t
branches/pmc_pct/t/op/stringu.t
branches/pmc_pct/t/op/trans.t
branches/pmc_pct/t/pmc/io.t
branches/pmc_pct/t/pmc/multidispatch.t
branches/pmc_pct/t/pmc/namespace.t
branches/pmc_pct/t/pmc/object-meths.t
branches/pmc_pct/t/pmc/packfileannotation.t
branches/pmc_pct/t/pmc/packfileannotations.t
branches/pmc_pct/t/pmc/packfileconstanttable.t
branches/pmc_pct/t/pmc/packfiledirectory.t
branches/pmc_pct/t/pmc/pmcproxy.t
branches/pmc_pct/t/pmc/string.t
branches/pmc_pct/t/pmc/sub.t
branches/pmc_pct/t/pmc/sys.t
branches/pmc_pct/t/pmc/testlib/packfile_common.pir
branches/pmc_pct/t/pmc/threads.t
branches/pmc_pct/t/pmc/undef.t
branches/pmc_pct/t/src/embed.t (props changed)
branches/pmc_pct/t/steps/auto_gcc-01.t
branches/pmc_pct/t/tools/ops2pm/05-renum_op_map_file.t
branches/pmc_pct/t/tools/pmc2c.t
branches/pmc_pct/tools/build/c2str.pl
branches/pmc_pct/tools/build/headerizer.pl
branches/pmc_pct/tools/dev/fetch_languages.pl (props changed)
branches/pmc_pct/tools/dev/install_dev_files.pl
branches/pmc_pct/tools/dev/install_files.pl
branches/pmc_pct/tools/dev/mk_gitignore.pl (props changed)
branches/pmc_pct/tools/dev/mk_language_shell.pl
branches/pmc_pct/tools/dev/opsrenumber.pl
branches/pmc_pct/tools/dev/pbc_to_exe.pir
branches/pmc_pct/tools/install/smoke_languages.pl
branches/pmc_pct/tools/util/perlcritic-cage.conf (props changed)
branches/pmc_pct/tools/util/release.json
Modified: branches/pmc_pct/CREDITS
==============================================================================
--- branches/pmc_pct/CREDITS Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/CREDITS Thu Jun 4 02:32:48 2009 (r39377)
@@ -875,6 +875,7 @@
N: Stephen Weeks
U: tene
+A: t... at allalone.org
D: Cardinal, a Ruby compiler
D: ChitChat, a Smalltalk compiler
D: Minor Rakudo patches
Modified: branches/pmc_pct/ChangeLog
==============================================================================
--- branches/pmc_pct/ChangeLog Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/ChangeLog Thu Jun 4 02:32:48 2009 (r39377)
@@ -1,5 +1,9 @@
#1 $Id$
+2009.05.19 Infinoid
+ * Released 1.2.0
+ See NEWS for more.
+
2009.04.21 fperrad
* Released 1.1.0
See NEWS for more.
Modified: branches/pmc_pct/DEPRECATED.pod
==============================================================================
--- branches/pmc_pct/DEPRECATED.pod Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/DEPRECATED.pod Thu Jun 4 02:32:48 2009 (r39377)
@@ -57,6 +57,12 @@
L<https://trac.parrot.org/parrot/ticket/452>
+=item Hash changes to AssociativePMCArray [eligible in 1.5]
+
+Also OrderedHash to OrderedAssociativePMCArray.
+
+L<https://trac.parrot.org/parrot/ticket/679>
+
=back
=head1 Opcodes
@@ -87,6 +93,14 @@
for Sub, Exception, and related PMC types will instead be handled by
get_label and set_label.
+=item C<bsr>, C<jsr>, and C<ret> [eligible in 1.5]
+
+L<https://trac.parrot.org/parrot/ticket/702>
+
+=item C<branch_cs> [eligible in 1.5]
+
+L<https://trac.parrot.org/parrot/ticket/470>
+
=back
=head1 Bytecode
@@ -111,14 +125,6 @@
=over 4
-=item :anon and :vtable named parameters to add_method [eligible in 1.1]
-
-If you want to override a vtable method/function when building a Class, then
-use the method C<add_vtable_override> instead of calling C<add_method> with
-one or both of these flags.
-
-L<https://trac.parrot.org/parrot/ticket/158>
-
=back
=head1 PIR syntax
@@ -234,6 +240,30 @@
L<https://trac.parrot.org/parrot/ticket/664>
+=item functions in src/stack.c [eligible in 1.5]
+
+L<https://trac.parrot.org/parrot/ticket/702>
+Here is a list of functions in this file which are currently being exported:
+
+ stack_system_init
+ cst_new_stack_chunk
+ new_stack
+ mark_stack
+ stack_height
+ stack_entry
+ stack_prepare_push
+ stack_push
+ stack_prepare_pop
+ stack_pop
+ pop_dest
+ stack_peep
+ Parrot_dump_dynamic_environment
+ Parrot_push_action*
+ Parrot_push_mark*
+ Parrot_pop_mark*
+
+* = item may be kept but reimplemented.
+
=back
=head1 Compiler tools
@@ -318,6 +348,21 @@
=back
+=head1 pmc2c syntax
+
+=over 4
+
+=item "pmclass" with name not matching file's basename [eligible in 1.5]
+
+When foo.pmc contains a the line "pmclass bar", pmc2c generates a pmc_foo.h
+but tries to include pmc_bar.h. This is a bug, but it's possible someone out
+there is using it. This usage will result in a warning for now; after
+the 1.4 release, this warning will be upgraded to an error.
+
+L<https://trac.parrot.org/parrot/ticket/665>
+
+=back
+
=head1 Parrot library
=over 4
Modified: branches/pmc_pct/MANIFEST
==============================================================================
--- branches/pmc_pct/MANIFEST Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/MANIFEST Thu Jun 4 02:32:48 2009 (r39377)
@@ -1,7 +1,11 @@
# ex: set ro:
# $Id$
#
+<<<<<<< .working
# generated by tools/dev/mk_manifest_and_skip.pl Sun May 17 03:53:15 2009 UT
+=======
+# generated by tools/dev/mk_manifest_and_skip.pl Sun May 24 16:30:09 2009 UT
+>>>>>>> .merge-right.r39376
#
# See tools/dev/install_files.pl for documentation on the
# format of this file.
@@ -58,8 +62,6 @@
compilers/json/JSON.pir [json]
compilers/json/JSON/grammar.pg [json]
compilers/json/JSON/pge2pir.tg [json]
-compilers/json/postalcodes.pir [json]
-compilers/json/test.pir [json]
compilers/ncigen/MAINTAINER [ncigen]
compilers/ncigen/NCIGEN.TODO [ncigen]
compilers/ncigen/NCIGENP6.pm [ncigen]
@@ -491,7 +493,6 @@
docs/book/ch06_nqp.pod []
docs/book/ch07_dynpmcs.pod []
docs/book/ch08_dynops.pod []
-docs/book/ch09_pasm.pod []
docs/book/ch10_opcode_reference.pod []
docs/book/ch11_directive_reference.pod []
docs/book/ch12_operator_reference.pod []
@@ -712,6 +713,8 @@
examples/japh/japh3.pasm [examples]
examples/japh/japh4.pasm [examples]
examples/japh/japh5.pasm [examples]
+examples/json/postalcodes.pir [examples]
+examples/json/test.pir [examples]
examples/languages/abc/Configure.pl [examples]
examples/languages/abc/MAINTAINER [examples]
examples/languages/abc/README []doc
@@ -1115,6 +1118,7 @@
lib/Parrot/IO/Directory.pm [devel]lib
lib/Parrot/IO/File.pm [devel]lib
lib/Parrot/IO/Path.pm [devel]lib
+lib/Parrot/Install.pm [devel]lib
lib/Parrot/Manifest.pm [devel]lib
lib/Parrot/Op.pm [devel]lib
lib/Parrot/OpTrans.pm [devel]lib
@@ -1206,8 +1210,8 @@
runtime/parrot/include/README []doc
runtime/parrot/include/fp_equality.pasm [library]
runtime/parrot/include/hllmacros.pir [library]
-runtime/parrot/include/sockets.pasm [library]
runtime/parrot/include/test_more.pir [library]
+runtime/parrot/languages/parrot/parrot.pir [library]
runtime/parrot/library/CGI/QueryHash.pir [library]
runtime/parrot/library/Config/JSON.pir [library]
runtime/parrot/library/Crow.pir [library]
@@ -1288,7 +1292,6 @@
runtime/parrot/library/postgres.pasm [library]
runtime/parrot/library/postgres.pir [library]
runtime/parrot/library/random_lib.pir [library]
-runtime/parrot/library/tcpstream.pir [library]
runtime/parrot/library/uuid.pir [library]
runtime/parrot/library/yaml_dumper.pir [library]
src/atomic/gcc_x86.c []
@@ -1320,17 +1323,19 @@
src/exec_start.c []
src/exit.c []
src/extend.c []
+src/gc/alloc_memory.c []
+src/gc/alloc_register.c []
+src/gc/alloc_resources.c []
src/gc/api.c []
src/gc/gc_malloc.c []
+src/gc/gc_ms.c []
src/gc/gc_private.h []
src/gc/generational_ms.c []
src/gc/incremental_ms.c []
+src/gc/malloc.c []
+src/gc/malloc_trace.c []
src/gc/mark_sweep.c []
-src/gc/memory.c []
-src/gc/pools.c []
-src/gc/register.c []
src/gc/res_lea.c []
-src/gc/resources.c []
src/gc/system.c []
src/global.c []
src/global_setup.c []
@@ -1344,7 +1349,6 @@
src/io/core.c []
src/io/filehandle.c []
src/io/io_private.h []
-src/io/io_string.c []
src/io/portable.c []
src/io/socket_api.c []
src/io/socket_unix.c []
@@ -1399,8 +1403,6 @@
src/list.c []
src/longopt.c []
src/main.c []
-src/malloc-trace.c []
-src/malloc.c []
src/misc.c []
src/multidispatch.c []
src/nci_test.c []
@@ -1478,7 +1480,6 @@
src/pmc/os.pmc [devel]src
src/pmc/packfile.pmc [devel]src
src/pmc/packfileannotation.pmc [devel]src
-src/pmc/packfileannotationkeys.pmc [devel]src
src/pmc/packfileannotations.pmc [devel]src
src/pmc/packfileconstanttable.pmc [devel]src
src/pmc/packfiledirectory.pmc [devel]src
@@ -1819,6 +1820,7 @@
t/oo/new.t [test]
t/oo/ops.t [test]
t/oo/proxy.t [test]
+t/oo/root_new.t [test]
t/oo/subclass.t [test]
t/oo/vtableoverride.t [test]
t/op/00ff-dos.t [test]
@@ -1931,7 +1933,6 @@
t/pmc/os.t [test]
t/pmc/packfile.t [test]
t/pmc/packfileannotation.t [test]
-t/pmc/packfileannotationkeys.t [test]
t/pmc/packfileannotations.t [test]
t/pmc/packfileconstanttable.t [test]
t/pmc/packfiledirectory.t [test]
@@ -2070,6 +2071,36 @@
t/tools/dev/searchops.t [test]
t/tools/dev/searchops/samples.pm [test]
t/tools/dump_pbc.t [test]
+t/tools/install/01-create_directories.t [test]
+t/tools/install/02-install_files.t [test]
+t/tools/install/03-lines_to_files.t [test]
+t/tools/install/dev_overall.t [test]
+t/tools/install/overall.t [test]
+t/tools/install/testlib/LICENSE [test]
+t/tools/install/testlib/MANIFEST.1defective [test]
+t/tools/install/testlib/README []doc
+t/tools/install/testlib/compilers/nqp/bootstrap/actions.pm [test]
+t/tools/install/testlib/compilers/pge/PGE.pir [test]
+t/tools/install/testlib/dev_generated_pseudo [test]
+t/tools/install/testlib/dev_manifest_pseudo [test]
+t/tools/install/testlib/docs/compiler_faq.pod [test]
+t/tools/install/testlib/docs/gettingstarted.pod [test]
+t/tools/install/testlib/docs/pct/past_building_blocks.pod [test]
+t/tools/install/testlib/docs/resources/phony_resource [test]
+t/tools/install/testlib/generated_pseudo [test]
+t/tools/install/testlib/generated_pseudo_with_dupe [test]
+t/tools/install/testlib/include/parrot/charset.h [test]
+t/tools/install/testlib/install_config.fpmc [test]
+t/tools/install/testlib/lib/Parrot/Configure.pm [test]
+t/tools/install/testlib/manifest_pseudo [test]
+t/tools/install/testlib/parrot.pc [test]
+t/tools/install/testlib/phony [test]
+t/tools/install/testlib/phony.exe [test]
+t/tools/install/testlib/runtime/parrot/library/TGE.pbc [test]
+t/tools/install/testlib/src/ops/ops.num [test]
+t/tools/install/testlib/src/pmc/pmc_object.h [test]
+t/tools/install/testlib/tools/build/ops2c.pl [test]
+t/tools/install/testlib/vtable.dump [test]
t/tools/ops2cutils/01-new.t [test]
t/tools/ops2cutils/02-usage.t [test]
t/tools/ops2cutils/03-print_c_header_file.t [test]
Modified: branches/pmc_pct/MANIFEST.generated
==============================================================================
--- branches/pmc_pct/MANIFEST.generated Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/MANIFEST.generated Thu Jun 4 02:32:48 2009 (r39377)
@@ -2,10 +2,10 @@
# See tools/dev/install_files.pl for documentation on the
# format of this file.
# Please re-sort this file after *EVERY* modification
-blib/lib/libparrot.1.1.0.dylib [main]lib
+blib/lib/libparrot.1.2.0.dylib [main]lib
blib/lib/libparrot.a [main]lib
blib/lib/libparrot.dylib [main]lib
-blib/lib/libparrot.so.1.1.0 [main]lib
+blib/lib/libparrot.so.1.2.0 [main]lib
blib/lib/libparrot.so [main]lib
compilers/json/JSON/grammar.pbc [json]
compilers/json/JSON.pbc [json]
@@ -131,15 +131,21 @@
runtime/parrot/include/vtable_methods.pasm [main]
runtime/parrot/include/warnings.pasm [main]
runtime/parrot/library/CGI/QueryHash.pbc [main]
+runtime/parrot/library/Config/JSON.pbc [main]
runtime/parrot/library/config.pbc [main]
runtime/parrot/library/config.pir [main]
+runtime/parrot/library/Crow.pbc [main]
runtime/parrot/library/Data/Dumper/Base.pbc [main]
runtime/parrot/library/Data/Dumper/Default.pbc [main]
runtime/parrot/library/Data/Dumper.pbc [main]
+runtime/parrot/library/Data/Replace.pbc [main]
+runtime/parrot/library/Digest/MD5.pbc [main]
runtime/parrot/library/dumper.pbc [main]
runtime/parrot/library/Getopt/Obj.pbc [main]
+runtime/parrot/library/HTTP/Daemon.pbc [main]
runtime/parrot/library/Iter.pbc [main]
runtime/parrot/library/JSON.pbc [main]
+runtime/parrot/library/libpcre.pbc [main]
runtime/parrot/library/Math/Random/mt19937ar.pbc [main]
runtime/parrot/library/Math/Rand.pbc [main]
runtime/parrot/library/MIME/Base64.pbc [main]
@@ -178,7 +184,15 @@
runtime/parrot/library/Stream/Replay.pbc [main]
runtime/parrot/library/Stream/Sub.pbc [main]
runtime/parrot/library/Stream/Writer.pbc [main]
+runtime/parrot/library/Tcl/Glob.pbc [main]
runtime/parrot/library/TclLibrary.pbc [main]
+runtime/parrot/library/Test/Builder/Test.pbc [main]
+runtime/parrot/library/Test/Builder/Tester.pbc [main]
+runtime/parrot/library/Test/Builder/TestPlan.pbc [main]
+runtime/parrot/library/Test/Builder/Output.pbc [main]
+runtime/parrot/library/Test/Builder.pbc [main]
+runtime/parrot/library/Test/Class.pbc [main]
+runtime/parrot/library/Test/More.pbc [main]
runtime/parrot/library/TGE.pbc [tge]
runtime/parrot/library/YAML/Dumper/Base.pmc [main]
runtime/parrot/library/YAML/Dumper/Default.pmc [main]
Modified: branches/pmc_pct/META.yml
==============================================================================
--- branches/pmc_pct/META.yml Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/META.yml Thu Jun 4 02:32:48 2009 (r39377)
@@ -4,7 +4,7 @@
# See http://module-build.sourceforge.net/META-spec-current.html for details.
---
name: parrot
-version: 1.1.0
+version: 1.2.0
author: parrot-dev at lists.parrot.org
abstract: a virtual machine designed for dynamic languages
license: artistic2
Modified: branches/pmc_pct/NEWS
==============================================================================
--- branches/pmc_pct/NEWS Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/NEWS Thu Jun 4 02:32:48 2009 (r39377)
@@ -1,10 +1,34 @@
# $Id$
+New in 1.2.0
+- Core
+ + Fixes for pir classes inheriting from core pmcs.
+ + Cleaned up headers and reorganized some sources into subsystem directories.
+ + Clean up PMCs so libparrot.so exports far fewer vtable/method symbols.
+ + Clean up the GC API.
+ + Several unicode identifier improvements in IMCC.
+- Deprecations
+ + Protoobject stringification is gone.
+- Documentation
+ + Rewrite several core documents.
+ + Many reworks, improvements & additions to the Parrot Book.
+ + Installation PDD is launched out of draft.
+- Tools
+ + Fixes for running the language shell generator outside the parrot tree.
+ + Several fixes for developing and building HLLs from an installed parrot.
+ + Configure.pl now has a --no-line-directives option to ease source level debugging.
+- Miscellaneous
+ + Portability updates for macports, netbsd, mingw32, hpux.
+ + Several (build time, runtime) performance improvements.
+ + Lots of updates to examples and tests.
+ + Various bugfixes, code cleanups, and coding standard fixes.
+
New in 1.1.0
- Core
+ Added op: load_language, find_caller_lex
- + socket IO are back as PMC
- + refactor some PMC: Hash, ManagedStruct
+ + Socket IO are back as PMC
+ + Refactor some PMC: Hash, ManagedStruct
+ + Refactor GC API
- Compiler
+ PGE
- Allow \x, \c, and \o in enumerated character classes (incl ranges)
Modified: branches/pmc_pct/PBC_COMPAT
==============================================================================
--- branches/pmc_pct/PBC_COMPAT Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/PBC_COMPAT Thu Jun 4 02:32:48 2009 (r39377)
@@ -27,6 +27,8 @@
# please insert tab separated entries at the top of the list
+4.7 2009.05.29 cotto add cmp_pmc opcode (also, addition of setstdin and root_new in previous commits)
+4.6 2009.05.18 bacek removed PackfileAnnotationKeys PMC
4.5 2009.04.10 cotto removed Ref and SharedRef PMCs
4.4 2009.04.07 pmichaud find_caller_lex added
4.3 2009.03.25 jonathan socket opcodes added
Modified: branches/pmc_pct/PLATFORMS
==============================================================================
--- branches/pmc_pct/PLATFORMS Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/PLATFORMS Thu Jun 4 02:32:48 2009 (r39377)
@@ -20,7 +20,7 @@
linux-x86-gcc4.2.3 Y Y ? Y Y Y Y ? 20080715
linux-x86-gcc4.2.4 Y Y ? Y Y Y Y ? 20081023
linux-x86-gcc4.3.2 Y Y ? Y Y Y Y ? 20081030
-linux-x86-llvm-gcc-4.2 Y Y ? ? ? Y Y ? 20080801
+linux-x86-llvm-gcc-4.2 Y Y ? ? ? Y Y ? 20090514
sol10-sparc-cc_5.9 B4 Y - - Y Y Y Y ? 20090419
sol10-sparc-cc_5.9 B8 Y - - Y Y Y Y ? 20090419
sol10-sparc-gcc_4.0.2 B4 Y - - Y Y Y Y/1 ? 20080510
@@ -43,15 +43,19 @@
linux-s390x-gcc4.1.2 B4 ? - - Y Y Y Y/2 ? 20080908
linux-x86_64-gcc4.1.2 8 Y - - Y Y Y Y ? 20080220
linux-x86_64-gcc4.3.2 8 Y - - Y Y Y Y ? 20081118
-linux-x86_64-gcc4.3.3 8 Y - - Y Y Y Y ? 20090419
+linux-x86_64-gcc4.3.3 8 Y - - Y Y Y Y ? 20090517
netbsd3.1-ppc-gcc-3.3.3 B Y Y ? Y Y Y Y ? 20090419
-netbsd4.0-arm-gcc-4.1.2 Y - ? Y Y Y Y ? 20090421
-netbsd4.0-i386-gcc-4.1.2 Y Y ? Y Y Y Y ? 20090419
-netbsd4.0-ppc-gcc-4.1.2 B Y Y ? Y Y Y Y ? 20090419
-netbsd4.0-x86_64-gcc-4.1.2 8 Y - ? Y Y Y Y ? 20090419
-netbsd5.0-i386-gcc-4.1.3 Y Y ? Y Y Y Y ? 20090419
-netbsd5.0-mipseb32-gcc-4.1.3 B Y - ? Y Y Y Y ? 20090422
-netbsd5.0-sparc64-gcc-4.1.3 B8 Y - - Y Y Y Y ? 20090421
+netbsd4.0-alpha-gcc-4.1.2 8 Y - ? Y Y Y Y ? 20090518
+netbsd4.0-arm-gcc-4.1.2 Y - ? Y Y Y Y ? 20090518
+netbsd4.0-i386-gcc-4.1.2 Y Y ? Y Y Y Y ? 20090517
+netbsd4.0-ppc-gcc-4.1.2 B Y Y ? Y Y Y Y ? 20090519
+netbsd4.0-sparc64-gcc-4.1.2 B8 Y - - Y Y Y Y ? 20090519
+netbsd4.0-x86_64-gcc-4.1.2 8 Y - ? Y Y Y Y ? 20090519
+netbsd5.0-i386-gcc-4.1.3 Y Y ? Y Y Y Y ? 20090519
+netbsd5.0-ppc-gcc-4.1.3 B Y Y ? Y Y Y Y ? 20090517
+netbsd5.0-mipseb32-gcc-4.1.3 B Y - ? Y Y Y Y ? 20090518
+netbsd5.0-sparc-gcc-4.1.3 B Y - - Y Y Y Y ? 20090519
+netbsd5.0-sparc64-gcc-4.1.3 B8 Y - - Y Y Y Y/1 ? 20090519
netbsd5.0-x86_64-gcc-4.1.3 8 Y - - Y Y Y Y ? 20090419
opensolaris-x86-gcc_4.0.3 4 Y Y ? ? ? Y Y/2 ? 20080325
sol8-sparc-gcc_4.1.0 B - - - - - - Y/42 ? 20090317
Modified: branches/pmc_pct/README
==============================================================================
--- branches/pmc_pct/README Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/README Thu Jun 4 02:32:48 2009 (r39377)
@@ -1,4 +1,4 @@
-This is Parrot, version 1.1.0
+This is Parrot, version 1.2.0
------------------------------
Parrot is Copyright (C) 2001-2009, Parrot Foundation.
Modified: branches/pmc_pct/README_win32.pod
==============================================================================
--- branches/pmc_pct/README_win32.pod Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/README_win32.pod Thu Jun 4 02:32:48 2009 (r39377)
@@ -68,7 +68,7 @@
Configure.pl to use it.
mkdir C:\usr\lib
- unzip icu4c-4_0-Win32-msvc8.zip -d C:\usr\lib
+ unzip icu4c-4_2-Win32-msvc9.zip -d C:\usr\lib
mkdir C:\usr\lib\data
set PATH=%PATH%;C:\usr\lib\icu\bin
cd <parrot directory>
@@ -85,8 +85,8 @@
The availability of these libraries is checked by Configure.pl.
-B<libcrypto> - a part of libssl
-L<http://www.openssl.org/>
+B<libcrypto> - a part of libssl / OpenSSL
+L<http://gnuwin32.sourceforge.net/>
B<gettext> - library and tools for native language support
L<http://gnuwin32.sourceforge.net/>
Modified: branches/pmc_pct/RESPONSIBLE_PARTIES
==============================================================================
--- branches/pmc_pct/RESPONSIBLE_PARTIES Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/RESPONSIBLE_PARTIES Thu Jun 4 02:32:48 2009 (r39377)
@@ -25,6 +25,7 @@
Andrew Whitworth
Klaas-Jan Stol
Francois Perrad
+ Mark Glines
Metacommitter Allison Randal
Jerry Gay
@@ -47,6 +48,7 @@
Christoph Otto
Julian Albo
Mark Glines
+ Vasily Chekalkin
Compiler Developer Patrick Michaud (PGE, PCT)
Allison Randal (TGE)
Modified: branches/pmc_pct/VERSION
==============================================================================
--- branches/pmc_pct/VERSION Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/VERSION Thu Jun 4 02:32:48 2009 (r39377)
@@ -1 +1 @@
-1.1.0
+1.2.0
Modified: branches/pmc_pct/compilers/imcc/imc.c
==============================================================================
--- branches/pmc_pct/compilers/imcc/imc.c Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/compilers/imcc/imc.c Thu Jun 4 02:32:48 2009 (r39377)
@@ -266,6 +266,11 @@
clear_locals(unit);
+ if (unit->vtable_name)
+ mem_sys_free(unit->vtable_name);
+ if (unit->instance_of)
+ mem_sys_free(unit->instance_of);
+
free(unit->hash.data);
free(unit);
}
Modified: branches/pmc_pct/compilers/imcc/imcc.l
==============================================================================
--- branches/pmc_pct/compilers/imcc/imcc.l Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/compilers/imcc/imcc.l Thu Jun 4 02:32:48 2009 (r39377)
@@ -430,6 +430,7 @@
"stringliteral or register", IMCC_INFO(interp)->cur_macro_name);
define_macro(interp, IMCC_INFO(interp)->cur_macro_name, NULL, valp->s, start_line);
+ mem_sys_free(valp->s);
IMCC_INFO(interp)->cur_macro_name = NULL;
@@ -443,9 +444,12 @@
<emit,INITIAL>".include" {
const int c = yylex(valp, yyscanner, interp);
+
if (c != STRINGC)
return c;
+ /* STRINGCs have a str_dup()ed valp->s */
+ mem_sys_free(valp->s);
YYCHOP();
include_file(interp, yytext + 1, yyscanner);
}
Modified: branches/pmc_pct/compilers/imcc/imcc.y
==============================================================================
--- branches/pmc_pct/compilers/imcc/imcc.y Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/compilers/imcc/imcc.y Thu Jun 4 02:32:48 2009 (r39377)
@@ -1165,10 +1165,12 @@
TK_LINE INTC COMMA STRINGC '\n'
{
IMCC_INFO(interp)->line = atoi($2);
+ /* set_filename() frees the STRINGC */
set_filename(interp, $4);
}
| TK_FILE STRINGC '\n'
{
+ /* set_filename() frees the STRINGC */
set_filename(interp, $2);
}
;
@@ -1193,6 +1195,7 @@
Parrot_register_HLL(interp, hll_name);
IMCC_INFO(interp)->cur_namespace = NULL;
+ mem_sys_free($2);
$$ = 0;
}
;
@@ -1210,12 +1213,15 @@
CONST { pesky_global__is_def=1; } INTC var_or_i '=' any_string
{
$$ = mk_pmc_const(interp, IMCC_INFO(interp)->cur_unit, $3, $4, $6);
+ mem_sys_free($6);
pesky_global__is_def = 0;
}
| CONST { pesky_global__is_def=1; } STRINGC var_or_i '=' any_string
{
$$ = mk_pmc_const_named(interp, IMCC_INFO(interp)->cur_unit, $3, $4, $6);
+ mem_sys_free($3);
+ mem_sys_free($6);
pesky_global__is_def = 0;
}
;
Modified: branches/pmc_pct/compilers/imcc/imclexer.c
==============================================================================
--- branches/pmc_pct/compilers/imcc/imclexer.c Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/compilers/imcc/imclexer.c Thu Jun 4 02:32:48 2009 (r39377)
@@ -75,7 +75,6 @@
typedef unsigned char flex_uint8_t;
typedef unsigned short int flex_uint16_t;
typedef unsigned int flex_uint32_t;
-#endif /* ! C99 */
/* Limits of integral types. */
#ifndef INT8_MIN
@@ -106,6 +105,8 @@
#define UINT32_MAX (4294967295U)
#endif
+#endif /* ! C99 */
+
#endif /* ! FLEXINT_H */
#ifdef __cplusplus
@@ -179,7 +180,15 @@
/* Size of default input buffer. */
#ifndef YY_BUF_SIZE
+#ifdef __ia64__
+/* On IA-64, the buffer size is 16k, not 8k.
+ * Moreover, YY_BUF_SIZE is 2*YY_READ_BUF_SIZE in the general case.
+ * Ditto for the __ia64__ case accordingly.
+ */
+#define YY_BUF_SIZE 32768
+#else
#define YY_BUF_SIZE 16384
+#endif /* __ia64__ */
#endif
/* The state buf must be large enough to hold one state per character in the main buffer.
@@ -2478,7 +2487,7 @@
-#line 2482 "compilers/imcc/imclexer.c"
+#line 2491 "compilers/imcc/imclexer.c"
#define INITIAL 0
#define emit 1
@@ -2613,7 +2622,12 @@
/* Amount of stuff to slurp up with each read. */
#ifndef YY_READ_BUF_SIZE
+#ifdef __ia64__
+/* On IA-64, the buffer size is 16k, not 8k */
+#define YY_READ_BUF_SIZE 16384
+#else
#define YY_READ_BUF_SIZE 8192
+#endif /* __ia64__ */
#endif
/* Copy whatever the last rule matched to the standard output. */
@@ -2621,7 +2635,7 @@
/* This used to be an fputs(), but since the string might contain NUL's,
* we now use fwrite().
*/
-#define ECHO fwrite( yytext, yyleng, 1, yyout )
+#define ECHO do { if (fwrite( yytext, yyleng, 1, yyout )) {} } while (0)
#endif
/* Gets input and stuffs it into "buf". number of characters read, or YY_NULL,
@@ -2632,7 +2646,7 @@
if ( YY_CURRENT_BUFFER_LVALUE->yy_is_interactive ) \
{ \
int c = '*'; \
- int n; \
+ size_t n; \
for ( n = 0; n < max_size && \
(c = getc( yyin )) != EOF && c != '\n'; ++n ) \
buf[n] = (char) c; \
@@ -2737,7 +2751,7 @@
return 0;
}
-#line 2741 "compilers/imcc/imclexer.c"
+#line 2755 "compilers/imcc/imclexer.c"
if ( !yyg->yy_init )
{
@@ -3494,6 +3508,7 @@
"stringliteral or register", IMCC_INFO(interp)->cur_macro_name);
define_macro(interp, IMCC_INFO(interp)->cur_macro_name, NULL, valp->s, start_line);
+ mem_sys_free(valp->s);
IMCC_INFO(interp)->cur_macro_name = NULL;
@@ -3503,26 +3518,29 @@
YY_BREAK
case 110:
YY_RULE_SETUP
-#line 440 "compilers/imcc/imcc.l"
+#line 441 "compilers/imcc/imcc.l"
{
return read_macro(valp, interp, yyscanner);
}
YY_BREAK
case 111:
YY_RULE_SETUP
-#line 444 "compilers/imcc/imcc.l"
+#line 445 "compilers/imcc/imcc.l"
{
const int c = yylex(valp,yyscanner,interp);
+
if (c != STRINGC)
return c;
+ /* STRINGCs have a str_dup()ed valp->s */
+ mem_sys_free(valp->s);
YYCHOP();
include_file(interp, yytext + 1, yyscanner);
}
YY_BREAK
case 112:
YY_RULE_SETUP
-#line 453 "compilers/imcc/imcc.l"
+#line 457 "compilers/imcc/imcc.l"
{
if (valp) {
char *label;
@@ -3547,7 +3565,7 @@
YY_BREAK
case 113:
YY_RULE_SETUP
-#line 475 "compilers/imcc/imcc.l"
+#line 479 "compilers/imcc/imcc.l"
{
if (valp) {
@@ -3572,12 +3590,12 @@
YY_BREAK
case 114:
YY_RULE_SETUP
-#line 497 "compilers/imcc/imcc.l"
+#line 501 "compilers/imcc/imcc.l"
return COMMA;
YY_BREAK
case 115:
YY_RULE_SETUP
-#line 499 "compilers/imcc/imcc.l"
+#line 503 "compilers/imcc/imcc.l"
{
/* trim last ':' */
YYCHOP();
@@ -3590,7 +3608,7 @@
YY_BREAK
case 116:
YY_RULE_SETUP
-#line 509 "compilers/imcc/imcc.l"
+#line 513 "compilers/imcc/imcc.l"
{
char * const macro_name = yytext + 1;
@@ -3602,32 +3620,32 @@
YY_BREAK
case 117:
YY_RULE_SETUP
-#line 520 "compilers/imcc/imcc.l"
+#line 524 "compilers/imcc/imcc.l"
DUP_AND_RET(valp, FLOATC);
YY_BREAK
case 118:
YY_RULE_SETUP
-#line 521 "compilers/imcc/imcc.l"
+#line 525 "compilers/imcc/imcc.l"
DUP_AND_RET(valp, INTC);
YY_BREAK
case 119:
YY_RULE_SETUP
-#line 522 "compilers/imcc/imcc.l"
+#line 526 "compilers/imcc/imcc.l"
DUP_AND_RET(valp, INTC);
YY_BREAK
case 120:
YY_RULE_SETUP
-#line 523 "compilers/imcc/imcc.l"
+#line 527 "compilers/imcc/imcc.l"
DUP_AND_RET(valp, INTC);
YY_BREAK
case 121:
YY_RULE_SETUP
-#line 524 "compilers/imcc/imcc.l"
+#line 528 "compilers/imcc/imcc.l"
DUP_AND_RET(valp, INTC);
YY_BREAK
case 122:
YY_RULE_SETUP
-#line 526 "compilers/imcc/imcc.l"
+#line 530 "compilers/imcc/imcc.l"
{
valp->s = str_dup(yytext);
@@ -3640,7 +3658,7 @@
YY_BREAK
case 123:
YY_RULE_SETUP
-#line 536 "compilers/imcc/imcc.l"
+#line 540 "compilers/imcc/imcc.l"
{
valp->s = str_dup(yytext);
@@ -3650,7 +3668,7 @@
YY_BREAK
case 124:
YY_RULE_SETUP
-#line 543 "compilers/imcc/imcc.l"
+#line 547 "compilers/imcc/imcc.l"
{
macro_frame_t *frame;
@@ -3681,7 +3699,7 @@
YY_BREAK
case 125:
YY_RULE_SETUP
-#line 571 "compilers/imcc/imcc.l"
+#line 575 "compilers/imcc/imcc.l"
{
/* charset:"..." */
valp->s = str_dup(yytext);
@@ -3692,7 +3710,7 @@
YY_BREAK
case 126:
YY_RULE_SETUP
-#line 579 "compilers/imcc/imcc.l"
+#line 583 "compilers/imcc/imcc.l"
{
if (valp) (valp)->s = yytext;
if (IMCC_INFO(interp)->state->pasm_file)
@@ -3703,7 +3721,7 @@
YY_BREAK
case 127:
YY_RULE_SETUP
-#line 587 "compilers/imcc/imcc.l"
+#line 591 "compilers/imcc/imcc.l"
{
if (valp) (valp)->s = yytext;
if (IMCC_INFO(interp)->state->pasm_file)
@@ -3714,7 +3732,7 @@
YY_BREAK
case 128:
YY_RULE_SETUP
-#line 595 "compilers/imcc/imcc.l"
+#line 599 "compilers/imcc/imcc.l"
{
if (valp) (valp)->s = yytext;
if (IMCC_INFO(interp)->state->pasm_file)
@@ -3725,7 +3743,7 @@
YY_BREAK
case 129:
YY_RULE_SETUP
-#line 603 "compilers/imcc/imcc.l"
+#line 607 "compilers/imcc/imcc.l"
{
if (valp) (valp)->s = yytext;
if (IMCC_INFO(interp)->state->pasm_file)
@@ -3736,7 +3754,7 @@
YY_BREAK
case 130:
YY_RULE_SETUP
-#line 611 "compilers/imcc/imcc.l"
+#line 615 "compilers/imcc/imcc.l"
{
IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
"'%s' is not a valid register name", yytext);
@@ -3744,7 +3762,7 @@
YY_BREAK
case 131:
YY_RULE_SETUP
-#line 616 "compilers/imcc/imcc.l"
+#line 620 "compilers/imcc/imcc.l"
{
if (IMCC_INFO(interp)->state->pasm_file == 0)
IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
@@ -3758,7 +3776,7 @@
YY_BREAK
case 132:
YY_RULE_SETUP
-#line 627 "compilers/imcc/imcc.l"
+#line 631 "compilers/imcc/imcc.l"
{
if (!pesky_global__is_def) {
SymReg *r = find_sym(interp, yytext);
@@ -3789,19 +3807,19 @@
YY_BREAK
case 133:
YY_RULE_SETUP
-#line 656 "compilers/imcc/imcc.l"
+#line 660 "compilers/imcc/imcc.l"
/* skip */;
YY_BREAK
case 134:
YY_RULE_SETUP
-#line 658 "compilers/imcc/imcc.l"
+#line 662 "compilers/imcc/imcc.l"
{
/* catch all except for state macro */
return yytext[0];
}
YY_BREAK
case YY_STATE_EOF(emit):
-#line 663 "compilers/imcc/imcc.l"
+#line 667 "compilers/imcc/imcc.l"
{
BEGIN(INITIAL);
@@ -3814,18 +3832,18 @@
}
YY_BREAK
case YY_STATE_EOF(INITIAL):
-#line 674 "compilers/imcc/imcc.l"
+#line 678 "compilers/imcc/imcc.l"
yyterminate();
YY_BREAK
case 135:
YY_RULE_SETUP
-#line 676 "compilers/imcc/imcc.l"
+#line 680 "compilers/imcc/imcc.l"
DUP_AND_RET(valp, ENDM);
YY_BREAK
case 136:
/* rule 136 can match eol */
YY_RULE_SETUP
-#line 678 "compilers/imcc/imcc.l"
+#line 682 "compilers/imcc/imcc.l"
{
IMCC_INFO(interp)->line++;
DUP_AND_RET(valp, '\n');
@@ -3833,12 +3851,12 @@
YY_BREAK
case 137:
YY_RULE_SETUP
-#line 683 "compilers/imcc/imcc.l"
+#line 687 "compilers/imcc/imcc.l"
return LABEL;
YY_BREAK
case 138:
YY_RULE_SETUP
-#line 685 "compilers/imcc/imcc.l"
+#line 689 "compilers/imcc/imcc.l"
{
if (yylex(valp,yyscanner,interp) != LABEL)
@@ -3864,7 +3882,7 @@
YY_BREAK
case 139:
YY_RULE_SETUP
-#line 708 "compilers/imcc/imcc.l"
+#line 712 "compilers/imcc/imcc.l"
{
if (valp) {
const size_t len = strlen(IMCC_INFO(interp)->cur_macro_name) + yyleng + 12;
@@ -3881,49 +3899,49 @@
YY_BREAK
case 140:
YY_RULE_SETUP
-#line 722 "compilers/imcc/imcc.l"
+#line 726 "compilers/imcc/imcc.l"
/* skip leading ws */;
YY_BREAK
case 141:
YY_RULE_SETUP
-#line 723 "compilers/imcc/imcc.l"
+#line 727 "compilers/imcc/imcc.l"
DUP_AND_RET(valp, ' ');
YY_BREAK
case 142:
YY_RULE_SETUP
-#line 724 "compilers/imcc/imcc.l"
+#line 728 "compilers/imcc/imcc.l"
DUP_AND_RET(valp, REG);
YY_BREAK
case 143:
YY_RULE_SETUP
-#line 725 "compilers/imcc/imcc.l"
+#line 729 "compilers/imcc/imcc.l"
DUP_AND_RET(valp, REG);
YY_BREAK
case 144:
YY_RULE_SETUP
-#line 726 "compilers/imcc/imcc.l"
+#line 730 "compilers/imcc/imcc.l"
DUP_AND_RET(valp, IDENTIFIER);
YY_BREAK
case 145:
YY_RULE_SETUP
-#line 727 "compilers/imcc/imcc.l"
+#line 731 "compilers/imcc/imcc.l"
DUP_AND_RET(valp, MACRO);
YY_BREAK
case 146:
YY_RULE_SETUP
-#line 728 "compilers/imcc/imcc.l"
+#line 732 "compilers/imcc/imcc.l"
DUP_AND_RET(valp, yytext[0]);
YY_BREAK
case YY_STATE_EOF(macro):
-#line 729 "compilers/imcc/imcc.l"
+#line 733 "compilers/imcc/imcc.l"
yyterminate();
YY_BREAK
case 147:
YY_RULE_SETUP
-#line 731 "compilers/imcc/imcc.l"
+#line 735 "compilers/imcc/imcc.l"
ECHO;
YY_BREAK
-#line 3927 "compilers/imcc/imclexer.c"
+#line 3945 "compilers/imcc/imclexer.c"
case YY_STATE_EOF(pod):
case YY_STATE_EOF(cmt1):
case YY_STATE_EOF(cmt2):
@@ -4702,8 +4720,8 @@
/** Setup the input buffer state to scan the given bytes. The next call to yylex() will
* scan from a @e copy of @a bytes.
- * @param bytes the byte buffer to scan
- * @param len the number of bytes in the buffer pointed to by @a bytes.
+ * @param yybytes the byte buffer to scan
+ * @param _yybytes_len the number of bytes in the buffer pointed to by @a bytes.
* @param yyscanner The scanner object.
* @return the newly allocated buffer state object.
*/
@@ -5125,7 +5143,7 @@
#define YYTABLES_NAME "yytables"
-#line 731 "compilers/imcc/imcc.l"
+#line 735 "compilers/imcc/imcc.l"
Modified: branches/pmc_pct/compilers/imcc/imcparser.c
==============================================================================
--- branches/pmc_pct/compilers/imcc/imcparser.c Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/compilers/imcc/imcparser.c Thu Jun 4 02:32:48 2009 (r39377)
@@ -368,8 +368,8 @@
static void add_pcc_named_arg(PARROT_INTERP,
ARGMOD(SymReg *cur_call),
- ARGIN(SymReg *name),
- ARGIN(SymReg *value))
+ ARGIN(SymReg *name),
+ ARGIN(SymReg *value))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
__attribute__nonnull__(3)
@@ -378,8 +378,8 @@
static void add_pcc_named_arg_var(PARROT_INTERP,
ARGMOD(SymReg *cur_call),
- ARGIN(SymReg *name),
- ARGIN(SymReg *value))
+ ARGIN(SymReg *name),
+ ARGIN(SymReg *value))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
__attribute__nonnull__(3)
@@ -388,8 +388,8 @@
static void add_pcc_named_param(PARROT_INTERP,
ARGMOD(SymReg *cur_call),
- ARGIN(SymReg *name),
- ARGIN(SymReg *value))
+ ARGIN(SymReg *name),
+ ARGIN(SymReg *value))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
__attribute__nonnull__(3)
@@ -398,8 +398,8 @@
static void add_pcc_named_result(PARROT_INTERP,
ARGMOD(SymReg *cur_call),
- ARGIN(SymReg *name),
- ARGIN(SymReg *value))
+ ARGIN(SymReg *name),
+ ARGIN(SymReg *value))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
__attribute__nonnull__(3)
@@ -408,8 +408,8 @@
static void add_pcc_named_return(PARROT_INTERP,
ARGMOD(SymReg *cur_call),
- ARGIN(SymReg *name),
- ARGIN(SymReg *value))
+ ARGIN(SymReg *name),
+ ARGIN(SymReg *value))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
__attribute__nonnull__(3)
@@ -1194,8 +1194,8 @@
/*
-=item C<static void add_pcc_named_arg(PARROT_INTERP, SymReg *cur_call, const
-char *name, SymReg *value)>
+=item C<static void add_pcc_named_arg(PARROT_INTERP, SymReg *cur_call, SymReg
+*name, SymReg *value)>
=cut
@@ -1234,8 +1234,8 @@
/*
-=item C<static void add_pcc_named_result(PARROT_INTERP, SymReg *cur_call, const
-char *name, SymReg *value)>
+=item C<static void add_pcc_named_result(PARROT_INTERP, SymReg *cur_call, SymReg
+*name, SymReg *value)>
=cut
@@ -1255,7 +1255,7 @@
/*
-=item C<static void add_pcc_named_param(PARROT_INTERP, SymReg *cur_call, SymReg
+=item C<static void add_pcc_named_param(PARROT_INTERP, SymReg *cur_call, SymReg
*name, SymReg *value)>
=cut
@@ -1276,8 +1276,8 @@
/*
-=item C<static void add_pcc_named_return(PARROT_INTERP, SymReg *cur_call, const
-char *name, SymReg *value)>
+=item C<static void add_pcc_named_return(PARROT_INTERP, SymReg *cur_call, SymReg
+*name, SymReg *value)>
=cut
@@ -1297,7 +1297,7 @@
/*
-=item C<static void adv_named_set(PARROT_INTERP, char *name)>
+=item C<static void adv_named_set(PARROT_INTERP, const char *name)>
Sets the name of the current named argument.
@@ -1815,39 +1815,39 @@
static const yytype_uint16 yyrline[] =
{
0, 1125, 1125, 1129, 1130, 1134, 1135, 1136, 1142, 1148,
- 1149, 1150, 1151, 1155, 1156, 1165, 1170, 1177, 1189, 1201,
- 1201, 1210, 1210, 1216, 1216, 1223, 1224, 1228, 1229, 1233,
- 1234, 1235, 1236, 1237, 1238, 1239, 1242, 1242, 1251, 1250,
- 1262, 1266, 1275, 1279, 1283, 1283, 1295, 1297, 1301, 1316,
- 1324, 1329, 1333, 1337, 1328, 1349, 1350, 1351, 1364, 1364,
- 1368, 1382, 1386, 1392, 1401, 1407, 1416, 1422, 1431, 1437,
- 1446, 1454, 1459, 1470, 1473, 1478, 1486, 1487, 1488, 1489,
- 1490, 1501, 1512, 1515, 1517, 1522, 1521, 1554, 1555, 1559,
- 1560, 1564, 1565, 1569, 1570, 1574, 1575, 1576, 1577, 1578,
- 1579, 1580, 1581, 1582, 1583, 1584, 1585, 1586, 1587, 1591,
- 1596, 1600, 1605, 1609, 1613, 1618, 1627, 1628, 1632, 1637,
- 1638, 1646, 1647, 1647, 1662, 1663, 1667, 1668, 1669, 1670,
- 1671, 1672, 1673, 1678, 1678, 1681, 1689, 1689, 1695, 1696,
- 1701, 1709, 1710, 1715, 1723, 1727, 1732, 1731, 1744, 1745,
- 1749, 1750, 1760, 1765, 1775, 1784, 1785, 1797, 1801, 1803,
- 1804, 1805, 1806, 1807, 1811, 1812, 1816, 1817, 1821, 1830,
- 1831, 1842, 1849, 1858, 1868, 1869, 1874, 1875, 1876, 1876,
- 1892, 1897, 1902, 1902, 1909, 1910, 1910, 1916, 1922, 1926,
- 1938, 1939, 1940, 1941, 1942, 1943, 1947, 1948, 1949, 1950,
- 1954, 1967, 1969, 1971, 1973, 1975, 1980, 1983, 1990, 1989,
- 1998, 1999, 2000, 2001, 2009, 2010, 2011, 2015, 2016, 2017,
- 2018, 2019, 2020, 2021, 2022, 2023, 2024, 2025, 2026, 2027,
- 2028, 2029, 2030, 2031, 2032, 2033, 2034, 2035, 2036, 2037,
- 2043, 2042, 2054, 2061, 2062, 2063, 2064, 2065, 2066, 2067,
- 2068, 2069, 2070, 2071, 2072, 2073, 2078, 2089, 2090, 2091,
- 2092, 2098, 2112, 2118, 2124, 2123, 2132, 2133, 2143, 2153,
- 2160, 2165, 2175, 2179, 2180, 2184, 2185, 2188, 2189, 2193,
- 2197, 2207, 2213, 2223, 2228, 2232, 2233, 2237, 2241, 2245,
- 2252, 2256, 2260, 2267, 2268, 2272, 2273, 2274, 2275, 2276,
- 2277, 2281, 2282, 2286, 2287, 2291, 2292, 2296, 2297, 2304,
- 2311, 2312, 2313, 2317, 2318, 2322, 2323, 2327, 2328, 2332,
- 2333, 2337, 2337, 2350, 2350, 2363, 2364, 2372, 2381, 2382,
- 2383, 2384, 2385, 2389, 2390, 2391, 2392
+ 1149, 1150, 1151, 1155, 1156, 1165, 1171, 1179, 1191, 1204,
+ 1204, 1213, 1213, 1220, 1220, 1229, 1230, 1234, 1235, 1239,
+ 1240, 1241, 1242, 1243, 1244, 1245, 1248, 1248, 1257, 1256,
+ 1268, 1272, 1281, 1285, 1289, 1289, 1301, 1303, 1307, 1322,
+ 1330, 1335, 1339, 1343, 1334, 1355, 1356, 1357, 1370, 1370,
+ 1374, 1388, 1392, 1398, 1407, 1413, 1422, 1428, 1437, 1443,
+ 1452, 1460, 1465, 1476, 1479, 1484, 1492, 1493, 1494, 1495,
+ 1496, 1507, 1518, 1521, 1523, 1528, 1527, 1560, 1561, 1565,
+ 1566, 1570, 1571, 1575, 1576, 1580, 1581, 1582, 1583, 1584,
+ 1585, 1586, 1587, 1588, 1589, 1590, 1591, 1592, 1593, 1597,
+ 1602, 1606, 1611, 1615, 1619, 1624, 1633, 1634, 1638, 1643,
+ 1644, 1652, 1653, 1653, 1668, 1669, 1673, 1674, 1675, 1676,
+ 1677, 1678, 1679, 1684, 1684, 1687, 1695, 1695, 1701, 1702,
+ 1707, 1715, 1716, 1721, 1729, 1733, 1738, 1737, 1750, 1751,
+ 1755, 1756, 1766, 1771, 1781, 1790, 1791, 1803, 1807, 1809,
+ 1810, 1811, 1812, 1813, 1817, 1818, 1822, 1823, 1827, 1836,
+ 1837, 1848, 1855, 1864, 1874, 1875, 1880, 1881, 1882, 1882,
+ 1898, 1903, 1908, 1908, 1915, 1916, 1916, 1922, 1928, 1932,
+ 1944, 1945, 1946, 1947, 1948, 1949, 1953, 1954, 1955, 1956,
+ 1960, 1973, 1975, 1977, 1979, 1981, 1986, 1989, 1996, 1995,
+ 2004, 2005, 2006, 2007, 2015, 2016, 2017, 2021, 2022, 2023,
+ 2024, 2025, 2026, 2027, 2028, 2029, 2030, 2031, 2032, 2033,
+ 2034, 2035, 2036, 2037, 2038, 2039, 2040, 2041, 2042, 2043,
+ 2049, 2048, 2060, 2067, 2068, 2069, 2070, 2071, 2072, 2073,
+ 2074, 2075, 2076, 2077, 2078, 2079, 2084, 2095, 2096, 2097,
+ 2098, 2104, 2118, 2124, 2130, 2129, 2138, 2139, 2149, 2159,
+ 2166, 2171, 2181, 2185, 2186, 2190, 2191, 2194, 2195, 2199,
+ 2203, 2213, 2219, 2229, 2234, 2238, 2239, 2243, 2247, 2251,
+ 2258, 2262, 2266, 2273, 2274, 2278, 2279, 2280, 2281, 2282,
+ 2283, 2287, 2288, 2292, 2293, 2297, 2298, 2302, 2303, 2310,
+ 2317, 2318, 2319, 2323, 2324, 2328, 2329, 2333, 2334, 2338,
+ 2339, 2343, 2343, 2356, 2356, 2369, 2370, 2378, 2387, 2388,
+ 2389, 2390, 2391, 2395, 2396, 2397, 2398
};
#endif
@@ -3269,19 +3269,21 @@
#line 1166 "compilers/imcc/imcc.y"
{
IMCC_INFO(interp)->line = atoi((yyvsp[(2) - (5)].s));
+ /* set_filename() frees the STRINGC */
set_filename(interp, (yyvsp[(4) - (5)].s));
}
break;
case 16:
-#line 1171 "compilers/imcc/imcc.y"
+#line 1172 "compilers/imcc/imcc.y"
{
+ /* set_filename() frees the STRINGC */
set_filename(interp, (yyvsp[(2) - (3)].s));
}
break;
case 17:
-#line 1178 "compilers/imcc/imcc.y"
+#line 1180 "compilers/imcc/imcc.y"
{
/* We'll want to store an entry while emitting instructions, so just
* store annotation like it's an instruction. */
@@ -3292,24 +3294,25 @@
break;
case 18:
-#line 1190 "compilers/imcc/imcc.y"
+#line 1192 "compilers/imcc/imcc.y"
{
STRING * const hll_name = Parrot_str_unescape(interp, (yyvsp[(2) - (2)].s) + 1, '"', NULL);
CONTEXT(interp)->current_HLL =
Parrot_register_HLL(interp, hll_name);
IMCC_INFO(interp)->cur_namespace = NULL;
+ mem_sys_free((yyvsp[(2) - (2)].s));
(yyval.t) = 0;
}
break;
case 19:
-#line 1201 "compilers/imcc/imcc.y"
+#line 1204 "compilers/imcc/imcc.y"
{ pesky_global__is_def = 1; }
break;
case 20:
-#line 1202 "compilers/imcc/imcc.y"
+#line 1205 "compilers/imcc/imcc.y"
{
mk_const_ident(interp, (yyvsp[(4) - (6)].s), (yyvsp[(3) - (6)].t), (yyvsp[(6) - (6)].sr), 1);
mem_sys_free((yyvsp[(4) - (6)].s));
@@ -3318,63 +3321,66 @@
break;
case 21:
-#line 1210 "compilers/imcc/imcc.y"
+#line 1213 "compilers/imcc/imcc.y"
{ pesky_global__is_def=1; }
break;
case 22:
-#line 1211 "compilers/imcc/imcc.y"
+#line 1214 "compilers/imcc/imcc.y"
{
(yyval.i) = mk_pmc_const(interp, IMCC_INFO(interp)->cur_unit, (yyvsp[(3) - (6)].s), (yyvsp[(4) - (6)].sr), (yyvsp[(6) - (6)].s));
+ mem_sys_free((yyvsp[(6) - (6)].s));
pesky_global__is_def = 0;
}
break;
case 23:
-#line 1216 "compilers/imcc/imcc.y"
+#line 1220 "compilers/imcc/imcc.y"
{ pesky_global__is_def=1; }
break;
case 24:
-#line 1217 "compilers/imcc/imcc.y"
+#line 1221 "compilers/imcc/imcc.y"
{
(yyval.i) = mk_pmc_const_named(interp, IMCC_INFO(interp)->cur_unit, (yyvsp[(3) - (6)].s), (yyvsp[(4) - (6)].sr), (yyvsp[(6) - (6)].s));
+ mem_sys_free((yyvsp[(3) - (6)].s));
+ mem_sys_free((yyvsp[(6) - (6)].s));
pesky_global__is_def = 0;
}
break;
case 29:
-#line 1233 "compilers/imcc/imcc.y"
+#line 1239 "compilers/imcc/imcc.y"
{ (yyval.i) = 0; }
break;
case 30:
-#line 1234 "compilers/imcc/imcc.y"
+#line 1240 "compilers/imcc/imcc.y"
{ (yyval.i) = 0; }
break;
case 31:
-#line 1235 "compilers/imcc/imcc.y"
+#line 1241 "compilers/imcc/imcc.y"
{ (yyval.i) = 0; }
break;
case 32:
-#line 1236 "compilers/imcc/imcc.y"
+#line 1242 "compilers/imcc/imcc.y"
{ (yyval.i) = 0; }
break;
case 33:
-#line 1237 "compilers/imcc/imcc.y"
+#line 1243 "compilers/imcc/imcc.y"
{ (yyval.i) = (yyvsp[(1) - (1)].i); }
break;
case 36:
-#line 1242 "compilers/imcc/imcc.y"
+#line 1248 "compilers/imcc/imcc.y"
{ clear_state(interp); }
break;
case 37:
-#line 1244 "compilers/imcc/imcc.y"
+#line 1250 "compilers/imcc/imcc.y"
{
(yyval.i) = INS(interp, IMCC_INFO(interp)->cur_unit,
(yyvsp[(2) - (3)].s), 0, IMCC_INFO(interp)->regs,
@@ -3384,7 +3390,7 @@
break;
case 38:
-#line 1251 "compilers/imcc/imcc.y"
+#line 1257 "compilers/imcc/imcc.y"
{
imc_close_unit(interp, IMCC_INFO(interp)->cur_unit);
IMCC_INFO(interp)->cur_unit = imc_open_unit(interp, IMC_PASM);
@@ -3392,7 +3398,7 @@
break;
case 39:
-#line 1256 "compilers/imcc/imcc.y"
+#line 1262 "compilers/imcc/imcc.y"
{
(yyval.i) = iSUBROUTINE(interp,
IMCC_INFO(interp)->cur_unit,
@@ -3402,14 +3408,14 @@
break;
case 40:
-#line 1263 "compilers/imcc/imcc.y"
+#line 1269 "compilers/imcc/imcc.y"
{
(yyval.i) = MK_I(interp, IMCC_INFO(interp)->cur_unit, "null", 1, (yyvsp[(2) - (2)].sr));
}
break;
case 41:
-#line 1267 "compilers/imcc/imcc.y"
+#line 1273 "compilers/imcc/imcc.y"
{
SymReg *r = mk_pasm_reg(interp, (yyvsp[(4) - (4)].s));
SymReg *n = mk_const(interp, (yyvsp[(2) - (4)].s), 'S');
@@ -3421,17 +3427,17 @@
break;
case 42:
-#line 1275 "compilers/imcc/imcc.y"
+#line 1281 "compilers/imcc/imcc.y"
{ (yyval.i) = 0;}
break;
case 44:
-#line 1283 "compilers/imcc/imcc.y"
+#line 1289 "compilers/imcc/imcc.y"
{ IMCC_INFO(interp)->cur_unit = imc_open_unit(interp, IMC_PASM); }
break;
case 45:
-#line 1286 "compilers/imcc/imcc.y"
+#line 1292 "compilers/imcc/imcc.y"
{
/* if (optimizer_level & OPT_PASM)
imc_compile_unit(interp, IMCC_INFO(interp)->cur_unit);
@@ -3442,7 +3448,7 @@
break;
case 48:
-#line 1302 "compilers/imcc/imcc.y"
+#line 1308 "compilers/imcc/imcc.y"
{
int re_open = 0;
(yyval.i) = 0;
@@ -3457,7 +3463,7 @@
break;
case 49:
-#line 1317 "compilers/imcc/imcc.y"
+#line 1323 "compilers/imcc/imcc.y"
{
if (IMCC_INFO(interp)->in_slice)
IMCC_fataly(interp, EXCEPTION_SYNTAX_ERROR,
@@ -3468,26 +3474,26 @@
break;
case 50:
-#line 1324 "compilers/imcc/imcc.y"
+#line 1330 "compilers/imcc/imcc.y"
{ (yyval.sr) = NULL; }
break;
case 51:
-#line 1329 "compilers/imcc/imcc.y"
+#line 1335 "compilers/imcc/imcc.y"
{
IMCC_INFO(interp)->cur_unit = imc_open_unit(interp, IMC_PCCSUB);
}
break;
case 52:
-#line 1333 "compilers/imcc/imcc.y"
+#line 1339 "compilers/imcc/imcc.y"
{
iSUBROUTINE(interp, IMCC_INFO(interp)->cur_unit, (yyvsp[(3) - (3)].sr));
}
break;
case 53:
-#line 1337 "compilers/imcc/imcc.y"
+#line 1343 "compilers/imcc/imcc.y"
{
IMCC_INFO(interp)->cur_call->pcc_sub->pragma = (yyvsp[(5) - (6)].t);
if (!IMCC_INFO(interp)->cur_unit->instructions->symregs[0]->subid) {
@@ -3498,22 +3504,22 @@
break;
case 54:
-#line 1345 "compilers/imcc/imcc.y"
+#line 1351 "compilers/imcc/imcc.y"
{ (yyval.i) = 0; IMCC_INFO(interp)->cur_call = NULL; }
break;
case 55:
-#line 1349 "compilers/imcc/imcc.y"
+#line 1355 "compilers/imcc/imcc.y"
{ (yyval.sr) = 0; }
break;
case 56:
-#line 1350 "compilers/imcc/imcc.y"
+#line 1356 "compilers/imcc/imcc.y"
{ (yyval.sr) = 0; }
break;
case 57:
-#line 1352 "compilers/imcc/imcc.y"
+#line 1358 "compilers/imcc/imcc.y"
{
if (IMCC_INFO(interp)->adv_named_id) {
add_pcc_named_param(interp, IMCC_INFO(interp)->cur_call,
@@ -3526,17 +3532,17 @@
break;
case 58:
-#line 1364 "compilers/imcc/imcc.y"
+#line 1370 "compilers/imcc/imcc.y"
{ pesky_global__is_def=1; }
break;
case 59:
-#line 1364 "compilers/imcc/imcc.y"
+#line 1370 "compilers/imcc/imcc.y"
{ (yyval.sr) = (yyvsp[(3) - (3)].sr); pesky_global__is_def=0; }
break;
case 60:
-#line 1369 "compilers/imcc/imcc.y"
+#line 1375 "compilers/imcc/imcc.y"
{
if ((yyvsp[(3) - (3)].t) & VT_UNIQUE_REG)
(yyval.sr) = mk_ident_ur(interp, (yyvsp[(2) - (3)].s), (yyvsp[(1) - (3)].t));
@@ -3548,12 +3554,12 @@
break;
case 61:
-#line 1382 "compilers/imcc/imcc.y"
+#line 1388 "compilers/imcc/imcc.y"
{ (yyval.t) = 0; }
break;
case 62:
-#line 1387 "compilers/imcc/imcc.y"
+#line 1393 "compilers/imcc/imcc.y"
{
(yyval.t) = 0;
IMCC_INFO(interp)->cur_unit->outer = mk_sub_address_fromc(interp, (yyvsp[(3) - (4)].s));
@@ -3562,7 +3568,7 @@
break;
case 63:
-#line 1393 "compilers/imcc/imcc.y"
+#line 1399 "compilers/imcc/imcc.y"
{
(yyval.t) = 0;
IMCC_INFO(interp)->cur_unit->outer = mk_const(interp, (yyvsp[(3) - (4)].s), 'S');
@@ -3571,7 +3577,7 @@
break;
case 64:
-#line 1402 "compilers/imcc/imcc.y"
+#line 1408 "compilers/imcc/imcc.y"
{
(yyval.t) = P_VTABLE;
IMCC_INFO(interp)->cur_unit->vtable_name = NULL;
@@ -3580,7 +3586,7 @@
break;
case 65:
-#line 1408 "compilers/imcc/imcc.y"
+#line 1414 "compilers/imcc/imcc.y"
{
(yyval.t) = P_VTABLE;
IMCC_INFO(interp)->cur_unit->vtable_name = (yyvsp[(3) - (4)].s);
@@ -3589,7 +3595,7 @@
break;
case 66:
-#line 1417 "compilers/imcc/imcc.y"
+#line 1423 "compilers/imcc/imcc.y"
{
(yyval.t) = P_METHOD;
IMCC_INFO(interp)->cur_unit->method_name = NULL;
@@ -3598,7 +3604,7 @@
break;
case 67:
-#line 1423 "compilers/imcc/imcc.y"
+#line 1429 "compilers/imcc/imcc.y"
{
(yyval.t) = P_METHOD;
IMCC_INFO(interp)->cur_unit->method_name = (yyvsp[(3) - (4)].s);
@@ -3607,7 +3613,7 @@
break;
case 68:
-#line 1432 "compilers/imcc/imcc.y"
+#line 1438 "compilers/imcc/imcc.y"
{
(yyval.t) = 0;
IMCC_INFO(interp)->cur_unit->ns_entry_name = NULL;
@@ -3616,7 +3622,7 @@
break;
case 69:
-#line 1438 "compilers/imcc/imcc.y"
+#line 1444 "compilers/imcc/imcc.y"
{
(yyval.t) = 0;
IMCC_INFO(interp)->cur_unit->ns_entry_name = (yyvsp[(3) - (4)].s);
@@ -3625,7 +3631,7 @@
break;
case 70:
-#line 1447 "compilers/imcc/imcc.y"
+#line 1453 "compilers/imcc/imcc.y"
{
(yyval.t) = 0;
IMCC_INFO(interp)->cur_unit->instance_of = (yyvsp[(3) - (4)].s);
@@ -3633,7 +3639,7 @@
break;
case 71:
-#line 1455 "compilers/imcc/imcc.y"
+#line 1461 "compilers/imcc/imcc.y"
{
(yyval.t) = 0;
IMCC_INFO(interp)->cur_unit->subid = NULL;
@@ -3641,7 +3647,7 @@
break;
case 72:
-#line 1460 "compilers/imcc/imcc.y"
+#line 1466 "compilers/imcc/imcc.y"
{
(yyval.t) = 0;
IMCC_INFO(interp)->cur_unit->subid = mk_const(interp, (yyvsp[(3) - (4)].s), 'S');
@@ -3651,14 +3657,14 @@
break;
case 73:
-#line 1470 "compilers/imcc/imcc.y"
+#line 1476 "compilers/imcc/imcc.y"
{
add_pcc_multi(IMCC_INFO(interp)->cur_call, NULL);
}
break;
case 74:
-#line 1474 "compilers/imcc/imcc.y"
+#line 1480 "compilers/imcc/imcc.y"
{
(yyval.t) = 0;
add_pcc_multi(IMCC_INFO(interp)->cur_call, (yyvsp[(3) - (3)].sr));
@@ -3666,7 +3672,7 @@
break;
case 75:
-#line 1479 "compilers/imcc/imcc.y"
+#line 1485 "compilers/imcc/imcc.y"
{
(yyval.t) = 0;
add_pcc_multi(IMCC_INFO(interp)->cur_call, (yyvsp[(1) - (1)].sr));
@@ -3674,27 +3680,27 @@
break;
case 76:
-#line 1486 "compilers/imcc/imcc.y"
+#line 1492 "compilers/imcc/imcc.y"
{ (yyval.sr) = mk_const(interp, "INTVAL", 'S'); }
break;
case 77:
-#line 1487 "compilers/imcc/imcc.y"
+#line 1493 "compilers/imcc/imcc.y"
{ (yyval.sr) = mk_const(interp, "FLOATVAL", 'S'); }
break;
case 78:
-#line 1488 "compilers/imcc/imcc.y"
+#line 1494 "compilers/imcc/imcc.y"
{ (yyval.sr) = mk_const(interp, "PMC", 'S'); }
break;
case 79:
-#line 1489 "compilers/imcc/imcc.y"
+#line 1495 "compilers/imcc/imcc.y"
{ (yyval.sr) = mk_const(interp, "STRING", 'S'); }
break;
case 80:
-#line 1491 "compilers/imcc/imcc.y"
+#line 1497 "compilers/imcc/imcc.y"
{
SymReg *r;
if (strcmp((yyvsp[(1) - (1)].s), "_") != 0)
@@ -3708,7 +3714,7 @@
break;
case 81:
-#line 1502 "compilers/imcc/imcc.y"
+#line 1508 "compilers/imcc/imcc.y"
{
SymReg *r;
if (strcmp((yyvsp[(1) - (1)].s), "_") != 0)
@@ -3722,12 +3728,12 @@
break;
case 82:
-#line 1512 "compilers/imcc/imcc.y"
+#line 1518 "compilers/imcc/imcc.y"
{ (yyval.sr) = (yyvsp[(2) - (3)].sr); }
break;
case 85:
-#line 1522 "compilers/imcc/imcc.y"
+#line 1528 "compilers/imcc/imcc.y"
{
char name[128];
SymReg *r, *r1;
@@ -3754,82 +3760,82 @@
break;
case 86:
-#line 1550 "compilers/imcc/imcc.y"
+#line 1556 "compilers/imcc/imcc.y"
{ (yyval.i) = 0; IMCC_INFO(interp)->cur_call = NULL; }
break;
case 87:
-#line 1554 "compilers/imcc/imcc.y"
+#line 1560 "compilers/imcc/imcc.y"
{ (yyval.i) = NULL; IMCC_INFO(interp)->cur_call->pcc_sub->label = 0; }
break;
case 88:
-#line 1555 "compilers/imcc/imcc.y"
+#line 1561 "compilers/imcc/imcc.y"
{ (yyval.i) = NULL; IMCC_INFO(interp)->cur_call->pcc_sub->label = 1; }
break;
case 89:
-#line 1559 "compilers/imcc/imcc.y"
+#line 1565 "compilers/imcc/imcc.y"
{ (yyval.i) = NULL; }
break;
case 90:
-#line 1560 "compilers/imcc/imcc.y"
+#line 1566 "compilers/imcc/imcc.y"
{ (yyval.i) = NULL; IMCC_INFO(interp)->cur_call->pcc_sub->object = (yyvsp[(2) - (3)].sr); }
break;
case 91:
-#line 1564 "compilers/imcc/imcc.y"
+#line 1570 "compilers/imcc/imcc.y"
{ (yyval.t) = 0; }
break;
case 93:
-#line 1569 "compilers/imcc/imcc.y"
+#line 1575 "compilers/imcc/imcc.y"
{ (yyval.t) = (yyvsp[(1) - (1)].t); }
break;
case 94:
-#line 1570 "compilers/imcc/imcc.y"
+#line 1576 "compilers/imcc/imcc.y"
{ (yyval.t) = (yyvsp[(1) - (2)].t) | (yyvsp[(2) - (2)].t); }
break;
case 95:
-#line 1574 "compilers/imcc/imcc.y"
+#line 1580 "compilers/imcc/imcc.y"
{ (yyval.t) = P_LOAD; }
break;
case 96:
-#line 1575 "compilers/imcc/imcc.y"
+#line 1581 "compilers/imcc/imcc.y"
{ (yyval.t) = P_INIT; }
break;
case 97:
-#line 1576 "compilers/imcc/imcc.y"
+#line 1582 "compilers/imcc/imcc.y"
{ (yyval.t) = P_MAIN; }
break;
case 98:
-#line 1577 "compilers/imcc/imcc.y"
+#line 1583 "compilers/imcc/imcc.y"
{ (yyval.t) = P_IMMEDIATE; }
break;
case 99:
-#line 1578 "compilers/imcc/imcc.y"
+#line 1584 "compilers/imcc/imcc.y"
{ (yyval.t) = P_POSTCOMP; }
break;
case 100:
-#line 1579 "compilers/imcc/imcc.y"
+#line 1585 "compilers/imcc/imcc.y"
{ (yyval.t) = P_ANON; }
break;
case 101:
-#line 1580 "compilers/imcc/imcc.y"
+#line 1586 "compilers/imcc/imcc.y"
{ (yyval.t) = P_NEED_LEX; }
break;
case 109:
-#line 1592 "compilers/imcc/imcc.y"
+#line 1598 "compilers/imcc/imcc.y"
{
add_pcc_sub(IMCC_INFO(interp)->cur_call, (yyvsp[(2) - (5)].sr));
add_pcc_cc(IMCC_INFO(interp)->cur_call, (yyvsp[(4) - (5)].sr));
@@ -3837,14 +3843,14 @@
break;
case 110:
-#line 1597 "compilers/imcc/imcc.y"
+#line 1603 "compilers/imcc/imcc.y"
{
add_pcc_sub(IMCC_INFO(interp)->cur_call, (yyvsp[(2) - (3)].sr));
}
break;
case 111:
-#line 1601 "compilers/imcc/imcc.y"
+#line 1607 "compilers/imcc/imcc.y"
{
add_pcc_sub(IMCC_INFO(interp)->cur_call, (yyvsp[(2) - (3)].sr));
IMCC_INFO(interp)->cur_call->pcc_sub->flags |= isNCI;
@@ -3852,21 +3858,21 @@
break;
case 112:
-#line 1606 "compilers/imcc/imcc.y"
+#line 1612 "compilers/imcc/imcc.y"
{
add_pcc_sub(IMCC_INFO(interp)->cur_call, (yyvsp[(2) - (3)].sr));
}
break;
case 113:
-#line 1610 "compilers/imcc/imcc.y"
+#line 1616 "compilers/imcc/imcc.y"
{
add_pcc_sub(IMCC_INFO(interp)->cur_call, mk_const(interp, (yyvsp[(2) - (3)].s), 'S'));
}
break;
case 114:
-#line 1614 "compilers/imcc/imcc.y"
+#line 1620 "compilers/imcc/imcc.y"
{
add_pcc_sub(IMCC_INFO(interp)->cur_call, (yyvsp[(2) - (5)].sr));
add_pcc_cc(IMCC_INFO(interp)->cur_call, (yyvsp[(4) - (5)].sr));
@@ -3874,7 +3880,7 @@
break;
case 115:
-#line 1619 "compilers/imcc/imcc.y"
+#line 1625 "compilers/imcc/imcc.y"
{
add_pcc_sub(IMCC_INFO(interp)->cur_call, mk_const(interp, (yyvsp[(2) - (5)].s), 'S'));
add_pcc_cc(IMCC_INFO(interp)->cur_call, (yyvsp[(4) - (5)].sr));
@@ -3882,27 +3888,27 @@
break;
case 116:
-#line 1627 "compilers/imcc/imcc.y"
+#line 1633 "compilers/imcc/imcc.y"
{ (yyval.sr) = 0; }
break;
case 117:
-#line 1628 "compilers/imcc/imcc.y"
+#line 1634 "compilers/imcc/imcc.y"
{ add_pcc_arg(IMCC_INFO(interp)->cur_call, (yyvsp[(2) - (3)].sr)); }
break;
case 118:
-#line 1632 "compilers/imcc/imcc.y"
+#line 1638 "compilers/imcc/imcc.y"
{ (yyval.sr) = (yyvsp[(2) - (2)].sr); }
break;
case 119:
-#line 1637 "compilers/imcc/imcc.y"
+#line 1643 "compilers/imcc/imcc.y"
{ (yyval.sr) = 0; }
break;
case 120:
-#line 1639 "compilers/imcc/imcc.y"
+#line 1645 "compilers/imcc/imcc.y"
{
if ((yyvsp[(2) - (3)].sr))
add_pcc_result(IMCC_INFO(interp)->cur_call, (yyvsp[(2) - (3)].sr));
@@ -3910,17 +3916,17 @@
break;
case 121:
-#line 1646 "compilers/imcc/imcc.y"
+#line 1652 "compilers/imcc/imcc.y"
{ (yyval.sr) = (yyvsp[(2) - (3)].sr); (yyval.sr)->type |= (yyvsp[(3) - (3)].t); }
break;
case 122:
-#line 1647 "compilers/imcc/imcc.y"
+#line 1653 "compilers/imcc/imcc.y"
{ pesky_global__is_def=1; }
break;
case 123:
-#line 1648 "compilers/imcc/imcc.y"
+#line 1654 "compilers/imcc/imcc.y"
{
IdList *l = (yyvsp[(4) - (4)].idlist);
SymReg *ignored;
@@ -3935,62 +3941,62 @@
break;
case 124:
-#line 1662 "compilers/imcc/imcc.y"
+#line 1668 "compilers/imcc/imcc.y"
{ (yyval.t) = 0; }
break;
case 125:
-#line 1663 "compilers/imcc/imcc.y"
+#line 1669 "compilers/imcc/imcc.y"
{ (yyval.t) = (yyvsp[(1) - (2)].t) | (yyvsp[(2) - (2)].t); }
break;
case 126:
-#line 1667 "compilers/imcc/imcc.y"
+#line 1673 "compilers/imcc/imcc.y"
{ (yyval.t) = VT_FLAT; }
break;
case 127:
-#line 1668 "compilers/imcc/imcc.y"
+#line 1674 "compilers/imcc/imcc.y"
{ (yyval.t) = VT_OPTIONAL; }
break;
case 128:
-#line 1669 "compilers/imcc/imcc.y"
+#line 1675 "compilers/imcc/imcc.y"
{ (yyval.t) = VT_OPT_FLAG; }
break;
case 129:
-#line 1670 "compilers/imcc/imcc.y"
+#line 1676 "compilers/imcc/imcc.y"
{ (yyval.t) = VT_NAMED; }
break;
case 130:
-#line 1671 "compilers/imcc/imcc.y"
+#line 1677 "compilers/imcc/imcc.y"
{ adv_named_set(interp, (yyvsp[(3) - (4)].s)); (yyval.t) = 0; }
break;
case 131:
-#line 1672 "compilers/imcc/imcc.y"
+#line 1678 "compilers/imcc/imcc.y"
{ adv_named_set_u(interp, (yyvsp[(3) - (4)].s)); (yyval.t) = 0; }
break;
case 132:
-#line 1673 "compilers/imcc/imcc.y"
+#line 1679 "compilers/imcc/imcc.y"
{ (yyval.t) = VT_UNIQUE_REG; }
break;
case 133:
-#line 1678 "compilers/imcc/imcc.y"
+#line 1684 "compilers/imcc/imcc.y"
{ begin_return_or_yield(interp, 0); }
break;
case 134:
-#line 1680 "compilers/imcc/imcc.y"
+#line 1686 "compilers/imcc/imcc.y"
{ (yyval.i) = 0; IMCC_INFO(interp)->asm_state = AsmDefault; }
break;
case 135:
-#line 1682 "compilers/imcc/imcc.y"
+#line 1688 "compilers/imcc/imcc.y"
{
IMCC_INFO(interp)->asm_state = AsmDefault;
(yyval.i) = 0;
@@ -3998,22 +4004,22 @@
break;
case 136:
-#line 1689 "compilers/imcc/imcc.y"
+#line 1695 "compilers/imcc/imcc.y"
{ begin_return_or_yield(interp, 1); }
break;
case 137:
-#line 1691 "compilers/imcc/imcc.y"
+#line 1697 "compilers/imcc/imcc.y"
{ (yyval.i) = 0; IMCC_INFO(interp)->asm_state = AsmDefault; }
break;
case 138:
-#line 1695 "compilers/imcc/imcc.y"
+#line 1701 "compilers/imcc/imcc.y"
{ (yyval.sr) = 0; }
break;
case 139:
-#line 1697 "compilers/imcc/imcc.y"
+#line 1703 "compilers/imcc/imcc.y"
{
if ((yyvsp[(1) - (2)].sr))
add_pcc_result(IMCC_INFO(interp)->sr_return, (yyvsp[(1) - (2)].sr));
@@ -4021,7 +4027,7 @@
break;
case 140:
-#line 1702 "compilers/imcc/imcc.y"
+#line 1708 "compilers/imcc/imcc.y"
{
if ((yyvsp[(2) - (3)].sr))
add_pcc_result(IMCC_INFO(interp)->sr_return, (yyvsp[(2) - (3)].sr));
@@ -4029,12 +4035,12 @@
break;
case 141:
-#line 1709 "compilers/imcc/imcc.y"
+#line 1715 "compilers/imcc/imcc.y"
{ (yyval.sr) = 0; }
break;
case 142:
-#line 1711 "compilers/imcc/imcc.y"
+#line 1717 "compilers/imcc/imcc.y"
{
if ((yyvsp[(1) - (2)].sr))
add_pcc_result(IMCC_INFO(interp)->sr_return, (yyvsp[(1) - (2)].sr));
@@ -4042,7 +4048,7 @@
break;
case 143:
-#line 1716 "compilers/imcc/imcc.y"
+#line 1722 "compilers/imcc/imcc.y"
{
if ((yyvsp[(2) - (3)].sr))
add_pcc_result(IMCC_INFO(interp)->sr_return, (yyvsp[(2) - (3)].sr));
@@ -4050,17 +4056,17 @@
break;
case 144:
-#line 1723 "compilers/imcc/imcc.y"
+#line 1729 "compilers/imcc/imcc.y"
{ (yyval.sr) = (yyvsp[(2) - (3)].sr); (yyval.sr)->type |= (yyvsp[(3) - (3)].t); }
break;
case 145:
-#line 1727 "compilers/imcc/imcc.y"
+#line 1733 "compilers/imcc/imcc.y"
{ (yyval.sr) = (yyvsp[(2) - (3)].sr); (yyval.sr)->type |= (yyvsp[(3) - (3)].t); }
break;
case 146:
-#line 1732 "compilers/imcc/imcc.y"
+#line 1738 "compilers/imcc/imcc.y"
{
if (IMCC_INFO(interp)->asm_state == AsmDefault)
begin_return_or_yield(interp, (yyvsp[(1) - (2)].t));
@@ -4068,7 +4074,7 @@
break;
case 147:
-#line 1737 "compilers/imcc/imcc.y"
+#line 1743 "compilers/imcc/imcc.y"
{
IMCC_INFO(interp)->asm_state = AsmDefault;
(yyval.t) = 0;
@@ -4076,22 +4082,22 @@
break;
case 148:
-#line 1744 "compilers/imcc/imcc.y"
+#line 1750 "compilers/imcc/imcc.y"
{ (yyval.t) = 0; }
break;
case 149:
-#line 1745 "compilers/imcc/imcc.y"
+#line 1751 "compilers/imcc/imcc.y"
{ (yyval.t) = 1; }
break;
case 150:
-#line 1749 "compilers/imcc/imcc.y"
+#line 1755 "compilers/imcc/imcc.y"
{ (yyval.i) = 0; }
break;
case 151:
-#line 1751 "compilers/imcc/imcc.y"
+#line 1757 "compilers/imcc/imcc.y"
{
if (IMCC_INFO(interp)->adv_named_id) {
add_pcc_named_return(interp, IMCC_INFO(interp)->sr_return,
@@ -4104,7 +4110,7 @@
break;
case 152:
-#line 1761 "compilers/imcc/imcc.y"
+#line 1767 "compilers/imcc/imcc.y"
{
SymReg *name = mk_const(interp, (yyvsp[(1) - (3)].s), 'S');
add_pcc_named_return(interp, IMCC_INFO(interp)->sr_return, name, (yyvsp[(3) - (3)].sr));
@@ -4112,7 +4118,7 @@
break;
case 153:
-#line 1766 "compilers/imcc/imcc.y"
+#line 1772 "compilers/imcc/imcc.y"
{
if (IMCC_INFO(interp)->adv_named_id) {
add_pcc_named_return(interp, IMCC_INFO(interp)->sr_return,
@@ -4125,7 +4131,7 @@
break;
case 154:
-#line 1776 "compilers/imcc/imcc.y"
+#line 1782 "compilers/imcc/imcc.y"
{
SymReg *name = mk_const(interp, (yyvsp[(3) - (5)].s), 'S');
add_pcc_named_return(interp, IMCC_INFO(interp)->sr_return, name, (yyvsp[(5) - (5)].sr));
@@ -4133,59 +4139,59 @@
break;
case 157:
-#line 1797 "compilers/imcc/imcc.y"
+#line 1803 "compilers/imcc/imcc.y"
{ clear_state(interp); }
break;
case 158:
-#line 1802 "compilers/imcc/imcc.y"
+#line 1808 "compilers/imcc/imcc.y"
{ (yyval.i) = (yyvsp[(2) - (2)].i); }
break;
case 159:
-#line 1803 "compilers/imcc/imcc.y"
+#line 1809 "compilers/imcc/imcc.y"
{ (yyval.i) = 0; }
break;
case 160:
-#line 1804 "compilers/imcc/imcc.y"
+#line 1810 "compilers/imcc/imcc.y"
{ (yyval.i) = 0; }
break;
case 161:
-#line 1805 "compilers/imcc/imcc.y"
+#line 1811 "compilers/imcc/imcc.y"
{ (yyval.i) = 0; }
break;
case 162:
-#line 1806 "compilers/imcc/imcc.y"
+#line 1812 "compilers/imcc/imcc.y"
{ (yyval.i) = 0; }
break;
case 163:
-#line 1807 "compilers/imcc/imcc.y"
+#line 1813 "compilers/imcc/imcc.y"
{ (yyval.i) = (yyvsp[(1) - (1)].i); }
break;
case 164:
-#line 1811 "compilers/imcc/imcc.y"
+#line 1817 "compilers/imcc/imcc.y"
{ (yyval.i) = NULL; }
break;
case 168:
-#line 1822 "compilers/imcc/imcc.y"
+#line 1828 "compilers/imcc/imcc.y"
{
(yyval.i) = iLABEL(interp, IMCC_INFO(interp)->cur_unit, mk_local_label(interp, (yyvsp[(1) - (1)].s)));
}
break;
case 169:
-#line 1830 "compilers/imcc/imcc.y"
+#line 1836 "compilers/imcc/imcc.y"
{ (yyval.i) = (yyvsp[(2) - (3)].i); }
break;
case 170:
-#line 1832 "compilers/imcc/imcc.y"
+#line 1838 "compilers/imcc/imcc.y"
{
if (yynerrs >= PARROT_MAX_RECOVER_ERRORS) {
IMCC_warning(interp, "Too many errors. Correct some first.\n");
@@ -4196,7 +4202,7 @@
break;
case 171:
-#line 1843 "compilers/imcc/imcc.y"
+#line 1849 "compilers/imcc/imcc.y"
{
IdList* l = (yyvsp[(1) - (1)].idlist);
l->next = NULL;
@@ -4205,7 +4211,7 @@
break;
case 172:
-#line 1850 "compilers/imcc/imcc.y"
+#line 1856 "compilers/imcc/imcc.y"
{
IdList* l = (yyvsp[(3) - (3)].idlist);
l->next = (yyvsp[(1) - (3)].idlist);
@@ -4214,7 +4220,7 @@
break;
case 173:
-#line 1859 "compilers/imcc/imcc.y"
+#line 1865 "compilers/imcc/imcc.y"
{
IdList* const l = mem_allocate_n_zeroed_typed(1, IdList);
l->id = (yyvsp[(1) - (2)].s);
@@ -4224,22 +4230,22 @@
break;
case 174:
-#line 1868 "compilers/imcc/imcc.y"
+#line 1874 "compilers/imcc/imcc.y"
{ (yyval.t) = 0; }
break;
case 175:
-#line 1869 "compilers/imcc/imcc.y"
+#line 1875 "compilers/imcc/imcc.y"
{ (yyval.t) = 1; }
break;
case 178:
-#line 1876 "compilers/imcc/imcc.y"
+#line 1882 "compilers/imcc/imcc.y"
{ pesky_global__is_def=1; }
break;
case 179:
-#line 1877 "compilers/imcc/imcc.y"
+#line 1883 "compilers/imcc/imcc.y"
{
IdList *l = (yyvsp[(4) - (4)].idlist);
while (l) {
@@ -4258,7 +4264,7 @@
break;
case 180:
-#line 1893 "compilers/imcc/imcc.y"
+#line 1899 "compilers/imcc/imcc.y"
{
SymReg *n = mk_const(interp, (yyvsp[(2) - (4)].s), 'S');
set_lexical(interp, (yyvsp[(4) - (4)].sr), n); (yyval.i) = 0;
@@ -4266,7 +4272,7 @@
break;
case 181:
-#line 1898 "compilers/imcc/imcc.y"
+#line 1904 "compilers/imcc/imcc.y"
{
SymReg *n = mk_const(interp, (yyvsp[(2) - (4)].s), 'U');
set_lexical(interp, (yyvsp[(4) - (4)].sr), n); (yyval.i) = 0;
@@ -4274,12 +4280,12 @@
break;
case 182:
-#line 1902 "compilers/imcc/imcc.y"
+#line 1908 "compilers/imcc/imcc.y"
{ pesky_global__is_def=1; }
break;
case 183:
-#line 1903 "compilers/imcc/imcc.y"
+#line 1909 "compilers/imcc/imcc.y"
{
mk_const_ident(interp, (yyvsp[(4) - (6)].s), (yyvsp[(3) - (6)].t), (yyvsp[(6) - (6)].sr), 0);
pesky_global__is_def=0;
@@ -4288,12 +4294,12 @@
break;
case 185:
-#line 1910 "compilers/imcc/imcc.y"
+#line 1916 "compilers/imcc/imcc.y"
{ pesky_global__is_def=1; }
break;
case 186:
-#line 1911 "compilers/imcc/imcc.y"
+#line 1917 "compilers/imcc/imcc.y"
{
mk_const_ident(interp, (yyvsp[(4) - (6)].s), (yyvsp[(3) - (6)].t), (yyvsp[(6) - (6)].sr), 1);
pesky_global__is_def=0;
@@ -4302,7 +4308,7 @@
break;
case 187:
-#line 1917 "compilers/imcc/imcc.y"
+#line 1923 "compilers/imcc/imcc.y"
{
(yyval.i) = NULL;
IMCC_INFO(interp)->cur_call->pcc_sub->flags |= isTAIL_CALL;
@@ -4311,14 +4317,14 @@
break;
case 188:
-#line 1923 "compilers/imcc/imcc.y"
+#line 1929 "compilers/imcc/imcc.y"
{
(yyval.i) = MK_I(interp, IMCC_INFO(interp)->cur_unit, "branch", 1, (yyvsp[(2) - (2)].sr));
}
break;
case 189:
-#line 1927 "compilers/imcc/imcc.y"
+#line 1933 "compilers/imcc/imcc.y"
{
(yyval.i) = INS(interp,
IMCC_INFO(interp)->cur_unit,
@@ -4333,47 +4339,47 @@
break;
case 190:
-#line 1938 "compilers/imcc/imcc.y"
+#line 1944 "compilers/imcc/imcc.y"
{ (yyval.i) = MK_I(interp, IMCC_INFO(interp)->cur_unit, "null", 1, (yyvsp[(2) - (2)].sr)); }
break;
case 191:
-#line 1939 "compilers/imcc/imcc.y"
+#line 1945 "compilers/imcc/imcc.y"
{ (yyval.i) = 0; IMCC_INFO(interp)->cur_call = NULL; }
break;
case 192:
-#line 1940 "compilers/imcc/imcc.y"
+#line 1946 "compilers/imcc/imcc.y"
{ (yyval.i) = 0; }
break;
case 195:
-#line 1943 "compilers/imcc/imcc.y"
+#line 1949 "compilers/imcc/imcc.y"
{ (yyval.i) = 0;}
break;
case 196:
-#line 1947 "compilers/imcc/imcc.y"
+#line 1953 "compilers/imcc/imcc.y"
{ (yyval.t) = 'I'; }
break;
case 197:
-#line 1948 "compilers/imcc/imcc.y"
+#line 1954 "compilers/imcc/imcc.y"
{ (yyval.t) = 'N'; }
break;
case 198:
-#line 1949 "compilers/imcc/imcc.y"
+#line 1955 "compilers/imcc/imcc.y"
{ (yyval.t) = 'S'; }
break;
case 199:
-#line 1950 "compilers/imcc/imcc.y"
+#line 1956 "compilers/imcc/imcc.y"
{ (yyval.t) = 'P'; }
break;
case 200:
-#line 1955 "compilers/imcc/imcc.y"
+#line 1961 "compilers/imcc/imcc.y"
{
/* there'd normally be a str_dup() here, but the lexer already
* copied the string, so it's safe to use directly */
@@ -4386,37 +4392,37 @@
break;
case 201:
-#line 1968 "compilers/imcc/imcc.y"
+#line 1974 "compilers/imcc/imcc.y"
{ (yyval.i) = MK_I(interp, IMCC_INFO(interp)->cur_unit, "set", 2, (yyvsp[(1) - (3)].sr), (yyvsp[(3) - (3)].sr)); }
break;
case 202:
-#line 1970 "compilers/imcc/imcc.y"
+#line 1976 "compilers/imcc/imcc.y"
{ (yyval.i) = MK_I(interp, IMCC_INFO(interp)->cur_unit, (yyvsp[(3) - (4)].s), 2, (yyvsp[(1) - (4)].sr), (yyvsp[(4) - (4)].sr)); }
break;
case 203:
-#line 1972 "compilers/imcc/imcc.y"
+#line 1978 "compilers/imcc/imcc.y"
{ (yyval.i) = MK_I(interp, IMCC_INFO(interp)->cur_unit, (yyvsp[(4) - (5)].s), 3, (yyvsp[(1) - (5)].sr), (yyvsp[(3) - (5)].sr), (yyvsp[(5) - (5)].sr)); }
break;
case 204:
-#line 1974 "compilers/imcc/imcc.y"
+#line 1980 "compilers/imcc/imcc.y"
{ (yyval.i) = iINDEXFETCH(interp, IMCC_INFO(interp)->cur_unit, (yyvsp[(1) - (6)].sr), (yyvsp[(3) - (6)].sr), (yyvsp[(5) - (6)].sr)); }
break;
case 205:
-#line 1976 "compilers/imcc/imcc.y"
+#line 1982 "compilers/imcc/imcc.y"
{ (yyval.i) = iINDEXSET(interp, IMCC_INFO(interp)->cur_unit, (yyvsp[(1) - (6)].sr), (yyvsp[(3) - (6)].sr), (yyvsp[(6) - (6)].sr)); }
break;
case 206:
-#line 1981 "compilers/imcc/imcc.y"
+#line 1987 "compilers/imcc/imcc.y"
{ (yyval.i) = iNEW(interp, IMCC_INFO(interp)->cur_unit, (yyvsp[(1) - (7)].sr), (yyvsp[(4) - (7)].s), (yyvsp[(6) - (7)].sr), 1); }
break;
case 207:
-#line 1984 "compilers/imcc/imcc.y"
+#line 1990 "compilers/imcc/imcc.y"
{
add_pcc_result((yyvsp[(3) - (3)].i)->symregs[0], (yyvsp[(1) - (3)].sr));
IMCC_INFO(interp)->cur_call = NULL;
@@ -4425,14 +4431,14 @@
break;
case 208:
-#line 1990 "compilers/imcc/imcc.y"
+#line 1996 "compilers/imcc/imcc.y"
{
(yyval.i) = IMCC_create_itcall_label(interp);
}
break;
case 209:
-#line 1994 "compilers/imcc/imcc.y"
+#line 2000 "compilers/imcc/imcc.y"
{
IMCC_itcall_sub(interp, (yyvsp[(6) - (9)].sr));
IMCC_INFO(interp)->cur_call = NULL;
@@ -4440,144 +4446,144 @@
break;
case 213:
-#line 2002 "compilers/imcc/imcc.y"
+#line 2008 "compilers/imcc/imcc.y"
{
(yyval.i) = MK_I(interp, IMCC_INFO(interp)->cur_unit, "null", 1, (yyvsp[(1) - (3)].sr));
}
break;
case 214:
-#line 2009 "compilers/imcc/imcc.y"
+#line 2015 "compilers/imcc/imcc.y"
{ (yyval.s) = (char *)"not"; }
break;
case 215:
-#line 2010 "compilers/imcc/imcc.y"
+#line 2016 "compilers/imcc/imcc.y"
{ (yyval.s) = (char *)"bnot"; }
break;
case 216:
-#line 2011 "compilers/imcc/imcc.y"
+#line 2017 "compilers/imcc/imcc.y"
{ (yyval.s) = (char *)"neg"; }
break;
case 217:
-#line 2015 "compilers/imcc/imcc.y"
+#line 2021 "compilers/imcc/imcc.y"
{ (yyval.s) = (char *)"sub"; }
break;
case 218:
-#line 2016 "compilers/imcc/imcc.y"
+#line 2022 "compilers/imcc/imcc.y"
{ (yyval.s) = (char *)"add"; }
break;
case 219:
-#line 2017 "compilers/imcc/imcc.y"
+#line 2023 "compilers/imcc/imcc.y"
{ (yyval.s) = (char *)"mul"; }
break;
case 220:
-#line 2018 "compilers/imcc/imcc.y"
+#line 2024 "compilers/imcc/imcc.y"
{ (yyval.s) = (char *)"div"; }
break;
case 221:
-#line 2019 "compilers/imcc/imcc.y"
+#line 2025 "compilers/imcc/imcc.y"
{ (yyval.s) = (char *)"mod"; }
break;
case 222:
-#line 2020 "compilers/imcc/imcc.y"
+#line 2026 "compilers/imcc/imcc.y"
{ (yyval.s) = (char *)"fdiv"; }
break;
case 223:
-#line 2021 "compilers/imcc/imcc.y"
+#line 2027 "compilers/imcc/imcc.y"
{ (yyval.s) = (char *)"pow"; }
break;
case 224:
-#line 2022 "compilers/imcc/imcc.y"
+#line 2028 "compilers/imcc/imcc.y"
{ (yyval.s) = (char *)"concat"; }
break;
case 225:
-#line 2023 "compilers/imcc/imcc.y"
+#line 2029 "compilers/imcc/imcc.y"
{ (yyval.s) = (char *)"iseq"; }
break;
case 226:
-#line 2024 "compilers/imcc/imcc.y"
+#line 2030 "compilers/imcc/imcc.y"
{ (yyval.s) = (char *)"isne"; }
break;
case 227:
-#line 2025 "compilers/imcc/imcc.y"
+#line 2031 "compilers/imcc/imcc.y"
{ (yyval.s) = (char *)"isgt"; }
break;
case 228:
-#line 2026 "compilers/imcc/imcc.y"
+#line 2032 "compilers/imcc/imcc.y"
{ (yyval.s) = (char *)"isge"; }
break;
case 229:
-#line 2027 "compilers/imcc/imcc.y"
+#line 2033 "compilers/imcc/imcc.y"
{ (yyval.s) = (char *)"islt"; }
break;
case 230:
-#line 2028 "compilers/imcc/imcc.y"
+#line 2034 "compilers/imcc/imcc.y"
{ (yyval.s) = (char *)"isle"; }
break;
case 231:
-#line 2029 "compilers/imcc/imcc.y"
+#line 2035 "compilers/imcc/imcc.y"
{ (yyval.s) = (char *)"shl"; }
break;
case 232:
-#line 2030 "compilers/imcc/imcc.y"
+#line 2036 "compilers/imcc/imcc.y"
{ (yyval.s) = (char *)"shr"; }
break;
case 233:
-#line 2031 "compilers/imcc/imcc.y"
+#line 2037 "compilers/imcc/imcc.y"
{ (yyval.s) = (char *)"lsr"; }
break;
case 234:
-#line 2032 "compilers/imcc/imcc.y"
+#line 2038 "compilers/imcc/imcc.y"
{ (yyval.s) = (char *)"and"; }
break;
case 235:
-#line 2033 "compilers/imcc/imcc.y"
+#line 2039 "compilers/imcc/imcc.y"
{ (yyval.s) = (char *)"or"; }
break;
case 236:
-#line 2034 "compilers/imcc/imcc.y"
+#line 2040 "compilers/imcc/imcc.y"
{ (yyval.s) = (char *)"xor"; }
break;
case 237:
-#line 2035 "compilers/imcc/imcc.y"
+#line 2041 "compilers/imcc/imcc.y"
{ (yyval.s) = (char *)"band"; }
break;
case 238:
-#line 2036 "compilers/imcc/imcc.y"
+#line 2042 "compilers/imcc/imcc.y"
{ (yyval.s) = (char *)"bor"; }
break;
case 239:
-#line 2037 "compilers/imcc/imcc.y"
+#line 2043 "compilers/imcc/imcc.y"
{ (yyval.s) = (char *)"bxor"; }
break;
case 240:
-#line 2043 "compilers/imcc/imcc.y"
+#line 2049 "compilers/imcc/imcc.y"
{
(yyval.i) = IMCC_create_itcall_label(interp);
(yyval.i)->type &= ~ITCALL;
@@ -4586,84 +4592,84 @@
break;
case 241:
-#line 2048 "compilers/imcc/imcc.y"
+#line 2054 "compilers/imcc/imcc.y"
{ (yyval.i) = 0; }
break;
case 242:
-#line 2055 "compilers/imcc/imcc.y"
+#line 2061 "compilers/imcc/imcc.y"
{
(yyval.i) = MK_I(interp, IMCC_INFO(interp)->cur_unit, (yyvsp[(2) - (3)].s), 2, (yyvsp[(1) - (3)].sr), (yyvsp[(3) - (3)].sr));
}
break;
case 243:
-#line 2061 "compilers/imcc/imcc.y"
+#line 2067 "compilers/imcc/imcc.y"
{ (yyval.s) = (char *)"add"; }
break;
case 244:
-#line 2062 "compilers/imcc/imcc.y"
+#line 2068 "compilers/imcc/imcc.y"
{ (yyval.s) = (char *)"sub"; }
break;
case 245:
-#line 2063 "compilers/imcc/imcc.y"
+#line 2069 "compilers/imcc/imcc.y"
{ (yyval.s) = (char *)"mul"; }
break;
case 246:
-#line 2064 "compilers/imcc/imcc.y"
+#line 2070 "compilers/imcc/imcc.y"
{ (yyval.s) = (char *)"div"; }
break;
case 247:
-#line 2065 "compilers/imcc/imcc.y"
+#line 2071 "compilers/imcc/imcc.y"
{ (yyval.s) = (char *)"mod"; }
break;
case 248:
-#line 2066 "compilers/imcc/imcc.y"
+#line 2072 "compilers/imcc/imcc.y"
{ (yyval.s) = (char *)"fdiv"; }
break;
case 249:
-#line 2067 "compilers/imcc/imcc.y"
+#line 2073 "compilers/imcc/imcc.y"
{ (yyval.s) = (char *)"concat"; }
break;
case 250:
-#line 2068 "compilers/imcc/imcc.y"
+#line 2074 "compilers/imcc/imcc.y"
{ (yyval.s) = (char *)"band"; }
break;
case 251:
-#line 2069 "compilers/imcc/imcc.y"
+#line 2075 "compilers/imcc/imcc.y"
{ (yyval.s) = (char *)"bor"; }
break;
case 252:
-#line 2070 "compilers/imcc/imcc.y"
+#line 2076 "compilers/imcc/imcc.y"
{ (yyval.s) = (char *)"bxor"; }
break;
case 253:
-#line 2071 "compilers/imcc/imcc.y"
+#line 2077 "compilers/imcc/imcc.y"
{ (yyval.s) = (char *)"shr"; }
break;
case 254:
-#line 2072 "compilers/imcc/imcc.y"
+#line 2078 "compilers/imcc/imcc.y"
{ (yyval.s) = (char *)"shl"; }
break;
case 255:
-#line 2073 "compilers/imcc/imcc.y"
+#line 2079 "compilers/imcc/imcc.y"
{ (yyval.s) = (char *)"lsr"; }
break;
case 256:
-#line 2079 "compilers/imcc/imcc.y"
+#line 2085 "compilers/imcc/imcc.y"
{
(yyval.i) = func_ins(interp, IMCC_INFO(interp)->cur_unit, (yyvsp[(1) - (4)].sr), (yyvsp[(3) - (4)].s),
IMCC_INFO(interp) -> regs,
@@ -4674,22 +4680,22 @@
break;
case 257:
-#line 2089 "compilers/imcc/imcc.y"
+#line 2095 "compilers/imcc/imcc.y"
{ (yyval.sr) = mk_sub_address(interp, (yyvsp[(1) - (1)].s)); mem_sys_free((yyvsp[(1) - (1)].s)); }
break;
case 258:
-#line 2090 "compilers/imcc/imcc.y"
+#line 2096 "compilers/imcc/imcc.y"
{ (yyval.sr) = mk_sub_address_fromc(interp, (yyvsp[(1) - (1)].s)); mem_sys_free((yyvsp[(1) - (1)].s)); }
break;
case 259:
-#line 2091 "compilers/imcc/imcc.y"
+#line 2097 "compilers/imcc/imcc.y"
{ (yyval.sr) = mk_sub_address_u(interp, (yyvsp[(1) - (1)].s)); mem_sys_free((yyvsp[(1) - (1)].s)); }
break;
case 260:
-#line 2093 "compilers/imcc/imcc.y"
+#line 2099 "compilers/imcc/imcc.y"
{
(yyval.sr) = (yyvsp[(1) - (1)].sr);
if ((yyvsp[(1) - (1)].sr)->set != 'P')
@@ -4698,7 +4704,7 @@
break;
case 261:
-#line 2099 "compilers/imcc/imcc.y"
+#line 2105 "compilers/imcc/imcc.y"
{
/* disallow bareword method names; SREG name constants are fine */
char *name = (yyvsp[(3) - (3)].sr)->name;
@@ -4715,7 +4721,7 @@
break;
case 262:
-#line 2113 "compilers/imcc/imcc.y"
+#line 2119 "compilers/imcc/imcc.y"
{
IMCC_INFO(interp)->cur_obj = (yyvsp[(1) - (3)].sr);
(yyval.sr) = mk_const(interp, (yyvsp[(3) - (3)].s), 'S');
@@ -4724,12 +4730,12 @@
break;
case 263:
-#line 2118 "compilers/imcc/imcc.y"
+#line 2124 "compilers/imcc/imcc.y"
{ IMCC_INFO(interp)->cur_obj = (yyvsp[(1) - (3)].sr); (yyval.sr) = (yyvsp[(3) - (3)].sr); }
break;
case 264:
-#line 2124 "compilers/imcc/imcc.y"
+#line 2130 "compilers/imcc/imcc.y"
{
(yyval.i) = IMCC_create_itcall_label(interp);
IMCC_itcall_sub(interp, (yyvsp[(1) - (1)].sr));
@@ -4737,17 +4743,17 @@
break;
case 265:
-#line 2128 "compilers/imcc/imcc.y"
+#line 2134 "compilers/imcc/imcc.y"
{ (yyval.i) = (yyvsp[(2) - (5)].i); }
break;
case 266:
-#line 2132 "compilers/imcc/imcc.y"
+#line 2138 "compilers/imcc/imcc.y"
{ (yyval.sr) = 0; }
break;
case 267:
-#line 2134 "compilers/imcc/imcc.y"
+#line 2140 "compilers/imcc/imcc.y"
{
(yyval.sr) = 0;
if (IMCC_INFO(interp)->adv_named_id) {
@@ -4760,7 +4766,7 @@
break;
case 268:
-#line 2144 "compilers/imcc/imcc.y"
+#line 2150 "compilers/imcc/imcc.y"
{
(yyval.sr) = 0;
if (IMCC_INFO(interp)->adv_named_id) {
@@ -4773,7 +4779,7 @@
break;
case 269:
-#line 2154 "compilers/imcc/imcc.y"
+#line 2160 "compilers/imcc/imcc.y"
{
(yyval.sr) = 0;
add_pcc_named_arg(interp, IMCC_INFO(interp)->cur_call,
@@ -4783,7 +4789,7 @@
break;
case 270:
-#line 2161 "compilers/imcc/imcc.y"
+#line 2167 "compilers/imcc/imcc.y"
{
(yyval.sr) = 0;
add_pcc_named_arg_var(interp, IMCC_INFO(interp)->cur_call, (yyvsp[(1) - (3)].sr), (yyvsp[(3) - (3)].sr));
@@ -4791,7 +4797,7 @@
break;
case 271:
-#line 2166 "compilers/imcc/imcc.y"
+#line 2172 "compilers/imcc/imcc.y"
{
(yyval.sr) = 0;
add_pcc_named_arg(interp, IMCC_INFO(interp)->cur_call,
@@ -4801,47 +4807,47 @@
break;
case 272:
-#line 2175 "compilers/imcc/imcc.y"
+#line 2181 "compilers/imcc/imcc.y"
{ (yyval.sr) = (yyvsp[(1) - (2)].sr); (yyval.sr)->type |= (yyvsp[(2) - (2)].t); }
break;
case 273:
-#line 2179 "compilers/imcc/imcc.y"
+#line 2185 "compilers/imcc/imcc.y"
{ (yyval.t) = 0; }
break;
case 274:
-#line 2180 "compilers/imcc/imcc.y"
+#line 2186 "compilers/imcc/imcc.y"
{ (yyval.t) = (yyvsp[(1) - (2)].t) | (yyvsp[(2) - (2)].t); }
break;
case 275:
-#line 2184 "compilers/imcc/imcc.y"
+#line 2190 "compilers/imcc/imcc.y"
{ (yyval.t) = VT_FLAT; }
break;
case 276:
-#line 2185 "compilers/imcc/imcc.y"
+#line 2191 "compilers/imcc/imcc.y"
{ (yyval.t) = VT_NAMED; }
break;
case 277:
-#line 2188 "compilers/imcc/imcc.y"
+#line 2194 "compilers/imcc/imcc.y"
{ adv_named_set_u(interp, (yyvsp[(3) - (4)].s)); (yyval.t) = 0; }
break;
case 278:
-#line 2189 "compilers/imcc/imcc.y"
+#line 2195 "compilers/imcc/imcc.y"
{ adv_named_set(interp, (yyvsp[(3) - (4)].s)); (yyval.t) = 0; }
break;
case 279:
-#line 2193 "compilers/imcc/imcc.y"
+#line 2199 "compilers/imcc/imcc.y"
{ (yyval.sr) = (yyvsp[(1) - (2)].sr); (yyval.sr)->type |= (yyvsp[(2) - (2)].t); }
break;
case 280:
-#line 2198 "compilers/imcc/imcc.y"
+#line 2204 "compilers/imcc/imcc.y"
{
(yyval.sr) = 0;
if (IMCC_INFO(interp)->adv_named_id) {
@@ -4854,7 +4860,7 @@
break;
case 281:
-#line 2208 "compilers/imcc/imcc.y"
+#line 2214 "compilers/imcc/imcc.y"
{
add_pcc_named_result(interp, IMCC_INFO(interp)->cur_call,
mk_const(interp, (yyvsp[(3) - (5)].s), 'S'), (yyvsp[(5) - (5)].sr));
@@ -4863,7 +4869,7 @@
break;
case 282:
-#line 2214 "compilers/imcc/imcc.y"
+#line 2220 "compilers/imcc/imcc.y"
{
(yyval.sr) = 0;
if (IMCC_INFO(interp)->adv_named_id) {
@@ -4876,7 +4882,7 @@
break;
case 283:
-#line 2224 "compilers/imcc/imcc.y"
+#line 2230 "compilers/imcc/imcc.y"
{
add_pcc_named_result(interp, IMCC_INFO(interp)->cur_call, mk_const(interp, (yyvsp[(1) - (3)].s), 'S'), (yyvsp[(3) - (3)].sr));
mem_sys_free((yyvsp[(1) - (3)].s));
@@ -4884,124 +4890,124 @@
break;
case 284:
-#line 2228 "compilers/imcc/imcc.y"
+#line 2234 "compilers/imcc/imcc.y"
{ (yyval.sr) = 0; }
break;
case 285:
-#line 2232 "compilers/imcc/imcc.y"
+#line 2238 "compilers/imcc/imcc.y"
{ (yyval.i) = (yyvsp[(1) - (1)].i); }
break;
case 286:
-#line 2233 "compilers/imcc/imcc.y"
+#line 2239 "compilers/imcc/imcc.y"
{ (yyval.i) = (yyvsp[(1) - (1)].i); }
break;
case 287:
-#line 2238 "compilers/imcc/imcc.y"
+#line 2244 "compilers/imcc/imcc.y"
{
(yyval.i) =MK_I(interp, IMCC_INFO(interp)->cur_unit, inv_op((yyvsp[(3) - (6)].s)), 3, (yyvsp[(2) - (6)].sr), (yyvsp[(4) - (6)].sr), (yyvsp[(6) - (6)].sr));
}
break;
case 288:
-#line 2242 "compilers/imcc/imcc.y"
+#line 2248 "compilers/imcc/imcc.y"
{
(yyval.i) = MK_I(interp, IMCC_INFO(interp)->cur_unit, "unless_null", 2, (yyvsp[(3) - (5)].sr), (yyvsp[(5) - (5)].sr));
}
break;
case 289:
-#line 2246 "compilers/imcc/imcc.y"
+#line 2252 "compilers/imcc/imcc.y"
{
(yyval.i) = MK_I(interp, IMCC_INFO(interp)->cur_unit, "unless", 2, (yyvsp[(2) - (4)].sr), (yyvsp[(4) - (4)].sr));
}
break;
case 290:
-#line 2253 "compilers/imcc/imcc.y"
+#line 2259 "compilers/imcc/imcc.y"
{
(yyval.i) = MK_I(interp, IMCC_INFO(interp)->cur_unit, "if", 2, (yyvsp[(2) - (4)].sr), (yyvsp[(4) - (4)].sr));
}
break;
case 291:
-#line 2257 "compilers/imcc/imcc.y"
+#line 2263 "compilers/imcc/imcc.y"
{
(yyval.i) =MK_I(interp, IMCC_INFO(interp)->cur_unit, (yyvsp[(3) - (6)].s), 3, (yyvsp[(2) - (6)].sr), (yyvsp[(4) - (6)].sr), (yyvsp[(6) - (6)].sr));
}
break;
case 292:
-#line 2261 "compilers/imcc/imcc.y"
+#line 2267 "compilers/imcc/imcc.y"
{
(yyval.i) = MK_I(interp, IMCC_INFO(interp)->cur_unit, "if_null", 2, (yyvsp[(3) - (5)].sr), (yyvsp[(5) - (5)].sr));
}
break;
case 293:
-#line 2267 "compilers/imcc/imcc.y"
+#line 2273 "compilers/imcc/imcc.y"
{ (yyval.t) = 0; }
break;
case 294:
-#line 2268 "compilers/imcc/imcc.y"
+#line 2274 "compilers/imcc/imcc.y"
{ (yyval.t) = 0; }
break;
case 295:
-#line 2272 "compilers/imcc/imcc.y"
+#line 2278 "compilers/imcc/imcc.y"
{ (yyval.s) = (char *)"eq"; }
break;
case 296:
-#line 2273 "compilers/imcc/imcc.y"
+#line 2279 "compilers/imcc/imcc.y"
{ (yyval.s) = (char *)"ne"; }
break;
case 297:
-#line 2274 "compilers/imcc/imcc.y"
+#line 2280 "compilers/imcc/imcc.y"
{ (yyval.s) = (char *)"gt"; }
break;
case 298:
-#line 2275 "compilers/imcc/imcc.y"
+#line 2281 "compilers/imcc/imcc.y"
{ (yyval.s) = (char *)"ge"; }
break;
case 299:
-#line 2276 "compilers/imcc/imcc.y"
+#line 2282 "compilers/imcc/imcc.y"
{ (yyval.s) = (char *)"lt"; }
break;
case 300:
-#line 2277 "compilers/imcc/imcc.y"
+#line 2283 "compilers/imcc/imcc.y"
{ (yyval.s) = (char *)"le"; }
break;
case 303:
-#line 2286 "compilers/imcc/imcc.y"
+#line 2292 "compilers/imcc/imcc.y"
{ (yyval.sr) = NULL; }
break;
case 304:
-#line 2287 "compilers/imcc/imcc.y"
+#line 2293 "compilers/imcc/imcc.y"
{ (yyval.sr) = (yyvsp[(1) - (1)].sr); }
break;
case 305:
-#line 2291 "compilers/imcc/imcc.y"
+#line 2297 "compilers/imcc/imcc.y"
{ (yyval.sr) = IMCC_INFO(interp)->regs[0]; }
break;
case 307:
-#line 2296 "compilers/imcc/imcc.y"
+#line 2302 "compilers/imcc/imcc.y"
{ IMCC_INFO(interp)->regs[IMCC_INFO(interp)->nargs++] = (yyvsp[(1) - (1)].sr); }
break;
case 308:
-#line 2298 "compilers/imcc/imcc.y"
+#line 2304 "compilers/imcc/imcc.y"
{
IMCC_INFO(interp) -> regs[IMCC_INFO(interp)->nargs++] = (yyvsp[(1) - (4)].sr);
IMCC_INFO(interp) -> keyvec |= KEY_BIT(IMCC_INFO(interp)->nargs);
@@ -5011,7 +5017,7 @@
break;
case 309:
-#line 2305 "compilers/imcc/imcc.y"
+#line 2311 "compilers/imcc/imcc.y"
{
IMCC_INFO(interp) -> regs[IMCC_INFO(interp)->nargs++] = (yyvsp[(2) - (3)].sr);
(yyval.sr) = (yyvsp[(2) - (3)].sr);
@@ -5019,37 +5025,37 @@
break;
case 311:
-#line 2312 "compilers/imcc/imcc.y"
+#line 2318 "compilers/imcc/imcc.y"
{ (yyval.sr) = mk_sub_address_fromc(interp, (yyvsp[(1) - (1)].s)); mem_sys_free((yyvsp[(1) - (1)].s)); }
break;
case 312:
-#line 2313 "compilers/imcc/imcc.y"
+#line 2319 "compilers/imcc/imcc.y"
{ (yyval.sr) = mk_sub_address_u(interp, (yyvsp[(1) - (1)].s)); mem_sys_free((yyvsp[(1) - (1)].s)); }
break;
case 313:
-#line 2317 "compilers/imcc/imcc.y"
+#line 2323 "compilers/imcc/imcc.y"
{ (yyval.sr) = mk_sub_address(interp, (yyvsp[(1) - (1)].s)); mem_sys_free((yyvsp[(1) - (1)].s)); }
break;
case 314:
-#line 2318 "compilers/imcc/imcc.y"
+#line 2324 "compilers/imcc/imcc.y"
{ (yyval.sr) = mk_sub_address(interp, (yyvsp[(1) - (1)].s)); mem_sys_free((yyvsp[(1) - (1)].s)); }
break;
case 315:
-#line 2322 "compilers/imcc/imcc.y"
+#line 2328 "compilers/imcc/imcc.y"
{ (yyval.sr) = mk_label_address(interp, (yyvsp[(1) - (1)].s)); mem_sys_free((yyvsp[(1) - (1)].s)); }
break;
case 316:
-#line 2323 "compilers/imcc/imcc.y"
+#line 2329 "compilers/imcc/imcc.y"
{ (yyval.sr) = mk_label_address(interp, (yyvsp[(1) - (1)].s)); mem_sys_free((yyvsp[(1) - (1)].s)); }
break;
case 321:
-#line 2337 "compilers/imcc/imcc.y"
+#line 2343 "compilers/imcc/imcc.y"
{
IMCC_INFO(interp)->nkeys = 0;
IMCC_INFO(interp)->in_slice = 0;
@@ -5057,7 +5063,7 @@
break;
case 322:
-#line 2342 "compilers/imcc/imcc.y"
+#line 2348 "compilers/imcc/imcc.y"
{
(yyval.sr) = link_keys(interp,
IMCC_INFO(interp)->nkeys,
@@ -5066,7 +5072,7 @@
break;
case 323:
-#line 2350 "compilers/imcc/imcc.y"
+#line 2356 "compilers/imcc/imcc.y"
{
IMCC_INFO(interp)->nkeys = 0;
IMCC_INFO(interp)->in_slice = 0;
@@ -5074,7 +5080,7 @@
break;
case 324:
-#line 2355 "compilers/imcc/imcc.y"
+#line 2361 "compilers/imcc/imcc.y"
{
(yyval.sr) = link_keys(interp,
IMCC_INFO(interp)->nkeys,
@@ -5083,12 +5089,12 @@
break;
case 325:
-#line 2363 "compilers/imcc/imcc.y"
+#line 2369 "compilers/imcc/imcc.y"
{ IMCC_INFO(interp)->keys[IMCC_INFO(interp)->nkeys++] = (yyvsp[(1) - (1)].sr); }
break;
case 326:
-#line 2365 "compilers/imcc/imcc.y"
+#line 2371 "compilers/imcc/imcc.y"
{
IMCC_INFO(interp)->keys[IMCC_INFO(interp)->nkeys++] = (yyvsp[(3) - (3)].sr);
(yyval.sr) = IMCC_INFO(interp)->keys[0];
@@ -5096,7 +5102,7 @@
break;
case 327:
-#line 2373 "compilers/imcc/imcc.y"
+#line 2379 "compilers/imcc/imcc.y"
{
if (IMCC_INFO(interp)->in_slice)
(yyvsp[(1) - (1)].sr)->type |= VT_START_SLICE | VT_END_SLICE;
@@ -5105,53 +5111,53 @@
break;
case 328:
-#line 2381 "compilers/imcc/imcc.y"
+#line 2387 "compilers/imcc/imcc.y"
{ (yyval.sr) = mk_symreg(interp, (yyvsp[(1) - (1)].s), 'I'); }
break;
case 329:
-#line 2382 "compilers/imcc/imcc.y"
+#line 2388 "compilers/imcc/imcc.y"
{ (yyval.sr) = mk_symreg(interp, (yyvsp[(1) - (1)].s), 'N'); }
break;
case 330:
-#line 2383 "compilers/imcc/imcc.y"
+#line 2389 "compilers/imcc/imcc.y"
{ (yyval.sr) = mk_symreg(interp, (yyvsp[(1) - (1)].s), 'S'); }
break;
case 331:
-#line 2384 "compilers/imcc/imcc.y"
+#line 2390 "compilers/imcc/imcc.y"
{ (yyval.sr) = mk_symreg(interp, (yyvsp[(1) - (1)].s), 'P'); }
break;
case 332:
-#line 2385 "compilers/imcc/imcc.y"
+#line 2391 "compilers/imcc/imcc.y"
{ (yyval.sr) = mk_pasm_reg(interp, (yyvsp[(1) - (1)].s)); mem_sys_free((yyvsp[(1) - (1)].s)); }
break;
case 333:
-#line 2389 "compilers/imcc/imcc.y"
+#line 2395 "compilers/imcc/imcc.y"
{ (yyval.sr) = mk_const(interp, (yyvsp[(1) - (1)].s), 'I'); mem_sys_free((yyvsp[(1) - (1)].s)); }
break;
case 334:
-#line 2390 "compilers/imcc/imcc.y"
+#line 2396 "compilers/imcc/imcc.y"
{ (yyval.sr) = mk_const(interp, (yyvsp[(1) - (1)].s), 'N'); mem_sys_free((yyvsp[(1) - (1)].s)); }
break;
case 335:
-#line 2391 "compilers/imcc/imcc.y"
+#line 2397 "compilers/imcc/imcc.y"
{ (yyval.sr) = mk_const(interp, (yyvsp[(1) - (1)].s), 'S'); mem_sys_free((yyvsp[(1) - (1)].s)); }
break;
case 336:
-#line 2392 "compilers/imcc/imcc.y"
+#line 2398 "compilers/imcc/imcc.y"
{ (yyval.sr) = mk_const(interp, (yyvsp[(1) - (1)].s), 'U'); mem_sys_free((yyvsp[(1) - (1)].s)); }
break;
/* Line 1267 of yacc.c. */
-#line 5144 "compilers/imcc/imcparser.c"
+#line 5150 "compilers/imcc/imcparser.c"
default: break;
}
YY_SYMBOL_PRINT ("-> $$ =", yyr1[yyn], &yyval, &yyloc);
@@ -5365,7 +5371,7 @@
}
-#line 2398 "compilers/imcc/imcc.y"
+#line 2404 "compilers/imcc/imcc.y"
/* I need this prototype somewhere... */
Modified: branches/pmc_pct/compilers/imcc/pbc.c
==============================================================================
--- branches/pmc_pct/compilers/imcc/pbc.c Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/compilers/imcc/pbc.c Thu Jun 4 02:32:48 2009 (r39377)
@@ -2146,6 +2146,9 @@
interp->code->base.data = (opcode_t *)
mem_sys_realloc(interp->code->base.data, bytes);
+ /* reallocating this removes its mmaped-ness; needs encapsulation */
+ interp->code->base.pf->is_mmap_ped = 0;
+
interp->code->pic_index->data = (opcode_t *)
mem_sys_realloc(interp->code->pic_index->data, bytes / 2);
@@ -2157,7 +2160,7 @@
/* add debug if necessary */
if (IMCC_INFO(interp)->optimizer_level == 0
- || IMCC_INFO(interp)->optimizer_level == OPT_PASM) {
+ || IMCC_INFO(interp)->optimizer_level == OPT_PASM) {
const char * const sourcefile = unit->file;
/* FIXME length and multiple subs */
Deleted: branches/pmc_pct/compilers/json/postalcodes.pir
==============================================================================
--- branches/pmc_pct/compilers/json/postalcodes.pir Thu Jun 4 02:32:48 2009 (r39376)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,118 +0,0 @@
-#!../../parrot
-# Copyright (C) 2001-2008, Parrot Foundation.
-# $Id$
-
-=head1 NAME
-
-postalcodes.pir
-
-=head1 SYNOPSIS
-
- % ./parrot postalcodes.pir <postal>
-
-=head1 DESCRIPTION
-
-Given a postal code (like, '06382'), print some information about various
-places with that code from around the world.
-
-=cut
-
-.include 'socket.pasm'
-
-.sub _main :main
- .param pmc argv
-
- .local string postal, url
-
- $I0 = elements argv
- if $I0 != 2 goto bad_args
-
- postal = argv[1]
-
- .local pmc sock, address
- .local string buf, json_result
- json_result = ''
- .local int ret
- .local int len
-
- # create the socket handle
- sock = new 'Socket'
- sock.'socket'(.PIO_PF_INET, .PIO_SOCK_STREAM, .PIO_PROTO_TCP)
-
- # Pack a sockaddr_in structure with IP and port
- address = sock.'sockaddr'('ws.geonames.org', 80)
- ret = sock.'connect'(address)
-
- .local string url
- url = 'http://ws.geonames.org/postalCodeSearchJSON?maxRows=10&postalcode='
- url .= postal
-
- $S0 = 'GET '
- $S0 .= url
- $S0 .= " HTTP/1.0\r\nUser-agent: Parrot\r\n\r\n"
- ret = sock.'send'($S0)
-MORE:
- buf = sock.'recv'()
- ret = length buf
- if ret <= 0 goto END
- json_result .= buf
- goto MORE
-ERR:
- print "Socket error\n"
- end
-END:
- close sock
-
- $I1 = find_charset 'unicode'
- trans_charset json_result, $I1
-
- # Strip off http headers.
- $I0 = index json_result, "\r\n\r\n"
- substr json_result, 0, $I0, ""
-
- load_bytecode 'compilers/json/JSON.pbc'
- $P1 = compreg 'JSON'
- $P2 = $P1(json_result)
-
- $P3 = $P2['error']
- unless null $P3 goto bad_code
-
- $P2 = $P2['postalCodes']
- .local pmc iter, code
- iter = new 'Iterator', $P2
-
- code_loop:
- push_eh code_end
- code = shift iter
- pop_eh
- unless code goto code_end
-
- $S0 = code['placeName']
- print "Place: "
- print $S0
- print ', '
- $S0 = code['countryCode']
- print $S0
- print '; Code: '
- $S0 = code['postalCode']
- print $S0
- print "\n"
-
- goto code_loop
- code_end:
-
- end
-
-bad_args:
- say "Usage: postcalcodes.pir <postal>"
- .return()
-
-bad_code:
- say $P3
-.end
-
-# Local Variables:
-# mode: pir
-# fill-column: 100
-# End:
-# vim: expandtab shiftwidth=4 ft=pir:
Deleted: branches/pmc_pct/compilers/json/test.pir
==============================================================================
--- branches/pmc_pct/compilers/json/test.pir Thu Jun 4 02:32:48 2009 (r39376)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,35 +0,0 @@
-#!../../parrot
-# Copyright (C) 2006-2009, Parrot Foundation.
-# $Id$
-
-.sub main :main
- .param pmc argv
-
- .local int argc
- argc = elements argv
-
- if argc != 2 goto bad_args
-
- load_bytecode 'PGE.pbc'
- load_bytecode 'PGE/Util.pbc'
- load_bytecode 'compilers/json/JSON.pbc'
-
- .local pmc JSON
- JSON = compreg "JSON"
- $S0 = argv[1]
- $P1 = JSON($S0)
-
- load_bytecode 'dumper.pbc'
- _dumper($P1, "JSON")
- end
-
- bad_args:
- say "must specify a single arg."
- end
-.end
-
-# Local Variables:
-# mode: pir
-# fill-column: 100
-# End:
-# vim: expandtab shiftwidth=4 ft=pir:
Modified: branches/pmc_pct/compilers/nqp/src/Grammar/Actions.pir
==============================================================================
--- branches/pmc_pct/compilers/nqp/src/Grammar/Actions.pir Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/compilers/nqp/src/Grammar/Actions.pir Thu Jun 4 02:32:48 2009 (r39377)
@@ -378,6 +378,7 @@
## if $<declarator> eq 'method' {
## $past.blocktype('method');
## $past.push(PAST::Op.new('inline'=>'.lex 'self', self);
+## $past.symbol('self', :scope('lexical'));
## }
## for $<signature>[0] {
## my $parameter := $($_<parameter>);
@@ -404,6 +405,7 @@
$P3 = get_hll_global ['PAST'], 'Op'
$P4 = $P3.'new'('inline'=>' .lex "self", self', 'pasttype'=>'inline')
unshift past, $P4
+ past.'symbol'('self', 'scope'=>'lexical')
add_signature:
$P0 = match['signature']
$P0 = $P0[0]
@@ -743,7 +745,7 @@
## method noun($/, $key) {
## if $key eq 'self' {
-## make PAST::Var.new('name'=>'self', 'node'=>$/);
+## make PAST::Var.new(:name('self'), :scope('lexical'), :node($/));
## }
## else {
## make $($/{$key});
Modified: branches/pmc_pct/compilers/pct/src/PAST/Compiler.pir
==============================================================================
--- branches/pmc_pct/compilers/pct/src/PAST/Compiler.pir Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/compilers/pct/src/PAST/Compiler.pir Thu Jun 4 02:32:48 2009 (r39377)
@@ -1954,20 +1954,43 @@
pop_eh
scope_error:
unless scope goto scope_error_1
- scope = concat " '", scope
- scope = concat scope, "'"
+ scope = concat " in '", scope
+ scope = concat scope, "' scope"
scope_error_1:
# Find the nearest named block
+ .local string blockname
+ blockname = ''
.local pmc it
$P0 = get_global '@?BLOCK'
it = iter $P0
scope_error_block_loop:
unless it goto scope_error_2
$P0 = shift it
- $S0 = $P0.'name'()
- unless $S0 goto scope_error_block_loop
+ blockname = $P0.'name'()
+ unless blockname goto scope_error_block_loop
scope_error_2:
- .tailcall self.'panic'("Scope", scope, " not found for PAST::Var '", name, "' in ", $S0)
+ if blockname goto have_blockname
+ blockname = '<anonymous>'
+ have_blockname:
+ # Find the source location, if available
+ .local string sourceline
+ .local pmc source, pos, files
+ sourceline = ''
+ source = node['source']
+ pos = node['pos']
+ if null source goto scope_error_3
+ files = find_caller_lex '$?FILES'
+ if null files goto scope_error_3
+ $S0 = files
+ sourceline = concat ' (', $S0
+ concat sourceline, ':'
+ $I0 = source.'lineof'(pos)
+ inc $I0
+ $S0 = $I0
+ concat sourceline, $S0
+ concat sourceline, ')'
+ scope_error_3:
+ .tailcall self.'panic'("Symbol '", name, "' not predeclared", scope, " in ", blockname, sourceline)
.end
Modified: branches/pmc_pct/compilers/pct/src/PCT/HLLCompiler.pir
==============================================================================
--- branches/pmc_pct/compilers/pct/src/PCT/HLLCompiler.pir Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/compilers/pct/src/PCT/HLLCompiler.pir Thu Jun 4 02:32:48 2009 (r39377)
@@ -326,13 +326,31 @@
.local string tcode
tcode = adverbs['transcode']
unless tcode goto transcode_done
- push_eh transcode_skip
+ .local pmc tcode_it
+ $P0 = split ' ', tcode
+ tcode_it = iter $P0
+ tcode_loop:
+ unless tcode_it goto transcode_done
+ tcode = shift tcode_it
+ push_eh tcode_enc
$I0 = find_charset tcode
$S0 = source
$S0 = trans_charset $S0, $I0
assign source, $S0
- transcode_skip:
pop_eh
+ goto transcode_done
+ tcode_enc:
+ pop_eh
+ push_eh tcode_fail
+ $I0 = find_encoding tcode
+ $S0 = source
+ $S0 = trans_encoding $S0, $I0
+ assign source, $S0
+ pop_eh
+ goto transcode_done
+ tcode_fail:
+ pop_eh
+ goto tcode_loop
transcode_done:
.local string target
Modified: branches/pmc_pct/compilers/pge/PGE/Exp.pir
==============================================================================
--- branches/pmc_pct/compilers/pge/PGE/Exp.pir Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/compilers/pge/PGE/Exp.pir Thu Jun 4 02:32:48 2009 (r39377)
@@ -210,17 +210,17 @@
.local string expstr
expstr = expcode
code.'emit'(" .local pmc cstack :unique_reg")
- code.'emit'(" cstack = new 'ResizableIntegerArray'")
+ code.'emit'(" cstack = root_new ['parrot';'ResizableIntegerArray']")
$I0 = index expstr, 'ustack'
if $I0 < 0 goto code_body_1
code.'emit'(" .local pmc ustack :unique_reg")
- code.'emit'(" ustack = new 'ResizablePMCArray'")
+ code.'emit'(" ustack = root_new ['parrot';'ResizablePMCArray']")
code_body_1:
## generate the gpad only if we need it
$I0 = index expstr, 'gpad'
if $I0 < 0 goto code_body_2
code.'emit'(" .local pmc gpad :unique_reg")
- code.'emit'(" gpad = new 'ResizablePMCArray'")
+ code.'emit'(" gpad = root_new ['parrot';'ResizablePMCArray']")
code_body_2:
## set the captscope if we need it
$I0 = index expstr, 'captscope'
@@ -328,7 +328,7 @@
captgen.'emit'(<<" CODE", cname, label)
$I0 = defined captscope[%0]
if $I0 goto %1_cgen
- $P0 = new 'ResizablePMCArray'
+ $P0 = root_new ['parrot';'ResizablePMCArray']
captscope[%0] = $P0
local_branch cstack, %1_cgen
delete captscope[%0]
Modified: branches/pmc_pct/config/auto/gc.pm
==============================================================================
--- branches/pmc_pct/config/auto/gc.pm Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/config/auto/gc.pm Thu Jun 4 02:32:48 2009 (r39377)
@@ -64,7 +64,7 @@
my $gc = $conf->options->get('gc');
- # default is GC in resources.c
+ # default is GC in alloc_resources.c
$gc = 'gc' unless defined $gc;
if ( $gc =~ /^malloc(?:-trace)?$/ ) {
@@ -97,9 +97,9 @@
$gc = 'gc';
$conf->data->set(
TEMP_gc_c => <<"EOF",
-\$(SRC_DIR)/gc/resources\$(O): \$(GENERAL_H_FILES) \$(SRC_DIR)/gc/resources.c
+\$(SRC_DIR)/gc/alloc_resources\$(O): \$(GENERAL_H_FILES) \$(SRC_DIR)/gc/alloc_resources.c
EOF
- TEMP_gc_o => "\$(SRC_DIR)/gc/resources\$(O)",
+ TEMP_gc_o => "\$(SRC_DIR)/gc/alloc_resources\$(O)",
gc_flag => '',
);
}
Modified: branches/pmc_pct/config/auto/gcc.pm
==============================================================================
--- branches/pmc_pct/config/auto/gcc.pm Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/config/auto/gcc.pm Thu Jun 4 02:32:48 2009 (r39377)
@@ -93,10 +93,7 @@
$conf->data->set(
ccwarn => "$ccwarn",
gccversion => $gccversion,
- HAS_aligned_funcptr => 1
);
- $conf->data->set( HAS_aligned_funcptr => 0 )
- if $conf->data->get_p5('OSNAME') eq 'hpux';
return 1;
}
Modified: branches/pmc_pct/config/auto/icu.pm
==============================================================================
--- branches/pmc_pct/config/auto/icu.pm Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/config/auto/icu.pm Thu Jun 4 02:32:48 2009 (r39377)
@@ -299,6 +299,7 @@
print "Trying $arg->{icuconfig} with '--prefix'\n"
if $arg->{verbose};
$icuheaders = capture_output("$arg->{icuconfig} --prefix");
+ chomp($icuheaders);
print "icuheaders: captured $icuheaders\n"
if $arg->{verbose};
($icuheaders, $arg->{without}) =
Modified: branches/pmc_pct/config/gen/call_list/core.in
==============================================================================
--- branches/pmc_pct/config/gen/call_list/core.in Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/config/gen/call_list/core.in Thu Jun 4 02:32:48 2009 (r39377)
@@ -86,6 +86,10 @@
I JPP # MMD compare
+# These are needed for packfileconstanttable.pmc
+I JPS
+I JPN
+
# These are needed for parrotio.pmc
i JP
v JP
Modified: branches/pmc_pct/config/gen/config_pm.pm
==============================================================================
--- branches/pmc_pct/config/gen/config_pm.pm Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/config/gen/config_pm.pm Thu Jun 4 02:32:48 2009 (r39377)
@@ -97,9 +97,18 @@
END
+ my %p5_keys = map { $_ => 1 } $conf->data->keys_p5();
+ # A few of these keys are still useful.
+ my @p5_keys_whitelist = qw(archname ccflags longsize optimize);
+ foreach my $key (@p5_keys_whitelist) {
+ delete($p5_keys{$key});
+ }
+
while (<$IN>) {
if (/\@PCONFIG\@/) {
for my $k ( sort { lc $a cmp lc $b || $a cmp $b } $conf->data->keys ) {
+ next if exists $p5_keys{$k};
+
my $v = $conf->data->get($k);
if ( defined $v ) {
my $type = ref $v;
Modified: branches/pmc_pct/config/gen/config_pm/config_pir.in
==============================================================================
--- branches/pmc_pct/config/gen/config_pm/config_pir.in Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/config/gen/config_pm/config_pir.in Thu Jun 4 02:32:48 2009 (r39377)
@@ -8,6 +8,7 @@
.sub _some
...
+ load_bytecode 'config.pbc'
# store the config data into $P0
$P0 = _config()
# Retrieve and print a key
@@ -18,7 +19,6 @@
...
.end
- .include "library/config.pir"
=head1 DESCRIPTION
Modified: branches/pmc_pct/config/gen/makefiles/dynoplibs.in
==============================================================================
--- branches/pmc_pct/config/gen/makefiles/dynoplibs.in Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/config/gen/makefiles/dynoplibs.in Thu Jun 4 02:32:48 2009 (r39377)
@@ -17,8 +17,7 @@
CFLAGS := @ccflags@ @cc_shared@ @cc_debug@ @ccwarn@ @cc_hasjit@ @cg_flag@ @gc_flag@
CC_OUT := @cc_o_out@
LD_OUT := @ld_out@
-#IF(parrot_is_shared):LIBPARROT := @libparrot_ldflags@
-#ELSE:LIBPARROT :=
+LIBPARROT := @libparrot_ldflags@
BUILD_TOOLS_DIR := $(BUILD_DIR)@slash at tools@slash at build
OPS2C := $(PERL) -I$(BUILD_DIR)@slash at lib $(BUILD_TOOLS_DIR)@slash at ops2c.pl
Modified: branches/pmc_pct/config/gen/makefiles/dynpmc.in
==============================================================================
--- branches/pmc_pct/config/gen/makefiles/dynpmc.in Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/config/gen/makefiles/dynpmc.in Thu Jun 4 02:32:48 2009 (r39377)
@@ -17,15 +17,13 @@
CFLAGS := @ccflags@ @cc_shared@ @cc_debug@ @ccwarn@ @cc_hasjit@ @cg_flag@ @gc_flag@
CC_OUT := @cc_o_out@
LD_OUT := @ld_out@
-#IF(parrot_is_shared):LIBPARROT := @libparrot_ldflags@
-#ELSE:LIBPARROT :=
+LIBPARROT := @libparrot_ldflags@
BUILD_TOOLS_DIR := $(BUILD_DIR)@slash at tools@slash at build
BUILD_LIB_DIR := $(BUILD_DIR)@slash at blib@slash at lib
PMC2C := $(PERL) $(BUILD_TOOLS_DIR)@slash at pmc2c.pl
INCLUDES := -I$(BUILD_DIR)@slash at include -I at build_dir@@slash at src@slash at pmc
-#IF(!cygwin and cc==gcc):LINKARGS := -Wl,-L $(BUILD_LIB_DIR) $(LDFLAGS) $(LD_LOAD_FLAGS) $(LIBPARROT) @icu_shared@ @libs@
-#ELSE:LINKARGS := $(LDFLAGS) $(LD_LOAD_FLAGS) $(LIBPARROT) @icu_shared@ @libs@
+LINKARGS := $(LDFLAGS) $(LD_LOAD_FLAGS) $(LIBPARROT) @icu_shared@ @libs@
PMC2CD := $(PERL) $(BUILD_TOOLS_DIR)/pmc2c.pl --dump
PMC2CC := $(PERL) $(BUILD_TOOLS_DIR)/pmc2c.pl --c
Modified: branches/pmc_pct/config/gen/makefiles/parrot_embed_pl.in
==============================================================================
--- branches/pmc_pct/config/gen/makefiles/parrot_embed_pl.in Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/config/gen/makefiles/parrot_embed_pl.in Thu Jun 4 02:32:48 2009 (r39377)
@@ -19,7 +19,7 @@
$config{PARROT} = '.. at slash@.. at slash@parrot at exe@';
$config{C_LIBS} = '@libs@';
$config{INCLUDE} = "$config{PARROTDIR}/include";
-#UNLESS(win32):$config{ALL_PARROT_LIBS} = "@libparrot_ldflags@ $config{C_LIBS} @linkflags@";
+#UNLESS(win32):$config{ALL_PARROT_LIBS} = "@libparrot_linkflags@ $config{C_LIBS} @linkflags@";
$config{ABS_PARROTDIR} = Cwd::realpath(
File::Spec->rel2abs( $config{PARROTDIR} ) );
$config{LDDLFLAGS} = $Config{lddlflags};
@@ -36,7 +36,7 @@
'PREREQ_PM' => { 'ExtUtils::CBuilder' => 0 },
#IF(win32): 'LIBS' => [ $config{C_LIBS} ],
#ELSE: 'LIBS' => [ $config{ALL_PARROT_LIBS} ],
-#IF(win32): 'OBJECT' => q|@libparrot_ldflags@ Embed at o@|,
+#IF(win32): 'OBJECT' => q|@libparrot_linkflags@ Embed at o@|,
'INC' => "-I$config{INCLUDE}",
'PM' => { map { $_ => "blib/$_" } <lib/Parrot/*pm> },
'clean' => { FILES => '*.xs t/greet.pbc' },
Modified: branches/pmc_pct/config/gen/makefiles/pirc.in
==============================================================================
--- branches/pmc_pct/config/gen/makefiles/pirc.in Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/config/gen/makefiles/pirc.in Thu Jun 4 02:32:48 2009 (r39377)
@@ -68,7 +68,7 @@
pirc$(EXE): $(OBJS)
$(LINK) @ld_out@$@ \
$(OBJS) \
- @rpath_blib@ @libparrot_ldflags@ $(C_LIBS) $(LINKFLAGS) $(LINK_DYNAMIC)
+ @rpath_blib@ @libparrot_linkflags@ $(C_LIBS) $(LINKFLAGS) $(LINK_DYNAMIC)
src/pirparser$(O): src/pirparser.c src/pirparser.h
src/pirlexer$(O): src/pirlexer.c src/pirlexer.h
Modified: branches/pmc_pct/config/gen/makefiles/root.in
==============================================================================
--- branches/pmc_pct/config/gen/makefiles/root.in Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/config/gen/makefiles/root.in Thu Jun 4 02:32:48 2009 (r39377)
@@ -32,7 +32,7 @@
LIB_DIR := @libdir@
INCLUDE_DIR := @includedir@
DATA_DIR := @datadir@
-DOC_DIR := @doc_dir@
+DOC_DIR := @docdir@
VERSION_DIR = @versiondir@
@@ -407,12 +407,12 @@
$(SRC_DIR)/exit$(O) \
$(SRC_DIR)/extend$(O) \
$(SRC_DIR)/extend_vtable$(O) \
+ $(SRC_DIR)/gc/alloc_memory$(O) \
+ $(SRC_DIR)/gc/alloc_register$(O) \
$(SRC_DIR)/gc/api$(O) \
$(SRC_DIR)/gc/generational_ms$(O) \
$(SRC_DIR)/gc/incremental_ms$(O) \
- $(SRC_DIR)/gc/memory$(O) \
- $(SRC_DIR)/gc/pools$(O) \
- $(SRC_DIR)/gc/register$(O) \
+ $(SRC_DIR)/gc/gc_ms$(O) \
$(SRC_DIR)/gc/mark_sweep$(O) \
$(SRC_DIR)/gc/system$(O) \
$(SRC_DIR)/global$(O) \
@@ -512,7 +512,7 @@
LIBPARROT := @libparrot@
#IF(has_icu):ICU_SHARED := @icu_shared@
-ALL_PARROT_LIBS := @libparrot_ldflags@ $(ICU_SHARED) $(C_LIBS)
+ALL_PARROT_LIBS := @libparrot_linkflags@ $(ICU_SHARED) $(C_LIBS)
# dynamic extensions
DYNEXT_DIR := runtime/parrot/dynext
@@ -742,6 +742,7 @@
@echo " bsdlint: Code checking with bsdlint."
@echo " sunlint: Code checking with Sun Studio's sunlint."
@echo " splint: Code checking with splint."
+ @echo " splint-all: Splint all of Parrot, for the masochist only."
@echo " headerizer: Recreate header files for C-source files"
@echo " apilist: Show list of PARROT_EXPORT functions"
@echo " malloclist: Show list of PARROT_MALLOC functions"
@@ -752,7 +753,6 @@
@echo ""
@echo "Release:"
@echo " release: Create a tarball."
- @echo " rpms: Create RPMs."
@echo " win32-inno-installer: Create MSWin32 setup."
@echo ""
@echo "Examples:"
@@ -869,9 +869,6 @@
lib_deps : lib_deps_object lib_deps_source
-check_source : $(GENERAL_H_FILES)
- $(PERL) tools/dev/check_source_standards.pl all_source
-
# XXX changes don't always propagate into libparrot
# e.g. when I change debug:fataly to xfataly, nm still shows the old symbol
# and parrot builds fine (except for the unproto warning
@@ -1093,15 +1090,15 @@
$(SRC_DIR)/gc/mark_sweep$(O) : $(GENERAL_H_FILES) $(SRC_DIR)/gc/gc_private.h
+$(SRC_DIR)/gc/gc_ms$(O) : $(GENERAL_H_FILES) $(SRC_DIR)/gc/gc_ms.c
+
$(SRC_DIR)/gc/api$(O) : $(GENERAL_H_FILES) $(SRC_DIR)/gc/gc_private.h
$(SRC_DIR)/gc/generational_ms$(O) : $(GENERAL_H_FILES)
$(SRC_DIR)/gc/incremental_ms$(O) : $(GENERAL_H_FILES)
-$(SRC_DIR)/gc/pools$(O) : $(GENERAL_H_FILES)
-
-$(SRC_DIR)/gc/resources$(O) : $(GENERAL_H_FILES)
+$(SRC_DIR)/gc/alloc_resources$(O) : $(GENERAL_H_FILES)
$(SRC_DIR)/gc/res_lea$(O) : $(GENERAL_H_FILES)
@@ -1172,7 +1169,7 @@
$(IO_DIR)/win32$(O) : $(GENERAL_H_FILES) $(IO_DIR)/io_private.h
-$(SRC_DIR)/gc/memory$(O) : $(GENERAL_H_FILES)
+$(SRC_DIR)/gc/alloc_memory$(O) : $(GENERAL_H_FILES)
$(SRC_DIR)/main$(O) : $(SRC_DIR)/main.c $(GENERAL_H_FILES)
@@ -1193,7 +1190,7 @@
$(SRC_DIR)/parrot$(O) : $(GENERAL_H_FILES)
-$(SRC_DIR)/gc/register$(O) : $(GENERAL_H_FILES) $(SRC_DIR)/pmc/pmc_sub.h
+$(SRC_DIR)/gc/alloc_register$(O) : $(GENERAL_H_FILES) $(SRC_DIR)/pmc/pmc_sub.h
$(SRC_DIR)/runcore/cores$(O) : $(GENERAL_H_FILES)
@@ -1231,7 +1228,8 @@
$(SRC_DIR)/spf_vtable$(O) : $(GENERAL_H_FILES) $(SRC_DIR)/spf_vtable.str
-$(SRC_DIR)/string/encoding$(O) : $(SRC_DIR)/string/encoding.c $(GENERAL_H_FILES)
+$(SRC_DIR)/string/encoding$(O) : $(SRC_DIR)/string/encoding.c \
+ $(INC_DIR)/config.h $(GENERAL_H_FILES)
$(SRC_DIR)/string/charset$(O) : $(SRC_DIR)/string/charset.c $(GENERAL_H_FILES)
@@ -1369,7 +1367,7 @@
dynpmc : dynpmc.dummy
# XXX this dependancy is too broad, and should be narrowed down
-dynpmc.dummy : $(PARROT) $(INC_DIR)/parrot.h $(INC_DIR)/extend.h $(INC_DIR)/dynext.h
+dynpmc.dummy : $(PARROT) $(INC_DIR)/parrot.h $(INC_DIR)/extend.h $(INC_DIR)/dynext.h $(PMC2C_FILES)
$(MAKE) src/dynpmc
dynpmc-test : $(PARROT) $(INC_DIR)/parrot.h $(INC_DIR)/extend.h $(INC_DIR)/dynext.h
@@ -1469,12 +1467,10 @@
$(REVISIONUTILS_DIR)/*.t \
$(HARNESS_DIR)/*.t
MANIFEST_DIR := t/manifest
+INSTALL_TOOLS_DIR := t/tools/install
MANIFEST_TEST_FILES := \
- $(MANIFEST_DIR)/01-basic.t \
- $(MANIFEST_DIR)/02-regenerate_file.t \
- $(MANIFEST_DIR)/03-regenerate_skip.t \
- $(MANIFEST_DIR)/04-alt_file.t \
- $(MANIFEST_DIR)/05-alt_skip.t
+ $(MANIFEST_DIR)/*.t \
+ $(INSTALL_TOOLS_DIR)/*.t
EXAMPLES_TEST_FILES := \
t/examples/*.t
CONFIGURE_TEST_FILES := \
@@ -1495,7 +1491,10 @@
# integrating them in a single run is difficult.
# Normal test package
-test : test_prep test_pbc_annotation_persistence nqp_test
+test : test_core nqp_test
+
+# Test Parrot core.
+test_core: test_prep test_pbc_annotation_persistence
$(PERL) t/harness $(EXTRA_TEST_ARGS)
# Test the NQP compiler
@@ -1629,7 +1628,7 @@
# benchmark tests
benchmark_tests : test_prep
- $(PERL) t/harness $(EXTRA_TEST_ARGS) $(BENCHMARK_TEST_FILES)
+ $(PERL) t/harness $(BENCHMARK_TEST_FILES)
# Running a benchmark
mopsbench : test_prep
@@ -1963,7 +1962,7 @@
-showfunc \
-tmpdir $(SPLINT_TMP) \
\
- +posix-strict-lib \
+ +posix-lib \
-skip-posix-headers \
\
+ansi89-limits \
@@ -2016,12 +2015,21 @@
SPLINTFLAGS := $(SPLINTFLAGS) \
+relax-quals
-# Pointer arithmetic is OK, but watch for null pointers
+# Memory checking
SPLINTFLAGS := $(SPLINTFLAGS) \
- -ptr-arith \
+ -must-free \
+ -mustfreefresh \
+ -mustfreeonly \
+ +null \
+nullptrarith \
+ +nullret \
+ -ptr-arith \
+ptr-negate \
- -zero-ptr
+ -zero-ptr \
+
+# Transfer errors are too tough for us right now
+SPLINTFLAGS := $(SPLINTFLAGS) \
+ -mem-trans
# Symbol definitions
SPLINTFLAGS := $(SPLINTFLAGS) \
@@ -2054,24 +2062,10 @@
+long-integral \
+match-any-integral \
-# TODO: Miscellaneous other flags
-SPLINTFLAGS := $(SPLINTFLAGS) \
- +aliasunique \
- +assignexpose \
- +continuecomment \
- +fielduse \
- +match-fields \
- +nestedextern \
- +null \
- +nullret \
- +paramuse \
- +shadow \
-
# Other options we'd like to add back
# +initallelements : Right now, the *.ops files don't initialize all
# values of the arrays
# +casebreak: Auto-generated ops have way too case fallthrus right now
-# +noeffect: Right now the UNUSED(macro) trips +noeffect
# +fcnuse: We have many functions that are defined but not used, but they
# should get hidden or ifdeffed
# +redef, +redecl: Ops currently have tons of redefinitions
@@ -2079,18 +2073,25 @@
# added to splint target to simplify experimentation,
# ex: make SPLINTFLAGS_TEST='-posixstrictlib +posixlib' splint
-splint : $(PARROT)
+SPLINT_SOURCE := `echo $(O_FILES) | $(PERL) -pe @PQ at s/\.o/\.c/g at PQ@`
+
+splint-all : $(PARROT)
$(MKPATH) $(SPLINT_TMP)
- $(SPLINT) $(CC_INC) @cc_hasjit@ "-Isrc/pmc" "-Icompilers/ast" $(SPLINTFLAGS) $(SPLINTFLAGS_TEST) `echo $(O_FILES) | $(PERL) -pe @PQ at s/\.o/\.c/g at PQ@`
+ $(SPLINT) $(CC_INC) @cc_hasjit@ "-Isrc/pmc" "-Icompilers/ast" $(SPLINTFLAGS) $(SPLINTFLAGS_TEST) \
+ $(SPLINT_SOURCE) \
$(SPLINT) $(CC_INC) $(SPLINTFLAGS) $(SPLINTFLAGS_TEST) $(IMCC_DIR)/main.c
-# Test a single file with limited splint options to ease cleanup -petdance
-splint-andy :
+# "splint" is the less-thorough splint target. For cage cleaning work,
+# you'll probably want to specify SPLINT_SOURCE rather than work on the
+# entire tree, like so:
+# make splint SPLINT_SOURCE='src/call/*.c'
+
+splint : all
$(MKPATH) $(SPLINT_TMP)
- splint $(CC_INC) @cc_hasjit@ -DNDEBUG "-Isrc/pmc" "-Icompilers/ast" $(SPLINTFLAGS) $(SPLINTFLAGS_TEST) \
- +partial -memchecks \
- src/packfile.c \
- | grep -v 'Source code error generation point'
+ $(SPLINT) $(CC_INC) @cc_hasjit@ "-Isrc/pmc" "-Icompilers/ast" $(SPLINTFLAGS) $(SPLINTFLAGS_TEST) \
+ +partial -DNDEBUG \
+ $(SPLINT_SOURCE) \
+ | grep -v 'Source code error generation point'
COVER_FLAGS := -fprofile-arcs -ftest-coverage
COVER_DIRS := \
Modified: branches/pmc_pct/config/gen/platform/generic/memexec.c
==============================================================================
--- branches/pmc_pct/config/gen/platform/generic/memexec.c Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/config/gen/platform/generic/memexec.c Thu Jun 4 02:32:48 2009 (r39377)
@@ -73,7 +73,7 @@
# ifdef WIN32
free(p);
# else /* !WIN32 */
- size_t pagesize = sysconf(_SC_PAGESIZE);
+ const size_t pagesize = sysconf(_SC_PAGESIZE);
size = (size + pagesize - 1) & ~(pagesize-1);
munmap(p, size);
# endif /* WIN32 */
Modified: branches/pmc_pct/config/init/defaults.pm
==============================================================================
--- branches/pmc_pct/config/init/defaults.pm Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/config/init/defaults.pm Thu Jun 4 02:32:48 2009 (r39377)
@@ -206,9 +206,6 @@
make_set_make => $Config{make_set_make},
make_and => '&&',
- # for cygwin
- cygchkdll => '',
-
# make_c: Command to emulate GNU make's C<-C directory> option: chdir
# to C<directory> before executing $(MAKE)
make_c => '$(PERL) -e \'chdir shift @ARGV; system q{$(MAKE)}, @ARGV; exit $$? >> 8;\'',
Modified: branches/pmc_pct/config/init/hints/cygwin.pm
==============================================================================
--- branches/pmc_pct/config/init/hints/cygwin.pm Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/config/init/hints/cygwin.pm Thu Jun 4 02:32:48 2009 (r39377)
@@ -52,6 +52,8 @@
blib_dir => '.',
libparrot_ldflags => '-L' . $build_dir . ' -lparrot',
inst_libparrot_ldflags => '-L' . $bindir . ' -lparrot',
+ libparrot_linkflags => '-L' . $build_dir . ' -lparrot',
+ inst_libparrot_linkflags => '-L' . $bindir . ' -lparrot',
);
# inet_aton needs to be defined on Cygwin.
Modified: branches/pmc_pct/config/init/hints/mswin32.pm
==============================================================================
--- branches/pmc_pct/config/init/hints/mswin32.pm Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/config/init/hints/mswin32.pm Thu Jun 4 02:32:48 2009 (r39377)
@@ -109,7 +109,9 @@
# If we are building shared, need to include dynamic libparrot.lib, otherwise
# the static libparrot.lib.
+ # Unclear if it's needed both for ld and link.
$conf->data->set( libparrot_ldflags => "\"$build_dir\\libparrot.lib\"" );
+ $conf->data->set( libparrot_linkflags => "\"$build_dir\\libparrot.lib\"" );
# 'link' needs to be link.exe, not cl.exe.
# This makes 'link' and 'ld' the same.
@@ -247,6 +249,8 @@
ld_share_flags => '-shared ',
libparrot_ldflags => "\"$build_dir\\libparrot.dll\"",
inst_libparrot_ldflags => "\"$bindir\\libparrot.dll\"",
+ libparrot_linkflags => "\"$build_dir\\libparrot.dll\"",
+ inst_libparrot_linkflags => "\"$bindir\\libparrot.dll\"",
ncilib_link_extra => 'src/libnci_test.def',
sym_export => '__declspec(dllexport)',
sym_import => '__declspec(dllimport)',
Modified: branches/pmc_pct/config/init/install.pm
==============================================================================
--- branches/pmc_pct/config/init/install.pm Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/config/init/install.pm Thu Jun 4 02:32:48 2009 (r39377)
@@ -105,7 +105,7 @@
srcdir => $srcdir,
# parrot internal use only
- doc_dir => $datadir . "/doc",
+ docdir => $datadir . "/doc",
versiondir => $versiondir,
);
Modified: branches/pmc_pct/config/inter/libparrot.pm
==============================================================================
--- branches/pmc_pct/config/inter/libparrot.pm Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/config/inter/libparrot.pm Thu Jun 4 02:32:48 2009 (r39377)
@@ -118,8 +118,28 @@
: ''
);
+ # When building shared libraries and dynamically loadable
+ # modules with 'ld', do we need to include -lparrot? If so
+ # this variable contains the necessary flags. (This is normally
+ # empty, but may be overridden by various hints files for
+ # specific platforms.)
+
+ # This version works in the build directory.
unless ( defined( $conf->data->get('libparrot_ldflags') ) ) {
- $conf->data->set(libparrot_ldflags =>
+ $conf->data->set(libparrot_ldflags => '');
+ }
+
+ # This version refers to the installed library.
+ unless ( defined( $conf->data->get('inst_libparrot_ldflags') ) ) {
+ $conf->data->set(inst_libparrot_ldflags => '');
+ }
+
+ # When linking an executable to -lparrot, this variable
+ # contains the necessary flags to find and use -lparrot.
+
+ # This version uses the -lparrot in the build directory.
+ unless ( defined( $conf->data->get('libparrot_linkflags') ) ) {
+ $conf->data->set(libparrot_linkflags =>
'-L'
. $conf->data->get('build_dir')
. $conf->data->get('slash')
@@ -128,8 +148,9 @@
);
}
- unless ( defined( $conf->data->get('inst_libparrot_ldflags') ) ) {
- $conf->data->set(inst_libparrot_ldflags =>
+ # This version uses the installed -lparrot.
+ unless ( defined( $conf->data->get('inst_libparrot_linkflags') ) ) {
+ $conf->data->set(inst_libparrot_linkflags =>
'-L'
. $conf->data->get('libdir')
. ' -lparrot'
Modified: branches/pmc_pct/docs/book/ch02_getting_started.pod
==============================================================================
--- branches/pmc_pct/docs/book/ch02_getting_started.pod Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/docs/book/ch02_getting_started.pod Thu Jun 4 02:32:48 2009 (r39377)
@@ -133,12 +133,6 @@
Parrot allows language developers to extend Parrot's core instruction set --
again to suit the needs of advanced languages.
-=item Chapter 9, I<Parrot Assembly Language>
-
-Parrot Assembly Language (PASM) is a low-level language native to the Parrot
-virtual machine. It serves as a source code representation of Parrot's bytecode
-format.
-
=item Chapter 10, I<Instruction Reference>
Parrot's standard instruction set provides powerful behavior for primitive
Modified: branches/pmc_pct/docs/book/ch03_pir.pod
==============================================================================
--- branches/pmc_pct/docs/book/ch03_pir.pod Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/docs/book/ch03_pir.pod Thu Jun 4 02:32:48 2009 (r39377)
@@ -5,42 +5,37 @@
Z<CHP-3>
X<Parrot Intermediate Representation;;(see PIR)>
-X<PIR>
+X<PIR (Parrot intermediate representation)>
Parrot Intermediate Representation (PIR) is Parrot's native low-level
-language.N<Parrot also has a pure native assembly language called PASM,
-described in Chapter 9.> PIR is fundamentally an assembly language, but
-it has some higher-level features such as operator syntax, syntactic
-sugar for subroutine and method calls, automatic register allocation,
-and more friendly conditional syntax. PIR is commonly used to write
-Parrot libraries -- including some of Parrot's compilers -- and is the
-target form when compiling high-level languages to Parrot. Even so, PIR
-is more rigid and "close to the machine" then some higher-level
-languages like C. X<.pir files> Files containing PIR code use the
-F<.pir> extension.
+language.N<Parrot has a pure native assembly language called PASM, described in
+Chapter 9.> PIR is fundamentally an assembly language, but it has some
+higher-level features such as operator syntax, syntactic sugar for subroutine
+and method calls, automatic register allocation, and more friendly conditional
+syntax. PIR is commonly used to write Parrot libraries -- including some of
+PCT's compilers -- and is the target form when compiling high-level languages
+to Parrot.
+
+Even so, PIR is more rigid and "close to the machine" then some higher-level
+languages like C. X<.pir files> Files containing PIR code use the F<.pir>
+extension.
-=head2 Basic Syntax
+=head2 Basics
PIR has a relatively simple syntax. Every line is a comment, a label, a
-statement, or a directive. There is no end-of-line symbol (such as a
-semicolon in C), the end of the line is the end of the statement or
-directive.
+statement, or a directive. Each statement or directive stands on its own line.
+There is no end-of-line symbol (such as a semicolon in other languages).
=head3 Comments
-X<PIR (Parrot intermediate representation); comments>
-X<comments (PIR)>
+X<PIR comments>
A comment begins with the C<#> symbol, and continues until the end of the line.
Comments can stand alone on a line or follow a statement or directive.
-=begin PIR
-
# This is a regular comment. The PIR
# interpreter ignores this.
-=end PIR
-
-X<Pod documentation>
+X<PIR POD>
PIR also treats inline documentation in Pod format as a comment. An
equals sign as the first character of a line marks the start of a Pod
block. A C<=cut> marker signals the end of a Pod block.
@@ -52,32 +47,21 @@
=cut
-=head3 Labels
+=head2 Labels
Z<CHP-3-SECT-4>
X<PIR (Parrot intermediate representation);labels> X<labels (PIR)> A label
-attaches a name to a line of code so other statements can refer to it.
-Labels can contain letters, numbers, and underscores. By convention,
-labels use all capital letters to stand out from the rest of the source
-code. It's fine to put a label on the same line as a statement or
-directive:
-
-=begin PIR_FRAGMENT
-
- GREET: print "'Allo, 'allo, 'allo."
-
-=end PIR_FRAGMENT
-
-Readability is improved by putting labels on separate lines, outdented
-to stand apart from the ordiary code flow:
-
-=begin PIR_FRAGMENT
+attaches to a line of code so other statements can refer to it. Labels can
+contain letters, numbers, and underscores. By convention, labels use all
+capital letters to stand out from the rest of the source code. A label can be
+precede a line of code, though outdenting labels on separate lines improves
+readability:
GREET:
- print "'Allo, 'allo, 'allo."
+ say "'Allo, 'allo, 'allo."
-=end PIR_FRAGMENT
+Labels are vital to control flow.
=head3 Statements
@@ -89,397 +73,102 @@
opcode is a native instruction for the virtual machine; it consists of the name
of the instruction followed by zero or more arguments.
-=begin PIR_FRAGMENT
-
- print "Norwegian Blue"
-
-=end PIR_FRAGMENT
+ say "Norwegian Blue"
PIR also provides higher-level constructs, including symbol operators:
-=begin PIR_FRAGMENT
-
$I1 = 2 + 5
-=end PIR_FRAGMENT
-
Under the hood, these special statement forms are just syntactic sugar for
regular opcodes. The C<+> symbol corresponds to the C<add> opcode, the C<->
-symbol to the C<sub> opcode, and so on. The previous example is equivalent to:
-
-=begin PIR_FRAGMENT
+symbol to the C<sub> opcode, and so on. The previous example is equivalent to:
add $I1, 2, 5
-=end PIR_FRAGMENT
-
=head3 Directives
-Directives look similar to opcodes, but they begin with a period (C<.>).
-Parrot's parser handles them specially. Some directives specify actions
-that occur at compile time. Other directives represent complex
-operations that require the generation of multiple instructions. The
-C<.local> directive, for example, declares a named variable.
-
-=begin PIR_FRAGMENT
+Directives begin with a period (C<.>); Parrot's parser handles them specially.
+Some directives specify actions that occur at compile time. Other directives
+represent complex operations that require the generation of multiple
+instructions. The C<.local> directive declares a typed register.
.local string hello
-=end PIR_FRAGMENT
+PIR also has a macro facility to create user-defined directives.
=head3 Literals
Integers and floating point numbers are numeric literals. They can be positive
or negative.
-=begin PIR_FRAGMENT
-
$I0 = 42 # positive
$I1 = -1 # negative
-=end PIR_FRAGMENT
-
-Integer literals can also be binary or hexadecimal:
-
-=begin PIR_FRAGMENT
+Integer literals can also be binary, octal, or hexadecimal:
$I3 = 0b01010 # binary
+ $I3 = 0o78 # octal
$I2 = 0xA5 # hexadecimal
-=end PIR_FRAGMENT
-
Floating point number literals have a decimal point, and can use scientific
notation:
-=begin PIR_FRAGMENT
-
$N0 = 3.14
$N2 = -1.2e+4
-=end PIR_FRAGMENT
-
X<strings;in PIR>
String literals are enclosed in single or double-quotes.N<L<Strings>
explains the differences between the quoting types.>
-=begin PIR_FRAGMENT
-
$S0 = "This is a valid literal string"
$S1 = 'This is also a valid literal string'
-=end PIR_FRAGMENT
-
=head3 Variables
-PIR variables can store four different kinds of valuesE<mdash>integers,
-numbers (floating point), strings, and objects. Parrot's objects are
-called PMCs, for "I<P>olyI<M>orphic I<C>ontainer".
-
-The simplest kind of variable is a register variable. The name of a
-register variable always starts with a dollar sign (C<$>), followed by a
-single character which specifies the type of the variableE<mdash>integer
-(C<I>), number (C<N>), string (C<S>), or PMC (C<P>)E<mdash>, and end
-with a unique number. Register variables don't need to be predeclared:
-
-=begin PIR_FRAGMENT
+PIR variables can store four different kinds of valuesE<mdash>integers, numbers
+(floating point), strings, and objects. The simplest way to work with these
+values is through register variables. Register variables always start with a
+dollar sign (C<$>) and a single character which specifies the type of the
+register: integer (C<I>), number (C<N>), string (C<S>), or PMC (C<P>).
+Registers have numbers as well; the "first" string register is
+C<$S0>.N<Register numbers may or may not correspond to the register used
+internally; Parrot's compiler remaps registers as appropriate.>
$S0 = "Who's a pretty boy, then?"
- print $S0
-
-=end PIR_FRAGMENT
+ say $S0
-PIR also has named variables, which are declared with the C<.local>
-directive. As with register variables, there are four valid types:
-C<int>, C<num>, C<string>, and C<pmc>. Named variables have to be
-declared, but otherwise behave exactly the same as register variables.
-
-=begin PIR_FRAGMENT
+PIR also has named variables, which are declared with the C<.local> directive.
+As with registers, there are four valid types for named variables: C<int>,
+C<num>, C<string>, and C<pmc>.N<Again, for "I<P>olyI<M>orphic I<C>ontainer".>
+After declaring a named variable, you can use the name anywhere you would use a
+register:
.local string hello
- hello = "'Allo, 'allo, 'allo."
- print hello
-
-=end PIR_FRAGMENT
-
-=head3 Constants
-
-X<PIR (Parrot intermediate representation);constants>
-X<constants (PIR)>
-
-The C<.const> directive declares a named constant. Named constants are
-similar to named variables, but their values are set in the declaration
-and can never be changed. Like C<.local>, C<.const> takes a type and a
-name. It also requires a literal argument to set the value of the
-constant.
-
-=begin PIR_FRAGMENT
-
- .const int frog = 4 # integer constant
- .const string name = "Superintendent Parrot" # string constant
- .const num pi = 3.14159 # floating point constant
-
-=end PIR_FRAGMENT
-
-Named constants may be used in all the same places as literals, but have
-to be declared beforehand. The following example declares a named string
-constant C<hello> and prints the value:
-
-=begin PIR_FRAGMENT
-
- .const string hello = "Hello, Polly."
- print hello
-
-=end PIR_FRAGMENT
-
-=head3 Control Structures
-
-Rather than providing a pre-packaged set of control structures like
-C<if> and C<while>, PIR gives you the building blocks to construct your
-own.N<PIR has many advanced features, but at heart it B<is> an assembly
-language.> The most basic of these building blocks is C<goto>, which
-jumps to a named label.N<This is not your father's C<goto>. It can only
-jump inside a subroutine, and only to a named label.> In the following
-code example, the C<print> statement will run immediately after the
-C<goto> statement:
-
-=begin PIR_FRAGMENT
-
- goto GREET
- # ... some skipped code ...
-
- GREET:
- print "'Allo, 'allo, 'allo."
-
-=end PIR_FRAGMENT
-
-Variations on the basic C<goto> check whether a particular condition is
-true or false before jumping:
-
-=begin PIR_FRAGMENT
-
- if $I0 > 5 goto GREET
-
-=end PIR_FRAGMENT
-
-All of the traditional control structures can be constructed from PIR's
-control building blocks.
-
-=head3 Subroutines
-
-A PIR subroutine starts with the C<.sub> directive and ends with the
-C<.end> directive. Parameter declarations use the C<.param> directive,
-and look a lot like named variable declarations. The following example
-declares a subroutined named C<greeting>, that takes a single string
-parameter named C<hello>:
-
-=begin PIR
-
- .sub greeting
- .param string hello
- print hello
- .end
-
-=end PIR
-
-=head3 That's All Folks
-
-You now know everything you need to know about PIR. Everything else you
-read or learn about PIR will use one of these fundamental language
-structures. The rest is vocabulary.
-
-=head2 Working with Variables
-
-We call the simple C<$I0>-style variables "register variables" for a
-specific reason: Parrot is a register-based virtual machine. It has 4
-typed register sets: integers, floating-point numbers, strings, and
-objects. When you're working with register variables or named variables,
-you're actually working directly with register storage locations in the
-virtual machine.
-
-If you've ever worked with an assembly language before, you may
-immediately jump to the conclusion that C<$I0> is the zeroth integer
-register, but Parrot is a bit smarter than that. The number of a
-register variable usually does not correspond to the register used
-internally; Parrot's compiler maps registers as appropriate for speed
-and memory considerations. The only guarantee Parrot gives you is that
-you'll always get the same storage location when you use C<$I0> in the
-same subroutine.
-
-The most basic operation on a variable is assignment using the C<=>
-operator:
-
-=begin PIR_FRAGMENT
-
- $I0 = 42 # set integer variable to the value 42
- $N3 = 3.14159 # set number variable to an approximation of pi
- $I1 = $I0 # set $I1 to the value of $I0
-
-=end PIR_FRAGMENT
-
-The C<exchange> opcode swaps the contents of two variables of the same
-type. The following example sets C<$I0> to the value of C<$I1>, and sets
-C<$I1> to the value of C<$I0>.
-
-=begin PIR_FRAGMENT
-
- exchange $I0, $I1
-
-=end PIR_FRAGMENT
-
-The C<null> opcode sets an integer or number variable to a zero value,
-and undefines a string or object.
-
-=begin PIR_FRAGMENT
-
- null $I0 # 0
- null $N0 # 0.0
- null $S0 # NULL
- null $P0 # PMCNULL
-
-=end PIR_FRAGMENT
-
-=head2 Working with Numbers
-
-X<PIR (Parrot assembly language);math operations>
-PIR has an extensive set of math instructions that work with integers,
-floating-point numbers, and numeric PMCs. Many of the math instructions
-have two- and three-argument forms:
-
-=begin PIR_FRAGMENT
-
- $I10 = $I11 + $I2
- $I0 += $I1
-
-=end PIR_FRAGMENT
-
-The three-argument form of C<+> stores the sum
-of the two arguments in the result variable. The two-argument form
-adds the first variable to the second and stores the result back in
-the first variable.
-
-The arguments can be Parrot variables or constants, but they
-must be compatible with the type of the result.
-Generally, "compatible" means that the result and arguments have to
-be the same type, but there are a few exceptions:
-
-=begin PIR_FRAGMENT
-
- $P0 = $P1 - 2
- $P0 = $P1 - 1.5
-
-=end PIR_FRAGMENT
-
-If the result is an integer type, like C<$I0>, the arguments must be
-integer variables or constants. A
-floating-point result, like C<$N0>, usually requires
-floating-point arguments, but many math instructions also allow the final
-argument to be an integer. Instructions with a PMC result may
-accept an integer, floating-point, or PMC final argument:
-
-=begin PIR_FRAGMENT
-
- mul $P0, $P1 # $P0 *= $P1
- mul $P0, $I1
- mul $P0, $N1
- mul $P0, $P1, $P2 # $P0 = $P1 * $P2
- mul $P0, $P1, $I2
- mul $P0, $P1, $N2
-
-=end PIR_FRAGMENT
-
-
-
-We won't list every math opcode here, but we'll list some of the most common
-ones. You can get a complete list in "PIR Opcodes" in Chapter 11.
-
-=head4 Unary math opcodes
-
-Z<CHP-9-SECT-2.3.1>
-
-The unary opcodes have either a destination argument and a source
-argument, or a single argument as destination and source. Some of the
-most common unary math opcodes are C<inc> (increment), C<dec>
-(decrement), C<abs> (absolute value), C<neg> (negate), and C<fact>
-(factorial):
-
-=begin PIR_FRAGMENT
-
- abs $N0, -5.0 # the absolute value of -5.0 is 5.0
- fact $I1, 5 # the factorial of 5 is 120
- inc $I1 # 120 incremented by 1 is 121
-
-=end PIR_FRAGMENT
-
-=head4 Binary math opcodes
-
-Z<CHP-9-SECT-2.3.2>
-
-X<PIR (Parrot assembly language);math operations;binary>
-Binary opcodes have two source arguments and a destination argument, and we
-saw examples of these types above. As we mentioned before, most binary math
-opcodes have a two-argument form in which the first argument is both a source
-and the destination. Parrot provides C<add>X<add opcode (PIR)> (addition),
-C<sub>X<sub opcode (PIR)> (subtraction), C<mul>X<mul opcode (PIR)>
-(multiplication), C<div>X<div opcode (PIR)> (division), and C<pow>X<pow
-opcode (PIR)> (exponent) opcodes, as well as two different modulus
-operations. C<mod>X<mod opcode (PIR)> is Parrot's implementation of modulus,
-and C<cmod>X<cmod opcode (PIR)> performs an operation equivalent the C<%>
-operator from the C programming language. It also provides C<gcd>X<gcd opcode
-(PIR)> (greatest common divisor) and C<lcm>X<lcm opcode (PIR)> (least common
-multiple).
-
-=begin PIR_FRAGMENT
-
- div $I0, 12, 5 # $I0 = 12 / 5
- mod $I0, 12, 5 # $I0 = 12 % 5
-
-=end PIR_FRAGMENT
-
-=head4 Floating-point operations
-
-Z<CHP-9-SECT-2.3.3>
-
-X<PIR (Parrot assembly language);math operations;floating-point>
-Although most of the math operations work with both floating-point numbers
-and integers, a few require floating-point destination registers. Among these
-are C<ln> (natural log), C<log2> (log base 2), C<log10> (log base 10), and
-C<exp> (I<e>G<x>), as well as a full set of trigonometric opcodes such as
-C<sin> (sine), C<cos> (cosine), C<tan> (tangent), C<sec> (secant), C<cosh>
-(hyperbolic cosine), C<tanh> (hyperbolic tangent), C<sech> (hyperbolic secant),
-C<asin> (arc sine), C<acos> (arc cosine), C<atan> (arc tangent), C<asec> (arc
-secant), C<exsec> (exsecant), C<hav> (haversine), and C<vers> (versine). All
-angle arguments for the X<trigonometric functions (PIR)> trigonometric
-functions are in radians:
-
-=begin PIR_FRAGMENT
-
- sin $N1, $N0
- exp $N1, 2
-
-=end PIR_FRAGMENT
-
-The majority of the floating-point operations have a single source argument
-and a single destination argument. Even though the destination must be a
-floating-point register, the source can be either an integer or floating-point
-number.
-
-The C<atan>X<atan opcode (PIR)> opcode also has a three-argument variant that
-implements C's C<atan2()>:
-
-=begin PIR_FRAGMENT
-
- atan $N0, 1, 1
-
-=end PIR_FRAGMENT
-
+ set hello, "'Allo, 'allo, 'allo."
+ say hello
+Integer (C<I>) and Number (C<N>) registers use platform-dependent sizes and
+limitations.N<There are a few exceptions to this; Parrot smooths out some of the
+bumps and inconsistencies so that PIR code behaves the same way on all
+supported platforms.> Internally, Parrot treats both I and N registers as
+signed quantities internally for the purposes of arithmetic. Parrot's floating
+point values and operations all comply with the IEEE 754 standard.
+
+Strings (S) are buffers of variable-sized data. The most common use of S
+registers and variables is to store textual data. S registers I<may> also be
+buffers for binary or other non-textual data, though this is rare.N<In general,
+a custom PMC is mroe useful.> Parrot strings are flexible and powerful, to
+account for all the complexity of human-readable (and computer-representable)
+textual data.
+The final data type is the PMC. PMC resemble classes and objects are in
+object-oriented languages. They are the basis for complex data structures and
+object-oriented behavior in Parrot.
-=head2 Working with Strings
+=head2 Strings
Strings in double-quotes accept all sorts of escape sequences using
-backslashes. Strings in single-quotes only allow escapes for nested
-quotes:
+backslashes. Strings in single-quotes only allow escapes for nested quotes:
$S0 = "This string is \n on two lines"
$S0 = 'This is a \n one-line string with a slash in it'
@@ -516,2724 +205,721 @@
End_Token
-=head3 Assignment
+=head3 Strings: Encodings and Charsets
-Strings in Parrot are also stored as references to internal data structures
-like PMCs. However, strings use Copy-On-Write (COW) optimizations. When we
-call C<set S1, S0> we copy the pointer only, so both registers point to the
-same string memory. We don't actually make a copy of the string until one of
-two registers is modified. Here's the same example using string registers
-instead of PMC registers, which demonstrate how strings use COW:
-
-=begin PASM
-
- set S0, "Ford"
- set S1, S0
- set S1, "Zaphod"
- print S0 # prints "Ford"
- print S1 # prints "Zaphod"
- end
-
-=end PASM
-
-Here, we can clearly see the opposite result from how PMCs were handled in
-the previous example. Modifying one of the two registers causes a new string
-to be created, preserving the old value in C<S0> and assigning the new value
-to the new string in C<S1>. The benefits here are that we don't have to worry
-about stray references causing side effects in our code, and we don't waste
-time copying a string until it's actually time to make a copy.
-
-
-Strings are buffers of variable-sized data. The most common use of string
-registers and variables is to store textual data. String registers I<may> also be
-buffers for binary or other non-textual data, though this is rareN<In general,
-a custom PMC is more useful>. Parrot strings are flexible and powerful, to
-account for all the complexity of human-readable (and computer-representable)
-textual data.
-
-X<PIR (Parrot assembly language);string operations>
-String operations work with string registers and string-like PMCs.
-String operations on PMC registers require all their string
-arguments to be String PMCs.
-
-=head4 Concatenating strings
+X<charset>
+Strings are complicated; string declarations aren't the whole story. In olden
+times, strings only needed to support the ASCII character set (or charset), a
+mapping of 128 bit patterns to symbols and English-language characters. This
+worked as long as everyone using a computer read and wrote English and used a
+small handful of punctuation symbols.
-Z<CHP-9-SECT-2.4.1>
+In other words, it was woefully insufficient for international uses, polyglots, and more.
-X<PIR (Parrot assembly language);string operations;concatenation>
-Use the C<concat>X<concat opcode (PIR)> opcode to concatenate
-strings. With string register or string constant arguments, C<concat>
-has both a two-argument and a three-argument form. The first argument
-is a source and a destination in the two-argument form:
+A modern string system must manage several character encodings and charsets in
+order to make sense out of all the string data in the world. Parrot does this.
+Every string has an associated encoding and an associated character set. The
+default charset is 8-bit ASCII, which is simple to use and is almost
+universally supported.
-=begin PIR_FRAGMENT
+Double-quoted string constants can have an optional prefix specifying the the
+string's encoding and charset.N<As you might suspect, single-quoted strings do
+not support this.> Parrot will maintain these values internally, and will
+automatically convert strings when necessary to preserve the information.
+String prefixes are specified as C<encoding:charset:> at the front of the
+string. Here are some examples:
- set $S0, "ab"
- concat $S0, "cd" # S0 has "cd" appended
- print $S0 # prints "abcd"
- print "\n"
+ $S0 = utf8:unicode:"Hello UTF8 Unicode World!"
+ $S1 = utf16:unicode:"Hello UTF16 Unicode World!"
+ $S2 = ascii:"This is 8-bit ASCII"
+ $S3 = binary:"This is raw, unformatted binary data"
- concat $S1, $S0, "xy" # S1 is the string S0 with "xy" appended
- print $S1 # prints "abcdxy"
- print "\n"
+The C<binary:> charset treats the string as a buffer of raw unformatted binary
+data. It isn't really a string per se, because binary data contains no readable
+characters. As mentioned earlier, this exists to support libraries which
+manipulate binary data that doesn't easily fit into any other primitive data
+type.
-=end PIR_FRAGMENT
+When Parrot combines two strings (such as through concatenation), they must
+both use the same character set and encoding. Parrot will automatically
+upgrade one or both of the strings to use the next highest compatible format as
+necessary. ASCII strings will automatically upgrade to UTF-8 strings if needed,
+and UTF-8 will upgrade to UTF-16. All of these conversions happen inside
+Parrot; you the programmer don't need to worry about the details.
-The first C<concat> concatenates the string "cd" onto the string "ab" in
-C<S0>. It generates a new string "abcd" and changes C<S0> to point to the
-new string. The second C<concat> concatenates "xy" onto the string "abcd"
-in C<S0> and stores the new string in C<S1>.
+=head2 Named Variables
-X<PMCs (Polymorphic Containers);concatenation>
-For PMC registers, C<concat> has only a three-argument form with
-separate registers for source and destination:
+Z<CHP-3-SECT-2.3>
-=begin PIR_FRAGMENT
+X<named variables (PIR)>
+X<PIR (Parrot intermediate representation);named variables>
- new $P0, "String"
- new $P1, "String"
- new $P2, "String"
- set $P0, "ab"
- set $P1, "cd"
- concat $P2, $P0, $P1
- print $P2 # prints abcd
- print "\n"
+=for author
-=end PIR_FRAGMENT
+The declaration section earlier alludes to this.
-Here, C<concat> concatenates the strings in C<$P0> and C<$P1> and stores
-the result in C<$P2>.
+=end for
-=head4 Repeating strings
+Calling a value "$S0" isn't very descriptive, and usually it's a lot
+nicer to be able to refer to values using a helpful name. For this
+reason Parrot allows registers to be given temporary variable names to
+use instead. These named variables can be used anywhere a register
+would be used normally.N<...because they actually are registers, but
+with fancier names.> They're declared with the C<.local> statement
+which requires a variable type and a name:
-Z<CHP-9-SECT-2.4.2>
+ .local string hello
+ set hello, "Hello, Polly."
+ say hello
-X<PIR (Parrot assembly language);string operations;repeating strings>
-The C<repeat>X<repeat opcode (PIR)> opcode repeats a string a certain
-number of times:
+This snippet defines a string variable named C<hello>, assigns it the value
+"Hello, Polly.", and then prints the value. Under the hood these named
+variables are just normal registers of course, so any operation that a register
+can be used for a named variable can be used for as well.
+
+X<types;variable (PIR)>
+X<variables;types (PIR)>
+The valid types are C<int>, C<num>, C<string>, and C<pmc>
+It should come as no surprise that these are the same as Parrot's four
+built-in register types. Named variables are valid from the point of
+their definition to the end of the current subroutine.
+
+The name of a variable must be a valid PIR identifier. It can contain letters,
+digits and underscores but the first character has to be a letter or an
+underscore. There is no limit to the length of an identifier, other than good
+taste.
+
+As mentioned earlier, Parrot's internal compiler may remap named registers and
+symbolic registers to actual registers as necessary. This happens
+transparently, and for the most part you never need to know about it. There's
+one exception: when you know something outside of Parrot must refer to a
+specific register exactly.N<For example, when an NCI call takes a pointer to a
+register and returns a value through the pointer.> Use the C<:unique_reg>
+modifier on a variable declaration to prevent potential register allocation
+changes:
+
+ .local pmc MyUniquePMC :unique_reg
-=begin PIR_FRAGMENT
+This attribute C<:unique_reg> will not affect the behavior of Parrot otherwise.
- set $S0, "x"
- repeat $S1, $S0, 5 # $S1 = $S0 x 5
- print $S1 # prints "xxxxx"
- print "\n"
+=head2 PMC variables
-=end PIR_FRAGMENT
+Z<CHP-3-SECT-2.4>
-In this example, C<repeat> generates a new string with "x" repeated
-five times and stores a pointer to it in C<S1>.
+PMC registers and variables act much like any integer, floating-point
+number, or string register or variable, but you have to instantiate a
+new PMC object into a type before you use it. The C<new> instruction creates
+a new PMC of the specified type:
-=head4 Length of a string
+ $P0 = new 'String'
+ $P0 = "Hello, Polly."
+ say $P0
-Z<CHP-9-SECT-2.4.3>
+This example creates a C<String> object, stores it in the PMC register C<$P0>,
+assigns it the value "Hello, Polly.", and prints it. The type provided to the
+C<.local> directive is either the generic C<pmc> or a type compatible with the
+type passed to C<new>:
-X<PIR (Parrot assembly language);string operations;length>
-The C<length>X<length opcode (PIR)> opcode returns the length of a
-string in characters. This won't be the same as the length in bytes
-for multibyte encoded strings:
+ .local String hello # or .local pmc hello
+ hello = new 'String'
+ hello = "Hello, Polly."
+ say hello
-=begin PIR_FRAGMENT
+PIR is a dynamic language; that dynamicism is evident in how Parrot handles PMC
+values. Primitive registers like strings, numbers, and integers perform a
+special action called X<autoboxing> when assigned to a PMC. Autoboxing is the
+process of converting a primitive type to a PMC object. PMC classes exist for
+String, Number, and Integer; notice that the primitive types are in lower-case,
+while the PMC classes are capitalized. If you want to box a value explicitly,
+use the C<box> opcode:
- set $S0, "abcd"
- length $I0, $S0 # the length is 4
- print $I0
- print "\n"
+ $P0 = new 'Integer' # The boxed form of int
+ $P0 = box 42
+ $P1 = new 'Number' # The boxed form of num
+ $P1 = box 3.14
+ $P2 = new 'String' # The boxed form of string
+ $P2 = "This is a string!"
-=end PIR_FRAGMENT
+The PMC classes C<Integer>, C<Number>, and C<String> are thin overlays on the
+primitive types they represent. These PMC types have the benefit of the
+X<PMC;VTABLE Interface> VTABLE interface. VTABLEs are a standard API that all
+PMCs conform to for performing standard operations. These PMC types support
+custom methods to perform various operations, may be passed to subroutines that
+expect PMC arguments, and can be subclassed by a user-defined type.
-C<length> doesn't have an equivalent for PMC strings.
+=head2 Named Constants
-=head4 Substrings
+Z<CHP-3-SECT-2.5>
-Z<CHP-9-SECT-2.4.4>
+X<PIR (Parrot intermediate representation);named constants>
+X<named constants (PIR)>
-X<PIR (Parrot assembly language);string operations;substrings>
-The simplest version of the C<substr>X<substr opcode (PIR)> opcode
-takes four arguments: a destination register, a string, an offset
-position, and a length. It returns a substring of the original string,
-starting from the offset position (0 is the first character) and
-spanning the length:
+The C<.const> directive declares a named constant. It resembles C<.local>; it
+requires a type and a name. It also requires the assignment of a constant
+value. As with named variables, named constants are visibl only within the
+compilation unit where they're declared. This example declares a named string
+constant C<hello> and prints the value:
-=begin PIR_FRAGMENT
+ .const string hello = "Hello, Polly."
+ say hello
- substr $S0, "abcde", 1, 2 # $S0 is "bc"
+Named constants may be used in all the same places as literal constants,
+but have to be declared beforehand:
-=end PIR_FRAGMENT
+ .const int the_answer = 42 # integer constant
+ .const string mouse = "Mouse" # string constant
+ .const num pi = 3.14159 # floating point constant
-This example extracts a two-character string from "abcde" at a
-one-character offset from the beginning of the string (starting with
-the second character). It generates a new string, "bc", in the
-destination register C<S0>.
+In addition to normal local constants, you can also specify a global constant
+which is accessible from everywhere in the current code file:
-When the offset position is negative, it counts backward from the end
-of the string. So an offset of -1 starts at the last character of the
-string.
+ .globalconst int days = 365
-C<substr> also has a five-argument form, where the fifth argument is a
-string to replace the substring. This modifies the second argument and
-returns the removed substring in the destination register.
+Currently there is no way to specify a PMC constant in PIR source code.
-=begin PIR_FRAGMENT
+=for author
- set $S1, "abcde"
- substr $S0, $S1, 1, 2, "XYZ"
- print $S0 # prints "bc"
- print "\n"
- print $S1 # prints "aXYZde"
- print "\n"
+Why declare constants?
-=end PIR_FRAGMENT
+=end for
-This replaces the substring "bc" in C<S1> with the string "XYZ", and
-returns "bc" in C<S0>.
+=head2 Symbol Operators
-When the offset position in a replacing C<substr> is one character
-beyond the original string length, C<substr> appends the replacement
-string just like the C<concat> opcode. If the replacement string is an
-empty string, the characters are just removed from the original
-string.
+Z<CHP-3-SECT-3>
-When you don't need to capture the replaced string, there's an
-optimized version of C<substr> that just does a replace without
-returning the removed substring.
+X<symbol operators in PIR>
-=begin PIR_FRAGMENT
+=for author
- set $S1, "abcde"
- substr $S1, 1, 2, "XYZ"
- print $S1 # prints "aXYZde"
- print "\n"
+An earlier section described this already too.
-=end PIR_FRAGMENT
+=end for
-The PMC versions of C<substr> are not yet implemented.
+PIR has many other symbolic operators: arithmetic, concatenation, comparison,
+bitwise, and logical. All PIR operators are translated into one or more Parrot
+opcodes internally, but the details of this translation stay safely hidden from
+the programmer. Consider this example snippet:
+
+ .local int sum
+ sum = $I42 + 5
+ say sum
+
+The statement C<sum = $I42 + 5> translates to the equivalent statement C<add
+sum, $I42, 5>. PIR symbolic operations are:
+
+ $I0 = $I1 + 5 # Addition
+ $N0 = $N1 - 7 # Subtraction
+ $I3 = 4 * 6 # Multiplication
+ $N7 = 3.14 / $N2 # Division
+ $S0 = $S1 . $S2 # String concatenation
+
+PIR also provides automatic assignment operators such as C<+=>, C<-=>,
+and C<<< >>= >>>. These operators help programmers to perform common
+manipulations on a data value in place, and save a few keystrokes while
+doing them.
-=head4 Chopping strings
+A complete list of PIR operators is available in Chapter 13.
-Z<CHP-9-SECT-2.4.5>
+=head2 C<=> and Type Conversion
-X<PIR (Parrot assembly language);string operations;chopping strings>
-The C<chopn>X<chopn opcode (PIR)> opcode removes characters from the
-end of a string. It takes two arguments: the string to modify and the
-count of characters to remove.
+The C<=> operator is very powerful. Its simplest form stores a value into one
+of the Parrot registers. It can assign a string value to a C<string> register,
+an integer value to an C<int> register, a floating point value into a C<number>
+register, etc. However, the C<=> operator can assign I<any> type of value into
+I<any> type of register; Parrot will handle the conversion for you
+automatically:
-=begin PIR_FRAGMENT
+ $I0 = 5 # Integer. 5
+ $S0 = $I0 # Stringify. "5"
+ $N0 = $S0 # Numify. 5.0
+ $I0 = $N0 # Intify. 5
- set $S0, "abcde"
- chopn $S0, 2
- print $S0 # prints "abc"
- print "\n"
+Notice that conversions between the numeric formats and strings only makes
+sense when the value to convert is a number.
-=end PIR_FRAGMENT
+ $S0 = "parrot"
+ $I0 = $S0 # 0
-This example removes two characters from the end of C<S0>. If the
-count is negative, that many characters are kept in the string:
+An earlier example showed a string literal assigned to a PMC register of type
+C<String>. This works for all the primitive types and their autoboxed PMC
+equivalents:
-=begin PIR_FRAGMENT
+ $P0 = new 'Integer'
+ $P0 = 5
+ $S0 = $P0 # Stringify. "5"
+ $N0 = $P0 # Numify. 5.0
+ $I0 = $P0 # Unbox. $I0 = 5
- set $S0, "abcde"
- chopn $S0, -2
- print $S0 # prints "ab"
- print "\n"
+ $P1 = new 'String'
+ $P1 = "5 birds"
+ $S1 = $P1 # Unbox. $S1 = "5 birds"
+ $I1 = $P1 # Intify. 5
+ $N1 = $P1 # Numify. 5.0
-=end PIR_FRAGMENT
+ $P2 = new 'Number'
+ $P2 = 3.14
+ $S2 = $P2 # Stringify. "3.14"
+ $I2 = $P2 # Intify. 3
+ $N2 = $P2 # Unbox. $N2 = 3.14
-This keeps the first two characters in C<S0> and removes the rest.
-C<chopn> also has a three-argument version that stores the chopped
-string in a separate destination register, leaving the original string
-untouched:
+=head2 Compilation Units
-=begin PIR_FRAGMENT
+Z<CHP-3-SECT-4.1>
- set $S0, "abcde"
- chopn $S1, $S0, 1
- print $S1 # prints "abcd"
- print "\n"
+X<PIR (Parrot intermediate representation);subroutine> X<subroutine (PIR)>
+Subroutines in PIR are roughly equivalent to the subroutines or methods of a
+high-level language. All code in a PIR source file must appear within a
+subroutine. The simplest syntax for a PIR subroutine starts with the C<.sub>
+directive and ends with the C<.end> directive:
-=end PIR_FRAGMENT
+=begin PIR
-=head4 Copying and Cloning
+ .sub 'main'
+ say "Hello, Polly."
+ .end
-Z<CHP-9-SECT-2.4.6>
+=end PIR
-X<PIR (Parrot assembly language);string operations;copying> The C<clone>
-X<clone opcode (PIR)> opcode makes a deep copy of a string or PMC. Earlier
-in this chapter we saw that PMC and String values used with the C<set> opcode
-didn't create a copy of the underlying data structure, it only created
-a copy of the reference to that structure. With strings, this doesn't cause
-a problem because strings use Copy On Write (COW) semantics to automatically
-create a copy of the string when one reference is modified. However, as we
-saw, PMCs don't have this same behavior and so making a change to one PMC
-reference would modify the data that all the other references to that same
-PMC pointed to.
+This example defines a subroutine named C<main> that prints a string C<"Hello,
+Polly.">. Parrot will normally execute the first subroutine it encounters in
+the first file it runs, but you can flag any subroutine as the first one to
+execute with the C<:main> marker:
-Instead of just copying the pointer like C<set> would do, we can use the
-C<clone> opcode to create a I<deep copy> of the PMC, not just a I<shallow
-copy> of the reference.
+=begin PIR
-=begin PIR_FRAGMENT
+ .sub 'first'
+ say "Polly want a cracker?"
+ .end
- new $P0, "String"
- set $P0, "Ford"
- clone $P1, $P0
- set $P0, "Zaphod"
- print $P0 # prints "Zaphod"
- print $P1 # prints "Ford"
+ .sub 'second' :main
+ say "Hello, Polly."
+ .end
-=end PIR_FRAGMENT
+=end PIR
-This example creates an identical, independent clone of the PMC in
-C<P0> and puts a pointer to it in C<P1>. Later changes to C<P0> have
-no effect on the PMC referenced in C<P1>.
+This code prints out "Hello, Polly." but not "Polly want a cracker?". Though
+the C<first> function appears first in the source code, C<second> has the
+C<:main> flag and gets called. C<first> is never called. Revising that
+program produces different results:
-With simple strings, the copes created by C<clone> are COW exactly the same
-as the copy created by C<set>, so there is no difference between these two
-opcodes for strings. By convention, C<set> is used with strings more often
-then C<clone>, but there is no rule about this.
+=begin PIR
-=head4 Converting characters
+ .sub 'first' :main
+ say "Polly want a cracker?"
+ .end
-Z<CHP-9-SECT-2.4.7>
+ .sub 'second'
+ say "Hello, Polly."
+ .end
-X<PIR (Parrot assembly language);string operations;converting strings>
-The C<chr>X<chr opcode (PIR)> opcode takes an integer value and returns the
-corresponding character in the ASCII character set as a one-character string,
-while the C<ord>X<ord opcode (PIR)> opcode takes a single character string
-and returns the integer value of the character at the first position in the
-string. Notice that the integer value of the character will differ depending
-on the current encoding of the string:
+=end PIR
-=begin PIR_FRAGMENT
+The output now is "Polly want a cracker?". Execution in PIR starts at the
+C<:main> function and continues until that function ends. To perform other
+operations, you must call other functions explicitly. Chapter 4 describes
+subroutines and their uses.
- chr $S0, 65 # $S0 is "A"
- ord $I0, $S0 # $I0 is 65, if $S0 is ASCII or UTF-8
+=head2 Flow Control
-=end PIR_FRAGMENT
+Z<CHP-3-SECT-5>
-C<ord> has a three-argument variant that takes a character offset to select
-a single character from a multicharacter string. The offset must be within
-the length of the string:
+X<PIR (Parrot intermediate representation);flow control>
+X<flow control;in PIR>
-=begin PIR_FRAGMENT
+Flow control in PIR occurs entirely with conditional and unconditional branches
+to labels. This may seem simplistic and primitive, but here PIR shows its roots
+as a thin overlay on the assembly language of a virtual processor. PIR does
+not support high-level looping structures such as C<while> or C<for> loops. PIR
+has some support for basic C<if> branching constructs, but does not support
+more complicated C<if>/C<then>/C<else> branch structures.
- ord $I0, "ABC", 2 # $I0 is 67
-
-=end PIR_FRAGMENT
-
-A negative offset counts backward from the end of the string, so -1 is
-the last character.
-
-=begin PIR_FRAGMENT
-
- ord $I0, "ABC", -1 # $I0 is 67
-
-=end PIR_FRAGMENT
-
-=head4 Formatting strings
-
-Z<CHP-9-SECT-2.4.8>
-
-X<PIR (Parrot assembly language);string operations;formatting strings>
-The C<sprintf>X<sprintf opcode (PIR)> opcode generates a formatted string
-from a series of values. It takes three arguments: the destination register,
-a string specifying the format, and an ordered aggregate PMC (like an
-C<Array> PMC) containing the values to be formatted. The format string and
-the destination register can be either strings or PMCs:
-
-=begin PIR_FRAGMENT
-
- sprintf $S0, $S1, $P2
- sprintf $P0, $P1, $P2
-
-=end PIR_FRAGMENT
-
-The format string is similar to the one for C's C<sprintf> function,
-but with some extensions for Parrot data types. Each format field in
-the string starts with a C<%>
-X<% (percent sign);% format strings for sprintf opcode (PIR)> and
-ends with a character specifying the output format. The output format
-characters are listed in Table 9-1.
-
-=begin table picture Format characters
-
-Z<CHP-9-TABLE-1>
-
-=headrow
-
-=row
-
-=cell Format
-
-=cell Meaning
-
-=bodyrows
-
-=row
-
-=cell C<%c>
-
-=cell A single character.
-
-=row
-
-=cell C<%d>
-
-=cell A decimal integer.
-
-=row
-
-=cell C<%i>
-
-=cell A decimal integer.
-
-=row
-
-=cell C<%u>
-
-=cell An unsigned integer.
-
-=row
-
-=cell C<%o>
-
-=cell An octal integer.
-
-=row
-
-=cell C<%x>
-
-=cell A hex integer, preceded by 0x when # is specified.
-
-=row
+The control structures of high-level languages hew tightly to the semantics of
+those languages; Parrot provides the minimal feature set necessary to implement
+any semantic of an HLL without dictating how that HLL may implement its
+features. Language agnosticism is an important design goal in Parrot, and
+creates a very flexible and powerful development environment for language
+developers.
-=cell C<%X>
+X<goto instruction (PIR)>
+The most basic branching instruction is the unconditional branch, C<goto>:
-=cell A hex integer with a capital X (when # is specified).
+=begin PIR
-=row
+ .sub 'main'
+ goto L1
+ say "never printed"
-=cell C<%b>
+ L1:
+ say "after branch"
+ end
+ .end
-=cell A binary integer, preceded by 0b when # is specified.
+=end PIR
-=row
+The first C<say> statement never runs because the C<goto> always skips over it
+to the label C<L1>.
-=cell C<%B>
+The conditional branches combine C<if> or C<unless> with C<goto>.
-=cell A binary integer with a capital B (when # is specified).
+=begin PIR
-=row
+ .sub 'main'
+ $I0 = 42
+ if $I0 goto L1
+ say "never printed"
+ L1:
+ say "after branch"
+ end
+ .end
-=cell C<%p>
+=end PIR
-=cell A pointer address in hex.
+X<if (conditional);instruction (PIR)> X<unless (conditional);instruction (PIR)>
+In this example, the C<goto> branches to the label C<L1> only if the value
+stored in C<$I0> is true. The C<unless> statement is similar, but it branches
+when the tested value is false. You can use PMC and STRING registers with
+C<if> and C<unless>. The op will call the C<get_bool> vtable entry on any PMC
+so used and will convert the STRING to a boolean value. An undefined value, 0,
+or an empty string are all false values. All other values are true.
-=row
+The comparison operators (C<E<lt>>, C<E<lt>=>, C<==>, C<!=>, C<E<gt>>,
+C<E<gt>=>) can combine with C<if ... goto>. These branch when the
+comparison is true:
-=cell C<%f>
+=begin PIR
-=cell A floating-point number.
+ .sub 'main'
+ $I0 = 42
+ $I1 = 43
+ if $I0 < $I1 goto L1
+ say "never printed"
+ L1:
+ say "after branch"
+ end
+ .end
-=row
+=end PIR
-=cell C<%e>
+This example compares C<$I0> to C<$I1> and branches to the label C<L1> if
+C<$I0> is less than C<$I1>. The C<if $I0 E<lt> $I1 goto L1> statement
+translates directly to the C<lt> branch operation.
-=cell A floating-point number in scientific notation (displayed with a
-lowercase "e").
+Chapter 11's "PIR Instructions" section summarizes the other comparison
+operators.
-=row
+X<loops;PIR>
+X<PIR (Parrot intermediate representation);loop constructs>
+PIR has no special loop constructs. A combination of conditional and
+unconditional branches handle iteration:
-=cell C<%E>
+=begin PIR
-=cell The same as C<%e>, but displayed with an uppercase E.
+ .sub 'main'
+ $I0 = 1 # product
+ $I1 = 5 # counter
-=row
+ REDO: # start of loop
+ $I0 = $I0 * $I1
+ dec $I1
+ if $I1 > 0 goto REDO # end of loop
-=cell C<%g>
+ say $I0
+ end
+ .end
-=cell The same as either C<%e> or C<%f>, whichever fits best.
+=end PIR
-=row
+X<do-while style loop;(PIR)>
+This example calculates the factorial C<5!>. Each time through the loop it
+multiplies C<$I0> by the current value of the counter C<$I1>, decrements the
+counter, and branches to the start of the loop. The loop ends when C<$I1>
+counts down to 0. This is a I<do while>-style loop with the condition test at
+the end so that the code always runs at least once through the loop.
-=cell C<%G>
+X<while-style loop (PIR)>
+For a I<while>-style loop with the condition test at the start, use a
+conditional branch with an unconditional branch:
-=cell The same as C<%g>, but displayed with an uppercase E.
+=begin PIR
-=row
+ .sub 'main'
+ $I0 = 1 # product
+ $I1 = 5 # counter
-=cell C<%s>
+ REDO: # start of loop
+ if $I1 <= 0 goto LAST
+ $I0 = $I0 * $I1
+ dec $I1
+ goto REDO
+ LAST: # end of loop
-=cell A string.
+ say $I0
+ end
+ .end
-=end table
+=end PIR
-Each format field can be specified with several options: R<flags>,
-R<width>, R<precision>, and R<size>. The format flags are listed in
-Table 9-2.
+This example tests the counter C<$I1> at the start of the loop. At the end of
+the loop, it unconditionally branches back to the start of the loop and tests
+the condition again. The loop ends when the counter C<$I1> reaches 0 and the
+C<if> branches to the C<LAST> label. If the counter isn't a positive number
+before the loop, the loop will never execute.
-=begin table picture Format flags
+You can build any high-level flow control construct from conditional and
+unconditional branches; the lowest level of computer hardware works this way.
+All modern programming languages use branching constructs to implement their
+most complex flow control devices.
-Z<CHP-9-TABLE-2>
+That doesn't make complex code easier to write in PIR. Fortunately, a series
+of macros exist to simplify flow control.
-=headrow
+=head2 Macros
-=row
+=for author
-=cell Flag
+Needs supplementing; needs moving.
-=cell Meaning
+=end for
-=bodyrows
+=head2 Subroutines
-=row
+Z<CHP-4>
-=cell 0
+X<PIR (Parrot intermediate representation);subroutines>
+X<subroutines;in PIR>
+The most basic building block of code reuse in PIR is the subroutine. A large
+program may perform a calculation like "the factorial of a number" several
+times. Subroutines abstract this behavior into a single, named, stand-alone
+unit. PIR is a subroutine-based language in that all code in PIR must exist in
+a subroutine. Execution starts in the C<:main> subroutine, which itself can
+call other subroutines. Subroutines can fit together into more elaborate
+chunks of code reusability such as methods and objects.
-=cell Pad with zeros.
+Parrot supports multiple high-level languages. Each language uses a different
+syntax for defining and calling subroutines. The goal of PIR is not to be a
+high-level language in itself, but to provide the basic tools that other
+languages can use to implement them. PIR's subroutine syntax may seem very
+primitive for this reason.
-=row
+=head2 Parrot Calling Conventions
-=cell E<lt>spaceE<gt>
+Z<CHP-4-SECT-1>
-=cell Pad with spaces.
+X<PIR (Parrot intermediate representation);subroutines;Parrot calling conventions>
+X<subroutines;Parrot calling conventions;in PIR>
-=row
+The way that Parrot calls a subroutine -- passing arguments, altering control
+flow, and returning results -- is the "Parrot Calling Conventions" (PCC).
+Parrot generally hides the details of PCC from the programmer. PIR has several
+constructs to gloss over these details, and the average programmer will not
+need to worry about them. PCC uses the Continuation Passing Style
+X<Continuation Passing Style (CPS)>X<CPS (Continuation Passing Style)> (CPS) to
+pass control to subroutines and back again. Again, the details are irrelevant
+for most uses, but the power is available to anyone who wants to take advantage
+of it.
-=cell C<+>
+=head3 Subroutine Calls
-=cell Prefix numbers with a sign.
+X<PIR (Parrot intermediate representation);subroutine calls>
+PIR's simplest subroutine call syntax looks much like a subroutine
+call from a high-level language. This example calls the subroutine
+C<fact> with two arguments and assigns the result to C<$I0>:
-=row
+ $I0 = 'fact'(count, product)
-=cell C<->
+This simple statement hides much complexity. It generates a subroutine PMC
+object, creates a continuation PMC object to represent the control flow up to
+this point, passes the arguments, looks up the subroutine by name (and by
+signature, if necessary)), calls the subroutine, and assigns the results of the
+call to the appropriate integer register. This is all in addition to the
+computation the subroutine itself performs.
-=cell Align left.
+=head3 Expanded Subroutine Syntax
-=row
+The single line subroutine call is incredibly convenient, but it isn't always
+flexible enough. PIR also has a more verbose call syntax that is still more
+convenient than manual calls. This example looks up the subroutine C<fact> out
+in the global symbol table and calls it:
-=cell C<#>
+ find_global $P1, "fact"
-=cell Prefix a leading 0 for octal, 0x for hex, or force a decimal point.
+ .begin_call
+ .arg count
+ .arg product
+ .call $P1
+ .result $I0
+ .end_call
-=end table
+X<.arg directive>
+X<.result directive>
+The whole chunk of code from C<.begin_call> to C<.end_call> acts as a single
+unit. The C<.arg> directive sets up and passes arguments to the call. The
+C<.call> directive calls the subroutine and identifies the point at which to
+return control flow after the subroutine has completed. The C<.result>
+directive retrieves returned values from the call.
-The R<width> is a number defining the minimum width of the output from
-a field. The R<precision> is the maximum width for strings or
-integers, and the number of decimal places for floating-point fields.
-If either R<width> or R<precision> is an asterisk (C<*>), it takes its
-value from the next argument in the PMC.
+=head3 Subroutine Declarations
-The R<size> modifier defines the type of the argument the field takes.
-The flags are listed in Table 9-3.
+X<.param directive> In addition to syntax for subroutine calls, PIR provides
+syntax for subroutine definitions: the C<.sub> and C<.end> directives shown in
+earlier examples. The C<.param> directive defines input parameters and creates
+local named variables for them (similar to C<.local>):
-=begin table picture Size flags
+ .param int c
-Z<CHP-9-TABLE-3>
+X<.return directive>
+The C<.return> directive allows the subroutine to return control flow
+to the calling subroutine, and optionally returns result output values.
-=headrow
+Here's a complete code example that implements the factorial algorithm. The
+subroutine C<fact> is a separate subroutine, assembled and processed after the
+C<main> function. Parrot resolves global symbols like the C<fact> label
+between different units.
-=row
+=begin PIR
-=cell Character
+ # factorial.pir
+ .sub 'main' :main
+ .local int count
+ .local int product
+ count = 5
+ product = 1
-=cell Meaning
+ $I0 = 'fact'(count, product)
-=bodyrows
+ say $I0
+ end
+ .end
-=row
+ .sub 'fact'
+ .param int c
+ .param int p
-=cell C<h>
+ loop:
+ if c <= 1 goto fin
+ p = c * p
+ dec c
+ branch loop
+ fin:
+ .return (p)
+ .end
-=cell short integer or single-precision float
+=end PIR
-=row
+This example defines two local named variables, C<count> and C<product>, and
+assigns them the values 1 and 5. It calls the C<fact> subroutine with both
+variables as arguments. The C<fact> subroutine uses C<.param> to retrieve
+these parameters and C<.return> to return the result. The final printed result
+is 120.
-=cell C<l>
+As usual, execution of the program starts at the C<:main> subroutine.
-=cell long
+=head3 Named Arguments
-=row
+=for author
-=cell C<H>
+We have to get our terms straight here. Which are "arguments" (passed in) and
+which are "parameters" (processed from within)?
-=cell huge value (long long or long double)
+=end for
-=row
+X<positional arguments>
+X<named arguments>
+Parameters passed only by their order are I<positional arguments>. The only
+differentiator between positional arguments is their positions in the function
+call. Putting positional arguments in a different order will produce different
+effects, or may cause errors. Parrot also supports I<named parameters>. Instead
+of passing parameters by their position in the string, parameters are passed by
+name and can be in any order. Here's an example:
-=cell C<v>
+=begin PIR
-=cell Parrot INTVAL or FLOATVAL
+ .sub 'MySub'
+ .param string yrs :named("age")
+ .param string call :named("name")
+ $S0 = "Hello " . call
+ $S1 = "You are " . yrs
+ $S1 .= " years old"
+ say $S0
+ say $S1
+ .end
-=row
+ .sub 'main' :main
+ 'MySub'("age" => 42, "name" => "Bob")
+ .end
-=cell C<O>
+=end PIR
-=cell opcode_t pointer
+Named arguments are convenient because the order of the pairs does not matter.
+You can also pass these pairs in the opposite order:
-=row
+=begin PIR
-=cell C<P>
-
-=cell C<PMC>
-
-=row
-
-=cell C<S>
-
-=cell String
-
-=end table
-
-The values in the aggregate PMC must have a type compatible with the
-specified R<size>.
-
-Here's a short illustration of string formats:
-
-=begin PIR_FRAGMENT
-
- new $P2, "Array"
- new $P0, "Int"
- set $P0, 42
- push $P2, $P0
- new $P1, "Num"
- set $P1, 10
- push $P2, $P1
- sprintf $S0, "int %#Px num %+2.3Pf\n", $P2
- print $S0 # prints "int 0x2a num +10.000"
- print "\n"
-
-=end PIR_FRAGMENT
-
-The first eight lines create a C<Array> with two elements: a
-C<Int> and a C<Num>. The format string of the C<sprintf> has
-two format fields. The first, C<%#Px>, takes a PMC argument from the
-aggregate (C<P>) and formats it as a hexadecimal integer (C<x>), with
-a leading 0x (C<#>). The second format field, C<%+2.3Pf>, takes a PMC
-argument (C<P>) and formats it as a floating-point number (C<f>), with
-a minimum of two whole digits and a maximum of three decimal places
-(C<2.3>) and a leading sign (C<+>).
-
-The test files F<t/op/string.t> and F<t/src/sprintf.t> have many more
-examples of format strings.
-
-=head4 Testing for substrings
-
-Z<CHP-9-SECT-2.4.9>
-
-X<PIR (Parrot assembly language);string operations;testing for substrings>
-The C<index>X<index opcode (PIR)> opcode searches for a substring
-within a string. If it finds the substring, it returns the position
-where the substring was found as a character offset from the beginning
-of the string. If it fails to find the substring, it returns -1:
-
-=begin PIR_FRAGMENT
-
- index $I0, "Beeblebrox", "eb"
- print $I0 # prints 2
- print "\n"
- index $I0, "Beeblebrox", "Ford"
- print $I0 # prints -1
- print "\n"
-
-=end PIR_FRAGMENT
-
-C<index> also has a four-argument version, where the fourth argument
-defines an offset position for starting the search:
-
-=begin PIR_FRAGMENT
-
- index $I0, "Beeblebrox", "eb", 3
- print $I0 # prints 5
- print "\n"
-
-=end PIR_FRAGMENT
-
-This finds the second "eb" in "Beeblebrox" instead of the first,
-because the search skips the first three characters in the
-string.
-
-=head4 Joining strings
-
-The C<join> opcode joins the elements of an array PMC into a single
-string. The second argument separates the individual elements of the
-PMC in the final string result.
-
-=begin PIR_FRAGMENT
-
- new $P0, "Array"
- push $P0, "hi"
- push $P0, 0
- push $P0, 1
- push $P0, 0
- push $P0, "parrot"
- join $S0, "__", $P0
- print $S0 # prints "hi__0__1__0__parrot"
-
-=end PIR_FRAGMENT
-
-This example builds a C<Array> in C<P0> with the values C<"hi">,
-C<0>, C<1>, C<0>, and C<"parrot">. It then joins those values (separated
-by the string C<"__">) into a single string, and stores it in C<S0>.
-
-=head4 Splitting strings
-
-Splitting a string yields a new array containing the resulting
-substrings of the original string.
-
-=begin PIR_FRAGMENT
-
- split $P0, "", "abc"
- set $P1, $P0[0]
- print $P1 # 'a'
- set $P1, $P0[2]
- print $P1 # 'c'
-
-=end PIR_FRAGMENT
-
-This example splits the string "abc" into individual characters and
-stores them in an array in C<P0>. It then prints out the first and
-third elements of the array. For now, the split pattern (the second
-argument to the opcode) is ignored except for a test to make sure that
-its length is zero.
-
-=head3 Logical and Bitwise Operations
-
-Z<CHP-9-SECT-2.6>
-
-X<PIR (Parrot assembly language);bitwise operations>
-X<PIR (Parrot assembly language);logical operations>
-The X<logical opcodes> logical opcodes evaluate the truth of their
-arguments. They're often used to make decisions on control flow.
-Logical operations are implemented for integers and PMCs. Numeric
-values are false if they're 0, and true otherwise. Strings are false
-if they're the empty string or a single character "0", and true
-otherwise. PMCs are true when their
-C<get_bool>X<get_bool vtable method (PIR)> vtable method returns a
-nonzero value.
-
-The C<and>X<and opcode (PIR)> opcode returns the second argument if
-it's false and the third argument otherwise:
-
-=begin PIR_FRAGMENT
-
- and $I0, 0, 1 # returns 0
- and $I0, 1, 2 # returns 2
-
-=end PIR_FRAGMENT
-
-The C<or>X<or opcode (PIR)> opcode returns the second argument if
-it's true and the third argument otherwise:
-
-=begin PIR_FRAGMENT
-
- or $I0, 1, 0 # returns 1
- or $I0, 0, 2 # returns 2
-
- or $P0, $P1, $P2
-
-=end PIR_FRAGMENT
-
-Both C<and> and C<or> are short-circuiting. If they can determine what
-value to return from the second argument, they'll never evaluate the
-third. This is significant only for PMCs, as they might have side
-effects on evaluation.
-
-The C<xor>X<xor opcode (PIR)> opcode returns the second argument if
-it is the only true value, returns the third argument if it is the
-only true value, and returns false if both values are true or both are
-false:
-
-=begin PIR_FRAGMENT
-
- xor $I0, 1, 0 # returns 1
- xor $I0, 0, 1 # returns 1
- xor $I0, 1, 1 # returns 0
- xor $I0, 0, 0 # returns 0
-
-=end PIR_FRAGMENT
-
-The C<not>X<not opcode (PIR)> opcode returns a true value when the
-second argument is false, and a false value if the second argument is
-true:
-
-=begin PIR_FRAGMENT
-
- not $I0, $I1
- not $P0, $P1
-
-=end PIR_FRAGMENT
-
-The X<bitwise;opcodes (PIR)> bitwise opcodes operate on their values
-a single bit at a time. C<band>X<band opcode (PIR)>,
-C<bor>X<bor opcode (PIR)>, and C<bxor>X<bxor opcode (PIR)> return a
-value that is the logical AND, OR, or XOR of each bit in the source
-arguments. They each take a destination register and two source
-registers. They also have two-argument forms where the destination is
-also a source. C<bnot>X<bnot opcode (PIR)> is the logical NOT of
-each bit in a single source argument.
-
-=begin PIR_FRAGMENT
-
- bnot $I0, $I1
- band $P0, $P1
- bor $I0, $I1, $I2
- bxor $P0, $P1, $I2
-
-=end PIR_FRAGMENT
-
-X<bitwise;string opcodes>
-The bitwise opcodes also have string variants for AND, OR, and XOR:
-C<bors>X<bors opcode (PIR)>, C<bands>X<bands opcode (PIR)>, and
-C<bxors>X<bxors opcode (PIR)>. These take string register or PMC
-string source arguments and perform the logical operation on each byte
-of the strings to produce the final string.
-
-=begin PIR_FRAGMENT
-
- bors $S0, $S1
- bands $P0, $P1
- bors $S0, $S1, $S2
- bxors $P0, $P1, $S2
-
-=end PIR_FRAGMENT
-
-The bitwise string opcodes only have meaningful results when they're
-used with simple ASCII strings because the bitwise operation is done
-per byte.
-
-The logical and arithmetic shift operations shift their values by a
-specified number of bits:
-
-=begin PIR_FRAGMENT
-
- shl $I0, $I1, $I2 # shift I1 left by count I2 giving I0
- shr $I0, $I1, $I2 # arithmetic shift right
- lsr $P0, $P1, $P2 # logical shift right
-
-=end PIR_FRAGMENT
-
-=head3 Encodings and Charsets
-
-X<charset>
-A modern string system must manage several character encodings and charsets in
-order to make sense out of all the string data in the world. Parrot does this.
-Every string has an associated encoding and an associated character set. The
-default charset is 8-bit ASCII, which is simple to use and is almost
-universally supported.
-
-Double-quoted string constants can have an optional prefix specifying the the
-string's encoding and charsetN<As you might suspect, single-quoted strings do
-not support this.>. Parrot will maintain these values internally, and will
-automatically convert strings when necessary to preserve the information.
-String prefixes are specified as C<encoding:charset:> at the front of the
-string. Here are some examples:
-
-=begin PIR_FRAGMENT
-
- $S0 = utf8:unicode:"Hello UTF8 Unicode World!"
- $S1 = utf16:unicode:"Hello UTF16 Unicode World!"
- $S2 = ascii:"This is 8-bit ASCII"
- $S3 = binary:"This is raw, unformatted binary data"
-
-=end PIR_FRAGMENT
-
-The C<binary:> charset treats the string as a buffer of raw unformatted binary
-data. It isn't really a string per se, because binary data contains no readable
-characters. As mentioned earlier, this exists to support libraries which
-manipulate binary data that doesn't easily fit into any other primitive data
-type.
-
-When Parrot combines two strings (such as through concatenation), they must
-both use the same character set and encoding. Parrot will automatically
-upgrade one or both of the strings to use the next highest compatible format as
-necessary. ASCII strings will automatically upgrade to UTF-8 strings if needed,
-and UTF-8 will upgrade to UTF-16. All of these conversions happen inside
-Parrot; you the programmer don't need to worry about the details.
-
-=head2 Working with PMCs
-
-Polymorphic Containers (PMCs) are the basis for complex data types and
-object-oriented behavior in Parrot. In PIR, any variable that isn't a
-low-level integer, number, or string is a PMC
-
-Operations on a PMC are implemented by vtable functions. The result of
-an operation is entirely determined by the behavior of
-the PMCs vtable. Since PMCs define their own behavior for these vtable
-functions, it's important to familiarize yourself with the behavior
-of the particular PMC before you start performing a lot of operations on it.
-
-=head3 Assignment
-
-PMC registers contain references to PMC structures internally. So, the set
-opcode doesn't copy the entire PMC, it only copies the reference to the
-PMC data. Here's an example that shows a side effect of this operation:
-
-=begin PASM
-
- new P0, "String"
- set P0, "Ford"
- set P1, P0
- set P1, "Zaphod"
- print P0 # prints "Zaphod"
- print P1 # prints "Zaphod"
- end
-
-=end PASM
-
-In this example, both C<P0> and C<P1> are both references to the same
-internal data structure, so when we set C<P1> to the string literal
-C<"Zaphod">, it overwrites the previous value C<"Ford">. Now, both C<P0>
-and C<P1> point to the String PMC C<"Zaphod">, even though it appears that
-we only set one of those two registers to that value.
-
-=head4 PMC object types
-
-Z<CHP-9-SECT-2.2.2>
-
-X<PMCs (Polymorphic Containers);object types>
-Every PMC has a distinct type that determines its behavior through the
-vtable interface. In the chapter on PIR, we've seen a number of these vtable
-functions already, and seen how they implement the behaviors found inside
-the various opcodes. The vtable interface is standard, and all PMCs implement
-the exact same set of vtables. We've seen some of the vtables and their uses,
-and more of them will be discussed in this chapter and later in the various
-reference chapters.
-
-The C<typeof> opcode can be used to determine the type of a PMC. When
-the source argument is a PMC and the destination is a string register,
-C<typeof> returns the name of the type:
-
-=begin PIR_FRAGMENT
-
- new $P0, "String"
- typeof $S0, $P0 # $S0 is "String"
- print $S0
- print "\n"
-
-=end PIR_FRAGMENT
-
-Using C<typeof> with a PMC output parameter instead, it returns the Class
-PMC for that type.
-
-
-
-=head3 Scalars
-
-Parrot provides a set of
-
-In most of the examples we've shown so far, X<PMCs (Polymorphic
-Containers);working with> PMCs just duplicate the functionality of integers,
-numbers, and strings.
-
-PMCs act much like any integer, floating-point
-number, or string register or variable, but you have to instantiate a
-new PMC object into a type before you use it. The C<new> instruction creates
-a new PMC of the specified type:
-
-=begin PIR_FRAGMENT
-
- $P0 = new 'String'
- $P0 = "That's a bollard and not a parrot."
- print $P0
-
-=end PIR_FRAGMENT
-
-This example creates a C<String> object, stores it in the PMC register variable C<$P0>,
-assigns it the value "Hello, Polly.", and prints it:
-
-=end PIR_FRAGMENT
-
- .local pmc hello # or .local pmc hello
- hello = new 'String'
- hello = "Hello, Polly."
- print hello
-
-=end PIR_FRAGMENT
-
-PIR is a dynamic language; that dynamicism is evident in how Parrot handles PMC
-values. Primitive registers like strings, numbers, and integers perform a
-special action called X<autoboxing> when assigned to a PMC. Autoboxing is the
-process of converting a primitive type to a PMC object. PMC classes exist for
-String, Number, and Integer; notice that the primitive types are in lower-case,
-while the PMC classes are capitalized. If you want to box a value explicitly,
-use the C<box> opcode:
-
-=begin PIR_FRAGMENT
-
- $P0 = new 'Integer' # The boxed form of int
- $P0 = box 42
- $P1 = new 'Number' # The boxed form of num
- $P1 = box 3.14
- $P2 = new 'String' # The boxed form of string
- $P2 = "This is a string!"
-
-=end PIR_FRAGMENT
-
-The PMC classes C<Integer>, C<Number>, and C<String> are thin overlays on the
-primitive types they represent. These PMC types have the benefit of the
-X<PMC;VTABLE Interface> VTABLE interface. VTABLEs are a standard API that all
-PMCs conform to for performing standard operations. These PMC types support
-custom methods to perform various operations, may be passed to subroutines that
-expect PMC arguments, and can be subclassed by a user-defined type.
-
-
-PMCs are are polymorphic data items that
-can be one of a large variety of predefined types. As we have seen briefly,
-and as we will see in more depth later, PMCs have a standard interface called
-the VTABLE interface. VTABLEs are a standard list of functions that all PMCs
-implement N<or, PMCs can choose not to implement each interface explicitly and
-instead let Parrot call the default implementations>.
-
-VTABLEs are very strict: There are a fixed number with fixed names and
-fixed argument lists. You can't just create any random VTABLE interface that
-you want to create, you can only make use of the ones that Parrot supplies
-and expects. To circumvent this limitation, PMCs may have METHODS in
-addition to VTABLEs. METHODs are arbitrary code functions that can be
-written in C, may have any name, and may implement any behavior.
-
-=head4 Boxing and Unboxing
-
-Z<CHP-9-SECT-2.2.3>
-
-As we've seen in the previous chapters about PIR, we can convert between
-primitive string, integer, and number types and PMCs. PIR used the C<=>
-operator to make these conversions. PIR uses the C<set> opcode to do the
-same thing. C<set> will perform the type conversions for us automatically,
-in a process called I<autoboxing>.
-
-Assigning a primitive data type to a PMC of a String, Integer, or Float type
-converts that PMC to the new type. So, assigning a string to a Number PMC
-converts it into a String PMC. Assigning an integer value converts it to a
-C<Integer>, and assigning C<undef> converts it to an C<Undef> PMC:
-
-=begin PIR_FRAGMENT
-
- new $P0, "String"
- set $P0, "Ford\n"
- print $P0 # prints "Ford\n"
- set $P0, 42
- print $P0 # prints 42
- print "\n"
- typeof $S0, $P0
- print $S0 # prints "Integer"
- print "\n"
-
-=end PIR_FRAGMENT
-
-C<P0> starts as a C<String>, but when C<set> assigns it an integer
-value 42 (replacing the old string value C<"Ford">), it changes type
-to C<Integer>. This behavior only works for the wrapper PMC types for the
-primitive values string, int, and num. Other PMC classes will have different
-behaviors when you try to assign a primitive value to them.
-
-We can also use the C<box> opcode to explicitly convert an integer, a float,
-or a string into an appropriate PMC type.
-
-=begin PIR_FRAGMENT
-
- box $P0, 3
- typeof $S0, $P0 # $P0 is an "Integer"
- box $P1, "hello"
- typeof $S0, $P1 # $P1 is a "String"
- box $P2, 3.14
- typeof $S0, $P2 # $P2 is a "Number"
-
-=end PIR_FRAGMENT
-
-
-=head3 Aggregates
-
-Z<CHP-9-SECT-3.1>
-
-PMCs can define complex types that hold multiple values. These are
-commonly called "X<PMCs (Polymorphic Containers);aggregate>
-X<aggregate PMCs> aggregates." The most important feature added for
-aggregates is keyed access. Elements within an aggregate PMC can be
-stored and retrieved by a numeric or string key. PIR also offers a
-full set of operations for manipulating aggregate data types.
-
-Two of the most basic aggregate types are arrays and hashes. The primary
-difference between these two is that arrays are indexed using integer keys,
-and hashes are indexed with string keys. The term "hash" in this context is
-derived from the data type in Perl 5 of the same name. Other programming
-languages might refer to the same concept using different terms such as
-"dictionary" or "hash table" or "associative array".
-
-Arrays and hashes are not the only types of aggregates available, although
-they are the most simple demonstrations of using integer and strings as
-keys in an aggregate, respectively.
-
-=head4 Arrays
-
-Z<CHP-9-SECT-3.1.1>
-
-X<arrays>
-The C<Array>X<Array PMC> PMC is an ordered aggregate with zero-based integer
-keys. The syntax for X<keyed access to PMCs> keyed access to a PMC puts the
-key in square brackets after the register name:
-
-=begin PIR_FRAGMENT
-
- new $P0, "Array" # obtain a new array object
- set $P0, 2 # set its length
- set $P0[0], 10 # set first element to 10
- set $P0[1], $I31 # set second element to $I31
- set $I0, $P0[0] # get the first element
- set $I1, $P0 # get array length
-
-=end PIR_FRAGMENT
-
-A key on the destination register of a C<set> operation sets a value
-for that key in the aggregate. A key on the source register of a
-C<set> returns the value for that key. If you set C<P0> without a key,
-you set the length of the array, not one of its values.N<C<Array>
-is an autoextending array, so you never need to set its length. Other
-array types may require the length to be set explicitly.> And if you
-assign the C<Array> to an integer, you get the length of the
-array.
-
-We mention "other array types" above, not as a vague suggestion that there may
-be other types of arrays eventually, but as an indication that we actually
-have several types of array PMCs in Parrot's core. Parrot comes with
-C<FixedPMCArray>, C<ResizablePMCArray>, C<FixedIntegerArray>,
-C<ResizableIntegerArray>, C<FixedFloatArray>, C<ResizableFloatArray>,
-C<FixedStringArray>, C<ResizableStringArray>, C<FixedBooleanArray>,
-and C<ResizableBooleanArray> types. These various types of arrays use
-various packing methods to create higher memory efficiency for their contents
-then using a single generic array type would be able to. The trade-off for
-higher memory efficiency is that these array PMCs can only hold a single type
-of data.
-
-The array PMC types that start with "Fixed" have a fixed size and do not
-automatically extend themselves if you attempt to add data to a higher index
-then the array contains. The "Resizable" variants will automatically extend
-themselves as more data are added, but the cost is in algorithmic complexity
-of checking array bounds and reallocating array memory.
-
-To retrieve the number of items currently in an array, you can use the
-C<elements> opcode.
-
-=begin PIR_FRAGMENT
-
- set $P0, 100 # allocate store for 100 elements
- set $I0, $P0 # obtain current allocation size
- elements $I0, $P0 # get element count
-
-=end PIR_FRAGMENT
-
-Some other useful instructions for working with arrays are C<push>,
-C<pop>, C<shift>, and C<unshift> (you'll find them in
-"PIR Opcodes" in Chapter 11).
-
-=head4 Hashes
-
-Z<CHP-9-SECT-3.1.2>
-
-X<PMCs (Polymorphic Containers);hashes>
-The C<Hash>X<Hash PMC> PMC is an unordered aggregate which uses string keys
-to identify elements within it.
-
-=begin PIR_FRAGMENT
-
- new $P1, "Hash" # generate a new hash object
- set $P1["key"], 10 # set key and value
- set $I0, $P1["key"] # obtain value for key
- set $I1, $P1 # number of entries in hash
-
-=end PIR_FRAGMENT
-
-The C<exists>X<exists opcode (PIR)> opcode tests whether a keyed
-value exists in an aggregate. It returns 1 if it finds the key in the
-aggregate, and returns 0 if it doesn't. It doesn't care if the value
-itself is true or false, only that the key has been set:
-
-=begin PIR_FRAGMENT
-
- new $P0, "Hash"
- set $P0["key"], 0
- exists $I0, $P0["key"] # does a value exist at "key"
- print $I0 # prints 1
- print "\n"
-
-=end PIR_FRAGMENT
-
-The C<delete>X<delete opcode (PIR)> opcode is also useful for working
-with hashes: it removes a key/value pair.
-
-=head4 Iterators
-
-Z<CHP-9-SECT-3.1.3>
-
-Iterators extract values from an aggregate PMC one at a time and without
-extracting duplicates. Iterators are most useful in loops where an action
-needs to be performed on every element in an aggregate. You create an
-iterator by creating a new C<Iterator> PMC, and passing the aggregate PMC
-to C<new> as an additional parameter:
-
-=begin PIR_FRAGMENT
-
- new $P1, "Iterator", $P2
-
-=end PIR_FRAGMENT
-
-Alternatively, you can use the C<iter> opcode to do the same thing:
-
-=begin PIR_FRAGMENT
-
- iter $P1, $P2 # Same!
-
-=end PIR_FRAGMENT
-
-The include file F<iterator.pasm> defines some constants for working
-with iterators. The C<.ITERATE_FROM_START> and C<.ITERATE_FROM_END>
-constants are used to select whether an array iterator starts from the
-beginning or end of the array. Since Hash PMCs are unordered, these two
-constants do not have any affect on Hash iterators.
-
-A value can be extracted from the iterator using the C<shift> opcode.
-Evaluating the iterator PMC as a boolean returns whether the iterator has
-reached the end of the aggregate or not.
-
-=begin PIR_FRAGMENT
-
- .include "iterator.pasm"
- new $P2, "Array"
- push $P2, "a"
- push $P2, "b"
- push $P2, "c"
- new $P1, "Iterator", $P2
- set $P1, .ITERATE_FROM_START
-
- iter_loop:
- unless $P1, iter_end
- shift $P5, $P1
- print $P5 # prints "a", "b", "c"
- branch iter_loop
- iter_end:
- # ...
-
-=end PIR_FRAGMENT
-
-Hash iterators work similarly to array iterators, but they extract keys
-only. With the key, you can find it's value from the original hash PMC.
-With hashes it's only meaningful to iterate in one direction since they
-don't define any order for their keys.
-
-=begin PIR_FRAGMENT
-
- .include "iterator.pasm"
- new $P2, "Hash"
- set $P2["a"], 10
- set $P2["b"], 20
- set $P2["c"], 30
- new $P1, "Iterator", $P2
- set $P1, .ITERATE_FROM_START_KEYS
-
- iter_loop:
- unless $P1, iter_end
- shift $S5, $P1 # one of the keys "a", "b", "c"
- set $I9, $P2[$S5]
- print $I9 # prints e.g. 20, 10, 30
- branch iter_loop
- iter_end:
- # ...
-
-=end PIR_FRAGMENT
-
-=head4 Data structures
-
-Z<CHP-9-SECT-3.1.4>
-
-X<PMCs (Polymorphic Containers);data structures>
-Arrays and hashes can hold any data type, including other aggregates.
-Accessing elements deep within nested data structures is a common
-operation, so PIR provides a way to do it in a single instruction.
-Complex keys specify a series of nested data structures, with each
-individual key separated by a semicolon:
-
-=begin PIR_FRAGMENT
-
- new $P0, "Hash"
- new $P1, "Array"
- set $P1[2], 42
- set $P0["answer"], $P1
- set $I1, 2
- set $I0, $P0["answer";$I1] # $i = %hash{"answer"}[2]
- print $I0
- print "\n"
-
-=end PIR_FRAGMENT
-
-This example builds up a data structure of a hash containing an array.
-The complex key C<P0["answer";I1]> retrieves an element of the array
-within the hash. You can also set a value using a complex key:
-
-=begin PIR_FRAGMENT
-
- set $P0["answer";0], 5 # %hash{"answer"}[0] = 5
-
-=end PIR_FRAGMENT
-
-The individual keys are integers or strings, or registers with integer
-or string values.
-
-=head3 PMC Assignment
-
-Z<CHP-9-SECT-3.2>
-
-We mentioned before that C<set> on two X<PMCs (Polymorphic
-Containers);assignment> PMCs simply aliases them both to the same object,
-and that C<clone> creates a complete duplicate object. But if you just
-want to assign the value of one PMC to another PMC, you need the
-C<assign>X<assign opcode (PIR)> opcode:
-
-=begin PIR_FRAGMENT
-
- new $P0, "Int"
- new $P1, "Int"
- set $P0, 42
- set $P2, $P0
- assign $P1, $P0 # note: $P1 has to exist already
- inc $P0
- print $P0 # prints 43
- print "\n"
- print $P1 # prints 42
- print "\n"
- print $P2 # prints 43
- print "\n"
-
-=end PIR_FRAGMENT
-
-This example creates two C<Int> PMCs: C<P0> and C<P1>. It gives
-C<P0> a value of 42. It then uses C<set> to give the same value to
-C<P2>, but uses C<assign> to give the value to C<P1>. When C<P0> is
-incremented, C<P2> also changes, but C<P1> doesn't. The destination
-register for C<assign> must have an existing object of the right type
-in it, since C<assign> doesn't create a new object (as with C<clone>)
-or reuse the source object (as with C<set>).
-
-=head3 Properties
-
-Z<CHP-9-SECT-3.3>
-
-X<PMCs (Polymorphic Containers);properties>
-PMCs can have additional values attached to them as "properties" of
-the PMC. What these properties do is entirely up to the language being
-implemented. Most usually properties are used to hold extra metadata about
-the PMC that is used by the high-level language (HLL).
-
-The C<setprop>X<setprop opcode (PIR)> opcode sets the value of a
-named property on a PMC. It takes three arguments: the PMC to be set
-with a property, the name of the property, and a PMC containing the
-value of the property. The C<getprop>X<getprop opcode (PIR)> opcode
-returns the value of a property. It also takes three arguments: the
-PMC to store the property's value, the name of the property, and the
-PMC from which the property value is to be retrieved. Internally a PMCs
-properties are stored in a Hash structure, where the name of the property
-is stored in a special properties Hash.
-
-=begin PIR_FRAGMENT
-
- new $P0, "String"
- set $P0, "Zaphod"
- new $P1, "Int"
- set $P1, 1
- setprop $P0, "constant", $P1 # set a property on $P0
- getprop $P3, "constant", $P0 # retrieve a property on $P0
- print $P3 # prints 1
- print "\n"
-
-=end PIR_FRAGMENT
-
-This example creates a C<String> object in C<P0>, and a C<Int>
-object with the value 1 in C<P1>. C<setprop> sets a property named
-"constant" on the object in C<P0> and gives the property the value in
-C<P1>.N<The "constant" property is ignored by PIR, but may be significant
-to the HLL that set it.> C<getprop> retrieves the value of the property
-"constant" on C<P0> and stores it in C<P3>.
-
-Properties are kept in a separate hash for each PMC. Property values
-are always PMCs, but only references to the actual PMCs. Trying to
-fetch the value of a property that doesn't exist returns a
-C<Undef>.
-
-C<delprop>X<delprop opcode (PIR)> deletes a property from a PMC.
-
-=begin PIR_FRAGMENT
-
- delprop $P1, "constant" # delete property
-
-=end PIR_FRAGMENT
-
-You can also return a complete hash of all properties on a PMC with
-C<prophash>X<prophash opcode (PIR)>.
-
-=begin PIR_FRAGMENT
-
- prophash $P0, $P1 # set $P0 to the property hash of $P1
-
-=end PIR_FRAGMENT
-
-
-=head2 VTABLE Interfaces
-
-Internally, all operations on PMCs are performed by calling various VTABLE
-interfaces.
-
-=head3 Type Conversion
-
-The C<=> operator is very powerful. Its simplest form stores a value into one
-of the Parrot registers. It can assign a string value to a C<string> register,
-an integer value to an C<int> register, a floating point value into a C<number>
-register, etc. However, the C<=> operator can assign I<any> type of value into
-I<any> type of register; Parrot will handle the conversion for you
-automatically:
-
-=begin PIR_FRAGMENT
-
- $I0 = 5 # Integer. 5
- $S0 = $I0 # Stringify. "5"
- $N0 = $S0 # Numify. 5.0
- $I0 = $N0 # Intify. 5
-
-=end PIR_FRAGMENT
-
-Notice that conversions between the numeric formats and strings only makes
-sense when the value to convert is a number.
-
-=begin PIR_FRAGMENT
-
- $S0 = "parrot"
- $I0 = $S0 # 0
-
-=end PIR_FRAGMENT
-
-An earlier example showed a string literal assigned to a PMC register of type
-C<String>. This works for all the primitive types and their autoboxed PMC
-equivalents:
-
-=begin PIR_FRAGMENT
-
- $P0 = new 'Integer'
- $P0 = 5
- $S0 = $P0 # Stringify. "5"
- $N0 = $P0 # Numify. 5.0
- $I0 = $P0 # Unbox. $I0 = 5
-
- $P1 = new 'String'
- $P1 = "5 birds"
- $S1 = $P1 # Unbox. $S1 = "5 birds"
- $I1 = $P1 # Intify. 5
- $N1 = $P1 # Numify. 5.0
-
- $P2 = new 'Number'
- $P2 = 3.14
- $S2 = $P2 # Stringify. "3.14"
- $I2 = $P2 # Intify. 3
- $N2 = $P2 # Unbox. $N2 = 3.14
-
-=end PIR_FRAGMENT
-
-=head2 Control Structures
-
-Z<CHP-3-SECT-5>
-
-X<PIR (Parrot intermediate representation);control flow>
-X<control flow;in PIR>
-
-Control flow in PIR occurs entirely with conditional and unconditional branches
-to labels. This may seem simplistic and primitive, but here PIR shows its roots
-as a thin overlay on the assembly language of a virtual processor. PIR does
-not support high-level looping structures such as C<while> or C<for> loops. PIR
-has some support for basic C<if> branching constructs, but does not support
-more complicated C<if>/C<then>/C<else> branch structures.
-
-The control structures of high-level languages hew tightly to the semantics of
-those languages; Parrot provides the minimal feature set necessary to implement
-any semantic of an HLL without dictating how that HLL may implement its
-features. Language agnosticism is an important design goal in Parrot, and
-creates a very flexible and powerful development environment for language
-developers.
-
-X<goto instruction (PIR)>
-The most basic branching instruction is the unconditional branch, C<goto>:
-
-=begin PIR
-
- .sub 'main'
- goto L1
- print "never printed"
-
- L1:
- print "after branch"
- .end
-
-=end PIR
-
-The first C<print> statement never runs because the C<goto> always skips over it
-to the label C<L1>.
-
-The conditional branches combine C<if> or C<unless> with C<goto>.
-
-=begin PIR
-
- .sub 'main'
- $I0 = 42
- if $I0 goto L1
- say "never printed"
- L1:
- say "after branch"
- .end
-
-=end PIR
-
-X<if (conditional);instruction (PIR)> X<unless (conditional);instruction (PIR)>
-In this example, the C<goto> branches to the label C<L1> only if the value
-stored in C<$I0> is true. The C<unless> statement is similar, but it branches
-when the tested value is false. You can use PMC and STRING registers with
-C<if> and C<unless>. The op will call the C<get_bool> vtable entry on any PMC
-so used and will convert the STRING to a boolean value. An undefined value, 0,
-or an empty string are all false values. All other values are true.
-
-The comparison operators (C<E<lt>>, C<E<lt>=>, C<==>, C<!=>, C<E<gt>>,
-C<E<gt>=>) can combine with C<if ... goto>. These branch when the
-comparison is true:
-
-=begin PIR
-
- .sub 'main'
- $I0 = 42
- $I1 = 43
- if $I0 < $I1 goto L1
- say "never printed"
- L1:
- say "after branch"
- .end
-
-=end PIR
-
-This example compares C<$I0> to C<$I1> and branches to the label C<L1> if
-C<$I0> is less than C<$I1>. The C<if $I0 E<lt> $I1 goto L1> statement
-translates directly to the C<lt> branch operation.
-
-Chapter 11's "PIR Instructions" section summarizes the other comparison
-operators.
-
-X<loops;PIR>
-X<PIR (Parrot intermediate representation);loop constructs>
-PIR has no special loop constructs. A combination of conditional and
-unconditional branches handle iteration:
-
-=begin PIR
-
- .sub 'main'
- $I0 = 1 # product
- $I1 = 5 # counter
-
- REDO: # start of loop
- $I0 = $I0 * $I1
- dec $I1
- if $I1 > 0 goto REDO # end of loop
-
- say $I0
- .end
-
-=end PIR
-
-X<do-while style loop;(PIR)>
-This example calculates the factorial C<5!>. Each time through the loop it
-multiplies C<$I0> by the current value of the counter C<$I1>, decrements the
-counter, and branches to the start of the loop. The loop ends when C<$I1>
-counts down to 0. This is a I<do while>-style loop with the condition test at
-the end, so the code always runs the first time through.
-
-X<while-style loop (PIR)>
-For a I<while>-style loop with the condition test at the start, use a
-conditional branch with an unconditional branch:
-
-=begin PIR
-
- .sub 'main'
- $I0 = 1 # product
- $I1 = 5 # counter
-
- REDO: # start of loop
- if $I1 <= 0 goto LAST
- $I0 = $I0 * $I1
- dec $I1
- goto REDO
- LAST: # end of loop
-
- say $I0
- .end
-
-=end PIR
-
-This example tests the counter C<$I1> at the start of the loop. At the
-end of the loop, it unconditionally branches back to the start of the
-loop and tests the condition again. The loop ends when the counter
-C<$I1> reaches 0 and the C<if> branches to the C<LAST> label. If the
-counter isn't a positive number before the loop, the loop never
-executes.
-
-You can build any high-level flow control construct from conditional and
-unconditional branches; the lowest level of computer hardware works this way.
-All modern programming languages use branching constructs to implement their
-most complex flow control devices.
-
-
-Branch instructions transfer control to a relative offset from the
-current instruction. The rightmost argument to every branch opcode is
-a label, which the assembler converts to the integer value of the
-offset. You can also branch on a literal integer value, but there's
-rarely any need to do so. The simplest branch instruction is
-C<branch>:
-
-=begin PIR_FRAGMENT
-
- branch L1 # branch 4
- print "skipped\n"
- L1:
- print "after branch\n"
-
-=end PIR_FRAGMENT
-
-This example unconditionally branches to the location of the label
-C<L1>, skipping over the first C<print> statement.
-
-Jump instructions transfer control to an absolute address. The C<jump>
-opcode doesn't calculate an address from a label, so it's used
-together with C<set_addr>:
-
-=begin PIR_FRAGMENT
-
- set_addr $I0, L1
- jump $I0
- print "skipped\n"
- end
- L1:
- print "after jump\n"
-
-=end PIR_FRAGMENT
-
-The C<set_addr>X<set_addr opcode (PIR)> opcode takes a label or an
-integer offset and returns an absolute address.
-
-You've probably noticed the C<end>X<end opcode (PIR)> opcode as the
-last statement in many examples above. This terminates the execution
-of the current run loop. Terminating the main bytecode segment (the
-first run loop) stops the interpreter. Without the C<end> statement,
-execution just falls off the end of the bytecode segment, with a good
-chance of crashing the interpreter.
-
-=head3 Conditional Branches
-
-Z<CHP-9-SECT-4.1>
-
-X<PIR (Parrot assembly language);conditional branches>
-X<conditional branches in PIR>
-Unconditional jumps and branches aren't really enough for flow
-control. What you need to implement the control structures of
-high-level languages is the ability to select different actions based
-on a set of conditions. PIR has opcodes that conditionally branch
-based on the truth of a single value or the comparison of two values.
-The following example has C<if>X<if (conditional);opcode (PIR)> and
-C<unless>X<unless (conditional);opcode (PIR)> conditional branches:
-
-=begin PIR_FRAGMENT
-
- set $I0, 0
- if $I0, TRUE
- unless $I0, FALSE
- print "skipped\n"
- end
- TRUE:
- print "shouldn't happen\n"
- end
- FALSE:
- print "the value was false\n"
-
-=end PIR_FRAGMENT
-
-C<if> branches if its first argument is a true value, and C<unless>
-branches if its first argument is a false value. In this case, the
-C<if> doesn't branch because C<I0> is false, but the C<unless> does
-branch.
-The comparison branching opcodes compare two values and branch if the
-stated relation holds true. These are
-C<eq>X<eq (equal);opcode (PIR)> (branch when equal),
-C<ne>X<ne (not equal);opcode (PIR)> (when not equal),
-C<lt>X<lt (less than);opcode (PIR)> (when less than),
-C<gt>X<gt (greater than);opcode (PIR)> (when greater than),
-C<le>X<le (less than or equal);opcode (PIR)> (when less than or
-equal), and C<ge>X<ge (greater than or equal);opcode (PIR)> (when
-greater than or equal). The two compared arguments must be the same
-register type:
-
-=begin PIR_FRAGMENT
-
- set $I0, 4
- set $I1, 4
- eq $I0, $I1, EQUAL
- print "skipped\n"
- end
- EQUAL:
- print "the two values are equal\n"
-
-=end PIR_FRAGMENT
-
-This compares two integers, C<I0> and C<I1>, and branches if they're
-equal. Strings of different character sets or encodings are converted
-to Unicode before they're compared. PMCs have a C<cmp> vtable method.
-This gets called on the left argument to perform the comparison of the
-two objects.
-
-The comparison opcodes don't specify if a numeric or string comparison
-is intended. The type of the register selects for integers, floats,
-and strings. With PMCs, the vtable method C<cmp> or C<is_equal> of the
-first argument is responsible for comparing the PMC meaningfully with
-the other operand. If you need to force a numeric or string comparison
-on two PMCs, use the alternate comparison opcodes that end in the
-C<_num> and C<_str> suffixes.
-
-=begin PIR_FRAGMENT
-
- eq_str $P0, $P1, label # always a string compare
- gt_num $P0, $P1, label # always numerically
-
-=end PIR_FRAGMENT
-
-Finally, the C<eq_addr> opcode branches if two PMCs or strings are
-actually the same object (have the same address):
-
-=begin PIR_FRAGMENT
-
- eq_addr $P0, $P1, same_pmcs_found
-
-=end PIR_FRAGMENT
-
-=head3 Iteration
-
-Z<CHP-9-SECT-4.2>
-
-X<iteration;in PIR>
-X<PIR (Parrot assembly language);iteration>
-PIR doesn't define high-level loop constructs. These are built up
-from a combination of conditional and unconditional branches. A
-I<do-while>X<do-while style loop;(PIR)> style loop can be constructed
-with a single conditional branch:
-
-=begin PIR_FRAGMENT
-
- set $I0, 0
- set $I1, 10
- REDO:
- inc $I0
- print $I0
- print "\n"
- lt $I0, $I1, REDO
-
-=end PIR_FRAGMENT
-
-This example prints out the numbers 1 to 10. The first time through,
-it executes all statements up to the C<lt> statement. If the
-condition evaluates as true (C<I0> is less than C<I1>) it branches to
-the C<REDO> label and runs the three statements in the loop body
-again. The loop ends when the condition evaluates as false.
-
-Conditional and unconditional branches can build up quite complex
-looping constructs, as follows:
-
-=begin PIR_FRAGMENT
-
- # loop ($i=1; $i<=10; $i++) {
- # print "$i\n";
- # }
- loop_init:
- set $I0, 1
- branch loop_test
- loop_body:
- print $I0
- print "\n"
- branch loop_continue
- loop_test:
- le $I0, 10, loop_body
- branch out
- loop_continue:
- inc $I0
- branch loop_test
- out:
- # ...
-
-=end PIR_FRAGMENT
-
-X<loops;PIR>
-X<PIR (Parrot assembly language);loops>
-This example emulates a X<counter-controlled loop> counter-controlled
-loop like Perl 6's C<loop> keyword or C's C<for>. The first time
-through the loop it sets the initial value of the counter in
-C<loop_init>, tests that the loop condition is met in C<loop_test>,
-and then executes the body of the loop in C<loop_body>. If the test
-fails on the first iteration, the loop body will never execute. The
-end of C<loop_body> branches to C<loop_continue>, which increments the
-counter and then goes to C<loop_test> again. The loop ends when the
-condition fails, and it branches to C<out>. The example is more
-complex than it needs to be just to count to 10, but it nicely shows
-the major components of a
-loop.
-
-=head2 Macros
-
-=for author
-
-Needs supplementing; needs moving.
-
-=end for
-
-=head2 Subroutines
-
-X<PIR (Parrot intermediate representation);subroutine> X<subroutine (PIR)>
-Subroutines in PIR are roughly equivalent to the subroutines or methods of a
-high-level language. All code in a PIR source file must occur within a
-subroutine. The simplest syntax for a PIR subroutine starts with the C<.sub>
-directive and ends with the C<.end> directiveN<The name C<main> is only a
-convention.>:
-
-=begin PIR
-
- .sub 'main'
- say "Hello, Polly."
- .end
-
-=end PIR
-
-This example defines a subroutine named C<main> that prints a string C<"Hello,
-Polly.">. Parrot will normally execute the first subroutine it encounters in
-the first file it runs, but you can flag any subroutine as the first one to
-execute with the C<:main> marker:
-
-=begin PIR
-
- .sub 'first'
- say "Polly want a cracker?"
- .end
-
- .sub 'second' :main
- say "Hello, Polly."
- .end
-
-=end PIR
-
-This code prints out "Hello, Polly." but not "Polly want a cracker?". Though
-the C<first> function appears first in the source code, C<second> has the
-C<:main> flag and gets called. C<first> is never called. Revising that
-program produces different results:
-
-=begin PIR
-
- .sub 'first' :main
- say "Polly want a cracker?"
- .end
-
- .sub 'second'
- say "Hello, Polly."
- .end
-
-=end PIR
-
-The output now is "Polly want a cracker?". Execution in PIR starts at the
-C<:main> function and continues until that function ends. To perform other
-operations, you must call other functions explicitly. Chapter 4 describes
-subroutines and their uses.
-
-
-X<PIR (Parrot intermediate representation);subroutines>
-X<subroutines;in PIR>
-The most basic building block of code reuse in PIR is the subroutine. A large
-program may perform a calculation like "the factorial of a number" several
-times. Subroutines abstract this behavior into a single, named, stand-alone
-unit. PIR is a subroutine-based language in that all code in PIR must exist in
-a subroutine. Execution starts in the C<:main> subroutine, which itself can
-call other subroutines. Subroutines can fit together into more elaborate
-chunks of code reusability such as methods and objects.
-
-Parrot supports multiple high-level languages. Each language uses a different
-syntax for defining and calling subroutines. The goal of PIR is not to be a
-high-level language in itself, but to provide the basic tools that other
-languages can use to implement them. PIR's subroutine syntax may seem very
-primitive for this reason.
-
-=head3 Parrot Calling Conventions
-
-Z<CHP-4-SECT-1>
-
-X<PIR (Parrot intermediate representation);subroutines;Parrot calling conventions>
-X<subroutines;Parrot calling conventions;in PIR>
-
-The C<.sub> directive defines globally accessible subroutine
-objects.
-
-Subroutine objects of all kinds can be called with the
-C<invoke>X<invoke opcode (PIR)> opcode. There is also an C<invoke>
-C<PR<x>> instruction for calling objects held in a different register.
-
-The C<invokecc>X<invokecc opcode (PIR)> opcode is like C<invoke>, but it
-also creates and stores a new return continuation. When the
-called subroutine invokes this return continuation, it returns control
-to the instruction after the function call. This kind of call is known
-as Continuation Passing Style (CPS).
-X<CPS (Continuation Passing Style)>
-X<Continuation Passing Style (CPS)>
-
-The way that Parrot calls a subroutine -- passing arguments, altering control
-flow, and returning results -- is the "Parrot Calling Conventions" (PCC).
-Parrot generally hides the details of PCC from the programmer. PIR has several
-constructs to gloss over these details, and the average programmer will not
-need to worry about them. PCC uses the Continuation Passing Style
-X<Continuation Passing Style (CPS)>X<CPS (Continuation Passing Style)> (CPS) to
-pass control to subroutines and back again. Again, the details are irrelevant
-for most uses, but the power is available to anyone who wants to take advantage
-of it.
-
-=head3 Subroutine Calls
-
-X<PIR (Parrot intermediate representation);subroutine calls>
-PIR's simplest subroutine call syntax looks much like a subroutine
-call from a high-level language. This example calls the subroutine
-C<fact> with two arguments and assigns the result to C<$I0>:
-
- $I0 = 'fact'(count, product)
-
-This simple statement hides much complexity. It generates a subroutine PMC
-object, creates a continuation PMC object to represent the control flow up to
-this point, passes the arguments, looks up the subroutine by name (and by
-signature, if necessary)), calls the subroutine, and assigns the results of the
-call to the appropriate integer register. This is all in addition to the
-computation the subroutine itself performs.
-
-The single line subroutine call is incredibly convenient, but it isn't always
-flexible enough. PIR also has a more verbose call syntax that is still more
-convenient than manual calls. This example looks up the subroutine C<fact> out
-in the global symbol table and calls it:
-
- find_global $P1, "fact"
-
- .begin_call
- .arg count
- .arg product
- .call $P1
- .result $I0
- .end_call
-
-X<.arg directive>
-X<.result directive>
-The whole chunk of code from C<.begin_call> to C<.end_call> acts as a single
-unit. The C<.arg> directive sets up and passes arguments to the call. The
-C<.call> directive calls the subroutine and identifies the point at which to
-return control flow after the subroutine has completed. The C<.result>
-directive retrieves returned values from the call.
-
-=head3 Subroutine Declarations
-
-X<.param directive> In addition to syntax for subroutine calls, PIR provides
-syntax for subroutine definitions: the C<.sub> and C<.end> directives shown in
-earlier examples. The C<.param> directive defines input parameters and creates
-local named variables for them (similar to C<.local>):
-
- .param int c
-
-X<.return directive>
-The C<.return> directive allows the subroutine to return control flow
-to the calling subroutine, and optionally returns result output values.
-
-Here's a complete code example that implements the factorial algorithm. The
-subroutine C<fact> is a separate subroutine, assembled and processed after the
-C<main> function. Parrot resolves global symbols like the C<fact> label
-between different units.
-
-=begin PIR
-
- # factorial.pir
- .sub 'main' :main
- .local int count
- .local int product
- count = 5
- product = 1
-
- $I0 = 'fact'(count, product)
-
- say $I0
- .end
-
- .sub 'fact'
- .param int c
- .param int p
-
- loop:
- if c <= 1 goto fin
- p = c * p
- dec c
- branch loop
- fin:
- .return (p)
- .end
-
-=end PIR
-
-This example defines two local named variables, C<count> and C<product>, and
-assigns them the values 1 and 5. It calls the C<fact> subroutine with both
-variables as arguments. The C<fact> subroutine uses C<.param> to retrieve
-these parameters and C<.return> to return the result. The final printed result
-is 120.
-
-As usual, execution of the program starts at the C<:main> subroutine.
-
-=head3 Parameters and Arguments
-
-=head4 Named Parameters
-
-=for author
-
-We have to get our terms straight here. Which are "arguments" (passed in) and
-which are "parameters" (processed from within).
-
-=end for
-
-X<positional arguments>
-X<named arguments>
-Parameters passed only by their order are I<positional arguments>. The only
-differentiator between positional arguments is their positions in the function
-call. Putting positional arguments in a different order will produce different
-effects, or may cause errors. Parrot also supports I<named parameters>. Instead
-of passing parameters by their position in the string, parameters are passed by
-name and can be in any order. Here's an example:
-
-=begin PIR
-
- .sub 'MySub'
- .param string yrs :named("age")
- .param string call :named("name")
- $S0 = "Hello " . call
- $S1 = "You are " . yrs
- $S1 = $S1 . " years old"
- say $S0
- say $S1
- .end
-
- .sub 'main' :main
- 'MySub'("age" => 42, "name" => "Bob")
- .end
-
-=end PIR
-
-You can also pass these pairs in the opposite order:
-
-=begin PIR
-
- .sub 'main' :main
- 'MySub'("name" => "Bob", "age" => 42) # Same!
- .end
-
-=end PIR
-
-Named arguments can be a big help because you don't have to worry about the
-exact order of variables, especially as argument lists get very long.
-
-=head4 Optional Parameters
-
-X<optional arguments>
-Some functions have arguments with appropriate default values, so that callers
-don't always have to pass them. Parrot provides a mechanism to identify
-optional argument. Parrot also provides a flag value to determine if the
-caller has passed in an optional argument.
-
-Optional parameters appear in PIR as if they're actually I<two> parameters:
-the value and its flag:
-
- .param string name :optional
- .param int has_name :opt_flag
-
-The C<:optional> flag specifies that the given parameter is optional. The
-C<:opt_flag> specifies an integer which parameter contains a boolean flag; this
-flag is true if the value was passed, and false otherwise. To provide a default
-value for an optional parameter, you can write:
-
- .param string name :optional
- .param int has_name :opt_flag
-
- if has_name goto we_have_a_name
- name = "Default value"
- we_have_a_name:
-
-Optional parameters can be positional or named parameters. When using them with
-positional parameters, they must appear at the end of the list of positional
-parameters. Also, the C<:opt_flag> parameter must always appear directly after
-the C<:optional> parameter.
-
- .sub 'Foo'
- .param int optvalue :optional
- .param int hasvalue :opt_flag
- .param pmc notoptional # WRONG!
- ...
-
- .sub 'Bar'
- .param int hasvalue :opt_flag
- .param int optvalue :optional # WRONG!
- ...
-
- .sub 'Baz'
- .param int optvalue :optional
- .param pmc notoptional
- .param int hasvalue :opt_flag # WRONG!
- ...
-
-You may mix optional parameters with named parameters:
-
- .sub 'MySub'
- .param int value :named("answer") :optional
- .param int has_value :opt_flag
- ...
-
-You can call this function in two ways:
-
- 'MySub'("answer" => 42) # with a value
- 'MySub'() # without
-
-=head4 Commandline Arguments
-
-Programs written in Parrot have access to arguments passed on the command
-line:
-
-=begin PIR
-
- .sub 'MyMain' :main
- .param pmc all_args :slurpy
- # ...
- .end
-
-=end PIR
-
-=for author
-
-Please verify and expand.
-
-=end for
-
-The C<all_args> PMC is a ResizableStringArray PMC, which means you can loop
-over the results, access them individually, or even modify them.
-
-=head3 Continuations
-
-X<continuations>
-
-A continuation is a subroutine that captures a complete copy of the
-caller's context. Invoking a
-continuation starts or restarts it at the entry point:
-
-=begin PIR_FRAGMENT_INVALID
-
- new $P1, "Integer"
- set $P1, 5
-
- newsub $P0, 'Continuation', _con
- _con:
- print "in cont "
- print $P1
- print "\n"
- dec $P1
- unless $P1, done
- invoke # $P0
- done:
- print "done\n"
-
-=end PIR_FRAGMENT_INVALID
-
-This prints:
-
- in cont 5
- in cont 4
- in cont 3
- in cont 2
- in cont 1
- done
-
-Continuations are a kind of subroutine that take a snapshots of control
-flow. They are frozen images of the current
-execution state of the VM. Once you have a continuation, you can invoke it to
-return to the point where the continuation was first created. It's like a
-magical timewarp that allows the developer to arbitrarily move control flow
-back to any previous point in the program.
-
-Continuations are like any other PMC; you can create one with the C<new> opcode:
-
-=begin PIR_FRAGMENT
-
- $P0 = new 'Continuation'
-
-=end PIR_FRAGMENT
-
-The new continuation starts off in an undefined state. If you attempt to invoke
-a new continuation without initializing it, Parrot will throw an exception. To
-prepare the continuation for use, assign it a destination label with the
-C<set_addr> opcode:
-
-=begin PIR_FRAGMENT
-
- $P0 = new 'Continuation'
- set_addr $P0, my_label
-
- my_label:
- # ...
-
-=end PIR_FRAGMENT
-
-To jump to the continuation's stored label and return the context to the state
-it was in I<at the point of its creation>, invoke the continuation:
-
-=begin PIR_FRAGMENT_INVALID
-
- invoke $P0 # Explicit using "invoke" opcode
- $P0() # Same, but nicer syntax
-
-=end PIR_FRAGMENT_INVALID
-
-Even though you can use the subroutine notation C<$P0()> to invoke the
-continuation, it doesn't make any sense to pass arguments or obtain return
-values:
-
-=begin PIR_FRAGMENT
-
- $P0 = new 'Continuation'
- set_addr $P0, my_label
-
- $P0(1, 2) # WRONG!
-
- $P1 = $P0() # WRONG!
-
-=end PIR_FRAGMENT
-
-
-=head4 Continuation Passing Style
-
-X<continuation passing style>
-X<CPS>
-
-Parrot uses continuations internally for control flow. When Parrot
-invokes a function, it creates a continuation representing the
-current point in the program. It passes this continuation as an invisible
-parameter to the function call. When that function returns, it invokes the
-continuation -- in effect, it performs a goto to the point of creation of that
-continuation. If you have a continuation, you can invoke it to return to its
-point of creation any time you want.
-
-This type of flow control -- invoking continuations instead of performing bare
-jumps -- is X<Continuation Passing Style;CPS> Continuation Passing Style (CPS).
-
-
-
-=head4 Tailcalls
-
-In many cases, a subroutine will set up and call another subroutine, and then
-return the result of the second call directly. This is a X<tailcall> tailcall,
-and is an important opportunity for optimization. Here's a contrived example
-in pseudocode:
-
- call add_two(5)
-
- subroutine add_two(value)
- value = add_one(value)
- return add_one(value)
-
-In this example, the subroutine C<add_two> makes two calls to c<add_one>. The
-second call to C<add_one> is the return value. C<add_one> gets called; its
-result gets returned to the caller of C<add_two>. Nothing in C<add_two> uses
-that return value directly.
-
-A simple optimization is available for this type of code. The second call to
-C<add_one> can return to the same place that C<add_two> returns; therefore,
-it's perfectly safe and correct to use the same return continuation that
-C<add_two> uses. The two subroutine calls can share a return continuation,
-instead of having to create a new continuation for each call.
-
-X<.tailcall directive>
-
-PIR provides the C<.tailcall> directive to identify similar situations. Use it
-in place of the C<.return> directive. C<.tailcall> performs this optimization
-by reusing the return continuation of the parent function to make the tailcall:
-
-=begin PIR
-
- .sub 'main' :main
- .local int value
- value = add_two(5)
- say value
- .end
-
- .sub 'add_two'
- .param int value
- .local int val2
- val2 = add_one(value)
- .tailcall add_one(val2)
- .end
-
- .sub 'add_one'
- .param int a
- .local int b
- b = a + 1
- .return (b)
- .end
-
-=end PIR
-
-This example above will print out the correct value "7".
-
-=head3 Native Call Interface
-
-Z<CHP-9-SECT-7.2>
-
-X<subroutines;calling conventions;NCI>
-A special version of the Parrot calling conventions are used by the
-X<NCI (Native Call Interface)> Native Call Interface (NCI) for calling
-subroutines with a known prototype in shared libraries. This is not
-really portable across all libraries, but it's worth a short example.
-This is a simplified version of the first test in F<t/pmc/nci.t>:
-
-=begin PIR_FRAGMENT
-
- loadlib $P1, "libnci_test" # get library object for a shared lib
- print "loaded\n"
- dlfunc $P0, $P1, "nci_dd", "dd" # obtain the function object
- print "dlfunced\n"
- set $I0, 1 # prototype used - unchecked
- set_args "0", 4.0 # set the argument
- get_results "0", $N5 # prepare to store the return value
- invokecc $P0 # call nci_dd
- ne $N5, 8.0, nok_1 # the test functions returns 2*arg
- print "ok 1\n"
- end
- nok_1:
- #...
-
-=end PIR_FRAGMENT
-
-This example shows two new instructions: C<loadlib> and C<dlfunc>. The
-C<loadlib>X<loadlib opcode (PIR)> opcode obtains a handle for a shared
-library. It searches for the shared library in the current directory,
-in F<runtime/parrot/dynext>, and in a few other configured
-directories. It also tries to load the provided filename unaltered and
-with appended extensions like C<.so> or C<.dll>. Which extensions it
-tries depends on the OS Parrot is running on.
-
-The C<dlfunc>X<dlfunc opcode (PIR)> opcode gets a function object from a
-previously loaded library (second argument) of a specified name (third
-argument) with a known function signature (fourth argument). The
-function signature is a string where the first character is the return
-value and the rest of the parameters are the function parameters. The
-characters used in X<NCI (Native Call Interface);function signatures>
-NCI function signatures are listed in Table 9-5.
-
-=begin table picture Function signature letters
-
-Z<CHP-9-TABLE-5>
-
-=headrow
-
-=row
-
-=cell Character
-
-=cell Register set
-
-=cell C type
-
-=bodyrows
-
-=row
-
-=cell C<v>
-
-=cell -
-
-=cell void (no return value)
-
-=row
-
-=cell C<c>
-
-=cell C<I>
-
-=cell char
-
-=row
-
-=cell C<s>
-
-=cell C<I>
-
-=cell short
-
-=row
-
-=cell C<i>
-
-=cell C<I>
-
-=cell int
-
-=row
-
-=cell C<l>
-
-=cell C<I>
-
-=cell long
-
-=row
-
-=cell C<f>
-
-=cell C<N>
-
-=cell float
-
-=row
-
-=cell C<d>
-
-=cell C<N>
-
-=cell double
-
-=row
-
-=cell C<t>
-
-=cell C<S>
-
-=cell char *
-
-=row
-
-=cell C<p>
-
-=cell C<P>
-
-=cell void * (or other pointer)
-
-=row
-
-=cell C<I>
-
-=cell -
-
-=cell Parrot_Interp *interpreter
-
-=row
-
-=cell C<C>
-
-=cell -
-
-=cell a callback function pointer
-
-=row
-
-=cell C<D>
-
-=cell -
-
-=cell a callback function pointer
-
-=row
-
-=cell C<Y>
-
-=cell C<P>
-
-=cell the subroutine C<C> or C<D> calls into
-
-=row
-
-=cell C<Z>
-
-=cell C<P>
-
-=cell the argument for C<Y>
-
-=end table
-
-For more information on callback functions, read the documentation in
-F<docs/pdds/pdd16_native_call.pod> and F<docs/pmc/struct.pod>.
-
-
-
-=head3 Coroutines
-
-X<PIR;Coroutines>
-X<Coroutines>
-
-As we mentioned in the previous chapter, coroutines are
-X<subroutines;coroutines> subroutines that
-can suspend themselves and return control to the caller--and then pick
-up where they left off the next time they're called, as if they never
-left.
-
-X<coroutines>
-In PIR, coroutines are subroutine-like objects:
-
-=begin PIR_FRAGMENT_INVALID
-
- newsub P0, .Coroutine, _co_entry
-
-=end PIR_FRAGMENT_INVALID
-
-The C<Coroutine> object has its own user stack, register frame stacks,
-control stack, and pad stack. The pad stack is inherited from the
-caller. The coroutine's control stack has the caller's control stack
-prepended, but is still distinct. When the coroutine invokes itself,
-it returns to the caller and restores the caller's context (basically
-swapping all stacks). The next time the coroutine is invoked, it
-continues to execute from the point at which it previously returned:
-
-=begin PIR_FRAGMENT_INVALID
-
- new_pad 0 # push a new lexical pad on stack
- new P0, "Int" # save one variable in it
- set P0, 10
- store_lex -1, "var", P0
-
- newsub P0, .Coroutine, _cor
- # make a new coroutine object
- saveall # preserve environment
- invoke # invoke the coroutine
- restoreall
- print "back\n"
- saveall
- invoke # invoke coroutine again
- restoreall
- print "done\n"
- pop_pad
- end
-
- _cor:
- find_lex P1, "var" # inherited pad from caller
- print "in cor "
- print P1
- print "\n"
- inc P1 # var++
- saveall
- invoke # yield( )
- restoreall
- print "again "
- branch _cor # next invocation of the coroutine
-
-=end PIR_FRAGMENT_INVALID
-
-This prints out the result:
-
- in cor 10
- back
- again in cor 11
- done
-
-X<invoke opcode (PIR);coroutines and>
-The C<invoke> inside the coroutine is commonly referred to as
-I<yield>. The coroutine never ends. When it reaches the bottom, it
-branches back up to C<_cor> and executes until it hits C<invoke>
-again.
-
-The interesting part about this example is that the coroutine yields
-in the same way that a subroutine is called. This means that the
-coroutine has to preserve its own register values. This example uses
-C<saveall> but it could have only stored the registers the coroutine
-actually used. Saving off the registers like this works because
-coroutines have their own register frame stacks.
-
-We've mentioned coroutines several times before, and we're finally going
-to explain what they are. Coroutines are similar to subroutines except
-that they have an internal notion of I<state> N<And the cool new name!>.
-Coroutines, in addition to performing a normal C<.return> to return
-control flow back to the caller and destroy the lexical environment of
-the subroutine, may also perform a C<.yield> operation. C<.yield> returns
-a value to the caller like C<.return> can, but it does not destroy the
-lexical state of the coroutine. The next time the coroutine is called, it
-continues execution from the point of the last C<.yield>, not at the
-beginning of the coroutine.
-
-In a Coroutine, when we continue from a C<.yield>, the entire lexical
-environment is the same as it was when C<.yield> was called. This
-means that the parameter values don't change, even if we call the
-coroutine with different arguments later.
-
-Coroutines are defined like any ordinary subroutine. They do not require
-any special flag or any special syntax to mark them as being a
-coroutine. However, what sets them apart is the use of the C<.yield>
-directive. C<.yield> plays several roles:
-
-=over 4
-
-=item * Identifies coroutines
-
-When Parrot sees a yield, it knows to create a Coroutine PMC object
-instead of a Sub PMC.
-
-=item * Creates a continuation
-
-Continuations, as we have already seen, allow us to continue
-execution at the point of the continuation later. It's like a snapshot of
-the current execution environment. C<.yield> creates a continuation in
-the coroutine and stores the continuation object in the coroutine object
-or later resuming from the point of the C<.yield>.
-
-=item * Returns a value
-
-C<.yield> can return a value N<or many values, or no values> to the caller.
-It is basically the same as a C<.return> in this regard.
-
-=back
-
-Here is a quick example of a simple coroutine:
-
- .sub 'MyCoro'
- .yield(1)
- .yield(2)
- .yield(3)
- .return(4)
- .end
-
- .sub 'main' :main
- $I0 = MyCoro() # 1
- $I0 = MyCoro() # 2
- $I0 = MyCoro() # 3
- $I0 = MyCoro() # 4
- $I0 = MyCoro() # 1
- $I0 = MyCoro() # 2
- $I0 = MyCoro() # 3
- $I0 = MyCoro() # 4
- $I0 = MyCoro() # 1
- $I0 = MyCoro() # 2
- $I0 = MyCoro() # 3
- $I0 = MyCoro() # 4
- .end
-
-This is obviously a contrived example, but it demonstrates how the coroutine
-stores it's state. The coroutine stores it's state when we reach a C<.yield>
-directive, and when the coroutine is called again it picks up where it last
-left off. Coroutines also handle parameters in a way that might not be
-intuitive. Here's an example of this:
-
- .sub 'StoredConstant'
- .param int x
- .yield(x)
- .yield(x)
- .yield(x)
- .end
-
- .sub 'main' :main
- $I0 = StoredConstant(5) # $I0 = 5
- $I0 = StoredConstant(6) # $I0 = 5
- $I0 = StoredConstant(7) # $I0 = 5
- $I0 = StoredConstant(8) # $I0 = 8
- .end
-
-Notice how even though we are calling the C<StoredConstant> coroutine with
-different arguments each time, the value of parameter C<x> doesn't change
-until the coroutine's state resets after the last C<.yield>. Remember that
-a continuation takes a snapshot of the current state, and the C<.yield>
-directive takes a continuation. The next time we call the coroutine, it
-invokes the continuation internally, and returns us to the exact same place in
-the exact same condition as we were when we called the C<.yield>. In order
-to reset the coroutine and enable it to take a new parameter, we must either
-execute a C<.return> directive or reach the end of the coroutine.
-
-=head3 Multiple Dispatch
-
-Multiple dispatch is when there are multiple subroutines in a single
-namespace with the same name. These functions must differ, however, in
-their parameter list, or "signature". All subs with the same name get
-put into a single PMC called a MultiSub. The MultiSub is like a list
-of subroutines. When the multisub is invoked, the MultiSub PMC object
-searches through the list of subroutines and searches for the one with
-the closest matching signature. The best match is the sub that gets
-invoked.
+ .sub 'main' :main
+ 'MySub'("name" => "Bob", "age" => 42) # Same!
+ .end
-MultiSubs are subroutines with the C<:multi> flag applied to them.
-MultiSubs (also called "Multis") must all differ from one another in
-the number and/or type of arguments passed to the function. Having
-two multisubs with the same function signature could result in a
-parsing error, or the later function could overwrite the former one
-in the multi.
+=end PIR
-Multisubs are defined like this:
+=head3 Optional Arguments
- .sub 'MyMulti' :multi
- # does whatever a MyMulti does
- .end
+X<optional arguments>
+Some functions have arguments with appropriate default values so that callers
+don't always have to pass them. Parrot provides a mechanism to identify
+optional arguments as well as flag values to determine if the
+caller has passed optional arguments.
-Multis belong to a specific namespace. Functions in different namespaces
-with the same name do not conflict with each other N<this is one of the
-reasons for having multisubs in the first place!>. It's only when
-multiple functions in a single namespace need to have the same name that
-a multi is used.
+Optional parameters appear in PIR as if they're actually I<two> parameters:
+the value and a flag:
-Multisubs take a special designator called a I<multi signature>. The multi
-signature tells Parrot what particular combination of input parameters the
-multi accepts. Each multi will have a different signature, and Parrot will
-be able to dispatch to each one depending on the arguments passed. The
-multi signature is specified in the C<:multi> directive:
+ .param string name :optional
+ .param int has_name :opt_flag
- .sub 'Add' :multi(I, I)
- .param int x
- .param int y
- .return(x + y)
- .end
+The C<:optional> flag specifies that the given parameter is optional. The
+C<:opt_flag> specifies an integer which parameter contains a boolean flag; this
+flag is true if the value was passed, and false otherwise. To provide a default
+value for an optional parameter, you can write:
- .sub 'Add' :multi(N, N)
- .param num x
- .param num y
- .return(x + y)
- .end
+ .param string name :optional
+ .param int has_name :opt_flag
- .sub 'Start' :main
- $I0 = Add(1, 2) # 3
- $N0 = Add(3.14, 2.0) # 5.14
- $S0 = Add("a", "b") # ERROR! No (S, S) variant!
- .end
+ if has_name goto we_have_a_name
+ name = "Default value"
+ we_have_a_name:
-Multis can take I, N, S, and P types, but they can also use C<_> (underscore)
-to denote a wildcard, and a string that can be the name of a particular PMC
-type:
+Optional parameters can be positional or named parameters. Optional positional
+parameters must appear at the end of the list of positional parameters. Also,
+the C<:opt_flag> parameter must always appear directly after the C<:optional>
+parameter.
- .sub 'Add' :multi(I, I) # Two integers
+ .sub 'Foo'
+ .param int optvalue :optional
+ .param int hasvalue :opt_flag
+ .param pmc notoptional # WRONG!
...
- .sub 'Add' :multi(I, 'Float') # An integer and Float PMC
+ .sub 'Bar'
+ .param int hasvalue :opt_flag
+ .param int optvalue :optional # WRONG!
+ ...
+
+ .sub 'Baz'
+ .param int optvalue :optional
+ .param pmc notoptional
+ .param int hasvalue :opt_flag # WRONG!
...
- # Two Integer PMCs
- .sub 'Add' :multi('Integer', _)
+You may mix optional parameters with named parameters:
+
+ .sub 'MySub'
+ .param int value :named("answer") :optional
+ .param int has_value :opt_flag
...
-When we call a multi PMC, Parrot will try to take the most specific
-best-match variant, and will fall back to more general variants if a perfect
-best-match cannot be found. So if we call C<'Add'(1, 2)>, Parrot will dispatch
-to the C<(I, I)> variant. If we call C<'Add'(1, "hi")>, Parrot will match the
-C<(I, _)> variant, since the string in the second argument doesn't match C<I>
-or C<'Float'>. Parrot can also choose to automatically promote one of the I,
-N, or S values to an Integer, Float, or String PMC.
+You can call this function in two ways:
-To make the decision about which multi variant to call, Parrot takes a
-I<Manhattan Distance> between the two. Parrot calculates the I<distance>
-between the multi signatures and the argument signature. Every difference
-counts as one step. A difference can be an autobox from a primitive type
-to a PMC, or the conversion from one primitive type to another, or the
-matching of an argument to a C<_> wildcard. After Parrot calculates the
-distance to each variant, it calls the function with the lowest distance.
-Notice that it's possible to define a variant that is impossible to call:
-for every potential combination of arguments there is a better match. This
-isn't necessarily a common occurrence, but it's something to watch out for
-in systems with a lot of multis and a limited number of data types in use.
+ 'MySub'("answer" => 42) # with a value
+ 'MySub'() # without
=head3 Sub PMCs
@@ -3246,7 +932,7 @@
To find a subroutine in a different namespace, first look up the appropriate
the namespace PMC, then use that with C<get_global>:
- $P0 = get_namespace "MyNamespace"
+ $P0 = get_namespace "MyNameSpace"
$P1 = get_global $P0, "MySubName"
You can obviously invoke a Sub PMC:
@@ -3307,234 +993,147 @@
$P1 = $P0.'get_namespace'()
-=head3 Evaluating a Code String
-
-Z<CHP-9-SECT-7.6>
-
-X<code strings, evaluating>
-This isn't really a subroutine operation, but it does produce a code
-object that can be invoked. In this case, it's a X<bytecode segment
-object> bytecode segment object.
+=head2 The Commandline
-The first step is to get an assembler or compiler for the target
-language:
-
-=begin PIR_FRAGMENT
-
- compreg $P1, "PIR"
-
-=end PIR_FRAGMENT
-
-Within the Parrot interpreter there are currently three registered
-languages: C<PASM>, C<PIR>, and C<PASM1>. The first two are for parrot
-assembly language and parrot intermediate representation code. The third
-is for evaluating single statements in PASM. Parrot automatically adds
-an C<end> opcode at the end of C<PASM1> strings before they're
-compiled.
-
-This example places a bytecode segment object into the destination
-register C<P0> and then invokes it with C<invoke>:
-
-=begin PIR_FRAGMENT_INVALID
-
- compreg P1, "PASM1" # get compiler
- set S1, "in eval\n"
- compile P0, P1, "print S1"
- invoke # eval code P0
- print "back again\n"
-
-=end PIR_FRAGMENT_INVALID
-
-You can register a compiler or assembler for any language inside the
-Parrot core and use it to compile and invoke code from that language.
-These compilers may be written in PIR or reside in shared libraries.
-
-=begin PIR_FRAGMENT
-
- compreg "MyLanguage", $P10
-
-=end PIR_FRAGMENT
-
-In this example the C<compreg> opcode registers the subroutine-like
-object C<P10> as a compiler for the language "MyLanguage". See
-F<examples/compilers> and F<examples/japh/japh16.pasm> for an external
-compiler in a shared library.
-
-
-
-=head2 Lexicals and Globals
-
-So far, we've been treating Parrot registers like the variables of a
-high-level language. This is fine, as far as it goes, but it isn't the
-full picture. The dynamic nature and introspective features of
-languages like Perl make it desirable to manipulate variables by name,
-instead of just by register or stack location. These languages also
-have global variables, which are visible throughout the entire
-program. Storing a global variable in a register would either tie up
-that register for the lifetime of the program or require some unwieldy way
-to shuffle the data into and out of registers.
-
-Parrot provides structures for storing both global and lexically
-scoped named variables. Lexical and global variables must be PMC
-values. PIR provides instructions for storing and retrieving
-variables from these structures so the PIR opcodes can operate on
-their values.
-
-=head3 Globals
-
-Z<CHP-9-SECT-6.1>
+Programs written in Parrot have access to arguments passed on the command
+line like any other program would:
-X<PIR (Parrot assembly language);global variables>
-Global variables are stored in a C<Hash>, so every variable name
-must be unique. PIR has two opcodes for globals, C<set_global> and
-C<get_global>:
+ .sub 'MyMain' :main
+ .param pmc all_args :slurpy
+ ...
+ .end
-=begin PIR_FRAGMENT_INVALID
+=for author
- new P10, "Int"
- set P10, 42
- set_global "$foo", P10
- # ...
- get_global P0, "$foo"
- print P0 # prints 42
+Please verify and expand.
-=end PIR_FRAGMENT_INVALID
+=end for
-The first two statements create a C<Int> in the PMC register
-C<P10> and give it the value 42. In the third statement,
-C<set_global> stores that PMC as the named global variable C<$foo>.
-At some later point in the program, C<get_global> retrieves the PMC
-from the global variable by name, and stores it in C<P0> so it can be
-printed.
+The C<all_args> PMC is a ResizableStringArray PMC, which means you can loop
+over the results, access them individually, or even modify them.
-The C<set_global> opcode only stores a reference to the object. If
-we add an increment statement:
+=head2 Continuation Passing Style
-=begin PIR_FRAGMENT
+X<continuations>
+X<continuation passing style>
+X<CPS>
+Continuations are snapshots of control flow: frozen images of the current
+execution state of the VM. Once you have a continuation, you can invoke it to
+return to the point where the continuation was first created. It's like a
+magical timewarp that allows the developer to arbitrarily move control flow
+back to any previous point in the program.
- inc $P10
+Continuations are not a new concept; they've boggled the minds of new Lisp and
+Scheme programmers for many years. Despite their power and heritage, they're
+not visible to most other modern programming languages or their runtimes.
+Parrot aims to change that: it performs almost all control flow through the use
+of continuations. PIR and PCT hide most of this complexity from developers,
+but the full power of continuations is available.
-=end PIR_FRAGMENT
+When Parrot invokes a function, it creates a continuation representing the
+current point in the program. It passes this continuation as an invisible
+parameter to the function call. When that function returns, it invokes the
+continuation -- in effect, it performs a goto to the point of creation of that
+continuation. If you have a continuation, you can invoke it to return to its
+point of creation any time you want.
-after the C<set_global> it increments the stored global, printing 43.
-If that's not what you want, you can C<clone> the PMC before you store
-it. Leaving the global variable as an alias does have advantages,
-though. If you retrieve a stored global into a register and modify it
-as follows:
+This type of flow control -- invoking continuations instead of performing bare
+jumps -- is X<Continuation Passing Style;CPS> Continuation Passing Style (CPS).
+CPS allows parrot to offer all sorts of neat features, such as tail-call
+optimizations and lexical subroutines.
-=begin PIR_FRAGMENT_INVALID
+=head3 Tailcalls
- get_global P0, "varname"
- inc P0
+A subroutine may set up and call another subroutine, then return the result of
+the second call directly. This is a X<tailcall> tailcall, and is an important
+opportunity for optimization. Here's a contrived example in pseudocode:
-=end PIR_FRAGMENT_INVALID
+ call add_two(5)
-the value of the stored global is directly modified, so you don't need
-to call C<set_global> again.
+ subroutine add_two(value)
+ value = add_one(value)
+ return add_one(value)
-The two-argument forms of C<set_global> and C<get_global> store or
-retrieve globals from the outermost namespace (what Perl users will
-know as the "main" namespace). A simple flat global namespace isn't
-enough for most languages, so Parrot also needs to support
-hierarchical namespaces for separating packages (classes and modules
-in Perl 6). Use C<set_rootglobal> and
-C<get_root_global> add an argument to select a nested namespace:
+In this example, the subroutine C<add_two> makes two calls to c<add_one>. The
+second call to C<add_one> is the return value. C<add_one> gets called; its
+result gets returned to the caller of C<add_two>. Nothing in C<add_two> uses
+that return value directly.
-=begin PIR_FRAGMENT_INVALID
+A simple optimization is available for this type of code. The second call to
+C<add_one> will return to the same place that C<add_two> returns; it's
+perfectly safe and correct to use the same return continuation that C<add_two>
+uses. The two subroutine calls can share a return continuation, instead of
+having to create a new continuation for each call.
- set_root_global ["Foo"], "var", P0 # store P0 as var in the Foo namespace
- get_root_global P1, ["Foo"], "var" # get Foo::var
+X<.tailcall directive>
-=end PIR_FRAGMENT_INVALID
+PIR provides the C<.tailcall> directive to identify similar situations. Use it
+in place of the C<.return> directive. C<.tailcall> performs this optimization
+by reusing the return continuation of the parent function to make the tailcall:
-Eventually the global opcodes will have variants that take a PMC to
-specify the namespace, but the design and implementation of these
-aren't finished yet.
+=begin PIR
-=head3 Lexicals
+ .sub 'main' :main
+ .local int value
+ value = add_two(5)
+ say value
+ .end
-X<PIR (Parrot assembly language);lexical variables>
-Lexical variables are stored in a lexical scratchpad. There's one pad
-for each lexical scope. Every pad has both a hash and an array, so
-elements can be stored either by name or by numeric index.
+ .sub 'add_two'
+ .param int value
+ .local int val2
+ val2 = add_one(value)
+ .tailcall add_one(val2)
+ .end
-=head4 Basic instructions
+ .sub 'add_one'
+ .param int a
+ .local int b
+ b = a + 1
+ .return (b)
+ .end
-Z<CHP-9-SECT-6.2.1>
+=end PIR
-To store a lexical variable in the current scope pad, use C<store_lex>.
-Likewise, use C<find_lex> to retrieve a variable from the current pad.
+This example above print the correct value "7".
-=begin PIR_FRAGMENT
+=head3 Creating and Using Continuations
- new $P0, "Int" # create a variable
- set $P0, 10 # assign value to it
- store_lex "foo", $P0 # store the var with the variable name "foo"
- # ...
- find_lex $P1, "foo" # get the var "foo" into P1
- print $P1
- print "\n" # prints 10
+While Parrot's use of continuations and CPS is invisible to most code, you can
+create and use them explicitly if you like. Continuations are like any other
+PMC. Create one with the C<new> opcode:
-=end PIR_FRAGMENT
+ $P0 = new 'Continuation'
-As we have seen above, we can declare a new subroutine to be a nested inner
-subroutine of an existing outer subroutine using the C<:outer> flag. The
-outer flag is used to specify the name of the outer subroutine. Where there
-may be multiple subroutines with the same name N<such is the case with
-multisubs, which we will discuss soon>, we can use the C<:subid> flag on the
-outer subroutine to give it a different--and unique--name that the lexical
-subroutines can reference in their C<:outer> declarations. Within lexical
-subroutines, the C<.lex> command defines a local variable that follows these
-scoping rules.
+The new continuation starts off in an undefined state. If you attempt to invoke
+a new continuation without initializing it, Parrot will raise an exception. To
+prepare the continuation for use, assign it a destination label with the
+C<set_addr> opcode:
-=head3 LexPad and LexInfo PMCs
+ $P0 = new 'Continuation'
+ set_addr $P0, my_label
-Information about lexical variables in a subroutine is stored in two different
-types of PMCs: The LexPad PMC that we already mentioned briefly, and the
-LexInfo PMCs which we haven't. Neither of these PMC types are really usable
-from PIR code, but are instead used by Parrot internally to store information
-about lexical variables.
-
-C<LexInfo> PMCs are used to store information about lexical variables at
-compile time. This is read-only information that is generated during
-compilation to represent what is known about lexical variables. Not all
-subroutines get a LexInfo PMC by default, you need to indicate to Parrot
-somehow that you require a LexInfo PMC to be created. One way to do this is
-with the C<.lex> directive that we looked at above. Of course, the C<.lex>
-directive only works for languages where the names of lexical variables are
-all known at compile time. For languages where this information isn't known,
-the subroutine can be flagged with C<:lex> instead.
-
-C<LexPad> PMCs are used to store run-time information about lexical variables.
-This includes their current values and their type information. LexPad PMCs are
-created at runtime for subs that have a C<LexInfo> PMC already. These are
-created each time the subroutine is invoked, which allows for recursive
-subroutine calls without overwriting variable names.
+ my_label:
+ ...
-With a Subroutine PMC, you can get access to the associated LexInfo PMC by
-calling the C<'get_lexinfo'> method:
+To jump to the continuation's stored label and return the context to the state
+it was in I<at the point of its creation>, invoke the continuation:
- $P0 = find_global "MySubroutine"
- $P1 = $P0.'get_lexinfo'()
+ invoke $P0 # Explicit using "invoke" opcode
+ $P0() # Same, but nicer syntax
-Once you have the LexInfo PMC, there are a limited number of operations that
-you can call with it:
+Even though you can use the subroutine notation C<$P0()> to invoke the
+continuation, it doesn't make any sense to pass arguments or obtain return
+values:
- $I0 = elements $P1 # Get the number of lexical variables from it
- $P0 = $P1["name"] # Get the entry for lexical variable "name"
+ $P0 = new 'Continuation'
+ set_addr $P0, my_label
-There really isn't much else useful to do with LexInfo PMCs, they're mostly
-used by Parrot internally and aren't helpful to the PIR programmer.
+ $P0(1, 2) # WRONG!
-There is no easy way to get a reference to the current LexPad PMC in a given
-subroutine, but like LexInfo PMCs that doesn't matter because they aren't
-useful from PIR anyway. Remember that subroutines themselves can be lexical
-and that therefore the lexical environment of a given variable can extend to
-multiple subroutines and therefore multiple LexPads. The opcodes C<find_lex>
-and C<store_lex> automatically search through nested LexPads recursively to
-find the proper environment information about the given variables.
+ $P1 = $P0() # WRONG!
-=head3 Lexical Subroutines
+=head2 Lexical Subroutines
X<Lexical Subroutines>
@@ -3545,8 +1144,8 @@
variables that the outer subroutine cannot access. PIR lacks the concept of
blocks or nested lexical scopes; this is how it performs the same function.
-If the subroutine is lexical, you can get its C<:outer> with the C<get_outer>
-method on the Sub PMC:
+If a subroutine is lexical, find its C<:outer> Sub with the C<get_outer>
+method:
$P1 = $P0.'get_outer'()
@@ -3592,9 +1191,9 @@
=head3 PIR Scoping
-Only one PIR structure supports scoping like this: the subroutineN<... and
+Only one PIR structure supports scoping like this: the subroutine.N<... and
objects that inherit from subroutines, such as methods, coroutines, and
-multisubs>. There are no blocks in PIR that have their own scope besides
+multisubs> There are no blocks in PIR that have their own scope besides
subroutines. Fortunately, we can use these lexical subroutines to simulate this
behavior that HLLs require:
@@ -3611,661 +1210,731 @@
.sub 'MyInner' :outer('MyOuter')
.local int z
.lex 'z', z
- #x, y, and z are all "visible" here
+ # x, y, and z are all "visible" here
.end
=end PIR
-In the example above we put the word C<"visible"> in quotes. This is because
-lexically-defined variables need to be accessed with the C<get_lex> and
-C<set_lex> opcodes. These two opcodes don't just access the value of a
-register, where the value is stored while it's being used, but they also make
-sure to interact with the C<LexPad> PMC that's storing the data. If the value
-isn't properly stored in the LexPad, then they won't be available in nested
-inner subroutines, or available from C<:outer> subroutines either.
-
-=head2 Namespaces
-
-X<Namespaces>
-X<.namespace>
-Namespaces provide a mechanism where names can be reused. This may not
-sound like much, but in large complicated systems, or systems with
-many included libraries, it can be very handy. Each namespace gets its
-own area for function names and global variables. This way you can have
-multiple functions named C<create> or C<new> or C<convert>, for
-instance, without having to use I<Multi-Method Dispatch> (MMD) which we
-will describe later. Namespaces are also vital for defining classes and their
-methods, which we already mentioned. We'll talk about all those uses here.
-
-Namespaces are specified with the C<.namespace []> directive. The brackets
-are not optional, but the keys inside them are. Here are some examples:
-
- .namespace [ ] # The root namespace
- .namespace [ "Foo" ] # The namespace "Foo"
- .namespace [ "Foo" ; "Bar" ] # Namespace Foo::Bar
- .namespace # WRONG! The [] are needed
-
-Using semicolons, namespaces can be nested to any arbitrary depth.
-Namespaces are special types of PMC, so we can access them and manipulate
-them just like other data objects. We can get the PMC for the root
-namespace using the C<get_root_namespace> opcode:
-
- $P0 = get_root_namespace
-
-The current namespace, which might be different from the root namespace
-can be retrieved with the C<get_namespace> opcode:
-
- $P0 = get_namespace # get current namespace PMC
- $P0 = get_namespace ["Foo"] # get PMC for namespace "Foo"
-
-Namespaces are arranged into a large n-ary tree. There is the root namespace
-at the top of the tree, and in the root namespace are various special HLL
-namespaces. Each HLL compiler gets its own HLL namespace where it can store
-its data during compilation and runtime. Each HLL namespace may have a large
-hierarchy of other namespaces. We'll talk more about HLL namespaces and their
-significance in chapter 10.
-
-The root namespace is a busy place. Everybody could be lazy and use it to store
-all their subroutines and global variables, and then we would run into all
-sorts of collisions. One library would define a function "Foo", and then
-another library could try to create another subroutine with the same name.
-This is called I<namespace pollution>, because everybody is trying to put
-things into the root namespace, and those things are all unrelated to each
-other. Best practices requires that namespaces be used to hold private
-information away from public information, and to keep like things together.
-
-As an example, the namespace C<Integers> could be used to store subroutines
-that deal with integers. The namespace C<images> could be used to store
-subroutines that deal with creating and manipulating images. That way, when
-we have a subroutine that adds two numbers together, and a subroutine that
-performs additive image composition, we can name them both C<add> without any
-conflict or confusion. And within the C<image> namespace we could have sub
-namespaces for C<jpeg> and C<MRI> and C<schematics>, and each of these could
-have a C<add> method without getting into each other's way.
-
-The short version is this: use namespaces. There aren't any penalties to them,
-and they do a lot of work to keep things organized and separated.
-
-=head3 Namespace PMC
-
-The C<.namespace> directive that we've seen sets the current namespace. In
-PIR code, we have multiple ways to address a namespace:
-
- # Get namespace "a/b/c" starting at the root namespace
- $P0 = get_root_namespace ["a" ; "b" ; "c"]
-
- # Get namespace "a/b/c" starting in the current HLL namespace.
- $P0 = get_hll_namespace ["a" ; "b" ; "c"]
- # Same
- $P0 = get_root_namespace ["hll" ; "a" ; "b" ; "c"]
-
- # Get namespace "a/b/c" starting in the current namespace
- $P0 = get_namespace ["a" ; "b" ; "c"]
-
-Once we have a namespace PMC we can retrieve global variables and
-subroutine PMCs from it using the following functions:
-
- $P1 = get_global $S0 # Get global in current namespace
- $P1 = get_global ["Foo"], $S0 # Get global in namespace "Foo"
- $P1 = get_global $P0, $S0 # Get global in $P0 namespace PMC
-
-=head3 Operations on the Namespace PMC
-
-We've seen above how to find a Namespace PMC. Once you have it, there are a
-few things you can do with it. You can find methods and variables that are
-stored in the namespace, or you can add new ones:
-
- $P0 = get_namespace
- $P0.'add_namespace'($P1) # Add Namespace $P1 to $P0
- $P1 = $P0.'find_namespace'("MyOtherNamespace")
-
- # Find namespace "MyNamespace" in $P0, create it if it
- # doesn't exist
- $P1 = $P0.'make_namespace'("MyNamespace")
-
- $P0.'add_sub'("MySub", $P2) # Add Sub PMC $P2 to the namespace
- $P1 = $P0.'find_sub'("MySub") # Find it
-
- $P0.'add_var'("MyVar", $P3) # Add variable "MyVar" in $P3
- $P1 = $P0.'find_var'("MyVar") # Find it
+=for author
- # Return the name of Namespace $P0 as a ResizableStringArray
- $P3 = $P0.'get_name'()
+This paragraph is unclear.
- # Find the parent namespace that contains this one:
- $P5 = $P0.'get_parent'()
+=end for
- # Get the Class PMC associated with this namespace:
- $P6 = $P0.'get_class'()
+This example calls the variables in C<MyInner> "visible". This is because
+lexically-defined variables need to be accessed with the C<get_lex> and
+C<set_lex> opcodes. These two opcodes don't just access the value of a
+register, where the value is stored while it's being used, but they also make
+sure to interact with the C<LexPad> PMC that's storing the data. If the value
+isn't properly stored in the LexPad, then they won't be available in nested
+inner subroutines, or available from C<:outer> subroutines either.
-There are a few other operations that can be done on Namespaces, but none
-as interesting as these. We'll talk about Namespaces throughout the rest
-of this chapter.
+=head3 Lexical Variables
+=for author
-=head2 Classes and Objects
+What's the point of this paragraph?
-This section revolves around one complete example that defines a
-class, instantiates objects, and uses them. The whole example is
-included at the end of the section.
+=end for
-=head3 Class declaration
+As we have seen above, we can declare a new subroutine to be a nested inner
+subroutine of an existing outer subroutine using the C<:outer> flag. The outer
+flag is used to specify the name of the outer subroutine. Where there may be
+multiple subroutines with the same name, we can use the C<:subid> flag on the
+outer subroutine to give it a different--and unique--name that the lexical
+subroutines can reference in their C<:outer> declarations. Within lexical
+subroutines, the C<.lex> command defines a local variable that follows these
+scoping rules.
-Z<CHP-9-SECT-12.1>
+=head3 LexPad and LexInfo PMCs
-X<classes;in PIR>
-The C<newclass>X<newclass opcode (PIR)> opcode defines a new class.
-It takes two arguments, the name of the class and the destination
-register for the class PMC. All classes (and objects) inherit from the
-C<ParrotClass> PMCX<ParrotClass PMC>, which is the core of the Parrot
-object system.
+X<LexPad PMC>
+X<LexInfo PMC>
+Subs store information about lexical variables in two different PMCs: the
+LexPad PMC and the LexInfo PMC. They're not visible to PIR code; Parrot uses
+them internally to store information about lexical variables.
+
+I<LexInfo> PMCs store read-only information about the lexical variables used in
+a Sub. Parrot creates them when it compiles a Sub. Not all subroutines get a
+LexInfo PMC by default; only those that need it. One way to identify such a
+Sub is its use of the C<.lex> directive, but this only works for languages
+which know the names of lexical variables at compile time. If that's not true
+of your language, declare the Sub with the C<:lex> attribute.
+
+I<LexPad> PMCs store run-time information about lexical variables. This
+includes their current values and their type information. Parrot creates LexPad
+PMCs for Subs that already have a LexInfo PMC. As you can imagine, Parrot must
+create a new LexPad for each I<invocation> of a Sub, lest a recursive call
+overwrite previous lexical values.
-=begin PIR_FRAGMENT
+Call the C<get_lexinfo> method on a Subroutine PMC to access its associated
+LexInfo PMC:
- newclass $P1, "Foo"
+ $P0 = find_global "MySubroutine"
+ $P1 = $P0.'get_lexinfo'()
-=end PIR_FRAGMENT
+Once you have the LexInfo PMC, you can inspect the lexicals it represents:
-To instantiate a new object of a particular class, you first look up
-the integer value for the class type with the C<find_type> opcode,
-then create an object of that type with the C<new> opcode:
+ $I0 = elements $P1 # the number of lexical variables it holds
+ $P0 = $P1["name"] # the entry for lexical variable "name"
-=begin PIR_FRAGMENT_INVALID
+There's not much else you can do (though the PMC behaves like a Hash PMC, so
+you can iterate over its keys and values).
- find_type I1, "Foo"
- new P3I I1
+There is no easy way to get a reference to the current LexPad PMC in a given
+subroutine, but they're not useful from PIR anyway. Remember that subroutines
+themselves can be lexical; the lexical environment of a given variable can
+extend to multiple subroutines with their own LexPads. The opcodes C<find_lex>
+and C<store_lex> search through nested LexPads recursively to find the proper
+environment for the given variables.
+
+=head2 Compilation Units Revisited
+
+Z<CHP-4-SECT-1.1>
+
+X<Subroutine>
+A subroutine is a section of code that forms a single unit. The factorial
+calculation example had two separate subroutines: the C<main> subroutine and
+the C<fact> subroutine. Here is that algorithm in a single subroutine:
-=end PIR_FRAGMENT_INVALID
+=begin PIR
-The C<new> opcode also checks to see if the class defines a
-method named "__init" and calls it if it exists.
+ .sub 'main'
+ $I1 = 5 # counter
+ bsr fact
+ say $I0
+ $I1 = 6 # counter
+ bsr fact
+ say $I0
+ end
-=head3 Attributes
+ fact:
+ $I0 = 1 # product
+ L1:
+ $I0 = $I0 * $I1
+ dec $I1
+ if $I1 > 0 goto L1
+ ret
+ .end
-Z<CHP-9-SECT-12.2>
+=end PIR
-X<attributes;in PIR>
-X<classes;attributes>
-The C<addattribute> opcode creates a slot in the class for an
-attribute (sometimes known as an I<instance variable>) and associates
-it with a name:
+The unit of code from the C<fact> label definition to C<ret> is a reusable
+routine, but is only usable from within the C<main> subroutine. There are
+several problems with this simple approach. In terms of the interface, the
+caller has to know to pass the argument to C<fact> in C<$I1> and to get the
+result from C<$I0>. This differs from Parrot's well-understood calling
+conventions.
+
+Another disadvantage of this approach is that C<main> and C<fact> share the
+same subroutine. Parrot processes them as one piece of code. They share
+registers, and they'd share any LexInfo and LexPad PMCs, if any were needed by
+C<main>. The C<fact> routine is also not easily usable from outside the C<main>
+subroutine, so other parts of your code won't have access to it.
-=begin PIR_FRAGMENT
+=head2 NameSpaces, Methods, and VTABLES
- addattribute $P1, ".i" # Foo.i
+Z<CHP-4-SECT-2>
-=end PIR_FRAGMENT
+X<PIR (Parrot intermediate representation);methods>
+X<methods;in PIR>
+X<classes;methods>
+X<. (dot);. (method call);instruction (PIR)>
+PIR provides syntax to simplify writing methods and method calls for
+object-oriented programming. PIR allows you to define your own classes, and
+with those classes you can define method interfaces to them. Method calls
+follow the Parrot's calling conventions, including the various parameter
+configurations, lexical scoping, and other aspects already shown.
+
+Parrot supports several built-in classes, such as C<ResizablePMCArray> and
+C<Integer>, written in C and compiled with the rest of Parrot. You may also
+declare your own classes in PIR. Like other object oriented systems, Parrot
+classes provide their own I<namespaces> and support I<methods> and
+I<attributes>.
-This chunk of code
-from the C<__init> method looks up the position of the first
-attribute, creates a C<Int> PMC, and stores it as the first
-attribute:
+=head3 NameSpaces
-=begin PIR_FRAGMENT_INVALID
+Z<CHP-4-SECT-2.1>
- classoffset $I0, $P2, "Foo" # first "Foo" attribute of object P2
- new $P6, "Int" # create storage for the attribute
- setattribute $P2, $I0, $P6 # store the first attribute
+X<NameSpaces>
+X<.namespace>
+NameSpaces provide a categorization mechanism to avoid name collisions. This is
+most useful when producing encapsulated libraries or when building large
+systems. Each namespace provides a separate location for function names and
+global variables.
+
+X<namespace collisions>
+X<namespace pollution>
+
+Without a namespace (or in a program that eschews namespaces), all subroutines
+and global variables would live in one big bag, running the risk of
+I<namespace collisions> thanks to I<namespace pollution>. You couldn't tell
+which subroutine performed which operation when two task contexts use the same
+word to mean two different things.
+
+NameSpaces are very effective at hiding private information as well as
+gathering similar things together.
+
+For example, the C<Math> namespace could store subroutines that manipulate
+numbers. The C<Images> namespace could store subroutines create and manipulate
+images. If your program must add two numbers together I<and> perform additive
+image composition, you can use the appropriate namespaced C<add> functions
+without conflict or confusion. Within the C<Image> namespace you could have
+also have sub namespaces for C<jpeg> and C<MRI> and C<schematics>; each of
+these could have its own C<add> subroutine without getting into each other's
+way.
-=end PIR_FRAGMENT_INVALID
+Declare a namespace in PIR with the C<.namespace []> directive. The brackets
+are not optional, but the keys inside them are. For example:
-The C<classoffset> opcodeX<classoffset opcode (PIR)> takes a PMC
-containing an object and the name of its class, and returns an integer
-index for the position of the first attribute. The C<setattribute>
-opcode uses the integer index to store a PMC value in one of the
-object's attribute slots. This example initializes the first
-attribute. The second attribute would be at C<I0 + 1>, the third
-attribute at C<I0 + 2>, etc:
+ .namespace [ ] # The root namespace
+ .namespace [ "Foo" ] # The namespace "Foo"
+ .namespace [ "Foo" ; "Bar" ] # NameSpace Foo::Bar
+ .namespace # WRONG! The [] are needed
-=begin PIR_FRAGMENT_INVALID
+You may nest namespaces to arbitrary depth by separating name components with
+semicolons. NameSpaces are PMC, so you can access them and manipulate them
+just like other data objects. Get the PMC for the root namespace using the
+C<get_root_namespace> opcode:
- inc $I0
- setattribute $P2, $I0, $P7 # store next attribute
- #...
+ $P0 = get_root_namespace
-=end PIR_FRAGMENT_INVALID
+The current namespace may be different from the root namespace; retrieved it
+with the C<get_namespace> opcode:
-There is also support for named parameters with fully qualified
-parameter names (although this is a little bit slower than getting
-the class offset once and accessing several attributes by index):
+ $P0 = get_namespace # get current namespace PMC
+ $P0 = get_namespace ["Foo"] # get PMC for namespace "Foo"
-=begin PIR_FRAGMENT
+X<HLL namespaces>
+X<namespaces; HLL>
+Parrot arranges its namespaces in a hiarachy. The root namespace is the root
+of the tree. Beneath the root are HLL namespaces; hLL compiler gets its own
+HLL namespace where it can store its data during compilation and runtime. Each
+HLL namespace may itself be the root of a tree of namespaces.
- new $P6, "Int"
- setattribute $P2, "Foo\x0.i", $P6 # store the attribute
+=head3 NameSpace PMC
-=end PIR_FRAGMENT
+There are multiple ways to address a namespace in PIR, depending on the
+starting point of the lookup. They may start at the root namespace:
-You use the same integer index to retrieve the value of an attribute.
-The C<getattribute>X<getattribute opcode (PIR)> opcode takes an object and
-an index as arguments and returns the attribute PMC at that position:
+ # Get namespace "a/b/c" starting at the root namespace
+ $P0 = get_root_namespace ["a" ; "b" ; "c"]
-=begin PIR_FRAGMENT_INVALID
+... or from the current HLL's namespace as a root:
- classoffset $I0, $P2, "Foo" # first "Foo" attribute of object P2
- getattribute $P10, $P2, $I0 # indexed get of attribute
+ # Get namespace "a/b/c" starting in the current HLL namespace.
+ $P0 = get_hll_namespace ["a" ; "b" ; "c"]
-=end PIR_FRAGMENT_INVALID
+... but this is identical to a root namespace lookup with the HLL as the first
+branch:
-or
+ $P0 = get_root_namespace ["hll" ; "a" ; "b" ; "c"]
-=begin PIR_FRAGMENT
+... and, of course, relative to the current namespace without a root:
- getattribute $P10, $P2, "Foo\x0.i" # named get
+ # Get namespace "a/b/c" starting in the current namespace
+ $P0 = get_namespace ["a" ; "b" ; "c"]
-=end PIR_FRAGMENT
+Given a namespace PMC, retrieve global variables and subroutine PMCs with the
+C<get_global> opcode:
-To set the value of an attribute PMC, first retrieve it with
-C<getattribute> and then assign to the returned PMC. Because PMC
-registers are only pointers to values, you don't need to store the PMC
-again after you modify its value:
+ $P1 = get_global $S0 # Get global in current namespace
+ $P1 = get_global ["Foo"], $S0 # Get global in namespace "Foo"
+ $P1 = get_global $P0, $S0 # Get global in $P0 namespace PMC
-=begin PIR_FRAGMENT_INVALID
+=head3 Operations on the NameSpace PMC
- getattribute $P10, $P2, $I0
- set $P10, $I5
+You can perform other operations on the NameSpace PMC. You can find methods
+and variables that are stored in the namespace or add new ones.
-=end PIR_FRAGMENT_INVALID
+For example, to add one namespace to another current namespace, use the
+C<add_namespace> method:
-=head3 Methods
+ $P0 = get_namespace
+ $P0.'add_namespace'($P1)
-Z<CHP-9-SECT-12.3>
+You can also find a namespace nested in a namespace with the C<find_namespace>
+method. Note that this finds I<only> a namespace, where the C<find_global>
+opcode will find I<any> PMC stored in that namespace under the given name:
-X<methods;in PIR>
-X<classes;methods>
-X<classes;namespaces>
-Methods in PIR are just subroutines installed in the namespace of the
-class. You define a method with the C<.pcc_sub> directive before the
-label:
-
-=begin PIR_INVALID_FRAGMENT
-
- .pcc_sub _half: # I5 = self."_half"()
- classoffset I0, P2, "Foo"
- getattribute P10, P2, I0
- set I5, P10 # get value
- div I5, 2
- invoke P1
-
-=end PIR_INVALID_FRAGMENT
-
-This routine returns half of the value of the first attribute of the
-object. Method calls use the Parrot calling conventions so they always
-pass the I<invocant> object (often called I<self>) in C<P2>. Invoking
-the return continuation in C<P1> returns control to the caller.
-
-The C<.pcc_sub> directive automatically stores the subroutine as a
-global in the current namespace. The C<.namespace> directive sets the
-current namespace:
+ $P0 = get_namespace
+ $P1 = $P0.'find_namespace'("MyOtherNameSpace")
-=begin PIR
+You may also wish to create a namespace if it doesn't exist and find it
+otherwise. That's the purpose of the C<make_namespace> method:
- .namespace [ "Foo" ]
+ $P1 = $P0.'make_namespace'("MyNameSpace")
-=end PIR
+To manipulate Sub PMCs in a namespace, use the C<add_sub> and C<find_sub>
+methods. As with C<find_namespace>, C<find_sub> returns I<only> a Sub PMC and
+never any other kind of global symbol:
-If the namespace is explicitly set to an empty string or key, then the
-subroutine is stored in the outermost namespace.
+ $P0.'add_sub'("MySub", $P2)
+ $P1 = $P0.'find_sub'("MySub")
-The C<callmethodcc>X<callmethodcc opcode (PIR)> opcode makes a method
-call. It follows the Parrot calling conventions, so it expects to
-find the invocant object in C<P2>, the method object in C<P0>, etc. It
-adds one bit of magic, though. If you pass the name of the method in
-C<S0>, C<callmethodcc> looks up that method name in the invocant
-object and stores the method object in C<P0> for you:
+Similarly, the C<add_var> and C<find_var> methods work on PMCs of I<any> type:
-=begin PIR_FRAGMENT_INVALID
+ $P0.'add_var'("MyVar", $P3) # Add variable "MyVar" in $P3
+ $P1 = $P0.'find_var'("MyVar") # Find it
- set $S0, "_half" # set method name
- set $P2, $P3 # the object
- callmethodcc # create return continuation, call
- print $I5 # result of method call
- print "\n"
+You can get the name of a namespace with the C<get_name> method; this returns a
+ResizableStringArray of STRINGs:
-=end PIR_FRAGMENT_INVALID
+ $P3 = $P0.'get_name'()
-The C<callmethodcc> opcode also generates a return continuation and
-stores it in C<P1>. The C<callmethod> opcode doesn't generate a return
-continuation, but is otherwise identical to C<callmethodcc>. Just like
-ordinary subroutine calls, you have to preserve and restore any
-registers you want to keep after a method call. Whether you store
-individual registers, register frames, or half register frames is up
-to you.
+Request a namespace's parent namespace with the C<get_parent> method:
-=head4 Overriding vtable functions
+ $P5 = $P0.'get_parent'()
-Z<CHP-9-SECT-12.3.1>
+Find a class associated with a namespace with the C<get_class> method:
-Every object inherits a default set of I<vtable> functions from the
-C<ParrotObject> PMC, but you can also override them with your own
-methods. The vtable functions have predefined names that start with a
-double underscore "__". The following code defines a method named
-C<__init> in the C<Foo> class that initializes the first attribute of
-the object with an integer:
+ $P6 = $P0.'get_class'()
-=begin PIR_FRAGMENT_INVALID
+=head3 Calling Methods
- .sub __init:
- classoffset I0, P2, "Foo" # lookup first attribute position
- new P6, "Int" # create storage for the attribute
- setattribute P2, I0, P6 # store the first attribute
- invoke P1 # return
+Z<CHP-4-SECT-2.2>
-=end PIR_FRAGMENT_INVALID
+X<methods>
+Namespaces enable plenty of interesting behaviors, such as object oriented
+programming and method calls. Methods resemble subroutines with one big
+change: they require an invocant (an object PMC passed as the C<self>
+parameter).
+
+The basic syntax for a method call resembles a subroutine call. Previous
+examples have demonstrated it already. A PIR method call takes a variable for
+the invocant PMC and a string with the name of the method:
-Ordinary methods have to be called explicitly, but the vtable
-functions are called implicitly in many different contexts. Parrot
-saves and restores registers for you in these calls. The C<__init>
-method is called whenever a new object is constructed:
+ object."methodname"(arguments)
-=begin PIR_FRAGMENT_INVALID
+If you forget the quotes around the method's name, PIR will treat the method
+name as a named variable which contains the method's name:
- find_type I1, "Foo"
- new P3, I1 # call __init if it exists
+ .local string methname = "Foo"
+ object.methname() # Same as object."Foo"()
+ object."Foo"() # Same
-=end PIR_FRAGMENT_INVALID
+The invocant can be a variable or register, and the method name can be a
+literal string, string variable, or method object PMC.
-A few other vtable functions in the complete code example for this
-section are C<__set_integer_native>, C<__add>, C<__get_integer>,
-C<__get_string>, and C<__increment>. The C<set> opcode calls Foo's
-C<__set_integer_native> vtable function when its destination register
-is a C<Foo> object and the source register is a native integer:
+=head3 Defining Methods
-=begin PIR_FRAGMENT
+Define a method like any other subroutine, respecting two changes. First, a
+method must be a member of a namespace (the namespace representing the class to
+which the method belongs). Second, they require the C<:method> flag.
- set $P3, 30 # call __set_integer_native method
+ .namespace [ "MyClass" ]
-=end PIR_FRAGMENT
+ .sub 'MyMethod' :method
+ ...
+ .end
-The C<add> opcode calls Foo's C<__add> vtable function when it adds
-two C<Foo> objects:
+Inside the method, access the invocant object through the C<self> parameter.
+C<self> isn't the only name you can call this value, however. You can also use
+the C<:invocant> flag to define a new name for the invocant object:
-=begin PIR_FRAGMENT_INVALID
+(See TT #483)
- new $P4, $I1 # same with P4
- set $P4, $12
- new $P5, $I1 # create a new store for add
+=begin PIR
- add $P5, $P3, $P4 # __add method
+ .sub 'MyMethod' :method
+ $S0 = self # Already defined as "self"
+ say $S0
+ .end
-=end PIR_FRAGMENT_INVALID
+ .sub 'MyMethod2' :method
+ .param pmc item :invocant # "self" is now "item"
+ $S0 = item
+ say $S0
+ .end
-The C<inc> opcode calls Foo's C<__increment> vtable function when it
-increments a C<Foo> object:
+=end PIR
-=begin PIR_FRAGMENT
+This example defines two methods in the C<Foo> class. It calls one from the
+main body of the subroutine and the other from within the first method:
- inc $P3 # __increment
+=begin PIR
-=end PIR_FRAGMENT
+ .sub 'main'
+ .local pmc class
+ .local pmc obj
+ newclass class, "Foo" # create a new Foo class
+ new obj, "Foo" # instantiate a Foo object
+ obj."meth"() # call obj."meth" which is actually
+ say "done" # in the "Foo" namespace
+ end
+ .end
-Foo's C<__get_integer> and C<__get_string> vtable functions are called
-whenever an integer or string value is retrieved from a C<Foo> object:
+ .namespace [ "Foo" ] # start namespace "Foo"
-=begin PIR_FRAGMENT
+ .sub 'meth' :method # define Foo::meth global
+ say "in meth"
+ $S0 = "other_meth" # method names can be in a register too
+ self.$S0() # self is the invocant
+ .end
- set $I10, $P5 # __get_integer
- #...
- print $P5 # calls __get_string, prints 'fortytwo'
+ .sub 'other_meth' :method # define another method
+ say "in other_meth" # as earlier, Parrot provides a return
+ .end # statement
-=end PIR_FRAGMENT
+=end PIR
+Each method call looks up the method name in the object's class namespace. The
+C<.sub> directive automatically makes a symbol table entry for the subroutine
+in the current namespace.
-=head3 Inheritance
+You can pass multiple arguments to a method and retrieve multiple return values
+just like a single line subroutine call:
-Z<CHP-9-SECT-12.4>
+ (res1, res2) = obj."method"(arg1, arg2)
-X<inheritance;in PIR>
-X<classes;inheritance>
-The C<subclass>X<subclass opcode (PIR)> opcode creates a new class that
-inherits methods and attributes from another class. It takes 3
-arguments: the destination register for the new class, a register
-containing the parent class, and the name of the new class:
+=head3 VTABLEs
-=begin PIR_FRAGMENT
+PMCs all implement a common interface of functions called X<VTABLE> VTABLEs.
+Every PMC implements the same set of these interfaces, which perform very
+specific low-level tasks on the PMC. The term VTABLE was originally a shortened
+form of the name "virtual function table", although that name isn't used any
+more by the developers, or in any of the documentation.N<In fact, if you say
+"virtual function table" to one of the developers, they probably won't know
+what you are talking about.> The virtual functions in the VTABLE, called
+X<VTABLE interfaces> VTABLE interfaces, are similar to ordinary functions and
+methods in many respects. VTABLE interfaces are occasionally called "VTABLE
+functions", or "VTABLE methods" or even "VTABLE entries" in casual
+conversation. A quick comparison shows that VTABLE interfaces are not really
+subroutines or methods in the way that those terms have been used throughout
+the rest of Parrot. Like methods on an object, VTABLE interfaces are defined
+for a specific class of PMC, and can be invoked on any member of that class.
+Likewise, in a VTABLE interface declaration, the C<self> keyword is used to
+describe the object that it is invoked upon. That's where the similarities end,
+however. Unlike ordinary subroutines or methods, VTABLE methods cannot be
+invoked directly, they are also not inherited through class hierarchies like
+how methods are. With all this terminology discussion out of the way, we can
+start talking about what VTABLES are and how they are used in Parrot.
- subclass $P3, $P1, "Bar"
+VTABLE interfaces are the primary way that data in the PMC is accessed
+and modified. VTABLES also provide a way to invoke the PMC if it's a
+subroutine or subroutine-like PMC. VTABLE interfaces are not called
+directly from PIR code, but are instead called internally by Parrot to
+implement specific opcodes and behaviors. For instance, the C<invoke>
+opcode calls the C<invoke> VTABLE interface of the subroutine PMC,
+while the C<inc> opcode on a PMC calls the C<increment> VTABLE
+interface on that PMC. What VTABLE interface overrides do, in essence,
+is to allow the programmer to change the very way that Parrot accesses
+PMC data in the most fundamental way, and changes the very way that the
+opcodes act on that data.
-=end PIR_FRAGMENT
+PMCs, as we will look at more closely in later chapters, are typically
+implemented using X<PMC Script> PMC Script, a layer of syntax and macros
+over ordinary C code. A X<PMC Compiler> PMC compiler program converts the
+PMC files into C code for compilation as part of the ordinary build
+process. However, VTABLE interfaces can be written I<and overwritten> in
+PIR using the C<:vtable> flag on a subroutine declaration. This technique
+is used most commonly when subclassing an existing PMC class in PIR code
+to create a new data type with custom access methods.
-X<multiple inheritance; in PIR>
-For multiple inheritance, the C<addparent>X<addparent opcode (PIR)>
-opcode adds additional parents to a subclass.
+VTABLE interfaces are declared with the C<:vtable> flag:
-=begin PIR_FRAGMENT
+ .sub 'set_integer' :vtable
+ #set the integer value of the PMC here
+ .end
- newclass $P4, "Baz"
- addparent $P3, $P4
+in which case the subroutine must have the same name as the VTABLE
+interface it is intended to implement. VTABLE interfaces all have very
+specific names, and you can't override one with just any arbitrary name.
+However, if you would like to name the function something different but
+still use it as a VTABLE interface, you could add an additional name
+parameter to the flag:
-=end PIR_FRAGMENT
+ .sub 'MySetInteger' :vtable('set_integer')
+ #set the integer value of the PMC here
+ .end
-To override an inherited method, define a method with the same name in
-the namespace of the subclass. The following code overrides Bar's
-C<__increment> method so it decrements the value instead of
-incrementing it:
+VTABLE interfaces are often given the C<:method> flag also, so that they can
+be used directly in PIR code as methods, in addition to being used by Parrot
+as VTABLE interfaces. This means we can have the following:
-=begin PIR_FRAGMENT_INVALID
+ .namespace [ "MyClass" ]
- .namespace [ "Bar" ]
+ .sub 'ToString' :vtable('get_string') :method
+ $S0 = "hello!"
+ .return($S0)
+ .end
- .sub __increment:
- classoffset I0, P2, "Foo" # get Foo's attribute slot offset
- getattribute P10, P2, I0 # get the first Foo attribute
- dec P10 # the evil line
- invoke P1
+ .namespace [ "OtherClass" ]
-=end PIR_FRAGMENT_INVALID
+ .local pmc myclass = new "MyClass"
+ say myclass # say converts to string internally
+ $S0 = myclass # Convert to a string, store in $S0
+ $S0 = myclass.'ToString'() # The same
-Notice that the attribute inherited from C<Foo> can only be looked up
-with the C<Foo> class name, not the C<Bar> class name. This preserves
-the distinction between attributes that belong to the class and
-inherited attributes.
+Inside a VTABLE interface definition, the C<self> local variable contains
+the PMC on which the VTABLE interface is invoked, just like in a method
+declaration.
-Object creation for subclasses is the same as for ordinary classes:
+=head2 Roles
-=begin PIR_FRAGMENT_INVALID
+As we've seen above and in the previous chapter, Class PMCs and NameSpace
+PMCs work to keep classes and methods together in a logical way. There is
+another factor to add to this mix: The Role PMC.
- find_type $I1, "Bar"
- new $P5, $I1
+Roles are like classes, but don't stand on their own. They represent
+collections of methods and VTABLES that can be added into an existing class.
+Adding a role to a class is called I<composing> that role, and any class
+that has been composed with a role C<does> that role.
-=end PIR_FRAGMENT_INVALID
+Roles are created as PMCs and can be manipulated through opcodes and methods
+like other PMCs:
-Calls to inherited methods are just like calls to methods defined in
-the class:
+ $P0 = new 'Role'
+ $P1 = get_global "MyRoleSub"
+ $P0.'add_method'("MyRoleSub", $P1)
-=begin PIR_FRAGMENT_INVALID
+Once we've created a role and added methods to it, we can add that role to
+a class, or even to another role:
- set $P5, 42 # inherited __set_integer_native
- inc $P5 # overridden __increment
- print $P5 # prints 41 as Bar's __increment decrements
- print "\n"
+ $P1 = new 'Role'
+ $P2 = new 'Class'
+ $P1.'add_role'($P0)
+ $P2.'add_role'($P0)
+ add_role $P2, $P0 # Same!
- set $S0, "_half" # set method name
- set $P2, $P5 # the object
- callmethodcc # create return continuation, call
- print $I5
- print "\n"
+Now that we have added the role, we can check whether we implement it:
-=end PIR_FRAGMENT_INVALID
+ $I0 = does $P2, $P0 # Yes
-=head3 Additional Object Opcodes
+We can get a list of roles from our Class PMC:
-Z<CHP-9-SECT-12.5>
+ $P3 = $P2.'roles'()
-The C<isa> and C<can> instructuions are also useful when working with
-objects. C<isa> checks whether an object belongs to or
-inherits from a particular class. C<can> checks whether
-an object has a particular method. Both return a true or false value.
+Roles are very useful for ensuring that related classes all implement a common
+interface.
-=begin PIR_FRAGMENT
+=head2 Coroutines
- $I0 = isa $P3, "Foo" # 1
- $I0 = isa $P3, "Bar" # 1
- $I0 = can $P3, "add" # 1
+X<PIR;Coroutines>
+X<Coroutines>
+We've mentioned coroutines several times before, and we're finally going
+to explain what they are. Coroutines are similar to subroutines except
+that they have an internal notion of I<state>.N<And the cool new name!>.
+Coroutines, in addition to performing a normal C<.return> to return
+control flow back to the caller and destroy the lexical environment of
+the subroutine, may also perform a C<.yield> operation. C<.yield> returns
+a value to the caller like C<.return> can, but it does not destroy the
+lexical state of the coroutine. The next time the coroutine is called, it
+continues execution from the point of the last C<.yield>, not at the
+beginning of the coroutine.
-=end PIR_FRAGMENT
+In a Coroutine, when we continue from a C<.yield>, the entire lexical
+environment is the same as it was when C<.yield> was called. This
+means that the parameter values don't change, even if we call the
+coroutine with different arguments later.
+=head3 Defining Coroutines
-It may seem more appropriate for a discussion of PIR's support for classes
-and objects to reside in its own chapter, instead of appearing in a generic
-chapter about PIR programming "basics". However, part of PIR's core
-functionality is its support for object-oriented programming. PIR doesn't
-use all the fancy syntax as other OO languages, and it doesn't even support
-all the features that most modern OO languages have. What PIR does have is
-support for some of the basic structures and abilities, the necessary subset
-to construct richer and higher-level object systems.
+Coroutines are defined like any ordinary subroutine. They do not require
+any special flag or any special syntax to mark them as being a
+coroutine. However, what sets them apart is the use of the C<.yield>
+directive. C<.yield> plays several roles:
+=over 4
-=head3 Attributes
+=item * Identifies coroutines
-Classes and subclasses can be given attributes N<in addition to methods,
-which we will talk about in the next chapter> which are named data fields.
-Attributes are created with the C<addattribute> opcode, and can be set
-and retrieved with the C<setattribute> and C<getattribute> opcodes
-respectively:
+When Parrot sees a yield, it knows to create a Coroutine PMC object
+instead of a Sub PMC.
- # Create the new class with two attributes
- $P0 = newclass 'MyClass'
- addattribute $P0, 'First'
- addattribute $P0, 'Second'
+=item * Creates a continuation
- # Create a new item of type MyClass
- $P1 = new 'MyClass'
+Continuations, as we have already seen, allow us to continue
+execution at the point of the continuation later. It's like a snapshot of
+the current execution environment. C<.yield> creates a continuation in
+the coroutine and stores the continuation object in the coroutine object
+or later resuming from the point of the C<.yield>.
- # Set values to the attributes
- setattribute $P1, 'First', 'First Value'
- setattribute $P1, 'Second', 'Second Value'
+=item * Returns a value
- # Get the attribute values
- $S0 = getattribute $P1, 'First'
- $S1 = getattribute $P1, 'Second'
+C<.yield> can return a valueN<or many values, or no values> to the caller.
+It is basically the same as a C<.return> in this regard.
-Those values added as attributes don't need to be strings, even though
-both of the ones in the example are. They can be integers, numbers
-or PMCs too.
+=back
-=head3 Methods
+Here is a quick example of a simple coroutine:
-PIR provides syntax to simplify writing methods and method calls for
-object-oriented programming. We've seen some method calls in the examples
-above, especially when we were talking about the interfaces to certain PMC
-types. We've also seen a little bit of information about classes and objects
-in the previous chapter. PIR allows you to define your own classes, and with
-those classes you can define method interfaces to them. Method calls follow
-the same Parrot calling conventions that we have seen above, including all the
-various parameter configurations, lexical scoping, and other aspects we have
-already talked about.
-
-The second type of class can be defined in PIR at runtime. We saw some
-examples of this in the last chapter using the C<newclass> and C<subclass>
-opcodes. We also talked about class attribute values. Now, we're going to talk
-about associating subroutines with these classes, and they're called
-I<methods>. Methods are just like other normal subroutines with two major
-changes: they are marked with the C<:method> flag, and they exist in a
-I<namespace>. Before we can talk about methods, we need to discuss
-namespaces first.
+ .sub 'MyCoro'
+ .yield(1)
+ .yield(2)
+ .yield(3)
+ .return(4)
+ .end
-Z<CHP-4-SECT-2.2>
+ .sub 'main' :main
+ $I0 = MyCoro() # 1
+ $I0 = MyCoro() # 2
+ $I0 = MyCoro() # 3
+ $I0 = MyCoro() # 4
+ $I0 = MyCoro() # 1
+ $I0 = MyCoro() # 2
+ $I0 = MyCoro() # 3
+ $I0 = MyCoro() # 4
+ $I0 = MyCoro() # 1
+ $I0 = MyCoro() # 2
+ $I0 = MyCoro() # 3
+ $I0 = MyCoro() # 4
+ .end
-Methods are just like subroutines, except
-they are invoked on a object PMC, and that PMC is passed as the c<self>
-parameter.
+This is obviously a contrived example, but it demonstrates how the coroutine
+stores it's state. The coroutine stores it's state when we reach a C<.yield>
+directive, and when the coroutine is called again it picks up where it last
+left off. Coroutines also handle parameters in a way that might not be
+intuitive. Here's an example of this:
-The basic syntax for a method call is similar to the single line
-subroutine call above. It takes a variable for the invocant PMC and a
-string with the name of the method:
+ .sub 'StoredConstant'
+ .param int x
+ .yield(x)
+ .yield(x)
+ .yield(x)
+ .end
- object."methodname"(arguments)
+ .sub 'main' :main
+ $I0 = StoredConstant(5) # $I0 = 5
+ $I0 = StoredConstant(6) # $I0 = 5
+ $I0 = StoredConstant(7) # $I0 = 5
+ $I0 = StoredConstant(8) # $I0 = 8
+ .end
-Notice that the name of the method must be contained in quotes. If the
-name of the method is not contained in quotes, it's treated as a named
-variable that does. Here's an example:
+Notice how even though we are calling the C<StoredConstant> coroutine with
+different arguments each time, the value of parameter C<x> doesn't change
+until the coroutine's state resets after the last C<.yield>. Remember that
+a continuation takes a snapshot of the current state, and the C<.yield>
+directive takes a continuation. The next time we call the coroutine, it
+invokes the continuation internally, and returns us to the exact same place in
+the exact same condition as we were when we called the C<.yield>. In order
+to reset the coroutine and enable it to take a new parameter, we must either
+execute a C<.return> directive or reach the end of the coroutine.
- .local string methname = "Foo"
- object.methname() # Same as object."Foo"()
- object."Foo"() # Same
+=head2 Multiple Dispatch
-The invocant can be a variable or register, and the method name can be
-a literal string, string variable, or method object PMC.
+Multiple dispatch is when there are multiple subroutines in a single
+namespace with the same name. These functions must differ, however, in
+their parameter list, or "signature". All subs with the same name get
+put into a single PMC called a MultiSub. The MultiSub is like a list
+of subroutines. When the multisub is invoked, the MultiSub PMC object
+searches through the list of subroutines and searches for the one with
+the closest matching signature. The best match is the sub that gets
+invoked.
-=head3 Defining Methods
+=head3 Defining MultiSubs
-Methods are defined like any other subroutine except with two major
-differences: They must be inside a namespace named after the class
-they are a part of, and they must use the C<:method> flag.
+MultiSubs are subroutines with the C<:multi> flag applied to them.
+MultiSubs (also called "Multis") must all differ from one another in
+the number and/or type of arguments passed to the function. Having
+two multisubs with the same function signature could result in a
+parsing error, or the later function could overwrite the former one
+in the multi.
- .namespace [ "MyClass"]
+Multisubs are defined like this:
- .sub "MyMethod" :method
- ...
+ .sub 'MyMulti' :multi
+ # does whatever a MyMulti does
+ .end
-Inside the method, the invocant object can be accessed using the C<self>
-keyword. C<self> isn't the only name you can call this value, however.
-You can also use the C<:invocant> flag to define a new name for the invocant
-object:
+Multis belong to a specific namespace. Functions in different namespaces with
+the same name do not conflict with each other. It's only when multiple
+functions in a single namespace need to have the same name that a multi is
+used.
-(See TT #483)
+Multisubs take a special designator called a I<multi signature>. The multi
+signature tells Parrot what particular combination of input parameters the
+multi accepts. Each multi will have a different signature, and Parrot will
+be able to dispatch to each one depending on the arguments passed. The
+multi signature is specified in the C<:multi> directive:
-=begin PIR_INVALID
+ .sub 'Add' :multi(I, I)
+ .param int x
+ .param int y
+ .return(x + y)
+ .end
- .sub "MyMethod" :method
- $S0 = self # Already defined as "self"
- say $S0
+ .sub 'Add' :multi(N, N)
+ .param num x
+ .param num y
+ .return(x + y)
.end
- .sub "MyMethod2" :method
- .param pmc item :invocant # "self" is now called "item"
- $S0 = item
- say $S0
+ .sub 'Start' :main
+ $I0 = Add(1, 2) # 3
+ $N0 = Add(3.14, 2.0) # 5.14
+ $S0 = Add("a", "b") # ERROR! No (S, S) variant!
.end
-=end PIR_INVALID
+Multis can take I, N, S, and P types, but they can also use C<_> (underscore)
+to denote a wildcard, and a string that can be the name of a particular PMC
+type:
-This example defines two methods in the C<Foo> class. It calls one
-from the main body of the subroutine and the other from within the
-first method:
+ .sub 'Add' :multi(I, I) # Two integers
+ ...
-=begin PIR
+ .sub 'Add' :multi(I, 'Float') # An integer and Float PMC
+ ...
- .sub main
- .local pmc class
- .local pmc obj
- newclass class, "Foo" # create a new Foo class
- new obj, "Foo" # instantiate a Foo object
- obj."meth"() # call obj."meth" which is actually
- print "done\n" # in the "Foo" namespace
- .end
+ # Two Integer PMCs
+ .sub 'Add' :multi('Integer', _)
+ ...
- .namespace [ "Foo" ] # start namespace "Foo"
+When we call a multi PMC, Parrot will try to take the most specific
+best-match variant, and will fall back to more general variants if a perfect
+best-match cannot be found. So if we call C<'Add'(1, 2)>, Parrot will dispatch
+to the C<(I, I)> variant. If we call C<'Add'(1, "hi")>, Parrot will match the
+C<(I, _)> variant, since the string in the second argument doesn't match C<I>
+or C<'Float'>. Parrot can also choose to automatically promote one of the I,
+N, or S values to an Integer, Float, or String PMC.
- .sub meth :method # define Foo::meth global
- print "in meth\n"
- $S0 = "other_meth" # method names can be in a register too
- self.$S0() # self is the invocant
- .end
+To make the decision about which multi variant to call, Parrot takes a
+I<Manhattan Distance> between the two. Parrot calculates the I<distance>
+between the multi signatures and the argument signature. Every difference
+counts as one step. A difference can be an autobox from a primitive type
+to a PMC, or the conversion from one primitive type to another, or the
+matching of an argument to a C<_> wildcard. After Parrot calculates the
+distance to each variant, it calls the function with the lowest distance.
+Notice that it's possible to define a variant that is impossible to call:
+for every potential combination of arguments there is a better match. This
+isn't necessarily a common occurrence, but it's something to watch out for
+in systems with a lot of multis and a limited number of data types in use.
- .sub other_meth :method # define another method
- print "in other_meth\n" # as above Parrot provides a return
- .end # statement
-=end PIR
+=head2 Classes and Objects
+
+It may seem more appropriate for a discussion of PIR's support for classes
+and objects to reside in its own chapter, instead of appearing in a generic
+chapter about PIR programming "basics". However, part of PIR's core
+functionality is its support for object-oriented programming. PIR doesn't
+use all the fancy syntax as other OO languages, and it doesn't even support
+all the features that most modern OO languages have. What PIR does have is
+support for some of the basic structures and abilities, the necessary subset
+to construct richer and higher-level object systems.
-Each method call looks up the method name in the object's class namespace.
-The C<.sub> directive automatically makes a symbol table entry for the
-subroutine in the current namespace.
-
-When a C<.sub> is declared as a C<:method>, it automatically creates a
-local variable named C<self> and assigns it the object passed in
-C<P2>. You don't need to write C<.param pmc self> to get it, it comes
-free with the method.
+=head2 PMCs as Classes
-You can pass multiple arguments to a method and retrieve multiple
-return values just like a single line subroutine call:
+PMCs aren't exactly "classes" in the way that this term is normally used in
+object-oriented programming languages. They are polymorphic data items that can
+be one of a large variety of predefined types. As we have seen briefly, and as
+we will see in more depth later, PMCs have a standard interface called the
+VTABLE interface. VTABLEs are a standard list of functions that all PMCs
+implement.N<Alternately, PMCs can choose not to implement each interface
+explicitly and instead let Parrot call the default implementations.>
- (res1, res2) = obj."method"(arg1, arg2)
+VTABLEs are very strict: There are a fixed number with fixed names and
+fixed argument lists. You can't just create any random VTABLE interface that
+you want to create, you can only make use of the ones that Parrot supplies
+and expects. To circumvent this limitation, PMCs may have METHODS in
+addition to VTABLEs. METHODs are arbitrary code functions that can be
+written in C, may have any name, and may implement any behavior.
+=head2 VTABLE Interfaces
+
+Internally, all operations on PMCs are performed by calling various VTABLE
+interfaces.
-=head3 Introspection
+=head2 Class and Object PMCs
The details about various PMC classes are managed by the Class PMC. Class PMCs
contain information about the class, available methods, the inheritance
@@ -4321,137 +1990,44 @@
$P0 = new 'MyArray'
$P1 = new 'MyOtherArray'
+=head2 Attributes
+Classes and subclasses can be given attributes which are named data fields.
+Attributes are created with the C<addattribute> opcode, and can be set and
+retrieved with the C<setattribute> and C<getattribute> opcodes respectively:
-=head3 Vtable Overrides
-
-PMCs all subscribe to a common interface of functions called X<VTABLE>
-VTABLEs. Every PMC implements the same set of these interfaces, which
-perform very specific low-level tasks on the PMC. The term VTABLE was
-originally a shortened form of the name "virtual function table",
-although that name isn't used any more by the developers, or in any of
-the documentation. The virtual functions in the VTABLE, called X<VTABLE
-interfaces> VTABLE interfaces, are similar to ordinary functions and
-methods in many respects. VTABLE interfaces are occasionally called
-"VTABLE functions", or "VTABLE methods" or even "VTABLE entries" in
-casual conversation. A quick comparison shows that VTABLE interfaces
-are not really subroutines or methods in the way that those terms have
-been used throughout the rest of Parrot. Like methods on an object,
-VTABLE interfaces are defined for a specific class of PMC, and can be
-invoked on any member of that class. Likewise, in a VTABLE interface
-declaration, the C<self> keyword is used to describe the object that
-it is invoked upon. That's where the similarities end, however. Unlike
-ordinary subroutines or methods, VTABLE methods cannot be invoked
-directly, they are also not inherited through class hierarchies like
-how methods are. With all this terminology discussion out of the way,
-we can start talking about what VTABLES are and how they are used in
-Parrot.
-
-VTABLE interfaces are the primary way that data in the PMC is accessed
-and modified. VTABLES also provide a way to invoke the PMC if it's a
-subroutine or subroutine-like PMC. VTABLE interfaces are not called
-directly from PIR code, but are instead called internally by Parrot to
-implement specific opcodes and behaviors. For instance, the C<invoke>
-opcode calls the C<invoke> VTABLE interface of the subroutine PMC,
-while the C<inc> opcode on a PMC calls the C<increment> VTABLE
-interface on that PMC. What VTABLE interface overrides do, in essence,
-is to allow the programmer to change the very way that Parrot accesses
-PMC data in the most fundamental way, and changes the very way that the
-opcodes act on that data.
-
-PMCs, as we will look at more closely in later chapters, are typically
-implemented using X<PMC Script> PMC Script, a layer of syntax and macros
-over ordinary C code. A X<PMC Compiler> PMC compiler program converts the
-PMC files into C code for compilation as part of the ordinary build
-process. However, VTABLE interfaces can be written I<and overwritten> in
-PIR using the C<:vtable> flag on a subroutine declaration. This technique
-is used most commonly when subclassing an existing PMC class in PIR code
-to create a new data type with custom access methods.
-
-VTABLE interfaces are declared with the C<:vtable> flag:
-
- .sub 'set_integer' :vtable
- #set the integer value of the PMC here
- .end
-
-in which case the subroutine must have the same name as the VTABLE
-interface it is intended to implement. VTABLE interfaces all have very
-specific names, and you can't override one with just any arbitrary name.
-However, if you would like to name the function something different but
-still use it as a VTABLE interface, you could add an additional name
-parameter to the flag:
-
- .sub 'MySetInteger' :vtable('set_integer')
- #set the integer value of the PMC here
- .end
-
-VTABLE interfaces are often given the C<:method> flag also, so that they can
-be used directly in PIR code as methods, in addition to being used by Parrot
-as VTABLE interfaces. This means we can have the following:
-
- .namespace [ "MyClass" ]
-
- .sub 'ToString' :vtable('get_string') :method
- $S0 = "hello!"
- .return($S0)
- .end
-
- .namespace [ "OtherClass" ]
-
- .local pmc myclass = new "MyClass"
- say myclass # say converts to string internally
- $S0 = myclass # Convert to a string, store in $S0
- $S0 = myclass.'ToString'() # The same
-
-Inside a VTABLE interface definition, the C<self> local variable contains
-the PMC on which the VTABLE interface is invoked, just like in a method
-declaration.
-
-
-=head3 Roles
-
-As we've seen above and in the previous chapter, Class PMCs and NameSpace
-PMCs work to keep classes and methods together in a logical way. There is
-another factor to add to this mix: The Role PMC.
-
-Roles are like classes, but don't stand on their own. They represent
-collections of methods and VTABLES that can be added into an existing class.
-Adding a role to a class is called I<composing> that role, and any class
-that has been composed with a role C<does> that role.
-
-Roles are created as PMC and can be manipulated through opcodes and methods
-like other PMCs:
-
- $P0 = new 'Role'
- $P1 = get_global "MyRoleSub"
- $P0.'add_method'("MyRoleSub", $P1)
-
-Once we've created a role and added methods to it, we can add that role to
-a class, or even to another role:
-
- $P1 = new 'Role'
- $P2 = new 'Class'
- $P1.'add_role'($P0)
- $P2.'add_role'($P0)
- add_role $P2, $P0 # Same!
-
-Now that we have added the role, we can check whether we implement it:
-
- $I0 = does $P2, $P0 # Yes
+ # Create the new class with two attributes
+ $P0 = newclass 'MyClass'
+ addattribute $P0, 'First'
+ addattribute $P0, 'Second'
-We can get a list of roles from our Class PMC:
+ # Create a new item of type MyClass
+ $P1 = new 'MyClass'
- $P3 = $P2.'roles'()
+ # Set values to the attributes
+ setattribute $P1, 'First', 'First Value'
+ setattribute $P1, 'Second', 'Second Value'
-Roles are very useful for ensuring that related classes all implement a common
-interface.
+ # Get the attribute values
+ $S0 = getattribute $P1, 'First'
+ $S1 = getattribute $P1, 'Second'
+Those values added as attributes don't need to be strings, even though
+both of the ones in the example are. They can be integers, numbers
+or PMCs too.
-=head2 Filehandles
+=head2 Input and Output
Like almost everything else in Parrot, input and output are handled by PMCs.
+Using the C<print> opcode or the C<say> opcode like we've already seen in
+some examples does this internally without your knowledge. However, we can
+do it explicitly too. First we'll talk about basic I/O, and then we will talk
+about using PMC-based filehandles for more advanced operations.
+
+=head2 Basic I/O Opcodes
-We've seen C<print> and C<say>. C<print> prints
+We've seen C<print> and C<say>. These are carry-over artifacts from Perl, when
+Parrot was simply the VM backend to the Perl 6 language. C<print> prints
the given string argument, or the stringified form of the argument, if it's
not a string, to standard output. C<say> does the same thing but also appends
a trailing newline to it. Another opcode worth mentioning is the C<printerr>
@@ -4475,6 +2051,8 @@
=end PIR
+=head2 Filehandles
+
The ops we have seen so far are useful if all your I/O operations are limited
to the standard streams. However, there are plenty of other places where
you might want to get data from and send data to. Things like files, sockets,
@@ -4677,101 +2255,6 @@
=head2 Exceptions
-=head2 Exceptions and Exception Handlers
-
-Z<CHP-9-SECT-8>
-
-X<exceptions>
-X<exception handlers>
-Exceptions provide a way of calling a piece of code outside the normal
-flow of control. They are mainly used for error reporting or cleanup
-tasks, but sometimes exceptions are just a funny way to branch from
-one code location to another one. The design and implementation of
-exceptions in Parrot isn't complete yet, but this section will give
-you an idea where we're headed.
-
-Exceptions are objects that hold all the information needed to handle
-the exception: the error message, the severity and type of the error,
-etc. The class of an exception object indicates the kind of exception
-it is.
-
-Exception handlers are derived from continuations. They are ordinary
-subroutines that follow the Parrot calling conventions, but are never
-explicitly called from within user code. User code pushes an exception
-handler onto the control stack with the C<set_eh>X<set_eh opcode (PIR)>
-opcode. The system calls the installed exception handler only when an
-exception is thrown (perhaps because of code that does division by
-zero or attempts to retrieve a global that wasn't stored.)
-
-=begin PIR_FRAGMENT_INVALID
-
- newsub P20, .ExceptionHandler, _handler
- set_eh P20 # push handler on control stack
- null P10 # set register to null
- get_global P10, "none" # may throw exception
- clear_eh # pop the handler off the stack
- #...
-
- _handler: # if not, execution continues here
- is_null P10, not_found # test P10
- #...
-
-=end PIR_FRAGMENT_INVALID
-
-This example creates a new exception handler subroutine with the
-C<newsub> opcode and installs it on the control stack with the
-C<set_eh> opcode. It sets the C<P10> register to a null value (so it
-can be checked later) and attempts to retrieve the global variable
-named C<none>. If the global variable is found, the next statement
-(C<clear_eh>) pops the exception handler off the control stack and
-normal execution continues. If the C<get_global> call doesn't find
-C<none> it throws an exception by pushing an exception object onto the
-control stack. When Parrot sees that it has an exception, it pops it
-off the control stack and calls the exception handler C<_handler>.
-
-The first exception handler in the control stack sees every exception
-thrown. The handler has to examine the exception object and decide
-whether it can handle it (or discard it) or whether it should
-C<rethrow> the exception to pass it along to an exception handler
-deeper in the stack. The C<rethrow>X<rethrow opcode (PIR)> opcode is only
-valid in exception handlers. It pushes the exception object back onto
-the control stack so Parrot knows to search for the next exception
-handler in the stack. The process continues until some exception
-handler deals with the exception and returns normally, or until there
-are no more exception handlers on the control stack. When the system
-finds no installed exception handlers it defaults to a final action,
-which normally means it prints an appropriate message and terminates
-the program.
-
-When the system installs an exception handler, it creates a return
-continuation with a snapshot of the current interpreter context. If
-the exception handler just returns (that is, if the exception is
-cleanly caught) the return continuation restores the control stack
-back to its state when the exception handler was called, cleaning up
-the exception handler and any other changes that were made in the
-process of handling the exception.
-
-Exceptions thrown by standard Parrot opcodes (like the one thrown by
-C<get_global> above or by the C<throw> opcode) are always resumable,
-so when the exception handler function returns normally it continues
-execution at the opcode immediately after the one that threw the
-exception. Other exceptions at the run-loop level are also generally
-resumable.
-
-=begin PIR_FRAGMENT
-
- new $P10, 'Exception' # create new Exception object
- set $P10, 'I die' # set message attribute
- throw $P10 # throw it
-
-=end PIR_FRAGMENT
-
-Exceptions are designed to work with the Parrot calling conventions.
-Since the return addresses of C<bsr> subroutine calls and exception
-handlers are both pushed onto the control stack, it's generally a bad
-idea to combine the two.
-
-
Parrot includes a robust exception mechanism that is not only used internally
to implement a variety of control flow constructs, but is also available for
use directly from PIR code. Exceptions, in as few words as possible, are
@@ -4785,7 +2268,7 @@
such as the location where the error was thrown (including complete
backtraces), any annotation information from the file, and other data.
-=head3 Throwing Exceptions
+=head2 Throwing Exceptions
Many exceptions are used internally in Parrot to indicate error conditions.
Opcodes such as C<die> and C<warn> throw exceptions internally to do what they
@@ -4803,7 +2286,7 @@
handler and continue execution there. If there are no handlers available,
Parrot will exit.
-=head3 Exception Attributes
+=head2 Exception Attributes
Since Exceptions are PMC objects, they can contain a number of useful data
items. One such data item is the message:
@@ -4822,7 +2305,7 @@
$P0["payload"] = $P2 # Any arbitrary PMC
-=head3 Exception Handlers
+=head2 Exception Handlers
Exception handlers are labels in PIR code that can be jumped to when an
exception is thrown. To list a label as an exception handler, the C<push_eh>
@@ -4864,13 +2347,13 @@
my_handler:
...
-=head3 Rethrowing Exceptions
+=head2 Rethrowing and Exception Propagation
Exception handlers are nested and are stored in a stack. This is because not
all handlers are intended to handle all exceptions. If a handler cannot deal
-with a particular exception, it can C<rethrow> the exception to the next outer handler
-handler. If none of the set handlers can handle the exception, the
-exception is a fatal error and Parrot will exit.
+with a particular exception, it can C<rethrow> the exception to the next
+handler in the stack. Exceptions propagate through the handler stack until it
+reaches the default handler which causes Parrot to exit.
=head2 Annotations
@@ -4879,7 +2362,7 @@
is especially important when dealing with high-level languages. We'll go into
detail about annotations and their use in Chapter 10.
-Annotations are created using the c<.annotation> keyword. Annotations consist
+Annotations are created using the C<.annotation> keyword. Annotations consist
of a key/value pair, where the key is a string and the value is an integer,
a number, or a string. Since annotations are stored compactly as constants in
the compiled bytecode, PMCs cannot be used.
@@ -4921,331 +2404,6 @@
C<'annotation'> which is the hash of annotations that were in effect at that
point, and C<'sub'> which is the Sub PMC of that function.
-=head2 Events
-
-Z<CHP-9-SECT-9>
-
-An event is a notification that something has happened: a timer
-expired, an IO operation finished, a thread sent a message to
-another thread, or the user pressed C<Ctrl-C> to interrupt program
-execution.
-
-What all of these events have in common is that they arrive
-asynchronously. It's generally not safe to interrupt program flow at an
-arbitrary point and continue at a different position, so the event is
-placed in the
-interpreter's task queue. The run loops code regularly checks whether
-an event needs to be handled. Event handlers may be an internal piece
-of code or a user-defined event handler subroutine.
-
-Events are still experimental in Parrot, so the implementation and
-design is subject to change.
-
-=head3 Timers
-
-Z<CHP-9-SECT-9.1>
-
-C<Timer> objects are the replacement for Perl 5's C<alarm> handlers.
-They are also a significant improvement. Timers can fire once or
-repeatedly, and multiple timers can run independently. The precision
-of a timer is limited by the OS Parrot runs on, but it is always more
-fine-grained then a whole second. The final syntax isn't yet fixed, so
-please consult the documentation for examples.
-
-=head3 Signals
-
-Z<CHP-9-SECT-9.2>
-
-Signal handling is related to events. When Parrot gets a signal it
-needs to handle from the OS, it converts that signal into an event and
-broadcasts it to all running threads. Each thread independently
-decides if it's interested in this signal and, if so, how to respond to it.
-
-=begin PIR_FRAGMENT_INVALID
-
- newsub P20, .ExceptionHandler, _handler
- set_eh P20 # establish signal handler
- print "send SIGINT:\n"
- sleep 2 # press ^C after you saw start
- print "no SIGINT\n"
- end
- _handler:
- .include "signal.pasm" # get signal definitions
- print "caught "
- set I0, P5["type"] # if _type is negative, the ...
- neg I0, I0 # ... negated type is the signal
- ne I0, .SIGINT, nok
- print "SIGINT\n"
- nok:
- end
-
-=end PIR_FRAGMENT_INVALID
-
-This example creates a signal handler and pushes it on to the control
-stack. It then prompts the user to send a C<SIGINT> from the shell
-(this is usually C<Ctrl-C>, but it varies in different shells), and
-waits for 2 seconds. If the user doesn't send a SIGINT in 2 seconds
-the example just prints "no SIGINT" and ends. If the user does send a
-SIGINT, the signal handler catches it, prints out "caught SIGINT" and
-ends.N<Currently, only Linux installs a C<SIGINT> C<sigaction>
-handler, so this example won't work on other platforms.>
-
-=head2 Threads
-
-Z<CHP-9-SECT-10>
-
-Threads allow multiple pieces of code to run in parallel. This is
-useful when you have multiple physical CPUs to share the load of
-running individual threads. With a single processor, threads still
-provide the feeling of parallelism, but without any improvement in
-execution time. Even worse, sometimes using threads on a single
-processor will actually slow down your program.
-
-Still, many algorithms can be expressed more easily in terms of
-parallel running pieces of code and many applications profit from
-taking advantage of multiple CPUs. Threads can vastly simplify
-asynchronous programs like internet servers: a thread splits off,
-waits for some IO to happen, handles it, and relinquishes the
-processor again when it's done.
-
-Parrot compiles in thread support by default (at least, if the
-platform provides some kind of support for it). Unlike Perl 5,
-compiling with threading support doesn't impose any execution time
-penalty for a non-threaded program. Like exceptions and events,
-threads are still under development, so you can expect significant
-changes in the near future.
-
-As outlined in the previous chapter, Parrot implements three different
-threading models. (B<Note>: As of version 1.0, the C<TQueue> PMC will be
-deprecated, rendering the following discussion obsolete.) The following
-example uses the third model, which takes advantage of shared data. It uses a
-C<TQueue> (thread-safe queue) object to synchronize the two parallel running
-threads. This is only a simple example to illustrate threads, not a typical
-usage of threads (no-one really wants to spawn two threads just to print out a
-simple string).
-
-=begin PIR_FRAGMENT_INVALID
-
- get_global P5, "_th1" # locate thread function
- new P2, "ParrotThread" # create a new thread
- find_method P0, P2, "thread3" # a shared thread's entry
- new P7, "TQueue" # create a Queue object
- new P8, "Int" # and a Int
- push P7, P8 # push the Int onto queue
- new P6, "String" # create new string
- set P6, "Js nte artHce\n"
- set I3, 3 # thread function gets 3 args
- invoke # _th1.run(P5,P6,P7)
- new P2, "ParrotThread" # same for a second thread
- get_global P5, "_th2"
- set P6, "utaohrPro akr" # set string to 2nd thread's
- invoke # ... data, run 2nd thread too
- end # Parrot joins both
-
- .pcc_sub _th1: # 1st thread function
- w1: sleep 0.001 # wait a bit and schedule
- defined I1, P7 # check if queue entry is ...
- unless I1, w1 # ... defined, yes: it's ours
- set S5, P6 # get string param
- substr S0, S5, I0, 1 # extract next char
- print S0 # and print it
- inc I0 # increment char pointer
- shift P8, P7 # pull item off from queue
- if S0, w1 # then wait again, if todo
- invoke P1 # done with string
-
- .pcc_sub _th2: # 2nd thread function
- w2: sleep 0.001
- defined I1, P7 # if queue entry is defined
- if I1, w2 # then wait
- set S5, P6
- substr S0, S5, I0, 1 # if not print next char
- print S0
- inc I0
- new P8, "Int" # and put a defined entry
- push P7, P8 # onto the queue so that
- if S0, w2 # the other thread will run
- invoke P1 # done with string
-
-=end PIR_FRAGMENT_INVALID
-
-This example creates a C<ParrotThread> object and calls its C<thread3>
-method, passing three arguments: a PMC for the C<_th1> subroutine in
-C<P5>, a string argument in C<P6>, and a C<TQueue> object in C<P7>
-containing a single integer. Remember from the earlier section
-"Parrot calling conventions" that registers 5-15
-hold the arguments for a subroutine or method call and C<I3> stores
-the number of arguments. The thread object is passed in C<P2>.
-
-This call to the C<thread3> method spawns a new thread to run the
-C<_th1> subroutine. The main body of the code then creates a second
-C<ParrotThread> object in C<P2>, stores a different subroutine in
-C<P5>, sets C<P6> to a new string value, and then calls the C<thread3>
-method again, passing it the same C<TQueue> object as the first
-thread. This method call spawns a second thread. The main body of code
-then ends, leaving the two threads to do the work.
-
-At this point the two threads have already started running. The first
-thread (C<_th1>) starts off by sleeping for a 1000th of a second. It
-then checks if the C<TQueue> object contains a value. Since it
-contains a value when the thread is first called, it goes ahead and
-runs the body of the subroutine. The first thing this does is shift
-the element off the C<TQueue>. It then pulls one character off a copy
-of the string parameter using C<substr>, prints the character,
-increments the current position (C<I0>) in the string, and loops back
-to the C<w1> label and sleeps. Since the queue doesn't have any
-elements now, the subroutine keeps sleeping.
-
-Meanwhile, the second thread (C<_th2>) also starts off by sleeping for
-a 1000th of a second. It checks if the shared C<TQueue> object
-contains a defined value but unlike the first thread it only continues
-sleeping if the queue does contain a value. Since the queue contains a
-value when the second thread is first called, the subroutine loops
-back to the C<w2> label and continues sleeping. It keeps sleeping
-until the first thread shifts the integer off the queue, then runs the
-body of the subroutine. The body pulls one character off a copy of the
-string parameter using C<substr>, prints the character, and increments
-the current position in the string. It then creates a new
-C<Int>, pushes it onto the shared queue, and loops back to the
-C<w2> label again to sleep. The queue has an element now, so the
-second thread keeps sleeping, but the first thread runs through its
-loop again.
-
-The two threads alternate like this, printing a character and marking
-the queue so the next thread can run, until there are no more
-characters in either string. At the end, each subroutine invokes the
-return continuation in C<P1> which terminates the thread. The
-interpreter waits for all threads to terminate in the cleanup phase
-after the C<end> in the main body of code.
-
-The final printed result (as you might have guessed) is:
-
- Just another Parrot Hacker
-
-The syntax for threads isn't carved in stone and the implementation
-still isn't finished but as this example shows, threads are working
-now and already useful.
-
-Several methods are useful when working with threads. The C<join>
-method belongs to the C<ParrotThread> class. When it's called on a
-C<ParrotThread> object, the calling code waits until the thread
-terminates.
-
-=begin PIR_FRAGMENT_INVALID
-
- new $P2, "ParrotThread" # create a new thread
- set $I5, $P2 # get thread ID
-
- find_method $P0, $P2, "join" # get the join method...
- invoke # ...and join (wait for) the thread
- set $P16, $P5 # the return result of the thread
-
-=end PIR_FRAGMENT_INVALID
-
-C<kill> and C<detach> are interpreter methods, so you have to grab the
-current interpreter object before you can look up the method object.
-
-=begin PIR_FRAGMENT_INVALID
-
- set $I5, $P2 # get thread ID of thread P2
- getinterp $P3 # get this interpreter object
- find_method $P0, $P3, "kill" # get kill method
- invoke # kill thread with ID I5
-
- find_method $P0, $P3, "detach"
- invoke # detach thread with ID I5
-
-=end PIR_FRAGMENT_INVALID
-
-By the time you read this, some of these combinations of statements
-and much of the threading syntax above may be reduced to a simpler set
-of opcodes.
-
-=head2 Loading Bytecode
-
-Z<CHP-9-SECT-11>
-
-In addition to running Parrot bytecode on the command-line, you can
-also load pre-compiled bytecode directly into your PIR source file.
-The C<load_bytecode>X<load_bytecode opcode (PIR)> opcode takes a single
-argument: the name of the bytecode file to load. So, if you create a
-file named F<file.pasm> containing a single subroutine:
-
-=begin PIR_FRAGMENT_INVALID
-
- # file.pasm
- .sub _sub2: # .sub stores a global sub
- print "in sub2\n"
- invoke P1
-
-=end PIR_FRAGMENT_INVALID
-
-and compile it to bytecode using the C<-o> command-line switch:
-
- $ parrot -o file.pbc file.pasm
-
-You can then load the compiled bytecode into F<main.pasm> and directly
-call the subroutine defined in F<file.pasm>:
-
-=begin PIR_FRAGMENT_INVALID
-
- # main.pir
- main:
- load_bytecode "file.pbc" # compiled file.pasm
- get_global $P0, "_sub2"
- invokecc
-
-=end PIR_FRAGMENT_INVALID
-
-The C<load_bytecode> opcode also works with source files, as long as
-Parrot has a compiler registered for that type of file:
-
-=begin PIR_FRAGMENT_INVALID
-
- # main2.pir
- main:
- load_bytecode "file.pasm" # PIR source code
- set_global $P0, "_sub2"
- invokecc
-
-=end PIR_FRAGMENT_INVALID
-
-Subroutines marked with C<:load> run as soon as they're loaded (before
-C<load_bytecode> returns), rather than waiting to be called. A
-subroutine marked with C<:main> will always run first, no matter what
-name you give it or where you define it in the file.
-
-=begin PIR_FRAGMENT_INVALID
-
- # file3.pir
- .sub :load # mark the sub as to be run
- print "file3\n"
- invoke $P1 # return
-
- # main3.pasm
- first: # first is never invoked
- print "never\n"
- invoke $P1
-
- .sub :main # because _main is marked as the
- print "main\n" # MAIN entry of program execution
- load_bytecode "file3.pasm"
- print "back\n"
-
-=end PIR_FRAGMENT_INVALID
-
-This example uses both C<:load> and C<:main>. Because the C<main>
-subroutine is defined with C<:main> it will execute first even though
-another subroutine comes before it in the file. C<main> prints a
-line, loads the PIR source file, and then prints another line.
-Because C<_entry> in F<file3.pasm> is marked with C<:load> it runs
-before C<load_bytecode> returns, so the final output is:
-
- main
- file3
- back
-
-
=cut
# Local variables:
Modified: branches/pmc_pct/docs/book/ch04_compiler_tools.pod
==============================================================================
--- branches/pmc_pct/docs/book/ch04_compiler_tools.pod Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/docs/book/ch04_compiler_tools.pod Thu Jun 4 02:32:48 2009 (r39377)
@@ -2,184 +2,268 @@
=head1 Parrot Compiler Tools
-Z<CHP-9>
+Z<CHP-4>
-So far we've talked a lot about low-level Parrot programming with
-PIR and PASM. However, the true power of Parrot is its ability to
-host programs written in high level languages such as Perl 6,
-Python, Ruby, Tcl, and PHP. In order to write code in these languages
-developers need there to be compilers that convert from the language
-into PIR or PASM (or even directly convert to Parrot Bytecode).
-People who have worked on compilers before may be anticipating us
-to use terms like "Lex and Yacc" here, but we promise that we won't.
-
-Instead of traditional lexical analyzers and parser-generators that
-have been the mainstay of compiler designers for decades, Parrot
-uses an advanced set of parsing tools called the Parrot Compiler
-Tools (PCT)X<Parrot Compiler Tools>. PCT uses a subset of the Perl 6
-programming language called I<Not Quite Perl>X<Not Quite Perl> (NQP)
-and an implementation of the Perl 6 Grammar Engine X<Perl 6 Grammar
-Engine> (PGE) to build compilers for Parrot. Instead of using
-traditional low-level languages to write compilers, we can use a
-modern dynamic language like Perl 6 to write it instead. On a more
-interesting note, this means that the Perl 6 compiler is itself
-being written in Perl 6, a mind-boggling process known as
-C<bootstrapping>.
-
-The language-neutrality of the interpreter is partially a design
-decision for modularity. Keeping the implementation independent of the
-syntax makes the codebase cleaner and easier to maintain.
-Modular design also benefits future language designers, not just
-designers of current languages. Instead of targeting I<lex>/I<yacc> and
-reimplementing low-level features such as garbage collection and dynamic
-data types, designers can leave the details to Parrot and focus on the
-high-level features of their language: syntax, libraries, capabilities.
-Parrot does all the necessary bookkeeping, exposing a rich interface with
-capabilities that few languages can make full use of.
-
-A robust exceptions system, a capability to compile into
-platform-independent bytecode, and a clean extension and embedding
-mechanism would be just some of the necessary and standard features.
-
-Since Parrot would support the features of the major dynamic languages
-and wasn't biased to a particular syntax, it could run all these
-languages with little additional effort.
-
-Language interoperability is another core goal. Different languages are
-suited to different tasks, and picking which language to use in a large
-software project is a common planning problem. There's never a perfect
-fit, at least not for all jobs. Developers find themselves settling for
-the language with the most advantages and the least noticeable
-disadvantages. The ability to easily combine multiple languages within a
-single project opens up the potential of using well-tested libraries
-from one language, taking advantage of clean problem-domain expression
-in a second, while binding it together in a third that elegantly
-captures the overall architecture. It's about using languages according
-to their inherent strengths, and mitigating the cost of their
-weaknesses.
+The previous chapters demonstrated low-level Parrot programming in PIR. That's
+fun, but Parrot's true power is to host programs written in high level
+languages such as Perl 6, Python, Ruby, Tcl, and PHP.
+
+Parrot's language neutrality was a conscious design decision. Parrot and Perl
+6 hewed closely in the early days; it would have been easy for the two to
+overlap and intermingle.
+
+By keeping the two projects separate and encapsulated, the possibility arose to
+support many other dynamic languages equally well. This modular design also
+benefits designers of future languages. Instead of having to reimplement
+low-level features such as garbage collection and dynamic data types, language
+designers and compiler implementers can leave these details of infrastructure
+to Parrot and focus on the syntax, capabilities, and libraries of their
+high-level languages instead.
+
+Parrot exposes a rich interface for these languages to use, offering several
+important features: a robust exceptions system, compilation into
+platform-independent bytecode, a clean extension and embedding interface,
+just-in-time compilation to machine code, native library interface mechanisms,
+garbage collection, support for objects and classes, and a robust concurrency
+model. Designing a new language or implementing a new compiler for an old
+language is easier with all of these features designed, implemented, tested,
+and supported in a VM already.
+
+Language interoperability is a core goal for Parrot. Different languages are
+suited to different tasks; heated debates explode across the Internet about
+which language is right for which project. There's rarely a perfect fit.
+Developers often settle for one particular language if only because it offers
+the fewest I<disadvantages>. Parrot changes this game by allowing developers
+to combine multiple languages seamlessly within a single project. Well-tested
+libraries written in one languages can interoperate with clean problem-domain
+expression in a second language, glued together by a third language which
+elegantly describes the entire system's architecture. You can use the
+strengths of multiple language and mitigate their weaknesses.
+
+For language hosting and interoperability to work, languages developers need to
+write compilers that convert source code written in high level languages to
+bytecode. This process is analogous to how a compiler such as GCC converts C
+or C++ into machine code -- though instead of targeting machine code for a
+specific hardware platform, compilers written in Parrot produce Parrot code
+which can run on any hardware platform that can run Parrot.
+
+Parrot includes a suite of compiler tools for every step of this conversion:
+lexical analysis, parsing, optimization, resource allocation, and code
+generation. Instead of using traditional low-level languages -- such as the C
+produced by C<lex> and C<yacc> -- to write compilers, Parrot can use any
+language hosted on Parrot in its compiler process. As a practical matter, the
+prevalent tool uses a subset of the Perl 6 programming language called I<Not
+Quite Perl>X<Not Quite Perl> (NQP) and an implementation of the Perl 6 Grammar
+Engine X<Perl 6 Grammar Engine> (PGE) to build compilers for Parrot.
+
+=begin notetip
+
+Yes, the Perl 6 compiler on Parrot is itself written in Perl 6. This
+X<bootstrapping> I<bootstrapping> process is mind-boggling at first.
+
+=end notetip
+
+PGE and NQP are part of the Parrot Compiler Tools. A<CHP-5> Chapter 5
+discusses PGE and A<CHP-6> Chapter 6 explains NQP.
=head2 PCT Overview
-PCT is a collection of classes which handle the creation of a
-compiler and driver program for a high-level language. The
-C<PCT::HLLCompiler> class handles building the compiler front end
-while the C<PCT::Grammar> and C<PCT::Grammar::Actions> classes handle
-building the parser and lexical analyzer. Creating a new HLL compiler
-is as easy as subclassing these three entities with methods specific
-to that high-level language.
+The X<Parrot Compiler Tools;PCT> Parrot Compiler Tools (PCT) enable the
+creation of high-level language compilers and runtimes. Though the Perl 6
+development team originally created these tools to produce Rakudo (Perl 6 on
+Parrot), several other Parrot-hosted compilers use them to great effect.
+Writing a compiler using Perl 6 syntax and dynamic language tools is much
+easier than writing a compiler in C, C<lex>, and C<yacc>.
+
+PCT contains several classes that implement various parts of a compiler. HLL
+developers write language-specific subclasses to fill in the details their
+languages require. The X<HLLCompiler> C<PCT::HLLCompiler> class specifies the
+compiler's interface and represents the object used to parse and execute code.
+The X<Parrot Compiler Tools;PCT::Grammar> C<PCT::Grammar> and X<Parrot Compiler
+Tools;PCT::Grammar::Actions> C<PCT::Grammar::Actions> classes represent the
+parser and syntax tree generators, respectively. Creating a new HLL compiler is
+as easy as subclassing these three entities with methods specific to your
+language.
=head3 Grammars and Action Files
-Creating a compiler using PCT requires three basic files, plus any
-additional files needed to implement the languages logic and library:
+A PCT-based compiler requires three basic files: the main entry point file, the
+grammar specification file, and the grammar actions file. In addition,
+compilers and the languages they implement often use large libaries of built-in
+routines to provide language-specific behaviors.
=over 4
-=item * A main file
+=item * The main file
-The main file should contain the C<:main> function that is the driver
-program for the compiler. Here, a new C<PCT::HLLCompiler> object is
-instantiated, libraries are loaded, and necessary special global
-variables are created. The driver program is typically written in PIR,
-although thankfully they tend to be very short. Most of the action
-happens elsewhere.
-
-=item * A parser file
-
-The grammar for the high level language is specified using the Perl 6
-grammar engine (PGE) and is stored in a C<.pg> file. This file should
-subclass the C<PCT::Grammar> class and implement all the necessary
-rules to successfully parse the language.
+The main file is (often) a PIR program which contains the C<:main> function
+that creates and executes the compiler object. This program instantiates a
+C<PCT::HLLCompiler> subclass, loads any necessary support libraries, and
+initializes any compiler- or languages-specific data.
+
+The main file tends to be short. The guts of the compiler logic is in the
+grammar and actions files. Runtime support and auxiliary functions often
+appear in other files, by convention. This separation of concerns tends to
+make compilers easier to maintain.
+
+=item * A grammar file
+
+The high-level language's grammar appears in a F<.pg> file. This file
+subclasses C<PCT::Grammar> class and implements all of the necessary rules --
+written using PGE -- to parse the languages.
=item * An actions file
-Actions files are written in NQP. They take match objects generated by
-the grammar file and convert them into an Abstract Syntax Tree (AST)
-X<Abstract Syntax Tree;Parrot Abstract Syntax Tree;AST;PAST>
-which is converted by PCT into PIR for compiling and execution.
-The PIR implementation of these AST trees and nodes is called the
-Parrot Abstract Syntax Tree (PAST).
+Actions contains methods -- written in NQP -- on the C<PCT::Grammar:Actions>
+object which receive parse data from the grammar rules and construct an
+X<Abstract Syntax Tree;Parrot Abstract Syntax Tree;AST;PAST> Abstract Syntax
+Tree (AST).N<The Parrot version of an AST is, of course, the Parrot Abstract
+Syntax Tree, or PAST.>
=back
-=head3 C<make_language_shell.pl>
+PCT's workflow is customizable, but simple. The compiler passes the source
+code of the HLL into the grammar engine. The grammer engine parses this code
+and returns a X<PGE;Match Object> special Match object which represents a
+parsed version of the code. The compiler then passes this match object to the
+action methods, which convert it in stages into PAST. The compiler finally
+converts this PAST into PIR code, which it can save to a file, convert to
+bytecode, or execute directly.
+
+=head3 C<mk_language_shell.pl>
+
+The only way creating a new language compiler could be easier is if these files
+created themselves. PCT includes a tool to do just that:
+C<mk_language_shell.pl>. This program automatically creates a new directory in
+F<languages/> for your new language, the necessary three files, starter files
+for libraries, a F<Makefile> to automate the build process, and a basic test
+harness to demonstrate that your language works as expects.
+
+These generated files are all stubs which will require extensive editing to
+implement a full language, but they are a well-understood and working starting
+point. With this single command you can create a working compiler. It's up to
+you to fill the details.
+
+C<mk_language_shell.pl> prefers to run from within a working Parrot repository.
+It requires a single argument, the name of the new project to create. There
+are no hard-and-fast rules about names, but the Parrot developers reccomend
+that Parrot-based implementations of existing languages use unique names.
+
+Consider the names of Perl 5 distributions: Active Perl and Strawberry Perl.
+Python implementations are IronPython (running on the CLR) and Jython (running
+on the JVM). The Ruby-on-Parrot compiler isn't just "Ruby": it's Cardinal.
+The Tcl compiler on Parrot is Partcl.
+
+An entirely new language has no such constraints.
-The Parrot repository contains a number of helpful utilities for doing
-some common development and building tasks with Parrot. Many of these
-utilities are currently written in Perl 5, though some run on Parrot
-directly, and in future releases more will be migrated to Parrot.
-
-One of the tools of use to new compiler designers and language implementers
-is C<make_language_shell.pl>. C<make_language_shell.pl> is a tool for
-automatically creating all the necessary stub files for creating a new
-compiler for Parrot. It generates the driver file, parser grammar and
-actions files, builtin functions stub file, makefile, and test harness.
-All of these are demonstrative stubs and will obviously need to be
-edited furiously or even completely overwritten, but they give a good idea
-of what is needed to start on development of the compiler.
-
-C<make_language_shell.pl> is designed to be run from within the Parrot
-repository file structure. It creates a subfolder in C</languages/>
-with the name of your new language implementation. Typically a new
-implementation of an existing language is not simply named after the
-language, but is given some other descriptive name to let users know it
-is only one implementation available. Consider the way Perl 5 distributions
-are named things like "Active Perl" or "Strawberry Perl", or how Python
-distributions might be "IronPython" or "VPython". If, on the other hand,
-you are implementing an entirely new language, you don't need to give it
-a fancy distribution name.
+From the Parrot directory, invoke C<mk_language_shell.pl> like:
+
+ $ B<cd languages/>
+ $ B<perl ../tools/build/mk_language_shell.pl <project name>>
=head3 Parsing Fundamentals
-Compilers typically consist of three components: The lexical analyzer,
-the parser, and the code generator C<This is an oversimplification,
-compilers also may have semantic analyzers, symbol tables, optimizers,
-preprocessors, data flow analyzers, dependency analyzers, and resource
-allocators, among other components. All these things are internal to
-Parrot and aren't the concern of the compiler implementer. Plus, these
-are all well beyond the scope of this book>. The lexical analyzer converts
-the HLL input file into individual tokens. A token may consist of an
-individual punctuation mark("+"), an identifier ("myVar"), or a keyword
-("while"), or any other artifact that cannot be sensibly broken down. The
-parser takes a stream of these input tokens, and attempts to match them
-against a given pattern, or grammar. The matching process orders the input
-tokens into an abstract syntax tree (AST), which is a form that
-the computer can easily work with. This AST is passed to the code
-generator which converts it into code of the target language. For
-something like the GCC C compiler, the target language is machine code.
-For PCT and Parrot, the target language is PIR and PBC.
-
-Parsers come in two general varieties: Top-down and bottom-up. Top-down
-parsers start with a top-level rule, a rule which is supposed to
-represent the entire input. It attempts to match various combination of
-subrules until the entire input is matched. Bottom-down parsers, on the
-other hand, start with individual tokens from the lexical analyzer and
-attempt to combine them together into larger and larger patterns until
-they produce a top-level token.
-
-PGE itself is a top-down parser, although it also contains a bottom-up
-I<operator precedence> parser, for things like mathematical expressions
-where bottom-up methods are more efficient. We'll discuss both, and the
-methods for switching between the two, throughout this chapter.
+An important part of a compiler is the parser and lexical analyzer. The
+lexical analyzer converts the HLL input file into individual tokens. A token
+may consist of an individual punctuation ("+"), an identifier ("myVar"), a
+keyword ("while"), or any other artifact that stands on its own as a single
+unit. The parser attempts to match a stream of these input tokens against a
+given pattern, or grammar. The matching process orders the input tokens into an
+abstract syntax tree which the other portions of the compiler can process.
+
+X<top-down parser>
+X<bottom-up parser>
+X<parsers; top-down>
+X<parsers; bottom-up>
+Parsers come in top-down and bottom-up varieties. Top-down parsers start with a
+top-level rule which represents the entire input. It attempts to match various
+combination of subrules until it has consumed the entire input. Bottom-down
+parsers start with individual tokens from the lexical analyzer and attempt to
+combine them together into larger and larger patterns until they produce a
+top-level token.
+
+PGE is a top-down parser, although it also contains a bottom-up I<operator
+precedence> parser to make processing token clusters such as mathematical
+expressions more efficient.
=head2 Driver Programs
-The driver program for the new compiler must create instances of the
-various necessary classes that run the parser. It must also include
-the standard function libraries, create global variables, and handle
-commandline options. Most commandline options are handled by PCT, but
-there are some behaviors that the driver program will want to
-override.
-
-PCT programs can, by default, be run in two ways: Interactive mode,
-which is run one statement at a time in the console, and file mode which
-loads and runs an entire file. For interactive mode, it is necessary
-to specify information about the prompt that's used and the environment
-that's expected. Help and error messages need to be written for the user
-too.
+The driver program for the new compiler must create instances of the various
+necessary classes that run the parser. It must also include the standard
+function libraries, create global variables, and handle commandline options.
+PCT provides several useful command-line options, but driver programs may need
+to override several behaviors.
+
+PCT programs can run in two ways. An interactive mode runs one statement at a
+time in the console. A file mode loads and runs an entire file at once. A
+driver program may specificy information about the interactive prompt and
+environment, as well as help and error messages.
=head3 C<HLLCompiler> class
+The C<HLLCompiler> class implements a compiler object. This object contains
+references to language-specific parser grammar and actions files, as well as
+the steps involved in the compilation process. The stub compiler created by
+C<mk_language_shell.pl> might resemble:
+
+ .sub 'onload' :anon :load :init
+ load_bytecode 'PCT.pbc'
+ $P0 = get_hll_global ['PCT'], 'HLLCompiler'
+ $P1 = $P0.'new'()
+ $P1.'language'('MyCompiler')
+ $P1.'parsegrammar'('MyCompiler::Grammar')
+ $P1.'parseactions'('MyCompiler::Grammar::Actions')
+ .end
+
+ .sub 'main' :main
+ .param pmc args
+ $P0 = compreg 'MyCompiler'
+ $P1 = $P0.'command_line'(args)
+ .end
+
+The C<:onload> function creates the driver object as an instance of
+C<HLLCompiler>, sets the necessary options, and registers the compiler with
+Parrot. The C<:main> function drives parsing and execution begin. It calls the
+C<compreg> opcode to retrieve the registered compiler object for the language
+"MyCompiler" and invokes that compiler object using the options received from
+the commandline.
+
+The C<compreg> opcode hides some of Parrot's magic; you can use it multiple
+times in a program to compile and run different languages. You can create
+multiple instances of a compiler object for a single language (such as for
+runtime C<eval>) or you can create compiler objects for multiple languages for
+easy interoperability. The Rakudo Perl 6 C<eval> function uses this mechanism
+to allow runtime eval of code snippets in other languages:
+
+ eval("puts 'Konnichiwa'", :lang<Ruby>);
+
+=head3 C<HLLCompiler> methods
+
+The previous example showed the use of several HLLCompiler methods:
+C<language>, C<parsegrammar>, and C<parseactions>. These three methods are the
+bare minimum interface any PCT-based compiler should provide. The C<language>
+method takes a string argument that is the name of the compiler. The
+HLLCompiler object uses this name to register the compiler object with Parrot.
+The C<parsegrammar> method creates a reference to the grammar file that you
+write with PGE. The C<parseactions> method takes the class name of the NQP file
+used to create the AST-generator for the compiler.
+
+If your compiler needs additional features, there are several other available
+methods:
+
+=over 4
+
+=item * C<commandline_prompt>
+
+The C<commandline_prompt> method allows you to specify a custom prompt to
+display to users in interactive mode.
+
+=item * C<commandline_banner>
+
+The C<commandline_banner> method allows you to specify a banner message that
+displays at the beginning of interactive mode.
+
+=back
=cut
Modified: branches/pmc_pct/docs/book/ch05_pge.pod
==============================================================================
--- branches/pmc_pct/docs/book/ch05_pge.pod Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/docs/book/ch05_pge.pod Thu Jun 4 02:32:48 2009 (r39377)
@@ -6,26 +6,47 @@
X<PGE (Parrot Grammar Engine)>
The Parrot Grammar Engine (PGE) is a parser generator, one of the key
components of the Parrot Compiler Toolkit. It reads grammar files written in
-the PGE rules format and generates parser modules. PGE rules provide the full
-power of recursive descent parsing and operator precedence parsing, but are
-usable even if you don't know exactly what that means. All you'll need to know
-to start is that rules are patterns for matching text.
+the PGE rules format and generates parser modules written in PIR code. PGE
+rules provide the full power of I<recursive descent parsing> and I<operator
+precedence parsing>. Fortunately, you don't need to know what those terms
+mean in order to make good use of PGE. We'll introduce the necessary
+concepts as we talk about various features in this chapter.
=head2 Grammars
-A grammar is a collection of rules, in much the same way that a class is a
-collection of methods.N<A grammar is a special kind of class and a rule is a
-special kind of method.> Each rule defines a pattern for matching one unit of
-text. The basic matching syntax for rules is familiar to anyone who has worked
-with regular expressions:
+The ultimate goal of a parser is to match patterns in a source language and
+convert them to an internal data structure for later manipulations. As a
+programmer, you're probably already familiar with some of these types of
+patterns: function declarations, function calls, statements, and assignments.
+Each of these different concepts have a particular form called a I<syntax>.
+In C for example, the syntax to define a function looks something like this:
+
+ <return_type> <function_name> ( <arguments> ) { <function_body> }
+
+Things that fit this pattern, so long as all the sub-patterns use the proper
+syntax also, are valid subroutines in C. Similarly, we can use a slightly
+different pattern to create a subroutine:
+
+ sub <function_name> { <function_body> }
+
+A grammar is a collection of rules like the ones above that specify all the
+acceptable patterns in a language. Grammars group together these rules in
+much the same way that a groups together related data fields and methods
+N<In languages like Perl 6 for instance, a grammar is just a special kind
+of class and a rule is just a special kind of method.>. Each rule defines
+a pattern for matching one unit of text, and can be made up of various other
+rules which are called recursively to make a complete match.
+
+A rule can contain regular expressions to match patterns of characters:
rule id { \d+ }
-Smaller rules can combine into larger rules:
+A rule can also contain patterns of references to other rules:
rule record { <id> <name> <phone> }
-A grammar contains a group of rules that work together:
+A grammar contains a group of rules that work together to match the entire
+language:
grammar Contacts;
@@ -41,10 +62,10 @@
X<rule>
X<token>
-There are two different kinds of rules: C<rule> or C<token>. A C<rule> performs
-smart whitespace matching between the various pieces of the pattern. The
-C<record> rule given previously would match "6355 John" or "6355 John" but
-not "6355John".
+There are two different kinds of rules: C<rule>, which we saw above, and
+C<token>. A C<rule> performs smart whitespace matching between the various
+pieces of the pattern. The C<record> rule given previously would match
+"6355 John" or "6355 John" but not "6355John".
A C<token> matches whitespace only if you specifically request it. To get the
same effect with a token, add the C<\s> (match a space character) and C<+>
@@ -57,20 +78,25 @@
X<top>
X<top-down parser>
-A recursive descent parser is a top-down parser. It starts at the highest-level
-rule and works its way down through individual rules to match an entire string
-or file. PGE convention calls this top-level rule C<TOP>N<Perl 6 allows any
-name for the top-level rule, but PCT expects a rule called C<TOP>.>.
+A recursive descent parser is what's called a I<top-down parser>. It starts
+at the highest-level rule, called C<TOP>, and works its way down through
+individual rules to match an entire string or file. Real Perl 6 allows any
+name for the top-level rule, but PCT expects a rule called C<TOP>. If PCT
+was as fully-featured as Perl 6, people would use it instead! Here's an
+example of a TOP rule:
rule TOP { <record> }
-This rule matches a single record in a string or file. Once the parser has
-succeeded in matching the entire string or file passed to the start rule, it
-returns a parse tree.
+This rule matches a single C<record> pattern in a string or file. Once the
+parser has succeeded in matching the entire string or file passed to the
+start rule, it returns a parse tree. If it cannot match the entire input
+with the rules provided, it can either return a partial match, or it can
+throw a parse error.
=head3 Testing a Grammar
-Save this example to a file called F<Contacts.pg>:
+Let's do a small example grammar. Save this example to a file called
+F<Contacts.pg>:
grammar Contacts is PGE::Grammar;
Modified: branches/pmc_pct/docs/book/ch06_nqp.pod
==============================================================================
--- branches/pmc_pct/docs/book/ch06_nqp.pod Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/docs/book/ch06_nqp.pod Thu Jun 4 02:32:48 2009 (r39377)
@@ -2,74 +2,92 @@
=head1 Grammar Actions
-Protofunction signatures aren't the only way to apply functions to rules
-matched by the parser. In fact, they might be the most primitive because
-they use PIR code to implement the operator logic. Another way has been made
-available, by programming function actions in a language that's almost, but
-Not Quite Perl (NQP).
-
-NQP is a small language that's implemented as a subset of Perl 6 syntax and
-semantics. It was originally developed as a bootstrapping tool to help allow
-the Rakudo Perl 6 compiler to be written in Perl 6 itself. It has since been
-used to implement many other compilers on Parrot as well, and has become a
-permanent member of the Parrot Compiler Toolkit (PCT).
-
-NQP represents almost the smallest subset of the Perl 6 language necessary
-to implement the logic of a parser, although some developers have complained
-enough to get a few extra syntactic features added in above the bare minimum.
-NQP also happens to be a Perl 6 subset that's not entirely dissimilar from
-Perl 5, so Perl 5 programmers should not be too lost when using it.
+The job of the grammar is to match input patterns from the source language.
+These patterns then need to get converted to nodes in the abstract syntax
+tree for manipulation in other stages of the compiler. We've already seen
+one example of a subroutine structure that takes a match and produces a
+tree node: Protofunctions. Protofunction signatures aren't the only way to
+apply functions to rules matched by a parser. They are limited and are
+slightly primitive, but effective for handling operators. There is an
+easier and more powerful way to write subroutines to convert match objects
+into parse tree nodes, using a language that's almost, but Not Quite Perl.
+
+X<NQP>
+X<Not Quite Perl>
+NQP (Not Quite Perl) is a small language which offers a limited subset of
+Perl 6's syntax and semantics. Though it originated as a bootstrapping tool
+for the Rakudo Perl 6 compiler, several other Parrot-based compilers use it
+as well. It has become a permanent member of PCT, and therefore a permanent
+part of the Parrot code base.
+
+NQP represets almost the smallest subset of the Perl 6 language necessary to
+implement parser transformations, plus a few syntactic convenience features
+that developers have requested. NQP's Perl 6 subset shows its Perl 5 roots,
+so existing Perl 5 programmers should find much of it familiar and should be
+able to leverage their existing skills for writing compilers.
+
+In PGE, at the time of a match the grammar we can invoke an action using the
+special <code>{*}</code> symbol. In general, these action methods are
+written in NQP, although it is possible for them to be written in PIR N<In
+fact, this is how the NQP compiler itself is written>. We won't discuss the
+PIR case here because it's uncommon and needlessly difficult. NQP is the
+standard and preferred choice for this.
=head2 NQP Basics
+X<sigils>
+X<scalar>
Like all flavors and versions of Perl, NQP uses special prefix symbols called
-I<sigils> to differentiate different types of variables. The C<$> sigil is used
-for scalars, C<@> is used for arrays, and C<%> is used for hashes N<Perl 6
-aficionados will know that this isn't entirely true, but an in-depth look at
-Perl 6's context awareness is another topic for another book>. A "scalar" is
-really any single value, and can interchangeably be given a string value, or an
-integer value, or an object reference. In NQP we can write things like this:
+I<sigils> to distinguish variable types. The C<$> sigil represents scalars,
+C<@> arrays, and C<%> for hashes. A scalar is any single value which can
+interchangeably contain given a string value, an integer value, or an object
+reference. Simple NQP assignments are:
$scalar := "This is a string"
$x := 123
$pi := 3.1415 # rounding
-Wait a minute, what's that weird C<:=> symbol? Why don't we just use the
-plain old vanilla C<=> sign? The problem is that I<NQP doesn't have it>.
-Remember how we mentioned that NQP was a minimal subset or Perl 6? The
-C<:=> operator is the I<bind> operator, that makes one value an alias
-C<C programmers and the like may call it a "reference"> for another. In
-most cases you can ignore the distinction between the two, but be warned
-that it's not a regular variable assignment.
-
-With hashes and arrays, it might be tempting to do a list assignment like
-we've all grown familiar with in Perl 5 and other dynamic languages:
-
- @small_integers := (1, 2, 3, 4); # WRONG!
- %leading_ladies := ("Trillian" => "Hitchhikers Guide",
- "Leia" => "Starwars"); # WRONG!
-
-Here's another little gotcha, NQP doesn't have list or hash context! If
-it's necessary to initialize a whole list at once, you can write:
-
- @small_integers[0] := 1;
- @small_integers[1] := 2;
- # ... And so on, and so forth ...
+X<bind operator>
+X<operators; binding>
+X<:=>
+The C<:=> I<bind> operator performs reference assignment in NQP. Reference
+assignment makes one variable into an alias for another. This means that
+the two variables are just different names for the same storage location,
+and changes to one will change both. It's important to remember that a bind
+is not a copy!
+
+NQP has hashes and arrays just like other flavors of Perl and various
+dynamic languages. NQP does not have a notion of hash and array context,
+but otherwise it works the way you would expect. Arrays have the C<@> sigil,
+and hashes have the C<%> sigil. Here are some examples:
+
+ @ary[0] := 1;
+ @ary[1] := "foo";
+ ...
+
+ %hsh{'bar'} := 2;
+ %hsh{'baz'} := "parrot";
+ ...
-It's also possible to assign a list in I<scalar context> as follows:
+There is also a nice shorthand way to index hashes, using angle brackets:
+
+ %hsh<bar> := "parrot";
+
+It's also possible to assign a list in I<scalar context>:
$array_but_a_scalar := (1, 2, 3, 4)
-Or, you could write a new function in PIR to create a new array from a
-variadic argument list:
+Or you could write a new function in PIR to create a new array from a variadic
+argument list:
@my_array := create_new_array(1, 2, 3, 4)
-Which calls the PIR function:
+... which calls the PIR function:
=begin PIR
.namespace []
+
.sub 'create_new_array'
.param pmc elems :slurpy
.return(elems)
@@ -77,24 +95,22 @@
=end PIR
-Remember how we said NQP was a bare-bones subset of Perl 6? It really doesn't
-have a lot of features that programmers might expect. In this chapter we will
-talk about some of the features and capabilities that it does have.
-
=head3 Calling Actions From Rules
-When talking about grammar rules, we discussed the funny little C<{*}>
-symbol that calls an action. The action in question is an NQP method
-with the same name as the rule that calls it. NQP rules can be called
-with two different function signatures:
+=for editor
+
+Needs a link to that section.
- method name ($/) { ... }
+=end for
-And with a key:
+As mentioned in the chapter on grammar rules, the funny little C<{*}> symbol
+calls an action. The action in question is an NQP method with the same name as
+the rule that calls it. NQP rules can have two different signatures:
+ method name ($/) { ... }
method name($/, $key) { ... }
-Here's an example that shows how the keys are used:
+Where does the key come from? Consider this grammar:
rule cavepeople {
'Fred' {*} #= Caveman
@@ -102,7 +118,7 @@
| 'Dino' {*} #= Dinosaur
}
-And here is the rule that tells us the result:
+The C<cavepeople> rule demonstrates the result:
method cavepeople($/, $key) {
if $key eq 'Caveman' {
@@ -114,75 +130,86 @@
}
}
-The key is just a string that contains whatever text is on the line after
-the C<#=> symbol. If we don't have a C<#=> we don't use a C<$key> in our
-method. If you attempt to use one without the other, the NQP compiler will
-die with error messages about mismatched argument/parameter numbers.
+The key is a string that contains whatever any text following the C<#=> symbol.
+Without a C<#=> following the rule invocation, there's no C<$key> to use in the
+method. If you attempt to use one without the other, the NQP compiler will die
+with error messages about mismatched argument/parameter numbers.
=head3 The Match Object C<$/>
-The match object C<$/> may have a funny-looking name, but it's a data
-structure that's all business. It's both a hash and an array. Plus,
-since it's a special variable it also gets a special shortcut syntax
-that can be used to save a few keystrokes:
-
- $/{'Match_item'} is the same as $<Match_item>
- $/[0] is the same as $[0]
-
-In the match object, each item in the hash is named after one of the items
-that we matched in the rule. So, if we have a file with input "C<X + 5>"
-and a rule:
+X<match object>
+X<$/>
+The match object C<$/> it's a data structure that's all business: it's both a
+hash and an array. Because it's a special variable used pervasively in PCT, it
+has a special shortcut syntax:
+
+ $/{'Match_item'} is the same as $<Match_item>
+ $/[0] is the same as $[0]
+
+Each key in the match object's hash is the name of a matched rule. Given a
+file containing "C<X + 5>" and a rule:
rule introductions {
<variable> <operator> <number>
}
-Our match object is going to look like this: C<$/ = ("variable" => "x",
-"operator" => "+", "number" => "5")>
+The resulting match object will contain the key/value pairs:
-If we have multiple values with the same name, or items with quantifiers
-C<*> or C<+> on it, those members of the match object may be arrays. So,
-if we have the input "A A A B B", and the following rule:
+ "variable" => "x"
+ "operator" => "+"
+ "number" => "5"
+
+When the match contains multiple values with the same name, or when rules have
+quantifiers such as C<*> or C<+>, the values in the hash may be arrays. Given
+the input "A A A B B" and the rule:
rule letters {
<vowel>* <consonant>*
}
-The match object will look like this (in Perl 5 syntax):
+The match object will contain the pairs:
+
+ "vowel" => ["A", "A", "A"]
+ "consonant" => ["B", "B"]
- $/ = ("vowel" => ["A", "A", "A"], "consonant" => ["B", "B"])
+X<$( ) operator>
-We can get the number of matches in each group by casting it to a scalar
-using the C<$( )> operator:
+Use the C<$( )> operator to count the number of matches in each group (by
+casting it to a scalar):
$($<vowel>) == 3
=head3 Inline PIR
-Now that we know what the match object is, we can talk about the inline
-PIR functionality. In a PGE rule, we can use the C<{{ }}> double curly
-brackets to go into inline-PIR mode. Inside these brackets arbitrary
-PIR code can be executed to affect the operation of the parser. We can
-access the variable C<$/> directly in the grammar without having to
-jump into NQP, and actually examine and affect the values in it.
+=for author
+
+Needs expansion.
+
+=end for
+
+X<{{ }}>
+X<double curly brackets>
+Sometimes NQP isn't quite flexible enough to handle transforms appropriately.
+In a PGE rule, the C<{{ }}> double curly brackets demarcate inline-PIR mode.
+PGE will execute any PIR code in those brackets. You can access C<$/> directly
+in the grammar without having to jump into NQP.
=head3 PAST Nodes
-The job of NQP is to make abstract syntax trees, and the PCT implementation
-of syntax trees is implemented in the PAST class. There are many different
-types of objects in the PAST class, each of which represents a
-particular program construct. These constructs are relatively common and
-simple, but there are powerful levels of configuration that allow complicated
-programming structures to be represented.
+X<PAST>
+X<PAST nodes>
+NQP's job is to make abstract syntax trees. These trees are all objects -- and
+as such, instances of PAST nodes. Each PAST class represents a unique program
+construct. These constructs are common and simple, but combine to represent
+complicated programming structures.
=head3 Making Trees
-Every action has the ability to create a PAST node that represents that
-action N<and additional PAST nodes, that are children of that node>. Calling
-the C<make> command on that node adds it into the growing PAST tree that
-PCT maintains. Once the C<TOP> rule matches successfully and returns,
-PCT takes that tree and starts the process of optimizing it and converting
-it into PIR and PBC code for execution.
+Every action has the ability to create a PAST node that represents that action,
+as well as any children of that node. Calling C<make> on that node adds it into
+the growing PAST tree that PCT maintains. Once the C<TOP> rule matches
+successfully and returns, PCT optimizes and converts that tree into PIR and PBC
+for execution.
=cut
Deleted: branches/pmc_pct/docs/book/ch09_pasm.pod
==============================================================================
--- branches/pmc_pct/docs/book/ch09_pasm.pod Thu Jun 4 02:32:48 2009 (r39376)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,82 +0,0 @@
-=pod
-
-=head1 Parrot Assembly Language
-
-Z<CHP-9>
-
-X<Parrot Assembly Language;;(see PASM)>
-X<PASM (Parrot assembly language)>
-PIR is the intermediate language that's used most often for implementing
-libraries in Parrot, NQP is used for writing grammar actions for
-high-level language compilers, PGE is used for specifying grammar rules,
-and various high-level languages that target Parrot are used for most
-other programming tasks. These options, though many and versatile, are
-not the only ways to interface with Parrot.
-
-Like PIR, Parrot Assembly Language (PASM) is a low-level language native
-to the virtual machine. PASM is a pure assembly language, with none of
-the syntactic sugar that makes PIR friendly for library development.
-
-Its primary purpose is to act as a plain English reprepresention of the
-bytecode format. In regular assemblers, assembly language mnemonics
-share a one-to-one correspondence with the underlying machine code words
-that they represent. A simple assembler (and, for that matter, a simple
-disassembler) could be implemented as a mere lookup table. PASM
-instructions share a one-to-one correspondence to the underlying
-bytecode instructions, and for this reason PASM is used by the Parrot
-disassembler instead of PIR.
-
-PASM is used as a debugging tool more often than it is used to write
-extensive libraries of code. PIR or a higher-level language are
-recommended for most development tasks.
-
-X<.pasm extension>
-PASM files use the F<.pasm> file extension. Parrot also has a C<-a>
-command-line option to tell it to treat a file as PASM code even if it
-doesn't have a F<.pasm> extension.
-
-=head2 Basics
-
-Z<CHP-9-SECT-2>
-
-X<PASM (Parrot assembly language);overview>
-PASM has a simple syntax that will be familiar to people who have experience
-programming other assembly languages. Each statement stands on its own line
-and there is no end-of-line delimiter. Statements begin with a Parrot
-instruction, commonly referred to as an "opcode"N<More accurately, it should
-probably be referred to as a "mnemonic">. The arguments follow, separated by
-commas:
-
- [label] opcode dest, source, source ...
-
-If the opcode returns a result, it is stored in the first argument.
-Sometimes the first register is both a source value and the
-destination of the result, this is the case when we want to modify a
-value in place, without consuming a new Parrot register to hold the
-value. The arguments can be either registers or constants, although the
-destination argument cannot be constant.
-
-=begin PASM
-
- LABEL:
- print "The answer is: "
- print 42
- print "\n"
- end # halt the interpreter
-
-=end PASM
-
-
-
-
-
-
-
-
-
-=cut
-
-# Local variables:
-# c-file-style: "parrot"
-# End:
-# vim: expandtab shiftwidth=4:
Modified: branches/pmc_pct/docs/book/ch10_opcode_reference.pod
==============================================================================
--- branches/pmc_pct/docs/book/ch10_opcode_reference.pod Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/docs/book/ch10_opcode_reference.pod Thu Jun 4 02:32:48 2009 (r39377)
@@ -442,6 +442,17 @@
I<Arguments: IR, P, P>
+=head3 cmp_pmc
+
+X<cmp_pmc opcode (PASM)>
+
+ cmp_pmc R<DEST>, R<VAL1>, R<VAL2>
+
+Like C<cmp>, but places a PMC in R<DEST>. This opcode is useful for avoiding
+semipredicate problems in HLLs where two PMCs are not always comparable.
+
+I<Arguments: P, P, P>
+
=head3 collect
X<collect opcode (PASM)>
@@ -846,7 +857,7 @@
fdopen R<DEST>, R<INT>, R<MODE>
-Get a ParrotIO object for handle R<INT> with open mode R<MODE>.
+Get a FileHandle object for handle R<INT> with open mode R<MODE>.
I<Arguments: P, I, S>
@@ -1124,7 +1135,7 @@
getstdin R<DEST>
getstdout R<DEST>
-Get a ParrotIO object for the given standard handle.
+Get a FileHandle object for the given standard handle.
I<Arguments: P>
@@ -1787,7 +1798,7 @@
peek R<DEST>
peek R<DEST>, R<PIO>
-Read the next byte from the given ParrotIO object or from C<stdin> but
+Read the next byte from the given FileHandle object or from C<stdin> but
don't remove it.
I<Arguments: SR or SR, P>
@@ -2234,12 +2245,14 @@
=head3 setstd*
X<setstderr opcode (PASM)>
+X<setstdin opcode (PASM)>
X<setstdout opcode (PASM)>
setstderr R<DEST>
+ setstdin R<DEST>
setstdout R<DEST>
-Set a ParrotIO object for the given standard handle.
+Set a FileHandle object for the given standard handle.
I<Arguments: P>
@@ -2714,7 +2727,7 @@
tell R<DEST>, R<PIO>
tell R<UPPER32>, R<LOWER32>, R<PIO>
-Return the file position of the given ParrotIO object.
+Return the file position of the given FileHandle object.
I<Arguments: IR, P or IR, I, P>
Modified: branches/pmc_pct/docs/compiler_faq.pod
==============================================================================
--- branches/pmc_pct/docs/compiler_faq.pod Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/docs/compiler_faq.pod Thu Jun 4 02:32:48 2009 (r39377)
@@ -31,22 +31,39 @@
This looks like a function call in many HLLs:
+=begin PIR_FRAGMENT
+
$P0( $P1, $P2, $P3 )
+=end PIR_FRAGMENT
+
where $P0 is the function object, and $P1, $P2, and $P3 are its
parameters. You can also use a function's name in place of the
object, as long as it's in the same namespace.
+=begin PIR_FRAGMENT
+
somefunctionlabel( $P1, $P2, $P3 )
+=end PIR_FRAGMENT
+
You can also get return value(s):
+=begin PIR_FRAGMENT
+
($P1,$P2) = $P0( $P1, $P2, $P3 )
+=end PIR_FRAGMENT
+
If the function name might collide with a Parrot opcode, quote it:
+=begin PIR_FRAGMENT
+
+ .local int i
i = 'new'(42)
+=end PIR_FRAGMENT
+
You can also use the full PCC for these calls. See
L<docs/pdd19_pir.pod/Parameter Passing and Getting Flags> and other
questions below for more information.
@@ -56,14 +73,24 @@
Similar to function calls, just append C<.> and the method name to the object.
You should quote a literal method name to avoid confusion.
+=begin PIR_FRAGMENT
+
+ .local pmc ret_val, some_obj, arg
ret_val = some_obj.'some_meth'(arg)
+=end PIR_FRAGMENT
+
The method name may also be a string variable representing a method name:
+=begin PIR_FRAGMENT
+
.local string m
+ .local pmc curses_obj
m = 'bold'
curses_obj.m()
+=end PIR_FRAGMENT
+
=head2 How do I locate or create a subroutine object?
There are several ways to achieve this, depending on the location of
@@ -71,15 +98,23 @@
If the sub is in the same compilation unit use a Sub constant:
+=begin PIR_FRAGMENT
+
.const 'Sub' foo = 'foo'
- ...
+ # ...
foo()
+=end PIR_FRAGMENT
+
A more dynamic way is:
+=begin PIR_FRAGMENT
+
.local pmc foo
foo = find_name 'foo'
+=end PIR_FRAGMENT
+
This searches for a subroutine 'foo' in the current lexical pad, in
the current namespace, in the global, and in the builtin namespace in
that order. This opcode is generated, if I<foo()> is used, but the
@@ -88,8 +123,13 @@
If the subroutine is in a different namespace, use the
C<get_hll_global> or C<get_root_global> opcodes:
+=begin PIR_FRAGMENT
+
+ .local pmc foo
foo = get_root_global ['Foo'], 'foo'
+=end PIR_FRAGMENT
+
This fetches the sub C<foo> in the C<Foo> namespace.
=head2 How do I create a Closure or Coroutine?
@@ -99,10 +139,14 @@
First use one of the above ways to locate the Sub object.
Then use the op C<newclosure> to capture the environment.
+=begin PIR_FRAGMENT
+
.local pmc coro
coro = find_name 'my_coro'
coro = newclosure coro
+=end PIR_FRAGMENT
+
Any subroutine that contains a C<.yield> directive is automatically
created as a Coroutine PMC:
@@ -143,39 +187,56 @@
If you have a variable amounts of arguments in an array, you can
pass all items of that array with the C<:flat> directive.
+=begin PIR_FRAGMENT
+
+ .local pmc ar, foo
ar = new 'ResizablePMCArray'
push ar, "arg 1\n"
push ar, "arg 2\n"
- ...
+ #...
foo(ar :flat)
- ...
+ #...
+
+=end PIR_FRAGMENT
=head2 How to I retrieve the contents of a variable-length parameter
list being passed to me?
Use a slurpy array:
+=begin PIR
+
.sub mysub
.param pmc argv :slurpy
.local int argc
argc = argv
- ...
+ #...
+ .end
+
+=end PIR
If you have a few fixed parameters too, you can use a slurpy array
to get the rest of the arguments
+=begin PIR
+
.sub mysub
.param pmc arg0
.param pmc arg1
.param pmc varargs :slurpy
.local int num_varargs
num_varargs = varargs
- ...
+ # ...
+ .end
+
+=end PIR
=head2 How do I pass optional arguments?
Use the C<:optional> and C<:opt_flag> pragmas:
+=begin PIR
+
.sub foo
.param pmc arg1 :optional
.param int has_arg1 :opt_flag
@@ -183,7 +244,10 @@
.param int has_arg2 :opt_flag
if has_arg1 goto got_arg1
- ...
+ #...
+ .end
+
+=end PIR
=head2 How do I create nested subroutines?
@@ -197,13 +261,19 @@
Use the C<get_root_global> or C<get_hll_global> op:
+=begin PIR_FRAGMENT
+
get_hll_global $P0, ['name'; 'space'], 'name_of_the_global'
get_hll_global $P1, 'name_of_the_global'
+=end PIR_FRAGMENT
+
=head2 How can I delete a global?
You can retrieve the namespace hash and use the C<delete> opcode.
+=begin PIR
+
.sub main :main
$P0 = new 'Integer'
$P0 = 42
@@ -228,6 +298,7 @@
print "null.\n"
.end
+=end PIR
=head2 How do I use lexical pads to have both a function scope and a
global scope?
@@ -244,16 +315,24 @@
Use C<find_name>:
+=begin PIR_FRAGMENT
+
$P0 = find_name '$x'
find_name $P0, 'foo' # same thing
+=end PIR_FRAGMENT
+
This will find the name C<foo> in the lexical, global, or builtin namespace, in
that order, and store it in C<$P0>.
=head2 How do I fetch a variable from the current lexical pad?
+=begin PIR_FRAGMENT
+
find_lex $P0, 'foo'
+=end PIR_FRAGMENT
+
or much better, if possible just use the variable defined along with
the C<.lex> definition of C<foo>.
@@ -261,8 +340,12 @@
That is still the same:
+=begin PIR_FRAGMENT
+
find_lex $P0, 'foo'
+=end PIR_FRAGMENT
+
This finds a C<foo> variable at any B<outer> depth starting from the top.
If your language looks up variables differently, you have to walk the
@@ -285,53 +368,72 @@
With the C<newclass> op:
+=begin PIR_FRAGMENT
+
newclass $P0, 'Animal'
+=end PIR_FRAGMENT
+
=head2 How do I add instance variables/attributes?
Each class knows which attributes its objects can have. You can add attributes
to a class (not to individual objects) like so:
+=begin PIR_FRAGMENT
+
addattribute $P0, 'legs'
+=end PIR_FRAGMENT
+
=head2 How do I add instance methods to a class?
Methods are declared as functions in the class namespace with the C<:method>
keyword appended to the function declaration:
+=begin PIR
+
.namespace [ 'Animal' ]
.sub run :method
print "slow and steady\n"
.end
+=end PIR
+
=head2 How do I override a vtable on a class?
As with methods, but note the new keyword. The vtable name specified B<must>
be an existing vtable slot.
+=begin PIR
+
.namespace [ 'NearlyPi' ]
.sub get_string :vtable
.return ('three and a half')
.end
+=end PIR
+
Now, given an instance of NearlyPi in $P0
+=begin PIR_FRAGMENT
+
$S0 = $P0
say $S0 # prints 'three and a half'
+=end PIR_FRAGMENT
+
=head2 How do I access attributes?
You can access attributes by a short name:
+=begin PIR_FRAGMENT_INVALID
+
$P0 = getattribute self, 'legs'
assign $P0, 4 # set attribute's value
-or by a fully qualified name: XXX This is long dead.
-
- $P0 = getattribute self, "Animal\0legs"
- assign $P0, 4 # set attribute's value
+=end PIR_FRAGMENT_INVALID
=head2 When should I use properties vs. attributes?
@@ -344,13 +446,21 @@
Either you use the PMC returned by the C<newclass> op if you created
the class, or use the C<get_class> op:
+=begin PIR_FRAGMENT
+
get_class $P0, 'Animal'
+=end PIR_FRAGMENT
+
Then you can use the C<subclass> op to create a new class that is a
subclass of this class:
+=begin PIR_FRAGMENT
+
subclass $P1, $P0, 'Dog'
+=end PIR_FRAGMENT
+
This stores the newly created class PMC in $P1.
=head2 How do I create a class that has more than one parent class?
@@ -365,39 +475,59 @@
If you have a class PMC (created with C<newclass> or by C<subclass>),
you can add more parent classes to it with the C<addparent> op:
+=begin PIR_FRAGMENT
+
get_class $P1, 'Dog'
subclass $P2, $P1, 'SmallDog'
get_class $P3, 'Pet'
addparent $P2, $P3 # make "SmallDog" also a "Pet"
+=end PIR_FRAGMENT
+
=head2 How can I specify the constructor of a class?
Just override the init vtable for that class.
- newclass $P0, 'Dog' # create a class named Dog
- # ...
+=begin PIR
+
+ .sub _ :main
+ newclass $P0, 'Dog' # create a class named Dog
+ .end
.namespace ['Dog']
.sub init :vtable
# ...
+ .end
+
+=end PIR
Or you can specify the constructor method by setting the BUILD
property of the class PMC:
+=begin PIR_FRAGMENT
+
newclass $P0, 'Dog' # create a class named Dog
new $P1, 'String' # create a string
set $P1, 'initialise' # set it to the name of the constructor method
setprop $P0, 'BUILD', $P1 # set the BUILD property
+=end PIR_FRAGMENT
+
=head2 How do I instantiate a class?
You can do so either with the class name:
+=begin PIR_FRAGMENT
+
new $P0, 'Dog'
+=end PIR_FRAGMENT
+
or with the class object:
+=begin PIR_FRAGMENT
+
$P1 = get_class 'Dog' # find the 'Dog' class
unless null $P1 goto have_dog_class
printerr "Oops; can't find the 'Dog' class.\n"
@@ -405,6 +535,8 @@
have_dog_class:
new $P0, $P1 # creates a Dog object and stores it in register $P0
+=end PIR_FRAGMENT
+
The chief difference is that using a string constant will produce the
specific error "Class 'Dog' not found" if that happens to be the case;
the other code has to check explicitly.
@@ -417,14 +549,17 @@
a hash PMC is passed to the constructor that contains the arguments as
key/value pairs:
+=begin PIR_FRAGMENT
+
new $P0, 'Hash'
set $P0['greeting'], 'hello'
set $P0['size'], 1.23
- find_type $I0, 'Alien'
- new $P1, $I0, $P0 # create an Alien object and pass
+ new $P1, 'Alien', $P0 # create an Alien object and pass
# the hash to the constructor
+=end PIR_FRAGMENT
+
=head2 How do I add module/class methods?
XXX
@@ -439,53 +574,74 @@
The easiest way is the perl-like
+=begin PIR_FRAGMENT
+
die 'Eeeek!'
+=end PIR_FRAGMENT
+
You can also explicitly create an exception object and throw it:
+=begin PIR_FRAGMENT
+
$P0 = new 'Exception'
$P0 = 'something happened'
throw $P0
+=end PIR_FRAGMENT
+
=head2 How do I catch an exception in PIR?
Use C<push_eh> to push an exception handler onto the stack. End the set of
instructions that might throw the exception you're interested in with
C<pop_eh>.
+=begin PIR_FRAGMENT
+
push_eh handler
die 'whoops' # or any other code that might throw an exception...
pop_eh
- ... # ok
+ # ok
+
+=end PIR_FRAGMENT
An exception handler is called with one argument, which is the exception object.
The message of the exception can be easily extracted, as follows:
+=begin PIR_FRAGMENT
+
handler: # exception
.get_results ($P0)
print 'Exception caught:'
$S0 = $P0['message']
say $S0
- ...
+
+=end PIR_FRAGMENT
=head2 How do I let exceptions from C<exit> pass through my handler?
Rethrow the exception if it has a severity of C<EXCEPT_EXIT>.
+=begin PIR_FRAGMENT
+
.include 'except_severity.pasm'
- ...
+ # ...
handler:
.get_results ($P0)
$I0 = $P0['severity']
if $I0 == .EXCEPT_EXIT goto handle_exit
say 'Exception caught!'
- ...
+ # ...
handle_exit:
rethrow $P0 # let the next handler deal with it.
+=end PIR_FRAGMENT
+
Exception example:
+=begin PIR_FRAGMENT
+
push_eh handler
$P0 = new 'Exception'
$P0 = 'something happened'
@@ -503,6 +659,8 @@
print "\n"
exit 1
+=end PIR_FRAGMENT
+
=head1 C Extensions
=head2 How do I create PMCs for my compiler?
@@ -578,6 +736,8 @@
Then, after having compiled the file as a shared library, the PIR code looks
like this:
+=begin PIR
+
.sub main :main
.local pmc lib, func
@@ -593,15 +753,21 @@
.end
+=end PIR
+
If you embedded a Parrot in your C file and you want to invoke another function
in that same C file, you should pass a null string to loadlib. Do that as follows:
+=begin PIR_FRAGMENT
+
.local pmc lib
.local string libname
null libname
lib = loadlib libname
+=end PIR_FRAGMENT
+
Under Linux, the .c file must then be linked with the -export-dynamic option.
=head1 Misc
@@ -610,18 +776,26 @@
Create a new C<Env> PMC and access it like a hash.
+=begin PIR_FRAGMENT
+
.local pmc e
e = new 'Env'
$P0 = e['USER'] # lt
+=end PIR_FRAGMENT
+
=head2 How can I access Parrot's configuration?
+=begin PIR_FRAGMENT
+
.include 'iglobals.pasm'
.local pmc interp, cfg
interp = getinterp
cfg = interp[.IGLOBALS_CONFIG_HASH]
$S0 = cfg['VERSION'] # "0.3.0"
+=end PIR_FRAGMENT
+
See F<config_lib.pasm> for all the keys in the config hash - or iterate over
the config hash.
Modified: branches/pmc_pct/docs/dev/byteorder.pod
==============================================================================
--- branches/pmc_pct/docs/dev/byteorder.pod Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/docs/dev/byteorder.pod Thu Jun 4 02:32:48 2009 (r39377)
@@ -13,8 +13,14 @@
for parrot code in
- $P0 = _config()
- $P0["byteorder"]
+=begin PIR_FRAGMENT
+
+ $P0 = getinterp
+ .include 'iglobals.pasm'
+ $P1 = $P0[.IGLOBALS_CONFIG_HASH]
+ $P2 = $P1["byteorder"]
+
+=end PIR_FRAGMENT
or for perl code via
Modified: branches/pmc_pct/docs/dev/c_functions.pod
==============================================================================
--- branches/pmc_pct/docs/dev/c_functions.pod Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/docs/dev/c_functions.pod Thu Jun 4 02:32:48 2009 (r39377)
@@ -97,6 +97,11 @@
Modifiable, or "in-out" parameters are parameters that have both behaviors.
Some fields in it are read, some fields in it are changed.
+Please note that these are only to be used on pointer types. If you're
+not absolutely sure that the argument is a pointer, don't use them.
+(The "va_list" builtin type is sometimes a pointer, sometimes a struct,
+depending on platform and compiler.)
+
Here's a simple example of a function that uses these modifiers:
void MyFunction(PARROT_INTERP, ARGIN(char *Foo),
Modified: branches/pmc_pct/docs/dev/jit_i386.pod
==============================================================================
--- branches/pmc_pct/docs/dev/jit_i386.pod Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/docs/dev/jit_i386.pod Thu Jun 4 02:32:48 2009 (r39377)
@@ -28,21 +28,24 @@
PASM JIT ops Normal CGP ops
- (call cgp_core) (jmp back)
+=begin PASM
+ # (call cgp_core) (jmp back)
- set I0, 10 set_i_ic
- print I0 (call) print_i
- print "\n" print_sc
- bsr inc (call) bsr_ic cpu_ret
- end (jmp) HALT end (ret)
- end (ret)
+ set I0, 10 # set_i_ic
+ print I0 # (call) print_i
+ print "\n" # print_sc
+ bsr inc # (call) bsr_ic cpu_ret
+ end # (jmp) HALT end (ret)
+ # end (ret)
inc:
- inc I0 inc_i
- new P0, 'String' new_p_sc
- set P0, I0 set_p_i
- print P0 (call) print_p
- print "\n" print_sc
- ret (call) ret cpu_ret
+ inc I0 # inc_i
+ new P0, 'String' # new_p_sc
+ set P0, I0 # set_p_i
+ print P0 # (call) print_p
+ print "\n" # print_sc
+ ret # (call) ret cpu_ret
+
+=end PASM
=head2 Startup sequence
Modified: branches/pmc_pct/docs/dev/pmc_obj_design_meeting_notes.pod
==============================================================================
--- branches/pmc_pct/docs/dev/pmc_obj_design_meeting_notes.pod Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/docs/dev/pmc_obj_design_meeting_notes.pod Thu Jun 4 02:32:48 2009 (r39377)
@@ -188,12 +188,18 @@
Dan used to often remark that sequences like the following were "very slow":
+=begin PIR_FRAGMENT_INVALID
+
$P0 = getattribute obj, "foo"
$P1 = getattribute obj, "bar"
$P2 = getattribute obj, "baz"
+=end PIR_FRAGMENT_INVALID
+
Instead, Dan suggested always using classoffset to obtain attributes:
+=begin PIR_FRAGMENT_INVALID
+
$I0 = classoffset obj, "FooClass"
$P0 = getattribute obj, $I0 # which attr is this?
inc $I0
@@ -201,6 +207,8 @@
inc $I0
$P0 = getattribute obj, $I0
+=end PIR_FRAGMENT_INVALID
+
Unfortunately, this doesn't seem to be very practical in many respects. Can
we at least get a declaration from the designers about the appropriate style
to use for object attributes? I much prefer the former to the latter, and if
Modified: branches/pmc_pct/docs/imcc/imcfaq.pod
==============================================================================
--- branches/pmc_pct/docs/imcc/imcfaq.pod Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/docs/imcc/imcfaq.pod Thu Jun 4 02:32:48 2009 (r39377)
@@ -137,11 +137,15 @@
The basic block of execution of an IMC program is the subroutine. Subs can be
simple, with no arguments or returns. Line comments are allowed in IMC using #.
+=begin PIR
+
# Hello world
.sub main :main
print "Hello world.\n"
.end
+=end PIR
+
=head2 Tutorial
For more examples see the PIR tutorial in F<examples/tutorial>.
@@ -207,11 +211,15 @@
Example:
+=begin PIR_FRAGMENT
+
$S1 = "hiya"
$S2 = $S1 . "mel"
$I1 = 1 + 2
$I2 = $I1 * 3
+=end PIR_FRAGMENT
+
This example uses symbolic STRING and INTVAL registers as temporaries. This is
the typical sort of code that compilers generate from the syntax tree.
@@ -225,6 +233,8 @@
Example:
+=begin PIR
+
.sub _main :main
.local int i
.local num n
@@ -232,24 +242,28 @@
n = 5.003
.end
+=end PIR
=head2 How do I declare global or package variables in PIR?
You can't. You can explicitly create global variables at runtime, however,
but it only works for PMC types, like so:
+=begin PIR
+
.sub _main :main
.local pmc i
.local pmc j
i = new 'Integer'
i = 123
# Create the global
- global "i" = i
+ set_global "i", i
# Refer to the global
- j = global "i"
+ j = get_global "i"
.end
+=end PIR
Happy Hacking.
Modified: branches/pmc_pct/docs/imcc/operation.pod
==============================================================================
--- branches/pmc_pct/docs/imcc/operation.pod Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/docs/imcc/operation.pod Thu Jun 4 02:32:48 2009 (r39377)
@@ -68,15 +68,19 @@
This also means that you currently can't use the same global symbol (e.g.
subroutine name) in different namespaces. The following creates invalid code:
+=begin PIR
+
.sub main
- ...
+ #...
.end
.namespace ["main"]
.sub main
- ...
+ #...
.end
+=end PIR
+
Local labels in different I<compilation units> with the same name are
allowed, though assembling the generated PASM doesn't work. However,
running this code inside imcc is ok. This will probably change in the
@@ -94,14 +98,22 @@
of another variable, they might get the same parrot register. For
instance:
+=begin PIR_FRAGMENT
+
$I0 = 10
$I1 = 20
+=end PIR_FRAGMENT
+
will translate to
+=begin PASM
+
set I0, 10
set I0, 20
+=end PASM
+
provided that $I0 is not used after these lines. In this case, the
assignment to $I0 is redundant and will be optimized away if IMCC is
run with optimization level B<-O2>.
@@ -143,33 +155,39 @@
Consider these two code snippets (block numbers are attached):
+=begin PIR
+
.sub main :main
- 0 $I0 = 0 # initialized
- 0 if $I0 goto l1
- 1 $I1 = 1 # init in block 1
- 1 goto l2
- 2 l1:
- 2 $I1 = 2 # init in block 2
- 3 l2:
- 3 print $I0
- 3 print $I1 # all paths leading here do init
- 3 print "\n"
- 3 end
+ $I0 = 0 # 0 initialized
+ if $I0 goto l1 # 0
+ $I1 = 1 # 1 init
+ goto l2 # 1
+ l1: # 2
+ $I1 = 2 # 2 init
+ l2: # 3
+ print $I0 # 3
+ print $I1 # 3 all paths leading here do init
+ print "\n" # 3
.end
+=end PIR
+
and:
+=begin PIR
+
.sub main :main
- 0 $I0 = 0 # initialized
- 0 if $I0 goto l1 # branch to bb 1 or 2
- 1 $I1 = 1 # init only in block 1
- 2 l1:
- 2 print $I0
- 2 print $I1 # no init in code path from block 0
- 2 print "\n"
- 2 end
+ $I0 = 0 # 0 initialized
+ if $I0 goto l1 # 0 branch to bb 1 or 2
+ $I1 = 1 # 1 init only in block 1
+ l1: # 2
+ print $I0 # 2
+ print $I1 # 2 no init in code path from block 0
+ print "\n" # 2
.end
+=end PIR
+
The latter of these emits the warning:
warning:imcc:propagate_need: '$I1' might be used \
@@ -208,18 +226,30 @@
A sequence of code:
+=begin PIR_FRAGMENT
+
+ .local pmc cond
+ # ...
if cond, L1
branch L2
L1:
- ...
+ # ...
L2:
+=end PIR_FRAGMENT
+
will be converted to
+=begin PIR_FRAGMENT
+
+ .local pmc cond
+ # ...
unless cond, L2
- ...
+ # ...
L2:
+=end PIR_FRAGMENT
+
The same is done for other conditional branches B<gt>, B<ge>, B<eq>
and their reverse meanings.
@@ -245,14 +275,22 @@
For a sequence of code
+=begin PIR_FRAGMENT
+
$I0 = 10
$I1 = 20
+=end PIR_FRAGMENT
+
where B<$I0> is not used again, the first assignment will be tossed,
resulting in code like:
+=begin PASM
+
set I0, 20
+=end PASM
+
=head2 Loop optimization
Instructions which are invariant to a loop are pulled out of the loop
Modified: branches/pmc_pct/docs/intro.pod
==============================================================================
--- branches/pmc_pct/docs/intro.pod Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/docs/intro.pod Thu Jun 4 02:32:48 2009 (r39377)
@@ -277,28 +277,62 @@
PIR provides a bit of syntactic sugar that makes it look more high level than
assembly. For example:
+=begin PIR_FRAGMENT
+
+ .local pmc temp, i
temp = i * i
+=end PIR_FRAGMENT
+
Is just another way of writing the more assembly-ish:
+=begin PIR_FRAGMENT
+
+ .local pmc temp, i
mul temp, i, i
+=end PIR_FRAGMENT
+
And:
+=begin PIR_FRAGMENT
+
+ .local pmc i, maxnum
if i <= maxnum goto loop
+ # ...
+ loop:
+
+=end PIR_FRAGMENT
Is the same as:
+=begin PIR_FRAGMENT
+
+ .local pmc i, maxnum
le i, maxnum, loop
+ # ...
+ loop:
+
+=end PIR_FRAGMENT
And:
+=begin PIR_FRAGMENT
+
+ .local pmc temp, total
total += temp
+=end PIR_FRAGMENT
+
Is the same as:
+=begin PIR_FRAGMENT
+
+ .local pmc temp, total
add total, temp
+=end PIR_FRAGMENT
+
As a rule, whenever a Parrot instruction modifies the contents of a register,
that will be the first register when writing the instruction in assembly form.
@@ -361,9 +395,14 @@
Much of what follows has been seen in previous examples, apart from the line
reading:
+=begin PIR_FRAGMENT
+
+ .local pmc result, factorial
result = factorial($I0)
-This single line of PIR actually represents a few lines of PASM. The assembler
+=end PIR_FRAGMENT
+
+The last line of PIR actually represents a few lines of PASM. The assembler
builds a PMC that describes the signature, including which register the
arguments are held in. A similar process happens for providing the registers
that the return values should be placed in. Finally, the C<factorial> sub is
Modified: branches/pmc_pct/docs/parrothist.pod
==============================================================================
--- branches/pmc_pct/docs/parrothist.pod Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/docs/parrothist.pod Thu Jun 4 02:32:48 2009 (r39377)
@@ -89,7 +89,7 @@
kjs 0.9.1 2009-Feb-17 "Final Countdown"
Allison 1.0.0 2009-Mar-17 "Haru Tatsu"
-
Francois 1.1.0 2009-Apr-21 "Half-moon Conure"
+ Infinoid 1.2.0 2009-May-19 "Bird Brain"
=cut
Modified: branches/pmc_pct/docs/pct/past_building_blocks.pod
==============================================================================
--- branches/pmc_pct/docs/pct/past_building_blocks.pod Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/docs/pct/past_building_blocks.pod Thu Jun 4 02:32:48 2009 (r39377)
@@ -38,11 +38,15 @@
Without any attributes, a PAST::Block translates to the following:
+=begin PIR
+
.namespace []
.sub "_block10"
.return ()
.end
+=end PIR
+
=head2 Typical use
A block represents a lexical C<scope>. The most common use for a block
@@ -91,6 +95,8 @@
The block is invoked immediately. When the :blocktype attribute is set to this
value, the generated PIR becomes:
+=begin PIR
+
.namespace []
.sub "anon"
get_global $P11, "_block10"
@@ -103,6 +109,8 @@
.return ()
.end
+=end PIR
+
The sub C<anon> is the I<main> function, which is the entry point of the
whole program. It looks for the sub that we declared, creates a new closure
from that block (more on that later), and invokes that closure.
@@ -118,10 +126,14 @@
translates to:
+=begin PIR
+
.sub "foo"
.return ()
.end
+=end PIR
+
=head2 Symbol tables
As a block defines a new scope, a PAST::Block object has a symbol table,
@@ -197,8 +209,12 @@
results in:
+=begin PIR_FRAGMENT
+
find_lex $P10, "foo"
+=end PIR_FRAGMENT
+
=head2 Typical use
Nodes of type PAST::Var are used to represent variables and their declarations
@@ -226,8 +242,12 @@
When the C<:scope> attribute is set to C<lexical>, then the identifier
specified in the C<:name> attribute is handled as a lexical:
+=begin PIR_FRAGMENT
+
find_lex $P10, "foo"
+=end PIR_FRAGMENT
+
=item 'package'
Defines the variable as a C<package> variable. This is handled by the
@@ -237,9 +257,13 @@
Defines the variable as a parameter (but is stored as a lexical).
+=begin PIR_FRAGMENT
+
.param pmc param_10
.lex "foo", param_10
+=end PIR_FRAGMENT
+
=item 'keyed'
my $idx := PAST::Var.new( :name('foo'), :scope('package') );
@@ -248,10 +272,14 @@
results in:
+=begin PIR_FRAGMENT
+
get_global $P10, "foo" # get index, a package-scoped variable "foo"
get_global $P11, "bar" # get aggregate, a package-scoped variable "bar"
set $P12, $P11[$P10] # get the contents at bar[foo]
+=end PIR_FRAGMENT
+
=item 'attribute'
Defines the variable as an attribute of an object. The first child of
@@ -266,9 +294,13 @@
translates to:
+=begin PIR_FRAGMENT_INVALID
+
get_global $P10, "foo"
get_attribute $P11, $P10, "bar"
+=end PIR_FRAGMENT_INVALID
+
Note: currently, no child nodes are evaluated, so you can only get
attributes on C<self> for now.
@@ -279,8 +311,12 @@
If this flag is set, the variable represented by this PAST::Var node is
declared at this point. This flag is cleared by default.
+=begin PIR_FRAGMENT
+
.lex "foo", $P10
+=end PIR_FRAGMENT
+
=head3 C<:viviself>
When this attribute is set, the variable is initialized with the value
@@ -307,9 +343,13 @@
results in:
+=begin PIR_FRAGMENT
+
new $P10, "Integer"
assign $P10, 42
+=end PIR_FRAGMENT
+
=head2 Typical use
All literal values in your source language can be represented by
@@ -397,8 +437,12 @@
results in:
+=begin PIR_FRAGMENT
+
"foo"()
+=end PIR_FRAGMENT
+
while
my $fun := PAST::Var.new( :name('foo'), :scope('package'));
@@ -406,9 +450,13 @@
generates:
+=begin PIR_FRAGMENT
+
get_global $P10, "foo"
$P10()
+=end PIR_FRAGMENT
+
Children of a :pasttype('call') node are evaluated and passed as arguments.
If the node does not receive a C<:name> attribute, then the first child
is evaluated as the subroutine to be invoked.
@@ -423,10 +471,12 @@
generates:
+=begin PIR_FRAGMENT
+
get_global $P10, "foo"
$P10."bar"()
-
+=end PIR_FRAGMENT
=item C<bind>
@@ -439,14 +489,22 @@
results in:
+=begin PIR_FRAGMENT
+
new $P10, "Integer" # code for evaluating $rhs
assign $P10, 42
set_global "foo", $P10 # code for the :pasttype('bind') op
+=end PIR_FRAGMENT
+
when the scope is set to C<lexical>, the last line becomes:
+=begin PIR_FRAGMENT
+
store_lex "foo", $P10
+=end PIR_FRAGMENT
+
=back
=head3 C<:inline>
@@ -464,9 +522,12 @@
is transformed to:
+=begin PIR_FRAGMENT
+
find_lex $P10, "foo" # generated for $var
$P11 = $P10 # inline '%r = %0'
+=end PIR_FRAGMENT
=head1 TIPS AND TRICKS
Modified: branches/pmc_pct/docs/pct/pct_optable_guide.pod
==============================================================================
--- branches/pmc_pct/docs/pct/pct_optable_guide.pod Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/docs/pct/pct_optable_guide.pod Thu Jun 4 02:32:48 2009 (r39377)
@@ -152,6 +152,8 @@
C<infix:+>. Therefore, you need to write a subroutine for each operator
you define. The subroutine for the C<infix:+> operator could look like this:
+=begin PIR_INVALID
+
.sub 'infix:+'
.param pmc a # left operand
.param pmc b # right operand
@@ -159,6 +161,8 @@
.return ($P0)
.end
+=end PIR_INVALID
+
Whenever an expression such as C<42 + 1> is parsed, this will result in a
call to C<infix:+> with the operands C<42> and C<1>. The C<infix:+> sub
will create a new object, and assign the result of C<42 + 1> to it, after
@@ -241,7 +245,7 @@
course, this fully depends on the specification of your language. Sometimes,
you need a different rule to define subroutine invocation syntax. This is the
case when arguments can be other objects than operands of normal operators
-(which, again, are defined by the c<term:> rule).
+(which, again, are defined by the C<term:> rule).
An example to handle indexing (assuming the index is an operand as any other
operator's operand) is this:
Modified: branches/pmc_pct/docs/pdds/draft/pdd08_keys.pod
==============================================================================
--- branches/pmc_pct/docs/pdds/draft/pdd08_keys.pod Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/docs/pdds/draft/pdd08_keys.pod Thu Jun 4 02:32:48 2009 (r39377)
@@ -212,19 +212,35 @@
constant keys have the signature C<kc>. Integer register and constant keys are
encoded as C<ki> and C<kic> respectively.
- set P1["hi"], 1234
+=begin PIR_FRAGMENT
+
+ set $P1["hi"], 1234
+
+=end PIR_FRAGMENT
finds an op named C<set_p_kc_i>. On the other hand,
- set P1[P1], 1234
+=begin PIR_FRAGMENT
+
+ set $P1[$P1], 1234
+
+=end PIR_FRAGMENT
produces an op named C<set_p_k_i>. Likewise, this:
- set P1[1], 1234
+=begin PIR_FRAGMENT
+
+ set $P1[1], 1234
+
+=end PIR_FRAGMENT
produces an op named C<set_p_kic>, and this:
- set P1[I1], 1234
+=begin PIR_FRAGMENT
+
+ set $P1[$I1], 1234
+
+=end PIR_FRAGMENT
produces an op named C<set_p_ki>.
Modified: branches/pmc_pct/docs/pdds/draft/pdd16_native_call.pod
==============================================================================
--- branches/pmc_pct/docs/pdds/draft/pdd16_native_call.pod Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/docs/pdds/draft/pdd16_native_call.pod Thu Jun 4 02:32:48 2009 (r39377)
@@ -235,12 +235,16 @@
When the callback function is invoked by the external library, the function
itself should look like:
+=begin PIR
+
.sub _my_callback
.param pmc my_data
.param pmc library_data # type depends on signature
# Do something with the passed in data
.end
+=end PIR
+
Parrot itself handles all the nasty bits involved in collecting up the
interpreter pointer, creating the wrapping PMCs, stuffing data various places,
and generally dealing with the bookkeeping.
@@ -250,6 +254,8 @@
This section contains an example to register a callback function and have
it call back into Parrot.
+=begin PIR
+
.sub main
# set up callback
@@ -280,6 +286,8 @@
print "Foo callback\n"
.end
+=end PIR
+
The C code contains the function to be invoked through NCI. In the function
C<sayhello> a function call is done to a Parrot subroutine. The C<sayhello>
function gets a reference to this callback function, so its signature needs
Modified: branches/pmc_pct/docs/pdds/draft/pdd29_compiler_tools.pod
==============================================================================
--- branches/pmc_pct/docs/pdds/draft/pdd29_compiler_tools.pod Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/docs/pdds/draft/pdd29_compiler_tools.pod Thu Jun 4 02:32:48 2009 (r39377)
@@ -31,6 +31,8 @@
Creating a PCT-based compiler can be done as follows:
+=begin PIR
+
.sub 'onload' :anon :load :init
load_bytecode 'PCT.pbc'
$P0 = get_hll_global ['PCT'], 'HLLCompiler'
@@ -46,6 +48,8 @@
$P1 = $P0.'command_line'(args)
.end
+=end PIR
+
{{ this is the most important part; is this enough? }}
The Parrot distribution contains a Perl script to generate a compiler
@@ -303,19 +307,35 @@
=item language
-$P0.'language'('Foo')
+=begin PIR_FRAGMENT
+
+ $P0.'language'('Foo')
+
+=end PIR_FRAGMENT
=item parsegrammar
-$P0.'parsegrammar'('Foo::Grammar')
+=begin PIR_FRAGMENT
+
+ $P0.'parsegrammar'('Foo::Grammar')
+
+=end PIR_FRAGMENT
=item parseactions
-$P0.'parseactions('Foo::Grammar::Actions')
+=begin PIR_FRAGMENT
+
+ $P0.'parseactions'('Foo::Grammar::Actions')
+
+=end PIR_FRAGMENT
=item commandline_prompt
-$P0.'commandline_prompt'($S0)
+=begin PIR_FRAGMENT
+
+ $P0.'commandline_prompt'($S0)
+
+=end PIR_FRAGMENT
sets the string in C<$S0> as a commandline prompt on the compiler in C<$P0>.
The prompt is the text that is shown on the commandline before a command is
@@ -323,7 +343,11 @@
=item commandline_banner
-$P0.'commandline_banner'($S0)
+=begin PIR_FRAGMENT
+
+ $P0.'commandline_banner'($S0)
+
+=end PIR_FRAGMENT
sets the string in C<$S0> as a commandline banner on the compiler in C<$P0>.
The banner is the first text that is shown when the compiler is started in
Modified: branches/pmc_pct/docs/pdds/pdd03_calling_conventions.pod
==============================================================================
--- branches/pmc_pct/docs/pdds/pdd03_calling_conventions.pod Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/docs/pdds/pdd03_calling_conventions.pod Thu Jun 4 02:32:48 2009 (r39377)
@@ -342,6 +342,10 @@
=head3 Function Calls
+=begin PIR_FRAGMENT_INVALID
+
+ .local pmc foo, i, ar, y, p, value, kw, a, b, c, z
+ # ...
foo(1, i) # 2 positional arguments
foo(x, ar :flat, y) # flattening array
foo(p, 'key' => value) # named argument
@@ -351,24 +355,45 @@
# all together now: three positional (one flat) with two named (one flat)
foo(a, b, c :flat, 'x' => 3, 'y' => 4, z :flat :named('z'))
+=end PIR_FRAGMENT_INVALID
+
=head3 Parameters
- .param int i # positional parameter
- .param pmc argv :slurpy # slurpy array
- .param pmc value :named('key') # named parameter
- .param int x :optional # optional parameter
- .param int has_x :opt_flag # flag 0/1 x was passed
- .param pmc kw :slurpy :named # slurpy hash
+=begin PIR
+
+ .sub foo
+ .param int i # positional parameter
+ .param pmc argv :slurpy # slurpy array
+ .param pmc value :named('key') # named parameter
+ .param int x :optional # optional parameter
+ .param int has_x :opt_flag # flag 0/1 x was passed
+ .param pmc kw :slurpy :named # slurpy hash
+ # ...
+ .end
+
+=end PIR
=head3 Return Values
- .return (i, ar: flat, value :named('key') )
+=begin PIR_INVALID
+
+ .sub foo
+ .local pmc i, ar, value
+ .return (i, ar: flat, value :named('key') )
+ .end
+
+=end PIR_INVALID
=head3 Call Results
+=begin PIR_FRAGMENT
+
+ .local pmc x, foo, i, j, ar, value
x = foo() # single result
(i, j :optional, ar :slurpy, value :named('key') ) = foo()
+=end PIR_FRAGMENT
+
=head2 Attachments
None.
Modified: branches/pmc_pct/docs/pdds/pdd13_bytecode.pod
==============================================================================
--- branches/pmc_pct/docs/pdds/pdd13_bytecode.pod Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/docs/pdds/pdd13_bytecode.pod Thu Jun 4 02:32:48 2009 (r39377)
@@ -1094,22 +1094,19 @@
=head4 PackfileAnnotations.pmc (isa PackfileSegment)
-This PMC represents the bytecode annotations table. The key ID to key name and
-key type mappings are stored in a separate PackfileAnnotationKeys PMC. Each
-(offset, key, value) entry is represented by a PackfileAnnotation PMC. The
-following methods are implemented:
+This PMC represents the bytecode annotations table. The following methods are
+implemented:
=over 4
-=item * C<PMC* get_key_list()>
-
-Returns a PackfileAnnotationKeys PMC containing the names and types of the
-annotation keys. Fetch and add to this to create a new annotation key.
-
=item * C<elements> (v-table)
Gets the number of annotations in the table.
+=item * C<get_iter> (v-table)
+
+Get iterator for stored annotations.
+
=item * C<get_pmc_keyed_int> (v-table)
Gets the annotation at the specified index. If there is no annotation at that
@@ -1132,45 +1129,8 @@
=item - The offset of the next entry, if it exists, is greater than this entry
-=item - The key ID references a valid annotation key
-
-=back
-
=back
-=head4 PackfileAnnotationKeys.pmc
-
-This PMC represents the table of keys and the type of value that is stored
-against that key. It implements the following methods:
-
-=over 4
-
-=item * C<elements> (v-table)
-
-Get the number of stored Keys.
-
-=item * C<get_string_keyed_int> (v-table)
-
-Gets the name of the annotation key specified by the index. An exception will
-be thrown if the index is out of range.
-
-=item * C<set_string_keyed_int> (v-table)
-
-Sets the name of the annotation key specified by the index. If there is no key
-with that index currently, a key at that position in the table will be added.
-
-=item * C<get_integer_keyed_int> (v-table)
-
-Gets an integer representing the type of the value that is stored with the key
-at the specified index. An exception will be thrown if the index is out of
-range.
-
-=item * C<set_integer_keyed_int> (v-table)
-
-Sets the type of the value that is stored with the key at the specified index.
-If there is no key with that index currently, a key at that position in the
-table will be added.
-
=back
=head4 PackfileAnnotation.pmc
@@ -1188,23 +1148,37 @@
Sets the offset into the bytecode of the instruction that is being annotated.
-=item * C<int get_key_id()>
+=item * C<int get_name()>
-Gets the ID of the key of the annotation.
+Gets the name of the annotation.
-=item * C<int set_key_id()>
+=item * C<int set_name()>
-Sets the ID of the key of the annotation.
+Sets the name of the annotation.
=item * C<get_integer> (v-table)
-Gets the value of the annotation. This may be, depending upon the type of the
-annotation, an integer annotation or an index into the constants table.
+Gets the integer value of the annotation.
=item * C<set_integer> (v-table)
-Sets the value of the annotation. This may be, depending upon the type of the
-annotation, an integer annotation or an index into the constants table.
+Sets the integer value of the annotation.
+
+=item * C<get_string> (v-table)
+
+Gets the string value of the annotation.
+
+=item * C<set_string> (v-table)
+
+Sets the string value of the annotation.
+
+=item * C<get_number> (v-table)
+
+Gets the number value of the annotation.
+
+=item * C<set_number> (v-table)
+
+Sets the number value of the annotation.
=back
Modified: branches/pmc_pct/docs/pdds/pdd15_objects.pod
==============================================================================
--- branches/pmc_pct/docs/pdds/pdd15_objects.pod Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/docs/pdds/pdd15_objects.pod Thu Jun 4 02:32:48 2009 (r39377)
@@ -418,7 +418,11 @@
=item name
- $P1 = $P2.name( $S3 )
+=begin PIR_FRAGMENT
+
+ $P1 = $P2.'name'( $S3 )
+
+=end PIR_FRAGMENT
The accessor for the name attribute. With no argument, it simply returns
the current value for name. When passed an argument, it sets the name of
@@ -427,13 +431,21 @@
=item namespace
- $P1 = $P2.namespace()
+=begin PIR_FRAGMENT
+
+ $P1 = $P2.'namespace'()
+
+=end PIR_FRAGMENT
Retrieve the namespace object associated with the class.
=item new
- $P1 = $P2.new( 'myattrib' => "Foo" )
+=begin PIR_FRAGMENT
+
+ $P1 = $P2.'new'( 'myattrib' => "Foo" )
+
+=end PIR_FRAGMENT
Create a new instance object from the class object. It takes an optional,
slurpy, named list of attributes and values to initialize the object.
@@ -441,9 +453,13 @@
=item add_attribute
- $P1.add_attribute($S2)
- $P1.add_attribute($S2, $S3)
- $P1.add_attribute($S2, $P3)
+=begin PIR_FRAGMENT
+
+ $P1.'add_attribute'($S2)
+ $P1.'add_attribute'($S2, $S3)
+ $P1.'add_attribute'($S2, $P3)
+
+=end PIR_FRAGMENT
Adds a single attribute to the class. It takes a simple string name and,
optionally, a simple string value or key specifying a type name. (A type
@@ -456,7 +472,11 @@
=item attributes
- $P1 = $P2.attributes()
+=begin PIR_FRAGMENT
+
+ $P1 = $P2.'attributes'()
+
+=end PIR_FRAGMENT
An accessor for the attributes of the class. It returns the a Hash of
all attributes, with a key of the attribute name and a value of a Hash
@@ -464,8 +484,12 @@
=item add_method
- $P1.add_method($S2, $P3)
- $P1.add_method($S2, $P3, 'vtable' => 1)
+=begin PIR_FRAGMENT
+
+ $P1.'add_method'($S2, $P3)
+ $P1.'add_method'($S2, $P3, 'vtable' => 1)
+
+=end PIR_FRAGMENT
Adds a method to the class. It takes a simple string name and a method
PMC. If the method already exists (and isn't a Multi) it will replace
@@ -477,7 +501,11 @@
=item methods
- $P1 = $P2.methods()
+=begin PIR_FRAGMENT
+
+ $P1 = $P2.'methods'()
+
+=end PIR_FRAGMENT
An accessor for the methods of the class. It returns a Hash of all
methods, with a key of the method name and a value of an invokable PMC.
@@ -486,27 +514,43 @@
=item add_parent
- $P1.add_parent($P3)
+=begin PIR_FRAGMENT
+
+ $P1.'add_parent'($P3)
+
+=end PIR_FRAGMENT
Adds a single parent to the class. It takes an instance of the Class PMC.
=item parents
- $P1 = $P2.parents()
+=begin PIR_FRAGMENT
+
+ $P1 = $P2.'parents'()
+
+=end PIR_FRAGMENT
An accessor for the parents of the class. It returns an Array of all
parents. The accessor is read-only.
=item roles
- $P1 = $P2.roles()
+=begin PIR_FRAGMENT
+
+ $P1 = $P2.'roles'()
+
+=end PIR_FRAGMENT
An accessor for the roles of the class. It returns an Array of all
roles. The accessor is read-only.
=item add_role
- $P1.add_role($P2, [named])
+=begin PIR_FRAGMENT_INVALID
+
+ $P1.'add_role'($P2, [named])
+
+=end PIR_FRAGMENT_INVALID
Adds a single role to the class. It takes an instance of the Role PMC as a
required positional parameter, and the optional named parameters C<exclude>
@@ -514,13 +558,21 @@
=item subclass
- $P1 = $P2.subclass($S3)
+=begin PIR_FRAGMENT
+
+ $P1 = $P2.'subclass'($S3)
+
+=end PIR_FRAGMENT
Create a subclass of $P2 with name $S3 and return it in $P1.
=item isa
- $I1 = $P2.isa($S3)
+=begin PIR_FRAGMENT
+
+ $I1 = $P2.'isa'($S3)
+
+=end PIR_FRAGMENT
Returns true if the class name passed in as a parameter is in the inheritance
hierarchy of the class (this is not the same as the inheritance hierarchy of
@@ -528,7 +580,11 @@
=item can
- $I1 = $P2.can($S3)
+=begin PIR_FRAGMENT
+
+ $I1 = $P2.'can'($S3)
+
+=end PIR_FRAGMENT
Returns true if the class object can perform the requested method, false
otherwise.
@@ -537,7 +593,11 @@
=item does
- $I1 = $P2.does($S3)
+=begin PIR_FRAGMENT
+
+ $I1 = $P2.'does'($S3)
+
+=end PIR_FRAGMENT
Returns true if the object in question implements the role, class, type,
or behavior passed in, false otherwise.
@@ -548,8 +608,12 @@
=item inspect
- $P1 = $P2.inspect()
- $P1 = $P2.inspect($S3)
+=begin PIR_FRAGMENT
+
+ $P1 = $P2.'inspect'()
+ $P1 = $P2.'inspect'($S3)
+
+=end PIR_FRAGMENT
Return introspection information for the class.
@@ -798,7 +862,11 @@
=item name
- $P1 = $P2.name( $S3 )
+=begin PIR_FRAGMENT
+
+ $P1 = $P2.'name'( $S3 )
+
+=end PIR_FRAGMENT
The accessor for the name attribute. With no argument, it simply returns
the current value for name. When passed an argument, it sets the name of
@@ -806,13 +874,21 @@
=item namespace
- $P1 = $P2.namespace()
+=begin PIR_FRAGMENT
+
+ $P1 = $P2.'namespace'()
+
+=end PIR_FRAGMENT
Retrieve the namespace object associated with the role.
=item attributes
- $P1 = $P2.attributes()
+=begin PIR_FRAGMENT
+
+ $P1 = $P2.'attributes'()
+
+=end PIR_FRAGMENT
An accessor for the attributes of the role. It returns the Hash of all
attributes, with a key of the attribute name, and a value of the
@@ -820,9 +896,13 @@
=item add_attribute
- $P1.add_attribute($S2)
- $P1.add_attribute($S2, $S3)
- $P1.add_attribute($S2, $P3)
+=begin PIR_FRAGMENT
+
+ $P1.'add_attribute'($S2)
+ $P1.'add_attribute'($S2, $S3)
+ $P1.'add_attribute'($S2, $P3)
+
+=end PIR_FRAGMENT
Adds a single attribute to the role. It takes a simple string name, and
optionally, a simple string value or key specifying a type name. (A type
@@ -831,7 +911,11 @@
=item add_role
- $P1.add_role($P2, [named])
+=begin PIR_FRAGMENT_INVALID
+
+ $P1.'add_role'($P2, [named])
+
+=end PIR_FRAGMENT_INVALID
Adds a single role to the role. It takes an instance of the Role PMC as a
required positional parameter, and the optional named parameters C<exclude>
@@ -839,7 +923,11 @@
=item roles
- $P1 = $P2.roles()
+=begin PIR_FRAGMENT
+
+ $P1 = $P2.'roles'()
+
+=end PIR_FRAGMENT
An accessor for the roles composed into the role. It returns an Array of all
roles as PMC objects. If any roles that were composed into this one were
@@ -849,8 +937,12 @@
=item add_method
- $P1.add_method($S2, $P3)
- $P1.add_method($S2, $P3, 'vtable' => 1)
+=begin PIR_FRAGMENT
+
+ $P1.'add_method'($S2, $P3)
+ $P1.'add_method'($S2, $P3, 'vtable' => 1)
+
+=end PIR_FRAGMENT
Adds a method to the role. It takes a simple string name and a method
PMC. If the method already exists (and isn't a Multi) it will replace
@@ -862,7 +954,11 @@
=item methods
- $P1 = $P2.methods()
+=begin PIR_FRAGMENT
+
+ $P1 = $P2.'methods'()
+
+=end PIR_FRAGMENT
An accessor for the methods of the role. It returns a Hash of all methods,
with a key of the method name and a value of an invokable PMC. The list will
@@ -871,8 +967,12 @@
=item inspect
- $P1 = $P2.inspect()
- $P1 = $P2.inspect($S3)
+=begin PIR_FRAGMENT
+
+ $P1 = $P2.'inspect'()
+ $P1 = $P2.'inspect'($S3)
+
+=end PIR_FRAGMENT
Return introspection information for the role.
@@ -935,9 +1035,13 @@
=item getattribute
+=begin PIR_FRAGMENT
+
$P1 = getattribute $P2, $S3
$P1 = getattribute $P2, $P3, $S4
+=end PIR_FRAGMENT
+
Get the attribute with the fully qualified name $S3 from object $P2 and put it
in $P1. To get an attribute for a parent class that has the same name as an
attribute in the child class, pass an optional class object or namespace key
@@ -948,9 +1052,13 @@
=item setattribute
+=begin PIR_FRAGMENT
+
setattribute $P1, $S2, $P3
setattribute $P1, $P2, $S3, $P4
+=end PIR_FRAGMENT
+
Set the attribute of object $P1 with the attribute name $S2 to $P3. To set an
attribute for a parent class that has the same name as an attribute in the
child class, pass an optional class object or namespace key $P2 for the parent
@@ -960,14 +1068,22 @@
=item callmethod
+=begin PIR_FRAGMENT
+
callmethod $P1, $S1, $P2
+=end PIR_FRAGMENT
+
Call the method specified in the attribute $S1 using $P1 as the invocant and
using the continuation passed in $P2. If you need to create a new continuation
use C<callmethodcc>.
+=begin PIR_FRAGMENT
+
callmethod $P1, $P2, $P3
+=end PIR_FRAGMENT
+
Call the method specified in the Sub object $P2 using $P1 as the invocant and
using the continuation passed in $P3. If you need to create a new continuation
use C<callmethodcc>.
@@ -975,9 +1091,13 @@
=item callmethodcc
+=begin PIR_FRAGMENT
+
callmethodcc $P1, $S1
callmethodcc $P1, $P2
+=end PIR_FRAGMENT
+
Call the method specified in the attribute $S1, or in the Sub object $P2,
using $P1 as the invocant for method lookup and generate a new return
continuation.
@@ -986,9 +1106,13 @@
=item callmethodsupercc [hypothetical, 2.0 or later]
+=begin PIR_FRAGMENT_TODO
+
callmethodsupercc $P1, $S1
callmethodsupercc $P1, $P2
+=end PIR_FRAGMENT_TODO
+
Call the method specified in the attribute $S1, or in the Sub object $P2,
using $P1 as the invocant for method lookup and generate a new return
continuation. This is a variant of C<callmethodcc> that skips over the
@@ -997,9 +1121,13 @@
=item callmethodnextcc [hypothetical, 2.0 or later]
+=begin PIR_FRAGMENT_TODO
+
callmethodnextcc $P1, $S1
callmethodnextcc $P1, $P2
+=end PIR_FRAGMENT_TODO
+
Call the method specified in the attribute $S1, or in the Sub object $P2,
using $P1 as the invocant for method lookup and generate a new return
continuation. A variant of C<callmethodcc> that picks up an existing
@@ -1010,14 +1138,20 @@
=item newclass
+=begin PIR_FRAGMENT_INVALID
+
$P1 = newclass $S2
$P1 = newclass $S2, $P3
+=end PIR_FRAGMENT_INVALID
+
Create a new base class named $S2, and put the PMC for it in $P1. You may
optionally pass a hash of initialization parameters for the class in $P3.
=item subclass
+=begin PIR_FRAGMENT
+
$P1 = subclass $S2
$P1 = subclass $P2
$P1 = subclass $S2, $S3
@@ -1025,15 +1159,21 @@
$P1 = subclass $S2, $P3
$P1 = subclass $P2, $P3
+=end PIR_FRAGMENT
+
Create a new class, named $S3, which has $P2 as its immediate parent. $P2 may
be either another high-level class based on the Class PMC, or it may be a
low-level PMC such as C<Integer> or C<ResizablePMCArray>.
=item get_class
+=begin PIR_FRAGMENT
+
$P1 = get_class $S2
$P1 = get_class $P2
+=end PIR_FRAGMENT
+
Retrieve a class object for the class identified by the string name in
$S2, or by the PMC key or namespace object in $P2.
@@ -1046,9 +1186,13 @@
=item typeof
+=begin PIR_FRAGMENT
+
$S1 = typeof $P2
$P1 = typeof $P2
+=end PIR_FRAGMENT
+
Lookup the type of the instance object in $P2. Return the string name if the
destination is a string register or variable. If the destination is a PMC
register or variable, return the class object for an instance of a high-level
@@ -1056,37 +1200,53 @@
=item new
+=begin PIR_FRAGMENT
+
$P1 = new $S2
$P1 = new $S2, $P3
$P1 = new $P2
$P1 = new $P2, $P3
+=end PIR_FRAGMENT
+
Create a new object from the class named by $S2 or $P2 (a string PMC,
namespace key, or class object), and put the PMC for it in $P1. You may
optionally pass a hash of initialization parameters for the class in $P3.
=item addparent
+=begin PIR_FRAGMENT
+
addparent $P1, $P2
+=end PIR_FRAGMENT
+
Add class $P2 to the end of the list of immediate parents of class $P1.
Adds any attributes of $P2 (and its parent classes) that aren't already
in $P1.
=item removeparent
+=begin PIR_FRAGMENT
+
removeparent $P1, $P2
+=end PIR_FRAGMENT
+
Remove class $P2 from the parent list of $P1. All parent classes of $P2
which aren't parent classes of what remains of $P1's parent list are
removed, as are their attributes.
=item addattribute
+=begin PIR_FRAGMENT_INVALID
+
addattribute $P1, $S2
addattribute $P1, $S2, $S3
addattribute $P1, $S2, $P3
+=end PIR_FRAGMENT_INVALID
+
Add attribute $S2 to class or role $P1. This will add the attribute slot
to all objects of class $P1, classes that inherit from class $P1, or
classes that compose the role $P1, with a default value of C<Null>. It
@@ -1095,8 +1255,12 @@
=item removeattribute
+=begin PIR_FRAGMENT
+
removeattribute $P1, $S2
+=end PIR_FRAGMENT
+
Remove the attribute $S2 from class or role $P1. This will not remove
the attribute from any objects that have already been instantiated, but
it will be absent from all future objects of class $P1, of classes that
@@ -1104,16 +1268,24 @@
=item addrole
+=begin PIR_FRAGMENT
+
addrole $P1, $P2
+=end PIR_FRAGMENT
+
Add role $P2 to the end of the list of roles of class or role $P1. Adds
any methods and attributes of $P2 that aren't already in $P1.
=item inspect
+=begin PIR_FRAGMENT
+
$P1 = inspect $P2
$P1 = inspect $P2, $S3
+=end PIR_FRAGMENT
+
Return introspection information for the PMC. Without the optional string
argument, return a data structure of all information relevant to
introspection. With the optional string argument, return a PMC Hash, Array,
@@ -1130,18 +1302,26 @@
=item :method
+=begin PIR
+
.sub custom_method :method
# ...
.end
+=end PIR
+
Flags the code entity as a method.
=item :vtable
+=begin PIR
+
.sub get_integer :vtable
# ...
.end
+=end PIR
+
Flags the code entity as a vtable override.
=back
@@ -1187,57 +1367,85 @@
To create a new class C<Foo> which has no parent classes:
+=begin PIR_FRAGMENT
+
newclass $P0, "Foo"
+=end PIR_FRAGMENT
+
=head3 Creating a new class with multiple parents
To create a class C<Foo> with the parents C<A> and C<B>, the code would be:
+=begin PIR_FRAGMENT
+
get_class $P0, "A"
get_class $P1, "B"
subclass $P2, $P0, "Foo"
addparent $P2, $P1
+=end PIR_FRAGMENT
+
=head3 Creating a new class with attributes
Adding the attributes C<a> and C<b> to the new class C<Foo>:
+=begin PIR_FRAGMENT
+
$P0 = newclass "Foo"
addattribute $P0, "a"
addattribute $P0, "b"
+=end PIR_FRAGMENT
+
=head3 Instantiating an object
Assuming we want an object of class C<Foo>:
+=begin PIR_FRAGMENT
+
.local pmc FooClass
.local pmc MyObject
FooClass = get_class "Foo"
- MyObject = FooClass.new()
+ MyObject = FooClass.'new'()
+
+=end PIR_FRAGMENT
=head3 Calling a method on an object
Calling the method C<Xyzzy> on an object, assuming the PDD03 calling
conventions are respected:
+=begin PIR_FRAGMENT_INVALID
+
callmethod "Xyzzy"
set S0, "Xyzzy"
callmethod
+=end PIR_FRAGMENT_INVALID
+
Or, if a return continuation needs constructing:
+=begin PIR_FRAGMENT_INVALID
+
callmethodcc "Xyzzy"
set S0, "Xyzzy"
callmethodcc
+=end PIR_FRAGMENT_INVALID
+
=head3 Accessing attributes from within a class
With named access:
+=begin PIR_FRAGMENT
+
getattribute $P1, $P0, "Foo\x0b"
+=end PIR_FRAGMENT
+
=head2 Explanations
To get a new class, you can do a C<newclass>, which creates a new class
Modified: branches/pmc_pct/docs/pdds/pdd17_pmc.pod
==============================================================================
--- branches/pmc_pct/docs/pdds/pdd17_pmc.pod Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/docs/pdds/pdd17_pmc.pod Thu Jun 4 02:32:48 2009 (r39377)
@@ -310,9 +310,13 @@
retrieving the namespace object, and then instantiating from that
namespace.
+=begin PIR_FRAGMENT
+
$P0 = get_root_namespace ['parrot'; 'Integer']
$P1 = new $P0
+=end PIR_FRAGMENT
+
HLLs can choose to provide direct access to Parrot's core PMC types by
aliasing them within the HLL namespace.
@@ -380,14 +384,22 @@
Therefore, subclassing a PMC looks, at a PIR level, like subclassing a high
level class.
+=begin PIR_FRAGMENT
+
$P0 = get_class 'Hash'
$P1 = newclass 'MyClass'
addparent $P1, $P0 # The new class inherits from the Hash PMC
+=end PIR_FRAGMENT
+
Or, more briefly:
+=begin PIR_FRAGMENT
+
$P1 = subclass 'Hash', 'MyClass'
+=end PIR_FRAGMENT
+
PMCs store state in a very different way to PDD15 objects. When a method
inherited from a PMC is called on a PDD15 object, that method needs to
access the attributes of the inherited low-level PMC. Further, if
Modified: branches/pmc_pct/docs/pdds/pdd19_pir.pod
==============================================================================
--- branches/pmc_pct/docs/pdds/pdd19_pir.pod Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/docs/pdds/pdd19_pir.pod Thu Jun 4 02:32:48 2009 (r39377)
@@ -89,17 +89,25 @@
name must be unique within a subroutine, but it can be reused in other
subroutines.
+=begin PIR_FRAGMENT
+
goto label1
- ...
+ # ...
label1:
+=end PIR_FRAGMENT
+
=head4 Registers and Variables
There are two ways of referencing Parrot's registers. The first is
through named local variables declared with C<.local>.
+=begin PIR_FRAGMENT
+
.local pmc foo
+=end PIR_FRAGMENT
+
The type of a named variable can be C<int>, C<num>, C<string> or C<pmc>,
corresponding to the types of registers. No other types are used.
@@ -140,33 +148,48 @@
Assignment of a heredoc:
+=begin PIR_FRAGMENT
+
$S0 = <<"EOS"
...
- EOS
+EOS
+
+=end PIR_FRAGMENT
A heredoc as an argument:
+=begin PIR_FRAGMENT
+
+ .local pmc function, arg
+ # ...
+
function(<<"END_OF_HERE", arg)
...
- END_OF_HERE
+END_OF_HERE
- .return(<<'EOS')
+ .yield(<<'EOS')
...
- EOS
+EOS
- .yield(<<'EOS')
+ .return(<<'EOS')
...
- EOS
+EOS
+
+=end PIR_FRAGMENT
Although currently not possible, a future implementation of the PIR
language will allow you to use multiple heredocs within a single
statement or directive:
+=begin PIR_FRAGMENT_TODO
+
function(<<'INPUT', <<'OUTPUT', 'some test')
...
- INPUT
+INPUT
...
- OUTPUT
+OUTPUT
+
+=end PIR_FRAGMENT_TODO
=item charset:"string constant"
@@ -247,19 +270,31 @@
Declare a lexical variable that is an alias for a PMC register. For example,
given this preamble:
+=begin PIR_FRAGMENT
+
.lex '$a', $P0
$P1 = new 'Integer'
+=end PIR_FRAGMENT
+
These two opcodes have an identical effect:
+=begin PIR_FRAGMENT
+
$P0 = $P1
store_lex '$a', $P1
+=end PIR_FRAGMENT
+
And these two opcodes also have an identical effect:
+=begin PIR_FRAGMENT
+
$P1 = $P0
$P1 = find_lex '$a'
+=end PIR_FRAGMENT
+
=item .const <type> <identifier> = <const>
Define a constant named I<identifier> of type I<type> and assign value
@@ -267,7 +302,7 @@
constant indicating the PMC type. This allows you to create PMC constants
representing subroutines; the value of the constant in that case is the
name of the subroutine. If the referred subroutine has an C<:immediate>
-flag and it returns a value, then that value is stored instead of the
+modifier and it returns a value, then that value is stored instead of the
subroutine.
C<.const> declarations representing subroutines can only be written
@@ -277,16 +312,16 @@
=item .globalconst <type> <identifier> = <const>
As C<.const> above, but the defined constant is globally accessible.
-C<.globalconst> may only be used withing a C<.sub>.
+C<.globalconst> may only be used within a C<.sub>.
=item .sub
- .sub <identifier> [:<flag> ...]
- .sub <quoted string> [:<flag> ...]
+ .sub <identifier> [:<modifier> ...]
+ .sub <quoted string> [:<modifier> ...]
Define a subroutine. All code in a PIR source file must be defined in a
-subroutine. See the section L<Subroutine flags> for available flags.
-Optional flags are a list of I<flag>, separated by spaces.
+subroutine. See the section L<Subroutine modifiers> for available
+modifiers. Optional modifiers are a list separated by spaces.
The name of the sub may be either a bare identifier or a quoted string
constant. Bare identifiers must be valid PIR identifiers (see L<Identifiers>
@@ -312,8 +347,12 @@
You can specify the root namespace by using empty brackets, such as:
+=begin PIR
+
.namespace [ ]
+=end PIR
+
The brackets are not optional, although the key inside them is.
=item .loadlib 'lib_name'
@@ -349,10 +388,14 @@
Makes an entry in the bytecode annotations table. This is used to store high
level language debug information. Examples:
+=begin PIR_FRAGMENT
+
.annotate "file", "aardvark.p6"
.annotate "line", 5
.annotate "column", 24
+=end PIR_FRAGMENT
+
An annotation stays in effect until the next annotation with the same key or
the end of the current compilation unit (that is, if you use a tool such as
C<pbc_merge> to link multiple bytecode files, then annotations will not spill
@@ -362,20 +405,28 @@
line of HLL code is 15 lines of PIR, you only need to emit one annotation
before the first of those 15 lines to set the line number.
+=begin PIR_FRAGMENT
+
.annotate "line", 42
+=end PIR_FRAGMENT
+
The key must always be a quoted string. The value may be an integer, a number
or a quoted string. Note that integer values are stored most compactly; should
you instead of the above annotate directive emit:
+=begin PIR_FRAGMENT
+
.annotate "line", "42"
+=end PIR_FRAGMENT
+
then instead "42" is stored as a string, taking up more space in the resulting
bytecode file.
=back
-=head4 Subroutine flags
+=head4 Subroutine modifiers
=over 4
@@ -384,7 +435,7 @@
Define "main" entry point to start execution. If multiple subroutines are
marked as B<:main>, the B<last> marked subroutine is used. Only the first
file loaded or compiled counts; subs marked as B<:main> are ignored by the
-B<load_bytecode> op. If no B<:main> flag is specified at all, execution
+B<load_bytecode> op. If no B<:main> modifier is specified, execution
starts at the first subroutine in the file.
=item :load
@@ -408,7 +459,7 @@
=item :multi(type1, type2...)
Engage in multiple dispatch with the listed types.
-See L<docs/pdds/pdd27_multi_dispatch.pod> for more information on the
+See F<docs/pdds/pdd27_multi_dispatch.pod> for more information on the
multiple dispatch system.
=item :immediate
@@ -426,10 +477,12 @@
{{ TODO: need a freeze/thaw reference }}.
For instance, after compilation of the sub 'init', that sub is executed
-immediately (hence the :immediate flag). Instead of storing the sub
+immediately (hence the C<:immediate> modifier). Instead of storing the sub
'init' in the constants table, the value returned by 'init' is stored,
which in this example is a FixedIntegerArrray.
+=begin PIR
+
.sub main :main
.const "Sub" initsub = "init"
.end
@@ -443,6 +496,7 @@
.return (array)
.end
+=end PIR
=item :postcomp
@@ -452,12 +506,18 @@
As an example, suppose file C<main.pir> contains:
+=begin PIR
+
.sub main
load_bytecode 'foo.pir'
.end
+=end PIR
+
and the file C<foo.pir> contains:
+=begin PIR
+
.sub foo :immediate
print '42'
.end
@@ -466,6 +526,8 @@
print '43'
.end
+=end PIR
+
Executing C<foo.pir> will run both C<foo> and C<bar>. On the other hand,
executing C<main.pir> will run only C<foo>. If C<foo.pir> is compiled to
bytecode, only C<foo> will be run, and loading C<foo.pbc> will not run either
@@ -473,8 +535,17 @@
=item :method
+=begin PIR
+
.sub bar :method
+ # ...
+ .end
+
.sub bar :method('foo')
+ # ...
+ .end
+
+=end PIR
The marked C<.sub> is a method, added as a method in the class that
corresponds to the current namespace, and not stored in the namespace.
@@ -485,8 +556,17 @@
=item :vtable
+=begin PIR
+
.sub bar :vtable
+ # ...
+ .end
+
.sub bar :vtable('foo')
+ # ...
+ .end
+
+=end PIR
The marked C<.sub> overrides a vtable function, and is not stored in the
namespace. By default, it overrides a vtable function with the same name
@@ -494,8 +574,8 @@
C<:vtable('...')>. For example, to have a C<.sub> named I<ToString> also
be the vtable function C<get_string>), use C<:vtable('get_string')>.
-When the B<:vtable> flag is set, the object PMC can be referred to with
-C<self>, as with the B<:method> flag.
+When the B<:vtable> modifier is set, the object PMC can be referred to with
+C<self>, as with the B<:method> modifier.
=item :outer(subname)
@@ -519,9 +599,9 @@
=item :nsentry( <string_constant> )
Specify the name by which the subroutine is stored in the namespace. The
-default name by which a subroutine is stored in the namespace (if this flag
-is missing), is the subroutine's name as given after the C<.sub> directive.
-This flag allows to override this.
+default name by which a subroutine is stored in the namespace (if this
+modifier is missing), is the subroutine's name as given after the
+C<.sub> directive. This modifier allows to override this.
=back
@@ -564,30 +644,30 @@
Directive to make a call through the Native Calling Interface (NCI).
The specified subroutine must be loaded using the <dlfunc> op that takes
the library, function name and function signature as arguments.
-See L<docs/pdds/pdd16_native_call> for details.
+See F<docs/pdds/pdd16_native_call> for details.
-=item .set_return <var> [:<flag>]*
+=item .set_return <var> [:<modifier>]*
Between C<.begin_return> and C<.end_return>, specify one or
more of the return value(s) of the current subroutine. Available
-flags: C<:flat>, C<:named>.
+modifiers: C<:flat>, C<:named>.
-=item .set_yield <var> [:<flag>]*
+=item .set_yield <var> [:<modifier>]*
Between C<.begin_yield> and C<.end_yield>, specify one or
more of the yield value(s) of the current subroutine. Available
-flags: C<:flat>, C<:named>.
+modifiers: C<:flat>, C<:named>.
-=item .set_arg <var> [:<flag>]*
+=item .set_arg <var> [:<modifier>]*
Between C<.begin_call> and C<.call>, specify an argument to be
-passed. Available flags: C<:flat>, C<:named>.
+passed. Available modifiers: C<:flat>, C<:named>.
-=item .get_result <var> [:<flag>]*
+=item .get_result <var> [:<modifier>]*
Between C<.call> and C<.end_call>, specify where one or more return
-value(s) should be stored. Available flags:
-C<:slurpy>, C<:named>, C<:optional>, and C<:opt_flag>.
+value(s) should be stored. Available modifiers: C<:slurpy>, C<:named>,
+C<:optional>, and C<:opt_flag>.
=back
@@ -595,12 +675,12 @@
=over 4
-=item .param <type> <identifier> [:<flag>]*
+=item .param <type> <identifier> [:<modifier>]*
At the top of a subroutine, declare a local variable, in the manner
of C<.local>, into which parameter(s) of the current subroutine should
-be stored. Available flags:
-C<:slurpy>, C<:named>, C<:optional>, C<:opt_flag> and C<:unique_reg>.
+be stored. Available modifiers: C<:slurpy>, C<:named>, C<:optional>,
+C<:opt_flag> and C<:unique_reg>.
=back
@@ -608,7 +688,7 @@
See L<PDD03|pdds/pdd03_calling_conventions.pod> for a description of
the meaning of the flag bits C<SLURPY>, C<OPTIONAL>, C<OPT_FLAG>,
-and C<FLAT>, which correspond to the calling convention flags
+and C<FLAT>, which correspond to the calling convention modifiers
C<:slurpy>, C<:optional>, C<:opt_flag>, and C<:flat>.
@@ -619,27 +699,37 @@
retrieve the thrown exception, use the C<.get_results> directive. This
directive always takes one argument: an exception object.
+=begin PIR_FRAGMENT
+
push_eh handler
- ...
+ # ...
handler:
.local pmc exception
.get_results (exception)
- ...
+ # ...
+
+=end PIR_FRAGMENT
-This is syntactic sugar for the C<get_results> op, but any flags set on the
-targets will be handled automatically by the PIR compiler.
-The C<.get_results> directive must be the first instruction of the exception
+
+This is syntactic sugar for the C<get_results> op, but any modifiers set
+on the targets will be handled automatically by the PIR compiler. The
+C<.get_results> directive must be the first instruction of the exception
handler; only declarations (.lex, .local) may come first.
To resume execution after handling the exception, just invoke the continuation
stored in the exception.
- ...
+=begin PIR_FRAGMENT
+
+ .local pmc exception, continuation
+ # ...
.get_results(exception)
- ...
+ # ...
continuation = exception['resume']
continuation()
- ...
+ # ...
+
+=end PIR_FRAGMENT
See L<PDD23|pdds/pdd23_exceptions.pod> for accessing the various attributes
of the exception object.
@@ -739,40 +829,48 @@
opcode is placed before the C<=>, and all remaining arguments go after the
opcode name. For example:
+=begin PIR_FRAGMENT
+
new $P0, 'Type'
+=end PIR_FRAGMENT
+
becomes:
+=begin PIR_FRAGMENT
+
$P0 = new 'Type'
+=end PIR_FRAGMENT
+
Note that this only works for opcodes that have have a leading C<OUT>
parameter. [this restriction unimplemented: RT #36283]
-=item ([<var1> [:<flag1> ...], ...]) = <var2>([<arg1> [:<flag2> ...], ...])
+=item ([<var1> [:<modifier1> ...], ...]) = <var2>([<arg1> [:<modifier2> ...], ...])
This is short for:
.begin_call
- .set_arg <arg1> <flag2>
+ .set_arg <arg1> <modifier2>
...
.call <var2>
- .get_result <var1> <flag1>
+ .get_result <var1> <modifier1>
...
.end_call
-=item <var> = <var>([arg [:<flag> ...], ...])
+=item <var> = <var>([arg [:<modifier> ...], ...])
-=item <var>([arg [:<flag> ...], ...])
+=item <var>([arg [:<modifier> ...], ...])
-=item <var>."_method"([arg [:<flag> ...], ...])
+=item <var>."_method"([arg [:<modifier> ...], ...])
-=item <var>.<var>([arg [:<flag> ...], ...])
+=item <var>.<var>([arg [:<modifier> ...], ...])
Function or method call. These notations are shorthand for a longer PCC
function call. I<var> can denote a global subroutine, a local I<identifier> or
a I<reg>.
-=item .return ([<var> [:<flag> ...], ...])
+=item .return ([<var> [:<modifier> ...], ...])
Return from the current subroutine with zero or more values.
@@ -848,8 +946,12 @@
=item * C<.macro_const> <identifier> (<literal>|<reg>)
+=begin PIR
+
.macro_const PI 3.14
+=end PIR
+
The C<.macro_const> directive is a special type of macro; it allows the user
to use a symbolic name for a constant value. Like C<.macro>, the substitution
occurs at compile time. It takes two arguments (not comma separated), the
@@ -868,10 +970,14 @@
A macro expansion is a dot-prefixed identifier. For instance, if a macro
was defined as shown below:
+=begin PIR
+
.macro foo(bar)
- ...
+ # ...
.endm
+=end PIR
+
this macro can be expanded by writing C<.foo(42)>. The body of the macro
will be inserted at the point where the macro expansion is written.
@@ -885,10 +991,14 @@
The parameter list for a macro is specified in parentheses after the name of
the macro. Macro parameters are not typed.
+=begin PIR
+
.macro foo(bar, baz, buz)
- ...
+ # ...
.endm
+=end PIR
+
The number of arguments in the call to a macro must match the number of
parameters in the macro's parameter list. Macros do not perform multidispatch,
so you can't have two macros with the same name but different parameters.
@@ -897,17 +1007,25 @@
If a macro defines no parameter list, parentheses are optional on both the
definition and the call. This means that a macro defined as:
+=begin PIR
+
.macro foo
- ...
+ # ...
.endm
+=end PIR
+
can be expanded by writing either C<.foo> or C<.foo()>. And a macro definition
written as:
+=begin PIR
+
.macro foo()
- ...
+ # ...
.endm
+=end PIR
+
can also be expanded by writing either C<.foo> or C<.foo()>.
B<Note: IMCC requires you to write parentheses if the macro was declared with
@@ -922,6 +1040,8 @@
implementation of PIR ("PIRC") will be able to handle this correctly.
This means that, currently, when using IMCC, the following is not allowed:
+=begin PIR_TODO
+
.macro foo(bar)
...
.endm
@@ -930,13 +1050,16 @@
This is a heredoc
string.
- EOS
+EOS
+=end PIR_TODO
Using braces, { }, allows you to span multiple lines for an argument.
See runtime/parrot/include/hllmacros.pir for examples and possible usage.
A simple example is this:
+=begin PIR
+
.macro foo(a,b)
.a
.b
@@ -951,8 +1074,12 @@
})
.end
+=end PIR
+
This will expand the macro C<foo>, after which the input to the PIR parser is:
+=begin PIR
+
.sub main
print "1"
print "2"
@@ -960,6 +1087,8 @@
print "4"
.end
+=end PIR
+
which will result in the output:
1234
@@ -971,12 +1100,15 @@
Within the macro body, the user can declare a unique label identifier using
the value of a macro parameter, like so:
+=begin PIR
+
.macro foo(a)
- ...
+ # ...
.label $a:
- ...
+ # ...
.endm
+=end PIR
=head4 Unique local variables
@@ -985,41 +1117,53 @@
Within the macro body, the user can declare a local variable with a unique
name.
+=begin PIR
+
.macro foo()
- ...
+ # ...
.macro_local int b
- ...
+ # ...
.b = 42
print .b # prints the value of the unique variable (42)
- ...
+ # ...
.endm
+=end PIR
+
The C<.macro_local> directive declares a local variable with a unique name in
the macro. When the macro C<.foo()> is called, the resulting code that is
given to the parser will read as follows:
+=begin PIR
+
.sub main
.local int local__foo__b__2
- ...
+ # ...
local__foo__b__2 = 42
print local__foo__b__2
.end
+=end PIR
+
The user can also declare a local variable with a unique name set to the
symbolic value of one of the macro parameters.
+=begin PIR
+
.macro foo(b)
- ...
+ # ...
.macro_local int $b
- ...
+ # ...
.$b = 42
print .$b # prints the value of the unique variable (42)
print .b # prints the value of parameter "b", which is
# also the name of the variable.
- ...
+ # ...
.endm
+=end PIR
+
So, the special C<$> character indicates whether the symbol is interpreted as
just the value of the parameter, or that the variable by that name is meant.
Obviously, the value of C<b> should be a string.
@@ -1027,6 +1171,8 @@
The automatic name munging on C<.macro_local> variables allows for using
multiple macros, like so:
+=begin PIR
+
.macro foo(a)
.macro_local int $a
.endm
@@ -1040,13 +1186,19 @@
.bar("x")
.end
+=end PIR
+
This will result in code for the parser as follows:
+=begin PIR
+
.sub main
.local int local__foo__x__2
.local int local__bar__x__4
.end
+=end PIR
+
Each expansion is associated with a unique number; for labels declared with
C<.macro_label> and locals declared with C<.macro_local> expansions, this
means that multiple expansions of a macro will not result in conflicting
@@ -1056,24 +1208,38 @@
Defining a non-unique variable can still be done, using the normal syntax:
+=begin PIR
+
.macro foo(b)
.local int b
.macro_local int $b
.endm
+=end PIR
+
When invoking the macro C<foo> as follows:
+=begin PIR_FRAGMENT
+
.foo("x")
+=end PIR_FRAGMENT
+
there will be two variables: C<b> and C<x>. When the macro is invoked twice:
+=begin PIR
+
.sub main
.foo("x")
.foo("y")
.end
+=end PIR
+
the resulting code that is given to the parser will read as follows:
+=begin PIR
+
.sub main
.local int b
.local int local__foo__x
@@ -1081,6 +1247,8 @@
.local int local__foo__y
.end
+=end PIR
+
Obviously, this will result in an error, as the variable C<b> is defined
twice. If you intend the macro to create unique variables names, use
C<.macro_local> instead of C<.local> to take advantage of the name munging.
@@ -1090,7 +1258,9 @@
=head3 Subroutine Definition
A simple subroutine, marked with C<:main>, indicating it's the entry point
-in the file. Other sub flags include C<:load>, C<:init>, etc.
+in the file. Other sub modifiers include C<:load>, C<:init>, etc.
+
+=begin PIR
.sub sub_label :main
.param int a
@@ -1103,11 +1273,15 @@
.end
+=end PIR
+
=head3 Subroutine Call
Invocation of a subroutine. In this case a continuation subroutine is
created.
+=begin PIR_FRAGMENT
+
.const "Sub" $P0 = "sub_label"
$P1 = new 'Continuation'
set_addr $P1, ret_addr
@@ -1125,8 +1299,12 @@
.get_result r
.end_call
+=end PIR_FRAGMENT
+
=head3 NCI Call
+=begin PIR_FRAGMENT
+
load_lib $P0, "libname"
dlfunc $P1, $P0, "funcname", "signature"
# ...
@@ -1139,28 +1317,39 @@
.get_result r
.end_call
+=end PIR_FRAGMENT
+
=head3 Subroutine Call Syntactic Sugar
Below there are three different ways to invoke the subroutine C<sub_label>.
The first retrieves a single return value, the second retrieves 3 return
values, whereas the last discards any return values.
+=begin PIR_FRAGMENT
+
.local int r0, r1, r2
r0 = sub_label($I0, $I1, $I2)
(r0, r1, r2) = sub_label($I0, $I1, $I2)
sub_label($I0, $I1, $I2)
+=end PIR_FRAGMENT
+
This also works for NCI calls, as the subroutine PMC will be
a NCI sub, and on invocation will do the Right Thing.
Instead of the label a subroutine object can be used too:
+=begin PIR_FRAGMENT
+
get_global $P0, "sub_label"
$P0(args)
+=end PIR_FRAGMENT
=head3 Methods
+=begin PIR
+
.namespace [ "Foo" ]
.sub _sub_label :method [,Subpragma, ...]
@@ -1176,6 +1365,8 @@
...
.end
+=end PIR
+
The variable "self" automatically refers to the invocating object, if the
subroutine declaration contains "method".
@@ -1184,6 +1375,8 @@
The syntax is very similar to subroutine calls. The call is done with
C<.meth_call> which must immediately be preceded by the C<.invocant>:
+=begin PIR_FRAGMENT
+
.local int x, y, z
.local pmc class, obj
newclass class, "Foo"
@@ -1199,6 +1392,9 @@
.end_call
...
+=end PIR_FRAGMENT
+
+
The return continuation is optional. The method can be a string
constant or a string variable.
Modified: branches/pmc_pct/docs/pdds/pdd20_lexical_vars.pod
==============================================================================
--- branches/pmc_pct/docs/pdds/pdd20_lexical_vars.pod Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/docs/pdds/pdd20_lexical_vars.pod Thu Jun 4 02:32:48 2009 (r39377)
@@ -14,9 +14,11 @@
=head2 Synopsis
+=begin PIR
+
.sub 'foo'
.lex "$a", $P0
- $P1 = new Integer
+ $P1 = new 'Integer'
$P1 = 13013
store_lex "$a", $P1
print $P0 # prints 13013
@@ -44,13 +46,14 @@
.sub grault :lex # without ":lex", Tcl subs have no lexicals
$P0 = find_lex "x" # FAILS
- $P0 = new Integer # really TclInteger
- $P0 = 42
+ box $P0, 42 # really TclInteger
store_lex "x", $P0 # creates lexical "x"
$P0 = find_lex "x" # SUCCEEDS
.end
+=end PIR
+
=head2 Description
For Parrot purposes, "lexical variables" are variables stored in a
@@ -125,7 +128,13 @@
This is normally a static attribute of a Sub, but can be changed
dynamically using the C<set_outer> method.
+=begin PIR
+
.sub 'a' :outer('foo')
+ # ...
+ .end
+
+=end PIR
The value of C<:outer> identifies a subroutine by its C<:subid>
flag; subroutine definitions that do not have an explicit C<:subid>
@@ -142,9 +151,11 @@
the current sub. This is normally done either when the outer
sub is entered or just prior to invoking the inner sub.
+=begin PIR
+
.sub 'a'
.lex '$a', $P0
- ...
+ # ...
# capture current lexical environment for inner sub 'foo'
.const 'Sub' $P0 = 'foo'
capture_lex $P0
@@ -152,9 +163,13 @@
'foo'()
.end
+=end PIR
+
The C<newclosure> opcode will clone a subroutine and then perform
C<capture_lex> on the newly cloned sub.
+=begin PIR
+
.sub 'a'
.lex '$a', $P0
@@ -164,6 +179,8 @@
$P1()
.end
+=end PIR
+
=head4 Lexical Lookup Algorithm
When a subroutine is invoked, its newly created call frame
@@ -256,19 +273,31 @@
compiler calls this method in response to a C<.lex STRING, PREG> directive.
For example, given this preamble:
+=begin PIR_FRAGMENT
+
.lex "$a", $P0
- $P1 = new Integer
+ $P1 = new 'Integer'
+
+=end PIR_FRAGMENT
These two opcodes have an identical effect:
+=begin PIR_FRAGMENT
+
$P0 = $P1
store_lex "$a", $P1
+=end PIR_FRAGMENT
+
And these two opcodes also have an identical effect:
+=begin PIR_FRAGMENT
+
$P1 = $P0
$P1 = find_lex "$a"
+=end PIR_FRAGMENT
+
=back
=head4 LexPad
@@ -314,36 +343,56 @@
For example, to get the immediate caller's LexPad, use:
+=begin PIR_FRAGMENT
+
$P0 = getinterp
$P1 = $P0["lexpad"; 1]
+=end PIR_FRAGMENT
+
To access a sub's C<:outer> subroutine, use the C<get_outer()> method:
+=begin PIR_FRAGMENT
+
.include "interpinfo.pasm"
interpinfo $P1, .INTERPINFO_CURRENT_SUB
$P2 = $P1."get_outer"()
+=end PIR_FRAGMENT
+
Here, C<$P1> contains information on the current subroutine. C<$P2> will
contain C<$P1>'s outer subroutine.
To get C<$P2>'s outer subroutine (if any), the same method can be used on
C<$P2> itself:
+=begin PIR_FRAGMENT
+
$P3 = $P2."get_outer"()
+=end PIR_FRAGMENT
Using the C<interpinfo> instruction is one way to do it. Another way is this:
+=begin PIR_FRAGMENT
+
$P0 = getinterp
$P1 = $P0["outer"; "sub"]
$P2 = $P0["outer"; "sub"; 2] # get the outer sub of the current's outer
# subroutine
+=end PIR_FRAGMENT
+
+
It is also possible to get the C<:outer> sub's LexPad, as above:
+=begin PIR_FRAGMENT
+
$P0 = getinterp
$P1 = $P0["outer"; "lexpad"]
+=end PIR_FRAGMENT
+
See [1] for an example.
It's likely that this interface will continue to be available even once call
Modified: branches/pmc_pct/docs/pdds/pdd21_namespaces.pod
==============================================================================
--- branches/pmc_pct/docs/pdds/pdd21_namespaces.pod Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/docs/pdds/pdd21_namespaces.pod Thu Jun 4 02:32:48 2009 (r39377)
@@ -139,7 +139,11 @@
=item C<get_name>
- $P1 = $P2.get_name()
+=begin PIR_FRAGMENT
+
+ $P1 = $P2.'get_name'()
+
+=end PIR_FRAGMENT
Gets the name of the namespace $P2 as an array of strings. For example,
if $P2 is a Perl 5 namespace "Some::Module", within the Perl 5 HLL, then
@@ -172,19 +176,31 @@
=item C<add_namespace>
- $P1.add_namespace($S2, $P3)
+=begin PIR_FRAGMENT
+
+ $P1.'add_namespace'($S2, $P3)
+
+=end PIR_FRAGMENT
Store $P3 as a namespace under the namespace $P1, with the name of $S2.
=item C<add_sub>
- $P1.add_sub($S2, $P3)
+=begin PIR_FRAGMENT
+
+ $P1.'add_sub'($S2, $P3)
+
+=end PIR_FRAGMENT
Store $P3 as a subroutine with the name of $S2 in the namespace $P1.
=item C<add_var>
- $P1.add_var($S2, $P3)
+=begin PIR_FRAGMENT
+
+ $P1.'add_var'($S2, $P3)
+
+=end PIR_FRAGMENT
Store $P3 as a variable with the name of $S2 in the namespace $P1.
@@ -195,17 +211,25 @@
=item C<del_namespace>, C<del_sub>, C<del_var>
- $P1.del_namespace($S2)
- $P1.del_sub($S2)
- $P1.del_var($S2)
+=begin PIR_FRAGMENT
+
+ $P1.'del_namespace'($S2)
+ $P1.'del_sub'($S2)
+ $P1.'del_var'($S2)
+
+=end PIR_FRAGMENT
Delete the sub, namespace, or variable named $S2 from the namespace $P1.
=item C<find_namespace>, C<find_sub>, C<find_var>
- $P1 = $P2.find_namespace($S3)
- $P1 = $P2.find_sub($S3)
- $P1 = $P2.find_var($S3)
+=begin PIR_FRAGMENT
+
+ $P1 = $P2.'find_namespace'($S3)
+ $P1 = $P2.'find_sub'($S3)
+ $P1 = $P2.'find_var'($S3)
+
+=end PIR_FRAGMENT
Find the sub, namespace, or variable named $S3 in the namespace $P2.
@@ -217,7 +241,11 @@
=item C<export_to>
- $P1.export_to($P2, $P3)
+=begin PIR_FRAGMENT
+
+ $P1.'export_to'($P2, $P3)
+
+=end PIR_FRAGMENT
Export items from the namespace $P1 into the namespace $P2. The items to
export are named in $P3, which may be an array of strings, a hash, or null.
@@ -266,7 +294,11 @@
=item C<parse_name>
- $P1 = $P2.parse_name($S3)
+=begin PIR_FRAGMENT
+
+ $P1 = $P2.'parse_name'($S3)
+
+=end PIR_FRAGMENT
Parse the name in $S3 using the rules specific to the compiler $P2, and
return an array of individual name elements.
@@ -278,7 +310,11 @@
=item C<get_namespace>
- $P1 = $P2.get_namespace($P3)
+=begin PIR_FRAGMENT
+
+ $P1 = $P2.'get_namespace'($P3)
+
+=end PIR_FRAGMENT
Ask the compiler $P2 to find its namespace which is named by the
elements of the array in $P3. If $P3 is a null PMC or an empty array,
@@ -298,7 +334,11 @@
=item C<load_library>
- $P1.load_library($P2, $P3)
+=begin PIR_FRAGMENT
+
+ $P1.'load_library'($P2, $P3)
+
+=end PIR_FRAGMENT
Ask this compiler to load a library/module named by the elements of the array
in $P2, with optional control information in $P3.
@@ -325,7 +365,11 @@
=item C<get_namespace>
- $P1 = $P2.get_namespace()
+=begin PIR_FRAGMENT
+
+ $P1 = $P2.'get_namespace'()
+
+=end PIR_FRAGMENT
Retrieve the namespace $P1 where the subroutine $P2 was defined. (As
opposed to the namespace(s) that it may have been exported to.)
@@ -344,40 +388,60 @@
=item C<set_namespace>
- set_namespace [key], $P1
- set_hll_namespace [key], $P1
- set_root_namespace [key], $P1
+=begin PIR_FRAGMENT_INVALID
+
+ set_namespace ['key'], $P1
+ set_hll_namespace ['key'], $P1
+ set_root_namespace ['key'], $P1
+
+=end PIR_FRAGMENT_INVALID
Add the namespace PMC $P1 under the name denoted by a multidimensional
hash key.
+=begin PIR_FRAGMENT_INVALID
+
set_namespace $P1, $P2
set_hll_namespace $P1, $P2
set_root_namespace $P1, $P2
+=end PIR_FRAGMENT_INVALID
+
Add the namespace PMC $P2 under the name denoted by an array of name
strings $P1.
=item C<get_namespace>
+=begin PIR_FRAGMENT
+
$P1 = get_namespace
$P1 = get_hll_namespace
$P1 = get_root_namespace
+=end PIR_FRAGMENT
+
Retrieve the current namespace, the HLL root namespace, or the true
root namespace and store it in $P1.
+=begin PIR_FRAGMENT_INVALID
+
$P1 = get_namespace [key]
$P1 = get_hll_namespace [key]
$P1 = get_root_namespace [key]
+=end PIR_FRAGMENT_INVALID
+
Retrieve the namespace denoted by a multidimensional hash key and
store it in C<$P1>.
+=begin PIR_FRAGMENT
+
$P1 = get_namespace $P2
$P1 = get_hll_namespace $P2
$P1 = get_root_namespace $P2
+=end PIR_FRAGMENT
+
Retrieve the namespace denoted by the array of names $P2 and store it in
C<$P1>.
@@ -385,75 +449,117 @@
the name was known at compile time, you could retrieve the namespace
with a key:
+=begin PIR_FRAGMENT
+
$P0 = get_hll_namespace ["Foo"; "Bar"]
+=end PIR_FRAGMENT
+
If the name was not known at compile time, you would retrieve the
namespace with an array instead:
+=begin PIR_FRAGMENT
+
$P1 = split "::", "Foo::Bar"
$P0 = get_hll_namespace $P1
+=end PIR_FRAGMENT
+
=item C<make_namespace>
+=begin PIR_FRAGMENT_INVALID
+
$P1 = make_namespace [key]
$P1 = make_hll_namespace [key]
$P1 = make_root_namespace [key]
+=end PIR_FRAGMENT_INVALID
+
Create and retrieve the namespace denoted by a multidimensional hash key
and store it in C<$P1>. If the namespace already exists, only retrieve
it.
+=begin PIR_FRAGMENT_INVALID
+
$P1 = make_namespace $P2
$P1 = make_hll_namespace $P2
$P1 = make_root_namespace $P2
+=end PIR_FRAGMENT_INVALID
+
Create and retrieve the namespace denoted by the array of names $P2 and
store it in C<$P1>. If the namespace already exists, only retrieve it.
=item C<get_global>
+=begin PIR_FRAGMENT
+
$P1 = get_global $S2
$P1 = get_hll_global $S2
$P1 = get_root_global $S2
+=end PIR_FRAGMENT
+
Retrieve the symbol named $S2 in the current namespace, HLL root
namespace, or true root namespace.
+=begin PIR_FRAGMENT
+
+ .local pmc key
$P1 = get_global [key], $S2
$P1 = get_hll_global [key], $S2
$P1 = get_root_global [key], $S2
+=end PIR_FRAGMENT
+
Retrieve the symbol named $S2 by a multidimensional hash key relative
to the current namespace, HLL root namespace, or true root namespace.
+=begin PIR_FRAGMENT
+
$P1 = get_global $P2, $S3
$P1 = get_hll_global $P2, $S3
$P1 = get_root_global $P2, $S3
+=end PIR_FRAGMENT
+
Retrieve the symbol named $S3 by the array of names $P2 relative to the
current namespace, HLL root namespace, or true root namespace.
=item C<set_global>
+=begin PIR_FRAGMENT
+
set_global $S1, $P2
set_hll_global $S1, $P2
set_root_global $S1, $P2
+=end PIR_FRAGMENT
+
Store $P2 as the symbol named $S1 in the current namespace, HLL root
namespace, or true root namespace.
+=begin PIR_FRAGMENT
+
+ .local pmc key
set_global [key], $S1, $P2
set_hll_global [key], $S1, $P2
set_root_global [key], $S1, $P2
+=end PIR_FRAGMENT
+
Store $P2 as the symbol named $S1 by a multidimensional hash key,
relative to the current namespace, HLL root namespace, or true root
namespace. If the given namespace does not exist it is created.
+=begin PIR_FRAGMENT
+
set_global $P1, $S2, $P3
set_hll_global $P1, $S2, $P3
set_root_global $P1, $S2, $P3
+=end PIR_FRAGMENT
+
Store $P3 as the symbol named $S2 by the array of names $P1, relative to
the current namespace, HLL root namespace, or true root namespace. If
the given namespace does not exist it is created.
@@ -479,6 +585,8 @@
should map roughly to this PIR:
+=begin PIR
+
.HLL "Perl5"
.loadlib "perl5_group"
.namespace [ "Foo" ]
@@ -488,6 +596,8 @@
set_global "$x", $P0
.end
+=end PIR
+
In this case, the C<main> sub would be tied to Perl 5 by the C<.HLL>
directive, so a Perl 5 namespace would be created.
@@ -503,6 +613,8 @@
these cases, Parrot should create the namespace based on the HLL of the PIR
subroutine that calls the store function.
+=begin PIR
+
.HLL "Perl5"
.loadlib "perl5_group"
.sub main :main
@@ -511,7 +623,7 @@
$P0 = "x"
set_global "$a", $P0
# ${"Foo::$a"} = 5;
- $P1 = new PerlString
+ $P1 = new 'PerlString'
$P1 = "Foo::"
$P1 .= $P0
$S0 = $P1
@@ -523,6 +635,8 @@
set_global $P2, $S0, $P3
.end
+=end PIR
+
In this case, C<set_global> should see that it was called from "main",
which is in a Perl 5 namespace, so it will create the "Foo" namespace as
a Perl 5 namespace.
@@ -572,8 +686,10 @@
PIR:
+=begin PIR
+
.sub main :main
- $P0 = get_name "&foo"
+ $P0 = get_global "&foo"
$P1 = get_namespace ["Foo"]
# A smart perl6 compiler would emit this,
@@ -581,14 +697,16 @@
$P1["&bar"] = $P0
# But a naive perl6 compiler would emit this:
- $P1.add_sub("bar", $P0)
+ $P1.'add_sub'("bar", $P0)
.end
.sub foo
- ...
+ #...
.end
+=end PIR
+
=head4 Cross-language Exportation
Perl 5:
@@ -599,6 +717,8 @@
PIR (without error checking):
+=begin PIR
+
.sub main :main
.local pmc tcl
.local pmc ns
@@ -608,13 +728,15 @@
ns[0] = "Some"
ns[1] = "Module"
null $P0
- tcl.load_library(ns, $P0)
- $P0 = tcl.get_namespace(ns)
+ tcl.'load_library'(ns, $P0)
+ $P0 = tcl.'get_namespace'(ns)
$P1 = get_namespace
- $P0.export_to($P1, 'w*')
+ $P0.'export_to'($P1, 'w*')
"write"("this is a tcl command")
.end
+=end PIR
+
=head2 Attachments
None.
Modified: branches/pmc_pct/docs/pdds/pdd22_io.pod
==============================================================================
--- branches/pmc_pct/docs/pdds/pdd22_io.pod Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/docs/pdds/pdd22_io.pod Thu Jun 4 02:32:48 2009 (r39377)
@@ -32,18 +32,17 @@
=head2 Implementation
-=head3 Composition
+=head3 Platform Implementation
-Currently, the Parrot I/O subsystem uses a per-interpreter stack to
-provide a layer-based approach to I/O. Each layer implements a subset of
-the C<ParrotIOLayerAPI> vtable. To find an I/O function, the layer stack
-is searched downwards until a non-NULL function pointer is found for
-that particular slot. This implementation will be replaced with a
-composition model. Rather than living in a stack, the module fragments
-that make up the ParrotIO class will be composed and any conflicts
-resolved when the class is loaded. This strategy eliminates the need to
-search a stack on each I/O call, while still allowing a "layered"
-combination of functionality for different platforms.
+Parrot uses a series of macros and conditional compilation to generate
+code to handle IO on various platforms. There is a "portable" version of
+the IO system that is used for most systems that use a common POSIX API
+for IO, and there are platform-specific files that can be used for systems
+that do not subscribe, or don't subscribe faithfully, to POSIX.
+
+A series of macros and conditional compilation are used to determine which
+files get added to the build, and which functions are called to implement
+each operation.
=head3 Concurrency Model for Asynchronous I/O
@@ -59,10 +58,6 @@
they don't need opcodes. They can access the functionality via methods
on ParrotIO objects.
-The asynchronous I/O implementation will use the composition model to
-allow some platforms to take advantage of their built-in asynchronous
-operations, layered behind Parrot's asynchronous I/O interface.
-
Asynchronous operations use a lightweight concurrency model. At the user
level, Parrot follows the callback function model of asynchronous I/O.
At the interpreter level, each asynchronous operation registers a task
@@ -84,38 +79,33 @@
capture no state other than the arguments passed to the I/O call, and
share no variables with the calling code other than the status object.
-[See L<http://en.wikipedia.org/wiki/Asynchronous_I/O> for a relatively
-comprehensive list of asynchronous I/O implementation options.]
-
=head3 FileHandle PMC API
Methods
-[Over and over again throughout this section, I keep wanting an API that
-isn't possible with current low-level PMCs. This could mean that
-low-level PMCs need a good bit of work to gain the same argument passing
-capabilities as higher-level Parrot objects (which is true, long-term).
-It could mean that Parrot I/O objects would be better off defined in a
-higher-level syntax, with embedded C (via NCI, or a lighter-weight
-embedding mechanism) for those pieces that really are direct C access.
-Or, it could mean that I'll come back and rip this interface down to a
-bare minimum.]
-
=over 4
=item C<new>
+=begin PIR_FRAGMENT
+
$P0 = new [ 'FileHandle' ]
+=end PIR_FRAGMENT
+
Creates a new I/O stream object. [Note that this is usually performed
via the C<open> opcode.]
=item C<open>
+=begin PIR_FRAGMENT
+
$P0 = $P1.'open'()
$P0 = $P1.'open'($S2)
$P0 = $P1.'open'($S2, $S3)
+=end PIR_FRAGMENT
+
Opens a stream on an existing I/O stream object, and returns a status
object. With no arguments, it can be used to reopen a previously opened
I/O stream. $S2 is a file path and $S3 is an optional mode for the
@@ -133,9 +123,13 @@
=item C<close>
+=begin PIR_FRAGMENT
+
$P0 = $P1.'close'()
$P0 = $P1.'close'($P2)
+=end PIR_FRAGMENT
+
Closes an I/O stream, but leaves destruction of the I/O object to the
GC. The C<close> method returns a PMC status object.
@@ -147,6 +141,8 @@
=item C<print>
+=begin PIR_FRAGMENT
+
$P0 = $P1.'print'($I2)
$P0 = $P1.'print'($N2)
$P0 = $P1.'print'($S2)
@@ -156,6 +152,8 @@
$P0 = $P1.'print'($S2, $P3)
$P0 = $P1.'print'($P2, $P3)
+=end PIR_FRAGMENT
+
Writes an integer, float, string, or PMC value to an I/O stream object.
Returns a PMC status object.
@@ -165,9 +163,13 @@
=item C<read>
+=begin PIR_FRAGMENT
+
$S0 = $P1.'read'($I2)
$P0 = $P1.'read'($I2, $P3)
+=end PIR_FRAGMENT
+
Retrieves a specified number of bytes ($I2) from a stream $P1 into a
string $S0. By default it reads in bytes, but the FileHandle object can
be configured to read in code points instead, by setting the character
@@ -186,9 +188,13 @@
=item C<readline>
+=begin PIR_FRAGMENT
+
$S0 = $P1.'readline'()
$P0 = $P1.'readline'($P2)
+=end PIR_FRAGMENT
+
Retrieves a single line from a stream $P1 into a string $S1. Calling
C<readline> flags the stream as operating in line-buffer mode (see the
C<buffer_type> method below). The C<readline> operation respects the
@@ -202,12 +208,16 @@
=item C<readall>
+=begin PIR_FRAGMENT
+
$S0 = $P1.'readall'()
$P0 = $P1.'readall'($P2)
$S0 = $P1.'readall'($S2)
$P0 = $P1.'readall'($S2, $P3)
+=end PIR_FRAGMENT
+
Retrieves the entire contents from a stream $P1 into a string $S0. On a
previously opened stream, C<readall> will read the entire contents of
the file, and return them as a string. It will respect the read mode of
@@ -224,18 +234,26 @@
=item C<record_separator>
+=begin PIR_FRAGMENT
+
$S0 = $P1.'record_separator'()
$P0.'record_separator'($S1)
+=end PIR_FRAGMENT
+
Accessor (get and set) for the I/O stream's record separator attribute.
The default value is a newline (CR, LF, CRLF, etc. depending on the
platform).
=item C<buffer_type>
+=begin PIR_FRAGMENT
+
$S0 = $P1.'buffer_type'()
$P0.'buffer_type'($S1)
+=end PIR_FRAGMENT
+
Accessor (get and set) for the I/O stream's buffer type attribute. The
attribute is set or returned as a string value of 'unbuffered' (bytes sent as
soon as possible), 'line-buffered' (bytes sent when record separator is
@@ -243,9 +261,13 @@
=item C<buffer_size>
+=begin PIR_FRAGMENT
+
$I0 = $P1.'buffer_size'()
$P0.'buffer_size'($I1)
+=end PIR_FRAGMENT
+
Accessor (get and set) for the I/O stream's buffer size attribute. The
size is specified in bytes (positive integer value), though the buffer
may hold a varying number of characters when dealing with an encoding of
@@ -265,24 +287,36 @@
=item C<mode>
+=begin PIR_FRAGMENT
+
$S0 = $P1.'mode'()
+=end PIR_FRAGMENT
+
Accessor (get only) for the I/O stream's read mode. This returns the mode
string used to open the I/O stream.
=item C<encoding>
+=begin PIR_FRAGMENT
+
$S0 = $P1.'encoding'()
$P0.'encoding'($S1)
+=end PIR_FRAGMENT
+
Accessor (get and set) for the I/O stream's encoding attribute. Currently,
the only valid value to set is 'utf8' which turns on UTF-8 reading/writing
mode for the stream. The default behavior is fixed-width 8-bit characters.
=item C<get_fd> [RT #48312]
+=begin PIR_FRAGMENT
+
$I0 = $P1.'get_fd'()
+=end PIR_FRAGMENT
+
For stream objects that are simple wrappers around a Unix filehandle,
C<get_fd> retrieves the Unix integer file descriptor of the object.
This method will simply return -1 on stream objects that aren't Unix
@@ -298,8 +332,12 @@
=item C<get_integer> (vtable)
+=begin PIR_FRAGMENT
+
$I0 = $P1
+=end PIR_FRAGMENT
+
Returns an integer status for the status object, 1 for successful
completion, -1 for an error, and 0 while still running. [Discuss: This
is largely to preserve current expectations of -1 for an error. If we
@@ -307,23 +345,37 @@
=item C<get_bool> (vtable)
- if $P0 goto ...
+=begin PIR_FRAGMENT
+
+ if $P0 goto L1
+ # ...
+ L1:
+
+=end PIR_FRAGMENT
Returns a boolean status for the status object, C<true> for successful
completion or while still running, C<false> for an error.
=item C<return>
+=begin PIR_FRAGMENT
+
$P0 = $P1.'return'()
+=end PIR_FRAGMENT
+
Retrieves the return value of the asynchronous operation from the status
object. Returns a NULL PMC while still running, or if the operation had
no return value.
=item C<error>
+=begin PIR_FRAGMENT
+
$P0 = $P1.'error'()
+=end PIR_FRAGMENT
+
Retrieves the error object from the status object, if the execution of
the asynchronous operation terminated with an error. The error object is
derived from Exception, and can be thrown from the callback. If there
@@ -332,8 +384,12 @@
=item C<throw>
+=begin PIR_FRAGMENT
+
$P0.'throw'()
+=end PIR_FRAGMENT
+
Throw an exception from the status object if it contains an error
object, otherwise do nothing.
@@ -349,22 +405,34 @@
=item C<new>
+=begin PIR_FRAGMENT
+
new $P0, [ 'Iterator' ], $P1
+=end PIR_FRAGMENT
+
Create a new iterator object $P0 from I/O object $P1.
=item C<shift>
+=begin PIR_FRAGMENT
+
shift $S0, $P1
+=end PIR_FRAGMENT
+
Retrieve the next line/block $S0 from the I/O iterator $P1. The amount
of data retrieved in each iteration is determined by the I/O object's
C<buffer_type> setting: unbuffered, line-buffered, or fully-buffered.
=item C<get_bool> (vtable)
+=begin PIR_FRAGMENT
+
unless $P0 goto iter_end
+=end PIR_FRAGMENT
+
Returns a boolean value for the iterator, C<true> if there is more data
to pull from the I/O object, C<false> if the iterator has reached the
end of the data. [NOTE: this means that an iterator always checks for
@@ -394,11 +462,15 @@
=item C<open>
+=begin PIR_FRAGMENT_INVALID
+
$P0 = open $S1
$P0 = open $S1, $S2
$P0 = open $P1
$P0 = open $P1, $S2
+=end PIR_FRAGMENT_INVALID
+
Opens a stream object based on a file path in $S1 and returns it. The
stream object defaults to read/write mode. The optional string argument
$S2 specifies the mode of the stream (read, write, append, read/write,
@@ -414,9 +486,13 @@
=item C<close>
+=begin PIR_FRAGMENT_INVALID
+
close $P0
close $P0, $P1
+=end PIR_FRAGMENT_INVALID
+
Closes a stream object. It takes a single string object argument and
returns a status object.
@@ -451,6 +527,8 @@
=item C<print>
+=begin PIR_FRAGMENT_INVALID
+
print $I0
print $N0
print $S0
@@ -464,6 +542,8 @@
print $P0, $S1, $P2
print $P0, $P1, $P2
+=end PIR_FRAGMENT_INVALID
+
Writes an integer, float, string, or PMC value to a stream. It
writes to standard output by default, but optionally takes a PMC
argument to select another stream to write to.
@@ -474,11 +554,15 @@
=item C<printerr>
+=begin PIR_FRAGMENT
+
printerr $I0
printerr $N0
printerr $S0
printerr $P0
+=end PIR_FRAGMENT
+
Writes an integer, float, string, or PMC value to standard error.
There is no asynchronous variant of C<printerr>. [It's just a shortcut.
@@ -492,10 +576,14 @@
=item C<read>
+=begin PIR_FRAGMENT_INVALID
+
$S0 = read $I1
$S0 = read $P1, $I2
$P0 = read $P1, $I2, $P3
+=end PIR_FRAGMENT_INVALID
+
Retrieves a specified number of bytes, $I2, from a stream, $P2, into a
string, $S0. [Note this is bytes, not codepoints.] By default it reads
from standard input, but it also takes an alternate stream object source
@@ -508,9 +596,13 @@
=item C<readline>
+=begin PIR_FRAGMENT_INVALID
+
$S0 = readline $P1
$P0 = readline $P1, $P2
+=end PIR_FRAGMENT_INVALID
+
Retrieves a single line from a stream into a string. Calling
C<readline> flags the stream as operating in line-buffer mode.
@@ -521,9 +613,13 @@
=item C<peek>
+=begin PIR_FRAGMENT
+
$S0 = peek
$S0 = peek $P1
+=end PIR_FRAGMENT
+
[C<peek>, C<seek>, C<tell>, and C<poll> are all candidates for moving from
opcodes to FileHandle object methods.]
@@ -543,11 +639,15 @@
=item C<seek>
+=begin PIR_FRAGMENT_INVALID
+
seek $P0, $I1, $I2
seek $P0, $I1, $I2, $I3
seek $P0, $I1, $I2, $P3
seek $P0, $I1, $I2, $I3, $P4
+=end PIR_FRAGMENT_INVALID
+
Sets the current file position of a stream object, $P0, to an integer
byte offset, $I1, from an integer starting position, $I2, (0 for the
start of the file, 1 for the current position, and 2 for the end of the
@@ -562,9 +662,13 @@
=item C<tell>
+=begin PIR_FRAGMENT_INVALID
+
$I0 = tell $P1
($I0, $I1) = tell $P2
+=end PIR_FRAGMENT_INVALID
+
Retrieves the current file position of a stream object. It also has a
64-bit variant that returns the byte offset as two integers (one for the
first 32 bits of the 64-bit offset, and one for the second 32 bits).
@@ -575,8 +679,12 @@
=item C<poll>
+=begin PIR_FRAGMENT_INVALID
+
$I0 = poll $P1, $I2, $I3, $I4
+=end PIR_FRAGMENT_INVALID
+
Polls a stream or socket object for particular types of events (an
integer flag) at a frequency set by seconds and microseconds (the final
two integer arguments). [At least, that's what the documentation in
@@ -938,6 +1046,11 @@
None.
+=head2 Links
+
+L<http://en.wikipedia.org/wiki/Asynchronous_I/O> for a relatively
+comprehensive list of asynchronous I/O implementation options.
+
=head2 References
F<src/io/io.c>
Modified: branches/pmc_pct/docs/pdds/pdd23_exceptions.pod
==============================================================================
--- branches/pmc_pct/docs/pdds/pdd23_exceptions.pod Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/docs/pdds/pdd23_exceptions.pod Thu Jun 4 02:32:48 2009 (r39377)
@@ -380,6 +380,8 @@
(though it would still be implemented as an exception handler
internally). Something like:
+=begin PIR_FRAGMENT_TODO
+
.local pmc error_code
.capture_start error_code
$P1 = find_lex 'foo'
@@ -387,6 +389,8 @@
# error_code contains what would have been the "error" return value
+=end PIR_FRAGMENT_TODO
+
This could eliminate the need for "defanging" because it would be almost
as easy to use as error codes. It could be implemented once for all
exceptional opcodes, instead of needing to be defined for each one. And,
@@ -399,7 +403,9 @@
The exception message is stored in the 'message' attribute:
- ...
+=begin PIR_FRAGMENT
+
+ # ...
handler:
.local pmc exception
.local string message
@@ -407,6 +413,8 @@
message = exception['message']
say message
+=end PIR_FRAGMENT
+
=head4 Resuming after Exceptions
@@ -423,6 +431,8 @@
You resume from an exception by invoking the return continuation stored
in the 'resume' attribute of the exception.
+=begin PIR_FRAGMENT
+
push_eh handler
$P0 = new 'Exception' # create new exception object
throw $P0 # throw it
@@ -435,6 +445,8 @@
continuation = exception['resume']
continuation()
+=end PIR_FRAGMENT
+
=head2 Attachments
None.
Modified: branches/pmc_pct/docs/pdds/pdd24_events.pod
==============================================================================
--- branches/pmc_pct/docs/pdds/pdd24_events.pod Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/docs/pdds/pdd24_events.pod Thu Jun 4 02:32:48 2009 (r39377)
@@ -82,8 +82,8 @@
=head3 Event API
-An event is a PMC object that contains a type, data for the event, and a
-priority.
+An event is a Task PMC object that contains a type, data for the event,
+and a priority.
The type of an event is only used to match the event with an event handler,
but is notionally similar to the class of an object.
@@ -99,20 +99,25 @@
ignores an event because of its priority level, the event remains in the task
list until the priority threshold changes.
-An instance of the Event PMC has 3 internal attributes, which are:
+An instance of the Task PMC acting as an event uses 4 internal
+attributes, which are:
=over 4
=item 1
-The type of the event
+The type of the task, which is "event"
=item 2
-The priority of the event
+The subtype of this particular event
=item 3
+The priority of the event
+
+=item 4
+
A PMC containing any additional data associated with the event, which may be
used by the event handler.
@@ -243,18 +248,27 @@
=item new
+=begin PIR_FRAGMENT
+
$P1 = new 'Event'
$P1 = new 'EventHandler'
$P1 = new 'EventHandler', $P2
+=end PIR_FRAGMENT
+
+
Creates a new event or event handler.
=item schedule
+=begin PIR_FRAGMENT
+
$P0 = new 'Event'
# set attributes
schedule $P0
+=end PIR_FRAGMENT
+
Register an event with the concurrency scheduler. If the concurrency scheduler
for this interpreter (thread/clustered instance) is linked to another
"primary" concurrency scheduler, this will pass along the event to the
@@ -265,10 +279,14 @@
=item addhandler
+=begin PIR_FRAGMENT
+
$P0 = new 'EventHandler'
# set attributes
addhandler $P0
+=end PIR_FRAGMENT
+
Register an event handler with the concurrency scheduler. If the concurrency
scheduler for this interpreter (thread/clustered instance) is linked to
another "primary" concurrency scheduler, this will pass along the event
Modified: branches/pmc_pct/docs/pdds/pdd25_concurrency.pod
==============================================================================
--- branches/pmc_pct/docs/pdds/pdd25_concurrency.pod Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/docs/pdds/pdd25_concurrency.pod Thu Jun 4 02:32:48 2009 (r39377)
@@ -274,13 +274,21 @@
=item add_handler
- $P1.add_handler($P2)
+=begin PIR_FRAGMENT
+
+ $P1.'add_handler'($P2)
+
+=end PIR_FRAGMENT
Add an event or exception handler to the scheduler's list of handlers.
=item find_handler
- $P1 = $P2.find_handler($P3)
+=begin PIR_FRAGMENT
+
+ $P1 = $P2.'find_handler'($P3)
+
+=end PIR_FRAGMENT
Search for an event or exception handler $P1, in scheduler $P2, for the task
$P3. Returns a null PMC if an appropriate handler is not found.
@@ -365,34 +373,50 @@
=item new
+=begin PIR_FRAGMENT
+
$P1 = new 'Task'
+=end PIR_FRAGMENT
+
Creates a new task. (The Scheduler PMC is never instantiated directly, it is
only used by Parrot internals.)
=item schedule
+=begin PIR_FRAGMENT
+
$P0 = new 'Task'
# set attributes
schedule $P0
+=end PIR_FRAGMENT
+
Register a task with the concurrency scheduler. Details about the task are
stored within the task PMC.
=item join
+=begin PIR_FRAGMENT_INVALID
+
$P0 = new 'Task'
# ... schedule the task, etc.
join $P0
+=end PIR_FRAGMENT_INVALID
+
Wait for a particular task to complete.
=item kill
+=begin PIR_FRAGMENT_INVALID
+
$P0 = new 'Task'
# ... schedule the task, etc.
kill $P0
+=end PIR_FRAGMENT_INVALID
+
Kill a task without waiting for it to complete.
Modified: branches/pmc_pct/docs/pdds/pdd27_multiple_dispatch.pod
==============================================================================
--- branches/pmc_pct/docs/pdds/pdd27_multiple_dispatch.pod Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/docs/pdds/pdd27_multiple_dispatch.pod Thu Jun 4 02:32:48 2009 (r39377)
@@ -157,14 +157,26 @@
=item :multi
+=begin PIR
+
.sub mymultisub :multi(Integer, Integer)
+ # ...
+ .end
+
+=end PIR
The C<:multi> attribute marks a subroutine or method as participating in
multiple dispatch.
=item :invocant
+=begin PIR_INVALID
+
+ .sub mymultisub
.param pmc first :invocant
+ .end
+
+=end PIR_INVALID
Not all elements of a multi-sub's signature are relevant for the purposes of
multiple dispatch. The subroutine parameters that participate in dispatch are
Modified: branches/pmc_pct/docs/pmc/array.pod
==============================================================================
--- branches/pmc_pct/docs/pmc/array.pod Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/docs/pmc/array.pod Thu Jun 4 02:32:48 2009 (r39377)
@@ -13,17 +13,21 @@
=head1 SYNOPSIS
- new P0, 'Array' # initialize P0 as an array
+=begin PIR_FRAGMENT
- set I0, P0 # set I0 to the size of the array in P0
- set P0, 2 # set the size of the array in P0 to 2
+ new $P0, 'Array' # initialize P0 as an array
- set P0[0], "foo" # put "foo" into the array at position 0
- set I1, P0[1] # get an integer value from the entry
- # at array position 1
+ set $I0, $P0 # set I0 to the size of the array in P0
+ set $P0, 2 # set the size of the array in P0 to 2
- defined I2, P0[1] # is the value at position 1 defined?
- exists I3, P0[0] # is there an element at position 0?
+ set $P0[0], "foo " # put "foo" into the array at position 0
+ set $I1, $P0[1] # get an integer value from the entry
+ # at array position 1
+
+ defined $I2, $P0[1] # is the value at position 1 defined?
+ exists $I3, $P0[0] # is there an element at position 0?
+
+=end PIR_FRAGMENT
=head1 DESCRIPTION
@@ -32,20 +36,32 @@
As with any other PMC, the following line creates an array PMC in register
C<P0>:
- new P0, 'Array'
+=begin PIR_FRAGMENT
+
+ new $P0, 'Array'
+
+=end PIR_FRAGMENT
=head2 Array sizes
You can retrieve the size of the array using
- set I0, P0
+=begin PIR_FRAGMENT
+
+ set $I0, $P0
+
+=end PIR_FRAGMENT
This will put the size of the array in register C<P0> into C<I0>. In the same
way, assigning an integer directly to the array sets the size of the array.
For instance:
- new P0, 'Array'
- set P0, 2
+=begin PIR_FRAGMENT
+
+ new $P0, 'Array'
+ set $P0, 2
+
+=end PIR_FRAGMENT
creates a new Array (with default size 0) and then expands the size of the
array to two.
@@ -62,49 +78,73 @@
first position to the integer C<-8> and second position to the floating point
number C<3.1415>.
- new P0, 'Array'
- set P0, 2
+=begin PIR_FRAGMENT
+
+ new $P0, 'Array'
+ set $P0, 2
+
+ set $P0[0], -8
+ set $P0[1], 3.1415
- set P0[0], -8
- set P0[1], 3.1415
+=end PIR_FRAGMENT
You can also assign directly from registers; for instance:
- new P0, 'Array'
- set P0, 2
+=begin PIR_FRAGMENT
- set I0, -8
- set N0, 3.1415
+ new $P0, 'Array'
+ set $P0, 2
- set P0[0], I0
- set P0[1], N0
+ set $I0, -8
+ set $N0, 3.1415
+
+ set $P0[0], $I0
+ set $P0[1], $N0
+
+=end PIR_FRAGMENT
leaves P0 in the same state as in the previous code snippet.
To retrieve elements, we use the same syntax:
- set N1, P0[1]
- set I1, P0[0]
+=begin PIR_FRAGMENT
+
+ set $N1, $P0[1]
+ set $I1, $P0[0]
+
+=end PIR_FRAGMENT
Those two lines retrieve the values from the array back into registers.
The value stored at a given position is not fixed; it can be changed simply by
assigning a new value:
- set P0[1], "A string"
+=begin PIR_FRAGMENT
+
+ set $P0[1], "A string"
+
+=end PIR_FRAGMENT
Accessing an out-of-bounds array element raises an exception; if you want an
Array that will automatically resize, then use a C<ResizablePMCArray>.
You can test if there is a defined element at an array position by using
- defined I0, P0[1]
+=begin PIR_FRAGMENT
+
+ defined $I0, $P0[1]
+
+=end PIR_FRAGMENT
for the position you want to test. On the other hand, if you only want to test
whether a given element exists (rather than whether it is defined), then use
the C<exists> op instead:
- exists I0, P0[0]
+=begin PIR_FRAGMENT
+
+ exists $I0, $P0[0]
+
+=end PIR_FRAGMENT
=head2 TODO
Modified: branches/pmc_pct/docs/pmc/documentation.pod
==============================================================================
--- branches/pmc_pct/docs/pmc/documentation.pod Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/docs/pmc/documentation.pod Thu Jun 4 02:32:48 2009 (r39377)
@@ -1,3 +1,7 @@
+=head1 TITLE
+
+Documenting PMCs
+
=head1 Overview
This document describes guidelines for writing documentation for PMCs.
Modified: branches/pmc_pct/docs/pmc/struct.pod
==============================================================================
--- branches/pmc_pct/docs/pmc/struct.pod Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/docs/pmc/struct.pod Thu Jun 4 02:32:48 2009 (r39377)
@@ -63,6 +63,8 @@
can be declared with this initializer:
+=begin PIR_FRAGMENT_INVALID
+
new P2, 'ResizablePMCArray'
.include "datatypes.pasm"
push P2, .DATATYPE_DOUBLE
@@ -78,19 +80,24 @@
push P2, 0
push P2, 0
+=end PIR_FRAGMENT_INVALID
+
=head2 Named Structure Elements
The initializer can be an OrderedHash PMC too. When all elements are defined in
the correct order this can be used to define and access struct elements by name
and by index:
+=begin PIR_FRAGMENT_INVALID
+
new P2, 'OrderedHash'
.include "datatypes.pasm"
set P2["d"], .DATATYPE_DOUBLE
push P2, 0 # no array i.e. 1 element
push P2, 0 # calculate offset by just adding item size
set P2["f"], .DATATYPE_FLOAT
- ...
+
+=end PIR_FRAGMENT_INVALID
=head1 Size of a Structure
@@ -100,10 +107,14 @@
The size can be obtained by:
+=begin PIR_FRAGMENT_INVALID
+
new P5, 'ManagedStruct', P2 # P2 be some initializer
set I0, P5 # allocated size
+=end PIR_FRAGMENT_INVALID
+
=head1 Accessing Structure Items
Setting or getting items is done by keyed access to the Struct PMC. The first
@@ -112,6 +123,8 @@
=head2 Example
+=begin PIR_FRAGMENT_INVALID
+
set P5[0], N0 # set d
set N0, P5[0] # get d
@@ -129,6 +142,8 @@
set S0, P5[3] # get string at *s
set S0, P5["s"] # same
+=end PIR_FRAGMENT_INVALID
+
=head2 Strings
When passing a STRING to a structure that needs a 0-terminated C-string (char
@@ -139,14 +154,22 @@
char *s;
};
+=begin PIR_FRAGMENT_INVALID
+
set P5["s"], "a string\x0"
+=end PIR_FRAGMENT_INVALID
+
Please also note, that the C function currently gets a pointer to string
memory, so any code that might trigger GC should be avoided (or GC turned off).
Passing constant strings like above is safe though.
+=begin PIR_FRAGMENT_INVALID
+
set P5["s"], S0 # S0 shouldn't move until function call
+=end PIR_FRAGMENT_INVALID
+
=head2 Callback Functions in the C Library
Given a C function that returns a structure containing a callback function like
@@ -161,6 +184,8 @@
The PASM would look like:
+=begin PASM_INVALID
+
push P2, .DATATYPE_FUNC_PTR
# attach function signature property to this type
set P1, P2[-1]
@@ -177,6 +202,8 @@
# call the call_back function
invoke
+=end PASM_INVALID
+
=head2 Nested Structures or Pointers to Nested Structures
Each contained structure needs its own UnManagedStruct initializer. The
@@ -196,6 +223,8 @@
... access to elements could look like:
+=begin PIR_FRAGMENT_INVALID
+
# the nested structure
new P3, 'OrderedHash'
set P3["i"], .DATATYPE_CHAR
@@ -237,10 +266,16 @@
set I0, P5["_y"; "j"]
set I0, P5["z"]
+=end PIR_FRAGMENT_INVALID
+
If the structure has a pointer to another structure the datatype is:
+=begin PIR_INVALID
+
push P2, .DATATYPE_STRUCT_PTR
+=end PIR_INVALID
+
=head1 Passing A Structure to a C function
For a shared library B<libnci_test.so> (or whatever) and a C function
@@ -255,12 +290,16 @@
a pointer to the structure is passed with the B<p> signature char:
+=begin PIR
+
loadlib P1, "libnci_test"
dlfunc P0, P1, "nci_ip", "ip"
# P5 is ManagedStruct from above
invoke
# I5 is result
+=begin PIR
+
=head1 BUGS
Not all datatypes are implemented. Alignment is barely tested on different
Modified: branches/pmc_pct/docs/pmc/subs.pod
==============================================================================
--- branches/pmc_pct/docs/pmc/subs.pod Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/docs/pmc/subs.pod Thu Jun 4 02:32:48 2009 (r39377)
@@ -70,13 +70,19 @@
B<get_root_global> opcodes. Within the PIR source, they can also be put in
registers with a C<.const 'Sub'> declaration:
+=begin PIR_FRAGMENT
+
.const 'Sub' rsub = 'random_sub'
+=end PIR_FRAGMENT
+
This uses C<find_sub_not_null> under the hood to look up the sub named
"random_sub".
Here's an example of fetching a sub from another namespace:
+=begin PIR
+
.sub main :main
get_hll_global $P0, ['Other'; 'Namespace'], "the_sub"
$P0()
@@ -89,6 +95,8 @@
print "in sub\n"
.end
+=end PIR
+
Note that C<the_sub> could be defined in a different bytecode or PIR source
file from C<main>.
@@ -97,7 +105,13 @@
One subroutine in the first executed source or bytecode file may be flagged as
the "main" subroutine, where execution starts.
+=begin PIR
+
.sub the_main_event :main
+ # ...
+ .end
+
+=end PIR
In the absence of a B<:main> entry Parrot starts execution at the first
statement. Any C<:main> directives in a subsequent PIR or bytecode file that
@@ -114,6 +128,8 @@
e.g.
+=begin PIR
+
.sub main :main
print "in main\n"
load_bytecode "library_code.pir"
@@ -126,6 +142,8 @@
print "initializing library\n"
.end
+=end PIR
+
If a subroutine is marked as B<:init> this subroutine is run before the
B<:main> or the first subroutine in the source file runs. Unlike B<:main>
subs, B<:init> subs are also run when compiling from memory. B<:load> subs
@@ -153,10 +171,16 @@
PIR sub invocation syntax is similar to HLL syntax:
+=begin PIR_FRAGMENT
+
$P0 = do_something($P1, $S3)
+=end PIR_FRAGMENT
+
This is syntactic sugar for the following four bytecode instructions:
+=begin PIR_FRAGMENT
+
# Establish arguments.
set_args '(0,0)', $P1, $S3
# Find the sub.
@@ -166,6 +190,8 @@
# Call the sub in $P8, implicitly creating a return continuation.
invokecc $P8
+=end PIR_FRAGMENT
+
The sub name could be replaced with a PMC register, in which case the
C<find_sub_not_null> instruction would not be needed. If the return values
from the sub were ignored (by dropping the C<$P0 => part), the C<get_results>
@@ -181,34 +207,85 @@
To receive multiple values, put the register names in parentheses:
+=begin PIR_FRAGMENT
+
+ ($P10, $P11) = do_something($P1, $S3)
+
($P10, $P11) = do_something($P1, $S3)
+=end PIR_FRAGMENT
+
+To test whether a value was returned, declare it C<:optional>, and follow it
+with an integer register declared C<:opt_val>:
+
+=begin PIR_FRAGMENT_INVALID
+
+ ($P10 :optional, $I10 :opt_val) = do_something($P1, $S3)
+
+=end PIR_FRAGMENT_INVALID
+
+Both of these affect only the signature provided via C<get_results>.
+
+[should also describe :flat, :slurpy, :named, ..., or at least provide a
+reference. -- rgr, 25-May-08.]
+
+=begin PIR_FRAGMENT
+
+ # Call the sub in $P8, with continuation (created earlier) in $P9.
+ invoke $P8, $P9
+
+=end PIR_FRAGMENT
+
+=head2 Returning from a sub
+
+PIR supports a convenient syntax for returning any number of values from a sub
+or closure:
+
+
To test whether a value was returned, declare it C<:optional>, and follow it
with an integer register declared C<:opt_val>:
+=begin PIR_FRAGMENT_INVALID
+
($P10 :optional, $I10 :opt_val) = do_something($P1, $S3)
+=end PIR_FRAGMENT_INVALID
+
Both of these affect only the signature provided via C<get_results>.
[should also describe :flat, :slurpy, :named, ..., or at least provide a
reference. -- rgr, 25-May-08.]
+=begin PIR_FRAGMENT
+
# Call the sub in $P8, with continuation (created earlier) in $P9.
invoke $P8, $P9
+=end PIR_FRAGMENT
+
=head2 Returning from a sub
PIR supports a convenient syntax for returning any number of values from a sub
or closure:
- .return ($P0, $I1, $S3)
+=begin PIR
+
+ .sub main
+ .return ($P0, $I1, $S3)
+ .end
+
+=end PIR
Integer, float, and string constants are also accepted. This is translated
to:
+=begin PIR_FRAGMENT
+
get_results '(0,0,0)', $P0, $I1, $S3
returncc # return by calling the current continuation
+=end PIR_FRAGMENT
+
As for C<set_args>, the '(0,0,0)' is actually a placeholder for an integer
array that describes the register types; it is replaced internally with C<[2,
0, 1]>, which means "three arguments, of type PMC, integer, and string".
@@ -218,21 +295,33 @@
caller of the old sub (i.e. without first returning to the old sub). This
passes the three values to C<another_sub> via tail-calling:
- .return another_sub($P0, $I1, $S3)
+=begin PIR
+
+ .sub main
+ .tailcall another_sub($P0, $I1, $S3)
+ .end
+
+=end PIR
This is translated into a C<set_args> instruction for the call, but with
C<tailcall> instead of C<invokecc>:
+=begin PIR_FRAGMENT
+
set_args '(0,0,0)', $P0, $I1, $S3
$P8 = find_sub_not_null "another_sub"
tailcall $P8
+=end PIR_FRAGMENT
+
As for calling, the sub name could be replaced with a PMC register, in which
case the C<find_sub_not_null> instruction would not be needed.
If needed, the current continuation can be extracted and called explicitly as
follows:
+=begin PIR_FRAGMENT
+
## This is what defines .INTERPINFO_CURRENT_CONT.
.include 'interpinfo.pasm'
## Store our return continuation as exit_cont.
@@ -243,12 +332,16 @@
## ... or equivalently:
tailcall exit_cont
+=end PIR_FRAGMENT
+
To return values, use C<set_args> as before.
=head2 All together now
The following complete example illustrates the typical call/return pattern:
+=begin PIR
+
.sub main :main
print "in main\n"
the_sub()
@@ -259,6 +352,8 @@
print "in sub\n"
.end
+=end PIR
+
Notice that we are not passing or returning values here.
[example of passing values. this could get pretty elaborate; look for other
@@ -267,6 +362,8 @@
If a short subroutine is called several times, for instance inside a loop, the
creation of the return continuation can be done outside the loop:
+=begin PIR_INVALID
+
.sub main :main
## Initialize the sub and the return cont.
.local pmc cont
@@ -293,6 +390,8 @@
## do_something
.end
+=end PIR_INVALID
+
If the sub returns values, the C<get_results> must be B<after> C<ret_label> in
order to receive them.
Modified: branches/pmc_pct/docs/project/release_manager_guide.pod
==============================================================================
--- branches/pmc_pct/docs/project/release_manager_guide.pod Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/docs/project/release_manager_guide.pod Thu Jun 4 02:32:48 2009 (r39377)
@@ -18,7 +18,9 @@
report (and hopefully fix!) any problems they find. Check in with
language project leads for release blockers, to allow time to fix them.
Also ask people to review the tickets targeted for the upcoming release
-L<https://trac.parrot.org/parrot/roadmap>.
+L<https://trac.parrot.org/parrot/roadmap>. Make sure your ssh keys have
+been added to the FTP server, so you'll be able to ship the release (any
+previous release manager can help).
A couple of days in advance: announce the new release to
parrot-dev at lists.parrot.org and to the IRC channel #parrot. Ask whether
@@ -52,8 +54,7 @@
=item a
Increment the version number in the following files:
-F<VERSION>, F<parrot.spec>, F<MANIFEST.generated>, F<META.yml>,
-F<README>.
+F<VERSION>, F<MANIFEST.generated>, F<META.yml>, F<README>.
Also update the version number, date, and your name in the
the file: F<docs/parrothist.pod>.
@@ -89,6 +90,10 @@
Update the date part of the link to the wiki page for the next bugday.
+=item C<ftp.path>
+
+The URL of the FTP directory where the Parrot tarball can be found.
+
=back
=item d
@@ -242,7 +247,7 @@
=item b
-Set the "News" category to "Releases".
+For the "News" category, select both "Releases" and "News".
Add tags to the page for significant changes in this release (e.g. "rakudo" for
significant Rakudo language updates, or "gc" for significant garbage collection
@@ -359,7 +364,6 @@
The starred releases are Parrot's twice-yearly supported releases, see
F<docs/project/support_policy.pod>.
- - May 19, 2009 - 1.2 - tewk
- June 16, 2009 - 1.3 - whiteknight
- July 21, 2009 - 1.4* - cotto
- August 18, 2009 - 1.5 - rgrjr
Modified: branches/pmc_pct/docs/project/ubuntu_packaging_guide.pod
==============================================================================
--- branches/pmc_pct/docs/project/ubuntu_packaging_guide.pod Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/docs/project/ubuntu_packaging_guide.pod Thu Jun 4 02:32:48 2009 (r39377)
@@ -40,23 +40,28 @@
=item 3.
+Integrate any new change entries from F<ports/debian/changelog> into
+F<ports/ubuntu/changelog>, preserving chronological order.
+
Copy the F<ports/debian/> directory from the Parrot source tree into the fresh
tarball extract.
cp -r <path/to/parrot/svn>/ports/debian ~/udeb/parrot/parrot-[version]/.
-Integrate any new change entries from F<ports/debian/changelog> into
-F<ports/ubuntu/changelog>, preserving chronological order. Copy the Ubuntu
-changelog file over the F<changelog> file in
-F<~/udeb/parrot/parrot-[version]/debian>.
+
+Then copy the unique Ubuntu files (F<changelog> and F<control.in>) from
+F<ports/ubuntu/> into the new F<debian/> directory.
+
+ cp <path/to/parrot/svn>/ports/ubuntu/* ~/udeb/parrot/parrot-[version]/debian/.
=item 4.
-Update the F<changelog> file in F<~/udeb/parrot/parrot-[version]/debian/> to
-add an entry for the Ubuntu package. Copy the first line from the Debian
-changelog. Add C<ubuntu#> after the Debian version to indicate the Ubuntu
-revision of the package, and for PPA uploads also add C<~ppa#>. Instead of the
-Debian branch ('unstable') use the target Ubuntu distribution ('intrepid').
+Add a new entry to the F<changelog> file in
+F<~/udeb/parrot/parrot-[version]/debian/> for the Ubuntu package. Copy
+the first line from the Debian changelog. Add C<ubuntu#> after the
+Debian version to indicate the Ubuntu revision of the package, and for
+PPA uploads also add C<~ppa#>. Instead of the Debian branch ('unstable')
+use the target Ubuntu distribution ('intrepid').
parrot (0.5.1-1ubuntu1) intrepid; urgency=low
@@ -85,7 +90,8 @@
=item 7.
-Update Parrot's PPA with the new release (configured in ChrootSetup):
+Update Parrot's PPA with the new release (configured in ChrootSetup).
+From F<~/udeb/parrot/> run:
$ dput parrot-ppa parrot_[version]_source.changes
Modified: branches/pmc_pct/docs/tests.pod
==============================================================================
--- branches/pmc_pct/docs/tests.pod Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/docs/tests.pod Thu Jun 4 02:32:48 2009 (r39377)
@@ -81,8 +81,6 @@
C<pir_output_is> and friends.
pir_output_is(<<'CODE',<<'OUT','nothing useful');
- .include 'library/config.pir'
-
.sub main :main
print "hi\n"
.end
Modified: branches/pmc_pct/docs/user/pir/exceptions.pod
==============================================================================
--- branches/pmc_pct/docs/user/pir/exceptions.pod Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/docs/user/pir/exceptions.pod Thu Jun 4 02:32:48 2009 (r39377)
@@ -10,43 +10,36 @@
including two pasm files that define constants for exception type and
severity.
- .include 'except_types.pasm'
- .include 'except_severity.pasm'
-
You create exceptions just like you create any other object, with
C<new>.
- .local pmc ex
- ex = new 'Exception'
-
You usually want to at least set a descriptive message about what went
wrong.
- ex = "Everything is horrible, dood."
-
You also usually want to set a severity and sometimes a type. You can
find these in L<runtime/parrot/include/except_severity.pasm>.
- ex['severity'] = .EXCEPT_DOOMED
- ex['type'] = .CONTROL_ERROR
-
You actually throw the exception by using the C<throw> op.
- throw ex
-
Put all together, it looks like this:
-=head3 Throw Example
+=begin PIR_FRAGMENT
.include 'except_types.pasm'
.include 'except_severity.pasm'
+
.local pmc ex
ex = new 'Exception'
+
ex = "Everything is horrible, dood."
+
ex['severity'] = .EXCEPT_DOOMED
ex['type'] = .CONTROL_ERROR
+
throw ex
+=end PIR_FRAGMENT
+
=head2 Catching exceptions
Parrot maintains a stack of exception handlers. When an exception is
@@ -59,27 +52,35 @@
You create exception handlers just like you create any other object, with
C<new>.
+=begin PIR_FRAGMENT
+
.local pmc eh
eh = new 'ExceptionHandler'
+=end PIR_FRAGMENT
+
You set the target of the exception handler (the code that will be
invoked) with the C<set_attr> opcode. Usually this will be a label.
You manipulate the exception handler stack with the C<push_eh> and
C<pop_eh> opcodes. This is a fairly standard use of exception handlers:
+=begin PIR_FRAGMENT
+
.local pmc eh
eh = new 'ExceptionHandler'
set_addr eh, handler
push_eh eh
- ... # code that might throw an exception
+ # code that might throw an exception
pop_eh
.return (1) # Success!
handler:
.local pmc ex
.get_results (ex)
- ... # code that prints a warning, logs an error, whatever
+ # code that prints a warning, logs an error, whatever
.return (0) # Failure!
+=end PIR_FRAGMENT
+
Sometimes you want to be more specific in what you catch. You can set
filters on the exception handler based on exception type and severity.
The methods you use include C<.min_severity()>, C<.max_severity()>,
Modified: branches/pmc_pct/docs/user/pir/intro.pod
==============================================================================
--- branches/pmc_pct/docs/user/pir/intro.pod Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/docs/user/pir/intro.pod Thu Jun 4 02:32:48 2009 (r39377)
@@ -116,25 +116,37 @@
Parrot C<set> opcode to put values into registers, and the C<add>
opcode to add them, like this:
+=begin PIR_FRAGMENT
+
set $I1, 5
set $I2, 3
add $I0, $I1, $I2 # $I0 yields 5+3
+=end PIR_FRAGMENT
+
PIR includes infix operators for these common opcodes. I could write
this same code as
+=begin PIR_FRAGMENT
+
$I1 = 5
$I2 = 3
$I0 = $I1 + $I2
+=end PIR_FRAGMENT
+
There are the four arithmetic operators as you should be expecting, as
well as the six different comparison operators, which return a boolean
value:
+=begin PIR_FRAGMENT
+
$I1 = 5
$I2 = 3
$I0 = $I1 <= $I2 # $I0 yields 0 (false)
+=end PIR_FRAGMENT
+
I can also use the short accumulation-like operators, like C<+=>.
Another PIR perk is that local variable names may be declared and used
@@ -142,9 +154,13 @@
variable using the C<.local> keyword with any of the four data
types available on PIR: C<int>, C<string>, C<num> and C<pmc>:
+=begin PIR_FRAGMENT
+
.local int size
size = 5
+=end PIR_FRAGMENT
+
Note that all registers, both numbered and named, are consolidated by
the Parrot register allocator, assigning these "virtual registers" to
actual registers as needed. The register allocator even coalesces two
@@ -166,12 +182,24 @@
test a condition and jump to another place in the code, I would write
the following PASM code:
- le $I1, $I2, LESS_EQ
+=begin PASM
+
+ le I1, I2, LESS_EQ
+ # ...
+ LESS_EQ:
+
+=end PASM
Meaning, if C<$I1> is less or equal than C<$I2>, jump to label
C<LESS_EQ>. In PIR I would write it in a more legible way:
+=begin PIR_FRAGMENT
+
if $I1 <= $I2 goto LESS_EQ
+ # ...
+ LESS_EQ:
+
+=end PIR_FRAGMENT
PIR includes the C<unless> keyword as well.
@@ -219,19 +247,33 @@
To return values from PIR subroutines I use the C<.return> keyword,
followed by one or more arguments, just like this:
- .return (10, 20, 30)
+=begin PIR
+
+ .sub _
+ .return (10, 20, 30)
+ .end
+
+=end PIR
The calling subroutine can accept these values. If you want to retrieve
only one value (or only the first value, in case multiple values are
returned), write this:
+=begin PIR_FRAGMENT
+
$I0 = compute_it($I8, $I9)
+=end PIR_FRAGMENT
+
To accept multiple values from such a function, use a parenthesized
results list:
+=begin PIR_FRAGMENT
+
($I1, $I2, $I3) = compute_it($I8, $I9)
+=end PIR_FRAGMENT
+
=head2 Factorial Example
Now, for a little more complicated example, let me show how I would
@@ -269,8 +311,13 @@
As before, I need to use C<.param> for each named argument, but you need to
specify a flag indicating the parameter is named:
+=begin PIR
+
.sub func
.param int a :named("foo")
+ .end
+
+=end PIR
The subroutine will receive an integer named "foo", and inside of the
subroutine that integer will be known as "a".
@@ -278,9 +325,13 @@
When calling the function, I need to pass the names of the
arguments. For that there are two syntaxes:
+=begin PIR_FRAGMENT
+
func( 10 :named("foo") ) # or
func( "foo" => 10 )
+=end PIR_FRAGMENT
+
Note that with named arguments, you may rearrange the order of your
parameters at will.
@@ -297,11 +348,15 @@
This subroutine may be called in any of the following ways:
+=begin PIR_FRAGMENT
+
foo( "Fred", 35, "m" )
foo( "gender" => "m", "name" => "Fred", "age" => 35 )
foo( "age" => 35, "gender" => "m", "name" => "Fred" )
foo( "m" :named("gender"), 35 :named("age"), "name" => "Fred" )
+=end PIR_FRAGMENT
+
and any other permutation you can think of as long as you use the named
argument syntax. Note that any positional parameters must be passed
before the named parameters. So, the following is allowed:
@@ -318,21 +373,33 @@
Whereas the following is not:
+=begin PIR_INVALID
+
.sub main
.param int a :named("name")
.param int b # cannot declare positional parameter after a named parameter
# ...
.end
+=begin PIR_INVALID
+
It's also possible to use named syntax when returning values from
subroutines. Into the C<.return> command I'll use:
+=begin PIR
+
.return ( "bar" => 20, "foo" => 10)
+=end PIR
+
and when calling the function, I will do:
+=begin PIR
+
("foo" => $I0, "bar" => $I1) = func()
+=end PIR
+
And C<$I0> will yield 10, and C<$I1> will yield 20, as expected.
=head2 Concluding
@@ -343,15 +410,23 @@
pass it a string register or variable where you wish the characters
read to be placed and the number of characters you wish to read:
+=begin PIR
+
read $S1, 100
+=end PIR
+
This line will read 100 characters (or until the end of the line) and
put the read string into C<$S1>. In case you need a number, just
assign the string to the correct register type:
+=begin PIR
+
read $S1, 100
$I1 = $S1
+=end PIR
+
With the PIR syntax shown in this article you should be able to start
writing simple programs. Next article we will look into available
Polymorphic Containers (PMCs), and how they can be used.
Modified: branches/pmc_pct/docs/user/pir/objects.pod
==============================================================================
--- branches/pmc_pct/docs/user/pir/objects.pod Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/docs/user/pir/objects.pod Thu Jun 4 02:32:48 2009 (r39377)
@@ -161,14 +161,24 @@
the quotes, then the identifier is assumed to be a declared
C<.local> symbol. So, instead of writing:
+=begin PIR_FRAGMENT
+
+ .local pmc elsie
elsie.'speak'()
+=end PIR_FRAGMENT
+
you could also have written:
+=begin PIR_FRAGMENT
+
+ .local pmc elsie
.local string speak
speak = 'speak'
elsie.speak()
+=end PIR_FRAGMENT
+
Another example of this is shown below.
=head3 Example 4: variable methods
@@ -305,18 +315,22 @@
=head3 Example 6: inheriting
- ...
+=begin PIR_FRAGMENT
+
$P0 = newclass "Animal"
addattribute $P0, "name"
$P0 = subclass "Animal", "Cow"
$P0 = subclass "Animal", "Dog"
$P0 = subclass "Animal", "Pig"
- ...
+ # ...
+ .local pmc cow
cow = new 'Cow'
cow.'setname'("Elsie")
- ...
+ # ...
cow.'getname'()
+=end PIR_FRAGMENT
+
Each subclass will contain an attribute called "name" that can be
used to store the name of the animal. The C<setname> method
abstracts out the process of creating a C<String> PMC and
Modified: branches/pmc_pct/examples/benchmarks/addit.pasm
==============================================================================
--- branches/pmc_pct/examples/benchmarks/addit.pasm Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/examples/benchmarks/addit.pasm Thu Jun 4 02:32:48 2009 (r39377)
@@ -12,7 +12,7 @@
=head1 DESCRIPTION
Joe Wilson's original PASM version of his C<varargs> subroutines
-benchmark. It calls an "add it" function 500000 times in a loop and
+benchmark. It calls an "add it" function 50000 times in a loop and
prints the result (21001097.970000).
=cut
@@ -24,7 +24,7 @@
push P5, 87
push P5, "3.87"
push P5, "21000000"
- set I9, 500000
+ set I9, 50000
AGAIN:
dec I9
lt I9, 0, FIN
Modified: branches/pmc_pct/examples/benchmarks/addit.pir
==============================================================================
--- branches/pmc_pct/examples/benchmarks/addit.pir Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/examples/benchmarks/addit.pir Thu Jun 4 02:32:48 2009 (r39377)
@@ -14,7 +14,7 @@
An IMC version of Joe Wilson's original PASM version of his C<varargs>
subroutines benchmark rewritten as it would be generated by a compiler
using Parrot calling conventions (PDD 3). It calls an "add it" function
-500000 times in a loop and prints the result (21001097.970000).
+50000 times in a loop and prints the result (21001097.970000).
=cut
@@ -36,7 +36,7 @@
a4 = "21000000"
.local pmc x
x = new 'Integer'
- x = 500000
+ x = 50000
AGAIN:
dec x
lt x, 0, FIN
Modified: branches/pmc_pct/examples/benchmarks/addit.pl
==============================================================================
--- branches/pmc_pct/examples/benchmarks/addit.pl Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/examples/benchmarks/addit.pl Thu Jun 4 02:32:48 2009 (r39377)
@@ -36,7 +36,7 @@
$args[3] = "3.87";
$args[4] = "21000000";
-for ( my $x = 500000 ; $x >= 0 ; --$x ) {
+for ( my $x = 50000 ; $x >= 0 ; --$x ) {
$result = varargs_adder(@args);
}
print "$result\n";
Modified: branches/pmc_pct/examples/benchmarks/addit.rb
==============================================================================
--- branches/pmc_pct/examples/benchmarks/addit.rb Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/examples/benchmarks/addit.rb Thu Jun 4 02:32:48 2009 (r39377)
@@ -15,7 +15,7 @@
arg4 = "21000000";
result = 0
-500000.times {
+50000.times {
result = addit(arg0, arg1, arg2, arg3, arg4)
}
puts result
Modified: branches/pmc_pct/examples/benchmarks/addit2.pir
==============================================================================
--- branches/pmc_pct/examples/benchmarks/addit2.pir Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/examples/benchmarks/addit2.pir Thu Jun 4 02:32:48 2009 (r39377)
@@ -15,7 +15,7 @@
C<varargs> subroutines benchmark rewritten as it would be generated by a
compiler using Parrot calling conventions (PDD 3).
-It calls an "add it" function 500000 times in a loop and prints the
+It calls an "add it" function 50000 times in a loop and prints the
result (21001097.970000).
=cut
@@ -38,7 +38,7 @@
a4 = "21000000"
.local pmc x
x = new 'Integer'
- x = 500000
+ x = 50000
.local pmc result
AGAIN:
dec x
Modified: branches/pmc_pct/examples/benchmarks/oo2.pasm
==============================================================================
--- branches/pmc_pct/examples/benchmarks/oo2.pasm Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/examples/benchmarks/oo2.pasm Thu Jun 4 02:32:48 2009 (r39377)
@@ -31,7 +31,7 @@
addattribute P1, ".j"
set I10, 0
- set I11, 500000
+ set I11, 50000
loop:
new P3, "Foo"
inc I10
Modified: branches/pmc_pct/examples/benchmarks/oo5.pir
==============================================================================
--- branches/pmc_pct/examples/benchmarks/oo5.pir Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/examples/benchmarks/oo5.pir Thu Jun 4 02:32:48 2009 (r39377)
@@ -23,7 +23,7 @@
y = new 'Integer'
assign y, $P5
inc i
- if i <= 500000 goto loop
+ if i <= 50000 goto loop
$P2 = o."i"()
print $P2
Modified: branches/pmc_pct/examples/benchmarks/oofib.pir
==============================================================================
--- branches/pmc_pct/examples/benchmarks/oofib.pir Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/examples/benchmarks/oofib.pir Thu Jun 4 02:32:48 2009 (r39377)
@@ -7,7 +7,7 @@
argc = argv
.local pmc N
N = new 'Integer'
- N = 28
+ N = 24
if argc <= 1 goto noarg
$S0 = argv[1]
N = $S0
Modified: branches/pmc_pct/examples/benchmarks/oofib.pl
==============================================================================
--- branches/pmc_pct/examples/benchmarks/oofib.pl Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/examples/benchmarks/oofib.pl Thu Jun 4 02:32:48 2009 (r39377)
@@ -33,7 +33,7 @@
package main;
-my $N = shift || 28;
+my $N = shift || 24;
my $b = B->new();
Modified: branches/pmc_pct/examples/benchmarks/oofib.py
==============================================================================
--- branches/pmc_pct/examples/benchmarks/oofib.py Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/examples/benchmarks/oofib.py Thu Jun 4 02:32:48 2009 (r39377)
@@ -20,7 +20,7 @@
return( self.fib(n-2) + self.fibA(n-1) )
-N = int(len(sys.argv) == 2 and sys.argv[1] or 28)
+N = int(len(sys.argv) == 2 and sys.argv[1] or 24)
b = B()
Modified: branches/pmc_pct/examples/benchmarks/oofib.rb
==============================================================================
--- branches/pmc_pct/examples/benchmarks/oofib.rb Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/examples/benchmarks/oofib.rb Thu Jun 4 02:32:48 2009 (r39377)
@@ -20,6 +20,6 @@
b = B.new
-N = Integer( ARGV.shift || 28 )
+N = Integer( ARGV.shift || 24 )
puts "fib(#{N}) = #{ b.fib(N) }"
Modified: branches/pmc_pct/examples/benchmarks/overload.pir
==============================================================================
--- branches/pmc_pct/examples/benchmarks/overload.pir Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/examples/benchmarks/overload.pir Thu Jun 4 02:32:48 2009 (r39377)
@@ -17,7 +17,7 @@
loop:
r = a * b
inc i
- if i <= 500000 goto loop
+ if i <= 50000 goto loop
print r
print "\n"
end
Modified: branches/pmc_pct/examples/benchmarks/overload.pl
==============================================================================
--- branches/pmc_pct/examples/benchmarks/overload.pl Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/examples/benchmarks/overload.pl Thu Jun 4 02:32:48 2009 (r39377)
@@ -24,7 +24,7 @@
my $a = Foo->new(7);
my $b = Foo->new(6);
my $r;
-for my $i ( 1 .. 500_000 ) { $r = $a * $b }
+for my $i ( 1 .. 50_000 ) { $r = $a * $b }
print "$r\n";
# Local Variables:
Modified: branches/pmc_pct/examples/benchmarks/primes.pasm
==============================================================================
--- branches/pmc_pct/examples/benchmarks/primes.pasm Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/examples/benchmarks/primes.pasm Thu Jun 4 02:32:48 2009 (r39377)
@@ -21,7 +21,7 @@
set P1, 1
# I2 holds the highest number we want to check for primality
new P2, 'Integer'
- set P2, 10000
+ set P2, 1000
new P6, 'Integer'
set P6, 0
print "N primes up to "
Modified: branches/pmc_pct/examples/benchmarks/primes.pl
==============================================================================
--- branches/pmc_pct/examples/benchmarks/primes.pl Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/examples/benchmarks/primes.pl Thu Jun 4 02:32:48 2009 (r39377)
@@ -21,7 +21,7 @@
use warnings;
my $i1 = 1;
-my $i2 = 10000;
+my $i2 = 1000;
my $i3;
my $i4;
my $i5;
Modified: branches/pmc_pct/examples/benchmarks/primes2.c
==============================================================================
--- branches/pmc_pct/examples/benchmarks/primes2.c Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/examples/benchmarks/primes2.c Thu Jun 4 02:32:48 2009 (r39377)
@@ -37,7 +37,7 @@
int
main(int argc, char *argv[])
{
- int i=0, max=10000;
+ int i=0, max=500;
int i6 = 0;
int i7;
Modified: branches/pmc_pct/examples/benchmarks/primes2.pir
==============================================================================
--- branches/pmc_pct/examples/benchmarks/primes2.pir Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/examples/benchmarks/primes2.pir Thu Jun 4 02:32:48 2009 (r39377)
@@ -23,7 +23,7 @@
i = new 'Integer'
i = 0
max = new 'Integer'
- max = 5000
+ max = 500
i6 = new 'Integer'
i6 = 0
i7 = new 'Integer'
Modified: branches/pmc_pct/examples/benchmarks/primes2.pl
==============================================================================
--- branches/pmc_pct/examples/benchmarks/primes2.pl Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/examples/benchmarks/primes2.pl Thu Jun 4 02:32:48 2009 (r39377)
@@ -7,7 +7,7 @@
use warnings;
my $i = 0;
-my $max = 5000;
+my $max = 500;
my $i6 = 0;
my $i7;
Modified: branches/pmc_pct/examples/benchmarks/primes2.py
==============================================================================
--- branches/pmc_pct/examples/benchmarks/primes2.py Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/examples/benchmarks/primes2.py Thu Jun 4 02:32:48 2009 (r39377)
@@ -38,7 +38,7 @@
l = 0
i6 = 0
i7 = 0
- max = 5000
+ max = 500
while 1:
Modified: branches/pmc_pct/examples/benchmarks/primes2.rb
==============================================================================
--- branches/pmc_pct/examples/benchmarks/primes2.rb Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/examples/benchmarks/primes2.rb Thu Jun 4 02:32:48 2009 (r39377)
@@ -2,7 +2,7 @@
i6 = 0
i7 = 0
-max = 5000
+max = 500
def is_prime(n)
if n < 1
Copied: branches/pmc_pct/examples/json/postalcodes.pir (from r39376, trunk/examples/json/postalcodes.pir)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/pmc_pct/examples/json/postalcodes.pir Thu Jun 4 02:32:48 2009 (r39377, copy of r39376, trunk/examples/json/postalcodes.pir)
@@ -0,0 +1,118 @@
+#!../../parrot
+# Copyright (C) 2001-2008, Parrot Foundation.
+# $Id$
+
+=head1 NAME
+
+postalcodes.pir
+
+=head1 SYNOPSIS
+
+ % ./parrot postalcodes.pir <postal>
+
+=head1 DESCRIPTION
+
+Given a postal code (like, '06382'), print some information about various
+places with that code from around the world.
+
+=cut
+
+.include 'socket.pasm'
+
+.sub _main :main
+ .param pmc argv
+
+ .local string postal, url
+
+ $I0 = elements argv
+ if $I0 != 2 goto bad_args
+
+ postal = argv[1]
+
+ .local pmc sock, address
+ .local string buf, json_result
+ json_result = ''
+ .local int ret
+ .local int len
+
+ # create the socket handle
+ sock = new 'Socket'
+ sock.'socket'(.PIO_PF_INET, .PIO_SOCK_STREAM, .PIO_PROTO_TCP)
+
+ # Pack a sockaddr_in structure with IP and port
+ address = sock.'sockaddr'('ws.geonames.org', 80)
+ ret = sock.'connect'(address)
+
+ .local string url
+ url = 'http://ws.geonames.org/postalCodeSearchJSON?maxRows=10&postalcode='
+ url .= postal
+
+ $S0 = 'GET '
+ $S0 .= url
+ $S0 .= " HTTP/1.0\r\nUser-agent: Parrot\r\n\r\n"
+ ret = sock.'send'($S0)
+MORE:
+ buf = sock.'recv'()
+ ret = length buf
+ if ret <= 0 goto END
+ json_result .= buf
+ goto MORE
+ERR:
+ print "Socket error\n"
+ end
+END:
+ close sock
+
+ $I1 = find_charset 'unicode'
+ trans_charset json_result, $I1
+
+ # Strip off http headers.
+ $I0 = index json_result, "\r\n\r\n"
+ substr json_result, 0, $I0, ""
+
+ load_bytecode 'compilers/json/JSON.pbc'
+ $P1 = compreg 'JSON'
+ $P2 = $P1(json_result)
+
+ $P3 = $P2['error']
+ unless null $P3 goto bad_code
+
+ $P2 = $P2['postalCodes']
+ .local pmc iter, code
+ iter = new 'Iterator', $P2
+
+ code_loop:
+ push_eh code_end
+ code = shift iter
+ pop_eh
+ unless code goto code_end
+
+ $S0 = code['placeName']
+ print "Place: "
+ print $S0
+ print ', '
+ $S0 = code['countryCode']
+ print $S0
+ print '; Code: '
+ $S0 = code['postalCode']
+ print $S0
+ print "\n"
+
+ goto code_loop
+ code_end:
+
+ end
+
+bad_args:
+ say "Usage: postcalcodes.pir <postal>"
+ .return()
+
+bad_code:
+ say $P3
+.end
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
Copied: branches/pmc_pct/examples/json/test.pir (from r39376, trunk/examples/json/test.pir)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/pmc_pct/examples/json/test.pir Thu Jun 4 02:32:48 2009 (r39377, copy of r39376, trunk/examples/json/test.pir)
@@ -0,0 +1,35 @@
+#!../../parrot
+# Copyright (C) 2006-2009, Parrot Foundation.
+# $Id$
+
+.sub main :main
+ .param pmc argv
+
+ .local int argc
+ argc = elements argv
+
+ if argc != 2 goto bad_args
+
+ load_bytecode 'PGE.pbc'
+ load_bytecode 'PGE/Util.pbc'
+ load_bytecode 'compilers/json/JSON.pbc'
+
+ .local pmc JSON
+ JSON = compreg "JSON"
+ $S0 = argv[1]
+ $P1 = JSON($S0)
+
+ load_bytecode 'dumper.pbc'
+ _dumper($P1, "JSON")
+ end
+
+ bad_args:
+ say "must specify a single arg."
+ end
+.end
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
Modified: branches/pmc_pct/examples/languages/abc/config/makefiles/root.in
==============================================================================
--- branches/pmc_pct/examples/languages/abc/config/makefiles/root.in Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/examples/languages/abc/config/makefiles/root.in Thu Jun 4 02:32:48 2009 (r39377)
@@ -8,7 +8,7 @@
VERSION := @versiondir@
BIN_DIR := @bindir@
LIB_DIR := @libdir@$(VERSION)
-DOC_DIR := @doc_dir@$(VERSION)
+DOC_DIR := @docdir@$(VERSION)
MANDIR := @mandir@$(VERSION)
# Set up extensions
Modified: branches/pmc_pct/examples/languages/abc/src/parser/actions.pm
==============================================================================
--- branches/pmc_pct/examples/languages/abc/src/parser/actions.pm Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/examples/languages/abc/src/parser/actions.pm Thu Jun 4 02:32:48 2009 (r39377)
@@ -33,10 +33,10 @@
=item
-The C<make> function and C< $(...) > are used to set and retrieve
+The C<make> function and C< .ast > are used to set and retrieve
the I<result object> for a match. Here, we use the result object
to hold the ast representation of any given match. So, in the
-code below, whenever you see an expression like C<< $($<foo>) >>,
+code below, whenever you see an expression like C<< $<foo>.ast >>,
we're really saying "the ast of C<< <foo> >>".
=back
@@ -48,7 +48,7 @@
## The ast of the entire program is the ast of the
## top-level <statement_list>.
method TOP($/) {
- make $($<statement_list>);
+ make $<statement_list>.ast;
}
@@ -61,7 +61,7 @@
method statement_list($/) {
my $past := PAST::Stmts.new( :node($/) );
for $<statement> {
- $past.push( $($_) );
+ $past.push( $_.ast );
}
make $past;
}
@@ -71,7 +71,7 @@
## In the parse grammar, we've set up $key to tell us the
## name of whatever subrule was matched by this statement.
## We can then use $key to quickly get the subrule's ast
-## with $( $/{$key} ).
+## with $/{$key}.ast .
##
## bc(1) expression statements also have special semantics
## which we handle here. If a statement is an expression
@@ -81,7 +81,7 @@
## Similarly, if the statement consists of a simple string, it's
## displayed on the output.
method statement($/, $key) {
- my $past := $( $/{$key} );
+ my $past := $/{$key}.ast;
if ($key eq 'expression' && ~$past.name() ne 'infix:=') {
my $last := PAST::Var.new( :name('last'),
:scope('package'),
@@ -109,12 +109,12 @@
## matches and set them as the children of a
## PAST::Op node with a pasttype of 'if'.
method if_statement($/) {
- my $past := PAST::Op.new( $($<expression>),
- $( $<statement>[0] ),
+ my $past := PAST::Op.new( $<expression>.ast,
+ $<statement>[0].ast,
:pasttype('if'),
:node( $/ ) );
if ( $<statement>[1] ) {
- $past.push( $( $<statement>[1] ) );
+ $past.push( $<statement>[1].ast );
}
make $past;
}
@@ -124,8 +124,8 @@
## This is basically the same as if_statement above, except
## we use a pasttype of 'while'.
method while_statement($/) {
- make PAST::Op.new( $($<expression>),
- $($<statement>),
+ make PAST::Op.new( $<expression>.ast,
+ $<statement>.ast,
:pasttype('while'),
:node($/) );
}
@@ -140,13 +140,13 @@
my $past := PAST::Stmts.new( :node($/) );
# add the initial "expr0;" node
- $past.push( $( $<expression>[0] ) );
+ $past.push( $<expression>[0].ast );
# create the "{ body; expr2; }" part
- my $body := PAST::Stmts.new( $($<statement>), $($<expression>[2]) );
+ my $body := PAST::Stmts.new( $<statement>.ast, $<expression>[2].ast );
# now create the "while (expr1) { body; expr2; }" part
- $past.push( PAST::Op.new( $($<expression>[1]), $body, :pasttype('while')));
+ $past.push( PAST::Op.new( $<expression>[1].ast, $body, :pasttype('while')));
make $past;
}
@@ -156,7 +156,7 @@
## A compound statement is just a list of statements, so we
## return the ast of its embedded <statement_list>.
method compound_statement($/) {
- make $($<statement_list>);
+ make $<statement_list>.ast;
}
@@ -182,7 +182,7 @@
## is invoked with the expression in $<expr> and a $key of 'end'.
method expression($/, $key) {
if ($key eq 'end') {
- make $($<expr>);
+ make $<expr>.ast;
}
else {
my $past := PAST::Op.new( :name($<type>),
@@ -192,7 +192,7 @@
:node($/)
);
for @($/) {
- $past.push( $($_) );
+ $past.push( $_.ast );
}
make $past;
}
@@ -203,7 +203,7 @@
## Like 'statement' above, the $key has been set to let us know
## which term subrule was matched.
method term($/, $key) {
- make $( $/{$key} );
+ make $/{$key}.ast;
}
## float/integer:
@@ -246,7 +246,7 @@
);
}
if ($key eq 'call') {
- $past := PAST::Op.new( $($<expression>),
+ $past := PAST::Op.new( $<expression>.ast,
:name( ~$<name> ),
:pasttype('call'),
:node( $/ )
Modified: branches/pmc_pct/examples/languages/squaak/config/makefiles/root.in
==============================================================================
--- branches/pmc_pct/examples/languages/squaak/config/makefiles/root.in Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/examples/languages/squaak/config/makefiles/root.in Thu Jun 4 02:32:48 2009 (r39377)
@@ -8,7 +8,7 @@
VERSION := @versiondir@
BIN_DIR := @bindir@
LIB_DIR := @libdir@$(VERSION)
-DOC_DIR := @doc_dir@$(VERSION)
+DOC_DIR := @docdir@$(VERSION)
MANDIR := @mandir@$(VERSION)
# Set up extensions
Modified: branches/pmc_pct/examples/library/pcre.pir
==============================================================================
--- branches/pmc_pct/examples/library/pcre.pir Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/examples/library/pcre.pir Thu Jun 4 02:32:48 2009 (r39377)
@@ -21,10 +21,6 @@
=cut
-
-.include 'library/pcre.pir'
-
-
.sub main :main
.param pmc argv
@@ -35,6 +31,7 @@
.local pmc func
.local pmc lib
+ load_bytecode 'pcre.pbc'
func= get_hll_global ['PCRE'], 'init'
lib= func()
Modified: branches/pmc_pct/examples/namespace/namespace_dump.pir
==============================================================================
--- branches/pmc_pct/examples/namespace/namespace_dump.pir Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/examples/namespace/namespace_dump.pir Thu Jun 4 02:32:48 2009 (r39377)
@@ -80,6 +80,7 @@
print spac
$P0 = multi[i]
$P1 = $P0."get_multisig"()
+ if null $P1 goto next_loop
m = elements $P1
j = 0
lp2:
@@ -90,6 +91,7 @@
if j < m goto lp2
print "\n"
+next_loop:
inc i
if i < n goto loop
.end
Modified: branches/pmc_pct/examples/nci/xlibtest.pir
==============================================================================
--- branches/pmc_pct/examples/nci/xlibtest.pir Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/examples/nci/xlibtest.pir Thu Jun 4 02:32:48 2009 (r39377)
@@ -11,16 +11,25 @@
Compile Xlib.pir to Xlib.pbc before usage:
-../../parrot -o Xlib.pbc Xlib.pir
+../../parrot -o Xlib.pbc Xlib.pir [ filename ]
Press Escape key to exit.
-=cut
+Press S to save to filename
+=cut
.include 'Xlibconstants.pir'
+# Key for JSON line data
+.const string JKEY_LINES = 'lines'
+
.sub main :main
+ .param pmc args
+
+ .local string filename
+ filename = args [1]
+ say filename
load_bytecode 'Xlib.pbc'
@@ -82,8 +91,18 @@
codeEscape = display.'KeysymToKeycode'($I0)
# say codeEscape
+ $I0 = StringToKeysym('S')
+# print $I0
+# print '-'
+ .local int codeS
+ codeS = display.'KeysymToKeycode'($I0)
+# say codeS
+
.local pmc listline
- listline = new 'ResizablePMCArray'
+ listline = load(filename)
+
+mainloop:
+
.local pmc line
# Event loop
@@ -131,16 +150,24 @@
# say $S0
# eq $S0, 'Escape', finish
- ne $I0, codeEscape, loop
+ if $I0 == codeEscape goto handleescape
+ if $I0 == codeS goto handleS
+ goto loop
+handleescape:
w.'Unmap'()
w.'Destroy'()
goto loop
+handleS:
+ say 'S'
+ save(filename, listline)
+ goto loop
+
press:
lastpx = event.'x'()
lastpy = event.'y'()
w.'DrawPoint'(lastpx, lastpy)
- line = new 'ResizableIntegerArray'
+ line = new [ 'ResizableIntegerArray' ]
push listline, line
push line, lastpx
push line, lastpy
@@ -243,6 +270,72 @@
.end
#-----------------------------------------------------------------------
+.sub load
+ .param string filename
+ .local pmc listline
+ if null filename goto newfile
+
+ push_eh newfile
+ .local pmc handle
+ handle = open filename, 'r'
+ pop_eh
+
+ push_eh failed
+ .local string jsonfile
+ jsonfile = handle.'readall'()
+ close handle
+
+ load_bytecode 'compilers/json/JSON.pbc'
+ .local pmc json
+ json = compreg 'JSON'
+ .local pmc jsonobject
+ jsonobject = json(jsonfile)
+ listline = jsonobject [JKEY_LINES]
+ goto finish
+
+failed:
+ .local pmc exception
+ .get_results(exception)
+ pop_eh
+ print "\nERROR LOADING FILE: "
+ print exception
+ print "\n\n"
+
+newfile:
+ listline = new [ 'ResizablePMCArray' ]
+finish:
+ .return(listline)
+.end
+
+#-----------------------------------------------------------------------
+.sub save
+ .param string filename
+ .param pmc listline
+
+ push_eh failed
+ load_bytecode 'JSON.pbc'
+
+ .local pmc jsondata
+ jsondata = new [ 'Hash' ]
+ jsondata [JKEY_LINES] = listline
+ .local string jsonfile
+ jsonfile = _json(jsondata)
+ .local pmc handle
+ handle = open filename, 'w'
+ print handle, jsonfile
+ print handle, "\n"
+ close handle
+ .return()
+failed:
+ .local pmc exception
+ .get_results(exception)
+ pop_eh
+ print "\nERROR SAVING FILE: "
+ print exception
+ print "\n\n"
+.end
+
+#-----------------------------------------------------------------------
# Local Variables:
# mode: pir
# fill-column: 100
Modified: branches/pmc_pct/examples/pir/befunge/config/makefiles/root.in
==============================================================================
--- branches/pmc_pct/examples/pir/befunge/config/makefiles/root.in Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/examples/pir/befunge/config/makefiles/root.in Thu Jun 4 02:32:48 2009 (r39377)
@@ -8,7 +8,7 @@
VERSION := @versiondir@
BIN_DIR := @bindir@
LIB_DIR := @libdir@$(VERSION)
-DOC_DIR := @doc_dir@$(VERSION)
+DOC_DIR := @docdir@$(VERSION)
MANDIR := @mandir@$(VERSION)
# Set up extensions
Modified: branches/pmc_pct/examples/streams/Bytes.pir
==============================================================================
--- branches/pmc_pct/examples/streams/Bytes.pir Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/examples/streams/Bytes.pir Thu Jun 4 02:32:48 2009 (r39377)
@@ -22,7 +22,7 @@
$P0 = new ['Stream'; 'Sub']
# set the stream's source sub
.const 'Sub' temp = "_hello"
- assign $P0, $P1
+ assign $P0, temp
stream = new ['Stream'; 'Replay']
assign stream, $P0
Modified: branches/pmc_pct/examples/tcl/tcltkdemo.pir
==============================================================================
--- branches/pmc_pct/examples/tcl/tcltkdemo.pir Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/examples/tcl/tcltkdemo.pir Thu Jun 4 02:32:48 2009 (r39377)
@@ -2,9 +2,8 @@
# $Id$
# demonstrate Tcl/Tk GUI using NCI
-.include 'runtime/parrot/library/TclLibrary.pir'
-
.sub try :main
+ load_bytecode 'TclLibrary.pbc'
.local pmc tcl
tcl = new 'TclLibrary'
.local string res
Modified: branches/pmc_pct/ext/SQLite3/Makefile.in
==============================================================================
--- branches/pmc_pct/ext/SQLite3/Makefile.in Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/ext/SQLite3/Makefile.in Thu Jun 4 02:32:48 2009 (r39377)
@@ -10,10 +10,10 @@
PREFIX = @prefix@
EXEC_PREFIX = @exec_prefix@
DESTDIR =
-BIN_DIR = @bin_dir@
-LIB_DIR = @lib_dir@
-INCLUDE_DIR = @include_dir@
-DOC_DIR = @doc_dir@
+BIN_DIR = @bindir@
+LIB_DIR = @libdir@
+INCLUDE_DIR = @includedir@
+DOC_DIR = @docdir@
INC_DIR = @inc@
RM_F = @rm_f@
RM_RF = @rm_rf@
Modified: branches/pmc_pct/include/parrot/charset.h
==============================================================================
--- branches/pmc_pct/include/parrot/charset.h Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/include/parrot/charset.h Thu Jun 4 02:32:48 2009 (r39377)
@@ -152,10 +152,9 @@
CHARSET * Parrot_new_charset(SHIM_INTERP);
PARROT_EXPORT
-INTVAL Parrot_register_charset(PARROT_INTERP,
+INTVAL Parrot_register_charset(SHIM_INTERP,
ARGIN(const char *charsetname),
ARGIN(CHARSET *charset))
- __attribute__nonnull__(1)
__attribute__nonnull__(2)
__attribute__nonnull__(3);
@@ -194,8 +193,7 @@
PARROT_ASSERT_ARG(charset)
#define ASSERT_ARGS_Parrot_new_charset __attribute__unused__ int _ASSERT_ARGS_CHECK = 0
#define ASSERT_ARGS_Parrot_register_charset __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(charsetname) \
+ PARROT_ASSERT_ARG(charsetname) \
|| PARROT_ASSERT_ARG(charset)
#define ASSERT_ARGS_Parrot_register_charset_converter \
__attribute__unused__ int _ASSERT_ARGS_CHECK = \
Modified: branches/pmc_pct/include/parrot/compiler.h
==============================================================================
--- branches/pmc_pct/include/parrot/compiler.h Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/include/parrot/compiler.h Thu Jun 4 02:32:48 2009 (r39377)
@@ -111,7 +111,7 @@
/* UNUSED() is the old way we handled shim arguments Should still be
used in cases where the argument should, at some point be used.
*/
-#define UNUSED(a) if (0) (void)(a);
+#define UNUSED(a) /*@-noeffect*/if (0) (void)(a)/*@=noeffect*/;
#if PARROT_HAS_SAL
# define PARROT_CAN_RETURN_NULL /*@null@*/ __maybenull
@@ -132,6 +132,11 @@
#define PARROT_DOES_NOT_RETURN_WHEN_FALSE /*@noreturnwhenfalse@*/
#define PARROT_MALLOC /*@only@*/ __attribute__malloc__ __attribute__warn_unused_result__
+/* Macros for exposure tracking for splint. */
+/* See http://www.splint.org/manual/html/all.html section 6.2 */
+#define PARROT_OBSERVER /*@observer@*/
+#define PARROT_EXPOSED /*@exposed@*/
+
/* Function argument instrumentation */
/* For explanations of the annotations, see http://www.splint.org/manual/manual.html */
Modified: branches/pmc_pct/include/parrot/datatypes.h
==============================================================================
--- branches/pmc_pct/include/parrot/datatypes.h Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/include/parrot/datatypes.h Thu Jun 4 02:32:48 2009 (r39377)
@@ -143,8 +143,7 @@
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
PARROT_EXPORT
-FLOATVAL floatval_divide_by_zero(PARROT_INTERP, FLOATVAL num)
- __attribute__nonnull__(1);
+FLOATVAL floatval_divide_by_zero(SHIM_INTERP, FLOATVAL num);
PARROT_EXPORT
PARROT_WARN_UNUSED_RESULT
@@ -159,8 +158,7 @@
STRING * Parrot_get_datatype_name(PARROT_INTERP, INTVAL type)
__attribute__nonnull__(1);
-#define ASSERT_ARGS_floatval_divide_by_zero __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp)
+#define ASSERT_ARGS_floatval_divide_by_zero __attribute__unused__ int _ASSERT_ARGS_CHECK = 0
#define ASSERT_ARGS_Parrot_get_datatype_enum __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
|| PARROT_ASSERT_ARG(type_name)
Modified: branches/pmc_pct/include/parrot/encoding.h
==============================================================================
--- branches/pmc_pct/include/parrot/encoding.h Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/include/parrot/encoding.h Thu Jun 4 02:32:48 2009 (r39377)
@@ -29,6 +29,7 @@
typedef void (*encoding_become_encoding_t)(PARROT_INTERP, STRING *src);
typedef UINTVAL (*encoding_codepoints_t)(PARROT_INTERP, STRING *src);
typedef UINTVAL (*encoding_bytes_t)(PARROT_INTERP, STRING *src);
+typedef UINTVAL (*encoding_find_cclass_t)(PARROT_INTERP, STRING *s, const INTVAL *typetable, INTVAL flags, UINTVAL offset, UINTVAL count);
/* iterator support */
@@ -55,6 +56,7 @@
encoding_codepoints_t codepoints;
encoding_bytes_t bytes;
encoding_iter_init_t iter_init;
+ encoding_find_cclass_t find_cclass;
};
typedef struct _encoding ENCODING;
@@ -218,6 +220,8 @@
((src)->encoding)->bytes((i), (src))
#define ENCODING_ITER_INIT(i, src, iter) \
((src)->encoding)->iter_init((i), (src), (iter))
+#define ENCODING_FIND_CCLASS(i, src, typetable, flags, pos, end) \
+ ((src)->encoding)->find_cclass((i), (src), (typetable), (flags), (pos), (end))
#endif /* PARROT_ENCODING_H_GUARD */
Modified: branches/pmc_pct/include/parrot/exceptions.h
==============================================================================
--- branches/pmc_pct/include/parrot/exceptions.h Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/include/parrot/exceptions.h Thu Jun 4 02:32:48 2009 (r39377)
@@ -276,7 +276,7 @@
* int _ASSERT_ARGS = PARROT_ASSERT_ARG(a) || PARROT_ASSERT_ARG(b) || ...
*/
#ifdef NDEBUG
-# define PARROT_ASSERT(x) ((void)0)
+# define PARROT_ASSERT(x) /*@-noeffect@*/((void)0)/*@=noeffect@*/
# define PARROT_ASSERT_ARG(x) (0)
# define ASSERT_ARGS(a)
#else
Modified: branches/pmc_pct/include/parrot/gc_api.h
==============================================================================
--- branches/pmc_pct/include/parrot/gc_api.h Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/include/parrot/gc_api.h Thu Jun 4 02:32:48 2009 (r39377)
@@ -70,9 +70,9 @@
} Memory_Pool;
typedef enum {
- GC_TRACE_FULL,
- GC_TRACE_ROOT_ONLY,
- GC_TRACE_SYSTEM_ONLY
+ GC_TRACE_FULL = 1,
+ GC_TRACE_ROOT_ONLY = 2,
+ GC_TRACE_SYSTEM_ONLY = 3
} Parrot_gc_trace_type;
typedef void (*add_free_object_fn_type)(PARROT_INTERP, struct Small_Object_Pool *, void *);
Modified: branches/pmc_pct/include/parrot/interpreter.h
==============================================================================
--- branches/pmc_pct/include/parrot/interpreter.h Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/include/parrot/interpreter.h Thu Jun 4 02:32:48 2009 (r39377)
@@ -195,38 +195,40 @@
struct Parrot_Context {
/* common header with Interp_Context */
- struct Parrot_Context *caller_ctx; /* caller context */
- Regs_ni bp; /* pointers to FLOATVAL & INTVAL */
- Regs_ps bp_ps; /* pointers to PMC & STR */
+ struct Parrot_Context *caller_ctx; /* caller context */
+ Regs_ni bp; /* pointers to FLOATVAL & INTVAL */
+ Regs_ps bp_ps; /* pointers to PMC & STR */
/* end common header */
- INTVAL *n_regs_used; /* INSP in PBC points to Sub */
- size_t regs_mem_size; /* memory occupied by registers */
- int ref_count; /* how often refered to */
- int gc_mark; /* marked in gc run */
-
- PMC *lex_pad; /* LexPad PMC */
- struct Parrot_Context *outer_ctx; /* outer context, if a closure */
- UINTVAL warns; /* Keeps track of what warnings
- * have been activated */
- UINTVAL errors; /* fatals that can be turned off */
- UINTVAL trace_flags;
- UINTVAL recursion_depth; /* Sub call recursion depth */
+ INTVAL n_regs_used[4]; /* INSP in PBC points to Sub */
+ PMC *lex_pad; /* LexPad PMC */
+ struct Parrot_Context *outer_ctx; /* outer context, if a closure */
/* new call scheme and introspective variables */
- PMC *current_sub; /* the Sub we are executing */
+ PMC *current_sub; /* the Sub we are executing */
/* for now use a return continuation PMC */
- PMC *current_cont; /* the return continuation PMC */
- PMC *current_object; /* current object if a method call */
- opcode_t *current_pc; /* program counter of Sub invocation */
- PMC *current_namespace; /* The namespace we're currently in */
- INTVAL current_HLL; /* see also src/hll.c */
- opcode_t *current_results; /* ptr into code with get_results opcode */
- PMC *results_signature; /* results signature pmc if it is non-const */
- PMC *handlers; /* local handlers for the context */
+ PMC *handlers; /* local handlers for the context */
+ PMC *current_cont; /* the return continuation PMC */
+ PMC *current_object; /* current object if a method call */
+ PMC *current_namespace; /* The namespace we're currently in */
+ PMC *results_signature; /* non-const results signature PMC */
+ opcode_t *current_pc; /* program counter of Sub invocation */
+ opcode_t *current_results; /* ptr into code with get_results opcode */
+
/* deref the constants - we need it all the time */
- struct PackFile_Constant ** constants;
+ struct PackFile_Constant **constants;
+
+ INTVAL current_HLL; /* see also src/hll.c */
+ size_t regs_mem_size; /* memory occupied by registers */
+ int ref_count; /* how often refered to */
+ int gc_mark; /* marked in gc run */
+
+ UINTVAL warns; /* Keeps track of what warnings
+ * have been activated */
+ UINTVAL errors; /* fatals that can be turned off */
+ UINTVAL trace_flags;
+ UINTVAL recursion_depth; /* Sub call recursion depth */
/* code->prederefed.code - code->base.data in opcodes
* to simplify conversion between code ptrs in e.g. invoke */
@@ -636,7 +638,7 @@
void register_raw_nci_method_in_ns(PARROT_INTERP,
const int type,
ARGIN(void *func),
- ARGIN(const char *name))
+ ARGIN(STRING *name))
__attribute__nonnull__(1)
__attribute__nonnull__(3)
__attribute__nonnull__(4);
Modified: branches/pmc_pct/include/parrot/io.h
==============================================================================
--- branches/pmc_pct/include/parrot/io.h Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/include/parrot/io.h Thu Jun 4 02:32:48 2009 (r39377)
@@ -101,8 +101,6 @@
extern PIOOFF_T piooffsetzero;
-typedef struct _ParrotIOFilter ParrotIOFilter;
-typedef struct _ParrotIO ParrotIO;
typedef struct _ParrotIOData ParrotIOData;
#ifdef _MSC_VER
Modified: branches/pmc_pct/include/parrot/io_win32.h
==============================================================================
--- branches/pmc_pct/include/parrot/io_win32.h Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/include/parrot/io_win32.h Thu Jun 4 02:32:48 2009 (r39377)
@@ -49,10 +49,13 @@
PARROT_WARN_UNUSED_RESULT
PARROT_CAN_RETURN_NULL
PMC * Parrot_io_open_pipe_win32(PARROT_INTERP,
- SHIM(PMC *filehandle),
- SHIM(STRING *command),
+ ARGMOD(PMC *filehandle),
+ ARGIN(STRING *command),
int flags)
- __attribute__nonnull__(1);
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ __attribute__nonnull__(3)
+ FUNC_MODIFIES(*filehandle);
PARROT_CAN_RETURN_NULL
PMC * Parrot_io_open_win32(PARROT_INTERP,
@@ -112,7 +115,9 @@
PARROT_ASSERT_ARG(interp) \
|| PARROT_ASSERT_ARG(filehandle)
#define ASSERT_ARGS_Parrot_io_open_pipe_win32 __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp)
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(filehandle) \
+ || PARROT_ASSERT_ARG(command)
#define ASSERT_ARGS_Parrot_io_open_win32 __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
|| PARROT_ASSERT_ARG(filehandle) \
Modified: branches/pmc_pct/include/parrot/memory.h
==============================================================================
--- branches/pmc_pct/include/parrot/memory.h Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/include/parrot/memory.h Thu Jun 4 02:32:48 2009 (r39377)
@@ -41,7 +41,7 @@
#define mem_realloc_n_typed(p, n, type) (p) = (type *)mem_sys_realloc((p), (n)*sizeof(type))
#define mem_copy_n_typed(dest, src, n, type) memcpy((dest), (src), (n)*sizeof(type))
-/* HEADERIZER BEGIN: src/gc/memory.c */
+/* HEADERIZER BEGIN: src/gc/alloc_memory.c */
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
PARROT_EXPORT
@@ -127,7 +127,7 @@
#define ASSERT_ARGS_mem__internal_realloc_zeroed __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(file)
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
-/* HEADERIZER END: src/gc/memory.c */
+/* HEADERIZER END: src/gc/alloc_memory.c */
#endif /* PARROT_MEMORY_H_GUARD */
Modified: branches/pmc_pct/include/parrot/oo.h
==============================================================================
--- branches/pmc_pct/include/parrot/oo.h Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/include/parrot/oo.h Thu Jun 4 02:32:48 2009 (r39377)
@@ -96,8 +96,7 @@
PARROT_EXPORT
PARROT_PURE_FUNCTION
PARROT_CAN_RETURN_NULL
-const char * Parrot_get_vtable_name(PARROT_INTERP, INTVAL idx)
- __attribute__nonnull__(1);
+const char * Parrot_get_vtable_name(SHIM_INTERP, INTVAL idx);
PARROT_EXPORT
void Parrot_invalidate_method_cache(PARROT_INTERP,
@@ -132,6 +131,16 @@
void mark_object_cache(PARROT_INTERP)
__attribute__nonnull__(1);
+PARROT_CANNOT_RETURN_NULL
+PMC * Parrot_oo_clone_object(PARROT_INTERP,
+ ARGIN(PMC * pmc),
+ ARGMOD_NULLOK(PMC * class_),
+ ARGMOD_NULLOK(PMC * dest))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ FUNC_MODIFIES(* class_)
+ FUNC_MODIFIES(* dest);
+
void Parrot_oo_extract_methods_from_namespace(PARROT_INTERP,
ARGIN(PMC *self),
ARGIN(PMC *ns))
@@ -162,6 +171,11 @@
PMC * Parrot_oo_get_namespace(SHIM_INTERP, ARGIN(const PMC *classobj))
__attribute__nonnull__(2);
+PARROT_CANNOT_RETURN_NULL
+void * Parrot_oo_new_object_attrs(PARROT_INTERP, ARGIN(PMC * class_))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
PARROT_CAN_RETURN_NULL
PARROT_WARN_UNUSED_RESULT
PMC * Parrot_oo_newclass_from_str(PARROT_INTERP, ARGIN(STRING *name))
@@ -197,8 +211,7 @@
#define ASSERT_ARGS_Parrot_get_vtable_index __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
|| PARROT_ASSERT_ARG(name)
-#define ASSERT_ARGS_Parrot_get_vtable_name __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp)
+#define ASSERT_ARGS_Parrot_get_vtable_name __attribute__unused__ int _ASSERT_ARGS_CHECK = 0
#define ASSERT_ARGS_Parrot_invalidate_method_cache \
__attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp)
@@ -215,6 +228,9 @@
PARROT_ASSERT_ARG(interp)
#define ASSERT_ARGS_mark_object_cache __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp)
+#define ASSERT_ARGS_Parrot_oo_clone_object __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(pmc)
#define ASSERT_ARGS_Parrot_oo_extract_methods_from_namespace \
__attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
@@ -232,6 +248,9 @@
|| PARROT_ASSERT_ARG(name)
#define ASSERT_ARGS_Parrot_oo_get_namespace __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(classobj)
+#define ASSERT_ARGS_Parrot_oo_new_object_attrs __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(class_)
#define ASSERT_ARGS_Parrot_oo_newclass_from_str __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
|| PARROT_ASSERT_ARG(name)
Modified: branches/pmc_pct/include/parrot/packfile.h
==============================================================================
--- branches/pmc_pct/include/parrot/packfile.h Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/include/parrot/packfile.h Thu Jun 4 02:32:48 2009 (r39377)
@@ -563,12 +563,11 @@
PARROT_WARN_UNUSED_RESULT
PARROT_CAN_RETURN_NULL
const opcode_t * PackFile_ConstTable_unpack(PARROT_INTERP,
- ARGOUT(PackFile_Segment *seg),
+ ARGIN(PackFile_Segment *seg),
ARGIN(const opcode_t *cursor))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
- __attribute__nonnull__(3)
- FUNC_MODIFIES(*seg);
+ __attribute__nonnull__(3);
PARROT_EXPORT
void PackFile_destroy(PARROT_INTERP, ARGMOD_NULLOK(PackFile *pf))
Modified: branches/pmc_pct/include/parrot/pmc.h
==============================================================================
--- branches/pmc_pct/include/parrot/pmc.h Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/include/parrot/pmc.h Thu Jun 4 02:32:48 2009 (r39377)
@@ -76,6 +76,7 @@
PARROT_EXPORT
PARROT_CANNOT_RETURN_NULL
+PARROT_IGNORABLE_RESULT
PMC * pmc_reuse(PARROT_INTERP,
ARGIN(PMC *pmc),
INTVAL new_type,
@@ -84,6 +85,18 @@
__attribute__nonnull__(2);
PARROT_EXPORT
+PARROT_CANNOT_RETURN_NULL
+PARROT_IGNORABLE_RESULT
+PMC * pmc_reuse_by_class(PARROT_INTERP,
+ ARGMOD(PMC * pmc),
+ ARGIN(PMC * class_),
+ UINTVAL flags)
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ __attribute__nonnull__(3)
+ FUNC_MODIFIES(* pmc);
+
+PARROT_EXPORT
PARROT_WARN_UNUSED_RESULT
INTVAL pmc_type(PARROT_INTERP, ARGIN_NULLOK(STRING *name))
__attribute__nonnull__(1);
@@ -134,6 +147,10 @@
#define ASSERT_ARGS_pmc_reuse __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
|| PARROT_ASSERT_ARG(pmc)
+#define ASSERT_ARGS_pmc_reuse_by_class __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(pmc) \
+ || PARROT_ASSERT_ARG(class_)
#define ASSERT_ARGS_pmc_type __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp)
#define ASSERT_ARGS_pmc_type_p __attribute__unused__ int _ASSERT_ARGS_CHECK = \
Modified: branches/pmc_pct/include/parrot/pmc_freeze.h
==============================================================================
--- branches/pmc_pct/include/parrot/pmc_freeze.h Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/include/parrot/pmc_freeze.h Thu Jun 4 02:32:48 2009 (r39377)
@@ -14,7 +14,7 @@
#define PARROT_PMC_FREEZE_H_GUARD
struct _visit_info;
-typedef void (*visit_f)(PARROT_INTERP, PMC*, struct _visit_info*);
+typedef void (*visit_f)(PARROT_INTERP, ARGIN_NULLOK(PMC*), ARGIN(struct _visit_info*));
typedef enum {
VISIT_FREEZE_NORMAL,
Modified: branches/pmc_pct/include/parrot/pobj.h
==============================================================================
--- branches/pmc_pct/include/parrot/pobj.h Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/include/parrot/pobj.h Thu Jun 4 02:32:48 2009 (r39377)
@@ -56,7 +56,7 @@
#define PObj_bufstart(pmc) (pmc)->cache._b._bufstart
#define PObj_buflen(pmc) (pmc)->cache._b._buflen
-/* See src/gc/resources.c. the basic idea is that buffer memory is
+/* See src/gc/alloc_resources.c. the basic idea is that buffer memory is
set up as follows:
+-----------------+
| ref_count |f | # GC header
@@ -70,11 +70,11 @@
is also suitably aligned for any use. If, for example, malloc() returns
objects aligned on 8-byte boundaries, and obj->bufstart is also aligned
on 8-byte boundaries, then there should be 4 bytes of padding. It is
-handled differently in the two files resources.c and res_lea.c.
-In resources.c, the buffer is carved out of a larger memory pool. In
+handled differently in the two files alloc_resources.c and res_lea.c.
+In alloc_resources.c, the buffer is carved out of a larger memory pool. In
res_lea.c, each buffer is individually allocated.
- src/gc/resources.c: src/gc/res_lea.c:
+ src/gc/alloc_resources.c: src/gc/res_lea.c:
ptr from malloc -> +------------------+ +------------------+
[other blocks?] | INTVAL ref_count |
@@ -97,7 +97,7 @@
# define PObj_bufallocstart(b) ((char *)PObj_bufstart(b) - Buffer_alloc_offset)
# define PObj_bufrefcount(b) (((Buffer_alloc_unit *)PObj_bufallocstart(b))->ref_count)
# define PObj_bufrefcountptr(b) (&PObj_bufrefcount(b))
-#else /* see src/gc/resources.c */
+#else /* see src/gc/alloc_resources.c */
# define Buffer_alloc_offset sizeof (INTVAL)
# define PObj_bufallocstart(b) ((char *)PObj_bufstart(b) - Buffer_alloc_offset)
# define PObj_bufrefcount(b) (*(INTVAL *)PObj_bufallocstart(b))
Modified: branches/pmc_pct/include/parrot/register.h
==============================================================================
--- branches/pmc_pct/include/parrot/register.h Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/include/parrot/register.h Thu Jun 4 02:32:48 2009 (r39377)
@@ -60,7 +60,7 @@
struct Stack_Chunk;
typedef struct Parrot_Context Parrot_Context; /* parrot/interpreter.h */
-/* HEADERIZER BEGIN: src/gc/register.c */
+/* HEADERIZER BEGIN: src/gc/alloc_register.c */
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
PARROT_EXPORT
@@ -172,7 +172,7 @@
PARROT_ASSERT_ARG(interp) \
|| PARROT_ASSERT_ARG(number_regs_used)
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
-/* HEADERIZER END: src/gc/register.c */
+/* HEADERIZER END: src/gc/alloc_register.c */
#endif /* PARROT_REGISTER_H_GUARD */
Modified: branches/pmc_pct/include/parrot/runcore_api.h
==============================================================================
--- branches/pmc_pct/include/parrot/runcore_api.h Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/include/parrot/runcore_api.h Thu Jun 4 02:32:48 2009 (r39377)
@@ -14,6 +14,66 @@
# define DO_OP(PC, INTERP) ((PC) = (((INTERP)->op_func_table)[*(PC)])((PC), (INTERP)))
+/* HEADERIZER BEGIN: src/runcore/main.c */
+/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
+
+PARROT_EXPORT
+void disable_event_checking(PARROT_INTERP)
+ __attribute__nonnull__(1);
+
+PARROT_EXPORT
+void enable_event_checking(PARROT_INTERP)
+ __attribute__nonnull__(1);
+
+void do_prederef(void **pc_prederef, PARROT_INTERP, int type)
+ __attribute__nonnull__(2);
+
+void dynop_register(PARROT_INTERP, PMC *lib_pmc)
+ __attribute__nonnull__(1);
+
+void exec_init_prederef(PARROT_INTERP, void *prederef_arena)
+ __attribute__nonnull__(1);
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CAN_RETURN_NULL
+void * init_jit(PARROT_INTERP, SHIM(opcode_t *pc))
+ __attribute__nonnull__(1);
+
+void Parrot_runcore_destroy(PARROT_INTERP)
+ __attribute__nonnull__(1);
+
+void Parrot_setup_event_func_ptrs(PARROT_INTERP)
+ __attribute__nonnull__(1);
+
+void prepare_for_run(PARROT_INTERP)
+ __attribute__nonnull__(1);
+
+void runops_int(PARROT_INTERP, size_t offset)
+ __attribute__nonnull__(1);
+
+#define ASSERT_ARGS_disable_event_checking __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
+#define ASSERT_ARGS_enable_event_checking __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
+#define ASSERT_ARGS_do_prederef __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
+#define ASSERT_ARGS_dynop_register __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
+#define ASSERT_ARGS_exec_init_prederef __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
+#define ASSERT_ARGS_init_jit __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
+#define ASSERT_ARGS_Parrot_runcore_destroy __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
+#define ASSERT_ARGS_Parrot_setup_event_func_ptrs __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
+#define ASSERT_ARGS_prepare_for_run __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
+#define ASSERT_ARGS_runops_int __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
+/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
+/* HEADERIZER END: src/runcore/main.c */
+
/* HEADERIZER BEGIN: src/runcore/cores.c */
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
Modified: branches/pmc_pct/include/parrot/runcore_trace.h
==============================================================================
--- branches/pmc_pct/include/parrot/runcore_trace.h Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/include/parrot/runcore_trace.h Thu Jun 4 02:32:48 2009 (r39377)
@@ -18,6 +18,10 @@
/* HEADERIZER BEGIN: src/runcore/trace.c */
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
+PARROT_CANNOT_RETURN_NULL
+Interp * debugger_or_interp(PARROT_INTERP)
+ __attribute__nonnull__(1);
+
int trace_key_dump(PARROT_INTERP, ARGIN(PMC *key))
__attribute__nonnull__(1)
__attribute__nonnull__(2);
@@ -40,6 +44,8 @@
void trace_pmc_dump(PARROT_INTERP, ARGIN_NULLOK(PMC *pmc))
__attribute__nonnull__(1);
+#define ASSERT_ARGS_debugger_or_interp __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
#define ASSERT_ARGS_trace_key_dump __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
|| PARROT_ASSERT_ARG(key)
Modified: branches/pmc_pct/include/parrot/string_funcs.h
==============================================================================
--- branches/pmc_pct/include/parrot/string_funcs.h Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/include/parrot/string_funcs.h Thu Jun 4 02:32:48 2009 (r39377)
@@ -497,6 +497,16 @@
PARROT_EXPORT
PARROT_WARN_UNUSED_RESULT
+PARROT_CANNOT_RETURN_NULL
+STRING * string_make_from_charset(PARROT_INTERP,
+ ARGIN_NULLOK(const char *buffer),
+ UINTVAL len,
+ INTVAL charset_nr,
+ UINTVAL flags)
+ __attribute__nonnull__(1);
+
+PARROT_EXPORT
+PARROT_WARN_UNUSED_RESULT
INTVAL string_max_bytes(SHIM_INTERP, ARGIN(const STRING *s), UINTVAL nchars)
__attribute__nonnull__(2);
@@ -507,6 +517,7 @@
PARROT_EXPORT
PARROT_CANNOT_RETURN_NULL
+PARROT_OBSERVER
const char* string_primary_encoding_for_representation(PARROT_INTERP,
parrot_string_representation_t representation)
__attribute__nonnull__(1);
@@ -709,6 +720,8 @@
|| PARROT_ASSERT_ARG(s)
#define ASSERT_ARGS_string_make __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp)
+#define ASSERT_ARGS_string_make_from_charset __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
#define ASSERT_ARGS_string_max_bytes __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(s)
#define ASSERT_ARGS_string_ord __attribute__unused__ int _ASSERT_ARGS_CHECK = \
Modified: branches/pmc_pct/include/parrot/sub.h
==============================================================================
--- branches/pmc_pct/include/parrot/sub.h Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/include/parrot/sub.h Thu Jun 4 02:32:48 2009 (r39377)
@@ -178,7 +178,7 @@
else { \
(sub) = Parrot_get_sub_pmc_from_subclass((interp), (pmc)); \
} \
- } while (0);
+ } while (0)
/* the first entries must match Parrot_sub, so we can cast
* these two to the other type
Modified: branches/pmc_pct/lib/Parrot/Configure/Compiler.pm
==============================================================================
--- branches/pmc_pct/lib/Parrot/Configure/Compiler.pm Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/lib/Parrot/Configure/Compiler.pm Thu Jun 4 02:32:48 2009 (r39377)
@@ -54,6 +54,9 @@
perl => {
comment_type => '#',
},
+ pir => {
+ comment_type => '#',
+ },
);
=item C<cc_gen()>
@@ -359,6 +362,9 @@
elsif ($target =~ m/\.pmc$/ ) {
$options{file_type} = 'pmc';
}
+ elsif ($target =~ m/\.pir$/ ) {
+ $options{file_type} = 'pir';
+ }
} elsif ( $options{file_type} eq 'none' ) {
delete $options{file_type};
}
Modified: branches/pmc_pct/lib/Parrot/Distribution.pm
==============================================================================
--- branches/pmc_pct/lib/Parrot/Distribution.pm Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/lib/Parrot/Distribution.pm Thu Jun 4 02:32:48 2009 (r39377)
@@ -431,7 +431,7 @@
compilers/pirc/macro/macrolexer.h
compilers/pirc/macro/macroparser.c
compilers/pirc/macro/macroparser.h
- src/malloc.c
+ src/gc/malloc.c
} unless @exemptions;
my $path = -f $file ? $file : $file->path;
Modified: branches/pmc_pct/lib/Parrot/Docs/File.pm
==============================================================================
--- branches/pmc_pct/lib/Parrot/Docs/File.pm Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/lib/Parrot/Docs/File.pm Thu Jun 4 02:32:48 2009 (r39377)
@@ -1,4 +1,4 @@
-# Copyright (C) 2004-2007, Parrot Foundation.
+# Copyright (C) 2004-2009, Parrot Foundation.
# $Id$
=head1 NAME
@@ -380,45 +380,20 @@
return '' unless $self->contains_pod;
my @lines = $self->read;
+ my $firstline = shift @lines;
+ return $self->title unless $firstline =~ /^=head1\s+ABSTRACT/;
- while (@lines) {
- my $line = shift @lines;
-
- if ( $line =~ /^=head1\s+ABSTRACT/o ) {
- while (@lines) {
- $line = shift @lines;
-
- last if $line =~ /\S/o;
- }
-
- my @abstract_text = $line;
-
- while (@lines) {
- $line = shift @lines;
-
- last if $line !~ /\S/o;
-
- push @abstract_text, $line;
- }
-
- my $desc = join ' ', @abstract_text;
-
- # Joining lines may have created a bit of extra whitespace.
- $desc =~ s/\s+/ /osg;
- $desc =~ s/^\s+//os;
- $desc =~ s/\s+$//os;
-
- # Remove any POD.
- $desc =~ s/[CFL]<([^>]+)>/$1/osg;
-
- return $desc;
- }
- }
-
- # RT#43687 - The abstract section above was added later. The two searches
- # could be combined.
-
- return $self->title;
+ my $all_text = join "\n" => @lines;
+ $all_text =~ s/^\s+//;
+ my @paragraphs = split /\n{2,}/, $all_text;
+ my $desc;
+ # For a short description, we take only the first paragraph of any
+ # ABSTRACT.
+ ($desc = $paragraphs[0]) =~ s/\n/ /g;
+ $desc =~ s/\s+/ /sg;
+ # We eliminate certain POD formatting characters.
+ $desc =~ s/[CFL]<([^>]+)>/$1/sg;
+ return $desc;
}
=back
Modified: branches/pmc_pct/lib/Parrot/Docs/Group.pm
==============================================================================
--- branches/pmc_pct/lib/Parrot/Docs/Group.pm Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/lib/Parrot/Docs/Group.pm Thu Jun 4 02:32:48 2009 (r39377)
@@ -60,8 +60,6 @@
my $text = shift;
my @contents = @_;
- # RT#43709 - Groups should only contain items or paths.
-
$self = $self->SUPER::new( $text, @contents );
$self->{NAME} = $name;
$self->{TITLE} = $name;
Modified: branches/pmc_pct/lib/Parrot/Docs/Item.pm
==============================================================================
--- branches/pmc_pct/lib/Parrot/Docs/Item.pm Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/lib/Parrot/Docs/Item.pm Thu Jun 4 02:32:48 2009 (r39377)
@@ -68,8 +68,6 @@
my $text = shift;
my @contents = @_;
- # RT#43713 - Items should only contain paths.
-
die "No contents ($text).\n" unless @contents;
$self = bless {
Modified: branches/pmc_pct/lib/Parrot/Docs/POD2HTML.pm
==============================================================================
--- branches/pmc_pct/lib/Parrot/Docs/POD2HTML.pm Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/lib/Parrot/Docs/POD2HTML.pm Thu Jun 4 02:32:48 2009 (r39377)
@@ -218,9 +218,6 @@
}
else {
- # Tidy up the C reference *s.
- $text =~ s|\b\s*\*\s+\b| \*|gs;
-
esc($text);
}
Modified: branches/pmc_pct/lib/Parrot/Docs/Section/Developer.pm
==============================================================================
--- branches/pmc_pct/lib/Parrot/Docs/Section/Developer.pm Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/lib/Parrot/Docs/Section/Developer.pm Thu Jun 4 02:32:48 2009 (r39377)
@@ -51,8 +51,14 @@
$self->new_item( '', 'docs/native_exec.pod' ),
$self->new_item( '', 'docs/porting_intro.pod' ),
),
- $self->new_group( 'Development Notes', '', 'docs/dev' ),
- $self->new_group( 'Articles', '', 'docs/user/pir' ),
+ $self->new_group( 'Development Notes', '', 'docs/dev',
+ $self->new_item( 'Documenting PMCs', 'docs/pmc/documentation.pod'),
+ ),
+ $self->new_group( 'Articles', '', 'docs/user/pir',
+ $self->new_item( 'Array base class', 'docs/pmc/array.pod'),
+ $self->new_item( 'Accesing C Structs from Parrot', 'docs/pmc/struct.pod'),
+ $self->new_item( 'Parrot Subroutines', 'docs/pmc/subs.pod'),
+ ),
);
}
Modified: branches/pmc_pct/lib/Parrot/Docs/Section/Parrot.pm
==============================================================================
--- branches/pmc_pct/lib/Parrot/Docs/Section/Parrot.pm Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/lib/Parrot/Docs/Section/Parrot.pm Thu Jun 4 02:32:48 2009 (r39377)
@@ -107,7 +107,6 @@
$self->new_item( 'Chapter 6 Not Quite Perl', 'docs/book/ch06_nqp.pod'),
$self->new_item( 'Chapter 7 Dynamic C-level Objects', 'docs/book/ch07_dynpmcs.pod'),
$self->new_item( 'Chapter 8 Dynamic Opcodes', 'docs/book/ch08_dynops.pod'),
- $self->new_item( 'Chapter 9 Parrot Assembly Language', 'docs/book/ch09_pasm.pod'),
$self->new_item( 'Chapter 10 Instruction Reference', 'docs/book/ch10_opcode_reference.pod'),
$self->new_item( 'Chapter 11 Directive Reference', 'docs/book/ch11_directive_reference.pod'),
$self->new_item( 'Chapter 12 PIR Operator Reference', 'docs/book/ch12_operator_reference.pod'),
Modified: branches/pmc_pct/lib/Parrot/Headerizer.pm
==============================================================================
--- branches/pmc_pct/lib/Parrot/Headerizer.pm Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/lib/Parrot/Headerizer.pm Thu Jun 4 02:32:48 2009 (r39377)
@@ -62,6 +62,7 @@
PARROT_CONST_FUNCTION
PARROT_DOES_NOT_RETURN
PARROT_MALLOC
+ PARROT_OBSERVER
);
=item C<extract_function_declarations($text)>
Copied: branches/pmc_pct/lib/Parrot/Install.pm (from r39376, trunk/lib/Parrot/Install.pm)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/pmc_pct/lib/Parrot/Install.pm Thu Jun 4 02:32:48 2009 (r39377, copy of r39376, trunk/lib/Parrot/Install.pm)
@@ -0,0 +1,239 @@
+package Parrot::Install;
+# Copyright (C) 2001-2009, Parrot Foundation.
+# $Id$
+use strict;
+use warnings;
+use File::Basename qw(dirname);
+use File::Copy;
+use File::Path; # mkpath
+use File::Spec;
+use base qw( Exporter );
+our @EXPORT_OK = qw(
+ lines_to_files
+ create_directories
+ install_files
+);
+
+#################### DOCUMENTATION ####################
+
+=head1 NAME
+
+Parrot::Install - Functionality for installation programs
+
+=head1 SYNOPSIS
+
+ use Parrot::Install qw(
+ install_files
+ create_directories
+ lines_to_files
+ );
+
+=head1 DESCRIPTION
+
+This module exports on demand only three subroutines used in the Parrot
+installation programs F<tools/dev/install_files.pl> and
+F<tools/dev/install_dev_files.pl>. The subroutines are tested by tests found
+in F<t/tools/install/>.
+
+=head1 SUBROUTINES
+
+=head2 C<lines_to_files()>
+
+B<Purpose:> Suck in the lines from the mentioned manifests, and turn them into
+file locations.
+
+B<Arguments:> List of five scalars.
+
+ ($files, $directories) =
+ lines_to_files(
+ \%metatransforms,
+ \@transformorder,
+ \@manifests,
+ \%options,
+ $parrotdir,
+ );
+
+B<Return Value:> List of three scalars.
+
+B<Comment:>
+
+=cut
+
+sub lines_to_files {
+ my ($metatransforms, $transformorder, $manifests_ref,
+ $options_ref, $parrotdir) = @_;
+ my @files;
+ my %directories;
+ my($tkey, $thash);
+ my $filehash;
+
+ # We'll report multiple occurrences of the same file
+ my(%seen);
+
+ # Check $manifests_ref
+ ref($manifests_ref) eq 'ARRAY'
+ or die "Manifests must be listed in an array reference: $!";
+ @{ $manifests_ref } > 0 or die "No manifests specified";
+
+ # Check $transformorder
+ ref($transformorder) eq 'ARRAY'
+ or die "Transform order should be an array of keys\n";
+
+ @ARGV = @{ $manifests_ref };
+ LINE: while ( my $entry = <> ) {
+ chomp $entry;
+
+ $entry =~ s/\#.*//; # Ignore comments
+ next if $entry =~ /^\s*$/; # Skip blank lines
+
+ my ( $src, $meta, $dest ) = split( /\s+/, $entry );
+ $dest = $src unless $dest;
+
+ if ( $seen{$src}++ ) {
+ print STDERR "$ARGV:$.: Duplicate entry $src\n";
+ }
+
+ # Parse out metadata
+ die "Malformed line in MANIFEST: $entry" if not defined $meta;
+ my $generated = $meta =~ s/^\*//;
+ my ($package) = $meta =~ /^\[(.*?)\]/;
+ $meta =~ s/^\[(.*?)\]//;
+ next unless $package; # Skip if this file belongs to no package
+
+ my $plist = defined ( $options_ref->{packages})
+ ? $options_ref->{packages}
+ : '.*';
+ next unless $package =~ /$plist/;
+
+ my %metadata;
+ @metadata{ split( /,/, $meta ) } = ();
+ $metadata{$_} = 1 for ( keys %metadata ); # Laziness
+
+ $filehash = {
+ Source => $src,
+ Dest => $dest,
+ DestDirs => [],
+ };
+
+ FIXFILE: {
+ # Have to catch this case early for some unknown reason
+ if ( $entry =~ /^runtime/ ) {
+ $filehash->{Dest} =~ s/^runtime\/parrot\///;
+ $filehash->{Dest} = File::Spec->catdir(
+ $options_ref->{libdir}, $parrotdir, $filehash->{Dest}
+ );
+ last FIXFILE;
+ }
+ foreach my $tkey (@$transformorder) {
+ $thash = $metatransforms->{$tkey};
+ unless($thash->{ismeta} ? $metadata{$tkey} : $entry =~ /$tkey/) { next; }
+ $filehash = &{ $thash->{transform} }($filehash);
+ ref($filehash) eq 'HASH' or die "Error: transform didn't return a hash for key '$tkey'\n";
+ $filehash->{Dest} = File::Spec->catdir(
+ $options_ref->{$thash->{optiondir} . 'dir'},
+ @{ $filehash->{DestDirs} },
+ $filehash->{Dest}
+ );
+ last FIXFILE;
+ }
+ die "Unknown install location in MANIFEST for file '$entry'\n";
+ }
+
+ if(! $filehash->{Installable}) {
+ $filehash->{Dest} = File::Spec->catdir( $options_ref->{buildprefix}, $filehash->{Dest} )
+ if $options_ref->{buildprefix};
+ }
+
+ $directories{ dirname($filehash->{Dest}) } = 1;
+ push( @files, $filehash );
+ }
+ continue {
+ close ARGV if eof; # Reset line numbering for each input file
+ }
+
+ (grep { ! ref } @files) and die "lines_to_files from Parrot::Install created a bad hash!\n";
+ return(\@files, \%directories);
+}
+
+=head2 C<create_directories()>
+
+B<Purpose:> Creates the directories passed in.
+
+B<Arguments:> Two scalar arguments.
+
+ create_directories(
+ $destination_directory,
+ $directories_hash_ref,
+ );
+
+B<Return Value:> True value.
+
+B<Comment:>
+
+=cut
+
+sub create_directories {
+ my($destdir, $directories) = @_;
+
+ mkpath([
+ grep { ! -d } map { $destdir . $_ } keys %$directories
+ ],0,0777);
+}
+
+=head2 C<install_files()>
+
+B<Purpose:> Install the mentioned files into the appropriate locations.
+
+ install_files(
+ $destination_directory,
+ $dry_run_option,
+ $list_of_files_and_executables,
+ );
+
+B<Arguments:> Takes two scalar arguments, followed by a reference to a
+list consisting of hashes.
+
+B<Return Value:> True value.
+
+B<Comment:>
+
+=cut
+
+sub install_files {
+ my($destdir, $dryrun, $files) = @_;
+ my($src, $dest, $mode);
+
+ ref($files) eq 'ARRAY' or die "Error: parameter \$files must be an array\n";
+ print("Installing ...\n");
+ foreach my $el ( @$files ) {
+ unless(ref($el) eq 'HASH') {
+ my($ref) = ref($el);
+ warn "Bad reference passed in \$files (want a HASH, got a '$ref')\n";
+ next;
+ }
+ ( $src, $dest ) = map { $el->{$_} } qw(Source Dest);
+ $dest = $destdir . $dest;
+ if ( $dryrun ) {
+ print "$src -> $dest\n";
+ next;
+ }
+ else {
+ next unless -e $src;
+ next if $^O eq 'cygwin' and -e "$src.exe"; # stat works, copy not
+ copy( $src, $dest ) or die "Error: couldn't copy $src to $dest: $!\n";
+ print "$dest\n";
+ }
+ $mode = ( stat($src) )[2];
+ chmod $mode, $dest;
+ }
+ return 1;
+}
+
+1;
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
Modified: branches/pmc_pct/lib/Parrot/Manifest.pm
==============================================================================
--- branches/pmc_pct/lib/Parrot/Manifest.pm Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/lib/Parrot/Manifest.pm Thu Jun 4 02:32:48 2009 (r39377)
@@ -1,11 +1,58 @@
# $Id$
# Copyright (C) 2007, Parrot Foundation.
+=head1 NAME
+
+Parrot::Manifest - Re-create MANIFEST and MANIFEST.SKIP
+
+=head1 SYNOPSIS
+
+ use Parrot::Manifest;
+
+ $mani = Parrot::Manifest->new($0);
+
+ $manifest_lines_ref = $mani->prepare_manifest();
+ $need_for_files = $mani->determine_need_for_manifest($manifest_lines_ref);
+ $mani->print_manifest($manifest_lines_ref) if $need_for_files;
+
+ $print_str = $mani->prepare_manifest_skip();
+ $need_for_skip = $mani->determine_need_for_manifest_skip($print_str);
+ $mani->print_manifest_skip($print_str) if $need_for_skip;
+
+ $print_str = $mani->prepare_gitignore();
+ $mani->print_gitignore($print_str) if $need_for_skip;
+
+=cut
+
package Parrot::Manifest;
use strict;
use warnings;
use Carp;
+=head1 METHODS
+
+=head2 new
+
+ $mani = Parrot::Manifest->new({
+ script => $0,
+ file => $filename,
+ skip => $skipfilename,
+ gitignore => $gitignoresfilename,
+ })
+
+Creates a Parrot::Manifest object by asking C<svn status> for verbose output,
+and parsing the results.
+
+C<file> is the name of the file that the manifest will eventually be written
+to, and defaults to F<MANIFEST>. C<skip> is the name of the file that will
+hold the list of files to be skipped, and defaults to F<MANIFEST.SKIP>.
+C<gitignore> contains the same information as F<MANIFEST.SKIP> in a different
+format. It defaults to F<.gitignore>. The C<script> parameter is the name of
+the program invoking Parrot::Manifest, for use in messages.
+
+=cut
+
+# ...the results go into $self->{dirs} and $self->{versioned_files}
sub new {
my $class = shift;
my $argsref = shift;
@@ -55,6 +102,16 @@
return $self;
}
+=head2 prepare_manifest
+
+ $manifest_lines_ref = $mani->prepare_manifest();
+
+Prepares the manifest from the read in by the C<new()> method, and returns a
+hash of the files. The keys of the hash are the filenames, and the values are
+strings representing the package and a list of the meta flags.
+
+=cut
+
sub prepare_manifest {
my $self = shift;
@@ -66,6 +123,32 @@
return \%manifest_lines;
}
+=head2 determine_need_for_manifest
+
+ $need_for_files =
+ $mani->determine_need_for_manifest($manifest_lines_ref);
+
+Determines the need for the manifest. The checks are:
+
+=over 4
+
+=item *
+
+If there's no manifest yet, we need one.
+
+=item *
+
+If there's a difference between what's already there and what's in the list,
+we need a new one.
+
+=back
+
+If a new manifest is needed, the return value is C<1>; otherwise it is
+undefined. The value passed in is the hash as returned from I<e.g.>,
+C<prepare_manifest()>.
+
+=cut
+
sub determine_need_for_manifest {
my $self = shift;
my $proposed_files_ref = shift;
@@ -84,6 +167,15 @@
$different_patterns_count ? return 1 : return;
}
+=head2 print_manifest
+
+ $mani->print_manifest($manifest_lines_ref) if $need_for_files;
+
+Writes the manifest to a file. The example above does so only if an update is
+needed.
+
+=cut
+
my $text_file_coda = <<'CODA';
# Local variables:
# mode: text
@@ -101,8 +193,8 @@
#
# generated by $self->{script} $self->{time} UT
#
-# See tools/dev/install_files.pl for documentation on the
-# format of this file.
+# See below for documentation on the format of this file.
+#
# See docs/submissions.pod on how to recreate this file after SVN
# has been told about new or deleted files.
END_HEADER
@@ -119,6 +211,9 @@
return 1;
}
+# Gets the package and the meta flags for the given file. This function does
+# it based on the directory the file is in. If a particular file is needed,
+# then _get_special (below) provides that functionality.
sub _get_manifest_entry {
my $file = shift;
@@ -156,6 +251,7 @@
return $loc;
}
+# See comments for _get_manifest_entry, above
sub _get_special {
my %special = qw(
LICENSE [main]doc
@@ -191,6 +287,7 @@
return \%special;
}
+# Gets files currently listed in manifest, and returns a hash
sub _get_current_files {
my $self = shift;
@@ -212,6 +309,15 @@
return \%current_files;
}
+=head2 prepare_manifest_skip
+
+ $print_str = $mani->prepare_manifest_skip();
+
+Gets a list of the files that SVN ignores, and returns a string that can be
+put into F<MANIFEST.SKIP>.
+
+=cut
+
sub prepare_manifest_skip {
my $self = shift;
@@ -220,6 +326,15 @@
return $self->_compose_manifest_skip($ignores_ref);
}
+=head2 prepare_gitignore
+
+ $print_str = $mani->prepare_gitignore();
+
+Gets a list of the files that SVN ignores, and then writes it to the
+F<.gitignore> file.
+
+=cut
+
sub prepare_gitignore {
my $self = shift;
@@ -228,6 +343,27 @@
return $self->_compose_gitignore($ignores_ref);
}
+=head2 determine_need_for_manifest_skip
+
+ $need_for_skip =
+ $mani->determine_need_for_manifest_skip($print_str);
+
+Determines whether F<MANIFEST.SKIP> is needed. The tests used are:
+
+=over 4
+
+=item *
+
+If the file doesn't exist, we need one.
+
+=item *
+
+If the proposed and existing contents differ, we need one.
+
+=back
+
+=cut
+
sub determine_need_for_manifest_skip {
my $self = shift;
my $print_str = shift;
@@ -250,6 +386,14 @@
}
}
+=head2 print_manifest_skip
+
+ $mani->print_manifest_skip($print_str) if $need_for_skip;
+
+Writes F<MANIFEST.SKIP> to a file. The example above does so only if needed.
+
+=cut
+
sub print_manifest_skip {
my $self = shift;
my $print_str = shift;
@@ -264,6 +408,14 @@
return 1;
}
+=head2 print_gitignore
+
+ $mani->print_gitignore($print_str) if $need_for_skip;
+
+Writes the F<.gitignore> file. The example above does so only if needed.
+
+=cut
+
sub print_gitignore {
my $self = shift;
my $print_str = shift;
@@ -278,6 +430,7 @@
return 1;
}
+# Gets a list of files that SVN ignores
sub _get_ignores {
my $self = shift;
@@ -305,6 +458,7 @@
return \%ignores;
}
+# Turns the list of ignored files into .gitignore format
sub _compose_gitignore {
my $self = shift;
my $ignores_ref = shift;
@@ -337,6 +491,7 @@
return $print_str;
}
+# Turns list of ignored files into F<MANIFEST.SKIP> format
sub _compose_manifest_skip {
my $self = shift;
my $ignore_ref = shift;
@@ -378,6 +533,7 @@
return $print_str;
}
+# Gets a list of the currently skipped files from F<MANIFEST.SKIP>
sub _get_current_skips {
my $self = shift;
@@ -395,6 +551,7 @@
return \%current_skips;
}
+# Gets list of files we're proposing to skip
sub _get_proposed_skips {
my $print_str = shift;
@@ -411,28 +568,61 @@
1;
-#################### DOCUMENTATION ####################
+=head1 MANIFEST FORMAT
-=head1 NAME
+The format of the F<MANIFEST> (currently F<MANIFEST> and F<MANIFEST.generated>
+are used) is:
-Parrot::Manifest - Re-create MANIFEST and MANIFEST.SKIP
+ source_path <whitespace> [package]meta1,meta2,...
-=head1 SYNOPSIS
+or you may optionally specify a different destination path:
- use Parrot::Manifest;
+ source_path <whitespace> [package]meta1,meta2,... <whitespace> destination
- $mani = Parrot::Manifest->new($0);
+Additionally, there may be a C<*> in front of the whole line to designate
+a generated file:
- $manifest_lines_ref = $mani->prepare_manifest();
- $need_for_files = $mani->determine_need_for_manifest($manifest_lines_ref);
- $mani->print_manifest($manifest_lines_ref) if $need_for_files;
+ source_path <whitespace> *[package]meta1,meta2,... <whitespace> destination
- $print_str = $mani->prepare_manifest_skip();
- $need_for_skip = $mani->determine_need_for_manifest_skip($print_str);
- $mani->print_manifest_skip($print_str) if $need_for_skip;
+The square brackets around C<package> are literal. C<package> gives
+the name of the RPM that the given file will be installed for, and is
+only used by this script to skip files that are not members of any
+package.
- $print_str = $mani->prepare_gitignore();
- $mani->print_gitignore($print_str) if $need_for_skip;
+The various meta flags recognized are:
+
+=over 4
+
+=item C<doc>
+
+Tag this file with C<%doc> in the RPM, and omit the leading path (because
+F<rpm> will put it into a directory of its choosing).
+
+=item C<include>
+
+Write this file to the location given by the C<--includedir> option.
+
+=item C<lib>
+
+Write this file to the location given by the C<--libdir> option.
+
+=item C<bin>
+
+Write this file to the location given by the C<--bindir> option.
+
+=back
+
+The optional C<destination> field provides a general way to change
+where a file will be written to. It will be applied before any
+metadata tags.
+
+Example: if this line is in the F<MANIFEST.generated> file
+
+ languages/snorkfest/snork-compile [main]bin
+
+and the C<--bindir=/usr/parroty/bin>, then the generated
+F<parrot-E<lt>VERSIONE<gt>-1.E<lt>archE<gt>.rpm> file will contain the file
+C</usr/parroty/bin/snork-compile>.
=head1 SEE ALSO
Modified: branches/pmc_pct/lib/Parrot/OpsRenumber.pm
==============================================================================
--- branches/pmc_pct/lib/Parrot/OpsRenumber.pm Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/lib/Parrot/OpsRenumber.pm Thu Jun 4 02:32:48 2009 (r39377)
@@ -17,16 +17,15 @@
$self = Parrot::OpsRenumber->new( {
argv => [ @ARGV ],
- nolines => $nolines_flag,
moddir => "lib/Parrot/OpLib",
module => "core.pm",
inc_dir => "include/parrot/oplib",
inc_f => "ops.h",
- script => "tools/build/opsrenumber.pl",
+ script => "tools/dev/opsrenumber.pl",
} );
$self->prepare_ops();
- $self->renum_op_map_file( $PConfig{MAJOR} );
+ $self->renum_op_map_file();
=cut
@@ -72,9 +71,8 @@
sub renum_op_map_file {
my $self = shift;
- my $major_version = shift;
- my $file = scalar(@_) ? shift : $self->{num_file};
+ my $file = $self->{num_file};
# We open up the currently existing ops.num and file and read it
# line-by-line. That file is basically divided into two halves
@@ -123,7 +121,7 @@
# Parrot::Ops2pm::Base. prepare_ops(), in turn, works off
# Parrot::OpsFile.
- # So whether a particular opcode will appear in the *new* ops.num
+ # So whether a particular opcode will continue to appear in ops.num
# depends entirely on whether or not it's found in
# @{ $self->{ops}->{OPS} }. If a particular opcode has been deleted or
# gone missing from that array, then it won't appear in the new
Modified: branches/pmc_pct/lib/Parrot/Pmc2c/Attribute.pm
==============================================================================
--- branches/pmc_pct/lib/Parrot/Pmc2c/Attribute.pm Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/lib/Parrot/Pmc2c/Attribute.pm Thu Jun 4 02:32:48 2009 (r39377)
@@ -129,21 +129,21 @@
}
elsif ($attrtype eq "INTVAL") {
$decl .= <<"EOA";
- PMC *attr_value = VTABLE_get_attr_str(interp, \\
+ PMC * const attr_value = VTABLE_get_attr_str(interp, \\
pmc, Parrot_str_new_constant(interp, "$attrname")); \\
(dest) = (PMC_IS_NULL(attr_value) ? (INTVAL) 0: VTABLE_get_integer(interp, attr_value)); \\
EOA
}
elsif ($attrtype eq "FLOATVAL") {
$decl .= <<"EOA";
- PMC *attr_value = VTABLE_get_attr_str(interp, \\
+ PMC * const attr_value = VTABLE_get_attr_str(interp, \\
pmc, Parrot_str_new_constant(interp, "$attrname")); \\
(dest) = (PMC_IS_NULL(attr_value) ? (FLOATVAL) 0.0: VTABLE_get_number(interp, attr_value)); \\
EOA
}
elsif ($attrtype =~ $isptrtostring) {
$decl .= <<"EOA";
- PMC *attr_value = VTABLE_get_attr_str(interp, \\
+ PMC * const attr_value = VTABLE_get_attr_str(interp, \\
pmc, Parrot_str_new_constant(interp, "$attrname")); \\
(dest) = (PMC_IS_NULL(attr_value) ? (STRING *) 0: VTABLE_get_string(interp, attr_value)); \\
EOA
@@ -168,7 +168,7 @@
} \\
else \\
(dest) = ((Parrot_${pmcname}_attributes *)PMC_data(pmc))->$attrname; \\
- } while (0);
+ } while (0)
#define SETATTR_${pmcname}_${attrname}(interp, pmc, value) \\
do { \\
@@ -184,7 +184,7 @@
}
elsif ($attrtype eq "INTVAL") {
$decl .= <<"EOA";
- PMC *attr_value = pmc_new(interp, enum_class_Integer); \\
+ PMC * const attr_value = pmc_new(interp, enum_class_Integer); \\
VTABLE_set_integer_native(interp, attr_value, value); \\
VTABLE_set_attr_str(interp, pmc, \\
Parrot_str_new_constant(interp, "$attrname"), attr_value); \\
@@ -192,7 +192,7 @@
}
elsif ($attrtype eq "FLOATVAL") {
$decl .= <<"EOA";
- PMC *attr_value = pmc_new(interp, enum_class_Float); \\
+ PMC * const attr_value = pmc_new(interp, enum_class_Float); \\
VTABLE_set_number_native(interp, attr_value, value); \\
VTABLE_set_attr_str(interp, pmc, \\
Parrot_str_new_constant(interp, "$attrname"), attr_value); \\
@@ -200,7 +200,7 @@
}
elsif ($attrtype =~ $isptrtostring) {
$decl .= <<"EOA";
- PMC *attr_value = pmc_new(interp, enum_class_String); \\
+ PMC * const attr_value = pmc_new(interp, enum_class_String); \\
VTABLE_set_string_native(interp, attr_value, value); \\
VTABLE_set_attr_str(interp, pmc, \\
Parrot_str_new_constant(interp, "$attrname"), attr_value); \\
@@ -225,7 +225,7 @@
} \\
else \\
((Parrot_${pmcname}_attributes *)PMC_data(pmc))->$attrname = (value); \\
- } while (0);
+ } while (0)
EOA
Modified: branches/pmc_pct/lib/Parrot/Pmc2c/PMCEmitter.pm
==============================================================================
--- branches/pmc_pct/lib/Parrot/Pmc2c/PMCEmitter.pm Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/lib/Parrot/Pmc2c/PMCEmitter.pm Thu Jun 4 02:32:48 2009 (r39377)
@@ -1,4 +1,4 @@
-# Copyright (C) 2007-2008, Parrot Foundation.
+# Copyright (C) 2007-2009, Parrot Foundation.
# $Id$
=head1 NAME
@@ -22,15 +22,15 @@
package Parrot::Pmc2c::PMC;
use strict;
use warnings;
-use Parrot::Pmc2c::Emitter;
-use Parrot::Pmc2c::Method;
-use Parrot::Pmc2c::MethodEmitter;
+use Parrot::Pmc2c::Emitter ();
+use Parrot::Pmc2c::Method ();
+use Parrot::Pmc2c::MethodEmitter ();
use Parrot::Pmc2c::UtilFunctions qw( dont_edit dynext_load_code c_code_coda );
use Text::Balanced 'extract_bracketed';
-use Parrot::Pmc2c::PCCMETHOD;
-use Parrot::Pmc2c::MULTI;
-use Parrot::Pmc2c::PMC::RO;
-use Parrot::Pmc2c::PMC::ParrotClass;
+use Parrot::Pmc2c::PCCMETHOD ();
+use Parrot::Pmc2c::MULTI ();
+use Parrot::Pmc2c::PMC::RO ();
+use Parrot::Pmc2c::PMC::ParrotClass ();
sub prep_for_emit {
my ( $this, $pmc, $vtable_dump ) = @_;
@@ -130,8 +130,8 @@
}
if ($name ne 'default') {
- $h->emit("${export}VTABLE* Parrot_${name}_update_vtable(VTABLE*);\n");
- $h->emit("${export}VTABLE* Parrot_${name}_ro_update_vtable(VTABLE*);\n");
+ $h->emit("${export}VTABLE* Parrot_${name}_update_vtable(ARGMOD(VTABLE*));\n");
+ $h->emit("${export}VTABLE* Parrot_${name}_ro_update_vtable(ARGMOD(VTABLE*));\n");
}
$h->emit("${export}VTABLE* Parrot_${name}_get_vtable(PARROT_INTERP);\n");
$h->emit("${export}VTABLE* Parrot_${name}_ro_get_vtable(PARROT_INTERP);\n");
@@ -182,7 +182,7 @@
$export = $self->is_dynamic ? 'PARROT_DYNEXT_EXPORT ' : 'PARROT_EXPORT ';
- $hout .= "${export}VTABLE* Parrot_${lc_name}_update_vtable(VTABLE*);\n"
+ $hout .= "${export}VTABLE* Parrot_${lc_name}_update_vtable(ARGMOD(VTABLE*));\n"
unless $name eq 'default';
$hout .= "${export}VTABLE* Parrot_${lc_name}_get_vtable(PARROT_INTERP);\n";
@@ -333,7 +333,18 @@
return $ret;
}
+=item C<pre_method_gen>
+
+Generate switch-bases VTABLE for MULTI
+
+=cut
+
sub pre_method_gen {
+ my ($self) = @_;
+
+ $self->gen_switch_vtable;
+
+ 1;
}
=item C<gen_methods()>
@@ -372,21 +383,20 @@
my ($self) = @_;
my $attributes = $self->attributes;
- if ( @$attributes ) {
+ if ( @{$attributes} ) {
Parrot::Pmc2c::Attribute::generate_start( $attributes->[0], $self );
- foreach my $attribute ( @$attributes ) {
+ foreach my $attribute ( @{$attributes} ) {
$attribute->generate_declaration($self);
}
Parrot::Pmc2c::Attribute::generate_end( $attributes->[0], $self );
- foreach my $attribute ( @$attributes ) {
+ foreach my $attribute ( @{$attributes} ) {
$attribute->generate_accessor($self);
}
}
-
}
=item C<find_multi_functions()>
@@ -408,7 +418,7 @@
my $full_sig = $pmcname . "," . $method->{MULTI_full_sig};
my $functionname = 'Parrot_' . $pmcname . '_' . $method->name;
push @multi_names, [ $method->symbol, $short_sig, $full_sig,
- $pmcname, $functionname ];
+ $pmcname, $functionname, $method ];
}
return ( \@multi_names );
}
@@ -531,7 +541,7 @@
[$ns, $ns_name ]) {
my ($raw_string, $name) = @$s;
next if $strings_seen{$name}++;
- $multi_strings .= " STRING *$name = "
+ $multi_strings .= " STRING * const $name = "
. qq|CONST_STRING_GEN(interp, "$raw_string");\n|;
}
@@ -619,8 +629,8 @@
my $flags = $self->vtable_flags;
$cout .= <<"EOC";
- Hash * isa_hash;
- VTABLE * vt = Parrot_${classname}_get_vtable(interp);
+ Hash *isa_hash = NULL;
+ VTABLE * const vt = Parrot_${classname}_get_vtable(interp);
vt->base_type = $enum_name;
vt->flags = $flags;
vt->attribute_defs = attr_defs;
@@ -647,21 +657,28 @@
string_make(interp, " $provides", @{[length($provides) + 1]}, "ascii",
PObj_constant_FLAG|PObj_external_FLAG));
- /* set up isa hash */
- isa_hash = parrot_new_hash(interp);
- vt->isa_hash = isa_hash;
EOC
}
else {
$cout .= <<"EOC";
vt->whoami = CONST_STRING_GEN(interp, "$classname");
vt->provides_str = CONST_STRING_GEN(interp, "$provides");
+EOC
+ }
+
+ if (@isa) {
+ unshift @isa, $classname;
+ $cout .= <<"EOC";
- /* set up isa hash */
isa_hash = parrot_new_hash(interp);
vt->isa_hash = isa_hash;
EOC
}
+ else {
+ $cout .= <<"EOC";
+ vt->isa_hash = NULL;
+EOC
+ }
for my $k ( keys %extra_vt ) {
$cout .= <<"EOC";
@@ -683,7 +700,7 @@
interp->vtables[entry] = vt;
EOC
- for my $isa ($classname, @isa) {
+ for my $isa (@isa) {
$cout .= <<"EOC";
parrot_hash_put(interp, isa_hash, (void *)(CONST_STRING_GEN(interp, "$isa")), PMCNULL);
EOC
@@ -702,8 +719,7 @@
{
/* Register this PMC as a HLL mapping */
- const INTVAL pmc_id = Parrot_get_HLL_id( interp, CONST_STRING_GEN(interp, "$hll")
- );
+ const INTVAL pmc_id = Parrot_get_HLL_id( interp, CONST_STRING_GEN(interp, "$hll"));
if (pmc_id > 0) {
EOC
foreach my $maps ( sort keys %{ $self->{flags}{maps} } ) {
@@ -719,7 +735,7 @@
$cout .= <<"EOC";
{
- PMC * mro = pmc_new(interp, enum_class_ResizableStringArray);
+ PMC * const mro = pmc_new(interp, enum_class_ResizableStringArray);
VTABLE * const vt = interp->vtables[entry];
vt->mro = mro;
@@ -729,7 +745,9 @@
EOC
- for my $isa ($classname, @isa) {
+ @isa = $classname unless @isa;
+
+ for my $isa (@isa) {
$cout .= <<"EOC";
VTABLE_push_string(interp, mro, CONST_STRING_GEN(interp, "$isa"));
EOC
@@ -753,8 +771,7 @@
if ( exists $method->{PCCMETHOD} ) {
$cout .= <<"EOC";
- register_raw_nci_method_in_ns(interp, entry,
- F2DPTR(Parrot_${classname}_${method_name}), "$symbol_name");
+ register_raw_nci_method_in_ns(interp, entry, F2DPTR(Parrot_${classname}_${method_name}), CONST_STRING_GEN(interp, "$symbol_name"));
EOC
}
else {
@@ -849,7 +866,7 @@
$cout .= <<"EOC";
-PARROT_EXPORT VTABLE *Parrot_${classname}_ro_update_vtable(VTABLE *vt) {
+PARROT_EXPORT VTABLE *Parrot_${classname}_ro_update_vtable(ARGMOD(VTABLE *vt)) {
$vtable_updates
return vt;
}
@@ -883,6 +900,8 @@
$cout .= <<"EOC";
PARROT_EXPORT
+PARROT_CANNOT_RETURN_NULL
+PARROT_WARN_UNUSED_RESULT
VTABLE* Parrot_${classname}_get_vtable(PARROT_INTERP) {
VTABLE *vt;
$get_vtable
@@ -903,6 +922,8 @@
$cout .= <<"EOC";
PARROT_EXPORT
+PARROT_CANNOT_RETURN_NULL
+PARROT_WARN_UNUSED_RESULT
VTABLE* Parrot_${classname}_ro_get_vtable(PARROT_INTERP) {
VTABLE *vt;
$get_extra_vtable
@@ -926,6 +947,138 @@
return $self->{vtable};
}
+=item C<gen_switch_vtable>
+
+Generate switch-bases VTABLE for MULTI
+
+=cut
+
+sub gen_switch_vtable {
+ my ($self) = @_;
+
+ # No cookies for DynPMC. At least not now.
+ return 1 if $self->is_dynamic;
+
+ # Convert list of multis to name->[(type,,ssig,fsig,ns,func)] hash.
+ my %multi_methods;
+ foreach (@{$self->find_multi_functions}) {
+ my ($name, $ssig, $fsig, $ns, $func, $method) = @$_;
+ my @sig = split /,/, $fsig;
+ push @{ $multi_methods{ $name } }, [ $sig[1], $ssig, $fsig, $ns, $func, $method ];
+ }
+
+ # vtable methods
+ foreach my $method ( @{ $self->vtable->methods } ) {
+ my $vt_method_name = $method->name;
+ next if $vt_method_name eq 'class_init';
+
+ next if $self->implements_vtable($vt_method_name);
+ next unless exists $multi_methods{$vt_method_name};
+
+ my $multis = $multi_methods{$vt_method_name};
+
+ # Gather "case :"
+ my @cases = map { $self->generate_single_case($vt_method_name, $_) } @$multis;
+ my $cases = join "\n", @cases;
+
+ my $body = <<"BODY";
+ INTVAL type = VTABLE_type(INTERP, value);
+ /* For dynpmc fallback to MMD */
+ if ((type >= enum_class_core_max) || (SELF.type() >= enum_class_core_max))
+ type = enum_class_core_max;
+ switch(type) {
+$cases
+ }
+BODY
+
+ my $vtable = $method->clone({
+ body => Parrot::Pmc2c::Emitter->text($body),
+ });
+ $self->add_method($vtable);
+ }
+
+ 1;
+}
+
+# Generate signle case for switch VTABLE
+sub generate_single_case {
+ my ($self, $vt_method_name, $multi) = @_;
+
+ my ($type, $ssig, $fsig, $ns, $func, $impl) = @$multi;
+ my $case;
+
+ # Gather parameters names
+ my @parameters = map { s/\s*PMC\s*\*\s*//; $_ } split (/,/, $impl->parameters);
+ my $parameters = join ', ', @parameters;
+ # ISO C forbids return with expression from void functions.
+ my $return = $impl->return_type =~ /^void\s*$/
+ ? ''
+ : 'return ';
+
+ if ($type eq 'DEFAULT' || $type eq 'PMC') {
+ # For default case we have to handle return manually.
+ my ($pcc_signature, $retval, $call_tail, $pcc_return)
+ = $self->gen_defaul_case_wrapping($ssig, @parameters);
+
+ $case = <<"CASE";
+ default:
+ if (type < enum_class_core_max)
+ $return$func(INTERP, SELF, $parameters);
+ else {
+ $retval
+ Parrot_mmd_multi_dispatch_from_c_args(INTERP, "$vt_method_name", "$pcc_signature", SELF, $parameters$call_tail);
+ $pcc_return
+ }
+ break;
+CASE
+ }
+ else {
+ $case = <<"CASE";
+ case enum_class_$type:
+ $return$func(INTERP, SELF, $parameters);
+ break;
+CASE
+ }
+
+ $case;
+}
+
+# Generate (pcc_signature, retval holder, pcc_call_tail, return statement)
+# for default case in switch.
+sub gen_defaul_case_wrapping {
+ my ($self, $ssig, @parameters) = @_;
+
+ my $letter = substr($ssig, 0, 1);
+ if ($letter eq 'I') {
+ return (
+ "PP->" . $letter,
+ "INTVAL retval;",
+ ', &retval',
+ 'return retval;',
+ );
+ }
+ elsif ($letter eq 'P') {
+ return (
+ 'PPP->P',
+ '',
+ ", &$parameters[1]",
+ "return $parameters[1];",
+ );
+ }
+ elsif ($letter eq 'v') {
+ return (
+ 'PP->',
+ '',
+ '',
+ 'return;',
+ );
+ }
+ else {
+ die "Can't handle signature $ssig!";
+ }
+}
+
+
1;
# Local Variables:
Modified: branches/pmc_pct/lib/Parrot/Pmc2c/Parser.pm
==============================================================================
--- branches/pmc_pct/lib/Parrot/Pmc2c/Parser.pm Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/lib/Parrot/Pmc2c/Parser.pm Thu Jun 4 02:32:48 2009 (r39377)
@@ -15,6 +15,7 @@
use Parrot::Pmc2c::Emitter ();
use Parrot::Pmc2c::UtilFunctions qw(count_newlines filename slurp);
use Text::Balanced 'extract_bracketed';
+use File::Basename qw(basename);
=head1 NAME
@@ -65,6 +66,11 @@
my ( $preamble, $pmcname, $flags, $parents, $pmcbody, $post, $chewed_lines ) =
parse_top_level($code);
+ my $filebase = basename($filename);
+ $filebase =~ s/\.pmc$//;
+ # Note: this can be changed to a die() after the 1.4 release. (TT #665)
+ warn("PMC filename $filebase.pmc does not match pmclass name $pmcname!\n")
+ unless lc($filebase) eq lc($pmcname);
my $pmc = Parrot::Pmc2c::PMC->create($pmcname);
$pmc->preamble( Parrot::Pmc2c::Emitter->text( $preamble, $filename, 1 ) );
$pmc->name($pmcname);
@@ -159,7 +165,7 @@
@modifiers = split /\s/, $4;
$comment = $5;
- $lineno++;
+ $lineno += count_newlines($1);
$pmc->add_attribute(Parrot::Pmc2c::Attribute->new(
{
@@ -221,6 +227,7 @@
}
( my $methodblock, $pmcbody ) = extract_balanced($pmcbody);
+ my $block_lines = count_newlines($methodblock);
$methodblock = strip_outer_brackets($methodblock);
@@ -288,9 +295,14 @@
$pmc->add_method($method);
}
- $lineno += count_newlines($methodblock);
+ $lineno += $block_lines;
}
+ # include the remainder in the line count, minus the last one
+ # (the last one is included in the postamble directly)
+ chomp $pmcbody;
+ $lineno += count_newlines($pmcbody);
+
return ($lineno, $class_init);
}
Modified: branches/pmc_pct/lib/Parrot/Pmc2c/Pmc2cMain.pm
==============================================================================
--- branches/pmc_pct/lib/Parrot/Pmc2c/Pmc2cMain.pm Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/lib/Parrot/Pmc2c/Pmc2cMain.pm Thu Jun 4 02:32:48 2009 (r39377)
@@ -24,7 +24,8 @@
# Parrot::Pmc2c::Emitter.
our $OPTIONS;
-$SIG{'__WARN__'} = sub { use Carp; warn $_[0]; Carp::confess; };
+# This is useful for debugging, but upgrades deprecation warnings to errors.
+#$SIG{'__WARN__'} = sub { use Carp; warn $_[0]; Carp::confess; };
=head1 NAME
Modified: branches/pmc_pct/lib/Parrot/Test.pm
==============================================================================
--- branches/pmc_pct/lib/Parrot/Test.pm Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/lib/Parrot/Test.pm Thu Jun 4 02:32:48 2009 (r39377)
@@ -966,7 +966,7 @@
? ""
: "-L$PConfig{blib_dir} "))
. ($^O =~ m/MSWin32/
- ? $PConfig{libparrot_ldflags}
+ ? $PConfig{libparrot_linkflags}
: "-lparrot")
: File::Spec->join(
@PConfig{qw/build_dir blib_dir libparrot_static/},
Modified: branches/pmc_pct/lib/Parrot/Vtable.pm
==============================================================================
--- branches/pmc_pct/lib/Parrot/Vtable.pm Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/lib/Parrot/Vtable.pm Thu Jun 4 02:32:48 2009 (r39377)
@@ -201,7 +201,7 @@
sub vtbl_macros {
my $vtable = shift;
- my $macros = <<"EOM";
+ my $macros = <<'EOM';
/*
* vtable accessor macros
@@ -220,7 +220,7 @@
(pmc)->vtable->$entry->[1]($args)
EOM
}
- $macros .= <<"EOM";
+ $macros .= <<'EOM';
/*
* vtable method name defines for delegate
@@ -234,12 +234,12 @@
EOM
}
- $macros .= <<"EOM";
+ $macros .= <<'EOM';
EOM
# finally the name mapping
- $macros .= <<"EOM";
+ $macros .= <<'EOM';
/*
* vtable slot names
*/
@@ -247,7 +247,7 @@
#define PARROT_VTABLE_LOW 9
-static const char * const Parrot_vtable_slot_names[] = {
+static PARROT_OBSERVER const char * const Parrot_vtable_slot_names[] = {
"", /* Pointer to namespace for this class */
"", /* 'type' value for MMD */
"", /* Name of class this vtable is for */
@@ -293,14 +293,14 @@
$entry->[4],
EOM
}
- $macros .= <<"EOM";
+ $macros .= <<'EOM';
MMD_USER_FIRST
} parrot_mmd_func_enum;
/* &end_gen */
#ifdef PARROT_IN_OBJECTS_C
-static const char * const Parrot_mmd_func_names[] = {
+static PARROT_OBSERVER const char * const Parrot_mmd_func_names[] = {
EOM
for my $entry ( @{$vtable} ) {
Modified: branches/pmc_pct/ports/cygwin/README
==============================================================================
--- branches/pmc_pct/ports/cygwin/README Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/ports/cygwin/README Thu Jun 4 02:32:48 2009 (r39377)
@@ -190,7 +190,6 @@
/usr/lib/parrot/1.0.0/library/postgres.pasm
/usr/lib/parrot/1.0.0/library/postgres.pir
/usr/lib/parrot/1.0.0/library/random_lib.pir
- /usr/lib/parrot/1.0.0/library/tcpstream.pir
/usr/lib/parrot/1.0.0/library/uuid.pir
/usr/lib/parrot/1.0.0/library/yaml_dumper.pir
/usr/share/doc/parrot-1.0.0/LICENSE
@@ -738,7 +737,6 @@
/usr/lib/parrot/1.0.0/include/parrotlib.pbc
/usr/lib/parrot/1.0.0/include/pmctypes.pasm
/usr/lib/parrot/1.0.0/include/signal.pasm
- /usr/lib/parrot/1.0.0/include/sockets.pasm
/usr/lib/parrot/1.0.0/include/stat.pasm
/usr/lib/parrot/1.0.0/include/stdio.pasm
/usr/lib/parrot/1.0.0/include/stringinfo.pasm
@@ -1330,7 +1328,6 @@
/usr/share/doc/parrot/1.0.0/html/runtime/parrot/library/libpcre.pir.html
/usr/share/doc/parrot/1.0.0/html/runtime/parrot/library/parrotlib.pir.html
/usr/share/doc/parrot/1.0.0/html/runtime/parrot/library/pcre.pir.html
- /usr/share/doc/parrot/1.0.0/html/runtime/parrot/library/tcpstream.pir.html
/usr/share/doc/parrot/1.0.0/html/runtime/parrot/library/uuid.pir.html
/usr/share/doc/parrot/1.0.0/html/runtime/parrot/library/yaml_dumper.pir.html
/usr/share/doc/parrot/1.0.0/html/scheme.html
Modified: branches/pmc_pct/ports/fedora/parrot.spec.fedora
==============================================================================
--- branches/pmc_pct/ports/fedora/parrot.spec.fedora Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/ports/fedora/parrot.spec.fedora Thu Jun 4 02:32:48 2009 (r39377)
@@ -1,31 +1,55 @@
Name: parrot
-Version: 1.1.0
-Release: 1%{dist}
-Summary: Parrot Virtual Machine
+Version: 1.0.0
+Release: 6%{?dist}
+Summary: Parrot is a virtual machine
License: Artistic 2.0
Group: Development/Libraries
URL: http://www.parrot.org/
+
Source0: ftp://ftp.parrot.org/pub/parrot/releases/stable/%{version}/parrot-%{version}.tar.gz
+# Without Patch0 %{_libdir}/libparrot.so would not be a symbolic link to
+# %{_libdir}/libparrot.so.%{version}
+# Symlink: libparrot.so -> libparrot.so.%{version}
+# See for upstream: https://trac.parrot.org/parrot/ticket/509
+# Extended for the package to have no subdirectory under pkgconfig
+Patch0: parrot-install_files.patch
+Patch1: parrot-1.0.0-rpath-removal.patch
+
BuildRoot: %{_tmppath}/%{name}-%{version}-%{release}-root-%(%{__id_u} -n)
BuildRequires: readline-devel
BuildRequires: ncurses-devel
BuildRequires: gmp-devel
BuildRequires: gdbm-devel
BuildRequires: libicu-devel
-BuildRequires: perl-Test-Harness
+BuildRequires: perl(Test::Harness)
+BuildRequires: perl(Test::Simple)
+BuildRequires: ctags
+BuildRequires: openssl-devel
+
%package docs
Summary: Parrot Virtual Machine documentation
-License: Artistic 2.0
-Group: Development/Libraries
-BuildRequires: /usr/bin/perldoc
+Group: Documentation
+Requires: perl(strict)
+Requires: perl(warnings)
%package devel
Summary: Parrot Virtual Machine development headers and libraries
-License: Artistic 2.0
Group: Development/Libraries
Requires: %{name} = %{version}-%{release}
-Requires: %{_libdir}/pkgconfig
+Requires: pkgconfig
+
+%package tools
+Summary: Parrot Virtual Machine development for languages
+Group: Development/Libraries
+Requires: %{name} = %{version}-%{release}
+Requires: perl(Pod::Simple)
+Requires: perl(File::Which) = 0.05
+# It is necessary to have installed the package "perl-Perl-Critic" to install
+# the parrot-tools
+Provides: perl(Parrot::Pmc2c::MethodEmitter) = %{version}
+Provides: perl(Parrot::Pmc2c::PCCMETHOD_BITS) = %{version}
+Provides: perl(Parrot::Pmc2c::PMCEmitter) = %{version}
%description
Parrot is a virtual machine designed to efficiently compile and execute
@@ -34,22 +58,36 @@
%description docs
Documentation in text-, POD- and HTML-format (docs/html-subdirectory) and also
-examples about the Parrot Virtual Machine
+examples about the Parrot Virtual Machine.
%description devel
Parrot Virtual Machine development headers and libraries.
+%description tools
+Parrot Virtual Machine development files for building languages.
+
%prep
%setup -q
+%patch0 -p0
+%patch1 -b .rpatch
%{__perl} -pi -e 's,"lib/,"%{_lib}/, if (/CONST_STRING\(interp,/)' \
src/library.c
%{__perl} -pi -e "s,'/usr/lib','%{_libdir}',;s,runtime/lib/,runtime/%{_lib}/," \
tools/dev/install_files.pl
-%build
-%ifarch i386 x86_64
+cat << \EOF > %{name}-prov
+#!/bin/sh
+%{__perl_provides} $* | %{__sed} -e '/perl(A)/d' -e '/perl(B)/d' -e '/perl(DB)/d'
+EOF
+
+%global __perl_provides %{_builddir}/%{name}-%{version}/%{name}-prov
+chmod +x %{__perl_provides}
+
+
+%build
+%ifarch %{ix86} x86_64
%{__perl} Configure.pl \
--prefix=%{_usr} \
--libdir=%{_libdir} \
@@ -60,52 +98,113 @@
--cxx=%{__cxx} \
--optimize="$RPM_OPT_FLAGS -maccumulate-outgoing-args" \
--parrot_is_shared \
- --lex=/usr/bin/flex \
- --yacc=/usr/bin/yacc \
- --libs="-lcurses -lm"
+ --lex=%{_bindir}/flex \
+ --yacc=%{_bindir}/yacc \
+ --libs='-lcurses -lm'
%else
-# PowerPC
+# PowerPC, not all options work with the PowerPC-architecture, I do not test
+# which is not working (Gerd)
%{__perl} Configure.pl \
--prefix=%{_usr} \
--libdir=%{_libdir}
%endif
+# The LDD_LIBRARY_PATH hack is needed for "miniparrot"
+# to find his parrot-library in "blib/lib"
export LD_LIBRARY_PATH=$( pwd )/blib/lib
+
+# pbc_to_exe would not build if %{_smp_mflags} would used
make
make parrot_utils
make installable
make html
+
%install
rm -rf $RPM_BUILD_ROOT
+# This hack is needed for "miniparrot" to find his parrot-library in "blib/lib"
export LD_LIBRARY_PATH=$( pwd )/blib/lib
-make install DESTDIR=$RPM_BUILD_ROOT
+
+# install-dev: Same as 'install' taget but also install support for development.
+make install-dev DESTDIR=$RPM_BUILD_ROOT
+
+%define RPM_PAR_LIB_DIR $RPM_BUILD_ROOT%{_libdir}/%{name}/%{version}/
+
# Drop the docs so rpm can pick them up itself.
-rm -rf $RPM_BUILD_ROOT%{_usr}/share/doc/parrot # necessary for SuSE
-#rm -rf $RPM_BUILD_ROOT/%{_docdir}/parrot # for Solaris?
+rm -rf $RPM_BUILD_ROOT%{_defaultdocdir}/%{name}
# Force permissions on doc directories.
find docs examples -type d -exec chmod 755 {} \;
find docs examples -type f -exec chmod 644 {} \;
-# Force permissions on shared libs so they get stripped.
-find $RPM_BUILD_ROOT%{_libdir} -type f \( -name '*.so' -o -name '*.so.*' \) \
+# Force permissions on shared versioned libs so they get stripped.
+# The parrot-install-script don't set the permissions right
+# With changed permissions the dependencies will be found
+find %{RPM_PAR_LIB_DIR}dynext -type f -name '*.so' -exec chmod 755 {} \;
+
+# Remove module that should be install instead (perl(File::Which))
+rm -rf %{RPM_PAR_LIB_DIR}tools/lib/File
+
+
+# Added to reduce output errors when using rpmlint
+
+# Force permission on perl-scripts in the "tools" subdirctory
+find %{RPM_PAR_LIB_DIR}tools -type f -name "*.pl" -exec chmod 755 {} \; \
+ -exec %{__sed} -i -e '1 s&#! perl&#!/usr/bin/perl&' {} \;
+# Set path to parrot binary and Force permission
+find %{RPM_PAR_LIB_DIR}tools/dev -type f -name "pbc_to_exe.pir" \
+ -exec %{__sed} -i -e '1 s&#! parrot&#!/usr/bin/parrot&' {} \; \
-exec chmod 755 {} \;
+# This module is only needed for building and should not be installed (I think)
+# module "Parrot::OpLib::core"
+rm -rf %{RPM_PAR_LIB_DIR}tools/lib/Parrot/OpLib
+
+# Remove doc-files with zero-length
+find docs/html -type f -size 0 -exec rm -f {} \;
+
+# Set path for installed programs in docs package
+find examples -type f -name "*.pl" \
+ -exec %{__sed} -i -e '1 s&#! perl&#!/usr/bin/perl&' {} \;
+find examples -wholename 'examples/pir/befunge/t/basic.t' \
+ -exec %{__sed} -i -e '1 s&#! perl&#!/usr/bin/perl&' {} \;
+find examples -type f -name "*.py" \
+ -exec %{__sed} -i -e '1 s&#! python&#!/usr/bin/python&' {} \;
+find examples -type f -name "*.rb" \
+ -exec %{__sed} -i -e '1 s&#! ruby&#!/usr/bin/ruby&' {} \;
+
+find examples -type f -name "*.pir" \
+ -exec %{__sed} -i -e '1 s&#!./parrot&#!/usr/bin/parrot&' {} \;
+find examples/shootout -type f -name "random.pasm" \
+ -exec %{__sed} -i -e '1 s&#!./parrot&#!/usr/bin/parrot&' {} \;
+
+find examples -wholename 'examples/languages/abc/t/01-tests.t' \
+ -exec %{__sed} -i -e '1 s&#!perl&#!/usr/bin/perl&' {} \;
+find examples -wholename 'examples/shootout/revcomp.pir' \
+ -exec %{__sed} -i -e '1 s&#!parrot&#!/usr/bin/parrot&' {} \;
+
+find examples -wholename 'examples/languages/abc/t/harness' \
+ -exec %{__perl} -pi -e 's/\r$//' {} \;
+
+find examples/languages -type f -name harness \
+ -exec %{__sed} -i -e '1 s&#! perl&#!/usr/bin/perl&' {} \;
+for file in docs/book/ch09_pct.pod docs/memory_internals.pod; do
+ %{__mv} $file timestamp
+ iconv -f ISO-8859-1 -t UTF-8 -o $file timestamp
+ touch -r timestamp $file
+done
+%{__rm} -f timestamp
# These files *probably* aren't needed.
rm -rf $RPM_BUILD_ROOT%{_usr}/config \
$RPM_BUILD_ROOT%{_includedir}/src \
- $RPM_BUILD_ROOT%{_usr}/src \
- $RPM_BUILD_ROOT%{_usr}/tools
+ $RPM_BUILD_ROOT%{_usr}/src
%check
export LD_LIBRARY_PATH=$( pwd )/blib/lib
-# make test < /dev/null
-# %{?_with_fulltest:make fulltest < /dev/null}
-# make test || :
-# %{?_with_fulltest:make fulltest || :}
+make test
+%{?_with_fulltest: make fulltest}
%clean
rm -rf $RPM_BUILD_ROOT
@@ -116,17 +215,19 @@
%files
%defattr(-,root,root,-)
+%doc ChangeLog CREDITS NEWS PBC_COMPAT PLATFORMS README
+%doc RESPONSIBLE_PARTIES TODO LICENSE
%exclude %{_bindir}/parrot_config
%exclude %{_bindir}/parrot_debugger
%exclude %{_bindir}/pbc_*
%{_bindir}/*
-%{_libdir}/parrot
+%{_libdir}/parrot/
+%exclude %{_libdir}/parrot/%{version}/tools
+%exclude %{_libdir}/parrot/%{version}/VERSION
%{_libdir}/libparrot.so.*
%files docs
%defattr(-,root,root,-)
-%doc ChangeLog CREDITS NEWS PBC_COMPAT PLATFORMS README
-%doc RESPONSIBLE_PARTIES TODO
%doc docs examples
%files devel
@@ -143,9 +244,44 @@
%{_libdir}/libparrot.a
%{_libdir}/pkgconfig/*
+%files tools
+%defattr(-,root,root,-)
+# Files for building languages
+%{_libdir}/parrot/%{version}/tools/*
+%{_libdir}/parrot/%{version}/VERSION
+
+
+
%changelog
-* Tue Apr 21 2009 Francois Perrad <francois.perrad at gadz.org> 1.1.0
-- updated to 1.1.0
+* Thu Apr 23 2009 Gerd Pokorra <gp at zimt.uni-siegen.de> 1.0.0-6
+- add a list of changes from Lubomir Rintel
+- add patch to remove rpath
+- add filtering Provides
+- change requires for docs-subpackage
+- enable test suite
+
+* Wed Mar 25 2009 Gerd Pokorra <gp at zimt.uni-siegen.de> 1.0.0-5
+- change the group of the subpackage "-docs" to Documentation
+- put the main-documentation from the docs-package to the main package
+- LICENSE file added
+- change 'make install' to 'make install-dev' to also install support for development (tools)
+- add Provides-lines
+- add patch for the file "tools/dev/install_files.pl"
+- add commands to reduce output of errors when using rpmlint
+- define RPM_PAR_LIB_DIR added
+- add subpackage "tools"
+- exclude tools directory from main-package
+
+* Sun Mar 22 2009 Fabien Georget <fabien.georget at gmail.com> 1.0.0-4
+- add tools
+
+* Sun Mar 22 2009 David Fetter <david at fetter.org> 1.0.0-3
+- Removed wrong prefix from pkgconfig per Christoph Wickert
+- Changed i386 to ix86 per Christoph Wickert
+
+* Sun Mar 22 2009 David Fetter <david at fetter.org> 1.0.0-2
+- Changed hard-coded path requirement to perl.
+
* Tue Mar 17 2009 Allison Randal <allison at parrot.org> 1.0.0
- updated to 1.0.0
Modified: branches/pmc_pct/ports/ubuntu/changelog
==============================================================================
--- branches/pmc_pct/ports/ubuntu/changelog Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/ports/ubuntu/changelog Thu Jun 4 02:32:48 2009 (r39377)
@@ -1,7 +1,9 @@
-parrot (1.0.0-1ubuntu1~ppa9~karmic1) karmic; urgency=low
+parrot (1.0.0-1ubuntu1) karmic; urgency=low
* Resynchronize with Debian unstable.
+ * Add a patch to detect the lpia architecture, to correctly configure for
+ unaligned function pointers.
- -- Allison Randal <allison at parrot.org> Sun, 10 May 2009 20:39:20 -0700
+ -- Allison Randal <allison at parrot.org> Thu, 28 May 2009 13:13:12 -0700
parrot (1.0.0-1) unstable; urgency=low
* New upstream release
Copied: branches/pmc_pct/ports/ubuntu/lpia_no_aligned_funcptr.patch (from r39376, trunk/ports/ubuntu/lpia_no_aligned_funcptr.patch)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/pmc_pct/ports/ubuntu/lpia_no_aligned_funcptr.patch Thu Jun 4 02:32:48 2009 (r39377, copy of r39376, trunk/ports/ubuntu/lpia_no_aligned_funcptr.patch)
@@ -0,0 +1,12 @@
+Index: /trunk/config/auto/gcc.pm
+===================================================================
+--- /trunk/config/auto/gcc.pm (revision 37201)
++++ /trunk/config/auto/gcc.pm (revision 39212)
+@@ -97,5 +97,6 @@
+ );
+ $conf->data->set( HAS_aligned_funcptr => 0 )
+- if $conf->data->get_p5('OSNAME') eq 'hpux';
++ if ( $conf->data->get_p5('OSNAME') eq 'hpux'
++ || $conf->data->get('archname') =~ /gnulp/); # lpia arch
+ return 1;
+ }
Deleted: branches/pmc_pct/runtime/parrot/include/sockets.pasm
==============================================================================
--- branches/pmc_pct/runtime/parrot/include/sockets.pasm Thu Jun 4 02:32:48 2009 (r39376)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,31 +0,0 @@
-# Copyright (C) 2006-2009, Parrot Foundation.
-# $Id$
-
-# families
-.macro_const AF_UNSPEC 0 # unspecified
-.macro_const AF_UNIX 1 # local to host (pipes)
-.macro_const AF_INET 2 # internetwork: UDP, TCP, etc.
-.macro_const AF_INET6 30 # IPv6
-
-
-# types
-.macro_const SOCK_STREAM 1 # stream socket
-.macro_const SOCK_DGRAM 2 # datagram socket
-.macro_const SOCK_RAW 3 # raw-protocol interface
-.macro_const SCOK_SEQPACKET 5 # sequenced packet stream
-
-
-# protocols (RFC 1700)
-.macro_const IPPROTO_IP 0 # dummy for IP
-.macro_const IPPROTO_ICMP 1 # control message protocol
-.macro_const IPPROTO_TCP 6 # tcp
-.macro_const IPPROTO_UDP 17 # user datagram protocol
-.macro_const IPPROTO_IPV6 41 # IP6 header
-.macro_const IPPROTO_RAW 255 # raw IP packet
-.macro_const IPPROTO_MAX 256
-
-# Local Variables:
-# mode: pir
-# fill-column: 100
-# End:
-# vim: expandtab shiftwidth=4 ft=pir:
Copied: branches/pmc_pct/runtime/parrot/languages/parrot/parrot.pir (from r39376, trunk/runtime/parrot/languages/parrot/parrot.pir)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/pmc_pct/runtime/parrot/languages/parrot/parrot.pir Thu Jun 4 02:32:48 2009 (r39377, copy of r39376, trunk/runtime/parrot/languages/parrot/parrot.pir)
@@ -0,0 +1,96 @@
+# Copyright (C) 2009, Parrot Foundation.
+# $Id$
+
+.HLL 'parrot'
+.namespace ['Parrot';'Compiler']
+
+.sub 'load' :anon :load :init
+ # I'm not sure if this is completely right...
+ .local pmc p6meta, c
+ load_bytecode 'PCT.pbc'
+ p6meta = get_hll_global 'P6metaclass'
+ c = p6meta.'new_class'('Parrot::Compiler', 'parent'=>'PCT::HLLCompiler')
+ c.'language'('parrot')
+.end
+
+.sub 'load_library' :method
+ .param pmc name
+ .param pmc extra :named :slurpy
+ .local pmc name, library, inc_hash
+ .local string file
+ $I0 = does name, 'array'
+ if $I0 goto have_namelist
+ $S0 = name
+ name = split '::', $S0
+ have_namelist:
+ file = join '/', name
+ file = concat file, '.pir'
+ load_bytecode file
+ library = new 'Hash'
+ library['name'] = name
+ library['filename'] = file
+ # If this fails, we should build a hash of DEFAULT and ALL => the normal ns
+ $P0 = get_hll_global name, 'EXPORT'
+ library['symbols'] = $P0
+ $P0 = get_hll_namespace name
+ library['namespace'] = $P0
+ .return (library)
+ fail:
+ # TODO: better fail?
+ .return (0)
+.end
+
+.sub 'export' :method
+ .param string list
+ # This should accept a tag...
+ .local pmc syms, i, ns, relns, exportns
+ # We should default to all symbols when none are specified
+ syms = split ' ', list
+ i = getinterp
+ ns = i['namespace';1]
+ relns = new 'ResizablePMCArray'
+ relns.'push'('EXPORT')
+ # This could be a loop, I guess...
+ relns.'push'('ALL')
+ exportns = ns.'make_namespace'(relns)
+ ns.'export_to'(exportns, syms)
+ relns.'pop'()
+ relns.'push'('DEFAULT')
+ exportns = ns.'make_namespace'(relns)
+ ns.'export_to'(exportns, syms)
+.end
+
+# TODO Should this provide support for loading HLL libraries?
+
+=head1 NAME
+
+languages/parrot/parrot.pir - Compiler object for interop between HLLs and
+Parrot-hosted languages
+
+=head1 SYNOPSIS
+
+ # NameSpace MUST match path!
+ .namespace ['Foo']
+ .sub 'load' :anon :load :init
+ .local pmc c
+ load_language 'parrot'
+ c = compreg 'parrot'
+ c.'export'('dance leap')
+ .end
+
+ .sub 'dance'
+ say 'lol dancing'
+ .end
+
+ .sub 'leap'
+ say 'like dancing, but fancier'
+ .end
+
+=cut
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
+
Modified: branches/pmc_pct/runtime/parrot/library/Config/JSON.pir
==============================================================================
--- branches/pmc_pct/runtime/parrot/library/Config/JSON.pir Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/runtime/parrot/library/Config/JSON.pir Thu Jun 4 02:32:48 2009 (r39377)
@@ -71,16 +71,17 @@
expanded = not compact
# render the object as a string.
+ load_bytecode 'JSON.pir'
.local string output
output = _json( config, expanded )
# write out the file..
$P1 = open filename, 'w'
print $P1, output
+ print $P1, "\n"
close $P1
.end
-.include 'library/JSON.pir'
# Local Variables:
# mode: pir
Modified: branches/pmc_pct/runtime/parrot/library/JSON.pir
==============================================================================
--- branches/pmc_pct/runtime/parrot/library/JSON.pir Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/runtime/parrot/library/JSON.pir Thu Jun 4 02:32:48 2009 (r39377)
@@ -9,7 +9,7 @@
Use the C<_json> method to generate a JSON representation of a PMC.
- .include 'library/JSON.pir'
+ load_bytecode 'JSON.pir'
$S0 = _json( $P0 )
To generate a PMC from a JSON string, see L<compilers/json/JSON.pir>.
Modified: branches/pmc_pct/runtime/parrot/library/PGE/Perl6Grammar.pir
==============================================================================
--- branches/pmc_pct/runtime/parrot/library/PGE/Perl6Grammar.pir Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/runtime/parrot/library/PGE/Perl6Grammar.pir Thu Jun 4 02:32:48 2009 (r39377)
@@ -197,7 +197,7 @@
ns_optable:
$P0 = ns['optable']
if $P0 == '' goto iter_loop
- initpir.'emit'(" optable = new ['PGE';'OPTable']")
+ initpir.'emit'(" optable = root_new ['parrot';'PGE';'OPTable']")
$S0 = namespace
$P1 = split '::', $S0
$P1 = initpir.'key'($P1 :flat)
Modified: branches/pmc_pct/runtime/parrot/library/TclLibrary.pir
==============================================================================
--- branches/pmc_pct/runtime/parrot/library/TclLibrary.pir Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/runtime/parrot/library/TclLibrary.pir Thu Jun 4 02:32:48 2009 (r39377)
@@ -204,6 +204,8 @@
push libnames, 'tcl84'
push libnames, 'libtcl8.5'
push libnames, 'libtcl8.4'
+ push libnames, 'libtcl8.5.so'
+ push libnames, 'libtcl8.4.so'
standard_names_e:
.local pmc libtcl
Modified: branches/pmc_pct/runtime/parrot/library/libpcre.pir
==============================================================================
--- branches/pmc_pct/runtime/parrot/library/libpcre.pir Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/runtime/parrot/library/libpcre.pir Thu Jun 4 02:32:48 2009 (r39377)
@@ -35,11 +35,11 @@
## allocate space in string for error message
repeat error, " ", error_size
- PCRE_NCI_compile= get_hll_global ['PCRE::NCI'], 'PCRE_compile'
+ PCRE_NCI_compile = get_hll_global ['PCRE::NCI'], 'PCRE_compile'
.local pmc code
- code= PCRE_NCI_compile( pat, options, error, errptr, NULL )
+ code = PCRE_NCI_compile( pat, options, error, errptr, NULL )
.local int is_code_defined
is_code_defined = defined code
@@ -66,18 +66,18 @@
## osize -- 1/(2/3) * 4 * 2
.local int osize
- osize= 12
+ osize = 12
## number of result pairs
.local int num_result_pairs
- num_result_pairs= 10
+ num_result_pairs = 10
.local int ovector_length
- ovector_length= osize * num_result_pairs
+ ovector_length = osize * num_result_pairs
.local pmc ovector
- ovector= new 'ManagedStruct'
- ovector= ovector_length
+ ovector = new 'ManagedStruct'
+ ovector = ovector_length
## on 32 bit systems
.local pmc PCRE_NCI_exec
@@ -85,7 +85,7 @@
.local int ok
- ok= PCRE_NCI_exec( regex, NULL, s, len, start, options, ovector, 10 )
+ ok = PCRE_NCI_exec( regex, NULL, s, len, start, options, ovector, 10 )
.return( ok, ovector )
.end
Modified: branches/pmc_pct/runtime/parrot/library/pcre.pir
==============================================================================
--- branches/pmc_pct/runtime/parrot/library/pcre.pir Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/runtime/parrot/library/pcre.pir Thu Jun 4 02:32:48 2009 (r39377)
@@ -1,4 +1,4 @@
-# Copyright (C) 2004-2008, Parrot Foundation.
+# Copyright (C) 2004-2009, Parrot Foundation.
# $Id$
=head1 TITLE
@@ -8,7 +8,10 @@
=head1 SYNOPSIS
load_bytecode 'pcre.pbc'
- lib = pcre_init()
+
+ .local pmc func, lib
+ func = get_hll_global ['PCRE'], 'init'
+ lib = func()
func = get_hll_global ['PCRE'], 'compile'
( regex, error, errptr )= func( pat, options )
@@ -194,7 +197,7 @@
.sub version
.local pmc pcre_function
- pcre_function= get_hll_global ['PCRE::NCI'], 'PCRE_version'
+ pcre_function = get_hll_global ['PCRE::NCI'], 'PCRE_version'
.local string ver
Deleted: branches/pmc_pct/runtime/parrot/library/tcpstream.pir
==============================================================================
--- branches/pmc_pct/runtime/parrot/library/tcpstream.pir Thu Jun 4 02:32:48 2009 (r39376)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,278 +0,0 @@
-# Copyright (C) 2006-2009, Parrot Foundation.
-# $Id$
-
-=head1 NAME
-
-TCPStream
-
-=head1 SYNOPSIS
-
- .sub main :main
- load_bytecode 'tcpstream.pir'
-
- .local pmc stream
- stream = new 'TCPStream'
- stream.'connect'("www.google.com", 80)
-
- stream.'say'("GET / HTTP/1.0")
- stream.'say'("User-agent: Parrot")
- stream.'say'("")
-
- $S0 = stream.'slurp'()
- print $S0
-
- stream.'close'()
- .end
-
-=head1 DESCRIPTION
-
-This is a high-level sockets library designed to mimic Tcl's socket builtins. As
-such, it uses C<print> and C<say> instead of C<send> and C<readline> and
-C<slurp> instead of C<recv>.
-
-=head1 VTABLE FUNCTIONS
-
-=over 4
-
-=cut
-
-.namespace ['TCPStream']
-
-.include 'sockets.pasm'
-
-.sub class_init :load :init :anon
- .local pmc class
- class = newclass "TCPStream"
-
- addattribute class, '$.buffer'
- addattribute class, '$.socket'
-.end
-
-=item C<init>
-
-Initialize a TCPStream object (create a socket and a buffer).
-
-=cut
-
-.sub init :anon :vtable :method
- .local pmc buffer
- buffer = new 'String'
- buffer = ''
-
- .local pmc sock
- sock = socket .AF_INET, .SOCK_STREAM, .IPPROTO_IP
-
- setattribute self, '$.buffer', buffer
- setattribute self, '$.socket', sock
-.end
-
-=item C<init_pmc>
-
-Initialize a TCPStream object from an already pre-existing socket. This can be
-use to create servers, among other things.
-
-=cut
-
-.sub init_pmc :anon :vtable :method
- .param pmc sock
-
- .local pmc buffer
- buffer = new 'String'
- buffer = ''
-
- setattribute self, '$.buffer', buffer
- setattribute self, '$.socket', sock
-.end
-
-=item C<get_bool>
-
-Returns whether or not this socket has data waiting to be read.
-
-=cut
-
-.sub get_bool :anon :vtable :method
- .local pmc buffer
- buffer = getattribute self, '$.buffer'
- if buffer != "" goto true
-
- .local pmc sock
- .local int bytes
- sock = getattribute self, '$.socket'
- bytes = recv sock, $S0
- if bytes == 0 goto false
- buffer .= $S0
- goto true
-
-false:
- .return(0)
-
-true:
- .return(1)
-.end
-
-=back
-
-=head1 METHODS
-
-=over 4
-
-=item C<void close()>
-
-Closes the socket.
-
-=cut
-
-.sub close :method
- .local pmc sock
- sock = getattribute self, '$.socket'
-
- close sock
-.end
-
-=item C<void connect(string host, int port)>
-
-Connects to a host/port.
-
-Throws an exception if unable to connect.
-
-=cut
-
-.sub connect :method
- .param string host
- .param int port
-
- .local string address
- .local pmc sock
- address = sockaddr port, host
- sock = getattribute self, '$.socket'
-
- .local int ret
- ret = connect sock, address
- if ret == -1 goto cant_connect
-
- .return()
-
-cant_connect:
- .local pmc excep
- excep = new 'Exception'
- excep[0] = "Can't connect socket"
- throw excep
-.end
-
-=item C<void flush()>
-
-=cut
-
-.sub flush :method
-.end
-
-=item C<string readline()>
-
-Reads and returns up to (and excluding) an end-of-line character and discards
-the end-of-line character.
-
-=cut
-
-.sub readline :method
- .local int idx
- .local pmc buffer
- .local string strbuf
- buffer = getattribute self, '$.buffer'
- strbuf = buffer
- idx = index strbuf, "\n"
- if idx != -1 goto have_newline
-
- .local int ret, len, bytes
- .local pmc sock
- sock = getattribute self, '$.socket'
- len = length strbuf
-loop:
- ret = poll sock, 1, 0, 3
- unless ret goto done
-
- bytes = recv sock, $S0
- unless bytes goto done
- strbuf .= $S0
- idx = index strbuf, "\n", len
- if idx != -1 goto have_newline
- $I0 = length $S0
- len += $I0
- if bytes goto loop
-
-done:
- buffer = ""
- .return(strbuf)
-
-have_newline:
- inc idx
- $S0 = substr strbuf, 0, idx, ""
- buffer = strbuf
- chopn $S0, 1
- .return($S0)
-.end
-
-=item C<void say(string msg)>
-
-Print C<msg> and an end-of-line character to the socket.
-
-=cut
-
-.sub say :method
- .param string msg
-
- .local pmc sock
- sock = getattribute self, '$.socket'
-
- .local int ret
- msg .= "\n"
- ret = send sock, msg
- if ret == -1 goto cant_send
-
- .return()
-
-cant_send:
- .local pmc excep
- excep = new 'Exception'
- excep[0] = "Can't send to socket"
- throw excep
-.end
-
-=item C<string slurp()>
-
-Return all the data in the socket.
-
-=cut
-
-.sub slurp :method
- .local pmc sock, buffer
- sock = getattribute self, '$.socket'
- buffer = getattribute self, '$.buffer'
-
- .local int ret, bytes
-loop:
- ret = poll sock, 1, 0, 3
- unless ret goto done
-
- bytes = recv sock, $S0
- buffer .= $S0
- if bytes goto loop
-
-done:
- $S0 = buffer
- buffer = ""
- .return($S0)
-.end
-
-=back
-
-=head1 AUTHOR
-
-Matt Diephouse <matt at diephouse.com>.
-
-=cut
-
-# Local Variables:
-# mode: pir
-# fill-column: 100
-# End:
-# vim: expandtab shiftwidth=4 ft=pir:
Modified: branches/pmc_pct/src/call/pcc.c
==============================================================================
--- branches/pmc_pct/src/call/pcc.c Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/call/pcc.c Thu Jun 4 02:32:48 2009 (r39377)
@@ -188,15 +188,13 @@
ARGMOD(Parrot_Context *ctx),
ARGMOD(opcode_t **indexes),
ARGIN(const char *ret_x),
- ARGMOD(va_list returns))
+ va_list returns)
__attribute__nonnull__(1)
__attribute__nonnull__(2)
__attribute__nonnull__(3)
__attribute__nonnull__(4)
- __attribute__nonnull__(5)
FUNC_MODIFIES(*ctx)
- FUNC_MODIFIES(*indexes)
- FUNC_MODIFIES(returns);
+ FUNC_MODIFIES(*indexes);
static int set_retval_util(PARROT_INTERP,
ARGIN(const char *sig),
@@ -310,8 +308,7 @@
PARROT_ASSERT_ARG(interp) \
|| PARROT_ASSERT_ARG(ctx) \
|| PARROT_ASSERT_ARG(indexes) \
- || PARROT_ASSERT_ARG(ret_x) \
- || PARROT_ASSERT_ARG(returns)
+ || PARROT_ASSERT_ARG(ret_x)
#define ASSERT_ARGS_set_retval_util __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
|| PARROT_ASSERT_ARG(sig) \
@@ -369,11 +366,11 @@
ARGIN(const char *sig), va_list args)
{
ASSERT_ARGS(Parrot_pcc_build_sig_object_from_varargs)
- PMC *type_tuple = PMCNULL;
- PMC *returns = PMCNULL;
- PMC *call_object = pmc_new(interp, enum_class_CallSignature);
- STRING *string_sig = Parrot_str_new_constant(interp, sig);
- const INTVAL sig_len = Parrot_str_byte_length(interp, string_sig);
+ PMC *type_tuple = PMCNULL;
+ PMC *returns = PMCNULL;
+ PMC * const call_object = pmc_new(interp, enum_class_CallSignature);
+ STRING *string_sig = Parrot_str_new_constant(interp, sig);
+ const INTVAL sig_len = Parrot_str_byte_length(interp, string_sig);
INTVAL in_return_sig = 0;
INTVAL i;
@@ -972,7 +969,7 @@
next_arg_sig(interp, &st->dest);
if (st->dest.sig & PARROT_ARG_SLURPY_ARRAY) {
- PMC *slurped = pmc_new(interp,
+ PMC * const slurped = pmc_new(interp,
Parrot_get_ctx_HLL_type(interp, enum_class_ResizablePMCArray));
PARROT_ASSERT((st->dest.sig & PARROT_ARG_TYPE_MASK) == PARROT_ARG_PMC);
@@ -1666,7 +1663,7 @@
* RT #54860 and others
* Save current value while setting the optional
*/
- UnionVal old_value = st->val;
+ const UnionVal old_value = st->val;
while (dest->sig & PARROT_ARG_OPTIONAL) {
null_val(st->dest.sig, st);
@@ -2400,14 +2397,14 @@
{
ASSERT_ARGS(set_context_sig_returns)
const char *x;
- STRING *empty_string = CONST_STRING(interp, "");
+ STRING * const empty_string = CONST_STRING(interp, "");
unsigned int index = 0;
unsigned int seen_arrow = 1;
/* result_accessors perform the arg accessor function,
* assigning the corresponding registers to the result variables */
for (x = ret_x; x && *x; x++) {
- PMC *result_item = VTABLE_get_pmc_keyed_int(interp, result_list, index);
+ PMC * const result_item = VTABLE_get_pmc_keyed_int(interp, result_list, index);
if (isupper((unsigned char)*x)) {
switch (*x) {
case 'I':
@@ -2469,7 +2466,7 @@
static void
set_context_sig_returns_varargs(PARROT_INTERP, ARGMOD(Parrot_Context *ctx),
- ARGMOD(opcode_t **indexes), ARGIN(const char *ret_x), ARGMOD(va_list returns))
+ ARGMOD(opcode_t **indexes), ARGIN(const char *ret_x), va_list returns)
{
ASSERT_ARGS(set_context_sig_returns_varargs)
unsigned int index = 0;
Modified: branches/pmc_pct/src/datatypes.c
==============================================================================
--- branches/pmc_pct/src/datatypes.c Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/datatypes.c Thu Jun 4 02:32:48 2009 (r39377)
@@ -94,10 +94,10 @@
PARROT_EXPORT
FLOATVAL
-floatval_divide_by_zero(PARROT_INTERP, FLOATVAL num)
+floatval_divide_by_zero(SHIM_INTERP, FLOATVAL num)
{
ASSERT_ARGS(floatval_divide_by_zero)
- FLOATVAL zero = 0.0;
+ const FLOATVAL zero = 0.0;
return num / zero;
}
Modified: branches/pmc_pct/src/dynext.c
==============================================================================
--- branches/pmc_pct/src/dynext.c Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/dynext.c Thu Jun 4 02:32:48 2009 (r39377)
@@ -352,6 +352,14 @@
return path;
}
#endif
+
+ /* And after-finally, let the OS use his own search */
+ if (!STRING_IS_EMPTY(lib)) {
+ *handle = dlopen_string(interp, lib);
+ if (*handle)
+ return lib;
+ }
+
err = Parrot_dlerror();
Parrot_warn(interp, PARROT_WARNINGS_DYNEXT_FLAG,
"Couldn't load '%Ss': %s\n",
Modified: branches/pmc_pct/src/exceptions.c
==============================================================================
--- branches/pmc_pct/src/exceptions.c Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/exceptions.c Thu Jun 4 02:32:48 2009 (r39377)
@@ -227,8 +227,17 @@
address = VTABLE_invoke(interp, handler, dest);
+ /* XXX This is an obvious hack. We need to identify here whether this is
+ an ExceptionHandler proper or a PIR-defined subclass. This conditional
+ monstrosity attempts to check whether this is an object of a PIR-defined
+ subclass. When we have garbage-collectable PMCs, we shouldn't need to do
+ this nonsense. See TT#154 for details */
+ if (handler->vtable->base_type == enum_class_Object) {
+ /* Don't know what to do here to make sure the exception parameter gets
+ passed properly. */
+ }
/* Set up the continuation context of the handler in the interpreter. */
- if (PMC_cont(handler)->current_results)
+ else if (PMC_cont(handler)->current_results)
address = pass_exception_args(interp, "P", address,
CONTEXT(interp), exception);
@@ -363,6 +372,10 @@
PDB_backtrace(interp);
}
+ /* Note the thrower.
+ * XXX TT#596 - pass in current context instead when we have context PMCs. */
+ VTABLE_set_attr_str(interp, exception, CONST_STRING(interp, "thrower"), CONTEXT(interp)->current_cont);
+
/* it's a C exception handler */
if (PObj_get_FLAGS(handler) & SUB_FLAG_C_HANDLER) {
Parrot_runloop * const jump_point =
Copied: branches/pmc_pct/src/gc/alloc_memory.c (from r39376, trunk/src/gc/alloc_memory.c)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/pmc_pct/src/gc/alloc_memory.c Thu Jun 4 02:32:48 2009 (r39377, copy of r39376, trunk/src/gc/alloc_memory.c)
@@ -0,0 +1,357 @@
+/*
+Copyright (C) 2001-2009, Parrot Foundation.
+$Id$
+
+=head1 NAME
+
+src/gc/memory.c - Memory allocation
+
+=head1 DESCRIPTION
+
+The memory (mem) API handles memory allocation,
+
+Basically just a wrapper C<around malloc/calloc/realloc/free()> with an
+setup function to initialize the memory pools.
+
+=head2 Functions
+
+=over 4
+
+=cut
+
+*/
+
+#include "parrot/parrot.h"
+#include "parrot/memory.h"
+
+/* HEADERIZER HFILE: include/parrot/memory.h */
+
+/*
+
+=item C<void * mem_sys_allocate(size_t size)>
+
+Uses C<malloc> to allocate system memory. Panics if the system cannot
+return memory.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+PARROT_MALLOC
+PARROT_CANNOT_RETURN_NULL
+void *
+mem_sys_allocate(size_t size)
+{
+ ASSERT_ARGS(mem_sys_allocate)
+ void * const ptr = malloc(size);
+#ifdef DETAIL_MEMORY_DEBUG
+ fprintf(stderr, "Allocated %i at %p\n", size, ptr);
+#endif
+ if (!ptr)
+ PANIC(NULL, "Out of mem");
+ return ptr;
+}
+
+/*
+
+=item C<void * mem__internal_allocate(size_t size, const char *file, int line)>
+
+Calls C<malloc> to allocate memory from the system, Panics if there is no
+memory available. If C<DETAIL_MEMORY_DEBUG> macro is defined, prints
+debug information to C<STDERR>.
+
+=cut
+
+*/
+
+PARROT_MALLOC
+PARROT_CANNOT_RETURN_NULL
+void *
+mem__internal_allocate(size_t size, ARGIN(const char *file), int line)
+{
+ ASSERT_ARGS(mem__internal_allocate)
+ void * const ptr = malloc((size_t)size);
+#ifdef DETAIL_MEMORY_DEBUG
+ fprintf(stderr, "Internal malloc %i at %p (%s/%d)\n",
+ size, ptr, file, line);
+#else
+ UNUSED(file);
+ UNUSED(line);
+#endif
+ if (!ptr)
+ PANIC(NULL, "Out of mem");
+ return ptr;
+}
+
+/*
+
+=item C<void * mem_sys_allocate_zeroed(size_t size)>
+
+Uses C<calloc> to allocate system memory. Guaranteed to succeed, Panics
+otherwise.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+PARROT_MALLOC
+PARROT_CANNOT_RETURN_NULL
+void *
+mem_sys_allocate_zeroed(size_t size)
+{
+ ASSERT_ARGS(mem_sys_allocate_zeroed)
+ void * const ptr = calloc(1, (size_t)size);
+#ifdef DETAIL_MEMORY_DEBUG
+ fprintf(stderr, "Allocated %i at %p\n", size, ptr);
+#endif
+ if (!ptr)
+ PANIC(NULL, "Out of mem");
+ return ptr;
+}
+
+/*
+
+=item C<void * mem__internal_allocate_zeroed(size_t size, const char *file, int
+line)>
+
+Uses C<calloc> to allocate system memory. Guaranteed to succeed, Panics
+otherwise. If C<DETAIL_MEMORY_DEBUG> macro is defined, prints
+debug information to C<STDERR>.
+
+=cut
+
+*/
+
+PARROT_MALLOC
+PARROT_CANNOT_RETURN_NULL
+void *
+mem__internal_allocate_zeroed(size_t size, ARGIN(const char *file), int line)
+{
+ ASSERT_ARGS(mem__internal_allocate_zeroed)
+ void * const ptr = calloc(1, (size_t)size);
+#ifdef DETAIL_MEMORY_DEBUG
+ fprintf(stderr, "Internal malloc %i at %p (%s/%d)\n",
+ size, ptr, file, line);
+#else
+ UNUSED(file);
+ UNUSED(line);
+#endif
+ if (!ptr)
+ PANIC(NULL, "Out of mem");
+ return ptr;
+}
+
+/*
+
+=item C<void * mem_sys_realloc(void *from, size_t size)>
+
+Resizes a chunk of memory. Unlike C<realloc>, it can handle a
+NULL pointer, in which case it calls C<calloc> to create the memory
+block.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+PARROT_MALLOC
+PARROT_CANNOT_RETURN_NULL
+void *
+mem_sys_realloc(ARGFREE(void *from), size_t size)
+{
+ ASSERT_ARGS(mem_sys_realloc)
+ void *ptr;
+#ifdef DETAIL_MEMORY_DEBUG
+ fprintf(stderr, "Freed %p (realloc -- %i bytes)\n", from, size);
+#endif
+ if (from)
+ ptr = realloc(from, size);
+ else
+ ptr = calloc(1, size);
+#ifdef DETAIL_MEMORY_DEBUG
+ fprintf(stderr, "Allocated %i at %p\n", size, ptr);
+#endif
+ if (!ptr)
+ PANIC(NULL, "Out of mem");
+ return ptr;
+}
+
+
+/*
+
+=item C<void * mem_sys_realloc_zeroed(void *from, size_t size, size_t old_size)>
+
+Resizes a chunk of system memory and fills the newly allocated space
+with zeroes. If the pointer is C<NULL> a new memory block is
+allocated and zeroed instead.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+PARROT_MALLOC
+PARROT_CANNOT_RETURN_NULL
+void *
+mem_sys_realloc_zeroed(ARGFREE(void *from), size_t size, size_t old_size)
+{
+ ASSERT_ARGS(mem_sys_realloc_zeroed)
+ void *ptr;
+#ifdef DETAIL_MEMORY_DEBUG
+ fprintf(stderr, "Freed %p (realloc -- %i bytes)\n", from, size);
+#endif
+ ptr = from ? realloc(from, size) : malloc(size);
+#ifdef DETAIL_MEMORY_DEBUG
+ fprintf(stderr, "Allocated %i at %p\n", size, ptr);
+#endif
+ if (!ptr)
+ PANIC(NULL, "Out of mem");
+
+ if (size > old_size)
+ memset((char*)ptr + old_size, 0, size - old_size);
+
+ return ptr;
+}
+
+/*
+
+=item C<void * mem__internal_realloc(void *from, size_t size, const char *file,
+int line)>
+
+Resizes a chunk of system memory. Unlike C<realloc>, it can handle a
+NULL pointer, in which case a new memory block is allocated for the
+requested size. If C<DETAIL_MEMORY_DEBUG> macro is defined, debug
+information is printed to C<STDERR>.
+
+=cut
+
+*/
+
+PARROT_MALLOC
+PARROT_CANNOT_RETURN_NULL
+void *
+mem__internal_realloc(ARGFREE(void *from), size_t size,
+ ARGIN(const char *file), int line)
+{
+ ASSERT_ARGS(mem__internal_realloc)
+ void * const ptr = realloc(from, size);
+#ifdef DETAIL_MEMORY_DEBUG
+ fprintf(stderr, "internal free of %p (realloc -- %i bytes) (%s/%d)\n",
+ from, size, file, line);
+ fprintf(stderr, "Internal malloc %i at %p (%s/%d)\n",
+ size, ptr, file, line);
+#else
+ UNUSED(file);
+ UNUSED(line);
+#endif
+ if (!ptr)
+ PANIC(NULL, "Out of mem");
+ return ptr;
+}
+
+#if 0
+
+/*
+
+=item C<void * mem__internal_realloc_zeroed(void *from, size_t size, size_t
+old_size, const char *file, int line)>
+
+Reallocates a given buffer of size C<old_size> to C<size>. If the new size
+is larger then the old size, the difference is filled with zeros. Contains
+debugging information, and can print filename and line number where it is
+used if C<DETAIL_MEMORY_DEBUG> is defined.
+
+=cut
+
+*/
+
+PARROT_MALLOC
+PARROT_CANNOT_RETURN_NULL
+void *
+mem__internal_realloc_zeroed(ARGFREE(void *from), size_t size, size_t old_size,
+ ARGIN(const char *file), int line)
+{
+ ASSERT_ARGS(mem__internal_realloc_zeroed)
+ void * const ptr = realloc(from, size);
+# ifdef DETAIL_MEMORY_DEBUG
+ fprintf(stderr, "internal free of %p (realloc -- %i bytes) (%s/%d)\n",
+ from, size, file, line);
+ fprintf(stderr, "Internal malloc %i at %p (%s/%d)\n",
+ size, ptr, file, line);
+# else
+ UNUSED(file);
+ UNUSED(line);
+# endif
+ if (!ptr)
+ PANIC(NULL, "Out of mem");
+ if (size > old_size)
+ memset((char*)ptr + old_size, 0, size - old_size);
+
+ return ptr;
+}
+
+#endif
+
+/*
+
+=item C<void mem_sys_free(void *from)>
+
+Frees a chunk of memory back to the system.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+mem_sys_free(ARGFREE(void *from))
+{
+ ASSERT_ARGS(mem_sys_free)
+#ifdef DETAIL_MEMORY_DEBUG
+ fprintf(stderr, "Freed %p\n", from);
+#endif
+ if (from)
+ free(from);
+}
+
+/*
+
+=item C<void mem__internal_free(void *from, const char *file, int line)>
+
+Frees a chunk of memory back to the system. If
+C<DETAIL_MEMORY_DEBUG> macro is defined, prints debug information to
+C<STDERR>.
+
+=cut
+
+*/
+
+void
+mem__internal_free(ARGFREE(void *from), ARGIN(const char *file), int line)
+{
+ ASSERT_ARGS(mem__internal_free)
+#ifdef DETAIL_MEMORY_DEBUG
+ fprintf(stderr, "Internal free of %p (%s/%d)\n", from, file, line);
+#else
+ UNUSED(file);
+ UNUSED(line);
+#endif
+ free(from);
+}
+
+/*
+
+=back
+
+=cut
+
+*/
+
+/*
+ * Local variables:
+ * c-file-style: "parrot"
+ * End:
+ * vim: expandtab shiftwidth=4:
+ */
Copied: branches/pmc_pct/src/gc/alloc_register.c (from r39376, trunk/src/gc/alloc_register.c)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/pmc_pct/src/gc/alloc_register.c Thu Jun 4 02:32:48 2009 (r39377, copy of r39376, trunk/src/gc/alloc_register.c)
@@ -0,0 +1,813 @@
+/*
+Copyright (C) 2001-2009, Parrot Foundation.
+$Id$
+
+=head1 NAME
+
+src/gc/register.c - Register handling routines
+
+=head1 DESCRIPTION
+
+Parrot has 4 register sets, one for each of its basic types. The number of
+registers in each set varies depending on the use counts of the subroutine and
+is determined by the PASM/PIR compiler in the register allocation pass
+(F<imcc/reg_alloc.c>).
+
+=cut
+
+*/
+
+#include "parrot/parrot.h"
+#include "parrot/register.h"
+#include "../pmc/pmc_sub.h"
+
+
+/* set CTX_LEAK_DEBUG_FULL to 1 for enhanced context debugging.
+ * When set (1) freed contexts are "poisoned" so that any dangling
+ * references produce segfaults, and (2) contexts are not recycled
+ * so that later allocations don't suddenly restore a dangling
+ * reference to a "working" condition.
+ */
+#define CTX_LEAK_DEBUG_FULL 0
+
+
+
+/* HEADERIZER HFILE: include/parrot/register.h */
+
+/* HEADERIZER BEGIN: static */
+/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
+
+static void clear_regs(PARROT_INTERP, ARGMOD(Parrot_Context *ctx))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ FUNC_MODIFIES(*ctx);
+
+static void init_context(PARROT_INTERP,
+ ARGMOD(Parrot_Context *ctx),
+ ARGIN_NULLOK(const Parrot_Context *old))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ FUNC_MODIFIES(*ctx);
+
+#define ASSERT_ARGS_clear_regs __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(ctx)
+#define ASSERT_ARGS_init_context __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(ctx)
+/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
+/* HEADERIZER END: static */
+
+
+/*
+=head2 Context and register frame layout
+
+ +----------++----+------+------------+----+
+ | context || N | I | P | S +
+ +----------++----+------+------------+----+
+ ^ ^ ^ ^
+ | | ctx.bp ctx.bp_ps
+ ctx.state opt
+ padding
+
+Registers are addressed as usual via the register base pointer ctx.bp.
+
+The macro CONTEXT() hides these details
+
+=cut
+
+*/
+
+/*
+=head2 Context and register frame allocation
+
+There are two allocation strategies: chunked memory and malloced with a free
+list.
+
+ CHUNKED_CTX_MEM = 1
+
+C<ctx_mem.data> is a pointer to an allocated chunk of memory. The pointer
+C<ctx_mem.free> holds the next usable location. With (full) continuations the
+C<ctx_mem.free> pointer can't be moved below the C<ctx_mem.threshold>, which is
+the highest context pointer of all active continuations.
+
+[the code for this is incomplete; it had suffered some bit-rot and was
+getting in the way of maintaining the other case. -- rgr, 4-Feb-06.]
+
+RT #46177 GC has to lower this threshold when collecting continuations.
+
+ CHUNKED_CTX_MEM = 0
+
+Context/register memory is malloced. C<ctx_mem.free> is used as a free list of
+reusable items.
+
+=cut
+
+*/
+
+#define CTX_ALLOC_SIZE 0x20000
+
+#define ALIGNED_CTX_SIZE (((sizeof (Parrot_Context) + NUMVAL_SIZE - 1) \
+ / NUMVAL_SIZE) * NUMVAL_SIZE)
+
+/*
+
+=pod
+
+Round register allocation size up to the nearest multiple of 8. A granularity
+of 8 is arbitrary, it could have been some bigger power of 2. A "slot" is an
+index into the free_list array. Each slot in free_list has a linked list of
+pointers to already allocated contexts available for (re)use. The slot where
+an available context is stored corresponds to the size of the context.
+
+=cut
+
+*/
+
+#define SLOT_CHUNK_SIZE 8
+
+#define ROUND_ALLOC_SIZE(size) ((((size) + SLOT_CHUNK_SIZE - 1) \
+ / SLOT_CHUNK_SIZE) * SLOT_CHUNK_SIZE)
+#define CALCULATE_SLOT_NUM(size) ((size) / SLOT_CHUNK_SIZE)
+
+#if CHUNKED_CTX_MEM
+ # error "Non-working code removed."
+#endif
+
+/*
+
+=head2 Context and Register Allocation Functions
+
+=over 4
+
+=cut
+
+*/
+
+/*
+
+=item C<void destroy_context(PARROT_INTERP)>
+
+Frees allocated context memory.
+
+=cut
+
+*/
+
+void
+destroy_context(PARROT_INTERP)
+{
+ ASSERT_ARGS(destroy_context)
+ Parrot_Context *context = CONTEXT(interp);
+ int slot;
+
+ while (context) {
+ Parrot_Context * const prev = context->caller_ctx;
+
+ /* always collect the parentmost context in the parentmost interp*/
+ if (!prev && !interp->parent_interpreter)
+ context->ref_count = 1;
+
+ Parrot_free_context(interp, context, 1);
+
+ context = prev;
+ }
+
+ /* clear freed contexts */
+ for (slot = 0; slot < interp->ctx_mem.n_free_slots; ++slot) {
+ void *ptr = interp->ctx_mem.free_list[slot];
+ while (ptr) {
+ void * const next = *(void **) ptr;
+ mem_sys_free(ptr);
+ ptr = next;
+ }
+ }
+ mem_sys_free(interp->ctx_mem.free_list);
+}
+
+
+/*
+
+=item C<void create_initial_context(PARROT_INTERP)>
+
+Creates the interpreter's initial context.
+
+=cut
+
+*/
+
+void
+create_initial_context(PARROT_INTERP)
+{
+ ASSERT_ARGS(create_initial_context)
+ static INTVAL num_regs[] = {32, 32, 32, 32};
+ Parrot_Context *ignored;
+
+ /* Create some initial free_list slots. */
+
+#define INITIAL_FREE_SLOTS 8
+ interp->ctx_mem.n_free_slots = INITIAL_FREE_SLOTS;
+ interp->ctx_mem.free_list = mem_allocate_n_zeroed_typed(INITIAL_FREE_SLOTS, void *);
+
+ /* For now create context with 32 regs each. Some src tests (and maybe
+ * other extenders) assume the presence of these registers */
+ ignored = Parrot_set_new_context(interp, num_regs);
+ UNUSED(ignored);
+}
+
+
+/*
+
+=item C<void parrot_gc_context(PARROT_INTERP)>
+
+Cleans up dead context memory; called by the garbage collector. This only
+applies in the chunked context memory scheme.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+parrot_gc_context(PARROT_INTERP)
+{
+ ASSERT_ARGS(parrot_gc_context)
+#if CHUNKED_CTX_MEM
+ Parrot_Context ctx;
+ ASSERT_ARGS(parrot_gc_context)
+
+ if (!interp->ctx_mem.threshold)
+ return;
+ LVALUE_CAST(char *, ctx.bp) = interp->ctx_mem.threshold
+ - sizeof (parrot_regs_t);
+#else
+ UNUSED(interp);
+#endif
+}
+
+
+/*
+
+=item C<static void clear_regs(PARROT_INTERP, Parrot_Context *ctx)>
+
+Clears all registers in a context. PMC and STRING registers contain PMCNULL
+and NULL, respectively. Integer and float registers contain negative flag
+values, for debugging purposes.
+
+=cut
+
+*/
+
+static void
+clear_regs(PARROT_INTERP, ARGMOD(Parrot_Context *ctx))
+{
+ ASSERT_ARGS(clear_regs)
+ int i;
+
+ /* NULL out registers - P/S have to be NULL for GC
+ *
+ * if the architecture has 0x := NULL and 0.0 we could memset too
+ */
+
+ for (i = 0; i < ctx->n_regs_used[REGNO_PMC]; i++) {
+ CTX_REG_PMC(ctx, i) = PMCNULL;
+ }
+
+ for (i = 0; i < ctx->n_regs_used[REGNO_STR]; i++) {
+ CTX_REG_STR(ctx, i) = NULL;
+ }
+
+ if (Interp_debug_TEST(interp, PARROT_REG_DEBUG_FLAG)) {
+ /* depending on -D40 we set int and num to be identifiable garbage values */
+ for (i = 0; i < ctx->n_regs_used[REGNO_INT]; i++) {
+ CTX_REG_INT(ctx, i) = -999;
+ }
+ for (i = 0; i < ctx->n_regs_used[REGNO_NUM]; i++) {
+ CTX_REG_NUM(ctx, i) = -99.9;
+ }
+ }
+}
+
+
+/*
+
+=item C<static void init_context(PARROT_INTERP, Parrot_Context *ctx, const
+Parrot_Context *old)>
+
+Initializes a freshly allocated or recycled context.
+
+=cut
+
+*/
+
+static void
+init_context(PARROT_INTERP, ARGMOD(Parrot_Context *ctx),
+ ARGIN_NULLOK(const Parrot_Context *old))
+{
+ ASSERT_ARGS(init_context)
+ ctx->ref_count = 0;
+ ctx->gc_mark = 0;
+ ctx->current_results = NULL;
+ ctx->results_signature = NULL;
+ ctx->lex_pad = PMCNULL;
+ ctx->outer_ctx = NULL;
+ ctx->current_cont = NULL;
+ ctx->current_object = NULL;
+ ctx->handlers = PMCNULL;
+ ctx->caller_ctx = NULL;
+
+ if (old) {
+ /* some items should better be COW copied */
+ ctx->constants = old->constants;
+ ctx->warns = old->warns;
+ ctx->errors = old->errors;
+ ctx->trace_flags = old->trace_flags;
+ ctx->pred_offset = old->pred_offset;
+ ctx->current_HLL = old->current_HLL;
+ ctx->current_namespace = old->current_namespace;
+ /* end COW */
+ ctx->recursion_depth = old->recursion_depth;
+ }
+ else {
+ ctx->constants = NULL;
+ ctx->warns = 0;
+ ctx->errors = 0;
+ ctx->trace_flags = 0;
+ ctx->pred_offset = 0;
+ ctx->current_HLL = 0;
+ ctx->current_namespace = PMCNULL;
+ ctx->recursion_depth = 0;
+ }
+
+ /* other stuff is set inside Sub.invoke */
+ clear_regs(interp, ctx);
+}
+
+
+/*
+
+=item C<Parrot_Context * Parrot_push_context(PARROT_INTERP, const INTVAL
+*n_regs_used)>
+
+Creates and sets the current context to a new context, remembering the old
+context in C<caller_ctx>. Suitable to use with C<Parrot_pop_context>.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+PARROT_WARN_UNUSED_RESULT
+PARROT_CANNOT_RETURN_NULL
+Parrot_Context *
+Parrot_push_context(PARROT_INTERP, ARGIN(const INTVAL *n_regs_used))
+{
+ ASSERT_ARGS(Parrot_push_context)
+ Parrot_Context * const old = CONTEXT(interp);
+ Parrot_Context * const ctx = Parrot_set_new_context(interp, n_regs_used);
+
+ ctx->caller_ctx = old;
+
+ /* doesn't change */
+ ctx->current_sub = old->current_sub;
+
+ /* copy more ? */
+ return ctx;
+}
+
+
+/*
+
+=item C<void Parrot_pop_context(PARROT_INTERP)>
+
+Frees the context created with C<Parrot_push_context> and restores the previous
+context (the caller context).
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_pop_context(PARROT_INTERP)
+{
+ ASSERT_ARGS(Parrot_pop_context)
+ Parrot_Context * const ctx = CONTEXT(interp);
+ Parrot_Context * const old = ctx->caller_ctx;
+
+#if CTX_LEAK_DEBUG
+ if (ctx->ref_count > 0 &&
+ Interp_debug_TEST(interp, PARROT_CTX_DESTROY_DEBUG_FLAG)) {
+ fprintf(stderr, "[force recycle of context %p (%d refs)]\n",
+ (void *)ctx, ctx->ref_count);
+ }
+#endif
+ ctx->ref_count = 0;
+ Parrot_free_context(interp, ctx, 0);
+
+ /* restore old, set cached interpreter base pointers */
+ CONTEXT(interp) = old;
+ interp->ctx.bp = old->bp;
+ interp->ctx.bp_ps = old->bp_ps;
+}
+
+
+/*
+
+=item C<Parrot_Context * Parrot_alloc_context(PARROT_INTERP, const INTVAL
+*number_regs_used, Parrot_Context *old)>
+
+Allocates and returns a new context. Does not set this new context as the
+current context. Note that the register usage C<n_regs_used> is copied. Use
+the init flag to indicate whether you want to initialize the new context
+(setting its default values and clearing its registers).
+
+=cut
+
+*/
+
+PARROT_CANNOT_RETURN_NULL
+PARROT_WARN_UNUSED_RESULT
+Parrot_Context *
+Parrot_alloc_context(PARROT_INTERP, ARGIN(const INTVAL *number_regs_used),
+ ARGIN_NULLOK(Parrot_Context *old))
+{
+ ASSERT_ARGS(Parrot_alloc_context)
+ Parrot_Context *ctx;
+ void *p;
+
+ const size_t size_i = sizeof (INTVAL) * number_regs_used[REGNO_INT];
+ const size_t size_n = sizeof (FLOATVAL) * number_regs_used[REGNO_NUM];
+ const size_t size_s = sizeof (STRING *) * number_regs_used[REGNO_STR];
+ const size_t size_p = sizeof (PMC *) * number_regs_used[REGNO_PMC];
+
+ const size_t size_nip = size_n + size_i + size_p;
+ const size_t all_regs_size = size_n + size_i + size_p + size_s;
+ const size_t reg_alloc = ROUND_ALLOC_SIZE(all_regs_size);
+ const int slot = CALCULATE_SLOT_NUM(reg_alloc);
+
+ /*
+ * If slot is beyond the end of the allocated list, extend the list to
+ * allocate more slots.
+ */
+ if (slot >= interp->ctx_mem.n_free_slots) {
+ const int extend_size = slot + 1;
+ int i;
+
+ mem_realloc_n_typed(interp->ctx_mem.free_list, extend_size, void *);
+ for (i = interp->ctx_mem.n_free_slots; i < extend_size; ++i)
+ interp->ctx_mem.free_list[i] = NULL;
+ interp->ctx_mem.n_free_slots = extend_size;
+ }
+
+ /*
+ * The free_list contains a linked list of pointers for each size (slot
+ * index). Pop off an available context of the desired size from free_list.
+ * If no contexts of the desired size are available, allocate a new one.
+ */
+ ctx = (Parrot_Context *)interp->ctx_mem.free_list[slot];
+
+ if (ctx) {
+ /*
+ * Store the next pointer from the linked list for this size (slot
+ * index) in free_list. On "*(void **) ctx", C won't dereference a void
+ * * pointer (untyped), so type cast ctx to void ** (a dereference-able
+ * type) then dereference it to get a void *. Store the dereferenced
+ * value (the next pointer in the linked list) in free_list.
+ */
+ interp->ctx_mem.free_list[slot] = *(void **)ctx;
+ }
+ else {
+ const size_t to_alloc = reg_alloc + ALIGNED_CTX_SIZE;
+ ctx = (Parrot_Context *)mem_sys_allocate(to_alloc);
+ }
+
+ ctx->n_regs_used[REGNO_INT] = number_regs_used[REGNO_INT];
+ ctx->n_regs_used[REGNO_NUM] = number_regs_used[REGNO_NUM];
+ ctx->n_regs_used[REGNO_STR] = number_regs_used[REGNO_STR];
+ ctx->n_regs_used[REGNO_PMC] = number_regs_used[REGNO_PMC];
+
+#if CTX_LEAK_DEBUG
+ if (Interp_debug_TEST(interp, PARROT_CTX_DESTROY_DEBUG_FLAG)) {
+ fprintf(stderr, "[alloc ctx %p]\n", ctx);
+ }
+#endif
+
+ ctx->regs_mem_size = reg_alloc;
+
+ /* regs start past the context */
+ p = (void *) ((char *)ctx + ALIGNED_CTX_SIZE);
+
+ /* ctx.bp points to I0, which has Nx on the left */
+ ctx->bp.regs_i = (INTVAL *)((char *)p + size_n);
+
+ /* ctx.bp_ps points to S0, which has Px on the left */
+ ctx->bp_ps.regs_s = (STRING **)((char *)p + size_nip);
+
+ init_context(interp, ctx, old);
+
+ return ctx;
+}
+
+
+/*
+
+=item C<Parrot_Context * Parrot_set_new_context(PARROT_INTERP, const INTVAL
+*number_regs_used)>
+
+Allocates and returns a new context as the current context. Note that the
+register usage C<n_regs_used> is copied.
+
+=cut
+
+*/
+
+PARROT_CANNOT_RETURN_NULL
+PARROT_WARN_UNUSED_RESULT
+Parrot_Context *
+Parrot_set_new_context(PARROT_INTERP, ARGIN(const INTVAL *number_regs_used))
+{
+ ASSERT_ARGS(Parrot_set_new_context)
+ Parrot_Context *old = CONTEXT(interp);
+ Parrot_Context *ctx = Parrot_alloc_context(interp, number_regs_used, old);
+
+ CONTEXT(interp) = ctx;
+ interp->ctx.bp.regs_i = ctx->bp.regs_i;
+ interp->ctx.bp_ps.regs_s = ctx->bp_ps.regs_s;
+
+ return ctx;
+}
+
+
+/*
+
+=item C<void Parrot_free_context(PARROT_INTERP, Parrot_Context *ctx, int deref)>
+
+Frees the context if its reference count is zero. If C<deref>
+is true, then reduce the reference count prior to determining
+if the context should be freed.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_free_context(PARROT_INTERP, ARGMOD(Parrot_Context *ctx), int deref)
+{
+ ASSERT_ARGS(Parrot_free_context)
+ /*
+ * The context structure has a reference count, initially 0.
+ * This field is incremented when something outside of the normal
+ * calling chain (such as a continuation or outer scope) wants to
+ * preserve the context. The field is decremented when
+ * Parrot_free_context is called with the C<deref> flag set true.
+ * To trace context handling and check for leaks,
+ * (a) disable NDEBUG, (b) enable CTX_LEAK_DEBUG in interpreter.h,
+ * and (c) execute "debug 0x80" in a (preferably small) test case.
+ *
+ */
+ if (deref) {
+#if CTX_LEAK_DEBUG
+ if (Interp_debug_TEST(interp, PARROT_CTX_DESTROY_DEBUG_FLAG)) {
+ fprintf(stderr, "[reference to context %p released]\n", (void*)ctx);
+ }
+#endif
+ ctx->ref_count--;
+ }
+
+ if (ctx->ref_count <= 0) {
+ void *ptr;
+ int slot;
+
+#ifndef NDEBUG
+ if (Interp_debug_TEST(interp, PARROT_CTX_DESTROY_DEBUG_FLAG)
+ && ctx->current_sub) {
+ /* can't probably Parrot_io_eprintf here */
+ Parrot_sub *doomed;
+ PMC_get_sub(interp, ctx->current_sub, doomed);
+
+ if (doomed) {
+ fprintf(stderr, "[free ctx %p of sub '%s']\n",
+ (void *)ctx,
+ (doomed->name == (void*)0xdeadbeef
+ ? "???"
+ : (char*)doomed->name->strstart));
+ }
+ else {
+ Parrot_ex_throw_from_c_args(interp, NULL, 1,
+ "NULL doomed sub detected in Parrot_free_context");
+ }
+ }
+#endif
+
+ if (ctx->outer_ctx)
+ Parrot_free_context(interp, ctx->outer_ctx, 1);
+
+ ctx->n_regs_used[REGNO_INT] = 0;
+ ctx->n_regs_used[REGNO_NUM] = 0;
+ ctx->n_regs_used[REGNO_STR] = 0;
+ ctx->n_regs_used[REGNO_PMC] = 0;
+
+#if CTX_LEAK_DEBUG_FULL
+ /* for debugging, poison the freed context in case anything
+ * tries to use it later. */
+ ctx->current_results = (opcode_t *)0xbeefcafe;
+ ctx->results_signature = (PMC *)0xbeefcafe;
+ ctx->lex_pad = (PMC *)0xbeefcafe;
+ ctx->outer_ctx = (Parrot_Context *)0xbeefcafe;
+ ctx->current_cont = (PMC *)0xbeefcafe;
+ ctx->current_object = (PMC *)0xbeefcafe;
+ ctx->current_HLL = -1;
+ ctx->handlers = (PMC *)0xbeefcafe;
+ ctx->constants = (struct PackFile_Constant **)0xbeefcafe;
+ ctx->current_namespace = (PMC *)0xbeefcafe;
+#endif
+
+ /* don't put the same context on the free list multiple times; we don't
+ * have the re-use versus multiple ref count semantics right yet */
+ if (ctx->ref_count < 0)
+ return;
+
+ /* force the reference count negative to indicate a dead context
+ * so mark_context (src/sub.c) can report it */
+ ctx->ref_count--;
+
+ ptr = ctx;
+ slot = CALCULATE_SLOT_NUM(ctx->regs_mem_size);
+
+#if CTX_LEAK_DEBUG_FULL
+ slot = 0;
+#endif
+
+ PARROT_ASSERT(slot < interp->ctx_mem.n_free_slots);
+ *(void **)ptr = interp->ctx_mem.free_list[slot];
+ interp->ctx_mem.free_list[slot] = ptr;
+ }
+}
+
+
+/*
+
+=item C<Parrot_Context * Parrot_context_ref_trace(PARROT_INTERP, Parrot_Context
+*ctx, const char *file, int line)>
+
+Helper function to trace references when CTX_LEAK_DEBUG is set.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+PARROT_CANNOT_RETURN_NULL
+Parrot_Context *
+Parrot_context_ref_trace(PARROT_INTERP, ARGMOD(Parrot_Context *ctx),
+ ARGIN(const char *file), int line)
+{
+ ASSERT_ARGS(Parrot_context_ref_trace)
+ if (Interp_debug_TEST(interp, PARROT_CTX_DESTROY_DEBUG_FLAG)) {
+ const char *name = "unknown";
+ Parrot_sub *sub;
+
+ PMC_get_sub(interp, ctx->current_sub, sub);
+ if (ctx->current_sub)
+ name = (char *)(sub->name->strstart);
+
+ fprintf(stderr, "[reference to context %p ('%s') taken at %s:%d]\n",
+ (void *)ctx, name, file, line);
+ }
+
+ ctx->ref_count++;
+ return ctx;
+}
+
+
+/*
+
+=item C<void Parrot_set_context_threshold(PARROT_INTERP, Parrot_Context *ctx)>
+
+Marks the context as possible threshold.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_set_context_threshold(SHIM_INTERP, SHIM(Parrot_Context *ctx))
+{
+ ASSERT_ARGS(Parrot_set_context_threshold)
+ /* nothing to do */
+}
+
+/*
+
+=back
+
+=head2 Register Stack Functions
+
+=over 4
+
+=cut
+
+=item C<void Parrot_clear_i(PARROT_INTERP)>
+
+Sets all integer registers in the current context to 0.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_clear_i(PARROT_INTERP)
+{
+ ASSERT_ARGS(Parrot_clear_i)
+ int i;
+ for (i = 0; i < CONTEXT(interp)->n_regs_used[REGNO_INT]; ++i)
+ REG_INT(interp, i) = 0;
+}
+
+
+/*
+
+=item C<void Parrot_clear_s(PARROT_INTERP)>
+
+Sets all STRING registers in the current context to NULL.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_clear_s(PARROT_INTERP)
+{
+ ASSERT_ARGS(Parrot_clear_s)
+ int i;
+ for (i = 0; i < CONTEXT(interp)->n_regs_used[REGNO_STR]; ++i)
+ REG_STR(interp, i) = NULL;
+}
+
+
+/*
+
+=item C<void Parrot_clear_p(PARROT_INTERP)>
+
+Sets all PMC registers in the current context to NULL.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_clear_p(PARROT_INTERP)
+{
+ ASSERT_ARGS(Parrot_clear_p)
+ int i;
+ for (i = 0; i < CONTEXT(interp)->n_regs_used[REGNO_PMC]; ++i)
+ REG_PMC(interp, i) = PMCNULL;
+}
+
+
+/*
+
+=item C<void Parrot_clear_n(PARROT_INTERP)>
+
+Sets all number registers in the current context to 0.0.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+void
+Parrot_clear_n(PARROT_INTERP)
+{
+ ASSERT_ARGS(Parrot_clear_n)
+ int i;
+ for (i = 0; i < CONTEXT(interp)->n_regs_used[REGNO_NUM]; ++i)
+ REG_NUM(interp, i) = 0.0;
+}
+
+
+/*
+
+=back
+
+=head1 SEE ALSO
+
+F<include/parrot/register.h> and F<src/stacks.c>.
+
+=cut
+
+*/
+
+
+/*
+ * Local variables:
+ * c-file-style: "parrot"
+ * End:
+ * vim: expandtab shiftwidth=4:
+ */
Copied: branches/pmc_pct/src/gc/alloc_resources.c (from r39376, trunk/src/gc/alloc_resources.c)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/pmc_pct/src/gc/alloc_resources.c Thu Jun 4 02:32:48 2009 (r39377, copy of r39376, trunk/src/gc/alloc_resources.c)
@@ -0,0 +1,750 @@
+/*
+Copyright (C) 2001-2009, Parrot Foundation.
+$Id$
+
+=head1 NAME
+
+src/gc/alloc_resources.c - Allocate and deallocate buffer resources such as
+STRINGS.
+
+=head1 DESCRIPTION
+
+Functions to manage non-PObj memory, including strings and buffers.
+
+=head2 Parrot Memory Management Code
+
+=over 4
+
+=cut
+
+*/
+
+#include "parrot/parrot.h"
+#include "gc_private.h"
+
+
+#define RECLAMATION_FACTOR 0.20
+#define WE_WANT_EVER_GROWING_ALLOCATIONS 0
+
+/* show allocated blocks on stderr */
+#define RESOURCE_DEBUG 0
+#define RESOURCE_DEBUG_SIZE 1000000
+
+#define POOL_SIZE 65536 * 2
+
+typedef void (*compact_f) (Interp *, Memory_Pool *);
+
+/* HEADERIZER HFILE: src/gc/gc_private.h */
+
+/* HEADERIZER BEGIN: static */
+/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
+
+static void alloc_new_block(PARROT_INTERP,
+ size_t size,
+ ARGMOD(Memory_Pool *pool),
+ ARGIN(const char *why))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(3)
+ __attribute__nonnull__(4)
+ FUNC_MODIFIES(*pool);
+
+PARROT_CANNOT_RETURN_NULL
+PARROT_WARN_UNUSED_RESULT
+static const char* buffer_location(PARROT_INTERP, ARGIN(const PObj *b))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+static void debug_print_buf(PARROT_INTERP, ARGIN(const PObj *b))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_MALLOC
+PARROT_CANNOT_RETURN_NULL
+static Memory_Pool * new_memory_pool(
+ size_t min_block,
+ NULLOK(compact_f compact));
+
+#define ASSERT_ARGS_alloc_new_block __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(pool) \
+ || PARROT_ASSERT_ARG(why)
+#define ASSERT_ARGS_buffer_location __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(b)
+#define ASSERT_ARGS_debug_print_buf __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(b)
+#define ASSERT_ARGS_new_memory_pool __attribute__unused__ int _ASSERT_ARGS_CHECK = 0
+/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
+/* HEADERIZER END: static */
+
+
+/*
+
+=item C<static void alloc_new_block(PARROT_INTERP, size_t size, Memory_Pool
+*pool, const char *why)>
+
+Allocate a new memory block. We allocate either the requested size or the
+default size, whichever is larger. Add the new block to the given memory
+pool. The given C<char *why> text is used for debugging.
+
+=cut
+
+*/
+
+static void
+alloc_new_block(PARROT_INTERP, size_t size, ARGMOD(Memory_Pool *pool),
+ ARGIN(const char *why))
+{
+ ASSERT_ARGS(alloc_new_block)
+ Memory_Block *new_block;
+
+ const size_t alloc_size = (size > pool->minimum_block_size)
+ ? size : pool->minimum_block_size;
+
+#if RESOURCE_DEBUG
+ fprintf(stderr, "new_block (%s) size %u -> %u\n",
+ why, size, alloc_size);
+#else
+ UNUSED(why)
+#endif
+
+ /* Allocate a new block. Header info's on the front */
+ new_block = (Memory_Block *)mem_internal_allocate_zeroed(
+ sizeof (Memory_Block) + alloc_size);
+
+ if (!new_block) {
+ fprintf(stderr, "out of mem allocsize = %d\n", (int)alloc_size);
+ exit(EXIT_FAILURE);
+ }
+
+ new_block->free = alloc_size;
+ new_block->size = alloc_size;
+
+ new_block->next = NULL;
+ new_block->start = (char *)new_block + sizeof (Memory_Block);
+ new_block->top = new_block->start;
+
+ /* Note that we've allocated it */
+ interp->arena_base->memory_allocated += alloc_size;
+
+ /* If this is for a public pool, add it to the list */
+ new_block->prev = pool->top_block;
+
+ /* If we're not first, then tack us on the list */
+ if (pool->top_block)
+ pool->top_block->next = new_block;
+
+ pool->top_block = new_block;
+ pool->total_allocated += alloc_size;
+}
+
+/*
+
+=item C<void * mem_allocate(PARROT_INTERP, size_t size, Memory_Pool *pool)>
+
+Allocates memory for headers.
+
+Alignment problems history:
+
+See L<http://archive.develooper.com/perl6-internals%40perl.org/msg12310.html>
+for details.
+
+- return aligned pointer *if needed*
+- return strings et al at unaligned i.e. void* boundaries
+- remember alignment in a buffer header bit
+ use this in compaction code
+- reduce alignment to a reasonable value i.e. MALLOC_ALIGNMENT
+ aka 2*sizeof (size_t) or just 8 (TODO make a config hint)
+
+Buffer memory layout:
+
+ +-----------------+
+ | ref_count |f | # GC header
+ obj->bufstart -> +-----------------+
+ | data |
+ v v
+
+ * if PObj_is_COWable is set, then we have
+ - a ref_count, {inc, dec}remented by 2 always
+ - the lo bit 'f' means 'is being forwarded" - what TAIL_flag was
+
+ * if PObj_align_FLAG is set, obj->bufstart is aligned like discussed above
+ * obj->buflen is the usable length excluding the optional GC part.
+
+=cut
+
+*/
+
+PARROT_MALLOC
+PARROT_CANNOT_RETURN_NULL
+void *
+mem_allocate(PARROT_INTERP, size_t size, ARGMOD(Memory_Pool *pool))
+{
+ ASSERT_ARGS(mem_allocate)
+ void *return_val;
+
+ /* we always should have one block at least */
+ PARROT_ASSERT(pool->top_block);
+
+ /* If not enough room, try to find some */
+ if (pool->top_block->free < size) {
+ /*
+ * force a GC mark run to get live flags set
+ * for incremental M&S collection is run from there
+ * but only if there may be something worth collecting!
+ * TODO pass required allocation size to the GC system,
+ * so that collection can be skipped if needed
+ */
+ if (!interp->arena_base->gc_mark_block_level
+ && interp->arena_base->mem_allocs_since_last_collect) {
+ Parrot_gc_mark_and_sweep(interp, GC_trace_stack_FLAG);
+#if !PARROT_GC_IMS
+ /* Compact the pool if allowed and worthwhile */
+ if (pool->compact) {
+ /* don't bother reclaiming if it's just chicken feed */
+ if ((pool->possibly_reclaimable * pool->reclaim_factor +
+ pool->guaranteed_reclaimable) > size) {
+ (*pool->compact) (interp, pool);
+ }
+
+ }
+#endif
+ }
+ if (pool->top_block->free < size) {
+ if (pool->minimum_block_size < 65536 * 16)
+ pool->minimum_block_size *= 2;
+ /*
+ * TODO - Big blocks
+ *
+ * Mark the block as big block (it has just one item)
+ * And don't set big blocks as the top_block.
+ */
+ alloc_new_block(interp, size, pool, "compact failed");
+
+ interp->arena_base->mem_allocs_since_last_collect++;
+
+ if (pool->top_block->free < size) {
+ fprintf(stderr, "out of mem\n");
+ exit(EXIT_FAILURE);
+ }
+ }
+ }
+
+ /* TODO inline the fast path */
+ return_val = pool->top_block->top;
+ pool->top_block->top += size;
+ pool->top_block->free -= size;
+
+ return return_val;
+}
+
+/*
+
+=item C<static const char* buffer_location(PARROT_INTERP, const PObj *b)>
+
+Recturns a constant string representing the location of the given
+PObj C<b> in one of the PMC registers. If the PMC is not located
+in one of the PMC registers of the current context, returns the
+string C<"???">.
+
+=cut
+
+*/
+
+#if RESOURCE_DEBUG
+PARROT_CANNOT_RETURN_NULL
+PARROT_WARN_UNUSED_RESULT
+static const char*
+buffer_location(PARROT_INTERP, ARGIN(const PObj *b))
+{
+ ASSERT_ARGS(buffer_location)
+ int i;
+ static char reg[10];
+
+ Parrot_Context* const ctx = CONTEXT(interp);
+
+ for (i = 0; i < ctx->n_regs_used[REGNO_STR]; ++i) {
+ PObj * const obj = (PObj *) CTX_REG_STR(interp, ctx, i);
+ if (obj == b) {
+ sprintf(reg, "S%d", i);
+ return reg;
+ }
+ }
+
+ return "???";
+}
+
+/*
+
+=item C<static void debug_print_buf(PARROT_INTERP, const PObj *b)>
+
+Prints a debug statement with information about the given PObj C<b>.
+=cut
+
+*/
+
+static void
+debug_print_buf(PARROT_INTERP, ARGIN(const PObj *b))
+{
+ ASSERT_ARGS(debug_print_buf)
+ fprintf(stderr, "found %p, len %d, flags 0x%08x at %s\n",
+ b, (int)PObj_buflen(b), (uint)PObj_get_FLAGS(b),
+ buffer_location(interp, b));
+}
+#endif
+
+/*
+
+=back
+
+=head2 Compaction Code
+
+=over 4
+
+=item C<void compact_pool(PARROT_INTERP, Memory_Pool *pool)>
+
+Compact the string buffer pool. Does not perform a GC scan, or mark items
+as being alive in any way.
+
+=cut
+
+*/
+
+void
+compact_pool(PARROT_INTERP, ARGMOD(Memory_Pool *pool))
+{
+ ASSERT_ARGS(compact_pool)
+ INTVAL j;
+ UINTVAL total_size;
+
+ Memory_Block *new_block; /* A pointer to our working block */
+ char *cur_spot; /* Where we're currently copying to */
+
+ Small_Object_Arena *cur_buffer_arena;
+ Arenas * const arena_base = interp->arena_base;
+
+ /* Bail if we're blocked */
+ if (arena_base->gc_sweep_block_level)
+ return;
+
+ ++arena_base->gc_sweep_block_level;
+
+ if (interp->profile)
+ Parrot_gc_profile_start(interp);
+
+ /* We're collecting */
+ arena_base->mem_allocs_since_last_collect = 0;
+ arena_base->header_allocs_since_last_collect = 0;
+ arena_base->gc_collect_runs++;
+
+ /* total - reclaimable == currently used. Add a minimum block to the
+ * current amount, so we can avoid having to allocate it in the future. */
+ {
+ Memory_Block *cur_block = pool->top_block;
+
+ total_size = 0;
+
+ while (cur_block) {
+ /*
+ * TODO - Big blocks
+ *
+ * Currently all available blocks are compacted into on new
+ * block with total_size. This is more than suboptimal, if
+ * the block has just one live item from a big allocation.
+ *
+ * But currently it's unknown if the buffer memory is alive
+ * as the live bits are in Buffer headers. We have to run the
+ * compaction loop below to check liveness. OTOH if this
+ * compaction is running through all the buffer headers, there
+ * is no relation to the block.
+ *
+ *
+ * Moving the life bit into the buffer thus also solves this
+ * problem easily.
+ */
+ total_size += cur_block->size - cur_block->free;
+ cur_block = cur_block->prev;
+ }
+ }
+ /*
+ * XXX for some reason the guarantee isn't correct
+ * TODO check why
+ */
+
+ /* total_size -= pool->guaranteed_reclaimable; */
+
+ /* this makes for ever increasing allocations but fewer collect runs */
+#if WE_WANT_EVER_GROWING_ALLOCATIONS
+ total_size += pool->minimum_block_size;
+#endif
+
+ /* Snag a block big enough for everything */
+ alloc_new_block(interp, total_size, pool, "inside compact");
+
+ new_block = pool->top_block;
+
+ /* Start at the beginning */
+ cur_spot = new_block->start;
+
+ /* Run through all the Buffer header pools and copy */
+ for (j = (INTVAL)arena_base->num_sized - 1; j >= 0; --j) {
+ Small_Object_Pool * const header_pool = arena_base->sized_header_pools[j];
+ UINTVAL object_size;
+
+ if (!header_pool)
+ continue;
+
+ object_size = header_pool->object_size;
+
+ for (cur_buffer_arena = header_pool->last_Arena;
+ cur_buffer_arena;
+ cur_buffer_arena = cur_buffer_arena->prev) {
+ Buffer *b = (Buffer *)ARENA_to_PObj(cur_buffer_arena->start_objects);
+ UINTVAL i;
+
+ for (i = cur_buffer_arena->used; i; --i) {
+ INTVAL *ref_count = NULL;
+
+ /* ! (on_free_list | constant | external | sysmem) */
+ if (PObj_buflen(b) && PObj_is_movable_TESTALL(b)) {
+ ptrdiff_t offset = 0;
+#if RESOURCE_DEBUG
+ if (PObj_buflen(b) >= RESOURCE_DEBUG_SIZE)
+ debug_print_buf(interp, b);
+#endif
+
+ /* we can't perform the math all the time, because
+ * strstart might be in unallocated memory */
+ if (PObj_is_COWable_TEST(b)) {
+ ref_count = PObj_bufrefcountptr(b);
+
+ if (PObj_is_string_TEST(b)) {
+ offset = (ptrdiff_t)((STRING *)b)->strstart -
+ (ptrdiff_t)PObj_bufstart(b);
+ }
+ }
+
+ /* buffer has already been moved; just change the header */
+ if (PObj_COW_TEST(b) &&
+ (ref_count && *ref_count & Buffer_moved_FLAG)) {
+ /* Find out who else references our data */
+ Buffer * const hdr = *(Buffer **)(PObj_bufstart(b));
+
+ PARROT_ASSERT(PObj_is_COWable_TEST(b));
+
+ /* Make sure they know that we own it too */
+ PObj_COW_SET(hdr);
+
+ /* TODO incr ref_count, after fixing string too
+ * Now make sure we point to where the other guy does */
+ PObj_bufstart(b) = PObj_bufstart(hdr);
+
+ /* And if we're a string, update strstart */
+ /* Somewhat of a hack, but if we get per-pool
+ * collections, it should help ease the pain */
+ if (PObj_is_string_TEST(b)) {
+ ((STRING *)b)->strstart = (char *)PObj_bufstart(b) +
+ offset;
+ }
+ }
+ else {
+ cur_spot = aligned_mem(b, cur_spot);
+
+ if (PObj_is_COWable_TEST(b)) {
+ INTVAL * const new_ref_count = ((INTVAL*) cur_spot) - 1;
+ *new_ref_count = 2;
+ }
+
+ /* Copy our memory to the new pool */
+ memcpy(cur_spot, PObj_bufstart(b), PObj_buflen(b));
+
+ /* If we're COW */
+ if (PObj_COW_TEST(b)) {
+ PARROT_ASSERT(PObj_is_COWable_TEST(b));
+
+ /* Let the old buffer know how to find us */
+ *(Buffer **)(PObj_bufstart(b)) = b;
+
+ /* No guarantees that our data is still COW, so
+ * assume not, and let the above code fix-up */
+ PObj_COW_CLEAR(b);
+
+ /* Finally, let the tail know that we've moved, so
+ * that any other references can know to look for
+ * us and not re-copy */
+ if (ref_count)
+ *ref_count |= Buffer_moved_FLAG;
+ }
+
+ PObj_bufstart(b) = cur_spot;
+
+ if (PObj_is_string_TEST(b)) {
+ ((STRING *)b)->strstart = (char *)PObj_bufstart(b) +
+ offset;
+ }
+
+ cur_spot += PObj_buflen(b);
+ }
+ }
+ b = (Buffer *)((char *)b + object_size);
+ }
+ }
+ }
+
+ /* Okay, we're done with the copy. Set the bits in the pool struct */
+ /* First, where we allocate next */
+ new_block->top = cur_spot;
+
+ PARROT_ASSERT(new_block->size >= (size_t)new_block->top -
+ (size_t)new_block->start);
+
+ /* How much is free. That's the total size minus the amount we used */
+ new_block->free = new_block->size - (new_block->top - new_block->start);
+
+ arena_base->memory_collected += (new_block->top - new_block->start);
+
+ /* Now we're done. We're already on the pool's free list, so let us be the
+ * only one on the free list and free the rest */
+ {
+ Memory_Block *cur_block = new_block->prev;
+
+ PARROT_ASSERT(new_block == pool->top_block);
+
+ while (cur_block) {
+ Memory_Block * const next_block = cur_block->prev;
+
+ /* Note that we don't have it any more */
+ arena_base->memory_allocated -= cur_block->size;
+
+ /* We know the pool body and pool header are a single chunk, so
+ * this is enough to get rid of 'em both */
+ mem_internal_free(cur_block);
+ cur_block = next_block;
+ }
+
+ /* Set our new pool as the only pool */
+ new_block->prev = NULL;
+ pool->total_allocated = total_size;
+ }
+
+ pool->guaranteed_reclaimable = 0;
+ pool->possibly_reclaimable = 0;
+
+ if (interp->profile)
+ Parrot_gc_profile_end(interp, PARROT_PROF_GC);
+
+ --arena_base->gc_sweep_block_level;
+}
+
+/*
+
+=item C<size_t aligned_size(const Buffer *buffer, size_t len)>
+
+Determines the size of Buffer C<buffer> which has nominal length C<len>.
+The actual size in RAM of the Buffer might be different because of
+alignment issues.
+
+=cut
+
+*/
+
+PARROT_PURE_FUNCTION
+PARROT_WARN_UNUSED_RESULT
+size_t
+aligned_size(ARGIN(const Buffer *buffer), size_t len)
+{
+ ASSERT_ARGS(aligned_size)
+ if (PObj_is_COWable_TEST(buffer))
+ len += sizeof (void*);
+ if (PObj_aligned_TEST(buffer))
+ len = (len + BUFFER_ALIGN_1) & BUFFER_ALIGN_MASK;
+ else
+ len = (len + WORD_ALIGN_1) & WORD_ALIGN_MASK;
+ return len;
+}
+
+/*
+
+=item C<char * aligned_mem(const Buffer *buffer, char *mem)>
+
+Returns a pointer to the aligned allocated storage for Buffer C<buffer>,
+which might not be the same as the pointer to C<buffeR> because of
+memory alignment.
+
+=cut
+
+*/
+
+PARROT_CANNOT_RETURN_NULL
+PARROT_WARN_UNUSED_RESULT
+char *
+aligned_mem(ARGIN(const Buffer *buffer), ARGIN(char *mem))
+{
+ ASSERT_ARGS(aligned_mem)
+ if (PObj_is_COWable_TEST(buffer))
+ mem += sizeof (void*);
+ if (PObj_aligned_TEST(buffer))
+ mem = (char*)(((unsigned long)(mem + BUFFER_ALIGN_1)) &
+ BUFFER_ALIGN_MASK);
+ else
+ mem = (char*)(((unsigned long)(mem + WORD_ALIGN_1)) & WORD_ALIGN_MASK);
+
+ return mem;
+}
+
+/*
+
+=item C<size_t aligned_string_size(size_t len)>
+
+Determines the size of a string of length C<len> in RAM, accounting for
+alignment.
+
+=cut
+
+*/
+
+PARROT_CONST_FUNCTION
+PARROT_WARN_UNUSED_RESULT
+size_t
+aligned_string_size(size_t len)
+{
+ ASSERT_ARGS(aligned_string_size)
+ len += sizeof (void*);
+ len = (len + WORD_ALIGN_1) & WORD_ALIGN_MASK;
+ return len;
+}
+
+/*
+
+=back
+
+=head2 Parrot Re/Allocate Code
+
+=over 4
+
+=item C<static Memory_Pool * new_memory_pool(size_t min_block, compact_f
+compact)>
+
+Allocate a new C<Memory_Pool> structures, and set some initial values.
+return a pointer to the new pool.
+
+=cut
+
+*/
+
+PARROT_MALLOC
+PARROT_CANNOT_RETURN_NULL
+static Memory_Pool *
+new_memory_pool(size_t min_block, NULLOK(compact_f compact))
+{
+ ASSERT_ARGS(new_memory_pool)
+ Memory_Pool * const pool = mem_internal_allocate_typed(Memory_Pool);
+
+ pool->top_block = NULL;
+ pool->compact = compact;
+ pool->minimum_block_size = min_block;
+ pool->total_allocated = 0;
+ pool->guaranteed_reclaimable = 0;
+ pool->possibly_reclaimable = 0;
+ pool->reclaim_factor = RECLAMATION_FACTOR;
+
+ return pool;
+}
+
+/*
+
+=item C<void initialize_memory_pools(PARROT_INTERP)>
+
+Initialize the managed memory pools. Parrot maintains two C<Memory_Pool>
+structures, the general memory pool and the constant string pool. Create
+and initialize both pool structures, and allocate initial blocks of memory
+for both.
+
+=cut
+
+*/
+
+void
+initialize_memory_pools(PARROT_INTERP)
+{
+ ASSERT_ARGS(initialize_memory_pools)
+ Arenas * const arena_base = interp->arena_base;
+
+ arena_base->memory_pool = new_memory_pool(POOL_SIZE, &compact_pool);
+ alloc_new_block(interp, POOL_SIZE, arena_base->memory_pool, "init");
+
+ /* Constant strings - not compacted */
+ arena_base->constant_string_pool = new_memory_pool(POOL_SIZE, NULL);
+
+ alloc_new_block(interp, POOL_SIZE, arena_base->constant_string_pool, "init");
+}
+
+
+/*
+
+=item C<void merge_pools(Memory_Pool *dest, Memory_Pool *source)>
+
+Merge two memory pools together. Do this by moving all memory blocks
+from the C<*source> pool into the C<*dest> pool. The C<source> pool
+is emptied, but is not destroyed here.
+
+=cut
+
+*/
+
+void
+merge_pools(ARGMOD(Memory_Pool *dest), ARGMOD(Memory_Pool *source))
+{
+ ASSERT_ARGS(merge_pools)
+ Memory_Block *cur_block;
+
+ cur_block = source->top_block;
+
+ while (cur_block) {
+ Memory_Block * const next_block = cur_block->prev;
+
+ if (cur_block->free == cur_block->size) {
+ mem_internal_free(cur_block);
+ }
+ else {
+ cur_block->next = NULL;
+ cur_block->prev = dest->top_block;
+
+ dest->top_block = cur_block;
+ dest->total_allocated += cur_block->size;
+ }
+ cur_block = next_block;
+ }
+
+ dest->guaranteed_reclaimable += source->guaranteed_reclaimable;
+ dest->possibly_reclaimable += dest->possibly_reclaimable;
+
+ source->top_block = NULL;
+ source->total_allocated = 0;
+ source->possibly_reclaimable = 0;
+ source->guaranteed_reclaimable = 0;
+}
+
+/*
+
+=back
+
+=head1 SEE ALSO
+
+F<src/gc/memory.c>.
+
+=head1 HISTORY
+
+Initial version by Dan on 2001.10.2.
+
+=cut
+
+*/
+
+/*
+ * Local variables:
+ * c-file-style: "parrot"
+ * End:
+ * vim: expandtab shiftwidth=4:
+ */
Modified: branches/pmc_pct/src/gc/api.c
==============================================================================
--- branches/pmc_pct/src/gc/api.c Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/gc/api.c Thu Jun 4 02:32:48 2009 (r39377)
@@ -43,6 +43,25 @@
__attribute__nonnull__(2)
FUNC_MODIFIES(*dest_interp);
+static void free_pool(ARGMOD(Small_Object_Pool *pool))
+ __attribute__nonnull__(1)
+ FUNC_MODIFIES(*pool);
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CANNOT_RETURN_NULL
+static void * get_free_buffer(PARROT_INTERP, ARGIN(Small_Object_Pool *pool))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+static void Parrot_gc_merge_buffer_pools(PARROT_INTERP,
+ ARGMOD(Small_Object_Pool *dest),
+ ARGMOD(Small_Object_Pool *source))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ __attribute__nonnull__(3)
+ FUNC_MODIFIES(*dest)
+ FUNC_MODIFIES(*source);
+
static int sweep_cb_buf(PARROT_INTERP,
ARGMOD(Small_Object_Pool *pool),
SHIM(int flag),
@@ -65,6 +84,15 @@
#define ASSERT_ARGS_fix_pmc_syncs __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(dest_interp) \
|| PARROT_ASSERT_ARG(pool)
+#define ASSERT_ARGS_free_pool __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(pool)
+#define ASSERT_ARGS_get_free_buffer __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(pool)
+#define ASSERT_ARGS_Parrot_gc_merge_buffer_pools __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(dest) \
+ || PARROT_ASSERT_ARG(source)
#define ASSERT_ARGS_sweep_cb_buf __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
|| PARROT_ASSERT_ARG(pool) \
@@ -182,8 +210,8 @@
Parrot_gc_gms_init(interp);
#endif
- Parrot_initialize_memory_pools(interp);
- Parrot_initialize_header_pools(interp);
+ initialize_memory_pools(interp);
+ initialize_header_pools(interp);
}
/*
@@ -456,6 +484,37 @@
/*
+=item C<static void * get_free_buffer(PARROT_INTERP, Small_Object_Pool *pool)>
+
+Gets a free object or buffer from the given C<pool> and returns it. If the
+object is larger then a standard C<PObj> structure, all additional memory is
+cleared.
+
+=cut
+
+*/
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CANNOT_RETURN_NULL
+static void *
+get_free_buffer(PARROT_INTERP, ARGIN(Small_Object_Pool *pool))
+{
+ ASSERT_ARGS(get_free_buffer)
+ PObj * const buffer = (PObj *)pool->get_free_object(interp, pool);
+
+ /* don't mess around with flags */
+ PObj_bufstart(buffer) = NULL;
+ PObj_buflen(buffer) = 0;
+
+ if (pool->object_size - GC_HEADER_SIZE > sizeof (PObj))
+ memset(buffer + 1, 0,
+ pool->object_size - sizeof (PObj) - GC_HEADER_SIZE);
+
+ return buffer;
+}
+
+/*
+
=item C<void Parrot_gc_free_bufferlike_header(PARROT_INTERP, PObj *obj, size_t
size)>
@@ -761,18 +820,18 @@
/* heavily borrowed from forall_header_pools */
fix_pmc_syncs(dest_interp, source_arena->constant_pmc_pool);
- Parrot_small_object_pool_merge(dest_interp, dest_arena->constant_pmc_pool,
+ Parrot_gc_merge_buffer_pools(dest_interp, dest_arena->constant_pmc_pool,
source_arena->constant_pmc_pool);
fix_pmc_syncs(dest_interp, source_arena->pmc_pool);
- Parrot_small_object_pool_merge(dest_interp, dest_arena->pmc_pool,
+ Parrot_gc_merge_buffer_pools(dest_interp, dest_arena->pmc_pool,
source_arena->pmc_pool);
- Parrot_small_object_pool_merge(dest_interp,
+ Parrot_gc_merge_buffer_pools(dest_interp,
dest_arena->constant_string_header_pool,
source_arena->constant_string_header_pool);
- Parrot_small_object_pool_merge(dest_interp,
+ Parrot_gc_merge_buffer_pools(dest_interp,
dest_arena->pmc_ext_pool, source_arena->pmc_ext_pool);
for (i = 0; i < source_arena->num_sized; ++i) {
@@ -787,7 +846,7 @@
PARROT_ASSERT(dest_arena->sized_header_pools[i]);
}
- Parrot_small_object_pool_merge(dest_interp,
+ Parrot_gc_merge_buffer_pools(dest_interp,
dest_arena->sized_header_pools[i],
source_arena->sized_header_pools[i]);
}
@@ -795,6 +854,70 @@
/*
+=item C<static void Parrot_gc_merge_buffer_pools(PARROT_INTERP,
+Small_Object_Pool *dest, Small_Object_Pool *source)>
+
+Merge pool C<source> into pool C<dest>. Combines the free lists directly,
+moves all arenas to the new pool, and remove the old pool. To merge, the
+two pools must have the same object size, and the same name (if they have
+names).
+
+=cut
+
+*/
+
+static void
+Parrot_gc_merge_buffer_pools(PARROT_INTERP,
+ ARGMOD(Small_Object_Pool *dest), ARGMOD(Small_Object_Pool *source))
+{
+ ASSERT_ARGS(Parrot_gc_merge_buffer_pools)
+ Small_Object_Arena *cur_arena;
+ void **free_list_end;
+
+ PARROT_ASSERT(dest->object_size == source->object_size);
+ PARROT_ASSERT((dest->name == NULL && source->name == NULL)
+ || STREQ(dest->name, source->name));
+
+ dest->total_objects += source->total_objects;
+
+ /* append new free_list to old */
+ /* XXX this won't work with, e.g., gc_gms */
+ free_list_end = &dest->free_list;
+
+ while (*free_list_end)
+ free_list_end = (void **)*free_list_end;
+
+ *free_list_end = source->free_list;
+
+ /* now append source arenas */
+ cur_arena = source->last_Arena;
+
+ while (cur_arena) {
+ size_t total_objects;
+ Small_Object_Arena * const next_arena = cur_arena->prev;
+
+ cur_arena->next = cur_arena->prev = NULL;
+
+ total_objects = cur_arena->total_objects;
+
+ Parrot_append_arena_in_pool(interp, dest, cur_arena,
+ cur_arena->total_objects);
+
+ /* XXX needed? */
+ cur_arena->total_objects = total_objects;
+
+ cur_arena = next_arena;
+ }
+
+ /* remove things from source */
+ source->last_Arena = NULL;
+ source->free_list = NULL;
+ source->total_objects = 0;
+ source->num_free_objects = 0;
+}
+
+/*
+
=item C<static void fix_pmc_syncs(Interp *dest_interp, Small_Object_Pool *pool)>
Walks through the given arena, looking for all live and shared PMCs,
@@ -837,7 +960,7 @@
=item C<void Parrot_gc_destroy_header_pools(PARROT_INTERP)>
Performs a garbage collection sweep on all pools, then frees them. Calls
-C<Parrot_forall_header_pools> to loop over all the pools, passing
+C<header_pools_iterate_callback> to loop over all the pools, passing
C<sweep_cb_pmc> and C<sweep_cb_buf> callback routines. Frees the array of sized
header pointers in the C<Arenas> structure too.
@@ -862,12 +985,12 @@
const INTVAL start = 2;
#endif
- Parrot_forall_header_pools(interp, POOL_PMC, NULL, sweep_cb_pmc);
- Parrot_forall_header_pools(interp, POOL_PMC | POOL_CONST, NULL,
+ header_pools_iterate_callback(interp, POOL_PMC, NULL, sweep_cb_pmc);
+ header_pools_iterate_callback(interp, POOL_PMC | POOL_CONST, NULL,
sweep_cb_pmc);
for (pass = start; pass <= 2; pass++) {
- Parrot_forall_header_pools(interp, POOL_BUFFER | POOL_CONST,
+ header_pools_iterate_callback(interp, POOL_BUFFER | POOL_CONST,
(void *)pass, sweep_cb_buf);
}
@@ -884,7 +1007,7 @@
flag, void *arg)>
Performs a garbage collection sweep of the given pmc pool, then frees it. Calls
-C<Parrot_gc_sweep> to perform the sweep, and C<free_pool> to free the pool and
+C<Parrot_gc_sweep_pool> to perform the sweep, and C<free_pool> to free the pool and
all its arenas. Always returns C<0>.
=cut
@@ -895,7 +1018,7 @@
sweep_cb_pmc(PARROT_INTERP, ARGMOD(Small_Object_Pool *pool),
SHIM(int flag), SHIM(void *arg))
{
- Parrot_gc_sweep(interp, pool);
+ Parrot_gc_sweep_pool(interp, pool);
free_pool(pool);
return 0;
}
@@ -906,7 +1029,7 @@
flag, void *arg)>
Performs a final garbage collection sweep, then frees the pool. Calls
-C<Parrot_gc_sweep> to perform the sweep, and C<free_pool> to free the pool and
+C<Parrot_gc_sweep_pool> to perform the sweep, and C<free_pool> to free the pool and
all its arenas.
=cut
@@ -929,7 +1052,7 @@
{
UNUSED(arg);
- Parrot_gc_sweep(interp, pool);
+ Parrot_gc_sweep_pool(interp, pool);
free_pool(pool);
}
@@ -938,6 +1061,33 @@
/*
+=item C<static void free_pool(Small_Object_Pool *pool)>
+
+Frees a pool and all of its arenas. Loops through the list of arenas backwards
+and returns each to the memory manager. Then, frees the pool structure itself.
+
+=cut
+
+*/
+
+static void
+free_pool(ARGMOD(Small_Object_Pool *pool))
+{
+ ASSERT_ARGS(free_pool)
+ Small_Object_Arena *cur_arena;
+
+ for (cur_arena = pool->last_Arena; cur_arena;) {
+ Small_Object_Arena * const next = cur_arena->prev;
+ mem_internal_free(cur_arena->start_objects);
+ mem_internal_free(cur_arena);
+ cur_arena = next;
+ }
+ mem_internal_free(pool);
+}
+
+
+/*
+
=item C<void Parrot_gc_destroy_memory_pools(PARROT_INTERP)>
Destroys the memory pool and the constant string pool. Loop through both
Modified: branches/pmc_pct/src/gc/gc_malloc.c
==============================================================================
--- branches/pmc_pct/src/gc/gc_malloc.c Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/gc/gc_malloc.c Thu Jun 4 02:32:48 2009 (r39377)
@@ -77,7 +77,7 @@
if (flag & POOL_BUFFER)
used_cow(interp, pool, 0);
- Parrot_gc_sweep(interp, pool);
+ Parrot_gc_sweep_pool(interp, pool);
if (flag & POOL_BUFFER)
clear_cow(interp, pool, 0);
Copied: branches/pmc_pct/src/gc/gc_ms.c (from r39376, trunk/src/gc/gc_ms.c)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/pmc_pct/src/gc/gc_ms.c Thu Jun 4 02:32:48 2009 (r39377, copy of r39376, trunk/src/gc/gc_ms.c)
@@ -0,0 +1,602 @@
+/*
+Copyright (C) 2001-2009, Parrot Foundation.
+$Id$
+
+=head1 NAME
+
+src/gc/gc_ms.c - Implementation of the basic mark & sweep collector
+
+=head1 DESCRIPTION
+
+This code implements the default mark and sweep garbage collector.
+
+=cut
+
+*/
+
+#include "parrot/parrot.h"
+#include "gc_private.h"
+
+/* HEADERIZER HFILE: src/gc/gc_private.h */
+
+/* HEADERIZER BEGIN: static */
+/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
+
+static void gc_ms_add_free_object(SHIM_INTERP,
+ ARGMOD(Small_Object_Pool *pool),
+ ARGIN(void *to_add))
+ __attribute__nonnull__(2)
+ __attribute__nonnull__(3)
+ FUNC_MODIFIES(*pool);
+
+static void gc_ms_add_free_pmc_ext(SHIM_INTERP,
+ ARGMOD(Small_Object_Pool *pool),
+ ARGIN(void *to_add))
+ __attribute__nonnull__(2)
+ __attribute__nonnull__(3)
+ FUNC_MODIFIES(*pool);
+
+static void gc_ms_alloc_objects(PARROT_INTERP,
+ ARGMOD(Small_Object_Pool *pool))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ FUNC_MODIFIES(*pool);
+
+static void gc_ms_finalize(PARROT_INTERP, ARGIN(Arenas * const arena_base))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_CANNOT_RETURN_NULL
+PARROT_WARN_UNUSED_RESULT
+static void * gc_ms_get_free_object(PARROT_INTERP,
+ ARGMOD(Small_Object_Pool *pool))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ FUNC_MODIFIES(*pool);
+
+PARROT_CANNOT_RETURN_NULL
+PARROT_WARN_UNUSED_RESULT
+static void * gc_ms_get_free_pmc_ext(PARROT_INTERP,
+ ARGMOD(Small_Object_Pool *pool))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ FUNC_MODIFIES(*pool);
+
+static void gc_ms_mark_and_sweep(PARROT_INTERP, UINTVAL flags)
+ __attribute__nonnull__(1);
+
+static void gc_ms_more_traceable_objects(PARROT_INTERP,
+ ARGMOD(Small_Object_Pool *pool))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ FUNC_MODIFIES(*pool);
+
+static void gc_ms_pool_init(SHIM_INTERP, ARGMOD(Small_Object_Pool *pool))
+ __attribute__nonnull__(2)
+ FUNC_MODIFIES(*pool);
+
+static int gc_ms_sweep_cb(PARROT_INTERP,
+ ARGMOD(Small_Object_Pool *pool),
+ int flag,
+ ARGMOD(void *arg))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ __attribute__nonnull__(4)
+ FUNC_MODIFIES(*pool)
+ FUNC_MODIFIES(*arg);
+
+static int gc_ms_trace_active_PMCs(PARROT_INTERP,
+ Parrot_gc_trace_type trace)
+ __attribute__nonnull__(1);
+
+#define ASSERT_ARGS_gc_ms_add_free_object __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(pool) \
+ || PARROT_ASSERT_ARG(to_add)
+#define ASSERT_ARGS_gc_ms_add_free_pmc_ext __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(pool) \
+ || PARROT_ASSERT_ARG(to_add)
+#define ASSERT_ARGS_gc_ms_alloc_objects __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(pool)
+#define ASSERT_ARGS_gc_ms_finalize __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(arena_base)
+#define ASSERT_ARGS_gc_ms_get_free_object __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(pool)
+#define ASSERT_ARGS_gc_ms_get_free_pmc_ext __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(pool)
+#define ASSERT_ARGS_gc_ms_mark_and_sweep __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
+#define ASSERT_ARGS_gc_ms_more_traceable_objects __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(pool)
+#define ASSERT_ARGS_gc_ms_pool_init __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(pool)
+#define ASSERT_ARGS_gc_ms_sweep_cb __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(pool) \
+ || PARROT_ASSERT_ARG(arg)
+#define ASSERT_ARGS_gc_ms_trace_active_PMCs __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
+/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
+/* HEADERIZER END: static */
+
+/* the percent of used Arena items at which to trace next time through */
+#define GC_DEBUG_REPLENISH_LEVEL_FACTOR 0.0
+#define GC_DEBUG_UNITS_PER_ALLOC_GROWTH_FACTOR 1
+#define REPLENISH_LEVEL_FACTOR 0.3
+
+/* this factor is totally arbitrary, but gives good timings for stress.pasm */
+#define UNITS_PER_ALLOC_GROWTH_FACTOR 1.75
+
+#define POOL_MAX_BYTES 65536 * 128
+
+/*
+
+=head2 Primary MS Functions
+
+=over 4
+
+=item C<void Parrot_gc_ms_init(PARROT_INTERP)>
+
+Initialize the state structures of the gc system. Called immediately before
+creation of memory pools. This function must set the function pointers
+for C<add_free_object_fn>, C<get_free_object_fn>, C<alloc_object_fn>, and
+C<more_object_fn>.
+
+=cut
+
+*/
+
+void
+Parrot_gc_ms_init(PARROT_INTERP)
+{
+ ASSERT_ARGS(Parrot_gc_ms_init)
+ Arenas * const arena_base = interp->arena_base;
+
+ arena_base->do_gc_mark = gc_ms_mark_and_sweep;
+ arena_base->finalize_gc_system = NULL;
+ arena_base->init_pool = gc_ms_pool_init;
+}
+
+/*
+
+=item C<static void gc_ms_mark_and_sweep(PARROT_INTERP, UINTVAL flags)>
+
+Runs the stop-the-world mark & sweep (MS) collector.
+
+=cut
+
+*/
+
+static void
+gc_ms_mark_and_sweep(PARROT_INTERP, UINTVAL flags)
+{
+ ASSERT_ARGS(gc_ms_mark_and_sweep)
+ Arenas * const arena_base = interp->arena_base;
+ int total_free = 0;
+
+ if (arena_base->gc_mark_block_level)
+ return;
+
+ if (interp->pdb && interp->pdb->debugger) {
+ /* The debugger could have performed a mark. Make sure everything is
+ marked dead here, so that when we sweep it all gets collected */
+ Parrot_gc_clear_live_bits(interp, arena_base->pmc_pool);
+ }
+
+ if (flags & GC_finish_FLAG) {
+ gc_ms_finalize(interp, arena_base);
+ return;
+ }
+
+ ++arena_base->gc_mark_block_level;
+ arena_base->lazy_gc = flags & GC_lazy_FLAG;
+
+ /* tell the threading system that we're doing GC mark */
+ pt_gc_start_mark(interp);
+ Parrot_gc_run_init(interp);
+
+ /* compact STRING pools to collect free headers and allocated buffers */
+ Parrot_gc_compact_memory_pool(interp);
+
+ /* Now go trace the PMCs. returning true means we did a complete trace.
+ false means it was a lazy trace. */
+ if (gc_ms_trace_active_PMCs(interp, (flags & GC_trace_stack_FLAG)
+ ? GC_TRACE_FULL : GC_TRACE_ROOT_ONLY)) {
+
+ arena_base->gc_trace_ptr = NULL;
+ arena_base->gc_mark_ptr = NULL;
+
+ /* We've done the mark, now do the sweep. Pass the sweep callback
+ function to the PMC pool and all the sized pools. */
+ header_pools_iterate_callback(interp, POOL_BUFFER | POOL_PMC,
+ (void*)&total_free, gc_ms_sweep_cb);
+
+ if (interp->profile)
+ Parrot_gc_profile_end(interp, PARROT_PROF_GC_cb);
+ }
+ else {
+ ++arena_base->gc_lazy_mark_runs;
+
+ Parrot_gc_clear_live_bits(interp, arena_base->pmc_pool);
+ if (interp->profile)
+ Parrot_gc_profile_end(interp, PARROT_PROF_GC_p2);
+ }
+
+ pt_gc_stop_mark(interp);
+
+ /* Note it */
+ arena_base->gc_mark_runs++;
+ --arena_base->gc_mark_block_level;
+
+ return;
+}
+
+/*
+
+=item C<static void gc_ms_finalize(PARROT_INTERP, Arenas * const arena_base)>
+
+Perform the finalization run, freeing all PMCs.
+
+=cut
+
+*/
+
+static void
+gc_ms_finalize(PARROT_INTERP, ARGIN(Arenas * const arena_base))
+{
+ ASSERT_ARGS(gc_ms_finalize)
+ Parrot_gc_clear_live_bits(interp, arena_base->pmc_pool);
+ Parrot_gc_clear_live_bits(interp, arena_base->constant_pmc_pool);
+
+ /* keep the scheduler and its kids alive for Task-like PMCs to destroy
+ * themselves; run a sweep to collect them */
+ if (interp->scheduler) {
+ Parrot_gc_mark_PObj_alive(interp, (PObj *)interp->scheduler);
+ VTABLE_mark(interp, interp->scheduler);
+ Parrot_gc_sweep_pool(interp, interp->arena_base->pmc_pool);
+ }
+
+ /* now sweep everything that's left */
+ Parrot_gc_sweep_pool(interp, interp->arena_base->pmc_pool);
+ Parrot_gc_sweep_pool(interp, interp->arena_base->constant_pmc_pool);
+}
+
+
+/*
+
+=item C<static int gc_ms_trace_active_PMCs(PARROT_INTERP, Parrot_gc_trace_type
+trace)>
+
+Performs a full trace run and marks all the PMCs as active if they
+are. Returns whether the run completed, that is, whether it's safe
+to proceed with GC.
+
+=cut
+
+*/
+
+static int
+gc_ms_trace_active_PMCs(PARROT_INTERP, Parrot_gc_trace_type trace)
+{
+ ASSERT_ARGS(gc_ms_trace_active_PMCs)
+ if (!Parrot_gc_trace_root(interp, trace))
+ return 0;
+
+ /* Okay, we've marked the whole root set, and should have a good-sized
+ * list of things to look at. Run through it */
+ return Parrot_gc_trace_children(interp, (size_t) -1);
+}
+
+/*
+
+=item C<static int gc_ms_sweep_cb(PARROT_INTERP, Small_Object_Pool *pool, int
+flag, void *arg)>
+
+Sweeps the given pool for the MS collector. This function also ends
+the profiling timer, if profiling is enabled. Returns the total number
+of objects freed.
+
+=cut
+
+*/
+
+static int
+gc_ms_sweep_cb(PARROT_INTERP, ARGMOD(Small_Object_Pool *pool), int flag,
+ ARGMOD(void *arg))
+{
+ ASSERT_ARGS(gc_ms_sweep_cb)
+ int * const total_free = (int *) arg;
+
+ Parrot_gc_sweep_pool(interp, pool);
+
+ if (interp->profile && (flag & POOL_PMC))
+ Parrot_gc_profile_end(interp, PARROT_PROF_GC_cp);
+
+ *total_free += pool->num_free_objects;
+
+ return 0;
+}
+
+/*
+
+=back
+
+=head2 MS Pool Functions
+
+=over 4
+
+=item C<static void gc_ms_pool_init(PARROT_INTERP, Small_Object_Pool *pool)>
+
+Initialize a memory pool for the MS garbage collector system. Sets the
+function pointers necessary to perform basic operations on a pool, such
+as object allocation.
+
+=cut
+
+*/
+
+static void
+gc_ms_pool_init(SHIM_INTERP, ARGMOD(Small_Object_Pool *pool))
+{
+ ASSERT_ARGS(gc_ms_pool_init)
+ pool->add_free_object = gc_ms_add_free_object;
+ pool->get_free_object = gc_ms_get_free_object;
+ pool->alloc_objects = gc_ms_alloc_objects;
+ pool->more_objects = gc_ms_more_traceable_objects;
+}
+
+/*
+
+=item C<static void gc_ms_more_traceable_objects(PARROT_INTERP,
+Small_Object_Pool *pool)>
+
+We're out of traceable objects. First we try a GC run to free some up. If
+that doesn't work, allocate a new arena.
+
+=cut
+
+*/
+
+static void
+gc_ms_more_traceable_objects(PARROT_INTERP, ARGMOD(Small_Object_Pool *pool))
+{
+ ASSERT_ARGS(gc_ms_more_traceable_objects)
+ if (pool->skip)
+ pool->skip = 0;
+ else {
+ Small_Object_Arena * const arena = pool->last_Arena;
+ if (arena) {
+ if (arena->used == arena->total_objects)
+ Parrot_gc_mark_and_sweep(interp, GC_trace_stack_FLAG);
+
+ if (pool->num_free_objects > pool->replenish_level)
+ pool->skip = 1;
+ }
+ }
+
+ /* requires that num_free_objects be updated in Parrot_gc_mark_and_sweep.
+ If gc is disabled, then we must check the free list directly. */
+ if (!pool->free_list)
+ (*pool->alloc_objects) (interp, pool);
+}
+
+/*
+
+=item C<static void gc_ms_add_free_object(PARROT_INTERP, Small_Object_Pool
+*pool, void *to_add)>
+
+Add an unused object back to the pool's free list for later reuse. Set
+the PObj flags to indicate that the item is free.
+
+=cut
+
+*/
+
+static void
+gc_ms_add_free_object(SHIM_INTERP, ARGMOD(Small_Object_Pool *pool),
+ ARGIN(void *to_add))
+{
+ ASSERT_ARGS(gc_ms_add_free_object)
+ PObj *object = (PObj *)to_add;
+
+ PObj_flags_SETTO(object, PObj_on_free_list_FLAG);
+
+ ((GC_MS_PObj_Wrapper*)object)->next_ptr = (PObj *)pool->free_list;
+ pool->free_list = object;
+}
+
+/*
+
+=item C<static void * gc_ms_get_free_object(PARROT_INTERP, Small_Object_Pool
+*pool)>
+
+Free object allocator for the MS garbage collector system. If there are no
+free objects, call C<gc_ms_add_free_object> to either free them up with a
+GC run, or allocate new objects. If there are objects available on the
+free list, pop it off and return it.
+
+=cut
+
+*/
+
+PARROT_CANNOT_RETURN_NULL
+PARROT_WARN_UNUSED_RESULT
+static void *
+gc_ms_get_free_object(PARROT_INTERP, ARGMOD(Small_Object_Pool *pool))
+{
+ ASSERT_ARGS(gc_ms_get_free_object)
+ PObj *ptr;
+ PObj *free_list = (PObj *)pool->free_list;
+
+ /* if we don't have any objects */
+ if (!free_list) {
+ (*pool->more_objects)(interp, pool);
+ free_list = (PObj *)pool->free_list;
+ }
+
+ ptr = free_list;
+ pool->free_list = ((GC_MS_PObj_Wrapper*)ptr)->next_ptr;
+
+ PObj_flags_SETTO(ptr, 0);
+
+ --pool->num_free_objects;
+
+ return ptr;
+}
+
+/*
+
+=item C<static void gc_ms_alloc_objects(PARROT_INTERP, Small_Object_Pool *pool)>
+
+New arena allocator function for the MS garbage collector system. Allocates
+and initializes a new memory arena in the given pool. Adds all the new
+objects to the pool's free list for later allocation.
+
+=cut
+
+*/
+
+static void
+gc_ms_alloc_objects(PARROT_INTERP, ARGMOD(Small_Object_Pool *pool))
+{
+ ASSERT_ARGS(gc_ms_alloc_objects)
+ /* Setup memory for the new objects */
+ Small_Object_Arena * const new_arena =
+ mem_internal_allocate_typed(Small_Object_Arena);
+
+ const size_t size = pool->object_size * pool->objects_per_alloc;
+ size_t alloc_size;
+
+ /* could be mem_internal_allocate too, but calloc is fast */
+ new_arena->start_objects = mem_internal_allocate_zeroed(size);
+
+ Parrot_append_arena_in_pool(interp, pool, new_arena, size);
+
+ Parrot_add_to_free_list(interp, pool, new_arena);
+
+ /* Allocate more next time */
+ if (GC_DEBUG(interp)) {
+ pool->objects_per_alloc *= GC_DEBUG_UNITS_PER_ALLOC_GROWTH_FACTOR;
+ pool->replenish_level =
+ (size_t)(pool->total_objects *
+ GC_DEBUG_REPLENISH_LEVEL_FACTOR);
+ }
+ else {
+ pool->objects_per_alloc = (size_t)(pool->objects_per_alloc *
+ UNITS_PER_ALLOC_GROWTH_FACTOR);
+ pool->replenish_level =
+ (size_t)(pool->total_objects * REPLENISH_LEVEL_FACTOR);
+ }
+
+ /* check alloc size against maximum */
+ alloc_size = pool->object_size * pool->objects_per_alloc;
+
+ if (alloc_size > POOL_MAX_BYTES)
+ pool->objects_per_alloc = POOL_MAX_BYTES / pool->object_size;
+}
+
+/*
+
+=back
+
+=head2 MS PMC_EXT Pool functions
+
+=over 4
+
+=item C<void gc_ms_pmc_ext_pool_init(Small_Object_Pool *pool)>
+
+Initialize the PMC_EXT pool functions. This is done separately from other
+pools.
+
+=cut
+
+*/
+
+void
+gc_ms_pmc_ext_pool_init(ARGMOD(Small_Object_Pool *pool))
+{
+ ASSERT_ARGS(gc_ms_pmc_ext_pool_init)
+ pool->add_free_object = gc_ms_add_free_pmc_ext;
+ pool->get_free_object = gc_ms_get_free_pmc_ext;
+ pool->alloc_objects = gc_ms_alloc_objects;
+ pool->more_objects = gc_ms_alloc_objects;
+}
+
+
+/*
+
+=item C<static void gc_ms_add_free_pmc_ext(PARROT_INTERP, Small_Object_Pool
+*pool, void *to_add)>
+
+Add a freed PMC_EXT structure to the free list in the PMC_EXT pool. Objects
+on the free list can be reused later.
+
+=cut
+
+*/
+
+static void
+gc_ms_add_free_pmc_ext(SHIM_INTERP, ARGMOD(Small_Object_Pool *pool), ARGIN(void *to_add))
+{
+ ASSERT_ARGS(gc_ms_add_free_pmc_ext)
+ PMC_EXT * const object = (PMC_EXT *)to_add;
+ object->_metadata = NULL;
+
+ /* yes, this cast is a hack for now, but a pointer is a pointer */
+ object->_next_for_GC = (PMC *)pool->free_list;
+ pool->free_list = object;
+}
+
+/*
+
+=item C<static void * gc_ms_get_free_pmc_ext(PARROT_INTERP, Small_Object_Pool
+*pool)>
+
+Get a new PMC_EXT structure from the free pool and return it.
+
+=cut
+
+*/
+
+PARROT_CANNOT_RETURN_NULL
+PARROT_WARN_UNUSED_RESULT
+static void *
+gc_ms_get_free_pmc_ext(PARROT_INTERP, ARGMOD(Small_Object_Pool *pool))
+{
+ ASSERT_ARGS(gc_ms_get_free_pmc_ext)
+ PMC_EXT *ptr;
+ PMC_EXT *free_list = (PMC_EXT *)pool->free_list;
+
+ /* if we don't have any objects */
+ if (!free_list) {
+ (*pool->more_objects)(interp, pool);
+ free_list = (PMC_EXT *)pool->free_list;
+ }
+
+ ptr = free_list;
+ pool->free_list = ptr->_next_for_GC;
+ ptr->_next_for_GC = NULL;
+
+ --pool->num_free_objects;
+
+ return ptr;
+}
+
+/*
+
+=back
+
+=cut
+
+*/
+
+/*
+ * Local variables:
+ * c-file-style: "parrot"
+ * End:
+ * vim: expandtab shiftwidth=4:
+ */
Modified: branches/pmc_pct/src/gc/gc_private.h
==============================================================================
--- branches/pmc_pct/src/gc/gc_private.h Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/gc/gc_private.h Thu Jun 4 02:32:48 2009 (r39377)
@@ -216,14 +216,9 @@
/* HEADERIZER BEGIN: src/gc/system.c */
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
-void trace_mem_block(PARROT_INTERP, size_t lo_var_ptr, size_t hi_var_ptr)
- __attribute__nonnull__(1);
-
void trace_system_areas(PARROT_INTERP)
__attribute__nonnull__(1);
-#define ASSERT_ARGS_trace_mem_block __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp)
#define ASSERT_ARGS_trace_system_areas __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp)
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
@@ -318,20 +313,27 @@
__attribute__nonnull__(1)
__attribute__nonnull__(2);
-void gc_pmc_ext_pool_init(ARGMOD(Small_Object_Pool *pool))
+PARROT_WARN_UNUSED_RESULT
+PARROT_CANNOT_RETURN_NULL
+Small_Object_Pool * get_bufferlike_pool(PARROT_INTERP, size_t buffer_size)
+ __attribute__nonnull__(1);
+
+PARROT_IGNORABLE_RESULT
+int /*@alt void@*/
+header_pools_iterate_callback(PARROT_INTERP,
+ int flag,
+ ARGIN_NULLOK(void *arg),
+ NOTNULL(pool_iter_fn func))
__attribute__nonnull__(1)
- FUNC_MODIFIES(*pool);
+ __attribute__nonnull__(4);
+
+void initialize_header_pools(PARROT_INTERP)
+ __attribute__nonnull__(1);
void mark_special(PARROT_INTERP, ARGIN(PMC *obj))
__attribute__nonnull__(1)
__attribute__nonnull__(2);
-PARROT_MALLOC
-PARROT_CANNOT_RETURN_NULL
-Small_Object_Pool * new_small_object_pool(
- size_t object_size,
- size_t objects_per_alloc);
-
void Parrot_add_to_free_list(PARROT_INTERP,
ARGMOD(Small_Object_Pool *pool),
ARGMOD(Small_Object_Arena *arena))
@@ -351,26 +353,21 @@
FUNC_MODIFIES(*pool)
FUNC_MODIFIES(*new_arena);
-void Parrot_gc_clear_live_bits(PARROT_INTERP)
- __attribute__nonnull__(1);
-
-void Parrot_gc_ms_free_pmc(PARROT_INTERP,
- SHIM(Small_Object_Pool *pool),
- ARGMOD(PObj *p))
+void Parrot_gc_clear_live_bits(PARROT_INTERP,
+ ARGIN(const Small_Object_Pool *pool))
__attribute__nonnull__(1)
- __attribute__nonnull__(3)
- FUNC_MODIFIES(*p);
+ __attribute__nonnull__(2);
-void Parrot_gc_ms_init(PARROT_INTERP)
+void Parrot_gc_profile_end(PARROT_INTERP, int what)
__attribute__nonnull__(1);
-void Parrot_gc_ms_run(PARROT_INTERP, UINTVAL flags)
+void Parrot_gc_profile_start(PARROT_INTERP)
__attribute__nonnull__(1);
-void Parrot_gc_ms_run_init(PARROT_INTERP)
+void Parrot_gc_run_init(PARROT_INTERP)
__attribute__nonnull__(1);
-void Parrot_gc_sweep(PARROT_INTERP, ARGMOD(Small_Object_Pool *pool))
+void Parrot_gc_sweep_pool(PARROT_INTERP, ARGMOD(Small_Object_Pool *pool))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
FUNC_MODIFIES(*pool);
@@ -381,28 +378,19 @@
int Parrot_gc_trace_root(PARROT_INTERP, Parrot_gc_trace_type trace)
__attribute__nonnull__(1);
-int Parrot_is_const_pmc(PARROT_INTERP, ARGIN(const PMC *pmc))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2);
-
-void Parrot_small_object_pool_merge(PARROT_INTERP,
- ARGMOD(Small_Object_Pool *dest),
- ARGMOD(Small_Object_Pool *source))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- __attribute__nonnull__(3)
- FUNC_MODIFIES(*dest)
- FUNC_MODIFIES(*source);
-
#define ASSERT_ARGS_contained_in_pool __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(pool) \
|| PARROT_ASSERT_ARG(ptr)
-#define ASSERT_ARGS_gc_pmc_ext_pool_init __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(pool)
+#define ASSERT_ARGS_get_bufferlike_pool __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
+#define ASSERT_ARGS_header_pools_iterate_callback __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(func)
+#define ASSERT_ARGS_initialize_header_pools __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
#define ASSERT_ARGS_mark_special __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
|| PARROT_ASSERT_ARG(obj)
-#define ASSERT_ARGS_new_small_object_pool __attribute__unused__ int _ASSERT_ARGS_CHECK = 0
#define ASSERT_ARGS_Parrot_add_to_free_list __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
|| PARROT_ASSERT_ARG(pool) \
@@ -412,159 +400,55 @@
|| PARROT_ASSERT_ARG(pool) \
|| PARROT_ASSERT_ARG(new_arena)
#define ASSERT_ARGS_Parrot_gc_clear_live_bits __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp)
-#define ASSERT_ARGS_Parrot_gc_ms_free_pmc __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(p)
-#define ASSERT_ARGS_Parrot_gc_ms_init __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ || PARROT_ASSERT_ARG(pool)
+#define ASSERT_ARGS_Parrot_gc_profile_end __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp)
-#define ASSERT_ARGS_Parrot_gc_ms_run __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+#define ASSERT_ARGS_Parrot_gc_profile_start __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp)
-#define ASSERT_ARGS_Parrot_gc_ms_run_init __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+#define ASSERT_ARGS_Parrot_gc_run_init __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp)
-#define ASSERT_ARGS_Parrot_gc_sweep __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+#define ASSERT_ARGS_Parrot_gc_sweep_pool __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
|| PARROT_ASSERT_ARG(pool)
#define ASSERT_ARGS_Parrot_gc_trace_children __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp)
#define ASSERT_ARGS_Parrot_gc_trace_root __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp)
-#define ASSERT_ARGS_Parrot_is_const_pmc __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(pmc)
-#define ASSERT_ARGS_Parrot_small_object_pool_merge \
- __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(dest) \
- || PARROT_ASSERT_ARG(source)
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
/* HEADERIZER END: src/gc/mark_sweep.c */
/* HEADERIZER BEGIN: src/gc/pools.c */
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
-void free_pool(ARGMOD(Small_Object_Pool *pool))
- __attribute__nonnull__(1)
- FUNC_MODIFIES(*pool);
-
PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
Small_Object_Pool * get_bufferlike_pool(PARROT_INTERP, size_t buffer_size)
__attribute__nonnull__(1);
-PARROT_WARN_UNUSED_RESULT
-PARROT_CANNOT_RETURN_NULL
-void * get_free_buffer(PARROT_INTERP, ARGIN(Small_Object_Pool *pool))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2);
-
-PARROT_WARN_UNUSED_RESULT
-size_t get_max_buffer_address(PARROT_INTERP)
- __attribute__nonnull__(1);
-
-PARROT_WARN_UNUSED_RESULT
-size_t get_max_pmc_address(PARROT_INTERP)
- __attribute__nonnull__(1);
-
-PARROT_WARN_UNUSED_RESULT
-size_t get_min_buffer_address(PARROT_INTERP)
- __attribute__nonnull__(1);
-
-PARROT_WARN_UNUSED_RESULT
-size_t get_min_pmc_address(PARROT_INTERP)
- __attribute__nonnull__(1);
-
-PARROT_WARN_UNUSED_RESULT
-int is_buffer_ptr(PARROT_INTERP, ARGIN(const void *ptr))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2);
-
-PARROT_WARN_UNUSED_RESULT
-int is_pmc_ptr(PARROT_INTERP, ARGIN(const void *ptr))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2);
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CANNOT_RETURN_NULL
-Small_Object_Pool * new_buffer_pool(PARROT_INTERP)
- __attribute__nonnull__(1);
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CANNOT_RETURN_NULL
-Small_Object_Pool * new_bufferlike_pool(PARROT_INTERP,
- size_t actual_buffer_size)
- __attribute__nonnull__(1);
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CANNOT_RETURN_NULL
-Small_Object_Pool * new_pmc_pool(PARROT_INTERP)
- __attribute__nonnull__(1);
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CANNOT_RETURN_NULL
-Small_Object_Pool * new_string_pool(PARROT_INTERP, INTVAL constant)
- __attribute__nonnull__(1);
-
PARROT_IGNORABLE_RESULT
int /*@alt void@*/
-Parrot_forall_header_pools(PARROT_INTERP,
+header_pools_iterate_callback(PARROT_INTERP,
int flag,
ARGIN_NULLOK(void *arg),
NOTNULL(pool_iter_fn func))
__attribute__nonnull__(1)
__attribute__nonnull__(4);
-void Parrot_initialize_header_pools(PARROT_INTERP)
+void initialize_header_pools(PARROT_INTERP)
__attribute__nonnull__(1);
-void Parrot_merge_memory_pools(
- ARGIN(Interp *dest_interp),
- ARGIN(Interp *source_interp))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2);
-
-#define ASSERT_ARGS_free_pool __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(pool)
#define ASSERT_ARGS_get_bufferlike_pool __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp)
-#define ASSERT_ARGS_get_free_buffer __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(pool)
-#define ASSERT_ARGS_get_max_buffer_address __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp)
-#define ASSERT_ARGS_get_max_pmc_address __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp)
-#define ASSERT_ARGS_get_min_buffer_address __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp)
-#define ASSERT_ARGS_get_min_pmc_address __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp)
-#define ASSERT_ARGS_is_buffer_ptr __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(ptr)
-#define ASSERT_ARGS_is_pmc_ptr __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(ptr)
-#define ASSERT_ARGS_new_buffer_pool __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp)
-#define ASSERT_ARGS_new_bufferlike_pool __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp)
-#define ASSERT_ARGS_new_pmc_pool __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp)
-#define ASSERT_ARGS_new_string_pool __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp)
-#define ASSERT_ARGS_Parrot_forall_header_pools __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+#define ASSERT_ARGS_header_pools_iterate_callback __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
|| PARROT_ASSERT_ARG(func)
-#define ASSERT_ARGS_Parrot_initialize_header_pools \
- __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+#define ASSERT_ARGS_initialize_header_pools __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp)
-#define ASSERT_ARGS_Parrot_merge_memory_pools __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(dest_interp) \
- || PARROT_ASSERT_ARG(source_interp)
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
/* HEADERIZER END: src/gc/pools.c */
-/* HEADERIZER BEGIN: src/gc/resources.c */
+/* HEADERIZER BEGIN: src/gc/alloc_resources.c */
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
PARROT_CANNOT_RETURN_NULL
@@ -587,6 +471,9 @@
__attribute__nonnull__(2)
FUNC_MODIFIES(*pool);
+void initialize_memory_pools(PARROT_INTERP)
+ __attribute__nonnull__(1);
+
PARROT_MALLOC
PARROT_CANNOT_RETURN_NULL
void * mem_allocate(PARROT_INTERP, size_t size, ARGMOD(Memory_Pool *pool))
@@ -600,20 +487,6 @@
FUNC_MODIFIES(*dest)
FUNC_MODIFIES(*source);
-void Parrot_allocate(PARROT_INTERP, ARGOUT(Buffer *buffer), size_t size)
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- FUNC_MODIFIES(*buffer);
-
-void Parrot_gc_profile_end(PARROT_INTERP, int what)
- __attribute__nonnull__(1);
-
-void Parrot_gc_profile_start(PARROT_INTERP)
- __attribute__nonnull__(1);
-
-void Parrot_initialize_memory_pools(PARROT_INTERP)
- __attribute__nonnull__(1);
-
#define ASSERT_ARGS_aligned_mem __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(buffer) \
|| PARROT_ASSERT_ARG(mem)
@@ -623,24 +496,16 @@
#define ASSERT_ARGS_compact_pool __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
|| PARROT_ASSERT_ARG(pool)
+#define ASSERT_ARGS_initialize_memory_pools __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
#define ASSERT_ARGS_mem_allocate __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
|| PARROT_ASSERT_ARG(pool)
#define ASSERT_ARGS_merge_pools __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(dest) \
|| PARROT_ASSERT_ARG(source)
-#define ASSERT_ARGS_Parrot_allocate __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(buffer)
-#define ASSERT_ARGS_Parrot_gc_profile_end __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp)
-#define ASSERT_ARGS_Parrot_gc_profile_start __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp)
-#define ASSERT_ARGS_Parrot_initialize_memory_pools \
- __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp)
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
-/* HEADERIZER END: src/gc/resources.c */
+/* HEADERIZER END: src/gc/alloc_resources.c */
/* GC subsystem init functions */
/* HEADERIZER BEGIN: src/gc/generational_ms.c */
@@ -720,6 +585,22 @@
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
/* HEADERIZER END: src/gc/incremental_ms.c */
+/* HEADERIZER BEGIN: src/gc/gc_ms.c */
+/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
+
+void gc_ms_pmc_ext_pool_init(ARGMOD(Small_Object_Pool *pool))
+ __attribute__nonnull__(1)
+ FUNC_MODIFIES(*pool);
+
+void Parrot_gc_ms_init(PARROT_INTERP)
+ __attribute__nonnull__(1);
+
+#define ASSERT_ARGS_gc_ms_pmc_ext_pool_init __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(pool)
+#define ASSERT_ARGS_Parrot_gc_ms_init __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
+/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
+/* HEADERIZER END: src/gc/gc_ms.c */
#endif /* PARROT_GC_PRIVATE_H_GUARD */
Modified: branches/pmc_pct/src/gc/generational_ms.c
==============================================================================
--- branches/pmc_pct/src/gc/generational_ms.c Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/gc/generational_ms.c Thu Jun 4 02:32:48 2009 (r39377)
@@ -1269,7 +1269,7 @@
plan.merge_gen = 1;
else
gmsp->current_gen_no = 1;
- Parrot_forall_header_pools(interp, POOL_ALL, &plan, set_gen_cb);
+ header_pools_iterate_callback(interp, POOL_ALL, &plan, set_gen_cb);
}
/*
@@ -1543,7 +1543,7 @@
arena_base->num_early_PMCs_seen = 0;
arena_base->num_extended_PMCs = 0;
- Parrot_forall_header_pools(interp, POOL_ALL, 0, init_mark_cb);
+ header_pools_iterate_callback(interp, POOL_ALL, 0, init_mark_cb);
}
/*
@@ -1594,7 +1594,7 @@
if (ret == 0)
return 0;
- Parrot_forall_header_pools(interp, POOL_ALL, 0, trace_igp_cb);
+ header_pools_iterate_callback(interp, POOL_ALL, 0, trace_igp_cb);
return ret;
}
@@ -1661,7 +1661,7 @@
gc_gms_trace_children(PARROT_INTERP)
{
ASSERT_ARGS(gc_gms_trace_children)
- return !Parrot_forall_header_pools(interp, POOL_PMC, 0,
+ return !header_pools_iterate_callback(interp, POOL_PMC, 0,
trace_children_cb);
}
@@ -1789,8 +1789,8 @@
gc_gms_sweep(PARROT_INTERP)
{
ASSERT_ARGS(gc_gms_sweep)
- Parrot_forall_header_pools(interp, POOL_PMC, 0, sweep_cb_pmc);
- Parrot_forall_header_pools(interp, POOL_BUFFER, 0, sweep_cb_buf);
+ header_pools_iterate_callback(interp, POOL_PMC, 0, sweep_cb_pmc);
+ header_pools_iterate_callback(interp, POOL_BUFFER, 0, sweep_cb_buf);
}
/*
@@ -1835,7 +1835,7 @@
gc_gms_end_cycle(PARROT_INTERP)
{
ASSERT_ARGS(gc_gms_end_cycle)
- Parrot_forall_header_pools(interp, POOL_ALL, 0, end_cycle_cb);
+ header_pools_iterate_callback(interp, POOL_ALL, 0, end_cycle_cb);
}
/*
@@ -1875,7 +1875,7 @@
pool->white = pool->marker.next;
/* XXX need to sweep over objects that have finalizers only */
- Parrot_forall_header_pools(interp, POOL_PMC, 0, sweep_cb_pmc);
+ header_pools_iterate_callback(interp, POOL_PMC, 0, sweep_cb_pmc);
gc_gms_end_cycle(interp);
--arena_base->gc_mark_block_level;
return;
Modified: branches/pmc_pct/src/gc/incremental_ms.c
==============================================================================
--- branches/pmc_pct/src/gc/incremental_ms.c Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/gc/incremental_ms.c Thu Jun 4 02:32:48 2009 (r39377)
@@ -697,7 +697,7 @@
Arenas * const arena_base = interp->arena_base;
arena_base->lazy_gc = 0;
- Parrot_gc_ms_run_init(interp);
+ Parrot_gc_run_init(interp);
/*
* trace root set w/o system areas
@@ -759,7 +759,7 @@
=item C<static int sweep_cb(PARROT_INTERP, Small_Object_Pool *pool, int flag,
void *arg)>
-Callback to sweep a header pool (see Parrot_forall_header_pools).
+Callback to sweep a header pool (see header_pools_iterate_callback).
=cut
@@ -771,7 +771,7 @@
ASSERT_ARGS(sweep_cb)
int * const n_obj = (int *)arg;
- Parrot_gc_sweep(interp, pool);
+ Parrot_gc_sweep_pool(interp, pool);
if (interp->profile && (flag & POOL_PMC))
Parrot_gc_profile_end(interp, PARROT_PROF_GC_cp);
@@ -820,7 +820,7 @@
/* now sweep all */
n_objects = 0;
- ignored = Parrot_forall_header_pools(interp, POOL_BUFFER | POOL_PMC,
+ ignored = header_pools_iterate_callback(interp, POOL_BUFFER | POOL_PMC,
(void*)&n_objects, sweep_cb);
UNUSED(ignored);
@@ -838,7 +838,7 @@
=item C<static int collect_cb(PARROT_INTERP, Small_Object_Pool *pool, int flag,
void *arg)>
-Callback to collect a header pool (see Parrot_forall_header_pools).
+Callback to collect a header pool (see header_pools_iterate_callback).
=cut
@@ -911,7 +911,7 @@
g_ims = (Gc_ims_private *)arena_base->gc_private;
- ret = Parrot_forall_header_pools(interp, POOL_BUFFER,
+ ret = header_pools_iterate_callback(interp, POOL_BUFFER,
(void *)(long)check_only, collect_cb);
if (ret)
@@ -1040,9 +1040,9 @@
* Be sure live bits are clear.
*/
if (g_ims->state >= GC_IMS_RE_INIT || g_ims->state < GC_IMS_FINISHED)
- Parrot_gc_clear_live_bits(interp);
+ Parrot_gc_clear_live_bits(interp, arena_base->pmc_pool);
- Parrot_gc_sweep(interp, interp->arena_base->pmc_pool);
+ Parrot_gc_sweep_pool(interp, interp->arena_base->pmc_pool);
g_ims->state = GC_IMS_DEAD;
return;
Copied: branches/pmc_pct/src/gc/malloc.c (from r39376, trunk/src/gc/malloc.c)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/pmc_pct/src/gc/malloc.c Thu Jun 4 02:32:48 2009 (r39377, copy of r39376, trunk/src/gc/malloc.c)
@@ -0,0 +1,5655 @@
+/*
+ This is a version (aka dlmalloc) of malloc/free/realloc written by
+ Doug Lea and released to the public domain. Use, modify, and
+ redistribute this code without permission or acknowledgment in any
+ way you wish. Send questions, comments, complaints, performance
+ data, etc to dl at cs.oswego.edu
+
+* VERSION 2.7.2 Sat Aug 17 09:07:30 2002 Doug Lea (dl at gee)
+
+ Note: There may be an updated version of this malloc obtainable at
+ ftp://gee.cs.oswego.edu/pub/misc/malloc.c
+ Check before installing!
+
+* Quickstart
+
+ This library is all in one file to simplify the most common usage:
+ ftp it, compile it (-O), and link it into another program. All
+ of the compile-time options default to reasonable values for use on
+ most unix platforms. Compile -DWIN32 for reasonable defaults on windows.
+ You might later want to step through various compile-time and dynamic
+ tuning options.
+
+ For convenience, an include file for code using this malloc is at:
+ ftp://gee.cs.oswego.edu/pub/misc/malloc-2.7.1.h
+ You don't really need this .h file unless you call functions not
+ defined in your system include files. The .h file contains only the
+ excerpts from this file needed for using this malloc on ANSI C/C++
+ systems, so long as you haven't changed compile-time options about
+ naming and tuning parameters. If you do, then you can create your
+ own malloc.h that does include all settings by cutting at the point
+ indicated below.
+
+* Why use this malloc?
+
+ This is not the fastest, most space-conserving, most portable, or
+ most tunable malloc ever written. However it is among the fastest
+ while also being among the most space-conserving, portable and tunable.
+ Consistent balance across these factors results in a good general-purpose
+ allocator for malloc-intensive programs.
+
+ The main properties of the algorithms are:
+ * For large (>= 512 bytes) requests, it is a pure best-fit allocator,
+ with ties normally decided via FIFO (i.e. least recently used).
+ * For small (<= 64 bytes by default) requests, it is a caching
+ allocator, that maintains pools of quickly recycled chunks.
+ * In between, and for combinations of large and small requests, it does
+ the best it can trying to meet both goals at once.
+ * For very large requests (>= 128KB by default), it relies on system
+ memory mapping facilities, if supported.
+
+ For a longer but slightly out of date high-level description, see
+ http://gee.cs.oswego.edu/dl/html/malloc.html
+
+ You may already by default be using a C library containing a malloc
+ that is based on some version of this malloc (for example in
+ linux). You might still want to use the one in this file in order to
+ customize settings or to avoid overheads associated with library
+ versions.
+
+* Contents, described in more detail in "description of public routines" below.
+
+ Standard (ANSI/SVID/...) functions:
+ malloc(size_t n);
+ calloc(size_t n_elements, size_t element_size);
+ free(Void_t* p);
+ realloc(Void_t* p, size_t n);
+ memalign(size_t alignment, size_t n);
+ valloc(size_t n);
+ mallinfo()
+ mallopt(int parameter_number, int parameter_value)
+
+ Additional functions:
+ independent_calloc(size_t n_elements, size_t size, Void_t* chunks[]);
+ independent_comalloc(size_t n_elements, size_t sizes[], Void_t* chunks[]);
+ pvalloc(size_t n);
+ cfree(Void_t* p);
+ malloc_trim(size_t pad);
+ malloc_usable_size(Void_t* p);
+ malloc_stats();
+
+* Vital statistics:
+
+ Supported pointer representation: 4 or 8 bytes
+ Supported size_t representation: 4 or 8 bytes
+ Note that size_t is allowed to be 4 bytes even if pointers are 8.
+ You can adjust this by defining INTERNAL_SIZE_T
+
+ Alignment: 2 * sizeof (size_t) (default)
+ (i.e., 8 byte alignment with 4byte size_t). This suffices for
+ nearly all current machines and C compilers. However, you can
+ define MALLOC_ALIGNMENT to be wider than this if necessary.
+
+ Minimum overhead per allocated chunk: 4 or 8 bytes
+ Each malloced chunk has a hidden word of overhead holding size
+ and status information.
+
+ Minimum allocated size: 4-byte ptrs: 16 bytes (including 4 overhead)
+ 8-byte ptrs: 24/32 bytes (including, 4/8 overhead)
+
+ When a chunk is freed, 12 (for 4byte ptrs) or 20 (for 8 byte
+ ptrs but 4 byte size) or 24 (for 8/8) additional bytes are
+ needed; 4 (8) for a trailing size field and 8 (16) bytes for
+ free list pointers. Thus, the minimum allocatable size is
+ 16/24/32 bytes.
+
+ Even a request for zero bytes (i.e., malloc(0)) returns a
+ pointer to something of the minimum allocatable size.
+
+ The maximum overhead wastage (i.e., number of extra bytes
+ allocated than were requested in malloc) is less than or equal
+ to the minimum size, except for requests >= mmap_threshold that
+ are serviced via mmap(), where the worst case wastage is 2 *
+ sizeof (size_t) bytes plus the remainder from a system page (the
+ minimal mmap unit); typically 4096 or 8192 bytes.
+
+ Maximum allocated size: 4-byte size_t: 2^32 minus about two pages
+ 8-byte size_t: 2^64 minus about two pages
+
+ It is assumed that (possibly signed) size_t values suffice to
+ represent chunk sizes. `Possibly signed' is due to the fact
+ that `size_t' may be defined on a system as either a signed or
+ an unsigned type. The ISO C standard says that it must be
+ unsigned, but a few systems are known not to adhere to this.
+ Additionally, even when size_t is unsigned, sbrk (which is by
+ default used to obtain memory from system) accepts signed
+ arguments, and may not be able to handle size_t-wide arguments
+ with negative sign bit. Generally, values that would
+ appear as negative after accounting for overhead and alignment
+ are supported only via mmap(), which does not have this
+ limitation.
+
+ Requests for sizes outside the allowed range will perform an optional
+ failure action and then return null. (Requests may also
+ also fail because a system is out of memory.)
+
+ Thread-safety: NOT thread-safe unless USE_MALLOC_LOCK defined
+
+ When USE_MALLOC_LOCK is defined, wrappers are created to
+ surround every public call with either a pthread mutex or
+ a win32 spinlock (depending on WIN32). This is not
+ especially fast, and can be a major bottleneck.
+ It is designed only to provide minimal protection
+ in concurrent environments, and to provide a basis for
+ extensions. If you are using malloc in a concurrent program,
+ you would be far better off obtaining ptmalloc, which is
+ derived from a version of this malloc, and is well-tuned for
+ concurrent programs. (See http://www.malloc.de) Note that
+ even when USE_MALLOC_LOCK is defined, you can can guarantee
+ full thread-safety only if no threads acquire memory through
+ direct calls to MORECORE or other system-level allocators.
+
+ Compliance: I believe it is compliant with the 1997 Single Unix Specification
+ (See http://www.opennc.org). Also SVID/XPG, ANSI C, and probably
+ others as well.
+
+* Synopsis of compile-time options:
+
+ People have reported using previous versions of this malloc on all
+ versions of Unix, sometimes by tweaking some of the defines
+ below. It has been tested most extensively on Solaris and
+ Linux. It is also reported to work on WIN32 platforms.
+ People also report using it in stand-alone embedded systems.
+
+ The implementation is in straight, hand-tuned ANSI C. It is not
+ at all modular. (Sorry!) It uses a lot of macros. To be at all
+ usable, this code should be compiled using an optimizing compiler
+ (for example gcc -O3) that can simplify expressions and control
+ paths. (FAQ: some macros import variables as arguments rather than
+ declare locals because people reported that some debuggers
+ otherwise get confused.)
+
+ OPTION DEFAULT VALUE
+
+ Compilation Environment options:
+
+ __STD_C derived from C compiler defines
+ WIN32 NOT defined
+ HAVE_MEMCPY defined
+ USE_MEMCPY 1 if HAVE_MEMCPY is defined
+ HAVE_MMAP defined as 1
+ MMAP_CLEARS 1
+ HAVE_MREMAP 0 unless linux defined
+ malloc_getpagesize derived from system #includes, or 4096 if not
+ HAVE_USR_INCLUDE_MALLOC_H NOT defined
+ LACKS_UNISTD_H NOT defined unless WIN32
+ LACKS_SYS_PARAM_H NOT defined unless WIN32
+ LACKS_SYS_MMAN_H NOT defined unless WIN32
+ LACKS_FCNTL_H NOT defined
+
+ Changing default word sizes:
+
+ INTERNAL_SIZE_T size_t
+ MALLOC_ALIGNMENT 2 * sizeof (INTERNAL_SIZE_T)
+ PTR_UINT unsigned long
+ CHUNK_SIZE_T unsigned long
+
+ Configuration and functionality options:
+
+ USE_DL_PREFIX NOT defined
+ USE_PUBLIC_MALLOC_WRAPPERS NOT defined
+ USE_MALLOC_LOCK NOT defined
+ DEBUG NOT defined
+ REALLOC_ZERO_BYTES_FREES NOT defined
+ MALLOC_FAILURE_ACTION errno = ENOMEM, if __STD_C defined, else no-op
+ TRIM_FASTBINS 0
+ FIRST_SORTED_BIN_SIZE 512
+
+ Options for customizing MORECORE:
+
+ MORECORE sbrk
+ MORECORE_CONTIGUOUS 1
+ MORECORE_CANNOT_TRIM NOT defined
+ MMAP_AS_MORECORE_SIZE (1024 * 1024)
+
+ Tuning options that are also dynamically changeable via mallopt:
+
+ DEFAULT_MXFAST 64
+ DEFAULT_TRIM_THRESHOLD 256 * 1024
+ DEFAULT_TOP_PAD 0
+ DEFAULT_MMAP_THRESHOLD 256 * 1024
+ DEFAULT_MMAP_MAX 65536
+
+ There are several other #defined constants and macros that you
+ probably don't want to touch unless you are extending or adapting malloc.
+*/
+
+/*
+ WIN32 sets up defaults for MS environment and compilers.
+ Otherwise defaults are for unix.
+*/
+
+/* #define WIN32 */
+
+#ifdef WIN32
+
+# define WIN32_LEAN_AND_MEAN
+# include <windows.h>
+
+/* Win32 doesn't supply or need the following headers */
+# define LACKS_UNISTD_H
+# define LACKS_SYS_PARAM_H
+# define LACKS_SYS_MMAN_H
+
+/* Use the supplied emulation of sbrk */
+# define MORECORE sbrk
+# define MORECORE_CONTIGUOUS 1
+# define MORECORE_FAILURE ((void*)(-1))
+
+/* Use the supplied emulation of mmap and munmap */
+# define HAVE_MMAP 1
+# define MUNMAP_FAILURE (-1)
+# define MMAP_CLEARS 1
+
+/* These values don't really matter in windows mmap emulation */
+# define MAP_PRIVATE 1
+# define MAP_ANONYMOUS 2
+# define PROT_READ 1
+# define PROT_WRITE 2
+
+/* Emulation functions defined at the end of this file */
+
+/* If USE_MALLOC_LOCK, use supplied critical-section-based lock functions */
+# ifdef USE_MALLOC_LOCK
+static int slwait(int *sl);
+static int slrelease(int *sl);
+# endif
+
+static long getpagesize(void);
+static long getregionsize(void);
+static void *sbrk(long size);
+static void *mmap(void *ptr, long size, long prot, long type,
+ long handle, long arg);
+static long munmap(void *ptr, long size);
+
+static void vminfo (unsigned long*free, unsigned long*reserved,
+ unsigned long*committed);
+static int cpuinfo (int whole, unsigned long*kernel, unsigned long*user);
+
+#endif
+
+/*
+ __STD_C should be nonzero if using ANSI-standard C compiler, a C++
+ compiler, or a C compiler sufficiently close to ANSI to get away
+ with it.
+*/
+
+#ifndef __STD_C
+# if defined(__STDC__) || defined(_cplusplus)
+# define __STD_C 1
+# else
+# define __STD_C 0
+# endif
+#endif /*__STD_C*/
+
+
+/*
+ Void_t* is the pointer type that malloc should say it returns
+*/
+
+#ifndef Void_t
+# if (__STD_C || defined(WIN32))
+# define Void_t void
+# else
+# define Void_t char
+# endif
+#endif /*Void_t*/
+
+#if __STD_C
+# include <stddef.h> /* for size_t */
+#else
+# include <sys/types.h>
+#endif
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/* define LACKS_UNISTD_H if your system does not have a <unistd.h>. */
+
+/* #define LACKS_UNISTD_H */
+
+#ifndef LACKS_UNISTD_H
+# include <unistd.h>
+#endif
+
+/* define LACKS_SYS_PARAM_H if your system does not have a <sys/param.h>. */
+
+/* #define LACKS_SYS_PARAM_H */
+
+
+#include <stdio.h> /* needed for malloc_stats */
+#include <errno.h> /* needed for optional MALLOC_FAILURE_ACTION */
+
+
+/*
+ Debugging:
+
+ Because freed chunks may be overwritten with bookkeeping fields, this
+ malloc will often die when freed memory is overwritten by user
+ programs. This can be very effective (albeit in an annoying way)
+ in helping track down dangling pointers.
+
+ If you compile with -DDEBUG, a number of assertion checks are
+ enabled that will catch more memory errors. You probably won't be
+ able to make much sense of the actual assertion errors, but they
+ should help you locate incorrectly overwritten memory. The
+ checking is fairly extensive, and will slow down execution
+ noticeably. Calling malloc_stats or mallinfo with DEBUG set will
+ attempt to check every non-mmapped allocated and free chunk in the
+ course of computing the summaries. (By nature, mmapped regions
+ cannot be checked very much automatically.)
+
+ Setting DEBUG may also be helpful if you are trying to modify
+ this code. The assertions in the check routines spell out in more
+ detail the assumptions and invariants underlying the algorithms.
+
+ Setting DEBUG does NOT provide an automated mechanism for checking
+ that all accesses to malloced memory stay within their
+ bounds. However, there are several add-ons and adaptations of this
+ or other mallocs available that do this.
+*/
+
+#if DEBUG
+# include <assert.h>
+#else
+# define assert(x) ((void)0)
+#endif
+
+/*
+ The unsigned integer type used for comparing any two chunk sizes.
+ This should be at least as wide as size_t, but should not be signed.
+*/
+
+#ifndef CHUNK_SIZE_T
+# define CHUNK_SIZE_T unsigned long
+#endif
+
+/*
+ The unsigned integer type used to hold addresses when they are are
+ manipulated as integers. Except that it is not defined on all
+ systems, intptr_t would suffice.
+*/
+#ifndef PTR_UINT
+# define PTR_UINT unsigned long
+#endif
+
+
+/*
+ INTERNAL_SIZE_T is the word-size used for internal bookkeeping
+ of chunk sizes.
+
+ The default version is the same as size_t.
+
+ While not strictly necessary, it is best to define this as an
+ unsigned type, even if size_t is a signed type. This may avoid some
+ artificial size limitations on some systems.
+
+ On a 64-bit machine, you may be able to reduce malloc overhead by
+ defining INTERNAL_SIZE_T to be a 32 bit `unsigned int' at the
+ expense of not being able to handle more than 2^32 of malloced
+ space. If this limitation is acceptable, you are encouraged to set
+ this unless you are on a platform requiring 16byte alignments. In
+ this case the alignment requirements turn out to negate any
+ potential advantages of decreasing size_t word size.
+
+ Implementors: Beware of the possible combinations of:
+ - INTERNAL_SIZE_T might be signed or unsigned, might be 32 or 64 bits,
+ and might be the same width as int or as long
+ - size_t might have different width and signedness as INTERNAL_SIZE_T
+ - int and long might be 32 or 64 bits, and might be the same width
+ To deal with this, most comparisons and difference computations
+ among INTERNAL_SIZE_Ts should cast them to CHUNK_SIZE_T, being
+ aware of the fact that casting an unsigned int to a wider long does
+ not sign-extend. (This also makes checking for negative numbers
+ awkward.) Some of these casts result in harmless compiler warnings
+ on some systems.
+*/
+
+#ifndef INTERNAL_SIZE_T
+# define INTERNAL_SIZE_T size_t
+#endif
+
+/* The corresponding word size */
+#define SIZE_SZ (sizeof (INTERNAL_SIZE_T))
+
+
+
+/*
+ MALLOC_ALIGNMENT is the minimum alignment for malloc'ed chunks.
+ It must be a power of two at least 2 * SIZE_SZ, even on machines
+ for which smaller alignments would suffice. It may be defined as
+ larger than this though. Note however that code and data structures
+ are optimized for the case of 8-byte alignment.
+*/
+
+
+#ifndef MALLOC_ALIGNMENT
+# define MALLOC_ALIGNMENT (2 * SIZE_SZ)
+#endif
+
+/* The corresponding bit mask value */
+#define MALLOC_ALIGN_MASK (MALLOC_ALIGNMENT - 1)
+
+
+
+/*
+ REALLOC_ZERO_BYTES_FREES should be set if a call to
+ realloc with zero bytes should be the same as a call to free.
+ Some people think it should. Otherwise, since this malloc
+ returns a unique pointer for malloc(0), so does realloc(p, 0).
+*/
+
+/* #define REALLOC_ZERO_BYTES_FREES */
+
+/*
+ TRIM_FASTBINS controls whether free() of a very small chunk can
+ immediately lead to trimming. Setting to true (1) can reduce memory
+ footprint, but will almost always slow down programs that use a lot
+ of small chunks.
+
+ Define this only if you are willing to give up some speed to more
+ aggressively reduce system-level memory footprint when releasing
+ memory in programs that use many small chunks. You can get
+ essentially the same effect by setting MXFAST to 0, but this can
+ lead to even greater slowdowns in programs using many small chunks.
+ TRIM_FASTBINS is an in-between compile-time option, that disables
+ only those chunks bordering topmost memory from being placed in
+ fastbins.
+*/
+
+#ifndef TRIM_FASTBINS
+# define TRIM_FASTBINS 0
+#endif
+
+
+/*
+ USE_DL_PREFIX will prefix all public routines with the string 'dl'.
+ This is necessary when you only want to use this malloc in one part
+ of a program, using your regular system malloc elsewhere.
+*/
+
+/* #define USE_DL_PREFIX */
+
+
+/*
+ USE_MALLOC_LOCK causes wrapper functions to surround each
+ callable routine with pthread mutex lock/unlock.
+
+ USE_MALLOC_LOCK forces USE_PUBLIC_MALLOC_WRAPPERS to be defined
+*/
+
+
+/* #define USE_MALLOC_LOCK */
+
+
+/*
+ If USE_PUBLIC_MALLOC_WRAPPERS is defined, every public routine is
+ actually a wrapper function that first calls MALLOC_PREACTION, then
+ calls the internal routine, and follows it with
+ MALLOC_POSTACTION. This is needed for locking, but you can also use
+ this, without USE_MALLOC_LOCK, for purposes of interception,
+ instrumentation, etc. It is a sad fact that using wrappers often
+ noticeably degrades performance of malloc-intensive programs.
+*/
+
+#ifdef USE_MALLOC_LOCK
+# define USE_PUBLIC_MALLOC_WRAPPERS
+#else
+ /* #define USE_PUBLIC_MALLOC_WRAPPERS */
+#endif
+
+
+/*
+ Two-phase name translation.
+ All of the actual routines are given mangled names.
+ When wrappers are used, they become the public callable versions.
+ When DL_PREFIX is used, the callable names are prefixed.
+*/
+
+#ifndef USE_PUBLIC_MALLOC_WRAPPERS
+# define cALLOc public_cALLOc
+# define fREe public_fREe
+# define cFREe public_cFREe
+# define mALLOc public_mALLOc
+# define mEMALIGn public_mEMALIGn
+# define rEALLOc public_rEALLOc
+# define vALLOc public_vALLOc
+# define pVALLOc public_pVALLOc
+# define mALLINFo public_mALLINFo
+# define mALLOPt public_mALLOPt
+# define mTRIm public_mTRIm
+# define mSTATs public_mSTATs
+# define mUSABLe public_mUSABLe
+# define iCALLOc public_iCALLOc
+# define iCOMALLOc public_iCOMALLOc
+#endif
+
+#ifdef USE_DL_PREFIX
+# define public_cALLOc dlcalloc
+# define public_fREe dlfree
+# define public_cFREe dlcfree
+# define public_mALLOc dlmalloc
+# define public_mEMALIGn dlmemalign
+# define public_rEALLOc dlrealloc
+# define public_vALLOc dlvalloc
+# define public_pVALLOc dlpvalloc
+# define public_mALLINFo dlmallinfo
+# define public_mALLOPt dlmallopt
+# define public_mTRIm dlmalloc_trim
+# define public_mSTATs dlmalloc_stats
+# define public_mUSABLe dlmalloc_usable_size
+# define public_iCALLOc dlindependent_calloc
+# define public_iCOMALLOc dlindependent_comalloc
+#else /* USE_DL_PREFIX */
+# define public_cALLOc calloc
+# define public_fREe free
+# define public_cFREe cfree
+# define public_mALLOc malloc
+# define public_mEMALIGn memalign
+# define public_rEALLOc realloc
+# define public_vALLOc valloc
+# define public_pVALLOc pvalloc
+# define public_mALLINFo mallinfo
+# define public_mALLOPt mallopt
+# define public_mTRIm malloc_trim
+# define public_mSTATs malloc_stats
+# define public_mUSABLe malloc_usable_size
+# define public_iCALLOc independent_calloc
+# define public_iCOMALLOc independent_comalloc
+#endif /* USE_DL_PREFIX */
+
+
+/*
+ HAVE_MEMCPY should be defined if you are not otherwise using
+ ANSI STD C, but still have memcpy and memset in your C library
+ and want to use them in calloc and realloc. Otherwise simple
+ macro versions are defined below.
+
+ USE_MEMCPY should be defined as 1 if you actually want to
+ have memset and memcpy called. People report that the macro
+ versions are faster than libc versions on some systems.
+
+ Even if USE_MEMCPY is set to 1, loops to copy/clear small chunks
+ (of <= 36 bytes) are manually unrolled in realloc and calloc.
+*/
+
+#define HAVE_MEMCPY
+
+#ifndef USE_MEMCPY
+# ifdef HAVE_MEMCPY
+# define USE_MEMCPY 1
+# else
+# define USE_MEMCPY 0
+# endif
+#endif
+
+
+#if (__STD_C || defined(HAVE_MEMCPY))
+
+# ifdef WIN32
+/* On Win32 memset and memcpy are already declared in windows.h */
+# else
+# if __STD_C
+void* memset(void*, int, size_t);
+void* memcpy(void*, const void*, size_t);
+# else
+Void_t* memset();
+Void_t* memcpy();
+# endif
+# endif
+#endif
+
+/*
+ MALLOC_FAILURE_ACTION is the action to take before "return 0" when
+ malloc fails to be able to return memory, either because memory is
+ exhausted or because of illegal arguments.
+
+ By default, sets errno if running on STD_C platform, else does nothing.
+*/
+
+#ifndef MALLOC_FAILURE_ACTION
+# if __STD_C
+# define MALLOC_FAILURE_ACTION \
+ errno = ENOMEM;
+
+# else
+# define MALLOC_FAILURE_ACTION
+# endif
+#endif
+
+/*
+ MORECORE-related declarations. By default, rely on sbrk
+*/
+
+
+#ifdef LACKS_UNISTD_H
+# if !defined(__FreeBSD__) && !defined(__OpenBSD__) && \
+ !defined(__NetBSD__) && !defined(__GNUC__)
+# if __STD_C
+extern Void_t* sbrk(ptrdiff_t);
+# else
+extern Void_t* sbrk();
+# endif
+# endif
+#endif
+
+/*
+ MORECORE is the name of the routine to call to obtain more memory
+ from the system. See below for general guidance on writing
+ alternative MORECORE functions, as well as a version for WIN32 and a
+ sample version for pre-OSX macos.
+*/
+
+#ifndef MORECORE
+# define MORECORE sbrk
+#endif
+
+/*
+ MORECORE_FAILURE is the value returned upon failure of MORECORE
+ as well as mmap. Since it cannot be an otherwise valid memory address,
+ and must reflect values of standard sys calls, you probably ought not
+ try to redefine it.
+*/
+
+#ifndef MORECORE_FAILURE
+# define MORECORE_FAILURE (-1)
+#endif
+
+/*
+ If MORECORE_CONTIGUOUS is true, take advantage of fact that
+ consecutive calls to MORECORE with positive arguments always return
+ contiguous increasing addresses. This is true of unix sbrk. Even
+ if not defined, when regions happen to be contiguous, malloc will
+ permit allocations spanning regions obtained from different
+ calls. But defining this when applicable enables some stronger
+ consistency checks and space efficiencies.
+*/
+
+#ifndef MORECORE_CONTIGUOUS
+# define MORECORE_CONTIGUOUS 1
+#endif
+
+/*
+ Define MORECORE_CANNOT_TRIM if your version of MORECORE
+ cannot release space back to the system when given negative
+ arguments. This is generally necessary only if you are using
+ a hand-crafted MORECORE function that cannot handle negative arguments.
+*/
+
+/* #define MORECORE_CANNOT_TRIM */
+
+
+/*
+ Define HAVE_MMAP as true to optionally make malloc() use mmap() to
+ allocate very large blocks. These will be returned to the
+ operating system immediately after a free(). Also, if mmap
+ is available, it is used as a backup strategy in cases where
+ MORECORE fails to provide space from system.
+
+ This malloc is best tuned to work with mmap for large requests.
+ If you do not have mmap, operations involving very large chunks (1MB
+ or so) may be slower than you'd like.
+*/
+
+#ifndef HAVE_MMAP
+# define HAVE_MMAP 1
+#endif
+
+#if HAVE_MMAP
+/*
+ Standard unix mmap using /dev/zero clears memory so calloc doesn't
+ need to.
+*/
+
+# ifndef MMAP_CLEARS
+# define MMAP_CLEARS 1
+# endif
+
+#else /* no mmap */
+# ifndef MMAP_CLEARS
+# define MMAP_CLEARS 0
+# endif
+#endif
+
+
+/*
+ MMAP_AS_MORECORE_SIZE is the minimum mmap size argument to use if
+ sbrk fails, and mmap is used as a backup (which is done only if
+ HAVE_MMAP). The value must be a multiple of page size. This
+ backup strategy generally applies only when systems have "holes" in
+ address space, so sbrk cannot perform contiguous expansion, but
+ there is still space available on system. On systems for which
+ this is known to be useful (i.e. most linux kernels), this occurs
+ only when programs allocate huge amounts of memory. Between this,
+ and the fact that mmap regions tend to be limited, the size should
+ be large, to avoid too many mmap calls and thus avoid running out
+ of kernel resources.
+*/
+
+#ifndef MMAP_AS_MORECORE_SIZE
+# define MMAP_AS_MORECORE_SIZE (1024 * 1024)
+#endif
+
+/*
+ Define HAVE_MREMAP to make realloc() use mremap() to re-allocate
+ large blocks. This is currently only possible on Linux with
+ kernel versions newer than 1.3.77.
+*/
+
+#ifndef HAVE_MREMAP
+# ifdef linux
+# define HAVE_MREMAP 1
+# else
+# define HAVE_MREMAP 0
+# endif
+
+#endif /* HAVE_MMAP */
+
+
+/*
+ The system page size. To the extent possible, this malloc manages
+ memory from the system in page-size units. Note that this value is
+ cached during initialization into a field of malloc_state. So even
+ if malloc_getpagesize is a function, it is only called once.
+
+ The following mechanics for getpagesize were adapted from bsd/gnu
+ getpagesize.h. If none of the system-probes here apply, a value of
+ 4096 is used, which should be OK: If they don't apply, then using
+ the actual value probably doesn't impact performance.
+*/
+
+
+#ifndef malloc_getpagesize
+
+# ifndef LACKS_UNISTD_H
+# include <unistd.h>
+# endif
+
+# ifdef _SC_PAGESIZE /* some SVR4 systems omit an underscore */
+# ifndef _SC_PAGE_SIZE
+# define _SC_PAGE_SIZE _SC_PAGESIZE
+# endif
+# endif
+
+# ifdef _SC_PAGE_SIZE
+# define malloc_getpagesize sysconf(_SC_PAGE_SIZE)
+# else
+# if defined(BSD) || defined(DGUX) || defined(HAVE_GETPAGESIZE)
+ extern size_t getpagesize();
+# define malloc_getpagesize getpagesize()
+# else
+# ifdef WIN32 /* use supplied emulation of getpagesize */
+# define malloc_getpagesize getpagesize()
+# else
+# ifndef LACKS_SYS_PARAM_H
+# include <sys/param.h>
+# endif
+# ifdef EXEC_PAGESIZE
+# define malloc_getpagesize EXEC_PAGESIZE
+# else
+# ifdef NBPG
+# ifndef CLSIZE
+# define malloc_getpagesize NBPG
+# else
+# define malloc_getpagesize (NBPG * CLSIZE)
+# endif
+# else
+# ifdef NBPC
+# define malloc_getpagesize NBPC
+# else
+# ifdef PAGESIZE
+# define malloc_getpagesize PAGESIZE
+# else /* just guess */
+# define malloc_getpagesize (4096)
+# endif
+# endif
+# endif
+# endif
+# endif
+# endif
+# endif
+#endif
+
+/*
+ This version of malloc supports the standard SVID/XPG mallinfo
+ routine that returns a struct containing usage properties and
+ statistics. It should work on any SVID/XPG compliant system that has
+ a /usr/include/malloc.h defining struct mallinfo. (If you'd like to
+ install such a thing yourself, cut out the preliminary declarations
+ as described above and below and save them in a malloc.h file. But
+ there's no compelling reason to bother to do this.)
+
+ The main declaration needed is the mallinfo struct that is returned
+ (by-copy) by mallinfo(). The SVID/XPG malloinfo struct contains a
+ bunch of fields that are not even meaningful in this version of
+ malloc. These fields are are instead filled by mallinfo() with
+ other numbers that might be of interest.
+
+ HAVE_USR_INCLUDE_MALLOC_H should be set if you have a
+ /usr/include/malloc.h file that includes a declaration of struct
+ mallinfo. If so, it is included; else an SVID2/XPG2 compliant
+ version is declared below. These must be precisely the same for
+ mallinfo() to work. The original SVID version of this struct,
+ defined on most systems with mallinfo, declares all fields as
+ ints. But some others define as unsigned long. If your system
+ defines the fields using a type of different width than listed here,
+ you must #include your system version and #define
+ HAVE_USR_INCLUDE_MALLOC_H.
+*/
+
+/* #define HAVE_USR_INCLUDE_MALLOC_H */
+
+#ifdef HAVE_USR_INCLUDE_MALLOC_H
+# include "/usr/include/malloc.h"
+#else
+
+/* SVID2/XPG mallinfo structure */
+
+struct mallinfo {
+ int arena; /* non-mmapped space allocated from system */
+ int ordblks; /* number of free chunks */
+ int smblks; /* number of fastbin blocks */
+ int hblks; /* number of mmapped regions */
+ int hblkhd; /* space in mmapped regions */
+ int usmblks; /* maximum total allocated space */
+ int fsmblks; /* space available in freed fastbin blocks */
+ int uordblks; /* total allocated space */
+ int fordblks; /* total free space */
+ int keepcost; /* top-most, releasable (via malloc_trim) space */
+};
+
+/*
+ SVID/XPG defines four standard parameter numbers for mallopt,
+ normally defined in malloc.h. Only one of these (M_MXFAST) is used
+ in this malloc. The others (M_NLBLKS, M_GRAIN, M_KEEP) don't apply,
+ so setting them has no effect. But this malloc also supports other
+ options in mallopt described below.
+*/
+#endif
+
+
+/* ---------- description of public routines ------------ */
+
+/*
+ malloc(size_t n)
+ Returns a pointer to a newly allocated chunk of at least n bytes, or null
+ if no space is available. Additionally, on failure, errno is
+ set to ENOMEM on ANSI C systems.
+
+ If n is zero, malloc returns a minumum-sized chunk. (The minimum
+ size is 16 bytes on most 32bit systems, and 24 or 32 bytes on 64bit
+ systems.) On most systems, size_t is an unsigned type, so calls
+ with negative arguments are interpreted as requests for huge amounts
+ of space, which will often fail. The maximum supported value of n
+ differs across systems, but is in all cases less than the maximum
+ representable value of a size_t.
+*/
+#if __STD_C
+Void_t* public_mALLOc(size_t);
+#else
+Void_t* public_mALLOc();
+#endif
+
+/*
+ free(Void_t* p)
+ Releases the chunk of memory pointed to by p, that had been previously
+ allocated using malloc or a related routine such as realloc.
+ It has no effect if p is null. It can have arbitrary (i.e., bad!)
+ effects if p has already been freed.
+
+ Unless disabled (using mallopt), freeing very large spaces will
+ when possible, automatically trigger operations that give
+ back unused memory to the system, thus reducing program footprint.
+*/
+#if __STD_C
+void public_fREe(Void_t*);
+#else
+void public_fREe();
+#endif
+
+/*
+ calloc(size_t n_elements, size_t element_size);
+ Returns a pointer to n_elements * element_size bytes, with all locations
+ set to zero.
+*/
+#if __STD_C
+Void_t* public_cALLOc(size_t, size_t);
+#else
+Void_t* public_cALLOc();
+#endif
+
+/*
+ realloc(Void_t* p, size_t n)
+ Returns a pointer to a chunk of size n that contains the same data
+ as does chunk p up to the minimum of (n, p's size) bytes, or null
+ if no space is available.
+
+ The returned pointer may or may not be the same as p. The algorithm
+ prefers extending p when possible, otherwise it employs the
+ equivalent of a malloc-copy-free sequence.
+
+ If p is null, realloc is equivalent to malloc.
+
+ If space is not available, realloc returns null, errno is set (if on
+ ANSI) and p is NOT freed.
+
+ if n is for fewer bytes than already held by p, the newly unused
+ space is lopped off and freed if possible. Unless the #define
+ REALLOC_ZERO_BYTES_FREES is set, realloc with a size argument of
+ zero (re)allocates a minimum-sized chunk.
+
+ Large chunks that were internally obtained via mmap will always
+ be reallocated using malloc-copy-free sequences unless
+ the system supports MREMAP (currently only linux).
+
+ The old unix realloc convention of allowing the last-free'd chunk
+ to be used as an argument to realloc is not supported.
+*/
+#if __STD_C
+Void_t* public_rEALLOc(Void_t*, size_t);
+#else
+Void_t* public_rEALLOc();
+#endif
+
+/*
+ memalign(size_t alignment, size_t n);
+ Returns a pointer to a newly allocated chunk of n bytes, aligned
+ in accord with the alignment argument.
+
+ The alignment argument should be a power of two. If the argument is
+ not a power of two, the nearest greater power is used.
+ 8-byte alignment is guaranteed by normal malloc calls, so don't
+ bother calling memalign with an argument of 8 or less.
+
+ Overreliance on memalign is a sure way to fragment space.
+*/
+#if __STD_C
+Void_t* public_mEMALIGn(size_t, size_t);
+#else
+Void_t* public_mEMALIGn();
+#endif
+
+/*
+ valloc(size_t n);
+ Equivalent to memalign(pagesize, n), where pagesize is the page
+ size of the system. If the pagesize is unknown, 4096 is used.
+*/
+#if __STD_C
+Void_t* public_vALLOc(size_t);
+#else
+Void_t* public_vALLOc();
+#endif
+
+
+
+/*
+ mallopt(int parameter_number, int parameter_value)
+ Sets tunable parameters The format is to provide a
+ (parameter-number, parameter-value) pair. mallopt then sets the
+ corresponding parameter to the argument value if it can (i.e., so
+ long as the value is meaningful), and returns 1 if successful else
+ 0. SVID/XPG/ANSI defines four standard param numbers for mallopt,
+ normally defined in malloc.h. Only one of these (M_MXFAST) is used
+ in this malloc. The others (M_NLBLKS, M_GRAIN, M_KEEP) don't apply,
+ so setting them has no effect. But this malloc also supports four
+ other options in mallopt. See below for details. Briefly, supported
+ parameters are as follows (listed defaults are for "typical"
+ configurations).
+
+ Symbol param # default allowed param values
+ M_MXFAST 1 64 0-80 (0 disables fastbins)
+ M_TRIM_THRESHOLD -1 256*1024 any (-1U disables trimming)
+ M_TOP_PAD -2 0 any
+ M_MMAP_THRESHOLD -3 256*1024 any (or 0 if no MMAP support)
+ M_MMAP_MAX -4 65536 any (0 disables use of mmap)
+*/
+#if __STD_C
+int public_mALLOPt(int, int);
+#else
+int public_mALLOPt();
+#endif
+
+
+/*
+ mallinfo()
+ Returns (by copy) a struct containing various summary statistics:
+
+ arena: current total non-mmapped bytes allocated from system
+ ordblks: the number of free chunks
+ smblks: the number of fastbin blocks (i.e., small chunks that
+ have been freed but not use, reused, or consolidated)
+ hblks: current number of mmapped regions
+ hblkhd: total bytes held in mmapped regions
+ usmblks: the maximum total allocated space. This will be greater
+ than current total if trimming has occurred.
+ fsmblks: total bytes held in fastbin blocks
+ uordblks: current total allocated space (normal or mmapped)
+ fordblks: total free space
+ keepcost: the maximum number of bytes that could ideally be released
+ back to system via malloc_trim. ("ideally" means that
+ it ignores page restrictions etc.)
+
+ Because these fields are ints, but internal bookkeeping may
+ be kept as longs, the reported values may wrap around zero and
+ thus be inaccurate.
+*/
+#if __STD_C
+struct mallinfo public_mALLINFo(void);
+#else
+struct mallinfo public_mALLINFo();
+#endif
+
+/*
+ independent_calloc(size_t n_elements, size_t element_size, Void_t* chunks[]);
+
+ independent_calloc is similar to calloc, but instead of returning a
+ single cleared space, it returns an array of pointers to n_elements
+ independent elements that can hold contents of size elem_size, each
+ of which starts out cleared, and can be independently freed,
+ realloc'ed etc. The elements are guaranteed to be adjacently
+ allocated (this is not guaranteed to occur with multiple callocs or
+ mallocs), which may also improve cache locality in some
+ applications.
+
+ The "chunks" argument is optional (i.e., may be null, which is
+ probably the most typical usage). If it is null, the returned array
+ is itself dynamically allocated and should also be freed when it is
+ no longer needed. Otherwise, the chunks array must be of at least
+ n_elements in length. It is filled in with the pointers to the
+ chunks.
+
+ In either case, independent_calloc returns this pointer array, or
+ null if the allocation failed. If n_elements is zero and "chunks"
+ is null, it returns a chunk representing an array with zero elements
+ (which should be freed if not wanted).
+
+ Each element must be individually freed when it is no longer
+ needed. If you'd like to instead be able to free all at once, you
+ should instead use regular calloc and assign pointers into this
+ space to represent elements. (In this case though, you cannot
+ independently free elements.)
+
+ independent_calloc simplifies and speeds up implementations of many
+ kinds of pools. It may also be useful when constructing large data
+ structures that initially have a fixed number of fixed-sized nodes,
+ but the number is not known at compile time, and some of the nodes
+ may later need to be freed. For example:
+
+ struct Node { int item; struct Node* next; };
+
+ struct Node* build_list() {
+ struct Node** pool;
+ int n = read_number_of_nodes_needed();
+ if (n <= 0) return 0;
+ pool = (struct Node**)(independent_calloc(n, sizeof (struct Node), 0);
+ if (pool == 0) die();
+ / / organize into a linked list...
+ struct Node* first = pool[0];
+ for (i = 0; i < n-1; ++i)
+ pool[i]->next = pool[i+1];
+ free(pool); / / Can now free the array (or not, if it is needed later)
+ return first;
+ }
+*/
+#if __STD_C
+Void_t** public_iCALLOc(size_t, size_t, Void_t**);
+#else
+Void_t** public_iCALLOc();
+#endif
+
+/*
+ independent_comalloc(size_t n_elements, size_t sizes[], Void_t* chunks[]);
+
+ independent_comalloc allocates, all at once, a set of n_elements
+ chunks with sizes indicated in the "sizes" array. It returns
+ an array of pointers to these elements, each of which can be
+ independently freed, realloc'ed etc. The elements are guaranteed to
+ be adjacently allocated (this is not guaranteed to occur with
+ multiple callocs or mallocs), which may also improve cache locality
+ in some applications.
+
+ The "chunks" argument is optional (i.e., may be null). If it is null
+ the returned array is itself dynamically allocated and should also
+ be freed when it is no longer needed. Otherwise, the chunks array
+ must be of at least n_elements in length. It is filled in with the
+ pointers to the chunks.
+
+ In either case, independent_comalloc returns this pointer array, or
+ null if the allocation failed. If n_elements is zero and chunks is
+ null, it returns a chunk representing an array with zero elements
+ (which should be freed if not wanted).
+
+ Each element must be individually freed when it is no longer
+ needed. If you'd like to instead be able to free all at once, you
+ should instead use a single regular malloc, and assign pointers at
+ particular offsets in the aggregate space. (In this case though, you
+ cannot independently free elements.)
+
+ independent_comallac differs from independent_calloc in that each
+ element may have a different size, and also that it does not
+ automatically clear elements.
+
+ independent_comalloc can be used to speed up allocation in cases
+ where several structs or objects must always be allocated at the
+ same time. For example:
+
+ struct Head { ... }
+ struct Foot { ... }
+
+ void send_message(char* msg) {
+ int msglen = strlen(msg);
+ size_t sizes[3] = { sizeof (struct Head), msglen, sizeof (struct Foot) };
+ void* chunks[3];
+ if (independent_comalloc(3, sizes, chunks) == 0)
+ die();
+ struct Head* head = (struct Head*)(chunks[0]);
+ char* body = (char*)(chunks[1]);
+ struct Foot* foot = (struct Foot*)(chunks[2]);
+ / / ...
+ }
+
+ In general though, independent_comalloc is worth using only for
+ larger values of n_elements. For small values, you probably won't
+ detect enough difference from series of malloc calls to bother.
+
+ Overuse of independent_comalloc can increase overall memory usage,
+ since it cannot reuse existing noncontiguous small chunks that
+ might be available for some of the elements.
+*/
+#if __STD_C
+Void_t** public_iCOMALLOc(size_t, size_t*, Void_t**);
+#else
+Void_t** public_iCOMALLOc();
+#endif
+
+
+/*
+ pvalloc(size_t n);
+ Equivalent to valloc(minimum-page-that-holds(n)), that is,
+ round up n to nearest pagesize.
+ */
+#if __STD_C
+Void_t* public_pVALLOc(size_t);
+#else
+Void_t* public_pVALLOc();
+#endif
+
+/*
+ cfree(Void_t* p);
+ Equivalent to free(p).
+
+ cfree is needed/defined on some systems that pair it with calloc,
+ for odd historical reasons (such as: cfree is used in example
+ code in the first edition of K&R).
+*/
+#if __STD_C
+void public_cFREe(Void_t*);
+#else
+void public_cFREe();
+#endif
+
+/*
+ malloc_trim(size_t pad);
+
+ If possible, gives memory back to the system (via negative
+ arguments to sbrk) if there is unused memory at the `high' end of
+ the malloc pool. You can call this after freeing large blocks of
+ memory to potentially reduce the system-level memory requirements
+ of a program. However, it cannot guarantee to reduce memory. Under
+ some allocation patterns, some large free blocks of memory will be
+ locked between two used chunks, so they cannot be given back to
+ the system.
+
+ The `pad' argument to malloc_trim represents the amount of free
+ trailing space to leave untrimmed. If this argument is zero,
+ only the minimum amount of memory to maintain internal data
+ structures will be left (one page or less). Non-zero arguments
+ can be supplied to maintain enough trailing space to service
+ future expected allocations without having to re-obtain memory
+ from the system.
+
+ Malloc_trim returns 1 if it actually released any memory, else 0.
+ On systems that do not support "negative sbrks", it will always
+ rreturn 0.
+*/
+#if __STD_C
+int public_mTRIm(size_t);
+#else
+int public_mTRIm();
+#endif
+
+/*
+ malloc_usable_size(Void_t* p);
+
+ Returns the number of bytes you can actually use in
+ an allocated chunk, which may be more than you requested (although
+ often not) due to alignment and minimum size constraints.
+ You can use this many bytes without worrying about
+ overwriting other allocated objects. This is not a particularly great
+ programming practice. malloc_usable_size can be more useful in
+ debugging and assertions, for example:
+
+ p = malloc(n);
+ assert(malloc_usable_size(p) >= 256);
+
+*/
+#if __STD_C
+size_t public_mUSABLe(Void_t*);
+#else
+size_t public_mUSABLe();
+#endif
+
+/*
+ malloc_stats();
+ Prints on stderr the amount of space obtained from the system (both
+ via sbrk and mmap), the maximum amount (which may be more than
+ current if malloc_trim and/or munmap got called), and the current
+ number of bytes allocated via malloc (or realloc, etc) but not yet
+ freed. Note that this is the number of bytes allocated, not the
+ number requested. It will be larger than the number requested
+ because of alignment and bookkeeping overhead. Because it includes
+ alignment wastage as being in use, this figure may be greater than
+ zero even when no user-level chunks are allocated.
+
+ The reported current and maximum system memory can be inaccurate if
+ a program makes other calls to system memory allocation functions
+ (normally sbrk) outside of malloc.
+
+ malloc_stats prints only the most commonly interesting statistics.
+ More information can be obtained by calling mallinfo.
+
+*/
+#if __STD_C
+void public_mSTATs();
+#else
+void public_mSTATs();
+#endif
+
+/* mallopt tuning options */
+
+/*
+ M_MXFAST is the maximum request size used for "fastbins", special bins
+ that hold returned chunks without consolidating their spaces. This
+ enables future requests for chunks of the same size to be handled
+ very quickly, but can increase fragmentation, and thus increase the
+ overall memory footprint of a program.
+
+ This malloc manages fastbins very conservatively yet still
+ efficiently, so fragmentation is rarely a problem for values less
+ than or equal to the default. The maximum supported value of MXFAST
+ is 80. You wouldn't want it any higher than this anyway. Fastbins
+ are designed especially for use with many small structs, objects or
+ strings -- the default handles structs/objects/arrays with sizes up
+ to 16 4byte fields, or small strings representing words, tokens,
+ etc. Using fastbins for larger objects normally worsens
+ fragmentation without improving speed.
+
+ M_MXFAST is set in REQUEST size units. It is internally used in
+ chunksize units, which adds padding and alignment. You can reduce
+ M_MXFAST to 0 to disable all use of fastbins. This causes the malloc
+ algorithm to be a closer approximation of fifo-best-fit in all cases,
+ not just for larger requests, but will generally cause it to be
+ slower.
+*/
+
+
+/* M_MXFAST is a standard SVID/XPG tuning option, usually listed in malloc.h */
+#ifndef M_MXFAST
+# define M_MXFAST 1
+#endif
+
+#ifndef DEFAULT_MXFAST
+# define DEFAULT_MXFAST 64
+#endif
+
+
+/*
+ M_TRIM_THRESHOLD is the maximum amount of unused top-most memory
+ to keep before releasing via malloc_trim in free().
+
+ Automatic trimming is mainly useful in long-lived programs.
+ Because trimming via sbrk can be slow on some systems, and can
+ sometimes be wasteful (in cases where programs immediately
+ afterward allocate more large chunks) the value should be high
+ enough so that your overall system performance would improve by
+ releasing this much memory.
+
+ The trim threshold and the mmap control parameters (see below)
+ can be traded off with one another. Trimming and mmapping are
+ two different ways of releasing unused memory back to the
+ system. Between these two, it is often possible to keep
+ system-level demands of a long-lived program down to a bare
+ minimum. For example, in one test suite of sessions measuring
+ the XF86 X server on Linux, using a trim threshold of 128K and a
+ mmap threshold of 192K led to near-minimal long term resource
+ consumption.
+
+ If you are using this malloc in a long-lived program, it should
+ pay to experiment with these values. As a rough guide, you
+ might set to a value close to the average size of a process
+ (program) running on your system. Releasing this much memory
+ would allow such a process to run in memory. Generally, it's
+ worth it to tune for trimming rather tham memory mapping when a
+ program undergoes phases where several large chunks are
+ allocated and released in ways that can reuse each other's
+ storage, perhaps mixed with phases where there are no such
+ chunks at all. And in well-behaved long-lived programs,
+ controlling release of large blocks via trimming versus mapping
+ is usually faster.
+
+ However, in most programs, these parameters serve mainly as
+ protection against the system-level effects of carrying around
+ massive amounts of unneeded memory. Since frequent calls to
+ sbrk, mmap, and munmap otherwise degrade performance, the default
+ parameters are set to relatively high values that serve only as
+ safeguards.
+
+ The trim value must be greater than page size to have any useful
+ effect. To disable trimming completely, you can set to
+ (unsigned long)(-1)
+
+ Trim settings interact with fastbin (MXFAST) settings: Unless
+ TRIM_FASTBINS is defined, automatic trimming never takes place upon
+ freeing a chunk with size less than or equal to MXFAST. Trimming is
+ instead delayed until subsequent freeing of larger chunks. However,
+ you can still force an attempted trim by calling malloc_trim.
+
+ Also, trimming is not generally possible in cases where
+ the main arena is obtained via mmap.
+
+ Note that the trick some people use of mallocing a huge space and
+ then freeing it at program startup, in an attempt to reserve system
+ memory, doesn't have the intended effect under automatic trimming,
+ since that memory will immediately be returned to the system.
+*/
+
+#define M_TRIM_THRESHOLD -1
+
+#ifndef DEFAULT_TRIM_THRESHOLD
+# define DEFAULT_TRIM_THRESHOLD (256 * 1024)
+#endif
+
+/*
+ M_TOP_PAD is the amount of extra `padding' space to allocate or
+ retain whenever sbrk is called. It is used in two ways internally:
+
+ * When sbrk is called to extend the top of the arena to satisfy
+ a new malloc request, this much padding is added to the sbrk
+ request.
+
+ * When malloc_trim is called automatically from free(),
+ it is used as the `pad' argument.
+
+ In both cases, the actual amount of padding is rounded
+ so that the end of the arena is always a system page boundary.
+
+ The main reason for using padding is to avoid calling sbrk so
+ often. Having even a small pad greatly reduces the likelihood
+ that nearly every malloc request during program start-up (or
+ after trimming) will invoke sbrk, which needlessly wastes
+ time.
+
+ Automatic rounding-up to page-size units is normally sufficient
+ to avoid measurable overhead, so the default is 0. However, in
+ systems where sbrk is relatively slow, it can pay to increase
+ this value, at the expense of carrying around more memory than
+ the program needs.
+*/
+
+#define M_TOP_PAD -2
+
+#ifndef DEFAULT_TOP_PAD
+# define DEFAULT_TOP_PAD (0)
+#endif
+
+/*
+ M_MMAP_THRESHOLD is the request size threshold for using mmap()
+ to service a request. Requests of at least this size that cannot
+ be allocated using already-existing space will be serviced via mmap.
+ (If enough normal freed space already exists it is used instead.)
+
+ Using mmap segregates relatively large chunks of memory so that
+ they can be individually obtained and released from the host
+ system. A request serviced through mmap is never reused by any
+ other request (at least not directly; the system may just so
+ happen to remap successive requests to the same locations).
+
+ Segregating space in this way has the benefits that:
+
+ 1. Mmapped space can ALWAYS be individually released back
+ to the system, which helps keep the system level memory
+ demands of a long-lived program low.
+ 2. Mapped memory can never become `locked' between
+ other chunks, as can happen with normally allocated chunks, which
+ means that even trimming via malloc_trim would not release them.
+ 3. On some systems with "holes" in address spaces, mmap can obtain
+ memory that sbrk cannot.
+
+ However, it has the disadvantages that:
+
+ 1. The space cannot be reclaimed, consolidated, and then
+ used to service later requests, as happens with normal chunks.
+ 2. It can lead to more wastage because of mmap page alignment
+ requirements
+ 3. It causes malloc performance to be more dependent on host
+ system memory management support routines which may vary in
+ implementation quality and may impose arbitrary
+ limitations. Generally, servicing a request via normal
+ malloc steps is faster than going through a system's mmap.
+
+ The advantages of mmap nearly always outweigh disadvantages for
+ "large" chunks, but the value of "large" varies across systems. The
+ default is an empirically derived value that works well in most
+ systems.
+*/
+
+#define M_MMAP_THRESHOLD -3
+
+#ifndef DEFAULT_MMAP_THRESHOLD
+# define DEFAULT_MMAP_THRESHOLD (256 * 1024)
+#endif
+
+/*
+ M_MMAP_MAX is the maximum number of requests to simultaneously
+ service using mmap. This parameter exists because
+. Some systems have a limited number of internal tables for
+ use by mmap, and using more than a few of them may degrade
+ performance.
+
+ The default is set to a value that serves only as a safeguard.
+ Setting to 0 disables use of mmap for servicing large requests. If
+ HAVE_MMAP is not set, the default value is 0, and attempts to set it
+ to non-zero values in mallopt will fail.
+*/
+
+#define M_MMAP_MAX -4
+
+#ifndef DEFAULT_MMAP_MAX
+# if HAVE_MMAP
+# define DEFAULT_MMAP_MAX (65536)
+# else
+# define DEFAULT_MMAP_MAX (0)
+# endif
+#endif
+
+#ifdef __cplusplus
+}; /* end of extern "C" */
+#endif
+
+/*
+ ========================================================================
+ To make a fully customizable malloc.h header file, cut everything
+ above this line, put into file malloc.h, edit to suit, and #include it
+ on the next line, as well as in programs that use this malloc.
+ ========================================================================
+*/
+
+/* #include "malloc.h" */
+
+/* --------------------- public wrappers ---------------------- */
+
+#ifdef USE_PUBLIC_MALLOC_WRAPPERS
+
+/* Declare all routines as internal */
+# if __STD_C
+static Void_t* mALLOc(size_t);
+static void fREe(Void_t*);
+static Void_t* rEALLOc(Void_t*, size_t);
+static Void_t* mEMALIGn(size_t, size_t);
+static Void_t* vALLOc(size_t);
+static Void_t* pVALLOc(size_t);
+static Void_t* cALLOc(size_t, size_t);
+static Void_t** iCALLOc(size_t, size_t, Void_t**);
+static Void_t** iCOMALLOc(size_t, size_t*, Void_t**);
+static void cFREe(Void_t*);
+static int mTRIm(size_t);
+static size_t mUSABLe(Void_t*);
+static void mSTATs();
+static int mALLOPt(int, int);
+static struct mallinfo mALLINFo(void);
+# else
+static Void_t* mALLOc();
+static void fREe();
+static Void_t* rEALLOc();
+static Void_t* mEMALIGn();
+static Void_t* vALLOc();
+static Void_t* pVALLOc();
+static Void_t* cALLOc();
+static Void_t** iCALLOc();
+static Void_t** iCOMALLOc();
+static void cFREe();
+static int mTRIm();
+static size_t mUSABLe();
+static void mSTATs();
+static int mALLOPt();
+static struct mallinfo mALLINFo();
+# endif
+
+/*
+ MALLOC_PREACTION and MALLOC_POSTACTION should be
+ defined to return 0 on success, and nonzero on failure.
+ The return value of MALLOC_POSTACTION is currently ignored
+ in wrapper functions since there is no reasonable default
+ action to take on failure.
+*/
+
+
+# ifdef USE_MALLOC_LOCK
+
+# ifdef WIN32
+
+static int mALLOC_MUTEx;
+# define MALLOC_PREACTION slwait(&mALLOC_MUTEx)
+# define MALLOC_POSTACTION slrelease(&mALLOC_MUTEx)
+
+# else
+
+# include <pthread.h>
+
+static pthread_mutex_t mALLOC_MUTEx = PTHREAD_MUTEX_INITIALIZER;
+
+# define MALLOC_PREACTION pthread_mutex_lock(&mALLOC_MUTEx)
+# define MALLOC_POSTACTION pthread_mutex_unlock(&mALLOC_MUTEx)
+
+# endif /* USE_MALLOC_LOCK */
+
+# else
+
+/* Substitute anything you like for these */
+
+# define MALLOC_PREACTION (0)
+# define MALLOC_POSTACTION (0)
+
+# endif
+
+Void_t* public_mALLOc(size_t bytes) {
+ Void_t* m;
+ if (MALLOC_PREACTION != 0) {
+ return 0;
+ }
+ m = mALLOc(bytes);
+ if (MALLOC_POSTACTION != 0) {
+ }
+ return m;
+}
+
+void public_fREe(Void_t* m) {
+ if (MALLOC_PREACTION != 0) {
+ return;
+ }
+ fREe(m);
+ if (MALLOC_POSTACTION != 0) {
+ }
+}
+
+Void_t* public_rEALLOc(Void_t* m, size_t bytes) {
+ if (MALLOC_PREACTION != 0) {
+ return 0;
+ }
+ m = rEALLOc(m, bytes);
+ if (MALLOC_POSTACTION != 0) {
+ }
+ return m;
+}
+
+Void_t* public_mEMALIGn(size_t alignment, size_t bytes) {
+ Void_t* m;
+ if (MALLOC_PREACTION != 0) {
+ return 0;
+ }
+ m = mEMALIGn(alignment, bytes);
+ if (MALLOC_POSTACTION != 0) {
+ }
+ return m;
+}
+
+Void_t* public_vALLOc(size_t bytes) {
+ Void_t* m;
+ if (MALLOC_PREACTION != 0) {
+ return 0;
+ }
+ m = vALLOc(bytes);
+ if (MALLOC_POSTACTION != 0) {
+ }
+ return m;
+}
+
+Void_t* public_pVALLOc(size_t bytes) {
+ Void_t* m;
+ if (MALLOC_PREACTION != 0) {
+ return 0;
+ }
+ m = pVALLOc(bytes);
+ if (MALLOC_POSTACTION != 0) {
+ }
+ return m;
+}
+
+Void_t* public_cALLOc(size_t n, size_t elem_size) {
+ Void_t* m;
+ if (MALLOC_PREACTION != 0) {
+ return 0;
+ }
+ m = cALLOc(n, elem_size);
+ if (MALLOC_POSTACTION != 0) {
+ }
+ return m;
+}
+
+
+Void_t** public_iCALLOc(size_t n, size_t elem_size, Void_t** chunks) {
+ Void_t** m;
+ if (MALLOC_PREACTION != 0) {
+ return 0;
+ }
+ m = iCALLOc(n, elem_size, chunks);
+ if (MALLOC_POSTACTION != 0) {
+ }
+ return m;
+}
+
+Void_t** public_iCOMALLOc(size_t n, size_t sizes[], Void_t** chunks) {
+ Void_t** m;
+ if (MALLOC_PREACTION != 0) {
+ return 0;
+ }
+ m = iCOMALLOc(n, sizes, chunks);
+ if (MALLOC_POSTACTION != 0) {
+ }
+ return m;
+}
+
+void public_cFREe(Void_t* m) {
+ if (MALLOC_PREACTION != 0) {
+ return;
+ }
+ cFREe(m);
+ if (MALLOC_POSTACTION != 0) {
+ }
+}
+
+int public_mTRIm(size_t s) {
+ int result;
+ if (MALLOC_PREACTION != 0) {
+ return 0;
+ }
+ result = mTRIm(s);
+ if (MALLOC_POSTACTION != 0) {
+ }
+ return result;
+}
+
+size_t public_mUSABLe(Void_t* m) {
+ size_t result;
+ if (MALLOC_PREACTION != 0) {
+ return 0;
+ }
+ result = mUSABLe(m);
+ if (MALLOC_POSTACTION != 0) {
+ }
+ return result;
+}
+
+void public_mSTATs() {
+ if (MALLOC_PREACTION != 0) {
+ return;
+ }
+ mSTATs();
+ if (MALLOC_POSTACTION != 0) {
+ }
+}
+
+struct mallinfo public_mALLINFo() {
+ struct mallinfo m;
+ if (MALLOC_PREACTION != 0) {
+ struct mallinfo nm = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 };
+ return nm;
+ }
+ m = mALLINFo();
+ if (MALLOC_POSTACTION != 0) {
+ }
+ return m;
+}
+
+int public_mALLOPt(int p, int v) {
+ int result;
+ if (MALLOC_PREACTION != 0) {
+ return 0;
+ }
+ result = mALLOPt(p, v);
+ if (MALLOC_POSTACTION != 0) {
+ }
+ return result;
+}
+
+#endif
+
+
+
+/* ------------- Optional versions of memcopy ---------------- */
+
+
+#if USE_MEMCPY
+
+/*
+ Note: memcpy is ONLY invoked with non-overlapping regions,
+ so the (usually slower) memmove is not needed.
+*/
+
+# define MALLOC_COPY(dest, src, nbytes) memcpy((dest), (src), (nbytes))
+# define MALLOC_ZERO(dest, nbytes) memset((dest), 0, (nbytes))
+
+#else /* !USE_MEMCPY */
+
+/* Use Duff's device for good zeroing/copying performance. */
+
+# define MALLOC_ZERO(charp, nbytes) \
+do { \
+ INTERNAL_SIZE_T* mzp = (INTERNAL_SIZE_T*)(charp); \
+ CHUNK_SIZE_T mctmp = (nbytes)/sizeof (INTERNAL_SIZE_T); \
+ long mcn; \
+ if (mctmp < 8) mcn = 0; else { mcn = (mctmp-1)/8; mctmp %= 8; } \
+ switch (mctmp) { \
+ case 0: for (;;) { *mzp++ = 0; \
+ case 7: *mzp++ = 0; \
+ case 6: *mzp++ = 0; \
+ case 5: *mzp++ = 0; \
+ case 4: *mzp++ = 0; \
+ case 3: *mzp++ = 0; \
+ case 2: *mzp++ = 0; \
+ case 1: *mzp++ = 0; if (mcn <= 0) break; mcn--; } \
+ } \
+} while (0)
+
+# define MALLOC_COPY(dest,src,nbytes) \
+do { \
+ INTERNAL_SIZE_T* mcsrc = (INTERNAL_SIZE_T*) (src); \
+ INTERNAL_SIZE_T* mcdst = (INTERNAL_SIZE_T*) (dest); \
+ CHUNK_SIZE_T mctmp = (nbytes)/sizeof (INTERNAL_SIZE_T); \
+ long mcn; \
+ if (mctmp < 8) mcn = 0; else { mcn = (mctmp-1)/8; mctmp %= 8; } \
+ switch (mctmp) { \
+ case 0: for (;;) { *mcdst++ = *mcsrc++; \
+ case 7: *mcdst++ = *mcsrc++; \
+ case 6: *mcdst++ = *mcsrc++; \
+ case 5: *mcdst++ = *mcsrc++; \
+ case 4: *mcdst++ = *mcsrc++; \
+ case 3: *mcdst++ = *mcsrc++; \
+ case 2: *mcdst++ = *mcsrc++; \
+ case 1: *mcdst++ = *mcsrc++; if (mcn <= 0) break; mcn--; } \
+ } \
+} while (0)
+
+#endif
+
+/* ------------------ MMAP support ------------------ */
+
+
+#if HAVE_MMAP
+
+# ifndef LACKS_FCNTL_H
+# include <fcntl.h>
+# endif
+
+# ifndef LACKS_SYS_MMAN_H
+# include <sys/mman.h>
+# endif
+
+# if !defined(MAP_ANONYMOUS) && defined(MAP_ANON)
+# define MAP_ANONYMOUS MAP_ANON
+# endif
+
+/*
+ Nearly all versions of mmap support MAP_ANONYMOUS,
+ so the following is unlikely to be needed, but is
+ supplied just in case.
+*/
+
+# ifndef MAP_ANONYMOUS
+
+static int dev_zero_fd = -1; /* Cached file descriptor for /dev/zero. */
+
+# define MMAP(addr, size, prot, flags) ((dev_zero_fd < 0) ? \
+ (dev_zero_fd = open("/dev/zero", O_RDWR), \
+ mmap((addr), (size), (prot), (flags), dev_zero_fd, 0)) : \
+ mmap((addr), (size), (prot), (flags), dev_zero_fd, 0))
+
+# else
+
+# define MMAP(addr, size, prot, flags) \
+ (mmap((addr), (size), (prot), (flags)|MAP_ANONYMOUS, -1, 0))
+
+# endif
+
+
+#endif /* HAVE_MMAP */
+
+
+/*
+ ----------------------- Chunk representations -----------------------
+*/
+
+
+/*
+ This struct declaration is misleading (but accurate and necessary).
+ It declares a "view" into memory allowing access to necessary
+ fields at known offsets from a given base. See explanation below.
+*/
+
+struct malloc_chunk {
+
+ INTERNAL_SIZE_T prev_size; /* Size of previous chunk (if free). */
+ INTERNAL_SIZE_T size; /* Size in bytes, including overhead. */
+
+ struct malloc_chunk* fd; /* double links -- used only if free. */
+ struct malloc_chunk* bk;
+};
+
+
+typedef struct malloc_chunk* mchunkptr;
+
+/*
+ malloc_chunk details:
+
+ (The following includes lightly edited explanations by Colin Plumb.)
+
+ Chunks of memory are maintained using a `boundary tag' method as
+ described in e.g., Knuth or Standish. (See the paper by Paul
+ Wilson ftp://ftp.cs.utexas.edu/pub/garbage/allocsrv.ps for a
+ survey of such techniques.) Sizes of free chunks are stored both
+ in the front of each chunk and at the end. This makes
+ consolidating fragmented chunks into bigger chunks very fast. The
+ size fields also hold bits representing whether chunks are free or
+ in use.
+
+ An allocated chunk looks like this:
+
+
+ chunk-> +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+ | Size of previous chunk, if allocated | |
+ +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+ | Size of chunk, in bytes |P|
+ mem-> +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+ | User data starts here... .
+ . .
+ . (malloc_usable_space() bytes) .
+ . |
+nextchunk-> +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+ | Size of chunk |
+ +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+
+
+ Where "chunk" is the front of the chunk for the purpose of most of
+ the malloc code, but "mem" is the pointer that is returned to the
+ user. "Nextchunk" is the beginning of the next contiguous chunk.
+
+ Chunks always begin on even word boundaries, so the mem portion
+ (which is returned to the user) is also on an even word boundary, and
+ thus at least double-word aligned.
+
+ Free chunks are stored in circular doubly-linked lists, and look like this:
+
+ chunk-> +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+ | Size of previous chunk |
+ +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+ `head:' | Size of chunk, in bytes |P|
+ mem-> +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+ | Forward pointer to next chunk in list |
+ +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+ | Back pointer to previous chunk in list |
+ +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+ | Unused space (may be 0 bytes long) .
+ . .
+ . |
+nextchunk-> +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+ `foot:' | Size of chunk, in bytes |
+ +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
+
+ The P (PREV_INUSE) bit, stored in the unused low-order bit of the
+ chunk size (which is always a multiple of two words), is an in-use
+ bit for the *previous* chunk. If that bit is *clear*, then the
+ word before the current chunk size contains the previous chunk
+ size, and can be used to find the front of the previous chunk.
+ The very first chunk allocated always has this bit set,
+ preventing access to non-existent (or non-owned) memory. If
+ prev_inuse is set for any given chunk, then you CANNOT determine
+ the size of the previous chunk, and might even get a memory
+ addressing fault when trying to do so.
+
+ Note that the `foot' of the current chunk is actually represented
+ as the prev_size of the NEXT chunk. This makes it easier to
+ deal with alignments etc but can be very confusing when trying
+ to extend or adapt this code.
+
+ The two exceptions to all this are
+
+ 1. The special chunk `top' doesn't bother using the
+ trailing size field since there is no next contiguous chunk
+ that would have to index off it. After initialization, `top'
+ is forced to always exist. If it would become less than
+ MINSIZE bytes long, it is replenished.
+
+ 2. Chunks allocated via mmap, which have the second-lowest-order
+ bit (IS_MMAPPED) set in their size fields. Because they are
+ allocated one-by-one, each must contain its own trailing size field.
+
+*/
+
+/*
+ ---------- Size and alignment checks and conversions ----------
+*/
+
+/* conversion from malloc headers to user pointers, and back */
+
+#define chunk2mem(p) ((Void_t*)((char*)(p) + 2*SIZE_SZ))
+#define mem2chunk(mem) ((mchunkptr)((char*)(mem) - 2*SIZE_SZ))
+
+/* The smallest possible chunk */
+#define MIN_CHUNK_SIZE (sizeof (struct malloc_chunk))
+
+/* The smallest size we can malloc is an aligned minimal chunk */
+
+#define MINSIZE \
+ (CHUNK_SIZE_T)(((MIN_CHUNK_SIZE+MALLOC_ALIGN_MASK) & ~MALLOC_ALIGN_MASK))
+
+/* Check if m has acceptable alignment */
+
+#define aligned_OK(m) (((PTR_UINT)((m)) & (MALLOC_ALIGN_MASK)) == 0)
+
+
+/*
+ Check if a request is so large that it would wrap around zero when
+ padded and aligned. To simplify some other code, the bound is made
+ low enough so that adding MINSIZE will also not wrap around sero.
+*/
+
+#define REQUEST_OUT_OF_RANGE(req) \
+ ((CHUNK_SIZE_T)(req) >= \
+ (CHUNK_SIZE_T)(INTERNAL_SIZE_T)(-2 * MINSIZE))
+
+/* pad request bytes into a usable size -- internal version */
+
+#define request2size(req) \
+ (((req) + SIZE_SZ + MALLOC_ALIGN_MASK < MINSIZE) ? \
+ MINSIZE : \
+ ((req) + SIZE_SZ + MALLOC_ALIGN_MASK) & ~MALLOC_ALIGN_MASK)
+
+/* Same, except also perform argument check */
+
+#define checked_request2size(req, sz) \
+ if (REQUEST_OUT_OF_RANGE(req)) { \
+ MALLOC_FAILURE_ACTION; \
+ return 0; \
+ } \
+ (sz) = request2size(req);
+
+/*
+ --------------- Physical chunk operations ---------------
+*/
+
+
+/* size field is or'ed with PREV_INUSE when previous adjacent chunk in use */
+#define PREV_INUSE 0x1
+
+/* extract inuse bit of previous chunk */
+#define prev_inuse(p) ((p)->size & PREV_INUSE)
+
+
+/* size field is or'ed with IS_MMAPPED if the chunk was obtained with mmap() */
+#define IS_MMAPPED 0x2
+
+/* check for mmap()'ed chunk */
+#define chunk_is_mmapped(p) ((p)->size & IS_MMAPPED)
+
+/*
+ Bits to mask off when extracting size
+
+ Note: IS_MMAPPED is intentionally not masked off from size field in
+ macros for which mmapped chunks should never be seen. This should
+ cause helpful core dumps to occur if it is tried by accident by
+ people extending or adapting this malloc.
+*/
+#define SIZE_BITS (PREV_INUSE|IS_MMAPPED)
+
+/* Get size, ignoring use bits */
+#define chunksize(p) ((p)->size & ~(SIZE_BITS))
+
+
+/* Ptr to next physical malloc_chunk. */
+#define next_chunk(p) ((mchunkptr)(((char*)(p)) + ((p)->size & ~PREV_INUSE)))
+
+/* Ptr to previous physical malloc_chunk */
+#define prev_chunk(p) ((mchunkptr)(((char*)(p)) - ((p)->prev_size)))
+
+/* Treat space at ptr + offset as a chunk */
+#define chunk_at_offset(p, s) ((mchunkptr)(((char*)(p)) + (s)))
+
+/* extract p's inuse bit */
+#define inuse(p)\
+((((mchunkptr)(((char*)(p))+((p)->size & ~PREV_INUSE)))->size) & PREV_INUSE)
+
+/* set/clear chunk as being inuse without otherwise disturbing */
+#define set_inuse(p)\
+((mchunkptr)(((char*)(p)) + ((p)->size & ~PREV_INUSE)))->size |= PREV_INUSE
+
+#define clear_inuse(p)\
+((mchunkptr)(((char*)(p)) + ((p)->size & ~PREV_INUSE)))->size &= ~(PREV_INUSE)
+
+
+/* check/set/clear inuse bits in known places */
+#define inuse_bit_at_offset(p, s)\
+ (((mchunkptr)(((char*)(p)) + (s)))->size & PREV_INUSE)
+
+#define set_inuse_bit_at_offset(p, s)\
+ (((mchunkptr)(((char*)(p)) + (s)))->size |= PREV_INUSE)
+
+#define clear_inuse_bit_at_offset(p, s)\
+ (((mchunkptr)(((char*)(p)) + (s)))->size &= ~(PREV_INUSE))
+
+
+/* Set size at head, without disturbing its use bit */
+#define set_head_size(p, s) ((p)->size = (((p)->size & PREV_INUSE) | (s)))
+
+/* Set size/use field */
+#define set_head(p, s) ((p)->size = (s))
+
+/* Set size at footer (only when chunk is not in use) */
+#define set_foot(p, s) (((mchunkptr)((char*)(p) + (s)))->prev_size = (s))
+
+
+/*
+ -------------------- Internal data structures --------------------
+
+ All internal state is held in an instance of malloc_state defined
+ below. There are no other static variables, except in two optional
+ cases:
+ * If USE_MALLOC_LOCK is defined, the mALLOC_MUTEx declared above.
+ * If HAVE_MMAP is true, but mmap doesn't support
+ MAP_ANONYMOUS, a dummy file descriptor for mmap.
+
+ Beware of lots of tricks that minimize the total bookkeeping space
+ requirements. The result is a little over 1K bytes (for 4byte
+ pointers and size_t.)
+*/
+
+/*
+ Bins
+
+ An array of bin headers for free chunks. Each bin is doubly
+ linked. The bins are approximately proportionally (log) spaced.
+ There are a lot of these bins (128). This may look excessive, but
+ works very well in practice. Most bins hold sizes that are
+ unusual as malloc request sizes, but are more usual for fragments
+ and consolidated sets of chunks, which is what these bins hold, so
+ they can be found quickly. All procedures maintain the invariant
+ that no consolidated chunk physically borders another one, so each
+ chunk in a list is known to be preceded and followed by either
+ inuse chunks or the ends of memory.
+
+ Chunks in bins are kept in size order, with ties going to the
+ approximately least recently used chunk. Ordering isn't needed
+ for the small bins, which all contain the same-sized chunks, but
+ facilitates best-fit allocation for larger chunks. These lists
+ are just sequential. Keeping them in order almost never requires
+ enough traversal to warrant using fancier ordered data
+ structures.
+
+ Chunks of the same size are linked with the most
+ recently freed at the front, and allocations are taken from the
+ back. This results in LRU (FIFO) allocation order, which tends
+ to give each chunk an equal opportunity to be consolidated with
+ adjacent freed chunks, resulting in larger free chunks and less
+ fragmentation.
+
+ To simplify use in double-linked lists, each bin header acts
+ as a malloc_chunk. This avoids special-casing for headers.
+ But to conserve space and improve locality, we allocate
+ only the fd/bk pointers of bins, and then use repositioning tricks
+ to treat these as the fields of a malloc_chunk*.
+*/
+
+typedef struct malloc_chunk* mbinptr;
+
+/* addressing -- note that bin_at(0) does not exist */
+#define bin_at(m, i) ((mbinptr)((char*)&((m)->bins[(i)<<1]) - (SIZE_SZ<<1)))
+
+/* analog of ++bin */
+#define next_bin(b) ((mbinptr)((char*)(b) + (sizeof (mchunkptr)<<1)))
+
+/* Reminders about list directionality within bins */
+#define first(b) ((b)->fd)
+#define last(b) ((b)->bk)
+
+/* Take a chunk off a bin list */
+#define unlink(P, BK, FD) { \
+ (FD) = (P)->fd; \
+ (BK) = (P)->bk; \
+ (FD)->bk = (BK); \
+ (BK)->fd = (FD); \
+}
+
+/*
+ Indexing
+
+ Bins for sizes < 512 bytes contain chunks of all the same size, spaced
+ 8 bytes apart. Larger bins are approximately logarithmically spaced:
+
+ 64 bins of size 8
+ 32 bins of size 64
+ 16 bins of size 512
+ 8 bins of size 4096
+ 4 bins of size 32768
+ 2 bins of size 262144
+ 1 bin of size what's left
+
+ The bins top out around 1MB because we expect to service large
+ requests via mmap.
+*/
+
+#define NBINS 96
+#define NSMALLBINS 32
+#define SMALLBIN_WIDTH 8
+#define MIN_LARGE_SIZE 256
+
+#define in_smallbin_range(sz) \
+ ((CHUNK_SIZE_T)(sz) < (CHUNK_SIZE_T)MIN_LARGE_SIZE)
+
+#define smallbin_index(sz) (((unsigned)(sz)) >> 3)
+
+/*
+ Compute index for size. We expect this to be inlined when
+ compiled with optimization, else not, which works out well.
+*/
+static int largebin_index(unsigned int sz) {
+ unsigned int x = sz >> SMALLBIN_WIDTH;
+ unsigned int m; /* bit position of highest set bit of m */
+
+ if (x >= 0x10000) return NBINS-1;
+
+ /* On intel, use BSRL instruction to find highest bit */
+#if defined(__GNUC__) && defined(i386)
+
+ __asm__("bsrl %1,%0\n\t"
+ : "=r" (m)
+ : "g" (x));
+
+#else
+ {
+ /*
+ Based on branch-free nlz algorithm in chapter 5 of Henry
+ S. Warren Jr's book "Hacker's Delight".
+ */
+
+ unsigned int n = ((x - 0x100) >> 16) & 8;
+ x <<= n;
+ m = ((x - 0x1000) >> 16) & 4;
+ n += m;
+ x <<= m;
+ m = ((x - 0x4000) >> 16) & 2;
+ n += m;
+ x = (x << m) >> 14;
+ m = 13 - n + (x & ~(x>>1));
+ }
+#endif
+
+ /* Use next 2 bits to create finer-granularity bins */
+ return NSMALLBINS + (m << 2) + ((sz >> (m + 6)) & 3);
+}
+
+#define bin_index(sz) \
+ ((in_smallbin_range(sz)) ? smallbin_index(sz) : largebin_index(sz))
+
+/*
+ FIRST_SORTED_BIN_SIZE is the chunk size corresponding to the
+ first bin that is maintained in sorted order. This must
+ be the smallest size corresponding to a given bin.
+
+ Normally, this should be MIN_LARGE_SIZE. But you can weaken
+ best fit guarantees to sometimes speed up malloc by increasing value.
+ Doing this means that malloc may choose a chunk that is
+ non-best-fitting by up to the width of the bin.
+
+ Some useful cutoff values:
+ 512 - all bins sorted
+ 2560 - leaves bins <= 64 bytes wide unsorted
+ 12288 - leaves bins <= 512 bytes wide unsorted
+ 65536 - leaves bins <= 4096 bytes wide unsorted
+ 262144 - leaves bins <= 32768 bytes wide unsorted
+ -1 - no bins sorted (not recommended!)
+*/
+
+#define FIRST_SORTED_BIN_SIZE MIN_LARGE_SIZE
+/* #define FIRST_SORTED_BIN_SIZE 65536 */
+
+/*
+ Unsorted chunks
+
+ All remainders from chunk splits, as well as all returned chunks,
+ are first placed in the "unsorted" bin. They are then placed
+ in regular bins after malloc gives them ONE chance to be used before
+ binning. So, basically, the unsorted_chunks list acts as a queue,
+ with chunks being placed on it in free (and malloc_consolidate),
+ and taken off (to be either used or placed in bins) in malloc.
+*/
+
+/* The otherwise unindexable 1-bin is used to hold unsorted chunks. */
+#define unsorted_chunks(M) (bin_at((M), 1))
+
+/*
+ Top
+
+ The top-most available chunk (i.e., the one bordering the end of
+ available memory) is treated specially. It is never included in
+ any bin, is used only if no other chunk is available, and is
+ released back to the system if it is very large (see
+ M_TRIM_THRESHOLD). Because top initially
+ points to its own bin with initial zero size, thus forcing
+ extension on the first malloc request, we avoid having any special
+ code in malloc to check whether it even exists yet. But we still
+ need to do so when getting memory from system, so we make
+ initial_top treat the bin as a legal but unusable chunk during the
+ interval between initialization and the first call to
+ sYSMALLOc. (This is somewhat delicate, since it relies on
+ the 2 preceding words to be zero during this interval as well.)
+*/
+
+/* Conveniently, the unsorted bin can be used as dummy top on first call */
+#define initial_top(M) (unsorted_chunks(M))
+
+/*
+ Binmap
+
+ To help compensate for the large number of bins, a one-level index
+ structure is used for bin-by-bin searching. `binmap' is a
+ bitvector recording whether bins are definitely empty so they can
+ be skipped over during during traversals. The bits are NOT always
+ cleared as soon as bins are empty, but instead only
+ when they are noticed to be empty during traversal in malloc.
+*/
+
+/* Conservatively use 32 bits per map word, even if on 64bit system */
+#define BINMAPSHIFT 5
+#define BITSPERMAP (1U << BINMAPSHIFT)
+#define BINMAPSIZE (NBINS / BITSPERMAP)
+
+#define idx2block(i) ((i) >> BINMAPSHIFT)
+#define idx2bit(i) ((1U << ((i) & ((1U << BINMAPSHIFT)-1))))
+
+#define mark_bin(m,i) ((m)->binmap[idx2block(i)] |= idx2bit(i))
+#define unmark_bin(m,i) ((m)->binmap[idx2block(i)] &= ~(idx2bit(i)))
+#define get_binmap(m,i) ((m)->binmap[idx2block(i)] & idx2bit(i))
+
+/*
+ Fastbins
+
+ An array of lists holding recently freed small chunks. Fastbins
+ are not doubly linked. It is faster to single-link them, and
+ since chunks are never removed from the middles of these lists,
+ double linking is not necessary. Also, unlike regular bins, they
+ are not even processed in FIFO order (they use faster LIFO) since
+ ordering doesn't much matter in the transient contexts in which
+ fastbins are normally used.
+
+ Chunks in fastbins keep their inuse bit set, so they cannot
+ be consolidated with other free chunks. malloc_consolidate
+ releases all chunks in fastbins and consolidates them with
+ other free chunks.
+*/
+
+typedef struct malloc_chunk* mfastbinptr;
+
+/* offset 2 to use otherwise unindexable first 2 bins */
+#define fastbin_index(sz) ((((unsigned int)(sz)) >> 3) - 2)
+
+/* The maximum fastbin request size we support */
+#define MAX_FAST_SIZE 80
+
+#define NFASTBINS (fastbin_index(request2size(MAX_FAST_SIZE))+1)
+
+/*
+ FASTBIN_CONSOLIDATION_THRESHOLD is the size of a chunk in free()
+ that triggers automatic consolidation of possibly-surrounding
+ fastbin chunks. This is a heuristic, so the exact value should not
+ matter too much. It is defined at half the default trim threshold as a
+ compromise heuristic to only attempt consolidation if it is likely
+ to lead to trimming. However, it is not dynamically tunable, since
+ consolidation reduces fragmentation surrounding loarge chunks even
+ if trimming is not used.
+*/
+
+#define FASTBIN_CONSOLIDATION_THRESHOLD \
+ ((unsigned long)(DEFAULT_TRIM_THRESHOLD) >> 1)
+
+/*
+ Since the lowest 2 bits in max_fast don't matter in size comparisons,
+ they are used as flags.
+*/
+
+/*
+ ANYCHUNKS_BIT held in max_fast indicates that there may be any
+ freed chunks at all. It is set true when entering a chunk into any
+ bin.
+*/
+
+#define ANYCHUNKS_BIT (1U)
+
+#define have_anychunks(M) (((M)->max_fast & ANYCHUNKS_BIT))
+#define set_anychunks(M) ((M)->max_fast |= ANYCHUNKS_BIT)
+#define clear_anychunks(M) ((M)->max_fast &= ~ANYCHUNKS_BIT)
+
+/*
+ FASTCHUNKS_BIT held in max_fast indicates that there are probably
+ some fastbin chunks. It is set true on entering a chunk into any
+ fastbin, and cleared only in malloc_consolidate.
+*/
+
+#define FASTCHUNKS_BIT (2U)
+
+#define have_fastchunks(M) (((M)->max_fast & FASTCHUNKS_BIT))
+#define set_fastchunks(M) ((M)->max_fast |= (FASTCHUNKS_BIT|ANYCHUNKS_BIT))
+#define clear_fastchunks(M) ((M)->max_fast &= ~(FASTCHUNKS_BIT))
+
+/*
+ Set value of max_fast.
+ Use impossibly small value if 0.
+*/
+
+#define set_max_fast(M, s) \
+ (M)->max_fast = (((s) == 0)? SMALLBIN_WIDTH: request2size(s)) | \
+ ((M)->max_fast & (FASTCHUNKS_BIT|ANYCHUNKS_BIT))
+
+#define get_max_fast(M) \
+ ((M)->max_fast & ~(FASTCHUNKS_BIT | ANYCHUNKS_BIT))
+
+
+/*
+ morecore_properties is a status word holding dynamically discovered
+ or controlled properties of the morecore function
+*/
+
+#define MORECORE_CONTIGUOUS_BIT (1U)
+
+#define contiguous(M) \
+ (((M)->morecore_properties & MORECORE_CONTIGUOUS_BIT))
+#define noncontiguous(M) \
+ (((M)->morecore_properties & MORECORE_CONTIGUOUS_BIT) == 0)
+#define set_contiguous(M) \
+ ((M)->morecore_properties |= MORECORE_CONTIGUOUS_BIT)
+#define set_noncontiguous(M) \
+ ((M)->morecore_properties &= ~MORECORE_CONTIGUOUS_BIT)
+
+
+/*
+ ----------- Internal state representation and initialization -----------
+*/
+
+struct malloc_state {
+
+ /* The maximum chunk size to be eligible for fastbin */
+ INTERNAL_SIZE_T max_fast; /* low 2 bits used as flags */
+
+ /* Fastbins */
+ mfastbinptr fastbins[NFASTBINS];
+
+ /* Base of the topmost chunk -- not otherwise kept in a bin */
+ mchunkptr top;
+
+ /* The remainder from the most recent split of a small request */
+ mchunkptr last_remainder;
+
+ /* Normal bins packed as described above */
+ mchunkptr bins[NBINS * 2];
+
+ /* Bitmap of bins. Trailing zero map handles cases of largest binned size */
+ unsigned int binmap[BINMAPSIZE+1];
+
+ /* Tunable parameters */
+ CHUNK_SIZE_T trim_threshold;
+ INTERNAL_SIZE_T top_pad;
+ INTERNAL_SIZE_T mmap_threshold;
+
+ /* Memory map support */
+ int n_mmaps;
+ int n_mmaps_max;
+ int max_n_mmaps;
+
+ /* Cache malloc_getpagesize */
+ unsigned int pagesize;
+
+ /* Track properties of MORECORE */
+ unsigned int morecore_properties;
+
+ /* Statistics */
+ INTERNAL_SIZE_T mmapped_mem;
+ INTERNAL_SIZE_T sbrked_mem;
+ INTERNAL_SIZE_T max_sbrked_mem;
+ INTERNAL_SIZE_T max_mmapped_mem;
+ INTERNAL_SIZE_T max_total_mem;
+};
+
+typedef struct malloc_state *mstate;
+
+/*
+ There is exactly one instance of this struct in this malloc.
+ If you are adapting this malloc in a way that does NOT use a static
+ malloc_state, you MUST explicitly zero-fill it before using. This
+ malloc relies on the property that malloc_state is initialized to
+ all zeroes (as is true of C statics).
+*/
+
+static struct malloc_state av_; /* never directly referenced */
+
+/*
+ All uses of av_ are via get_malloc_state().
+ At most one "call" to get_malloc_state is made per invocation of
+ the public versions of malloc and free, but other routines
+ that in turn invoke malloc and/or free may call more then once.
+ Also, it is called in check* routines if DEBUG is set.
+*/
+
+#define get_malloc_state() (&(av_))
+
+/*
+ Initialize a malloc_state struct.
+
+ This is called only from within malloc_consolidate, which needs
+ be called in the same contexts anyway. It is never called directly
+ outside of malloc_consolidate because some optimizing compilers try
+ to inline it at all call points, which turns out not to be an
+ optimization at all. (Inlining it in malloc_consolidate is fine though.)
+*/
+
+#if __STD_C
+static void malloc_init_state(mstate av)
+#else
+static void malloc_init_state(av) mstate av;
+#endif
+{
+ int i;
+ mbinptr bin;
+
+ /* Establish circular links for normal bins */
+ for (i = 1; i < NBINS; ++i) {
+ bin = bin_at(av,i);
+ bin->fd = bin->bk = bin;
+ }
+
+ av->top_pad = DEFAULT_TOP_PAD;
+ av->n_mmaps_max = DEFAULT_MMAP_MAX;
+ av->mmap_threshold = DEFAULT_MMAP_THRESHOLD;
+ av->trim_threshold = DEFAULT_TRIM_THRESHOLD;
+
+#if MORECORE_CONTIGUOUS
+ set_contiguous(av);
+#else
+ set_noncontiguous(av);
+#endif
+
+
+ set_max_fast(av, DEFAULT_MXFAST);
+
+ av->top = initial_top(av);
+ av->pagesize = malloc_getpagesize;
+}
+
+/*
+ Other internal utilities operating on mstates
+*/
+
+#if __STD_C
+static Void_t* sYSMALLOc(INTERNAL_SIZE_T, mstate);
+static int sYSTRIm(size_t, mstate);
+static void malloc_consolidate(mstate);
+static Void_t** iALLOc(size_t, size_t*, int, Void_t**);
+#else
+static Void_t* sYSMALLOc();
+static int sYSTRIm();
+static void malloc_consolidate();
+static Void_t** iALLOc();
+#endif
+
+/*
+ Debugging support
+
+ These routines make a number of assertions about the states
+ of data structures that should be true at all times. If any
+ are not true, it's very likely that a user program has somehow
+ trashed memory. (It's also possible that there is a coding error
+ in malloc. In which case, please report it!)
+*/
+
+#if ! DEBUG
+
+# define check_chunk(P)
+# define check_free_chunk(P)
+# define check_inuse_chunk(P)
+# define check_remalloced_chunk(P,N)
+# define check_malloced_chunk(P,N)
+# define check_malloc_state()
+
+#else
+# define check_chunk(P) do_check_chunk((P))
+# define check_free_chunk(P) do_check_free_chunk((P))
+# define check_inuse_chunk(P) do_check_inuse_chunk((P))
+# define check_remalloced_chunk(P,N) do_check_remalloced_chunk((P),(N))
+# define check_malloced_chunk(P,N) do_check_malloced_chunk((P),(N))
+# define check_malloc_state() do_check_malloc_state()
+
+/*
+ Properties of all chunks
+*/
+
+# if __STD_C
+static void do_check_chunk(mchunkptr p)
+# else
+static void do_check_chunk(p) mchunkptr p;
+# endif
+{
+ mstate av = get_malloc_state();
+ CHUNK_SIZE_T sz = chunksize(p);
+ /* min and max possible addresses assuming contiguous allocation */
+ char* max_address = (char*)(av->top) + chunksize(av->top);
+ char* min_address = max_address - av->sbrked_mem;
+
+ if (!chunk_is_mmapped(p)) {
+
+ /* Has legal address ... */
+ if (p != av->top) {
+ if (contiguous(av)) {
+ assert(((char*)p) >= min_address);
+ assert(((char*)p + sz) <= ((char*)(av->top)));
+ }
+ }
+ else {
+ /* top size is always at least MINSIZE */
+ assert((CHUNK_SIZE_T)(sz) >= MINSIZE);
+ /* top predecessor always marked inuse */
+ assert(prev_inuse(p));
+ }
+
+ }
+ else {
+# if HAVE_MMAP
+ /* address is outside main heap */
+ if (contiguous(av) && av->top != initial_top(av)) {
+ assert(((char*)p) < min_address || ((char*)p) > max_address);
+ }
+ /* chunk is page-aligned */
+ assert(((p->prev_size + sz) & (av->pagesize-1)) == 0);
+ /* mem is aligned */
+ assert(aligned_OK(chunk2mem(p)));
+# else
+ /* force an appropriate assert violation if debug set */
+ assert(!chunk_is_mmapped(p));
+# endif
+ }
+}
+
+/*
+ Properties of free chunks
+*/
+
+# if __STD_C
+static void do_check_free_chunk(mchunkptr p)
+# else
+static void do_check_free_chunk(p) mchunkptr p;
+# endif
+{
+ mstate av = get_malloc_state();
+
+ INTERNAL_SIZE_T sz = p->size & ~PREV_INUSE;
+ mchunkptr next = chunk_at_offset(p, sz);
+
+ do_check_chunk(p);
+
+ /* Chunk must claim to be free ... */
+ assert(!inuse(p));
+ assert (!chunk_is_mmapped(p));
+
+ /* Unless a special marker, must have OK fields */
+ if ((CHUNK_SIZE_T)(sz) >= MINSIZE)
+ {
+ assert((sz & MALLOC_ALIGN_MASK) == 0);
+ assert(aligned_OK(chunk2mem(p)));
+ /* ... matching footer field */
+ assert(next->prev_size == sz);
+ /* ... and is fully consolidated */
+ assert(prev_inuse(p));
+ assert (next == av->top || inuse(next));
+
+ /* ... and has minimally sane links */
+ assert(p->fd->bk == p);
+ assert(p->bk->fd == p);
+ }
+ else /* markers are always of size SIZE_SZ */
+ assert(sz == SIZE_SZ);
+}
+
+/*
+ Properties of inuse chunks
+*/
+
+# if __STD_C
+static void do_check_inuse_chunk(mchunkptr p)
+# else
+static void do_check_inuse_chunk(p) mchunkptr p;
+# endif
+{
+ mstate av = get_malloc_state();
+ mchunkptr next;
+ do_check_chunk(p);
+
+ if (chunk_is_mmapped(p))
+ return; /* mmapped chunks have no next/prev */
+
+ /* Check whether it claims to be in use ... */
+ assert(inuse(p));
+
+ next = next_chunk(p);
+
+ /* ... and is surrounded by OK chunks.
+ Since more things can be checked with free chunks than inuse ones,
+ if an inuse chunk borders them and debug is on, it's worth doing them.
+ */
+ if (!prev_inuse(p)) {
+ /* Note that we cannot even look at prev unless it is not inuse */
+ mchunkptr prv = prev_chunk(p);
+ assert(next_chunk(prv) == p);
+ do_check_free_chunk(prv);
+ }
+
+ if (next == av->top) {
+ assert(prev_inuse(next));
+ assert(chunksize(next) >= MINSIZE);
+ }
+ else if (!inuse(next))
+ do_check_free_chunk(next);
+}
+
+/*
+ Properties of chunks recycled from fastbins
+*/
+
+# if __STD_C
+static void do_check_remalloced_chunk(mchunkptr p, INTERNAL_SIZE_T s)
+# else
+static void do_check_remalloced_chunk(p, s) mchunkptr p; INTERNAL_SIZE_T s;
+# endif
+{
+ INTERNAL_SIZE_T sz = p->size & ~PREV_INUSE;
+
+ do_check_inuse_chunk(p);
+
+ /* Legal size ... */
+ assert((sz & MALLOC_ALIGN_MASK) == 0);
+ assert((CHUNK_SIZE_T)(sz) >= MINSIZE);
+ /* ... and alignment */
+ assert(aligned_OK(chunk2mem(p)));
+ /* chunk is less than MINSIZE more than request */
+ assert((long)(sz) - (long)(s) >= 0);
+ assert((long)(sz) - (long)(s + MINSIZE) < 0);
+}
+
+/*
+ Properties of nonrecycled chunks at the point they are malloced
+*/
+
+# if __STD_C
+static void do_check_malloced_chunk(mchunkptr p, INTERNAL_SIZE_T s)
+# else
+static void do_check_malloced_chunk(p, s) mchunkptr p; INTERNAL_SIZE_T s;
+# endif
+{
+ /* same as recycled case ... */
+ do_check_remalloced_chunk(p, s);
+
+ /*
+ ... plus, must obey implementation invariant that prev_inuse is
+ always true of any allocated chunk; i.e., that each allocated
+ chunk borders either a previously allocated and still in-use
+ chunk, or the base of its memory arena. This is ensured
+ by making all allocations from the the `lowest' part of any found
+ chunk. This does not necessarily hold however for chunks
+ recycled via fastbins.
+ */
+
+ assert(prev_inuse(p));
+}
+
+
+/*
+ Properties of malloc_state.
+
+ This may be useful for debugging malloc, as well as detecting user
+ programmer errors that somehow write into malloc_state.
+
+ If you are extending or experimenting with this malloc, you can
+ probably figure out how to hack this routine to print out or
+ display chunk addresses, sizes, bins, and other instrumentation.
+*/
+
+static void do_check_malloc_state()
+{
+ mstate av = get_malloc_state();
+ int i;
+ mchunkptr p;
+ mchunkptr q;
+ mbinptr b;
+ unsigned int binbit;
+ int empty;
+ unsigned int idx;
+ INTERNAL_SIZE_T size;
+ CHUNK_SIZE_T total = 0;
+ int max_fast_bin;
+
+ /* internal size_t must be no wider than pointer type */
+ assert(sizeof (INTERNAL_SIZE_T) <= sizeof (char*));
+
+ /* alignment is a power of 2 */
+ assert((MALLOC_ALIGNMENT & (MALLOC_ALIGNMENT-1)) == 0);
+
+ /* cannot run remaining checks until fully initialized */
+ if (av->top == 0 || av->top == initial_top(av))
+ return;
+
+ /* pagesize is a power of 2 */
+ assert((av->pagesize & (av->pagesize-1)) == 0);
+
+ /* properties of fastbins */
+
+ /* max_fast is in allowed range */
+ assert(get_max_fast(av) <= request2size(MAX_FAST_SIZE));
+
+ max_fast_bin = fastbin_index(av->max_fast);
+
+ for (i = 0; i < NFASTBINS; ++i) {
+ p = av->fastbins[i];
+
+ /* all bins past max_fast are empty */
+ if (i > max_fast_bin)
+ assert(p == 0);
+
+ while (p != 0) {
+ /* each chunk claims to be inuse */
+ do_check_inuse_chunk(p);
+ total += chunksize(p);
+ /* chunk belongs in this bin */
+ assert(fastbin_index(chunksize(p)) == i);
+ p = p->fd;
+ }
+ }
+
+ if (total != 0)
+ assert(have_fastchunks(av));
+ else if (!have_fastchunks(av))
+ assert(total == 0);
+
+ /* check normal bins */
+ for (i = 1; i < NBINS; ++i) {
+ b = bin_at(av,i);
+
+ /* binmap is accurate (except for bin 1 == unsorted_chunks) */
+ if (i >= 2) {
+ binbit = get_binmap(av,i);
+ empty = last(b) == b;
+ if (!binbit)
+ assert(empty);
+ else if (!empty)
+ assert(binbit);
+ }
+
+ for (p = last(b); p != b; p = p->bk) {
+ /* each chunk claims to be free */
+ do_check_free_chunk(p);
+ size = chunksize(p);
+ total += size;
+ if (i >= 2) {
+ /* chunk belongs in bin */
+ idx = bin_index(size);
+ assert(idx == i);
+ /* lists are sorted */
+ if ((CHUNK_SIZE_T) size >= (CHUNK_SIZE_T)(FIRST_SORTED_BIN_SIZE)) {
+ assert(p->bk == b ||
+ (CHUNK_SIZE_T)chunksize(p->bk) >=
+ (CHUNK_SIZE_T)chunksize(p));
+ }
+ }
+ /* chunk is followed by a legal chain of inuse chunks */
+ for (q = next_chunk(p);
+ (q != av->top && inuse(q) &&
+ (CHUNK_SIZE_T)(chunksize(q)) >= MINSIZE);
+ q = next_chunk(q))
+ do_check_inuse_chunk(q);
+ }
+ }
+
+ /* top chunk is OK */
+ check_chunk(av->top);
+
+ /* sanity checks for statistics */
+
+ assert(total <= (CHUNK_SIZE_T)(av->max_total_mem));
+ assert(av->n_mmaps >= 0);
+ assert(av->n_mmaps <= av->max_n_mmaps);
+
+ assert((CHUNK_SIZE_T)(av->sbrked_mem) <=
+ (CHUNK_SIZE_T)(av->max_sbrked_mem));
+
+ assert((CHUNK_SIZE_T)(av->mmapped_mem) <=
+ (CHUNK_SIZE_T)(av->max_mmapped_mem));
+
+ assert((CHUNK_SIZE_T)(av->max_total_mem) >=
+ (CHUNK_SIZE_T)(av->mmapped_mem) + (CHUNK_SIZE_T)(av->sbrked_mem));
+}
+#endif
+
+
+/* ----------- Routines dealing with system allocation -------------- */
+
+/*
+ sysmalloc handles malloc cases requiring more memory from the system.
+ On entry, it is assumed that av->top does not have enough
+ space to service request for nb bytes, thus requiring that av->top
+ be extended or replaced.
+*/
+
+#if __STD_C
+static Void_t* sYSMALLOc(INTERNAL_SIZE_T nb, mstate av)
+#else
+static Void_t* sYSMALLOc(nb, av) INTERNAL_SIZE_T nb; mstate av;
+#endif
+{
+ mchunkptr old_top; /* incoming value of av->top */
+ INTERNAL_SIZE_T old_size; /* its size */
+ char* old_end; /* its end address */
+
+ long size; /* arg to first MORECORE or mmap call */
+ char* brk; /* return value from MORECORE */
+
+ long correction; /* arg to 2nd MORECORE call */
+ char* snd_brk; /* 2nd return val */
+
+ INTERNAL_SIZE_T front_misalign; /* unusable bytes at front of new space */
+ INTERNAL_SIZE_T end_misalign; /* partial page left at end of new space */
+ char* aligned_brk; /* aligned offset into brk */
+
+ mchunkptr p; /* the allocated/returned chunk */
+ mchunkptr remainder; /* remainder from allocation */
+ CHUNK_SIZE_T remainder_size; /* its size */
+
+ CHUNK_SIZE_T sum; /* for updating stats */
+
+ size_t pagemask = av->pagesize - 1;
+
+ /*
+ If there is space available in fastbins, consolidate and retry
+ malloc from scratch rather than getting memory from system. This
+ can occur only if nb is in smallbin range so we didn't consolidate
+ upon entry to malloc. It is much easier to handle this case here
+ than in malloc proper.
+ */
+
+ if (have_fastchunks(av)) {
+ assert(in_smallbin_range(nb));
+ malloc_consolidate(av);
+ return mALLOc(nb - MALLOC_ALIGN_MASK);
+ }
+
+
+#if HAVE_MMAP
+
+ /*
+ If have mmap, and the request size meets the mmap threshold, and
+ the system supports mmap, and there are few enough currently
+ allocated mmapped regions, try to directly map this request
+ rather than expanding top.
+ */
+
+ if ((CHUNK_SIZE_T)(nb) >= (CHUNK_SIZE_T)(av->mmap_threshold) &&
+ (av->n_mmaps < av->n_mmaps_max)) {
+
+ char* mm; /* return value from mmap call*/
+
+ /*
+ Round up size to nearest page. For mmapped chunks, the overhead
+ is one SIZE_SZ unit larger than for normal chunks, because there
+ is no following chunk whose prev_size field could be used.
+ */
+ size = (nb + SIZE_SZ + MALLOC_ALIGN_MASK + pagemask) & ~pagemask;
+
+ /* Don't try if size wraps around 0 */
+ if ((CHUNK_SIZE_T)(size) > (CHUNK_SIZE_T)(nb)) {
+
+ mm = (char*)(MMAP(0, size, PROT_READ|PROT_WRITE, MAP_PRIVATE));
+
+ if (mm != (char*)(MORECORE_FAILURE)) {
+
+ /*
+ The offset to the start of the mmapped region is stored
+ in the prev_size field of the chunk. This allows us to adjust
+ returned start address to meet alignment requirements here
+ and in memalign(), and still be able to compute proper
+ address argument for later munmap in free() and realloc().
+ */
+
+ front_misalign = (INTERNAL_SIZE_T)chunk2mem(mm) & MALLOC_ALIGN_MASK;
+ if (front_misalign > 0) {
+ correction = MALLOC_ALIGNMENT - front_misalign;
+ p = (mchunkptr)(mm + correction);
+ p->prev_size = correction;
+ set_head(p, (size - correction) |IS_MMAPPED);
+ }
+ else {
+ p = (mchunkptr)mm;
+ p->prev_size = 0;
+ set_head(p, size|IS_MMAPPED);
+ }
+
+ /* update statistics */
+
+ if (++av->n_mmaps > av->max_n_mmaps)
+ av->max_n_mmaps = av->n_mmaps;
+
+ sum = av->mmapped_mem += size;
+ if (sum > (CHUNK_SIZE_T)(av->max_mmapped_mem))
+ av->max_mmapped_mem = sum;
+ sum += av->sbrked_mem;
+ if (sum > (CHUNK_SIZE_T)(av->max_total_mem))
+ av->max_total_mem = sum;
+
+ check_chunk(p);
+
+ return chunk2mem(p);
+ }
+ }
+ }
+#endif
+
+ /* Record incoming configuration of top */
+
+ old_top = av->top;
+ old_size = chunksize(old_top);
+ old_end = (char*)(chunk_at_offset(old_top, old_size));
+
+ brk = snd_brk = (char*)(MORECORE_FAILURE);
+
+ /*
+ If not the first time through, we require old_size to be
+ at least MINSIZE and to have prev_inuse set.
+ */
+
+ assert((old_top == initial_top(av) && old_size == 0) ||
+ ((CHUNK_SIZE_T) (old_size) >= MINSIZE &&
+ prev_inuse(old_top)));
+
+ /* Precondition: not enough current space to satisfy nb request */
+ assert((CHUNK_SIZE_T)(old_size) < (CHUNK_SIZE_T)(nb + MINSIZE));
+
+ /* Precondition: all fastbins are consolidated */
+ assert(!have_fastchunks(av));
+
+
+ /* Request enough space for nb + pad + overhead */
+
+ size = nb + av->top_pad + MINSIZE;
+
+ /*
+ If contiguous, we can subtract out existing space that we hope to
+ combine with new space. We add it back later only if
+ we don't actually get contiguous space.
+ */
+
+ if (contiguous(av))
+ size -= old_size;
+
+ /*
+ Round to a multiple of page size.
+ If MORECORE is not contiguous, this ensures that we only call it
+ with whole-page arguments. And if MORECORE is contiguous and
+ this is not first time through, this preserves page-alignment of
+ previous calls. Otherwise, we correct to page-align below.
+ */
+
+ size = (size + pagemask) & ~pagemask;
+
+ /*
+ Don't try to call MORECORE if argument is so big as to appear
+ negative. Note that since mmap takes size_t arg, it may succeed
+ below even if we cannot call MORECORE.
+ */
+
+ if (size > 0)
+ brk = (char*)(MORECORE(size));
+
+ /*
+ If have mmap, try using it as a backup when MORECORE fails or
+ cannot be used. This is worth doing on systems that have "holes" in
+ address space, so sbrk cannot extend to give contiguous space, but
+ space is available elsewhere. Note that we ignore mmap max count
+ and threshold limits, since the space will not be used as a
+ segregated mmap region.
+ */
+
+#if HAVE_MMAP
+ if (brk == (char*)(MORECORE_FAILURE)) {
+
+ /* Cannot merge with old top, so add its size back in */
+ if (contiguous(av))
+ size = (size + old_size + pagemask) & ~pagemask;
+
+ /* If we are relying on mmap as backup, then use larger units */
+ if ((CHUNK_SIZE_T)(size) < (CHUNK_SIZE_T)(MMAP_AS_MORECORE_SIZE))
+ size = MMAP_AS_MORECORE_SIZE;
+
+ /* Don't try if size wraps around 0 */
+ if ((CHUNK_SIZE_T)(size) > (CHUNK_SIZE_T)(nb)) {
+
+ brk = (char*)(MMAP(0, size, PROT_READ|PROT_WRITE, MAP_PRIVATE));
+
+ if (brk != (char*)(MORECORE_FAILURE)) {
+
+ /* We do not need, and cannot use, another sbrk call to find end */
+ snd_brk = brk + size;
+
+ /*
+ Record that we no longer have a contiguous sbrk region.
+ After the first time mmap is used as backup, we do not
+ ever rely on contiguous space since this could incorrectly
+ bridge regions.
+ */
+ set_noncontiguous(av);
+ }
+ }
+ }
+#endif
+
+ if (brk != (char*)(MORECORE_FAILURE)) {
+ av->sbrked_mem += size;
+
+ /*
+ If MORECORE extends previous space, we can likewise extend top size.
+ */
+
+ if (brk == old_end && snd_brk == (char*)(MORECORE_FAILURE)) {
+ set_head(old_top, (size + old_size) | PREV_INUSE);
+ }
+
+ /*
+ Otherwise, make adjustments:
+
+ * If the first time through or noncontiguous, we need to call sbrk
+ just to find out where the end of memory lies.
+
+ * We need to ensure that all returned chunks from malloc will meet
+ MALLOC_ALIGNMENT
+
+ * If there was an intervening foreign sbrk, we need to adjust sbrk
+ request size to account for fact that we will not be able to
+ combine new space with existing space in old_top.
+
+ * Almost all systems internally allocate whole pages at a time, in
+ which case we might as well use the whole last page of request.
+ So we allocate enough more memory to hit a page boundary now,
+ which in turn causes future contiguous calls to page-align.
+ */
+
+ else {
+ front_misalign = 0;
+ end_misalign = 0;
+ correction = 0;
+ aligned_brk = brk;
+
+ /*
+ If MORECORE returns an address lower than we have seen before,
+ we know it isn't really contiguous. This and some subsequent
+ checks help cope with non-conforming MORECORE functions and
+ the presence of "foreign" calls to MORECORE from outside of
+ malloc or by other threads. We cannot guarantee to detect
+ these in all cases, but cope with the ones we do detect.
+ */
+ if (contiguous(av) && old_size != 0 && brk < old_end) {
+ set_noncontiguous(av);
+ }
+
+ /* handle contiguous cases */
+ if (contiguous(av)) {
+
+ /*
+ We can tolerate forward non-contiguities here (usually due
+ to foreign calls) but treat them as part of our space for
+ stats reporting.
+ */
+ if (old_size != 0)
+ av->sbrked_mem += brk - old_end;
+
+ /* Guarantee alignment of first new chunk made from this space */
+
+ front_misalign = (INTERNAL_SIZE_T)chunk2mem(brk) & MALLOC_ALIGN_MASK;
+ if (front_misalign > 0) {
+
+ /*
+ Skip over some bytes to arrive at an aligned position.
+ We don't need to specially mark these wasted front bytes.
+ They will never be accessed anyway because
+ prev_inuse of av->top (and any chunk created from its start)
+ is always true after initialization.
+ */
+
+ correction = MALLOC_ALIGNMENT - front_misalign;
+ aligned_brk += correction;
+ }
+
+ /*
+ If this isn't adjacent to existing space, then we will not
+ be able to merge with old_top space, so must add to 2nd request.
+ */
+
+ correction += old_size;
+
+ /* Extend the end address to hit a page boundary */
+ end_misalign = (INTERNAL_SIZE_T)(brk + size + correction);
+ correction += ((end_misalign + pagemask) & ~pagemask) - end_misalign;
+
+ assert(correction >= 0);
+ snd_brk = (char*)(MORECORE(correction));
+
+ if (snd_brk == (char*)(MORECORE_FAILURE)) {
+ /*
+ If can't allocate correction, try to at least find out current
+ brk. It might be enough to proceed without failing.
+ */
+ correction = 0;
+ snd_brk = (char*)(MORECORE(0));
+ }
+ else if (snd_brk < brk) {
+ /*
+ If the second call gives noncontiguous space even though
+ it says it won't, the only course of action is to ignore
+ results of second call, and conservatively estimate where
+ the first call left us. Also set noncontiguous, so this
+ won't happen again, leaving at most one hole.
+
+ Note that this check is intrinsically incomplete. Because
+ MORECORE is allowed to give more space than we ask for,
+ there is no reliable way to detect a noncontiguity
+ producing a forward gap for the second call.
+ */
+ snd_brk = brk + size;
+ correction = 0;
+ set_noncontiguous(av);
+ }
+ }
+
+ /* handle non-contiguous cases */
+ else {
+ /* MORECORE/mmap must correctly align */
+ assert(aligned_OK(chunk2mem(brk)));
+
+ /* Find out current end of memory */
+ if (snd_brk == (char*)(MORECORE_FAILURE)) {
+ snd_brk = (char*)(MORECORE(0));
+ av->sbrked_mem += snd_brk - brk - size;
+ }
+ }
+
+ /* Adjust top based on results of second sbrk */
+ if (snd_brk != (char*)(MORECORE_FAILURE)) {
+ av->top = (mchunkptr)aligned_brk;
+ set_head(av->top, (snd_brk - aligned_brk + correction) | PREV_INUSE);
+ av->sbrked_mem += correction;
+
+ /*
+ If not the first time through, we either have a
+ gap due to foreign sbrk or a non-contiguous region. Insert a
+ double fencepost at old_top to prevent consolidation with space
+ we don't own. These fenceposts are artificial chunks that are
+ marked as inuse and are in any case too small to use. We need
+ two to make sizes and alignments work out.
+ */
+
+ if (old_size != 0) {
+ /*
+ Shrink old_top to insert fenceposts, keeping size a
+ multiple of MALLOC_ALIGNMENT. We know there is at least
+ enough space in old_top to do this.
+ */
+ old_size = (old_size - 3*SIZE_SZ) & ~MALLOC_ALIGN_MASK;
+ set_head(old_top, old_size | PREV_INUSE);
+
+ /*
+ Note that the following assignments completely overwrite
+ old_top when old_size was previously MINSIZE. This is
+ intentional. We need the fencepost, even if old_top otherwise gets
+ lost.
+ */
+ chunk_at_offset(old_top, old_size)->size =
+ SIZE_SZ|PREV_INUSE;
+
+ chunk_at_offset(old_top, old_size + SIZE_SZ)->size =
+ SIZE_SZ|PREV_INUSE;
+
+ /*
+ If possible, release the rest, suppressing trimming.
+ */
+ if (old_size >= MINSIZE) {
+ INTERNAL_SIZE_T tt = av->trim_threshold;
+ av->trim_threshold = (INTERNAL_SIZE_T)(-1);
+ fREe(chunk2mem(old_top));
+ av->trim_threshold = tt;
+ }
+ }
+ }
+ }
+
+ /* Update statistics */
+ sum = av->sbrked_mem;
+ if (sum > (CHUNK_SIZE_T)(av->max_sbrked_mem))
+ av->max_sbrked_mem = sum;
+
+ sum += av->mmapped_mem;
+ if (sum > (CHUNK_SIZE_T)(av->max_total_mem))
+ av->max_total_mem = sum;
+
+ check_malloc_state();
+
+ /* finally, do the allocation */
+
+ p = av->top;
+ size = chunksize(p);
+
+ /* check that one of the above allocation paths succeeded */
+ if ((CHUNK_SIZE_T)(size) >= (CHUNK_SIZE_T)(nb + MINSIZE)) {
+ remainder_size = size - nb;
+ remainder = chunk_at_offset(p, nb);
+ av->top = remainder;
+ set_head(p, nb | PREV_INUSE);
+ set_head(remainder, remainder_size | PREV_INUSE);
+ check_malloced_chunk(p, nb);
+ return chunk2mem(p);
+ }
+
+ }
+
+ /* catch all failure paths */
+ MALLOC_FAILURE_ACTION;
+ return 0;
+}
+
+
+
+
+/*
+ sYSTRIm is an inverse of sorts to sYSMALLOc. It gives memory back
+ to the system (via negative arguments to sbrk) if there is unused
+ memory at the `high' end of the malloc pool. It is called
+ automatically by free() when top space exceeds the trim
+ threshold. It is also called by the public malloc_trim routine. It
+ returns 1 if it actually released any memory, else 0.
+*/
+
+#if __STD_C
+static int sYSTRIm(size_t pad, mstate av)
+#else
+static int sYSTRIm(pad, av) size_t pad; mstate av;
+#endif
+{
+ long top_size; /* Amount of top-most memory */
+ long extra; /* Amount to release */
+ long released; /* Amount actually released */
+ char* current_brk; /* address returned by pre-check sbrk call */
+ char* new_brk; /* address returned by post-check sbrk call */
+ size_t pagesz;
+
+ pagesz = av->pagesize;
+ top_size = chunksize(av->top);
+
+ /* Release in pagesize units, keeping at least one page */
+ extra = ((top_size - pad - MINSIZE + (pagesz-1)) / pagesz - 1) * pagesz;
+
+ if (extra > 0) {
+
+ /*
+ Only proceed if end of memory is where we last set it.
+ This avoids problems if there were foreign sbrk calls.
+ */
+ current_brk = (char*)(MORECORE(0));
+ if (current_brk == (char*)(av->top) + top_size) {
+
+ /*
+ Attempt to release memory. We ignore MORECORE return value,
+ and instead call again to find out where new end of memory is.
+ This avoids problems if first call releases less than we asked,
+ of if failure somehow altered brk value. (We could still
+ encounter problems if it altered brk in some very bad way,
+ but the only thing we can do is adjust anyway, which will cause
+ some downstream failure.)
+ */
+
+ MORECORE(-extra);
+ new_brk = (char*)(MORECORE(0));
+
+ if (new_brk != (char*)MORECORE_FAILURE) {
+ released = (long)(current_brk - new_brk);
+
+ if (released != 0) {
+ /* Success. Adjust top. */
+ av->sbrked_mem -= released;
+ set_head(av->top, (top_size - released) | PREV_INUSE);
+ check_malloc_state();
+ return 1;
+ }
+ }
+ }
+ }
+ return 0;
+}
+
+/*
+ ------------------------------ malloc ------------------------------
+*/
+
+
+#if __STD_C
+Void_t* mALLOc(size_t bytes)
+#else
+ Void_t* mALLOc(bytes) size_t bytes;
+#endif
+{
+ mstate av = get_malloc_state();
+
+ INTERNAL_SIZE_T nb; /* normalized request size */
+ unsigned int idx; /* associated bin index */
+ mbinptr bin; /* associated bin */
+ mfastbinptr* fb; /* associated fastbin */
+
+ mchunkptr victim; /* inspected/selected chunk */
+ INTERNAL_SIZE_T size; /* its size */
+ int victim_index; /* its bin index */
+
+ mchunkptr remainder; /* remainder from a split */
+ CHUNK_SIZE_T remainder_size; /* its size */
+
+ unsigned int block; /* bit map traverser */
+ unsigned int bit; /* bit map traverser */
+ unsigned int map; /* current word of binmap */
+
+ mchunkptr fwd; /* misc temp for linking */
+ mchunkptr bck; /* misc temp for linking */
+
+ /*
+ Convert request size to internal form by adding SIZE_SZ bytes
+ overhead plus possibly more to obtain necessary alignment and/or
+ to obtain a size of at least MINSIZE, the smallest allocatable
+ size. Also, checked_request2size traps (returning 0) request sizes
+ that are so large that they wrap around zero when padded and
+ aligned.
+ */
+
+ checked_request2size(bytes, nb);
+
+ /*
+ Bypass search if no frees yet
+ */
+ if (!have_anychunks(av)) {
+ if (av->max_fast == 0) /* initialization check */
+ malloc_consolidate(av);
+ goto use_top;
+ }
+
+ /*
+ If the size qualifies as a fastbin, first check corresponding bin.
+ */
+
+ if ((CHUNK_SIZE_T)(nb) <= (CHUNK_SIZE_T)(av->max_fast)) {
+ fb = &(av->fastbins[(fastbin_index(nb))]);
+ if ((victim = *fb) != 0) {
+ *fb = victim->fd;
+ check_remalloced_chunk(victim, nb);
+ return chunk2mem(victim);
+ }
+ }
+
+ /*
+ If a small request, check regular bin. Since these "smallbins"
+ hold one size each, no searching within bins is necessary.
+ (For a large request, we need to wait until unsorted chunks are
+ processed to find best fit. But for small ones, fits are exact
+ anyway, so we can check now, which is faster.)
+ */
+
+ if (in_smallbin_range(nb)) {
+ idx = smallbin_index(nb);
+ bin = bin_at(av,idx);
+
+ if ((victim = last(bin)) != bin) {
+ bck = victim->bk;
+ set_inuse_bit_at_offset(victim, nb);
+ bin->bk = bck;
+ bck->fd = bin;
+
+ check_malloced_chunk(victim, nb);
+ return chunk2mem(victim);
+ }
+ }
+
+ /*
+ If this is a large request, consolidate fastbins before continuing.
+ While it might look excessive to kill all fastbins before
+ even seeing if there is space available, this avoids
+ fragmentation problems normally associated with fastbins.
+ Also, in practice, programs tend to have runs of either small or
+ large requests, but less often mixtures, so consolidation is not
+ invoked all that often in most programs. And the programs that
+ it is called frequently in otherwise tend to fragment.
+ */
+
+ else {
+ idx = largebin_index(nb);
+ if (have_fastchunks(av))
+ malloc_consolidate(av);
+ }
+
+ /*
+ Process recently freed or remaindered chunks, taking one only if
+ it is exact fit, or, if this a small request, the chunk is remainder from
+ the most recent non-exact fit. Place other traversed chunks in
+ bins. Note that this step is the only place in any routine where
+ chunks are placed in bins.
+ */
+
+ while ((victim = unsorted_chunks(av)->bk) != unsorted_chunks(av)) {
+ bck = victim->bk;
+ size = chunksize(victim);
+
+ /*
+ If a small request, try to use last remainder if it is the
+ only chunk in unsorted bin. This helps promote locality for
+ runs of consecutive small requests. This is the only
+ exception to best-fit, and applies only when there is
+ no exact fit for a small chunk.
+ */
+
+ if (in_smallbin_range(nb) &&
+ bck == unsorted_chunks(av) &&
+ victim == av->last_remainder &&
+ (CHUNK_SIZE_T)(size) > (CHUNK_SIZE_T)(nb + MINSIZE)) {
+
+ /* split and reattach remainder */
+ remainder_size = size - nb;
+ remainder = chunk_at_offset(victim, nb);
+ unsorted_chunks(av)->bk = unsorted_chunks(av)->fd = remainder;
+ av->last_remainder = remainder;
+ remainder->bk = remainder->fd = unsorted_chunks(av);
+
+ set_head(victim, nb | PREV_INUSE);
+ set_head(remainder, remainder_size | PREV_INUSE);
+ set_foot(remainder, remainder_size);
+
+ check_malloced_chunk(victim, nb);
+ return chunk2mem(victim);
+ }
+
+ /* remove from unsorted list */
+ unsorted_chunks(av)->bk = bck;
+ bck->fd = unsorted_chunks(av);
+
+ /* Take now instead of binning if exact fit */
+
+ if (size == nb) {
+ set_inuse_bit_at_offset(victim, size);
+ check_malloced_chunk(victim, nb);
+ return chunk2mem(victim);
+ }
+
+ /* place chunk in bin */
+
+ if (in_smallbin_range(size)) {
+ victim_index = smallbin_index(size);
+ bck = bin_at(av, victim_index);
+ fwd = bck->fd;
+ }
+ else {
+ victim_index = largebin_index(size);
+ bck = bin_at(av, victim_index);
+ fwd = bck->fd;
+
+ if (fwd != bck) {
+ /* if smaller than smallest, place first */
+ if ((CHUNK_SIZE_T)(size) < (CHUNK_SIZE_T)(bck->bk->size)) {
+ fwd = bck;
+ bck = bck->bk;
+ }
+ else if ((CHUNK_SIZE_T)(size) >=
+ (CHUNK_SIZE_T)(FIRST_SORTED_BIN_SIZE)) {
+
+ /* maintain large bins in sorted order */
+ size |= PREV_INUSE; /* Or with inuse bit to speed comparisons */
+ while ((CHUNK_SIZE_T)(size) < (CHUNK_SIZE_T)(fwd->size))
+ fwd = fwd->fd;
+ bck = fwd->bk;
+ }
+ }
+ }
+
+ mark_bin(av, victim_index);
+ victim->bk = bck;
+ victim->fd = fwd;
+ fwd->bk = victim;
+ bck->fd = victim;
+ }
+
+ /*
+ If a large request, scan through the chunks of current bin to
+ find one that fits. (This will be the smallest that fits unless
+ FIRST_SORTED_BIN_SIZE has been changed from default.) This is
+ the only step where an unbounded number of chunks might be
+ scanned without doing anything useful with them. However the
+ lists tend to be short.
+ */
+
+ if (!in_smallbin_range(nb)) {
+ bin = bin_at(av, idx);
+
+ for (victim = last(bin); victim != bin; victim = victim->bk) {
+ size = chunksize(victim);
+
+ if ((CHUNK_SIZE_T)(size) >= (CHUNK_SIZE_T)(nb)) {
+ remainder_size = size - nb;
+ unlink(victim, bck, fwd);
+
+ /* Exhaust */
+ if (remainder_size < MINSIZE) {
+ set_inuse_bit_at_offset(victim, size);
+ check_malloced_chunk(victim, nb);
+ return chunk2mem(victim);
+ }
+ /* Split */
+ else {
+ remainder = chunk_at_offset(victim, nb);
+ unsorted_chunks(av)->bk = unsorted_chunks(av)->fd = remainder;
+ remainder->bk = remainder->fd = unsorted_chunks(av);
+ set_head(victim, nb | PREV_INUSE);
+ set_head(remainder, remainder_size | PREV_INUSE);
+ set_foot(remainder, remainder_size);
+ check_malloced_chunk(victim, nb);
+ return chunk2mem(victim);
+ }
+ }
+ }
+ }
+
+ /*
+ Search for a chunk by scanning bins, starting with next largest
+ bin. This search is strictly by best-fit; i.e., the smallest
+ (with ties going to approximately the least recently used) chunk
+ that fits is selected.
+
+ The bitmap avoids needing to check that most blocks are nonempty.
+ */
+
+ ++idx;
+ bin = bin_at(av,idx);
+ block = idx2block(idx);
+ map = av->binmap[block];
+ bit = idx2bit(idx);
+
+ for (;;) {
+
+ /* Skip rest of block if there are no more set bits in this block. */
+ if (bit > map || bit == 0) {
+ do {
+ if (++block >= BINMAPSIZE) /* out of bins */
+ goto use_top;
+ } while ((map = av->binmap[block]) == 0);
+
+ bin = bin_at(av, (block << BINMAPSHIFT));
+ bit = 1;
+ }
+
+ /* Advance to bin with set bit. There must be one. */
+ while ((bit & map) == 0) {
+ bin = next_bin(bin);
+ bit <<= 1;
+ assert(bit != 0);
+ }
+
+ /* Inspect the bin. It is likely to be non-empty */
+ victim = last(bin);
+
+ /* If a false alarm (empty bin), clear the bit. */
+ if (victim == bin) {
+ av->binmap[block] = map &= ~bit; /* Write through */
+ bin = next_bin(bin);
+ bit <<= 1;
+ }
+
+ else {
+ size = chunksize(victim);
+
+ /* We know the first chunk in this bin is big enough to use. */
+ assert((CHUNK_SIZE_T)(size) >= (CHUNK_SIZE_T)(nb));
+
+ remainder_size = size - nb;
+
+ /* unlink */
+ bck = victim->bk;
+ bin->bk = bck;
+ bck->fd = bin;
+
+ /* Exhaust */
+ if (remainder_size < MINSIZE) {
+ set_inuse_bit_at_offset(victim, size);
+ check_malloced_chunk(victim, nb);
+ return chunk2mem(victim);
+ }
+
+ /* Split */
+ else {
+ remainder = chunk_at_offset(victim, nb);
+
+ unsorted_chunks(av)->bk = unsorted_chunks(av)->fd = remainder;
+ remainder->bk = remainder->fd = unsorted_chunks(av);
+ /* advertise as last remainder */
+ if (in_smallbin_range(nb))
+ av->last_remainder = remainder;
+
+ set_head(victim, nb | PREV_INUSE);
+ set_head(remainder, remainder_size | PREV_INUSE);
+ set_foot(remainder, remainder_size);
+ check_malloced_chunk(victim, nb);
+ return chunk2mem(victim);
+ }
+ }
+ }
+
+ use_top:
+ /*
+ If large enough, split off the chunk bordering the end of memory
+ (held in av->top). Note that this is in accord with the best-fit
+ search rule. In effect, av->top is treated as larger (and thus
+ less well fitting) than any other available chunk since it can
+ be extended to be as large as necessary (up to system
+ limitations).
+
+ We require that av->top always exists (i.e., has size >=
+ MINSIZE) after initialization, so if it would otherwise be
+ exhausted by the current request, it is replenished. (The main
+ reason for ensuring it exists is that we may need MINSIZE space
+ to put in fenceposts in sysmalloc.)
+ */
+
+ victim = av->top;
+ size = chunksize(victim);
+
+ if ((CHUNK_SIZE_T)(size) >= (CHUNK_SIZE_T)(nb + MINSIZE)) {
+ remainder_size = size - nb;
+ remainder = chunk_at_offset(victim, nb);
+ av->top = remainder;
+ set_head(victim, nb | PREV_INUSE);
+ set_head(remainder, remainder_size | PREV_INUSE);
+
+ check_malloced_chunk(victim, nb);
+ return chunk2mem(victim);
+ }
+
+ /*
+ If no space in top, relay to handle system-dependent cases
+ */
+ return sYSMALLOc(nb, av);
+}
+
+/*
+ ------------------------------ free ------------------------------
+*/
+
+#if __STD_C
+void fREe(Void_t* mem)
+#else
+void fREe(mem) Void_t* mem;
+#endif
+{
+ mstate av = get_malloc_state();
+
+ mchunkptr p; /* chunk corresponding to mem */
+ INTERNAL_SIZE_T size; /* its size */
+ mfastbinptr* fb; /* associated fastbin */
+ mchunkptr nextchunk; /* next contiguous chunk */
+ INTERNAL_SIZE_T nextsize; /* its size */
+ int nextinuse; /* true if nextchunk is used */
+ INTERNAL_SIZE_T prevsize; /* size of previous contiguous chunk */
+ mchunkptr bck; /* misc temp for linking */
+ mchunkptr fwd; /* misc temp for linking */
+
+ /* free(0) has no effect */
+ if (mem != 0) {
+ p = mem2chunk(mem);
+ size = chunksize(p);
+
+ check_inuse_chunk(p);
+
+ /*
+ If eligible, place chunk on a fastbin so it can be found
+ and used quickly in malloc.
+ */
+
+ if ((CHUNK_SIZE_T)(size) <= (CHUNK_SIZE_T)(av->max_fast)
+
+#if TRIM_FASTBINS
+ /*
+ If TRIM_FASTBINS set, don't place chunks
+ bordering top into fastbins
+ */
+ && (chunk_at_offset(p, size) != av->top)
+#endif
+ ) {
+
+ set_fastchunks(av);
+ fb = &(av->fastbins[fastbin_index(size)]);
+ p->fd = *fb;
+ *fb = p;
+ }
+
+ /*
+ Consolidate other non-mmapped chunks as they arrive.
+ */
+
+ else if (!chunk_is_mmapped(p)) {
+ set_anychunks(av);
+
+ nextchunk = chunk_at_offset(p, size);
+ nextsize = chunksize(nextchunk);
+
+ /* consolidate backward */
+ if (!prev_inuse(p)) {
+ prevsize = p->prev_size;
+ size += prevsize;
+ p = chunk_at_offset(p, -((long) prevsize));
+ unlink(p, bck, fwd);
+ }
+
+ if (nextchunk != av->top) {
+ /* get and clear inuse bit */
+ nextinuse = inuse_bit_at_offset(nextchunk, nextsize);
+ set_head(nextchunk, nextsize);
+
+ /* consolidate forward */
+ if (!nextinuse) {
+ unlink(nextchunk, bck, fwd);
+ size += nextsize;
+ }
+
+ /*
+ Place the chunk in unsorted chunk list. Chunks are
+ not placed into regular bins until after they have
+ been given one chance to be used in malloc.
+ */
+
+ bck = unsorted_chunks(av);
+ fwd = bck->fd;
+ p->bk = bck;
+ p->fd = fwd;
+ bck->fd = p;
+ fwd->bk = p;
+
+ set_head(p, size | PREV_INUSE);
+ set_foot(p, size);
+
+ check_free_chunk(p);
+ }
+
+ /*
+ If the chunk borders the current high end of memory,
+ consolidate into top
+ */
+
+ else {
+ size += nextsize;
+ set_head(p, size | PREV_INUSE);
+ av->top = p;
+ check_chunk(p);
+ }
+
+ /*
+ If freeing a large space, consolidate possibly-surrounding
+ chunks. Then, if the total unused topmost memory exceeds trim
+ threshold, ask malloc_trim to reduce top.
+
+ Unless max_fast is 0, we don't know if there are fastbins
+ bordering top, so we cannot tell for sure whether threshold
+ has been reached unless fastbins are consolidated. But we
+ don't want to consolidate on each free. As a compromise,
+ consolidation is performed if FASTBIN_CONSOLIDATION_THRESHOLD
+ is reached.
+ */
+
+ if ((CHUNK_SIZE_T)(size) >= FASTBIN_CONSOLIDATION_THRESHOLD) {
+ if (have_fastchunks(av))
+ malloc_consolidate(av);
+
+#ifndef MORECORE_CANNOT_TRIM
+ if ((CHUNK_SIZE_T)(chunksize(av->top)) >=
+ (CHUNK_SIZE_T)(av->trim_threshold))
+ sYSTRIm(av->top_pad, av);
+#endif
+ }
+
+ }
+ /*
+ If the chunk was allocated via mmap, release via munmap()
+ Note that if HAVE_MMAP is false but chunk_is_mmapped is
+ true, then user must have overwritten memory. There's nothing
+ we can do to catch this error unless DEBUG is set, in which case
+ check_inuse_chunk (above) will have triggered error.
+ */
+
+ else {
+#if HAVE_MMAP
+ int ret;
+ INTERNAL_SIZE_T offset = p->prev_size;
+ av->n_mmaps--;
+ av->mmapped_mem -= (size + offset);
+ ret = munmap((char*)p - offset, size + offset);
+ /* munmap returns non-zero on failure */
+ assert(ret == 0);
+#endif
+ }
+ }
+}
+
+/*
+ ------------------------- malloc_consolidate -------------------------
+
+ malloc_consolidate is a specialized version of free() that tears
+ down chunks held in fastbins. Free itself cannot be used for this
+ purpose since, among other things, it might place chunks back onto
+ fastbins. So, instead, we need to use a minor variant of the same
+ code.
+
+ Also, because this routine needs to be called the first time through
+ malloc anyway, it turns out to be the perfect place to trigger
+ initialization code.
+*/
+
+#if __STD_C
+static void malloc_consolidate(mstate av)
+#else
+static void malloc_consolidate(av) mstate av;
+#endif
+{
+ mfastbinptr* fb; /* current fastbin being consolidated */
+ mfastbinptr* maxfb; /* last fastbin (for loop control) */
+ mchunkptr p; /* current chunk being consolidated */
+ mchunkptr nextp; /* next chunk to consolidate */
+ mchunkptr unsorted_bin; /* bin header */
+ mchunkptr first_unsorted; /* chunk to link to */
+
+ /* These have same use as in free() */
+ mchunkptr nextchunk;
+ INTERNAL_SIZE_T size;
+ INTERNAL_SIZE_T nextsize;
+ INTERNAL_SIZE_T prevsize;
+ int nextinuse;
+ mchunkptr bck;
+ mchunkptr fwd;
+
+ /*
+ If max_fast is 0, we know that av hasn't
+ yet been initialized, in which case do so below
+ */
+
+ if (av->max_fast != 0) {
+ clear_fastchunks(av);
+
+ unsorted_bin = unsorted_chunks(av);
+
+ /*
+ Remove each chunk from fast bin and consolidate it, placing it
+ then in unsorted bin. Among other reasons for doing this,
+ placing in unsorted bin avoids needing to calculate actual bins
+ until malloc is sure that chunks aren't immediately going to be
+ reused anyway.
+ */
+
+ maxfb = &(av->fastbins[fastbin_index(av->max_fast)]);
+ fb = &(av->fastbins[0]);
+ do {
+ if ((p = *fb) != 0) {
+ *fb = 0;
+
+ do {
+ check_inuse_chunk(p);
+ nextp = p->fd;
+
+ /* Slightly streamlined version of consolidation code in free() */
+ size = p->size & ~PREV_INUSE;
+ nextchunk = chunk_at_offset(p, size);
+ nextsize = chunksize(nextchunk);
+
+ if (!prev_inuse(p)) {
+ prevsize = p->prev_size;
+ size += prevsize;
+ p = chunk_at_offset(p, -((long) prevsize));
+ unlink(p, bck, fwd);
+ }
+
+ if (nextchunk != av->top) {
+ nextinuse = inuse_bit_at_offset(nextchunk, nextsize);
+ set_head(nextchunk, nextsize);
+
+ if (!nextinuse) {
+ size += nextsize;
+ unlink(nextchunk, bck, fwd);
+ }
+
+ first_unsorted = unsorted_bin->fd;
+ unsorted_bin->fd = p;
+ first_unsorted->bk = p;
+
+ set_head(p, size | PREV_INUSE);
+ p->bk = unsorted_bin;
+ p->fd = first_unsorted;
+ set_foot(p, size);
+ }
+
+ else {
+ size += nextsize;
+ set_head(p, size | PREV_INUSE);
+ av->top = p;
+ }
+
+ } while ((p = nextp) != 0);
+
+ }
+ } while (fb++ != maxfb);
+ }
+ else {
+ malloc_init_state(av);
+ check_malloc_state();
+ }
+}
+
+/*
+ ------------------------------ realloc ------------------------------
+*/
+
+
+#if __STD_C
+Void_t* rEALLOc(Void_t* oldmem, size_t bytes)
+#else
+Void_t* rEALLOc(oldmem, bytes) Void_t* oldmem; size_t bytes;
+#endif
+{
+ mstate av = get_malloc_state();
+
+ INTERNAL_SIZE_T nb; /* padded request size */
+
+ mchunkptr oldp; /* chunk corresponding to oldmem */
+ INTERNAL_SIZE_T oldsize; /* its size */
+
+ mchunkptr newp; /* chunk to return */
+ INTERNAL_SIZE_T newsize; /* its size */
+ Void_t* newmem; /* corresponding user mem */
+
+ mchunkptr next; /* next contiguous chunk after oldp */
+
+ mchunkptr remainder; /* extra space at end of newp */
+ CHUNK_SIZE_T remainder_size; /* its size */
+
+ mchunkptr bck; /* misc temp for linking */
+ mchunkptr fwd; /* misc temp for linking */
+
+ CHUNK_SIZE_T copysize; /* bytes to copy */
+ unsigned int ncopies; /* INTERNAL_SIZE_T words to copy */
+ INTERNAL_SIZE_T* s; /* copy source */
+ INTERNAL_SIZE_T* d; /* copy destination */
+
+
+#ifdef REALLOC_ZERO_BYTES_FREES
+ if (bytes == 0) {
+ fREe(oldmem);
+ return 0;
+ }
+#endif
+
+ /* realloc of null is supposed to be same as malloc */
+ if (oldmem == 0)
+ return mALLOc(bytes);
+
+ checked_request2size(bytes, nb);
+
+ oldp = mem2chunk(oldmem);
+ oldsize = chunksize(oldp);
+
+ check_inuse_chunk(oldp);
+
+ if (!chunk_is_mmapped(oldp)) {
+
+ if ((CHUNK_SIZE_T)(oldsize) >= (CHUNK_SIZE_T)(nb)) {
+ /* already big enough; split below */
+ newp = oldp;
+ newsize = oldsize;
+ }
+
+ else {
+ next = chunk_at_offset(oldp, oldsize);
+
+ /* Try to expand forward into top */
+ if (next == av->top &&
+ (CHUNK_SIZE_T)(newsize = oldsize + chunksize(next)) >=
+ (CHUNK_SIZE_T)(nb + MINSIZE)) {
+ set_head_size(oldp, nb);
+ av->top = chunk_at_offset(oldp, nb);
+ set_head(av->top, (newsize - nb) | PREV_INUSE);
+ return chunk2mem(oldp);
+ }
+
+ /* Try to expand forward into next chunk; split off remainder below */
+ else if (next != av->top &&
+ !inuse(next) &&
+ (CHUNK_SIZE_T)(newsize = oldsize + chunksize(next)) >=
+ (CHUNK_SIZE_T)(nb)) {
+ newp = oldp;
+ unlink(next, bck, fwd);
+ }
+
+ /* allocate, copy, free */
+ else {
+ newmem = mALLOc(nb - MALLOC_ALIGN_MASK);
+ if (newmem == 0)
+ return 0; /* propagate failure */
+
+ newp = mem2chunk(newmem);
+ newsize = chunksize(newp);
+
+ /*
+ Avoid copy if newp is next chunk after oldp.
+ */
+ if (newp == next) {
+ newsize += oldsize;
+ newp = oldp;
+ }
+ else {
+ /*
+ Unroll copy of <= 36 bytes (72 if 8byte sizes)
+ We know that contents have an odd number of
+ INTERNAL_SIZE_T-sized words; minimally 3.
+ */
+
+ copysize = oldsize - SIZE_SZ;
+ s = (INTERNAL_SIZE_T*)(oldmem);
+ d = (INTERNAL_SIZE_T*)(newmem);
+ ncopies = copysize / sizeof (INTERNAL_SIZE_T);
+ assert(ncopies >= 3);
+
+ if (ncopies > 9)
+ MALLOC_COPY(d, s, copysize);
+
+ else {
+ *(d+0) = *(s+0);
+ *(d+1) = *(s+1);
+ *(d+2) = *(s+2);
+ if (ncopies > 4) {
+ *(d+3) = *(s+3);
+ *(d+4) = *(s+4);
+ if (ncopies > 6) {
+ *(d+5) = *(s+5);
+ *(d+6) = *(s+6);
+ if (ncopies > 8) {
+ *(d+7) = *(s+7);
+ *(d+8) = *(s+8);
+ }
+ }
+ }
+ }
+
+ fREe(oldmem);
+ check_inuse_chunk(newp);
+ return chunk2mem(newp);
+ }
+ }
+ }
+
+ /* If possible, free extra space in old or extended chunk */
+
+ assert((CHUNK_SIZE_T)(newsize) >= (CHUNK_SIZE_T)(nb));
+
+ remainder_size = newsize - nb;
+
+ if (remainder_size < MINSIZE) { /* not enough extra to split off */
+ set_head_size(newp, newsize);
+ set_inuse_bit_at_offset(newp, newsize);
+ }
+ else { /* split remainder */
+ remainder = chunk_at_offset(newp, nb);
+ set_head_size(newp, nb);
+ set_head(remainder, remainder_size | PREV_INUSE);
+ /* Mark remainder as inuse so free() won't complain */
+ set_inuse_bit_at_offset(remainder, remainder_size);
+ fREe(chunk2mem(remainder));
+ }
+
+ check_inuse_chunk(newp);
+ return chunk2mem(newp);
+ }
+
+ /*
+ Handle mmap cases
+ */
+
+ else {
+#if HAVE_MMAP
+
+# if HAVE_MREMAP
+ INTERNAL_SIZE_T offset = oldp->prev_size;
+ size_t pagemask = av->pagesize - 1;
+ char *cp;
+ CHUNK_SIZE_T sum;
+
+ /* Note the extra SIZE_SZ overhead */
+ newsize = (nb + offset + SIZE_SZ + pagemask) & ~pagemask;
+
+ /* don't need to remap if still within same page */
+ if (oldsize == newsize - offset)
+ return oldmem;
+
+ cp = (char*)mremap((char*)oldp - offset, oldsize + offset, newsize, 1);
+
+ if (cp != (char*)MORECORE_FAILURE) {
+
+ newp = (mchunkptr)(cp + offset);
+ set_head(newp, (newsize - offset)|IS_MMAPPED);
+
+ assert(aligned_OK(chunk2mem(newp)));
+ assert((newp->prev_size == offset));
+
+ /* update statistics */
+ sum = av->mmapped_mem += newsize - oldsize;
+ if (sum > (CHUNK_SIZE_T)(av->max_mmapped_mem))
+ av->max_mmapped_mem = sum;
+ sum += av->sbrked_mem;
+ if (sum > (CHUNK_SIZE_T)(av->max_total_mem))
+ av->max_total_mem = sum;
+
+ return chunk2mem(newp);
+ }
+# endif
+
+ /* Note the extra SIZE_SZ overhead. */
+ if ((CHUNK_SIZE_T)(oldsize) >= (CHUNK_SIZE_T)(nb + SIZE_SZ))
+ newmem = oldmem; /* do nothing */
+ else {
+ /* Must alloc, copy, free. */
+ newmem = mALLOc(nb - MALLOC_ALIGN_MASK);
+ if (newmem != 0) {
+ MALLOC_COPY(newmem, oldmem, oldsize - 2*SIZE_SZ);
+ fREe(oldmem);
+ }
+ }
+ return newmem;
+
+#else
+ /* If !HAVE_MMAP, but chunk_is_mmapped, user must have overwritten mem */
+ check_malloc_state();
+ MALLOC_FAILURE_ACTION;
+ return 0;
+#endif
+ }
+}
+
+/*
+ ------------------------------ memalign ------------------------------
+*/
+
+#if __STD_C
+Void_t* mEMALIGn(size_t alignment, size_t bytes)
+#else
+Void_t* mEMALIGn(alignment, bytes) size_t alignment; size_t bytes;
+#endif
+{
+ INTERNAL_SIZE_T nb; /* padded request size */
+ char* m; /* memory returned by malloc call */
+ mchunkptr p; /* corresponding chunk */
+ char* brk; /* alignment point within p */
+ mchunkptr newp; /* chunk to return */
+ INTERNAL_SIZE_T newsize; /* its size */
+ INTERNAL_SIZE_T leadsize; /* leading space before alignment point */
+ mchunkptr remainder; /* spare room at end to split off */
+ CHUNK_SIZE_T remainder_size; /* its size */
+ INTERNAL_SIZE_T size;
+
+ /* If need less alignment than we give anyway, just relay to malloc */
+
+ if (alignment <= MALLOC_ALIGNMENT)
+ return mALLOc(bytes);
+
+ /* Otherwise, ensure that it is at least a minimum chunk size */
+
+ if (alignment < MINSIZE)
+ alignment = MINSIZE;
+
+ /* Make sure alignment is power of 2 (in case MINSIZE is not). */
+ if ((alignment & (alignment - 1)) != 0) {
+ size_t a = MALLOC_ALIGNMENT * 2;
+ while ((CHUNK_SIZE_T)a < (CHUNK_SIZE_T)alignment)
+ a <<= 1;
+ alignment = a;
+ }
+
+ checked_request2size(bytes, nb);
+
+ /*
+ Strategy: find a spot within that chunk that meets the alignment
+ request, and then possibly free the leading and trailing space.
+ */
+
+
+ /* Call malloc with worst case padding to hit alignment. */
+
+ m = (char*)(mALLOc(nb + alignment + MINSIZE));
+
+ if (m == 0)
+ return 0; /* propagate failure */
+
+ p = mem2chunk(m);
+
+ if ((((PTR_UINT)(m)) % alignment) != 0) { /* misaligned */
+
+ /*
+ Find an aligned spot inside chunk. Since we need to give back
+ leading space in a chunk of at least MINSIZE, if the first
+ calculation places us at a spot with less than MINSIZE leader,
+ we can move to the next aligned spot -- we've allocated enough
+ total room so that this is always possible.
+ */
+
+ brk = (char*)mem2chunk((PTR_UINT)(((PTR_UINT)(m + alignment - 1)) &
+ -((signed long) alignment)));
+ if ((CHUNK_SIZE_T)(brk - (char*)(p)) < MINSIZE)
+ brk += alignment;
+
+ newp = (mchunkptr)brk;
+ leadsize = brk - (char*)(p);
+ newsize = chunksize(p) - leadsize;
+
+ /* For mmapped chunks, just adjust offset */
+ if (chunk_is_mmapped(p)) {
+ newp->prev_size = p->prev_size + leadsize;
+ set_head(newp, newsize|IS_MMAPPED);
+ return chunk2mem(newp);
+ }
+
+ /* Otherwise, give back leader, use the rest */
+ set_head(newp, newsize | PREV_INUSE);
+ set_inuse_bit_at_offset(newp, newsize);
+ set_head_size(p, leadsize);
+ fREe(chunk2mem(p));
+ p = newp;
+
+ assert (newsize >= nb &&
+ (((PTR_UINT)(chunk2mem(p))) % alignment) == 0);
+ }
+
+ /* Also give back spare room at the end */
+ if (!chunk_is_mmapped(p)) {
+ size = chunksize(p);
+ if ((CHUNK_SIZE_T)(size) > (CHUNK_SIZE_T)(nb + MINSIZE)) {
+ remainder_size = size - nb;
+ remainder = chunk_at_offset(p, nb);
+ set_head(remainder, remainder_size | PREV_INUSE);
+ set_head_size(p, nb);
+ fREe(chunk2mem(remainder));
+ }
+ }
+
+ check_inuse_chunk(p);
+ return chunk2mem(p);
+}
+
+/*
+ ------------------------------ calloc ------------------------------
+*/
+
+#if __STD_C
+Void_t* cALLOc(size_t n_elements, size_t elem_size)
+#else
+Void_t* cALLOc(n_elements, elem_size) size_t n_elements; size_t elem_size;
+#endif
+{
+ mchunkptr p;
+ CHUNK_SIZE_T clearsize;
+ CHUNK_SIZE_T nclears;
+ INTERNAL_SIZE_T* d;
+
+ Void_t* mem = mALLOc(n_elements * elem_size);
+
+ if (mem != 0) {
+ p = mem2chunk(mem);
+
+ if (!chunk_is_mmapped(p))
+ {
+ /*
+ Unroll clear of <= 36 bytes (72 if 8byte sizes)
+ We know that contents have an odd number of
+ INTERNAL_SIZE_T-sized words; minimally 3.
+ */
+
+ d = (INTERNAL_SIZE_T*)mem;
+ clearsize = chunksize(p) - SIZE_SZ;
+ nclears = clearsize / sizeof (INTERNAL_SIZE_T);
+ assert(nclears >= 3);
+
+ if (nclears > 9)
+ MALLOC_ZERO(d, clearsize);
+
+ else {
+ *(d+0) = 0;
+ *(d+1) = 0;
+ *(d+2) = 0;
+ if (nclears > 4) {
+ *(d+3) = 0;
+ *(d+4) = 0;
+ if (nclears > 6) {
+ *(d+5) = 0;
+ *(d+6) = 0;
+ if (nclears > 8) {
+ *(d+7) = 0;
+ *(d+8) = 0;
+ }
+ }
+ }
+ }
+ }
+#if ! MMAP_CLEARS
+ else
+ {
+ d = (INTERNAL_SIZE_T*)mem;
+ /*
+ Note the additional SIZE_SZ
+ */
+ clearsize = chunksize(p) - 2*SIZE_SZ;
+ MALLOC_ZERO(d, clearsize);
+ }
+#endif
+ }
+ return mem;
+}
+
+/*
+ ------------------------------ cfree ------------------------------
+*/
+
+#if __STD_C
+void cFREe(Void_t *mem)
+#else
+void cFREe(mem) Void_t *mem;
+#endif
+{
+ fREe(mem);
+}
+
+/*
+ ------------------------- independent_calloc -------------------------
+*/
+
+#if __STD_C
+Void_t** iCALLOc(size_t n_elements, size_t elem_size, Void_t* chunks[])
+#else
+Void_t** iCALLOc(n_elements, elem_size, chunks) size_t n_elements;
+ size_t elem_size;
+ Void_t* chunks[];
+#endif
+{
+ size_t sz = elem_size; /* serves as 1-element array */
+ /* opts arg of 3 means all elements are same size, and should be cleared */
+ return iALLOc(n_elements, &sz, 3, chunks);
+}
+
+/*
+ ------------------------- independent_comalloc -------------------------
+*/
+
+#if __STD_C
+Void_t** iCOMALLOc(size_t n_elements, size_t sizes[], Void_t* chunks[])
+#else
+Void_t** iCOMALLOc(n_elements, sizes, chunks)
+size_t n_elements;
+size_t sizes[];
+Void_t* chunks[];
+#endif
+{
+ return iALLOc(n_elements, sizes, 0, chunks);
+}
+
+
+/*
+ ------------------------------ ialloc ------------------------------
+ ialloc provides common support for independent_X routines, handling all of
+ the combinations that can result.
+
+ The opts arg has:
+ bit 0 set if all elements are same size (using sizes[0])
+ bit 1 set if elements should be zeroed
+*/
+
+
+#if __STD_C
+static Void_t** iALLOc(size_t n_elements,
+ size_t* sizes,
+ int opts,
+ Void_t* chunks[])
+#else
+static Void_t** iALLOc(n_elements, sizes, opts, chunks) size_t n_elements;
+ size_t* sizes;
+ int opts;
+ Void_t* chunks[];
+#endif
+{
+ mstate av = get_malloc_state();
+ INTERNAL_SIZE_T element_size; /* chunksize of each element, if all same */
+ INTERNAL_SIZE_T contents_size; /* total size of elements */
+ INTERNAL_SIZE_T array_size; /* request size of pointer array */
+ Void_t* mem; /* malloced aggregate space */
+ mchunkptr p; /* corresponding chunk */
+ INTERNAL_SIZE_T remainder_size; /* remaining bytes while splitting */
+ Void_t** marray; /* either "chunks" or malloced ptr array */
+ mchunkptr array_chunk; /* chunk for malloced ptr array */
+ int mmx; /* to disable mmap */
+ INTERNAL_SIZE_T size;
+ size_t i;
+
+ /* Ensure initialization */
+ if (av->max_fast == 0)
+ malloc_consolidate(av);
+
+ /* compute array length, if needed */
+ if (chunks != 0) {
+ if (n_elements == 0)
+ return chunks; /* nothing to do */
+ marray = chunks;
+ array_size = 0;
+ }
+ else {
+ /* if empty req, must still return chunk representing empty array */
+ if (n_elements == 0)
+ return (Void_t**) mALLOc(0);
+ marray = 0;
+ array_size = request2size(n_elements * (sizeof (Void_t*)));
+ }
+
+ /* compute total element size */
+ if (opts & 0x1) { /* all-same-size */
+ element_size = request2size(*sizes);
+ contents_size = n_elements * element_size;
+ }
+ else { /* add up all the sizes */
+ element_size = 0;
+ contents_size = 0;
+ for (i = 0; i != n_elements; ++i)
+ contents_size += request2size(sizes[i]);
+ }
+
+ /* subtract out alignment bytes from total to minimize overallocation */
+ size = contents_size + array_size - MALLOC_ALIGN_MASK;
+
+ /*
+ Allocate the aggregate chunk.
+ But first disable mmap so malloc won't use it, since
+ we would not be able to later free/realloc space internal
+ to a segregated mmap region.
+ */
+ mmx = av->n_mmaps_max; /* disable mmap */
+ av->n_mmaps_max = 0;
+ mem = mALLOc(size);
+ av->n_mmaps_max = mmx; /* reset mmap */
+ if (mem == 0)
+ return 0;
+
+ p = mem2chunk(mem);
+ assert(!chunk_is_mmapped(p));
+ remainder_size = chunksize(p);
+
+ if (opts & 0x2) { /* optionally clear the elements */
+ MALLOC_ZERO(mem, remainder_size - SIZE_SZ - array_size);
+ }
+
+ /* If not provided, allocate the pointer array as final part of chunk */
+ if (marray == 0) {
+ array_chunk = chunk_at_offset(p, contents_size);
+ marray = (Void_t**) (chunk2mem(array_chunk));
+ set_head(array_chunk, (remainder_size - contents_size) | PREV_INUSE);
+ remainder_size = contents_size;
+ }
+
+ /* split out elements */
+ for (i = 0; ; ++i) {
+ marray[i] = chunk2mem(p);
+ if (i != n_elements-1) {
+ if (element_size != 0)
+ size = element_size;
+ else
+ size = request2size(sizes[i]);
+ remainder_size -= size;
+ set_head(p, size | PREV_INUSE);
+ p = chunk_at_offset(p, size);
+ }
+ else { /* the final element absorbs any overallocation slop */
+ set_head(p, remainder_size | PREV_INUSE);
+ break;
+ }
+ }
+
+#if DEBUG
+ if (marray != chunks) {
+ /* final element must have exactly exhausted chunk */
+ if (element_size != 0)
+ assert(remainder_size == element_size);
+ else
+ assert(remainder_size == request2size(sizes[i]));
+ check_inuse_chunk(mem2chunk(marray));
+ }
+
+ for (i = 0; i != n_elements; ++i)
+ check_inuse_chunk(mem2chunk(marray[i]));
+#endif
+
+ return marray;
+}
+
+
+/*
+ ------------------------------ valloc ------------------------------
+*/
+
+#if __STD_C
+Void_t* vALLOc(size_t bytes)
+#else
+Void_t* vALLOc(bytes) size_t bytes;
+#endif
+{
+ /* Ensure initialization */
+ mstate av = get_malloc_state();
+ if (av->max_fast == 0)
+ malloc_consolidate(av);
+ return mEMALIGn(av->pagesize, bytes);
+}
+
+/*
+ ------------------------------ pvalloc ------------------------------
+*/
+
+
+#if __STD_C
+Void_t* pVALLOc(size_t bytes)
+#else
+Void_t* pVALLOc(bytes) size_t bytes;
+#endif
+{
+ mstate av = get_malloc_state();
+ size_t pagesz;
+
+ /* Ensure initialization */
+ if (av->max_fast == 0)
+ malloc_consolidate(av);
+ pagesz = av->pagesize;
+ return mEMALIGn(pagesz, (bytes + pagesz - 1) & ~(pagesz - 1));
+}
+
+
+/*
+ ------------------------------ malloc_trim ------------------------------
+*/
+
+#if __STD_C
+int mTRIm(size_t pad)
+#else
+int mTRIm(pad) size_t pad;
+#endif
+{
+ mstate av = get_malloc_state();
+ /* Ensure initialization/consolidation */
+ malloc_consolidate(av);
+
+#ifndef MORECORE_CANNOT_TRIM
+ return sYSTRIm(pad, av);
+#else
+ return 0;
+#endif
+}
+
+
+/*
+ ------------------------- malloc_usable_size -------------------------
+*/
+
+#if __STD_C
+size_t mUSABLe(Void_t* mem)
+#else
+size_t mUSABLe(mem) Void_t* mem;
+#endif
+{
+ mchunkptr p;
+ if (mem != 0) {
+ p = mem2chunk(mem);
+ if (chunk_is_mmapped(p))
+ return chunksize(p) - 2*SIZE_SZ;
+ else if (inuse(p))
+ return chunksize(p) - SIZE_SZ;
+ }
+ return 0;
+}
+
+/*
+ ------------------------------ mallinfo ------------------------------
+*/
+
+struct mallinfo mALLINFo()
+{
+ mstate av = get_malloc_state();
+ struct mallinfo mi;
+ int i;
+ mbinptr b;
+ mchunkptr p;
+ INTERNAL_SIZE_T avail;
+ INTERNAL_SIZE_T fastavail;
+ int nblocks;
+ int nfastblocks;
+
+ /* Ensure initialization */
+ if (av->top == 0)
+ malloc_consolidate(av);
+
+ check_malloc_state();
+
+ /* Account for top */
+ avail = chunksize(av->top);
+ nblocks = 1; /* top always exists */
+
+ /* traverse fastbins */
+ nfastblocks = 0;
+ fastavail = 0;
+
+ for (i = 0; i < NFASTBINS; ++i) {
+ for (p = av->fastbins[i]; p != 0; p = p->fd) {
+ ++nfastblocks;
+ fastavail += chunksize(p);
+ }
+ }
+
+ avail += fastavail;
+
+ /* traverse regular bins */
+ for (i = 1; i < NBINS; ++i) {
+ b = bin_at(av, i);
+ for (p = last(b); p != b; p = p->bk) {
+ ++nblocks;
+ avail += chunksize(p);
+ }
+ }
+
+ mi.smblks = nfastblocks;
+ mi.ordblks = nblocks;
+ mi.fordblks = avail;
+ mi.uordblks = av->sbrked_mem - avail;
+ mi.arena = av->sbrked_mem;
+ mi.hblks = av->n_mmaps;
+ mi.hblkhd = av->mmapped_mem;
+ mi.fsmblks = fastavail;
+ mi.keepcost = chunksize(av->top);
+ mi.usmblks = av->max_total_mem;
+ return mi;
+}
+
+/*
+ ------------------------------ malloc_stats ------------------------------
+*/
+
+void mSTATs()
+{
+ struct mallinfo mi = mALLINFo();
+
+#ifdef WIN32
+ {
+ CHUNK_SIZE_T free, reserved, committed;
+ vminfo (&free, &reserved, &committed);
+ Parrot_io_eprintf(NULL, "free bytes = %10lu\n",
+ free);
+ Parrot_io_eprintf(NULL, "reserved bytes = %10lu\n",
+ reserved);
+ Parrot_io_eprintf(NULL, "committed bytes = %10lu\n",
+ committed);
+ }
+#endif
+
+
+ Parrot_io_eprintf(NULL, "max system bytes = %10lu\n",
+ (CHUNK_SIZE_T)(mi.usmblks));
+ Parrot_io_eprintf(NULL, "system bytes = %10lu\n",
+ (CHUNK_SIZE_T)(mi.arena + mi.hblkhd));
+ Parrot_io_eprintf(NULL, "in use bytes = %10lu\n",
+ (CHUNK_SIZE_T)(mi.uordblks + mi.hblkhd));
+
+#ifdef WIN32
+ {
+ CHUNK_SIZE_T kernel, user;
+ if (cpuinfo (TRUE, &kernel, &user)) {
+ Parrot_io_eprintf(NULL, "kernel ms = %10lu\n",
+ kernel);
+ Parrot_io_eprintf(NULL, "user ms = %10lu\n",
+ user);
+ }
+ }
+#endif
+}
+
+
+/*
+ ------------------------------ mallopt ------------------------------
+*/
+
+#if __STD_C
+int mALLOPt(int param_number, int value)
+#else
+int mALLOPt(param_number, value) int param_number; int value;
+#endif
+{
+ mstate av = get_malloc_state();
+ /* Ensure initialization/consolidation */
+ malloc_consolidate(av);
+
+ switch (param_number) {
+ case M_MXFAST:
+ if (value >= 0 && value <= MAX_FAST_SIZE) {
+ set_max_fast(av, value);
+ return 1;
+ }
+ else
+ return 0;
+
+ case M_TRIM_THRESHOLD:
+ av->trim_threshold = value;
+ return 1;
+
+ case M_TOP_PAD:
+ av->top_pad = value;
+ return 1;
+
+ case M_MMAP_THRESHOLD:
+ av->mmap_threshold = value;
+ return 1;
+
+ case M_MMAP_MAX:
+#if !HAVE_MMAP
+ if (value != 0)
+ return 0;
+#endif
+ av->n_mmaps_max = value;
+ return 1;
+
+ default:
+ return 0;
+ }
+}
+
+
+/*
+ -------------------- Alternative MORECORE functions --------------------
+*/
+
+
+/*
+ General Requirements for MORECORE.
+
+ The MORECORE function must have the following properties:
+
+ If MORECORE_CONTIGUOUS is false:
+
+ * MORECORE must allocate in multiples of pagesize. It will
+ only be called with arguments that are multiples of pagesize.
+
+ * MORECORE(0) must return an address that is at least
+ MALLOC_ALIGNMENT aligned. (Page-aligning always suffices.)
+
+ else (i.e. If MORECORE_CONTIGUOUS is true):
+
+ * Consecutive calls to MORECORE with positive arguments
+ return increasing addresses, indicating that space has been
+ contiguously extended.
+
+ * MORECORE need not allocate in multiples of pagesize.
+ Calls to MORECORE need not have args of multiples of pagesize.
+
+ * MORECORE need not page-align.
+
+ In either case:
+
+ * MORECORE may allocate more memory than requested. (Or even less,
+ but this will generally result in a malloc failure.)
+
+ * MORECORE must not allocate memory when given argument zero, but
+ instead return one past the end address of memory from previous
+ nonzero call. This malloc does NOT call MORECORE(0)
+ until at least one call with positive arguments is made, so
+ the initial value returned is not important.
+
+ * Even though consecutive calls to MORECORE need not return contiguous
+ addresses, it must be OK for malloc'ed chunks to span multiple
+ regions in those cases where they do happen to be contiguous.
+
+ * MORECORE need not handle negative arguments -- it may instead
+ just return MORECORE_FAILURE when given negative arguments.
+ Negative arguments are always multiples of pagesize. MORECORE
+ must not misinterpret negative args as large positive unsigned
+ args. You can suppress all such calls from even occurring by defining
+ MORECORE_CANNOT_TRIM,
+
+ There is some variation across systems about the type of the
+ argument to sbrk/MORECORE. If size_t is unsigned, then it cannot
+ actually be size_t, because sbrk supports negative args, so it is
+ normally the signed type of the same width as size_t (sometimes
+ declared as "intptr_t", and sometimes "ptrdiff_t"). It doesn't much
+ matter though. Internally, we use "long" as arguments, which should
+ work across all reasonable possibilities.
+
+ Additionally, if MORECORE ever returns failure for a positive
+ request, and HAVE_MMAP is true, then mmap is used as a noncontiguous
+ system allocator. This is a useful backup strategy for systems with
+ holes in address spaces -- in this case sbrk cannot contiguously
+ expand the heap, but mmap may be able to map noncontiguous space.
+
+ If you'd like mmap to ALWAYS be used, you can define MORECORE to be
+ a function that always returns MORECORE_FAILURE.
+
+ Malloc only has limited ability to detect failures of MORECORE
+ to supply contiguous space when it says it can. In particular,
+ multithreaded programs that do not use locks may result in
+ rece conditions across calls to MORECORE that result in gaps
+ that cannot be detected as such, and subsequent corruption.
+
+ If you are using this malloc with something other than sbrk (or its
+ emulation) to supply memory regions, you probably want to set
+ MORECORE_CONTIGUOUS as false. As an example, here is a custom
+ allocator kindly contributed for pre-OSX macOS. It uses virtually
+ but not necessarily physically contiguous non-paged memory (locked
+ in, present and won't get swapped out). You can use it by
+ uncommenting this section, adding some #includes, and setting up the
+ appropriate defines above:
+
+ #define MORECORE osMoreCore
+ #define MORECORE_CONTIGUOUS 0
+
+ There is also a shutdown routine that should somehow be called for
+ cleanup upon program exit.
+
+ #define MAX_POOL_ENTRIES 100
+ #define MINIMUM_MORECORE_SIZE (64 * 1024)
+ static int next_os_pool;
+ void *our_os_pools[MAX_POOL_ENTRIES];
+
+ void *osMoreCore(int size)
+ {
+ void *ptr = 0;
+ static void *sbrk_top = 0;
+
+ if (size > 0)
+ {
+ if (size < MINIMUM_MORECORE_SIZE)
+ size = MINIMUM_MORECORE_SIZE;
+ if (CurrentExecutionLevel() == kTaskLevel)
+ ptr = PoolAllocateResident(size + RM_PAGE_SIZE, 0);
+ if (ptr == 0)
+ {
+ return (void *) MORECORE_FAILURE;
+ }
+ / / save ptrs so they can be freed during cleanup
+ our_os_pools[next_os_pool] = ptr;
+ next_os_pool++;
+ ptr = (void *) ((((CHUNK_SIZE_T) ptr) + RM_PAGE_MASK) & ~RM_PAGE_MASK);
+ sbrk_top = (char *) ptr + size;
+ return ptr;
+ }
+ else if (size < 0)
+ {
+ / / we don't currently support shrink behavior
+ return (void *) MORECORE_FAILURE;
+ }
+ else
+ {
+ return sbrk_top;
+ }
+ }
+
+ / / cleanup any allocated memory pools
+ / / called as last thing before shutting down driver
+
+ void osCleanupMem(void)
+ {
+ void **ptr;
+
+ for (ptr = our_os_pools; ptr < &our_os_pools[MAX_POOL_ENTRIES]; ptr++)
+ if (*ptr)
+ {
+ PoolDeallocate(*ptr);
+ *ptr = 0;
+ }
+ }
+
+*/
+
+
+/*
+ --------------------------------------------------------------
+
+ Emulation of sbrk for win32.
+ Donated by J. Walter <Walter at GeNeSys-e.de>.
+ For additional information about this code, and malloc on Win32, see
+ http://www.genesys-e.de/jwalter/
+*/
+
+
+#ifdef WIN32
+
+# ifdef _DEBUG
+/* #define TRACE */
+# endif
+
+/* Support for USE_MALLOC_LOCK */
+# ifdef USE_MALLOC_LOCK
+
+/* Wait for spin lock */
+static int slwait (int *sl) {
+ while (InterlockedCompareExchange ((void **) sl,
+ (void *) 1,
+ (void *) 0) != 0)
+ Sleep (0);
+ return 0;
+}
+
+/* Release spin lock */
+static int slrelease (int *sl) {
+ InterlockedExchange (sl, 0);
+ return 0;
+}
+
+# ifdef NEEDED
+/* Spin lock for emulation code */
+static int g_sl;
+# endif
+
+# endif /* USE_MALLOC_LOCK */
+
+/* getpagesize for windows */
+static long getpagesize (void) {
+ static long g_pagesize = 0;
+ if (! g_pagesize) {
+ SYSTEM_INFO system_info;
+ GetSystemInfo (&system_info);
+ g_pagesize = system_info.dwPageSize;
+ }
+ return g_pagesize;
+}
+static long getregionsize (void) {
+ static long g_regionsize = 0;
+ if (! g_regionsize) {
+ SYSTEM_INFO system_info;
+ GetSystemInfo (&system_info);
+ g_regionsize = system_info.dwAllocationGranularity;
+ }
+ return g_regionsize;
+}
+
+/* A region list entry */
+typedef struct _region_list_entry {
+ void *top_allocated;
+ void *top_committed;
+ void *top_reserved;
+ long reserve_size;
+ struct _region_list_entry *previous;
+} region_list_entry;
+
+/* Allocate and link a region entry in the region list */
+static int region_list_append (region_list_entry **last,
+ void *base_reserved, long reserve_size) {
+ region_list_entry *next = HeapAlloc (GetProcessHeap (), 0,
+ sizeof (region_list_entry));
+ if (! next)
+ return FALSE;
+ next->top_allocated = (char *) base_reserved;
+ next->top_committed = (char *) base_reserved;
+ next->top_reserved = (char *) base_reserved + reserve_size;
+ next->reserve_size = reserve_size;
+ next->previous = *last;
+ *last = next;
+ return TRUE;
+}
+/* Free and unlink the last region entry from the region list */
+static int region_list_remove (region_list_entry **last) {
+ region_list_entry *previous = (*last)->previous;
+ if (! HeapFree (GetProcessHeap (), sizeof (region_list_entry), *last))
+ return FALSE;
+ *last = previous;
+ return TRUE;
+}
+
+# define CEIL(size,to) (((size)+(to)-1)&~((to)-1))
+# define FLOOR(size,to) ((size)&~((to)-1))
+
+# define SBRK_SCALE 0
+/* #define SBRK_SCALE 1 */
+/* #define SBRK_SCALE 2 */
+/* #define SBRK_SCALE 4 */
+
+/* sbrk for windows */
+static void *sbrk (long size) {
+ static long g_pagesize, g_my_pagesize;
+ static long g_regionsize, g_my_regionsize;
+ static region_list_entry *g_last;
+ void *result = (void *) MORECORE_FAILURE;
+# ifdef TRACE
+ Parrot_io_printf (NULL, "sbrk %d\n", size);
+# endif
+# if defined (USE_MALLOC_LOCK) && defined (NEEDED)
+ /* Wait for spin lock */
+ slwait (&g_sl);
+# endif
+ /* First time initialization */
+ if (! g_pagesize) {
+ g_pagesize = getpagesize ();
+ g_my_pagesize = g_pagesize << SBRK_SCALE;
+ }
+ if (! g_regionsize) {
+ g_regionsize = getregionsize ();
+ g_my_regionsize = g_regionsize << SBRK_SCALE;
+ }
+ if (! g_last) {
+ if (! region_list_append (&g_last, 0, 0))
+ goto sbrk_exit;
+ }
+ /* Assert invariants */
+ assert (g_last);
+ assert ((char *) g_last->top_reserved - g_last->reserve_size
+ <= (char *) g_last->top_allocated &&
+ g_last->top_allocated <= g_last->top_committed);
+ assert ((char *) g_last->top_reserved - g_last->reserve_size
+ <= (char *) g_last->top_committed &&
+ g_last->top_committed <= g_last->top_reserved &&
+ (unsigned) g_last->top_committed % g_pagesize == 0);
+ assert ((unsigned) g_last->top_reserved % g_regionsize == 0);
+ assert ((unsigned) g_last->reserve_size % g_regionsize == 0);
+ /* Allocation requested? */
+ if (size >= 0) {
+ /* Allocation size is the requested size */
+ long allocate_size = size;
+ /* Compute the size to commit */
+ long to_commit = (char *) g_last->top_allocated + allocate_size -
+ (char *) g_last->top_committed;
+ /* Do we reach the commit limit? */
+ if (to_commit > 0) {
+ /* Round size to commit */
+ long commit_size = CEIL (to_commit, g_my_pagesize);
+ /* Compute the size to reserve */
+ long to_reserve = (char *) g_last->top_committed + commit_size -
+ (char *) g_last->top_reserved;
+ /* Do we reach the reserve limit? */
+ if (to_reserve > 0) {
+ /* Compute the remaining size to commit in the current region */
+ long remaining_commit_size = (char *) g_last->top_reserved -
+ (char *) g_last->top_committed;
+ if (remaining_commit_size > 0) {
+ /* Assert preconditions */
+ assert ((unsigned) g_last->top_committed % g_pagesize == 0);
+ assert (0 < remaining_commit_size &&
+ remaining_commit_size % g_pagesize == 0); {
+ /* Commit this */
+ void *base_committed =
+ VirtualAlloc(g_last->top_committed,
+ remaining_commit_size,
+ MEM_COMMIT, PAGE_READWRITE);
+ /* Check returned pointer for consistency */
+ if (base_committed != g_last->top_committed)
+ goto sbrk_exit;
+ /* Assert postconditions */
+ assert ((unsigned) base_committed % g_pagesize == 0);
+# ifdef TRACE
+ Parrot_io_printf (NULL, "Commit %p %d\n", base_committed,
+ remaining_commit_size);
+# endif
+ /* Adjust the regions commit top */
+ g_last->top_committed = (char *) base_committed +
+ remaining_commit_size;
+ }
+ } {
+ /* Now we are going to search and reserve. */
+ int contiguous = -1;
+ int found = FALSE;
+ MEMORY_BASIC_INFORMATION memory_info;
+ void *base_reserved;
+ long reserve_size;
+ do {
+ /* Assume contiguous memory */
+ contiguous = TRUE;
+ /* Round size to reserve */
+ reserve_size = CEIL (to_reserve, g_my_regionsize);
+ /* Start with the current region's top */
+ memory_info.BaseAddress = g_last->top_reserved;
+ /* Assert preconditions */
+ assert ((unsigned) memory_info.BaseAddress %
+ g_pagesize == 0);
+ assert (0 < reserve_size && reserve_size %
+ g_regionsize == 0);
+ while (VirtualQuery (memory_info.BaseAddress,
+ &memory_info,
+ sizeof (memory_info))) {
+ /* Assert postconditions */
+ assert ((unsigned) memory_info.BaseAddress %
+ g_pagesize == 0);
+# ifdef TRACE
+ Parrot_io_printf (NULL, "Query %p %d %s\n",
+ memory_info.BaseAddress,
+ memory_info.RegionSize,
+ memory_info.State == MEM_FREE ? "FREE":
+ (memory_info.State == MEM_RESERVE ?
+ "RESERVED":
+ (memory_info.State == MEM_COMMIT ?
+ "COMMITTED": "?")));
+# endif
+ /* Region is free, well aligned and big
+ * enough: we are done */
+ if (memory_info.State == MEM_FREE &&
+ (unsigned) memory_info.BaseAddress %
+ g_regionsize == 0
+ &&
+ memory_info.RegionSize >= (unsigned)
+ reserve_size) {
+ found = TRUE;
+ break;
+ }
+ /* From now on we can't get contiguous memory! */
+ contiguous = FALSE;
+ /* Recompute size to reserve */
+ reserve_size = CEIL (allocate_size,
+ g_my_regionsize);
+ memory_info.BaseAddress =
+ (char *) memory_info.BaseAddress +
+ memory_info.RegionSize;
+ /* Assert preconditions */
+ assert ((unsigned) memory_info.BaseAddress
+ % g_pagesize == 0);
+ assert (0 < reserve_size && reserve_size
+ % g_regionsize == 0);
+ }
+ /* Search failed? */
+ if (! found)
+ goto sbrk_exit;
+ /* Assert preconditions */
+ assert ((unsigned) memory_info.BaseAddress
+ % g_regionsize == 0);
+ assert (0 < reserve_size && reserve_size
+ % g_regionsize == 0);
+ /* Try to reserve this */
+ base_reserved = VirtualAlloc (memory_info.BaseAddress,
+ reserve_size,
+ MEM_RESERVE,
+ PAGE_NOACCESS);
+ if (! base_reserved) {
+ int rc = GetLastError ();
+ if (rc != ERROR_INVALID_ADDRESS)
+ goto sbrk_exit;
+ }
+ /* A null pointer signals (hopefully) a race
+ * condition with another thread. */
+ /* In this case, we try again. */
+ } while (! base_reserved);
+ /* Check returned pointer for consistency */
+ if (memory_info.BaseAddress &&
+ base_reserved != memory_info.BaseAddress)
+ goto sbrk_exit;
+ /* Assert postconditions */
+ assert ((unsigned) base_reserved % g_regionsize == 0);
+# ifdef TRACE
+ Parrot_io_printf (NULL, "Reserve %p %d\n", base_reserved,
+ reserve_size);
+# endif
+ /* Did we get contiguous memory? */
+ if (contiguous) {
+ long start_size = (char *) g_last->top_committed -
+ (char *) g_last->top_allocated;
+ /* Adjust allocation size */
+ allocate_size -= start_size;
+ /* Adjust the regions allocation top */
+ g_last->top_allocated = g_last->top_committed;
+ /* Recompute the size to commit */
+ to_commit = (char *) g_last->top_allocated +
+ allocate_size - (char *) g_last->top_committed;
+ /* Round size to commit */
+ commit_size = CEIL (to_commit, g_my_pagesize);
+ }
+ /* Append the new region to the list */
+ if (! region_list_append (&g_last, base_reserved,
+ reserve_size))
+ goto sbrk_exit;
+ /* Didn't we get contiguous memory? */
+ if (! contiguous) {
+ /* Recompute the size to commit */
+ to_commit = (char *) g_last->top_allocated +
+ allocate_size - (char *) g_last->top_committed;
+ /* Round size to commit */
+ commit_size = CEIL (to_commit, g_my_pagesize);
+ }
+ }
+ }
+ /* Assert preconditions */
+ assert ((unsigned) g_last->top_committed % g_pagesize == 0);
+ assert (0 < commit_size && commit_size % g_pagesize == 0); {
+ /* Commit this */
+ void *base_committed = VirtualAlloc (g_last->top_committed,
+ commit_size,
+ MEM_COMMIT,
+ PAGE_READWRITE);
+ /* Check returned pointer for consistency */
+ if (base_committed != g_last->top_committed)
+ goto sbrk_exit;
+ /* Assert postconditions */
+ assert ((unsigned) base_committed % g_pagesize == 0);
+# ifdef TRACE
+ Parrot_io_printf(NULL, "Commit %p %d\n", base_committed, commit_size);
+# endif
+ /* Adjust the regions commit top */
+ g_last->top_committed = (char *) base_committed + commit_size;
+ }
+ }
+ /* Adjust the regions allocation top */
+ g_last->top_allocated = (char *) g_last->top_allocated + allocate_size;
+ result = (char *) g_last->top_allocated - size;
+ /* Deallocation requested? */
+ }
+ else if (size < 0) {
+ long deallocate_size = - size;
+ /* As long as we have a region to release */
+ while ((char *) g_last->top_allocated - deallocate_size
+ < (char *) g_last->top_reserved - g_last->reserve_size) {
+ /* Get the size to release */
+ long release_size = g_last->reserve_size;
+ /* Get the base address */
+ void *base_reserved = (char *) g_last->top_reserved - release_size;
+ /* Assert preconditions */
+ assert ((unsigned) base_reserved % g_regionsize == 0);
+ assert (0 < release_size && release_size % g_regionsize == 0); {
+ /* Release this */
+ int rc = VirtualFree (base_reserved, 0,
+ MEM_RELEASE);
+ /* Check returned code for consistency */
+ if (! rc)
+ goto sbrk_exit;
+# ifdef TRACE
+ Parrot_io_printf(NULL, "Release %p %d\n", base_reserved,release_size);
+# endif
+ }
+ /* Adjust deallocation size */
+ deallocate_size -=
+ (char *) g_last->top_allocated - (char *) base_reserved;
+ /* Remove the old region from the list */
+ if (! region_list_remove (&g_last))
+ goto sbrk_exit;
+ } {
+ /* Compute the size to decommit */
+ long to_decommit = (char *) g_last->top_committed -
+ ((char *) g_last->top_allocated - deallocate_size);
+ if (to_decommit >= g_my_pagesize) {
+ /* Compute the size to decommit */
+ long decommit_size = FLOOR (to_decommit, g_my_pagesize);
+ /* Compute the base address */
+ void *base_committed = (char *) g_last->top_committed -
+ decommit_size;
+ /* Assert preconditions */
+ assert ((unsigned) base_committed % g_pagesize == 0);
+ assert (0 < decommit_size && decommit_size % g_pagesize == 0); {
+ /* Decommit this */
+ int rc = VirtualFree((char *) base_committed, decommit_size,
+ MEM_DECOMMIT);
+ /* Check returned code for consistency */
+ if (! rc)
+ goto sbrk_exit;
+# ifdef TRACE
+ Parrot_io_printf (NULL, "Decommit %p %d\n",
+ base_committed, decommit_size);
+# endif
+ }
+ /* Adjust deallocation size and regions commit and
+ * allocate top */
+ deallocate_size -= (char *) g_last->top_allocated -
+ (char *) base_committed;
+ g_last->top_committed = base_committed;
+ g_last->top_allocated = base_committed;
+ }
+ }
+ /* Adjust regions allocate top */
+ g_last->top_allocated = (char *)g_last->top_allocated - deallocate_size;
+ /* Check for underflow */
+ if ((char *) g_last->top_reserved - g_last->reserve_size
+ > (char *) g_last->top_allocated ||
+ g_last->top_allocated > g_last->top_committed) {
+ /* Adjust regions allocate top */
+ g_last->top_allocated = (char *) g_last->top_reserved
+ - g_last->reserve_size;
+ goto sbrk_exit;
+ }
+ result = g_last->top_allocated;
+ }
+ /* Assert invariants */
+ assert (g_last);
+ assert ((char *) g_last->top_reserved - g_last->reserve_size
+ <= (char *) g_last->top_allocated &&
+ g_last->top_allocated <= g_last->top_committed);
+ assert ((char *) g_last->top_reserved - g_last->reserve_size
+ <= (char *) g_last->top_committed &&
+ g_last->top_committed <= g_last->top_reserved &&
+ (unsigned) g_last->top_committed % g_pagesize == 0);
+ assert ((unsigned) g_last->top_reserved % g_regionsize == 0);
+ assert ((unsigned) g_last->reserve_size % g_regionsize == 0);
+
+sbrk_exit:
+# if defined (USE_MALLOC_LOCK) && defined (NEEDED)
+ /* Release spin lock */
+ slrelease (&g_sl);
+# endif
+ return result;
+}
+
+/* mmap for windows */
+static void *mmap (void *ptr, long size, long prot, long type,
+ long handle, long arg) {
+ static long g_pagesize;
+ static long g_regionsize;
+# ifdef TRACE
+ Parrot_io_printf (NULL, "mmap %d\n", size);
+# endif
+# if defined (USE_MALLOC_LOCK) && defined (NEEDED)
+ /* Wait for spin lock */
+ slwait (&g_sl);
+# endif
+ /* First time initialization */
+ if (! g_pagesize)
+ g_pagesize = getpagesize ();
+ if (! g_regionsize)
+ g_regionsize = getregionsize ();
+ /* Assert preconditions */
+ assert ((unsigned) ptr % g_regionsize == 0);
+ assert (size % g_pagesize == 0);
+ /* Allocate this */
+ ptr = VirtualAlloc (ptr, size,
+ MEM_RESERVE | MEM_COMMIT | MEM_TOP_DOWN, PAGE_READWRITE);
+ if (! ptr) {
+ ptr = (void *) MORECORE_FAILURE;
+ goto mmap_exit;
+ }
+ /* Assert postconditions */
+ assert ((unsigned) ptr % g_regionsize == 0);
+# ifdef TRACE
+ Parrot_io_printf (NULL, "Commit %p %d\n", ptr, size);
+# endif
+mmap_exit:
+# if defined (USE_MALLOC_LOCK) && defined (NEEDED)
+ /* Release spin lock */
+ slrelease (&g_sl);
+# endif
+ return ptr;
+}
+
+/* munmap for windows */
+static long munmap (void *ptr, long size) {
+ static long g_pagesize;
+ static long g_regionsize;
+ int rc = MUNMAP_FAILURE;
+# ifdef TRACE
+ Parrot_io_printf (NULL, "munmap %p %d\n", ptr, size);
+# endif
+# if defined (USE_MALLOC_LOCK) && defined (NEEDED)
+ /* Wait for spin lock */
+ slwait (&g_sl);
+# endif
+ /* First time initialization */
+ if (! g_pagesize)
+ g_pagesize = getpagesize ();
+ if (! g_regionsize)
+ g_regionsize = getregionsize ();
+ /* Assert preconditions */
+ assert ((unsigned) ptr % g_regionsize == 0);
+ assert (size % g_pagesize == 0);
+ /* Free this */
+ if (! VirtualFree (ptr, 0,
+ MEM_RELEASE))
+ goto munmap_exit;
+ rc = 0;
+# ifdef TRACE
+ Parrot_io_printf (NULL, "Release %p %d\n", ptr, size);
+# endif
+munmap_exit:
+# if defined (USE_MALLOC_LOCK) && defined (NEEDED)
+ /* Release spin lock */
+ slrelease (&g_sl);
+# endif
+ return rc;
+}
+
+static void vminfo (CHUNK_SIZE_T *free, CHUNK_SIZE_T *reserved,
+ CHUNK_SIZE_T *committed) {
+ MEMORY_BASIC_INFORMATION memory_info;
+ memory_info.BaseAddress = 0;
+ *free = *reserved = *committed = 0;
+ while (VirtualQuery (memory_info.BaseAddress, &memory_info,
+ sizeof (memory_info))) {
+ switch (memory_info.State) {
+ case MEM_FREE:
+ *free += memory_info.RegionSize;
+ break;
+ case MEM_RESERVE:
+ *reserved += memory_info.RegionSize;
+ break;
+ case MEM_COMMIT:
+ *committed += memory_info.RegionSize;
+ break;
+ }
+ memory_info.BaseAddress = (char *) memory_info.BaseAddress +
+ memory_info.RegionSize;
+ }
+}
+
+static int cpuinfo (int whole, CHUNK_SIZE_T *kernel, CHUNK_SIZE_T *user) {
+ if (whole) {
+ __int64 creation64, exit64, kernel64, user64;
+ int rc = GetProcessTimes (GetCurrentProcess (),
+ (FILETIME *) &creation64,
+ (FILETIME *) &exit64,
+ (FILETIME *) &kernel64,
+ (FILETIME *) &user64);
+ if (! rc) {
+ *kernel = 0;
+ *user = 0;
+ return FALSE;
+ }
+ *kernel = (CHUNK_SIZE_T) (kernel64 / 10000);
+ *user = (CHUNK_SIZE_T) (user64 / 10000);
+ return TRUE;
+ }
+ else {
+ __int64 creation64, exit64, kernel64, user64;
+ int rc = GetThreadTimes (GetCurrentThread (),
+ (FILETIME *) &creation64,
+ (FILETIME *) &exit64,
+ (FILETIME *) &kernel64,
+ (FILETIME *) &user64);
+ if (! rc) {
+ *kernel = 0;
+ *user = 0;
+ return FALSE;
+ }
+ *kernel = (CHUNK_SIZE_T) (kernel64 / 10000);
+ *user = (CHUNK_SIZE_T) (user64 / 10000);
+ return TRUE;
+ }
+}
+
+#endif /* WIN32 */
+
+/* ------------------------------------------------------------
+History:
+ V2.7.2 Sat Aug 17 09:07:30 2002 Doug Lea (dl at gee)
+ * Fix malloc_state bitmap array misdeclaration
+
+ V2.7.1 Thu Jul 25 10:58:03 2002 Doug Lea (dl at gee)
+ * Allow tuning of FIRST_SORTED_BIN_SIZE
+ * Use PTR_UINT as type for all ptr->int casts. Thanks to John Belmonte.
+ * Better detection and support for non-contiguousness of MORECORE.
+ Thanks to Andreas Mueller, Conal Walsh, and Wolfram Gloger
+ * Bypass most of malloc if no frees. Thanks To Emery Berger.
+ * Fix freeing of old top non-contiguous chunk im sysmalloc.
+ * Raised default trim and map thresholds to 256K.
+ * Fix mmap-related #defines. Thanks to Lubos Lunak.
+ * Fix copy macros; added LACKS_FCNTL_H. Thanks to Neal Walfield.
+ * Branch-free bin calculation
+ * Default trim and mmap thresholds now 256K.
+
+ V2.7.0 Sun Mar 11 14:14:06 2001 Doug Lea (dl at gee)
+ * Introduce independent_comalloc and independent_calloc.
+ Thanks to Michael Pachos for motivation and help.
+ * Make optional .h file available
+ * Allow > 2GB requests on 32bit systems.
+ * new WIN32 sbrk, mmap, munmap, lock code from <Walter at GeNeSys-e.de>.
+ Thanks also to Andreas Mueller <a.mueller at paradatec.de>,
+ and Anonymous.
+ * Allow override of MALLOC_ALIGNMENT (Thanks to Ruud Waij for
+ helping test this.)
+ * memalign: check alignment arg
+ * realloc: don't try to shift chunks backwards, since this
+ leads to more fragmentation in some programs and doesn't
+ seem to help in any others.
+ * Collect all cases in malloc requiring system memory into sYSMALLOc
+ * Use mmap as backup to sbrk
+ * Place all internal state in malloc_state
+ * Introduce fastbins (although similar to 2.5.1)
+ * Many minor tunings and cosmetic improvements
+ * Introduce USE_PUBLIC_MALLOC_WRAPPERS, USE_MALLOC_LOCK
+ * Introduce MALLOC_FAILURE_ACTION, MORECORE_CONTIGUOUS
+ Thanks to Tony E. Bennett <tbennett at nvidia.com> and others.
+ * Include errno.h to support default failure action.
+
+ V2.6.6 Sun Dec 5 07:42:19 1999 Doug Lea (dl at gee)
+ * return null for negative arguments
+ * Added Several WIN32 cleanups from Martin C. Fong <mcfong at yahoo.com>
+ * Add 'LACKS_SYS_PARAM_H' for those systems without 'sys/param.h'
+ (e.g. WIN32 platforms)
+ * Cleanup header file inclusion for WIN32 platforms
+ * Cleanup code to avoid Microsoft Visual C++ compiler complaints
+ * Add 'USE_DL_PREFIX' to quickly allow co-existence with existing
+ memory allocation routines
+ * Set 'malloc_getpagesize' for WIN32 platforms (needs more work)
+ * Use 'assert' rather than 'ASSERT' in WIN32 code to conform to
+ usage of 'assert' in non-WIN32 code
+ * Improve WIN32 'sbrk()' emulation's 'findRegion()' routine to
+ avoid infinite loop
+ * Always call 'fREe()' rather than 'free()'
+
+ V2.6.5 Wed Jun 17 15:57:31 1998 Doug Lea (dl at gee)
+ * Fixed ordering problem with boundary-stamping
+
+ V2.6.3 Sun May 19 08:17:58 1996 Doug Lea (dl at gee)
+ * Added pvalloc, as recommended by H.J. Liu
+ * Added 64bit pointer support mainly from Wolfram Gloger
+ * Added anonymously donated WIN32 sbrk emulation
+ * Malloc, calloc, getpagesize: add optimizations from Raymond Nijssen
+ * malloc_extend_top: fix mask error that caused wastage after
+ foreign sbrks
+ * Add linux mremap support code from HJ Liu
+
+ V2.6.2 Tue Dec 5 06:52:55 1995 Doug Lea (dl at gee)
+ * Integrated most documentation with the code.
+ * Add support for mmap, with help from
+ Wolfram Gloger (Gloger at lrz.uni-muenchen.de).
+ * Use last_remainder in more cases.
+ * Pack bins using idea from colin at nyx10.cs.du.edu
+ * Use ordered bins instead of best-fit threshold
+ * Eliminate block-local decls to simplify tracing and debugging.
+ * Support another case of realloc via move into top
+ * Fix error occurring when initial sbrk_base not word-aligned.
+ * Rely on page size for units instead of SBRK_UNIT to
+ avoid surprises about sbrk alignment conventions.
+ * Add mallinfo, mallopt. Thanks to Raymond Nijssen
+ (raymond at es.ele.tue.nl) for the suggestion.
+ * Add `pad' argument to malloc_trim and top_pad mallopt parameter.
+ * More precautions for cases where other routines call sbrk,
+ courtesy of Wolfram Gloger (Gloger at lrz.uni-muenchen.de).
+ * Added macros etc., allowing use in linux libc from
+ H.J. Lu (hjl at gnu.ai.mit.edu)
+ * Inverted this history list
+
+ V2.6.1 Sat Dec 2 14:10:57 1995 Doug Lea (dl at gee)
+ * Re-tuned and fixed to behave more nicely with V2.6.0 changes.
+ * Removed all preallocation code since under current scheme
+ the work required to undo bad preallocations exceeds
+ the work saved in good cases for most test programs.
+ * No longer use return list or unconsolidated bins since
+ no scheme using them consistently outperforms those that don't
+ given above changes.
+ * Use best fit for very large chunks to prevent some worst-cases.
+ * Added some support for debugging
+
+ V2.6.0 Sat Nov 4 07:05:23 1995 Doug Lea (dl at gee)
+ * Removed footers when chunks are in use. Thanks to
+ Paul Wilson (wilson at cs.texas.edu) for the suggestion.
+
+ V2.5.4 Wed Nov 1 07:54:51 1995 Doug Lea (dl at gee)
+ * Added malloc_trim, with help from Wolfram Gloger
+ (wmglo at Dent.MED.Uni-Muenchen.DE).
+
+ V2.5.3 Tue Apr 26 10:16:01 1994 Doug Lea (dl at g)
+
+ V2.5.2 Tue Apr 5 16:20:40 1994 Doug Lea (dl at g)
+ * realloc: try to expand in both directions
+ * malloc: swap order of clean-bin strategy;
+ * realloc: only conditionally expand backwards
+ * Try not to scavenge used bins
+ * Use bin counts as a guide to preallocation
+ * Occasionally bin return list chunks in first scan
+ * Add a few optimizations from colin at nyx10.cs.du.edu
+
+ V2.5.1 Sat Aug 14 15:40:43 1993 Doug Lea (dl at g)
+ * faster bin computation & slightly different binning
+ * merged all consolidations to one part of malloc proper
+ (eliminating old malloc_find_space & malloc_clean_bin)
+ * Scan 2 returns chunks (not just 1)
+ * Propagate failure in realloc if malloc returns 0
+ * Add stuff to allow compilation on non-ANSI compilers
+ from kpv at research.att.com
+
+ V2.5 Sat Aug 7 07:41:59 1993 Doug Lea (dl at g.oswego.edu)
+ * removed potential for odd address access in prev_chunk
+ * removed dependency on getpagesize.h
+ * misc cosmetics and a bit more internal documentation
+ * anticosmetics: mangled names in macros to evade debugger strangeness
+ * tested on sparc, hp-700, dec-mips, rs6000
+ with gcc & native cc (hp, dec only) allowing
+ Detlefs & Zorn comparison study (in SIGPLAN Notices.)
+
+ Trial version Fri Aug 28 13:14:29 1992 Doug Lea (dl at g.oswego.edu)
+ * Based loosely on libg++-1.2X malloc. (It retains some of the overall
+ structure of old version, but most details differ.)
+
+*/
+
+/*
+ * Local variables:
+ * c-file-style: "parrot"
+ * End:
+ * vim: expandtab shiftwidth=4:
+ */
Copied: branches/pmc_pct/src/gc/malloc_trace.c (from r39376, trunk/src/gc/malloc_trace.c)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/pmc_pct/src/gc/malloc_trace.c Thu Jun 4 02:32:48 2009 (r39377, copy of r39376, trunk/src/gc/malloc_trace.c)
@@ -0,0 +1,353 @@
+/* malloc-trace.c
+ *
+ * by Wolfram Gloger 1995.
+ *
+ * $Id$
+ * Copyright (C) 2002-2007, Parrot Foundation.
+ */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <unistd.h>
+#include <fcntl.h>
+#include <string.h>
+#include <sys/time.h>
+#ifdef __linux__
+# include <signal.h>
+# include <asm/signal.h>
+#endif
+
+#include "malloc-trace.h"
+
+#define ACTION_BUF_SIZE 1024
+#define TIMESTAMP_FREQ 50
+#define LOG_NAME "/tmp/mtrace"
+
+static void malloc_trace_destructor(void);
+
+static ACTION buffer[ACTION_BUF_SIZE+1];
+static int buffer_i = 0;
+static int fd = -1;
+static int tracing = 1;
+static int pid = 0;
+static char *initial_brk = 0;
+
+/*
+
+=head1 NAME
+
+src/malloc-trace.c
+
+=head1 DESCRIPTION
+
+RT#48264
+
+=head2 Functions
+
+=over 4
+
+=cut
+
+*/
+
+/*
+
+=item C<static void open_log_file()>
+
+Open a logfile for storing debugging information.
+
+=cut
+
+*/
+
+static void
+open_log_file()
+{
+ char name[128];
+ const unsigned version = MTRACE_VERSION;
+#ifdef __linux__
+ char cmdline[128], *s;
+ int count, fd2;
+#endif
+
+ tracing = 0;
+ pid = getpid();
+#ifdef __linux__
+ sprintf(name, "/proc/%d/cmdline", pid);
+ fd2 = open(name, O_RDONLY);
+ if (fd2>=0 && (count = read(fd2, cmdline, 127)) > 0) {
+ close(fd2);
+ cmdline[count] = 0;
+ for (s=cmdline; *s++;); s--;
+ while (--s>cmdline && *s!='/');
+ if (*s == '/') s++;
+ sprintf(name, LOG_NAME ".%.12s.%d", s, pid);
+ }
+ else {
+ sprintf(name, LOG_NAME ".%d", pid);
+ }
+#else
+ sprintf(name, LOG_NAME ".%d", pid);
+#endif
+ fd = open(name, O_WRONLY|O_CREAT, 0600);
+ if (fd >= 0) {
+ write(fd, &version, sizeof (version));
+ write(fd, &initial_brk, sizeof (initial_brk));
+ }
+ tracing = 1;
+}
+
+/*
+
+=item C<static void malloc_trace_destructor(void)>
+
+Print out a final timestamp and message to the log file.
+
+=cut
+
+*/
+
+static void
+malloc_trace_destructor(void)
+{
+ struct timeval t;
+
+ /* produce final timestamp */
+ gettimeofday(&t, NULL);
+ buffer[buffer_i].code = CODE_TIMESTAMP;
+ buffer[buffer_i].size = t.tv_sec;
+ buffer[buffer_i].ptr = (void *)t.tv_usec;
+ buffer[buffer_i].ptr2 = NULL;
+ buffer_i++;
+ if (fd < 0) open_log_file();
+ if (getpid() != pid) { /* Oops, must have forked... */
+ if (fd >= 0) close(fd);
+ return;
+ }
+ if (fd >= 0) write(fd, buffer, buffer_i*sizeof (ACTION));
+ write(2, "<end malloc trace>\n", 19);
+ if (fd >= 0) close(fd);
+}
+
+#ifdef __linux__
+
+/*
+
+=item C<static void malloc_segv_handler(int i, struct sigcontext_struct sc)>
+
+Catch a segfault signal, print an error message, and end the logfile.
+
+=cut
+
+*/
+
+static void
+malloc_segv_handler(int i, struct sigcontext_struct sc)
+{
+ tracing = 0;
+ fprintf(stderr, "malloc-trace: caught SEGV signal.\n");
+ fprintf(stderr, "sc.cr2 = %8lx\n", (unsigned long)sc.cr2);
+ malloc_trace_destructor();
+}
+
+#endif
+
+/*
+
+=item C<static void malloc_record(int code, size_t size, void *ptr, void *ptr2)>
+
+Record information about the allocation into the logfile.
+
+=cut
+
+*/
+
+static void
+malloc_record(int code, size_t size, void *ptr, void *ptr2)
+{
+ static long count = 0;
+ struct timeval t;
+
+ if (!tracing) return;
+#ifdef __linux__
+ if (count == 0) signal(SIGSEGV, (void (*)(int))malloc_segv_handler);
+#endif
+ if ((count++ % TIMESTAMP_FREQ) == 0) {
+ gettimeofday(&t, NULL);
+ buffer[buffer_i].code = CODE_TIMESTAMP;
+ buffer[buffer_i].size = t.tv_sec;
+ buffer[buffer_i].ptr = (void *)t.tv_usec;
+ buffer[buffer_i].ptr2 = NULL;
+ buffer_i++;
+ }
+ buffer[buffer_i].code = code;
+ buffer[buffer_i].size = size;
+ buffer[buffer_i].ptr = ptr;
+ buffer[buffer_i].ptr2 = ptr2;
+ if (++buffer_i >= ACTION_BUF_SIZE) {
+ if (fd < 0) open_log_file();
+ if (getpid() != pid) { /* Oops, must have forked... */
+ tracing = 0;
+ return;
+ }
+ if (fd >= 0) write(fd, buffer, buffer_i*sizeof (ACTION));
+ buffer_i = 0;
+ }
+}
+
+void* _real_malloc(size_t bytes);
+
+/*
+
+=item C<void* malloc(size_t bytes)>
+
+Allocate memory with the specified size in bytes. Record information about it
+in the logfile.
+
+=cut
+
+*/
+
+void* malloc(size_t bytes)
+{
+ void *ptr;
+
+ if (initial_brk == 0) { /* Must be the first time. */
+ initial_brk = sbrk(0);
+ atexit(malloc_trace_destructor);
+ }
+ ptr = _real_malloc(bytes);
+ malloc_record(CODE_MALLOC, bytes, ptr, 0);
+ return ptr;
+}
+#define malloc _real_malloc
+
+void _real_free(void* mem);
+
+/*
+
+=item C<void free(void* mem)>
+
+Record information about the free in the logfile, and free the memory.
+
+=cut
+
+*/
+
+void free(void* mem)
+{
+ malloc_record(CODE_FREE, 0, mem, 0);
+ _real_free(mem);
+}
+#define free _real_free
+
+void* _real_realloc(void* mem, size_t bytes);
+
+/*
+
+=item C<void* realloc(void* mem, size_t bytes)>
+
+Resize the allocated memory buffer to the new size.
+
+=cut
+
+*/
+
+void* realloc(void* mem, size_t bytes)
+{
+ void *ptr;
+
+ ptr = _real_realloc(mem, bytes);
+ malloc_record(CODE_REALLOC, bytes, mem, ptr);
+ return ptr;
+}
+#define realloc _real_realloc
+
+void* _real_memalign(size_t alignment, size_t bytes);
+
+/*
+
+=item C<void* memalign(size_t alignment, size_t bytes)>
+
+Return an allocated memory buffer that's of at least the given size in bytes
+and is aligned along the given boundary.
+
+=cut
+
+*/
+
+void* memalign(size_t alignment, size_t bytes)
+{
+ void *ptr;
+
+ if (initial_brk == 0) { /* Must be the first time. */
+ initial_brk = sbrk(0);
+ atexit(malloc_trace_destructor);
+ }
+ ptr = _real_memalign(alignment, bytes);
+ malloc_record(CODE_MEMALIGN, bytes, ptr, (void*)alignment);
+ return ptr;
+}
+#define memalign _real_memalign
+
+void* _real_calloc(size_t n, size_t elem_size);
+
+/*
+
+=item C<void* calloc(size_t n, size_t elem_size)>
+
+Allocate memory of the given size, initializing the memory to the given value.
+
+=cut
+
+*/
+
+void* calloc(size_t n, size_t elem_size)
+{
+ void *ptr;
+
+ if (initial_brk == 0) { /* Must be the first time. */
+ initial_brk = sbrk(0);
+ atexit(malloc_trace_destructor);
+ }
+ ptr = _real_calloc(n, elem_size);
+ malloc_record(CODE_CALLOC, n*elem_size, ptr, 0);
+ return ptr;
+}
+#define calloc _real_calloc
+
+void _real_cfree(void *mem);
+
+/*
+
+=item C<void cfree(void *mem)>
+
+free the given buffer, recording information about it in the log.
+
+=cut
+
+*/
+
+void cfree(void *mem)
+{
+ malloc_record(CODE_CFREE, 0, mem, 0);
+ _real_cfree(mem);
+}
+#define cfree _real_cfree
+
+#include "malloc.c"
+
+/*
+
+=back
+
+=cut
+
+*/
+
+/*
+ * Local variables:
+ * c-file-style: "parrot"
+ * End:
+ * vim: expandtab shiftwidth=4:
+ */
Modified: branches/pmc_pct/src/gc/mark_sweep.c
==============================================================================
--- branches/pmc_pct/src/gc/mark_sweep.c Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/gc/mark_sweep.c Thu Jun 4 02:32:48 2009 (r39377)
@@ -8,8 +8,12 @@
=head1 DESCRIPTION
-Handles the accessing of small object pools (header pools). All of the
-mark/sweep garbage collectors use this code.
+This file implements a number of routines related to the mark and sweep phases
+of the garbage collector system. The functions in this file attempt to perform
+various useful utilities without interfering with the operations of the
+particular GC core. Individual GC cores may choose to use these functions or
+to reimplement their functionality, hopefully without causing any problems
+throughout the rest of Parrot.
=head2 Functions
@@ -27,240 +31,125 @@
/* HEADERIZER BEGIN: static */
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
-static void clear_live_bits(ARGIN(const Small_Object_Pool *pool))
- __attribute__nonnull__(1);
-
-static void gc_ms_add_free_object(SHIM_INTERP,
+static void free_buffer(SHIM_INTERP,
ARGMOD(Small_Object_Pool *pool),
- ARGIN(void *to_add))
+ ARGMOD(PObj *b))
__attribute__nonnull__(2)
__attribute__nonnull__(3)
- FUNC_MODIFIES(*pool);
+ FUNC_MODIFIES(*pool)
+ FUNC_MODIFIES(*b);
-static void gc_ms_add_free_pmc_ext(SHIM_INTERP,
- ARGMOD(Small_Object_Pool *pool),
- ARGIN(void *to_add))
- __attribute__nonnull__(2)
+static void free_buffer_malloc(SHIM_INTERP,
+ SHIM(Small_Object_Pool *pool),
+ ARGMOD(PObj *b))
__attribute__nonnull__(3)
- FUNC_MODIFIES(*pool);
+ FUNC_MODIFIES(*b);
-static void gc_ms_alloc_objects(PARROT_INTERP,
- ARGMOD(Small_Object_Pool *pool))
+static void free_pmc_in_pool(PARROT_INTERP,
+ SHIM(Small_Object_Pool *pool),
+ ARGMOD(PObj *p))
__attribute__nonnull__(1)
- __attribute__nonnull__(2)
- FUNC_MODIFIES(*pool);
+ __attribute__nonnull__(3)
+ FUNC_MODIFIES(*p);
-PARROT_CANNOT_RETURN_NULL
PARROT_WARN_UNUSED_RESULT
-static void * gc_ms_get_free_object(PARROT_INTERP,
- ARGMOD(Small_Object_Pool *pool))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- FUNC_MODIFIES(*pool);
-
PARROT_CANNOT_RETURN_NULL
-PARROT_WARN_UNUSED_RESULT
-static void * gc_ms_get_free_pmc_ext(PARROT_INTERP,
- ARGMOD(Small_Object_Pool *pool))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- FUNC_MODIFIES(*pool);
+static Small_Object_Pool * new_buffer_pool(PARROT_INTERP)
+ __attribute__nonnull__(1);
-static void gc_ms_pool_init(SHIM_INTERP, ARGMOD(Small_Object_Pool *pool))
- __attribute__nonnull__(2)
- FUNC_MODIFIES(*pool);
+PARROT_WARN_UNUSED_RESULT
+PARROT_CANNOT_RETURN_NULL
+static Small_Object_Pool * new_bufferlike_pool(PARROT_INTERP,
+ size_t actual_buffer_size)
+ __attribute__nonnull__(1);
-static void more_traceable_objects(PARROT_INTERP,
- ARGMOD(Small_Object_Pool *pool))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- FUNC_MODIFIES(*pool);
+PARROT_WARN_UNUSED_RESULT
+PARROT_CANNOT_RETURN_NULL
+static Small_Object_Pool * new_pmc_pool(PARROT_INTERP)
+ __attribute__nonnull__(1);
-static int sweep_cb(PARROT_INTERP,
- ARGMOD(Small_Object_Pool *pool),
- int flag,
- ARGMOD(void *arg))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- __attribute__nonnull__(4)
- FUNC_MODIFIES(*pool)
- FUNC_MODIFIES(*arg);
+PARROT_MALLOC
+PARROT_CANNOT_RETURN_NULL
+static Small_Object_Pool * new_small_object_pool(
+ size_t object_size,
+ size_t objects_per_alloc);
-static int trace_active_PMCs(PARROT_INTERP, Parrot_gc_trace_type trace)
+PARROT_WARN_UNUSED_RESULT
+PARROT_CANNOT_RETURN_NULL
+static Small_Object_Pool * new_string_pool(PARROT_INTERP, INTVAL constant)
__attribute__nonnull__(1);
-#define ASSERT_ARGS_clear_live_bits __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(pool)
-#define ASSERT_ARGS_gc_ms_add_free_object __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(pool) \
- || PARROT_ASSERT_ARG(to_add)
-#define ASSERT_ARGS_gc_ms_add_free_pmc_ext __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+#define ASSERT_ARGS_free_buffer __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(pool) \
- || PARROT_ASSERT_ARG(to_add)
-#define ASSERT_ARGS_gc_ms_alloc_objects __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(pool)
-#define ASSERT_ARGS_gc_ms_get_free_object __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(pool)
-#define ASSERT_ARGS_gc_ms_get_free_pmc_ext __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ || PARROT_ASSERT_ARG(b)
+#define ASSERT_ARGS_free_buffer_malloc __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(b)
+#define ASSERT_ARGS_free_pmc_in_pool __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(pool)
-#define ASSERT_ARGS_gc_ms_pool_init __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(pool)
-#define ASSERT_ARGS_more_traceable_objects __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(pool)
-#define ASSERT_ARGS_sweep_cb __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(pool) \
- || PARROT_ASSERT_ARG(arg)
-#define ASSERT_ARGS_trace_active_PMCs __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ || PARROT_ASSERT_ARG(p)
+#define ASSERT_ARGS_new_buffer_pool __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
+#define ASSERT_ARGS_new_bufferlike_pool __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
+#define ASSERT_ARGS_new_pmc_pool __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
+#define ASSERT_ARGS_new_small_object_pool __attribute__unused__ int _ASSERT_ARGS_CHECK = 0
+#define ASSERT_ARGS_new_string_pool __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp)
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
/* HEADERIZER END: static */
-
-#define GC_DEBUG_REPLENISH_LEVEL_FACTOR 0.0
-#define GC_DEBUG_UNITS_PER_ALLOC_GROWTH_FACTOR 1
-#define REPLENISH_LEVEL_FACTOR 0.3
-
-/* this factor is totally arbitrary, but gives good timings for stress.pasm */
-#define UNITS_PER_ALLOC_GROWTH_FACTOR 1.75
-
-#define POOL_MAX_BYTES 65536 * 128
-
/* Set when walking the system stack */
int CONSERVATIVE_POINTER_CHASING = 0;
/*
-=item C<void Parrot_gc_ms_run(PARROT_INTERP, UINTVAL flags)>
+=item C<void Parrot_gc_run_init(PARROT_INTERP)>
-Runs the stop-the-world mark & sweep (MS) collector.
+Prepares the collector for a mark & sweep GC run. Initializes the various
+fields in the Arenas structure that need to be zeroed out prior to the
+mark phase.
=cut
*/
void
-Parrot_gc_ms_run(PARROT_INTERP, UINTVAL flags)
+Parrot_gc_run_init(PARROT_INTERP)
{
- ASSERT_ARGS(Parrot_gc_ms_run)
- Arenas * const arena_base = interp->arena_base;
-
- /* XXX these should go into the interpreter */
- int total_free = 0;
-
- if (arena_base->gc_mark_block_level)
- return;
-
- if (interp->pdb && interp->pdb->debugger) {
- /*
- * if the other interpreter did a GC mark run, it can set
- * live bits of shared objects, but these aren't reset, because
- * they are in a different arena. When now such a PMC points to
- * other non-shared object, these wouldn't be marked and hence
- * collected.
- */
- Parrot_gc_clear_live_bits(interp);
- }
-
- /*
- * the sync sweep is always at the end, so that
- * the live bits are cleared
- */
- if (flags & GC_finish_FLAG) {
- clear_live_bits(interp->arena_base->pmc_pool);
- clear_live_bits(interp->arena_base->constant_pmc_pool);
-
- /* keep the scheduler and its kids alive for Task-like PMCs to destroy
- * themselves; run a sweep to collect them */
- if (interp->scheduler) {
- Parrot_gc_mark_PObj_alive(interp, (PObj *)interp->scheduler);
- VTABLE_mark(interp, interp->scheduler);
- Parrot_gc_sweep(interp, interp->arena_base->pmc_pool);
- }
-
- /* now sweep everything that's left */
- Parrot_gc_sweep(interp, interp->arena_base->pmc_pool);
- Parrot_gc_sweep(interp, interp->arena_base->constant_pmc_pool);
-
- return;
- }
-
- ++arena_base->gc_mark_block_level;
- arena_base->lazy_gc = flags & GC_lazy_FLAG;
-
- /* tell the threading system that we're doing GC mark */
- pt_gc_start_mark(interp);
- Parrot_gc_ms_run_init(interp);
-
- /* compact STRING pools to collect free headers and allocated buffers */
- Parrot_gc_compact_memory_pool(interp);
-
- /* Now go trace the PMCs */
- if (trace_active_PMCs(interp, (flags & GC_trace_stack_FLAG)
- ? GC_TRACE_FULL
- : GC_TRACE_ROOT_ONLY)) {
- int ignored;
-
- arena_base->gc_trace_ptr = NULL;
- arena_base->gc_mark_ptr = NULL;
-
- /* mark is now finished */
- pt_gc_stop_mark(interp);
-
- /* Now put unused PMCs and Buffers on the free list */
- ignored = Parrot_forall_header_pools(interp, POOL_BUFFER | POOL_PMC,
- (void*)&total_free, sweep_cb);
- UNUSED(ignored);
-
- if (interp->profile)
- Parrot_gc_profile_end(interp, PARROT_PROF_GC_cb);
- }
- else {
- pt_gc_stop_mark(interp); /* XXX */
-
- /* successful lazy mark run count */
- ++arena_base->gc_lazy_mark_runs;
-
- Parrot_gc_clear_live_bits(interp);
- if (interp->profile)
- Parrot_gc_profile_end(interp, PARROT_PROF_GC_p2);
- }
-
- /* Note it */
- arena_base->gc_mark_runs++;
- --arena_base->gc_mark_block_level;
+ ASSERT_ARGS(Parrot_gc_run_init)
+ Arenas * const arena_base = interp->arena_base;
- return;
+ arena_base->gc_trace_ptr = NULL;
+ arena_base->gc_mark_start = NULL;
+ arena_base->num_early_PMCs_seen = 0;
+ arena_base->num_extended_PMCs = 0;
}
-
/*
=item C<int Parrot_gc_trace_root(PARROT_INTERP, Parrot_gc_trace_type trace)>
-Traces the root set. Returns 0 if it's a lazy GC run and all objects
-that need timely destruction were found.
+Traces the root set with behavior that's dependent on the flags passed.
+Returns 0 if it's a lazy GC run and all objects that need timely destruction
+were found. Returns 1 otherwise.
-C<trace_stack> can have these values:
+The flag C<trace> can have these values:
=over 4
-=item * GC_TRACE_FULL
-
-trace whole root set, including system areas
-
=item * GC_TRACE_ROOT_ONLY
-trace normal roots, no system areas
+trace normal roots
=item * GC_TRACE_SYSTEM_ONLY
trace system areas only
+=item * GC_TRACE_FULL
+
+trace whole root set, including system areas.
+
=back
=cut
@@ -293,7 +182,7 @@
= interp->iglobals;
}
- /* mark it as used */
+ /* mark the list of iglobals */
Parrot_gc_mark_PObj_alive(interp, (PObj *)interp->iglobals);
/* mark the current continuation */
@@ -308,15 +197,7 @@
/* mark the dynamic environment. */
mark_stack(interp, interp->dynamic_env);
- /*
- * mark vtable->data
- *
- * XXX these PMCs are constant and shouldn't get collected
- * but t/library/dumper* fails w/o this marking.
- *
- * It seems that the Class PMC gets GCed - these should
- * get created as constant PMCs.
- */
+ /* mark the vtables: the data, Class PMCs, etc. */
mark_vtables(interp);
/* mark the root_namespace */
@@ -346,101 +227,39 @@
/* Walk the iodata */
Parrot_IOData_mark(interp, interp->piodata);
- /* quick check if we can already bail out */
+ if (trace == GC_TRACE_FULL)
+ trace_system_areas(interp);
+
+ /* quick check to see if we have already marked all impatient PMCs. If we
+ have, return 0 and exit here. This will alert other parts of the GC
+ that if we are in a lazy run we can just stop it. */
if (arena_base->lazy_gc
&& arena_base->num_early_PMCs_seen >= arena_base->num_early_gc_PMCs)
return 0;
- /* Find important stuff on the system stack */
- if (trace == GC_TRACE_FULL)
- trace_system_areas(interp);
-
if (interp->profile)
Parrot_gc_profile_end(interp, PARROT_PROF_GC_p1);
return 1;
}
-/*
-
-=item C<void Parrot_gc_ms_run_init(PARROT_INTERP)>
-
-Prepares the collector for a mark & sweep GC run. This is the
-initializer function for the MS garbage collector.
-
-=cut
-
-*/
-
-void
-Parrot_gc_ms_run_init(PARROT_INTERP)
-{
- ASSERT_ARGS(Parrot_gc_ms_run_init)
- Arenas * const arena_base = interp->arena_base;
-
- arena_base->gc_trace_ptr = NULL;
- arena_base->gc_mark_start = NULL;
- arena_base->num_early_PMCs_seen = 0;
- arena_base->num_extended_PMCs = 0;
-}
-
-
-/*
-
-=item C<void Parrot_gc_ms_free_pmc(PARROT_INTERP, Small_Object_Pool *pool, PObj
-*p)>
-
-Frees a PMC that is no longer being used. Calls a custom C<destroy> VTABLE
-method if one is available. If the PMC uses a PMC_EXT structure, that is freed
-as well.
-
-=cut
-
-*/
-
-void
-Parrot_gc_ms_free_pmc(PARROT_INTERP, SHIM(Small_Object_Pool *pool),
- ARGMOD(PObj *p))
-{
- ASSERT_ARGS(Parrot_gc_ms_free_pmc)
- PMC * const pmc = (PMC *)p;
- Arenas * const arena_base = interp->arena_base;
-
- /* TODO collect objects with finalizers */
- if (PObj_needs_early_gc_TEST(p))
- --arena_base->num_early_gc_PMCs;
-
- if (PObj_active_destroy_TEST(p))
- VTABLE_destroy(interp, pmc);
-
- if (PObj_is_PMC_EXT_TEST(p))
- Parrot_gc_free_pmc_ext(interp, pmc);
-
-#ifndef NDEBUG
-
- pmc->pmc_ext = (PMC_EXT *)0xdeadbeef;
- pmc->vtable = (VTABLE *)0xdeadbeef;
-
-#endif
-
-}
/*
-=item C<void Parrot_gc_sweep(PARROT_INTERP, Small_Object_Pool *pool)>
+=item C<void Parrot_gc_sweep_pool(PARROT_INTERP, Small_Object_Pool *pool)>
-Puts any buffers/PMCs that are now unused onto the pool's free list. If
-C<GC_IS_MALLOC>, bufstart gets freed too, if possible. Avoids buffers that
-are immune from collection (i.e. constant).
+Puts any buffers/PMCs that are marked as "dead" or "black" onto the pool
+free list. If C<GC_IS_MALLOC>, bufstart gets freed too, if possible. Avoids
+buffers that are immune from collection (i.e. constant).
=cut
*/
void
-Parrot_gc_sweep(PARROT_INTERP, ARGMOD(Small_Object_Pool *pool))
+Parrot_gc_sweep_pool(PARROT_INTERP, ARGMOD(Small_Object_Pool *pool))
{
- ASSERT_ARGS(Parrot_gc_sweep)
+ ASSERT_ARGS(Parrot_gc_sweep_pool)
UINTVAL total_used = 0;
const UINTVAL object_size = pool->object_size;
@@ -517,8 +336,6 @@
}
-
-
/*
=item C<INTVAL contained_in_pool(const Small_Object_Pool *pool, const void
@@ -544,41 +361,14 @@
(ptrdiff_t)ptr - (ptrdiff_t)arena->start_objects;
if (0 <= ptr_diff
- && ptr_diff < (ptrdiff_t)(arena->used * pool->object_size)
- && ptr_diff % pool->object_size == 0)
+ && ptr_diff < (ptrdiff_t)(arena->used * pool->object_size)
+ && ptr_diff % pool->object_size == 0)
return 1;
}
return 0;
}
-/*
-
-=item C<int Parrot_is_const_pmc(PARROT_INTERP, const PMC *pmc)>
-
-Returns whether C<*pmc> is a constant PMC. The given pointer is a constant
-PMC if it points into the constant PMC pool.
-
-=cut
-
-*/
-
-int
-Parrot_is_const_pmc(PARROT_INTERP, ARGIN(const PMC *pmc))
-{
- ASSERT_ARGS(Parrot_is_const_pmc)
- Small_Object_Pool * const pool = interp->arena_base->constant_pmc_pool;
- const int c = contained_in_pool(pool, pmc);
-
- /* some paranoia first. */
- /* I wonder if it would save any machine cycles to write
- !(PObj_constant_TEST(pmc) ^ c)
- instead. */
- PARROT_ASSERT(!!PObj_constant_TEST(pmc) == !!c);
-
- return c;
-}
-
/*
@@ -614,7 +404,7 @@
if (PObj_is_PMC_shared_TEST(obj)) {
interp = PMC_sync(obj)->owner;
PARROT_ASSERT(interp);
- /* XXX FIXME hack */
+
if (!interp->arena_base->gc_mark_ptr)
interp->arena_base->gc_mark_ptr = obj;
}
@@ -647,13 +437,11 @@
* processed first.
*/
if (hi_prio && tptr) {
- if (PMC_next_for_GC(tptr) == tptr) {
+ if (PMC_next_for_GC(tptr) == tptr)
PMC_next_for_GC(obj) = obj;
- }
- else {
+ else
/* put it at the head of the list */
PMC_next_for_GC(obj) = PMC_next_for_GC(tptr);
- }
PMC_next_for_GC(tptr) = (PMC*)obj;
}
@@ -668,7 +456,6 @@
}
if (PObj_custom_mark_TEST(obj)) {
PObj_get_FLAGS(obj) |= PObj_custom_GC_FLAG;
-
if (!PObj_constant_TEST(obj))
VTABLE_mark(interp, obj);
}
@@ -677,235 +464,21 @@
/*
-=item C<static void more_traceable_objects(PARROT_INTERP, Small_Object_Pool
+=item C<void Parrot_gc_clear_live_bits(PARROT_INTERP, const Small_Object_Pool
*pool)>
-We're out of traceable objects. First we try a GC run to free some up. If
-that doesn't work, allocate a new arena.
-
-=cut
-
-*/
-
-static void
-more_traceable_objects(PARROT_INTERP, ARGMOD(Small_Object_Pool *pool))
-{
- ASSERT_ARGS(more_traceable_objects)
- if (pool->skip)
- pool->skip = 0;
- else {
- Small_Object_Arena * const arena = pool->last_Arena;
- if (arena) {
- if (arena->used == arena->total_objects)
- Parrot_gc_mark_and_sweep(interp, GC_trace_stack_FLAG);
-
- if (pool->num_free_objects <= pool->replenish_level)
- pool->skip = 1;
- }
- }
-
- /* requires that num_free_objects be updated in Parrot_gc_mark_and_sweep. If gc
- * is disabled, then we must check the free list directly. */
- if (!pool->free_list)
- (*pool->alloc_objects) (interp, pool);
-}
-
-/*
-
-=item C<static void gc_ms_add_free_pmc_ext(PARROT_INTERP, Small_Object_Pool
-*pool, void *to_add)>
-
-Add a freed PMC_EXT structure to the free list in the PMC_EXT pool. Objects
-on the free list can be reused later.
-
-=cut
-
-*/
-
-static void
-gc_ms_add_free_pmc_ext(SHIM_INTERP, ARGMOD(Small_Object_Pool *pool), ARGIN(void *to_add))
-{
- ASSERT_ARGS(gc_ms_add_free_pmc_ext)
- PMC_EXT * const object = (PMC_EXT *)to_add;
- object->_metadata = NULL;
-
- /* yes, this cast is a hack for now, but a pointer is a pointer */
- object->_next_for_GC = (PMC *)pool->free_list;
- pool->free_list = object;
-}
-
-/*
-
-=item C<static void gc_ms_add_free_object(PARROT_INTERP, Small_Object_Pool
-*pool, void *to_add)>
-
-Add an unused object back to the pool's free list for later reuse. Set
-the PObj flags to indicate that the item is free.
-
-=cut
-
-*/
-
-static void
-gc_ms_add_free_object(SHIM_INTERP, ARGMOD(Small_Object_Pool *pool), ARGIN(void *to_add))
-{
- ASSERT_ARGS(gc_ms_add_free_object)
- PObj *object = (PObj *)to_add;
-
- PObj_flags_SETTO(object, PObj_on_free_list_FLAG);
-
- ((GC_MS_PObj_Wrapper*)object)->next_ptr = (PObj *)pool->free_list;
- pool->free_list = object;
-}
-
-
-/*
-
-=item C<static void * gc_ms_get_free_object(PARROT_INTERP, Small_Object_Pool
-*pool)>
-
-Free object allocator for the MS garbage collector system. If there are no
-free objects, call C<gc_ms_add_free_object> to either free them up with a
-GC run, or allocate new objects. If there are objects available on the
-free list, pop it off and return it.
-
-=cut
-
-*/
-
-PARROT_CANNOT_RETURN_NULL
-PARROT_WARN_UNUSED_RESULT
-static void *
-gc_ms_get_free_object(PARROT_INTERP, ARGMOD(Small_Object_Pool *pool))
-{
- ASSERT_ARGS(gc_ms_get_free_object)
- PObj *ptr;
- PObj *free_list = (PObj *)pool->free_list;
-
- /* if we don't have any objects */
- if (!free_list) {
- (*pool->more_objects)(interp, pool);
- free_list = (PObj *)pool->free_list;
- }
-
- ptr = free_list;
- pool->free_list = ((GC_MS_PObj_Wrapper*)ptr)->next_ptr;
-
- PObj_flags_SETTO(ptr, 0);
-
- --pool->num_free_objects;
-
- return ptr;
-}
-
-
-/*
-
-=item C<static void * gc_ms_get_free_pmc_ext(PARROT_INTERP, Small_Object_Pool
-*pool)>
-
-Get a new PMC_EXT structure from the free pool and return it.
-
-=cut
-
-*/
-
-PARROT_CANNOT_RETURN_NULL
-PARROT_WARN_UNUSED_RESULT
-static void *
-gc_ms_get_free_pmc_ext(PARROT_INTERP, ARGMOD(Small_Object_Pool *pool))
-{
- ASSERT_ARGS(gc_ms_get_free_pmc_ext)
- PMC_EXT *ptr;
- PMC_EXT *free_list = (PMC_EXT *)pool->free_list;
-
- /* if we don't have any objects */
- if (!free_list) {
- (*pool->more_objects)(interp, pool);
- free_list = (PMC_EXT *)pool->free_list;
- }
-
- ptr = free_list;
- pool->free_list = ptr->_next_for_GC;
- ptr->_next_for_GC = NULL;
-
- --pool->num_free_objects;
-
- return ptr;
-}
-
-
-/*
-
-=item C<static int sweep_cb(PARROT_INTERP, Small_Object_Pool *pool, int flag,
-void *arg)>
-
-Sweeps the given pool for the MS collector. This function also ends
-the profiling timer, if profiling is enabled. Returns the total number
-of objects freed.
-
-=cut
-
-*/
-
-static int
-sweep_cb(PARROT_INTERP, ARGMOD(Small_Object_Pool *pool), int flag,
- ARGMOD(void *arg))
-{
- ASSERT_ARGS(sweep_cb)
- int * const total_free = (int *) arg;
-
- Parrot_gc_sweep(interp, pool);
-
- if (interp->profile && (flag & POOL_PMC))
- Parrot_gc_profile_end(interp, PARROT_PROF_GC_cp);
-
- *total_free += pool->num_free_objects;
-
- return 0;
-}
-
-
-/*
-
-=item C<static int trace_active_PMCs(PARROT_INTERP, Parrot_gc_trace_type trace)>
-
-Performs a full trace run and marks all the PMCs as active if they
-are. Returns whether the run completed, that is, whether it's safe
-to proceed with GC.
-
-=cut
-
-*/
-
-static int
-trace_active_PMCs(PARROT_INTERP, Parrot_gc_trace_type trace)
-{
- ASSERT_ARGS(trace_active_PMCs)
- if (!Parrot_gc_trace_root(interp, trace))
- return 0;
-
- /* Okay, we've marked the whole root set, and should have a good-sized
- * list of things to look at. Run through it */
- return Parrot_gc_trace_children(interp, (size_t) -1);
-}
-
-
-/*
-
-=item C<static void clear_live_bits(const Small_Object_Pool *pool)>
-
-Runs through all PMC arenas and clear live bits. This is used to reset
-the GC system after a full system sweep.
+Resets the PMC pool, so all objects are marked as "White". This
+is done after a GC run to reset the system and prepare for the
+next mark phase.
=cut
*/
-static void
-clear_live_bits(ARGIN(const Small_Object_Pool *pool))
+void
+Parrot_gc_clear_live_bits(PARROT_INTERP, ARGIN(const Small_Object_Pool *pool))
{
- ASSERT_ARGS(clear_live_bits)
+ ASSERT_ARGS(Parrot_gc_clear_live_bits)
Small_Object_Arena *arena;
const UINTVAL object_size = pool->object_size;
@@ -918,28 +491,6 @@
b = (Buffer *)((char *)b + object_size);
}
}
-
-}
-
-
-/*
-
-=item C<void Parrot_gc_clear_live_bits(PARROT_INTERP)>
-
-Resets the PMC pool, so all objects are marked as "White". This
-is done after a GC run to reset the system and prepare for the
-next mark phase.
-
-=cut
-
-*/
-
-void
-Parrot_gc_clear_live_bits(PARROT_INTERP)
-{
- ASSERT_ARGS(Parrot_gc_clear_live_bits)
- Small_Object_Pool * const pool = interp->arena_base->pmc_pool;
- clear_live_bits(pool);
}
@@ -947,7 +498,9 @@
=item C<int Parrot_gc_trace_children(PARROT_INTERP, size_t how_many)>
-Returns whether the tracing process has completed.
+Traces through the linked list formed by the C<next_for_GC> pointer.
+Returns 0 if this is a lazy GC run and we've found all impatient PMCs.
+Returns 1 if we've traced the entire list.
=cut
@@ -1023,7 +576,7 @@
=item C<void Parrot_add_to_free_list(PARROT_INTERP, Small_Object_Pool *pool,
Small_Object_Arena *arena)>
-Adds the objects in the newly allocated C<arena> to the free list.
+Adds the objects in the newly allocated C<arena> to the free list of the pool.
=cut
@@ -1066,6 +619,7 @@
=cut
*/
+
void
Parrot_append_arena_in_pool(PARROT_INTERP,
ARGMOD(Small_Object_Pool *pool),
@@ -1094,63 +648,182 @@
interp->arena_base->header_allocs_since_last_collect++;
}
+/*
+
+=item C<void Parrot_gc_profile_start(PARROT_INTERP)>
+
+Records the start time of a GC mark run when profiling is enabled.
+
+=cut
+
+*/
+
+void
+Parrot_gc_profile_start(PARROT_INTERP)
+{
+ ASSERT_ARGS(Parrot_gc_profile_start)
+ if (Interp_flags_TEST(interp, PARROT_PROFILE_FLAG))
+ interp->profile->gc_time = Parrot_floatval_time();
+}
+
+/*
+
+=item C<void Parrot_gc_profile_end(PARROT_INTERP, int what)>
+
+Records the end time of the GC mark run part C<what> run when profiling is
+enabled. Also record start time of next part.
+
+=cut
+
+*/
+
+void
+Parrot_gc_profile_end(PARROT_INTERP, int what)
+{
+ ASSERT_ARGS(Parrot_gc_profile_end)
+ if (Interp_flags_TEST(interp, PARROT_PROFILE_FLAG)) {
+ RunProfile * const profile = interp->profile;
+ const FLOATVAL now = Parrot_floatval_time();
+
+ profile->data[what].numcalls++;
+ profile->data[what].time += now - profile->gc_time;
+
+ /*
+ * we've recorded the time of a GC piece from
+ * gc_time until now, so add this to the start of the
+ * currently executing opcode, which hasn't run this
+ * interval.
+ */
+ profile->starttime += now - profile->gc_time;
+
+ /* prepare start for next step */
+ profile->gc_time = now;
+ }
+}
+
+#ifndef GC_IS_MALLOC
+# define PMC_HEADERS_PER_ALLOC 10240 / sizeof (PMC)
+# define BUFFER_HEADERS_PER_ALLOC 5120 / sizeof (Buffer)
+# define STRING_HEADERS_PER_ALLOC 5120 / sizeof (STRING)
+#else /* GC_IS_MALLOC */
+# define PMC_HEADERS_PER_ALLOC 10240 / sizeof (PMC)
+# define BUFFER_HEADERS_PER_ALLOC 10240 / sizeof (Buffer)
+# define STRING_HEADERS_PER_ALLOC 10240 / sizeof (STRING)
+#endif /* GC_IS_MALLOC */
+
+#define CONSTANT_PMC_HEADERS_PER_ALLOC 64
+#define GET_SIZED_POOL_IDX(x) ((x) / sizeof (void *))
+
+
+
+/*
+
+=back
+
+=head2 Header Pool Creation Functions
+
+=over 4
+
+=item C<static Small_Object_Pool * new_pmc_pool(PARROT_INTERP)>
+
+Creates and initializes a new pool for PMCs and returns it.
+
+=cut
+
+*/
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CANNOT_RETURN_NULL
+static Small_Object_Pool *
+new_pmc_pool(PARROT_INTERP)
+{
+ ASSERT_ARGS(new_pmc_pool)
+ const int num_headers = PMC_HEADERS_PER_ALLOC;
+ Small_Object_Pool * const pmc_pool =
+ new_small_object_pool(sizeof (PMC), num_headers);
+
+ pmc_pool->mem_pool = NULL;
+ pmc_pool->gc_object = free_pmc_in_pool;
+
+ (interp->arena_base->init_pool)(interp, pmc_pool);
+ return pmc_pool;
+}
/*
-=item C<static void gc_ms_alloc_objects(PARROT_INTERP, Small_Object_Pool *pool)>
+=item C<static void free_pmc_in_pool(PARROT_INTERP, Small_Object_Pool *pool,
+PObj *p)>
-New arena allocator function for the MS garbage collector system. Allocates
-and initializes a new memory arena in the given pool. Adds all the new
-objects to the pool's free list for later allocation.
+Frees a PMC that is no longer being used. Calls a custom C<destroy> VTABLE
+method if one is available. If the PMC uses a PMC_EXT structure, that is freed
+as well.
=cut
*/
static void
-gc_ms_alloc_objects(PARROT_INTERP, ARGMOD(Small_Object_Pool *pool))
+free_pmc_in_pool(PARROT_INTERP, SHIM(Small_Object_Pool *pool),
+ ARGMOD(PObj *p))
{
- ASSERT_ARGS(gc_ms_alloc_objects)
- /* Setup memory for the new objects */
- Small_Object_Arena * const new_arena =
- mem_internal_allocate_typed(Small_Object_Arena);
+ ASSERT_ARGS(free_pmc_in_pool)
+ PMC * const pmc = (PMC *)p;
+ Arenas * const arena_base = interp->arena_base;
- const size_t size = pool->object_size * pool->objects_per_alloc;
- size_t alloc_size;
+ /* TODO collect objects with finalizers */
+ if (PObj_needs_early_gc_TEST(p))
+ --arena_base->num_early_gc_PMCs;
- /* could be mem_internal_allocate too, but calloc is fast */
- new_arena->start_objects = mem_internal_allocate_zeroed(size);
+ if (PObj_active_destroy_TEST(p))
+ VTABLE_destroy(interp, pmc);
- Parrot_append_arena_in_pool(interp, pool, new_arena, size);
+ if (PObj_is_PMC_EXT_TEST(p))
+ Parrot_gc_free_pmc_ext(interp, pmc);
- Parrot_add_to_free_list(interp, pool, new_arena);
+#ifndef NDEBUG
- /* Allocate more next time */
- if (GC_DEBUG(interp)) {
- pool->objects_per_alloc *= GC_DEBUG_UNITS_PER_ALLOC_GROWTH_FACTOR;
- pool->replenish_level =
- (size_t)(pool->total_objects *
- GC_DEBUG_REPLENISH_LEVEL_FACTOR);
- }
- else {
- pool->objects_per_alloc = (size_t)(pool->objects_per_alloc *
- UNITS_PER_ALLOC_GROWTH_FACTOR);
- pool->replenish_level =
- (size_t)(pool->total_objects * REPLENISH_LEVEL_FACTOR);
- }
+ pmc->pmc_ext = (PMC_EXT *)0xdeadbeef;
+ pmc->vtable = (VTABLE *)0xdeadbeef;
- /* check alloc size against maximum */
- alloc_size = pool->object_size * pool->objects_per_alloc;
+#endif
- if (alloc_size > POOL_MAX_BYTES)
- pool->objects_per_alloc = POOL_MAX_BYTES / pool->object_size;
}
/*
-=item C<Small_Object_Pool * new_small_object_pool(size_t object_size, size_t
-objects_per_alloc)>
+=item C<static Small_Object_Pool * new_bufferlike_pool(PARROT_INTERP, size_t
+actual_buffer_size)>
+
+Creates a new pool for buffer-like structures. This is called from
+C<get_bufferlike_pool()>, and should probably not be called directly.
+
+=cut
+
+*/
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CANNOT_RETURN_NULL
+static Small_Object_Pool *
+new_bufferlike_pool(PARROT_INTERP, size_t actual_buffer_size)
+{
+ ASSERT_ARGS(new_bufferlike_pool)
+ const int num_headers = BUFFER_HEADERS_PER_ALLOC;
+ const size_t buffer_size =
+ (actual_buffer_size + sizeof (void *) - 1) & ~(sizeof (void *) - 1);
+ Small_Object_Pool * const pool =
+ new_small_object_pool(buffer_size, num_headers);
+
+ pool->gc_object = NULL;
+ pool->mem_pool = interp->arena_base->memory_pool;
+ (interp->arena_base->init_pool)(interp, pool);
+ return pool;
+}
+
+/*
+
+=item C<static Small_Object_Pool * new_small_object_pool(size_t object_size,
+size_t objects_per_alloc)>
Creates a new C<Small_Object_Pool> and returns a pointer to it.
Initializes the pool structure based on the size of objects in the
@@ -1162,7 +835,7 @@
PARROT_MALLOC
PARROT_CANNOT_RETURN_NULL
-Small_Object_Pool *
+static Small_Object_Pool *
new_small_object_pool(size_t object_size, size_t objects_per_alloc)
{
ASSERT_ARGS(new_small_object_pool)
@@ -1179,149 +852,330 @@
}
+
/*
-=item C<void gc_pmc_ext_pool_init(Small_Object_Pool *pool)>
+=item C<static Small_Object_Pool * new_buffer_pool(PARROT_INTERP)>
+
+Creates a new C<Small_Object_Pool> structure for managing buffer objects.
-Initialize the PMC_EXT pool functions. This is done separately from other
-pools.
+Non-constant strings and plain Buffers are stored in the sized header pools.
=cut
*/
-void
-gc_pmc_ext_pool_init(ARGMOD(Small_Object_Pool *pool))
+PARROT_WARN_UNUSED_RESULT
+PARROT_CANNOT_RETURN_NULL
+static Small_Object_Pool *
+new_buffer_pool(PARROT_INTERP)
{
- ASSERT_ARGS(gc_pmc_ext_pool_init)
- pool->add_free_object = gc_ms_add_free_pmc_ext;
- pool->get_free_object = gc_ms_get_free_pmc_ext;
- pool->alloc_objects = gc_ms_alloc_objects;
- pool->more_objects = gc_ms_alloc_objects;
+ ASSERT_ARGS(new_buffer_pool)
+ Small_Object_Pool * const pool = get_bufferlike_pool(interp, sizeof (Buffer));
+
+#ifdef GC_IS_MALLOC
+ pool->gc_object = free_buffer_malloc;
+#else
+ pool->gc_object = free_buffer;
+#endif
+
+ return pool;
}
+/*
+
+=item C<static void free_buffer_malloc(PARROT_INTERP, Small_Object_Pool *pool,
+PObj *b)>
+
+Frees the given buffer, returning the storage space to the operating system
+and removing it from Parrot's memory management system. If the buffer is COW,
+The buffer is not freed if the reference count is greater then 1.
+
+=cut
+
+*/
+
+static void
+free_buffer_malloc(SHIM_INTERP, SHIM(Small_Object_Pool *pool),
+ ARGMOD(PObj *b))
+{
+ ASSERT_ARGS(free_buffer_malloc)
+ /* free allocated space at (int *)bufstart - 1, but not if it used COW or is
+ * external */
+ PObj_buflen(b) = 0;
+
+ if (!PObj_bufstart(b) || PObj_is_external_or_free_TESTALL(b))
+ return;
+
+ if (PObj_COW_TEST(b)) {
+ INTVAL * const refcount = PObj_bufrefcountptr(b);
+
+ if (--(*refcount) == 0) {
+ mem_sys_free(refcount); /* the actual bufstart */
+ }
+ }
+ else
+ mem_sys_free(PObj_bufrefcountptr(b));
+}
/*
-=item C<static void gc_ms_pool_init(PARROT_INTERP, Small_Object_Pool *pool)>
+=item C<static void free_buffer(PARROT_INTERP, Small_Object_Pool *pool, PObj
+*b)>
-Initialize a memory pool for the MS garbage collector system. Sets the
-function pointers necessary to perform basic operations on a pool, such
-as object allocation.
+Frees a buffer, returning it to the memory pool for Parrot to possibly
+reuse later.
=cut
*/
static void
-gc_ms_pool_init(SHIM_INTERP, ARGMOD(Small_Object_Pool *pool))
+free_buffer(SHIM_INTERP, ARGMOD(Small_Object_Pool *pool), ARGMOD(PObj *b))
{
- ASSERT_ARGS(gc_ms_pool_init)
- pool->add_free_object = gc_ms_add_free_object;
- pool->get_free_object = gc_ms_get_free_object;
- pool->alloc_objects = gc_ms_alloc_objects;
- pool->more_objects = more_traceable_objects;
+ ASSERT_ARGS(free_buffer)
+ Memory_Pool * const mem_pool = (Memory_Pool *)pool->mem_pool;
+
+ /* XXX Jarkko reported that on irix pool->mem_pool was NULL, which really
+ * shouldn't happen */
+ if (mem_pool) {
+ if (!PObj_COW_TEST(b))
+ mem_pool->guaranteed_reclaimable += PObj_buflen(b);
+
+ mem_pool->possibly_reclaimable += PObj_buflen(b);
+ }
+
+ PObj_buflen(b) = 0;
}
/*
-=item C<void Parrot_gc_ms_init(PARROT_INTERP)>
+=item C<static Small_Object_Pool * new_string_pool(PARROT_INTERP, INTVAL
+constant)>
-Initialize the state structures of the gc system. Called immediately before
-creation of memory pools. This function must set the function pointers
-for C<add_free_object_fn>, C<get_free_object_fn>, C<alloc_object_fn>, and
-C<more_object_fn>.
+Creates a new pool for C<STRING>s and returns it. This calls
+C<get_bufferlike_pool> internally, which in turn calls C<new_bufferlike_pool>.
=cut
*/
-void
-Parrot_gc_ms_init(PARROT_INTERP)
+PARROT_WARN_UNUSED_RESULT
+PARROT_CANNOT_RETURN_NULL
+static Small_Object_Pool *
+new_string_pool(PARROT_INTERP, INTVAL constant)
{
- ASSERT_ARGS(Parrot_gc_ms_init)
- Arenas * const arena_base = interp->arena_base;
+ ASSERT_ARGS(new_string_pool)
+ Small_Object_Pool *pool;
+ if (constant) {
+ pool = new_bufferlike_pool(interp, sizeof (STRING));
+ pool->mem_pool = interp->arena_base->constant_string_pool;
+ }
+ else
+ pool = get_bufferlike_pool(interp, sizeof (STRING));
- arena_base->do_gc_mark = Parrot_gc_ms_run;
- arena_base->finalize_gc_system = NULL;
- arena_base->init_pool = gc_ms_pool_init;
+ pool->objects_per_alloc = STRING_HEADERS_PER_ALLOC;
+
+ return pool;
}
/*
-=item C<void Parrot_small_object_pool_merge(PARROT_INTERP, Small_Object_Pool
-*dest, Small_Object_Pool *source)>
+=item C<Small_Object_Pool * get_bufferlike_pool(PARROT_INTERP, size_t
+buffer_size)>
+
+Makes and return a bufferlike header pool for objects of a given size. If a
+pool for objects of that size already exists, no new pool will be created and
+the pointer to the existing pool is returned.
+
+=cut
+
+*/
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CANNOT_RETURN_NULL
+Small_Object_Pool *
+get_bufferlike_pool(PARROT_INTERP, size_t buffer_size)
+{
+ ASSERT_ARGS(get_bufferlike_pool)
+ Small_Object_Pool **sized_pools = interp->arena_base->sized_header_pools;
+ const UINTVAL num_old = interp->arena_base->num_sized;
+ const UINTVAL idx = GET_SIZED_POOL_IDX(buffer_size);
+
+ /* Expands the array of sized resource pools, if necessary */
+ if (num_old <= idx) {
+ const UINTVAL num_new = idx + 1;
+ /* XXX: use mem_sys_realloc_zeroed to do this easier? If we want the
+ same debugging behavior as mem_internal_realloc, we would
+ need to add a new function/macro for
+ mem_internal_realloc_zeroed, to mirror mem_sys_realloc_zeroed. */
+ sized_pools = (Small_Object_Pool **)mem_internal_realloc(sized_pools,
+ num_new * sizeof (void *));
+ memset(sized_pools + num_old, 0, sizeof (void *) * (num_new - num_old));
+
+ interp->arena_base->sized_header_pools = sized_pools;
+ interp->arena_base->num_sized = num_new;
+ }
+
+ if (sized_pools[idx] == NULL)
+ sized_pools[idx] = new_bufferlike_pool(interp, buffer_size);
+
+ return sized_pools[idx];
+}
+
+/*
+
+=item C<void initialize_header_pools(PARROT_INTERP)>
-Merge pool C<source> into pool C<dest>. Combines the free lists directly,
-moves all arenas to the new pool, and remove the old pool. To merge, the
-two pools must have the same object size, and the same name (if they have
-names).
+The initialization routine for the interpreter's header pools. Initializes
+pools for string headers, constant string headers, buffers, PMCs, PMC_EXTs, and
+constant PMCs.
+
+The C<string_header_pool> and C<buffer_header_pool> are actually both in the
+sized pools, although no other sized pools are created here.
=cut
*/
void
-Parrot_small_object_pool_merge(PARROT_INTERP,
- ARGMOD(Small_Object_Pool *dest), ARGMOD(Small_Object_Pool *source))
+initialize_header_pools(PARROT_INTERP)
{
- ASSERT_ARGS(Parrot_small_object_pool_merge)
- Small_Object_Arena *cur_arena;
- void **free_list_end;
+ ASSERT_ARGS(initialize_header_pools)
+ Arenas * const arena_base = interp->arena_base;
+
+ /* Init the constant string header pool */
+ arena_base->constant_string_header_pool = new_string_pool(interp, 1);
+ arena_base->constant_string_header_pool->name = "constant_string_header";
- /* XXX num_free_objects doesn't seem to be accounted correctly in, e.g.,
- * the PMC_EXT pool.
+ /* Init the buffer header pool
+ *
+ * The buffer_header_pool and the string_header_pool actually live in the
+ * sized_header_pools. These pool pointers only provide faster access in
+ * new_*_header */
+ arena_base->buffer_header_pool = new_buffer_pool(interp);
+ arena_base->buffer_header_pool->name = "buffer_header";
+
+ /* Init the string header pool */
+ arena_base->string_header_pool = new_string_pool(interp, 0);
+ arena_base->string_header_pool->name = "string_header";
+
+ /* Init the PMC header pool */
+ arena_base->pmc_pool = new_pmc_pool(interp);
+ arena_base->pmc_pool->name = "pmc";
+
+ /* pmc extension buffer */
+ arena_base->pmc_ext_pool =
+ new_small_object_pool(sizeof (PMC_EXT), 1024);
+
+#if PARROT_GC_MS
+ /*
+ * pmc_ext isn't a managed item. If a PMC has a pmc_ext structure
+ * it is returned to the pool instantly - the structure is never
+ * marked.
+ * Use GS MS pool functions
*/
-#if 0
- if (source->num_free_objects == source->total_objects) {
- return;
- }
+ gc_ms_pmc_ext_pool_init(arena_base->pmc_ext_pool);
+#else
+ /* rational, consistant behavior (as yet unwritten) */
#endif
- /* PARROT_ASSERT(source->total_objects); */
- PARROT_ASSERT(dest->object_size == source->object_size);
- PARROT_ASSERT((dest->name == NULL && source->name == NULL)
- || STREQ(dest->name, source->name));
+ arena_base->pmc_ext_pool->name = "pmc_ext";
+
+ /* constant PMCs */
+ arena_base->constant_pmc_pool = new_pmc_pool(interp);
+ arena_base->constant_pmc_pool->name = "constant_pmc";
+ arena_base->constant_pmc_pool->objects_per_alloc =
+ CONSTANT_PMC_HEADERS_PER_ALLOC;
+}
+
+
+/*
+
+=item C<int header_pools_iterate_callback(PARROT_INTERP, int flag, void *arg,
+pool_iter_fn func)>
+
+Iterates through header pools, invoking the given callback function on each
+pool in the list matching the given criteria. Determines which pools to iterate
+over depending on flags passed to the function. Returns the callback's return
+value, if non-zero. A non-zero return value from the callback function will
+terminate the iteration prematurely.
+
+=over 4
+
+=item flag is one of
+
+ POOL_PMC
+ POOL_BUFFER
+ POOL_CONST
+ POOL_ALL
+
+Only matching pools will be used. Notice that it is not possible to iterate
+over certain sets of pools using the provided flags in the single pass. For
+instance, both the PMC pool and the constant PMC pool cannot be iterated over
+in a single pass.
+
+=item arg
- dest->total_objects += source->total_objects;
+This argument is passed on to the iteration function.
- /* append new free_list to old */
- /* XXX this won't work with, e.g., gc_gms */
- free_list_end = &dest->free_list;
+=item pool_iter_fn
- while (*free_list_end)
- free_list_end = (void **)*free_list_end;
+Called with C<(Parrot_Interp, Small_Object_Pool *, int flag, void *arg)>. If
+the function returns a non-zero value, iteration will stop.
- *free_list_end = source->free_list;
+=back
+
+=cut
- /* now append source arenas */
- cur_arena = source->last_Arena;
+*/
- while (cur_arena) {
- size_t total_objects;
- Small_Object_Arena * const next_arena = cur_arena->prev;
+PARROT_IGNORABLE_RESULT
+int
+header_pools_iterate_callback(PARROT_INTERP, int flag, ARGIN_NULLOK(void *arg),
+ NOTNULL(pool_iter_fn func))
+{
+ ASSERT_ARGS(header_pools_iterate_callback)
+ Arenas * const arena_base = interp->arena_base;
- cur_arena->next = cur_arena->prev = NULL;
+ if (flag & POOL_PMC) {
+ Small_Object_Pool *pool = flag & POOL_CONST
+ ? arena_base->constant_pmc_pool
+ : arena_base->pmc_pool;
- total_objects = cur_arena->total_objects;
+ const int ret_val = (func)(interp, pool,
+ flag & (POOL_PMC | POOL_CONST) , arg);
- Parrot_append_arena_in_pool(interp, dest, cur_arena,
- cur_arena->total_objects);
+ if (ret_val)
+ return ret_val;
+ }
- /* XXX needed? */
- cur_arena->total_objects = total_objects;
+ if (flag & POOL_BUFFER) {
+ INTVAL i;
- cur_arena = next_arena;
+ if (flag & POOL_CONST) {
+ const int ret_val = (func)(interp,
+ arena_base->constant_string_header_pool,
+ POOL_BUFFER | POOL_CONST, arg);
+
+ if (ret_val)
+ return ret_val;
+ }
+
+ for (i = interp->arena_base->num_sized - 1; i >= 0; --i) {
+ Small_Object_Pool * const pool = arena_base->sized_header_pools[i];
+
+ if (pool) {
+ const int ret_val = (func)(interp, pool, POOL_BUFFER, arg);
+ if (ret_val)
+ return ret_val;
+ }
+ }
}
- /* remove things from source */
- /* XXX is this enough? */
- source->last_Arena = NULL;
- source->free_list = NULL;
- source->total_objects = 0;
- source->num_free_objects = 0;
+ return 0;
}
Deleted: branches/pmc_pct/src/gc/memory.c
==============================================================================
--- branches/pmc_pct/src/gc/memory.c Thu Jun 4 02:32:48 2009 (r39376)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,357 +0,0 @@
-/*
-Copyright (C) 2001-2009, Parrot Foundation.
-$Id$
-
-=head1 NAME
-
-src/gc/memory.c - Memory allocation
-
-=head1 DESCRIPTION
-
-The memory (mem) API handles memory allocation,
-
-Basically just a wrapper C<around malloc/calloc/realloc/free()> with an
-setup function to initialize the memory pools.
-
-=head2 Functions
-
-=over 4
-
-=cut
-
-*/
-
-#include "parrot/parrot.h"
-#include "parrot/memory.h"
-
-/* HEADERIZER HFILE: include/parrot/memory.h */
-
-/*
-
-=item C<void * mem_sys_allocate(size_t size)>
-
-Uses C<malloc> to allocate system memory. Panics if the system cannot
-return memory.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-PARROT_MALLOC
-PARROT_CANNOT_RETURN_NULL
-void *
-mem_sys_allocate(size_t size)
-{
- ASSERT_ARGS(mem_sys_allocate)
- void * const ptr = malloc(size);
-#ifdef DETAIL_MEMORY_DEBUG
- fprintf(stderr, "Allocated %i at %p\n", size, ptr);
-#endif
- if (!ptr)
- PANIC(NULL, "Out of mem");
- return ptr;
-}
-
-/*
-
-=item C<void * mem__internal_allocate(size_t size, const char *file, int line)>
-
-Calls C<malloc> to allocate memory from the system, Panics if there is no
-memory available. If C<DETAIL_MEMORY_DEBUG> macro is defined, prints
-debug information to C<STDERR>.
-
-=cut
-
-*/
-
-PARROT_MALLOC
-PARROT_CANNOT_RETURN_NULL
-void *
-mem__internal_allocate(size_t size, ARGIN(const char *file), int line)
-{
- ASSERT_ARGS(mem__internal_allocate)
- void * const ptr = malloc((size_t)size);
-#ifdef DETAIL_MEMORY_DEBUG
- fprintf(stderr, "Internal malloc %i at %p (%s/%d)\n",
- size, ptr, file, line);
-#else
- UNUSED(file);
- UNUSED(line);
-#endif
- if (!ptr)
- PANIC(NULL, "Out of mem");
- return ptr;
-}
-
-/*
-
-=item C<void * mem_sys_allocate_zeroed(size_t size)>
-
-Uses C<calloc> to allocate system memory. Guaranteed to succeed, Panics
-otherwise.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-PARROT_MALLOC
-PARROT_CANNOT_RETURN_NULL
-void *
-mem_sys_allocate_zeroed(size_t size)
-{
- ASSERT_ARGS(mem_sys_allocate_zeroed)
- void * const ptr = calloc(1, (size_t)size);
-#ifdef DETAIL_MEMORY_DEBUG
- fprintf(stderr, "Allocated %i at %p\n", size, ptr);
-#endif
- if (!ptr)
- PANIC(NULL, "Out of mem");
- return ptr;
-}
-
-/*
-
-=item C<void * mem__internal_allocate_zeroed(size_t size, const char *file, int
-line)>
-
-Uses C<calloc> to allocate system memory. Guaranteed to succeed, Panics
-otherwise. If C<DETAIL_MEMORY_DEBUG> macro is defined, prints
-debug information to C<STDERR>.
-
-=cut
-
-*/
-
-PARROT_MALLOC
-PARROT_CANNOT_RETURN_NULL
-void *
-mem__internal_allocate_zeroed(size_t size, ARGIN(const char *file), int line)
-{
- ASSERT_ARGS(mem__internal_allocate_zeroed)
- void * const ptr = calloc(1, (size_t)size);
-#ifdef DETAIL_MEMORY_DEBUG
- fprintf(stderr, "Internal malloc %i at %p (%s/%d)\n",
- size, ptr, file, line);
-#else
- UNUSED(file);
- UNUSED(line);
-#endif
- if (!ptr)
- PANIC(NULL, "Out of mem");
- return ptr;
-}
-
-/*
-
-=item C<void * mem_sys_realloc(void *from, size_t size)>
-
-Resizes a chunk of memory. Unlike C<realloc>, it can handle a
-NULL pointer, in which case it calls C<calloc> to create the memory
-block.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-PARROT_MALLOC
-PARROT_CANNOT_RETURN_NULL
-void *
-mem_sys_realloc(ARGFREE(void *from), size_t size)
-{
- ASSERT_ARGS(mem_sys_realloc)
- void *ptr;
-#ifdef DETAIL_MEMORY_DEBUG
- fprintf(stderr, "Freed %p (realloc -- %i bytes)\n", from, size);
-#endif
- if (from)
- ptr = realloc(from, size);
- else
- ptr = calloc(1, size);
-#ifdef DETAIL_MEMORY_DEBUG
- fprintf(stderr, "Allocated %i at %p\n", size, ptr);
-#endif
- if (!ptr)
- PANIC(NULL, "Out of mem");
- return ptr;
-}
-
-
-/*
-
-=item C<void * mem_sys_realloc_zeroed(void *from, size_t size, size_t old_size)>
-
-Resizes a chunk of system memory and fills the newly allocated space
-with zeroes. If the pointer is C<NULL> a new memory block is
-allocated and zeroed instead.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-PARROT_MALLOC
-PARROT_CANNOT_RETURN_NULL
-void *
-mem_sys_realloc_zeroed(ARGFREE(void *from), size_t size, size_t old_size)
-{
- ASSERT_ARGS(mem_sys_realloc_zeroed)
- void *ptr;
-#ifdef DETAIL_MEMORY_DEBUG
- fprintf(stderr, "Freed %p (realloc -- %i bytes)\n", from, size);
-#endif
- ptr = from ? realloc(from, size) : malloc(size);
-#ifdef DETAIL_MEMORY_DEBUG
- fprintf(stderr, "Allocated %i at %p\n", size, ptr);
-#endif
- if (!ptr)
- PANIC(NULL, "Out of mem");
-
- if (size > old_size)
- memset((char*)ptr + old_size, 0, size - old_size);
-
- return ptr;
-}
-
-/*
-
-=item C<void * mem__internal_realloc(void *from, size_t size, const char *file,
-int line)>
-
-Resizes a chunk of system memory. Unlike C<realloc>, it can handle a
-NULL pointer, in which case a new memory block is allocated for the
-requested size. If C<DETAIL_MEMORY_DEBUG> macro is defined, debug
-information is printed to C<STDERR>.
-
-=cut
-
-*/
-
-PARROT_MALLOC
-PARROT_CANNOT_RETURN_NULL
-void *
-mem__internal_realloc(ARGFREE(void *from), size_t size,
- ARGIN(const char *file), int line)
-{
- ASSERT_ARGS(mem__internal_realloc)
- void * const ptr = realloc(from, size);
-#ifdef DETAIL_MEMORY_DEBUG
- fprintf(stderr, "internal free of %p (realloc -- %i bytes) (%s/%d)\n",
- from, size, file, line);
- fprintf(stderr, "Internal malloc %i at %p (%s/%d)\n",
- size, ptr, file, line);
-#else
- UNUSED(file);
- UNUSED(line);
-#endif
- if (!ptr)
- PANIC(NULL, "Out of mem");
- return ptr;
-}
-
-#if 0
-
-/*
-
-=item C<void * mem__internal_realloc_zeroed(void *from, size_t size, size_t
-old_size, const char *file, int line)>
-
-Reallocates a given buffer of size C<old_size> to C<size>. If the new size
-is larger then the old size, the difference is filled with zeros. Contains
-debugging information, and can print filename and line number where it is
-used if C<DETAIL_MEMORY_DEBUG> is defined.
-
-=cut
-
-*/
-
-PARROT_MALLOC
-PARROT_CANNOT_RETURN_NULL
-void *
-mem__internal_realloc_zeroed(ARGFREE(void *from), size_t size, size_t old_size,
- ARGIN(const char *file), int line)
-{
- ASSERT_ARGS(mem__internal_realloc_zeroed)
- void * const ptr = realloc(from, size);
-# ifdef DETAIL_MEMORY_DEBUG
- fprintf(stderr, "internal free of %p (realloc -- %i bytes) (%s/%d)\n",
- from, size, file, line);
- fprintf(stderr, "Internal malloc %i at %p (%s/%d)\n",
- size, ptr, file, line);
-# else
- UNUSED(file);
- UNUSED(line);
-# endif
- if (!ptr)
- PANIC(NULL, "Out of mem");
- if (size > old_size)
- memset((char*)ptr + old_size, 0, size - old_size);
-
- return ptr;
-}
-
-#endif
-
-/*
-
-=item C<void mem_sys_free(void *from)>
-
-Frees a chunk of memory back to the system.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-void
-mem_sys_free(ARGFREE(void *from))
-{
- ASSERT_ARGS(mem_sys_free)
-#ifdef DETAIL_MEMORY_DEBUG
- fprintf(stderr, "Freed %p\n", from);
-#endif
- if (from)
- free(from);
-}
-
-/*
-
-=item C<void mem__internal_free(void *from, const char *file, int line)>
-
-Frees a chunk of memory back to the system. If
-C<DETAIL_MEMORY_DEBUG> macro is defined, prints debug information to
-C<STDERR>.
-
-=cut
-
-*/
-
-void
-mem__internal_free(ARGFREE(void *from), ARGIN(const char *file), int line)
-{
- ASSERT_ARGS(mem__internal_free)
-#ifdef DETAIL_MEMORY_DEBUG
- fprintf(stderr, "Internal free of %p (%s/%d)\n", from, file, line);
-#else
- UNUSED(file);
- UNUSED(line);
-#endif
- free(from);
-}
-
-/*
-
-=back
-
-=cut
-
-*/
-
-/*
- * Local variables:
- * c-file-style: "parrot"
- * End:
- * vim: expandtab shiftwidth=4:
- */
Deleted: branches/pmc_pct/src/gc/pools.c
==============================================================================
--- branches/pmc_pct/src/gc/pools.c Thu Jun 4 02:32:48 2009 (r39376)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,719 +0,0 @@
-/*
-Copyright (C) 2001-2009, Parrot Foundation.
-$Id$
-
-=head1 NAME
-
-src/gc/pools.c - Header management functions
-
-=head1 DESCRIPTION
-
-Handles pool creation for PMC headers.
-
-=cut
-
-*/
-
-#include "parrot/parrot.h"
-#include "gc_private.h"
-
-/* HEADERIZER HFILE: src/gc/gc_private.h */
-
-/* HEADERIZER BEGIN: static */
-/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
-
-static void Parrot_gc_free_buffer(SHIM_INTERP,
- ARGMOD(Small_Object_Pool *pool),
- ARGMOD(PObj *b))
- __attribute__nonnull__(2)
- __attribute__nonnull__(3)
- FUNC_MODIFIES(*pool)
- FUNC_MODIFIES(*b);
-
-static void Parrot_gc_free_buffer_malloc(SHIM_INTERP,
- SHIM(Small_Object_Pool *pool),
- ARGMOD(PObj *b))
- __attribute__nonnull__(3)
- FUNC_MODIFIES(*b);
-
-#define ASSERT_ARGS_Parrot_gc_free_buffer __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(pool) \
- || PARROT_ASSERT_ARG(b)
-#define ASSERT_ARGS_Parrot_gc_free_buffer_malloc __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(b)
-/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
-/* HEADERIZER END: static */
-
-
-#ifndef GC_IS_MALLOC
-# define PMC_HEADERS_PER_ALLOC 10240 / sizeof (PMC)
-# define BUFFER_HEADERS_PER_ALLOC 5120 / sizeof (Buffer)
-# define STRING_HEADERS_PER_ALLOC 5120 / sizeof (STRING)
-#else /* GC_IS_MALLOC */
-# define PMC_HEADERS_PER_ALLOC 10240 / sizeof (PMC)
-# define BUFFER_HEADERS_PER_ALLOC 10240 / sizeof (Buffer)
-# define STRING_HEADERS_PER_ALLOC 10240 / sizeof (STRING)
-#endif /* GC_IS_MALLOC */
-
-#define CONSTANT_PMC_HEADERS_PER_ALLOC 64
-#define GET_SIZED_POOL_IDX(x) ((x) / sizeof (void *))
-
-/*
-
-=head2 Buffer Header Functions for small-object lookup table
-
-=over 4
-
-=item C<void Parrot_merge_memory_pools(Interp *dest_interp, Interp
-*source_interp)>
-
-Merge the memory pools of two interpreter structures. Merge the general
-memory pool and the constant string pools from C<source_interp> into
-C<dest_interp>.
-
-=cut
-
-*/
-
-void
-Parrot_merge_memory_pools(ARGIN(Interp *dest_interp), ARGIN(Interp *source_interp))
-{
- ASSERT_ARGS(Parrot_merge_memory_pools)
- merge_pools(dest_interp->arena_base->constant_string_pool,
- source_interp->arena_base->constant_string_pool);
-
- merge_pools(dest_interp->arena_base->memory_pool,
- source_interp->arena_base->memory_pool);
-}
-
-/*
-
-=item C<void * get_free_buffer(PARROT_INTERP, Small_Object_Pool *pool)>
-
-Gets a free object or buffer from the given C<pool> and returns it. If the
-object is larger then a standard C<PObj> structure, all additional memory is
-cleared.
-
-=cut
-
-*/
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CANNOT_RETURN_NULL
-void *
-get_free_buffer(PARROT_INTERP, ARGIN(Small_Object_Pool *pool))
-{
- ASSERT_ARGS(get_free_buffer)
- PObj * const buffer = (PObj *)pool->get_free_object(interp, pool);
-
- /* don't mess around with flags */
- PObj_bufstart(buffer) = NULL;
- PObj_buflen(buffer) = 0;
-
- if (pool->object_size - GC_HEADER_SIZE > sizeof (PObj))
- memset(buffer + 1, 0,
- pool->object_size - sizeof (PObj) - GC_HEADER_SIZE);
-
- return buffer;
-}
-
-
-/*
-
-=back
-
-=head2 Header Pool Creation Functions
-
-=over 4
-
-=item C<Small_Object_Pool * new_pmc_pool(PARROT_INTERP)>
-
-Creates and initializes a new pool for PMCs and returns it.
-
-=cut
-
-*/
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CANNOT_RETURN_NULL
-Small_Object_Pool *
-new_pmc_pool(PARROT_INTERP)
-{
- ASSERT_ARGS(new_pmc_pool)
- const int num_headers = PMC_HEADERS_PER_ALLOC;
- Small_Object_Pool * const pmc_pool =
- new_small_object_pool(sizeof (PMC), num_headers);
-
- pmc_pool->mem_pool = NULL;
- pmc_pool->gc_object = Parrot_gc_ms_free_pmc;
-
- (interp->arena_base->init_pool)(interp, pmc_pool);
- return pmc_pool;
-}
-
-
-/*
-
-=item C<Small_Object_Pool * new_bufferlike_pool(PARROT_INTERP, size_t
-actual_buffer_size)>
-
-Creates a new pool for buffer-like structures. This is called from
-C<get_bufferlike_pool()>, and should probably not be called directly.
-
-=cut
-
-*/
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CANNOT_RETURN_NULL
-Small_Object_Pool *
-new_bufferlike_pool(PARROT_INTERP, size_t actual_buffer_size)
-{
- ASSERT_ARGS(new_bufferlike_pool)
- const int num_headers = BUFFER_HEADERS_PER_ALLOC;
- const size_t buffer_size =
- (actual_buffer_size + sizeof (void *) - 1) & ~(sizeof (void *) - 1);
- Small_Object_Pool * const pool =
- new_small_object_pool(buffer_size, num_headers);
-
- pool->gc_object = NULL;
- pool->mem_pool = interp->arena_base->memory_pool;
- (interp->arena_base->init_pool)(interp, pool);
- return pool;
-}
-
-
-/*
-
-=item C<Small_Object_Pool * new_buffer_pool(PARROT_INTERP)>
-
-Creates a new C<Small_Object_Pool> structure for managing buffer objects.
-
-Non-constant strings and plain Buffers are stored in the sized header pools.
-
-=cut
-
-*/
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CANNOT_RETURN_NULL
-Small_Object_Pool *
-new_buffer_pool(PARROT_INTERP)
-{
- ASSERT_ARGS(new_buffer_pool)
- Small_Object_Pool * const pool = get_bufferlike_pool(interp, sizeof (Buffer));
-
-#ifdef GC_IS_MALLOC
- pool->gc_object = Parrot_gc_free_buffer_malloc;
-#else
- pool->gc_object = Parrot_gc_free_buffer;
-#endif
-
- return pool;
-}
-
-/*
-
-=item C<static void Parrot_gc_free_buffer_malloc(PARROT_INTERP,
-Small_Object_Pool *pool, PObj *b)>
-
-Frees the given buffer, returning the storage space to the operating system
-and removing it from Parrot's memory management system. If the buffer is COW,
-The buffer is not freed if the reference count is greater then 1.
-
-=cut
-
-*/
-
-static void
-Parrot_gc_free_buffer_malloc(SHIM_INTERP, SHIM(Small_Object_Pool *pool),
- ARGMOD(PObj *b))
-{
- ASSERT_ARGS(Parrot_gc_free_buffer_malloc)
- /* free allocated space at (int *)bufstart - 1, but not if it used COW or is
- * external */
- PObj_buflen(b) = 0;
-
- if (!PObj_bufstart(b) || PObj_is_external_or_free_TESTALL(b))
- return;
-
- if (PObj_COW_TEST(b)) {
- INTVAL * const refcount = PObj_bufrefcountptr(b);
-
- if (--(*refcount) == 0) {
- mem_sys_free(refcount); /* the actual bufstart */
- }
- }
- else
- mem_sys_free(PObj_bufrefcountptr(b));
-}
-
-/*
-
-=item C<static void Parrot_gc_free_buffer(PARROT_INTERP, Small_Object_Pool
-*pool, PObj *b)>
-
-Frees a buffer, returning it to the memory pool for Parrot to possibly
-reuse later.
-
-=cut
-
-*/
-
-static void
-Parrot_gc_free_buffer(SHIM_INTERP, ARGMOD(Small_Object_Pool *pool), ARGMOD(PObj *b))
-{
- ASSERT_ARGS(Parrot_gc_free_buffer)
- Memory_Pool * const mem_pool = (Memory_Pool *)pool->mem_pool;
-
- /* XXX Jarkko reported that on irix pool->mem_pool was NULL, which really
- * shouldn't happen */
- if (mem_pool) {
- if (!PObj_COW_TEST(b))
- mem_pool->guaranteed_reclaimable += PObj_buflen(b);
-
- mem_pool->possibly_reclaimable += PObj_buflen(b);
- }
-
- PObj_buflen(b) = 0;
-}
-
-
-/*
-
-=item C<Small_Object_Pool * new_string_pool(PARROT_INTERP, INTVAL constant)>
-
-Creates a new pool for C<STRING>s and returns it. This calls
-C<get_bufferlike_pool> internally, which in turn calls C<new_bufferlike_pool>.
-
-=cut
-
-*/
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CANNOT_RETURN_NULL
-Small_Object_Pool *
-new_string_pool(PARROT_INTERP, INTVAL constant)
-{
- ASSERT_ARGS(new_string_pool)
- Small_Object_Pool *pool;
- if (constant) {
- pool = new_bufferlike_pool(interp, sizeof (STRING));
- pool->mem_pool = interp->arena_base->constant_string_pool;
- }
- else
- pool = get_bufferlike_pool(interp, sizeof (STRING));
-
- pool->objects_per_alloc = STRING_HEADERS_PER_ALLOC;
-
- return pool;
-}
-
-
-/*
-
-=item C<Small_Object_Pool * get_bufferlike_pool(PARROT_INTERP, size_t
-buffer_size)>
-
-Makes and return a bufferlike header pool for objects of a given size. If a
-pool for objects of that size already exists, no new pool will be created and
-the pointer to the existing pool is returned.
-
-=cut
-
-*/
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CANNOT_RETURN_NULL
-Small_Object_Pool *
-get_bufferlike_pool(PARROT_INTERP, size_t buffer_size)
-{
- ASSERT_ARGS(get_bufferlike_pool)
- Small_Object_Pool **sized_pools = interp->arena_base->sized_header_pools;
- const UINTVAL num_old = interp->arena_base->num_sized;
- const UINTVAL idx = GET_SIZED_POOL_IDX(buffer_size);
-
- /* Expands the array of sized resource pools, if necessary */
- if (num_old <= idx) {
- const UINTVAL num_new = idx + 1;
- /* XXX: use mem_sys_realloc_zeroed to do this easier? If we want the
- same debugging behavior as mem_internal_realloc, we would
- need to add a new function/macro for
- mem_internal_realloc_zeroed, to mirror mem_sys_realloc_zeroed. */
- sized_pools = (Small_Object_Pool **)mem_internal_realloc(sized_pools,
- num_new * sizeof (void *));
- memset(sized_pools + num_old, 0, sizeof (void *) * (num_new - num_old));
-
- interp->arena_base->sized_header_pools = sized_pools;
- interp->arena_base->num_sized = num_new;
- }
-
- if (sized_pools[idx] == NULL)
- sized_pools[idx] = new_bufferlike_pool(interp, buffer_size);
-
- return sized_pools[idx];
-}
-
-
-/*
-
-=item C<size_t get_max_buffer_address(PARROT_INTERP)>
-
-Calculates the maximum buffer address and returns it. This is done by looping
-through all the sized pools, and finding the pool whose C<end_arena_memory>
-field is the highest. Notice that arenas in each pool are not necessarily
-located directly next to each other in memory, and the last arena in the pool's
-list may not be located at the highest memory address.
-
-=cut
-
-*/
-
-PARROT_WARN_UNUSED_RESULT
-size_t
-get_max_buffer_address(PARROT_INTERP)
-{
- ASSERT_ARGS(get_max_buffer_address)
- Arenas * const arena_base = interp->arena_base;
- size_t max = 0;
- UINTVAL i;
-
- for (i = 0; i < arena_base->num_sized; i++) {
- if (arena_base->sized_header_pools[i]) {
- if (arena_base->sized_header_pools[i]->end_arena_memory > max)
- max = arena_base->sized_header_pools[i]->end_arena_memory;
- }
- }
-
- return max;
-}
-
-
-/*
-
-=item C<size_t get_min_buffer_address(PARROT_INTERP)>
-
-Calculates the minimum buffer address and returns it. Loops through all sized
-pools, and finds the one with the smallest C<start_arena_memory> field. Notice
-that the memory region between C<get_min_buffer_address> and
-C<get_max_buffer_address> may be fragmented, and parts of it may not be
-available for Parrot to use directly (such as bookkeeping data for the OS
-memory manager).
-
-=cut
-
-*/
-
-PARROT_WARN_UNUSED_RESULT
-size_t
-get_min_buffer_address(PARROT_INTERP)
-{
- ASSERT_ARGS(get_min_buffer_address)
- Arenas * const arena_base = interp->arena_base;
- size_t min = (size_t) -1;
- UINTVAL i;
-
- for (i = 0; i < arena_base->num_sized; i++) {
- if (arena_base->sized_header_pools[i]
- && arena_base->sized_header_pools[i]->start_arena_memory) {
- if (arena_base->sized_header_pools[i]->start_arena_memory < min)
- min = arena_base->sized_header_pools[i]->start_arena_memory;
- }
- }
-
- return min;
-}
-
-
-/*
-
-=item C<size_t get_max_pmc_address(PARROT_INTERP)>
-
-Returns the maximum memory address used by the C<pmc_pool>.
-
-=cut
-
-*/
-
-PARROT_WARN_UNUSED_RESULT
-size_t
-get_max_pmc_address(PARROT_INTERP)
-{
- ASSERT_ARGS(get_max_pmc_address)
- return interp->arena_base->pmc_pool->end_arena_memory;
-}
-
-
-/*
-
-=item C<size_t get_min_pmc_address(PARROT_INTERP)>
-
-Returns the minimum memory address used by the C<pmc_pool>. Notice that the
-memory region between C<get_min_pmc_address> and C<get_max_pmc_address> may be
-fragmented, and not all of it may be used directly by Parrot for storing PMCs.
-
-=cut
-
-*/
-
-PARROT_WARN_UNUSED_RESULT
-size_t
-get_min_pmc_address(PARROT_INTERP)
-{
- ASSERT_ARGS(get_min_pmc_address)
- return interp->arena_base->pmc_pool->start_arena_memory;
-}
-
-
-/*
-
-=item C<int is_buffer_ptr(PARROT_INTERP, const void *ptr)>
-
-Checks whether the given C<ptr> is located within one of the sized
-header pools. Returns C<1> if it is, and C<0> if not.
-
-=cut
-
-*/
-
-PARROT_WARN_UNUSED_RESULT
-int
-is_buffer_ptr(PARROT_INTERP, ARGIN(const void *ptr))
-{
- ASSERT_ARGS(is_buffer_ptr)
- Arenas * const arena_base = interp->arena_base;
- UINTVAL i;
-
- for (i = 0; i < arena_base->num_sized; i++) {
- if (arena_base->sized_header_pools[i]
- && contained_in_pool(arena_base->sized_header_pools[i], ptr))
- return 1;
- }
-
- return 0;
-}
-
-
-/*
-
-=item C<int is_pmc_ptr(PARROT_INTERP, const void *ptr)>
-
-Checks that C<ptr> is actually a PMC pointer. Returns C<1> if it is, C<0>
-otherwise.
-
-=cut
-
-*/
-
-PARROT_WARN_UNUSED_RESULT
-int
-is_pmc_ptr(PARROT_INTERP, ARGIN(const void *ptr))
-{
- ASSERT_ARGS(is_pmc_ptr)
- return contained_in_pool(interp->arena_base->pmc_pool, ptr);
-}
-
-
-/*
-
-=item C<void Parrot_initialize_header_pools(PARROT_INTERP)>
-
-The initialization routine for the interpreter's header pools. Initializes
-pools for string headers, constant string headers, buffers, PMCs, PMC_EXTs, and
-constant PMCs.
-
-The C<string_header_pool> and C<buffer_header_pool> are actually both in the
-sized pools, although no other sized pools are created here.
-
-=cut
-
-*/
-
-void
-Parrot_initialize_header_pools(PARROT_INTERP)
-{
- ASSERT_ARGS(Parrot_initialize_header_pools)
- Arenas * const arena_base = interp->arena_base;
-
- /* Init the constant string header pool */
- arena_base->constant_string_header_pool = new_string_pool(interp, 1);
- arena_base->constant_string_header_pool->name = "constant_string_header";
-
- /* Init the buffer header pool
- *
- * The buffer_header_pool and the string_header_pool actually live in the
- * sized_header_pools. These pool pointers only provide faster access in
- * new_*_header */
- arena_base->buffer_header_pool = new_buffer_pool(interp);
- arena_base->buffer_header_pool->name = "buffer_header";
-
- /* Init the string header pool */
- arena_base->string_header_pool = new_string_pool(interp, 0);
- arena_base->string_header_pool->name = "string_header";
-
- /* Init the PMC header pool */
- arena_base->pmc_pool = new_pmc_pool(interp);
- arena_base->pmc_pool->name = "pmc";
-
- /* pmc extension buffer */
- arena_base->pmc_ext_pool =
- new_small_object_pool(sizeof (PMC_EXT), 1024);
-
-#if PARROT_GC_MS
- /*
- * pmc_ext isn't a managed item. If a PMC has a pmc_ext structure
- * it is returned to the pool instantly - the structure is never
- * marked.
- * Use GS MS pool functions
- */
- gc_pmc_ext_pool_init(arena_base->pmc_ext_pool);
-#else
- /* rational, consistant behavior (as yet unwritten) */
-#endif
-
- arena_base->pmc_ext_pool->name = "pmc_ext";
-
- /* constant PMCs */
- arena_base->constant_pmc_pool = new_pmc_pool(interp);
- arena_base->constant_pmc_pool->name = "constant_pmc";
- arena_base->constant_pmc_pool->objects_per_alloc =
- CONSTANT_PMC_HEADERS_PER_ALLOC;
-}
-
-
-/*
-
-=item C<int Parrot_forall_header_pools(PARROT_INTERP, int flag, void *arg,
-pool_iter_fn func)>
-
-Iterates through header pools, invoking the given callback function on each
-pool in the list matching the given criteria. Determines which pools to iterate
-over depending on flags passed to the function. Returns the callback's return
-value, if non-zero. A non-zero return value from the callback function will
-terminate the iteration prematurely.
-
-=over 4
-
-=item flag is one of
-
- POOL_PMC
- POOL_BUFFER
- POOL_CONST
- POOL_ALL
-
-Only matching pools will be used. Notice that it is not possible to iterate
-over certain sets of pools using the provided flags in the single pass. For
-instance, both the PMC pool and the constant PMC pool cannot be iterated over
-in a single pass.
-
-=item arg
-
-This argument is passed on to the iteration function.
-
-=item pool_iter_fn
-
-Called with C<(Parrot_Interp, Small_Object_Pool *, int flag, void *arg)>. If
-the function returns a non-zero value, iteration will stop.
-
-=back
-
-=cut
-
-*/
-
-PARROT_IGNORABLE_RESULT
-int
-Parrot_forall_header_pools(PARROT_INTERP, int flag, ARGIN_NULLOK(void *arg),
- NOTNULL(pool_iter_fn func))
-{
- ASSERT_ARGS(Parrot_forall_header_pools)
- Arenas * const arena_base = interp->arena_base;
-
- if (flag & POOL_PMC) {
- Small_Object_Pool *pool = flag & POOL_CONST
- ? arena_base->constant_pmc_pool
- : arena_base->pmc_pool;
-
- const int ret_val = (func)(interp, pool,
- flag & (POOL_PMC | POOL_CONST) , arg);
-
- if (ret_val)
- return ret_val;
- }
-
- if (flag & POOL_BUFFER) {
- INTVAL i;
-
- if (flag & POOL_CONST) {
- const int ret_val = (func)(interp,
- arena_base->constant_string_header_pool,
- POOL_BUFFER | POOL_CONST, arg);
-
- if (ret_val)
- return ret_val;
- }
-
- for (i = interp->arena_base->num_sized - 1; i >= 0; --i) {
- Small_Object_Pool * const pool = arena_base->sized_header_pools[i];
-
- if (pool) {
- const int ret_val = (func)(interp, pool, POOL_BUFFER, arg);
- if (ret_val)
- return ret_val;
- }
- }
- }
-
- return 0;
-}
-
-
-/*
-
-=item C<void free_pool(Small_Object_Pool *pool)>
-
-Frees a pool and all of its arenas. Loops through the list of arenas backwards
-and returns each to the memory manager. Then, frees the pool structure itself.
-
-=cut
-
-*/
-
-void
-free_pool(ARGMOD(Small_Object_Pool *pool))
-{
- ASSERT_ARGS(free_pool)
- Small_Object_Arena *cur_arena;
-
- for (cur_arena = pool->last_Arena; cur_arena;) {
- Small_Object_Arena * const next = cur_arena->prev;
- mem_internal_free(cur_arena->start_objects);
- mem_internal_free(cur_arena);
- cur_arena = next;
- }
- mem_internal_free(pool);
-}
-
-/*
-
-=back
-
-=head1 SEE ALSO
-
-F<include/parrot/gc_pools.h>.
-
-=head1 HISTORY
-
-Initial version by Mike Lambert on 2002.05.27.
-
-=cut
-
-*/
-
-
-/*
- * Local variables:
- * c-file-style: "parrot"
- * End:
- * vim: expandtab shiftwidth=4:
- */
Deleted: branches/pmc_pct/src/gc/register.c
==============================================================================
--- branches/pmc_pct/src/gc/register.c Thu Jun 4 02:32:48 2009 (r39376)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,799 +0,0 @@
-/*
-Copyright (C) 2001-2009, Parrot Foundation.
-$Id$
-
-=head1 NAME
-
-src/gc/register.c - Register handling routines
-
-=head1 DESCRIPTION
-
-Parrot has 4 register sets, one for each of its basic types. The number of
-registers in each set varies depending on the use counts of the subroutine and
-is determined by the PASM/PIR compiler in the register allocation pass
-(F<imcc/reg_alloc.c>).
-
-=cut
-
-*/
-
-#include "parrot/parrot.h"
-#include "parrot/register.h"
-#include "../pmc/pmc_sub.h"
-
-
-/* set CTX_LEAK_DEBUG_FULL to 1 for enhanced context debugging.
- * When set (1) freed contexts are "poisoned" so that any dangling
- * references produce segfaults, and (2) contexts are not recycled
- * so that later allocations don't suddenly restore a dangling
- * reference to a "working" condition.
- */
-#define CTX_LEAK_DEBUG_FULL 0
-
-
-
-/* HEADERIZER HFILE: include/parrot/register.h */
-
-/* HEADERIZER BEGIN: static */
-/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
-
-static void clear_regs(PARROT_INTERP, ARGMOD(Parrot_Context *ctx))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- FUNC_MODIFIES(*ctx);
-
-static void init_context(PARROT_INTERP,
- ARGMOD(Parrot_Context *ctx),
- ARGIN_NULLOK(const Parrot_Context *old))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- FUNC_MODIFIES(*ctx);
-
-#define ASSERT_ARGS_clear_regs __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(ctx)
-#define ASSERT_ARGS_init_context __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(ctx)
-/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
-/* HEADERIZER END: static */
-
-
-/*
-=head2 Context and register frame layout
-
- +----------++----+------+------------+----+
- | context || N | I | P | S +
- +----------++----+------+------------+----+
- ^ ^ ^ ^
- | | ctx.bp ctx.bp_ps
- ctx.state opt
- padding
-
-Registers are addressed as usual via the register base pointer ctx.bp.
-
-The macro CONTEXT() hides these details
-
-=cut
-
-*/
-
-/*
-=head2 Context and register frame allocation
-
-There are two allocation strategies: chunked memory and malloced with a free
-list.
-
- CHUNKED_CTX_MEM = 1
-
-C<ctx_mem.data> is a pointer to an allocated chunk of memory. The pointer
-C<ctx_mem.free> holds the next usable location. With (full) continuations the
-C<ctx_mem.free> pointer can't be moved below the C<ctx_mem.threshold>, which is
-the highest context pointer of all active continuations.
-
-[the code for this is incomplete; it had suffered some bit-rot and was
-getting in the way of maintaining the other case. -- rgr, 4-Feb-06.]
-
-RT #46177 GC has to lower this threshold when collecting continuations.
-
- CHUNKED_CTX_MEM = 0
-
-Context/register memory is malloced. C<ctx_mem.free> is used as a free list of
-reusable items.
-
-=cut
-
-*/
-
-#define CTX_ALLOC_SIZE 0x20000
-
-#define ALIGNED_CTX_SIZE (((sizeof (Parrot_Context) + NUMVAL_SIZE - 1) \
- / NUMVAL_SIZE) * NUMVAL_SIZE)
-
-/*
-
-=pod
-
-Round register allocation size up to the nearest multiple of 8. A granularity
-of 8 is arbitrary, it could have been some bigger power of 2. A "slot" is an
-index into the free_list array. Each slot in free_list has a linked list of
-pointers to already allocated contexts available for (re)use. The slot where
-an available context is stored corresponds to the size of the context.
-
-=cut
-
-*/
-
-#define SLOT_CHUNK_SIZE 8
-
-#define ROUND_ALLOC_SIZE(size) ((((size) + SLOT_CHUNK_SIZE - 1) \
- / SLOT_CHUNK_SIZE) * SLOT_CHUNK_SIZE)
-#define CALCULATE_SLOT_NUM(size) ((size) / SLOT_CHUNK_SIZE)
-
-#if CHUNKED_CTX_MEM
- # error "Non-working code removed."
-#endif
-
-/*
-
-=head2 Context and Register Allocation Functions
-
-=over 4
-
-=cut
-
-*/
-
-/*
-
-=item C<void destroy_context(PARROT_INTERP)>
-
-Frees allocated context memory.
-
-=cut
-
-*/
-
-void
-destroy_context(PARROT_INTERP)
-{
- ASSERT_ARGS(destroy_context)
- Parrot_Context *context = CONTEXT(interp);
- int slot;
-
- while (context) {
- Parrot_Context * const prev = context->caller_ctx;
- Parrot_free_context(interp, context, 1);
- context = prev;
- }
-
- /* clear freed contexts */
- for (slot = 0; slot < interp->ctx_mem.n_free_slots; ++slot) {
- void *ptr = interp->ctx_mem.free_list[slot];
- while (ptr) {
- void * const next = *(void **) ptr;
- mem_sys_free(ptr);
- ptr = next;
- }
- }
- mem_sys_free(interp->ctx_mem.free_list);
-}
-
-
-/*
-
-=item C<void create_initial_context(PARROT_INTERP)>
-
-Creates the interpreter's initial context.
-
-=cut
-
-*/
-
-void
-create_initial_context(PARROT_INTERP)
-{
- ASSERT_ARGS(create_initial_context)
- static INTVAL num_regs[] = {32, 32, 32, 32};
- Parrot_Context *ignored;
-
- /* Create some initial free_list slots. */
-
-#define INITIAL_FREE_SLOTS 8
- interp->ctx_mem.n_free_slots = INITIAL_FREE_SLOTS;
- interp->ctx_mem.free_list = mem_allocate_n_zeroed_typed(INITIAL_FREE_SLOTS, void *);
-
- /* For now create context with 32 regs each. Some src tests (and maybe
- * other extenders) assume the presence of these registers */
- ignored = Parrot_set_new_context(interp, num_regs);
- UNUSED(ignored);
-}
-
-
-/*
-
-=item C<void parrot_gc_context(PARROT_INTERP)>
-
-Cleans up dead context memory; called by the garbage collector. This only
-applies in the chunked context memory scheme.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-void
-parrot_gc_context(PARROT_INTERP)
-{
- ASSERT_ARGS(parrot_gc_context)
-#if CHUNKED_CTX_MEM
- Parrot_Context ctx;
- ASSERT_ARGS(parrot_gc_context)
-
- if (!interp->ctx_mem.threshold)
- return;
- LVALUE_CAST(char *, ctx.bp) = interp->ctx_mem.threshold
- - sizeof (parrot_regs_t);
-#else
- UNUSED(interp);
-#endif
-}
-
-
-/*
-
-=item C<static void clear_regs(PARROT_INTERP, Parrot_Context *ctx)>
-
-Clears all registers in a context. PMC and STRING registers contain PMCNULL
-and NULL, respectively. Integer and float registers contain negative flag
-values, for debugging purposes.
-
-=cut
-
-*/
-
-static void
-clear_regs(PARROT_INTERP, ARGMOD(Parrot_Context *ctx))
-{
- ASSERT_ARGS(clear_regs)
- int i;
-
- /* NULL out registers - P/S have to be NULL for GC
- *
- * if the architecture has 0x := NULL and 0.0 we could memset too
- */
-
- for (i = 0; i < ctx->n_regs_used[REGNO_PMC]; i++) {
- CTX_REG_PMC(ctx, i) = PMCNULL;
- }
-
- for (i = 0; i < ctx->n_regs_used[REGNO_STR]; i++) {
- CTX_REG_STR(ctx, i) = NULL;
- }
-
- if (Interp_debug_TEST(interp, PARROT_REG_DEBUG_FLAG)) {
- /* depending on -D40 we set int and num to be identifiable garbage values */
- for (i = 0; i < ctx->n_regs_used[REGNO_INT]; i++) {
- CTX_REG_INT(ctx, i) = -999;
- }
- for (i = 0; i < ctx->n_regs_used[REGNO_NUM]; i++) {
- CTX_REG_NUM(ctx, i) = -99.9;
- }
- }
-}
-
-
-/*
-
-=item C<static void init_context(PARROT_INTERP, Parrot_Context *ctx, const
-Parrot_Context *old)>
-
-Initializes a freshly allocated or recycled context.
-
-=cut
-
-*/
-
-static void
-init_context(PARROT_INTERP, ARGMOD(Parrot_Context *ctx),
- ARGIN_NULLOK(const Parrot_Context *old))
-{
- ASSERT_ARGS(init_context)
- ctx->ref_count = 0;
- ctx->gc_mark = 0;
- ctx->current_results = NULL;
- ctx->results_signature = NULL;
- ctx->lex_pad = PMCNULL;
- ctx->outer_ctx = NULL;
- ctx->current_cont = NULL;
- ctx->current_object = NULL;
- ctx->current_HLL = 0;
- ctx->handlers = PMCNULL;
-
- if (old) {
- /* some items should better be COW copied */
- ctx->constants = old->constants;
- ctx->warns = old->warns;
- ctx->errors = old->errors;
- ctx->trace_flags = old->trace_flags;
- ctx->pred_offset = old->pred_offset;
- ctx->current_HLL = old->current_HLL;
- ctx->current_namespace = old->current_namespace;
- /* end COW */
- ctx->recursion_depth = old->recursion_depth;
- }
-
- /* other stuff is set inside Sub.invoke */
- clear_regs(interp, ctx);
-}
-
-
-/*
-
-=item C<Parrot_Context * Parrot_push_context(PARROT_INTERP, const INTVAL
-*n_regs_used)>
-
-Creates and sets the current context to a new context, remembering the old
-context in C<caller_ctx>. Suitable to use with C<Parrot_pop_context>.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-PARROT_WARN_UNUSED_RESULT
-PARROT_CANNOT_RETURN_NULL
-Parrot_Context *
-Parrot_push_context(PARROT_INTERP, ARGIN(const INTVAL *n_regs_used))
-{
- ASSERT_ARGS(Parrot_push_context)
- Parrot_Context * const old = CONTEXT(interp);
- Parrot_Context * const ctx = Parrot_set_new_context(interp, n_regs_used);
-
- ctx->caller_ctx = old;
-
- /* doesn't change */
- ctx->current_sub = old->current_sub;
-
- /* copy more ? */
- return ctx;
-}
-
-
-/*
-
-=item C<void Parrot_pop_context(PARROT_INTERP)>
-
-Frees the context created with C<Parrot_push_context> and restores the previous
-context (the caller context).
-
-=cut
-
-*/
-
-PARROT_EXPORT
-void
-Parrot_pop_context(PARROT_INTERP)
-{
- ASSERT_ARGS(Parrot_pop_context)
- Parrot_Context * const ctx = CONTEXT(interp);
- Parrot_Context * const old = ctx->caller_ctx;
-
-#if CTX_LEAK_DEBUG
- if (ctx->ref_count > 0 &&
- Interp_debug_TEST(interp, PARROT_CTX_DESTROY_DEBUG_FLAG)) {
- fprintf(stderr, "[force recycle of context %p (%d refs)]\n",
- (void *)ctx, ctx->ref_count);
- }
-#endif
- ctx->ref_count = 0;
- Parrot_free_context(interp, ctx, 0);
-
- /* restore old, set cached interpreter base pointers */
- CONTEXT(interp) = old;
- interp->ctx.bp = old->bp;
- interp->ctx.bp_ps = old->bp_ps;
-}
-
-
-/*
-
-=item C<Parrot_Context * Parrot_alloc_context(PARROT_INTERP, const INTVAL
-*number_regs_used, Parrot_Context *old)>
-
-Allocates and returns a new context. Does not set this new context as the
-current context. Note that the register usage C<n_regs_used> is copied. Use
-the init flag to indicate whether you want to initialize the new context
-(setting its default values and clearing its registers).
-
-=cut
-
-*/
-
-PARROT_CANNOT_RETURN_NULL
-PARROT_WARN_UNUSED_RESULT
-Parrot_Context *
-Parrot_alloc_context(PARROT_INTERP, ARGIN(const INTVAL *number_regs_used),
- ARGIN_NULLOK(Parrot_Context *old))
-{
- ASSERT_ARGS(Parrot_alloc_context)
- Parrot_Context *ctx;
- void *p;
-
- const size_t size_i = sizeof (INTVAL) * number_regs_used[REGNO_INT];
- const size_t size_n = sizeof (FLOATVAL) * number_regs_used[REGNO_NUM];
- const size_t size_s = sizeof (STRING *) * number_regs_used[REGNO_STR];
- const size_t size_p = sizeof (PMC *) * number_regs_used[REGNO_PMC];
-
- const size_t size_nip = size_n + size_i + size_p;
- const size_t all_regs_size = size_n + size_i + size_p + size_s;
- const size_t reg_alloc = ROUND_ALLOC_SIZE(all_regs_size);
- const int slot = CALCULATE_SLOT_NUM(reg_alloc);
-
- /* this gets attached to the context, which should free it */
- INTVAL * const n_regs_used = mem_allocate_n_zeroed_typed(4, INTVAL);
- n_regs_used[REGNO_INT] = number_regs_used[REGNO_INT];
- n_regs_used[REGNO_NUM] = number_regs_used[REGNO_NUM];
- n_regs_used[REGNO_STR] = number_regs_used[REGNO_STR];
- n_regs_used[REGNO_PMC] = number_regs_used[REGNO_PMC];
-
- /*
- * If slot is beyond the end of the allocated list, extend the list to
- * allocate more slots.
- */
- if (slot >= interp->ctx_mem.n_free_slots) {
- const int extend_size = slot + 1;
- int i;
-
- mem_realloc_n_typed(interp->ctx_mem.free_list, extend_size, void *);
- for (i = interp->ctx_mem.n_free_slots; i < extend_size; ++i)
- interp->ctx_mem.free_list[i] = NULL;
- interp->ctx_mem.n_free_slots = extend_size;
- }
-
- /*
- * The free_list contains a linked list of pointers for each size (slot
- * index). Pop off an available context of the desired size from free_list.
- * If no contexts of the desired size are available, allocate a new one.
- */
- ctx = (Parrot_Context *)interp->ctx_mem.free_list[slot];
-
- if (ctx) {
- /*
- * Store the next pointer from the linked list for this size (slot
- * index) in free_list. On "*(void **) ctx", C won't dereference a void
- * * pointer (untyped), so type cast ctx to void ** (a dereference-able
- * type) then dereference it to get a void *. Store the dereferenced
- * value (the next pointer in the linked list) in free_list.
- */
- interp->ctx_mem.free_list[slot] = *(void **)ctx;
- }
- else {
- const size_t to_alloc = reg_alloc + ALIGNED_CTX_SIZE;
- ctx = (Parrot_Context *)mem_sys_allocate_zeroed(to_alloc);
- }
-
-#if CTX_LEAK_DEBUG
- if (Interp_debug_TEST(interp, PARROT_CTX_DESTROY_DEBUG_FLAG)) {
- fprintf(stderr, "[alloc ctx %p]\n", ctx);
- }
-#endif
-
- ctx->regs_mem_size = reg_alloc;
- ctx->n_regs_used = n_regs_used;
-
- /* regs start past the context */
- p = (void *) ((char *)ctx + ALIGNED_CTX_SIZE);
-
- /* ctx.bp points to I0, which has Nx on the left */
- ctx->bp.regs_i = (INTVAL *)((char *)p + size_n);
-
- /* ctx.bp_ps points to S0, which has Px on the left */
- ctx->bp_ps.regs_s = (STRING **)((char *)p + size_nip);
-
- init_context(interp, ctx, old);
-
- return ctx;
-}
-
-
-/*
-
-=item C<Parrot_Context * Parrot_set_new_context(PARROT_INTERP, const INTVAL
-*number_regs_used)>
-
-Allocates and returns a new context as the current context. Note that the
-register usage C<n_regs_used> is copied.
-
-=cut
-
-*/
-
-PARROT_CANNOT_RETURN_NULL
-PARROT_WARN_UNUSED_RESULT
-Parrot_Context *
-Parrot_set_new_context(PARROT_INTERP, ARGIN(const INTVAL *number_regs_used))
-{
- ASSERT_ARGS(Parrot_set_new_context)
- Parrot_Context *old = CONTEXT(interp);
- Parrot_Context *ctx = Parrot_alloc_context(interp, number_regs_used, old);
-
- CONTEXT(interp) = ctx;
- interp->ctx.bp.regs_i = ctx->bp.regs_i;
- interp->ctx.bp_ps.regs_s = ctx->bp_ps.regs_s;
-
- return ctx;
-}
-
-
-/*
-
-=item C<void Parrot_free_context(PARROT_INTERP, Parrot_Context *ctx, int deref)>
-
-Frees the context if its reference count is zero. If C<deref>
-is true, then reduce the reference count prior to determining
-if the context should be freed.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-void
-Parrot_free_context(PARROT_INTERP, ARGMOD(Parrot_Context *ctx), int deref)
-{
- ASSERT_ARGS(Parrot_free_context)
- /*
- * The context structure has a reference count, initially 0.
- * This field is incremented when something outside of the normal
- * calling chain (such as a continuation or outer scope) wants to
- * preserve the context. The field is decremented when
- * Parrot_free_context is called with the C<deref> flag set true.
- * To trace context handling and check for leaks,
- * (a) disable NDEBUG, (b) enable CTX_LEAK_DEBUG in interpreter.h,
- * and (c) execute "debug 0x80" in a (preferably small) test case.
- *
- */
- if (deref) {
-#if CTX_LEAK_DEBUG
- if (Interp_debug_TEST(interp, PARROT_CTX_DESTROY_DEBUG_FLAG)) {
- fprintf(stderr, "[reference to context %p released]\n", (void*)ctx);
- }
-#endif
- ctx->ref_count--;
- }
- if (ctx->ref_count <= 0) {
- void *ptr;
- int slot;
-
-#ifndef NDEBUG
- if (Interp_debug_TEST(interp, PARROT_CTX_DESTROY_DEBUG_FLAG)
- && ctx->current_sub) {
- /* can't probably Parrot_io_eprintf here */
- Parrot_sub *doomed;
- PMC_get_sub(interp, ctx->current_sub, doomed);
-
- if (doomed) {
- fprintf(stderr, "[free ctx %p of sub '%s']\n",
- (void *)ctx,
- (doomed->name == (void*)0xdeadbeef
- ? "???"
- : (char*)doomed->name->strstart));
- }
- else {
- Parrot_ex_throw_from_c_args(interp, NULL, 1,
- "NULL doomed sub detected in Parrot_free_context");
- }
- }
-#endif
-
- if (ctx->outer_ctx)
- Parrot_free_context(interp, ctx->outer_ctx, 1);
-
- if (ctx->n_regs_used) {
- mem_sys_free(ctx->n_regs_used);
- ctx->n_regs_used = NULL;
- }
-
-#if CTX_LEAK_DEBUG_FULL
- /* for debugging, poison the freed context in case anything
- * tries to use it later. */
- ctx->current_results = (opcode_t *)0xbeefcafe;
- ctx->results_signature = (PMC *)0xbeefcafe;
- ctx->lex_pad = (PMC *)0xbeefcafe;
- ctx->outer_ctx = (Parrot_Context *)0xbeefcafe;
- ctx->current_cont = (PMC *)0xbeefcafe;
- ctx->current_object = (PMC *)0xbeefcafe;
- ctx->current_HLL = -1;
- ctx->handlers = (PMC *)0xbeefcafe;
- ctx->constants = (struct PackFile_Constant **)0xbeefcafe;
- ctx->current_namespace = (PMC *)0xbeefcafe;
-#endif
-
- /* don't put the same context on the free list multiple times; we don't
- * have the re-use versus multiple ref count semantics right yet */
- if (ctx->ref_count < 0)
- return;
-
- /* force the reference count negative to indicate a dead context
- * so mark_context (src/sub.c) can report it */
- ctx->ref_count--;
-
- ptr = ctx;
- slot = CALCULATE_SLOT_NUM(ctx->regs_mem_size);
-
-#if CTX_LEAK_DEBUG_FULL
- slot = 0;
-#endif
-
- PARROT_ASSERT(slot < interp->ctx_mem.n_free_slots);
- *(void **)ptr = interp->ctx_mem.free_list[slot];
- interp->ctx_mem.free_list[slot] = ptr;
- }
-}
-
-
-/*
-
-=item C<Parrot_Context * Parrot_context_ref_trace(PARROT_INTERP, Parrot_Context
-*ctx, const char *file, int line)>
-
-Helper function to trace references when CTX_LEAK_DEBUG is set.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-PARROT_CANNOT_RETURN_NULL
-Parrot_Context *
-Parrot_context_ref_trace(PARROT_INTERP, ARGMOD(Parrot_Context *ctx),
- ARGIN(const char *file), int line)
-{
- ASSERT_ARGS(Parrot_context_ref_trace)
- if (Interp_debug_TEST(interp, PARROT_CTX_DESTROY_DEBUG_FLAG)) {
- const char *name = "unknown";
- Parrot_sub *sub;
-
- PMC_get_sub(interp, ctx->current_sub, sub);
- if (ctx->current_sub)
- name = (char *)(sub->name->strstart);
-
- fprintf(stderr, "[reference to context %p ('%s') taken at %s:%d]\n",
- (void *)ctx, name, file, line);
- }
-
- ctx->ref_count++;
- return ctx;
-}
-
-
-/*
-
-=item C<void Parrot_set_context_threshold(PARROT_INTERP, Parrot_Context *ctx)>
-
-Marks the context as possible threshold.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-void
-Parrot_set_context_threshold(SHIM_INTERP, SHIM(Parrot_Context *ctx))
-{
- ASSERT_ARGS(Parrot_set_context_threshold)
- /* nothing to do */
-}
-
-/*
-
-=back
-
-=head2 Register Stack Functions
-
-=over 4
-
-=cut
-
-=item C<void Parrot_clear_i(PARROT_INTERP)>
-
-Sets all integer registers in the current context to 0.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-void
-Parrot_clear_i(PARROT_INTERP)
-{
- ASSERT_ARGS(Parrot_clear_i)
- int i;
- for (i = 0; i < CONTEXT(interp)->n_regs_used[REGNO_INT]; ++i)
- REG_INT(interp, i) = 0;
-}
-
-
-/*
-
-=item C<void Parrot_clear_s(PARROT_INTERP)>
-
-Sets all STRING registers in the current context to NULL.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-void
-Parrot_clear_s(PARROT_INTERP)
-{
- ASSERT_ARGS(Parrot_clear_s)
- int i;
- for (i = 0; i < CONTEXT(interp)->n_regs_used[REGNO_STR]; ++i)
- REG_STR(interp, i) = NULL;
-}
-
-
-/*
-
-=item C<void Parrot_clear_p(PARROT_INTERP)>
-
-Sets all PMC registers in the current context to NULL.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-void
-Parrot_clear_p(PARROT_INTERP)
-{
- ASSERT_ARGS(Parrot_clear_p)
- int i;
- for (i = 0; i < CONTEXT(interp)->n_regs_used[REGNO_PMC]; ++i)
- REG_PMC(interp, i) = PMCNULL;
-}
-
-
-/*
-
-=item C<void Parrot_clear_n(PARROT_INTERP)>
-
-Sets all number registers in the current context to 0.0.
-
-=cut
-
-*/
-
-PARROT_EXPORT
-void
-Parrot_clear_n(PARROT_INTERP)
-{
- ASSERT_ARGS(Parrot_clear_n)
- int i;
- for (i = 0; i < CONTEXT(interp)->n_regs_used[REGNO_NUM]; ++i)
- REG_NUM(interp, i) = 0.0;
-}
-
-
-/*
-
-=back
-
-=head1 SEE ALSO
-
-F<include/parrot/register.h> and F<src/stacks.c>.
-
-=cut
-
-*/
-
-
-/*
- * Local variables:
- * c-file-style: "parrot"
- * End:
- * vim: expandtab shiftwidth=4:
- */
Modified: branches/pmc_pct/src/gc/res_lea.c
==============================================================================
--- branches/pmc_pct/src/gc/res_lea.c Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/gc/res_lea.c Thu Jun 4 02:32:48 2009 (r39377)
@@ -155,7 +155,8 @@
/*
-=item C<void Parrot_allocate(PARROT_INTERP, Buffer *buffer, size_t size)>
+=item C<void Parrot_gc_allocate_buffer_storage_aligned(PARROT_INTERP,
+Buffer *buffer, size_t size)>
Allocate buffer memory for the given Buffer pointer. The C<size>
has to be a multiple of the word size.
@@ -238,7 +239,7 @@
/*
-=item C<void Parrot_initialize_memory_pools(PARROT_INTERP)>
+=item C<void initialize_memory_pools(PARROT_INTERP)>
Does nothing.
@@ -247,14 +248,14 @@
*/
void
-Parrot_initialize_memory_pools(PARROT_INTERP)
+initialize_memory_pools(PARROT_INTERP)
{
ASSERT_ARGS(parrot_initialize_memory_pools)
}
/*
-=item C<void Parrot_merge_memory_pools(Interp *dest, Interp *source)>
+=item C<void Parrot_gc_merge_memory_pools(Interp *dest, Interp *source)>
Does nothing.
@@ -262,7 +263,7 @@
*/
void
-Parrot_merge_memory_pools(Interp *dest, Interp *source)
+Parrot_gc_merge_memory_pools(Interp *dest, Interp *source)
{
ASSERT_ARGS(parrot_merge_memory_pools)
}
Deleted: branches/pmc_pct/src/gc/resources.c
==============================================================================
--- branches/pmc_pct/src/gc/resources.c Thu Jun 4 02:32:48 2009 (r39376)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,829 +0,0 @@
-/*
-Copyright (C) 2001-2009, Parrot Foundation.
-$Id$
-
-=head1 NAME
-
-src/gc/resources.c - Allocate and deallocate tracked resources
-
-=head1 DESCRIPTION
-
-Functions to manage non-PObj memory, including strings and buffers.
-
-=head2 Parrot Memory Management Code
-
-=over 4
-
-=cut
-
-*/
-
-#include "parrot/parrot.h"
-#include "gc_private.h"
-
-
-#define RECLAMATION_FACTOR 0.20
-#define WE_WANT_EVER_GROWING_ALLOCATIONS 0
-
-/* show allocated blocks on stderr */
-#define RESOURCE_DEBUG 0
-#define RESOURCE_DEBUG_SIZE 1000000
-
-#define POOL_SIZE 65536 * 2
-
-typedef void (*compact_f) (Interp *, Memory_Pool *);
-
-/* HEADERIZER HFILE: src/gc/gc_private.h */
-
-/* HEADERIZER BEGIN: static */
-/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
-
-static void alloc_new_block(PARROT_INTERP,
- size_t size,
- ARGMOD(Memory_Pool *pool),
- ARGIN(const char *why))
- __attribute__nonnull__(1)
- __attribute__nonnull__(3)
- __attribute__nonnull__(4)
- FUNC_MODIFIES(*pool);
-
-PARROT_CANNOT_RETURN_NULL
-PARROT_WARN_UNUSED_RESULT
-static const char* buffer_location(PARROT_INTERP, ARGIN(const PObj *b))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2);
-
-static void debug_print_buf(PARROT_INTERP, ARGIN(const PObj *b))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2);
-
-PARROT_MALLOC
-PARROT_CANNOT_RETURN_NULL
-static Memory_Pool * new_memory_pool(
- size_t min_block,
- NULLOK(compact_f compact));
-
-#define ASSERT_ARGS_alloc_new_block __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(pool) \
- || PARROT_ASSERT_ARG(why)
-#define ASSERT_ARGS_buffer_location __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(b)
-#define ASSERT_ARGS_debug_print_buf __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(b)
-#define ASSERT_ARGS_new_memory_pool __attribute__unused__ int _ASSERT_ARGS_CHECK = 0
-/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
-/* HEADERIZER END: static */
-
-
-/*
-
-=item C<static void alloc_new_block(PARROT_INTERP, size_t size, Memory_Pool
-*pool, const char *why)>
-
-Allocate a new memory block. We allocate either the requested size or the
-default size, whichever is larger. Add the new block to the given memory
-pool. The given C<char *why> text is used for debugging.
-
-=cut
-
-*/
-
-static void
-alloc_new_block(PARROT_INTERP, size_t size, ARGMOD(Memory_Pool *pool),
- ARGIN(const char *why))
-{
- ASSERT_ARGS(alloc_new_block)
- Memory_Block *new_block;
-
- const size_t alloc_size = (size > pool->minimum_block_size)
- ? size : pool->minimum_block_size;
-
-#if RESOURCE_DEBUG
- fprintf(stderr, "new_block (%s) size %u -> %u\n",
- why, size, alloc_size);
-#else
- UNUSED(why)
-#endif
-
- /* Allocate a new block. Header info's on the front */
- new_block = (Memory_Block *)mem_internal_allocate_zeroed(
- sizeof (Memory_Block) + alloc_size);
-
- if (!new_block) {
- fprintf(stderr, "out of mem allocsize = %d\n", (int)alloc_size);
- exit(EXIT_FAILURE);
- }
-
- new_block->free = alloc_size;
- new_block->size = alloc_size;
-
- new_block->next = NULL;
- new_block->start = (char *)new_block + sizeof (Memory_Block);
- new_block->top = new_block->start;
-
- /* Note that we've allocated it */
- interp->arena_base->memory_allocated += alloc_size;
-
- /* If this is for a public pool, add it to the list */
- new_block->prev = pool->top_block;
-
- /* If we're not first, then tack us on the list */
- if (pool->top_block)
- pool->top_block->next = new_block;
-
- pool->top_block = new_block;
- pool->total_allocated += alloc_size;
-}
-
-/*
-
-=item C<void * mem_allocate(PARROT_INTERP, size_t size, Memory_Pool *pool)>
-
-Allocates memory for headers.
-
-Alignment problems history:
-
-See L<http://archive.develooper.com/perl6-internals%40perl.org/msg12310.html>
-for details.
-
-- return aligned pointer *if needed*
-- return strings et al at unaligned i.e. void* boundaries
-- remember alignment in a buffer header bit
- use this in compaction code
-- reduce alignment to a reasonable value i.e. MALLOC_ALIGNMENT
- aka 2*sizeof (size_t) or just 8 (TODO make a config hint)
-
-Buffer memory layout:
-
- +-----------------+
- | ref_count |f | # GC header
- obj->bufstart -> +-----------------+
- | data |
- v v
-
- * if PObj_is_COWable is set, then we have
- - a ref_count, {inc, dec}remented by 2 always
- - the lo bit 'f' means 'is being forwarded" - what TAIL_flag was
-
- * if PObj_align_FLAG is set, obj->bufstart is aligned like discussed above
- * obj->buflen is the usable length excluding the optional GC part.
-
-=cut
-
-*/
-
-PARROT_MALLOC
-PARROT_CANNOT_RETURN_NULL
-void *
-mem_allocate(PARROT_INTERP, size_t size, ARGMOD(Memory_Pool *pool))
-{
- ASSERT_ARGS(mem_allocate)
- void *return_val;
-
- /* we always should have one block at least */
- PARROT_ASSERT(pool->top_block);
-
- /* If not enough room, try to find some */
- if (pool->top_block->free < size) {
- /*
- * force a GC mark run to get live flags set
- * for incremental M&S collection is run from there
- * but only if there may be something worth collecting!
- * TODO pass required allocation size to the GC system,
- * so that collection can be skipped if needed
- */
- if (!interp->arena_base->gc_mark_block_level
- && interp->arena_base->mem_allocs_since_last_collect) {
- Parrot_gc_mark_and_sweep(interp, GC_trace_stack_FLAG);
-#if !PARROT_GC_IMS
- /* Compact the pool if allowed and worthwhile */
- if (pool->compact) {
- /* don't bother reclaiming if it's just chicken feed */
- if ((pool->possibly_reclaimable * pool->reclaim_factor +
- pool->guaranteed_reclaimable) > size) {
- (*pool->compact) (interp, pool);
- }
-
- }
-#endif
- }
- if (pool->top_block->free < size) {
- if (pool->minimum_block_size < 65536 * 16)
- pool->minimum_block_size *= 2;
- /*
- * TODO - Big blocks
- *
- * Mark the block as big block (it has just one item)
- * And don't set big blocks as the top_block.
- */
- alloc_new_block(interp, size, pool, "compact failed");
-
- interp->arena_base->mem_allocs_since_last_collect++;
-
- if (pool->top_block->free < size) {
- fprintf(stderr, "out of mem\n");
- exit(EXIT_FAILURE);
- }
- }
- }
-
- /* TODO inline the fast path */
- return_val = pool->top_block->top;
- pool->top_block->top += size;
- pool->top_block->free -= size;
-
- return return_val;
-}
-
-/*
-
-=item C<static const char* buffer_location(PARROT_INTERP, const PObj *b)>
-
-Recturns a constant string representing the location of the given
-PObj C<b> in one of the PMC registers. If the PMC is not located
-in one of the PMC registers of the current context, returns the
-string C<"???">.
-
-=cut
-
-*/
-
-#if RESOURCE_DEBUG
-PARROT_CANNOT_RETURN_NULL
-PARROT_WARN_UNUSED_RESULT
-static const char*
-buffer_location(PARROT_INTERP, ARGIN(const PObj *b))
-{
- ASSERT_ARGS(buffer_location)
- int i;
- static char reg[10];
-
- Parrot_Context* const ctx = CONTEXT(interp);
-
- for (i = 0; i < ctx->n_regs_used[REGNO_STR]; ++i) {
- PObj * const obj = (PObj *) CTX_REG_STR(interp, ctx, i);
- if (obj == b) {
- sprintf(reg, "S%d", i);
- return reg;
- }
- }
-
- return "???";
-}
-
-/*
-
-=item C<static void debug_print_buf(PARROT_INTERP, const PObj *b)>
-
-Prints a debug statement with information about the given PObj C<b>.
-=cut
-
-*/
-
-static void
-debug_print_buf(PARROT_INTERP, ARGIN(const PObj *b))
-{
- ASSERT_ARGS(debug_print_buf)
- fprintf(stderr, "found %p, len %d, flags 0x%08x at %s\n",
- b, (int)PObj_buflen(b), (uint)PObj_get_FLAGS(b),
- buffer_location(interp, b));
-}
-#endif
-
-/*
-
-=back
-
-=head2 Compaction Code
-
-=over 4
-
-=item C<void compact_pool(PARROT_INTERP, Memory_Pool *pool)>
-
-Compact the string buffer pool. Does not perform a GC scan, or mark items
-as being alive in any way.
-
-=cut
-
-*/
-
-void
-compact_pool(PARROT_INTERP, ARGMOD(Memory_Pool *pool))
-{
- ASSERT_ARGS(compact_pool)
- INTVAL j;
- UINTVAL total_size;
-
- Memory_Block *new_block; /* A pointer to our working block */
- char *cur_spot; /* Where we're currently copying to */
-
- Small_Object_Arena *cur_buffer_arena;
- Arenas * const arena_base = interp->arena_base;
-
- /* Bail if we're blocked */
- if (arena_base->gc_sweep_block_level)
- return;
-
- ++arena_base->gc_sweep_block_level;
-
- if (interp->profile)
- Parrot_gc_profile_start(interp);
-
- /* We're collecting */
- arena_base->mem_allocs_since_last_collect = 0;
- arena_base->header_allocs_since_last_collect = 0;
- arena_base->gc_collect_runs++;
-
- /* total - reclaimable == currently used. Add a minimum block to the
- * current amount, so we can avoid having to allocate it in the future. */
- {
- Memory_Block *cur_block = pool->top_block;
-
- total_size = 0;
-
- while (cur_block) {
- /*
- * TODO - Big blocks
- *
- * Currently all available blocks are compacted into on new
- * block with total_size. This is more than suboptimal, if
- * the block has just one live item from a big allocation.
- *
- * But currently it's unknown if the buffer memory is alive
- * as the live bits are in Buffer headers. We have to run the
- * compaction loop below to check liveness. OTOH if this
- * compaction is running through all the buffer headers, there
- * is no relation to the block.
- *
- *
- * Moving the life bit into the buffer thus also solves this
- * problem easily.
- */
- total_size += cur_block->size - cur_block->free;
- cur_block = cur_block->prev;
- }
- }
- /*
- * XXX for some reason the guarantee isn't correct
- * TODO check why
- */
-
- /* total_size -= pool->guaranteed_reclaimable; */
-
- /* this makes for ever increasing allocations but fewer collect runs */
-#if WE_WANT_EVER_GROWING_ALLOCATIONS
- total_size += pool->minimum_block_size;
-#endif
-
- /* Snag a block big enough for everything */
- alloc_new_block(interp, total_size, pool, "inside compact");
-
- new_block = pool->top_block;
-
- /* Start at the beginning */
- cur_spot = new_block->start;
-
- /* Run through all the Buffer header pools and copy */
- for (j = (INTVAL)arena_base->num_sized - 1; j >= 0; --j) {
- Small_Object_Pool * const header_pool = arena_base->sized_header_pools[j];
- UINTVAL object_size;
-
- if (!header_pool)
- continue;
-
- object_size = header_pool->object_size;
-
- for (cur_buffer_arena = header_pool->last_Arena;
- cur_buffer_arena;
- cur_buffer_arena = cur_buffer_arena->prev) {
- Buffer *b = (Buffer *)ARENA_to_PObj(cur_buffer_arena->start_objects);
- UINTVAL i;
-
- for (i = cur_buffer_arena->used; i; --i) {
- INTVAL *ref_count = NULL;
-
- /* ! (on_free_list | constant | external | sysmem) */
- if (PObj_buflen(b) && PObj_is_movable_TESTALL(b)) {
- ptrdiff_t offset = 0;
-#if RESOURCE_DEBUG
- if (PObj_buflen(b) >= RESOURCE_DEBUG_SIZE)
- debug_print_buf(interp, b);
-#endif
-
- /* we can't perform the math all the time, because
- * strstart might be in unallocated memory */
- if (PObj_is_COWable_TEST(b)) {
- ref_count = PObj_bufrefcountptr(b);
-
- if (PObj_is_string_TEST(b)) {
- offset = (ptrdiff_t)((STRING *)b)->strstart -
- (ptrdiff_t)PObj_bufstart(b);
- }
- }
-
- /* buffer has already been moved; just change the header */
- if (PObj_COW_TEST(b) &&
- (ref_count && *ref_count & Buffer_moved_FLAG)) {
- /* Find out who else references our data */
- Buffer * const hdr = *(Buffer **)(PObj_bufstart(b));
-
- PARROT_ASSERT(PObj_is_COWable_TEST(b));
-
- /* Make sure they know that we own it too */
- PObj_COW_SET(hdr);
-
- /* TODO incr ref_count, after fixing string too
- * Now make sure we point to where the other guy does */
- PObj_bufstart(b) = PObj_bufstart(hdr);
-
- /* And if we're a string, update strstart */
- /* Somewhat of a hack, but if we get per-pool
- * collections, it should help ease the pain */
- if (PObj_is_string_TEST(b)) {
- ((STRING *)b)->strstart = (char *)PObj_bufstart(b) +
- offset;
- }
- }
- else {
- cur_spot = aligned_mem(b, cur_spot);
-
- if (PObj_is_COWable_TEST(b)) {
- INTVAL * const new_ref_count = ((INTVAL*) cur_spot) - 1;
- *new_ref_count = 2;
- }
-
- /* Copy our memory to the new pool */
- memcpy(cur_spot, PObj_bufstart(b), PObj_buflen(b));
-
- /* If we're COW */
- if (PObj_COW_TEST(b)) {
- PARROT_ASSERT(PObj_is_COWable_TEST(b));
-
- /* Let the old buffer know how to find us */
- *(Buffer **)(PObj_bufstart(b)) = b;
-
- /* No guarantees that our data is still COW, so
- * assume not, and let the above code fix-up */
- PObj_COW_CLEAR(b);
-
- /* Finally, let the tail know that we've moved, so
- * that any other references can know to look for
- * us and not re-copy */
- if (ref_count)
- *ref_count |= Buffer_moved_FLAG;
- }
-
- PObj_bufstart(b) = cur_spot;
-
- if (PObj_is_string_TEST(b)) {
- ((STRING *)b)->strstart = (char *)PObj_bufstart(b) +
- offset;
- }
-
- cur_spot += PObj_buflen(b);
- }
- }
- b = (Buffer *)((char *)b + object_size);
- }
- }
- }
-
- /* Okay, we're done with the copy. Set the bits in the pool struct */
- /* First, where we allocate next */
- new_block->top = cur_spot;
-
- PARROT_ASSERT(new_block->size >= (size_t)new_block->top -
- (size_t)new_block->start);
-
- /* How much is free. That's the total size minus the amount we used */
- new_block->free = new_block->size - (new_block->top - new_block->start);
-
- arena_base->memory_collected += (new_block->top - new_block->start);
-
- /* Now we're done. We're already on the pool's free list, so let us be the
- * only one on the free list and free the rest */
- {
- Memory_Block *cur_block = new_block->prev;
-
- PARROT_ASSERT(new_block == pool->top_block);
-
- while (cur_block) {
- Memory_Block * const next_block = cur_block->prev;
-
- /* Note that we don't have it any more */
- arena_base->memory_allocated -= cur_block->size;
-
- /* We know the pool body and pool header are a single chunk, so
- * this is enough to get rid of 'em both */
- mem_internal_free(cur_block);
- cur_block = next_block;
- }
-
- /* Set our new pool as the only pool */
- new_block->prev = NULL;
- pool->total_allocated = total_size;
- }
-
- pool->guaranteed_reclaimable = 0;
- pool->possibly_reclaimable = 0;
-
- if (interp->profile)
- Parrot_gc_profile_end(interp, PARROT_PROF_GC);
-
- --arena_base->gc_sweep_block_level;
-}
-
-/*
-
-=item C<size_t aligned_size(const Buffer *buffer, size_t len)>
-
-Determines the size of Buffer C<buffer> which has nominal length C<len>.
-The actual size in RAM of the Buffer might be different because of
-alignment issues.
-
-=cut
-
-*/
-
-PARROT_PURE_FUNCTION
-PARROT_WARN_UNUSED_RESULT
-size_t
-aligned_size(ARGIN(const Buffer *buffer), size_t len)
-{
- ASSERT_ARGS(aligned_size)
- if (PObj_is_COWable_TEST(buffer))
- len += sizeof (void*);
- if (PObj_aligned_TEST(buffer))
- len = (len + BUFFER_ALIGN_1) & BUFFER_ALIGN_MASK;
- else
- len = (len + WORD_ALIGN_1) & WORD_ALIGN_MASK;
- return len;
-}
-
-/*
-
-=item C<char * aligned_mem(const Buffer *buffer, char *mem)>
-
-Returns a pointer to the aligned allocated storage for Buffer C<buffer>,
-which might not be the same as the pointer to C<buffeR> because of
-memory alignment.
-
-=cut
-
-*/
-
-PARROT_CANNOT_RETURN_NULL
-PARROT_WARN_UNUSED_RESULT
-char *
-aligned_mem(ARGIN(const Buffer *buffer), ARGIN(char *mem))
-{
- ASSERT_ARGS(aligned_mem)
- if (PObj_is_COWable_TEST(buffer))
- mem += sizeof (void*);
- if (PObj_aligned_TEST(buffer))
- mem = (char*)(((unsigned long)(mem + BUFFER_ALIGN_1)) &
- BUFFER_ALIGN_MASK);
- else
- mem = (char*)(((unsigned long)(mem + WORD_ALIGN_1)) & WORD_ALIGN_MASK);
-
- return mem;
-}
-
-/*
-
-=item C<size_t aligned_string_size(size_t len)>
-
-Determines the size of a string of length C<len> in RAM, accounting for
-alignment.
-
-=cut
-
-*/
-
-/* XXX Looks like we can lose buffer here */
-PARROT_CONST_FUNCTION
-PARROT_WARN_UNUSED_RESULT
-size_t
-aligned_string_size(size_t len)
-{
- ASSERT_ARGS(aligned_string_size)
- len += sizeof (void*);
- len = (len + WORD_ALIGN_1) & WORD_ALIGN_MASK;
- return len;
-}
-
-/*
-
-=back
-
-=head2 Parrot Re/Allocate Code
-
-=over 4
-
-
-=item C<void Parrot_allocate(PARROT_INTERP, Buffer *buffer, size_t size)>
-
-Allocate buffer memory for the given Buffer pointer. The C<size>
-has to be a multiple of the word size.
-C<PObj_buflen> will be set to exactly the given C<size>.
-
-=cut
-
-*/
-
-void
-Parrot_allocate(PARROT_INTERP, ARGOUT(Buffer *buffer), size_t size)
-{
- ASSERT_ARGS(Parrot_allocate)
- PObj_buflen(buffer) = 0;
- PObj_bufstart(buffer) = NULL;
- PARROT_ASSERT((size & WORD_ALIGN_1) == 0);
- PObj_bufstart(buffer) = mem_allocate(interp, size,
- interp->arena_base->memory_pool);
- PObj_buflen(buffer) = size;
-}
-
-/*
-
-=item C<static Memory_Pool * new_memory_pool(size_t min_block, compact_f
-compact)>
-
-Allocate a new C<Memory_Pool> structures, and set some initial values.
-return a pointer to the new pool.
-
-=cut
-
-*/
-
-PARROT_MALLOC
-PARROT_CANNOT_RETURN_NULL
-static Memory_Pool *
-new_memory_pool(size_t min_block, NULLOK(compact_f compact))
-{
- ASSERT_ARGS(new_memory_pool)
- Memory_Pool * const pool = mem_internal_allocate_typed(Memory_Pool);
-
- pool->top_block = NULL;
- pool->compact = compact;
- pool->minimum_block_size = min_block;
- pool->total_allocated = 0;
- pool->guaranteed_reclaimable = 0;
- pool->possibly_reclaimable = 0;
- pool->reclaim_factor = RECLAMATION_FACTOR;
-
- return pool;
-}
-
-/*
-
-=item C<void Parrot_initialize_memory_pools(PARROT_INTERP)>
-
-Initialize the managed memory pools. Parrot maintains two C<Memory_Pool>
-structures, the general memory pool and the constant string pool. Create
-and initialize both pool structures, and allocate initial blocks of memory
-for both.
-
-=cut
-
-*/
-
-void
-Parrot_initialize_memory_pools(PARROT_INTERP)
-{
- ASSERT_ARGS(Parrot_initialize_memory_pools)
- Arenas * const arena_base = interp->arena_base;
-
- arena_base->memory_pool = new_memory_pool(POOL_SIZE, &compact_pool);
- alloc_new_block(interp, POOL_SIZE, arena_base->memory_pool, "init");
-
- /* Constant strings - not compacted */
- arena_base->constant_string_pool = new_memory_pool(POOL_SIZE, NULL);
-
- alloc_new_block(interp, POOL_SIZE, arena_base->constant_string_pool, "init");
-}
-
-
-/*
-
-=item C<void merge_pools(Memory_Pool *dest, Memory_Pool *source)>
-
-Merge two memory pools together. Do this by moving all memory blocks
-from the C<*source> pool into the C<*dest> pool. The C<source> pool
-is emptied, but is not destroyed here.
-
-=cut
-
-*/
-
-void
-merge_pools(ARGMOD(Memory_Pool *dest), ARGMOD(Memory_Pool *source))
-{
- ASSERT_ARGS(merge_pools)
- Memory_Block *cur_block;
-
- cur_block = source->top_block;
-
- while (cur_block) {
- Memory_Block * const next_block = cur_block->prev;
-
- if (cur_block->free == cur_block->size) {
- mem_internal_free(cur_block);
- }
- else {
- cur_block->next = NULL;
- cur_block->prev = dest->top_block;
-
- dest->top_block = cur_block;
- dest->total_allocated += cur_block->size;
- }
- cur_block = next_block;
- }
-
- dest->guaranteed_reclaimable += source->guaranteed_reclaimable;
- dest->possibly_reclaimable += dest->possibly_reclaimable;
-
- source->top_block = NULL;
- source->total_allocated = 0;
- source->possibly_reclaimable = 0;
- source->guaranteed_reclaimable = 0;
-}
-
-/*
-
-=item C<void Parrot_gc_profile_start(PARROT_INTERP)>
-
-Records the start time of a GC mark run when profiling is enabled.
-
-=cut
-
-*/
-
-void
-Parrot_gc_profile_start(PARROT_INTERP)
-{
- ASSERT_ARGS(Parrot_gc_profile_start)
- if (Interp_flags_TEST(interp, PARROT_PROFILE_FLAG))
- interp->profile->gc_time = Parrot_floatval_time();
-}
-
-/*
-
-=item C<void Parrot_gc_profile_end(PARROT_INTERP, int what)>
-
-Records the end time of the GC mark run part C<what> run when profiling is
-enabled. Also record start time of next part.
-
-=cut
-
-*/
-
-void
-Parrot_gc_profile_end(PARROT_INTERP, int what)
-{
- ASSERT_ARGS(Parrot_gc_profile_end)
- if (Interp_flags_TEST(interp, PARROT_PROFILE_FLAG)) {
- RunProfile * const profile = interp->profile;
- const FLOATVAL now = Parrot_floatval_time();
-
- profile->data[what].numcalls++;
- profile->data[what].time += now - profile->gc_time;
-
- /*
- * we've recorded the time of a GC piece from
- * gc_time until now, so add this to the start of the
- * currently executing opcode, which hasn't run this
- * interval.
- */
- profile->starttime += now - profile->gc_time;
-
- /* prepare start for next step */
- profile->gc_time = now;
- }
-}
-
-
-/*
-
-=back
-
-=head1 SEE ALSO
-
-F<src/gc/memory.c>.
-
-=head1 HISTORY
-
-Initial version by Dan on 2001.10.2.
-
-=cut
-
-*/
-
-/*
- * Local variables:
- * c-file-style: "parrot"
- * End:
- * vim: expandtab shiftwidth=4:
- */
Modified: branches/pmc_pct/src/gc/system.c
==============================================================================
--- branches/pmc_pct/src/gc/system.c Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/gc/system.c Thu Jun 4 02:32:48 2009 (r39377)
@@ -38,11 +38,58 @@
static size_t find_common_mask(PARROT_INTERP, size_t val1, size_t val2)
__attribute__nonnull__(1);
+PARROT_WARN_UNUSED_RESULT
+static size_t get_max_buffer_address(PARROT_INTERP)
+ __attribute__nonnull__(1);
+
+PARROT_WARN_UNUSED_RESULT
+static size_t get_max_pmc_address(PARROT_INTERP)
+ __attribute__nonnull__(1);
+
+PARROT_WARN_UNUSED_RESULT
+static size_t get_min_buffer_address(PARROT_INTERP)
+ __attribute__nonnull__(1);
+
+PARROT_WARN_UNUSED_RESULT
+static size_t get_min_pmc_address(PARROT_INTERP)
+ __attribute__nonnull__(1);
+
+PARROT_WARN_UNUSED_RESULT
+static int is_buffer_ptr(PARROT_INTERP, ARGIN(const void *ptr))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+PARROT_WARN_UNUSED_RESULT
+static int is_pmc_ptr(PARROT_INTERP, ARGIN(const void *ptr))
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2);
+
+static void trace_mem_block(PARROT_INTERP,
+ size_t lo_var_ptr,
+ size_t hi_var_ptr)
+ __attribute__nonnull__(1);
+
static void trace_system_stack(PARROT_INTERP)
__attribute__nonnull__(1);
#define ASSERT_ARGS_find_common_mask __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp)
+#define ASSERT_ARGS_get_max_buffer_address __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
+#define ASSERT_ARGS_get_max_pmc_address __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
+#define ASSERT_ARGS_get_min_buffer_address __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
+#define ASSERT_ARGS_get_min_pmc_address __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
+#define ASSERT_ARGS_is_buffer_ptr __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(ptr)
+#define ASSERT_ARGS_is_pmc_ptr __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(ptr)
+#define ASSERT_ARGS_trace_mem_block __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
#define ASSERT_ARGS_trace_system_stack __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp)
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
@@ -196,6 +243,116 @@
(size_t)&lo_var_ptr);
}
+/*
+
+=item C<static size_t get_max_buffer_address(PARROT_INTERP)>
+
+Calculates the maximum buffer address and returns it. This is done by looping
+through all the sized pools, and finding the pool whose C<end_arena_memory>
+field is the highest. Notice that arenas in each pool are not necessarily
+located directly next to each other in memory, and the last arena in the pool's
+list may not be located at the highest memory address.
+
+=cut
+
+*/
+
+PARROT_WARN_UNUSED_RESULT
+static size_t
+get_max_buffer_address(PARROT_INTERP)
+{
+ ASSERT_ARGS(get_max_buffer_address)
+ Arenas * const arena_base = interp->arena_base;
+ size_t max = 0;
+ UINTVAL i;
+
+ for (i = 0; i < arena_base->num_sized; i++) {
+ if (arena_base->sized_header_pools[i]) {
+ if (arena_base->sized_header_pools[i]->end_arena_memory > max)
+ max = arena_base->sized_header_pools[i]->end_arena_memory;
+ }
+ }
+
+ return max;
+}
+
+
+/*
+
+=item C<static size_t get_min_buffer_address(PARROT_INTERP)>
+
+Calculates the minimum buffer address and returns it. Loops through all sized
+pools, and finds the one with the smallest C<start_arena_memory> field. Notice
+that the memory region between C<get_min_buffer_address> and
+C<get_max_buffer_address> may be fragmented, and parts of it may not be
+available for Parrot to use directly (such as bookkeeping data for the OS
+memory manager).
+
+=cut
+
+*/
+
+PARROT_WARN_UNUSED_RESULT
+static size_t
+get_min_buffer_address(PARROT_INTERP)
+{
+ ASSERT_ARGS(get_min_buffer_address)
+ Arenas * const arena_base = interp->arena_base;
+ size_t min = (size_t) -1;
+ UINTVAL i;
+
+ for (i = 0; i < arena_base->num_sized; i++) {
+ if (arena_base->sized_header_pools[i]
+ && arena_base->sized_header_pools[i]->start_arena_memory) {
+ if (arena_base->sized_header_pools[i]->start_arena_memory < min)
+ min = arena_base->sized_header_pools[i]->start_arena_memory;
+ }
+ }
+
+ return min;
+}
+
+
+/*
+
+=item C<static size_t get_max_pmc_address(PARROT_INTERP)>
+
+Returns the maximum memory address used by the C<pmc_pool>.
+
+=cut
+
+*/
+
+PARROT_WARN_UNUSED_RESULT
+static size_t
+get_max_pmc_address(PARROT_INTERP)
+{
+ ASSERT_ARGS(get_max_pmc_address)
+ return interp->arena_base->pmc_pool->end_arena_memory;
+}
+
+
+/*
+
+=item C<static size_t get_min_pmc_address(PARROT_INTERP)>
+
+Returns the minimum memory address used by the C<pmc_pool>. Notice that the
+memory region between C<get_min_pmc_address> and C<get_max_pmc_address> may be
+fragmented, and not all of it may be used directly by Parrot for storing PMCs.
+
+=cut
+
+*/
+
+PARROT_WARN_UNUSED_RESULT
+static size_t
+get_min_pmc_address(PARROT_INTERP)
+{
+ ASSERT_ARGS(get_min_pmc_address)
+ return interp->arena_base->pmc_pool->start_arena_memory;
+}
+
+
#ifndef PLATFORM_STACK_WALK
/*
@@ -239,7 +396,7 @@
/*
-=item C<void trace_mem_block(PARROT_INTERP, size_t lo_var_ptr, size_t
+=item C<static void trace_mem_block(PARROT_INTERP, size_t lo_var_ptr, size_t
hi_var_ptr)>
Traces the memory block between C<lo_var_ptr> and C<hi_var_ptr>.
@@ -251,7 +408,7 @@
*/
-void
+static void
trace_mem_block(PARROT_INTERP, size_t lo_var_ptr, size_t hi_var_ptr)
{
ASSERT_ARGS(trace_mem_block)
@@ -309,6 +466,55 @@
return;
}
+
+/*
+
+=item C<static int is_buffer_ptr(PARROT_INTERP, const void *ptr)>
+
+Checks whether the given C<ptr> is located within one of the sized
+header pools. Returns C<1> if it is, and C<0> if not.
+
+=cut
+
+*/
+
+PARROT_WARN_UNUSED_RESULT
+static int
+is_buffer_ptr(PARROT_INTERP, ARGIN(const void *ptr))
+{
+ ASSERT_ARGS(is_buffer_ptr)
+ Arenas * const arena_base = interp->arena_base;
+ UINTVAL i;
+
+ for (i = 0; i < arena_base->num_sized; i++) {
+ if (arena_base->sized_header_pools[i]
+ && contained_in_pool(arena_base->sized_header_pools[i], ptr))
+ return 1;
+ }
+
+ return 0;
+}
+
+/*
+
+=item C<static int is_pmc_ptr(PARROT_INTERP, const void *ptr)>
+
+Checks that C<ptr> is actually a PMC pointer. Returns C<1> if it is, C<0>
+otherwise.
+
+=cut
+
+*/
+
+PARROT_WARN_UNUSED_RESULT
+static int
+is_pmc_ptr(PARROT_INTERP, ARGIN(const void *ptr))
+{
+ ASSERT_ARGS(is_pmc_ptr)
+ return contained_in_pool(interp->arena_base->pmc_pool, ptr);
+}
+
+
#endif
/*
Modified: branches/pmc_pct/src/global.c
==============================================================================
--- branches/pmc_pct/src/global.c Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/global.c Thu Jun 4 02:32:48 2009 (r39377)
@@ -110,63 +110,6 @@
/*
-=item C<static PMC * internal_ns_keyed(PARROT_INTERP, PMC *base_ns, PMC
-*pmc_key, int flags)>
-
-internal_ns_keyed: Internal function to do keyed namespace lookup relative to a
-given namespace PMC. Understands String, Key, and array PMCs containing
-strings.
-
-=cut
-
-*/
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CAN_RETURN_NULL
-static PMC *
-internal_ns_keyed(PARROT_INTERP, ARGIN(PMC *base_ns), ARGIN(PMC *pmc_key), int flags)
-{
- ASSERT_ARGS(internal_ns_keyed)
- PMC *ns = base_ns;
- INTVAL i, n;
-
- if (VTABLE_isa(interp, pmc_key, CONST_STRING(interp, "String"))) {
- STRING *str_key = VTABLE_get_string(interp, pmc_key);
- return internal_ns_keyed_str(interp, base_ns, str_key, flags);
- }
-
- else if (pmc_key->vtable->base_type == enum_class_Key)
- return internal_ns_keyed_key(interp, base_ns, pmc_key, flags);
- else
- n = VTABLE_elements(interp, pmc_key); /* array of strings */
-
- for (i = 0; i < n; ++i) {
- STRING *part;
- PMC *sub_ns;
-
- if (!pmc_key)
- Parrot_ex_throw_from_c_args(interp, NULL, 1,
- "Passed a NULL pmc_key into VTABLE_get_string_keyed_int");
-
- part = VTABLE_get_string_keyed_int(interp, pmc_key, i);
- sub_ns = VTABLE_get_pmc_keyed_str(interp, ns, part);
-
- if (PMC_IS_NULL(sub_ns) || !VTABLE_isa(interp, sub_ns, CONST_STRING(interp, "NameSpace"))) {
- sub_ns = internal_ns_maybe_create(interp, ns, part, flags);
-
- if (PMC_IS_NULL(sub_ns))
- return PMCNULL;
- }
-
- ns = sub_ns;
- }
-
- return ns;
-}
-
-
-/*
-
=item C<static PMC * internal_ns_keyed_str(PARROT_INTERP, PMC *base_ns, STRING
*key, int flags)>
@@ -184,7 +127,7 @@
ARGIN(STRING *key), int flags)
{
ASSERT_ARGS(internal_ns_keyed_str)
- PMC *ns = VTABLE_get_pmc_keyed_str(interp, base_ns, key);
+ PMC * const ns = VTABLE_get_pmc_keyed_str(interp, base_ns, key);
if (!PMC_IS_NULL(ns) && VTABLE_isa(interp, ns, CONST_STRING(interp, "NameSpace")))
return ns;
@@ -211,8 +154,8 @@
{
ASSERT_ARGS(internal_ns_keyed_key)
while (key) {
- STRING *part = VTABLE_get_string(interp, key);
- PMC *sub_ns = VTABLE_get_pmc_keyed_str(interp, ns, part);
+ STRING * const part = VTABLE_get_string(interp, key);
+ PMC *sub_ns = VTABLE_get_pmc_keyed_str(interp, ns, part);
if (PMC_IS_NULL(sub_ns) || !VTABLE_isa(interp, sub_ns, CONST_STRING(interp, "NameSpace"))) {
sub_ns = internal_ns_maybe_create(interp, ns, part, flags);
@@ -228,6 +171,58 @@
return ns;
}
+/*
+
+=item C<static PMC * internal_ns_keyed(PARROT_INTERP, PMC *base_ns, PMC
+*pmc_key, int flags)>
+
+internal_ns_keyed: Internal function to do keyed namespace lookup relative to a
+given namespace PMC. Understands String, Key, and array PMCs containing
+strings.
+
+=cut
+
+*/
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CAN_RETURN_NULL
+static PMC *
+internal_ns_keyed(PARROT_INTERP, ARGIN(PMC *base_ns), ARGIN(PMC *pmc_key), int flags)
+{
+ ASSERT_ARGS(internal_ns_keyed)
+
+ if (VTABLE_isa(interp, pmc_key, CONST_STRING(interp, "String"))) {
+ STRING * const str_key = VTABLE_get_string(interp, pmc_key);
+ return internal_ns_keyed_str(interp, base_ns, str_key, flags);
+ }
+ else if (pmc_key->vtable->base_type == enum_class_Key)
+ return internal_ns_keyed_key(interp, base_ns, pmc_key, flags);
+ else {
+ /* array of strings */
+ STRING * const isans = CONST_STRING(interp, "NameSpace");
+ const INTVAL n = VTABLE_elements(interp, pmc_key);
+ INTVAL i;
+ PMC *ns = base_ns;
+
+ for (i = 0; i < n; ++i) {
+ if (!pmc_key)
+ Parrot_ex_throw_from_c_args(interp, NULL, 1,
+ "Passed a NULL pmc_key into VTABLE_get_string_keyed_int");
+ else {
+ STRING * const part = VTABLE_get_string_keyed_int(interp, pmc_key, i);
+ PMC *sub_ns = VTABLE_get_pmc_keyed_str(interp, ns, part);
+
+ if (PMC_IS_NULL(sub_ns) || !VTABLE_isa(interp, sub_ns, isans)) {
+ sub_ns = internal_ns_maybe_create(interp, ns, part, flags);
+ if (PMC_IS_NULL(sub_ns))
+ return PMCNULL;
+ }
+ ns = sub_ns;
+ }
+ }
+ return ns;
+ }
+}
/*
@@ -831,7 +826,7 @@
/* is there an existing MultiSub PMC? or do we need to create one? */
if (PMC_IS_NULL(multisub)) {
- multisub = pmc_new(interp, enum_class_MultiSub);
+ multisub = pmc_new(interp, Parrot_get_ctx_HLL_type(interp, enum_class_MultiSub));
/* we have to push the sub onto the MultiSub before we try to store
it because storing requires information from the sub */
VTABLE_push_pmc(interp, multisub, sub_pmc);
Modified: branches/pmc_pct/src/hash.c
==============================================================================
--- branches/pmc_pct/src/hash.c Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/hash.c Thu Jun 4 02:32:48 2009 (r39377)
@@ -954,7 +954,7 @@
{
ASSERT_ARGS(parrot_create_hash)
HashBucket *bp;
- Hash * const hash = mem_allocate_zeroed_typed(Hash);
+ Hash * const hash = mem_allocate_typed(Hash);
size_t i;
PARROT_ASSERT(INITIAL_BUCKETS % 4 == 0);
@@ -966,6 +966,7 @@
hash->seed = interp->hash_seed;
hash->mask = INITIAL_BUCKETS - 1;
hash->entries = 0;
+ hash->container = PMCNULL;
/*
* TODO if we have a significant amount of small hashes:
Modified: branches/pmc_pct/src/interp/inter_create.c
==============================================================================
--- branches/pmc_pct/src/interp/inter_create.c Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/interp/inter_create.c Thu Jun 4 02:32:48 2009 (r39377)
@@ -20,6 +20,7 @@
#include "parrot/parrot.h"
+#include "parrot/runcore_api.h"
#include "parrot/oplib/core_ops.h"
#include "../compilers/imcc/imc.h"
#include "inter_create.str"
@@ -374,10 +375,9 @@
*/
/* we destroy all child interpreters and the last one too,
- * if the --leak-test commandline was given
- */
- if (! (interp->parent_interpreter ||
- Interp_flags_TEST(interp, PARROT_DESTROY_FLAG)))
+ * if the --leak-test commandline was given */
+ if (! (interp->parent_interpreter
+ || Interp_flags_TEST(interp, PARROT_DESTROY_FLAG)))
return;
if (interp->parent_interpreter
@@ -419,9 +419,6 @@
interp->profile = NULL;
}
- /* deinit op_lib */
- (void) PARROT_CORE_OPLIB_INIT(0);
-
destroy_context(interp);
destroy_runloop_jump_points(interp);
@@ -433,6 +430,8 @@
/* strings, charsets, encodings - only once */
Parrot_str_finish(interp);
+ PARROT_CORE_OPLIB_INIT(0);
+
if (!interp->parent_interpreter) {
if (interp->thread_data)
mem_sys_free(interp->thread_data);
@@ -444,6 +443,9 @@
if (interp->n_libs > 0) {
mem_sys_free(interp->op_info_table);
mem_sys_free(interp->op_func_table);
+
+ /* deinit op_lib */
+ Parrot_runcore_destroy(interp);
}
MUTEX_DESTROY(interpreter_array_mutex);
Modified: branches/pmc_pct/src/interp/inter_misc.c
==============================================================================
--- branches/pmc_pct/src/interp/inter_misc.c Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/interp/inter_misc.c Thu Jun 4 02:32:48 2009 (r39377)
@@ -67,7 +67,7 @@
/*
=item C<void register_raw_nci_method_in_ns(PARROT_INTERP, const int type, void
-*func, const char *name)>
+*func, STRING *name)>
Create an entry in the C<nci_method_table> for the given raw NCI method
of PMC class C<type>.
@@ -79,19 +79,17 @@
PARROT_EXPORT
void
register_raw_nci_method_in_ns(PARROT_INTERP, const int type, ARGIN(void *func),
- ARGIN(const char *name))
+ ARGIN(STRING *name))
{
ASSERT_ARGS(register_raw_nci_method_in_ns)
PMC * const method = pmc_new(interp, enum_class_NCI);
- STRING * const method_name = string_make(interp, name, strlen(name),
- NULL, PObj_constant_FLAG|PObj_external_FLAG);
/* setup call func */
VTABLE_set_pointer(interp, method, func);
/* insert it into namespace */
VTABLE_set_pmc_keyed_str(interp, interp->vtables[type]->_namespace,
- method_name, method);
+ name, method);
}
/*
Modified: branches/pmc_pct/src/io/api.c
==============================================================================
--- branches/pmc_pct/src/io/api.c Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/io/api.c Thu Jun 4 02:32:48 2009 (r39377)
@@ -39,7 +39,10 @@
=item C<PMC * Parrot_io_stdhandle(PARROT_INTERP, INTVAL fileno, PMC *newhandle)>
-Get the current standard IO object and optionally set a new one.
+Get the current standard IO object with the specified filenumber. If the
+C<newhandle> parameter is non-null, set that to be the new standard IO object
+of that number. Returns the old IO object before the new one is set, so it
+can be cached for later.
=cut
@@ -172,7 +175,8 @@
=item C<INTVAL Parrot_io_close(PARROT_INTERP, PMC *pmc)>
-Closes the filehandle object.
+Closes the filehandle object. Calls the C<close> method on the filehandle
+PMC object.
=cut
@@ -197,7 +201,8 @@
=item C<INTVAL Parrot_io_is_closed(PARROT_INTERP, PMC *pmc)>
-Test whether a filehandle is closed.
+Test whether a filehandle is closed. Calls the C<is_closed> method of the
+filehandle PMC.
=cut
@@ -222,7 +227,8 @@
=item C<void Parrot_io_flush(PARROT_INTERP, PMC *pmc)>
-Flushes the C<ParrotIO> PMC C<*pmc>.
+Flushes the C<ParrotIO> PMC C<*pmc>. Calls the C<flush> method on the
+filehandle PMC.
=cut
@@ -243,7 +249,8 @@
=item C<STRING * Parrot_io_reads(PARROT_INTERP, PMC *pmc, size_t length)>
-Return a new C<STRING*> holding up to C<len> bytes.
+Return a new C<STRING*> holding up to C<len> bytes read from the filehandle
+PMC. Calls the C<read> method on the filehandle PMC.
=cut
@@ -267,7 +274,8 @@
=item C<STRING * Parrot_io_readline(PARROT_INTERP, PMC *pmc)>
-Return a new C<STRING*> holding the next line read from the file.
+Return a new C<STRING*> holding the next line read from the file. Calls
+the C<readline> method of the filehandle PMC.
=cut
@@ -445,7 +453,8 @@
=item C<INTVAL Parrot_io_putps(PARROT_INTERP, PMC *pmc, STRING *s)>
-Writes C<*s> to C<*pmc>. Parrot string version.
+Writes C<*s> to C<*pmc>. Parrot string version. Calls the C<puts> method
+on the filehandle PMC.
=cut
Modified: branches/pmc_pct/src/io/core.c
==============================================================================
--- branches/pmc_pct/src/io/core.c Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/io/core.c Thu Jun 4 02:32:48 2009 (r39377)
@@ -107,7 +107,7 @@
=item C<void Parrot_IOData_mark(PARROT_INTERP, ParrotIOData *piodata)>
-Called from C<trace_active_PMCs()> to mark the IO data live.
+Called from C<Parrot_gc_trace_root()> to mark the IO data live.
=cut
Deleted: branches/pmc_pct/src/io/io_string.c
==============================================================================
--- branches/pmc_pct/src/io/io_string.c Thu Jun 4 02:32:48 2009 (r39376)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,184 +0,0 @@
-/*
-Copyright (C) 2006-2009, Parrot Foundation.
-$Id$
-
-=head1 NAME
-
-src/io/io_string.c - IO Layer for strings
-
-=head1 DESCRIPTION
-
-Capture output to a string PMC.
-
-=head2 String Layer Functions
-
-=over 4
-
-=cut
-
-*/
-
-#include "parrot/parrot.h"
-#include "io_private.h"
-
-/* HEADERIZER HFILE: none */
-
-/* HEADERIZER BEGIN: static */
-/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
-
-static size_t PIO_string_read(SHIM_INTERP,
- ARGMOD(ParrotIOLayer *l),
- SHIM(ParrotIO *io),
- ARGOUT(STRING **buf))
- __attribute__nonnull__(2)
- __attribute__nonnull__(4)
- FUNC_MODIFIES(*l)
- FUNC_MODIFIES(*buf);
-
-static size_t PIO_string_write(PARROT_INTERP,
- ARGMOD(ParrotIOLayer *l),
- SHIM(ParrotIO *io),
- ARGMOD(STRING *s))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- __attribute__nonnull__(4)
- FUNC_MODIFIES(*l)
- FUNC_MODIFIES(*s);
-
-/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
-/* HEADERIZER END: static */
-
-static const ParrotIOLayerAPI pio_string_layer_api = {
- PIO_null_init,
- PIO_base_new_layer,
- PIO_base_delete_layer,
- PIO_null_push_layer,
- PIO_null_pop_layer,
- PIO_null_open,
- PIO_null_open2,
- PIO_null_open3,
- PIO_null_open_async,
- PIO_null_fdopen,
- PIO_null_close,
- PIO_string_write,
- PIO_null_write_async,
- PIO_string_read,
- PIO_null_read_async,
- PIO_null_flush,
- PIO_null_peek,
- PIO_null_seek,
- PIO_null_tell,
- PIO_null_setbuf,
- PIO_null_setlinebuf,
- PIO_null_getcount,
- PIO_null_fill,
- PIO_null_eof,
- NULL, /* no poll */
- NULL, /* no socket */
- NULL, /* no connect */
- NULL, /* no send */
- NULL, /* no recv */
- NULL, /* no bind */
- NULL, /* no listen */
- NULL /* no accept */
-};
-
-ParrotIOLayer pio_string_layer = {
- NULL,
- "string",
- 0,
- &pio_string_layer_api,
- NULL, NULL
-};
-
-/*
-
-=item C<ParrotIOLayer * PIO_string_register_layer(void)>
-
-Get a pointer to the C<pio_string_layer> structure.
-
-=cut
-
-*/
-
-PARROT_WARN_UNUSED_RESULT
-PARROT_CANNOT_RETURN_NULL
-ParrotIOLayer *
-PIO_string_register_layer(void)
-{
- return &pio_string_layer;
-}
-
-/*
-
-=item C<static size_t PIO_string_read(PARROT_INTERP, ParrotIOLayer *l,
-ParrotIO *io, STRING **buf)>
-
-Read a string from layer C<l> and store it in the specified buffer.
-
-=cut
-
-*/
-
-static size_t
-PIO_string_read(SHIM_INTERP, ARGMOD(ParrotIOLayer *l), SHIM(ParrotIO *io), ARGOUT(STRING **buf))
-{
- if (!l->self)
- return 0;
-
- *buf = (STRING *)l->self;
- l->self = NULL;
-
- return (*buf)->strlen;
-}
-
-/*
-
-=item C<static size_t PIO_string_write(PARROT_INTERP, ParrotIOLayer *l, ParrotIO *io, STRING *s)>
-
-Write the string C<s> to the layer C<l>.
-
-=cut
-
-*/
-
-static size_t
-PIO_string_write(PARROT_INTERP, ARGMOD(ParrotIOLayer *l), SHIM(ParrotIO *io), ARGMOD(STRING *s))
-{
- STRING * const old_string = (STRING *)l->self;
-
- if (!old_string) {
- l->self = s;
- return s->strlen;
- }
-
- l->self = Parrot_str_append(interp, old_string, s);
- return Parrot_str_byte_length(interp, (STRING *)l->self);
-}
-
-/*
-
-=back
-
-=head1 SEE ALSO
-
-F<src/io/io_passdown.c>,
-F<src/io/io.c>,
-F<src/io/io_layers.c>,
-F<src/io/io_private.h>.
-
-=head1 HISTORY
-
-Initially written by chromatic.
-
-=cut
-
-*/
-
-
-/*
- * Local variables:
- * c-file-style: "parrot"
- * End:
- * vim: expandtab shiftwidth=4:
- */
Modified: branches/pmc_pct/src/io/unix.c
==============================================================================
--- branches/pmc_pct/src/io/unix.c Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/io/unix.c Thu Jun 4 02:32:48 2009 (r39377)
@@ -33,6 +33,9 @@
#ifdef PIO_OS_UNIX
+# include <sys/types.h>
+# include <sys/wait.h>
+
/* HEADERIZER HFILE: include/parrot/io_unix.h */
/* HEADERIZER BEGIN: static */
@@ -335,11 +338,20 @@
ASSERT_ARGS(Parrot_io_close_unix)
INTVAL result = 0;
PIOHANDLE file_descriptor = Parrot_io_get_os_handle(interp, filehandle);
+ int flags = Parrot_io_get_flags(interp, filehandle);
+
/* BSD and Solaris need explicit fsync() */
if (file_descriptor >= 0) {
fsync(file_descriptor);
if (close(file_descriptor) != 0)
result = errno;
+
+ /* Wait for the child after closing the
+ * handle, to let it notice the closing and finish */
+ if (flags & PIO_F_PIPE) {
+ int status;
+ waitpid(VTABLE_get_integer_keyed_int(interp, filehandle, 0), &status, 0);
+ }
}
Parrot_io_set_os_handle(interp, filehandle, -1);
return result;
@@ -639,25 +651,38 @@
* if that's not true, we need a test
*/
# ifdef PARROT_HAS_HEADER_UNISTD
- int pid, err, fds[2];
-
- err = pipe(fds);
- if (err < 0) {
- return NULL;
+ int pid;
+ int fds[2];
+ const int f_read = (flags & PIO_F_READ) != 0;
+ const int f_write = (flags & PIO_F_WRITE) != 0;
+ if (f_read == f_write)
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR,
+ "Invalid pipe mode: %X", flags);
+
+ if (pipe(fds) < 0)
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR,
+ "Error opening pipe: %s", strerror(errno));
+
+ pid = fork();
+ if (pid < 0) {
+ /* fork failed, cleaning up */
+ close(fds[0]);
+ close(fds[1]);
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR,
+ "fork failed: %s", strerror(errno));
}
-
- /* Parent - return IO stream */
- if ((pid = fork()) > 0) {
+ else if (pid > 0) {
+ /* Parent - return IO stream */
PMC *io;
if (PMC_IS_NULL(filehandle))
io = Parrot_io_new_pmc(interp, flags & (PIO_F_READ|PIO_F_WRITE));
else
io = filehandle;
- Parrot_io_set_flags(interp, io,
- (Parrot_io_get_flags(interp, io) & (~PIO_F_PIPE)));
+ /* Save the pid of the child, we'll wait for it when closing */
+ VTABLE_set_integer_keyed_int(interp, io, 0, pid);
- if (flags & PIO_F_READ) {
+ if (f_read) {
/* close this writer's end of pipe */
close(fds[1]);
Parrot_io_set_os_handle(interp, io, fds[0]);
@@ -669,83 +694,47 @@
}
return io;
}
-
- /* Child - exec process */
- if (pid == 0) {
- /* See above comments */
-# if 0
- char *argv[10], *p, *c, *cmd, *orig_cmd;
- int n;
-# else
- char * argv[10], *orig_cmd;
-
+ else /* (pid == 0) */ {
+ /* Child - exec process */
+ char * argv[4];
/* C strings for the execv call defined that way to avoid
* const problems without copying them.
*/
static char auxarg0 [] = "/bin/sh";
static char auxarg1 [] = "-c";
-# endif
- if (flags & PIO_F_WRITE) {
+ if (f_write) {
/* the other end is writing - we read from the pipe */
close(STDIN_FILENO);
- /*close(fds[1]);*/
+ close(fds[1]);
if (Parrot_dup(fds[0]) != STDIN_FILENO)
- exit(EXIT_SUCCESS);
+ exit(EXIT_FAILURE);
}
else {
/* XXX redirect stdout, stderr to pipe */
- close(STDIN_FILENO);
close(STDOUT_FILENO);
close(STDERR_FILENO);
+ close(fds[0]);
- if (Parrot_dup(fds[0]) != STDIN_FILENO
- || Parrot_dup(fds[1]) != STDOUT_FILENO
- || Parrot_dup(fds[1]) != STDERR_FILENO)
- exit(EXIT_SUCCESS);
- }
-
- /*******************************************************
- * THIS IS A QUICK TEST IMPLEMENTATION
- * Thus the if'ed out code is not deleted yet
- * TT #661
- *******************************************************
- */
-# if 0
- /* XXX ugly hack to be able to pass some arguments
- * split cmd at blanks */
- orig_cmd = cmd = Parrot_str_to_cstring(interp, command);
- c = strdup(cmd);
-
- for (n = 0, p = strtok(c, " "); n < 9 && p; p = strtok(NULL, " ")) {
- if (n == 0)
- cmd = p;
- argv[n++] = p;
+ if (Parrot_dup(fds[1]) != STDOUT_FILENO)
+ exit(EXIT_FAILURE);
+ if (Parrot_dup(fds[1]) != STDERR_FILENO)
+ exit(EXIT_FAILURE);
}
- argv[n] = NULL;
-
- Parrot_str_free_cstring(c); /* done with C string */
- execv(cmd, argv); /* XXX use execvp ? */
-# else
-
- orig_cmd = Parrot_str_to_cstring(interp, command);
argv [0] = auxarg0;
argv [1] = auxarg1;
- argv [2] = orig_cmd;
+ argv [2] = Parrot_str_to_cstring(interp, command);
argv [3] = NULL;
execv(argv [0], argv);
-# endif
-
- /* Will never reach this unless exec fails. */
- Parrot_str_free_cstring(orig_cmd);
+ /* Will never reach this unless exec fails.
+ * No need to clean up, we're just going to exit */
perror("execvp");
exit(EXIT_FAILURE);
}
- perror("fork");
# else
UNUSED(l);
UNUSED(command);
@@ -753,7 +742,6 @@
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_UNIMPLEMENTED,
"pipe() unimplemented");
# endif
- return NULL;
}
/*
Modified: branches/pmc_pct/src/io/win32.c
==============================================================================
--- branches/pmc_pct/src/io/win32.c Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/io/win32.c Thu Jun 4 02:32:48 2009 (r39377)
@@ -214,6 +214,9 @@
fprintf(stderr, "Parrot_io_open_win32: %s\n", spath);
}
# endif
+ if (flags & PIO_F_PIPE)
+ return Parrot_io_open_pipe_win32(interp, filehandle, path, flags);
+
if ((flags & (PIO_F_WRITE | PIO_F_READ)) == 0)
return NULL;
@@ -307,11 +310,18 @@
UINTVAL result = 0;
PIOHANDLE os_handle = Parrot_io_get_os_handle(interp, filehandle);
if (os_handle != INVALID_HANDLE_VALUE) {
+ int flags = Parrot_io_get_flags(interp, filehandle);
if (CloseHandle(os_handle) == 0)
result = GetLastError();
Parrot_io_set_os_handle(interp, filehandle, INVALID_HANDLE_VALUE);
+ if (flags & PIO_F_PIPE) {
+ INTVAL procid = VTABLE_get_integer_keyed_int(interp, filehandle, 0);
+ HANDLE process = (HANDLE) procid;
+ WaitForSingleObject(process, INFINITE);
+ CloseHandle(process);
+ }
}
- return 0;
+ return (result != 0);
}
/*
@@ -422,6 +432,8 @@
}
else {
/* FIXME : An error occured */
+ Parrot_io_set_flags(interp, filehandle,
+ (Parrot_io_get_flags(interp, filehandle) | PIO_F_EOF));
}
s->bufused = s->strlen = 0;
@@ -447,8 +459,9 @@
{
ASSERT_ARGS(Parrot_io_write_win32)
DWORD countwrote = 0;
+ DWORD err;
void * const buffer = s->strstart;
- size_t len = s->bufused;
+ DWORD len = (DWORD) s->bufused;
PIOHANDLE os_handle = Parrot_io_get_os_handle(interp, filehandle);
/* do it by hand, Win32 hasn't any specific flag */
@@ -456,7 +469,6 @@
LARGE_INTEGER p;
p.LowPart = 0;
p.HighPart = 0;
-
p.LowPart = SetFilePointer(os_handle, p.LowPart,
&p.HighPart, FILE_END);
if (p.LowPart == 0xFFFFFFFF && (GetLastError() != NO_ERROR)) {
@@ -465,8 +477,27 @@
}
}
- if (WriteFile(os_handle, (LPCSTR) buffer, (DWORD) len, &countwrote, NULL))
+ if (WriteFile(os_handle, (LPCSTR) buffer, len, &countwrote, NULL))
return countwrote;
+
+ /* Write may have failed because of small buffers,
+ * see TT #710 for example.
+ * Let's try writing in small chunks */
+ if ((err = GetLastError()) == ERROR_NOT_ENOUGH_MEMORY || err == ERROR_INVALID_USER_BUFFER) {
+ DWORD chunk = 4096; /* Arbitrarily choosen value */
+ if (len < chunk)
+ goto fail;
+ while (len > 0) {
+ if (chunk > len)
+ chunk = len;
+ if (WriteFile(os_handle, (LPCSTR) buffer, chunk, &countwrote, NULL) == 0 ||
+ countwrote != chunk)
+ goto fail;
+ len -= chunk;
+ }
+ return len;
+ }
+fail:
/* FIXME: Set error flag */
return (size_t)-1;
}
@@ -566,13 +597,111 @@
PARROT_WARN_UNUSED_RESULT
PARROT_CAN_RETURN_NULL
PMC *
-Parrot_io_open_pipe_win32(PARROT_INTERP, SHIM(PMC *filehandle),
- SHIM(STRING *command), int flags)
+Parrot_io_open_pipe_win32(PARROT_INTERP, ARGMOD(PMC *filehandle),
+ ARGIN(STRING *command), int flags)
{
ASSERT_ARGS(Parrot_io_open_pipe_win32)
- UNUSED(flags);
+
+ HANDLE current = GetCurrentProcess();
+ HANDLE hnull = INVALID_HANDLE_VALUE;
+ HANDLE hread = INVALID_HANDLE_VALUE;
+ HANDLE hwrite = INVALID_HANDLE_VALUE;
+ HANDLE hchild = INVALID_HANDLE_VALUE;
+ STARTUPINFO start;
+ SECURITY_ATTRIBUTES sec;
+ PROCESS_INFORMATION procinfo;
+ char *cmd = NULL;
+ const char *comspec;
+ PMC *io = PMC_IS_NULL(filehandle) ? Parrot_io_new_pmc(interp, flags) : filehandle;
+ STRING *auxcomm;
+ int f_read = (flags & PIO_F_READ) != 0;
+ int f_write = (flags & PIO_F_WRITE) != 0;
+ if (f_read == f_write)
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_PIO_ERROR,
+ "Invalid pipe mode: %X", flags);
+
+ procinfo.hThread = INVALID_HANDLE_VALUE;
+ procinfo.hProcess = INVALID_HANDLE_VALUE;
+ sec.nLength = sizeof sec;
+ sec.lpSecurityDescriptor = NULL;
+ sec.bInheritHandle = TRUE;
+
+ comspec = getenv("COMSPEC");
+ if (comspec == NULL)
+ comspec = "cmd";
+ auxcomm = Parrot_str_new(interp, comspec, 0);
+ auxcomm = Parrot_str_append(interp, auxcomm, Parrot_str_new(interp, " /c ", 0));
+ auxcomm = Parrot_str_append(interp, auxcomm, command);
+ cmd = Parrot_str_to_cstring(interp, auxcomm);
+ start.cb = sizeof start;
+ GetStartupInfo(&start);
+ start.dwFlags = STARTF_USESTDHANDLES;
+ if (CreatePipe(&hread, &hwrite, NULL, 0) == 0)
+ goto fail;
+ if (DuplicateHandle(current, f_read ? hwrite : hread,
+ current, &hchild,
+ 0, TRUE,
+ DUPLICATE_CLOSE_SOURCE | DUPLICATE_SAME_ACCESS)
+ == 0)
+ goto fail;
+ if (hchild == INVALID_HANDLE_VALUE)
+ goto fail;
+
+ if (f_read) {
+ /* Redirect input to NULL. This is to avoid
+ * interferences in case both the child and
+ * the parent tries to read from stdin.
+ * May be unneccessary or even interfere
+ * with valid usages, need more feedback. */
+ hnull = CreateFile("NUL", GENERIC_READ|GENERIC_WRITE,
+ 0, &sec, OPEN_EXISTING,
+ FILE_ATTRIBUTE_NORMAL, NULL);
+ if (hnull == INVALID_HANDLE_VALUE)
+ goto fail;
+ start.hStdInput = hnull;
+ start.hStdOutput = hchild;
+ start.hStdError = hchild;
+ }
+ else {
+ start.hStdInput = hchild;
+ }
+
+ if (CreateProcess(NULL,
+ cmd,
+ NULL, NULL, TRUE, 0,
+ NULL, NULL, &start, &procinfo) == 0)
+ goto fail;
+ Parrot_str_free_cstring(cmd);
+ cmd = NULL;
+ if (f_read) {
+ Parrot_io_set_os_handle(interp, io, hread);
+ CloseHandle(hwrite);
+ }
+ else {
+ Parrot_io_set_os_handle(interp, io, hwrite);
+ CloseHandle(hread);
+ }
+ CloseHandle(procinfo.hThread);
+ VTABLE_set_integer_keyed_int(interp, io, 0, (INTVAL)procinfo.hProcess);
+ return io;
+
+fail:
+ if (cmd != NULL)
+ Parrot_str_free_cstring(cmd);
+ if (hnull != INVALID_HANDLE_VALUE)
+ CloseHandle(hnull);
+ if (hread != INVALID_HANDLE_VALUE)
+ CloseHandle(hread);
+ if (hwrite != INVALID_HANDLE_VALUE)
+ CloseHandle(hwrite);
+ if (hchild != INVALID_HANDLE_VALUE)
+ CloseHandle(hchild);
+ if (procinfo.hThread != INVALID_HANDLE_VALUE)
+ CloseHandle(procinfo.hThread);
+ if (procinfo.hProcess != INVALID_HANDLE_VALUE)
+ CloseHandle(procinfo.hProcess);
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_UNIMPLEMENTED,
- "pipe() not implemented");
+ "pipe open error");
}
#endif /* PIO_OS_WIN32 */
Modified: branches/pmc_pct/src/jit.c
==============================================================================
--- branches/pmc_pct/src/jit.c Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/jit.c Thu Jun 4 02:32:48 2009 (r39377)
@@ -396,12 +396,10 @@
{
int typ;
- cur_section->ru[0].registers_used =
- CONTEXT(interp)->n_regs_used[REGNO_INT];
- cur_section->ru[3].registers_used =
- CONTEXT(interp)->n_regs_used[REGNO_NUM];
- cur_section->ru[1].registers_used =
- cur_section->ru[2].registers_used = 0;
+ cur_section->ru[0].registers_used = CONTEXT(interp)->n_regs_used[REGNO_INT];
+ cur_section->ru[3].registers_used = CONTEXT(interp)->n_regs_used[REGNO_NUM];
+ cur_section->ru[1].registers_used = cur_section->ru[2].registers_used = 0;
+
for (typ = 0; typ < 4; typ++) {
int j;
for (j = 0; j < cur_section->ru[typ].registers_used; j++)
@@ -1299,12 +1297,15 @@
PMC * const sub_pmc = ct->constants[ci]->u.key;
Parrot_sub *sub;
size_t offs;
+ int i;
PMC_get_sub(interp, sub_pmc, sub);
offs = pc - sub->seg->base.data;
if (offs >= sub->start_offs && offs < sub->end_offs) {
- CONTEXT(interp)->n_regs_used = sub->n_regs_used;
+ for (i = 0; i < 4; i++)
+ CONTEXT(interp)->n_regs_used[i] = sub->n_regs_used[i];
+
return;
}
}
@@ -1353,7 +1354,7 @@
PackFile_Segment *jit_seg;
char *map;
Parrot_jit_fn_info_t *op_func;
- INTVAL *n_regs_used; /* INSP in PBC */
+ INTVAL n_regs_used[4]; /* INSP in PBC */
op_info_t *op_info;
const jit_arch_info *arch_info;
int needs_fs; /* fetch/store */
@@ -1423,7 +1424,9 @@
#endif
/* remember register usage */
- n_regs_used = CONTEXT(interp)->n_regs_used;
+ for (i = 0; i < 4; i++)
+ n_regs_used[i] = CONTEXT(interp)->n_regs_used[i];
+
set_reg_usage(interp, code_start);
#if JIT_SEGS
@@ -1674,10 +1677,9 @@
cur_section->next;
}
- /*
- * restore register usage
- */
- CONTEXT(interp)->n_regs_used = n_regs_used;
+ /* restore register usage */
+ for (i = 0; i < 4; i++)
+ CONTEXT(interp)->n_regs_used[i] = n_regs_used[i];
/* Do fixups before converting offsets */
(arch_info->jit_dofixup)(jit_info, interp);
@@ -1766,7 +1768,7 @@
void
Parrot_jit_free_buffer(PARROT_INTERP, void *ptr, void *priv)
{
- struct jit_buffer_private_data *jit = (struct jit_buffer_private_data*)priv;
+ const struct jit_buffer_private_data * const jit = (struct jit_buffer_private_data*)priv;
mem_free_executable(ptr, jit->size);
free(priv);
}
@@ -1785,7 +1787,7 @@
PMC *
Parrot_jit_clone_buffer(PARROT_INTERP, PMC *pmc, void *priv)
{
- PMC *rv = pmc_new(interp, pmc->vtable->base_type);
+ PMC * const rv = pmc_new(interp, pmc->vtable->base_type);
VTABLE_init(interp, rv);
/* copy the attributes */
Modified: branches/pmc_pct/src/jit/amd64/jit_defs.c
==============================================================================
--- branches/pmc_pct/src/jit/amd64/jit_defs.c Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/jit/amd64/jit_defs.c Thu Jun 4 02:32:48 2009 (r39377)
@@ -1,5 +1,5 @@
/*
-Copyright (C) 2008, Parrot Foundation.
+Copyright (C) 2008-2009, Parrot Foundation.
$Id$
*/
@@ -59,7 +59,7 @@
jit_mov_mr_r,
jit_mov_mx_x,
Parrot_jit_dofixup,
- (jit_arch_f)0,
+ (jit_arch_f)NULL,
{
/* JIT_CODE_FILE */
{
@@ -352,9 +352,10 @@
emit_mov_r_mr(jit_info->native_ptr, dst_reg, base_reg, offs);
}
-
+PARROT_WARN_UNUSED_RESULT
+PARROT_CANNOT_RETURN_NULL
const jit_arch_info *
-Parrot_jit_init(Interp *interp)
+Parrot_jit_init(SHIM_INTERP)
{
return &arch_info;
}
Modified: branches/pmc_pct/src/jit/amd64/jit_emit.h
==============================================================================
--- branches/pmc_pct/src/jit/amd64/jit_emit.h Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/jit/amd64/jit_emit.h Thu Jun 4 02:32:48 2009 (r39377)
@@ -1,5 +1,5 @@
/*
- * Copyright (C) 2007-2008, Parrot Foundation.
+ * Copyright (C) 2007-2009, Parrot Foundation.
*/
/*
@@ -902,6 +902,9 @@
int dst_reg, int base_reg, INTVAL offs);
void jit_mov_r_mr(Interp *interp, Parrot_jit_info_t *jit_info,
int dst_reg, int base_reg, INTVAL offs);
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CANNOT_RETURN_NULL
const jit_arch_info * Parrot_jit_init(Interp *interp);
Modified: branches/pmc_pct/src/jit/hppa/jit_emit.h
==============================================================================
--- branches/pmc_pct/src/jit/hppa/jit_emit.h Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/jit/hppa/jit_emit.h Thu Jun 4 02:32:48 2009 (r39377)
@@ -1,5 +1,5 @@
/*
- * Copyright (C) 2004-2007, Parrot Foundation.
+ * Copyright (C) 2004-2009, Parrot Foundation.
*/
/*
@@ -763,6 +763,9 @@
}
}
};
+
+PARROT_WARN_UNUSED_RESULT
+PARROT_CANNOT_RETURN_NULL
const jit_arch_info*
Parrot_jit_init(PARROT_INTERP)
{
Modified: branches/pmc_pct/src/jit/i386/jit_defs.c
==============================================================================
--- branches/pmc_pct/src/jit/i386/jit_defs.c Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/jit/i386/jit_defs.c Thu Jun 4 02:32:48 2009 (r39377)
@@ -1,5 +1,5 @@
/*
-Copyright (C) 2008, Parrot Foundation.
+Copyright (C) 2008-2009, Parrot Foundation.
$Id$
*/
@@ -2529,6 +2529,8 @@
};
+PARROT_WARN_UNUSED_RESULT
+PARROT_CANNOT_RETURN_NULL
const jit_arch_info *
Parrot_jit_init(PARROT_INTERP)
{
Modified: branches/pmc_pct/src/jit/i386/jit_emit.h
==============================================================================
--- branches/pmc_pct/src/jit/i386/jit_emit.h Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/jit/i386/jit_emit.h Thu Jun 4 02:32:48 2009 (r39377)
@@ -1,5 +1,5 @@
/*
- * Copyright (C) 2002-2008, Parrot Foundation.
+ * Copyright (C) 2002-2009, Parrot Foundation.
*/
/*
@@ -1897,6 +1897,8 @@
extern const jit_arch_info arch_info;
+PARROT_WARN_UNUSED_RESULT
+PARROT_CANNOT_RETURN_NULL
const jit_arch_info * Parrot_jit_init(PARROT_INTERP);
#undef INT_REGISTERS_TO_MAP
Modified: branches/pmc_pct/src/jit/ppc/jit_emit.h
==============================================================================
--- branches/pmc_pct/src/jit/ppc/jit_emit.h Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/jit/ppc/jit_emit.h Thu Jun 4 02:32:48 2009 (r39377)
@@ -1,5 +1,5 @@
/*
- * Copyright (C) 2002-2008, Parrot Foundation.
+ * Copyright (C) 2002-2009, Parrot Foundation.
*/
/*
@@ -1386,6 +1386,8 @@
};
+PARROT_WARN_UNUSED_RESULT
+PARROT_CANNOT_RETURN_NULL
const jit_arch_info *
Parrot_jit_init(PARROT_INTERP)
{
Modified: branches/pmc_pct/src/jit/skeleton/jit_emit.h
==============================================================================
--- branches/pmc_pct/src/jit/skeleton/jit_emit.h Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/jit/skeleton/jit_emit.h Thu Jun 4 02:32:48 2009 (r39377)
@@ -353,6 +353,8 @@
* and finally you need an interface function to return above structure
*/
+PARROT_WARN_UNUSED_RESULT
+PARROT_CANNOT_RETURN_NULL
const jit_arch_info *
Parrot_jit_init(PARROT_INTERP)
{
Modified: branches/pmc_pct/src/jit/sun4/jit_emit.h
==============================================================================
--- branches/pmc_pct/src/jit/sun4/jit_emit.h Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/jit/sun4/jit_emit.h Thu Jun 4 02:32:48 2009 (r39377)
@@ -1,5 +1,5 @@
/*
- * Copyright (C) 2002-2008, Parrot Foundation.
+ * Copyright (C) 2002-2009, Parrot Foundation.
*/
/*
Modified: branches/pmc_pct/src/key.c
==============================================================================
--- branches/pmc_pct/src/key.c Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/key.c Thu Jun 4 02:32:48 2009 (r39377)
@@ -667,7 +667,7 @@
case KEY_number_FLAG:
GETATTR_Key_int_key(interp, key, int_key);
value = Parrot_str_append(interp, value,
- Parrot_str_from_num(interp, int_key));
+ Parrot_str_from_num(interp, (FLOATVAL)int_key));
break;
case KEY_string_FLAG:
GETATTR_Key_str_key(interp, key, str_key);
Modified: branches/pmc_pct/src/list.c
==============================================================================
--- branches/pmc_pct/src/list.c Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/list.c Thu Jun 4 02:32:48 2009 (r39377)
@@ -257,7 +257,7 @@
__attribute__nonnull__(2)
FUNC_MODIFIES(*list);
-static UINTVAL rebuild_chunk_list(PARROT_INTERP, ARGMOD(List *list))
+static void rebuild_chunk_list(PARROT_INTERP, ARGMOD(List *list))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
FUNC_MODIFIES(*list);
@@ -360,9 +360,11 @@
List_chunk *chunk;
Parrot_block_GC_mark(interp);
- /*Parrot_block_GC_sweep(interp); - why */
+ /* Parrot_block_GC_sweep(interp); - why */
+
chunk = (List_chunk *)Parrot_gc_new_bufferlike_header(interp, sizeof (*chunk));
- chunk->items = items;
+
+ chunk->items = items;
chunk->n_chunks = 0;
chunk->n_items = 0;
chunk->next = NULL;
@@ -380,12 +382,13 @@
return chunk;
}
+
/*
=item C<static void rebuild_chunk_ptrs(List *list, int cut)>
Rebuilds C<list> and updates/optimizes chunk usage. Deletes empty chunks,
-counts chunks and fixes C<prev> pointers.
+counts chunks, and fixes C<prev> pointers.
=cut
@@ -411,31 +414,39 @@
start = 0;
continue;
}
+
len++;
- start = 0;
+
+ start = 0;
chunk->prev = prev;
- prev = chunk;
- list->last = chunk;
+ prev = chunk;
+ list->last = chunk;
+
if (cut && cap > list->start + list->length && chunk != list->first) {
list->last = chunk->prev ? chunk->prev : list->first;
len--;
break;
}
+
cap += chunk->items;
}
if (list->last)
list->last->next = NULL;
+
list->cap = cap;
+
if (list->first)
list->first->prev = NULL;
+
list->n_chunks = len;
}
+
/*
=item C<static void rebuild_sparse(List *list)>
-Combines together adjacent sparse chunks in C<list>.
+Combines adjacent sparse chunks in C<list>.
=cut
@@ -445,13 +456,13 @@
rebuild_sparse(ARGMOD(List *list))
{
ASSERT_ARGS(rebuild_sparse)
- List_chunk *chunk = list->first;
- List_chunk *prev = NULL;
- int changes = 0;
+
+ List_chunk *chunk = list->first;
+ List_chunk *prev = NULL;
+ int changes = 0;
for (; chunk; chunk = chunk->next) {
- if (prev && (prev->flags & sparse) &&
- (chunk->flags & sparse)) {
+ if (prev && (prev->flags & sparse) && (chunk->flags & sparse)) {
prev->items += chunk->items;
chunk->items = 0;
changes++;
@@ -459,15 +470,17 @@
}
prev = chunk;
}
+
if (changes)
rebuild_chunk_ptrs(list, 0);
}
+
/*
=item C<static void rebuild_other(PARROT_INTERP, List *list)>
-Combines together adjacent irregular chunks in C<list>.
+Combines adjacent irregular chunks in C<list>.
=cut
@@ -477,23 +490,24 @@
rebuild_other(PARROT_INTERP, ARGMOD(List *list))
{
ASSERT_ARGS(rebuild_other)
- List_chunk *chunk = list->first;
- List_chunk *prev = NULL;
- int changes = 0;
+ List_chunk *chunk = list->first;
+ List_chunk *prev = NULL;
+ int changes = 0;
for (; chunk; chunk = chunk->next) {
/* two adjacent irregular chunks */
- if (prev && (prev->flags & no_power_2) &&
- (chunk->flags & no_power_2)) {
+ if (prev && (prev->flags & no_power_2) && (chunk->flags & no_power_2)) {
/* DONE don't make chunks bigger then MAX_ITEMS, no - make then
* but: if bigger, split them in a next pass
* TODO test the logic that solves the above problem */
if (prev->items + chunk->items > MAX_ITEMS) {
Parrot_gc_reallocate_buffer_storage(interp, (Buffer *)prev,
MAX_ITEMS * list->item_size);
+
if (list->container) {
GC_WRITE_BARRIER(interp, list->container, 0, prev);
}
+
mem_sys_memmove(
(char *) PObj_bufstart(&prev->data) +
prev->items * list->item_size,
@@ -506,7 +520,7 @@
(chunk->items - (MAX_ITEMS - prev->items))
* list->item_size);
chunk->items = chunk->items - (MAX_ITEMS - prev->items);
- prev->items = MAX_ITEMS;
+ prev->items = MAX_ITEMS;
}
else {
Parrot_gc_reallocate_buffer_storage(interp, (Buffer *)prev,
@@ -532,12 +546,13 @@
rebuild_chunk_ptrs(list, 0);
}
+
/*
=item C<static void rebuild_fix_ends(List *list)>
-Resets some values in C<list> and the lists's first chunk.
-Called by C<rebuild_chunk_list()>.
+Resets some values in C<list> and the lists's first chunk. Called by
+C<rebuild_chunk_list()>.
=cut
@@ -550,31 +565,34 @@
List_chunk * const chunk = list->first;
/* first is irregular, next is empty */
- if (list->n_chunks <= 2 && (chunk->flags & no_power_2) &&
- (!chunk->next || chunk->next->items == 0 ||
- list->start + list->length <= chunk->items)) {
- chunk->flags = 0;
+ if (list->n_chunks <= 2 && (chunk->flags & no_power_2)
+ && (!chunk->next
+ || chunk->next->items == 0
+ || list->start + list->length <= chunk->items)) {
+
+ chunk->flags = 0;
list->grow_policy = enum_grow_unknown;
- list->cap += PObj_buflen(&chunk->data) / list->item_size - chunk->items;
- chunk->items = PObj_buflen(&chunk->data) / list->item_size;
+ list->cap += PObj_buflen(&chunk->data) / list->item_size - chunk->items;
+ chunk->items = PObj_buflen(&chunk->data) / list->item_size;
}
+
/* XXX - still needed? - if last is empty and last->prev not full then
* delete last - combine small chunks if list is big */
}
+
/*
-=item C<static UINTVAL rebuild_chunk_list(PARROT_INTERP, List *list)>
+=item C<static void rebuild_chunk_list(PARROT_INTERP, List *list)>
-Optimises C<list> when it's been modified in some way. Combines adjacent
-chunks if they are both sparse or irregular. Updates the grow policies
-and computes list statistics.
+Optimizes a modified C<list>: combines adjacent chunks if they are both sparse
+or irregular and updates the grow policies and computes list statistics.
=cut
*/
-static UINTVAL
+static void
rebuild_chunk_list(PARROT_INTERP, ARGMOD(List *list))
{
ASSERT_ARGS(rebuild_chunk_list)
@@ -583,8 +601,10 @@
Parrot_block_GC_mark(interp);
Parrot_block_GC_sweep(interp);
+
/* count chunks and fix prev pointers */
rebuild_chunk_ptrs(list, 0);
+
/* if not regular, check & optimize */
if (list->grow_policy == enum_grow_mixed) {
rebuild_sparse(list);
@@ -594,17 +614,21 @@
/* allocate a new chunk_list buffer, if old one has moved or is too small */
len = list->n_chunks;
- if (list->collect_runs != Parrot_gc_count_collect_runs(interp) ||
- len > chunk_list_size(list)) {
+ if (list->collect_runs != Parrot_gc_count_collect_runs(interp)
+ || len > chunk_list_size(list)) {
/* round up to reasonable size */
len = 1 << (ld(len) + 1);
+
if (len < 4)
len = 4;
+
Parrot_gc_reallocate_buffer_storage(interp, (Buffer *)list,
len * sizeof (List_chunk *));
+
if (list->container) {
GC_WRITE_BARRIER(interp, list->container, 0, list);
}
+
list->collect_runs = Parrot_gc_count_collect_runs(interp);
}
@@ -617,9 +641,9 @@
chunk_list_ptr(list, len) = chunk;
len++;
- /* look, what type of chunks we have this is always correct: */
+ /* look what type of chunks we have this is always correct: */
chunk->n_chunks = 1;
- chunk->n_items = chunk->items;
+ chunk->n_items = chunk->items;
/* sparse hole or irregular chunk */
if (chunk->flags & (sparse | no_power_2)) {
@@ -634,24 +658,28 @@
}
else
break;
- first = chunk->next;
+ first = chunk->next;
list->grow_policy = enum_grow_mixed;
continue;
}
+
/* clear flag, next chunks will tell what comes */
chunk->flags = enum_grow_unknown;
+
if (first && first != chunk) {
/* constant chunk block */
if (first->items == chunk->items) {
first->n_chunks++;
first->n_items += chunk->items;
first->flags = fixed_items;
+
/* TODO optimize for fixed but non MAX_ITEMS lists */
if (first->items == MAX_ITEMS)
list->grow_policy |= enum_grow_fixed;
else
list->grow_policy |= enum_grow_mixed;
}
+
/* growing chunk block could optimize small growing blocks, they
* are probably not worth the effort. */
else if (prev && (prev->items == chunk->items >> 1)) {
@@ -661,21 +689,23 @@
list->grow_policy |= enum_grow_growing;
}
/* different growing scheme starts here */
- else {
+ else
first = chunk;
- }
}
+
prev = chunk;
}
+
/* if we have some mixture of grow_policies, then set it to _mixed */
- if (list->grow_policy && list->grow_policy != enum_grow_growing &&
- list->grow_policy != enum_grow_fixed)
+ if (list->grow_policy && list->grow_policy != enum_grow_growing
+ && list->grow_policy != enum_grow_fixed)
list->grow_policy = enum_grow_mixed;
+
Parrot_unblock_GC_mark(interp);
Parrot_unblock_GC_sweep(interp);
- return len;
}
+
/*
=item C<static List_chunk * alloc_next_size(PARROT_INTERP, List *list, int
@@ -695,10 +725,10 @@
alloc_next_size(PARROT_INTERP, ARGMOD(List *list), int where, UINTVAL idx)
{
ASSERT_ARGS(alloc_next_size)
- UINTVAL items, size;
List_chunk *new_chunk;
- const int much = idx - list->cap >= MIN_ITEMS;
- int do_sparse = (INTVAL)idx - (INTVAL)list->cap >= 10 * MAX_ITEMS;
+ UINTVAL items, size;
+ const int much = idx - list->cap >= MIN_ITEMS;
+ int do_sparse = (INTVAL)idx - (INTVAL)list->cap >= 10 * MAX_ITEMS;
if (list->item_type == enum_type_sized) {
do_sparse = 0;
@@ -716,7 +746,7 @@
items = MAX_ITEMS;
/* if we need more, the next allocation will allocate the rest */
- size = items * list->item_size;
+ size = items * list->item_size;
list->grow_policy = enum_grow_fixed;
}
else {
@@ -726,7 +756,7 @@
/* round down this function will then be called again, to add the
* final real chunk, with the rest of the needed size */
- items &= ~(MAX_ITEMS - 1);
+ items &= ~(MAX_ITEMS - 1);
list->grow_policy = enum_grow_mixed;
}
}
@@ -741,7 +771,7 @@
/* more then MIN_ITEMS, i.e. indexed access beyond length */
if (much) {
list->grow_policy = enum_grow_fixed;
- items = MAX_ITEMS;
+ items = MAX_ITEMS;
}
else {
/* TODO make bigger for small items like char */
@@ -775,13 +805,17 @@
}
size = items * list->item_size;
}
- new_chunk = allocate_chunk(interp, list, items, size);
+
+ new_chunk = allocate_chunk(interp, list, items, size);
list->cap += items;
+
if (do_sparse)
new_chunk->flags |= sparse;
+
return new_chunk;
}
+
/*
=item C<static List_chunk * add_chunk(PARROT_INTERP, List *list, int where,
@@ -800,7 +834,7 @@
add_chunk(PARROT_INTERP, ARGMOD(List *list), int where, UINTVAL idx)
{
ASSERT_ARGS(add_chunk)
- List_chunk * const chunk = where ? list->last : list->first;
+ List_chunk * const chunk = where ? list->last : list->first;
List_chunk * const new_chunk = alloc_next_size(interp, list, where, idx);
if (where) { /* at end */
@@ -813,14 +847,18 @@
}
else {
new_chunk->next = chunk;
- list->first = new_chunk;
+ list->first = new_chunk;
+
if (!list->last)
list->last = new_chunk;
}
+
rebuild_chunk_list(interp, list);
+
return new_chunk;
}
+
/*
=item C<UINTVAL ld(UINTVAL x)>
@@ -868,6 +906,7 @@
return m;
}
+
/*
=item C<static List_chunk * get_chunk(PARROT_INTERP, List *list, UINTVAL *idx)>
@@ -919,9 +958,9 @@
- sparse hole: 3 (could be 2, code assumes access at either end now)
-There could be some optimizer, that, after detecting almost only indexed
-access after some time, does reorganize the array to be all C<MAX_ITEMS>
-sized, when this would improve performance.
+There could be some optimizer that, after detecting almost only indexed access
+after some time, reorganizes the array to be all C<MAX_ITEMS> sized when this
+would improve performance.
=cut
@@ -974,11 +1013,12 @@
/* now look, if we can use the range of items in chunk_block: if idx
* is beyond n_items, skip n_chunks */
if (*idx >= chunk->n_items) {
- i += chunk->n_chunks;
+ i += chunk->n_chunks;
*idx -= chunk->n_items;
chunk = chunk_list_ptr(list, i);
continue;
}
+
/* we are inside this range of items */
if (chunk->flags & fixed_items) {
/* all chunks are chunk->items big, a power of 2 */
@@ -989,7 +1029,7 @@
/*
* Here is a small table, providing the basics of growing sized
- * addressing, for people like me, who's math lessons are +30 years
+ * addressing, for people like me, whose math lessons are +30 years
* in the past ;-)
* assuming MIN_ITEMS=4
*
@@ -1005,7 +1045,7 @@
if (chunk->flags & grow_items) {
/* the next chunks are growing from chunk->items ... last->items */
const UINTVAL ld_first = ld(chunk->items);
- const UINTVAL slot = ld(*idx + chunk->items) - ld_first;
+ const UINTVAL slot = ld(*idx + chunk->items) - ld_first;
/* we are in this growing area, so we are done */
PARROT_ASSERT(slot < chunk->n_chunks);
@@ -1016,8 +1056,8 @@
if (chunk->flags & (sparse | no_power_2)) {
/* these chunks hold exactly chunk->items */
*idx -= chunk->items;
- i++;
chunk = chunk->next;
+ i++;
continue;
}
@@ -1031,6 +1071,7 @@
*idx, list, list->cap);
}
+
/*
=item C<static void split_chunk(PARROT_INTERP, List *list, List_chunk *chunk,
@@ -1059,9 +1100,11 @@
/* it fits, just allocate */
Parrot_gc_reallocate_buffer_storage(interp, (Buffer *)chunk,
chunk->items * list->item_size);
+
if (list->container) {
GC_WRITE_BARRIER(interp, list->container, 0, chunk);
}
+
chunk->flags |= no_power_2;
chunk->flags &= ~sparse;
}
@@ -1069,32 +1112,41 @@
/* split chunk->items: n3 = n*MAX_ITEMS after chunk n2 = MAX_ITEMS
* chunk n1 = rest before */
const INTVAL idx = ix;
- const INTVAL n2 = MAX_ITEMS;
- const INTVAL n3 = ((chunk->items - idx) / MAX_ITEMS) * MAX_ITEMS;
- const INTVAL n1 = chunk->items - n2 - n3;
+ const INTVAL n2 = MAX_ITEMS;
+ const INTVAL n3 = ((chunk->items - idx) / MAX_ITEMS) * MAX_ITEMS;
+ const INTVAL n1 = chunk->items - n2 - n3;
+
+ chunk->items = n2;
- chunk->items = n2;
Parrot_gc_reallocate_buffer_storage(interp, (Buffer *)chunk,
chunk->items * list->item_size);
+
if (list->container) {
GC_WRITE_BARRIER(interp, list->container, 0, chunk);
}
+
chunk->flags &= ~sparse;
+
if (n3) {
List_chunk * const new_chunk = allocate_chunk(interp, list, n3, list->item_size);
+
new_chunk->flags |= sparse;
- new_chunk->next = chunk->next;
+ new_chunk->next = chunk->next;
+
if (chunk->next)
chunk->next = new_chunk;
else
list->last = new_chunk;
}
+
/* size before idx */
if (n1 > 0) {
/* insert a new sparse chunk before this one */
List_chunk * const new_chunk = allocate_chunk(interp, list, n1, list->item_size);
+
new_chunk->flags |= sparse;
- new_chunk->next = chunk;
+ new_chunk->next = chunk;
+
if (chunk->prev)
chunk->prev->next = new_chunk;
else
@@ -1105,6 +1157,7 @@
rebuild_chunk_list(interp, list);
}
+
/*
=item C<static void list_set(PARROT_INTERP, List *list, void *item, INTVAL type,
@@ -1121,16 +1174,17 @@
INTVAL type, INTVAL idx)
{
ASSERT_ARGS(list_set)
- const INTVAL oidx = idx;
- List_chunk *chunk = get_chunk(interp, list, (UINTVAL *)&idx);
+ List_chunk *chunk = get_chunk(interp, list, (UINTVAL *)&idx);
+ const INTVAL oidx = idx;
PARROT_ASSERT(chunk);
+
/* if this is a sparse chunk: split in possibly 2 sparse parts before and
* after then make a real chunk, rebuild chunk list and set item */
if (chunk->flags & sparse) {
split_chunk(interp, list, chunk, idx);
/* reget chunk and idx */
- idx = oidx;
+ idx = oidx;
chunk = get_chunk(interp, list, (UINTVAL *)&idx);
PARROT_ASSERT(chunk);
PARROT_ASSERT(!(chunk->flags & sparse));
@@ -1161,7 +1215,7 @@
if (list->container) {
GC_WRITE_BARRIER(interp, list->container,
((PMC **) PObj_bufstart(&chunk->data))[idx],
- (PMC*)item);
+ (PMC *)item);
}
((PMC **) PObj_bufstart(&chunk->data))[idx] = (PMC *)item;
break;
@@ -1174,6 +1228,7 @@
}
}
+
/*
=item C<static void * list_item(PARROT_INTERP, List *list, int type, INTVAL
@@ -1227,6 +1282,7 @@
}
}
+
/*
=item C<static void list_append(PARROT_INTERP, List *list, void *item, int type,
@@ -1245,12 +1301,15 @@
/* initially, list may be empty, also used by assign */
while (idx >= list->cap)
add_chunk(interp, list, enum_add_at_end, idx);
+
list_set(interp, list, item, type, idx);
+
/* invariant: prepare for next push */
if (idx >= list->cap - 1)
add_chunk(interp, list, enum_add_at_end, 0);
}
+
/*
=back
@@ -1274,7 +1333,8 @@
list_new(PARROT_INTERP, PARROT_DATA_TYPE type)
{
ASSERT_ARGS(list_new)
- List * const list = (List *)Parrot_gc_new_bufferlike_header(interp, sizeof (*list));
+ List * const list = (List *)Parrot_gc_new_bufferlike_header(interp,
+ sizeof (*list));
list->item_type = type;
switch (type) {
@@ -1308,6 +1368,7 @@
return list;
}
+
/*
=item C<void list_pmc_new(PARROT_INTERP, PMC *container)>
@@ -1464,48 +1525,49 @@
list_clone(PARROT_INTERP, ARGIN(const List *other))
{
ASSERT_ARGS(list_clone)
- List *l;
+ List *l;
List_chunk *chunk, *prev;
- UINTVAL i;
- PMC *op;
- STRING *s;
+ UINTVAL i;
Parrot_block_GC_mark(interp);
Parrot_block_GC_sweep(interp);
l = list_new(interp, other->item_type);
+
STRUCT_COPY(l, other);
- PObj_buflen(&l->chunk_list) = 0;
+ PObj_buflen(&l->chunk_list) = 0;
PObj_bufstart(&l->chunk_list) = NULL;
for (chunk = other->first, prev = NULL; chunk; chunk = chunk->next) {
List_chunk * const new_chunk = allocate_chunk(interp, l,
chunk->items, PObj_buflen(&chunk->data));
+
new_chunk->flags = chunk->flags;
+
if (!prev)
- l->first = new_chunk;
+ l->first = new_chunk;
else
prev->next = new_chunk;
+
prev = new_chunk;
if (!(new_chunk->flags & sparse)) {
switch (l->item_type) {
case enum_type_PMC:
for (i = 0; i < chunk->items; i++) {
- op = ((PMC **) PObj_bufstart(&chunk->data))[i];
- if (op) {
+ PMC * const op = ((PMC **) PObj_bufstart(&chunk->data))[i];
+
+ if (op)
((PMC **) PObj_bufstart(&new_chunk->data))[i] =
VTABLE_clone(interp, op);
- }
}
break;
case enum_type_STRING:
for (i = 0; i < chunk->items; i++) {
- s = ((STRING **) PObj_bufstart(&chunk->data))[i];
- if (s) {
+ STRING *s = ((STRING **) PObj_bufstart(&chunk->data))[i];
+ if (s)
((STRING **) PObj_bufstart(&new_chunk->data))[i] =
Parrot_str_copy(interp, s);
- }
}
break;
default:
@@ -1519,9 +1581,11 @@
rebuild_chunk_list(interp, l);
Parrot_unblock_GC_mark(interp);
Parrot_unblock_GC_sweep(interp);
+
return l;
}
+
/*
=item C<void list_mark(PARROT_INTERP, List *list)>
@@ -1541,8 +1605,9 @@
for (chunk = list->first; chunk; chunk = chunk->next) {
Parrot_gc_mark_PObj_alive(interp, (PObj *)chunk);
- if (list->item_type == enum_type_PMC ||
- list->item_type == enum_type_STRING) {
+
+ if (list->item_type == enum_type_PMC
+ || list->item_type == enum_type_STRING) {
if (!(chunk->flags & sparse)) {
PObj **p = ((PObj **) PObj_bufstart(&chunk->data));
UINTVAL i;
@@ -1559,6 +1624,7 @@
Parrot_gc_mark_PObj_alive(interp, (PObj *)list);
}
+
/*
=item C<void list_visit(PARROT_INTERP, List *list, void *pinfo)>
@@ -1576,9 +1642,9 @@
list_visit(PARROT_INTERP, ARGIN(List *list), ARGMOD(void *pinfo))
{
ASSERT_ARGS(list_visit)
- List_chunk *chunk;
+ List_chunk *chunk;
visit_info * const info = (visit_info*) pinfo;
- UINTVAL idx;
+ UINTVAL idx;
const UINTVAL n = list_length(interp, list);
PARROT_ASSERT(list->item_type == enum_type_PMC);
@@ -1589,7 +1655,7 @@
UINTVAL i;
for (i = 0; i < chunk->items && idx < n; i++, idx++) {
PMC ** const pos = ((PMC **) PObj_bufstart(&chunk->data)) + i;
- info->thaw_ptr = pos;
+ info->thaw_ptr = pos;
(info->visit_pmc_now)(interp, *pos, info);
}
}
@@ -1599,6 +1665,7 @@
}
}
+
/*
=item C<INTVAL list_length(PARROT_INTERP, const List *list)>
@@ -1618,6 +1685,7 @@
return list->length;
}
+
/*
=item C<void list_set_length(PARROT_INTERP, List *list, INTVAL len)>
@@ -1633,15 +1701,16 @@
list_set_length(PARROT_INTERP, ARGMOD(List *list), INTVAL len)
{
ASSERT_ARGS(list_set_length)
+
if (len < 0)
len += list->length;
+
if (len >= 0) {
const UINTVAL idx = list->start + (UINTVAL)len;
- list->length = len;
+ list->length = len;
+
if (idx >= list->cap) {
- /* assume user will fill it, so don't generate sparse
- * chunks
- */
+ /* assume user will fill it, so don't generate sparse chunks */
if (!list->cap && idx > MAX_ITEMS) {
while (idx - MAX_ITEMS >= list->cap) {
add_chunk(interp, list, enum_add_at_end,
@@ -1651,13 +1720,14 @@
list_append(interp, list, NULL, list->item_type, idx);
}
- else {
+ else
rebuild_chunk_ptrs(list, 1);
- }
+
rebuild_chunk_list(interp, list);
}
}
+
/*
=item C<void list_insert(PARROT_INTERP, List *list, INTVAL idx, INTVAL n_items)>
@@ -1677,46 +1747,54 @@
PARROT_ASSERT(idx >= 0);
idx += list->start;
+
PARROT_ASSERT(n_items >= 0);
if (n_items == 0)
return;
+
/* empty list */
if (idx >= (INTVAL)list->cap) {
- idx += n_items;
+ idx += n_items;
list->length = idx;
+
while (idx >= (INTVAL)list->cap)
add_chunk(interp, list, enum_add_at_end, idx);
+
return;
}
+
list->length += n_items;
- list->cap += n_items;
- chunk = get_chunk(interp, list, (UINTVAL *)&idx);
+ list->cap += n_items;
+ chunk = get_chunk(interp, list, (UINTVAL *)&idx);
+
/* the easy case: */
if (chunk->flags & sparse)
chunk->items += n_items;
else {
List_chunk *new_chunk;
- INTVAL items;
+ INTVAL items;
/* 1. cut this chunk at idx */
list->grow_policy = enum_grow_mixed;
+
/* allocate a sparse chunk, n_items big */
- new_chunk = allocate_chunk(interp, list, n_items,
- list->item_size);
+ new_chunk = allocate_chunk(interp, list, n_items, list->item_size);
new_chunk->flags |= sparse;
- items = chunk->items - idx;
- if (items) {
- List_chunk *rest;
+ items = chunk->items - idx;
+ if (items) {
/* allocate a small chunk, holding the rest of chunk beyond idx */
- chunk->flags = no_power_2;
- rest = allocate_chunk(interp, list, items,
- items * list->item_size);
- rest->flags |= no_power_2;
+ List_chunk *rest = allocate_chunk(interp, list, items,
+ items * list->item_size);
+
+ chunk->flags = no_power_2;
+ rest->flags |= no_power_2;
+
/* hang them together */
- rest->next = chunk->next;
- chunk->next = new_chunk;
+ rest->next = chunk->next;
+ chunk->next = new_chunk;
new_chunk->next = rest;
+
/* copy data over */
mem_sys_memmove(
(char *)PObj_bufstart(&rest->data),
@@ -1725,13 +1803,16 @@
}
else {
new_chunk->next = chunk->next;
- chunk->next = new_chunk;
+ chunk->next = new_chunk;
}
+
chunk->items = idx;
}
+
rebuild_chunk_list(interp, list);
}
+
/*
=item C<void list_delete(PARROT_INTERP, List *list, INTVAL idx, INTVAL n_items)>
@@ -1751,16 +1832,21 @@
PARROT_ASSERT(idx >= 0);
PARROT_ASSERT(n_items >= 0);
+
if (n_items == 0)
return;
- idx += list->start;
+
+ idx += list->start;
chunk = get_chunk(interp, list, (UINTVAL *)&idx);
+
/* deleting beyond end? */
if (idx + n_items > (INTVAL)list->length)
n_items = list->length - idx;
- list->length -= n_items;
- list->cap -= n_items;
+
+ list->length -= n_items;
+ list->cap -= n_items;
list->grow_policy = enum_grow_mixed;
+
while (n_items > 0) {
if (idx + n_items <= (INTVAL)chunk->items) {
/* chunk is bigger then we want to delete */
@@ -1793,11 +1879,14 @@
chunk->items -= n_items;
break;
}
+
if (idx == 0 && n_items >= (INTVAL)chunk->items) {
/* delete this chunk */
n_items -= chunk->items;
+
/* rebuild_chunk_list will kill it because: */
chunk->items = 0;
+
if (!chunk->prev)
list->first = chunk->next;
}
@@ -1805,16 +1894,20 @@
/* else shrink chunk, it starts at idx then */
if (!(chunk->flags & sparse))
chunk->flags = no_power_2;
- n_items -= chunk->items - idx;
+
+ n_items -= chunk->items - idx;
chunk->items = idx;
}
- idx = 0;
+
+ idx = 0;
chunk = chunk->next;
}
+
rebuild_chunk_ptrs(list, 1);
rebuild_chunk_list(interp, list);
}
+
/*
=item C<void list_push(PARROT_INTERP, List *list, void *item, int type)>
@@ -1835,6 +1928,7 @@
list_append(interp, list, item, type, idx);
}
+
/*
=item C<void list_unshift(PARROT_INTERP, List *list, void *item, int type)>
@@ -1853,15 +1947,19 @@
List_chunk *chunk;
if (list->start == 0) {
- chunk = add_chunk(interp, list, enum_add_at_start, 0);
+ chunk = add_chunk(interp, list, enum_add_at_start, 0);
list->start = chunk->items;
}
+
+ /* XXX This chunk is unused. Why are we getting it? */
else
- chunk = list->first; /* XXX This chunk is unused. Why are we getting it? */
+ chunk = list->first;
+
list_set(interp, list, item, type, --list->start);
list->length++;
}
+
/*
=item C<void * list_pop(PARROT_INTERP, List *list, int type)>
@@ -1878,29 +1976,33 @@
list_pop(PARROT_INTERP, ARGMOD(List *list), int type)
{
ASSERT_ARGS(list_pop)
- UINTVAL idx;
- void *ret;
List_chunk *chunk = list->last;
+ UINTVAL idx;
if (list->length == 0)
return NULL;
+
idx = list->start + --list->length;
+
if (list->length == 0)
list->start = 0;
/* shrink array if necessary */
if (idx < list->cap - chunk->items) {
- list->cap -= chunk->items;
- chunk = list->last = chunk->prev;
+ list->cap -= chunk->items;
+ chunk = list->last = chunk->prev;
chunk->next = NULL;
+
if (list->n_chunks <= 2)
list->first = list->last;
+
rebuild_chunk_list(interp, list);
}
- ret = list_item(interp, list, type, idx);
- return ret;
+
+ return list_item(interp, list, type, idx);
}
+
/*
=item C<void * list_shift(PARROT_INTERP, List *list, int type)>
@@ -1917,30 +2019,38 @@
list_shift(PARROT_INTERP, ARGMOD(List *list), int type)
{
ASSERT_ARGS(list_shift)
- void *ret;
- UINTVAL idx;
+ void *ret;
List_chunk *chunk = list->first;
+ UINTVAL idx;
if (list->length == 0)
return NULL;
+
idx = list->start;
+
/* optimize push + shift on empty lists */
if (--list->length == 0)
list->start = 0;
else
list->start++;
+
ret = list_item(interp, list, type, idx);
+
if (list->start >= chunk->items) {
- list->cap -= chunk->items;
- chunk = list->first = chunk->next ? chunk->next : list->last;
+ list->cap -= chunk->items;
+ chunk = list->first = chunk->next ? chunk->next : list->last;
list->start = 0;
+
rebuild_chunk_list(interp, list);
+
if (list->n_chunks == 1)
list->last = list->first;
}
+
return ret;
}
+
/*
=item C<void list_assign(PARROT_INTERP, List *list, INTVAL idx, void *item, int
@@ -1967,11 +2077,11 @@
list_append(interp, list, item, type, list->start + idx);
list->length = idx + 1;
}
- else {
+ else
list_set(interp, list, item, type, list->start + idx);
- }
}
+
/*
=item C<void * list_get(PARROT_INTERP, List *list, INTVAL idx, int type)>
@@ -1991,16 +2101,18 @@
ASSERT_ARGS(list_get)
const INTVAL length = list->length;
- if (idx >= length || -idx > length) {
+ if (idx >= length || -idx > length)
return NULL;
- }
if (idx < 0)
idx += length;
+
idx += list->start;
+
return list_item(interp, list, type, idx);
}
+
/*
=item C<void list_splice(PARROT_INTERP, List *list, List *value_list, INTVAL
@@ -2021,9 +2133,9 @@
{
ASSERT_ARGS(list_splice)
const INTVAL value_length = value_list ? value_list->length : 0;
- const INTVAL length = list->length;
- const int type = list->item_type;
- INTVAL i, j;
+ const INTVAL length = list->length;
+ const int type = list->item_type;
+ INTVAL i, j;
if (value_list && type != value_list->item_type)
Parrot_ex_throw_from_c_args(interp, NULL, 1,
@@ -2057,30 +2169,34 @@
val = *(PMC **)val;
else if (type == enum_type_STRING)
val = *(STRING **)val;
+
list_assign(interp, list, offset + i, val, type);
}
+
/* if we still have values in value_list, insert them */
if (j < value_length) {
/* make room for the remaining values */
list_insert(interp, list, offset + i, value_length - j);
+
for (; j < value_length; i++, j++) {
void *val = list_get(interp, value_list, j, type);
- /* XXX We don't know that val is non-NULL coming back from list_get. */
- /* We need to check that we're not dereferencing NULL. */
+ /* XXX We don't know that val is non-NULL coming back from
+ * list_get; check that we're not dereferencing NULL. */
if (type == enum_type_PMC)
val = *(PMC **)val;
else if (type == enum_type_STRING)
val = *(STRING **)val;
+
list_assign(interp, list, offset + i, val, type);
}
}
- else {
- /* else delete the rest */
+ /* else delete the rest */
+ else
list_delete(interp, list, offset + i, count - i);
- }
}
+
/*
=back
Deleted: branches/pmc_pct/src/malloc-trace.c
==============================================================================
--- branches/pmc_pct/src/malloc-trace.c Thu Jun 4 02:32:48 2009 (r39376)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,353 +0,0 @@
-/* malloc-trace.c
- *
- * by Wolfram Gloger 1995.
- *
- * $Id$
- * Copyright (C) 2002-2007, Parrot Foundation.
- */
-
-#include <stdio.h>
-#include <stdlib.h>
-#include <unistd.h>
-#include <fcntl.h>
-#include <string.h>
-#include <sys/time.h>
-#ifdef __linux__
-# include <signal.h>
-# include <asm/signal.h>
-#endif
-
-#include "malloc-trace.h"
-
-#define ACTION_BUF_SIZE 1024
-#define TIMESTAMP_FREQ 50
-#define LOG_NAME "/tmp/mtrace"
-
-static void malloc_trace_destructor(void);
-
-static ACTION buffer[ACTION_BUF_SIZE+1];
-static int buffer_i = 0;
-static int fd = -1;
-static int tracing = 1;
-static int pid = 0;
-static char *initial_brk = 0;
-
-/*
-
-=head1 NAME
-
-src/malloc-trace.c
-
-=head1 DESCRIPTION
-
-RT#48264
-
-=head2 Functions
-
-=over 4
-
-=cut
-
-*/
-
-/*
-
-=item C<static void open_log_file()>
-
-Open a logfile for storing debugging information.
-
-=cut
-
-*/
-
-static void
-open_log_file()
-{
- char name[128];
- const unsigned version = MTRACE_VERSION;
-#ifdef __linux__
- char cmdline[128], *s;
- int count, fd2;
-#endif
-
- tracing = 0;
- pid = getpid();
-#ifdef __linux__
- sprintf(name, "/proc/%d/cmdline", pid);
- fd2 = open(name, O_RDONLY);
- if (fd2>=0 && (count = read(fd2, cmdline, 127)) > 0) {
- close(fd2);
- cmdline[count] = 0;
- for (s=cmdline; *s++;); s--;
- while (--s>cmdline && *s!='/');
- if (*s == '/') s++;
- sprintf(name, LOG_NAME ".%.12s.%d", s, pid);
- }
- else {
- sprintf(name, LOG_NAME ".%d", pid);
- }
-#else
- sprintf(name, LOG_NAME ".%d", pid);
-#endif
- fd = open(name, O_WRONLY|O_CREAT, 0600);
- if (fd >= 0) {
- write(fd, &version, sizeof (version));
- write(fd, &initial_brk, sizeof (initial_brk));
- }
- tracing = 1;
-}
-
-/*
-
-=item C<static void malloc_trace_destructor(void)>
-
-Print out a final timestamp and message to the log file.
-
-=cut
-
-*/
-
-static void
-malloc_trace_destructor(void)
-{
- struct timeval t;
-
- /* produce final timestamp */
- gettimeofday(&t, NULL);
- buffer[buffer_i].code = CODE_TIMESTAMP;
- buffer[buffer_i].size = t.tv_sec;
- buffer[buffer_i].ptr = (void *)t.tv_usec;
- buffer[buffer_i].ptr2 = NULL;
- buffer_i++;
- if (fd < 0) open_log_file();
- if (getpid() != pid) { /* Oops, must have forked... */
- if (fd >= 0) close(fd);
- return;
- }
- if (fd >= 0) write(fd, buffer, buffer_i*sizeof (ACTION));
- write(2, "<end malloc trace>\n", 19);
- if (fd >= 0) close(fd);
-}
-
-#ifdef __linux__
-
-/*
-
-=item C<static void malloc_segv_handler(int i, struct sigcontext_struct sc)>
-
-Catch a segfault signal, print an error message, and end the logfile.
-
-=cut
-
-*/
-
-static void
-malloc_segv_handler(int i, struct sigcontext_struct sc)
-{
- tracing = 0;
- fprintf(stderr, "malloc-trace: caught SEGV signal.\n");
- fprintf(stderr, "sc.cr2 = %8lx\n", (unsigned long)sc.cr2);
- malloc_trace_destructor();
-}
-
-#endif
-
-/*
-
-=item C<static void malloc_record(int code, size_t size, void *ptr, void *ptr2)>
-
-Record information about the allocation into the logfile.
-
-=cut
-
-*/
-
-static void
-malloc_record(int code, size_t size, void *ptr, void *ptr2)
-{
- static long count = 0;
- struct timeval t;
-
- if (!tracing) return;
-#ifdef __linux__
- if (count == 0) signal(SIGSEGV, (void (*)(int))malloc_segv_handler);
-#endif
- if ((count++ % TIMESTAMP_FREQ) == 0) {
- gettimeofday(&t, NULL);
- buffer[buffer_i].code = CODE_TIMESTAMP;
- buffer[buffer_i].size = t.tv_sec;
- buffer[buffer_i].ptr = (void *)t.tv_usec;
- buffer[buffer_i].ptr2 = NULL;
- buffer_i++;
- }
- buffer[buffer_i].code = code;
- buffer[buffer_i].size = size;
- buffer[buffer_i].ptr = ptr;
- buffer[buffer_i].ptr2 = ptr2;
- if (++buffer_i >= ACTION_BUF_SIZE) {
- if (fd < 0) open_log_file();
- if (getpid() != pid) { /* Oops, must have forked... */
- tracing = 0;
- return;
- }
- if (fd >= 0) write(fd, buffer, buffer_i*sizeof (ACTION));
- buffer_i = 0;
- }
-}
-
-void* _real_malloc(size_t bytes);
-
-/*
-
-=item C<void* malloc(size_t bytes)>
-
-Allocate memory with the specified size in bytes. Record information about it
-in the logfile.
-
-=cut
-
-*/
-
-void* malloc(size_t bytes)
-{
- void *ptr;
-
- if (initial_brk == 0) { /* Must be the first time. */
- initial_brk = sbrk(0);
- atexit(malloc_trace_destructor);
- }
- ptr = _real_malloc(bytes);
- malloc_record(CODE_MALLOC, bytes, ptr, 0);
- return ptr;
-}
-#define malloc _real_malloc
-
-void _real_free(void* mem);
-
-/*
-
-=item C<void free(void* mem)>
-
-Record information about the free in the logfile, and free the memory.
-
-=cut
-
-*/
-
-void free(void* mem)
-{
- malloc_record(CODE_FREE, 0, mem, 0);
- _real_free(mem);
-}
-#define free _real_free
-
-void* _real_realloc(void* mem, size_t bytes);
-
-/*
-
-=item C<void* realloc(void* mem, size_t bytes)>
-
-Resize the allocated memory buffer to the new size.
-
-=cut
-
-*/
-
-void* realloc(void* mem, size_t bytes)
-{
- void *ptr;
-
- ptr = _real_realloc(mem, bytes);
- malloc_record(CODE_REALLOC, bytes, mem, ptr);
- return ptr;
-}
-#define realloc _real_realloc
-
-void* _real_memalign(size_t alignment, size_t bytes);
-
-/*
-
-=item C<void* memalign(size_t alignment, size_t bytes)>
-
-Return an allocated memory buffer that's of at least the given size in bytes
-and is aligned along the given boundary.
-
-=cut
-
-*/
-
-void* memalign(size_t alignment, size_t bytes)
-{
- void *ptr;
-
- if (initial_brk == 0) { /* Must be the first time. */
- initial_brk = sbrk(0);
- atexit(malloc_trace_destructor);
- }
- ptr = _real_memalign(alignment, bytes);
- malloc_record(CODE_MEMALIGN, bytes, ptr, (void*)alignment);
- return ptr;
-}
-#define memalign _real_memalign
-
-void* _real_calloc(size_t n, size_t elem_size);
-
-/*
-
-=item C<void* calloc(size_t n, size_t elem_size)>
-
-Allocate memory of the given size, initializing the memory to the given value.
-
-=cut
-
-*/
-
-void* calloc(size_t n, size_t elem_size)
-{
- void *ptr;
-
- if (initial_brk == 0) { /* Must be the first time. */
- initial_brk = sbrk(0);
- atexit(malloc_trace_destructor);
- }
- ptr = _real_calloc(n, elem_size);
- malloc_record(CODE_CALLOC, n*elem_size, ptr, 0);
- return ptr;
-}
-#define calloc _real_calloc
-
-void _real_cfree(void *mem);
-
-/*
-
-=item C<void cfree(void *mem)>
-
-free the given buffer, recording information about it in the log.
-
-=cut
-
-*/
-
-void cfree(void *mem)
-{
- malloc_record(CODE_CFREE, 0, mem, 0);
- _real_cfree(mem);
-}
-#define cfree _real_cfree
-
-#include "malloc.c"
-
-/*
-
-=back
-
-=cut
-
-*/
-
-/*
- * Local variables:
- * c-file-style: "parrot"
- * End:
- * vim: expandtab shiftwidth=4:
- */
Deleted: branches/pmc_pct/src/malloc.c
==============================================================================
--- branches/pmc_pct/src/malloc.c Thu Jun 4 02:32:48 2009 (r39376)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,5655 +0,0 @@
-/*
- This is a version (aka dlmalloc) of malloc/free/realloc written by
- Doug Lea and released to the public domain. Use, modify, and
- redistribute this code without permission or acknowledgment in any
- way you wish. Send questions, comments, complaints, performance
- data, etc to dl at cs.oswego.edu
-
-* VERSION 2.7.2 Sat Aug 17 09:07:30 2002 Doug Lea (dl at gee)
-
- Note: There may be an updated version of this malloc obtainable at
- ftp://gee.cs.oswego.edu/pub/misc/malloc.c
- Check before installing!
-
-* Quickstart
-
- This library is all in one file to simplify the most common usage:
- ftp it, compile it (-O), and link it into another program. All
- of the compile-time options default to reasonable values for use on
- most unix platforms. Compile -DWIN32 for reasonable defaults on windows.
- You might later want to step through various compile-time and dynamic
- tuning options.
-
- For convenience, an include file for code using this malloc is at:
- ftp://gee.cs.oswego.edu/pub/misc/malloc-2.7.1.h
- You don't really need this .h file unless you call functions not
- defined in your system include files. The .h file contains only the
- excerpts from this file needed for using this malloc on ANSI C/C++
- systems, so long as you haven't changed compile-time options about
- naming and tuning parameters. If you do, then you can create your
- own malloc.h that does include all settings by cutting at the point
- indicated below.
-
-* Why use this malloc?
-
- This is not the fastest, most space-conserving, most portable, or
- most tunable malloc ever written. However it is among the fastest
- while also being among the most space-conserving, portable and tunable.
- Consistent balance across these factors results in a good general-purpose
- allocator for malloc-intensive programs.
-
- The main properties of the algorithms are:
- * For large (>= 512 bytes) requests, it is a pure best-fit allocator,
- with ties normally decided via FIFO (i.e. least recently used).
- * For small (<= 64 bytes by default) requests, it is a caching
- allocator, that maintains pools of quickly recycled chunks.
- * In between, and for combinations of large and small requests, it does
- the best it can trying to meet both goals at once.
- * For very large requests (>= 128KB by default), it relies on system
- memory mapping facilities, if supported.
-
- For a longer but slightly out of date high-level description, see
- http://gee.cs.oswego.edu/dl/html/malloc.html
-
- You may already by default be using a C library containing a malloc
- that is based on some version of this malloc (for example in
- linux). You might still want to use the one in this file in order to
- customize settings or to avoid overheads associated with library
- versions.
-
-* Contents, described in more detail in "description of public routines" below.
-
- Standard (ANSI/SVID/...) functions:
- malloc(size_t n);
- calloc(size_t n_elements, size_t element_size);
- free(Void_t* p);
- realloc(Void_t* p, size_t n);
- memalign(size_t alignment, size_t n);
- valloc(size_t n);
- mallinfo()
- mallopt(int parameter_number, int parameter_value)
-
- Additional functions:
- independent_calloc(size_t n_elements, size_t size, Void_t* chunks[]);
- independent_comalloc(size_t n_elements, size_t sizes[], Void_t* chunks[]);
- pvalloc(size_t n);
- cfree(Void_t* p);
- malloc_trim(size_t pad);
- malloc_usable_size(Void_t* p);
- malloc_stats();
-
-* Vital statistics:
-
- Supported pointer representation: 4 or 8 bytes
- Supported size_t representation: 4 or 8 bytes
- Note that size_t is allowed to be 4 bytes even if pointers are 8.
- You can adjust this by defining INTERNAL_SIZE_T
-
- Alignment: 2 * sizeof (size_t) (default)
- (i.e., 8 byte alignment with 4byte size_t). This suffices for
- nearly all current machines and C compilers. However, you can
- define MALLOC_ALIGNMENT to be wider than this if necessary.
-
- Minimum overhead per allocated chunk: 4 or 8 bytes
- Each malloced chunk has a hidden word of overhead holding size
- and status information.
-
- Minimum allocated size: 4-byte ptrs: 16 bytes (including 4 overhead)
- 8-byte ptrs: 24/32 bytes (including, 4/8 overhead)
-
- When a chunk is freed, 12 (for 4byte ptrs) or 20 (for 8 byte
- ptrs but 4 byte size) or 24 (for 8/8) additional bytes are
- needed; 4 (8) for a trailing size field and 8 (16) bytes for
- free list pointers. Thus, the minimum allocatable size is
- 16/24/32 bytes.
-
- Even a request for zero bytes (i.e., malloc(0)) returns a
- pointer to something of the minimum allocatable size.
-
- The maximum overhead wastage (i.e., number of extra bytes
- allocated than were requested in malloc) is less than or equal
- to the minimum size, except for requests >= mmap_threshold that
- are serviced via mmap(), where the worst case wastage is 2 *
- sizeof (size_t) bytes plus the remainder from a system page (the
- minimal mmap unit); typically 4096 or 8192 bytes.
-
- Maximum allocated size: 4-byte size_t: 2^32 minus about two pages
- 8-byte size_t: 2^64 minus about two pages
-
- It is assumed that (possibly signed) size_t values suffice to
- represent chunk sizes. `Possibly signed' is due to the fact
- that `size_t' may be defined on a system as either a signed or
- an unsigned type. The ISO C standard says that it must be
- unsigned, but a few systems are known not to adhere to this.
- Additionally, even when size_t is unsigned, sbrk (which is by
- default used to obtain memory from system) accepts signed
- arguments, and may not be able to handle size_t-wide arguments
- with negative sign bit. Generally, values that would
- appear as negative after accounting for overhead and alignment
- are supported only via mmap(), which does not have this
- limitation.
-
- Requests for sizes outside the allowed range will perform an optional
- failure action and then return null. (Requests may also
- also fail because a system is out of memory.)
-
- Thread-safety: NOT thread-safe unless USE_MALLOC_LOCK defined
-
- When USE_MALLOC_LOCK is defined, wrappers are created to
- surround every public call with either a pthread mutex or
- a win32 spinlock (depending on WIN32). This is not
- especially fast, and can be a major bottleneck.
- It is designed only to provide minimal protection
- in concurrent environments, and to provide a basis for
- extensions. If you are using malloc in a concurrent program,
- you would be far better off obtaining ptmalloc, which is
- derived from a version of this malloc, and is well-tuned for
- concurrent programs. (See http://www.malloc.de) Note that
- even when USE_MALLOC_LOCK is defined, you can can guarantee
- full thread-safety only if no threads acquire memory through
- direct calls to MORECORE or other system-level allocators.
-
- Compliance: I believe it is compliant with the 1997 Single Unix Specification
- (See http://www.opennc.org). Also SVID/XPG, ANSI C, and probably
- others as well.
-
-* Synopsis of compile-time options:
-
- People have reported using previous versions of this malloc on all
- versions of Unix, sometimes by tweaking some of the defines
- below. It has been tested most extensively on Solaris and
- Linux. It is also reported to work on WIN32 platforms.
- People also report using it in stand-alone embedded systems.
-
- The implementation is in straight, hand-tuned ANSI C. It is not
- at all modular. (Sorry!) It uses a lot of macros. To be at all
- usable, this code should be compiled using an optimizing compiler
- (for example gcc -O3) that can simplify expressions and control
- paths. (FAQ: some macros import variables as arguments rather than
- declare locals because people reported that some debuggers
- otherwise get confused.)
-
- OPTION DEFAULT VALUE
-
- Compilation Environment options:
-
- __STD_C derived from C compiler defines
- WIN32 NOT defined
- HAVE_MEMCPY defined
- USE_MEMCPY 1 if HAVE_MEMCPY is defined
- HAVE_MMAP defined as 1
- MMAP_CLEARS 1
- HAVE_MREMAP 0 unless linux defined
- malloc_getpagesize derived from system #includes, or 4096 if not
- HAVE_USR_INCLUDE_MALLOC_H NOT defined
- LACKS_UNISTD_H NOT defined unless WIN32
- LACKS_SYS_PARAM_H NOT defined unless WIN32
- LACKS_SYS_MMAN_H NOT defined unless WIN32
- LACKS_FCNTL_H NOT defined
-
- Changing default word sizes:
-
- INTERNAL_SIZE_T size_t
- MALLOC_ALIGNMENT 2 * sizeof (INTERNAL_SIZE_T)
- PTR_UINT unsigned long
- CHUNK_SIZE_T unsigned long
-
- Configuration and functionality options:
-
- USE_DL_PREFIX NOT defined
- USE_PUBLIC_MALLOC_WRAPPERS NOT defined
- USE_MALLOC_LOCK NOT defined
- DEBUG NOT defined
- REALLOC_ZERO_BYTES_FREES NOT defined
- MALLOC_FAILURE_ACTION errno = ENOMEM, if __STD_C defined, else no-op
- TRIM_FASTBINS 0
- FIRST_SORTED_BIN_SIZE 512
-
- Options for customizing MORECORE:
-
- MORECORE sbrk
- MORECORE_CONTIGUOUS 1
- MORECORE_CANNOT_TRIM NOT defined
- MMAP_AS_MORECORE_SIZE (1024 * 1024)
-
- Tuning options that are also dynamically changeable via mallopt:
-
- DEFAULT_MXFAST 64
- DEFAULT_TRIM_THRESHOLD 256 * 1024
- DEFAULT_TOP_PAD 0
- DEFAULT_MMAP_THRESHOLD 256 * 1024
- DEFAULT_MMAP_MAX 65536
-
- There are several other #defined constants and macros that you
- probably don't want to touch unless you are extending or adapting malloc.
-*/
-
-/*
- WIN32 sets up defaults for MS environment and compilers.
- Otherwise defaults are for unix.
-*/
-
-/* #define WIN32 */
-
-#ifdef WIN32
-
-# define WIN32_LEAN_AND_MEAN
-# include <windows.h>
-
-/* Win32 doesn't supply or need the following headers */
-# define LACKS_UNISTD_H
-# define LACKS_SYS_PARAM_H
-# define LACKS_SYS_MMAN_H
-
-/* Use the supplied emulation of sbrk */
-# define MORECORE sbrk
-# define MORECORE_CONTIGUOUS 1
-# define MORECORE_FAILURE ((void*)(-1))
-
-/* Use the supplied emulation of mmap and munmap */
-# define HAVE_MMAP 1
-# define MUNMAP_FAILURE (-1)
-# define MMAP_CLEARS 1
-
-/* These values don't really matter in windows mmap emulation */
-# define MAP_PRIVATE 1
-# define MAP_ANONYMOUS 2
-# define PROT_READ 1
-# define PROT_WRITE 2
-
-/* Emulation functions defined at the end of this file */
-
-/* If USE_MALLOC_LOCK, use supplied critical-section-based lock functions */
-# ifdef USE_MALLOC_LOCK
-static int slwait(int *sl);
-static int slrelease(int *sl);
-# endif
-
-static long getpagesize(void);
-static long getregionsize(void);
-static void *sbrk(long size);
-static void *mmap(void *ptr, long size, long prot, long type,
- long handle, long arg);
-static long munmap(void *ptr, long size);
-
-static void vminfo (unsigned long*free, unsigned long*reserved,
- unsigned long*committed);
-static int cpuinfo (int whole, unsigned long*kernel, unsigned long*user);
-
-#endif
-
-/*
- __STD_C should be nonzero if using ANSI-standard C compiler, a C++
- compiler, or a C compiler sufficiently close to ANSI to get away
- with it.
-*/
-
-#ifndef __STD_C
-# if defined(__STDC__) || defined(_cplusplus)
-# define __STD_C 1
-# else
-# define __STD_C 0
-# endif
-#endif /*__STD_C*/
-
-
-/*
- Void_t* is the pointer type that malloc should say it returns
-*/
-
-#ifndef Void_t
-# if (__STD_C || defined(WIN32))
-# define Void_t void
-# else
-# define Void_t char
-# endif
-#endif /*Void_t*/
-
-#if __STD_C
-# include <stddef.h> /* for size_t */
-#else
-# include <sys/types.h>
-#endif
-
-#ifdef __cplusplus
-extern "C" {
-#endif
-
-/* define LACKS_UNISTD_H if your system does not have a <unistd.h>. */
-
-/* #define LACKS_UNISTD_H */
-
-#ifndef LACKS_UNISTD_H
-# include <unistd.h>
-#endif
-
-/* define LACKS_SYS_PARAM_H if your system does not have a <sys/param.h>. */
-
-/* #define LACKS_SYS_PARAM_H */
-
-
-#include <stdio.h> /* needed for malloc_stats */
-#include <errno.h> /* needed for optional MALLOC_FAILURE_ACTION */
-
-
-/*
- Debugging:
-
- Because freed chunks may be overwritten with bookkeeping fields, this
- malloc will often die when freed memory is overwritten by user
- programs. This can be very effective (albeit in an annoying way)
- in helping track down dangling pointers.
-
- If you compile with -DDEBUG, a number of assertion checks are
- enabled that will catch more memory errors. You probably won't be
- able to make much sense of the actual assertion errors, but they
- should help you locate incorrectly overwritten memory. The
- checking is fairly extensive, and will slow down execution
- noticeably. Calling malloc_stats or mallinfo with DEBUG set will
- attempt to check every non-mmapped allocated and free chunk in the
- course of computing the summaries. (By nature, mmapped regions
- cannot be checked very much automatically.)
-
- Setting DEBUG may also be helpful if you are trying to modify
- this code. The assertions in the check routines spell out in more
- detail the assumptions and invariants underlying the algorithms.
-
- Setting DEBUG does NOT provide an automated mechanism for checking
- that all accesses to malloced memory stay within their
- bounds. However, there are several add-ons and adaptations of this
- or other mallocs available that do this.
-*/
-
-#if DEBUG
-# include <assert.h>
-#else
-# define assert(x) ((void)0)
-#endif
-
-/*
- The unsigned integer type used for comparing any two chunk sizes.
- This should be at least as wide as size_t, but should not be signed.
-*/
-
-#ifndef CHUNK_SIZE_T
-# define CHUNK_SIZE_T unsigned long
-#endif
-
-/*
- The unsigned integer type used to hold addresses when they are are
- manipulated as integers. Except that it is not defined on all
- systems, intptr_t would suffice.
-*/
-#ifndef PTR_UINT
-# define PTR_UINT unsigned long
-#endif
-
-
-/*
- INTERNAL_SIZE_T is the word-size used for internal bookkeeping
- of chunk sizes.
-
- The default version is the same as size_t.
-
- While not strictly necessary, it is best to define this as an
- unsigned type, even if size_t is a signed type. This may avoid some
- artificial size limitations on some systems.
-
- On a 64-bit machine, you may be able to reduce malloc overhead by
- defining INTERNAL_SIZE_T to be a 32 bit `unsigned int' at the
- expense of not being able to handle more than 2^32 of malloced
- space. If this limitation is acceptable, you are encouraged to set
- this unless you are on a platform requiring 16byte alignments. In
- this case the alignment requirements turn out to negate any
- potential advantages of decreasing size_t word size.
-
- Implementors: Beware of the possible combinations of:
- - INTERNAL_SIZE_T might be signed or unsigned, might be 32 or 64 bits,
- and might be the same width as int or as long
- - size_t might have different width and signedness as INTERNAL_SIZE_T
- - int and long might be 32 or 64 bits, and might be the same width
- To deal with this, most comparisons and difference computations
- among INTERNAL_SIZE_Ts should cast them to CHUNK_SIZE_T, being
- aware of the fact that casting an unsigned int to a wider long does
- not sign-extend. (This also makes checking for negative numbers
- awkward.) Some of these casts result in harmless compiler warnings
- on some systems.
-*/
-
-#ifndef INTERNAL_SIZE_T
-# define INTERNAL_SIZE_T size_t
-#endif
-
-/* The corresponding word size */
-#define SIZE_SZ (sizeof (INTERNAL_SIZE_T))
-
-
-
-/*
- MALLOC_ALIGNMENT is the minimum alignment for malloc'ed chunks.
- It must be a power of two at least 2 * SIZE_SZ, even on machines
- for which smaller alignments would suffice. It may be defined as
- larger than this though. Note however that code and data structures
- are optimized for the case of 8-byte alignment.
-*/
-
-
-#ifndef MALLOC_ALIGNMENT
-# define MALLOC_ALIGNMENT (2 * SIZE_SZ)
-#endif
-
-/* The corresponding bit mask value */
-#define MALLOC_ALIGN_MASK (MALLOC_ALIGNMENT - 1)
-
-
-
-/*
- REALLOC_ZERO_BYTES_FREES should be set if a call to
- realloc with zero bytes should be the same as a call to free.
- Some people think it should. Otherwise, since this malloc
- returns a unique pointer for malloc(0), so does realloc(p, 0).
-*/
-
-/* #define REALLOC_ZERO_BYTES_FREES */
-
-/*
- TRIM_FASTBINS controls whether free() of a very small chunk can
- immediately lead to trimming. Setting to true (1) can reduce memory
- footprint, but will almost always slow down programs that use a lot
- of small chunks.
-
- Define this only if you are willing to give up some speed to more
- aggressively reduce system-level memory footprint when releasing
- memory in programs that use many small chunks. You can get
- essentially the same effect by setting MXFAST to 0, but this can
- lead to even greater slowdowns in programs using many small chunks.
- TRIM_FASTBINS is an in-between compile-time option, that disables
- only those chunks bordering topmost memory from being placed in
- fastbins.
-*/
-
-#ifndef TRIM_FASTBINS
-# define TRIM_FASTBINS 0
-#endif
-
-
-/*
- USE_DL_PREFIX will prefix all public routines with the string 'dl'.
- This is necessary when you only want to use this malloc in one part
- of a program, using your regular system malloc elsewhere.
-*/
-
-/* #define USE_DL_PREFIX */
-
-
-/*
- USE_MALLOC_LOCK causes wrapper functions to surround each
- callable routine with pthread mutex lock/unlock.
-
- USE_MALLOC_LOCK forces USE_PUBLIC_MALLOC_WRAPPERS to be defined
-*/
-
-
-/* #define USE_MALLOC_LOCK */
-
-
-/*
- If USE_PUBLIC_MALLOC_WRAPPERS is defined, every public routine is
- actually a wrapper function that first calls MALLOC_PREACTION, then
- calls the internal routine, and follows it with
- MALLOC_POSTACTION. This is needed for locking, but you can also use
- this, without USE_MALLOC_LOCK, for purposes of interception,
- instrumentation, etc. It is a sad fact that using wrappers often
- noticeably degrades performance of malloc-intensive programs.
-*/
-
-#ifdef USE_MALLOC_LOCK
-# define USE_PUBLIC_MALLOC_WRAPPERS
-#else
- /* #define USE_PUBLIC_MALLOC_WRAPPERS */
-#endif
-
-
-/*
- Two-phase name translation.
- All of the actual routines are given mangled names.
- When wrappers are used, they become the public callable versions.
- When DL_PREFIX is used, the callable names are prefixed.
-*/
-
-#ifndef USE_PUBLIC_MALLOC_WRAPPERS
-# define cALLOc public_cALLOc
-# define fREe public_fREe
-# define cFREe public_cFREe
-# define mALLOc public_mALLOc
-# define mEMALIGn public_mEMALIGn
-# define rEALLOc public_rEALLOc
-# define vALLOc public_vALLOc
-# define pVALLOc public_pVALLOc
-# define mALLINFo public_mALLINFo
-# define mALLOPt public_mALLOPt
-# define mTRIm public_mTRIm
-# define mSTATs public_mSTATs
-# define mUSABLe public_mUSABLe
-# define iCALLOc public_iCALLOc
-# define iCOMALLOc public_iCOMALLOc
-#endif
-
-#ifdef USE_DL_PREFIX
-# define public_cALLOc dlcalloc
-# define public_fREe dlfree
-# define public_cFREe dlcfree
-# define public_mALLOc dlmalloc
-# define public_mEMALIGn dlmemalign
-# define public_rEALLOc dlrealloc
-# define public_vALLOc dlvalloc
-# define public_pVALLOc dlpvalloc
-# define public_mALLINFo dlmallinfo
-# define public_mALLOPt dlmallopt
-# define public_mTRIm dlmalloc_trim
-# define public_mSTATs dlmalloc_stats
-# define public_mUSABLe dlmalloc_usable_size
-# define public_iCALLOc dlindependent_calloc
-# define public_iCOMALLOc dlindependent_comalloc
-#else /* USE_DL_PREFIX */
-# define public_cALLOc calloc
-# define public_fREe free
-# define public_cFREe cfree
-# define public_mALLOc malloc
-# define public_mEMALIGn memalign
-# define public_rEALLOc realloc
-# define public_vALLOc valloc
-# define public_pVALLOc pvalloc
-# define public_mALLINFo mallinfo
-# define public_mALLOPt mallopt
-# define public_mTRIm malloc_trim
-# define public_mSTATs malloc_stats
-# define public_mUSABLe malloc_usable_size
-# define public_iCALLOc independent_calloc
-# define public_iCOMALLOc independent_comalloc
-#endif /* USE_DL_PREFIX */
-
-
-/*
- HAVE_MEMCPY should be defined if you are not otherwise using
- ANSI STD C, but still have memcpy and memset in your C library
- and want to use them in calloc and realloc. Otherwise simple
- macro versions are defined below.
-
- USE_MEMCPY should be defined as 1 if you actually want to
- have memset and memcpy called. People report that the macro
- versions are faster than libc versions on some systems.
-
- Even if USE_MEMCPY is set to 1, loops to copy/clear small chunks
- (of <= 36 bytes) are manually unrolled in realloc and calloc.
-*/
-
-#define HAVE_MEMCPY
-
-#ifndef USE_MEMCPY
-# ifdef HAVE_MEMCPY
-# define USE_MEMCPY 1
-# else
-# define USE_MEMCPY 0
-# endif
-#endif
-
-
-#if (__STD_C || defined(HAVE_MEMCPY))
-
-# ifdef WIN32
-/* On Win32 memset and memcpy are already declared in windows.h */
-# else
-# if __STD_C
-void* memset(void*, int, size_t);
-void* memcpy(void*, const void*, size_t);
-# else
-Void_t* memset();
-Void_t* memcpy();
-# endif
-# endif
-#endif
-
-/*
- MALLOC_FAILURE_ACTION is the action to take before "return 0" when
- malloc fails to be able to return memory, either because memory is
- exhausted or because of illegal arguments.
-
- By default, sets errno if running on STD_C platform, else does nothing.
-*/
-
-#ifndef MALLOC_FAILURE_ACTION
-# if __STD_C
-# define MALLOC_FAILURE_ACTION \
- errno = ENOMEM;
-
-# else
-# define MALLOC_FAILURE_ACTION
-# endif
-#endif
-
-/*
- MORECORE-related declarations. By default, rely on sbrk
-*/
-
-
-#ifdef LACKS_UNISTD_H
-# if !defined(__FreeBSD__) && !defined(__OpenBSD__) && \
- !defined(__NetBSD__) && !defined(__GNUC__)
-# if __STD_C
-extern Void_t* sbrk(ptrdiff_t);
-# else
-extern Void_t* sbrk();
-# endif
-# endif
-#endif
-
-/*
- MORECORE is the name of the routine to call to obtain more memory
- from the system. See below for general guidance on writing
- alternative MORECORE functions, as well as a version for WIN32 and a
- sample version for pre-OSX macos.
-*/
-
-#ifndef MORECORE
-# define MORECORE sbrk
-#endif
-
-/*
- MORECORE_FAILURE is the value returned upon failure of MORECORE
- as well as mmap. Since it cannot be an otherwise valid memory address,
- and must reflect values of standard sys calls, you probably ought not
- try to redefine it.
-*/
-
-#ifndef MORECORE_FAILURE
-# define MORECORE_FAILURE (-1)
-#endif
-
-/*
- If MORECORE_CONTIGUOUS is true, take advantage of fact that
- consecutive calls to MORECORE with positive arguments always return
- contiguous increasing addresses. This is true of unix sbrk. Even
- if not defined, when regions happen to be contiguous, malloc will
- permit allocations spanning regions obtained from different
- calls. But defining this when applicable enables some stronger
- consistency checks and space efficiencies.
-*/
-
-#ifndef MORECORE_CONTIGUOUS
-# define MORECORE_CONTIGUOUS 1
-#endif
-
-/*
- Define MORECORE_CANNOT_TRIM if your version of MORECORE
- cannot release space back to the system when given negative
- arguments. This is generally necessary only if you are using
- a hand-crafted MORECORE function that cannot handle negative arguments.
-*/
-
-/* #define MORECORE_CANNOT_TRIM */
-
-
-/*
- Define HAVE_MMAP as true to optionally make malloc() use mmap() to
- allocate very large blocks. These will be returned to the
- operating system immediately after a free(). Also, if mmap
- is available, it is used as a backup strategy in cases where
- MORECORE fails to provide space from system.
-
- This malloc is best tuned to work with mmap for large requests.
- If you do not have mmap, operations involving very large chunks (1MB
- or so) may be slower than you'd like.
-*/
-
-#ifndef HAVE_MMAP
-# define HAVE_MMAP 1
-#endif
-
-#if HAVE_MMAP
-/*
- Standard unix mmap using /dev/zero clears memory so calloc doesn't
- need to.
-*/
-
-# ifndef MMAP_CLEARS
-# define MMAP_CLEARS 1
-# endif
-
-#else /* no mmap */
-# ifndef MMAP_CLEARS
-# define MMAP_CLEARS 0
-# endif
-#endif
-
-
-/*
- MMAP_AS_MORECORE_SIZE is the minimum mmap size argument to use if
- sbrk fails, and mmap is used as a backup (which is done only if
- HAVE_MMAP). The value must be a multiple of page size. This
- backup strategy generally applies only when systems have "holes" in
- address space, so sbrk cannot perform contiguous expansion, but
- there is still space available on system. On systems for which
- this is known to be useful (i.e. most linux kernels), this occurs
- only when programs allocate huge amounts of memory. Between this,
- and the fact that mmap regions tend to be limited, the size should
- be large, to avoid too many mmap calls and thus avoid running out
- of kernel resources.
-*/
-
-#ifndef MMAP_AS_MORECORE_SIZE
-# define MMAP_AS_MORECORE_SIZE (1024 * 1024)
-#endif
-
-/*
- Define HAVE_MREMAP to make realloc() use mremap() to re-allocate
- large blocks. This is currently only possible on Linux with
- kernel versions newer than 1.3.77.
-*/
-
-#ifndef HAVE_MREMAP
-# ifdef linux
-# define HAVE_MREMAP 1
-# else
-# define HAVE_MREMAP 0
-# endif
-
-#endif /* HAVE_MMAP */
-
-
-/*
- The system page size. To the extent possible, this malloc manages
- memory from the system in page-size units. Note that this value is
- cached during initialization into a field of malloc_state. So even
- if malloc_getpagesize is a function, it is only called once.
-
- The following mechanics for getpagesize were adapted from bsd/gnu
- getpagesize.h. If none of the system-probes here apply, a value of
- 4096 is used, which should be OK: If they don't apply, then using
- the actual value probably doesn't impact performance.
-*/
-
-
-#ifndef malloc_getpagesize
-
-# ifndef LACKS_UNISTD_H
-# include <unistd.h>
-# endif
-
-# ifdef _SC_PAGESIZE /* some SVR4 systems omit an underscore */
-# ifndef _SC_PAGE_SIZE
-# define _SC_PAGE_SIZE _SC_PAGESIZE
-# endif
-# endif
-
-# ifdef _SC_PAGE_SIZE
-# define malloc_getpagesize sysconf(_SC_PAGE_SIZE)
-# else
-# if defined(BSD) || defined(DGUX) || defined(HAVE_GETPAGESIZE)
- extern size_t getpagesize();
-# define malloc_getpagesize getpagesize()
-# else
-# ifdef WIN32 /* use supplied emulation of getpagesize */
-# define malloc_getpagesize getpagesize()
-# else
-# ifndef LACKS_SYS_PARAM_H
-# include <sys/param.h>
-# endif
-# ifdef EXEC_PAGESIZE
-# define malloc_getpagesize EXEC_PAGESIZE
-# else
-# ifdef NBPG
-# ifndef CLSIZE
-# define malloc_getpagesize NBPG
-# else
-# define malloc_getpagesize (NBPG * CLSIZE)
-# endif
-# else
-# ifdef NBPC
-# define malloc_getpagesize NBPC
-# else
-# ifdef PAGESIZE
-# define malloc_getpagesize PAGESIZE
-# else /* just guess */
-# define malloc_getpagesize (4096)
-# endif
-# endif
-# endif
-# endif
-# endif
-# endif
-# endif
-#endif
-
-/*
- This version of malloc supports the standard SVID/XPG mallinfo
- routine that returns a struct containing usage properties and
- statistics. It should work on any SVID/XPG compliant system that has
- a /usr/include/malloc.h defining struct mallinfo. (If you'd like to
- install such a thing yourself, cut out the preliminary declarations
- as described above and below and save them in a malloc.h file. But
- there's no compelling reason to bother to do this.)
-
- The main declaration needed is the mallinfo struct that is returned
- (by-copy) by mallinfo(). The SVID/XPG malloinfo struct contains a
- bunch of fields that are not even meaningful in this version of
- malloc. These fields are are instead filled by mallinfo() with
- other numbers that might be of interest.
-
- HAVE_USR_INCLUDE_MALLOC_H should be set if you have a
- /usr/include/malloc.h file that includes a declaration of struct
- mallinfo. If so, it is included; else an SVID2/XPG2 compliant
- version is declared below. These must be precisely the same for
- mallinfo() to work. The original SVID version of this struct,
- defined on most systems with mallinfo, declares all fields as
- ints. But some others define as unsigned long. If your system
- defines the fields using a type of different width than listed here,
- you must #include your system version and #define
- HAVE_USR_INCLUDE_MALLOC_H.
-*/
-
-/* #define HAVE_USR_INCLUDE_MALLOC_H */
-
-#ifdef HAVE_USR_INCLUDE_MALLOC_H
-# include "/usr/include/malloc.h"
-#else
-
-/* SVID2/XPG mallinfo structure */
-
-struct mallinfo {
- int arena; /* non-mmapped space allocated from system */
- int ordblks; /* number of free chunks */
- int smblks; /* number of fastbin blocks */
- int hblks; /* number of mmapped regions */
- int hblkhd; /* space in mmapped regions */
- int usmblks; /* maximum total allocated space */
- int fsmblks; /* space available in freed fastbin blocks */
- int uordblks; /* total allocated space */
- int fordblks; /* total free space */
- int keepcost; /* top-most, releasable (via malloc_trim) space */
-};
-
-/*
- SVID/XPG defines four standard parameter numbers for mallopt,
- normally defined in malloc.h. Only one of these (M_MXFAST) is used
- in this malloc. The others (M_NLBLKS, M_GRAIN, M_KEEP) don't apply,
- so setting them has no effect. But this malloc also supports other
- options in mallopt described below.
-*/
-#endif
-
-
-/* ---------- description of public routines ------------ */
-
-/*
- malloc(size_t n)
- Returns a pointer to a newly allocated chunk of at least n bytes, or null
- if no space is available. Additionally, on failure, errno is
- set to ENOMEM on ANSI C systems.
-
- If n is zero, malloc returns a minumum-sized chunk. (The minimum
- size is 16 bytes on most 32bit systems, and 24 or 32 bytes on 64bit
- systems.) On most systems, size_t is an unsigned type, so calls
- with negative arguments are interpreted as requests for huge amounts
- of space, which will often fail. The maximum supported value of n
- differs across systems, but is in all cases less than the maximum
- representable value of a size_t.
-*/
-#if __STD_C
-Void_t* public_mALLOc(size_t);
-#else
-Void_t* public_mALLOc();
-#endif
-
-/*
- free(Void_t* p)
- Releases the chunk of memory pointed to by p, that had been previously
- allocated using malloc or a related routine such as realloc.
- It has no effect if p is null. It can have arbitrary (i.e., bad!)
- effects if p has already been freed.
-
- Unless disabled (using mallopt), freeing very large spaces will
- when possible, automatically trigger operations that give
- back unused memory to the system, thus reducing program footprint.
-*/
-#if __STD_C
-void public_fREe(Void_t*);
-#else
-void public_fREe();
-#endif
-
-/*
- calloc(size_t n_elements, size_t element_size);
- Returns a pointer to n_elements * element_size bytes, with all locations
- set to zero.
-*/
-#if __STD_C
-Void_t* public_cALLOc(size_t, size_t);
-#else
-Void_t* public_cALLOc();
-#endif
-
-/*
- realloc(Void_t* p, size_t n)
- Returns a pointer to a chunk of size n that contains the same data
- as does chunk p up to the minimum of (n, p's size) bytes, or null
- if no space is available.
-
- The returned pointer may or may not be the same as p. The algorithm
- prefers extending p when possible, otherwise it employs the
- equivalent of a malloc-copy-free sequence.
-
- If p is null, realloc is equivalent to malloc.
-
- If space is not available, realloc returns null, errno is set (if on
- ANSI) and p is NOT freed.
-
- if n is for fewer bytes than already held by p, the newly unused
- space is lopped off and freed if possible. Unless the #define
- REALLOC_ZERO_BYTES_FREES is set, realloc with a size argument of
- zero (re)allocates a minimum-sized chunk.
-
- Large chunks that were internally obtained via mmap will always
- be reallocated using malloc-copy-free sequences unless
- the system supports MREMAP (currently only linux).
-
- The old unix realloc convention of allowing the last-free'd chunk
- to be used as an argument to realloc is not supported.
-*/
-#if __STD_C
-Void_t* public_rEALLOc(Void_t*, size_t);
-#else
-Void_t* public_rEALLOc();
-#endif
-
-/*
- memalign(size_t alignment, size_t n);
- Returns a pointer to a newly allocated chunk of n bytes, aligned
- in accord with the alignment argument.
-
- The alignment argument should be a power of two. If the argument is
- not a power of two, the nearest greater power is used.
- 8-byte alignment is guaranteed by normal malloc calls, so don't
- bother calling memalign with an argument of 8 or less.
-
- Overreliance on memalign is a sure way to fragment space.
-*/
-#if __STD_C
-Void_t* public_mEMALIGn(size_t, size_t);
-#else
-Void_t* public_mEMALIGn();
-#endif
-
-/*
- valloc(size_t n);
- Equivalent to memalign(pagesize, n), where pagesize is the page
- size of the system. If the pagesize is unknown, 4096 is used.
-*/
-#if __STD_C
-Void_t* public_vALLOc(size_t);
-#else
-Void_t* public_vALLOc();
-#endif
-
-
-
-/*
- mallopt(int parameter_number, int parameter_value)
- Sets tunable parameters The format is to provide a
- (parameter-number, parameter-value) pair. mallopt then sets the
- corresponding parameter to the argument value if it can (i.e., so
- long as the value is meaningful), and returns 1 if successful else
- 0. SVID/XPG/ANSI defines four standard param numbers for mallopt,
- normally defined in malloc.h. Only one of these (M_MXFAST) is used
- in this malloc. The others (M_NLBLKS, M_GRAIN, M_KEEP) don't apply,
- so setting them has no effect. But this malloc also supports four
- other options in mallopt. See below for details. Briefly, supported
- parameters are as follows (listed defaults are for "typical"
- configurations).
-
- Symbol param # default allowed param values
- M_MXFAST 1 64 0-80 (0 disables fastbins)
- M_TRIM_THRESHOLD -1 256*1024 any (-1U disables trimming)
- M_TOP_PAD -2 0 any
- M_MMAP_THRESHOLD -3 256*1024 any (or 0 if no MMAP support)
- M_MMAP_MAX -4 65536 any (0 disables use of mmap)
-*/
-#if __STD_C
-int public_mALLOPt(int, int);
-#else
-int public_mALLOPt();
-#endif
-
-
-/*
- mallinfo()
- Returns (by copy) a struct containing various summary statistics:
-
- arena: current total non-mmapped bytes allocated from system
- ordblks: the number of free chunks
- smblks: the number of fastbin blocks (i.e., small chunks that
- have been freed but not use, reused, or consolidated)
- hblks: current number of mmapped regions
- hblkhd: total bytes held in mmapped regions
- usmblks: the maximum total allocated space. This will be greater
- than current total if trimming has occurred.
- fsmblks: total bytes held in fastbin blocks
- uordblks: current total allocated space (normal or mmapped)
- fordblks: total free space
- keepcost: the maximum number of bytes that could ideally be released
- back to system via malloc_trim. ("ideally" means that
- it ignores page restrictions etc.)
-
- Because these fields are ints, but internal bookkeeping may
- be kept as longs, the reported values may wrap around zero and
- thus be inaccurate.
-*/
-#if __STD_C
-struct mallinfo public_mALLINFo(void);
-#else
-struct mallinfo public_mALLINFo();
-#endif
-
-/*
- independent_calloc(size_t n_elements, size_t element_size, Void_t* chunks[]);
-
- independent_calloc is similar to calloc, but instead of returning a
- single cleared space, it returns an array of pointers to n_elements
- independent elements that can hold contents of size elem_size, each
- of which starts out cleared, and can be independently freed,
- realloc'ed etc. The elements are guaranteed to be adjacently
- allocated (this is not guaranteed to occur with multiple callocs or
- mallocs), which may also improve cache locality in some
- applications.
-
- The "chunks" argument is optional (i.e., may be null, which is
- probably the most typical usage). If it is null, the returned array
- is itself dynamically allocated and should also be freed when it is
- no longer needed. Otherwise, the chunks array must be of at least
- n_elements in length. It is filled in with the pointers to the
- chunks.
-
- In either case, independent_calloc returns this pointer array, or
- null if the allocation failed. If n_elements is zero and "chunks"
- is null, it returns a chunk representing an array with zero elements
- (which should be freed if not wanted).
-
- Each element must be individually freed when it is no longer
- needed. If you'd like to instead be able to free all at once, you
- should instead use regular calloc and assign pointers into this
- space to represent elements. (In this case though, you cannot
- independently free elements.)
-
- independent_calloc simplifies and speeds up implementations of many
- kinds of pools. It may also be useful when constructing large data
- structures that initially have a fixed number of fixed-sized nodes,
- but the number is not known at compile time, and some of the nodes
- may later need to be freed. For example:
-
- struct Node { int item; struct Node* next; };
-
- struct Node* build_list() {
- struct Node** pool;
- int n = read_number_of_nodes_needed();
- if (n <= 0) return 0;
- pool = (struct Node**)(independent_calloc(n, sizeof (struct Node), 0);
- if (pool == 0) die();
- / / organize into a linked list...
- struct Node* first = pool[0];
- for (i = 0; i < n-1; ++i)
- pool[i]->next = pool[i+1];
- free(pool); / / Can now free the array (or not, if it is needed later)
- return first;
- }
-*/
-#if __STD_C
-Void_t** public_iCALLOc(size_t, size_t, Void_t**);
-#else
-Void_t** public_iCALLOc();
-#endif
-
-/*
- independent_comalloc(size_t n_elements, size_t sizes[], Void_t* chunks[]);
-
- independent_comalloc allocates, all at once, a set of n_elements
- chunks with sizes indicated in the "sizes" array. It returns
- an array of pointers to these elements, each of which can be
- independently freed, realloc'ed etc. The elements are guaranteed to
- be adjacently allocated (this is not guaranteed to occur with
- multiple callocs or mallocs), which may also improve cache locality
- in some applications.
-
- The "chunks" argument is optional (i.e., may be null). If it is null
- the returned array is itself dynamically allocated and should also
- be freed when it is no longer needed. Otherwise, the chunks array
- must be of at least n_elements in length. It is filled in with the
- pointers to the chunks.
-
- In either case, independent_comalloc returns this pointer array, or
- null if the allocation failed. If n_elements is zero and chunks is
- null, it returns a chunk representing an array with zero elements
- (which should be freed if not wanted).
-
- Each element must be individually freed when it is no longer
- needed. If you'd like to instead be able to free all at once, you
- should instead use a single regular malloc, and assign pointers at
- particular offsets in the aggregate space. (In this case though, you
- cannot independently free elements.)
-
- independent_comallac differs from independent_calloc in that each
- element may have a different size, and also that it does not
- automatically clear elements.
-
- independent_comalloc can be used to speed up allocation in cases
- where several structs or objects must always be allocated at the
- same time. For example:
-
- struct Head { ... }
- struct Foot { ... }
-
- void send_message(char* msg) {
- int msglen = strlen(msg);
- size_t sizes[3] = { sizeof (struct Head), msglen, sizeof (struct Foot) };
- void* chunks[3];
- if (independent_comalloc(3, sizes, chunks) == 0)
- die();
- struct Head* head = (struct Head*)(chunks[0]);
- char* body = (char*)(chunks[1]);
- struct Foot* foot = (struct Foot*)(chunks[2]);
- / / ...
- }
-
- In general though, independent_comalloc is worth using only for
- larger values of n_elements. For small values, you probably won't
- detect enough difference from series of malloc calls to bother.
-
- Overuse of independent_comalloc can increase overall memory usage,
- since it cannot reuse existing noncontiguous small chunks that
- might be available for some of the elements.
-*/
-#if __STD_C
-Void_t** public_iCOMALLOc(size_t, size_t*, Void_t**);
-#else
-Void_t** public_iCOMALLOc();
-#endif
-
-
-/*
- pvalloc(size_t n);
- Equivalent to valloc(minimum-page-that-holds(n)), that is,
- round up n to nearest pagesize.
- */
-#if __STD_C
-Void_t* public_pVALLOc(size_t);
-#else
-Void_t* public_pVALLOc();
-#endif
-
-/*
- cfree(Void_t* p);
- Equivalent to free(p).
-
- cfree is needed/defined on some systems that pair it with calloc,
- for odd historical reasons (such as: cfree is used in example
- code in the first edition of K&R).
-*/
-#if __STD_C
-void public_cFREe(Void_t*);
-#else
-void public_cFREe();
-#endif
-
-/*
- malloc_trim(size_t pad);
-
- If possible, gives memory back to the system (via negative
- arguments to sbrk) if there is unused memory at the `high' end of
- the malloc pool. You can call this after freeing large blocks of
- memory to potentially reduce the system-level memory requirements
- of a program. However, it cannot guarantee to reduce memory. Under
- some allocation patterns, some large free blocks of memory will be
- locked between two used chunks, so they cannot be given back to
- the system.
-
- The `pad' argument to malloc_trim represents the amount of free
- trailing space to leave untrimmed. If this argument is zero,
- only the minimum amount of memory to maintain internal data
- structures will be left (one page or less). Non-zero arguments
- can be supplied to maintain enough trailing space to service
- future expected allocations without having to re-obtain memory
- from the system.
-
- Malloc_trim returns 1 if it actually released any memory, else 0.
- On systems that do not support "negative sbrks", it will always
- rreturn 0.
-*/
-#if __STD_C
-int public_mTRIm(size_t);
-#else
-int public_mTRIm();
-#endif
-
-/*
- malloc_usable_size(Void_t* p);
-
- Returns the number of bytes you can actually use in
- an allocated chunk, which may be more than you requested (although
- often not) due to alignment and minimum size constraints.
- You can use this many bytes without worrying about
- overwriting other allocated objects. This is not a particularly great
- programming practice. malloc_usable_size can be more useful in
- debugging and assertions, for example:
-
- p = malloc(n);
- assert(malloc_usable_size(p) >= 256);
-
-*/
-#if __STD_C
-size_t public_mUSABLe(Void_t*);
-#else
-size_t public_mUSABLe();
-#endif
-
-/*
- malloc_stats();
- Prints on stderr the amount of space obtained from the system (both
- via sbrk and mmap), the maximum amount (which may be more than
- current if malloc_trim and/or munmap got called), and the current
- number of bytes allocated via malloc (or realloc, etc) but not yet
- freed. Note that this is the number of bytes allocated, not the
- number requested. It will be larger than the number requested
- because of alignment and bookkeeping overhead. Because it includes
- alignment wastage as being in use, this figure may be greater than
- zero even when no user-level chunks are allocated.
-
- The reported current and maximum system memory can be inaccurate if
- a program makes other calls to system memory allocation functions
- (normally sbrk) outside of malloc.
-
- malloc_stats prints only the most commonly interesting statistics.
- More information can be obtained by calling mallinfo.
-
-*/
-#if __STD_C
-void public_mSTATs();
-#else
-void public_mSTATs();
-#endif
-
-/* mallopt tuning options */
-
-/*
- M_MXFAST is the maximum request size used for "fastbins", special bins
- that hold returned chunks without consolidating their spaces. This
- enables future requests for chunks of the same size to be handled
- very quickly, but can increase fragmentation, and thus increase the
- overall memory footprint of a program.
-
- This malloc manages fastbins very conservatively yet still
- efficiently, so fragmentation is rarely a problem for values less
- than or equal to the default. The maximum supported value of MXFAST
- is 80. You wouldn't want it any higher than this anyway. Fastbins
- are designed especially for use with many small structs, objects or
- strings -- the default handles structs/objects/arrays with sizes up
- to 16 4byte fields, or small strings representing words, tokens,
- etc. Using fastbins for larger objects normally worsens
- fragmentation without improving speed.
-
- M_MXFAST is set in REQUEST size units. It is internally used in
- chunksize units, which adds padding and alignment. You can reduce
- M_MXFAST to 0 to disable all use of fastbins. This causes the malloc
- algorithm to be a closer approximation of fifo-best-fit in all cases,
- not just for larger requests, but will generally cause it to be
- slower.
-*/
-
-
-/* M_MXFAST is a standard SVID/XPG tuning option, usually listed in malloc.h */
-#ifndef M_MXFAST
-# define M_MXFAST 1
-#endif
-
-#ifndef DEFAULT_MXFAST
-# define DEFAULT_MXFAST 64
-#endif
-
-
-/*
- M_TRIM_THRESHOLD is the maximum amount of unused top-most memory
- to keep before releasing via malloc_trim in free().
-
- Automatic trimming is mainly useful in long-lived programs.
- Because trimming via sbrk can be slow on some systems, and can
- sometimes be wasteful (in cases where programs immediately
- afterward allocate more large chunks) the value should be high
- enough so that your overall system performance would improve by
- releasing this much memory.
-
- The trim threshold and the mmap control parameters (see below)
- can be traded off with one another. Trimming and mmapping are
- two different ways of releasing unused memory back to the
- system. Between these two, it is often possible to keep
- system-level demands of a long-lived program down to a bare
- minimum. For example, in one test suite of sessions measuring
- the XF86 X server on Linux, using a trim threshold of 128K and a
- mmap threshold of 192K led to near-minimal long term resource
- consumption.
-
- If you are using this malloc in a long-lived program, it should
- pay to experiment with these values. As a rough guide, you
- might set to a value close to the average size of a process
- (program) running on your system. Releasing this much memory
- would allow such a process to run in memory. Generally, it's
- worth it to tune for trimming rather tham memory mapping when a
- program undergoes phases where several large chunks are
- allocated and released in ways that can reuse each other's
- storage, perhaps mixed with phases where there are no such
- chunks at all. And in well-behaved long-lived programs,
- controlling release of large blocks via trimming versus mapping
- is usually faster.
-
- However, in most programs, these parameters serve mainly as
- protection against the system-level effects of carrying around
- massive amounts of unneeded memory. Since frequent calls to
- sbrk, mmap, and munmap otherwise degrade performance, the default
- parameters are set to relatively high values that serve only as
- safeguards.
-
- The trim value must be greater than page size to have any useful
- effect. To disable trimming completely, you can set to
- (unsigned long)(-1)
-
- Trim settings interact with fastbin (MXFAST) settings: Unless
- TRIM_FASTBINS is defined, automatic trimming never takes place upon
- freeing a chunk with size less than or equal to MXFAST. Trimming is
- instead delayed until subsequent freeing of larger chunks. However,
- you can still force an attempted trim by calling malloc_trim.
-
- Also, trimming is not generally possible in cases where
- the main arena is obtained via mmap.
-
- Note that the trick some people use of mallocing a huge space and
- then freeing it at program startup, in an attempt to reserve system
- memory, doesn't have the intended effect under automatic trimming,
- since that memory will immediately be returned to the system.
-*/
-
-#define M_TRIM_THRESHOLD -1
-
-#ifndef DEFAULT_TRIM_THRESHOLD
-# define DEFAULT_TRIM_THRESHOLD (256 * 1024)
-#endif
-
-/*
- M_TOP_PAD is the amount of extra `padding' space to allocate or
- retain whenever sbrk is called. It is used in two ways internally:
-
- * When sbrk is called to extend the top of the arena to satisfy
- a new malloc request, this much padding is added to the sbrk
- request.
-
- * When malloc_trim is called automatically from free(),
- it is used as the `pad' argument.
-
- In both cases, the actual amount of padding is rounded
- so that the end of the arena is always a system page boundary.
-
- The main reason for using padding is to avoid calling sbrk so
- often. Having even a small pad greatly reduces the likelihood
- that nearly every malloc request during program start-up (or
- after trimming) will invoke sbrk, which needlessly wastes
- time.
-
- Automatic rounding-up to page-size units is normally sufficient
- to avoid measurable overhead, so the default is 0. However, in
- systems where sbrk is relatively slow, it can pay to increase
- this value, at the expense of carrying around more memory than
- the program needs.
-*/
-
-#define M_TOP_PAD -2
-
-#ifndef DEFAULT_TOP_PAD
-# define DEFAULT_TOP_PAD (0)
-#endif
-
-/*
- M_MMAP_THRESHOLD is the request size threshold for using mmap()
- to service a request. Requests of at least this size that cannot
- be allocated using already-existing space will be serviced via mmap.
- (If enough normal freed space already exists it is used instead.)
-
- Using mmap segregates relatively large chunks of memory so that
- they can be individually obtained and released from the host
- system. A request serviced through mmap is never reused by any
- other request (at least not directly; the system may just so
- happen to remap successive requests to the same locations).
-
- Segregating space in this way has the benefits that:
-
- 1. Mmapped space can ALWAYS be individually released back
- to the system, which helps keep the system level memory
- demands of a long-lived program low.
- 2. Mapped memory can never become `locked' between
- other chunks, as can happen with normally allocated chunks, which
- means that even trimming via malloc_trim would not release them.
- 3. On some systems with "holes" in address spaces, mmap can obtain
- memory that sbrk cannot.
-
- However, it has the disadvantages that:
-
- 1. The space cannot be reclaimed, consolidated, and then
- used to service later requests, as happens with normal chunks.
- 2. It can lead to more wastage because of mmap page alignment
- requirements
- 3. It causes malloc performance to be more dependent on host
- system memory management support routines which may vary in
- implementation quality and may impose arbitrary
- limitations. Generally, servicing a request via normal
- malloc steps is faster than going through a system's mmap.
-
- The advantages of mmap nearly always outweigh disadvantages for
- "large" chunks, but the value of "large" varies across systems. The
- default is an empirically derived value that works well in most
- systems.
-*/
-
-#define M_MMAP_THRESHOLD -3
-
-#ifndef DEFAULT_MMAP_THRESHOLD
-# define DEFAULT_MMAP_THRESHOLD (256 * 1024)
-#endif
-
-/*
- M_MMAP_MAX is the maximum number of requests to simultaneously
- service using mmap. This parameter exists because
-. Some systems have a limited number of internal tables for
- use by mmap, and using more than a few of them may degrade
- performance.
-
- The default is set to a value that serves only as a safeguard.
- Setting to 0 disables use of mmap for servicing large requests. If
- HAVE_MMAP is not set, the default value is 0, and attempts to set it
- to non-zero values in mallopt will fail.
-*/
-
-#define M_MMAP_MAX -4
-
-#ifndef DEFAULT_MMAP_MAX
-# if HAVE_MMAP
-# define DEFAULT_MMAP_MAX (65536)
-# else
-# define DEFAULT_MMAP_MAX (0)
-# endif
-#endif
-
-#ifdef __cplusplus
-}; /* end of extern "C" */
-#endif
-
-/*
- ========================================================================
- To make a fully customizable malloc.h header file, cut everything
- above this line, put into file malloc.h, edit to suit, and #include it
- on the next line, as well as in programs that use this malloc.
- ========================================================================
-*/
-
-/* #include "malloc.h" */
-
-/* --------------------- public wrappers ---------------------- */
-
-#ifdef USE_PUBLIC_MALLOC_WRAPPERS
-
-/* Declare all routines as internal */
-# if __STD_C
-static Void_t* mALLOc(size_t);
-static void fREe(Void_t*);
-static Void_t* rEALLOc(Void_t*, size_t);
-static Void_t* mEMALIGn(size_t, size_t);
-static Void_t* vALLOc(size_t);
-static Void_t* pVALLOc(size_t);
-static Void_t* cALLOc(size_t, size_t);
-static Void_t** iCALLOc(size_t, size_t, Void_t**);
-static Void_t** iCOMALLOc(size_t, size_t*, Void_t**);
-static void cFREe(Void_t*);
-static int mTRIm(size_t);
-static size_t mUSABLe(Void_t*);
-static void mSTATs();
-static int mALLOPt(int, int);
-static struct mallinfo mALLINFo(void);
-# else
-static Void_t* mALLOc();
-static void fREe();
-static Void_t* rEALLOc();
-static Void_t* mEMALIGn();
-static Void_t* vALLOc();
-static Void_t* pVALLOc();
-static Void_t* cALLOc();
-static Void_t** iCALLOc();
-static Void_t** iCOMALLOc();
-static void cFREe();
-static int mTRIm();
-static size_t mUSABLe();
-static void mSTATs();
-static int mALLOPt();
-static struct mallinfo mALLINFo();
-# endif
-
-/*
- MALLOC_PREACTION and MALLOC_POSTACTION should be
- defined to return 0 on success, and nonzero on failure.
- The return value of MALLOC_POSTACTION is currently ignored
- in wrapper functions since there is no reasonable default
- action to take on failure.
-*/
-
-
-# ifdef USE_MALLOC_LOCK
-
-# ifdef WIN32
-
-static int mALLOC_MUTEx;
-# define MALLOC_PREACTION slwait(&mALLOC_MUTEx)
-# define MALLOC_POSTACTION slrelease(&mALLOC_MUTEx)
-
-# else
-
-# include <pthread.h>
-
-static pthread_mutex_t mALLOC_MUTEx = PTHREAD_MUTEX_INITIALIZER;
-
-# define MALLOC_PREACTION pthread_mutex_lock(&mALLOC_MUTEx)
-# define MALLOC_POSTACTION pthread_mutex_unlock(&mALLOC_MUTEx)
-
-# endif /* USE_MALLOC_LOCK */
-
-# else
-
-/* Substitute anything you like for these */
-
-# define MALLOC_PREACTION (0)
-# define MALLOC_POSTACTION (0)
-
-# endif
-
-Void_t* public_mALLOc(size_t bytes) {
- Void_t* m;
- if (MALLOC_PREACTION != 0) {
- return 0;
- }
- m = mALLOc(bytes);
- if (MALLOC_POSTACTION != 0) {
- }
- return m;
-}
-
-void public_fREe(Void_t* m) {
- if (MALLOC_PREACTION != 0) {
- return;
- }
- fREe(m);
- if (MALLOC_POSTACTION != 0) {
- }
-}
-
-Void_t* public_rEALLOc(Void_t* m, size_t bytes) {
- if (MALLOC_PREACTION != 0) {
- return 0;
- }
- m = rEALLOc(m, bytes);
- if (MALLOC_POSTACTION != 0) {
- }
- return m;
-}
-
-Void_t* public_mEMALIGn(size_t alignment, size_t bytes) {
- Void_t* m;
- if (MALLOC_PREACTION != 0) {
- return 0;
- }
- m = mEMALIGn(alignment, bytes);
- if (MALLOC_POSTACTION != 0) {
- }
- return m;
-}
-
-Void_t* public_vALLOc(size_t bytes) {
- Void_t* m;
- if (MALLOC_PREACTION != 0) {
- return 0;
- }
- m = vALLOc(bytes);
- if (MALLOC_POSTACTION != 0) {
- }
- return m;
-}
-
-Void_t* public_pVALLOc(size_t bytes) {
- Void_t* m;
- if (MALLOC_PREACTION != 0) {
- return 0;
- }
- m = pVALLOc(bytes);
- if (MALLOC_POSTACTION != 0) {
- }
- return m;
-}
-
-Void_t* public_cALLOc(size_t n, size_t elem_size) {
- Void_t* m;
- if (MALLOC_PREACTION != 0) {
- return 0;
- }
- m = cALLOc(n, elem_size);
- if (MALLOC_POSTACTION != 0) {
- }
- return m;
-}
-
-
-Void_t** public_iCALLOc(size_t n, size_t elem_size, Void_t** chunks) {
- Void_t** m;
- if (MALLOC_PREACTION != 0) {
- return 0;
- }
- m = iCALLOc(n, elem_size, chunks);
- if (MALLOC_POSTACTION != 0) {
- }
- return m;
-}
-
-Void_t** public_iCOMALLOc(size_t n, size_t sizes[], Void_t** chunks) {
- Void_t** m;
- if (MALLOC_PREACTION != 0) {
- return 0;
- }
- m = iCOMALLOc(n, sizes, chunks);
- if (MALLOC_POSTACTION != 0) {
- }
- return m;
-}
-
-void public_cFREe(Void_t* m) {
- if (MALLOC_PREACTION != 0) {
- return;
- }
- cFREe(m);
- if (MALLOC_POSTACTION != 0) {
- }
-}
-
-int public_mTRIm(size_t s) {
- int result;
- if (MALLOC_PREACTION != 0) {
- return 0;
- }
- result = mTRIm(s);
- if (MALLOC_POSTACTION != 0) {
- }
- return result;
-}
-
-size_t public_mUSABLe(Void_t* m) {
- size_t result;
- if (MALLOC_PREACTION != 0) {
- return 0;
- }
- result = mUSABLe(m);
- if (MALLOC_POSTACTION != 0) {
- }
- return result;
-}
-
-void public_mSTATs() {
- if (MALLOC_PREACTION != 0) {
- return;
- }
- mSTATs();
- if (MALLOC_POSTACTION != 0) {
- }
-}
-
-struct mallinfo public_mALLINFo() {
- struct mallinfo m;
- if (MALLOC_PREACTION != 0) {
- struct mallinfo nm = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 };
- return nm;
- }
- m = mALLINFo();
- if (MALLOC_POSTACTION != 0) {
- }
- return m;
-}
-
-int public_mALLOPt(int p, int v) {
- int result;
- if (MALLOC_PREACTION != 0) {
- return 0;
- }
- result = mALLOPt(p, v);
- if (MALLOC_POSTACTION != 0) {
- }
- return result;
-}
-
-#endif
-
-
-
-/* ------------- Optional versions of memcopy ---------------- */
-
-
-#if USE_MEMCPY
-
-/*
- Note: memcpy is ONLY invoked with non-overlapping regions,
- so the (usually slower) memmove is not needed.
-*/
-
-# define MALLOC_COPY(dest, src, nbytes) memcpy(dest, src, nbytes)
-# define MALLOC_ZERO(dest, nbytes) memset(dest, 0, nbytes)
-
-#else /* !USE_MEMCPY */
-
-/* Use Duff's device for good zeroing/copying performance. */
-
-# define MALLOC_ZERO(charp, nbytes) \
-do { \
- INTERNAL_SIZE_T* mzp = (INTERNAL_SIZE_T*)(charp); \
- CHUNK_SIZE_T mctmp = (nbytes)/sizeof (INTERNAL_SIZE_T); \
- long mcn; \
- if (mctmp < 8) mcn = 0; else { mcn = (mctmp-1)/8; mctmp %= 8; } \
- switch (mctmp) { \
- case 0: for (;;) { *mzp++ = 0; \
- case 7: *mzp++ = 0; \
- case 6: *mzp++ = 0; \
- case 5: *mzp++ = 0; \
- case 4: *mzp++ = 0; \
- case 3: *mzp++ = 0; \
- case 2: *mzp++ = 0; \
- case 1: *mzp++ = 0; if (mcn <= 0) break; mcn--; } \
- } \
-} while (0)
-
-# define MALLOC_COPY(dest,src,nbytes) \
-do { \
- INTERNAL_SIZE_T* mcsrc = (INTERNAL_SIZE_T*) src; \
- INTERNAL_SIZE_T* mcdst = (INTERNAL_SIZE_T*) dest; \
- CHUNK_SIZE_T mctmp = (nbytes)/sizeof (INTERNAL_SIZE_T); \
- long mcn; \
- if (mctmp < 8) mcn = 0; else { mcn = (mctmp-1)/8; mctmp %= 8; } \
- switch (mctmp) { \
- case 0: for (;;) { *mcdst++ = *mcsrc++; \
- case 7: *mcdst++ = *mcsrc++; \
- case 6: *mcdst++ = *mcsrc++; \
- case 5: *mcdst++ = *mcsrc++; \
- case 4: *mcdst++ = *mcsrc++; \
- case 3: *mcdst++ = *mcsrc++; \
- case 2: *mcdst++ = *mcsrc++; \
- case 1: *mcdst++ = *mcsrc++; if (mcn <= 0) break; mcn--; } \
- } \
-} while (0)
-
-#endif
-
-/* ------------------ MMAP support ------------------ */
-
-
-#if HAVE_MMAP
-
-# ifndef LACKS_FCNTL_H
-# include <fcntl.h>
-# endif
-
-# ifndef LACKS_SYS_MMAN_H
-# include <sys/mman.h>
-# endif
-
-# if !defined(MAP_ANONYMOUS) && defined(MAP_ANON)
-# define MAP_ANONYMOUS MAP_ANON
-# endif
-
-/*
- Nearly all versions of mmap support MAP_ANONYMOUS,
- so the following is unlikely to be needed, but is
- supplied just in case.
-*/
-
-# ifndef MAP_ANONYMOUS
-
-static int dev_zero_fd = -1; /* Cached file descriptor for /dev/zero. */
-
-# define MMAP(addr, size, prot, flags) ((dev_zero_fd < 0) ? \
- (dev_zero_fd = open("/dev/zero", O_RDWR), \
- mmap((addr), (size), (prot), (flags), dev_zero_fd, 0)) : \
- mmap((addr), (size), (prot), (flags), dev_zero_fd, 0))
-
-# else
-
-# define MMAP(addr, size, prot, flags) \
- (mmap((addr), (size), (prot), (flags)|MAP_ANONYMOUS, -1, 0))
-
-# endif
-
-
-#endif /* HAVE_MMAP */
-
-
-/*
- ----------------------- Chunk representations -----------------------
-*/
-
-
-/*
- This struct declaration is misleading (but accurate and necessary).
- It declares a "view" into memory allowing access to necessary
- fields at known offsets from a given base. See explanation below.
-*/
-
-struct malloc_chunk {
-
- INTERNAL_SIZE_T prev_size; /* Size of previous chunk (if free). */
- INTERNAL_SIZE_T size; /* Size in bytes, including overhead. */
-
- struct malloc_chunk* fd; /* double links -- used only if free. */
- struct malloc_chunk* bk;
-};
-
-
-typedef struct malloc_chunk* mchunkptr;
-
-/*
- malloc_chunk details:
-
- (The following includes lightly edited explanations by Colin Plumb.)
-
- Chunks of memory are maintained using a `boundary tag' method as
- described in e.g., Knuth or Standish. (See the paper by Paul
- Wilson ftp://ftp.cs.utexas.edu/pub/garbage/allocsrv.ps for a
- survey of such techniques.) Sizes of free chunks are stored both
- in the front of each chunk and at the end. This makes
- consolidating fragmented chunks into bigger chunks very fast. The
- size fields also hold bits representing whether chunks are free or
- in use.
-
- An allocated chunk looks like this:
-
-
- chunk-> +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
- | Size of previous chunk, if allocated | |
- +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
- | Size of chunk, in bytes |P|
- mem-> +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
- | User data starts here... .
- . .
- . (malloc_usable_space() bytes) .
- . |
-nextchunk-> +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
- | Size of chunk |
- +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
-
-
- Where "chunk" is the front of the chunk for the purpose of most of
- the malloc code, but "mem" is the pointer that is returned to the
- user. "Nextchunk" is the beginning of the next contiguous chunk.
-
- Chunks always begin on even word boundaries, so the mem portion
- (which is returned to the user) is also on an even word boundary, and
- thus at least double-word aligned.
-
- Free chunks are stored in circular doubly-linked lists, and look like this:
-
- chunk-> +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
- | Size of previous chunk |
- +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
- `head:' | Size of chunk, in bytes |P|
- mem-> +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
- | Forward pointer to next chunk in list |
- +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
- | Back pointer to previous chunk in list |
- +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
- | Unused space (may be 0 bytes long) .
- . .
- . |
-nextchunk-> +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
- `foot:' | Size of chunk, in bytes |
- +-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
-
- The P (PREV_INUSE) bit, stored in the unused low-order bit of the
- chunk size (which is always a multiple of two words), is an in-use
- bit for the *previous* chunk. If that bit is *clear*, then the
- word before the current chunk size contains the previous chunk
- size, and can be used to find the front of the previous chunk.
- The very first chunk allocated always has this bit set,
- preventing access to non-existent (or non-owned) memory. If
- prev_inuse is set for any given chunk, then you CANNOT determine
- the size of the previous chunk, and might even get a memory
- addressing fault when trying to do so.
-
- Note that the `foot' of the current chunk is actually represented
- as the prev_size of the NEXT chunk. This makes it easier to
- deal with alignments etc but can be very confusing when trying
- to extend or adapt this code.
-
- The two exceptions to all this are
-
- 1. The special chunk `top' doesn't bother using the
- trailing size field since there is no next contiguous chunk
- that would have to index off it. After initialization, `top'
- is forced to always exist. If it would become less than
- MINSIZE bytes long, it is replenished.
-
- 2. Chunks allocated via mmap, which have the second-lowest-order
- bit (IS_MMAPPED) set in their size fields. Because they are
- allocated one-by-one, each must contain its own trailing size field.
-
-*/
-
-/*
- ---------- Size and alignment checks and conversions ----------
-*/
-
-/* conversion from malloc headers to user pointers, and back */
-
-#define chunk2mem(p) ((Void_t*)((char*)(p) + 2*SIZE_SZ))
-#define mem2chunk(mem) ((mchunkptr)((char*)(mem) - 2*SIZE_SZ))
-
-/* The smallest possible chunk */
-#define MIN_CHUNK_SIZE (sizeof (struct malloc_chunk))
-
-/* The smallest size we can malloc is an aligned minimal chunk */
-
-#define MINSIZE \
- (CHUNK_SIZE_T)(((MIN_CHUNK_SIZE+MALLOC_ALIGN_MASK) & ~MALLOC_ALIGN_MASK))
-
-/* Check if m has acceptable alignment */
-
-#define aligned_OK(m) (((PTR_UINT)((m)) & (MALLOC_ALIGN_MASK)) == 0)
-
-
-/*
- Check if a request is so large that it would wrap around zero when
- padded and aligned. To simplify some other code, the bound is made
- low enough so that adding MINSIZE will also not wrap around sero.
-*/
-
-#define REQUEST_OUT_OF_RANGE(req) \
- ((CHUNK_SIZE_T)(req) >= \
- (CHUNK_SIZE_T)(INTERNAL_SIZE_T)(-2 * MINSIZE))
-
-/* pad request bytes into a usable size -- internal version */
-
-#define request2size(req) \
- (((req) + SIZE_SZ + MALLOC_ALIGN_MASK < MINSIZE) ? \
- MINSIZE : \
- ((req) + SIZE_SZ + MALLOC_ALIGN_MASK) & ~MALLOC_ALIGN_MASK)
-
-/* Same, except also perform argument check */
-
-#define checked_request2size(req, sz) \
- if (REQUEST_OUT_OF_RANGE(req)) { \
- MALLOC_FAILURE_ACTION; \
- return 0; \
- } \
- (sz) = request2size(req);
-
-/*
- --------------- Physical chunk operations ---------------
-*/
-
-
-/* size field is or'ed with PREV_INUSE when previous adjacent chunk in use */
-#define PREV_INUSE 0x1
-
-/* extract inuse bit of previous chunk */
-#define prev_inuse(p) ((p)->size & PREV_INUSE)
-
-
-/* size field is or'ed with IS_MMAPPED if the chunk was obtained with mmap() */
-#define IS_MMAPPED 0x2
-
-/* check for mmap()'ed chunk */
-#define chunk_is_mmapped(p) ((p)->size & IS_MMAPPED)
-
-/*
- Bits to mask off when extracting size
-
- Note: IS_MMAPPED is intentionally not masked off from size field in
- macros for which mmapped chunks should never be seen. This should
- cause helpful core dumps to occur if it is tried by accident by
- people extending or adapting this malloc.
-*/
-#define SIZE_BITS (PREV_INUSE|IS_MMAPPED)
-
-/* Get size, ignoring use bits */
-#define chunksize(p) ((p)->size & ~(SIZE_BITS))
-
-
-/* Ptr to next physical malloc_chunk. */
-#define next_chunk(p) ((mchunkptr)(((char*)(p)) + ((p)->size & ~PREV_INUSE)))
-
-/* Ptr to previous physical malloc_chunk */
-#define prev_chunk(p) ((mchunkptr)(((char*)(p)) - ((p)->prev_size)))
-
-/* Treat space at ptr + offset as a chunk */
-#define chunk_at_offset(p, s) ((mchunkptr)(((char*)(p)) + (s)))
-
-/* extract p's inuse bit */
-#define inuse(p)\
-((((mchunkptr)(((char*)(p))+((p)->size & ~PREV_INUSE)))->size) & PREV_INUSE)
-
-/* set/clear chunk as being inuse without otherwise disturbing */
-#define set_inuse(p)\
-((mchunkptr)(((char*)(p)) + ((p)->size & ~PREV_INUSE)))->size |= PREV_INUSE
-
-#define clear_inuse(p)\
-((mchunkptr)(((char*)(p)) + ((p)->size & ~PREV_INUSE)))->size &= ~(PREV_INUSE)
-
-
-/* check/set/clear inuse bits in known places */
-#define inuse_bit_at_offset(p, s)\
- (((mchunkptr)(((char*)(p)) + (s)))->size & PREV_INUSE)
-
-#define set_inuse_bit_at_offset(p, s)\
- (((mchunkptr)(((char*)(p)) + (s)))->size |= PREV_INUSE)
-
-#define clear_inuse_bit_at_offset(p, s)\
- (((mchunkptr)(((char*)(p)) + (s)))->size &= ~(PREV_INUSE))
-
-
-/* Set size at head, without disturbing its use bit */
-#define set_head_size(p, s) ((p)->size = (((p)->size & PREV_INUSE) | (s)))
-
-/* Set size/use field */
-#define set_head(p, s) ((p)->size = (s))
-
-/* Set size at footer (only when chunk is not in use) */
-#define set_foot(p, s) (((mchunkptr)((char*)(p) + (s)))->prev_size = (s))
-
-
-/*
- -------------------- Internal data structures --------------------
-
- All internal state is held in an instance of malloc_state defined
- below. There are no other static variables, except in two optional
- cases:
- * If USE_MALLOC_LOCK is defined, the mALLOC_MUTEx declared above.
- * If HAVE_MMAP is true, but mmap doesn't support
- MAP_ANONYMOUS, a dummy file descriptor for mmap.
-
- Beware of lots of tricks that minimize the total bookkeeping space
- requirements. The result is a little over 1K bytes (for 4byte
- pointers and size_t.)
-*/
-
-/*
- Bins
-
- An array of bin headers for free chunks. Each bin is doubly
- linked. The bins are approximately proportionally (log) spaced.
- There are a lot of these bins (128). This may look excessive, but
- works very well in practice. Most bins hold sizes that are
- unusual as malloc request sizes, but are more usual for fragments
- and consolidated sets of chunks, which is what these bins hold, so
- they can be found quickly. All procedures maintain the invariant
- that no consolidated chunk physically borders another one, so each
- chunk in a list is known to be preceded and followed by either
- inuse chunks or the ends of memory.
-
- Chunks in bins are kept in size order, with ties going to the
- approximately least recently used chunk. Ordering isn't needed
- for the small bins, which all contain the same-sized chunks, but
- facilitates best-fit allocation for larger chunks. These lists
- are just sequential. Keeping them in order almost never requires
- enough traversal to warrant using fancier ordered data
- structures.
-
- Chunks of the same size are linked with the most
- recently freed at the front, and allocations are taken from the
- back. This results in LRU (FIFO) allocation order, which tends
- to give each chunk an equal opportunity to be consolidated with
- adjacent freed chunks, resulting in larger free chunks and less
- fragmentation.
-
- To simplify use in double-linked lists, each bin header acts
- as a malloc_chunk. This avoids special-casing for headers.
- But to conserve space and improve locality, we allocate
- only the fd/bk pointers of bins, and then use repositioning tricks
- to treat these as the fields of a malloc_chunk*.
-*/
-
-typedef struct malloc_chunk* mbinptr;
-
-/* addressing -- note that bin_at(0) does not exist */
-#define bin_at(m, i) ((mbinptr)((char*)&((m)->bins[(i)<<1]) - (SIZE_SZ<<1)))
-
-/* analog of ++bin */
-#define next_bin(b) ((mbinptr)((char*)(b) + (sizeof (mchunkptr)<<1)))
-
-/* Reminders about list directionality within bins */
-#define first(b) ((b)->fd)
-#define last(b) ((b)->bk)
-
-/* Take a chunk off a bin list */
-#define unlink(P, BK, FD) { \
- FD = P->fd; \
- BK = P->bk; \
- FD->bk = BK; \
- BK->fd = FD; \
-}
-
-/*
- Indexing
-
- Bins for sizes < 512 bytes contain chunks of all the same size, spaced
- 8 bytes apart. Larger bins are approximately logarithmically spaced:
-
- 64 bins of size 8
- 32 bins of size 64
- 16 bins of size 512
- 8 bins of size 4096
- 4 bins of size 32768
- 2 bins of size 262144
- 1 bin of size what's left
-
- The bins top out around 1MB because we expect to service large
- requests via mmap.
-*/
-
-#define NBINS 96
-#define NSMALLBINS 32
-#define SMALLBIN_WIDTH 8
-#define MIN_LARGE_SIZE 256
-
-#define in_smallbin_range(sz) \
- ((CHUNK_SIZE_T)(sz) < (CHUNK_SIZE_T)MIN_LARGE_SIZE)
-
-#define smallbin_index(sz) (((unsigned)(sz)) >> 3)
-
-/*
- Compute index for size. We expect this to be inlined when
- compiled with optimization, else not, which works out well.
-*/
-static int largebin_index(unsigned int sz) {
- unsigned int x = sz >> SMALLBIN_WIDTH;
- unsigned int m; /* bit position of highest set bit of m */
-
- if (x >= 0x10000) return NBINS-1;
-
- /* On intel, use BSRL instruction to find highest bit */
-#if defined(__GNUC__) && defined(i386)
-
- __asm__("bsrl %1,%0\n\t"
- : "=r" (m)
- : "g" (x));
-
-#else
- {
- /*
- Based on branch-free nlz algorithm in chapter 5 of Henry
- S. Warren Jr's book "Hacker's Delight".
- */
-
- unsigned int n = ((x - 0x100) >> 16) & 8;
- x <<= n;
- m = ((x - 0x1000) >> 16) & 4;
- n += m;
- x <<= m;
- m = ((x - 0x4000) >> 16) & 2;
- n += m;
- x = (x << m) >> 14;
- m = 13 - n + (x & ~(x>>1));
- }
-#endif
-
- /* Use next 2 bits to create finer-granularity bins */
- return NSMALLBINS + (m << 2) + ((sz >> (m + 6)) & 3);
-}
-
-#define bin_index(sz) \
- ((in_smallbin_range(sz)) ? smallbin_index(sz) : largebin_index(sz))
-
-/*
- FIRST_SORTED_BIN_SIZE is the chunk size corresponding to the
- first bin that is maintained in sorted order. This must
- be the smallest size corresponding to a given bin.
-
- Normally, this should be MIN_LARGE_SIZE. But you can weaken
- best fit guarantees to sometimes speed up malloc by increasing value.
- Doing this means that malloc may choose a chunk that is
- non-best-fitting by up to the width of the bin.
-
- Some useful cutoff values:
- 512 - all bins sorted
- 2560 - leaves bins <= 64 bytes wide unsorted
- 12288 - leaves bins <= 512 bytes wide unsorted
- 65536 - leaves bins <= 4096 bytes wide unsorted
- 262144 - leaves bins <= 32768 bytes wide unsorted
- -1 - no bins sorted (not recommended!)
-*/
-
-#define FIRST_SORTED_BIN_SIZE MIN_LARGE_SIZE
-/* #define FIRST_SORTED_BIN_SIZE 65536 */
-
-/*
- Unsorted chunks
-
- All remainders from chunk splits, as well as all returned chunks,
- are first placed in the "unsorted" bin. They are then placed
- in regular bins after malloc gives them ONE chance to be used before
- binning. So, basically, the unsorted_chunks list acts as a queue,
- with chunks being placed on it in free (and malloc_consolidate),
- and taken off (to be either used or placed in bins) in malloc.
-*/
-
-/* The otherwise unindexable 1-bin is used to hold unsorted chunks. */
-#define unsorted_chunks(M) (bin_at(M, 1))
-
-/*
- Top
-
- The top-most available chunk (i.e., the one bordering the end of
- available memory) is treated specially. It is never included in
- any bin, is used only if no other chunk is available, and is
- released back to the system if it is very large (see
- M_TRIM_THRESHOLD). Because top initially
- points to its own bin with initial zero size, thus forcing
- extension on the first malloc request, we avoid having any special
- code in malloc to check whether it even exists yet. But we still
- need to do so when getting memory from system, so we make
- initial_top treat the bin as a legal but unusable chunk during the
- interval between initialization and the first call to
- sYSMALLOc. (This is somewhat delicate, since it relies on
- the 2 preceding words to be zero during this interval as well.)
-*/
-
-/* Conveniently, the unsorted bin can be used as dummy top on first call */
-#define initial_top(M) (unsorted_chunks(M))
-
-/*
- Binmap
-
- To help compensate for the large number of bins, a one-level index
- structure is used for bin-by-bin searching. `binmap' is a
- bitvector recording whether bins are definitely empty so they can
- be skipped over during during traversals. The bits are NOT always
- cleared as soon as bins are empty, but instead only
- when they are noticed to be empty during traversal in malloc.
-*/
-
-/* Conservatively use 32 bits per map word, even if on 64bit system */
-#define BINMAPSHIFT 5
-#define BITSPERMAP (1U << BINMAPSHIFT)
-#define BINMAPSIZE (NBINS / BITSPERMAP)
-
-#define idx2block(i) ((i) >> BINMAPSHIFT)
-#define idx2bit(i) ((1U << ((i) & ((1U << BINMAPSHIFT)-1))))
-
-#define mark_bin(m,i) ((m)->binmap[idx2block(i)] |= idx2bit(i))
-#define unmark_bin(m,i) ((m)->binmap[idx2block(i)] &= ~(idx2bit(i)))
-#define get_binmap(m,i) ((m)->binmap[idx2block(i)] & idx2bit(i))
-
-/*
- Fastbins
-
- An array of lists holding recently freed small chunks. Fastbins
- are not doubly linked. It is faster to single-link them, and
- since chunks are never removed from the middles of these lists,
- double linking is not necessary. Also, unlike regular bins, they
- are not even processed in FIFO order (they use faster LIFO) since
- ordering doesn't much matter in the transient contexts in which
- fastbins are normally used.
-
- Chunks in fastbins keep their inuse bit set, so they cannot
- be consolidated with other free chunks. malloc_consolidate
- releases all chunks in fastbins and consolidates them with
- other free chunks.
-*/
-
-typedef struct malloc_chunk* mfastbinptr;
-
-/* offset 2 to use otherwise unindexable first 2 bins */
-#define fastbin_index(sz) ((((unsigned int)(sz)) >> 3) - 2)
-
-/* The maximum fastbin request size we support */
-#define MAX_FAST_SIZE 80
-
-#define NFASTBINS (fastbin_index(request2size(MAX_FAST_SIZE))+1)
-
-/*
- FASTBIN_CONSOLIDATION_THRESHOLD is the size of a chunk in free()
- that triggers automatic consolidation of possibly-surrounding
- fastbin chunks. This is a heuristic, so the exact value should not
- matter too much. It is defined at half the default trim threshold as a
- compromise heuristic to only attempt consolidation if it is likely
- to lead to trimming. However, it is not dynamically tunable, since
- consolidation reduces fragmentation surrounding loarge chunks even
- if trimming is not used.
-*/
-
-#define FASTBIN_CONSOLIDATION_THRESHOLD \
- ((unsigned long)(DEFAULT_TRIM_THRESHOLD) >> 1)
-
-/*
- Since the lowest 2 bits in max_fast don't matter in size comparisons,
- they are used as flags.
-*/
-
-/*
- ANYCHUNKS_BIT held in max_fast indicates that there may be any
- freed chunks at all. It is set true when entering a chunk into any
- bin.
-*/
-
-#define ANYCHUNKS_BIT (1U)
-
-#define have_anychunks(M) (((M)->max_fast & ANYCHUNKS_BIT))
-#define set_anychunks(M) ((M)->max_fast |= ANYCHUNKS_BIT)
-#define clear_anychunks(M) ((M)->max_fast &= ~ANYCHUNKS_BIT)
-
-/*
- FASTCHUNKS_BIT held in max_fast indicates that there are probably
- some fastbin chunks. It is set true on entering a chunk into any
- fastbin, and cleared only in malloc_consolidate.
-*/
-
-#define FASTCHUNKS_BIT (2U)
-
-#define have_fastchunks(M) (((M)->max_fast & FASTCHUNKS_BIT))
-#define set_fastchunks(M) ((M)->max_fast |= (FASTCHUNKS_BIT|ANYCHUNKS_BIT))
-#define clear_fastchunks(M) ((M)->max_fast &= ~(FASTCHUNKS_BIT))
-
-/*
- Set value of max_fast.
- Use impossibly small value if 0.
-*/
-
-#define set_max_fast(M, s) \
- (M)->max_fast = (((s) == 0)? SMALLBIN_WIDTH: request2size(s)) | \
- ((M)->max_fast & (FASTCHUNKS_BIT|ANYCHUNKS_BIT))
-
-#define get_max_fast(M) \
- ((M)->max_fast & ~(FASTCHUNKS_BIT | ANYCHUNKS_BIT))
-
-
-/*
- morecore_properties is a status word holding dynamically discovered
- or controlled properties of the morecore function
-*/
-
-#define MORECORE_CONTIGUOUS_BIT (1U)
-
-#define contiguous(M) \
- (((M)->morecore_properties & MORECORE_CONTIGUOUS_BIT))
-#define noncontiguous(M) \
- (((M)->morecore_properties & MORECORE_CONTIGUOUS_BIT) == 0)
-#define set_contiguous(M) \
- ((M)->morecore_properties |= MORECORE_CONTIGUOUS_BIT)
-#define set_noncontiguous(M) \
- ((M)->morecore_properties &= ~MORECORE_CONTIGUOUS_BIT)
-
-
-/*
- ----------- Internal state representation and initialization -----------
-*/
-
-struct malloc_state {
-
- /* The maximum chunk size to be eligible for fastbin */
- INTERNAL_SIZE_T max_fast; /* low 2 bits used as flags */
-
- /* Fastbins */
- mfastbinptr fastbins[NFASTBINS];
-
- /* Base of the topmost chunk -- not otherwise kept in a bin */
- mchunkptr top;
-
- /* The remainder from the most recent split of a small request */
- mchunkptr last_remainder;
-
- /* Normal bins packed as described above */
- mchunkptr bins[NBINS * 2];
-
- /* Bitmap of bins. Trailing zero map handles cases of largest binned size */
- unsigned int binmap[BINMAPSIZE+1];
-
- /* Tunable parameters */
- CHUNK_SIZE_T trim_threshold;
- INTERNAL_SIZE_T top_pad;
- INTERNAL_SIZE_T mmap_threshold;
-
- /* Memory map support */
- int n_mmaps;
- int n_mmaps_max;
- int max_n_mmaps;
-
- /* Cache malloc_getpagesize */
- unsigned int pagesize;
-
- /* Track properties of MORECORE */
- unsigned int morecore_properties;
-
- /* Statistics */
- INTERNAL_SIZE_T mmapped_mem;
- INTERNAL_SIZE_T sbrked_mem;
- INTERNAL_SIZE_T max_sbrked_mem;
- INTERNAL_SIZE_T max_mmapped_mem;
- INTERNAL_SIZE_T max_total_mem;
-};
-
-typedef struct malloc_state *mstate;
-
-/*
- There is exactly one instance of this struct in this malloc.
- If you are adapting this malloc in a way that does NOT use a static
- malloc_state, you MUST explicitly zero-fill it before using. This
- malloc relies on the property that malloc_state is initialized to
- all zeroes (as is true of C statics).
-*/
-
-static struct malloc_state av_; /* never directly referenced */
-
-/*
- All uses of av_ are via get_malloc_state().
- At most one "call" to get_malloc_state is made per invocation of
- the public versions of malloc and free, but other routines
- that in turn invoke malloc and/or free may call more then once.
- Also, it is called in check* routines if DEBUG is set.
-*/
-
-#define get_malloc_state() (&(av_))
-
-/*
- Initialize a malloc_state struct.
-
- This is called only from within malloc_consolidate, which needs
- be called in the same contexts anyway. It is never called directly
- outside of malloc_consolidate because some optimizing compilers try
- to inline it at all call points, which turns out not to be an
- optimization at all. (Inlining it in malloc_consolidate is fine though.)
-*/
-
-#if __STD_C
-static void malloc_init_state(mstate av)
-#else
-static void malloc_init_state(av) mstate av;
-#endif
-{
- int i;
- mbinptr bin;
-
- /* Establish circular links for normal bins */
- for (i = 1; i < NBINS; ++i) {
- bin = bin_at(av,i);
- bin->fd = bin->bk = bin;
- }
-
- av->top_pad = DEFAULT_TOP_PAD;
- av->n_mmaps_max = DEFAULT_MMAP_MAX;
- av->mmap_threshold = DEFAULT_MMAP_THRESHOLD;
- av->trim_threshold = DEFAULT_TRIM_THRESHOLD;
-
-#if MORECORE_CONTIGUOUS
- set_contiguous(av);
-#else
- set_noncontiguous(av);
-#endif
-
-
- set_max_fast(av, DEFAULT_MXFAST);
-
- av->top = initial_top(av);
- av->pagesize = malloc_getpagesize;
-}
-
-/*
- Other internal utilities operating on mstates
-*/
-
-#if __STD_C
-static Void_t* sYSMALLOc(INTERNAL_SIZE_T, mstate);
-static int sYSTRIm(size_t, mstate);
-static void malloc_consolidate(mstate);
-static Void_t** iALLOc(size_t, size_t*, int, Void_t**);
-#else
-static Void_t* sYSMALLOc();
-static int sYSTRIm();
-static void malloc_consolidate();
-static Void_t** iALLOc();
-#endif
-
-/*
- Debugging support
-
- These routines make a number of assertions about the states
- of data structures that should be true at all times. If any
- are not true, it's very likely that a user program has somehow
- trashed memory. (It's also possible that there is a coding error
- in malloc. In which case, please report it!)
-*/
-
-#if ! DEBUG
-
-# define check_chunk(P)
-# define check_free_chunk(P)
-# define check_inuse_chunk(P)
-# define check_remalloced_chunk(P,N)
-# define check_malloced_chunk(P,N)
-# define check_malloc_state()
-
-#else
-# define check_chunk(P) do_check_chunk(P)
-# define check_free_chunk(P) do_check_free_chunk(P)
-# define check_inuse_chunk(P) do_check_inuse_chunk(P)
-# define check_remalloced_chunk(P,N) do_check_remalloced_chunk(P,N)
-# define check_malloced_chunk(P,N) do_check_malloced_chunk(P,N)
-# define check_malloc_state() do_check_malloc_state()
-
-/*
- Properties of all chunks
-*/
-
-# if __STD_C
-static void do_check_chunk(mchunkptr p)
-# else
-static void do_check_chunk(p) mchunkptr p;
-# endif
-{
- mstate av = get_malloc_state();
- CHUNK_SIZE_T sz = chunksize(p);
- /* min and max possible addresses assuming contiguous allocation */
- char* max_address = (char*)(av->top) + chunksize(av->top);
- char* min_address = max_address - av->sbrked_mem;
-
- if (!chunk_is_mmapped(p)) {
-
- /* Has legal address ... */
- if (p != av->top) {
- if (contiguous(av)) {
- assert(((char*)p) >= min_address);
- assert(((char*)p + sz) <= ((char*)(av->top)));
- }
- }
- else {
- /* top size is always at least MINSIZE */
- assert((CHUNK_SIZE_T)(sz) >= MINSIZE);
- /* top predecessor always marked inuse */
- assert(prev_inuse(p));
- }
-
- }
- else {
-# if HAVE_MMAP
- /* address is outside main heap */
- if (contiguous(av) && av->top != initial_top(av)) {
- assert(((char*)p) < min_address || ((char*)p) > max_address);
- }
- /* chunk is page-aligned */
- assert(((p->prev_size + sz) & (av->pagesize-1)) == 0);
- /* mem is aligned */
- assert(aligned_OK(chunk2mem(p)));
-# else
- /* force an appropriate assert violation if debug set */
- assert(!chunk_is_mmapped(p));
-# endif
- }
-}
-
-/*
- Properties of free chunks
-*/
-
-# if __STD_C
-static void do_check_free_chunk(mchunkptr p)
-# else
-static void do_check_free_chunk(p) mchunkptr p;
-# endif
-{
- mstate av = get_malloc_state();
-
- INTERNAL_SIZE_T sz = p->size & ~PREV_INUSE;
- mchunkptr next = chunk_at_offset(p, sz);
-
- do_check_chunk(p);
-
- /* Chunk must claim to be free ... */
- assert(!inuse(p));
- assert (!chunk_is_mmapped(p));
-
- /* Unless a special marker, must have OK fields */
- if ((CHUNK_SIZE_T)(sz) >= MINSIZE)
- {
- assert((sz & MALLOC_ALIGN_MASK) == 0);
- assert(aligned_OK(chunk2mem(p)));
- /* ... matching footer field */
- assert(next->prev_size == sz);
- /* ... and is fully consolidated */
- assert(prev_inuse(p));
- assert (next == av->top || inuse(next));
-
- /* ... and has minimally sane links */
- assert(p->fd->bk == p);
- assert(p->bk->fd == p);
- }
- else /* markers are always of size SIZE_SZ */
- assert(sz == SIZE_SZ);
-}
-
-/*
- Properties of inuse chunks
-*/
-
-# if __STD_C
-static void do_check_inuse_chunk(mchunkptr p)
-# else
-static void do_check_inuse_chunk(p) mchunkptr p;
-# endif
-{
- mstate av = get_malloc_state();
- mchunkptr next;
- do_check_chunk(p);
-
- if (chunk_is_mmapped(p))
- return; /* mmapped chunks have no next/prev */
-
- /* Check whether it claims to be in use ... */
- assert(inuse(p));
-
- next = next_chunk(p);
-
- /* ... and is surrounded by OK chunks.
- Since more things can be checked with free chunks than inuse ones,
- if an inuse chunk borders them and debug is on, it's worth doing them.
- */
- if (!prev_inuse(p)) {
- /* Note that we cannot even look at prev unless it is not inuse */
- mchunkptr prv = prev_chunk(p);
- assert(next_chunk(prv) == p);
- do_check_free_chunk(prv);
- }
-
- if (next == av->top) {
- assert(prev_inuse(next));
- assert(chunksize(next) >= MINSIZE);
- }
- else if (!inuse(next))
- do_check_free_chunk(next);
-}
-
-/*
- Properties of chunks recycled from fastbins
-*/
-
-# if __STD_C
-static void do_check_remalloced_chunk(mchunkptr p, INTERNAL_SIZE_T s)
-# else
-static void do_check_remalloced_chunk(p, s) mchunkptr p; INTERNAL_SIZE_T s;
-# endif
-{
- INTERNAL_SIZE_T sz = p->size & ~PREV_INUSE;
-
- do_check_inuse_chunk(p);
-
- /* Legal size ... */
- assert((sz & MALLOC_ALIGN_MASK) == 0);
- assert((CHUNK_SIZE_T)(sz) >= MINSIZE);
- /* ... and alignment */
- assert(aligned_OK(chunk2mem(p)));
- /* chunk is less than MINSIZE more than request */
- assert((long)(sz) - (long)(s) >= 0);
- assert((long)(sz) - (long)(s + MINSIZE) < 0);
-}
-
-/*
- Properties of nonrecycled chunks at the point they are malloced
-*/
-
-# if __STD_C
-static void do_check_malloced_chunk(mchunkptr p, INTERNAL_SIZE_T s)
-# else
-static void do_check_malloced_chunk(p, s) mchunkptr p; INTERNAL_SIZE_T s;
-# endif
-{
- /* same as recycled case ... */
- do_check_remalloced_chunk(p, s);
-
- /*
- ... plus, must obey implementation invariant that prev_inuse is
- always true of any allocated chunk; i.e., that each allocated
- chunk borders either a previously allocated and still in-use
- chunk, or the base of its memory arena. This is ensured
- by making all allocations from the the `lowest' part of any found
- chunk. This does not necessarily hold however for chunks
- recycled via fastbins.
- */
-
- assert(prev_inuse(p));
-}
-
-
-/*
- Properties of malloc_state.
-
- This may be useful for debugging malloc, as well as detecting user
- programmer errors that somehow write into malloc_state.
-
- If you are extending or experimenting with this malloc, you can
- probably figure out how to hack this routine to print out or
- display chunk addresses, sizes, bins, and other instrumentation.
-*/
-
-static void do_check_malloc_state()
-{
- mstate av = get_malloc_state();
- int i;
- mchunkptr p;
- mchunkptr q;
- mbinptr b;
- unsigned int binbit;
- int empty;
- unsigned int idx;
- INTERNAL_SIZE_T size;
- CHUNK_SIZE_T total = 0;
- int max_fast_bin;
-
- /* internal size_t must be no wider than pointer type */
- assert(sizeof (INTERNAL_SIZE_T) <= sizeof (char*));
-
- /* alignment is a power of 2 */
- assert((MALLOC_ALIGNMENT & (MALLOC_ALIGNMENT-1)) == 0);
-
- /* cannot run remaining checks until fully initialized */
- if (av->top == 0 || av->top == initial_top(av))
- return;
-
- /* pagesize is a power of 2 */
- assert((av->pagesize & (av->pagesize-1)) == 0);
-
- /* properties of fastbins */
-
- /* max_fast is in allowed range */
- assert(get_max_fast(av) <= request2size(MAX_FAST_SIZE));
-
- max_fast_bin = fastbin_index(av->max_fast);
-
- for (i = 0; i < NFASTBINS; ++i) {
- p = av->fastbins[i];
-
- /* all bins past max_fast are empty */
- if (i > max_fast_bin)
- assert(p == 0);
-
- while (p != 0) {
- /* each chunk claims to be inuse */
- do_check_inuse_chunk(p);
- total += chunksize(p);
- /* chunk belongs in this bin */
- assert(fastbin_index(chunksize(p)) == i);
- p = p->fd;
- }
- }
-
- if (total != 0)
- assert(have_fastchunks(av));
- else if (!have_fastchunks(av))
- assert(total == 0);
-
- /* check normal bins */
- for (i = 1; i < NBINS; ++i) {
- b = bin_at(av,i);
-
- /* binmap is accurate (except for bin 1 == unsorted_chunks) */
- if (i >= 2) {
- binbit = get_binmap(av,i);
- empty = last(b) == b;
- if (!binbit)
- assert(empty);
- else if (!empty)
- assert(binbit);
- }
-
- for (p = last(b); p != b; p = p->bk) {
- /* each chunk claims to be free */
- do_check_free_chunk(p);
- size = chunksize(p);
- total += size;
- if (i >= 2) {
- /* chunk belongs in bin */
- idx = bin_index(size);
- assert(idx == i);
- /* lists are sorted */
- if ((CHUNK_SIZE_T) size >= (CHUNK_SIZE_T)(FIRST_SORTED_BIN_SIZE)) {
- assert(p->bk == b ||
- (CHUNK_SIZE_T)chunksize(p->bk) >=
- (CHUNK_SIZE_T)chunksize(p));
- }
- }
- /* chunk is followed by a legal chain of inuse chunks */
- for (q = next_chunk(p);
- (q != av->top && inuse(q) &&
- (CHUNK_SIZE_T)(chunksize(q)) >= MINSIZE);
- q = next_chunk(q))
- do_check_inuse_chunk(q);
- }
- }
-
- /* top chunk is OK */
- check_chunk(av->top);
-
- /* sanity checks for statistics */
-
- assert(total <= (CHUNK_SIZE_T)(av->max_total_mem));
- assert(av->n_mmaps >= 0);
- assert(av->n_mmaps <= av->max_n_mmaps);
-
- assert((CHUNK_SIZE_T)(av->sbrked_mem) <=
- (CHUNK_SIZE_T)(av->max_sbrked_mem));
-
- assert((CHUNK_SIZE_T)(av->mmapped_mem) <=
- (CHUNK_SIZE_T)(av->max_mmapped_mem));
-
- assert((CHUNK_SIZE_T)(av->max_total_mem) >=
- (CHUNK_SIZE_T)(av->mmapped_mem) + (CHUNK_SIZE_T)(av->sbrked_mem));
-}
-#endif
-
-
-/* ----------- Routines dealing with system allocation -------------- */
-
-/*
- sysmalloc handles malloc cases requiring more memory from the system.
- On entry, it is assumed that av->top does not have enough
- space to service request for nb bytes, thus requiring that av->top
- be extended or replaced.
-*/
-
-#if __STD_C
-static Void_t* sYSMALLOc(INTERNAL_SIZE_T nb, mstate av)
-#else
-static Void_t* sYSMALLOc(nb, av) INTERNAL_SIZE_T nb; mstate av;
-#endif
-{
- mchunkptr old_top; /* incoming value of av->top */
- INTERNAL_SIZE_T old_size; /* its size */
- char* old_end; /* its end address */
-
- long size; /* arg to first MORECORE or mmap call */
- char* brk; /* return value from MORECORE */
-
- long correction; /* arg to 2nd MORECORE call */
- char* snd_brk; /* 2nd return val */
-
- INTERNAL_SIZE_T front_misalign; /* unusable bytes at front of new space */
- INTERNAL_SIZE_T end_misalign; /* partial page left at end of new space */
- char* aligned_brk; /* aligned offset into brk */
-
- mchunkptr p; /* the allocated/returned chunk */
- mchunkptr remainder; /* remainder from allocation */
- CHUNK_SIZE_T remainder_size; /* its size */
-
- CHUNK_SIZE_T sum; /* for updating stats */
-
- size_t pagemask = av->pagesize - 1;
-
- /*
- If there is space available in fastbins, consolidate and retry
- malloc from scratch rather than getting memory from system. This
- can occur only if nb is in smallbin range so we didn't consolidate
- upon entry to malloc. It is much easier to handle this case here
- than in malloc proper.
- */
-
- if (have_fastchunks(av)) {
- assert(in_smallbin_range(nb));
- malloc_consolidate(av);
- return mALLOc(nb - MALLOC_ALIGN_MASK);
- }
-
-
-#if HAVE_MMAP
-
- /*
- If have mmap, and the request size meets the mmap threshold, and
- the system supports mmap, and there are few enough currently
- allocated mmapped regions, try to directly map this request
- rather than expanding top.
- */
-
- if ((CHUNK_SIZE_T)(nb) >= (CHUNK_SIZE_T)(av->mmap_threshold) &&
- (av->n_mmaps < av->n_mmaps_max)) {
-
- char* mm; /* return value from mmap call*/
-
- /*
- Round up size to nearest page. For mmapped chunks, the overhead
- is one SIZE_SZ unit larger than for normal chunks, because there
- is no following chunk whose prev_size field could be used.
- */
- size = (nb + SIZE_SZ + MALLOC_ALIGN_MASK + pagemask) & ~pagemask;
-
- /* Don't try if size wraps around 0 */
- if ((CHUNK_SIZE_T)(size) > (CHUNK_SIZE_T)(nb)) {
-
- mm = (char*)(MMAP(0, size, PROT_READ|PROT_WRITE, MAP_PRIVATE));
-
- if (mm != (char*)(MORECORE_FAILURE)) {
-
- /*
- The offset to the start of the mmapped region is stored
- in the prev_size field of the chunk. This allows us to adjust
- returned start address to meet alignment requirements here
- and in memalign(), and still be able to compute proper
- address argument for later munmap in free() and realloc().
- */
-
- front_misalign = (INTERNAL_SIZE_T)chunk2mem(mm) & MALLOC_ALIGN_MASK;
- if (front_misalign > 0) {
- correction = MALLOC_ALIGNMENT - front_misalign;
- p = (mchunkptr)(mm + correction);
- p->prev_size = correction;
- set_head(p, (size - correction) |IS_MMAPPED);
- }
- else {
- p = (mchunkptr)mm;
- p->prev_size = 0;
- set_head(p, size|IS_MMAPPED);
- }
-
- /* update statistics */
-
- if (++av->n_mmaps > av->max_n_mmaps)
- av->max_n_mmaps = av->n_mmaps;
-
- sum = av->mmapped_mem += size;
- if (sum > (CHUNK_SIZE_T)(av->max_mmapped_mem))
- av->max_mmapped_mem = sum;
- sum += av->sbrked_mem;
- if (sum > (CHUNK_SIZE_T)(av->max_total_mem))
- av->max_total_mem = sum;
-
- check_chunk(p);
-
- return chunk2mem(p);
- }
- }
- }
-#endif
-
- /* Record incoming configuration of top */
-
- old_top = av->top;
- old_size = chunksize(old_top);
- old_end = (char*)(chunk_at_offset(old_top, old_size));
-
- brk = snd_brk = (char*)(MORECORE_FAILURE);
-
- /*
- If not the first time through, we require old_size to be
- at least MINSIZE and to have prev_inuse set.
- */
-
- assert((old_top == initial_top(av) && old_size == 0) ||
- ((CHUNK_SIZE_T) (old_size) >= MINSIZE &&
- prev_inuse(old_top)));
-
- /* Precondition: not enough current space to satisfy nb request */
- assert((CHUNK_SIZE_T)(old_size) < (CHUNK_SIZE_T)(nb + MINSIZE));
-
- /* Precondition: all fastbins are consolidated */
- assert(!have_fastchunks(av));
-
-
- /* Request enough space for nb + pad + overhead */
-
- size = nb + av->top_pad + MINSIZE;
-
- /*
- If contiguous, we can subtract out existing space that we hope to
- combine with new space. We add it back later only if
- we don't actually get contiguous space.
- */
-
- if (contiguous(av))
- size -= old_size;
-
- /*
- Round to a multiple of page size.
- If MORECORE is not contiguous, this ensures that we only call it
- with whole-page arguments. And if MORECORE is contiguous and
- this is not first time through, this preserves page-alignment of
- previous calls. Otherwise, we correct to page-align below.
- */
-
- size = (size + pagemask) & ~pagemask;
-
- /*
- Don't try to call MORECORE if argument is so big as to appear
- negative. Note that since mmap takes size_t arg, it may succeed
- below even if we cannot call MORECORE.
- */
-
- if (size > 0)
- brk = (char*)(MORECORE(size));
-
- /*
- If have mmap, try using it as a backup when MORECORE fails or
- cannot be used. This is worth doing on systems that have "holes" in
- address space, so sbrk cannot extend to give contiguous space, but
- space is available elsewhere. Note that we ignore mmap max count
- and threshold limits, since the space will not be used as a
- segregated mmap region.
- */
-
-#if HAVE_MMAP
- if (brk == (char*)(MORECORE_FAILURE)) {
-
- /* Cannot merge with old top, so add its size back in */
- if (contiguous(av))
- size = (size + old_size + pagemask) & ~pagemask;
-
- /* If we are relying on mmap as backup, then use larger units */
- if ((CHUNK_SIZE_T)(size) < (CHUNK_SIZE_T)(MMAP_AS_MORECORE_SIZE))
- size = MMAP_AS_MORECORE_SIZE;
-
- /* Don't try if size wraps around 0 */
- if ((CHUNK_SIZE_T)(size) > (CHUNK_SIZE_T)(nb)) {
-
- brk = (char*)(MMAP(0, size, PROT_READ|PROT_WRITE, MAP_PRIVATE));
-
- if (brk != (char*)(MORECORE_FAILURE)) {
-
- /* We do not need, and cannot use, another sbrk call to find end */
- snd_brk = brk + size;
-
- /*
- Record that we no longer have a contiguous sbrk region.
- After the first time mmap is used as backup, we do not
- ever rely on contiguous space since this could incorrectly
- bridge regions.
- */
- set_noncontiguous(av);
- }
- }
- }
-#endif
-
- if (brk != (char*)(MORECORE_FAILURE)) {
- av->sbrked_mem += size;
-
- /*
- If MORECORE extends previous space, we can likewise extend top size.
- */
-
- if (brk == old_end && snd_brk == (char*)(MORECORE_FAILURE)) {
- set_head(old_top, (size + old_size) | PREV_INUSE);
- }
-
- /*
- Otherwise, make adjustments:
-
- * If the first time through or noncontiguous, we need to call sbrk
- just to find out where the end of memory lies.
-
- * We need to ensure that all returned chunks from malloc will meet
- MALLOC_ALIGNMENT
-
- * If there was an intervening foreign sbrk, we need to adjust sbrk
- request size to account for fact that we will not be able to
- combine new space with existing space in old_top.
-
- * Almost all systems internally allocate whole pages at a time, in
- which case we might as well use the whole last page of request.
- So we allocate enough more memory to hit a page boundary now,
- which in turn causes future contiguous calls to page-align.
- */
-
- else {
- front_misalign = 0;
- end_misalign = 0;
- correction = 0;
- aligned_brk = brk;
-
- /*
- If MORECORE returns an address lower than we have seen before,
- we know it isn't really contiguous. This and some subsequent
- checks help cope with non-conforming MORECORE functions and
- the presence of "foreign" calls to MORECORE from outside of
- malloc or by other threads. We cannot guarantee to detect
- these in all cases, but cope with the ones we do detect.
- */
- if (contiguous(av) && old_size != 0 && brk < old_end) {
- set_noncontiguous(av);
- }
-
- /* handle contiguous cases */
- if (contiguous(av)) {
-
- /*
- We can tolerate forward non-contiguities here (usually due
- to foreign calls) but treat them as part of our space for
- stats reporting.
- */
- if (old_size != 0)
- av->sbrked_mem += brk - old_end;
-
- /* Guarantee alignment of first new chunk made from this space */
-
- front_misalign = (INTERNAL_SIZE_T)chunk2mem(brk) & MALLOC_ALIGN_MASK;
- if (front_misalign > 0) {
-
- /*
- Skip over some bytes to arrive at an aligned position.
- We don't need to specially mark these wasted front bytes.
- They will never be accessed anyway because
- prev_inuse of av->top (and any chunk created from its start)
- is always true after initialization.
- */
-
- correction = MALLOC_ALIGNMENT - front_misalign;
- aligned_brk += correction;
- }
-
- /*
- If this isn't adjacent to existing space, then we will not
- be able to merge with old_top space, so must add to 2nd request.
- */
-
- correction += old_size;
-
- /* Extend the end address to hit a page boundary */
- end_misalign = (INTERNAL_SIZE_T)(brk + size + correction);
- correction += ((end_misalign + pagemask) & ~pagemask) - end_misalign;
-
- assert(correction >= 0);
- snd_brk = (char*)(MORECORE(correction));
-
- if (snd_brk == (char*)(MORECORE_FAILURE)) {
- /*
- If can't allocate correction, try to at least find out current
- brk. It might be enough to proceed without failing.
- */
- correction = 0;
- snd_brk = (char*)(MORECORE(0));
- }
- else if (snd_brk < brk) {
- /*
- If the second call gives noncontiguous space even though
- it says it won't, the only course of action is to ignore
- results of second call, and conservatively estimate where
- the first call left us. Also set noncontiguous, so this
- won't happen again, leaving at most one hole.
-
- Note that this check is intrinsically incomplete. Because
- MORECORE is allowed to give more space than we ask for,
- there is no reliable way to detect a noncontiguity
- producing a forward gap for the second call.
- */
- snd_brk = brk + size;
- correction = 0;
- set_noncontiguous(av);
- }
- }
-
- /* handle non-contiguous cases */
- else {
- /* MORECORE/mmap must correctly align */
- assert(aligned_OK(chunk2mem(brk)));
-
- /* Find out current end of memory */
- if (snd_brk == (char*)(MORECORE_FAILURE)) {
- snd_brk = (char*)(MORECORE(0));
- av->sbrked_mem += snd_brk - brk - size;
- }
- }
-
- /* Adjust top based on results of second sbrk */
- if (snd_brk != (char*)(MORECORE_FAILURE)) {
- av->top = (mchunkptr)aligned_brk;
- set_head(av->top, (snd_brk - aligned_brk + correction) | PREV_INUSE);
- av->sbrked_mem += correction;
-
- /*
- If not the first time through, we either have a
- gap due to foreign sbrk or a non-contiguous region. Insert a
- double fencepost at old_top to prevent consolidation with space
- we don't own. These fenceposts are artificial chunks that are
- marked as inuse and are in any case too small to use. We need
- two to make sizes and alignments work out.
- */
-
- if (old_size != 0) {
- /*
- Shrink old_top to insert fenceposts, keeping size a
- multiple of MALLOC_ALIGNMENT. We know there is at least
- enough space in old_top to do this.
- */
- old_size = (old_size - 3*SIZE_SZ) & ~MALLOC_ALIGN_MASK;
- set_head(old_top, old_size | PREV_INUSE);
-
- /*
- Note that the following assignments completely overwrite
- old_top when old_size was previously MINSIZE. This is
- intentional. We need the fencepost, even if old_top otherwise gets
- lost.
- */
- chunk_at_offset(old_top, old_size)->size =
- SIZE_SZ|PREV_INUSE;
-
- chunk_at_offset(old_top, old_size + SIZE_SZ)->size =
- SIZE_SZ|PREV_INUSE;
-
- /*
- If possible, release the rest, suppressing trimming.
- */
- if (old_size >= MINSIZE) {
- INTERNAL_SIZE_T tt = av->trim_threshold;
- av->trim_threshold = (INTERNAL_SIZE_T)(-1);
- fREe(chunk2mem(old_top));
- av->trim_threshold = tt;
- }
- }
- }
- }
-
- /* Update statistics */
- sum = av->sbrked_mem;
- if (sum > (CHUNK_SIZE_T)(av->max_sbrked_mem))
- av->max_sbrked_mem = sum;
-
- sum += av->mmapped_mem;
- if (sum > (CHUNK_SIZE_T)(av->max_total_mem))
- av->max_total_mem = sum;
-
- check_malloc_state();
-
- /* finally, do the allocation */
-
- p = av->top;
- size = chunksize(p);
-
- /* check that one of the above allocation paths succeeded */
- if ((CHUNK_SIZE_T)(size) >= (CHUNK_SIZE_T)(nb + MINSIZE)) {
- remainder_size = size - nb;
- remainder = chunk_at_offset(p, nb);
- av->top = remainder;
- set_head(p, nb | PREV_INUSE);
- set_head(remainder, remainder_size | PREV_INUSE);
- check_malloced_chunk(p, nb);
- return chunk2mem(p);
- }
-
- }
-
- /* catch all failure paths */
- MALLOC_FAILURE_ACTION;
- return 0;
-}
-
-
-
-
-/*
- sYSTRIm is an inverse of sorts to sYSMALLOc. It gives memory back
- to the system (via negative arguments to sbrk) if there is unused
- memory at the `high' end of the malloc pool. It is called
- automatically by free() when top space exceeds the trim
- threshold. It is also called by the public malloc_trim routine. It
- returns 1 if it actually released any memory, else 0.
-*/
-
-#if __STD_C
-static int sYSTRIm(size_t pad, mstate av)
-#else
-static int sYSTRIm(pad, av) size_t pad; mstate av;
-#endif
-{
- long top_size; /* Amount of top-most memory */
- long extra; /* Amount to release */
- long released; /* Amount actually released */
- char* current_brk; /* address returned by pre-check sbrk call */
- char* new_brk; /* address returned by post-check sbrk call */
- size_t pagesz;
-
- pagesz = av->pagesize;
- top_size = chunksize(av->top);
-
- /* Release in pagesize units, keeping at least one page */
- extra = ((top_size - pad - MINSIZE + (pagesz-1)) / pagesz - 1) * pagesz;
-
- if (extra > 0) {
-
- /*
- Only proceed if end of memory is where we last set it.
- This avoids problems if there were foreign sbrk calls.
- */
- current_brk = (char*)(MORECORE(0));
- if (current_brk == (char*)(av->top) + top_size) {
-
- /*
- Attempt to release memory. We ignore MORECORE return value,
- and instead call again to find out where new end of memory is.
- This avoids problems if first call releases less than we asked,
- of if failure somehow altered brk value. (We could still
- encounter problems if it altered brk in some very bad way,
- but the only thing we can do is adjust anyway, which will cause
- some downstream failure.)
- */
-
- MORECORE(-extra);
- new_brk = (char*)(MORECORE(0));
-
- if (new_brk != (char*)MORECORE_FAILURE) {
- released = (long)(current_brk - new_brk);
-
- if (released != 0) {
- /* Success. Adjust top. */
- av->sbrked_mem -= released;
- set_head(av->top, (top_size - released) | PREV_INUSE);
- check_malloc_state();
- return 1;
- }
- }
- }
- }
- return 0;
-}
-
-/*
- ------------------------------ malloc ------------------------------
-*/
-
-
-#if __STD_C
-Void_t* mALLOc(size_t bytes)
-#else
- Void_t* mALLOc(bytes) size_t bytes;
-#endif
-{
- mstate av = get_malloc_state();
-
- INTERNAL_SIZE_T nb; /* normalized request size */
- unsigned int idx; /* associated bin index */
- mbinptr bin; /* associated bin */
- mfastbinptr* fb; /* associated fastbin */
-
- mchunkptr victim; /* inspected/selected chunk */
- INTERNAL_SIZE_T size; /* its size */
- int victim_index; /* its bin index */
-
- mchunkptr remainder; /* remainder from a split */
- CHUNK_SIZE_T remainder_size; /* its size */
-
- unsigned int block; /* bit map traverser */
- unsigned int bit; /* bit map traverser */
- unsigned int map; /* current word of binmap */
-
- mchunkptr fwd; /* misc temp for linking */
- mchunkptr bck; /* misc temp for linking */
-
- /*
- Convert request size to internal form by adding SIZE_SZ bytes
- overhead plus possibly more to obtain necessary alignment and/or
- to obtain a size of at least MINSIZE, the smallest allocatable
- size. Also, checked_request2size traps (returning 0) request sizes
- that are so large that they wrap around zero when padded and
- aligned.
- */
-
- checked_request2size(bytes, nb);
-
- /*
- Bypass search if no frees yet
- */
- if (!have_anychunks(av)) {
- if (av->max_fast == 0) /* initialization check */
- malloc_consolidate(av);
- goto use_top;
- }
-
- /*
- If the size qualifies as a fastbin, first check corresponding bin.
- */
-
- if ((CHUNK_SIZE_T)(nb) <= (CHUNK_SIZE_T)(av->max_fast)) {
- fb = &(av->fastbins[(fastbin_index(nb))]);
- if ((victim = *fb) != 0) {
- *fb = victim->fd;
- check_remalloced_chunk(victim, nb);
- return chunk2mem(victim);
- }
- }
-
- /*
- If a small request, check regular bin. Since these "smallbins"
- hold one size each, no searching within bins is necessary.
- (For a large request, we need to wait until unsorted chunks are
- processed to find best fit. But for small ones, fits are exact
- anyway, so we can check now, which is faster.)
- */
-
- if (in_smallbin_range(nb)) {
- idx = smallbin_index(nb);
- bin = bin_at(av,idx);
-
- if ((victim = last(bin)) != bin) {
- bck = victim->bk;
- set_inuse_bit_at_offset(victim, nb);
- bin->bk = bck;
- bck->fd = bin;
-
- check_malloced_chunk(victim, nb);
- return chunk2mem(victim);
- }
- }
-
- /*
- If this is a large request, consolidate fastbins before continuing.
- While it might look excessive to kill all fastbins before
- even seeing if there is space available, this avoids
- fragmentation problems normally associated with fastbins.
- Also, in practice, programs tend to have runs of either small or
- large requests, but less often mixtures, so consolidation is not
- invoked all that often in most programs. And the programs that
- it is called frequently in otherwise tend to fragment.
- */
-
- else {
- idx = largebin_index(nb);
- if (have_fastchunks(av))
- malloc_consolidate(av);
- }
-
- /*
- Process recently freed or remaindered chunks, taking one only if
- it is exact fit, or, if this a small request, the chunk is remainder from
- the most recent non-exact fit. Place other traversed chunks in
- bins. Note that this step is the only place in any routine where
- chunks are placed in bins.
- */
-
- while ((victim = unsorted_chunks(av)->bk) != unsorted_chunks(av)) {
- bck = victim->bk;
- size = chunksize(victim);
-
- /*
- If a small request, try to use last remainder if it is the
- only chunk in unsorted bin. This helps promote locality for
- runs of consecutive small requests. This is the only
- exception to best-fit, and applies only when there is
- no exact fit for a small chunk.
- */
-
- if (in_smallbin_range(nb) &&
- bck == unsorted_chunks(av) &&
- victim == av->last_remainder &&
- (CHUNK_SIZE_T)(size) > (CHUNK_SIZE_T)(nb + MINSIZE)) {
-
- /* split and reattach remainder */
- remainder_size = size - nb;
- remainder = chunk_at_offset(victim, nb);
- unsorted_chunks(av)->bk = unsorted_chunks(av)->fd = remainder;
- av->last_remainder = remainder;
- remainder->bk = remainder->fd = unsorted_chunks(av);
-
- set_head(victim, nb | PREV_INUSE);
- set_head(remainder, remainder_size | PREV_INUSE);
- set_foot(remainder, remainder_size);
-
- check_malloced_chunk(victim, nb);
- return chunk2mem(victim);
- }
-
- /* remove from unsorted list */
- unsorted_chunks(av)->bk = bck;
- bck->fd = unsorted_chunks(av);
-
- /* Take now instead of binning if exact fit */
-
- if (size == nb) {
- set_inuse_bit_at_offset(victim, size);
- check_malloced_chunk(victim, nb);
- return chunk2mem(victim);
- }
-
- /* place chunk in bin */
-
- if (in_smallbin_range(size)) {
- victim_index = smallbin_index(size);
- bck = bin_at(av, victim_index);
- fwd = bck->fd;
- }
- else {
- victim_index = largebin_index(size);
- bck = bin_at(av, victim_index);
- fwd = bck->fd;
-
- if (fwd != bck) {
- /* if smaller than smallest, place first */
- if ((CHUNK_SIZE_T)(size) < (CHUNK_SIZE_T)(bck->bk->size)) {
- fwd = bck;
- bck = bck->bk;
- }
- else if ((CHUNK_SIZE_T)(size) >=
- (CHUNK_SIZE_T)(FIRST_SORTED_BIN_SIZE)) {
-
- /* maintain large bins in sorted order */
- size |= PREV_INUSE; /* Or with inuse bit to speed comparisons */
- while ((CHUNK_SIZE_T)(size) < (CHUNK_SIZE_T)(fwd->size))
- fwd = fwd->fd;
- bck = fwd->bk;
- }
- }
- }
-
- mark_bin(av, victim_index);
- victim->bk = bck;
- victim->fd = fwd;
- fwd->bk = victim;
- bck->fd = victim;
- }
-
- /*
- If a large request, scan through the chunks of current bin to
- find one that fits. (This will be the smallest that fits unless
- FIRST_SORTED_BIN_SIZE has been changed from default.) This is
- the only step where an unbounded number of chunks might be
- scanned without doing anything useful with them. However the
- lists tend to be short.
- */
-
- if (!in_smallbin_range(nb)) {
- bin = bin_at(av, idx);
-
- for (victim = last(bin); victim != bin; victim = victim->bk) {
- size = chunksize(victim);
-
- if ((CHUNK_SIZE_T)(size) >= (CHUNK_SIZE_T)(nb)) {
- remainder_size = size - nb;
- unlink(victim, bck, fwd);
-
- /* Exhaust */
- if (remainder_size < MINSIZE) {
- set_inuse_bit_at_offset(victim, size);
- check_malloced_chunk(victim, nb);
- return chunk2mem(victim);
- }
- /* Split */
- else {
- remainder = chunk_at_offset(victim, nb);
- unsorted_chunks(av)->bk = unsorted_chunks(av)->fd = remainder;
- remainder->bk = remainder->fd = unsorted_chunks(av);
- set_head(victim, nb | PREV_INUSE);
- set_head(remainder, remainder_size | PREV_INUSE);
- set_foot(remainder, remainder_size);
- check_malloced_chunk(victim, nb);
- return chunk2mem(victim);
- }
- }
- }
- }
-
- /*
- Search for a chunk by scanning bins, starting with next largest
- bin. This search is strictly by best-fit; i.e., the smallest
- (with ties going to approximately the least recently used) chunk
- that fits is selected.
-
- The bitmap avoids needing to check that most blocks are nonempty.
- */
-
- ++idx;
- bin = bin_at(av,idx);
- block = idx2block(idx);
- map = av->binmap[block];
- bit = idx2bit(idx);
-
- for (;;) {
-
- /* Skip rest of block if there are no more set bits in this block. */
- if (bit > map || bit == 0) {
- do {
- if (++block >= BINMAPSIZE) /* out of bins */
- goto use_top;
- } while ((map = av->binmap[block]) == 0);
-
- bin = bin_at(av, (block << BINMAPSHIFT));
- bit = 1;
- }
-
- /* Advance to bin with set bit. There must be one. */
- while ((bit & map) == 0) {
- bin = next_bin(bin);
- bit <<= 1;
- assert(bit != 0);
- }
-
- /* Inspect the bin. It is likely to be non-empty */
- victim = last(bin);
-
- /* If a false alarm (empty bin), clear the bit. */
- if (victim == bin) {
- av->binmap[block] = map &= ~bit; /* Write through */
- bin = next_bin(bin);
- bit <<= 1;
- }
-
- else {
- size = chunksize(victim);
-
- /* We know the first chunk in this bin is big enough to use. */
- assert((CHUNK_SIZE_T)(size) >= (CHUNK_SIZE_T)(nb));
-
- remainder_size = size - nb;
-
- /* unlink */
- bck = victim->bk;
- bin->bk = bck;
- bck->fd = bin;
-
- /* Exhaust */
- if (remainder_size < MINSIZE) {
- set_inuse_bit_at_offset(victim, size);
- check_malloced_chunk(victim, nb);
- return chunk2mem(victim);
- }
-
- /* Split */
- else {
- remainder = chunk_at_offset(victim, nb);
-
- unsorted_chunks(av)->bk = unsorted_chunks(av)->fd = remainder;
- remainder->bk = remainder->fd = unsorted_chunks(av);
- /* advertise as last remainder */
- if (in_smallbin_range(nb))
- av->last_remainder = remainder;
-
- set_head(victim, nb | PREV_INUSE);
- set_head(remainder, remainder_size | PREV_INUSE);
- set_foot(remainder, remainder_size);
- check_malloced_chunk(victim, nb);
- return chunk2mem(victim);
- }
- }
- }
-
- use_top:
- /*
- If large enough, split off the chunk bordering the end of memory
- (held in av->top). Note that this is in accord with the best-fit
- search rule. In effect, av->top is treated as larger (and thus
- less well fitting) than any other available chunk since it can
- be extended to be as large as necessary (up to system
- limitations).
-
- We require that av->top always exists (i.e., has size >=
- MINSIZE) after initialization, so if it would otherwise be
- exhausted by the current request, it is replenished. (The main
- reason for ensuring it exists is that we may need MINSIZE space
- to put in fenceposts in sysmalloc.)
- */
-
- victim = av->top;
- size = chunksize(victim);
-
- if ((CHUNK_SIZE_T)(size) >= (CHUNK_SIZE_T)(nb + MINSIZE)) {
- remainder_size = size - nb;
- remainder = chunk_at_offset(victim, nb);
- av->top = remainder;
- set_head(victim, nb | PREV_INUSE);
- set_head(remainder, remainder_size | PREV_INUSE);
-
- check_malloced_chunk(victim, nb);
- return chunk2mem(victim);
- }
-
- /*
- If no space in top, relay to handle system-dependent cases
- */
- return sYSMALLOc(nb, av);
-}
-
-/*
- ------------------------------ free ------------------------------
-*/
-
-#if __STD_C
-void fREe(Void_t* mem)
-#else
-void fREe(mem) Void_t* mem;
-#endif
-{
- mstate av = get_malloc_state();
-
- mchunkptr p; /* chunk corresponding to mem */
- INTERNAL_SIZE_T size; /* its size */
- mfastbinptr* fb; /* associated fastbin */
- mchunkptr nextchunk; /* next contiguous chunk */
- INTERNAL_SIZE_T nextsize; /* its size */
- int nextinuse; /* true if nextchunk is used */
- INTERNAL_SIZE_T prevsize; /* size of previous contiguous chunk */
- mchunkptr bck; /* misc temp for linking */
- mchunkptr fwd; /* misc temp for linking */
-
- /* free(0) has no effect */
- if (mem != 0) {
- p = mem2chunk(mem);
- size = chunksize(p);
-
- check_inuse_chunk(p);
-
- /*
- If eligible, place chunk on a fastbin so it can be found
- and used quickly in malloc.
- */
-
- if ((CHUNK_SIZE_T)(size) <= (CHUNK_SIZE_T)(av->max_fast)
-
-#if TRIM_FASTBINS
- /*
- If TRIM_FASTBINS set, don't place chunks
- bordering top into fastbins
- */
- && (chunk_at_offset(p, size) != av->top)
-#endif
- ) {
-
- set_fastchunks(av);
- fb = &(av->fastbins[fastbin_index(size)]);
- p->fd = *fb;
- *fb = p;
- }
-
- /*
- Consolidate other non-mmapped chunks as they arrive.
- */
-
- else if (!chunk_is_mmapped(p)) {
- set_anychunks(av);
-
- nextchunk = chunk_at_offset(p, size);
- nextsize = chunksize(nextchunk);
-
- /* consolidate backward */
- if (!prev_inuse(p)) {
- prevsize = p->prev_size;
- size += prevsize;
- p = chunk_at_offset(p, -((long) prevsize));
- unlink(p, bck, fwd);
- }
-
- if (nextchunk != av->top) {
- /* get and clear inuse bit */
- nextinuse = inuse_bit_at_offset(nextchunk, nextsize);
- set_head(nextchunk, nextsize);
-
- /* consolidate forward */
- if (!nextinuse) {
- unlink(nextchunk, bck, fwd);
- size += nextsize;
- }
-
- /*
- Place the chunk in unsorted chunk list. Chunks are
- not placed into regular bins until after they have
- been given one chance to be used in malloc.
- */
-
- bck = unsorted_chunks(av);
- fwd = bck->fd;
- p->bk = bck;
- p->fd = fwd;
- bck->fd = p;
- fwd->bk = p;
-
- set_head(p, size | PREV_INUSE);
- set_foot(p, size);
-
- check_free_chunk(p);
- }
-
- /*
- If the chunk borders the current high end of memory,
- consolidate into top
- */
-
- else {
- size += nextsize;
- set_head(p, size | PREV_INUSE);
- av->top = p;
- check_chunk(p);
- }
-
- /*
- If freeing a large space, consolidate possibly-surrounding
- chunks. Then, if the total unused topmost memory exceeds trim
- threshold, ask malloc_trim to reduce top.
-
- Unless max_fast is 0, we don't know if there are fastbins
- bordering top, so we cannot tell for sure whether threshold
- has been reached unless fastbins are consolidated. But we
- don't want to consolidate on each free. As a compromise,
- consolidation is performed if FASTBIN_CONSOLIDATION_THRESHOLD
- is reached.
- */
-
- if ((CHUNK_SIZE_T)(size) >= FASTBIN_CONSOLIDATION_THRESHOLD) {
- if (have_fastchunks(av))
- malloc_consolidate(av);
-
-#ifndef MORECORE_CANNOT_TRIM
- if ((CHUNK_SIZE_T)(chunksize(av->top)) >=
- (CHUNK_SIZE_T)(av->trim_threshold))
- sYSTRIm(av->top_pad, av);
-#endif
- }
-
- }
- /*
- If the chunk was allocated via mmap, release via munmap()
- Note that if HAVE_MMAP is false but chunk_is_mmapped is
- true, then user must have overwritten memory. There's nothing
- we can do to catch this error unless DEBUG is set, in which case
- check_inuse_chunk (above) will have triggered error.
- */
-
- else {
-#if HAVE_MMAP
- int ret;
- INTERNAL_SIZE_T offset = p->prev_size;
- av->n_mmaps--;
- av->mmapped_mem -= (size + offset);
- ret = munmap((char*)p - offset, size + offset);
- /* munmap returns non-zero on failure */
- assert(ret == 0);
-#endif
- }
- }
-}
-
-/*
- ------------------------- malloc_consolidate -------------------------
-
- malloc_consolidate is a specialized version of free() that tears
- down chunks held in fastbins. Free itself cannot be used for this
- purpose since, among other things, it might place chunks back onto
- fastbins. So, instead, we need to use a minor variant of the same
- code.
-
- Also, because this routine needs to be called the first time through
- malloc anyway, it turns out to be the perfect place to trigger
- initialization code.
-*/
-
-#if __STD_C
-static void malloc_consolidate(mstate av)
-#else
-static void malloc_consolidate(av) mstate av;
-#endif
-{
- mfastbinptr* fb; /* current fastbin being consolidated */
- mfastbinptr* maxfb; /* last fastbin (for loop control) */
- mchunkptr p; /* current chunk being consolidated */
- mchunkptr nextp; /* next chunk to consolidate */
- mchunkptr unsorted_bin; /* bin header */
- mchunkptr first_unsorted; /* chunk to link to */
-
- /* These have same use as in free() */
- mchunkptr nextchunk;
- INTERNAL_SIZE_T size;
- INTERNAL_SIZE_T nextsize;
- INTERNAL_SIZE_T prevsize;
- int nextinuse;
- mchunkptr bck;
- mchunkptr fwd;
-
- /*
- If max_fast is 0, we know that av hasn't
- yet been initialized, in which case do so below
- */
-
- if (av->max_fast != 0) {
- clear_fastchunks(av);
-
- unsorted_bin = unsorted_chunks(av);
-
- /*
- Remove each chunk from fast bin and consolidate it, placing it
- then in unsorted bin. Among other reasons for doing this,
- placing in unsorted bin avoids needing to calculate actual bins
- until malloc is sure that chunks aren't immediately going to be
- reused anyway.
- */
-
- maxfb = &(av->fastbins[fastbin_index(av->max_fast)]);
- fb = &(av->fastbins[0]);
- do {
- if ((p = *fb) != 0) {
- *fb = 0;
-
- do {
- check_inuse_chunk(p);
- nextp = p->fd;
-
- /* Slightly streamlined version of consolidation code in free() */
- size = p->size & ~PREV_INUSE;
- nextchunk = chunk_at_offset(p, size);
- nextsize = chunksize(nextchunk);
-
- if (!prev_inuse(p)) {
- prevsize = p->prev_size;
- size += prevsize;
- p = chunk_at_offset(p, -((long) prevsize));
- unlink(p, bck, fwd);
- }
-
- if (nextchunk != av->top) {
- nextinuse = inuse_bit_at_offset(nextchunk, nextsize);
- set_head(nextchunk, nextsize);
-
- if (!nextinuse) {
- size += nextsize;
- unlink(nextchunk, bck, fwd);
- }
-
- first_unsorted = unsorted_bin->fd;
- unsorted_bin->fd = p;
- first_unsorted->bk = p;
-
- set_head(p, size | PREV_INUSE);
- p->bk = unsorted_bin;
- p->fd = first_unsorted;
- set_foot(p, size);
- }
-
- else {
- size += nextsize;
- set_head(p, size | PREV_INUSE);
- av->top = p;
- }
-
- } while ((p = nextp) != 0);
-
- }
- } while (fb++ != maxfb);
- }
- else {
- malloc_init_state(av);
- check_malloc_state();
- }
-}
-
-/*
- ------------------------------ realloc ------------------------------
-*/
-
-
-#if __STD_C
-Void_t* rEALLOc(Void_t* oldmem, size_t bytes)
-#else
-Void_t* rEALLOc(oldmem, bytes) Void_t* oldmem; size_t bytes;
-#endif
-{
- mstate av = get_malloc_state();
-
- INTERNAL_SIZE_T nb; /* padded request size */
-
- mchunkptr oldp; /* chunk corresponding to oldmem */
- INTERNAL_SIZE_T oldsize; /* its size */
-
- mchunkptr newp; /* chunk to return */
- INTERNAL_SIZE_T newsize; /* its size */
- Void_t* newmem; /* corresponding user mem */
-
- mchunkptr next; /* next contiguous chunk after oldp */
-
- mchunkptr remainder; /* extra space at end of newp */
- CHUNK_SIZE_T remainder_size; /* its size */
-
- mchunkptr bck; /* misc temp for linking */
- mchunkptr fwd; /* misc temp for linking */
-
- CHUNK_SIZE_T copysize; /* bytes to copy */
- unsigned int ncopies; /* INTERNAL_SIZE_T words to copy */
- INTERNAL_SIZE_T* s; /* copy source */
- INTERNAL_SIZE_T* d; /* copy destination */
-
-
-#ifdef REALLOC_ZERO_BYTES_FREES
- if (bytes == 0) {
- fREe(oldmem);
- return 0;
- }
-#endif
-
- /* realloc of null is supposed to be same as malloc */
- if (oldmem == 0)
- return mALLOc(bytes);
-
- checked_request2size(bytes, nb);
-
- oldp = mem2chunk(oldmem);
- oldsize = chunksize(oldp);
-
- check_inuse_chunk(oldp);
-
- if (!chunk_is_mmapped(oldp)) {
-
- if ((CHUNK_SIZE_T)(oldsize) >= (CHUNK_SIZE_T)(nb)) {
- /* already big enough; split below */
- newp = oldp;
- newsize = oldsize;
- }
-
- else {
- next = chunk_at_offset(oldp, oldsize);
-
- /* Try to expand forward into top */
- if (next == av->top &&
- (CHUNK_SIZE_T)(newsize = oldsize + chunksize(next)) >=
- (CHUNK_SIZE_T)(nb + MINSIZE)) {
- set_head_size(oldp, nb);
- av->top = chunk_at_offset(oldp, nb);
- set_head(av->top, (newsize - nb) | PREV_INUSE);
- return chunk2mem(oldp);
- }
-
- /* Try to expand forward into next chunk; split off remainder below */
- else if (next != av->top &&
- !inuse(next) &&
- (CHUNK_SIZE_T)(newsize = oldsize + chunksize(next)) >=
- (CHUNK_SIZE_T)(nb)) {
- newp = oldp;
- unlink(next, bck, fwd);
- }
-
- /* allocate, copy, free */
- else {
- newmem = mALLOc(nb - MALLOC_ALIGN_MASK);
- if (newmem == 0)
- return 0; /* propagate failure */
-
- newp = mem2chunk(newmem);
- newsize = chunksize(newp);
-
- /*
- Avoid copy if newp is next chunk after oldp.
- */
- if (newp == next) {
- newsize += oldsize;
- newp = oldp;
- }
- else {
- /*
- Unroll copy of <= 36 bytes (72 if 8byte sizes)
- We know that contents have an odd number of
- INTERNAL_SIZE_T-sized words; minimally 3.
- */
-
- copysize = oldsize - SIZE_SZ;
- s = (INTERNAL_SIZE_T*)(oldmem);
- d = (INTERNAL_SIZE_T*)(newmem);
- ncopies = copysize / sizeof (INTERNAL_SIZE_T);
- assert(ncopies >= 3);
-
- if (ncopies > 9)
- MALLOC_COPY(d, s, copysize);
-
- else {
- *(d+0) = *(s+0);
- *(d+1) = *(s+1);
- *(d+2) = *(s+2);
- if (ncopies > 4) {
- *(d+3) = *(s+3);
- *(d+4) = *(s+4);
- if (ncopies > 6) {
- *(d+5) = *(s+5);
- *(d+6) = *(s+6);
- if (ncopies > 8) {
- *(d+7) = *(s+7);
- *(d+8) = *(s+8);
- }
- }
- }
- }
-
- fREe(oldmem);
- check_inuse_chunk(newp);
- return chunk2mem(newp);
- }
- }
- }
-
- /* If possible, free extra space in old or extended chunk */
-
- assert((CHUNK_SIZE_T)(newsize) >= (CHUNK_SIZE_T)(nb));
-
- remainder_size = newsize - nb;
-
- if (remainder_size < MINSIZE) { /* not enough extra to split off */
- set_head_size(newp, newsize);
- set_inuse_bit_at_offset(newp, newsize);
- }
- else { /* split remainder */
- remainder = chunk_at_offset(newp, nb);
- set_head_size(newp, nb);
- set_head(remainder, remainder_size | PREV_INUSE);
- /* Mark remainder as inuse so free() won't complain */
- set_inuse_bit_at_offset(remainder, remainder_size);
- fREe(chunk2mem(remainder));
- }
-
- check_inuse_chunk(newp);
- return chunk2mem(newp);
- }
-
- /*
- Handle mmap cases
- */
-
- else {
-#if HAVE_MMAP
-
-# if HAVE_MREMAP
- INTERNAL_SIZE_T offset = oldp->prev_size;
- size_t pagemask = av->pagesize - 1;
- char *cp;
- CHUNK_SIZE_T sum;
-
- /* Note the extra SIZE_SZ overhead */
- newsize = (nb + offset + SIZE_SZ + pagemask) & ~pagemask;
-
- /* don't need to remap if still within same page */
- if (oldsize == newsize - offset)
- return oldmem;
-
- cp = (char*)mremap((char*)oldp - offset, oldsize + offset, newsize, 1);
-
- if (cp != (char*)MORECORE_FAILURE) {
-
- newp = (mchunkptr)(cp + offset);
- set_head(newp, (newsize - offset)|IS_MMAPPED);
-
- assert(aligned_OK(chunk2mem(newp)));
- assert((newp->prev_size == offset));
-
- /* update statistics */
- sum = av->mmapped_mem += newsize - oldsize;
- if (sum > (CHUNK_SIZE_T)(av->max_mmapped_mem))
- av->max_mmapped_mem = sum;
- sum += av->sbrked_mem;
- if (sum > (CHUNK_SIZE_T)(av->max_total_mem))
- av->max_total_mem = sum;
-
- return chunk2mem(newp);
- }
-# endif
-
- /* Note the extra SIZE_SZ overhead. */
- if ((CHUNK_SIZE_T)(oldsize) >= (CHUNK_SIZE_T)(nb + SIZE_SZ))
- newmem = oldmem; /* do nothing */
- else {
- /* Must alloc, copy, free. */
- newmem = mALLOc(nb - MALLOC_ALIGN_MASK);
- if (newmem != 0) {
- MALLOC_COPY(newmem, oldmem, oldsize - 2*SIZE_SZ);
- fREe(oldmem);
- }
- }
- return newmem;
-
-#else
- /* If !HAVE_MMAP, but chunk_is_mmapped, user must have overwritten mem */
- check_malloc_state();
- MALLOC_FAILURE_ACTION;
- return 0;
-#endif
- }
-}
-
-/*
- ------------------------------ memalign ------------------------------
-*/
-
-#if __STD_C
-Void_t* mEMALIGn(size_t alignment, size_t bytes)
-#else
-Void_t* mEMALIGn(alignment, bytes) size_t alignment; size_t bytes;
-#endif
-{
- INTERNAL_SIZE_T nb; /* padded request size */
- char* m; /* memory returned by malloc call */
- mchunkptr p; /* corresponding chunk */
- char* brk; /* alignment point within p */
- mchunkptr newp; /* chunk to return */
- INTERNAL_SIZE_T newsize; /* its size */
- INTERNAL_SIZE_T leadsize; /* leading space before alignment point */
- mchunkptr remainder; /* spare room at end to split off */
- CHUNK_SIZE_T remainder_size; /* its size */
- INTERNAL_SIZE_T size;
-
- /* If need less alignment than we give anyway, just relay to malloc */
-
- if (alignment <= MALLOC_ALIGNMENT)
- return mALLOc(bytes);
-
- /* Otherwise, ensure that it is at least a minimum chunk size */
-
- if (alignment < MINSIZE)
- alignment = MINSIZE;
-
- /* Make sure alignment is power of 2 (in case MINSIZE is not). */
- if ((alignment & (alignment - 1)) != 0) {
- size_t a = MALLOC_ALIGNMENT * 2;
- while ((CHUNK_SIZE_T)a < (CHUNK_SIZE_T)alignment)
- a <<= 1;
- alignment = a;
- }
-
- checked_request2size(bytes, nb);
-
- /*
- Strategy: find a spot within that chunk that meets the alignment
- request, and then possibly free the leading and trailing space.
- */
-
-
- /* Call malloc with worst case padding to hit alignment. */
-
- m = (char*)(mALLOc(nb + alignment + MINSIZE));
-
- if (m == 0)
- return 0; /* propagate failure */
-
- p = mem2chunk(m);
-
- if ((((PTR_UINT)(m)) % alignment) != 0) { /* misaligned */
-
- /*
- Find an aligned spot inside chunk. Since we need to give back
- leading space in a chunk of at least MINSIZE, if the first
- calculation places us at a spot with less than MINSIZE leader,
- we can move to the next aligned spot -- we've allocated enough
- total room so that this is always possible.
- */
-
- brk = (char*)mem2chunk((PTR_UINT)(((PTR_UINT)(m + alignment - 1)) &
- -((signed long) alignment)));
- if ((CHUNK_SIZE_T)(brk - (char*)(p)) < MINSIZE)
- brk += alignment;
-
- newp = (mchunkptr)brk;
- leadsize = brk - (char*)(p);
- newsize = chunksize(p) - leadsize;
-
- /* For mmapped chunks, just adjust offset */
- if (chunk_is_mmapped(p)) {
- newp->prev_size = p->prev_size + leadsize;
- set_head(newp, newsize|IS_MMAPPED);
- return chunk2mem(newp);
- }
-
- /* Otherwise, give back leader, use the rest */
- set_head(newp, newsize | PREV_INUSE);
- set_inuse_bit_at_offset(newp, newsize);
- set_head_size(p, leadsize);
- fREe(chunk2mem(p));
- p = newp;
-
- assert (newsize >= nb &&
- (((PTR_UINT)(chunk2mem(p))) % alignment) == 0);
- }
-
- /* Also give back spare room at the end */
- if (!chunk_is_mmapped(p)) {
- size = chunksize(p);
- if ((CHUNK_SIZE_T)(size) > (CHUNK_SIZE_T)(nb + MINSIZE)) {
- remainder_size = size - nb;
- remainder = chunk_at_offset(p, nb);
- set_head(remainder, remainder_size | PREV_INUSE);
- set_head_size(p, nb);
- fREe(chunk2mem(remainder));
- }
- }
-
- check_inuse_chunk(p);
- return chunk2mem(p);
-}
-
-/*
- ------------------------------ calloc ------------------------------
-*/
-
-#if __STD_C
-Void_t* cALLOc(size_t n_elements, size_t elem_size)
-#else
-Void_t* cALLOc(n_elements, elem_size) size_t n_elements; size_t elem_size;
-#endif
-{
- mchunkptr p;
- CHUNK_SIZE_T clearsize;
- CHUNK_SIZE_T nclears;
- INTERNAL_SIZE_T* d;
-
- Void_t* mem = mALLOc(n_elements * elem_size);
-
- if (mem != 0) {
- p = mem2chunk(mem);
-
- if (!chunk_is_mmapped(p))
- {
- /*
- Unroll clear of <= 36 bytes (72 if 8byte sizes)
- We know that contents have an odd number of
- INTERNAL_SIZE_T-sized words; minimally 3.
- */
-
- d = (INTERNAL_SIZE_T*)mem;
- clearsize = chunksize(p) - SIZE_SZ;
- nclears = clearsize / sizeof (INTERNAL_SIZE_T);
- assert(nclears >= 3);
-
- if (nclears > 9)
- MALLOC_ZERO(d, clearsize);
-
- else {
- *(d+0) = 0;
- *(d+1) = 0;
- *(d+2) = 0;
- if (nclears > 4) {
- *(d+3) = 0;
- *(d+4) = 0;
- if (nclears > 6) {
- *(d+5) = 0;
- *(d+6) = 0;
- if (nclears > 8) {
- *(d+7) = 0;
- *(d+8) = 0;
- }
- }
- }
- }
- }
-#if ! MMAP_CLEARS
- else
- {
- d = (INTERNAL_SIZE_T*)mem;
- /*
- Note the additional SIZE_SZ
- */
- clearsize = chunksize(p) - 2*SIZE_SZ;
- MALLOC_ZERO(d, clearsize);
- }
-#endif
- }
- return mem;
-}
-
-/*
- ------------------------------ cfree ------------------------------
-*/
-
-#if __STD_C
-void cFREe(Void_t *mem)
-#else
-void cFREe(mem) Void_t *mem;
-#endif
-{
- fREe(mem);
-}
-
-/*
- ------------------------- independent_calloc -------------------------
-*/
-
-#if __STD_C
-Void_t** iCALLOc(size_t n_elements, size_t elem_size, Void_t* chunks[])
-#else
-Void_t** iCALLOc(n_elements, elem_size, chunks) size_t n_elements;
- size_t elem_size;
- Void_t* chunks[];
-#endif
-{
- size_t sz = elem_size; /* serves as 1-element array */
- /* opts arg of 3 means all elements are same size, and should be cleared */
- return iALLOc(n_elements, &sz, 3, chunks);
-}
-
-/*
- ------------------------- independent_comalloc -------------------------
-*/
-
-#if __STD_C
-Void_t** iCOMALLOc(size_t n_elements, size_t sizes[], Void_t* chunks[])
-#else
-Void_t** iCOMALLOc(n_elements, sizes, chunks)
-size_t n_elements;
-size_t sizes[];
-Void_t* chunks[];
-#endif
-{
- return iALLOc(n_elements, sizes, 0, chunks);
-}
-
-
-/*
- ------------------------------ ialloc ------------------------------
- ialloc provides common support for independent_X routines, handling all of
- the combinations that can result.
-
- The opts arg has:
- bit 0 set if all elements are same size (using sizes[0])
- bit 1 set if elements should be zeroed
-*/
-
-
-#if __STD_C
-static Void_t** iALLOc(size_t n_elements,
- size_t* sizes,
- int opts,
- Void_t* chunks[])
-#else
-static Void_t** iALLOc(n_elements, sizes, opts, chunks) size_t n_elements;
- size_t* sizes;
- int opts;
- Void_t* chunks[];
-#endif
-{
- mstate av = get_malloc_state();
- INTERNAL_SIZE_T element_size; /* chunksize of each element, if all same */
- INTERNAL_SIZE_T contents_size; /* total size of elements */
- INTERNAL_SIZE_T array_size; /* request size of pointer array */
- Void_t* mem; /* malloced aggregate space */
- mchunkptr p; /* corresponding chunk */
- INTERNAL_SIZE_T remainder_size; /* remaining bytes while splitting */
- Void_t** marray; /* either "chunks" or malloced ptr array */
- mchunkptr array_chunk; /* chunk for malloced ptr array */
- int mmx; /* to disable mmap */
- INTERNAL_SIZE_T size;
- size_t i;
-
- /* Ensure initialization */
- if (av->max_fast == 0)
- malloc_consolidate(av);
-
- /* compute array length, if needed */
- if (chunks != 0) {
- if (n_elements == 0)
- return chunks; /* nothing to do */
- marray = chunks;
- array_size = 0;
- }
- else {
- /* if empty req, must still return chunk representing empty array */
- if (n_elements == 0)
- return (Void_t**) mALLOc(0);
- marray = 0;
- array_size = request2size(n_elements * (sizeof (Void_t*)));
- }
-
- /* compute total element size */
- if (opts & 0x1) { /* all-same-size */
- element_size = request2size(*sizes);
- contents_size = n_elements * element_size;
- }
- else { /* add up all the sizes */
- element_size = 0;
- contents_size = 0;
- for (i = 0; i != n_elements; ++i)
- contents_size += request2size(sizes[i]);
- }
-
- /* subtract out alignment bytes from total to minimize overallocation */
- size = contents_size + array_size - MALLOC_ALIGN_MASK;
-
- /*
- Allocate the aggregate chunk.
- But first disable mmap so malloc won't use it, since
- we would not be able to later free/realloc space internal
- to a segregated mmap region.
- */
- mmx = av->n_mmaps_max; /* disable mmap */
- av->n_mmaps_max = 0;
- mem = mALLOc(size);
- av->n_mmaps_max = mmx; /* reset mmap */
- if (mem == 0)
- return 0;
-
- p = mem2chunk(mem);
- assert(!chunk_is_mmapped(p));
- remainder_size = chunksize(p);
-
- if (opts & 0x2) { /* optionally clear the elements */
- MALLOC_ZERO(mem, remainder_size - SIZE_SZ - array_size);
- }
-
- /* If not provided, allocate the pointer array as final part of chunk */
- if (marray == 0) {
- array_chunk = chunk_at_offset(p, contents_size);
- marray = (Void_t**) (chunk2mem(array_chunk));
- set_head(array_chunk, (remainder_size - contents_size) | PREV_INUSE);
- remainder_size = contents_size;
- }
-
- /* split out elements */
- for (i = 0; ; ++i) {
- marray[i] = chunk2mem(p);
- if (i != n_elements-1) {
- if (element_size != 0)
- size = element_size;
- else
- size = request2size(sizes[i]);
- remainder_size -= size;
- set_head(p, size | PREV_INUSE);
- p = chunk_at_offset(p, size);
- }
- else { /* the final element absorbs any overallocation slop */
- set_head(p, remainder_size | PREV_INUSE);
- break;
- }
- }
-
-#if DEBUG
- if (marray != chunks) {
- /* final element must have exactly exhausted chunk */
- if (element_size != 0)
- assert(remainder_size == element_size);
- else
- assert(remainder_size == request2size(sizes[i]));
- check_inuse_chunk(mem2chunk(marray));
- }
-
- for (i = 0; i != n_elements; ++i)
- check_inuse_chunk(mem2chunk(marray[i]));
-#endif
-
- return marray;
-}
-
-
-/*
- ------------------------------ valloc ------------------------------
-*/
-
-#if __STD_C
-Void_t* vALLOc(size_t bytes)
-#else
-Void_t* vALLOc(bytes) size_t bytes;
-#endif
-{
- /* Ensure initialization */
- mstate av = get_malloc_state();
- if (av->max_fast == 0)
- malloc_consolidate(av);
- return mEMALIGn(av->pagesize, bytes);
-}
-
-/*
- ------------------------------ pvalloc ------------------------------
-*/
-
-
-#if __STD_C
-Void_t* pVALLOc(size_t bytes)
-#else
-Void_t* pVALLOc(bytes) size_t bytes;
-#endif
-{
- mstate av = get_malloc_state();
- size_t pagesz;
-
- /* Ensure initialization */
- if (av->max_fast == 0)
- malloc_consolidate(av);
- pagesz = av->pagesize;
- return mEMALIGn(pagesz, (bytes + pagesz - 1) & ~(pagesz - 1));
-}
-
-
-/*
- ------------------------------ malloc_trim ------------------------------
-*/
-
-#if __STD_C
-int mTRIm(size_t pad)
-#else
-int mTRIm(pad) size_t pad;
-#endif
-{
- mstate av = get_malloc_state();
- /* Ensure initialization/consolidation */
- malloc_consolidate(av);
-
-#ifndef MORECORE_CANNOT_TRIM
- return sYSTRIm(pad, av);
-#else
- return 0;
-#endif
-}
-
-
-/*
- ------------------------- malloc_usable_size -------------------------
-*/
-
-#if __STD_C
-size_t mUSABLe(Void_t* mem)
-#else
-size_t mUSABLe(mem) Void_t* mem;
-#endif
-{
- mchunkptr p;
- if (mem != 0) {
- p = mem2chunk(mem);
- if (chunk_is_mmapped(p))
- return chunksize(p) - 2*SIZE_SZ;
- else if (inuse(p))
- return chunksize(p) - SIZE_SZ;
- }
- return 0;
-}
-
-/*
- ------------------------------ mallinfo ------------------------------
-*/
-
-struct mallinfo mALLINFo()
-{
- mstate av = get_malloc_state();
- struct mallinfo mi;
- int i;
- mbinptr b;
- mchunkptr p;
- INTERNAL_SIZE_T avail;
- INTERNAL_SIZE_T fastavail;
- int nblocks;
- int nfastblocks;
-
- /* Ensure initialization */
- if (av->top == 0)
- malloc_consolidate(av);
-
- check_malloc_state();
-
- /* Account for top */
- avail = chunksize(av->top);
- nblocks = 1; /* top always exists */
-
- /* traverse fastbins */
- nfastblocks = 0;
- fastavail = 0;
-
- for (i = 0; i < NFASTBINS; ++i) {
- for (p = av->fastbins[i]; p != 0; p = p->fd) {
- ++nfastblocks;
- fastavail += chunksize(p);
- }
- }
-
- avail += fastavail;
-
- /* traverse regular bins */
- for (i = 1; i < NBINS; ++i) {
- b = bin_at(av, i);
- for (p = last(b); p != b; p = p->bk) {
- ++nblocks;
- avail += chunksize(p);
- }
- }
-
- mi.smblks = nfastblocks;
- mi.ordblks = nblocks;
- mi.fordblks = avail;
- mi.uordblks = av->sbrked_mem - avail;
- mi.arena = av->sbrked_mem;
- mi.hblks = av->n_mmaps;
- mi.hblkhd = av->mmapped_mem;
- mi.fsmblks = fastavail;
- mi.keepcost = chunksize(av->top);
- mi.usmblks = av->max_total_mem;
- return mi;
-}
-
-/*
- ------------------------------ malloc_stats ------------------------------
-*/
-
-void mSTATs()
-{
- struct mallinfo mi = mALLINFo();
-
-#ifdef WIN32
- {
- CHUNK_SIZE_T free, reserved, committed;
- vminfo (&free, &reserved, &committed);
- Parrot_io_eprintf(NULL, "free bytes = %10lu\n",
- free);
- Parrot_io_eprintf(NULL, "reserved bytes = %10lu\n",
- reserved);
- Parrot_io_eprintf(NULL, "committed bytes = %10lu\n",
- committed);
- }
-#endif
-
-
- Parrot_io_eprintf(NULL, "max system bytes = %10lu\n",
- (CHUNK_SIZE_T)(mi.usmblks));
- Parrot_io_eprintf(NULL, "system bytes = %10lu\n",
- (CHUNK_SIZE_T)(mi.arena + mi.hblkhd));
- Parrot_io_eprintf(NULL, "in use bytes = %10lu\n",
- (CHUNK_SIZE_T)(mi.uordblks + mi.hblkhd));
-
-#ifdef WIN32
- {
- CHUNK_SIZE_T kernel, user;
- if (cpuinfo (TRUE, &kernel, &user)) {
- Parrot_io_eprintf(NULL, "kernel ms = %10lu\n",
- kernel);
- Parrot_io_eprintf(NULL, "user ms = %10lu\n",
- user);
- }
- }
-#endif
-}
-
-
-/*
- ------------------------------ mallopt ------------------------------
-*/
-
-#if __STD_C
-int mALLOPt(int param_number, int value)
-#else
-int mALLOPt(param_number, value) int param_number; int value;
-#endif
-{
- mstate av = get_malloc_state();
- /* Ensure initialization/consolidation */
- malloc_consolidate(av);
-
- switch (param_number) {
- case M_MXFAST:
- if (value >= 0 && value <= MAX_FAST_SIZE) {
- set_max_fast(av, value);
- return 1;
- }
- else
- return 0;
-
- case M_TRIM_THRESHOLD:
- av->trim_threshold = value;
- return 1;
-
- case M_TOP_PAD:
- av->top_pad = value;
- return 1;
-
- case M_MMAP_THRESHOLD:
- av->mmap_threshold = value;
- return 1;
-
- case M_MMAP_MAX:
-#if !HAVE_MMAP
- if (value != 0)
- return 0;
-#endif
- av->n_mmaps_max = value;
- return 1;
-
- default:
- return 0;
- }
-}
-
-
-/*
- -------------------- Alternative MORECORE functions --------------------
-*/
-
-
-/*
- General Requirements for MORECORE.
-
- The MORECORE function must have the following properties:
-
- If MORECORE_CONTIGUOUS is false:
-
- * MORECORE must allocate in multiples of pagesize. It will
- only be called with arguments that are multiples of pagesize.
-
- * MORECORE(0) must return an address that is at least
- MALLOC_ALIGNMENT aligned. (Page-aligning always suffices.)
-
- else (i.e. If MORECORE_CONTIGUOUS is true):
-
- * Consecutive calls to MORECORE with positive arguments
- return increasing addresses, indicating that space has been
- contiguously extended.
-
- * MORECORE need not allocate in multiples of pagesize.
- Calls to MORECORE need not have args of multiples of pagesize.
-
- * MORECORE need not page-align.
-
- In either case:
-
- * MORECORE may allocate more memory than requested. (Or even less,
- but this will generally result in a malloc failure.)
-
- * MORECORE must not allocate memory when given argument zero, but
- instead return one past the end address of memory from previous
- nonzero call. This malloc does NOT call MORECORE(0)
- until at least one call with positive arguments is made, so
- the initial value returned is not important.
-
- * Even though consecutive calls to MORECORE need not return contiguous
- addresses, it must be OK for malloc'ed chunks to span multiple
- regions in those cases where they do happen to be contiguous.
-
- * MORECORE need not handle negative arguments -- it may instead
- just return MORECORE_FAILURE when given negative arguments.
- Negative arguments are always multiples of pagesize. MORECORE
- must not misinterpret negative args as large positive unsigned
- args. You can suppress all such calls from even occurring by defining
- MORECORE_CANNOT_TRIM,
-
- There is some variation across systems about the type of the
- argument to sbrk/MORECORE. If size_t is unsigned, then it cannot
- actually be size_t, because sbrk supports negative args, so it is
- normally the signed type of the same width as size_t (sometimes
- declared as "intptr_t", and sometimes "ptrdiff_t"). It doesn't much
- matter though. Internally, we use "long" as arguments, which should
- work across all reasonable possibilities.
-
- Additionally, if MORECORE ever returns failure for a positive
- request, and HAVE_MMAP is true, then mmap is used as a noncontiguous
- system allocator. This is a useful backup strategy for systems with
- holes in address spaces -- in this case sbrk cannot contiguously
- expand the heap, but mmap may be able to map noncontiguous space.
-
- If you'd like mmap to ALWAYS be used, you can define MORECORE to be
- a function that always returns MORECORE_FAILURE.
-
- Malloc only has limited ability to detect failures of MORECORE
- to supply contiguous space when it says it can. In particular,
- multithreaded programs that do not use locks may result in
- rece conditions across calls to MORECORE that result in gaps
- that cannot be detected as such, and subsequent corruption.
-
- If you are using this malloc with something other than sbrk (or its
- emulation) to supply memory regions, you probably want to set
- MORECORE_CONTIGUOUS as false. As an example, here is a custom
- allocator kindly contributed for pre-OSX macOS. It uses virtually
- but not necessarily physically contiguous non-paged memory (locked
- in, present and won't get swapped out). You can use it by
- uncommenting this section, adding some #includes, and setting up the
- appropriate defines above:
-
- #define MORECORE osMoreCore
- #define MORECORE_CONTIGUOUS 0
-
- There is also a shutdown routine that should somehow be called for
- cleanup upon program exit.
-
- #define MAX_POOL_ENTRIES 100
- #define MINIMUM_MORECORE_SIZE (64 * 1024)
- static int next_os_pool;
- void *our_os_pools[MAX_POOL_ENTRIES];
-
- void *osMoreCore(int size)
- {
- void *ptr = 0;
- static void *sbrk_top = 0;
-
- if (size > 0)
- {
- if (size < MINIMUM_MORECORE_SIZE)
- size = MINIMUM_MORECORE_SIZE;
- if (CurrentExecutionLevel() == kTaskLevel)
- ptr = PoolAllocateResident(size + RM_PAGE_SIZE, 0);
- if (ptr == 0)
- {
- return (void *) MORECORE_FAILURE;
- }
- / / save ptrs so they can be freed during cleanup
- our_os_pools[next_os_pool] = ptr;
- next_os_pool++;
- ptr = (void *) ((((CHUNK_SIZE_T) ptr) + RM_PAGE_MASK) & ~RM_PAGE_MASK);
- sbrk_top = (char *) ptr + size;
- return ptr;
- }
- else if (size < 0)
- {
- / / we don't currently support shrink behavior
- return (void *) MORECORE_FAILURE;
- }
- else
- {
- return sbrk_top;
- }
- }
-
- / / cleanup any allocated memory pools
- / / called as last thing before shutting down driver
-
- void osCleanupMem(void)
- {
- void **ptr;
-
- for (ptr = our_os_pools; ptr < &our_os_pools[MAX_POOL_ENTRIES]; ptr++)
- if (*ptr)
- {
- PoolDeallocate(*ptr);
- *ptr = 0;
- }
- }
-
-*/
-
-
-/*
- --------------------------------------------------------------
-
- Emulation of sbrk for win32.
- Donated by J. Walter <Walter at GeNeSys-e.de>.
- For additional information about this code, and malloc on Win32, see
- http://www.genesys-e.de/jwalter/
-*/
-
-
-#ifdef WIN32
-
-# ifdef _DEBUG
-/* #define TRACE */
-# endif
-
-/* Support for USE_MALLOC_LOCK */
-# ifdef USE_MALLOC_LOCK
-
-/* Wait for spin lock */
-static int slwait (int *sl) {
- while (InterlockedCompareExchange ((void **) sl,
- (void *) 1,
- (void *) 0) != 0)
- Sleep (0);
- return 0;
-}
-
-/* Release spin lock */
-static int slrelease (int *sl) {
- InterlockedExchange (sl, 0);
- return 0;
-}
-
-# ifdef NEEDED
-/* Spin lock for emulation code */
-static int g_sl;
-# endif
-
-# endif /* USE_MALLOC_LOCK */
-
-/* getpagesize for windows */
-static long getpagesize (void) {
- static long g_pagesize = 0;
- if (! g_pagesize) {
- SYSTEM_INFO system_info;
- GetSystemInfo (&system_info);
- g_pagesize = system_info.dwPageSize;
- }
- return g_pagesize;
-}
-static long getregionsize (void) {
- static long g_regionsize = 0;
- if (! g_regionsize) {
- SYSTEM_INFO system_info;
- GetSystemInfo (&system_info);
- g_regionsize = system_info.dwAllocationGranularity;
- }
- return g_regionsize;
-}
-
-/* A region list entry */
-typedef struct _region_list_entry {
- void *top_allocated;
- void *top_committed;
- void *top_reserved;
- long reserve_size;
- struct _region_list_entry *previous;
-} region_list_entry;
-
-/* Allocate and link a region entry in the region list */
-static int region_list_append (region_list_entry **last,
- void *base_reserved, long reserve_size) {
- region_list_entry *next = HeapAlloc (GetProcessHeap (), 0,
- sizeof (region_list_entry));
- if (! next)
- return FALSE;
- next->top_allocated = (char *) base_reserved;
- next->top_committed = (char *) base_reserved;
- next->top_reserved = (char *) base_reserved + reserve_size;
- next->reserve_size = reserve_size;
- next->previous = *last;
- *last = next;
- return TRUE;
-}
-/* Free and unlink the last region entry from the region list */
-static int region_list_remove (region_list_entry **last) {
- region_list_entry *previous = (*last)->previous;
- if (! HeapFree (GetProcessHeap (), sizeof (region_list_entry), *last))
- return FALSE;
- *last = previous;
- return TRUE;
-}
-
-# define CEIL(size,to) (((size)+(to)-1)&~((to)-1))
-# define FLOOR(size,to) ((size)&~((to)-1))
-
-# define SBRK_SCALE 0
-/* #define SBRK_SCALE 1 */
-/* #define SBRK_SCALE 2 */
-/* #define SBRK_SCALE 4 */
-
-/* sbrk for windows */
-static void *sbrk (long size) {
- static long g_pagesize, g_my_pagesize;
- static long g_regionsize, g_my_regionsize;
- static region_list_entry *g_last;
- void *result = (void *) MORECORE_FAILURE;
-# ifdef TRACE
- Parrot_io_printf (NULL, "sbrk %d\n", size);
-# endif
-# if defined (USE_MALLOC_LOCK) && defined (NEEDED)
- /* Wait for spin lock */
- slwait (&g_sl);
-# endif
- /* First time initialization */
- if (! g_pagesize) {
- g_pagesize = getpagesize ();
- g_my_pagesize = g_pagesize << SBRK_SCALE;
- }
- if (! g_regionsize) {
- g_regionsize = getregionsize ();
- g_my_regionsize = g_regionsize << SBRK_SCALE;
- }
- if (! g_last) {
- if (! region_list_append (&g_last, 0, 0))
- goto sbrk_exit;
- }
- /* Assert invariants */
- assert (g_last);
- assert ((char *) g_last->top_reserved - g_last->reserve_size
- <= (char *) g_last->top_allocated &&
- g_last->top_allocated <= g_last->top_committed);
- assert ((char *) g_last->top_reserved - g_last->reserve_size
- <= (char *) g_last->top_committed &&
- g_last->top_committed <= g_last->top_reserved &&
- (unsigned) g_last->top_committed % g_pagesize == 0);
- assert ((unsigned) g_last->top_reserved % g_regionsize == 0);
- assert ((unsigned) g_last->reserve_size % g_regionsize == 0);
- /* Allocation requested? */
- if (size >= 0) {
- /* Allocation size is the requested size */
- long allocate_size = size;
- /* Compute the size to commit */
- long to_commit = (char *) g_last->top_allocated + allocate_size -
- (char *) g_last->top_committed;
- /* Do we reach the commit limit? */
- if (to_commit > 0) {
- /* Round size to commit */
- long commit_size = CEIL (to_commit, g_my_pagesize);
- /* Compute the size to reserve */
- long to_reserve = (char *) g_last->top_committed + commit_size -
- (char *) g_last->top_reserved;
- /* Do we reach the reserve limit? */
- if (to_reserve > 0) {
- /* Compute the remaining size to commit in the current region */
- long remaining_commit_size = (char *) g_last->top_reserved -
- (char *) g_last->top_committed;
- if (remaining_commit_size > 0) {
- /* Assert preconditions */
- assert ((unsigned) g_last->top_committed % g_pagesize == 0);
- assert (0 < remaining_commit_size &&
- remaining_commit_size % g_pagesize == 0); {
- /* Commit this */
- void *base_committed =
- VirtualAlloc(g_last->top_committed,
- remaining_commit_size,
- MEM_COMMIT, PAGE_READWRITE);
- /* Check returned pointer for consistency */
- if (base_committed != g_last->top_committed)
- goto sbrk_exit;
- /* Assert postconditions */
- assert ((unsigned) base_committed % g_pagesize == 0);
-# ifdef TRACE
- Parrot_io_printf (NULL, "Commit %p %d\n", base_committed,
- remaining_commit_size);
-# endif
- /* Adjust the regions commit top */
- g_last->top_committed = (char *) base_committed +
- remaining_commit_size;
- }
- } {
- /* Now we are going to search and reserve. */
- int contiguous = -1;
- int found = FALSE;
- MEMORY_BASIC_INFORMATION memory_info;
- void *base_reserved;
- long reserve_size;
- do {
- /* Assume contiguous memory */
- contiguous = TRUE;
- /* Round size to reserve */
- reserve_size = CEIL (to_reserve, g_my_regionsize);
- /* Start with the current region's top */
- memory_info.BaseAddress = g_last->top_reserved;
- /* Assert preconditions */
- assert ((unsigned) memory_info.BaseAddress %
- g_pagesize == 0);
- assert (0 < reserve_size && reserve_size %
- g_regionsize == 0);
- while (VirtualQuery (memory_info.BaseAddress,
- &memory_info,
- sizeof (memory_info))) {
- /* Assert postconditions */
- assert ((unsigned) memory_info.BaseAddress %
- g_pagesize == 0);
-# ifdef TRACE
- Parrot_io_printf (NULL, "Query %p %d %s\n",
- memory_info.BaseAddress,
- memory_info.RegionSize,
- memory_info.State == MEM_FREE ? "FREE":
- (memory_info.State == MEM_RESERVE ?
- "RESERVED":
- (memory_info.State == MEM_COMMIT ?
- "COMMITTED": "?")));
-# endif
- /* Region is free, well aligned and big
- * enough: we are done */
- if (memory_info.State == MEM_FREE &&
- (unsigned) memory_info.BaseAddress %
- g_regionsize == 0
- &&
- memory_info.RegionSize >= (unsigned)
- reserve_size) {
- found = TRUE;
- break;
- }
- /* From now on we can't get contiguous memory! */
- contiguous = FALSE;
- /* Recompute size to reserve */
- reserve_size = CEIL (allocate_size,
- g_my_regionsize);
- memory_info.BaseAddress =
- (char *) memory_info.BaseAddress +
- memory_info.RegionSize;
- /* Assert preconditions */
- assert ((unsigned) memory_info.BaseAddress
- % g_pagesize == 0);
- assert (0 < reserve_size && reserve_size
- % g_regionsize == 0);
- }
- /* Search failed? */
- if (! found)
- goto sbrk_exit;
- /* Assert preconditions */
- assert ((unsigned) memory_info.BaseAddress
- % g_regionsize == 0);
- assert (0 < reserve_size && reserve_size
- % g_regionsize == 0);
- /* Try to reserve this */
- base_reserved = VirtualAlloc (memory_info.BaseAddress,
- reserve_size,
- MEM_RESERVE,
- PAGE_NOACCESS);
- if (! base_reserved) {
- int rc = GetLastError ();
- if (rc != ERROR_INVALID_ADDRESS)
- goto sbrk_exit;
- }
- /* A null pointer signals (hopefully) a race
- * condition with another thread. */
- /* In this case, we try again. */
- } while (! base_reserved);
- /* Check returned pointer for consistency */
- if (memory_info.BaseAddress &&
- base_reserved != memory_info.BaseAddress)
- goto sbrk_exit;
- /* Assert postconditions */
- assert ((unsigned) base_reserved % g_regionsize == 0);
-# ifdef TRACE
- Parrot_io_printf (NULL, "Reserve %p %d\n", base_reserved,
- reserve_size);
-# endif
- /* Did we get contiguous memory? */
- if (contiguous) {
- long start_size = (char *) g_last->top_committed -
- (char *) g_last->top_allocated;
- /* Adjust allocation size */
- allocate_size -= start_size;
- /* Adjust the regions allocation top */
- g_last->top_allocated = g_last->top_committed;
- /* Recompute the size to commit */
- to_commit = (char *) g_last->top_allocated +
- allocate_size - (char *) g_last->top_committed;
- /* Round size to commit */
- commit_size = CEIL (to_commit, g_my_pagesize);
- }
- /* Append the new region to the list */
- if (! region_list_append (&g_last, base_reserved,
- reserve_size))
- goto sbrk_exit;
- /* Didn't we get contiguous memory? */
- if (! contiguous) {
- /* Recompute the size to commit */
- to_commit = (char *) g_last->top_allocated +
- allocate_size - (char *) g_last->top_committed;
- /* Round size to commit */
- commit_size = CEIL (to_commit, g_my_pagesize);
- }
- }
- }
- /* Assert preconditions */
- assert ((unsigned) g_last->top_committed % g_pagesize == 0);
- assert (0 < commit_size && commit_size % g_pagesize == 0); {
- /* Commit this */
- void *base_committed = VirtualAlloc (g_last->top_committed,
- commit_size,
- MEM_COMMIT,
- PAGE_READWRITE);
- /* Check returned pointer for consistency */
- if (base_committed != g_last->top_committed)
- goto sbrk_exit;
- /* Assert postconditions */
- assert ((unsigned) base_committed % g_pagesize == 0);
-# ifdef TRACE
- Parrot_io_printf(NULL, "Commit %p %d\n", base_committed, commit_size);
-# endif
- /* Adjust the regions commit top */
- g_last->top_committed = (char *) base_committed + commit_size;
- }
- }
- /* Adjust the regions allocation top */
- g_last->top_allocated = (char *) g_last->top_allocated + allocate_size;
- result = (char *) g_last->top_allocated - size;
- /* Deallocation requested? */
- }
- else if (size < 0) {
- long deallocate_size = - size;
- /* As long as we have a region to release */
- while ((char *) g_last->top_allocated - deallocate_size
- < (char *) g_last->top_reserved - g_last->reserve_size) {
- /* Get the size to release */
- long release_size = g_last->reserve_size;
- /* Get the base address */
- void *base_reserved = (char *) g_last->top_reserved - release_size;
- /* Assert preconditions */
- assert ((unsigned) base_reserved % g_regionsize == 0);
- assert (0 < release_size && release_size % g_regionsize == 0); {
- /* Release this */
- int rc = VirtualFree (base_reserved, 0,
- MEM_RELEASE);
- /* Check returned code for consistency */
- if (! rc)
- goto sbrk_exit;
-# ifdef TRACE
- Parrot_io_printf(NULL, "Release %p %d\n", base_reserved,release_size);
-# endif
- }
- /* Adjust deallocation size */
- deallocate_size -=
- (char *) g_last->top_allocated - (char *) base_reserved;
- /* Remove the old region from the list */
- if (! region_list_remove (&g_last))
- goto sbrk_exit;
- } {
- /* Compute the size to decommit */
- long to_decommit = (char *) g_last->top_committed -
- ((char *) g_last->top_allocated - deallocate_size);
- if (to_decommit >= g_my_pagesize) {
- /* Compute the size to decommit */
- long decommit_size = FLOOR (to_decommit, g_my_pagesize);
- /* Compute the base address */
- void *base_committed = (char *) g_last->top_committed -
- decommit_size;
- /* Assert preconditions */
- assert ((unsigned) base_committed % g_pagesize == 0);
- assert (0 < decommit_size && decommit_size % g_pagesize == 0); {
- /* Decommit this */
- int rc = VirtualFree((char *) base_committed, decommit_size,
- MEM_DECOMMIT);
- /* Check returned code for consistency */
- if (! rc)
- goto sbrk_exit;
-# ifdef TRACE
- Parrot_io_printf (NULL, "Decommit %p %d\n",
- base_committed, decommit_size);
-# endif
- }
- /* Adjust deallocation size and regions commit and
- * allocate top */
- deallocate_size -= (char *) g_last->top_allocated -
- (char *) base_committed;
- g_last->top_committed = base_committed;
- g_last->top_allocated = base_committed;
- }
- }
- /* Adjust regions allocate top */
- g_last->top_allocated = (char *)g_last->top_allocated - deallocate_size;
- /* Check for underflow */
- if ((char *) g_last->top_reserved - g_last->reserve_size
- > (char *) g_last->top_allocated ||
- g_last->top_allocated > g_last->top_committed) {
- /* Adjust regions allocate top */
- g_last->top_allocated = (char *) g_last->top_reserved
- - g_last->reserve_size;
- goto sbrk_exit;
- }
- result = g_last->top_allocated;
- }
- /* Assert invariants */
- assert (g_last);
- assert ((char *) g_last->top_reserved - g_last->reserve_size
- <= (char *) g_last->top_allocated &&
- g_last->top_allocated <= g_last->top_committed);
- assert ((char *) g_last->top_reserved - g_last->reserve_size
- <= (char *) g_last->top_committed &&
- g_last->top_committed <= g_last->top_reserved &&
- (unsigned) g_last->top_committed % g_pagesize == 0);
- assert ((unsigned) g_last->top_reserved % g_regionsize == 0);
- assert ((unsigned) g_last->reserve_size % g_regionsize == 0);
-
-sbrk_exit:
-# if defined (USE_MALLOC_LOCK) && defined (NEEDED)
- /* Release spin lock */
- slrelease (&g_sl);
-# endif
- return result;
-}
-
-/* mmap for windows */
-static void *mmap (void *ptr, long size, long prot, long type,
- long handle, long arg) {
- static long g_pagesize;
- static long g_regionsize;
-# ifdef TRACE
- Parrot_io_printf (NULL, "mmap %d\n", size);
-# endif
-# if defined (USE_MALLOC_LOCK) && defined (NEEDED)
- /* Wait for spin lock */
- slwait (&g_sl);
-# endif
- /* First time initialization */
- if (! g_pagesize)
- g_pagesize = getpagesize ();
- if (! g_regionsize)
- g_regionsize = getregionsize ();
- /* Assert preconditions */
- assert ((unsigned) ptr % g_regionsize == 0);
- assert (size % g_pagesize == 0);
- /* Allocate this */
- ptr = VirtualAlloc (ptr, size,
- MEM_RESERVE | MEM_COMMIT | MEM_TOP_DOWN, PAGE_READWRITE);
- if (! ptr) {
- ptr = (void *) MORECORE_FAILURE;
- goto mmap_exit;
- }
- /* Assert postconditions */
- assert ((unsigned) ptr % g_regionsize == 0);
-# ifdef TRACE
- Parrot_io_printf (NULL, "Commit %p %d\n", ptr, size);
-# endif
-mmap_exit:
-# if defined (USE_MALLOC_LOCK) && defined (NEEDED)
- /* Release spin lock */
- slrelease (&g_sl);
-# endif
- return ptr;
-}
-
-/* munmap for windows */
-static long munmap (void *ptr, long size) {
- static long g_pagesize;
- static long g_regionsize;
- int rc = MUNMAP_FAILURE;
-# ifdef TRACE
- Parrot_io_printf (NULL, "munmap %p %d\n", ptr, size);
-# endif
-# if defined (USE_MALLOC_LOCK) && defined (NEEDED)
- /* Wait for spin lock */
- slwait (&g_sl);
-# endif
- /* First time initialization */
- if (! g_pagesize)
- g_pagesize = getpagesize ();
- if (! g_regionsize)
- g_regionsize = getregionsize ();
- /* Assert preconditions */
- assert ((unsigned) ptr % g_regionsize == 0);
- assert (size % g_pagesize == 0);
- /* Free this */
- if (! VirtualFree (ptr, 0,
- MEM_RELEASE))
- goto munmap_exit;
- rc = 0;
-# ifdef TRACE
- Parrot_io_printf (NULL, "Release %p %d\n", ptr, size);
-# endif
-munmap_exit:
-# if defined (USE_MALLOC_LOCK) && defined (NEEDED)
- /* Release spin lock */
- slrelease (&g_sl);
-# endif
- return rc;
-}
-
-static void vminfo (CHUNK_SIZE_T *free, CHUNK_SIZE_T *reserved,
- CHUNK_SIZE_T *committed) {
- MEMORY_BASIC_INFORMATION memory_info;
- memory_info.BaseAddress = 0;
- *free = *reserved = *committed = 0;
- while (VirtualQuery (memory_info.BaseAddress, &memory_info,
- sizeof (memory_info))) {
- switch (memory_info.State) {
- case MEM_FREE:
- *free += memory_info.RegionSize;
- break;
- case MEM_RESERVE:
- *reserved += memory_info.RegionSize;
- break;
- case MEM_COMMIT:
- *committed += memory_info.RegionSize;
- break;
- }
- memory_info.BaseAddress = (char *) memory_info.BaseAddress +
- memory_info.RegionSize;
- }
-}
-
-static int cpuinfo (int whole, CHUNK_SIZE_T *kernel, CHUNK_SIZE_T *user) {
- if (whole) {
- __int64 creation64, exit64, kernel64, user64;
- int rc = GetProcessTimes (GetCurrentProcess (),
- (FILETIME *) &creation64,
- (FILETIME *) &exit64,
- (FILETIME *) &kernel64,
- (FILETIME *) &user64);
- if (! rc) {
- *kernel = 0;
- *user = 0;
- return FALSE;
- }
- *kernel = (CHUNK_SIZE_T) (kernel64 / 10000);
- *user = (CHUNK_SIZE_T) (user64 / 10000);
- return TRUE;
- }
- else {
- __int64 creation64, exit64, kernel64, user64;
- int rc = GetThreadTimes (GetCurrentThread (),
- (FILETIME *) &creation64,
- (FILETIME *) &exit64,
- (FILETIME *) &kernel64,
- (FILETIME *) &user64);
- if (! rc) {
- *kernel = 0;
- *user = 0;
- return FALSE;
- }
- *kernel = (CHUNK_SIZE_T) (kernel64 / 10000);
- *user = (CHUNK_SIZE_T) (user64 / 10000);
- return TRUE;
- }
-}
-
-#endif /* WIN32 */
-
-/* ------------------------------------------------------------
-History:
- V2.7.2 Sat Aug 17 09:07:30 2002 Doug Lea (dl at gee)
- * Fix malloc_state bitmap array misdeclaration
-
- V2.7.1 Thu Jul 25 10:58:03 2002 Doug Lea (dl at gee)
- * Allow tuning of FIRST_SORTED_BIN_SIZE
- * Use PTR_UINT as type for all ptr->int casts. Thanks to John Belmonte.
- * Better detection and support for non-contiguousness of MORECORE.
- Thanks to Andreas Mueller, Conal Walsh, and Wolfram Gloger
- * Bypass most of malloc if no frees. Thanks To Emery Berger.
- * Fix freeing of old top non-contiguous chunk im sysmalloc.
- * Raised default trim and map thresholds to 256K.
- * Fix mmap-related #defines. Thanks to Lubos Lunak.
- * Fix copy macros; added LACKS_FCNTL_H. Thanks to Neal Walfield.
- * Branch-free bin calculation
- * Default trim and mmap thresholds now 256K.
-
- V2.7.0 Sun Mar 11 14:14:06 2001 Doug Lea (dl at gee)
- * Introduce independent_comalloc and independent_calloc.
- Thanks to Michael Pachos for motivation and help.
- * Make optional .h file available
- * Allow > 2GB requests on 32bit systems.
- * new WIN32 sbrk, mmap, munmap, lock code from <Walter at GeNeSys-e.de>.
- Thanks also to Andreas Mueller <a.mueller at paradatec.de>,
- and Anonymous.
- * Allow override of MALLOC_ALIGNMENT (Thanks to Ruud Waij for
- helping test this.)
- * memalign: check alignment arg
- * realloc: don't try to shift chunks backwards, since this
- leads to more fragmentation in some programs and doesn't
- seem to help in any others.
- * Collect all cases in malloc requiring system memory into sYSMALLOc
- * Use mmap as backup to sbrk
- * Place all internal state in malloc_state
- * Introduce fastbins (although similar to 2.5.1)
- * Many minor tunings and cosmetic improvements
- * Introduce USE_PUBLIC_MALLOC_WRAPPERS, USE_MALLOC_LOCK
- * Introduce MALLOC_FAILURE_ACTION, MORECORE_CONTIGUOUS
- Thanks to Tony E. Bennett <tbennett at nvidia.com> and others.
- * Include errno.h to support default failure action.
-
- V2.6.6 Sun Dec 5 07:42:19 1999 Doug Lea (dl at gee)
- * return null for negative arguments
- * Added Several WIN32 cleanups from Martin C. Fong <mcfong at yahoo.com>
- * Add 'LACKS_SYS_PARAM_H' for those systems without 'sys/param.h'
- (e.g. WIN32 platforms)
- * Cleanup header file inclusion for WIN32 platforms
- * Cleanup code to avoid Microsoft Visual C++ compiler complaints
- * Add 'USE_DL_PREFIX' to quickly allow co-existence with existing
- memory allocation routines
- * Set 'malloc_getpagesize' for WIN32 platforms (needs more work)
- * Use 'assert' rather than 'ASSERT' in WIN32 code to conform to
- usage of 'assert' in non-WIN32 code
- * Improve WIN32 'sbrk()' emulation's 'findRegion()' routine to
- avoid infinite loop
- * Always call 'fREe()' rather than 'free()'
-
- V2.6.5 Wed Jun 17 15:57:31 1998 Doug Lea (dl at gee)
- * Fixed ordering problem with boundary-stamping
-
- V2.6.3 Sun May 19 08:17:58 1996 Doug Lea (dl at gee)
- * Added pvalloc, as recommended by H.J. Liu
- * Added 64bit pointer support mainly from Wolfram Gloger
- * Added anonymously donated WIN32 sbrk emulation
- * Malloc, calloc, getpagesize: add optimizations from Raymond Nijssen
- * malloc_extend_top: fix mask error that caused wastage after
- foreign sbrks
- * Add linux mremap support code from HJ Liu
-
- V2.6.2 Tue Dec 5 06:52:55 1995 Doug Lea (dl at gee)
- * Integrated most documentation with the code.
- * Add support for mmap, with help from
- Wolfram Gloger (Gloger at lrz.uni-muenchen.de).
- * Use last_remainder in more cases.
- * Pack bins using idea from colin at nyx10.cs.du.edu
- * Use ordered bins instead of best-fit threshold
- * Eliminate block-local decls to simplify tracing and debugging.
- * Support another case of realloc via move into top
- * Fix error occurring when initial sbrk_base not word-aligned.
- * Rely on page size for units instead of SBRK_UNIT to
- avoid surprises about sbrk alignment conventions.
- * Add mallinfo, mallopt. Thanks to Raymond Nijssen
- (raymond at es.ele.tue.nl) for the suggestion.
- * Add `pad' argument to malloc_trim and top_pad mallopt parameter.
- * More precautions for cases where other routines call sbrk,
- courtesy of Wolfram Gloger (Gloger at lrz.uni-muenchen.de).
- * Added macros etc., allowing use in linux libc from
- H.J. Lu (hjl at gnu.ai.mit.edu)
- * Inverted this history list
-
- V2.6.1 Sat Dec 2 14:10:57 1995 Doug Lea (dl at gee)
- * Re-tuned and fixed to behave more nicely with V2.6.0 changes.
- * Removed all preallocation code since under current scheme
- the work required to undo bad preallocations exceeds
- the work saved in good cases for most test programs.
- * No longer use return list or unconsolidated bins since
- no scheme using them consistently outperforms those that don't
- given above changes.
- * Use best fit for very large chunks to prevent some worst-cases.
- * Added some support for debugging
-
- V2.6.0 Sat Nov 4 07:05:23 1995 Doug Lea (dl at gee)
- * Removed footers when chunks are in use. Thanks to
- Paul Wilson (wilson at cs.texas.edu) for the suggestion.
-
- V2.5.4 Wed Nov 1 07:54:51 1995 Doug Lea (dl at gee)
- * Added malloc_trim, with help from Wolfram Gloger
- (wmglo at Dent.MED.Uni-Muenchen.DE).
-
- V2.5.3 Tue Apr 26 10:16:01 1994 Doug Lea (dl at g)
-
- V2.5.2 Tue Apr 5 16:20:40 1994 Doug Lea (dl at g)
- * realloc: try to expand in both directions
- * malloc: swap order of clean-bin strategy;
- * realloc: only conditionally expand backwards
- * Try not to scavenge used bins
- * Use bin counts as a guide to preallocation
- * Occasionally bin return list chunks in first scan
- * Add a few optimizations from colin at nyx10.cs.du.edu
-
- V2.5.1 Sat Aug 14 15:40:43 1993 Doug Lea (dl at g)
- * faster bin computation & slightly different binning
- * merged all consolidations to one part of malloc proper
- (eliminating old malloc_find_space & malloc_clean_bin)
- * Scan 2 returns chunks (not just 1)
- * Propagate failure in realloc if malloc returns 0
- * Add stuff to allow compilation on non-ANSI compilers
- from kpv at research.att.com
-
- V2.5 Sat Aug 7 07:41:59 1993 Doug Lea (dl at g.oswego.edu)
- * removed potential for odd address access in prev_chunk
- * removed dependency on getpagesize.h
- * misc cosmetics and a bit more internal documentation
- * anticosmetics: mangled names in macros to evade debugger strangeness
- * tested on sparc, hp-700, dec-mips, rs6000
- with gcc & native cc (hp, dec only) allowing
- Detlefs & Zorn comparison study (in SIGPLAN Notices.)
-
- Trial version Fri Aug 28 13:14:29 1992 Doug Lea (dl at g.oswego.edu)
- * Based loosely on libg++-1.2X malloc. (It retains some of the overall
- structure of old version, but most details differ.)
-
-*/
-
-/*
- * Local variables:
- * c-file-style: "parrot"
- * End:
- * vim: expandtab shiftwidth=4:
- */
Modified: branches/pmc_pct/src/multidispatch.c
==============================================================================
--- branches/pmc_pct/src/multidispatch.c Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/multidispatch.c Thu Jun 4 02:32:48 2009 (r39377)
@@ -1356,10 +1356,6 @@
/* Create an NCI sub for the C function */
PMC *sub_obj = constant_pmc_new(interp, enum_class_NCI);
-#ifdef PARROT_HAS_ALIGNED_FUNCPTR
- PARROT_ASSERT((PTR2UINTVAL(func_ptr) & 3) == 0);
-#endif
-
VTABLE_set_pointer_keyed_str(interp, sub_obj, short_sig,
F2DPTR(func_ptr));
Modified: branches/pmc_pct/src/oo.c
==============================================================================
--- branches/pmc_pct/src/oo.c Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/oo.c Thu Jun 4 02:32:48 2009 (r39377)
@@ -23,6 +23,7 @@
#include "parrot/parrot.h"
#include "parrot/oo_private.h"
#include "pmc/pmc_class.h"
+#include "pmc/pmc_object.h"
#include "oo.str"
@@ -58,6 +59,12 @@
__attribute__nonnull__(2)
__attribute__nonnull__(3);
+PARROT_INLINE
+PARROT_CANNOT_RETURN_NULL
+PARROT_WARN_UNUSED_RESULT
+static PMC * get_pmc_proxy(PARROT_INTERP, INTVAL type)
+ __attribute__nonnull__(1);
+
static void invalidate_all_caches(PARROT_INTERP)
__attribute__nonnull__(1);
@@ -78,6 +85,8 @@
PARROT_ASSERT_ARG(interp) \
|| PARROT_ASSERT_ARG(_class) \
|| PARROT_ASSERT_ARG(method_name)
+#define ASSERT_ARGS_get_pmc_proxy __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
#define ASSERT_ARGS_invalidate_all_caches __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp)
#define ASSERT_ARGS_invalidate_type_caches __attribute__unused__ int _ASSERT_ARGS_CHECK = \
@@ -235,19 +244,163 @@
else
type = pmc_type(interp, VTABLE_get_string(interp, key));
- /* Reject invalid type numbers */
- if (type > interp->n_vtable_max || type <= 0)
- classobj = PMCNULL;
- else {
- PMC * const type_num = pmc_new(interp, enum_class_Integer);
- VTABLE_set_integer_native(interp, type_num, type);
- classobj = pmc_new_init(interp, enum_class_PMCProxy, type_num);
- }
+ classobj = get_pmc_proxy(interp, type);
}
return classobj;
}
+/*
+
+=item C<PMC * Parrot_oo_clone_object(PARROT_INTERP, PMC * pmc, PMC * class_, PMC
+* dest)>
+
+Clone an Object PMC. If an existing PMC C<dest> is provided, reuse that
+PMC to store copies of the data. Otherwise, create a new PMC and populate
+that with the data.
+
+=cut
+
+*/
+
+PARROT_CANNOT_RETURN_NULL
+PMC *
+Parrot_oo_clone_object(PARROT_INTERP, ARGIN(PMC * pmc),
+ ARGMOD_NULLOK(PMC * class_), ARGMOD_NULLOK(PMC * dest))
+{
+ ASSERT_ARGS(Parrot_oo_clone_object)
+ Parrot_Object_attributes * obj;
+ Parrot_Class_attributes * _class;
+ INTVAL num_classes;
+ PMC * cloned;
+ Parrot_Object_attributes * cloned_guts;
+ INTVAL i, num_attrs;
+
+ if (!PMC_IS_NULL(dest)) {
+ PARROT_ASSERT(!PMC_IS_NULL(class_));
+ PARROT_ASSERT(class_->vtable->base_type == enum_class_Class);
+ obj = (Parrot_Object_attributes *)
+ Parrot_oo_new_object_attrs(interp, class_);
+ cloned = dest;
+ }
+ else {
+ obj = PARROT_OBJECT(pmc);
+ cloned = pmc_new_noinit(interp, enum_class_Object);
+ }
+ _class = PARROT_CLASS(obj->_class);
+ PARROT_ASSERT(_class);
+ num_classes = VTABLE_elements(interp, _class->all_parents);
+
+ /* Set custom GC mark and destroy on the object. */
+ PObj_custom_mark_SET(cloned);
+ PObj_active_destroy_SET(cloned);
+
+ /* Flag that it is an object */
+ PObj_is_object_SET(cloned);
+
+ /* Now create the underlying structure, and clone attributes list.class. */
+ cloned_guts = mem_allocate_zeroed_typed(Parrot_Object_attributes);
+ PMC_data(cloned) = cloned_guts;
+ cloned_guts->_class = obj->_class;
+ cloned_guts->attrib_store = VTABLE_clone(interp, obj->attrib_store);
+ num_attrs = VTABLE_elements(interp, cloned_guts->attrib_store);
+ for (i = 0; i < num_attrs; i++) {
+ PMC * const to_clone = VTABLE_get_pmc_keyed_int(interp, cloned_guts->attrib_store, i);
+ if (!PMC_IS_NULL(to_clone)) {
+ VTABLE_set_pmc_keyed_int(interp, cloned_guts->attrib_store, i,
+ VTABLE_clone(interp, to_clone));
+ }
+ }
+
+ /* Some of the attributes may have been the PMCs providing storage for any
+ * PMCs we inherited from; also need to clone those. */
+ if (CLASS_has_alien_parents_TEST(obj->_class)) {
+ /* Locate any PMC parents. */
+ for (i = 0; i < num_classes; i++) {
+ PMC * const cur_class = VTABLE_get_pmc_keyed_int(interp, _class->all_parents, i);
+ if (cur_class->vtable->base_type == enum_class_PMCProxy) {
+ /* Clone this PMC too. */
+ STRING * const proxy = CONST_STRING(interp, "proxy");
+ VTABLE_set_attr_keyed(interp, cloned, cur_class, proxy,
+ VTABLE_clone(interp,
+ VTABLE_get_attr_keyed(interp, cloned, cur_class, proxy)));
+ }
+ }
+ }
+
+ /* And we have ourselves a clone. */
+ return cloned;
+}
+
+/*
+
+=item C<void * Parrot_oo_new_object_attrs(PARROT_INTERP, PMC * class_)>
+
+Create a new C<Parrot_Object_attributes> structure, which is the thing that
+holds data for an Object PMC. We need this for places where a new Object
+is being created without being instantiated by it's associated class, such
+as in C<Parrot_oo_clone_object>.
+
+=cut
+
+*/
+
+PARROT_CANNOT_RETURN_NULL
+void *
+Parrot_oo_new_object_attrs(PARROT_INTERP, ARGIN(PMC * class_))
+{
+ ASSERT_ARGS(Parrot_oo_new_object_attrs)
+ Parrot_Object_attributes * const obj_guts =
+ mem_allocate_zeroed_typed(Parrot_Object_attributes);
+ obj_guts->_class = class_;
+ obj_guts->attrib_store = pmc_new(interp, enum_class_ResizablePMCArray);
+ return (void *)obj_guts;
+}
+
+/*
+
+=item C<static PMC * get_pmc_proxy(PARROT_INTERP, INTVAL type)>
+
+Get the PMC proxy for a PMC with the given type, creating it if does not exist.
+If type is not a valid type, return PMCNULL. This code assumes that
+all PMCProxy objects live in the 'parrot' HLL namespace -- if/when
+we allow PMC types to exist in other HLL namespaces, this code will
+need to be updated.
+
+For internal use only.
+
+=cut
+
+*/
+
+PARROT_INLINE
+PARROT_CANNOT_RETURN_NULL
+PARROT_WARN_UNUSED_RESULT
+static PMC *
+get_pmc_proxy(PARROT_INTERP, INTVAL type)
+{
+ ASSERT_ARGS(get_pmc_proxy)
+
+ /* Check if not a PMC or invalid type number */
+ if (type > interp->n_vtable_max || type <= 0)
+ return PMCNULL;
+ else {
+ PMC * const parrot_hll = Parrot_get_namespace_keyed_str(interp, interp->root_namespace, CONST_STRING(interp, "parrot"));
+ PMC * const pmc_ns =
+ Parrot_make_namespace_keyed_str(interp, parrot_hll,
+ interp->vtables[type]->whoami);
+ PMC * proxy = VTABLE_get_class(interp, pmc_ns);
+
+ /* Create proxy if not found */
+ if (PMC_IS_NULL(proxy)) {
+ PMC * const type_num = pmc_new(interp, enum_class_Integer);
+ VTABLE_set_integer_native(interp, type_num, type);
+ proxy = pmc_new_init(interp, enum_class_PMCProxy, type_num);
+ Parrot_PCCINVOKE(interp, pmc_ns, CONST_STRING(interp, "set_class"), "P->", proxy);
+ }
+ return proxy;
+ }
+}
/*
@@ -266,27 +419,19 @@
Parrot_oo_get_class_str(PARROT_INTERP, ARGIN(STRING *name))
{
ASSERT_ARGS(Parrot_oo_get_class_str)
+
+ /* First check in current HLL namespace */
PMC * const hll_ns = VTABLE_get_pmc_keyed_int(interp, interp->HLL_namespace,
CONTEXT(interp)->current_HLL);
PMC * const ns = Parrot_get_namespace_keyed_str(interp, hll_ns, name);
PMC * const _class = PMC_IS_NULL(ns)
? PMCNULL : VTABLE_get_class(interp, ns);
- /* Look up a low-level class and create a proxy */
- if (PMC_IS_NULL(_class)) {
- const INTVAL type = pmc_type(interp, name);
-
- /* Reject invalid type numbers */
- if (type > interp->n_vtable_max || type <= 0)
- return PMCNULL;
- else {
- PMC * const type_num = pmc_new(interp, enum_class_Integer);
- VTABLE_set_integer_native(interp, type_num, type);
- return pmc_new_init(interp, enum_class_PMCProxy, type_num);
- }
- }
-
- return _class;
+ /* If not found, check for a PMC */
+ if (PMC_IS_NULL(_class))
+ return get_pmc_proxy(interp, pmc_type(interp, name));
+ else
+ return _class;
}
@@ -307,7 +452,7 @@
{
ASSERT_ARGS(Parrot_oo_newclass_from_str)
PMC * const namearg = pmc_new(interp, enum_class_String);
- PMC *namehash = pmc_new(interp, enum_class_Hash);
+ PMC * const namehash = pmc_new(interp, enum_class_Hash);
PMC *classobj;
VTABLE_set_string_native(interp, namearg, name);
@@ -371,6 +516,8 @@
if (!PMC_IS_NULL(result))
return result;
+ else if (VTABLE_exists_keyed_str(interp, _class->parent_overrides, name))
+ return PMCNULL;
else {
/* Walk and search for the vtable method. */
const INTVAL num_classes = VTABLE_elements(interp, _class->all_parents);
@@ -453,12 +600,12 @@
PARROT_PURE_FUNCTION
PARROT_CAN_RETURN_NULL
const char *
-Parrot_get_vtable_name(PARROT_INTERP, INTVAL idx)
+Parrot_get_vtable_name(SHIM_INTERP, INTVAL idx)
{
ASSERT_ARGS(Parrot_get_vtable_name)
- INTVAL low = PARROT_VTABLE_LOW;
- INTVAL high = NUM_VTABLE_FUNCTIONS + PARROT_VTABLE_LOW;
+ const INTVAL low = PARROT_VTABLE_LOW;
+ const INTVAL high = NUM_VTABLE_FUNCTIONS + PARROT_VTABLE_LOW;
PARROT_ASSERT(idx > 0);
@@ -565,7 +712,7 @@
PMC * const classobj = VTABLE_get_class(interp, _namespace);
if (!PMC_IS_NULL(classobj)) {
- STRING *classname = VTABLE_get_string(interp, _namespace);
+ STRING * const classname = VTABLE_get_string(interp, _namespace);
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
"Class %Ss already registered!\n",
Parrot_str_escape(interp, classname));
@@ -579,9 +726,9 @@
}
{
if (!typeid_exists) {
- PMC *classname_hash = interp->class_hash;
+ PMC * const classname_hash = interp->class_hash;
+ PMC * const item = pmc_new(interp, enum_class_Integer);
/* set entry in name->type hash */
- PMC *item = pmc_new(interp, enum_class_Integer);
VTABLE_set_integer_native(interp, item, type);
VTABLE_set_pmc_keyed(interp, classname_hash, name, item);
@@ -874,7 +1021,7 @@
mc->mc_size = type + 1;
}
- if (!mc->idx[type]) {
+ if (mc->idx[type] == NULL) {
mc->idx[type] = (Meth_cache_entry **)mem_sys_allocate_zeroed(
sizeof (Meth_cache_entry *) * TBL_SIZE);
}
@@ -936,7 +1083,7 @@
if (PObj_is_class_TEST(_class)) {
SLOTTYPE * const class_array = PMC_data_typed(_class, SLOTTYPE *);
- PMC *const class_name_pmc = get_attrib_num(class_array, PCD_CLASS_NAME);
+ PMC * const class_name_pmc = get_attrib_num(class_array, PCD_CLASS_NAME);
class_name = VTABLE_get_string(interp, class_name_pmc);
}
else
@@ -1077,10 +1224,10 @@
/* Otherwise, remove what was accepted from the merge lists. */
for (i = 0; i < list_count; i++) {
- int j;
PMC * const list = VTABLE_get_pmc_keyed_int(interp, merge_list, i);
- const int list_count = VTABLE_elements(interp, list);
+ const INTVAL list_count = VTABLE_elements(interp, list);
+ INTVAL j;
for (j = 0; j < list_count; j++) {
if (VTABLE_get_pmc_keyed_int(interp, list, j) == accepted) {
@@ -1117,14 +1264,14 @@
{
ASSERT_ARGS(Parrot_ComputeMRO_C3)
- PMC *merge_list = PMCNULL;
- PMC *immediate_parents = VTABLE_inspect_str(interp, _class, CONST_STRING(interp, "parents"));
+ PMC * const immediate_parents = VTABLE_inspect_str(interp, _class, CONST_STRING(interp, "parents"));
+ PMC *merge_list;
PMC *result;
- int i, parent_count;
+ INTVAL i;
+ INTVAL parent_count;
/* Now get immediate parents list. */
-
if (!immediate_parents)
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_METHOD_NOT_FOUND,
"Failed to get parents list from class!");
@@ -1140,6 +1287,7 @@
/* Otherwise, need to do merge. For that, need linearizations of all of
* our parents added to the merge list. */
+ merge_list = PMCNULL;
for (i = 0; i < parent_count; i++) {
PMC * const lin = Parrot_ComputeMRO_C3(interp,
VTABLE_get_pmc_keyed_int(interp, immediate_parents, i));
@@ -1202,10 +1350,11 @@
PMC *roles_of_role;
PMC *proposed_add_methods;
- int i, roles_of_role_count;
+ INTVAL roles_of_role_count;
+ INTVAL i;
/* Check we have not already composed the role; if so, just ignore it. */
- int roles_count = VTABLE_elements(interp, roles_list);
+ INTVAL roles_count = VTABLE_elements(interp, roles_list);
for (i = 0; i < roles_count; i++)
if (VTABLE_get_pmc_keyed_int(interp, roles_list, i) == role)
@@ -1253,7 +1402,7 @@
if (VTABLE_exists_keyed_str(interp, methods_hash, method_name)) {
/* Conflicts with something already in the class, unless it's a
* multi-method. */
- PMC *cur_entry = VTABLE_get_pmc_keyed_str(interp, methods_hash, method_name);
+ PMC * const cur_entry = VTABLE_get_pmc_keyed_str(interp, methods_hash, method_name);
if (PMC_IS_NULL(cur_entry) || !VTABLE_isa(interp, cur_entry, CONST_STRING(interp, "MultiSub")))
Parrot_ex_throw_from_c_args(interp, NULL,
EXCEPTION_ROLE_COMPOSITION_METHOD_CONFLICT,
@@ -1286,7 +1435,7 @@
/* Is there a method with this name already in the class? If it's
* not a multi-method, error. */
if (VTABLE_exists_keyed_str(interp, methods_hash, alias_name)) {
- PMC *cur_entry = VTABLE_get_pmc_keyed_str(interp, methods_hash, alias_name);
+ PMC * const cur_entry = VTABLE_get_pmc_keyed_str(interp, methods_hash, alias_name);
if (PMC_IS_NULL(cur_entry) || !VTABLE_isa(interp, cur_entry, CONST_STRING(interp, "MultiSub")))
/* Conflicts with something already in the class. */
Parrot_ex_throw_from_c_args(interp, NULL,
@@ -1323,17 +1472,17 @@
proposed_add_methods, method_name);
/* Add it to the methods of the class. */
- PMC *cur_entry = VTABLE_get_pmc_keyed_str(interp, methods_hash, method_name);
+ PMC * const cur_entry = VTABLE_get_pmc_keyed_str(interp, methods_hash, method_name);
if (VTABLE_isa(interp, cur_method, CONST_STRING(interp, "MultiSub"))) {
/* The thing we're adding is a multi-sub, but is the thing in the
* class already a multi-sub? */
if (!PMC_IS_NULL(cur_entry) && VTABLE_isa(interp, cur_entry, CONST_STRING(interp, "MultiSub"))) {
/* Class already has a multi-sub; need to merge our methods into it. */
- INTVAL num_subs = VTABLE_elements(interp, cur_method);
- INTVAL i;
- for (i = 0; i < num_subs; i++)
+ const INTVAL num_subs = VTABLE_elements(interp, cur_method);
+ INTVAL j;
+ for (j = 0; j < num_subs; j++)
VTABLE_push_pmc(interp, cur_entry, VTABLE_get_pmc_keyed_int(interp,
- cur_method, i));
+ cur_method, j));
}
else {
/* It's not, and we didn't conflict so must be no entry. Just stick it in. */
@@ -1364,7 +1513,7 @@
/* Only add if we don't already have it in the list. */
PMC * const cur_role = VTABLE_get_pmc_keyed_int(interp,
roles_of_role, i);
- int j;
+ INTVAL j;
for (j = 0; j < roles_count; j++) {
if (VTABLE_get_pmc_keyed_int(interp, roles_list, j) == cur_role) {
Modified: branches/pmc_pct/src/ops/cmp.ops
==============================================================================
--- branches/pmc_pct/src/ops/cmp.ops Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/ops/cmp.ops Thu Jun 4 02:32:48 2009 (r39377)
@@ -614,7 +614,6 @@
=item B<cmp_num>(out INT, invar PMC, invar PMC)
-
Sets $1 to -1 if $2 < $3, +1 if $2 > $3, and 0 otherwise.
=cut
@@ -666,6 +665,18 @@
$1 = VTABLE_cmp_num(interp, $2, $3);
}
+=item B<cmp_pmc>(out PMC, invar PMC, invar PMC)
+
+Does the same thing as the other cmp_* variants, but puts a PMC in $1. This is
+useful for avoiding the semipredicate problem in HLLs where two aggregate PMCs
+are not always comparable.
+
+=cut
+
+inline op cmp_pmc(out PMC, invar PMC, invar PMC) :base_core {
+ $1 = VTABLE_cmp_pmc(interp, $2, $3);
+}
+
########################################
=item B<issame>(out INT, invar PMC, invar PMC)
Modified: branches/pmc_pct/src/ops/io.ops
==============================================================================
--- branches/pmc_pct/src/ops/io.ops Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/ops/io.ops Thu Jun 4 02:32:48 2009 (r39377)
@@ -90,19 +90,27 @@
#########################################
+=item B<setstdin>(invar PMC)
+
+Sets the standard input for a bare C<read> op to go to the supplied PMC.
+Call C<getstdin> first if you care about retaining the previous PMC.
+
=item B<setstdout>(invar PMC)
-Sets the standard output for a bare C<print> op to go to the supplied ParrotIO
-PMC. Call C<getstdout> first if you care about retaining the previous PMC.
+Sets the standard output for a bare C<print> op to go to the supplied PMC.
+Call C<getstdout> first if you care about retaining the previous PMC.
=item B<setstderr>(invar PMC)
-Sets the standard error for a bare C<printerr> op to go to the supplied
-ParrotIO PMC. Call C<getstderr> first if you care about retaining the previous
-PMC.
+Sets the standard error for a bare C<printerr> op to go to the supplied PMC.
+Call C<getstderr> first if you care about retaining the previous PMC.
=cut
+inline op setstdin(invar PMC) :base_io {
+ _PIO_STDIN(interp) = $1;
+}
+
inline op setstdout(invar PMC) :base_io {
_PIO_STDOUT(interp) = $1;
}
@@ -235,7 +243,7 @@
STRING * const s = $1;
if (s && Parrot_str_byte_length(interp, s))
Parrot_io_putps(interp, _PIO_STDOUT(interp), s);
- Parrot_io_puts(interp, _PIO_STDOUT(interp), "\n");
+ Parrot_io_putps(interp, _PIO_STDOUT(interp), Parrot_str_new_constant(interp, "\n"));
}
op say(invar PMC) :base_io {
@@ -251,7 +259,7 @@
STRING * const s = VTABLE_get_string(interp, p);
if (s)
Parrot_io_putps(interp, _PIO_STDOUT(interp), s);
- Parrot_io_puts(interp, _PIO_STDOUT(interp), "\n");
+ Parrot_io_putps(interp, _PIO_STDOUT(interp), Parrot_str_new_constant(interp, "\n"));
}
}
Modified: branches/pmc_pct/src/ops/ops.num
==============================================================================
--- branches/pmc_pct/src/ops/ops.num Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/ops/ops.num Thu Jun 4 02:32:48 2009 (r39377)
@@ -380,893 +380,901 @@
cmp_i_p_sc 356
cmp_str_i_p_p 357
cmp_num_i_p_p 358
-issame_i_p_p 359
-issame_i_s_s 360
-issame_i_sc_s 361
-issame_i_s_sc 362
-issame_i_sc_sc 363
-isntsame_i_p_p 364
-isntsame_i_s_s 365
-isntsame_i_sc_s 366
-isntsame_i_s_sc 367
-isntsame_i_sc_sc 368
-istrue_i_p 369
-isfalse_i_p 370
-isnull_i_p 371
-isnull_i_pc 372
-isgt_i_p_p 373
-isge_i_p_p 374
-isle_i_i_i 375
-isle_i_ic_i 376
-isle_i_i_ic 377
-isle_i_n_n 378
-isle_i_nc_n 379
-isle_i_n_nc 380
-isle_i_s_s 381
-isle_i_sc_s 382
-isle_i_s_sc 383
-isle_i_p_p 384
-islt_i_i_i 385
-islt_i_ic_i 386
-islt_i_i_ic 387
-islt_i_n_n 388
-islt_i_nc_n 389
-islt_i_n_nc 390
-islt_i_s_s 391
-islt_i_sc_s 392
-islt_i_s_sc 393
-islt_i_p_p 394
-iseq_i_i_i 395
-iseq_i_ic_i 396
-iseq_i_i_ic 397
-iseq_i_n_n 398
-iseq_i_nc_n 399
-iseq_i_n_nc 400
-iseq_i_s_s 401
-iseq_i_sc_s 402
-iseq_i_s_sc 403
-iseq_i_p_p 404
-isne_i_i_i 405
-isne_i_ic_i 406
-isne_i_i_ic 407
-isne_i_n_n 408
-isne_i_nc_n 409
-isne_i_n_nc 410
-isne_i_s_s 411
-isne_i_sc_s 412
-isne_i_s_sc 413
-isne_i_p_p 414
-and_i_i_i 415
-and_i_ic_i 416
-and_i_i_ic 417
-and_p_p_p 418
-not_i 419
-not_i_i 420
-not_p 421
-not_p_p 422
-or_i_i_i 423
-or_i_ic_i 424
-or_i_i_ic 425
-or_p_p_p 426
-xor_i_i_i 427
-xor_i_ic_i 428
-xor_i_i_ic 429
-xor_p_p_p 430
-debug_init 431
-debug_load_sc 432
-debug_break 433
-debug_print 434
-backtrace 435
-getline_i 436
-getfile_s 437
-close_p 438
-fdopen_p_i_s 439
-fdopen_p_ic_s 440
-fdopen_p_i_sc 441
-fdopen_p_ic_sc 442
-getstdin_p 443
-getstdout_p 444
-getstderr_p 445
-setstdout_p 446
-setstderr_p 447
-open_p_s_s 448
-open_p_sc_s 449
-open_p_s_sc 450
-open_p_sc_sc 451
-open_p_s 452
-open_p_sc 453
-print_i 454
-print_ic 455
-print_n 456
-print_nc 457
-print_s 458
-print_sc 459
-print_p 460
-say_i 461
-say_ic 462
-say_n 463
-say_nc 464
-say_s 465
-say_sc 466
-say_p 467
-printerr_i 468
-printerr_ic 469
-printerr_n 470
-printerr_nc 471
-printerr_s 472
-printerr_sc 473
-printerr_p 474
-print_p_i 475
-print_p_ic 476
-print_p_n 477
-print_p_nc 478
-print_p_s 479
-print_p_sc 480
-print_p_p 481
-read_s_i 482
-read_s_ic 483
-read_s_p_i 484
-read_s_p_ic 485
-readline_s_p 486
-peek_s 487
-peek_s_p 488
-stat_i_s_i 489
-stat_i_sc_i 490
-stat_i_s_ic 491
-stat_i_sc_ic 492
-stat_i_i_i 493
-stat_i_ic_i 494
-stat_i_i_ic 495
-stat_i_ic_ic 496
-seek_p_i_i 497
-seek_p_ic_i 498
-seek_p_i_ic 499
-seek_p_ic_ic 500
-seek_p_i_i_i 501
-seek_p_ic_i_i 502
-seek_p_i_ic_i 503
-seek_p_ic_ic_i 504
-seek_p_i_i_ic 505
-seek_p_ic_i_ic 506
-seek_p_i_ic_ic 507
-seek_p_ic_ic_ic 508
-tell_i_p 509
-tell_i_i_p 510
-abs_i 511
-abs_n 512
-abs_i_i 513
-abs_n_n 514
-abs_p 515
-abs_p_p 516
-add_i_i 517
-add_i_ic 518
-add_n_n 519
-add_n_nc 520
-add_p_p 521
-add_p_i 522
-add_p_ic 523
-add_p_n 524
-add_p_nc 525
-add_i_i_i 526
-add_i_ic_i 527
-add_i_i_ic 528
-add_n_n_n 529
-add_n_nc_n 530
-add_n_n_nc 531
-add_p_p_p 532
-add_p_p_i 533
-add_p_p_ic 534
-add_p_p_n 535
-add_p_p_nc 536
-cmod_i_i_i 537
-cmod_i_ic_i 538
-cmod_i_i_ic 539
-cmod_p_p_i 540
-cmod_p_p_ic 541
-cmod_p_p_p 542
-cmod_n_n_n 543
-cmod_n_nc_n 544
-cmod_n_n_nc 545
-cmod_p_p_n 546
-cmod_p_p_nc 547
-dec_i 548
-dec_n 549
-dec_p 550
-div_i_i 551
-div_i_ic 552
-div_n_n 553
-div_n_nc 554
-div_p_p 555
-div_p_i 556
-div_p_ic 557
-div_p_n 558
-div_p_nc 559
-div_i_i_i 560
-div_i_ic_i 561
-div_i_i_ic 562
-div_i_ic_ic 563
-div_n_n_n 564
-div_n_nc_n 565
-div_n_n_nc 566
-div_n_nc_nc 567
-div_p_p_p 568
-div_p_p_i 569
-div_p_p_ic 570
-div_p_p_n 571
-div_p_p_nc 572
-fdiv_i_i 573
-fdiv_i_ic 574
-fdiv_n_n 575
-fdiv_n_nc 576
-fdiv_p_p 577
-fdiv_p_i 578
-fdiv_p_ic 579
-fdiv_p_n 580
-fdiv_p_nc 581
-fdiv_i_i_i 582
-fdiv_i_ic_i 583
-fdiv_i_i_ic 584
-fdiv_n_n_n 585
-fdiv_n_nc_n 586
-fdiv_n_n_nc 587
-fdiv_p_p_p 588
-fdiv_p_p_i 589
-fdiv_p_p_ic 590
-fdiv_p_p_n 591
-fdiv_p_p_nc 592
-ceil_n 593
-ceil_i_n 594
-ceil_n_n 595
-floor_n 596
-floor_i_n 597
-floor_n_n 598
-inc_i 599
-inc_n 600
-inc_p 601
-mod_i_i 602
-mod_i_ic 603
-mod_n_n 604
-mod_n_nc 605
-mod_p_p 606
-mod_p_i 607
-mod_p_ic 608
-mod_p_n 609
-mod_p_nc 610
-mod_i_i_i 611
-mod_i_ic_i 612
-mod_i_i_ic 613
-mod_n_n_n 614
-mod_n_nc_n 615
-mod_n_n_nc 616
-mod_p_p_p 617
-mod_p_p_i 618
-mod_p_p_ic 619
-mod_p_p_n 620
-mod_p_p_nc 621
-mul_i_i 622
-mul_i_ic 623
-mul_n_n 624
-mul_n_nc 625
-mul_p_p 626
-mul_p_i 627
-mul_p_ic 628
-mul_p_n 629
-mul_p_nc 630
-mul_i_i_i 631
-mul_i_ic_i 632
-mul_i_i_ic 633
-mul_n_n_n 634
-mul_n_nc_n 635
-mul_n_n_nc 636
-mul_p_p_p 637
-mul_p_p_i 638
-mul_p_p_ic 639
-mul_p_p_n 640
-mul_p_p_nc 641
-neg_i 642
-neg_n 643
-neg_p 644
-neg_i_i 645
-neg_n_n 646
-neg_p_p 647
-pow_n_n_n 648
-pow_n_nc_n 649
-pow_n_n_nc 650
-pow_p_p_p 651
-pow_p_p_i 652
-pow_p_p_ic 653
-pow_p_p_n 654
-pow_p_p_nc 655
-pow_n_n_i 656
-pow_n_nc_i 657
-pow_n_n_ic 658
-pow_n_nc_ic 659
-sub_i_i 660
-sub_i_ic 661
-sub_n_n 662
-sub_n_nc 663
-sub_p_p 664
-sub_p_i 665
-sub_p_ic 666
-sub_p_n 667
-sub_p_nc 668
-sub_i_i_i 669
-sub_i_ic_i 670
-sub_i_i_ic 671
-sub_n_n_n 672
-sub_n_nc_n 673
-sub_n_n_nc 674
-sub_p_p_p 675
-sub_p_p_i 676
-sub_p_p_ic 677
-sub_p_p_n 678
-sub_p_p_nc 679
-sqrt_n_n 680
-acos_n_n 681
-asec_n_n 682
-asin_n_n 683
-atan_n_n 684
-atan_n_n_n 685
-atan_n_nc_n 686
-atan_n_n_nc 687
-cos_n_n 688
-cosh_n_n 689
-exp_n_n 690
-ln_n_n 691
-log10_n_n 692
-log2_n_n 693
-sec_n_n 694
-sech_n_n 695
-sin_n_n 696
-sinh_n_n 697
-tan_n_n 698
-tanh_n_n 699
-gcd_i_i_i 700
-gcd_i_ic_i 701
-gcd_i_i_ic 702
-lcm_i_i_i 703
-lcm_i_ic_i 704
-lcm_i_i_ic 705
-fact_i_i 706
-fact_n_i 707
-callmethodcc_p_s 708
-callmethodcc_p_sc 709
-callmethodcc_p_p 710
-callmethod_p_s_p 711
-callmethod_p_sc_p 712
-callmethod_p_p_p 713
-tailcallmethod_p_s 714
-tailcallmethod_p_sc 715
-tailcallmethod_p_p 716
-addmethod_p_s_p 717
-addmethod_p_sc_p 718
-can_i_p_s 719
-can_i_p_sc 720
-does_i_p_s 721
-does_i_p_sc 722
-does_i_p_p 723
-does_i_p_pc 724
-isa_i_p_s 725
-isa_i_p_sc 726
-isa_i_p_p 727
-isa_i_p_pc 728
-newclass_p_s 729
-newclass_p_sc 730
-newclass_p_p 731
-newclass_p_pc 732
-subclass_p_p 733
-subclass_p_pc 734
-subclass_p_p_s 735
-subclass_p_pc_s 736
-subclass_p_p_sc 737
-subclass_p_pc_sc 738
-subclass_p_p_p 739
-subclass_p_pc_p 740
-subclass_p_p_pc 741
-subclass_p_pc_pc 742
-subclass_p_s 743
-subclass_p_sc 744
-subclass_p_s_s 745
-subclass_p_sc_s 746
-subclass_p_s_sc 747
-subclass_p_sc_sc 748
-subclass_p_s_p 749
-subclass_p_sc_p 750
-subclass_p_s_pc 751
-subclass_p_sc_pc 752
-get_class_p_s 753
-get_class_p_sc 754
-get_class_p_p 755
-get_class_p_pc 756
-class_p_p 757
-addparent_p_p 758
-removeparent_p_p 759
-addrole_p_p 760
-addattribute_p_s 761
-addattribute_p_sc 762
-removeattribute_p_s 763
-removeattribute_p_sc 764
-getattribute_p_p_s 765
-getattribute_p_p_sc 766
-getattribute_p_p_p_s 767
-getattribute_p_p_pc_s 768
-getattribute_p_p_p_sc 769
-getattribute_p_p_pc_sc 770
-setattribute_p_s_p 771
-setattribute_p_sc_p 772
-setattribute_p_p_s_p 773
-setattribute_p_pc_s_p 774
-setattribute_p_p_sc_p 775
-setattribute_p_pc_sc_p 776
-inspect_p_p 777
-inspect_p_pc 778
-inspect_p_p_s 779
-inspect_p_pc_s 780
-inspect_p_p_sc 781
-inspect_p_pc_sc 782
-pic_infix___ic_p_p 783
-pic_inline_sub___ic_p_p 784
-pic_get_params___pc 785
-pic_set_returns___pc 786
-pic_callr___pc 787
-new_p_s 788
-new_p_sc 789
-new_p_s_p 790
-new_p_sc_p 791
-new_p_s_pc 792
-new_p_sc_pc 793
-new_p_p 794
-new_p_pc 795
-new_p_p_p 796
-new_p_pc_p 797
-new_p_p_pc 798
-new_p_pc_pc 799
-typeof_s_p 800
-typeof_p_p 801
-get_repr_s_p 802
-find_method_p_p_s 803
-find_method_p_p_sc 804
-defined_i_p 805
-defined_i_p_ki 806
-defined_i_p_kic 807
-defined_i_p_k 808
-defined_i_p_kc 809
-exists_i_p_ki 810
-exists_i_p_kic 811
-exists_i_p_k 812
-exists_i_p_kc 813
-delete_p_k 814
-delete_p_kc 815
-delete_p_ki 816
-delete_p_kic 817
-elements_i_p 818
-push_p_i 819
-push_p_ic 820
-push_p_n 821
-push_p_nc 822
-push_p_s 823
-push_p_sc 824
-push_p_p 825
-pop_i_p 826
-pop_n_p 827
-pop_s_p 828
-pop_p_p 829
-unshift_p_i 830
-unshift_p_ic 831
-unshift_p_n 832
-unshift_p_nc 833
-unshift_p_s 834
-unshift_p_sc 835
-unshift_p_p 836
-shift_i_p 837
-shift_n_p 838
-shift_s_p 839
-shift_p_p 840
-splice_p_p_i_i 841
-splice_p_p_ic_i 842
-splice_p_p_i_ic 843
-splice_p_p_ic_ic 844
-setprop_p_s_p 845
-setprop_p_sc_p 846
-getprop_p_s_p 847
-getprop_p_sc_p 848
-delprop_p_s 849
-delprop_p_sc 850
-prophash_p_p 851
-freeze_s_p 852
-thaw_p_s 853
-thaw_p_sc 854
-add_multi_s_s_p 855
-add_multi_sc_s_p 856
-add_multi_s_sc_p 857
-add_multi_sc_sc_p 858
-find_multi_p_s_s 859
-find_multi_p_sc_s 860
-find_multi_p_s_sc 861
-find_multi_p_sc_sc 862
-register_p 863
-unregister_p 864
-box_p_i 865
-box_p_ic 866
-box_p_n 867
-box_p_nc 868
-box_p_s 869
-box_p_sc 870
-iter_p_p 871
-morph_p_p 872
-morph_p_pc 873
-clone_s_s 874
-clone_s_sc 875
-exchange_i_i 876
-exchange_p_p 877
-exchange_n_n 878
-exchange_s_s 879
-set_i_i 880
-set_i_ic 881
-set_i_n 882
-set_i_nc 883
-set_i_s 884
-set_i_sc 885
-set_n_n 886
-set_n_nc 887
-set_n_i 888
-set_n_ic 889
-set_n_s 890
-set_n_sc 891
-set_n_p 892
-set_s_p 893
-set_s_s 894
-set_s_sc 895
-set_s_i 896
-set_s_ic 897
-set_s_n 898
-set_s_nc 899
-set_p_pc 900
-set_p_p 901
-set_p_i 902
-set_p_ic 903
-set_p_n 904
-set_p_nc 905
-set_p_s 906
-set_p_sc 907
-set_i_p 908
-assign_p_p 909
-assign_p_i 910
-assign_p_ic 911
-assign_p_n 912
-assign_p_nc 913
-assign_p_s 914
-assign_p_sc 915
-assign_s_s 916
-assign_s_sc 917
-setref_p_p 918
-deref_p_p 919
-setp_ind_i_p 920
-setp_ind_ic_p 921
-setn_ind_i_n 922
-setn_ind_ic_n 923
-setn_ind_i_nc 924
-setn_ind_ic_nc 925
-sets_ind_i_s 926
-sets_ind_ic_s 927
-sets_ind_i_sc 928
-sets_ind_ic_sc 929
-seti_ind_i_i 930
-seti_ind_ic_i 931
-seti_ind_i_ic 932
-seti_ind_ic_ic 933
-set_p_ki_i 934
-set_p_kic_i 935
-set_p_ki_ic 936
-set_p_kic_ic 937
-set_p_ki_n 938
-set_p_kic_n 939
-set_p_ki_nc 940
-set_p_kic_nc 941
-set_p_ki_s 942
-set_p_kic_s 943
-set_p_ki_sc 944
-set_p_kic_sc 945
-set_p_ki_p 946
-set_p_kic_p 947
-set_i_p_ki 948
-set_i_p_kic 949
-set_n_p_ki 950
-set_n_p_kic 951
-set_s_p_ki 952
-set_s_p_kic 953
-set_p_p_ki 954
-set_p_p_kic 955
-set_p_k_i 956
-set_p_kc_i 957
-set_p_k_ic 958
-set_p_kc_ic 959
-set_p_k_n 960
-set_p_kc_n 961
-set_p_k_nc 962
-set_p_kc_nc 963
-set_p_k_s 964
-set_p_kc_s 965
-set_p_k_sc 966
-set_p_kc_sc 967
-set_p_k_p 968
-set_p_kc_p 969
-set_i_p_k 970
-set_i_p_kc 971
-set_n_p_k 972
-set_n_p_kc 973
-set_s_p_k 974
-set_s_p_kc 975
-set_p_p_k 976
-set_p_p_kc 977
-clone_p_p 978
-clone_p_p_p 979
-clone_p_p_pc 980
-copy_p_p 981
-null_s 982
-null_i 983
-null_p 984
-null_n 985
-cleari 986
-clearn 987
-clears 988
-clearp 989
-ord_i_s 990
-ord_i_sc 991
-ord_i_s_i 992
-ord_i_sc_i 993
-ord_i_s_ic 994
-ord_i_sc_ic 995
-chr_s_i 996
-chr_s_ic 997
-chopn_s_i 998
-chopn_s_ic 999
-chopn_s_s_i 1000
-chopn_s_sc_i 1001
-chopn_s_s_ic 1002
-chopn_s_sc_ic 1003
-concat_s_s 1004
-concat_s_sc 1005
-concat_p_p 1006
-concat_p_s 1007
-concat_p_sc 1008
-concat_s_s_s 1009
-concat_s_sc_s 1010
-concat_s_s_sc 1011
-concat_p_p_s 1012
-concat_p_p_sc 1013
-concat_p_p_p 1014
-repeat_s_s_i 1015
-repeat_s_sc_i 1016
-repeat_s_s_ic 1017
-repeat_s_sc_ic 1018
-repeat_p_p_i 1019
-repeat_p_p_ic 1020
-repeat_p_p_p 1021
-repeat_p_i 1022
-repeat_p_ic 1023
-repeat_p_p 1024
-length_i_s 1025
-length_i_sc 1026
-bytelength_i_s 1027
-bytelength_i_sc 1028
-pin_s 1029
-unpin_s 1030
-substr_s_s_i 1031
-substr_s_sc_i 1032
-substr_s_s_ic 1033
-substr_s_sc_ic 1034
-substr_s_s_i_i 1035
-substr_s_sc_i_i 1036
-substr_s_s_ic_i 1037
-substr_s_sc_ic_i 1038
-substr_s_s_i_ic 1039
-substr_s_sc_i_ic 1040
-substr_s_s_ic_ic 1041
-substr_s_sc_ic_ic 1042
-substr_s_s_i_i_s 1043
-substr_s_s_ic_i_s 1044
-substr_s_s_i_ic_s 1045
-substr_s_s_ic_ic_s 1046
-substr_s_s_i_i_sc 1047
-substr_s_s_ic_i_sc 1048
-substr_s_s_i_ic_sc 1049
-substr_s_s_ic_ic_sc 1050
-substr_s_i_i_s 1051
-substr_s_ic_i_s 1052
-substr_s_i_ic_s 1053
-substr_s_ic_ic_s 1054
-substr_s_i_i_sc 1055
-substr_s_ic_i_sc 1056
-substr_s_i_ic_sc 1057
-substr_s_ic_ic_sc 1058
-substr_s_p_i_i 1059
-substr_s_p_ic_i 1060
-substr_s_p_i_ic 1061
-substr_s_p_ic_ic 1062
-index_i_s_s 1063
-index_i_sc_s 1064
-index_i_s_sc 1065
-index_i_sc_sc 1066
-index_i_s_s_i 1067
-index_i_sc_s_i 1068
-index_i_s_sc_i 1069
-index_i_sc_sc_i 1070
-index_i_s_s_ic 1071
-index_i_sc_s_ic 1072
-index_i_s_sc_ic 1073
-index_i_sc_sc_ic 1074
-sprintf_s_s_p 1075
-sprintf_s_sc_p 1076
-sprintf_p_p_p 1077
-new_s 1078
-new_s_i 1079
-new_s_ic 1080
-stringinfo_i_s_i 1081
-stringinfo_i_sc_i 1082
-stringinfo_i_s_ic 1083
-stringinfo_i_sc_ic 1084
-upcase_s_s 1085
-upcase_s_sc 1086
-upcase_s 1087
-downcase_s_s 1088
-downcase_s_sc 1089
-downcase_s 1090
-titlecase_s_s 1091
-titlecase_s_sc 1092
-titlecase_s 1093
-join_s_s_p 1094
-join_s_sc_p 1095
-split_p_s_s 1096
-split_p_sc_s 1097
-split_p_s_sc 1098
-split_p_sc_sc 1099
-charset_i_s 1100
-charset_i_sc 1101
-charsetname_s_i 1102
-charsetname_s_ic 1103
-find_charset_i_s 1104
-find_charset_i_sc 1105
-trans_charset_s_i 1106
-trans_charset_s_ic 1107
-trans_charset_s_s_i 1108
-trans_charset_s_sc_i 1109
-trans_charset_s_s_ic 1110
-trans_charset_s_sc_ic 1111
-encoding_i_s 1112
-encoding_i_sc 1113
-encodingname_s_i 1114
-encodingname_s_ic 1115
-find_encoding_i_s 1116
-find_encoding_i_sc 1117
-trans_encoding_s_i 1118
-trans_encoding_s_ic 1119
-trans_encoding_s_s_i 1120
-trans_encoding_s_sc_i 1121
-trans_encoding_s_s_ic 1122
-trans_encoding_s_sc_ic 1123
-is_cclass_i_i_s_i 1124
-is_cclass_i_ic_s_i 1125
-is_cclass_i_i_sc_i 1126
-is_cclass_i_ic_sc_i 1127
-is_cclass_i_i_s_ic 1128
-is_cclass_i_ic_s_ic 1129
-is_cclass_i_i_sc_ic 1130
-is_cclass_i_ic_sc_ic 1131
-find_cclass_i_i_s_i_i 1132
-find_cclass_i_ic_s_i_i 1133
-find_cclass_i_i_sc_i_i 1134
-find_cclass_i_ic_sc_i_i 1135
-find_cclass_i_i_s_ic_i 1136
-find_cclass_i_ic_s_ic_i 1137
-find_cclass_i_i_sc_ic_i 1138
-find_cclass_i_ic_sc_ic_i 1139
-find_cclass_i_i_s_i_ic 1140
-find_cclass_i_ic_s_i_ic 1141
-find_cclass_i_i_sc_i_ic 1142
-find_cclass_i_ic_sc_i_ic 1143
-find_cclass_i_i_s_ic_ic 1144
-find_cclass_i_ic_s_ic_ic 1145
-find_cclass_i_i_sc_ic_ic 1146
-find_cclass_i_ic_sc_ic_ic 1147
-find_not_cclass_i_i_s_i_i 1148
-find_not_cclass_i_ic_s_i_i 1149
-find_not_cclass_i_i_sc_i_i 1150
-find_not_cclass_i_ic_sc_i_i 1151
-find_not_cclass_i_i_s_ic_i 1152
-find_not_cclass_i_ic_s_ic_i 1153
-find_not_cclass_i_i_sc_ic_i 1154
-find_not_cclass_i_ic_sc_ic_i 1155
-find_not_cclass_i_i_s_i_ic 1156
-find_not_cclass_i_ic_s_i_ic 1157
-find_not_cclass_i_i_sc_i_ic 1158
-find_not_cclass_i_ic_sc_i_ic 1159
-find_not_cclass_i_i_s_ic_ic 1160
-find_not_cclass_i_ic_s_ic_ic 1161
-find_not_cclass_i_i_sc_ic_ic 1162
-find_not_cclass_i_ic_sc_ic_ic 1163
-escape_s_s 1164
-compose_s_s 1165
-compose_s_sc 1166
-spawnw_i_s 1167
-spawnw_i_sc 1168
-spawnw_i_p 1169
-err_i 1170
-err_s 1171
-err_s_i 1172
-err_s_ic 1173
-time_i 1174
-time_n 1175
-gmtime_s_i 1176
-gmtime_s_ic 1177
-localtime_s_i 1178
-localtime_s_ic 1179
-decodetime_p_i 1180
-decodetime_p_ic 1181
-decodelocaltime_p_i 1182
-decodelocaltime_p_ic 1183
-sysinfo_s_i 1184
-sysinfo_s_ic 1185
-sysinfo_i_i 1186
-sysinfo_i_ic 1187
-sleep_i 1188
-sleep_ic 1189
-sleep_n 1190
-sleep_nc 1191
-sizeof_i_i 1192
-sizeof_i_ic 1193
-store_lex_s_p 1194
-store_lex_sc_p 1195
-find_lex_p_s 1196
-find_lex_p_sc 1197
-find_caller_lex_p_s 1198
-find_caller_lex_p_sc 1199
-get_namespace_p 1200
-get_namespace_p_p 1201
-get_namespace_p_pc 1202
-get_hll_namespace_p 1203
-get_hll_namespace_p_p 1204
-get_hll_namespace_p_pc 1205
-get_root_namespace_p 1206
-get_root_namespace_p_p 1207
-get_root_namespace_p_pc 1208
-get_global_p_s 1209
-get_global_p_sc 1210
-get_global_p_p_s 1211
-get_global_p_pc_s 1212
-get_global_p_p_sc 1213
-get_global_p_pc_sc 1214
-get_hll_global_p_s 1215
-get_hll_global_p_sc 1216
-get_hll_global_p_p_s 1217
-get_hll_global_p_pc_s 1218
-get_hll_global_p_p_sc 1219
-get_hll_global_p_pc_sc 1220
-get_root_global_p_s 1221
-get_root_global_p_sc 1222
-get_root_global_p_p_s 1223
-get_root_global_p_pc_s 1224
-get_root_global_p_p_sc 1225
-get_root_global_p_pc_sc 1226
-set_global_s_p 1227
-set_global_sc_p 1228
-set_global_p_s_p 1229
-set_global_pc_s_p 1230
-set_global_p_sc_p 1231
-set_global_pc_sc_p 1232
-set_hll_global_s_p 1233
-set_hll_global_sc_p 1234
-set_hll_global_p_s_p 1235
-set_hll_global_pc_s_p 1236
-set_hll_global_p_sc_p 1237
-set_hll_global_pc_sc_p 1238
-set_root_global_s_p 1239
-set_root_global_sc_p 1240
-set_root_global_p_s_p 1241
-set_root_global_pc_s_p 1242
-set_root_global_p_sc_p 1243
-set_root_global_pc_sc_p 1244
-find_name_p_s 1245
-find_name_p_sc 1246
-find_sub_not_null_p_s 1247
-find_sub_not_null_p_sc 1248
+cmp_pmc_p_p_p 359
+issame_i_p_p 360
+issame_i_s_s 361
+issame_i_sc_s 362
+issame_i_s_sc 363
+issame_i_sc_sc 364
+isntsame_i_p_p 365
+isntsame_i_s_s 366
+isntsame_i_sc_s 367
+isntsame_i_s_sc 368
+isntsame_i_sc_sc 369
+istrue_i_p 370
+isfalse_i_p 371
+isnull_i_p 372
+isnull_i_pc 373
+isgt_i_p_p 374
+isge_i_p_p 375
+isle_i_i_i 376
+isle_i_ic_i 377
+isle_i_i_ic 378
+isle_i_n_n 379
+isle_i_nc_n 380
+isle_i_n_nc 381
+isle_i_s_s 382
+isle_i_sc_s 383
+isle_i_s_sc 384
+isle_i_p_p 385
+islt_i_i_i 386
+islt_i_ic_i 387
+islt_i_i_ic 388
+islt_i_n_n 389
+islt_i_nc_n 390
+islt_i_n_nc 391
+islt_i_s_s 392
+islt_i_sc_s 393
+islt_i_s_sc 394
+islt_i_p_p 395
+iseq_i_i_i 396
+iseq_i_ic_i 397
+iseq_i_i_ic 398
+iseq_i_n_n 399
+iseq_i_nc_n 400
+iseq_i_n_nc 401
+iseq_i_s_s 402
+iseq_i_sc_s 403
+iseq_i_s_sc 404
+iseq_i_p_p 405
+isne_i_i_i 406
+isne_i_ic_i 407
+isne_i_i_ic 408
+isne_i_n_n 409
+isne_i_nc_n 410
+isne_i_n_nc 411
+isne_i_s_s 412
+isne_i_sc_s 413
+isne_i_s_sc 414
+isne_i_p_p 415
+and_i_i_i 416
+and_i_ic_i 417
+and_i_i_ic 418
+and_p_p_p 419
+not_i 420
+not_i_i 421
+not_p 422
+not_p_p 423
+or_i_i_i 424
+or_i_ic_i 425
+or_i_i_ic 426
+or_p_p_p 427
+xor_i_i_i 428
+xor_i_ic_i 429
+xor_i_i_ic 430
+xor_p_p_p 431
+debug_init 432
+debug_load_sc 433
+debug_break 434
+debug_print 435
+backtrace 436
+getline_i 437
+getfile_s 438
+close_p 439
+fdopen_p_i_s 440
+fdopen_p_ic_s 441
+fdopen_p_i_sc 442
+fdopen_p_ic_sc 443
+getstdin_p 444
+getstdout_p 445
+getstderr_p 446
+setstdin_p 447
+setstdout_p 448
+setstderr_p 449
+open_p_s_s 450
+open_p_sc_s 451
+open_p_s_sc 452
+open_p_sc_sc 453
+open_p_s 454
+open_p_sc 455
+print_i 456
+print_ic 457
+print_n 458
+print_nc 459
+print_s 460
+print_sc 461
+print_p 462
+say_i 463
+say_ic 464
+say_n 465
+say_nc 466
+say_s 467
+say_sc 468
+say_p 469
+printerr_i 470
+printerr_ic 471
+printerr_n 472
+printerr_nc 473
+printerr_s 474
+printerr_sc 475
+printerr_p 476
+print_p_i 477
+print_p_ic 478
+print_p_n 479
+print_p_nc 480
+print_p_s 481
+print_p_sc 482
+print_p_p 483
+read_s_i 484
+read_s_ic 485
+read_s_p_i 486
+read_s_p_ic 487
+readline_s_p 488
+peek_s 489
+peek_s_p 490
+stat_i_s_i 491
+stat_i_sc_i 492
+stat_i_s_ic 493
+stat_i_sc_ic 494
+stat_i_i_i 495
+stat_i_ic_i 496
+stat_i_i_ic 497
+stat_i_ic_ic 498
+seek_p_i_i 499
+seek_p_ic_i 500
+seek_p_i_ic 501
+seek_p_ic_ic 502
+seek_p_i_i_i 503
+seek_p_ic_i_i 504
+seek_p_i_ic_i 505
+seek_p_ic_ic_i 506
+seek_p_i_i_ic 507
+seek_p_ic_i_ic 508
+seek_p_i_ic_ic 509
+seek_p_ic_ic_ic 510
+tell_i_p 511
+tell_i_i_p 512
+abs_i 513
+abs_n 514
+abs_i_i 515
+abs_n_n 516
+abs_p 517
+abs_p_p 518
+add_i_i 519
+add_i_ic 520
+add_n_n 521
+add_n_nc 522
+add_p_p 523
+add_p_i 524
+add_p_ic 525
+add_p_n 526
+add_p_nc 527
+add_i_i_i 528
+add_i_ic_i 529
+add_i_i_ic 530
+add_n_n_n 531
+add_n_nc_n 532
+add_n_n_nc 533
+add_p_p_p 534
+add_p_p_i 535
+add_p_p_ic 536
+add_p_p_n 537
+add_p_p_nc 538
+cmod_i_i_i 539
+cmod_i_ic_i 540
+cmod_i_i_ic 541
+cmod_p_p_i 542
+cmod_p_p_ic 543
+cmod_p_p_p 544
+cmod_n_n_n 545
+cmod_n_nc_n 546
+cmod_n_n_nc 547
+cmod_p_p_n 548
+cmod_p_p_nc 549
+dec_i 550
+dec_n 551
+dec_p 552
+div_i_i 553
+div_i_ic 554
+div_n_n 555
+div_n_nc 556
+div_p_p 557
+div_p_i 558
+div_p_ic 559
+div_p_n 560
+div_p_nc 561
+div_i_i_i 562
+div_i_ic_i 563
+div_i_i_ic 564
+div_i_ic_ic 565
+div_n_n_n 566
+div_n_nc_n 567
+div_n_n_nc 568
+div_n_nc_nc 569
+div_p_p_p 570
+div_p_p_i 571
+div_p_p_ic 572
+div_p_p_n 573
+div_p_p_nc 574
+fdiv_i_i 575
+fdiv_i_ic 576
+fdiv_n_n 577
+fdiv_n_nc 578
+fdiv_p_p 579
+fdiv_p_i 580
+fdiv_p_ic 581
+fdiv_p_n 582
+fdiv_p_nc 583
+fdiv_i_i_i 584
+fdiv_i_ic_i 585
+fdiv_i_i_ic 586
+fdiv_n_n_n 587
+fdiv_n_nc_n 588
+fdiv_n_n_nc 589
+fdiv_p_p_p 590
+fdiv_p_p_i 591
+fdiv_p_p_ic 592
+fdiv_p_p_n 593
+fdiv_p_p_nc 594
+ceil_n 595
+ceil_i_n 596
+ceil_n_n 597
+floor_n 598
+floor_i_n 599
+floor_n_n 600
+inc_i 601
+inc_n 602
+inc_p 603
+mod_i_i 604
+mod_i_ic 605
+mod_n_n 606
+mod_n_nc 607
+mod_p_p 608
+mod_p_i 609
+mod_p_ic 610
+mod_p_n 611
+mod_p_nc 612
+mod_i_i_i 613
+mod_i_ic_i 614
+mod_i_i_ic 615
+mod_n_n_n 616
+mod_n_nc_n 617
+mod_n_n_nc 618
+mod_p_p_p 619
+mod_p_p_i 620
+mod_p_p_ic 621
+mod_p_p_n 622
+mod_p_p_nc 623
+mul_i_i 624
+mul_i_ic 625
+mul_n_n 626
+mul_n_nc 627
+mul_p_p 628
+mul_p_i 629
+mul_p_ic 630
+mul_p_n 631
+mul_p_nc 632
+mul_i_i_i 633
+mul_i_ic_i 634
+mul_i_i_ic 635
+mul_n_n_n 636
+mul_n_nc_n 637
+mul_n_n_nc 638
+mul_p_p_p 639
+mul_p_p_i 640
+mul_p_p_ic 641
+mul_p_p_n 642
+mul_p_p_nc 643
+neg_i 644
+neg_n 645
+neg_p 646
+neg_i_i 647
+neg_n_n 648
+neg_p_p 649
+pow_n_n_n 650
+pow_n_nc_n 651
+pow_n_n_nc 652
+pow_p_p_p 653
+pow_p_p_i 654
+pow_p_p_ic 655
+pow_p_p_n 656
+pow_p_p_nc 657
+pow_n_n_i 658
+pow_n_nc_i 659
+pow_n_n_ic 660
+pow_n_nc_ic 661
+sub_i_i 662
+sub_i_ic 663
+sub_n_n 664
+sub_n_nc 665
+sub_p_p 666
+sub_p_i 667
+sub_p_ic 668
+sub_p_n 669
+sub_p_nc 670
+sub_i_i_i 671
+sub_i_ic_i 672
+sub_i_i_ic 673
+sub_n_n_n 674
+sub_n_nc_n 675
+sub_n_n_nc 676
+sub_p_p_p 677
+sub_p_p_i 678
+sub_p_p_ic 679
+sub_p_p_n 680
+sub_p_p_nc 681
+sqrt_n_n 682
+acos_n_n 683
+asec_n_n 684
+asin_n_n 685
+atan_n_n 686
+atan_n_n_n 687
+atan_n_nc_n 688
+atan_n_n_nc 689
+cos_n_n 690
+cosh_n_n 691
+exp_n_n 692
+ln_n_n 693
+log10_n_n 694
+log2_n_n 695
+sec_n_n 696
+sech_n_n 697
+sin_n_n 698
+sinh_n_n 699
+tan_n_n 700
+tanh_n_n 701
+gcd_i_i_i 702
+gcd_i_ic_i 703
+gcd_i_i_ic 704
+lcm_i_i_i 705
+lcm_i_ic_i 706
+lcm_i_i_ic 707
+fact_i_i 708
+fact_n_i 709
+callmethodcc_p_s 710
+callmethodcc_p_sc 711
+callmethodcc_p_p 712
+callmethod_p_s_p 713
+callmethod_p_sc_p 714
+callmethod_p_p_p 715
+tailcallmethod_p_s 716
+tailcallmethod_p_sc 717
+tailcallmethod_p_p 718
+addmethod_p_s_p 719
+addmethod_p_sc_p 720
+can_i_p_s 721
+can_i_p_sc 722
+does_i_p_s 723
+does_i_p_sc 724
+does_i_p_p 725
+does_i_p_pc 726
+isa_i_p_s 727
+isa_i_p_sc 728
+isa_i_p_p 729
+isa_i_p_pc 730
+newclass_p_s 731
+newclass_p_sc 732
+newclass_p_p 733
+newclass_p_pc 734
+subclass_p_p 735
+subclass_p_pc 736
+subclass_p_p_s 737
+subclass_p_pc_s 738
+subclass_p_p_sc 739
+subclass_p_pc_sc 740
+subclass_p_p_p 741
+subclass_p_pc_p 742
+subclass_p_p_pc 743
+subclass_p_pc_pc 744
+subclass_p_s 745
+subclass_p_sc 746
+subclass_p_s_s 747
+subclass_p_sc_s 748
+subclass_p_s_sc 749
+subclass_p_sc_sc 750
+subclass_p_s_p 751
+subclass_p_sc_p 752
+subclass_p_s_pc 753
+subclass_p_sc_pc 754
+get_class_p_s 755
+get_class_p_sc 756
+get_class_p_p 757
+get_class_p_pc 758
+class_p_p 759
+addparent_p_p 760
+removeparent_p_p 761
+addrole_p_p 762
+addattribute_p_s 763
+addattribute_p_sc 764
+removeattribute_p_s 765
+removeattribute_p_sc 766
+getattribute_p_p_s 767
+getattribute_p_p_sc 768
+getattribute_p_p_p_s 769
+getattribute_p_p_pc_s 770
+getattribute_p_p_p_sc 771
+getattribute_p_p_pc_sc 772
+setattribute_p_s_p 773
+setattribute_p_sc_p 774
+setattribute_p_p_s_p 775
+setattribute_p_pc_s_p 776
+setattribute_p_p_sc_p 777
+setattribute_p_pc_sc_p 778
+inspect_p_p 779
+inspect_p_pc 780
+inspect_p_p_s 781
+inspect_p_pc_s 782
+inspect_p_p_sc 783
+inspect_p_pc_sc 784
+pic_infix___ic_p_p 785
+pic_inline_sub___ic_p_p 786
+pic_get_params___pc 787
+pic_set_returns___pc 788
+pic_callr___pc 789
+new_p_s 790
+new_p_sc 791
+new_p_s_p 792
+new_p_sc_p 793
+new_p_s_pc 794
+new_p_sc_pc 795
+new_p_p 796
+new_p_pc 797
+new_p_p_p 798
+new_p_pc_p 799
+new_p_p_pc 800
+new_p_pc_pc 801
+root_new_p_p 802
+root_new_p_pc 803
+root_new_p_p_p 804
+root_new_p_pc_p 805
+root_new_p_p_pc 806
+root_new_p_pc_pc 807
+typeof_s_p 808
+typeof_p_p 809
+get_repr_s_p 810
+find_method_p_p_s 811
+find_method_p_p_sc 812
+defined_i_p 813
+defined_i_p_ki 814
+defined_i_p_kic 815
+defined_i_p_k 816
+defined_i_p_kc 817
+exists_i_p_ki 818
+exists_i_p_kic 819
+exists_i_p_k 820
+exists_i_p_kc 821
+delete_p_k 822
+delete_p_kc 823
+delete_p_ki 824
+delete_p_kic 825
+elements_i_p 826
+push_p_i 827
+push_p_ic 828
+push_p_n 829
+push_p_nc 830
+push_p_s 831
+push_p_sc 832
+push_p_p 833
+pop_i_p 834
+pop_n_p 835
+pop_s_p 836
+pop_p_p 837
+unshift_p_i 838
+unshift_p_ic 839
+unshift_p_n 840
+unshift_p_nc 841
+unshift_p_s 842
+unshift_p_sc 843
+unshift_p_p 844
+shift_i_p 845
+shift_n_p 846
+shift_s_p 847
+shift_p_p 848
+splice_p_p_i_i 849
+splice_p_p_ic_i 850
+splice_p_p_i_ic 851
+splice_p_p_ic_ic 852
+setprop_p_s_p 853
+setprop_p_sc_p 854
+getprop_p_s_p 855
+getprop_p_sc_p 856
+delprop_p_s 857
+delprop_p_sc 858
+prophash_p_p 859
+freeze_s_p 860
+thaw_p_s 861
+thaw_p_sc 862
+add_multi_s_s_p 863
+add_multi_sc_s_p 864
+add_multi_s_sc_p 865
+add_multi_sc_sc_p 866
+find_multi_p_s_s 867
+find_multi_p_sc_s 868
+find_multi_p_s_sc 869
+find_multi_p_sc_sc 870
+register_p 871
+unregister_p 872
+box_p_i 873
+box_p_ic 874
+box_p_n 875
+box_p_nc 876
+box_p_s 877
+box_p_sc 878
+iter_p_p 879
+morph_p_p 880
+morph_p_pc 881
+clone_s_s 882
+clone_s_sc 883
+exchange_i_i 884
+exchange_p_p 885
+exchange_n_n 886
+exchange_s_s 887
+set_i_i 888
+set_i_ic 889
+set_i_n 890
+set_i_nc 891
+set_i_s 892
+set_i_sc 893
+set_n_n 894
+set_n_nc 895
+set_n_i 896
+set_n_ic 897
+set_n_s 898
+set_n_sc 899
+set_n_p 900
+set_s_p 901
+set_s_s 902
+set_s_sc 903
+set_s_i 904
+set_s_ic 905
+set_s_n 906
+set_s_nc 907
+set_p_pc 908
+set_p_p 909
+set_p_i 910
+set_p_ic 911
+set_p_n 912
+set_p_nc 913
+set_p_s 914
+set_p_sc 915
+set_i_p 916
+assign_p_p 917
+assign_p_i 918
+assign_p_ic 919
+assign_p_n 920
+assign_p_nc 921
+assign_p_s 922
+assign_p_sc 923
+assign_s_s 924
+assign_s_sc 925
+setref_p_p 926
+deref_p_p 927
+setp_ind_i_p 928
+setp_ind_ic_p 929
+setn_ind_i_n 930
+setn_ind_ic_n 931
+setn_ind_i_nc 932
+setn_ind_ic_nc 933
+sets_ind_i_s 934
+sets_ind_ic_s 935
+sets_ind_i_sc 936
+sets_ind_ic_sc 937
+seti_ind_i_i 938
+seti_ind_ic_i 939
+seti_ind_i_ic 940
+seti_ind_ic_ic 941
+set_p_ki_i 942
+set_p_kic_i 943
+set_p_ki_ic 944
+set_p_kic_ic 945
+set_p_ki_n 946
+set_p_kic_n 947
+set_p_ki_nc 948
+set_p_kic_nc 949
+set_p_ki_s 950
+set_p_kic_s 951
+set_p_ki_sc 952
+set_p_kic_sc 953
+set_p_ki_p 954
+set_p_kic_p 955
+set_i_p_ki 956
+set_i_p_kic 957
+set_n_p_ki 958
+set_n_p_kic 959
+set_s_p_ki 960
+set_s_p_kic 961
+set_p_p_ki 962
+set_p_p_kic 963
+set_p_k_i 964
+set_p_kc_i 965
+set_p_k_ic 966
+set_p_kc_ic 967
+set_p_k_n 968
+set_p_kc_n 969
+set_p_k_nc 970
+set_p_kc_nc 971
+set_p_k_s 972
+set_p_kc_s 973
+set_p_k_sc 974
+set_p_kc_sc 975
+set_p_k_p 976
+set_p_kc_p 977
+set_i_p_k 978
+set_i_p_kc 979
+set_n_p_k 980
+set_n_p_kc 981
+set_s_p_k 982
+set_s_p_kc 983
+set_p_p_k 984
+set_p_p_kc 985
+clone_p_p 986
+clone_p_p_p 987
+clone_p_p_pc 988
+copy_p_p 989
+null_s 990
+null_i 991
+null_p 992
+null_n 993
+cleari 994
+clearn 995
+clears 996
+clearp 997
+ord_i_s 998
+ord_i_sc 999
+ord_i_s_i 1000
+ord_i_sc_i 1001
+ord_i_s_ic 1002
+ord_i_sc_ic 1003
+chr_s_i 1004
+chr_s_ic 1005
+chopn_s_i 1006
+chopn_s_ic 1007
+chopn_s_s_i 1008
+chopn_s_sc_i 1009
+chopn_s_s_ic 1010
+chopn_s_sc_ic 1011
+concat_s_s 1012
+concat_s_sc 1013
+concat_p_p 1014
+concat_p_s 1015
+concat_p_sc 1016
+concat_s_s_s 1017
+concat_s_sc_s 1018
+concat_s_s_sc 1019
+concat_p_p_s 1020
+concat_p_p_sc 1021
+concat_p_p_p 1022
+repeat_s_s_i 1023
+repeat_s_sc_i 1024
+repeat_s_s_ic 1025
+repeat_s_sc_ic 1026
+repeat_p_p_i 1027
+repeat_p_p_ic 1028
+repeat_p_p_p 1029
+repeat_p_i 1030
+repeat_p_ic 1031
+repeat_p_p 1032
+length_i_s 1033
+length_i_sc 1034
+bytelength_i_s 1035
+bytelength_i_sc 1036
+pin_s 1037
+unpin_s 1038
+substr_s_s_i 1039
+substr_s_sc_i 1040
+substr_s_s_ic 1041
+substr_s_sc_ic 1042
+substr_s_s_i_i 1043
+substr_s_sc_i_i 1044
+substr_s_s_ic_i 1045
+substr_s_sc_ic_i 1046
+substr_s_s_i_ic 1047
+substr_s_sc_i_ic 1048
+substr_s_s_ic_ic 1049
+substr_s_sc_ic_ic 1050
+substr_s_s_i_i_s 1051
+substr_s_s_ic_i_s 1052
+substr_s_s_i_ic_s 1053
+substr_s_s_ic_ic_s 1054
+substr_s_s_i_i_sc 1055
+substr_s_s_ic_i_sc 1056
+substr_s_s_i_ic_sc 1057
+substr_s_s_ic_ic_sc 1058
+substr_s_i_i_s 1059
+substr_s_ic_i_s 1060
+substr_s_i_ic_s 1061
+substr_s_ic_ic_s 1062
+substr_s_i_i_sc 1063
+substr_s_ic_i_sc 1064
+substr_s_i_ic_sc 1065
+substr_s_ic_ic_sc 1066
+substr_s_p_i_i 1067
+substr_s_p_ic_i 1068
+substr_s_p_i_ic 1069
+substr_s_p_ic_ic 1070
+index_i_s_s 1071
+index_i_sc_s 1072
+index_i_s_sc 1073
+index_i_sc_sc 1074
+index_i_s_s_i 1075
+index_i_sc_s_i 1076
+index_i_s_sc_i 1077
+index_i_sc_sc_i 1078
+index_i_s_s_ic 1079
+index_i_sc_s_ic 1080
+index_i_s_sc_ic 1081
+index_i_sc_sc_ic 1082
+sprintf_s_s_p 1083
+sprintf_s_sc_p 1084
+sprintf_p_p_p 1085
+new_s 1086
+new_s_i 1087
+new_s_ic 1088
+stringinfo_i_s_i 1089
+stringinfo_i_sc_i 1090
+stringinfo_i_s_ic 1091
+stringinfo_i_sc_ic 1092
+upcase_s_s 1093
+upcase_s_sc 1094
+upcase_s 1095
+downcase_s_s 1096
+downcase_s_sc 1097
+downcase_s 1098
+titlecase_s_s 1099
+titlecase_s_sc 1100
+titlecase_s 1101
+join_s_s_p 1102
+join_s_sc_p 1103
+split_p_s_s 1104
+split_p_sc_s 1105
+split_p_s_sc 1106
+split_p_sc_sc 1107
+charset_i_s 1108
+charset_i_sc 1109
+charsetname_s_i 1110
+charsetname_s_ic 1111
+find_charset_i_s 1112
+find_charset_i_sc 1113
+trans_charset_s_i 1114
+trans_charset_s_ic 1115
+trans_charset_s_s_i 1116
+trans_charset_s_sc_i 1117
+trans_charset_s_s_ic 1118
+trans_charset_s_sc_ic 1119
+encoding_i_s 1120
+encoding_i_sc 1121
+encodingname_s_i 1122
+encodingname_s_ic 1123
+find_encoding_i_s 1124
+find_encoding_i_sc 1125
+trans_encoding_s_i 1126
+trans_encoding_s_ic 1127
+trans_encoding_s_s_i 1128
+trans_encoding_s_sc_i 1129
+trans_encoding_s_s_ic 1130
+trans_encoding_s_sc_ic 1131
+is_cclass_i_i_s_i 1132
+is_cclass_i_ic_s_i 1133
+is_cclass_i_i_sc_i 1134
+is_cclass_i_ic_sc_i 1135
+is_cclass_i_i_s_ic 1136
+is_cclass_i_ic_s_ic 1137
+is_cclass_i_i_sc_ic 1138
+is_cclass_i_ic_sc_ic 1139
+find_cclass_i_i_s_i_i 1140
+find_cclass_i_ic_s_i_i 1141
+find_cclass_i_i_sc_i_i 1142
+find_cclass_i_ic_sc_i_i 1143
+find_cclass_i_i_s_ic_i 1144
+find_cclass_i_ic_s_ic_i 1145
+find_cclass_i_i_sc_ic_i 1146
+find_cclass_i_ic_sc_ic_i 1147
+find_cclass_i_i_s_i_ic 1148
+find_cclass_i_ic_s_i_ic 1149
+find_cclass_i_i_sc_i_ic 1150
+find_cclass_i_ic_sc_i_ic 1151
+find_cclass_i_i_s_ic_ic 1152
+find_cclass_i_ic_s_ic_ic 1153
+find_cclass_i_i_sc_ic_ic 1154
+find_cclass_i_ic_sc_ic_ic 1155
+find_not_cclass_i_i_s_i_i 1156
+find_not_cclass_i_ic_s_i_i 1157
+find_not_cclass_i_i_sc_i_i 1158
+find_not_cclass_i_ic_sc_i_i 1159
+find_not_cclass_i_i_s_ic_i 1160
+find_not_cclass_i_ic_s_ic_i 1161
+find_not_cclass_i_i_sc_ic_i 1162
+find_not_cclass_i_ic_sc_ic_i 1163
+find_not_cclass_i_i_s_i_ic 1164
+find_not_cclass_i_ic_s_i_ic 1165
+find_not_cclass_i_i_sc_i_ic 1166
+find_not_cclass_i_ic_sc_i_ic 1167
+find_not_cclass_i_i_s_ic_ic 1168
+find_not_cclass_i_ic_s_ic_ic 1169
+find_not_cclass_i_i_sc_ic_ic 1170
+find_not_cclass_i_ic_sc_ic_ic 1171
+escape_s_s 1172
+compose_s_s 1173
+compose_s_sc 1174
+spawnw_i_s 1175
+spawnw_i_sc 1176
+spawnw_i_p 1177
+err_i 1178
+err_s 1179
+err_s_i 1180
+err_s_ic 1181
+time_i 1182
+time_n 1183
+gmtime_s_i 1184
+gmtime_s_ic 1185
+localtime_s_i 1186
+localtime_s_ic 1187
+decodetime_p_i 1188
+decodetime_p_ic 1189
+decodelocaltime_p_i 1190
+decodelocaltime_p_ic 1191
+sysinfo_s_i 1192
+sysinfo_s_ic 1193
+sysinfo_i_i 1194
+sysinfo_i_ic 1195
+sleep_i 1196
+sleep_ic 1197
+sleep_n 1198
+sleep_nc 1199
+sizeof_i_i 1200
+sizeof_i_ic 1201
+store_lex_s_p 1202
+store_lex_sc_p 1203
+find_lex_p_s 1204
+find_lex_p_sc 1205
+find_caller_lex_p_s 1206
+find_caller_lex_p_sc 1207
+get_namespace_p 1208
+get_namespace_p_p 1209
+get_namespace_p_pc 1210
+get_hll_namespace_p 1211
+get_hll_namespace_p_p 1212
+get_hll_namespace_p_pc 1213
+get_root_namespace_p 1214
+get_root_namespace_p_p 1215
+get_root_namespace_p_pc 1216
+get_global_p_s 1217
+get_global_p_sc 1218
+get_global_p_p_s 1219
+get_global_p_pc_s 1220
+get_global_p_p_sc 1221
+get_global_p_pc_sc 1222
+get_hll_global_p_s 1223
+get_hll_global_p_sc 1224
+get_hll_global_p_p_s 1225
+get_hll_global_p_pc_s 1226
+get_hll_global_p_p_sc 1227
+get_hll_global_p_pc_sc 1228
+get_root_global_p_s 1229
+get_root_global_p_sc 1230
+get_root_global_p_p_s 1231
+get_root_global_p_pc_s 1232
+get_root_global_p_p_sc 1233
+get_root_global_p_pc_sc 1234
+set_global_s_p 1235
+set_global_sc_p 1236
+set_global_p_s_p 1237
+set_global_pc_s_p 1238
+set_global_p_sc_p 1239
+set_global_pc_sc_p 1240
+set_hll_global_s_p 1241
+set_hll_global_sc_p 1242
+set_hll_global_p_s_p 1243
+set_hll_global_pc_s_p 1244
+set_hll_global_p_sc_p 1245
+set_hll_global_pc_sc_p 1246
+set_root_global_s_p 1247
+set_root_global_sc_p 1248
+set_root_global_p_s_p 1249
+set_root_global_pc_s_p 1250
+set_root_global_p_sc_p 1251
+set_root_global_pc_sc_p 1252
+find_name_p_s 1253
+find_name_p_sc 1254
+find_sub_not_null_p_s 1255
+find_sub_not_null_p_sc 1256
Modified: branches/pmc_pct/src/ops/pmc.ops
==============================================================================
--- branches/pmc_pct/src/ops/pmc.ops Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/ops/pmc.ops Thu Jun 4 02:32:48 2009 (r39377)
@@ -125,6 +125,58 @@
########################################
+=item B<root_new>(out PMC, in PMC)
+
+=item B<root_new>(out PMC, in PMC, in PMC)
+
+Instantiate a new object from a key name relative to the root namespace.
+
+ root_new P0, ['parrot';'ResizableBooleanArray']
+
+Optionally a PMC may be passed to the constructor. It's up to the class what
+to do with the initializer.
+
+=cut
+
+op root_new(out PMC, in PMC) {
+ PMC * const key = $2;
+ PMC * const root_ns = interp->root_namespace;
+ PMC * const ns = Parrot_get_namespace_keyed(interp, root_ns, key);
+ PMC * classobj = PMCNULL;
+
+ if (!PMC_IS_NULL(ns))
+ classobj = Parrot_oo_get_class(interp, ns);
+ if (!PMC_IS_NULL(classobj))
+ $1 = VTABLE_instantiate(interp, classobj, PMCNULL);
+ else {
+ opcode_t *dest = Parrot_ex_throw_from_op_args(interp, expr NEXT(),
+ EXCEPTION_NO_CLASS,
+ "Class '%Ss' not found", VTABLE_get_repr(interp, key));
+ goto ADDRESS(dest);
+ }
+}
+
+op root_new(out PMC, in PMC, in PMC) {
+ PMC * const key = $2;
+ PMC * const root_ns = interp->root_namespace;
+ PMC * const ns = Parrot_get_namespace_keyed(interp, root_ns, key);
+ PMC * classobj = PMCNULL;
+
+ if (!PMC_IS_NULL(ns))
+ classobj = Parrot_oo_get_class(interp, ns);
+ if (!PMC_IS_NULL(classobj))
+ $1 = VTABLE_instantiate(interp, classobj, $3);
+ else {
+ opcode_t *dest = Parrot_ex_throw_from_op_args(interp, expr NEXT(),
+ EXCEPTION_NO_CLASS,
+ "Class '%Ss' not found", VTABLE_get_repr(interp, key));
+ goto ADDRESS(dest);
+ }
+}
+
+
+########################################
+
=item B<typeof>(out STR, invar PMC)
=item B<typeof>(out PMC, invar PMC)
Modified: branches/pmc_pct/src/ops/set.ops
==============================================================================
--- branches/pmc_pct/src/ops/set.ops Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/ops/set.ops Thu Jun 4 02:32:48 2009 (r39377)
@@ -490,33 +490,40 @@
=cut
inline op copy(inout PMC, invar PMC) :base_mem {
- PMC * const clone = VTABLE_clone(interp, $2);
-
- /* Preserve the metadata on the destination. */
- PMC * const meta = VTABLE_getprops(interp, $1);
-
- /* avoid leaks and unreachable memory by destroying the destination PMC */
- if (PObj_active_destroy_TEST($1))
- VTABLE_destroy(interp, $1);
-
- /* the source PMC knows how to clone itself, but we must reuse the
- destination header */
- memmove($1, clone, sizeof (PMC));
-
- /* don't let the clone's destruction destroy the destination's data */
- PObj_active_destroy_CLEAR(clone);
- if (PObj_is_PMC_EXT_TEST(clone))
- clone->pmc_ext = NULL;
-
- /* Restore metadata. */
- if (!PMC_IS_NULL(meta)) {
- PMC * const iter = VTABLE_get_iter(interp, meta);
- while (VTABLE_get_bool(interp, iter)) {
- STRING * const key = VTABLE_shift_string(interp, iter);
- PMC * const value = VTABLE_get_pmc_keyed_str(interp, meta, key);
- VTABLE_setprop(interp, $1, key, value);
- }
- }
+ if (PMC_IS_NULL($1)) {
+ opcode_t *dest = expr NEXT();
+ opcode_t *handler = Parrot_ex_throw_from_op_args(interp, dest,
+ EXCEPTION_NULL_REG_ACCESS, "Null PMC in copy");
+ goto ADDRESS(handler);
+ }
+ else {
+ PMC * const clone = VTABLE_clone(interp, $2);
+ /* Preserve the metadata on the destination. */
+ PMC * const meta = VTABLE_getprops(interp, $1);
+
+ /* avoid leaks and unreachable memory by destroying the destination PMC */
+ if (PObj_active_destroy_TEST($1))
+ VTABLE_destroy(interp, $1);
+
+ /* the source PMC knows how to clone itself, but we must reuse the
+ * destination header */
+ memmove($1, clone, sizeof (PMC));
+
+ /* don't let the clone's destruction destroy the destination's data */
+ PObj_active_destroy_CLEAR(clone);
+ if (PObj_is_PMC_EXT_TEST(clone))
+ clone->pmc_ext = NULL;
+
+ /* Restore metadata. */
+ if (!PMC_IS_NULL(meta)) {
+ PMC * const iter = VTABLE_get_iter(interp, meta);
+ while (VTABLE_get_bool(interp, iter)) {
+ STRING * const key = VTABLE_shift_string(interp, iter);
+ PMC * const value = VTABLE_get_pmc_keyed_str(interp, meta, key);
+ VTABLE_setprop(interp, $1, key, value);
+ }
+ }
+ }
}
=back
Modified: branches/pmc_pct/src/packfile.c
==============================================================================
--- branches/pmc_pct/src/packfile.c Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/packfile.c Thu Jun 4 02:32:48 2009 (r39377)
@@ -38,7 +38,8 @@
/* HEADERIZER BEGIN: static */
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
-static void byte_code_destroy(SHIM_INTERP, ARGMOD(PackFile_Segment *self))
+static void byte_code_destroy(PARROT_INTERP, ARGMOD(PackFile_Segment *self))
+ __attribute__nonnull__(1)
__attribute__nonnull__(2)
FUNC_MODIFIES(*self);
@@ -335,7 +336,8 @@
__attribute__nonnull__(3);
#define ASSERT_ARGS_byte_code_destroy __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(self)
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(self)
#define ASSERT_ARGS_byte_code_new __attribute__unused__ int _ASSERT_ARGS_CHECK = 0
#define ASSERT_ARGS_clone_constant __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
@@ -802,10 +804,23 @@
opcode_t i;
for (i = 0; i < ct->const_count; i++) {
- if (constants[i]->type == PFC_PMC) {
- PMC * const pmc = constants[i]->u.key;
- if (pmc)
- Parrot_gc_mark_PObj_alive(interp, (PObj *)pmc);
+ PMC * pmc;
+ STRING * string;
+ switch (constants[i]->type) {
+ case PFC_PMC:
+ case PFC_KEY:
+ pmc = constants[i]->u.key;
+ if (pmc)
+ Parrot_gc_mark_PObj_alive(interp, (PObj *)pmc);
+ break;
+ case PFC_STRING:
+ string = constants[i]->u.string;
+ if (string)
+ Parrot_gc_mark_PObj_alive(interp, (PObj *)string);
+ break;
+ default:
+ /* Do nothing. */
+ break;
}
}
}
@@ -2505,7 +2520,7 @@
*/
static void
-byte_code_destroy(SHIM_INTERP, ARGMOD(PackFile_Segment *self))
+byte_code_destroy(PARROT_INTERP, ARGMOD(PackFile_Segment *self))
{
ASSERT_ARGS(byte_code_destroy)
PackFile_ByteCode * const byte_code = (PackFile_ByteCode *)self;
@@ -3032,7 +3047,7 @@
/* compiling source code uses this function too,
* which gives misleading trace messages */
if (really && Interp_trace_TEST(interp, PARROT_TRACE_SUB_CALL_FLAG)) {
- Interp * const tracer = interp->pdb->debugger
+ Interp * const tracer = interp->pdb && interp->pdb->debugger
? interp->pdb->debugger
: interp;
Parrot_io_eprintf(tracer, "*** switching to %s\n", new_cs->base.name);
@@ -3184,18 +3199,18 @@
for (i = 0; i <= hash->mask; ++i) {
HashBucket *bucket = hash->bi[i];
+
while (bucket) {
PackFile_ConstTable * const table =
(PackFile_ConstTable *)bucket->key;
PackFile_Constant ** const orig_consts = table->constants;
PackFile_Constant ** const consts =
(PackFile_Constant **) bucket->value;
- INTVAL const const_count = table->const_count;
- INTVAL i;
+ INTVAL j;
- for (i = 0; i < const_count; ++i) {
- if (consts[i] != orig_consts[i])
- mem_sys_free(consts[i]);
+ for (j = 0; j < table->const_count; ++j) {
+ if (consts[j] != orig_consts[j])
+ mem_sys_free(consts[j]);
}
mem_sys_free(consts);
@@ -3670,7 +3685,7 @@
PARROT_WARN_UNUSED_RESULT
PARROT_CAN_RETURN_NULL
const opcode_t *
-PackFile_ConstTable_unpack(PARROT_INTERP, ARGOUT(PackFile_Segment *seg),
+PackFile_ConstTable_unpack(PARROT_INTERP, ARGIN(PackFile_Segment *seg),
ARGIN(const opcode_t *cursor))
{
ASSERT_ARGS(PackFile_ConstTable_unpack)
@@ -4036,8 +4051,6 @@
else
head = tail = constant_pmc_new(interp, pmc_enum);
- VTABLE_init(interp, tail);
-
op = PF_fetch_opcode(pf, &cursor);
switch (type) {
@@ -4193,32 +4206,35 @@
ARGMOD(opcode_t *cursor))
{
ASSERT_ARGS(PackFile_Annotations_pack)
- PackFile_Annotations *self = (PackFile_Annotations *)seg;
+ const PackFile_Annotations * const self = (PackFile_Annotations *)seg;
INTVAL i;
/* Write key count and any keys. */
*cursor++ = self->num_keys;
for (i = 0; i < self->num_keys; i++) {
- *cursor++ = self->keys[i]->name;
- *cursor++ = self->keys[i]->type;
+ const PackFile_Annotations_Key * const key = self->keys[i];
+ *cursor++ = key->name;
+ *cursor++ = key->type;
}
/* Write group count and any groups. */
*cursor++ = self->num_groups;
for (i = 0; i < self->num_groups; i++) {
- *cursor++ = self->groups[i]->bytecode_offset;
- *cursor++ = self->groups[i]->entries_offset;
+ const PackFile_Annotations_Group * const group = self->groups[i];
+ *cursor++ = group->bytecode_offset;
+ *cursor++ = group->entries_offset;
}
/* Write entry count and any entries. */
*cursor++ = self->num_entries;
for (i = 0; i < self->num_entries; i++) {
- *cursor++ = self->entries[i]->bytecode_offset;
- *cursor++ = self->entries[i]->key;
- *cursor++ = self->entries[i]->value;
+ const PackFile_Annotations_Entry * const entry = self->entries[i];
+ *cursor++ = entry->bytecode_offset;
+ *cursor++ = entry->key;
+ *cursor++ = entry->value;
}
return cursor;
@@ -4259,11 +4275,12 @@
self->keys = mem_allocate_n_typed(self->num_keys, PackFile_Annotations_Key *);
for (i = 0; i < self->num_keys; i++) {
- self->keys[i] = mem_allocate_typed(PackFile_Annotations_Key);
- self->keys[i]->name = PF_fetch_opcode(seg->pf, &cursor);
- self->keys[i]->type = PF_fetch_opcode(seg->pf, &cursor);
+ PackFile_Annotations_Key * const key =
+ self->keys[i] = mem_allocate_typed(PackFile_Annotations_Key);
+ key->name = PF_fetch_opcode(seg->pf, &cursor);
+ key->type = PF_fetch_opcode(seg->pf, &cursor);
TRACE_PRINTF_VAL(("PackFile_Annotations_unpack: key[%d]/%d name=%s type=%d\n",
- i, self->num_keys, self->keys[i]->name, self->keys[i]->type));
+ i, self->num_keys, key->name, key->type));
}
/* Unpack groups. */
@@ -4271,23 +4288,25 @@
self->groups = mem_allocate_n_typed(self->num_groups, PackFile_Annotations_Group *);
for (i = 0; i < self->num_groups; i++) {
- self->groups[i] = mem_allocate_typed(PackFile_Annotations_Group);
- self->groups[i]->bytecode_offset = PF_fetch_opcode(seg->pf, &cursor);
- self->groups[i]->entries_offset = PF_fetch_opcode(seg->pf, &cursor);
+ PackFile_Annotations_Group * const group =
+ self->groups[i] = mem_allocate_typed(PackFile_Annotations_Group);
+ group->bytecode_offset = PF_fetch_opcode(seg->pf, &cursor);
+ group->entries_offset = PF_fetch_opcode(seg->pf, &cursor);
TRACE_PRINTF_VAL((
"PackFile_Annotations_unpack: group[%d]/%d bytecode_offset=%d entries_offset=%d\n",
- i, self->num_groups, self->groups[i]->bytecode_offset,
- self->groups[i]->entries_offset));
+ i, self->num_groups, group->bytecode_offset,
+ group->entries_offset));
}
/* Unpack entries. */
self->num_entries = PF_fetch_opcode(seg->pf, &cursor);
self->entries = mem_allocate_n_typed(self->num_entries, PackFile_Annotations_Entry *);
for (i = 0; i < self->num_entries; i++) {
- self->entries[i] = mem_allocate_typed(PackFile_Annotations_Entry);
- self->entries[i]->bytecode_offset = PF_fetch_opcode(seg->pf, &cursor);
- self->entries[i]->key = PF_fetch_opcode(seg->pf, &cursor);
- self->entries[i]->value = PF_fetch_opcode(seg->pf, &cursor);
+ PackFile_Annotations_Entry * const entry =
+ self->entries[i] = mem_allocate_typed(PackFile_Annotations_Entry);
+ entry->bytecode_offset = PF_fetch_opcode(seg->pf, &cursor);
+ entry->key = PF_fetch_opcode(seg->pf, &cursor);
+ entry->value = PF_fetch_opcode(seg->pf, &cursor);
}
/* Need to associate this segment with the applicable code segment. */
@@ -4335,13 +4354,14 @@
/* Dump keys. */
Parrot_io_printf(interp, "\n keys => [\n");
for (i = 0; i < self->num_keys; i++) {
+ const PackFile_Annotations_Key * const key = self->keys[i];
Parrot_io_printf(interp, " #%d\n [\n", i);
Parrot_io_printf(interp, " NAME => %Ss\n",
- PF_CONST(self->code, self->keys[i]->name)->u.string);
+ PF_CONST(self->code, key->name)->u.string);
Parrot_io_printf(interp, " TYPE => %s\n",
- self->keys[i]->type == PF_ANNOTATION_KEY_TYPE_INT ? "integer" :
- self->keys[i]->type == PF_ANNOTATION_KEY_TYPE_STR ? "string" :
- self->keys[i]->type == PF_ANNOTATION_KEY_TYPE_NUM ? "number" :
+ key->type == PF_ANNOTATION_KEY_TYPE_INT ? "integer" :
+ key->type == PF_ANNOTATION_KEY_TYPE_STR ? "string" :
+ key->type == PF_ANNOTATION_KEY_TYPE_NUM ? "number" :
"PMC");
Parrot_io_printf(interp, " ],\n");
}
@@ -4351,11 +4371,12 @@
/* Dump groups. */
Parrot_io_printf(interp, "\n groups => [\n");
for (i = 0; i < self->num_groups; i++) {
+ const PackFile_Annotations_Group * const group = self->groups[i];
Parrot_io_printf(interp, " #%d\n [\n", i);
Parrot_io_printf(interp, " BYTECODE_OFFSET => %d\n",
- self->groups[i]->bytecode_offset);
+ group->bytecode_offset);
Parrot_io_printf(interp, " ENTRIES_OFFSET => %d\n",
- self->groups[i]->entries_offset);
+ group->entries_offset);
Parrot_io_printf(interp, " ],\n");
}
@@ -4365,13 +4386,14 @@
Parrot_io_printf(interp, "\n entries => [\n");
for (i = 0; i < self->num_entries; i++) {
+ const PackFile_Annotations_Entry * const entry = self->entries[i];
Parrot_io_printf(interp, " #%d\n [\n", i);
Parrot_io_printf(interp, " BYTECODE_OFFSET => %d\n",
- self->entries[i]->bytecode_offset);
+ entry->bytecode_offset);
Parrot_io_printf(interp, " KEY => %d\n",
- self->entries[i]->key);
+ entry->key);
Parrot_io_printf(interp, " VALUE => %d\n",
- self->entries[i]->value);
+ entry->value);
Parrot_io_printf(interp, " ],\n");
}
@@ -4571,7 +4593,7 @@
if (key) {
for (i = 0; i < self->num_keys; i++) {
- STRING *test_key = PF_CONST(self->code, self->keys[i]->name)->u.string;
+ STRING * const test_key = PF_CONST(self->code, self->keys[i]->name)->u.string;
if (Parrot_str_equal(interp, test_key, key)) {
key_id = i;
break;
@@ -4612,7 +4634,7 @@
for (i = 0; i < self->num_keys; i++) {
if (have_values[i]) {
- STRING *key_name = PF_CONST(self->code, self->keys[i]->name)->u.string;
+ STRING * const key_name = PF_CONST(self->code, self->keys[i]->name)->u.string;
VTABLE_set_pmc_keyed_str(interp, result, key_name,
make_annotation_value_pmc(interp, self, self->keys[i]->type,
latest_values[i]));
@@ -4665,10 +4687,10 @@
enum_runtime_ft file_type)
{
ASSERT_ARGS(compile_or_load_file)
- char *filename = Parrot_str_to_cstring(interp, path);
+ char * const filename = Parrot_str_to_cstring(interp, path);
if (file_type == PARROT_RUNTIME_FT_PBC) {
- PackFile *pf = PackFile_append_pbc(interp, filename);
+ PackFile * const pf = PackFile_append_pbc(interp, filename);
Parrot_str_free_cstring(filename);
if (!pf)
@@ -4809,6 +4831,7 @@
{
ASSERT_ARGS(Parrot_load_bytecode)
STRING *wo_ext, *ext, *pbc, *path;
+ STRING *found_path, *found_ext;
PMC *is_loaded_hash;
enum_runtime_ft file_type;
@@ -4840,6 +4863,16 @@
/* remember wo_ext => full_path mapping */
VTABLE_set_string_keyed_str(interp, is_loaded_hash, wo_ext, path);
+ parrot_split_path_ext(interp, path, &found_path, &found_ext);
+
+ /* Check if the file found was actually a bytecode file (.pbc
+ * extension) or a source file (.pir or .pasm extension). */
+
+ if (Parrot_str_equal(interp, found_ext, pbc))
+ file_type = PARROT_RUNTIME_FT_PBC;
+ else
+ file_type = PARROT_RUNTIME_FT_SOURCE;
+
compile_or_load_file(interp, path, file_type);
}
Modified: branches/pmc_pct/src/packfile/pf_items.c
==============================================================================
--- branches/pmc_pct/src/packfile/pf_items.c Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/packfile/pf_items.c Thu Jun 4 02:32:48 2009 (r39377)
@@ -1306,42 +1306,43 @@
PF_fetch_string(PARROT_INTERP, ARGIN_NULLOK(PackFile *pf), ARGIN(const opcode_t **cursor))
{
ASSERT_ARGS(PF_fetch_string)
- UINTVAL flags;
- opcode_t charset_nr;
- size_t size;
- STRING *s;
+ STRING *s;
+ UINTVAL flags = PF_fetch_opcode(pf, cursor);
const int wordsize = pf ? pf->header->wordsize : sizeof (opcode_t);
- const char *charset_name;
+ size_t size;
+ opcode_t charset_nr;
- flags = PF_fetch_opcode(pf, cursor);
/* don't let PBC mess our internals - only constant or not */
- flags &= (PObj_constant_FLAG | PObj_private7_FLAG);
- charset_nr = PF_fetch_opcode(pf, cursor);
+ flags &= (PObj_constant_FLAG | PObj_private7_FLAG);
+ charset_nr = PF_fetch_opcode(pf, cursor);
/* These may need to be separate */
- size = (size_t)PF_fetch_opcode(pf, cursor);
+ size = (size_t)PF_fetch_opcode(pf, cursor);
+
TRACE_PRINTF(("PF_fetch_string(): flags=0x%04x, ", flags));
TRACE_PRINTF(("charset_nr=%ld, ", charset_nr));
TRACE_PRINTF(("size=%ld.\n", size));
- charset_name = Parrot_charset_c_name(interp, charset_nr);
- s = string_make(interp, (const char *)*cursor, size, charset_name, flags);
+
+ s = string_make_from_charset(interp, (const char *)*cursor,
+ size, charset_nr, flags);
/* print only printable characters */
TRACE_PRINTF_VAL(("PF_fetch_string(): string is '%s' at 0x%x\n",
s->strstart, OFFS(pf, *cursor)));
-/* s = string_make(interp, *cursor, size,
- encoding_lookup_index(encoding),
- flags); */
TRACE_PRINTF_ALIGN(("-s ROUND_UP_B: cursor=0x%x, size=%d, wordsize=%d\n",
(const char *)*cursor + size, size, wordsize));
+
size = ROUND_UP_B(size, wordsize);
+
TRACE_PRINTF(("PF_fetch_string(): round size up to %ld.\n", size));
*((const unsigned char **) (cursor)) += size;
+
TRACE_PRINTF_ALIGN(("+s ROUND_UP_B: cursor=0x%x, size=%d\n", *cursor, size));
return s;
}
+
/*
=item C<opcode_t* PF_store_string(opcode_t *cursor, const STRING *s)>
Modified: branches/pmc_pct/src/pic.c
==============================================================================
--- branches/pmc_pct/src/pic.c Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/pic.c Thu Jun 4 02:32:48 2009 (r39377)
@@ -124,11 +124,6 @@
__attribute__nonnull__(3)
FUNC_MODIFIES(*mic);
-static void parrot_pic_move(PARROT_INTERP, ARGMOD(Parrot_MIC *mic))
- __attribute__nonnull__(1)
- __attribute__nonnull__(2)
- FUNC_MODIFIES(*mic);
-
static int pass_int(PARROT_INTERP,
ARGIN(PMC *sig),
ARGIN(const char *src_base),
@@ -207,9 +202,6 @@
PARROT_ASSERT_ARG(interp) \
|| PARROT_ASSERT_ARG(pc) \
|| PARROT_ASSERT_ARG(mic)
-#define ASSERT_ARGS_parrot_pic_move __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(mic)
#define ASSERT_ARGS_pass_int __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
|| PARROT_ASSERT_ARG(sig) \
@@ -913,40 +905,6 @@
/*
-=item C<static void parrot_pic_move(PARROT_INTERP, Parrot_MIC *mic)>
-
-=cut
-
-*/
-
-static void
-parrot_pic_move(PARROT_INTERP, ARGMOD(Parrot_MIC *mic))
-{
- ASSERT_ARGS(parrot_pic_move)
- /* MIC slot is empty - use it */
- if (!mic->lru.u.type)
- return;
-
- /* need more cache slots - allocate one PIC */
- if (!mic->pic) {
- mic->pic = parrot_PIC_alloc_pic(interp);
- }
- else {
- /* PIC was already used - shift slots up */
- Parrot_PIC * const pic = mic->pic;
-
- pic->lru[2].u.type = pic->lru[1].u.type;
- pic->lru[2].f.sub = pic->lru[1].f.sub;
- pic->lru[1].u.type = pic->lru[0].u.type;
- pic->lru[1].f.sub = pic->lru[0].f.sub;
- pic->lru[0].u.type = mic->lru.u.type;
- pic->lru[0].f.sub = mic->lru.f.sub;
- mic->lru.u.type = 0;
- }
-}
-
-/*
-
=item C<void parrot_pic_find_infix_v_pp(PARROT_INTERP, PMC *left, PMC *right,
Parrot_MIC *mic, opcode_t *cur_opcode)>
Modified: branches/pmc_pct/src/pmc.c
==============================================================================
--- branches/pmc_pct/src/pmc.c Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/pmc.c Thu Jun 4 02:32:48 2009 (r39377)
@@ -18,12 +18,18 @@
#include "parrot/parrot.h"
#include "pmc.str"
+#include "pmc/pmc_class.h"
/* HEADERIZER HFILE: include/parrot/pmc.h */
/* HEADERIZER BEGIN: static */
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
+static void check_pmc_reuse_flags(PARROT_INTERP,
+ UINTVAL srcflags,
+ UINTVAL destflags)
+ __attribute__nonnull__(1);
+
PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
static PMC * create_class_pmc(PARROT_INTERP, INTVAL type)
@@ -36,16 +42,21 @@
UINTVAL flags)
__attribute__nonnull__(1);
-static void pmc_free(PARROT_INTERP, ARGMOD(PMC *pmc))
+static INTVAL pmc_reuse_check_pmc_ext(PARROT_INTERP,
+ ARGMOD(PMC * pmc),
+ INTVAL newflags,
+ INTVAL flags)
__attribute__nonnull__(1)
__attribute__nonnull__(2)
- FUNC_MODIFIES(*pmc);
+ FUNC_MODIFIES(* pmc);
+#define ASSERT_ARGS_check_pmc_reuse_flags __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp)
#define ASSERT_ARGS_create_class_pmc __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp)
#define ASSERT_ARGS_get_new_pmc_header __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp)
-#define ASSERT_ARGS_pmc_free __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+#define ASSERT_ARGS_pmc_reuse_check_pmc_ext __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
|| PARROT_ASSERT_ARG(pmc)
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
@@ -119,9 +130,11 @@
Reuse an existing PMC, turning it into an empty PMC of the new type. Any
required internal structure will be put in place (such as the extension area)
-and the PMC will be ready to go. This will throw an exception if the PMC is
-constant or of a singleton type (such as the environment PMC) or is being
-turned into a PMC of a singleton type.
+and the PMC will be ready to go.
+
+Cannot currently handle converting a non-Object PMC into an Object. Use
+C<pmc_reuse_by_class> for that.
+
=cut
@@ -129,13 +142,14 @@
PARROT_EXPORT
PARROT_CANNOT_RETURN_NULL
+PARROT_IGNORABLE_RESULT
PMC *
pmc_reuse(PARROT_INTERP, ARGIN(PMC *pmc), INTVAL new_type,
SHIM(UINTVAL flags))
{
ASSERT_ARGS(pmc_reuse)
VTABLE *new_vtable;
- INTVAL has_ext, new_flags;
+ INTVAL has_ext, new_flags = 0;
if (pmc->vtable->base_type == new_type)
return pmc;
@@ -143,71 +157,164 @@
new_vtable = interp->vtables[new_type];
/* Singleton/const PMCs/types are not eligible */
+ check_pmc_reuse_flags(interp, pmc->vtable->flags, new_vtable->flags);
+
+ /* Does the old PMC need any resources freed? */
+ if (PObj_active_destroy_TEST(pmc))
+ VTABLE_destroy(interp, pmc);
+
+ new_flags = pmc_reuse_check_pmc_ext(interp, pmc, new_flags, new_vtable->flags);
+
+ /* we are a PMC + maybe is_PMC_EXT */
+ PObj_flags_SETTO(pmc, PObj_is_PMC_FLAG | new_flags);
+
+ /* Set the right vtable */
+ pmc->vtable = new_vtable;
+
+ /* Call the base init for the redone pmc. Warning, this should not
+ be called on Object PMCs. */
+ VTABLE_init(interp, pmc);
+
+ return pmc;
+}
+
+/*
+
+=item C<PMC * pmc_reuse_by_class(PARROT_INTERP, PMC * pmc, PMC * class_, UINTVAL
+flags)>
+
+Reuse an existing PMC. Convert it to the type specified by the given Class
+PMC. At the moment, this means we can only use this function to reuse PMCs
+into types with Classes (not built-in PMCs). Use C<pmc_reuse> if you need
+to convert to a built-in PMC type.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+PARROT_CANNOT_RETURN_NULL
+PARROT_IGNORABLE_RESULT
+PMC *
+pmc_reuse_by_class(PARROT_INTERP, ARGMOD(PMC * pmc), ARGIN(PMC * class_),
+ UINTVAL flags)
+{
+ ASSERT_ARGS(pmc_reuse_by_class)
+ const INTVAL new_type = PARROT_CLASS(class_)->id;
+ VTABLE * const new_vtable = interp->vtables[new_type];
+ INTVAL new_flags = flags;
+
+ if (pmc->vtable->base_type == new_type)
+ return pmc;
+
+ /* Singleton/const PMCs/types are not eligible */
+ check_pmc_reuse_flags(interp, pmc->vtable->flags, new_vtable->flags);
- if ((pmc->vtable->flags | new_vtable->flags)
- & (VTABLE_PMC_IS_SINGLETON | VTABLE_IS_CONST_FLAG))
+ /* Does the old PMC need any resources freed? */
+ if (PObj_active_destroy_TEST(pmc))
+ VTABLE_destroy(interp, pmc);
+
+ new_flags = pmc_reuse_check_pmc_ext(interp, pmc, new_flags, new_vtable->flags);
+
+ /* we are a PMC + maybe is_PMC_EXT */
+ PObj_flags_SETTO(pmc, PObj_is_PMC_FLAG | new_flags);
+
+ /* Set the right vtable */
+ pmc->vtable = new_vtable;
+
+ return pmc;
+}
+
+
+/*
+
+=item C<static void check_pmc_reuse_flags(PARROT_INTERP, UINTVAL srcflags,
+UINTVAL destflags)>
+
+We're converting one PMC type to another, either in C<pmc_reuse> or
+C<pmc_reuse_by_class>. Check to make sure that neither the existing PMC
+or the intended target PMC type are singletons or constants. We throw an
+exception if we are attempting an illegal operation.
+
+=cut
+
+*/
+
+static void
+check_pmc_reuse_flags(PARROT_INTERP, UINTVAL srcflags, UINTVAL destflags)
+{
+ ASSERT_ARGS(check_pmc_reuse_flags)
+ if ((srcflags | destflags) & (VTABLE_PMC_IS_SINGLETON | VTABLE_IS_CONST_FLAG))
{
/* First, is the destination a singleton? No joy for us there */
- if (new_vtable->flags & VTABLE_PMC_IS_SINGLETON)
+ if (destflags & VTABLE_PMC_IS_SINGLETON)
Parrot_ex_throw_from_c_args(interp, NULL,
EXCEPTION_ALLOCATION_ERROR,
"Parrot VM: Can't turn to a singleton type!\n");
- /* First, is the destination a constant? No joy for us there */
- if (new_vtable->flags & VTABLE_IS_CONST_FLAG)
+ /* Is the destination a constant? No joy for us there */
+ if (destflags & VTABLE_IS_CONST_FLAG)
Parrot_ex_throw_from_c_args(interp, NULL,
EXCEPTION_ALLOCATION_ERROR,
"Parrot VM: Can't turn to a constant type!\n");
/* Is the source a singleton? */
- if (pmc->vtable->flags & VTABLE_PMC_IS_SINGLETON)
+ if (srcflags & VTABLE_PMC_IS_SINGLETON)
Parrot_ex_throw_from_c_args(interp, NULL,
EXCEPTION_ALLOCATION_ERROR,
"Parrot VM: Can't modify a singleton\n");
/* Is the source constant? */
- if (pmc->vtable->flags & VTABLE_IS_CONST_FLAG)
+ if (srcflags & VTABLE_IS_CONST_FLAG)
Parrot_ex_throw_from_c_args(interp, NULL,
EXCEPTION_ALLOCATION_ERROR,
"Parrot VM: Can't modify a constant\n");
}
+}
- /* Does the old PMC need any resources freed? */
- if (PObj_active_destroy_TEST(pmc))
- VTABLE_destroy(interp, pmc);
+/*
+
+=item C<static INTVAL pmc_reuse_check_pmc_ext(PARROT_INTERP, PMC * pmc, INTVAL
+newflags, INTVAL flags)>
+
+We are converting one PMC type into another, such as in C<pmc_reuse> or
+C<pmc_reuse_by_class>. Check to make sure that we have a pmc_ext if we need
+one, and that we don't have it if we don't need it. Returns the updated
+flags field with the C<PObj_is_PMC_EXT> flag set if necessary.
+
+=cut
+*/
+
+static INTVAL
+pmc_reuse_check_pmc_ext(PARROT_INTERP, ARGMOD(PMC * pmc),
+ INTVAL newflags, INTVAL flags)
+{
+ ASSERT_ARGS(pmc_reuse_check_pmc_ext)
/* Do we have an extension area? */
- has_ext = (PObj_is_PMC_EXT_TEST(pmc) && pmc->pmc_ext);
+ INTVAL const has_ext = (PObj_is_PMC_EXT_TEST(pmc) && pmc->pmc_ext);
/* Do we need one? */
- if (new_vtable->flags & VTABLE_PMC_NEEDS_EXT) {
+ if (flags & VTABLE_PMC_NEEDS_EXT) {
/* If we need an ext area, go allocate one */
if (!has_ext)
Parrot_gc_add_pmc_ext(interp, pmc);
-
- new_flags = PObj_is_PMC_EXT_FLAG;
+ newflags |= PObj_is_PMC_EXT_FLAG;
+ PARROT_ASSERT(pmc->pmc_ext != NULL);
+ PARROT_ASSERT((newflags & PObj_is_PMC_EXT_FLAG) != 0);
}
else {
if (has_ext)
Parrot_gc_free_pmc_ext(interp, pmc);
-
+ pmc->pmc_ext = NULL;
PMC_data(pmc) = NULL;
- new_flags = 0;
+ newflags &= ~PObj_is_PMC_EXT_FLAG;
+ PARROT_ASSERT((newflags & PObj_is_PMC_EXT_FLAG) == 0);
+ PARROT_ASSERT(pmc->pmc_ext == NULL);
}
-
- /* we are a PMC + maybe is_PMC_EXT */
- PObj_flags_SETTO(pmc, PObj_is_PMC_FLAG | new_flags);
-
- /* Set the right vtable */
- pmc->vtable = new_vtable;
-
- /* Call the base init for the redone pmc */
- VTABLE_init(interp, pmc);
-
- return pmc;
+ return newflags;
}
-
/*
=item C<static PMC * get_new_pmc_header(PARROT_INTERP, INTVAL base_type, UINTVAL
@@ -431,16 +538,20 @@
=item C<PMC * temporary_pmc_new(PARROT_INTERP, INTVAL base_type)>
-Creates a new temporary PMC of type C<base_type>, the call C<init>. B<You> are
-responsible for freeing this PMC when it goes out of scope with
-C<free_temporary_pmc()>. B<Do not> store this PMC in any other PMCs, or allow
-it to be stored. B<Do not> store any regular PMC in this PMC, or allow the
-storage of any regular PMC in this PMC.
-
-If you don't know what this means means, or you can't tell if either case will
-happen as the result of any call you make on or with this PMC, B<DO NOT> use
-this function, lest you cause weird crashes and memory errors. Use
-C<pmc_new()> instead.
+Creates a new temporary PMC of type C<base_type>, then call C<init>. Cannot
+be used to create PMC Objects which have been defined from PIR.
+
+B<You> are responsible for freeing this PMC when it goes out of scope with
+C<free_temporary_pmc()>. B<Do not> store this PMC in any other PMCs, or
+allow it to be stored. B<Do not> store any regular PMC in this PMC, or
+allow the storage of any regular PMC in this PMC. Temporary PMCs do not
+participate in garbage collection, and mixing them with PMCs that are
+garbage-collected will cause bugs.
+
+If you don't know what this means means, or you can't tell if either case
+will happen as the result of any call you make on or with this PMC,
+B<DO NOT> use this function, lest you cause weird crashes and memory errors.
+Use C<pmc_new()> instead.
(Why do these functions even exist? Used judiciously, they can reduce GC
pressure in hotspots tremendously. If you haven't audited the code carefully
@@ -461,14 +572,15 @@
return pmc;
}
+
/*
=item C<void temporary_pmc_free(PARROT_INTERP, PMC *pmc)>
-Frees a new temporary PMC created by C<temporary_pmc_new()>. Do not call this
-with any other type of PMC. Do not forget to call this (or you'll leak PMCs).
-Read and I<understand> the warnings for C<temporary_pmc_new()> before you're
-tempted to use this.
+Frees a new temporary PMC created by C<temporary_pmc_new()>. Do not call
+this with any other type of PMC. Do not forget to call this (or you'll leak
+PMCs). Read and I<understand> the warnings for C<temporary_pmc_new()> before
+you're tempted to use this.
=cut
@@ -481,26 +593,6 @@
Parrot_gc_free_pmc_header(interp, pmc);
}
-/*
-
-=item C<static void pmc_free(PARROT_INTERP, PMC *pmc)>
-
-Free the given PMC. This function does not call the custom destroy VTABLE if
-one is specified for PMCs of that type (should it?).
-
-TT #663: As of r38727, this function is not called from anywhere
-
-=cut
-
-*/
-
-static void
-pmc_free(PARROT_INTERP, ARGMOD(PMC *pmc))
-{
- ASSERT_ARGS(pmc_free)
- Parrot_gc_free_pmc_header(interp, pmc);
-
-}
/*
Modified: branches/pmc_pct/src/pmc/array.pmc
==============================================================================
--- branches/pmc_pct/src/pmc/array.pmc Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/pmc/array.pmc Thu Jun 4 02:32:48 2009 (r39377)
@@ -46,7 +46,7 @@
static PMC *retval(PARROT_INTERP, void *ret) {
PMC *value;
- if (ret == 0)
+ if (ret == NULL)
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_OUT_OF_BOUNDS,
"Array index out of bounds!");
@@ -82,12 +82,12 @@
void * const ret = list_get(interp, list, key, enum_type_PMC);
PMC *value;
- if (ret == 0)
+ if (ret == NULL)
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_OUT_OF_BOUNDS,
"Array index out of bounds!");
/* assign into a sparse or not yet set value */
- if (ret == (void *)-1 || *(PMC **)ret == 0) {
+ if (ret == (void *)-1 || *(PMC **)ret == NULL) {
value = undef(interp);
list_assign(interp, list, key, value, enum_type_PMC);
}
@@ -263,7 +263,7 @@
*/
VTABLE INTVAL elements() {
- return ((List *) PMC_data(SELF))->length;
+ return ((const List *) PMC_data(SELF))->length;
}
/*
@@ -277,7 +277,7 @@
*/
VTABLE FLOATVAL get_number() {
- INTVAL e = SELF.elements();
+ const INTVAL e = SELF.elements();
return (FLOATVAL)e;
}
@@ -421,7 +421,7 @@
PMC *nextkey, *box;
if (!key)
- return 0;
+ return NULL;
ix = VTABLE_get_integer(INTERP, key);
nextkey = key_next(INTERP, key);
@@ -468,7 +468,7 @@
PMC *nextkey, *box;
if (!key)
- return 0;
+ return NULL;
ix = VTABLE_get_integer(INTERP, key);
nextkey = key_next(INTERP, key);
@@ -1006,7 +1006,7 @@
void * const ret =
list_get(INTERP, (List *)PMC_data(pmc), key, enum_type_PMC);
- if (ret == 0 || ret == (void *) -1)
+ if (ret == NULL || ret == (void *) -1)
return 0;
value = *(PMC **)ret;
@@ -1058,7 +1058,7 @@
void * ret = list_get(INTERP,
(List *)PMC_data(pmc), key, enum_type_PMC);
- if (ret == 0 || ret == (void *)-1)
+ if (ret == NULL || ret == (void *)-1)
return 0;
return !PMC_IS_NULL(*(PMC **)ret);
@@ -1146,7 +1146,7 @@
PMC * const item2 = VTABLE_get_pmc_keyed_int(INTERP, value, j);
if (item1 != item2) {
- INTVAL result = VTABLE_is_equal(INTERP, item1, item2);
+ const INTVAL result = VTABLE_is_equal(INTERP, item1, item2);
if (!result)
return 0;
}
@@ -1173,7 +1173,7 @@
VTABLE PMC *slice(PMC *key, INTVAL f) {
if (f == 0) {
- STRING *name = CONST_STRING(interp, "set_key");
+ STRING * const name = CONST_STRING(interp, "set_key");
PMC * const iter = pmc_new_init(INTERP, enum_class_Iterator, SELF);
Parrot_PCCINVOKE(interp, iter, name, "P->", key);
return iter;
@@ -1184,7 +1184,7 @@
}
VTABLE PMC *get_iter() {
- STRING *name = CONST_STRING(interp, "set_key");
+ STRING * const name = CONST_STRING(interp, "set_key");
PMC * const iter = pmc_new_init(INTERP, enum_class_Iterator, SELF);
PMC * const key = pmc_new(INTERP, enum_class_Key);
Parrot_PCCINVOKE(interp, iter, name, "P->", key);
Modified: branches/pmc_pct/src/pmc/bigint.pmc
==============================================================================
--- branches/pmc_pct/src/pmc/bigint.pmc Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/pmc/bigint.pmc Thu Jun 4 02:32:48 2009 (r39377)
@@ -311,7 +311,6 @@
static void
bigint_abs(PARROT_INTERP, PMC *self, PMC *dest) {
BIGINT *bi_self, *bi_dest;
- pmc_reuse(interp, dest, enum_class_BigInt, 0);
GETATTR_BigInt_bi(interp, self, bi_self);
GETATTR_BigInt_bi(interp, dest, bi_dest);
mpz_abs(bi_dest->b, bi_self->b);
@@ -320,7 +319,6 @@
static void
bigint_neg(PARROT_INTERP, PMC *self, PMC *dest) {
BIGINT *bi_self, *bi_dest;
- pmc_reuse(interp, dest, enum_class_BigInt, 0);
GETATTR_BigInt_bi(interp, self, bi_self);
GETATTR_BigInt_bi(interp, dest, bi_dest);
mpz_neg(bi_dest->b, bi_self->b);
@@ -837,14 +835,14 @@
}
MULTI PMC *add(BigInt value, PMC *dest) {
- dest = pmc_new(INTERP, SELF->vtable->base_type);
+ dest = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
bigint_add_bigint(INTERP, SELF, value, dest);
return dest;
}
MULTI PMC *add(Integer value, PMC *dest) {
- dest = pmc_new(INTERP, SELF->vtable->base_type);
+ dest = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
bigint_add_bigint_int(INTERP, SELF, VTABLE_get_integer(interp, value), dest);
return dest;
@@ -859,7 +857,7 @@
}
VTABLE PMC *add_int(INTVAL value, PMC *dest) {
- dest = pmc_new(INTERP, SELF->vtable->base_type);
+ dest = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
bigint_add_bigint_int(INTERP, SELF, value, dest);
return dest;
@@ -893,20 +891,14 @@
MULTI PMC *subtract(BigInt value, PMC *dest) {
- if (dest)
- pmc_reuse(interp, dest, SELF->vtable->base_type, 0);
- else
- dest = pmc_new(INTERP, SELF->vtable->base_type);
+ dest = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
bigint_sub_bigint(INTERP, SELF, value, dest);
return dest;
}
MULTI PMC *subtract(Integer value, PMC *dest) {
- if (dest)
- pmc_reuse(interp, dest, SELF->vtable->base_type, 0);
- else
- dest = pmc_new(INTERP, SELF->vtable->base_type);
+ dest = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
bigint_sub_bigint_int(INTERP, SELF, VTABLE_get_integer(interp, value), dest);
return dest;
@@ -921,10 +913,7 @@
}
VTABLE PMC *subtract_int(INTVAL value, PMC *dest) {
- if (dest)
- pmc_reuse(interp, dest, SELF->vtable->base_type, 0);
- else
- dest = pmc_new(INTERP, SELF->vtable->base_type);
+ dest = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
bigint_sub_bigint_int(INTERP, SELF, value, dest);
return dest;
@@ -958,14 +947,14 @@
MULTI PMC *multiply(BigInt value, PMC *dest) {
- dest = pmc_new(INTERP, SELF->vtable->base_type);
+ dest = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
bigint_mul_bigint(INTERP, SELF, value, dest);
return dest;
}
MULTI PMC *multiply(Integer value, PMC *dest) {
- dest = pmc_new(INTERP, SELF->vtable->base_type);
+ dest = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
bigint_mul_bigint_int(INTERP, SELF, VTABLE_get_integer(interp, value), dest);
return dest;
@@ -980,7 +969,7 @@
}
VTABLE PMC *multiply_int(INTVAL value, PMC *dest) {
- dest = pmc_new(INTERP, SELF->vtable->base_type);
+ dest = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
bigint_mul_bigint_int(INTERP, SELF, value, dest);
return dest;
@@ -1011,10 +1000,7 @@
}
VTABLE PMC *pow_int(INTVAL value, PMC *dest) {
- if (dest)
- pmc_reuse(interp, dest, SELF->vtable->base_type, 0);
- else
- dest = pmc_new(INTERP, SELF->vtable->base_type);
+ dest = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
bigint_pow_bigint_int(INTERP, SELF, value, dest);
return dest;
@@ -1023,7 +1009,7 @@
MULTI PMC *pow(PMC *value, PMC *dest) {
/* XXX only Integer RHS currently */
const INTVAL r = VTABLE_get_integer(INTERP, value);
- dest = pmc_new(INTERP, SELF->vtable->base_type);
+ dest = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
bigint_pow_bigint_int(INTERP, SELF, r, dest);
return dest;
@@ -1031,10 +1017,7 @@
MULTI PMC *divide(BigInt value, PMC *dest) {
BIGINT *bi;
- if (dest)
- pmc_reuse(interp, dest, SELF->vtable->base_type, 0);
- else
- dest = pmc_new(INTERP, SELF->vtable->base_type);
+ dest = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
bigint_div_bigint(INTERP, SELF, value, dest);
#if 0
@@ -1050,10 +1033,7 @@
}
MULTI PMC *divide(Integer value, PMC *dest) {
- if (dest)
- pmc_reuse(interp, dest, SELF->vtable->base_type, 0);
- else
- dest = pmc_new(INTERP, SELF->vtable->base_type);
+ dest = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
bigint_div_bigint_int(INTERP, SELF, VTABLE_get_integer(interp, value), dest);
return dest;
@@ -1068,10 +1048,7 @@
}
VTABLE PMC *divide_int(INTVAL value, PMC *dest) {
- if (dest)
- pmc_reuse(interp, dest, SELF->vtable->base_type, 0);
- else
- dest = pmc_new(INTERP, SELF->vtable->base_type);
+ dest = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
bigint_div_bigint_int(INTERP, SELF, value, dest);
return dest;
@@ -1095,14 +1072,14 @@
}
MULTI PMC *floor_divide(BigInt value, PMC *dest) {
- dest = pmc_new(INTERP, SELF->vtable->base_type);
+ dest = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
bigint_fdiv_bigint(INTERP, SELF, value, dest);
return dest;
}
MULTI PMC *floor_divide(Integer value, PMC *dest) {
- dest = pmc_new(INTERP, SELF->vtable->base_type);
+ dest = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
bigint_fdiv_bigint_int(INTERP, SELF, VTABLE_get_integer(interp, value), dest);
return dest;
@@ -1117,10 +1094,7 @@
}
VTABLE PMC *floor_divide_int(INTVAL value, PMC *dest) {
- if (dest)
- pmc_reuse(interp, dest, SELF->vtable->base_type, 0);
- else
- dest = pmc_new(INTERP, SELF->vtable->base_type);
+ dest = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
bigint_fdiv_bigint_int(INTERP, SELF, value, dest);
return dest;
@@ -1146,20 +1120,14 @@
}
MULTI PMC *modulus(BigInt value, PMC *dest) {
- if (dest)
- pmc_reuse(interp, dest, SELF->vtable->base_type, 0);
- else
- dest = pmc_new(INTERP, SELF->vtable->base_type);
+ dest = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
bigint_mod_bigint(INTERP, SELF, value, dest);
return dest;
}
MULTI PMC *modulus(Integer value, PMC *dest) {
- if (dest)
- pmc_reuse(interp, dest, SELF->vtable->base_type, 0);
- else
- dest = pmc_new(INTERP, SELF->vtable->base_type);
+ dest = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
bigint_mod_bigint_int(INTERP, SELF, VTABLE_get_integer(interp, value), dest);
return dest;
@@ -1229,7 +1197,7 @@
*/
VTABLE PMC *absolute(PMC *dest) {
- dest = pmc_new(INTERP, SELF->vtable->base_type);
+ dest = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
bigint_abs(INTERP, SELF, dest);
return dest;
@@ -1253,7 +1221,7 @@
*/
VTABLE PMC *neg(PMC *dest) {
- dest = pmc_new(INTERP, SELF->vtable->base_type);
+ dest = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
bigint_neg(INTERP, SELF, dest);
return dest;
@@ -1282,10 +1250,7 @@
*/
MULTI PMC *bitwise_shl(BigInt value, PMC *dest) {
- if (dest)
- pmc_reuse(interp, dest, SELF->vtable->base_type, 0);
- else
- dest = pmc_new(INTERP, SELF->vtable->base_type);
+ dest = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
bigint_bitwise_shl_bigint_int(INTERP, SELF,
VTABLE_get_integer(INTERP, value),
@@ -1294,10 +1259,7 @@
}
MULTI PMC *bitwise_shl(Integer value, PMC *dest) {
- if (dest)
- pmc_reuse(interp, dest, SELF->vtable->base_type, 0);
- else
- dest = pmc_new(INTERP, SELF->vtable->base_type);
+ dest = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
bigint_bitwise_shl_bigint_int(INTERP, SELF,
VTABLE_get_integer(interp, value), dest);
@@ -1312,10 +1274,7 @@
}
VTABLE PMC *bitwise_shl_int(INTVAL value, PMC *dest) {
- if (dest)
- pmc_reuse(interp, dest, SELF->vtable->base_type, 0);
- else
- dest = pmc_new(INTERP, SELF->vtable->base_type);
+ dest = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
bigint_bitwise_shl_bigint_int(INTERP, SELF, value, dest);
return dest;
@@ -1363,10 +1322,7 @@
*/
MULTI PMC *bitwise_shr(BigInt value, PMC *dest) {
- if (dest)
- pmc_reuse(interp, dest, SELF->vtable->base_type, 0);
- else
- dest = pmc_new(INTERP, SELF->vtable->base_type);
+ dest = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
bigint_bitwise_shr_bigint_int(INTERP, SELF,
VTABLE_get_integer(INTERP, value),
@@ -1375,10 +1331,7 @@
}
MULTI PMC *bitwise_shr(Integer value, PMC *dest) {
- if (dest)
- pmc_reuse(interp, dest, SELF->vtable->base_type, 0);
- else
- dest = pmc_new(INTERP, SELF->vtable->base_type);
+ dest = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
bigint_bitwise_shr_bigint_int(INTERP, SELF,
VTABLE_get_integer(interp, value), dest);
@@ -1394,10 +1347,7 @@
}
VTABLE PMC *bitwise_shr_int(INTVAL value, PMC *dest) {
- if (dest)
- pmc_reuse(interp, dest, SELF->vtable->base_type, 0);
- else
- dest = pmc_new(INTERP, SELF->vtable->base_type);
+ dest = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
bigint_bitwise_shr_bigint_int(INTERP, SELF, value, dest);
return dest;
Modified: branches/pmc_pct/src/pmc/bignum.pmc
==============================================================================
--- branches/pmc_pct/src/pmc/bignum.pmc Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/pmc/bignum.pmc Thu Jun 4 02:32:48 2009 (r39377)
@@ -546,7 +546,6 @@
static void
bignum_abs(PARROT_INTERP, PMC *self, PMC *dest) {
BIGNUM *bn_self, *bn_dest;
- pmc_reuse(interp, dest, enum_class_BigNum, 0);
GETATTR_BigNum_bn(interp, self, bn_self);
GETATTR_BigNum_bn(interp, dest, bn_dest);
mpf_abs(bn_dest->b, bn_self->b);
@@ -555,7 +554,6 @@
static void
bignum_neg(PARROT_INTERP, PMC *self, PMC *dest) {
BIGNUM *bn_self, *bn_dest;
- pmc_reuse(interp, dest, enum_class_BigNum, 0);
GETATTR_BigNum_bn(interp, self, bn_self);
GETATTR_BigNum_bn(interp, dest, bn_dest);
mpf_neg(bn_dest->b, bn_self->b);
@@ -1133,8 +1131,12 @@
bignum_add_bignum(INTERP, SELF, value, SELF);
}
- MULTI void i_add(FLOATVAL value) {
- bignum_add_bignum_float(INTERP, SELF, value, SELF);
+ MULTI void i_add(Integer value) {
+ bignum_add_bignum_int(INTERP, SELF, VTABLE_get_integer(INTERP, value), SELF);
+ }
+
+ MULTI void i_add(Float value) {
+ bignum_add_bignum_float(INTERP, SELF, VTABLE_get_number(INTERP, value), SELF);
}
MULTI void i_add(DEFAULT value) {
@@ -1149,9 +1151,7 @@
}
VTABLE void i_add_float(FLOATVAL value) {
- Parrot_ex_throw_from_c_args(INTERP, NULL,
- EXCEPTION_INTERNAL_NOT_IMPLEMENTED,
- "BigNum: no multiple dispatch variant 'i_add_float' for FLOATVAL");
+ bignum_add_bignum_float(INTERP, SELF, value, SELF);
}
/*
@@ -1163,20 +1163,14 @@
*/
MULTI PMC *subtract(BigNum value, PMC *dest) {
- if (dest)
- pmc_reuse(interp, dest, SELF->vtable->base_type, 0);
- else
- dest = pmc_new(INTERP, SELF->vtable->base_type);
+ dest = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
bignum_sub_bignum(INTERP, SELF, value, dest);
return dest;
}
MULTI PMC *subtract(Integer value, PMC *dest) {
- if (dest)
- pmc_reuse(interp, dest, SELF->vtable->base_type, 0);
- else
- dest = pmc_new(INTERP, SELF->vtable->base_type);
+ dest = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
bignum_sub_bignum_int(INTERP, SELF, VTABLE_get_integer(interp, value), dest);
return dest;
@@ -1190,10 +1184,7 @@
}
VTABLE PMC *subtract_int(INTVAL value, PMC *dest) {
- if (dest)
- pmc_reuse(interp, dest, SELF->vtable->base_type, 0);
- else
- dest = pmc_new(INTERP, SELF->vtable->base_type);
+ dest = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
bignum_sub_bignum_int(INTERP, SELF, value, dest);
return dest;
@@ -1203,8 +1194,12 @@
bignum_sub_bignum(INTERP, SELF, value, SELF);
}
- MULTI void i_subtract(FLOATVAL value) {
- bignum_sub_bignum_float(INTERP, SELF, value, SELF);
+ MULTI void i_subtract(Integer value) {
+ bignum_sub_bignum_int(INTERP, SELF, VTABLE_get_integer(INTERP, value), SELF);
+ }
+
+ MULTI void i_subtract(Float value) {
+ bignum_sub_bignum_float(INTERP, SELF, VTABLE_get_number(INTERP, value), SELF);
}
MULTI void i_subtract(DEFAULT value) {
@@ -1219,9 +1214,7 @@
}
VTABLE void i_subtract_float(FLOATVAL value) {
- Parrot_ex_throw_from_c_args(INTERP, NULL,
- EXCEPTION_INTERNAL_NOT_IMPLEMENTED,
- "BigNum: no multiple dispatch variant 'i_subtract_float' for FLOATVAL");
+ bignum_sub_bignum_float(INTERP, SELF, value, SELF);
}
/*
@@ -1264,8 +1257,8 @@
bignum_mul_bignum(INTERP, SELF, value, SELF);
}
- MULTI void i_multiply(FLOATVAL value) {
- bignum_mul_bignum_float(INTERP, SELF, value, SELF);
+ MULTI void i_multiply(Float value) {
+ bignum_mul_bignum_float(INTERP, SELF, VTABLE_get_number(INTERP, value), SELF);
}
MULTI void i_multiply(Integer value) {
@@ -1284,9 +1277,7 @@
}
VTABLE void i_multiply_float(FLOATVAL value) {
- Parrot_ex_throw_from_c_args(INTERP, NULL,
- EXCEPTION_INTERNAL_NOT_IMPLEMENTED,
- "BigNum: no multiple dispatch variant 'i_multiply_float' for FLOATVAL");
+ bignum_mul_bignum_float(INTERP, SELF, value, SELF);
}
/*
@@ -1298,10 +1289,7 @@
*/
VTABLE PMC *pow_int(INTVAL value, PMC *dest) {
- if (dest)
- pmc_reuse(interp, dest, SELF->vtable->base_type, 0);
- else
- dest = pmc_new(INTERP, SELF->vtable->base_type);
+ dest = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
bignum_pow_bignum_int(INTERP, SELF, value, dest);
return dest;
@@ -1326,10 +1314,7 @@
MULTI PMC *divide(BigNum value, PMC *dest) {
BIGNUM *bn;
- if (dest)
- pmc_reuse(interp, dest, SELF->vtable->base_type, 0);
- else
- dest = pmc_new(INTERP, SELF->vtable->base_type);
+ dest = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
bignum_div_bignum(INTERP, SELF, value, dest);
#if 0
@@ -1345,10 +1330,7 @@
}
MULTI PMC *divide(Integer value, PMC *dest) {
- if (dest)
- pmc_reuse(interp, dest, SELF->vtable->base_type, 0);
- else
- dest = pmc_new(INTERP, SELF->vtable->base_type);
+ dest = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
bignum_div_bignum_int(INTERP, SELF, VTABLE_get_integer(interp, value), dest);
return dest;
@@ -1362,10 +1344,7 @@
}
VTABLE PMC *divide_int(INTVAL value, PMC *dest) {
- if (dest)
- pmc_reuse(interp, dest, SELF->vtable->base_type, 0);
- else
- dest = pmc_new(INTERP, SELF->vtable->base_type);
+ dest = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
bignum_div_bignum_int(INTERP, SELF, value, dest);
return dest;
@@ -1377,6 +1356,9 @@
MULTI void i_divide(Integer value) {
bignum_div_bignum_int(INTERP, SELF, VTABLE_get_integer(interp, value), SELF);
}
+ MULTI void i_divide(Float value) {
+ bignum_div_bignum_float(INTERP, SELF, VTABLE_get_integer(interp, value), SELF);
+ }
MULTI void i_divide(DEFAULT value) {
Parrot_ex_throw_from_c_args(INTERP, NULL,
EXCEPTION_INTERNAL_NOT_IMPLEMENTED,
@@ -1397,14 +1379,14 @@
*/
MULTI PMC *floor_divide(BigNum value, PMC *dest) {
- dest = pmc_new(INTERP, SELF->vtable->base_type);
+ dest = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
bignum_fdiv_bignum(INTERP, SELF, value, dest);
return dest;
}
MULTI PMC *floor_divide(Integer value, PMC *dest) {
- dest = pmc_new(INTERP, SELF->vtable->base_type);
+ dest = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
bignum_fdiv_bignum_int(INTERP, SELF, VTABLE_get_integer(interp, value), dest);
return dest;
@@ -1418,10 +1400,7 @@
}
VTABLE PMC *floor_divide_int(INTVAL value, PMC *dest) {
- if (dest)
- pmc_reuse(interp, dest, SELF->vtable->base_type, 0);
- else
- dest = pmc_new(INTERP, SELF->vtable->base_type);
+ dest = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
bignum_fdiv_bignum_int(INTERP, SELF, value, dest);
return dest;
Modified: branches/pmc_pct/src/pmc/callsignature.pmc
==============================================================================
--- branches/pmc_pct/src/pmc/callsignature.pmc Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/pmc/callsignature.pmc Thu Jun 4 02:32:48 2009 (r39377)
@@ -1,5 +1,5 @@
/*
-Copyright (C) 2008, Parrot Foundation.
+Copyright (C) 2008-2009, Parrot Foundation.
$Id$
=head1 NAME
@@ -43,7 +43,7 @@
*/
VTABLE void init() {
- Parrot_CallSignature_attributes *sig_struct =
+ Parrot_CallSignature_attributes * const sig_struct =
mem_allocate_typed(Parrot_CallSignature_attributes);
PMC_data(SELF) = sig_struct;
sig_struct->short_sig = NULL;
@@ -183,7 +183,6 @@
*/
VTABLE void mark() {
PMC ** const data = PMC_data_typed(SELF, PMC **);
- INTVAL i;
Parrot_CallSignature_attributes * const attrs = PARROT_CALLSIGNATURE(SELF);
if (attrs) {
@@ -200,12 +199,12 @@
Parrot_gc_mark_PObj_alive(interp, (PObj*)attrs->short_sig);
}
- if (!data)
- return;
-
- for (i = attrs->data_size - 1; i >= 0; --i)
- if (data[i])
- Parrot_gc_mark_PObj_alive(interp, (PObj *)data[i]);
+ if (data) {
+ INTVAL i;
+ for (i = attrs->data_size - 1; i >= 0; --i)
+ if (data[i])
+ Parrot_gc_mark_PObj_alive(interp, (PObj *)data[i]);
+ }
}
Modified: branches/pmc_pct/src/pmc/class.pmc
==============================================================================
--- branches/pmc_pct/src/pmc/class.pmc Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/pmc/class.pmc Thu Jun 4 02:32:48 2009 (r39377)
@@ -1166,8 +1166,6 @@
VTABLE PMC *instantiate(PMC *init) {
Parrot_Class_attributes * const _class = PARROT_CLASS(SELF);
-
- Parrot_Object_attributes *obj_guts;
PMC *object;
/* If we've not been instantiated before... */
@@ -1236,10 +1234,8 @@
/* Initialize the object's underlying structure, pointing it to this
* class. */
- obj_guts = mem_allocate_zeroed_typed(Parrot_Object_attributes);
- obj_guts->_class = SELF;
- PMC_data(object) = obj_guts;
- obj_guts->attrib_store = pmc_new(interp, enum_class_ResizablePMCArray);
+ PMC_data(object) =
+ (Parrot_Object_attributes *)Parrot_oo_new_object_attrs(interp, SELF);
if (!PMC_IS_NULL(init)) {
/* Initialize attributes with the supplied values. */
@@ -1783,19 +1779,9 @@
=cut
*/
- METHOD add_method(STRING *name, PMC *sub,
- int vtable :optional :named("vtable"),
- int has_vtable :opt_flag,
- int anon :optional :named("anon"),
- int has_anon :opt_flag)
+ METHOD add_method(STRING *name, PMC *sub)
{
- /* If it's a vtable method... */
- if (has_vtable && vtable)
- VTABLE_add_vtable_override(interp, SELF, name, sub);
-
- /* Provided it's not anonymous, add it to the methods list. */
- if (!has_anon || !anon)
- SELF.add_method(name, sub);
+ SELF.add_method(name, sub);
}
/*
Modified: branches/pmc_pct/src/pmc/codestring.pmc
==============================================================================
--- branches/pmc_pct/src/pmc/codestring.pmc Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/pmc/codestring.pmc Thu Jun 4 02:32:48 2009 (r39377)
@@ -1,5 +1,5 @@
/*
-Copyright (C) 2007-2008, Parrot Foundation.
+Copyright (C) 2007-2009, Parrot Foundation.
$Id$
=head1 NAME
@@ -142,15 +142,17 @@
Return the line number of the line at offset C<pos>. This code assumes that
the first line is line number zero.
+=cut
+
*/
METHOD lineof(INTVAL pos) {
- STRING *str = SELF.get_string();
- INTVAL line = 0;
- INTVAL ipos = 0;
- INTVAL seen_first_line = 0;
- INTVAL jpos;
- INTVAL last_pos;
+ STRING *str = NULL;
+ INTVAL line = 0;
+ INTVAL ipos = 0;
+ INTVAL seen_first_line = 0;
+ INTVAL jpos;
+ INTVAL last_pos;
GET_ATTR_last_pos(INTERP, SELF, last_pos);
@@ -166,6 +168,7 @@
ipos = last_pos;
}
+ str = SELF.get_string();
jpos = Parrot_str_find_cclass(INTERP, enum_cclass_newline, str, ipos, pos);
while (jpos < pos) {
@@ -270,6 +273,8 @@
Converts the Unicode character name given by C<name> to its
codepoint value. Returns -1 if an error occurs in conversion.
+=cut
+
*/
@@ -294,7 +299,7 @@
=item C<key( string name1 [, string name2, ...] )>
-Construct a PIR key using the strings passed as arguments.
+Constructs a PIR key using the strings passed as arguments.
For example, C<key('Foo', 'Bar')> returns C<["Foo";"Bar"]>.
=cut
Modified: branches/pmc_pct/src/pmc/complex.pmc
==============================================================================
--- branches/pmc_pct/src/pmc/complex.pmc Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/pmc/complex.pmc Thu Jun 4 02:32:48 2009 (r39377)
@@ -1,5 +1,5 @@
/*
-Copyright (C) 2004-2008, Parrot Foundation.
+Copyright (C) 2004-2009, Parrot Foundation.
$Id$
=head1 NAME
@@ -39,7 +39,7 @@
static void
complex_parse_string(PARROT_INTERP, FLOATVAL *re, FLOATVAL *im, STRING *value) {
- char *str = Parrot_str_to_cstring(interp, value);
+ char * const str = Parrot_str_to_cstring(interp, value);
char *t = str;
char *first_num_offset = str;
char *second_num_offset = NULL;
@@ -386,8 +386,9 @@
}
VTABLE PMC *clone() {
+ PMC * const dest = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
FLOATVAL re, im;
- PMC *dest = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
+
GET_ATTR_re(INTERP, SELF, re);
GET_ATTR_im(INTERP, SELF, im);
SET_ATTR_re(INTERP, dest, re);
@@ -419,7 +420,7 @@
*/
VTABLE INTVAL get_integer() {
- FLOATVAL f = SELF.get_number();
+ const FLOATVAL f = SELF.get_number();
return (INTVAL)f;
}
@@ -470,7 +471,7 @@
}
VTABLE INTVAL get_integer_keyed_str(STRING *key) {
- FLOATVAL f = SELF.get_number_keyed_str(key);
+ const FLOATVAL f = SELF.get_number_keyed_str(key);
return (INTVAL)f;
}
@@ -495,7 +496,7 @@
VTABLE PMC *get_pmc_keyed(PMC *key) {
if (VTABLE_isa(interp, key, CONST_STRING(interp, "Integer"))) {
- INTVAL i = VTABLE_get_integer(interp, key);
+ const INTVAL i = VTABLE_get_integer(interp, key);
return SELF.get_pmc_keyed_int(i);
}
else {
@@ -606,8 +607,7 @@
}
VTABLE void set_pmc(PMC *value) {
- if (VTABLE_isa(INTERP, value, CONST_STRING(INTERP, "Complex")))
- {
+ if (VTABLE_isa(INTERP, value, CONST_STRING(INTERP, "Complex"))) {
FLOATVAL re, im;
GET_ATTR_re(INTERP, value, re);
GET_ATTR_im(INTERP, value, im);
@@ -658,7 +658,7 @@
VTABLE void set_number_keyed(PMC *key, FLOATVAL value) {
if (VTABLE_isa(interp, key, CONST_STRING(interp, "Integer"))) {
- INTVAL i = VTABLE_get_integer(interp, key);
+ const INTVAL i = VTABLE_get_integer(interp, key);
SELF.set_number_keyed_int(i, value);
}
else {
@@ -1038,7 +1038,7 @@
MULTI PMC *divide(DEFAULT value, PMC *dest) {
FLOATVAL re, im;
- FLOATVAL d = VTABLE_get_number(INTERP, value);
+ const FLOATVAL d = VTABLE_get_number(INTERP, value);
float_check_divide_zero(INTERP, d);
dest = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
@@ -1080,7 +1080,7 @@
}
MULTI void i_divide(Complex value) {
- FLOATVAL mod, re, im;
+ FLOATVAL re, im;
FLOATVAL self_re, self_im, val_re, val_im;
complex_check_divide_zero(INTERP, value);
@@ -1097,7 +1097,7 @@
else {
/* a little speed optimisation: cache an intermediate number;
I'm not sure the compiler does this */
- mod = (val_re * val_re + val_im * val_im);
+ const FLOATVAL mod = (val_re * val_re + val_im * val_im);
re = (self_re * val_re + self_im * val_im) / mod;
im = (self_im * val_re - self_re * val_im) / mod;
}
@@ -1109,7 +1109,7 @@
MULTI void i_divide(DEFAULT value) {
FLOATVAL re, im;
- FLOATVAL d = VTABLE_get_number(INTERP, value);
+ const FLOATVAL d = VTABLE_get_number(INTERP, value);
float_check_divide_zero(INTERP, d);
GET_ATTR_re(INTERP, SELF, re);
@@ -1272,7 +1272,7 @@
*/
METHOD ln() {
- PMC *d = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
+ PMC * const d = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
FLOATVAL re, im, result_re, result_im;
GET_ATTR_re(INTERP, SELF, re);
GET_ATTR_im(INTERP, SELF, im);
@@ -1306,7 +1306,7 @@
*/
METHOD exp() {
- PMC *d = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
+ PMC * const d = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
FLOATVAL re, im, f;
GET_ATTR_re(INTERP, SELF, re);
GET_ATTR_im(INTERP, SELF, im);
@@ -1360,7 +1360,7 @@
*/
METHOD sin() {
- PMC *d = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
+ PMC * const d = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
FLOATVAL re, im, result_re, result_im;
GET_ATTR_re(INTERP, SELF, re);
GET_ATTR_im(INTERP, SELF, im);
@@ -1390,7 +1390,7 @@
}
METHOD cos() {
- PMC *d = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
+ PMC * const d = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
FLOATVAL re, im, result_re, result_im;
GET_ATTR_re(INTERP, SELF, re);
GET_ATTR_im(INTERP, SELF, im);
@@ -1415,8 +1415,8 @@
}
METHOD tan() {
- PMC *d = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
- PMC *e = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
+ PMC * const d = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
+ PMC * const e = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
(PMC *d) = PCCINVOKE(INTERP, SELF, "sin");
(PMC *e) = PCCINVOKE(INTERP, SELF, "cos");
@@ -1427,8 +1427,8 @@
}
METHOD cot() {
- PMC *d = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
- PMC *e = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
+ PMC * const d = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
+ PMC * const e = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
(PMC *d) = PCCINVOKE(INTERP, SELF, "cos");
(PMC *e) = PCCINVOKE(INTERP, SELF, "sin");
@@ -1438,8 +1438,8 @@
}
METHOD sec() {
- PMC *d = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
- PMC *e = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
+ PMC * const d = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
+ PMC * const e = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
SET_ATTR_re(INTERP, d, 1.0);
SET_ATTR_im(INTERP, d, 0.0);
(PMC *e) = PCCINVOKE(INTERP, SELF, "cos");
@@ -1450,8 +1450,8 @@
}
METHOD csc() {
- PMC *d = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
- PMC *e = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
+ PMC * const d = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
+ PMC * const e = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
SET_ATTR_re(INTERP, d, 1.0);
SET_ATTR_im(INTERP, d, 0.0);
@@ -1498,8 +1498,8 @@
METHOD asin() {
FLOATVAL d_re, d_im, e_re, e_im, self_re, self_im;
- PMC *d = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
- PMC *e = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
+ PMC * const d = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
+ PMC * e = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
GET_ATTR_re(INTERP, SELF, self_re);
GET_ATTR_im(INTERP, SELF, self_im);
@@ -1526,8 +1526,8 @@
METHOD acos() {
FLOATVAL d_re, d_im, e_re, e_im, self_re, self_im;
- PMC *d = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
- PMC *e = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
+ PMC * const d = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
+ PMC * e = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
GET_ATTR_re(INTERP, SELF, self_re);
GET_ATTR_im(INTERP, SELF, self_im);
@@ -1553,8 +1553,8 @@
}
METHOD atan() {
- PMC *d = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
- PMC *e = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
+ PMC * const d = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
+ PMC * const e = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
FLOATVAL re, im, d_re, d_im;
GET_ATTR_re(INTERP, SELF, re);
GET_ATTR_im(INTERP, SELF, im);
@@ -1577,7 +1577,7 @@
}
METHOD acot() {
- PMC *d = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
+ PMC * const d = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
PMC *e;
FLOATVAL re, im;
GET_ATTR_re(INTERP, SELF, re);
@@ -1591,7 +1591,7 @@
}
METHOD acsc() {
- PMC *d = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
+ PMC * const d = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
PMC *e;
FLOATVAL re, im;
GET_ATTR_re(INTERP, SELF, re);
@@ -1605,7 +1605,7 @@
}
METHOD asec() {
- PMC *d = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
+ PMC * const d = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
PMC *e;
FLOATVAL re, im;
GET_ATTR_re(INTERP, SELF, re);
@@ -1639,7 +1639,7 @@
*/
METHOD sinh() {
- PMC *d = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
+ PMC * const d = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
FLOATVAL re, im;
GET_ATTR_re(INTERP, SELF, re);
GET_ATTR_im(INTERP, SELF, im);
@@ -1651,7 +1651,7 @@
}
METHOD cosh() {
- PMC *d = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
+ PMC * const d = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
FLOATVAL re, im;
GET_ATTR_re(INTERP, SELF, re);
GET_ATTR_im(INTERP, SELF, im);
@@ -1668,8 +1668,8 @@
}
METHOD tanh() {
- PMC *d = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
- PMC *e = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
+ PMC * const d = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
+ PMC * const e = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
(PMC *d) = PCCINVOKE(INTERP, SELF, "sinh");
(PMC *e) = PCCINVOKE(INTERP, SELF, "cosh");
@@ -1681,7 +1681,7 @@
METHOD coth() {
FLOATVAL re, im;
- PMC *d = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
+ PMC * const d = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
(PMC *d) = PCCINVOKE(INTERP, SELF, "tanh");
GET_ATTR_re(INTERP, d, re);
@@ -1695,7 +1695,7 @@
METHOD csch() {
FLOATVAL re, im;
- PMC *d = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
+ PMC * const d = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
(PMC *d) = PCCINVOKE(INTERP, SELF, "sinh");
GET_ATTR_re(INTERP, d, re);
@@ -1709,7 +1709,7 @@
METHOD sech() {
FLOATVAL re, im;
- PMC *d = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
+ PMC * const d = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
(PMC *d) = PCCINVOKE(INTERP, SELF, "cosh");
GET_ATTR_re(INTERP, d, re);
@@ -1751,8 +1751,8 @@
METHOD asinh() {
FLOATVAL re, im;
- PMC *d = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
- PMC *e = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
+ PMC * const d = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
+ PMC * const e = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
GET_ATTR_re(INTERP, SELF, re);
GET_ATTR_im(INTERP, SELF, im);
@@ -1770,8 +1770,8 @@
METHOD acosh() {
FLOATVAL re, im;
- PMC *d = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
- PMC *e = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
+ PMC * const d = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
+ PMC * const e = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
(PMC *d) = PCCINVOKE(INTERP, SELF, "acos");
GET_ATTR_re(INTERP, d, re);
@@ -1784,8 +1784,8 @@
METHOD atanh() {
FLOATVAL re, im;
- PMC *d = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
- PMC *e = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
+ PMC * const d = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
+ PMC * const e = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
GET_ATTR_re(INTERP, SELF, re);
GET_ATTR_im(INTERP, SELF, im);
@@ -1802,7 +1802,7 @@
}
METHOD acoth() {
- PMC *d = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
+ PMC * const d = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
PMC *e;
FLOATVAL re, im;
GET_ATTR_re(INTERP, SELF, re);
@@ -1816,7 +1816,7 @@
}
METHOD acsch() {
- PMC *d = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
+ PMC * const d = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
PMC *e;
FLOATVAL re, im;
GET_ATTR_re(INTERP, SELF, re);
@@ -1830,7 +1830,7 @@
}
METHOD asech() {
- PMC *d = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
+ PMC * const d = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
PMC *e;
FLOATVAL re, im;
GET_ATTR_re(INTERP, SELF, re);
@@ -1897,8 +1897,8 @@
}
METHOD sqrt() {
- PMC *result = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
- FLOATVAL absval = SELF.get_number();
+ PMC * const result = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
+ const FLOATVAL absval = SELF.get_number();
FLOATVAL sx, sy, rx, ry;
GET_ATTR_re(INTERP, SELF, sx);
GET_ATTR_im(INTERP, SELF, sy);
Modified: branches/pmc_pct/src/pmc/continuation.pmc
==============================================================================
--- branches/pmc_pct/src/pmc/continuation.pmc Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/pmc/continuation.pmc Thu Jun 4 02:32:48 2009 (r39377)
@@ -134,11 +134,17 @@
*/
VTABLE PMC *clone() {
- Parrot_cont * const cc_self = PMC_cont(SELF);
- Parrot_cont * const cc = new_continuation(INTERP, cc_self);
- PMC * const ret = pmc_new(INTERP, enum_class_Continuation);
+ Parrot_cont * const cc_self = PMC_cont(SELF);
+ Parrot_cont * const cc = new_continuation(INTERP, cc_self);
+ PMC * const ret = pmc_new(INTERP, enum_class_Continuation);
+ Parrot_cont * const ret_cont = PMC_cont(ret);
PObj_custom_mark_destroy_SETALL(ret);
+
+ /* free ret's PMC_cont */
+ Parrot_free_context(interp, ret_cont->from_ctx, 1);
+ mem_sys_free(ret_cont);
+
cc->runloop_id = cc_self->runloop_id;
PMC_cont(ret) = cc;
Modified: branches/pmc_pct/src/pmc/coroutine.pmc
==============================================================================
--- branches/pmc_pct/src/pmc/coroutine.pmc Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/pmc/coroutine.pmc Thu Jun 4 02:32:48 2009 (r39377)
@@ -8,7 +8,7 @@
=head1 DESCRIPTION
-C<Coroutine> extends C<Continuation> to provide a subroutine that can
+C<Coroutine> extends C<Sub> to provide a subroutine that can
stop in the middle, and start back up later at the point at which it
stopped. See the L<Glossary|docs/glossary.pod> for more information.
@@ -76,41 +76,33 @@
VTABLE void init() {
Parrot_Coroutine_attributes *attrs =
- mem_allocate_zeroed_typed(Parrot_Coroutine_attributes);
- attrs->sub = (Parrot_sub*)new_coroutine(INTERP);
+ mem_allocate_typed(Parrot_Coroutine_attributes);
+
+ attrs->sub = (Parrot_sub *)new_coroutine(INTERP);
PMC_data(SELF) = attrs;
+
PObj_custom_mark_destroy_SETALL(SELF);
}
+
/*
-=item C<void destroy()>
+=item C<PMC * clone()>
-Destroys the coroutine.
+Clones the coroutine.
=cut
*/
- VTABLE void destroy() {
- Parrot_Coroutine_attributes *attrs = PARROT_COROUTINE(SELF);
- Parrot_sub *sub = attrs->sub;
-
- if (sub->ctx)
- Parrot_free_context(interp, sub->ctx, 1);
-
- SUPER();
- }
-
VTABLE PMC *clone() {
- Parrot_coro * const coro_sub = mem_allocate_typed(Parrot_coro);
PMC * const ret = pmc_new(INTERP, SELF->vtable->base_type);
Parrot_sub *sub;
+ Parrot_sub *coro_sub;
PObj_custom_mark_destroy_SETALL(ret);
- SET_ATTR_sub(INTERP, ret, (Parrot_sub *)coro_sub);
-
+ PMC_get_sub(INTERP, ret, coro_sub);
PMC_get_sub(INTERP, SELF, sub);
memcpy(coro_sub, sub, sizeof (Parrot_coro));
@@ -132,7 +124,7 @@
VTABLE opcode_t *invoke(void *next) {
PackFile_ByteCode *wanted_seg;
Parrot_Coroutine_attributes *attrs = PARROT_COROUTINE(SELF);
- Parrot_coro * const co = (Parrot_coro*)attrs->sub;
+ Parrot_coro * const co = (Parrot_coro *)attrs->sub;
opcode_t * dest = co->address;
if (Interp_trace_TEST(INTERP, PARROT_TRACE_SUB_CALL_FLAG))
@@ -262,17 +254,15 @@
VTABLE void mark() {
Parrot_Coroutine_attributes *attrs = PARROT_COROUTINE(SELF);
- Parrot_coro * const co = (Parrot_coro *)attrs->sub;
+ Parrot_coro * const co = (Parrot_coro *)attrs->sub;
+ /* co->ctx marked in SUPER(), so do not mark here */
if (co) {
- if (co->ctx)
- mark_context(INTERP, co->ctx);
if (co->dynamic_state)
mark_stack(INTERP, co->dynamic_state);
+ SUPER();
}
-
- SUPER();
}
}
Modified: branches/pmc_pct/src/pmc/cpointer.pmc
==============================================================================
--- branches/pmc_pct/src/pmc/cpointer.pmc Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/pmc/cpointer.pmc Thu Jun 4 02:32:48 2009 (r39377)
@@ -85,19 +85,20 @@
VTABLE void mark() {
Parrot_CPointer_attributes * const data = PARROT_CPOINTER(SELF);
- if (data->sig)
+ if (data->sig) {
Parrot_gc_mark_PObj_alive(interp, (PObj *)data->sig);
- if (data->pointer) {
- if (Parrot_str_equal(interp, data->sig, CONST_STRING(interp, "P"))) {
- PMC ** const pmc_pointer = (PMC **) data->pointer;
- PARROT_ASSERT(*pmc_pointer);
- Parrot_gc_mark_PObj_alive(interp, (PObj *) *pmc_pointer);
- }
- else if (Parrot_str_equal(interp, data->sig, CONST_STRING(interp, "S"))) {
- STRING ** const str_pointer = (STRING **) data->pointer;
- PARROT_ASSERT(*str_pointer);
- Parrot_gc_mark_PObj_alive(interp, (PObj *) *str_pointer);
+ if (data->pointer) {
+ if (Parrot_str_equal(interp, data->sig, CONST_STRING(interp, "P"))) {
+ PMC ** const pmc_pointer = (PMC **) data->pointer;
+ PARROT_ASSERT(*pmc_pointer);
+ Parrot_gc_mark_PObj_alive(interp, (PObj *) *pmc_pointer);
+ }
+ else if (Parrot_str_equal(interp, data->sig, CONST_STRING(interp, "S"))) {
+ STRING ** const str_pointer = (STRING **) data->pointer;
+ PARROT_ASSERT(*str_pointer);
+ Parrot_gc_mark_PObj_alive(interp, (PObj *) *str_pointer);
+ }
}
}
}
Modified: branches/pmc_pct/src/pmc/default.pmc
==============================================================================
--- branches/pmc_pct/src/pmc/default.pmc Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/pmc/default.pmc Thu Jun 4 02:32:48 2009 (r39377)
@@ -171,7 +171,7 @@
/*
=item C<static INTVAL
-has_pending_std_props(PMC *self)>
+has_pending_std_props(ARGIN(const PMC *self))>
Returns true if propagate_std_props() would create a non-empty prophash.
@@ -180,7 +180,7 @@
*/
static INTVAL
-has_pending_std_props(PMC *self) {
+has_pending_std_props(ARGIN(const PMC *self)) {
if (self->vtable->flags & (VTABLE_IS_CONST_FLAG | VTABLE_IS_READONLY_FLAG))
return 1;
else
@@ -233,7 +233,6 @@
PMC_metadata(self) = prop = pmc_new(interp, enum_class_Hash);
GC_WRITE_BARRIER(interp, self, NULL, prop);
- VTABLE_init(interp, prop);
propagate_std_props(interp, self, prop);
return prop;
}
@@ -896,12 +895,19 @@
*/
VTABLE INTVAL isa_pmc(PMC *lookup) {
+ Hash * const isa_hash = SELF->vtable->isa_hash;
+ STRING *pmc_name;
+
if (PMC_IS_NULL(lookup))
return 0;
+ pmc_name = VTABLE_get_string(interp, lookup);
+
+ if (!isa_hash)
+ return Parrot_str_equal(interp, SELF->vtable->whoami, pmc_name);
+
/* RT #46665 - walk mro */
- return parrot_hash_exists(INTERP, SELF->vtable->isa_hash,
- (void *)VTABLE_get_string(interp, lookup));
+ return parrot_hash_exists(INTERP, isa_hash, (void *)pmc_name);
}
/*
@@ -918,8 +924,11 @@
VTABLE INTVAL isa(STRING *_class) {
/* RT #46665 - walk mro */
- return parrot_hash_exists(INTERP, SELF->vtable->isa_hash,
- (void *)_class);
+ Hash * const isa_hash = SELF->vtable->isa_hash;
+ if (!isa_hash)
+ return Parrot_str_equal(interp, SELF->vtable->whoami, _class);
+
+ return parrot_hash_exists(INTERP, isa_hash, (void *)_class);
}
/*
Modified: branches/pmc_pct/src/pmc/eventhandler.pmc
==============================================================================
--- branches/pmc_pct/src/pmc/eventhandler.pmc Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/pmc/eventhandler.pmc Thu Jun 4 02:32:48 2009 (r39377)
@@ -139,25 +139,8 @@
if (! PMC_IS_NULL(e->code))
Parrot_gc_mark_PObj_alive(INTERP, (PObj *)e->code);
}
- }
-
-/*
-
-=item C<void destroy()>
-
-Frees any memory held by this PMC.
-
-=cut
-*/
-
- VTABLE void destroy() {
- Parrot_EventHandler_attributes *e = PMC_data_typed(SELF, Parrot_EventHandler_attributes *);
-
- if (e) {
- mem_sys_free(e);
- PMC_data(SELF) = NULL;
- }
+ SUPER();
}
/*
Modified: branches/pmc_pct/src/pmc/exception.pmc
==============================================================================
--- branches/pmc_pct/src/pmc/exception.pmc Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/pmc/exception.pmc Thu Jun 4 02:32:48 2009 (r39377)
@@ -66,6 +66,7 @@
ATTR INTVAL handled; /* Whether the exception has been handled. */
ATTR PMC *handler_iter; /* An iterator of handlers (for rethrow). */
ATTR Parrot_Context *handler_ctx; /* A stored context for handler iterator. */
+ ATTR Parrot_Context *thrower; /* The position we were at when thrown. */
/*
@@ -174,7 +175,8 @@
VTABLE void destroy() {
Parrot_Exception_attributes * const core_struct = PARROT_EXCEPTION(SELF);
-
+ if (core_struct->thrower)
+ Parrot_free_context(interp, core_struct->thrower, 1);
if (core_struct)
mem_sys_free(core_struct);
}
@@ -655,6 +657,17 @@
else if (Parrot_str_equal(INTERP, name, CONST_STRING(INTERP, "handler_iter"))) {
SET_ATTR_handler_iter(interp, SELF, value);
}
+ else if (Parrot_str_equal(INTERP, name, CONST_STRING(INTERP, "thrower"))) {
+ /* Ensure it's a ret cont, and extract the from_ctx.
+ * XXX TT#596 - when we have Context PMCs, just take and set that. */
+ if (VTABLE_isa(interp, value, CONST_STRING(interp, "Continuation"))) {
+ Parrot_Context *ctx = PMC_cont(value)->from_ctx;
+ if (ctx) {
+ Parrot_context_ref(interp, ctx);
+ SET_ATTR_thrower(interp, SELF, ctx);
+ }
+ }
+ }
else {
/* If unknown attribute name, throw an exception. */
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_ATTRIB_NOT_FOUND,
@@ -748,13 +761,24 @@
METHOD backtrace() {
PMC *result = pmc_new(interp, enum_class_ResizablePMCArray);
PMC *resume;
+ Parrot_Context *cur_ctx;
+ Parrot_cont *cont;
/* Get starting context, then loop over them. */
GET_ATTR_resume(interp, SELF, resume);
if (!PMC_IS_NULL(resume)) {
- Parrot_cont *cont = PMC_cont(resume);
- Parrot_Context *cur_ctx = cont->to_ctx;
+ /* We have a resume continuation, so we can get the address from
+ * that. */
+ cont = PMC_cont(resume);
+ cur_ctx = cont->to_ctx;
+ }
+ else {
+ /* No return continuation. Assuming we're being called */
+ cont = NULL;
+ GET_ATTR_thrower(interp, SELF, cur_ctx);
+ }
+ {
while (cur_ctx) {
PMC *frame = pmc_new(interp, enum_class_Hash);
PMC *annotations = NULL;
@@ -774,7 +798,7 @@
if (sub->seg->annotations) {
PackFile_ByteCode *seg = sub->seg;
- opcode_t *pc = cur_ctx == cont->to_ctx
+ opcode_t *pc = cont && cur_ctx == cont->to_ctx
? cont->address
: cur_ctx->current_pc;
Modified: branches/pmc_pct/src/pmc/exporter.pmc
==============================================================================
--- branches/pmc_pct/src/pmc/exporter.pmc Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/pmc/exporter.pmc Thu Jun 4 02:32:48 2009 (r39377)
@@ -1,5 +1,5 @@
/*
-Copyright (C) 2007-2008, Parrot Foundation.
+Copyright (C) 2007-2009, Parrot Foundation.
$Id$
=head1 NAME
@@ -107,10 +107,10 @@
*/
VTABLE void init() {
- Parrot_Exporter_attributes *exp = NULL;
+ Parrot_Exporter_attributes * const exp =
+ mem_allocate_zeroed_typed(Parrot_Exporter_attributes);
/* Set up the object. */
- exp = mem_allocate_zeroed_typed(Parrot_Exporter_attributes);
exp->ns_src = PMCNULL;
exp->ns_dest = CONTEXT(interp)->current_namespace;
exp->globals = PMCNULL;
@@ -148,7 +148,7 @@
*/
VTABLE void mark() {
- Parrot_Exporter_attributes *exp = PARROT_EXPORTER(SELF);
+ Parrot_Exporter_attributes * const exp = PARROT_EXPORTER(SELF);
if (exp->ns_src)
Parrot_gc_mark_PObj_alive(interp, (PObj *)exp->ns_src);
Modified: branches/pmc_pct/src/pmc/filehandle.pmc
==============================================================================
--- branches/pmc_pct/src/pmc/filehandle.pmc Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/pmc/filehandle.pmc Thu Jun 4 02:32:48 2009 (r39377)
@@ -31,6 +31,17 @@
#endif
#endif
+#ifdef PIO_OS_WIN32
+# define PIO_INVALID_HANDLE INVALID_HANDLE_VALUE
+#endif
+
+#ifdef PIO_OS_UNIX
+# define PIO_INVALID_HANDLE -1
+#endif
+
+#ifdef PIO_OS_STDIO
+# define PIO_INVALID_HANDLE NULL
+#endif
pmclass FileHandle need_ext {
ATTR INTVAL flags; /* Filehandle flags */
@@ -38,6 +49,7 @@
ATTR STRING *mode; /* The mode string used in open */
ATTR STRING *encoding; /* The encoding for read/write */
ATTR PIOHANDLE os_handle; /* Low level OS descriptor */
+ ATTR INTVAL process_id; /* Child process on pipes */
ATTR PIOOFF_T file_size; /* Current file size */
ATTR PIOOFF_T file_pos; /* Current real file pointer */
ATTR PIOOFF_T last_pos; /* Last file position */
@@ -48,6 +60,12 @@
ATTR unsigned char *buffer_next; /* Current read/write pointer */
/*
+ * Using INTVAL for process_id is a temporary solution.
+ * We may need to define a custom type to store it in a platform
+ * dependant way.
+ */
+
+/*
=item C<void init()>
@@ -61,30 +79,23 @@
Parrot_FileHandle_attributes *data_struct =
mem_allocate_typed(Parrot_FileHandle_attributes);
- PMC_data(SELF) = data_struct;
- data_struct->flags = 0;
- data_struct->mode = NULL;
- data_struct->encoding = NULL;
- data_struct->filename = NULL;
- data_struct->file_size = 0;
- data_struct->file_pos = piooffsetzero;
- data_struct->last_pos = piooffsetzero;
- data_struct->buffer_flags = 0;
- data_struct->buffer_size = 0;
- data_struct->buffer_start = NULL;
- data_struct->buffer_end = NULL;
- data_struct->buffer_next = NULL;
+ PMC_data(SELF) = data_struct;
+ data_struct->flags = 0;
+ data_struct->filename = NULL;
+ data_struct->mode = NULL;
+ data_struct->encoding = NULL;
+ data_struct->process_id = 0;
+ data_struct->file_size = 0;
+ data_struct->file_pos = piooffsetzero;
+ data_struct->last_pos = piooffsetzero;
+ data_struct->buffer_size = 0;
+ data_struct->buffer_flags = 0;
+ data_struct->buffer_start = NULL;
+ data_struct->buffer_end = NULL;
+ data_struct->buffer_next = NULL;
/* Initialize the os_handle to the platform-specific value for closed. */
-#ifdef PIO_OS_WIN32
- data_struct->os_handle = (PIOHANDLE)INVALID_HANDLE_VALUE;
-#endif
-#ifdef PIO_OS_UNIX
- data_struct->os_handle = (PIOHANDLE)-1;
-#endif
-#ifdef PIO_OS_STDIO
- data_struct->os_handle = (PIOHANDLE)NULL;
-#endif
+ data_struct->os_handle = (PIOHANDLE) PIO_INVALID_HANDLE;
PObj_custom_mark_SET(SELF);
PObj_active_destroy_SET(SELF);
@@ -160,6 +171,50 @@
/*
+=item C<INTVAL get_integer_keyed_int(INTVAL key)>
+
+Shortcut to get the value of some attributes.
+For internal usage only, subject to change without notice.
+
+=cut
+
+*/
+
+ VTABLE INTVAL get_integer_keyed_int(INTVAL key) {
+ INTVAL result;
+ switch (key) {
+ case 0:
+ GET_ATTR_process_id(INTERP, SELF, result);
+ break;
+ default:
+ result = 0;
+ }
+ return result;
+ }
+
+/*
+
+=item C<void set_integer_keyed_int(INTVAL key, INTVAL value)>
+
+Shortcut to set the value of some attributes
+For internal usage only, subject to change without notice.
+
+=cut
+
+*/
+
+ VTABLE void set_integer_keyed_int(INTVAL key, INTVAL value) {
+ switch (key) {
+ case 0:
+ SET_ATTR_process_id(INTERP, SELF, value);
+ break;
+ default:
+ break;
+ }
+ }
+
+/*
+
=item C<INTVAL get_bool()>
Returns whether the FileHandle has reached the end of the file.
@@ -341,9 +396,9 @@
*/
METHOD readline_interactive(STRING *prompt :optional, INTVAL got_prompt :opt_flag) {
- STRING *string_result;
+ STRING *string_result = NULL;
#ifdef PARROT_HAS_READLINE
- char * const r = readline(got_prompt ? prompt->strstart : NULL);
+ char * const r = readline(got_prompt ? prompt->strstart : NULL);
if (r) {
if (*r)
@@ -351,13 +406,8 @@
string_result = Parrot_str_new(INTERP, r, 0);
mem_sys_free(r);
- RETURN(STRING *string_result);
}
-
- RETURN(PMC *PMCNULL);
#else
- UINTVAL len;
-
if (got_prompt)
fprintf(stderr, "%s", prompt->strstart);
@@ -365,21 +415,22 @@
Parrot_io_setlinebuf(INTERP, SELF);
string_result = Parrot_io_reads(INTERP, SELF, 0);
- if (!string_result)
- RETURN(PMC *PMCNULL);
- len = Parrot_str_byte_length(INTERP, string_result);
- if (len < 1)
- RETURN(PMC *PMCNULL);
- while (len > 0 &&
- (((char*)string_result->strstart)[len - 1] == '\n' ||
- ((char*)string_result->strstart)[len - 1] == '\r')) {
- --len;
- --string_result->strlen;
- --string_result->bufused;
+ if (string_result) {
+ UINTVAL len = Parrot_str_byte_length(INTERP, string_result);
+ if (len < 1)
+ string_result = NULL;
+ else {
+ while (len > 0 &&
+ (((char*)string_result->strstart)[len - 1] == '\n' ||
+ ((char*)string_result->strstart)[len - 1] == '\r')) {
+ --len;
+ --string_result->strlen;
+ --string_result->bufused;
+ }
+ }
}
-
- RETURN(STRING *string_result);
#endif
+ RETURN(STRING *string_result);
}
/*
Modified: branches/pmc_pct/src/pmc/fixedintegerarray.pmc
==============================================================================
--- branches/pmc_pct/src/pmc/fixedintegerarray.pmc Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/pmc/fixedintegerarray.pmc Thu Jun 4 02:32:48 2009 (r39377)
@@ -659,6 +659,7 @@
Parrot_FixedIntegerArray_attributes *attrs =
mem_allocate_zeroed_typed(Parrot_FixedIntegerArray_attributes);
PMC_data(SELF) = attrs;
+ PObj_active_destroy_SET(SELF);
if (info->extra_flags == EXTRA_IS_NULL) {
IMAGE_IO * const io = info->image_io;
Modified: branches/pmc_pct/src/pmc/fixedpmcarray.pmc
==============================================================================
--- branches/pmc_pct/src/pmc/fixedpmcarray.pmc Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/pmc/fixedpmcarray.pmc Thu Jun 4 02:32:48 2009 (r39377)
@@ -373,7 +373,7 @@
return;
PMC_size(SELF) = size;
- data = mem_allocate_n_zeroed_typed(size, PMC *);
+ data = mem_allocate_n_typed(size, PMC *);
for (i = 0; i < size; i++)
data[i] = PMCNULL;
Modified: branches/pmc_pct/src/pmc/float.pmc
==============================================================================
--- branches/pmc_pct/src/pmc/float.pmc Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/pmc/float.pmc Thu Jun 4 02:32:48 2009 (r39377)
@@ -33,8 +33,11 @@
VTABLE void init() {
Parrot_Float_attributes * const fattr = mem_allocate_zeroed_typed(Parrot_Float_attributes);
- fattr->fv = 0.0;
+
+ fattr->fv = 0.0;
PMC_data(SELF) = fattr;
+
+ PObj_active_destroy_SET(SELF);
}
/*
Modified: branches/pmc_pct/src/pmc/hash.pmc
==============================================================================
--- branches/pmc_pct/src/pmc/hash.pmc Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/pmc/hash.pmc Thu Jun 4 02:32:48 2009 (r39377)
@@ -155,17 +155,19 @@
*/
VTABLE void init() {
- Parrot_Hash_attributes *attr =
- mem_allocate_zeroed_typed(Parrot_Hash_attributes);
+ Parrot_Hash_attributes * const attr =
+ mem_allocate_typed(Parrot_Hash_attributes);
+
PMC_data(SELF) = attr;
- SELF.set_pointer(parrot_new_hash(INTERP));
+ attr->hash = parrot_new_hash(INTERP);
PObj_custom_mark_destroy_SETALL(SELF);
}
VTABLE void destroy() {
- if (SELF.get_pointer()) {
- parrot_hash_destroy(INTERP, (Hash *)SELF.get_pointer());
- }
+ Hash *hash = (Hash *)SELF.get_pointer();
+ if (hash)
+ parrot_hash_destroy(INTERP, hash);
+
mem_sys_free(PMC_data(SELF));
}
/*
@@ -218,10 +220,10 @@
Hash *new_hash = (Hash *)ptr;
PARROT_HASH(SELF)->hash = new_hash;
- new_hash->container = SELF;
- if (old_hash != NULL) {
+ new_hash->container = SELF;
+
+ if (old_hash)
parrot_hash_destroy(INTERP, old_hash);
- }
}
/*
Modified: branches/pmc_pct/src/pmc/integer.pmc
==============================================================================
--- branches/pmc_pct/src/pmc/integer.pmc Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/pmc/integer.pmc Thu Jun 4 02:32:48 2009 (r39377)
@@ -90,9 +90,10 @@
VTABLE void init() {
- Parrot_Integer_attributes* const attrs =
- mem_allocate_zeroed_typed(Parrot_Integer_attributes);
- attrs->iv = 0;
+ Parrot_Integer_attributes * const attrs =
+ mem_allocate_typed(Parrot_Integer_attributes);
+
+ attrs->iv = 0;
PMC_data(SELF) = attrs;
PObj_active_destroy_SET(SELF);
}
@@ -363,7 +364,7 @@
MULTI PMC *add(Complex value, PMC *dest) {
const INTVAL a = SELF.get_integer();
- dest = pmc_new(INTERP, VTABLE_type(interp, value));
+ dest = pmc_new(INTERP, VTABLE_type(INTERP, value));
VTABLE_set_number_native(INTERP, dest,
a + VTABLE_get_number_keyed_int(INTERP, value, 0));
@@ -424,32 +425,26 @@
*/
- VTABLE void i_add(PMC *value) {
- const INTVAL type = value->vtable->base_type;
+ MULTI void i_add(Integer value) {
+ STATICSELF.i_add_int(VTABLE_get_integer(INTERP, value));
+ }
- switch (type) {
- case enum_class_Integer:
- STATICSELF.i_add_int(VTABLE_get_integer(INTERP, value));
- break;
- case enum_class_Complex:
- pmc_reuse(INTERP, SELF, enum_class_Complex, 0);
- VTABLE_set_number_native(INTERP, SELF,
- SELF.get_integer() + VTABLE_get_number(INTERP, value));
- break;
+ MULTI void i_add(Complex value) {
+ const INTVAL a = SELF.get_integer();
- default:
- VTABLE_set_number_native(INTERP, SELF,
- SELF.get_integer() + VTABLE_get_number(INTERP, value));
- break;
- }
+ pmc_reuse(INTERP, SELF, enum_class_Complex, 0);
+ VTABLE_set_number_native(INTERP, SELF,
+ SELF.get_integer() + VTABLE_get_number(INTERP, value));
}
+
MULTI void i_add(DEFAULT value) {
VTABLE_set_number_native(INTERP, SELF,
SELF.get_integer() + VTABLE_get_number(INTERP, value));
}
+
VTABLE void i_add_int(INTVAL b) {
const INTVAL a = SELF.get_integer();
const INTVAL c = a + b;
Modified: branches/pmc_pct/src/pmc/key.pmc
==============================================================================
--- branches/pmc_pct/src/pmc/key.pmc Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/pmc/key.pmc Thu Jun 4 02:32:48 2009 (r39377)
@@ -41,7 +41,7 @@
VTABLE void init() {
- Parrot_Key_attributes *attrs =
+ Parrot_Key_attributes * const attrs =
mem_allocate_zeroed_typed(Parrot_Key_attributes);
PMC_data(SELF) = attrs;
Modified: branches/pmc_pct/src/pmc/lexpad.pmc
==============================================================================
--- branches/pmc_pct/src/pmc/lexpad.pmc Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/pmc/lexpad.pmc Thu Jun 4 02:32:48 2009 (r39377)
@@ -78,8 +78,11 @@
*/
VTABLE void init_pmc(PMC *lexinfo) {
- Parrot_LexPad_attributes *attrs =
+ Parrot_LexPad_attributes * const attrs =
mem_allocate_zeroed_typed(Parrot_LexPad_attributes);
+
+ PObj_active_destroy_SET(SELF);
+
attrs->lexinfo = lexinfo;
PMC_data(SELF) = attrs;
}
Modified: branches/pmc_pct/src/pmc/managedstruct.pmc
==============================================================================
--- branches/pmc_pct/src/pmc/managedstruct.pmc Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/pmc/managedstruct.pmc Thu Jun 4 02:32:48 2009 (r39377)
@@ -65,7 +65,7 @@
VTABLE void init_pmc(PMC *value) {
SELF.init();
- SUPER(value);
+ SELF.set_pmc(value);
}
/*
Modified: branches/pmc_pct/src/pmc/namespace.pmc
==============================================================================
--- branches/pmc_pct/src/pmc/namespace.pmc Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/pmc/namespace.pmc Thu Jun 4 02:32:48 2009 (r39377)
@@ -67,7 +67,7 @@
if (sub->vtable_index != -1) {
/* Insert it in class, if there is a class */
if (!PMC_IS_NULL(classobj) && PObj_is_class_TEST(classobj)) {
- const char *vtable_key_c =
+ const char * const vtable_key_c =
Parrot_get_vtable_name(interp, sub->vtable_index);
PARROT_ASSERT(vtable_key_c);
vtable_key = Parrot_str_new(interp, vtable_key_c,
@@ -148,7 +148,6 @@
mem_allocate_zeroed_typed(Parrot_NameSpace_attributes);
PARROT_NAMESPACE(SELF)->vtable = PMCNULL;
PARROT_NAMESPACE(SELF)->_class = PMCNULL;
- PARROT_NAMESPACE(SELF)->_class = PMCNULL;
SELF.set_pointer(parrot_new_hash(INTERP));
PObj_custom_mark_destroy_SETALL(SELF);
}
@@ -245,7 +244,7 @@
:value->vtable->base_type == enum_class_NameSpace;
/* don't need this everywhere yet */
- PMC *old = (PMC *)parrot_hash_get(INTERP, (Hash *)SELF.get_pointer(), key);
+ PMC * const old = (PMC *)parrot_hash_get(INTERP, (Hash *)SELF.get_pointer(), key);
/* If it's a sub... */
if (!PMC_IS_NULL(value) && VTABLE_isa(INTERP, value, CONST_STRING(INTERP, "Sub"))) {
@@ -485,11 +484,9 @@
if (PMC_IS_NULL(ns))
return PMCNULL;
}
-
- return ns;
}
case enum_class_ResizableStringArray: {
- INTVAL elements = VTABLE_elements(interp, key);
+ const INTVAL elements = VTABLE_elements(interp, key);
INTVAL i;
for (i = 0; i < elements; ++i) {
STRING * const part = VTABLE_get_string_keyed_int(interp, key, i);
@@ -594,8 +591,6 @@
METHOD add_sub(STRING *name, PMC *sub) {
STRING * const s_sub = CONST_STRING(INTERP, "Sub");
STRING * const s_multisub = CONST_STRING(INTERP, "MultiSub");
- Parrot_sub *real_sub;
- INTVAL vtable_idx = 0;
if (!VTABLE_isa(INTERP, sub, s_sub)
&& !VTABLE_isa(INTERP, sub, s_multisub))
Modified: branches/pmc_pct/src/pmc/nci.pmc
==============================================================================
--- branches/pmc_pct/src/pmc/nci.pmc Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/pmc/nci.pmc Thu Jun 4 02:32:48 2009 (r39377)
@@ -23,75 +23,75 @@
void pcc_params(PARROT_INTERP, STRING *sig, Parrot_NCI_attributes * const nci_info);
void pcc_params(PARROT_INTERP, STRING *sig, Parrot_NCI_attributes * const nci_info) {
- char *sig_c = Parrot_str_to_cstring(interp, sig);
- size_t sig_length = strlen(sig_c);
- char *param_sig = mem_allocate_n_zeroed_typed(sig_length, char);
- size_t j = 0;
- size_t i;
-
- for (i = 1; i < sig_length; i++) {
- switch (sig_c[i]) {
- case '0': /* null ptr or such - doesn't consume a reg */
- break;
- case 'f':
- case 'N':
- case 'd':
- param_sig[j++] = 'N';
- break;
- case 'I': /* INTVAL */
- case 'l': /* long */
- case 'i': /* int */
- case 's': /* short */
- case 'c': /* char */
- param_sig[j++] = 'I';
- break;
- case 'S':
- case 't': /* string, pass a cstring */
- param_sig[j++] = 'S';
- break;
- case 'J': /* interpreter */
- break;
- case 'p': /* push pmc->data */
- case 'O': /* push PMC * object in P2 */
- case 'P': /* push PMC * */
- case 'V': /* push PMC * */
- param_sig[j++] = 'P';
- case 'v':
- break;
- /* I have no idea how to handle these */
- case '2':
- case '3':
- case '4':
- param_sig[j++] = 'I';
- break;
- case '@':
- param_sig[j++] = '@';
- break;
- case 'b': /* buffer (void*) pass PObj_bufstart(SReg) */
- case 'B': /* buffer (void**) pass &PObj_bufstart(SReg) */
- param_sig[j++] = 'S';
- break;
- default:
- Parrot_ex_throw_from_c_args(interp, NULL,
- EXCEPTION_JIT_ERROR,
- "Unknown param Signature %c\n", sig_c[i]);
- break;
- }
+ size_t sig_length = Parrot_str_byte_length(interp, sig);
+ char *param_sig = mem_allocate_n_typed(sig_length, char);
+ size_t j = 0;
+ size_t i;
+
+ for (i = 1; i < sig_length; i++) {
+ INTVAL c = Parrot_str_indexed(interp, sig, i);
+
+ switch (c) {
+ case (INTVAL)'0': /* null ptr or such - doesn't consume a reg */
+ break;
+ case (INTVAL)'f':
+ case (INTVAL)'N':
+ case (INTVAL)'d':
+ param_sig[j++] = 'N';
+ break;
+ case (INTVAL)'I': /* INTVAL */
+ case (INTVAL)'l': /* long */
+ case (INTVAL)'i': /* int */
+ case (INTVAL)'s': /* short */
+ case (INTVAL)'c': /* char */
+ param_sig[j++] = 'I';
+ break;
+ case (INTVAL)'S':
+ case (INTVAL)'t': /* string, pass a cstring */
+ param_sig[j++] = 'S';
+ break;
+ case (INTVAL)'J': /* interpreter */
+ break;
+ case (INTVAL)'p': /* push pmc->data */
+ case (INTVAL)'O': /* push PMC * object in P2 */
+ case (INTVAL)'P': /* push PMC * */
+ case (INTVAL)'V': /* push PMC * */
+ param_sig[j++] = 'P';
+ case (INTVAL)'v':
+ break;
+ /* I have no idea how to handle these */
+ case (INTVAL)'2':
+ case (INTVAL)'3':
+ case (INTVAL)'4':
+ param_sig[j++] = 'I';
+ break;
+ case (INTVAL)'@':
+ param_sig[j++] = '@';
+ break;
+ case (INTVAL)'b': /* buffer (void*) pass PObj_bufstart(SReg) */
+ case (INTVAL)'B': /* buffer (void**) pass &PObj_bufstart(SReg) */
+ param_sig[j++] = 'S';
+ break;
+ default:
+ Parrot_ex_throw_from_c_args(interp, NULL,
+ EXCEPTION_JIT_ERROR,
+ "Unknown param Signature %c\n", (char)c);
+ break;
}
+ }
- PARROT_ASSERT(j <= sig_length);
+ PARROT_ASSERT(j <= sig_length);
- /* use only the signature-significant part of the string buffer */
- if (j) {
- nci_info->pcc_params_signature = string_make(interp, param_sig, j,
- NULL, PObj_constant_FLAG);
- }
- else
- nci_info->pcc_params_signature = CONST_STRING(interp, "");
-
- mem_sys_free(param_sig);
- Parrot_str_free_cstring(sig_c);
+ /* use only the signature-significant part of the string buffer */
+ if (j) {
+ nci_info->pcc_params_signature = string_make(interp, param_sig, j,
+ NULL, PObj_constant_FLAG);
}
+ else
+ nci_info->pcc_params_signature = CONST_STRING(interp, "");
+
+ mem_sys_free(param_sig);
+}
pmclass NCI need_ext {
@@ -118,7 +118,7 @@
METHOD get_multisig() {
PMC *sig;
GET_ATTR_multi_sig(INTERP, SELF, sig);
- if (sig == PMCNULL)
+ if (PMC_IS_NULL(sig))
sig = PMCNULL;
RETURN(PMC *sig);
}
Modified: branches/pmc_pct/src/pmc/object.pmc
==============================================================================
--- branches/pmc_pct/src/pmc/object.pmc Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/pmc/object.pmc Thu Jun 4 02:32:48 2009 (r39377)
@@ -29,13 +29,17 @@
Parrot_Class_attributes * const _class = PARROT_CLASS(self);
const INTVAL cur_hll = CONTEXT(interp)->current_HLL;
int num_classes, i;
+ INTVAL retval;
CONTEXT(interp)->current_HLL = 0;
/* First see if we can find it in the cache. */
- if (VTABLE_exists_keyed_str(interp, _class->attrib_cache, name)) {
- const INTVAL retval =
- VTABLE_get_integer_keyed_str(interp, _class->attrib_cache, name);
+ retval = VTABLE_get_integer_keyed_str(interp,
+ _class->attrib_cache, name);
+
+ /* there's a semi-predicate problem with a retval of 0 */
+ if (retval
+ || VTABLE_exists_keyed_str(interp, _class->attrib_cache, name)) {
CONTEXT(interp)->current_HLL = cur_hll;
return retval;
}
@@ -639,15 +643,14 @@
*/
VTABLE PMC * clone() {
- Parrot_Object_attributes * const obj = PARROT_OBJECT(pmc);
+ Parrot_Object_attributes * const obj = PARROT_OBJECT(pmc);
Parrot_Class_attributes * const _class = PARROT_CLASS(obj->_class);
STRING * const meth_name = CONST_STRING(interp, "clone");
PMC * cloned;
- Parrot_Object_attributes * cloned_guts;
/* See if we have a custom override of the method first. */
const int num_classes = VTABLE_elements(interp, _class->all_parents);
- int i, num_attrs;
+ int i;
for (i = 0; i < num_classes; i++) {
/* Get the class. */
PMC * const cur_class = VTABLE_get_pmc_keyed_int(interp, _class->all_parents, i);
@@ -660,47 +663,7 @@
}
/* If we get here, no custom clone. Create a new object PMC. */
- cloned = pmc_new_noinit(interp, enum_class_Object);
-
- /* Set custom GC mark and destroy on the object. */
- PObj_custom_mark_SET(cloned);
- PObj_active_destroy_SET(cloned);
-
- /* Flag that it is an object */
- PObj_is_object_SET(cloned);
-
- /* Now create the underlying structure, and clone attributes list.class. */
- cloned_guts = mem_allocate_zeroed_typed(Parrot_Object_attributes);
- cloned_guts->_class = obj->_class;
- cloned_guts->attrib_store = VTABLE_clone(INTERP, obj->attrib_store);
- PMC_data(cloned) = cloned_guts;
- num_attrs = VTABLE_elements(INTERP, cloned_guts->attrib_store);
- for (i = 0; i < num_attrs; i++) {
- PMC * const to_clone = VTABLE_get_pmc_keyed_int(INTERP, cloned_guts->attrib_store, i);
- if (!PMC_IS_NULL(to_clone)) {
- VTABLE_set_pmc_keyed_int(INTERP, cloned_guts->attrib_store, i,
- VTABLE_clone(INTERP, to_clone));
- }
- }
-
- /* Some of the attributes may have been the PMCs providing storage for any
- * PMCs we inherited from; also need to clone those. */
- if (CLASS_has_alien_parents_TEST(obj->_class)) {
- /* Locate any PMC parents. */
- for (i = 0; i < num_classes; i++) {
- PMC * const cur_class = VTABLE_get_pmc_keyed_int(interp, _class->all_parents, i);
- if (cur_class->vtable->base_type == enum_class_PMCProxy) {
- /* Clone this PMC too. */
- STRING * const proxy = CONST_STRING(interp, "proxy");
- VTABLE_set_attr_keyed(interp, cloned, cur_class, proxy,
- VTABLE_clone(interp,
- VTABLE_get_attr_keyed(interp, cloned, cur_class, proxy)));
- }
- }
- }
-
- /* And we have ourselves a clone. */
- return cloned;
+ return Parrot_oo_clone_object(interp, SELF, obj->_class, NULL);
}
/*
Modified: branches/pmc_pct/src/pmc/packfile.pmc
==============================================================================
--- branches/pmc_pct/src/pmc/packfile.pmc Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/pmc/packfile.pmc Thu Jun 4 02:32:48 2009 (r39377)
@@ -182,11 +182,16 @@
"Can't unpack packfile.");
}
+ /* Disable GC during copy data into internal structures. */
+ Parrot_block_GC_mark(interp);
+
/* Copy values from PackFile header to own attributes */
copy_packfile_header(interp, SELF, pf);
VTABLE_set_pointer(interp, attrs->directory, &pf->directory);
+ Parrot_unblock_GC_mark(interp);
+
PackFile_destroy(interp, pf);
}
Modified: branches/pmc_pct/src/pmc/packfileannotation.pmc
==============================================================================
--- branches/pmc_pct/src/pmc/packfileannotation.pmc Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/pmc/packfileannotation.pmc Thu Jun 4 02:32:48 2009 (r39377)
@@ -20,9 +20,13 @@
*/
pmclass PackfileAnnotation {
- ATTR INTVAL value;
- ATTR INTVAL offset;
- ATTR INTVAL key_id;
+ ATTR STRING *name;
+ ATTR INTVAL offset;
+ ATTR INTVAL value_type;
+ /* This 3 attributes should be in single union. But Pmc2c isn't smart enough to handle it */
+ ATTR INTVAL int_value;
+ ATTR FLOATVAL num_value;
+ ATTR STRING *str_value;
/*
@@ -93,30 +97,30 @@
/*
-=item C<INTVAL get_key_id()>
+=item C<STRING* get_name()>
-Fetch the ID of the key of the annotation.
+Fetch the name of the annotation.
=cut
*/
- METHOD get_key_id() {
- INTVAL key_id = PARROT_PACKFILEANNOTATION(SELF)->key_id;
- RETURN(INTVAL key_id);
+ METHOD get_name() {
+ STRING * name = PARROT_PACKFILEANNOTATION(SELF)->name;
+ RETURN(STRING * name);
}
/*
-=item C<void set_key_id(INTVAL key_id)>
+=item C<void set_name(STRING* name)>
-Set the ID of the key of the annotation.
+Set the name of the annotation.
=cut
*/
- METHOD set_key_id(INTVAL key_id) {
- PARROT_PACKFILEANNOTATION(SELF)->key_id = key_id;
+ METHOD set_name(STRING * name) {
+ PARROT_PACKFILEANNOTATION(SELF)->name = name;
}
@@ -124,27 +128,99 @@
=item C<INTVAL get_integer()>
-Fetch the value of the annotation.
+Fetch the integer value of the annotation.
=cut
*/
VTABLE INTVAL get_integer() {
- return PARROT_PACKFILEANNOTATION(SELF)->value;
+ Parrot_PackfileAnnotation_attributes * attrs = PARROT_PACKFILEANNOTATION(SELF);
+ if (attrs->value_type != PF_ANNOTATION_KEY_TYPE_INT)
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
+ "Trying to fetch wrong type of value from annotation");
+ return attrs->int_value;
}
/*
-=item C<void set_integer(INTVAL value)>
+=item C<void set_integer_native(INTVAL value)>
-Set the value of the annotation.
+Set the integer value of the annotation.
=cut
*/
VTABLE void set_integer_native(INTVAL value) {
- PARROT_PACKFILEANNOTATION(SELF)->value = value;
+ Parrot_PackfileAnnotation_attributes * attrs = PARROT_PACKFILEANNOTATION(SELF);
+ attrs->value_type = PF_ANNOTATION_KEY_TYPE_INT;
+ attrs->int_value = value;
+ }
+
+/*
+
+=item C<STRING * get_string()>
+
+Fetch the string value of the annotation.
+
+=cut
+
+*/
+ VTABLE STRING * get_string() {
+ Parrot_PackfileAnnotation_attributes * attrs = PARROT_PACKFILEANNOTATION(SELF);
+ if (attrs->value_type != PF_ANNOTATION_KEY_TYPE_STR)
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
+ "Trying to fetch wrong type of value from annotation");
+ return attrs->str_value;
+ }
+
+
+/*
+
+=item C<void set_string_native(STRING * value)>
+
+Set the string value of the annotation.
+
+=cut
+
+*/
+ VTABLE void set_string_native(STRING * value) {
+ Parrot_PackfileAnnotation_attributes * attrs = PARROT_PACKFILEANNOTATION(SELF);
+ attrs->value_type = PF_ANNOTATION_KEY_TYPE_STR;
+ attrs->str_value = value;
+ }
+
+/*
+
+=item C<INTVAL get_number()>
+
+Fetch the float value of the annotation.
+
+=cut
+
+*/
+ VTABLE FLOATVAL get_number() {
+ Parrot_PackfileAnnotation_attributes * attrs = PARROT_PACKFILEANNOTATION(SELF);
+ if (attrs->value_type != PF_ANNOTATION_KEY_TYPE_NUM)
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
+ "Trying to fetch wrong type of value from annotation");
+ return attrs->num_value;
+ }
+
+
+/*
+
+=item C<void set_number_native(INTVAL value)>
+
+Set the float value of the annotation.
+
+=cut
+
+*/
+ VTABLE void set_number_native(FLOATVAL value) {
+ Parrot_PackfileAnnotation_attributes * attrs = PARROT_PACKFILEANNOTATION(SELF);
+ attrs->value_type = PF_ANNOTATION_KEY_TYPE_NUM;
+ attrs->num_value = value;
}
}
Deleted: branches/pmc_pct/src/pmc/packfileannotationkeys.pmc
==============================================================================
--- branches/pmc_pct/src/pmc/packfileannotationkeys.pmc Thu Jun 4 02:32:48 2009 (r39376)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,289 +0,0 @@
-/*
-Copyright (C) 2001-2008, Parrot Foundation.
-$Id$
-
-=head1 NAME
-
-src/pmc/packfileannotationkeys.pmc - PackfileAnnotationKeys PMC
-
-=head1 DESCRIPTION
-
-This class implements a PackfileAnnotationKeys object, an array storing the
-table of keys and types contained within a PackfileAnnotations container.
-
-See packfile.pmc for the toplevel Packfile interface, see packfilesegment.pmc
-for the list of common methods every packfile segment pmc must implement; see
-PDD13 for the design spec.
-
-
-=head2 Methods
-
-=over 4
-
-=cut
-
-*/
-
-/*
-Fetch PackfileConstantTable from PackfileAnnotationKeys.
-Throw exception if table wasn't initilized.
-*/
-static PMC *
-fetch_const_table(PARROT_INTERP, PMC *self) {
- PMC * table = PARROT_PACKFILEANNOTATIONKEYS(self)->const_table;
- if (!table)
- Parrot_ex_throw_from_c_args(interp, NULL,
- EXCEPTION_PARROT_USAGE_ERROR, "Wrong Annotation initialization");
-
- return table;
-}
-
-pmclass PackfileAnnotationKeys {
- /* ConstantTable used for names lookup */
- ATTR PMC *const_table;
-
- /* RIA of Names */
- ATTR PMC *names;
-
- /* RIA of Types */
- ATTR PMC *types;
-
-/*
-
-=item C<void init()>
-
-Initialize PackfileAnnotationKeys.
-
-=cut
-
-*/
- VTABLE void init() {
- Parrot_PackfileAnnotationKeys_attributes * attrs =
- mem_allocate_zeroed_typed(Parrot_PackfileAnnotationKeys_attributes);
-
- attrs->const_table = NULL;
- attrs->names = pmc_new(interp, enum_class_ResizableIntegerArray);
- attrs->types = pmc_new(interp, enum_class_ResizableIntegerArray);
-
- PObj_custom_mark_destroy_SETALL(SELF);
- PMC_data(SELF) = attrs;
- }
-
-/*
-
-=item C<void mark()>
-
-Marks the object as live.
-
-=cut
-
-*/
-
- VTABLE void mark() {
- Parrot_PackfileAnnotationKeys_attributes * attrs =
- PARROT_PACKFILEANNOTATIONKEYS(SELF);
-
- if (attrs->const_table)
- Parrot_gc_mark_PObj_alive(interp, (PObj *)attrs->const_table);
- if (attrs->names)
- Parrot_gc_mark_PObj_alive(interp, (PObj *)attrs->names);
- if (attrs->types)
- Parrot_gc_mark_PObj_alive(interp, (PObj *)attrs->types);
- }
-
-/*
-
-=item C<void destroy()>
-
-Destroys the PMC and frees all allocated memory.
-
-=cut
-
-*/
-
- VTABLE void destroy() {
- Parrot_PackfileAnnotationKeys_attributes * attrs =
- PARROT_PACKFILEANNOTATIONKEYS(SELF);
-
- if (attrs) {
- mem_sys_free(attrs);
- PMC_data(SELF) = NULL;
- }
- }
-/*
-
-=item C<STRING *get_string_keyed_int(INTVAL index)>
-
-Fetch the given entry's name key.
-
-=cut
-
-*/
- VTABLE STRING *get_string_keyed_int(INTVAL index) {
- Parrot_PackfileAnnotationKeys_attributes *attrs =
- PARROT_PACKFILEANNOTATIONKEYS(SELF);
-
- PMC *const_table = fetch_const_table(interp, SELF);
- INTVAL const_index = VTABLE_get_integer_keyed_int(interp,
- attrs->names, index);
- return VTABLE_get_string_keyed_int(interp, attrs->const_table, const_index);
- }
-
-
-/*
-
-=item C<void set_string_keyed_int(INTVAL index, STRING *value)>
-
-Store the given entry's name key.
-
-=cut
-
-*/
- VTABLE void set_string_keyed_int(INTVAL index, STRING *value) {
- Parrot_PackfileAnnotationKeys_attributes *attrs =
- PARROT_PACKFILEANNOTATIONKEYS(SELF);
- PMC *const_table = fetch_const_table(interp, SELF);
- INTVAL i;
-
- /* Store constant into ConstantTable. Don't check for duplicates for now. */
- i = VTABLE_elements(interp, const_table);
- VTABLE_set_string_keyed_int(interp, const_table, i, value);
-
- /* And store C<i> in names */
- VTABLE_set_integer_keyed_int(interp, attrs->names, index, i);
- }
-
-/*
-
-=item C<INTVAL get_integer_keyed_int(INTVAL index)>
-
-Fetch the given entry's annotation type.
-
-=cut
-
-*/
- VTABLE INTVAL get_integer_keyed_int(INTVAL index) {
- Parrot_PackfileAnnotationKeys_attributes *attrs =
- PARROT_PACKFILEANNOTATIONKEYS(SELF);
-
- /* Just ensure sematics */
- PMC * const_table = fetch_const_table(interp, SELF);
-
- return VTABLE_get_integer_keyed_int(interp, attrs->types, index);
- }
-
-
-/*
-
-=item C<void set_integer_keyed_int(INTVAL index, INTVAL value)>
-
-Store the given entry's annotation type.
-
-=cut
-
-*/
- VTABLE void set_integer_keyed_int(INTVAL index, INTVAL value) {
- Parrot_PackfileAnnotationKeys_attributes *attrs =
- PARROT_PACKFILEANNOTATIONKEYS(SELF);
- VTABLE_set_integer_keyed_int(interp, attrs->types, index, value);
- }
-
-/*
-
-=item C<void set_pointer(void *pointer)>
-
-Initialize from PackFile_Annotation pointer.
-
-=cut
-
-*/
- VTABLE void set_pointer(void *pointer) {
- PackFile_Annotations *annotations = (PackFile_Annotations*)pointer;
- Parrot_PackfileAnnotationKeys_attributes *attrs =
- PARROT_PACKFILEANNOTATIONKEYS(SELF);
- opcode_t i;
-
- for (i = 0; i < annotations->num_keys; ++i) {
- VTABLE_set_integer_keyed_int(interp, attrs->names,
- i, annotations->keys[i]->name);
- VTABLE_set_integer_keyed_int(interp, attrs->types,
- i, annotations->keys[i]->type);
- }
- }
-
-/*
-
-=item C<INTVAL elements()>
-
-Get the number of stored Keys.
-
-=cut
-
-*/
- VTABLE INTVAL elements() {
- return VTABLE_elements(interp,
- PARROT_PACKFILEANNOTATIONKEYS(SELF)->names);
- }
-
-/*
-
-=item C<void set_constant_table(PMC *table)>
-
-Set PackfileConstantTable associated with Keys.
-
-=cut
-
-*/
- METHOD set_constant_table(PMC *table) {
- PARROT_PACKFILEANNOTATIONKEYS(SELF)->const_table = table;
- }
-
-/*
-
-=item C<PMC *get_constant_table()>
-
-Get PackfileConstantTable associated with PackfileAnnotationKeys.
-Solely for testing purpose only.
-
-=cut
-
-*/
- METHOD get_constant_table() {
- PMC * table = PARROT_PACKFILEANNOTATIONKEYS(SELF)->const_table;
- if (!table)
- table = PMCNULL;
- RETURN(PMC* table);
- }
-
-/*
-
-=item C<INTVAL get_name_constant(INTVAL index)>
-
-Get constant id used for name at given C<index>.
-
-=cut
-
-*/
- METHOD get_name_constant(INTVAL index) {
- Parrot_PackfileAnnotationKeys_attributes *attrs =
- PARROT_PACKFILEANNOTATIONKEYS(SELF);
- INTVAL res = VTABLE_get_integer_keyed_int(interp, attrs->names, index);
- RETURN(INTVAL res);
- }
-
-}
-
-/*
-
-=back
-
-=cut
-
-*/
-
-/*
- * Local variables:
- * c-file-style: "parrot"
- * End:
- * vim: expandtab shiftwidth=4:
- */
Modified: branches/pmc_pct/src/pmc/packfileannotations.pmc
==============================================================================
--- branches/pmc_pct/src/pmc/packfileannotations.pmc Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/pmc/packfileannotations.pmc Thu Jun 4 02:32:48 2009 (r39377)
@@ -30,12 +30,12 @@
#include "pmc_packfileannotation.h"
pmclass PackfileAnnotations extends PackfileSegment {
+ /* ConstantTable used for names lookup */
+ ATTR PMC *const_table;
+
/* RPA of Annotation */
ATTR PMC *annotations;
- /* AnnotationKeys */
- ATTR PMC *keys;
-
/*
=item C<void init()>
@@ -50,7 +50,6 @@
mem_allocate_zeroed_typed(Parrot_PackfileAnnotations_attributes);
attrs->annotations = pmc_new(interp, enum_class_ResizablePMCArray);
- attrs->keys = pmc_new(interp, enum_class_PackfileAnnotationKeys);
PObj_custom_mark_destroy_SETALL(SELF);
PMC_data(SELF) = attrs;
@@ -70,10 +69,13 @@
Parrot_PackfileAnnotations_attributes * attrs =
PARROT_PACKFILEANNOTATIONS(SELF);
+ if (attrs->const_table)
+ Parrot_gc_mark_PObj_alive(interp, (PObj *)attrs->const_table);
+
if (attrs->annotations)
Parrot_gc_mark_PObj_alive(interp, (PObj *)attrs->annotations);
- if (attrs->keys)
- Parrot_gc_mark_PObj_alive(interp, (PObj *)attrs->keys);
+
+ SUPER();
}
/*
@@ -96,21 +98,6 @@
}
}
-/*
-
-=item C<PMC *get_key_list()>
-
-Get the PackfileAnnotationKeys PMC, listing the keys and types of annotations
-contained within this object.
-
-=cut
-
-*/
- METHOD get_key_list() {
- PMC * keys = PARROT_PACKFILEANNOTATIONS(SELF)->keys;
- RETURN(PMC* keys);
- }
-
/*
@@ -167,10 +154,37 @@
*/
VTABLE void set_pmc_keyed_int(INTVAL index, PMC *annotation) {
- PMC * annotations = PARROT_PACKFILEANNOTATIONS(SELF)->annotations;
+ Parrot_PackfileAnnotations_attributes * attrs =
+ PARROT_PACKFILEANNOTATIONS(SELF);
+ Parrot_PackfileAnnotation_attributes * entity_attrs =
+ PARROT_PACKFILEANNOTATION(annotation);
+ INTVAL dummy;
/* TODO: add checks desribed above */
- VTABLE_set_pmc_keyed_int(interp, annotations, index, annotation);
+ VTABLE_set_pmc_keyed_int(interp, attrs->annotations, index, annotation);
+
+ /* Add required constants */
+ Parrot_mmd_multi_dispatch_from_c_args(interp,
+ "get_or_create_constant", "PS->I", attrs->const_table,
+ entity_attrs->name, &dummy);
+
+ switch (entity_attrs->value_type) {
+ case PF_ANNOTATION_KEY_TYPE_STR:
+ Parrot_mmd_multi_dispatch_from_c_args(interp,
+ "get_or_create_constant", "PS->I", attrs->const_table,
+ entity_attrs->str_value, &dummy);
+ break;
+
+ case PF_ANNOTATION_KEY_TYPE_NUM:
+ Parrot_mmd_multi_dispatch_from_c_args(interp,
+ "get_or_create_constant", "PN->I", attrs->const_table,
+ entity_attrs->num_value, &dummy);
+ break;
+
+ default:
+ /* Do nothing. If value_type if INT it will be stored directly */
+ break;
+ }
}
/*
@@ -198,9 +212,7 @@
segment = VTABLE_get_pmc_keyed_str(interp, directory, name);
if (VTABLE_isa(interp, segment,
Parrot_str_new_constant(interp, "PackfileConstantTable"))) {
- Parrot_PCCINVOKE(interp, attrs->keys,
- Parrot_str_new_constant(interp, "set_constant_table"),
- "P->", segment);
+ attrs->const_table = segment;
break;
}
}
@@ -223,19 +235,34 @@
PMC *annotation;
Parrot_PackfileAnnotation_attributes *annotation_attrs;
- /* Initialize Keys */
- VTABLE_set_pointer(interp, attrs->keys, a);
-
/* Copy annotations to own array */
VTABLE_set_integer_native(interp, attrs->annotations, a->num_entries);
for (i = 0; i < a->num_entries; ++i) {
+ PackFile_Annotations_Entry *entry = a->entries[i];
+ PackFile_Annotations_Key *key = a->keys[entry->key];
annotation = pmc_new(interp, enum_class_PackfileAnnotation);
/* Poke directly to annotation attributes. */
annotation_attrs = PARROT_PACKFILEANNOTATION(annotation);
- annotation_attrs->value = a->entries[i]->value;
- annotation_attrs->key_id = a->entries[i]->key;
- annotation_attrs->offset = a->entries[i]->bytecode_offset;
+ annotation_attrs->offset = entry->bytecode_offset;
+ annotation_attrs->name = VTABLE_get_string_keyed_int(interp,
+ attrs->const_table, key->name);
+ switch (key->type) {
+ case PF_ANNOTATION_KEY_TYPE_INT:
+ VTABLE_set_integer_native(interp, annotation, entry->value);
+ break;
+ case PF_ANNOTATION_KEY_TYPE_STR:
+ VTABLE_set_string_native(interp, annotation,
+ VTABLE_get_string_keyed_int(interp, attrs->const_table, entry->value));
+ break;
+ case PF_ANNOTATION_KEY_TYPE_NUM:
+ VTABLE_set_number_native(interp, annotation,
+ VTABLE_get_number_keyed_int(interp, attrs->const_table, entry->value));
+ break;
+ default:
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_MALFORMED_PACKFILE,
+ "Unknown value type %d in Packfile Annotation", key->type);
+ }
VTABLE_set_pmc_keyed_int(interp, attrs->annotations, i, annotation);
}
@@ -254,37 +281,115 @@
Parrot_PackfileAnnotations_attributes *attrs =
PARROT_PACKFILEANNOTATIONS(SELF);
PackFile_Annotations *res = mem_allocate_zeroed_typed(PackFile_Annotations);
- PMC *entity;
- Parrot_PackfileAnnotation_attributes *entity_attrs;
INTVAL i, num;
INTVAL key_type;
+ PMC *keys; /* Temporary representation of Keys */
+ PMC *names; /* Constants for Key's names */
+ PMC *types; /* Types of Keys */
+ INTVAL key_id;
+ INTVAL last_key_id;
+ INTVAL name_id;
res->base.type = PF_ANNOTATIONS_SEG;
- /* Copy keys */
- num = VTABLE_elements(interp, attrs->keys);
- res->num_keys = num;
- res->keys = mem_allocate_n_typed(num, PackFile_Annotations_Key*);
- for (i = 0; i < num; ++i) {
- res->keys[i] = mem_allocate_typed(PackFile_Annotations_Key);
- Parrot_PCCINVOKE(interp, attrs->keys,
- Parrot_str_new_constant(interp, "get_name_constant"),
- "I->I", i, &res->keys[i]->name);
- res->keys[i]->type = VTABLE_get_integer_keyed_int(interp, attrs->keys, i);
- }
+ /*
+ Create keys. Hash will be created in next structure:
+ keys => {
+ name => [
+ $int_key_id,
+ $str_key_id,
+ $num_key_id,
+ ]
+ }
+
+ Each key has name from ConstantTable. We store them in names Array.
+ names => [
+ $constant_id_1,
+ $contsant_id_2,
+ ...
+ ]
+ */
+ keys = pmc_new(interp, enum_class_Hash);
+ names = pmc_new(interp, enum_class_ResizableIntegerArray);
+ types = pmc_new(interp, enum_class_ResizableIntegerArray);
+ last_key_id = -1;
- /* Copy entities */
+ /* Iterate over stored annotations and create Key if required. */
num = VTABLE_elements(interp, attrs->annotations);
res->num_entries = num;
res->entries = mem_allocate_n_typed(num, PackFile_Annotations_Entry*);
for (i = 0; i < num; ++i) {
- res->entries[i] = mem_allocate_zeroed_typed(PackFile_Annotations_Entry);
- entity = VTABLE_get_pmc_keyed_int(interp, attrs->annotations, i);
- entity_attrs = PARROT_PACKFILEANNOTATION(entity);
-
- res->entries[i]->bytecode_offset = entity_attrs->offset;
- res->entries[i]->value = entity_attrs->value;
- res->entries[i]->key = entity_attrs->key_id;
+ PMC *entity = VTABLE_get_pmc_keyed_int(interp, attrs->annotations, i);
+ Parrot_PackfileAnnotation_attributes *entity_attrs = PARROT_PACKFILEANNOTATION(entity);
+
+ /* Handle creating of Key */
+ PMC * key_array = VTABLE_get_pmc_keyed_str(interp, keys, entity_attrs->name);
+ if (PMC_IS_NULL(key_array)) {
+ /* Never see this name before. Create new FIA and add to keys. */
+ key_array = pmc_new(interp, enum_class_FixedIntegerArray);
+ VTABLE_set_integer_native(interp, key_array, 3);
+ VTABLE_set_integer_keyed_int(interp, key_array, 0, -1);
+ VTABLE_set_integer_keyed_int(interp, key_array, 1, -1);
+ VTABLE_set_integer_keyed_int(interp, key_array, 2, -1);
+
+ VTABLE_set_pmc_keyed_str(interp, keys, entity_attrs->name, key_array);
+ }
+
+ /* PackfileAnnotation.value_type exactly the same as key.type */
+ key_id = VTABLE_get_integer_keyed_int(interp, key_array, entity_attrs->value_type);
+
+ /* If key_id is -1 it means we have to create new key. */
+ if (key_id == -1) {
+ key_id = ++last_key_id;
+ VTABLE_set_integer_keyed_int(interp, key_array, entity_attrs->value_type, key_id);
+
+ /* Store type */
+ VTABLE_set_integer_keyed_int(interp, types, key_id, entity_attrs->value_type);
+
+
+ /* Store constant for name. */
+ Parrot_mmd_multi_dispatch_from_c_args(interp, "get_or_create_constant",
+ "PS->I", attrs->const_table, entity_attrs->name, &name_id);
+
+ VTABLE_set_integer_keyed_int(interp, names, key_id, name_id);
+ }
+
+ /* At this point we have create (if nesassary) key and name constant. */
+ /* Start storing real entity */
+ res->entries[i] = mem_allocate_zeroed_typed(PackFile_Annotations_Entry);
+
+ res->entries[i]->bytecode_offset = entity_attrs->offset;
+ res->entries[i]->key = key_id;
+
+ /* Handle value */
+ switch (entity_attrs->value_type) {
+ case PF_ANNOTATION_KEY_TYPE_INT:
+ res->entries[i]->value = entity_attrs->int_value;
+ break;
+ case PF_ANNOTATION_KEY_TYPE_STR:
+ Parrot_mmd_multi_dispatch_from_c_args(interp, "get_or_create_constant",
+ "PS->I", attrs->const_table, entity_attrs->str_value,
+ &res->entries[i]->value);
+ break;
+ case PF_ANNOTATION_KEY_TYPE_NUM:
+ Parrot_mmd_multi_dispatch_from_c_args(interp, "get_or_create_constant",
+ "PN->I", attrs->const_table, entity_attrs->num_value,
+ &res->entries[i]->value);
+ break;
+ default:
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_MALFORMED_PACKFILE,
+ "Unknown value type in PackfileAnnotation");
+ }
+ }
+
+ /* Time to pack keys */
+ num = VTABLE_elements(interp, types);
+ res->num_keys = num;
+ res->keys = mem_allocate_n_typed(num, PackFile_Annotations_Key*);
+ for (i = 0; i < num; ++i) {
+ res->keys[i] = mem_allocate_typed(PackFile_Annotations_Key);
+ res->keys[i]->name = VTABLE_get_integer_keyed_int(interp, names, i);
+ res->keys[i]->type = VTABLE_get_integer_keyed_int(interp, types, i);
}
return res;
Modified: branches/pmc_pct/src/pmc/packfileconstanttable.pmc
==============================================================================
--- branches/pmc_pct/src/pmc/packfileconstanttable.pmc Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/pmc/packfileconstanttable.pmc Thu Jun 4 02:32:48 2009 (r39377)
@@ -70,6 +70,8 @@
Parrot_gc_mark_PObj_alive(interp, (PObj *)attrs->constants);
if (attrs->types)
Parrot_gc_mark_PObj_alive(interp, (PObj *)attrs->types);
+
+ SUPER();
}
/*
@@ -342,6 +344,57 @@
RETURN(INTVAL rv);
}
+/*
+
+=item C<INTVAL get_or_create_constant()>
+
+Get or create constant for passed value.
+
+=cut
+
+TODO: Add same for PMCs.
+
+*/
+ MULTI INTVAL get_or_create_constant(STRING *value) {
+ Parrot_PackfileConstantTable_attributes *attrs =
+ PARROT_PACKFILECONSTANTTABLE(SELF);
+ INTVAL num = VTABLE_elements(interp, attrs->types);
+ INTVAL i;
+ STRING *str;
+ for (i=0; i < num; ++i) {
+ INTVAL type = VTABLE_get_integer_keyed_int(interp, attrs->types, i);
+ if (type != PFC_STRING)
+ continue;
+
+ str = VTABLE_get_string_keyed_int(interp, attrs->constants, i);
+ if (Parrot_str_equal(interp, value, str))
+ return i;
+ }
+ /* Constant not found. Add new one */
+ VTABLE_set_string_keyed_int(interp, SELF, i, value);
+ return i;
+ }
+
+ MULTI INTVAL get_or_create_constant(FLOATVAL value) {
+ Parrot_PackfileConstantTable_attributes *attrs =
+ PARROT_PACKFILECONSTANTTABLE(SELF);
+ INTVAL num = VTABLE_elements(interp, attrs->types);
+ INTVAL i;
+ FLOATVAL val;
+ for (i=0; i < num; ++i) {
+ INTVAL type = VTABLE_get_integer_keyed_int(interp, attrs->types, i);
+ if (type != PFC_NUMBER)
+ continue;
+
+ val = VTABLE_get_number_keyed_int(interp, attrs->constants, i);
+ if (FLOAT_IS_ZERO(fabs(val - value)))
+ return i;
+ }
+ /* Constant not found. Add new one */
+ VTABLE_set_number_keyed_int(interp, SELF, i, value);
+ return i;
+ }
+
}
/*
Modified: branches/pmc_pct/src/pmc/packfiledirectory.pmc
==============================================================================
--- branches/pmc_pct/src/pmc/packfiledirectory.pmc Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/pmc/packfiledirectory.pmc Thu Jun 4 02:32:48 2009 (r39377)
@@ -64,6 +64,8 @@
if (attrs->hash)
Parrot_gc_mark_PObj_alive(interp, (PObj *)attrs->hash);
+
+ SUPER();
}
/*
@@ -99,18 +101,16 @@
VTABLE void set_pointer(void *ptr) {
const PackFile_Directory * const pfd = (const PackFile_Directory *)ptr;
- PackFile_Segment *pfseg;
- PMC *segment;
- int pmc_type;
- unsigned int i;
- STRING *name;
- PMC *hash = PARROT_PACKFILEDIRECTORY(SELF)->hash;
+ size_t i;
SUPER(ptr);
/* Iterate over elements and create corresponded PMCs */
for (i=0; i < pfd->num_segments; ++i) {
- pfseg = pfd->segments[i];
+ PackFile_Segment * const pfseg = pfd->segments[i];
+ int pmc_type;
+ PMC *segment;
+ STRING *name;
switch (pfseg->type) {
case PF_DIR_SEG:
@@ -156,20 +156,16 @@
VTABLE void *get_pointer() {
Parrot_PackfileDirectory_attributes * attrs =
PARROT_PACKFILEDIRECTORY(SELF);
- PackFile * pf = PackFile_new(interp, 0); /* dummy PackFile... */
- PackFile_Directory * pfdir = &pf->directory;
- PackFile_Segment * pfseg;
- PMC * seg;
- PMC * iter;
- STRING * name;
- STRING * res;
+ PackFile * const pf = PackFile_new(interp, 0); /* dummy PackFile... */
+ PackFile_Directory * const pfdir = &pf->directory;
+ PMC * const iter = VTABLE_get_iter(interp, attrs->hash);
/* Create Segments. Add to Directory with transfering ownership */
- iter = VTABLE_get_iter(interp, attrs->hash);
while (VTABLE_get_bool(interp, iter)) {
- name = VTABLE_shift_string(interp, iter);
- seg = VTABLE_get_pmc_keyed_str(interp, attrs->hash, name);
- pfseg = (PackFile_Segment*)VTABLE_get_pointer(interp, seg);
+ STRING * const name = VTABLE_shift_string(interp, iter);
+ PMC * const seg = VTABLE_get_pmc_keyed_str(interp, attrs->hash, name);
+ PackFile_Segment * const pfseg = (PackFile_Segment *)VTABLE_get_pointer(interp, seg);
+
pfseg->pf = pf;
pfseg->name = strdup(Parrot_string_cstring(interp, name));
PackFile_add_segment(interp, pfdir, pfseg);
@@ -231,7 +227,7 @@
*/
VTABLE PMC *get_pmc_keyed(PMC *key) {
- STRING *s_key = VTABLE_get_string(interp, key);
+ STRING * const s_key = VTABLE_get_string(interp, key);
return VTABLE_get_pmc_keyed_str(interp,
PARROT_PACKFILEDIRECTORY(SELF)->hash, s_key);
}
@@ -259,7 +255,7 @@
/*
-=item C<PMC *set_pmc_keyed(PMC *key)>
+=item C<PMC *set_pmc_keyed(PMC *key, PMC *segment)>
Add a segment with the given name to the directory. Dispatches to
set_pmc_keyed_str.
@@ -269,12 +265,28 @@
*/
VTABLE void set_pmc_keyed(PMC *key, PMC *segment) {
- STRING *s_key = VTABLE_get_string(interp, key);
+ STRING * const s_key = VTABLE_get_string(interp, key);
VTABLE_set_pmc_keyed_str(interp, SELF, s_key, segment);
}
+/*
+
+=item C<PMC *delete_keyed(PMC *key)>
+
+Delete the specified segment from the directory.
+
+=cut
+
+*/
+
+ VTABLE void delete_keyed(PMC *key) {
+ VTABLE_delete_keyed(interp,
+ PARROT_PACKFILEDIRECTORY(SELF)->hash, key);
+ }
+
}
+
/*
=back
Modified: branches/pmc_pct/src/pmc/packfilefixuptable.pmc
==============================================================================
--- branches/pmc_pct/src/pmc/packfilefixuptable.pmc Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/pmc/packfilefixuptable.pmc Thu Jun 4 02:32:48 2009 (r39377)
@@ -64,6 +64,8 @@
if (attrs->entries)
Parrot_gc_mark_PObj_alive(interp, (PObj *)attrs->entries);
+
+ SUPER();
}
/*
Modified: branches/pmc_pct/src/pmc/packfilerawsegment.pmc
==============================================================================
--- branches/pmc_pct/src/pmc/packfilerawsegment.pmc Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/pmc/packfilerawsegment.pmc Thu Jun 4 02:32:48 2009 (r39377)
@@ -64,6 +64,8 @@
if (attrs->opcodes)
Parrot_gc_mark_PObj_alive(interp, (PObj *)attrs->opcodes);
+
+ SUPER();
}
/*
Modified: branches/pmc_pct/src/pmc/parrotinterpreter.pmc
==============================================================================
--- branches/pmc_pct/src/pmc/parrotinterpreter.pmc Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/pmc/parrotinterpreter.pmc Thu Jun 4 02:32:48 2009 (r39377)
@@ -242,6 +242,7 @@
PMC_data(SELF) = attrs;
create_interp(SELF, INTERP);
PARROT_ASSERT(attrs->interp);
+ PObj_active_destroy_SET(SELF);
}
}
@@ -264,6 +265,23 @@
create_interp(SELF, p);
}
+
+/*
+
+=item C<void destroy()>
+
+Destroys the PMC.
+
+=cut
+
+*/
+
+ VTABLE void destroy() {
+ if (PMC_data(SELF))
+ mem_sys_free(PMC_data(SELF));
+ }
+
+
/*
=item C<void set_pointer(void *value)>
@@ -283,6 +301,7 @@
Parrot_ParrotInterpreter_attributes *attrs =
mem_allocate_zeroed_typed(Parrot_ParrotInterpreter_attributes);
PMC_data(SELF) = attrs;
+ PObj_active_destroy_SET(SELF);
}
PMC_interp(SELF) = (struct parrot_interp_t *)value;
}
@@ -692,6 +711,7 @@
Parrot_ParrotInterpreter_attributes *attrs =
mem_allocate_zeroed_typed(Parrot_ParrotInterpreter_attributes);
PMC_data(SELF) = attrs;
+ PObj_active_destroy_SET(SELF);
}
PMC_interp(SELF) = INTERP;
Modified: branches/pmc_pct/src/pmc/parrotlibrary.pmc
==============================================================================
--- branches/pmc_pct/src/pmc/parrotlibrary.pmc Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/pmc/parrotlibrary.pmc Thu Jun 4 02:32:48 2009 (r39377)
@@ -1,5 +1,5 @@
/*
-Copyright (C) 2001-2008, Parrot Foundation.
+Copyright (C) 2001-2009, Parrot Foundation.
$Id$
=head1 NAME
@@ -46,7 +46,7 @@
*/
VTABLE void init() {
- Parrot_ParrotLibrary_attributes *attrs =
+ Parrot_ParrotLibrary_attributes * const attrs =
mem_allocate_zeroed_typed(Parrot_ParrotLibrary_attributes);
PMC_data(SELF) = attrs;
PObj_active_destroy_SET(SELF);
@@ -81,7 +81,7 @@
*/
VTABLE PMC *clone() {
- PMC *dest = pmc_new(INTERP, SELF->vtable->base_type);
+ PMC * const dest = pmc_new(INTERP, SELF->vtable->base_type);
PMC_oplib_init(dest) = PMC_oplib_init(SELF);
PMC_dlhandle(dest) = PMC_dlhandle(SELF);
@@ -116,8 +116,8 @@
*/
VTABLE STRING *get_string() {
- STRING *key = CONST_STRING(INTERP, "_filename");
- PMC *prop = VTABLE_getprop(INTERP, SELF, key);
+ STRING * const key = CONST_STRING(INTERP, "_filename");
+ PMC * const prop = VTABLE_getprop(INTERP, SELF, key);
return VTABLE_get_string(INTERP, prop);
}
Modified: branches/pmc_pct/src/pmc/pmcproxy.pmc
==============================================================================
--- branches/pmc_pct/src/pmc/pmcproxy.pmc Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/pmc/pmcproxy.pmc Thu Jun 4 02:32:48 2009 (r39377)
@@ -295,9 +295,16 @@
return 1;
/* Look in the isa hash. */
- if (interp->vtables[_proxy->id] != NULL &&
- parrot_hash_exists(interp, interp->vtables[_proxy->id]->isa_hash, classname))
- return 1;
+ if (interp->vtables[_proxy->id]) {
+ Hash *isa_hash = interp->vtables[_proxy->id]->isa_hash;
+
+ if (!isa_hash && Parrot_str_equal(interp,
+ interp->vtables[_proxy->id]->whoami, classname))
+ return 1;
+
+ if (isa_hash && parrot_hash_exists(interp, isa_hash, classname))
+ return 1;
+ }
/* Iterate over all the parents and check if they respond true
* for 'isa' on the original comparison. */
@@ -334,9 +341,17 @@
return 1;
/* Look in the isa hash. */
- if (interp->vtables[_proxy->id] != NULL &&
- parrot_hash_exists(interp, interp->vtables[_proxy->id]->isa_hash, classname))
- return 1;
+ if (interp->vtables[_proxy->id]) {
+ Hash *isa_hash = interp->vtables[_proxy->id]->isa_hash;
+
+ if (!isa_hash && Parrot_str_equal(interp,
+ interp->vtables[_proxy->id]->whoami, classname)) {
+ return 1;
+ }
+
+ if (isa_hash && parrot_hash_exists(interp, isa_hash, classname))
+ return 1;
+ }
return 0;
}
Modified: branches/pmc_pct/src/pmc/resizablepmcarray.pmc
==============================================================================
--- branches/pmc_pct/src/pmc/resizablepmcarray.pmc Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/pmc/resizablepmcarray.pmc Thu Jun 4 02:32:48 2009 (r39377)
@@ -69,11 +69,13 @@
}
else {
-
SUPER(size);
PMC_threshold(SELF) = size;
}
}
+ else if (size == PMC_size(SELF)) {
+ return;
+ }
else if (size <= PMC_threshold(SELF)) {
PMC_size(SELF) = size;
@@ -81,7 +83,6 @@
return;
}
else {
-
INTVAL i, cur, needed;
i = cur = PMC_threshold(SELF);
if (cur < 8192)
@@ -92,8 +93,10 @@
cur &= ~0xfff;
}
- PMC_array(SELF) = (PMC **)mem_sys_realloc(PMC_array(SELF),
- cur * sizeof (PMC *));
+ if (cur < 8)
+ cur = 8;
+
+ PMC_array(SELF) = mem_realloc_n_typed(PMC_array(SELF), cur, PMC *);
for (; i < cur; i++) {
(PMC_array(SELF))[i] = PMCNULL;
Modified: branches/pmc_pct/src/pmc/retcontinuation.pmc
==============================================================================
--- branches/pmc_pct/src/pmc/retcontinuation.pmc Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/pmc/retcontinuation.pmc Thu Jun 4 02:32:48 2009 (r39377)
@@ -36,11 +36,12 @@
*/
VTABLE void init() {
- Parrot_RetContinuation_attributes *attrs =
- mem_allocate_zeroed_typed(Parrot_RetContinuation_attributes);
- PMC_data(SELF) = attrs;
+ Parrot_RetContinuation_attributes * const attrs =
+ mem_allocate_typed(Parrot_RetContinuation_attributes);
+ PMC_data(SELF) = attrs;
PMC_cont(SELF) = new_ret_continuation(INTERP);
+
PObj_custom_mark_destroy_SETALL(SELF);
}
Modified: branches/pmc_pct/src/pmc/scalar.pmc
==============================================================================
--- branches/pmc_pct/src/pmc/scalar.pmc Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/pmc/scalar.pmc Thu Jun 4 02:32:48 2009 (r39377)
@@ -1,5 +1,5 @@
/*
-Copyright (C) 2001-2008, Parrot Foundation.
+Copyright (C) 2001-2009, Parrot Foundation.
$Id$
=head1 NAME
@@ -76,7 +76,7 @@
dest = pmc_new(interp, enum_class_BigInt);
VTABLE_set_integer_native(interp, dest, base);
- interp->vtables[enum_class_BigInt]->bitwise_shl_int(interp, dest, shift_amount, dest);
+ VTABLE_i_bitwise_shl_int(interp, dest, shift_amount);
}
return dest;
@@ -257,10 +257,7 @@
MULTI PMC *subtract(Complex value, PMC *dest) {
const FLOATVAL a = SELF.get_number();
- if (dest)
- pmc_reuse(INTERP, dest, value->vtable->base_type, 0);
- else
- dest = pmc_new(INTERP, VTABLE_type(INTERP, value));
+ dest = pmc_new(INTERP, VTABLE_type(INTERP, value));
VTABLE_set_number_native(INTERP, dest,
a - VTABLE_get_number_keyed_int(INTERP, value, 0));
@@ -403,7 +400,7 @@
*/
MULTI PMC *divide(PMC *value, PMC *dest) {
- FLOATVAL d = VTABLE_get_number(INTERP, value);
+ const FLOATVAL d = VTABLE_get_number(INTERP, value);
if (FLOAT_IS_ZERO(d))
Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_DIV_BY_ZERO,
@@ -438,7 +435,7 @@
}
VTABLE void i_divide(PMC *value) {
- FLOATVAL d = VTABLE_get_number(INTERP, value);
+ const FLOATVAL d = VTABLE_get_number(INTERP, value);
if (FLOAT_IS_ZERO(d))
Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_DIV_BY_ZERO,
@@ -524,7 +521,7 @@
}
VTABLE void i_floor_divide(PMC *value) {
- FLOATVAL d = VTABLE_get_number(INTERP, value);
+ const FLOATVAL d = VTABLE_get_number(INTERP, value);
if (FLOAT_IS_ZERO(d))
Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_DIV_BY_ZERO,
@@ -576,7 +573,7 @@
*/
MULTI PMC *modulus(PMC *value, PMC *dest) {
- FLOATVAL d = VTABLE_get_number(INTERP, value);
+ const FLOATVAL d = VTABLE_get_number(INTERP, value);
if (FLOAT_IS_ZERO(d))
Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_DIV_BY_ZERO,
@@ -614,7 +611,7 @@
}
VTABLE void i_modulus(PMC *value) {
- FLOATVAL d = VTABLE_get_number(INTERP, value);
+ const FLOATVAL d = VTABLE_get_number(INTERP, value);
if (FLOAT_IS_ZERO(d))
Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_DIV_BY_ZERO,
@@ -866,7 +863,7 @@
return dest;
}
- MULTI PMC *bitwise_xor_int(INTVAL value, PMC *dest) {
+ VTABLE PMC *bitwise_xor_int(INTVAL value, PMC *dest) {
const INTVAL result = SELF.get_integer() ^ value;
dest = pmc_new(INTERP, VTABLE_type(INTERP, SELF));
Modified: branches/pmc_pct/src/pmc/string.pmc
==============================================================================
--- branches/pmc_pct/src/pmc/string.pmc Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/pmc/string.pmc Thu Jun 4 02:32:48 2009 (r39377)
@@ -34,9 +34,8 @@
*/
VTABLE void init() {
-
Parrot_String_attributes *attrs =
- mem_allocate_zeroed_typed(Parrot_String_attributes);
+ mem_allocate_typed(Parrot_String_attributes);
attrs->str_val = Parrot_str_new_noinit(INTERP, enum_stringrep_one, 0);
PMC_data(SELF) = attrs;
@@ -242,8 +241,10 @@
VTABLE void set_string_native(STRING *value) {
/* Only allow constant PMCs to embed constant strings */
if (PObj_constant_TEST(SELF) && !PObj_constant_TEST(value)) {
- const char *copy = Parrot_str_to_cstring(INTERP, value);
- value = Parrot_str_new_constant(INTERP, copy);
+ char *copy = Parrot_str_to_cstring(INTERP, value);
+ value = Parrot_str_new_init(INTERP, copy, strlen(copy),
+ PARROT_DEFAULT_ENCODING, PARROT_DEFAULT_CHARSET, PObj_constant_FLAG);
+ Parrot_str_free_cstring(copy);
}
SET_ATTR_str_val(INTERP, SELF, value);
@@ -260,8 +261,11 @@
*/
VTABLE void assign_string_native(STRING *value) {
- SET_ATTR_str_val(INTERP, SELF,
- Parrot_str_set(INTERP, SELF.get_string(), value));
+ if (!STRING_IS_NULL(value))
+ SET_ATTR_str_val(INTERP, SELF,
+ Parrot_str_set(INTERP, SELF.get_string(), value));
+ else
+ SET_ATTR_str_val(INTERP, SELF, NULL);
}
/*
@@ -841,7 +845,7 @@
IMAGE_IO * const io = info->image_io;
SUPER(info);
if (info->extra_flags == EXTRA_IS_NULL)
- SELF.set_string_native(VTABLE_shift_string(INTERP, io));
+ SET_ATTR_str_val(INTERP, SELF, VTABLE_shift_string(INTERP, io));
}
/*
Modified: branches/pmc_pct/src/pmc/stringhandle.pmc
==============================================================================
--- branches/pmc_pct/src/pmc/stringhandle.pmc Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/pmc/stringhandle.pmc Thu Jun 4 02:32:48 2009 (r39377)
@@ -11,15 +11,40 @@
The StringHandle PMC performs I/O operations, but on an internal string rather
than an external file. Commonly used as a mock FileHandle for testing.
-=head2 Vtable Functions
+=cut
+
+*/
+
+#include "../src/io/io_private.h"
+
+PARROT_INLINE
+static int encoding_is_utf8(PARROT_INTERP, ARGIN_NULLOK(STRING *s));
+
+/*
+
+=head2 Internal Functions
=over 4
+=item C<static int encoding_is_utf8()>
+
+Helper function for internal usage. Return 1 if the string argument is
+not null and has utf8 encoding, 0 otherwise.
+
+=back
+
=cut
*/
-#include "../src/io/io_private.h"
+PARROT_INLINE
+static int encoding_is_utf8(PARROT_INTERP, ARGIN_NULLOK(STRING *s))
+{
+ if (STRING_IS_NULL(s))
+ return 0;
+ else
+ return Parrot_str_equal(interp, s, CONST_STRING(interp, "utf8"));
+}
pmclass StringHandle need_ext {
ATTR INTVAL flags; /* Filehandle flags */
@@ -31,6 +56,10 @@
/*
+=head2 Vtable Functions
+
+=over 4
+
=item C<void init()>
Initializes a newly created StringHandle object.
@@ -176,8 +205,7 @@
STRING *encoding;
GET_ATTR_encoding(INTERP, SELF, encoding);
- if (!STRING_IS_NULL(encoding)
- && Parrot_str_equal(INTERP, encoding, CONST_STRING(INTERP, "utf8")))
+ if (encoding_is_utf8(INTERP, encoding))
new_string = string_make(INTERP, "", 0, "unicode", 0);
else
new_string = Parrot_str_new(INTERP, "", 0);
@@ -343,9 +371,7 @@
if (STRING_IS_NULL(string_result)) {
STRING *encoding;
GET_ATTR_encoding(INTERP, SELF, encoding);
- if (!STRING_IS_NULL(encoding) &&
- Parrot_str_equal(INTERP, encoding,
- Parrot_str_new_constant(INTERP, "utf8")))
+ if (encoding_is_utf8(INTERP, encoding))
string_result = string_make(INTERP, "", 0, "unicode", 0);
else
string_result = Parrot_str_new_constant(INTERP, "");
@@ -432,9 +458,9 @@
METHOD buffer_type(STRING *new_type :optional, INTVAL got_type :opt_flag) {
INTVAL flags;
- STRING * const nobuffer_string = Parrot_str_new_constant(INTERP, "unbuffered");
- STRING * const linebuffer_string = Parrot_str_new_constant(INTERP, "line-buffered");
- STRING * const fullbuffer_string = Parrot_str_new_constant(INTERP, "full-buffered");
+ STRING * const nobuffer_string = CONST_STRING(INTERP, "unbuffered");
+ STRING * const linebuffer_string = CONST_STRING(INTERP, "line-buffered");
+ STRING * const fullbuffer_string = CONST_STRING(INTERP, "full-buffered");
GET_ATTR_flags(INTERP, SELF, flags);
Modified: branches/pmc_pct/src/pmc/sub.pmc
==============================================================================
--- branches/pmc_pct/src/pmc/sub.pmc Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/pmc/sub.pmc Thu Jun 4 02:32:48 2009 (r39377)
@@ -1,5 +1,5 @@
/*
-Copyright (C) 2001-2008, Parrot Foundation.
+Copyright (C) 2001-2009, Parrot Foundation.
$Id$
=head1 NAME
@@ -22,7 +22,7 @@
#include "sub.str"
static void
-print_sub_name(PARROT_INTERP, PMC *sub)
+print_sub_name(PARROT_INTERP, ARGIN_NULLOK(PMC *sub))
{
Interp * const tracer = (interp->pdb && interp->pdb->debugger) ?
interp->pdb->debugger :
@@ -67,7 +67,7 @@
* see also the enum in include/parrot/sub.h
*/
VTABLE void init() {
- Parrot_Sub_attributes *attrs =
+ Parrot_Sub_attributes * const attrs =
mem_allocate_zeroed_typed(Parrot_Sub_attributes);
attrs->sub = new_sub(INTERP);
@@ -120,9 +120,10 @@
VTABLE STRING *get_string() {
Parrot_sub *sub;
PMC_get_sub(INTERP, SELF, sub);
- if (sub->name != NULL) {
+
+ if (sub->name)
return Parrot_str_copy(INTERP, sub->name);
- }
+
return NULL;
}
@@ -260,16 +261,8 @@
PARROT_ASSERT(!PMC_IS_NULL(ccont));
- /*
- * plain subroutine call
- * create new context, place it in interpreter
- */
-/*#define PREMATURE_OPT*/
-#ifdef PREMATURE_OPT
- if (caller_ctx->current_sub == SELF)
- context = Parrot_dup_context(INTERP, caller_ctx);
- else
-#endif
+ /* plain subroutine call
+ * create new context, place it in interpreter */
context = Parrot_set_new_context(INTERP, sub->n_regs_used);
context->current_sub = SELF;
context->caller_ctx = caller_ctx;
@@ -286,8 +279,7 @@
/* if this is an outer sub, then we need to set sub->ctx
* to the new context (refcounted) and convert the
- * retcontinuation to a normal continuation.
- */
+ * retcontinuation to a normal continuation. */
if (PObj_get_FLAGS(SELF) & SUB_FLAG_IS_OUTER) {
/* release any previously held context */
if (sub->ctx)
@@ -339,7 +331,7 @@
PMC_get_sub(INTERP, outer_pmc, outer_sub);
if (!outer_sub->ctx) {
- Parrot_Context *dummy = Parrot_alloc_context(INTERP,
+ Parrot_Context * const dummy = Parrot_alloc_context(INTERP,
outer_sub->n_regs_used, NULL);
dummy->current_sub = outer_pmc;
@@ -366,9 +358,9 @@
Parrot_switch_to_cs(INTERP, sub->seg, 1);
if (PObj_get_FLAGS(ccont) & SUB_FLAG_TAILCALL) {
- if (!(*pc == PARROT_OP_get_params_pc ||
- (*pc == PARROT_OP_push_eh_ic &&
- pc[2] == PARROT_OP_get_params_pc))) {
+ if (!(*pc == PARROT_OP_get_params_pc
+ || (*pc == PARROT_OP_push_eh_ic
+ && pc[2] == PARROT_OP_get_params_pc))) {
/* TODO keep it or resize it */
--context->recursion_depth;
@@ -394,23 +386,33 @@
*/
VTABLE PMC *clone() {
+ PMC * const ret = pmc_new(INTERP, SELF->vtable->base_type);
Parrot_sub *dest_sub;
- Parrot_sub *sub = mem_allocate_typed(Parrot_sub);
- PMC * const ret = pmc_new(INTERP, SELF->vtable->base_type);
+ Parrot_sub *sub;
/* we have to mark it ourselves */
PObj_custom_mark_destroy_SETALL(ret);
- /* first set the sub struct, Parrot_str_copy may cause GC */
- SET_ATTR_sub(INTERP, ret, sub);
+ PMC_get_sub(INTERP, ret, sub);
+
+ /* release any previously held contexts */
+ if (sub->ctx)
+ Parrot_free_context(INTERP, sub->ctx, 1);
+ if (sub->outer_ctx)
+ Parrot_free_context(INTERP, sub->outer_ctx, 1);
+
PMC_get_sub(INTERP, SELF, dest_sub);
- memcpy(sub, dest_sub, sizeof (Parrot_sub));
- if (sub->name != NULL)
+
+ /* first set the sub struct, Parrot_str_copy may cause GC */
+ *sub = *dest_sub;
+
+ if (sub->name)
sub->name = Parrot_str_copy(INTERP, sub->name);
/* Be sure not to share arg_info. */
dest_sub->arg_info = NULL;
+ /* mark any newly held contexts */
if (sub->ctx)
Parrot_context_ref(INTERP, sub->ctx);
if (sub->outer_ctx)
@@ -434,20 +436,32 @@
}
VTABLE void assign_pmc(PMC *other) {
- Parrot_sub *my_sub, *other_sub;
/* only handle the case where the other PMC is the same type */
if (other->vtable->base_type == SELF->vtable->base_type) {
- /* copy the sub struct */
+ Parrot_sub *my_sub;
+ Parrot_sub *other_sub;
PMC_get_sub(INTERP, SELF, my_sub);
PMC_get_sub(INTERP, other, other_sub);
- memcpy(my_sub, other_sub, sizeof (struct Parrot_sub));
+
+ /* Increase reference count of destination before
+ * freeing the one in self, to avoid problems in
+ * case of self assignment */
+ if (other_sub->ctx)
+ Parrot_context_ref(interp, other_sub->ctx);
+ /* get rid of this context, if attached */
+ if (my_sub->ctx)
+ Parrot_free_context(INTERP, my_sub->ctx, 1);
+
+ /* copy the sub struct */
+ memmove(my_sub, other_sub, sizeof (Parrot_sub));
/* copy the name so it's a different string in memory */
- if (my_sub->name != NULL)
+ if (my_sub->name)
my_sub->name = Parrot_str_copy(INTERP, my_sub->name);
}
else
- Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION,
+ Parrot_ex_throw_from_c_args(INTERP, NULL,
+ EXCEPTION_INVALID_OPERATION,
"Can't assign a non-Sub type to a Sub");
}
@@ -503,15 +517,14 @@
*/
MULTI INTVAL is_equal(PMC *value) {
-
Parrot_sub *my_sub, *value_sub;
PMC_get_sub(INTERP, SELF, my_sub);
PMC_get_sub(INTERP, value, value_sub);
- return SELF->vtable == value->vtable &&
- (my_sub)->start_offs == (value_sub)->start_offs &&
- (my_sub)->seg == (value_sub)->seg;
+ return SELF->vtable == value->vtable
+ && (my_sub)->start_offs == (value_sub)->start_offs
+ && (my_sub)->seg == (value_sub)->seg;
}
/*
@@ -633,6 +646,7 @@
int i;
PMC_get_sub(INTERP, SELF, sub);
+
/* we get relative offsets */
sub->start_offs = (size_t) VTABLE_shift_integer(INTERP, io);
sub->end_offs = (size_t) VTABLE_shift_integer(INTERP, io);
@@ -669,13 +683,13 @@
{
/* Create a hash, then use inspect_str to get all of the data to
* fill it up with. */
- PMC * const metadata = pmc_new(interp, enum_class_Hash);
- STRING * const pos_required_str = CONST_STRING(interp, "pos_required");
- STRING * const pos_optional_str = CONST_STRING(interp, "pos_optional");
- STRING * const named_required_str = CONST_STRING(interp, "named_required");
- STRING * const named_optional_str = CONST_STRING(interp, "named_optional");
- STRING * const pos_slurpy_str = CONST_STRING(interp, "pos_slurpy");
- STRING * const named_slurpy_str = CONST_STRING(interp, "named_slurpy");
+ PMC * const metadata = pmc_new(interp, enum_class_Hash);
+ STRING * const pos_required_str = CONST_STRING(interp, "pos_required");
+ STRING * const pos_optional_str = CONST_STRING(interp, "pos_optional");
+ STRING * const named_required_str = CONST_STRING(interp, "named_required");
+ STRING * const named_optional_str = CONST_STRING(interp, "named_optional");
+ STRING * const pos_slurpy_str = CONST_STRING(interp, "pos_slurpy");
+ STRING * const named_slurpy_str = CONST_STRING(interp, "named_slurpy");
VTABLE_set_pmc_keyed_str(interp, metadata, pos_required_str,
VTABLE_inspect_str(interp, SELF, pos_required_str));
@@ -740,13 +754,13 @@
VTABLE PMC *inspect_str(STRING *what)
{
Parrot_sub *sub;
- INTVAL count_found = -1;
- PMC *retval;
+ PMC *retval;
+ INTVAL count_found = -1;
PMC_get_sub(INTERP, SELF, sub);
+
/* If the argument info hasn't been generated yet, generate it. */
- if (sub->arg_info == NULL)
- {
+ if (!sub->arg_info) {
/* Get pointer into the bytecode where this sub starts. */
opcode_t *pc = sub->seg->base.data + sub->start_offs;
@@ -755,8 +769,8 @@
/* If the first instruction is a get_params... */
if (*pc == PARROT_OP_get_params_pc) {
- int i, sig_length;
PMC *sig;
+ int i, sig_length;
/* Get the signature (the next thing in the bytecode). */
pc++;
@@ -765,8 +779,8 @@
/* Iterate over the signature and compute argument counts. */
sig_length = VTABLE_elements(INTERP, sig);
- for (i = 0; i < sig_length; i++)
- {
+
+ for (i = 0; i < sig_length; i++) {
int sig_item = VTABLE_get_integer_keyed_int(INTERP, sig, i);;
if (PARROT_ARG_SLURPY_ARRAY_ISSET(sig_item)){
if (PARROT_ARG_NAME_ISSET(sig_item))
@@ -913,6 +927,15 @@
RETURN(PMC *lexinfo);
}
+ METHOD get_subid() {
+ Parrot_sub *sub;
+ STRING *subid;
+
+ PMC_get_sub(INTERP, SELF, sub);
+ subid = sub->subid ? sub->subid : CONST_STRING(interp, "");
+ RETURN(STRING *subid);
+ }
+
METHOD get_outer() {
Parrot_sub *sub;
PMC *outersub;
@@ -957,10 +980,10 @@
}
METHOD arity() {
- PMC *pos_required = VTABLE_inspect_str(interp, SELF, CONST_STRING(interp, "pos_required"));
- PMC *named_required = VTABLE_inspect_str(interp, SELF, CONST_STRING(interp, "named_required"));
+ PMC * const pos_required = VTABLE_inspect_str(interp, SELF, CONST_STRING(interp, "pos_required"));
+ PMC * const named_required = VTABLE_inspect_str(interp, SELF, CONST_STRING(interp, "named_required"));
- INTVAL arity = VTABLE_get_integer(INTERP, pos_required) +
+ const INTVAL arity = VTABLE_get_integer(INTERP, pos_required) +
VTABLE_get_integer(INTERP, named_required);
RETURN(INTVAL arity);
Modified: branches/pmc_pct/src/pmc/undef.pmc
==============================================================================
--- branches/pmc_pct/src/pmc/undef.pmc Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/pmc/undef.pmc Thu Jun 4 02:32:48 2009 (r39377)
@@ -23,6 +23,7 @@
*/
+#include "pmc_object.h"
#define UNDEF_STRING_CLASS enum_class_String
pmclass Undef no_ro {
@@ -39,8 +40,15 @@
*/
VTABLE void set_pmc(PMC *other) {
- pmc_reuse(INTERP, SELF, other->vtable->base_type, 0);
- VTABLE_set_pmc(INTERP, SELF, other);
+ if (!PObj_is_object_TEST(other)) {
+ pmc_reuse(INTERP, SELF, other->vtable->base_type, 0);
+ VTABLE_set_pmc(INTERP, SELF, other);
+ }
+ else {
+ PMC * const class_ = PARROT_OBJECT(other)->_class;
+ pmc_reuse_by_class(INTERP, SELF, class_, PObj_is_object_FLAG);
+ Parrot_oo_clone_object(interp, other, class_, SELF);
+ }
}
/*
@@ -55,9 +63,6 @@
*/
VTABLE void assign_pmc(PMC *other) {
- if (!PObj_is_object_TEST(other))
- pmc_reuse(INTERP, SELF, other->vtable->base_type, 0);
-
/* don't want to call set_pmc if we're assigning an Undef to an Undef */
if (other->vtable->base_type != enum_class_Undef)
VTABLE_set_pmc(INTERP, SELF, other);
Modified: branches/pmc_pct/src/pmc/unmanagedstruct.pmc
==============================================================================
--- branches/pmc_pct/src/pmc/unmanagedstruct.pmc Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/pmc/unmanagedstruct.pmc Thu Jun 4 02:32:48 2009 (r39377)
@@ -653,8 +653,8 @@
pmclass UnManagedStruct need_ext no_ro {
ATTR void *ptr; /* the struct that this UnManagedStruct isn't managing */
- ATTR INTVAL size; /* the size of the struct */
ATTR PMC *init; /* the initializer used with this UnManagedStruct */
+ ATTR INTVAL size; /* the size of the struct */
/*
@@ -676,8 +676,24 @@
Parrot_UnManagedStruct_attributes *attrs =
mem_allocate_zeroed_typed(Parrot_UnManagedStruct_attributes);
PMC_data(SELF) = attrs;
+ PObj_active_destroy_SET(SELF);
+ }
+
+/*
+
+=item C<void destroy()>
+
+Destroys the subroutine.
+
+=cut
+
+*/
+
+ VTABLE void destroy() {
+ mem_sys_free(PMC_data(SELF));
}
+
/*
=item C<void init_pmc(PMC *value)>
@@ -707,7 +723,9 @@
*/
VTABLE void init_pmc(PMC *value) {
- SELF.init();
+ Parrot_UnManagedStruct_attributes *attrs =
+ mem_allocate_zeroed_typed(Parrot_UnManagedStruct_attributes);
+ PMC_data(SELF) = attrs;
SELF.set_pmc(value);
}
Modified: branches/pmc_pct/src/pmc_freeze.c
==============================================================================
--- branches/pmc_pct/src/pmc_freeze.c Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/pmc_freeze.c Thu Jun 4 02:32:48 2009 (r39377)
@@ -1759,7 +1759,6 @@
* collected under us.
*/
if (1 || (Parrot_str_byte_length(interp, image) > THAW_BLOCK_GC_SIZE)) {
- Parrot_gc_mark_and_sweep(interp, 1);
Parrot_block_GC_mark(interp);
Parrot_block_GC_sweep(interp);
gc_block = 1;
Modified: branches/pmc_pct/src/runcore/main.c
==============================================================================
--- branches/pmc_pct/src/runcore/main.c Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/runcore/main.c Thu Jun 4 02:32:48 2009 (r39377)
@@ -49,7 +49,7 @@
#include "../pmc/pmc_parrotlibrary.h"
-/* HEADERIZER HFILE: none */
+/* HEADERIZER HFILE: include/parrot/runcore_api.h */
/* XXX Needs to get done at the same time as the other interpreter files */
/* HEADERIZER BEGIN: static */
@@ -300,6 +300,7 @@
void
do_prederef(void **pc_prederef, PARROT_INTERP, int type)
{
+ ASSERT_ARGS(do_prederef)
const size_t offset = pc_prederef - interp->code->prederef.code;
opcode_t * const pc = ((opcode_t *)interp->code->base.data) + offset;
const op_info_t *opinfo;
@@ -620,6 +621,7 @@
void
exec_init_prederef(PARROT_INTERP, void *prederef_arena)
{
+ ASSERT_ARGS(exec_init_prederef)
load_prederef(interp, PARROT_CGP_CORE);
if (!interp->code->prederef.code) {
@@ -648,6 +650,7 @@
void *
init_jit(PARROT_INTERP, SHIM(opcode_t *pc))
{
+ ASSERT_ARGS(init_jit)
#if JIT_CAPABLE
opcode_t *code_start;
UINTVAL code_size; /* in opcodes */
@@ -695,7 +698,9 @@
void
prepare_for_run(PARROT_INTERP)
{
+ ASSERT_ARGS(prepare_for_run)
void *ignored;
+
switch (interp->run_core) {
case PARROT_JIT_CORE:
ignored = init_jit(interp, interp->code->base.data);
@@ -892,6 +897,7 @@
void
runops_int(PARROT_INTERP, size_t offset)
{
+ ASSERT_ARGS(runops_int)
opcode_t *(*core) (PARROT_INTERP, opcode_t *) = NULL;
/* setup event function ptrs */
@@ -1009,6 +1015,7 @@
void
Parrot_setup_event_func_ptrs(PARROT_INTERP)
{
+ ASSERT_ARGS(Parrot_setup_event_func_ptrs)
const size_t n = interp->op_count;
const oplib_init_f init_func = get_core_op_lib_init(interp, interp->run_core);
op_lib_t * const lib = init_func(1);
@@ -1034,6 +1041,36 @@
/*
+=item C<void Parrot_runcore_destroy(PARROT_INTERP)>
+
+Shuts down the runcores and deallocates any dynops memory.
+
+=cut
+
+*/
+
+void
+Parrot_runcore_destroy(PARROT_INTERP)
+{
+ ASSERT_ARGS(Parrot_runcore_destroy)
+ op_lib_t *cg_lib;
+
+#ifdef HAVE_COMPUTED_GOTO
+ cg_lib = PARROT_CORE_CGP_OPLIB_INIT(1);
+ if (cg_lib->op_func_table)
+ mem_sys_free(cg_lib->op_func_table);
+ cg_lib->op_func_table = NULL;
+
+ cg_lib = PARROT_CORE_CG_OPLIB_INIT(1);
+ if (cg_lib->op_func_table)
+ mem_sys_free(cg_lib->op_func_table);
+ cg_lib->op_func_table = NULL;
+#endif
+}
+
+
+/*
+
=back
=head2 Dynamic Loading Functions
@@ -1051,6 +1088,7 @@
void
dynop_register(PARROT_INTERP, PMC *lib_pmc)
{
+ ASSERT_ARGS(dynop_register)
op_lib_t *lib, *core;
oplib_init_f init_func;
op_func_t *new_func_table, *new_evc_func_table;
@@ -1341,6 +1379,7 @@
void
disable_event_checking(PARROT_INTERP)
{
+ ASSERT_ARGS(disable_event_checking)
/* restore func table */
PARROT_ASSERT(interp->save_func_table);
notify_func_table(interp, interp->save_func_table, 0);
@@ -1366,6 +1405,7 @@
void
enable_event_checking(PARROT_INTERP)
{
+ ASSERT_ARGS(enable_event_checking)
/* put table in place */
notify_func_table(interp, interp->evc_func_table, 1);
}
Modified: branches/pmc_pct/src/runcore/trace.c
==============================================================================
--- branches/pmc_pct/src/runcore/trace.c Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/runcore/trace.c Thu Jun 4 02:32:48 2009 (r39377)
@@ -44,6 +44,23 @@
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
/* HEADERIZER END: static */
+/*
+
+=item C<Interp * debugger_or_interp(PARROT_INTERP)>
+
+Get debugger if available
+
+=cut
+*/
+PARROT_CANNOT_RETURN_NULL
+Interp *
+debugger_or_interp(PARROT_INTERP) {
+ ASSERT_ARGS(debugger_or_interp)
+
+ return interp->pdb && interp->pdb->debugger
+ ? interp->pdb->debugger
+ : interp;
+}
/*
@@ -87,7 +104,7 @@
trace_pmc_dump(PARROT_INTERP, ARGIN_NULLOK(PMC *pmc))
{
ASSERT_ARGS(trace_pmc_dump)
- Interp * const debugger = interp->pdb->debugger;
+ Interp * const debugger = debugger_or_interp(interp);
Parrot_sub *sub;
if (!pmc) {
@@ -175,7 +192,7 @@
trace_key_dump(PARROT_INTERP, ARGIN(PMC *key))
{
ASSERT_ARGS(trace_key_dump)
- Interp * const debugger = interp->pdb->debugger;
+ Interp * const debugger = debugger_or_interp(interp);
int len = Parrot_io_eprintf(debugger, "[");
@@ -261,7 +278,7 @@
ASSERT_ARGS(trace_op_dump)
INTVAL s, n;
int more = 0, var_args;
- Interp * const debugger = interp->pdb->debugger;
+ Interp * const debugger = debugger_or_interp(interp);
op_info_t * const info = &interp->op_info_table[*pc];
PMC *sig;
int type;
Modified: branches/pmc_pct/src/scheduler.c
==============================================================================
--- branches/pmc_pct/src/scheduler.c Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/scheduler.c Thu Jun 4 02:32:48 2009 (r39377)
@@ -402,11 +402,11 @@
Parrot_cx_delete_task(PARROT_INTERP, ARGIN(PMC *task))
{
ASSERT_ARGS(Parrot_cx_delete_task)
- if (interp->scheduler) {
+ if (interp->scheduler && !PObj_on_free_list_TEST(interp->scheduler)) {
const INTVAL tid = VTABLE_get_integer(interp, task);
VTABLE_delete_keyed_int(interp, interp->scheduler, tid);
}
- else
+ else if (interp->scheduler)
Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
"Scheduler was not initialized for this interpreter.\n");
}
Modified: branches/pmc_pct/src/string/api.c
==============================================================================
--- branches/pmc_pct/src/string/api.c Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/string/api.c Thu Jun 4 02:32:48 2009 (r39377)
@@ -633,6 +633,7 @@
PARROT_EXPORT
PARROT_CANNOT_RETURN_NULL
+PARROT_OBSERVER
const char*
string_primary_encoding_for_representation(PARROT_INTERP,
parrot_string_representation_t representation)
@@ -683,6 +684,7 @@
return s;
}
+
/*
=item C<STRING * string_make(PARROT_INTERP, const char *buffer, UINTVAL len,
@@ -736,6 +738,52 @@
}
+
+/*
+
+=item C<STRING * string_make_from_charset(PARROT_INTERP, const char *buffer,
+UINTVAL len, INTVAL charset_nr, UINTVAL flags)>
+
+Creates and returns a new Parrot string using C<len> bytes of string data read
+from C<buffer>.
+
+The value of C<charset_name> specifies the string's representation. It must be
+a valid charset identifier.
+
+ 'iso-8859-1'
+ 'ascii'
+ 'binary'
+ 'unicode'
+
+The encoding is implicitly guessed; C<unicode> implies the C<utf-8> encoding,
+and the other three assume C<fixed-8> encoding.
+
+The value of C<flags> is optionally one or more C<PObj_*> flags C<OR>-ed
+together.
+
+=cut
+
+*/
+
+PARROT_EXPORT
+PARROT_WARN_UNUSED_RESULT
+PARROT_CANNOT_RETURN_NULL
+STRING *
+string_make_from_charset(PARROT_INTERP, ARGIN_NULLOK(const char *buffer),
+ UINTVAL len, INTVAL charset_nr, UINTVAL flags)
+{
+ ASSERT_ARGS(string_make_from_charset)
+ const CHARSET *charset = Parrot_get_charset(interp, charset_nr);
+
+ if (!charset)
+ Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_UNIMPLEMENTED,
+ "Invalid charset number '%d' specified", charset_nr);
+
+ return Parrot_str_new_init(interp, buffer, len,
+ charset->preferred_encoding, charset, flags);
+}
+
+
/*
=item C<STRING * Parrot_str_new_init(PARROT_INTERP, const char *buffer, UINTVAL
@@ -2357,19 +2405,27 @@
Parrot_str_to_hashval(PARROT_INTERP, ARGMOD_NULLOK(STRING *s))
{
ASSERT_ARGS(Parrot_str_to_hashval)
- register size_t h;
- const UINTVAL seed = interp->hash_seed;
+ String_iter iter;
+ UINTVAL offs;
+ size_t hashval = interp->hash_seed;
if (!s)
- return seed;
+ return hashval;
/* ZZZZZ workaround for something not setting up encodings right */
saneify_string(s);
- h = CHARSET_COMPUTE_HASH(interp, s, seed);
- s->hashval = h;
+ ENCODING_ITER_INIT(interp, s, &iter);
+
+ for (offs = 0; offs < s->strlen; ++offs) {
+ const UINTVAL c = iter.get_and_advance(interp, &iter);
+ hashval += hashval << 5;
+ hashval += c;
+ }
+
+ s->hashval = hashval;
- return h;
+ return hashval;
}
Modified: branches/pmc_pct/src/string/charset.c
==============================================================================
--- branches/pmc_pct/src/string/charset.c Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/string/charset.c Thu Jun 4 02:32:48 2009 (r39377)
@@ -35,9 +35,7 @@
CHARSET *Parrot_unicode_charset_ptr;
CHARSET *Parrot_ascii_charset_ptr;
-/*
- * all registered charsets are collected in one global structure
- */
+/* all registered charsets are collected in one global structure */
typedef struct To_converter {
NOTNULL(CHARSET *to);
@@ -46,14 +44,14 @@
typedef struct One_charset {
NOTNULL(CHARSET *charset);
- STRING *name;
- int n_converters;
- To_converter *to_converters;
+ STRING *name;
+ To_converter *to_converters;
+ int n_converters;
} One_charset;
typedef struct All_charsets {
- int n_charsets;
One_charset *set;
+ int n_charsets;
} All_charsets;
static All_charsets *all_charsets;
@@ -66,12 +64,11 @@
static void Parrot_str_internal_register_charset_names(PARROT_INTERP)
__attribute__nonnull__(1);
-static INTVAL register_charset(PARROT_INTERP,
+static INTVAL register_charset(
ARGIN(const char *charsetname),
ARGIN(CHARSET *charset))
__attribute__nonnull__(1)
- __attribute__nonnull__(2)
- __attribute__nonnull__(3);
+ __attribute__nonnull__(2);
static void register_static_converters(PARROT_INTERP)
__attribute__nonnull__(1);
@@ -80,8 +77,7 @@
__attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp)
#define ASSERT_ARGS_register_charset __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(charsetname) \
+ PARROT_ASSERT_ARG(charsetname) \
|| PARROT_ASSERT_ARG(charset)
#define ASSERT_ARGS_register_static_converters __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp)
@@ -161,10 +157,10 @@
const int n = all_charsets->n_charsets;
for (i = 0; i < n; ++i) {
- if (STREQ(all_charsets->set[i].charset->name, charsetname)) {
+ if (STREQ(all_charsets->set[i].charset->name, charsetname))
return all_charsets->set[i].charset;
- }
}
+
return NULL;
}
@@ -315,8 +311,8 @@
/*
-=item C<static INTVAL register_charset(PARROT_INTERP, const char *charsetname,
-CHARSET *charset)>
+=item C<static INTVAL register_charset(const char *charsetname, CHARSET
+*charset)>
Adds a new charset C<charset> with name <charsetname> to the list of
all charsets. Returns 0 and does nothing if a charset with that name
@@ -327,8 +323,7 @@
*/
static INTVAL
-register_charset(PARROT_INTERP, ARGIN(const char *charsetname),
- ARGIN(CHARSET *charset))
+register_charset(ARGIN(const char *charsetname), ARGIN(CHARSET *charset))
{
ASSERT_ARGS(register_charset)
int i;
@@ -348,8 +343,9 @@
else
all_charsets->set = (One_charset *)mem_sys_realloc(all_charsets->set,
(n + 1) * sizeof (One_charset));
+
all_charsets->n_charsets++;
- all_charsets->set[n].charset = charset;
+ all_charsets->set[n].charset = charset;
all_charsets->set[n].n_converters = 0;
return 1;
@@ -433,34 +429,39 @@
PARROT_EXPORT
INTVAL
-Parrot_register_charset(PARROT_INTERP, ARGIN(const char *charsetname),
+Parrot_register_charset(SHIM_INTERP, ARGIN(const char *charsetname),
ARGIN(CHARSET *charset))
{
ASSERT_ARGS(Parrot_register_charset)
if (!all_charsets) {
- all_charsets = mem_allocate_typed(All_charsets);
+ all_charsets = mem_allocate_typed(All_charsets);
+ all_charsets->set = NULL;
all_charsets->n_charsets = 0;
- all_charsets->set = NULL;
}
+
if (STREQ("binary", charsetname)) {
Parrot_binary_charset_ptr = charset;
- return register_charset(interp, charsetname, charset);
+ return register_charset(charsetname, charset);
}
+
if (STREQ("iso-8859-1", charsetname)) {
Parrot_iso_8859_1_charset_ptr = charset;
- return register_charset(interp, charsetname, charset);
+ return register_charset(charsetname, charset);
}
+
if (STREQ("unicode", charsetname)) {
Parrot_unicode_charset_ptr = charset;
- return register_charset(interp, charsetname, charset);
+ return register_charset(charsetname, charset);
}
+
if (STREQ("ascii", charsetname)) {
- if (!Parrot_default_charset_ptr) {
+ if (!Parrot_default_charset_ptr)
Parrot_default_charset_ptr = charset;
- }
+
Parrot_ascii_charset_ptr = charset;
- return register_charset(interp, charsetname, charset);
+ return register_charset(charsetname, charset);
}
+
return 0;
}
@@ -482,8 +483,7 @@
ASSERT_ARGS(Parrot_charsets_encodings_init)
/* the order is crucial here:
* 1) encodings, default = fixed_8
- * 2) charsets default = ascii
- */
+ * 2) charsets default = ascii */
Parrot_encoding_fixed_8_init(interp);
Parrot_encoding_utf8_init(interp);
Parrot_encoding_ucs2_init(interp);
@@ -495,14 +495,11 @@
Parrot_charset_unicode_init(interp);
/* Now that the plugins are registered, we can create STRING
- * names for them.
- */
+ * names for them. */
Parrot_str_internal_register_encoding_names(interp);
Parrot_str_internal_register_charset_names(interp);
- /*
- * now install charset converters
- */
+ /* now install charset converters */
register_static_converters(interp);
}
Modified: branches/pmc_pct/src/string/charset/ascii.c
==============================================================================
--- branches/pmc_pct/src/string/charset/ascii.c Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/string/charset/ascii.c Thu Jun 4 02:32:48 2009 (r39377)
@@ -766,6 +766,9 @@
=item C<static INTVAL find_cclass(PARROT_INTERP, INTVAL flags, STRING
*source_string, UINTVAL offset, UINTVAL count)>
+Find a character in the given character class. Delegates to the find_cclass
+method of the encoding plugin.
+
=cut
*/
@@ -780,13 +783,8 @@
UINTVAL end = offset + count;
end = source_string->strlen < end ? source_string->strlen : end;
- for (; pos < end; ++pos) {
- const UINTVAL codepoint = ENCODING_GET_CODEPOINT(interp, source_string, pos);
- if ((Parrot_ascii_typetable[codepoint] & flags) != 0) {
- return pos;
- }
- }
- return end;
+ return ENCODING_FIND_CCLASS(interp, source_string, Parrot_ascii_typetable,
+ flags, pos, end);
}
/*
Modified: branches/pmc_pct/src/string/charset/iso-8859-1.c
==============================================================================
--- branches/pmc_pct/src/string/charset/iso-8859-1.c Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/string/charset/iso-8859-1.c Thu Jun 4 02:32:48 2009 (r39377)
@@ -591,6 +591,9 @@
=item C<static INTVAL find_cclass(PARROT_INTERP, INTVAL flags, STRING
*source_string, UINTVAL offset, UINTVAL count)>
+Find a character in the given character class. Delegates to the find_cclass
+method of the encoding plugin.
+
=cut
*/
@@ -602,16 +605,10 @@
ASSERT_ARGS(find_cclass)
UINTVAL pos = offset;
UINTVAL end = offset + count;
- UINTVAL codepoint;
end = source_string->strlen < end ? source_string->strlen : end;
- for (; pos < end; ++pos) {
- codepoint = ENCODING_GET_CODEPOINT(interp, source_string, pos);
- if ((Parrot_iso_8859_1_typetable[codepoint] & flags) != 0) {
- return pos;
- }
- }
- return end;
+ return ENCODING_FIND_CCLASS(interp, source_string,
+ Parrot_iso_8859_1_typetable, flags, pos, end);
}
/*
Modified: branches/pmc_pct/src/string/encoding.c
==============================================================================
--- branches/pmc_pct/src/string/encoding.c Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/string/encoding.c Thu Jun 4 02:32:48 2009 (r39377)
@@ -24,16 +24,14 @@
/* HEADERIZER BEGIN: static */
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
-static INTVAL register_encoding(PARROT_INTERP,
+static INTVAL register_encoding(SHIM_INTERP,
ARGIN(const char *encodingname),
ARGIN(ENCODING *encoding))
- __attribute__nonnull__(1)
__attribute__nonnull__(2)
__attribute__nonnull__(3);
#define ASSERT_ARGS_register_encoding __attribute__unused__ int _ASSERT_ARGS_CHECK = \
- PARROT_ASSERT_ARG(interp) \
- || PARROT_ASSERT_ARG(encodingname) \
+ PARROT_ASSERT_ARG(encodingname) \
|| PARROT_ASSERT_ARG(encoding)
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will be lost. */
/* HEADERIZER END: static */
@@ -300,7 +298,7 @@
*/
static INTVAL
-register_encoding(PARROT_INTERP, ARGIN(const char *encodingname),
+register_encoding(SHIM_INTERP, ARGIN(const char *encodingname),
ARGIN(ENCODING *encoding))
{
ASSERT_ARGS(register_encoding)
Modified: branches/pmc_pct/src/string/encoding/fixed_8.c
==============================================================================
--- branches/pmc_pct/src/string/encoding/fixed_8.c Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/string/encoding/fixed_8.c Thu Jun 4 02:32:48 2009 (r39377)
@@ -34,6 +34,17 @@
__attribute__nonnull__(1)
__attribute__nonnull__(2);
+PARROT_WARN_UNUSED_RESULT
+static UINTVAL find_cclass(PARROT_INTERP,
+ ARGIN(STRING *s),
+ ARGIN(const INTVAL *typetable),
+ INTVAL flags,
+ UINTVAL pos,
+ UINTVAL end)
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ __attribute__nonnull__(3);
+
static UINTVAL fixed8_get_next(PARROT_INTERP, ARGMOD(String_iter *iter))
__attribute__nonnull__(1)
__attribute__nonnull__(2)
@@ -163,6 +174,10 @@
#define ASSERT_ARGS_codepoints __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
|| PARROT_ASSERT_ARG(source_string)
+#define ASSERT_ARGS_find_cclass __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(s) \
+ || PARROT_ASSERT_ARG(typetable)
#define ASSERT_ARGS_fixed8_get_next __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
|| PARROT_ASSERT_ARG(iter)
@@ -278,6 +293,33 @@
set_byte(interp, source_string, offset, codepoint);
}
+
+/*
+
+=item C<static UINTVAL find_cclass(PARROT_INTERP, STRING *s, const INTVAL
+*typetable, INTVAL flags, UINTVAL pos, UINTVAL end)>
+
+codepoints are bytes, so delegate
+
+=cut
+
+*/
+
+PARROT_WARN_UNUSED_RESULT
+static UINTVAL
+find_cclass(PARROT_INTERP, ARGIN(STRING *s), ARGIN(const INTVAL *typetable),
+INTVAL flags, UINTVAL pos, UINTVAL end)
+{
+ ASSERT_ARGS(find_cclass)
+ unsigned char *contents = (unsigned char *)s->strstart;
+ for (; pos < end; ++pos) {
+ if ((typetable[contents[pos]] & flags) != 0) {
+ return pos;
+ }
+ }
+ return end;
+}
+
/*
=item C<static UINTVAL get_byte(PARROT_INTERP, const STRING *source_string,
@@ -652,7 +694,8 @@
become_encoding,
codepoints,
bytes,
- iter_init
+ iter_init,
+ find_cclass
};
STRUCT_COPY_FROM_STRUCT(return_encoding, base_encoding);
Modified: branches/pmc_pct/src/string/encoding/ucs2.c
==============================================================================
--- branches/pmc_pct/src/string/encoding/ucs2.c Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/string/encoding/ucs2.c Thu Jun 4 02:32:48 2009 (r39377)
@@ -49,6 +49,17 @@
__attribute__nonnull__(1)
__attribute__nonnull__(2);
+PARROT_WARN_UNUSED_RESULT
+static UINTVAL find_cclass(PARROT_INTERP,
+ ARGIN(STRING *s),
+ ARGIN(const INTVAL *typetable),
+ INTVAL flags,
+ UINTVAL pos,
+ UINTVAL end)
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ __attribute__nonnull__(3);
+
static UINTVAL get_byte(PARROT_INTERP,
SHIM(const STRING *src),
SHIM(UINTVAL offset))
@@ -167,6 +178,10 @@
#define ASSERT_ARGS_codepoints __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
|| PARROT_ASSERT_ARG(src)
+#define ASSERT_ARGS_find_cclass __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(s) \
+ || PARROT_ASSERT_ARG(typetable)
#define ASSERT_ARGS_get_byte __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp)
#define ASSERT_ARGS_get_bytes __attribute__unused__ int _ASSERT_ARGS_CHECK = \
@@ -299,6 +314,27 @@
/*
+=item C<static UINTVAL find_cclass(PARROT_INTERP, STRING *s, const INTVAL
+*typetable, INTVAL flags, UINTVAL pos, UINTVAL end)>
+
+Stub, the charset level handles this for unicode strings.
+
+=cut
+
+*/
+
+PARROT_WARN_UNUSED_RESULT
+static UINTVAL
+find_cclass(PARROT_INTERP, ARGIN(STRING *s), ARGIN(const INTVAL *typetable),
+INTVAL flags, UINTVAL pos, UINTVAL end)
+{
+ Parrot_ex_throw_from_c_args(interp, NULL,
+ EXCEPTION_UNIMPLEMENTED,
+ "No find_cclass support in unicode encoding plugins");
+}
+
+/*
+
=item C<static UINTVAL get_byte(PARROT_INTERP, const STRING *src, UINTVAL
offset)>
@@ -691,7 +727,8 @@
become_encoding,
codepoints,
bytes,
- iter_init
+ iter_init,
+ find_cclass
};
STRUCT_COPY_FROM_STRUCT(return_encoding, base_encoding);
Parrot_register_encoding(interp, "ucs2", return_encoding);
Modified: branches/pmc_pct/src/string/encoding/utf16.c
==============================================================================
--- branches/pmc_pct/src/string/encoding/utf16.c Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/string/encoding/utf16.c Thu Jun 4 02:32:48 2009 (r39377)
@@ -38,6 +38,17 @@
__attribute__nonnull__(1)
__attribute__nonnull__(2);
+PARROT_WARN_UNUSED_RESULT
+static UINTVAL find_cclass(PARROT_INTERP,
+ ARGIN(STRING *s),
+ ARGIN(const INTVAL *typetable),
+ INTVAL flags,
+ UINTVAL pos,
+ UINTVAL end)
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ __attribute__nonnull__(3);
+
static UINTVAL get_byte(SHIM_INTERP,
ARGIN(const STRING *src),
UINTVAL offset)
@@ -164,6 +175,10 @@
#define ASSERT_ARGS_codepoints __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
|| PARROT_ASSERT_ARG(src)
+#define ASSERT_ARGS_find_cclass __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(s) \
+ || PARROT_ASSERT_ARG(typetable)
#define ASSERT_ARGS_get_byte __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(src)
#define ASSERT_ARGS_get_bytes __attribute__unused__ int _ASSERT_ARGS_CHECK = \
@@ -392,6 +407,27 @@
/*
+=item C<static UINTVAL find_cclass(PARROT_INTERP, STRING *s, const INTVAL
+*typetable, INTVAL flags, UINTVAL pos, UINTVAL end)>
+
+Stub, the charset level handles this for unicode strings.
+
+=cut
+
+*/
+
+PARROT_WARN_UNUSED_RESULT
+static UINTVAL
+find_cclass(PARROT_INTERP, ARGIN(STRING *s), ARGIN(const INTVAL *typetable),
+INTVAL flags, UINTVAL pos, UINTVAL end)
+{
+ Parrot_ex_throw_from_c_args(interp, NULL,
+ EXCEPTION_UNIMPLEMENTED,
+ "No find_cclass support in unicode encoding plugins");
+}
+
+/*
+
=item C<static UINTVAL get_byte(PARROT_INTERP, const STRING *src, UINTVAL
offset)>
@@ -806,7 +842,8 @@
become_encoding,
codepoints,
bytes,
- iter_init
+ iter_init,
+ find_cclass
};
STRUCT_COPY_FROM_STRUCT(return_encoding, base_encoding);
Parrot_register_encoding(interp, "utf16", return_encoding);
Modified: branches/pmc_pct/src/string/encoding/utf8.c
==============================================================================
--- branches/pmc_pct/src/string/encoding/utf8.c Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/string/encoding/utf8.c Thu Jun 4 02:32:48 2009 (r39377)
@@ -39,6 +39,17 @@
__attribute__nonnull__(2)
FUNC_MODIFIES(*src);
+PARROT_WARN_UNUSED_RESULT
+static UINTVAL find_cclass(PARROT_INTERP,
+ ARGIN(STRING *s),
+ ARGIN(const INTVAL *typetable),
+ INTVAL flags,
+ UINTVAL pos,
+ UINTVAL end)
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ __attribute__nonnull__(3);
+
static UINTVAL get_byte(SHIM_INTERP,
ARGIN(const STRING *src),
UINTVAL offset)
@@ -181,6 +192,10 @@
#define ASSERT_ARGS_codepoints __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(interp) \
|| PARROT_ASSERT_ARG(src)
+#define ASSERT_ARGS_find_cclass __attribute__unused__ int _ASSERT_ARGS_CHECK = \
+ PARROT_ASSERT_ARG(interp) \
+ || PARROT_ASSERT_ARG(s) \
+ || PARROT_ASSERT_ARG(typetable)
#define ASSERT_ARGS_get_byte __attribute__unused__ int _ASSERT_ARGS_CHECK = \
PARROT_ASSERT_ARG(src)
#define ASSERT_ARGS_get_bytes __attribute__unused__ int _ASSERT_ARGS_CHECK = \
@@ -683,6 +698,27 @@
/*
+=item C<static UINTVAL find_cclass(PARROT_INTERP, STRING *s, const INTVAL
+*typetable, INTVAL flags, UINTVAL pos, UINTVAL end)>
+
+Stub, the charset level handles this for unicode strings.
+
+=cut
+
+*/
+
+PARROT_WARN_UNUSED_RESULT
+static UINTVAL
+find_cclass(PARROT_INTERP, ARGIN(STRING *s), ARGIN(const INTVAL *typetable),
+INTVAL flags, UINTVAL pos, UINTVAL end)
+{
+ Parrot_ex_throw_from_c_args(interp, NULL,
+ EXCEPTION_UNIMPLEMENTED,
+ "No find_cclass support in unicode encoding plugins");
+}
+
+/*
+
=item C<static UINTVAL get_byte(PARROT_INTERP, const STRING *src, UINTVAL
offset)>
@@ -1018,7 +1054,8 @@
become_encoding,
codepoints,
bytes,
- iter_init
+ iter_init,
+ find_cclass
};
STRUCT_COPY_FROM_STRUCT(return_encoding, base_encoding);
Parrot_register_encoding(interp, "utf8", return_encoding);
Modified: branches/pmc_pct/src/sub.c
==============================================================================
--- branches/pmc_pct/src/sub.c Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/sub.c Thu Jun 4 02:32:48 2009 (r39377)
@@ -120,13 +120,8 @@
for (i = 0; i < ctx->n_regs_used[REGNO_STR]; ++i) {
obj = (PObj *)CTX_REG_STR(ctx, i);
- if (obj) {
- /* work around a mysterious segfault-inducing problem we haven't
- * yet tracked down */
- PObj_flag_CLEAR(is_PMC, obj);
- PObj_is_string_SET(obj);
+ if (obj)
Parrot_gc_mark_PObj_alive(interp, obj);
- }
}
}
Modified: branches/pmc_pct/src/vtables.c
==============================================================================
--- branches/pmc_pct/src/vtables.c Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/src/vtables.c Thu Jun 4 02:32:48 2009 (r39377)
@@ -179,7 +179,7 @@
ASSERT_ARGS(parrot_free_vtables)
int i;
- for (i = 1; i < interp->n_vtable_max; i++)
+ for (i = 0; i < interp->n_vtable_max; i++)
Parrot_destroy_vtable(interp, interp->vtables[i]);
mem_sys_free(interp->vtables);
Modified: branches/pmc_pct/t/benchmark/benchmarks.t
==============================================================================
--- branches/pmc_pct/t/benchmark/benchmarks.t Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/t/benchmark/benchmarks.t Thu Jun 4 02:32:48 2009 (r39377)
@@ -143,28 +143,29 @@
Copying\sa\stotal\sof\s\d+\sbytes\n
There\sare\s\d+\sactive\sBuffer\sstructs\n
There\sare\s\d+\stotal\sBuffer\sstructs\n$/x,
- q{mops.pasm} => qr/^Iterations:\s\s\s\s10000000\n
- Estimated\sops:\s20000000\n
- done\n
- Elapsed\stime:\s\s\d+\.\d+\n
- M\sop\/s:\s\s\s\s\s\s\s\s\d+\.\d+\n$/x,
- q(mops_intval.pasm) => qr/^Iterations:\s\s\s\s100000000\n
- Estimated\sops:\s200000000\n
- Elapsed\stime:\s\s\d+\.\d+\n
- M\sop\/s:\s\s\s\s\s\s\s\s\d+\.\d+\n$/x,
+#omitted because they're slow and doesn't exercise anything novel
+# q{mops.pasm} => qr/^Iterations:\s\s\s\s10000000\n
+# Estimated\sops:\s20000000\n
+# done\n
+# Elapsed\stime:\s\s\d+\.\d+\n
+# M\sop\/s:\s\s\s\s\s\s\s\s\d+\.\d+\n$/x,
+# q(mops_intval.pasm) => qr/^Iterations:\s\s\s\s100000000\n
+# Estimated\sops:\s200000000\n
+# Elapsed\stime:\s\s\d+\.\d+\n
+# M\sop\/s:\s\s\s\s\s\s\s\s\d+\.\d+\n$/x,
q{oo1.pasm} => qq(10\n),
q{oo2.pasm} => qq(10\n),
q{oo3.pasm} => qq(10\n),
q{oo4.pasm} => qq(500000\n),
q{oo5.pir} => qq(10\n),
q{oo6.pir} => qq(500000\n),
- q{oofib.pir} => qr/^fib\(28\)\s=\s317811\s\d+\.\d+s$/x,
+ q{oofib.pir} => qr/^fib\(24\)\s=\s46368\s\d+\.\d+s$/x,
q{overload.pir} => qq(42\n),
- q{primes.pasm} => qr/^N\sprimes\sup\sto\s10000\sis:\s1229\n
- last\sis:\s10001\n
+ q{primes.pasm} => qr/^N\sprimes\sup\sto\s1000\sis:\s168\n
+ last\sis:\s1001\n
Elapsed\stime:\s\d+\.\d+\n$/x,
- q{primes2.pir} => qr/^N\sprimes\scalculated\sto\s5000\sis\s670\n
- last\sis:\s4999\n$/x,
+ q{primes2.pir} => qr/^N\sprimes\scalculated\sto\s500\sis\s96\n
+ last\sis:\s499\n$/x,
q{primes2_i.pir} => qr/^N\sprimes\scalculated\sto\s10000\s
is\s1230\nlast\sis:\s9973\n$/x,
q{primes_i.pasm} => qr/^N\sprimes\sup\sto\s10000\sis:\s1229\n
Modified: branches/pmc_pct/t/codingstd/c_function_docs.t
==============================================================================
--- branches/pmc_pct/t/codingstd/c_function_docs.t Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/t/codingstd/c_function_docs.t Thu Jun 4 02:32:48 2009 (r39377)
@@ -86,8 +86,6 @@
}
__DATA__
-src/gc/gc_malloc.c
-src/gc/generational_ms.c
compilers/imcc/instructions.c
compilers/imcc/optimizer.c
compilers/imcc/parser_util.c
@@ -126,6 +124,8 @@
examples/embed/lorito.c
src/atomic/gcc_x86.c
src/debug.c
+src/gc/gc_malloc.c
+src/gc/generational_ms.c
src/gc/res_lea.c
src/io/io_string.c
src/jit/amd64/jit_defs.c
Modified: branches/pmc_pct/t/codingstd/c_returns.t
==============================================================================
--- branches/pmc_pct/t/codingstd/c_returns.t Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/t/codingstd/c_returns.t Thu Jun 4 02:32:48 2009 (r39377)
@@ -29,7 +29,8 @@
=head1 NOTES
This test was hacked from the C<check_returns> sub in
-C<tools/dev/check_source_standards.pl>
+C<tools/dev/check_source_standards.pl>, which is no longer part of the Parrot
+distribution.
=head1 SEE ALSO
Modified: branches/pmc_pct/t/codingstd/copyright.t
==============================================================================
--- branches/pmc_pct/t/codingstd/copyright.t Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/t/codingstd/copyright.t Thu Jun 4 02:32:48 2009 (r39377)
@@ -51,7 +51,7 @@
my $copyright_simple =
qr/Copyright \(C\) \d{4}/i;
my $copyright_parrot =
- qr/Copyright \(C\) (?:\d{4}\-)?\d{4}, Parrot Foundation\.$/;
+ qr/Copyright \(C\) (?:\d{4}\-)?\d{4}, Parrot Foundation\.\n/;
foreach my $file (@files) {
@@ -69,7 +69,7 @@
# is the copyright text correct?
# If so, remove it...
- if ( ! ($buf =~ s/$copyright_parrot//m) ) {
+ if ( ! ($buf =~ s/$copyright_parrot//) ) {
push @bad_format_copyright_files, $path;
}
# ... and then see if any other copyright notices exist.
@@ -96,9 +96,6 @@
$suggested_version
);
-TODO:
-{
- local $TODO = "Waiting for full transition to Parrot Foundation";
ok( !scalar(@bad_format_copyright_files), 'Copyright statement in the right format' )
or diag(
join
@@ -109,7 +106,6 @@
"Please update to read something like:",
$suggested_version
);
-}
# Certain files contain the string 'Copyright (c)' more than once
# because they contain heredocs for generated files, correctly cite the
@@ -162,18 +158,18 @@
TODO: {
local $TODO = 'duplicate copyrights exist.';
-ok( !scalar(@non_permitted_duplicate_copyright_files),
- 'Duplicate Copyright statements' )
- or diag(
- join
- $/ => "Duplicate copyright statement found in "
- . scalar @non_permitted_duplicate_copyright_files
- . " files:",
- @non_permitted_duplicate_copyright_files,
- "Please get copyright assigned to Parrot Foundation",
- "and remove alternate notice; or remove duplicated",
- "notice for Parrot Foundation."
- );
+ ok( !scalar(@non_permitted_duplicate_copyright_files),
+ 'Duplicate Copyright statements' )
+ or diag(
+ join
+ $/ => "Duplicate copyright statement found in "
+ . scalar @non_permitted_duplicate_copyright_files
+ . " files:",
+ @non_permitted_duplicate_copyright_files,
+ "Please get copyright assigned to Parrot Foundation",
+ "and remove alternate notice; or remove duplicated",
+ "notice for Parrot Foundation."
+ );
}
# Local Variables:
Modified: branches/pmc_pct/t/compilers/imcc/syn/regressions.t
==============================================================================
--- branches/pmc_pct/t/compilers/imcc/syn/regressions.t Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/t/compilers/imcc/syn/regressions.t Thu Jun 4 02:32:48 2009 (r39377)
@@ -177,14 +177,19 @@
}
-pir_error_output_like( <<'CODE', <<'OUT', 'die in immediate, TT#629');
+TODO: {
+ local $TODO = 'Broken with CGP'
+ if $ENV{TEST_PROG_ARGS} =~ /--run-pbc/;
+
+pir_error_output_like( <<'CODE', <<'OUT', 'die in immediate, TT #629');
.sub 'foo' :immediate
die 'no'
.end
CODE
-/no\ncurrent inst.*:2\)$/
+/no\ncurrent inst.*:[\d-]+\)$/
OUT
+}
# Local Variables:
# mode: cperl
# cperl-indent-level: 4
Modified: branches/pmc_pct/t/compilers/json/from_parrot.t
==============================================================================
--- branches/pmc_pct/t/compilers/json/from_parrot.t Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/t/compilers/json/from_parrot.t Thu Jun 4 02:32:48 2009 (r39377)
@@ -30,10 +30,10 @@
.local string s
s = ''
+ load_bytecode 'JSON.pbc'
$S0 = _json( s, 0 )
say $S0
.end
-.include 'library/JSON.pir'
CODE
""
OUT
@@ -45,10 +45,10 @@
.local string s
s = 'abcdeABCDE01234$%^&*'
+ load_bytecode 'JSON.pbc'
$S0 = _json( s, 0 )
say $S0
.end
-.include 'library/JSON.pir'
CODE
"abcdeABCDE01234$%^&*"
OUT
@@ -60,10 +60,10 @@
.local string s
s = "abcde\\ABCDE\"01234\n$%^&*"
# XXX more escapes need to be tested; see http://www.json.org/
+ load_bytecode 'JSON.pbc'
$S0 = _json( s, 0 )
say $S0
.end
-.include 'library/JSON.pir'
CODE
"abcde\\ABCDE\"01234\n$%^&*"
OUT
@@ -74,6 +74,7 @@
.sub test :main
.local int i
i = 0
+ load_bytecode 'JSON.pbc'
$S0 = _json( i, 0 )
say $S0
i = 35
@@ -89,7 +90,6 @@
$S0 = _json( i, 0 )
say $S0
.end
-.include 'library/JSON.pir'
CODE
0
35
@@ -104,6 +104,7 @@
.sub test :main
.local num n
n = 0.0
+ load_bytecode 'JSON.pbc'
$S0 = _json( n )
say $S0
n = 2.50
@@ -116,7 +117,6 @@
$S0 = _json( n )
say $S0
.end
-.include 'library/JSON.pir'
CODE
0
2.5
@@ -130,6 +130,7 @@
.sub test :main
.local string s
s = "abcde\\ABCDE\"01234\n$%^&*"
+ load_bytecode 'JSON.pbc'
$S0 = _json( s, 1 )
print $S0
@@ -143,7 +144,6 @@
$S0 = _json( n, 1 )
print $S0
.end
-.include 'library/JSON.pir'
CODE
"abcde\\ABCDE\"01234\n$%^&*"
-42
@@ -169,10 +169,10 @@
array[8] = 8
array[9] = 9
+ load_bytecode 'JSON.pbc'
$S0 = _json( array, 0 )
say $S0
.end
-.include 'library/JSON.pir'
CODE
[0,1,2,3,4,5,6,7,8,9]
OUT
@@ -196,10 +196,10 @@
array[8] = 8
array[9] = 9
+ load_bytecode 'JSON.pbc'
$S0 = _json( array, 1 )
print $S0
.end
-.include 'library/JSON.pir'
CODE
[
0,
@@ -230,10 +230,10 @@
array[4] = -2147483648
array[5] = 2147483647
+ load_bytecode 'JSON.pbc'
$S0 = _json( array, 1 )
print $S0
.end
-.include 'library/JSON.pir'
CODE
[
35,
@@ -260,10 +260,10 @@
array[4] = "json"
array[5] = 0.0
+ load_bytecode 'JSON.pbc'
$S0 = _json( array, 1 )
print $S0
.end
-.include 'library/JSON.pir'
CODE
[
0,
@@ -287,10 +287,10 @@
hash["gamma"] = 3.1
hash["delta"] = "DELTA"
+ load_bytecode 'JSON.pbc'
$S0 = _json( hash, 1 )
print $S0
.end
-.include 'library/JSON.pir'
CODE
{
"alpha" : 29,
@@ -312,10 +312,10 @@
hash["gamma"] = 3.1
hash["delta"] = "DELTA"
+ load_bytecode 'JSON.pbc'
$S0 = _json( hash, 0 )
say $S0
.end
-.include 'library/JSON.pir'
CODE
{"alpha":29,"beta":"B","delta":"DELTA","gamma":3.1}
OUT
@@ -349,10 +349,10 @@
world["population"] = 1234567890
world["some_country"] = country
+ load_bytecode 'JSON.pbc'
$S0 = _json( world, 1 )
print $S0
.end
-.include 'library/JSON.pir'
CODE
{
"population" : 1234567890,
@@ -400,10 +400,10 @@
world["population"] = 1234567890
world["some_country"] = country
+ load_bytecode 'JSON.pbc'
$S0 = _json( world, 0 )
say $S0
.end
-.include 'library/JSON.pir'
CODE
{"population":1234567890,"some_country":[[{"Perl":"Highway","Python":"Grove","Ruby":"Lane"},{}],[]]}
OUT
@@ -416,6 +416,7 @@
s = new 'String'
s = ''
+ load_bytecode 'JSON.pbc'
$S0 = _json( s, 0 )
say $S0
$S0 = _json( s, 1 )
@@ -428,7 +429,6 @@
$S0 = _json( s, 1 )
print $S0
.end
-.include 'library/JSON.pir'
CODE
""
""
@@ -444,6 +444,7 @@
i = new 'Integer'
i = 0
+ load_bytecode 'JSON.pbc'
$S0 = _json( i, 0 )
say $S0
$S0 = _json( i, 1 )
@@ -456,7 +457,6 @@
$S0 = _json( i, 1 )
print $S0
.end
-.include 'library/JSON.pir'
CODE
0
0
@@ -472,6 +472,7 @@
b = new 'Boolean'
b = 0
+ load_bytecode 'JSON.pbc'
$S0 = _json( b, 0 )
say $S0
$S0 = _json( b, 1 )
@@ -484,7 +485,6 @@
$S0 = _json( b, 1 )
print $S0
.end
-.include 'library/JSON.pir'
CODE
false
false
@@ -499,6 +499,7 @@
.local pmc n
null n
+ load_bytecode 'JSON.pbc'
$S0 = _json( n, 0 )
say $S0
$S0 = _json( n, 1 )
@@ -510,7 +511,6 @@
$S0 = _json( n, 1 )
print $S0
.end
-.include 'library/JSON.pir'
CODE
null
null
Modified: branches/pmc_pct/t/compilers/pge/pge_examples.t
==============================================================================
--- branches/pmc_pct/t/compilers/pge/pge_examples.t Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/t/compilers/pge/pge_examples.t Thu Jun 4 02:32:48 2009 (r39377)
@@ -52,7 +52,8 @@
OUT
# 2
-pir_output_is( <<'CODE', <<'OUT', "parse FASTA" );
+my @todo = (($^O =~ /darwin/i) ? (todo => 'Darwin segfault -- TT #479') : ());
+pir_output_is( <<'CODE', <<'OUT', "parse FASTA", @todo );
# Grok fasta files, which usually contain DNA, RNA or protein sequences.
# http://en.wikipedia.org/wiki/FASTA_format
Modified: branches/pmc_pct/t/examples/pod.t
==============================================================================
--- branches/pmc_pct/t/examples/pod.t Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/t/examples/pod.t Thu Jun 4 02:32:48 2009 (r39377)
@@ -161,7 +161,7 @@
=end PIR_FRAGMENT_INVALID
-As show, you can "stack" the modifiers. Take care to make the begin and
+As shown, you can "stack" the modifiers. Take care to make the begin and
and end POD targets identical. Always begin with the target language.
=cut
Modified: branches/pmc_pct/t/examples/streams.t
==============================================================================
--- branches/pmc_pct/t/examples/streams.t Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/t/examples/streams.t Thu Jun 4 02:32:48 2009 (r39377)
@@ -160,26 +160,26 @@
read:[ 38 name = argv[1]]
read:[ 39 NO_NAME:]
read:[ 40 ]
-read:[ 41 load_bytecode \"library/Stream/ParrotIO.pir\"]
-read:[ 42 load_bytecode \"library/Stream/Lines.pir\"]
-read:[ 43 load_bytecode \"library/Stream/Sub.pir\"]
-read:[ 44 load_bytecode \"library/Stream/Combiner.pir\"]
+read:[ 41 load_bytecode 'Stream/ParrotIO.pbc']
+read:[ 42 load_bytecode 'Stream/Lines.pbc']
+read:[ 43 load_bytecode 'Stream/Sub.pbc']
+read:[ 44 load_bytecode 'Stream/Combiner.pbc']
read:[ 45 ]
read:[ 46 # create a file stream]
-read:[ 47 file = new \"Stream::ParrotIO\"]
+read:[ 47 file = new ['Stream'; 'ParrotIO']]
read:[ 48 file.\"open\"( name, 'r' )]
read:[ 49 ]
read:[ 50 # process it one line per read]
-read:[ 51 lines = new \"Stream::Lines\"]
+read:[ 51 lines = new ['Stream'; 'Lines']]
read:[ 52 assign lines, file]
read:[ 53 ]
read:[ 54 # endless counter]
-read:[ 55 counter = new \"Stream::Sub\"]
+read:[ 55 counter = new ['Stream'; 'Sub']]
read:[ 56 .const 'Sub' temp = \"_counter\"]
read:[ 57 assign counter, temp]
read:[ 58 ]
read:[ 59 # combine the counter and the file's lines]
-read:[ 60 combiner = new \"Stream::Combiner\"]
+read:[ 60 combiner = new ['Stream'; 'Combiner']]
read:[ 61 assign combiner, counter]
read:[ 62 assign combiner, lines]
read:[ 63 ]
@@ -223,7 +223,7 @@
read:[ 101 ]
read:[ 102 =head1 COPYRIGHT]
read:[ 103 ]
-read:[ 104 Copyright (C) 2004-2008, Parrot Foundation.]
+read:[ 104 Copyright (C) 2004-2009, Parrot Foundation.]
read:[ 105 ]
read:[ 106 =cut]
read:[ 107 ]
@@ -247,20 +247,20 @@
read:[ng the C<open> method, you can also assign your ow]
read:[n ParrotIO\nPMC to the stream with the C<assign> op]
read:[.\n\n=cut\n\n.sub _main :main\n .local pmc stream\n\n ]
-read:[ load_bytecode \"library/Stream/ParrotIO.pir\"\n\n ]
-read:[ # create the ParrotIO stream\n stream = new \"S]
-read:[tream::ParrotIO\"\n\n # open this file\n stream.]
-read:[\"open\"( \"examples/streams/ParrotIO.pir\", 'r' )\n\n ]
-read:[ # you can specify a custom block size with\n #]
-read:[ stream.\"blockSize\"( 10 )\n\n # dump the stream\n ]
-read:[ stream.\"dump\"()\n\n end\n.end\n\n=head1 AUTHOR\n\nJ]
-read:[ens Rieks E<lt>parrot at jensbeimsurfen dot deE<gt]
-read:[> is the author\nand maintainer.\nPlease send patche]
-read:[s and suggestions to the Perl 6 Internals mailing ]
-read:[list.\n\n=head1 COPYRIGHT\n\nCopyright (C) 2004-2008, ]
-read:[Parrot Foundation.\n\n=cut\n\n# Local Variables:\n# m]
-read:[ode: pir\n# fill-column: 100\n# End:\n# vim: expand]
-read:[tab shiftwidth=4 ft=pir:\n]
+read:[ load_bytecode 'Stream/ParrotIO.pbc'\n\n # crea]
+read:[te the ParrotIO stream\n stream = new ['Stream';]
+read:[ 'ParrotIO']\n\n # open this file\n stream.\"ope]
+read:[n\"( \"examples/streams/ParrotIO.pir\", 'r' )\n\n # ]
+read:[you can specify a custom block size with\n # str]
+read:[eam.\"blockSize\"( 10 )\n\n # dump the stream\n s]
+read:[tream.\"dump\"()\n\n end\n.end\n\n=head1 AUTHOR\n\nJens ]
+read:[Rieks E<lt>parrot at jensbeimsurfen dot deE<gt> is]
+read:[ the author\nand maintainer.\nPlease send patches an]
+read:[d suggestions to the Perl 6 Internals mailing list]
+read:[.\n\n=head1 COPYRIGHT\n\nCopyright (C) 2004-2009, Parr]
+read:[ot Foundation.\n\n=cut\n\n# Local Variables:\n# mode:]
+read:[ pir\n# fill-column: 100\n# End:\n# vim: expandtab ]
+read:[shiftwidth=4 ft=pir:\n]
EXP_PARROTIO
},
);
Modified: branches/pmc_pct/t/library/pcre.t
==============================================================================
--- branches/pmc_pct/t/library/pcre.t Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/t/library/pcre.t Thu Jun 4 02:32:48 2009 (r39377)
@@ -1,10 +1,11 @@
#!perl
-# Copyright (C) 2001-2005, Parrot Foundation.
+# Copyright (C) 2001-2009, Parrot Foundation.
# $Id$
use strict;
use warnings;
use lib qw( t . lib ../lib ../../lib );
+
use Test::More;
use Parrot::Test tests => 1;
@@ -26,22 +27,22 @@
# if we keep pcre, we need a config test
my $cmd = ( $^O =~ /MSWin32/ ) ? "pcregrep --version" : "pcre-config --version";
my $has_pcre = !Parrot::Test::run_command( $cmd, STDERR => File::Spec->devnull, );
-my $pcre_libpath = "";
+my $pcre_libpath = '';
# It's possible that libpcre is installed in some non-standard path...
if ($has_pcre && ($^O !~ /MSWin32/)) {
# Extract the library path for non-windows platforms (in case it isn't in
# the normal lookup locations)
- my $outfile = "pcre-config.out";
- Parrot::Test::run_command("pcre-config --prefix", STDOUT => $outfile);
+ my $outfile = 'pcre-config.out';
+ Parrot::Test::run_command('pcre-config --prefix', STDOUT => $outfile);
my $out = Parrot::Test::slurp_file($outfile);
unlink $outfile;
chomp $out;
- $pcre_libpath="$out/lib";
+ $pcre_libpath = "$out/lib";
}
SKIP: {
- skip( "no pcre-config", Test::Builder->new()->expected_tests() )
+ skip( 'no pcre-config', Test::Builder->new()->expected_tests() )
unless $has_pcre;
## 1
@@ -65,22 +66,21 @@
.local pmc func
.local pmc lib
-
get_global func, ['PCRE'], 'init'
if_null func, NOK1
branch OK1
NOK1:
print 'not '
OK1:
- say "ok 1"
+ say 'ok 1'
- lib= func()
+ lib = func()
if_null lib, NOK2
branch OK2
NOK2:
print 'not '
OK2:
- say "ok 2"
+ say 'ok 2'
.local string s
@@ -101,7 +101,7 @@
if is_code_defined goto OK3
print 'not '
OK3:
- say "ok 3"
+ say 'ok 3'
.local int ok
.local pmc result
@@ -112,18 +112,18 @@
unless ok < 0 goto OK4
print 'not '
OK4:
- say "ok 4"
+ say 'ok 4'
.local int i
- i= 0
+ i = 0
.local string match
- func= get_global ['PCRE'], 'dollar'
- match= func( s, ok, result, i )
+ func = get_global ['PCRE'], 'dollar'
+ match = func( s, ok, result, i )
if 'a' == match goto OK5
print 'not '
OK5:
- say "ok 5"
+ say 'ok 5'
.end
CODE
Modified: branches/pmc_pct/t/manifest/01-basic.t
==============================================================================
--- branches/pmc_pct/t/manifest/01-basic.t Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/t/manifest/01-basic.t Thu Jun 4 02:32:48 2009 (r39377)
@@ -6,57 +6,62 @@
use strict;
use warnings;
-use Test::More;
-plan( skip_all => "\nRelevant only when working in checkout from repository" )
- unless (-e 'DEVELOPING');
-plan( tests => 13 );
+use Test::More tests => 13;
use Carp;
use Cwd;
use File::Temp qw( tempdir );
use lib (qw| lib |);
-use_ok('Parrot::Manifest');
-my $script = $0;
-my $file = q{MANIFEST};
-my $skip = q{MANIFEST.SKIP};
-
-my $mani = Parrot::Manifest->new( { script => $script, } );
-isa_ok( $mani, 'Parrot::Manifest' );
-
-ok( scalar( @{ $mani->{dirs} } ),
- "Parrot::Manifest constructor used 'status' command to find at least 1 directory." );
-ok( scalar( @{ $mani->{versioned_files} } ),
- "Parrot::Manifest constructor used 'status' command to find at least 1 versioned file." );
-
-my $manifest_lines_ref = $mani->prepare_manifest();
-is( ref($manifest_lines_ref), q{HASH}, "prepare_manifest() returned hash ref" );
-
-my $cwd = cwd();
-{
- my $tdir = tempdir( CLEANUP => 1 );
- chdir $tdir
- or croak "Unable to change to temporary directory for testing";
- ok( !-f $file, "No $file yet in this directory" );
- $mani->print_manifest($manifest_lines_ref);
- ok( -f $file, "$file has been created in this directory" );
- chdir $cwd
- or croak "Unable to change back from temporary directory after testing";
-}
-
-my $print_str = $mani->prepare_manifest_skip();
-ok( $print_str, "prepare_manifest_skip() returned" );
-
-{
- my $tdir = tempdir( CLEANUP => 1 );
- chdir $tdir
- or croak "Unable to change to temporary directory for testing";
- ok( !-f $skip, "No $skip yet in tempdir" );
- my $need_for_skip = $mani->determine_need_for_manifest_skip($print_str);
- ok( $need_for_skip, "No $skip in tempdir; it must be regenerated" );
- ok( $mani->print_manifest_skip($print_str), "print_manifest_skip() returned true" );
- ok( -f $skip, "$skip has been created in tempdir" );
- chdir $cwd
- or croak "Unable to change back from temporary directory after testing";
+SKIP: {
+ skip
+ q{Relevant only when working in checkout from repository},
+ 12
+ unless (-e 'DEVELOPING');
+
+ use_ok('Parrot::Manifest');
+
+ my $script = $0;
+ my $file = q{MANIFEST};
+ my $skip = q{MANIFEST.SKIP};
+
+ my $mani = Parrot::Manifest->new( { script => $script, } );
+ isa_ok( $mani, 'Parrot::Manifest' );
+
+ ok( scalar( @{ $mani->{dirs} } ),
+ "Parrot::Manifest constructor used 'status' command to find at least 1 directory." );
+ ok( scalar( @{ $mani->{versioned_files} } ),
+ "Parrot::Manifest constructor used 'status' command to find at least 1 versioned file." );
+
+ my $manifest_lines_ref = $mani->prepare_manifest();
+ is( ref($manifest_lines_ref), q{HASH}, "prepare_manifest() returned hash ref" );
+
+ my $cwd = cwd();
+ {
+ my $tdir = tempdir( CLEANUP => 1 );
+ chdir $tdir
+ or croak "Unable to change to temporary directory for testing";
+ ok( !-f $file, "No $file yet in this directory" );
+ $mani->print_manifest($manifest_lines_ref);
+ ok( -f $file, "$file has been created in this directory" );
+ chdir $cwd
+ or croak "Unable to change back from temporary directory after testing";
+ }
+
+ my $print_str = $mani->prepare_manifest_skip();
+ ok( $print_str, "prepare_manifest_skip() returned" );
+
+ {
+ my $tdir = tempdir( CLEANUP => 1 );
+ chdir $tdir
+ or croak "Unable to change to temporary directory for testing";
+ ok( !-f $skip, "No $skip yet in tempdir" );
+ my $need_for_skip = $mani->determine_need_for_manifest_skip($print_str);
+ ok( $need_for_skip, "No $skip in tempdir; it must be regenerated" );
+ ok( $mani->print_manifest_skip($print_str), "print_manifest_skip() returned true" );
+ ok( -f $skip, "$skip has been created in tempdir" );
+ chdir $cwd
+ or croak "Unable to change back from temporary directory after testing";
+ }
}
pass("Completed all tests in $0");
Modified: branches/pmc_pct/t/manifest/02-regenerate_file.t
==============================================================================
--- branches/pmc_pct/t/manifest/02-regenerate_file.t Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/t/manifest/02-regenerate_file.t Thu Jun 4 02:32:48 2009 (r39377)
@@ -6,89 +6,94 @@
use strict;
use warnings;
-use Test::More;
-plan( skip_all => "\nRelevant only when working in checkout from repository" )
- unless (-e 'DEVELOPING');
-plan( tests => 12 );
+use Test::More tests => 12;
use Carp;
use Cwd;
use File::Copy;
use File::Temp qw( tempdir );
use Tie::File;
use lib (qw| lib |);
-use_ok('Parrot::Manifest');
-my $script = $0;
-my $mani = Parrot::Manifest->new( { script => $script, } );
-isa_ok( $mani, 'Parrot::Manifest' );
-
-my $cwd = cwd();
-my $f = q{MANIFEST};
-
-my $manifest_lines_ref = $mani->prepare_manifest();
-ok( $manifest_lines_ref, "prepare_manifest_skip() returned" );
-
-# 1: Copy the real MANIFEST unaltered to the tempdir.
-# Assuming the real MANIFEST was correct going in to this test, the
-# absence of any change in it will mean that there will be no need to
-# regenerate it.
-{
- my $tdir = tempdir( CLEANUP => 1 );
- chdir $tdir
- or croak "Unable to change to temporary directory for testing";
- copy( qq{$cwd/$f}, qq{$tdir/$f} )
- or croak "Unable to copy $f to tempdir";
- ok( -f $f, "$f found in tempdir" );
- my $need_for_file = $mani->determine_need_for_manifest($manifest_lines_ref);
- ok( !$need_for_file, "No need to regenerate $f" );
- chdir $cwd
- or croak "Unable to change back from temporary directory after testing";
- unlink qq{$tdir/$f} or croak "Unable to delete file from tempdir";
-}
-
-# 2: Copy the real MANIFEST to the tempdir but mangle it there.
-# The alteration in the copied MANIFEST will be sufficient to require
-# regeneration of MANIFEST. And for good measure, toss in a line of all
-# whitespace to demonstrate that it is correctly skipped.
-{
- my $tdir = tempdir( CLEANUP => 1 );
- chdir $tdir
- or croak "Unable to change to temporary directory for testing";
- copy( qq{$cwd/$f}, qq{$tdir/$f} )
- or croak "Unable to copy $f to tempdir";
- ok( -f $f, "$f found in tempdir" );
- my @lines;
- tie @lines, 'Tie::File', qq{$tdir/$f}
- or croak "Unable to tie to $f in tempdir";
-
- for ( 1 .. 10 ) {
- if ( defined( $lines[-1] ) ) {
- pop @lines;
+SKIP: {
+ skip
+ q{Relevant only when working in checkout from repository},
+ 11
+ unless (-e 'DEVELOPING');
+
+ use_ok('Parrot::Manifest');
+
+ my $script = $0;
+ my $mani = Parrot::Manifest->new( { script => $script, } );
+ isa_ok( $mani, 'Parrot::Manifest' );
+
+ my $cwd = cwd();
+ my $f = q{MANIFEST};
+
+ my $manifest_lines_ref = $mani->prepare_manifest();
+ ok( $manifest_lines_ref, "prepare_manifest_skip() returned" );
+
+ # 1: Copy the real MANIFEST unaltered to the tempdir.
+ # Assuming the real MANIFEST was correct going in to this test, the
+ # absence of any change in it will mean that there will be no need to
+ # regenerate it.
+ {
+ my $tdir = tempdir( CLEANUP => 1 );
+ chdir $tdir
+ or croak "Unable to change to temporary directory for testing";
+ copy( qq{$cwd/$f}, qq{$tdir/$f} )
+ or croak "Unable to copy $f to tempdir";
+ ok( -f $f, "$f found in tempdir" );
+ my $need_for_file = $mani->determine_need_for_manifest($manifest_lines_ref);
+ ok( !$need_for_file, "No need to regenerate $f" );
+ chdir $cwd
+ or croak "Unable to change back from temporary directory after testing";
+ unlink qq{$tdir/$f} or croak "Unable to delete file from tempdir";
+ }
+
+ # 2: Copy the real MANIFEST to the tempdir but mangle it there.
+ # The alteration in the copied MANIFEST will be sufficient to require
+ # regeneration of MANIFEST. And for good measure, toss in a line of all
+ # whitespace to demonstrate that it is correctly skipped.
+ {
+ my $tdir = tempdir( CLEANUP => 1 );
+ chdir $tdir
+ or croak "Unable to change to temporary directory for testing";
+ copy( qq{$cwd/$f}, qq{$tdir/$f} )
+ or croak "Unable to copy $f to tempdir";
+ ok( -f $f, "$f found in tempdir" );
+ my @lines;
+ tie @lines, 'Tie::File', qq{$tdir/$f}
+ or croak "Unable to tie to $f in tempdir";
+
+ for ( 1 .. 10 ) {
+ if ( defined( $lines[-1] ) ) {
+ pop @lines;
+ }
}
+ push @lines, q{ };
+ push @lines, q{};
+ untie @lines or croak "Unable to untie from $f";
+ my $need_for_file = $mani->determine_need_for_manifest($manifest_lines_ref);
+ ok( $need_for_file, "Need to regenerate $f" );
+ ok( $mani->print_manifest($manifest_lines_ref), "print_manifest() returned true" );
+ ok( -f $f, "$f has been created in tempdir" );
+ unlink qq{$tdir/$f} or croak "Unable to delete file from tempdir";
+ chdir $cwd
+ or croak "Unable to change back from temporary directory after testing";
+ }
+
+ # 3: Go to a tempdir which lacks a MANIFEST. Confirm that you need to
+ # regenerate MANIFEST (but do not bother to actually do it there).
+ {
+ my $tdir = tempdir( CLEANUP => 1 );
+ chdir $tdir
+ or croak "Unable to change to temporary directory for testing";
+ ok( !-f $f, "$f found in tempdir" );
+ my $need_for_file = $mani->determine_need_for_manifest($manifest_lines_ref);
+ ok( $need_for_file, "We would need to regenerate $f" );
+ chdir $cwd
+ or croak "Unable to change back from temporary directory after testing";
}
- push @lines, q{ };
- push @lines, q{};
- untie @lines or croak "Unable to untie from $f";
- my $need_for_file = $mani->determine_need_for_manifest($manifest_lines_ref);
- ok( $need_for_file, "Need to regenerate $f" );
- ok( $mani->print_manifest($manifest_lines_ref), "print_manifest() returned true" );
- ok( -f $f, "$f has been created in tempdir" );
- unlink qq{$tdir/$f} or croak "Unable to delete file from tempdir";
- chdir $cwd
- or croak "Unable to change back from temporary directory after testing";
-}
-
-# 3: Go to a tempdir which lacks a MANIFEST. Confirm that you need to
-# regenerate MANIFEST (but do not bother to actually do it there).
-{
- my $tdir = tempdir( CLEANUP => 1 );
- chdir $tdir
- or croak "Unable to change to temporary directory for testing";
- ok( !-f $f, "$f found in tempdir" );
- my $need_for_file = $mani->determine_need_for_manifest($manifest_lines_ref);
- ok( $need_for_file, "We would need to regenerate $f" );
- chdir $cwd
- or croak "Unable to change back from temporary directory after testing";
}
pass("Completed all tests in $0");
Modified: branches/pmc_pct/t/manifest/03-regenerate_skip.t
==============================================================================
--- branches/pmc_pct/t/manifest/03-regenerate_skip.t Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/t/manifest/03-regenerate_skip.t Thu Jun 4 02:32:48 2009 (r39377)
@@ -6,72 +6,77 @@
use strict;
use warnings;
-use Test::More;
-plan( skip_all => "\nRelevant only when working in checkout from repository" )
- unless (-e 'DEVELOPING');
-plan( tests => 10 );
+use Test::More tests => 10;
use Carp;
use Cwd;
use File::Copy;
use File::Temp qw( tempdir );
use Tie::File;
use lib (qw| lib |);
-use_ok('Parrot::Manifest');
-my $script = $0;
-my $mani = Parrot::Manifest->new( { script => $script, } );
-isa_ok( $mani, 'Parrot::Manifest' );
-
-my $cwd = cwd();
-my $sk = q{MANIFEST.SKIP};
-my $print_str = $mani->prepare_manifest_skip();
-ok( $print_str, "prepare_manifest_skip() returned" );
-
-# 1: Copy the real MANIFEST.SKIP unaltered to the tempdir.
-# Assuming the real MANIFEST.SKIP was correct going in to this test, the
-# absence of any change in it will mean that there will be no need to
-# regenerate it.
-{
- my $tdir = tempdir( CLEANUP => 1 );
- chdir $tdir
- or croak "Unable to change to temporary directory for testing";
- copy( qq{$cwd/$sk}, qq{$tdir/$sk} )
- or croak "Unable to copy $sk to tempdir";
- ok( -f $sk, "$sk found in tempdir" );
- my $need_for_skip = $mani->determine_need_for_manifest_skip($print_str);
- ok( !$need_for_skip, "No need to regenerate $sk" );
- unlink qq{$tdir/$sk} or croak "Unable to delete file from tempdir";
- chdir $cwd
- or croak "Unable to change back from temporary directory after testing";
-}
-
-# 2: Copy the real MANIFEST.SKIP to the tempdir but mangle it there.
-# The alteration in the copied MANIFEST.SKIP will be sufficient to require
-# regeneration of MANIFEST.SKIP.
-{
- my $tdir = tempdir( CLEANUP => 1 );
- chdir $tdir
- or croak "Unable to change to temporary directory for testing";
- copy( qq{$cwd/$sk}, qq{$tdir/$sk} )
- or croak "Unable to copy $sk to tempdir";
- ok( -f $sk, "$sk found in tempdir" );
- my @lines;
- tie @lines, 'Tie::File', qq{$tdir/$sk}
- or croak "Unable to tie to $sk in tempdir";
-
- for ( 1 .. 10 ) {
- if ( defined( $lines[-1] ) ) {
- pop @lines;
+SKIP: {
+ skip
+ q{Relevant only when working in checkout from repository},
+ 9
+ unless (-e 'DEVELOPING');
+
+ use_ok('Parrot::Manifest');
+
+ my $script = $0;
+ my $mani = Parrot::Manifest->new( { script => $script, } );
+ isa_ok( $mani, 'Parrot::Manifest' );
+
+ my $cwd = cwd();
+ my $sk = q{MANIFEST.SKIP};
+ my $print_str = $mani->prepare_manifest_skip();
+ ok( $print_str, "prepare_manifest_skip() returned" );
+
+ # 1: Copy the real MANIFEST.SKIP unaltered to the tempdir.
+ # Assuming the real MANIFEST.SKIP was correct going in to this test, the
+ # absence of any change in it will mean that there will be no need to
+ # regenerate it.
+ {
+ my $tdir = tempdir( CLEANUP => 1 );
+ chdir $tdir
+ or croak "Unable to change to temporary directory for testing";
+ copy( qq{$cwd/$sk}, qq{$tdir/$sk} )
+ or croak "Unable to copy $sk to tempdir";
+ ok( -f $sk, "$sk found in tempdir" );
+ my $need_for_skip = $mani->determine_need_for_manifest_skip($print_str);
+ ok( !$need_for_skip, "No need to regenerate $sk" );
+ unlink qq{$tdir/$sk} or croak "Unable to delete file from tempdir";
+ chdir $cwd
+ or croak "Unable to change back from temporary directory after testing";
+ }
+
+ # 2: Copy the real MANIFEST.SKIP to the tempdir but mangle it there.
+ # The alteration in the copied MANIFEST.SKIP will be sufficient to require
+ # regeneration of MANIFEST.SKIP.
+ {
+ my $tdir = tempdir( CLEANUP => 1 );
+ chdir $tdir
+ or croak "Unable to change to temporary directory for testing";
+ copy( qq{$cwd/$sk}, qq{$tdir/$sk} )
+ or croak "Unable to copy $sk to tempdir";
+ ok( -f $sk, "$sk found in tempdir" );
+ my @lines;
+ tie @lines, 'Tie::File', qq{$tdir/$sk}
+ or croak "Unable to tie to $sk in tempdir";
+
+ for ( 1 .. 10 ) {
+ if ( defined( $lines[-1] ) ) {
+ pop @lines;
+ }
}
+ untie @lines or croak "Unable to untie from $sk";
+ my $need_for_skip = $mani->determine_need_for_manifest_skip($print_str);
+ ok( $need_for_skip, "Need to regenerate $sk" );
+ ok( $mani->print_manifest_skip($print_str), "print_manifest_skip() returned true" );
+ ok( -f $sk, "$sk has been created in tempdir" );
+ unlink qq{$tdir/$sk} or croak "Unable to delete file from tempdir";
+ chdir $cwd
+ or croak "Unable to change back from temporary directory after testing";
}
- untie @lines or croak "Unable to untie from $sk";
- my $need_for_skip = $mani->determine_need_for_manifest_skip($print_str);
- ok( $need_for_skip, "Need to regenerate $sk" );
- ok( $mani->print_manifest_skip($print_str), "print_manifest_skip() returned true" );
- ok( -f $sk, "$sk has been created in tempdir" );
- unlink qq{$tdir/$sk} or croak "Unable to delete file from tempdir";
- chdir $cwd
- or croak "Unable to change back from temporary directory after testing";
}
pass("Completed all tests in $0");
Modified: branches/pmc_pct/t/manifest/04-alt_file.t
==============================================================================
--- branches/pmc_pct/t/manifest/04-alt_file.t Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/t/manifest/04-alt_file.t Thu Jun 4 02:32:48 2009 (r39377)
@@ -6,31 +6,36 @@
use strict;
use warnings;
-use Test::More;
-plan( skip_all => "\nRelevant only when working in checkout from repository" )
- unless (-e 'DEVELOPING');
-plan( tests => 6 );
+use Test::More tests => 6;
use Carp;
use lib (qw| lib |);
-use_ok('Parrot::Manifest');
-my $script = $0;
-my $g = q{something_other_than_MANIFEST};
-
-my $mani = Parrot::Manifest->new(
- {
- script => $script,
- file => $g,
- }
-);
-isa_ok( $mani, 'Parrot::Manifest' );
-
-my $manifest_lines_ref = $mani->prepare_manifest();
-ok( $manifest_lines_ref, "prepare_manifest_skip() returned" );
-
-ok( !-f $g, "No $g found" );
-my $need_for_file = $mani->determine_need_for_manifest($manifest_lines_ref);
-ok( $need_for_file, "Need to regenerate $g" );
+SKIP: {
+ skip
+ q{Relevant only when working in checkout from repository},
+ 5
+ unless (-e 'DEVELOPING');
+
+ use_ok('Parrot::Manifest');
+
+ my $script = $0;
+ my $g = q{something_other_than_MANIFEST};
+
+ my $mani = Parrot::Manifest->new(
+ {
+ script => $script,
+ file => $g,
+ }
+ );
+ isa_ok( $mani, 'Parrot::Manifest' );
+
+ my $manifest_lines_ref = $mani->prepare_manifest();
+ ok( $manifest_lines_ref, "prepare_manifest_skip() returned" );
+
+ ok( !-f $g, "No $g found" );
+ my $need_for_file = $mani->determine_need_for_manifest($manifest_lines_ref);
+ ok( $need_for_file, "Need to regenerate $g" );
+}
pass("Completed all tests in $0");
Modified: branches/pmc_pct/t/manifest/05-alt_skip.t
==============================================================================
--- branches/pmc_pct/t/manifest/05-alt_skip.t Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/t/manifest/05-alt_skip.t Thu Jun 4 02:32:48 2009 (r39377)
@@ -6,31 +6,36 @@
use strict;
use warnings;
-use Test::More;
-plan( skip_all => "\nRelevant only when working in checkout from repository" )
- unless (-e 'DEVELOPING');
-plan( tests => 6 );
+use Test::More tests => 6;
use Carp;
use lib (qw| lib |);
-use_ok('Parrot::Manifest');
-my $script = $0;
-my $g = q{something_other_than_MANIFEST.SKIP};
-
-my $mani = Parrot::Manifest->new(
- {
- script => $script,
- skip => $g,
- }
-);
-isa_ok( $mani, 'Parrot::Manifest' );
-
-my $print_str = $mani->prepare_manifest_skip();
-ok( $print_str, "prepare_manifest_skip() returned" );
-
-ok( !-f $g, "No $g found" );
-my $need_for_skip = $mani->determine_need_for_manifest_skip($print_str);
-ok( $need_for_skip, "Need to regenerate $g" );
+SKIP: {
+ skip
+ q{Relevant only when working in checkout from repository},
+ 5
+ unless (-e 'DEVELOPING');
+
+ use_ok('Parrot::Manifest');
+
+ my $script = $0;
+ my $g = q{something_other_than_MANIFEST.SKIP};
+
+ my $mani = Parrot::Manifest->new(
+ {
+ script => $script,
+ skip => $g,
+ }
+ );
+ isa_ok( $mani, 'Parrot::Manifest' );
+
+ my $print_str = $mani->prepare_manifest_skip();
+ ok( $print_str, "prepare_manifest_skip() returned" );
+
+ ok( !-f $g, "No $g found" );
+ my $need_for_skip = $mani->determine_need_for_manifest_skip($print_str);
+ ok( $need_for_skip, "Need to regenerate $g" );
+}
pass("Completed all tests in $0");
Modified: branches/pmc_pct/t/native_pbc/annotations.pbc
==============================================================================
Binary file (source and/or target). No diff available.
Modified: branches/pmc_pct/t/native_pbc/integer_1.pbc
==============================================================================
Binary file (source and/or target). No diff available.
Modified: branches/pmc_pct/t/native_pbc/number_1.pbc
==============================================================================
Binary file (source and/or target). No diff available.
Modified: branches/pmc_pct/t/native_pbc/number_2.pbc
==============================================================================
Binary file (source and/or target). No diff available.
Modified: branches/pmc_pct/t/native_pbc/string_1.pbc
==============================================================================
Binary file (source and/or target). No diff available.
Modified: branches/pmc_pct/t/oo/proxy.t
==============================================================================
--- branches/pmc_pct/t/oo/proxy.t Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/t/oo/proxy.t Thu Jun 4 02:32:48 2009 (r39377)
@@ -19,14 +19,17 @@
.sub main :main
.include 'test_more.pir'
- plan(9)
+ plan(11)
typeof_a_low_level_object()
typeof_a_high_level_object()
typeof_a_class_object()
proxy_as_parent_of_class()
proxy_as_parent_of_class_with_new()
-
+ proxy_no_method_conflict()
+ .local pmc proxy_no_invade
+ proxy_no_invade = get_root_global ['foo'], 'proxy_no_invade'
+ proxy_no_invade()
.end
.sub typeof_a_low_level_object
@@ -81,6 +84,36 @@
is ($S0, 'Foo;Bar', 'object is typeof Foo;Bar')
.end
+.sub proxy_no_method_conflict
+ $P0 = new 'Complex'
+ $P0['real'] = 1
+ $P1 = $P0.'Complex'()
+ $S0 = $P1
+ is($S0, "1+0i", 'Complex method survived')
+.end
+
+.namespace ['Complex']
+.sub 'Complex' :method
+ .return (self)
+.end
+
+.HLL 'foo'
+
+.sub proxy_no_invade
+ .local pmc is
+ is = get_root_global ['parrot'], 'is'
+
+ $P0 = new 'Class'
+ $I0 = isa $P0, 'Sub'
+ $P1 = get_root_global ['foo'], 'Sub'
+ $I1 = 0
+ if null $P1 goto do_test
+ inc $I1
+do_test:
+ is($I1, 0, 'No proxy in current HLL namespace, TT #715')
+.end
+
+
# Local Variables:
# mode: pir
# fill-column: 100
Copied: branches/pmc_pct/t/oo/root_new.t (from r39376, trunk/t/oo/root_new.t)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/pmc_pct/t/oo/root_new.t Thu Jun 4 02:32:48 2009 (r39377, copy of r39376, trunk/t/oo/root_new.t)
@@ -0,0 +1,95 @@
+#! parrot
+# Copyright (C) 2007-2009, Parrot Foundation.
+# $Id$
+
+=head1 NAME
+
+t/oo/root_new.t - Test OO instantiation via root_new
+
+=head1 SYNOPSIS
+
+ % prove t/oo/root_new.t
+
+=head1 DESCRIPTION
+
+Tests OO features related to instantiating new objects
+via the C<root_new> opcode.
+
+=cut
+
+.sub main :main
+ .include 'except_types.pasm'
+ .include 'test_more.pir'
+ plan(6)
+
+ instantiate_from_key_pmc()
+ .const 'Sub' test2 = 'instantiate_from_key_pmc_in_foreign_hll'
+ test2()
+.end
+
+
+#
+# Utility sub
+#
+.sub _test_instance
+ .param pmc obj
+ .param string in_str
+
+ # Set up local variables
+ .local pmc key_pmc
+ .local string class_name
+
+ key_pmc = new 'Key'
+ $P0 = split ' ', in_str
+ $S0 = shift $P0
+ $I1 = 1
+ key_pmc = $S0
+ class_name = $S0
+
+ LOOP:
+ $I0 = elements $P0
+ if $I0 == 0 goto BEGIN_TEST
+ $S1 = shift $P0
+ $P1 = new 'Key'
+ $P1 = $S1
+ push key_pmc, $P1
+ concat class_name, ';'
+ concat class_name, $S1
+ $I1 += 1
+ goto LOOP
+
+ # Start testing
+ BEGIN_TEST:
+ .local string typeof_message
+ typeof_message = concat 'New instance is of type: ', class_name
+ $S1 = typeof obj
+ is($S1, class_name, typeof_message)
+
+ .local string keypmc_message
+ $S2 = get_repr key_pmc
+ keypmc_message = concat 'The object isa ', $S2
+ $I2 = isa obj, key_pmc
+ ok($I2, keypmc_message)
+
+ unless $I1 == 1 goto END_TEST
+ isa_ok(obj, class_name)
+
+ END_TEST:
+ .return()
+.end
+
+
+#############################################################################
+
+.sub instantiate_from_key_pmc
+ $P0 = root_new ['parrot';'Integer']
+ _test_instance($P0, 'Integer')
+.end
+
+
+.HLL 'foreign'
+.sub instantiate_from_key_pmc_in_foreign_hll
+ $P0 = root_new ['parrot';'Integer']
+ _test_instance($P0, 'Integer')
+.end
+
Copied: branches/pmc_pct/t/op/arithmetics_pmc.t (from r39376, trunk/t/op/arithmetics_pmc.t)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/pmc_pct/t/op/arithmetics_pmc.t Thu Jun 4 02:32:48 2009 (r39377, copy of r39376, trunk/t/op/arithmetics_pmc.t)
@@ -0,0 +1,109 @@
+#!perl
+# Copyright (C) 2001-2009, Parrot Foundation.
+# $Id$
+
+use strict;
+use warnings;
+use lib qw( . lib ../lib ../../lib );
+
+use Test::More;
+use Parrot::Test;
+
+# test for GMP
+use Parrot::Config;
+
+=head1 NAME
+
+t/op/arithmetics_pmc.t - Arithmetic Ops involving PMCs
+
+=head1 SYNOPSIS
+
+ % prove t/op/arithmetics_pmc.t
+
+=head1 DESCRIPTION
+
+Test handling C<dest> arg in 3-args arithmetic.
+
+=cut
+
+# We don't check BigInt and BigNum ops
+if ( $PConfig{gmp} ) {
+ plan tests => 68;
+}
+else {
+ plan tests => 34;
+}
+
+
+# Map vtable method to op
+my %methods = qw{
+ add add
+ subtract sub
+ multiply mul
+ divide div
+
+ floor_divide fdiv
+ modulus mod
+ pow pow
+
+ bitwise_or bor
+ bitwise_and band
+ bitwise_xor bxor
+
+ bitwise_shr shr
+ bitwise_shl shl
+ bitwise_lsr lsr
+
+ concatenate concat
+
+ logical_or or
+ logical_and and
+ logical_xor xor
+};
+
+# XXX Put BigInt and BigNum here
+my @pmcs = qw{
+ Integer Float
+};
+
+if ($PConfig{gmp}) {
+ push @pmcs, qw{ BigInt BigNum};
+}
+
+foreach my $pmc (@pmcs) {
+ while(my($vtable, $op) = each(%methods)) {
+
+# We should generate more tests for all possible combinations
+pir_output_is( <<"CODE", <<OUTPUT, "Original dest is untouched in $pmc.$vtable " );
+.sub 'test' :main
+ \$P0 = new '$pmc'
+ \$P0 = 40
+ \$P1 = new '$pmc'
+ \$P1 = 2
+ \$P2 = new '$pmc'
+ \$P2 = 115200
+
+ \$P99 = \$P2
+ # ignore exceptions
+ push_eh done
+ $op \$P2, \$P0, \$P1
+
+ \$I0 = cmp \$P99, 115200
+ unless \$I0 goto done
+ print " not "
+ done:
+ say "ok"
+.end
+CODE
+ok
+OUTPUT
+
+ }
+}
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
Modified: branches/pmc_pct/t/op/copy.t
==============================================================================
--- branches/pmc_pct/t/op/copy.t Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/t/op/copy.t Thu Jun 4 02:32:48 2009 (r39377)
@@ -19,10 +19,11 @@
.sub 'main' :main
.include 'test_more.pir'
- plan(3)
+ plan(4)
test_basic()
test_rt48467()
+ test_tonull()
.end
.sub 'test_basic'
@@ -63,6 +64,22 @@
is( dest, 3.2, 'copy should make independent copies' )
.end
+.sub 'test_tonull'
+ null $P1
+ $P2 = new 'Undef'
+ .local string msg
+ msg = 'failed'
+ push_eh catch
+ copy $P1, $P2
+ goto check
+catch:
+ .get_results($P3)
+ msg = $P3 ['message']
+check:
+ pop_eh
+ is( msg, 'Null PMC in copy', 'copy to null throws' )
+.end
+
# Local Variables:
# mode: pir
# fill-column: 100
Modified: branches/pmc_pct/t/op/io.t
==============================================================================
--- branches/pmc_pct/t/op/io.t Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/t/op/io.t Thu Jun 4 02:32:48 2009 (r39377)
@@ -52,7 +52,7 @@
OUTPUT
TODO: {
-local $TODO = 'Testing' unless $^O =~ /linux|darwin/;
+local $TODO = 'Unimplemented in this platform, TT #661' unless $^O =~ /linux|darwin|MSWin32/;
pir_output_like( <<'CODE', <<'OUTPUT', 'open pipe for reading' );
.include 'iglobals.pasm'
@@ -92,12 +92,12 @@
}
TODO: {
-local $TODO = 'Testing';
+local $TODO = 'Unimplemented in this platform, TT #661' unless $^O =~ /linux|darwin|MSWin32/;
pir_output_is( <<'CODE', <<'OUTPUT', 'open pipe for writing' );
.include 'iglobals.pasm'
-.sub testreadpipe :main
+.sub testwritepipe :main
.local pmc interp
interp = getinterp
.local pmc conf
Modified: branches/pmc_pct/t/op/stringu.t
==============================================================================
--- branches/pmc_pct/t/op/stringu.t Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/t/op/stringu.t Thu Jun 4 02:32:48 2009 (r39377)
@@ -6,7 +6,7 @@
use warnings;
use lib qw( . lib ../lib ../../lib );
use Test::More;
-use Parrot::Test tests => 27;
+use Parrot::Test tests => 28;
use Parrot::Config;
=head1 NAME
@@ -435,23 +435,75 @@
OUTPUT
}
-pasm_output_is( <<'CODE', <<OUTPUT, "UTF-8 and Unicode literals", todo => 'TT #24' );
- set S0, unicode:"\u00ab"
- length I0, S0
- say I0
- say S0
- set S0, iso-8859-1:"\xab"
- length I0, S0
- say I0
- say S0
- end
+pir_output_is( <<'CODE', <<OUTPUT, "UTF-8 and Unicode hash keys");
+.sub 'main'
+ .local string str0, str1
+ str0 = unicode:"\u00ab"
+ str1 = iso-8859-1:"\xab"
+
+ .local pmc hash
+ hash = new 'Hash'
+ hash[str0] = 'hello'
+
+ $I0 = iseq str0, str1
+ say $I0
+
+ $S0 = hash[str0]
+ $S1 = hash[str1]
+ $I0 = iseq $S0, $S1
+ say $I0
+ say $S0
+ say $S1
+.end
CODE
1
-\xc2\xab
1
-\xc2\xab
+hello
+hello
OUTPUT
+pir_output_is( <<'CODE', <<OUTPUT, "UTF-8 and Unicode hash keys, full bucket" );
+.sub 'main'
+ .local string str0, str1
+ str0 = unicode:"infix:\u00b1"
+ str1 = iso-8859-1:"infix:\xb1"
+
+ .local pmc hash
+ hash = new 'Hash'
+ hash[str0] = 'hello'
+
+ $I0 = 0
+ fill_loop:
+ unless $I0 < 200 goto fill_done
+ inc $I0
+ $S0 = $I0
+ $S0 = concat 'infix:', $S0
+ hash[$S0] = 'foo'
+ goto fill_loop
+ fill_done:
+
+ $I0 = iseq str0, str1
+ #print "iseq str0, str1 => "
+ say $I0
+
+ $S0 = hash[str0]
+ $S1 = hash[str1]
+ $I0 = iseq $S0, $S1
+ #print "iseq hash[str0], hash[str1] => "
+ say $I0
+ say $S0
+ say $S1
+.end
+CODE
+1
+1
+hello
+hello
+OUTPUT
+
+
+
+
# Local Variables:
# mode: cperl
# cperl-indent-level: 4
Modified: branches/pmc_pct/t/op/trans.t
==============================================================================
--- branches/pmc_pct/t/op/trans.t Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/t/op/trans.t Thu Jun 4 02:32:48 2009 (r39377)
@@ -272,7 +272,12 @@
ok 2
OUTPUT
-pasm_output_is( <<"CODE", <<OUTPUT, 'atan2' );
+my @jittodo = (
+ $runcore =~ /--runcore=jit/
+ ? ( todo => 'broken under JIT TT #530' )
+ : ()
+);
+pasm_output_is( <<"CODE", <<OUTPUT, 'atan2', @jittodo );
.include 'fp_equality.pasm'
set N0, 0.0
set I0, 0
Modified: branches/pmc_pct/t/pmc/io.t
==============================================================================
--- branches/pmc_pct/t/pmc/io.t Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/t/pmc/io.t Thu Jun 4 02:32:48 2009 (r39377)
@@ -7,7 +7,7 @@
use lib qw( . lib ../lib ../../lib );
use Test::More;
-use Parrot::Test tests => 43;
+use Parrot::Test tests => 42;
use Parrot::Test::Util 'create_tempfile';
use Parrot::Test::Util 'create_tempfile';
@@ -431,8 +431,6 @@
Howdy World
OUTPUT
-SKIP: {
- skip( "segfault, see TT #418", 1 );
pir_output_is( <<"CODE", <<'OUTPUT', 'I/O buffering' );
.sub main
.local string filename
@@ -490,7 +488,6 @@
CODE
Successful
OUTPUT
-}
# RT #46843
pir_output_is( <<'CODE', <<'OUT', 'standard file descriptors' );
@@ -826,27 +823,6 @@
T\xf6tsch
OUTPUT
-pir_output_is( <<'CODE', <<"OUTPUT", "string read/write handle", todo => "no stringhandle yet" );
-.sub main :main
- .local pmc pio
- .local string greeting
- .local string layer
-
- pio = new ['StringHandle']
- print pio, "Hello"
- print pio, ", "
- print pio, "world!"
- print pio, "\n"
-
- greeting = read pio, 1024
-
- print greeting
- print "\n"
-.end
-CODE
-Hello, world!
-OUTPUT
-
pir_output_is( <<"CODE", <<"OUTPUT", "PIO.readall() - classmeth" );
.sub main :main
\$S0 = <<"EOS"
Modified: branches/pmc_pct/t/pmc/multidispatch.t
==============================================================================
--- branches/pmc_pct/t/pmc/multidispatch.t Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/t/pmc/multidispatch.t Thu Jun 4 02:32:48 2009 (r39377)
@@ -25,7 +25,7 @@
=cut
-pir_output_is( <<'CODE', <<'OUTPUT', 'Integer_divide_Integer 10 / 3 = 1003' );
+pir_output_is( <<'CODE', <<'OUTPUT', 'Integer_divide_Integer 10 / 3 = 1003', todo => 'TT #452' );
.sub 'test' :main
.local pmc divide
@@ -57,7 +57,7 @@
1003
OUTPUT
-pir_output_is( <<'CODE', <<'OUTPUT', "1+1=3" );
+pir_output_is( <<'CODE', <<'OUTPUT', "1+1=3", todo => 'TT #452' );
.sub _main
.local pmc add
@@ -89,7 +89,7 @@
3
OUTPUT
-pir_output_is( <<'CODE', <<'OUTPUT', "PASM divide - override builtin 10 / 3 = 42" );
+pir_output_is( <<'CODE', <<'OUTPUT', "PASM divide - override builtin 10 / 3 = 42", todo => 'TT #452' );
.sub _main
.local pmc divide
@@ -117,7 +117,7 @@
42
OUTPUT
-pir_output_is( <<'CODE', <<'OUTPUT', "INTVAL return numeq" );
+pir_output_is( <<'CODE', <<'OUTPUT', "INTVAL return numeq", todo => 'TT #452' );
.sub _main
.local pmc comp
@@ -220,7 +220,7 @@
EOF
close $TEMP;
-pir_output_is( <<"CODE", <<'OUTPUT', "PASM MMD divide - loaded sub" );
+pir_output_is( <<"CODE", <<'OUTPUT', "PASM MMD divide - loaded sub", todo => 'TT #452' );
.sub _main
.local pmc divide
load_bytecode "$temp_pir"
@@ -239,7 +239,7 @@
42
OUTPUT
-pasm_output_is( <<'CODE', <<'OUTPUT', "PASM INTVAL - new result" );
+pasm_output_is( <<'CODE', <<'OUTPUT', "PASM INTVAL - new result", todo => 'TT #452' );
.include "datatypes.pasm"
get_global P10, "Integer_bxor_Intval"
add_multi "bitwise_xor_int", "Integer,INTVAL,PMC", P10
@@ -264,7 +264,7 @@
1
OUTPUT
-pasm_output_is( <<'CODE', <<'OUTPUT', "PASM INTVAL - existing result" );
+pasm_output_is( <<'CODE', <<'OUTPUT', "PASM INTVAL - existing result", todo => 'TT #452' );
.include "datatypes.pasm"
get_global P10, "Integer_bxor_Intval"
add_multi "bitwise_xor_int", "Integer,INTVAL,PMC", P10
@@ -289,7 +289,7 @@
1
OUTPUT
-pasm_output_is( <<'CODE', <<'OUTPUT', "PASM INTVAL - mixed" );
+pasm_output_is( <<'CODE', <<'OUTPUT', "PASM INTVAL - mixed", todo => 'TT #452' );
.include "datatypes.pasm"
get_global P10, "Integer_bxor_Intval"
add_multi "bitwise_xor_int", "Integer,INTVAL,PMC", P10
Modified: branches/pmc_pct/t/pmc/namespace.t
==============================================================================
--- branches/pmc_pct/t/pmc/namespace.t Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/t/pmc/namespace.t Thu Jun 4 02:32:48 2009 (r39377)
@@ -1333,14 +1333,11 @@
parrot
OUTPUT
-pir_error_output_like( <<'CODE', <<'OUTPUT', 'add_sub() with error', todo => 'needs full implementation of PDD 17' );
+pir_output_like( <<'CODE', <<'OUTPUT', 'add_sub() with error' );
.sub main :main
.local pmc s_child
s_child = subclass 'Sub', 'SubChild'
- .local pmc e_child
- e_child = subclass 'Closure', 'ClosureChild'
-
.local pmc child
child = new ['SubChild']
@@ -1350,10 +1347,6 @@
root_ns.'add_sub'( 'child', child )
print "Added sub child\n"
- child = new ['Closure']
- root_ns.'add_sub'( 'closure', child )
- print "Added closure\n"
-
child = new ['Coroutine']
root_ns.'add_sub'( 'coroutine', child )
print "Added coroutine\n"
@@ -1362,10 +1355,6 @@
root_ns.'add_sub'( 'eval', child )
print "Added eval\n"
- child = new ['ClosureChild']
- root_ns.'add_sub'( 'closure_child', child )
- print "Added closure child\n"
-
.local pmc not_a_sub
not_a_sub = new ['Integer']
@@ -1384,10 +1373,8 @@
.end
CODE
/Added sub child
-Added closure
Added coroutine
Added eval
-Added closure child
Invalid type \d+ in add_sub\(\)/
OUTPUT
Modified: branches/pmc_pct/t/pmc/object-meths.t
==============================================================================
--- branches/pmc_pct/t/pmc/object-meths.t Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/t/pmc/object-meths.t Thu Jun 4 02:32:48 2009 (r39377)
@@ -728,7 +728,7 @@
o = new ['Bar']
print o
$P0 = get_global "ok2"
- cl.'add_method'('get_string', $P0, 'vtable' => 1)
+ cl.'add_vtable_override'('get_string', $P0)
print o
.end
.sub ok2
Modified: branches/pmc_pct/t/pmc/packfileannotation.t
==============================================================================
--- branches/pmc_pct/t/pmc/packfileannotation.t Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/t/pmc/packfileannotation.t Thu Jun 4 02:32:48 2009 (r39377)
@@ -21,21 +21,30 @@
.include 'test_more.pir'
.local pmc pa
- plan(4)
+ plan(5)
pa = new ['PackfileAnnotation']
$I0 = defined pa
ok($I0, 'PackfileAnnotation created')
- pa = 42
- pa.'set_key_id'(1)
+ pa.'set_name'('line')
pa.'set_offset'(115200)
+ pa = 42
- $I0 = pa
- is($I0, 42, 'Value stored and fetched')
- $I0 = pa.'get_key_id'()
- is($I0, 1, 'KeyId stored and fetched')
+ $S0 = pa.'get_name'()
+ is($S0, 'line', 'Name stored and fetched')
$I0 = pa.'get_offset'()
is($I0, 115200, 'Offset stored and fetched')
+ $I0 = pa
+ is($I0, 42, 'Value stored and fetched')
+
+ # We can't fetch string from integer annotation
+ push_eh check
+ $I1 = 1
+ $S0 = pa
+ $I0 = 0
+ check:
+ pop_eh
+ ok($I0, "Can't fetch wrong value from Annotation")
.end
Deleted: branches/pmc_pct/t/pmc/packfileannotationkeys.t
==============================================================================
--- branches/pmc_pct/t/pmc/packfileannotationkeys.t Thu Jun 4 02:32:48 2009 (r39376)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,118 +0,0 @@
-#!parrot
-# Copyright (C) 2006-2009, Parrot Foundation.
-
-=head1 NAME
-
-t/pmc/packfileannotationkeys.t - test the PackfileAnnotationKeys PMC
-
-
-=head1 SYNOPSIS
-
- % prove t/pmc/packfileannotationkeys.t
-
-=head1 DESCRIPTION
-
-Tests the PackfileAnnotationKeys PMC.
-
-=cut
-
-.include 'packfile_annotation_key_type.pasm'
-.include 't/pmc/testlib/packfile_common.pir'
-
-# Packfile constructor
-.sub 'test' :main
-.include 'test_more.pir'
- plan(14)
-
- test_sanity()
- test_pack_unpack()
-
-.end
-
-# Sanity test for creating PackfileAnnotationKeys
-.sub 'test_sanity'
- .local pmc pf
- pf = new ['PackfileAnnotationKeys']
- $I0 = defined pf
- ok($I0, "PackfileAnnotationKeys created")
-.end
-
-# Pack PackfileAnnotationKeys
-.sub 'test_pack_unpack'
- .local pmc pf, pfdir, ctable, annotations, keys
-
- pf = new 'Packfile'
- pfdir = pf.'get_directory'()
-
- # Fixup table and Bytecode is mandatory
- $P0 = new 'PackfileFixupTable'
- pfdir["FIXUP_t/pmc/packfileannotationkeys.t"] = $P0
- $P1 = new 'PackfileRawSegment'
- pfdir["BYTECODE_t/pmc/packfileannotationkeys.t"] = $P1
-
- ctable = new 'PackfileConstantTable'
- pfdir["CONSTANT_t/pmc/packfileannotationkeys.t"] = ctable
-
- # Annotation associated with bytecode by interesting
- annotations = new 'PackfileAnnotations'
- pfdir["BYTECODE_t/pmc/packfileannotationkeys.t_ANN"] = annotations
-
- # Initialize kyes
- keys = annotations.'get_key_list'()
- keys[0] = "line"
- keys[0] = .PF_ANNOTATION_KEY_TYPE_INT
-
- # Set couple of annotations
- $P0 = new 'PackfileAnnotation'
- $P0.'set_key_id'(0)
- $P0.'set_offset'(0)
- $P0 = 1
- annotations[0] = $P0
-
- $P1 = new 'PackfileAnnotation'
- $P1.'set_key_id'(0)
- $P1.'set_offset'(1)
- $P1 = 42
- annotations[1] = $P1
-
- # Pack/unpack
- $S0 = pf
- $I0 = length $S0
- ok($I0, "Packfile with annotations packed")
-
- pf = $S0
- annotations = _find_segment_by_type(pf, 'PackfileAnnotations')
- $I0 = defined annotations
- ok($I0, "PackfileAnnotations was unpacked successfully")
-
- # Check unpacked keys
- keys = annotations.'get_key_list'()
- $I0 = elements keys
- is($I0, 1, "Got 1 unpacked key")
- $S0 = keys[0]
- is($S0, "line", "With expected name")
- $I0 = keys[0]
- is($I0, .PF_ANNOTATION_KEY_TYPE_INT, "With expected type")
-
- # Check unpacked entries
- $P0 = annotations[0]
- isa_ok($P0, "PackfileAnnotation")
- $I0 = $P0.'get_key_id'()
- is($I0, 0, "First key_id is correct")
- $I0 = $P0.'get_offset'()
- is($I0, 0, "First offset is correct")
- $I0 = $P0
- is($I0, 1, "First value is correct")
-
- $P0 = annotations[1]
- isa_ok($P0, "PackfileAnnotation")
- $I0 = $P0.'get_key_id'()
- is($I0, 0, "Second key_id is correct")
- $I0 = $P0.'get_offset'()
- is($I0, 1, "Second offset is correct")
- $I0 = $P0
- is($I0, 42, "Second value is correct")
-
-
-.end
-
Modified: branches/pmc_pct/t/pmc/packfileannotations.t
==============================================================================
--- branches/pmc_pct/t/pmc/packfileannotations.t Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/t/pmc/packfileannotations.t Thu Jun 4 02:32:48 2009 (r39377)
@@ -21,10 +21,10 @@
.sub 'main' :main
.include 'test_more.pir'
- plan(14)
+ plan(17)
test_sanity()
- test_handling_directory()
test_unpack()
+ test_pack_unpack()
.end
@@ -36,36 +36,68 @@
ok($I0, "PackfileAnnotations created")
.end
-# Annotations should propogate ConstantTable to Keys.
-.sub 'test_handling_directory'
- .local pmc keys, anns, pfdir
-
- anns = new 'PackfileAnnotations'
- keys = anns.'get_key_list'()
- $I0 = defined keys
- ok($I0, "Keys created")
- $P0 = keys.'get_constant_table'()
- $I0 = defined $P0
- is($I0, 0, " without ConstantTable")
-
- pfdir = new 'PackfileDirectory'
- $P0 = new 'PackfileConstantTable'
- # Order does matter
- pfdir['CONSTANTS'] = $P0
- pfdir['ANNOTATIONS'] = anns
- $P0 = keys.'get_constant_table'()
- $I0 = defined $P0
- ok($I0, 'PackfileConstantTable found and propogated to Keys')
-.end
-
# PackfileAnnotations unpack from PBC
.sub 'test_unpack'
- .local pmc pf, pfdir, pfanns, it
+ .local pmc pf
$P0 = open 't/native_pbc/annotations.pbc'
$S0 = $P0.'readall'()
pf = new 'Packfile'
pf = $S0
+ .tailcall '!test_unpack'(pf)
+.end
+
+# Programatically create PBC same as t/native_pbc/annotations.pbc and check unpack of it.
+.sub 'test_pack_unpack'
+ .local pmc pf, pfdir
+ pf = new 'Packfile'
+ pfdir = pf.'get_directory'()
+ #$P0 = new 'PackfileConstantTable'
+ #$P0[0] = 42.0
+ $P0 = new 'PackfileFixupTable'
+ pfdir["FIXUP_t/pmc/packfileannotations.t"] = $P0
+
+ $P1 = new 'PackfileRawSegment'
+ pfdir["BYTECODE_t/pmc/packfileannotations.t"] = $P1
+
+ $P2 = new 'PackfileConstantTable'
+ pfdir["CONSTANTS_t/pmc/packfileannotations.t"] = $P2
+
+ .local pmc anns
+ anns = new 'PackfileAnnotations'
+ # We have to add it to Directory before doing anything to handle Constants properly
+ pfdir["BYTECODE_t/pmc/packfileannotations.t_ANN"] = anns
+
+ $P3 = new 'PackfileAnnotation'
+ $P3.'set_name'('file')
+ $P3 = 'annotations.pir'
+ anns[0] = $P3
+
+ $P4 = new 'PackfileAnnotation'
+ $P4.'set_name'('creator')
+ $P4 = 'Parrot Foundation'
+ anns[1] = $P4
+
+ $P5 = new 'PackfileAnnotation'
+ $P5.'set_name'('line')
+ $P5 = 1
+ anns[2] = $P5
+
+ $P6 = new 'PackfileAnnotation'
+ $P6.'set_name'('line')
+ $P6 = 2
+ anns[3] = $P6
+
+ # Pack
+ $S0 = pf
+ pf = new 'Packfile'
+ pf = $S0
+ .tailcall '!test_unpack'(pf)
+.end
+
+.sub '!test_unpack'
+ .param pmc pf
+ .local pmc pfdir, pfanns, it
# Find annotations
pfdir = pf.'get_directory'()
@@ -79,19 +111,6 @@
ok(1, "PackfileAnnotations unpacked")
pfanns = $P0
- # Check keys
- .local pmc keys
- keys = pfanns.'get_key_list'()
- $I0 = elements keys
- is($I0, 3, 'Keys were successfully unpacked')
-
- $S0 = keys[0]
- is($S0, "file", "First key is correct")
- $S0 = keys[1]
- is($S0, "creator", "Second key is correct")
- $S0 = keys[2]
- is($S0, "line", "Third key is correct")
-
# Test entities
$I0 = elements pfanns
is($I0, 4, "Annotations were unpack correctly")
@@ -101,15 +120,17 @@
constants = _find_segment_by_type(pf, "PackfileConstantTable")
# "file"
a = pfanns[0]
- $I0 = a
- $S0 = constants[$I0]
- is($S0, "annotations.pir", "First annotation is correct")
+ $S0 = a.'get_name'()
+ is($S0, "file", "First annotation's name unpacked")
+ $S0 = a
+ is($S0, "annotations.pir", "First annotation's value is correct")
# "creator"
a = pfanns[1]
- $I0 = a
- $S0 = constants[$I0]
- is($S0, "Parrot Foundation", "Second annotation is correct")
+ $S0 = a.'get_name'()
+ is($S0, "creator", "Second annotation's name unpacked")
+ $S0 = a
+ is($S0, "Parrot Foundation", "Second annotation's value is correct")
# Two "line"
a = pfanns[2]
Modified: branches/pmc_pct/t/pmc/packfileconstanttable.t
==============================================================================
--- branches/pmc_pct/t/pmc/packfileconstanttable.t Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/t/pmc/packfileconstanttable.t Thu Jun 4 02:32:48 2009 (r39377)
@@ -27,12 +27,13 @@
.sub 'main' :main
.include 'test_more.pir'
.include 'packfile_constants.pasm'
- 'plan'(10)
+ 'plan'(14)
'test_sanity'()
'test_elements'()
'test_get'()
'test_set'()
+ 'test_get_or_create'()
.end
@@ -140,6 +141,26 @@
.end
+.sub 'test_get_or_create'
+ .local pmc pfc
+ pfc = new 'PackfileConstantTable'
+ $I1 = pfc.'get_or_create_constant'('foo')
+ $I2 = pfc.'get_or_create_constant'('foo')
+ is($I1, $I2, "get_or_create_constant returs same string value for same key")
+
+ $I2 = pfc.'get_or_create_constant'('bar')
+ $I0 = $I1 != $I2
+ ok($I0, "get_or_create_constant returs different string values for different keys")
+
+
+ $I1 = pfc.'get_or_create_constant'(1.0)
+ $I2 = pfc.'get_or_create_constant'(1.0)
+ is($I1, $I2, "get_or_create_constant returs same number value for same key")
+
+ $I2 = pfc.'get_or_create_constant'(42.1)
+ $I0 = $I1 != $I2
+ ok($I0, "get_or_create_constant returs different number values for different keys")
+.end
.sub '_get_consttable'
.param pmc pf
Modified: branches/pmc_pct/t/pmc/packfiledirectory.t
==============================================================================
--- branches/pmc_pct/t/pmc/packfiledirectory.t Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/t/pmc/packfiledirectory.t Thu Jun 4 02:32:48 2009 (r39377)
@@ -21,7 +21,7 @@
.sub 'main' :main
.include 'test_more.pir'
- plan(21)
+ plan(23)
'test_create'()
'test_typeof'()
@@ -122,7 +122,6 @@
pfdir[$S0] = seg
$I1 = elements pfdir
is($I0, $I1, "Segment with old name was added")
- goto done
# Add segment with new name
add_new:
@@ -133,6 +132,13 @@
inc $I0
is($I0, $I1, "New segment added")
+ # Remove that segment again
+ delete_seg:
+ delete pfdir[$S0]
+ dec $I0
+ $I1 = elements pfdir
+ is($I0, $I1, "segment deleted")
+
done:
.return()
.end
Modified: branches/pmc_pct/t/pmc/pmcproxy.t
==============================================================================
--- branches/pmc_pct/t/pmc/pmcproxy.t Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/t/pmc/pmcproxy.t Thu Jun 4 02:32:48 2009 (r39377)
@@ -146,7 +146,7 @@
#We will override the add_role vtable method.
$P2 = get_global 'no_add_role'
- $P0.'add_method'('add_role', $P2, 'vtable' => 1)
+ $P0.'add_vtable_override'('add_role', $P2)
ok(1, 'overrode a vtable method')
$P2 = $P0.'new'()
@@ -180,7 +180,7 @@
#We will override the inspect_str vtable method.
$P2 = get_global 'always42'
- $P0.'add_method'('inspect_str', $P2, 'vtable' => 1)
+ $P0.'add_vtable_override'('inspect_str', $P2)
ok(1, 'overrode inspect_str method')
$P2 = $P0.'new'()
Modified: branches/pmc_pct/t/pmc/string.t
==============================================================================
--- branches/pmc_pct/t/pmc/string.t Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/t/pmc/string.t Thu Jun 4 02:32:48 2009 (r39377)
@@ -20,7 +20,7 @@
.sub main :main
.include 'test_more.pir'
- plan(164)
+ plan(165)
set_or_get_strings()
setting_integers()
@@ -70,6 +70,7 @@
out_of_bounds_substr_negative_offset()
exception_to_int_2()
exception_to_int_3()
+ assign_null_string()
# END_OF_TESTS
@@ -1017,6 +1018,20 @@
.exception_is( 'invalid conversion to int - bad base 37' )
.end
+.sub assign_null_string
+ .local pmc s
+ .local string m
+ s = new ['String']
+ null m
+ assign s, m
+ m = 'Any other thing'
+ m = s
+ $I0 = 0
+ if null m goto check
+ inc $I0
+check:
+ is( $I0, 0, 'assign null string, TT #729' )
+.end
# Local Variables:
# mode: cperl
Modified: branches/pmc_pct/t/pmc/sub.t
==============================================================================
--- branches/pmc_pct/t/pmc/sub.t Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/t/pmc/sub.t Thu Jun 4 02:32:48 2009 (r39377)
@@ -9,7 +9,7 @@
use Test::More;
use Parrot::Test::Util 'create_tempfile';
-use Parrot::Test tests => 68;
+use Parrot::Test tests => 69;
use Parrot::Config;
=head1 NAME
@@ -1589,6 +1589,39 @@
lived
OUTPUT
+pir_output_is( <<'CODE', <<'OUTPUT', '.get_subid' );
+.sub 'main'
+ .const 'Sub' foo = 'foo'
+ $S0 = foo.'get_subid'()
+ say $S0
+
+ $P0 = get_global 'bar'
+ $S0 = $P0.'get_subid'()
+ say $S0
+
+ $P0 = get_global 'baz'
+ $S0 = $P0.'get_subid'()
+ say $S0
+.end
+
+.sub '' :subid('foo')
+ say 'foo'
+.end
+
+.sub 'bar'
+ say 'bar'
+.end
+
+.sub 'baz' :subid('bazsubid')
+ say 'baz'
+.end
+CODE
+foo
+bar
+bazsubid
+OUTPUT
+
+
# Local Variables:
# mode: cperl
# cperl-indent-level: 4
Modified: branches/pmc_pct/t/pmc/sys.t
==============================================================================
--- branches/pmc_pct/t/pmc/sys.t Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/t/pmc/sys.t Thu Jun 4 02:32:48 2009 (r39377)
@@ -36,6 +36,7 @@
print O, "\tsay \\"Hello, World!\\"\\n"
print O, ".end\\n"
close O
+ load_bytecode 'config.pbc'
.local pmc conf_hash
conf_hash = _config()
.local string slash
@@ -51,7 +52,6 @@
say \$I0
.end
-.include "library/config.pir"
CODE
Hello, World!
0
@@ -59,6 +59,7 @@
pir_output_is( <<'CODE', <<'OUT', "conf_hash is read-only")
.sub _test :main
+ load_bytecode 'config.pbc'
.local pmc conf_hash
conf_hash = _config()
push_eh is_ro
@@ -70,7 +71,6 @@
end:
.end
-.include 'library/config.pir'
CODE
hash is read-only
OUT
Modified: branches/pmc_pct/t/pmc/testlib/packfile_common.pir
==============================================================================
--- branches/pmc_pct/t/pmc/testlib/packfile_common.pir Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/t/pmc/testlib/packfile_common.pir Thu Jun 4 02:32:48 2009 (r39377)
@@ -19,9 +19,7 @@
.include "interpinfo.pasm"
.local pmc pf, pio
pf = new ['Packfile']
- #$S0 = interpinfo .INTERPINFO_RUNTIME_PREFIX
- #$S0 .= "/runtime/parrot/library/uuid.pbc"
- $S0 = '_filename'()
+ $S0 = '_filename'()
pio = open $S0, 'r'
$S0 = pio.'readall'()
close pio
Modified: branches/pmc_pct/t/pmc/threads.t
==============================================================================
--- branches/pmc_pct/t/pmc/threads.t Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/t/pmc/threads.t Thu Jun 4 02:32:48 2009 (r39377)
@@ -31,6 +31,7 @@
hpux
irix
linux
+ netbsd
openbsd
solaris
MSWin32
Modified: branches/pmc_pct/t/pmc/undef.t
==============================================================================
--- branches/pmc_pct/t/pmc/undef.t Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/t/pmc/undef.t Thu Jun 4 02:32:48 2009 (r39377)
@@ -19,7 +19,7 @@
.sub main :main
.include 'test_more.pir'
- plan(19)
+ plan(21)
morph_to_string()
undef_pmc_is_false()
@@ -33,6 +33,7 @@
check_whether_interface_is_done()
verify_clone_works()
undef_equals_undef()
+ set_undef_to_object()
.end
.sub morph_to_string
@@ -166,6 +167,21 @@
ok( 1, 'Undef == Undef (RT #33603)' )
.end
+.sub set_undef_to_object
+ $P0 = new "Undef"
+ $P2 = new 'Integer'
+ assign $P0, $P2
+ ok( 1, 'Assign Integer to Undef' )
+
+ $P0 = new "Undef"
+ $P1 = newclass "HI"
+ $P2 = new $P1
+ assign $P0, $P2
+ ok( 1, 'Assign Object to Undef' )
+
+ # TODO: Needs tests to verify that the values and metadata are preserved
+ # across the assignment
+.end
# Local Variables:
# mode: pir
# fill-column: 100
Modified: branches/pmc_pct/t/steps/auto_gcc-01.t
==============================================================================
--- branches/pmc_pct/t/steps/auto_gcc-01.t Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/t/steps/auto_gcc-01.t Thu Jun 4 02:32:48 2009 (r39377)
@@ -5,7 +5,7 @@
use strict;
use warnings;
-use Test::More tests => 123;
+use Test::More tests => 122;
use Carp;
use lib qw( lib t/configure/testlib );
use_ok('config::init::defaults');
@@ -288,8 +288,6 @@
"gccversion defined as expected");
is($conf->data->get( 'gccversion' ), q{3.1},
"Got expected value for gccversion");
- is($conf->data->get( 'HAS_aligned_funcptr' ), 0,
- "Got expected value for HAS_aligned_funcptr");
like($step->result(), qr/^yes/, "Got expected result");
}
Copied: branches/pmc_pct/t/tools/install/01-create_directories.t (from r39376, trunk/t/tools/install/01-create_directories.t)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/pmc_pct/t/tools/install/01-create_directories.t Thu Jun 4 02:32:48 2009 (r39377, copy of r39376, trunk/t/tools/install/01-create_directories.t)
@@ -0,0 +1,101 @@
+#! perl
+# Copyright (C) 2007, Parrot Foundation.
+# $Id$
+# 01-create_directories.t
+
+use strict;
+use warnings;
+
+use Test::More tests => 6;
+use Carp;
+use File::Path qw( mkpath );
+use File::Temp qw( tempdir );
+use lib qw( lib );
+use Parrot::Install qw(
+ create_directories
+);
+use IO::CaptureOutput qw( capture );
+
+{
+ my $tdir = tempdir( CLEANUP => 1 );
+ $tdir .= '/';
+
+ my @dirs = qw(foo/bar foo/bar/baz);
+ create_directories($tdir, { map { $_ => 1 } @dirs });
+ my $dirs_seen = 0;
+ foreach my $d (@dirs) {
+ $dirs_seen++ if -d "$tdir$d";
+ }
+ is($dirs_seen, 2, 'got expected number of directories created');
+}
+
+{
+ my $tdir = tempdir( CLEANUP => 1 );
+ $tdir .= '/';
+
+ my @dirs = qw(foo/bar foo/bar/baz);
+ my @created = mkpath( "$tdir$dirs[0]" );
+ ok( ( -d $created[0] ),
+ "one directory created before create_directories() is called" );
+
+ create_directories($tdir, { map { $_ => 1 } @dirs });
+ my $dirs_seen = 0;
+ foreach my $d (@dirs) {
+ $dirs_seen++ if -d "$tdir$d";
+ }
+ is($dirs_seen, 2,
+ "create_directories() handled case where one directory already existed" );
+}
+
+{
+ my $tdir = tempdir( CLEANUP => 1 );
+ $tdir .= '/';
+
+ my @dirs = qw(foo/bar foo/bar/baz);
+ my @created = mkpath( $tdir . 'foo' );
+ ok( ( -d $created[0] ),
+ "one directory created before create_directories() is called" );
+
+ create_directories($tdir, { map { $_ => 1 } @dirs });
+ my $dirs_seen = 0;
+ foreach my $d (@dirs) {
+ $dirs_seen++ if -d "$tdir$d";
+ }
+ is($dirs_seen, 2,
+ "create_directories() handled case where one path partially existed" );
+}
+
+pass("Completed all tests in $0");
+
+################### DOCUMENTATION ###################
+
+=head1 NAME
+
+01-create_directories.t - test subroutines exported by C<Parrot::Install>
+
+=head1 SYNOPSIS
+
+ % prove t/tools/install/01-create_directories.t
+
+=head1 DESCRIPTION
+
+The files in this directory test functionality used by
+F<tools/dev/install_files.pl> and F<tools/dev/install_dev_files.pl> and
+exported by F<lib/Parrot/Install.pm>.
+
+=head1 AUTHOR
+
+James E Keenan and Timothy S Nelson
+
+=head1 SEE ALSO
+
+Parrot::Install, F<tools/dev/install_files.pl>, F<tools/dev/install_dev_files.pl>
+
+=cut
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
Copied: branches/pmc_pct/t/tools/install/02-install_files.t (from r39376, trunk/t/tools/install/02-install_files.t)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/pmc_pct/t/tools/install/02-install_files.t Thu Jun 4 02:32:48 2009 (r39377, copy of r39376, trunk/t/tools/install/02-install_files.t)
@@ -0,0 +1,283 @@
+#! perl
+# Copyright (C) 2007, Parrot Foundation.
+# $Id$
+# 02-install_files.t
+
+use strict;
+use warnings;
+
+use Test::More tests => 18;
+use Carp;
+use Cwd;
+use File::Copy;
+use File::Path qw( mkpath );
+use File::Temp qw( tempdir );
+use lib qw( lib );
+use Parrot::Install qw(
+ install_files
+ create_directories
+);
+use IO::CaptureOutput qw( capture );
+
+my $cwd = cwd();
+my $testsourcedir = qq{$cwd/t/tools/install/testlib};
+
+{
+ my $tdir = tempdir( CLEANUP => 1 );
+ $tdir .= '/';
+
+ my @dirs = qw(foo/bar foo/bar/baz);
+ create_directories($tdir, { map { $_ => 1 } @dirs });
+
+ {
+ my ( $stdout, $stderr, $rv );
+
+ eval {
+ capture(
+ sub { $rv = install_files($tdir, 1); },
+ \$stdout,
+ \$stderr,
+ );
+ };
+ like($@, qr/Error: parameter \$files must be an array/s, "Catches non-ARRAY \$files");
+ }
+}
+
+{
+ my $tdir = tempdir( CLEANUP => 1 );
+ $tdir .= '/';
+
+ my @dirs = qw(foo/bar foo/bar/baz);
+ create_directories($tdir, { map { $_ => 1 } @dirs });
+
+ # Case where element in @files is not a hash ref
+ my $files_ref = [ q[] ];
+
+ {
+ my ( $stdout, $stderr, $rv );
+ capture(
+ sub { $rv = install_files($tdir, 0, $files_ref); },
+ \$stdout,
+ \$stderr,
+ );
+ like($stderr, qr/Bad reference passed in \$files/, "Catches non-HASH files");
+
+ like( $stdout, qr/Installing \.\.\./,
+ 'Got expected installation message' );
+ }
+}
+
+{
+ my $tdir = tempdir( CLEANUP => 1 );
+ $tdir .= '/';
+
+ my @dirs = qw(foo/bar foo/bar/baz);
+ create_directories($tdir, { map { $_ => 1 } @dirs });
+
+ my $files_ref = [ {
+ Source => "$testsourcedir/README",
+ Dest => "$dirs[0]/README",
+ } ];
+
+ {
+ my ( $stdout, $stderr, $rv );
+
+ capture(
+ sub { $rv = install_files($tdir, 1, $files_ref); },
+ \$stdout,
+ \$stderr,
+ );
+ ok( $rv, 'install_files() completed successfully in dry-run case' );
+
+ my $files_created = 0;
+ foreach my $el (@$files_ref) {
+ $files_created++ if -f $tdir . $el->{Dest};
+ }
+ is( $files_created, 0, 'Dry run, so no files created' );
+
+ like( $stdout, qr/Installing.*README.*README/s,
+ 'Got expected installation message' );
+ $stdout =~ qr/Installing.*README.*README/s or print "Warning was: $stderr";
+ }
+
+ {
+ my ( $stdout, $stderr, $rv );
+ capture(
+ sub { $rv = install_files($tdir, 0, $files_ref); },
+ \$stdout,
+ \$stderr,
+ );
+ ok( $rv, 'install_files() completed successfully in production case' );
+
+ my $files_created = 0;
+ foreach my $el (@$files_ref) {
+ $files_created++ if -f "$tdir$el->{Dest}";
+ }
+ is( $files_created, 1, 'Production, so 1 file created' );
+
+ like( $stdout, qr/Installing.*README/s,
+ 'Got expected installation message' );
+ }
+}
+
+{
+ local $^O = 'cygwin';
+ my $tdir = tempdir( CLEANUP => 1 );
+ chdir $tdir or die "Unable to change to testing directory: $!";
+ $tdir .= '/';
+
+ my @dirs = qw(foo/bar foo/bar/baz);
+ create_directories($tdir, { map { $_ => 1 } @dirs });
+
+ my @testingfiles = qw( README phony );
+ foreach my $f ( @testingfiles ) {
+ copy "$testsourcedir/$f", "$tdir/$f"
+ or die "Unable to copy $f prior to testing: $!";
+ }
+ my $files_ref = [
+ {
+ Source => "$tdir/README",
+ Dest => "$dirs[0]/README",
+ },
+ {
+ Source => "$tdir/phony",
+ Dest => "$dirs[0]/phony",
+ },
+ ];
+
+ {
+ my ( $stdout, $stderr, $rv );
+ capture(
+ sub { $rv = install_files($tdir, 0, $files_ref); },
+ \$stdout,
+ \$stderr,
+ );
+ ok( $rv, 'install_files() completed successfully in mock-Cygwin case' );
+
+ my $files_created = 0;
+ foreach my $el (@$files_ref) {
+ $files_created++ if -f "$tdir$el->{Dest}";
+ }
+ is( $files_created, 2, 'Production, so 2 files created' );
+
+ like( $stdout, qr/Installing.*README.*phony/s,
+ 'Got expected installation message' );
+ }
+ chdir $cwd or die "Unable to change back to starting directory: $!";
+}
+
+{
+ local $^O = 'cygwin';
+ my $tdir = tempdir( CLEANUP => 1 );
+ chdir $tdir or die "Unable to change to testing directory: $!";
+ $tdir .= '/';
+
+ my @dirs = qw(foo/bar foo/bar/baz);
+ create_directories($tdir, { map { $_ => 1 } @dirs });
+
+ my @testingfiles = qw( README phony phony.exe );
+ foreach my $f ( @testingfiles ) {
+ copy "$testsourcedir/$f", "$tdir/$f"
+ or die "Unable to copy $f prior to testing: $!";
+ }
+ my $files_ref = [
+ {
+ Source => "$tdir/README",
+ Dest => "$dirs[0]/README"
+ },
+ {
+ Source => "$tdir/phony",
+ Dest => "$dirs[0]/phony"
+ },
+ {
+ Source => "$tdir/phony.exe",
+ Dest => "$dirs[0]/phony.exe"
+ },
+ ];
+
+ {
+ my ( $stdout, $stderr, $rv );
+ capture(
+ sub { $rv = install_files($tdir, 0, $files_ref); },
+ \$stdout,
+ \$stderr,
+ );
+ ok( $rv, 'install_files() completed successfully in mock-Cygwin case' );
+
+ my $files_created = 0;
+ foreach my $el (@$files_ref) {
+ $files_created++ if -f "$tdir$el->{Dest}";
+ }
+ is( $files_created, 2,
+ 'Production, so 2 files created; 1 file passed over' );
+
+ like( $stdout, qr/Installing.*README.*phony/s,
+ 'Got expected installation message' );
+ }
+ chdir $cwd or die "Unable to change back to starting directory: $!";
+}
+
+{
+ my $tdir = tempdir( CLEANUP => 1 );
+ $tdir .= '/';
+
+ my @dirs = qw(foo/bar foo/bar/baz);
+ create_directories($tdir, { map { $_ => 1 } @dirs });
+
+ # Case where element in @files does not hold existent file
+ my $nonexistent = q{ajdpfadksjfjvjkvds} . $$;
+ my $files_ref = [
+ {
+ Source => $nonexistent,
+ Dest => "$dirs[0]/$nonexistent",
+ }
+ ];
+
+ {
+ my ( $stdout, $stderr, $rv );
+ capture(
+ sub { $rv = install_files($tdir, 0, $files_ref); },
+ \$stdout,
+ \$stderr,
+ );
+ ok( $rv, 'install_files() handled non-existent file as expected' );
+
+ like( $stdout, qr/Installing \.\.\./,
+ 'Got expected installation message' );
+ }
+}
+
+pass("Completed all tests in $0");
+
+################### DOCUMENTATION ###################
+
+=head1 NAME
+
+02-install_files.t - test subroutines exported by C<Parrot::Install>
+
+=head1 SYNOPSIS
+
+ % prove t/tools/install/02-install_files.t
+
+=head1 DESCRIPTION
+
+The files in this directory test functionality used by
+F<tools/dev/install_files.pl> and F<tools/dev/install_dev_files.pl> and
+exported by F<lib/Parrot/Install.pm>.
+
+=head1 AUTHOR
+
+James E Keenan and Timothy S Nelson
+
+=head1 SEE ALSO
+
+Parrot::Install, F<tools/dev/install_files.pl>, F<tools/dev/install_dev_files.pl>
+
+=cut
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
Copied: branches/pmc_pct/t/tools/install/03-lines_to_files.t (from r39376, trunk/t/tools/install/03-lines_to_files.t)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/pmc_pct/t/tools/install/03-lines_to_files.t Thu Jun 4 02:32:48 2009 (r39377, copy of r39376, trunk/t/tools/install/03-lines_to_files.t)
@@ -0,0 +1,292 @@
+#! perl
+# Copyright (C) 2007, Parrot Foundation.
+# $Id$
+# 03-lines_to_files.t
+
+use strict;
+use warnings;
+
+use Test::More tests => 8;
+use Carp;
+use Cwd;
+use File::Copy;
+use File::Path qw( mkpath );
+use File::Temp qw( tempdir );
+use lib qw( lib );
+use Parrot::Install qw(
+ install_files
+ create_directories
+ lines_to_files
+);
+use IO::CaptureOutput qw( capture );
+
+my $cwd = cwd();
+my $testsourcedir = qq{$cwd/t/tools/install/testlib};
+
+my $parrotdir = q{};
+
+my %metatransforms = (
+ doc => {
+ optiondir => 'doc',
+ transform => sub {
+ my($dest) = @_;
+ # resources go in the top level of docs
+ $dest =~ s/^docs\/resources/resources/;
+ # other docs are actually raw Pod
+ $dest =~ s/^docs/pod/;
+ $parrotdir, $dest;
+ },
+ },
+ '.*' => {
+ optiondir => 'foo',
+ transform => sub {
+ return($_[0]);
+ }
+ }
+);
+my(@transformorder) = ('doc', '.*');
+
+my %badmetatransforms = (
+ doc => {
+ optiondir => 'doc',
+ transform => sub {
+ my($dest) = @_;
+ $dest =~ s/^docs\/resources/resources/; # resources go in the top level of docs
+ $dest =~ s/^docs/pod/; # other docs are actually raw Pod
+ $parrotdir, $dest;
+ },
+ },
+ '.*' => {
+ optiondir => 'foo',
+ transform => sub {
+ return(@_);
+ }
+ }
+);
+
+my @manifests = qw(MANIFEST MANIFEST.generated);
+my %options = (
+ packages => 'main',
+);
+
+my ($files_ref, $directories_ref, %badtransformorder);
+
+eval {
+ ($files_ref, $directories_ref) =
+ lines_to_files(
+ \%metatransforms,
+ \@transformorder,
+ {},
+ \%options,
+ $parrotdir,
+ );
+};
+like($@, qr/Manifests must be listed in an array reference/,
+ "Correctly detected lack of array ref as 3rd argument"
+);
+
+eval {
+ ($files_ref, $directories_ref) =
+ lines_to_files(
+ \%metatransforms,
+ \@transformorder,
+ [],
+ \%options,
+ $parrotdir,
+ );
+};
+like($@, qr/No manifests specified/,
+ "Correctly detected lack of manifest files"
+);
+
+eval {
+ ($files_ref, $directories_ref) =
+ lines_to_files(
+ \%metatransforms,
+ \%badtransformorder,
+ [ qw( MANIFEST MANIFEST.generated ) ],
+ \%options,
+ $parrotdir,
+ );
+};
+like($@, qr/Transform order should be an array of keys/,
+ "Correctly detected incorrect type for transform order"
+);
+
+{
+ my $tdir = tempdir( CLEANUP => 1 );
+ chdir $tdir or die "Unable to change to testing directory: $!";
+ copy qq{$testsourcedir/manifest_pseudo} => qq{$tdir/MANIFEST}
+ or die "Unable to copy file to tempdir for testing: $!";
+ copy qq{$testsourcedir/generated_pseudo} => qq{$tdir/MANIFEST.generated}
+ or die "Unable to copy file to tempdir for testing: $!";
+
+ my ($stdout, $stderr);
+ eval {
+ ($files_ref, $directories_ref) =
+ lines_to_files(
+ \%badmetatransforms,
+ \@transformorder,
+ [ qw( MANIFEST MANIFEST.generated ) ],
+ \%options,
+ $parrotdir,
+ );
+ };
+ like($@, qr/transform didn't return a hash for key/,
+ "Correctly detected transform with a bad return value"
+ );
+
+ chdir $cwd or die "Unable to return to starting directory: $!";
+}
+
+{
+ my $tdir = tempdir( CLEANUP => 1 );
+ chdir $tdir or die "Unable to change to testing directory: $!";
+ copy qq{$testsourcedir/manifest_pseudo} => qq{$tdir/MANIFEST}
+ or die "Unable to copy file to tempdir for testing: $!";
+ copy qq{$testsourcedir/generated_pseudo_with_dupe} => qq{$tdir/MANIFEST.generated}
+ or die "Unable to copy file to tempdir for testing: $!";
+
+ my ($stdout, $stderr);
+ eval {
+ capture(
+ sub {
+ ($files_ref, $directories_ref) =
+ lines_to_files(
+ \%metatransforms,
+ \@transformorder,
+ [ qw( MANIFEST MANIFEST.generated ) ],
+ \%options,
+ $parrotdir,
+ );
+ },
+ \$stdout,
+ \$stderr,
+ );
+ };
+ like($stderr, qr/MANIFEST\.generated:\d+:\s+Duplicate entry/,
+ "Detected duplicate entries in one or more manifest files" );
+ is( scalar(grep { $_->{Installable} } @$files_ref), 0,
+ "No installable executables in this test" );
+
+ chdir $cwd or die "Unable to return to starting directory: $!";
+}
+
+{
+ my $tdir = tempdir( CLEANUP => 1 );
+ chdir $tdir or die "Unable to change to testing directory: $!";
+ my $defective_man = q{MANIFEST.1defective};
+ copy qq{$testsourcedir/$defective_man} => qq{$tdir/MANIFEST}
+ or die "Unable to copy file to tempdir for testing: $!";
+
+ eval {
+ ($files_ref, $directories_ref) =
+ lines_to_files(
+ \%metatransforms,
+ \@transformorder,
+ [ q{MANIFEST} ],
+ \%options,
+ $parrotdir,
+ );
+ };
+ like($@, qr/Malformed line in MANIFEST: ChangeLog/,
+ "Got expected error message with defective manifest" );
+
+ chdir $cwd or die "Unable to return to starting directory: $!";
+}
+
+
+pass("Completed all tests in $0");
+
+################### DOCUMENTATION ###################
+
+=head1 NAME
+
+03-lines_to_files.t - test subroutines exported by C<Parrot::Install>
+
+=head1 SYNOPSIS
+
+ % prove t/tools/install/03-lines_to_files.t
+
+=head1 DESCRIPTION
+
+The files in this directory test functionality used by
+F<tools/dev/install_files.pl> and F<tools/dev/install_dev_files.pl> and
+exported by F<lib/Parrot/Install.pm>.
+
+=head1 AUTHOR
+
+James E Keenan and Timothy S Nelson
+
+=head1 SEE ALSO
+
+Parrot::Install, F<tools/dev/install_files.pl>, F<tools/dev/install_dev_files.pl>
+
+=cut
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
+
+__END__
+
+# Can't safely run lines_to_files() more than once in a program until it's been fixed,
+# and we can't fix it until its tested, so I've commented most of these out until we've
+# fixed lines_to_files() not to use @ARGV
+
+
+
+## In the code below:
+## - othertransforms needs to be merged into metatransforms
+## - transformorder needs to be added
+## - $installable_exe needs to be removed
+
+#{
+# my($metatransforms, $transformorder, $manifests, $options, $parrotdir,
+# $files, $installable_exe, $directories);
+#
+# # First lines_to_files test
+## eval { lines_to_files(); };
+## $@ or die "lines_to_files didn't die with no parameters\n";
+## ok($@ =~ /^.manifests must be an array reference$/, 'lines_to_files dies with bad parameters');
+#
+# # Second lines_to_files test
+## eval { lines_to_files(
+## $metatransforms, $transformorder,
+## [qw(MANIFEST MANIFEST.generated)],
+## $options, $parrotdir
+## ); };
+## ok($@ =~ /^Unknown install location in MANIFEST for file/, 'fails for install locations not specified in transforms');
+#
+# # Third lines_to_files test
+# $metatransforms = {
+# doc => {
+# optiondir => 'doc',
+# transform => sub {
+# my($dest) = @_;
+# $dest =~ s/^docs\/resources/resources/; # resources go in the top level of docs
+# $dest =~ s/^docs/pod/; # other docs are actually raw Pod
+# $parrotdir, $dest;
+# },
+# },
+# };
+# $othertransforms = {
+# '.*' => {
+# optiondir => 'foo',
+# transform => sub {
+# return(@_);
+# }
+# }
+# };
+#
+# ($files, $installable_exe, $directories) = lines_to_files(
+# $metatransforms, $othertransforms,
+# [qw(MANIFEST MANIFEST.generated)],
+# { packages => 'main' }, $parrotdir
+# );
+# ok((ref($files) and ref($installable_exe) and ref($directories)), 'lines_to_files returns something vaguely sensible');
+# ok(1, 'lines_to_files passed all tests');
+#}
Copied: branches/pmc_pct/t/tools/install/dev_overall.t (from r39376, trunk/t/tools/install/dev_overall.t)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/pmc_pct/t/tools/install/dev_overall.t Thu Jun 4 02:32:48 2009 (r39377, copy of r39376, trunk/t/tools/install/dev_overall.t)
@@ -0,0 +1,193 @@
+#! perl
+# Copyright (C) 2007-2008, Parrot Foundation.
+# $Id$
+# dev_overall.t
+
+use strict;
+use warnings;
+use Test::More tests => 4;
+use Carp;
+use Cwd;
+use File::Basename;
+use File::Copy;
+use File::Path qw( mkpath );
+use File::Spec ();
+use File::Temp qw( tempdir );
+use lib qw( lib );
+use Parrot::Config qw( %PConfig );
+use IO::CaptureOutput qw( capture );
+
+my $DEBUG = 0;
+
+my $cwd = cwd();
+my $installer = File::Spec->catfile( 'tools', 'dev', 'install_dev_files.pl' );
+my $full_installer = File::Spec->catfile( $cwd, $installer );
+ok(-f $full_installer, "Able to locate $installer");
+
+my $testlibdir = File::Spec->catdir( qw| t tools install testlib | );
+my $man_pseudo = File::Spec->catfile( $testlibdir, q|dev_manifest_pseudo| );
+my $full_man_pseudo = File::Spec->catfile( $cwd, $man_pseudo );
+my $gen_pseudo = File::Spec->catfile( $testlibdir, q|dev_generated_pseudo| );
+my $full_gen_pseudo = File::Spec->catfile( $cwd, $gen_pseudo );
+
+{
+ my $builddir = tempdir( CLEANUP => 1 );
+ my $prefixdir = tempdir( CLEANUP => 1 );
+ if ($DEBUG) {
+ print STDERR "$builddir\n$prefixdir\n";
+ }
+
+ my $includedir = File::Spec->catdir( $prefixdir, 'include' );
+ my $libdir = File::Spec->catdir( $prefixdir, 'lib' );
+ my $docdir = File::Spec->catdir( $prefixdir, 'share', 'doc' );
+ my $srcdir = File::Spec->catdir( $prefixdir, 'src' );
+ my $versiondir = $PConfig{versiondir};
+
+ my %testfiles = (
+ 'compilers/nqp/bootstrap/actions.pm' => {
+ start => File::Spec->catfile(
+ qw| . compilers nqp bootstrap actions.pm | ),
+ end => File::Spec->catfile(
+ $libdir, $versiondir, 'languages', 'nqp', 'bootstrap', 'actions.pm' ),
+ },
+ 'docs/compiler_faq.pod' => {
+ start => File::Spec->catfile( qw| . docs compiler_faq.pod | ),
+ end => File::Spec->catfile(
+ $docdir, $versiondir, 'pod', 'compiler_faq.pod' ),
+ },
+ 'docs/pct/past_building_blocks.pod' => {
+ start => File::Spec->catfile(
+ qw| . docs pct past_building_blocks.pod | ),
+ end => File::Spec->catfile(
+ $docdir, $versiondir, 'pod', 'pct', 'past_building_blocks.pod' ),
+ },
+ 'lib/Parrot/Configure.pm' => {
+ start => File::Spec->catfile(
+ qw| . lib Parrot Configure.pm | ),
+ end => File::Spec->catfile(
+ $libdir, $versiondir, 'tools', 'lib', 'Parrot', 'Configure.pm' ),
+ },
+ 'src/ops/ops.num' => {
+ start => File::Spec->catfile(
+ qw| . src ops ops.num | ),
+ end => File::Spec->catfile(
+ $srcdir, $versiondir, 'ops', 'ops.num' ),
+ },
+ 'tools/build/ops2c.pl' => {
+ start => File::Spec->catfile(
+ qw| . tools build ops2c.pl | ),
+ end => File::Spec->catfile(
+ $libdir, $versiondir, 'tools', 'build', 'ops2c.pl' ),
+ },
+ 'runtime/parrot/library/TGE.pbc' => {
+ start => File::Spec->catfile(
+ qw| . runtime parrot library TGE.pbc | ),
+ end => File::Spec->catfile(
+ $libdir, $versiondir, 'library', 'TGE.pbc' ),
+ },
+ 'src/pmc/pmc_object.h' => {
+ start => File::Spec->catfile(
+ qw| . src pmc pmc_object.h | ),
+ end => File::Spec->catfile(
+ $includedir, $versiondir, 'pmc', 'pmc_object.h' ),
+ },
+ 'vtable.dump' => {
+ start => File::Spec->catfile(
+ qw| . vtable.dump | ),
+ end => File::Spec->catfile(
+ $srcdir, $versiondir, 'vtable.dump' ),
+ },
+ );
+ chdir $builddir or croak "Unable to change to tempdir for testing: $!";
+ my $man_quasi = File::Spec->catfile( $builddir, 'MANIFEST' );
+ my $gen_quasi = File::Spec->catfile( $builddir, 'MANIFEST.generated' );
+ copy $full_man_pseudo => $man_quasi
+ or croak "Unable to copy $man_pseudo for testing: $!";
+ copy $full_gen_pseudo => $gen_quasi
+ or croak "Unable to copy $gen_pseudo for testing: $!";
+
+ my @dirs_needed = qw(
+ compilers/nqp/bootstrap
+ docs/pct
+ lib/Parrot
+ src/ops
+ tools/build
+ runtime/parrot/library
+ src/pmc
+ );
+ my @created =
+ mkpath( map { File::Spec->catdir( $builddir, $_ ) } @dirs_needed );
+ print STDERR "dirs created: @created\n" if $DEBUG;
+ foreach my $f ( keys %testfiles ) {
+ my $src = File::Spec->catfile( $cwd, $testlibdir, $f );
+ my $des = File::Spec->catfile( $builddir, $testfiles{$f}{start} );
+ copy $src, $des or croak "Unable to copy $f for testing: $!";
+ }
+ my $addlib = qq{$cwd/lib};
+ my $cmd = qq{$^X -I$addlib $full_installer --prefix=$prefixdir};
+ $cmd .= qq{ --includedir=$includedir};
+ $cmd .= qq{ --libdir=$libdir};
+ $cmd .= qq{ --versiondir=$versiondir};
+ $cmd .= qq{ --docdir=$docdir};
+ $cmd .= qq{ --srcdir=$srcdir};
+# $cmd .= qq{ --dry-run=1} if $DEBUG;
+ $cmd .= qq{ MANIFEST MANIFEST.generated};
+ print "cmd: $cmd\n" if $DEBUG;
+ my ($stdout, $stderr);
+ capture(
+ sub {
+ system( $cmd ) and croak "Unable to execute $installer: $!";
+ },
+ \$stdout,
+ \$stderr,
+ );
+ like( $stdout, qr/^Installing/, "Got expected standard output" );
+ print STDERR "out: $stdout\n" if $DEBUG;
+ print STDERR "err: $stderr\n" if $DEBUG;
+ my $seen = 0;
+ my $expected = scalar keys %testfiles;
+ foreach my $f ( keys %testfiles ) {
+ my $des = $testfiles{$f}{end};
+ print STDERR "wanted: $des\n" if $DEBUG;
+ $seen++ if -f $des;
+ }
+ is( $seen, $expected,
+ "Got all $expected expected files in installation" );
+
+ chdir $cwd
+ or croak "Unable to return to top-level directory after testing: $!";
+}
+
+pass("Completed all tests in $0");
+
+################### DOCUMENTATION ###################
+
+=head1 NAME
+
+dev_overall.t - test tools/dev/install_dev_files.pl
+
+=head1 SYNOPSIS
+
+ % prove t/tools/install/dev_overall.t
+
+=head1 DESCRIPTION
+
+This file simulates the operation of F<tools/dev/install_dev_files.pl> and
+sanity-checks the results.
+
+=head1 AUTHOR
+
+James E Keenan
+
+=head1 SEE ALSO
+
+F<tools/dev/install_dev_files.pl>.
+
+=cut
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
Copied: branches/pmc_pct/t/tools/install/overall.t (from r39376, trunk/t/tools/install/overall.t)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/pmc_pct/t/tools/install/overall.t Thu Jun 4 02:32:48 2009 (r39377, copy of r39376, trunk/t/tools/install/overall.t)
@@ -0,0 +1,176 @@
+#! perl
+# Copyright (C) 2007-2008, Parrot Foundation.
+# $Id$
+# overall.t
+
+use strict;
+use warnings;
+use Test::More tests => 4;
+use Carp;
+use Cwd;
+use File::Basename;
+use File::Copy;
+use File::Path qw( mkpath );
+use File::Spec ();
+use File::Temp qw( tempdir );
+use lib qw( lib );
+use Parrot::Config qw( %PConfig );
+use Parrot::Install qw(
+ install_files
+ create_directories
+ lines_to_files
+);
+use IO::CaptureOutput qw( capture );
+
+my $DEBUG = 0;
+
+my $cwd = cwd();
+my $installer = File::Spec->catfile( 'tools', 'dev', 'install_files.pl' );
+my $full_installer = File::Spec->catfile( $cwd, $installer );
+ok(-f $full_installer, "Able to locate $installer");
+
+my $testlibdir = File::Spec->catdir( qw| t tools install testlib | );
+my $man_pseudo = File::Spec->catfile( $testlibdir, q|manifest_pseudo| );
+my $full_man_pseudo = File::Spec->catfile( $cwd, $man_pseudo );
+my $gen_pseudo = File::Spec->catfile( $testlibdir, q|generated_pseudo| );
+my $full_gen_pseudo = File::Spec->catfile( $cwd, $gen_pseudo );
+
+{
+ my $builddir = tempdir( CLEANUP => 1 );
+ my $prefixdir = tempdir( CLEANUP => 1 );
+ if ($DEBUG) {
+ print STDERR "$builddir\n$prefixdir\n";
+ }
+
+ my $includedir = File::Spec->catdir( $prefixdir, 'include' );
+ my $libdir = File::Spec->catdir( $prefixdir, 'lib' );
+ my $docdir = File::Spec->catdir( $prefixdir, 'share', 'doc' );
+ my $versiondir = $PConfig{versiondir};
+
+ my %testfiles = (
+ 'LICENSE' => {
+ start => File::Spec->catfile( qw| . LICENSE | ),
+ end => File::Spec->catfile(
+ $docdir, $versiondir, 'LICENSE' )
+ },
+ 'docs/gettingstarted.pod' => {
+ start => File::Spec->catfile( qw| . docs gettingstarted.pod | ),
+ end => File::Spec->catfile(
+ $docdir, $versiondir, 'pod', 'gettingstarted.pod' ),
+ },
+ 'docs/resources/phony_resource' => {
+ start => File::Spec->catfile( qw| . docs resources phony_resource | ),
+ end => File::Spec->catfile(
+ $docdir, $versiondir, 'resources', 'phony_resource' ),
+ },
+ 'include/parrot/charset.h' => {
+ start => File::Spec->catfile( qw| . include parrot charset.h | ),
+ end => File::Spec->catfile(
+ $includedir, $versiondir, 'parrot', 'charset.h' ),
+ },
+ 'install_config.fpmc' => {
+ start => File::Spec->catfile( qw| . install_config.fpmc | ),
+ end => File::Spec->catfile(
+ $libdir, $versiondir, 'include', 'config.fpmc' ),
+ },
+ 'parrot.pc' => {
+ start => File::Spec->catfile( qw| . | ),
+ end => File::Spec->catfile(
+ $libdir, 'pkgconfig', $versiondir, 'parrot.pc' ),
+ },
+ 'compilers/pge/PGE.pir' => {
+ start => File::Spec->catfile( qw| . compilers pge PGE.pir | ),
+ end => File::Spec->catfile(
+ $libdir, $versiondir, 'languages', 'pge', 'PGE.pir' ),
+ },
+
+ );
+ chdir $builddir or croak "Unable to change to tempdir for testing: $!";
+ my $man_quasi = File::Spec->catfile( $builddir, 'MANIFEST' );
+ my $gen_quasi = File::Spec->catfile( $builddir, 'MANIFEST.generated' );
+ copy $full_man_pseudo => $man_quasi
+ or croak "Unable to copy $man_pseudo for testing: $!";
+ copy $full_gen_pseudo => $gen_quasi
+ or croak "Unable to copy $gen_pseudo for testing: $!";
+
+ my @dirs_needed = qw(
+ src
+ docs/resources
+ include/parrot
+ runtime/parrot/include
+ compilers/pge
+ );
+ my @created =
+ mkpath( map { File::Spec->catdir( $builddir, $_ ) } @dirs_needed );
+ print STDERR "dirs created: @created\n" if $DEBUG;
+ foreach my $f ( keys %testfiles ) {
+ my $src = File::Spec->catfile( $cwd, $testlibdir, $f );
+ my $des = File::Spec->catfile( $builddir, $testfiles{$f}{start} );
+ copy $src, $des or croak "Unable to copy $f for testing: $!";
+ }
+ my $addlib = qq{$cwd/lib};
+ my $cmd = qq{$^X -I$addlib $full_installer --prefix=$prefixdir};
+ $cmd .= qq{ --includedir=$includedir};
+ $cmd .= qq{ --libdir=$libdir};
+ $cmd .= qq{ --versiondir=$versiondir};
+ $cmd .= qq{ --docdir=$docdir};
+# $cmd .= qq{ --dry-run=1} if $DEBUG;
+ $cmd .= qq{ MANIFEST MANIFEST.generated};
+ print "cmd: $cmd\n" if $DEBUG;
+ my ($stdout, $stderr);
+ capture(
+ sub {
+ system( $cmd ) and croak "Unable to execute $installer: $!";
+ },
+ \$stdout,
+ \$stderr,
+ );
+ like( $stdout, qr/^Installing/, "Got expected standard output" );
+ print STDERR "out: $stdout\n" if $DEBUG;
+ print STDERR "err: $stderr\n" if $DEBUG;
+ my $seen = 0;
+ my $expected = scalar keys %testfiles;
+ foreach my $f ( keys %testfiles ) {
+ my $des = $testfiles{$f}{end};
+ $seen++ if -f $des;
+ }
+ is( $seen, $expected,
+ "Got all $expected expected files in installation" );
+
+ chdir $cwd
+ or croak "Unable to return to top-level directory after testing: $!";
+}
+
+pass("Completed all tests in $0");
+
+################### DOCUMENTATION ###################
+
+=head1 NAME
+
+overall.t - test tools/dev/install_files.pl
+
+=head1 SYNOPSIS
+
+ % prove t/tools/install/overall.t
+
+=head1 DESCRIPTION
+
+This file simulates the operation of F<tools/dev/install_files.pl> and
+sanity-checks the results.
+
+=head1 AUTHOR
+
+James E Keenan
+
+=head1 SEE ALSO
+
+F<tools/dev/install_files.pl>.
+
+=cut
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
Copied: branches/pmc_pct/t/tools/install/testlib/LICENSE (from r39376, trunk/t/tools/install/testlib/LICENSE)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/pmc_pct/t/tools/install/testlib/LICENSE Thu Jun 4 02:32:48 2009 (r39377, copy of r39376, trunk/t/tools/install/testlib/LICENSE)
@@ -0,0 +1,2 @@
+# $Id$
+
Copied: branches/pmc_pct/t/tools/install/testlib/MANIFEST.1defective (from r39376, trunk/t/tools/install/testlib/MANIFEST.1defective)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/pmc_pct/t/tools/install/testlib/MANIFEST.1defective Thu Jun 4 02:32:48 2009 (r39377, copy of r39376, trunk/t/tools/install/testlib/MANIFEST.1defective)
@@ -0,0 +1,5 @@
+# $Id$
+#
+# generated by hand for testing purposes only
+CREDITS [] /destination/to/file
+ChangeLog
Copied: branches/pmc_pct/t/tools/install/testlib/README (from r39376, trunk/t/tools/install/testlib/README)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/pmc_pct/t/tools/install/testlib/README Thu Jun 4 02:32:48 2009 (r39377, copy of r39376, trunk/t/tools/install/testlib/README)
@@ -0,0 +1,155 @@
+This is Parrot, version 0.9.1
+------------------------------
+
+Parrot is Copyright (C) 2001-2009, Parrot Foundation.
+
+$Id$
+
+LICENSE INFORMATION
+-------------------
+
+This code is distributed under the terms of the Artistic License 2.0.
+For more details, see the full text of the license in the file LICENSE.
+
+PREREQUISITES
+-------------
+
+You need a C compiler, a linker, and a make program of course. If you will be
+linking with the ICU library you have to download and install it before
+configuring Parrot.
+
+Get it from http://www-306.ibm.com/software/globalization/icu/downloads.jsp
+
+You also need Perl 5.8.4 or newer, Storable 2.12 or newer, and Bundle::Parrot
+to run various configure and build scripts.
+
+For most of the platforms that we are supporting initially, Parrot should build
+out of the box. PLATFORM lists our target platforms.
+
+The current configure system is primitive, as it's only a temporary solution.
+It will be happy with most any answers you decide to feed it. Garbage In,
+Garbage Out.
+
+INSTRUCTIONS
+------------
+
+For now, unpack your Parrot tarball, (if you're reading this, you've
+probably already done that) and type
+
+ perl Configure.pl
+
+to run the Configure script. The Configure.pl script extracts
+configuration from the running perl5 program. Unfortunately, the perl5
+configuration is not set up to compile and link c++ programs, so you
+may need to explicitly tell Configure.pl which compiler and linker to
+use. For example, to compile C files with 'cc', C++ files with
+'CC', and link everything together with 'CC', you would type
+
+ perl Configure.pl --cc=cc --cxx=CC --link=CC --ld=CC
+
+See "perl Configure.pl --help" for more options and docs/configuration.pod
+for more details.
+
+For systems like HPUX that don't have inet_pton please run
+
+ perl Configure.pl --define=inet_aton
+
+Running Configure.pl will generate a config.h header, a Parrot::Config
+module, platform files and many Makefiles.
+
+The file "myconfig" has an overview of configure settings.
+
+Next, run make. (Configure.pl will tell you which version of make it
+recommends for your system.)
+
+Now, the interpreter should build. If you are building the ICU library
+(this is the default on most systems), you need to use GNU make instead
+(or something compatible with it).
+
+NOTE: If you have trouble linking parrot, this *may* be due to a pre-existing
+parrot version installed via 'make install'. Until this issue is resolved,
+you may have to delete the installed version of parrot before building a new
+one. Our apologies.
+
+You can test parrot by running "make test". You can run the tests in parallel
+with "make TEST_JOBS=3 test".
+
+You can run the full test suite with
+
+ make fulltest
+
+Note: PLATFORMS contains notes about whether test failures are expected
+on your system.
+
+On some systems you can install parrot:
+
+ make install
+
+This installs a bunch of files in /usr/local. The parrot executable is in
+/usr/local/bin. Please note that this feature is currently experimental.
+(It's so experimental that you have to read the directions it gives you.)
+
+If you want to install Parrot into a non-standard location use:
+
+ perl Configure.pl --prefix=/Users/foo/parrot-0.7.0
+ make install
+
+But please note that dynamic libs will not be found for non-standard
+locations unless you set LD_LIBRARY_PATH or similar.
+
+Look at docs/parrot.pod and docs/intro.pod for where to go from here. If you
+have any problems, see the section "How To Submit A Bug Report" in
+docs/submissions.pod. These documents are in POD format. You can view these
+files with the command:
+
+ perldoc -F docs/intro.pod
+
+NOTES
+-----
+
+On some older computers with little RAM, the computed-goto dispatch core
+(ops/core_ops_cg.c) may take a while to compile or may fail to compile at all.
+You can pass a flag to Configure.pl (--cgoto=0) to disable the computed-goto
+core, at a slight cost in runtime speed.
+
+CHANGES
+-------
+
+For documentation on the user-visible changes between this version and
+previous versions, please see NEWS.
+
+MAILING LISTS
+-------------
+
+The mailing list for parrot is parrot-dev at lists.parrot.org. Subscribe by
+filling out the form at http://lists.parrot.org/mailman/listinfo/parrot-dev
+It is archived at http://lists.parrot.org/pipermail/parrot-dev/
+
+The old development list is archived at
+http://www.nntp.perl.org/group/perl.perl6.internals
+and available via NNTP at nntp://nntp.perl.org/perl.perl6.internals
+
+You can also read the (old) list via Google Groups at
+http://groups-beta.google.com/group/perl.perl6.internals
+
+FEEDBACK, PATCHES, etc.
+-----------------------
+
+See F<docs/submissions.pod> for more information on reporting bugs and
+submitting patches.
+
+WEB SITES
+---------
+
+The following web sites have all the information you need about Parrot:
+ http://www.parrot.org/
+ http://trac.parrot.org/
+ http://www.parrotblog.org/
+
+And Perl6:
+ http://rakudo.org/
+ http://dev.perl.org/perl6/
+ http://pugscode.org/
+
+Have fun,
+ The Parrot Team.
Copied: branches/pmc_pct/t/tools/install/testlib/compilers/nqp/bootstrap/actions.pm (from r39376, trunk/t/tools/install/testlib/compilers/nqp/bootstrap/actions.pm)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/pmc_pct/t/tools/install/testlib/compilers/nqp/bootstrap/actions.pm Thu Jun 4 02:32:48 2009 (r39377, copy of r39376, trunk/t/tools/install/testlib/compilers/nqp/bootstrap/actions.pm)
@@ -0,0 +1,9 @@
+# $Id$
+# Copyright (C) 2009, Parrot Foundation.
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
Copied: branches/pmc_pct/t/tools/install/testlib/compilers/pge/PGE.pir (from r39376, trunk/t/tools/install/testlib/compilers/pge/PGE.pir)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/pmc_pct/t/tools/install/testlib/compilers/pge/PGE.pir Thu Jun 4 02:32:48 2009 (r39377, copy of r39376, trunk/t/tools/install/testlib/compilers/pge/PGE.pir)
@@ -0,0 +1,8 @@
+# $Id$
+# Copyright (C) 2005-2009, Parrot Foundation.
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
Copied: branches/pmc_pct/t/tools/install/testlib/dev_generated_pseudo (from r39376, trunk/t/tools/install/testlib/dev_generated_pseudo)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/pmc_pct/t/tools/install/testlib/dev_generated_pseudo Thu Jun 4 02:32:48 2009 (r39377, copy of r39376, trunk/t/tools/install/testlib/dev_generated_pseudo)
@@ -0,0 +1,10 @@
+# $Id$
+# See tools/dev/install_files.pl for documentation on the
+# format of this file.
+# Please re-sort this file after *EVERY* modification
+runtime/parrot/library/TGE.pbc [tge]
+src/pmc/pmc_object.h [devel]include
+vtable.dump [devel]src
+# Local variables:
+# mode: text
+# End:
Copied: branches/pmc_pct/t/tools/install/testlib/dev_manifest_pseudo (from r39376, trunk/t/tools/install/testlib/dev_manifest_pseudo)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/pmc_pct/t/tools/install/testlib/dev_manifest_pseudo Thu Jun 4 02:32:48 2009 (r39377, copy of r39376, trunk/t/tools/install/testlib/dev_manifest_pseudo)
@@ -0,0 +1,17 @@
+# $Id$
+#
+# generated by tools/dev/mk_manifest_and_skip.pl Thu May 21 03:56:48 2009 UT
+#
+# See tools/dev/install_files.pl for documentation on the
+# format of this file.
+# See docs/submissions.pod on how to recreate this file after SVN
+# has been told about new or deleted files.
+compilers/nqp/bootstrap/actions.pm [nqp]
+docs/compiler_faq.pod [devel]doc
+docs/pct/past_building_blocks.pod [pct]doc
+lib/Parrot/Configure.pm [devel]lib
+src/ops/ops.num [devel]src
+tools/build/ops2c.pl [devel]
+# Local variables:
+# mode: text
+# End:
Copied: branches/pmc_pct/t/tools/install/testlib/docs/compiler_faq.pod (from r39376, trunk/t/tools/install/testlib/docs/compiler_faq.pod)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/pmc_pct/t/tools/install/testlib/docs/compiler_faq.pod Thu Jun 4 02:32:48 2009 (r39377, copy of r39376, trunk/t/tools/install/testlib/docs/compiler_faq.pod)
@@ -0,0 +1,2 @@
+# $Id$
+
Copied: branches/pmc_pct/t/tools/install/testlib/docs/gettingstarted.pod (from r39376, trunk/t/tools/install/testlib/docs/gettingstarted.pod)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/pmc_pct/t/tools/install/testlib/docs/gettingstarted.pod Thu Jun 4 02:32:48 2009 (r39377, copy of r39376, trunk/t/tools/install/testlib/docs/gettingstarted.pod)
@@ -0,0 +1,2 @@
+# $Id$
+
Copied: branches/pmc_pct/t/tools/install/testlib/docs/pct/past_building_blocks.pod (from r39376, trunk/t/tools/install/testlib/docs/pct/past_building_blocks.pod)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/pmc_pct/t/tools/install/testlib/docs/pct/past_building_blocks.pod Thu Jun 4 02:32:48 2009 (r39377, copy of r39376, trunk/t/tools/install/testlib/docs/pct/past_building_blocks.pod)
@@ -0,0 +1,2 @@
+# $Id$
+
Copied: branches/pmc_pct/t/tools/install/testlib/docs/resources/phony_resource (from r39376, trunk/t/tools/install/testlib/docs/resources/phony_resource)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/pmc_pct/t/tools/install/testlib/docs/resources/phony_resource Thu Jun 4 02:32:48 2009 (r39377, copy of r39376, trunk/t/tools/install/testlib/docs/resources/phony_resource)
@@ -0,0 +1,2 @@
+# $Id$
+
Copied: branches/pmc_pct/t/tools/install/testlib/generated_pseudo (from r39376, trunk/t/tools/install/testlib/generated_pseudo)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/pmc_pct/t/tools/install/testlib/generated_pseudo Thu Jun 4 02:32:48 2009 (r39377, copy of r39376, trunk/t/tools/install/testlib/generated_pseudo)
@@ -0,0 +1,9 @@
+# $Id$
+# See tools/dev/install_files.pl for documentation on the
+# format of this file.
+# Please re-sort this file after *EVERY* modification
+install_config.fpmc [main]lib
+parrot.pc [main]pkgconfig
+# Local variables:
+# mode: text
+# End:
Copied: branches/pmc_pct/t/tools/install/testlib/generated_pseudo_with_dupe (from r39376, trunk/t/tools/install/testlib/generated_pseudo_with_dupe)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/pmc_pct/t/tools/install/testlib/generated_pseudo_with_dupe Thu Jun 4 02:32:48 2009 (r39377, copy of r39376, trunk/t/tools/install/testlib/generated_pseudo_with_dupe)
@@ -0,0 +1,10 @@
+# $Id$
+# See tools/dev/install_files.pl for documentation on the
+# format of this file.
+# Please re-sort this file after *EVERY* modification
+install_config.fpmc [main]lib
+parrot.pc [main]pkgconfig
+parrot.pc [main]pkgconfig
+# Local variables:
+# mode: text
+# End:
Copied: branches/pmc_pct/t/tools/install/testlib/include/parrot/charset.h (from r39376, trunk/t/tools/install/testlib/include/parrot/charset.h)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/pmc_pct/t/tools/install/testlib/include/parrot/charset.h Thu Jun 4 02:32:48 2009 (r39377, copy of r39376, trunk/t/tools/install/testlib/include/parrot/charset.h)
@@ -0,0 +1,17 @@
+/* charset.h
+ * Copyright (C) 2009, Parrot Foundation.
+ * SVN Info
+ * $Id$
+ */
+
+#ifndef PARROT_TEST_INSTALL_CHARSET_H_GUARD
+#define PARROT_TEST_INSTALL_CHARSET_H_GUARD
+
+#endif /* PARROT_TEST_INSTALL_CHARSET_H_GUARD */
+
+/*
+ * Local variables:
+ * c-file-style: "parrot"
+ * End:
+ * vim: expandtab shiftwidth=4:
+ */
Copied: branches/pmc_pct/t/tools/install/testlib/install_config.fpmc (from r39376, trunk/t/tools/install/testlib/install_config.fpmc)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/pmc_pct/t/tools/install/testlib/install_config.fpmc Thu Jun 4 02:32:48 2009 (r39377, copy of r39376, trunk/t/tools/install/testlib/install_config.fpmc)
@@ -0,0 +1,2 @@
+# $Id$
+
Copied: branches/pmc_pct/t/tools/install/testlib/lib/Parrot/Configure.pm (from r39376, trunk/t/tools/install/testlib/lib/Parrot/Configure.pm)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/pmc_pct/t/tools/install/testlib/lib/Parrot/Configure.pm Thu Jun 4 02:32:48 2009 (r39377, copy of r39376, trunk/t/tools/install/testlib/lib/Parrot/Configure.pm)
@@ -0,0 +1,9 @@
+# $Id$
+# Copyright (C) 2009, Parrot Foundation.
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
Copied: branches/pmc_pct/t/tools/install/testlib/manifest_pseudo (from r39376, trunk/t/tools/install/testlib/manifest_pseudo)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/pmc_pct/t/tools/install/testlib/manifest_pseudo Thu Jun 4 02:32:48 2009 (r39377, copy of r39376, trunk/t/tools/install/testlib/manifest_pseudo)
@@ -0,0 +1,17 @@
+# $Id$
+#
+# generated by tools/dev/mk_manifest_and_skip.pl Thu May 21 03:56:48 2009 UT
+#
+# See tools/dev/install_files.pl for documentation on the
+# format of this file.
+# See docs/submissions.pod on how to recreate this file after SVN
+# has been told about new or deleted files.
+LICENSE [main]doc
+compilers/pge/PGE.pir [pge]
+docs/gettingstarted.pod [main]doc
+docs/resources/phony_resource [main]doc
+include/parrot/charset.h [main]include
+runtime/parrot/include/sockets.pasm [library]
+# Local variables:
+# mode: text
+# End:
Copied: branches/pmc_pct/t/tools/install/testlib/parrot.pc (from r39376, trunk/t/tools/install/testlib/parrot.pc)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/pmc_pct/t/tools/install/testlib/parrot.pc Thu Jun 4 02:32:48 2009 (r39377, copy of r39376, trunk/t/tools/install/testlib/parrot.pc)
@@ -0,0 +1,2 @@
+# $Id$
+
Copied: branches/pmc_pct/t/tools/install/testlib/phony (from r39376, trunk/t/tools/install/testlib/phony)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/pmc_pct/t/tools/install/testlib/phony Thu Jun 4 02:32:48 2009 (r39377, copy of r39376, trunk/t/tools/install/testlib/phony)
@@ -0,0 +1 @@
+File used in testing of Parrot::Install.
Copied: branches/pmc_pct/t/tools/install/testlib/phony.exe (from r39376, trunk/t/tools/install/testlib/phony.exe)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/pmc_pct/t/tools/install/testlib/phony.exe Thu Jun 4 02:32:48 2009 (r39377, copy of r39376, trunk/t/tools/install/testlib/phony.exe)
@@ -0,0 +1 @@
+File used in testing of Parrot::Install; not a real executable.
Copied: branches/pmc_pct/t/tools/install/testlib/runtime/parrot/include/sockets.pasm (from r39376, trunk/t/tools/install/testlib/runtime/parrot/include/sockets.pasm)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/pmc_pct/t/tools/install/testlib/runtime/parrot/include/sockets.pasm Thu Jun 4 02:32:48 2009 (r39377, copy of r39376, trunk/t/tools/install/testlib/runtime/parrot/include/sockets.pasm)
@@ -0,0 +1,9 @@
+# $Id$
+# Copyright (C) 2001-2009, Parrot Foundation.
+
+
+# Local Variables:
+# mode: pir
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:
Copied: branches/pmc_pct/t/tools/install/testlib/runtime/parrot/library/TGE.pbc (from r39376, trunk/t/tools/install/testlib/runtime/parrot/library/TGE.pbc)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/pmc_pct/t/tools/install/testlib/runtime/parrot/library/TGE.pbc Thu Jun 4 02:32:48 2009 (r39377, copy of r39376, trunk/t/tools/install/testlib/runtime/parrot/library/TGE.pbc)
@@ -0,0 +1,2 @@
+# $Id$
+
Copied: branches/pmc_pct/t/tools/install/testlib/src/ops/ops.num (from r39376, trunk/t/tools/install/testlib/src/ops/ops.num)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/pmc_pct/t/tools/install/testlib/src/ops/ops.num Thu Jun 4 02:32:48 2009 (r39377, copy of r39376, trunk/t/tools/install/testlib/src/ops/ops.num)
@@ -0,0 +1,2 @@
+# $Id$
+
Copied: branches/pmc_pct/t/tools/install/testlib/src/pmc/pmc_object.h (from r39376, trunk/t/tools/install/testlib/src/pmc/pmc_object.h)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/pmc_pct/t/tools/install/testlib/src/pmc/pmc_object.h Thu Jun 4 02:32:48 2009 (r39377, copy of r39376, trunk/t/tools/install/testlib/src/pmc/pmc_object.h)
@@ -0,0 +1,17 @@
+/* pmc_object.h
+ * Copyright (C) 2009, Parrot Foundation.
+ * SVN Info
+ * $Id$
+ */
+
+#ifndef PARROT_TEST_INSTALL_PMC_OBJECT_H_GUARD
+#define PARROT_TEST_INSTALL_PMC_OBJECT_H_GUARD
+
+#endif /* PARROT_TEST_INSTALL_PMC_OBJECT_H_GUARD */
+
+/*
+ * Local variables:
+ * c-file-style: "parrot"
+ * End:
+ * vim: expandtab shiftwidth=4:
+ */
Copied: branches/pmc_pct/t/tools/install/testlib/tools/build/ops2c.pl (from r39376, trunk/t/tools/install/testlib/tools/build/ops2c.pl)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/pmc_pct/t/tools/install/testlib/tools/build/ops2c.pl Thu Jun 4 02:32:48 2009 (r39377, copy of r39376, trunk/t/tools/install/testlib/tools/build/ops2c.pl)
@@ -0,0 +1,9 @@
+# $Id$
+# Copyright (C) 2009, Parrot Foundation.
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
Copied: branches/pmc_pct/t/tools/install/testlib/vtable.dump (from r39376, trunk/t/tools/install/testlib/vtable.dump)
==============================================================================
--- /dev/null 00:00:00 1970 (empty, because file is newly added)
+++ branches/pmc_pct/t/tools/install/testlib/vtable.dump Thu Jun 4 02:32:48 2009 (r39377, copy of r39376, trunk/t/tools/install/testlib/vtable.dump)
@@ -0,0 +1,2 @@
+# $Id$
+
Modified: branches/pmc_pct/t/tools/ops2pm/05-renum_op_map_file.t
==============================================================================
--- branches/pmc_pct/t/tools/ops2pm/05-renum_op_map_file.t Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/t/tools/ops2pm/05-renum_op_map_file.t Thu Jun 4 02:32:48 2009 (r39377)
@@ -6,10 +6,9 @@
use strict;
use warnings;
-use Test::More qw(no_plan); # tests => 14;
+use Test::More tests => 6;
use Carp;
use Cwd;
-use File::Basename;
use File::Copy;
use File::Path qw( mkpath );
use File::Spec;
@@ -35,9 +34,6 @@
my $opsdir = File::Spec->catdir ( $tdir, 'src', 'ops' );
mkpath( $opsdir, 0, 755 ) or croak "Unable to make testing directory";
- ##### Test pre-Parrot 1.0 case
- my $major_version = 0;
-
##### Stage 1: Generate ops.num de novo #####
my @stage1 = qw(
@@ -56,7 +52,6 @@
src/ops/bit.ops
) ],
$numoutput,
- $major_version,
);
is($lastcode, q{bxors_s_s_sc},
"Stage 1: Got expected last opcode");
@@ -73,7 +68,6 @@
src/ops/bit.ops
) ],
$numoutput,
- $major_version,
);
is($lastcode, q{bxor_i_i_ic},
@@ -81,93 +75,6 @@
is($lastnumber, 172,
"Stage 2: Got expected last opcode number");
- ##### Stage 3: Add some opcodes and regenerate ops.num #####
-
- TODO: {
- local $TODO = 'Post 1.0 regeneration problematic, TT #469';
- my @stage3 = qw( pic_ops.original );
- copy_into_position($samplesdir, \@stage3, q{original}, $opsdir);
- ($lastcode, $lastnumber) = run_test_stage(
- [ qw(
- src/ops/core.ops
- src/ops/bit.ops
- src/ops/pic.ops
- ) ],
- $numoutput,
- $major_version,
- );
- is($lastcode, q{pic_callr___pc},
- "Stage 3: Got expected last opcode");
- is($lastnumber, 189,
- "Stage 3: Got expected last opcode number");
- }
-
- ##### Stage 4: Again generate ops.num de novo #####
-
- my @stage4 = qw(
- core_ops.original
- bit_ops.original
- ops_num.original
- );
- copy_into_position($samplesdir, \@stage4, q{original}, $opsdir);
- foreach my $f ( qw| core bit | ) {
- copy qq{$samplesdir/${f}_ops.original}, qq{src/ops/$f.ops.post}
- or croak "Unable to store $f for later testing: $!";
- }
- ($lastcode, $lastnumber) = run_test_stage(
- [ qw(
- src/ops/core.ops
- src/ops/bit.ops
- ) ],
- $numoutput,
- $major_version,
- );
- is($lastcode, q{bxors_s_s_sc},
- "Stage 4: Got expected last opcode");
- is($lastnumber, 177,
- "Stage 4: Got expected last opcode number");
-
- ##### Test post-Parrot 1.0 case
- $major_version = 1;
-
- ###### Stage 5: Delete some opcodes and regenerate ops.num #####
-
- TODO: {
- local $TODO = 'Post 1.0 regeneration should work just like pre-1.0 regeneration, TT #469';
- my @stage5 = qw( bit_ops.second );
- copy_into_position($samplesdir, \@stage5, q{second}, $opsdir);
- ($lastcode, $lastnumber) = run_test_stage(
- [ qw(
- src/ops/core.ops
- src/ops/bit.ops
- ) ],
- $numoutput,
- $major_version,
- );
- is($lastcode, q{bxor_i_ic_ic},
- "Stage 5: Got expected last opcode");
- is($lastnumber, 189,
- "Stage 5: Got expected last opcode number");
-
- ##### Stage 6: Add some opcodes and regenerate ops.num #####
-
- my @stage6 = qw( pic_ops.original );
- copy_into_position($samplesdir, \@stage6, q{original}, $opsdir);
- ($lastcode, $lastnumber) = run_test_stage(
- [ qw(
- src/ops/core.ops
- src/ops/bit.ops
- src/ops/pic.ops
- ) ],
- $numoutput,
- $major_version,
- );
- is($lastcode, q{pic_callr___pc},
- "Stage 6: Got expected last opcode: additions permitted");
- is($lastnumber, 194,
- "Stage 6: Got expected last opcode number: additions permitted");
- }
-
# Go back where we started to activate cleanup
chdir $cwd or croak "Unable to change back to starting directory: $!";
}
@@ -177,7 +84,7 @@
#################### SUBROUTINES ####################
sub run_test_stage {
- my ($opsfilesref, $numoutput, $major_version) = @_;
+ my ($opsfilesref, $numoutput) = @_;
my $self = Parrot::OpsRenumber->new(
{
argv => $opsfilesref,
@@ -190,7 +97,7 @@
);
$self->prepare_ops();
- $self->renum_op_map_file($major_version);
+ $self->renum_op_map_file();
my ($lastcode, $lastnumber) = get_last_opcode($numoutput);
return ($lastcode, $lastnumber);
}
Modified: branches/pmc_pct/t/tools/pmc2c.t
==============================================================================
--- branches/pmc_pct/t/tools/pmc2c.t Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/t/tools/pmc2c.t Thu Jun 4 02:32:48 2009 (r39377)
@@ -28,7 +28,7 @@
use Fatal qw{open close};
use Test::More;
-use Parrot::Test tests => 11;
+use Parrot::Test tests => 13;
use Parrot::Config;
my $pmc2c = join $PConfig{slash}, qw(. tools build pmc2c.pl);
@@ -149,8 +149,7 @@
pmc2c_output_like( <<'END_PMC', <<'END_C', 'maps' );
pmclass a hll dale maps Integer { }
END_PMC
- const INTVAL pmc_id = Parrot_get_HLL_id( interp, CONST_STRING_GEN(interp, "dale")
- );
+ const INTVAL pmc_id = Parrot_get_HLL_id( interp, CONST_STRING_GEN(interp, "dale"));
if (pmc_id > 0) {
Parrot_register_HLL_type( interp, pmc_id, enum_class_Integer, entry);
}
@@ -159,8 +158,7 @@
pmc2c_output_like( <<'END_PMC', <<'END_C', 'maps, more than one.' );
pmclass a hll dale maps Integer maps Float { }
END_PMC
- const INTVAL pmc_id = Parrot_get_HLL_id( interp, CONST_STRING_GEN(interp, "dale")
- );
+ const INTVAL pmc_id = Parrot_get_HLL_id( interp, CONST_STRING_GEN(interp, "dale"));
if (pmc_id > 0) {
Parrot_register_HLL_type( interp, pmc_id, enum_class_Float, entry);
Parrot_register_HLL_type( interp, pmc_id, enum_class_Integer, entry);
@@ -191,6 +189,53 @@
#line 4
END_C
+# test attr/comment line numbering
+pmc2c_output_like( <<'END_PMC', <<'END_C', 'line+pod' );
+pmclass a {
+ ATTR int foo;
+
+ /* Comment comment comment.
+ * Blah blah blah.
+ */
+
+ VTABLE void init() {
+ Parrot_a_attributes * attrs =
+ mem_allocate_zeroed_typed(Parrot_a_attributes);
+
+ attrs->hash = pmc_new(interp, enum_class_Hash);
+
+ PMC_data(SELF) = attrs;
+ }
+}
+END_PMC
+static void
+Parrot_a_init(PARROT_INTERP, PMC *pmc)
+{
+#line 8
+END_C
+
+# test EOF/coda line numbering
+# Note: We can't test the whole thing, as the filename component varies
+pmc2c_output_like( <<'END_PMC', <<'END_C', 'line+pod' );
+pmclass a {
+ ATTR int foo;
+
+ /* Comment comment comment.
+ * Blah blah blah.
+ */
+
+ VTABLE void init() {
+ PMC_data(SELF) = NULL;
+ }
+
+}
+
+/* foo bar */
+END_PMC
+} /* Parrot_a_class_init */
+#line 11
+END_C
+
# Local Variables:
# mode: cperl
# cperl-indent-level: 4
Modified: branches/pmc_pct/tools/build/c2str.pl
==============================================================================
--- branches/pmc_pct/tools/build/c2str.pl Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/tools/build/c2str.pl Thu Jun 4 02:32:48 2009 (r39377)
@@ -199,9 +199,9 @@
#ifndef PARROT_SRC_STRING_PRIVATE_CSTRING_H_GUARD
#define PARROT_SRC_STRING_PRIVATE_CSTRING_H_GUARD
-static const struct _cstrings {
+static PARROT_OBSERVER const struct _cstrings {
UINTVAL len;
- const char *string;
+ PARROT_OBSERVER const char *string;
} parrot_cstrings[] = {
{ 0, "" },
HEADER
Modified: branches/pmc_pct/tools/build/headerizer.pl
==============================================================================
--- branches/pmc_pct/tools/build/headerizer.pl Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/tools/build/headerizer.pl Thu Jun 4 02:32:48 2009 (r39377)
@@ -1,5 +1,5 @@
#! perl
-# Copyright (C) 2001-2007, Parrot Foundation.
+# Copyright (C) 2001-2009, Parrot Foundation.
# $Id$
use strict;
@@ -81,6 +81,7 @@
PARROT_DOES_NOT_RETURN
PARROT_DOES_NOT_RETURN_WHEN_FALSE
PARROT_MALLOC
+ PARROT_OBSERVER
);
main();
@@ -323,9 +324,9 @@
else {
# try to isolate the variable's name;
# strip off everything before the final space or asterisk.
- $var =~ s[.+[* ]([^* ]+)$][$1];
+ $var =~ s{.+[* ]([^* ]+)$}{$1};
# strip off a trailing "[]", if any.
- $var =~ s/\[\]$//;
+ $var =~ s{\[\]$}{};
}
push( @asserts, "PARROT_ASSERT_ARG($var)" );
}
Modified: branches/pmc_pct/tools/dev/install_dev_files.pl
==============================================================================
--- branches/pmc_pct/tools/dev/install_dev_files.pl Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/tools/dev/install_dev_files.pl Thu Jun 4 02:32:48 2009 (r39377)
@@ -46,9 +46,9 @@
=back
-=head2 See Also
+=head1 SEE ALSO
-See F<tools/dev/install_files.pl> for a detailed description of the MANIFEST
+See F<lib/Parrot/Manifest.pm> for a detailed description of the MANIFEST
format.
=cut
@@ -57,9 +57,13 @@
use strict;
use warnings;
-use File::Basename qw(dirname basename);
-use File::Copy;
-use File::Spec;
+use File::Basename qw(basename);
+use lib qw( lib );
+use Parrot::Install qw(
+ install_files
+ create_directories
+ lines_to_files
+);
# When run from the makefile, which is probably the only time this
# script will ever be used, all of these defaults will get overridden.
@@ -74,7 +78,9 @@
docdir => '/usr/share/doc', # parrot/ subdir added below
datadir => '/usr/share/', # parrot/ subdir added below
srcdir => '/usr/src/', # parrot/ subdir added below
+ versiondir => '',
'dry-run' => 0,
+ packages => 'devel|pct|tge|nqp',
);
my @manifests;
@@ -89,118 +95,88 @@
my $parrotdir = $options{versiondir};
-# We'll report multiple occurrences of the same file
-my %seen;
-
-my @files;
-my @installable_exe;
-my %directories;
- at ARGV = @manifests;
-while (<>) {
- chomp;
-
- s/\#.*//; # Ignore comments
- next if /^\s*$/; # Skip blank lines
-
- my ( $src, $meta, $dest ) = split( /\s+/, $_ );
- $dest ||= $src;
-
- if ( $seen{$src}++ ) {
- print STDERR "$ARGV:$.: Duplicate entry $src\n";
- }
-
- # Parse out metadata
- die "Malformed line in MANIFEST: $_" if not defined $meta;
- my $generated = $meta =~ s/^\*//;
- my ($package) = $meta =~ /^\[(.*?)\]/;
- $meta =~ s/^\[(.*?)\]//;
- next unless $package; # Skip if this file belongs to no package
-
- next unless $package =~ /devel|pct|tge|nqp/;
-
- my %meta;
- @meta{ split( /,/, $meta ) } = ();
- $meta{$_} = 1 for ( keys %meta ); # Laziness
-
- if ( $meta{lib} ) {
- $dest = File::Spec->catdir( $options{libdir}, $parrotdir, "tools", $dest );
- }
- elsif ( $meta{share} ) {
- $dest = File::Spec->catdir( $options{datadir}, $parrotdir, basename($dest) );
- }
- elsif ( $meta{include} ) {
- $dest =~ s/^src//; # strip off leading src/ dir
- $dest =~ s/^include//;
- $dest = File::Spec->catdir( $options{includedir}, $parrotdir, $dest );
- }
- elsif ( $meta{src} ) {
- $dest =~ s/^src//; # strip off leading src/ dir
- $dest = File::Spec->catdir( $options{srcdir}, $parrotdir, $dest );
- }
- elsif ( $meta{doc} ) {
- $dest =~ s/^docs/pod/; # docs dir are actually raw Pod
- $dest = File::Spec->catdir( $options{docdir}, $parrotdir, $dest );
- }
- elsif ( /^runtime/ ) {
- $dest =~ s/^runtime\/parrot\///;
- $dest = File::Spec->catdir( $options{libdir}, $parrotdir, $dest );
- }
- elsif ( /^tools/ ) {
- $dest = File::Spec->catdir( $options{libdir}, $parrotdir, $dest );
- }
- elsif ( /^VERSION/ ) {
- $dest = File::Spec->catdir( $options{libdir}, $parrotdir, $dest );
- }
- elsif ( /^compilers/ ) {
- $dest =~ s/^compilers/languages/;
- $dest = File::Spec->catdir( $options{libdir}, $parrotdir, $dest );
- }
- else {
- die "Unknown file type in MANIFEST: $_";
- }
-
- $dest = File::Spec->catdir( $options{buildprefix}, $dest )
- if $options{buildprefix};
+# Set up transforms on filenames
+my(@transformorder) = (qw(lib share include src doc), '^(tools|VERSION)', '^compilers');
+my(%metatransforms) = (
+ lib => {
+ ismeta => 1,
+ optiondir => 'lib',
+ transform => sub {
+ my($filehash) = @_;
+ $filehash->{DestDirs} = [$parrotdir, "tools"];
+ return($filehash);
+ },
+ },
+ share => {
+ ismeta => 1,
+ optiondir => 'data',
+ transform => sub {
+ my($filehash) = @_;
+ $filehash->{Dest} = basename($filehash->{Dest});
+ $filehash->{DestDirs} = [$parrotdir];
+ return($filehash);
+ },
+ },
+ include => {
+ ismeta => 1,
+ optiondir => 'include',
+ transform => sub {
+ my($filehash) = @_;
+ $filehash->{Dest} =~ s/^src//; # strip off leading src/ dir
+ $filehash->{Dest} =~ s/^include//;
+ $filehash->{DestDirs} = [$parrotdir];
+ return($filehash);
+ },
+ },
+ src => {
+ ismeta => 1,
+ optiondir => 'src',
+ transform => sub {
+ my($filehash) = @_;
+ $filehash->{Dest} =~ s/^src//; # strip off leading src/ dir
+ $filehash->{DestDirs} = [$parrotdir];
+ return($filehash);
+ },
+ },
+ doc => {
+ ismeta => 1,
+ optiondir => 'doc',
+ transform => sub {
+ my($filehash) = @_;
+ $filehash->{Dest} =~ s/^docs/pod/; # other docs are actually raw Pod
+ $filehash->{DestDirs} = [$parrotdir];
+ return($filehash);
+ },
+ },
+ '^(tools|VERSION)' => {
+ optiondir => 'lib',
+ transform => sub {
+ my($filehash) = @_;
+ $filehash->{DestDirs} = [$parrotdir];
+ return($filehash);
+ },
+ },
+ '^compilers' => {
+ optiondir => 'lib',
+ transform => sub {
+ my($filehash) = @_;
+ $filehash->{Dest} =~ s/^compilers/languages/;
+ $filehash->{DestDirs} = [$parrotdir];
+ return($filehash);
+ },
+ },
+);
- $directories{ dirname($dest) } = 1;
- push( @files, [ $src => $dest ] );
-}
-continue {
- close ARGV if eof; # Reset line numbering for each input file
-}
+my($filehashes, $directories) = lines_to_files(
+ \%metatransforms, \@transformorder, \@manifests, \%options, $parrotdir
+);
unless ( $options{'dry-run'} ) {
- for my $dir ( map { $options{destdir} . $_ } keys %directories ) {
- unless ( -d $dir ) {
-
- # Make full path to the directory $dir
- my @dirs;
- while ( !-d $dir ) { # Scan up to nearest existing ancestor
- unshift @dirs, $dir;
- $dir = dirname($dir);
- }
- foreach (@dirs) {
- mkdir( $_, 0777 ) or die "mkdir $_: $!\n";
- }
- }
- }
-}
-print("Installing ...\n");
-foreach ( @files, @installable_exe ) {
- my ( $src, $dest ) = @$_;
- $dest = $options{destdir} . $dest;
- if ( $options{'dry-run'} ) {
- print "$src -> $dest\n";
- next;
- }
- else {
- next unless -e $src;
- copy( $src, $dest ) or die "copy $src to $dest: $!\n";
- print "$dest\n";
- }
- my $mode = ( stat($src) )[2];
- chmod $mode, $dest;
+ create_directories($options{destdir}, $directories);
}
+install_files($options{destdir}, $options{'dry-run'}, $filehashes);
+
+print "Finished install_dev_files.pl\n";
# Local Variables:
# mode: cperl
Modified: branches/pmc_pct/tools/dev/install_files.pl
==============================================================================
--- branches/pmc_pct/tools/dev/install_files.pl Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/tools/dev/install_files.pl Thu Jun 4 02:32:48 2009 (r39377)
@@ -1,199 +1,9 @@
#! perl
################################################################################
-# Copyright (C) 2001-2008, Parrot Foundation.
+# Copyright (C) 2001-2009, Parrot Foundation.
# $Id$
################################################################################
-use strict;
-use warnings;
-use File::Basename qw(dirname basename);
-use File::Copy;
-use File::Spec;
-
-# When run from the makefile, which is probably the only time this
-# script will ever be used, all of these defaults will get overridden.
-my %options = (
- buildprefix => '',
- prefix => '/usr',
- destdir => '',
- exec_prefix => '/usr',
- bindir => '/usr/bin',
- libdir => '/usr/lib', # parrot/ subdir added below
- includedir => '/usr/include', # parrot/ subdir added below
- docdir => '/usr/share/doc', # parrot/ subdir added below
- version => '',
- 'dry-run' => 0,
-);
-
-my @manifests;
-foreach my $arg (@ARGV) {
- if ( $arg =~ m/^--([^=]+)=(.*)/ ) {
- $options{$1} = $2;
- }
- else {
- push @manifests, $arg;
- }
-}
-
-my $parrotdir = $options{versiondir};
-
-# We'll report multiple occurrences of the same file
-my %seen;
-
-my @files;
-my @installable_exe;
-my %directories;
- at ARGV = @manifests;
-while (<>) {
- chomp;
-
- s/\#.*//; # Ignore comments
- next if /^\s*$/; # Skip blank lines
-
- my ( $src, $meta, $dest ) = split( /\s+/, $_ );
- $dest ||= $src;
-
- if ( $seen{$src}++ ) {
- print STDERR "$ARGV:$.: Duplicate entry $src\n";
- }
-
- # Parse out metadata
- die "Malformed line in MANIFEST: $_" if not defined $meta;
- my $generated = $meta =~ s/^\*//;
- my ($package) = $meta =~ /^\[(.*?)\]/;
- $meta =~ s/^\[(.*?)\]//;
- next unless $package; # Skip if this file belongs to no package
-
- next unless $package =~ /main|library|pge/;
-
- my %meta;
- @meta{ split( /,/, $meta ) } = ();
- $meta{$_} = 1 for ( keys %meta ); # Laziness
-
- if ( /^runtime/ ) {
- # have to catch this case early.
- $dest =~ s/^runtime\/parrot\///;
- $dest = File::Spec->catdir( $options{libdir}, $parrotdir, $dest );
- }
- elsif ( $meta{lib} ) {
- if ( $dest =~ /^install_/ ) {
- $dest =~ s/^install_//; # parrot with different config
- $dest = File::Spec->catdir( $options{libdir}, $parrotdir, 'include', $dest );
- }
- else {
- # don't allow libraries to be installed into subdirs of libdir
- $dest = File::Spec->catdir( $options{libdir}, basename($dest) );
- }
- }
- elsif ( $meta{bin} ) {
- my $copy = $dest;
- $dest =~ s/^installable_//; # parrot with different config
- $dest = File::Spec->catdir( $options{bindir}, $dest );
- # track bin here to check later below
- # https://trac.parrot.org/parrot/ticket/434
- if ( $copy =~ /^installable/ ) {
- push @installable_exe, [ $src, $dest ];
- next;
- }
- }
- elsif ( $meta{include} ) {
- $dest =~ s/^include//;
- $dest = File::Spec->catdir( $options{includedir}, $parrotdir, $dest );
- }
- elsif ( $meta{doc} ) {
- $dest =~ s/^docs\/resources/resources/; # resources go in the top level of docs
- $dest =~ s/^docs/pod/; # other docs are actually raw Pod
- $dest = File::Spec->catdir( $options{docdir}, $parrotdir, $dest );
- }
- elsif ( $meta{pkgconfig} ) {
-
- # For the time being this is hardcoded as being installed under libdir
- # as it is typically done with automake installed packages. If there
- # is a use case to make this configurable we'll add a seperate
- # --pkgconfigdir option.
- $dest = File::Spec->catdir( $options{libdir}, 'pkgconfig', $parrotdir, $dest );
- }
- elsif ( /^compilers/ ) {
- $dest =~ s/^compilers/languages/;
- $dest = File::Spec->catdir( $options{libdir}, $parrotdir, $dest );
- }
- else {
- die "Unknown install location in MANIFEST: $_";
- }
-
- $dest = File::Spec->catdir( $options{buildprefix}, $dest )
- if $options{buildprefix};
-
- $directories{ dirname($dest) } = 1;
- push( @files, [ $src => $dest ] );
-}
-continue {
- close ARGV if eof; # Reset line numbering for each input file
-}
-
-unless ( $options{'dry-run'} ) {
- for my $dir ( map { $options{destdir} . $_ } keys %directories ) {
- unless ( -d $dir ) {
-
- # Make full path to the directory $dir
- my @dirs;
- while ( !-d $dir ) { # Scan up to nearest existing ancestor
- unshift @dirs, $dir;
- $dir = dirname($dir);
- }
- foreach my $d (@dirs) {
- mkdir( $d, 0777 ) or die "mkdir $d: $!\n";
- }
- }
- }
-}
-
-for my $iref (@installable_exe) {
- my ( $i, $dest ) = @{ $iref };
- my ($file) = $i =~ /installable_(.+)$/;
- next unless $file;
- my @f = map { $_ ? $_->[0] : '' } @files;
- if (grep(/^$file$/, @f)) {
- if (-e $file) {
- print "skipping $file, using installable_$file instead\n";
- @files = map {$_ and $_->[0] !~ /^$file$/ ? $_ : undef} @files;
- }
- }
-}
-# for every .exe check if there's an installable. Fail if not
-foreach my $fref (@files ) {
- next unless $fref;
- my ( $src, $dest ) = @{ $fref };
- my $i;
- # This logic will fail on non-win32 if the generated files are really
- # generated as with rt #40817. We don't have [main]bin here.
- $i = "installable_$src" if $src =~ /\.exe$/;
- next unless $i;
- unless (map {$_->[0] =~ /^$i$/} @installable_exe) {
- die "$i is missing in MANIFEST or MANIFEST.generated\n";
- }
-}
-print("Installing ...\n");
-foreach my $fref ( @files, @installable_exe ) {
- next unless $fref;
- my ( $src, $dest ) = @{ $fref };
- $dest = $options{destdir} . $dest;
- if ( $options{'dry-run'} ) {
- print "$src -> $dest\n";
- next;
- }
- else {
- next unless -e $src;
- next if $^O eq 'cygwin' and -e "$src.exe"; # stat works, copy not
- copy( $src, $dest ) or die "copy $src to $dest: $!\n";
- print "$dest\n";
- }
- my $mode = ( stat($src) )[2];
- chmod $mode, $dest;
-}
-
-################################################################################
-
=head1 TITLE
tools/dev/install_files.pl - Copy files to their correct locations
@@ -236,67 +46,171 @@
=back
-=head2 MANIFEST Format
-
-The format of the MANIFEST (currently MANIFEST and MANIFEST.generated
-are used) is:
-
- source_path <whitespace> [package]meta1,meta2,...
-
-or you may optionally specify a different destination path:
-
- source_path <whitespace> [package]meta1,meta2,... <whitespace> destination
-
-Additionally, there may be a * in front of the whole line to designate
-a generated file:
-
- source_path <whitespace> *[package]meta1,meta2,... <whitespace> destination
-
-The square brackets around C<package> are literal. C<package> gives
-the name of the RPM that the given file will be installed for, and is
-only used by this script to skip files that are not members of any
-package.
-
-The various meta flags recognized are:
-
-=over 4
-
-=item C<doc>
-
-Tag this file with %doc in the RPM, and omit the leading path (because
-rpm will put it into a directory of its choosing)
+=head1 SEE ALSO
-=item C<include>
+See F<lib/Parrot/Manifest.pm> for a detailed description of the MANIFEST
+format.
-Write this file to the location given by the C<--includedir> option
+F<tools/dev/mk_manifests.pl>
-=item C<lib>
+=cut
-Write this file to the location given by the C<--libdir> option
+################################################################################
-=item C<bin>
+use strict;
+use warnings;
+use File::Basename qw(basename);
+use lib qw( lib );
+use Parrot::Install qw(
+ install_files
+ create_directories
+ lines_to_files
+);
-Write this file to the location given by the C<--bindir> option
+# When run from the makefile, which is probably the only time this
+# script will ever be used, all of these defaults will get overridden.
+my %options = (
+ buildprefix => '',
+ prefix => '/usr',
+ destdir => '',
+ exec_prefix => '/usr',
+ bindir => '/usr/bin',
+ libdir => '/usr/lib', # parrot/ subdir added below
+ includedir => '/usr/include', # parrot/ subdir added below
+ docdir => '/usr/share/doc', # parrot/ subdir added below
+ versiondir => '',
+ 'dry-run' => 0,
+ packages => 'main|library|pge',
+);
-=back
+my @manifests;
+foreach (@ARGV) {
+ if (/^--([^=]+)=(.*)/) {
+ $options{$1} = $2;
+ }
+ else {
+ push @manifests, $_;
+ }
+}
-The optional C<destination> field provides a general way to change
-where a file will be written to. It will be applied before any
-metadata tags.
+my $parrotdir = $options{versiondir};
-Example: if this line is in the MANIFEST.generated file
+# Set up transforms on filenames
+my(@transformorder) = qw(lib bin include doc pkgconfig ^compilers);
+my(%metatransforms) = (
+ lib => {
+ ismeta => 1,
+ optiondir => 'lib',
+ transform => sub {
+ my($filehash) = @_;
+ local($_) = $filehash->{Dest};
+ if ( /^install_/ ) {
+ s/^install_//; # parrot with different config
+ $filehash->{DestDirs} = [$parrotdir, 'include'];
+ $filehash->{Dest} = $_;
+ }
+ else {
+ # don't allow libraries to be installed into subdirs of libdir
+ $filehash->{Dest} = basename($_);
+ }
+ return($filehash);
+ },
+ },
+ bin => {
+ ismeta => 1,
+ optiondir => 'bin',
+ transform => sub {
+ my($filehash) = @_;
+ # parrot with different config
+ $filehash->{Installable} = $filehash->{Dest} =~ s/^installable_//;
+ return($filehash);
+ },
+ isbin => 1,
+ },
+ include => {
+ ismeta => 1,
+ optiondir => 'include',
+ transform => sub {
+ my($filehash) = @_;
+ $filehash->{Dest} =~ s/^include//;
+ $filehash->{DestDirs} = [$parrotdir];
+ return($filehash);
+ },
+ },
+ doc => {
+ ismeta => 1,
+ optiondir => 'doc',
+ transform => sub {
+ my($filehash) = @_;
+ $filehash->{Dest} =~ s#^docs/resources#resources#; # resources go in the top level of docs
+ $filehash->{Dest} =~ s/^docs/pod/; # other docs are actually raw Pod
+ $filehash->{DestDirs} = [$parrotdir];
+ return($filehash);
+ },
+ },
+ pkgconfig => {
+ ismeta => 1,
+ optiondir => 'lib',
+ transform => sub {
+ my($filehash) = @_;
+ # For the time being this is hardcoded as being installed under
+ # libdir as it is typically done with automake installed packages.
+ # If there is a use case to make this configurable we'll add a
+ # seperate --pkgconfigdir option.
+ $filehash->{DestDirs} = ['pkgconfig', $parrotdir];
+ return($filehash);
+ },
+ },
+ '^compilers' => {
+ optiondir => 'lib',
+ transform => sub {
+ my($filehash) = @_;
+ $filehash->{Dest} =~ s/^compilers/languages/;
+ $filehash->{DestDirs} = [$parrotdir];
+ return($filehash);
+ },
+ },
+);
- languages/snorkfest/snork-compile [main]bin
+my($filehashes, $directories) = lines_to_files(
+ \%metatransforms, \@transformorder, \@manifests, \%options, $parrotdir
+);
-and the --bindir=/usr/parroty/bin, then the generated
-parrot-<VERSION>-1.<arch>.rpm file will contain the file
-/usr/parroty/bin/snork-compile.
+unless ( $options{'dry-run'} ) {
+ create_directories($options{destdir}, $directories);
+}
-=head1 SEE ALSO
+# TT #347
+# 1. skip build_dir-only binaries for files marked Installable
+my($filehash, @removes, $removes);
+foreach $filehash (grep { $_->{Installable} } @$filehashes) {
+ my( $src, $dest ) = map { $filehash->{$_} } qw(Source Dest);
+ my ($file) = $src =~ /installable_(.+)$/;
+ next unless $file;
+ if((grep { $_->{Source} =~ /^$file$/ } @$filehashes) and -e $file) {
+ print "skipping $file, using installable_$file instead\n";
+ push @removes, $file;
+ }
+}
+$removes = join '|', @removes;
+@$filehashes = grep { $_->{Source} !~ /^($removes)$/ } @$filehashes;
+
+# 2. for every .exe check if there's an installable. Fail if not
+my $i;
+foreach $filehash (grep { ! $_->{Installable} } @$filehashes ) {
+ my( $src, $dest ) = map { $filehash->{$_} } qw(Source Dest);
+ next unless $src =~ /\.exe$/;
+ # This logic will fail on non-win32 if the generated files are really
+ # generated as with rt #40817. We don't have [main]bin here.
+ $i = "installable_$src";
+ unless (map {$_->{Source} =~ /^$i$/} grep { $_->{Installable} } @$filehashes) {
+ die "$i is missing in MANIFEST or MANIFEST.generated\n";
+ }
+}
-F<tools/dev/mk_manifests.pl>
+install_files($options{destdir}, $options{'dry-run'}, $filehashes);
-=cut
+print "Finished install_files.pl\n";
# Local Variables:
# mode: cperl
Modified: branches/pmc_pct/tools/dev/mk_language_shell.pl
==============================================================================
--- branches/pmc_pct/tools/dev/mk_language_shell.pl Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/tools/dev/mk_language_shell.pl Thu Jun 4 02:32:48 2009 (r39377)
@@ -318,8 +318,7 @@
CFLAGS := @ccflags@ @cc_shared@ @cc_debug@ @ccwarn@ @cc_hasjit@ @cg_flag@ @gc_flag@
CC_OUT := @cc_o_out@
LD_OUT := @ld_out@
-#IF(parrot_is_shared):LIBPARROT := @inst_libparrot_ldflags@
-#ELSE:LIBPARROT :=
+LIBPARROT := @inst_libparrot_ldflags@
OPS2C := $(PERL) $(LIB_DIR)/tools/build/ops2c.pl
@@ -411,8 +410,7 @@
CFLAGS := @ccflags@ @cc_shared@ @cc_debug@ @ccwarn@ @cc_hasjit@ @cg_flag@ @gc_flag@
CC_OUT := @cc_o_out@
LD_OUT := @ld_out@
-#IF(parrot_is_shared):LIBPARROT := @inst_libparrot_ldflags@
-#ELSE:LIBPARROT :=
+LIBPARROT := @inst_libparrot_ldflags@
PMC2C_INCLUDES := --include $(SRC_DIR) --include $(SRC_DIR)/pmc
PMC2C := $(PERL) $(LIB_DIR)/tools/build/pmc2c.pl
@@ -494,7 +492,7 @@
VERSION := @versiondir@
BIN_DIR := @bindir@
LIB_DIR := @libdir@$(VERSION)
-DOC_DIR := @doc_dir@$(VERSION)
+DOC_DIR := @docdir@$(VERSION)
MANDIR := @mandir@$(VERSION)
# Set up extensions
Modified: branches/pmc_pct/tools/dev/opsrenumber.pl
==============================================================================
--- branches/pmc_pct/tools/dev/opsrenumber.pl Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/tools/dev/opsrenumber.pl Thu Jun 4 02:32:48 2009 (r39377)
@@ -6,7 +6,6 @@
use warnings;
use lib 'lib';
-use Parrot::Config qw( %PConfig );
use Parrot::OpsRenumber;
my $self = Parrot::OpsRenumber->new(
@@ -21,7 +20,7 @@
);
$self->prepare_ops();
-$self->renum_op_map_file($PConfig{MAJOR});
+$self->renum_op_map_file();
exit 0;
@@ -41,8 +40,15 @@
All opcodes except the first seven are potentially deletable and the opcodes'
order may be rearranged. However, in and after Parrot 1.0.0, deletion of
-opcodes should be a rare event. New opcodes should be added at the end of the
-list.
+opcodes should be a rare event. The program will automatically detect which
+opcodes have been deleted and will renumber the remaining codes appropriately.
+
+The program, however, will B<not> automatically detect new opcodes. This is
+a feature, not a bug, as it is intended to require someone to think about why
+new opcodes should be added. Once a decision to add new opcodes has been
+made, those opcodes should be entered manually at the endc of
+F<src/ops/ops.num>, then F<tools/dev/opsrenumber.pl> (or F<make opsrenumber>)
+should be run.
=head1 SEE ALSO
Modified: branches/pmc_pct/tools/dev/pbc_to_exe.pir
==============================================================================
--- branches/pmc_pct/tools/dev/pbc_to_exe.pir Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/tools/dev/pbc_to_exe.pir Thu Jun 4 02:32:48 2009 (r39377)
@@ -18,8 +18,6 @@
=cut
-.include 'library/config.pir'
-
.sub 'main' :main
.param pmc argv
.local string infile
@@ -29,11 +27,25 @@
.local string out
.local int closeresult
+ .local string gcc
+ .local int is_gcc
+ load_bytecode 'config.pbc'
+ $P0 = '_config'()
+ gcc = $P0['gccversion']
+ $I0 = length gcc
+ is_gcc = $I0 > 0
+
(infile, cfile, objfile, exefile) = 'handle_args'(argv)
unless infile > '' goto err_infile
.local string codestring
+ unless is_gcc goto code_for_non_gcc
+ code_for_gcc:
+ codestring = 'generate_code_gcc'(infile)
+ goto code_end
+ code_for_non_gcc:
codestring = 'generate_code'(infile)
+ code_end:
open_outfile:
.local pmc outfh
@@ -221,6 +233,91 @@
die "cannot open infile"
.end
+# The PBC will be represented as a C string, so this sub builds a table
+# of the C representation of each ASCII character, for lookup by ordinal value.
+.sub 'generate_encoding_table'
+ # Use '\%o' for speed, or '\x%02x' for readability
+ .const string encoding_format = '\%o'
+
+ # The 'sprintf' op requires the arglist to be in an array, even when
+ # there is only one arg.
+ .local pmc one_number
+ one_number = new 'FixedIntegerArray'
+ set one_number, 1
+
+ .local pmc coded_strings
+ coded_strings = new 'FixedStringArray'
+ set coded_strings, 256
+
+ .local int index
+ index = 0
+
+ next_index:
+ one_number[0] = index
+ $S0 = sprintf encoding_format, one_number
+ coded_strings[index] = $S0
+ inc index
+ if index < 256 goto next_index
+
+ .return (coded_strings)
+.end
+
+.sub 'generate_code_gcc'
+ .param string infile
+ .local pmc ifh
+ ifh = open infile, 'r'
+ unless ifh goto err_infile
+
+ .local pmc encoding_table
+ encoding_table = 'generate_encoding_table'()
+
+ .local string codestring
+ .local int size
+ codestring = "const char * program_code =\n"
+ codestring .= '"'
+ size = 0
+
+ read_loop:
+ .local string pbcstring
+ .local int pbclength
+
+ pbcstring = read ifh, 16384
+ pbclength = length pbcstring
+ unless pbclength > 0 goto read_done
+
+ .local int pos
+ pos = 0
+ code_loop:
+ unless pos < pbclength goto code_done
+ $I0 = ord pbcstring, pos
+ $S0 = encoding_table[$I0]
+ codestring .= $S0
+ inc pos
+ inc size
+ $I0 = size % 32
+ unless $I0 == 0 goto code_loop
+ codestring .= '"'
+ codestring .= "\n"
+ codestring .= '"'
+ goto code_loop
+ code_done:
+ goto read_loop
+
+ read_done:
+ close ifh
+
+ codestring .= '"'
+ codestring .= "\n;\n\n"
+ codestring .= "const int bytecode_size = "
+ $S0 = size
+ codestring .= $S0
+ codestring .= ";\n"
+ .return (codestring)
+
+ err_infile:
+ die "cannot open infile"
+.end
+
# util functions
.sub 'compile_file'
.param string cfile
@@ -284,7 +381,7 @@
link_dynamic = $P0['link_dynamic']
linkflags = $P0['linkflags']
ld_out = $P0['ld_out']
- libparrot = $P0['libparrot_ldflags']
+ libparrot = $P0['libparrot_linkflags']
libs = $P0['libs']
o = $P0['o']
rpath = $P0['rpath_blib']
Modified: branches/pmc_pct/tools/install/smoke_languages.pl
==============================================================================
--- branches/pmc_pct/tools/install/smoke_languages.pl Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/tools/install/smoke_languages.pl Thu Jun 4 02:32:48 2009 (r39377)
@@ -340,7 +340,7 @@
or die "Can't open $filename ($!).\n";
print $FH q{"Hello, world!\n"};
close $FH;
-$out = `$parrot $langdir/primitivearc/arc.pbc $filename`;
+$out = `$parrot $langdir/primitivearc/primitivearc.pbc $filename`;
ok($out eq "Hello, world!\n\n", "check primitivearc");
unlink($filename);
}
Modified: branches/pmc_pct/tools/util/release.json
==============================================================================
--- branches/pmc_pct/tools/util/release.json Thu Jun 4 02:08:48 2009 (r39376)
+++ branches/pmc_pct/tools/util/release.json Thu Jun 4 02:32:48 2009 (r39377)
@@ -1,9 +1,9 @@
{
- "release.version" : "1.1.0",
- "release.name" : "Half-moon Conure",
+ "release.version" : "1.2.0",
+ "release.name" : "Bird Brain",
"release.day" : "Tuesday",
- "release.date" : "21 April 2009",
- "release.nextdate" : "19 May 2009",
+ "release.date" : "19 May 2009",
+ "release.nextdate" : "16 June 2009",
"web.root" : "http://parrot.org/",
"web.source" : "download",
@@ -11,13 +11,13 @@
"web.repository" : "https://svn.parrot.org/parrot/trunk/",
"bugday.day" : "Saturday",
- "bugday.date" : "16 May 2009",
+ "bugday.date" : "13 June 2009",
"wiki.root" : "https://trac.parrot.org/parrot/wiki/",
- "wiki.bugday" : "bug_day_2009_05_16",
+ "wiki.bugday" : "bug_day_2009_06_13",
"cpan.search" : "http://search.cpan.org/dist/parrot",
- "ftp.path" : "ftp://ftp.parrot.org/pub/parrot/releases/devel/1.1.0/",
+ "ftp.path" : "ftp://ftp.parrot.org/pub/parrot/releases/devel/1.2.0/",
"subversion.root" : "http://subversion.tigris.org/",
"svk.root" : "http://svk.bestpractical.com/"
}
More information about the parrot-commits
mailing list