mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-09 23:40:29 +02:00
Code Activity

Avoid uses of deprecated forms in the VM code.

Browse source 
Reported by Daniel Kraft <d@domob.eu>.

* libguile/frames.c, libguile/vm.c: Include <stdlib.h>, use `size_t'
  instead of `scm_sizet'.

* libguile/objcodes.c, libguile/programs.c, libguile/vm-engine.c,
  libguile/vm-i-loader.c, libguile/vm-i-system.c: Use `scm_list_X ()'
  instead of the deprecated `SCM_LISTX ()'.
This commit is contained in:
Ludovic Courtès 2009-04-05 20:15:11 +02:00
parent 6ab8238d99
commit da8b47478e
7 changed files with 29 additions and 26 deletions
Download patch file Download diff file Expand all files Collapse all files

3
libguile/frames.c
View file

@ -43,6 +43,7 @@
# include <config.h> # include <config.h>
#endif #endif
#include <stdlib.h>
#include <string.h> #include <string.h>
#include "vm-bootstrap.h" #include "vm-bootstrap.h"
#include "frames.h" #include "frames.h"
@ -85,7 +86,7 @@ vm_frame_mark (SCM obj)
return SCM_VM_FRAME_STACK_HOLDER (obj); return SCM_VM_FRAME_STACK_HOLDER (obj);
} }
static scm_sizet static size_t
vm_frame_free (SCM obj) vm_frame_free (SCM obj)
{ {
struct scm_vm_frame *p = SCM_VM_FRAME_DATA (obj); struct scm_vm_frame *p = SCM_VM_FRAME_DATA (obj);

18
libguile/objcodes.c
View file

@ -81,7 +81,7 @@ make_objcode_by_mmap (int fd)
if (st.st_size <= sizeof (struct scm_objcode) + strlen (OBJCODE_COOKIE)) if (st.st_size <= sizeof (struct scm_objcode) + strlen (OBJCODE_COOKIE))
scm_misc_error (FUNC_NAME, "object file too small (~a bytes)", scm_misc_error (FUNC_NAME, "object file too small (~a bytes)",
SCM_LIST1 (SCM_I_MAKINUM (st.st_size))); scm_list_1 (SCM_I_MAKINUM (st.st_size)));
addr = mmap (0, st.st_size, PROT_READ, MAP_SHARED, fd, 0); addr = mmap (0, st.st_size, PROT_READ, MAP_SHARED, fd, 0);
if (addr == MAP_FAILED) if (addr == MAP_FAILED)
@ -94,8 +94,8 @@ make_objcode_by_mmap (int fd)
if (data->len + data->metalen != (st.st_size - sizeof (*data) - strlen (OBJCODE_COOKIE))) if (data->len + data->metalen != (st.st_size - sizeof (*data) - strlen (OBJCODE_COOKIE)))
scm_misc_error (FUNC_NAME, "bad length header (~a, ~a)", scm_misc_error (FUNC_NAME, "bad length header (~a, ~a)",
SCM_LIST2 (scm_from_size_t (st.st_size), scm_list_2 (scm_from_size_t (st.st_size),
scm_from_uint32 (sizeof (*data) + data->len + data->metalen))); scm_from_uint32 (sizeof (*data) + data->len + data->metalen)));
SCM_NEWSMOB3 (sret, scm_tc16_objcode, addr + strlen (OBJCODE_COOKIE), SCM_NEWSMOB3 (sret, scm_tc16_objcode, addr + strlen (OBJCODE_COOKIE),
SCM_PACK (SCM_BOOL_F), fd); SCM_PACK (SCM_BOOL_F), fd);
@ -121,10 +121,10 @@ scm_c_make_objcode_slice (SCM parent, scm_t_uint8 *ptr)
|| ptr >= (parent_data->base + parent_data->len + parent_data->metalen || ptr >= (parent_data->base + parent_data->len + parent_data->metalen
- sizeof (struct scm_objcode))) - sizeof (struct scm_objcode)))
scm_misc_error (FUNC_NAME, "offset out of bounds (~a vs ~a + ~a + ~a)", scm_misc_error (FUNC_NAME, "offset out of bounds (~a vs ~a + ~a + ~a)",
SCM_LIST4 (scm_from_ulong ((unsigned long)ptr), scm_list_4 (scm_from_ulong ((unsigned long)ptr),
scm_from_ulong ((unsigned long)parent_data->base), scm_from_ulong ((unsigned long)parent_data->base),
scm_from_uint32 (parent_data->len), scm_from_uint32 (parent_data->len),
scm_from_uint32 (parent_data->metalen))); scm_from_uint32 (parent_data->metalen)));
data = (struct scm_objcode*)ptr; data = (struct scm_objcode*)ptr;
if (data->base + data->len + data->metalen > parent_data->base + parent_data->len + parent_data->metalen) if (data->base + data->len + data->metalen > parent_data->base + parent_data->len + parent_data->metalen)
@ -194,8 +194,8 @@ SCM_DEFINE (scm_bytecode_to_objcode, "bytecode->objcode", 1, 0, 0,
SCM_ASSERT_RANGE (0, bytecode, size >= sizeof(struct scm_objcode)); SCM_ASSERT_RANGE (0, bytecode, size >= sizeof(struct scm_objcode));
if (data->len + data->metalen != (size - sizeof (*data))) if (data->len + data->metalen != (size - sizeof (*data)))
scm_misc_error (FUNC_NAME, "bad u8vector size (~a != ~a)", scm_misc_error (FUNC_NAME, "bad u8vector size (~a != ~a)",
SCM_LIST2 (scm_from_size_t (size), scm_list_2 (scm_from_size_t (size),
scm_from_uint32 (sizeof (*data) + data->len + data->metalen))); scm_from_uint32 (sizeof (*data) + data->len + data->metalen)));
assert (increment == 1); assert (increment == 1);
SCM_SET_SMOB_FLAGS (objcode, SCM_F_OBJCODE_IS_U8VECTOR); SCM_SET_SMOB_FLAGS (objcode, SCM_F_OBJCODE_IS_U8VECTOR);

8
libguile/programs.c
View file

@ -173,10 +173,10 @@ SCM_DEFINE (scm_program_arity, "program-arity", 1, 0, 0,
SCM_VALIDATE_PROGRAM (1, program); SCM_VALIDATE_PROGRAM (1, program);
p = SCM_PROGRAM_DATA (program); p = SCM_PROGRAM_DATA (program);
return SCM_LIST4 (SCM_I_MAKINUM (p->nargs), return scm_list_4 (SCM_I_MAKINUM (p->nargs),
SCM_I_MAKINUM (p->nrest), SCM_I_MAKINUM (p->nrest),
SCM_I_MAKINUM (p->nlocs), SCM_I_MAKINUM (p->nlocs),
SCM_I_MAKINUM (p->nexts)); SCM_I_MAKINUM (p->nexts));
} }
#undef FUNC_NAME #undef FUNC_NAME

