;
;-----------------------------------------------
;
;		S Y M B O L   T A B L E
;		M A N I P U L A T I O N
;
;-----------------------------------------------
;
;
;
;-----fixup reference to built-in routine------
;
; in:	a = routine identifier
;
fix.up.built.in.rtn:
	push	psw
	lxi	h,word
	lxi	d,word.save
	call	move.string
	pop	psw
;
	sta	word
	xra	a
	sta	word + 1
	call	fix.up.fwd.ref.word
;
	lxi	h,word.save
	lxi	d,word
	jmp	move.string
;
;
;
;--------------------------
;	all forward references cause all registers to be
;	undefined.  Specific cases must be handled elsewhere
;--------------------------
;
;
fix.up.fwd.ref.word:
	lhld	curr.ovl.start.key
	push	h
	call	opt.undef.all
	call	init.sym.tbl.srch
fufrw.lup:
	call	get.sym.tbl.entry
	lda	ste.type	;any more to do?
	cpi	stet.end.tbl
	jz	fufrw.restore.ovl	;exit
;
	lxi	h,curr.block.level	;is it within scope?
	lda	ste.block.level
	cmp	m
	jc	fufrw.restore.ovl	;exit
;
	lda	ste.type	;is it a fwd ref?
	cpi	stet.fwd.ref
	jnz	fufrw.lup
;
	lxi	h,ste.name	;is it same name?
	lxi	d,word
	call	compare.strings
	jnz	fufrw.lup
;
	lhld	ste.ovl.key	;is reference in an overlay?
	mov	a,h
	ana	l
	inr	a
	jz	fufrw.not.ovl
;
	lda	overlay.in.process	;patch ovl-to-ovl handled same
	ora	a			;as patch com-to-com
	jnz	fufrw.not.ovl
;
;---set up for overlay patch---
;
	push	h		;ovl-hdr key
	call	write.code.write
	;---save COM fcb---
	lxi	h,code.fcb
	lxi	d,code.fcb.save
	lxi	b,36
	call	move.h.2.d.cnt.b
	lxi	h,code.file.map
	lxi	d,code.map.save
	lxi	b,512
	call	move.h.2.d.cnt.b
	;---replace COM fcb with OVL fcb---
	lxi	h,ovl.fcb
	lxi	d,code.fcb
	lxi	b,36
	call	move.h.2.d.cnt.b
	;---don't allocate any new ovl recs---
	lxi	h,code.file.map
	lxi	d,code.file.map + 1
	mvi	m,0ffh
	lxi	b,511
	call	move.h.2.d.cnt.b
	mvi	a,0ffh
	sta	overlay.in.process
;
	pop	h		;ovl-hdr key
	shld	ovl.sctr.offset
	shld	curr.ovl.start.key
;
	lhld	curr.code.addr
	push	h		;save non-ovl address
;
;---find start address of overlay---
;
	lhld	start.wk.sym.tbl.addr	;save parms for
	push	h			;get.sym.tbl.entry
	lhld	wk.sym.tbl.addr
	push	h
;
	;--loop for earliest label in this overlay---
fufrw.get.ovl.lup:
	call	get.sym.tbl.entry
	lda	ste.type
	cpi	stet.end.tbl		;finished?
	jz	fufrw.ovl.endlup	;yes
;
	ani	0ffh - stet.deleted	;see what it used to be
	cpi	stet.label		;is this a label
	jnz	fufrw.get.ovl.lup	;no, can't be ovl start
;
	lhld	ste.ovl.key		;is it same overlay as patch?
	xchg
	lhld	ovl.sctr.offset
	call	cmp.de.fm.hl
	jnz	fufrw.get.ovl.lup	;no
;
	lhld	ste.address		;the last one here is overlay-start
	shld	fufrw.ovl.hdr.addr
	jmp	fufrw.get.ovl.lup
;
fufrw.ovl.endlup:
	;---restore previous sym-tbl search params---
	pop	h
	shld	wk.sym.tbl.addr
	pop	h
	shld	start.wk.sym.tbl.addr
	lxi	d,symbol.table.entry
	call	move.sym.tbl.entry
fufrw.ovl.hdr.addr	equ	$+1
	lxi	h,0
	shld	start.code.addr
