(FILECREATED "23-Jun-86 16:21:04" {ERIS}<LISPCORE>SOURCES>MOD44IO.;39 118583
changes to: (FNS \M44DeleteFile)
previous date: "17-Jun-86 17:22:16" {ERIS}<LISPCORE>SOURCES>MOD44IO.;38)
(* Copyright (c) 1981, 1982, 1983, 1984, 1985, 1986 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT MOD44IOCOMS)
(RPAQQ MOD44IOCOMS
((* Device dependent code for the Model44 disk)
(FNS \M44AddDiskPages \M44CloseFile \M44CompleteFH \M44CREATEFILE \M44DeleteFile \M44EVENTFN
\M44ExtendFilePageMap \M44FillInMap \M44GetFileHandle \M44GetFileInfo \M44GETDATEPROP
\M44GetFileName \M44GetPageLoc \M44KillFilePageMap \M44MAKEDIRENTRY \M44OpenFile
\M44OPENFILEFROMFP \M44ReadDiskPage \M44ReadLeaderPage \M44ReadPages \M44SetAccessTimes
\M44SetEndOfFile \M44SetFileInfo \M44SETFILETYPE \M44TruncateFile \M44WriteDiskPage
\M44WriteLeaderPage \M44WritePages \M44WritePages1)
(FNS \ADDDISKPAGES \M44DELETEPAGES \ASSIGNDISKPAGE \COUNTDISKFREEPAGES \M44MARKPAGEFREE
\M44FLUSHDISKDESCRIPTOR \MAKELEADERDAS DISKFREEPAGES \M44FREEPAGECOUNT VMEMSIZE)
(INITVARS (\M44MULTFLG T))
(DECLARE: DONTCOPY (MACROS UCASECHAR UPDATEVALIDATION)
(RECORDS M44DEVICE)
(GLOBALVARS \OPENFILES \M44MULTFLG \DISKNAMECASEARRAY)
(MACROS .LISP.TO.BFS. .BFS.TO.LISP. .DISKCASEARRAY.)
(CONSTANTS (PageMapIncrement 64))
(COMS (* File properties)
(RECORDS M44FILEPROP)
(CONSTANTS * FPROPTYPES)
(CONSTANTS * FPTYPES)))
(GLOBALRESOURCES \M44PAGEBUFFER)
(COMS (* Directory enumeration)
(FNS \M44GENERATEFILES \M44SORTFILES \M44GENERATENEXT \M44NEXTFILEFN
\M44SORTEDNEXTFILEFN \M44FILEINFOFN))
(COMS (* Directory lookup routines)
(FNS \M44PARSEFILENAME \FINDDIRHOLE \M44PACKFILENAME \M44LOOKUPVERSIONS \M44READVERSION
\OPENDISKDESCRIPTOR \READDIRFPTR \M44SEARCHDIR \M44UNPACKFILENAME)
(FNS)
(VARS \FILENAMECHARSLST)
(GLOBALVARS \FILENAMECHARSLST)
(DECLARE: DONTCOPY (RECORDS UNAME FILESPEC M44GENFILESTATE M44DIRSEARCHSTATE)
(MACROS BETWEEN)))
(COMS (FNS \CREATE.FID.FOR.DD \OPENDISK \OPENDISKDEVICE \OPENDIR \M44CHECKPASSWORD
\M44HOSTNAMEP)
(DECLARE: DONTCOPY (CONSTANTS \OFFSET.BCPLUSERNAME \OFFSET.BCPLPASSWORD
\NWORDS.BCPLPASSWORD)))
(COMS (* SYSOUT etc)
(FNS \COPYSYS \COPYSYS1))
(COMS (* Stats code. On MOD44IO because it writes on the disk and uses records not exported
from MOD44IO)
(FNS GATHERSTATS)
(VARS (\STATSON NIL)))
(DECLARE: EVAL@COMPILE DONTCOPY (LOCALVARS . T)
(FILES (LOADCOMP)
LLBFS))))
(* Device dependent code for the Model44 disk)
(DEFINEQ
(\M44AddDiskPages
[LAMBDA (STREAM NEWLASTPAGE NEWLASTBYTE) (* bvm: "29-DEC-82 17:49")
(* Add pages to an existing Model44 file. NEWLASTPAGE is the page number of the last page in the extended file.
Return the disk address of the new last page.)
(\M44FillInMap STREAM (fetch LastPage of STREAM)) (* Fill in map to end of file.
Code below assumes at least one valid map entry)
(\ADDDISKPAGES STREAM (ADD1 (fetch LASTMAPPEDPAGE of STREAM))
(IDIFFERENCE NEWLASTPAGE (fetch LASTMAPPEDPAGE of STREAM))
(fetch (ARRAYP BASE) of (\M44ExtendFilePageMap STREAM NEWLASTPAGE))
NEWLASTBYTE)
(replace LASTMAPPEDPAGE of STREAM with NEWLASTPAGE)
(replace LastPage of STREAM with NEWLASTPAGE)
(replace LastOffset of STREAM with NEWLASTBYTE) (* record new eof in filehandle only)
NEWLASTPAGE])
(\M44CloseFile
[LAMBDA (STREAM) (* hdj "10-Jun-86 15:02")
(\CLEARMAP STREAM)
[COND
((NEQ (fetch ACCESS of STREAM)
(QUOTE INPUT)) (* Update EOF in leader page)
(\M44TruncateFile STREAM (fetch EPAGE of STREAM)
(fetch EOFFSET of STREAM)
T)
(\M44FLUSHDISKDESCRIPTOR (fetch DEVICE of STREAM]
(\DELETE-OPEN-STREAM STREAM (fetch (STREAM DEVICE) of STREAM))
STREAM])
(\M44CompleteFH
[LAMBDA (STREAM) (* bvm: "18-May-84 14:09")
(* Completes the fields of a file handle that describes an existing file by reading in its leader page which it
leaves for its caller)
(PROG ((NUMCHARS (CONS))
(LEADERPAGE (\M44ReadLeaderPage STREAM))
(DSK (fetch DSKOBJ of (fetch DEVICE of STREAM)))
LASTPAGE# NBYTES)
(* Get the page number and the number of bytes on the last page of the file specified by fHandle.
If the last page number hint is wrong in the leader page, then find the real last page and change the hint.)
(COND
((AND (NEQ (SETQ LASTPAGE# (.BFS.TO.LISP. (fetch LastPageNumber of LEADERPAGE)))
-1)
(EQ [PROG ((DAs (ARRAY 3 (QUOTE WORD)
\FILLINDA 0))
(BFSPG# (.LISP.TO.BFS. LASTPAGE#)))
(SETA DAs 1 (fetch LastPageAddress of LEADERPAGE))
(SETA DAs 2 \EOFDA)
(RETURN (AND (EQ (\ACTONDISKPAGES DSK NIL (fetch (ARRAYP BASE)
of DAs)
LASTPAGE# STREAM BFSPG# BFSPG#
\DC.READD NUMCHARS NIL T)
BFSPG#)
(SETQ NBYTES (CAR NUMCHARS]
(fetch LastPageByteCount of LEADERPAGE)))
(replace LastPage of STREAM with LASTPAGE#) (* Update STREAM eof)
(replace LastOffset of STREAM with NBYTES))
(T (* Hint was wrong so scan the file for last page)
(for PN from PageMapIncrement by PageMapIncrement
do (SETQ LASTPAGE# (\M44FillInMap STREAM PN))
(* Wait until attempt to find page fails)
repeatwhile (EQ PN LASTPAGE#))
(SETQ NBYTES (\ACTONDISKPAGES DSK NIL (fetch (ARRAYP BASE)
of (fetch FILEPAGEMAP of STREAM))
-1 STREAM (.LISP.TO.BFS. LASTPAGE#)
(.LISP.TO.BFS. LASTPAGE#)
\DC.READD NUMCHARS))
(* Read last page to find out how many bytes are on it)
(\M44SetEndOfFile STREAM LASTPAGE# (CAR NUMCHARS)
T)))
(UPDATEVALIDATION STREAM LEADERPAGE) (* Validation is low order bits of creation and write
dates)
[COND
((EQ (fetch LastOffset of STREAM)
BYTESPERPAGE) (* Shouldn't happen, because alto files should never
have a full last page. However, cope if it happens...)
(replace EPAGE of STREAM with (ADD1 (fetch LastPage of STREAM)))
(replace EOFFSET of STREAM with 0))
(T (replace EPAGE of STREAM with (fetch LastPage of STREAM))
(replace EOFFSET of STREAM with (fetch LastOffset of STREAM]
(RETURN STREAM])
(\M44CREATEFILE
[LAMBDA (FDEV UNAME LENGTH CRDATE TYPE DIRECTORYP) (* bvm: " 3-Apr-85 14:59")
(* Create a file on the Model44 disk.)
(PROG ((DSK (fetch DSKOBJ of FDEV))
(PNAME (\M44PACKFILENAME UNAME))
(LEADERPAGE (create \M44LeaderPage))
(NC 0)
STREAM FP MAP FPBASE DAT)
(OR PNAME (RETURN)) (* Cant create as name wasnt complete)
(SETQ STREAM (create M44STREAM))
(replace FULLFILENAME of STREAM with PNAME)
(replace DEVICE of STREAM with FDEV)
(replace FID of STREAM with (SETQ FP (create FID)))
(replace FILEPAGEMAP of STREAM with (SETQ MAP (ARRAY (COND
((FIXP LENGTH)
(IPLUS 4 (FOLDHI LENGTH
BYTESPERPAGE)))
(T PageMapIncrement))
(QUOTE WORD)
\FILLINDA 0)))
(replace LASTMAPPEDPAGE of STREAM with 0)
(replace MULTIBUFFERHINT of STREAM with \M44MULTFLG)
(replace LEADERPAGE of STREAM with LEADERPAGE)
(SETQ FPBASE (fetch (ARRAYP BASE) of FP))
(replace FPSERIAL# of FPBASE with (add (fetch (DSKOBJ DISKLASTSERIAL#) of DSK)
1))
(COND
(DIRECTORYP (add (fetch FPSERIALHI of FPBASE)
\FP.DIRECTORYP)))
(replace FPVERSION of FPBASE with 1)
(SETA MAP 0 \EOFDA)
(SETA MAP 3 \EOFDA) (* We are about to create pages 0 and 1, everything
else is nonexistent)
(* Done by the NCREATE -- (\ZEROPAGE
(fetch (POINTER PAGE#) of LEADERPAGE)))
(\BLT (LOCF (fetch TimeWrite of LEADERPAGE))
(SETQ DAT (\DAYTIME0 (create FIXP)))
WORDSPERCELL) (* Set creation and write dates)
(\BLT (LOCF (fetch TimeCreate of LEADERPAGE))
(OR CRDATE DAT)
WORDSPERCELL)
(replace PropertyPtr of LEADERPAGE with \INITPROPPTR)
(* See \M44MAKEDIRENTRY for the name logic.)
(for C in (fetch ORIGCHARS of UNAME) bind (NAMEBASE ←(LOCF (fetch NameCharCount
of LEADERPAGE)))
do (\PUTBASEBYTE NAMEBASE (add NC 1)
C)
finally [COND
((OR (CDR (fetch VERSION of UNAME))
(NEQ (CAR (fetch VERSION of UNAME))
(CHARCODE 1)))
(\PUTBASEBYTE NAMEBASE (add NC 1)
(CHARCODE !))
(for C in (fetch VERSION of UNAME) do (\PUTBASEBYTE NAMEBASE
(add NC 1)
C]
(\PUTBASEBYTE NAMEBASE (add NC 1)
(CHARCODE %.)) (* Last character of all alto names is dot)
(replace NameCharCount of LEADERPAGE with NC))
(\M44SETFILETYPE STREAM TYPE)
(\WRITEDISKPAGES DSK (LIST LEADERPAGE NIL)
(fetch (ARRAYP BASE) of MAP)
-1 STREAM 0 1 NIL NIL 0 0) (* The end of file will be zero and the validation not
set as befits a new file.)
(replace FPLEADERVDA of FPBASE with (\WORDELT MAP 1))
(* Now that the file is safely created, make entry in
directory)
(replace DIRINFO of STREAM with (\M44MAKEDIRENTRY (fetch FID of STREAM)
UNAME NC FDEV))
(RETURN STREAM])
(\M44DeleteFile
[LAMBDA (FILENAME DEV) (* hdj "23-Jun-86 15:01")
(* Delete a Model44 file.)
(PROG ((STREAM (\M44GetFileHandle FILENAME (QUOTE OLDEST)
DEV T)))
(COND
((OR (NOT STREAM)
(FDEVOP (QUOTE OPENP)
DEV FILENAME NIL DEV)) (* Can't delete an open file)
(RETURN)))
(\M44DELETEPAGES STREAM -1)
(PROG ((DIROFD (fetch (M44DEVICE SYSDIROFD) of DEV)))
(* Delete directory entry)
(\SETFILEPTR DIROFD (fetch DIRINFO of STREAM))
(\BOUT DIROFD (LOGAND 3 (\PEEKBIN DIROFD)))
(FLUSHMAP DIROFD))
(\M44KillFilePageMap STREAM)
(replace FID of STREAM with NIL)
(RETURN (fetch FULLFILENAME of STREAM])
(\M44EVENTFN
[LAMBDA (FDEV EVENT) (* hdj " 5-Jun-86 22:42")
(DECLARE (GLOBALVARS \DEVICENAMETODEVICE \MACHINETYPE))
(SELECTQ EVENT
((AFTERLOGOUT AFTERSYSOUT AFTERMAKESYS AFTERSAVEVM)
(* * reinitialize DSK device and revalidate its open streams)
[PROG ((DSKOBJ (fetch (M44DEVICE DSKOBJ) of FDEV))
DD)
(COND
((SETQ DD (fetch DISKDESCRIPTOROFD of DSKOBJ))
(* Flush out of date disk descriptor)
(FORGETPAGES DD)
(replace DDVALID of DSKOBJ with NIL)
(replace DISKDESCRIPTOROFD of DSKOBJ with NIL)))
(FORGETPAGES (fetch SYSDIROFD of DSKOBJ))
(COND
[(AND (NEQ \MACHINETYPE \DANDELION)
(PROG [(PARTZEROP (EQ (fetch (M44DEVICE DSKPARTITION) of FDEV)
0))
(CURPARTP (EQ (fetch (FDEV DEVICENAME) of FDEV)
(PACK* (QUOTE DSK)
(DISKPARTITION]
(COND
(PARTZEROP (* This is interlock with
\M44EXTENDVMEMFILE which doesn't want
to mess up the DiskDescriptor)
(SETQ \M44.READY T)))
(RETURN (COND
((OR (AND PARTZEROP CURPARTP)
(\DEVICE-OPEN-STREAMS FDEV))
(COND
((EQ PARTZEROP CURPARTP)
(* No partition change to worry about,
just reopen dir)
(\OPENDIR FDEV))
(PARTZEROP (* This was the default partition, no
longer is, so reopen it as if from
scratch. Also, remove the mapping of
DSK to this device)
(\REMOVEDEVICE.NAMES FDEV (QUOTE DSK))
(\OPENDISK (SUBATOM (fetch (FDEV DEVICENAME)
of FDEV)
4)
FDEV))
(T (* This was a non-default partition,
now the default. Reopen it with
\MAINDISK as its DSKOBJ)
(\OPENDISKDEVICE NIL NIL FDEV]
(T (* Device no longer exists if machine
is now Dandelion; and if there were no
open files, no need to try reopening
the dir)
(replace SYSDIROFD of DSKOBJ with NIL)
(* Have to explicitly clear these
fields, because when we drop the
DSKOBJ on the floor, GC does not know
about its POINTER fields)
(replace REOPENFILE of FDEV with (FUNCTION NILL))
(* In case there are files open over
sysout as we come back on Dandelion)
(\REMOVEDEVICE FDEV]
(\PAGED.REVALIDATEFILELST FDEV))
(BEFORELOGOUT (\FLUSH.OPEN.STREAMS FDEV)
(\M44FLUSHDISKDESCRIPTOR FDEV))
NIL])
(\M44ExtendFilePageMap
[LAMBDA (STREAM TOPAGE#) (* bvm: "18-May-84 16:25")
(* If the file's page map is not big enough to map the given page, then create a new one that is big enough and
copy the old OLDMAP information into the new map. If the file has no map, then create one big enough to map the
given page. Return the new map. -
Map entry 0 corresponds to bfs page -1, entry 1 corresponds to the leader page, and entry 2 corresponds to Lisp
page 0)
(PROG ((OLDMAP (fetch FILEPAGEMAP of STREAM))
OLDSIZE NEWMAP)
(RETURN (COND
([AND OLDMAP (ILESSP (IPLUS TOPAGE# 3)
(SETQ OLDSIZE (fetch (ARRAYP LENGTH) of OLDMAP]
OLDMAP)
(T (SETQ NEWMAP (ARRAY (CEIL (IPLUS TOPAGE# 4)
PageMapIncrement)
(QUOTE SMALLPOSP)
\FILLINDA 0))
[COND
(OLDMAP (* Copy old map into new)
(\BLT (fetch (ARRAYP BASE) of NEWMAP)
(fetch (ARRAYP BASE) of OLDMAP)
OLDSIZE))
(T (* Initialize with leader page hint)
(SETA NEWMAP 0 \EOFDA)
(SETA NEWMAP 1 (fetch FPLEADERVDA of (fetch (ARRAYP BASE)
of (fetch FID of STREAM]
(replace FILEPAGEMAP of STREAM with NEWMAP)
NEWMAP])
(\M44FillInMap
[LAMBDA (STREAM UPTOPAGE) (* bvm: "18-May-84 15:15")
(* * Assures that the disk address map for STREAM is filled in up thru page# UPTOPAGE. Reads file as needed)
(PROG ((MAP (\M44ExtendFilePageMap STREAM UPTOPAGE))
(DSK (fetch DSKOBJ of (fetch DEVICE of STREAM)))
(LASTKNOWNPAGE (fetch LASTMAPPEDPAGE of STREAM))
NPAGES LASTPAGEREAD LASTATTEMPTED DAs DA) (* Extend MAP)
(SETQ DAs (fetch (ARRAYP BASE) of MAP))
[while (ILESSP LASTKNOWNPAGE UPTOPAGE)
do (COND
[(NEQ (SETQ DA (\GETBASE DAs (IPLUS LASTKNOWNPAGE 1 2)))
\FILLINDA) (* There already is an entry for the next page, so no
need to read it)
(COND
((EQ DA \EOFDA)
(RETURN))
(T (add LASTKNOWNPAGE 1]
(T [SETQ NPAGES (IMIN \MAXDISKDAs (ADD1 (IDIFFERENCE UPTOPAGE LASTKNOWNPAGE]
(* We know where LASTKNOWNPAGE lives, so read it to find out where the next page after that is.
Can do this for many pages at once to make it reasonable)
(SETQ LASTPAGEREAD (\ACTONDISKPAGES DSK NIL DAs -1 STREAM (.LISP.TO.BFS.
LASTKNOWNPAGE)
[SETQ LASTATTEMPTED
(.LISP.TO.BFS. (SUB1 (IPLUS LASTKNOWNPAGE
NPAGES]
\DC.READD))
(SETQ LASTKNOWNPAGE (.BFS.TO.LISP. LASTPAGEREAD))
(COND
((ILESSP LASTPAGEREAD LASTATTEMPTED)
(* Hit end of file)
(RETURN]
(replace LASTMAPPEDPAGE of STREAM with LASTKNOWNPAGE)
(RETURN LASTKNOWNPAGE])
(\M44GetFileHandle
[LAMBDA (NAME RECOG FDEV FAST CREATEFLG) (* bvm: " 3-Apr-85 14:58")
(* Creates a STREAM for dsk file NAME. If file does not exist, but CREATEFLG is true, returns the UNAME of the file
so that it may be created. If FAST is true, does not fill in any fields of STREAM that would require reading the
file, e.g., the length and full map)
(PROG ((DIROFD (fetch (M44DEVICE SYSDIROFD) of FDEV))
FS STREAM)
(RETURN (COND
((NULL DIROFD) (* Non-existent device)
NIL)
((EQ (fetch FSDIRPTR of (SETQ FS (\M44PARSEFILENAME NAME RECOG FDEV CREATEFLG)))
(QUOTE DIRECTORY)) (* directory name was given.)
NIL)
((fetch FSDIRPTR of FS)
(SETQ STREAM (create M44STREAM))
(replace FULLFILENAME of STREAM with (fetch PNAME of FS))
(replace DEVICE of STREAM with FDEV)
(replace FID of STREAM with (\READDIRFPTR DIROFD (fetch FSDIRPTR of FS)))
(replace DIRINFO of STREAM with (fetch FSDIRPTR of FS))
(replace MULTIBUFFERHINT of STREAM with \M44MULTFLG)
(OR FAST (\M44CompleteFH STREAM))
STREAM)
((NULL (fetch UNAME of FS))
(LISPERROR "BAD FILE NAME" NAME))
(CREATEFLG (fetch UNAME of FS])
(\M44GetFileInfo
[LAMBDA (STREAM ATTRIBUTE DEV) (* bvm: "15-Jan-85 17:06")
(* Get the value of the ATTRIBUTE for a model44 file.
If STREAM is a filename, then the file is not open.)
(COND
((OR (type? STREAM STREAM)
(SETQ STREAM (\M44GetFileHandle STREAM (QUOTE OLD)
DEV T)))
(SELECTQ ATTRIBUTE
[(LENGTH SIZE)
(COND
((NULL (fetch VALIDATION of STREAM)) (* Need to read leader page etc to get length)
(\M44CompleteFH STREAM)))
(SELECTQ ATTRIBUTE
(LENGTH (create BYTEPTR
PAGE ←(fetch EPAGE of STREAM)
OFFSET ←(fetch EOFFSET of STREAM)))
(IPLUS (fetch EPAGE of STREAM)
(FOLDHI (fetch EOFFSET of STREAM)
BYTESPERPAGE]
[TYPE (PROG ((BUF (\M44ReadLeaderPage STREAM)))
(RETURN (COND
((IGREATERP (fetch PropertyLength of BUF)
0)
(SETQ BUF (\ADDBASE BUF (fetch PropertyBegin of BUF)))
(do (SELECTC (fetch FPROPTYPE of BUF)
(0 (* End of properties)
(RETURN))
[\FPROP.TYPE (RETURN
(SELECTC (fetch FPROPWORD0
of BUF)
(\FPTYPE.TEXT
(QUOTE TEXT))
(\FPTYPE.BINARY
(QUOTE BINARY))
(\FPTYPE.UNKNOWN NIL)
(\TYPE.FROM.FILETYPE
(fetch FPROPWORD0
of BUF]
NIL)
(SETQ BUF (\ADDBASE BUF (fetch FPROPLENGTH of BUF]
(CREATIONDATE (\M44GETDATEPROP STREAM (INDEXF (fetch TimeCreate of T))
T))
(WRITEDATE (\M44GETDATEPROP STREAM (INDEXF (fetch TimeWrite of T))
T))
(READDATE (\M44GETDATEPROP STREAM (INDEXF (fetch TimeRead of T))
T))
[ICREATIONDATE (\M44GETDATEPROP STREAM (INDEXF (fetch TimeCreate of T]
[IWRITEDATE (\M44GETDATEPROP STREAM (INDEXF (fetch TimeWrite of T]
[IREADDATE (\M44GETDATEPROP STREAM (INDEXF (fetch TimeRead of T]
NIL])
(\M44GETDATEPROP
[LAMBDA (STREAM OFFSET STRINGIFY) (* bvm: "27-May-84 22:57")
(* Returns the create/write/read date of STREAM that lives at OFFSET in its leader page, as a string if STRINGIFY
is true, else as a Lisp date fixp)
(PROG ((DATEBASE (\ADDBASE (\M44ReadLeaderPage STREAM)
OFFSET))
DAT)
(SETQ DAT (\MAKENUMBER (\GETBASE DATEBASE 0)
(\GETBASE DATEBASE 1)))
(RETURN (COND
((NEQ DAT 0)
(SETQ DAT (ALTO.TO.LISP.DATE DAT))
(COND
(STRINGIFY (GDATE DAT))
(T DAT])
(\M44GetFileName
[LAMBDA (NAME RECOG FDEV) (* bvm: " 3-Apr-85 14:19")
(fetch PNAME of (\M44PARSEFILENAME NAME RECOG FDEV])
(\M44GetPageLoc
[LAMBDA (STREAM PAGENO CREATE?) (* bvm: "29-DEC-82 17:50")
(* Look in the file's page map to find the disk address of the page. If the map does not include the page, then
extend it appropriately. If page does not exit, create it if CREATE? is true, else return \EOFDA)
(COND
((ILEQ PAGENO (fetch LastPage of STREAM))
(COND
((IGREATERP PAGENO (fetch LASTMAPPEDPAGE of STREAM))
(\M44FillInMap STREAM PAGENO)))
(\WORDELT (fetch FILEPAGEMAP of STREAM)
(IPLUS PAGENO 2)))
(CREATE? (\M44AddDiskPages STREAM PAGENO 0)
(\M44GetPageLoc STREAM PAGENO))
(T \EOFDA])
(\M44KillFilePageMap
[LAMBDA (fHandle) (* bas: " 7-JAN-80 19:43")
(* Remove the file's page map.)
(replace FILEPAGEMAP of fHandle with NIL)
(replace LASTMAPPEDPAGE of fHandle with -1])
(\M44MAKEDIRENTRY
[LAMBDA (FID UNAME NC FDEV) (* bvm: " 3-Apr-85 14:59")
(* Makes a directory entry for a new file)
(PROG ((DIROFD (fetch (M44DEVICE SYSDIROFD) of FDEV))
(VERSION (fetch VERSION of UNAME))
POS)
(SETQ POS (\FINDDIRHOLE (LRSH (IPLUS NC 14)
1)
DIROFD))
(\BOUTS DIROFD (fetch FIDBLOCK of FID)
0
(UNFOLD 5 BYTESPERWORD))
(\BOUT DIROFD NC)
(* Now write out the alto-style name "name[.ext]!ver." with ver omitted if 1; This is basically the same logic as is
used to write the name in the leader page in \M44CREATEFILE. We can't share cause here we do bouts, cause we might
run over a page; there we must do PUTBASEBYTE's cause we can't set the fileptr to the leader page.)
(for C in (fetch ORIGCHARS of UNAME) do (\BOUT DIROFD C))
[COND
((OR (CDR VERSION)
(NEQ (CHARCODE 1)
(CAR VERSION)))
(\BOUT DIROFD (CHARCODE !))
(for C in VERSION do (\BOUT DIROFD C]
(\BOUT DIROFD (CHARCODE %.))
(COND
((EVENP NC BYTESPERWORD)
(\BOUT DIROFD 0)))
(\SETFILEPTR DIROFD POS)
(\BOUT DIROFD (LOGOR 4 (\PEEKBIN DIROFD))) (* When everything is ready, finally change the type
from hole to file.)
(FORCEOUTPUT DIROFD)
(RETURN POS])
(\M44OpenFile
[LAMBDA (NAME ACCESS RECOG PARAMETERS FDEV OLDSTREAM) (* hdj "17-Jun-86 17:16")
(*
"Open a Model44 file. Gets the physical end of file and sets up stream")
(PROG (PAGESTIMATE STREAM CRDATE TYPE DON'T.CHANGE.DATE X)
(*
"if file is open in a conflicting way, barf")
(if (\FILE-CONFLICT (\RECOGNIZE-HACK NAME RECOG FDEV)
ACCESS FDEV)
then (RETURN NIL))
[COND
((NEQ ACCESS (QUOTE INPUT)) (*
"Interesting parameters when creating a file")
(for X in PARAMETERS do (SELECTQ (CAR (LISTP X))
(LENGTH (SETQ PAGESTIMATE (IPLUS 2 (FOLDHI (CADR X)
BYTESPERPAGE))))
(CREATIONDATE (SETQ CRDATE (IDATE (CADR X))))
(ICREATIONDATE (SETQ CRDATE (CADR X)))
(TYPE (SETQ TYPE (CADR X)))
(DON'T.CHANGE.DATE
(SETQ DON'T.CHANGE.DATE T))
NIL]
(COND
[(type? STREAM NAME)
(COND
((OR (fetch (M44DEVICE DSKPASSWORDOK) of (fetch DEVICE of NAME))
(EQ (fetch W0 of (fetch FID of NAME))
32768)) (*
"Make sure password is ok if trying to reopen anything but a directory")
(\M44CompleteFH (SETQ STREAM NAME)))
(T (RETURN]
([NULL (SETQ STREAM (\M44GetFileHandle NAME RECOG FDEV NIL (NEQ ACCESS (QUOTE INPUT]
(*
"File not found. Return NIL to let generic open generate a FILE NOT FOUND error")
(RETURN NIL)))
[COND
([AND PAGESTIMATE (IGREATERP PAGESTIMATE (IPLUS (fetch (M44DEVICE DISKFREEPAGES)
of FDEV)
(COND
((type? STREAM STREAM)
(fetch LastPage of STREAM))
(T
(* "New file")
0]
(RETURN (LISPERROR "FILE SYSTEM RESOURCES EXCEEDED" (COND
((type? STREAM STREAM)
(fetch FULLFILENAME
of STREAM))
(T NAME]
[COND
(CRDATE (* "Convert to alto format")
(COND
([NOT (type? FIXP (SETQ CRDATE (LISP.TO.ALTO.DATE CRDATE]
(* "sigh, wanted a number box")
(\PUTBASEFIXP (SETQ X (create FIXP))
0 CRDATE)
(SETQ CRDATE X]
[COND
((NOT (type? STREAM STREAM))
(SETQ STREAM (\M44CREATEFILE FDEV STREAM PAGESTIMATE CRDATE TYPE)))
((NOT OLDSTREAM) (* "Old file, not from REOPENFILE")
[COND
((EQ ACCESS (QUOTE OUTPUT)) (* "File is EMPTY even if it is old")
(replace EPAGE of STREAM with (replace EOFFSET of STREAM with 0]
(*
"Leader page is read in during STREAM initialization")
(COND
((NOT DON'T.CHANGE.DATE)
(\M44SetAccessTimes STREAM ACCESS CRDATE) (* "Resets validation")
(\M44WriteLeaderPage STREAM) (*
"We write out accumulated changes to leader page")
]
(COND
(CRDATE (replace NONDEFAULTDATEFLG of STREAM with T)))
(RETURN STREAM])
(\M44OPENFILEFROMFP
[LAMBDA (DEV NAME ACCESS FID DIRINFO) (* hdj " 5-Jun-86 22:34")
(* Opens a disk file given its FP)
(LET ((STREAM (create M44STREAM)))
(replace FULLFILENAME of STREAM with (SETQ NAME (PACK* (QUOTE {)
(fetch (FDEV DEVICENAME) of DEV)
(QUOTE })
NAME)))
(replace DEVICE of STREAM with DEV)
(replace FID of STREAM with FID)
(replace DIRINFO of STREAM with DIRINFO)
(replace MULTIBUFFERHINT of STREAM with \M44MULTFLG)
(LET ((RESULT (\OPENFILE STREAM ACCESS)))
(\DELETE-OPEN-STREAM RESULT DEV)
RESULT])
(\M44ReadDiskPage
[LAMBDA (STREAM PAGENO BUF) (* bvm: "13-Feb-85 19:34")
(* The functions for reading a disk page called by \M44ReadPages. Returns the number of bytes read.
If PAGEADDR is 0, then assume 0 bytes read. Fill the BUF with zeros beyond the last byte read.)
(COND
((AND (IGEQ PAGENO (fetch EPAGE of STREAM))
(OR (NOT (IEQP PAGENO (fetch EPAGE of STREAM)))
(EQ (fetch EOFFSET of STREAM)
0))) (* Asking for page after eof.
PMAP system really ought to catch this itself)
(\CLEARWORDS BUF WORDSPERPAGE)
0)
(T (PROG ((PAGEADDR (\M44GetPageLoc STREAM PAGENO))
(BFSPG# (ADD1 PAGENO)))
(RETURN (COND
((EQ PAGEADDR \EOFDA) (* no bytes read, fill with zeroes.)
(\CLEARWORDS BUF WORDSPERPAGE)
0)
((EQ PAGEADDR \FILLINDA)
(SHOULDNT))
((EQ (\ACTONDISKPAGES (fetch DSKOBJ of (fetch DEVICE of STREAM))
BUF
(fetch (ARRAYP BASE) of (fetch FILEPAGEMAP
of STREAM))
-1 STREAM BFSPG# BFSPG# \DC.READD)
BFSPG#)
BYTESPERPAGE)
(T (* if READDISKPAGE returns NIL, presumably there is an
error of some kind, hope it was with the file map and
try again.)
(\M44KillFilePageMap STREAM)
(\M44ReadDiskPage STREAM PAGENO BUF])
(\M44ReadLeaderPage
[LAMBDA (STREAM AGAIN) (* bvm: "17-May-84 16:11")
(* * Returns the leader page of STREAM, reading it if necessary. If AGAIN is true, will read it afresh even if it
already has a cached leader page)
(* File leader page format: Words 0-1, time created. Words 2-3, time last written. Words 4-5, time last read.
Words 6-25, name of file. Words 26-235, leader properties. Words 236-245, spare. Word 246, property pointer.
Word 247, change serial number. Words 248-252, STREAM hint for directory. Word 253, disk address of last page.
Word 254, page number of last page. Word 255, number of bytes on last page.)
(PROG ((BUFFER (fetch LEADERPAGE of STREAM)))
(COND
[(NULL BUFFER)
(SETQ BUFFER (NCREATE (QUOTE VMEMPAGEP]
((NOT AGAIN)
(RETURN BUFFER)))
(\ACTONDISKPAGES (fetch DSKOBJ of (fetch DEVICE of STREAM))
BUFFER
(fetch (ARRAYP BASE) of (OR (fetch FILEPAGEMAP of STREAM)
(\MAKELEADERDAS STREAM)))
-1 STREAM 0 0 \DC.READD)
(replace LEADERPAGE of STREAM with BUFFER)
(RETURN BUFFER])
(\M44ReadPages
[LAMBDA (STREAM FIRSTPAGE# BUFFERS) (* bvm: "26-DEC-81 23:50")
(* Read pages from a Model44 file.)
(for BUF inside BUFFERS as PAGENO from FIRSTPAGE# sum (\M44ReadDiskPage STREAM PAGENO BUF])
(\M44SetAccessTimes
[LAMBDA (STREAM ACCESS CRDATE) (* bvm: " 4-Jun-84 16:40")
(* * Set the "last read" and/or "last written" times in the leader page according to access, which is assumed to
be either INPUT, OUTPUT, BOTH, or APPEND.)
(PROG ((DAT (\DAYTIME0 (create FIXP)))
(BUF (fetch LEADERPAGE of STREAM))) (* Note: DAYTIME0 returns an Alto time, not Lisp time.
This is consistent with the dates in the leader page)
(SELECTQ ACCESS
((OUTPUT BOTH APPEND)
(\BLT (LOCF (fetch TimeCreate of BUF))
(OR CRDATE DAT)
WORDSPERCELL)
(\BLT (LOCF (fetch TimeWrite of BUF))
DAT WORDSPERCELL) (* Must revalidate because write DAT has changed)
(UPDATEVALIDATION STREAM BUF))
NIL)
(SELECTQ ACCESS
((INPUT BOTH)
(\BLT (LOCF (fetch TimeRead of BUF))
DAT WORDSPERCELL))
NIL])
(\M44SetEndOfFile
[LAMBDA (STREAM EPAGE EOFFSET UPDATENOW) (* bvm: "18-May-84 15:27")
(* Reset the file's leader page end-of-file hint. If FAST is given, then simply update the leader page.
If it is not, then read and write the leader page.)
(replace LastPage of STREAM with EPAGE) (* Update handle)
(replace LastOffset of STREAM with EOFFSET)
(PROG ((EADDR (\M44GetPageLoc STREAM EPAGE))
(LEADERPAGE (\M44ReadLeaderPage STREAM)))
(replace LastPageAddress of LEADERPAGE with EADDR)
(replace LastPageNumber of LEADERPAGE with (ADD1 EPAGE))
(* M44 counts from 1)
(replace LastPageByteCount of LEADERPAGE with EOFFSET)
(COND
(UPDATENOW (\M44WriteLeaderPage STREAM])
(\M44SetFileInfo
[LAMBDA (STREAM ATTRIBUTE VALUE DEV) (* bvm: "28-May-84 15:37")
(PROG ((WASOPEN (type? STREAM STREAM)))
(SELECTQ ATTRIBUTE
[CREATIONDATE (SETQ VALUE (OR (IDATE VALUE)
(LISPERROR "ILLEGAL ARG" VALUE]
(ICREATIONDATE (OR (FIXP VALUE)
(LISPERROR "NON-NUMERIC ARG" VALUE)))
(TYPE)
(RETURN))
(RETURN (COND
((OR WASOPEN (SETQ STREAM (\M44GetFileHandle STREAM (QUOTE OLD)
DEV T)))
(COND
((SELECTQ ATTRIBUTE
(TYPE (\M44SETFILETYPE STREAM VALUE))
(PROGN (replace TimeCreate of (\M44ReadLeaderPage STREAM)
with (LISP.TO.ALTO.DATE VALUE))
T))
(\M44WriteLeaderPage STREAM)
T])
(\M44SETFILETYPE
[LAMBDA (STREAM TYPE) (* bvm: "15-Jan-85 17:09")
(* Set TYPE attribute of file to be TYPE -- assumes
someone else will be writing out the leader page later)
(PROG ((TYPECODE (SELECTQ TYPE
(TEXT \FPTYPE.TEXT)
(BINARY \FPTYPE.BINARY)
(NIL \FPTYPE.UNKNOWN)
(OR (\FILETYPE.FROM.TYPE TYPE)
\FPTYPE.BINARY)))
(BUF (\M44ReadLeaderPage STREAM))
PTR TOTALLENGTH)
(* Computation of TYPECODE done this way for backward compatibility -- the \FPTYPE.xx constants were defined before
\FILETYPE.FROM.TYPE was written, and the numbers are incompatible)
(SETQ PTR (\ADDBASE BUF (fetch PropertyBegin of BUF)))
(SETQ TOTALLENGTH (fetch PropertyLength of BUF))
(RETURN (while (IGREATERP TOTALLENGTH 0)
do (SELECTC (fetch FPROPTYPE of PTR)
[0 (* End of properties)
(RETURN (COND
((IGREATERP TOTALLENGTH 1)
(replace FPROPWORD0 of PTR with TYPECODE)
(replace FPROPLENGTH of PTR with 2)
(replace FPROPTYPE of PTR with \FPROP.TYPE)
T]
(\FPROP.TYPE (* Already has a type, change it)
(replace FPROPWORD0 of PTR with TYPECODE)
(RETURN T))
NIL)
(SETQ PTR (\ADDBASE PTR (fetch FPROPLENGTH of PTR)))
(SETQ TOTALLENGTH (IDIFFERENCE TOTALLENGTH (fetch FPROPLENGTH of PTR])
(\M44TruncateFile
[LAMBDA (STREAM LP LO UPDATENOW) (* bvm: "18-May-84 15:27")
(* Resets the length of the file to LP page and LO
offset. Can both shorten and lengthen files.)
[COND
((NOT LP)
(SETQ LP (fetch EPAGE of STREAM))
(SETQ LO (fetch EOFFSET of STREAM]
(COND
((IGREATERP LP (fetch LastPage of STREAM))
(\M44AddDiskPages STREAM LP LO))
((ILESSP LP (fetch LastPage of STREAM))
(\M44DELETEPAGES STREAM (ADD1 LP))
(COND
((ILESSP LP (fetch LASTMAPPEDPAGE of STREAM))
(for I from (ADD1 LP) to (fetch LASTMAPPEDPAGE of STREAM)
do (SETA (fetch FILEPAGEMAP of STREAM)
(IPLUS I 2)
\EOFDA))
(replace LASTMAPPEDPAGE of STREAM with LP)))
(\M44SetEndOfFile STREAM LP LO) (* Now need to rewrite last page with new length, null
next pointer)
(\MAPPAGE LP STREAM)
(\SETIODIRTY STREAM LP)
(FORCEOUTPUT STREAM))
(T (replace LastOffset of STREAM with LO)))
(AND UPDATENOW (\M44SetEndOfFile STREAM LP LO T))
STREAM])
(\M44WriteDiskPage
[LAMBDA (STREAM PAGENO BUF NBYTES) (* bvm: "25-MAY-83 12:04")
(* Write a disk page on the Model44.)
(\M44GetPageLoc STREAM PAGENO T) (* Ensure that PAGENO is in map)
(PROG ((BFSPG# (ADD1 PAGENO)))
(RETURN (COND
([COND
((NEQ PAGENO (fetch LastPage of STREAM))
(* Writing only data)
(\ACTONDISKPAGES (fetch DSKOBJ of (fetch DEVICE of STREAM))
BUF
(fetch (ARRAYP BASE) of (fetch FILEPAGEMAP of STREAM))
-1 STREAM BFSPG# BFSPG# \DC.WRITED))
(T (* When writing last page, need to fill in the numchars
field of label, so this is harder)
(COND
((EQ PAGENO (fetch EPAGE of STREAM))
(EQ (\WRITEDISKPAGES (fetch DSKOBJ of (fetch DEVICE of STREAM))
BUF
(fetch (ARRAYP BASE)
of (fetch FILEPAGEMAP of STREAM))
-1 STREAM BFSPG# BFSPG# NIL NIL NBYTES)
BFSPG#))
(T
(* We will have to write more pages after this one, too, unless the file is truncated back to here, so extend the
file while we're at it. This may save a call to \ADDDISKPAGES)
[COND
((ILEQ (fetch LASTMAPPEDPAGE of STREAM)
PAGENO)
(\M44ExtendFilePageMap STREAM (ADD1 PAGENO]
(COND
((EQ (\WRITEDISKPAGES (fetch DSKOBJ of (fetch DEVICE of STREAM))
(LIST BUF NIL)
(fetch (ARRAYP BASE)
of (fetch FILEPAGEMAP of STREAM))
-1 STREAM BFSPG# (ADD1 BFSPG#)
NIL NIL 0)
(ADD1 BFSPG#)) (* Write two pages, the second of which is blank)
(replace LastPage of STREAM with (ADD1 PAGENO))
(replace LastOffset of STREAM with 0)
T]
NBYTES)
(T (\M44KillFilePageMap STREAM)
(\M44WriteDiskPage STREAM PAGENO BUF NBYTES])
(\M44WriteLeaderPage
[LAMBDA (STREAM) (* bvm: "17-May-84 16:38")
(* Write the file's leader page)
(PROG ((BUFFER (fetch LEADERPAGE of STREAM)))
(AND BUFFER (\ACTONDISKPAGES (fetch DSKOBJ of (fetch DEVICE of STREAM))
BUFFER
(fetch (ARRAYP BASE) of (OR (fetch FILEPAGEMAP of STREAM)
(\MAKELEADERDAS STREAM)))
-1 STREAM 0 0 \DC.WRITED])
(\M44WritePages
[LAMBDA (STREAM FIRSTPAGE# BUFFERS) (* bvm: "11-Jul-84 13:59")
(* Write pages onto a Model44 file.)
(PROG ([NPAGES (COND
((NLISTP BUFFERS)
1)
(T (for B in BUFFERS sum 1]
LASTPAGE#)
(COND
((fetch REVALIDATEFLG of STREAM)
(* Need to update creationdate, since a SAVEVM etc has occurred since the last write. Otherwise, it is possible to
see a change to the file but no change to the creationdate)
(\M44SetAccessTimes STREAM (QUOTE OUTPUT))
(\M44WriteLeaderPage STREAM)
(replace REVALIDATEFLG of STREAM with NIL)))
(\M44GetPageLoc STREAM FIRSTPAGE# T) (* Make sure we know where we are starting to write)
[COND
([ILESSP (fetch LASTMAPPEDPAGE of STREAM)
(SETQ LASTPAGE# (IPLUS FIRSTPAGE# (SUB1 NPAGES]
(* Need enough pagemap to cover everything we write)
(\M44ExtendFilePageMap STREAM (ADD1 LASTPAGE#]
[COND
([AND (IGEQ NPAGES \#DISKBUFFERS)
(for B in BUFFERS thereis (NOT (EMADDRESSP B]
(* More pages to write than we have disk buffers to do it in one command, so break it up. Buffers already in
emulator space are free, though, so we can write lots of them)
(bind (MAXPAGES ←(SUB1 \#DISKBUFFERS))
do (\M44WritePages1 STREAM FIRSTPAGE# (IPLUS FIRSTPAGE# (SUB1 MAXPAGES))
(to MAXPAGES collect (pop BUFFERS)))
(add FIRSTPAGE# MAXPAGES)
(SETQ NPAGES (IDIFFERENCE NPAGES MAXPAGES))
repeatwhile (IGREATERP NPAGES MAXPAGES]
(\M44WritePages1 STREAM FIRSTPAGE# LASTPAGE# BUFFERS])
(\M44WritePages1
[LAMBDA (STREAM FIRSTPAGE# LASTPAGE# BUFFERS) (* bvm: "16-May-84 15:11")
(* * Writes BUFFERS to STREAM, covering pages FIRSTPAGE# thru LASTPAGE#. Caller guarantees that we have enough
disk buffers to do it. -
There are two cases: easy one is if the pages already exist, in which case we just rewrite their data;
hard case is writing pages at end of file, in which case we need to write labels and maybe allocate pages)
(COND
((ILESSP LASTPAGE# (fetch LastPage of STREAM)) (* Writing only data)
(\ACTONDISKPAGES (fetch DSKOBJ of (fetch DEVICE of STREAM))
BUFFERS
(fetch (ARRAYP BASE) of (fetch FILEPAGEMAP of STREAM))
-1 STREAM (.LISP.TO.BFS. FIRSTPAGE#)
(.LISP.TO.BFS. LASTPAGE#)
\DC.WRITED))
(T (* When writing last page, need to fill in the numchars
field of label, so this is harder)
(PROG (MYBUFS NBYTES)
[SETQ MYBUFS (COND
((AND (EQ LASTPAGE# (fetch EPAGE of STREAM))
(NEQ (SETQ NBYTES (fetch EOFFSET of STREAM))
BYTESPERPAGE)) (* Only write to the end of the file)
BUFFERS)
(T
(* We will have to write more pages after this one, too, unless the file is truncated back to here, so extend the
file while we're at it. This may save a call to \ADDDISKPAGES)
(PROG1 (SETQ MYBUFS (CONS))
[for B inside BUFFERS
do (RPLACA MYBUFS B)
(SETQ MYBUFS (CDR (RPLACD MYBUFS (CONS]
(RPLACD (RPLACA MYBUFS NIL)
NIL) (* Write a final blank page)
(SETQ NBYTES 0)
(add LASTPAGE# 1]
(\WRITEDISKPAGES (fetch DSKOBJ of (fetch DEVICE of STREAM))
MYBUFS
(fetch (ARRAYP BASE) of (fetch FILEPAGEMAP of STREAM))
-1 STREAM (.LISP.TO.BFS. FIRSTPAGE#)
(.LISP.TO.BFS. LASTPAGE#)
NIL NIL NBYTES)
(replace LastPage of STREAM with LASTPAGE#)
(replace LastOffset of STREAM with NBYTES])
)
(DEFINEQ
(\ADDDISKPAGES
[LAMBDA (STREAM FIRSTNEWPAGE NPAGES DAs LASTNUMCHARS) (* bvm: "17-May-84 16:46")
(* Adds to file STREAM NPAGES, where FIRSTNEWPAGE-1 is the last existing page. DAs is the vector of disk
addresses, where first element corresponds to BFS page -1)
(* Note FIRSTNEWPAGE is in Lisp terms, so it is actually
LASTOLDPAGE for the BFS)
(PROG ((LASTPAGEBUF (NCREATE (QUOTE VMEMPAGEP)))
(LASTEXISTINGPAGE FIRSTNEWPAGE)
(DSK (fetch DSKOBJ of (fetch DEVICE of STREAM)))
BUFFERS CHUNK)
(SETQ BUFFERS (CONS LASTPAGEBUF (for I from 1 to (IMIN NPAGES \MAXDISKDAs) collect NIL)))
(\ACTONDISKPAGES DSK LASTPAGEBUF DAs -1 STREAM LASTEXISTINGPAGE LASTEXISTINGPAGE \DC.READD
NIL NIL NIL LASTEXISTINGPAGE) (* Read last existing page, so we can rewrite it with
new label)
(while (IGREATERP NPAGES 0)
do (SETQ CHUNK (IMIN \MAXDISKDAs NPAGES))
(\WRITEDISKPAGES DSK BUFFERS DAs -1 STREAM LASTEXISTINGPAGE (IPLUS LASTEXISTINGPAGE
CHUNK)
NIL NIL LASTNUMCHARS LASTEXISTINGPAGE)
(RPLACA BUFFERS NIL)
(add LASTEXISTINGPAGE CHUNK)
(SETQ NPAGES (IDIFFERENCE NPAGES CHUNK])
(\M44DELETEPAGES
[LAMBDA (STREAM FIRSTPAGE) (* bvm: "25-MAY-83 12:07")
(* FIRSTPAGE is in Lisp terms, i.e. -1 = leader page)
(PROG ((DEV (fetch DEVICE of STREAM))
(NPAGES (COND
((fetch VALIDATION of STREAM)
(IPLUS (ADD1 (IDIFFERENCE (fetch LastPage of STREAM)
FIRSTPAGE))
2))
(T PageMapIncrement)))
(PN (ADD1 FIRSTPAGE))
DAs FIRSTDA LASTPAGESEEN DSK)
(* NPAGES is used to decide how much to do at once. Need be no more than number of pages known to exist.
The ADD1 is that, plus two for the pages around it)
(COND
((ILESSP NPAGES 2) (* Nothing to delete)
(RETURN)))
(SETQ DSK (fetch DSKOBJ of DEV)) (* (\FLUSHDISKDESCRIPTOR (EMPOINTER
(fetch (DSKOBJ DSKDDMGR) of DSK))
(fetch ALTODSKOBJ of DSK)))
(* Tell Alto to clear out anything it knows about dd)
(* IF STREAM:LASTMAPPEDPAGE GE FIRSTPAGE+NPAGES THEN DAs
← STREAM:FILEPAGEMAP DAorigin ← -1)
(SETQ DAs (ARRAY (SETQ NPAGES (IMIN NPAGES \MAXDISKDAs))
(QUOTE WORD)
NIL 0))
[SETQ FIRSTDA (COND
[(EQ FIRSTPAGE -1)
(fetch FPLEADERVDA of (fetch FIDBLOCK of (fetch FID of STREAM]
(T (\M44GetPageLoc STREAM FIRSTPAGE]
(while (NEQ FIRSTDA \EOFDA)
do (SETA DAs 0 \FILLINDA)
(SETA DAs 1 FIRSTDA) (* Corresponds to PN)
(for I from 2 to (SUB1 NPAGES) do (SETA DAs I \FILLINDA))
[SETQ LASTPAGESEEN (\ACTONDISKPAGES DSK NIL (fetch (ARRAYP BASE) of DAs)
(SUB1 PN)
STREAM PN (IPLUS PN NPAGES -3)
\DC.READD NIL NIL NIL
(ADD1 (fetch EPAGE of STREAM]
(* Read DAs for the next NPAGES-2)
(\WRITEDISKPAGES DSK NIL (fetch (ARRAYP BASE) of DAs)
(SUB1 PN)
\FREEPAGEFID PN LASTPAGESEEN (UNSIGNED -1 BITSPERWORD))
[for I from PN to LASTPAGESEEN do (\M44MARKPAGEFREE DEV
(ELT DAs (ADD1 (IDIFFERENCE
I PN]
(SETQ FIRSTDA (ELT DAs (IPLUS (IDIFFERENCE LASTPAGESEEN PN)
2)))
(SETQ PN (ADD1 LASTPAGESEEN))) (* (FLUSHMAP (fetch (M44DEVICE DISKDESCRIPTOROFD) of
DEV)))
(* (FORGETPAGES (fetch (M44DEVICE DISKDESCRIPTOROFD) of
DEV)))
(\M44FLUSHDISKDESCRIPTOR DEV])
(\ASSIGNDISKPAGE
[LAMBDA (DSK PREVDA) (* bvm: "13-Feb-85 19:32")
(* * Assigns a new page on DSK. If PREVDA is \EOFDA will pick random page, otherwise will attempt to allocate
PREVDA+1. Returns NIL if disk is full)
(PROG ([VDA (COND
((OR (EQ PREVDA \EOFDA)
(COND
((EQ PREVDA \FILLINDA)
(AND \DISKDEBUG (RAID
"[Disk debug] \ASSIGNDISKPAGE called with \FILLINDA. ↑N to continue"))
T)))
(fetch DISKLASTPAGEALLOC of DSK))
(T (ADD1 PREVDA]
(DD (fetch DISKDESCRIPTOROFD of DSK))
(MASK 128)
BITS A LOOPEDONCE FREE)
(OR (fetch DDVALID of DSK)
(RAID "DISKDESCRIPTOR not open" DSK))
(\SETFILEPTR DD (IPLUS \DDBITTABSTART (FOLDLO VDA BITSPERBYTE)))
(SETQ A (MOD VDA BITSPERBYTE))
(FRPTQ A (SETQ MASK (LRSH MASK 1)))
LP (COND
((NULL (SETQ BITS (\BIN DD)))
(* End of file -- wrap around to start. This technique takes longer than necessary to bomb out when disk is full,
but who cares?)
(COND
(LOOPEDONCE (RETURN NIL)))
(SETQ LOOPEDONCE T)
(\SETFILEPTR DD \DDBITTABSTART))
((NEQ BITS 255)
(until (OR (EQ (LOGAND BITS MASK)
0)
(EQ (SETQ MASK (LRSH MASK 1))
0))
do (add A 1))
(COND
((NEQ MASK 0) (* Found a free page)
(\BACKFILEPTR DD)
(SETQ VDA (IPLUS (UNFOLD (IDIFFERENCE (\GETFILEPTR DD)
\DDBITTABSTART)
BITSPERBYTE)
A))
(\BOUT DD (LOGOR BITS MASK)) (* Set bit indicating we snarfed this page)
(* Decrement free page count hint)
[replace DISKFREEPAGES of DSK with (COND
((EQ (SETQ FREE (fetch DISKFREEPAGES
of DSK))
0)
(AND \DISKDEBUG (RAID
"[Disk debug] Free page hint went negative. ↑N to continue"))
(\COUNTDISKFREEPAGES DD))
(T (SUB1 FREE]
(replace DISKLASTPAGEALLOC of DSK with VDA)
(replace DDDIRTY of DSK with T)
(RETURN VDA)))
(SETQ MASK 128)
(SETQ A 0)))
(GO LP])
(\COUNTDISKFREEPAGES
[LAMBDA (DD) (* bvm: "13-Feb-85 19:32")
(* * Counts number of free pages on a disk. DD is the diskdescriptor stream)
[OR (type? STREAM DD)
(SETQ DD (\OPENDISKDESCRIPTOR (\GETDEVICEFROMNAME (OR DD (QUOTE DSK]
(PROG ((CNT 0)
MASK BITS)
(\SETFILEPTR DD \DDBITTABSTART)
LP [COND
((NULL (SETQ BITS (\BIN DD))) (* End of file)
(RETURN CNT))
((EQ BITS 0)
(add CNT 8))
((NEQ BITS 255)
(SETQ MASK 128)
(do (COND
((EQ (LOGAND BITS MASK)
0)
(add CNT 1)))
until (EQ (SETQ MASK (LRSH MASK 1))
0]
(GO LP])
(\M44MARKPAGEFREE
[LAMBDA (DEV DA) (* bvm: "17-Jan-85 17:11")
(* Mark disk address DA on disk device DEV free)
(PROG ((DSK (COND
((type? FDEV DEV)
(fetch (M44DEVICE DSKOBJ) of DEV))
(T DEV)))
DD BITS MASK)
[SETQ DD (COND
((fetch (DSKOBJ DDVALID) of DSK)
(fetch (DSKOBJ DISKDESCRIPTOROFD) of DSK))
(T (\OPENDISKDESCRIPTOR DEV]
(SETFILEPTR DD (IPLUS \DDBITTABSTART (FOLDLO DA BITSPERBYTE)))
(SETQ BITS (\BIN DD))
[SETQ MASK (LLSH 1 (IDIFFERENCE 7 (MOD DA BITSPERBYTE]
(COND
((NEQ (LOGAND BITS MASK)
0) (* Page is marked occupied, so free it)
(\BACKFILEPTR DD)
(\BOUT DD (LOGXOR BITS MASK))
(add (fetch (DSKOBJ DISKFREEPAGES) of DSK)
1)
(replace (DSKOBJ DDDIRTY) of DSK with T])
(\M44FLUSHDISKDESCRIPTOR
[LAMBDA (DEV) (* bvm: " 8-Jun-84 14:48")
(PROG ((DSK (COND
((type? FDEV DEV)
(fetch (M44DEVICE DSKOBJ) of DEV))
(T DEV)))
DD)
(OR (fetch (DSKOBJ DDDIRTY) of DSK)
(RETURN))
(OR (SETQ DD (fetch DISKDESCRIPTOROFD of DSK))
(RETURN (RAID "[Disk debug] no disk descriptor stream")))
(\SETFILEPTR DD \OFFSET.DISKLASTSERIAL#)
(\BOUTS DD (LOCF (fetch DISKLASTSERIAL# of DSK))
0 \NBYTES.DISKINFO) (* Copy interesting stuff into diskdescriptor header)
(FORCEOUTPUT DD)
(replace DDDIRTY of DSK with NIL)
(RETURN T])
(\MAKELEADERDAS
[LAMBDA (STREAM) (* bvm: "20-OCT-82 18:42")
(* Makes a page map for STREAM that includes the leader
vda)
(PROG ((MAP (ARRAY 4 (QUOTE WORD)
\FILLINDA 0)))
(SETA MAP 0 \EOFDA)
[SETA MAP 1 (fetch FPLEADERVDA of (fetch (ARRAYP BASE) of (fetch FID of STREAM]
(replace FILEPAGEMAP of STREAM with MAP)
(replace LASTMAPPEDPAGE of STREAM with -1)
(RETURN MAP])
(DISKFREEPAGES
(LAMBDA (DSK RECOMPUTE) (* ejs: " 7-Nov-85 16:33")
(* DSK ignored for now)
(SELECTC \MACHINETYPE
((LIST \DANDELION \DAYBREAK) (* Temporary until this become a device op)
(\DFSFreeDiskPages DSK RECOMPUTE))
(\M44FREEPAGECOUNT (COND
((type? FDEV DSK)
DSK)
(T (\GETDEVICEFROMNAME (OR DSK (QUOTE DSK)))))
NIL RECOMPUTE))))
(\M44FREEPAGECOUNT
[LAMBDA (DEV DIRECTORY RECOMPUTE) (* bvm: "12-Oct-85 15:43")
(PROG (CNT)
(COND
((NOT (type? M44DEVICE DEV))
(\ILLEGAL.ARG DEV)))
(RETURN (COND
(RECOMPUTE (SETQ CNT (\COUNTDISKFREEPAGES (\OPENDISKDESCRIPTOR DEV)))
(COND
((NEQ CNT (fetch (M44DEVICE DISKFREEPAGES) of DEV))
(replace (M44DEVICE DISKFREEPAGES) of DEV with CNT)
(replace (M44DEVICE DDDIRTY) of DEV with T)))
CNT)
(T (fetch (M44DEVICE DISKFREEPAGES) of DEV])
(VMEMSIZE
[LAMBDA NIL (* bvm: " 1-NOV-82 16:44")
(fetch (IFPAGE NActivePages) of \InterfacePage])
)
(RPAQ? \M44MULTFLG T)
(DECLARE: DONTCOPY
(DECLARE: EVAL@COMPILE
[PUTPROPS UCASECHAR MACRO ((C)
(COND ((ILESSP C (CHARCODE a))
C)
(T (IDIFFERENCE C (IDIFFERENCE (CHARCODE a)
(CHARCODE A]
[PUTPROPS UPDATEVALIDATION MACRO ((STREAM BUF)
(replace VALIDATION of STREAM with (\MAKENUMBER (\GETBASE BUF 1)
(\GETBASE BUF 3]
)
[DECLARE: EVAL@COMPILE
(ACCESSFNS M44DEVICE ((DSKOBJ (fetch DEVICEINFO of DATUM)
(replace DEVICEINFO of DATUM with NEWVALUE)))
[TYPE? (AND (type? FDEV DATUM)
(EQ (fetch OPENFILE of DATUM)
(QUOTE \M44OpenFile])
]
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \OPENFILES \M44MULTFLG \DISKNAMECASEARRAY)
)
(DECLARE: EVAL@COMPILE
(PUTPROPS .LISP.TO.BFS. MACRO (= . ADD1))
(PUTPROPS .BFS.TO.LISP. MACRO (= . SUB1))
[PUTPROPS .DISKCASEARRAY. MACRO (NIL (fetch (ARRAYP BASE)
of
(\DTEST \DISKNAMECASEARRAY (QUOTE ARRAYP]
)
(DECLARE: EVAL@COMPILE
(RPAQQ PageMapIncrement 64)
(CONSTANTS (PageMapIncrement 64))
)
(* File properties)
[DECLARE: EVAL@COMPILE
(BLOCKRECORD M44FILEPROP ((FPROPTYPE BYTE) (* Type of property)
(FPROPLENGTH BYTE) (* Length of entire entry in words)
(FPROPWORD0 WORD) (* value starts here)
) (* Overlays a piece of leader page to
describe a file property)
)
]
(RPAQQ FPROPTYPES ((\FPROP.TYPE 136)
(\FPROP.PAGEMAP 137)))
(DECLARE: EVAL@COMPILE
(RPAQQ \FPROP.TYPE 136)
(RPAQQ \FPROP.PAGEMAP 137)
(CONSTANTS (\FPROP.TYPE 136)
(\FPROP.PAGEMAP 137))
)
(RPAQQ FPTYPES ((\FPTYPE.UNKNOWN 0)
(\FPTYPE.TEXT 1)
(\FPTYPE.BINARY 2)))
(DECLARE: EVAL@COMPILE
(RPAQQ \FPTYPE.UNKNOWN 0)
(RPAQQ \FPTYPE.TEXT 1)
(RPAQQ \FPTYPE.BINARY 2)
(CONSTANTS (\FPTYPE.UNKNOWN 0)
(\FPTYPE.TEXT 1)
(\FPTYPE.BINARY 2))
)
)
(DECLARE: DONTCOPY
(DECLARE: EVAL@COMPILE
[PUTDEF (QUOTE \M44PAGEBUFFER)
(QUOTE RESOURCES)
(QUOTE (NEW (NCREATE (QUOTE VMEMPAGEP]
)
)
(/SETTOPVAL (QUOTE \\M44PAGEBUFFER.GLOBALRESOURCE))
(* Directory enumeration)
(DEFINEQ
(\M44GENERATEFILES
[LAMBDA (FDEV PATTERN DESIREDPROPS OPTIONS) (* bvm: "12-Oct-85 15:13")
(* Returns a file-generator object that will generate AT LEAST all files in the sys-dir of FDEV whose names match
PATTERN. Clients might need to provide additional filtering. For M44, the generate state consists of the HOSTNAME
(DSK) followed by a "search state", a directory pointer and a character list of the sort that \SEARCHDIR1 expects.
DIRPTR is the position of the next file to be considered in the directory.)
(PROG ((DIRSTREAM (fetch (M44DEVICE SYSDIROFD) of FDEV))
(SORT? (EQMEMB (QUOTE SORT)
OPTIONS))
(CASEBASE (.DISKCASEARRAY.))
(EXT (QUOTE *))
HOSTNAME NAME VERSION CHARLIST GENSTREAM FILTER DESIREDVERSION SEARCHSTATE HOSTPREFIX)
(OR DIRSTREAM (RETURN (\NULLFILEGENERATOR)))
[COND
((for TAIL on (UNPACKFILENAME.STRING PATTERN) by (CDDR TAIL)
do (SELECTQ (CAR TAIL)
(HOST (SETQ HOSTNAME (CADR TAIL)))
(NAME (SETQ NAME (CADR TAIL)))
(EXTENSION (SETQ EXT (CADR TAIL)))
[VERSION (COND
((OR (EQ [NCHARS (SETQ VERSION
(MKATOM (CADR TAIL]
0)
(EQ VERSION 0))
(* Newest version only)
(SETQ SORT? T)
(* Can only get highest version by sorting)
(SETQ VERSION NIL)
(SETQ DESIREDVERSION T))
((SMALLP VERSION)
(* An actual specific version to look for)
(SETQ DESIREDVERSION VERSION))
((NEQ VERSION (QUOTE *))
(* Bogus version)
(RETURN T]
(RETURN T))) (* Bad file name)
(RETURN (\NULLFILEGENERATOR]
(SETQ FILTER (DIRECTORY.MATCH.SETUP (CONCAT NAME (QUOTE %.)
EXT ";*")))
(SETQ CHARLIST (for C instring (COND
((OR (EQ 0 (NCHARS EXT))
(EQ (CHCON1 EXT)
(CHARCODE *)))
NAME)
(T (CONCAT NAME (QUOTE %.)
EXT)))
until (SELCHARQ (SETQ C (\GETBASEBYTE CASEBASE C))
((# *)
(* \SEARCHDIR1 currently only checks prefixes, so we truncate at the first * or escape. Also ignore version
specifications, because of the alternative representations of version 1)
T)
NIL)
collect C))
(COND
(DESIREDPROPS (* Create a scratch stream for \M44FILEINFOFN to use)
(SETQ GENSTREAM (create M44STREAM))
(replace DEVICE of GENSTREAM with FDEV)))
(SETQ SEARCHSTATE (create M44DIRSEARCHSTATE
DIRPTR ← 0
CHARLIST ← CHARLIST))
(SETQ HOSTPREFIX (CONCAT (QUOTE {)
HOSTNAME
(QUOTE })))
(RETURN (COND
(SORT? (* Have to generate the matching files first, sort
them, then enumerate)
(create FILEGENOBJ
NEXTFILEFN ←(FUNCTION \M44SORTEDNEXTFILEFN)
FILEINFOFN ←(FUNCTION \M44FILEINFOFN)
GENFILESTATE ←(create M44GENFILESTATE
DIROFD ← DIRSTREAM
SEARCHSTATE ←(\M44SORTFILES
DIRSTREAM SEARCHSTATE FILTER
DESIREDVERSION HOSTPREFIX
(LENGTH CHARLIST))
GENVERSION ← DESIREDVERSION
GENSTREAM ← GENSTREAM)))
(T (* Order not important)
(create FILEGENOBJ
NEXTFILEFN ←(FUNCTION \M44NEXTFILEFN)
FILEINFOFN ←(FUNCTION \M44FILEINFOFN)
GENFILESTATE ←(create M44GENFILESTATE
DIROFD ← DIRSTREAM
SEARCHSTATE ← SEARCHSTATE
GENFILTER ← FILTER
GENVERSION ← DESIREDVERSION
HOSTNAME ← HOSTPREFIX
GENSTREAM ← GENSTREAM])
(\M44SORTFILES
[LAMBDA (DIRSTREAM SEARCHSTATE FILTER DESIREDVERSION HOSTPREFIX PATTERNLENGTH)
(* bvm: " 7-Jun-84 14:38")
(SORT (bind FL while (SETQ FL (\M44GENERATENEXT DIRSTREAM SEARCHSTATE FILTER DESIREDVERSION
HOSTPREFIX PATTERNLENGTH))
collect FL)
(FUNCTION (LAMBDA (X Y)
(SELECTQ (UALPHORDER (CAR X)
(CAR Y))
(LESSP T)
(EQUAL (IGREATERP (CADR X)
(CADR Y)))
NIL])
(\M44GENERATENEXT
[LAMBDA (DIRSTREAM SEARCHSTATE FILTER DESIREDVERSION HOSTPREFIX PATTERNLENGTH GENFILESTATE)
(* bvm: "12-Oct-85 15:49")
(* * Produces the next filename from directory DIRSTREAM satisfying SEARCHSTATE and the more constrained FILTER and
DESIREDVERSION, or returns NIL if no more files. HOSTPREFIX is string to put on front, or NIL for names only.
PATTERNLENGTH is the length of the pattern in SEARCHSTATE. GENFILESTATE is a a M44GENFILESTATE whose GENSTREAM and
ENTRYSTART want to be set appropriately for \M44FILEINFOFN; if NIL, then the value is returned for SORTFILES in the
form (name version entrystart))
(PROG ((PATTERNHASDOT (MEMB (CHARCODE %.)
(fetch CHARLIST of SEARCHSTATE)))
SAWDOT ENTRYSTART TEMP PREFIXLEN TOTALLEN THISVERSION RESULT INDEX)
LP (COND
((NOT (SETQ TEMP (\M44SEARCHDIR DIRSTREAM SEARCHSTATE)))
(* Enumeration finished)
(RETURN NIL)))
(SETQ SAWDOT PATTERNHASDOT)
(SETQ ENTRYSTART (IDIFFERENCE (GETFILEPTR DIRSTREAM)
(IPLUS PATTERNLENGTH 13)))
(* Read all the characters from the directory)
(SETQ TOTALLEN (IPLUS PATTERNLENGTH (SUB1 TEMP)))
(for I from (SUB1 TEMP) to 1 by -1
do (* The SUB1 is because the last character is the
undesired dot)
(SELCHARQ (\BIN DIRSTREAM)
[! (RETURN (SETQ THISVERSION (\M44READVERSION DIRSTREAM
(SUB1 I]
(%. (SETQ SAWDOT T))
NIL)
finally (SETQ THISVERSION 1))
(COND
((AND DESIREDVERSION (NEQ THISVERSION DESIREDVERSION)
(NEQ DESIREDVERSION T)) (* Failure, try next)
(GO LP)))
[SETQ RESULT (ALLOCSTRING (IPLUS TOTALLEN (SETQ PREFIXLEN (COND
(HOSTPREFIX (NCHARS HOSTPREFIX))
(T 0)))
(COND
((AND (EQ THISVERSION 1)
HOSTPREFIX)
2)
(T 0))
(COND
(SAWDOT 0)
(T 1]
(AND HOSTPREFIX (RPLSTRING RESULT 1 HOSTPREFIX))
(\SETFILEPTR DIRSTREAM (IPLUS ENTRYSTART 13))
(* Now read the whole name)
(SETQ INDEX PREFIXLEN)
(for I from TOTALLEN to 1 by -1
do (SELCHARQ (SETQ TEMP (\BIN DIRSTREAM))
(%. (SETQ SAWDOT T))
(! (OR SAWDOT (RPLCHARCODE RESULT (add INDEX 1)
(CHARCODE %.)))
(SETQ SAWDOT T)
[COND
(HOSTPREFIX (RPLCHARCODE RESULT (add INDEX 1)
(CHARCODE ;))
(to (SUB1 I)
do (RPLCHARCODE RESULT (add INDEX 1)
(COND
(GENFILESTATE (\BIN
DIRSTREAM))
(T
(* Make everything a constant version for benefit of SORT. Will replace with real thing later.
The constant version is chosen in a way that makes 2-digit versions sort in front of 1-digit versions, etc, and
single-digit versions come out as ;1 to match the ;1 inserted below)
(IDIFFERENCE
(CHARCODE 3)
I]
(RETURN))
NIL)
(RPLCHARCODE RESULT (add INDEX 1)
TEMP))
(OR SAWDOT (RPLCHARCODE RESULT (add INDEX 1)
(CHARCODE %.)))
(COND
((AND (EQ THISVERSION 1)
HOSTPREFIX)
(RPLSTRING RESULT (ADD1 INDEX)
";1")))
(COND
((AND FILTER (NOT (DIRECTORY.MATCH FILTER RESULT)))
(GO LP)))
(RETURN (COND
(GENFILESTATE (replace ENTRYSTART of GENFILESTATE with ENTRYSTART)
(replace DIRINFO of (fetch GENSTREAM of GENFILESTATE)
with NIL)
RESULT)
(T (LIST RESULT THISVERSION ENTRYSTART])
(\M44NEXTFILEFN
[LAMBDA (GENFILESTATE NAMEONLY) (* bvm: " 7-Jun-84 12:13")
(* GENFILESTATE is the state information from the file-generator object created by \M44GENERATEFILES.
This function returns the next file name as a string. Returns NIL if no files left. It updates GENFILESTATE so
that it will get the following satisfactory file on the next call to this function. -
NAMEONLY => returns the filenames without the semi-colon and version number)
(PROG ((DIRSTREAM (fetch DIROFD of GENFILESTATE))
(SEARCHSTATE (fetch SEARCHSTATE of GENFILESTATE))
(DESIREDVERSION (fetch GENVERSION of GENFILESTATE))
(FILTER (fetch GENFILTER of GENFILESTATE))
(HOSTPREFIX (AND (NOT NAMEONLY)
(fetch HOSTNAME of GENFILESTATE)))
PATTERNLENGTH)
(SETQ PATTERNLENGTH (LENGTH (fetch CHARLIST of SEARCHSTATE)))
(RETURN (\M44GENERATENEXT DIRSTREAM SEARCHSTATE FILTER DESIREDVERSION HOSTPREFIX
PATTERNLENGTH GENFILESTATE])
(\M44SORTEDNEXTFILEFN
[LAMBDA (GENFILESTATE NAMEONLY) (* bvm: "12-Oct-85 15:16")
(LET ((FILES (fetch SEARCHSTATE of GENFILESTATE))
THISFILE THISNAME V LEN)
(COND
((SETQ THISFILE (CAR FILES)) (* THISFILE = (name version entryStart))
(SETQ THISNAME (CAR THISFILE))
(SETQ V (CADR THISFILE)) (* need to fill in the correct version number, since
the names were generated with constant version number)
(SETQ LEN (NCHARS THISNAME))
[COND
[(ILESSP V 10) (* Easy, 1-digit version)
(\RPLCHARCODE THISNAME LEN (PLUS V (CHARCODE 0]
(T (SETQ V (CHCON V))
(for C in V as I from [SETQ LEN (ADD1 (IDIFFERENCE LEN (LENGTH
V]
do (\RPLCHARCODE THISNAME I C]
(replace DIRINFO of (fetch GENSTREAM of GENFILESTATE) with NIL)
(replace ENTRYSTART of GENFILESTATE with (CADDR THISFILE))
(SETQ FILES (CDR FILES))
(COND
((EQ (fetch GENVERSION of GENFILESTATE)
T)
(bind (THISNAMEONLY ←(SUBSTRING THISNAME 1 (SUB1 LEN)))
while (AND FILES (STRING-EQUAL (SUBSTRING (CAAR FILES)
1
(SUB1 LEN))
THISNAMEONLY))
do (SETQ FILES (CDR FILES)))
FILES))
(replace SEARCHSTATE of GENFILESTATE with FILES)
THISNAME])
(\M44FILEINFOFN
[LAMBDA (GENFILESTATE ATTRIBUTE) (* bvm: "18-May-84 11:15")
(* Retrieves info of file currently being enumerated.
State has a directory pointer to help us out)
(PROG ((STREAM (fetch GENSTREAM of GENFILESTATE)))
(OR STREAM (RETURN))
(COND
((NULL (fetch DIRINFO of STREAM))
(replace VALIDATION of STREAM with (replace FILEPAGEMAP of STREAM with NIL))
(replace DIRINFO of STREAM with (fetch ENTRYSTART of GENFILESTATE))
(replace FID of STREAM with (\READDIRFPTR (fetch DIROFD of GENFILESTATE)
(fetch ENTRYSTART of GENFILESTATE)
(fetch FID of STREAM)))
(\M44ReadLeaderPage STREAM T)))
(RETURN (\M44GetFileInfo STREAM ATTRIBUTE])
)
(* Directory lookup routines)
(DEFINEQ
(\M44PARSEFILENAME
[LAMBDA (X RECOG DEV CREATEFLG) (* bvm: " 3-Apr-85 15:10")
(* This returns a full file specification, with all the information needed to do open, delete, etc. A filespec is a
(packedname unpackedname dirptr) triple, with the true version number smashed into the uname.
The dirptr is NIL if the file does not currently exist in the directory.)
(PROG ((UNAME (\M44UNPACKFILENAME X DEV CREATEFLG))
V L DP)
[COND
((NULL UNAME) (* BAD FILE NAME)
(RETURN (create FILESPEC
UNAME ← NIL)))
[(EQ UNAME (QUOTE DIRECTORY)) (* directory name found on front of file name, needs to
generate file not found error in openfile.)
(RETURN (create FILESPEC
UNAME ← NIL
FSDIRPTR ←(QUOTE DIRECTORY]
([AND (SETQ L (\M44LOOKUPVERSIONS UNAME (fetch (M44DEVICE SYSDIROFD) of DEV)
(SELECTQ RECOG
((NEW OLD/NEW)
T)
NIL)))
(SETQ V (SELECTQ (OR (fetch VERSION of UNAME)
RECOG)
((OLD OLD/NEW)
(CAR (LAST L)))
[NEW (* A new version, so the DIRPTR is NIL)
(LIST (ADD1 (CAAR (LAST L]
(OLDEST (CAR L))
(SASSOC (fetch VERSION of UNAME)
L]
(SETQ DP (CDR V))
(SETQ V (CAR V)))
(T (SETQ DP NIL) (* Since file doesnt exist, recognition mode takes
precedence over version number)
(SETQ V (SELECTQ (OR RECOG (fetch VERSION of UNAME))
((NEW OLD/NEW)
(OR (FIXP (fetch VERSION of UNAME))
1))
((OLD OLDEST)
NIL)
(FIXP (fetch VERSION of UNAME]
(replace VERSION of UNAME with (AND V (CHCON V)))
(* We may have to zap a version number that was
specified but not found)
(RETURN (create FILESPEC
UNAME ← UNAME
FSDIRPTR ← DP])
(\FINDDIRHOLE
[LAMBDA (#WORDS DIRSTREAM) (* bvm: "21-May-84 12:20")
(* Returns the byte address of a directory hole of size #WORDS. The directory file is positioned just after the
2-byte length field of the hole.)
(PROG ((PTR (OR (fetch DIRHOLEPTR of DIRSTREAM)
0))
ENTRYLENGTH C)
NEXT(\SETFILEPTR DIRSTREAM PTR)
(COND
((\EOFP DIRSTREAM)
(GO END))
((AND (IGEQ (SETQ ENTRYLENGTH (IPLUS (LLSH (LOGAND (SETQ C (\BIN DIRSTREAM))
3)
8)
(\BIN DIRSTREAM)))
#WORDS)
(ILESSP C 4))
(* First 6 bits is entry type, next 10 bits are length of entry in words. Free entries have type zero.
Thus C < 4 implies this is free entry.)
(\SETFILEPTR DIRSTREAM PTR) (* Hole is large enough)
[COND
((IGREATERP ENTRYLENGTH #WORDS) (* Too large, so break it apart.)
(SETQ ENTRYLENGTH (IDIFFERENCE ENTRYLENGTH #WORDS))
(\WOUT DIRSTREAM ENTRYLENGTH)
(\SETFILEPTR DIRSTREAM (add PTR (UNFOLD ENTRYLENGTH BYTESPERWORD]
(GO END)))
(add PTR (UNFOLD ENTRYLENGTH BYTESPERWORD))
(GO NEXT)
END (\WOUT DIRSTREAM #WORDS)
(RETURN PTR])
(\M44PACKFILENAME
[LAMBDA (UNAME) (* bvm: " 3-Apr-85 14:44")
(* Produces a Lisp style file-name of the form
"name.[ext];ver")
(AND (fetch VERSION of UNAME)
(PACK* (QUOTE {)
(fetch PARTNAME of UNAME)
(QUOTE })
(PACKC (APPEND (fetch UCASECHARS of UNAME)
[COND
((MEMB (CHARCODE %.)
(fetch UCASECHARS of UNAME))
(CHARCODE (;)))
(T (CHARCODE (%. ;]
(fetch VERSION of UNAME])
(\M44LOOKUPVERSIONS
[LAMBDA (UNAME STREAM HMIN) (* bvm: " 3-Apr-85 15:10")
(* UNAME is a value of \UNPACKFILENAME. STREAM is the directory ofd. HMIN=T means look for a hole big enough for
UNAME, a number N means look for that size hole, NIL means don't look. Returns a list of (version . fileptr) pairs
sorted by increasing version. Ptr is a pointer to the beginning of the directory slot for the file.)
(PROG ([LEN1 (IPLUS 13 (LENGTH (fetch UCASECHARS of UNAME]
(TLIST (CONS 0 (fetch UCASECHARS of UNAME)))
(FIXEDVERSION (FIXP (fetch VERSION of UNAME)))
PTR NCHARSLEFT VERSIONPAIRS VERS END C)
(COND
((EQ FIXEDVERSION 0) (* Highest version not really a fixed version)
(SETQ FIXEDVERSION NIL)))
[COND
((EQ HMIN T) (* The 6 is to allow for the maximum number of chars in
a version number)
(SETQ HMIN (FOLDLO (IPLUS LEN1 6)
BYTESPERWORD]
SEARCHLP
(COND
((NULL (SETQ NCHARSLEFT (\M44SEARCHDIR STREAM TLIST HMIN)))
(RETURN VERSIONPAIRS)))
(SETQ PTR (\GETFILEPTR STREAM))
(COND
((EQ NCHARSLEFT 1) (* No version, just the final dot)
(SETQ VERS 1))
((NEQ (\BIN STREAM)
(CHARCODE !)) (* More chars follow before version, so no match)
(GO NEXT))
([NULL (SETQ VERS (\M44READVERSION STREAM (IDIFFERENCE NCHARSLEFT 2]
(GO NEXT)))
(* * Name matches. VERS is the version number. Cons up a piece of the result. If UNAME has an explicit version,
insist on it now)
(SETQ PTR (IDIFFERENCE PTR LEN1)) (* Find beginning of the directory entry)
(* Merge new element into VERSIONPAIRS)
[COND
[FIXEDVERSION (COND
((EQ VERS FIXEDVERSION)
(RETURN (LIST (CONS VERS PTR]
((OR (NULL VERSIONPAIRS)
(IGREATERP (CAAR VERSIONPAIRS)
VERS))
(push VERSIONPAIRS (CONS VERS PTR)))
(T (for (PREV ← VERSIONPAIRS) while (AND (CDR PREV)
(IGREATERP VERS (CAADR PREV)))
do (SETQ PREV (CDR PREV)) finally (RPLACD PREV (CONS (CONS VERS PTR)
(CDR PREV]
NEXT(AND HMIN (fetch DIRHOLEPTR of STREAM)
(SETQ HMIN NIL)) (* Stop looking if found a hole)
(GO SEARCHLP])
(\M44READVERSION
[LAMBDA (DIRSTREAM MAXCHARS) (* bvm: " 7-Jun-84 11:38")
(to MAXCHARS bind (VERSION ← 0)
C
do (SETQ C (\BIN DIRSTREAM))
(COND
[(AND (IGEQ C (CHARCODE 0))
(ILEQ C (CHARCODE 9)))
(SETQ VERSION (IPLUS (ITIMES VERSION 10)
(IDIFFERENCE C (CHARCODE 0]
(T (* A non-numeric after a ! means that it wasn't the
version marker. This is permissible by alto file spec)
(RETURN)))
finally (RETURN VERSION])
(\OPENDISKDESCRIPTOR
[LAMBDA (DEV) (* hdj " 5-Jun-86 22:52")
(* Opens and returns a stream on the
disk descriptor file for DEV)
[COND
((NOT (type? FDEV DEV))
(SETQ DEV (\GETDEVICEFROMNAME (fetch DISKDEVICENAME of DEV]
(OR (fetch (M44DEVICE DDVALID) of DEV)
(PROG ((OLDD (fetch (M44DEVICE DISKDESCRIPTOROFD) of DEV))
STREAM)
(COND
(OLDD (FORGETPAGES OLDD)))
[SETQ STREAM (COND
((EQ (fetch DSKOBJ of DEV)
\MAINDISK)
(\M44OPENFILEFROMFP DEV "DISKDESCRIPTOR.;1" (QUOTE BOTH)
(\CREATE.FID.FOR.DD DEV)))
(T (LET [(RESULT (\OPENFILE (CONCAT "{" (fetch (FDEV DEVICENAME)
of DEV)
"}" "DISKDESCRIPTOR.;1")
(QUOTE BOTH]
(\DELETE-OPEN-STREAM RESULT (fetch (STREAM DEVICE) of RESULT))
RESULT]
(replace (M44DEVICE DISKDESCRIPTOROFD) of DEV with STREAM)
(replace MAXBUFFERS of STREAM with (ADD1 (fetch EPAGE of STREAM)))
(* Prepare to buffer the whole file,
so that we don't get in trouble under
\NEWPAGE)
(for I from 0 to (fetch EPAGE of STREAM) do (\MAPPAGE I STREAM))
(* Ought to define a \MAPPAGES to do
that more efficiently)
(replace ENDOFSTREAMOP of STREAM with (FUNCTION NILL))
(replace (M44DEVICE DDVALID) of DEV with T)))
(fetch (M44DEVICE DISKDESCRIPTOROFD) of DEV])
(\READDIRFPTR
[LAMBDA (STREAM ENTRYSTART FPTR) (* bvm: "18-May-84 18:28")
(\SETFILEPTR STREAM (IPLUS ENTRYSTART 2))
(\BINS STREAM [fetch FIDBLOCK of (OR FPTR (SETQ FPTR (create FID]
0
(UNFOLD 5 BYTESPERWORD))
FPTR])
(\M44SEARCHDIR
[LAMBDA (STREAM TLIST HMIN) (* bvm: " 3-Apr-85 14:42")
(* Finds next directory entry for which TLIST::1 is a prefix of the filename. Returns NIL if no entry found, else
the length of the remaining chars in the entry. Leaves the directory positioned after the char matching the last
char of TLIST::1 -
STREAM is the ofd of the directory file -
TLIST is a list of the form (POS . NAMECHARS), where POS at entry is a fileptr in the directory file at which to
start searching and NAMECHARS is like the characters pairs of a uname. At exit, TLIST is smashed so that POS is the
fileptr just beyond the found entry. -
if HMIN~=NIL, sets STREAM's DIRHOLEPTR to NIL or the fileptr of the first hole of at least HMIN words.)
(PROG ((CASEBASE (.DISKCASEARRAY.))
(NEXT (CAR TLIST))
(NAMECHARS (CDR TLIST))
THISNAMELENGTH TARGETLENGTH PTR L TYP ENTRYLENGTH)
(COND
(HMIN (replace DIRHOLEPTR of STREAM with NIL)))
(SETQ TARGETLENGTH (LENGTH NAMECHARS))
NEXT(\SETFILEPTR STREAM (SETQ PTR NEXT))
(COND
((\EOFP STREAM)
(RETURN)))
(* * Format of a directory entry is -
Type (0 = hole, 1 = file), 6 bits -
Length of entry in words, 10 bits -
FP 5 words -
Name as a BcplString)
(SETQ TYP (\BIN STREAM))
(SETQ ENTRYLENGTH (IPLUS (LLSH (LOGAND TYP 3)
8)
(\BIN STREAM)))
(SETQ NEXT (IPLUS (UNFOLD ENTRYLENGTH BYTESPERWORD)
PTR))
(COND
((NEQ (LRSH TYP 2)
1) (* Not a file)
(COND
((AND HMIN (NOT (IGREATERP HMIN ENTRYLENGTH)))
(replace DIRHOLEPTR of STREAM with PTR)
(SETQ HMIN NIL)))
(GO NEXT)))
(\SETFILEPTR STREAM (IPLUS PTR 12))
(COND
((ILESSP (SETQ THISNAMELENGTH (\BIN STREAM))
TARGETLENGTH)
(GO NEXT)))
(SETQ L NAMECHARS)
READ(COND
((NULL L) (* Exhausted the pattern before finding a mismatch, so
take it)
(RPLACA TLIST NEXT)
(RETURN (IDIFFERENCE THISNAMELENGTH TARGETLENGTH)))
((EQ (\GETBASEBYTE CASEBASE (\BIN STREAM))
(CAR L))
(SETQ L (CDR L))
(GO READ))
(T (GO NEXT])
(\M44UNPACKFILENAME
[LAMBDA (NAME DEV CREATEFLG) (* bvm: " 3-Apr-85 14:57")
(* Unpacks file name into a UNAME whose VERSION is the version indicator (either a positive integer or one of OLD,
OLDEST, NEW); PARTNAME is the name of DEV. UCASECHARS is a list of uppercase charcodes from the name.
If CREATEFLG is true, also sets ORIGCHARS to be list of original char codes, for sake of setting real file name)
(PROG ((CASEBASE (.DISKCASEARRAY.))
J C UPC END ORIGEND VERSION RESULT)
(COND
([OR (NOT NAME)
(EQ NAME T)
(NOT (OR (LITATOM NAME)
(STRINGP NAME)))
(NEQ (NTHCHARCODE NAME 1)
(CHARCODE {))
(NOT (SETQ J (STRPOS "}" NAME 5]
(RETURN)))
[SETQ END (fetch UCASECHARHEAD of (SETQ RESULT (create UNAME
PARTNAME ←(fetch DEVICENAME
of DEV]
(* End is the cell whose CDR can be smashed.)
(SETQ ORIGEND (fetch ORIGCHARHEAD of RESULT))
(add J 1)
[COND
((EQ (NTHCHARCODE NAME J)
(CHARCODE <)) (* if directory name is included, generate file not
found error. If not, return NIL which will cause bad
file name error.)
(RETURN (COND
((STRPOS ">" NAME) (* pass back special error code.)
(QUOTE DIRECTORY]
COLLECTNAME
(COND
((NOT (SETQ C (NTHCHARCODE NAME J))) (* End of name)
(GO RET))
((EQ (SETQ UPC (\GETBASEBYTE CASEBASE C))
0) (* Illegal char)
(GO ERR))
(T [RPLACD END (SETQ END (LIST (SELCHARQ UPC
(; (GO SEMI))
((# *)
(* Wildcards not allowed)
(GO ERR))
(%. (* Omit trailing dots)
(SELCHARQ (NTHCHARCODE NAME (ADD1 J))
(NIL (GO RET))
((; !)
(add J 1)
(GO SEMI))
UPC))
UPC]
[COND
(CREATEFLG (* Save orig chars as well)
(RPLACD ORIGEND (SETQ ORIGEND (LIST C]
(add J 1)
(GO COLLECTNAME)))
(* * Parsing the stuff after the semicolon; loop to catch all the funny forms that could be after that instead of a
version. Perhaps should get rid of some of these, since no other device tolerates them)
SEMI(COND
([NULL (SETQ C (NTHCHARCODE NAME (add J 1]
(GO ERR))
((EQ (SETQ C (\GETBASEBYTE CASEBASE C))
0) (* Illegal char)
(GO ERR)))
[SELCHARQ C
(H (SETQQ VERSION OLD)
(SELCHARQ (SETQ C (NTHCHARCODE NAME (add J 1)))
(NIL (GO RET))
((; !)
(GO SEMI))
(GO ERR)))
(L (SETQQ VERSION OLDEST)
(SELCHARQ (SETQ C (NTHCHARCODE NAME (add J 1)))
(NIL (GO RET))
((; !)
(GO SEMI))
(GO ERR)))
(N (SETQQ VERSION NEW)
(SELCHARQ (SETQ C (NTHCHARCODE NAME (add J 1)))
(NIL (GO RET))
((; !)
(GO SEMI))
(GO ERR)))
(COND
(VERSION (GO ERR))
(T (SETQ VERSION 0)
(GO COLLECTVERSION]
COLLECTVERSION
(COND
((AND C (BETWEEN C (CHARCODE 0)
(CHARCODE 9)))
[SETQ VERSION (IPLUS (ITIMES VERSION 10)
(IDIFFERENCE C (CHARCODE 0]
(SETQ C (NTHCHARCODE NAME (add J 1)))
(GO COLLECTVERSION)))
(COND
((EQ VERSION 0)
(SETQQ VERSION OLD))
((IGREATERP VERSION 65535)
(GO ERR)))
TERM(SELCHARQ C
(NIL (GO RET))
((; !)
(GO SEMI))
(GO ERR))
ERR (* BAD FILE NAME)
(RETURN NIL)
RET (replace VERSION of RESULT with VERSION)
(RETURN RESULT])
)
(RPAQQ \FILENAMECHARSLST (36 43 45 46))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \FILENAMECHARSLST)
)
(DECLARE: DONTCOPY
[DECLARE: EVAL@COMPILE
(RECORD UNAME (VERSION . UCASECHARHEAD)
(RECORD UCASECHARHEAD (ORIGCHARHEAD . UCASECHARS)
(RECORD ORIGCHARHEAD (PARTNAME . ORIGCHARS))))
(RECORD FILESPEC (UNAME FSDIRPTR)
[ACCESSFNS FILESPEC ((PNAME (\M44PACKFILENAME (fetch UNAME of DATUM])
(RECORD M44GENFILESTATE (DIROFD SEARCHSTATE GENFILTER GENVERSION HOSTNAME GENSTREAM ENTRYSTART))
(RECORD M44DIRSEARCHSTATE (DIRPTR . CHARLIST))
]
(DECLARE: EVAL@COMPILE
[PUTPROPS BETWEEN MACRO (OPENLAMBDA (V LO HI)
(AND (IGEQ V LO)
(ILEQ V HI]
)
)
(DEFINEQ
(\CREATE.FID.FOR.DD
[LAMBDA (FDEV) (* bvm: "25-MAY-83 12:16")
(* Creates a FID for the file DISKDESCRIPTOR on FDEV,
which must be the default disk partition's device)
(PROG ((FID (create FID)))
(* Currently \SYSDISK has a copy of the diskdescriptor fp inside it, as looked up by alto at beginning of world,
so be lazy and use that)
(\BLT (fetch FIDBLOCK of FID)
(LOCF (fetch (M44DEVICE DSKDDBLK) of FDEV))
\LENFP)
(RETURN FID])
(\OPENDISK
[LAMBDA (PARTNUM FDEV) (* bvm: "20-Nov-84 16:02")
(PROG (DSK DD)
(OR (\TESTPARTITION PARTNUM)
(RETURN))
(SETQ DSK (create DSKOBJ))
(\LOCKWORDS DSK \NWORDS.DSKOBJ)
(replace DSKPARTITION of DSK with PARTNUM)
(replace ddPOINTER of DSK with (LOCF (fetch ddLASTSERIAL# of DSK)))
(replace NDISKS of DSK with 2)
(replace NTRACKS of DSK with 406)
(replace NHEADS of DSK with 2)
(replace NSECTORS of DSK with 14)
(replace RETRYCOUNT of DSK with 8)
(replace CBQUEUE of DSK with (fetch CBQUEUE of \MAINDISK))
(* Really should have our own)
(RETURN (\OPENDISKDEVICE PARTNUM DSK FDEV])
(\OPENDISKDEVICE
[LAMBDA (PARTITION DSKOBJ FDEV) (* hdj "28-May-86 12:15")
(DECLARE (GLOBALVARS \MAINDISK)) (* Creates the model 44 DSK device and
opens its SYSDIR.)
(PROG ([NAME (PACK* (QUOTE DSK)
(OR PARTITION (DISKPARTITION]
FDEV)
[OR FDEV (SETQ FDEV (\MAKE.PMAP.DEVICE (create FDEV
DEVICENAME ← NAME
NODIRECTORIES ← T
CLOSEFILE ← (FUNCTION \M44CloseFile)
DELETEFILE ← (FUNCTION \M44DeleteFile)
GETFILEINFO ← (FUNCTION \M44GetFileInfo)
GETFILENAME ← (FUNCTION \M44GetFileName)
OPENFILE ← (FUNCTION \M44OpenFile)
READPAGES ← (FUNCTION \M44ReadPages)
SETFILEINFO ← (FUNCTION \M44SetFileInfo)
TRUNCATEFILE ← (FUNCTION \M44TruncateFile)
WRITEPAGES ← (FUNCTION \M44WritePages)
REOPENFILE ← (FUNCTION \M44OpenFile)
GENERATEFILES ← (FUNCTION \M44GENERATEFILES)
EVENTFN ← (FUNCTION \M44EVENTFN)
DIRECTORYNAMEP ← [FUNCTION (LAMBDA (NAME)
(* Assume host is OK, check that no
directory)
(EQ (NTHCHARCODE
NAME -1)
(CHARCODE
}]
HOSTNAMEP ← (FUNCTION NILL)
FREEPAGECOUNT ← (FUNCTION \M44FREEPAGECOUNT)
OPENP ← (FUNCTION \GENERIC.OPENP)
REGISTERFILE ← (FUNCTION \ADD-OPEN-STREAM]
(replace DSKOBJ of FDEV with (OR DSKOBJ (SETQ DSKOBJ \MAINDISK)))
(replace DISKDEVICENAME of DSKOBJ with NAME)
(RETURN (RESETLST (RESETSAVE NIL (LIST [FUNCTION (LAMBDA (DEV)
(COND
((NOT (fetch (M44DEVICE DSKPASSWORDOK
) of DEV))
(* Oops, it didn't work, take it away)
(\REMOVEDEVICE DEV]
FDEV))
(\DEFINEDEVICE NAME FDEV) (* have to define it tentatively first
so that \OPENDISKDESCRIPTOR will work)
(COND
((\OPENDIR FDEV)
(COND
((NULL PARTITION) (* this is also the default disk)
(\DEFINEDEVICE (QUOTE DSK)
FDEV)))
FDEV])
(\OPENDIR
[LAMBDA (FDEV) (* bvm: " 6-APR-83 12:16")
(* Opens the model44 directory on the current partition)
(PROG ((PART (fetch (M44DEVICE DSKPARTITION) of FDEV))
STREAM DD)
(replace (M44DEVICE DSKPASSWORDOK) of FDEV with NIL)
(COND
((AND (NEQ PART 0)
(NOT (\TESTPARTITION PART)))
(replace (M44DEVICE SYSDIROFD) of FDEV with NIL)
(RETURN)))
(SETQ STREAM
(\M44OPENFILEFROMFP FDEV "SYSDIR.;1" (QUOTE BOTH)
(create FID
W0 ← 100000Q
W1 ← 144Q
W2 ← 1
W3 ← 0
W4 ← 1))) (* {DSK}SYSDIR.;1 always has sn 100, leader page on
virtual page 1)
[replace MAXBUFFERS of STREAM with (IMAX 100Q (ADD1 (fetch EPAGE of STREAM]
(* Enough buffers so that directory is effectively
always in core)
(replace (M44DEVICE SYSDIROFD) of FDEV with STREAM)
[COND
((NEQ PART 0)
(SETQ DD (\OPENDISKDESCRIPTOR FDEV))
(\SETFILEPTR DD \OFFSET.DISKLASTSERIAL#)
(\BINS DD (LOCF (fetch (M44DEVICE DISKLASTSERIAL#) of FDEV))
0 \NBYTES.DISKINFO)
(add (fetch (M44DEVICE DISKLASTSERIAL#) of FDEV)
3) (* Try to avoid collisions)
(COND
((NOT (\M44CHECKPASSWORD FDEV))
(replace (M44DEVICE SYSDIROFD) of FDEV with NIL)
(RETURN]
(replace (M44DEVICE DSKPASSWORDOK) of FDEV with T)
(RETURN STREAM])
(\M44CHECKPASSWORD
[LAMBDA (DEV) (* hdj " 5-Jun-86 22:56")
(PROG ((STREAM (\OPENFILE (PACK* (QUOTE {)
(fetch (FDEV DEVICENAME) of DEV)
"}SYS.BOOT;1")
(QUOTE INPUT)
(QUOTE OLD)))
PASSVECTOR BUF PASSINFO ASKEDONCE NAME N)
(\DELETE-OPEN-STREAM STREAM DEV)
(COND
((NULL STREAM)
(RETURN T)))
(SETQ PASSVECTOR (\ALLOCBLOCK (FOLDHI \NWORDS.BCPLPASSWORD WORDSPERCELL)))
(SETFILEPTR STREAM \OFFSET.BCPLPASSWORD)
(\BINS STREAM PASSVECTOR 0 (UNFOLD \NWORDS.BCPLPASSWORD BYTESPERWORD))
(COND
((EQ (\GETBASE PASSVECTOR 0)
0) (* No password)
(\CLOSEFILE STREAM)
(RETURN T)))
(SETFILEPTR STREAM \OFFSET.BCPLUSERNAME)
[SETQ NAME (ALLOCSTRING (SETQ N (\BIN STREAM] (* Read in a bcpl string which is the
username installed on the disk)
(\BINS STREAM (fetch (STRINGP BASE) of NAME)
0 N)
(\CLOSEFILE STREAM)
(SETQ NAME (MKATOM NAME))
LP (SETQ PASSINFO (\INTERNAL/GETPASSWORD (fetch (FDEV DEVICENAME) of DEV)
ASKEDONCE NIL NIL NAME))
(COND
((NULL PASSINFO)
(RETURN NIL)))
(COND
((UNINTERRUPTABLY
(SETQ BUF (\GETPACKETBUFFER)) (* HORRIBLE CHEAP TRICK to get some
emulator space)
(\BLT (\ADDBASE BUF 64)
PASSVECTOR \NWORDS.BCPLPASSWORD)
(SetBcplString (\ADDBASE BUF (IPLUS 64 \NWORDS.BCPLPASSWORD))
(\DECRYPT.PWD (CDR PASSINFO)))
(\CHECKBCPLPASSWORD (\ADDBASE BUF (IPLUS 64 \NWORDS.BCPLPASSWORD))
(\ADDBASE BUF 64)))
(RETURN T))
(T (SETQ ASKEDONCE T)
(GO LP])
(\M44HOSTNAMEP
[LAMBDA (NAME DEV) (* bvm: "20-Nov-84 16:06")
(PROG (PARTNUM)
(RETURN (COND
((EQ NAME (QUOTE DSK))
(\OPENDISKDEVICE))
((AND (STRPOS (QUOTE DSK)
NAME 1 NIL T)
(SETQ PARTNUM (FIXP (SUBATOM NAME 4)))
(\TESTPARTITION PARTNUM))
(COND
[(EQ PARTNUM (DISKPARTITION))
(RETURN (\GETDEVICEFROMNAME (QUOTE DSK]
(T (\OPENDISK PARTNUM])
)
(DECLARE: DONTCOPY
(DECLARE: EVAL@COMPILE
(RPAQQ \OFFSET.BCPLUSERNAME 512)
(RPAQQ \OFFSET.BCPLPASSWORD 768)
(RPAQQ \NWORDS.BCPLPASSWORD 9)
(CONSTANTS \OFFSET.BCPLUSERNAME \OFFSET.BCPLPASSWORD \NWORDS.BCPLPASSWORD)
)
)
(* SYSOUT etc)
(DEFINEQ
(\COPYSYS
[LAMBDA (FILE SYSNAME DONTSAVE) (* hdj "22-May-86 16:16")
(DECLARE (GLOBALVARS SYSOUTCURSOR))
(RESETLST
(RESETSAVE \VMEM.INHIBIT.WRITE T) (* Prevent dirty pages from being
written after the \FLUSHVM)
(PROG (FULL-NAME STREAM VAL LASTPAGE)
RETRY
(RECLAIM)
(RETURN (COND
([NULL (SETQ VAL
(OR (AND (NOT DONTSAVE)
(\FLUSHVM))
(PROGN (SETQ LASTPAGE (fetch (IFPAGE NActivePages) of
\InterfacePage
))
(* Note length of sysout now, because
NActivePages can grow as we prepare to
write the sysout)
[SETQ STREAM (OPENSTREAM FILE (QUOTE OUTPUT)
(QUOTE NEW)
NIL
(CONS (LIST (QUOTE LENGTH)
(UNFOLD LASTPAGE
BYTESPERPAGE))
(QUOTE ((SEQUENTIAL T)
(TYPE BINARY]
(SETQ FULL-NAME (fetch (STREAM FULLNAME) of STREAM))
(RESETSAVE NIL (LIST [FUNCTION (LAMBDA (FILE)
(CLOSEF FILE)
(AND
RESETSTATE
(DELFILE
(fetch (STREAM FULLNAME)
of FILE]
STREAM))
(COND
(SYSNAME (SET SYSNAME FULL-NAME)))
[RESETSAVE (CURSOR (COND
((type? CURSOR SYSOUTCURSOR)
(* Comes from a later file)
SYSOUTCURSOR)
(T T]
(RESETSAVE IDLE.PROFILE NIL)
(* Disable idler)
(\COPYSYS1 STREAM LASTPAGE]
(* First is T when resuming this vmem; second is starting the sysout.
If \COPYSYS1 did not itself do a \FLUSHVM, the second would never return T,
yes? NIL is normal return, <fixp> is error return)
(* Continuing in the current image)
(\DAYTIME0 \LASTUSERACTION)
FULL-NAME)
((AND (SMALLP VAL)
(IGREATERP 0 VAL)) (* Error occurred while making sysout.)
(LISPERROR (IMINUS VAL)
FULL-NAME)
(GO RETRY))
(T (* Starting sysout)
(\CLEARSYSBUF T)
(\RESETKEYBOARD)
(LIST FULL-NAME])
(\COPYSYS1
[LAMBDA (STREAM LASTPAGE) (* mpl "14-Aug-85 13:42")
(COND
[(AND (type? M44DEVICE (fetch DEVICE of STREAM))
(EQ (fetch DEVICENAME of (fetch DEVICE of STREAM))
(QUOTE DSK))) (* Haven't quite worked out the buffer strategy yet)
(\M44FLUSHDISKDESCRIPTOR (fetch DEVICE of STREAM))
(replace DDVALID of (fetch DEVICE of STREAM) with NIL)
(PROG1 (\COPYSYS0SUBR (fetch (ARRAYP BASE) of (fetch FID of STREAM)))
(replace LastPage of STREAM with (replace EPAGE of STREAM with (fetch (IFPAGE
NActivePages)
of \InterfacePage)))
(replace LastOffset of STREAM with (replace EOFFSET of STREAM with 0]
(T (PROG ((PAGEMAPPED (fetch PAGEMAPPED of (fetch DEVICE of STREAM)))
(NBUFS (SUB1 \#EMUBUFFERS))
(BUFBASE \EMUBUFFERS)
(FIRSTPAGE 2)
(CURSORBAR \EM.CURSORBITMAP)
(CURSORMASK (LLSH 1 (SUB1 BITSPERWORD)))
(DOMINOPAGE (fetch LastDominoFilePage of \InterfacePage))
CURSORINC CURSORNEXT LASTPAGESEEN NPAGES BUFFERS DAS)
(* * Strategy is to copy from the vmem file to STREAM -
The vmem file is read with \DL.ACTONVMEMFILE on DLion, \ACTONDISKPAGES on Dolphin and Dorado where we know more.
As buffers we use the set of pre-allocated swap buffers, reducing the number available for swapping to a bare
minimum of one. If STREAM is pagemapped, we take advantage of knowledge of pagemapped streams to write these buffers
directly to the destination stream, which saves the copying that would occur if we just generically used \BOUTS for
all streams. In the case of Mod44 DSK, this also lets us use more buffers at a time, because DSK can write directly
from the buffers we use for reading the vmem, rather than copying into its own buffers)
(RESETSAVE \#SWAPBUFFERS 1) (* Reduce us to one swap buffer, so we can use the rest
for copying the vmem)
(RESETSAVE \EMUSWAPBUFFERS (\ADDBASE BUFBASE (UNFOLD NBUFS WORDSPERPAGE)))
(RESETSAVE \#DISKBUFFERS (COND
((type? M44DEVICE (fetch DEVICE of STREAM))
(* DSK code needs 1 extra buffer beyond the ones we
give to \WRITEPAGES)
(SETQ NBUFS (SUB1 NBUFS))
(SETQ BUFBASE (\ADDBASE BUFBASE WORDSPERPAGE))
1)
(T 0)))
(SETQ DAS (ARRAY (IPLUS NBUFS 2)
(QUOTE WORD)
NIL 0))
(SETQ BUFFERS (to NBUFS as (BUF ← BUFBASE) by (\ADDBASE BUF WORDSPERPAGE)
collect BUF))
[SETQ CURSORINC (SETQ CURSORNEXT (FOLDLO LASTPAGE (ITIMES 16 16]
(* How often to do something to the cursor)
(COND
((EQ DOMINOPAGE 0) (* First page to write is the ISF map page, which
should be blank in a sysout)
(\CLEARWORDS BUFBASE WORDSPERPAGE)
(SETA DAS 1 (fetch ISFDA2 of \ISFMAP)))
((EQ \MACHINETYPE \DANDELION)
(\DL.ACTONVMEMFILE DOMINOPAGE BUFBASE 1))
((EQ \MACHINETYPE \DAYBREAK)
(\DOVE.ACTONVMEMFILE DOMINOPAGE BUFBASE 1))
(T (SETA DAS 1 (\LOOKUPFMAP DOMINOPAGE)) (* Copy the first domino page, stashed at the end of
the Domino area, into page 1 for a good Dandelion boot
image)
(\ACTONDISKPAGES \MAINDISK BUFBASE (fetch (ARRAYP BASE) of DAS)
(SUB1 DOMINOPAGE)
\ISFMAP DOMINOPAGE DOMINOPAGE \DC.READD)
(SETA DAS 1 (fetch ISFDA2 of \ISFMAP)) (* Prepare DAS to start reading at page 2)
))
(COND
(PAGEMAPPED (replace EPAGE of STREAM with LASTPAGE)
(* Set up end of file correctly.
LASTPAGE is last alto page (full), which is last Lisp
page plus 1)
(replace EOFFSET of STREAM with 0)
(\WRITEPAGES STREAM 0 (CAR BUFFERS)))
(T (\BOUTS STREAM (CAR BUFFERS)
0 BYTESPERPAGE)))
(while (ILEQ FIRSTPAGE LASTPAGE)
do [COND
((IGEQ FIRSTPAGE CURSORNEXT) (* Gradually complement the cursor)
(\PUTBASE CURSORBAR 0 (LOGXOR (\GETBASE CURSORBAR 0)
CURSORMASK))
(COND
((EQ \MACHINETYPE \DAYBREAK)
(\DoveDisplay.SetCursorShape)))
(add CURSORNEXT CURSORINC)
(COND
((EQ (SETQ CURSORMASK (LRSH CURSORMASK 1))
0)
(SETQ CURSORBAR (\ADDBASE CURSORBAR 1))
(SETQ CURSORMASK (LLSH 1 (SUB1 BITSPERWORD]
[COND
((EQ \MACHINETYPE \DANDELION)
[\DL.ACTONVMEMFILE FIRSTPAGE BUFBASE (SETQ NPAGES
(IMIN NBUFS (ADD1 (IDIFFERENCE LASTPAGE FIRSTPAGE]
(SETQ LASTPAGESEEN (IPLUS FIRSTPAGE NPAGES -1)))
((EQ \MACHINETYPE \DAYBREAK)
[\DOVE.ACTONVMEMFILE FIRSTPAGE BUFBASE (SETQ NPAGES
(IMIN NBUFS (ADD1 (IDIFFERENCE LASTPAGE FIRSTPAGE]
(SETQ LASTPAGESEEN (IPLUS FIRSTPAGE NPAGES -1)))
(T (for I from 2 to (ADD1 NBUFS) do (SETA DAS I \FILLINDA))
(SETQ LASTPAGESEEN (\ACTONDISKPAGES \MAINDISK BUFFERS (fetch (ARRAYP BASE)
of DAS)
(SUB1 FIRSTPAGE)
\ISFMAP FIRSTPAGE
(IMIN (IPLUS FIRSTPAGE NBUFS -1)
LASTPAGE)
\DC.READD))
(SETQ NPAGES (ADD1 (IDIFFERENCE LASTPAGESEEN FIRSTPAGE)))
(SETA DAS 1 (ELT DAS (ADD1 NPAGES]
(* Read NBUFS pages from vmem)
[COND
((NOT PAGEMAPPED) (* Have to just ship the bits)
(\BOUTS STREAM BUFBASE 0 (UNFOLD NPAGES BYTESPERPAGE)))
(T (\WRITEPAGES STREAM (SUB1 FIRSTPAGE)
(COND
((ILESSP LASTPAGESEEN LASTPAGE)
BUFFERS)
(T (* Don't write too many pages on the last pass if
NPAGES is less than length of BUFFERS)
(to NPAGES as BUF in BUFFERS collect BUF]
(* Write them to output)
(SETQ FIRSTPAGE (ADD1 LASTPAGESEEN)))
(RETURN NIL])
)
(* Stats code. On MOD44IO because it writes on the disk and uses records not exported from
MOD44IO)
(DEFINEQ
(GATHERSTATS
[LAMBDA (FILENAME) (* bvm: "16-May-84 12:38")
(* Enables and disables statistics gathering. Uses low level file operations to avoid stats file being visible
from Lisp b/c the file position is not updated as it is written)
(DECLARE (GLOBALVARS \STATSON))
(COND
((EQ \MACHINETYPE \DANDELION)
(ERROR "Stats not implemented for this type of machine" FILENAME))
[FILENAME (AND \STATSON (GATHERSTATS))
(SELECTQ (FILENAMEFIELD FILENAME (QUOTE HOST))
(DSK)
(NIL (SETQ FILENAME (PACKFILENAME (QUOTE HOST)
(QUOTE DSK)
(QUOTE BODY)
FILENAME)))
(ERROR "Stats file must be on DSK" FILENAME))
(SETQ \STATSON T)
(\GATHERSTATS (PROG [(STREAM (\OPENFILE FILENAME (QUOTE OUTPUT)
(QUOTE NEW]
(* CLose before doing stats, cause file isn't really
open from Lisp's point of view.)
(RETURN (fetch (ARRAYP BASE)
of (fetch FID
of (PROG1 STREAM (\CLOSEFILE STREAM)
(\M44FLUSHDISKDESCRIPTOR (fetch DEVICE
of STREAM))
(replace DDVALID
of (fetch DEVICE of STREAM)
with NIL]
(\STATSON (\GATHERSTATS)
(SETQ \STATSON NIL])
)
(RPAQQ \STATSON NIL)
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
(FILESLOAD (LOADCOMP)
LLBFS)
)
(PUTPROPS MOD44IO COPYRIGHT ("Xerox Corporation" 1981 1982 1983 1984 1985 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (3075 49766 (\M44AddDiskPages 3085 . 4066) (\M44CloseFile 4068 . 4649) (\M44CompleteFH
4651 . 7633) (\M44CREATEFILE 7635 . 11574) (\M44DeleteFile 11576 . 12618) (\M44EVENTFN 12620 . 17569)
(\M44ExtendFilePageMap 17571 . 18994) (\M44FillInMap 18996 . 20724) (\M44GetFileHandle 20726 . 22243)
(\M44GetFileInfo 22245 . 24548) (\M44GETDATEPROP 24550 . 25150) (\M44GetFileName 25152 . 25333) (
\M44GetPageLoc 25335 . 26047) (\M44KillFilePageMap 26049 . 26379) (\M44MAKEDIRENTRY 26381 . 28018) (
\M44OpenFile 28020 . 33084) (\M44OPENFILEFROMFP 33086 . 34052) (\M44ReadDiskPage 34054 . 35663) (
\M44ReadLeaderPage 35665 . 36927) (\M44ReadPages 36929 . 37260) (\M44SetAccessTimes 37262 . 38273) (
\M44SetEndOfFile 38275 . 39208) (\M44SetFileInfo 39210 . 39978) (\M44SETFILETYPE 39980 . 41687) (
\M44TruncateFile 41689 . 42939) (\M44WriteDiskPage 42941 . 45121) (\M44WriteLeaderPage 45123 . 45675)
(\M44WritePages 45677 . 47565) (\M44WritePages1 47567 . 49764)) (49767 61124 (\ADDDISKPAGES 49777 .
51105) (\M44DELETEPAGES 51107 . 53955) (\ASSIGNDISKPAGE 53957 . 56455) (\COUNTDISKFREEPAGES 56457 .
57287) (\M44MARKPAGEFREE 57289 . 58379) (\M44FLUSHDISKDESCRIPTOR 58381 . 59149) (\MAKELEADERDAS 59151
. 59763) (DISKFREEPAGES 59765 . 60318) (\M44FREEPAGECOUNT 60320 . 60954) (VMEMSIZE 60956 . 61122)) (
63911 76703 (\M44GENERATEFILES 63921 . 68205) (\M44SORTFILES 68207 . 68732) (\M44GENERATENEXT 68734 .
73032) (\M44NEXTFILEFN 73034 . 74121) (\M44SORTEDNEXTFILEFN 74123 . 75753) (\M44FILEINFOFN 75755 .
76701)) (76742 94270 (\M44PARSEFILENAME 76752 . 79058) (\FINDDIRHOLE 79060 . 80361) (\M44PACKFILENAME
80363 . 81009) (\M44LOOKUPVERSIONS 81011 . 83849) (\M44READVERSION 83851 . 84447) (\OPENDISKDESCRIPTOR
84449 . 86874) (\READDIRFPTR 86876 . 87159) (\M44SEARCHDIR 87161 . 89771) (\M44UNPACKFILENAME 89773
. 94268)) (95067 105377 (\CREATE.FID.FOR.DD 95077 . 95713) (\OPENDISK 95715 . 96688) (\OPENDISKDEVICE
96690 . 100814) (\OPENDIR 100816 . 102572) (\M44CHECKPASSWORD 102574 . 104837) (\M44HOSTNAMEP 104839
. 105375)) (105637 116814 (\COPYSYS 105647 . 109952) (\COPYSYS1 109954 . 116812)) (116924 118329 (
GATHERSTATS 116934 . 118327)))))
STOP