2008-03-21 Basile Starynkevitch <basile@starynkevitch.net>

	* gcc/basilys.c: (basilysgc_read_file) added second argument locnam.
	(do_initial_command) uses basilys_secondargument_string.  !!!!! A
	BUG REMAINS AND CRASHES our cc1 for test0 !!!!!!!
	* gcc/basilys.h: (basilysgc_read_file) added second argument locnam.
	* gcc/melt/test0.bysl: added file.
	* gcc/melt/test1.bysl: added file.
	* gcc/melt/warm-basilys.bysl: replaced some call to or .. with if (not
	..) to avoid some warnings from cold-basilys.lisp
	nctx_symbcachemap filled even in create_normcontext to handle MELT
	variables at toplevel. compileseq_command takes an optional second
	string.
	* gcc/common.opt: added fbasilys-secondarg for
	basilys_secondargument_string.
	* gcc/melt-cc-script.proto: corrected dynstuff computation. added echo
	messages and set -x.
	* gcc/Makefile.in: added coldtest-warm-basilys HORRIBLE KLUDGE 
	which still crashes because of a basilys.c? bug



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/melt-branch@133433 138bc75d-0d04-0410-961f-82ee72b054a4

11 files changed, 322 insertions, 137 deletions

diff --git a/gcc/ChangeLog b/gcc/ChangeLog
index 9134b4bc93a..8f64a48311a 100644
--- a/gcc/ChangeLog
+++ b/gcc/ChangeLog
@@ -1,16 +1,7 @@
-<<<<<<< .mine
-<<<<<<< .mine
-<<<<<<< .mine
-<<<<<<< .mine
-<<<<<<< .mine
+
 2008-03-02  Basile Starynkevitch <basile@starynkevitch.net>
 	merged with trunk 132817
 
-=======
-=======
-=======
-=======
-=======
 2008-03-20	Kai Tietz  <kai.tietz@onevision.com>
 
 	* c-format.c (replace_format_name_to_system_name): New.
diff --git a/gcc/ChangeLog.melt b/gcc/ChangeLog.melt
index 08b0ff4734d..8b23ef66b85 100644
--- a/gcc/ChangeLog.melt
+++ b/gcc/ChangeLog.melt
@@ -1,5 +1,24 @@
 
-2008-03-20   Basile Starynkevitch  <basile@starynkevitch.net>
+2008-03-21  Basile Starynkevitch  <basile@starynkevitch.net>
+	* basilys.c: (basilysgc_read_file) added second argument locnam.
+	(do_initial_command) uses basilys_secondargument_string.  !!!!! A
+	BUG REMAINS AND CRASHES our cc1 for test0 !!!!!!!
+	* basilys.h: (basilysgc_read_file) added second argument locnam.
+	* melt/test0.bysl: added file.
+	* melt/test1.bysl: added file.
+	* melt/warm-basilys.bysl: replaced some call to or .. with if (not
+	..) to avoid some warnings from cold-basilys.lisp
+	nctx_symbcachemap filled even in create_normcontext to handle MELT
+	variables at toplevel. compileseq_command takes an optional second
+	string.
+	* common.opt: added fbasilys-secondarg for
+	basilys_secondargument_string.
+	* melt-cc-script.proto: corrected dynstuff computation. added echo
+	messages and set -x.
+	* Makefile.in: added coldtest-warm-basilys HORRIBLE KLUDGE 
+	which still crashes because of a basilys.c? bug
+
+2008-03-20  Basile Starynkevitch  <basile@starynkevitch.net>
 	* Makefile.in: added @DEFS@ to MELT_CFLAGS. Better run-basilys.d
 	target (still specific to some systems like linux; depcomp should
 	be used...). Added ugly temporary kludge to build
@@ -8,7 +27,7 @@
 	* melt-cc-script.proto: corrected typos.
 	* run-basilys.h: working at last.
 
-2008-03-20   Basile Starynkevitch  <basile@starynkevitch.net>
+2008-03-20  Basile Starynkevitch  <basile@starynkevitch.net>
 	MELT branch merged with trunk r133366.
 	* basilys.c: pass_basilys is now a gimple_opt_pass.
 	* tree-pass.h: pass_basilys is now a gimple_opt_pass.
diff --git a/gcc/Makefile.in b/gcc/Makefile.in
index f37d9bfb477..16eb4d686d4 100644
--- a/gcc/Makefile.in
+++ b/gcc/Makefile.in
@@ -4603,13 +4603,14 @@ melt.encap: run-basilys.d
 ## !!! TEMPORARY KLUDGE !!!
 # this is a ugly temporary hack, working probably only on Linux machines (hosts) with CLISP
 	$(MAKE) coldbuilt-warm-basilys.so