;
;---do the patch---
;
	lhld	ste.address
	shld	curr.code.addr
	call	set.code.key
	shld	code.fcb + fcb.rnd.rec
	call	read.code.buff.only
	pop	h		;routine addr
	push	h		;re-save
	call	put.code.word
	call	write.code.write	;force disk update
	;---set back to non-overlay COM file---
	xra	a
	sta	overlay.in.process
	lxi	h,code.fcb.save
	lxi	d,code.fcb
	lxi	b,36
	call	move.h.2.d.cnt.b
	lxi	h,code.map.save
	lxi	d,code.file.map
	lxi	b,512
	call	move.h.2.d.cnt.b
	lxi	h,0
	shld	ovl.sctr.offset
	lxi	h,0100h
	shld	start.code.addr
	pop	h			;restore routine addr
	shld	curr.code.addr
	call	set.code.key
	call	read.code.buff.only
	jmp	fufrw.ovl.cont
;
;---NON-overlay fix-up---
;
fufrw.not.ovl:
	lhld	ste.address
	call	read.code
	lhld	curr.code.addr
	push	h
	lhld	ste.address
	shld	curr.code.addr
	pop	h
	push	h
	call	put.code.word
	pop	h
	shld	curr.code.addr
fufrw.ovl.cont:
	lhld	start.wk.sym.tbl.addr
	mov	a,m
	ori	stet.deleted
	mov	m,a
	jmp	fufrw.lup
;
;
fufrw.restore.ovl:
	pop	h
	shld	curr.ovl.start.key
	ret
;
;
;
;---------------------------------------
;
;
;	put code word / put code byte
; in:	(word) - hl (put into code l then h)
;	(byte) - a
;
put.code.word:
	mov	a,l
	push	h
	call	put.code.byte
	pop	h
	mov	a,h
put.code.byte:
	push	psw
;
	lhld	start.code.addr
	xchg
	lhld	curr.code.addr
	call	cmp.de.fm.hl
	cc	err.pgm.bounds
;
	call	read.code
;
	lhld	curr.code.addr
	mov	a,l
	lhld	start.code.addr
	sub	l
	ani	7fh
	mov	l,a
	mvi	h,0
	lxi	d,code.buffer
	dad	d
	pop	psw
	mov	m,a
	lhld	curr.code.addr
	inx	h
	shld	curr.code.addr
	ret
;
;
;
;
;
;---------------------------------------
write.code.write:
	lhld	code.fcb + fcb.rnd.rec
	lxi	d,code.file.map
	dad	d
	mvi	m,0ffh
	lxi	d,code.buffer
	mvi	c,26
	call	entry
;
;---add in possible overlay base sctr offset---
;
	lhld	code.fcb + fcb.rnd.rec
	push	h
	xchg
	lhld	ovl.sctr.offset
	dad	d
	shld	code.fcb + fcb.rnd.rec
	lxi	d,code.fcb
	mvi	c,34
	call	entry
	pop	h
	shld	code.fcb + fcb.rnd.rec
	push	psw
;
	lxi	d,dflt.dma
	mvi	c,26
	call	entry
;
	call	clear.code.buff
	pop	psw
	ora	a
	rz
	jmp	err.code.write
;
;
;
;
;--------------------------------------
;
;    read  code
;
;
read.code:
	call	set.code.key
	shld	curr.read.key
	xchg
	lhld	code.fcb + fcb.rnd.rec
	call	cmp.de.fm.hl
	rz
;
	call	write.code.write
;
	lxi	d,0
read.code.write.lup:
	push	d
	lxi	h,code.file.map
	dad	d
	mov	a,m
	ora	a
	jnz	read.code.written
;
	xchg
	shld	code.fcb + fcb.rnd.rec
	call	write.code.write
;
read.code.written:
	pop	d
	lhld	curr.read.key
	call	cmp.de.fm.hl
	jz	read.code.end
	inx	d
	jmp	read.code.write.lup
;
read.code.end:
	lhld	curr.read.key
	shld	code.fcb + fcb.rnd.rec
;
	lxi	d,code.file.map
	dad	d
	mov	a,m
	ora	a
	jz	clear.code.buff
;
read.code.buff.only:
;
	lxi	d,code.buffer
	mvi	c,26
	call	entry
