github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-03-03 02:17:57 +00:00
Code Issues Projects Releases Wiki Activity

Change default EOL to LF on UFS (#312)

Browse Source 
UFS changes the the default in \UFSeol to LF.EOLC.  LLREAD changes \rprint2 to convert EOL to LF if escaped in a string.  NSPROTECTION eliminates literal EOL
This commit is contained in:
rmkaplan
2021-04-22 21:10:48 -07:00
committed by GitHub
parent f0b9ce3dae
commit 21c8759084
6 changed files with 277 additions and 206 deletions
Download Patch File Download Diff File Expand all files Collapse all files

106
lispusers/NSPROTECTION
View File

@@ -1,16 +1,47 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED " 7-Sep-89 12:31:44" "{piglet/n}<piglet>vanmelle>lispusers>nsprotection;4" 31274
(FILECREATED "21-Apr-2021 11:56:06" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>NSPROTECTION.;4 32481
changes to%: (FNS NSPROT.SET.MULTIPLE))
changes to%: (FNS NSPROT.LIMITCHARS)
previous date%: " 7-Sep-89 12:31:44"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>NSPROTECTION.;2)
(* "
Copyright (c) 1987, 1989 by Xerox Corporation. All rights reserved.
(* ; "
Copyright (c) 1987, 1989, 2021 by Xerox Corporation.
")
(PRETTYCOMPRINT NSPROTECTIONCOMS)
(RPAQQ NSPROTECTIONCOMS ((COMS (* ; "Main window selection handlers") (FNS NSPROTECTION NSPROT.SHOW NSPROT.FETCH.PROTECTION NSPROT.NEW.ENTRY NSPROT.APPLY NSPROT.SET.PROTECTION NSPROT.SET.PROTECTION.ONE NSPROT.SET.MULTIPLE NSPROT.SET.TO.DEFAULT NSPROT.BEGIN.COMMAND) (FNS NSPROT.HANDLE.TYPE NSPROT.RESTORE.TYPE NSPROT.HANDLE.VERIFY NSPROT.RESTORE.VERIFY NSPROT.PARSE.FILENAME NSPROT.PARSE.PROTECTIONS NSPROT.STRIP.HOST NSPROT.EXPAND.FULLNAME)) (COMS (* ; "Handle protection submenus") (FNS NSPROT.GET.SUBMENU NSPROT.ADD.SUBMENU NSPROT.REMOVE.SUBMENUS NSPROT.CHANGE.STATE NSPROT.HANDLE.ALL NSPROT.MESSAGE.ALL NSPROT.HANDLE.SUBTYPE NSPROT.SHOW.PROT.VALUE)) (COMS (* ; "utilities") (FNS NSPROT.DIRECTORY.SYNTAXP NSPROT.TOP.LEVELP NSPROT.GET.FONT NSPROT.PROMPT NSPROT.CLEAR.PROMPT NSPROT.LIMITCHARS NSPROT.PAGEFULLFN NSPROT.ICONFN)) (INITVARS NSPROT.PLAIN.FONT NSPROT.BOLD.FONT) (VARS NSPROT.ICON) (GLOBALVARS NSPROT.PLAIN.FONT NSPROT.BOLD.FONT \NSFILING.ATTRIBUTES NSPROT.ICON \DEFAULTTTYDISPLAYSTREAM) (LOCALVARS . T) (COMS (DECLARE%: DONTEVAL@LOAD DOCOPY (P (AND (EQ MAKESYSNAME :LYRIC) (FILESLOAD (SYSLOAD) NSRANDOM)))) (FNS ADD.NSPROTECTION) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (ADD.NSPROTECTION)))) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (NLAML) (LAMA NSPROT.PROMPT)))))
(RPAQQ NSPROTECTIONCOMS
[(COMS (* ; "Main window selection handlers")
(FNS NSPROTECTION NSPROT.SHOW NSPROT.FETCH.PROTECTION NSPROT.NEW.ENTRY NSPROT.APPLY
NSPROT.SET.PROTECTION NSPROT.SET.PROTECTION.ONE NSPROT.SET.MULTIPLE
NSPROT.SET.TO.DEFAULT NSPROT.BEGIN.COMMAND)
(FNS NSPROT.HANDLE.TYPE NSPROT.RESTORE.TYPE NSPROT.HANDLE.VERIFY NSPROT.RESTORE.VERIFY
NSPROT.PARSE.FILENAME NSPROT.PARSE.PROTECTIONS NSPROT.STRIP.HOST
NSPROT.EXPAND.FULLNAME))
(COMS (* ; "Handle protection submenus")
(FNS NSPROT.GET.SUBMENU NSPROT.ADD.SUBMENU NSPROT.REMOVE.SUBMENUS NSPROT.CHANGE.STATE
NSPROT.HANDLE.ALL NSPROT.MESSAGE.ALL NSPROT.HANDLE.SUBTYPE NSPROT.SHOW.PROT.VALUE)
)
(COMS (* ; "utilities")
(FNS NSPROT.DIRECTORY.SYNTAXP NSPROT.TOP.LEVELP NSPROT.GET.FONT NSPROT.PROMPT
NSPROT.CLEAR.PROMPT NSPROT.LIMITCHARS NSPROT.PAGEFULLFN NSPROT.ICONFN))
(INITVARS NSPROT.PLAIN.FONT NSPROT.BOLD.FONT)
(VARS NSPROT.ICON)
(GLOBALVARS NSPROT.PLAIN.FONT NSPROT.BOLD.FONT \NSFILING.ATTRIBUTES NSPROT.ICON
\DEFAULTTTYDISPLAYSTREAM)
(LOCALVARS . T)
[COMS [DECLARE%: DONTEVAL@LOAD DOCOPY (P (AND (EQ MAKESYSNAME :LYRIC)
(FILESLOAD (SYSLOAD)
NSRANDOM]
(FNS ADD.NSPROTECTION)
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (ADD.NSPROTECTION]
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA])
@@ -159,8 +190,16 @@ Copyright (c) 1987, 1989 by Xerox Corporation. All rights reserved.
)
(NSPROT.LIMITCHARS
(LAMBDA (ITEM WINDOW CHAR) (* ; "Edited 21-Aug-87 12:00 by bvm:") (SELECTQ CHAR ((%
Â) (FM.SKIPNEXT WINDOW) NIL) T)))
[LAMBDA (ITEM WINDOW CHAR) (* ; "Edited 21-Apr-2021 11:55 by rmk:")
(* ;; "RMK: Got rid of literal %%<CR> in favor of CHARCODE CR, for switch to default LF EOL convention. But compiled file may end up with LF")
(SELECTC CHAR
((LIST (CHARACTER (CHARCODE CR))
'Â)
(FM.SKIPNEXT WINDOW)
NIL)
T])
(NSPROT.PAGEFULLFN
(LAMBDA (PW) (* ; "Edited 2-Aug-89 16:19 by bvm") (* ;; "PAGEFULLFN for prompt window--makes the window a line bigger and allows output to proceed") (SETQ \CURRENTDISPLAYLINE (PROG1 \#DISPLAYLINES (GETPROMPTWINDOW (MAINWINDOW PW) (+ 1 \#DISPLAYLINES)) (* ; "\Currentdisplayline is the line we're on when window fills, origin zero"))))
@@ -171,14 +210,17 @@ Copyright (c) 1987, 1989 by Xerox Corporation. All rights reserved.
)
)
(RPAQ? NSPROT.PLAIN.FONT NIL)
(RPAQ? NSPROT.PLAIN.FONT NIL)
(RPAQ? NSPROT.BOLD.FONT NIL)
(RPAQ? NSPROT.BOLD.FONT NIL)
(RPAQQ NSPROT.ICON (#*(80 40)OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@@@@@@@@@@@@@@@@@CL@@@@@@@@@@@@@@@@@@CL@@@@@@@@@@@@@@@@@@CL@@@@@@@@@@@@@@@@@@CL@@@@@@@@@@@@@@AN@@CL@@@@@@@@@@@@@@GOH@CL@@@@@@@@@@@@@@OOL@CL@@@@@@@@@@@@@AOCN@CL@@@@@@@@@@@@@ANAN@CL@@@@@@@@@@@@@CL@O@CL@@@@@@@@@@@@@CL@O@CL@@@@@@@@@@@@@GH@G@CL@@@@@@@@@@@@@GH@GHCL@@@@@@@@@@@@@GH@GHCL@@@@@@@@@@@@@O@@CHCL@@@@@@@@@@@@@O@@CHCLAOOOOOOOOOOOOO@@CHCLCOOOOOOOOOOOOO@@CHCLCOOOOOOOOOOOOO@@CHCLAOOOOOOOOOOOOO@@CHCL@GNGNGN@@@@@@O@@CHCL@GNGNGN@@@@@@O@@CHCL@GNFFGN@@@@@@GH@GHCL@FFFFGN@@@@@@GH@GHCL@FF@@GN@@@@@@GH@G@CL@@@@@FF@@@@@@CL@O@CL@@@@@FF@@@@@@CL@O@CL@@@@@@@@@@@@@ANAN@CL@@@@@@@@@@@@@AOCN@CL@@@@@@@@@@@@@@OOL@CL@@@@@@@@@@@@@@GOH@CL@@@@@@@@@@@@@@CO@@CL@@@@@@@@@@@@@@@L@@CL@@@@@@@@@@@@@@@@@@CL@@@@@@@@@@@@@@@@@@CL@@@@@@@@@@@@@@@@@@COOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO NIL (4 22 51 14)))
(RPAQQ NSPROT.ICON (#*(80 40)OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOL@@@@@@@@@@@@@@@@@@CL@@@@@@@@@@@@@@@@@@CL@@@@@@@@@@@@@@@@@@CL@@@@@@@@@@@@@@@@@@CL@@@@@@@@@@@@@@AN@@CL@@@@@@@@@@@@@@GOH@CL@@@@@@@@@@@@@@OOL@CL@@@@@@@@@@@@@AOCN@CL@@@@@@@@@@@@@ANAN@CL@@@@@@@@@@@@@CL@O@CL@@@@@@@@@@@@@CL@O@CL@@@@@@@@@@@@@GH@G@CL@@@@@@@@@@@@@GH@GHCL@@@@@@@@@@@@@GH@GHCL@@@@@@@@@@@@@O@@CHCL@@@@@@@@@@@@@O@@CHCLAOOOOOOOOOOOOO@@CHCLCOOOOOOOOOOOOO@@CHCLCOOOOOOOOOOOOO@@CHCLAOOOOOOOOOOOOO@@CHCL@GNGNGN@@@@@@O@@CHCL@GNGNGN@@@@@@O@@CHCL@GNFFGN@@@@@@GH@GHCL@FFFFGN@@@@@@GH@GHCL@FF@@GN@@@@@@GH@G@CL@@@@@FF@@@@@@CL@O@CL@@@@@FF@@@@@@CL@O@CL@@@@@@@@@@@@@ANAN@CL@@@@@@@@@@@@@AOCN@CL@@@@@@@@@@@@@@OOL@CL@@@@@@@@@@@@@@GOH@CL@@@@@@@@@@@@@@CO@@CL@@@@@@@@@@@@@@@L@@CL@@@@@@@@@@@@@@@@@@CL@@@@@@@@@@@@@@@@@@CL@@@@@@@@@@@@@@@@@@COOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
NIL
(4 22 51 14)))
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS NSPROT.PLAIN.FONT NSPROT.BOLD.FONT \NSFILING.ATTRIBUTES NSPROT.ICON \DEFAULTTTYDISPLAYSTREAM)
(GLOBALVARS NSPROT.PLAIN.FONT NSPROT.BOLD.FONT \NSFILING.ATTRIBUTES NSPROT.ICON
\DEFAULTTTYDISPLAYSTREAM)
)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
@@ -186,7 +228,9 @@ Copyright (c) 1987, 1989 by Xerox Corporation. All rights reserved.
)
(DECLARE%: DONTEVAL@LOAD DOCOPY
(AND (EQ MAKESYSNAME :LYRIC) (FILESLOAD (SYSLOAD) NSRANDOM))
(AND (EQ MAKESYSNAME :LYRIC)
(FILESLOAD (SYSLOAD)
NSRANDOM))
)
(DEFINEQ
@@ -196,30 +240,30 @@ Copyright (c) 1987, 1989 by Xerox Corporation. All rights reserved.
)
(DECLARE%: DONTEVAL@LOAD DOCOPY
(ADD.NSPROTECTION)
(ADD.NSPROTECTION)
)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA)
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML)
(ADDTOVAR NLAML )
(ADDTOVAR LAMA NSPROT.PROMPT)
(ADDTOVAR LAMA )
)
(PUTPROPS NSPROTECTION COPYRIGHT ("Xerox Corporation" 1987 1989))
(PUTPROPS NSPROTECTION COPYRIGHT ("Xerox Corporation" 1987 1989 2021))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (1695 14166 (NSPROTECTION 1705 . 4891) (NSPROT.SHOW 4893 . 5411) (
NSPROT.FETCH.PROTECTION 5413 . 8347) (NSPROT.NEW.ENTRY 8349 . 8972) (NSPROT.APPLY 8974 . 9903) (
NSPROT.SET.PROTECTION 9905 . 10481) (NSPROT.SET.PROTECTION.ONE 10483 . 11359) (NSPROT.SET.MULTIPLE
11361 . 12860) (NSPROT.SET.TO.DEFAULT 12862 . 13674) (NSPROT.BEGIN.COMMAND 13676 . 14164)) (14167
21199 (NSPROT.HANDLE.TYPE 14177 . 14477) (NSPROT.RESTORE.TYPE 14479 . 14830) (NSPROT.HANDLE.VERIFY
14832 . 15192) (NSPROT.RESTORE.VERIFY 15194 . 15525) (NSPROT.PARSE.FILENAME 15527 . 17256) (
NSPROT.PARSE.PROTECTIONS 17258 . 19753) (NSPROT.STRIP.HOST 19755 . 20136) (NSPROT.EXPAND.FULLNAME
20138 . 21197)) (21243 25794 (NSPROT.GET.SUBMENU 21253 . 23057) (NSPROT.ADD.SUBMENU 23059 . 23366) (
NSPROT.REMOVE.SUBMENUS 23368 . 23788) (NSPROT.CHANGE.STATE 23790 . 24072) (NSPROT.HANDLE.ALL 24074 .
24316) (NSPROT.MESSAGE.ALL 24318 . 24590) (NSPROT.HANDLE.SUBTYPE 24592 . 25137) (
NSPROT.SHOW.PROT.VALUE 25139 . 25792)) (25821 29042 (NSPROT.DIRECTORY.SYNTAXP 25831 . 26015) (
NSPROT.TOP.LEVELP 26017 . 26179) (NSPROT.GET.FONT 26181 . 26700) (NSPROT.PROMPT 26702 . 27226) (
NSPROT.CLEAR.PROMPT 27228 . 28111) (NSPROT.LIMITCHARS 28113 . 28254) (NSPROT.PAGEFULLFN 28256 . 28616)
(NSPROT.ICONFN 28618 . 29040)) (30249 30998 (ADD.NSPROTECTION 30259 . 30996)))))
(FILEMAP (NIL (2525 14996 (NSPROTECTION 2535 . 5721) (NSPROT.SHOW 5723 . 6241) (
NSPROT.FETCH.PROTECTION 6243 . 9177) (NSPROT.NEW.ENTRY 9179 . 9802) (NSPROT.APPLY 9804 . 10733) (
NSPROT.SET.PROTECTION 10735 . 11311) (NSPROT.SET.PROTECTION.ONE 11313 . 12189) (NSPROT.SET.MULTIPLE
12191 . 13690) (NSPROT.SET.TO.DEFAULT 13692 . 14504) (NSPROT.BEGIN.COMMAND 14506 . 14994)) (14997
22029 (NSPROT.HANDLE.TYPE 15007 . 15307) (NSPROT.RESTORE.TYPE 15309 . 15660) (NSPROT.HANDLE.VERIFY
15662 . 16022) (NSPROT.RESTORE.VERIFY 16024 . 16355) (NSPROT.PARSE.FILENAME 16357 . 18086) (
NSPROT.PARSE.PROTECTIONS 18088 . 20583) (NSPROT.STRIP.HOST 20585 . 20966) (NSPROT.EXPAND.FULLNAME
20968 . 22027)) (22073 26624 (NSPROT.GET.SUBMENU 22083 . 23887) (NSPROT.ADD.SUBMENU 23889 . 24196) (
NSPROT.REMOVE.SUBMENUS 24198 . 24618) (NSPROT.CHANGE.STATE 24620 . 24902) (NSPROT.HANDLE.ALL 24904 .
25146) (NSPROT.MESSAGE.ALL 25148 . 25420) (NSPROT.HANDLE.SUBTYPE 25422 . 25967) (
NSPROT.SHOW.PROT.VALUE 25969 . 26622)) (26651 30154 (NSPROT.DIRECTORY.SYNTAXP 26661 . 26845) (
NSPROT.TOP.LEVELP 26847 . 27009) (NSPROT.GET.FONT 27011 . 27530) (NSPROT.PROMPT 27532 . 28056) (
NSPROT.CLEAR.PROMPT 28058 . 28941) (NSPROT.LIMITCHARS 28943 . 29366) (NSPROT.PAGEFULLFN 29368 . 29728)
(NSPROT.ICONFN 29730 . 30152)) (31446 32195 (ADD.NSPROTECTION 31456 . 32193)))))
STOP

