// MDlist2.bcpl -- more listing routines for MicroD
// last edited February 2, 1981  3:02 PM

	get "mddecl.d"
	get "streams.d"

external	// defined here
[	OpenListFile	// (sp, zone) -> stream
	ListIMAbs	// (S)
	ListOccupied	// (S)
	ListIMap	// (S, sources)
	ListChart	// (S, sources)
]

external	// used
[
// OS
	CreateDiskStream
	Puts; Wss
	MoveBlock; Zero
// Template
	PutTemplate
// MDload
	sourceNameWidth
// MDmain
	@IP
	@DMachine
	@NInstructions; @IMlocked
// MDerr
	Err
	GetSource
	PutBlanks
	PutFileName
// MDinit
	OutputSource
	VersionString
	StartDTString
// MDprescan
	@PageSize; @nPages; @WordMask; @PageMask
// MDlist0
	CountUsed
	ListASym
// MDasm
	CountBits; Get1Bit; Set1Bit
]


manifest	// layout for 2-up landscape listing
[	chartLinesPerPage = 75
]


let OpenListFile(sp, zone) = valof
[	let s = CreateDiskStream(sp>>Source.pFP, ksTypeWriteOnly, charItem, 0, 0, zone)
	if s eq 0 then Err(Fatal, "Can't open output file $S", sp>>Source.pName)
	Err(PassMessage, "Writing $S...", sp>>Source.pName)
	PutTemplate(s, "** $S**   at $S*N*N", VersionString, StartDTString)
	resultis s
]

and ListIMAbs(S) be
[	// Identify virtual location corresponding to each absolute one
	for a = 0 to IMsize-1 do IP(a)>>IM.absPtr = -1
	for i = 0 to NInstructions-1 do
	[ let ip = IP(i)
	  if ip>>IM.placed then IP(ip>>IM.W0)>>IM.absPtr = i
	]
	let lstWidth = (sourceNameWidth ls 4? 4, sourceNameWidth)+2
	PutTemplate(S, "IM:*N Real$PFile  Symbol*N", PutBlanks, lstWidth-4)
	let lastpage = -1
	for a = 0 to IMsize-1 do
	 if IP(a)>>IM.absPtr ne -1 then
	[ let page = a & PageMask
	  if page ne lastpage then [ Puts(S, $*N); lastpage = page ]
	  PutTemplate(S, "$5O", a)
	  let i = IP(a)>>IM.absPtr
	  let source = GetSource(i)
	  test source eq 0
	   ifso PutBlanks(S, lstWidth)	// only one source
	   ifnot
	  [ let name = source>>Source.pName
	    PutBlanks(S, lstWidth-name>>BS.length)
	    Wss(S, name)
	  ]
	  let first = (source eq 0? 0, source>>Source.niFirst)
	  let si = i
	  while (si gr first) & (IP(si)>>IM.SymPtr eq 0) do si = si-1
	  Wss(S, "  ")
	  let sym, diff = IP(si)>>IM.SymPtr, i-si
	  test sym eq 0
	   ifso PutTemplate(S, "$D", diff)
	   ifnot
	  [ ListASym(S, sym)
	    if diff ne 0 then PutTemplate(S, "+$D", diff)
	  ]
	  Puts(S, $*N)
	]
]

and ListOccupied(S) be
[	let ubits, used, reserved = vec IMsize/16, vec maxnPages, vec maxnPages
	CountUsed(ubits, used, reserved)
	PutTemplate(S, "INSERT[OccupiedDefs];*N*N*TTITLE[$POccupied];*N", PutFileName, OutputSource>>Source.pName)
	let reserve(s, p, f, l) be
	  PutTemplate(s, "*TIMRESERVE[$O, $O, $O];*N", p, (f+1)&WordMask, l-f-1)
	for p = 0 to nPages-1 do
	 if used!p ne 0 then
	[ PutTemplate(S, "*N** Locations reserved on page $O$S*N*N", p, (p gr 7? "B", ""))
	  let z = p*PageSize-1
	  let end = z+PageSize
	  for j = z+1 to end do
	   if Get1Bit(ubits, j) eq 0 then	// end of an occupied run
	  [ if j ne z+1 then reserve(S, p, z, j)
	    z = j
	  ]
	  if z ne end then reserve(S, p, z, end+1)
	]
	Wss(S, "*N*TEND;*N*N")
]