;
	lhld	code.fcb + fcb.rnd.rec
	push	h
	xchg
	lhld	ovl.sctr.offset
	dad	d
	shld	code.fcb + fcb.rnd.rec
	lxi	d,code.fcb
	mvi	c,33
	call	entry
	pop	h
	shld	code.fcb + fcb.rnd.rec
;
	lxi	d,dflt.dma
	mvi	c,26
	jmp	entry
;
;
;
;----------------------------------
;     set code key
;
; in:	hl=memory address of code file
; out:	hl=code file key
;
;
set.code.key:
;---compute offset from start of code---
;---whether offset is zero or 100h------
	xchg
	lhld	start.code.addr
	mov	a,h
	cma
	mov	h,a
	mov	a,l
	cma
	mov	l,a
	inx	h
	dad	d
;--shr 8 then shl 1 (shr 7)
	mov	a,l
	mov	l,h
	mvi	h,0
	dad	h
	add	a
	mvi	a,0
	adc	l
	mov	l,a
	mvi	a,0
	adc	h
	mov	h,a
	ret
;
;
;
clear.code.buff:
	xra	a
	sta	code.buffer
	lxi	h,code.buffer
	lxi	d,code.buffer + 1
	lxi	b,127
	jmp	move.h.2.d.cnt.b
;
;
;
;
;
;---put word and 'ste.' params into symbol table---
;
put.word.into.tbl:
	lhld	curr.code.addr
	shld	ste.address
put.word.into.tbl.no.addr:
	lxi	h,word
	lxi	d,ste.name
	call	move.string
put.ste.into.tbl.no.addr:
	lhld	curr.ovl.start.key
	lda	overlay.in.process
	ora	a
	jnz	psit.is.ovl
	lxi	h,0ffffh
psit.is.ovl:
	shld	ste.ovl.key
	lda	curr.block.level
	sta	ste.block.level
;
;---fall into 'move.entry.to.sym.tbl'---
;
;
;
;
;-----move symbol.table.entry into symbol table-----
; in:	symbol.table.entry
;	start.sym.tbl.addr
;
; out:	start.sym.tbl.addr
;
;
move.entry.to.sym.tbl:
	lxi	d,ste.name - 1
	lxi	b,(ste.name - symbol.table.entry)
metst.count.lup:
	inx	b
	inx	d
	ldax	d
	ora	a
	jnz	metst.count.lup
;
	push	d
	lhld	my.top.stk.addr
	dad	b
	xchg
	lhld	start.sym.tbl.addr
	call	cmp.hl.fm.de
	pop	d
	jc	metst.move.lup
;
	lxi	d,em.sym.ofl
	mvi	c,9
	call	entry
	jmp	boot
em.sym.ofl:
	db	'symbol table overflow',13,10,'$'
;
metst.move.lup:
	dcx	h
	ldax	d
	mov	m,a
	dcx	d
	dcx	b
	mov	a,b
	ora	c
	jnz	metst.move.lup
	shld	start.sym.tbl.addr
;
;---check if new low sym tbl addr---
;
	xchg
	lhld	lowest.sym.tbl.addr
	call	cmp.hl.fm.de
	xchg
	rnc
;
	shld	lowest.sym.tbl.addr
	ret
;
;
;
;
;---------------------------------------------------
;
set.dflt.dma:
	lxi	d,dflt.dma
	mvi	c,26
	jmp	entry
;
set.dflt.dma.map:	db	00h
;
;--------------------------------------------------
;
listing.crlf:
	mvi	e,0dh
	call	print.out
	mvi	e,0ah
	jmp	print.out
;
;
con.ch.in:
	mvi	c,1
	jmp	entry
;
;
listing.string.out:
	ldax	d
	ora	a
	rz
	inx	d
	push	d
	mov	e,a
	call	print.out
	pop	d
	jmp	listing.string.out
;
;
;
listing.blk.hex.out:
	push	psw
	mvi	e,' '
	call	print.out
	pop	psw
listing.hex.out:
	push	psw
	rrc
	rrc
	rrc
	rrc
	call	listing.hex.digit
	pop	psw
listing.hex.digit:
	ani	0fh
	adi	'0'
	cpi	'9'+1
	jc	listing.hex.ok
	adi	7
listing.hex.ok:
	mov	e,a
	jmp	print.out
