// 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
]