Author: tewk
Date: Fri Jun 1 17:26:39 2007
New Revision: 18738
Added:
branches/pmc2c/languages/lisp/t/arithmetics.t
- copied unchanged from r18737, /trunk/languages/lisp/t/arithmetics.t
Modified:
branches/pmc2c/DEPRECATED.pod
branches/pmc2c/MANIFEST
branches/pmc2c/META.yml
branches/pmc2c/compilers/imcc/imc.h
branches/pmc2c/compilers/imcc/parser_util.c
branches/pmc2c/config/auto/gcc.pm
branches/pmc2c/config/init/hints/linux.pm
branches/pmc2c/include/parrot/builtin.h
branches/pmc2c/include/parrot/exceptions.h
branches/pmc2c/include/parrot/interpreter.h
branches/pmc2c/include/parrot/io.h
branches/pmc2c/include/parrot/pic.h
branches/pmc2c/languages/lisp/lib/Parrot/Test/Lisp.pm
branches/pmc2c/languages/lisp/lisp/bootstrap.l
branches/pmc2c/languages/lisp/t/atoms.t
branches/pmc2c/languages/lisp/t/hello.t
branches/pmc2c/languages/lua/lua.pir
branches/pmc2c/languages/lua/src/POSTGrammar.tg
branches/pmc2c/languages/t/harness
branches/pmc2c/src/debug.c
branches/pmc2c/src/exceptions.c
branches/pmc2c/src/gc/register.c
branches/pmc2c/src/hash.c
branches/pmc2c/src/inter_misc.c
branches/pmc2c/src/io/io.c
branches/pmc2c/src/objects.c
branches/pmc2c/src/packfile.c
branches/pmc2c/src/pic.c
branches/pmc2c/src/pic_jit.c
branches/pmc2c/src/pmc/addrregistry.pmc
branches/pmc2c/src/pmc/os.pmc
branches/pmc2c/src/pmc/sub.pmc
branches/pmc2c/src/pmc_freeze.c
Log:
[Pmc2c] Merge 18715-18737
Modified: branches/pmc2c/DEPRECATED.pod
==============================================================================
--- branches/pmc2c/DEPRECATED.pod (original)
+++ branches/pmc2c/DEPRECATED.pod Fri Jun 1 17:26:39 2007
@@ -11,14 +11,7 @@
=head1 Deprecated C APIs
-=over 4
-
-=item enter_nci_method
-
-This function is being renamed to register_nci_method. The original name was
-confusing (see #40801).
-
-=back
+Currently no C APIs are deprecated.
=head1 Deprecated methods
Modified: branches/pmc2c/MANIFEST
==============================================================================
--- branches/pmc2c/MANIFEST (original)
+++ branches/pmc2c/MANIFEST Fri Jun 1 17:26:39 2007
@@ -1411,6 +1411,7 @@
languages/lisp/lisp/pred.l [lisp]
languages/lisp/read.pir [lisp]
languages/lisp/system.pir [lisp]
+languages/lisp/t/arithmetics.t [lisp]
languages/lisp/t/atoms.t [lisp]
languages/lisp/t/harness [lisp]
languages/lisp/t/hello.t [lisp]
Modified: branches/pmc2c/META.yml
==============================================================================
--- branches/pmc2c/META.yml (original)
+++ branches/pmc2c/META.yml Fri Jun 1 17:26:39 2007
@@ -27,10 +27,7 @@
- Parrot::OpTrans::CGP
- Parrot::OpTrans::CSwitch
- Parrot::OpTrans::Compiled
- - Perl::Critic::Policy::CodeLayout::UseParrotCoda
- Parrot::OpsFile
- namespace:
- - Parrot::Configure
resources:
homepage: http://parrotcode.org/
bugtracker: https://rt.perl.org/rt3/
Modified: branches/pmc2c/compilers/imcc/imc.h
==============================================================================
--- branches/pmc2c/compilers/imcc/imc.h (original)
+++ branches/pmc2c/compilers/imcc/imc.h Fri Jun 1 17:26:39 2007
@@ -92,7 +92,7 @@
PARROT_API void imcc_init(Parrot_Interp interp);
PARROT_API void imcc_destroy(Parrot_Interp interp);
int check_op(Interp *, char * fullname, char *op, SymReg *r[], int narg, int
keyvec);
-int is_op(Interp *, char *);
+int is_op(Interp *, const char *opname);
char *str_dup(const char *);
char *str_cat(const char *, const char *);
int imcc_vfprintf(Interp *, FILE *fd, const char *format, va_list ap);
Modified: branches/pmc2c/compilers/imcc/parser_util.c
==============================================================================
--- branches/pmc2c/compilers/imcc/parser_util.c (original)
+++ branches/pmc2c/compilers/imcc/parser_util.c Fri Jun 1 17:26:39 2007
@@ -227,7 +227,7 @@
* Is instruction a parrot opcode?
*/
int
-is_op(Interp *interp, char *name)
+is_op(Interp *interp, const char *name)
{
int (*op_lookup)(const char *, int full) =
interp->op_lib->op_code;
Modified: branches/pmc2c/config/auto/gcc.pm
==============================================================================
--- branches/pmc2c/config/auto/gcc.pm (original)
+++ branches/pmc2c/config/auto/gcc.pm Fri Jun 1 17:26:39 2007
@@ -132,6 +132,7 @@
# We shouldn't be using __packed__, but I doubt -Wpacked will harm
# us -Wpadded may prove interesting, or even noisy.
# -Wunreachable-code might be useful in a non debugging version
+ 4.0 => "-fvisibility=hidden",
);
my @cage_opt_and_vers = (
0 =>
@@ -265,6 +266,9 @@
HAS_aligned_funcptr => 1
);
+ $conf->data->set( sym_export => '__attribute__ ((visibility("default")))' )
+ if $gccversion > 4.0;
+
$conf->data->set( HAS_aligned_funcptr => 0 )
if $^O eq 'hpux';
Modified: branches/pmc2c/config/init/hints/linux.pm
==============================================================================
--- branches/pmc2c/config/init/hints/linux.pm (original)
+++ branches/pmc2c/config/init/hints/linux.pm Fri Jun 1 17:26:39 2007
@@ -52,9 +52,6 @@
}
}
else {
- # hide non-exported symbols
- $cflags .= ' -fvisibility=hidden';
-
if ( $ld_share_flags !~ /-fPIC/ ) {
$ld_share_flags .= ' -fPIC';
}
@@ -90,7 +87,6 @@
libparrot_shared => 'libparrot$(SHARE_EXT).$(SOVERSION)',
libparrot_shared_alias => 'libparrot$(SHARE_EXT)',
libparrot_soname =>
'-Wl,-soname=libparrot$(SHARE_EXT).$(SOVERSION)',
- sym_export => '__attribute__ ((visibility("default")))',
);
if ( ( split( '-', $Config{archname} ) )[0] eq 'ia64' ) {
Modified: branches/pmc2c/include/parrot/builtin.h
==============================================================================
--- branches/pmc2c/include/parrot/builtin.h (original)
+++ branches/pmc2c/include/parrot/builtin.h Fri Jun 1 17:26:39 2007
@@ -17,8 +17,7 @@
void Parrot_init_builtins(Interp *interp);
int Parrot_is_builtin(Interp *interp, const char *func, const char *sig)
- __attribute__nonnull__(2)
- __attribute__nonnull__(3);
+ __attribute__nonnull__(2);
PMC* Parrot_find_builtin(Interp *interp, STRING *func)
__attribute__nonnull__(2);
const char * Parrot_builtin_get_c_namespace(Interp *interp, int bi);
Modified: branches/pmc2c/include/parrot/exceptions.h
==============================================================================
--- branches/pmc2c/include/parrot/exceptions.h (original)
+++ branches/pmc2c/include/parrot/exceptions.h Fri Jun 1 17:26:39 2007
@@ -1,5 +1,5 @@
/* exceptions.h
- * Copyright (C) 2001-2003, The Perl Foundation.
+ * Copyright (C) 2001-2007, The Perl Foundation.
* SVN Info
* $Id$
* Overview:
@@ -176,12 +176,14 @@
PARROT_API PMC* new_c_exception_handler(Parrot_Interp, Parrot_exception *jb);
PARROT_API void push_new_c_exception_handler(Parrot_Interp, Parrot_exception
*jb);
-PARROT_API void rethrow_c_exception(Parrot_Interp interp);
+PARROT_API void rethrow_c_exception(Parrot_Interp interp)
+ __attribute__noreturn__;
/*
* internal exception handling
*/
-PARROT_API void do_exception(Parrot_Interp, INTVAL severity, long error);
+PARROT_API void do_exception(Parrot_Interp, INTVAL severity, long error)
+ __attribute__noreturn__;
PARROT_API void new_internal_exception(Parrot_Interp);
PARROT_API void free_internal_exception(Parrot_Interp);
Modified: branches/pmc2c/include/parrot/interpreter.h
==============================================================================
--- branches/pmc2c/include/parrot/interpreter.h (original)
+++ branches/pmc2c/include/parrot/interpreter.h Fri Jun 1 17:26:39 2007
@@ -541,8 +541,6 @@
void clone_interpreter(Parrot_Interp dest, Parrot_Interp self, INTVAL flags);
-PARROT_API void enter_nci_method(Interp *, const int type,
- void *func, const char *name, const char *proto);
PARROT_API void register_nci_method(Interp *, const int type,
void *func, const char *name, const char *proto);
PARROT_API void register_raw_nci_method_in_ns(Parrot_Interp interp, const int
type,
Modified: branches/pmc2c/include/parrot/io.h
==============================================================================
--- branches/pmc2c/include/parrot/io.h (original)
+++ branches/pmc2c/include/parrot/io.h Fri Jun 1 17:26:39 2007
@@ -189,12 +189,19 @@
PARROT_API extern PMC *PIO_accept(Interp *, PMC *pmc);
-PARROT_API extern INTVAL PIO_putps(Interp *, PMC *io, STRING *s);
-PARROT_API extern INTVAL PIO_fprintf(Interp *, PMC *io, const char *s, ...);
-PARROT_API extern INTVAL PIO_printf(Interp *, const char *s, ...);
-PARROT_API extern INTVAL PIO_eprintf(Interp *, const char *s, ...);
-PARROT_API extern PIOHANDLE PIO_getfd(Interp *, PMC *io);
-PARROT_API extern PIOOFF_T PIO_tell(Interp *, PMC *io);
+PARROT_API extern INTVAL PIO_putps(Interp *, PMC *io, STRING *s)
+ __attribute__nonnull__(2);
+PARROT_API extern INTVAL PIO_fprintf(Interp *, PMC *io, const char *s, ...)
+ __attribute__nonnull__(2)
+ __attribute__nonnull__(3);
+PARROT_API extern INTVAL PIO_printf(Interp *, const char *s, ...)
+ __attribute__nonnull__(2);
+PARROT_API extern INTVAL PIO_eprintf(Interp *, const char *s, ...)
+ __attribute__nonnull__(2);
+PARROT_API extern PIOHANDLE PIO_getfd(Interp *, PMC *io)
+ __attribute__nonnull__(2);
+PARROT_API extern PIOOFF_T PIO_tell(Interp *, PMC *io)
+ __attribute__nonnull__(2);
PARROT_API extern void Parrot_IOData_mark(Interp *, ParrotIOData *piodata);
Modified: branches/pmc2c/include/parrot/pic.h
==============================================================================
--- branches/pmc2c/include/parrot/pic.h (original)
+++ branches/pmc2c/include/parrot/pic.h Fri Jun 1 17:26:39 2007
@@ -80,7 +80,12 @@
typedef int (*arg_pass_f)(Interp *, PMC *sig,
char *src_base, void **src_pc, char *dest_base, void **dest_pc);
-int parrot_pic_check_sig(Interp *, PMC *sig1, PMC *sig2, int *type);
+int parrot_pic_check_sig(Interp *, const PMC *sig1, const PMC *sig2, int *type)
+ __attribute__nonnull__(1)
+ __attribute__nonnull__(2)
+ __attribute__nonnull__(3)
+ __attribute__nonnull__(4);
+
int parrot_pic_is_safe_to_jit(Interp *, PMC *sub,
PMC *sig_args, PMC *sig_results, int *flags);
Modified: branches/pmc2c/languages/lisp/lib/Parrot/Test/Lisp.pm
==============================================================================
--- branches/pmc2c/languages/lisp/lib/Parrot/Test/Lisp.pm (original)
+++ branches/pmc2c/languages/lisp/lib/Parrot/Test/Lisp.pm Fri Jun 1
17:26:39 2007
@@ -22,29 +22,25 @@
sub output_is {
my ( $self, $code, $output, $desc ) = @_;
- my $count = $self->{builder}->current_test + 1;
+ my $count = $self->{builder}->current_test() + 1;
my $lang_fn = File::Spec->rel2abs(Parrot::Test::per_test( '.l', $count ));
my $out_fn = File::Spec->rel2abs(Parrot::Test::per_test( '.out', $count
));
Parrot::Test::write_code_to_file( $code, $lang_fn );
- my $exit_code = 0;
- my $pass = 0;
- my $args = $ENV{TEST_PROG_ARGS} || '';
- my $cmd = "../../$self->{parrot} $args lisp.pbc $lang_fn";
+ my $args = $ENV{TEST_PROG_ARGS} || '';
+ my $cmd = "../../$self->{parrot} $args lisp.pbc $lang_fn";
+ my $lang_dir = File::Spec->catdir( $self->{relpath}, qw( languages lisp )
);
- $exit_code = Parrot::Test::run_command(
+ my $exit_code = Parrot::Test::run_command(
$cmd,
- CD => "$self->{relpath}/languages/lisp!",
+ CD => $lang_dir,
STDOUT => $out_fn,
STDERR => $out_fn
);
- if ( ! $pass ) {
- my $file = Parrot::Test::slurp_file($out_fn);
- $pass = $self->{builder}->is_eq( Parrot::Test::slurp_file($out_fn),
$output, $desc );
- $self->{builder}->diag("'$cmd' failed with exit code $exit_code")
- if $exit_code and not $pass;
- }
+ my $pass = $self->{builder}->is_eq( Parrot::Test::slurp_file($out_fn),
$output, $desc );
+ $self->{builder}->diag("'$cmd' failed with exit code $exit_code")
+ if $exit_code and not $pass;
return $pass;
}
Modified: branches/pmc2c/languages/lisp/lisp/bootstrap.l
==============================================================================
--- branches/pmc2c/languages/lisp/lisp/bootstrap.l (original)
+++ branches/pmc2c/languages/lisp/lisp/bootstrap.l Fri Jun 1 17:26:39 2007
@@ -37,70 +37,70 @@
"FLOAT" "HASH-TABLE" "INTEGER" "MACRO" "NIL" "PACKAGE" "STREAM"
"STRING" "SYMBOL" "T")
-;; Set the current package to SYSTEM so we don't have to prefix symbols.
-(cl:setq *package* (sys:%find-package "SYSTEM"))
-(%use-package (%find-package "SYSTEM") (%find-package "COMMON-LISP"))
-
-;; Create a hash table used to store all the dispatching macros.
-(setq *dispatching-macros* (%make-hash-table))
-
-;; #'xxx macro. See CLtL section 2.4.8.2 for details.
-(%set-hash *dispatching-macros*
- "'"
- (function
- (lambda (stream char)
- (list 'function (read stream)))))
-
-;; #.xxx macro. See CLtL section 2.4.8.6 for details.
-(setq *read-eval* t)
-(%set-hash *dispatching-macros*
- "."
- (function
- (lambda (stream char)
- (if *read-eval*
- (eval (read stream))
- (error "reader-error" "*READ-EVAL* is NIL")))))
-
-;; #< macro. See CLtL section 2.4.8.20 for details.
-(%set-hash *dispatching-macros*
- "<"
- (function
- (lambda (stream char)
- (error "reader-error" "#< is invalid syntax"))))
-
-;; ##<Space> macro. See CLtL section 2.4.8.21 for details.
-(%set-hash *dispatching-macros*
- " "
- (function
- (lambda (stream char)
- (error "reader-error" "#| | is invalid syntax"))))
-
-;; #) macro. See CLtL section 2.4.8.22 for details.
-(%set-hash *dispatching-macros*
- ")"
- (function
- (lambda (stream char)
- (error "reader-error" "#) is invalid syntax"))))
-
-(setq *macroexpand-hook* #'(lambda (fn form env)
- (apply fn (list form env))))
-
-;; Create the KEYWORD package.
-(sys:%make-package "KEYWORD")
-
-(sys:load "lisp/objects.l")
-(sys:load "lisp/core.l")
-(sys:load "lisp/logic.l")
-(sys:load "lisp/pred.l")
-(sys:load "lisp/list.l")
-(sys:load "lisp/math.l")
-
-;; Create and alias the COMMON-LISP-USER package.
-(sys:%make-package "COMMON-LISP-USER")
-(sys:%alias-package (sys:%find-package "COMMON-LISP-USER") "CL-USER")
-
-(cl:setq *package* (sys:%find-package "CL-USER"))
-(sys:%use-package (sys:%find-package "CL-USER")
- (sys:%find-package "COMMON-LISP"))
-
-(in-package "COMMON-LISP-USER")
+; ;; Set the current package to SYSTEM so we don't have to prefix
symbols.
+; (cl:setq *package* (sys:%find-package "SYSTEM"))
+; (%use-package (%find-package "SYSTEM") (%find-package "COMMON-LISP"))
+;
+; ;; Create a hash table used to store all the dispatching macros.
+; (setq *dispatching-macros* (%make-hash-table))
+;
+; ;; #'xxx macro. See CLtL section 2.4.8.2 for details.
+; (%set-hash *dispatching-macros*
+; "'"
+; (function
+; (lambda (stream char)
+; (list 'function (read stream)))))
+;
+; ;; #.xxx macro. See CLtL section 2.4.8.6 for details.
+; (setq *read-eval* t)
+; (%set-hash *dispatching-macros*
+; "."
+; (function
+; (lambda (stream char)
+; (if *read-eval*
+; (eval (read stream))
+; (error "reader-error" "*READ-EVAL* is NIL")))))
+;
+; ;; #< macro. See CLtL section 2.4.8.20 for details.
+; (%set-hash *dispatching-macros*
+; "<"
+; (function
+; (lambda (stream char)
+; (error "reader-error" "#< is invalid syntax"))))
+;
+; ;; ##<Space> macro. See CLtL section 2.4.8.21 for details.
+; (%set-hash *dispatching-macros*
+; " "
+; (function
+; (lambda (stream char)
+; (error "reader-error" "#| | is invalid syntax"))))
+;
+; ;; #) macro. See CLtL section 2.4.8.22 for details.
+; (%set-hash *dispatching-macros*
+; ")"
+; (function
+; (lambda (stream char)
+; (error "reader-error" "#) is invalid syntax"))))
+;
+; (setq *macroexpand-hook* #'(lambda (fn form env)
+; (apply fn (list form env))))
+;
+; ;; Create the KEYWORD package.
+; (sys:%make-package "KEYWORD")
+;
+; (sys:load "lisp/objects.l")
+; (sys:load "lisp/core.l")
+; (sys:load "lisp/logic.l")
+; (sys:load "lisp/pred.l")
+; (sys:load "lisp/list.l")
+; (sys:load "lisp/math.l")
+;
+; ;; Create and alias the COMMON-LISP-USER package.
+; (sys:%make-package "COMMON-LISP-USER")
+; (sys:%alias-package (sys:%find-package "COMMON-LISP-USER") "CL-USER")
+;
+; (cl:setq *package* (sys:%find-package "CL-USER"))
+; (sys:%use-package (sys:%find-package "CL-USER")
+; (sys:%find-package "COMMON-LISP"))
+;
+; (in-package "COMMON-LISP-USER")
Modified: branches/pmc2c/languages/lisp/t/atoms.t
==============================================================================
--- branches/pmc2c/languages/lisp/t/atoms.t (original)
+++ branches/pmc2c/languages/lisp/t/atoms.t Fri Jun 1 17:26:39 2007
@@ -23,6 +23,8 @@
# Parrot modules
use Parrot::Test;
-language_output_is( 'Lisp', <<'END_CODE', '1', 'integer 1' );
-1
+language_output_is( 'Lisp', <<'END_CODE', <<'END_OUT', 'integer 1' );
+(print 1)
END_CODE
+1
+END_OUT
Modified: branches/pmc2c/languages/lisp/t/hello.t
==============================================================================
--- branches/pmc2c/languages/lisp/t/hello.t (original)
+++ branches/pmc2c/languages/lisp/t/hello.t Fri Jun 1 17:26:39 2007
@@ -23,6 +23,8 @@
# Parrot modules
use Parrot::Test;
-language_output_is( 'Lisp', <<'END_CODE', 'Hello, World!', 'hello 1' );
+language_output_is( 'Lisp', <<'END_CODE', <<'END_OUT', 'hello 1' );
( print "Hello, World!" )
END_CODE
+Hello, World!
+END_OUT
Modified: branches/pmc2c/languages/lua/lua.pir
==============================================================================
--- branches/pmc2c/languages/lua/lua.pir (original)
+++ branches/pmc2c/languages/lua/lua.pir Fri Jun 1 17:26:39 2007
@@ -30,18 +30,6 @@
.HLL "Lua", "lua_group"
-.sub '__onload' :anon :init
- load_bytecode 'languages/lua/lib/luabasic.pbc'
- load_bytecode 'languages/lua/lib/luacoroutine.pir'
- load_bytecode 'languages/lua/lib/luapackage.pbc'
- load_bytecode 'languages/lua/lib/luastring.pir'
- load_bytecode 'languages/lua/lib/luatable.pbc'
- load_bytecode 'languages/lua/lib/luamath.pbc'
- load_bytecode 'languages/lua/lib/luaio.pir'
- load_bytecode 'languages/lua/lib/luaos.pbc'
- load_bytecode 'languages/lua/lib/luadebug.pbc'
-.end
-
=head1 SEE ALSO
F<languages/lua/doc/status.pod>
Modified: branches/pmc2c/languages/lua/src/POSTGrammar.tg
==============================================================================
--- branches/pmc2c/languages/lua/src/POSTGrammar.tg (original)
+++ branches/pmc2c/languages/lua/src/POSTGrammar.tg Fri Jun 1 17:26:39 2007
@@ -39,20 +39,28 @@
iter_end:
set_hll_global ['Lua::POST'], '$?SUB', outerpost
unless null outerpost goto no_chunk
-# .local pmc onload
-# onload = post.'new'('POST::Sub', 'name'=>'__onload', 'pragma'=>':anon
:init', 'result'=>'')
-## onload.'push_pirop'('inline', ' print "onload\n"')
-# onload.'push_pirop'('inline', ' load_bytecode
"languages/lua/lib/luabasic.pbc"')
- pragma .= ' :main'
- post.'pragma'(pragma)
- post = post.'new'('Lua::POST::Chunk', post, 'prologue'=><<'PIRCODE')
-
-.HLL "Lua", "lua_group"
-
-#.sub "__onload" :anon :init
-# load_bytecode "languages/lua/lib/luabasic.pbc"
-#.end
-PIRCODE
+ .local pmc start
+ start = post.'new'('POST::Sub', 'name'=>'__start', 'pragma'=>':main',
'result'=>'')
+ start.'push_pirop'('inline', '# print "start\n"')
+ start.'push_pirop'('inline', ' load_bytecode
"languages/lua/lib/luabasic.pbc"')
+ start.'push_pirop'('inline', ' load_bytecode
"languages/lua/lib/luacoroutine.pir"')
+ start.'push_pirop'('inline', ' load_bytecode
"languages/lua/lib/luapackage.pbc"')
+ start.'push_pirop'('inline', ' load_bytecode
"languages/lua/lib/luastring.pir"')
+ start.'push_pirop'('inline', ' load_bytecode
"languages/lua/lib/luatable.pbc"')
+ start.'push_pirop'('inline', ' load_bytecode
"languages/lua/lib/luamath.pbc"')
+ start.'push_pirop'('inline', ' load_bytecode
"languages/lua/lib/luaio.pbc"')
+ start.'push_pirop'('inline', ' load_bytecode
"languages/lua/lib/luaos.pbc"')
+ start.'push_pirop'('inline', ' load_bytecode
"languages/lua/lib/luadebug.pbc"')
+ start.'push_pirop'('inline', ' .const .Sub main = "_main"')
+ start.'push_pirop'('inline', ' $P0 = get_global "_G"')
+ start.'push_pirop'('inline', ' main."setfenv"($P0)')
+ start.'push_pirop'('inline', ' docall(main)')
+ post.'init'('outer'=>start)
+ .local pmc onload
+ onload = post.'new'('POST::Sub', 'name'=>'__onload', 'pragma'=>':anon
:init', 'result'=>'')
+ onload.'push_pirop'('inline', ' .const .Sub main = "_main"')
+ onload.'push_pirop'('inline', '# print "onload\n"')
+ post = post.'new'('Lua::POST::Chunk', post, onload, start,
'prologue'=>'.HLL "Lua", "lua_group"')
no_chunk:
.return (post)
}
Modified: branches/pmc2c/languages/t/harness
==============================================================================
--- branches/pmc2c/languages/t/harness (original)
+++ branches/pmc2c/languages/t/harness Fri Jun 1 17:26:39 2007
@@ -79,7 +79,6 @@
# cola not maintained
# conversion No t/harness
# forth No t/harness
-# lisp No t/harness
# miniperl not maintained, should be removed
# perl6 test scripts are written in Perl 6, not Perl 5
# pheme test scripts are written in Scheme, not Perl 5
@@ -100,6 +99,7 @@
HQ9plus
jako
lazy-k
+ lisp
lua
m4
ook
Modified: branches/pmc2c/src/debug.c
==============================================================================
--- branches/pmc2c/src/debug.c (original)
+++ branches/pmc2c/src/debug.c Fri Jun 1 17:26:39 2007
@@ -2149,18 +2149,13 @@
/*
-=item C<static void
-dump_string(Interp *interp, STRING *s)>
-
Dumps the buflen, flags, bufused, strlen, and offset associated with a string
and the string itself.
-=cut
-
*/
static void
-dump_string(Interp *interp, STRING *s)
+dump_string(Interp *interp, const STRING *s /*NULLOK*/)
{
if (!s)
return;
@@ -2169,7 +2164,7 @@
PIO_eprintf(interp, "\tFlags =\t%12ld\n", PObj_get_FLAGS(s));
PIO_eprintf(interp, "\tBufused =\t%12ld\n", s->bufused);
PIO_eprintf(interp, "\tStrlen =\t%12ld\n", s->strlen);
- PIO_eprintf(interp, "\tOffset =\t%12d\n",
+ PIO_eprintf(interp, "\tOffset =\t%12ld\n",
(char*) s->strstart - (char*) PObj_bufstart(s));
PIO_eprintf(interp, "\tString =\t%S\n", s);
}
@@ -2260,31 +2255,31 @@
void
PDB_info(Interp *interp)
{
- PIO_eprintf(interp, "Total memory allocated = %d\n",
+ PIO_eprintf(interp, "Total memory allocated = %ld\n",
interpinfo(interp, TOTAL_MEM_ALLOC));
- PIO_eprintf(interp, "DOD runs = %d\n",
+ PIO_eprintf(interp, "DOD runs = %ld\n",
interpinfo(interp, DOD_RUNS));
- PIO_eprintf(interp, "Lazy DOD runs = %d\n",
+ PIO_eprintf(interp, "Lazy DOD runs = %ld\n",
interpinfo(interp, LAZY_DOD_RUNS));
- PIO_eprintf(interp, "Collect runs = %d\n",
+ PIO_eprintf(interp, "Collect runs = %ld\n",
interpinfo(interp, COLLECT_RUNS));
- PIO_eprintf(interp, "Collect memory = %d\n",
+ PIO_eprintf(interp, "Collect memory = %ld\n",
interpinfo(interp, TOTAL_COPIED));
- PIO_eprintf(interp, "Active PMCs = %d\n",
+ PIO_eprintf(interp, "Active PMCs = %ld\n",
interpinfo(interp, ACTIVE_PMCS));
- PIO_eprintf(interp, "Extended PMCs = %d\n",
+ PIO_eprintf(interp, "Extended PMCs = %ld\n",
interpinfo(interp, EXTENDED_PMCS));
- PIO_eprintf(interp, "Timely DOD PMCs = %d\n",
+ PIO_eprintf(interp, "Timely DOD PMCs = %ld\n",
interpinfo(interp, IMPATIENT_PMCS));
- PIO_eprintf(interp, "Total PMCs = %d\n",
+ PIO_eprintf(interp, "Total PMCs = %ld\n",
interpinfo(interp, TOTAL_PMCS));
- PIO_eprintf(interp, "Active buffers = %d\n",
+ PIO_eprintf(interp, "Active buffers = %ld\n",
interpinfo(interp, ACTIVE_BUFFERS));
- PIO_eprintf(interp, "Total buffers = %d\n",
+ PIO_eprintf(interp, "Total buffers = %ld\n",
interpinfo(interp, TOTAL_BUFFERS));
- PIO_eprintf(interp, "Header allocations since last collect = %d\n",
+ PIO_eprintf(interp, "Header allocations since last collect = %ld\n",
interpinfo(interp, HEADER_ALLOCS_SINCE_COLLECT));
- PIO_eprintf(interp, "Memory allocations since last collect = %d\n",
+ PIO_eprintf(interp, "Memory allocations since last collect = %ld\n",
interpinfo(interp, MEM_ALLOCS_SINCE_COLLECT));
}
Modified: branches/pmc2c/src/exceptions.c
==============================================================================
--- branches/pmc2c/src/exceptions.c (original)
+++ branches/pmc2c/src/exceptions.c Fri Jun 1 17:26:39 2007
@@ -198,7 +198,7 @@
= stack_entry(interp, interp->dynamic_env, 0);
if (!e)
real_exception(interp, NULL, 1,
- "Mark %d not found.", mark);
+ "Mark %ld not found.", (long)mark);
(void)stack_pop(interp, &interp->dynamic_env,
NULL, e->entry_type);
if (e->entry_type == STACK_ENTRY_MARK) {
Modified: branches/pmc2c/src/gc/register.c
==============================================================================
--- branches/pmc2c/src/gc/register.c (original)
+++ branches/pmc2c/src/gc/register.c Fri Jun 1 17:26:39 2007
@@ -72,7 +72,7 @@
#define CTX_ALLOC_SIZE 0x20000
-#define ALIGNED_CTX_SIZE (((sizeof (struct Parrot_Context) + NUMVAL_SIZE - 1) \
+#define ALIGNED_CTX_SIZE (((sizeof (Parrot_Context) + NUMVAL_SIZE - 1) \
/ NUMVAL_SIZE) * NUMVAL_SIZE)
/*
@@ -116,12 +116,12 @@
destroy_context(Interp *interp)
{
int slot;
- struct Parrot_Context *context;
+ Parrot_Context *context;
/* clear active contexts all the way back to the initial context */
context = CONTEXT(interp->ctx);
while (context) {
- struct Parrot_Context * prev = context->caller_ctx;
+ Parrot_Context * prev = context->caller_ctx;
mem_sys_free(context);
context = prev;
}
@@ -281,11 +281,12 @@
clear_regs(interp, ctx);
}
-struct Parrot_Context *
-Parrot_dup_context(Interp *interp, const struct Parrot_Context *old)
+Parrot_Context *
+Parrot_dup_context(Interp *interp, const Parrot_Context *old)
{
- size_t diff;
- struct Parrot_Context *ctx;
+ size_t diff;
+ Parrot_Context *ctx;
+ DECL_CONST_CAST;
const size_t reg_alloc = old->regs_mem_size;
const int slot = CALCULATE_SLOT_NUM(reg_alloc);
@@ -297,11 +298,11 @@
else {
ptr = (void *)mem_sys_allocate(reg_alloc + ALIGNED_CTX_SIZE);
}
- CONTEXT(interp->ctx) = ctx = (struct Parrot_Context *)ptr;
+ CONTEXT(interp->ctx) = ctx = (Parrot_Context *)ptr;
ctx->regs_mem_size = reg_alloc;
ctx->n_regs_used = old->n_regs_used;
- diff = (long*)ctx - (long*)old;
+ diff = (long *)ctx - (long *)const_cast(old);
interp->ctx.bp.regs_i += diff;
interp->ctx.bp_ps.regs_s += diff;
@@ -309,11 +310,11 @@
return ctx;
}
-struct Parrot_Context *
+Parrot_Context *
Parrot_push_context(Interp *interp, INTVAL *n_regs_used)
{
- struct Parrot_Context * const old = CONTEXT(interp->ctx);
- struct Parrot_Context * const ctx =
+ Parrot_Context * const old = CONTEXT(interp->ctx);
+ Parrot_Context * const ctx =
Parrot_alloc_context(interp, n_regs_used);
ctx->caller_ctx = old;
@@ -325,8 +326,8 @@
void
Parrot_pop_context(Interp *interp)
{
- struct Parrot_Context * const ctx = CONTEXT(interp->ctx);
- struct Parrot_Context * const old = ctx->caller_ctx;
+ Parrot_Context * const ctx = CONTEXT(interp->ctx);
+ Parrot_Context * const old = ctx->caller_ctx;
Parrot_free_context(interp, ctx, 1);
/* restore old, set cached interpreter base pointers */
@@ -336,10 +337,10 @@
}
-struct Parrot_Context *
+Parrot_Context *
Parrot_alloc_context(Interp *interp, INTVAL *n_regs_used)
{
- struct Parrot_Context *old, *ctx;
+ Parrot_Context *old, *ctx;
void *ptr, *p;
/*
@@ -404,7 +405,7 @@
}
#endif
- CONTEXT(interp->ctx) = ctx = (struct Parrot_Context *)ptr;
+ CONTEXT(interp->ctx) = ctx = (Parrot_Context *)ptr;
ctx->regs_mem_size = reg_alloc;
ctx->n_regs_used = n_regs_used;
Modified: branches/pmc2c/src/hash.c
==============================================================================
--- branches/pmc2c/src/hash.c (original)
+++ branches/pmc2c/src/hash.c Fri Jun 1 17:26:39 2007
@@ -178,12 +178,6 @@
return a != b;
}
-static void
-pobject_lives_fn(Interp *interp, PObj *o)
-{
- pobject_lives(interp, o);
-}
-
/*
=item C<void
Modified: branches/pmc2c/src/inter_misc.c
==============================================================================
--- branches/pmc2c/src/inter_misc.c (original)
+++ branches/pmc2c/src/inter_misc.c Fri Jun 1 17:26:39 2007
@@ -1,14 +1,14 @@
/*
-Copyright (C) 2001-2006, The Perl Foundation.
+Copyright (C) 2001-2007, The Perl Foundation.
$Id$
=head1 NAME
-src/inter_misc.c - Parrot Interpreter - Misc functions
+src/inter_misc.c - Parrot Interpreter miscellaneous functions
=head1 DESCRIPTION
-NCI function setup, C<interpinfo>, and C<sysinfo> opcodes.
+NCI function setup, compiler registration, C<interpinfo>, and C<sysinfo>
opcodes.
=head2 Functions
@@ -38,13 +38,6 @@
void Parrot_NCI_nci_make_raw_nci(Interp *interp, PMC *method, void *func);
void
-enter_nci_method(Parrot_Interp interp, const int type, void *func,
- const char *name, const char *proto)
-{
- register_nci_method(interp, type, func, name, proto);
-}
-
-void
register_nci_method(Parrot_Interp interp, const int type, void *func,
const char *name, const char *proto)
{
@@ -127,7 +120,7 @@
}
nci = pmc_new(interp, enum_class_Compiler);
VTABLE_set_pmc_keyed_str(interp, hash, type, nci);
- /* build native call interface fir the C sub in "func" */
+ /* build native call interface for the C sub in "func" */
sc = CONST_STRING(interp, "PJt");
VTABLE_set_pointer_keyed_str(interp, nci, sc, (void*)func);
}
Modified: branches/pmc2c/src/io/io.c
==============================================================================
--- branches/pmc2c/src/io/io.c (original)
+++ branches/pmc2c/src/io/io.c Fri Jun 1 17:26:39 2007
@@ -693,14 +693,8 @@
/*
-=item C<PMC *
-PIO_open(Interp *interp, ParrotIOLayer *layer, const char *spath,
- const char *sflags)>
-
Creates and returns a C<ParrotIO> PMC for C<*spath>.
-=cut
-
*/
PMC *
@@ -1006,7 +1000,7 @@
*/
INTVAL
-PIO_putps(Interp *interp, PMC *pmc, STRING *s)
+PIO_putps(Interp *interp, PMC *pmc, STRING *s /*NULLOK*/)
{
ParrotIOLayer * const l = (ParrotIOLayer *)PMC_struct_val(pmc);
ParrotIO * const io = (ParrotIO *)PMC_data0(pmc);
Modified: branches/pmc2c/src/objects.c
==============================================================================
--- branches/pmc2c/src/objects.c (original)
+++ branches/pmc2c/src/objects.c Fri Jun 1 17:26:39 2007
@@ -231,32 +231,6 @@
"can't register Class", data_types[type].name);
}
-/*
- * FIXME make array clone shallow
- */
-static PMC *
-clone_array(Interp *interp, PMC *source_array)
-{
- PMC * const new_array = pmc_new(interp,
- source_array->vtable->base_type);
- const INTVAL count = VTABLE_elements(interp, source_array);
- INTVAL i;
-
- /*
- * preserve type, we have OrderedHash and Array
- * XXX this doesn't preserve the keys of the ordered hash
- * (but the keys aren't used -leo)
- */
- VTABLE_set_integer_native(interp, new_array, count);
-
- for (i = 0; i < count; i++) {
- VTABLE_set_pmc_keyed_int(interp, new_array, i,
- VTABLE_get_pmc_keyed_int(interp, source_array, i));
- }
-
- return new_array;
-}
-
/* Take the class and completely rebuild the attribute stuff for
it. Horribly destructive, and definitely not a good thing to do if
there are instantiated objects for the class */
Modified: branches/pmc2c/src/packfile.c
==============================================================================
--- branches/pmc2c/src/packfile.c (original)
+++ branches/pmc2c/src/packfile.c Fri Jun 1 17:26:39 2007
@@ -2751,19 +2751,19 @@
PackFile_FixupEntry * const entry =
self->fixups[i] =
mem_allocate_typed(PackFile_FixupEntry);
- self->fixups[i]->type = PF_fetch_opcode(pf, &cursor);
- switch (self->fixups[i]->type) {
+ entry->type = PF_fetch_opcode(pf, &cursor);
+ switch (entry->type) {
case enum_fixup_label:
case enum_fixup_sub:
- self->fixups[i]->name = PF_fetch_cstring(pf, &cursor);
- self->fixups[i]->offset = PF_fetch_opcode(pf, &cursor);
+ entry->name = PF_fetch_cstring(pf, &cursor);
+ entry->offset = PF_fetch_opcode(pf, &cursor);
break;
case enum_fixup_none:
break;
default:
PIO_eprintf(interp,
"PackFile_FixupTable_unpack: Unknown fixup type %d!\n",
- self->fixups[i]->type);
+ entry->type);
return 0;
}
}
Modified: branches/pmc2c/src/pic.c
==============================================================================
--- branches/pmc2c/src/pic.c (original)
+++ branches/pmc2c/src/pic.c Fri Jun 1 17:26:39 2007
@@ -1,5 +1,5 @@
/*
-Copyright (C) 2004-2006, The Perl Foundation.
+Copyright (C) 2004-2007, The Perl Foundation.
$Id$
=head1 NAME
@@ -370,7 +370,7 @@
* the type PARROT_ARG_CONSTANT stands for mixed types or constants
*/
int
-parrot_pic_check_sig(Interp *interp, PMC *sig1, PMC *sig2, int *type)
+parrot_pic_check_sig(Interp *interp, const PMC *sig1, const PMC *sig2, int
*type /*NN*/)
{
int i, n, t0, t1, t2;
t0 = 0; /* silence compiler uninit warning */
@@ -419,14 +419,13 @@
parrot_context_t *caller_ctx;
INTVAL const_nr;
opcode_t *args;
- PMC *ccont;
PMC * const sig1 = (PMC*)(pc[1]);
parrot_context_t * const ctx = CONTEXT(interp->ctx);
/* check params */
if (op == PARROT_OP_set_returns_pc) {
- ccont = ctx->current_cont;
+ PMC * const ccont = ctx->current_cont;
if (!PMC_cont(ccont)->address)
return 0;
caller_ctx = PMC_cont(ccont)->to_ctx;
@@ -437,7 +436,7 @@
args = interp->current_args;
}
if (args) {
- const_nr = args[1];
+ const INTVAL const_nr = args[1];
/* check current_args signature */
sig2 = caller_ctx->constants[const_nr]->u.key;
n = parrot_pic_check_sig(interp, sig1, sig2, &type);
@@ -481,11 +480,6 @@
static int
is_pic_func(Interp *interp, void **pc, Parrot_MIC *mic, int core_type)
{
- PMC *sub, *sig_args, *sig_results;
- parrot_context_t *ctx;
- opcode_t *op, n;
- int flags;
-
/*
* if we have these opcodes
*
@@ -504,8 +498,13 @@
* pc is at set_args
*/
- ctx = CONTEXT(interp->ctx);
- sig_args = (PMC*)(pc[1]);
+ PMC *sub, *sig_results;
+ opcode_t *op, n;
+ int flags;
+
+ parrot_context_t * const ctx = CONTEXT(interp->ctx);
+ PMC * const sig_args = (PMC*)(pc[1]);
+
ASSERT_SIG_PMC(sig_args);
n = SIG_ELEMS(sig_args);
interp->current_args = (opcode_t*)pc + ctx->pred_offset;
@@ -556,9 +555,8 @@
switch (op) {
case PARROT_OP_new_p_sc:
{
- STRING *_class;
INTVAL type;
- _class = (STRING *)cur_opcode[2];
+ STRING * const _class = (STRING *)cur_opcode[2];
type = pmc_type(interp, _class);
if (!type)
type = pmc_type(interp, _class);
@@ -605,8 +603,6 @@
static void
parrot_pic_move(Interp* interp, Parrot_MIC *mic)
{
- Parrot_PIC* pic;
-
/*
* MIC slot is empty - use it
*/
@@ -622,7 +618,8 @@
/*
* PIC was already used - shift slots up
*/
- pic = mic->pic;
+ 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;
@@ -663,10 +660,10 @@
func = get_mmd_dispatch_type(interp,
mic->m.func_nr, left_type, right_type, &is_pmc);
if (is_pmc) {
- size_t offs = cur_opcode - interp->code->prederef.code;
- opcode_t* real_op = interp->code->base.data + offs + 1;
- /* set prederef code address to orig slot for now
- */
+ const size_t offs = cur_opcode - interp->code->prederef.code;
+ opcode_t* const real_op = interp->code->base.data + offs + 1;
+
+ /* set prederef code address to orig slot for now */
((void**)cur_opcode)[0] =
parrot_pic_opcode(interp, PARROT_OP_infix_ic_p_p);
/* restore 1st operand i.e. .MMD_func_nr */
Modified: branches/pmc2c/src/pic_jit.c
==============================================================================
--- branches/pmc2c/src/pic_jit.c (original)
+++ branches/pmc2c/src/pic_jit.c Fri Jun 1 17:26:39 2007
@@ -108,10 +108,10 @@
static int
-args_match_params(Interp *interp, PMC *sig_args, PackFile_ByteCode *seg,
+args_match_params(Interp *interp, const PMC *sig_args, PackFile_ByteCode *seg,
opcode_t *start)
{
- PMC *sig_params;
+ const PMC *sig_params;
int n, type;
if (*start != PARROT_OP_get_params_pc)
@@ -145,7 +145,7 @@
}
static int
-returns_match_results(Interp *interp, PMC *sig_ret, PMC *sig_result)
+returns_match_results(Interp *interp, const PMC *sig_ret, const PMC
*sig_result)
{
int type;
const int n = parrot_pic_check_sig(interp, sig_ret, sig_result, &type);
@@ -209,20 +209,16 @@
}
static int
-ops_jittable(Interp *interp, PMC *sub, PMC *sig_results, PackFile_ByteCode
*seg,
+ops_jittable(Interp *interp, PMC *sub, const PMC *sig_results,
PackFile_ByteCode *seg,
opcode_t *pc, opcode_t *end, int *flags)
{
- int op;
- op_info_t *op_info;
- int n;
-
while (pc < end) {
/* special opcodes which are handled, but not marked as JITtable */
int i;
- op = *pc;
- op_info = interp->op_info_table + op;
- n = op_info->op_count;
+ const int op = *pc;
+ const op_info_t * const op_info = interp->op_info_table + op;
+ int n = op_info->op_count;
switch (op) {
case PARROT_OP_returncc:
@@ -231,8 +227,7 @@
break;
case PARROT_OP_set_returns_pc:
{
- PMC *sig_ret;
- sig_ret = seg->const_table->constants[pc[1]]->u.key;
+ const PMC * const sig_ret =
seg->const_table->constants[pc[1]]->u.key;
if (!returns_match_results(interp, sig_ret, sig_results))
return 0;
}
Modified: branches/pmc2c/src/pmc/addrregistry.pmc
==============================================================================
--- branches/pmc2c/src/pmc/addrregistry.pmc (original)
+++ branches/pmc2c/src/pmc/addrregistry.pmc Fri Jun 1 17:26:39 2007
@@ -43,12 +43,6 @@
return a != b;
}
-static void
-pobject_lives_fn(Interp *interp, PObj *o)
-{
- pobject_lives(interp, o);
-}
-
pmclass AddrRegistry need_ext does hash {
/*
Modified: branches/pmc2c/src/pmc/os.pmc
==============================================================================
--- branches/pmc2c/src/pmc/os.pmc (original)
+++ branches/pmc2c/src/pmc/os.pmc Fri Jun 1 17:26:39 2007
@@ -505,10 +505,9 @@
string_cstring_free(coldpath);
string_cstring_free(cnewpath);
- if (ret < 0)
- {
- char *errmsg = strerror(errno) ;
- real_exception(interp, NULL, E_SystemError, errmsg);
+ if (ret < 0) {
+ const char * const errmsg = strerror(errno) ;
+ real_exception(interp, NULL, E_SystemError, "%s", errmsg);
}
}
Modified: branches/pmc2c/src/pmc/sub.pmc
==============================================================================
--- branches/pmc2c/src/pmc/sub.pmc (original)
+++ branches/pmc2c/src/pmc/sub.pmc Fri Jun 1 17:26:39 2007
@@ -213,7 +213,7 @@
opcode_t* invoke(void *next) {
struct Parrot_sub *sub = PMC_sub(SELF);
parrot_context_t *caller_ctx;
- struct Parrot_Context *context;
+ Parrot_Context *context;
PMC *ccont;
opcode_t *pc;
Modified: branches/pmc2c/src/pmc_freeze.c
==============================================================================
--- branches/pmc2c/src/pmc_freeze.c (original)
+++ branches/pmc2c/src/pmc_freeze.c Fri Jun 1 17:26:39 2007
@@ -859,7 +859,7 @@
info->visit_action = pmc->vtable->freeze;
break;
default:
- internal_exception(1, "Illegal action %d", info->what);
+ internal_exception(1, "Illegal action %ld", (long)info->what);
break;
}
}
