(FILECREATED "10-Dec-84 16:21:31" {ERIS}<LISP>HARMONY>SOURCES>MOD44IO.;4 106919
changes to: (FNS \COPYSYS1)
previous date: "17-Nov-84 15:09:02" {ERIS}<LISP>HARMONY>SOURCES>MOD44IO.;3)
(* Copyright (c) 1981, 1982, 1983, 1984 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 \CREATE.FID.FOR.DD \OPENDISK DISKFREEPAGES
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 \LOOKUPVERSIONS \M44READVERSION
\OPENDISKDESCRIPTOR \READDIRFPTR \SEARCHDIR1 \M44UNPACKFILENAME)
(FNS ALTOFILENAME)
(VARS \FILENAMECHARSLST)
(GLOBALVARS \FILENAMECHARSLST)
(DECLARE: DONTCOPY (RECORDS UNAME FILESPEC M44GENFILESTATE M44DIRSEARCHSTATE)
(MACROS BETWEEN)))
[COMS (FNS \VANILLADISKINIT \OPENDISKDEVICE \OPENDIR \M44CHECKPASSWORD \M44HOSTNAMEP)
(DECLARE: DONTCOPY (CONSTANTS \OFFSET.BCPLUSERNAME \OFFSET.BCPLPASSWORD
\NWORDS.BCPLPASSWORD))
(DECLARE: DONTEVAL@LOAD DOCOPY (P (\VANILLADISKINIT)
(OR (BOUNDP (QUOTE \CONNECTED.DIR))
(CNDIR]
(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) (* bvm: " 8-Jun-84 14:50")
(\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]
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: " 5-Jun-84 14:30")
(* 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 CHARPAIRS 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) (* bvm: "18-May-84 11:07")
(* Delete a Model44 file.)
(PROG ((STREAM (\M44GetFileHandle FILENAME (QUOTE OLDEST)
DEV T)))
(COND
((OR (NOT STREAM)
(bind (NAME ←(fetch FULLFILENAME of STREAM)) find ST in \OPENFILES
suchthat (EQ (fetch FULLFILENAME of ST)
NAME))) (* 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) (* bvm: "22-Jun-84 12:14")
(DECLARE (GLOBALVARS \OPENFILES))
(SELECTQ EVENT
[(AFTERLOGOUT AFTERSYSOUT AFTERMAKESYS AFTERSAVEVM)
(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)
(OR (EQ (fetch DEVICENAME of FDEV)
(QUOTE DSK))
(for STREAM in \OPENFILES thereis (EQ (fetch DEVICE of STREAM)
FDEV]
(\OPENDIR 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]
(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: "18-May-84 15:56")
(* Creates a STREAM for dsk file NAME. I 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 DIROFD)))
(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: "28-May-84 17:17")
(* 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))
NIL)))
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: "18-May-84 15:56")
(fetch PNAME of (\M44PARSEFILENAME NAME RECOG (fetch (M44DEVICE SYSDIROFD) of 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: " 5-Jun-84 14:32")
(* 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 CHARPAIRS 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) (* bvm: " 7-Jun-84 14:49")
(* Open a Model44 file. Gets the physical end of file
and sets up ofd)
(PROG (PAGESTIMATE STREAM CRDATE TYPE DON'T.CHANGE.DATE X)
[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) (* bvm: "17-May-84 10:21")
(* Opens a disk file given its FP)
(PROG ((STREAM (create M44STREAM)))
(replace FULLFILENAME of STREAM with (SETQ NAME (PACK* (QUOTE {)
(fetch 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)
(RETURN (\OPENFILE STREAM ACCESS])
(\M44ReadDiskPage
[LAMBDA (STREAM PAGENO BUF) (* bvm: " 7-OCT-83 17:29")
(* 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)))
(ZEROP (fetch EOFFSET of STREAM] (* Asking for page after eof.
PMAP system really ought to catch this itself)
(\ZEROWORDS BUF (\ADDBASE BUF (SUB1 WordsPerPage)))
0)
(T (PROG ((PAGEADDR (\M44GetPageLoc STREAM PAGENO))
(BFSPG# (ADD1 PAGENO)))
(RETURN (COND
((EQ PAGEADDR \EOFDA) (* no bytes read, fill with zeroes.)
(\ZEROWORDS BUF (\ADDBASE BUF (SUB1 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: "27-May-84 22:25")
(* 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)
(\ILLEGAL.ARG TYPE)))
(BUF (\M44ReadLeaderPage STREAM))
PTR TOTALLENGTH)
(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: " 3-JAN-83 14:51")
(* * 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 (ZEROP (LOGAND BITS MASK))
(ZEROP (SETQ MASK (LRSH MASK 1]
do (add A 1))
(COND
((NOT (ZEROP MASK)) (* 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
((ZEROP (SETQ FREE (fetch DISKFREEPAGES
of DSK)))
(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: " 3-JAN-83 12:25")
(* * 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
((ZEROP (LOGAND BITS MASK))
(add CNT 1)))
until (ZEROP (SETQ MASK (LRSH MASK 1]
(GO LP])
(\M44MARKPAGEFREE
[LAMBDA (DEV DA) (* bvm: "16-DEC-82 13:02")
(* Mark disk address DA on disk device DEV free)
(PROG ([DD (COND
((fetch (M44DEVICE DDVALID) of DEV)
(fetch (M44DEVICE DISKDESCRIPTOROFD) of DEV))
(T (\OPENDISKDESCRIPTOR DEV]
BITS MASK)
(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 (M44DEVICE DISKFREEPAGES) of DEV)
1)
(replace (M44DEVICE DDDIRTY) of DEV 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])
(\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) (* bvm: " 5-APR-83 13:42")
(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])
(DISKFREEPAGES
[LAMBDA (DSK RECOMPUTE) (* bvm: " 8-Jan-84 18:02")
(* DSK ignored for now)
(SELECTC \MACHINETYPE
(\DANDELION (* Temporary until this become a device op)
(\DFSFreeDiskPages (OR DSK (QUOTE DSK))
RECOMPUTE))
(PROG ((DEV (COND
((LITATOM DSK)
(\GETDEVICEFROMNAME (OR DSK (QUOTE DSK))
T))
(T DSK)))
CNT)
(COND
((NOT (type? M44DEVICE DEV))
(\ILLEGAL.ARG DSK)))
(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: "17-Nov-84 15:04")
(* 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))
(CASEBASE (.DISKCASEARRAY.))
HOSTNAME NAME EXT 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 (SETQ VERSION (MKATOM (CADR TAIL)))
(COND
((AND (NEQ VERSION 0)
(SMALLP VERSION))
(* An actual specific version to look for)
(SETQ DESIREDVERSION VERSION]
(RETURN T))) (* Bad file name)
(RETURN (\NULLFILEGENERATOR]
[SETQ FILTER (DIRECTORY.MATCH.SETUP (CONCATLIST (CONS NAME
(NCONC (AND EXT (LIST (QUOTE %.)
EXT))
(AND VERSION
(LIST (QUOTE ;)
VERSION]
(SETQ CHARLIST (for C instring (COND
((OR (NULL 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
((EQMEMB (QUOTE SORT)
OPTIONS) (* 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))
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: " 7-Jun-84 14:38")
(* * 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 ((SAWDOT (MEMB (CHARCODE %.)
(fetch CHARLIST of SEARCHSTATE)))
ENTRYSTART TEMP PREFIXLEN TOTALLEN THISVERSION RESULT INDEX)
LP (RETURN (COND
((SETQ TEMP (\SEARCHDIR1 DIRSTREAM SEARCHSTATE))
(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))
(* 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 %.)))
[COND
(HOSTPREFIX (\RPLCHARCODE RESULT (add INDEX 1)
(CHARCODE ;))
(to (SUB1 I)
do (\RPLCHARCODE RESULT (add INDEX 1)
(COND
(GENFILESTATE
(\BIN DIRSTREAM))
(T
(* Make everything look like version 1 for benefit of
SORT. Will replace with real thing later)
(CHARCODE 1]
(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)))
(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: " 7-Jun-84 14:42")
(PROG ((X (pop (fetch SEARCHSTATE of GENFILESTATE)))
V LEN)
(RETURN (COND
(X [COND
((NEQ (SETQ V (CADR X))
1) (* need to fill in the correct version number, since the
names were generated with constant version number)
(SETQ LEN (NCHARS (CAR X)))
(COND
[(ILESSP V 10) (* Easy, 1-digit version)
(\RPLCHARCODE (CAR X)
LEN
(PLUS V (CHARCODE 0]
(T (SETQ V (CHCON V))
(for C in V as I from (ADD1 (IDIFFERENCE LEN (LENGTH V)))
do (\RPLCHARCODE (CAR X)
I C]
(replace DIRINFO of (fetch GENSTREAM of GENFILESTATE) with NIL)
(replace ENTRYSTART of GENFILESTATE with (CADDR X))
(CAR X])
(\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 DIROFD) (* bvm: " 5-Jun-84 15:06")
(* 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 (DP V L (UNAME (\M44UNPACKFILENAME X)))
[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 (\LOOKUPVERSIONS UNAME DIROFD (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: " 4-Jun-84 22:17")
(* Produces a Lisp style file-name of the form
"name.[ext];ver")
(AND (fetch VERSION of UNAME)
(PACK* (COND
((fetch PARTNUM of UNAME)
(PACK* "{DSK" (fetch PARTNUM of UNAME)
"}"))
(T "{DSK}"))
(PACKC (APPEND (fetch CHARPAIRS of UNAME)
[COND
((MEMB (CHARCODE %.)
(fetch CHARPAIRS of UNAME))
(CHARCODE (;)))
(T (CHARCODE (%. ;]
(fetch VERSION of UNAME])
(\LOOKUPVERSIONS
[LAMBDA (UNAME STREAM HMIN) (* bvm: " 5-Jun-84 16:40")
(* 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 CHARPAIRS of UNAME]
(TLIST (CONS 0 (fetch CHARPAIRS 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 (\SEARCHDIR1 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) (* bvm: "25-MAY-83 12:16")
(* 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 (\OPENFILE (PACK* (QUOTE {)
(fetch DEVICENAME of DEV)
(QUOTE })
"DISKDESCRIPTOR.;1")
(QUOTE BOTH]
(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])
(\SEARCHDIR1
[LAMBDA (STREAM TLIST HMIN) (* bvm: " 4-Jun-84 17:43")
(* 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) (* bvm: "17-Nov-84 15:07")
(* Unpacks file name into a UNAME of the form ((VERSION PARTNUM . ESCFLAG) . CHARPAIRS) where VERSION is the version
indicator (either a positive integer or one of OLD, OLDEST, NEW) PARTNUM is the partion number
(NIL for current Partition) and ESCFLAG indicates that NAME terminated in escape, and the CHARPAIRS is a list of
pairs the first element of which is the char actually specified in name, and the second is the upper/lower case
alternative for alphabetics.)
(* changed to generate a file not found error in the
case that a directory is specified -
rrb.)
(PROG ((CASEBASE (.DISKCASEARRAY.))
J C END NEGATEDVERSION VERSION RESULT PARTNUM)
(COND
([OR (NOT NAME)
(EQ NAME T)
(NOT (OR (LITATOM NAME)
(STRINGP NAME)))
(NEQ (NTHCHARCODE NAME 1)
(CHARCODE {))
(NEQ (U-CASE (SUBATOM NAME 2 4))
(QUOTE DSK))
(NOT (SETQ J (STRPOS "}" NAME 5)))
(AND (NEQ J 5)
(NOT (FIXP (SETQ PARTNUM (SUBATOM NAME 5 (SUB1 J]
(RETURN)))
(SETQ END (SETQ RESULT (create UNAME
PARTNUM ← PARTNUM)))
(* End is the cell whose CDR can be smashed.)
(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))
((ZEROP (SETQ C (\GETBASEBYTE CASEBASE C))) (* Illegal char)
(GO ERR))
(T [RPLACD END (SETQ END (LIST (SELCHARQ C
(; (GO SEMI))
((# *)
(* Wildcards not allowed)
(GO ERR))
(%. (* Omit trailing dots)
(SELCHARQ (NTHCHARCODE NAME (ADD1 J))
(NIL (GO RET))
((; !)
(add J 1)
(GO SEMI))
C))
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))
((ZEROP (SETQ C (\GETBASEBYTE CASEBASE C))) (* 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)))
[(T S A P) (* Various Tenex crocks. Not implemented, but don't
complain about them)
(PROG NIL
SKIP(SELCHARQ (NTHCHARCODE NAME (add J 1))
((; !)
(GO SEMI))
(NIL (GO RET))
(GO SKIP]
[- (COND
(VERSION (GO ERR))
(T (SETQ NEGATEDVERSION T)
(SETQ VERSION 0)
(SETQ C (NTHCHARCODE NAME (add J 1)))
(GO COLLECTVERSION]
(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
[NEGATEDVERSION (SETQ VERSION (SELECTQ VERSION
(1 (QUOTE NEW))
(2 (QUOTE OLDEST))
(GO ERR]
((ZEROP VERSION)
(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])
)
(DEFINEQ
(ALTOFILENAME
[LAMBDA (X) (* rmk: "28-OCT-81 22:49")
(* Converts the lisp filename X to the equivalent
Alto-format filename.)
(PROG [(EXT (FILENAMEFIELD X (QUOTE EXTENSION]
(RETURN (CONCAT (FILENAMEFIELD X (QUOTE NAME))
(COND
((SETQ EXT (FILENAMEFIELD X (QUOTE EXTENSION)))
(CONCAT "." EXT))
(T ""))
(COND
([EQ 1 (SETQ X (FILENAMEFIELD X (QUOTE VERSION]
"")
(T (CONCAT "!" X])
)
(RPAQQ \FILENAMECHARSLST (36 43 45 46))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS \FILENAMECHARSLST)
)
(DECLARE: DONTCOPY
[DECLARE: EVAL@COMPILE
(RECORD UNAME ((VERSION PARTNUM . ESCFLAG) . CHARPAIRS))
(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
(\VANILLADISKINIT
[LAMBDA NIL (* hts: "16-Sep-84 20:47")
(PROG ((ARR (COPYARRAY UPPERCASEARRAY))) (* Set up array that maps illegal filename chars to 0
and synonymous characters to a canonical char)
(for I from 0 to (SUB1 (CHARCODE 0)) do (SETCASEARRAY ARR I 0))
(* Non-printing characters verboten)
(for I from (ADD1 (CHARCODE 9)) to (SUB1 (CHARCODE A)) do (SETCASEARRAY ARR I 0))
(for I from (ADD1 (CHARCODE Z)) to (SUB1 (CHARCODE a)) do (SETCASEARRAY ARR I 0))
(for I from (ADD1 (CHARCODE z)) to \MAXCHAR do (SETCASEARRAY ARR I 0))
(SETCASEARRAY ARR (CHARCODE ;)
(CHARCODE ;))
(SETCASEARRAY ARR (CHARCODE !)
(CHARCODE ;))
(SETCASEARRAY ARR (CHARCODE *)
(CHARCODE *))
(SETCASEARRAY ARR (CHARCODE ESCAPE)
(CHARCODE *))
(SETCASEARRAY ARR (CHARCODE ?)
(CHARCODE #))
(SETCASEARRAY ARR (CHARCODE %.)
(CHARCODE %.))
(SETCASEARRAY ARR (CHARCODE -)
(CHARCODE -))
(SETCASEARRAY ARR (CHARCODE +)
(CHARCODE +))
(SETCASEARRAY ARR (CHARCODE $)
(CHARCODE $))
(SETQ \DISKNAMECASEARRAY ARR)) (* Define a device whose sole purpose is to select the
appropriate DSK device depending on which machine
you're on)
(\DEFINEDEVICE NIL
(create
FDEV
DEVICENAME ← "VANILLADISK"
EVENTFN ←(FUNCTION NILL)
HOSTNAMEP ←(FUNCTION (LAMBDA (NAME)
(SELECTC \MACHINETYPE
[\DANDELION
(PROG (DEV)
(* If the dandelion local file system is capable of storing files, use it; else create a coredevice that will get
rid of itself on conditions where the dandelion local file system might have a chance)
(if (SETQ DEV (AND (GETD (QUOTE \DFSDEVICEP))
(\DFSDEVICEP NAME)))
then (RETURN DEV)
elseif (EQ NAME (QUOTE DSK))
then (SETQ DEV (\GETDEVICEFROMNAME (COREDEVICE NAME)))
(* Grumble. COREDEVICE returns name, not device)
[replace EVENTFN of DEV
with (FUNCTION (LAMBDA (FDEV EVENT)
(SELECTQ EVENT
[(AFTERLOGOUT AFTERSYSOUT
AFTERMAKESYS)
(COND
((NEQ (MACHINETYPE)
(QUOTE DANDELION))
(\REMOVEDEVICE FDEV]
NIL]
(RETURN DEV]
(\M44HOSTNAMEP NAME])
(\OPENDISKDEVICE
[LAMBDA (PARTITION DSKOBJ) (* bvm: "28-May-84 14:11")
(DECLARE (GLOBALVARS \MAINDISK)) (* Creates the model 44 DSK device and opens its
SYSDIR.)
(PROG ([NAME (COND
((ZEROP PARTITION)
(QUOTE DSK))
(T (PACK* (QUOTE DSK)
PARTITION]
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]
(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 (fetch DEVICENAME of FDEV)
FDEV)
(COND
((\OPENDIR 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) (* bvm: "21-NOV-83 17:15")
(PROG ((STREAM (\OPENFILE (PACK* (QUOTE {)
(fetch DEVICENAME of DEV)
"}SYS.BOOT;1")
(QUOTE INPUT)
(QUOTE OLD)))
PASSVECTOR BUF PASSINFO ASKEDONCE NAME N)
(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
((ZEROP (\GETBASE PASSVECTOR 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 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: "29-Nov-83 14:47")
(PROG (PARTNUM)
(RETURN (COND
((EQ NAME (QUOTE DSK))
(\OPENDISKDEVICE 0))
((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)
)
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(\VANILLADISKINIT)
(OR (BOUNDP (QUOTE \CONNECTED.DIR))
(CNDIR))
)
(* SYSOUT etc)
(DEFINEQ
(\COPYSYS
[LAMBDA (FILE SYSNAME DONTSAVE) (* bvm: "24-Jan-84 11:03")
(DECLARE (GLOBALVARS SYSOUTCURSOR))
(RESETLST
(RESETSAVE \VMEM.INHIBIT.WRITE T) (* Prevent dirty pages from being written after the
\FLUSHVM)
(PROG (FL STREAM VAL LASTPAGE)
RETRY
(RECLAIM)
(RETURN (PROG1 (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 FL (OPENFILE FILE (QUOTE OUTPUT)
(QUOTE NEW)
NIL
(CONS (LIST (QUOTE LENGTH)
(UNFOLD LASTPAGE
BYTESPERPAGE))
(QUOTE ((SEQUENTIAL T)
(TYPE BINARY]
(SETQ STREAM (GETSTREAM FL))
(RESETSAVE NIL
(LIST [FUNCTION (LAMBDA (FILE)
(CLOSEF FILE)
(AND RESETSTATE
(DELFILE (fetch FULLNAME
of FILE]
STREAM))
(COND
(SYSNAME (SET SYSNAME FL)))
[RESETSAVE (CURSOR (COND
((type? CURSOR SYSOUTCURSOR)
(* Comes from a later file)
SYSOUTCURSOR)
(T T]
(\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)
FL)
((AND (SMALLP VAL)
(IGREATERP 0 VAL)) (* Error occurred while making sysout.)
(LISPERROR (IMINUS VAL)
FL)
(GO RETRY))
(T (* Starting sysout)
(\CLEARSYSBUF)
(CLEARMOUSEBUF)
(\RESETKEYBOARD)
(LIST FL)))
(\RESETKEYBOARD])
(\COPYSYS1
[LAMBDA (STREAM LASTPAGE) (* bvm: "10-Dec-84 12:13")
(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
((ZEROP DOMINOPAGE) (* First page to write is the ISF map page, which
should be blank in a sysout)
(\ZEROPAGE (fetch (POINTER PAGE#) of BUFBASE))
(SETA DAS 1 (fetch ISFDA2 of \ISFMAP)))
((EQ \MACHINETYPE \DANDELION)
(\DL.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))
(add CURSORNEXT CURSORINC)
(COND
((ZEROP (SETQ CURSORMASK (LRSH CURSORMASK 1)))
(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)))
(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)
)
(FILESLOAD (LOADCOMP)
LLBFS)
)
(PUTPROPS MOD44IO COPYRIGHT ("Xerox Corporation" 1981 1982 1983 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2751 43337 (\M44AddDiskPages 2761 . 3742) (\M44CloseFile 3744 . 4205) (\M44CompleteFH
4207 . 7189) (\M44CREATEFILE 7191 . 10977) (\M44DeleteFile 10979 . 12046) (\M44EVENTFN 12048 . 13838)
(\M44ExtendFilePageMap 13840 . 15263) (\M44FillInMap 15265 . 16993) (\M44GetFileHandle 16995 . 18458)
(\M44GetFileInfo 18460 . 20551) (\M44GETDATEPROP 20553 . 21153) (\M44GetFileName 21155 . 21376) (
\M44GetPageLoc 21378 . 22090) (\M44KillFilePageMap 22092 . 22422) (\M44MAKEDIRENTRY 22424 . 23954) (
\M44OpenFile 23956 . 27279) (\M44OPENFILEFROMFP 27281 . 28002) (\M44ReadDiskPage 28004 . 29547) (
\M44ReadLeaderPage 29549 . 30811) (\M44ReadPages 30813 . 31144) (\M44SetAccessTimes 31146 . 32157) (
\M44SetEndOfFile 32159 . 33092) (\M44SetFileInfo 33094 . 33862) (\M44SETFILETYPE 33864 . 35258) (
\M44TruncateFile 35260 . 36510) (\M44WriteDiskPage 36512 . 38692) (\M44WriteLeaderPage 38694 . 39246)
(\M44WritePages 39248 . 41136) (\M44WritePages1 41138 . 43335)) (43338 55598 (\ADDDISKPAGES 43348 .
44676) (\M44DELETEPAGES 44678 . 47526) (\ASSIGNDISKPAGE 47528 . 49802) (\COUNTDISKFREEPAGES 49804 .
50536) (\M44MARKPAGEFREE 50538 . 51449) (\M44FLUSHDISKDESCRIPTOR 51451 . 52219) (\MAKELEADERDAS 52221
. 52833) (\CREATE.FID.FOR.DD 52835 . 53471) (\OPENDISK 53473 . 54413) (DISKFREEPAGES 54415 . 55428) (
VMEMSIZE 55430 . 55596)) (57921 69063 (\M44GENERATEFILES 57931 . 61831) (\M44SORTFILES 61833 . 62358)
(\M44GENERATENEXT 62360 . 66054) (\M44NEXTFILEFN 66056 . 67143) (\M44SORTEDNEXTFILEFN 67145 . 68113) (
\M44FILEINFOFN 68115 . 69061)) (69102 86055 (\M44PARSEFILENAME 69112 . 71200) (\FINDDIRHOLE 71202 .
72503) (\M44PACKFILENAME 72505 . 73169) (\LOOKUPVERSIONS 73171 . 75786) (\M44READVERSION 75788 . 76384
) (\OPENDISKDESCRIPTOR 76386 . 78049) (\READDIRFPTR 78051 . 78334) (\SEARCHDIR1 78336 . 80748) (
\M44UNPACKFILENAME 80750 . 86053)) (86056 86650 (ALTOFILENAME 86066 . 86648)) (87292 96121 (
\VANILLADISKINIT 87302 . 90307) (\OPENDISKDEVICE 90309 . 92162) (\OPENDIR 92164 . 93920) (
\M44CHECKPASSWORD 93922 . 95651) (\M44HOSTNAMEP 95653 . 96119)) (96483 105167 (\COPYSYS 96493 . 98709)
(\COPYSYS1 98711 . 105165)) (105277 106682 (GATHERSTATS 105287 . 106680)))))
STOP