// MDlist1.bcpl -- listing routines for MicroD
// last edited February 2, 1981  3:27 PM

	get "mddecl.d"
	get "mdfields.d"

external	// defined here
[	LinkSyms	// (tab, len, zone)
	ListIM	// (S, sources)
	ListIMUsed	// (S, map)
	ListNonIM	// (S, level)
	ListOtherSyms	// (S)
]

external	// used
[
// OS
	Puts; Wss
	Noop
// Template
	PutTemplate
// MDmain
	@IP
	Err
	@DMachine
	@NInstructions
	@IMlocked
	@RM; @RMbits
	@IFUMbits
	@ALUFM; @ALUFMbits
// MDload
	@mNames
	@mSymMax
// MDscan
	@nPages; @PageSize
// MDdump
	FixIFUM
	@mSymPtrs
// MDlist0
	CountUsed
	ListRM
	ListMem; ListSym
// MDasm
	Get1Bit
// OS
	Allocate
]


let LinkSyms(tab, len, zone) be
// Correlate IM and other memory locations with symbols
// ***Note: destroys the symbol hash chains
[	for i = 0 to NInstructions-1 do IP(i)>>IM.SymPtr = 0
	mSymPtrs = Allocate(zone, nMemX)
	for i = 0 to nMemX-1 do
	  mSymPtrs!i = Allocate(zone, mSymMax!i+1)
	for i = 0 to len-1 do
	[ let sym = tab!i
	  until sym eq 0 do
	  [ let addr = (sym!-1)<<Sym.addr
	    let memx = (sym!-1)<<Sym.memx
	    let lvptr = (memx eq IMmemx? lv IP(addr)>>IM.SymPtr, mSymPtrs!memx+addr)
	    let s = @sym
	    @sym = @lvptr
	    @lvptr = sym
	    sym = s
	  ]
	]
]

let ListIM(S, sources) be
// The listing flag in the Source structure is defined by
//  the listXxx manifests in MDdecl
[	Err(PassMessage, "Writing listing...")
	let oldflag = -1
	let source = sources
	while source ne 0 do
	[ let lflag = source>>Source.lflag
	  if lflag ge 0 then
	  [ if lflag ne oldflag then
	    [ if oldflag ls 0 then Wss(S, "*NIM:*N")
	      ListIMHead(S, lflag)
	      oldflag = lflag
	    ]
	    PutTemplate(S, "$S:*N", source>>Source.pName)
	    ListAllIM(S, source>>Source.niFirst, source>>Source.niLast, lflag)
	  ]
	  source = source>>Source.next
	]
]

and ListIMUsed(S, map) be
[	Puts(S, $*N)
	let ubits, used, reserved = vec IMsize/16, vec maxnPages, vec maxnPages
	CountUsed(ubits, used, reserved)
	for i = 0 to nPages-1 do
	 if (used!i ne 0) % (reserved!i ne 0) then
	[ PutTemplate(S, "Page $4O: $3O locations used, $3O free", i*PageSize, used!i, PageSize-used!i-reserved!i)
	  if reserved!i ne 0 then PutTemplate(S, ", $3O IMRESERVEd", reserved!i)
	  Puts(S, $*N)
	  if map & (used!i ne PageSize) then
	   for j = i*PageSize to (i+1)*PageSize-1 do
	  [ Puts(S, (Get1Bit(ubits, j) ne 0? $**, Get1Bit(IMlocked, j) ne 0? $~, $.))
	    if (j&7) eq 7 then Puts(S, ((j&37b) eq 37b? $*N, $*S))
	  ]
	]
]

and ListNonIM(S, level) be
[	if level ls 0 then
	[ if DMachine ne 0 then ListIFUMShort(S)
	  return
	]
	ListRM(S)
	if DMachine eq 0 return
	ListIFUM(S, level eq listFull)
	let ListALUFM(S, i, used) be
	  PutTemplate(S, "$5O", ALUFM!i rshift 8)
	ListMem(S, "ALUFM", ALUFMbits, ALUFMmemx, ALUFMsize, ListALUFM, 0)
]

and ListIFUMShort(S) be
[	static [ ifirst ]
	ifirst = true
	let lo = 0
	let wpair(S, lo, hi) be
	[ if ifirst then [ Wss(S, "*NIFUM locations used:*N"); ifirst = false ]
	  test lo eq hi
	   ifso PutTemplate(S, "$6O*N", lo)
	   ifnot PutTemplate(S, "$6O - $6O*N", lo, hi)
	]
	for i = 0 to IFUMsize-1 do
	 if Get1Bit(IFUMbits, i) eq 0 then
	[ if lo ne i then wpair(S, lo, i-1)
	  lo = i+1
	]
	if lo ne IFUMsize then wpair(S, lo, IFUMsize-1)
]

