diff --git a/sources/ADIR b/sources/ADIR index b9cd641cb..532a8d566 100644 --- a/sources/ADIR +++ b/sources/ADIR @@ -1,12 +1,12 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "20-Jan-2025 13:37:28" {DSK}briggs>Projects>medley>sources>ADIR.;48 70144 +(FILECREATED "12-Feb-2025 10:49:30" {WMEDLEY}ADIR.;66 74086 - :EDIT-BY "briggs" + :EDIT-BY rmk - :CHANGES-TO (FNS \LOGOUT0 LOGOUT) + :CHANGES-TO (FNS UNPACKFILENAME.STRING) - :PREVIOUS-DATE "31-Dec-2024 11:45:01" {DSK}briggs>Projects>medley>sources>ADIR.;47) + :PREVIOUS-DATE "20-Jan-2025 13:37:28" {WMEDLEY}ADIR.;60) (PRETTYCOMPRINT ADIRCOMS) @@ -321,7 +321,8 @@ (DEFINEQ (UNPACKFILENAME.STRING - [LAMBDA (FILE ONEFIELDFLG DIRFLG OSTYPE PACKFLG CLFLG) (* ; "Edited 11-May-2024 21:23 by rmk") + [LAMBDA (FILE ONEFIELDFLG DIRFLG OSTYPE PACKFLG CLFLG) (* ; "Edited 12-Feb-2025 10:49 by rmk") + (* ; "Edited 11-May-2024 21:23 by rmk") (* ; "Edited 4-May-2024 12:45 by rmk") (* ; "Edited 9-Mar-2024 10:23 by rmk") (* ; "Edited 13-Nov-2023 20:28 by rmk") @@ -421,7 +422,7 @@ (RETURN (FOR C HOST HOSTSTART HOSTEND HOSTENDCHAR STARTPOS DEVICESTART DEVICEEND DIRSTART DIREND DIRBRKSTART DIRBRKEND DIRDIRTY NAMESTART NAMEEND EXTENSIONSTART EXTENSIONEND - VERSIONSTART VERSIONEND INPNAME FILE + VERSIONSTART VERSIONEND TOPS20EXTRASTART INPNAME FILE FIRST (* ;; "Host: { for Medley, [ for some arpanet, ( proposed for Xerox. If the host doesn't end its the whole string") @@ -452,244 +453,309 @@ (* ;; "STARTPOS starts after host, is updated after device for later fields") - (SETQ STARTPOS $$OFFSET) WHEN (AND (IGEQ C MINFILENAMECODE) - (ILEQ C MAXFILENAMECODE)) - DO - (* ;; "Test interval because SELCHARQ doesn't compile as a dispatch.") + (SETQ STARTPOS $$OFFSET) - COERCE - (SELCHARQ C - (%: (* ; + (* ;; "Host: { for Medley, [ for some arpanet, ( proposed for Xerox. If the host doesn't end its the whole string") + + (CL:WHEN [SETQ HOSTENDCHAR (CADR (ASSOC (\GETBASECHAR $$FATP $$BASE $$OFFSET) + (CHARCODE (({ }) + (%( %)) + (%[ %]] + (SETQ HOSTSTART $$OFFSET) + [SETQ HOSTEND (FOR I CH FROM (ADD1 HOSTSTART) TO $$END + DO (* ; "Skip the opening bracket") + (SETQ CH (\GETBASECHAR $$FATP $$BASE I)) + (IF (EQ CH HOSTENDCHAR) + THEN (RETURN I) + ELSEIF (EQ CH (CHARCODE %')) + THEN (ADD I 1)) FINALLY + + (* ;; + "The %"bracket%" is just past the end") + + (RETURN (ADD1 $$END] + (SETQ HOST (\UPF.EXTRACT (ADD1 HOSTSTART) + (SUB1 HOSTEND))) (* ; "Needed for GETHOSTINFO") + (CL:WHEN (IGEQ HOSTEND $$END) (* ; "Only a host") + (GO RETURNVALUE)) + (SETQ $$OFFSET (ADD1 HOSTEND))) + + (* ;; "") + + (* ;; "STARTPOS starts after host, is updated after device for later fields") + + (SETQ STARTPOS $$OFFSET) + + (* ;; "Should there be a default host type other than IFS?") + + (SELECTQ OSTYPE + (NIL (* ; + "GETHOSTINFO seems to fail in loadup")) + ((T NIL) + (SETQ OSTYPE (OR (GETHOSTINFO HOST 'OSTYPE) + 'IFS))) + NIL) WHEN (AND (IGEQ C MINFILENAMECODE) + (ILEQ C MAXFILENAMECODE)) + DO ( + (* ;; "Test interval because SELCHARQ doesn't compile as a dispatch.") + + COERCE + (SELCHARQ C + (%: (* ;  "Device ends on the first colon before any other marker") - (CL:UNLESS (OR DEVICESTART DIRSTART NAMESTART EXTENSIONSTART VERSIONSTART) - (SETQ DEVICESTART STARTPOS) - (SETQ DEVICEEND $$OFFSET) - (SETQ STARTPOS (ADD1 $$OFFSET)))) - (< (CL:UNLESS (OR EXTENSIONSTART VERSIONSTART) + (CL:UNLESS (OR DEVICESTART DIRSTART NAMESTART EXTENSIONSTART VERSIONSTART) + (SETQ DEVICESTART STARTPOS) + (SETQ DEVICEEND $$OFFSET) + (SETQ STARTPOS (ADD1 $$OFFSET)))) + (< (CL:UNLESS (OR EXTENSIONSTART VERSIONSTART) (* ;  "Ordinary character if already started directory or in an extension") - (IF DIRSTART - THEN - (* ;; "DIRECTORY advances over initial duplicate brackets (but DIRSTART could be a subdirectory character instead)") - - (SETQ C (CHARCODE >)) - (GO COERCE) - (IF (EQ DIRSTART (SUB1 $$OFFSET)) - THEN (CL:WHEN (FMEMB (\GETBASECHAR $$FATP $$BASE - (SUB1 $$OFFSET)) - (CHARCODE (> / <))) - (SETQ DIRSTART $$OFFSET)) - ELSE - (* ;; + (IF DIRSTART + THEN + (* ;; "DIRECTORY advances over initial duplicate brackets (but DIRSTART could be a subdirectory character instead)") + + (SETQ C (CHARCODE >)) + (GO COERCE) + (IF (EQ DIRSTART (SUB1 $$OFFSET)) + THEN (CL:WHEN (FMEMB (\GETBASECHAR $$FATP $$BASE + (SUB1 $$OFFSET)) + (CHARCODE (> / <))) + (SETQ DIRSTART $$OFFSET)) + ELSE + (* ;;  "< in the middle: DIRTY flushes it, alternative is (\ILLEGAL.ARG FILE)") - (SETQ DIRDIRTY T)) - ELSE (SETQ DIRSTART STARTPOS) + (SETQ DIRDIRTY T)) + ELSE (SETQ DIRSTART STARTPOS) - (* ;; + (* ;;  "DIRSTART updates for duplicates, but NAME may want all the brackets") - (SETQ DIRBRKSTART STARTPOS)) + (SETQ DIRBRKSTART STARTPOS)) - (* ;; "Borrow DIREND code below if we don't want < after the last > to show up as the first character of the name.") + (* ;; "Borrow DIREND code below if we don't want < after the last > to show up as the first character of the name.") - [SETQ NAMESTART (SETQ NAMEEND (SETQ EXTENSIONSTART (SETQ VERSIONSTART - NIL])) - ((> /) (* ; "Preceding string is for sure a directory that maybe ends here (unless we're already in an extension") - (IF DIRSTART - THEN + [SETQ NAMESTART (SETQ NAMEEND (SETQ EXTENSIONSTART (SETQ VERSIONSTART + NIL])) + ((> /) (* ; "Preceding string is for sure a directory that maybe ends here (unless we're already in an extension") + (IF DIRSTART + THEN (* ;; "> and / in the middle or end of a directory are essentially equivalent: the directory is dirty unless there is exactly one >. A sequence >//>/ reduces at output to a singleton >. It is also dirty if a single occurence is a slash--that is also canonicalized to a single >.") - (* ;; "It is not clear yet whether < in the middle should be treated in the same way, or whether that should cause an error.") + (* ;; "It is not clear yet whether < in the middle should be treated in the same way, or whether that should cause an error.") - (IF (EQ DIRSTART (SUB1 $$OFFSET)) - THEN (CL:WHEN (FMEMB (\GETBASECHAR $$FATP $$BASE (SUB1 - $$OFFSET - )) - (CHARCODE (> / <))) + (IF (EQ DIRSTART (SUB1 $$OFFSET)) + THEN (CL:WHEN (FMEMB (\GETBASECHAR $$FATP $$BASE + (SUB1 $$OFFSET)) + (CHARCODE (> / <))) - (* ;; + (* ;;  "Advance over initial duplicate brackets (but DIRSTART could be a subdirectory character)") - (SETQ DIRSTART $$OFFSET)) - ELSEIF (OR (FMEMB (\GETBASECHAR $$FATP $$BASE (SUB1 $$OFFSET)) - (CHARCODE (> /))) - (EQ C (CHARCODE /))) - THEN - (* ;; "Either extending a sequence, or a single slash.") + (SETQ DIRSTART $$OFFSET)) + ELSEIF (OR (FMEMB (\GETBASECHAR $$FATP $$BASE (SUB1 $$OFFSET)) + (CHARCODE (> /))) + (EQ C (CHARCODE /))) + THEN + (* ;; "Either extending a sequence, or a single slash.") + + (SETQ DIRDIRTY T)) + ELSE (SETQ DIRSTART STARTPOS) + (SETQ DIRBRKSTART STARTPOS)) + (IF DIREND + THEN (CL:UNLESS (EQ DIREND (SUB1 $$OFFSET)) + (CL:WHEN [OR (EQ (\GETBASECHAR $$FATP $$BASE DIREND) + (CHARCODE /)) + (FMEMB (\GETBASECHAR $$FATP $$BASE (ADD1 DIREND + )) + (CHARCODE (> /] - (SETQ DIRDIRTY T)) - ELSE (SETQ DIRSTART STARTPOS) - (SETQ DIRBRKSTART STARTPOS)) - (IF DIREND - THEN (CL:UNLESS (EQ DIREND (SUB1 $$OFFSET)) - (CL:WHEN [OR (EQ (\GETBASECHAR $$FATP $$BASE DIREND) - (CHARCODE /)) - (FMEMB (\GETBASECHAR $$FATP $$BASE (ADD1 DIREND) - ) - (CHARCODE (> /] - - (* ;; + (* ;;  "Previous end may have started an internal duplicate run that needs to be cleaned up") - (SETQ DIRDIRTY T)) - (SETQ DIREND $$OFFSET)) - ELSE - (* ;; + (SETQ DIRDIRTY T)) + (SETQ DIREND $$OFFSET)) + ELSE + (* ;;  "If this is the last bracket, it will be thrown out so it doesn't matter if it is /") - (SETQ DIREND $$OFFSET)) + (SETQ DIREND $$OFFSET)) - (* ;; "NAME keeps duplicates, may want all the brackets.") + (* ;; "NAME keeps duplicates, may want all the brackets.") - (SETQ DIRBRKEND $$OFFSET) + (SETQ DIRBRKEND $$OFFSET) - (* ;; "Toss all prior guesses") + (* ;; "Toss all prior guesses") - [SETQ NAMESTART (SETQ NAMEEND (SETQ EXTENSIONSTART (SETQ VERSIONSTART NIL]) - (%. (CL:UNLESS NAMESTART - (SETQ NAMESTART (IF DIREND - THEN (ADD1 DIRBRKEND) - ELSE STARTPOS))) - (CL:UNLESS (EQ NAMESTART $$OFFSET) (* ; + [SETQ NAMESTART (SETQ NAMEEND (SETQ EXTENSIONSTART (SETQ VERSIONSTART NIL + ]) + (%. (CL:UNLESS NAMESTART + (SETQ NAMESTART (IF DIREND + THEN (ADD1 DIRBRKEND) + ELSE STARTPOS))) + (CL:UNLESS (EQ NAMESTART $$OFFSET)(* ;  "Allow . in first NAME position : .git") - (SETQ NAMEEND (SUB1 $$OFFSET)) - (SETQ EXTENSIONSTART $$OFFSET) - (SETQ EXTENSIONEND NIL))) - (; (CL:WHEN VERSIONSTART (* ; "What about x;1;2") + (if (AND (EQ 'TOPS20 OSTYPE) + EXTENSIONSTART) + then (* ; + "We have already seen at least one dot") + (CL:WHEN VERSIONSTART - (* ;; "This gives old behavior is NAME=x, VERSION=1;2") + (* ;; "We have already seen at least two dots. The extension goes into the name, the version goes into the extension, version disappears.") - (* ;; - "If take this out: NAME=x;1, VERSION=2. I.e. move the previous version to an earlier field") + (* ;; " [N.X].[E/ext].[V/ver] gets converted to") - (GO $$ITERATE)) + (* ;; " [N.X.E/Nam].[V/ext].[") - (* ;; "Starting a version, close up preceders") + (SETQ NAMEEND EXTENSIONEND) + (SETQ EXTENSIONSTART VERSIONSTART)) + (SETQ EXTENSIONEND (SUB1 $$OFFSET)) + (SETQ VERSIONSTART $$OFFSET) + else (SETQ NAMEEND (SUB1 $$OFFSET)) + (SETQ EXTENSIONSTART $$OFFSET) + (SETQ EXTENSIONEND NIL)))) + (; (CL:WHEN (AND VERSIONSTART (NEQ 'TOPS20 OSTYPE)) + (* ; "What about x;1;2") - (CL:UNLESS NAMESTART (* ; "We haven't seen a directory") - (SETQ NAMESTART (IF DIREND - THEN (ADD1 DIRBRKEND) - ELSE STARTPOS))) - (CL:IF EXTENSIONSTART - (SETQ EXTENSIONEND (SUB1 $$OFFSET)) - (SETQ NAMEEND (SUB1 $$OFFSET))) - (SETQ VERSIONSTART $$OFFSET)) - (%' - (* ;; - "Quote the next character (if there is one: original returns empty string in this case).") - - (* ;; "But this is odd: Shouldn't quotes be removed from our value, and reinserted by PACKFILENAME ? Do devices know about our quoting conventions? What about back-slash quoting?") + (* ;; "This gives old behavior is NAME=x, VERSION=1;2") - (ADD $$OFFSET 1)) - (! - (* ;; "! is a Xerox IFS version marker, coerce to ;") - - (CL:WHEN (FMEMB OSTYPE '(T NIL)) - (SETQ OSTYPE (OR (GETHOSTINFO HOST 'OSTYPE) - 'IFS))) - (CL:WHEN (EQ OSTYPE 'IFS) - (SETQ C (CHARCODE ;)) - (GO COERCE))) - NIL) - FINALLY - - (* ;; "Adjudicate directory and name. Empty NAME uses DIRBRKSTART and DIRBRKEND, since names retain duplicate brackets.") - - (IF DIREND - THEN - (* ;; - "NAME is squeezed between directory and extension, version, or end. ") - - (CL:UNLESS NAMESTART - (CL:WHEN (OR NAMEEND (ILESSP DIRBRKEND $$END)) - (SETQ NAMESTART (ADD1 DIRBRKEND)))) - ELSEIF DIRSTART - THEN (* ; "DIR ran off the end") - (IF (FMEMB (\GETBASECHAR $$FATP $$BASE DIRSTART) - (CHARCODE (< /))) - THEN (SETQ DIREND DIRSTART) (* ; " DIR < NAME aaa") - (CL:UNLESS (EQ DIRSTART $$END) - (SETQ NAMESTART (ADD1 DIRBRKSTART))) - ELSE (SETQ NAMESTART DIRBRKSTART) - (* ; "aaaa NAME aaa (e.g. %"{DSK}/Users/kaplan%". If we don't do something, %"kaplan%" would be seen as the NAME. ") + (* ;; "Starting a version or tops20 extra, close up preceders") - (CL:WHEN [AND (EQ DIRFLG 'RETURN) - (OR (ILESSP $$END $$OFFSET) - (NOT (FMEMB (\GETBASECHAR $$FATP $$BASE $$END) - (CHARCODE (> / <] - (SETQ DIRSTART STARTPOS) - (SETQ DIREND (ADD1 $$END)) - (SETQ DIRDIRTY T) - (SETQ NAMESTART (SETQ EXTENSIONSTART (SETQ VERSIONSTART NIL)))) + (CL:UNLESS NAMESTART (* ; "We haven't seen a directory") + (SETQ NAMESTART (IF DIREND + THEN (ADD1 DIRBRKEND) + ELSE STARTPOS))) + (if (EQ 'TOPS20 OSTYPE) + then (if VERSIONSTART + then (SETQ VERSIONEND (SUB1 $$OFFSET)) + elseif EXTENSIONSTART + then (SETQ EXTENSIONEND (SUB1 $$OFFSET)) + else (SETQ NAMEEND (SUB1 $$OFFSET))) + (SETQ TOPS20EXTRASTART $$OFFSET) + else (CL:IF EXTENSIONSTART + (SETQ EXTENSIONEND (SUB1 $$OFFSET)) + (SETQ NAMEEND (SUB1 $$OFFSET))) + (SETQ VERSIONSTART $$OFFSET))) + (%' + (* ;; + "Quote the next character (if there is one: original returns empty string in this case).") - (* ;; + (* ;; "But this is odd: Shouldn't quotes be removed from our value, and reinserted by PACKFILENAME ? Do devices know about our quoting conventions? What about back-slash quoting?") + + (ADD $$OFFSET 1)) + (! + (* ;; "! is a Xerox IFS version marker, coerce to ;") + + (CL:WHEN (EQ OSTYPE 'IFS) + (SETQ C (CHARCODE ;)) + (GO COERCE))) + NIL)) + FINALLY + + (* ;; "Adjudicate directory and name. Empty NAME uses DIRBRKSTART and DIRBRKEND, since names retain duplicate brackets.") + + (IF DIREND + THEN + (* ;; "NAME is squeezed between directory and extension, version, or end. ") + + (CL:UNLESS NAMESTART + (CL:WHEN (OR NAMEEND (ILESSP DIRBRKEND $$END)) + (SETQ NAMESTART (ADD1 DIRBRKEND)))) + ELSEIF DIRSTART + THEN (* ; "DIR ran off the end") + (IF (FMEMB (\GETBASECHAR $$FATP $$BASE DIRSTART) + (CHARCODE (< /))) + THEN (SETQ DIREND DIRSTART) (* ; " DIR < NAME aaa") + (CL:UNLESS (EQ DIRSTART $$END) + (SETQ NAMESTART (ADD1 DIRBRKSTART))) + ELSE (SETQ NAMESTART DIRBRKSTART) (* ; "aaaa NAME aaa (e.g. %"{DSK}/Users/kaplan%". If we don't do something, %"kaplan%" would be seen as the NAME. ") + + (CL:WHEN [AND (EQ DIRFLG 'RETURN) + (OR (ILESSP $$END $$OFFSET) + (NOT (FMEMB (\GETBASECHAR $$FATP $$BASE $$END) + (CHARCODE (> / <] + (SETQ DIRSTART STARTPOS) + (SETQ DIREND (ADD1 $$END)) + (SETQ DIRDIRTY T) + [SETQ NAMESTART (SETQ EXTENSIONSTART (SETQ VERSIONSTART (SETQ TOPS20EXTRASTART NIL]) + + (* ;;  "Construct the return value. DIRFLG=FIELD on calls from FILENAMEFIELD, with a ONEFIELDFLG.") - (* ;; "Fields are interrogated backwards so no need to reverse") + (* ;; "Fields are interrogated backwards so no need to reverse") + + (* ;; "") - RETURNVALUE - (RETURN (FOR F FVAL - INSIDE (OR ONEFIELDFLG - '(VERSION EXTENSION NAME RELATIVEDIRECTORY SUBDIRECTORY - DIRECTORY DEVICE HOST)) - WHEN (SETQ FVAL - (SELECTQ F - (HOST HOST) - (DEVICE (CL:WHEN DEVICESTART + RETURNVALUE + (RETURN (FOR F FVAL + INSIDE (OR ONEFIELDFLG '(TEMPORARY VERSION EXTENSION NAME RELATIVEDIRECTORY + SUBDIRECTORY DIRECTORY DEVICE HOST)) + WHEN (SETQ FVAL + (SELECTQ F + (HOST HOST) + (DEVICE (CL:WHEN DEVICESTART - (* ;; + (* ;;  "Unless CLFLG, include the colon so NIL: works as atom") - (\UPF.EXTRACT DEVICESTART (CL:IF CLFLG - (SUB1 DEVICEEND) - DEVICEEND)))) - (DIRECTORY - (* ;; "Subtypes move up to DIRECTORY if FIELD") - - (CL:WHEN [AND DIRSTART (OR (EQ 'DIRECTORY - (\UPF.DIRTYPE - DIRSTART)) - (EQ DIRFLG - 'FIELD] - (\UPF.DIRECTORY DIRSTART DIREND DIRDIRTY - $$BASE $$FATP $$READONLY))) - ((SUBDIRECTORY RELATIVEDIRECTORY) - (CL:WHEN (AND DIRSTART (EQ F (\UPF.DIRTYPE DIRSTART)) - (NEQ DIRFLG 'FIELD)) + (\UPF.EXTRACT DEVICESTART (CL:IF CLFLG + (SUB1 DEVICEEND) + DEVICEEND)))) + (DIRECTORY + (* ;; "Subtypes move up to DIRECTORY if FIELD") + + (CL:WHEN [AND DIRSTART (OR (EQ 'DIRECTORY (\UPF.DIRTYPE + DIRSTART)) + (EQ DIRFLG 'FIELD] (\UPF.DIRECTORY DIRSTART DIREND DIRDIRTY $$BASE $$FATP $$READONLY))) - (NAME (CL:WHEN NAMESTART - (OR (\UPF.EXTRACT NAMESTART (OR NAMEEND $$END)) - ""))) - (EXTENSION (CL:WHEN EXTENSIONSTART - (OR (\UPF.EXTRACT (ADD1 EXTENSIONSTART) - (OR EXTENSIONEND $$END)) - ""))) - (VERSION (CL:WHEN VERSIONSTART - (OR (\UPF.EXTRACT (ADD1 VERSIONSTART) - $$END) - ""))) - NIL)) DO (CL:WHEN PACKFLG - (SETQ FVAL (CL:UNLESS (EQ 0 (NCHARS FVAL)) - - (* ;; + ((SUBDIRECTORY RELATIVEDIRECTORY) + (CL:WHEN (AND DIRSTART (EQ F (\UPF.DIRTYPE DIRSTART)) + (NEQ DIRFLG 'FIELD)) + (\UPF.DIRECTORY DIRSTART DIREND DIRDIRTY $$BASE $$FATP + $$READONLY))) + (NAME (CL:WHEN NAMESTART + (OR (\UPF.EXTRACT NAMESTART (OR NAMEEND $$END)) + ""))) + (EXTENSION (CL:WHEN EXTENSIONSTART + (OR (\UPF.EXTRACT (ADD1 EXTENSIONSTART) + (OR EXTENSIONEND $$END)) + ""))) + (VERSION (CL:WHEN VERSIONSTART + (OR (\UPF.EXTRACT (ADD1 VERSIONSTART) + (OR VERSIONEND $$END)) + ""))) + (TEMPORARY [CL:WHEN (AND TOPS20EXTRASTART + (STREQUAL "T" (OR (\UPF.EXTRACT + (ADD1 TOPS20EXTRASTART + ) + $$END) + ""]) + NIL)) DO (CL:WHEN PACKFLG + (SETQ FVAL (CL:UNLESS (EQ 0 (NCHARS FVAL)) + + (* ;;  "Empty string goes to NIL, not empty atom") - (MKATOM FVAL)))) - (CL:WHEN ONEFIELDFLG (RETURN FVAL)) - (PUSH $$VAL F FVAL]) + (MKATOM FVAL)))) + (CL:WHEN ONEFIELDFLG (RETURN FVAL)) + (PUSH $$VAL F FVAL]) (\UPF.DIRECTORY [LAMBDA (DIRSTART DIREND DIRDIRTY $$BASE $$FATP $$READONLY)(* ; "Edited 11-May-2024 18:55 by rmk") @@ -1282,14 +1348,14 @@ (ADDTOVAR LAMA PACKFILENAME.STRING PACKFILENAME) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (3225 16052 (DELFILE 3235 . 3396) (FULLNAME 3398 . 3765) (INFILE 3767 . 4026) (INFILEP -4028 . 4163) (IOFILE 4165 . 4416) (OPENFILE 4418 . 4721) (OPENSTREAM 4723 . 9063) (OUTFILE 9065 . 9327 -) (OUTFILEP 9329 . 9465) (RENAMEFILE 9467 . 9773) (SIMPLE.FINDFILE 9775 . 10185) (VMEMSIZE 10187 . -10354) (\COPYSYS 10356 . 14647) (\FLUSHVM 14649 . 15721) (\LOGOUT0 15723 . 16050)) (16551 41211 ( -UNPACKFILENAME.STRING 16561 . 38397) (\UPF.DIRECTORY 38399 . 41209)) (42739 45045 (UNPACKFILENAME -42749 . 42935) (LASTCHPOS 42937 . 43631) (FILENAMEFIELD 43633 . 43927) (FILENAMEFIELD.STRING 43929 . -44333) (PACKFILENAME 44335 . 44678) (PACKFILENAME.STRING 44680 . 45043)) (59515 60428 ( -FILEDIRCASEARRAY 59525 . 60426)) (60595 67903 (LOGOUT 60605 . 61650) (MAKESYS 61652 . 63281) (SYSOUT -63283 . 64835) (SAVEVM 64837 . 65637) (HERALD 65639 . 65799) (INTERPRET.REM.CM 65801 . 67526) ( -\USEREVENT 67528 . 67901)) (68085 69812 (USERNAME 68095 . 69051) (SETUSERNAME 69053 . 69810))))) + (FILEMAP (NIL (3176 16003 (DELFILE 3186 . 3347) (FULLNAME 3349 . 3716) (INFILE 3718 . 3977) (INFILEP +3979 . 4114) (IOFILE 4116 . 4367) (OPENFILE 4369 . 4672) (OPENSTREAM 4674 . 9014) (OUTFILE 9016 . 9278 +) (OUTFILEP 9280 . 9416) (RENAMEFILE 9418 . 9724) (SIMPLE.FINDFILE 9726 . 10136) (VMEMSIZE 10138 . +10305) (\COPYSYS 10307 . 14598) (\FLUSHVM 14600 . 15672) (\LOGOUT0 15674 . 16001)) (16502 45153 ( +UNPACKFILENAME.STRING 16512 . 42339) (\UPF.DIRECTORY 42341 . 45151)) (46681 48987 (UNPACKFILENAME +46691 . 46877) (LASTCHPOS 46879 . 47573) (FILENAMEFIELD 47575 . 47869) (FILENAMEFIELD.STRING 47871 . +48275) (PACKFILENAME 48277 . 48620) (PACKFILENAME.STRING 48622 . 48985)) (63457 64370 ( +FILEDIRCASEARRAY 63467 . 64368)) (64537 71845 (LOGOUT 64547 . 65592) (MAKESYS 65594 . 67223) (SYSOUT +67225 . 68777) (SAVEVM 68779 . 69579) (HERALD 69581 . 69741) (INTERPRET.REM.CM 69743 . 71468) ( +\USEREVENT 71470 . 71843)) (72027 73754 (USERNAME 72037 . 72993) (SETUSERNAME 72995 . 73752))))) STOP diff --git a/sources/ADIR.LCOM b/sources/ADIR.LCOM index 13cc0d9ec..e971758b7 100644 Binary files a/sources/ADIR.LCOM and b/sources/ADIR.LCOM differ