Rmk110 fix unpackfilename.string (#1573)
* ADIR: prevent segmentation fault on Intel macs * Move the coercion of STRUCTURE and GENERATION down into UNPACKFILENAME.STRING It was just in FILENAMEFIELD and FILENAMEFIELD.STRING, I think the coercion should be uniform
This commit is contained in:
rmkaplan
GitHub
parent
dd60b85658
commit
c66583e7b0
74
sources/ADIR
74
sources/ADIR
@ -1,12 +1,12 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
|
||||
(FILECREATED "13-Nov-2023 20:28:57" {WMEDLEY}<sources>ADIR.;31 67473
|
||||
(FILECREATED " 9-Mar-2024 10:24:39" {WMEDLEY}<sources>ADIR.;38 67777
|
||||
|
||||
:EDIT-BY rmk
|
||||
|
||||
:CHANGES-TO (FNS UNPACKFILENAME.STRING)
|
||||
:CHANGES-TO (FNS UNPACKFILENAME.STRING FILENAMEFIELD FILENAMEFIELD.STRING \UPF.DIRECTORY)
|
||||
|
||||
:PREVIOUS-DATE "14-Sep-2023 23:20:17" {WMEDLEY}<sources>ADIR.;30)
|
||||
:PREVIOUS-DATE "13-Nov-2023 20:28:57" {WMEDLEY}<sources>ADIR.;31)
|
||||
|
||||
|
||||
(PRETTYCOMPRINT ADIRCOMS)
|
||||
@ -317,7 +317,8 @@
|
||||
(DEFINEQ
|
||||
|
||||
(UNPACKFILENAME.STRING
|
||||
[LAMBDA (FILE ONEFIELDFLG DIRFLG OSTYPE PACKFLG CLFLG) (* ; "Edited 13-Nov-2023 20:28 by rmk")
|
||||
[LAMBDA (FILE ONEFIELDFLG DIRFLG OSTYPE PACKFLG CLFLG) (* ; "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")
|
||||
|
||||
@ -367,6 +368,12 @@
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(* ;; "These coercions were formerly in FILENAMEFIELD and FILENAMEFIELD.STRING. But they presumably should work everywhere.")
|
||||
|
||||
(SELECTQ ONEFIELDFLG
|
||||
(STRUCTURE (SETQ ONEFIELDFLG 'DEVICE))
|
||||
(GENERATION (SETQ ONEFIELDFLG 'VERSION))
|
||||
NIL)
|
||||
(PROG NIL
|
||||
(COND
|
||||
((NULL FILE)
|
||||
@ -386,6 +393,9 @@
|
||||
FILE)
|
||||
(LIST 'NAME FILE))]
|
||||
(T (\ILLEGAL.ARG FILE)))
|
||||
(CL:WHEN (EQ (NCHARS FILE)
|
||||
0)
|
||||
(RETURN NIL))
|
||||
|
||||
(* ;;
|
||||
"Parse the string to find marker positions. The format (parens mean optional, [ ] group, | disjoins")
|
||||
@ -583,11 +593,12 @@
|
||||
|
||||
(* ;; "")
|
||||
|
||||
(* ;; " DIRFLG is RETURN on calls (\UPFDirectoryNameP CL:USER-HOMEDIR-PATHNAME) where FILE is known to have no more than a directory, but the directory might not end with / or > (e.g. %"{DSK}/Users/kaplan%". If we don't do something, %"kaplan%" would be seen as the NAME. ")
|
||||
(* ;; " DIRFLG is RETURN on calls (\UFSDirectoryNameP CL:USER-HOMEDIR-PATHNAME) where FILE is known to have no more than a directory, but the directory might not end with / or > (e.g. %"{DSK}/Users/kaplan%". If we don't do something, %"kaplan%" would be seen as the NAME. ")
|
||||
|
||||
(CL:WHEN [AND (EQ DIRFLG 'RETURN)
|
||||
(NOT (FMEMB (\GETBASECHAR $$FATP $$BASE $$END)
|
||||
(CHARCODE (> / <]
|
||||
(OR (ILESSP $$END $$OFFSET)
|
||||
(NOT (FMEMB (\GETBASECHAR $$FATP $$BASE $$END)
|
||||
(CHARCODE (> / <]
|
||||
(SETQ DIRSTART STARTPOS)
|
||||
(SETQ DIREND (ADD1 $$END))
|
||||
(SETQ DIRDIRTY T)
|
||||
@ -651,7 +662,8 @@
|
||||
(PUSH $$VAL F FVAL])
|
||||
|
||||
(\UPF.DIRECTORY
|
||||
[LAMBDA (DIRSTART DIREND DIRDIRTY $$BASE $$FATP $$READONLY)(* ; "Edited 28-Apr-2022 09:15 by rmk")
|
||||
[LAMBDA (DIRSTART DIREND DIRDIRTY $$BASE $$FATP $$READONLY)(* ; "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")
|
||||
|
||||
@ -666,9 +678,9 @@
|
||||
NIL)))
|
||||
(IF (EQ DIREND DIRSTART)
|
||||
THEN
|
||||
(* ;; "If EQ, the directory is just the bracket, the rest is must be the name.")
|
||||
(* ;; "If EQ, the directory is is empty.")
|
||||
|
||||
BRACKET
|
||||
(MKSTRING "")
|
||||
ELSE (CL:WHEN BRACKET (* ; "Skip the < or /")
|
||||
(ADD DIRSTART 1))
|
||||
|
||||
@ -753,25 +765,15 @@
|
||||
(RETURN RESULT])
|
||||
|
||||
(FILENAMEFIELD
|
||||
[LAMBDA (FILE FIELDNAME) (* ; "Edited 6-Mar-90 19:38 by nm")
|
||||
(UNPACKFILENAME.STRING FILE (SELECTQ FIELDNAME
|
||||
((VERSION GENERATION)
|
||||
'VERSION)
|
||||
((DEVICE STRUCTURE)
|
||||
'DEVICE)
|
||||
FIELDNAME)
|
||||
'FIELD NIL T])
|
||||
[LAMBDA (FILE FIELDNAME) (* ; "Edited 9-Mar-2024 10:24 by rmk")
|
||||
(* ; "Edited 6-Mar-90 19:38 by nm")
|
||||
(UNPACKFILENAME.STRING FILE FIELDNAME 'FIELD NIL T])
|
||||
|
||||
(FILENAMEFIELD.STRING
|
||||
[LAMBDA (FILE FIELDNAME) (* ; "Edited 26-Mar-2022 09:38 by rmk")
|
||||
[LAMBDA (FILE FIELDNAME) (* ; "Edited 9-Mar-2024 10:24 by rmk")
|
||||
(* ; "Edited 26-Mar-2022 09:38 by rmk")
|
||||
(* ; "Edited 6-Mar-90 19:38 by nm")
|
||||
(UNPACKFILENAME.STRING FILE (SELECTQ FIELDNAME
|
||||
((VERSION GENERATION)
|
||||
'VERSION)
|
||||
((DEVICE STRUCTURE)
|
||||
'DEVICE)
|
||||
FIELDNAME)
|
||||
'FIELD])
|
||||
(UNPACKFILENAME.STRING FILE FIELDNAME 'FIELD])
|
||||
|
||||
(PACKFILENAME
|
||||
[LAMBDA N (* bvm%: " 5-Jul-85 15:40")
|
||||
@ -1252,14 +1254,14 @@
|
||||
(ADDTOVAR LAMA PACKFILENAME.STRING PACKFILENAME)
|
||||
)
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (3119 15776 (DELFILE 3129 . 3290) (FULLNAME 3292 . 3659) (INFILE 3661 . 3920) (INFILEP
|
||||
3922 . 4057) (IOFILE 4059 . 4310) (OPENFILE 4312 . 4615) (OPENSTREAM 4617 . 8957) (OUTFILE 8959 . 9221
|
||||
) (OUTFILEP 9223 . 9359) (RENAMEFILE 9361 . 9667) (SIMPLE.FINDFILE 9669 . 10079) (VMEMSIZE 10081 .
|
||||
10248) (\COPYSYS 10250 . 14495) (\FLUSHVM 14497 . 15569) (\LOGOUT0 15571 . 15774)) (16234 38302 (
|
||||
UNPACKFILENAME.STRING 16244 . 35681) (\UPF.DIRECTORY 35683 . 38300)) (39830 42502 (UNPACKFILENAME
|
||||
39840 . 40026) (LASTCHPOS 40028 . 40722) (FILENAMEFIELD 40724 . 41209) (FILENAMEFIELD.STRING 41211 .
|
||||
41790) (PACKFILENAME 41792 . 42135) (PACKFILENAME.STRING 42137 . 42500)) (56972 57885 (
|
||||
FILEDIRCASEARRAY 56982 . 57883)) (58052 65232 (LOGOUT 58062 . 58979) (MAKESYS 58981 . 60610) (SYSOUT
|
||||
60612 . 62164) (SAVEVM 62166 . 62966) (HERALD 62968 . 63128) (INTERPRET.REM.CM 63130 . 64855) (
|
||||
\USEREVENT 64857 . 65230)) (65414 67141 (USERNAME 65424 . 66380) (SETUSERNAME 66382 . 67139)))))
|
||||
(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)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Loading…
x
Reference in New Issue
Block a user