BIN
lispusers/NSPROTECTION.LCOM
View File

Binary file not shown.

2
sources/LLREAD
View File

File diff suppressed because one or more lines are too long

BIN
sources/LLREAD.LCOM
View File

Binary file not shown.

375
sources/UFS
View File

@@ -1,23 +1,25 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "31-Dec-2000 12:38:40" {DSK}<project>medley3.5>sources>UFS.;2 69364
(FILECREATED "21-Apr-2021 11:36:54" {DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>UFS.;5 69271
changes to%: (VARS UFSCOMS)
changes to%: (FNS \UFSeol)
previous date%: "29-Mar-95 17:50:11" {DSK}<project>medley3.5>sources>UFS.;1)
previous date%: "20-Apr-2021 12:11:36"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>UFS.;4)
(* ; "
Copyright (c) 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 2000 by Venue & Xerox Corporation. All rights reserved.
Copyright (c) 1988-1995, 2000, 2021 by Venue & Xerox Corporation.
")
(PRETTYCOMPRINT UFSCOMS)
(RPAQQ UFSCOMS
(RPAQQ UFSCOMS
[(PROP (FILETYPE MAKEFILE-ENVIRONMENT)
UFS)
(DECLARE%: EVAL@COMPILE DONTEVAL@LOAD DONTCOPY (FILES (LOADCOMP)
DIRECTORY FILEIO))
(COMS (* ; "Create FDEV function.")
(INITVARS (\UFS.DEFAULT.EOLC NIL))
(COMS (* ; "Create FDEV function.")
(FNS \UFSCreateDevice \UFS.CREATE.DEVICE \UFSOpenDevice \UFSCloseDevice)
(INITVARS (\UFSdevice)
(\UFStopMonitor (CREATE.MONITORLOCK "UFSTopMonitor")))
@@ -25,15 +27,15 @@ Copyright (c) 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 2000 by Venue & Xe
(COMS (DECLARE%: DONTCOPY (EXPORT (RECORDS UFSGENFILESTATE)))
(INITRECORDS UFSGENFILESTATE)
(SYSRECORDS UFSGENFILESTATE))
(COMS (* ;
 "UNIX File System's FDEV methods.")
(COMS (* ;
 "UNIX File System's FDEV methods.")
(FNS \UFSOpenFile \UFS.OPENP \UFS.RECOGNIZE.FILE \UFS.DIRECTORY.NAME \UFSCloseFile
\UFSGetFileName \UFSDeleteFile \UFSRenameFile \UFSReadPages \UFSWritePages
\UFSTruncateFile \UFSDirectoryNameP \UFSEventFn \UFSGetFileInfo \UFS.CREATE.PROPS
\UFSSetFileInfo \UFSGenerateFiles \UFS.NEXTFILEFN \UFS.FILEINFOFN \UFS.VALID.PROPP
\UFS.REGISTER.GFS \UFS.UNREGISTER.GFS \UFS.ABORT.DIRECTORY \UFS.ABORT.CL-DIRECTORY
\UFS.CLEANUP.GFS.TABLE))
(COMS (* ; "File Name parsing")
(COMS (* ; "File Name parsing")
(FNS \UFSMakeUnixFormatName \UFSParseNameString \UFSParse-Directory \UFS.PARSE.BODY
\UFS.ADJUST.HOST \UFS.FULLNAME \UFS.ADD.HOST.FIELD \UFS.REMOVE.HOST.FIELD
\UFS.HANDLE.RELATIVEDIRECTORY)
@@ -54,22 +56,22 @@ Copyright (c) 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 2000 by Venue & Xe
\UFS.DEFAULT.DIRECTORY *DSK-UPPER-CASE-FILE-NAMES* \UFS.GFS.TABLE
*DSK-HOST-NAME* *UFS-HOST-NAME*))
(COMS
(* ;; "Change UNIX Curent Directory")
(* ;; "Change UNIX Curent Directory")
(FNS CHDIR)
(* ;; "To access UNIX special files by like {UNIX}/dev/ttya.")
(* ;; "To access UNIX special files by like {UNIX}/dev/ttya.")
(FNS \DEVICEFILE.EOSERROR)
(* ;; "flush/revalidate unvisible stream, like dribble files.")
(* ;; "flush/revalidate unvisible stream, like dribble files.")
(FNS \UNVISIBLE.PAGED.REVALIDATEFILELST \UNVISIBLE.FLUSH.OPEN.STREAMS)
(* ;; " Error handler")
(* ;; " Error handler")
(FNS \UFSError))
(COMS (* ; "File Type and EOL handling")
(COMS (* ; "File Type and EOL handling")
(FNS \UFSGetFileType \UFSSetFileType \UFSeol)
[DECLARE%: DONTEVAL@LOAD DOCOPY (VARS (DEFAULTFILETYPE 'BINARY)
(DEFAULTFILETYPELIST '((NIL . BINARY)
@@ -108,26 +110,28 @@ Copyright (c) 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 2000 by Venue & Xe
(VM . BINARY]
(GLOBALVARS DEFAULTFILETYPE DEFAULTFILETYPELIST))
(DECLARE%: EVAL@COMPILE DONTCOPY (COMS * UFSDECLS))
(COMS (* ; "Filetypepatch functions. ")
(COMS (* ; "Filetypepatch functions. ")
(FNS \UFSGetPrintFileType \UFSGetFileTypeConfirm \UFSPrintTypeMenu)
(* ; "for hardcopy")
(* ; "for hardcopy")
(FNS \UFStoOtherCopyMess \UFStoOtherRenameMess)
(* ; "for copyfile,renamefile")
(* ; "for copyfile,renamefile")
(INITVARS (FileTypeConfirmFlg T))
(GLOBALVARS FileTypeMenu FileTypeConfirmFlg))
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA])
(PUTPROPS UFS FILETYPE :BCOMPL)
(PUTPROPS UFS FILETYPE :BCOMPL)
(PUTPROPS UFS MAKEFILE-ENVIRONMENT (:PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10))
(PUTPROPS UFS MAKEFILE-ENVIRONMENT (:PACKAGE "INTERLISP" :READTABLE "INTERLISP" :BASE 10))
(DECLARE%: EVAL@COMPILE DONTEVAL@LOAD DONTCOPY
(FILESLOAD (LOADCOMP)
DIRECTORY FILEIO)
)
(RPAQ? \UFS.DEFAULT.EOLC NIL)
(* ; "Create FDEV function.")
@@ -154,12 +158,12 @@ Copyright (c) 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 2000 by Venue & Xe
(RPAQ? \UFSdevice )
(RPAQ? \UFStopMonitor (CREATE.MONITORLOCK "UFSTopMonitor"))
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \UFSdevice \UFStopMonitor)
)
(DECLARE%: DONTCOPY
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
(DECLARE%: DONTCOPY
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
(DATATYPE UFSGENFILESTATE (
(* ;;
@@ -171,12 +175,12 @@ Copyright (c) 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995, 2000 by Venue & Xe
(TOTALNUM FIXP)
DIRECTORY DEV (PROPP FLAG)
THISFILE
(ERRONO FIXP)
NAME
(LENGTH FIXP)
(WDATE FIXP)
(RDATE FIXP)
(PROTECTION FIXP)
(ERRONO FIXP)
NAME
(LENGTH FIXP)
(WDATE FIXP)
(RDATE FIXP)
(PROTECTION FIXP)
AUTHOR
(AULEN FIXP)
SUBGENERATORS (* ;
@@ -409,46 +413,65 @@ update the map") (SETQ PAGES (RESTOREMAP STREAM))) (DELETED (* ; "the file disap
(RPAQ? \UFSDefaultDelimiterChar '/)
(RPAQ? \UFSDefaultConnDir "./")
(RPAQ? \UFSDefaultConnDir "./")
(RPAQ? \UFSBeforeType '%.)
(RPAQ? \UFSBeforeVersion ';)
(RPAQ? \UFSDeviceDelimiter '})
(RPAQ? \DSK.DEFAULT.DIRECTORY "~>")
(RPAQ? \UFS.DEFAULT.DIRECTORY ".>")
(RPAQ? *DSK-UPPER-CASE-FILE-NAMES* NIL)
(RPAQ? \UFS.GFS.TABLE (HASHARRAY 20))
(RPAQ? *DSK-HOST-NAME* "{DSK}")
(RPAQ? *UFS-HOST-NAME* "{UNIX}")
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \UFSDeviceDelimiter \UFSBeforeVersion \UFSBeforeType \UFSDefaultConnDir
\UFSDefaultDelimiterChar \UFSDefaultDelimiter \DSK.DEFAULT.DIRECTORY \UFS.DEFAULT.DIRECTORY
*DSK-UPPER-CASE-FILE-NAMES* \UFS.GFS.TABLE *DSK-HOST-NAME* *UFS-HOST-NAME*)
(RPAQ? \UFSDeviceDelimiter '})
(RPAQ? \DSK.DEFAULT.DIRECTORY "~>")
(RPAQ? \UFS.DEFAULT.DIRECTORY ".>")
(RPAQ? *DSK-UPPER-CASE-FILE-NAMES* NIL)
(RPAQ? \UFS.GFS.TABLE (HASHARRAY 20))
(RPAQ? *DSK-HOST-NAME* "{DSK}")
(RPAQ? *UFS-HOST-NAME* "{UNIX}")
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \UFSDeviceDelimiter \UFSBeforeVersion \UFSBeforeType \UFSDefaultConnDir
\UFSDefaultDelimiterChar \UFSDefaultDelimiter \DSK.DEFAULT.DIRECTORY \UFS.DEFAULT.DIRECTORY
*DSK-UPPER-CASE-FILE-NAMES* \UFS.GFS.TABLE *DSK-HOST-NAME* *UFS-HOST-NAME*)
)
(* ;; "Change UNIX Curent Directory")
(DEFINEQ
(CHDIR
(LAMBDA (PATHNAME) (* ; "Edited 2-Apr-90 01:07 by nm") (* ;;; "(\CALL-C SUBR-UFS-DIRECTORYNAMEP ..) returns T(=1) or NIL.") (WITH.MONITOR \UFStopMonitor (LET ((PATH (\ADD.CONNECTED.DIR PATHNAME)) HOST) (if PATH then (SETQ HOST (U-CASE (FILENAMEFIELD PATH (QUOTE HOST)))) (if (OR (EQ HOST (QUOTE DSK)) (EQ HOST (QUOTE UNIX))) then (if (SETQ PATH (DIRECTORYNAME PATH)) then (if (\UFSCHDIR-C PATH) then (DIRECTORYNAME PATH) else (ERROR "NO-SUCH-DIRECTORY" PATHNAME)) else (ERROR "NO-SUCH-DIRECTORY" PATHNAME)) else (ERROR "Bad Host Name" HOST)) else (ERROR "NO-SUCH-DIRECTORY" PATHNAME)))))
)
)
(* ;; "To access UNIX special files by like {UNIX}/dev/ttya.")
)
(* ;; "Change UNIX Curent Directory")
(DEFINEQ
(CHDIR
(LAMBDA (PATHNAME) (* ; "Edited 2-Apr-90 01:07 by nm") (* ;;; "(\CALL-C SUBR-UFS-DIRECTORYNAMEP ..) returns T(=1) or NIL.") (WITH.MONITOR \UFStopMonitor (LET ((PATH (\ADD.CONNECTED.DIR PATHNAME)) HOST) (if PATH then (SETQ HOST (U-CASE (FILENAMEFIELD PATH (QUOTE HOST)))) (if (OR (EQ HOST (QUOTE DSK)) (EQ HOST (QUOTE UNIX))) then (if (SETQ PATH (DIRECTORYNAME PATH)) then (if (\UFSCHDIR-C PATH) then (DIRECTORYNAME PATH) else (ERROR "NO-SUCH-DIRECTORY" PATHNAME)) else (ERROR "NO-SUCH-DIRECTORY" PATHNAME)) else (ERROR "Bad Host Name" HOST)) else (ERROR "NO-SUCH-DIRECTORY" PATHNAME)))))
)
)
(* ;; "To access UNIX special files by like {UNIX}/dev/ttya.")
(DEFINEQ
(\DEVICEFILE.EOSERROR
(LAMBDA (STREAM) (* ; "Edited 3-Mar-89 15:06 by bvm") (SELECTQ (fetch (STREAM ACCESS) of STREAM) (OUTPUT (LISPERROR "END OF FILE" (fetch (STREAM FULLNAME) of STREAM) T)) (INPUT (PROG (BUF VMEMBUF DATASIZE) (OR (SETQ BUF (fetch (STREAM BUFFS) of STREAM)) (replace (STREAM BUFFS) of STREAM with (SETQ BUF (\GETMAPBUFFER)))) (SETQ VMEMBUF (fetch (BUFFER VMEMPAGE) of BUF)) (until (SETQ DATASIZE (\UFSReadPages-C (fetch (UFSSTREAM FILEID) of STREAM) 0 VMEMBUF)) do (BLOCK)) (if (EQ DATASIZE 0) then (LISPERROR "END OF FILE" (fetch (STREAM FULLNAME) of STREAM) T) (RETURN NIL)) (UNINTERRUPTABLY (replace (BUFFER FILEPAGE#) of BUF with 0) (replace (BUFFER BUFFERNEXT) of BUF with NIL) (replace (BUFFER SYSNEXT) of BUF with NIL) (replace (STREAM CBUFSIZE) of STREAM with DATASIZE) (replace (STREAM EOFFSET) of STREAM with DATASIZE) (replace (STREAM COFFSET) of STREAM with 0) (replace (STREAM CBUFPTR) of STREAM with VMEMBUF)) (RETURN T))) (SHOULDNT)))
)
)
(* ;; "flush/revalidate unvisible stream, like dribble files.")
(DEFINEQ
(\UNVISIBLE.PAGED.REVALIDATEFILELST
(LAMBDA (DEVICE) (* ; "Edited 3-Mar-89 15:33 by bvm") (* ;;; "This function is writen based on \PAGED.REVALIDATEFILELST") (* ;;; "Revalidate unvisible open files on DEVICE (a PMAP device)") (bind REASON PAGES for STREAM in (fetch (FDEV OPENFILELST) of DEVICE) when (NULL (fetch (STREAM USERVISIBLE) of STREAM)) do (if (SETQ REASON (\PAGED.REVALIDATEFILE STREAM)) then (SELECTQ REASON (CHANGED (* ; "it changed %
%
update the map") (SETQ PAGES (RESTOREMAP STREAM))) (DELETED (* ; "the file disappeared, so zap the stream") (SETQ PAGES (FORGETPAGES STREAM)) (MAPC (STREAMPROP STREAM (QUOTE AFTERCLOSE)) (FUNCTION (LAMBDA (FN) (APPLY* FN STREAM)))) (replace (STREAM ACCESS) of STREAM with NIL) (FDEVOP (QUOTE UNREGISTERFILE) DEVICE DEVICE STREAM)) (SHOULDNT)) (\PRINT-REVALIDATION-RESULT REASON STREAM))))
)
(\UNVISIBLE.FLUSH.OPEN.STREAMS
(LAMBDA (FDEV) (* ; "Edited 20-Dec-88 10:20 by Hayata") (* ;;; "This function is writen based on \FLUSH.OPEN.STREAMS") (* ;;; "flush unvisible open streams") (for STREAM in (fetch (FDEV OPENFILELST) of FDEV) bind STREAM when (AND (NULL (fetch (STREAM USERVISIBLE) of STREAM)) (DIRTYABLE STREAM)) do (FDEVOP (QUOTE FORCEOUTPUT) FDEV STREAM)))
@@ -456,124 +479,127 @@ update the map") (SETQ PAGES (RESTOREMAP STREAM))) (DELETED (* ; "the file disap
)
(* ;; "flush/revalidate unvisible stream, like dribble files.")
(* ;; " Error handler")
(DEFINEQ
(\UFSError
(LAMBDA (PATHNAME ERRNO DEV) (* ; "Edited 14-Dec-94 16:46 by jds") (* ;; "If DEV is supplied, we combine it with PATHNAME to get a real name.") (* ;; "Note that codes not explicitly listed here do not signal an error (!!). This may be reasonable for code zero (file not found), but others???") (PROG ((NO (IPLUS ERRNO 0))) (* ;; "errno is fixp cell, changed into a SMALLP using IPLUS, and residing in NO.") (COND (DEV (SETQ PATHNAME (\UFS.FULLNAME PATHNAME DEV)))) (SELECTQ NO (1 (ERROR "Not owner" PATHNAME)) (5 (* ; "I/O error") (CL:ERROR (QUOTE XCL:SIMPLE-DEVICE-ERROR) :MESSAGE PATHNAME)) (13 (* ; "Permission denied") (CL:ERROR (QUOTE XCL:FS-PROTECTION-VIOLATION) :PATHNAME PATHNAME)) (21 (ERROR "Is a directory" PATHNAME)) (23 (* ; "File table overflow") (CL:ERROR (QUOTE XCL:FILE-WONT-OPEN) :PATHNAME PATHNAME)) (24 (* ; "LISPERROR 15 is no longer supported (LISPERROR %"TOO MANY FILES OPEN%" |pathname|)") (ERROR "TOO MANY FILES OPEN" PATHNAME)) (27 (ERROR "File too large" PATHNAME)) (28 (* ; "No space left on device") (CL:ERROR (QUOTE XCL:FS-RESOURCES-EXCEEDED) :PATHNAME PATHNAME)) (29 (* ; "Illegal seek") (CL:ERROR (QUOTE XCL:SIMPLE-DEVICE-ERROR) :MESSAGE PATHNAME)) (30 (* ; "Read only file system") (CL:ERROR (QUOTE XCL:FS-PROTECTION-VIOLATION) :PATHNAME PATHNAME)) (60 (* ; "Connect request or NFS request failed") (ERROR "Connection timed out" PATHNAME)) (62 (* ; "Too many levels of symbolic link (usually a loop of links)") (ERROR "Too many levels of symbolic link in" PATHNAME)) (66 (ERROR "Directory not empty" PATHNAME)) (100 (ERROR "Connection timed out" PATHNAME)) NIL)))
(\UNVISIBLE.PAGED.REVALIDATEFILELST
(LAMBDA (DEVICE) (* ; "Edited 3-Mar-89 15:33 by bvm") (* ;;; "This function is writen based on \PAGED.REVALIDATEFILELST") (* ;;; "Revalidate unvisible open files on DEVICE (a PMAP device)") (bind REASON PAGES for STREAM in (fetch (FDEV OPENFILELST) of DEVICE) when (NULL (fetch (STREAM USERVISIBLE) of STREAM)) do (if (SETQ REASON (\PAGED.REVALIDATEFILE STREAM)) then (SELECTQ REASON (CHANGED (* ; "it changed %
%
update the map") (SETQ PAGES (RESTOREMAP STREAM))) (DELETED (* ; "the file disappeared, so zap the stream") (SETQ PAGES (FORGETPAGES STREAM)) (MAPC (STREAMPROP STREAM (QUOTE AFTERCLOSE)) (FUNCTION (LAMBDA (FN) (APPLY* FN STREAM)))) (replace (STREAM ACCESS) of STREAM with NIL) (FDEVOP (QUOTE UNREGISTERFILE) DEVICE DEVICE STREAM)) (SHOULDNT)) (\PRINT-REVALIDATION-RESULT REASON STREAM))))
)
(\UNVISIBLE.FLUSH.OPEN.STREAMS
(LAMBDA (FDEV) (* ; "Edited 20-Dec-88 10:20 by Hayata") (* ;;; "This function is writen based on \FLUSH.OPEN.STREAMS") (* ;;; "flush unvisible open streams") (for STREAM in (fetch (FDEV OPENFILELST) of FDEV) bind STREAM when (AND (NULL (fetch (STREAM USERVISIBLE) of STREAM)) (DIRTYABLE STREAM)) do (FDEVOP (QUOTE FORCEOUTPUT) FDEV STREAM)))
)
)
)
(* ; "File Type and EOL handling")
(DEFINEQ
(\UFSGetFileType
(LAMBDA (FILENAME) (* ; "Edited 19-May-91 11:18 by jds") (LET ((TYPE (UNPACKFILENAME.STRING FILENAME (QUOTE EXTENSION)))) (SETQ TYPE (MKATOM (U-CASE (COND ((AND (EQ (NCHARS TYPE) 0) (* ; "Handle null extension specially") (CDR (CL:ASSOC NIL DEFAULTFILETYPELIST)))) ((CDR (CL:ASSOC TYPE DEFAULTFILETYPELIST :TEST (QUOTE STRING-EQUAL)))) (T DEFAULTFILETYPE))))) (* ; "(SELECTQ TYPE ((TEXT BINARY) TYPE) (CL:ERROR %"Invalid File Type ~A for ~A%" TYPE FILENAME))") (* ;; "TYPE used to be constraied to be TEXT or BINARY, which caused some older user code to tail. AR 11373") TYPE))
(* ;; " Error handler")
(DEFINEQ
(\UFSError
)
(\UFSSetFileType
(LAMBDA (FILENAME TYPE) (* ; "Edited 6-Jun-88 13:48 by HH") (LET ((EXTENSION (MKATOM (U-CASE (LISTGET (\UFSParseNameString FILENAME) (QUOTE EXTENSION)))))) (SETQ TYPE (MKATOM (U-CASE TYPE))) (for PAIR in DEFAULTFILETYPELIST bind PAIR finally (RETURN (EQ TYPE (MKATOM (U-CASE DEFAULTFILETYPE)))) do (if (EQUAL EXTENSION (MKATOM (U-CASE (CAR PAIR)))) then (RETURN (EQ TYPE (MKATOM (U-CASE (CDR PAIR)))))))))
)
(\UFSeol
[LAMBDA (FILENAME TYPE RECOG) (* ; "Edited 21-Apr-2021 11:36 by rmk:")
(if (AND [SETQ TYPE (SELECTQ (CADR TYPE)
)
)
(* ; "File Type and EOL handling")
(TEXT 'TEXT)
(NIL NIL)
(PROGN (* ; "Anything else reduces to binary")
'BINARY]
(EQ RECOG 'NEW)
(NEQ TYPE (\UFSGetFileType FILENAME)))
then (* ;
 "Warn user that TYPE will not be properly inferred when we next read this file")
(\UFSGetFileType
(LAMBDA (FILENAME) (* ; "Edited 19-May-91 11:18 by jds") (LET ((TYPE (UNPACKFILENAME.STRING FILENAME (QUOTE EXTENSION)))) (SETQ TYPE (MKATOM (U-CASE (COND ((AND (EQ (NCHARS TYPE) 0) (* ; "Handle null extension specially") (CDR (CL:ASSOC NIL DEFAULTFILETYPELIST)))) ((CDR (CL:ASSOC TYPE DEFAULTFILETYPELIST :TEST (QUOTE STRING-EQUAL)))) (T DEFAULTFILETYPE))))) (* ; "(SELECTQ TYPE ((TEXT BINARY) TYPE) (CL:ERROR %"Invalid File Type ~A for ~A%" TYPE FILENAME))") (* ;; "TYPE used to be constraied to be TEXT or BINARY, which caused some older user code to tail. AR 11373") TYPE))
(PRINTOUT PROMPTWINDOW T "Warning: creating " TYPE " file, but name '"
(\UFS.PARSE.BODY (\UFSParseNameString FILENAME))
"' does not have a " TYPE " extension."))
(SELECTQ (OR TYPE (\UFSGetFileType FILENAME))
(\UFSSetFileType
(LAMBDA (FILENAME TYPE) (* ; "Edited 6-Jun-88 13:48 by HH") (LET ((EXTENSION (MKATOM (U-CASE (LISTGET (\UFSParseNameString FILENAME) (QUOTE EXTENSION)))))) (SETQ TYPE (MKATOM (U-CASE TYPE))) (for PAIR in DEFAULTFILETYPELIST bind PAIR finally (RETURN (EQ TYPE (MKATOM (U-CASE DEFAULTFILETYPE)))) do (if (EQUAL EXTENSION (MKATOM (U-CASE (CAR PAIR)))) then (RETURN (EQ TYPE (MKATOM (U-CASE (CDR PAIR)))))))))
)
(TEXT LF.EOLC)
(PROGN (* ;
 "BINARY or unknown. RMK: Switch default to LF")
(OR \UFS.DEFAULT.EOLC LF.EOLC])
)
(DECLARE%: DONTEVAL@LOAD DOCOPY
(LAMBDA (FILENAME TYPE RECOG) (* ; "Edited 27-Feb-89 16:21 by bvm") (if (AND (SETQ TYPE (SELECTQ (CADR TYPE) (TEXT (QUOTE TEXT)) (NIL NIL) (PROGN (* ; "Anything else reduces to binary") (QUOTE BINARY)))) (EQ RECOG (QUOTE NEW)) (NEQ TYPE (\UFSGetFileType FILENAME))) then (* ; "Warn user that TYPE will not be properly inferred when we next read this file") (PRINTOUT PROMPTWINDOW T "Warning: creating " TYPE " file, but name '" (\UFS.PARSE.BODY (\UFSParseNameString FILENAME)) "' does not have a " TYPE " extension.")) (SELECTQ (OR TYPE (\UFSGetFileType FILENAME)) (TEXT LF.EOLC) (PROGN (* ; "BINARY or unknown") CR.EOLC)))
)
(RPAQQ DEFAULTFILETYPE BINARY)
(DECLARE%: DONTEVAL@LOAD DOCOPY
(RPAQQ DEFAULTFILETYPE BINARY)
(RPAQQ DEFAULTFILETYPELIST ((NIL . BINARY)
(C . TEXT)
(H . TEXT)
(EL . TEXT)
(IM . TEXT)
(LISP . TEXT)
(LSP . TEXT)
(RPAQQ DEFAULTFILETYPELIST
((NIL . BINARY)
(C . TEXT)
(H . TEXT)
(EL . TEXT)
(LCOM . BINARY)
(DFASL . BINARY)
(DCOM . BINARY)
(SKETCH . BINARY)
(TEDIT . BINARY)
(TED . BINARY)
(DISPLAYFONT . BINARY)
(AC . BINARY)
(WD . BINARY)
(IM . TEXT)
(LISP . TEXT)
(LSP . TEXT)
(O . BINARY)
(OUT . BINARY)
(INTERPRESS . BINARY)
(PRESS . BINARY)
(PSCFONT . BINARY)
(RST . BINARY)
(BIN . BINARY)
(LCOM . BINARY)
(DFASL . BINARY)
(SYSOUT . BINARY)
(SYSOUT.Z . BINARY)
(TAR . BINARY)
(INDEX . BINARY)
(HASH . BINARY)
(DCOM . BINARY)
(SKETCH . BINARY)
(TEDIT . BINARY)
(TED . BINARY)
(DISPLAYFONT . BINARY)
(AC . BINARY)
(WD . BINARY)
(IP . BINARY)
(INTERPRESS . BINARY)
(PRESS . BINARY)
(PSCFONT . BINARY)
(RST . BINARY)
(Z . BINARY)
(BIN . BINARY)
(MAIL . BINARY)
(SYSOUT . BINARY)
(SYSOUT.Z . BINARY)
(TAR . BINARY)
(INDEX . BINARY)
(VM . BINARY)))
)
(HASH . BINARY)
(NOTEFILE . BINARY)
(Z . BINARY)
(VIRTUALMEM . BINARY)
(VM . BINARY)))
)
(GLOBALVARS DEFAULTFILETYPE DEFAULTFILETYPELIST)
)
(DECLARE%: EVAL@COMPILE DONTCOPY
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(RPAQQ UFSDECLS ((MACROS \UFS.FULLNAME.M \UFSGetMonitor \UFS.DEFAULT.DIR \UFS.FILE.RECOGNIZER
\UFS.DIRECTORY.RECOGNIZER DSKP)
(RECORDS UFSSTREAM NAME&ALLPROPS)
(* ;; "File attribute code. For interface between Cfunc and LISPfunc.")
(GLOBALVARS DEFAULTFILETYPE DEFAULTFILETYPELIST)
)
(DECLARE%: EVAL@COMPILE DONTCOPY
(CONSTANTS (ATTR-LENGTH 1)
(ATTR-WDATE 2)
(ATTR-RDATE 3)
(RPAQQ UFSDECLS
((MACROS \UFS.FULLNAME.M \UFSGetMonitor \UFS.DEFAULT.DIR \UFS.FILE.RECOGNIZER
\UFS.DIRECTORY.RECOGNIZER DSKP)
(RECORDS UFSSTREAM NAME&ALLPROPS)
(* ;; "File attribute code. For interface between Cfunc and LISPfunc.")
(CONSTANTS (ATTR-LENGTH 1)
(ATTR-WDATE 2)
(ATTR-RDATE 3)
(ATTR-CDATE 4)
(ATTR-AUTHOR 5)
(ATTR-PROTECTION 6)
(ATTR-EOL 7)
(ATTR-ALL 8))
(* ;; "File RECOG code. For interface between Cfunc and LISPfunc.")
(ATTR-ALL 8))
(CONSTANTS (RECOG-OLD 0)
(RECOG-OLDEST 1)
(RECOG-NEW 2)
(RECOG-NEW-OLD 3)
(RECOG-OTHER 4)
(RECOG-OLDEST 1)
(RECOG-NON 5))
(* ;; "File ACCESS code. For interface between Cfunc and LISPfunc.")
(RECOG-OTHER 4)
(CONSTANTS (ACCESS-INPUT 0)
(ACCESS-OUTPUT 1)
(* ;; "File ACCESS code. For interface between Cfunc and LISPfunc.")
(ACCESS-BOTH 2)
(ACCESS-APPEND 3)
(ACCESS-OTHER 4))
(* ;; "\UFSGetFileInfo allocate this size buffer to keep the user name.")
@@ -747,25 +773,26 @@ update the map") (SETQ PAGES (RESTOREMAP STREAM))) (DELETED (* ; "the file disap
(CONSTANTS (ACCESS-INPUT 0)
(ACCESS-OUTPUT 1)
(ACCESS-BOTH 2)
(ACCESS-APPEND 3)
(ACCESS-OUTPUT 1)
(ACCESS-BOTH 2)
(ACCESS-APPEND 3)
(ACCESS-OTHER 4))
)
(* ;; "\UFSGetFileInfo allocate this size buffer to keep the user name.")
(DECLARE%: EVAL@COMPILE
(RPAQQ MAX-UNAME-LEN 512)
(CONSTANTS (MAX-UNAME-LEN 512))
)
(ACCESS-OTHER 4))
)
(* ;; "\UFSGetFileInfo allocate this size buffer to keep the user name.")
(DECLARE%: EVAL@COMPILE
(RPAQQ MAX-UNAME-LEN 512)
(CONSTANTS (MAX-UNAME-LEN 512))
)
(* ;; "\UFSGetFileName allocate this size buffer to keep the path name.")
(DECLARE%: EVAL@COMPILE

BIN
sources/UFS.LCOM
View File

Binary file not shown.