(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "INTERLISP") (filecreated " 3-Nov-86 16:40:40" ("compiled on " {eris}sources>cmlpathname.\;20) " 3-Nov-86 15:43:00" "COMPILE-FILEd" |in| "Xerox Lisp 31-Oct-86 ..." |dated| "31-Oct-86 17:48:39") (filecreated "31-Oct-86 22:51:10" {eris}sources>cmlpathname.\;20 38207 |changes| |to:| (fns %print-pathname) |previous| |date:| "28-Oct-86 22:16:40" {eris}sources>cmlpathname.\;19) (rpaqq cmlpathnamecoms ((* |;;| "Common Lisp pathname functions") (prop filetype cmlpathname) (coms (* |;;| "useful macros") (functions %wild-name %component-string %unpackfile1)) (structures pathname) ( fns %print-pathname cl:make-pathname cl:pathname-host cl:pathname-device cl:pathname-directory cl:pathname-name cl:pathname-type cl:pathname-version) (fns pathname cl:merge-pathnames file-name cl:host-namestring cl:enough-namestring %numeric-string-p) (functions cl:namestring cl:parse-namestring parse-namestring1 cl:truename) (functions %make-pathname) (functions interlisp-namestring) (functions %pathname-equal) (functions %initialize-default-pathname) (variables *default-pathname-defaults*) ( coms (* |;;| "Interlisp-D compatibility") (functions unpackpathname.string)) (functions cl:file-namestring cl:directory-namestring) (declare\: donteval@load docopy (p ( %initialize-default-pathname))) (declare\: donteval@load doeval@compile dontcopy compilervars (addvars (nlama) (nlaml) (lama cl:enough-namestring cl:host-namestring file-name cl:merge-pathnames pathname cl:pathname-version cl:pathname-type cl:pathname-name cl:pathname-directory cl:pathname-device cl:pathname-host cl:make-pathname %print-pathname))))) (putprops cmlpathname filetype cl:compile-file) |expand-%WILD-NAME| d1 (l (1 si::$$macro-environment 0 si::$$macro-form)) @ggHhhonil (11 s 8 let) ( 21 ((cl:if (string-equal s "*") :wild s))) (setf-macro-function (quote %wild-name) (quote |expand-%WILD-NAME|)) |expand-%COMPONENT-STRING| d1 (l (1 si::$$macro-environment 0 si::$$macro-form)) @gHonil (8 or) ( 13 ("")) (setf-macro-function (quote %component-string) (quote |expand-%COMPONENT-STRING|)) |expand-%UNPACKFILE1| d1 (l (1 si::$$macro-environment 0 si::$$macro-form)) @ HHZJ\L^_N__O__O_ggOhggOggOgOKMhhiggOKMhohhgIOhhhggIOhgggOgOKMhhiggOKMhohhhhnil (183 substring 180 or 164 subatom 159 cond 156 return 153 |then| 143 eqmemb 140 |elseif| 122 cons 97 substring 94 or 78 subatom 73 cond 70 cons 65 setq 62 |then| 54 not 51 |if|) ( 196 ("") 110 ("")) (setf-macro-function (quote %unpackfile1) (quote |expand-%UNPACKFILE1|)) (cl::set-parsed-structure (quote pathname) (quote (cl::ps pathname %%make-pathname (host device directory name type version) cl::datatype nil nil %pathname- (%%make-pathname . :none) cl:pathnamep %print-pathname copy-pathname nil 0 ((host nil t nil (pathname 0 pointer) %pathname-host) (device nil t nil (pathname 2 pointer) %pathname-device) (directory nil t nil (pathname 4 pointer) %pathname-directory) (name nil t nil (pathname 6 pointer) %pathname-name) (type nil t nil (pathname 8 pointer) %pathname-type) (version nil t nil (pathname 10 pointer) %pathname-version)) ((host nil t nil (pathname 0 pointer) %pathname-host) (device nil t nil (pathname 2 pointer) %pathname-device) ( directory nil t nil (pathname 4 pointer) %pathname-directory) (name nil t nil (pathname 6 pointer) %pathname-name) (type nil t nil (pathname 8 pointer) %pathname-type) (version nil t nil (pathname 10 pointer) %pathname-version)) nil nil (pointer pointer pointer pointer pointer pointer) nil))) (si::%structure-declare-datatype (quote pathname) (quote (pointer pointer pointer pointer pointer pointer)) (quote ((pathname 0 pointer) (pathname 2 pointer) (pathname 4 pointer) (pathname 6 pointer) (pathname 8 pointer) (pathname 10 pointer))) 12 (quote cl::structure-object)) cl::|type-expand-PATHNAME| d1 (l (0 $$type-form)) onil nil ( 3 (datatype pathname)) (put (quote pathname) (quote type-expander) (quote cl::|type-expand-PATHNAME|)) cl:pathnamep d1 (l (0 cl::object)) @inil (3 pathname) () %pathname-host d1 (l (0 pathname)) @nil (3 pathname) () %pathname-device d1 (l (0 pathname)) @nil (3 pathname) () %pathname-directory d1 (l (0 pathname)) @nil (3 pathname) () %pathname-name d1 (l (0 pathname)) @nil (3 pathname) () %pathname-type d1 (l (0 pathname)) @nil (3 pathname) () %pathname-version d1 (l (0 pathname)) @ nil (3 pathname) () (remprop (quote %pathname-host) (quote setf-method-expander)) (putprop (quote %pathname-host) (quote setf-inverse) (quote %%setf-%pathname-host)) %%setf-%pathname-host d1 (l (1 cl::value 0 pathname)) @AAnil (3 pathname) () (remprop (quote %pathname-device) (quote setf-method-expander)) (putprop (quote %pathname-device) (quote setf-inverse) (quote %%setf-%pathname-device)) %%setf-%pathname-device d1 (l (1 cl::value 0 pathname)) @AAnil (3 pathname) () (remprop (quote %pathname-directory) (quote setf-method-expander)) (putprop (quote %pathname-directory) (quote setf-inverse) (quote %%setf-%pathname-directory)) %%setf-%pathname-directory d1 (l (1 cl::value 0 pathname)) @AAnil (3 pathname) () (remprop (quote %pathname-name) (quote setf-method-expander)) (putprop (quote %pathname-name) (quote setf-inverse) (quote %%setf-%pathname-name)) %%setf-%pathname-name d1 (l (1 cl::value 0 pathname)) @AAnil (3 pathname) () (remprop (quote %pathname-type) (quote setf-method-expander)) (putprop (quote %pathname-type) (quote setf-inverse) (quote %%setf-%pathname-type)) %%setf-%pathname-type d1 (l (1 cl::value 0 pathname)) @AAnil (3 pathname) () (remprop (quote %pathname-version) (quote setf-method-expander)) (putprop (quote %pathname-version) (quote setf-inverse) (quote %%setf-%pathname-version)) %%setf-%pathname-version d1 (l (1 cl::value 0 pathname)) @A Anil (3 pathname) () %%make-pathname d1 (l (0 |-args-|)) BeHkJdIhHkKdJhHkNdMh_Hk__OdOh_Hk__OdOh_Hk__OdOh_ `_"IO"LO"OO"OO"OO"O  O"agJkaOJlZ>agKkaOKl[>agNkaINl^8agOkaJOl_6agOkaIOl_5agOkaHOl_4nil (300 :version 276 :type 252 :name 231 :directory 210 :device 189 :host 178 pathname 169 pathname 160 pathname 151 pathname 143 pathname 135 pathname 129 |PATHNAMETYPE#|) () copy-pathname d1 (l (0 pathname)) [@HB`H@H@H@H@H@H@  HigHg b(84 check-type-fail) (81 pathname 77 pathname 66 pathname 57 pathname 48 pathname 39 pathname 30 pathname 21 pathname 13 |PATHNAMETYPE#| 7 pathname) () %print-pathname d1 (l (2 d 1 stream 0 s)) Aog@ (14 cl:format 11 cl:namestring) (7 pathname) ( 4 "#.(~S ~S)") cl:make-pathname d1 (l (0 |-args-|)) eHkJdIhiHkLdKhZiHk__OdO h^_i_Hk__OdOh__i_Hk_ _O dOh__"i_$Hk_(_&O(dO&h_$_*i_,Hk_0_.O0dO.h_,_2IJO` ]G _4JO4 NO4 _OO4 _OO4 _"O$O4 _*O,O4 _2MMg agJkaJlZagLkaLl\agOkaOl_agOkaOl_agO kaO l_ agO(kaO(l_(agO0kaO0l_0MOdOg OO"dO"g O*dO*g O2 (501 %make-pathname 495 coerce 480 coerce 463 coerce 282 coerce 265 %pathname-version 254 %pathname-type 243 %pathname-name 232 %pathname-directory 221 %pathname-device 213 %pathname-host 203 pathname 197 %pathname-host) (492 cl:simple-string 477 cl:simple-string 460 cl:simple-string 427 :version 403 :type 379 :name 355 :directory 331 :device 310 :host 289 :defaults 279 cl:simple-string 194 *default-pathname-defaults*) () cl:pathname-host d1 (l (0 pathname)) @d @ (14 %pathname-host 11 pathname 4 cl:pathnamep) nil () cl:pathname-device d1 (l (0 pathname)) @d @ (14 %pathname-device 11 pathname 4 cl:pathnamep) nil () cl:pathname-directory d1 (l (0 pathname)) @d @ (14 %pathname-directory 11 pathname 4 cl:pathnamep) nil () cl:pathname-name d1 (l (0 pathname)) @d @ (14 %pathname-name 11 pathname 4 cl:pathnamep) nil () cl:pathname-type d1 (l (0 pathname)) @d @ (14 %pathname-type 11 pathname 4 cl:pathnamep) nil () cl:pathname-version d1 (l (0 pathname)) @d @ (14 %pathname-version 11 pathname 4 cl:pathnamep) nil () pathname d1 (l (0 thing)) @ (6 cl:values 3 cl:parse-namestring) nil () cl:merge-pathnames d1 (l (0 |-args-|)) yekaalH`lalHhlaI J L L _L M OM L M NM L M L NM K (118 %make-pathname 111 %pathname-version 103 %pathname-version 99 %pathname-type 93 %pathname-type 89 %pathname-name 82 %pathname-directory 76 %pathname-directory 72 %pathname-device 64 %pathname-host 58 %pathname-host 51 %pathname-device 46 %pathname-name 41 pathname 36 pathname) (16 *default-pathname-defaults*) () file-name d1 (l (0 file)) @ d o (16 mkstring 7 streamp 3 fullname) nil ( 12 "") cl:host-namestring d1 (l (0 pathname)) @ o(6 %pathname-host 3 pathname) nil ( 12 "") cl:enough-namestring d1 (l (0 |-args-|))  eka lH`laI J K K K _K _K _o_h_MNyOSO(OOL o gOoO _OOOL :zgOoOo L o gOO _i_L o {gOoNo _cL o OM_HO(256 cl:string-not-equal 247 %pathname-device 237 cl:concatenate 215 cl:equalp 206 %pathname-directory 193 cl:concatenate 181 cl:string-not-equal 172 %pathname-name 167 cl:concatenate 144 %pathname-version 126 cl:concatenate 110 cl:string-not-equal 101 %pathname-type 59 %pathname-version 52 %pathname-type 45 %pathname-name 40 %pathname-directory 35 %pathname-device 30 pathname 25 pathname) (222 cl:simple-string 186 cl:simple-string 150 cl:simple-string 115 cl:simple-string 16 *default-pathname-defaults*) ( 253 "" 233 ">" 228 "<" 212 "" 178 "" 164 "" 156 ";" 121 "." 107 "" 66 "") %numeric-string-p d1 (p 1 char i 0 string) I@ A@QHkٻHKHغHCjhiKk[JMLKLK¹l0IIl9hi(3 cl:stringp) nil () cl:namestring d1 (l (0 pathname)) @d @do bd a@ @ @ @ @ hHgoHo IgNI JgNoJdgoo KgNKdgo LgNoLdgo M2gNMdgogMogoM N(219 cl:concatenate 216 cl:concatenate 213 cl:princ-to-string 168 cl:concatenate 141 cl:concatenate 118 cl:concatenate 86 cl:concatenate 75 cl:concatenate 55 %pathname-version 50 %pathname-type 45 %pathname-name 40 %pathname-directory 35 %pathname-device 28 %pathname-host 22 pathname 4 streamp) (205 cl:simple-string 193 :newest 181 :wild 175 cl:simple-string 158 :wild 148 cl:simple-string 131 :wild 125 cl:simple-string 103 :wild 93 cl:simple-string 81 cl:simple-string 63 cl:simple-string 11 stream) ( 209 ";" 201 "" 188 ";*" 165 "*" 153 "." 138 "*" 114 ">" 110 "*" 98 "<" 72 "}" 67 "{" 18 "") cl:parse-namestring d1 (l (0 |-args-|)) ekalHhlalH`laHlMdLNjHl__OdOMh_Hl__OdOMK`JK I_d FIg YfagMkaMl]agOkaOl_agOl_IN OdI YI YoI OI _INO __gOg'gOg'gOg'do ggOg'do ggOg'do ggOg'_Odo go gO NO (391 cl:values 383 cl:make-pathname 379 mkatom 369 cl:equal 355 cl:equal 328 string-equal 306 string-equal 284 string-equal 243 parse-namestring1 240 mkstring 237 cl:subseq 227 cl:length 219 cl:error 209 cl:symbol-name 198 file-name 185 cl:values 116 coerce 106 cl:stringp 98 %pathname-host) (373 :wild 360 :newest 341 version 336 :version 333 :wild 319 type 314 :type 311 :wild 297 name 292 :name 289 :wild 275 directory 270 :directory 266 device 261 :device 257 host 252 :host 204 litatom 192 stream 179 pathname 164 :junk-allowed 142 :end 123 :start 113 cl:simple-string 91 *default-pathname-defaults* 27 *default-pathname-defaults*) ( 366 "*" 352 "" 325 "*" 303 "*" 281 "*" 215 "This is of an inappropriate type for parse-namestring: ~S") parse-namestring1 d1 (l (0 file))  k@Hhl-@d '@d3 d@ Hg@hb @k dl{l}dl[l]l(OHOg_mm_@OO oOM]HM @H dl/l/@Hk Ydl
l>@Hk Yh!@HkIk ogMIkظi_@HY ^HM @HIk oKNl.gg[MLNl.gig:g@H dlPg$dlAHkԸgdlTdlSggMNIkXl'IkYNl/Nl>@IkY ^l.Ndl!dl;Nl. Ko@Ik Z@Jk ZJ3 O3@HOk ogMOkظh_NHIHM (651 dreverse 612 substring 590 nthchar 581 strpos 543 nthcharcode 456 nthcharcode 403 substring 393 dreverse 381 nthcharcode 354 substring 338 lastchpos 315 lastchpos 300 nthcharcode 293 dreverse 275 substring 232 nthcharcode 204 dreverse 197 nthcharcode 161 substring 152 lastchpos 135 dreverse 110 substring 95 \\upf.nextpos 64 nthcharcode 58 \\illegal.arg 21 cl:stringp) (621 subdirectory 501 version 496 temporary 480 account 465 protection 448 \; 443 type 437 \; 423 name 419 \; 363 directory 255 subdirectory 192 directory 186 return 170 device 119 host 46 name 34 stream) ( 618 "" 574 "." 409 "" 360 "" 281 "" 167 "" 116 "") cl:truename d1 (l (0 pathname)) 1@d @do@  Ho@ H(45 cl:error 42 cl:namestring 28 cl:probe-file 24 cl:error 4 streamp) (12 stream) ( 38 "The file ~S does not exist." 20 "The stream ~S has no corresponding named file.") %make-pathname d1 (l (5 version 4 type 3 name 2 directory 1 device 0 host)) g@gAgBgCgDgE (27 %%make-pathname) (22 :version 18 :type 14 :name 10 :directory 6 :device 2 :host) () interlisp-namestring d1 (l (0 pathname)) @d @do bd @ @ @ @ @ oHoHo INI JNoJdgoo KNKdgo LNoLdgo M2NMdgogoMooM N(200 concat 197 concat 194 cl:princ-to-string 149 concat 125 concat 105 concat 77 concat 69 concat 48 %pathname-version 44 %pathname-type 40 %pathname-name 36 %pathname-directory 32 %pathname-device 28 %pathname-host 22 pathname 4 streamp) (171 :newest 159 :wild 139 :wild 115 :wild 91 :wild 11 stream) ( 190 ";" 185 "" 177 ";" 166 ";*" 146 "*" 134 "." 122 "*" 102 ">" 98 "*" 86 "<" 66 "}" 61 "{" 52 "" 18 "") %pathname-equal d1 (l (1 pathname2 0 pathname1)) N@ A A@ A 4@ A '@ A @ A @ A (75 cl:equal 72 %pathname-version 68 %pathname-version 62 cl:equal 59 %pathname-type 55 %pathname-type 49 cl:equal 46 %pathname-name 42 %pathname-name 36 cl:equal 33 %pathname-directory 29 %pathname-directory 23 cl:equal 20 %pathname-device 16 %pathname-device 10 cl:equal 7 %pathname-host 3 %pathname-host) nil () %initialize-default-pathname d1 nil *g g`dg dg `(36 %%setf-%pathname-version 26 cl:parse-namestring 23 filenamefield 5 boundp) (39 *default-pathname-defaults* 33 :newest 29 *default-pathname-defaults* 20 host 16 \\connected.directory 12 \\connected.directory 9 {dsk} 2 \\connected.directory) () (cl:proclaim (quote (global *default-pathname-defaults*))) unpackpathname.string d1 (l (3 atomflg 2 dirflg 1 onefieldflg 0 file)) A@ XvgCjH edAo bg@ >Adg@ 0g@ %Adg@ g@ Ag@ CH HHHh@ XgCH Hh@ XgCH Hh@ XgCH Hh@ XgCH Hh@ XgCH H h (251 \\append2 248 \\append2 245 \\append2 242 \\append2 239 \\append2 233 mkstring 228 mkatom 216 cl:pathname-version 207 mkatom 195 cl:pathname-type 186 mkatom 174 cl:pathname-name 165 mkatom 153 cl:pathname-directory 144 mkatom 132 cl:pathname-device 119 mkatom 110 cl:pathname-version 98 cl:pathname-type 87 cl:pathname-name 73 cl:pathname-directory 62 cl:pathname-device 48 cl:pathname-host 36 cl:intersection 22 mkatom 9 cl:pathname-host) (222 version 201 extension 180 name 159 directory 138 device 103 version 92 extension 80 name 67 directory 55 device 42 host 15 host) ( 33 (host device directory name extension version)) cl:file-namestring d1 (l (0 pathname)) f@ !gH ooH o H Z8gIJdgo"goJogoJ I(97 cl:concatenate 94 cl:concatenate 91 cl:princ-to-string 41 %pathname-version 36 cl:concatenate 27 %pathname-type 13 %pathname-name 3 pathname) (83 cl:simple-string 65 :newest 53 :wild 47 cl:simple-string 9 cl:simple-string) ( 87 ";" 79 "" 71 ";" 60 ";*" 33 "" 23 "." 19 "") cl:directory-namestring d1 (l (0 pathname)) @ o(6 %pathname-directory 3 pathname) nil ( 12 "") (%initialize-default-pathname) (putprops cmlpathname copyright ("Xerox Corporation" 1986)) nil