// MDassign -- assign locations to instructions
// last edited August 16, 1980  9:47 PM

	get "mddecl.d"
	get "mdadefs.d"

external [	// defined here
	Assign	// (zone)
		// Statics for MDaring
	@lBT; @lPage
	@PageBase
]

external [
		// OS
	Allocate
	MoveBlock; SetBlock; Zero
	CallSwat
		// MDmain
	@IP
	@DMachine
	@IM; @IMlocked; @NInstructions
	AbortCode
		// MDerr
	Err
	PutAddress
	PutAddrData
	PutRing
		// MDaring
	AssignRing
		// MDplace
	SetupMasks
	CountBits
		// MDprescan
	@PageSize; @nPages; @WordMask
	@globalZero; @nGlobalPages
	@ifuZero; @nIfuPages; @pageIfuMax; @ifuMask
	@calledMask; @goedtoMask; @jbctMask
		// MDasm
	Set1Bit
]


static
[	@PageTab
	@PageBase
	@lBT; @lPage
	@firstPage; @lastPage; @thisPage
	@failMsg; @fullMsg; @total = 0
]

let Assign(zone) be
[	Err(PassMessage, "Assigning locations...")
	lBT = PageSize/16
	let m1, m2, m3, m4, m5 = nil, nil, nil, nil, -1
	test DMachine eq 0
	ifso
	[ SetupMasks(zone, lv m5, 1, lBT)
	]
	ifnot
	[ let jbceMask = jbctMask % (jbctMask rshift 1)
	  m1, m2, m3, m4 =
	    not (calledMask % ifuMask % jbceMask),
	    not (calledMask % jbceMask),
	    not (calledMask % (ifuMask & jbceMask)),
	    not (calledMask)
	  SetupMasks(zone, lv m1, 5, lBT)
	]
	lPage = lPageHd+lBT
	PageTab = Allocate(zone, nPages)
	PageBase = Allocate(zone, nPages*lPage)
	for i = 0 to nPages-1 do
	[ let page = PageBase+i*lPage
	  PageTab!i = page
	  let lbase = IMlocked+i*lBT
	  for j = 0 to lBT-1 do
	  [ let b = lbase!j
	    if b eq 0 loop
	    page>>Page.BT^j = b
	    page>>Page.used = page>>Page.used+CountBits(b)
	  ]
	]
	let Tab = vec lIbuf	// working vector
	let ring = vec maxlPage
// Classify instructions by group
	let groups = vec 8
	SetBlock(groups, -1, 8)
	let gAbs, gGlobal, gIFUE = -1, -1, -1
	for i = NInstructions-1 by -1 to 0 do	// so lists wind up in ascending order
	[ let ip = IP(i)
	  ip>>IM.marked = 0
	  let lvg = nil
	  test ip>>IM.onPage  ifso lvg = lv gAbs  ifnot
	  test ip>>IM.global  ifso lvg = lv gGlobal  ifnot
	  test ip>>IM.IFUE  ifso lvg = lv gIFUE  ifnot
	  [ lvg = (ip>>IM.aLinked ne 0? 4, 0)+groups	  // Do alists first
	    if (not calledMask & ip>>IM.mask) eq 0 then lvg = lvg+2	  // Then subroutine entries
	    if ip>>IM.bLink ne i then lvg = lvg+1	  // Then non-unit rings
	  ]
	  ip>>IM.groupLink = @lvg
	  @lvg = i
	]
// Process pages with known page number
	failMsg = "Can't assign absolutely placed ring"
	fullMsg = "Too many instructions on page"
	total = 0
	until gAbs eq -1 do
	[ let i = gAbs
	  let ip = IP(i)
	  gAbs = ip>>IM.groupLink
	  if ip>>IM.marked loop	// already processed
	  let pn = ip>>IM.W0/PageSize
	  let pa = pn*PageSize
	  total = CollectRing(i, Tab, ring) + total
	  if (ring>>Page.global ne 0) & ((pa&globalZero) ne 0) then
	    Err(PassFatal, "Can't have GLOBAL on page $O", pa)
	  if (ring>>Page.IFUE ne 0) & ((pa&ifuZero) ne 0) then
	    Err(PassFatal, "Can't have IFU entry on page $O", pa)
	  pagelimits(pn, pn)
	  assignpage(Tab, ring)
	]
	writetotal("rings involving ONPAGE or AT")
// Process global and IFU entry rings (none for D0)
	pagelimits(0, nGlobalPages-1)
	failMsg = "Can't assign GLOBAL ring"
	fullMsg = 0
	total = 0
	until gGlobal eq -1 do
	[ let i = gGlobal
	  let ip = IP(i)
	  gGlobal = ip>>IM.groupLink
	  if ip>>IM.marked loop	// already processed
	  total = CollectRing(i, Tab, ring) + total
	  assignpage(Tab, ring)
	]
	writetotal("rings with a GLOBAL")
	pagelimits(0, nIfuPages-1)
	failMsg = "Can't assign IFU entry ring"
	total = 0
	until gIFUE eq -1 do
	[ let i = gIFUE
	  let ip = IP(i)
	  gIFUE = ip>>IM.groupLink
	  if ip>>IM.marked loop	// already processed
	  total = CollectRing(i, Tab, ring) + total
	  assignpage(Tab, ring)
	]
	writetotal("rings with an IFU entry")
// Process other rings
	pagelimits(0, nPages-1)
	failMsg = "Ran out of pages trying to assign ring"
	for a = 7 to 0 by -1 do
	[ total = 0
	  let i = groups!a
	  until i eq -1 do
	  [ let ip = IP(i)
	    unless ip>>IM.marked do	  // already processed
	    [ total = CollectRing(i, Tab, ring) + total
	      assignpage(Tab, ring)
	    ]
	    i = ip>>IM.groupLink
	  ]
	  writetotal(selecton a into
	  [ case 7: "CALLed rings including a CALL/conditional"
	    case 6: 0	// Can't have a 1-instruction alist
	    case 5: "other rings including a CALL/conditional"
	    case 4: 0	// Can't have a 1-instruction alist
	    case 3: "CALLed multi-instruction rings"
	    case 2: "CALLed 1-instruction rings"
	    case 1: "other multi-instruction rings"
	    case 0: "other 1-instruction rings"
	  ])
	]
// Check to make sure assignment was completed
// (strictly an internal consistency check)
	let ec, str, acode = PassFatal, "******The following had no address assigned:*N*T$P", AbortCode
	for i = 0 to NInstructions-1 do
	[ let ip = IP(i)
	  let placed = ip>>IM.onPage & ip>>IM.atWord
	  ip>>IM.placed = placed
	  if (placed eq 0) & (acode ls 0) then
	  [ Err(ec, str, PutAddrData, i); ec, str = PassMessage, "*T$P" ]
	]
]

