rpms/clisp
3
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions
clisp/clisp-volatile.patch
Jerry James 697bbc50ef Update to latest mercurial snapshot. 
Also:
- Drop upstreamed -32bit patch.
- Add -volatile, -negshift, and -alias patches.
2017-02-24 16:03:34 -07:00

193 lines
9.4 KiB
Diff
Raw Blame History

--- src/control.d.orig 2017-02-24 10:37:24.000000000 -0700
+++ src/control.d 2017-02-24 10:42:57.475011548 -0700
@@ -1591,7 +1591,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);
--- src/eval.d.orig 2017-02-24 10:37:24.000000000 -0700
+++ src/eval.d 2017-02-24 10:42:57.479011514 -0700
@@ -710,10 +710,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)) {
@@ -726,7 +726,7 @@ global maygc void invoke_handlers (objec
if (framecode(FRAME_(0)) == 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);
@@ -2398,7 +2398,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 */ \
@@ -2441,7 +2441,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 */ \
@@ -2460,8 +2460,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;
@@ -2649,7 +2650,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);
@@ -2664,7 +2665,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: */
@@ -2936,7 +2937,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: */
@@ -2991,7 +2992,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: */
{
@@ -5734,7 +5735,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, {
@@ -5763,7 +5765,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: */
--- src/lispbibl.d.orig 2017-02-24 10:41:33.223732185 -0700
+++ src/lispbibl.d 2017-02-24 10:42:57.481011497 -0700
@@ -9103,7 +9103,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
--- src/record.d.orig 2017-02-24 10:37:24.000000000 -0700
+++ src/record.d 2017-02-24 10:42:57.482011489 -0700
@@ -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
--- src/spvw.d.orig 2017-02-24 10:37:24.000000000 -0700
+++ src/spvw.d 2017-02-24 10:42:57.482011489 -0700
@@ -3466,7 +3466,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)));
@@ -3484,8 +3484,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;
--- src/stream.d.orig 2017-02-24 10:37:24.000000000 -0700
+++ src/stream.d 2017-02-24 10:42:57.484011471 -0700
@@ -5839,7 +5839,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;
@@ -8325,7 +8325,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;
@@ -9310,7 +9310,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;
Reference in a new issue View git blame Copy permalink