Skip to content

Commit c66583e

Browse files
authored
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
1 parent dd60b85 commit c66583e

File tree

2 files changed

+38
-36
lines changed

2 files changed

+38
-36
lines changed

sources/ADIR

Lines changed: 38 additions & 36 deletions
Original file line numberDiff line numberDiff line change
@@ -1,12 +1,12 @@
11
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
22

3-
(FILECREATED "13-Nov-2023 20:28:57" {WMEDLEY}<sources>ADIR.;31 67473
3+
(FILECREATED " 9-Mar-2024 10:24:39" {WMEDLEY}<sources>ADIR.;38 67777
44

55
:EDIT-BY rmk
66

7-
:CHANGES-TO (FNS UNPACKFILENAME.STRING)
7+
:CHANGES-TO (FNS UNPACKFILENAME.STRING FILENAMEFIELD FILENAMEFIELD.STRING \UPF.DIRECTORY)
88

9-
:PREVIOUS-DATE "14-Sep-2023 23:20:17" {WMEDLEY}<sources>ADIR.;30)
9+
:PREVIOUS-DATE "13-Nov-2023 20:28:57" {WMEDLEY}<sources>ADIR.;31)
1010

1111

1212
(PRETTYCOMPRINT ADIRCOMS)
@@ -317,7 +317,8 @@
317317
(DEFINEQ
318318

319319
(UNPACKFILENAME.STRING
320-
[LAMBDA (FILE ONEFIELDFLG DIRFLG OSTYPE PACKFLG CLFLG) (* ; "Edited 13-Nov-2023 20:28 by rmk")
320+
[LAMBDA (FILE ONEFIELDFLG DIRFLG OSTYPE PACKFLG CLFLG) (* ; "Edited 9-Mar-2024 10:23 by rmk")
321+
(* ; "Edited 13-Nov-2023 20:28 by rmk")
321322
(* ; "Edited 28-Apr-2022 11:40 by rmk")
322323
(* ; "Edited 24-Apr-2022 14:11 by rmk")
323324

@@ -367,6 +368,12 @@
367368

368369
(* ;; "")
369370

371+
(* ;; "These coercions were formerly in FILENAMEFIELD and FILENAMEFIELD.STRING. But they presumably should work everywhere.")
372+
373+
(SELECTQ ONEFIELDFLG
374+
(STRUCTURE (SETQ ONEFIELDFLG 'DEVICE))
375+
(GENERATION (SETQ ONEFIELDFLG 'VERSION))
376+
NIL)
370377
(PROG NIL
371378
(COND
372379
((NULL FILE)
@@ -386,6 +393,9 @@
386393
FILE)
387394
(LIST 'NAME FILE))]
388395
(T (\ILLEGAL.ARG FILE)))
396+
(CL:WHEN (EQ (NCHARS FILE)
397+
0)
398+
(RETURN NIL))
389399

390400
(* ;;
391401
 "Parse the string to find marker positions. The format (parens mean optional, [ ] group, | disjoins")
@@ -583,11 +593,12 @@
583593

584594
(* ;; "")
585595

586-
(* ;; " 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. ")
596+
(* ;; " 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. ")
587597

588598
(CL:WHEN [AND (EQ DIRFLG 'RETURN)
589-
(NOT (FMEMB (\GETBASECHAR $$FATP $$BASE $$END)
590-
(CHARCODE (> / <]
599+
(OR (ILESSP $$END $$OFFSET)
600+
(NOT (FMEMB (\GETBASECHAR $$FATP $$BASE $$END)
601+
(CHARCODE (> / <]
591602
(SETQ DIRSTART STARTPOS)
592603
(SETQ DIREND (ADD1 $$END))
593604
(SETQ DIRDIRTY T)
@@ -651,7 +662,8 @@
651662
(PUSH $$VAL F FVAL])
652663

653664
(\UPF.DIRECTORY
654-
[LAMBDA (DIRSTART DIREND DIRDIRTY $$BASE $$FATP $$READONLY)(* ; "Edited 28-Apr-2022 09:15 by rmk")
665+
[LAMBDA (DIRSTART DIREND DIRDIRTY $$BASE $$FATP $$READONLY)(* ; "Edited 8-Mar-2024 23:03 by rmk")
666+
(* ; "Edited 28-Apr-2022 09:15 by rmk")
655667
(* ; "Edited 27-Apr-2022 08:50 by rmk")
656668
(* ; "Edited 23-Apr-2022 17:09 by rmk")
657669

@@ -666,9 +678,9 @@
666678
NIL)))
667679
(IF (EQ DIREND DIRSTART)
668680
THEN
669-
(* ;; "If EQ, the directory is just the bracket, the rest is must be the name.")
681+
(* ;; "If EQ, the directory is is empty.")
670682

671-
BRACKET
683+
(MKSTRING "")
672684
ELSE (CL:WHEN BRACKET (* ; "Skip the < or /")
673685
(ADD DIRSTART 1))
674686

@@ -753,25 +765,15 @@
753765
(RETURN RESULT])
754766

755767
(FILENAMEFIELD
756-
[LAMBDA (FILE FIELDNAME) (* ; "Edited 6-Mar-90 19:38 by nm")
757-
(UNPACKFILENAME.STRING FILE (SELECTQ FIELDNAME
758-
((VERSION GENERATION)
759-
'VERSION)
760-
((DEVICE STRUCTURE)
761-
'DEVICE)
762-
FIELDNAME)
763-
'FIELD NIL T])
768+
[LAMBDA (FILE FIELDNAME) (* ; "Edited 9-Mar-2024 10:24 by rmk")
769+
(* ; "Edited 6-Mar-90 19:38 by nm")
770+
(UNPACKFILENAME.STRING FILE FIELDNAME 'FIELD NIL T])
764771

765772
(FILENAMEFIELD.STRING
766-
[LAMBDA (FILE FIELDNAME) (* ; "Edited 26-Mar-2022 09:38 by rmk")
773+
[LAMBDA (FILE FIELDNAME) (* ; "Edited 9-Mar-2024 10:24 by rmk")
774+
(* ; "Edited 26-Mar-2022 09:38 by rmk")
767775
(* ; "Edited 6-Mar-90 19:38 by nm")
768-
(UNPACKFILENAME.STRING FILE (SELECTQ FIELDNAME
769-
((VERSION GENERATION)
770-
'VERSION)
771-
((DEVICE STRUCTURE)
772-
'DEVICE)
773-
FIELDNAME)
774-
'FIELD])
776+
(UNPACKFILENAME.STRING FILE FIELDNAME 'FIELD])
775777

776778
(PACKFILENAME
777779
[LAMBDA N (* bvm%: " 5-Jul-85 15:40")
@@ -1252,14 +1254,14 @@
12521254
(ADDTOVAR LAMA PACKFILENAME.STRING PACKFILENAME)
12531255
)
12541256
(DECLARE%: DONTCOPY
1255-
(FILEMAP (NIL (3119 15776 (DELFILE 3129 . 3290) (FULLNAME 3292 . 3659) (INFILE 3661 . 3920) (INFILEP
1256-
3922 . 4057) (IOFILE 4059 . 4310) (OPENFILE 4312 . 4615) (OPENSTREAM 4617 . 8957) (OUTFILE 8959 . 9221
1257-
) (OUTFILEP 9223 . 9359) (RENAMEFILE 9361 . 9667) (SIMPLE.FINDFILE 9669 . 10079) (VMEMSIZE 10081 .
1258-
10248) (\COPYSYS 10250 . 14495) (\FLUSHVM 14497 . 15569) (\LOGOUT0 15571 . 15774)) (16234 38302 (
1259-
UNPACKFILENAME.STRING 16244 . 35681) (\UPF.DIRECTORY 35683 . 38300)) (39830 42502 (UNPACKFILENAME
1260-
39840 . 40026) (LASTCHPOS 40028 . 40722) (FILENAMEFIELD 40724 . 41209) (FILENAMEFIELD.STRING 41211 .
1261-
41790) (PACKFILENAME 41792 . 42135) (PACKFILENAME.STRING 42137 . 42500)) (56972 57885 (
1262-
FILEDIRCASEARRAY 56982 . 57883)) (58052 65232 (LOGOUT 58062 . 58979) (MAKESYS 58981 . 60610) (SYSOUT
1263-
60612 . 62164) (SAVEVM 62166 . 62966) (HERALD 62968 . 63128) (INTERPRET.REM.CM 63130 . 64855) (
1264-
\USEREVENT 64857 . 65230)) (65414 67141 (USERNAME 65424 . 66380) (SETUSERNAME 66382 . 67139)))))
1257+
(FILEMAP (NIL (3169 15826 (DELFILE 3179 . 3340) (FULLNAME 3342 . 3709) (INFILE 3711 . 3970) (INFILEP
1258+
3972 . 4107) (IOFILE 4109 . 4360) (OPENFILE 4362 . 4665) (OPENSTREAM 4667 . 9007) (OUTFILE 9009 . 9271
1259+
) (OUTFILEP 9273 . 9409) (RENAMEFILE 9411 . 9717) (SIMPLE.FINDFILE 9719 . 10129) (VMEMSIZE 10131 .
1260+
10298) (\COPYSYS 10300 . 14545) (\FLUSHVM 14547 . 15619) (\LOGOUT0 15621 . 15824)) (16284 38972 (
1261+
UNPACKFILENAME.STRING 16294 . 36274) (\UPF.DIRECTORY 36276 . 38970)) (40500 42806 (UNPACKFILENAME
1262+
40510 . 40696) (LASTCHPOS 40698 . 41392) (FILENAMEFIELD 41394 . 41688) (FILENAMEFIELD.STRING 41690 .
1263+
42094) (PACKFILENAME 42096 . 42439) (PACKFILENAME.STRING 42441 . 42804)) (57276 58189 (
1264+
FILEDIRCASEARRAY 57286 . 58187)) (58356 65536 (LOGOUT 58366 . 59283) (MAKESYS 59285 . 60914) (SYSOUT
1265+
60916 . 62468) (SAVEVM 62470 . 63270) (HERALD 63272 . 63432) (INTERPRET.REM.CM 63434 . 65159) (
1266+
\USEREVENT 65161 . 65534)) (65718 67445 (USERNAME 65728 . 66684) (SETUSERNAME 66686 . 67443)))))
12651267
STOP

sources/ADIR.LCOM

-8 Bytes
Binary file not shown.

0 commit comments

Comments
 (0)