[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, master, updated. v2.1.0-410-gef6b7f7
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] GNU Guile branch, master, updated. v2.1.0-410-gef6b7f7 |
|
Date: |
Tue, 19 Nov 2013 19:07:25 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=ef6b7f718acaceba9408ad16d007cc4cb76e0a84
The branch, master has been updated
via ef6b7f718acaceba9408ad16d007cc4cb76e0a84 (commit)
via 827c2c26fc75c6c6686efbaca737d2736be5887e (commit)
via 8bf83893c746326dd1f10f1381423bd0406cf58c (commit)
via 6b9470bf483e14e10ae85fc6bcbc25b4e2e77ff7 (commit)
via 2b4d21d53e800e1af61caf6c8393660fe392c628 (commit)
via 34cf09ccdf33fed42af9bda1f59252db9af9f7af (commit)
via 2e12c1a2b7a5d066a4ef07b32c19cdf8d2f1738b (commit)
via fd5621f8680e6a9a919324ed47a63cbdaa8a15ab (commit)
via a1eb8d1168c35889d50893e636eee7cfec581cba (commit)
via d1100525ff1b4e6e1fdb7d818cef3ec7a838e002 (commit)
via 0bd1e9c6a0420816111e4dc109d6dd30f9f8cd73 (commit)
via edba822553cfa95c907bf3ecb4c4879723ef92ee (commit)
via 8079714576442964f84d215f3edbad5f07ae3911 (commit)
via e326baac0bc4b3049a97f429349f2c3c5a22b8a3 (commit)
via d798a895cccf4a25bfecd2785eb347903b76213b (commit)
via e0755cd12ae365c1b903fc6c57afb17231cf5468 (commit)
via 9121d9f1ac21a91d2031a186a5b3c77d551acaa4 (commit)
from b636cdb0f3e1b7e8723c214db7a9c80edac9ead6 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit ef6b7f718acaceba9408ad16d007cc4cb76e0a84
Author: Andy Wingo <address@hidden>
Date: Tue Nov 19 20:05:45 2013 +0100
Internal RTL excision in vm.c
* libguile/vm.c (vm_boot_continuation, vm_boot_continuation_code):
Rename from rtl_boot_continuation[_code].
(scm_bootstrap_vm):
* libguile/vm-engine.c (rtl_vm_engine): Adapt.
commit 827c2c26fc75c6c6686efbaca737d2736be5887e
Author: Andy Wingo <address@hidden>
Date: Tue Nov 19 20:02:49 2013 +0100
Small comment fix.
* libguile/vm-builtins.h: Rename RTL to VM in a comment.
commit 8bf83893c746326dd1f10f1381423bd0406cf58c
Author: Andy Wingo <address@hidden>
Date: Tue Nov 19 20:02:15 2013 +0100
Rename DT_GUILE_VM_VERSION.
* libguile/objcodes.c (DT_GUILE_VM_VERSION, process_dynamic_segment):
* module/system/vm/elf.scm (DT_GUILE_VM_VERSION): Rename from
DT_GUILE_RTL_VERSION.
* module/system/vm/assembler.scm (link-dynamic-section): Adapt.
commit 6b9470bf483e14e10ae85fc6bcbc25b4e2e77ff7
Author: Andy Wingo <address@hidden>
Date: Tue Nov 19 19:50:15 2013 +0100
Rename internal rtl-program-properties -> program-properties
* module/system/vm/program.scm (program-properties): Rename from
rtl-program-properties.
* libguile/programs.c (scm_i_program_properties): Adapt.
commit 2b4d21d53e800e1af61caf6c8393660fe392c628
Author: Andy Wingo <address@hidden>
Date: Tue Nov 19 19:47:33 2013 +0100
Excise "rtl-" from fallback program printer
* libguile/programs.c (scm_i_program_print): Fallback printer uses
"program", not "rtl-program".
commit 34cf09ccdf33fed42af9bda1f59252db9af9f7af
Author: Andy Wingo <address@hidden>
Date: Tue Nov 19 19:45:56 2013 +0100
Rename internals of (system vm program) program-minimum-arity
* module/system/vm/debug.scm (find-program-minimum-arity): Rename from
program-minimum-arity.
* module/system/vm/program.scm (program-minimum-arity): Rename from
rtl-program-minimum-arity.
* libguile/programs.c (scm_i_program_arity): Adapt.
commit 2e12c1a2b7a5d066a4ef07b32c19cdf8d2f1738b
Author: Andy Wingo <address@hidden>
Date: Tue Nov 19 19:36:16 2013 +0100
Rename (system vm program) internal functions to remove rtl-
* module/system/vm/program.scm (program-name)
(program-documentation): Rename (removing rtl-).
* libguile/programs.c (scm_i_program_name):
(scm_i_program_documentation): Adapt callers.
commit fd5621f8680e6a9a919324ed47a63cbdaa8a15ab
Author: Andy Wingo <address@hidden>
Date: Tue Nov 19 19:19:55 2013 +0100
Remove unused C scm_program_source.
* libguile/programs.c (scm_program_source): Remove; not called. (The
definition is in Scheme.)
commit a1eb8d1168c35889d50893e636eee7cfec581cba
Author: Andy Wingo <address@hidden>
Date: Tue Nov 19 19:18:36 2013 +0100
Reorganize programs.h.
* libguile/programs.h: Reorganize.
commit d1100525ff1b4e6e1fdb7d818cef3ec7a838e002
Author: Andy Wingo <address@hidden>
Date: Tue Nov 19 19:16:26 2013 +0100
rtl-program-code -> program-code
* libguile/programs.h:
* libguile/programs.c (scm_program_code): Rename from
scm_rtl_program_code. Also renames rtl-program-code to program-code.
* module/statprof.scm:
* module/system/repl/command.scm:
* module/system/repl/debug.scm:
* module/system/vm/coverage.scm:
* module/system/vm/disassembler.scm:
* module/system/vm/program.scm:
* module/system/vm/traps.scm:
* test-suite/tests/dwarf.test:
* test-suite/tests/rtl.test: Adapt callers.
commit 0bd1e9c6a0420816111e4dc109d6dd30f9f8cd73
Author: Andy Wingo <address@hidden>
Date: Tue Nov 19 19:11:40 2013 +0100
rtl-program? -> program?
* libguile/programs.c (scm_program_p): Rename from scm_rtl_program_p.
Changes name also from rtl-program? to program?.
* libguile/programs.h:
* module/ice-9/session.scm:
* module/language/tree-il/analyze.scm:
* module/statprof.scm:
* module/system/repl/command.scm:
* module/system/repl/debug.scm:
* module/system/vm/coverage.scm:
* module/system/vm/disassembler.scm:
* module/system/vm/frame.scm:
* module/system/vm/program.scm:
* module/system/vm/traps.scm:
* module/system/xref.scm: Adapt.
commit edba822553cfa95c907bf3ecb4c4879723ef92ee
Author: Andy Wingo <address@hidden>
Date: Tue Nov 19 19:03:09 2013 +0100
Remove make-rtl-program.
* libguile/programs.h:
* libguile/programs.c (scm_make_rtl_program): Remove. Unused.
* module/system/vm/program.scm (system): Remove make-rtl-program
export. Unused.
commit 8079714576442964f84d215f3edbad5f07ae3911
Author: Andy Wingo <address@hidden>
Date: Tue Nov 19 18:57:31 2013 +0100
scm_i_rtl_program_* -> scm_i_program_*
* libguile/programs.h (scm_i_make_program):
* libguile/programs.c (scm_i_program_name):
(scm_i_program_documentation):
(scm_i_program_properties): Remove "rtl_" infix.
* libguile/objcodes.c:
* libguile/procprop.c:
* libguile/vm.c: Adapt callers.
commit e326baac0bc4b3049a97f429349f2c3c5a22b8a3
Author: Andy Wingo <address@hidden>
Date: Tue Nov 19 18:55:03 2013 +0100
scm_i_make_rtl_program in BUILDING_LIBGUILE
* libguile/programs.h (scm_i_make_rtl_program): Enclose in a
BUILDING_LIBGUILE guard.
commit d798a895cccf4a25bfecd2785eb347903b76213b
Author: Andy Wingo <address@hidden>
Date: Tue Nov 19 18:28:19 2013 +0100
Remove RTL_ infix from macros
* libguile/programs.h (SCM_PROGRAM_P):
(SCM_PROGRAM_CODE):
(SCM_PROGRAM_FREE_VARIABLES):
(SCM_PROGRAM_FREE_VARIABLE_REF):
(SCM_PROGRAM_FREE_VARIABLE_SET):
(SCM_PROGRAM_NUM_FREE_VARIABLES):
(SCM_VALIDATE_PROGRAM): Remove RTL_ infix.
* libguile/continuations.c:
* libguile/continuations.h:
* libguile/control.c:
* libguile/foreign.c:
* libguile/frames.c:
* libguile/gsubr.c:
* libguile/gsubr.h:
* libguile/procprop.c:
* libguile/procs.c:
* libguile/programs.c:
* libguile/stacks.c:
* libguile/vm-engine.c: Adapt.
commit e0755cd12ae365c1b903fc6c57afb17231cf5468
Author: Andy Wingo <address@hidden>
Date: Tue Nov 19 18:24:22 2013 +0100
Rename scm_tc7_rtl_program to scm_tc7_program
* libguile/tags.h (scm_tc7_program): Rename from scm_tc7_rtl_program.
* libguile/continuations.c:
* libguile/control.c:
* libguile/evalext.c:
* libguile/foreign.c:
* libguile/goops.c:
* libguile/gsubr.c:
* libguile/print.c:
* libguile/programs.c:
* libguile/programs.h:
* libguile/vm-engine.c: Adapt users.
* module/system/vm/assembler.scm: Rename a tc7-rtl-program local to
tc7-program.
* libguile/tags.h (scm_tc7_program): Rename from scm_tc7_rtl_program. *
libguile/continuations.c: * libguile/control.c: * libguile/evalext.c: *
libguile/foreign.c: * libguile/goops.c: * libguile/gsubr.c: * libguile/print.c:
* libguile/programs.c: * libguile/programs.h: * libguile/vm-engine.c: Adapt
users.
* module/system/vm/assembler.scm: Rename a tc7-rtl-program local to
tc7-program.
commit 9121d9f1ac21a91d2031a186a5b3c77d551acaa4
Author: Andy Wingo <address@hidden>
Date: Tue Nov 19 18:09:34 2013 +0100
All instruction pointers are now scm_t_uint32*
* libguile/frames.h (SCM_FRAME_RTL_RETURN_ADDRESS)
(SCM_FRAME_SET_RTL_RETURN_ADDRESS): Remove. The variants without _RTL
now work fine.
(struct scm_vm_frame): Change the return address to be a
scm_t_uint32*.
(struct scm_frame): Change IP to be scm_t_uint32*.
* libguile/frames.c (scm_c_make_frame)
* libguile/control.c (reify_partial_continuation, scm_c_abort)
* libguile/dynstack.c (PROMPT_IP)
(scm_dynstack_push_prompt, scm_dynstack_find_prompt)
* libguile/dynstack.h:
* libguile/vm-engine.c (SYNC_IP, RETURN_ONE_VALUE)
(call, return-values, prompt): Adapt.
-----------------------------------------------------------------------
Summary of changes:
libguile/continuations.c | 6 +-
libguile/continuations.h | 2 +-
libguile/control.c | 10 ++-
libguile/dynstack.c | 6 +-
libguile/dynstack.h | 4 +-
libguile/evalext.c | 2 +-
libguile/foreign.c | 8 +-
libguile/frames.c | 4 +-
libguile/frames.h | 14 +---
libguile/goops.c | 2 +-
libguile/gsubr.c | 12 ++--
libguile/gsubr.h | 10 ++--
libguile/objcodes.c | 10 ++--
libguile/print.c | 2 +-
libguile/procprop.c | 14 ++--
libguile/procs.c | 2 +-
libguile/programs.c | 133 +++++++++++------------------------
libguile/programs.h | 60 +++++++--------
libguile/stacks.c | 2 +-
libguile/tags.h | 2 +-
libguile/vm-builtins.h | 2 +-
libguile/vm-engine.c | 56 +++++++-------
libguile/vm.c | 14 ++--
libguile/vm.h | 6 +-
module/ice-9/session.scm | 2 +-
module/language/tree-il/analyze.scm | 2 +-
module/statprof.scm | 6 +-
module/system/repl/command.scm | 4 +-
module/system/repl/debug.scm | 4 +-
module/system/vm/assembler.scm | 8 +-
module/system/vm/coverage.scm | 6 +-
module/system/vm/debug.scm | 6 +-
module/system/vm/disassembler.scm | 8 +-
module/system/vm/elf.scm | 4 +-
module/system/vm/frame.scm | 2 +-
module/system/vm/program.scm | 46 +++++-------
module/system/vm/traps.scm | 10 ++--
module/system/xref.scm | 9 +--
test-suite/tests/dwarf.test | 8 +-
test-suite/tests/rtl.test | 6 +-
40 files changed, 221 insertions(+), 293 deletions(-)
diff --git a/libguile/continuations.c b/libguile/continuations.c
index 21fc5e2..90c9ccf 100644
--- a/libguile/continuations.c
+++ b/libguile/continuations.c
@@ -75,9 +75,9 @@ make_continuation_trampoline (SCM contregs)
scm_t_bits nfree = 1;
scm_t_bits flags = SCM_F_PROGRAM_IS_CONTINUATION;
- ret = scm_words (scm_tc7_rtl_program | (nfree << 16) | flags, nfree + 2);
+ ret = scm_words (scm_tc7_program | (nfree << 16) | flags, nfree + 2);
SCM_SET_CELL_WORD_1 (ret, continuation_stub_code);
- SCM_RTL_PROGRAM_FREE_VARIABLE_SET (ret, 0, contregs);
+ SCM_PROGRAM_FREE_VARIABLE_SET (ret, 0, contregs);
return ret;
}
@@ -171,7 +171,7 @@ scm_i_continuation_to_frame (SCM continuation)
SCM contregs;
scm_t_contregs *cont;
- contregs = SCM_RTL_PROGRAM_FREE_VARIABLE_REF (continuation, 0);
+ contregs = SCM_PROGRAM_FREE_VARIABLE_REF (continuation, 0);
cont = SCM_CONTREGS (contregs);
if (scm_is_true (cont->vm_cont))
diff --git a/libguile/continuations.h b/libguile/continuations.h
index ca658bd..868a256 100644
--- a/libguile/continuations.h
+++ b/libguile/continuations.h
@@ -32,7 +32,7 @@
#define SCM_CONTINUATIONP(x) \
- (SCM_RTL_PROGRAM_P (x) && SCM_PROGRAM_IS_CONTINUATION (x))
+ (SCM_PROGRAM_P (x) && SCM_PROGRAM_IS_CONTINUATION (x))
/* a continuation SCM is a non-immediate pointing to a heap cell with:
word 0: bits 0-15: smob type tag: scm_tc16_continuation.
diff --git a/libguile/control.c b/libguile/control.c
index 3e5c0d8..dbd6522 100644
--- a/libguile/control.c
+++ b/libguile/control.c
@@ -70,16 +70,18 @@ make_partial_continuation (SCM vm_cont)
scm_t_bits flags = SCM_F_PROGRAM_IS_PARTIAL_CONTINUATION;
SCM ret;
- ret = scm_words (scm_tc7_rtl_program | (nfree << 16) | flags, nfree + 2);
+ ret = scm_words (scm_tc7_program | (nfree << 16) | flags, nfree + 2);
SCM_SET_CELL_WORD_1 (ret, compose_continuation_code);
- SCM_RTL_PROGRAM_FREE_VARIABLE_SET (ret, 0, vm_cont);
+ SCM_PROGRAM_FREE_VARIABLE_SET (ret, 0, vm_cont);
return ret;
}
static SCM
reify_partial_continuation (SCM vm,
- SCM *saved_fp, SCM *saved_sp, scm_t_uint8
*saved_ip,
+ SCM *saved_fp,
+ SCM *saved_sp,
+ scm_t_uint32 *saved_ip,
scm_i_jmp_buf *saved_registers,
scm_t_dynstack *dynstack,
scm_i_jmp_buf *current_registers)
@@ -128,7 +130,7 @@ scm_c_abort (SCM vm, SCM tag, size_t n, SCM *argv,
scm_t_bits *prompt;
scm_t_dynstack_prompt_flags flags;
SCM *fp, *sp;
- scm_t_uint8 *ip;
+ scm_t_uint32 *ip;
scm_i_jmp_buf *registers;
size_t i;
diff --git a/libguile/dynstack.c b/libguile/dynstack.c
index 5f19a2b..2d8895e 100644
--- a/libguile/dynstack.c
+++ b/libguile/dynstack.c
@@ -38,7 +38,7 @@
#define PROMPT_KEY(top) (SCM_PACK ((top)[0]))
#define PROMPT_FP(top) ((SCM *) ((top)[1]))
#define PROMPT_SP(top) ((SCM *) ((top)[2]))
-#define PROMPT_IP(top) ((scm_t_uint8 *) ((top)[3]))
+#define PROMPT_IP(top) ((scm_t_uint32 *) ((top)[3]))
#define PROMPT_JMPBUF(top) ((scm_i_jmp_buf *) ((top)[4]))
#define WINDER_WORDS 2
@@ -186,7 +186,7 @@ void
scm_dynstack_push_prompt (scm_t_dynstack *dynstack,
scm_t_dynstack_prompt_flags flags,
SCM key,
- SCM *fp, SCM *sp, scm_t_uint8 *ip,
+ SCM *fp, SCM *sp, scm_t_uint32 *ip,
scm_i_jmp_buf *registers)
{
scm_t_bits *words;
@@ -442,7 +442,7 @@ scm_dynstack_unwind_fork (scm_t_dynstack *dynstack,
scm_t_dynstack *branch)
scm_t_bits*
scm_dynstack_find_prompt (scm_t_dynstack *dynstack, SCM key,
scm_t_dynstack_prompt_flags *flags,
- SCM **fp, SCM **sp, scm_t_uint8 **ip,
+ SCM **fp, SCM **sp, scm_t_uint32 **ip,
scm_i_jmp_buf **registers)
{
scm_t_bits *walk;
diff --git a/libguile/dynstack.h b/libguile/dynstack.h
index 08e36a2..fe5bb54 100644
--- a/libguile/dynstack.h
+++ b/libguile/dynstack.h
@@ -155,7 +155,7 @@ SCM_INTERNAL void scm_dynstack_push_fluid (scm_t_dynstack *,
SCM_INTERNAL void scm_dynstack_push_prompt (scm_t_dynstack *,
scm_t_dynstack_prompt_flags,
SCM key,
- SCM *fp, SCM *sp, scm_t_uint8 *ip,
+ SCM *fp, SCM *sp, scm_t_uint32 *ip,
scm_i_jmp_buf *registers);
SCM_INTERNAL void scm_dynstack_push_dynwind (scm_t_dynstack *,
SCM enter, SCM leave);
@@ -191,7 +191,7 @@ SCM_INTERNAL void scm_dynstack_unwind_fluid (scm_t_dynstack
*dynstack,
SCM_INTERNAL scm_t_bits* scm_dynstack_find_prompt (scm_t_dynstack *, SCM,
scm_t_dynstack_prompt_flags
*,
- SCM **, SCM **, scm_t_uint8
**,
+ SCM **, SCM **,
scm_t_uint32 **,
scm_i_jmp_buf **);
SCM_INTERNAL void scm_dynstack_wind_prompt (scm_t_dynstack *, scm_t_bits *,
diff --git a/libguile/evalext.c b/libguile/evalext.c
index 897cabe..d80dee7 100644
--- a/libguile/evalext.c
+++ b/libguile/evalext.c
@@ -86,7 +86,7 @@ SCM_DEFINE (scm_self_evaluating_p, "self-evaluating?", 1, 0,
0,
case scm_tc7_number:
case scm_tc7_string:
case scm_tc7_smob:
- case scm_tc7_rtl_program:
+ case scm_tc7_program:
case scm_tc7_bytevector:
case scm_tc7_array:
case scm_tc7_bitvector:
diff --git a/libguile/foreign.c b/libguile/foreign.c
index ac7cf8c..2ec0a1e 100644
--- a/libguile/foreign.c
+++ b/libguile/foreign.c
@@ -796,7 +796,7 @@ get_foreign_stub_code (unsigned int nargs)
int
scm_i_foreign_arity (SCM foreign, int *req, int *opt, int *rest)
{
- const scm_t_uint32 *code = SCM_RTL_PROGRAM_CODE (foreign);
+ const scm_t_uint32 *code = SCM_PROGRAM_CODE (foreign);
if (code < foreign_stub_code)
return 0;
@@ -821,10 +821,10 @@ cif_to_procedure (SCM cif, SCM func_ptr)
c_cif = (ffi_cif *) SCM_POINTER_VALUE (cif);
- ret = scm_words (scm_tc7_rtl_program | (nfree << 16) | flags, nfree + 2);
+ ret = scm_words (scm_tc7_program | (nfree << 16) | flags, nfree + 2);
SCM_SET_CELL_WORD_1 (ret, get_foreign_stub_code (c_cif->nargs));
- SCM_RTL_PROGRAM_FREE_VARIABLE_SET (ret, 0, cif);
- SCM_RTL_PROGRAM_FREE_VARIABLE_SET (ret, 1, func_ptr);
+ SCM_PROGRAM_FREE_VARIABLE_SET (ret, 0, cif);
+ SCM_PROGRAM_FREE_VARIABLE_SET (ret, 1, func_ptr);
return ret;
}
diff --git a/libguile/frames.c b/libguile/frames.c
index 8ca628a..776ded5 100644
--- a/libguile/frames.c
+++ b/libguile/frames.c
@@ -37,7 +37,7 @@ verify (offsetof (struct scm_vm_frame, dynamic_link) == 0);
SCM
scm_c_make_frame (SCM stack_holder, SCM *fp, SCM *sp,
- scm_t_uint8 *ip, scm_t_ptrdiff offset)
+ scm_t_uint32 *ip, scm_t_ptrdiff offset)
{
struct scm_frame *p = scm_gc_malloc (sizeof (struct scm_frame),
"vmframe");
@@ -252,7 +252,7 @@ SCM_DEFINE (scm_frame_previous, "frame-previous", 1, 0, 0,
SCM_VM_FRAME_OFFSET (frame));
proc = scm_frame_procedure (frame);
- if (SCM_RTL_PROGRAM_P (proc) && SCM_PROGRAM_IS_BOOT (proc))
+ if (SCM_PROGRAM_P (proc) && SCM_PROGRAM_IS_BOOT (proc))
goto again;
else
return frame;
diff --git a/libguile/frames.h b/libguile/frames.h
index bc52165..d425b94 100644
--- a/libguile/frames.h
+++ b/libguile/frames.h
@@ -85,7 +85,7 @@
struct scm_vm_frame
{
SCM *dynamic_link;
- scm_t_uint8 *return_address;
+ scm_t_uint32 *return_address;
SCM locals[1]; /* Variable-length */
};
@@ -132,14 +132,6 @@ struct scm_vm_frame
#define SCM_FRAME_PROGRAM(fp) (SCM_FRAME_LOCAL (fp, 0))
-
-/* FIXME: Replace SCM_FRAME_RETURN_ADDRESS with these. */
-#define SCM_FRAME_RTL_RETURN_ADDRESS(fp) \
- ((scm_t_uint32 *) SCM_FRAME_RETURN_ADDRESS (fp))
-#define SCM_FRAME_SET_RTL_RETURN_ADDRESS(fp, ip) \
- SCM_FRAME_SET_RETURN_ADDRESS (fp, (scm_t_uint8 *) (ip))
-
-
/*
* Heap frames
*/
@@ -149,7 +141,7 @@ struct scm_frame
SCM stack_holder;
SCM *fp;
SCM *sp;
- scm_t_uint8 *ip;
+ scm_t_uint32 *ip;
scm_t_ptrdiff offset;
};
@@ -163,7 +155,7 @@ struct scm_frame
#define SCM_VALIDATE_VM_FRAME(p,x) SCM_MAKE_VALIDATE (p, x, VM_FRAME_P)
SCM_API SCM scm_c_make_frame (SCM stack_holder, SCM *fp, SCM *sp,
- scm_t_uint8 *ip, scm_t_ptrdiff offset);
+ scm_t_uint32 *ip, scm_t_ptrdiff offset);
SCM_API SCM scm_frame_p (SCM obj);
SCM_API SCM scm_frame_procedure (SCM frame);
SCM_API SCM scm_frame_arguments (SCM frame);
diff --git a/libguile/goops.c b/libguile/goops.c
index 1f56d34..ca1c157 100644
--- a/libguile/goops.c
+++ b/libguile/goops.c
@@ -291,7 +291,7 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
case scm_tc16_fraction:
return scm_class_fraction;
}
- case scm_tc7_rtl_program:
+ case scm_tc7_program:
if (SCM_PROGRAM_IS_PRIMITIVE_GENERIC (x)
&& SCM_UNPACK (*SCM_SUBR_GENERIC (x)))
return scm_class_primitive_generic;
diff --git a/libguile/gsubr.c b/libguile/gsubr.c
index 96fab4e..f089a41 100644
--- a/libguile/gsubr.c
+++ b/libguile/gsubr.c
@@ -239,12 +239,12 @@ create_subr (int define, const char *name,
flags = SCM_F_PROGRAM_IS_PRIMITIVE;
flags |= generic_loc ? SCM_F_PROGRAM_IS_PRIMITIVE_GENERIC : 0;
- ret = scm_words (scm_tc7_rtl_program | (nfree << 16) | flags, nfree + 2);
+ ret = scm_words (scm_tc7_program | (nfree << 16) | flags, nfree + 2);
SCM_SET_CELL_WORD_1 (ret, get_subr_stub_code (nreq, nopt, rest));
- SCM_RTL_PROGRAM_FREE_VARIABLE_SET (ret, 0, scm_from_pointer (fcn, NULL));
- SCM_RTL_PROGRAM_FREE_VARIABLE_SET (ret, 1, sname);
+ SCM_PROGRAM_FREE_VARIABLE_SET (ret, 0, scm_from_pointer (fcn, NULL));
+ SCM_PROGRAM_FREE_VARIABLE_SET (ret, 1, sname);
if (generic_loc)
- SCM_RTL_PROGRAM_FREE_VARIABLE_SET (ret, 2,
+ SCM_PROGRAM_FREE_VARIABLE_SET (ret, 2,
scm_from_pointer (generic_loc, NULL));
if (define)
@@ -259,7 +259,7 @@ create_subr (int define, const char *name,
int
scm_i_primitive_arity (SCM prim, int *req, int *opt, int *rest)
{
- const scm_t_uint32 *code = SCM_RTL_PROGRAM_CODE (prim);
+ const scm_t_uint32 *code = SCM_PROGRAM_CODE (prim);
unsigned idx, nargs, base, next;
if (code < subr_stub_code)
@@ -289,7 +289,7 @@ scm_i_primitive_arity (SCM prim, int *req, int *opt, int
*rest)
scm_t_uintptr
scm_i_primitive_call_ip (SCM subr)
{
- const scm_t_uint32 *code = SCM_RTL_PROGRAM_CODE (subr);
+ const scm_t_uint32 *code = SCM_PROGRAM_CODE (subr);
/* A stub is 4 32-bit words long, or 16 bytes. The call will be one
instruction, in either the fourth, third, or second word. Return a
diff --git a/libguile/gsubr.h b/libguile/gsubr.h
index 3350e2f..065b947 100644
--- a/libguile/gsubr.h
+++ b/libguile/gsubr.h
@@ -36,18 +36,18 @@
/* Max number of args to the C procedure backing a gsubr */
#define SCM_GSUBR_MAX 10
-#define SCM_PRIMITIVE_P(x) (SCM_RTL_PROGRAM_P (x) && SCM_PROGRAM_IS_PRIMITIVE
(x))
+#define SCM_PRIMITIVE_P(x) (SCM_PROGRAM_P (x) && SCM_PROGRAM_IS_PRIMITIVE (x))
-#define SCM_PRIMITIVE_GENERIC_P(x) (SCM_RTL_PROGRAM_P (x) &&
SCM_PROGRAM_IS_PRIMITIVE_GENERIC (x))
+#define SCM_PRIMITIVE_GENERIC_P(x) (SCM_PROGRAM_P (x) &&
SCM_PROGRAM_IS_PRIMITIVE_GENERIC (x))
#define SCM_SUBRF(x) \
((SCM (*) (void)) \
- SCM_POINTER_VALUE (SCM_RTL_PROGRAM_FREE_VARIABLE_REF (x, 0)))
+ SCM_POINTER_VALUE (SCM_PROGRAM_FREE_VARIABLE_REF (x, 0)))
-#define SCM_SUBR_NAME(x) (SCM_RTL_PROGRAM_FREE_VARIABLE_REF (x, 1))
+#define SCM_SUBR_NAME(x) (SCM_PROGRAM_FREE_VARIABLE_REF (x, 1))
#define SCM_SUBR_GENERIC(x) \
- ((SCM *) SCM_POINTER_VALUE (SCM_RTL_PROGRAM_FREE_VARIABLE_REF (x, 2)))
+ ((SCM *) SCM_POINTER_VALUE (SCM_PROGRAM_FREE_VARIABLE_REF (x, 2)))
#define SCM_SET_SUBR_GENERIC(x, g) \
(*SCM_SUBR_GENERIC (x) = (g))
diff --git a/libguile/objcodes.c b/libguile/objcodes.c
index 0515a7c..52ba7b8 100644
--- a/libguile/objcodes.c
+++ b/libguile/objcodes.c
@@ -68,7 +68,7 @@
#define DT_GUILE_GC_ROOT_SZ 0x37146001 /* Size in machine words of GC
roots */
#define DT_GUILE_ENTRY 0x37146002 /* Address of entry thunk */
-#define DT_GUILE_RTL_VERSION 0x37146003 /* Bytecode version */
+#define DT_GUILE_VM_VERSION 0x37146003 /* Bytecode version */
#define DT_HIGUILE 0x37146fff /* End of Guile-specific */
#ifdef WORDS_BIGENDIAN
@@ -92,7 +92,7 @@ pointer_to_procedure (enum bytecode_kind bytecode_kind, char
*ptr)
{
case BYTECODE_KIND_GUILE_2_2:
{
- return scm_i_make_rtl_program ((scm_t_uint32 *) ptr);
+ return scm_i_make_program ((scm_t_uint32 *) ptr);
}
case BYTECODE_KIND_NONE:
default:
@@ -280,9 +280,9 @@ process_dynamic_segment (char *base, Elf_Phdr *dyn_phdr,
return "duplicate DT_GUILE_ENTRY";
entry = base + dyn[i].d_un.d_val;
break;
- case DT_GUILE_RTL_VERSION:
+ case DT_GUILE_VM_VERSION:
if (bytecode_kind != BYTECODE_KIND_NONE)
- return "duplicate DT_GUILE_RTL_VERSION";
+ return "duplicate DT_GUILE_VM_VERSION";
{
scm_t_uint16 major = dyn[i].d_un.d_val >> 16;
scm_t_uint16 minor = dyn[i].d_un.d_val & 0xffff;
@@ -319,7 +319,7 @@ process_dynamic_segment (char *base, Elf_Phdr *dyn_phdr,
break;
case BYTECODE_KIND_NONE:
default:
- return "missing DT_GUILE_RTL_VERSION";
+ return "missing DT_GUILE_VM_VERSION";
}
if (gc_root)
diff --git a/libguile/print.c b/libguile/print.c
index 2091539..4809fd6 100644
--- a/libguile/print.c
+++ b/libguile/print.c
@@ -660,7 +660,7 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
case scm_tc7_variable:
scm_i_variable_print (exp, port, pstate);
break;
- case scm_tc7_rtl_program:
+ case scm_tc7_program:
scm_i_program_print (exp, port, pstate);
break;
case scm_tc7_pointer:
diff --git a/libguile/procprop.c b/libguile/procprop.c
index 488edcc..d455360 100644
--- a/libguile/procprop.c
+++ b/libguile/procprop.c
@@ -61,7 +61,7 @@ scm_i_procedure_arity (SCM proc, int *req, int *opt, int
*rest)
return 1;
}
- while (!SCM_RTL_PROGRAM_P (proc))
+ while (!SCM_PROGRAM_P (proc))
{
if (SCM_STRUCTP (proc))
{
@@ -146,8 +146,8 @@ SCM_DEFINE (scm_procedure_properties,
"procedure-properties", 1, 0, 0,
if (scm_is_pair (user_props) && scm_is_true (scm_car (user_props)))
return scm_cdr (user_props);
- if (SCM_RTL_PROGRAM_P (proc))
- ret = scm_i_rtl_program_properties (proc);
+ if (SCM_PROGRAM_P (proc))
+ ret = scm_i_program_properties (proc);
else
ret = SCM_EOL;
@@ -258,8 +258,8 @@ SCM_DEFINE (scm_procedure_name, "procedure-name", 1, 0, 0,
return SCM_BOOL_F;
}
- if (SCM_RTL_PROGRAM_P (proc))
- return scm_i_rtl_program_name (proc);
+ if (SCM_PROGRAM_P (proc))
+ return scm_i_program_name (proc);
else if (SCM_STRUCTP (proc) && SCM_STRUCT_APPLICABLE_P (proc))
return scm_procedure_name (SCM_STRUCT_PROCEDURE (proc));
else
@@ -295,8 +295,8 @@ SCM_DEFINE (scm_procedure_documentation,
"procedure-documentation", 1, 0, 0,
return SCM_BOOL_F;
}
- if (SCM_RTL_PROGRAM_P (proc))
- return scm_i_rtl_program_documentation (proc);
+ if (SCM_PROGRAM_P (proc))
+ return scm_i_program_documentation (proc);
else
return SCM_BOOL_F;
}
diff --git a/libguile/procs.c b/libguile/procs.c
index bf965ee..bbc80cf 100644
--- a/libguile/procs.c
+++ b/libguile/procs.c
@@ -47,7 +47,7 @@ SCM_DEFINE (scm_procedure_p, "procedure?", 1, 0, 0,
"Return @code{#t} if @var{obj} is a procedure.")
#define FUNC_NAME s_scm_procedure_p
{
- return scm_from_bool (SCM_RTL_PROGRAM_P (obj)
+ return scm_from_bool (SCM_PROGRAM_P (obj)
|| (SCM_STRUCTP (obj) && SCM_STRUCT_APPLICABLE_P (obj))
|| (SCM_HAS_TYP7 (obj, scm_tc7_smob)
&& SCM_SMOB_APPLICABLE_P (obj)));
diff --git a/libguile/programs.c b/libguile/programs.c
index a2c3fc9..fae95d0 100644
--- a/libguile/programs.c
+++ b/libguile/programs.c
@@ -30,96 +30,65 @@
static SCM write_program = SCM_BOOL_F;
-SCM_DEFINE (scm_make_rtl_program, "make-rtl-program", 1, 2, 0,
- (SCM bytevector, SCM byte_offset, SCM free_variables),
- "")
-#define FUNC_NAME s_scm_make_rtl_program
-{
- scm_t_uint8 *code;
- scm_t_uint32 offset;
-
- if (!scm_is_bytevector (bytevector))
- scm_wrong_type_arg (FUNC_NAME, 1, bytevector);
- if (SCM_UNBNDP (byte_offset))
- offset = 0;
- else
- {
- offset = scm_to_uint32 (byte_offset);
- if (offset > SCM_BYTEVECTOR_LENGTH (bytevector))
- SCM_OUT_OF_RANGE (2, byte_offset);
- }
-
- code = (scm_t_uint8*) SCM_BYTEVECTOR_CONTENTS (bytevector) + offset;
- if (((scm_t_uintptr) code) % 4)
- SCM_OUT_OF_RANGE (2, byte_offset);
-
- if (SCM_UNBNDP (free_variables) || scm_is_false (free_variables))
- return scm_cell (scm_tc7_rtl_program, (scm_t_bits) code);
- else
- abort ();
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_rtl_program_code, "rtl-program-code", 1, 0, 0,
+SCM_DEFINE (scm_program_code, "program-code", 1, 0, 0,
(SCM program),
"")
-#define FUNC_NAME s_scm_rtl_program_code
+#define FUNC_NAME s_scm_program_code
{
- SCM_VALIDATE_RTL_PROGRAM (1, program);
+ SCM_VALIDATE_PROGRAM (1, program);
- return scm_from_uintptr_t ((scm_t_uintptr) SCM_RTL_PROGRAM_CODE (program));
+ return scm_from_uintptr_t ((scm_t_uintptr) SCM_PROGRAM_CODE (program));
}
#undef FUNC_NAME
SCM
-scm_i_rtl_program_name (SCM program)
+scm_i_program_name (SCM program)
{
- static SCM rtl_program_name = SCM_BOOL_F;
+ static SCM program_name = SCM_BOOL_F;
if (SCM_PRIMITIVE_P (program))
return SCM_SUBR_NAME (program);
- if (scm_is_false (rtl_program_name) && scm_module_system_booted_p)
- rtl_program_name =
- scm_c_private_variable ("system vm program", "rtl-program-name");
+ if (scm_is_false (program_name) && scm_module_system_booted_p)
+ program_name =
+ scm_c_private_variable ("system vm program", "program-name");
- return scm_call_1 (scm_variable_ref (rtl_program_name), program);
+ return scm_call_1 (scm_variable_ref (program_name), program);
}
SCM
-scm_i_rtl_program_documentation (SCM program)
+scm_i_program_documentation (SCM program)
{
- static SCM rtl_program_documentation = SCM_BOOL_F;
+ static SCM program_documentation = SCM_BOOL_F;
if (SCM_PRIMITIVE_P (program))
return SCM_BOOL_F;
- if (scm_is_false (rtl_program_documentation) && scm_module_system_booted_p)
- rtl_program_documentation =
- scm_c_private_variable ("system vm program",
- "rtl-program-documentation");
+ if (scm_is_false (program_documentation) && scm_module_system_booted_p)
+ program_documentation =
+ scm_c_private_variable ("system vm program", "program-documentation");
- return scm_call_1 (scm_variable_ref (rtl_program_documentation), program);
+ return scm_call_1 (scm_variable_ref (program_documentation), program);
}
SCM
-scm_i_rtl_program_properties (SCM program)
+scm_i_program_properties (SCM program)
{
- static SCM rtl_program_properties = SCM_BOOL_F;
+ static SCM program_properties = SCM_BOOL_F;
if (SCM_PRIMITIVE_P (program))
{
- SCM name = scm_i_rtl_program_name (program);
+ SCM name = scm_i_program_name (program);
if (scm_is_false (name))
return SCM_EOL;
return scm_acons (scm_sym_name, name, SCM_EOL);
}
- if (scm_is_false (rtl_program_properties) && scm_module_system_booted_p)
- rtl_program_properties =
- scm_c_private_variable ("system vm program", "rtl-program-properties");
+ if (scm_is_false (program_properties) && scm_module_system_booted_p)
+ program_properties =
+ scm_c_private_variable ("system vm program", "program-properties");
- return scm_call_1 (scm_variable_ref (rtl_program_properties), program);
+ return scm_call_1 (scm_variable_ref (program_properties), program);
}
void
@@ -147,10 +116,10 @@ scm_i_program_print (SCM program, SCM port,
scm_print_state *pstate)
}
else if (scm_is_false (write_program) || print_error)
{
- scm_puts_unlocked ("#<rtl-program ", port);
+ scm_puts_unlocked ("#<program ", port);
scm_uintprint (SCM_UNPACK (program), 16, port);
scm_putc_unlocked (' ', port);
- scm_uintprint ((scm_t_uintptr) SCM_RTL_PROGRAM_CODE (program), 16, port);
+ scm_uintprint ((scm_t_uintptr) SCM_PROGRAM_CODE (program), 16, port);
scm_putc_unlocked ('>', port);
}
else
@@ -166,12 +135,12 @@ scm_i_program_print (SCM program, SCM port,
scm_print_state *pstate)
* Scheme interface
*/
-SCM_DEFINE (scm_rtl_program_p, "rtl-program?", 1, 0, 0,
+SCM_DEFINE (scm_program_p, "program?", 1, 0, 0,
(SCM obj),
"")
-#define FUNC_NAME s_scm_rtl_program_p
+#define FUNC_NAME s_scm_program_p
{
- return scm_from_bool (SCM_RTL_PROGRAM_P (obj));
+ return scm_from_bool (SCM_PROGRAM_P (obj));
}
#undef FUNC_NAME
@@ -211,33 +180,14 @@ scm_find_source_for_addr (SCM ip)
return scm_call_1 (scm_variable_ref (source_for_addr), ip);
}
-SCM
-scm_program_source (SCM program, SCM ip, SCM sources)
-{
- static SCM program_source = SCM_BOOL_F;
-
- if (scm_is_false (program_source)) {
- if (!scm_module_system_booted_p)
- return SCM_BOOL_F;
-
- program_source =
- scm_c_private_variable ("system vm program", "program-source");
- }
-
- if (SCM_UNBNDP (sources))
- return scm_call_2 (scm_variable_ref (program_source), program, ip);
- else
- return scm_call_3 (scm_variable_ref (program_source), program, ip,
sources);
-}
-
SCM_DEFINE (scm_program_num_free_variables, "program-num-free-variables", 1,
0, 0,
(SCM program),
"")
#define FUNC_NAME s_scm_program_num_free_variables
{
- SCM_VALIDATE_RTL_PROGRAM (1, program);
+ SCM_VALIDATE_PROGRAM (1, program);
- return scm_from_ulong (SCM_RTL_PROGRAM_NUM_FREE_VARIABLES (program));
+ return scm_from_ulong (SCM_PROGRAM_NUM_FREE_VARIABLES (program));
}
#undef FUNC_NAME
@@ -248,11 +198,11 @@ SCM_DEFINE (scm_program_free_variable_ref,
"program-free-variable-ref", 2, 0, 0,
{
unsigned long idx;
- SCM_VALIDATE_RTL_PROGRAM (1, program);
+ SCM_VALIDATE_PROGRAM (1, program);
SCM_VALIDATE_ULONG_COPY (2, i, idx);
- if (idx >= SCM_RTL_PROGRAM_NUM_FREE_VARIABLES (program))
+ if (idx >= SCM_PROGRAM_NUM_FREE_VARIABLES (program))
SCM_OUT_OF_RANGE (2, i);
- return SCM_RTL_PROGRAM_FREE_VARIABLE_REF (program, idx);
+ return SCM_PROGRAM_FREE_VARIABLE_REF (program, idx);
}
#undef FUNC_NAME
@@ -263,11 +213,11 @@ SCM_DEFINE (scm_program_free_variable_set_x,
"program-free-variable-set!", 3, 0,
{
unsigned long idx;
- SCM_VALIDATE_RTL_PROGRAM (1, program);
+ SCM_VALIDATE_PROGRAM (1, program);
SCM_VALIDATE_ULONG_COPY (2, i, idx);
- if (idx >= SCM_RTL_PROGRAM_NUM_FREE_VARIABLES (program))
+ if (idx >= SCM_PROGRAM_NUM_FREE_VARIABLES (program))
SCM_OUT_OF_RANGE (2, i);
- SCM_RTL_PROGRAM_FREE_VARIABLE_SET (program, idx, x);
+ SCM_PROGRAM_FREE_VARIABLE_SET (program, idx, x);
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
@@ -275,7 +225,7 @@ SCM_DEFINE (scm_program_free_variable_set_x,
"program-free-variable-set!", 3, 0,
int
scm_i_program_arity (SCM program, int *req, int *opt, int *rest)
{
- static SCM rtl_program_minimum_arity = SCM_BOOL_F;
+ static SCM program_minimum_arity = SCM_BOOL_F;
SCM l;
if (SCM_PRIMITIVE_P (program))
@@ -292,12 +242,11 @@ scm_i_program_arity (SCM program, int *req, int *opt, int
*rest)
return 1;
}
- if (scm_is_false (rtl_program_minimum_arity) && scm_module_system_booted_p)
- rtl_program_minimum_arity =
- scm_c_private_variable ("system vm program",
- "rtl-program-minimum-arity");
+ if (scm_is_false (program_minimum_arity) && scm_module_system_booted_p)
+ program_minimum_arity =
+ scm_c_private_variable ("system vm program", "program-minimum-arity");
- l = scm_call_1 (scm_variable_ref (rtl_program_minimum_arity), program);
+ l = scm_call_1 (scm_variable_ref (program_minimum_arity), program);
if (scm_is_false (l))
return 0;
diff --git a/libguile/programs.h b/libguile/programs.h
index 4b28b6e..096c2c0 100644
--- a/libguile/programs.h
+++ b/libguile/programs.h
@@ -22,40 +22,17 @@
#include <libguile.h>
/*
- * The new RTL programs.
- */
-
-#define SCM_RTL_PROGRAM_P(x) (SCM_HAS_TYP7 (x, scm_tc7_rtl_program))
-#define SCM_RTL_PROGRAM_CODE(x) ((scm_t_uint32 *) SCM_CELL_WORD_1 (x))
-#define SCM_RTL_PROGRAM_FREE_VARIABLES(x) (SCM_CELL_OBJECT_LOC (x, 2))
-#define SCM_RTL_PROGRAM_FREE_VARIABLE_REF(x,i) (SCM_RTL_PROGRAM_FREE_VARIABLES
(x)[i])
-#define SCM_RTL_PROGRAM_FREE_VARIABLE_SET(x,i,v)
(SCM_RTL_PROGRAM_FREE_VARIABLES (x)[i]=(v))
-#define SCM_RTL_PROGRAM_NUM_FREE_VARIABLES(x) (SCM_CELL_WORD_0 (x) >> 16)
-#define SCM_VALIDATE_RTL_PROGRAM(p,x) SCM_MAKE_VALIDATE (p, x, RTL_PROGRAM_P)
-
-static inline SCM
-scm_i_make_rtl_program (const scm_t_uint32 *code)
-{
- return scm_cell (scm_tc7_rtl_program, (scm_t_bits)code);
-}
-
-SCM_INTERNAL SCM scm_make_rtl_program (SCM bytevector, SCM byte_offset, SCM
free_variables);
-SCM_INTERNAL SCM scm_rtl_program_p (SCM obj);
-SCM_INTERNAL SCM scm_rtl_program_code (SCM program);
-
-SCM_INTERNAL SCM scm_primitive_p (SCM obj);
-SCM_INTERNAL SCM scm_primitive_call_ip (SCM prim);
-
-SCM_INTERNAL SCM scm_i_rtl_program_name (SCM program);
-SCM_INTERNAL SCM scm_i_rtl_program_documentation (SCM program);
-SCM_INTERNAL SCM scm_i_rtl_program_properties (SCM program);
-
-SCM_INTERNAL SCM scm_find_source_for_addr (SCM ip);
-
-/*
* Programs
*/
+#define SCM_PROGRAM_P(x) (SCM_HAS_TYP7 (x, scm_tc7_program))
+#define SCM_PROGRAM_CODE(x) ((scm_t_uint32 *) SCM_CELL_WORD_1 (x))
+#define SCM_PROGRAM_FREE_VARIABLES(x) (SCM_CELL_OBJECT_LOC (x, 2))
+#define SCM_PROGRAM_FREE_VARIABLE_REF(x,i) (SCM_PROGRAM_FREE_VARIABLES (x)[i])
+#define SCM_PROGRAM_FREE_VARIABLE_SET(x,i,v) (SCM_PROGRAM_FREE_VARIABLES
(x)[i]=(v))
+#define SCM_PROGRAM_NUM_FREE_VARIABLES(x) (SCM_CELL_WORD_0 (x) >> 16)
+#define SCM_VALIDATE_PROGRAM(p,x) SCM_MAKE_VALIDATE (p, x, PROGRAM_P)
+
#define SCM_F_PROGRAM_IS_BOOT 0x100
#define SCM_F_PROGRAM_IS_PRIMITIVE 0x200
#define SCM_F_PROGRAM_IS_PRIMITIVE_GENERIC 0x400
@@ -70,7 +47,26 @@ SCM_INTERNAL SCM scm_find_source_for_addr (SCM ip);
#define SCM_PROGRAM_IS_PARTIAL_CONTINUATION(x) (SCM_CELL_WORD_0 (x) &
SCM_F_PROGRAM_IS_PARTIAL_CONTINUATION)
#define SCM_PROGRAM_IS_FOREIGN(x) (SCM_CELL_WORD_0 (x) &
SCM_F_PROGRAM_IS_FOREIGN)
-SCM_API SCM scm_program_source (SCM program, SCM ip, SCM sources);
+#ifdef BUILDING_LIBGUILE
+static inline SCM
+scm_i_make_program (const scm_t_uint32 *code)
+{
+ return scm_cell (scm_tc7_program, (scm_t_bits)code);
+}
+#endif
+
+SCM_INTERNAL SCM scm_program_p (SCM obj);
+SCM_INTERNAL SCM scm_program_code (SCM program);
+
+SCM_INTERNAL SCM scm_primitive_p (SCM obj);
+SCM_INTERNAL SCM scm_primitive_call_ip (SCM prim);
+
+SCM_INTERNAL SCM scm_i_program_name (SCM program);
+SCM_INTERNAL SCM scm_i_program_documentation (SCM program);
+SCM_INTERNAL SCM scm_i_program_properties (SCM program);
+
+SCM_INTERNAL SCM scm_find_source_for_addr (SCM ip);
+
SCM_API SCM scm_program_num_free_variables (SCM program);
SCM_API SCM scm_program_free_variable_ref (SCM program, SCM i);
SCM_API SCM scm_program_free_variable_set_x (SCM program, SCM i, SCM x);
diff --git a/libguile/stacks.c b/libguile/stacks.c
index bbdde30..20b67ef 100644
--- a/libguile/stacks.c
+++ b/libguile/stacks.c
@@ -276,7 +276,7 @@ SCM_DEFINE (scm_make_stack, "make-stack", 1, 0, 1,
/* FIXME: is this even possible? */
if (scm_is_true (frame)
- && SCM_RTL_PROGRAM_P (scm_frame_procedure (frame))
+ && SCM_PROGRAM_P (scm_frame_procedure (frame))
&& SCM_PROGRAM_IS_BOOT (scm_frame_procedure (frame)))
frame = scm_frame_previous (frame);
diff --git a/libguile/tags.h b/libguile/tags.h
index 1c6503a..598b048 100644
--- a/libguile/tags.h
+++ b/libguile/tags.h
@@ -429,7 +429,7 @@ typedef union SCM { struct { scm_t_bits n; } n; } SCM;
#define scm_tc7_unused_17 61
#define scm_tc7_unused_21 63
-#define scm_tc7_rtl_program 69
+#define scm_tc7_program 69
#define scm_tc7_unused_79 79
#define scm_tc7_weak_set 85
#define scm_tc7_weak_table 87
diff --git a/libguile/vm-builtins.h b/libguile/vm-builtins.h
index ea9b9e2..5e31a04 100644
--- a/libguile/vm-builtins.h
+++ b/libguile/vm-builtins.h
@@ -28,7 +28,7 @@
M(call_with_values, CALL_WITH_VALUES, 2, 0, 0) \
M(call_with_current_continuation, CALL_WITH_CURRENT_CONTINUATION, 1, 0, 0)
-/* These enumerated values are embedded in RTL code, and as such are
+/* These enumerated values are embedded in VM code, and as such are
part of Guile's ABI. */
enum scm_vm_builtins
{
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 7fe7893..b13fab0 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -130,7 +130,7 @@
exception. */
#define SYNC_IP() \
- vp->ip = (scm_t_uint8 *) (ip)
+ vp->ip = (ip)
#define SYNC_REGISTER() \
SYNC_IP()
@@ -230,7 +230,7 @@
SCM val = ret; \
SCM *old_fp = fp; \
VM_HANDLE_INTERRUPTS; \
- ip = SCM_FRAME_RTL_RETURN_ADDRESS (fp); \
+ ip = SCM_FRAME_RETURN_ADDRESS (fp); \
fp = vp->fp = SCM_FRAME_DYNAMIC_LINK (fp); \
/* Clear frame. */ \
old_fp[-1] = SCM_BOOL_F; \
@@ -470,9 +470,9 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
continuation. */
base[0] = SCM_PACK (fp); /* dynamic link */
base[1] = SCM_PACK (ip); /* ra */
- base[2] = rtl_boot_continuation;
+ base[2] = vm_boot_continuation;
fp = &base[2];
- ip = (scm_t_uint32 *) rtl_boot_continuation_code;
+ ip = (scm_t_uint32 *) vm_boot_continuation_code;
/* MV-call frame, function & arguments */
base[3] = SCM_PACK (fp); /* dynamic link */
@@ -483,7 +483,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
}
apply:
- while (!SCM_RTL_PROGRAM_P (SCM_FRAME_PROGRAM (fp)))
+ while (!SCM_PROGRAM_P (SCM_FRAME_PROGRAM (fp)))
{
SCM proc = SCM_FRAME_PROGRAM (fp);
@@ -510,7 +510,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
}
/* Let's go! */
- ip = SCM_RTL_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp));
+ ip = SCM_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp));
NEXT (0);
BEGIN_DISPATCH_SWITCH;
@@ -577,17 +577,17 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
fp = vp->fp = old_fp + proc;
SCM_FRAME_SET_DYNAMIC_LINK (fp, old_fp);
- SCM_FRAME_SET_RTL_RETURN_ADDRESS (fp, ip + 2);
+ SCM_FRAME_SET_RETURN_ADDRESS (fp, ip + 2);
RESET_FRAME (nlocals);
PUSH_CONTINUATION_HOOK ();
APPLY_HOOK ();
- if (SCM_UNLIKELY (!SCM_RTL_PROGRAM_P (SCM_FRAME_PROGRAM (fp))))
+ if (SCM_UNLIKELY (!SCM_PROGRAM_P (SCM_FRAME_PROGRAM (fp))))
goto apply;
- ip = SCM_RTL_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp));
+ ip = SCM_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp));
NEXT (0);
}
@@ -609,10 +609,10 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
APPLY_HOOK ();
- if (SCM_UNLIKELY (!SCM_RTL_PROGRAM_P (SCM_FRAME_PROGRAM (fp))))
+ if (SCM_UNLIKELY (!SCM_PROGRAM_P (SCM_FRAME_PROGRAM (fp))))
goto apply;
- ip = SCM_RTL_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp));
+ ip = SCM_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp));
NEXT (0);
}
@@ -641,10 +641,10 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
APPLY_HOOK ();
- if (SCM_UNLIKELY (!SCM_RTL_PROGRAM_P (SCM_FRAME_PROGRAM (fp))))
+ if (SCM_UNLIKELY (!SCM_PROGRAM_P (SCM_FRAME_PROGRAM (fp))))
goto apply;
- ip = SCM_RTL_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp));
+ ip = SCM_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp));
NEXT (0);
}
@@ -712,7 +712,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
SCM *old_fp = fp;
VM_HANDLE_INTERRUPTS;
- ip = SCM_FRAME_RTL_RETURN_ADDRESS (fp);
+ ip = SCM_FRAME_RETURN_ADDRESS (fp);
fp = vp->fp = SCM_FRAME_DYNAMIC_LINK (fp);
/* Clear stack frame. */
@@ -746,7 +746,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
SCM_UNPACK_RTL_24 (op, ptr_idx);
- pointer = SCM_RTL_PROGRAM_FREE_VARIABLE_REF (LOCAL_REF (0), ptr_idx);
+ pointer = SCM_PROGRAM_FREE_VARIABLE_REF (LOCAL_REF (0), ptr_idx);
subr = SCM_POINTER_VALUE (pointer);
VM_HANDLE_INTERRUPTS;
@@ -816,8 +816,8 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
SCM_UNPACK_RTL_12_12 (op, cif_idx, ptr_idx);
closure = LOCAL_REF (0);
- cif = SCM_RTL_PROGRAM_FREE_VARIABLE_REF (closure, cif_idx);
- pointer = SCM_RTL_PROGRAM_FREE_VARIABLE_REF (closure, ptr_idx);
+ cif = SCM_PROGRAM_FREE_VARIABLE_REF (closure, cif_idx);
+ pointer = SCM_PROGRAM_FREE_VARIABLE_REF (closure, ptr_idx);
SYNC_IP ();
VM_HANDLE_INTERRUPTS;
@@ -850,7 +850,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
SCM_UNPACK_RTL_24 (op, contregs_idx);
contregs =
- SCM_RTL_PROGRAM_FREE_VARIABLE_REF (LOCAL_REF (0), contregs_idx);
+ SCM_PROGRAM_FREE_VARIABLE_REF (LOCAL_REF (0), contregs_idx);
SYNC_IP ();
scm_i_check_continuation (contregs);
@@ -878,7 +878,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t nargs_)
scm_t_uint32 cont_idx;
SCM_UNPACK_RTL_24 (op, cont_idx);
- vmcont = SCM_RTL_PROGRAM_FREE_VARIABLE_REF (LOCAL_REF (0), cont_idx);
+ vmcont = SCM_PROGRAM_FREE_VARIABLE_REF (LOCAL_REF (0), cont_idx);
SYNC_IP ();
VM_ASSERT (SCM_VM_CONT_REWINDABLE_P (vmcont),
@@ -929,10 +929,10 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
APPLY_HOOK ();
- if (SCM_UNLIKELY (!SCM_RTL_PROGRAM_P (SCM_FRAME_PROGRAM (fp))))
+ if (SCM_UNLIKELY (!SCM_PROGRAM_P (SCM_FRAME_PROGRAM (fp))))
goto apply;
- ip = SCM_RTL_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp));
+ ip = SCM_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp));
NEXT (0);
}
@@ -973,10 +973,10 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
APPLY_HOOK ();
- if (SCM_UNLIKELY (!SCM_RTL_PROGRAM_P (SCM_FRAME_PROGRAM (fp))))
+ if (SCM_UNLIKELY (!SCM_PROGRAM_P (SCM_FRAME_PROGRAM (fp))))
goto apply;
- ip = SCM_RTL_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp));
+ ip = SCM_PROGRAM_CODE (SCM_FRAME_PROGRAM (fp));
NEXT (0);
}
else
@@ -1558,11 +1558,11 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
SCM_UNPACK_RTL_24 (ip[2], nfree);
// FIXME: Assert range of nfree?
- closure = scm_words (scm_tc7_rtl_program | (nfree << 16), nfree + 2);
+ closure = scm_words (scm_tc7_program | (nfree << 16), nfree + 2);
SCM_SET_CELL_WORD_1 (closure, ip + offset);
// FIXME: Elide these initializations?
for (n = 0; n < nfree; n++)
- SCM_RTL_PROGRAM_FREE_VARIABLE_SET (closure, n, SCM_BOOL_F);
+ SCM_PROGRAM_FREE_VARIABLE_SET (closure, n, SCM_BOOL_F);
LOCAL_SET (dst, closure);
NEXT (3);
}
@@ -1578,7 +1578,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
SCM_UNPACK_RTL_12_12 (op, dst, src);
SCM_UNPACK_RTL_24 (ip[1], idx);
/* CHECK_FREE_VARIABLE (src); */
- LOCAL_SET (dst, SCM_RTL_PROGRAM_FREE_VARIABLE_REF (LOCAL_REF (src),
idx));
+ LOCAL_SET (dst, SCM_PROGRAM_FREE_VARIABLE_REF (LOCAL_REF (src), idx));
NEXT (2);
}
@@ -1593,7 +1593,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
SCM_UNPACK_RTL_12_12 (op, dst, src);
SCM_UNPACK_RTL_24 (ip[1], idx);
/* CHECK_FREE_VARIABLE (src); */
- SCM_RTL_PROGRAM_FREE_VARIABLE_SET (LOCAL_REF (dst), idx, LOCAL_REF
(src));
+ SCM_PROGRAM_FREE_VARIABLE_SET (LOCAL_REF (dst), idx, LOCAL_REF (src));
NEXT (2);
}
@@ -2012,7 +2012,7 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t
nargs_)
LOCAL_REF (tag),
fp,
LOCAL_ADDRESS (proc_slot),
- (scm_t_uint8 *)(ip + offset),
+ ip + offset,
®isters);
NEXT (3);
}
diff --git a/libguile/vm.c b/libguile/vm.c
index b083d06..9b0e080 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -103,7 +103,7 @@ scm_i_vm_cont_print (SCM x, SCM port, scm_print_state
*pstate)
call to vm_run; but that's currently not implemented.
*/
SCM
-scm_i_vm_capture_stack (SCM *stack_base, SCM *fp, SCM *sp, scm_t_uint8 *ra,
+scm_i_vm_capture_stack (SCM *stack_base, SCM *fp, SCM *sp, scm_t_uint32 *ra,
scm_t_dynstack *dynstack, scm_t_uint32 flags)
{
struct scm_vm_cont *p;
@@ -592,14 +592,14 @@ vm_error_bad_wide_string_length (size_t len)
-static SCM rtl_boot_continuation;
+static SCM vm_boot_continuation;
static SCM vm_builtin_apply;
static SCM vm_builtin_values;
static SCM vm_builtin_abort_to_prompt;
static SCM vm_builtin_call_with_values;
static SCM vm_builtin_call_with_current_continuation;
-static const scm_t_uint32 rtl_boot_continuation_code[] = {
+static const scm_t_uint32 vm_boot_continuation_code[] = {
SCM_PACK_RTL_24 (scm_rtl_op_halt, 0)
};
@@ -1214,13 +1214,13 @@ scm_bootstrap_vm (void)
sym_regular = scm_from_latin1_symbol ("regular");
sym_debug = scm_from_latin1_symbol ("debug");
- rtl_boot_continuation = scm_i_make_rtl_program (rtl_boot_continuation_code);
- SCM_SET_CELL_WORD_0 (rtl_boot_continuation,
- (SCM_CELL_WORD_0 (rtl_boot_continuation)
+ vm_boot_continuation = scm_i_make_program (vm_boot_continuation_code);
+ SCM_SET_CELL_WORD_0 (vm_boot_continuation,
+ (SCM_CELL_WORD_0 (vm_boot_continuation)
| SCM_F_PROGRAM_IS_BOOT));
#define DEFINE_BUILTIN(builtin, BUILTIN, req, opt, rest) \
- vm_builtin_##builtin = scm_i_make_rtl_program (vm_builtin_##builtin##_code);
+ vm_builtin_##builtin = scm_i_make_program (vm_builtin_##builtin##_code);
FOR_EACH_VM_BUILTIN (DEFINE_BUILTIN);
#undef DEFINE_BUILTIN
diff --git a/libguile/vm.h b/libguile/vm.h
index 7012eef..c678e42 100644
--- a/libguile/vm.h
+++ b/libguile/vm.h
@@ -41,7 +41,7 @@ typedef SCM (*scm_t_vm_engine) (SCM vm, SCM program, SCM
*argv, int nargs);
#define SCM_VM_NUM_ENGINES 2
struct scm_vm {
- scm_t_uint8 *ip; /* instruction pointer */
+ scm_t_uint32 *ip; /* instruction pointer */
SCM *sp; /* stack pointer */
SCM *fp; /* frame pointer */
size_t stack_size; /* stack size */
@@ -88,7 +88,7 @@ SCM_API void scm_c_set_default_vm_engine_x (int engine);
struct scm_vm_cont {
SCM *sp;
SCM *fp;
- scm_t_uint8 *ra;
+ scm_t_uint32 *ra;
scm_t_ptrdiff stack_size;
SCM *stack_base;
scm_t_ptrdiff reloc;
@@ -110,7 +110,7 @@ SCM_INTERNAL void scm_i_vm_print (SCM x, SCM port,
SCM_INTERNAL SCM scm_i_call_with_current_continuation (SCM proc);
SCM_INTERNAL SCM scm_i_capture_current_stack (void);
SCM_INTERNAL SCM scm_i_vm_capture_stack (SCM *stack_base, SCM *fp, SCM *sp,
- scm_t_uint8 *ra,
+ scm_t_uint32 *ra,
scm_t_dynstack *dynstack,
scm_t_uint32 flags);
SCM_INTERNAL void scm_i_vm_cont_print (SCM x, SCM port,
diff --git a/module/ice-9/session.scm b/module/ice-9/session.scm
index 4c21033..a6ab3ab 100644
--- a/module/ice-9/session.scm
+++ b/module/ice-9/session.scm
@@ -522,7 +522,7 @@ The alist keys that are currently defined are `required',
`optional',
(rest . ,rest)))))
((procedure-source proc)
=> cadr)
- (((@ (system vm program) rtl-program?) proc)
+ (((@ (system vm program) program?) proc)
((@ (system vm program) program-arguments-alist) proc))
(else #f)))
diff --git a/module/language/tree-il/analyze.scm
b/module/language/tree-il/analyze.scm
index 5a87cd9..0ce7344 100644
--- a/module/language/tree-il/analyze.scm
+++ b/module/language/tree-il/analyze.scm
@@ -950,7 +950,7 @@ given `tree-il' element."
(or (and (or (null? x) (pair? x))
(length x))
0))
- (cond ((rtl-program? proc)
+ (cond ((program? proc)
(values (procedure-name proc)
(map (lambda (a)
(list (length (or (assq-ref a 'required) '()))
diff --git a/module/statprof.scm b/module/statprof.scm
index bb6751b..7ef4430 100644
--- a/module/statprof.scm
+++ b/module/statprof.scm
@@ -217,7 +217,7 @@
(define (get-call-data proc)
(let ((k (cond
- ((rtl-program? proc) (rtl-program-code proc))
+ ((program? proc) (program-code proc))
(else proc))))
(or (hashv-ref procedure-data k)
(let ((call-data (make-call-data proc 0 0 0)))
@@ -580,8 +580,8 @@ to @code{statprof-reset} is true."
(lambda (a b)
(cond
((eq? a b))
- ((and (rtl-program? a) (rtl-program? b))
- (eq? (rtl-program-code a) (rtl-program-code b)))
+ ((and (program? a) (program? b))
+ (eq? (program-code a) (program-code b)))
(else
#f))))
diff --git a/module/system/repl/command.scm b/module/system/repl/command.scm
index 631957a..c0a5dd6 100644
--- a/module/system/repl/command.scm
+++ b/module/system/repl/command.scm
@@ -459,7 +459,7 @@ Change languages."
(define (load-image x)
(let ((thunk (load-thunk-from-memory x)))
- (find-mapped-elf-image (rtl-program-code thunk))))
+ (find-mapped-elf-image (program-code thunk))))
(define-meta-command (compile repl (form))
"compile EXP
@@ -492,7 +492,7 @@ Run the optimizer on a piece of code and print the result."
Disassemble a compiled procedure."
(let ((obj (repl-eval repl (repl-parse repl form))))
(cond
- ((rtl-program? obj)
+ ((program? obj)
(disassemble-program obj))
((bytevector? obj)
(disassemble-image (load-image obj)))
diff --git a/module/system/repl/debug.scm b/module/system/repl/debug.scm
index 2ca7364..fdf6bb7 100644
--- a/module/system/repl/debug.scm
+++ b/module/system/repl/debug.scm
@@ -95,8 +95,8 @@
(format port "~aRegisters:~%" per-line-prefix)
(print "ip = #x~x" (frame-instruction-pointer frame))
- (when (rtl-program? (frame-procedure frame))
- (let ((code (rtl-program-code (frame-procedure frame))))
+ (when (program? (frame-procedure frame))
+ (let ((code (program-code (frame-procedure frame))))
(format port " (address@hidden)" code
(- (frame-instruction-pointer frame) code))))
(newline port)
diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index 01fac65..7c1d589 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -900,7 +900,7 @@ should be .data or .rodata), and return the resulting
linker object.
(define tc7-wide-stringbuf
(+ tc7-stringbuf stringbuf-shared-flag stringbuf-wide-flag))
(define tc7-ro-string (+ 21 #x200))
- (define tc7-rtl-program 69)
+ (define tc7-program 69)
(define tc7-bytevector 77)
(define tc7-bitvector 95)
@@ -972,10 +972,10 @@ should be .data or .rodata), and return the resulting
linker object.
((static-procedure? obj)
(case word-size
((4)
- (bytevector-u32-set! buf pos tc7-rtl-program endianness)
+ (bytevector-u32-set! buf pos tc7-program endianness)
(bytevector-u32-set! buf (+ pos 4) 0 endianness))
((8)
- (bytevector-u64-set! buf pos tc7-rtl-program endianness)
+ (bytevector-u64-set! buf pos tc7-program endianness)
(bytevector-u64-set! buf (+ pos 8) 0 endianness))
(else (error "bad word size"))))
@@ -1220,7 +1220,7 @@ it will be added to the GC roots at runtime."
(* i word-size) 0 label)
relocs))
(%set-uword! bv (* i word-size) 0 endianness))))
- (set-uword! 0 DT_GUILE_RTL_VERSION)
+ (set-uword! 0 DT_GUILE_VM_VERSION)
(set-uword! 1 (logior (ash *bytecode-major-version* 16)
*bytecode-minor-version*))
(set-uword! 2 DT_GUILE_ENTRY)
diff --git a/module/system/vm/coverage.scm b/module/system/vm/coverage.scm
index 4c9644e..ea66ce1 100644
--- a/module/system/vm/coverage.scm
+++ b/module/system/vm/coverage.scm
@@ -257,8 +257,8 @@ executed."
((< val* val)
(lp (1+ idx) end))
(else elt))))))
- (and (rtl-program? proc)
- (match (binary-search (data-ip-counts data) car (rtl-program-code proc))
+ (and (program? proc)
+ (match (binary-search (data-ip-counts data) car (program-code proc))
(#f 0)
((ip . code) code))))
@@ -312,7 +312,7 @@ gathered, even if their code was not executed."
#;
(define (dump-function proc)
;; Dump source location and basic coverage data for PROC.
- (and (or (program? proc) (rtl-program? proc))
+ (and (or (program? proc))
(let ((sources (program-sources* data proc)))
(and (pair? sources)
(let* ((line (source:line-for-user (car sources)))
diff --git a/module/system/vm/debug.scm b/module/system/vm/debug.scm
index 252c69c..d201e50 100644
--- a/module/system/vm/debug.scm
+++ b/module/system/vm/debug.scm
@@ -64,7 +64,7 @@
find-program-debug-info
arity-arguments-alist
find-program-arities
- program-minimum-arity
+ find-program-minimum-arity
find-program-docstring
@@ -405,8 +405,8 @@ section of the ELF image. Returns an ELF symbol, or
@code{#f}."
(read-sub-arities context base (arity-header-offset first)))
(else (list first)))))))
-(define* (program-minimum-arity addr #:optional
- (context (find-debug-context addr)))
+(define* (find-program-minimum-arity addr #:optional
+ (context (find-debug-context addr)))
(and=>
(and context
(elf-section-by-name (debug-context-elf context) ".guile.arities"))
diff --git a/module/system/vm/disassembler.scm
b/module/system/vm/disassembler.scm
index ccdedf8..cfc8a15 100644
--- a/module/system/vm/disassembler.scm
+++ b/module/system/vm/disassembler.scm
@@ -350,7 +350,7 @@ address of that offset."
(define* (disassemble-program program #:optional (port (current-output-port)))
(cond
- ((find-program-debug-info (rtl-program-code program))
+ ((find-program-debug-info (program-code program))
=> (lambda (pdi)
(format port "Disassembly of ~S at #x~X:\n\n" program
(program-debug-info-addr pdi))
@@ -416,8 +416,8 @@ address of that offset."
(define* (fold-program-code proc seed program-or-addr #:key raw?)
(cond
- ((find-program-debug-info (if (rtl-program? program-or-addr)
- (rtl-program-code program-or-addr)
+ ((find-program-debug-info (if (program? program-or-addr)
+ (program-code program-or-addr)
program-or-addr))
=> (lambda (pdi)
(fold-code-range proc seed
@@ -452,5 +452,5 @@ address of that offset."
(define (disassemble-file file)
(let* ((thunk (load-thunk-from-file file))
- (elf (find-mapped-elf-image (rtl-program-code thunk))))
+ (elf (find-mapped-elf-image (program-code thunk))))
(disassemble-image elf)))
diff --git a/module/system/vm/elf.scm b/module/system/vm/elf.scm
index 5167459..2fe99ba 100644
--- a/module/system/vm/elf.scm
+++ b/module/system/vm/elf.scm
@@ -105,7 +105,7 @@
DT_FINI_ARRAYSZ DT_RUNPATH DT_FLAGS DT_ENCODING
DT_PREINIT_ARRAY DT_PREINIT_ARRAYSZ DT_NUM DT_LOGUILE
DT_GUILE_GC_ROOT DT_GUILE_GC_ROOT_SZ DT_GUILE_ENTRY
- DT_GUILE_RTL_VERSION DT_HIGUILE DT_LOOS DT_HIOS DT_LOPROC
+ DT_GUILE_VM_VERSION DT_HIGUILE DT_LOOS DT_HIOS DT_LOPROC
DT_HIPROC
string-table-ref
@@ -780,7 +780,7 @@
(define DT_GUILE_GC_ROOT #x37146000) ; Offset of GC roots
(define DT_GUILE_GC_ROOT_SZ #x37146001) ; Size in machine words of GC roots
(define DT_GUILE_ENTRY #x37146002) ; Address of entry thunk
-(define DT_GUILE_RTL_VERSION #x37146003); Bytecode version
+(define DT_GUILE_VM_VERSION #x37146003) ; Bytecode version
(define DT_HIGUILE #x37146fff) ; End of Guile-specific
(define DT_LOOS #x6000000d) ; Start of OS-specific
(define DT_HIOS #x6ffff000) ; End of OS-specific
diff --git a/module/system/vm/frame.scm b/module/system/vm/frame.scm
index 3ab3e1e..3c0cbb5 100644
--- a/module/system/vm/frame.scm
+++ b/module/system/vm/frame.scm
@@ -88,7 +88,7 @@
(cons
(or (false-if-exception (procedure-name p)) p)
(cond
- ((and (rtl-program? p)
+ ((and (program? p)
(program-arguments-alist p (frame-instruction-pointer frame)))
;; case 1
=> (lambda (arguments)
diff --git a/module/system/vm/program.scm b/module/system/vm/program.scm
index 243f43e..bbb9ef7 100644
--- a/module/system/vm/program.scm
+++ b/module/system/vm/program.scm
@@ -25,9 +25,7 @@
#:use-module (rnrs bytevectors)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
- #:export (make-rtl-program
-
- make-binding binding:name binding:boxed? binding:index
+ #:export (make-binding binding:name binding:boxed? binding:index
binding:start binding:end
source:addr source:line source:column source:file
@@ -43,7 +41,7 @@
program-arguments-alist program-arguments-alists
program-lambda-list
- rtl-program? rtl-program-code
+ program? program-code
program-free-variables
program-num-free-variables
program-free-variable-ref program-free-variable-set!))
@@ -52,23 +50,15 @@
"scm_init_programs")
;; These procedures are called by programs.c.
-(define (rtl-program-name program)
- (unless (rtl-program? program)
- (error "shouldn't get here"))
- (and=> (find-program-debug-info (rtl-program-code program))
+(define (program-name program)
+ (and=> (find-program-debug-info (program-code program))
program-debug-info-name))
-(define (rtl-program-documentation program)
- (unless (rtl-program? program)
- (error "shouldn't get here"))
- (find-program-docstring (rtl-program-code program)))
-(define (rtl-program-minimum-arity program)
- (unless (rtl-program? program)
- (error "shouldn't get here"))
- (program-minimum-arity (rtl-program-code program)))
-(define (rtl-program-properties program)
- (unless (rtl-program? program)
- (error "shouldn't get here"))
- (find-program-properties (rtl-program-code program)))
+(define (program-documentation program)
+ (find-program-docstring (program-code program)))
+(define (program-minimum-arity program)
+ (find-program-minimum-arity (program-code program)))
+(define (program-properties program)
+ (find-program-properties (program-code program)))
(define (make-binding name boxed? index start end)
(list name boxed? index start end))
@@ -104,11 +94,11 @@
(define (program-sources proc)
(map (lambda (source)
- (cons* (- (source-post-pc source) (rtl-program-code proc))
+ (cons* (- (source-post-pc source) (program-code proc))
(source-file source)
(source-line source)
(source-column source)))
- (find-program-sources (rtl-program-code proc))))
+ (find-program-sources (program-code proc))))
(define* (program-source proc ip #:optional (sources (program-sources proc)))
(let lp ((source #f) (sources sources))
@@ -131,11 +121,11 @@
;;
(define (program-sources-pre-retire proc)
(map (lambda (source)
- (cons* (- (source-pre-pc source) (rtl-program-code proc))
+ (cons* (- (source-pre-pc source) (program-code proc))
(source-file source)
(source-line source)
(source-column source)))
- (find-program-sources (rtl-program-code proc))))
+ (find-program-sources (program-code proc))))
(define (collapse-locals locs)
(let lp ((ret '()) (locs locs))
@@ -259,13 +249,13 @@
(arity->arguments-alist
prog
(list 0 0 nreq nopt rest? '(#f . ()))))))))
- ((rtl-program? prog)
+ ((program? prog)
(or-map (lambda (arity)
(and (or (not ip)
(and (<= (arity-low-pc arity) ip)
(< ip (arity-high-pc arity))))
(arity-arguments-alist arity)))
- (or (find-program-arities (rtl-program-code prog)) '())))
+ (or (find-program-arities (program-code prog)) '())))
(else
(let ((arity (program-arity prog ip)))
(and arity
@@ -307,8 +297,8 @@ lists."
(list 0 0 nreq nopt rest? '(#f . ())))))))
(cond
((primitive? prog) (fallback))
- ((rtl-program? prog)
- (let ((arities (find-program-arities (rtl-program-code prog))))
+ ((program? prog)
+ (let ((arities (find-program-arities (program-code prog))))
(if arities
(map arity-arguments-alist arities)
(fallback))))
diff --git a/module/system/vm/traps.scm b/module/system/vm/traps.scm
index f1dcc29..c7ee2a0 100644
--- a/module/system/vm/traps.scm
+++ b/module/system/vm/traps.scm
@@ -110,13 +110,13 @@
;; Returns an absolute IP.
(define (program-last-ip prog)
- (let ((pdi (find-program-debug-info (rtl-program-code prog))))
+ (let ((pdi (find-program-debug-info (program-code prog))))
(and pdi (program-debug-info-size pdi))))
(define (frame-matcher proc match-code?)
(if match-code?
- (if (rtl-program? proc)
- (let ((start (rtl-program-code proc))
+ (if (program? proc)
+ (let ((start (program-code proc))
(end (program-last-ip proc)))
(lambda (frame)
(let ((ip (frame-instruction-pointer frame)))
@@ -317,8 +317,8 @@
(define (program-sources-by-line proc file)
(cond
- ((rtl-program? proc)
- (let ((code (rtl-program-code proc)))
+ ((program? proc)
+ (let ((code (program-code proc)))
(let lp ((sources (program-sources proc))
(out '()))
(if (pair? sources)
diff --git a/module/system/xref.scm b/module/system/xref.scm
index 65d0fed..2b943fd 100644
--- a/module/system/xref.scm
+++ b/module/system/xref.scm
@@ -35,12 +35,12 @@
(define (nested-procedures prog)
(define (cons-uniq x y)
(if (memq x y) y (cons x y)))
- (if (rtl-program? prog)
+ (if (program? prog)
(reverse
(fold-program-code (lambda (elt out)
(match elt
(('static-ref dst proc)
- (if (rtl-program? proc)
+ (if (program? proc)
(fold cons-uniq
(cons proc out)
(nested-procedures prog))
@@ -79,7 +79,7 @@
(define (procedure-callee-rev-vars proc)
(cond
- ((rtl-program? proc) (program-callee-rev-vars proc))
+ ((program? proc) (program-callee-rev-vars proc))
(else '())))
(define (procedure-callees prog)
@@ -201,8 +201,7 @@ pair of the form (module-name . variable-name), "
;; ((ip file line . col) ...)
(define (procedure-sources proc)
(cond
- ((or (rtl-program? proc) (program? proc))
- (program-sources proc))
+ ((program? proc) (program-sources proc))
(else '())))
;; file -> line -> (proc ...)
diff --git a/test-suite/tests/dwarf.test b/test-suite/tests/dwarf.test
index 2d2a45e..0c43d61 100644
--- a/test-suite/tests/dwarf.test
+++ b/test-suite/tests/dwarf.test
@@ -49,19 +49,19 @@
(pass-if-equal 13 (bar 10))
- (let ((source (find-source-for-addr (rtl-program-code qux))))
+ (let ((source (find-source-for-addr (program-code qux))))
(pass-if-equal "foo.scm" (source-file source))
(pass-if-equal 0 (source-line source))
(pass-if-equal 1 (source-line-for-user source))
(pass-if-equal 0 (source-column source)))
- (let ((source (find-source-for-addr (rtl-program-code bar))))
+ (let ((source (find-source-for-addr (program-code bar))))
(pass-if-equal "foo.scm" (source-file source))
(pass-if-equal 4 (source-line source))
(pass-if-equal 5 (source-line-for-user source))
(pass-if-equal 2 (source-column source)))
- (match (find-program-sources (rtl-program-code qux))
+ (match (find-program-sources (program-code qux))
((s1 s2 s3)
(pass-if-equal "foo.scm" (source-file s1))
(pass-if-equal 0 (source-line s1))
@@ -80,7 +80,7 @@
(sources
(error "unexpected sources" sources)))
- (match (find-program-sources (rtl-program-code bar))
+ (match (find-program-sources (program-code bar))
((source)
(pass-if-equal "foo.scm" (source-file source))
(pass-if-equal 4 (source-line source))
diff --git a/test-suite/tests/rtl.test b/test-suite/tests/rtl.test
index a435d52..e900d34 100644
--- a/test-suite/tests/rtl.test
+++ b/test-suite/tests/rtl.test
@@ -320,16 +320,16 @@ a procedure."
(end-arity)
(end-program)))))
(pass-if "program name"
- (and=> (find-program-debug-info (rtl-program-code return-3))
+ (and=> (find-program-debug-info (program-code return-3))
(lambda (pdi)
(equal? (program-debug-info-name pdi)
'return-3))))
(pass-if "program address"
- (and=> (find-program-debug-info (rtl-program-code return-3))
+ (and=> (find-program-debug-info (program-code return-3))
(lambda (pdi)
(equal? (program-debug-info-addr pdi)
- (rtl-program-code return-3)))))))
+ (program-code return-3)))))))
(with-test-prefix "procedure name"
(pass-if-equal 'foo
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, master, updated. v2.1.0-410-gef6b7f7,
Andy Wingo <=