;
;
;
print.sym.tbl.entry:
	lxi	d,pst.lit.type
	call	listing.string.out
	lda	ste.type
	call	listing.hex.out
;
	lxi	d,pst.lit.address
	call	listing.string.out
	lda	ste.address + 1
	call	listing.hex.out
	lda	ste.address
	call	listing.hex.out
;
	lxi	d,pst.lit.level
	call	listing.string.out
	lda	ste.block.level
	call	listing.hex.out
;
	lxi	d,pst.lit.ovl
	call	listing.string.out
	lda	ste.ovl.key + 1
	call	listing.hex.out
	lda	ste.ovl.key
	call	listing.hex.out
;
	lxi	d,pst.lit.length
	call	listing.string.out
	lda	ste.length + 1
	call	listing.hex.out
	lda	ste.length
	call	listing.hex.out
;
	lxi	d,pst.lit.name
	call	listing.string.out
	lxi	d,ste.name
	ldax	d
	ani	80h	;special?
	jnz	str.to.print.in.hex
	call	listing.string.out
	jmp	listing.crlf
;
;
pst.lit.type:		db	'type:',0
pst.lit.address:	db	' addr:',0
pst.lit.level:		db	' lvl:',0
pst.lit.ovl:		db	' ovl#:',0
pst.lit.length:		db	' length:',0
pst.lit.name:		db	' name:',0
pst.line.wk:		db	'       ',0
;
;
;
;
;
;
;
;------------------------------------------
;
;
print.out.word:
	lxi	d,word
	ldax	d
	ani	80h
	jnz	err.unx.hex
	call	listing.string.out
	jmp	listing.crlf
;
err.unx.hex:
	call	str.to.print.in.hex
	jmp	listing.crlf
;
;
;
;
;
str.to.print.in.hex:
	ldax	d
	ora	a
	jz	listing.crlf
	inx	d
	push	d
	call	listing.blk.hex.out
	pop	d
	jmp	str.to.print.in.hex
;
;
;
;
;----------------------------------------------
;
;
;
err.pgm.bounds:
	lxi	h,em.pgm.bounds
	jmp	print.error
em.pgm.bounds:
	db	'Program address out of bounds',0
;
;
;
;----------------------------------------------
;
;
;
;
;----initialize for symbol table search----
;
init.sym.tbl.srch:
	lhld	start.sym.tbl.addr
	shld	wk.sym.tbl.addr
	lhld	end.sym.tbl.addr
	shld	start.wk.sym.tbl.addr
	ret
;
;
;
;-----get next symbol-table entry-----
;
; in:	wk.sym.tbl.addr		points at next entry
;
; out:	symbol.table.entry
;	wk.sym.tbl.addr		points at new next entry
;	start.wk.sym.tbl.addr	points at new current entry
;
get.sym.tbl.entry:
	lhld	wk.sym.tbl.addr
	shld	start.wk.sym.tbl.addr
	lxi	d,symbol.table.entry
	call	move.sym.tbl.entry
	shld	wk.sym.tbl.addr
	ret
;
;
;
print.out.c.blanks:
	mov	a,c
	ora	a
	rz
	push	b
	mvi	e,' '
	call	print.out
	pop	b
	dcr	c
	jmp	print.out.c.blanks
;
;
;
move.sym.tbl.entry:
	lxi	b,ste.name - symbol.table.entry
	call	move.h.2.d.cnt.b
	jmp	move.string
;
;
;
put.fwd.bir.sv.word:
	lhld	word
	push	h
	call	put.fwd.ref.bir
	pop	h
	shld	word
	ret
;
;
;
put.bir.call.fwd:
	push	psw
	call	opt.undef.all
	mvi	a,(call)
	call	put.code.byte
	pop	psw
put.fwd.ref.bir:
	sta	word
	mov	c,a
	xra	a
	sta	word + 1
;
	mov	a,c
	cpi	bir.routine.limit
	jnc	put.fwd.ref.addr
	sui	bir.routine.base
	mov	e,a
	mvi	d,0
	lxi	h,built.in.rtn.flags
	dad	d
	mov	m,c
;
;
;
;---put backwards jump to table if table present---
;
	lda	table.fwd.flag
	ora	a
	jz	put.fwd.ref.addr
