// MDalist.bcpl -- finish allocation lists, check placement constraints
//		on each list, accumulate global statistics, extend "AT" to
//		all elements of lists containing "AT", extend page-relative
//		placement to all elements of lists containing "GLOBAL"
// last edited December 5, 1979  3:02 PM

get "mddecl.d"

external [	// defined here
	BuildALists	// (zone)
]

external [
		// OS
	Allocate
	SetBlock
		// MicroD
	@IP
	Err
	PutAddress
	PutRing
	@IM; @NInstructions
		// MDprescan
	@PageSize; @PageMask; @WordMask
		// MDmake
	MakePageLink; MakeSubpageLink
]


//To process alists, sequence through IM as follows:
//  1.	If aLinked then loop (not an alist head).
//  2.	Iterate over the list as follows.
//		For each alist element I:
//  3.	"AND" its mask with the mask accumulated so far.
//		Error if the mask becomes zero in the process.
//		Mask is propagated from one alist element to the next by
//		Mask = Mask rcy 1.
//  4.	Check for absolute or global placement.  Propagate absolute
//		addresses to following list elements by
//		AbsAddr = ((AbsAddr & 7700B)+((AbsAddr+1) & 77B)).
//  5.	End of list handled as follows:
//	a. If absolute, AbsAddr is propagated to all alist elements.
//	b. If GlobFlag, page-relative positions are propagated
//	   to all list elements (same algorithm as propagating AbsAddr).


manifest
[	maxAlist = 16	// must fit on subpage
]


let BuildALists(zone) be
[	Err(PassMessage,"Building allocation lists...")
	CheckAlists()
	CheckRings()
]

and CheckAlists() be
[	let ListTab = vec maxAlist
	for i = 0 to NInstructions-1 do
	[ let IMptr = IP(i)
	  if IMptr>>IM.aLink eq i then	// common special case
	  [ if IMptr>>IM.mask eq 0 then
	      Err(PassFatal, "$P....Too many constraints", PutAddress, i)
	    loop
	  ]
	  if IMptr>>IM.aLinked loop	// Not an alist head
	  let Mask, Length = -1, 0
	  let PageFlag, WordFlag = false, false
	  let AbsPage, AbsWord = nil, nil	// Absolute address of list head
	  let NI = i
	  // Loop over all instructions in alist
	  [ if IMptr>>IM.atWord then
	    [ let word0 = (IMptr>>IM.W0-Length) & WordMask
	      if WordFlag then
	       if word0 ne AbsWord then
	        Err(PassFatal, "$P....Attempt to place at both word $O and $O", PutAddress, i, IMptr>>IM.W0&WordMask, (AbsWord+Length)&WordMask)
	      WordFlag, AbsWord = true, word0
	    ]
	    if IMptr>>IM.onPage then
	    [ let page = IMptr>>IM.W0 & PageMask
	      if PageFlag then
	       if page ne AbsPage then
	        Err(PassFatal, "$P....Attempt to place on both page $O and $O", PutAddress, i, page, AbsPage)
	      PageFlag, AbsPage = true, page
	    ]
	    if Length eq maxAlist then
	    [ Err(PassFatal, "$P....+1 list longer than $D", PutAddress, i, maxAlist)
	      break
	    ]
	    ListTab!Length = NI
//Done with this instruction, check for more in list
	    Length = Length+1
	    Mask = ((Mask rshift 1)+(Mask lshift 15)) & IMptr>>IM.mask	// Mask rcy 1
	    if Mask eq 0 then Err(PassFatal,
	      "$P....Impossible allocation list constraints", PutAddress, NI)
	    NI = IMptr>>IM.aLink
	    if NI eq i break	// end of list
//Advance to next instruction
	    IMptr = IP(NI)
	  ] repeat
//End of alist.
	// Fill in mask, also fill in addresses for global and page lists
	  for j = Length-1 by -1 to 0 do
	  [ let i = ListTab!j
	    let Iptr = IP(i)
	    Iptr>>IM.mask = Mask
	    if WordFlag then
	    [ Iptr>>IM.W0 = (Iptr>>IM.W0 & PageMask) + ((AbsWord+j) & WordMask)
	      Iptr>>IM.atWord = 1
	    ]
	    if PageFlag then
	    [ Iptr>>IM.W0 = AbsPage + (Iptr>>IM.W0 & WordMask)
	      Iptr>>IM.onPage = 1
	    ]
	    if j ne 0 then MakeSubpageLink(ListTab!(j-1), i)	// Force +1 list onto subpage
	    Mask = (Mask lshift 1)+(Mask rshift 15)	// Mask lcy 1
	  ]
	]
]

and CheckRings() be
// Propagate page assignments through branch rings
// Merge disjoint rings for same page
[	for i = 0 to NInstructions-1 do
	  IP(i)>>IM.marked = 0
	let PageVec = vec maxnPages
	SetBlock(PageVec, -1, maxnPages)
	for i = 0 to NInstructions-1 do
	[ let Iptr = IP(i)
	  if Iptr>>IM.marked loop	// already seen
	  unless Iptr>>IM.onPage loop	// don't start here
	  let i1, Iptr1 = i, Iptr
	  let errflag = false
	  let Addr1, Addr2 = nil, nil
	  [ Iptr1>>IM.marked = 1
	    let i2 = Iptr1>>IM.bLink
	    let Iptr2 = IP(i2)
	    Addr1, Addr2 = Iptr1>>IM.W0, Iptr2>>IM.W0
	    test Iptr2>>IM.onPage
	    ifso	// check for compatibility
	    [ if (Addr1&PageMask) ne (Addr2&PageMask) then
	        errflag = true
	    ]
	    ifnot	// propagate
	    [ Iptr2>>IM.W0 = Addr2+((Addr1-Addr2)&PageMask)
	      Iptr2>>IM.onPage = 1
	    ]
	    i1, Iptr1 = i2, Iptr2
	  ] repeatuntil i1 eq i
	  if errflag then
	    Err(PassFatal,
"The following must all be on the same page,*N   but have conflicting page assignments as follows:*N$P", PutRing, i)
	  until Iptr1>>IM.jbcLinked eq 0 do	//make sure not in subpage
	  [ i1 = Iptr1>>IM.bLink
	    Iptr1 = IP(i1)
	  ]
	  let page = Addr1/PageSize
	  test PageVec!page eq -1
	  ifso
	    PageVec!page = i1
	  ifnot	// merge the rings, no need to check if same
	  [ let Iptr2 = IP(PageVec!page)
	    let link1 = Iptr1>>IM.bLink
	    Iptr1>>IM.bLink = Iptr2>>IM.bLink
	    Iptr2>>IM.bLink = link1
	  ]
	]
]