Commit 8684d0ea authored by Erick Gallesio's avatar Erick Gallesio

.

parent 323645e1
;;;;
;;;; fileselector.stk -- GTKlos File Selector Widget
;;;;
;;;; Copyright 2002 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;; Copyright 2002-2007 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;;
;;;;
;;;; This program is free software; you can redistribute it and/or modify
......@@ -21,7 +21,7 @@
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 15-Feb-2002 16:59 (eg)
;;;; Last file update: 15-Feb-2002 18:06 (eg)
;;;; Last file update: 7-Jan-2007 23:01 (eg)
;;;;
(define-class <file-selector> (<gtk-container>)
......@@ -36,7 +36,7 @@
(define-method realize-widget ((self <file-selector>) initargs)
(let ((title (key-get initargs :title "")))
(slot-set! self 'wid (%fileseLector self title))))
(slot-set! self 'wid (%fileselector self title))))
;======================================================================
;
......
;bonus;;;
;;;; c o m p i l e r . s t k -- STklos Compiler
;;;;
;;;; Copyright 2000-2006 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;; Copyright 2000-2007 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;;
;;;;
;;;; This program is free software; you can redistribute it and/or modify
......@@ -21,7 +21,7 @@
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 26-Feb-2000 10:47 (eg)
;;;; Last file update: 18-Dec-2006 13:37 (eg)
;;;; Last file update: 5-Jan-2007 19:43 (eg)
;;;;
(define-module STKLOS-COMPILER
......@@ -1167,6 +1167,23 @@ doc>
(Loop (cdr l)
loc)))))))))))
(define (compile-let* args env tail?)
(let ((len (length args)))
(if (< len 3)
(compiler-error 'let* args "ill formed let* ~S" args)
(let ((bindings (cadr args))
(body (cddr args)))
(when (valid-let-bindings? bindings #f)
(compile (if (<= (length bindings) 1)
`(let ,bindings ,@body)
`(let (,(car bindings))
(let* ,(cdr bindings)
,@body)))
env args tail?))))))
;;
;; COND
;;
......
This diff is collapsed.
This source diff could not be displayed because it is too large. You can view the blob instead.
......@@ -21,7 +21,7 @@
*
* Author: Erick Gallesio [eg@unice.fr]
* Creation date: 1-Mar-2000 19:51 (eg)
* Last file update: 26-Nov-2006 12:16 (eg)
* Last file update: 5-Jan-2007 00:49 (eg)
*/
// INLINER values
......@@ -351,6 +351,44 @@ static Inline SCM clone_env(SCM e, vm_thread_t *vm)
return e;
}
static void verif_environment(vm_thread_t *vm)
{
SCM *lfp, *env;
STk_debug("<<<<<<VVVVVVVV<<<<");
for (lfp = vm->fp; lfp; lfp = ACT_SAVE_FP(lfp)) {
SCM self = (SCM) (ACT_SAVE_PROC(lfp));
STk_debug("self = ~S", self);
if (!self || !ACT_SAVE_ENV(lfp)) break;
STk_debug("++++ %d", ACT_SAVE_ENV(lfp));
for (env = ACT_SAVE_ENV(lfp); FRAMEP(env); env = FRAME_NEXT(env)){
STk_debug(" On a l'environment ~S (%d)", (SCM) env,
IS_IN_STACKP(env));
}
STk_debug("---");
}
STk_debug(">>>VVV>>>>>>>");
}
static void patch_environment(vm_thread_t *vm)
{
SCM *lfp;
STk_debug("<<<<<<<<<<");
for (lfp = vm->fp; lfp; lfp = ACT_SAVE_FP(lfp)) {
if (!ACT_SAVE_ENV(lfp)) break;
STk_debug("++++ %d", ACT_SAVE_ENV(lfp));
ACT_SAVE_ENV(lfp) = clone_env(ACT_SAVE_ENV(lfp), vm);
STk_debug("---");
}
STk_debug(">>>>>>>>>>");
verif_environment(vm);
}
static void error_bad_arity(SCM func, int arity, short given_args, vm_thread_t *vm)
{
......@@ -721,23 +759,24 @@ static void dump_couple_instr(void)
fprintf(dump, "\n]\n");
}
# endif
#endif
#ifdef STK_DEBUG
static void patch_environment(vm_thread_t *vm);
DEFINE_PRIMITIVE("%vm", set_vm_debug, vsubr, (int argc, SCM *argv))
{
/*
* This function is just a placeholder for debugging the VM. It's body is
* changed depending of the current bug to track
*/
int x;
vm_thread_t *vm = STk_get_current_vm();
printf("C stack %p, Scheme %p\n", &x, vm->sp);
patch_environment(STk_get_current_vm());
return STk_void;
}
#endif
/*===========================================================================*\
*
* S T k l o s V i r t u a l M a c h i n e
......@@ -1582,6 +1621,7 @@ void STk_get_stack_pointer(void **addr)
#ifndef THREADS_LURC
DEFINE_PRIMITIVE("%make-continuation", make_continuation, subr0, (void))
{
SCM z;
......@@ -1624,10 +1664,12 @@ DEFINE_PRIMITIVE("%make-continuation", make_continuation, subr0, (void))
k->sstart = sstart;
k->send = send;
patch_environment(vm);
k->pc = vm->pc;
k->fp = vm->fp;
k->sp = vm->sp;
k->env = clone_env(vm->env, vm);
k->env = vm->env = clone_env(vm->env, vm);
k->constants = vm->constants;
k->handlers = vm->handlers;
k->jb = vm->top_jmp_buf;
......@@ -1947,9 +1989,11 @@ int STk_init_vm()
ADD_PRIMITIVE(continuationp);
ADD_PRIMITIVE(fresh_continuationp);
#endif /* ! THREADS_LURC */
#ifdef DEBUG_VM
#ifdef STK_DEBUG
ADD_PRIMITIVE(set_vm_debug);
#endif
return TRUE;
}
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment