start:		;label not used - prevents assembly error
my.stack.top:	;label not used - prevents assembly error
;
	org	ovly.start.loc
;
;
;
	mvi	a,bir.END
	call	fix.up.built.in.rtn
;
;---have object program close it's overlay file---
	lda	any.overlay
	ora	a
	jz	MAIN.no.ovl.used
;
	mvi	a,21h
	call	put.code.byte
	lxi	h,0ffffh
	call	put.code.word
	mvi	a,bir.overlay.load
	call	put.bir.call.fwd
;---Copy overlay name to object routine--
	lxi	h,ovl.fcb + 1
	lxi	d,ovl.load.fcb + 1
	lxi	b,11
	call	move.h.2.d.cnt.b

	lxi	h,ovl.load.fcb + 6	;set R/O mode for MP/M
	mov	a,m
	ori	80h
	mov	m,a
MAIN.no.ovl.used:
;
	lda	stack.save.flag
	ora	a
	jz	MAIN.end.no.stk.sv
;
	mvi	a,bir.cpm.stack
	lxi	h,0
	call	put.LXI.H.fixup
	call	put.SPHL
	call	put.RET
;
	jmp	MAIN.eof.src
;
MAIN.end.no.stk.sv:
;
	lda	stack.none.flag
	ora	a
	jz	MAIN.reboot
;
	call	put.RET
	jmp	MAIN.eof.src
;
MAIN.reboot:
	call	put.JMP
	lxi	h,BOOT
	call	put.code.word
;
MAIN.eof.src:
;
;-----final forward reference fix-up-----
;
	lxi	h,l.eoj.himem
	shld	himem.bir.ptr
;
	lxi	h,bir.descriptions
	shld	curr.rtn.desc.addr
;
	lxi	d,built.in.rtn.flags
	lxi	h,reloc.rtn.tbl
MAIN.reloc.lup:
	ldax	d
	cpi	0ffh
	jz	MAIN.reloc.end
	inx	d
	push	d
	ora	a
	jz	MAIN.chk.nxt.reloc
	mov	c,a
	push	h
;
;
;
;---check if fwd table is prresent---
;
	lda	table.fwd.flag
	ora	a
	jz	MAIN.no.tbl.fix
;
	push	h
	push	d
	push	b
	mvi	b,0
	mov	h,b
	mov	a,c
	sui	bir.routine.base
	mov	l,a
	mov	c,a
	dad	h	;times 3
	dad	b
	mov	b,h
	mov	c,l
	lhld	fwd.tbl.addr
	dad	b
;
;---if printing map & using fwd tbl, show vector address---
;
	lda	reloc.map.flag
	ora	a
	jz	MAIN.no.vctr.prt
;
	push	h	;addr of bir-tbl JMP
	mvi	e,'('
	call	print.out
	pop	h
	push	h
	lxi	d,print.line
	call	cvt.bin.2.hex.str
	lxi	d,print.line
	call	listing.string.out
	mvi	e,')'
	call	print.out
	mvi	e,' '
	call	print.out
	pop	h	;addr of bir-tbl JMP
MAIN.no.vctr.prt:
	inx	h	;past JMP instr
	xchg
	lhld	himem.bir.ptr
	mov	m,e	;store addr of JMP addr
	inx	h
	mov	m,d
	inx	h
	xchg
	lhld	curr.code.addr
	xchg
	mov	m,e	;store addr to jump to
	inx	h
	mov	m,d
	inx	h
	shld	himem.bir.ptr
	pop	b
	pop	d
	pop	h
MAIN.no.tbl.fix:
;
;---check if to print map---
;
	lda	reloc.map.flag
	ora	a
	jz	MAIN.no.MAP
	push	b
	lhld	curr.code.addr
	lxi	d,print.line
	call	cvt.bin.2.hex.str
	lxi	d,print.line
	call	listing.string.out
	mvi	e,' '
	call	print.out
	lhld	curr.rtn.desc.addr
	xchg
	call	listing.string.out
	call	listing.crlf
	pop	b
	pop	h
	push	h
