//
// File searching package
// last edited October 29, 1980  9:31 PM
//
// Copyright Xerox Corporation 1979, 1980

	get "streams.d"
	get "altofilesys.d"
	get "findintdefs.d"

external	// entries
[	FindInitScan	// (stream, buf, bufsize, fa) -> ssd
	FindNext	// () -> ppos/not npages
	// Set up by FindCompile or FindCompileSoft
	findWriteReg	// (reg, value)
	findJumpRam	// (ac0, addr, ac3) -> (ac0, ac1, ac3)
]


external	// procedures used
[		// OS
	GetScanStreamBuffer
	InitScanStream
	LnPageSize
	MoveBlock
]


static
[	@fSsd	// ScanStream descriptor
	@fFa	// FA for passing match position to caller
	@fPn	// page number of current buffer
	@fBuf	// current buffer
	@fAddr	// current address within fBuf
	@fNchars	// number of chars of data in fBuf
	@fOdd	// 1 if scan ended on an odd byte
		// entries for FindComp
	@fNegK	// -K+1, where K is pattern length - fuzz
	@fNphase	// number of phases
	@fExitChar	// exit character (both bytes)
	findWriteReg = 0
	findJumpRam = 0
]


let FindInitScan(st, buf, bufsize, fa) = valof
[	let logps = LnPageSize(st)
	let ps = 1 lshift logps
	fBuf = buf
	let bufs = fBuf+ps+1	// +1 to store exit char at end
	let nbufs = (bufsize-ps-1)/ps
	for i = 0 to nbufs-1 do
	  fBuf!i = bufs+(i lshift logps)
// *** The following statement is a kludge to overcome the inflexible
// *** allocation policy of InitScanStream
	if nbufs gr 3 then nbufs = 3
	fSsd = InitScanStream(st, fBuf, nbufs)
	fFa = fa
	fPn = 0
	@fBuf = fExitChar
	fNchars = 0
	fAddr = fBuf-1
	fOdd = 1
	findWriteReg(RnegK1, fNegK)
	if findJumpRam eq 0 then
	 findJumpRam = table[
	   55001b	// sta 3 1,2
	   35003b	// lda 3 3,2
	  JMPRAM
	   11001b	// isz 1,2
	    3001b	// jmp @1,2
	 ]
	findJumpRam(1777b, Reset)
	resultis fSsd
]

let FindNext() = valof
[	let link, nctr, phase = nil, nil, nil	// preallocate for assembly code
	let sa = (FetchEven+1)-fOdd
	let next = table[
	   55004b	// STA 3 link,2
	    6406b	// JSR @lvfindJumpRam
	       2	//   2 // nargs
	   45005b	// STA 1 nctr,2
	   55006b	// STA 3 phase,2
	   35004b	// LDA 3 link,2
	    1401b	// JMP 1,3
	       0	//lvfindJumpRam:
	  ]
	next!7 = findJumpRam
	fAddr = next(fAddr, sa)
	fOdd = ((phase rshift 11) + phase) & 1
	let p1 = (fAddr-fBuf)*2+fOdd
	if nctr ge 0 then	// real match
	 [ findJumpRam(5777b-(fOdd lshift 11), Reset)
	   fFa>>FA.charPos = p1
	   resultis ((phase&1777b)-nctr+fNphase) rem fNphase	// position within pattern
	 ]
	test p1 eq fNchars
	 ifso	// real end of buffer
	 [ unless findbuffer() resultis not fPn
	   findWriteReg(Rphase, phase-1)	// back up phase
	   fOdd = 1	// force even fetch next
	 ]
	 ifnot	// extraneous exit char
	 [ findWriteReg(Rphase, (phase-1) xor 4000b)	// invert even/odd flag
	 ]
] repeat

and findbuffer() = valof
// Returns true if more data
[	let buf = GetScanStreamBuffer(fSsd)
	if buf eq 0 resultis false
	fPn = fSsd>>SSD.pageNumber
	fAddr = fBuf-1
	fNchars = fSsd>>SSD.numChars
	fFa>>FA.da = fSsd>>SSD.da
	fFa>>FA.pageNumber = fPn
	MoveBlock(fBuf, buf, (fNchars+1) rshift 1)	// Ugly but necessary
	fBuf>>bytes^fNchars = fExitChar
	resultis true
]