// PRESSBUFS.sr Module
// last modified
// RML October 7, 1977  11:03 PM fix assignbufs bug

get "BRAVO1.DF";
get "q.DF";
get "altofilesys.d";
get "Press.DF";
get "vm.DF";

// Incoming Procedures

external [
	move
	array
	Dequeue
	Enqueue
	doublemul
	doublesub
	MakeFileId
	WritePages
	LengthQ
	movec
	errhlta
	AllocVm
	Unqueue
	DeletePages
	];

// Incoming Statics

external [
	macbp
	fillInDA
	dnbp
	vpep
	];

// Outgoing Procedures

external [
	DlPosition
	EvenByte
	PressInitPutting
	PutChar
	PutWds
	QLength
	WritePressBufs
	]

// Outgoing statics
external	[
	pgnFirst
	]

 

// I N I T P U T 
//
let PressInitPutting(cfaFirstDl,daPrev,daPgn1) = valof
[ let poolbuf = array(macbp*lBuf);
let pep = array(lPress)
movec(pep,pep+lPress-1, 0)

let qbuf = lv pep >> PRESS.aqbufFree
AllocVm(qbuf,poolbuf,macbp-6,true)
move(cfaFirstDl,lv pep >> PRESS.acfaCur,lCFA)
pep >> PRESS.daPrev = daPrev
pep >> PRESS.daPgn1 = daPgn1
resultis pep
] 

//*** All below assume the global vpep where appropriate  ***//

// P U T C H A R 
//
and PutChar(char, qbuf) be
[ if qbuf>>Qelement.remainput eq 0 then
	[
	AssignPressBuf(qbuf,vpep)
	qbuf>>Qelement.pwput = (qbuf >> Q.tail) >> BUF.ca;
	qbuf>>Qelement.lbput = true
	qbuf>>Qelement.remainput = 512
	]
test qbuf>>Qelement.lbput ifso
	[ (qbuf>>Qelement.pwput) >> lh = char
	qbuf>>Qelement.lbput = false
	] 
ifnot	[ (qbuf>>Qelement.pwput) >> rh = char
	qbuf>>Qelement.lbput = true;
	qbuf>>Qelement.pwput = qbuf>>Qelement.pwput+1
	] 
qbuf>>Qelement.remainput = qbuf>>Qelement.remainput-1
] 

// P U T W D S
//
and PutWds(wd,qbuf) be	// assumes you ARE on a wd bndry.

[ if qbuf>>Qelement.remainput eq 0 then
	[
	AssignPressBuf(qbuf,vpep)
	qbuf>>Qelement.pwput = (qbuf >> Q.tail) >> BUF.ca;
	qbuf>>Qelement.lbput = true
	qbuf>>Qelement.remainput = 512
	]

@(qbuf>>Qelement.pwput) = wd
qbuf>>Qelement.lbput = true;
qbuf>>Qelement.pwput = qbuf>>Qelement.pwput+1
	 
qbuf>>Qelement.remainput = qbuf>>Qelement.remainput-2
]

//E V E N B Y T E 
//
and EvenByte(qbuf) = valof
	[
	unless qbuf>>Qelement.lbput do
		PutChar(pressEntityNoopm,qbuf)
	]

// W R I T E B U F S
//
and WritePressBufs(qbuf,pep,fNoTrunc; numargs na) be
	// adds qbuf to Dl

[ if na ls 3 then fNoTrunc = true
let cfaCur = lv pep >> PRESS.acfaCur
let rgca = vec maxbp; let rgda = vec maxbp+2
movec(rgda,rgda+maxbp-1,fillInDA)
rgda = rgda+1; rgda ! (-1) = pep >> PRESS.daPrev
rgda ! 0 = cfaCur >> CFA.fa.da
let cpg = 0;
let qbufFree = lv pep >> PRESS.aqbufFree
	[ let buf = Dequeue(qbuf)
	if buf eq 0 then break
	rgca ! cpg = buf >> BUF.ca
	cpg = cpg+1
	Enqueue(qbufFree,buf)
	] repeat
if cpg eq 0 then
	[ unless qbuf eq lv pep >> PRESS.aqbufDl then errhlta(217)
	return
	] 
qbuf>>Qelement.remainput = 0

let pgnFirst = cfaCur >> CFA.fa.pageNumber
let pgnNext = pgnFirst+cpg
let fileId = vec 3
MakeFileId(fileId,lv cfaCur >> CFA.fp)
rgda = rgda-pgnFirst
WritePages(rgca-pgnFirst,rgda,fileId,pgnFirst,pgnNext)
pep >> PRESS.daPrev = rgda ! (pgnNext-1)
cfaCur >> CFA.fa.pageNumber = pgnNext
cfaCur >> CFA.fa.da = (rgda ! pgnNext eq fillInDA) ? 0,rgda ! pgnNext

unless fNoTrunc do
	[
	WritePages(0, rgda, fileId,
		pgnNext, pgnNext, 0, 0, 0,dnbp ! 0)
	if rgda !(pgnNext+1) eq fillInDA then errhlta(216)
	DeletePages(dnbp ! 0, rgda !(pgnNext+1), fileId, pgnNext+1)
	] 
] 

// A S S I G N B U F S
//
and AssignPressBuf(qbuf,pep) be
[ let qbufFree = lv pep >> PRESS.aqbufFree
let buf = Dequeue(qbufFree)
if buf eq 0 then
	[ let bufLast = 0; let qbufDl = lv pep >> PRESS.aqbufDl
	let t = qbufDl>>Qelement.remainput
	unless t eq 0 then
		[ bufLast = qbufDl >> Q.tail
		unless Unqueue(qbufDl,bufLast) then
			errhlta(219)
		] 
	WritePressBufs(qbufDl,pep)
	unless bufLast eq 0 then
		Enqueue(qbufDl,bufLast)
	qbufDl>>Qelement.remainput = t	// was zeroed by WritePressBufs

	buf = Dequeue(qbufFree)
	if buf eq 0 then
		errhlta(220)
	] 
movec(buf>>BUF.ca,(buf>>BUF.ca)+255,0)// clear it.
//qbuf>>Qelement.remainput = 0
Enqueue(qbuf,buf)
] 
// D L P O S I T I O N
//
and DlPosition(dbl) be
[ let pgnB = (lv vpep >> PRESS.acfaCur) >> CFA.fa.pageNumber
let dpg = LengthQ(lv vpep >> PRESS.aqbufDl)

// dbl = numberPages*512-remainput
let tw = vec 1
tw!1 = (lv vpep>>PRESS.aqbufDl)>>Qelement.remainput
tw!0 = 0

doublemul(pgnB-pgnFirst+dpg, 512, dbl)
doublesub(dbl,tw,dbl)
] 

// Q L E N G T H
//
and QLength(qbuf) = valof	// single precision
[ resultis
	LengthQ(qbuf)*512-qbuf>>Qelement.remainput
]