; Spruce stream machine code

savedPC=1
temp=2

; incoming externals
	.bext SysErr,StreamError
; outgoing procedures, stream templates
	.bext WindowReadByte, WindowWriteByte, WindowRead, WindowWrite
	.bext WindowEof, spruceStream

	.srel
spruceStream: .fs

; the template below must parallel the FS structure declaration
	.nrel
.fs:
.fchs:	00
	00
	StreamError	;; used to be "Free"
	WindowReadByte
	WindowWriteByte
	Nop
	StreamError
	SysErr
	WindowEof
	StreamError
	00
	00
charPtr: 00
wordPtr: 00
count:	00 ; always in words
dirty:	00
eof:	00
putOverflow: SysErr ; buffer overflow routine for almost puts
getOverflow: SysErr ; buffer overflow routine for almost gets
putTwoBytesOverflow: SysErr; for odd-aligned putW
itemSize: 1; 
endPos: 00
savedGets: WindowReadByte
xt: 0
getTwoBytesOverflow: SysErr ; left over -- for odd-aligned getW

	.srel
WindowReadByte: .GetCh
WindowWriteByte: .PutCh
WindowRead: .GetW
WindowWrite: .PutW
WindowEof: .Fendof
Nop: .nop

	.nrel

; The internal structure of Spruce streams are insensitive to itemSize; itemSize
; merely controls the choice of Gets and Puts routines for the stream. Bytes may
; be managed in a word stream, words in a byte stream, by directly calling the
; implementing procedures -- this is compatible with "Press" predecessors.

; Restrictions: A file must be of even length. A buffer must contain an even
; number of bytes. No control character trapping is done.

; The stream activities are managed using a word pointer, a word
; count, and a character pointer (-1 for odd bytes, something else otherwise). This
; choice allows an efficient implementation.

; N.B. The charPtr parity choice is the approximate reverse of the "Press" version.

.GetCh: sta 3 savedPC,2
	mov 0 3
	isz charPtr-.fs,3
	jmp getEvenCh
getOddCh:
	lda 0 @wordPtr-.fs,3
	lda 1 .rmask
	and 1 0
done:	lda 3 savedPC,2
.nop:	jmp 1,3

getEvenCh:
	isz count-.fs,3
	jmp .+2
	jmp callOv

	mknil 0,0
	sta 0 charPtr-.fs,3
	isz wordPtr-.fs,3	; can't skip
	lda 0 @wordPtr-.fs,3
	lda 1 .lmask
	ands 1 0
	lda 3 savedPC,2
	jmp 1,3

callOv: dsz count-.fs,3		; can't skip
ov1:	mov 3 0
	lda 3 getOverflow-.fs,3
	jmp 1,3

; .GetW will work for odd or even-aligned words

.GetW:	sta 3 savedPC,2
	mov 0 3
	isz charPtr-.fs,3		; odd or even aligned?
	jmp getEvenWord
getOddWord:
	dsz charPtr-.fs,3		; charPtr ← -1, no skip
	isz count-.fs,3
	jmp .+2
	jmp callGetTwoOv		; second byte will overflow, do it from BCPL
	lda 0 @wordPtr-.fs,3
	lda 1 .rmask
	ands 1 0
	sta 0 temp,2
	isz wordPtr-.fs,3
	lda 0 @wordPtr-.fs,3
	lda 1 .lmask
	ands 1 0
	lda 1 temp,2
	add 1 0
	lda 3 savedPC,2
	jmp 1,3
getEvenWord:
	isz count-.fs,3
	jmp .+2
	jmp callOv
	isz wordPtr-.fs,3
	lda 0 @wordPtr-.fs,3
	lda 3 savedPC,2
	jmp 1,3

callGetTwoOv:
	dsz count-.fs,3
	mov 3 0
	lda 3 getTwoBytesOverflow-.fs,3
	jmp 1 3

.rmask:	377
.lmask:	177400

.PutCh:
	sta 3 savedPC,2
	mov 0 3
	isz charPtr-.fs,3
	jmp putEvenCh
putOddCh:
	lda 0 .rmask
	and 0 1
	movs 0 0
	jmp PutCh1
putEvenCh:
	isz count-.fs,3
	jmp .+2
	jmp callPutOv
