From 250b294aaa47c092b3f0e3e8ac7a846cf063d623 Mon Sep 17 00:00:00 2001
From: jjgarcia <jjgarcia>
Date: Sat, 12 Jul 2008 14:13:05 +0000
Subject: [PATCH 1/5] Added hooks for registering DEF* forms and their
 locations with some database.

---
 src/c/Makefile.in      |  2 +-
 src/c/compiler.d       |  2 +-
 src/c/load.d           |  5 +++--
 src/c/symbols_list.h   |  9 +++------
 src/c/symbols_list2.h  |  9 +++------
 src/clos/defclass.lsp  |  6 ++++--
 src/clos/generic.lsp   | 13 ++++++-------
 src/clos/method.lsp    | 21 ++++++---------------
 src/lsp/autoload.lsp   | 24 ------------------------
 src/lsp/defmacro.lsp   |  2 +-
 src/lsp/defstruct.lsp  |  3 ++-
 src/lsp/evalmacros.lsp | 18 ++++++++++--------
 src/lsp/export.lsp     | 13 ++++++++++++-
 13 files changed, 52 insertions(+), 75 deletions(-)

diff --git a/src/c/Makefile.in b/src/c/Makefile.in
index aedadc281..89f1be1e2 100644
--- a/src/c/Makefile.in
+++ b/src/c/Makefile.in
@@ -72,7 +72,7 @@ ffi_x86_64.c: arch/ffi_x86_64.d $(DPP) $(HFILES)
 	$(RANLIB) $@
 
 clean:
-	$(RM) dpp *.c *.h $(OBJS) ../libecl.a cinit.o core a.out
+	$(RM) $(DPP) *.c *.h $(OBJS) all_symbols.o all_symbols2.o ../libecl.a cinit.o core a.out
 
 # Build rules
 
