From edafb6d3402c5da427bd1608864b7695c32617ff Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Wed, 12 Feb 2025 09:34:35 -0800 Subject: [PATCH 1/2] UNPACKFILENAME.STRING deals with TOPS20 versions --- sources/ADIR | 474 ++++++++++++++++++++++++++-------------------- sources/ADIR.LCOM | Bin 19645 -> 20327 bytes 2 files changed, 268 insertions(+), 206 deletions(-) diff --git a/sources/ADIR b/sources/ADIR index b9cd641cb..30823fc19 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 "11-Feb-2025 22:25:49" {WMEDLEY}ADIR.;62 73956 - :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 11-Feb-2025 22:25 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,305 @@ (* ;; "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) + (CL:WHEN (FMEMB OSTYPE '(T NIL)) + (SETQ OSTYPE (OR (GETHOSTINFO HOST 'OSTYPE) + 'IFS))) - 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) + (CL:WHEN (FMEMB OSTYPE '(T NIL)) + (SETQ OSTYPE (OR (GETHOSTINFO HOST 'OSTYPE) + 'IFS))) 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") - - (GO $$ITERATE)) + (* ;; " [N.X].[E/ext].[V/ver] gets converted to") - (* ;; "Starting a version, close up preceders") - - (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).") + (* ;; " [N.X.E/Nam].[V/ext].[") - (* ;; "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?") + (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") - (ADD $$OFFSET 1)) - (! - (* ;; "! is a Xerox IFS version marker, coerce to ;") + (* ;; "This gives old behavior is NAME=x, VERSION=1;2") - (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 +1344,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 45023 ( +UNPACKFILENAME.STRING 16512 . 42209) (\UPF.DIRECTORY 42211 . 45021)) (46551 48857 (UNPACKFILENAME +46561 . 46747) (LASTCHPOS 46749 . 47443) (FILENAMEFIELD 47445 . 47739) (FILENAMEFIELD.STRING 47741 . +48145) (PACKFILENAME 48147 . 48490) (PACKFILENAME.STRING 48492 . 48855)) (63327 64240 ( +FILEDIRCASEARRAY 63337 . 64238)) (64407 71715 (LOGOUT 64417 . 65462) (MAKESYS 65464 . 67093) (SYSOUT +67095 . 68647) (SAVEVM 68649 . 69449) (HERALD 69451 . 69611) (INTERPRET.REM.CM 69613 . 71338) ( +\USEREVENT 71340 . 71713)) (71897 73624 (USERNAME 71907 . 72863) (SETUSERNAME 72865 . 73622))))) STOP diff --git a/sources/ADIR.LCOM b/sources/ADIR.LCOM index 13cc0d9ec0ac2ac1498ff90fd63ed6f416f12056..e9b93132a18ae460271fbff495051717469e580d 100644 GIT binary patch delta 3299 zcmcImZ)_W98TX&8g#c09xQ-Q4_l=jjZvJ?8=ezUS$)Y;(xwh;0F}Bk-Rq1V+Q_g5b2m#e;m5`uP*#whFKJa1E5MMgU6?|g+d)_-I zv7K(;$cMYR`~N#-uj zZ-dN#?ZU-Nha&1V;;N8EM2yd*)1)~u5D0il@#(K%#YX}1-XopY8VjuG!} z;(Yj%h>}n+EQloHkz>ii=;SQ9c)mm;Q;BHin4BLi0P)8&dD5xAKwME0$>!t}Ntnrx z#;_Xka?EJz>1DG^Y%mfGML6jbiZL~p?UgQj=T%9qbw6u+>=!EIAOrP-j_hEv_-PCN zRZr^4;yqjUQvD~!`pWMu%80t`IA{&1&pTWdMo-?eS(fSx^|i-~!K3x+aPsX>(U^Od zy-Gk&zHPf_C-k$z=!*)c15@pRk;J>dv-}`w0M2UvJ&%sNE3}%+W<7gLv)oVo1_J5Q zh9c?;uY(Bu-)kelyaXd4V&=E#`))B)U)2wQxYk=fTwevT^xhTvP{g%AL7=p8$H5#{ zkM46<(nfVjFM{-9>GIM$wya((PrYON4tmn}?fP_S6H9GkwG@8nfYfIw6Eyd1nM$UJ zY27+xV8m&mFU~}===**Rf$4|0w2q$X(#EOF38hP)TCCris`VcK5{2osEaP*1ud$fh zgYs{f>c9E1n#Xk|qQf{uwl$A8G>@B_VZ0%EoJz)rGX6-(6DV-v|0mhr^>LCbEs_%u zcz9j2ajnvSRUSxDw=-2NPhbPBf7NVz(H^f?hjj2>*R1~pA3py9&eigSX8kR6DNe<$ zFDO36s}RMbSvSfP^*1r)i8_wVpLKAq^Jb75>2VLgktl7}YY%YVF5tMhu!U=7>Z&rp zyo}8+ZKCU{VW`pl`(4#H6N*z``*G`6^`||9ZcM+6Rcbz9Zc?n$2Bv-+M$`{_9O z@2!oc$^-Q(zXdj29y?u*U@QM~K>d+(aQNT%!BusEr*<01Z3sZ$!)lglTssEN>X>;L zo#tSw51j5N1NGVgaN~C;xD^lTaq8cLF5LUqX;bvcMn4jC9BO_uKVarV0C&K3uAlCn zPS395!n>j$F@}uY_UO^|y~h3EVEvFNUBeS~3U7O@(Z*WuqcERa&}`q>7OjHE$SFIR0E+JQpEe{5YA|Xv2I;&6oj!vO<6wA$jt>i* zGw8&TPJ9=gbCizXpo5{5PSK!K+@aGjm4ybK1(VJ~8y(AACLPP`kTEv`ne=Fu8!$vE zS)MnimTfj6%L__Yk6wptH;!Hw(tUkOTGu|hZSixW7$VchqXn2IoG64y z27id;@@Vrc$rp0+7iOYqTrmtelbtC{M)Pt!c`8ddK?=8d_+Y5jQ{i|{Y;|#5s6CAn zrM4KBZ3E(1rVWP;hY@Ec8xP>GKY6MExmm(WA}WD`jBr7Y96A)u<)X8rh1sk; znwgoNlyih*5eKR4v>E%p6$tToUM`?acH2ec2rCNewZ4@T9501PL7vV+E{e*rMu?n{ zbNM7>5E#2GpDM^1bIG9OOmrHP!y$>plX5zSrYMm7%w$tX!$Men|42^{8^)G2`K7Qx z{gbSO!dp`$f!o59c)lem7;cXZ1}RL1m2gX%;6ov{c`0%niQ%u{DXNua2;C^c@?nPL z<}?IHoj2#{6a>u%S~;+3c8Yn3utyh>c8=ecBY^7)a{ za%E{bc6n)jc6K?IUs_zK%sjIkyHY9FD$mB27k{!eQ(2D1lbM3=tPnm$Ts%8Gap~$X z&+-An@lk&$8VI?_<)z9l`pn#=tFx8m6H(H0F$?2Rl30?34Be1Dhb18HRIW%mWK-3rNHkv%&t;%g98RJF;__#>;bdiox*!maiwc1#%l%)LhMNCi ze%;&kgJ;huRm*ecZb|u%g_!^4R1R5x$hehL)?*HjmMPyhTNd>9A2s3Uh1=$rYe`-9 zDnGXN*WI^G2W8CotNC^pS!ugHZ-Ei%&&f|s zFVgn@P&+#nA&J9_g=^zmu5!H#xp)M%)|g7*e8Rd+D-61bIfw&RB$j$F45IXnQ{5bF1vlnVneOfkSp;GdAs2=*9DTkM^o1+RQ0>giUt~ z($j{ldk{0Ge?&16c%%*79H8f<;lyprb{y~{?E`aa@y&zANLx7<#5Ny+QA^hc5R((y z+|MD#;0iG_jvOS)E!s70Qtg^ z+&9i?9A|M24p(2?fsG0=H^KWD zy#d=ED|h=(E4TU&$IY`~13MhSOJ49DIzSIoH5Xcq{N@4B)%!ppyn&2c`2i9eVZLd* z-|YV{aLo3c%G}xYMgb?4#B5nv_iCT54o*2|*b+ut!uxE=p)Ei*yK!io)RU~?N%ny! z?X8?|dy;Q?lJD?jlkz2u167&mZdZ6vH#Frd$HDGFD|;HXoBiZUk$r3zD4U0- zDK{M_>ju-sPNvq7%E@*0+n**I4oDh*$_x63?cKFGIjO~0A!)&5OTy^DfIO$hq)`--1LtF$O(+?$a5l+|> z2?hOoBLRL-Bq$(GDWCG;n}9ebL1CJ30Uqo2#QdQUxmfR1#rcE5hruEtj*N>^8j4aT zmjWV$_pk|=@Q`Rf%cBKFsgTKy6P}Nd6DQ(@LVS8yn$C;ExzbcZETB0EgSd&fuWbky z3GHS=DpeFE!iB=SA?gz0g1qv(Ba11_^^~L!gkgO;lLhjArw(o zf_+6!Ks!6o1uoS2lMjYT65mzEP%9q@5^6HOq4>k3AWEe|jzkbSlPZ!38ey!#pzzf&pU Date: Wed, 12 Feb 2025 10:53:59 -0800 Subject: [PATCH 2/2] GETOSTYPE doesn't seem to work in the INIT sysout --- sources/ADIR | 40 ++++++++++++++++++++++------------------ sources/ADIR.LCOM | Bin 20327 -> 20212 bytes 2 files changed, 22 insertions(+), 18 deletions(-) diff --git a/sources/ADIR b/sources/ADIR index 30823fc19..532a8d566 100644 --- a/sources/ADIR +++ b/sources/ADIR @@ -1,6 +1,6 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "11-Feb-2025 22:25:49" {WMEDLEY}ADIR.;62 73956 +(FILECREATED "12-Feb-2025 10:49:30" {WMEDLEY}ADIR.;66 74086 :EDIT-BY rmk @@ -321,7 +321,7 @@ (DEFINEQ (UNPACKFILENAME.STRING - [LAMBDA (FILE ONEFIELDFLG DIRFLG OSTYPE PACKFLG CLFLG) (* ; "Edited 11-Feb-2025 22:25 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") @@ -453,10 +453,7 @@ (* ;; "STARTPOS starts after host, is updated after device for later fields") - (SETQ STARTPOS $$OFFSET) - (CL:WHEN (FMEMB OSTYPE '(T NIL)) - (SETQ OSTYPE (OR (GETHOSTINFO HOST 'OSTYPE) - 'IFS))) + (SETQ STARTPOS $$OFFSET) (* ;; "Host: { for Medley, [ for some arpanet, ( proposed for Xerox. If the host doesn't end its the whole string") @@ -487,11 +484,18 @@ (* ;; "STARTPOS starts after host, is updated after device for later fields") - (SETQ STARTPOS $$OFFSET) - (CL:WHEN (FMEMB OSTYPE '(T NIL)) - (SETQ OSTYPE (OR (GETHOSTINFO HOST 'OSTYPE) - 'IFS))) WHEN (AND (IGEQ C MINFILENAMECODE) - (ILEQ C MAXFILENAMECODE)) + (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.") @@ -1347,11 +1351,11 @@ (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 45023 ( -UNPACKFILENAME.STRING 16512 . 42209) (\UPF.DIRECTORY 42211 . 45021)) (46551 48857 (UNPACKFILENAME -46561 . 46747) (LASTCHPOS 46749 . 47443) (FILENAMEFIELD 47445 . 47739) (FILENAMEFIELD.STRING 47741 . -48145) (PACKFILENAME 48147 . 48490) (PACKFILENAME.STRING 48492 . 48855)) (63327 64240 ( -FILEDIRCASEARRAY 63337 . 64238)) (64407 71715 (LOGOUT 64417 . 65462) (MAKESYS 65464 . 67093) (SYSOUT -67095 . 68647) (SAVEVM 68649 . 69449) (HERALD 69451 . 69611) (INTERPRET.REM.CM 69613 . 71338) ( -\USEREVENT 71340 . 71713)) (71897 73624 (USERNAME 71907 . 72863) (SETUSERNAME 72865 . 73622))))) +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 e9b93132a18ae460271fbff495051717469e580d..e971758b73af7903bd6b3c4d6ea8a1c1aa33b629 100644 GIT binary patch delta 3034 zcmeHJU1%It6z*(7nk+Rxjj8=f&0(pqX_D=|cYf~N(8f$=XR^~wX0|i4F~NYXZTzYA zmx`2H(}EO=KC}!}q(34m76}ou_+UYbPd@qXiy*!z2tuL06a>%ACY#-D!6%>WJlwhG z+nB84FYMA*h?TKt&fko%F(@Sr?aP0U}`Php~HTbu? zg7#6cfx%+Yw~dM$Ii3@tLx#n0A&jh9(=bccoDqb>u;p4N6aV7K*gwDp|9_FRvN?e{&mq*L+9-gDB8 z>hHamrEJ^%*;js=KVN#TJHEO7m+rm|>yCM1ZLoT&|JAL_3WM1hBl2f~X)*)PEa8^0 zPjSU4u#Qv=7nsUbSS(kfDI>IOXTFRc4fAgDC=_#T_7K|QVQOpCGE?wGn!<=^1tNM2 z5EUGODrLJ+bOOta{9pm7u3}t^j}xsKoob>f6}b#t*I?R;N`8nnvVGuGZ;s)FH#uTH zcsJ4*U=hoHVBp$JCJg4RAar~W7{!#V`N;B8lM2L7=|qJpgY8&u5vWiIgq5j=?F(6n zFKGS!R4@t+ew~xVKSgz|HAH8815c--DTpd9@Hz?vVU{V!189KfNUa7_6&#AzoMT!* zRb7STQ~>FxLSRLezym5{ogF(wF3K82emP_W`$W|HR8cniT*&EMjs--Zg|Zc2e=;1Q z6mmIWiq0SxB^|6>;$T8a-xP_6HdPfZ-aYheMy1tvhW^fMiu>K%8+D_4FLzOra`D-H zL<-`SeWP7NKCJEWLGG*$9oW?-t*+(2k~%1A*_?^L8$Pm}aK|%!&t$l9tRvO|sqT2w zNlq%5B^;wbkx-j`Jl=I_P$G12jW9AxWgm}$pc3jsiGre1q9M~S;t>*7my{4%Eo>r< z6PSEmU_#{$kh+eNa9r1#Hr#>{OoPU?n(RSkdVFX9P962Qxobtyn^skj!0SoKm}^+_ zD{j%lGO8@@8QCS#_|wCW_hEua>xO0Gqay>$**s-f&_&yEt%S6NaKVd=d7O;ff2x3Q zJfVk-CK7odhTy&*;-wG6Cj^tW<9j20hvWuj>G*xx5LUwROy+iHh9nt&>{AsFc$h0&ntOqasy@s*7gbs9GIdMOmkzD&7(6YETln)IULr&g(Y@$f&b) zx{M#ajTB^=Hl!fqsii3}tY=`kM*QX8ZkwsJc@GQ=wYdlt^<*f@a$TSt{28RL3R8X& zzlDUyZ;tK2n-IH#Kpt7H@L@D$fd)wpfw^uB2t32w!5j!g%#Gt)L5ZHjH$HV2v} z;$3>KD+@9~Y2y9b*E<;RE`0p2!rMk6k(v>?P8dCs-y`|`Z{#-+uO9CF4<-0nQE$he zKI`DE0o1vQx`aZZfY&HW8Bn6t%pqUG3BkmNwg1&$C+?&9^V6@_%<|*`G|x{$&HQ}w zY9Ido5*YXVVAgPJ|FJX1SO#aEF(fH7H delta 3156 zcmeHJ-D@0G6whozn%M3(Hi@;=)Wf2C;TbZCl;Tp`YQ)->61aOea0%naX@_{WJoL#LszDJxPMSDK5y+jldF9sSjG@Xi$?G}g` zszSB;-i~w(#h|L~nt?NCcdBu^4pBFhcvqumo38iz(-poJOb5m~eMm-6Y+aK6Dz=W= zb=YYdYl#h9fXX=)>^aA>F=rx06(uGcB76n)ss|VYBTf-`<|?DWuhig>aY=5?nQE-f zb*9IAbzD9iEmUk$0MN)>kwNK1#h4ryGd#5Ip6y^sHVbTu8f61aWFR6^NX&>w27AaD zSoqDhdsCXxlyChb)ovd~_VJd`{5X3?5bg*U@}h7cd?~*pbDK|}kWa^kViq@7^IQ6b z_nP0b_l41@XIT4?pa@)gmhV|SJS**w*o9jKksNOpnaUzrC9E=H3}tD}Ig&_-$CxOQ zYt{m*RPj+L5d~RW5>Y)bC`B7Bzkni(Kv`>1WF2+};E1S7!e2w>9c#J{#yPHQ&zf%D ztj?0Ev!wlyf_txf;pIEWcFMZgada7-sx!2VhI#e$5;$Ee`E|G8;kHrX*ui*8R>Lpd z@m&m{=!%9@(_(a;WwW*~UoU!;oD~&9Uy;eIRNRHA5pu4C%gX3_j?8Y)qhhic$^DFR zjAJRCVHg*pO=AraITan(j);}7EqH-BPda$l=A=WokQ-4c_`! zA{pH{4kV#PtaTX);BTiSF`lHvagA{v;mL_~gDYzHA$UaDb_+F