PECh:	mknil 0 0			; now odd-aligned
	sta 0 charPtr-.fs,3
	lda 0 .rmask
	ands 0 1
	isz wordPtr-.fs,3		; can't skip
PutCh1: sta 1 temp,2
	lda 1 @wordPtr-.fs,3
	and 1 0
	lda 1 temp,2
	add 0 1
	sta 1 @wordPtr-.fs,3
	sta 3 dirty-.fs,3		; set non-zero (true)
	lda 3 savedPC,2
	jmp 1,3

callPutOv: dsz count-.fs,3
	mov	3 0
	lda 3 putOverflow-.fs,3
	jmp 1,3

.Fendof: sta 3 savedPC,2
	mov 0 3
	lda 1 eof-.fs,3
	mknil 0 0			; true
	sz 1 1
	jmp done
	mkzero 0 0			; false
	lda 1 charPtr-.fs,3
	inc# 1 1 snr
	jmp done			; odd-aligned, not eof (see restrictions)
	lda 1 count-.fs,3
	inc# 1 1 szr
	jmp done			; buffer not empty, not eof
	jmp ov1			; read next buffer and ask again

; .PutW will work for odd or even-aligned words

.PutW:	sta 3 savedPC,2
	mov 0 3
	isz charPtr-.fs,3		; odd or even aligned?
	jmp putEvenWord
putOddWord:
	isz count-.fs,3
	jmp .+2
	jmp callPutTwoOv		; second byte in next buffer, do from BCPL
	sta 1 charPtr-.fs,3		; used as second temporary
	lda 0 .lmask			; duplicate putOddCh
	ands 0 1
	sta 1 temp,2
	lda 1 @wordPtr-.fs,3
	and 1 0
	lda 1 temp,2
	add 0 1
	sta 1 @wordPtr-.fs,3
	lda 1 charPtr-.fs,3		; original word
	jmp PECh			; store low order char in even loc
putEvenWord:
	isz count-.fs,3
	jmp .+2
	jmp callPutOv
	isz wordPtr-.fs,3		; can't skip
	sta 1 @wordPtr-.fs,3
	sta 3 dirty-.fs,3		; set non-zero (true, sort of)
	lda 3 savedPC,2
	jmp 1,3

callPutTwoOv:
	dsz charPtr-.fs,3		; return to initial state
	dsz count-.fs,3
	mov 3 0
	lda 3 putTwoBytesOverflow-.fs,3
	jmp 1 3

;; Page map function for wrap-around files
	.bext VpageToRpage

	.srel
VpageToRpage: .VpageToRpage

	.nrel
offSet = 1			; SPruceFile indices -- these match SPruceFile declaration
maxPages = 2			;  in SpruceFiles.D
numPages = 4
backwards = 6

.VpageToRpage:;(spruceFile, pageNo)
	sta	3 savedPC,2
	mov	0 3		; (spruceFile)
	lda	0 backwards,3; (spruceFile>>SPruceFile.backwards)
	sn	0 0		; if spruceFile>>SPruceFile.backwards then
	jmp	fwd
	lda	0 numPages,3
	inc	0 0
	sub	1 0		; pageNo = spruceFile>>SPruceFile.numPages+1-pageNo
	mov	0 1
fwd:
	lda	0 offSet,3	; let result = spruceFile>>SPruceFile.offSet
	add	1 0		;    + pageNo
	lda 	1 maxPages,3 ; (spruceFile>>SPruceFile.maxPages)
	adcl#	1 0,snc	; if result > maxPages then
	sub	1 0		;    result = result - maxPages
	lda	3 savedPC,2	; resultis result
	jmp	1,3

	.end

;; June 27, 1977  9:59 AM, made from Streamsml -- "Press" function names, for now
;; June 27, 1977  9:07 PM, some fixes
;; July 14, 1977  2:07 PM, VpageToRpage for wrap around files
;; July 15, 1977  4:57 PM, offSet, maxPAges moved
;; August 5, 1977  9:27 AM, add backwards-arranged files
;; September 9, 1977  11:15 PM, distinguish between get EOF and put EOF
;; October 12, 1978  12:11 AM, track changes in SPruceFile structure
;;