mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-19 03:00:25 +02:00
Code Activity

*** empty log message ***

Browse source
This commit is contained in:
Keisuke Nishida 2001-04-11 20:57:44 +00:00
parent 8710eba09b
commit 41f248a84a
14 changed files with 168 additions and 184 deletions
Download patch file Download diff file Expand all files Collapse all files

32
module/language/gscheme/spec.scm
View file

@ -26,23 +26,6 @@
:use-module (ice-9 and-let-star)
:export (gscheme))
;;;
;;; Macro expander
;;;
(define (expand x)
(expand-macro x (current-module)))
(define (expand-macro x m)
(if (pair? x)
(let* ((s (car x))
(v (and (symbol? s) (module-defined? m s) (module-ref m s))))
(if (defmacro? v)
(expand-macro (apply (defmacro-transformer v) (cdr x)) m)
(cons (expand-macro (car x) m) (expand-macro (cdr x) m))))
x))
;;;
;;; Translator
@ -111,10 +94,22 @@
(_loop ,@(map translate update)))))))
(_loop ,@(map translate init))))))
(else
(let ((e (expand x)))
(if (eq? e x)
(let ((prim (and (symbol? head) (symbol-append '@ head))))
(if (and prim (ghil-primitive? prim))
(cons prim (map translate rest))
(cons (translate head) (map translate rest))))))))
(cons (translate head) (map translate rest))))
(translate e)))))))
(define (expand x)
(if (and (symbol? (car x))
(module-defined? (current-module) (car x)))
(let ((v (module-ref (current-module) (car x))))
(if (defmacro? v)
(apply (defmacro-transformer v) (cdr x))
x))
x))
;;;
@ -125,7 +120,6 @@
:title "Guile Scheme"
:version "0.4"
:reader read
:expander expand
:translator translate
:printer write
)

4
module/system/il/compile.scm
View file

