// MDdump.bcpl -- dump routines for MicroD
// last edited December 12, 1979  2:34 PM

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

external	// defined here
[	Dump	// (S, zone)
	DumpSyms	// (S, tab, len, zone)
	// for MDlist
	FixIFUM	// (tempvec, i)
	@mSymPtrs
]

external	// used
[
// OS
	Allocate
	Puts
	MoveBlock
// MDmain
	@IP
	Err
	MaxBlock
	@DMachine
	@NInstructions
	@RM; @RMbits
	@IFUM; @IFUMbits
	@ALUFM; @ALUFMbits
// MDload
	fixTab
	@mSymMax
// MDout
	AllocOut; WriteOut; FreeOut
	@OutBuf; @OutPtr; @OutEnd
// MDasm
	Get1Bit
]


static
[	@mSymPtrs
]


let Dump(S, zone) be
[	Err(PassMessage, "Writing .MB file...")
	Puts(S, MBaddress); Puts(S, IMmemx); Puts(S, 0)
	let delta = (DMachine eq 1? 5, 6)
	let nBuf = MaxBlock(zone)/delta
	AllocOut(zone, nBuf*delta)
	let ptr = OutEnd
	[ ptr = ptr-delta
	  ptr!0, ptr!1 = MBdata, 0
	] repeatuntil ptr eq OutBuf
	for i = 0 to NInstructions-1 do
	[ if OutPtr eq OutEnd then WriteOut()
	  let ip = IP(i)
	  let awd = ip>>IM.W0
	  if ip>>IM.brkP then awd = awd+140000b
	  if ip>>IM.emulator then awd = awd+10000b
	  test DMachine eq 0
	   ifso
	  [ // Compute odd parity
	    ip>>TI.parity0 = 0
	    let x = ip>>TI.iw0 xor ip>>TI.iw1 xor (ip>>TI.iw2 & 170000b)
	    x = (x rshift 8) xor x
	    x = (x rshift 4) xor x
	    ip>>TI.parity0 = table[ 1;0;0;1;0;1;1;0;0;1;1;0;1;0;0;1 ]!(x&17b)
	    OutPtr!4 = (ip>>TI.iw2 & 170000b)
	  ]
	   ifnot
	  if DMachine eq 2 then	// shuffle bits back
	  [ let w0, w1, w2 = ip>>TI.iw0, ip>>TI.iw1, ip>>TI.iw2
	    ip>>TI.iw0 = (w2 & 100000b) + (w0 rshift 1)
	    ip>>TI.iw1 = (w0 lshift 15) + (w1 rshift 1)
	    ip>>TI.iw2 = (w1 lshift 15) + (w2 & 77777b)
	    OutPtr!4 = (ip>>TI.iw2 & 170000b)
	  ]
	  OutPtr!2, OutPtr!3 = ip>>TI.iw0, ip>>TI.iw1
	  OutPtr = OutPtr+delta
	  OutPtr!-1 = awd	// !4 or !5 as appropriate
	]
	DumpXRefs()
	let DumpRM(i) = valof
	[ @OutPtr = RM!i; resultis 1 ]
	DumpMem(RMmemx, RMbits, RMsize, DumpRM)
	if DMachine ne 0 then
	[ let DumpIFUM(i) = valof
	  [ FixIFUM(OutPtr, i); resultis 2 ]
	  DumpMem(IFUMmemx, IFUMbits, IFUMsize, DumpIFUM)
	  let DumpALUFM(i) = valof
	  [ @OutPtr = ALUFM!i; resultis 1 ]
	  DumpMem(ALUFMmemx, ALUFMbits, ALUFMsize, DumpALUFM)
	]
	WriteOut()
	FreeOut(zone)
]

and DumpXRefs() be
// Dump external references
[	let fixp = fixTab
	let limit = OutEnd-maxMBblock
	let JNfield = table[ JNfield0; JNfield1; JNfield2 ]!DMachine
	until @fixp eq -1 do
	[ fixp = fixp+2
	  let val = fixp!-1
	  if OutPtr-limit ge 0 then WriteOut()
	  OutPtr!0, OutPtr!2 = MBexternalfixup, fixp!-2 & (IMsize-1)
	  test (fixp!-2 lshift 1) ls 0	// test if from IFUM
	   ifso OutPtr!1, OutPtr!3 = IFUMmemx, IFADfield
	   ifnot OutPtr!1, OutPtr!3 = IMmemx, JNfield
	  OutPtr = OutPtr+4
	  let p = val+1
	  [ p = p+1
	    @OutPtr = @p & 77777b
	    OutPtr = OutPtr+1
	  ] repeatuntil @p ls 0
	  if (@p)<<rh ne 0 then [ @OutPtr = 0; OutPtr = OutPtr+1 ]
	]
]

and FixIFUM(v, i) = valof
[	let ip = IFUM+i*lIFUM
	MoveBlock(v, ip, lIFUM)
	v>>TIFUM.PA = ip>>IFUM.PA
	let addr = ip>>IFUM.IFAD
	if addr ne 7777B then
	  v>>TIFUM.notIFADr2 = not (IP(addr)>>IM.W0 rshift 2)	// Dorado model 1 only
	resultis addr
]

and DumpMem(memx, membits, memsize, proc) be
[	let first = true
	let addr = -1
	let limit = OutEnd-maxMBblock
	for i = 0 to memsize-1 do
	 if Get1Bit(membits, i) then
	[ if OutPtr-limit ge 0 then WriteOut()
	  if i ne addr then
	  [ @OutPtr, OutPtr!1, OutPtr!2 = MBaddress, memx, i
	    OutPtr = OutPtr+3
	  ]
	  @OutPtr, OutPtr!1 = MBdata, 0
	  OutPtr = OutPtr+2
	  OutPtr = proc(i)+OutPtr
	  addr = i+1
	]
]


let DumpSyms(S, tab, len, zone) be
[	AllocOut(zone, MaxBlock(zone))
	let limit = OutEnd-maxMBblock
	for i = 0 to len-1 do
	[ let sym = tab!i
	  until sym eq 0 do
	  [ if OutPtr-limit ge 0 then WriteOut()
	    @OutPtr, OutPtr!1, OutPtr!2 = MBsymbol, (sym!-1)<<Sym.memx, (sym!-1)<<Sym.addr
	    OutPtr = OutPtr+3
	    let p = sym
	    [ p = p+1
	      @OutPtr = @p & 77777b
	      OutPtr = OutPtr+1
	    ] repeatuntil @p ls 0
	    if (@p)<<rh ne 0 then [ @OutPtr = 0; OutPtr = OutPtr+1 ]
	    sym = @sym
	  ]
	]
	WriteOut()
	FreeOut(zone)
]