title	'XREF v3.06 - Assembler cross reference utility			83/10/18, 01:28'

vers	equ	3
revs	equ	6

*************************************************************************
*									*
*	      Macro Assembler Cross Reference Program			*
*									*
*   Program: XREF36.ASM							*
*   By:	     Lucien Pan	 Toronto, Ontario, Canada  (416) 690-8068 [h]	*
*									*
*   Copyright  (c)  1983 by Lucien Pan.	 All  rights  reserved.	 This	*
*   public domain program is distributed for non-commercial use	only.	*
*   The	author assumes no responsibility or liability for it's use.	*
*									*
*************************************************************************

*************************************************************************
*									*
*   REVISION LOG:							*
*   ------------							*
*									*
*   83/10/17 Added   disk  file	 output	 (forced  to   fn.LST),	  tab	*
*    v3.06   expansion/compression   routines	to  conserve   space,	*
*	     improved report by	automatically executing	a second pass	*
*	     through  the  file,  this time listing  only  the	lines	*
*	     containing	 errors,  tracing the progression on the CON:	*
*	     in	 the  form of pass/line	number or actual  file	being	*
*	     parsed  and finally the ability to	list only  the	error	*
*	     lines  in a file or get a summary report which  contains	*
*	     the  symbol table (if any),  the cross-reference listing	*
*	     and the error lines (if any).  All	these and a few	other	*
*	     options are selectable at run-time.			*
*					    - LLP.			*
*									*
*   83/09/14 This one was long due.  Adapted program to	accept	TDL's	*
*    v3.05   macro  assembler .PRN listing file.  This utility is now	*
*	     slightly  more  refined.  Because MACROII	(TM  Computer	*
*	     Design   Labs.)  does not use  form-feeds,	 it  must  be	*
*	     patched to	enable	XREF to	bypass the header;  following	*
*	     is	a simple procedure to do so:				*
*									*
*		A>DDT (or ZSID)						*
*		-F100 5000 0						*
*		-IMACROII.COM						*
*		-R							*
*		NEXT PC							*
*		3900 0100						*
*		-S509							*
*		0509 0D	8D						*
*		050A 0A	01						*
*		050B 43	.						*
*		-^C							*
*									*
*		A>SAVE 47 (anyname you whish).COM			*
*									*
*	     We	 simply	set the	8th bit	on the header initial CR  and	*
*	     replaced  the  following LF by a dummy character  (don't	*
*	     use @NUL or @CR).	Either version may be assembled	 from	*
*	     the  same	source file simply by setting the TDL  symbol	*
*	     equate to true or false.					*
*					    - LLP.			*
*									*
*   83/06/20 Improved  listing	appearance by flagging	error	lines	*
*    v3.04   with  '***'.  Also	 added	statistics report at  end  of	*
*	     XREF.							*
*					    - LLP.			*
*									*
*   83/06/14 Fixed a bug occuring when no symbols were defined	in  a	*
*    v3.03   program.  No  longer  needs title info or	page  preset.	*
*	     Symbol size increased to 7	characters.			*
*					    - LLP.			*
*									*
*   83/06/03 Improved  error handling routines,	 adapted program   to	*
*    v3.02   accept  files generated by	"ASM" (of Digital  Research),	*
*	     cleaned up	line printing routine.				*
*					    - LLP.			*
*									*
*   83/05/30 Fixed a bug clobbering line numbering and	printing when	*
*    v3.01   an	macro expansion	was encountered.  (ex:	mac  filename	*
*	     $pc+smld)							*
*					    - LLP.			*
*									*
*=======================================================================*
*									*
*   ABSTRACT:								*
*   --------								*
*									*
* 	 This  program will generate a  "bannered",  cross-referenced 	*
*   listing  of an .PRN file created by either DIGITAL RESEARCH's MAC 	*
*   or  COMPUTER  DESIGN LAB's (TDL)  MACROII  macro-assembler.  This 	*
*   feature is an assembly time option however.				*
*									*
*	 Please	 report	any bugs and/or	comments either	 through  the	*
*   TORONTO  RCP/M  SYSTEM ONE at (416)	231-0442 by leaving a message	*
*   if	not too	 impractical or	feel free to contact me	 directly  by	*
*   voice.								*
*					    - LLP.			*
*									*
*=======================================================================*
*									*
*   HISTORY:			v3.00					*
*   -------								*
*									*
*	 Based	on XREF.ASM,  originally written by Jeff Kravitz  and	*
*   modified  by  P.P.H.  Lee,	Ward Christensen and others,  and  on	*
*   BANNER.ASM,	 modified by Ron Booley,  I integrated both  programs	*
*   into one module and	adapted	it to accept .PRN files	 from MAC.	*
*									*
*	 Following is a	short description of some of the new features	*
*   added:								*
*									*
*     -	For the	sake of	"pretty-printing", a banner of the  file name	*
*	information is generated at the	beginning of the  listing (in	*
*	an  7X7	 matrix	 per character expanded)  for  easy   program	*
*	identification when multiple listings are bound	 together.  I	*
*	suggest	 that  the  first  page	be folded in  half  as	 this	*
*	procedure allows easy indexing through each of the  programs.	*
*									*
*     -	The  line identification number	is now appearing   after  the	*
*	object	expansion  making  the final listing  more   readable	*
*	especially when	a label	is printed right after the  expansion	*
*	without	space in between as it is the case when	 more than  5	*
*	characters are being defined in	an labeled DB  statement.	*
*									*
*     -	In case	the file type is not specified,	 the  default .PRN is	*
*	assumed.							*
*									*
*     -	The  symbol  length is now increased from 5 to 6   characters	*
*	which I	believe	is enough for significant but "to  the point"	*
*	names.								*
*									*
*					    - Lucien L.	Pan, 83/05/22	*
*									*
*************************************************************************

false	equ	0		;define boolean
true	equ	not false	;__equates
debug	equ	false		;debug version (save a tree)
cpm22	equ	true		;for standard CP/M 2.2 BDOS
h19	equ	true		;Heath/Zenith H-19 type terminal
z8911	equ	false		;use internal line printer device driver
				;__because Magnolia's CP/M bios doesn't
				;__support parallel i/o. Set to false to
				;__use standard CP/M LST logical device
eject	equ	false		;no initial page form feed
tdl	equ	true		;Set to true or false
mac	equ	not tdl		;don't touch (set by above)

;/******************************/
;
;   operating system equates
;
;/******************************/

;   page zero addresses

base	equ	0		;standard zero base CP/M
wboot	equ	base		;warm boot entry point
bdos	equ	wboot+5		;bdos entry point
fbase	equ	wboot+6		;highest user memory+1
fcb	equ	wboot+5ch	;default file control block
fcb2	equ	wboot+6ch	;second fcb
dma	equ	wboot+80h	;default dma address
tpa	equ	wboot+100h	;transient program area

;   bdos functions parameters

conif	equ	1		;console input
conof	equ	2		;console output
listf	equ	5		;list output
dciof	equ	6		;direct console i/o
psbf	equ	9		;print string buffer
constf	equ	11		;console status
cpmver	equ	12		;return version no.
openf	equ	15		;open file
findf	equ	17		;search file in directory
closef	equ	16		;close file
deletf	equ	19		;delete file
readf	equ	20		;read file
writef	equ	21		;write sequential file
makef	equ	22		;create file
sdmaf	equ	26		;set dma address

;   misc system equates

fcbl	equ	36		;length of fcb
eof	equ	1ah		;CP/M's end of file delimiter

;/******************************/
;
;   ascii characters equates
;
;/******************************/