@ -136,14 +136,14 @@
;; TEST
;; (br-if-not L1)
;; THEN
;; (jump L2)
;; (br L2)
;; L1: ELSE
;; L2:
(let ((L1 (make-label)) (L2 (make-label)))
(comp-push test)
(push-code! (make-<glil-branch> 'br-if-not L1))
(comp-tail then)
(if (not tail) (push-code! (make-<glil-branch> 'jump L2)))
(if (not tail) (push-code! (make-<glil-branch> 'br L2)))
(push-code! (make-<glil-label> L1))
(comp-tail else)
(if (not tail) (push-code! (make-<glil-label> L2)))))

5
module/system/il/glil.scm
View file

@ -156,7 +156,7 @@
(($ <glil-module> op module name)
`(,(symbol-append 'module- op) ,module ,name))
;; controls
(($ <glil-label> label) `(label ,label))
(($ <glil-label> label) label)
(($ <glil-branch> inst label) `(,inst ,label))
(($ <glil-call> inst nargs) `(,inst ,nargs))))
@ -168,8 +168,7 @@
(define (pprint-glil glil)
(let print ((code (unparse glil)) (column 0))
(display (make-string column #\space))
(case (car code)
((@asm)
(cond ((and (pair? code) (eq? (car code) '@asm))
(format #t "(@asm ~A\n" (cadr code))
(let ((col (+ column 2)))
(let loop ((l (cddr code)))

113
module/system/vm/assemble.scm
View file

@ -41,7 +41,7 @@
(define-structure (venv parent nexts closure?))
(define-structure (vmod id))
(define-structure (vlink module name))
(define-structure (bytespec nargs nrest nlocs nexts bytes objs))
(define-structure (bytespec nargs nrest nlocs nexts bytes objs closure?))
;;;
@ -74,33 +74,17 @@
(label-alist '())
(object-alist '()))
(define (push-code! code)
(set! stack (optimizing-push code stack)))
(set! stack (cons (code->bytes code) stack)))
(define (push-object! x)
(cond ((object->code x) => push-code!)
(toplevel
;; top-level object-dump
(cond ((object-assoc x object-alist) =>
(lambda (obj+index)
(cond ((not (cdr obj+index))
(set-cdr! obj+index nlocs)
(set! nlocs (+ nlocs 1))))
(push-code! `(local-ref ,(cdr obj+index)))))
(toplevel (dump-object! push-code! x))
(else
(set! object-alist (acons x #f object-alist))
(push-code! `(object-dump ,x)))))
(else
;; local object-ref
(let ((i (cond ((object-assoc x object-alist) => cdr)
(else
(let ((i (length object-alist)))
(set! object-alist (acons x i object-alist))
i)))))
(push-code! `(object-ref ,i))))))
(define (label-ref key)
(assq-ref label-alist key))
(define (label-set key)
(let ((addr (apply + (map length stack))))
(set! label-alist (assq-set! label-alist key addr))))
(define (generate-code x)
(match x
(($ <vm-asm> venv)
@ -108,7 +92,7 @@
(if (venv-closure? venv) (push-code! `(make-closure))))
(($ <glil-void>)
(push-code! `(void)))
(push-code! '(void)))
(($ <glil-const> x)
(push-object! x))
@ -139,11 +123,14 @@
(push-code! '(variable-set))))
(($ <glil-label> label)
(label-set label))
(define (byte-length x)
(cond ((string? x) (string-length x))
(else 3)))
(let ((addr (apply + (map byte-length stack))))
(set! label-alist (assq-set! label-alist label addr))))
(($ <glil-branch> inst label)
(let ((setter (lambda (addr) (- (label-ref label) addr))))
(push-code! (list inst setter))))
(set! stack (cons (list inst label) stack)))
(($ <glil-call> inst nargs)
(if (instruction? inst)
@ -158,73 +145,31 @@
;;
;; main
(for-each generate-code body)
(let ((bytes (stack->bytes (reverse! stack) label-alist)))
(if toplevel
;; top-level
(let ((new '()))
(define (push-code! x)
(set! new (cons x new)))
(do ((stack (reverse! stack) (cdr stack)))
((null? stack)
(make-dumpcode nlocs nexts (stack->bytes (reverse! new))))
(if (eq? (caar stack) 'object-dump)
(let ((x (cadar stack)))
(dump-object! push-code! x)
(cond ((object-assoc x object-alist) =>
(lambda (obj+index)
(cond ((cdr obj+index) =>
(lambda (n)
(push-code! '(dup))
(push-code! `(local-set ,n)))))))))
(push-code! (car stack)))))
;; closures
(let ((bytes (stack->bytes (reverse! stack)))
(objs (map car (reverse! object-alist))))
(make-bytespec nargs nrest nlocs nexts bytes objs)))))))
(make-dumpcode nlocs nexts bytes)
(let ((objs (map car (reverse! object-alist))))
(make-bytespec nargs nrest nlocs nexts bytes objs
(venv-closure? venv)))))))))
(define (object-assoc x alist)
(if (vlink? x) (assoc x alist) (assq x alist)))
(define (stack->bytes stack)
(define (stack->bytes stack label-alist)
(let loop ((result '()) (stack stack) (addr 0))
(if (null? stack)
(apply string-append (reverse! result))
(let* ((orig (car stack))
(addr (+ addr (length orig)))
(code (if (and (pair? (cdr orig)) (procedure? (cadr orig)))
`(,(car orig) ,((cadr orig) addr))
orig)))
(loop (cons (code->bytes code) result) (cdr stack) addr)))))
;;;
;;; Bytecode optimization
;;;
(define *optimization-table*
'((not (not . not-not)
(eq? . not-eq?)
(null? . not-null?)
(not-not . not)
(not-eq? . eq?)
(not-null? . null?))
(br-if (not . br-if-not)
(eq? . br-if-eq)
(null? . br-if-null)
(not-not . br-if)
(not-eq? . br-if-not-eq)
(not-null? . br-if-not-null))
(br-if-not (not . br-if)
(eq? . br-if-not-eq)
(null? . br-if-not-null)
(not-not . br-if-not)
(not-eq? . br-if-eq)
(not-null? . br-if-null))))
(define (optimizing-push code stack)
(let ((alist (assq-ref *optimization-table* (car code))))
(cond ((and alist (pair? stack) (assq-ref alist (caar stack))) =>
(lambda (inst) (cons (cons inst (cdr code)) (cdr stack))))
(else (cons (code-pack code) stack)))))
(let ((bytes (car stack)))
(if (pair? bytes)
(let* ((offset (- (assq-ref label-alist (cadr bytes))
(+ addr 3)))
(n (if (< offset 0) (+ offset 65536) offset)))
(set! bytes (code->bytes (list (car bytes)
(quotient n 256)
(modulo n 256))))))
(loop (cons bytes result)
(cdr stack)
(+ addr (string-length bytes)))))))
;;;
@ -239,7 +184,7 @@
((object->code x) => push-code!)
((bytespec? x)
(match x
(($ bytespec nargs nrest nlocs nexts bytes objs)
(($ bytespec nargs nrest nlocs nexts bytes objs closure?)
;; dump parameters
(cond
((and (< nargs 4) (< nlocs 8) (< nexts 4))
@ -264,7 +209,7 @@
;; dump bytecode
(push-code! `(load-program ,bytes)))))
((vlink? x)
(dump! (vlink-module x))
;;; (dump! (vlink-module x)) ;; FIXME: no module support now
(dump! (vlink-name x))
(push-code! `(link)))
((vmod? x)

8
module/system/vm/conv.scm
View file

@ -36,11 +36,6 @@
(cond ((< n 10)
(let ((abbrev (string->symbol (format #f "~A:~A" inst n))))
(if (instruction? abbrev) (list abbrev) code)))
((> n 255)
(let ((double (string->symbol (format #f "~A*2" inst))))
(if (instruction? double)
(list double (quotient n 256) (modulo n 256))
(apply error "Index out of range:" code))))
(else code)))
(else code)))
@ -91,7 +86,8 @@
(else #f)))
(define (code->bytes code)
(let* ((inst (car code))
(let* ((code (code-pack code))
(inst (car code))
(rest (cdr code))
(head (make-string 1 (integer->char (instruction->opcode inst))))
(len (instruction-length inst)))

19
module/system/vm/disasm.scm
View file

@ -44,7 +44,8 @@
(nlocs (caddr arity))
(nexts (cadddr arity))
(bytes (program-bytecode prog))
(objs (program-objects prog)))
(objs (program-objects prog))
(exts (program-external prog)))
;; Disassemble this bytecode
(format #t "Disassembly of ~A:\n\n" prog)
(format #t "nargs = ~A nrest = ~A nlocs = ~A nexts = ~A\n\n"
@ -53,6 +54,8 @@
(disassemble-bytecode bytes objs)
(if (> (vector-length objs) 0)
(disassemble-objects objs))
(if (pair? exts)
(disassemble-externals exts))
;; Disassemble other bytecode in it
(for-each
(lambda (x)
@ -89,6 +92,15 @@
(let ((info (object->string (vector-ref objs n))))
(print-info n info #f)))))
(define (disassemble-externals exts)
(display "Externals:\n\n")
(let ((len (length exts)))
(do ((n 0 (1+ n))
(l exts (cdr l)))
((null? l) (newline))
(let ((info (object->string (car l))))
(print-info n info #f)))))
(define (disassemble-meta meta)
(display "Meta info:\n\n")
(for-each (lambda (data)
@ -98,11 +110,12 @@
(define (original-value addr code objs)
(define (branch-code? code)
(string-match "^(br|jump)" (symbol->string (car code))))
(string-match "^br" (symbol->string (car code))))
(let ((code (code-unpack code)))
(cond ((code->object code) => object->string)
((branch-code? code)
(format #f "-> ~A" (+ addr (cadr code) 2)))
(let ((offset (+ (* (cadr code) 256) (caddr code))))
(format #f "-> ~A" (+ addr offset 3))))
(else
(let ((inst (car code)) (args (cdr code)))
(case inst

2
module/system/vm/load.scm
View file

@ -20,8 +20,8 @@
;;; Code:
(define-module (system vm load)
:use-module (system vm core)
:autoload (system base language) (compile-file-in lookup-language)
:use-module (system vm core)
:use-module (ice-9 regex)
:export (load/compile))

3
module/system/vm/trace.scm
View file

@ -20,6 +20,7 @@
;;; Code:
(define-module (system vm trace)
:use-syntax (system base syntax)
:use-module (system vm core)
:use-module (system vm frame)
:use-module (ice-9 format)
@ -49,7 +50,7 @@
(case (car opts)
((:s) (format #t "~20S" (vm-fetch-stack vm)))
((:v) (format #t "~20S" (frame-variables frame)))
((:e) (format #t "~20S" (program-external (frame-program frame))))))))
((:e) (format #t "~20A" (object->string (frame-external-link frame))))))))
(define (trace-apply vm)
(if (vm-option vm 'trace-first)

27
src/vm.c
View file

@ -68,6 +68,7 @@ make_vm_heap_frame (SCM *fp)
p->program = SCM_UNDEFINED;
p->variables = SCM_UNDEFINED;
p->dynamic_link = SCM_UNDEFINED;
p->external_link = SCM_UNDEFINED;
SCM_RETURN_NEWSMOB (scm_tc16_vm_heap_frame, p);
}
@ -77,7 +78,8 @@ vm_heap_frame_mark (SCM obj)
struct scm_vm_heap_frame *p = SCM_VM_HEAP_FRAME_DATA (obj);
scm_gc_mark (p->program);
scm_gc_mark (p->variables);
return p->dynamic_link;
scm_gc_mark (p->dynamic_link);
return p->external_link;
}
/* Scheme interface */
@ -146,6 +148,23 @@ SCM_DEFINE (scm_frame_dynamic_link, "frame-dynamic-link", 1, 0, 0,
}
#undef FUNC_NAME
SCM_DEFINE (scm_frame_external_link, "frame-external-link", 1, 0, 0,
(SCM frame),
"")
#define FUNC_NAME s_scm_frame_external_link
{
struct scm_vm_heap_frame *p;
SCM_VALIDATE_VM_HEAP_FRAME (1, frame);
p = SCM_VM_HEAP_FRAME_DATA (frame);
if (SCM_UNBNDP (p->external_link))
p->external_link = SCM_VM_FRAME_EXTERNAL_LINK (p->fp);
return p->external_link;
}
#undef FUNC_NAME
/*
* VM Continuation
@ -213,7 +232,7 @@ vm_cont_free (SCM obj)
* VM Internal functions
*/
SCM_SYMBOL (sym_vm_engine, "vm-engine");
SCM_SYMBOL (sym_vm_run, "vm-run");
SCM_SYMBOL (sym_vm_error, "vm-error");
static scm_byte_t *
@ -307,7 +326,7 @@ vm_mark (SCM obj)
for (; sp >= upper; sp--)
if (SCM_NIMP (*sp))
scm_gc_mark (*sp);
fp = SCM_VM_STACK_ADDRESS (*sp); /* dynamic link */
fp = SCM_VM_STACK_ADDRESS (sp[-1]); /* dynamic link */
/* Mark frame variables + program */
for (sp -= 2; sp >= lower; sp--)
if (SCM_NIMP (*sp))
@ -337,7 +356,7 @@ scm_vm_apply (SCM vm, SCM program, SCM args)
#define FUNC_NAME "scm_vm_apply"
{
SCM_VALIDATE_PROGRAM (1, program);
return vm_engine (vm, program, args);
return vm_run (vm, program, args);
}
#undef FUNC_NAME

14
src/vm.h
View file

@ -61,10 +61,11 @@
*/
/*
| | <- fp + bp->nargs + bp->nlocs + 2
| | <- fp + bp->nargs + bp->nlocs + 3
+------------------+ = SCM_VM_FRAME_UPPER_ADDRESS (fp)
| Return address |
| Dynamic link |
| Return address | <- fp + bp->nargs + bp->nlocs
| External link | <- fp + bp->nargs + bp->nlocs
| Local varialbe 1 | = SCM_VM_FRAME_DATA_ADDRESS (fp)
| Local variable 0 | <- fp + bp->nargs
| Argument 1 |
@ -74,15 +75,16 @@
| |
*/
#define SCM_VM_FRAME_LOWER_ADDRESS(fp) (fp - 1)
#define SCM_VM_FRAME_DATA_ADDRESS(fp) \
(fp + SCM_PROGRAM_NARGS (SCM_VM_FRAME_PROGRAM (fp)) \
+ SCM_PROGRAM_NLOCS (SCM_VM_FRAME_PROGRAM (fp)))
#define SCM_VM_FRAME_UPPER_ADDRESS(fp) \
(SCM_VM_FRAME_DATA_ADDRESS (fp) + 2)
(SCM_VM_FRAME_DATA_ADDRESS (fp) + 3)
#define SCM_VM_FRAME_LOWER_ADDRESS(fp) (fp - 1)
#define SCM_VM_FRAME_RETURN_ADDRESS(fp) SCM_VM_FRAME_DATA_ADDRESS (fp)[2]
#define SCM_VM_FRAME_DYNAMIC_LINK(fp) SCM_VM_FRAME_DATA_ADDRESS (fp)[1]
#define SCM_VM_FRAME_RETURN_ADDRESS(fp) SCM_VM_FRAME_DATA_ADDRESS (fp)[0]
#define SCM_VM_FRAME_EXTERNAL_LINK(fp) SCM_VM_FRAME_DATA_ADDRESS (fp)[0]
#define SCM_VM_FRAME_VARIABLE(fp,i) fp[i]
#define SCM_VM_FRAME_PROGRAM(fp) fp[-1]
@ -95,6 +97,7 @@ struct scm_vm_heap_frame {
SCM program;
SCM variables;
SCM dynamic_link;
SCM external_link;
};
extern scm_bits_t scm_tc16_vm_heap_frame;
@ -106,6 +109,7 @@ extern scm_bits_t scm_tc16_vm_heap_frame;
#define SCM_VM_HEAP_FRAME_PROGRAM(f) SCM_VM_HEAP_FRAME_DATA (f)->program
#define SCM_VM_HEAP_FRAME_VARIABLES(f) SCM_VM_HEAP_FRAME_DATA (f)->variables
#define SCM_VM_HEAP_FRAME_DYNAMIC_LINK(f) SCM_VM_HEAP_FRAME_DATA (f)->dynamic_link
#define SCM_VM_HEAP_FRAME_EXTERNAL_LINK(f) SCM_VM_HEAP_FRAME_DATA (f)->external_link
/*
* VM

6
src/vm_engine.c
View file

@ -44,7 +44,7 @@
#include "vm_engine.h"
static SCM
vm_engine (SCM vm, SCM program, SCM args)
vm_run (SCM vm, SCM program, SCM args)
#define FUNC_NAME "vm-engine"
{
/* VM registers */
@ -55,7 +55,7 @@ vm_engine (SCM vm, SCM program, SCM args)
/* Cache variables */
struct scm_vm *vp = SCM_VM_DATA (vm); /* VM data pointer */
struct scm_program *bp = NULL; /* program base pointer */
SCM external; /* external environment */
SCM external = SCM_EOL; /* external environment */
SCM *objects = NULL; /* constant objects */
SCM *stack_base = vp->stack_base; /* stack base address */
SCM *stack_limit = vp->stack_limit; /* stack limit address */
@ -161,7 +161,7 @@ vm_engine (SCM vm, SCM program, SCM args)
vm_error:
SYNC_ALL ();
scm_ithrow (sym_vm_error,
SCM_LIST4 (sym_vm_engine, err_msg, err_args,
SCM_LIST4 (sym_vm_run, err_msg, err_args,
scm_vm_current_frame (vm)),
1);
}

20
src/vm_engine.h
View file

@ -133,7 +133,16 @@
{ \
bp = SCM_PROGRAM_DATA (program); \
objects = SCM_VELTS (bp->objs); \
external = bp->external; \
}
#define CACHE_EXTERNAL() \
{ \
external = fp[bp->nargs + bp->nlocs]; \
}
#define SYNC_EXTERNAL() \
{ \
fp[bp->nargs + bp->nlocs] = external; \
}
#define SYNC_BEFORE_GC() \
@ -280,17 +289,18 @@ do { \
SCM dl = SCM_VM_MAKE_STACK_ADDRESS (fp); \
ip = bp->base; \
fp = sp - bp->nargs + 1; \
sp = sp + bp->nlocs + 2; \
sp = sp + bp->nlocs + 3; \
CHECK_OVERFLOW (); \
sp[0] = dl; \
sp[-1] = ra; \
sp[0] = ra; \
sp[-1] = dl; \
sp[-2] = bp->external; \
}
#define FREE_FRAME() \
{ \
SCM *new_sp = fp - 2; \
sp = fp + bp->nargs + bp->nlocs; \
ip = SCM_VM_BYTE_ADDRESS (sp[0]); \
ip = SCM_VM_BYTE_ADDRESS (sp[2]); \
fp = SCM_VM_STACK_ADDRESS (sp[1]); \
sp = new_sp; \
}

12
src/vm_loader.c
View file

@ -159,15 +159,12 @@ VM_DEFINE_LOADER (load_program, "load-program")
NEXT;
}
VM_DEFINE_INSTRUCTION (link, "link", 0, 2, 1)
{
if (!SCM_FALSEP (sp[-1]))
VM_DEFINE_INSTRUCTION (link, "link", 0, 1, 1)
{
#if 0
sp[-1] = scm_c_env_vcell (sp[-1], sp[0], 1);
sp--;
}
else
{
#endif
/* Temporary hack that supports the current module system */
SCM mod = scm_current_module ();
SCM var = scm_eval_closure_lookup (scm_standard_eval_closure (mod),
@ -176,8 +173,7 @@ VM_DEFINE_INSTRUCTION (link, "link", 0, 2, 1)
/* Create a new variable if not defined yet */
var = scm_eval_closure_lookup (scm_standard_eval_closure (mod),
*sp, SCM_BOOL_T);
*--sp = SCM_VARVCELL (var);
}
*sp = SCM_VARVCELL (var);
NEXT;
}

33
src/vm_system.c
View file

@ -223,49 +223,53 @@ VM_DEFINE_INSTRUCTION (variable_set, "variable-set", 0, 1, 0)
#define BR(p) \
{ \
signed char offset = FETCH (); \
int h = FETCH (); \
int l = FETCH (); \
signed short offset = (h << 8) + l; \
if (p) \
ip += offset; \
DROP (); \
NEXT; \
}
VM_DEFINE_INSTRUCTION (br_if, "br-if", 1, 0, 0)
VM_DEFINE_INSTRUCTION (br, "br", 2, 0, 0)
{
int h = FETCH ();
int l = FETCH ();
ip += (signed short) (h << 8) + l;
NEXT;
}
VM_DEFINE_INSTRUCTION (br_if, "br-if", 2, 0, 0)
{
BR (!SCM_FALSEP (*sp));
}
VM_DEFINE_INSTRUCTION (br_if_not, "br-if-not", 1, 0, 0)
VM_DEFINE_INSTRUCTION (br_if_not, "br-if-not", 2, 0, 0)
{
BR (SCM_FALSEP (*sp));
}
VM_DEFINE_INSTRUCTION (br_if_eq, "br-if-eq", 1, 0, 0)
VM_DEFINE_INSTRUCTION (br_if_eq, "br-if-eq", 2, 0, 0)
{
BR (SCM_EQ_P (sp[0], sp--[1]));
}
VM_DEFINE_INSTRUCTION (br_if_not_eq, "br-if-not-eq", 1, 0, 0)
VM_DEFINE_INSTRUCTION (br_if_not_eq, "br-if-not-eq", 2, 0, 0)
{
BR (!SCM_EQ_P (sp[0], sp--[1]));
}
VM_DEFINE_INSTRUCTION (br_if_null, "br-if-null", 1, 0, 0)
VM_DEFINE_INSTRUCTION (br_if_null, "br-if-null", 2, 0, 0)
{
BR (SCM_NULLP (*sp));
}
VM_DEFINE_INSTRUCTION (br_if_not_null, "br-if-not-null", 1, 0, 0)
VM_DEFINE_INSTRUCTION (br_if_not_null, "br-if-not-null", 2, 0, 0)
{
BR (!SCM_NULLP (*sp));
}
VM_DEFINE_INSTRUCTION (jump, "jump", 1, 0, 0)
{
ip += (signed char) FETCH ();
NEXT;
}
/*
* Subprogram call
@ -305,8 +309,10 @@ VM_DEFINE_INSTRUCTION (call, "call", 1, -1, 1)
LOCAL_SET (i, SCM_UNDEFINED);
/* Create external variables */
CACHE_EXTERNAL ();
for (i = 0; i < bp->nexts; i++)
CONS (external, SCM_UNDEFINED, external);
SYNC_EXTERNAL ();
ENTER_HOOK ();
APPLY_HOOK ();
@ -454,6 +460,7 @@ VM_DEFINE_INSTRUCTION (return, "return", 0, 0, 1)
/* Restore the last program */
program = SCM_VM_FRAME_PROGRAM (fp);
CACHE_PROGRAM ();
CACHE_EXTERNAL ();
PUSH (ret);
NEXT;
}