11
libguile/vm-engine.c
View file

@ -175,7 +175,7 @@ VM_NAME (struct scm_vm *vp, SCM program, SCM *argv, int nargs)
vm_error_bad_instruction: vm_error_bad_instruction:
err_msg = scm_from_locale_string ("VM: Bad instruction: ~A"); err_msg = scm_from_locale_string ("VM: Bad instruction: ~A");
finish_args = SCM_LIST1 (scm_from_uchar (ip[-1])); finish_args = scm_list_1 (scm_from_uchar (ip[-1]));
goto vm_error; goto vm_error;
vm_error_unbound: vm_error_unbound:
@ -189,7 +189,7 @@ VM_NAME (struct scm_vm *vp, SCM program, SCM *argv, int nargs)
vm_error_too_many_args: vm_error_too_many_args:
err_msg = scm_from_locale_string ("VM: Too many arguments"); err_msg = scm_from_locale_string ("VM: Too many arguments");
finish_args = SCM_LIST1 (scm_from_int (nargs)); finish_args = scm_list_1 (scm_from_int (nargs));
goto vm_error; goto vm_error;
vm_error_wrong_num_args: vm_error_wrong_num_args:
@ -202,8 +202,8 @@ VM_NAME (struct scm_vm *vp, SCM program, SCM *argv, int nargs)
vm_error_wrong_type_apply: vm_error_wrong_type_apply:
err_msg = scm_from_locale_string ("VM: Wrong type to apply: ~S " err_msg = scm_from_locale_string ("VM: Wrong type to apply: ~S "
"[IP offset: ~a]"); "[IP offset: ~a]");
finish_args = SCM_LIST2 (program, finish_args = scm_list_2 (program,
SCM_I_MAKINUM (ip - bp->base)); SCM_I_MAKINUM (ip - bp->base));
goto vm_error; goto vm_error;
vm_error_stack_overflow: vm_error_stack_overflow:
@ -264,7 +264,8 @@ VM_NAME (struct scm_vm *vp, SCM program, SCM *argv, int nargs)
vm_error: vm_error:
SYNC_ALL (); SYNC_ALL ();
scm_ithrow (sym_vm_error, SCM_LIST3 (sym_vm_run, err_msg, finish_args), 1); scm_ithrow (sym_vm_error, scm_list_3 (sym_vm_run, err_msg, finish_args),
1);
} }
abort (); /* never reached */ abort (); /* never reached */

