(FILECREATED "28-May-84 14:35:00" {PHYLUM}<LISPCORE>SOURCES>LLBFS.;3 72576
changes to: (VARS LLBFSCOMS)
(RECORDS \M44LeaderPage M44STREAM)
(FNS \ACTONDISKPAGES \DOWRITEDISKPAGES)
(MACROS .SETUPDISKBUFFERS.)
previous date: " 3-NOV-83 22:59:48" {PHYLUM}<LISP>SOURCES>LLBFS.;2)
(* Copyright (c) 1982, 1983, 1984 by Xerox Corporation)
(PRETTYCOMPRINT LLBFSCOMS)
(RPAQQ LLBFSCOMS [(COMS (* Low-level subr calls)
(FNS \INITBFS \TESTPARTITION \ACTONDISKPAGES \WRITEDISKPAGES \DISKERROR)
(DECLARE: EVAL@COMPILE DONTCOPY (MACROS .SETUPDISKBUFFERS. DISKWRITEACTION?
DISKREADACTION?)
(CONSTANTS * DISKCOMMANDS)
(CONSTANTS * DISKERRORS)
(* Some of these are also used by MOD44IO)
(RECORDS DISKREQUEST ALTODSKOBJ DDHEADER CB DISKLABEL REALDA
SHORTCB FP DSKOBJ \M44LeaderPage M44STREAM FID)
(CONSTANTS (\FILLINDA 65534)
(\EOFDA 65535)
(\LENFP 5)
(\FP.DIRECTORYP 32768)
(\INITPROPPTR 6866)
(\DDBITTABSTART 32)
(\NBYTES.DISKINFO 12)
(\OFFSET.DISKLASTSERIAL# 8)
(\NWORDS.DSKOBJ 36))
(GLOBALVARS \EMUDISKBUFEND \EMUDISKBUFFERS \EMUSCRATCH
\EMUSWAPBUFFERS \EXTRAISFBUF \ISFMAP \ISFMAXCHUNK
\ISFSCRATCHCAS \ISFSCRATCHDAS \#DISKBUFFERS \MAXDISKDAs
\#SWAPBUFFERS \SYSDISK \ISFCHUNKSIZE \MAINDISK
\DISKREQUESTBLOCK \SWAPREQUESTBLOCK \DISKDEBUG
\MAXSWAPBUFFERS \SPAREDISKWRITEBUFFER \FREEPAGEFID
\#EMUBUFFERS \EMUBUFFERS)))
[COMS (* Super low level)
(FNS \ACTONVMEMPAGES \WRITEVMEMPAGES \DOACTONDISKPAGES \DOWRITEDISKPAGES \CHECKFREEPAGE
\DODISKCOMMAND \GETDISKCB \CLEARCB \CLEANUPDISKQUEUE \VIRTUALDISKDA \REALDISKDA)
(DECLARE: EVAL@COMPILE DONTCOPY (CONSTANTS * CBSTATUSCONSTANTS)
(CONSTANTS * IDISKCOMMANDS)
(CONSTANTS (\EM.DISKCOMMAND 337)
(\EM.DISKADDRESS 339)
(\FIXEDLENDISKREQUEST 42)
(\DEFAULTDASTORAGELENGTH 60)
(\LENCB 6)
(\LENDSKOBJ 34)
(\LENSHORTCB 18))
(CONSTANTS (\CB.PENDING 1)
(\CB.FREE 0]
[COMS (* At MAKEINIT time)
(FNS MAKEINITBFS)
(DECLARE: DONTCOPY (ADDVARS (INITPTRS (\MAINDISK)
(\SWAPREQUESTBLOCK)
(\DISKREQUESTBLOCK)
(\FREEPAGEFID))
(INEWCOMS (FNS MAKEINITBFS)))
EVAL@COMPILE
(ADDVARS (DONTCOMPILEFNS MAKEINITBFS]
(COMS (* Swap stuff)
(FNS \M44ACTONVMEMFILE \INSUREVMEMFILE \MAYBE.EXTENDVMEMFILE \LOOKUPFMAP
\EXTENDVMEMFILE \LISP.EXTENDVMEMFILE \BCPL.EXTENDVMEMFILE \EXTENDISFMAP
\WARN.OF.BADVMEM)
(DECLARE: EVAL@COMPILE DONTCOPY (RECORDS ISFMAP)
(CONSTANTS (\ISFMAPOFFSET 18))
(ADDVARS (DONTCOMPILEFNS \LISP.EXTENDVMEMFILE))
(GLOBALVARS \FRAGMENTATIONWARNED))
(INITVARS (\DISKDEBUG)
(\EXTENDINGVMEMFILE)
(\MAXSWAPBUFFERS 1)
(\FRAGMENTATIONWARNED))
(ADDVARS (\SYSTEMCACHEVARS \FRAGMENTATIONWARNED)))
(DECLARE: DONTCOPY
(ADDVARS (INEWCOMS (ALLOCAL (ADDVARS (LOCKEDFNS ERROR RAID \M44ACTONVMEMFILE
\ACTONVMEMFILESUBR \ACTONVMEMPAGES
\CLEANUPDISKQUEUE \CLEARCB
\DISKERROR \DOACTONDISKPAGES
\DODISKCOMMAND \EXTENDISFMAP
\EXTENDVMEMFILE \GETDISKCB \INITBFS
\INSUREVMEMFILE \LISPERROR
\LOOKUPFMAP \REALDISKDA
\VIRTUALDISKDA \WARN.OF.BADVMEM
\ZEROPAGE \ZEROWORDS \TESTPARTITION)
(LOCKEDVARS \DISKREQUESTBLOCK
\SWAPREQUESTBLOCK \MAINDISK
\ISFCHUNKSIZE \EMUSCRATCH
\EMUDISKBUFFERS \EMUSWAPBUFFERS
\EMUDISKBUFEND \MAXSWAPBUFFERS
\#DISKBUFFERS \InterfacePage
\ISFMAP \ISFSCRATCHCAS
\ISFSCRATCHDAS \SYSDISK
\#SWAPBUFFERS \MAXDISKDAs
%%STREAMTYPE# \DISKDEBUG
\MAXSWAPBUFFERS
\SPAREDISKWRITEBUFFER \#EMUBUFFERS
\EMUBUFFERS \FRAGMENTATIONWARNED])
(* Low-level subr calls)
(DEFINEQ
(\INITBFS
[LAMBDA (BASE NWORDS AFTER) (* bvm: "15-JUL-83 12:26")
(PROG ((DSK \MAINDISK)
CBSTART CB DD)
(* BASE is the start of a chunk of space running for NWORDS words for disk scratch use. Divvy it up as follows:
first page as scratch buffer for \WRITEDISKPAGES, then short CB's for disk ops, then miscellaneous scratch for
copying DA and CA arrays)
(PROGN (* For \WRITEDISKPAGES)
(SETQ \SPAREDISKWRITEBUFFER BASE)
(SETQ BASE (\ADDBASE BASE WORDSPERPAGE))
(SETQ NWORDS (IDIFFERENCE NWORDS WORDSPERPAGE)))
[PROGN (* Fill in pieces of \MAINDISK)
(OR (SETQ \SYSDISK (EMPOINTER (fetch (IFPAGE SYSDISK) of \InterfacePage)))
(RAID "Can't find sysDisk"))
(SETQ DD (fetch DDHEADER of \SYSDISK))
(SETQ CB (SETQ CBSTART (fetch CBQUEUE of DSK)))
(do (* Allocate Short CB's for disk controller)
(replace SHORTCB of CB with BASE)
(SETQ BASE (\ADDBASE BASE \LENSHORTCB))
(SETQ NWORDS (IDIFFERENCE NWORDS \LENSHORTCB))
(SETQ CB (fetch CBNEXT of CB)) repeatuntil (EQ CB CBSTART))
(replace ddPOINTER of DSK with (LOCF (fetch (ALTODSKOBJ DDLASTSERIAL#) of \SYSDISK)))
(* Make some fields indirect thru alto record for now)
(replace ALTODSKOBJ of DSK with \SYSDISK)
(PROGN (replace NDISKS of DSK with (fetch DD#DISKS of DD))
(* Copy some constant fields from alto)
(replace NTRACKS of DSK with (fetch DD#TRACKS of DD))
(replace NHEADS of DSK with (fetch DD#HEADS of DD))
(replace NSECTORS of DSK with (fetch DD#SECTORS of DD)))
(replace RETRYCOUNT of DSK with 8)
(AND AFTER (replace DDDIRTY of DSK with (replace DDVALID of DSK with NIL]
(PROGN (SETQ \EMUSCRATCH BASE)
(SETQ \MAXDISKDAs (IQUOTIENT (IDIFFERENCE NWORDS (IPLUS \LENFP 8))
2)))
(COND
((SETQ \ISFMAP (EMPOINTER (fetch (IFPAGE ISFMAP) of \InterfacePage)))
(SETQ \ISFSCRATCHCAS (\ADDBASE [SETQ \ISFSCRATCHDAS
(\ADDBASE \ISFMAP (IPLUS (fetch ISFEND of \ISFMAP)
(PROGN
(* Leave a little room for off-by-one error in BCPL
code)
2]
(IPLUS (fetch ISFCHUNKSIZE of \ISFMAP)
2)))
(SETQ \ISFCHUNKSIZE (fetch ISFCHUNKSIZE of \ISFMAP))
(replace DISKVERSION of \SWAPREQUESTBLOCK with (fetch FPVERSION of \ISFMAP))
(* Fill in disk label info for all Lisp.virtualmem
requests)
(\BLT (LOCF (fetch DISKSERIAL# of \SWAPREQUESTBLOCK))
\ISFMAP WORDSPERCELL)
(replace RETURNONCHECKERROR of \SWAPREQUESTBLOCK with NIL))
(T (RAID "No ISF map"])
(\TESTPARTITION
[LAMBDA (NUM) (* bvm: " 5-APR-83 12:03")
(PROG [(HERE ((OPCODES SUBRCALL 10Q 0]
(RETURN (COND
([NOT (ZEROP ((OPCODES SUBRCALL 10Q 1)
(\DTEST NUM (QUOTE SMALLP]
(* Partition switch succeeded, now restore original
partition)
((OPCODES SUBRCALL 10Q 1)
HERE)
T])
(\ACTONDISKPAGES
[LAMBDA (DSK BUFFERS DAs DAorigin FID FIRSTPAGE LASTPAGE ACTION LASTNUMCHARSCONS LASTACTION
ReturnOnCheckError HINTLASTPAGE CAs) (* bvm: "17-May-84 15:05")
(* performs indicated ACTION on pages FIRSTPAGE thru LASTPAGE of DSK (a disk object) for file whose alto id is
FID. Returns page number of last page acted on, which may be less than LASTPAGE if end of file was encountered.
BUFFERS is either NIL (don't care about the data) or else a buffer or list of buffers of data to be read/written.
DAs is a vector of virtual disk addresses (words) for pages of the file, per alto conventions.
DAorigin indicates which page (\GETBASE DAs 0) corresponds to; it should be no greater than FIRSTPAGE.
LASTACTION, if supplied, is performed instead of ACTION on LASTPAGE. HINTLASTPAGE is hint of the last page of
file, to avoid chaining beyond the end of file. NUMCHARSCONS, if supplied, is a list, car of which will be smashed
with the NUMCHARS field of the last page acted on (this in lieu of multiple value return). If ReturnOnCheckError
is true, returns (- (I + 100Q)), where I was the last page successfully acted on)
(PROG ((EMBLOCK \EMUSCRATCH)
(EMBUFS \EMUDISKBUFFERS)
EMCAs EMDAs EMFID EMFIXEDCA RESULT STREAM LASTNC)
[COND
((type? STREAM FID)
(SETQ STREAM FID)
(SETQ FID (fetch (ARRAYP BASE) of (fetch FID of FID]
(UNINTERRUPTABLY
(\CLOCK0 (LOCF (fetch DISKTEMP0 of \MISCSTATS)))
(* Note starting time)
(.SETUPDISKBUFFERS. ACTION)
(COND
((EQ DSK \SYSDISK)
(SETQ DSK \MAINDISK)))
(PROG ((REQUEST \DISKREQUESTBLOCK))
(replace DISKCAS of REQUEST with EMCAs)
(replace FIXEDDISKBUFFER of REQUEST with EMFIXEDCA)
(replace DISKDAS of REQUEST with (\ADDBASE EMDAs (IMINUS DAorigin)))
(replace DISKVERSION of REQUEST with (fetch FPVERSION of FID))
(\BLT (LOCF (fetch DISKSERIAL# of REQUEST))
FID WORDSPERCELL) (* Fill in serial number for label)
(replace DISKFIRSTPAGE of REQUEST with FIRSTPAGE)
(replace DISKLASTPAGE of REQUEST with LASTPAGE)
(replace DISKHINTLASTPAGE of REQUEST with (OR HINTLASTPAGE 0))
(replace RETURNONCHECKERROR of REQUEST with ReturnOnCheckError)
(replace DISKACTION of REQUEST with ACTION)
(replace LASTDISKACTION of REQUEST with (COND
((AND LASTACTION (NEQ LASTACTION 0))
LASTACTION)
(T ACTION)))
(SETQ RESULT (\MISCAPPLY*(FUNCTION \DOACTONDISKPAGES)
DSK REQUEST))
(SETQ LASTNC (fetch CURRENTNUMCHARS of REQUEST)))
[COND
((AND BUFFERS (NEQ LASTNC BYTESPERPAGE)
(IGEQ RESULT 0)
(DISKREADACTION? (OR (AND (EQ RESULT LASTPAGE)
LASTACTION)
ACTION))) (* Zero out everything past the last byte)
(PROG [(BUF (OR EMFIXEDCA (EMPOINTER (\GETBASE EMCAs RESULT]
(\ZEROBYTES BUF LASTNC (SUB1 BYTESPERPAGE]
[COND
((NOT (EMADDRESSP DAs)) (* Possibly update the user's DAs from the emulator
copy)
(\BLT DAs EMDAs (IPLUS LASTPAGE 2 (IMINUS DAorigin]
(* If action was read, now copy from emu buffers into
user buffers)
(COND
((LISTP BUFFERS)
(for BUF in BUFFERS as (CA ← EMCAs) by (\ADDBASE CA 1) as N from FIRSTPAGE
when (AND BUF (NOT (EMADDRESSP BUF))
(DISKREADACTION? (OR (AND (EQ N LASTPAGE)
LASTACTION)
ACTION)))
do (\BLT BUF (\VAG2 0 (\GETBASE CA 0))
WORDSPERPAGE)))
((AND BUFFERS (NOT (EMADDRESSP BUFFERS))
(DISKREADACTION? ACTION))
(\BLT BUFFERS EMFIXEDCA WORDSPERPAGE)))
[\BOXIPLUS (LOCF (fetch DISKIOTIME of \MISCSTATS))
(\BOXIDIFFERENCE (\CLOCK0 (LOCF (fetch DISKTEMP1 of \MISCSTATS)))
(LOCF (fetch DISKTEMP0 of \MISCSTATS]
(* Note total time spent here)
)
(RETURN (COND
((ILESSP RESULT 0)
(\DISKERROR (IMINUS RESULT)
STREAM LASTNC))
(T [COND
(LASTNUMCHARSCONS (COND
((LISTP LASTNUMCHARSCONS)
(RPLACA LASTNUMCHARSCONS LASTNC))
(T (\PUTBASE LASTNUMCHARSCONS 0 LASTNC]
(SIGNED RESULT BITSPERWORD])
(\WRITEDISKPAGES
[LAMBDA (DSK BUFFERS DAs DAorigin FID FIRSTPAGE LASTPAGE LASTACTION LASTNUMCHARSCONS LASTNUMCHARS
HINTLASTPAGE CAs) (* bvm: "31-MAR-83 21:45")
(* Write pages FIRSTPAGE thru LASTPAGE of DSK (a disk object) for file whose alto id is FID.
Returns page number of last page acted on. BUFFERS is either NIL (don't care about the data) or else a buffer or
list of buffers of data to be written. DAs is a vector of virtual disk addresses (words) for pages of the file,
per alto conventions. DAorigin indicates which page (\GETBASE DAs 0) corresponds to; it should be no greater than
FIRSTPAGE. LASTACTION, if supplied, is performed instead of ACTION on LASTPAGE. HINTLASTPAGE is hint of the last
page of file, to avoid chaining beyond the end of file. NUMCHARSCONS, if supplied, is a list, car of which will be
smashed with the NUMCHARS field of the last page acted on (this in lieu of multiple value return). LASTNUMCHARS is
the nchars field to be written for LASTPAGE)
(PROG ((EMBLOCK \EMUSCRATCH)
(EMBUFS \EMUDISKBUFFERS)
EMCAs EMDAs EMFID EMFIXEDCA RESULT STREAM)
(COND
((EQ DSK \SYSDISK)
(SETQ DSK \MAINDISK)))
[COND
((type? STREAM FID)
(SETQ STREAM FID)
(SETQ FID (fetch (ARRAYP BASE) of (fetch FID of FID]
(\OPENDISKDESCRIPTOR DSK)
(UNINTERRUPTABLY
(\CLOCK0 (LOCF (fetch DISKTEMP0 of \MISCSTATS)))
(.SETUPDISKBUFFERS. \DC.WRITED)
[SETQ RESULT (PROG ((REQUEST \DISKREQUESTBLOCK))
(replace DISKCAS of REQUEST with EMCAs)
(replace FIXEDDISKBUFFER of REQUEST with EMFIXEDCA)
(replace DISKDAS of REQUEST with (\ADDBASE EMDAs (IMINUS DAorigin)))
(replace DISKVERSION of REQUEST with (fetch FPVERSION of FID))
(\BLT (LOCF (fetch DISKSERIAL# of REQUEST))
FID WORDSPERCELL) (* Fill in serial number for label)
(replace DISKFIRSTPAGE of REQUEST with FIRSTPAGE)
(replace DISKLASTPAGE of REQUEST with LASTPAGE)
(replace DISKHINTLASTPAGE of REQUEST with (OR HINTLASTPAGE 0))
(replace DISKNOALLOC of REQUEST with (EQ LASTACTION
(UNSIGNED -1 BITSPERWORD)))
(replace DISKWRITELASTNUMCHARS of REQUEST with (OR LASTNUMCHARS
BYTESPERPAGE))
(RETURN (\MISCAPPLY*(FUNCTION \DOWRITEDISKPAGES)
DSK REQUEST]
[COND
((NOT (EMADDRESSP DAs))
(\BLT DAs EMDAs (IPLUS LASTPAGE 2 (IMINUS DAorigin]
[\BOXIPLUS (LOCF (fetch DISKIOTIME of \MISCSTATS))
(\BOXIDIFFERENCE (\CLOCK0 (LOCF (fetch DISKTEMP1 of \MISCSTATS)))
(LOCF (fetch DISKTEMP0 of \MISCSTATS]
(* Note total time spent)
)
(RETURN (COND
((ILESSP RESULT 0)
(\DISKERROR (IMINUS RESULT)
STREAM))
(T (SIGNED RESULT BITSPERWORD])
(\DISKERROR
[LAMBDA (ERRCODE STREAM LASTNC DSK) (* bvm: " 3-NOV-83 22:43")
(COND
[STREAM (SELECTC ERRCODE
(\DSK.HARD.ERROR (LISPERROR "HARD DISK ERROR" (fetch FULLFILENAME
of STREAM)))
(\DSK.FULL.ERROR (LISPERROR "FILE SYSTEM RESOURCES EXCEEDED"
(fetch FULLFILENAME of STREAM)))
(ERROR "Disk Error" (fetch FULLFILENAME of STREAM]
(T (while T do (SELECTC ERRCODE
(\DSK.HARD.ERROR (RAID "Hard Disk Error in Lisp.virtualmem. Page = "
(fetch (DSKOBJ CURRENTDISKPAGE) of DSK)))
(\DSK.FULL.ERROR (RAID "Disk Full"))
(RAID "Unknown disk error in Lisp.virtualmem" ERRCODE])
)
(DECLARE: EVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
(PUTPROPS .SETUPDISKBUFFERS. MACRO [(ACTION) (* bvm: "15-OCT-82 17:28")
[COND
((ILESSP DAorigin (SUB1 FIRSTPAGE))
[SETQ DAs (\ADDBASE DAs (SUB1 (IDIFFERENCE FIRSTPAGE DAorigin]
[AND CAs (SETQ CAs (\ADDBASE CAs (SUB1 (IDIFFERENCE FIRSTPAGE DAorigin]
(SETQ DAorigin (SUB1 FIRSTPAGE]
[SETQ EMDAs (COND
((EMADDRESSP DAs)
DAs)
(T (\BLT EMBLOCK DAs (IPLUS LASTPAGE 2 (IMINUS DAorigin)))
(PROG1 EMBLOCK (SETQ EMBLOCK (\ADDBASE EMBLOCK (IPLUS LASTPAGE 2 (IMINUS DAorigin]
(COND
[CAs (SETQ EMCAs (\ADDBASE CAs (IMINUS DAorigin]
[(AND (LISTP BUFFERS)
(OR (CDR BUFFERS)
(PROGN (SETQ BUFFERS (CAR BUFFERS)) (* Treat singleton BUFFER as nonlist)
NIL)))
(SETQ EMCAs (\ADDBASE EMBLOCK (IMINUS FIRSTPAGE)))
(for BUF in BUFFERS as N from FIRSTPAGE bind FIXEDBUF
do [\PUTBASE EMBLOCK 0 (COND
((AND BUF (EMADDRESSP BUF))
(\LOLOC BUF))
((AND (NULL BUF)
FIXEDBUF))
(T (PROG1 (\LOLOC EMBUFS)
[COND
((DISKWRITEACTION? (OR (AND (EQ N LASTPAGE)
LASTACTION)
ACTION))
(COND
(BUF (\BLT EMBUFS BUF WORDSPERPAGE))
(T (\ZEROPAGE (fetch (POINTER PAGE#) of EMBUFS))
(SETQ FIXEDBUF (\LOLOC EMBUFS]
(SETQ EMBUFS (\ADDBASE EMBUFS WORDSPERPAGE))
(COND
((PTRGTP EMBUFS \EMUDISKBUFEND)
(ERROR "Attempt to act on too many disk pages"]
(SETQ EMBLOCK (\ADDBASE EMBLOCK 1]
(T (SETQ EMFIXEDCA (COND
((AND BUFFERS (EMADDRESSP BUFFERS))
BUFFERS)
(T [COND
((DISKWRITEACTION? ACTION) (* If writing, copy data into buffer)
(COND
(BUFFERS (\BLT EMBUFS BUFFERS WORDSPERPAGE))
(T (\ZEROPAGE (fetch (POINTER PAGE#) of EMBUFS]
EMBUFS])
(PUTPROPS DISKWRITEACTION? MACRO ((ACTION) (* bvm: "15-OCT-82 17:06")
(SELECTC ACTION
((LIST \DC.WRITEHLD \DC.WRITELD \DC.WRITED)
T)
NIL)))
(PUTPROPS DISKREADACTION? MACRO ((ACTION) (* bvm: "15-OCT-82 17:06")
(ILESSP ACTION \DC.WRITEHLD)))
)
(RPAQQ DISKCOMMANDS ((\DC.READHLD 54784)
(\DC.READLD 54785)
(\DC.READD 54786)
(\DC.WRITEHLD 54787)
(\DC.WRITELD 54788)
(\DC.WRITED 54789)
(\DC.SEEKONLY 54790)
(\DC.NOOP 54791)
(\DC.RESTORE 54891)))
(DECLARE: EVAL@COMPILE
(RPAQQ \DC.READHLD 54784)
(RPAQQ \DC.READLD 54785)
(RPAQQ \DC.READD 54786)
(RPAQQ \DC.WRITEHLD 54787)
(RPAQQ \DC.WRITELD 54788)
(RPAQQ \DC.WRITED 54789)
(RPAQQ \DC.SEEKONLY 54790)
(RPAQQ \DC.NOOP 54791)
(RPAQQ \DC.RESTORE 54891)
(CONSTANTS (\DC.READHLD 54784)
(\DC.READLD 54785)
(\DC.READD 54786)
(\DC.WRITEHLD 54787)
(\DC.WRITELD 54788)
(\DC.WRITED 54789)
(\DC.SEEKONLY 54790)
(\DC.NOOP 54791)
(\DC.RESTORE 54891))
)
(RPAQQ DISKERRORS ((\DSK.HARD.ERROR 1101)
(\DSK.FULL.ERROR 1102)))
(DECLARE: EVAL@COMPILE
(RPAQQ \DSK.HARD.ERROR 1101)
(RPAQQ \DSK.FULL.ERROR 1102)
(CONSTANTS (\DSK.HARD.ERROR 1101)
(\DSK.FULL.ERROR 1102))
)
(* Some of these are also used by MOD44IO)
[DECLARE: EVAL@COMPILE
(BLOCKRECORD DISKREQUEST ((DISKDAS FULLXPOINTER) (* Vector of DAs to be acted on)
(DISKCAS FULLXPOINTER)
(FIXEDDISKBUFFER FULLXPOINTER)
(DISKERRORCODE FULLXPOINTER)
(CBCLEANUPFN FULLXPOINTER)
(DISKFIRSTPAGE WORD)
(DISKLASTPAGE WORD)
(DISKHINTLASTPAGE WORD)
(DISKVERSION WORD) (* These 3 words are for the disk label)
(DISKSERIAL# FIXP)
(DISKACTION WORD)
(LASTDISKACTION WORD)
(CURRENTNUMCHARS WORD)
(LASTPAGEACTEDON WORD)
(DISKWRITELASTNUMCHARS WORD)
(RETURNONCHECKERROR FLAG)
(DISKNOALLOC FLAG)
(NIL BITS 14)
(DISKCASTORAGE 20 WORD)
(DISKDASTORAGE 60 WORD) (* Or as much as you want)
)
[ACCESSFNS ((DISKFID (LOCF (fetch DISKVERSION of DATUM]
(CREATE (\ALLOCBLOCK (FOLDHI (IPLUS \FIXEDLENDISKREQUEST 60)
WORDSPERCELL))))
(BLOCKRECORD ALTODSKOBJ ((NIL 8 WORD) (* Alto functions to implement generic ops)
(DSKFPSYSDIR WORD) (* Short pointer to SYSDIR FP)
(NIL 2 WORD) (* More alto fns)
(DSKFPWORKINGDIR WORD) (* Short pointer to FP of "working" dir)
(DSKNAMEWORKINGDIR WORD) (* Short pointer to bcpl string)
(DSKLNPAGESIZE WORD) (* ln{pagesize-in-words})
(NIL 3 WORD) (* More alto cruft)
(DSKKD WORD) (* Short pointer to DDHEADER)
(DSKFPDISKDESCRIPTOR WORD) (* Short pointer to DiskDescriptor FP)
(DSKDRIVE# WORD)
(DSKRETRYCOUNT WORD)
(DSKTOTALERRORS WORD)
(DSKLENCBZ WORD)
(DSKLENCB WORD)
(DSKDDHEADER 16 WORD) (* Overlays DDHEADER)
(NIL 2 WORD)
(DSKDDMGR WORD) (* DD manager, for \FLUSHDISKDESCRIPTOR)
(DSKLASTVDA WORD) (* VDA of last page allocated, for biasing search)
(DSKSYSDIRBLK 5 WORD)
(DSKDDBLK 5 WORD)
(DSKWDBLK 5 WORD)
(NIL 20 WORD) (* WorkingDir name)
(DSKDDVDAS 17 WORD) (* VDAs for the data part of DD)
)
[ACCESSFNS ALTODSKOBJ ((DDHEADER (LOCF (fetch DSKDDHEADER of DATUM])
(BLOCKRECORD DDHEADER ((DD#DISKS WORD)
(DD#TRACKS WORD)
(DD#HEADS WORD)
(DD#SECTORS WORD)
(DDLASTSERIAL# FIXP)
(NIL WORD)
(DDBTSIZE WORD) (* Size of bittable in words)
(DDDEFAULTVERSIONSKEPT WORD)
(DDFREEPAGES WORD)
(NIL 6 WORD)))
(BLOCKRECORD CB ((CBQSTATUS BYTE)
(CBNEXT POINTER) (* Link to next one)
(SHORTCB POINTER) (* In alto space, what disk actually uses)
(CBPAGENO WORD) (* The page number we intended to act on with this CB)
)
(CREATE (\ALLOCBLOCK 3)))
(BLOCKRECORD DISKLABEL ((DLNEXT WORD)
(DLPREVIOUS WORD)
(NIL WORD)
(DLNUMCHARS WORD)
(DLPAGENO WORD)
(DLFID 3 WORD) (* Version followed by 2-word serial number)
))
(ACCESSFNS REALDA ((SECTOR (LRSH DATUM 12))
(TRACK (LOGAND (LRSH DATUM 3)
511))
(HEAD (LOGAND (LRSH DATUM 2)
1))
(DISK (LOGAND (LRSH DATUM 1)
1))
(RESTORE (LOGAND DATUM 1))))
(BLOCKRECORD SHORTCB ((CBLINK WORD) (* Short pointer to next in command chain, or zero)
(CBSTATUS WORD)
(CBCOMMAND WORD)
(CBHEADERADDR WORD) (* Short pointer to header record, normally CBHEADER)
(CBLABELADDR WORD) (* Short pointer to label record, normally either in
this CB or in the next cb in chain)
(CBDATAADDR WORD) (* Short pointer to buffer of data)
(CBWAKEUPS WORD) (* These two are always zero)
(CBERRWAKEUPS WORD)
(CBHEADER WORD)
(CBDA WORD) (* Address of this disk block.
May be filled in by previous access's label pointing at
my CBHEADER)
(CBLABNEXT WORD) (* Start of label field, if my CBLABELADDR points here)
(CBLABPREV WORD)
(CBLABBLANK WORD)
(CBLABNUMCHARS WORD)
(CBLABPAGENO WORD)
(CBLABVERSION WORD)
(CBLABSN1 WORD)
(CBLABSN2 WORD)
(CBTRUEPAGENO WORD) (* From here on is alto stuff that Lisp doesn't care
about)
(CBCBZ WORD)
(CBNEXTSHORTCB WORD))
(BLOCKRECORD SHORTCB ((NIL WORD)
(CBSECTOR BITS 4)
(CBDONE BITS 4)
(CBSEEKFAIL BITS 1)
(CBSEEKING BITS 1)
(CBNOTREADY BITS 1)
(CBDATALATE BITS 1)
(CBNOTRANSFER BITS 1)
(CBCHECKSUMERR BITS 1)
(CBFINALSTATUS BITS 2)
(CBSEAL BYTE)
(CBACTION BYTE)))
(BLOCKRECORD SHORTCB ((NIL WORD)
(NIL WORD)
(CBSHORTSEAL BITS 5)
(CBPARTITION BITS 3)
(NIL BYTE))))
(BLOCKRECORD FP ((FPSERIAL# FIXP)
(FPVERSION WORD)
(NIL WORD)
(FPLEADERVDA WORD))
(BLOCKRECORD FP ((FPSERIALHI WORD)
(FPSERIALLO WORD)
(NIL 3 WORD))))
(BLOCKRECORD DSKOBJ ((ddPOINTER FULLXPOINTER)
(* Either points at word 2 of this structure, or at DSKOBJ:LASTSERIAL#, so that we can maintain some fields in
parallel with alto OS for awhile. The next 6 words are arranged exactly as in the alto KDH structure, at least
those fields we care about)
(ddLASTSERIAL# FIXP) (* Last serial number given a file)
(NIL WORD)
(ddBITTABLESIZE WORD) (* Size of disk descriptor's bit table in words)
(NIL WORD)
(ddFREEPAGES WORD)
(DSKPARTITION BYTE) (* 0 or explicit partition pointer)
(ALTODSKOBJ XPOINTER) (* Pointer to alto BFSDSK structure, or NIL for disks
other than current partition)
(SAWCHECKERROR FLAG)
(DISKERRORCNT BITS 7)
(SYSDIROFD POINTER) (* Stream onto SYSDIR.;1)
(DDDIRTY FLAG) (* true if diskdescriptor needs writing)
(DDVALID FLAG) (* True if DISKDESCRIPTOROFD field is ok.
Invalidated on logout, etc)
(DSKPASSWORDOK FLAG) (* True after password for this partition, if any, has
been validated)
(NIL BITS 5)
(DISKDESCRIPTOROFD POINTER) (* Stream onto DiskDescriptor.;1)
(CBQUEUE POINTER) (* Stuff for management of command blocks.
No ref count because must not fault)
(CBFREEPTR FULLXPOINTER)
(CBPENDINGPTR FULLXPOINTER)
(CBLASTPTR FULLXPOINTER)
(CURRENTDAS FULLXPOINTER) (* Vector of DAs currently being acted on)
(DISKREQUEST FULLXPOINTER)
(DISKDEVICENAME POINTER) (* For retrieving the FDEV)
(DISKLASTPAGEALLOC WORD) (* Bias for new page search)
(* Pointer to request subrecord)
(CURRENTDISKPAGE WORD)
(TOTALDISKERRORS WORD)
(NDISKS WORD) (* Shape of disk. Info taken from disk descriptor)
(NTRACKS WORD)
(NHEADS WORD)
(NSECTORS WORD)
(RETRYCOUNT WORD))
(CREATE (\ALLOCBLOCK 18))
ddPOINTER ← NIL (BLOCKRECORD ddPOINTER ((DISKLASTSERIAL# FIXP)
(NIL WORD)
(DISKBITTABLESIZE WORD)
(NIL WORD)
(DISKFREEPAGES WORD))))
(BLOCKRECORD \M44LeaderPage ((TimeCreate FIXP)
(TimeWrite FIXP)
(TimeRead FIXP)
(NameCharCount BYTE)
(NameChars 39 BYTE)
(LeaderProps 210 WORD)
(Spares 10 WORD)
(PropertyPtr WORD)
(ConsecutiveHint FLAG)
(NIL BITS 7)
(ChangeSerialNumber BYTE)
(FIDDirectoryHint 5 WORD)
(LastPageAddress WORD)
(LastPageNumber WORD)
(LastPageByteCount WORD))
(BLOCKRECORD \M44LeaderPage ((NIL WORD)
(TimeCreateLo WORD)
(NIL WORD)
(TimeWriteLo WORD)
(NIL FIXP)
(NIL 20 WORD)
(NIL 210 WORD)
(NIL 10 WORD)
(PropertyBegin BYTE)
(PropertyLength BYTE)))
(CREATE (NCREATE (QUOTE VMEMPAGEP))))
(ACCESSFNS M44STREAM ((FID (fetch F1 of DATUM)
(replace F1 of DATUM with NEWVALUE))
(FILEPAGEMAP (fetch F2 of DATUM)
(replace F2 of DATUM with NEWVALUE))
(LASTMAPPEDPAGE (fetch F3 of DATUM)
(replace F3 of DATUM with NEWVALUE))
(DIRINFO (fetch F4 of DATUM)
(replace F4 of DATUM with NEWVALUE))
(LEADERPAGE (fetch F5 of DATUM)
(replace F5 of DATUM with NEWVALUE))
(LastPage (fetch FW6 of DATUM)
(replace FW6 of DATUM with NEWVALUE))
(LastOffset (fetch FW7 of DATUM)
(replace FW7 of DATUM with NEWVALUE)))
(ACCESSFNS M44STREAM ((DIRHOLEPTR (fetch F4 of DATUM)
(replace F4 of DATUM with NEWVALUE))
(* In dir stream only)
))
(CREATE (create STREAM))
LASTMAPPEDPAGE ← -1 LastPage ← 0 LastOffset ← 0)
(ACCESSFNS FID ((W0 (\WORDELT DATUM 0)
(SETA DATUM 0 NEWVALUE))
(W1 (\WORDELT DATUM 1)
(SETA DATUM 1 NEWVALUE))
(W2 (\WORDELT DATUM 2)
(SETA DATUM 2 NEWVALUE))
(W3 (\WORDELT DATUM 3)
(SETA DATUM 3 NEWVALUE))
(W4 (\WORDELT DATUM 4)
(SETA DATUM 4 NEWVALUE))
(FIDBLOCK (fetch (ARRAYP BASE) of DATUM)))
(CREATE (ARRAY 5 (QUOTE SMALLPOSP)
0 0)))
]
(DECLARE: EVAL@COMPILE
(RPAQQ \FILLINDA 65534)
(RPAQQ \EOFDA 65535)
(RPAQQ \LENFP 5)
(RPAQQ \FP.DIRECTORYP 32768)
(RPAQQ \INITPROPPTR 6866)
(RPAQQ \DDBITTABSTART 32)
(RPAQQ \NBYTES.DISKINFO 12)
(RPAQQ \OFFSET.DISKLASTSERIAL# 8)
(RPAQQ \NWORDS.DSKOBJ 36)
(CONSTANTS (\FILLINDA 65534)
(\EOFDA 65535)
(\LENFP 5)
(\FP.DIRECTORYP 32768)
(\INITPROPPTR 6866)
(\DDBITTABSTART 32)
(\NBYTES.DISKINFO 12)
(\OFFSET.DISKLASTSERIAL# 8)
(\NWORDS.DSKOBJ 36))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS \EMUDISKBUFEND \EMUDISKBUFFERS \EMUSCRATCH \EMUSWAPBUFFERS \EXTRAISFBUF \ISFMAP
\ISFMAXCHUNK \ISFSCRATCHCAS \ISFSCRATCHDAS \#DISKBUFFERS \MAXDISKDAs \#SWAPBUFFERS \SYSDISK
\ISFCHUNKSIZE \MAINDISK \DISKREQUESTBLOCK \SWAPREQUESTBLOCK \DISKDEBUG \MAXSWAPBUFFERS
\SPAREDISKWRITEBUFFER \FREEPAGEFID \#EMUBUFFERS \EMUBUFFERS)
)
)
(* Super low level)
(DEFINEQ
(\ACTONVMEMPAGES
[LAMBDA (DSK BUFFERS DAs DAorigin notused FIRSTPAGE LASTPAGE ACTION notused LASTACTION notused
HINTLASTPAGE CAs) (* bvm: " 3-NOV-83 22:41")
(PROG ((REQUEST \SWAPREQUESTBLOCK)
RESULT)
(replace FIXEDDISKBUFFER of REQUEST with (COND
(CAs (replace DISKCAS of REQUEST
with (\ADDBASE CAs (IMINUS DAorigin)))
NIL)
(T BUFFERS)))
(replace DISKDAS of REQUEST with (\ADDBASE DAs (IMINUS DAorigin)))
(replace DISKFIRSTPAGE of REQUEST with FIRSTPAGE)
(replace DISKLASTPAGE of REQUEST with LASTPAGE)
(replace DISKHINTLASTPAGE of REQUEST with (OR HINTLASTPAGE 0))
(replace DISKACTION of REQUEST with ACTION)
(replace LASTDISKACTION of REQUEST with (COND
((AND LASTACTION (NEQ LASTACTION 0))
LASTACTION)
(T ACTION)))
(RETURN (COND
((ILESSP (SETQ RESULT (\DOACTONDISKPAGES DSK REQUEST))
0)
(\DISKERROR (IMINUS RESULT)
NIL NIL DSK))
(T RESULT])
(\WRITEVMEMPAGES
[LAMBDA (DSK BUFFERS DAs DAorigin FID FIRSTPAGE LASTPAGE notused notused LASTNUMCHARS HINTLASTPAGE
CAs) (* bvm: " 3-NOV-83 22:41")
(* \WRITEDISKPAGES inside the junk context.
Used by \EXTENDVMEMFILE)
(PROG (RESULT)
(COND
((EQ DSK \SYSDISK)
(SETQ DSK \MAINDISK)))
(UNINTERRUPTABLY
[SETQ RESULT (PROG ((REQUEST \DISKREQUESTBLOCK))
[COND
(CAs (replace DISKCAS of REQUEST with (\ADDBASE CAs (IMINUS
DAorigin]
(replace FIXEDDISKBUFFER of REQUEST with BUFFERS)
(replace DISKDAS of REQUEST with (\ADDBASE DAs (IMINUS DAorigin)))
(replace DISKVERSION of REQUEST with (fetch FPVERSION of FID))
(\BLT (LOCF (fetch DISKSERIAL# of REQUEST))
FID WORDSPERCELL) (* Fill in serial number for label)
(replace DISKFIRSTPAGE of REQUEST with FIRSTPAGE)
(replace DISKLASTPAGE of REQUEST with LASTPAGE)
(replace DISKHINTLASTPAGE of REQUEST with (OR HINTLASTPAGE 0))
(replace DISKNOALLOC of REQUEST with NIL)
(replace DISKWRITELASTNUMCHARS of REQUEST with (OR LASTNUMCHARS
BYTESPERPAGE))
(RETURN (\DOWRITEDISKPAGES DSK REQUEST])
(RETURN (COND
((ILESSP RESULT 0)
(\DISKERROR (IMINUS RESULT)
NIL NIL DSK))
(T (SIGNED RESULT BITSPERWORD])
(\DOACTONDISKPAGES
[LAMBDA (DSK REQUEST CLEANUPFN) (* bvm: "30-DEC-82 13:08")
(PROG ((CAS (fetch DISKCAS of REQUEST))
(DAS (fetch DISKDAS of REQUEST))
(FIRSTPAGE (fetch DISKFIRSTPAGE of REQUEST))
(LASTPAGE (fetch DISKLASTPAGE of REQUEST))
(BUFFER (fetch FIXEDDISKBUFFER of REQUEST))
(HINTLASTPAGE (fetch DISKHINTLASTPAGE of REQUEST))
(RETURNONCHECKERROR (fetch RETURNONCHECKERROR of REQUEST))
CURRENTPAGE CB NEXTCB RESULT THISACTION)
(replace DISKREQUEST of DSK with REQUEST)
(replace CURRENTDAS of DSK with DAS)
(replace DISKERRORCNT of DSK with 0)
(replace SAWCHECKERROR of DSK with NIL)
(replace CBCLEANUPFN of REQUEST with CLEANUPFN)
(COND
((OR (NOT HINTLASTPAGE)
(ILESSP HINTLASTPAGE FIRSTPAGE)
(IGREATERP HINTLASTPAGE LASTPAGE))
(SETQ HINTLASTPAGE LASTPAGE)))
(SETQ CURRENTPAGE FIRSTPAGE)
(* HINTLASTPAGE is used, if reasonable, to terminate activity before LASTPAGE so that we do not chain off the end
and seek to cylinder 0, a typical BFS bug. If the hint is wrong, we just resume from there, having wasted a disk
rotation)
RETRY
(replace CBLASTPTR of DSK with NIL)
(replace CBFREEPTR of DSK with (replace CBPENDINGPTR of DSK with (fetch CBQUEUE
of DSK)))
(SETQ CB (\GETDISKCB DSK)) (* Should never return NIL)
(SETQ RESULT HINTLASTPAGE)
(for PAGENO from CURRENTPAGE to HINTLASTPAGE until (COND
((EQ (\GETBASE DAS PAGENO)
\EOFDA)
(* At end of file, do no more)
(SETQ RESULT (SUB1 PAGENO))
T))
do [SETQ THISACTION (COND
((EQ PAGENO LASTPAGE)
(fetch LASTDISKACTION of REQUEST))
(T (fetch DISKACTION of REQUEST]
[COND
((AND RETURNONCHECKERROR (fetch SAWCHECKERROR of DSK))
(* No disk activity now, because cleanup waited for disk
to stop)
(replace LASTPAGEACTEDON of REQUEST with (SUB1 PAGENO))
(RETURN (SETQ RESULT (LOGAND (IMINUS (IPLUS PAGENO -1 100Q))
177777Q]
(COND
((NEQ THISACTION \DC.NOOP)
(COND
((NULL (SETQ NEXTCB (\GETDISKCB DSK)))
(GO FAILURE)))
[replace (CB CBLABELADDR) of CB
with (\LOLOC (COND
((EQ (\GETBASE DAS (ADD1 PAGENO))
\FILLINDA) (* Chain to next cb, so that the next field from the
label of CB is written into the diskaddress field of
NEXTCB)
(LOCF (fetch (CB CBDA) of NEXTCB)))
(T (LOCF (fetch (CB CBLABNEXT) of NEXTCB]
(\DODISKCOMMAND DSK CB (OR BUFFER (EMPOINTER (\GETBASE CAS PAGENO)))
(\GETBASE DAS PAGENO)
PAGENO THISACTION)
(SETQ CB NEXTCB)))
finally (COND
((AND (fetch CBFREEPTR of DSK)
(NEQ (fetch CBFREEPTR of DSK)
(fetch CBNEXT of CB)))
(RAID "Inconsistency in CBFREEPTR" CB)))
(replace CBFREEPTR of DSK with CB) (* "Put back" the last CB, since it is never used for a
command)
(do (* Wait for commands to complete)
(SELECTQ (\CLEANUPDISKQUEUE DSK)
(NIL (GO FAILURE))
(T (RETURN))
NIL))
(COND
((AND (NEQ RESULT LASTPAGE)
(NEQ (\GETBASE DAS (ADD1 RESULT))
\EOFDA)) (* Stopped before LASTPAGE because of a bad hint.
Ignore hint and continue)
(SETQ HINTLASTPAGE LASTPAGE)
(SETQ CURRENTPAGE (ADD1 RESULT))
(GO RETRY)))
(replace LASTPAGEACTEDON of REQUEST with RESULT))
(RETURN RESULT)
FAILURE
(COND
((ILEQ (fetch DISKERRORCNT of DSK)
(fetch RETRYCOUNT of DSK))
(SETQ CURRENTPAGE (fetch CURRENTDISKPAGE of DSK))
(GO RETRY)))
(RETURN (IMINUS \DSK.HARD.ERROR])
(\DOWRITEDISKPAGES
[LAMBDA (DSK REQUEST) (* bvm: " 7-OCT-83 17:00")
(PROG ((CAS (fetch DISKCAS of REQUEST))
(DAS (fetch DISKDAS of REQUEST))
(FIRSTPAGE (fetch DISKFIRSTPAGE of REQUEST))
(LASTPAGE (fetch DISKLASTPAGE of REQUEST))
(BUFFER (fetch FIXEDDISKBUFFER of REQUEST))
CURRENTPAGE CB FIRSTNEWPAGE LASTVDA LAB)
[COND
((NOT (fetch DISKNOALLOC of REQUEST)) (* First try \ACTONDISKPAGES for any existing pages)
[COND
((EQ (\GETBASE DAS FIRSTPAGE)
\FILLINDA) (* This happens from createfile, no pages exist yet)
(SETQ FIRSTNEWPAGE FIRSTPAGE))
(T [COND
((EQ (\GETBASE DAS (ADD1 FIRSTPAGE))
\EOFDA)
(* FIRSTPAGE is the last existing page of the file, so we will have to rewrite its label anyway later on, so don't
do anything now)
)
(T (* Some of these pages may not need to have their labels
written, so see how far we can get with just
\ACTONDISKPAGES ...)
(replace DISKACTION of REQUEST with (replace LASTDISKACTION of REQUEST
with \DC.WRITED))
(replace RETURNONCHECKERROR of REQUEST with NIL)
(SETQ FIRSTPAGE (\DOACTONDISKPAGES DSK REQUEST))
(COND
((AND (EQ FIRSTPAGE LASTPAGE)
(EQ (fetch DISKWRITELASTNUMCHARS of REQUEST)
(fetch CURRENTNUMCHARS of REQUEST)))
(* All pages acted on, and byte count does not need to
be changed)
(RETURN LASTPAGE))
((ILESSP FIRSTPAGE 0) (* Error)
(RETURN FIRSTPAGE]
(SETQ FIRSTNEWPAGE (ADD1 FIRSTPAGE]
(COND
((ILEQ FIRSTNEWPAGE LASTPAGE)
(* Need to allocate new pages. For this, we need a spare buffer for reading the new pages to make sure they are
free pages)
(replace FIXEDDISKBUFFER of REQUEST with \SPAREDISKWRITEBUFFER)
(replace DISKACTION of REQUEST with (replace LASTDISKACTION of REQUEST
with \DC.READLD))
(do (SETQ LASTVDA (\GETBASE DAS (SUB1 FIRSTNEWPAGE)))
(for I from FIRSTNEWPAGE to LASTPAGE
do (OR (SETQ LASTVDA (\ASSIGNDISKPAGE DSK LASTVDA))
(GO DISKFULL))
(\PUTBASE DAS I LASTVDA)) (* Now check that the pages are really free)
(replace DISKFIRSTPAGE of REQUEST with FIRSTNEWPAGE)
(\DOACTONDISKPAGES DSK REQUEST (FUNCTION \CHECKFREEPAGE))
(* \CHECKFREEPAGE checks to make sure the page is really free, and if it is, stores its address in DAS.
We now march thru DAS, compacting toward the front all the pages that are really free, then iterate allocating
more if necessary)
(for I from FIRSTNEWPAGE to LASTPAGE when (NEQ (SETQ LASTVDA (\GETBASE DAS I))
\FILLINDA)
do (\PUTBASE DAS FIRSTNEWPAGE LASTVDA)
(add FIRSTNEWPAGE 1))
repeatuntil (IGREATERP FIRSTNEWPAGE LASTPAGE]
(replace DISKREQUEST of DSK with REQUEST)
(replace CURRENTDAS of DSK with DAS)
(replace DISKERRORCNT of DSK with 0)
(replace SAWCHECKERROR of DSK with NIL)
(replace CBCLEANUPFN of REQUEST with NIL)
(SETQ CURRENTPAGE FIRSTPAGE)
RETRY
(replace CBLASTPTR of DSK with NIL)
(replace CBFREEPTR of DSK with (replace CBPENDINGPTR of DSK with (fetch CBQUEUE
of DSK)))
(for PAGENO from CURRENTPAGE to LASTPAGE
do (COND
((NULL (SETQ CB (\GETDISKCB DSK)))
(GO FAILURE)))
(COND
((OR (AND (EQ PAGENO LASTPAGE)
(NEQ (fetch DISKWRITELASTNUMCHARS of REQUEST)
BYTESPERPAGE))
(EQ (\GETBASE DAS (ADD1 PAGENO))
\FILLINDA)) (* Mark end of file after this page)
(\PUTBASE DAS (ADD1 PAGENO)
\EOFDA))) (* Set up label with next and previous disk addresses,
numchars)
(SETQ LAB (LOCF (fetch (CB CBLABNEXT) of CB)))
[replace DLNEXT of LAB with (\REALDISKDA DSK (\GETBASE DAS (ADD1 PAGENO]
[replace DLPREVIOUS of LAB with (\REALDISKDA DSK (\GETBASE DAS (SUB1 PAGENO]
(replace DLNUMCHARS of LAB with (COND
((EQ PAGENO LASTPAGE)
(fetch DISKWRITELASTNUMCHARS of REQUEST))
(T BYTESPERPAGE)))
(replace (CB CBLABELADDR) of CB with (\LOLOC LAB))
(\DODISKCOMMAND DSK CB (OR BUFFER (EMPOINTER (\GETBASE CAS PAGENO)))
(\GETBASE DAS PAGENO)
PAGENO \DC.WRITELD)
finally (do (* Wait for commands to complete)
(SELECTQ (\CLEANUPDISKQUEUE DSK)
(NIL (GO FAILURE))
(T (RETURN))
NIL)))
(replace LASTPAGEACTEDON of REQUEST with LASTPAGE)
(RETURN LASTPAGE)
FAILURE
(COND
((ILEQ (fetch DISKERRORCNT of DSK)
(fetch RETRYCOUNT of DSK))
(SETQ CURRENTPAGE (fetch CURRENTDISKPAGE of DSK))
(GO RETRY)))
(RETURN (IMINUS \DSK.HARD.ERROR))
DISKFULL
(RETURN (IMINUS \DSK.FULL.ERROR])
(\CHECKFREEPAGE
[LAMBDA (DSK CB) (* bvm: " 9-DEC-82 13:41")
(* Check that CB got a free page, i.e. one whose file id
is all -1)
(PROG [(FID (LOCF (fetch DLFID of (EMPOINTER (fetch (CB CBLABELADDR) of CB]
[FRPTQ 3 (PROGN (COND
((NEQ (\GETBASE FID 0)
(UNSIGNED -1 BITSPERWORD))
(* Oops, bittable was wrong, so nullify this guy's
address in caller)
(\PUTBASE (fetch (DSKOBJ DISKDAS) of DSK)
(fetch (CB CBPAGENO) of CB)
\FILLINDA)
(RETURN)))
(SETQ FID (\ADDBASE FID 1]
(RETURN T])
(\DODISKCOMMAND
[LAMBDA (DSK CB BUFFER VDA PAGENO ACTION NEXTCB) (* bvm: " 6-JAN-83 16:35")
(PROG ((SHORTCB (fetch SHORTCB of CB))
LA NEXT LASTCB STATUS)
[replace CBHEADERADDR of SHORTCB with (\LOLOC (LOCF (fetch CBHEADER of SHORTCB]
(replace CBDATAADDR of SHORTCB with (\LOLOC BUFFER))
[COND
((ZEROP (SETQ LA (fetch CBLABELADDR of SHORTCB)))
(* Fill this in only if caller hasn't)
(replace CBLABELADDR of SHORTCB with (SETQ LA
(\LOLOC (COND
(NEXTCB (LOCF (fetch (CB CBDA)
of NEXTCB)))
(T (LOCF (fetch (CB CBLABNEXT)
of CB]
(SETQ LA (EMPOINTER LA))
(\BLT (LOCF (fetch DLFID of LA))
(fetch (DSKOBJ DISKFID) of DSK)
3) (* Set serial number for label check)
(replace DLPAGENO of LA with PAGENO)
(replace CBPAGENO of CB with PAGENO)
[COND
((NEQ VDA \FILLINDA)
(replace CBDA of SHORTCB with (\REALDISKDA DSK VDA]
(replace CBCOMMAND of SHORTCB
with (IPLUS (SELECTC ACTION
(\DC.READHLD \IDC.READHLD)
(\DC.READLD \IDC.READLD)
(\DC.READD \IDC.READD)
(\DC.WRITEHLD \IDC.WRITEHLD)
(\DC.WRITELD \IDC.WRITELD)
(\DC.WRITED \IDC.WRITED)
(\DC.SEEKONLY \IDC.SEEKONLY)
(\DC.RESTORE (replace CBDA of SHORTCB
with (ADD1 (LOGAND (fetch CBDA of SHORTCB)
170000Q)))
(* Track ← 0, Restore ← 1, so command is seek to track
zero)
\IDC.SEEKONLY)
(RAID "Invalid disk action" ACTION))
(LLSH (fetch DSKPARTITION of DSK)
10Q)))
(SETQ LASTCB (EMGETBASE \EM.DISKCOMMAND))
[COND
((NEQ LASTCB 0) (* Disk is busy, queue CB up at end)
(while (NEQ (SETQ NEXT (fetch CBLINK of (EMPOINTER LASTCB)))
0)
do (SETQ LASTCB NEXT))
(replace CBLINK of (EMPOINTER LASTCB) with (\LOLOC SHORTCB]
[COND
([AND (ZEROP (EMGETBASE \EM.DISKCOMMAND))
(OR (ZEROP LASTCB)
(ZEROP (fetch CBDONE of SHORTCB]
(* No CB's queued, so ours is the only one, and it hasn't been done yet. Careful here! If the last disk command
got an error, we don't want to do this. Also true if last disk command was never executed, which means that some
earlier command got an error)
(COND
([OR (NOT (SETQ LASTCB (fetch CBLASTPTR of DSK)))
(AND [NOT (ZEROP (SETQ STATUS (LOGAND (fetch (CB CBSTATUS) of LASTCB)
\CBS.GOODMASK]
(ZEROP (LOGAND STATUS \CBS.ERRORBITS]
(EMPUTBASE \EM.DISKCOMMAND (\LOLOC SHORTCB]
(replace CBQSTATUS of CB with \CB.PENDING)
(replace CBLASTPTR of DSK with CB)
(\BOXIPLUS (LOCF (fetch DISKOPS of \MISCSTATS))
1])
(\GETDISKCB
[LAMBDA (DSK) (* bvm: "24-NOV-82 18:12")
(* Gets a new CB, clearing it out, or returns NIL if there are errors. In latter case, caller should retry
starting with CURRENTPAGE (set freely by \CLEANUPDISKQUEUE))
(PROG (CB)
LP (RETURN (COND
((SETQ CB (fetch CBFREEPTR of DSK))
[replace CBFREEPTR of DSK with (COND
((EQ (fetch CBNEXT of CB)
(fetch CBPENDINGPTR of DSK))
(* Circular buffer; when pointers are equal means
everyone is free. Free = NIL means nobody is free)
NIL)
(T (fetch CBNEXT of CB]
(\CLEARCB CB)
CB)
((NOT (\CLEANUPDISKQUEUE DSK)) (* an error occurred)
NIL)
(T (* A CB was returned to the free queue)
(GO LP])
(\CLEARCB
[LAMBDA (CB) (* bvm: "23-NOV-82 17:09")
(\ZEROWORDS (fetch SHORTCB of CB)
(\ADDBASE (fetch SHORTCB of CB)
(SUB1 \LENSHORTCB)))
(replace CBQSTATUS of CB with \CB.FREE)
CB])
(\CLEANUPDISKQUEUE
[LAMBDA (DSK) (* bvm: " 3-JAN-83 14:06")
(* Called to process pending CB's. If queue is empty and all is quiet, returns T. Returns NIL on errors, after
running error routine. Otherwise, returns a finished CB, which has also been placed on \FREEDISKCBS by this
action)
(PROG ((CB (fetch CBPENDINGPTR of DSK))
(FREE (fetch CBFREEPTR of DSK))
SHORTCB LABEL LVDA)
(COND
((EQ CB FREE)
(RETURN T)))
LP (* Wait for disk to finish something)
(SETQ SHORTCB (fetch SHORTCB of CB))
(COND
((ZEROP (fetch CBDONE of SHORTCB)) (* Command not done yet)
[COND
((AND (ZEROP (EMGETBASE \EM.DISKCOMMAND))
(ZEROP (fetch CBDONE of SHORTCB))) (* Disk queue was flushed for some reason.
Fake an error)
(COND
((NEQ (fetch CBQSTATUS of CB)
\CB.PENDING)
(RETURN (RAID "No free CB's")))
(T (replace CBSTATUS of SHORTCB with \CBS.FAKEERROR]
(* Here is where some day we could block to let another
process run)
(GO LP))) (* We now have CB free from the disk controller)
(replace CBPENDINGPTR of DSK with (fetch CBNEXT of CB))
(COND
((EQ CB (fetch CBLASTPTR of DSK))
(replace CBLASTPTR of DSK with NIL))) (* Remove from pending queue)
(replace CBSHORTSEAL of SHORTCB with 0) (* Invalidate it as a disk command, just in case)
[COND
((NOT FREE)
(replace CBFREEPTR of DSK with (SETQ FREE CB]
(* Now clean up the transfer)
(COND
((EQ (fetch RESTORE of (fetch CBDA of SHORTCB))
1) (* This is our command, not user's, so nothing to
cleanup)
(RETURN CB)))
[COND
((NEQ (LOGAND (fetch CBSTATUS of SHORTCB)
\CBS.GOODMASK)
\CBS.GOOD) (* Error occurred)
(repeatuntil (ZEROP (EMGETBASE \EM.DISKCOMMAND)))
(* Wait for disk to stop spinning)
(COND
((NEQ (fetch TOTALDISKERRORS of DSK)
MAX.SMALL.INTEGER) (* Keep this count for debugging)
(add (fetch TOTALDISKERRORS of DSK)
1)))
(RETURN (COND
[(IGREATERP (add (fetch DISKERRORCNT of DSK)
1)
(fetch RETRYCOUNT of DSK))
(* Hard error)
(COND
(\DISKDEBUG (* Error is normally fielded in a more benign place)
(RAID "Hard Disk Error. ↑N to continue" CB]
(T (COND
((EQ (fetch CBFINALSTATUS of SHORTCB)
\CBS.CHECKERROR)
(replace SAWCHECKERROR of DSK with T)))
(replace CURRENTDISKPAGE of DSK with (fetch CBPAGENO of CB))
(COND
((IGREATERP (fetch DISKERRORCNT of DSK)
(LRSH (fetch RETRYCOUNT of DSK)
1)) (* Half the tolerable errors.
Initiate a Restore to let disk recalibrate)
(EMPUTBASE \EM.DISKADDRESS (UNSIGNED -1 BITSPERWORD))
(* This forces a seek)
(\DODISKCOMMAND DSK (\GETDISKCB DSK)
NIL
(\VIRTUALDISKDA DSK (fetch CBDA of SHORTCB))
(fetch CURRENTDISKPAGE of DSK)
\DC.RESTORE)))
NIL]
(SETQ LABEL (EMPOINTER (fetch CBLABELADDR of SHORTCB)))
(replace (DSKOBJ CURRENTNUMCHARS) of DSK with (fetch DLNUMCHARS of LABEL))
(replace DISKERRORCNT of DSK with 0)
(replace SAWCHECKERROR of DSK with NIL)
[COND
((fetch (DSKOBJ CBCLEANUPFN) of DSK)
(APPLY* (fetch (DSKOBJ CBCLEANUPFN) of DSK)
DSK CB))
(T [SETQ LVDA (\ADDBASE (fetch CURRENTDAS of DSK)
(SUB1 (fetch CBPAGENO of CB]
[COND
((EQ (\GETBASE LVDA 2)
\FILLINDA) (* Fill in Next address)
(\PUTBASE LVDA 2 (\VIRTUALDISKDA DSK (fetch DLNEXT of LABEL]
(COND
((EQ (\GETBASE LVDA 0)
\FILLINDA) (* Fill in Previous address)
(\PUTBASE LVDA 0 (\VIRTUALDISKDA DSK (fetch DLPREVIOUS of LABEL]
(RETURN CB])
(\VIRTUALDISKDA
[LAMBDA (DSK REALDA) (* bvm: "23-NOV-82 16:40")
(* Converts a real disk address into a virtual one)
(COND
((ZEROP REALDA)
\EOFDA)
(T (IPLUS (ITIMES (IPLUS (ITIMES (IPLUS (ITIMES (fetch DISK of REALDA)
(fetch NTRACKS of DSK))
(fetch TRACK of REALDA))
(fetch NHEADS of DSK))
(fetch HEAD of REALDA))
(fetch NSECTORS of DSK))
(fetch SECTOR of REALDA])
(\REALDISKDA
[LAMBDA (DSK VDA) (* bvm: "18-NOV-82 21:16")
(* Returns a real disk address for given virtual
address)
(COND
((EQ VDA \EOFDA)
0)
(T (PROG ((NSECTORS (fetch NSECTORS of DSK))
(NHEADS (fetch NHEADS of DSK))
(NTRACKS (fetch NTRACKS of DSK)))
(RETURN (IPLUS (LLSH (IREMAINDER VDA NSECTORS)
14Q)
(LLSH (IREMAINDER (SETQ VDA (IQUOTIENT VDA NSECTORS))
NHEADS)
2)
(LLSH (IREMAINDER (SETQ VDA (IQUOTIENT VDA NHEADS))
NTRACKS)
3)
(LLSH (IQUOTIENT VDA NTRACKS)
1])
)
(DECLARE: EVAL@COMPILE DONTCOPY
(RPAQQ CBSTATUSCONSTANTS ((\CBS.ERRORBITS 183)
(\CBS.GOODMASK 4023)
(\CBS.GOOD 3840)
(\CBS.FAKEERROR 3841)
(\CBS.CHECKERROR 2)))
(DECLARE: EVAL@COMPILE
(RPAQQ \CBS.ERRORBITS 183)
(RPAQQ \CBS.GOODMASK 4023)
(RPAQQ \CBS.GOOD 3840)
(RPAQQ \CBS.FAKEERROR 3841)
(RPAQQ \CBS.CHECKERROR 2)
(CONSTANTS (\CBS.ERRORBITS 183)
(\CBS.GOODMASK 4023)
(\CBS.GOOD 3840)
(\CBS.FAKEERROR 3841)
(\CBS.CHECKERROR 2))
)
(RPAQQ IDISKCOMMANDS ((\IDC.READHLD 18432)
(\IDC.READLD 18496)
(\IDC.READD 18512)
(\IDC.WRITEHLD 18600)
(\IDC.WRITELD 18536)
(\IDC.WRITED 18520)
(\IDC.SEEKONLY 18434)))
(DECLARE: EVAL@COMPILE
(RPAQQ \IDC.READHLD 18432)
(RPAQQ \IDC.READLD 18496)
(RPAQQ \IDC.READD 18512)
(RPAQQ \IDC.WRITEHLD 18600)
(RPAQQ \IDC.WRITELD 18536)
(RPAQQ \IDC.WRITED 18520)
(RPAQQ \IDC.SEEKONLY 18434)
(CONSTANTS (\IDC.READHLD 18432)
(\IDC.READLD 18496)
(\IDC.READD 18512)
(\IDC.WRITEHLD 18600)
(\IDC.WRITELD 18536)
(\IDC.WRITED 18520)
(\IDC.SEEKONLY 18434))
)
(DECLARE: EVAL@COMPILE
(RPAQQ \EM.DISKCOMMAND 337)
(RPAQQ \EM.DISKADDRESS 339)
(RPAQQ \FIXEDLENDISKREQUEST 42)
(RPAQQ \DEFAULTDASTORAGELENGTH 60)
(RPAQQ \LENCB 6)
(RPAQQ \LENDSKOBJ 34)
(RPAQQ \LENSHORTCB 18)
(CONSTANTS (\EM.DISKCOMMAND 337)
(\EM.DISKADDRESS 339)
(\FIXEDLENDISKREQUEST 42)
(\DEFAULTDASTORAGELENGTH 60)
(\LENCB 6)
(\LENDSKOBJ 34)
(\LENSHORTCB 18))
)
(DECLARE: EVAL@COMPILE
(RPAQQ \CB.PENDING 1)
(RPAQQ \CB.FREE 0)
(CONSTANTS (\CB.PENDING 1)
(\CB.FREE 0))
)
)
(* At MAKEINIT time)
(DEFINEQ
(MAKEINITBFS
[LAMBDA NIL (* bvm: " 8-DEC-82 13:10")
(* Called at MAKEINIT time to create bfs structures)
(\LOCKCELL (SETQ \MAINDISK (create DSKOBJ))
\LENDSKOBJ)
(replace DISKDEVICENAME of \MAINDISK with (EVQ (QUOTE DSK)))
(\LOCKCELL (SETQ \SWAPREQUESTBLOCK (create DISKREQUEST))
(IPLUS \FIXEDLENDISKREQUEST \DEFAULTDASTORAGELENGTH))
(\LOCKCELL (SETQ \DISKREQUESTBLOCK (create DISKREQUEST))
(IPLUS \FIXEDLENDISKREQUEST \DEFAULTDASTORAGELENGTH))
(to 3 bind PREV (CB ←(create CB))
first (\LOCKCELL CB \LENCB)
(SETQ PREV CB)
do (\LOCKCELL CB \LENCB)
(SETQ PREV (create CB
CBNEXT ← PREV))
finally (replace CBNEXT of CB with PREV)
(replace CBQUEUE of \MAINDISK with CB))
(SETQ \FREEPAGEFID (\ALLOCBLOCK 3)) (* FP or FID for free disk page is all -1)
(for I from 0 to 4 do (\PUTBASE \FREEPAGEFID I (UNSIGNED -1 BITSPERWORD])
)
(DECLARE: DONTCOPY
(ADDTOVAR INITPTRS (\MAINDISK)
(\SWAPREQUESTBLOCK)
(\DISKREQUESTBLOCK)
(\FREEPAGEFID))
(ADDTOVAR INEWCOMS (FNS MAKEINITBFS))
EVAL@COMPILE
(ADDTOVAR DONTCOMPILEFNS MAKEINITBFS)
)
(* Swap stuff)
(DEFINEQ
(\M44ACTONVMEMFILE
[LAMBDA (FIRSTPAGE BUFFER NPAGES WRITEFLG) (* bvm: "31-MAR-83 17:46")
(PROG ((LASTPAGE (IPLUS FIRSTPAGE NPAGES -1))
(DAs \ISFSCRATCHDAS)
(CAs \ISFSCRATCHCAS)
(PAGE FIRSTPAGE)
(BUF BUFFER)
CHUNK)
[COND
((AND (IGEQ LASTPAGE (\GETBASE \ISFMAP (fetch ISFLAST of \ISFMAP)))
(EQ (\LOOKUPFMAP FIRSTPAGE)
\FILLINDA))
(RETURN (RAID "Can't complete swap operation--page not in isf map"]
(while (IGREATERP NPAGES 0)
do (SETQ CHUNK (IMIN NPAGES \ISFCHUNKSIZE))
(for I from 0 to (SUB1 CHUNK)
do (\PUTBASE CAs I (\LOLOC BUF))
(\PUTBASE DAs I (\LOOKUPFMAP (IPLUS PAGE I)))
(SETQ BUF (\ADDBASE BUF WORDSPERPAGE)))
(\PUTBASE DAs CHUNK \FILLINDA)
(\ACTONVMEMPAGES \MAINDISK NIL DAs PAGE NIL PAGE (IPLUS PAGE CHUNK -1)
(COND
(WRITEFLG \DC.WRITED)
(T \DC.READD))
NIL NIL NIL NIL CAs)
(SETQ NPAGES (IDIFFERENCE NPAGES CHUNK))
(SETQ PAGE (IPLUS PAGE CHUNK)))
(RETURN LASTPAGE])
(\INSUREVMEMFILE
[LAMBDA (FIRSTPAGE LASTPAGE) (* bvm: "31-MAR-83 17:46")
(COND
([AND (NEQ \MACHINETYPE \DANDELION)
(IGEQ LASTPAGE (\GETBASE \ISFMAP (fetch ISFLAST of \ISFMAP]
(\EXTENDVMEMFILE FIRSTPAGE LASTPAGE T])
(\MAYBE.EXTENDVMEMFILE
[LAMBDA (LASTPAGE) (* bvm: "31-MAR-83 17:47")
(DECLARE (SPECVARS \EXTENDINGVMEMFILE))
(COND
((AND (NEQ \MACHINETYPE \DANDELION)
(IGEQ LASTPAGE (\GETBASE \ISFMAP (fetch ISFLAST of \ISFMAP)))
(NOT \EXTENDINGVMEMFILE)) (* Last condition fights recursion.
Opening diskdescriptor may cause \NEWPAGE)
(PROG ((\EXTENDINGVMEMFILE T))
(* When we do this in lisp and can ensure that no page allocation happens inside us: (OR (fetch DDVALID of
\MAINDISK) (\OPENDISKDESCRIPTOR \MAINDISK)) (* BFS page allocation may be necessary, so take care of this))
(\MISCAPPLY*(FUNCTION \EXTENDVMEMFILE)
LASTPAGE LASTPAGE])
(\LOOKUPFMAP
[LAMBDA (PAGE) (* bvm: "12-NOV-82 14:13")
(* Returns DA for PAGE out of \ISFMAP. The map consists of pairs <first page# of run> <da>, with the first entry
at \ISFMAPOFFSET and the last at \ISFMAP:ISFLAST being the first page beyond the scanned part of the file)
(PROG ((HI (fetch ISFLAST of \ISFMAP))
(LO \ISFMAPOFFSET)
MID)
[COND
((EQ PAGE (fetch ISFONEPAGE of \ISFMAP)) (* This is in case runtable overflows)
(RETURN (fetch ISFONEDA of \ISFMAP]
(COND
((IGEQ PAGE (\GETBASE \ISFMAP HI)) (* Should never happen)
(RETURN \FILLINDA)))
[while (IGREATERP HI (IPLUS LO 2))
do (SETQ MID (FLOOR (FOLDLO (IPLUS LO HI)
2)
2)) (* Do binary chop on map. Page numbers are all at even
offsets)
(COND
((IGEQ PAGE (\GETBASE \ISFMAP MID))
(SETQ LO MID))
(T (SETQ HI MID]
(SETQ LO (\ADDBASE \ISFMAP LO))
(RETURN (IPLUS (\GETBASE LO 1)
(IDIFFERENCE PAGE (\GETBASE LO 0])
(\EXTENDVMEMFILE
[LAMBDA (FIRSTPAGE LASTPAGE MAPONLY) (* bvm: "21-DEC-82 11:08")
(* Called when LASTPAGE is not in the ISF map. Might simply need to look up some new pages;
if we have already scanned the whole file, however, we will need to extend the file itself.
Returns error code on failure)
(PROG ((SCRATCHBUF \SPAREDISKWRITEBUFFER)
(DAs \ISFSCRATCHDAS)
(FIRSTDA (\LOOKUPFMAP FIRSTPAGE))
[LASTFULLPAGE (SUB1 (\GETBASE \ISFMAP (fetch ISFLAST of \ISFMAP]
(LASTNEEDEDPAGE LASTPAGE)
NP LASTPAGEREAD LASTPAGEWRITTEN LASTPAGEADDR LASTPAGEOFFSET P1)
(* Use \SPAREDISKWRITEBUFFER as a scratch buf, assuming this is not called while \DOWRITEDISKPAGES is happening
(because \DOWRITEDISKPAGES is locked). If it turns out we actually need to invoke \DOWRITEDISKPAGES ourselves,
then we better not have been writing the disk anyway, in which case we steal a different disk buffer)
(while (ILESSP LASTFULLPAGE LASTNEEDEDPAGE)
do (SETQ NP (IDIFFERENCE \ISFCHUNKSIZE 2))
[\PUTBASE DAs 0 (COND
((EQ LASTFULLPAGE 0)
\EOFDA)
(T (\LOOKUPFMAP (SUB1 LASTFULLPAGE]
(\PUTBASE DAs 1 (\LOOKUPFMAP LASTFULLPAGE))
(* Will operate on LASTFULLPAGE plus as many remaining
pages as desired. NP is number of new pages)
(for I from 2 to (IPLUS NP 2) do (\PUTBASE DAs I \FILLINDA))
(* \FILLINDA for NP starting at first unknown page.
Last one is bonus)
(SETQ LASTPAGEREAD (\ACTONVMEMPAGES \MAINDISK SCRATCHBUF DAs (SUB1 LASTFULLPAGE)
NIL LASTFULLPAGE (IPLUS LASTFULLPAGE NP)
\DC.READD NIL NIL NIL (fetch ISFHINTLASTPAGE
of \ISFMAP)))
(SETQ LASTPAGEOFFSET (IPLUS (IDIFFERENCE LASTPAGEREAD LASTFULLPAGE)
2)) (* Offset in DAs of one past LASTPAGEREAD)
[COND
((OR (NEQ (fetch CURRENTNUMCHARS of \SWAPREQUESTBLOCK)
BYTESPERPAGE)
(EQ (\GETBASE DAs LASTPAGEOFFSET)
\EOFDA)) (* Read to EOF. The second condition should never be
needed, but if file is malformed at the end we would be
in trouble)
(COND
((ILEQ LASTPAGEOFFSET 3) (* No pages were acted on, so extend simply)
(RETURN (\BCPL.EXTENDVMEMFILE LASTNEEDEDPAGE)))
(T
(* Too hard to do both. Fill in part of map now, and extend the file on the next iteration.
Number of good pages read was LASTPAGEREAD-1-LASTFULLPAGE)
(SETQ NP (IDIFFERENCE LASTPAGEOFFSET 3]
[for I from 1 to NP
do (\EXTENDISFMAP (IPLUS LASTFULLPAGE I)
(\GETBASE DAs (ADD1 I)))
(COND
((EQ (IPLUS LASTFULLPAGE I)
FIRSTPAGE)
(SETQ FIRSTDA (\GETBASE DAs (ADD1 I]
(SETQ LASTFULLPAGE (IPLUS LASTFULLPAGE NP)))
(\EXTENDISFMAP FIRSTPAGE FIRSTDA) (* just in case map is full, this will set ONEPAGE and
ONEDA for \LOOKUPFMAP)
(COND
((NEQ (fetch ISFREWRITE of \ISFMAP)
0) (* Write map back onto file)
(PROG ((CAs \ISFSCRATCHCAS))
(\PUTBASE DAs 0 \EOFDA)
(\PUTBASE DAs 1 (fetch ISFDA0 of \ISFMAP))
(\PUTBASE DAs 2 (fetch ISFDA1 of \ISFMAP))
(\PUTBASE DAs 3 (fetch ISFDA2 of \ISFMAP))
(\PUTBASE CAs 1 (LOLOC SCRATCHBUF))
(\PUTBASE CAs 2 (LOLOC \ISFMAP)) (* Set up to write leader page and first data page of
file)
(SETQ P1
(COND
(LASTPAGEWRITTEN (* File was extended, so need to rewrite leader page,
too)
(\ACTONVMEMPAGES \MAINDISK NIL DAs -1 NIL 0 0 \DC.READD NIL
NIL NIL NIL CAs)
(* Read leader page)
(replace LastPageAddress of \EMUSWAPBUFFERS with
LASTPAGEADDR)
(replace ISFHINTLASTPAGE of \ISFMAP
with (replace LastPageNumber of \EMUSWAPBUFFERS
with LASTPAGEWRITTEN))
(replace LastPageByteCount of \EMUSWAPBUFFERS with 0)
0)
(T 1)))
(\ACTONVMEMPAGES \MAINDISK NIL DAs -1 NIL P1 1 \DC.WRITED NIL NIL NIL NIL CAs])
(\LISP.EXTENDVMEMFILE
[LAMBDA NIL (* bvm: "17-DEC-82 13:40")
(* Was inside \EXTENDVMEMFILE.
Not used)
(PROG ((BUF \EMUDISKBUFFERS))
(COND
(MAPONLY (RAID "Unexpected attempt to extend vmemfile. ↑N to try to continue")))
(\ZEROPAGE (fetch (POINTER PAGE#) of BUF)) (* Want to write new pages blankly, I think)
(\PUTBASE DAs LASTPAGEOFFSET \FILLINDA) (* \ACTONDISKPAGES had set it to \EOFDA)
(\PUTBASE DAs (IPLUS NP 3)
\EOFDA)
(* We will rewrite LASTPAGEREAD, making it a full page and linking it to the NP+1 new pages, the last of which is
a blank page (and not placed in the isfmap, which is a bit of a misfeature))
(SETQ LASTPAGEWRITTEN (\WRITEVMEMPAGES \SYSDISK BUF DAs (SUB1 LASTFULLPAGE)
\ISFMAP LASTPAGEREAD (IPLUS LASTFULLPAGE NP 1)
NIL NIL 0))
(SETQ LASTPAGEADDR (\GETBASE DAs (IPLUS NP 2))) (* for rewriting leader page hint)
])
(\BCPL.EXTENDVMEMFILE
[LAMBDA (LASTPAGE) (* bvm: "19-DEC-82 14:48")
(\M44FLUSHDISKDESCRIPTOR \MAINDISK)
(replace DDVALID of \MAINDISK with NIL)
(COND
((ILESSP (PROG1 (fetch ISFLAST of \ISFMAP)
(\MOREVMEMFILE LASTPAGE))
(fetch ISFLAST of \ISFMAP))
(\WARN.OF.BADVMEM)))
NIL])
(\EXTENDISFMAP
[LAMBDA (PAGE DA) (* bvm: "19-DEC-82 14:48")
(* extend map to include the knowledge that DA is
address of PAGE)
(PROG ((LASTOFFSET (fetch ISFLAST of \ISFMAP))
LASTPAGE LASTMAP)
(replace ISFONEPAGE of \ISFMAP with PAGE)
(replace ISFONEDA of \ISFMAP with DA)
(SETQ LASTMAP (\ADDBASE \ISFMAP (IDIFFERENCE LASTOFFSET 2)))
(* LASTMAP points at the last Page, DA pair in map)
(COND
((NEQ (SETQ LASTPAGE (\GETBASE LASTMAP 2))
PAGE)
(RETURN)))
[COND
([EQ DA (IPLUS (\GETBASE LASTMAP 1)
(IDIFFERENCE LASTPAGE (\GETBASE LASTMAP 0]
(* Still in same chunk)
(\PUTBASE LASTMAP 2 (ADD1 LASTPAGE)))
(T (* Start new chunk)
(COND
((EQ LASTOFFSET (fetch ISFEND of \ISFMAP))
(* No more space in map)
(RETURN))
(T (\WARN.OF.BADVMEM)
(\PUTBASE LASTMAP 3 DA) (* DA corresponding to LASTPAGE=PAGE)
(\PUTBASE LASTMAP 4 (ADD1 LASTPAGE))
(replace ISFLAST of \ISFMAP with (IPLUS LASTOFFSET 2]
(RETURN T])
(\WARN.OF.BADVMEM
[LAMBDA NIL (* bvm: " 1-JUN-83 23:26")
(COND
((NOT \FRAGMENTATIONWARNED)
(RAID
"Extending {DSK}LISP.VIRTUALMEM.
This fragmentation will likely degrade swapping performance, so you
may want to rebuild your LISP.VIRTUALMEM, making it larger.
----- ↑N to continue now -----
Number of segments that are now in your vmem:"
(IQUOTIENT (IPLUS (fetch ISFLAST of \ISFMAP)
2
(IMINUS \ISFMAPOFFSET))
2))
(SETQ \FRAGMENTATIONWARNED T])
)
(DECLARE: EVAL@COMPILE DONTCOPY
[DECLARE: EVAL@COMPILE
(BLOCKRECORD ISFMAP ((NIL 5 WORD) (* First 5 words are a FP)
(ISFDA0 WORD) (* DA's of the first 3 pages of file)
(ISFDA1 WORD)
(ISFDA2 WORD)
(ISFSEAL WORD)
(ISFDISK WORD) (* points to a DSKOBJ for file)
(NIL WORD) (* ZONE)
(ISFLAST WORD) (* offset of last entry in map)
(ISFEND WORD) (* Offset of end of space for map)
(ISFONEPAGE WORD) (* Last page# added to map)
(ISFONEDA WORD) (* its DA)
(ISFREWRITE WORD) (* non-zero if map should be rewritten when file is
extended)
(ISFCHUNKSIZE WORD) (* if file needs to be extended, do so in this size
unit)
(ISFHINTLASTPAGE WORD) (* Hint of last page)
(ISFMAPSTART WORD)
(* Map entries follow. Each is two words: the page number of the start of a run, followed by the vda of that first
page)
))
]
(DECLARE: EVAL@COMPILE
(RPAQQ \ISFMAPOFFSET 18)
(CONSTANTS (\ISFMAPOFFSET 18))
)
(ADDTOVAR DONTCOMPILEFNS \LISP.EXTENDVMEMFILE)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS \FRAGMENTATIONWARNED)
)
)
(RPAQ? \DISKDEBUG )
(RPAQ? \EXTENDINGVMEMFILE )
(RPAQ? \MAXSWAPBUFFERS 1)
(RPAQ? \FRAGMENTATIONWARNED )
(ADDTOVAR \SYSTEMCACHEVARS \FRAGMENTATIONWARNED)
(DECLARE: DONTCOPY
(ADDTOVAR INEWCOMS (ALLOCAL (ADDVARS (LOCKEDFNS ERROR RAID \M44ACTONVMEMFILE \ACTONVMEMFILESUBR
\ACTONVMEMPAGES \CLEANUPDISKQUEUE \CLEARCB \DISKERROR
\DOACTONDISKPAGES \DODISKCOMMAND \EXTENDISFMAP
\EXTENDVMEMFILE \GETDISKCB \INITBFS \INSUREVMEMFILE
\LISPERROR \LOOKUPFMAP \REALDISKDA \VIRTUALDISKDA
\WARN.OF.BADVMEM \ZEROPAGE \ZEROWORDS \TESTPARTITION)
(LOCKEDVARS \DISKREQUESTBLOCK \SWAPREQUESTBLOCK \MAINDISK
\ISFCHUNKSIZE \EMUSCRATCH \EMUDISKBUFFERS
\EMUSWAPBUFFERS \EMUDISKBUFEND \MAXSWAPBUFFERS
\#DISKBUFFERS \InterfacePage \ISFMAP \ISFSCRATCHCAS
\ISFSCRATCHDAS \SYSDISK \#SWAPBUFFERS \MAXDISKDAs
%%STREAMTYPE# \DISKDEBUG \MAXSWAPBUFFERS
\SPAREDISKWRITEBUFFER \#EMUBUFFERS \EMUBUFFERS
\FRAGMENTATIONWARNED))))
)
(PUTPROPS LLBFS COPYRIGHT ("Xerox Corporation" 1982 1983 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (3980 16397 (\INITBFS 3990 . 7285) (\TESTPARTITION 7287 . 7749) (\ACTONDISKPAGES 7751 .
12456) (\WRITEDISKPAGES 12458 . 15655) (\DISKERROR 15657 . 16395)) (30860 55337 (\ACTONVMEMPAGES 30870
. 32061) (\WRITEVMEMPAGES 32063 . 33737) (\DOACTONDISKPAGES 33739 . 38129) (\DOWRITEDISKPAGES 38131
. 43700) (\CHECKFREEPAGE 43702 . 44495) (\DODISKCOMMAND 44497 . 47728) (\GETDISKCB 47730 . 48749) (
\CLEARCB 48751 . 49035) (\CLEANUPDISKQUEUE 49037 . 54010) (\VIRTUALDISKDA 54012 . 54610) (\REALDISKDA
54612 . 55335)) (57072 58238 (MAKEINITBFS 57082 . 58236)) (58491 69971 (\M44ACTONVMEMFILE 58501 .
59584) (\INSUREVMEMFILE 59586 . 59868) (\MAYBE.EXTENDVMEMFILE 59870 . 60656) (\LOOKUPFMAP 60658 .
61832) (\EXTENDVMEMFILE 61834 . 66392) (\LISP.EXTENDVMEMFILE 66394 . 67533) (\BCPL.EXTENDVMEMFILE
67535 . 67933) (\EXTENDISFMAP 67935 . 69425) (\WARN.OF.BADVMEM 69427 . 69969)))))
STOP