diff --git a/src/c/compiler.d b/src/c/compiler.d
index 07f3e4da7..7e2cd9f19 100644
--- a/src/c/compiler.d
+++ b/src/c/compiler.d
@@ -155,7 +155,7 @@ asm_end(cl_index beginning) {
 	cl_index code_size, data_size, i;
 	cl_opcode *code;
 	cl_object file = SYM_VAL(@'*load-truename*');
-	cl_object position = SYM_VAL(@'ext::*load-position*');
+	cl_object position = cl_cdr(SYM_VAL(@'ext::*source-location*'));
 
 	/* Save bytecodes from this session in a new vector */
 	code_size = current_pc() - beginning;
diff --git a/src/c/load.d b/src/c/load.d
index d615c832a..59bbe3c16 100644
--- a/src/c/load.d
+++ b/src/c/load.d
@@ -393,7 +393,8 @@ si_load_source(cl_object source, cl_object verbose, cl_object print)
 	}
 	CL_UNWIND_PROTECT_BEGIN {
 		cl_object form_index = MAKE_FIXNUM(0);
-		bds_bind(@'ext::*load-position*', MAKE_FIXNUM(0));
+		cl_object location = CONS(source, form_index);
+		bds_bind(@'ext::*source-location*', location);
 		for (;;) {
 			x = cl_read(3, strm, Cnil, OBJNULL);
 			if (x == OBJNULL)
@@ -404,7 +405,7 @@ si_load_source(cl_object source, cl_object verbose, cl_object print)
 				@terpri(0);
 			}
 			form_index = ecl_plus(MAKE_FIXNUM(1),form_index);
-			ECL_SETQ(@'ext::*load-position*', form_index);
+			ECL_RPLACD(location, form_index);
 		}
 		bds_unwind1();
 	} CL_UNWIND_PROTECT_EXIT {
diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h
index 72f6d9dea..a44e0972e 100644
--- a/src/c/symbols_list.h
+++ b/src/c/symbols_list.h
@@ -1227,11 +1227,9 @@ cl_symbols[] = {
 {SYS_ "*PROFILE-ARRAY*", SI_SPECIAL, NULL, -1, OBJNULL},
 #endif
 
-#ifdef PDE
-{SYS_ "*RECORD-SOURCE-PATHNAME-P*", SI_SPECIAL, NULL, -1, OBJNULL},
-{SYS_ "*SOURCE-PATHNAME*", SI_SPECIAL, NULL, -1, Cnil},
-{SYS_ "RECORD-SOURCE-PATHNAME", SI_ORDINARY, NULL, -1, OBJNULL},
-#endif
+{EXT_ "*SOURCE-LOCATION*", EXT_SPECIAL, NULL, -1, Cnil},
+{EXT_ "*REGISTER-WITH-PDE-HOOK*", EXT_SPECIAL, NULL, -1, Cnil},
+{EXT_ "REGISTER-WITH-PDE", EXT_ORDINARY, NULL, -1, OBJNULL},
 
 #ifdef PROFILE
 {SYS_ "PROFILE", SI_ORDINARY, si_profile, -1, OBJNULL},
@@ -1691,7 +1689,6 @@ cl_symbols[] = {
 
 {"LOG1P", SI_ORDINARY, si_log1p, 1, OBJNULL},
 
-{EXT_ "*LOAD-POSITION*", SI_SPECIAL, NULL, -1, Cnil},
 {EXT_ "BC-FILE", SI_ORDINARY, si_bc_file, 1, Cnil},
 
 {SYS_ "PROPERTY-LIST", SI_ORDINARY, NULL, 1, OBJNULL},
diff --git a/src/c/symbols_list2.h b/src/c/symbols_list2.h
index 6bf64b152..aadf46d3d 100644
--- a/src/c/symbols_list2.h
+++ b/src/c/symbols_list2.h
@@ -1227,11 +1227,9 @@ cl_symbols[] = {
 {SYS_ "*PROFILE-ARRAY*",NULL},
 #endif
 
-#ifdef PDE
-{SYS_ "*RECORD-SOURCE-PATHNAME-P*",NULL},
-{SYS_ "*SOURCE-PATHNAME*",NULL},
-{SYS_ "RECORD-SOURCE-PATHNAME",NULL},
-#endif
+{EXT_ "*SOURCE-LOCATION*",NULL},
+{EXT_ "*REGISTER-WITH-PDE-HOOK*",NULL},
+{EXT_ "REGISTER-WITH-PDE",NULL},
 
 #ifdef PROFILE
 {SYS_ "PROFILE","si_profile"},
@@ -1691,7 +1689,6 @@ cl_symbols[] = {
 
 {"LOG1P","si_log1p"},
 
-{EXT_ "*LOAD-POSITION*",NULL},
 {EXT_ "BC-FILE","si_bc_file"},
 
 {SYS_ "PROPERTY-LIST",NULL},
diff --git a/src/clos/defclass.lsp b/src/clos/defclass.lsp
index bb415232d..04d421611 100644
--- a/src/clos/defclass.lsp
+++ b/src/clos/defclass.lsp
@@ -124,8 +124,10 @@
 		 (list 'quote (rest option)))))
 	(setf options (list* `',option-name option-value options))))
     `(eval-when (compile load eval)
-      (ensure-class ',name :direct-superclasses ',superclasses
-       :direct-slots ,slots ,@options))))
+       ,(ext:register-with-pde form
+			       `(ensure-class ',name :direct-superclasses
+					      ',superclasses
+					      :direct-slots ,slots ,@options)))))
 
 ;;; ----------------------------------------------------------------------
 ;;; ENSURE-CLASS
diff --git a/src/clos/generic.lsp b/src/clos/generic.lsp
index 53a980100..413a9c8e4 100644
--- a/src/clos/generic.lsp
+++ b/src/clos/generic.lsp
@@ -15,7 +15,7 @@
 ;;; DEFGENERIC
 ;;;
 
-(defmacro defgeneric (&rest args)
+(defmacro defgeneric (&whole whole &rest args)
   (multiple-value-bind (function-specifier lambda-list options)
     (parse-defgeneric args)
     (parse-lambda-list lambda-list)
@@ -24,12 +24,11 @@
 	(parse-generic-options options lambda-list)
       (let* ((output `(ensure-generic-function ',function-specifier
 		       :delete-methods t ,@option-list)))
-	(if method-list
-	    `(associate-methods-to-gfun ,output
-	      ,@(mapcar #'(lambda (m) `(defmethod ,function-specifier ,@m))
-			method-list))
-	    output))
-      )))
+	(when method-list
+	  (setf method-list (mapcar #'(lambda (m) `(defmethod ,function-specifier ,@m))
+				    method-list)
+		output `(associate-methods-to-gfun ,output ,@method-list)))
+	(ext:register-with-pde whole output)))))
 
 (defun parse-defgeneric (args)
   (declare (si::c-local))
diff --git a/src/clos/method.lsp b/src/clos/method.lsp
index aca955b84..57d73ad5b 100644
--- a/src/clos/method.lsp
+++ b/src/clos/method.lsp
@@ -31,7 +31,7 @@
 ;;; DEFMETHOD
 ;;;
 
-(defmacro defmethod (&rest args &environment env)
+(defmacro defmethod (&whole whole &rest args &environment env)
   (multiple-value-bind (name qualifiers specialized-lambda-list body)
       (parse-defmethod args)
     (multiple-value-bind (lambda-list required-parameters specializers)
@@ -40,20 +40,11 @@
 	  (expand-defmethod name qualifiers lambda-list
 			    required-parameters specializers body env)
 	(declare (ignore required-parameters))
-	`(PROGN
-	  #+PDE
-	  (EVAL-WHEN (LOAD)
-	    (SI:RECORD-SOURCE-PATHNAME
-	     ',name '(DEFMETHOD ',qualifiers ',specializers)))
-	  (INSTALL-METHOD
-	   ',name
-	   ',qualifiers
-	   ,(list 'si::quasiquote specializers)
-	   ',lambda-list
-	   ',doc
-	   ',plist
-	   ,fn-form)
-	  )))))
+	(ext:register-with-pde whole
+			       `(install-method ',name ',qualifiers
+						,(list 'si::quasiquote specializers)
+						',lambda-list ',doc
+						',plist ,fn-form))))))
 
 
 ;;; ----------------------------------------------------------------------
diff --git a/src/lsp/autoload.lsp b/src/lsp/autoload.lsp
index ef8ea6387..5ac34d765 100644
--- a/src/lsp/autoload.lsp
+++ b/src/lsp/autoload.lsp
@@ -16,30 +16,6 @@
 
 (in-package "SYSTEM")
 
-#+PDE
-(progn
-(setq *record-source-pathname-p* nil)
-(defun record-source-pathname (symbol type)
-  ;; type is either:
-  ;; 1. a symbol, for single entry definitions (defun, defvar, defclass ..)
-  ;; 2. a list (type . spec), for multiple entries (defmethod)
-  (when (and *record-source-pathname-p*
-	     *source-pathname*)
-    (when (sys::setf-namep symbol)
-       (setq symbol (get-sysprop (second symbol) 'setf-symbol)))
-    (if (symbolp type)
-	(put-sysprop symbol *source-pathname* type)
-	(let* ((alist (get-sysprop symbol (car type)))
-	       (spec (cdr type)))
-	  (if alist
-	      (let ((entry (assoc spec alist :test #'equal)))
-		(if entry
-		    (setf (cdr entry) *source-pathname*)
-		    (push (cons spec *source-pathname*) alist)))
-	      (setq alist (list (cons spec *source-pathname*))))
-	  (put-sysprop symbol alist (car type))))))
-)
-
 (defun lisp-implementation-type ()
   "Args: ()
 Returns the string \"ECL\"."
diff --git a/src/lsp/defmacro.lsp b/src/lsp/defmacro.lsp
index f0e886916..9de121cb1 100644
--- a/src/lsp/defmacro.lsp
+++ b/src/lsp/defmacro.lsp
@@ -292,7 +292,7 @@
 		  (when *dump-defmacro-definitions*
 		    (print function)
 		    (setq function `(si::bc-disassemble ,function)))