+	$(MAKE) coldtest-warm-basilys
 
 ## !!! TEMPORARY KLUDGE !!!  WARNING: the warm-basilys.c file should
 ## really be generated by bootstrapping in the following sense:
 ## warm-basilys.c is made from melt/warm-basilys.bysl by "itself",
 ## more precisely by the dynamically loadable stuff (like
 ## warm-basilys.so on Linux) with a basilys/MELT enabled cc1 compiler.
-## However in march 2008 this self-generation was buggy, so we still
+## However in march 2008 this self-generation is buggy, so we still
 ## use the contrib/cold-basilys.lisp code to (temporarily) generated
 ## warm-basilys.c from melt/warm-basilys.bysl. When this shall be
 ## debugged, we'll drop the use of our clisp cold-basilys.lisp code
@@ -4621,10 +4622,32 @@ coldbuilt-warm-basilys.c: $(srcdir)/../contrib/cold-basilys.lisp $(srcdir) melt/
 	         -x "(handle-source-file \"$(srcdir)/melt/warm-basilys.bysl\" \"tmp-$@\")"
 	$(SHELL) $(srcdir)/../move-if-change tmp-$@ $@
 
-.PHONY: install-melt-headers
+.PHONY: install-melt-headers coldtest-warm-basilys
 
 install-melt-headers: melt.encap $(INSTALL_MELT_HEADERS_DIR) install-melt-cc-script
 
+coldtest-warm-basilys: coldbuilt-warm-basilys.so cc1$(exeext) built-melt-cc-script 
+## warmcompile test0.bysl
+	-@echo coldtest-warm-basilys starting test0
+	./cc1$(exeext) -fbasilys -fbasilys-debug \
+	   -fbasilys-init=coldbuilt-warm-basilys.so \
+	 -fbasilys-dynlibdir=. \
+	 -fbasilys-compile-script=built-melt-cc-script \
+  	 -fbasilys-gensrcdir=. \
+	 -fbasilys-tempdir=. \
+	 -fbasilys-command=compileseq -fbasilys-arg=$(srcdir)/melt/test0.bysl -frandom-seed=AbCdEfGhIj
+	-@echo done test0
+	./built-melt-cc-script test0.c test0.so
+## warmcompile test1.bysl
+	-@echo coldtest-warm-basilys starting test1
+	./cc1$(exeext) -fbasilys -fbasilys-debug \
+	   -fbasilys-init=coldbuilt-warm-basilys.so \
+	 -fbasilys-dynlibdir=. \
+	 -fbasilys-compile-script=built-melt-cc-script \
+  	 -fbasilys-gensrcdir=. \
+	 -fbasilys-tempdir=. \
+	 -fbasilys-command=compileseq -fbasilys-arg=$(srcdir)/melt/test1.bysl -frandom-seed=AbCdEfGhIj
+	./built-melt-cc-script test1.c test1.so
 
 ## one of the intall-melt-headers-{tar,cpio,cp} targets below is
 ## triggered by install-melt-headers target above
diff --git a/gcc/basilys.c b/gcc/basilys.c
index b509d893bf8..08e4c894d90 100644
--- a/gcc/basilys.c
+++ b/gcc/basilys.c
@@ -5037,44 +5037,32 @@ end:
 
 
 basilys_ptr_t