MAIN.no.MAP:
;
	call	put.reloc.rtn
	pop	h
MAIN.chk.nxt.reloc:
	lxi	d,4
	dad	d
	pop	d
MAIN.reloc.chk.end:
	mov	a,m
	inx	h
	ora	a
	jnz	MAIN.reloc.chk.end
;
	push	d
	push	h
	lhld	curr.rtn.desc.addr
	xchg
	call	size.d.2.h
	inx	d
	xchg
	shld	curr.rtn.desc.addr
	pop	h
	pop	d
	jmp	MAIN.reloc.lup
;
;
himem.bir.ptr	dw	l.eoj.himem
;
;
MAIN.reloc.end:
;
;---if fwd-tbl used, go back and patch in vectors---
;
	lhld	curr.code.addr
	push	h
	lda	table.fwd.flag
	ora	a
	jz	hi.bir.end
;
	lxi	h,l.eoj.himem
	shld	himem.bir.ptr
;
	lxi	d,built.in.rtn.flags
hi.bir.lup:
	ldax	d
	cpi	0ffh
	jz	hi.bir.end
	inx	d
	push	d
	ora	a
	jz	chk.nxt.hi.bir
;
	lhld	himem.bir.ptr
	mov	e,m	;get addr of JMP addr
	inx	h
	mov	d,m
	inx	h
	xchg
	shld	curr.code.addr
	xchg
	mov	e,m	;get addr to jump to
	inx	h
	mov	d,m
	inx	h
	shld	himem.bir.ptr
	xchg
	call	put.code.word
chk.nxt.hi.bir:
	pop	d
	jmp	hi.bir.lup
;
hi.bir.end:
	pop	h
	shld	curr.code.addr	;restore high code addr
;
;-----if stack size specified, allocate stack storage-----
;
	lda	stack.id.flag
	ora	a
	jz	MAIN.not.stack.id
;
	lhld	stack.id.size
	xchg
	lhld	curr.code.addr
	dad	d
	shld	curr.code.addr
	mvi	a,bir.stack.fwd
	call	fix.up.built.in.rtn
MAIN.not.stack.id:
;
;----highest memory address---
;
	mvi	a,bir.hi.mem
	call	fix.up.built.in.rtn
;
;
;---anything left as a forward reference is undefined--
;
	call	init.sym.tbl.srch
MAIN.undef.find.lup:
	call	get.sym.tbl.entry
	lda	ste.type
	cpi	stet.deleted
	jnc	MAIN.undef.find.lup
	cpi	stet.end.tbl
	jz	MAIN.end
	call	err.undef.label
	call	print.sym.tbl.entry
	jmp	MAIN.undef.find.lup
MAIN.end:
	call	write.code.write
	lxi	d,code.fcb
	mvi	c,16
	call	entry
;
;---close compiler's overlay output file---
;
	lda	any.overlay
	ora	a
	jz	MAIN.no.ovl.close
	lxi	h,ovl.fcb
	lxi	d,code.fcb
	lxi	b,36
	call	move.h.2.d.cnt.b
	lxi	d,code.fcb
	mvi	c,16
	call	entry
MAIN.no.ovl.close:
;
;---close source file---
;
	lxi	d,src.in
	mvi	c,16	;close
	call	entry
;
;-------------------------------
;   compiler summary printing
;-------------------------------
;
	call	listing.crlf
	call	listing.crlf
;
	mvi	a,0ffh
	sta	print.console
;
;--- # errors ---
;
	lhld	err.ctr
	lxi	d,decimal.work
	call	cvt.bin.2.dec.str
	lxi	d,decimal.work
	call	listing.string.out
	lxi	d,msg.err
	call	listing.string.out
;
	lda	nowarn.flag
	ora	a
	jnz	summ.skip.1a
