[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

compiler bug?



We are having a strange problem with a piece of code compiled
with safety level 2.
A script is enclosed to illustrate the problem.
It appears that function "foo" in the test program "bug.lsp" 
was not compiled correctly at safety level 2 when variable i
was declared as a fixnum.
In particular, the "fix" macro call in the C code 
"base[2]= aset1(base[0],V1,fix(base[1]));"
for (setf (aref x (decf i)) (aref x 1)) is suspicious.
Function "bar" was included for comparison.

Thanks for your help!

Hong-Tai Chou, MCC

------------------------------------------------------------
Script started on Thu Feb  4 12:32:00 1988
ricci>> cat bug.lsp
(defvar *a* (make-array 5 :initial-element 0))

(defun foo (x)
  (let ((i 3))
    (declare (fixnum i))
    (setf (aref x (decf i)) (aref x 1))))

(defun bar (x)
  (let ((i 3))
    (setf (aref x (decf i)) (aref x 1))))

ricci>> kcl
KCl (Kyoto Common Lisp)  September 16, 1986

>(proclaim '(optimize (safety 2)))
NIL

>(compile-file "bug" :c-file t)
Compiling bug.lsp.
End of Pass 1.  
End of Pass 2.  
OPTIMIZE levels: Safety=2, Space=0, Speed=3
Finished compiling bug.lsp.

>(load "bug")
Loading bug.o
Finished loading bug.o
700

>*a*
#(0 0 0 0 0)

>(bar *a*)
0

>(foo *a*)
#<OBJNULL>

>^DBye.
ricci>> cat bug.c
#include <cmpinclude.h>
#include "bug.h"
init_code(start,size,data)char *start;int size;object data;
{	register object *base=vs_top;register object *sup=base+VM2;vs_top=sup;vs_check;
	Cstart=start;Csize=size;Cdata=data;set_VV(VV,VM1,data);
	VV[3]->s.s_stype=(short)stp_special;
	if(VV[3]->s.s_dbind == OBJNULL){
	base[0]= VV[0];
	base[1]= VV[1];
	base[2]= VV[2];
	VV[3]->s.s_dbind = simple_symlispcall_no_event(VV[6],base+0,3);}
	MF(VV[7],L1,start,size,data);
	MF(VV[8],L2,start,size,data);
	vs_top=vs_base=base;
}
/*	function definition for FOO	*/
static L1()
{	register object *base=vs_base;
	register object *sup=base+VM3;
	vs_reserve(VM3);
	check_arg(1);
	vs_top=sup;
TTL:;
	{int V1;
	V1= 3;
	V1= (V1)-(1);
	base[1]= aref1(base[0],1);
	base[2]= aset1(base[0],V1,fix(base[1]));
	vs_top=(vs_base=base+2)+1;
	return;}
}
/*	function definition for BAR	*/
static L2()
{	register object *base=vs_base;
	register object *sup=base+VM4;
	vs_reserve(VM4);
	check_arg(1);
	vs_top=sup;
TTL:;
	base[1]= VV[4];
	base[1]= number_minus(base[1],VV[5]);
	base[2]= aref1(base[0],1);
	base[3]= aset1(base[0],fixint(base[1]),base[2]);
	vs_top=(vs_base=base+3)+1;
	return;
}
ricci>> exit
ricci>> 
script done on Thu Feb  4 12:35:01 1988