// SpruceStreams.Bcpl -- Spruce Streams -- built on "Spruce Files"
// Errors 2200
// This file contains a set of routines for implementing
// Spruce streams, one or more of which may
// rove over each Spruce File. There is also one function,
// SetEof, that logically belongs with fast streams -- it is a
// specialization of SetEof -- Puts at eof becomes an error
get "SpruceFiles.d"
get "spruce.d"
// Spruce Streams
// incoming statics
external [
// from OS
DefaultArgs; Zero; RetryCall; Endofs; Usc
sysZone; SysErr; Gets; Puts
// From Spruce
FSGet; FSGetX; FSPut; DPzero
// From SpruceFiles
AccessSpruceFile; UnAccessSpruceFile; PutSprucePage; GetSprucePage
FileLeng; InitSpruceFile
// From Spruce Utilities
SpruceError; Umin; Min; Max; PosToPage; PageToPos; SpruceCondition
// From AltoByteBlt
ByteBlt
// From SpruceMl -- Window nomenclature is temporary
WindowRead; WindowReadByte
WindowWrite; WindowWriteByte
spruceStream
// PageEvent // !!! monitoring stuff
]
// outgoing procedures
external [
WindowCreateStream; WindowSetPage; WindowPositionPtr; WindowSetPosition;
WindowGetPosition; WindowFlush; WindowClose
WindowReadBlock; WindowWriteBlock; WindowSetBounds; StreamError
WindowNextPage; WindowGetBounds; WindowRead2Bytes; WindowCopy;
WindowFile; WindowOddByte; WindowWordsPerPage
CurrentPos // ~~ a good idea? rename?
SetupWindowStream; EofError; PutEofError
]
// Create stream -- optional arguments allow specification of type, item size,
// first position, direction to read (unused for now). Uses spruceFile's zone.
// Currently returns 0 only if file cannot be accessed according to type
let WindowCreateStream(spruceFile, type, itemSize, ahead, filePos, errRtn, stepSize; numargs na) = valof
[
let numBuffers = spruceFile>>SPruceFile.numBuffers
// half the distance for trident -- adj. before default subst, since numBuffers already adjtd.
if spruceFile>>SPruceFile.deviceCode eq DISKT80 then ahead = (ahead+(ahead<0? -1, 1)) rshift 1
DefaultArgs(lv na, -1, ksTypeReadWrite, wordItem, numBuffers, DPzero, SysErr, 1)
if ahead ge numBuffers then ahead = Max(1, numBuffers-1) // leave some room
unless spruceFile>>SPruceFile.valid do InitSpruceFile(spruceFile)
unless AccessSpruceFile(spruceFile,
(type eq ksTypeReadOnly? spruceReadAccess, spruceWriteAccess)) resultis 0
let zone = spruceFile>>SPruceFile.zone
let s = FSGetX(lSS,zone,0)
// Modified code from InitializeFstream in FastStreams
CopyTemplate(s, spruceStream, lFSx)
s>>FSx.getOverflow = GetOverflow
s>>FSx.putOverflow = PutOverflow
s>>SS.getTwoBytesOverflow = GetTwoBytes // ~~ wouldn't fit in FSx
s>>FSx.putTwoBytesOverflow = PutTwoBytes
s>>FSx.itemSize = itemSize
if itemSize eq wordItem then
[
s>>FSx.gets = WindowRead
s>>FSx.puts = WindowWrite
]
s>>SS.fS.type = stTypeSpruce
s>>SS.fS.error = errRtn
s>>SS.fS.reset = WindowSetPosition // assumes 0 if only one arg
s>>SS.fS.close = WindowClose
s>>SS.spruceFile = spruceFile
s>>SS.type = type
s>>SS.ahead = ahead
s>>SS.stepSize = stepSize
s>>SS.lowPage = 1
s>>SS.highPage = spruceFile>>SPruceFile.numPages
s>>SS.highChars = spruceFile>>SPruceFile.numChars
WindowSetPosition(s,filePos) // Reads in appropriate page, sets up fS, too
resultis s
]
and PutOverflow(s, datum) be // FS output overflow routine
[
if s>>FSx.eof then PutEofError(s)
GetNextSprucePage(s, 0)
RetryCall(s, datum)
]
and GetOverflow(s, datum) be // FS input overflow routine
[
if s>>FSx.eof then EofError(s)
GetNextSprucePage(s, 0)
RetryCall(s, datum)
]
and GetNextSprucePage(s, nextPage) be // FS overflow routine
[
// nextPage:
// -1: Cleanup request -- write dirty pages, but retain current position
// -2: Write dirty pages, then set Eof true and forget current position.
// >0: use as next page request
// 0: get current page+1
let spruceFile = s>>SS.spruceFile
let sP = s>>SS.sprucePage
if sP then
[
sP>>SPrucePage.dirty = Dirty(s)
// if sP>>SPrucePage.dirty then PageEvent(s, sP>>SPrucePage.pageNumber, true) // !!!
PutSprucePage(spruceFile, sP)
]
SetDirty(s,false)
if nextPage eq -2 then [ SetEof(s, true); return ] // flush and forget
let pageNo = nextPage>0? nextPage,
sP? sP>>SPrucePage.pageNumber+s>>SS.stepSize+nextPage, s>>SS.lowPage
let lpP1 = Max(s>>SS.lowPage-1, Min(s>>SS.highPage+1, pageNo+s>>SS.ahead))
sP = pageNo < s>>SS.lowPage % pageNo > s>>SS.highPage? 0,
GetSprucePage(spruceFile, pageNo, lpP1-pageNo, s>>SS.type ne ksTypeWriteBeforeRead)
s>>SS.sprucePage = sP
test sP then [
if nextPage<0 return // Was just flushing buffers
// PageEvent(s, pageNo, false) // !!!
let numChars = sP>>SPrucePage.numChars
if pageNo eq s>>SS.highPage then numChars = s>>SS.highChars
SetupWindowStream(s, sP>>SPrucePage.buffer, 0, numChars) ]
or SetEof(s,true) // WARNING: no official stream access to any page
]
and WindowWriteBlock(s, addr, length) = WindowReadBlock(s, addr, length, true)
and WindowReadBlock(s, addr, length, write;numargs na) = valof
[
// ~~ assumes length le 2↑14 words
if not length % Endofs(s) resultis 0 // zero length file or currently at end -- files do not extend
if na<4 then write = false
unless s>>SS.fS.type eq stTypeSpruce do SpruceError(2200,s)
let sF = s>>SS.spruceFile
let pos = CurrentPos(s)
let numToMove = length lshift 1
let thisToMove, addrPos = 0, 0
// while numToMove do
[
let sP, pageNo = s>>SS.sprucePage, sP>>SPrucePage.pageNumber
unless sP do SpruceError(2250)
let numChars = sP>>SPrucePage.numChars
if pageNo eq s>>SS.highPage then numChars = s>>SS.highChars
thisToMove = Umin(numChars-pos, numToMove)
let buf = sP>>SPrucePage.buffer
if thisToMove then
test write eq 0 then ByteBlt(addr, addrPos, buf, pos, thisToMove)
or [ ByteBlt(buf, pos, addr, addrPos, thisToMove);
SetDirty(s, true) ]
addrPos = addrPos+thisToMove
numToMove = numToMove-thisToMove
// loop control
if numToMove eq 0 % pageNo eq s>>SS.highPage break
pos = 0
GetNextSprucePage(s,pageNo+s>>SS.stepSize)
] repeat
WindowPositionPtr(s,pos+thisToMove)
resultis length-(numToMove rshift 1) // inaccurate if odd-aligned word move
]
and WindowSetPosition(s, pos, itemSize; numargs na) be
// pos MUST be a pointer to a two word file position (ref itemSize),
// or omitted (def. 0)
[
let p = vec 1; Zero(p,2); if na<2 then pos = p
if na < 3 then itemSize = wordItem
let pn, chars = nil, nil
let sF = s>>SS.spruceFile
PosToPage(pos, lv pn, lv chars, itemSize, sF)
WindowSetPage(s, pn)
unless s>>SS.sprucePage test chars then EofError(s) or return
WindowPositionPtr(s, chars)
]
and WindowSetPage(s, pn) be
[
// error if out of range
if pn < s>>SS.lowPage % pn > s>>SS.highPage then
test pn eq s>>SS.highPage+1 &
s>>SS.highChars eq (s>>SS.spruceFile>>SPruceFile.pageSize lshift 1)
ifso pn = -2
ifnot SpruceCondition(2210, ECFatal+ECTestRead, s, pn)
GetNextSprucePage(s, pn)
unless pn eq -2 do
WindowPositionPtr(s, pn eq s>>SS.lowPage? s>>SS.lowChars, 0)
]
and WindowPositionPtr(s, newPos) be
[
let sP = s>>SS.sprucePage
unless sP do SpruceError(2250)
let pageNo = sP>>SPrucePage.pageNumber
let numChars =
pageNo eq s>>SS.highPage? s>>SS.highChars, sP>>SPrucePage.numChars
if newPos > numChars % (pageNo eq s>>SS.lowPage &
newPos < s>>SS.lowChars) then
SpruceCondition(2220, ECFatal+ECTestRead, s, newPos, pageNo)
SetEof(s, false)
SetupWindowStream(s, sP>>SPrucePage.buffer, newPos, numChars)
]
and WindowGetPosition(s, pos, itemSize; numargs na) = valof
[
let v = vec 1; if na < 2 % pos eq 0 then pos = v
if na < 3 then itemSize = wordItem
resultis
PageToPos(pos, s>>SS.sprucePage>>SPrucePage.pageNumber,
CurrentPos(s), itemSize, s>>SS.spruceFile)
]
// set or reset the eof flag -- like OS fast streams, except Puts at eof is error
and SetEof(s, newValue) be if s>>FSx.eof ne newValue then
[
// extracted from faststreams
s>>FSx.eof=newValue
s>>FSx.gets=(newValue ?
(valof [ s>>FSx.savedGets=s>>FSx.gets; resultis EofError ]),
s>>FSx.savedGets)
// end of extract
s>>SS.fS.puts=(newValue ?
(valof [ s>>SS.savedPuts=s>>SS.fS.puts; resultis PutEofError ]),
s>>SS.savedPuts)
if newValue then s>>SS.sprucePage = 0 // nichts to write
]
and WindowFlush(s, forget; numargs na) be
[
if na < 2 then forget = false
GetNextSprucePage(s,(forget? -2, -1)) // Flush dirty
// ~~ When becomes an issue, wait for all to be done
]
and WindowClose(s) = valof
[
WindowFlush(s, true) // flag for "don't update checkpoint?"
let sF = s>>SS.spruceFile
UnAccessSpruceFile(sF)
// additional checkpoint information -- stream gone
FSPut(s, sF>>SPruceFile.zone)
resultis 0
]
and WindowSetBounds(s, lowPos, highPos, itemSize; numargs na) be
[
let defB = vec 1
if na<4 then itemSize = wordItem
let sF = s>>SS.spruceFile
if na<2 then
[
lowPos = DPzero
highPos = defB
FileLeng(sF, defB)
]
WindowFlush(s, true) // Flush and forget
PosToPage(lowPos, lv s>>SS.lowPage, lv s>>SS.lowChars, itemSize, sF)
PosToPage(highPos, lv s>>SS.highPage, lv s>>SS.highChars, itemSize, sF)
]
and WindowGetBounds(s, lowPos, highPos, itemSize; numargs na) be
[
if na<4 then itemSize = wordItem
let sF = s>>SS.spruceFile
PageToPos(lowPos, s>>SS.lowPage, s>>SS.lowChars, itemSize, sF)
if na ge 3 & highPos then
PageToPos(highPos, s>>SS.highPage, s>>SS.highChars, itemSize, sF)
]
and WindowOddByte(s) = s>>FSx.charPtr < 0
and WindowNextPage(s) = valof
[
let sP = s>>SS.sprucePage
unless sP do PutEofError(s)
let pn = sP>>SPrucePage.pageNumber+s>>SS.stepSize
if CurrentPos(s) eq 0 resultis pn-1
WindowSetPage(s, pn)
resultis pn
]
and WindowWordsPerPage(s) = s>>SS.spruceFile>>SPruceFile.pageSize
// Temporary functions for compatibility with "Press" version of Spruce
and WindowRead2Bytes(s) = WindowRead(s)
and WindowFile(s) = s>>SS.spruceFile // DIFFERENT structure from "Press" version
// ------------------------------------------------------
and WindowCopy(fromS, toS, len) be
// ------------------------------------------------------
[
let fromSp = fromS>>SS.sprucePage
unless fromSp do EofError(fromS)
let cPos = CurrentPos(fromS) rshift 1
let thisToMove = Umin(len, (fromSp>>SPrucePage.numChars rshift 1)-cPos)
if WindowWriteBlock(toS, fromSp>>SPrucePage.buffer+cPos, thisToMove)
ne thisToMove then EofError(toS)
len = len - thisToMove
WindowPositionPtr(fromS, (cPos+thisToMove) lshift 1)
unless len return
WindowNextPage(fromS)
] repeat
// Fast stream auxiliary routines, extracted from FastStreams and modified
and GetTwoBytes(s) = WindowReadByte(s) lshift 8 + WindowReadByte(s)
and PutTwoBytes(s, w) = WindowWriteByte(s, w rshift 8) & WindowWriteByte(s,wŹ)
and CopyTemplate(dest, template, length) be
for i=0 to length-1 do
[
let t=template!i
if (t & #177700) ne 0 then t=rv t
dest!i=t
]
and CurrentPos(s)=
(s>>FSx.endPos) + ((s>>FSx.count+1) lshift 1) - (s>>FSx.charPtr < 0? 1, 0)
and EofError(s) be SpruceCondition(2270, ECTestRead+ECFatal, s)
and PutEofError(s) be SpruceCondition(2260, ECTestWrite+ECFatal, s)
and StreamError(s) be s>>FS.error(s, 1303)
and Dirty(s)=s>>FSx.dirty ne 0
and SetDirty(s, v) be s>>FSx.dirty=v
and SetupWindowStream(s, wordBase, currentPos, endPos) be
[
// endPos must be even, the first character not in the range
// charPtr ← -1 if currentPos is odd, else 0
// wordPtr ← address of word containing the character preceding the first
// in-range character
// count ← -(# complete in-range words + 1)
let charPtr = -(currentPos&1)
s>>FSx.charPtr = charPtr
currentPos = currentPos rshift 1 // word pos
s>>FSx.wordPtr = wordBase + currentPos - (1+charPtr)
unless (endPos&1) eq 0 do SpruceCondition(2240,ECTestRead+ECFatal, s)
s>>FSx.endPos = endPos& #177776 // now even, can continue manually
s>>FSx.count = - ((endPos rshift 1)-currentPos+charPtr+1)
]
// June 27, 1977 11:41 AM, major revision (see 6-9-77 archive); adapt to
// new ML, prepare for word-based positioning
// June 27, 1977 2:49 PM, sign problems with charPtr
// June 27, 1977 7:40 PM, fix CurrentPos for odd-positioned stream
// June 27, 1977 9:16 PM, repair odd-aligned problems
// June 27, 1977 10:47 PM, use Window nomenclature, modify calling sequences
// June 27, 1977 11:58 PM, enforce upper boundary in GetNextSprucePage
// July 5, 1977 8:49 AM, revise error codes to match "Press" approach
// July 5, 1977 11:02 PM, 7-5 hardcopy modifications (vbl page size, etc.)
// July 11, 1977 7:02 PM, sprucePage contains data buffer
// July 15, 1977 9:21 AM, CurrentPos made external
// July 27, 1977 11:08 PM, WindowFlush no longer forgets file position
// July 28, 1977 5:04 PM, repair page ref count problem
// July 30, 1977 2:32 PM, WindowGetBounds bugs
// August 1, 1977 2:41 PM, WindowRead, WindowWrite, etc., when called directly,
// did not trigger EofError
// August 4, 1977 10:15 PM, use FS for windowCopy buffer, not vec
// August 31, 1977 11:48 AM, NextPage doesn't leave blank pages; WindowCopy insists on success
// September 9, 1977 11:09 PM, distinguish read EOF from write EOF, enable bands file
// output overflow test
// January 17, 1978 3:10 PM, adjust to even boundary after odd boundary SetupWindow error
// March 11, 1978 1:57 PM, can give WindowCopy a buffer to work in, guaranteed ge 1K
// September 5, 1978 9:32 AM, Read/WriteBlock return 0 if at EOF when called
// October 5, 1978 2:30 PM, add PageEvent !!!!!! for analysis of stream behavior
// October 5, 1978 10:44 PM, implement ksTypeWriteBeforeRead
// October 5, 1978 11:48 PM, in ksTypeWriteBeforeRead, WriteBlock uses IndexedIO directly~~!!
// October 6, 1978 12:48 AM, rescind same -- not worth it
// October 9, 1978 12:03 PM, new GetSprucePage interface for concurrent processing
// October 9, 1978 10:00 PM, pull events back out
// October 16, 1978 2:39 PM, put events back in
// October 24, 1978 1:47 PM, implement the silly stepSize thing -- non-compact streams
// October 25, 1978 10:38 AM, WindowCopy does not use intermediary
// November 5, 1978 12:37 PM, comment out event reporting
//