-		  `(si::fset ',name ,function t ,pprint))))
+		  (ext:register-with-pde def `(si::fset ',name ,function t ,pprint)))))
 	  t)
 
 ;;; valid lambda-list to DESTRUCTURING-BIND is:
diff --git a/src/lsp/defstruct.lsp b/src/lsp/defstruct.lsp
index da5b7ca66..f4724d41f 100644
--- a/src/lsp/defstruct.lsp
+++ b/src/lsp/defstruct.lsp
@@ -326,7 +326,7 @@
 
 ;;; The DEFSTRUCT macro.
 
-(defmacro defstruct (name&opts &rest slots)
+(defmacro defstruct (&whole whole name&opts &rest slots)
   "Syntax: (defstruct
          {name | (name {:conc-name | (:conc-name prefix-string) |
                         :constructor | (:constructor symbol [lambda-list]) |
@@ -504,6 +504,7 @@ as a STRUCTURE doc and can be retrieved by (documentation 'NAME 'structure)."
       `(eval-when (:compile-toplevel :load-toplevel :execute)
 	 (eval-when (:compile-toplevel :load-toplevel)
 	   ,core
+	   ,(si::register-with-pde whole)
 	   ,@(subst `(load-time-value (find-class ',name))
 		    '.structure-constructor-class.
 		    constructors))
diff --git a/src/lsp/evalmacros.lsp b/src/lsp/evalmacros.lsp
index bf7aaee2c..df139e5bb 100644
--- a/src/lsp/evalmacros.lsp
+++ b/src/lsp/evalmacros.lsp
@@ -68,7 +68,7 @@ macro useful for defining macros."
        ,@(si::expand-set-documentation name 'function doc-string)
        ',name)))
 
-(defmacro defvar (var &optional (form nil form-sp) doc-string)
+(defmacro defvar (&whole whole var &optional (form nil form-sp) doc-string)
   "Syntax: (defvar name [form [doc]])
 Declares the variable named by NAME as a special variable.  If the variable
 does not have a value, then evaluates FORM and assigns the value to the
@@ -80,12 +80,12 @@ as a VARIABLE doc and can be retrieved by (documentation 'NAME 'variable)."
 	  `((UNLESS (BOUNDP ',var)
 	      (SETQ ,var ,form))))
     ,@(si::expand-set-documentation var 'variable doc-string)
-    #+PDE (SYS:RECORD-SOURCE-PATHNAME ',var 'defvar)
+    ,(ext:register-with-pde whole)
     (eval-when (:compile-toplevel)
       (si::register-global ',var))
     ',var))
 
-(defmacro defparameter (var form &optional doc-string)
+(defmacro defparameter (&whole whole var form &optional doc-string)
   "Syntax: (defparameter name form [doc])
 Declares the global variable named by NAME as a special variable and assigns
 the value of FORM to the variable.  The doc-string DOC, if supplied, is saved
@@ -94,15 +94,15 @@ as a VARIABLE doc and can be retrieved by (documentation 'NAME 'variable)."
     (SYS:*MAKE-SPECIAL ',var)
     (SETQ ,var ,form)
     ,@(si::expand-set-documentation var 'variable doc-string)
-    #+PDE (SYS:RECORD-SOURCE-PATHNAME ',var 'DEFPARAMETER)
+    ,(ext:register-with-pde whole)
     (eval-when (:compile-toplevel)
       (si::register-global ',var))
     ',var))
 
-(defmacro defconstant (var form &optional doc-string)
+(defmacro defconstant (&whole whole var form &optional doc-string)
   `(PROGN (SYS:*MAKE-CONSTANT ',var ,form)
     ,@(si::expand-set-documentation var 'variable doc-string)
-    #+PDE (SYS:RECORD-SOURCE-PATHNAME ',var 'defconstant)
+    ,(ext:register-with-pde whole)
     (eval-when (:compile-toplevel)
       (si::register-global ',var))
     ',var))
@@ -110,7 +110,7 @@ as a VARIABLE doc and can be retrieved by (documentation 'NAME 'variable)."
 ;;;
 ;;; This is a no-op unless the compiler is installed
 ;;;
-(defmacro define-compiler-macro (name vl &rest body)
+(defmacro define-compiler-macro (&whole whole name vl &rest body)
   (multiple-value-bind (function pprint doc-string)
       (sys::expand-defmacro name vl body)
     (setq function `(function ,function))
@@ -120,6 +120,7 @@ as a VARIABLE doc and can be retrieved by (documentation 'NAME 'variable)."
     `(progn
        (put-sysprop ',name 'sys::compiler-macro ,function)
        ,@(si::expand-set-documentation name 'function doc-string)
+       ,(ext:register-with-pde whole)
        ',name)))
 
 (defun compiler-macro-function (name &optional env)
@@ -317,7 +318,7 @@ SECOND-FORM."
   (declare (ignore type))
   value)
 
-(defmacro define-symbol-macro (symbol expansion)
+(defmacro define-symbol-macro (&whole whole symbol expansion)
   (cond ((not (symbolp symbol))
 	 (error "DEFINE-SYMBOL-MACRO: ~A is not a symbol"
 		symbol))
@@ -327,6 +328,7 @@ SECOND-FORM."
 	(t
 	 `(progn
 	   (put-sysprop ',symbol 'si::symbol-macro (lambda (form env) ',expansion))
+	   ,(ext:register-with-pde whole)
 	   ',symbol))))
 
 (defmacro nth-value (n expr)
diff --git a/src/lsp/export.lsp b/src/lsp/export.lsp
index fd40e1020..7fe112cc0 100644
--- a/src/lsp/export.lsp
+++ b/src/lsp/export.lsp
@@ -23,6 +23,17 @@
 
 ;; This is needed only when bootstrapping ECL using ECL-MIN
 (eval-when (eval)
+  (si::fset 'ext:register-with-pde
+	  #'(ext::lambda-block ext:register-with-pde (whole env)
+	       (let* ((definition (second whole))
+		      (output-form (third whole)))
+		 `(if ext:*register-with-pde-hook*
+		      (funcall ext:*register-with-pde-hook*
+			       (copy-tree *source-location*)
+			       ,definition
+			       ,output-form)
+		      ,output-form)))
+	  t)
   (si::fset 'defun
 	  #'(ext::lambda-block defun (def env)
 	      (let* ((name (second def))
@@ -30,7 +41,7 @@
 		(when *dump-defun-definitions*
 		  (print function)
 		  (setq function `(si::bc-disassemble ,function)))
-		`(si::fset ',name ,function)))
+		(ext:register-with-pde def `(si::fset ',name ,function))))
 	  t)
  (si::fset 'in-package
  	  #'(ext::lambda-block in-package (def env)

From 1e7967d0d97658e00709c36c81b4c83e7ba269ec Mon Sep 17 00:00:00 2001
From: jjgarcia <jjgarcia>
Date: Sat, 12 Jul 2008 16:55:07 +0000
Subject: [PATCH 2/5] Added a feature to identify we have PDE registration and
 update *source-location* when reading a file to be compiled

---
 src/c/assignment.d  | 12 ------------
 src/c/main.d        |  7 +------
 src/cmp/cmpmain.lsp | 11 +++++------
 src/h/object.h      |  3 ---
 4 files changed, 6 insertions(+), 27 deletions(-)

diff --git a/src/c/assignment.d b/src/c/assignment.d
index 7492c4724..87e524231 100644
--- a/src/c/assignment.d
+++ b/src/c/assignment.d
@@ -93,9 +93,6 @@ cl_fmakunbound(cl_object fname)
 	}
 	if (SYMBOLP(fname)) {
 		ecl_clear_compiler_properties(sym);
-#ifdef PDE
-		si_rem_sysprop(fname, @'defun');
-#endif
 		SYM_FUN(sym) = Cnil;
 		ecl_symbol_type_set(sym, ecl_symbol_type(sym) & ~stp_macro);
 	} else {
@@ -116,15 +113,6 @@ ecl_clear_compiler_properties(cl_object sym)
 	}
 }
 
-#ifdef PDE
-void
-record_source_pathname(cl_object sym, cl_object def)
-{
-  if (ecl_symbol_value(@'si::*record-source-pathname-p*') != Cnil)
-    (void)funcall(3, @'si::record-source-pathname', sym, def);
-}
-#endif /* PDE */
-
 cl_object
 si_get_sysprop(cl_object sym, cl_object prop)
 {
diff --git a/src/c/main.d b/src/c/main.d
index 29ae88bff..0d0850a6c 100644
--- a/src/c/main.d
+++ b/src/c/main.d
@@ -414,9 +414,6 @@ cl_boot(int argc, char **argv)
 		CONS(make_constant_base_string("LISP"), @'si::load-source'),
 		CONS(Cnil, @'si::load-source'));
 	ECL_SET(@'si::*load-hooks*', aux);
-#ifdef PDE
-	ECL_SET(@'si::*record-source-pathname-p*', Cnil);
-#endif
 	init_error();
 	init_macros();
 
@@ -468,9 +465,7 @@ cl_boot(int argc, char **argv)
 #ifdef ECL_OLD_LOOP
 	ADD_FEATURE("OLD-LOOP");
 #endif
-#ifdef PDE
-	ADD_FEATURE("PDE");
-#endif
+	ADD_FEATURE("ECL-PDE");
 #ifdef unix
 	ADD_FEATURE("UNIX");
 #endif
diff --git a/src/cmp/cmpmain.lsp b/src/cmp/cmpmain.lsp
index 62f164450..7483674f2 100644
--- a/src/cmp/cmpmain.lsp
+++ b/src/cmp/cmpmain.lsp
@@ -477,8 +477,7 @@ static cl_object VV[VM];
 			   (*compile-verbose* verbose)
 			   (*suppress-compiler-notes* (or *suppress-compiler-notes* (not verbose)))
 			   (*suppress-compiler-warnings* (or *suppress-compiler-warnings* (not verbose)))
-			   init-name
-			   #+PDE sys:*source-pathname*)
+			   init-name)
   (declare (notinline compiler-cc))
 
   #-dlopen
@@ -503,8 +502,6 @@ static cl_object VV[VM];
     (setf output-file *compile-file-truename*))
   (setf output-file (compile-file-pathname output-file :type (if system-p :object :fasl)))
 
-  #+PDE (setq sys:*source-pathname* *compile-file-truename*)
-
   (when (and system-p load)
     (error "Cannot load system files."))
 
@@ -549,10 +546,12 @@ Cannot compile ~a."
 	  (data-init))
 
       (with-open-file (*compiler-input* *compile-file-pathname*)
-	(do ((form (read *compiler-input* nil eof)
+	(do ((ext:*source-location* (cons *compile-file-pathname* 0))
+	     (form (read *compiler-input* nil eof)
 		   (read *compiler-input* nil eof)))
 	    ((eq form eof))
-	  (t1expr form)))
+	  (t1expr form)
+	  (incf (cdr ext:*source-location*))))
 
       (when (zerop *error-count*)
 	(when *compile-verbose* (format t "~&;;; End of Pass 1.  "))
diff --git a/src/h/object.h b/src/h/object.h
index 9e4f69ec7..f041dee9e 100644
--- a/src/h/object.h
+++ b/src/h/object.h
@@ -550,9 +550,6 @@ struct ecl_codeblock {
 	const char *data_text;		/*  string with objects to be defined  */
 	int	data_text_size;
 	cl_object next;			/*  next codeblock within same library */
-#ifdef PDE
-	int	source_pathname;
-#endif
 	cl_object name;
 	cl_object links;		/*  list of symbols with linking calls  */
 };

From 5757a65ace6310c1b8f1a8b11f08c21f5f718f04 Mon Sep 17 00:00:00 2001
From: jjgarcia <jjgarcia>
Date: Sun, 13 Jul 2008 08:47:00 +0000
Subject: [PATCH 3/5] Added a function ecl_make_stream_from_FILE, complementary
 to *_from_fd

---
 src/c/file.d     | 49 ++++++++++++++++++++++++++----------------------
 src/h/external.h |  1 +
 2 files changed, 28 insertions(+), 22 deletions(-)

diff --git a/src/c/file.d b/src/c/file.d
index b27d47a29..52638bf44 100644
--- a/src/c/file.d
+++ b/src/c/file.d
@@ -2811,9 +2811,34 @@ cl_interactive_stream_p(cl_object strm)
 }
 
 cl_object
-ecl_make_stream_from_fd(cl_object fname, int fd, enum ecl_smmode smm)
+ecl_make_stream_from_FILE(cl_object fname, void *fp, enum ecl_smmode smm)
 {
 	cl_object stream;
+	stream = cl_alloc_object(t_stream);
+	stream->stream.mode = (short)smm;
+	stream->stream.closed = 0;
+	stream->stream.file = fp;
+#if defined (ECL_WSOCK)
+	if ( smm == smm_input_wsock || smm == smm_io_wsock )
+		stream->stream.object0 = Cnil;
+	else
+		stream->stream.object0 = @'base-char';
+#else
+	stream->stream.object0 = @'base-char';
+#endif
+	stream->stream.object1 = fname; /* not really used */
+	stream->stream.int0 = stream->stream.int1 = 0;
+	stream->stream.char_stream_p = 1;
+	stream->stream.byte_size = 8;
+	stream->stream.signed_bytes = 0;
+	stream->stream.last_op = 0;
+	si_set_finalizer(stream, Ct);
+	return(stream);
+}
+
+cl_object
+ecl_make_stream_from_fd(cl_object fname, int fd, enum ecl_smmode smm)
+{
 	char *mode;			/* file open mode */
 	FILE *fp;			/* file pointer */
 
@@ -2844,27 +2869,7 @@ ecl_make_stream_from_fd(cl_object fname, int fd, enum ecl_smmode smm)
 #else
 	fp = fdopen(fd, mode);
 #endif
-
-	stream = cl_alloc_object(t_stream);
-	stream->stream.mode = (short)smm;
-	stream->stream.closed = 0;
-	stream->stream.file = fp;
-#if defined (ECL_WSOCK)
-	if ( smm == smm_input_wsock || smm == smm_io_wsock )
-		stream->stream.object0 = Cnil;
-	else
-		stream->stream.object0 = @'base-char';
-#else
-	stream->stream.object0 = @'base-char';
-#endif
-	stream->stream.object1 = fname; /* not really used */
-	stream->stream.int0 = stream->stream.int1 = 0;
-	stream->stream.char_stream_p = 1;
-	stream->stream.byte_size = 8;
-	stream->stream.signed_bytes = 0;
-	stream->stream.last_op = 0;
-	si_set_finalizer(stream, Ct);
-	return(stream);
+	return ecl_make_stream_from_FILE(fname, fp, smm);
 }
 
 int
diff --git a/src/h/external.h b/src/h/external.h
index f2a9de7bb..2ed0592e6 100644
--- a/src/h/external.h
+++ b/src/h/external.h
@@ -601,6 +601,7 @@ extern ECL_API cl_object ecl_file_position(cl_object strm);
 extern ECL_API cl_object ecl_file_position_set(cl_object strm, cl_object disp);
 extern ECL_API int ecl_file_column(cl_object strm);
 extern ECL_API cl_object ecl_make_stream_from_fd(cl_object host, int fd, enum ecl_smmode smm);
+extern ECL_API cl_object ecl_make_stream_from_FILE(cl_object host, void *fd, enum ecl_smmode smm);
 extern ECL_API int ecl_stream_to_handle(cl_object s, bool output);
 
 /* finalize.c */

From 3853a0ebe1cdc573c1aaef1ab72a55a3738468de Mon Sep 17 00:00:00 2001
From: jjgarcia <jjgarcia>
Date: Sun, 13 Jul 2008 09:43:49 +0000
Subject: [PATCH 4/5] Do not use INSTALL_PROGRAM to install lisp files. Ensure
 /ecl directory exists

---
 src/Makefile.in | 9 ++++++---
 1 file changed, 6 insertions(+), 3 deletions(-)

diff --git a/src/Makefile.in b/src/Makefile.in
index ebef4c845..deae9ef45 100644
--- a/src/Makefile.in
+++ b/src/Makefile.in
@@ -126,14 +126,14 @@ install-base:
 	# Here we would use the option -s but the install program in sourceforge-solaris
 	# is broken.
 	$(mkinstalldirs) $(DESTDIR)$(bindir) $(DESTDIR)$(libdir) \
-	  $(DESTDIR)$(ecldir) $(DESTDIR)$(includedir)
+	  $(DESTDIR)$(ecldir) $(DESTDIR)$(includedir) $(DESTDIR)$(includedir)/ecl
 	for i in $(TARGETS); do \
 	  $(INSTALL_PROGRAM) $$i $(DESTDIR)$(bindir); \
 	done;
-	$(mkinstalldirs) $(DESTDIR)$(includedir)/ecl/gc/private
 	sed '/-CUT-/,$$d' ./ecl/config.h > ./ecl/config-install.h
 	$(INSTALL_DATA) ./ecl/*.h $(DESTDIR)$(includedir)/ecl
 	if (echo $(SUBDIRS) | grep gc); then \
+	 $(mkinstalldirs) $(DESTDIR)$(includedir)/ecl/gc/private; \
 	  $(INSTALL_DATA) ./ecl/gc/*.h $(DESTDIR)$(includedir)/ecl/gc; \
 	  $(INSTALL_DATA) ./ecl/gc/private/*.h $(DESTDIR)$(includedir)/ecl/gc/private; \
 	fi
@@ -149,7 +149,10 @@ install-base:
 	  fi \
 	done
 	for i in c/dpp$(EXE) ecl_min$(EXE) `cat MODULES`; do \
-	  $(INSTALL_PROGRAM) $$i $(DESTDIR)$(ecldir); \
+	  case $$i in \
+	    *.fas) $(INSTALL_PROGRAM) $$i $(DESTDIR)$(ecldir);; \
+	    *) $(INSTALL_DATA) $$i $(DESTDIR)$(ecldir);; \
+	  esac \
 	done
 flatinstall: BUILD-STAMP
 	$(MAKE) DESTDIR=$(DESTDIR) bindir=$(prefix) libdir=$(prefix) \

From 9a16e8f827028b43c197302aaf1f372dd33baab4 Mon Sep 17 00:00:00 2001
From: jjgarcia <jjgarcia>
Date: Fri, 18 Jul 2008 08:51:27 +0000
Subject: [PATCH 5/5] Make link and compile less verbose

---
 msvc/Makefile | 20 ++++++++------------
 1 file changed, 8 insertions(+), 12 deletions(-)

diff --git a/msvc/Makefile b/msvc/Makefile
index b91d319c5..77f07ebf1 100644
--- a/msvc/Makefile
+++ b/msvc/Makefile
@@ -56,11 +56,11 @@ TAR_DIR = %CD%\ecl-$(ECL_VERSION)
 #
 
 CC	= cl
-MFLAGS  = -MD
-CFLAGS  = -EHsc -DGC_DLL -nologo
+MFLAGS  = /MD
+CFLAGS  = /EHsc /DGC_DLL /nologo
 LIBS	= eclgc.lib eclgmp.lib user32.lib ws2_32.lib shell32.lib
-LDFLAGS	= /link /nodefaultlib:libcmt /nodefaultlib:libcmtd /nodefaultlib:libc /nodefaultlib:libd
-SHARED_LDFLAGS = -LD
+LDFLAGS	= /link /nologo /nodefaultlib:libcmt /nodefaultlib:libcmtd /nodefaultlib:libc /nodefaultlib:libd
+SHARED_LDFLAGS = /LD
 GCFLAGS = nodebug=1
 RM	= del
 RMDIR   = rmdir /Q /S
@@ -103,9 +103,9 @@ DEF           = ecl.def
 # Enable debug information
 #
 !if "$(ECL_DEBUG)" != ""
-CFLAGS = -Z7 $(CFLAGS)
-LDFLAGS = -Z7 $(LDFLAGS)
-SHARED_LDFLAGS = -LDd
+CFLAGS = /Z7 $(CFLAGS)
+LDFLAGS = /Z7 $(LDFLAGS)
+SHARED_LDFLAGS = /LDd
 #MFLAGS = -MDd
 GCFLAGS =
 !endif
@@ -178,7 +178,7 @@ BUILD-STAMP: Makefile
 	date /t > $@
 
 ecl-static.lib: $(TARGETS)
-	link -lib -out:$@ eclmin.lib c\all_symbols2.obj lsp.lib eclgmp.lib eclgc.lib
+	link /lib /out:$@ eclmin.lib c\all_symbols2.obj lsp.lib eclgmp.lib eclgc.lib
 
 ecl_min$(EXE): $(LIBRARIES) eclmin.lib
 	$(CC) /Fe$@ cinit.obj c\all_symbols.obj eclmin.lib $(LDFLAGS) $(LIBS)
@@ -336,10 +336,6 @@ windows-nsi:
 	$(MV) $(TAR_DIR)\Setup.exe ecl-$(ECL_VERSION).exe
 	$(RMDIR) $(TAR_DIR)
 
-uninstall:
-	for i in $(TARGETS) ecl-config; do rm -rf $(bindir)/$$i; done
-	rm -rf $(libdir)
-
 clean: clean_ecl clean_lisp
 	-$(RM) .gdbinit cinit.lib ecl_min.lib
 	-$(RM) gc\*.pdb