diff --git a/sources/ADIR b/sources/ADIR
index 7fe32da3..c2f27f11 100644
--- a/sources/ADIR
+++ b/sources/ADIR
@@ -1,10 +1,11 @@
-(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")
-(FILECREATED "13-Jun-2021 11:25:58" {DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>ADIR.;9 65815  
+(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-      changes to%:  (FNS OPENSTREAM)
+(FILECREATED " 5-Jan-2022 11:06:37" {DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>ADIR.;10 65596  
 
-      previous date%: "21-Mar-2021 21:59:07" 
-{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>ADIR.;8)
+      :CHANGES-TO (FNS UNPACKFILENAME.STRING)
+
+      :PREVIOUS-DATE "13-Jun-2021 11:25:58" 
+{DSK}<Users>kaplan>Local>medley3.5>my-medley>sources>ADIR.;9)
 
 
 (* ; "
@@ -14,14 +15,14 @@ Copyright (c) 1981-1988, 1990-1992, 1920, 2017, 2020-2021 by Venue & Xerox Corpo
 (PRETTYCOMPRINT ADIRCOMS)
 
 (RPAQQ ADIRCOMS
-       [[COMS                                                (* ; "user-level i/o routines")
+       [[COMS                                                (* ; "user-level i/o routines")
               (FNS DELFILE FULLNAME INFILE INFILEP IOFILE OPENFILE OPENSTREAM OUTFILE OUTFILEP 
                    RENAMEFILE SIMPLE.FINDFILE VMEMSIZE \COPYSYS \FLUSHVM \LOGOUT0)
               (CONSTANTS (MULTIPLE.STREAMS.PER.FILE.ALLOWED T))
               (P (MOVD? 'SIMPLE.FINDFILE 'FINDFILE NIL T))
               (DECLARE%: DONTEVAL@LOAD DOCOPY (P 
 
-                                       (* ;; "for the benefit of the call to PATHNAMEP in OPENSTREAM.  PATHNAMEP (and pathnames) get defined much later in the loadup.")
+                                       (* ;; "for the benefit of the call to PATHNAMEP in OPENSTREAM.  PATHNAMEP (and pathnames) get defined much later in the loadup.")
 
                                                  (MOVD? 'NILL 'CL:PATHNAMEP]
         (COMS (FNS UNPACKFILENAME UNPACKFILENAME.STRING LASTCHPOS \UPF.NEXTPOS \UPF.TEMPFILEP 
@@ -30,8 +31,7 @@ Copyright (c) 1981-1988, 1990-1992, 1920, 2017, 2020-2021 by Venue & Xerox Corpo
                                          PACKFILENAME.ASSEMBLE UNPACKFILE1))
               (VARS \FILENAME.SYNTAX)
               (GLOBALVARS \FILENAME.SYNTAX))
-        (COMS                                                (* ; 
-                                                           "saving and restoring system state")
+        (COMS                                                (* ; "saving and restoring system state")
               (FNS LOGOUT MAKESYS SYSOUT SAVEVM HERALD INTERPRET.REM.CM \USEREVENT)
               (ADDVARS (AROUNDEXITFNS))
               (INITVARS (HERALDSTRING "")
@@ -274,7 +274,7 @@ Copyright (c) 1981-1988, 1990-1992, 1920, 2017, 2020-2021 by Venue & Xerox Corpo
 (DECLARE%: DONTEVAL@LOAD DOCOPY 
 
 
-(* ;; "for the benefit of the call to PATHNAMEP in OPENSTREAM.  PATHNAMEP (and pathnames) get defined much later in the loadup.")
+(* ;; "for the benefit of the call to PATHNAMEP in OPENSTREAM.  PATHNAMEP (and pathnames) get defined much later in the loadup.")
 
 
 (MOVD? 'NILL 'CL:PATHNAMEP)
@@ -286,10 +286,13 @@ Copyright (c) 1981-1988, 1990-1992, 1920, 2017, 2020-2021 by Venue & Xerox Corpo
     (UNPACKFILENAME.STRING FILE ONEFIELDFLG NIL OSTYPE T])
 
 (UNPACKFILENAME.STRING
-  [LAMBDA (FILE ONEFIELDFLG DIRFLG OSTYPE PACKFLG CLFLG) (* ; "Edited 30-Mar-90 22:37 by nm")
+  [LAMBDA (FILE ONEFIELDFLG DIRFLG OSTYPE PACKFLG CLFLG)     (* ; "Edited  5-Jan-2022 11:03 by rmk")
+                                                             (* ; "Edited 30-Mar-90 22:37 by nm")
 
 (* ;;; "Given a string or atom representation of a file name, unpack it into its component parts")
 
+(* ;;; "rmk: devices must come before directories.")
+
     (PROG ((POS 1)
            (LEN (NCHARS FILE))
            TEM BEYONDNAME BEYONDEXT VAL CODE HOSTP SUBDIREND FIRSTDOT SECONDDOT USEDSEMI)
@@ -302,7 +305,7 @@ Copyright (c) 1981-1988, 1990-1992, 1920, 2017, 2020-2021 by Venue & Xerox Corpo
              ((TYPEP FILE 'PATHNAME)
               (RETURN (UNPACKPATHNAME.STRING FILE ONEFIELDFLG DIRFLG PACKFLG)))
              [(STREAMP FILE)                                 (* ; 
-                                               "For streams, use full name.  If anonymous, fake it")
+                                                 "For streams, use full name.  If anonymous, fake it")
               (SETQ FILE (OR (ffetch FULLFILENAME of FILE)
                              (RETURN (COND
                                         (ONEFIELDFLG (AND (EQ ONEFIELDFLG 'NAME)
@@ -316,12 +319,12 @@ Copyright (c) 1981-1988, 1990-1992, 1920, 2017, 2020-2021 by Venue & Xerox Corpo
                                                  FILE 2)
                                           0))))
                    (%[                                       (* ; 
-                                                  "some Xerox and Arpanet systems use '[' for host")
+                                                    "some Xerox and Arpanet systems use '[' for host")
                        (SETQ TEM (SUB1 (OR (\UPF.NEXTPOS (CHARCODE "]")
                                                   FILE 2)
                                            0))))
                    (%(                                       (* ; 
-                                                "this is the 'proposed standard' for Xerox servers")
+                                                  "this is the 'proposed standard' for Xerox servers")
                        (SETQ TEM (SUB1 (OR (\UPF.NEXTPOS (CHARCODE ")")
                                                   FILE 2)
                                            0))))
@@ -329,21 +332,28 @@ Copyright (c) 1981-1988, 1990-1992, 1920, 2017, 2020-2021 by Venue & Xerox Corpo
               (UNPACKFILE1 'HOST 2 TEM)
               [COND
                  ((EQ TEM -1)                                (* ; 
-    "Started with the host field delimiter, but there was no corresponding terminating delimiter .")
+      "Started with the host field delimiter, but there was no corresponding terminating delimiter .")
                                                              (* ; 
-                                           "I'm not sure why the name is dealt with the host name.")
+                                             "I'm not sure why the name is dealt with the host name.")
                   (RETURN (DREVERSE VAL]
               (SETQ POS (IPLUS TEM 2))
               [if (EQ OSTYPE T)
-                  then                                   (* ; 
-                                                           "Use actual host to determine os type")
-                        (SETQ OSTYPE (GETHOSTINFO (CAR VAL)
-                                            'OSTYPE]
+                  then                                       (* ; 
+                                                             "Use actual host to determine os type")
+                       (SETQ OSTYPE (GETHOSTINFO (CAR VAL)
+                                           'OSTYPE]
               (SETQ HOSTP T)))
+
+     (* ;; "rmk:  if there is a colon before the next < or /, then we must be looking at a device.  A device appears to end after the last colon, i.e., a device name can have a colon inside it.")
+
           (COND
-             ((SETQ TEM (LASTCHPOS (CHARCODE %:)
-                               FILE POS))                    (* ; 
-                                 "all device returned have DEVICE.END on it so that NIL: will work")
+             ((AND (SETQ TEM (\UPF.NEXTPOS (CHARCODE (%: < /))
+                                    FILE POS))
+                   (EQ (CHARCODE %:)
+                       (NTHCHARCODE FILE TEM))
+                   (SETQ TEM (LASTCHPOS (CHARCODE %:)
+                                    FILE TEM)))              (* ; 
+                                   "all device returned have DEVICE.END on it so that NIL: will work")
               (UNPACKFILE1 'DEVICE POS (if CLFLG
                                            then (SUB1 TEM)
                                          else TEM))
@@ -356,7 +366,7 @@ Copyright (c) 1981-1988, 1990-1992, 1920, 2017, 2020-2021 by Venue & Xerox Corpo
                                 (NIL                         (* ; "just host, return")
                                      (RETURN (DREVERSE VAL)))
                                 ((/ <)                       (* ; 
-                                                    "Started with the initial directory delimiter.")
+                                                      "Started with the initial directory delimiter.")
                                      (ADD1 POS))
                                 POS))
                     END)
@@ -364,7 +374,7 @@ Copyright (c) 1981-1988, 1990-1992, 1920, 2017, 2020-2021 by Venue & Xerox Corpo
                                   ((/ >) 
                                        [COND
                                           ((EQ START POS)    (* ; 
-                                                         "Didn't start with a directory delimiter,")
+                                                           "Didn't start with a directory delimiter,")
                                            (COND
                                               ((NOT HOSTP)   (* ; "%"Incomplete file names%" case defined in IRM.  This is a subdirectory of the current connected directory")
                                                (SETQ TYPE 'SUBDIRECTORY))
@@ -372,13 +382,13 @@ Copyright (c) 1981-1988, 1990-1992, 1920, 2017, 2020-2021 by Venue & Xerox Corpo
                                                  (SETQ TYPE 'RELATIVEDIRECTORY]
                                        (COND
                                           ((EQ LEN POS)      (* ; 
-                                       "Only the initial directory is specified (i.e. %"{DSK}/%").")
+                                         "Only the initial directory is specified (i.e. %"{DSK}/%").")
                                            (SETQ START POS)
                                            -1)
                                           (T -2)))
                                   (PROGN [COND
                                             [(EQ START POS)  (* ; 
-                                            "Both of the initial and trail delimiters are omitted.")
+                                              "Both of the initial and trail delimiters are omitted.")
                                              (COND
                                                 ((NOT HOSTP) (* ; "%"Incomplete file names%" case defined in IRM.  This is a subdirectory of the current connected directory")
                                                  (SETQ TYPE 'SUBDIRECTORY))
@@ -387,24 +397,24 @@ Copyright (c) 1981-1988, 1990-1992, 1920, 2017, 2020-2021 by Venue & Xerox Corpo
                                             (T (COND
                                                   ((EQ LEN POS)
                                                              (* ; 
-                                       "Only the initial directory is specified (i.e. %"{DSK}<%").")
+                                         "Only the initial directory is specified (i.e. %"{DSK}<%").")
                                                    (SETQ START POS]
                                          -1)))
                    (UNPACKFILE1.DIRECTORY TYPE START END))
               (RETURN (DREVERSE VAL)))
              ((SELCHARQ (NTHCHARCODE FILE POS)
                    (/                                        (* ; 
-                                                "unix and the 'xerox standard' use / for delimiter")
+                                                  "unix and the 'xerox standard' use / for delimiter")
                                                              (* ; 
-                       "In the case of the {DSK}/FOO>BAR, FOO should be dealt with as a directory.")
+                         "In the case of the {DSK}/FOO>BAR, FOO should be dealt with as a directory.")
                       (SETQ TEM (LASTCHPOS (CHARCODE (/ >))
                                        FILE
                                        (ADD1 POS)))
                       T)
                    ((< >)                                    (* ; 
-             "Interlisp-D and most other Xerox systems, and Tops-20/Tenex use <>.  Jericho uses >>")
+               "Interlisp-D and most other Xerox systems, and Tops-20/Tenex use <>.  Jericho uses >>")
                                                              (* ; 
-                       "In the case of the {DSK}<FOO/BAR, FOO should be dealt with as a directory.")
+                         "In the case of the {DSK}<FOO/BAR, FOO should be dealt with as a directory.")
                         (SETQ TEM (LASTCHPOS (CHARCODE (> /))
                                          FILE
                                          (ADD1 POS)))
@@ -415,20 +425,19 @@ Copyright (c) 1981-1988, 1990-1992, 1920, 2017, 2020-2021 by Venue & Xerox Corpo
 
               (if TEM
                   then (UNPACKFILE1.DIRECTORY 'DIRECTORY (ADD1 POS)
-                                  (SUB1 TEM))
-                        (SETQ POS (ADD1 TEM))
+                              (SUB1 TEM))
+                       (SETQ POS (ADD1 TEM))
                 else 
+                     (* ;; "{DSK}/foo: the directory is /, the name is foo")
 
-                      (* ;; "{DSK}/foo: the directory is /, the name is foo")
-
-                      (UNPACKFILE1.DIRECTORY 'DIRECTORY POS POS)
-                      (SETQ POS (ADD1 POS)))
+                     (UNPACKFILE1.DIRECTORY 'DIRECTORY POS POS)
+                     (SETQ POS (ADD1 POS)))
               (SETQ HOSTP T))
              ((SETQ TEM (LASTCHPOS (CHARCODE (/ >))
                                FILE POS))                    (* ; " {eris}abc>  relative")
 
               (* ;; 
-        " This is the true %"relative pathname%".  Returns RELATIVEDIRECTORY instead of DIRECTORY.")
+          " This is the true %"relative pathname%".  Returns RELATIVEDIRECTORY instead of DIRECTORY.")
 
               [COND
                  ((NOT HOSTP)                                (* ; "%"Incomplete file names%" case.")
@@ -448,9 +457,9 @@ Copyright (c) 1981-1988, 1990-1992, 1920, 2017, 2020-2021 by Venue & Xerox Corpo
           (OR (SETQ CODE (NTHCHARCODE FILE (SETQ TEM POS)))
               (RETURN (DREVERSE VAL)))
           (if (EQ OSTYPE T)
-              then                                       (* ; 
-                                        "There wasn't a host field in the name, so we have no clue")
-                    (SETQ OSTYPE NIL))
+              then                                           (* ; 
+                                          "There wasn't a host field in the name, so we have no clue")
+                   (SETQ OSTYPE NIL))
       NAMELP
           
 
@@ -458,61 +467,61 @@ Copyright (c) 1981-1988, 1990-1992, 1920, 2017, 2020-2021 by Venue & Xerox Corpo
 
           (SELCHARQ CODE
                (%.                                           (* ; 
-                          "Note position for later--we only want to deal with the last set of dots")
+                            "Note position for later--we only want to deal with the last set of dots")
                    (if BEYONDNAME
-                       then                              (* ; 
-                                                 "no longer of interest (probably a bad name, too)")
+                       then                                  (* ; 
+                                                   "no longer of interest (probably a bad name, too)")
                      elseif FIRSTDOT
-                       then                              (* ; "We're recording the second dot")
-                             (if SECONDDOT
-                                 then                    (* ; 
-                                                           "Note only the two most recent dots")
-                                       (SETQ FIRSTDOT SECONDDOT))
-                             (SETQ SECONDDOT TEM)
+                       then                                  (* ; "We're recording the second dot")
+                            (if SECONDDOT
+                                then                         (* ; 
+                                                             "Note only the two most recent dots")
+                                     (SETQ FIRSTDOT SECONDDOT))
+                            (SETQ SECONDDOT TEM)
                      else (SETQ FIRSTDOT TEM)))
                ((! ; NIL)                                    (* ; 
-                             "SUBDIRECTORY, NAME and EXTENSION fields definitely terminated by now")
+                               "SUBDIRECTORY, NAME and EXTENSION fields definitely terminated by now")
                     (if (SELCHARQ CODE
-                                 (!                          (* ; 
-               "! is only a delimiter on IFS, so ignore it if we know the ostype is something else")
-                                    (AND OSTYPE (NEQ OSTYPE 'IFS)))
-                                 (;                          (* ; "If we've already parsed the extension, then we have a semi in the middle of the version.  Skip it unless it's ;T or ;S")
-                                    [AND BEYONDEXT (NOT (\UPF.TEMPFILEP FILE (ADD1 TEM])
-                                 NIL)
+                             (!                              (* ; 
+                 "! is only a delimiter on IFS, so ignore it if we know the ostype is something else")
+                                (AND OSTYPE (NEQ OSTYPE 'IFS)))
+                             (;                              (* ; "If we've already parsed the extension, then we have a semi in the middle of the version.  Skip it unless it's ;T or ;S")
+                                [AND BEYONDEXT (NOT (\UPF.TEMPFILEP FILE (ADD1 TEM])
+                             NIL)
                         then (GO NEXTCHAR))
                     (if FIRSTDOT
-                        then                             (* ; 
-                                                        "Have a name and/or extension to parse now")
+                        then                                 (* ; 
+                                                          "Have a name and/or extension to parse now")
                         (if
                          [AND SECONDDOT
                               (NOT (if OSTYPE
-                                       then              (* ; 
-                                      "Known OS type must be Tops20 for second dot to mean version")
-                                             (EQ OSTYPE 'TOPS20)
-                                     else                (* ; 
-                                "Unknown OS type, so check that %"version%" is numeric or wildcard")
-                                           (AND [for I from (ADD1 SECONDDOT)
-                                                   to (SUB1 TEM) bind CH
-                                                   always (OR (DIGITCHARP (SETQ CH
-                                                                               (NTHCHARCODE FILE I)))
-                                                                  (EQ CH (CHARCODE *]
-                                                (SELCHARQ CODE
-                                                     (NIL    (* ; "end of file name, ok")
-                                                          T)
-                                                     (;      (* ; 
-                                              "This semi-colon better not be introducing a version")
-                                                        (\UPF.TEMPFILEP FILE (ADD1 TEM)))
-                                                     NIL]
-                            then                         (* ; 
-                                                           "Second dot is not intoducing a version")
-                                  (SETQ FIRSTDOT SECONDDOT)
-                                  (SETQ SECONDDOT NIL))
+                                       then                  (* ; 
+                                        "Known OS type must be Tops20 for second dot to mean version")
+                                            (EQ OSTYPE 'TOPS20)
+                                     else                    (* ; 
+                                  "Unknown OS type, so check that %"version%" is numeric or wildcard")
+                                          (AND [for I from (ADD1 SECONDDOT) to (SUB1 TEM)
+                                                  bind CH
+                                                  always (OR (DIGITCHARP (SETQ CH (NTHCHARCODE FILE I
+                                                                                         )))
+                                                             (EQ CH (CHARCODE *]
+                                               (SELCHARQ CODE
+                                                    (NIL     (* ; "end of file name, ok")
+                                                         T)
+                                                    (;       (* ; 
+                                                "This semi-colon better not be introducing a version")
+                                                       (\UPF.TEMPFILEP FILE (ADD1 TEM)))
+                                                    NIL]
+                            then                             (* ; 
+                                                             "Second dot is not intoducing a version")
+                                 (SETQ FIRSTDOT SECONDDOT)
+                                 (SETQ SECONDDOT NIL))
                         (UNPACKFILE1 'NAME POS (SUB1 FIRSTDOT))
                         (SETQ POS (ADD1 (if SECONDDOT
                                             then (UNPACKFILE1 'EXTENSION (ADD1 FIRSTDOT)
-                                                            (SUB1 SECONDDOT))
-                                                  (SETQ BEYONDEXT T)
-                                                  SECONDDOT
+                                                        (SUB1 SECONDDOT))
+                                                 (SETQ BEYONDEXT T)
+                                                 SECONDDOT
                                           else FIRSTDOT)))
                         (SETQ BEYONDNAME T)
                         (SETQ FIRSTDOT NIL))
@@ -524,15 +533,15 @@ Copyright (c) 1981-1988, 1990-1992, 1920, 2017, 2020-2021 by Venue & Xerox Corpo
                                     ((AND (EQ BEYONDEXT (CHARCODE ";"))
                                           (\UPF.TEMPFILEP FILE POS)))
                                     (T                       (* ; 
-                                                           "Everything after the semi was version")
+                                                             "Everything after the semi was version")
                                        'VERSION))
                            POS
                            (SUB1 TEM))
                     (if (NULL CODE)
-                        then                             (* ; "End of string")
-                              (RETURN (DREVERSE VAL)))
+                        then                                 (* ; "End of string")
+                             (RETURN (DREVERSE VAL)))
                     (SETQ BEYONDEXT CODE)                    (* ; 
-                                                  "Note the character that terminated the name/ext")
+                                                    "Note the character that terminated the name/ext")
                     (SETQ POS (ADD1 TEM)))
                (%'                                           (* ; "Quoter")
                    (add TEM 1))
@@ -623,80 +632,74 @@ Copyright (c) 1981-1988, 1990-1992, 1920, 2017, 2020-2021 by Venue & Xerox Corpo
                     (DSTPOS 0)
                     (NEXTPOS -1))
                    (if (NOT FATP)
-                       then
-                       [for SRCPOS from 1 to LEN bind CODE
-                          first (while (EQMEMB (NTHCHARCODE SRCSTRING SRCPOS)
-                                                      (CHARCODE (< / >)))
-                                       do (add SRCPOS 1))
-                                (if (> SRCPOS LEN)
-                                    then (RETURN "<"))
-                          do (SELCHARQ (SETQ CODE (NTHCHARCODE SRCSTRING SRCPOS))
-                                      ((> /) 
-                                           (if (> DSTPOS NEXTPOS)
-                                               then (\PUTBASETHIN DSTBASE DSTPOS (CHARCODE >))
+                       then [for SRCPOS from 1 to LEN bind CODE
+                               first (while (EQMEMB (NTHCHARCODE SRCSTRING SRCPOS)
+                                                   (CHARCODE (< / >))) do (add SRCPOS 1))
+                                     (if (> SRCPOS LEN)
+                                         then (RETURN "<"))
+                               do (SELCHARQ (SETQ CODE (NTHCHARCODE SRCSTRING SRCPOS))
+                                       ((> /) 
+                                            (if (> DSTPOS NEXTPOS)
+                                                then (\PUTBASETHIN DSTBASE DSTPOS (CHARCODE >))
                                                      (SETQ NEXTPOS (add DSTPOS 1))))
-                                      (%' (\PUTBASETHIN DSTBASE DSTPOS CODE)
-                                          (add DSTPOS 1)
-                                          (if (NEQ SRCPOS LEN)
-                                              then (\PUTBASETHIN DSTBASE DSTPOS
-                                                              (NTHCHARCODE SRCSTRING (add SRCPOS
-                                                                                            1)))
+                                       (%' (\PUTBASETHIN DSTBASE DSTPOS CODE)
+                                           (add DSTPOS 1)
+                                           (if (NEQ SRCPOS LEN)
+                                               then (\PUTBASETHIN DSTBASE DSTPOS
+                                                           (NTHCHARCODE SRCSTRING (add SRCPOS 1)))
                                                     (add DSTPOS 1)))
-                                      (PROGN (\PUTBASETHIN DSTBASE DSTPOS CODE)
-                                             (add DSTPOS 1)))
-                          finally (RETURN (if (EQ DSTPOS LEN)
-                                                  then (if (EQMEMB (NTHCHARCODE DSTSTRING -1)
-                                                                          (CHARCODE (> /)))
-                                                               then (SUBSTRING DSTSTRING 1 -2)
-                                                             else DSTSTRING)
-                                                elseif (EQMEMB (NTHCHARCODE DSTSTRING DSTPOS)
-                                                                  (CHARCODE (> /)))
-                                                  then (SUBSTRING DSTSTRING 1 (SUB1 DSTPOS))
-                                                else (SUBSTRING DSTSTRING 1 DSTPOS]
-                     else
-                     (for SRCPOS from 1 to LEN bind CODE
-                        first (while (EQMEMB (NTHCHARCODE SRCSTRING SRCPOS)
-                                                    (CHARCODE (< / >))) do (add SRCPOS 1))
-                        do (SELCHARQ (SETQ CODE (NTHCHARCODE SRCSTRING SRCPOS))
-                                    ((> /) 
-                                         (if (> DSTPOS NEXTPOS)
-                                             then (\PUTBASEFAT DSTBASE DSTPOS (CHARCODE >))
+                                       (PROGN (\PUTBASETHIN DSTBASE DSTPOS CODE)
+                                              (add DSTPOS 1)))
+                               finally (RETURN (if (EQ DSTPOS LEN)
+                                                   then (if (EQMEMB (NTHCHARCODE DSTSTRING -1)
+                                                                   (CHARCODE (> /)))
+                                                            then (SUBSTRING DSTSTRING 1 -2)
+                                                          else DSTSTRING)
+                                                 elseif (EQMEMB (NTHCHARCODE DSTSTRING DSTPOS)
+                                                               (CHARCODE (> /)))
+                                                   then (SUBSTRING DSTSTRING 1 (SUB1 DSTPOS))
+                                                 else (SUBSTRING DSTSTRING 1 DSTPOS]
+                     else (for SRCPOS from 1 to LEN bind CODE
+                             first (while (EQMEMB (NTHCHARCODE SRCSTRING SRCPOS)
+                                                 (CHARCODE (< / >))) do (add SRCPOS 1))
+                             do (SELCHARQ (SETQ CODE (NTHCHARCODE SRCSTRING SRCPOS))
+                                     ((> /) 
+                                          (if (> DSTPOS NEXTPOS)
+                                              then (\PUTBASEFAT DSTBASE DSTPOS (CHARCODE >))
                                                    (SETQ NEXTPOS (add DSTPOS 1))))
-                                    (%' (\PUTBASEFAT DSTBASE DSTPOS CODE)
-                                        (add DSTPOS 1)
-                                        (if (NEQ SRCPOS LEN)
-                                            then (\PUTBASEFAT DSTBASE DSTPOS
-                                                            (NTHCHARCODE SRCSTRING (add SRCPOS 1)
-                                                                   ))
+                                     (%' (\PUTBASEFAT DSTBASE DSTPOS CODE)
+                                         (add DSTPOS 1)
+                                         (if (NEQ SRCPOS LEN)
+                                             then (\PUTBASEFAT DSTBASE DSTPOS (NTHCHARCODE
+                                                                               SRCSTRING
+                                                                               (add SRCPOS 1)))
                                                   (add DSTPOS 1)))
-                                    (PROGN (\PUTBASEFAT DSTBASE DSTPOS CODE)
-                                           (add DSTPOS 1)))
-                        finally (RETURN (if (EQ DSTPOS LEN)
-                                                then (if (EQMEMB (NTHCHARCODE DSTSTRING -1)
-                                                                        (CHARCODE (> /)))
-                                                             then (SUBSTRING DSTSTRING 1 -2)
-                                                           else DSTSTRING)
-                                              elseif (EQMEMB (NTHCHARCODE DSTSTRING DSTPOS)
-                                                                (CHARCODE (> /)))
-                                                then (SUBSTRING DSTSTRING 1 (SUB1 DSTPOS))
-                                              else (SUBSTRING DSTSTRING 1 DSTPOS])
+                                     (PROGN (\PUTBASEFAT DSTBASE DSTPOS CODE)
+                                            (add DSTPOS 1)))
+                             finally (RETURN (if (EQ DSTPOS LEN)
+                                                 then (if (EQMEMB (NTHCHARCODE DSTSTRING -1)
+                                                                 (CHARCODE (> /)))
+                                                          then (SUBSTRING DSTSTRING 1 -2)
+                                                        else DSTSTRING)
+                                               elseif (EQMEMB (NTHCHARCODE DSTSTRING DSTPOS)
+                                                             (CHARCODE (> /)))
+                                                 then (SUBSTRING DSTSTRING 1 (SUB1 DSTPOS))
+                                               else (SUBSTRING DSTSTRING 1 DSTPOS])
 
 (PUTPROPS UNPACKFILE1.DIRECTORY MACRO [OPENLAMBDA (NAM ST END)
-                                                (LET* ((OLDDIR (SUBSTRING FILE ST END))
-                                                       (NEWDIR (CANONICAL.DIRECTORY OLDDIR)))
-                                                      (COND
-                                                         [(NOT ONEFIELDFLG)
-                                                          (SETQ VAL
-                                                           (CONS (COND
-                                                                    (PACKFLG (AND NEWDIR (MKATOM
-                                                                                          NEWDIR)))
-                                                                    (T (OR NEWDIR "")))
-                                                                 (CONS NAM VAL]
-                                                         ((EQMEMB NAM ONEFIELDFLG)
-                                                          (RETURN (COND
+                                        (LET* ((OLDDIR (SUBSTRING FILE ST END))
+                                               (NEWDIR (CANONICAL.DIRECTORY OLDDIR)))
+                                              (COND
+                                                 [(NOT ONEFIELDFLG)
+                                                  (SETQ VAL (CONS (COND
                                                                      (PACKFLG (AND NEWDIR
                                                                                    (MKATOM NEWDIR)))
-                                                                     (T (OR NEWDIR ""])
+                                                                     (T (OR NEWDIR "")))
+                                                                  (CONS NAM VAL]
+                                                 ((EQMEMB NAM ONEFIELDFLG)
+                                                  (RETURN (COND
+                                                             (PACKFLG (AND NEWDIR (MKATOM NEWDIR)))
+                                                             (T (OR NEWDIR ""])
 
 (PUTPROPS PACKFILENAME.ASSEMBLE MACRO
           [NIL
@@ -705,11 +708,11 @@ Copyright (c) 1981-1988, 1990-1992, 1920, 2017, 2020-2021 by Venue & Xerox Corpo
                   HOST DEVICE STRUCTURE DIRECTORY SUBDIRECTORY RELATIVEDIRECTORY NAME EXTENSION 
                   VERSION TEMPORARY PROTECTION ACCOUNT PACKLIST VAR VAL TEMP)
                  (DECLARE (SPECVARS HOST DEVICE STRUCTURE DIRECTORY SUBDIRECTORY NAME EXTENSION 
-                                     VERSION TEMPORARY PROTECTION ACCOUNT))
+                                 VERSION TEMPORARY PROTECTION ACCOUNT))
              LP  (COND
                     ((<= I N)
 
-                     (* ;; "Grab the next field-name / value pair and fold it into the filename:")
+                     (* ;; "Grab the next field-name / value pair and fold it into the filename:")
 
                      (COND
                         ((LISTP (SETQ VAR (ARG N I)))
@@ -725,9 +728,9 @@ Copyright (c) 1981-1988, 1990-1992, 1920, 2017, 2020-2021 by Venue & Xerox Corpo
                          (\ILLEGAL.ARG VAL))
                      (SELECTQ VAR
                          (BODY (MAP (UNPACKFILENAME.STRING (COND
-                                                                  ((LISTP VAL)
-                                                                   (PACKFILENAME.STRING VAL))
-                                                                  (T VAL))
+                                                              ((LISTP VAL)
+                                                               (PACKFILENAME.STRING VAL))
+                                                              (T VAL))
                                            NIL
                                            'OK)
                                     [FUNCTION (LAMBDA (X)
@@ -781,52 +784,49 @@ Copyright (c) 1981-1988, 1990-1992, 1920, 2017, 2020-2021 by Venue & Xerox Corpo
                          ((PATHNAME DIRECTORY) 
                               [COND
                                  (VAL
-                                  (for X on (SETQ VAL (UNPACKFILENAME.STRING VAL NIL
-                                                                     'RETURN))
+                                  (for X on (SETQ VAL (UNPACKFILENAME.STRING VAL NIL 'RETURN))
                                      by (CDDR X)
                                      do (SELECTQ (CAR X)
-                                                (HOST [COND
-                                                         ((NOT HOST)
-                                                          (SETQ HOST (OR (CADR X)
+                                            (HOST [COND
+                                                     ((NOT HOST)
+                                                      (SETQ HOST (OR (CADR X)
+                                                                     BLIP])
+                                            (DEVICE [COND
+                                                       ((NOT DEVICE)
+                                                        (SETQ DEVICE (OR (CADR X)
                                                                          BLIP])
-                                                (DEVICE [COND
-                                                           ((NOT DEVICE)
-                                                            (SETQ DEVICE (OR (CADR X)
-                                                                             BLIP])
-                                                (SUBDIRECTORY [OR DIRECTORY
-                                                                  (COND
-                                                                     (RELATIVEDIRECTORY (SETQ 
-                                                                                         DIRECTORY 
-                                                                                         BLIP))
-                                                                     (T (SETQ DIRECTORY
-                                                                         (OR (CADR X)
-                                                                             BLIP])
-                                                (RELATIVEDIRECTORY 
+                                            (SUBDIRECTORY [OR DIRECTORY
+                                                              (COND
+                                                                 (RELATIVEDIRECTORY (SETQ DIRECTORY 
+                                                                                     BLIP))
+                                                                 (T (SETQ DIRECTORY
+                                                                     (OR (CADR X)
+                                                                         BLIP])
+                                            (RELATIVEDIRECTORY 
 
-                                 (* ;; "This used to set RELATIVEDIRECTORY to BLIP if DIRECTORY was already specified.  It really should act as a subdirectory in that case?  JDS")
+                                 (* ;; "This used to set RELATIVEDIRECTORY to BLIP if DIRECTORY was already specified.  It really should act as a subdirectory in that case?  JDS")
 
-                                                     (OR RELATIVEDIRECTORY (SETQ RELATIVEDIRECTORY
+                                                 (OR RELATIVEDIRECTORY (SETQ RELATIVEDIRECTORY
+                                                                        (OR (CADR X)
+                                                                            BLIP))))
+                                            (DIRECTORY [OR DIRECTORY (COND
+                                                                        (RELATIVEDIRECTORY
+                                                                         (SETQ DIRECTORY BLIP))
+                                                                        (T (SETQ DIRECTORY
                                                                             (OR (CADR X)
-                                                                                BLIP))))
-                                                (DIRECTORY [OR DIRECTORY
-                                                               (COND
-                                                                  (RELATIVEDIRECTORY (SETQ DIRECTORY
-                                                                                      BLIP))
-                                                                  (T (SETQ DIRECTORY
-                                                                      (OR (CADR X)
-                                                                          BLIP])
-                                                (ERROR "Illegal field in DIRECTORY slot" VAL)))
+                                                                                BLIP])
+                                            (ERROR "Illegal field in DIRECTORY slot" VAL)))
                                   (for X on VAL by (CDDR X)
                                      do (SELECTQ (CAR X)
-                                                (HOST (OR DEVICE (SETQ DEVICE BLIP))
-                                                      (OR DIRECTORY (SETQ DIRECTORY BLIP)))
-                                                (DEVICE (OR DIRECTORY (SETQ DIRECTORY BLIP)))
-                                                NIL)))
+                                            (HOST (OR DEVICE (SETQ DEVICE BLIP))
+                                                  (OR DIRECTORY (SETQ DIRECTORY BLIP)))
+                                            (DEVICE (OR DIRECTORY (SETQ DIRECTORY BLIP)))
+                                            NIL)))
                                  (T (OR DIRECTORY (SETQ DIRECTORY BLIP])
                          (SUBDIRECTORY (OR SUBDIRECTORY (SETQ SUBDIRECTORY (OR VAL BLIP))))
                          (RELATIVEDIRECTORY 
 
-                                 (* ;; "This used to set RELATIVEDIRECTORY to BLIP if DIRECTORY was already specified.  It really should act as a subdirectory in that case?  JDS")
+                                 (* ;; "This used to set RELATIVEDIRECTORY to BLIP if DIRECTORY was already specified.  It really should act as a subdirectory in that case?  JDS")
 
                               (OR RELATIVEDIRECTORY (SETQ RELATIVEDIRECTORY (OR VAL BLIP))))
                          (DEVICE (OR DEVICE (SETQ DEVICE (OR VAL BLIP))))
@@ -868,9 +868,9 @@ Copyright (c) 1981-1988, 1990-1992, 1920, 2017, 2020-2021 by Venue & Xerox Corpo
                                 [COND
                                    (DIRECTORY (COND
                                                  [[OR (STREQUAL DIRECTORY "<")
-                                                      (AND (SETQ TEMP (LASTCHPOS
-                                                                       (CHARCODE (> /))
-                                                                       DIRECTORY 1))
+                                                      (AND (SETQ TEMP (LASTCHPOS (CHARCODE
+                                                                                  (> /))
+                                                                             DIRECTORY 1))
                                                            (EQ TEMP (NCHARS DIRECTORY]
                                                   (COND
                                                      ((EQMEMB (NTHCHARCODE DIRECTORY 1)
@@ -913,20 +913,19 @@ Copyright (c) 1981-1988, 1990-1992, 1920, 2017, 2020-2021 by Venue & Xerox Corpo
                                                            (SUBSTRING VERSION 2 -1))
                                                       VERSION])
 
-(PUTPROPS UNPACKFILE1 MACRO [OPENLAMBDA (NAM ST END)
-                                                             (* lmm "22-APR-81 22:21")
-                                      (COND
-                                         [(NOT ONEFIELDFLG)
-                                          (SETQ VAL (CONS (COND
-                                                             (PACKFLG (SUBATOM FILE ST END))
-                                                             (T (OR (SUBSTRING FILE ST END)
-                                                                    "")))
-                                                          (CONS NAM VAL]
-                                         ((EQMEMB NAM ONEFIELDFLG)
-                                          (RETURN (COND
+(PUTPROPS UNPACKFILE1 MACRO [OPENLAMBDA (NAM ST END)         (* lmm "22-APR-81 22:21")
+                              (COND
+                                 [(NOT ONEFIELDFLG)
+                                  (SETQ VAL (CONS (COND
                                                      (PACKFLG (SUBATOM FILE ST END))
                                                      (T (OR (SUBSTRING FILE ST END)
-                                                            ""])
+                                                            "")))
+                                                  (CONS NAM VAL]
+                                 ((EQMEMB NAM ONEFIELDFLG)
+                                  (RETURN (COND
+                                             (PACKFLG (SUBATOM FILE ST END))
+                                             (T (OR (SUBSTRING FILE ST END)
+                                                    ""])
 )
 )
 
@@ -1158,14 +1157,14 @@ Copyright (c) 1981-1988, 1990-1992, 1920, 2017, 2020-2021 by Venue & Xerox Corpo
 (PUTPROPS ADIR COPYRIGHT ("Venue & Xerox Corporation" 1981 1982 1983 1984 1985 1986 1987 1988 1990 
 1991 1992 1920 2017 2020 2021))
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (2733 13858 (DELFILE 2743 . 2904) (FULLNAME 2906 . 3273) (INFILE 3275 . 3423) (INFILEP 
-3425 . 3560) (IOFILE 3562 . 3702) (OPENFILE 3704 . 4104) (OPENSTREAM 4106 . 8446) (OUTFILE 8448 . 8599
-) (OUTFILEP 8601 . 8737) (RENAMEFILE 8739 . 9045) (SIMPLE.FINDFILE 9047 . 9457) (VMEMSIZE 9459 . 9626)
- (\COPYSYS 9628 . 12577) (\FLUSHVM 12579 . 13651) (\LOGOUT0 13653 . 13856)) (14230 33821 (
-UNPACKFILENAME 14240 . 14426) (UNPACKFILENAME.STRING 14428 . 30700) (LASTCHPOS 30702 . 31396) (
-\UPF.NEXTPOS 31398 . 32043) (\UPF.TEMPFILEP 32045 . 32622) (FILENAMEFIELD 32624 . 33109) (PACKFILENAME
- 33111 . 33454) (PACKFILENAME.STRING 33456 . 33819)) (56262 63442 (LOGOUT 56272 . 57189) (MAKESYS 
-57191 . 58820) (SYSOUT 58822 . 60374) (SAVEVM 60376 . 61176) (HERALD 61178 . 61338) (INTERPRET.REM.CM 
-61340 . 63065) (\USEREVENT 63067 . 63440)) (63624 65351 (USERNAME 63634 . 64590) (SETUSERNAME 64592 . 
-65349)))))
+  (FILEMAP (NIL (2686 13811 (DELFILE 2696 . 2857) (FULLNAME 2859 . 3226) (INFILE 3228 . 3376) (INFILEP 
+3378 . 3513) (IOFILE 3515 . 3655) (OPENFILE 3657 . 4057) (OPENSTREAM 4059 . 8399) (OUTFILE 8401 . 8552
+) (OUTFILEP 8554 . 8690) (RENAMEFILE 8692 . 8998) (SIMPLE.FINDFILE 9000 . 9410) (VMEMSIZE 9412 . 9579)
+ (\COPYSYS 9581 . 12530) (\FLUSHVM 12532 . 13604) (\LOGOUT0 13606 . 13809)) (14183 34403 (
+UNPACKFILENAME 14193 . 14379) (UNPACKFILENAME.STRING 14381 . 31282) (LASTCHPOS 31284 . 31978) (
+\UPF.NEXTPOS 31980 . 32625) (\UPF.TEMPFILEP 32627 . 33204) (FILENAMEFIELD 33206 . 33691) (PACKFILENAME
+ 33693 . 34036) (PACKFILENAME.STRING 34038 . 34401)) (56043 63223 (LOGOUT 56053 . 56970) (MAKESYS 
+56972 . 58601) (SYSOUT 58603 . 60155) (SAVEVM 60157 . 60957) (HERALD 60959 . 61119) (INTERPRET.REM.CM 
+61121 . 62846) (\USEREVENT 62848 . 63221)) (63405 65132 (USERNAME 63415 . 64371) (SETUSERNAME 64373 . 
+65130)))))
 STOP
diff --git a/sources/ADIR.LCOM b/sources/ADIR.LCOM
index ddc65030..370a9cb6 100644
Binary files a/sources/ADIR.LCOM and b/sources/ADIR.LCOM differ