and ListIMap(S, sources) be
[	static [ @lstWidth ]
	let lmap1(s, source, n) be
	[ Wss(s, "  ")
	  let len = PutFileName(s, source>>Source.pName)
	  PutBlanks(s, lstWidth-len)
	  PutTemplate(s, "$6O ($DD)*N", n, n)
	]
	let frees = vec lSource
	frees>>Source.pName = "Free Instructions = "
	let res = vec lSource
	res>>Source.pName = "IMRESERVEd"
	lstWidth = (sourceNameWidth ge 19? sourceNameWidth, 19)
	// Print size of each module
	PutTemplate(S, "$P contains the following modules:*N*N", PutFileName, OutputSource>>Source.pName)
	let sp = sources
	until sp eq 0 do
	[ lmap1(S, sp, sp>>Source.niLast-sp>>Source.niFirst)
	  sp = sp>>Source.next
	]
	PutTemplate(S, "*NTotal Instructions =$6O ($DD)*N", NInstructions, NInstructions)
	// Print map of each page
	let ubits, used, reserved = vec IMsize/16, vec maxnPages, vec maxnPages
	CountUsed(ubits, used, reserved)
	for p = 0 to nPages-1 do
	[ PutTemplate(S, "*NPage$6O ($DD):*N", p, p)
	  let base = p*PageSize
	  let sp, u = sources, used!p
	  until sp eq 0 do
	  [ let n = 0
	    for i = sp>>Source.niFirst to sp>>Source.niLast-1 do
	    [ let ip = IP(i)
	      let abs = ip>>IM.W0
	      if ((abs & PageMask) eq base) & ip>>IM.placed then n = n+1	// Skip instrs not placed (if assignment pass failed)
	    ]
	    if n ne 0 then lmap1(S, sp, n)
	    sp, u = sp>>Source.next, u-n
	  ]
	  if reserved!p ne 0 then lmap1(S, res, reserved!p)
	  if u ne 0 then Err(PassFatal, "******Page $O IMap discrepancy = $O", p, u)
	  lmap1(S, frees, PageSize-used!p-reserved!p)
	]
]

and ListChart(S, sources) be
[	let lines = 3	// lines occupied on the current page (3 lines written by OpenListFile)
	// Make 10-character-wide strings for source names, and
	// identify the source for each location
	for i = 0 to IMsize-1 do IP(i)>>IM.absPtr = 0
	let source = sources
	until source eq 0 do
	[ let tag = source>>Source.pDate	// don't need date string any more
	  MoveBlock(tag, "           ", 6)
	  let name = source>>Source.pName
	  let len = name>>BS.length
	  for i = len by -1 to 1 do
	    if name>>BS.char^i eq $. then len = i-1
	  if len gr 10 then len = 10
	  let j = 11	// leave 1 leading blank
	  while len gr 0 do
	  [ tag>>BS.char^j = name>>BS.char^len
	    j, len = j-1, len-1
	  ]
	  for a = source>>Source.niFirst to source>>Source.niLast-1 do
	  [ let ip = IP(a)
	    if ip>>IM.placed then
	      IP(ip>>IM.W0)>>IM.absPtr = source>>Source.pDate
	  ]
	  source = source>>Source.next
	]
	// Actually produce the chart
	for page = 0 to nPages-1 do
	[ let newlines = PageSize/8+4
	  test lines+newlines gr chartLinesPerPage
	   ifso [ Wss(S, "*014*N"); lines = 1 ]	// page eject
	   ifnot [ if page ne 0 then Wss(S, "*N*N"); lines = lines+newlines ]
	  PutTemplate(S, "$S Control Store Locations for page $O ($DD)*N*N", (DMachine eq 0? "D0", "Dorado"), page, page)
	  let pbase = page*PageSize
	  let pend = pbase+PageSize-1
	  for i = pbase by 8 to pend do
	  [ PutTemplate(S, "$4O/", i)
	    let jnext = i
	    for j = i to i+7 do
	    [ let name = IP(j)>>IM.absPtr
	      if name ne 0 then
	      [ while jnext ls j do
	        [ Wss(S, "           "); jnext = jnext+1 ]
	        Wss(S, name)
	        jnext = j+1
	      ]
	    ]
	    Puts(S, $*N)
	  ]
	]
]