.title 'Cross Referencer for Modern Times 10/13 11:04'
.ident crossx
.SBTTL 7EQUATE DEFINITION AREA7
	.PABS
	.PHEX
	.SALL
;  
; this is a cross reference program
	version==1
	revision==1
; rev one doesn't capitalize on reading in record but i
;	one getting next character
; THIS VERSION WILL MODIFY PRN FILE INSTEAD OF CREATEING
;	A PRX FILE
;
; *****************************************
;	EQUATE AREA
;	
	lf==0AH
	cr==0DH
	tabchar==09h
	true==0ffH
	false==0
;
.INSERT bdoscall
;
;  FCB equates
	fcbname==1
	fcbext==9
	fcbex==12
	fcbcr==32
	fcbr0==33
;
;   TIME - address of clock in low memory
	dayaddr==45h
	mnthaddr==44h
	hraddr==43h
	minaddr==42h
;
;   PAGE definition Equates
	maxlines==66	; numof lines per 
			;	physical page
	headlines==6	; lines of header per page 
;
	maxSYlength==6	; maximum length of symbol
	defintype==80h	; delimflag setting means 
			; symbol is definiton
;
	SThdlength==23	; length of var STheader
;
;	BINARY SEARCH RETURNS
	UP==1
	DOWN==2
	EQUALS==0
; REFERNCE TABLE EQUATES
	rfItemSize==4		; length ref list elem
	rfListOffset==11	; length table elem to 
				;   start of list elem
	rftabItemsize==16	; len ref table element
	; NOTE must be 16 to facilate table search 
	; multiplication, if changed then must 
	; change multiplication
;
; EQUATES FOR COM LINE
maxcomlength==25  ; comment length
prnonly==01
xrfonly==02
both==03
;
; EQUATES for LISTER (print out module)
MXcolsPerPage==76
botMargin==3
fillLeft==14	; left margin when no sym in line
entrylength==8	; length of page&line ref in printout
;
;	END of EQUATE AREA
; *****************************************
;
.PAGE
.SBTTL 7MACRO DEFINITION AREA7
;
; **********************************************
.SBTTL 7MACRO DEFINITION AREA7
;    MACRO AREA
;
;  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
; OUTMESS - outputs message name to screen, saves 
;		environment	
.define outmess [messname]=
[	lxi	d,messname
	call	messout
]
; END OUTMESS MACRO
;  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
; jmpdegthl - jmp if de > HL
	.define	jmpdegthl[jmpaddr]=[
	ora	a	; clear cy
	dsbc	d
	jc	jmpaddr ]
; END JMPDEGTHL MACRO
; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
; DRcomp - does double register compare
	.define	DRcomp [r1h,r1l,r2h,r2l,%DRC]=[
	mov	a,r1h
	cmp	r2h
	jnz	%DRC
	mov	a,r1l
	cmp	r2l
%DRC:
	]
; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
; charcheck - sets up and performs check to see if 
;	char in a is in table. Returns a set CY if 
;	it finds it
	.define charcheck [tabaddr,tablength]=[
	lxi	h,tabaddr
	lxi	b,tablength
	call	crChkRoutine
	]	
;  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
; comp strings - sets up a string compare and then 
;	calls CMPstr
	.define	compstring [one,two,length]=[
	lxi	h,one
	lxi	d,two
	lxi	b,length
	call	cmpstr
	]
;END of COMPSTRINGS
;  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
; DBleft  double register shift to left with no 
;		carry in
	.define DBleft [high,low]=[
	mov	a,low
	ora	a	;resets CY
	ral
	mov	low,a
	mov	a,high
	ral
	mov	high,a
	]
;  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
; DBrighft  double register shift to right with 
;		no carry in
	.define DBright [high,low]=[
	mov	a,high
	ora	a	;resets CY
	rar
	mov	high,a
	mov	a,low
	rar
	mov	low,a
	]
; END of DBright Macro
;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
;DoEOL
	.define doEOL [num,%dloop]=[
	mvi	a,num
%dloop:
	push	PSW
	lxi	h,crlfmess
	prntstring	2
	pop	PSW
	dcr	a
	jrnz	%dloop
	]
;
;^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
; prnt puts bytes to xref for passed length from guy in hl
	.define	prntstring [length,]=[
	mvi	c,length
	call	putstring
	]
;
;    END MACRO AREA
;***********************************************
.PAGE
.SBTTL  'MAIN LOGIC'
;
	.LOC	100H
start:
;  com line processor
	call	cmlproc
	outmess	IdMess
	call	ldDate
	lda	iscomline
	cpi	true
	jz	minFileopen
	call	fileOpen
flopret:
	lda	isComLine
	cpi	false
	cz	stComment
;  insteaad read guy in
	;INITIALIZATIONS
	mvi	a,true
	sta	frstpass
	mvi	a,1
	sta	linecount
	lxi	h,1
	shld	pagecount
	; numer of bytes in reftable is zero
	dcr	l
	shld	rfTabSize
	shld	rfnumber
	shld	randrec	; rand record in prn file
	call	rdnxtrec
; In the first pass through we keep track of the 
;  pages while searching for the symbols table 
;  start (5 pluses SYMBOL TABLE +++++), after symbol 
;  table start we go to symbol table processor
;	- We also rewrite PRN file with line numbers if comflag is
;	   prnonly or both
;
pass1:
	call	gtNXTchar
	jc	STprocess
	cpi	lf	; see if char is linefeed
	cz	LFprocess	
	jz	pass1	; LFprocess sets zero flag
	;
	; check for start symbol tabel message (+)
	lda	curchar
	cpi	'+'
	cz	STcheck	; if finds symbol header passes 
			;     control to STprocess
	jmp	pass1
STprocess:	; if CY is set have reached EOF without 
		;  finding Table so give message and 
		;  abort, else process symbol table
	jc	NoSymTable
; processing symbol table if xref or both flag is set
	lda	comflag	    ; should we create XREF?
	ani	xrfonly	  
	jz	alldone 	; not both or xrf
	call	doSymPage   ; puts message on screen 
	; init cant flag	
	mvi	a,false
	sta	cantflag
..STp1:
	call	lexer
	jc	..STp2
	call	MkRefTable
	jmp	..stp1