-basilysgc_read_file (const char *filnam)
+basilysgc_read_file (const char *filnam, const char*locnam)
 {
   struct reading_st rds;
   FILE *fil = 0;
-  char *filpath = 0, *filnamdup = 0;
-  int filnamlen = 0;
-  char tinybuf[140];
   struct reading_st *rd = 0;
   BASILYS_ENTERFRAME (4, NULL);
 #define genv      curfram__.varptr[0]
 #define valv      curfram__.varptr[1]
-#define filnamv   curfram__.varptr[2]
+#define locnamv   curfram__.varptr[2]
 #define seqv      curfram__.varptr[3]
   memset (&rds, 0, sizeof (rds));
-  memset (tinybuf, 0, sizeof (tinybuf));
   if (!filnam)
     goto end;
-  debugeprintf ("basilysgc_read_file filnam %s", filnam);
-  filnamlen = strlen (filnam);
-  if (filnamlen < (int) sizeof (tinybuf) - 1)
-    filnamdup = strcpy (tinybuf, filnam);
-  else
-    filnamdup = strcpy (xcalloc (filnamlen + 1, 1), filnam);
-  fil = fopen (filnamdup, "rt");
-  if (!fil)
-    {
-      filpath = update_path (filnamdup, "GCC");
-      fil = fopen (filpath, "rt");
-    }
+  if (!locnam || !locnam[0])
+    locnam = basename(filnam);
+  debugeprintf ("basilysgc_read_file filnam %s locnam %s", filnam, locnam);
+  fil = fopen (filnam, "rt");
   if (!fil)
-    fatal_error ("cannot open basilys file %s - %m", filnamdup);
+    fatal_error ("cannot open basilys file %s - %m", filnam);
   /*  debugeprintf ("starting loading file %s", filnamdup); */
   rds.rfil = fil;
-  rds.rpath = filnamdup;
+  rds.rpath = filnam;
   rds.rlineno = 0;
   rd = &rds;
-  filnamv = basilysgc_new_string (BASILYSGOB (DISCR_STRING), filnamdup);
-  rds.rpfilnam = (basilys_ptr_t *) & filnamv;
+  locnamv = basilysgc_new_stringdup (BASILYSGOB (DISCR_STRING), locnam);
+  rds.rpfilnam = (basilys_ptr_t *) & locnamv;
   rds.rpgenv = (basilys_ptr_t *) & genv;
   seqv = basilysgc_new_list (BASILYSGOB (DISCR_LIST));
   while (!rdeof ())
@@ -5091,14 +5079,10 @@ basilysgc_read_file (const char *filnam)
   rd = 0;
 end:
   BASILYS_EXITFRAME ();
-  if (filpath)
-    free (filpath);
-  if (filnamdup && filnamdup != tinybuf)
-    free (filnamdup);
   return seqv;
 #undef vecshv
 #undef genv
-#undef filnamv
+#undef locnamv
 #undef seqv
 }
 
@@ -5110,6 +5094,7 @@ do_initial_command (void)
 #define dictv     curfram__.varptr[0]
 #define closv     curfram__.varptr[1]
 #define cstrv     curfram__.varptr[2]
+#define csecstrv  curfram__.varptr[3]
   debugeprintf ("do_initial_command command_string %s",
 		basilys_command_string);
   if (basilys_magic_discr
@@ -5129,13 +5114,22 @@ do_initial_command (void)
     goto end;
   debugeprintf ("do_initial_command argument_string %s",
 		basilys_argument_string);
+  debugeprintf ("do_initial_command secondargument_string %s",
+		basilys_secondargument_string);
   {
-    union basilysparam_un pararg[1];
+    union basilysparam_un pararg[2];
     memset (pararg, 0, sizeof (pararg));
     cstrv =
       basilysgc_new_string (BASILYSGOB (DISCR_STRING),
 			    basilys_argument_string);
     pararg[0].bp_aptr = (basilys_ptr_t *) & cstrv;
+    if (basilys_secondargument_string && basilys_secondargument_string[0])
+      {
+	csecstrv = 
+	  basilysgc_new_string (BASILYSGOB (DISCR_STRING),
+				basilys_secondargument_string);
+	pararg[1].bp_aptr = (basilys_ptr_t *) & csecstrv;
+      }
     debugeprintf ("do_initial_command before apply closv %p", closv);
     (void) basilysgc_apply (closv,
 			    BASILYSG
@@ -5143,12 +5137,13 @@ do_initial_command (void)
 			    BPARSTR_PTR, pararg, "", NULL);
     debugeprintf ("do_initial_command after apply closv %p", closv);
   }
-end:;
+ end:;
   debugeprintf ("do_initial_command end %s", basilys_argument_string);
   BASILYS_EXITFRAME ();
 #undef dictv
 #undef closv
 #undef cstrv
+#undef csecstrv
 }
 
 
@@ -5772,6 +5767,7 @@ basilys_output_cfile_decl_impl (basilys_ptr_t unitnam,
   fflush (cfil);
   fprintf (cfil, "\n/**** end of %s ****/\n", basilys_string_str (unitnam));
   fclose (cfil);
+  debugeprintf("output_cfile done dotcnam %s", dotcnam);
   free (dotcnam);
   free (dotcpercentnam);
 }
diff --git a/gcc/basilys.h b/gcc/basilys.h
index 86fc6994730..39feaee8dc5 100644
--- a/gcc/basilys.h
+++ b/gcc/basilys.h
@@ -1636,8 +1636,8 @@ basilys_ptr_t basilysgc_intern_symbol (basilys_ptr_t symb);
    is new, return it otherwise return the older homonymous symnol */
 basilys_ptr_t basilysgc_intern_keyword (basilys_ptr_t symb);
 