2
libguile/vm-i-loader.c
View file

@ -140,7 +140,7 @@ VM_DEFINE_INSTRUCTION (66, link_now, "link-now", 0, 1, 1)
mod = scm_module_public_interface (mod); mod = scm_module_public_interface (mod);
if (SCM_FALSEP (mod)) if (SCM_FALSEP (mod))
{ {
finish_args = SCM_LIST1 (SCM_CAR (what)); finish_args = scm_list_1 (SCM_CAR (what));
goto vm_error_no_such_module; goto vm_error_no_such_module;
} }
/* might longjmp */ /* might longjmp */

8
libguile/vm-i-system.c
View file

@ -253,7 +253,7 @@ VM_DEFINE_INSTRUCTION (24, variable_ref, "variable-ref", 0, 0, 1)
if (!VARIABLE_BOUNDP (x)) if (!VARIABLE_BOUNDP (x))
{ {
finish_args = SCM_LIST1 (x); finish_args = scm_list_1 (x);
/* Was: finish_args = SCM_LIST1 (SCM_CAR (x)); */ /* Was: finish_args = SCM_LIST1 (SCM_CAR (x)); */
goto vm_error_unbound; goto vm_error_unbound;
} }
@ -298,7 +298,7 @@ VM_DEFINE_INSTRUCTION (25, toplevel_ref, "toplevel-ref", 1, 0, 1)
mod = scm_module_public_interface (mod); mod = scm_module_public_interface (mod);
if (SCM_FALSEP (mod)) if (SCM_FALSEP (mod))
{ {
finish_args = SCM_LIST1 (mod); finish_args = scm_list_1 (mod);
goto vm_error_no_such_module; goto vm_error_no_such_module;
} }
/* might longjmp */ /* might longjmp */
@ -307,7 +307,7 @@ VM_DEFINE_INSTRUCTION (25, toplevel_ref, "toplevel-ref", 1, 0, 1)
if (!VARIABLE_BOUNDP (what)) if (!VARIABLE_BOUNDP (what))
{ {
finish_args = SCM_LIST1 (what); finish_args = scm_list_1 (what);
goto vm_error_unbound; goto vm_error_unbound;
} }
@ -381,7 +381,7 @@ VM_DEFINE_INSTRUCTION (29, toplevel_set, "toplevel-set", 1, 1, 0)
mod = scm_module_public_interface (mod); mod = scm_module_public_interface (mod);
if (SCM_FALSEP (mod)) if (SCM_FALSEP (mod))
{ {
finish_args = SCM_LIST1 (what); finish_args = scm_list_1 (what);
goto vm_error_no_such_module; goto vm_error_no_such_module;
} }
/* might longjmp */ /* might longjmp */

5
libguile/vm.c
View file

@ -43,6 +43,7 @@
# include <config.h> # include <config.h>
#endif #endif
#include <stdlib.h>
#include <alloca.h> #include <alloca.h>
#include <string.h> #include <string.h>
#include "vm-bootstrap.h" #include "vm-bootstrap.h"
@ -129,7 +130,7 @@ vm_cont_mark (SCM obj)
return SCM_BOOL_F; return SCM_BOOL_F;
} }
static scm_sizet static size_t
vm_cont_free (SCM obj) vm_cont_free (SCM obj)
{ {
struct scm_vm_cont *p = SCM_VM_CONT_DATA (obj); struct scm_vm_cont *p = SCM_VM_CONT_DATA (obj);
@ -368,7 +369,7 @@ vm_mark (SCM obj)
return vp->options; return vp->options;
} }
static scm_sizet static size_t
vm_free (SCM obj) vm_free (SCM obj)
{ {
struct scm_vm *vp = SCM_VM_DATA (obj); struct scm_vm *vp = SCM_VM_DATA (obj);