..STp2:		; found EOF, check for las symbol
	lda	sylength
	ora	a
	cnz	mKreftable
pass1done:	
	; figure out addr of freememory and number 
	xra	a
	sta	frstpass
	lxi	h,reftable
	lded	rftabsize
	dad	d
	shld	memaddr
	outmess	dnpass1mess
	lhld	rfnumber
	call	binasc
	outmess	ascnum
	outmess	crlfmess
pass2:
; reset PRN file by setting randrec to zer0
	; reset line and page count
	mvi	a,1
	sta	linecount
	lxi	h,1
	shld	pagecount
	lxi	h,0
	shld	randrec
	call	rdnxtrec
..ps2loop:
	call	lexer
	compstring	symbuffer,endstring,6
	jc	..ps2done
	call	MkReflist
	jmp	..ps2loop
..ps2done:
; TEST ROUTINE DISPLAYS MEMORY TOP
	lhld	memaddr
	call	hexasc
	outmess	mmbasmess
	outmess	ascnum
	outmess	crlfmess
	; END DISPLAY MEMORY
	call	lister	
	; close xrf file 
	lxi	d,xrfFCB
	mvi	c,bdclfile
	call	BDOS
alldone:
	; close prn file 
	lxi	d,prnFCB
	mvi	c,bdclfile
	call	BDOS
	; close xrf file 
	lxi	d,xrfFCB
	mvi	c,bdclfile
	call	BDOS
	jmp	0
; END MAIN LOGIC
;
minfileopen:
	call	midFileopen
	jmp	flopret
;
;
;++++++++++++++++++++++++++++++++++++++++++++++
; LFpr$1ocess - resets cantflag and then drpos through 
; 	to LFprocess
; LFprocess - processes a line feed in file, by 
;	incrementing linecount. If linecount = 67 
;	increments page count and resets line count 
;	to 1
;	On Entry: nothing
;	On Exit: line count is incremented, zero flag 
;		is set and CY is reset
LFpr$1ocess:
	mvi	a,false
	sta	cantflag
LFprocess:
	lda	linecount
	inr	a
	cpi	maxlines+1    ; maxlines is 66
	jnz	LFpr1
	mvi	a,1
	lhld	pagecount
	inx	h
	shld	pagecount
	;DEBUG CODE
	PUSH	PSW
	OUTMESS NEWPMESS
	POP	PSW
LFpr1:
	sta	linecount
	cpi	headlines
	jc	lfpr2
	cpi	maxlines-botmar+1
	jnc	lfpr2
	lda	frstpass
	cpi	true
	jnz	lfpr2
	; put line number into buffer
	lda	thischar	; place in buffer
	inr	a
	cpi	127
	jnc	lfpr2	; no room for file num
	lxi	h,recbuffer
	mvi	b,0
	mov	c,a
	dad	b	; hl has addr next place in buff
	mov	a,m
	cpi	' '
	jnz	lfpr2	; dont write line num if not blank
	push	h
	lhld	linecount
	mvi	h,0
	call	binasc
	pop	h
	lda	ascnum+2
	mov	m,a
	inx	h
	lda	ascnum+3
	mov	m,a	
lfpr2:
	xra	a	; sets zero flag and resets CY
	ret
; END of LFprocess
;
;
;++++++++++++++++++++++++++++++++++++++++++++++++
;  STcheck - checks to see if string matches symbol 
;	table header (5 pluses SYMBOL TABLE +++++). If 
;	so, it resets CY and  passes control to 
;	STprocess.  If it finds an LF passes control 
;	to LFprocess. 
;	On Entry: first + has been found.
;	On Exit: If string is found, stack is popped,
;		CY is reset.
STcheck:
	lxi	h,STheader
	lxi	b,SThdlength
..STloop:
	push	h
	push	b
	call	gtNxtchar
	pop	b
	pop	h
	; if EOF CY flag is set
	jc	..STC1
	; if line feed pass control to LGprocess which 
	;	will return to main loop
	cpi	lf
	jz	LFprocess
	cci	; compare to next char in Sym header
	rnz	; if ~zero this string is not header
	xra	a
	cmp	c	; if c is zero,  comp is done
	jnz	..STloop
	; on drop through header is found, so reset 
	;	CY and pass control to STprocess
	xra	a	; resets CY
..STC1:		; if we jumped here, CY is set 
		;    indicating EOF, pass control to 
		;    STprocess 
	pop	h	; clear ret addr
	jmp	STprocess
;
; +++++++++++++++++++++++++++++++++++++++++++++++
noSymTable:	; Error Routine when no symbol 
		;   table is found
	outmess	notablmess
	jmp	alldone
;END of noSymTable
;++++++++++++++++++++++++++++++++++++++++++++++
; do sym page - TEMPORARY TO SHOW 
doSympage:
	outmess	gotsymtabmess
	lhld	pagecount
	call	binasc
	outmess	ascnum
	outmess	lnummess
	lhld	linecount
	mvi	h,0
	call	binasc
	outmess	ascnum+2
	outmess	crlfmess
	ret
;
; ++++++++++++++++++++++++++++++++++++++++++++++++
; MkRefTable - this guy builds the reference table 
;	in memory.  When called it adds the symbol 
;	in SYMBUFFER to the list and then adds the number
;	following symbol.  This number is the next 4 
;	chars in file by virtue of the way checkdelim 
;	works. The we add a  null four bytes for
;	first entry.  
;	On Entry: symbuffer holds new symbol name
;	On exit: rftabsize holds num  bytes in table
MkRefTable:
	; if symbol is 'X     ' make sure its valid
	call	Xcheck
	rc
;	outmess	sym1mess
;	outmess	symbuffer
;	outmess	crlfmess
	lhld	rfnumber
	inx	h
	shld	rfnumber
	lded	rftabSize
	lxi	h,rfTabITemSize ; length of table entry
	dad	d		; hl has new table size
	shld	rfTabsize
	lxi	h,reftable	; base addr of table
	dad	d		; hl has ref table addr 
				;   of item 
	lxi	d,symbuffer
	xchg
	lxi	b,maxSYlength	; length symbol buffer
	ldir		     ; moves sym name to table
	mvi	a,' '
	stax	d
	inx	d
	mvi	a,4	; length of num that goes with symbol
