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