//
// PrintMB.bcpl -- print out a .MB file
// last edited August 9, 1978  5:06 PM
//

external [	// defined here
	PrintMB	// (instrm, outstrm, zone[, inst]) -> inst
]

external [
		// O.S.
	Gets; Puts; Wss; Wos
	MoveBlock; SetBlock
	Allocate
		// Template
	PutTemplate
	]


manifest	// Micro binary block types
[	MBend = 0	// ()
	MBdata = 1	// (sourceline, data)
	MBaddress = 2	// (memory, addr)
	MBfixup = 3	// (memory, addr, (firstbit, lastbit), value)
	MBmemory = 4	// (memory, width, name)
	MBsymbol = 5	// (memory, addr, name)
	MBexternalfixup = 6	// (memory, addr, (firstbit, lastbit), name)
]

structure [ lh bit 8; rh bit 8 ]

manifest [ maxMems = 16 ]

structure Inst:	// the instance structure
[	mnames^0,maxMems-1 word	// pointers to memory names
	mwidths^0,maxMems-1 word	// memory widths
	mds^0,maxMems-1 word 2	// dummy memory name strings
]
manifest [ lInst = size Inst/16 ]


let PrintMB(in, out, zone, inst; numargs na) = valof
[	let mem, addr = 0, nil
	let paddr = nil
	if (na ls 4) % (inst eq 0) then
	[ inst = Allocate(zone, lInst)
	  SetBlock(lv inst>>Inst.mwidths, -1, maxMems)
	  for i = 0 to maxMems-1 do
	  [ let p = lv inst>>Inst.mds^i
	    inst>>Inst.mnames^i = p
	    test i ls 8
	    ifso p!0, p!1 = 1000b+$#, ($0+i) lshift 8
	    ifnot p!0, p!1 = 1400b+$#, $1 lshift 8 + $0+(i&7)
	  ]
	]
	let mnames, mwidths = lv inst>>Inst.mnames, lv inst>>Inst.mwidths
	let sym = vec 100

 [	let type = Gets(in)
	switchon type into [

case MBend:
	break

case MBdata: [
	if mwidths!mem eq -1 then
	[ PutTemplate(out, "*N****** Data for memory #$O before MEMORY definition *******N", mem)
	  break
	]
	Gets(in)
	if (addr ne paddr) & ((addr&7) eq 0) then
	[ PutTemplate(out, "($S $UO)*N", mnames!mem, addr); paddr = addr ]
	for i = 1 to mwidths!mem do
	[ Puts(out, $*S); Wos(out, Gets(in)) ]
	Puts(out, $*N)
	addr = addr+1
	endcase ]

case MBaddress: [
	mem = Gets(in); addr = Gets(in)
	PutTemplate(out, "$S $UO:*N", mnames!mem, addr)
	paddr = addr
	endcase ]

case MBfixup: [
	let mem = Gets(in); let addr = Gets(in)
	let bits = Gets(in); let val = Gets(in)
	PutTemplate(out, "$S $UO [$O:$O] _ $UO*N", mnames!mem, addr, bits rshift 8, bits&#377, val)
	endcase ]

case MBmemory: [
	let mem = Gets(in); let width = Gets(in)
	mwidths!mem = (width+#17) rshift 4
	readsymbol(in, sym)
	PutTemplate(out, "MEMORY[$S,$UO] #$O*N", sym, width, mem)
	let nw = sym>>lh rshift 1 + 1
	let namep = Allocate(zone, nw)
	MoveBlock(namep, sym, nw)
	mnames!mem = namep
	endcase ]

case MBsymbol: [
	let mem = Gets(in); let addr = Gets(in)
	readsymbol(in, sym)
	PutTemplate(out, "$S = $S $UO*N", sym, mnames!mem, addr)
	endcase ]

case MBexternalfixup: [
	let mem = Gets(in); let addr = Gets(in)
	let bits = Gets(in)
	readsymbol(in, sym)
	PutTemplate(out, "$S $UO [$O:$O] _ $S*N", mnames!mem, addr, bits rshift 8, bits&#377, sym)
	endcase ]

default:
	PutTemplate(out, "*N****** Unknown block type: $UO *******N", type)
	break

  ]
 ] repeat

	resultis inst
]

and readsymbol(in, str) be
[	let sp, wd = str, Gets(in)
	@sp = wd<<lh; sp = sp+1
	while wd<<rh ne 0 do
	[ let w1 = Gets(in)
	  @sp = (wd lshift 8)+(w1 rshift 8)
	  sp, wd = sp+1, w1
	]
	str>>lh = 2*(sp-str)+(wd<<lh eq 0? -2, -1)
]