@nul	equ	'@'-40h		;^@ (ascii null)
@bel	equ	'G'-40h		;^G (ascii bell)
@tab	equ	'I'-40h		;^I (ascii tab)
@lf	equ	'J'-40h		;^J (ascii line feed)
@ff	equ	'L'-40h		;^L (ascii form feed)
@cr	equ	'M'-40h		;^M (ascii carriage return)
@esc	equ	'['-40h		;^[ (ascii escape)

;/******************************/
;
;   operational equates
;
;/******************************/

rsiz	equ	6		;size of reserved word table entry
symsiz	equ	7		;max size of symbol
ssiz	equ	symsiz+3	;# of xref addresses by line
refsz	equ	2+(ssiz*2)	;# of bytes in ref. block
tbsze	equ	20h		;# of sectors to read to fill buffer

	if	mac
pglen	equ	58		;# of lines to be printed per page
	endif			;mac

	if	tdl
pglen	equ	60
	endif

digits	equ	5		;# of digits for line number id.

;/******************************/
;
;   program start
;
;/******************************/

	org	tpa

	jmp	xref		;bypass header
	db	'Copyright (C) 1983 by Lucien Pan'
hello:	call	cdisp		;identify oneself
	db	'XREF v'
	db	(vers mod 10)+'0','.'
	db	revs/10+'0',(revs mod 10)+'0'

	if	z8911
	db	'p'
	endif
	
	db	' for '

	if	mac
	db	'MAC, ASM'
	endif

	if	tdl
	db	'TDL'
	endif

	db	' mnemonics.'

	if	h19
	db	@esc,'x5'	;disable cursor
	endif			;h19

	db	@cr,@lf,@nul
	ret

xref:	lxi	h,0
	dad	sp		;get ccp stack in hl
	lxi	sp,stack	;set local stack pointer
	push	h		;save ccp stack ^ on local stack

	if	z8911
	call	in8255		;initialize parallel port
	endif			;z8911

	call	hello		;say hello
	call	setup		;initialize program
xref0:	call	cdisp

	if	h19
	db	@esc,'l',@nul	;HEL - erase entire line
	else
	db	'                          ',@nul
	endif			;h19

	call	getbt		;get first byte of source file
	cpi	eof
	jz	empty		;in case of eof
	push	psw
	call	ckerr		;error only option selected?
	jz	xref01		;if not
	sub	a		;else, select pass two
	sta	pass
	lxi	h,done3		;where to go when done
	shld	way
xref01:	pop	psw

	if	mac
	cpi	' '
	jz	xref2		;if case 'page 0' from "MAC"
	cpi	@ff		;bypass first form feed (from "MAC")
	jz	xref2		;process form feed case if so
	cpi	@cr		;bypass CR,LF,CR,LF sequence (from "ASM")
	mvi	b,3
	jz	xref1		;if first char was indeed a @cr
	call	ckalp		;none of the above, char MUST at least be
	jnc	xref2		;__alphabetic (error code) to qualify as .PRN
	jmp	former		;in case an object file was requested
xref1:	call	getbt		;skip over "ASM" prologue
	dcr	b
	jnz	xref1
	cpi	@lf		;just to make sure
	jnz	former		;sorry!
	endif			;mac

xref2:	sta	char		;save character for later use
	call	ckpass		;are we in pass 1 or 2?
	jz	xref21		;if pass two
	call	cksumo		;is summary option active?
	jz	xref20		;if not
	sub	a		;else, temporarily disable flag
	sta	summary
	call	banner		;to print expanded file name
	mvi	a,true		;re-activate flag
	sta	summary
	ora	a
xref20:	cz	banner		;print expanded fcb information
xref21:	lda	char		;get back character

	if	mac
	cpi	@lf		;was it .PRN from "ASM"?
	jz	llf0		;if yes, process @lf case
	cpi	@ff		;was it .PRN from "MAC"?
	jnz	xref3		;if not
	call	getfc		;test for normal case
	jz	llf1		;parse if so
	jmp	lff2		;must be header case, process
xref3:	call	savbt		;save character in line buffer
	cpi	' '		;was it .PRN from "MAC" w/page set at 0 ?
	jz	llf1		;continue parsing object expansion field
	mvi	b,15		;this is a long shot to help cluts
	jmp	llf4		;recover from an error in the very first line!
	endif			;mac

	if	tdl
	cpi	@CR
	jnz	former
xref4:	call	skipnl		;skip formatting new lines
	call	ckban		;if no banner wanted
	jnz	xref41		;__bypass initial form-feed
	call	ckpass
	cnz	formf
xref41:	sub	a		;clear this option flag
	sta	nobanr		;__for next iteration
	call	header
	jmp	main1
	endif			;tdl

;/******************************/
;
;   character parsing mainline
;
;/******************************/

main:	call	getfc		;get a byte from source file
main1:	call	ckpass		;is it pass 1 or 2?
	lda	char
	jz	main2		;if pass 2
	call	cknum		;test for numeric
	jnc	lnum		;yes, found a number, process
	call	ckalp		;test for alphabetic
	jnc	lalph		;yes, process
main2:	call	ckspc		;parse special characters
	jc	main		;if not found, ignore and loop for more
	pchl			;when found, process special character

;/******************************/
;
;   exit from program
;
;/******************************/

empty:	call	fcdisp
	db	'+++ Unexpected end of file??? +++',@cr,@lf,@nul
	jmp	exit

abort:	call	fcdisp
	db	'+++ Aborted +++',@cr,@lf,@nul
;	jmp	exit

exit:	lxi	d,fcb		;close source file
	call	fclose
exit1:
	if	h19
	call	fcdisp
	db	@esc,'y5',@nul	;re-enable cursor
	endif			;h19

	lxi	sp,stack-2	;^ to old (ccp's) stack
	pop	h		;restore ccp stack
	sphl
	ret			;return control back to CP/M

;/******************************/
;
;   final statistics print
;
;/******************************/

done:	lxi	sp,stack-2	;just to be safe
	call	formf		;issue formf eject
	call	cdisp
	db	@cr,'Listing cross-reference ',@cr,@nul
	sta	pass		;activate pass two flag
	lhld	symbt		;get symbol table bottom
	call	endoft		;test for no symbol case
	jnz	done0		;continue if symbol exist
	call	lcdisp		;else print warning
	db	@bel,'+++ no symbol detected +++',@lf,@cr,@nul
	jmp	done2		;terminate program
done0:	shld	sym		;set symbol pointer
	lhld	symtp		;get symbol table top
	mvi	m,-1		;end off symbol table
done1:	lhld	sym		;get symbol table pointer
	call	psym		;print symbol
	lhld	sym
	lxi	d,symsiz+1	;offset to ref link
	dad	d
	mov	e,m
	inx	h
	mov	d,m		;get ref block addr
	xchg			;into hl
	shld	ref
	call	prefs		;print references
	lhld	sym		;get symbol table pointer
	lxi	d,ssiz		;size of sym table entry
	dad	d
	shld	sym
	call	endoft		;test for end of table
	jnz	done1		;loop if not
done2:	lhld	errorc		;any errors detected?
	mov	a,h
	ora	l
	jz	done4		;if not, proceed with stats.

;   errors were logged, scan file a second time
;   printing only error lines.

	lxi	h,done3		;where to branch when eof hit
	shld	way
	call	formf		;prettyprint
	lxi	d,fcb		;close and reopen file
	call	fclose
	lxi	d,ifcb
	lxi	h,fcb
	mvi	b,fcbl
	call	move
	lxi	d,fcb
	call	fopen
	jc	abort		;in case murphy's around
	call	initp
	jmp	xref0		;re-enter main loop
done3:	call	crlf2
	call	lptab
	lhld	errorc
	mov	a,h
	ora	l
	jnz	done31
	call	ldisp
	db	'   ',@nul
	call	lcdisp
	db	'No',@nul
done31:	cnz	done7
	call	lcdisp
	db	' error(s) detected        ',@lf,@cr,@nul
done4:	call	crlft
	call	lptab
	lhld	lcnt
	mov	a,h
	ora	l
	jz	exit

	if mac
	dcx	h
	endif

	call	done7
	call	lcdisp
	db	' line(s) processed        ',@lf,@cr,@nul
	call	formf
done5:	call	ckdsk
	jz	done6
	mvi	a,eof		;save end of file marker
	call	putfc
	lxi	d,dfcb		;close destination file
	call	fclose
	inr	a		;everything okay?
	jnz	done6		;if yes
	call	fcdisp
	db	@bel,' Is disk write protected? ',@nul
	jmp	abort
done6:	call	cdisp
	db	'Cross-reference completed',@cr,@lf,@nul
	jmp	exit		;return to ccp

done7:	call	decout
	jmp	prdec

;/******************************/
;
;   symbol print routine
;
;/******************************/

psym:	mvi	b,symsiz	;symbol size

	if	tdl		;print a space after 6 chars
	mvi	c,6		;__to enhance truncated symbols
	endif			;tdl

psym0:	mov	e,m		;get byte
	call	pbyt		;print byte
	inx	h

	if	tdl
	dcr	c
	cz	psym1
	endif			;tdl

	dcr	b
	jnz	psym0
psym1:	mvi	e,' '

	if	mac		;because enhanced printing
	call	pbyt		;__is only available on TDL
	endif			;mac

	jmp	pbyt		;return through pbyt

;/******************************/
;
;   reference print routine
;
;/******************************/

prefs:	lhld	ref		;get ref block addr
	inx	h
	inx	h		;bump to first ref number
	shld	temp		;save ref num addr
	mvi	a,(refsz-2)/2	;number of ref slots
	sta	symct		;save in symct
pref:	mvi	e,' '
	call	pbyt
	lhld	temp		;get ref slot addr
	mov	e,m
	inx	h
	mov	d,m		;get ref
	lxi	h,0		;zero?
	call	cphl
	jz	crlft		;yes, done
	xchg			;get num in hl
	call	decot		;convert
	lxi	h,dec		;point to dec string
	mvi	m,' '		;blank leading zero
	mvi	b,digits	;set loop count
pref2:	mov	e,m		;get byte
	call	pbyt		;print byte
	inx	h
	dcr	b
	jnz	pref2		;print reference number
	lhld	temp		;get ref slot addr
	inx	h
	inx	h		;bump to next slot
	shld	temp
	lda	symct		;get count
	dcr	a		;decrement
	sta	symct
	jnz	pref
	lhld	ref		;get ref block address
	mov	e,m
	inx	h
	mov	d,m		;get link to next block
	lxi	h,0
	call	cphl		;any more blocks?
	jz	crlft		;no, exit
	xchg			;yes, set next block pointer in ref
	shld	ref
	call	crlft		;print cr,lf
	mvi	b,symsiz+2
pref3:	mvi	e,' '
	call	pbyt		;print spaces
	dcr	b
	jnz	pref3
	jmp	prefs

;/******************************/
;
;   character parsing routines
;
;/******************************/

lalph:	call	ckpass		;don't xref on 2nd pass
	jz	main
	call	linit
	call	gtsym		;collect identifier
lalph0:	call	getfc		;get a byte from source file

	if	mac
	cpi	'$'		;'$' case?
	jz	lalph0		;if so, ignore
	endif			;mac

lalph1:	call	ckspsy		;check for special symbol char
	jz	lalph5
	call	cknum		;test for number
	jnc	lalph5		;yes, continue
	call	ckalp		;test for alphabetic
	jnc	lalph5		;yes, continue
	call	cres		;test for reserved word
	jc	lalph3		;no, continue
lalph2:	lda	char		;get character that ended id
	jmp	main1		;continue scan
lalph3:	call	find		;see if defined
	jc	lalph4		;no, continue
	call	addrf		;yes, add reference
	jmp	lalph2		;done
lalph4:	call	ensym		;enter symbol definition
	call	addrf		;add reference
	jmp	lalph2		;continue
lalph5:	call	gtsym		;collect identifier
	jmp	lalph0		;continue

lnum:	call	getfc		;get byte
	call	cknum		;test for numeric
	jnc	lnum		;yes, continue
	call	ckalp		;test for alphabetic
	jnc	lnum		;yes, continue
	jmp	main1		;continue with main scan

lapos:	call	getfc		;get a byte
	cpi	''''		;see if string quote
	jnz	lapos		;no, keep looping
	call	getfc		;get next byte
	cpi	''''		;test for doubles
	jz	lapos		;yes, start scan again
	jmp	main1		;no, continue in main scan

	if	tdl
lquot:	call	getfc		;get a byte
	cpi	'"'		;see if string quote
	jnz	lquot		;no, keep looping
	call	getfc		;get next byte
	cpi	'"'		;test for doubles
	jz	lquot		;yes, start scan again
	jmp	main1		;no, continue in main scan

ldot:	call	linit
	mov	b,a		;save character
	call	getfc
	cpi	'.'		;dot dot?
	jz	ldot1		;if true, bypass local symbol
	push	psw		;save character
	mov	a,b		;restore initial character
	call	gtsym		;add to symbol
	pop	psw		;restore second char
	jmp	lalph1		;continue parsing symbol

;   local symbol case, bypass parsing

ldot1:	call	getfc
	call	ckspsy
	jz	ldot1
	call	cknum
	jnc	ldot1
	call	ckalp
	jc	main1
	jmp	ldot1
	endif			;tdl

llf:	lhld	lcnt		;increment line count
	inx	h
	shld	lcnt
	sub	a		;reset error line flag
	sta	errl
llf0:	call	getfc		;get next file char
	jz	llf1		;br if space (case normal line)

	if	mac
	cpi	@ff		;test for @ff case (.PRN from "MAC")
	jz	lff		;if true, process
	cpi	@cr		;test for @cr case (.PRN from "ASM")
	jz	bypass		;bypass formatting CRLF's
	call	getfc		;else, find out if symbol case
	mvi	b,3		;set to skip to macro cue column
	jz	llf00		;when 2nd column is blank, its an error line
	call	getfc		;if 3rd column is blank, its an error line
	jz	llf00		;no need to test for symbol table case
	dcr	b		;else, it could be symbol table case
	call	skip		;this column is always blank
	jz	prsym		;__when symbol table case
llf00:	cz	skip		;position to macro cue - 1 column
	push	h		;now we know for sure this is an error line
	lhld	errorc		;increment error count
	inx	h
	shld	errorc
	mvi	a,true		;flag error line
	sta	errl
	pop	h
	call	getfc		;resync to macro cue
	jz	llf3		;if not macro expansion line, count up
	jmp	llf21		;else, don't increment (blank) line count
	endif			;mac

	if	tdl
	cpi	@cr		;is it new line case?
	jnz	llf01		;if not
	call	dcrlct		;if so, decrement line count
	call	pinit		;init printer line buffer pointers
	jmp	xref4		;bypass new lines and proceed to header case
llf01:	mvi	b,6		;is it symbol table case?
	call	skip		;symbol value always appears at column 8
	mvi	b,4		;test for a hex character string
	call	skiph0		;returns fc/1 if non hex char detected
	jnc	prsym		;if it was really a symbol table line
llf02:	dcr	b		;else, resync to column 12
	cnz	skip		;only if not already there
	lhld	errorc		;increment error line count
	inx	h
	shld	errorc
	mvi	a,true		;flag error line
	sta	errl
	mvi	b,14		;resync to source line
	jmp	llf2		;and proceed with parsing
	endif			;tdl

llf1:
	if	mac
	mvi	b,5		;skip over address expansion
	endif			;mac

	if	tdl
	mvi	b,24
	endif			;tdl

llf2:	call	skip		;__to point to macro indicator

	if	tdl
	cpi	'@'
	jz	llf20
	cpi	' '
	cnz	dcrlct		;macro-expansion lines
llf20:	call	getfc		;__will be xref'ed but not counted
;	jmp	llf5
	endif			;tdl

	if	mac
llf21:	cnz	dcrlct		;anything other than space
				;__will be treated as a macro line
llf3:	mvi	b,11		;skip over object code expansion
llf4:	call	skip		;(first 16 chars of a line in .PRN file)
	endif			;mac

llf5:	cpi	'*'		;test for special '*' comment line case
	jnz	main1		;if not true, parse remainder of file
;	jmp	lsemi		;else, consider line as a comment

lsemi:	call	bypln		;bypass parsing of the line (till @cr)
	jmp	main1		;parse remainder of file

bypass:
	call	dcrlct		;decrement line count
	jmp	lsemi		;treat rest of line as a comment line

lff:	if	mac
	sub	a		;reset page line count
	sta	lines
	call	getfc		;get next file char & test for space
	jnz	lff2		;if not normal case, test for symbol or header
	call	getfc		;test for weird page case
	mvi	b,4		;prepare to sync to macro cue
	jnz	llf2		;if normal line
	mvi	b,14		;# of chars to skip over object expansion
lff0:	call	getfc		;skip over object field
	jz	lff1		;if not object, test for page case
	dcr	b		;prepare to enter skip loop
	jnz	llf4		;it is not page case, enter normal parsing loop
	jmp	former		;cannot be any other case, file is corrupted
lff1:	dcr	b		;-- count
	jnz	lff0		;see if at end of object expansion, loop if not
	call	getfc		;test for page case
	cpi	@cr
	jnz	llf5		;if really not page, then test for comment
	call	getfc		;if page case, next char
	cpi	@lf		;__must be line feed
	jnz	former		;else we've got problems
	call	prline		;just print out (hopefully) blank line
	call	crlft		;this is why page case is WEIRD!
	jmp	main		;re-enter main parsing loop
lff2:	call	skiphx		;test for symbol line case
	jc	lff3		;if not a symbol table line
	call	getfc		;now, test for a space
	jz	prsym		;if really a symbol table line
	call	getfc		;test for a error source line case
	jz	llf3		;if true
	cpi	'M'		;try for a header line case
	jnz	bypass		;if none of above, treat as for a macro case
lff3:	call	bypln		;just save rest of line in line buffer
	call	prline		;and print out w/o numbers
	call	crlft		;__with the attendant prettyprinting
	call	getbt		;bypass following @lf and discard
	cpi	@lf		;just make sure were discarding the right char
	jnz	former		;if file format error
	call	getfc		;next char in file should be @lf
	cpi	@lf		;check that character was indeed a @lf
	jz	llf0		;if true, proceed parsing file as for @lf case
;	jmp	former		;else, we've got a problem
	endif			;mac

former:	call	fcdisp		;print warning and terminate program
	db	@bel,'+++ .PRN file format corrupted +++',@cr,@lf,@nul
	jmp	exit		;too bad!;(sorry... can't handle it yet)

prsym:	sub	a		;deactivate summary option
	sta	summary
	call	dcrlct		;decrement line count
prsym1:	call	bprlin		;bypass parsing of the line & unadorned print
	jmp	lcr1		;update page line count & exit

lcr:	call	prlinu		;print source and line id
lcr1:	call	ckpass		;don't increment page line count
	jz	main		;if pass 2
	lda	lines		;increment page line count
	inr	a
	sta	lines
	cpi	pglen		;test for forms length
	jnz	main		;re-enter main character parsing loop
	call	formf		;time to form feed
	call	getbt		;bypass saving following @lf
	cpi	@lf		;only if char is @lf
	jz	llf		;if @lf
	call	savbt		;else save
	jmp	main1		;and continue parsing

linit:	lxi	h,sbuf		;erase temporary symbol buffer
	mvi	c,symsiz
	mvi	a,' '
linit1:	mov	m,a
	inx	h
	dcr	c
	jnz	linit1
	lxi	h,sbuf		;reset symbol ^
	shld	sympt
	sub	a		;reset count
	sta	symct
	lda	char		;restore previously read char
	ret

dcrlct:	lhld	lcnt
	dcx	h
	shld	lcnt
	ret

ckpass:	lda	pass		;is it pass 1 or 2?
	ora	a		;pass 1 = nz, pass 2 = 0
	rnz
	sta	summary		;disable summary flag
	ret

ckcon:	lda	crt		;console trace option active?
	ora	a		;true if nz
	ret

ckdsk:	lda	diskl		;disk output option active?
	ora	a		;true if nz
	ret

ckerr:	lda	error		;error only option active?
	ora	a		;true if nz
	ret

ckban:	lda	nobanr		;no banner option selected?
	ora	a		;true if nz
	ret

ckquiet:lda	quiet		;quiet operation selected?
	ora	a		;true if nz
	ret

cksumo:	lda	summary		;summary option active?
	ora	a		;true if nz
	ret

ckentab:lda	entab		;enter tabs option active?
	ora	a
	ret

	if	tdl
skipnl:	call	getlf
	jnz	former
	call	getcr
	rc
	jz	skipnl
	rrc
	cpi	@nul
	jnz	skipn1
	endif			;tdl

skipn0:	lhld	way
	pchl

	if	tdl
skipn1:	push	psw
	call	crlf2
	pop	psw
	call	savbt
	jmp	prsym1
	
getlf:	call	getbt
	cpi	@lf
	ret

getcr:	call	getbt
	cpi	@cr
	rz
	rlc
	ret

header:	sub	a
	sta	char		;(clear for bypln)

;   print out first 4 lines of header as is

	mvi	b,4
heade0:	push	b
	call	bprlin		;print source line w/o formatting
	call	getfc		;get char following @CR (for bypln)
	pop	b
	dcr	b		;adj. count
	jnz	heade0		;loop till done

;   test to see if symbol table page case

	mvi	b,5
	lxi	h,pbuf+1
	mvi	a,'+'
heade1:	cmp	m
	jnz	heade2
	inx	h
	dcr	b
	jnz	heade1
	call	bprlin		;print source line w/o formatting
	jmp	heade3

;   normal listing page case

heade2:	call	ckpass		;don't pretty-print
	jz	heade21		;__if pass 2
	call	crlf
	call	ldisp		;replace blank line with pretty-print
	db	' Location  Object-code   Line#  Source line',@NUL
heade21:call	bypln

;   proper subroutine ending

heade3:	call	getfc
	call	bprlin		;print source line w/o formatting
	jmp	getfc		;indirect return
	endif			;tdl

;/******************************/
;
;   initialization
;
;/******************************/

setup:	sub	a		;disable all options
	sta	crt
	sta	diskl
	sta	error
	sta	nobanr
	sta	quiet
	sta	summary
	sta	entab
	sta	warning

;   parse command line

	lxi	h,dma		;^ to command line tail
	shld	bufadd
	ora	m		;anything entered?
	jnz	setu0		;if yes, test file type

;   Give a little bit of help

help:	call	cdisp		;else print help message
	db	@cr,@lf,'Usage:'
	db	@cr,@lf,@lf,'   [d:]xref [d:]fn.ft [d:][/ooo...]'
	db	@cr,@lf,@lf,'where ''[]'' denotes optional entry'
	db	@cr,@lf,'and ''o'' stands for a valid option identifier.'
	db	@cr,@lf,@lf,'Selectable options are:'
	db	@cr,@lf,'   c  -  CON: trace'
	db	@cr,@lf,'   d  -  disk file listing'
	db	@cr,@lf,'	  forces fn.LST as output file'
	db	@cr,@lf,'	  with option t in effect'
	db	@cr,@lf,'   e  -  list error lines only'
	db	@cr,@lf,'   n  -  no banner expansion'
	db	@cr,@lf,'   q  -  quiet mode'
	db	@cr,@lf,'   s  -  summary report only'
	db	@cr,@lf,'   t  -  compress blanks to tabs'
	db	@cr,@lf,@lf,'Note: if no file type is specified,'
	db	@cr,@lf,'      the default .PRN will be assumed.'
	db	@cr,@lf,'      A null file type is entered as a ''.'' (dot).'
	db	@cr,@lf,@nul
	jmp	exit1		;__and return to CP/M

;   file name was entered

setu0:	mvi	a,'.'		;look to see if file type defined
	call	findb
	jnc	setu00		;if yes, take file type as is
	mvi	a,'P'		;else, assume .PRN file
	sta	fcb+9
	lxi	h,'RN'
	shld	fcb+10

;   ckeck out options wanted

setu00:	lxi	h,dma
	mvi	a,'/'		;look for option delimiter
	call	findb
	jc	setu1		;if none found
	dcr	b		;any char following?
	jnz	setu02		;if yes
setu01:	call	fcdisp		;undecipherable option was entered
	db	@bel,'+++ Option error +++',@nul
	jmp	help
setu02:	inx	h		;get next char
	mov	a,m
	cpi	'D'		;disk listing option?
	jnz	setu03
	mvi	a,true
	sta	diskl
	sta	entab
	jmp	setu09
setu03:	cpi	'E'		;error only option?
	jnz	setu04
	mvi	a,true
	sta	error
	jmp	setu09
setu04:	cpi	'N'		;no banner option?
	jnz	setu05
	mvi	a,true
	sta	nobanr
	jmp	setu09
setu05:	cpi	'S'		;summary only option?
	jnz	setu06
	mvi	a,true
	sta	summary
	jmp	setu09
setu06:	cpi	'C'		;CON: trace option?
	jnz	setu07
	mvi	a,true
	sta	crt
	sta	quiet
	jmp	setu09
setu07:	cpi	'Q'		;quiet option?
	jnz	setu08
	mvi	a,true
	sta	quiet
	jmp	setu09
setu08:	cpi	'T'		;compress tabs option?
	jnz	setu01		;can't be anything else
	mvi	a,true
	sta	entab
;	jmp	setu09
setu09:	dcr	b		;more chars available?
	jnz	setu02		;if yes

setu1:	lxi	d,fcb		;point to fcb
	lxi	h,ifcb		;save a copy of initial fcb
	mvi	b,fcbl		;__for later use by pass 2
	call	move

;   create disk file output fcb

	call	ckdsk		;disk output option active?
	jz	setu12		;if not
setu11:	lda	fcb2		;get drive number
	sta	dfcb
	lxi	d,fcb+1		;copy source filename
	lxi	h,dfcb+1	;__to destination filename
	mvi	b,8
	call	move
	mvi	m,'L'		;force ft to 'LST'
	inx	h
	mvi	m,'S'
	inx	h
	mvi	m,'T'
	sub	a
	sta	dfcb+32		;clear current record

;   open source file

setu12:	lxi	d,fcb
	call	fopen		;open fcb
	jnc	setu13		;psw/c0, open ok
	call	fcdisp
	db	'+++ File not found +++',@cr,@lf,@nul
	jmp	exit		;exit back to ccp

;   if disk output wanted, open destination file

setu13:	call	ckdsk		;disk output option active?
	jz	setu2		;if not
	lxi	d,dfcb		;^ destination fcb
	mvi	c,findf		;look for destination filename
	call	bdos
	inr	a		;does file already exists?
	jz	setu14		;if not, bypass delete
	lxi	d,dfcb
	mvi	c,deletf	;else, delete the file
	call	bdos
setu14:	lxi	d,dfcb
	mvi	c,makef		;now, create the destination file
	call	bdos
	inr	a
	jnz	setu2		;opening sucessfull
	call	fcdisp
	db	'no directory space ',@nul
	jmp	abort

;   init variables for 1st pass

setu2:	sub	a		;enable pass 1 flag
	cma
	sta	pass
	lxi	h,done		;where to go when eof hit
	shld	way
	call	initp		;init disk & printer variables 
	lxi	h,symt		;set symbol table pointers
	mvi	m,-1		;__and xref variables
	shld	sym		
	shld	symbt
	shld	symtp

;   check if BDOS v2.2 present

	if	cpm22
	mvi	c,cpmver
	call	bdos
	cpi	22h
	jz	setu3		;if okay
	call	cdisp
	db	'Warning! this is not CP/M 2.2',@cr,@lf,@nul
	cma
	sta	warning
	jmp	setu4
setu3:	lhld	fbase		;get BDOS entry vector + 6
	lxi	d,30Eh-6	;offset to last char read flag
	dad	d
	shld	lastci		;save vector
	endif			;cpm22

;   calculate top of free RAM

setu4:	lhld	fbase		;get highest available memory + 7
	lxi	d,-(800h+7)	;substract CCP + 7 size
	dad	d		;to get start of CCP ^ - 1 (last free RAM)
	shld	ref		;set reference table pointers
	shld	refbt
	shld	reftp
	ret

;   common initialization routines

initp:	call	pinit		;set line buffer ^
	lxi	h,0
	shld	errorc		;reset error count

	if	mac
	inx	h
	endif			;mac

	shld	lcnt		;reset line count
	lxi	h,tbuf+(tbsze*128) ;reset disk buffer pointers
	shld	tbdma
	shld	inptr
	lxi	h,tbuf		;^ to start of disk buffer
	lxi	b,symt-tbuf	;calculate buffer size
initp1:	mvi	m,eof		;fill buffer area with eof's
	inx	h
	dcx	b
	mov	a,c
	ora	b
	jnz	initp1		;loop till done
;	sub	a
	sta	tbflg
	ret

;/******************************/
;
;   skip n characters
;   in line buffer
;
;/******************************/

skip:	call	getfc		;get a byte
	dcr	b		;-- count
	jnz	skip		;loop till done
	cpi	' '		;set psw/z1 if space
	ret

;/******************************/
;
;   skip to end of line
;
;/******************************/

bypln:	lda	char		;get current character
	cpi	@cr		;test for end of line delimiter
	rz			;return when one found
	call	getfc		;else, get next file char
	jmp	bypln		;and test again

;/******************************/
;
;   test for hex char in
;   address expansion field
;
;/******************************/

skiphx:	mvi	b,3		;3 following char should be hex
skiph0:	call	getfc		;get char
	call	ckhex		;test for hex
	rc			;exit with psw/c1 if not hex
	dcr	b		;-- count
	jnz	skiph0		;loop till done
	ret

;/******************************/
;
;   check for reserved word
;
;/******************************/

cres:	lxi	h,rtab		;point to reserved word table
	shld	temp		;save in temp word
cres1:	lhld	temp		;get table pointer
	lxi	d,sbuf		;point to symbol
	mvi	b,rsiz		;symbol size
cres2:	ldax	d		;get symbol byte
	cmp	m		;compare against table entry
	rc			;less, not in table
	jnz	cres3		;greater, get next table entry
	inx	d		;bump pointers
	inx	h
	dcr	b		;decrement byte count
	jnz	cres2		;keep testing
	jmp	cres4		;found
cres3:	lhld	temp		;get table pointer
	lxi	d,rsiz		;size of entry
	dad	d		;bump pointer
	shld	temp		;store new pointer
	call	endoft		;test for end of table
	jnz	cres1		;no, loop
	stc			;set carry (not in table)
	ret
cres4:	ora	a		;reset carry
	ret

;/******************************/
;
;   find symbol in table
;
;/******************************/

find:	lhld	symbt		;get begin of sym table
	shld	sym		;set temp pointer
find1:	lhld	sym		;get temp pointer
	lxi	d,sbuf		;point to current symbol
	mvi	b,symsiz	;symbol size
find2:	ldax	d		;get byte from sbuf
	cmp	m		;compare to sym table byte
	rc			;greater, not in table
	jnz	find3		;less, get next table entry
	inx	d		;bump pointer
	inx	h		;bump pointer
	dcr	b		;decrement byte count
	jnz	find2		;loop
	ret			;true zero, found
find3:	lhld	sym		;get current pointer
	lxi	d,ssiz		;symbol table entry size
	dad	d		;bump pointer
	xchg			;into de
	lhld	symtp		;get top of symbol table
	call	cphl		;test for end of table
	jz	find4		;yes, done
	jnc	find31		;psw/c0, everything ok, br if so
ferr:	call	fcdisp		;table overflow, error
	db	'+++ Symbol table overflow +++',@cr,@lf,@nul
	jmp	exit		;return to ccp
find31:	xchg			;current pointer into hl
	shld	sym		;set current pointer
	jmp	find1		;loop
find4:	stc			;set carry for not found
	lhld	symtp		;get current top
	shld	sym		;set current pointer
	ret

;/******************************/
;
;   add reference to ref table
;
;/******************************/

addrf:	lhld	sym		;get symbol pointer
	lxi	d,symsiz+1	;offset past symbol&flags
	dad	d
	mov	e,m
	inx	h
	mov	d,m		;get reference pointer
	lxi	h,0
	call	cphl		;test for zero ref ptr
	jz	bldrf		;yes, build reference entry
link:	xchg			;ref ptr in hl
	mov	e,m		;get ref link
	inx	h
	mov	d,m		;into de
	dcx	h		;reposition hl
	push	h		;save ref ptr
	lxi	h,0
	call	cphl		;if link is zero
	pop	h
	jnz	link		;non zero, get next link
	shld	ref		;save ref pointer
	inx	h
	inx	h		;skip to first ref number
	mvi	b,(refsz-2)/2	;number of ref numbers/entry
link3:	mov	e,m		;get ref number
	inx	h
	mov	d,m
	dcx	h		;reposition
	push	h		;save ref num addr
	lxi	h,0
	call	cphl		;see if ref num is zero
	pop	h
	jz	enref		;yes, enter reference
	inx	h
	inx	h		;skip to next ref num
	dcr	b		;decrement count
	jnz	link3		;try again at next slot
	call	adblk		;add new ref block
	lhld	ref		;get ref pointer
	inx	h
	inx	h		;skip to first ref slot
enref:	push	h		;save ref slot addr
	lhld	lcnt		;get line number
	xchg			;into de
	pop	h		;get ref slot addr
	mov	m,e
	inx	h
	mov	m,d		;store line ref
	ret			;done

;/******************************/
;
;   build ref table block
;
;/******************************/

bldrf:	lhld	sym		;get symbol pointer
	lxi	d,symsiz+1	;offset to ref pointer
	dad	d
	shld	ref		;set temp ref pointer to here
	call	adblk		;add block
	lhld	ref		;get real ref pointer
	inx	h
	inx	h		;position to first ref slot
	jmp	enref		;add reference
adblk:	lhld	refbt		;get ref bottom
	lxi	d,refsz		;subtract ref size
	mov	a,l
	sub	e
	mov	l,a
	mov	a,h
	sbb	d
	mov	h,a
	shld	temp		;save new ref bottom
	xchg			;into de also
	lhld	symtp		;get symbol top
	call	cphl		;check for bump
	jz	ferr		;yes, no room
	jnc	ferr		;no room
	lhld	temp		;get ref bottom
	xchg			;into de
	lhld	ref		;get ref pointer
	mov	m,e		;set link
	inx	h
	mov	m,d		;to new ref block
	lhld	temp		;get new ref block addr
	shld	ref		;store in ref
	mvi	b,refsz		;size of ref block
	sub	a
adb2:	mov	m,a		;zero the ref block
	inx	h
	dcr	b
	jnz	adb2
	lhld	temp		;get new ref bottom
	shld	refbt		;set refbt
	ret

;/******************************/
;
;   enter symbol in sym table
;
;/******************************/

ensym:	lhld	sym		;get symbol pointer
	xchg			;into de
	lhld	symtp		;get symbol table top
	call	cphl		;check for end of table
	jz	nwsym		;yes, add symbol at end
	lxi	d,ssiz		;symbol table entry size
	dad	d		;calculate new end of table
	xchg			;into de
	lhld	refbt		;reference table bottom
	call	cphl		;test for table overflow
	jz	ferr		;full, error
	jc	ferr		;yes, error
	lhld	symtp		;get table top
	lxi	d,ssiz-1	;bump to end of entry
	dad	d
	shld	to		;store in to address
	lxi	d,ssiz
	mov	a,l
	sub	e
	mov	l,a
	mov	a,h
	sbb	d
	mov	h,a		;subtract size of one entry
	shld	from		;store as from address
	lhld	sym		;get current pointer
	shld	limit		;store as limit address
	call	mvup		;move table up in memory
nwsym:	lhld	sym		;get current pointer
	lxi	d,sbuf		;point to symbol
	mvi	b,symsiz	;size of symbol
	call	move		;copy symbol to table
	sub	a
	mov	m,a
	inx	h
	mov	m,a
	inx	h
	mov	m,a		;set pointers to 0000
	lhld	symtp		;get symbol table top
	lxi	d,ssiz		;get symbol entry size
	dad	d		;bump
	shld	symtp		;store ew top
	ret

;/******************************/
;
;   move symbol table up
;
;/******************************/

mvup:	lhld	to		;get to pointer
	mov	b,h
	mov	c,l		;into bc
	lhld	from		;get from pointer
	xchg			;into de
	lhld	limit		;get limit address
mvup2:	ldax	d		;get from byte
	stax	b		;store at to address
	call	cphl		;compare from to limit
	rz			;exit if done
	dcx	b		;decrement to
	dcx	d		;decrment from
	jmp	mvup2		;loop

;/******************************/
;
;   general purpose move routine
;
;/******************************/

move:	ldax	d		;get byte
	mov	m,a		;store byte
	inx	d
	inx	h		;bump pointers
	dcr	b		;decrement count
	jnz	move		;loop
	ret

;/******************************/
;
;   general purpose find routine
;
; entry:
;	hl	^ count,string
;	a	byte searched
; exit:
;	hl	^ found byte
;	fc	if not found
; uses:
;	hl,b,a,psw
;
;/******************************/

findb:	mov	b,m
findb0:	inx	h
	cmp	m
	rz
	dcr	b
	jnz	findb0
	stc
	ret

;/******************************/
;
;   binary to decimal conversion
;
;/******************************/

decotj:	call	decot		;convert value in hl to decimal
	lxi	h,dec		;set to blank out leading zeroes
	mvi	a,'0'
decot1:	cmp	m		;by converting all zero characters to spaces
	rnz			;exit when first non-zero char hit
	mvi	m,' '		;else proceed with filter loop
	inx	h
	jmp	decot1

decot:	lxi	d,dec		;there are more elegant ways to do this
	xchg			;__but this one is simple enough
	lxi	b,10000		;__and creates a string as result
	call	dig		;__which then can be justified.
	lxi	b,1000
	call	dig
	lxi	b,100
	call	dig
	lxi	b,10
	call	dig
	lxi	b,1
	call	dig
	ret

dig:	mvi	m,'0'
di0:	mov	a,e
	sub	c
	mov	e,a
	mov	a,d
	sbb	b
	mov	d,a
	jm	di2
	inr	m
	jmp	di0
di2:	mov	a,e
	add	c
	mov	e,a
	mov	a,d
	adc	b
	mov	d,a
	inx	h
	ret

;/******************************/
;
;   check for special
;   symbol character
;
;/******************************/

ckspsy:
	if	mac
	cpi	'@'
	rz
	cpi	'?'
	ret
	endif			;mac

	if	tdl
	cpi	'$'
	rz
	cpi	'%'
	rz
	cpi	'.'
	ret
	endif			;tdl

;/******************************/
;
;   test for alphabetic char.
;
;/******************************/

ckalp:	cpi	'A'		;test for ascii characters
	rc			;between 'A' and 'Z'
	cpi	'Z'+1		;returns psw/c0 if within range
	cmc
	rnc
	cpi	'a'		;also test lowercase alpha characters
	rc
	cpi	'z'+1
	cmc
	ret

;/******************************/
;
;   test for numeric char
;
;/******************************/

cknum:	cpi	'0'		;test for ascii characters
	rc			;between '0' and '9'
	cpi	'9'+1		;returns psw/c0 if within range
	cmc
	ret

;/******************************/
;
;   test for hexadecimal char
;
;/******************************/

ckhex:	cpi	'0'		;smaller than '0' ?
	rc			;if yes
	cpi	'F'+1		;greater than 'F' ?
	cmc
	rc			;if yes
	cpi	'9'+1		;if smaller than ':' then ok
	cmc
	rnc			;if true
	cpi	'A'		;if not smaller than 'A' then ok
	ret

;/******************************/
;
;   test for printable char
;
;/******************************/

ckpra:	cpi	' '		;test for ascii characters
	rc			;between ' ' and 'z'
	cpi	'z'+1		;returns psw/c0 if within range
	cmc
	ret

;/******************************/
;
;   test end of table
;
;/******************************/

endoft:	mov	a,m
	cpi	-1
	ret

;/******************************/
;
;   map char to upper case
;
;/******************************/

mupc:	cpi	'a'		;is it smaller than 'a'?
	cmc			;just to be neat
	rnc			;if true, can't map
	cpi	'z'+1		;is it greater than 'z'?
	rnc			;if true, can't map
	sui	20h		;'a' <= char <= 'z' so convert
	ret

;/******************************/
;
;   check for special characters
;
;/******************************/

ckspc:	lxi	h,ctab		;point to special characters table
;	jmp	look

look:	lxi	d,3		;table entry size
	mov	b,a		;argument byte in b
look2:	call	endoft		;test for end of table
	jz	lookn		;yes, not found
	cmp	b		;compare
	jz	looky		;found
	dad	d		;bump pointer
	jmp	look2		;loop
lookn:	stc			;carry = not found
	ret

looky:	inx	h		;skip to table byte
	mov	e,m
	inx	h
	mov	d,m		;table entry in de
	xchg			;into hl
	ret

;/******************************/
;
;   save byte in line buffer
;
;/******************************/

savbt:	sta	char		;save char in char
	lhld	lpnt		;get line pointer
	mov	m,a		;save byte
	inx	h		;bump pointer
	shld	lpnt		;save pointer
	ret

;/******************************/
;
;   print source line with number
;
;/******************************/

prlinu:	call	curpas		;check which pass is active

;   print object expansion of .PRN file

pl0:
	if	mac
	mvi	b,16
	endif

	if	tdl
	mvi	b,24		;set loop count
	endif

pl1:	call	getlc		;get a line buffer character
	jc	pl4		;when psw/c1, @cr (end of line) was reached
	call	ckpra		;test for printable character
	cc	lpdvd		;could be a formatting char, print out anyway
	jc	pl1		;__but skip count
	call	lpdvd		;else, print out character to line printer
	dcr	b		;-- count
	jnz	pl1		;loop till done

;   print out line number

	push	h		;save line buffer ^

	if	mac
	lda	errl		;test for error line
	ora	a		;none if false (0)
	jz	pl11		;if no error
	mvi	e,' '		;prettyprint
	call	lpdvd		;__to enhance error line number
	call	lpdvd
	mvi	e,'*'
	mvi	b,3
pl10:	call	lpdvd
	dcr	b
	jnz	pl10
pl11:	call	lptab		;print out a tab (to align on a tab stop)
	endif			;mac

	lhld	lastp		;get previous line count
	xchg			;compare last line # to current one
	lhld	lcnt		;get current line count
	call	cphl		;do the compare
	shld	lastp		;update last line printed variable
	jnz	pl2		;if line is different
	lxi	h,0		;blank out same line #
pl2:	call	prdec		;print out decimal string

	if	mac
	call	lptab		;print out a tab (to align on a tab stop)
	endif			;mac

	if	tdl
	mvi	e,' '
	mvi	b,2
pl21:	call	lpdvd
	dcr	b
	jnz	pl21
	endif			;tdl

	pop	h		;restore line buffer ^

;   print out remainder of source line

pl3:	call	getlc		;get a char. from line buffer
	jc	pl4		;when psw/c1, end of line so br out
	call	lpdvd		;print out character
	jmp	pl3		;loop for more

;   and exit back

pl4:	call	lpdvd		;print out @cr (to flush line printer)
	call	pinit		;reset line buffer^
	ret

;/******************************/
;
;   print out line buffer
;
;/******************************/

bprlin:	call	bypln		;bypass parsing of the line
prline:	call	curpas		;check which pass is active
	jmp	pl3		;print out entire line

;/******************************/
;
;   line printer driver
;   with tab compression/expansion
;
;/******************************/

lptab:	mvi	e,@tab		;print out tab
;	jmp	lpdvd

lpdvd:	push	psw
	push	h
	call	cksumo		;summary option wanted?
	jnz	lpdvd3		;if yes, don't print out char
	lxi	h,col		;^ column counter
	mov	a,e		;get char to output
	sta	char		;save for later
	cpi	' '		;is it a blank?
	jz	lpdvd8		;if yes
	cpi	@tab		;is it a tab
	jz	lpdvd4		;if yes
	call	ckentab		;enter tabs?
	mov	a,e		;get character to output
	jz	lpdvd2		;if no compression wanted
	mvi	e,' '		;next char to print is a blank
lpdvd0:	mov	a,m		;get column count
	inx	h		;^ newcol
	sub	m		;is col < newcol ?
	dcx	h		;^ column
	jp	lpdvd1		;if not, print out actual char
	call	pbyt		;output blank
	inr	m		;adj. column count
	jmp	lpdvd0		;loop for more
lpdvd1:	lda	char		;get original char to print out
	mov	e,a		;set up registers 
	call	lpdvd9		;smart print
	mov	a,m		;get column count
	inx	h		;^ newcol counter
	mov	m,a		;save in newcount
	jmp	lpdvd3		;exit routine
lpdvd2:	call	lpdvd9		;smart print
lpdvd3:	pop	h		;exit gracefully
	pop	psw
	ret

lpdvd4:	call	ckentab		;enter tab option wanted?
	jnz	lpdvd6		;if yes
	mvi	e,' '		;else expand @tabs to blanks
lpdvd5:	call	pbyt		;print out blank until tab stop
	inr	m		;adjust column count
	mov	a,m		;are we on a tab stop?
	ani	7		;(modulo 8)
	jz	lpdvd3		;exit if so
	jmp	lpdvd5		;else, loop for more
lpdvd6:	inx	h		;calculate next tab stop
	mov	a,m
	adi	8
	ani	-8
	mov	m,a
lpdvd7:	dcx	h		;^ column counter
	mov	m,a		;adjust column count to new position
	call	pbyt		;print out @tab
	jmp	lpdvd3		;exit routine
lpdvd8:	call	ckentab		;enter tabs option wanted?
	mov	a,e		;restore char to print
	jz	lpdvd2		;if not, just print out & adj. column count
	inx	h		;^ newcol counter
	inr	m		;add one
	mov	a,m		;are we on a tab stop?
	ani	7		;(modulo 8)
	jnz	lpdvd3		;if not on a tab stop, exit
	mov	a,m		;get newcol count
	mvi	e,@tab		;else, print out @tab
	jmp	lpdvd7		;adj. column counter
lpdvd9:	call	ckpra		;is character printable?
	call	pbyt		;print-out anyway (for them "smart" printers)
	rc			;so, wasn't printable, don't count
	inr	m		;bump column count
	ret

;/******************************/
;
;   print decimal string
;   equivalent of HL
;
;/******************************/

prdec:	call	decotj		;convert string to decimal
	lxi	h,dec		;^ converted string
prde0:	call	getlc		;get a char. from decimal string
	rc			;when psw/c1, end of string so br out
	call	lpdvd		;print out the char
	jmp	prde0		;loop for more

;/******************************/
;
;   get next char in line buffer
;
;/******************************/

getlc:	mov	e,m		;get byte from buffer (^ by hl)
	mov	a,e		;__into a and e
	inx	h		;++ ^
	cpi	@cr		;test for eol
	stc
	rz			;__and return with psw/c1 if true
	cmc			;__else reset psw/c0 if not
	ret			;__and with read char in a and e

;/******************************/
;
;   display current pass
;   and line on console
;
;/******************************/

curpas:	lhld	lcnt		;get current line#
	call	decotj		;convert to decimal
	call	cdisp
	db	@cr,'Pass ',@nul
	call	ckpass		;is it pass 1?
	jnz	curpas1		;if yes
	call	cdisp		;else, its pass 2
	db	'2 - ',@nul	;so only print error lines
	lda	errl		;is it an error line?
	ora	a		;yes if not zero
	jnz	curpas2		;print error line
	call	curpas2		;display line number
	pop	h		;don't print normal line
	ret			;(return one level back)
curpas1:call	cdisp
	db	'1 - ',@nul
curpas2:call	cdisp
	db	'line # ',@nul
	push	d
	lxi	d,dec		;display current line#
	call	psb		;__to console
	pop	d
;	jmp	pinit		;return through pinit

;/******************************/
;
;   init line buffer pointers
;
;/******************************/

pinit:	lxi	h,pbuf		;reset ^ to start of line buffer
	shld	lpnt
	sub	a		;reset column counters
	sta	col
	sta	newcol
	ret

;/******************************/
;
;   collect symbol in sym buf
;
;/******************************/

gtsym:	call	mupc		;map symbol to upper case
	mov	b,a		;save char
	lda	symct		;get symbol count
	cpi	symsiz		;max?
	rnc			;yes, done 
	inr	a
	sta	symct
	lhld	sympt
	mov	m,b
	inx	h		;bump symbol pointer
	shld	sympt
	ret

;/******************************/
;
;   printer interfaces
;
;/******************************/

pbyt:	push	psw		;there goes the neighborhood...
	push	b
	push	d
	push	h
	call	ckcon		;console trace option wanted?
	mov	a,e		;get character to display
	cnz	fo
	call	ckdsk		;disk output option wanted?
	jz	pbyt1		;list to LST: if not
	mov	a,e		;get character to save
	call	putfc		;else, list to disk
	jmp	pbyt2		;bypass printing
pbyt1:
	if	z8911

;   heath h-89 with z-8911 extended i/o card device driver

	in	0d2h		;status port of 8255
	ani	80h		;ready?
	jz	pbyt1		;loop if not
	mov	a,e		;get byte to output
	out	0d0h		;data port of 8255
	xra	a		;turn strobe on (active low for tally 1602a)
	out	0d2h		;do it
	inr	a		;turn strobe off
	out	0d2h		;do it again

	if	debug
	mvi	c,conof
	call	bdos
	endif			;debug

	else			;if not z8911

	if	debug
	mvi	c,conof
	else			;if not debug
	mvi	c,listf		;then use CP/M to perform
	endif			;debug

	call	bdos		;printer (list) out function

	endif			;z8911

pbyt2:	call	break		;check for console input
	pop	h		;restore environment
	pop	d
	pop	b
	pop	psw
	ret

;/*****************************/
;
;   check for console input
;
;/*****************************/

break:	mvi	c,constf	;any pending char?
	call	bdos
	ora	a
	rz			;if not

;   Kluge to fix a minor bug in the direct console i/o  of CP/M 2.2 BDOS.
;   Console status of  DCIO  function will  not reliably  detect the next
;   typed  in  character  due  to  the  occurence of a 'pseudo-parrallel'
;   routine (in BDOS) which  also  checks  console status,  and saves the
;   input  character if one available.  This problem seems to appear more
;   frequently when the console i/o  routines  are  interrupt  driven and
;   shows up when a key  is struck during disk i/o. This 'lost' character
;   reappears at the CCP prompt when the transient terminates.

	if	cpm22
	lda	warning
	ora	a
	jnz	break0		;in case its not v2.2
	lhld	lastci		;get ^ to lastci variable (in BDOS)
	mov	a,m		;get last char input
	mvi	m,0		;toggle flag
	ora	a		;any char present?
	cz	dcin		;if not, get it
	jmp	break1
	endif			;cpm22

break0:	mvi	c,conif		;problem with this approach is
	call	bdos		;__that it echoes all displayable chars

break1:	cpi	'C'-40h		;abort?
	rnz			;if not return with char in a
	lda	quiet		;temporarily disable quiet option
	push	psw
	call	fcdisp		;ask confirmation if abort

	if	h19
	db	@esc,'y5'	;re-enable cursor
	endif			;h19

	db	@cr,@bel,'Abort? (Y/N or ^C to reboot) ',@nul
	mvi	c,conif		;get input and echo
	call	bdos
	call	mupc		;map to upper case
	cpi	'C'-40h		;reboot?
	jnz	break2		;if not
	call	cdisp		;echo '^C' on console
	db	'^C',@nul
	jmp	wboot		;exit back to CP/M
break2:	cpi	'Y'		;abort? (w/o reboot)
	push	psw
	call	cdisp		;crlf to screen
	db	@cr,@lf,@nul
	pop	psw
	jz	abort		;if yes, terminate program

	if	h19
	call	cdisp
	db	@esc,'x5',@nul	;else, disable cursor
	endif			;h19

	pop	psw		;restore quiet option  
	sta	quiet		;__to original value
	ret			;and ignore typed in char

;/******************************/
;
;   unadorned console input
;
;/******************************/

dcin:	mvi	e,-1		;set for input
	mvi	c,dciof		;direct console i/o
	call	bdos		;do it
	ora	a		;set psw
	ret

;/******************************/
;
;   initialize parallel port
;
;/******************************/

	if	z8911
in8255:	mvi	a,0aah		;set up 8255 device
	out	0d3h
	mvi	a,1		;set strobe off
	out	0d2h
	ret
	endif

;/*******************************/
;
;   issue formf eject
;
;/*******************************/

formf:	push	psw
	sub	a		;reset page line count
	sta	lines
	call	cksumo		;is summary option active?
	jnz	formf0		;if yes, don't print
	push	d
	mvi	e,@ff
	call	pbyt
	pop	d
formf0:	pop	psw
	ret

;/******************************/
;
;   issue cr, lf & test formf
;
;/******************************/

crlf2:	call	crlft
crlft:	push	psw
	call	crlf		;print out a cr & lf
	lda	lines		;++ line counter
	inr	a
	sta	lines
	cpi	pglen		;check for page eject
	cz	formf		;__at every n lines printed
	call	pinit
	pop	psw
	ret

crlf:	push	psw
	call	cksumo		;is summary option active?
	jnz	crlf0		;if yes, don't print
	push	d
	mvi	e,@lf		;print out @lf
	call	pbyt
	mvi	e,@cr		;print out @cr
	call	pbyt
	pop	d
crlf0:	pop	psw
	ret

;/******************************/
;
;   character parsing table
;
;/******************************/

ctab:	db	@lf
	dw	llf
	db	@ff
	dw	lff
	db	@cr
	dw	lcr
	db	''''
	dw	lapos

	if	tdl
	db	'"'
	dw	lquot
	endif			;tdl

	db	';'
	dw	lsemi

;   special symbol characters for Digital Research's MAC macro assembler

	if	mac
	db	'@'
	dw	lalph
	db	'?'
	dw	lalph
	endif			;mac

;   special symbols characters for TDL's macro assembler

	if	tdl
	db	'$'
	dw	lalph
	db	'%'
	dw	lalph
	db	'.'
	dw	ldot
	endif			;tdl

;   end of table

	db	eof
way:	dw	done

;   this character should never be encountered in a normal .PRN file

	db	-1
	dw	former

;/******************************/
;
;   reserved word table
;
;/******************************/

rtab:
	if	mac
	db	'A     '
	db	'ACI   '
	db	'ADC   '
	db	'ADD   '
	db	'ADI   '
	db	'ANA   '
	db	'AND   '
	db	'ANI   '
	db	'ASEG  '	;reserved for RMAC
	db	'B     '
	db	'C     '
	db	'CALL  '
	db	'CC    '
	db	'CM    '
	db	'CMA   '
	db	'CMC   '
	db	'CMP   '
	db	'CNC   '
	db	'CNZ   '
	db	'CP    '
	db	'CPE   '
	db	'CPI   '
	db	'CPO   '
	db	'CSEG  '	;reserved for RMAC
	db	'CZ    '
	db	'D     '
	db	'DAA   '
	db	'DAD   '
	db	'DB    '
	db	'DCR   '
	db	'DCX   '
	db	'DI    '
	db	'DS    '
	db	'DSEG  '	;reserved for RMAC
	db	'DW    '
	db	'E     '
	db	'EI    '
	db	'ELSE  '	;reserved for MAC
	db	'END   '
	db	'ENDIF '
	db	'ENDM  '	;reserved for MAC
	db	'EQ    '
	db	'EQU   '
	db	'EXITM '	;reserved for MAC
	db	'EXTRN '	;reserved for RMAC
	db	'GE    '
	db	'GT    '
	db	'H     '
	db	'HIGH  '
	db	'HLT   '
	db	'IF    '
	db	'IN    '
	db	'INPAGE'	;reserved for RMAC
	db	'INR   '
	db	'INX   '
	db	'IRP   '	;reserved for MAC
	db	'IRPC  '	;reserved for MAC
	db	'JC    '
	db	'JM    '
	db	'JMP   '
	db	'JNC   '
	db	'JNZ   '
	db	'JP    '
	db	'JPE   '
	db	'JPO   '
	db	'JZ    '
	db	'L     '
	db	'LDA   '
	db	'LDAX  '
	db	'LE    '
	db	'LHLD  '
	db	'LOCAL '	;reserved for MAC
	db	'LOW   '
	db	'LT    '
	db	'LXI   '
	db	'M     '
	db	'MACLIB'	;reserved for MAC
	db	'MACRO '	;reserved for MAC
	db	'MOD   '
	db	'MOV   '
	db	'MVI   '
	db	'NAME  '	;reserved for RMAC
	db	'NE    '
	db	'NOP   '
	db	'NOT   '
	db	'NUL   '
	db	'OR    '
	db	'ORA   '
	db	'ORG   '
	db	'ORI   '
	db	'OUT   '
	db	'PAGE  '
	db	'PCHL  '
	db	'POP   '
	db	'PSW   '
	db	'PUBLIC'	;reserved for RMAC
	db	'PUSH  '
	db	'RAL   '
	db	'RAR   '
	db	'RC    '
	db	'REPT  '	;reserved for MAC
	db	'RET   '
	db	'RLC   '
	db	'RM    '
	db	'RNC   '
	db	'RNZ   '
	db	'RP    '
	db	'RPE   '
	db	'RPO   '
	db	'RRC   '
	db	'RST   '
	db	'RZ    '
	db	'SBB   '
	db	'SBI   '
	db	'SET   '
	db	'SHL   '
	db	'SHLD  '
	db	'SHR   '
	db	'SP    '
	db	'SPHL  '
	db	'STA   '
	db	'STAX  '
	db	'STC   '
	db	'STKLN '	;reserved for RMAC
	db	'SUB   '
	db	'SUI   '
	db	'TITLE '	;reserved for MAC
	db	'XCHG  '
	db	'XOR   '
	db	'XRA   '
	db	'XRI   '
	db	'XTHL  '
	endif			;mac

	if	tdl
	db	'.     '	;'.' is a legal global symbol
				;__that in my opinion can lead to confusion
	db	'.ASCII'
	db	'.ASCIS'
	db	'.ASCIZ'
	db	'.BLKB '
	db	'.BLKW '
	db	'.BYTE '
	db	'.DATE '	;reserved for MACRO_III
	db	'.DEFIN'
	db	'.END  '
	db	'.ENTRY'
	db	'.ERROR'
	db	'.EXIT '
	db	'.EXTER'
	db	'.GOTO '
	db	'.I8080'
	db	'.IDENT'
	db	'.IF1  '
	db	'.IF2  '
	db	'.IFB  '
	db	'.IFDEF'
	db	'.IFDIF'
	db	'.IFE  '
	db	'.IFG  '
	db	'.IFGE '
	db	'.IFIDN'
	db	'.IFL  '
	db	'.IFLE '
	db	'.IFN  '
	db	'.IFNB '
	db	'.IFNDE'
	db	'.INSER'
	db	'.INTER'
	db	'.LADDR'
	db	'.LALL '
	db	'.LCTL '
	db	'.LIMAG'
	db	'.LINK '
	db	'.LIST '
	db	'.LOC  '
	db	'.LSYM '
	db	'.MASYN'
	db	'.OPSYN'
	db	'.PABS '
	db	'.PAGE '
	db	'.PBIN '
	db	'.PHEX '
	db	'.PREL '
	db	'.PRGEN'
	db	'.PRNTX'
	db	'.PROGI'
	db	'.PSYM '
	db	'.RAD40'
	db	'.RADIX'
	db	'.RELOC'
	db	'.REMAR'
	db	'.RLIST'
	db	'.SALL '
	db	'.SBTTL'
	db	'.SETDA'	;reserved for MACRO_III
	db	'.SETLE'	;reserved for MACRO_III
	db	'.SETTI'	;reserved for MACRO_III
	db	'.SETWI'	;reserved for MACRO_III
	db	'.SLIST'
	db	'.SYN  '
	db	'.SYSYN'
	db	'.TEMPS'
	db	'.TIME '	;reserved for MACRO_III
	db	'.TITLE'
	db	'.WORD '
	db	'.XADDR'
	db	'.XALL '
	db	'.XCTL '
	db	'.XIMAG'
	db	'.XLINK'
	db	'.XLIST'
	db	'.XPSYM'
	db	'.XSYM '
	db	'.Z80  '
	db	'A     '
	db	'ACI   '
	db	'ADC   '
	db	'ADD   '
	db	'ADI   '
	db	'ANA   '
	db	'ANI   '
	db	'B     '
	db	'BIT   '
	db	'C     '
	db	'CALL  '
	db	'CC    '
	db	'CCD   '
	db	'CCDR  '
	db	'CCI   '
	db	'CCIR  '
	db	'CM    '
	db	'CMA   '
	db	'CMC   '
	db	'CMP   '
	db	'CNC   '
	db	'CNO   '
	db	'CNZ   '
	db	'CO    '
	db	'CP    '
	db	'CPE   '
	db	'CPI   '
	db	'CPO   '
	db	'CZ    '
	db	'D     '
	db	'DAA   '
	db	'DAD   '
	db	'DADC  '
	db	'DADX  '
	db	'DADY  '
	db	'DCR   '
	db	'DCX   '
	db	'DI    '
	db	'DJNZ  '
	db	'DSBC  '
	db	'E     '
	db	'EI    '
	db	'EXAF  '
	db	'EXX   '
	db	'H     '
	db	'HLT   '
	db	'IM0   '
	db	'IM1   '
	db	'IM2   '
	db	'IN    '
	db	'IND   '
	db	'INDR  '
	db	'INI   '
	db	'INIR  '
	db	'INP   '
	db	'INR   '
	db	'INX   '
	db	'JC    '
	db	'JM    '
	db	'JMP   '
	db	'JMPR  '
	db	'JNC   '
	db	'JNO   '
	db	'JNZ   '
	db	'JO    '
	db	'JP    '
	db	'JPE   '
	db	'JPO   '
	db	'JRC   '
	db	'JRNC  '
	db	'JRNZ  '
	db	'JRZ   '
	db	'JZ    '
	db	'L     '
	db	'LBCD  '
	db	'LDA   '
	db	'LDAI  '
	db	'LDAR  '
	db	'LDAX  '
	db	'LDD   '
	db	'LDDR  '
	db	'LDED  '
	db	'LDI   '
	db	'LDIR  '
	db	'LHLD  '
	db	'LIXD  '
	db	'LIYD  '
	db	'LSPD  '
	db	'LXI   '
	db	'M     '
	db	'MOV   '
	db	'MVI   '
	db	'NEG   '
	db	'NOP   '
	db	'ORA   '
	db	'ORI   '
	db	'OUT   '
	db	'OUTD  '
	db	'OUTDR '
	db	'OUTI  '
	db	'OUTIR '
	db	'OUTP  '
	db	'P     '
	db	'PCHL  '
	db	'PCIX  '
	db	'PCIY  '
	db	'POP   '
	db	'PSW   '
	db	'PUSH  '
	db	'RAL   '
	db	'RALR  '
	db	'RAR   '
	db	'RARR  '
	db	'RC    '
	db	'RES   '
	db	'RET   '
	db	'RETI  '
	db	'RETN  '
	db	'RLC   '
	db	'RLCR  '
	db	'RLD   '
	db	'RM    '
	db	'RNC   '
	db	'RNO   '
	db	'RNZ   '
	db	'RO    '
	db	'RP    '
	db	'RPE   '
	db	'RPO   '
	db	'RRC   '
	db	'RRCR  '
	db	'RRD   '
	db	'RST   '
	db	'RZ    '
	db	'SBB   '
	db	'SBCD  '
	db	'SBI   '
	db	'SDED  '
	db	'SET   '
	db	'SHLD  '
	db	'SIXD  '
	db	'SIYD  '
	db	'SLAR  '
	db	'SP    '
	db	'SPHL  '
	db	'SPIX  '
	db	'SPIY  '
	db	'SRAR  '
	db	'SRLR  '
	db	'SSPD  '
	db	'STA   '
	db	'STAI  '
	db	'STAR  '
	db	'STAX  '
	db	'STC   '
	db	'SUB   '
	db	'SUI   '
	db	'X     '
	db	'XCHG  '
	db	'XRA   '
	db	'XRI   '
	db	'XTHL  '
	db	'Y     '
	endif			;tdl

	db	-1		;end of reserved word table

;/******************************/
;
;   routine to open a disk file
;
;   in:		de=a(fcb)
;   out:	fc/1=error
;
;/******************************/

fopen:	mvi	c,openf		;open file function
	call	bdos		;issue open
	cpi	-1		;error?
	stc			;set psw/c1 if so
	rz
	cmc			;else clear carry
	ret

;/******************************/
;
;   routine to close a disk file
;
;   in:		de=a(fcb)
;
;/******************************/

fclose:	mvi	c,closef
	jmp	bdos		;return through BDOS

;/******************************/
;
;   routine to read a byte
;
;   out:	a=byte
;		fc/1=error
;
;/******************************/

getfc:	call	getbt		;get a file character
	call	savbt		;save it in line buffer
	jc	skipn0		;in case of hard eof
	cpi	eof		;__or soft eof
	jz	skipn0
	cpi	' '		;set psw/z1 if space
	ret

getbt:	push	b
	push	d
	push	h
	lhld	tbdma		;get end of buffer
	xchg			;to de
	lhld	inptr		;current pointer in hl
	call	cphl		;test for end of buffer
	jz	getb2		;yes, read
getb1:	mov	a,m		;get byte
	inx	h		;bump pointer
	shld	inptr		;save pointer
	ora	a		;reset carry
	jmp	ierr1		;exit
getb2:	lda	tbflg		;get flag
	ora	a		;test it
	jnz	ierr		;br if no more
	lxi	h,tbuf-128	;else set start of buffer
	mvi	a,tbsze		;and buffer size in sectors
getb3:	sta	tbcnt		;save it
	lxi	d,128		;calculate new starting
	dad	d		;address
	shld	tbdma		;save it
	xchg			;place it in de
	mvi	c,sdmaf		;set dma address
	call	bdos
	mvi	c,readf		;read code
	lxi	d,fcb		;fcb address
	call	bdos		;issue read
	ora	a		;check for error/e-o-f
	jnz	getb4		;br if so
	lhld	tbdma		;else get last dma starting addr
	lda	tbcnt		;get sector count
	dcr	a		;subtract one
	jnz	getb3		;br if some more
	lxi	d,128		;else set new end of buffer
	dad	d
	shld	tbdma
	jmp	getb5
getb4:	mvi	a,-1		;set flag
	sta	tbflg
getb5:	lxi	h,tbuf		;reset buffer pointer
	jmp	getb1		;continue

ierr:	stc
ierr1:	pop	h
	pop	d
	pop	b
	ret

;/******************************/
;
;   routine to save a byte
;
;/******************************/

putfc:	cpi	eof
	jz	putfc1
	call	writec
	ret
putfc1:	call	writec
putfc2:	lda	bufadd
	cpi	128
	rz
	mvi	a,eof
	call	writec
	jmp	putfc2

;/******************************/
;
;   write a character to disk
;
;/******************************/

writec:	push	h
	lhld	bufadd
	mov	m,a
	inx	h
	sub	a
	cmp	l
	cz	newrit
	shld	bufadd
	pop	h
	ret

newrit:	lxi	h,dma
	push	h
	push	d
	push	b
	push	psw
	xchg
	mvi	c,sdmaf		;set dma address
	call	bdos
	lxi	d,dfcb
	mvi	c,writef
	call	bdos		;write one record
	ora	a		;write okay?
	jz	wexit		;if yes
	call	fcdisp
	db	@bel,'+++ disk full +++ ',@nul
	jmp	abort

wexit:	pop	psw
	pop	b
	pop	d
	pop	h
	ret

;/******************************/
;
;             c p h l
;   routine to compare hl vs de
;
;/******************************/

cphl:	mov	a,h
	cmp	d
	rnz
	mov	a,l
	cmp	e
	ret

;/*****************************/
;
;   word to decimal conversion
;
;/*****************************/

decout:	push	psw
	push	b
	push	d
	push	h
	lxi	b,-10		;radix for conversion
	lxi	d,-1		;becomes number/radix
decou1:	dad	b		;substract 10
	inx	d
	jc	decou1
	lxi	b,10		;add radix back in once
	dad	b
	xchg
	mov	a,h		;test for zero
	ora	l
	cnz	decout		;elegant recursive call
	mov	a,e
	adi	'0'		;convert from bcd to hex
	call	co		;display
	pop	h
	pop	d
	pop	b
	pop	psw
	ret

;/******************************/
;
;   inline message display
;
;/******************************/

ildisp:	xthl			;get ^string from stack
ildis1:	mov	a,m		;get a byte
	inx	h		;bump ^
	ora	a		;test for delimiter
	push	psw
	push	d
	push	h
	lxi	h,ildis2	;set indirect 
	push	h		;return address on stack
	xchg			;get routine address
	pchl			;indirect call
ildis2:	pop	h
	pop	d
	pop	psw
	jnz	ildis1		;loop till done
	xthl			;restore proper return address
	ret

;/******************************/
;
;   print message on both
;   console and line printer
;
;/******************************/

lcdisp:	lxi	d,lcdisp1
	jmp	ildisp
lcdisp1:mov	e,a
	call	lpdvd
	jmp	co		;indirect return through co

;/******************************/
;
;   print message to line printer
;
;/******************************/

ldisp:	lxi	d,ldis1
	jmp	ildisp
ldis1:	mov	e,a
	jmp	lpdvd		;indirect return through lpdvd

;/******************************/
;
;   force display of
;   message on console
;
;/******************************/

fcdisp:	sub	a		;deactivate quiet option
	sta	quiet
;	jmp	cdisp		;return through cdisp

;/******************************/
;
;   conditional display of
;   message on console
;
;/******************************/

cdisp:	lxi	d,co		;indirect return through co
	jmp	ildisp

;/******************************/
;
;   output character to console
;
;/******************************/

co:	push	psw
	call	ckquiet
	jz	co0
	pop	psw
	ret
co0:	pop	psw
;	jmp	fo

fo:	push	psw
	push	b
	push	d
	push	h
	mov	e,a
	mvi	c,conof
	call	bdos
	pop	h
	pop	d
	pop	b
	pop	psw
	ret

;/******************************/
;
; print string buffer to console
;
;/******************************/

psb:	push	psw
	push	b
	push	d
	push	h
	mvi	c,psbf
	call	ckquiet
	cz	bdos
	pop	h
	pop	d
	pop	b
	pop	psw
	ret

;/******************************/
;
;   banner print routine
;
;/******************************/

banner:
	if	eject
	call	formf		;start on fresh page
	endif			;eject

	call	ckban		;banner wanted or not?
	rnz			;just return if not
	call	bannes
	jmp	formf		;return through formf

bannes:	if	mac
	mvi	b,8		;__8 lines down
	endif			;mac

	if	tdl
	mvi	b,9
	endif			;tdl

bannel:	call	crlf
	dcr	b
	jnz	bannel
	call	mvfcb		;get converted fcb
banne0:	mvi	d,40h		;init d for matrix of 7 vertical
	lxi	h,pbuf		;define buffer area
banne1:	shld	banc		;save ^char. buffer
	mov	a,m		;get char from buffer
	ani	7fh		;strip off r/o bit
	mov	m,a		;__for good
	cpi	@cr		;end of record?
	jz	banne2		; finish full expansion if so
	call	cvpix		; no, link char. to graphics
	cnc	banexp		;if legal, expand first scan of pixels
	lhld	banc		;restore ^char.
	inx	h		;++^
	jmp	banne1		;loop till done

;   print out full characters expansion

banne2:	call	crlf		;print out line and start a fresh one
	mov	a,d
	rar
	ani	7fh
	rz			;exit when done
	mov	d,a
banne3:	lxi	h,pbuf		;reset to start of buffer
banne4:	shld	banc		;save ^char.
	mov	a,m		;get char.
	cpi	@cr		;record end?
	jz	banne2		;expand all if so
	call	cvpix		;link char. to graph.
	cnc	banexp		;if legal, print another scan
	lhld	banc		;get ^char.
	inx	h		;++^
	jmp	banne4		;loop till done

;   convert characters to graphics

cvpix:	push	h		;save ^
	call	cvpi2		;link ^ ;cy = invalid
	jc	cvpi1		;if error, restore original ^
	xthl			;else save link ^ on stack
cvpi1:	pop	h		;restore stack into hl
	ret

cvpi2:	mov	e,a
	sui	' '
	rc
	lxi	h,0
	jz	cvpi4
	sui	'*'-' '
	rc
	cpi	'Z'+1-'*'
	jnc	cvpi5
	adi	1
	mvi	b,0
	mov	c,a
	mov	l,a
	dad	h		;1x*2 = 2x
	dad	b		;2x+x = 3x
	dad	h		;3x*2 = 6x
	dad	b		;6x+x = 7x
cvpi4:	lxi	b,pixtab
	dad	b
	ret
cvpi5:	adi	-1
	ret

;   expand and print out graphics

banexp:	mvi	c,7		;set #of pixels per char
banex1:	shld	banp
	mov	a,m
	ana	a
	jm	banex3
	mov	b,e
	ana	d
	jnz	banex2
	mvi	b,' '
banex2:	push	b
	push	d
	mov	e,b
	call	pbyt
	pop	d
	pop	b
	lhld	banp
	inx	h
	dcr	c
	jnz	banex1
banex3:	mvi	b,' '
	push	b
	push	d
	mov	e,b
	call	pbyt
	call	pbyt
	call	pbyt
	pop	d
	pop	b
	ret

;/******************************/
;
;   xfer justified fcb
;
;/******************************/

mvfcb:	lxi	h,pbuf		;^ destination
	push	h		;save ^
	lxi	d,fcb+1		;^ source
	mvi	b,8		;max file name length
	call	move		;perform transfer
	pop	h		;restore ^ destination
	mvi	a,' '		;prepare to justify (filter spaces)
	mvi	b,8		;safeguard
mvfc0:	cmp	m		;test for first space
	jz	mvfc1		;exit loop when hit
	inx	h		;bump ^
	dcr	b		;in case 8 chars used in fn.
	jnz	mvfc0		;loop for more
mvfc1:	mvi	m,'.'		;insert a dot
	inx	h		;bump ^
	mvi	b,3		;max extent length
	call	move		;xfer again
	mvi	m,@cr		;save delimiter
	ret

;/******************************/
;
;   graphics pixels table
;
;/******************************/

pixtab:	db	00h,00h,00h,00h,00h,00h,00h	;null
	db	08h,22h,08h,1ch,08h,22h,08h	; *
	db	08h,08h,08h,3eh,08h,08h,08h	; +
	db	03h,80h,80h,80h,80h,80h,80h	; ,
	db	08h,08h,08h,08h,08h,80h,80h	; -
	db	01h,80h,80h,80h,80h,80h,80h	; .
	db	01h,02h,04h,08h,10h,20h,40h	; /
	db	3eh,43h,45h,49h,51h,61h,3eh	; 0
	db	01h,11h,31h,7fh,01h,01h,01h	; 1
	db	20h,41h,43h,45h,49h,51h,21h	; 2
	db	22h,41h,49h,49h,49h,49h,36h	; 3
	db	04h,0ch,14h,24h,44h,0fh,04h	; 4
	db	7ah,49h,49h,49h,49h,49h,46h	; 5
	db	3eh,49h,49h,49h,49h,49h,26h	; 6
	db	41h,42h,44h,48h,50h,60h,40h	; 7
	db	36h,49h,49h,49h,49h,49h,36h	; 8
	db	32h,49h,49h,49h,49h,49h,3eh	; 9
	db	12h,80h,80h,80h,80h,80h,80h	; :
	db	13h,80h,80h,80h,80h,80h,80h	; ;
	db	08h,14h,22h,41h,41h,41h,80h	; <
	db	14h,14h,14h,14h,14h,14h,14h	; =
	db	41h,41h,41h,22h,14h,08h,80h	; >
	db	20h,40h,40h,4dh,48h,50h,20h	; ?
	db	3eh,41h,41h,49h,55h,55h,39h	; @
	db	3fh,48h,48h,48h,48h,48h,3fh	; A
	db	7fh,49h,49h,49h,49h,49h,36h	; B
	db	3eh,41h,41h,41h,41h,41h,22h	; C
	db	7fh,41h,41h,41h,41h,41h,3eh	; D
	db	7fh,49h,49h,49h,49h,49h,41h	; E
	db	7fh,48h,48h,48h,48h,48h,40h	; F
	db	3eh,41h,41h,41h,4dh,49h,2eh	; G
	db	7fh,08h,08h,08h,08h,08h,7fh	; H
	db	41h,41h,41h,7fh,41h,41h,41h	; I
	db	06h,01h,01h,01h,41h,7eh,40h	; J
	db	7fh,08h,08h,08h,14h,22h,41h	; K
	db	7fh,01h,01h,01h,01h,01h,01h	; L
	db	7fh,20h,10h,08h,10h,20h,7fh	; M
	db	7fh,20h,10h,08h,04h,02h,7fh	; N
	db	3eh,41h,41h,41h,41h,41h,3eh	; O
	db	7fh,48h,48h,48h,48h,48h,30h	; P
	db	3eh,41h,41h,45h,45h,42h,3dh	; Q
	db	7fh,48h,48h,4ch,4ah,4ah,31h	; R
	db	32h,49h,49h,49h,49h,49h,26h	; S
	db	40h,40h,40h,7fh,40h,40h,40h	; T
	db	7eh,01h,01h,01h,01h,01h,7eh	; U
	db	70h,0ch,02h,01h,02h,0ch,70h	; V
	db	7fh,02h,04h,08h,04h,02h,7fh	; W
	db	41h,22h,14h,08h,14h,22h,41h	; X
	db	60h,10h,08h,07h,08h,10h,60h	; Y
	db	41h,43h,45h,49h,51h,61h,41h	; Z

;/******************************/
;
;   miscellaneous data
;
;/******************************/

symbt:	dw	0		;symbol table bottom address
symtp:	dw	0		;symbol table top address
refbt:	dw	0		;reference table bottom address
reftp:	dw	0		;reference table top address
sym:	dw	0		;current symbol table address
ref:	dw	0		;current reference table address
from:	dw	0		;move pointer
to:	dw	0		;to pointer
limit:	dw	0		;limit pointer
col:	db	0		;current line column position
newcol:	db	0		;for tabs compression
char:	db	0		;last read character
errl:	db	0		;error line flag
lcnt:	dw	0		;line counter
errorc:	dw	0		;error counter
lpnt:	dw	0		;line buffer char ^
lastp:	dw	0		;previous line number variable
symct:	db	0		;symbol count
sympt:	dw	0		;symbol ^
lines:	db	0		;print line count
temp:	dw	0		;temporary variable
tbflg:	db	0		;transient buffer flag (00=more, ff=no more)
tbcnt:	db	0		;transient buffer sector count
tbdma:	dw	0		;dma end of buffer address
inptr:	dw	0		;input pointer
bufadd:	dw	0		;output pointer
banc:	dw	0		;banner character pointer
banp:	dw	0		;banner pixel pointer
pass:	db	0		;current pass flag
crt:	db	0		;CON: trace option flag
diskl:	db	0		;disk output option flag
error:	db	0		;error only option flag
nobanr:	db	0		;no banner option flag
quiet:	db	0		;quiet operation flag
summary:db	0		;summary option flag
entab:	db	0		;compress tabs option flag
warning:db	0		;CP/M 2.2 BDOS flag
lastci:	dw	0		;vector to last char entered (in BDOS 2.2)
ifcb:	rept	fcbl		;initial fcb copy
	db	0
	endm
dfcb:	rept	fcbl		;destination fcb
	db	0
	endm
dec:	rept	digits		;right justified line # string
	db	0
	endm
	db	@cr,'$'
sbuf	set	$		;symbol buffer
pbuf	set	sbuf+symsiz	;line buffer
stack	set	pbuf+132+100h	;local stack area
tbuf	set	stack		;transient buffer

;/*********************************/
;
;        symbol table area
;
;   the symbol table must be the
;   last location of the program
;
;/*********************************/

symt	set	tbuf+(tbsze*128)

	end	tpa