;---# statements---
	lhld	statement.counter
	lxi	d,decimal.work
	call	cvt.bin.2.dec.str
	lxi	d,decimal.work
	call	listing.string.out
	lxi	d,msg.statements
	call	listing.string.out
;---# lines printed---
	lhld	print.line.ctr
	lxi	d,decimal.work
	call	cvt.bin.2.dec.str
	lxi	d,decimal.work
	call	listing.string.out
	lxi	d,msg.lines.printed
	call	listing.string.out
	call	listing.crlf
;
;--- total symbol table space ---
;
summ.skip.1a:
	lhld	my.top.stk.addr
	xchg
	lhld	end.sym.tbl.addr
	call	sub.de.fm.hl.2.hl
	shld	tot.sym.space
;
	lda	nowarn.flag
	ora	a
	jnz	summ.skip.1b
;
	lxi	d,decimal.work
	call	cvt.bin.2.dec.str
	lxi	d,msg.tot.sym.tbl.spc
	call	listing.string.out
	lxi	d,decimal.work
	call	listing.string.out
	call	listing.crlf
;
;--- symbol table space used ---
;
summ.skip.1b:
	lhld	lowest.sym.tbl.addr
	xchg
	lhld	end.sym.tbl.addr
	call	sub.de.fm.hl.2.hl
	shld	used.sym.space
;
	lda	nowarn.flag
	ora	a
	jnz	summ.skip.1c
;
	lxi	d,decimal.work
	call	cvt.bin.2.dec.str
	lxi	d,msg.usd.sym.tbl.spc
	call	listing.string.out
	lxi	d,decimal.work
	call	listing.string.out
;
;---  % = used / (total / 100)
;
summ.skip.1c:
	lhld	tot.sym.space
	xchg
	lxi	h,100
	call	div.d.by.h.2.d.r.h
	lhld	used.sym.space
	xchg
	call	div.d.by.h.2.d.r.h
	xchg
	lxi	d,decimal.work
	call	cvt.bin.2.dec.str
	lxi	d,msg.percent.prefix
	call	listing.string.out
	lxi	d,decimal.work
	call	listing.string.out
	lxi	d,msg.percent.postfix
	call	listing.string.out
;
	lda	nowarn.flag
	ora	a
	jnz	summ.skip.2
;
	call	listing.crlf
;
;---highest code addr
;
summ.skip.2:
	lhld	curr.code.addr
	lxi	d,decimal.work
	call	cvt.bin.2.hex.str
	lxi	d,msg.hi.obj.code
	call	listing.string.out
	lxi	d,decimal.work
	call	listing.string.out
;
	lda	nowarn.flag
	ora	a
	jnz	summ.skip.3
;
	lxi	d,msg.num.k.prefix
	call	listing.string.out
;---#k
	lhld	curr.code.addr
	lxi	d,100h
	call	sub.de.fm.hl.2.hl
	lxi	d,7fh	;round up #k to next 1/4 K
	dad	d
	push	h
	xchg
	lxi	h,1024
	call	div.d.by.h.2.d.r.h
	xchg
	lxi	d,decimal.work
	call	cvt.bin.2.dec.str
	lxi	d,decimal.work
	call	listing.string.out
	pop	d
	mov	a,d
	ani	03h
	ora	a
	jz	MAIN.even.K
	dcr	a
	jz	MAIN.25.K
	dcr	a
	jz	MAIN.50.K
;
	lxi	d,msg.75
	jmp	MAIN.K.fract
;
MAIN.50.K:
	lxi	d,msg.50
	jmp	MAIN.K.fract
;
MAIN.25.K:
	lxi	d,msg.25
MAIN.K.fract:
	call	listing.string.out
MAIN.even.K:
;
;--- number of records in code file ---
	lxi	d,msg.num.recs.prefix
	call	listing.string.out
