Commit 4090634b authored by Erick's avatar Erick

.

parent 18c69caf
...@@ -2,7 +2,7 @@ ...@@ -2,7 +2,7 @@
* *
* l i s t . c -- Lists procedures * l i s t . c -- Lists procedures
* *
* Copyright © 1993-2005 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr> * Copyright © 1993-2012 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
* *
* *
* This program is free software; you can redistribute it and/or modify * This program is free software; you can redistribute it and/or modify
...@@ -22,7 +22,7 @@ ...@@ -22,7 +22,7 @@
* *
* Author: Erick Gallesio [eg@kaolin.unice.fr] * Author: Erick Gallesio [eg@kaolin.unice.fr]
* Creation date: ??-Oct-1993 21:37 * Creation date: ??-Oct-1993 21:37
* Last file update: 10-Oct-2005 19:08 (eg) * Last file update: 26-Feb-2012 23:37 (eg)
*/ */
#include "stklos.h" #include "stklos.h"
...@@ -653,11 +653,11 @@ doc> ...@@ -653,11 +653,11 @@ doc>
*/ */
DEFINE_PRIMITIVE("last-pair", last_pair, subr1, (SCM l)) DEFINE_PRIMITIVE("last-pair", last_pair, subr1, (SCM l))
{ {
SCM tmp;
if (!CONSP(l)) error_wrong_type(l); if (!CONSP(l)) error_wrong_type(l);
for (tmp=l; CONSP(CDR(l)); l = CDR(l))
/* Nothing */; while (CONSP(CDR(l)))
l = CDR(l);
return l; return l;
} }
......
/* /*
* v m . c -- The STklos Virtual Machine * v m . c -- The STklos Virtual Machine
* *
* Copyright © 2000-2009 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr> * Copyright © 2000-2012 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
* *
* *
* This program is free software; you can redistribute it and/or modify * This program is free software; you can redistribute it and/or modify
...@@ -21,7 +21,7 @@ ...@@ -21,7 +21,7 @@
* *
* Author: Erick Gallesio [eg@unice.fr] * Author: Erick Gallesio [eg@unice.fr]
* Creation date: 1-Mar-2000 19:51 (eg) * Creation date: 1-Mar-2000 19:51 (eg)
* Last file update: 20-Dec-2009 15:11 (eg) * Last file update: 26-Feb-2012 23:39 (eg)
*/ */
// INLINER values // INLINER values
...@@ -1009,12 +1009,10 @@ CASE(UGLOBAL_REF) { /* Never produced by compiler */ ...@@ -1009,12 +1009,10 @@ CASE(UGLOBAL_REF) { /* Never produced by compiler */
CASE(GLOBAL_REF_PUSH) { CASE(GLOBAL_REF_PUSH) {
SCM ref = NULL; SCM ref = NULL;
short orig_opcode;
SCM orig_operand; SCM orig_operand;
SCM res; SCM res;
LOCK_AND_RESTART; LOCK_AND_RESTART;
orig_opcode = vm->pc[-1];
orig_operand = fetch_const(); orig_operand = fetch_const();
res = STk_lookup(orig_operand, vm->env, &ref, FALSE); res = STk_lookup(orig_operand, vm->env, &ref, FALSE);
...@@ -1187,11 +1185,9 @@ CASE(LOCAL_REF4_PUSH) {push(FRAME_LOCAL(vm->env, 4)); NEXT1;} ...@@ -1187,11 +1185,9 @@ CASE(LOCAL_REF4_PUSH) {push(FRAME_LOCAL(vm->env, 4)); NEXT1;}
CASE(GLOBAL_SET) { CASE(GLOBAL_SET) {
SCM ref = NULL; SCM ref = NULL;
short orig_opcode;
SCM orig_operand; SCM orig_operand;
LOCK_AND_RESTART; LOCK_AND_RESTART;
orig_opcode = vm->pc[-1];
orig_operand = fetch_const(); orig_operand = fetch_const();
STk_lookup(orig_operand, vm->env, &ref, FALSE); STk_lookup(orig_operand, vm->env, &ref, FALSE);
...@@ -2000,13 +1996,13 @@ DEFINE_PRIMITIVE("%make-continuation", make_continuation, subr0, (void)) ...@@ -2000,13 +1996,13 @@ DEFINE_PRIMITIVE("%make-continuation", make_continuation, subr0, (void))
#define CALL_CC_SPACE 1024 /* Add some space for restoration bookeepping */ #define CALL_CC_SPACE 1024 /* Add some space for restoration bookeepping */
static void restore_cont_jump(struct continuation_obj *k, void* addr){ static void restore_cont_jump(struct continuation_obj *k, void* addr){
char buf[1024]; char unused_buf[1024]; /* needed here to arbitrarily use some stack space */
vm_thread_t *vm = STk_get_current_vm(); vm_thread_t *vm = STk_get_current_vm();
int cur_stack_size; int cur_stack_size;
cur_stack_size = vm->start_stack - addr; cur_stack_size = vm->start_stack - addr;
buf[42] = 0x2a; unused_buf[42] = 0x2a;
if (cur_stack_size < 0) cur_stack_size = -cur_stack_size; if (cur_stack_size < 0) cur_stack_size = -cur_stack_size;
if (cur_stack_size <= (k->csize + CALL_CC_SPACE)) { if (cur_stack_size <= (k->csize + CALL_CC_SPACE)) {
......
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