diff --git a/sources/ADIR b/sources/ADIR
index 2000ef9a..d88e0bed 100644
--- a/sources/ADIR
+++ b/sources/ADIR
@@ -1,12 +1,12 @@
 (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
 
-(FILECREATED " 9-Mar-2024 10:24:39" {WMEDLEY}<sources>ADIR.;38 67777  
+(FILECREATED " 6-May-2024 15:54:01" {WMEDLEY}<sources>ADIR.;45 67756  
 
       :EDIT-BY rmk
 
-      :CHANGES-TO (FNS UNPACKFILENAME.STRING FILENAMEFIELD FILENAMEFIELD.STRING \UPF.DIRECTORY)
+      :CHANGES-TO (FNS \UPF.DIRECTORY)
 
-      :PREVIOUS-DATE "13-Nov-2023 20:28:57" {WMEDLEY}<sources>ADIR.;31)
+      :PREVIOUS-DATE " 4-May-2024 16:25:09" {WMEDLEY}<sources>ADIR.;44)
 
 
 (PRETTYCOMPRINT ADIRCOMS)
@@ -317,7 +317,8 @@
 (DEFINEQ
 
 (UNPACKFILENAME.STRING
-  [LAMBDA (FILE ONEFIELDFLG DIRFLG OSTYPE PACKFLG CLFLG)     (* ; "Edited  9-Mar-2024 10:23 by rmk")
+  [LAMBDA (FILE ONEFIELDFLG DIRFLG OSTYPE PACKFLG CLFLG)     (* ; "Edited  4-May-2024 12:45 by rmk")
+                                                             (* ; "Edited  9-Mar-2024 10:23 by rmk")
                                                              (* ; "Edited 13-Nov-2023 20:28 by rmk")
                                                              (* ; "Edited 28-Apr-2022 11:40 by rmk")
                                                              (* ; "Edited 24-Apr-2022 14:11 by rmk")
@@ -350,7 +351,6 @@
     (* ;; "")
 
     (* ;; "     If there is at least one / or > then the last one ends the directory, anything before is possibly a relative or subdirectory.  Anything after is a name")
-                                                             (* ; "")
 
     (* ;; "              (Rationale:  Those are not sub-directory brackets)")
 
@@ -662,52 +662,48 @@
                                                   (PUSH $$VAL F FVAL])
 
 (\UPF.DIRECTORY
-  [LAMBDA (DIRSTART DIREND DIRDIRTY $$BASE $$FATP $$READONLY)(* ; "Edited  8-Mar-2024 23:03 by rmk")
+  [LAMBDA (DIRSTART DIREND DIRDIRTY $$BASE $$FATP $$READONLY)(* ; "Edited  6-May-2024 15:53 by rmk")
+                                                             (* ; "Edited  4-May-2024 16:25 by rmk")
+                                                             (* ; "Edited  8-Mar-2024 23:03 by rmk")
                                                              (* ; "Edited 28-Apr-2022 09:15 by rmk")
                                                              (* ; "Edited 27-Apr-2022 08:50 by rmk")
                                                              (* ; "Edited 23-Apr-2022 17:09 by rmk")
 
-    (* ;; "Relative directory {abc}<foo or {abc}< with no >, subdirectory >foo or > with no host or device (DIRSTART=1).  ")
+    (* ;; "Extract the directory field, producing <> for the empty (top-level) directory, normalizing / to < or >.")
 
-    (* ;; "Advance DIRSTART through initial duplicates")
+    (if (ILEQ DIREND DIRSTART)
+        then 
+             (* ;; "An empty directory field is interpreted as the top as per issue #1685:  <xy  >xy  /xy all map to <>")
 
-    (LET ((BRACKET (SELCHARQ (\GETBASECHAR $$FATP $$BASE DIRSTART)
-                        ((< /) 
-                             "<")
-                        (> ">")
-                        NIL)))
-         (IF (EQ DIREND DIRSTART)
-             THEN 
-                  (* ;; "If EQ, the directory is is empty.")
+             (MKSTRING "<")
+      else (CL:WHEN (MEMB (\GETBASECHAR $$FATP $$BASE DIRSTART)
+                          (CHARCODE (< / >)))                (* ; "Skip leading brackets")
+               (ADD DIRSTART 1)) 
 
-                  (MKSTRING "")
-           ELSE (CL:WHEN BRACKET                             (* ; "Skip the < or /")
-                    (ADD DIRSTART 1)) 
+           (* ;; 
+           "If DIRDIRTY, the string contained at least one / that has to be converted to < or >")
 
-                (* ;; 
-         "Convert / to >, remove all  // /> >> duplicate sequences (keep the first, skip the others)")
+           (IF DIRDIRTY
+               THEN (FOR DIROFF C DEST DESTBASE (DESTPOS _ -1) FROM DIRSTART TO DIREND
+                       FIRST (SETQ DEST (ALLOCSTRING (ADD1 (IDIFFERENCE DIREND DIRSTART))
+                                               NIL NIL $$FATP))
+                             (SETQ DESTBASE (FETCH (STRINGP BASE) OF DEST))
+                       DO (ADD DESTPOS 1)
+                          (SETQ C (\GETBASECHAR $$FATP $$BASE DIROFF))
+                          (SELCHARQ C
+                               ((> /) 
+                                    (\PUTBASECHAR $$FATP DESTBASE DESTPOS (CHARCODE >))
 
-                (IF DIRDIRTY
-                    THEN (FOR DIROFF C DEST DESTBASE (DESTPOS _ -1) FROM DIRSTART TO DIREND
-                            FIRST (SETQ DEST (ALLOCSTRING (ADD1 (IDIFFERENCE DIREND DIRSTART))
-                                                    NIL NIL $$FATP))
-                                  (SETQ DESTBASE (FETCH (STRINGP BASE) OF DEST))
-                            DO (ADD DESTPOS 1)
-                               (SETQ C (\GETBASECHAR $$FATP $$BASE DIROFF))
-                               (SELCHARQ C
-                                    ((> /) 
-                                         (\PUTBASECHAR $$FATP DESTBASE DESTPOS (CHARCODE >))
+                                    (* ;; "Advance past duplicates")
 
-                                         (* ;; "Advance past duplicates")
-
-                                         (FIND I FROM (ADD1 DIROFF) TO DIREND
-                                            WHILE (FMEMB (\GETBASECHAR $$FATP $$BASE I)
-                                                         (CHARCODE (> /)))
-                                            FINALLY (SETQ DIROFF (SUB1 I))))
-                                    (\PUTBASECHAR $$FATP DESTBASE DESTPOS C))
-                            FINALLY (REPLACE (STRINGP LENGTH) OF DEST WITH DESTPOS)
-                                  (RETURN DEST))
-                  ELSE (\UPF.EXTRACT DIRSTART (SUB1 DIREND])
+                                    (FIND I FROM (ADD1 DIROFF) TO DIREND
+                                       WHILE (FMEMB (\GETBASECHAR $$FATP $$BASE I)
+                                                    (CHARCODE (> /))) FINALLY (SETQ DIROFF
+                                                                               (SUB1 I))))
+                               (\PUTBASECHAR $$FATP DESTBASE DESTPOS C))
+                       FINALLY (REPLACE (STRINGP LENGTH) OF DEST WITH DESTPOS)
+                             (RETURN DEST))
+             ELSE (\UPF.EXTRACT DIRSTART (SUB1 DIREND])
 )
 (DECLARE%: DONTCOPY 
 (DECLARE%: EVAL@COMPILE 
@@ -1254,14 +1250,14 @@
 (ADDTOVAR LAMA PACKFILENAME.STRING PACKFILENAME)
 )
 (DECLARE%: DONTCOPY
-  (FILEMAP (NIL (3169 15826 (DELFILE 3179 . 3340) (FULLNAME 3342 . 3709) (INFILE 3711 . 3970) (INFILEP 
-3972 . 4107) (IOFILE 4109 . 4360) (OPENFILE 4362 . 4665) (OPENSTREAM 4667 . 9007) (OUTFILE 9009 . 9271
-) (OUTFILEP 9273 . 9409) (RENAMEFILE 9411 . 9717) (SIMPLE.FINDFILE 9719 . 10129) (VMEMSIZE 10131 . 
-10298) (\COPYSYS 10300 . 14545) (\FLUSHVM 14547 . 15619) (\LOGOUT0 15621 . 15824)) (16284 38972 (
-UNPACKFILENAME.STRING 16294 . 36274) (\UPF.DIRECTORY 36276 . 38970)) (40500 42806 (UNPACKFILENAME 
-40510 . 40696) (LASTCHPOS 40698 . 41392) (FILENAMEFIELD 41394 . 41688) (FILENAMEFIELD.STRING 41690 . 
-42094) (PACKFILENAME 42096 . 42439) (PACKFILENAME.STRING 42441 . 42804)) (57276 58189 (
-FILEDIRCASEARRAY 57286 . 58187)) (58356 65536 (LOGOUT 58366 . 59283) (MAKESYS 59285 . 60914) (SYSOUT 
-60916 . 62468) (SAVEVM 62470 . 63270) (HERALD 63272 . 63432) (INTERPRET.REM.CM 63434 . 65159) (
-\USEREVENT 65161 . 65534)) (65718 67445 (USERNAME 65728 . 66684) (SETUSERNAME 66686 . 67443)))))
+  (FILEMAP (NIL (3112 15769 (DELFILE 3122 . 3283) (FULLNAME 3285 . 3652) (INFILE 3654 . 3913) (INFILEP 
+3915 . 4050) (IOFILE 4052 . 4303) (OPENFILE 4305 . 4608) (OPENSTREAM 4610 . 8950) (OUTFILE 8952 . 9214
+) (OUTFILEP 9216 . 9352) (RENAMEFILE 9354 . 9660) (SIMPLE.FINDFILE 9662 . 10072) (VMEMSIZE 10074 . 
+10241) (\COPYSYS 10243 . 14488) (\FLUSHVM 14490 . 15562) (\LOGOUT0 15564 . 15767)) (16227 38951 (
+UNPACKFILENAME.STRING 16237 . 36252) (\UPF.DIRECTORY 36254 . 38949)) (40479 42785 (UNPACKFILENAME 
+40489 . 40675) (LASTCHPOS 40677 . 41371) (FILENAMEFIELD 41373 . 41667) (FILENAMEFIELD.STRING 41669 . 
+42073) (PACKFILENAME 42075 . 42418) (PACKFILENAME.STRING 42420 . 42783)) (57255 58168 (
+FILEDIRCASEARRAY 57265 . 58166)) (58335 65515 (LOGOUT 58345 . 59262) (MAKESYS 59264 . 60893) (SYSOUT 
+60895 . 62447) (SAVEVM 62449 . 63249) (HERALD 63251 . 63411) (INTERPRET.REM.CM 63413 . 65138) (
+\USEREVENT 65140 . 65513)) (65697 67424 (USERNAME 65707 . 66663) (SETUSERNAME 66665 . 67422)))))
 STOP
diff --git a/sources/ADIR.LCOM b/sources/ADIR.LCOM
index 46046aa7..fbb324e0 100644
Binary files a/sources/ADIR.LCOM and b/sources/ADIR.LCOM differ
