// MDmake.bcpl -- subroutines for making allocation and cluster lists
// last edited July 9, 1980  8:48 AM

	get "mddecl.d"

external	// defined here
[	MakePlus1	// (i1, i2)
	MakeSubpageLink	// (i1, i2)
	MakePageLink	// (i1, i2)
]


external	// used
[		// MDmain
	@IP
	Err
	PutAddress
	@IM
		// MDprescan
	@PageMask
]


let MakePlus1(I1, I2) be
//Record the requirement that I2 be placed at the location following
//I1 (in the same page) by linking them together through their aLink fields.
//This is a circular chain with aLinked set in all but the first item.
//Error if I1 already has a link-from or I2 has a link-to.
[	let ip1, ip2 = IP(I1), IP(I2)
	if ip1>>IM.aLink eq I2 then
	[ if ip2>>IM.aLinked eq 0 then
	    Err(PassFatal, "$P....must both precede and follow $P", PutAddress, I1, PutAddress, I2)
	  return
	]
	let err = false
	if IP(ip1>>IM.aLink)>>IM.aLinked then
	[ ErrPlus1(I1, I2, "former already has a link to", ip1>>IM.aLink)
	  err = true
	]
	if ip2>>IM.aLinked then
	[ let I3 = I2	// Find predecessor of I2
	  [ let ip3 = IP(I3)
	    if ip3>>IM.aLink eq I2 break
	    I3 = ip3>>IM.aLink
	  ] repeat
	  ErrPlus1(I1, I2, "latter already has a link from", I3)
	  err = true
	]
	unless err do
	[ let Link1 = ip1>>IM.aLink	// beginning of chain
	  ip1>>IM.aLink = I2
	  ip2>>IM.aLinked = 1
	  while ip2>>IM.aLink ne I2 do	// find end of chain
	    ip2 = IP(ip2>>IM.aLink)
	  ip2>>IM.aLink = Link1
	]
]

and ErrPlus1(I1, I2, S, I3) be
	Err(PassFatal, "Attempted +1 link from $P to $P;*N   the $S $P", PutAddress, I1, PutAddress, I2, S, PutAddress, I3)

and MakePageLink(I1, I2) be
//Record the requirement that I1 and I2 be in the same page.
//This is done with a circular chain through bLink.
//Groups of instructions which must be in the same subpage
//have jbcLinked set in all but the last one.
[	let I = I2
	 [ if I eq I1 return	// I2 is already in I1's page
	   I = IP(I)>>IM.bLink
	 ] repeatuntil I eq I2
	let ip1 = IP(I1)
	let ip2 = IP(I2)
	if ip1>>IM.onPage & ip2>>IM.onPage & ((ip1>>IM.W0&PageMask) ne (ip2>>IM.W0&PageMask)) then	// Quick error check for D0
	  Err(PassFatal, "Can't put $P and $P on the same page", PutAddress, I1, PutAddress, I2)
	 [ if ip1>>IM.jbcLinked eq 0 break
	   I1 = ip1>>IM.bLink
	   ip1 = IP(I1)
	 ] repeat
	 [ if ip2>>IM.jbcLinked eq 0 break
	   I2 = ip2>>IM.bLink
	   ip2 = IP(I2)
	 ] repeat
	// Now splice the pages together
	let Link1 = ip1>>IM.bLink
	ip1>>IM.bLink = ip2>>IM.bLink
	ip2>>IM.bLink = Link1
]

and MakeSubpageLink(I1, I2) be
//Record the requirement that I1 and I2 be in the same subpage.
//This is done by patching the last bLink in I2's current subpage
//to point to the first instruction in I1's subpage, and setting
//jbcLinked in the last instruction in I2's subpage, and patching I1's
//old predecessor to point to I2's last's old successor.
//If I1 and I2 are already in the same page, I1's subpage
//must be removed from the ring first.
[	let ip2 = nil
	 [ ip2 = IP(I2)
	   if ip2>>IM.jbcLinked eq 0 break	// end of I2's subpage
	   I2 = ip2>>IM.bLink
	 ] repeat
	let I0 = nil	// will be I1's jbc group's predecessor
	let I = I1
	let sameRing = false
	 [ if I eq I2 then sameRing = true	// found I2 in I1's ring
	   let ip = IP(I)
	   if ip>>IM.jbcLinked eq 0 then I0 = I	// last end of subpage
	   I = ip>>IM.bLink
	 ] repeatuntil I eq I1
	let ip0 = IP(I0)
	let Link0 = ip0>>IM.bLink	// first instr in I1's subpage
	test sameRing
	ifso	// remove I1's subpage from the ring
	 [ I1 = Link0	// search entire page
	   let ip1 = nil
	    [ if I1 eq I2 return	// already in same subpage
	      ip1 = IP(I1)
	      if ip1>>IM.jbcLinked eq 0 break	// end of I1's subpage
	      I1 = ip1>>IM.bLink
	    ] repeat
	   ip0>>IM.bLink = ip1>>IM.bLink	// remove from ring
	   ip1>>IM.bLink = ip2>>IM.bLink
	 ]
	ifnot	// just splice rings together
	   ip0>>IM.bLink = ip2>>IM.bLink
	ip2>>IM.bLink = Link0
	ip2>>IM.jbcLinked = 1
]