// MDplace -- instruction placer subroutines
// last edited August 19, 1980  3:07 PM


external [	// defined here
	SetupMasks	// (zone, trytab, tlen, btlen)
	Find1Place	// (mask, bt) -> loc/-1
	FindAlistPlace	// (mask, length, bt) -> loc/-1
	WritePlaceStats	// (S)
]

external [
		// OS
	Allocate
	MoveBlock
	@oneBits
	Puts
		// Template
	PutTemplate
		// MDasm
	AndBlock
	CountBits
	FirstBitPos
	MakeRunMask
]


static [
	@MaskPtrTab	// points to table of i-bit masks rshift j
	@AtryTab; @AtryTabEnd; ATlen
	@Btemp; @BtempEnd; @BTlen
		// Statistics
	@find1placed = 0; @find1failed = 0
	@findlengths; @findstepsdisp; @findfailed = 0
]


let SetupMasks(zone, trytab, tlen, btlen) be
[	let mt = Allocate(zone, 16+15+14+13+12+11+10+9+8+7+6+5+4+3+2+1)
	MaskPtrTab = Allocate(zone, 17)
	let tab = mt
	for n = 1 to 16 do
	 [ let mask = -oneBits!(n-1)
	   MaskPtrTab!n = tab
	   for pos = 0 to 16-n do
	    [ @tab = mask
	      tab, mask = tab+1, mask rshift 1
	    ]
	 ]
	AtryTab, AtryTabEnd = trytab, trytab+tlen-1
	ATlen = tlen
	Btemp = Allocate(zone, btlen); BtempEnd = Btemp+btlen
	BTlen = btlen
	// Statistics
	findlengths = Allocate(zone, 17)
	let fst = Allocate(zone, tlen*btlen)
	let fs = Allocate(zone, tlen)
	for i = 0 to tlen-1 do fs!i = fst+i*btlen
	findstepsdisp = fs-AtryTab
]


let Find1Place(mask, bt) = valof
// The common special case of FindAlistPlace (see below)
[	let bmerge = (not AndBlock(bt, BTlen)) & mask
	if bmerge eq 0 then
	[ find1failed = find1failed+1
	  resultis -1
	]
	// There must be a match somewhere
	let ap = AtryTab
	until (bmerge & @ap) ne 0 do ap = ap+1
	// Now there must be a match somewhere in bt with this ap
	let m = @ap & mask
	let bp = bt
	until (not @bp & m) ne 0 do bp = bp+1	// previous loop left bp=bt
	let loc = FirstBitPos(not @bp & m)
	@bp = @bp + oneBits!loc
	let fsp = ap!findstepsdisp+(bp-bt)	// statistics
	@fsp = @fsp+1
	find1placed = find1placed+1
	resultis (bp-bt) lshift 4 + loc
]

and FindAlistPlace(mask, length, bt) = valof
// Mask gives permissible first locations
// Length is number of instructions in alist, 1 le length le 16
// Bt is BTlen-word bit table of occupied locations
// Returns location, or -1 if not possible
[	let flp = findlengths+length
	@flp = @flp+1
	// Find possible starting locations (runs ge length)
	MoveBlock(Btemp, bt, BTlen)
	let bmerge = 0
	let bp = BtempEnd
	[ bp = bp-1
	  @bp = MakeRunMask(not @bp, length) & mask
	  bmerge = bmerge % @bp
	] repeatuntil bp eq Btemp
	if bmerge eq 0 then
	[ findfailed = findfailed+1
	  resultis -1
	]
	// There must be a match somewhere
	let ap = AtryTab
	until (bmerge & @ap) ne 0 do ap = ap+1
	// Now there must be a match somewhere in Btemp with this ap
	until (@bp & @ap) ne 0 do bp = bp+1	// previous loop left bp=Btemp
	let loc = FirstBitPos(@bp & @ap)
	let wn = bp-Btemp
	bt!wn = bt!wn + (MaskPtrTab!length)!loc
	let fsp = ap!findstepsdisp+wn
	@fsp = @fsp+1
	resultis wn lshift 4 + loc
]

and WritePlaceStats(S) be
// Write placer statistics on listing file
[	PutTemplate(S, "  Single instructions: $D successes, $D failures*N  Instruction groups: $D failures*N  Groups by X=subpage, Y=priority*N", find1placed, find1failed, findfailed)
	let fsp = AtryTab+findstepsdisp
	let fspend = fsp+ATlen
	until fsp eq fspend do
	[ list8(S, @fsp, BTlen)
	  fsp = fsp+1
	]
]

and list8(S, tab, len) be
[	for i = 0 to len-1 do
	  PutTemplate(S, (((i&7) eq 0) & (i ne 0)? "*N$8UD", "$7UD"), tab!i)
	Puts(S, $*N)
]