and pagelimits(first, last) be
	firstPage, lastPage, thisPage = first, last, first

and assignpage(tab, ring) be
[	static [ @atrue = 0; @afalse = 0 ]	// statistics
	let max = PageSize-ring>>Page.used
	let pn = thisPage
	let af = afalse
	let fptr, fused = nil, PageSize
	[ let page = PageTab!pn
	  if page>>Page.used le max then
	  [ let fp = AssignRing(tab, ring, page)
	    test fp eq 0
	     ifso
	    [ thisPage = pn; atrue = atrue+1; return ]
	     ifnot
	    [ if page>>Page.used ls fused then
	        fptr, fused = fp, page>>Page.used
	      afalse = afalse+1
	    ]
	  ]
	  pn = pn-1
	] repeatuntil pn ls firstPage
	pn = thisPage+1
	until pn gr lastPage do
	[ let page = PageTab!pn
	  if page>>Page.used le max then
	  [ let fp = AssignRing(tab, ring, page)
	    test fp eq 0
	     ifso
	    [ thisPage = pn; atrue = atrue+1; return ]
	     ifnot
	    [ if page>>Page.used ls fused then
	        fptr, fused = fp, page>>Page.used
	      afalse = afalse+1
	    ]
	  ]
	  pn = pn+1
	]
	let msg = ((af eq afalse) &	// no page had enough room
	  (fullMsg ne 0)? fullMsg, failMsg)
	Err(PassMessage, (fptr eq -1? "$S:", "$S,*N  while trying to place instruction(s):"), msg)
	if fptr ne -1 then	// might not be any culprit
	 test (fptr-lv tab>>SubPage.data-tab>>SubPage.length) ls 0
	 ifso	// points to an isolated instruction
	  Err(PassMessage, "*T$P", PutAddrData, @fptr)
	 ifnot	// points to a subpage
	  for j = 0 to fptr>>SubPage.length-1 do
	    Err(PassMessage, "*T$P", PutAddrData, fptr>>SubPage.data^j)
	Err(PassFatal, "  Ring consists of:*N$P", PutRing, firstins(tab))
]

and firstins(tab) =
	(@tab eq 0? tab+lSubPageHd, tab)>>SubPage.data^0

and writetotal(msg) be
[	if total ne 0 then
	 test msg eq 0
	  ifso CallSwat("MicroD bug")
	  ifnot Err(PassMessage, "$6Ob instructions in $S", total, msg)
]

