*** ../gcl-cvs/./clcs/makefile Wed Dec 3 16:19:03 2003 --- ./clcs/makefile Sat Apr 24 04:34:46 2004 *************** saved_full_gcl: ${LISP} *** 34,37 **** clean: rm -f *.o *.fn saved_full_gcl$(EXE) saved_full_gcl cmpinclude.h *.c *.h *.data ! .INTERMEDIATE: saved_clcs_gcl \ No newline at end of file --- 34,38 ---- clean: rm -f *.o *.fn saved_full_gcl$(EXE) saved_full_gcl cmpinclude.h *.c *.h *.data ! ! # .INTERMEDIATE: saved_clcs_gcl *** ../gcl-cvs/./configure.in Fri Apr 23 22:21:47 2004 --- ./configure.in Sat Apr 24 04:34:46 2004 *************** AC_SUBST(INFO_DIR) *** 1530,1535 **** --- 1530,1536 ---- AC_MSG_CHECKING([for tcl/tk]) + if test "$have_x" = "disabled" ; then echo -n no X no TK ... ; TK_CONFIG_PREFIX="without-tk"; else if test -d "${TCL_CONFIG_PREFIX}" ; then true ; else rm -f conftest.tcl *************** if test "$have_dl" = "0" ; then *** 1629,1634 **** --- 1630,1639 ---- TCL_LIBS=`echo ${TCL_LIBS} | sed -e "s:-ldl::g"` fi + TK_LISP_LIB='gcl-tk/tk-package.lsp gcl-tk/tkl.o gcl-tk/tinfo.o gcl-tk/decode.tcl gcl-tk/demos/*.lsp gcl-tk/demos/*.lisp gcl-tk/demos/*.o' + TCL_EXES='gcl-tk/gcl.tcl gcl-tk/gcltkaux$(EXE)' + + fi AC_SUBST(TK_CONFIG_PREFIX) AC_SUBST(TK_LIBRARY) *************** AC_SUBST(TK_XINCLUDES) *** 1643,1653 **** AC_SUBST(TCL_LIB_SPEC) AC_SUBST(TCL_DL_LIBS) AC_SUBST(TCL_LIBS) ! ! ! ! ! if test -d "${TK_CONFIG_PREFIX}" ; then AC_MSG_RESULT([using TK_VERSION=${TK_VERSION} in ${TK_CONFIG_PREFIX}]) --- 1648,1655 ---- AC_SUBST(TCL_LIB_SPEC) AC_SUBST(TCL_DL_LIBS) AC_SUBST(TCL_LIBS) ! AC_SUBST(TK_LISP_LIB) ! AC_SUBST(TCL_EXES) if test -d "${TK_CONFIG_PREFIX}" ; then AC_MSG_RESULT([using TK_VERSION=${TK_VERSION} in ${TK_CONFIG_PREFIX}]) *************** fi *** 1658,1666 **** NOTIFY=$enable_notify AC_SUBST(NOTIFY) - - - # for sgbc the mprotect capabilities. # the time handling for unixtime, add timezone --- 1660,1665 ---- *** ../gcl-cvs/./h/att_ext.h Thu Nov 6 17:08:07 2003 --- ./h/att_ext.h Sun Apr 25 21:23:01 2004 *************** EXTER object sKroot; *** 394,399 **** --- 394,409 ---- EXTER object sKcurrent; EXTER object sKparent; EXTER object sKper; + EXTER object sKabsolute; + EXTER object sKrelative; + EXTER object sKlocal; + EXTER object sKcommon; + EXTER object sKback; + EXTER object sKup; + EXTER object sKwildinf; + EXTER object sKunspecific; + EXTER object sKsys; + /* object parse_namestring(); */ object coerce_to_pathname(); /* object default_device(); */ *************** object terpri(); *** 454,459 **** --- 464,475 ---- EXTER object sSpretty_print_format; EXTER int line_length; + /* file.d definied but not yet implemented */ + EXTER object sLAprint_linesA; + EXTER object sLAprint_miser_widthA; + EXTER object sLAprint_right_marginA; + EXTER object sLAread_evalA; + /* Read.d */ EXTER object standard_readtable; EXTER object Vreadtable; *** ../gcl-cvs/./lsp/gcl_auto.lsp Sun Apr 25 09:32:59 2004 --- ./lsp/gcl_auto.lsp Tue Apr 27 06:59:13 2004 *************** *** 181,186 **** --- 181,187 ---- (autoload-macro 'with-input-from-string '|iolib|) (autoload-macro 'with-open-file '|iolib|) (autoload-macro 'with-open-stream '|iolib|) + (autoload-macro 'with-standard-io-syntax '|gcl_iolib|) (autoload-macro 'with-output-to-string '|iolib|) ) ;;end autoloads of normally loaded files.j (if (find-package "COMPILER") (push :compiler *features*)) *** ../gcl-cvs/./lsp/gcl_auto_new.lsp Sun Apr 25 09:32:51 2004 --- ./lsp/gcl_auto_new.lsp Tue Apr 27 06:59:13 2004 *************** *** 181,186 **** --- 181,187 ---- (autoload-macro 'with-input-from-string '|gcl_iolib|) (autoload-macro 'with-open-file '|gcl_iolib|) (autoload-macro 'with-open-stream '|gcl_iolib|) + (autoload-macro 'with-standard-io-syntax '|gcl_iolib|) (autoload-macro 'with-output-to-string '|gcl_iolib|) ) ;;end autoloads of normally loaded files.j (if (find-package "COMPILER") (push :compiler *features*)) *** ../gcl-cvs/./lsp/gcl_autoload.lsp Sun Apr 25 09:33:08 2004 --- ./lsp/gcl_autoload.lsp Tue Apr 27 06:59:13 2004 *************** Good luck! The GCL Development Team" *** 417,422 **** --- 417,423 ---- (setf (get 'with-input-from-string 'si:pretty-print-format) 1) (setf (get 'with-open-file 'si:pretty-print-format) 1) (setf (get 'with-open-stream 'si:pretty-print-format) 1) + (setf (get 'with-standard-io-syntax 'si:pretty-print-format) 1) (setf (get 'with-output-to-string 'si:pretty-print-format) 1) *************** Good luck! The GCL Development Team" *** 424,427 **** (defvar *lib-directory* (namestring (probe-file "../"))) ! (import '(*lib-directory* *load-path* *system-directory*) 'si::user) \ No newline at end of file --- 425,428 ---- (defvar *lib-directory* (namestring (probe-file "../"))) ! (import '(*lib-directory* *load-path* *system-directory*) 'si::user) *** ../gcl-cvs/./lsp/gcl_export.lsp Sun Apr 25 09:33:17 2004 --- ./lsp/gcl_export.lsp Tue Apr 27 06:59:13 2004 *************** with-output-to-string *** 261,266 **** --- 261,267 ---- write-to-string y-or-n-p yes-or-no-p + with-standard-io-syntax proclaim proclamation *** ../gcl-cvs/./lsp/gcl_iolib.lsp Sun Sep 14 04:43:05 2003 --- ./lsp/gcl_iolib.lsp Tue Apr 27 06:59:13 2004 *************** *** 31,36 **** --- 31,37 ---- (export 'with-open-file) (export '(y-or-n-p yes-or-no-p)) (export 'dribble) + (export 'with-standard-io-syntax) (in-package 'system) *************** *** 192,195 **** --- 193,225 ---- (format t "~&Starts dribbling to ~A (~d/~d/~d, ~d:~d:~d)." namestring year month day hour min sec)))))) + ;;; copied from ECL under LGPL by Michael Koehne + ;;; with-standard-io-syntax + + (defmacro with-standard-io-syntax (&body body) + "Syntax: ({forms}*) + The forms of the body are executed in a print environment that corresponds to + the one defined in the ANSI standard. *print-base* is 10, *print-array* is t, + *package* is \"CL-USER\", etc." + `(let*((*package* (find-package :cl-user)) + (*print-array* t) + (*print-base* 10) + (*print-case* :upcase) + (*print-circle* nil) + (*print-escape* t) + (*print-gensym* t) + (*print-length* nil) + (*print-level* nil) + (*print-lines* nil) + (*print-miser-width* nil) + (*print-pretty* nil) + (*print-radix* nil) + (*print-readably* t) + (*print-right-margin* nil) + (*read-base* 10) + (*read-default-float-format* 'single-float) + (*read-eval* t) + (*read-suppress* nil) + (*readtable* (copy-readtable (si::standard-readtable)))) + ,@body)) *** ../gcl-cvs/./makedefc.in Wed Mar 10 23:57:15 2004 --- ./makedefc.in Sat Apr 24 04:34:46 2004 *************** address@hidden@ *** 39,44 **** --- 39,46 ---- address@hidden@ address@hidden@ address@hidden@ + address@hidden@ + address@hidden@ address@hidden@ address@hidden@ *** ../gcl-cvs/./makefile Sat Mar 20 02:31:49 2004 --- ./makefile Sat Apr 24 04:34:46 2004 *************** prefix=/usr/local *** 10,17 **** # ./configure --prefix=/usr/share # Allow platform defs file to override this. ! TK_LISP_LIB=gcl-tk/tkl.o gcl-tk/tinfo.o gcl-tk/decode.tcl gcl-tk/demos/*.lsp gcl-tk/demos/*.lisp gcl-tk/demos/*.o ! TCL_EXES=gcl-tk/gcl.tcl gcl-tk/gcltkaux$(EXE) GCL_DVI=gcl-tk.dvi gcl-si.dvi gcl.dvi GCL_HTML=gcl-si_toc.html gcl-tk_toc.html gcl_toc.html --- 10,17 ---- # ./configure --prefix=/usr/share # Allow platform defs file to override this. ! # TK_LISP_LIB=gcl-tk/tkl.o gcl-tk/tinfo.o gcl-tk/decode.tcl gcl-tk/demos/*.lsp gcl-tk/demos/*.lisp gcl-tk/demos/*.o ! # TCL_EXES=gcl-tk/gcl.tcl gcl-tk/gcltkaux$(EXE) GCL_DVI=gcl-tk.dvi gcl-si.dvi gcl.dvi GCL_HTML=gcl-si_toc.html gcl-tk_toc.html gcl_toc.html *************** VERSION=`cat majvers`.`cat minvers` *** 37,44 **** --- 37,50 ---- all: $(BUILD_BFD) $(PORTDIR)/$(FLISP) command cmpnew/gcl_collectfn.o lsp/gcl_info.o do-gcl-tk do-info + gcl: $(PORTDIR)/saved_gcl + xgcl: $(PORTDIR)/saved_xgcl + remake: + -rm -f unixport/saved_* unixport/lib* unixport/raw_* + make all + $(PORTDIR)/saved_xgcl: $(PORTDIR)/saved_gcl cd xgcl-2 && $(MAKE) *************** command: *** 131,137 **** merge: $(CC) -o merge merge.c ! LISP_LIB=clcs/myload1.lisp clcs/clcs_macros.lisp cmpnew/gcl_collectfn.o cmpnew/gcl_collectfn.lsp lsp/gcl_gprof.lsp lsp/gcl_info.o lsp/gcl_profile.lsp lsp/gcl_export.lsp lsp/gcl_autoload.lsp cmpnew/gcl_cmpmain.lsp cmpnew/gcl_cmpopt.lsp cmpnew/gcl_lfun_list.lsp lsp/gcl_auto_new.lsp h/cmpinclude.h unixport/init_$(SYSTEM).lsp unixport/lib$(SYSTEM).a unixport/libgclp.a gcl-tk/tk-package.lsp $(TK_LISP_LIB) $(RL_LIB) $(FIRST_FILE) $(LAST_FILE) $(addsuffix /sys-proclaim.lisp,lsp cmpnew pcl clcs) install-command: rm -f $(DESTDIR)$(prefix)/bin/gcl --- 137,143 ---- merge: $(CC) -o merge merge.c ! LISP_LIB=clcs/myload1.lisp clcs/clcs_macros.lisp cmpnew/gcl_collectfn.o cmpnew/gcl_collectfn.lsp lsp/gcl_gprof.lsp lsp/gcl_info.o lsp/gcl_profile.lsp lsp/gcl_export.lsp lsp/gcl_autoload.lsp cmpnew/gcl_cmpmain.lsp cmpnew/gcl_cmpopt.lsp cmpnew/gcl_lfun_list.lsp lsp/gcl_auto_new.lsp h/cmpinclude.h unixport/init_$(SYSTEM).lsp unixport/lib$(SYSTEM).a unixport/libgclp.a $(TK_LISP_LIB) $(RL_LIB) $(FIRST_FILE) $(LAST_FILE) $(addsuffix /sys-proclaim.lisp,lsp cmpnew pcl clcs) install-command: rm -f $(DESTDIR)$(prefix)/bin/gcl *************** clean: *** 228,234 **** -cd binutils/bfd && $(MAKE) distclean -cd binutils/libiberty && $(MAKE) distclean ! CMPINCLUDE_FILES=$(HDIR)cmpincl1.h $(HDIR)gclincl.h $(HDIR)compbas.h $(HDIR)enum.h $(HDIR)mgmp.h $(HDIR)object.h $(HDIR)vs.h \ $(HDIR)bds.h $(HDIR)frame.h \ $(HDIR)lex.h $(HDIR)eval.h $(HDIR)funlink.h \ $(HDIR)att_ext.h $(HDIR)new_decl.h $(HDIR)compbas2.h \ --- 234,241 ---- -cd binutils/bfd && $(MAKE) distclean -cd binutils/libiberty && $(MAKE) distclean ! CMPINCLUDE_FILES=$(HDIR)cmpincl1.h $(HDIR)gclincl.h $(HDIR)compbas.h \ ! $(HDIR)enum.h $(HDIR)mgmp.h $(HDIR)object.h $(HDIR)vs.h \ $(HDIR)bds.h $(HDIR)frame.h \ $(HDIR)lex.h $(HDIR)eval.h $(HDIR)funlink.h \ $(HDIR)att_ext.h $(HDIR)new_decl.h $(HDIR)compbas2.h \ *************** kcp: *** 264,267 **** (cd go ; $(MAKE) "CFLAGS = -I../h -pg -c -g ") (cd unixport ; $(MAKE) gcp) ! .INTERMEDIATE: unixport/saved_pcl_gcl \ No newline at end of file --- 271,274 ---- (cd go ; $(MAKE) "CFLAGS = -I../h -pg -c -g ") (cd unixport ; $(MAKE) gcp) ! # .INTERMEDIATE: unixport/saved_pcl_gcl *** ../gcl-cvs/./o/fasdump.c Thu Feb 12 06:24:42 2004 --- ./o/fasdump.c Sun Apr 25 06:16:01 2004 *************** read_fasl_vector(object in) *** 1499,1505 **** d->pn.pn_directory, d->pn.pn_name, make_simple_string("data"), ! d->pn.pn_version); d = coerce_to_namestring(d); in = open_stream(d,smm_input,Cnil,Cnil); if (in == Cnil) --- 1499,1506 ---- d->pn.pn_directory, d->pn.pn_name, make_simple_string("data"), ! d->pn.pn_version, ! Cnil); d = coerce_to_namestring(d); in = open_stream(d,smm_input,Cnil,Cnil); if (in == Cnil) *** ../gcl-cvs/./o/file.d Sat Mar 20 03:02:01 2004 --- ./o/file.d Mon Apr 26 03:35:59 2004 *************** object if_exists, if_does_not_exist; *** 421,427 **** /* goto AGAIN; */ /* /\* should not get here *\/ */ /* else { unlink(tmp);}} */ ! /* }} */ if (if_does_not_exist == sKerror) cannot_open(fn); else if (if_does_not_exist == sKcreate) { --- 421,427 ---- /* goto AGAIN; */ /* /\* should not get here *\/ */ /* else { unlink(tmp);}} */ ! /* } */ if (if_does_not_exist == sKerror) cannot_open(fn); else if (if_does_not_exist == sKcreate) { *** ../gcl-cvs/./o/mingfile.c Sat Feb 15 01:38:28 2003 --- ./o/mingfile.c Mon Apr 26 07:19:08 2004 *************** void Ldirectory ( void ) *** 8,20 **** --- 8,31 ---- char filename[MAXPATHLEN]; object *top=vs_top; object path; + int wildversion=0; + check_arg(1); + check_type_or_pathname_string_symbol_stream(&vs_base[0]); path = vs_base[0] = truename(coerce_to_pathname(vs_base[0])); + if ((namestring_resolve(sKversion) && + (vs_base[0]->pn.pn_version == sKwild)) { + wildversion=1; + vs_base[0]->pn.pn_version = Cnil; + } if (vs_base[0]->pn.pn_name==Cnil && vs_base[0]->pn.pn_type==Cnil) { coerce_to_filename(vs_base[0], filename); strcat(filename, "*.*"); + if (wildversion) + vs_base[0]->pn.pn_version = sKwild; + wildversion=0; } else if (vs_base[0]->pn.pn_name==Cnil) { vs_base[0]->pn.pn_name = sKwild; coerce_to_filename(vs_base[0], filename); *************** void Ldirectory ( void ) *** 22,29 **** --- 33,48 ---- } else if (vs_base[0]->pn.pn_type==Cnil) { coerce_to_filename(vs_base[0], filename); strcat(filename, ".*"); + if (wildversion) + vs_base[0]->pn.pn_version = sKwild; + wildversion=0; } else coerce_to_filename(vs_base[0], filename); + if (wildversion) { + strcat(filename, "*"); + vs_base[0]->pn.pn_version = sKwild; + wildversion=0; + } { WIN32_FIND_DATA data; HANDLE dirHandle = FindFirstFile(filename,&data); *************** void Ldirectory ( void ) *** 39,45 **** path->pn.pn_directory, new->pn.pn_name, new->pn.pn_type, ! new->pn.pn_version)); } } while (FindNextFile(dirHandle,&data)); FindClose(dirHandle); --- 58,65 ---- path->pn.pn_directory, new->pn.pn_name, new->pn.pn_type, ! new->pn.pn_version, ! Cnil)); } } while (FindNextFile(dirHandle,&data)); FindClose(dirHandle); *** ../gcl-cvs/./o/pathname.d Fri Apr 23 21:36:34 2004 --- ./o/pathname.d Tue Apr 27 06:47:31 2004 *************** any later version. *** 10,19 **** GCL is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ! FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. ! You should have received a copy of the GNU Library General Public License along with GCL; see the file COPYING. If not, write to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ --- 10,19 ---- GCL is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ! FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. ! You should have received a copy of the GNU Library General Public License along with GCL; see the file COPYING. If not, write to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ *************** Foundation, 675 Mass Ave, Cambridge, MA *** 25,200 **** This file contains those functions that interpret namestrings. */ #include "include.h" object ! make_pathname(host, device, directory, name, type, version) ! object host, device, directory, name, type, version; { ! object x; x = alloc_object(t_pathname); ! x->pn.pn_host = host; ! x->pn.pn_device = device; ! x->pn.pn_directory = directory; ! x->pn.pn_name = name; ! x->pn.pn_type = type; ! x->pn.pn_version = version; return(x); } ! static void ! make_one(s, end) char *s; ! int end; ! { int i; ! #ifdef UNIX ! for (i = 0; i < end; i++) ! token->st.st_self[i] = s[i]; ! #endif ! #ifdef AOSVS ! #endif ! token->st.st_fillp = end; ! vs_push(copy_simple_string(token)); } ! /* The function below does not attempt to handle DOS pathnames ! which use backslashes as directory separators. It needs ! TLC from someone who feels pedantic. MJT */ ! ! /* !!!!! Bug Fix. NLG */ object parse_namestring(s, start, end, ep) object s; int start, end, *ep; { ! int i, j, k, founddosdev = FALSE, oldstart=start, oldend=end, justdevice = FALSE; ! int d; ! object *vsp; ! object x; ! vs_mark; ! ! #ifndef IS_DIR_SEPARATOR ! #define IS_DIR_SEPARATOR(x) (x == '/') ! #endif ! *ep=oldend; ! vsp = vs_top + 1; ! for (;--end >= start && isspace((int)s->st.st_self[end]);); ! ! /* Check for a DOS path and process later */ ! if ( ( (start+1) <= end) && (s->st.st_self[start+1] == ':' )) { ! start+=2; ! founddosdev = TRUE; ! } ! if ( start > end ) { ! make_one(&s->st.st_self[0], 0); ! justdevice = TRUE; ! } else { ! for (i = j = start; i <= end; ) { ! #ifdef UNIX ! if (IS_DIR_SEPARATOR(s->st.st_self[i])) { ! #endif ! if (j == start && i == start) { ! i++; ! vs_push(sKroot); ! j = i; ! continue; ! } ! #ifdef UNIX ! if (i-j == 1 && s->st.st_self[j] == '.') { ! vs_push(sKcurrent); ! } else if (i-j==2 && s->st.st_self[j]=='.' && s->st.st_self[j+1]=='.') { ! vs_push(sKparent); ! } else { ! make_one(&s->st.st_self[j], i-j); ! } ! #endif ! i++; ! j = i; } else { ! i++; } ! } ! *ep = i; ! vs_push(Cnil); ! while (vs_top > vsp) ! stack_cons(); ! if (i == j) { ! /* no file and no type */ ! vs_push(Cnil); ! vs_push(Cnil); ! goto L; ! } ! for (k = j, d = -1; k < i; k++) ! if (s->st.st_self[k] == '.') ! d = k; ! if (d == -1) { ! /* no file type */ ! #ifdef UNIX ! if (i-j == 1 && s->st.st_self[j] == '*') ! #endif ! vs_push(sKwild); ! else ! make_one(&s->st.st_self[j], i-j); ! ! vs_push(Cnil); ! } else if (d == j) { ! /* no file name */ ! vs_push(Cnil); ! #ifdef UNIX ! if (i-d-1 == 1 && s->st.st_self[d+1] == '*') ! #endif ! vs_push(sKwild); ! else ! make_one(&s->st.st_self[d+1], i-d-1); } else { ! /* file name and file type */ ! #ifdef UNIX ! if (d-j == 1 && s->st.st_self[j] == '*') ! #endif ! vs_push(sKwild); ! else { ! make_one(&s->st.st_self[j], d-j); ! } ! #ifdef UNIX ! if (i-d-1 == 1 && s->st.st_self[d+1] == '*') ! #endif ! vs_push(sKwild); ! else ! make_one(&s->st.st_self[d+1], i-d-1); } - } - L: - /* Process DOS device name found earlier, build a string in a list and push it */ - if ( founddosdev ) { - /* Drive letter */ - token->st.st_self[0] = s->st.st_self[oldstart]; - /* Colon */ - token->st.st_self[1] = s->st.st_self[oldstart+1]; - /* Fill pointer */ - token->st.st_fillp = 2; - /* Push */ - vs_push(make_cons(copy_simple_string(token),Cnil)); - } else { - /* No device name */ - vs_push(Cnil); - } - if ( justdevice ) { - x = make_pathname ( Cnil, vs_top[-1], Cnil, Cnil, Cnil, Cnil ); - } else { - x = make_pathname ( Cnil, vs_top[-1], vs_top[-4], vs_top[-3], vs_top[-2], Cnil ); } ! vs_reset; return(x); } object coerce_to_pathname(x) object x; --- 25,485 ---- This file contains those functions that interpret namestrings. */ + /* hacked by Michael Koehne (c) GNU LGPL + * kraehe (at) copyleft.de + * Sun Apr 25 07:43:08 CEST 2004 + * + * beware of new bugs^h^h^h^h features ! + * + * feed them to http://www.copyleft.de/gecko/ + * or enjoy http://www.copyleft.de/lisp/ + * for other Lisp code + * + * many thanks to pfdietz - not only for ircing at #lisp to explain a + * few bits to me, but even more for writing the ansi-test. This hack + * would never been possible without his regression test ! + * ------------------------------------------------------------------------- */ + #include "include.h" + #include + #include + + object sSAnamestring_resolveA; + DEFVAR("*NAMESTRING-RESOLVE*",sSAnamestring_resolveA,SI,Cnil,""); + + /* + * namestring_resolve + * lookup the SI:*NAMESTRING-RESOLVE* variable, if I need to + * show :host, :device or :version. + * + * examples: + * (setq SI:*NAMESTRING-RESOLVE* :device) ;;; show device on DOS + * (setq SI:*NAMESTRING-RESOLVE* '(:host :version) ;;; show host and version + * + * this variable is also used by Ldirectory from unixfsys and mingfile. + * + * namestring_resolve + * query SI:*NAMESTRING-RESOLVE* and return 0 or 1 + */ + + int + namestring_resolve(key) + object key; + { + object o=symbol_value(sSAnamestring_resolveA); + if (o == key) return 1; + while (type_of(o) == t_cons) { + if (o->c.c_car==key) return 1; + o=o->c.c_cdr; + } + return 0; + } + /* + * pathname_case_word + * checks if a word is a string convert if :case :common. + * + * vs_push and return symbol or new string + */ object ! pathname_case_word(word, casekey) ! object word, casekey; { ! object x=word; ! int seen_lower=0; ! int seen_upper=0; ! int i; + if ((casekey == sKcommon) && (type_of(word) == t_string)) { + for (i=0; ist.st_fillp; i++) { + if (isupper(word->st.st_self[i])) seen_upper=1; + if (islower(word->st.st_self[i])) seen_lower=1; + } + if (seen_lower != seen_upper) { + x=copy_simple_string(word); + for (i=0; ist.st_fillp; i++) { + if (isupper(word->st.st_self[i])) + x->st.st_self[i]=tolower(x->st.st_self[i]); + else + if (islower(word->st.st_self[i])) + x->st.st_self[i]=toupper(x->st.st_self[i]); + } + } + } + vs_push(x); /* make-pathname will vs_reset later */ + return(x); + } + + /* + * make_pathname + * creates a new object of t_pathname. + * checks case and constrains directory to t_cons + * + * vs_mark; vs_push lot of junk; vs_reset; return new pathname + */ + + object + make_pathname(host, device, directory, name, type, version, casekey) + object host, device, directory, name, type, version, casekey; + { + object x,y,z; + int common_case=(casekey == sKcommon); + + vs_mark; x = alloc_object(t_pathname); ! vs_push(x); ! ! if ((directory != Cnil) && (type_of(directory) != t_cons)) { ! if ((type_of(directory) == t_string) || ! (directory == sKwild) || (directory == sKwildinf)) { ! vs_push(make_cons(directory,Cnil)); ! directory=make_cons(sKabsolute,vs_head); ! vs_head=directory; ! } else ! if ((directory == sKroot) || (directory == sKabsolute) || ! (directory == sKcurrent) || (directory == sKrelative) || ! (directory == sKup) || (directory == sKback) || ! (directory == sKparent)) { ! vs_push(make_cons(directory,Cnil)); ! directory=vs_head; ! } else ! FEerror("Illegal pathname directory component ~S.",1,directory); ! } ! ! if (common_case) { ! x->pn.pn_host = pathname_case_word(host,sKcommon); ! x->pn.pn_device = pathname_case_word(device,sKcommon); ! ! if (type_of(directory) == t_string) ! directory=pathname_case_word(directory); ! else ! if (type_of(directory) == t_cons) { ! z = directory; ! y = make_cons( pathname_case_word(z->c.c_car,sKcommon), Cnil); ! directory=y; ! vs_push(y); ! for (z = z->c.c_cdr; type_of(z) == t_cons; z = z->c.c_cdr) { ! y->c.c_cdr = make_cons( ! pathname_case_word(z->c.c_car,sKcommon), Cnil); ! y = y->c.c_cdr; ! } ! y->c.c_cdr = pathname_case_word(z,sKcommon); ! vs_popp; ! } ! x->pn.pn_directory = directory; ! ! x->pn.pn_name = pathname_case_word(name,sKcommon); ! x->pn.pn_type = pathname_case_word(type,sKcommon); ! x->pn.pn_version = pathname_case_word(version,sKcommon); ! } else { ! x->pn.pn_host = host; ! x->pn.pn_device = device; ! x->pn.pn_directory = directory; ! x->pn.pn_name = name; ! x->pn.pn_type = type; ! x->pn.pn_version = version; ! } ! vs_reset; return(x); } ! /* ! * parse_namestring_check ! * looks ahead for a character ! * ! * return string length or -1 if not found ! */ ! ! int ! parse_namestring_check(s,start,end,c,restrict) char *s; ! int start, end; ! char c; ! int restrict; ! { int i; + for (i=start; (s[i]!=c) && (ist.st_self[i++] = s[j++]; + token->st.st_fillp = i; + x=copy_simple_string(token); + vs_push(x); /* parse_namestring will vs_reset later */ + return(x); + } + /* + * parse_namestring_key + * checks the namestring object for known keys + * realm and assume tell what to do on the object + * + * might silently drop the old object - return old string or new keyword + */ ! object ! parse_namestring_key(o,realm,assume) ! object o,realm; ! int assume; ! { ! object x=o; ! if (type_of(o) == t_string) { ! if (realm == sKhost) { ! if ((o->st.st_fillp == 3) && !strncasecmp(o->st.st_self,"sys",2)) ! x=sKsys; ! } else ! if (realm == sKdirectory) { ! if ((o->st.st_fillp == 2) && !strncmp(o->st.st_self,"**",2)) ! x=sKwildinf; ! if (assume != ';') { ! if ((o->st.st_fillp == 2) && !strncmp(o->st.st_self,"..",2)) ! x=sKup; ! if ((o->st.st_fillp == 1) && (o->st.st_self[0]=='.')) ! x=sKcurrent; ! } ! } else ! if (realm == sKversion) { ! if ((o->st.st_fillp == 6) && !strncasecmp(o->st.st_self,"newest",6)) ! x=sKnewest; ! } ! if ((o->st.st_fillp == 1) && (o->st.st_self[0]=='*')) ! x= ((realm == sKhost) || (realm == sKdevice)) ? ! sKunspecific : sKwild; ! } ! return(x); } ! /* ! * parse_namestring ! * parses a namestring - trying varios forms like : ! * ! * source!c:/home/kraehe/lisp/foo.lisp c is a device Native ! * SYS:HOME;KRAEHE;LISP;FOO.LISP :sys is host CLHS like ! * ! * c:/home/kraehe/lisp/foo.lisp c is a device DOS like ! * source:/home/kraehe/lisp/foo.lisp source is a host Unix RSH like ! * source!/home/kraehe/lisp/foo.lisp source is a host Unix UUCP like ! * file://localhost/home/kraehe/lisp/foo.lisp file is device W3C URL like ! * ! * vs_mark; vs_push some junk; vs_reset and return new string object ! */ object parse_namestring(s, start, end, ep) object s; int start, end, *ep; { ! int i, j, k; ! object host=Cnil, device=Cnil, directory=Cnil, ! name=Cnil, type=Cnil, version=Cnil; ! object x=Cnil,dirend=Cnil; ! int assume=0; ! int relative=0; ! int name_type_key=0; ! char *p; ! vs_mark; /* only push stack - but dont'nt use it */ ! *ep=end; ! ! p = s->st.st_self; ! ! /* ignore leading and trailing spaces */ ! for (;isspace(p[start]) && (starti) { ! /* become greedy */ ! while ((j+1i) ! x=parse_namestring_make(p,i,j); ! if (j-i == 1) { ! assume='/'; ! device=parse_namestring_key(x,sKdevice,assume); ! } else ! if (j-i>1) { ! if (islower(p[i])) ! assume='/'; ! else { ! assume=';'; ! x=pathname_case_word(x,sKcommon); ! } ! host=parse_namestring_key(x,sKhost,assume); ! } ! i=j+1; ! } else ! /* try on unix like directories */ ! if ((j=parse_namestring_check(p,i,end,'/',0)) != -1) { ! if (assume==';') ! FEerror("Invalid pathname directory assumption ; got /.",0); ! assume='/'; ! /* try on URL's */ ! if ((directory == Cnil) && (i==j) && ! (j+2i) { ! x=parse_namestring_make(p,i,j); ! x=parse_namestring_key(x,sKdirectory,assume); ! } ! if ((directory == Cnil) && (x==Cnil)) { ! directory=make_cons(sKabsolute,Cnil); ! vs_push(directory); /* vs_push the list */ ! dirend=directory; ! } else ! if ((directory == Cnil) && (x!=Cnil)) { ! directory=make_cons(x,Cnil); ! vs_push(directory); /* vs_push the list */ ! dirend=directory; ! } else ! if ((directory != Cnil) && (x!=Cnil)) { ! dirend->c.c_cdr=make_cons(x,Cnil); ! dirend=dirend->c.c_cdr; ! } else ! FEerror("Illegal blank pathname directory component.",0); ! i=j+1; } ! } else ! ! /* try on lisp like directories */ ! if ((assume != '/') && ! ((j=parse_namestring_check(p,i,end,';',';')) != -1)) { ! if (assume==0) { ! if ((host == Cnil) && (device!=Cnil)) ! host=device; ! device=Cnil; ! assume=';'; ! } ! x=Cnil; ! if (j>i) { ! x=parse_namestring_make(p,i,j); ! x=pathname_case_word(x,sKcommon); ! x=parse_namestring_key(x,sKdirectory,assume); ! } ! if ((directory == Cnil) && (x==Cnil)) { ! if (relative) ! FEerror("Illegal blank pathname directory component.",0); ! relative=1; ! } else ! if ((directory == Cnil) && (x!=Cnil)) { ! if (relative) { ! directory=make_cons(x,Cnil); ! dirend=directory; ! relative=0; ! } else { ! directory=make_cons(sKabsolute,Cnil); ! directory->c.c_cdr=make_cons(x,Cnil); ! dirend=directory->c.c_cdr; ! } ! } else ! if ((directory != Cnil) && (x!=Cnil)) { ! dirend->c.c_cdr=make_cons(x,Cnil); ! dirend=dirend->c.c_cdr; ! } else ! FEerror("Illegal blank pathname directory component.",0); ! i=j+1; } else { ! ! /* try on name, type and version */ ! j=parse_namestring_check(p,i,end,'.',assume); ! if ((j==-1) || ((assume != ';') && (name_type_key==1))) ! j=end; ! x=Cnil; ! if (j>i) { ! x=parse_namestring_make(p,i,j); ! if (assume == ';') ! x=pathname_case_word(x,sKcommon); ! switch (name_type_key++) { ! case 0: ! name=parse_namestring_key(x,sKname,assume); ! if (j+1==end) ! type=parse_namestring_make(p,j+1,end); ! break; ! case 1: ! type=parse_namestring_key(x,sKtype,assume); ! break; ! case 2: ! version=parse_namestring_key(x,sKversion,assume); ! break; ! default: ! FEerror("Illegal 4th pathname name component.",0); ! } ! } else ! name_type_key++; ! i=j+1; } } ! ! x = make_pathname(host, device, directory, name, type, version, Cnil); ! vs_reset; /* release all that junk */ return(x); } + /* + * coerce_to_pathname + * coerce a string, symbol, stream, pathname into a pathname + * + * still old code - NO vs handling + * might contain SGC race conditions + */ + object coerce_to_pathname(x) object x; *************** L: *** 206,212 **** switch (type_of(x)) { case t_symbol: case t_string: - /* !!!!! Bug Fix. NLG */ y = parse_namestring(x, 0, x->st.st_fillp, &e); if (y == OBJNULL || e != x->st.st_fillp) goto CANNOT_COERCE; --- 491,496 ---- *************** static object *** 247,303 **** default_device(host) object host; { return(Cnil); - /* not implemented yet */ } object merge_pathnames(path, defaults, default_version) object path, defaults, default_version; { ! object host, device, directory, name, type, version; ! if (path->pn.pn_host == Cnil) ! host = defaults->pn.pn_host; ! else host = path->pn.pn_host; - if (path->pn.pn_device == Cnil) - if (path->pn.pn_host == Cnil) - device = defaults->pn.pn_device; - else if (path->pn.pn_host == defaults->pn.pn_host) - device = defaults->pn.pn_device; - else - device = default_device(path->pn.pn_host); else ! device = path->pn.pn_device; ! if (defaults->pn.pn_directory==Cnil || ! (type_of(path->pn.pn_directory)==t_cons ! && path->pn.pn_directory->c.c_car==sKroot)) ! directory=path->pn.pn_directory; ! else ! directory=path->pn.pn_directory==Cnil ? ! defaults->pn.pn_directory : ! append(defaults->pn.pn_directory,path->pn.pn_directory); ! if (path->pn.pn_name == Cnil) name = defaults->pn.pn_name; ! else name = path->pn.pn_name; if (path->pn.pn_type == Cnil) type = defaults->pn.pn_type; else type = path->pn.pn_type; ! version = Cnil; ! /* ! In this implimentation, version is not counted ! */ ! return(make_pathname(host,device,directory,name,type,version)); } /* ! Namestring(x) converts a pathname to a namestring. ! */ object namestring(x) object x; --- 531,638 ---- default_device(host) object host; { + /* not implemented yet */ return(Cnil); } + object merge_pathname_check(x) + object x; + { /* not implemented yet */ + return(x); + } + + /* + * merge_pathnames + * merges pathname, defaults and default_version + * + * does NOT YET handle :back. + * does NOT YET check for illegal conditions. + * + * vs_mark; vs_push; vs_reset; return new pathname + */ + object merge_pathnames(path, defaults, default_version) object path, defaults, default_version; { ! object host=Cnil, device=Cnil, directory=Cnil, ! name=Cnil, type=Cnil, version=Cnil; ! object x; ! vs_mark; ! ! if (path->pn.pn_host != Cnil) host = path->pn.pn_host; else ! host = defaults->pn.pn_host; ! if (path->pn.pn_device != Cnil) ! device = path->pn.pn_device; ! else ! if (path->pn.pn_host == Cnil) ! device = defaults->pn.pn_device; ! else ! if ((defaults->pn.pn_host != Cnil) && ! ((type_of(path->pn.pn_host) == t_symbol) || ! (type_of(path->pn.pn_host) == t_string)) && ! ((type_of(defaults->pn.pn_host) == t_symbol) || ! (type_of(defaults->pn.pn_host) == t_string)) && ! (string_equal(path->pn.pn_host, defaults->pn.pn_host) == TRUE)) ! device = defaults->pn.pn_device; ! else ! device = default_device(path->pn.pn_host); ! if (path->pn.pn_name == Cnil) { name = defaults->pn.pn_name; ! if (path->pn.pn_version != Cnil) ! version = path->pn.pn_version; ! else ! version = defaults->pn.pn_version; ! } else { name = path->pn.pn_name; + if (path->pn.pn_version != Cnil) + version = path->pn.pn_version; + else + version = default_version; + } if (path->pn.pn_type == Cnil) type = defaults->pn.pn_type; else type = path->pn.pn_type; ! ! if (defaults->pn.pn_directory==Cnil || ! (type_of(path->pn.pn_directory)==t_string) || ! ((type_of(path->pn.pn_directory)==t_cons) && ! ((path->pn.pn_directory->c.c_car==sKroot) || ! (path->pn.pn_directory->c.c_car==sKabsolute)))) ! directory=path->pn.pn_directory; ! else ! if (path->pn.pn_directory==Cnil) ! directory=defaults->pn.pn_directory; ! else { ! directory=append(defaults->pn.pn_directory,path->pn.pn_directory); ! vs_push(directory); ! } ! ! x=make_pathname(host,device,directory,name,type,version, Cnil); ! vs_push(x); ! merge_pathname_check(x); ! vs_reset; ! return(x); } /* ! * Namestring(x) converts a pathname to a namestring. ! * creates a new namestring at token space ! * silently ignores :version ! * ignores :device or :host depending on *NAMESTRING-RESOLVE* ! * ! * no vs handling needed - but code is cruft C showing lots ! * of pointer moving and even GOTO ! ! * ! * return new string ! */ ! object namestring(x) object x; *************** object x; *** 305,369 **** int i, j; object l, y; i = 0; ! l = x->pn.pn_device; ! if (endp(l)) { ! goto D; } ! y = l->c.c_car; ! y = coerce_to_string(y); ! for (j = 0; j < y->st.st_fillp; j++) { ! token->st.st_self[i++] = y->st.st_self[j]; } ! D: l = x->pn.pn_directory; ! if (endp(l)) goto L; y = l->c.c_car; ! if (y == sKroot) { ! #ifdef UNIX token->st.st_self[i++] = '/'; ! #endif l = l->c.c_cdr; } for (; !endp(l); l = l->c.c_cdr) { y = l->c.c_car; - #ifdef UNIX if (y == sKcurrent) { token->st.st_self[i++] = '.'; ! token->st.st_self[i++] = '/'; ! continue; ! } else if (y == sKparent) { token->st.st_self[i++] = '.'; token->st.st_self[i++] = '.'; ! token->st.st_self[i++] = '/'; ! continue; } - #endif - y = coerce_to_string(y); - for (j = 0; j < y->st.st_fillp; j++) - token->st.st_self[i++] - = y->st.st_self[j]; - #ifdef UNIX token->st.st_self[i++] = '/'; - #endif - #ifdef AOSVS - - #endif } L: y = x->pn.pn_name; if (y == Cnil) goto M; if (y == sKwild) { - #ifdef UNIX token->st.st_self[i++] = '*'; - #endif - #ifdef AOSVS - - #endif goto M; } if (type_of(y) != t_string) --- 640,747 ---- int i, j; object l, y; + int flag_host=0; i = 0; ! if (namestring_resolve(sKhost)) { ! l = x->pn.pn_host; ! if (type_of(l) == t_string) { ! for (j = 0; j < l->st.st_fillp; j++) ! token->st.st_self[i++] = l->st.st_self[j]; ! token->st.st_self[i++] = ! namestring_resolve(sKdevice) ? '!' : ':'; ! } else ! if ((l!=Cnil) && (l!=sKunspecific) && ! ((type_of(l) != t_cons) || endp(l))) ! FEerror("~S is an illegal pathname host.", 1, l); } ! ! if (namestring_resolve(sKdevice)) { ! l = x->pn.pn_device; ! if (type_of(l) == t_string) { ! for (j = 0; j < l->st.st_fillp; j++) ! token->st.st_self[i++] = l->st.st_self[j]; ! token->st.st_self[i++] = ':'; ! } else ! if ((l!=Cnil) && (l!=sKunspecific) && ! ((type_of(l) != t_cons) || endp(l))) ! FEerror("~S is an illegal pathname device.", 1, l); } ! l = x->pn.pn_directory; ! if (type_of(l) == t_string) { ! if ((l->st.st_fillp>0) && (l->st.st_self[0] != '/')) ! token->st.st_self[i++] = '/'; ! for (j = 0; j < l->st.st_fillp; j++) ! token->st.st_self[i++] = l->st.st_self[j]; ! if ((l->st.st_fillp<=0) || (token->st.st_self[i-1] != '/')) ! token->st.st_self[i++] = '/'; ! goto L; ! } else if (l == sKwild) { ! token->st.st_self[i++] = '/'; ! token->st.st_self[i++] = '*'; ! token->st.st_self[i++] = '/'; ! goto L; ! } else if ((l == sKabsolute) || (l == sKroot)) { ! token->st.st_self[i++] = '/'; ! goto L; ! } else if ((l == sKparent) || (l == sKup) || (l == sKback)) { ! if (flag_host) ! FEerror("~S is an illegal pathname directory for host.", 1, l); ! ! token->st.st_self[i++] = '.'; ! token->st.st_self[i++] = '.'; ! token->st.st_self[i++] = '/'; ! goto L; ! } else if ((l == Cnil) || (l == sKrelative) || (l == sKcurrent)) { ! if (flag_host) ! token->st.st_self[i++] = '/'; ! goto L; ! } else if (type_of(l) != t_cons) { ! FEerror("~S is an illegal pathname directory.", 1, l); ! } ! ! if (endp(l)) { ! if (flag_host) ! token->st.st_self[i++] = '/'; goto L; + } + y = l->c.c_car; ! if ((y == sKroot) || (y == sKabsolute)) { token->st.st_self[i++] = '/'; ! l = l->c.c_cdr; ! } else if (y == sKrelative) { l = l->c.c_cdr; } for (; !endp(l); l = l->c.c_cdr) { y = l->c.c_car; if (y == sKcurrent) { token->st.st_self[i++] = '.'; ! } else if ((y == sKparent) || (y == sKup) || (y == sKback)) { token->st.st_self[i++] = '.'; token->st.st_self[i++] = '.'; ! } else if (y == sKwild) { ! token->st.st_self[i++] = '*'; ! } else if (y == sKwildinf) { ! token->st.st_self[i++] = '*'; ! token->st.st_self[i++] = '*'; ! } else { ! if (type_of(y) != t_string) { ! FEerror("~S is an illegal pathname directory component.", 1, y); ! } ! for (j = 0; j < y->st.st_fillp; j++) ! token->st.st_self[i++] = y->st.st_self[j]; } token->st.st_self[i++] = '/'; } L: y = x->pn.pn_name; if (y == Cnil) goto M; if (y == sKwild) { token->st.st_self[i++] = '*'; goto M; } if (type_of(y) != t_string) *************** M: *** 376,396 **** goto N; if (y == sKwild) { token->st.st_self[i++] = '.'; - #ifdef UNIX token->st.st_self[i++] = '*'; - #endif - #ifdef AOSVS - - #endif goto N; } if (type_of(y) != t_string) ! FEerror("~S is an illegal pathname name.", 1, y); token->st.st_self[i++] = '.'; for (j = 0; j < y->st.st_fillp; j++) token->st.st_self[i++] = y->st.st_self[j]; N: token->st.st_fillp = i; #ifdef FIX_FILENAME {char buf[MAXPATHLEN]; if (i > MAXPATHLEN-1) i =MAXPATHLEN-1; --- 754,786 ---- goto N; if (y == sKwild) { token->st.st_self[i++] = '.'; token->st.st_self[i++] = '*'; goto N; } if (type_of(y) != t_string) ! FEerror("~S is an illegal pathname type.", 1, y); token->st.st_self[i++] = '.'; for (j = 0; j < y->st.st_fillp; j++) token->st.st_self[i++] = y->st.st_self[j]; N: + if (namestring_resolve(sKversion)) { + y = x->pn.pn_version; + if ((y == Cnil) || (y == sKnewest)) + goto O; + if (y == sKwild) { + token->st.st_self[i++] = '.'; + token->st.st_self[i++] = '*'; + goto O; + } else + if (type_of(y) != t_string) + goto O; + token->st.st_self[i++] = '.'; + for (j = 0; j < y->st.st_fillp; j++) + token->st.st_self[i++] = y->st.st_self[j]; + } + O: token->st.st_fillp = i; + #ifdef FIX_FILENAME {char buf[MAXPATHLEN]; if (i > MAXPATHLEN-1) i =MAXPATHLEN-1; *************** L: *** 480,505 **** case t_symbol: case t_string: get_string_start_end(x, start, end, &s, &e); ! for (; s < e && isspace((int)x->st.st_self[s]); s++) ! ; ! y ! /* !!!!! Bug Fix. NLG */ ! = parse_namestring(x, ! s, ! e - s, ! &ee); ! if (junk_allowed == Cnil) { ! for (; ee < e - s; ee++) ! if (!isspace((int)x->st.st_self[s + ee])) ! break; ! if (y == OBJNULL || ee != e - s) ! FEerror("Cannot parse the namestring ~S~%\ ! from ~S to ~S.", ! 3, x, start, end); ! } else ! if (y == OBJNULL) ! @(return Cnil `make_fixnum(s + ee)`) ! start = make_fixnum(s + ee); break; case t_pathname: --- 870,879 ---- case t_symbol: case t_string: get_string_start_end(x, start, end, &s, &e); ! y = parse_namestring(x, s, e, &ee); ! if (y == OBJNULL) ! @(return Cnil `make_fixnum(ee)`) ! start = make_fixnum(ee); break; case t_pathname: *************** from ~S to ~S.", *** 531,540 **** CANNOT_PARSE: FEerror("Cannot parse the namestring ~S.", 1, x); } ! if (host != Cnil && y->pn.pn_host != Cnil && ! host != y->pn.pn_host) FEerror("The hosts ~S and ~S do not match.", 2, host, y->pn.pn_host); @(return y start) @) --- 905,918 ---- CANNOT_PARSE: FEerror("Cannot parse the namestring ~S.", 1, x); } ! if ( (host != Cnil) && (host != sKunspecific) && ! (y->pn.pn_host != Cnil) && (y->pn.pn_host != sKunspecific)) { ! check_type_or_symbol_string(&host); ! check_type_or_symbol_string(&y->pn.pn_host); ! if (string_equal(host, y->pn.pn_host)==FALSE) FEerror("The hosts ~S and ~S do not match.", 2, host, y->pn.pn_host); + } @(return y start) @) *************** from ~S to ~S.", *** 556,580 **** (name `Cnil` name_supplied_p) (type `Cnil` type_supplied_p) (version `Cnil` version_supplied_p) ! defaults ! &aux x) @ if ( defaults == Cnil ) { ! defaults = symbol_value ( Vdefault_pathname_defaults ); ! defaults = coerce_to_pathname ( defaults ); ! defaults = make_pathname ( defaults->pn.pn_host, ! Cnil, Cnil, Cnil, Cnil, Cnil); } else { defaults = coerce_to_pathname(defaults); } ! x = make_pathname(host, device, directory, name, type, version); x = merge_pathnames(x, defaults, Cnil); ! if ( host_supplied_p) x->pn.pn_host = host; ! if (device_supplied_p) x->pn.pn_device = device; ! if (directory_supplied_p) x->pn.pn_directory = directory; ! if (name_supplied_p) x->pn.pn_name = name; ! if (type_supplied_p) x->pn.pn_type = type; ! if (version_supplied_p) x->pn.pn_version = version; @(return x) @) --- 934,959 ---- (name `Cnil` name_supplied_p) (type `Cnil` type_supplied_p) (version `Cnil` version_supplied_p) ! (case `Cnil` case_supplied_p) ! (defaults `Cnil` defaults_supplied_p) ! &aux x) @ if ( defaults == Cnil ) { ! if (defaults_supplied_p) ! defaults = make_pathname ( Cnil, ! Cnil, Cnil, Cnil, Cnil, Cnil, Cnil); ! else { ! defaults = symbol_value ( Vdefault_pathname_defaults ); ! defaults = coerce_to_pathname ( defaults ); ! defaults = make_pathname ( defaults->pn.pn_host, ! Cnil, Cnil, Cnil, Cnil, Cnil, Cnil); ! } } else { defaults = coerce_to_pathname(defaults); } ! x = make_pathname(host, device, directory, name, type, version, case); x = merge_pathnames(x, defaults, Cnil); ! @(return x) @) *************** LFD(Lpathnamep)(void) *** 588,637 **** vs_base[0] = Cnil; } ! LFD(Lpathname_host)(void) ! { ! check_arg(1); ! ! check_type_or_pathname_string_symbol_stream(&vs_base[0]); ! vs_base[0] = coerce_to_pathname(vs_base[0]); ! vs_base[0] = vs_base[0]->pn.pn_host; ! } ! ! LFD(Lpathname_device)(void) ! { ! check_arg(1); ! ! check_type_or_pathname_string_symbol_stream(&vs_base[0]); ! vs_base[0] = coerce_to_pathname(vs_base[0]); ! vs_base[0] = vs_base[0]->pn.pn_device; ! } ! ! LFD(Lpathname_directory)(void) ! { ! check_arg(1); ! ! check_type_or_pathname_string_symbol_stream(&vs_base[0]); ! vs_base[0] = coerce_to_pathname(vs_base[0]); ! vs_base[0] = vs_base[0]->pn.pn_directory; ! } ! LFD(Lpathname_name)(void) ! { ! check_arg(1); ! check_type_or_pathname_string_symbol_stream(&vs_base[0]); ! vs_base[0] = coerce_to_pathname(vs_base[0]); ! vs_base[0] = vs_base[0]->pn.pn_name; ! } ! LFD(Lpathname_type)(void) ! { ! check_arg(1); ! check_type_or_pathname_string_symbol_stream(&vs_base[0]); ! vs_base[0] = coerce_to_pathname(vs_base[0]); ! vs_base[0] = vs_base[0]->pn.pn_type; ! } LFD(Lpathname_version)(void) { --- 967,1057 ---- vs_base[0] = Cnil; } ! @(defun pathname_host (pathname &key ! (case `Cnil` case_supplied_p) ! &aux x) ! @ ! vs_mark; ! check_type_or_pathname_string_symbol_stream(&pathname); ! x = coerce_to_pathname(pathname); ! x = x->pn.pn_host; ! if (case == sKcommon) ! x=pathname_case_word(x,sKcommon); ! vs_reset; ! @(return x) ! @) ! @(defun pathname_device (pathname &key ! (case `Cnil` case_supplied_p) ! &aux x) ! @ ! vs_mark; ! check_type_or_pathname_string_symbol_stream(&pathname); ! x = coerce_to_pathname(pathname); ! x = x->pn.pn_device; ! if (case == sKcommon) ! x=pathname_case_word(x,sKcommon); ! vs_reset; ! @(return x) ! @) ! @(defun pathname_directory (pathname &key ! (case `Cnil` case_supplied_p) ! &aux x) ! @ ! object y,z; ! vs_mark; ! check_type_or_pathname_string_symbol_stream(&pathname); ! x = coerce_to_pathname(pathname); ! x = x->pn.pn_directory; ! if (case == sKcommon) { ! if (type_of(x) == t_string) ! x=pathname_case_word(x,sKcommon); ! else ! if (type_of(x) == t_cons) { ! z = x; ! y = make_cons( pathname_case_word(z->c.c_car,sKcommon), Cnil); ! x = y; ! vs_push(y); ! for (z = z->c.c_cdr; type_of(z) == t_cons; z = z->c.c_cdr) { ! y->c.c_cdr = make_cons( ! pathname_case_word(z->c.c_car,sKcommon), Cnil); ! y = y->c.c_cdr; ! } ! y->c.c_cdr = pathname_case_word(z,sKcommon); ! } ! } ! vs_reset; ! @(return x) ! @) ! @(defun pathname_name (pathname &key ! (case `Cnil` case_supplied_p) ! &aux x) ! @ ! vs_mark; ! check_type_or_pathname_string_symbol_stream(&pathname); ! x = coerce_to_pathname(pathname); ! x = x->pn.pn_name; ! if (case == sKcommon) ! x=pathname_case_word(x,sKcommon); ! vs_reset; ! @(return x) ! @) ! @(defun pathname_type (pathname &key ! (case `Cnil` case_supplied_p) ! &aux x) ! @ ! vs_mark; ! check_type_or_pathname_string_symbol_stream(&pathname); ! x = coerce_to_pathname(pathname); ! x = x->pn.pn_type; ! if (case == sKcommon) ! x=pathname_case_word(x,sKcommon); ! vs_reset; ! @(return x) ! @) LFD(Lpathname_version)(void) { *************** LFD(Lfile_namestring)(void) *** 660,666 **** = make_pathname(Cnil, Cnil, Cnil, vs_base[0]->pn.pn_name, vs_base[0]->pn.pn_type, ! vs_base[0]->pn.pn_version); vs_base[0] = namestring(vs_base[0]); } --- 1080,1087 ---- = make_pathname(Cnil, Cnil, Cnil, vs_base[0]->pn.pn_name, vs_base[0]->pn.pn_type, ! vs_base[0]->pn.pn_version, ! Cnil); vs_base[0] = namestring(vs_base[0]); } *************** LFD(Ldirectory_namestring)(void) *** 673,679 **** vs_base[0] = make_pathname(Cnil, Cnil, vs_base[0]->pn.pn_directory, ! Cnil, Cnil, Cnil); vs_base[0] = namestring(vs_base[0]); } --- 1094,1101 ---- vs_base[0] = make_pathname(Cnil, Cnil, vs_base[0]->pn.pn_directory, ! Cnil, Cnil, Cnil, ! Cnil); vs_base[0] = namestring(vs_base[0]); } *************** LFD(Lhost_namestring)(void) *** 710,727 **** Cnil : path->pn.pn_type, equalp(path->pn.pn_version, defaults->pn.pn_version) ? ! Cnil : path->pn.pn_version); @(return `namestring(path)`) @) void gcl_init_pathname(void) { Vdefault_pathname_defaults = make_special("*DEFAULT-PATHNAME-DEFAULTS*", ! make_pathname(Cnil, Cnil, Cnil, Cnil, Cnil, Cnil)); sKwild = make_keyword("WILD"); sKnewest = make_keyword("NEWEST"); sKstart = make_keyword("START"); --- 1132,1152 ---- Cnil : path->pn.pn_type, equalp(path->pn.pn_version, defaults->pn.pn_version) ? ! Cnil : path->pn.pn_version, ! Cnil); @(return `namestring(path)`) @) + void gcl_init_pathname(void) { Vdefault_pathname_defaults = make_special("*DEFAULT-PATHNAME-DEFAULTS*", ! make_pathname(Cnil, Cnil, Cnil, Cnil, Cnil, Cnil, Cnil)); sKwild = make_keyword("WILD"); + sKwildinf = make_keyword("WILD-INFERIORS"); sKnewest = make_keyword("NEWEST"); sKstart = make_keyword("START"); *************** gcl_init_pathname(void) *** 736,745 **** sKversion = make_keyword("VERSION"); sKdefaults = make_keyword("DEFAULTS"); sKroot = make_keyword("ROOT"); sKcurrent = make_keyword("CURRENT"); sKparent = make_keyword("PARENT"); ! sKper = make_keyword("PER"); } void --- 1161,1178 ---- sKversion = make_keyword("VERSION"); sKdefaults = make_keyword("DEFAULTS"); + sKper = make_keyword("PER"); sKroot = make_keyword("ROOT"); sKcurrent = make_keyword("CURRENT"); sKparent = make_keyword("PARENT"); ! sKabsolute = make_keyword("ABSOLUTE"); ! sKrelative = make_keyword("RELATIVE"); ! sKup = make_keyword("UP"); ! sKback = make_keyword("BACK"); ! sKlocal = make_keyword("LOCAL"); ! sKcommon = make_keyword("COMMON"); ! sKunspecific = make_keyword("UNSPECIFIC"); ! sKsys = make_keyword("SYS"); } void *** ../gcl-cvs/./o/print.d Thu Nov 6 17:08:10 2003 --- ./o/print.d Mon Apr 26 01:58:57 2004 *************** Foundation, 675 Mass Ave, Cambridge, MA *** 22,27 **** --- 22,38 ---- print.d */ + /* hacked by Michael Koehne (c) GNU LGPL + * kraehe (at) copyleft.de + * Sun Apr 25 07:43:08 CEST 2004 + * + * beware of new bugs^h^h^h^h features ! + * + * many thanks to pfdietz - not only for ircing at #lisp to explain a + * few bits to me, but even more for writing the ansi-test. This hack + * would never been possible without his regression test ! + * ------------------------------------------------------------------------- */ + #define NEED_ISFINITE #include "include.h" *************** DEFVAR("*PRINT-PACKAGE*",sSAprint_packag *** 1835,1840 **** --- 1846,1861 ---- DEFVAR("*PRINT-STRUCTURE*",sSAprint_structureA,SI,Cnil,""); DEF_ORDINARY("PRETTY-PRINT-FORMAT",sSpretty_print_format,SI,""); + /* + * those variables are only defined to make the ansi-test happy + * they are NOT YET implemented + */ + + DEFVAR("*PRINT-LINES*",sLAprint_linesA,LISP,Cnil,""); + DEFVAR("*PRINT-MISER-WIDTH*",sLAprint_miser_widthA,LISP,Cnil,""); + DEFVAR("*PRINT-RIGHT-MARGIN*",sLAprint_right_marginA,LISP,Cnil,""); + DEFVAR("*READ-EVAL*",sLAread_evalA,LISP,Ct,""); + void gcl_init_print() { *** ../gcl-cvs/./o/unixfsys.c Mon Apr 26 04:56:46 2004 --- ./o/unixfsys.c Tue Apr 27 06:01:27 2004 *************** FFN(Luser_homedir_pathname)(void) *** 523,547 **** } #ifdef BSD LFD(Ldirectory)(void) { char filename[MAXPATHLEN]; ! char command[MAXPATHLEN * 2]; FILE *fp; register int i, c; ! object *top = vs_top; char iobuffer[BUFSIZ]; extern FILE *popen(const char *, const char *); ! check_arg(1); check_type_or_pathname_string_symbol_stream(&vs_base[0]); vs_base[0] = coerce_to_pathname(vs_base[0]); if (vs_base[0]->pn.pn_name==Cnil && vs_base[0]->pn.pn_type==Cnil) { coerce_to_filename(vs_base[0], filename); strcat(filename, "*"); } else if (vs_base[0]->pn.pn_name==Cnil) { vs_base[0]->pn.pn_name = sKwild; coerce_to_filename(vs_base[0], filename); --- 523,563 ---- } + extern int namestring_resolve(); #ifdef BSD LFD(Ldirectory)(void) { char filename[MAXPATHLEN]; ! char command[MAXPATHLEN * 3]; FILE *fp; register int i, c; ! object *top; char iobuffer[BUFSIZ]; extern FILE *popen(const char *, const char *); + int wildversion=0; ! if (vs_top - vs_base < 1) ! too_few_arguments(); ! while (vs_top - vs_base > 1) ! vs_popp; ! ! top = vs_top; check_type_or_pathname_string_symbol_stream(&vs_base[0]); vs_base[0] = coerce_to_pathname(vs_base[0]); + + if (namestring_resolve(sKversion) && + (vs_base[0]->pn.pn_version == sKwild)) { + wildversion=1; + vs_base[0]->pn.pn_version = Cnil; + } if (vs_base[0]->pn.pn_name==Cnil && vs_base[0]->pn.pn_type==Cnil) { coerce_to_filename(vs_base[0], filename); strcat(filename, "*"); + if (wildversion) + vs_base[0]->pn.pn_version = sKwild; + wildversion=0; } else if (vs_base[0]->pn.pn_name==Cnil) { vs_base[0]->pn.pn_name = sKwild; coerce_to_filename(vs_base[0], filename); *************** LFD(Ldirectory)(void) *** 549,557 **** } else if (vs_base[0]->pn.pn_type==Cnil) { coerce_to_filename(vs_base[0], filename); strcat(filename, "*"); } else coerce_to_filename(vs_base[0], filename); ! sprintf(command, "ls -d %s 2> /dev/null", filename); fp = popen(command, "r"); setbuf(fp, iobuffer); for (;;) { --- 565,586 ---- } else if (vs_base[0]->pn.pn_type==Cnil) { coerce_to_filename(vs_base[0], filename); strcat(filename, "*"); + if (wildversion) + vs_base[0]->pn.pn_version = sKwild; + wildversion=0; } else coerce_to_filename(vs_base[0], filename); ! ! sprintf(command, "ls -d %s %s%s 2> /dev/null", ! filename, ! (wildversion ? filename : ""), ! (wildversion ? ".*" : "")); ! ! if (wildversion) { ! vs_base[0]->pn.pn_version = sKwild; ! wildversion=0; ! } ! fp = popen(command, "r"); setbuf(fp, iobuffer); for (;;) { *************** LFD(Ldirectory)() *** 586,596 **** --- 615,632 ---- char iobuffer[BUFSIZ]; struct direct dir; int i; + int wildversion=0; check_arg(1); check_type_or_pathname_string_symbol_stream(&vs_base[0]); vs_base[0] = coerce_to_pathname(vs_base[0]); + + if (namestring_resolve(sKversion) && + (vs_base[0]->pn.pn_version == sKwild)) { + wildversion=1; + vs_base[0]->pn.pn_version = Cnil; + } vs_push(vs_base[0]->pn.pn_name); vs_push(vs_base[0]->pn.pn_type); vs_base[0]->pn.pn_name = Cnil; *************** LFD(Ldirectory)() *** 598,603 **** --- 634,643 ---- coerce_to_filename(vs_base[0], filename); type = vs_base[0]->pn.pn_type = vs_pop; name = vs_base[0]->pn.pn_name = vs_pop; + if (wildversion) { + vs_base[0]->pn.pn_version = sKwild; + wildversion=0; + } i = strlen(filename); if (i > 1 && filename[i-1] == '/') filename[i-1] = '\0'; *************** LFD(Ldirectory)() *** 651,661 **** --- 691,708 ---- char iobuffer[BUFSIZ]; struct direct dir; int i; + int wildversion=0; check_arg(1); check_type_or_pathname_string_symbol_stream(&vs_base[0]); vs_base[0] = coerce_to_pathname(vs_base[0]); + + if (namestring_resolve(sKversion) && + (vs_base[0]->pn.pn_version == sKwild)) { + wildversion=1; + vs_base[0]->pn.pn_version = Cnil; + } vs_push(vs_base[0]->pn.pn_name); vs_push(vs_base[0]->pn.pn_type); vs_base[0]->pn.pn_name = Cnil; *************** LFD(Ldirectory)() *** 663,668 **** --- 710,719 ---- coerce_to_filename(vs_base[0], filename); type = vs_base[0]->pn.pn_type = vs_pop; name = vs_base[0]->pn.pn_name = vs_pop; + if (wildversion) { + vs_base[0]->pn.pn_version = sKwild; + wildversion=0; + } i = strlen(filename); if (i > 1 && filename[i-1] == '/') filename[i-1] = '\0'; *** ../gcl-cvs/./pcl/sys-package.lisp Sun Apr 25 09:33:25 2004 --- ./pcl/sys-package.lisp Sun Apr 25 21:29:14 2004 *************** *** 201,206 **** --- 201,208 ---- LISP::SET-MACRO-CHARACTER LISP::GET-MACRO-CHARACTER LISP::*BREAK-ON-WARNINGS* LISP::INPUT-STREAM-P LISP::*PRINT-PRETTY* LISP::*QUERY-IO* LISP::*PRINT-ARRAY* + LISP::*PRINT-LINES* LISP::*PRINT-MISER-WIDTH* + LISP::*PRINT-RIGHT-MARGIN* LISP::*READ-EVAL* LISP::DEFCFUN LISP::*LOAD-VERBOSE* LISP::FIND-IF LISP::POSITION LISP::MAKE-SEQUENCE LISP::TAG LISP::BOOLE-C2 LISP::SET-DISPATCH-MACRO-CHARACTER *************** *** 392,398 **** LISP::ED LISP::BOOLE-1 LISP::BOOLE-NAND LISP::BSD386 LISP::REAL LISP::&AUX LISP::GETHASH LISP::CLEAR-OUTPUT LISP::COMPLEXP LISP::STEP LISP::*STANDARD-INPUT* LISP::APPLY ! LISP::WITH-OPEN-STREAM LISP::ECASE LISP::&REST LISP::CCASE LISP::FCEILING LISP::CLRHASH LISP::PARSE-INTEGER LISP::LOGANDC2 LISP::COUNT LISP::DIRECTORY-NAMESTRING LISP::PRIN1 LISP::READ LISP::CDDR LISP::SGC LISP::SAVE --- 394,401 ---- LISP::ED LISP::BOOLE-1 LISP::BOOLE-NAND LISP::BSD386 LISP::REAL LISP::&AUX LISP::GETHASH LISP::CLEAR-OUTPUT LISP::COMPLEXP LISP::STEP LISP::*STANDARD-INPUT* LISP::APPLY ! LISP::WITH-OPEN-STREAM LISP::WITH-STANDARD-IO-SYNTAX ! LISP::ECASE LISP::&REST LISP::CCASE LISP::FCEILING LISP::CLRHASH LISP::PARSE-INTEGER LISP::LOGANDC2 LISP::COUNT LISP::DIRECTORY-NAMESTRING LISP::PRIN1 LISP::READ LISP::CDDR LISP::SGC LISP::SAVE *************** *** 514,520 **** LISP::PRINC LISP::SIMPLE-VECTOR LISP::NSUBST LISP::FBOUNDP LISP::SIMPLE-STRING LISP::SPICE LISP::TRACE LISP::METHOD-COMBINATION LISP::BOUNDP LISP::SYMBOL-NAME ! LISP::WITH-OPEN-STREAM LISP::UNSIGNED-BYTE LISP::HELP* LISP::NOTINLINE LISP::GET-MACRO-CHARACTER LISP::SET-MACRO-CHARACTER LISP::POP LISP::LIST-ALL-PACKAGES WALKER::VARIABLE-DECLARATION LISP::UNDEFINED-FUNCTION --- 517,524 ---- LISP::PRINC LISP::SIMPLE-VECTOR LISP::NSUBST LISP::FBOUNDP LISP::SIMPLE-STRING LISP::SPICE LISP::TRACE LISP::METHOD-COMBINATION LISP::BOUNDP LISP::SYMBOL-NAME ! LISP::WITH-OPEN-STREAM LISP::WITH-STANDARD-IO-SYNTAX ! LISP::UNSIGNED-BYTE LISP::HELP* LISP::NOTINLINE LISP::GET-MACRO-CHARACTER LISP::SET-MACRO-CHARACTER LISP::POP LISP::LIST-ALL-PACKAGES WALKER::VARIABLE-DECLARATION LISP::UNDEFINED-FUNCTION *************** *** 586,591 **** --- 590,597 ---- LISP::PLUSP LISP::CASE LISP::MACHINE-TYPE LISP::LOAD LISP::ENDP LISP::FRESH-LINE LISP::DEFCONSTANT LISP::SYMBOL LISP::VALUES LISP::SET-DIFFERENCE LISP::*PRINT-ARRAY* + LISP::*PRINT-LINES* LISP::*PRINT-MISER-WIDTH* + LISP::*PRINT-RIGHT-MARGIN* LISP::*READ-EVAL* LISP::SET-EXCLUSIVE-OR LISP::PROG2 LISP::DIVISION-BY-ZERO LISP::PHASE LISP::CAAAR LISP::ETYPECASE LISP::CTYPECASE LISP::NOT LISP::BOOLE-C2 LISP::NTH LISP::SPECIAL-OPERATOR-P *************** *** 822,828 **** LISP::PRINC LISP::SIMPLE-VECTOR LISP::NSUBST LISP::FBOUNDP LISP::SIMPLE-STRING LISP::SPICE LISP::TRACE LISP::METHOD-COMBINATION LISP::BOUNDP LISP::SYMBOL-NAME ! LISP::WITH-OPEN-STREAM LISP::UNSIGNED-BYTE LISP::HELP* LISP::NOTINLINE LISP::GET-MACRO-CHARACTER LISP::SET-MACRO-CHARACTER LISP::POP LISP::LIST-ALL-PACKAGES LISP::UNDEFINED-FUNCTION LISP::IEEE-FLOATING-POINT --- 828,835 ---- LISP::PRINC LISP::SIMPLE-VECTOR LISP::NSUBST LISP::FBOUNDP LISP::SIMPLE-STRING LISP::SPICE LISP::TRACE LISP::METHOD-COMBINATION LISP::BOUNDP LISP::SYMBOL-NAME ! LISP::WITH-OPEN-STREAM LISP::WITH-STANDARD-IO-SYNTAX ! LISP::UNSIGNED-BYTE LISP::HELP* LISP::NOTINLINE LISP::GET-MACRO-CHARACTER LISP::SET-MACRO-CHARACTER LISP::POP LISP::LIST-ALL-PACKAGES LISP::UNDEFINED-FUNCTION LISP::IEEE-FLOATING-POINT *************** *** 894,899 **** --- 901,908 ---- LISP::PLUSP LISP::CASE LISP::MACHINE-TYPE LISP::LOAD LISP::ENDP LISP::FRESH-LINE LISP::DEFCONSTANT LISP::SYMBOL LISP::VALUES LISP::SET-DIFFERENCE LISP::*PRINT-ARRAY* + LISP::*PRINT-LINES* LISP::*PRINT-MISER-WIDTH* + LISP::*PRINT-RIGHT-MARGIN* LISP::*READ-EVAL* LISP::SET-EXCLUSIVE-OR LISP::PROG2 LISP::DIVISION-BY-ZERO LISP::PHASE LISP::CAAAR LISP::ETYPECASE LISP::CTYPECASE LISP::NOT LISP::BOOLE-C2 LISP::NTH LISP::SPECIAL-OPERATOR-P *************** *** 1158,1164 **** LISP::DOUBLE-FLOAT-EPSILON LISP::DOUBLE-FLOAT-NEGATIVE-EPSILON LISP::BOOLE-IOR LISP::ASSERT LISP::ADJUSTABLE-ARRAY-P LISP::COPY-TREE LISP::CLEAR-OUTPUT LISP::CODE-CHAR ! LISP::STRING-CAPITALIZE LISP::/// LISP::WITH-OPEN-STREAM SYSTEM::*INFO-WINDOW* LISP::REST LISP::ACOS LISP::MACHINE-TYPE LISP::DENOMINATOR LISP::TRACE LISP::FLOATING-POINT-INEXACT LISP::*READ-BASE* LISP::CDR SYSTEM::BEGIN LISP::STRING-EQUAL --- 1167,1174 ---- LISP::DOUBLE-FLOAT-EPSILON LISP::DOUBLE-FLOAT-NEGATIVE-EPSILON LISP::BOOLE-IOR LISP::ASSERT LISP::ADJUSTABLE-ARRAY-P LISP::COPY-TREE LISP::CLEAR-OUTPUT LISP::CODE-CHAR ! LISP::STRING-CAPITALIZE LISP::/// ! LISP::WITH-OPEN-STREAM LISP::WITH-STANDARD-IO-SYNTAX SYSTEM::*INFO-WINDOW* LISP::REST LISP::ACOS LISP::MACHINE-TYPE LISP::DENOMINATOR LISP::TRACE LISP::FLOATING-POINT-INEXACT LISP::*READ-BASE* LISP::CDR SYSTEM::BEGIN LISP::STRING-EQUAL *************** *** 1214,1219 **** --- 1224,1231 ---- LISP::*MACROEXPAND-HOOK* LISP::PLUSP LISP::INTERNAL-TIME-UNITS-PER-SECOND LISP::LIST* LISP::*PRINT-ARRAY* LISP::FILE-WRITE-DATE LISP::LAMBDA + LISP::*PRINT-LINES* LISP::*PRINT-MISER-WIDTH* + LISP::*PRINT-RIGHT-MARGIN* LISP::*READ-EVAL* LISP::ED LISP::OPEN LISP::AREF LISP::RASSOC-IF LISP::LOGORC1 LISP::PROCLAIM LISP::CHAR-SUPER-BIT LISP::APPEND LISP::CONCATENATE LISP::WRITE-STRING LISP::MISMATCH *************** *** 1473,1479 **** LISP::DOUBLE-FLOAT-EPSILON LISP::DOUBLE-FLOAT-NEGATIVE-EPSILON LISP::BOOLE-IOR LISP::ASSERT LISP::ADJUSTABLE-ARRAY-P LISP::COPY-TREE LISP::CLEAR-OUTPUT LISP::CODE-CHAR ! LISP::STRING-CAPITALIZE LISP::/// LISP::WITH-OPEN-STREAM LISP::REST LISP::ACOS LISP::MACHINE-TYPE LISP::DENOMINATOR LISP::TRACE LISP::FLOATING-POINT-INEXACT LISP::*READ-BASE* LISP::CDR LISP::STRING-EQUAL LISP::GMP LISP::DELETE-FILE --- 1485,1492 ---- LISP::DOUBLE-FLOAT-EPSILON LISP::DOUBLE-FLOAT-NEGATIVE-EPSILON LISP::BOOLE-IOR LISP::ASSERT LISP::ADJUSTABLE-ARRAY-P LISP::COPY-TREE LISP::CLEAR-OUTPUT LISP::CODE-CHAR ! LISP::STRING-CAPITALIZE LISP::/// ! LISP::WITH-OPEN-STREAM LISP::WITH-STANDARD-IO-SYNTAX LISP::REST LISP::ACOS LISP::MACHINE-TYPE LISP::DENOMINATOR LISP::TRACE LISP::FLOATING-POINT-INEXACT LISP::*READ-BASE* LISP::CDR LISP::STRING-EQUAL LISP::GMP LISP::DELETE-FILE *************** *** 1526,1531 **** --- 1539,1546 ---- LISP::MULTIPLE-VALUE-CALL LISP::*MACROEXPAND-HOOK* LISP::PLUSP LISP::INTERNAL-TIME-UNITS-PER-SECOND LISP::LIST* LISP::*PRINT-ARRAY* LISP::FILE-WRITE-DATE LISP::LAMBDA + LISP::*PRINT-LINES* LISP::*PRINT-MISER-WIDTH* + LISP::*PRINT-RIGHT-MARGIN* LISP::*READ-EVAL* LISP::ED LISP::OPEN LISP::AREF LISP::RASSOC-IF LISP::LOGORC1 LISP::PROCLAIM LISP::CHAR-SUPER-BIT LISP::APPEND LISP::CONCATENATE LISP::WRITE-STRING LISP::MISMATCH *************** *** 1782,1788 **** LISP::DOUBLE-FLOAT-EPSILON LISP::DOUBLE-FLOAT-NEGATIVE-EPSILON LISP::BOOLE-IOR LISP::ASSERT LISP::ADJUSTABLE-ARRAY-P LISP::COPY-TREE LISP::CLEAR-OUTPUT LISP::CODE-CHAR ! LISP::STRING-CAPITALIZE LISP::/// LISP::WITH-OPEN-STREAM LISP::REST LISP::ACOS LISP::MACHINE-TYPE LISP::DENOMINATOR LISP::TRACE LISP::FLOATING-POINT-INEXACT LISP::*READ-BASE* LISP::CDR LISP::STRING-EQUAL LISP::GMP LISP::DELETE-FILE --- 1797,1804 ---- LISP::DOUBLE-FLOAT-EPSILON LISP::DOUBLE-FLOAT-NEGATIVE-EPSILON LISP::BOOLE-IOR LISP::ASSERT LISP::ADJUSTABLE-ARRAY-P LISP::COPY-TREE LISP::CLEAR-OUTPUT LISP::CODE-CHAR ! LISP::STRING-CAPITALIZE LISP::/// ! LISP::WITH-OPEN-STREAM LISP::WITH-STANDARD-IO-SYNTAX LISP::REST LISP::ACOS LISP::MACHINE-TYPE LISP::DENOMINATOR LISP::TRACE LISP::FLOATING-POINT-INEXACT LISP::*READ-BASE* LISP::CDR LISP::STRING-EQUAL LISP::GMP LISP::DELETE-FILE *************** *** 1833,1838 **** --- 1849,1856 ---- LISP::MULTIPLE-VALUE-CALL LISP::*MACROEXPAND-HOOK* LISP::PLUSP LISP::INTERNAL-TIME-UNITS-PER-SECOND LISP::LIST* LISP::*PRINT-ARRAY* LISP::FILE-WRITE-DATE LISP::LAMBDA + LISP::*PRINT-LINES* LISP::*PRINT-MISER-WIDTH* + LISP::*PRINT-RIGHT-MARGIN* LISP::*READ-EVAL* LISP::ED LISP::OPEN LISP::AREF LISP::RASSOC-IF LISP::LOGORC1 LISP::PROCLAIM LISP::CHAR-SUPER-BIT LISP::APPEND LISP::CONCATENATE LISP::WRITE-STRING LISP::MISMATCH *************** *** 2088,2094 **** LISP::DOUBLE-FLOAT-EPSILON LISP::DOUBLE-FLOAT-NEGATIVE-EPSILON LISP::BOOLE-IOR LISP::ASSERT LISP::ADJUSTABLE-ARRAY-P LISP::COPY-TREE LISP::CLEAR-OUTPUT LISP::CODE-CHAR ! LISP::STRING-CAPITALIZE LISP::/// LISP::WITH-OPEN-STREAM LISP::REST LISP::ACOS LISP::MACHINE-TYPE LISP::DENOMINATOR LISP::TRACE LISP::FLOATING-POINT-INEXACT LISP::*READ-BASE* LISP::CDR LISP::STRING-EQUAL LISP::GMP LISP::DELETE-FILE --- 2106,2113 ---- LISP::DOUBLE-FLOAT-EPSILON LISP::DOUBLE-FLOAT-NEGATIVE-EPSILON LISP::BOOLE-IOR LISP::ASSERT LISP::ADJUSTABLE-ARRAY-P LISP::COPY-TREE LISP::CLEAR-OUTPUT LISP::CODE-CHAR ! LISP::STRING-CAPITALIZE LISP::/// ! LISP::WITH-OPEN-STREAM LISP::WITH-STANDARD-IO-SYNTAX LISP::REST LISP::ACOS LISP::MACHINE-TYPE LISP::DENOMINATOR LISP::TRACE LISP::FLOATING-POINT-INEXACT LISP::*READ-BASE* LISP::CDR LISP::STRING-EQUAL LISP::GMP LISP::DELETE-FILE *************** *** 2141,2146 **** --- 2160,2167 ---- LISP::MULTIPLE-VALUE-CALL LISP::*MACROEXPAND-HOOK* LISP::PLUSP LISP::INTERNAL-TIME-UNITS-PER-SECOND LISP::LIST* LISP::*PRINT-ARRAY* LISP::FILE-WRITE-DATE LISP::LAMBDA + LISP::*PRINT-LINES* LISP::*PRINT-MISER-WIDTH* + LISP::*PRINT-RIGHT-MARGIN* LISP::*READ-EVAL* LISP::ED LISP::OPEN LISP::AREF LISP::RASSOC-IF LISP::LOGORC1 LISP::PROCLAIM LISP::CHAR-SUPER-BIT LISP::APPEND LISP::CONCATENATE LISP::WRITE-STRING LISP::MISMATCH