Description: gcl27 support
 Support for building with gcl-2.7.1+.
Forwarded: not-needed
Author: Camm Maguire <camm@debian.org>

--- fricas-1.3.11.orig/src/include/com.h
+++ fricas-1.3.11/src/include/com.h
@@ -114,11 +114,16 @@ typedef struct {
 
 /* table of dedicated socket types */
 
+#ifndef GCL_SOURCE
+#define STATIC
 extern Sock *purpose_table[];
 extern Sock server[];
 extern Sock clients[];
 extern fd_set socket_mask;
 extern fd_set server_mask;
+#else
+#define STATIC static
+#endif
 
 /* Commands sent over the FRICAS session manager or menu socket */
 
@@ -160,7 +165,11 @@ fricas_write(Sock* s, const char* buf, s
 static inline int
 fricas_read(Sock* s, char* buf, size_t n)
 {
-   return recv(s->socket, buf, n, 0);
+#ifdef GCL_SOURCE
+  return read(s->socket, buf, n);
+#else
+  return recv(s->socket, buf, n, 0);
+#endif
 }
 
 #endif
--- fricas-1.3.11.orig/src/interp/Makefile.in
+++ fricas-1.3.11/src/interp/Makefile.in
@@ -137,8 +137,10 @@ makeint.lisp: ../boot/lobj_lst
 	@ echo '#+:GCL (si::gbc-time 0)' >> makeint.lisp
 
 ${SAVESYS}:
-	echo '(load "makeint.lisp") #-:ecl(BOOT::reclaim)' \
+	echo '#+gcl(setq si::*optimize-maximum-pages* nil)' \
+	     '(load "makeint.lisp") #-:ecl(BOOT::reclaim)' \
              '#+:ecl(FRICAS-LISP::make-program "$(BASE)$@" nil)' \
+             '#+:gcl(progn (setq si::*code-block-reserve* "")(si::gbc t)(setq si::*code-block-reserve* (make-array 10000000 :element-type (quote character) :static t) si::*optimize-maximum-pages* t))' \
              '#-:ecl(BOOT::spad-save "$(BASE)$@" t)' | \
            DAASE='$(fricas_src_datadir)' ${BOOTSYS}
 	ls $@
@@ -150,7 +152,11 @@ all-fricassys: ${FRICASSYS}
 
 ${FRICASSYS}: ../etc/stamp-databases
 	echo '(defparameter FRICAS-LISP::*building-fricassys* t)' \
+	   '#+gcl(setq si::*optimize-maximum-pages* nil)' \
 	   '(load "makeint.lisp") #-:ecl(BOOT::reclaim)' \
+           '#+:gcl(progn (setq si::*code-block-reserve* "")(si::gbc t)(setq si::*code-block-reserve* (make-array 10000000 :element-type (quote character) :static t) si::*optimize-maximum-pages* t))' \
+	   '#+:cmu (setf (ext:search-list "libspad:")' \
+	   '(list "${FRICAS}/lib/" "${libdir}/fricas/target/${target}/lib/"))' \
 	   '#+:cmu (setq ext:*top-level-auto-declare* t)' \
 	   '#+:cmu (setq *compile-verbose* nil)' \
 	   '#+:cmu (setq *compile-print* nil)' \
--- fricas-1.3.11.orig/src/interp/foam_l.lisp
+++ fricas-1.3.11/src/interp/foam_l.lisp
@@ -161,16 +161,10 @@
 (deftype |HInt| () '(integer #.(- (expt 2 15)) #.(1- (expt 2 15))))
 (deftype |SInt| () '(integer #.(- (expt 2 31)) #.(1- (expt 2 31))))
 
-#+:GCL
-(deftype |BInt| () t)
-#-:GCL
 (deftype |BInt| () 'integer)
 
 (deftype |SFlo| () 'short-float)
 
-#+:GCL
-(deftype |DFlo| () t)
-#-:GCL
 (deftype |DFlo| () 'double-float)
 
 (deftype |Level| () t) ;; structure??
--- fricas-1.3.11.orig/src/interp/i-funsel.boot
+++ fricas-1.3.11/src/interp/i-funsel.boot
@@ -1304,7 +1304,7 @@ orderMmCatStack st ==
     if not mem then haventvars := cons(s,haventvars)
   null havevars => st
   st := nreverse nconc(haventvars,havevars)
-  SORT(st, function mmCatComp)
+  STABLE_-SORT(st, function mmCatComp)
 
 mmCatComp(c1, c2) ==
   b1 := ASSQ(CADR c1, $Subst)
--- fricas-1.3.11.orig/src/interp/i-toplev.boot
+++ fricas-1.3.11/src/interp/i-toplev.boot
@@ -86,7 +86,7 @@ from scratch.
 $spadroot := '""
 
 -- Prefix a filename with the {\bf |$spadroot|} variable.
-make_absolute_filename(name) == STRCONC($spadroot, '"/", name)
+make_absolute_filename(name) == append_directory_name($spadroot,name)
 
 reroot(dir) ==
     $spadroot := dir
--- fricas-1.3.11.orig/src/interp/lisplib.boot
+++ fricas-1.3.11/src/interp/lisplib.boot
@@ -330,7 +330,7 @@ mkEvalableCategoryForm(c, e) ==       --
   c is [op,:argl] =>
     op="Join" =>
         nargs := [mkEvalableCategoryForm(x, e) or return nil for x in argl]
-        nargs => ["Join", :nargs]
+        nargs => ["JoinInner", ["LIST", :nargs]]
     op is "DomainSubstitutionMacro" =>
         mkEvalableCategoryForm(CADR argl, e)
     op is "mkCategory" => c
--- fricas-1.3.11.orig/src/interp/macros.lisp
+++ fricas-1.3.11/src/interp/macros.lisp
@@ -452,13 +452,10 @@ This function respects intermediate #\Ne
            *standard-output*))
         (*compile-verbose* nil))
     (declare (special |$comp370_apply|))
-    #-:GCL
     (handler-bind ((warning #'muffle-warning)
                    #+:sbcl (sb-ext::compiler-note #'muffle-warning))
       (funcall driver fn)
       )
-    #+:GCL
-      (funcall driver fn)
 ))
 
 (defun |compQuietly| (fn)
--- fricas-1.3.11.orig/src/interp/nlib.lisp
+++ fricas-1.3.11/src/interp/nlib.lisp
@@ -368,13 +368,13 @@
 ;; E.g.  "/"  "/u/smwatt"  "../src"
 (defun |DirToString| (d)
   (cond
-    ((equal d '(:root)) "/")
+    ((equal d '(:absolute)) "/")
     ((null d) "")
     ('t (string-right-trim "/" (namestring (make-pathname :directory d)))) ))
 
 (defun |StringToDir| (s)
   (cond
-    ((string= s "/") '(:root))
+    ((string= s "/") '(:absolute))
     ((string= s "")  nil)
     ('t
       (let ((lastc (aref s (- (length s) 1))))
@@ -409,10 +409,7 @@
 
 (defun |fnameReadable?| (f)
   (let ((s
-          #-:GCL
           (ignore-errors (open f :direction :input :if-does-not-exist nil))
-          #+:GCL
-          (open f :direction :input :if-does-not-exist nil)
         ))
     (cond (s (close s) 't) ('t nil)) )
   )
--- fricas-1.3.11.orig/src/interp/util.lisp
+++ fricas-1.3.11/src/interp/util.lisp
@@ -252,12 +252,9 @@ After this function is called the image
                  (apply cname args))))
 
 (defun |eval|(x)
-    #-:GCL
     (handler-bind ((warning #'muffle-warning)
                    #+:sbcl (sb-ext::compiler-note #'muffle-warning))
             (eval  x))
-    #+:GCL
-    (eval  x)
 )
 
 ;;; For evaluating categories we need to bind %.
--- fricas-1.3.11.orig/src/interp/vmlisp.lisp
+++ fricas-1.3.11/src/interp/vmlisp.lisp
@@ -142,7 +142,8 @@
 ; 14.1 Creation
 
 ;;; needed for SPAD compiler output
-(define-function '|construct| #'list)
+#-gcl(define-function '|construct| #'list)
+#+gcl(define-function '|construct| #'cl::list)
 
 (defun VEC2LIST (vec) (coerce vec 'list))
 
@@ -289,19 +290,9 @@
 
 (defun GETZEROVEC (n) (MAKE-ARRAY n :initial-element 0))
 
-#-:GCL
 (defun LIST2VEC (list) (coerce list 'vector))
 
 ;;; At least in gcl 2.6.8 coerce is slow, so we roll our own version
-#+:GCL
-(defun LIST2VEC (list)
-    (if (consp list)
-        (let* ((len (length list))
-               (vec (make-array len)))
-             (dotimes (i len)
-                  (setf (aref vec i) (pop list)))
-             vec)
-        (coerce list 'vector)))
 
 
 (define-function 'LIST2REFVEC #'LIST2VEC)
@@ -673,8 +664,20 @@
 #+:poplog
 (defun reclaim () nil)
 
+#+gcl
+(defun BPINAME (func)
+  (typecase func
+    (symbol func)
+    ((cons (eql lambda-block) t) (cadr func))
+    (function
+     (cond (#.(fboundp 'function-lambda-expression)
+	    (multiple-value-bind (x y z) (function-lambda-expression func)
+	      (or (and (symbolp z) (fboundp z) z) func)))
+	   ((compiled-function-p func)
+            (system:compiled-function-name func))
+           (func)))))
 
-#+(OR IBCL KCL)
+#+(OR IBCL)
 (defun BPINAME (func)
   (if (functionp func)
       (cond ((symbolp func) func)
--- fricas-1.3.11.orig/src/lib/cfuns-c.c
+++ fricas-1.3.11/src/lib/cfuns-c.c
@@ -44,6 +44,10 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBI
 
 #include "cfuns-c.H1"
 
+#ifdef GCL_SOURCE
+#undef HOST_HAS_DIRFD_FCHDIR
+#endif
+
 /* Most versions of Windows don't have the POSIX functions getuid(),
    geteuid(), getgid(), and getegid().  The following definitions are
    approximations, to patch for the deficiencies of Windows
@@ -193,7 +197,7 @@ static char * fricas_copy_string(char *s
     if (res) {
         strcpy(res, str);
     } else {
-        fprintf(stderr, "Malloc failed (fricas_copy_string)\n");
+        perror("Malloc failed (fricas_copy_string)\n");
     }
     return res;
 }
@@ -217,25 +221,25 @@ remove_directory(char * name)
     struct file_list * flst = 0;
 #ifdef HOST_HAS_DIRFD_FCHDIR
     if (!cur_dir) {
-        fprintf(stderr, "Unable to open current directory\n");
+        perror("Unable to open current directory\n");
         return -1;
     }
 #else
     if (name_len > INT_MAX/5) {
-        fprintf(stderr, "directory name too long\n");
+        perror("directory name too long\n");
         return -1;
     }
 #endif
     dir = opendir(name);
     if (!dir) {
-        fprintf(stderr, "Unable to open directory to be removed\n");
+        perror("Unable to open directory to be removed\n");
         goto err1;
     }
 #ifdef HOST_HAS_DIRFD_FCHDIR
     cur_dir_fd = dirfd(cur_dir);
     dir_fd = dirfd(dir);
     if (cur_dir_fd == -1 || dir_fd == -1) {
-        fprintf(stderr, "dirfd failed\n");
+        perror("dirfd failed\n");
         goto err2;
     }
 #endif
@@ -251,7 +255,7 @@ remove_directory(char * name)
         } else {
             struct file_list * npos = malloc(sizeof(*npos));
             if (!npos) {
-                fprintf(stderr, "Malloc failed (npos)\n");
+                perror("Malloc failed (npos)\n");
                 break;
             }
             npos->file = fricas_copy_string(fname);
@@ -284,14 +288,12 @@ remove_directory(char * name)
 #else
         char pathbuf[PATH_MAX];
         if (strlen(flst->file) + name_len + 1 < PATH_MAX) {
-            strcpy(pathbuf, name);
-            strcat(pathbuf, "/");
-            strcat(pathbuf, flst->file);
-            if (unlink(pathbuf)) {
-                perror("Unlink failed");
-            }
+	  snprintf(pathbuf,sizeof(pathbuf),"%s/%s",name,flst->file);
+	  if (unlink(pathbuf)) {
+	    perror("Unlink failed");
+	  }
         } else {
-            fprintf(stderr, "panthname too long\n");
+            perror("pathname too long\n");
         }
 #endif
         free(flst->file);
--- fricas-1.3.11.orig/src/lib/sockio-c.c
+++ fricas-1.3.11/src/lib/sockio-c.c
@@ -68,15 +68,17 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBI
 #define MSG_NOSIGNAL 0
 #endif
 
-Sock clients[MaxClients];       /* socket description of spad clients */
-Sock server[2];                 /* AF_LOCAL and AF_INET sockets for server */
-Sock *purpose_table[TotalMaxPurposes]; /* table of dedicated socket types */
-fd_set socket_mask;             /* bit mask of active sockets */
-fd_set server_mask;             /* bit mask of server sockets */
-int socket_closed;              /* used to identify closed socket on SIGPIPE */
-int spad_server_number = -1;    /* spad server number used in sman */
-int str_len = 0;
-int still_reading  = 0;
+STATIC Sock clients[MaxClients];       /* socket description of spad clients */
+STATIC Sock server[2];                 /* AF_LOCAL and AF_INET sockets for server */
+STATIC Sock *purpose_table[TotalMaxPurposes]; /* table of dedicated socket types */
+STATIC fd_set socket_mask;             /* bit mask of active sockets */
+STATIC fd_set server_mask;             /* bit mask of server sockets */
+STATIC int socket_closed;              /* used to identify closed socket on SIGPIPE */
+STATIC int spad_server_number = -1;    /* spad server number used in sman */
+STATIC int str_len = 0;
+#ifndef GCL_SOURCE
+STATIC int still_reading  = 0;
+#endif
 
 
 
@@ -261,7 +263,7 @@ sread(Sock *sock, char *buf, int buf_siz
   }
   if (ret_val == -1) {
     if (msg) {
-      sprintf(err_msg, "reading: %s", msg);
+      snprintf(err_msg, sizeof(err_msg),"reading: %s", msg);
       perror(err_msg);
     }
     return -1;
@@ -291,7 +293,7 @@ swrite(Sock *sock,char *buf,int buf_size
       return wait_for_client_write(sock, buf, buf_size, msg);
     } else {
       if (msg) {
-        sprintf(err_msg, "writing: %s", msg);
+        snprintf(err_msg,sizeof(err_msg), "writing: %s", msg);
         perror(err_msg);
       }
       return -1;
@@ -823,8 +825,12 @@ remote_stdio(Sock *sock)
         return;
       else {
         *(buf + len) = '\0';
+#ifdef GCL_SOURCE
+	gcl_puts(buf);
+#else
         fputs(buf, stdout);
         fflush(stdout);
+#endif
       }
     }
   }
@@ -860,7 +866,7 @@ make_server_name(char *name,char * base)
 {
   char *num;
   if (spad_server_number != -1) {
-    sprintf(name, "%s%d", base, spad_server_number);
+    snprintf(name, 256, "%s%d", base, spad_server_number);
     return 0;
   }
   num = getenv("SPADNUM");
@@ -870,7 +876,7 @@ make_server_name(char *name,char * base)
 */
     return -1;
   }
-  sprintf(name, "%s%s", base, num);
+  snprintf(name, 256, "%s%s", base, num);
   return 0;
 }
 
@@ -1030,15 +1036,15 @@ redirect_stdio(Sock *sock)
 /*  setbuf(stdout, NULL);  */
   fd = dup2(sock->socket, 1);
   if (fd != 1) {
-    fprintf(stderr, "Error connecting stdout to socket\n");
+    perror("Error connecting stdout to socket\n");
     return;
   }
   fd = dup2(sock->socket, 0);
   if (fd != 0) {
-    fprintf(stderr, "Error connecting stdin to socket\n");
+    perror("Error connecting stdin to socket\n");
     return;
   }
-  fprintf(stderr, "Redirected standard IO\n");
+  perror("Redirected standard IO\n");
   FD_CLR(sock->socket, &socket_mask);
 }
 
--- fricas-1.3.11.orig/src/lisp/Makefile.in
+++ fricas-1.3.11/src/lisp/Makefile.in
@@ -56,27 +56,14 @@ $(OUT)/lisp$(EXEEXT): do_it.$(lisp_flavo
 do_it.gcl: fricas-lisp.lisp fricas-package.lisp fricas-config.lisp \
            primitives.lisp
 	$(fricas_gcl_rsym_hack)
-	echo '(load "fricas-package.lisp") (load "fricas-config.lisp")' \
+	echo '(setq si::*optimize-maximum-pages* nil)' \
+	     '(load "fricas-package.lisp") (load "fricas-config.lisp")' \
 	     '(load "fricas-lisp.lisp")' \
 	     '(setq compiler::*default-system-p* nil)' \
-	     '(compile-file "fricas-lisp.lisp")' \
-             '(compile-file "primitives.lisp")' | $(FRICAS_LISP)
-	echo '(compiler::link nil "prelisp" ' \
-              ' (format nil "(progn (let ((SI::*load-path*' \
-                                            ' (cons ~S SI::*load-path*))' \
-                                        ' (si::*load-types* ~S))' \
-                                       ' (compiler::emit-fn t))' \
-                                  ' (when (fboundp (quote si::sgc-on))' \
-                                        ' (si::sgc-on nil))' \
-                                  ' (setq compiler::*default-system-p* nil))' \
-                     ' (setq compiler::*default-large-memory-model-p* t))"' \
-                      ' si::*system-directory* (quote (list ".lsp")))' \
-               '  "$(lisp_c_objects) $(fricas_c_runtime_extra)")' \
-            | $(FRICAS_LISP)
-	echo '(load "fricas-package.lisp") (load "fricas-config.lisp")' \
-	     '(load "fricas-lisp.$(OBJEXT)")' '(load "primitives.$(OBJEXT)")' \
-	     '(in-package "FRICAS-LISP") (save-core "$(OUT)/lisp$(EXEEXT)")' \
-	    | ./prelisp$(EXEEXT)
+	     '(let ((compiler::*cc* (concatenate (quote string) compiler::*cc* " -I../../config -I../include")))(load (compile-file "fricas-lisp.lisp")))' \
+             '(load (compile-file "primitives.lisp"))' \
+             '(progn (setq si::*code-block-reserve* "")(si::gbc t)(setq si::*code-block-reserve* (make-array 10000000 :element-type (quote character) :static t) si::*optimize-maximum-pages* t))' \
+	     '(in-package "FRICAS-LISP")(save-core "$(OUT)/lisp$(EXEEXT)")' | GCL_ANSI=t $(FRICAS_LISP)
 	$(STAMP) $@
 
 fricas-lisp.lisp: $(srcdir)/fricas-lisp.lisp
--- fricas-1.3.11.orig/src/lisp/fricas-lisp.lisp
+++ fricas-1.3.11/src/lisp/fricas-lisp.lisp
@@ -1,7 +1,16 @@
 ;;; This file contains portablity and support routines which abstract away
 ;;; differences between Lisp dialects.
 
+#+gcl
+(si::clines "
+#define GCL_SOURCE
+#include \"../lib/bsdsignal.c\"
+#include \"../lib/cfuns-c.c\"
+#include \"../lib/sockio-c.c\"
+")
+
 (in-package "FRICAS-LISP")
+
 #+:cmu
 (progn
      (defvar *saved-terminal-io* *terminal-io*)
@@ -59,7 +68,7 @@ on this message after the fact. The cmpn
 else in GCL so stepping on the function call seems best. We're unhappy
 with this hack and will try to convince the GCL crowd to fix this.
 |#
-#+:gcl (defun compiler::cmpnote (&rest x))
+#+gcl(setq compiler::*suppress-compiler-notes* t)
 
 ;;
 #+:openmcl
@@ -70,10 +79,6 @@ with this hack and will try to convince
     ((app ccl::application) error-flag opts args) nil)
 )
 
-;;; Disable argument processing in GCL
-#+:gcl
-(defun system::process-some-args (&rest args) nil)
-
 ;; Save current image on disk as executable and quit.
 (defun save-core-restart (core-image restart)
 #+:GCL
@@ -202,8 +207,10 @@ with this hack and will try to convince
 
 #-:ecl
 (defun make-program (core-image lisp-files)
-    (load-lisp-files lisp-files)
-    (save-core core-image))
+  #+gcl(setq si::*optimize-maximum-pages* nil)
+  (load-lisp-files lisp-files)
+  #+:gcl(progn (setq si::*code-block-reserve* "")(si::gbc t)(setq si::*code-block-reserve* (make-array 10000000 :element-type (quote character) :static t) si::*optimize-maximum-pages* t))
+  (save-core core-image))
 
 #+:ecl
 (defun make-program (core-image lisp-files)
@@ -226,9 +233,7 @@ with this hack and will try to convince
 ;;; Deleting files ignoring errors
 
 (defun |maybe_delete_file| (file)
-    #-gcl (ignore-errors (delete-file file))
-    ;;; broken, but using gcl it is hard to do better
-    #+gcl (and (probe-file file) (delete-file file))
+  (ignore-errors (delete-file file))
 )
 
 ;;; Chdir function
@@ -310,11 +315,8 @@ with this hack and will try to convince
 
 (defun |load_quietly| (f)
     ;;; (format *error-output* "entered load_quietly ~&")
-    #-:GCL
     (handler-bind ((warning #'muffle-warning))
                   (load f))
-    #+:GCL
-    (load f)
     ;;; (format *error-output* "finished load_quietly ~&")
 )
 
@@ -657,15 +659,14 @@ with this hack and will try to convince
 ;; string with data read from connection, therefore needs address of
 ;; actual string buffer. We use 'sock_get_string_buf_wrapper' to
 ;; resolve the problem
-(SI::clines "int sock_get_string_buf_wrapper(int i, object x, int j)"
-	    "{ extern int sock_get_string_buf(int,void *,int); "
-	    " if (type_of(x)!=t_string) FEwrong_type_argument(sLstring,x);"
-	    " if (x->st.st_fillp<j)"
-	    "    FEerror(\"string too small in sock_get_string_buf_wrapper\",0);"
-	    " return sock_get_string_buf(i, x->st.st_self, j); }")
+(SI::clines "fixnum sock_get_string_buf_wrapper(fixnum i, object x, fixnum j)"
+    "{ if (!vectorp(x)) FEerror(\"not a string ->~s<-\",1,x);/*FIXME no stringp, and 2.7.0 only has simple_string*/"
+    "  if (length(x)<j)"
+    "    FEerror(\"string too small in sock_get_string_buf_wrapper ~s\",1,list(3,x,make_fixnum((fixnum)x),make_fixnum(j)));"
+    "  return (fixnum)sock_get_string_buf(i, x->st.st_self, j); }")
 
-(SI::defentry sock_get_string_buf (SI::int SI::object SI::int)
-    (SI::int "sock_get_string_buf_wrapper"))
+(SI::defentry sock_get_string_buf (SI::fixnum SI::object SI::fixnum)
+    (SI::fixnum "sock_get_string_buf_wrapper"))
 
 (defun |sockGetStringFrom| (type)
     (let ((buf (MAKE-STRING 10000)))
@@ -715,7 +716,7 @@ with this hack and will try to convince
 ;;; File and directory support
 ;;; First version contributed by Juergen Weiss.
 
-#+(or :ECL :GCL)
+#+ecl
 (progn
 
   (fricas-foreign-call file_kind "directoryp" int
@@ -725,9 +726,13 @@ with this hack and will try to convince
                    (arg c-string))
 )
 
+(defun |append_directory_name| (dir name)
+  (concatenate 'string (|trim_directory_name| dir) "/"
+	       (if (char= #\/ (char name 0)) (subseq name 1) name)))
+
 (defun |trim_directory_name| (name)
     #+(or :unix :win32)
-    (if (char= (char name (1- (length name))) #\/)
+    (if (when (> (length name) 0) (char= (char name (1- (length name))) #\/))
         (subseq name 0 (1- (length name)))
         name)
     #-(or :unix :win32)
@@ -735,7 +740,7 @@ with this hack and will try to convince
 
 (defun |pad_directory_name| (name)
    #+(or :unix :win32)
-   (if (char= (char name (1- (length name))) #\/)
+   (if (when (> (length name) 0) (char= (char name (1- (length name))) #\/))
        name
        (concatenate 'string name "/"))
    #-(or :unix :win32)
@@ -744,6 +749,9 @@ with this hack and will try to convince
 
 ;;; Make directory
 
+#+gcl
+(defun |makedir| (fname) (si::mkdir fname))
+
 #+(or :abcl :cmu :lispworks :openmcl)
 (defun |makedir| (fname)
     (|run_program| "mkdir" (list fname)))
@@ -769,6 +777,9 @@ with this hack and will try to convince
                 (find-symbol "UNIX-FILE-KIND" :sb-unix))))
          `(,file-kind-fun ,x)))
 
+#+gcl
+(defun file_kind (fname) (case (si::stat fname) (:directory 1) ((nil) -1) (otherwise 0)))
+
 (defun |file_kind| (filename)
    #+(or :GCL :ecl) (file_kind filename)
    #+:cmu
@@ -1134,3 +1145,14 @@ with this hack and will try to convince
 (defun |shoeEVALANDFILEACTQ| (expr)
     `(eval-when (:execute :load-toplevel)
          ,expr))
+
+#+gcl
+(in-package "BOOT")
+#+gcl
+(shadow "LIST")
+#+gcl
+(defmacro list (&rest r &aux (l (length r)))
+  (let ((x (nthcdr (1- call-arguments-limit) r)))
+    (if x `(nconc (cl::list ,@(ldiff r x)) (list ,@x)) `(cl::list ,@r))))
+#+gcl
+(deftype list nil 'cl::list)
--- fricas-1.3.11.orig/src/lisp/fricas-package.lisp
+++ fricas-1.3.11/src/lisp/fricas-package.lisp
@@ -43,7 +43,7 @@
 
 (export '(QUIT CHDIR |getEnv| |getCLArgs| |load_quietly|
           |get_current_directory|
-          |trim_directory_name| |pad_directory_name|
+          |trim_directory_name| |append_directory_name| |pad_directory_name|
           |file_kind| |makedir| |fricas_compile_file| |fricas_compile_fasl|
           |fricas_probe_file| |run_program| |run_shell_command|
           DEFCONST |exit_with_status| MEMQ |quiet_load_alien|
--- fricas-1.3.11.orig/src/lisp/primitives.lisp
+++ fricas-1.3.11/src/lisp/primitives.lisp
@@ -607,8 +607,8 @@
           (t (BREAK))))
 
 (defmacro qcsize (x)
- `(the fixnum (length (the #-(or :ecl :gcl)simple-string
-                           #+(or :ecl :gcl)string ,x))))
+  `(the fixnum (length (the #-ecl simple-string
+                            #+ecl string ,x))))
 
 (defmacro qrefelt (vec ind) `(svref ,vec ,ind))
 