and CollectRing(i, tab, ring) = valof
// Collect instructions starting at i
// Set bit table and counts in ring (Page structure)
// Put instructions in tab (fake SubPage for isolated instructions, sequence of SubPage structures, 0)
// Return # of instructions collected
[	Zero(ring, lPage)
	let Atab = vec maxPageSize
	@Atab = -2
	// Don't start ring inside subpage sequence
	let ip = nil
	[ ip = IP(i)
	  i = ip>>IM.bLink
	] repeatuntil ip>>IM.jbcLinked eq 0
	let j = i
	let top = tab+(lIbuf-1)
	let bot = tab+lSubPageHd
	let ni, ptr, end = 0, bot, top
	let nsp = 0
	let lastLinked = false
	[ ip = IP(j)
	  ip>>IM.marked = 1
	  if ip>>IM.global then
	  [ ring>>Page.global = ring>>Page.global+1
	    ring>>Page.slow = true
	    if ring>>Page.global gr pageGlobalMax then
	      Err(PassFatal, "More than $D GLOBAL(s) on same page:*N$P", pageGlobalMax, PutRing, j)
	  ]
	  if ip>>IM.IFUE then
	  [ ring>>Page.IFUE = ring>>Page.IFUE+1
	    ring>>Page.slow = true
	    if ring>>Page.IFUE gr pageIfuMax then
	      Err(PassFatal, "More than $D IFU entries on same page:*N$P", pageIfuMax, PutRing, j)
	  ]
	  if ip>>IM.atWord then
	  [ if @Atab eq -2 then SetBlock(Atab, -1, PageSize)
	    let wn = ip>>IM.W0 & WordMask
	    test Atab!wn eq -1
	    ifnot
	      Err(PassFatal, "$P....assigned to same location as $P", PutAddress, j, PutAddress, Atab!wn)
	    ifso
	    [ Set1Bit(lv ring>>Page.BT, wn, 1)
	      Atab!wn = j
	      ring>>Page.slow = true
	    ]
	  ]
	  unless lastLinked do
	   test ip>>IM.jbcLinked
	   ifnot
	  if end ne ptr then
	  [ @ptr = j
	    ptr = ptr+1
	  ]
	   ifso
	  [ let len = CollectSubpage(j, end, end-ptr)
	    end = end-len
	    if len ne 0 then nsp = nsp+len-lSubPageHd
	  ]
	  j = ip>>IM.bLink
	  lastLinked = ip>>IM.jbcLinked
	  ni = ni+1
	] repeatuntil j eq i
	if ni gr PageSize then
	[ Err(PassFatal, "$D instructions had to go on the same page (limit is $D):*N$P", ni, PageSize, PutRing, i)
	  ni = ptr-bot+nsp
	]
	ring>>Page.used = ni
	// Rearrange the tables
	@tab = ptr-bot
	@top = 0
	MoveBlock(ptr, end, top-end+1)
	resultis ni
]

and CollectSubpage(start, end, len) = valof
// Start is first instruction of subpage in ring
// End is the end of a SubPage structure for the result
// Put addresses in the structure with +1 lists first
// Set length, spn1, alists
// Return amount used if enough room, 0 if not enough
[	if len le lSubPageHd resultis 0
	let i = start
	let data = vec SubPageSize
	let jbot, jtop = end-len, end
	let dbot, dtop = data, data+SubPageSize
	let spn, iabs = -1, nil
	let ip = nil	// Compiler bug (!), should be "let ip" in next line
	[ ip = IP(i)
	  if ip>>IM.atWord then	// absolute placement
	  [ let spa = (ip>>IM.W0 & (PageSize-20b)) rshift 4
	    test spn eq -1
	     ifso spn, iabs = spa, i
	     ifnot if spn ne spa then
	      Err(PassFatal, "$P....must be in subpage with $P, but has conflicting assignment", PutAddress, i, PutAddress, iabs)
	  ]
	  test ip>>IM.aLink eq i
	  ifso	// not on a +1 list, put at end
	  [ if jtop eq jbot resultis 0
	    jtop = jtop-1
	    @jtop = i
	  ]
	  ifnot	// on a +1 list, put the list at the beginning
	  [ let i0, i1 = nil, nil
	    for j = data to dbot-1 do
	      if @j eq i goto ska	// already got it
	    i1 = i
	    while ip>>IM.aLinked do	// find beginning of alist
	    [ i1 = ip>>IM.aLink
	      ip = IP(i1)
	    ]
	    i0 = i1
	    [ if dbot eq dtop resultis false
	      @dbot = i1
	      i1 = ip>>IM.aLink
	      ip = IP(i1)
	      dbot = dbot+1
	    ] repeatuntil i1 eq i0
	    ip = IP(i)
ska:	  ]
	  i = ip>>IM.bLink
	] repeatwhile ip>>IM.jbcLinked
	// Join sections of table
	let V = jtop-(dbot-data)-lSubPageHd
	if (V-jbot) ls 0 resultis 0
	MoveBlock(V+lSubPageHd, data, dbot-data)
	let nw = end-V-lSubPageHd
	if nw gr 16 then
	  Err(PassFatal, "$P....more than 16 instructions in subpage", PutAddress, start)
	V>>SubPage.alists = dbot ne data
	V>>SubPage.spn1 = spn+1
	V>>SubPage.length = nw
	resultis end-V
]