;
	mov	h,d
	mov	l,e
	dad	h	;times 3
	dad	d
	xchg
	lhld	fwd.tbl.addr
	dad	d
	jmp	put.code.word
;
;
;
;---no table present -- put forward reference---
;	(also entry point for fwd-ref addresses)
;
put.fwd.ref.addr:
	mvi	a,stet.fwd.ref
	sta	ste.type
	lxi	h,0
	shld	ste.length
	call	put.word.into.tbl
	lxi	h,0
	jmp	put.code.word
;
;
;
err.code.write:
	lxi	d,em.code.write
	mvi	c,9
	call	entry
	mvi	c,1
	call	entry
	cpi	3
	jz	boot
	ret
;
;
;
em.code.write:
	db	'COM file write error',13,10
	db	'press ^C to abort, or any other',13,10
	db	'key to ignore',13,10,'$'
;
;
;
print.out:
	lda	print.console
	ora	a
	jz	print.out.not.con
	push	d
	call	print.con.ch
	pop	d
print.out.not.con:
	lda	print.printer.flag
	ora	a
	jz	print.out.not.printer
	push	d
	mvi	c,5
	call	entry
	pop	d
print.out.not.printer:
	lda	print.disk.flag
	ora	a
	rz				;exit
	push	d
	mov	a,e
	lxi	h,print.fcb + fcb.status	;zero status
	mvi	m,0
	push	h
	lxi	d,print.fcb
	call	disk.char.out
	pop	h
	mov	a,m		;check status
	ora	a
	jz	print.out.disk.ok
	lxi	d,em.print.disk
	mvi	c,9
	call	entry
	xra	a		;stop disk print on error
	sta	print.disk.flag
print.out.disk.ok:
	pop	d
	ret
;
;
;
print.error.and.colm:
	call	print.error
	jmp	print.error.colm
;
;
;
print.error.and.word:
	mvi	a,0ffh
	sta	print.word.flag
	call	print.error
	jmp	print.out.word
;
;
;
print.warning:
	lda	nowarn.flag
	ora	a
	rnz
	mvi	a,'>'
	sta	prt.err.flag.byte
	push	h
	jmp	print.warn.entry
;
;
;
print.error:
	push	h
	lhld	err.ctr
	inx	h
	shld	err.ctr
	mvi	e,7
	call	print.con.ch	;beep on error
	mvi	a,'-'
	sta	prt.err.flag.byte
print.warn.entry:
	mvi	d,5
prt.err.dash.lup:
	push	d
prt.err.flag.byte	equ	$+1
	mvi	e,'-'
	call	print.out
	pop	d
	dcr	d
	jnz	prt.err.dash.lup
	pop	h
print.error.lup:
	mov	a,m
	ora	a
	jz	print.error.end
	push	h
	mov	e,a
	call	print.out
	pop	h
	inx	h
	jmp	print.error.lup
;
print.error.end:
	lda	print.word.flag
	ora	a
	cz	listing.crlf
	xra	a
	sta	print.word.flag
	mvi	a,0ffh
	sta	error.this.line
	ret
;
;
;
print.error.colm:
	lda	curr.print.colm
	ora	a
	rz
;
;-----check number of spaces print is offset-----
;
	mvi	c,0
	lda	print.blk.match.flag
	ani	06h
	add	c
	mov	c,a
;
	lda	print.blk.lvl.flag
	ani	6
	add	c
	mov	c,a
;
	lda	print.line.num.flag
	ani	6
	add	c
	mov	c,a
;
	lda	print.code.addr.flag
	ani	5
	add	c
	mov	c,a
;
	call	print.out.c.blanks
;
;
	lda	curr.print.colm
	dcr	a
	ora	a
	jz	prt.err.got.colm
	cpi	print.line.size - 3
	jnc	prt.err.got.colm
prt.err.colm.lup:
	push	psw
	mvi	e,'-'
	call	print.out
	pop	psw
	dcr	a
	jnz	prt.err.colm.lup
prt.err.got.colm:
	mvi	e,'|'
	call	print.out
	jmp	listing.crlf
;
;
;
;
print.con.ch:
	mvi	c,2
	jmp	entry
;
em.print.disk:
	db	7,'Print write error$'
;
;
;
;
;--------------  End of LCOMMON.ASM  -----------------
;;
;