// 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; SpruceZone
// 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
// incoming statics from FastStreamsA.asm
fastChStream; fastWstream
// incoming procedures from FastStreamsA.asm
CurrentPos

// PageEvent // !!! monitoring stuff
]

// outgoing procedures
external [
WindowCreateStream; WindowSetPage; WindowPositionPtr; WindowSetPosition;
WindowGetPosition; WindowFlush; WindowClose
WindowReadBlock; WindowWriteBlock; WindowSetBounds; StreamError
WindowNextPage; WindowGetBounds; WindowRead2Bytes; WindowCopy;
WindowFile; WindowOddByte; WindowWordsPerPage
CurPosition // ~~ a good idea? rename?
SetupWindowStream; EofError; PutEofError

//outgoing procedures
CreateStringStream
StringPutOv; StringGetOv; StringCloses
]

manifest ecEof = 1302

structure String [ length byte; char↑1,255 byte ]

// 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 = CurPosition(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,
CurPosition(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 CurPosition(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 = CurPosition(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 CurPosition(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)
]

// ...more routines extracted from FastStreamsB.Bcpl, ...hacked ...renamed

//----------------------------------------------------------------------------
and InitFstream(fs, itemSize, PutOv, GetOv, GetCC; numargs na) be
//----------------------------------------------------------------------------
[
let template = selecton itemSize into
[
case charItem: fastChStream
case wordItem: fastWstream
// should call SpruceERROR with appropriate error code
// default: Errors(fs, ecBadItemSize)
]
for i = 0 to lFSx-1 do
[
let t = template!i
if (t & 177700b) ne 0 then t = @t
fs!i = t
]
fs>>FSx.putOverflow = PutOv
fs>>FSx.getOverflow = GetOv
// getCC unknown, so just ignore it
// if na ge 5 then fs>>FSx.getCC = GetCC
]


// the following functions take advantage of the fact that if
// itemSize is 1 or 2, shifting by itemSize-1 is the same as
// multiplying or dividing by itemSize

//----------------------------------------------------------------------------
and SetupFstrm(fs, wordBase, currentPos, endPos) be
//----------------------------------------------------------------------------
[
// Note that endPos is rounded up, although everything else is truncated
let m = -fs>>FSx.itemSize// truncation mask
let i = fs>>FSx.itemSize-1

currentPos = (currentPos+i) & m
endPos = (endPos+i) & m

fs>>FSx.charPtr = 1-(currentPos & 1)
fs>>FSx.wordPtr = wordBase+(currentPos rshift 1)-fs>>FSx.charPtr
// the (+1) in the next statement reflects the fact that the
// count must be one more than the number of items left
fs>>FSx.count = -(((endPos-currentPos) rshift i)+1)
fs>>FSx.endPos = endPos
]

//----------------------------------------------------------------------------
//and SetEof(fs, newValue) be // set or reset the eof flag
//----------------------------------------------------------------------------
// if fs>>FSx.eof ne newValue then
// [
// fs>>FSx.eof = newValue
// test newValue
// ifso [ fs>>FSx.savedGets = fs>>FSx.gets; fs>>FSx.gets = EofError ]
// ifnot fs>>FSx.gets = fs>>FSx.savedGets
// ]

//-----------------------------------------------------------------
and CreateStringStream(string, maxLength, firstByte, zone;
numargs na) = valof
//-----------------------------------------------------------------
//Creates and returns a string stream reading or writing the
//supplied string. If maxLength is zero, reading of an existing
//string is assumed; if nonzero, writing of a new string of
//maximum length maxLength is assumed. If firstByte is supplied
//and nonzero, it is the index of the first byte to be read or
//written. Closing the stream causes the string’s length to
//be updated to the current position iff it has been written into.
[
DefaultArgs(lv na, -1, 0, 1, SpruceZone)
let s = FSGetX(lFS, zone)
InitFstream(s, charItem, StringPutOv, StringGetOv)
SetupFstrm(s, string, firstByte,
(maxLength eq 0? string>>String.length, maxLength)+1)
s>>ST.par1 = string
s>>ST.par2 = zone
s>>ST.close = StringCloses
resultis s
]

//-----------------------------------------------------------------
and StringGetOv(s) be s>>ST.error(s, ecEof)
//-----------------------------------------------------------------

//-----------------------------------------------------------------
and StringPutOv(s) be s>>ST.error(s, ecEof)
//-----------------------------------------------------------------

//-----------------------------------------------------------------
and StringCloses(s) be
//-----------------------------------------------------------------
[
if Dirty(s) then s>>ST.par1>>String.length = CurrentPos(s)-1
FSPut(s, s>>ST.par2)
]

// 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 CurPosition 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, CurPosition 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
// December 13, 1982 6:25 PM, add more code pirated from FastStreamsB.Bcpl
// December 13, 1982 7:17 PM, added code from StringStreams
//(with some minor modifications), changed CurrentPos to CurPosition
//(to avoid conflict with CurrentPos() extracted from FastStreams)