mkrfloop:
	push	psw
	push	d
	call	gtnxtchar	; a now has new char
	pop	d
	stax	d
	inx	d
	pop	psw
	dcr	a
	jnz	mkrfloop	
	lxi	h,NULLS
	mvi	c,rfitemsize	; length rest of entry
	ldir
	ret
Xcheck:		; subroutine sees if sym is 'X     '. 
		;  If so sees if previous item is > 'X'. 
		;  If so sets CY flag
	compstring	Xstring,symbuff,6
	rnc
	; if carry string is 'X      '
	lxi	d,reftable-rftabitemsize
	lhld	rfTabSize
	dad	d
	mvi	a,'X'
	cmp	M	;if char > X CY set, else reset
	jm	xchk1
	ora	a
	ret
xchk1:
	stc
	ret
;
; END of MKrefTABLE
; ++++++++++++++++++++++++++++++++++++++++++++++++
; MkRefList - adds the symbol in symbuffer to refence 
;	list along with sym type,page and line number.  
;	Searches list etc.
mkRefList:
;	outmess	symbuffer
	; set up binary search
		; NOTE: since element numbers start at 
		;  zero (actually element offsets) the 
		;  top (first number out of range is 
		;  going to be the number of entries to 
		;  examine
	lxi	h,-1
	shld	SRbot
	lhld	rfnumber  ; top of area to search
	shld	SRtop
	xchg
	DBright	d,e	
srch1:
	; de now has element to search for. See if
	; element is bumping against top or bottom
	lhld	SRtop
	DRcomp	h,l,d,e
	jz	hittop
	lhld	SRbot
	DRcomp	h,l,d,e
	jz	hitbot
srch2:		; continue search  
		;  NOTE: DE must hold current element
	push	d
	call	itemComp  ; rets in a up,down or equal
		          ; if equal, addr saved in curRFaddr
	pop	d
	cpi	UP
	jz	srchup
	cpi	DOWN
	jz	srchDown
	; on drop through item is found
	jmp	elemfound	; 
srchup:		; look higher in table, de still has elem 
		;   number, which now becomes SRbot
	sded	SRbot	
	lhld	SRtop
srch3:
	ora	a	; reset CY
	dsbc	d	; hl has SRtop - SRbot
	DBright	h,l	; hl has half difference
	dad	d	; hl has new elem  number
	xchg
	jmp	srch1
srchdown:	; look lower in table
	xchg
	shld	SRtop
	lded	SRbot
	jmp	srch3
;
hittop:	   ;element number in DE matches SRtop
	dcx	d
	lhld	SRbot
srch4:
	DRcomp	d,e,h,l
	jz	elemNotFound
	jmp	srch2
hitbot:	   ; element nubmer in DE matches SRbot
	inx	d
	lhld	SRtop
	jmp	srch4
;
;
;
;
;  ITEMCOMP compares symbuffer to item number in list
;	On ENRTY: DE holds item offset number
;	On EXIT: a hold up, down or equals depending if 
;		item is less, greater or equal to symbuffer.
;		curRFaddr holds addr of list elem examined
itemcomp: 
	; calculate elem addr
	; NOTE: CALCULATION ASSUMES TABLE ELEMSIZE IS 16 
	lxi	h,reftable
	DBleft	d,e
	DBleft	d,e
	DBleft	d,e
	DBleft	d,e
	dad	d	; hl has addr of elem
	; compare strings
	mvi	b,maxSYlength
	lxi	d,symbuffer
..itc1:		; h has list, d has symbol buffer
	ldax	d
	cmp	M	; sym(char) - list (char)
	jm	..itc2	; sym is lower than list item
	jrz	..itcCont
	jp	..itc3	; sym is higher than item
..itcCONT:
	inx	h
	inx	d
	djnz	..itc1
	; on drop through strings are equal
	mvi	a,equals
	ret
..itc2:
	mvi	a,down
	ret
..itc3:
	mvi	a,up
	ret
;
;ELEMFOUND - we have found element in table so now we 
;	find first availble list elem and enter tne 
;	page and line number
;		On Entry: de has elem number
elemfound:
	; get addr of first availble list item
	; first addr is table addr + RFpageoffset
	lxi	h,reftable
	DBleft	d,e
	DBleft	d,e
	DBleft	d,e
	DBleft	d,e
	dad	d	; hl has addr of table elem
	lxi	d,RFlistOffset
	dad	d	; hl has addr of first list elem
ELMF1:
	; check pointer for last element in list 
	mov	a,M
	inx	h	;points to 2nd byte of pointer
	ora	M
	jz	elmf2	; last element is found
	dcx	h	; points to 1st byte
	call	nxtRFelem  ; load hl with addr next item
	jmp	ELMF1
ELMF2:		; hl has addr of last item in list+1
	inx	h  ; hl has addr of page num in list item
	; if page number ~zero, create new list elem
	mov	a,M
	ora	a
	jz	ELMF3	
	dcx	h
	dcx	h	; hl has addr of item
	call	mkRFelem	; creates new elem, returning 
				;   addr in hl
	inx	h
	inx	h	
ELMF3:		; hl now has addr of page number
	lda	pagecount
	mov	M,a
	inx	h
	; load line number and or with delimflag
	lda	linecount
	push	h
	lxi	h,delimflag
	ora	M
	pop	h
	mov	M,a	; stores flagged linecount
	ret
elemNotfound:
;	OUTMESS	ELEMNMESS
	ret
;
; nxtRFelem - gets addr of next element in list
;	  On ENtry: hl contains addr of current elem
;	  On Exit: hl contains addr of next elem
nxtRFelem:
	mov	e,M
	inx	h
	mov	d,M
	xchg
	ret
; END of nxtRFelem
; mkRFelem - adds an item to list at first availble 
;	memory address.  Loads new item with nulls and 
;	puts addr into old list item.
;	   On entry: hl has addr of old last item
;	   On exit:  hl has addr of new item or
;	       if no new item is available CY is set
mkRFelem:
	lded	memaddr
	push	d
	mov	M,e
	inx	h
	mov	M,d	; old elem has addr of new elem
	; move NULLS into new element
	lxi	h,NULLs
	lxi	b,rfItemsize
	ldir
;	after ldir instruction de had memaddr+rfItemsize 
;		( then new base of memory address)
	xchg
	shld	memaddr
	pop	h	; addr of new element
	ret
;  END of MKREFELEM
;	
;	
;
;
; END of MKrefLIST ROUTINE
; ++++++++++++++++++++++++++++++++++++++++++++++++
;  LEXER - this guy returns loads the next symbol into 
;	symbuff, sets the delimit type and returns. 
;	Unless it hits EOF in which case it sets CY
;	  On entry: nothing
;	  On exit: symbuffer has symbol
;		if EOF cy is set
;		if no symbol syLength is zero
LEXER:
	; zero out sylength
	xra	a
	sta	SYlength
LXloop:
	call	gtNXTchar
	jc	LXdone
	cpi	lf	; see if char is linefeed
	cz	LFpr$1ocess	; resets cantstart flag 
				;  then goes to LFprocess
	jz	LXloop	; LFprocess sets zero flag
	; if linecount <= number header lines, ignore data
	lda	linecount
	cpi	headlines+1
	jm	LXloop
	; check for symbol starting character
	lda	curchar
	CharCheck	capalpha,29	; table & length
	jc	SymStart
	; check for chars which mean the next char cant 
	;	start a word (digits)
	lda	curchar
	charcheck	digits,10
	jc	..LXR1
	; on drop through set can flag false
	mvi	a,false
	sta	cantflag
	jmp	LXloop
..LXR1:		; character is digit so next char cant 
		;	be start of symbol
	mvi	a,true
	sta	cantflag
	jmp	LXloop
SymStart:
	; we have just found a valid first character for 
	;   a symbol.  Now we check cant flag to see if 
	;   we are starting a symbol
	lda	cantflag
	cpi	true
	jz	LXloop	; if true keep searching, dont 
			;    reset cant flag
	; drop through means were starting a symbol 
	; blank symbol buff
	lxi	h,symbuffer
	shld	sybuindex
	xchg		; addr symbuffer in de
	lxi	h,blanks
	lxi	b,maxSYlength
	ldir
SymLoop:
	; see if max length is reached yet, if so 
	;  don't store letter
	lda	sylength
	cpi	maxSYlength
	jz	symfull
	; increment length
	inr	a
	sta	sylength
	; move char into buffer
	lhld	SyBuindex   ;addr of next symbuff char 
	lda	curchar
	; if accum < '0' then it is $ % or . all of 
	;   which must be translated to characters > 'Z' 
	;   so symbol table will be properly alphabetized
	cpi	'0'
	jp	syst1
	adi	40h
syst1:
	mov	m,a
	inx	h	; hl has next place in symbuffer
	shld	SyBuindex
symfull:
	; get next char and see if its a valid sym char
	call	gtnxtchar
	jc	LXdone	; return symbol and set cy
	; a hold curchar
	charcheck	capalpha,39
	jc	Symloop		; char is valid symbol 
	; on drop through character must be delimiter
	call	delimcheck	
	ora	a	; resets CY
	ret
LXdone:		; comes here on EOF
	stc
	ret
; DELIMCHECK - this subroutine reads the delimter at the 
;	end of a symbol. First reads past blanks and TABs.
;	Then if it reads : or = it sets the delim type to 
;	defintype else it sets the delim type normal and 
;	decrements thischar so main reading loop will 
;	examine the character on next pass.
;	    On entry: a holds delimitng character
;
DLMC1:	; loops here on blanks
	call	gtnxtchar	
	jc	DLMC3
delimcheck:	;  ENTRY POINT
	cpi	' '
	jz	DLMC1
	cpi	TABchar
	jz	DLMC1
	; on drop thorugh check for : and =
	cpi	':'
	jz	DLMC2
	cpi	'='
	jz	DLMC2
	; on drop through set delimflag =0, dcr thischar 
	xra	a
	sta	delimflag	; delim flag to normal(0)
	lxi	h,thischar
	dcr	m
	ret
DLMC2:		; set delimflag to defintype and return
	mvi	a,defintype
	sta	delimflag
	ret
DLMC3:		; EOF condition - pop return addr off stack 
		;     and jump to LXdone
	pop	h
	jmp	LXdone
;
; ++++++++++++++++++++++++++++++++++++++++++++++++
; FILEOPEN gets PRN file name, opens PRN file, erases old 
;	XRF file, and opens a work file  
fileOpen:
	outmess	nameMess	;prompts for file name
	call	inmess		; gets name from user
	mvi	a,false
	sta	isComLine	; if we jump here because
				; of bad filename reject 
				; command line
	lxi	d,commentstring
	lxi	h,blanks
	lxi	b,maxcomlength
	ldir			; loads blanks into comment
	mvi	a,both
	sta	comflag
midfileopen:	; jumps here if got name from command line
	lda	conlength	; length name read > 0?
	ora	a
	jz	badfilename
	call	extractFN
	; put opening message and file name to screen
	outmess	opprnmess
	call	FNprint		
	outmess	dotprnmess
	; open prn file
	lxi	d,prnFCB
	call	loadFCB		; loads up PRNfcb
	lxi	d,prnFCB
	mvi	c,bdOpFile	
	call	bdos	; open file, rets FFh on fail
	cpi	0FFh
	jz	badfilename
	; load xrf FCB
	lxi	d,xrfFCB
	call	loadFCB		; loads up PRNfcb
	ret
;
; FILE OPEN subroutines
;
; EXTRACTFN gets file name & drive number from console 
;	buffer, and loads them into FLNAME and DRVNUM
extractFN:
	; load DRVNUM with 0 and filename with blanks
	lxi	b,8
	lxi	d,filename
	lxi	h,blanks
	ldir
	xra	a
	sta	DRVNUM	; set drivenum to zero
	;
	lxi	h,conlength
	mov	b,M
	inx	h	; addr of condata
	push	h
	call	capit
	; if length is less than 3 don''t check for :
	pop	h	; h has addr condata
	lda	conlength
	mov	c,a
	cpi	3
	jm	extrc1
	; check for : in second character of string
	inx	h	; h has second position
	mov	a,M
	dcx	h	; hl points to condata
	cpi	':'
	jnz	extrc1   ; leave drivenum at zero
	; change drivenum
	mov	a,M	; drive char is now in a 
	sta	drvChar
	sbi	'A'-1
	sta	drvnum
	inx	h
	inx	h	; hl has start of name
	lda	conlength
	dcr	a
	dcr	a	; a has length of file name
	mov	c,a
;
; At this point hl points to name in buffer and c holds 
;	its length. If length is greater than 8 then 
;	truncate to 8
extrc1:
	lxi	d,filename
	mov	a,c
	cpi	9
	jm	extrc2
	mvi	c,8
extrc2:
	mvi	b,0	; bc has length of name
	ldir		; name from buffer to filename
	ret
;	
;
; FILEOPEN error routines
; 
;  if invalid PRN file name was entered
badfilename:
	outmess	badnamemess
	jmp	fileOpen
;
; END of FILEOPEN subroutine
;
; ++++++++++++++++++++++++++++++++++++++++++++
; StComment - gets comment and sets comflag
;
stcomment:
	outmess	comMess
	call	inmess
	lxi	h,conlength
	mov	c,m
	xra	a
	cmp	c
	jrz	..sc19
	mov	b,a
	inx	h
	lxi	d,commentString
	ldir
..sc19:
	outmess	flagmess
	call	inmess
	lda	conlength
	cpi	1
	rnz
	lda	condata
	ani	5fh	; capitalize	
	cpi	'P'
	jrz	..scm1
	cpi	'X'
	jrz	..scm2
	ret
..scm1:
	mvi	a,prnonly
	sta	comflag
	ret
..scm2:
	mvi	a,xrfonly
	sta	comflag
	ret

;
; ++++++++++++++++++++++++++++++++++++++++++++++
ldDate:
	lhld	dayaddr
	mvi	h,0
	call	binasc
	lda	ascnum+2
	sta	day
	lda	ascnum+3
	sta	day+1
	lhld	mnthaddr
	mvi	h,0
	call	binasc
	lda	ascnum+2
	sta	month
	lda	ascnum+3
	sta	month+1
	lhld	hraddr
	mvi	h,0
	call	binasc
	lda	ascnum+2
	sta	hour
	lda	ascnum+3
	sta	hour+1
	lhld	minaddr
	mvi	h,0
	call	binasc
	lda	ascnum+2
	sta	minute
	lda	ascnum+3
	sta	minute+1
	ret
;++++++++++++++++++++++++++++++++++++++++++++++
;GTnxtCHAR  - gets next character from file.  Incre-
;	ment thischar, this char = 128 it reads a 
;	new record into recbuffer and resets thischar 
;	to zero.  Then it offsets into buffer by this-
;	char, increments thischar, and returns in a the 
;	fetched char.  If it reaches an EOF it sets the 
;	carry flag, otherwise it resets carry flag
;	  On Entry: thischar has offset number of last 
;	    character read. 
;		Recbuffer holds a record read from file
;	On Exit:  this char has offset byte just read.
;		  a has character fetched
;		  curchar is loaded with new char 
;		  CY is set if EOF
;		  CY is reset if not EOF
GTnxtChar:
	lda	thischar
	cpi	127
	jnz	gtnx1
	call	rdnxtrec
	rc	; if is CY set then EOF so return
gtnx1:
	inr	a
	mov	c,a
	mvi	b,0
	sta	thischar
	lxi	h,recbuffer    ; base addr of record
	dad	b		; hl now points to desired char
	mov	a,M
	; capitalize it
	ani	7fh
	cpi	'{'	; first char not to cap
	jp	..gnxx
	cpi	'a'-1
	jm	..gnxx
	ani	5fh
..gnxx:		
	sta	curchar		; stores new char 
	ora	a		; resets carry flag
	ret
;
; END of GTnxtCHAR
;++++++++++++++++++++++++++++++++++++++++++++++
; RDnxtRec - reads a record into recbuffer
;	On Entry - nothing
;	On Exit: this char set to -1 so inr will make it 0
;		a has thischar 
;		CY is set if EOF
;		CY is reset if not EOF
RDnxtREC:
	; before reading next write this one back out
	; if its the first pass
	lda	frstpass
	cpi	true
	jrnz	..rdnCon
	lda	comflag
	ani	prnOnly
	jrz	..rdncon
	lxi	d,recbuffer
	mvi	c,bdstDMA
	call	bdos
	; write out record
	lhld	randrec
	mov	a,h
	cmp	l
	jz	..rdnCon
	dcx	h
	shld	randrec
	lxi	d,prnFCB
	mvi	c,bdWrRand	
	call	bdos	
	lhld	randrec
	inx	h
	shld	randrec
..rdnCon:
	; set DMA to recbuffer
	lxi	d,recbuffer
	mvi	c,bdstDMA
	call	bdos
	; read in record
	lxi	d,prnFCB
	mvi	c,BDrdRand
	call	bdos	
	; if non zero in a failure, assume for now EOF
	cpi	0
	jnz	rdnx1
	lhld	randrec
	inx	h
	shld	randrec	
	mvi	a,-1
	ora	a	; resets CY flag
	sta	thischar
	ret
rdnx1:			; failure on read
	stc
	ret
	
; End of RDnxtREC
; +++++++++++++++++++++++++++++++++++++++++
; +++++++++++++++++++++++++++++++++++++++++
; LISTER
; lister - this routine list out the shit to XREF file
;	
lister:	
	; erase old xrf file 
	lxi	d,xrfFCB
	call	loadFCB		; loads up XRFfcb
	lxi	d,xrfFCB
	mvi	c,bdDlFile	
	call	bdos	; open file, rets FFh on fail
	; open xrf file
	lxi	d,xrfFCB
	mvi	c,BDmkFILE
	call	BDOS
	xra	a
	sta	bytesInBuffer
	call	header
	lhld	rfnumber
	lxi	d,reftable
	xchg
..LST1:
	push	d
	push	h
	call	prntLST
	pop	h
	pop	d
	dcx	d
	mov	a,d
	ora	e
	jrz	..LST2
	lxi	b,rfTabItemSize
	dad	b
	jmpr	..LST1
..LST2:
	; finish page
	lda	prntLine
..lst8:
	cpi	maxlines+1
	jrz	..lst9
	inr	a
	push	PSW
	mvi	a,lf
	call	putabyte
	pop	Psw
	jmpr	..lst8
..lst9:
	; flush print buffer
	lda	bytesinBuffer
	cpi	128	; buff is full
	jrz	..lst3
	mvi	a,1ah
	call	putabyte
	jmpr	..lst9
..lst3:
	call	writebuffer
	ret
;
; prnt list - loads prnt buffer with list references 
;	till list is finished. When it reaches end of
;	line it sends cr,lf and fillleft blanks.
;	On Entry: hl points to table entry at 
;			beginnning of list to print
prntLST:
	push	h
	; translate symbol chars > Z back to . % and $
	call	backtrans
	pop	h
	push	h
	mvi	a,fillLeft
	sta	colsUsed
	prntstring	rfListOffset
	lxi	h,dasher
	prntstring	3
	pop	h	; addr of table entry
	lxi	b,rfListOffset
	dad	b
..PRL1:		; loop for printing, hl has addr of 
		; list entry
	push	h
	lda	colsUsed
	adi	entrylength
	sta	colsUsed
	cpi	MXcolsperpage 
	cp	EOL$margin
	pop	h
	push	h
	call	ldLnandPage	;moves line and page into 
				;	xrefbuffer

	; now see if pointer in list elem is 0
	pop	h	
	mov	a,M
	inx	h
	ora	M
	jrz	..PRL2	; if ptr is zero, list is done
	dcx	h	;reset to point to list elem
	call	nxtRFelem
	jmp	..PRL1	
..PRL2:		; finsh up this list item
	call	EOLine
	ret
;
; backtrans - tranlates sym chars back to . $ and %
; 	On entry:	hl has addr of symbol
backtrans:
	mvi	b,MaxSylength
..bck1:
	mov	a,M
	cpi	'Z'+1
	jm	..bck2
	sbi	40h	;tranlates char
..bck2:
	mov	M,a
	inx	h
	dcr	b
	jrnz	..bck1
	ret
;
; LdLnandPage - loads line and page number into xrefbuffer
;	On Entry: hl points to list elem start
LdLNandPAGE:
	inx	h
	inx	h	; h points to page number
	mov	e,m
	mvi	d,0
	push	h
	xchg		; hl has page number
	call	binasc
	lxi	h,ascnum+1 ; put out 3 digits
	prntstring	3
	mvi	a,','
	call	putabyte
	pop	h
	inx	h	; addr line number
	mov	e,m
	push	d
	res	7,e	; get rid of delim flag
	mvi	d,0
	xchg	; hl has line num
	call	binasc
	lxi	h,ascnum+2	; last two digits
	prntstring	2
	; if delim flag is set put out '* 'else put out '  '
	mvi	a,' '	; load blank in a
	pop	d
	bit	7,e	; check delim flag
	jz	..ldlnpg ; delim flag not set
	; delim flag set so load * into a for writing out
	mvi	a,'*'
..ldlnpg:
	call	putabyte
	mvi	a,' '
	call	putabyte
	ret
;
; EOLINE - Write CR,LF to prnt buffer. Resets colsUsed to zero. Checks 
;	new page is neeeded . If So calls header 
EOLine:
	lxi	h,crlfmess
	prntstring	2
	xra	a
	sta	colsUsed
	lda	prntline
	inr	a
	sta	prntline
	cpi	maxlines-botmargin
	rm
	doEOL	botmargin+1
	call	header
	ret	
EOL$margin:
	call	EOline
	lxi	h,blanks
	prntstring	fillleft
	mvi	a,fillleft+entrylength
	sta	colsused
	ret
;
header:
	lxi	h,crlfmess
	prntstring	2
	lxi	h,headmess
	prntstring	HML	; (length of header message)
	lxi	h,filename
	prntstring	8	; length of file name
	lxi	h,datestring
	prntstring	datelength
	lxi	h,commentstring
	prntstring	maxcomlength
	doEOL	2
	mvé	a,4
	stá	prntline
	ret
;
; PUTSTRING - writes out string addressed by hl for length 
;	stored in c
putstring:
	mov	a,m
	inx	h
	push	b
	push	h
	call	putabyte
	pop	h
	pop	b
	dcr	c
	jrnz	putstring
	ret
;
;PUTA BYTE  adds byte to xrfBuffer, if buffer is full it calls 
;	a write and resets bytesInBuff
putabyte:
	push	PSW
	lda	bytesInBuff
	cpi	128
	cz	writebuff	; loads zero in a 
	lxi	h,xrefBuffer
	mov	c,a
	mvi	b,0
	dad	b	; hl has addr to write to
	inr	a
	sta	bytesInBuff
	pop	PSW
	mov	M,a
	ret
;
; WRITEBUFF - writes xrfbuff to file, 
;	On Exit: a holds 0
writebuff:
	; set DMA to xrefbuffer
	lxi	d,xrefbuffer
	mvi	c,bdstDMA
	call	bdos
	; write out record
	lxi	d,xrfFCB
	mvi	c,BDwrseq	
	call	bdos	
	xra	a
	ret
;
; END of LISTER MODULE
; ++++++++++++++++++++++++++++++++++++++++++
;		
;
; ++++++++++++++++++++++++++++++++++++++++++
; CrChkRoutine - searches for character in a to a table
;	On Entry - a has character to search for
;		   bc has length of table
;		   hl has addr of table
;	On Exit - CY is set if char is found in table
;		  CY is reset if char not found
CrChkRoutine:
	ccir
	jz	CRCH1
	ora	a ; reset cy flag (didn''t find match)
	ret
CRCH1:		; found match
	stc
	ret
; END of CRCHKROUTINE
;  ++++++++++++++++++++++++++++++++++++++++
; CMPSTR  compares string pointed to by hl with de for 
;	length in bc returns CY setif strings are equal
cmpstr:
	ldax	d
	cmp	m
	jnz	CMPST1
	inx	h
	inx	d
	dcx	b
	mov	a,b
	ora	c	; checks for zero in bc
	jnz	cmpstr
	; on drop through strings match
	stc	
	ret
CMPST1:
	ora	a	;resets CY
	ret
; +++++++++++++++++++++++++++++++++++++++++++
; checks for and processes command line
CmlProc:
	mvi	a,both
	sta	comflag
	mvi	a,false
	sta	iscomLine
	lxi	h,80h
	mov	a,m	; length of command string
	cpi	2
	rc
	dcr	a	;drop leading blank from length
	sta	comlength
	inx	h
	inx	h
	mov	a,m
	cpi	' '
	rz	; second char is a blank, reject
		; command lline
	; there is a command string
	mvi	a,true
	sta	isComline
	; find end of file name
	lxi	b,1
cml1:
	inx	h
	inr	c
	lda	comlength
	cmp	c
	jc	cml2
	mov	a,m
	cpi	' '
	jz	cml2
	cpi	'.'
	jz	cml2
	jmpr	cml1
cml2:		; bc has length+1, move file name 
		; string into condata
	dcr	c
	lxi	d,conlength
	mov	a,c	; length
	stax	d
	inx	d
	lxi	h,82h	; begining of file name
	ldir
; find first blank after filename
	lda	conlength  ; length of filename
	mov	c,a
	lda	comlength
	cmp	c
	rz	; no more comstring
	dcr	a
	cmp	c
	rz	; only one byte left, don't bother
	mov	a,c
	lxi	h,82h
	add	l
	mov	l,a	; hl has addr byte after name
cml3:	; in this cycle c is one less than byte number 
	; being looked at
	mov	a,m
	cpi	' '	
	jz	cml4
	inr	c	
	inx	h
	lda	comlength
	dcr	a  ;since see is one less
	cmp	c
	rz	; string end
	jmpr	cml3
cml4:  ; blank after file name is found
	inx	h ; first char of switch or comment
	inr	c
	mov	a,m
	cpi	'$'	; switch flag
	jnz	cml55	; get comment if any
	inr	c	
	inx	h
	lda	comlength
	cmp	c
	rz	; string end
	mov	a,m
	ani	5fh	; capitalize
	cpi	'P'
	jz	cml6  ; prn file only
	cpi	'X'     
	jz	cml7	; xrf only
	; any thing else leave set to xrf only
cml5: 	; rest of string is comment
	inx	h
cml55:
	lda	comlength
	sub	c
	cpi	0
	rz
	rc
	cpi	maxcomlength
	jc	cml8
	mvi	a,maxcomlength
cml8:
	mov	c,a
	mvi	b,0
	lxi	d,commentstring
	ldir
	ret
;
cml6:	; prn only 
	mvi	a,prnOnly
	sta	comflag
	jmpr	cml5
cml7:	; both
	mvi	a,xrfonly
	sta	comflag
	jmpr	cml5

; ++++++++++++++++++++++++++++++++++++++++++
; CAPIT capitalizes all letters in string pointed to 
;	by hl of length b
capit:
	mov	a,M
	call	capOne
	inx	h
	dcr	b
	jnz	capit	
	; if we drop through whole string is exameined
	ret
capone:		; checks if char needs to be capped
	cpi	'a'
	rm
	cpi	'z'+1
	rp
	res	5,M
	ret
; END of CAPIT
;
; ++++++++++++++++++++++++++++++++++++++++++++
;  LOADFCB - moves file name and drivenum into FCB at 
;	addr in de
LOADFCB:
	push	d
	lxi	h,drvnum
	ldi
	lxi	h,filename
	lxi	b,8
	ldir
	; zero out ex,cr,r0,r1,r2
	xra	a	
	pop	h
	lxi	d,fcbex
	dad	d
	mov	m,a	; zeroes ex
	lxi	d,fcbcr-fcbex
	dad	d
	mov	m,a	; zeroes cr
	inx	h
	mov	m,a	; now zero three random bytes
	inx	h
	mov	m,a
	inx	h
	mov	m,a
	ret
; END of LOADFCB
; +++++++++++++++++++++++++++++++++++++++++++++++++++++
;
; FNprint - prints out the file name, checking drive 
;	num to see if it needs to print out the drve 
;	character also
FNprint:
	lda	drvnum
	cpi	0
	jz	Fnpr1
; drive number not zero so print drive char also
	outmess	drvchar
	ret
FNpr1:
	outmess	filename
	ret
; END of FNPRINT
;
; ++++++++++++++++++++++++++++++++++++++++++++++++++++
;
; INMESS - gets message from screen of up to 80 chars, 
;	saves environment	
INMESS:
	push	h
	push	b
	push	d
	mvi	c,bdrdcon
	lxi	d,conbuff
	call	bdos
	outmess	crlfmess   ; put out carraige return
	pop	d
	pop	b
	pop	h
	ret
; END INMESS SUBROUTINE
;
;  ++++++++++++++++++++++++++++++++++++++++++++
;
;MESSOUT - outputs message to screen
messout:
	push	h
	push	b
	push	d
	mvi	c,bdprint
	call	bdos
	pop	d
	pop	b
	pop	h
	ret
; END OF MESSOUT
;
;    ++++++++++++++++++++++++++++++++++++++++++
;
; binasc: converst hl to four digit ascii at ascnum
binasc:
	push	h
	lxi	d,9999
	jmpdegthl	..inrange
	pop	h
	; number greater than 9999 just answer 9999
	mvi	a,'9'
	lda	ascnum
	lda	ascnum+1
	lda	ascnum+2
	lda	ascnum+3
	ret
..inrange:
	pop 	h
	lxi	d,-1000
	mvi	a,'0'
thloop:				;thousands loop
	dad	d
	bit	7,h
	jnz	hdo
	adi	1
	jmpr	thloop
hdo:
	lxi	d,1000
	dad	d
	sta	ascnum
	lxi	d,-100
	mvi	a,'0'
hloop:				;hundreds loop
	dad	d
	bit	7,h
	jnz	tdo
	adi	1
	jmpr	hloop
tdo:
	lxi	d,100
	dad	d
	sta	ascnum+1
	mvi	a,'0'
	lxi	d,-10
tnloop:				;tens loop
	dad	d
	bit	7,h
	jnz	odo
	adi	1
	jmpr	tnloop
odo:
	lxi	d,10
	dad	d
	sta	ascnum+2
	mov	a,l
	adi	'0'
	sta	ascnum+3
	ret
;
; hexasc - converts hl to hex
hxmask==0fh
hexasc:
	mov	a,h
	ral
	ral
	ral
	ral
	call	hxcon
	sta	ascnum	
	mov	a,h
	call	hxcon
	sta	ascnum+1	
	mov	a,l
	ral
	ral
	ral
	ral
	call	hxcon
	sta	ascnum+2	
	mov	a,l
	call	hxcon
	sta	ascnum+3
	ret
;
hxcon:
	ani	hxmask
	adi	'0'
	cpi	'9'+1  
	rm
	adi	7  ; increases to letter value
	ret
;
.PAGE
.SBTTL 'DATA AREA'
;
;  CONSTANTS
;
BLANKS:		.ASCII	'                                                                               '
LOWALPHA:	.ASCII	'abcdefghijklmnopqrstuvwxyz'

; SYtable is list of valid symbol characters.  When 
;	looking for first letter of a symbol length 
;	of table is 29 to exclude digits, otherwise 
;	length of table is 39
SYtable:	
CAPALPHA:	.ASCII	'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
RADCHARS:	.ascii	'.%$'
DIGITS:		.ascii	'0123456789'
NULLS:		.byte	0,0,0,0,0,0,0,0,0,0
XSTRING:	.ascii	'X     ' ; appears in unwanted places 
				 ;  in xymbol table
endstring:	.ascii	'nEND  '
;
;
;
;
;	MESSAGE AREA 
IdMess:	.ascii '  Merry Xref for the TDL azzembler. VERSION '
		.byte	version+'0','.',revision+'0'
crlfmess:	.byte	cr,lf,'$'
nameMess:	.byte	lf,cr
		.ascii 'Enter name of PRN file to cross reference: $'
badnameMess:	.ascii 'No PRN file with that name. Please try again'
		.byte	lf,cr
		.ascii	'or enter control C to abort.'
		.byte	lf,cr,'$'
opPrnmess:	.ascii	'Opening file $'
dotPrnMess:	.ascii	'.PRN'
		.byte	lf,cr,'$'
notablmess:	.ascii	'No symbol table found in PRN file.  Can''t do XREF.'
		.byte	lf,cr,'$'
gotsymtabmess:	.ascii	'Found symbol Table. Page $'
dnpass1mess:	.ascii	'Number of entries in symbol table is $'
Lnummess:	.ascii	' Line $'
sym1mess:	.ascii	'Symbol: $'
NEWPMESS:	.ASCII	'.$'
MMBASMMESS:	.ASCII	'               NEW MEM BASE $'
ComMess:	.ascii	' Enter comments for header  '
		.BYTE	CR,LF,'$'
flagmess:	.ascii	' Enter P for PRN file only, X for XRF only or <cr> for both: $'
;
ascnum:		.blkb	4
		.byte	'$'
;
;	END MESSAGE AREA	
;
;mainDMA:		.byte	0,80H     ; system default value of DMA 
;
;   File Name Variables
drvnum:		.blkb	1
drvchar:	.blkb	1
		.byte	':'
filename:	.blkb	8
		.byte	'$'
;
;    ***** FCB area ******
PRNfcb:		.BLKB	9	;drive number & file name
		.ascii	'PRN'	;extension
	
		.BLKB	21	;remainder of FCB
randrec:	.blkb	3
XRFfcb:		.BLKB	9	;drive number & file name
		.ascii	'XRF'	;extension
		.BLKB	24	;remainder of FCB

;		
;   **** input form console ****
conbuff:	.BYTE	80	; buffer for console 
			;messages (80 max input)
conlength:	.BLKB	1	; length of input
condata:	.BLKB	80	; input data
;
;	***** variables for reading PRN file *******
;
curchar:	.blkb	1	; character most recently read 
				;    from buffer
thischar:	.blkb	1	; tells offset in record of 
				;   current character
recbuffer:	.blkb	128	; buffer holds current record 
				;    from PRN file
pagecount:	.blkb	2
linecount:	.blkb	1
frstpass:	.blkb	1   ; is this pass to write
				; back to PRN file
;
	
; DATA for handleing command line
;
iscomline:	.blkb	1	; is there a command line
comflag	:	.blkb	1	; whats in comand line
comlength:	.blkb	1   ; length of command string 
		            ; minus one for leading blank



;  ****** variables for searching and grabbing tokens
; symbol table header in prn file, less first (+)
STheader:	.ascii	'++++ SYMBOL TABLE +++++'
;
cantflag:	.blkb	1	; tells whether next 
			  ;char can start a symbol
Sylength:	.blkb	1   ; current length of symbol read
symbuffer:	.blkb	6   ; holds symbol being read
		.byte	'$'
SyBuIndex:	.blkw	1	; holds addrof current 
				;  char in symbuffer
delimflag:	.blkb	1  ; tells what type of 
			    ; delimter followed a symbol
;
;	VARIABLES for LISTER MODULE
;
; 
colSUsed:	.blkb	1     ; COLS PRINTED IN LINE
prntLine:	.blkb	1     ; lines printed on page
xrefBuffer:	.blkb	128   ; buffers output to xref	
dasher:		.ascii	' - '
headmess:	.ascii	'Cross Reference of '
HML==19		; length of headmess
commentstring:	.ascii	'                          '
datestring:	.ascii '   '
month:		.blkb	2
		.byte	'/'
day:		.blkb	2
		.byte	' ',' '
hour:		.blkb	2
		.byte	':'
minute:		.blkb	2
		.ascii	'   '
datelength==18
bytesInBuff:	.blkb	1     ; count 

;
;	binary search variables
SRtop:		.blkb	2
SRbot:		.blkb	2
curRFaddr:	.blkb	2	; address of last 
				;    element checked
;	
;
rftabsize:	.blkb	2	; number of bytes in 
				;     reference table	
rfnumber:	.blkb	2	; number of elements 
				;    in reference table
memaddr:	.blkb	2	; base of free memory
;
reftable:	; start of reftable in memory
	.end	start
