clisp/clisp-volatile.patch

200 lines
10 KiB
Diff

diff -up clisp-2.49.93/src/control.d.volatile clisp-2.49.93/src/control.d
--- clisp-2.49.93/src/control.d.volatile 2018-02-26 11:22:55.000000000 -0500
+++ clisp-2.49.93/src/control.d 2018-02-26 11:31:38.737088256 -0500
@@ -1602,7 +1602,7 @@ LISPFUN(maplap,seclass_default,2,0,rest,
LISPSPECFORM(tagbody, 0,0,body)
{ /* (TAGBODY {tag | statement}), CLTL p. 130 */
- var object body = popSTACK();
+ var volatile object body = popSTACK();
{ /* build GENV-frame: */
var gcv_object_t* top_of_frame = STACK; /* pointer to frame */
pushSTACK(aktenv.go_env);
diff -up clisp-2.49.93/src/eval.d.volatile clisp-2.49.93/src/eval.d
--- clisp-2.49.93/src/eval.d.volatile 2018-02-26 11:22:55.000000000 -0500
+++ clisp-2.49.93/src/eval.d 2018-02-26 11:32:25.995960520 -0500
@@ -708,10 +708,10 @@ global void throw_to (object tag) {
global maygc void invoke_handlers (object cond) {
/* Also deactivates the handler being called, and all newer handlers.
the handler-ranges, which are screened off: */
- var stack_range_t* other_ranges = inactive_handlers;
+ var stack_range_t* volatile other_ranges = inactive_handlers;
var stack_range_t new_range;
/* Search for Handler-Frame, that handles a Type with (TYPEP cond type): */
- var gcv_object_t* FRAME = STACK;
+ var gcv_object_t* volatile FRAME = STACK;
while (1) {
/* search in Stack starting at FRAME for a suitable HANDLER-Frame: */
if (!(other_ranges == NULL) && (FRAME == other_ranges->low_limit)) {
@@ -725,7 +725,7 @@ global maygc void invoke_handlers (objec
if (frame_info == HANDLER_frame_info || frame_info == C_HANDLER_frame_info) { /* Handler-Frame? */
/* loop over types of the vectors #(type1 label1 ... typem labelm): */
var uintL m2 = Svector_length(Car(FRAME_(frame_handlers))); /* 2*m */
- var uintL i = 0;
+ var volatile uintL i = 0;
do {
pushSTACK(cond); /* save cond */
pushSTACK(cond);
@@ -2432,7 +2432,7 @@ local maygc void trace_call (object fun,
/* But ':ALLOW-OTHER-KEYS NIL' hides a subsequent ':ALLOW-OTHER-KEYS T' \
(see CLHS 3.4.1.4.1.1). */ \
var bool allow_hidden = false; /* true if seen ':ALLOW-OTHER-KEYS NIL' */ \
- var uintC check_count=argcount; \
+ var volatile uintC check_count=argcount; \
while (check_count--) { \
var object kw = NEXT(argptr); /* next Argument */ \
var object val = NEXT(argptr); /* and value for it */ \
@@ -2475,7 +2475,7 @@ local maygc void trace_call (object fun,
> found_statement: what is to be done, if value found */
#define find_keyword_value(notfound_statement,found_statement) \
{ var gcv_object_t* argptr = rest_args_pointer; \
- var uintC find_count; \
+ var volatile uintC find_count; \
dotimesC(find_count,argcount, { \
if (eq(NEXT(argptr),keyword)) goto kw_found; /* right keyword? */ \
argptr skipSTACKop -1; /* NEXT */ \
@@ -2494,8 +2494,9 @@ local maygc void trace_call (object fun,
< mv_count/mv_space: values
< STACK: cleaned up, = args_pointer
can trigger GC */
-local maygc Values funcall_iclosure (object closure, gcv_object_t* args_pointer,
- uintC argcount)
+local maygc Values funcall_iclosure (volatile object closure,
+ gcv_object_t* args_pointer,
+ volatile uintC argcount)
{
/* 1st step: finish building of APPLY-frame: */
var sp_jmp_buf my_jmp_buf;
@@ -2683,7 +2684,7 @@ local maygc Values funcall_iclosure (obj
pushSTACK(NIL); /* start of list */
if (argcount>0) {
var gcv_object_t* ptr = args_pointer STACKop -(uintP)argcount;
- var uintC count;
+ var volatile uintC count;
dotimespC(count,argcount, {
var object new_cons = allocate_cons();
Car(new_cons) = BEFORE(ptr);
@@ -2698,7 +2699,7 @@ local maygc Values funcall_iclosure (obj
/* process &KEY-parameters: */
if (!numberp(TheIclosure(closure)->clos_keywords)) {
/* Keyword-parameters present */
- var gcv_object_t* rest_args_pointer = args_pointer;
+ var gcv_object_t* volatile rest_args_pointer = args_pointer;
/* argcount = number of remaining arguments */
/* halve argcount --> number of pairs Key.Value: */
if (argcount%2) { /* number was odd -> not paired: */
@@ -2970,7 +2971,7 @@ local Values eval_ffunction (object fun)
> form: form
< mv_count/mv_space: values
can trigger GC */
-modexp maygc Values eval (object form)
+modexp maygc Values eval (volatile object form)
{
start:
/* Test for Keyboard-Interrupt: */
@@ -3025,7 +3026,7 @@ modexp maygc Values eval (object form)
> form: Form
< mv_count/mv_space: values
can trigger GC */
-global maygc Values eval_no_hooks (object form) {
+global maygc Values eval_no_hooks (volatile object form) {
var sp_jmp_buf my_jmp_buf;
/* build EVAL-Frame: */
{
@@ -5769,7 +5770,8 @@ local maygc Values funcall_closure (obje
#define GOTO_ERROR(label) goto label
#define DEBUG_CHECK_BYTEPTR(b) do{}while(0)
#endif
-local /*maygc*/ Values interpret_bytecode_ (object closure_in, Sbvector codeptr,
+local /*maygc*/ Values interpret_bytecode_ (volatile object closure_in,
+ volatile Sbvector codeptr,
const uintB* byteptr_in)
{
GCTRIGGER_IF(true, {
@@ -5798,7 +5800,7 @@ local /*maygc*/ Values interpret_bytecod
#endif
TRACE_CALL(closure,'B','C');
/* situate closure in STACK, below the arguments: */
- var gcv_object_t* closureptr = (pushSTACK(closure), &STACK_0);
+ var gcv_object_t* volatile closureptr = (pushSTACK(closure), &STACK_0);
#ifndef FAST_SP
/* If there is no fast SP-Access, one has to introduce
an extra pointer: */
diff -up clisp-2.49.93/src/lispbibl.d.volatile clisp-2.49.93/src/lispbibl.d
--- clisp-2.49.93/src/lispbibl.d.volatile 2018-02-26 11:22:55.000000000 -0500
+++ clisp-2.49.93/src/lispbibl.d 2018-02-26 11:31:38.742088137 -0500
@@ -11836,7 +11836,7 @@ All other long words on the LISP-Stack a
#define FAST_SP
#endif
#elif defined(GNU) && defined(SP_register)
- register __volatile__ aint __SP __asm__(SP_register);
+ register aint __SP __asm__(SP_register);
#ifdef SPARC64
#define SP() (__SP+2048)
#else
diff -up clisp-2.49.93/src/record.d.volatile clisp-2.49.93/src/record.d
--- clisp-2.49.93/src/record.d.volatile 2018-02-26 11:22:56.000000000 -0500
+++ clisp-2.49.93/src/record.d 2018-02-26 11:31:38.743088113 -0500
@@ -1406,7 +1406,7 @@ LISPFUNNR(punbound,0) { /* not Foldable
> obj: the same CLOS instance, not a forward pointer
< result: the same CLOS instance, not a forward pointer
can trigger GC */
-global maygc object update_instance (object user_obj, object obj) {
+global maygc object update_instance (object user_obj, volatile object obj) {
/* Note about the handling of multiple consecutive class redefinitions:
When there are multiple class redefinitions before an instance gets to
be updated, we call UPDATE-INSTANCE-FOR-REDEFINED-CLASS once for each
diff -up clisp-2.49.93/src/spvw.d.volatile clisp-2.49.93/src/spvw.d
--- clisp-2.49.93/src/spvw.d.volatile 2018-02-26 11:22:55.000000000 -0500
+++ clisp-2.49.93/src/spvw.d 2018-02-26 11:31:38.743088113 -0500
@@ -3888,7 +3888,7 @@ local inline void main_actions (struct a
var gcv_object_t* top_of_frame = STACK; /* pointer over frame */
var sp_jmp_buf returner; /* return point */
var const char* const* fileptr = &p->argv_init_files[0];
- var uintL count = p->argv_init_filecount;
+ var volatile uintL count = p->argv_init_filecount;
finish_entry_frame(DRIVER,returner,,goto done_driver_init_files;);
do {
pushSTACK(asciz_to_string(*fileptr++,O(misc_encoding)));
@@ -3906,8 +3906,8 @@ local inline void main_actions (struct a
if (p->argv_compile_filecount > 0) {
var gcv_object_t* top_of_frame = STACK; /* pointer over frame */
var sp_jmp_buf returner; /* return point */
- var const argv_compile_file_t* fileptr = &p->argv_compile_files[0];
- var uintL count = p->argv_compile_filecount;
+ var const argv_compile_file_t* volatile fileptr = &p->argv_compile_files[0];
+ var volatile uintL count = p->argv_compile_filecount;
finish_entry_frame(DRIVER,returner,,goto done_driver_compile_files;);
do {
var uintC argcount = 1;
diff -up clisp-2.49.93/src/stream.d.volatile clisp-2.49.93/src/stream.d
--- clisp-2.49.93/src/stream.d.volatile 2018-02-26 11:22:56.000000000 -0500
+++ clisp-2.49.93/src/stream.d 2018-02-26 11:31:38.746088041 -0500
@@ -5875,7 +5875,7 @@ local maygc void clear_output_unbuffered
close_ochannel(stream, abort);
> stream : Channel-Stream
> abort: flag: non-0 => ignore errors */
-local maygc void close_ochannel (object stream, uintB abort) {
+local maygc void close_ochannel (volatile object stream, uintB abort) {
pushSTACK(stream);
MAYBE_IGNORE_ERRORS(abort,oconv_unshift_output_unbuffered(stream));
stream = STACK_0;
@@ -8358,7 +8358,7 @@ local void closed_buffered (object strea
> stream : File-Stream.
> abort: flag: non-0 => ignore errors
changed in stream: all Components except name and truename */
-local maygc void close_buffered (object stream, uintB abort) {
+local maygc void close_buffered (volatile object stream, uintB abort) {
/* Handle=NIL (Stream already closed) -> finished: */
if (nullp(BufferedStream_channel(stream)))
return;
@@ -9326,7 +9326,7 @@ local maygc char** lisp_completion (char
}
sstring_un_realloc(m);
var uintL charcount = Sstring_length(m);
- var const chart* ptr1;
+ var const chart* volatile ptr1;
unpack_sstring_alloca(m,charcount,0, ptr1=);
{ /* (CATCH 'SYS::CONVERSION-FAILURE ...) */
var gcv_object_t* top_of_frame = STACK;