;---# recs
	lhld	curr.code.addr
	call	set.code.key
	inx	h
	lxi	d,decimal.work
	call	cvt.bin.2.dec.str
	lxi	d,decimal.work
	call	listing.string.out
	lxi	d,msg.num.recs.postfix
	call	listing.string.out
	call	listing.crlf
summ.skip.3:
;
;---close print file
;
	lda	print.disk.flag
	ora	a
	jz	MAIN.final.end
;
	lxi	d,print.fcb
	call	close.dsk.ch
;
	lxi	d,print.fcb
	mvi	c,16	;close
	call	entry
	inr	a
	jnz	MAIN.final.end
	lxi	d,em.print.close
	mvi	c,9
	call	entry
	jmp	MAIN.final.end
;
em.print.close:
	db	'Print File Close Error$'
;
;
MAIN.final.end:
	lda	auto.execute.flag
	ora	a
	jz	boot
	lhld	err.ctr
	mov	a,h
	ora	l
	jnz	boot
;
	lxi	h,code.fcb
	lxi	d,dflt.fcb
	lxi	b,dflt.dma - dflt.fcb
	call	move.h.2.d.cnt.b
;
	xra	a
	sta	dflt.fcb + fcb.ext.num
	sta	dflt.fcb + fcb.cur.rec
	lxi	h,0
	push	h
	push	psw
	jmp	execute.no.format
;
;------------------------------------------------------
;
;
;
;
;-----------------------------------------------------
;	output relocatable routine to object code
;
; in:	hl -> reloc table entry
;	c  =  bir code
;
;
put.reloc.rtn:
	push	h
	mov	a,c
	call	fix.up.built.in.rtn
	pop	h
;
	mov	e,m
	inx	h
	mov	d,m
	inx	h
	xchg
	shld	curr.rtn.strt.addr
	shld	curr.rtn.addr
;
	xchg
	mov	e,m
	inx	h
	mov	d,m
	inx	h
	xchg
	shld	strt.map.loc
	shld	curr.map.loc
;
	xchg
	shld	curr.rtn.fwd.tbl
;
	mvi	a,80h
	sta	curr.reloc.bit
;
	lhld	curr.code.addr
	shld	curr.rtn.code.strt.addr
;
prr.lup:
	call	prr.test.reloc.bit
	jz	prr.no.reloc
;
	call	prr.test.reloc.bit
	jz	prr.reloc
	lhld	curr.rtn.fwd.tbl
	mov	a,m
	inx	h
	shld	curr.rtn.fwd.tbl
	call	put.fwd.ref.bir
	lhld	curr.rtn.addr
	inx	h
	inx	h
	shld	curr.rtn.addr
	jmp	prr.next
;
prr.reloc:
	lhld	curr.rtn.addr
	mov	e,m	;de <- value of reloc reference
	inx	h
	mov	d,m
	inx	h
	shld	curr.rtn.addr
;
	lhld	curr.rtn.strt.addr
	xchg
;---subtract start of rtn from reference location---
	call	sub.de.fm.hl.2.hl
	xchg
	lhld	curr.rtn.code.strt.addr
	dad	d
	call	put.code.word
	jmp	prr.next
;
prr.no.reloc:
	lhld	curr.rtn.addr
	mov	a,m
	inx	h
	shld	curr.rtn.addr
	call	put.code.byte
;
prr.next:
	lhld	strt.map.loc
	xchg
	lhld	curr.rtn.addr
	call	cmp.de.fm.hl
	jc	prr.lup
	ret
;
;
;
prr.test.reloc.bit:
	lhld	curr.map.loc
	mov	c,m
	lda	curr.reloc.bit
	mov	b,a
	ana	c
	push	psw
	mov	a,b
	rrc
	sta	curr.reloc.bit
	cpi	80h
	jnz	prr.trb.exit
	lhld	curr.map.loc
	inx	h
	shld	curr.map.loc
prr.trb.exit:
	pop	psw
	ret
;
;
;
;