-/* read a list of sexpressions from a file */
-basilys_ptr_t basilysgc_read_file (const char *filnam);
+/* read a list of sexpressions from a file; if the second argument is non-empty and non-null, it is used for locations; otherwise the basename of the filnam is used */
+basilys_ptr_t basilysgc_read_file (const char *filnam, const char* locnam);
 
 /* Use basilys_assert(MESSAGE,EXPR) to test invariants.  The MESSAGE
    should be a constant string displayed when asserted EXPR is
diff --git a/gcc/common.opt b/gcc/common.opt
index 7e6d3b5c245..ab83804eb0c 100644
--- a/gcc/common.opt
+++ b/gcc/common.opt
@@ -364,21 +364,26 @@ fbasilys-dynlibdir=
 Common Report Var(basilys_dynlibdir_string) RejectNegative Joined  Condition(HAVE_PARMAPOLY && HAVE_LIBTOOLDYNL)
 Dynlib plugin directory for basilys
 
+; generated source directory for basilys
+fbasilys-gensrcdir=
+Common Report Var(basilys_gensrcdir_string) RejectNegative Joined  Condition(HAVE_PARMAPOLY && HAVE_LIBTOOLDYNL)
+Generated source directory for basilys
+
 ; initial C file for above analysis
 fbasilys-init=
 Common Report Var(basilys_init_string) RejectNegative Joined  Condition(HAVE_PARMAPOLY && HAVE_LIBTOOLDYNL)
 Initial file for -fbasilys analysis (dynamic C mode)
 
+; second argument string for basilys
+fbasilys-secondarg=
+Common Report Var(basilys_secondargument_string) RejectNegative Joined  Condition(HAVE_PARMAPOLY && HAVE_LIBTOOLDYNL)
+Second argument for basilys analysis 
+
 ; temporary directory for basilys
 fbasilys-tempdir=
 Common Report Var(basilys_tempdir_string) RejectNegative Joined  Condition(HAVE_PARMAPOLY && HAVE_LIBTOOLDYNL)
 Temporary directory for basilys (is not cleaned if specified)
 
-; generated source directory for basilys
-fbasilys-gensrcdir=
-Common Report Var(basilys_gensrcdir_string) RejectNegative Joined  Condition(HAVE_PARMAPOLY && HAVE_LIBTOOLDYNL)
-Generated source directory for basilys
-
 
 ;;;;;;;;;; end of basilys/MELT stuff
 
diff --git a/gcc/melt-cc-script.proto b/gcc/melt-cc-script.proto
index f1eec90ef9d..9d6d7cc9771 100644
--- a/gcc/melt-cc-script.proto
+++ b/gcc/melt-cc-script.proto
@@ -21,18 +21,33 @@
 # <http://www.gnu.org/licenses/>. 
 
 #:! :MELT_CC: & :MELT_CFLAGS: &:MELT_HEADERDIR:  are substituted in the first 30 lines
-set -x
 
 melt_cc=":MELT_CC:"
 melt_cflags=":MELT_CFLAGS:"
 melt_headerdir=":MELT_HEADERDIR:"
 
+set -x
 ## script invoked by cc1 with two arguments : the generated C source to compile
 ## and the naked (without suffix) dynamically-loadable stuff to generate
 
 csource=$1
-nakedynstuff=`basename $2`
+dynstuff=$2
+
+case $dynstuff in
+    *.so) nakedynstuff=`basename $dynstuff .so`;;
+    *.sl) nakedynstuff=`basename $dynstuff .sl`;;
+    *.la) nakedynstuff=`basename $dynstuff .la`;;
+    *.lo) nakedynstuff=`basename $dynstuff .lo`;;
+    *.shlib) nakedynstuff=`basename $dynstuff .shlib`;;
+    *.dylib) nakedynstuff=`basename $dynstuff .dylib`;;
+    *) nakedynstuff=`echo $dynstuff | sed 's/\.[a-z]*$//'`;;
+esac
+
 datf=`tempfile  -p bdat`
+
+pwd
+echo melt_cc= $melt_cc melt_cflags= $melt_cflags melt_headerdir= $melt_headerdir  csource= $csource nakedynstuff= $nakedynstuff datf= $datf
+
 if [ -z "$datf" ]; then
     datf=/tmp/bdat$$
 fi
diff --git a/gcc/melt/README-MELT b/gcc/melt/README-MELT
index c1cc59e6b3c..25644a7b87b 100644
--- a/gcc/melt/README-MELT
+++ b/gcc/melt/README-MELT
@@ -5,74 +5,14 @@ and my GCC summit 2007 paper
 Multi-stage construction of a global static analyser by Basile Starynkevitch, pages 143 - 152
 
 This directory contains melt files. MELT is a dialect of Lisp compiled
-into C code which should be compilable (by some strange basilys-gcc
-script invoking any GCC [or perhaps even another compiler?] with the
-appropriate -fPIC and -I options
+into C code which should be compilable (by the strange melt-cc-script
+invoking any GCC [or perhaps even another compiler?] with the
+appropriate -fPIC and -I options (and using some melt-private-headers
+directory containing the required *.h files from GCC source tree
+needed to compile the MELT generated C code).
 
-The MELT source files are called .bysl (sorry for the messy suffix)
+The MELT source files -a lisp like code- are *.bysl (sorry for the messy suffix).
 
-This basilys-gcc (which really should be named melt-gcc) should be something similar to
-########################## CUT HERE FILE basilys-gcc to be installed in your $PATH
-#! /bin/bash
-if [ ! -e $1 ]; then
-    echo $0: no input file $1 1>&2
-    exit 1
-fi
-cc="ccache gcc"
-if [ ! -z "$3" ]; then
-    cc=$3
-fi
-srcin=$1
-echo BasilysGcc $srcin 1>&2
-##***## CHANGE BELOW LINE APPROPRIATELY ACCORDING TO YOUR GCC BUILD DIRECTORY
-. /usr/src/Lang/basile-ggcc/_Obj/gcc/compile-basilys-defs
-# indent $srcin
-outn=$2
-if [ -z "$outn" ]; then
-    outn=$(basename $srcin .c).so
-fi
-rm $outn
-objn=$(basename $srcin .c).pic.o
-barn=$(basename $srcin .c)
-datf=$(tempfile -s .c -p bdat)
-md5src=$(md5sum $srcin)
-date "+const char basilys_compiled_timestamp[]=\"$barn %c\";" > $datf
-echo "const char basilys_md5[]=\"$md5src\";" >> $datf
-## ccache works only with a -c option
-$cc -time  -fPIC  -g3  $ALL_CFLAGS $ALL_CPPFLAGS $srcin -c -o $objn
-gcc -shared -fPIC $objn $datf -o $outn
-head -9 $datf
-rm -f $datf
-echo "Basilysgcc -shared -fPIC -fno-inline -g3 -Wextra -Wall $ALL_CFLAGS $ALL_CPPFLAGS $srcin -o $outn" 
-ls -l $outn* $objn*
-############################## END OF basilys-gcc
-
-However, you have to change the sourcing of /usr/src/Lang/basile-ggcc/_Obj/gcc/compile-basilys-defs
-into the sourcing of $YOURBUILDGCCDIR/gcc/compile-basilys-defs
-
-You might also compile *.bysl file with the contrib/cold-basilys.lisp
-using CLISP with a script coldbasilys similar to
-
-############################## CUT HERE file coldbasilys to be installed in your $PATH
-#! /usr/bin/clisp -C
-;; !#
-
-;; -*- lisp -*-
-
-(proclaim '(optimize (debug 0) (safety 1) (speed 3)))
-
-(let 
-( (argv 
-   EXT:*ARGS*
-   ))	
-     (format *error-output* "coldbasilys start ~s ~%" argv))
-
-
-(load "cold-basilys.lisp")
-
-(time (mapc (function handle-source-file) EXT:*ARGS*))
-
-#################################### end of coldbasilys
 
 I am sorry for all this temporary mess. As soon as warm-basilys.bysl
 is debugged, it should bootstrap itself in the following sense:
@@ -90,6 +30,5 @@ is debugged, it should bootstrap itself in the following sense:
 
 for debugging I usually add the  -fbasilys-debug -fdump-ipa-basilys flags which should not be needed
 
-You should also be able to generate this wam-basilys.c file with coldbasilys warm-basilys.bysl
 
 #### comments and questions to <basile@starynkevitch.net> 
diff --git a/gcc/melt/test0.bysl b/gcc/melt/test0.bysl
new file mode 100644
index 00000000000..8c252b88e29
--- /dev/null
+++ b/gcc/melt/test0.bysl
@@ -0,0 +1,27 @@
+;; -*- lisp -*-
+(defprimitive gti (:long a b) :long 
+  "((" a ")>(" b "))")
+(defprimitive boxint (:long i) :value 
+  "basilysgc_new_int( BASILYSGOB(DISCR_INTEGER), (" i "))"
+)
+(defprimitive puts (:cstring s) :void "puts(" s ")")
+
+(defun foo (x :long n) 
+  (if
+      (gti n 0) 
+      x 
+    (boxint n)))
+
+(defun bar (y)
+  (if y
+      (foo y 12)
+    (boxint 1234)))
+
+(defun testforever (z)
+  (forever loop
+	   (exit loop (bar z))))
+ 
+
+foo
+
+(puts "end test0")
\ No newline at end of file
diff --git a/gcc/melt/test1.bysl b/gcc/melt/test1.bysl
new file mode 100644
index 00000000000..b6e5ceb32e7
--- /dev/null
+++ b/gcc/melt/test1.bysl
@@ -0,0 +1,163 @@
+;; -*- lisp -*-
+;; file test1.bysl
+
+(defun tlamb_t2 (f_cl)
+  (lambda (y_arg) 
+    (f_cl y_arg)))
+
+
+(defprimitive tup1_pr2 (di t1) :value "basilysgc_new_mult1((" di "), (" t1 "))")
+
+
+(defprimitive mkint_t2 (:long a) :value "basilysgc_new_int(BASILYSG(DISCR_INTEGER),(" a "))")
+
+(defun l2_t2 (x) 
+  (let ( (y1 
+	  (tup1_pr2 x 
+		    (mkint_t2 3))) 
+	 (y2 
+	  (tup1_pr2 x y1)) )
+    (tup1_pr2 y1 y2)))
+
+
+
+
+(defun coloopeven_t2 (x)
+  (if 
+      (tup1_pr2 x :somekeyword) 
+      (coloopodd_t2 x) 
+    x))
+
+(defun coloopodd_t2 (y)
+  (if 
+      (tup1_pr2 y y) 
+      (coloopeven_t2 y) 
+    'qqq))
+
+(defun tlet_t2 (u v)
+  (let ( (w (tup1_pr2 u u)) )
+    (tup1_pr2 w 
+	      (lambda (x) 
+		(if (tup1_pr2 x w) x)))))
+
+(defun and_t2 (x y z) (and x y z))
+
+(defun ff_t2 (t u) 
+  (tup1_pr2 t 
+	    (tup1_pr2 u u)))
+
+(defun tif_t2 (x y)
+  (if (tup1_pr2 x y)
+      (let ( (z (ff_t2 x x)) ) 
+	(tup1_pr2 y z))
+    y)
+)
+
+(defun ifl2_t2 (x) (if x (l2_t2 x)))
+
+(defun lam_t2 (x) (if (mkint_t2 x) (lambda (y) (l2_t2 (tup1_pr2 x y)))))
+
+
+(defun ll_t2 (y) (lambda (x) (ff_t2 x y)))
+
+
+(mkint_t2 1)
+
+(l2_t2 (mkint_t2 2))
+
+
+(defclass my_class_root 
+ :predef CLASS_ROOT
+ :fields (root_f1 root_f2))
+
+(defclass my_class_sub
+  :super my_class_root
+  :fields (sub_f3))
+
+(definstance mysub_instance my_class_sub
+  :root_f1 and_t2
+  :sub_f3 (mkint_t2 3)
+  )
+
+(defun multiret_t2 (x) 
+  (return x my_class_root my_class_sub))
+
+(defun mi_t2 (v)
+  (make_instance my_class_root :root_f1 v))
+
+(defun l2mi_t2 (v) 
+  (l2_t2 (make_instance my_class_root :root_f1 v :root_f2 'quotedf2)))
+
+
+
+(defun mi2_t2 (v) (if (tup1_pr2 v my_class_root) 
+		      (make_instance my_class_root :root_f1 v)))
+
+(definstance ii my_class_root :root_f1 (mkint_t2 1001))
+
+(defun fii_t2 (v) (if (tup1_pr2 v ii) v))
+
+(let ((kk (mkint_t2 5))) (if (tup1_pr2 kk my_class_root) (mkint_t2 0)))
+
+
+(defun hello_t2 (f) (f "hello"))
+
+(defun n1234_t2 (f) (f 1234))
+
+(defun xhello_t2 (f x) (f x x "hellox"))
+
+(defun xn12345_t2 (f x) (f x x 12345))
+
+
+(defun tl_t2 (v) (let ((x3 (mkint_t2 3))) (tup1_pr2 v x3)))
+
+
+
+
+(defun ts_t2 (v) (mkint_t2 1) (mkint_t2 2))
+
+(defun mm_t2 (p) 
+  (let ( (w (gg_t2 (gg_t2 p))) ) 
+    (if w (tup1_pr2 w p) p)))
+
+(defun kk_t2 (u)
+  (forever
+   lo 
+   (mkint_t2 u)
+   (exit lo u)
+   )
+  (tup1_pr2 u u)
+  )
+
+(defun mc_t2 (z) (multicall (rv :long ri) 
+			    (ff_t2 z (tl_t2 z)) 
+			    (tup1_pr2 rv (mkint_t2 ri))))
+
+
+
+(defun gg_t2 (z) (setq z (if z gg_t2)) (ff_t2 z z))
+
+
+(definstance t2inst my_class_root 
+  :root_f1 gg_t2)
+
+(definstance t2i1 my_class_root 
+  :root_f1 (mkint_t2 1))
+(definstance t2i2 my_class_root 
+  :root_f1 (mkint_t2 1))
+(definstance t2i3 my_class_root 
+  :root_f1 (mkint_t2 3))
+
+(defun ti_tk3 (x) (if (tup1_pr2 x t2i1) (if (tup1_pr2 x t2i2) (if (tup1_pr2 x t2i3) x))))
+
+(defun ti_clo2 (x y z) (lambda (u) (lambda (v) (lambda (w) (w x y z)))))
+
+(defun ti_t2 (z) (tup1_pr2 t2inst z))
+
+(defun tj_t2 (u) (tup1_pr2 u my_class_root))
+
+
+#| ; SKIPPING
+; SKIPPED |#
+
+;; eof
diff --git a/gcc/melt/warm-basilys.bysl b/gcc/melt/warm-basilys.bysl
index b829bd811b9..9d82412820c 100644
--- a/gcc/melt/warm-basilys.bysl
+++ b/gcc/melt/warm-basilys.bysl
@@ -586,7 +586,7 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; READ FILE primitive
 (defprimitive read_file (filnam) :value
-  "(basilysgc_read_file (basilys_string_str((" filnam "))))")
+  "(basilysgc_read_file (basilys_string_str((" filnam ")), (char*)0))")
 
 ;; to signal an error in a basilys source with some additional string value
 (defprimitive error_strv (loc :cstring msg :value strv) :void
@@ -974,8 +974,8 @@
 
 ;; add to a destination list a source list
 (defun list_append2list (dlist slist)
-  (or (is_list slist) (return dlist))
-  (or (is_list dlist) (setq dlist (make_list discr_list)))
+  (if (not (is_list slist)) (return dlist))
+  (if (not (is_list dlist)) (setq dlist (make_list discr_list)))
   (list_iterate slist 
 		(lambda (e) (list_append dlist e) slist))
   dlist)
@@ -984,7 +984,7 @@
 (defun pairlist_iterate (pair f)
       (if (is_closure f)
 	  (forever pairloop
-		   (or (is_pair pair) (exit pairloop))
+		   (if (not (is_pair pair)) (exit pairloop))
 		     (let ( (curelem (pair_head pair)) )
 		       (if (null (f curelem)) (exit pairloop curelem)))
 		       (setq pair (pair_tail pair)))))
@@ -1032,7 +1032,7 @@
   (let ( (:long ln 0) )
     (let ( (curpair pair) )
       (forever loopln
-	       (or (is_pair curpair) (exit loopln))
+	       (if (not (is_pair curpair)) (exit loopln))
 	       (setq ln (+i ln 1))
 	       (setq curpair (pair_tail curpair))))
     (let ( (tup (make_multiple disc ln))
@@ -1040,7 +1040,7 @@
 	   (curpair pair)
 	   )
       (forever loopfi
-	       (or (is_pair curpair) (exit loopfi))
+	       (if (not (is_pair curpair)) (exit loopfi))
 	       (let ( (c (pair_head curpair))
 		      (tc (if (is_closure f) (f c) c)) )
 		 (multiple_put_nth tup ix tc)
@@ -2125,7 +2125,7 @@
 	     (curpair (list_first (unsafe_get_field :sexp_contents sexp)))
 	     )
 	(forever nthloop
-		 (or (is_pair curpair) (exit nthloop))
+		 (if (not (is_pair curpair)) (exit nthloop))
 		 (if (==i ix n) (exit nthloop (pair_head curpair)))
 		 (setq ix (+i ix 1))
 		 (setq curpair (pair_tail curpair))
@@ -2390,7 +2390,7 @@
 		 (etuple (make_multiple discr_multiple nbcomp))
 		 (:long ix 0) )
 	    (forever comploop
-		     (or (is_pair curpair) (exit comploop))
+		     (if (not (is_pair curpair)) (exit comploop))
 		     (let ( (curcomp  (macroexpand_1 (pair_head curpair) env mexpander)) )
 		       ;; change string to verbatimstring to ease primitive expansion
 		       ;; and check that each component is e string or a symbol
@@ -2787,7 +2787,7 @@
 	(setq curpair (pair_tail curpair))
 	(forever insloop
 		 (debug_msg "mexpand_definstance insloop curpair" curpair (the_callcount))
-		 (or (is_pair curpair) (exit insloop))
+		 (if (not (is_pair curpair)) (exit insloop))
 		 (let ( (curfkw (pair_head curpair)) )
 		   (debug_msg "mexpand_definstance insloop curfkw" curfkw (the_callcount))
 		   (or (is_a curfkw class_keyword)
@@ -2865,7 +2865,7 @@
       (setq curpair (pair_tail curpair))
       (forever insloop
 	       (debug_msg "mexpand_make_instance insloop curpair" curpair (the_callcount))
-	       (or (is_pair curpair) (exit insloop))
+	       (if (not (is_pair curpair)) (exit insloop))
 	       (let ( (curfkw (pair_head curpair)) )
 		 (or (is_a curfkw class_keyword)
 		     (error_plain loc "expecting keyword in make_instance"))
@@ -2907,7 +2907,7 @@
     (let ( (fldlist (make_list discr_list))
 	   )
       (forever insloop
-	       (or (is_pair curpair) (exit insloop))
+	       (if (not (is_pair curpair)) (exit insloop))
 	       (let ( (curfkw (pair_head curpair)) )
 		 (or (is_a curfkw class_keyword)
 		     (error_plain loc "expecting heyword in unsafe_put_fields"))
@@ -2998,10 +2998,10 @@
 	 (loc  (unsafe_get_field :loca_location sexpr))
 	 (curpair (pair_tail (list_first cont)))
 	 (curif (pair_head curpair)) )
-    (or (is_pair curpair) 
+    (if (not (is_pair curpair))
 	(error_plain loc "missing condition in IF"))
     (setq curpair (pair_tail curpair))
-    (or (is_pair curpair) 
+    (if (not (is_pair curpair))
 	(error_plain loc "missing then in IF"))
     (setq xcond (macroexpand_1 curif env mexpander))
     (let ( (curthen (pair_head curpair)) )
@@ -3745,8 +3745,8 @@
 		   :nctx_predefmap predefmap
 		   :nctx_valmap valmap
 		   :nctx_valbindmap (make_mapobject discr_mapobjects 20)
-; cold-basilys.lisp don't know how to put a null field, so we comment it out
-;;		   :nctx_symbcachemap ()
+		   ;; we need a symbcachemap for the toplevel expressions
+		   :nctx_symbcachemap (make_mapobject discr_mapobjects 30)
 		   )))
 
 ;;; the normal_exp selector 
@@ -3915,6 +3915,13 @@
 	 (return)))
    (let ( (sycmap (unsafe_get_field :nctx_symbcachemap ncx))
 	  (syca (mapobject_get sycmap recv)) )
+     (if (not (is_mapobject sycmap)) 
+	 (progn 
+	   (debug_msg "normexp_symbol badsycmap ncx" ncx (the_callcount))
+	   (debug_msg "normexp_symbol badsycmap sycmap.discrim" (discrim sycmap) (the_callcount))
+	   (debug_msg "normexp_symbol badsycmap sycmap" sycmap (the_callcount))
+	   )
+       )
      (assert_msg "check sycmap" (is_mapobject sycmap))
      (cond 
       ;; check if in the cache
@@ -8555,7 +8562,7 @@
 (defun compilobj_datastring (nds gcx)
   (assert_msg "check nds" (is_a nds class_nrep_datastring))
   (assert_msg "check gcx" (is_a gcx class_genercontext))
-  (debug_msg "compilobj_datastring gcx" gcx (the_callcount))
+  ; (debug_msg "compilobj_datastring gcx" gcx (the_callcount))
   (debug_msg "compilobj_datastring nds" nds (the_callcount))
   (let ( (compicache (unsafe_get_field :gncx_compicache gcx)) 
 	 (inirout (unsafe_get_field :gncx_objrout gcx))
@@ -8857,11 +8864,11 @@
 (install_initial_command  (stringconst2val discr_string "normexpseq") normexpseq_command)
 
 ;;;;;
-(defun compileseq_command (dispatcher arg)
+(defun compileseq_command (dispatcher arg secarg)
   (message_dbg "starting compileseq_command")
   (debug_msg "start compileseq_command" arg (the_callcount))
   (let ( (rlist (read_file arg)) 
-	 (basnam (make_string_nakedbasename discr_string arg))
+	 (basnam (if (is_string secarg) secarg (make_string_nakedbasename discr_string arg)))
 	 ) 
     (debug_msg "after read compileseq_command rlist" rlist (the_callcount))
     (debug_msg "after read compileseq_command initial_environment" initial_environment (the_callcount))