diff options
author | Ludovic Court`es <ludovic.courtes@laas.fr> | 2005-04-22 16:00:33 +0000 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2008-04-25 19:09:29 +0200 |
commit | d8eeb67c89ea3f68f25bd1d7633a91cd3e8c1b68 (patch) | |
tree | 78a4059664f9c2c289abac64ce82d2bb974a61ce /src/objcodes.c | |
parent | f9e8c09d42ce992803d2c4dddbc00991260c636f (diff) | |
download | guile-d8eeb67c89ea3f68f25bd1d7633a91cd3e8c1b68.tar.gz |
Translation from Scheme to GHIL, and compilation to GLIL work.
* src/*.c: Removed calls to `scm_must_malloc', `SCM_MUST_MALLOC' and
`scm_must_free'. Same for `SCM_INUMP', `SCM_INUM', `SCM_STRING_CHARS',
and the likes.
* module/system/base/syntax.scm: Do not import `(ice-9 match)' and do
not re-export `match', do not export `syntax-error' which was not
defined here.
* module/system/base/compile.scm (call-with-compile-error-catch): Use
the `catch' form instead of `try'.
* src/instructions.c: Use `scm_from_char ()' instead of the deprecated
macro `SCM_MAKINUM ()'.
* src/instructions.h (scm_instruction): Made `npop' a signed char.
git-archimport-id: lcourtes@laas.fr--2004-libre/guile-vm--revival--0.6--patch-2
Diffstat (limited to 'src/objcodes.c')
-rw-r--r-- | src/objcodes.c | 34 |
1 files changed, 19 insertions, 15 deletions
diff --git a/src/objcodes.c b/src/objcodes.c index ad0d2e7c3..f845105ad 100644 --- a/src/objcodes.c +++ b/src/objcodes.c @@ -62,9 +62,10 @@ static SCM make_objcode (size_t size) #define FUNC_NAME "make_objcode" { - struct scm_objcode *p = SCM_MUST_MALLOC (sizeof (struct scm_objcode)); + struct scm_objcode *p = scm_gc_malloc (sizeof (struct scm_objcode), + "objcode"); p->size = size; - p->base = SCM_MUST_MALLOC (size); + p->base = scm_gc_malloc (size, "objcode-base"); p->fd = -1; SCM_RETURN_NEWSMOB (scm_tc16_objcode, p); } @@ -85,7 +86,7 @@ make_objcode_by_mmap (int fd) addr = mmap (0, st.st_size, PROT_READ, MAP_SHARED, fd, 0); if (addr == MAP_FAILED) SCM_SYSERROR; - p = SCM_MUST_MALLOC (sizeof (struct scm_objcode)); + p = scm_gc_malloc (sizeof (struct scm_objcode), "objcode"); p->size = st.st_size; p->base = addr; p->fd = fd; @@ -97,7 +98,7 @@ static scm_sizet objcode_free (SCM obj) #define FUNC_NAME "objcode_free" { - size_t size = (sizeof (struct scm_objcode)); + size_t size = sizeof (struct scm_objcode); struct scm_objcode *p = SCM_OBJCODE_DATA (obj); if (p->fd >= 0) @@ -109,13 +110,11 @@ objcode_free (SCM obj) if (rv < 0) SCM_SYSERROR; } else - { - size += p->size; - scm_must_free (p->base); - } + scm_gc_free (p->base, p->size, "objcode-base"); + + scm_gc_free (p, size, "objcode"); - scm_must_free (p); - return size; + return 0; } #undef FUNC_NAME @@ -139,21 +138,26 @@ SCM_DEFINE (scm_bytecode_to_objcode, "bytecode->objcode", 3, 0, 0, #define FUNC_NAME s_scm_bytecode_to_objcode { size_t size; - char *base; + char *base, *c_bytecode; SCM objcode; SCM_VALIDATE_STRING (1, bytecode); SCM_VALIDATE_INUM (2, nlocs); SCM_VALIDATE_INUM (3, nexts); - size = SCM_STRING_LENGTH (bytecode) + 10; + size = scm_c_string_length (bytecode) + 10; objcode = make_objcode (size); base = SCM_OBJCODE_BASE (objcode); memcpy (base, OBJCODE_COOKIE, 8); - base[8] = SCM_INUM (nlocs); - base[9] = SCM_INUM (nexts); - memcpy (base + 10, SCM_STRING_CHARS (bytecode), size - 10); + base[8] = scm_to_int (nlocs); + base[9] = scm_to_int (nexts); + + /* FIXME: We should really use SRFI-4 u8vectors! (Ludovic) */ + c_bytecode = scm_to_locale_string (bytecode); + memcpy (base + 10, c_bytecode, size - 10); + free (c_bytecode); + return objcode; } #undef FUNC_NAME |