and ListIFUM(S, full) be
[	static [ IFUMfull ]
	IFUMfull = full
	let ListIFUMword(S, i, used) be
	[ let v = vec lIFUM
	  let addr = FixIFUM(v, i)
	  test used
	   ifso
	  [ PutTemplate(S, "$8UO$7UO", v!0, v!1)
	    if IFUMfull then
	    [ let MemB, N = v>>TIFUM.MemB, v>>TIFUM.N
	      PutTemplate(S, "  $C$C$2O $C$1O$3O $C$C $C  $C", (v>>TIFUM.notTPause? $*S, $P), (v>>TIFUM.notTJump? $*S, $J), v>>TIFUM.notLength xor 3, (MemB ge 4? $3, $x), MemB, v>>TIFUM.notRBaseB xor 1, ((N ge 10b) & (N ne 17b)? $1, $*S), (N eq 17b? $*S, (N&7)+$0), (v>>TIFUM.Sign? $-, $*S), (v>>TIFUM.PA? $**, $*S))
	    ]
	  ]
	   ifnot
	    if addr ne 7777B then Wss(S, "                                   ")
	  if addr ne 7777B then ListSym(S, IP(addr)>>IM.SymPtr)
	]
	let header = (full?
	  "*NIFUM:*N*N   Loc    Hi     Lo    PJ L MB RB  N S PA  Symbol*N  ----  ------ ------  -- - -- -- -- - --  --------*N",
	  "*NIFUM:*N*N   Loc    Hi     Lo    Symbol*N  ----  ------ ------  --------*N")
	ListMem(S, header, IFUMbits, IFUMmemx, IFUMsize, ListIFUMword, 400b)
]

and ListOtherSyms(S) be
[	for memx = (DMachine eq 0? 3, 5) to nMemX-1 do	// skip IM, RM, IFUM, ALUFM
	 if mSymMax!memx ne -1 then
	  ListMem(S, mNames!memx, 0, memx, mSymMax!memx+1, Noop, 0)
]

and ListIMHead(S, flag) be
	PutTemplate(S,
	  "*N Imag   Real$S  Symbol*N ----   ----$S  --------*N",
	  (flag ne listFull? "",
	   DMachine ne 0? "    W0     W1  ",
	                  "    W0     W1   W2"),
	  (flag ne listFull? "",
	   DMachine ne 0? "  ------ ------",
	                  "  ------ ------ --")
	  )

and ListAllIM(S, first, last, flag) be
[	static [ @Putc; @lsts ]
	Putc = Puts	// faster call
	lsts = S
	let putw(h, v) be
	[ h = (v rshift 15)+(h*2)
	  Putc(lsts, (h eq 0? $*S, h+$0))
	  if h ne 0 then v = v % 100000b	// for leading zero suppression
	  let d1 = ((v rshift 1) rshift 1) rshift 1
	  let d2 = ((d1 rshift 1) rshift 1) rshift 1
	  let d3 = ((d2 rshift 1) rshift 1) rshift 1
	  let d4 = ((d3 rshift 1) rshift 1) rshift 1
	  Putc(lsts, (d4 eq 0? $*S, (d4&7)+$0))
	  Putc(lsts, (d3 eq 0? $*S, (d3&7)+$0))
	  Putc(lsts, (d2 eq 0? $*S, (d2&7)+$0))
	  Putc(lsts, (d1 eq 0? $*S, (d1&7)+$0))
	  Putc(lsts, (v&7)+$0)
	]
	let putd(v) be Putc(lsts, (v eq 0? $*S, (v&7)+$0))
	let lastSymLoc = 0
	for i = first to last-1 do
	[ let ip = IP(i)
	  if (flag eq listAbsOnly) & (ip>>IM.atW0 eq 0) & (ip>>IM.global eq 0) loop
	  // PutTemplate(S, " $4O$C$C$C$4O{$8UO$7UO}", ...)
	  Putc(S, $*S)
	  putd((i rshift 8) rshift 1)
	  putd(i rshift 6)
	  putd(((i rshift 1) rshift 1) rshift 1)
	  Putc(S, (i&7)+$0)
	  Putc(S, (ip>>IM.emulator? $e, $*S))
	  Putc(S, (ip>>IM.brkP? $b, $*S))
	  Putc(S, (ip>>IM.atW0? $@, $*S))
	  let v = ip>>IM.W0
	  putd((v rshift 8) rshift 1)
	  putd(v rshift 6)
	  putd(((v rshift 1) rshift 1) rshift 1)
	  Putc(S, (v&7)+$0)
	 if flag eq listFull then
	 [
	  Putc(S, $*S)
	  Putc(S, $*S)
	  test DMachine eq 2
	   ifso
	  [ let w0, w1, w2 = ip>>IM.iw0, ip>>IM.iw1, ip>>IM.iw2
	    putw(w0 rshift 15, (w0 lshift 1)+(w1 rshift 15))
	    Putc(S, $*S)
	    putw((w1 lshift 1) rshift 15, ((w1 lshift 1) lshift 1)+(w2 rshift 14))
	  ]
	   ifnot
	  [ putw(0, ip>>IM.iw0)
	    Putc(S, $*S)
	    putw(0, ip>>IM.iw1)
	    if DMachine eq 0 then
	    [ v = ip>>IM.iw2 rshift 12
	      Putc(S, $*S)
	      putd(((v rshift 1) rshift 1) rshift 1)
	      Putc(S, (v&7)+$0)
	    ]
	  ]
	 ]
	  test ip>>IM.SymPtr ne 0
	  ifso
	  [ ListSym(S, ip>>IM.SymPtr)
	    lastSymLoc = i
	  ]
	  ifnot
	  [ v = i-lastSymLoc
	    // PutTemplate(S, "   (+$O)", v)
	    Putc(S, $*S); Putc(S, $*S); Putc(S, $*S); Putc(S, $(); Putc(S, $+)
	    if v ge 1000b then Putc(S, (v rshift 9)+$0)
	    if v ge 100b then Putc(S, ((v rshift 6)&7)+$0)
	    if v ge 10b then Putc(S, ((v rshift 3)&7)+$0)
	    Putc(S, (v&7)+$0)
	    Putc(S, $))
	  ]
	  Putc(S, $*N)
	]
]