mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 03:40:34 +02:00
Improved the VM's efficiency. The VM is as fast as the interpreter. :-(
* benchmark/lib.scm: New file. * benchmark/measure.scm: New file. * README: Added useful pointers to various threads. * doc/guile-vm.texi: Fixed the description of `load-program' (it now expects _immediate_ integers). * src/*.[ch]: Use immediate integers whereever possible, as in the original code. For `CONS', use `scm_cell' rather than `scm_cons'. git-archimport-id: lcourtes@laas.fr--2004-libre/guile-vm--revival--0.6--patch-6
This commit is contained in:
parent
238e7a11a8
commit
2d80426a3e
16 changed files with 275 additions and 51 deletions
30
README
30
README
|
@ -1,3 +1,33 @@
|
|||
This is an attempt to revive the Guile-VM project by Keisuke Nishida
|
||||
written back in the years 2000 and 2001. Below are a few pointers to
|
||||
relevant threads on Guile's development mailing list.
|
||||
|
||||
Enjoy!
|
||||
|
||||
Ludovic Courtès <ludovic.courtes@laas.fr>, Apr. 2005.
|
||||
|
||||
|
||||
Pointers
|
||||
--------
|
||||
|
||||
Status of the last release, 0.5
|
||||
http://lists.gnu.org/archive/html/guile-devel/2001-04/msg00266.html
|
||||
|
||||
The very first release, 0.0
|
||||
http://sources.redhat.com/ml/guile/2000-07/msg00418.html
|
||||
|
||||
Performance, portability, GNU Lightning
|
||||
http://lists.gnu.org/archive/html/guile-devel/2001-03/msg00132.html
|
||||
|
||||
Playing with GNU Lightning
|
||||
http://lists.gnu.org/archive/html/guile-devel/2001-03/msg00185.html
|
||||
|
||||
On things left to be done
|
||||
http://lists.gnu.org/archive/html/guile-devel/2001-03/msg00146.html
|
||||
|
||||
|
||||
---8<--- Original README below. -----------------------------------------
|
||||
|
||||
Installation
|
||||
------------
|
||||
|
||||
|
|
119
benchmark/lib.scm
Normal file
119
benchmark/lib.scm
Normal file
|
@ -0,0 +1,119 @@
|
|||
;; -*- Scheme -*-
|
||||
;;
|
||||
;; A library of dumb functions that may be used to benchmark Guile-VM.
|
||||
|
||||
|
||||
(define (fibo x)
|
||||
(if (= 1 x)
|
||||
1
|
||||
(+ x
|
||||
(fibo (1- x)))))
|
||||
|
||||
(define (g-c-d x y)
|
||||
(if (= x y)
|
||||
x
|
||||
(if (< x y)
|
||||
(g-c-d x (- y x))
|
||||
(g-c-d (- x y) y))))
|
||||
|
||||
(define (loop how-long)
|
||||
;; This one shows that procedure calls are no faster than within the
|
||||
;; interpreter: the VM yields no performance improvement.
|
||||
(if (= 0 how-long)
|
||||
0
|
||||
(loop (1- how-long))))
|
||||
|
||||
;; Disassembly of `loop'
|
||||
;;
|
||||
; Disassembly of #<objcode 302360b0>:
|
||||
|
||||
; nlocs = 0 nexts = 0
|
||||
|
||||
; 0 (make-int8 64) ;; 64
|
||||
; 2 (link "=")
|
||||
; 5 (link "loop")
|
||||
; 11 (link "1-")
|
||||
; 15 (vector 3)
|
||||
; 17 (make-int8:0) ;; 0
|
||||
; 18 (load-symbol "how-long") ;; how-long
|
||||
; 28 (make-false) ;; #f
|
||||
; 29 (make-int8:0) ;; 0
|
||||
; 30 (list 3)
|
||||
; 32 (list 2)
|
||||
; 34 (list 1)
|
||||
; 36 (make-int8 8) ;; 8
|
||||
; 38 (make-int8 2) ;; 2
|
||||
; 40 (make-int8 6) ;; 6
|
||||
; 42 (cons)
|
||||
; 43 (cons)
|
||||
; 44 (make-int8 23) ;; 23
|
||||
; 46 (make-int8 4) ;; 4
|
||||
; 48 (make-int8 12) ;; 12
|
||||
; 50 (cons)
|
||||
; 51 (cons)
|
||||
; 52 (make-int8 25) ;; 25
|
||||
; 54 (make-int8 4) ;; 4
|
||||
; 56 (make-int8 6) ;; 6
|
||||
; 42 (cons)
|
||||
; 43 (cons)
|
||||
; 44 (make-int8 23) ;; 23
|
||||
; 46 (make-int8 4) ;; 4
|
||||
; 48 (make-int8 12) ;; 12
|
||||
; 50 (cons)
|
||||
; 51 (cons)
|
||||
; 52 (make-int8 25) ;; 25
|
||||
; 54 (make-int8 4) ;; 4
|
||||
; 56 (make-int8 6) ;; 6
|
||||
; 58 (cons)
|
||||
; 59 (cons)
|
||||
; 60 (list 4)
|
||||
; 62 load-program ##{201}#
|
||||
; 89 (link "loop")
|
||||
; 95 (variable-set)
|
||||
; 96 (void)
|
||||
; 97 (return)
|
||||
|
||||
; Bytecode ##{201}#:
|
||||
|
||||
; 0 (object-ref 0)
|
||||
; 2 (variable-ref)
|
||||
; 3 (make-int8:0) ;; 0
|
||||
; 4 (local-ref 0)
|
||||
; 6 (call 2)
|
||||
; 8 (br-if-not 0 2) ;; -> 13
|
||||
; 11 (make-int8:0) ;; 0
|
||||
; 12 (return)
|
||||
; 13 (object-ref 1)
|
||||
; 15 (variable-ref)
|
||||
; 16 (object-ref 2)
|
||||
; 18 (variable-ref)
|
||||
; 19 (local-ref 0)
|
||||
; 21 (call 1)
|
||||
; 23 (tail-call 1)
|
||||
|
||||
|
||||
(define (loopi how-long)
|
||||
;; Same as `loop'.
|
||||
(let loopi ((how-long how-long))
|
||||
(if (= 0 how-long)
|
||||
0
|
||||
(loopi (1- how-long)))))
|
||||
|
||||
|
||||
(define (do-cons x)
|
||||
;; This one shows that the built-in `cons' instruction yields a significant
|
||||
;; improvement (speedup: 1.4).
|
||||
(let loop ((x x)
|
||||
(result '()))
|
||||
(if (<= x 0)
|
||||
result
|
||||
(loop (1- x) (cons x result)))))
|
||||
|
||||
(define (copy-list lst)
|
||||
;; Speedup: 1.3.
|
||||
(let loop ((lst lst)
|
||||
(result '()))
|
||||
(if (null? lst)
|
||||
result
|
||||
(loop (cdr lst)
|
||||
(cons (car lst) result)))))
|
49
benchmark/measure.scm
Executable file
49
benchmark/measure.scm
Executable file
|
@ -0,0 +1,49 @@
|
|||
#!/bin/sh
|
||||
# aside from this initial boilerplate, this is actually -*- scheme -*- code
|
||||
main='(module-ref (resolve-module '\''(measure)) '\'main')'
|
||||
exec ${GUILE-guile} -l $0 -c "(apply $main (cdr (command-line)))" "$@"
|
||||
!#
|
||||
|
||||
;; A simple interpreter vs. VM performance comparison tool
|
||||
;;
|
||||
|
||||
(define-module (measure)
|
||||
:export (measure)
|
||||
:use-module (system vm core)
|
||||
:use-module (system base compile)
|
||||
:use-module (system base language))
|
||||
|
||||
(define (time-for-eval sexp eval)
|
||||
(let ((before (tms:utime (times))))
|
||||
(eval sexp (current-module))
|
||||
(let ((elapsed (- (tms:utime (times)) before)))
|
||||
(format #t "elapsed time: ~a~%" elapsed)
|
||||
elapsed)))
|
||||
|
||||
(define *scheme* (lookup-language 'scheme))
|
||||
|
||||
(define (measure . args)
|
||||
(if (< (length args) 2)
|
||||
(begin
|
||||
(format #t "Usage: measure SEXP FILE-TO-LOAD...~%")
|
||||
(format #t "~%")
|
||||
(format #t "Example: measure '(loop 23424)' lib.scm~%~%")
|
||||
(exit 1)))
|
||||
(for-each load (cdr args))
|
||||
(let* ((sexp (with-input-from-string (car args)
|
||||
(lambda ()
|
||||
(read))))
|
||||
(time-interpreted (time-for-eval sexp eval))
|
||||
(objcode (compile-in sexp (current-module) *scheme*))
|
||||
(time-compiled (time-for-eval objcode
|
||||
(let ((vm (the-vm))
|
||||
(prog (objcode->program objcode)))
|
||||
(lambda (o e)
|
||||
(vm prog))))))
|
||||
(format #t "interpreted: ~a~%" time-interpreted)
|
||||
(format #t "compiled: ~a~%" time-compiled)
|
||||
(format #t "speedup: ~a~%"
|
||||
(exact->inexact (/ time-interpreted time-compiled)))
|
||||
0))
|
||||
|
||||
(define main measure)
|
|
@ -593,11 +593,12 @@ stack):
|
|||
@item optionally, a vector which is the program's object table (a
|
||||
program that does not reference external bindings does not need an
|
||||
object table);
|
||||
@item either one integer or four integers representing respectively
|
||||
the number of arguments taken by the function (@var{nargs}), the
|
||||
number of @dfn{rest arguments} (@var{nrest}, 0 or 1), the number of
|
||||
local variables (@var{nlocs}) and the number of external variables
|
||||
(@var{nexts}) (see the example above).
|
||||
@item either one immediate integer or four immediate integers
|
||||
representing respectively the number of arguments taken by the
|
||||
function (@var{nargs}), the number of @dfn{rest arguments}
|
||||
(@var{nrest}, 0 or 1), the number of local variables (@var{nlocs}) and
|
||||
the number of external variables (@var{nexts}) (see the example
|
||||
above).
|
||||
@end itemize
|
||||
|
||||
In the end, push a program object onto the stack.
|
||||
|
|
|
@ -77,7 +77,7 @@
|
|||
(label-alist '())
|
||||
(object-alist '()))
|
||||
(define (push-code! code)
|
||||
(format #t "push-code! ~a~%" code)
|
||||
; (format #t "push-code! ~a~%" code)
|
||||
(set! stack (cons (code->bytes code) stack)))
|
||||
(define (push-object! x)
|
||||
(cond ((object->code x) => push-code!)
|
||||
|
@ -168,7 +168,7 @@
|
|||
;;
|
||||
;; main
|
||||
(for-each generate-code body)
|
||||
(format #t "codegen: stack = ~a~%" (reverse stack))
|
||||
; (format #t "codegen: stack = ~a~%" (reverse stack))
|
||||
(let ((bytes (stack->bytes (reverse! stack) label-alist)))
|
||||
(if toplevel
|
||||
(bytecode->objcode bytes vars.nlocs vars.nexts)
|
||||
|
|
|
@ -4,7 +4,8 @@ guile_vm_SOURCES = guile-vm.c
|
|||
guile_vm_LDADD = libguilevm.la
|
||||
guile_vm_LDFLAGS = $(GUILE_LDFLAGS)
|
||||
|
||||
AM_CFLAGS = -Wall -g
|
||||
AM_CFLAGS = -Wall -g -pg
|
||||
guile_vm_LDFLAGS += -pg
|
||||
|
||||
lib_LTLIBRARIES = libguilevm.la
|
||||
libguilevm_la_SOURCES = \
|
||||
|
@ -12,6 +13,7 @@ libguilevm_la_SOURCES = \
|
|||
envs.h frames.h instructions.h objcodes.h programs.h vm.h \
|
||||
vm_engine.h vm_expand.h
|
||||
libguilevm_la_LDFLAGS = -version-info 0:0:0 -export-dynamic
|
||||
libguilevm_la_LDFLAGS += -pg
|
||||
EXTRA_DIST = vm_engine.c vm_system.c vm_scheme.c vm_loader.c
|
||||
BUILT_SOURCES = vm_system.i vm_scheme.i vm_loader.i \
|
||||
envs.x frames.x instructions.x objcodes.x programs.x vm.x
|
||||
|
@ -25,12 +27,23 @@ ETAGS_ARGS = --regex='/SCM_\(SYMBOL\|VCELL\).*\"\([^\"]\)*\"/\3/' \
|
|||
|
||||
SNARF = guile-snarf
|
||||
SUFFIXES = .i .x
|
||||
|
||||
.c.i:
|
||||
grep '^VM_DEFINE' $< > $@
|
||||
|
||||
.c.x:
|
||||
$(SNARF) $< $(DEFS) $(INCLUDES) $(CPPFLAGS) $(CFLAGS) $< > $@ \
|
||||
|| { rm $@; false; }
|
||||
|
||||
|
||||
# Extra rules for debugging purposes.
|
||||
|
||||
%.I: %.c
|
||||
$(CPP) $(DEFS) $(INCLUDES) $(CPPFLAGS) $< > $@
|
||||
|
||||
%.s: %.c
|
||||
$(CC) -S -dA $(DEFS) $(INCLUDES) $(CFLAGS) $(CPPFLAGS) -o $@ $<
|
||||
|
||||
GUILE = "$(bindir)/guile"
|
||||
guilec: guilec.in
|
||||
sed "s!@guile@!$(GUILE)!" guilec.in > guilec
|
||||
|
|
|
@ -117,7 +117,7 @@ SCM_DEFINE (scm_frame_local_ref, "frame-local-ref", 2, 0, 0,
|
|||
SCM_VALIDATE_HEAP_FRAME (1, frame);
|
||||
SCM_VALIDATE_INUM (2, index); /* FIXME: Check the range! */
|
||||
return SCM_FRAME_VARIABLE (SCM_HEAP_FRAME_POINTER (frame),
|
||||
scm_to_int (index));
|
||||
SCM_I_INUM (index));
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
@ -129,7 +129,7 @@ SCM_DEFINE (scm_frame_local_set_x, "frame-local-set!", 3, 0, 0,
|
|||
SCM_VALIDATE_HEAP_FRAME (1, frame);
|
||||
SCM_VALIDATE_INUM (2, index); /* FIXME: Check the range! */
|
||||
SCM_FRAME_VARIABLE (SCM_HEAP_FRAME_POINTER (frame),
|
||||
scm_to_int (index)) = val;
|
||||
SCM_I_INUM (index)) = val;
|
||||
return SCM_UNSPECIFIED;
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
|
|
@ -107,7 +107,7 @@ SCM_DEFINE (scm_instruction_length, "instruction-length", 1, 0, 0,
|
|||
#define FUNC_NAME s_scm_instruction_length
|
||||
{
|
||||
SCM_VALIDATE_INSTRUCTION (1, inst);
|
||||
return scm_from_schar (SCM_INSTRUCTION_LENGTH (inst));
|
||||
return SCM_I_MAKINUM (SCM_INSTRUCTION_LENGTH (inst));
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
@ -117,7 +117,7 @@ SCM_DEFINE (scm_instruction_pops, "instruction-pops", 1, 0, 0,
|
|||
#define FUNC_NAME s_scm_instruction_pops
|
||||
{
|
||||
SCM_VALIDATE_INSTRUCTION (1, inst);
|
||||
return scm_from_schar (SCM_INSTRUCTION_POPS (inst));
|
||||
return SCM_I_MAKINUM (SCM_INSTRUCTION_POPS (inst));
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
@ -127,7 +127,7 @@ SCM_DEFINE (scm_instruction_pushes, "instruction-pushes", 1, 0, 0,
|
|||
#define FUNC_NAME s_scm_instruction_pushes
|
||||
{
|
||||
SCM_VALIDATE_INSTRUCTION (1, inst);
|
||||
return scm_from_char (SCM_INSTRUCTION_PUSHES (inst));
|
||||
return SCM_I_MAKINUM (SCM_INSTRUCTION_PUSHES (inst));
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
@ -137,7 +137,7 @@ SCM_DEFINE (scm_instruction_to_opcode, "instruction->opcode", 1, 0, 0,
|
|||
#define FUNC_NAME s_scm_instruction_to_opcode
|
||||
{
|
||||
SCM_VALIDATE_INSTRUCTION (1, inst);
|
||||
return scm_from_char (SCM_INSTRUCTION_OPCODE (inst));
|
||||
return SCM_I_MAKINUM (SCM_INSTRUCTION_OPCODE (inst));
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
@ -148,7 +148,7 @@ SCM_DEFINE (scm_opcode_to_instruction, "opcode->instruction", 1, 0, 0,
|
|||
{
|
||||
int i;
|
||||
SCM_VALIDATE_INUM (1, op);
|
||||
i = scm_to_int (op);
|
||||
i = SCM_I_INUM (op);
|
||||
SCM_ASSERT_RANGE (1, op, 0 <= i && i < scm_op_last);
|
||||
return scm_from_locale_symbol (scm_instruction_table[i].name);
|
||||
}
|
||||
|
|
|
@ -159,8 +159,8 @@ SCM_DEFINE (scm_bytecode_to_objcode, "bytecode->objcode", 3, 0, 0,
|
|||
base = SCM_OBJCODE_BASE (objcode);
|
||||
|
||||
memcpy (base, OBJCODE_COOKIE, 8);
|
||||
base[8] = scm_to_int (nlocs);
|
||||
base[9] = scm_to_int (nexts);
|
||||
base[8] = SCM_I_INUM (nlocs);
|
||||
base[9] = SCM_I_INUM (nexts);
|
||||
|
||||
memcpy (base + 10, c_bytecode, size - 10);
|
||||
|
||||
|
@ -176,10 +176,13 @@ SCM_DEFINE (scm_load_objcode, "load-objcode", 1, 0, 0,
|
|||
#define FUNC_NAME s_scm_load_objcode
|
||||
{
|
||||
int fd;
|
||||
char *c_file;
|
||||
|
||||
SCM_VALIDATE_STRING (1, file);
|
||||
|
||||
fd = open (SCM_STRING_CHARS (file), O_RDONLY);
|
||||
c_file = scm_to_locale_string (file);
|
||||
fd = open (c_file, O_RDONLY);
|
||||
free (c_file);
|
||||
if (fd < 0) SCM_SYSERROR;
|
||||
|
||||
return make_objcode_by_mmap (fd);
|
||||
|
|
|
@ -149,10 +149,10 @@ SCM_DEFINE (scm_program_arity, "program-arity", 1, 0, 0,
|
|||
SCM_VALIDATE_PROGRAM (1, program);
|
||||
|
||||
p = SCM_PROGRAM_DATA (program);
|
||||
return SCM_LIST4 (scm_from_uchar (p->nargs),
|
||||
scm_from_uchar (p->nrest),
|
||||
scm_from_uchar (p->nlocs),
|
||||
scm_from_uchar (p->nexts));
|
||||
return SCM_LIST4 (SCM_I_MAKINUM (p->nargs),
|
||||
SCM_I_MAKINUM (p->nrest),
|
||||
SCM_I_MAKINUM (p->nlocs),
|
||||
SCM_I_MAKINUM (p->nexts));
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
||||
|
|
8
src/vm.c
8
src/vm.c
|
@ -476,10 +476,10 @@ SCM_DEFINE (scm_vm_stats, "vm-stats", 1, 0, 0,
|
|||
|
||||
SCM_VALIDATE_VM (1, vm);
|
||||
|
||||
stats = scm_make_vector (scm_from_int (2), SCM_UNSPECIFIED);
|
||||
scm_vector_set_x (stats, scm_from_int (0),
|
||||
stats = scm_make_vector (SCM_I_MAKINUM (2), SCM_UNSPECIFIED);
|
||||
scm_vector_set_x (stats, SCM_I_MAKINUM (0),
|
||||
scm_from_ulong (SCM_VM_DATA (vm)->time));
|
||||
scm_vector_set_x (stats, scm_from_int (1),
|
||||
scm_vector_set_x (stats, SCM_I_MAKINUM (1),
|
||||
scm_from_ulong (SCM_VM_DATA (vm)->clock));
|
||||
|
||||
return stats;
|
||||
|
@ -528,7 +528,7 @@ SCM_DEFINE (scm_vm_fetch_code, "vm-fetch-code", 1, 0, 0,
|
|||
|
||||
list = SCM_LIST1 (scm_str2symbol (p->name));
|
||||
for (i = 1; i <= p->len; i++)
|
||||
list = scm_cons (scm_from_uint8 (ip[i]), list);
|
||||
list = scm_cons (SCM_I_MAKINUM (ip[i]), list);
|
||||
return scm_reverse_x (list, SCM_EOL);
|
||||
}
|
||||
#undef FUNC_NAME
|
||||
|
|
|
@ -72,7 +72,7 @@ vm_run (SCM vm, SCM program, SCM args)
|
|||
#endif
|
||||
|
||||
#ifdef HAVE_LABELS_AS_VALUES
|
||||
/* Jump talbe */
|
||||
/* Jump table */
|
||||
static void *jump_table[] = {
|
||||
#define VM_INSTRUCTION_TO_LABEL 1
|
||||
#include "vm_expand.h"
|
||||
|
|
|
@ -216,10 +216,15 @@
|
|||
#define DROP() do { CHECK_UNDERFLOW (); sp--; } while (0)
|
||||
#define POP(x) do { x = *sp; DROP (); } while (0)
|
||||
|
||||
/* A fast CONS. This has to be fast since its used, for instance, by
|
||||
POP_LIST when fetching a function's argument list. Note: `scm_cell' is an
|
||||
inlined function in Guile 1.7. Unfortunately, it calls
|
||||
`scm_gc_for_newcell ()' which is _not_ inlined and allocated cells on the
|
||||
heap. XXX */
|
||||
#define CONS(x,y,z) \
|
||||
{ \
|
||||
SYNC_BEFORE_GC (); \
|
||||
x = scm_cons (y, z); \
|
||||
x = scm_cell (SCM_UNPACK (y), SCM_UNPACK (z)); \
|
||||
}
|
||||
|
||||
#define POP_LIST(n) \
|
||||
|
|
|
@ -138,9 +138,9 @@ VM_DEFINE_LOADER (load_program, "load-program")
|
|||
|
||||
/* init parameters */
|
||||
/* NOTE: format defined in system/vm/assemble.scm */
|
||||
if (scm_is_integer (x))
|
||||
if (SCM_I_INUMP (x))
|
||||
{
|
||||
int i = scm_to_int (x);
|
||||
int i = SCM_I_INUM (x);
|
||||
if (-128 <= i && i <= 127)
|
||||
{
|
||||
/* 8-bit representation */
|
||||
|
@ -162,10 +162,10 @@ VM_DEFINE_LOADER (load_program, "load-program")
|
|||
{
|
||||
/* Other cases */
|
||||
sp -= 4;
|
||||
p->nargs = scm_to_int (sp[0]);
|
||||
p->nrest = scm_to_int (sp[1]);
|
||||
p->nlocs = scm_to_int (sp[2]);
|
||||
p->nexts = scm_to_int (sp[3]);
|
||||
p->nargs = SCM_I_INUM (sp[0]);
|
||||
p->nrest = SCM_I_INUM (sp[1]);
|
||||
p->nlocs = SCM_I_INUM (sp[2]);
|
||||
p->nexts = SCM_I_INUM (sp[3]);
|
||||
}
|
||||
|
||||
PUSH (prog);
|
||||
|
|
|
@ -167,8 +167,8 @@ VM_DEFINE_FUNCTION (set_cdr, "set-cdr!", 2)
|
|||
#define REL(crel,srel) \
|
||||
{ \
|
||||
ARGS2 (x, y); \
|
||||
if (scm_is_integer (x) && scm_is_integer (y)) \
|
||||
RETURN (SCM_BOOL (scm_to_int (x) crel scm_to_int (y))); \
|
||||
if (SCM_I_INUMP (x) && SCM_I_INUMP (y)) \
|
||||
RETURN (SCM_BOOL (SCM_I_INUM (x) crel SCM_I_INUM (y))); \
|
||||
RETURN (srel (x, y)); \
|
||||
}
|
||||
|
||||
|
@ -206,11 +206,11 @@ VM_DEFINE_FUNCTION (ge, "ge?", 2)
|
|||
#define FUNC1(CEXP,SEXP) \
|
||||
{ \
|
||||
ARGS1 (x); \
|
||||
if (scm_is_integer (x)) \
|
||||
if (SCM_I_INUMP (x)) \
|
||||
{ \
|
||||
int n = CEXP; \
|
||||
if (SCM_FIXABLE (n)) \
|
||||
RETURN (scm_from_int (n)); \
|
||||
RETURN (SCM_I_MAKINUM (n)); \
|
||||
} \
|
||||
RETURN (SEXP); \
|
||||
}
|
||||
|
@ -219,11 +219,11 @@ VM_DEFINE_FUNCTION (ge, "ge?", 2)
|
|||
#define FUNC2(CFUNC,SFUNC) \
|
||||
{ \
|
||||
ARGS2 (x, y); \
|
||||
if (scm_is_integer (x) && scm_is_integer (y)) \
|
||||
if (SCM_I_INUMP (x) && SCM_I_INUMP (y)) \
|
||||
{ \
|
||||
int n = scm_to_int (x) CFUNC scm_to_int (y); \
|
||||
int n = SCM_I_INUM (x) CFUNC SCM_I_INUM (y); \
|
||||
if (SCM_FIXABLE (n)) \
|
||||
RETURN (scm_from_int (n)); \
|
||||
RETURN (SCM_I_MAKINUM (n)); \
|
||||
} \
|
||||
RETURN (SFUNC (x, y)); \
|
||||
}
|
||||
|
|
|
@ -119,7 +119,7 @@ VM_DEFINE_INSTRUCTION (make_eol, "make-eol", 0, 0, 1)
|
|||
|
||||
VM_DEFINE_INSTRUCTION (make_int8, "make-int8", 1, 0, 1)
|
||||
{
|
||||
PUSH (scm_from_schar ((signed char) FETCH ()));
|
||||
PUSH (SCM_I_MAKINUM ((signed char) FETCH ()));
|
||||
NEXT;
|
||||
}
|
||||
|
||||
|
@ -139,7 +139,7 @@ VM_DEFINE_INSTRUCTION (make_int16, "make-int16", 2, 0, 1)
|
|||
{
|
||||
int h = FETCH ();
|
||||
int l = FETCH ();
|
||||
PUSH (scm_from_short ((signed short) (h << 8) + l));
|
||||
PUSH (SCM_I_MAKINUM ((signed short) (h << 8) + l));
|
||||
NEXT;
|
||||
}
|
||||
|
||||
|
@ -197,8 +197,12 @@ VM_DEFINE_INSTRUCTION (list_break, "list-break", 0, 0, 0)
|
|||
#define LOCAL_REF(i) SCM_FRAME_VARIABLE (fp, i)
|
||||
#define LOCAL_SET(i,o) SCM_FRAME_VARIABLE (fp, i) = o
|
||||
|
||||
/* #define VARIABLE_REF(v) SCM_CDR (v) */
|
||||
/* #define VARIABLE_SET(v,o) SCM_SETCDR (v, o) */
|
||||
/* For the variable operations, we _must_ obviously avoid function calls to
|
||||
`scm_variable_ref ()', `scm_variable_bound_p ()' and friends which do
|
||||
nothing more than the corresponding macros. */
|
||||
#define VARIABLE_REF(v) SCM_VARIABLE_REF (v)
|
||||
#define VARIABLE_SET(v,o) SCM_VARIABLE_SET (v, o)
|
||||
#define VARIABLE_BOUNDP(v) (VARIABLE_REF (v) != SCM_UNDEFINED)
|
||||
|
||||
/* ref */
|
||||
|
||||
|
@ -232,7 +236,7 @@ VM_DEFINE_INSTRUCTION (variable_ref, "variable-ref", 0, 0, 1)
|
|||
{
|
||||
SCM x = *sp;
|
||||
|
||||
if (SCM_FALSEP (scm_variable_bound_p (x)))
|
||||
if (!VARIABLE_BOUNDP (x))
|
||||
{
|
||||
err_args = SCM_LIST1 (x);
|
||||
/* Was: err_args = SCM_LIST1 (SCM_CAR (x)); */
|
||||
|
@ -240,7 +244,7 @@ VM_DEFINE_INSTRUCTION (variable_ref, "variable-ref", 0, 0, 1)
|
|||
}
|
||||
else
|
||||
{
|
||||
SCM o = scm_variable_ref (x);
|
||||
SCM o = VARIABLE_REF (x);
|
||||
*sp = o;
|
||||
}
|
||||
|
||||
|
@ -273,7 +277,7 @@ VM_DEFINE_INSTRUCTION (external_set, "external-set", 1, 1, 0)
|
|||
|
||||
VM_DEFINE_INSTRUCTION (variable_set, "variable-set", 0, 1, 0)
|
||||
{
|
||||
scm_variable_set_x (sp[0], sp[-1]);
|
||||
VARIABLE_SET (sp[0], sp[-1]);
|
||||
scm_set_object_property_x (sp[-1], scm_sym_name, SCM_CAR (sp[0]));
|
||||
sp -= 2;
|
||||
NEXT;
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue