Re: uninterned symbols and the compiler

[Taiichi Yuasa <yuasa%tutics.tut.junet%utokyo-relay.csnet@RELAY.CS.NET>]

Here is the bug fix for the compiler bug Jeff reported to kcl@cli.com.

***** Caution *****
This bug fix causes a drastic change in the KCL compiler.
It may be difficult for ordinary users to reboot KCL after the change.
If you do not worry about the reported bug, I recommend you NOT to install
this bug fix.
***** end Caution *****

1. Add the following declaration (marked "=>") in file c/print.d.

	int (*write_ch_fun)();

	object siSpretty_print_format;
=>	object siSsharp_exclamation;

	#define	MARK		0400

2. Add the following statements (marked "=>") in the definition of
   the C function init_print in file c/print.d
   
	siSpretty_print_format
	= make_si_ordinary("PRETTY-PRINT-FORMAT");
	enter_mark_origin(&siSpretty_print_format);

=>	siSsharp_exclamation = make_si_ordinary("#!");
=>	enter_mark_origin(&siSsharp_exclamation);

	PRINTstream = Cnil;

3. Add the following statements (marked "=>") in the definition of
   the C function write_object in file c/print.d

	case t_cons:
		if (x->c.c_car == siSsharp_comma) {
			write_str("#.");
			write_object(x->c.c_cdr, level);
			break;
		}
=>		if (x->c.c_car == siSsharp_exclamation) {
=>			write_str("#!");
=>			write_object(x->c.c_cdr, level);
=>			break;
=>		}
		if (PRINTcircle) {

4. Replace the following code in file cmpnew/cmpwt.lsp

	(defun wt-data (expr)
	  ...)

	(defun wt-data-begin ()
	  ...)
	
	(defun wt-data-end ()
	  ...)
	
	(defun wt-data-package-operation (form)
	  ...)

with the following code.

	(defvar *wt-data-data* nil)

	(defun wt-data (expr)
	  (push expr *wt-data-data*)
	  nil)
	
	(defun wt-data-begin ()
	  (setq *wt-data-data* nil))
	
	(defun wt-data-end ()
	  (format *compiler-output-data* "          ~%#")
	  (let ((*print-radix* nil)
	        (*print-base* 10)
	        (*print-circle* t)
	        (*print-pretty* nil)
	        (*print-level* nil)
	        (*print-length* nil)
	        (*print-case* :downcase)
	        (*print-gensym* t)
	        (*print-array* t)
	        (si::*print-package* t)
	        (si::*print-structure* t))
	    (prin1 (reverse *wt-data-data*) *compiler-output-data*))
	  (setq *wt-data-data* nil))
	
	(defun wt-data-package-operation (form)
	  (push (cons 'si::|#!| form) *wt-data-data*)
	  nil)

5. Replace the definition of the C function read_fasl_vector in file
c/read.d with the following definition.

	object
	read_fasl_vector(in)
	object in;
	{
		int dimcount, dim;
		object *vsp;		
	
		object x, l;
		int i;
		bool e;
		object old_READtable;
		int old_READdefault_float_format;
		int old_READbase;
		int old_READsuppress;
		int old_sharp_eq_context_max;
		struct sharp_eq_context_struct
			old_sharp_eq_context[SHARP_EQ_CONTEXT_SIZE];
		int old_backq_level;
	
		old_READtable = READtable;
		old_READdefault_float_format = READdefault_float_format;
		old_READbase = READbase;
		old_READsuppress = READsuppress;
		old_sharp_eq_context_max = sharp_eq_context_max;

		vs_push(old_READtable);
		for (i = 0;  i < sharp_eq_context_max;  i++)
			old_sharp_eq_context[i] = sharp_eq_context[i];
		old_backq_level = backq_level;
	
		setup_standard_READ();
	
		frs_push(FRS_PROTECT, Cnil);
		if (nlj_active) {
			e = TRUE;
			goto L;
		}
	
		while (readc_stream(in) != '#')
			;
		vsp = vs_top;
	
		delimiting_char = code_char(')');
		preserving_whitespace_flag = FALSE;
		detect_eos_flag = FALSE;
		l = read_object(in);
		if (l == OBJNULL)
			FEerror("Cannot read objects in FASL file.", 0);
		vs_push(l);
		if (sharp_eq_context_max > 0)
			l = vs_head = patch_sharp(l);
	
		for (dimcount = 0, x = l;  !endp(x);  dimcount++, x = x->c.c_cdr)
			;
		x = alloc_simple_vector(dimcount, aet_object);
		vs_push(x);
		x->v.v_self
		= (object *)alloc_relblock(dimcount * sizeof(object));
		for (dim = 0; dim < dimcount; dim++, l = l->c.c_cdr)
			x->v.v_self[dim] = l->c.c_car;
	
		e = FALSE;
	
	L:
		frs_pop();
	
		READtable = old_READtable;
		READdefault_float_format = old_READdefault_float_format;
		READbase = old_READbase;
		READsuppress = old_READsuppress;
		sharp_eq_context_max = old_sharp_eq_context_max;
		for (i = 0;  i < sharp_eq_context_max;  i++)
			sharp_eq_context[i] = old_sharp_eq_context[i];
		backq_level = old_backq_level;
		if (e) {
			nlj_active = FALSE;
			unwind(nlj_fr, nlj_tag);
		}
		vs_top = vsp;
		return(x);
	}
	
**** end bug fix ****