

  .title	'atrap'
  .ident	iotrap

version	==	1
revision==	13

;----------
;
; To create the atrap.com file:
;
; A>azm atrap o  (base address = 0)
; A>ren atrap0.hex=atrap.hex
; A>azm atrap o (base address = 100h)
; A>ddt atrap.hex
; -iatrap0.hex
; -r900
; -^C
; A>save 12 atrap.com
;
;	Based on a program by Peter Kavaler.
;	Re-written by David Stein.    6/82
;
;	modified by joel wittenberg
;	to suit his tastes, 13apr83
;
;	further modified by tracy lakin
;	put back check for first char after
;	<cr> being space or not.
;	14apr83
;
;	copyright Digital Microsystems, Inc.
;
;----------
	.pabs
	.phex

BASE	=\	"Enter base address (0 or 100h) > "

ctlC		==	03
lf		==	0ah
cr		==	0dh

ReBoot		==	0
ConInFunc	==	1
ListOutFunc	==	5
FuncLoc		==	5
PrtStrFunc	==	9
ConStatFunc	==	11
getVERS		==	12
RetCurDsk	==	19h

	.loc	BASE
;----------
; Initialization code
;----------
  .ife	BASE-100h,[
	lxi	D,hellomsg
	mvi	C,PrtStrFunc
	call	FuncLoc	; greet the user
;
	mvi	C,getVERS
	call	FuncLoc	; get CP/M version number
	mov	A,L
	ora	A
	jrz	..cpm14	; jump if CP/M 1.4
;
	cpi	22h
	jrz	..cpm22 ; jump if CP/M 2.2
;
	lxi	D,badver
	mvi	C,PrtStrFunc
	call	FuncLoc	; bad version number
	ret

..cpm14:
..cpm22:
	mvi	B,8	; CCP is 800h bytes
	lhld	FuncLoc+1; get real BDOS address
	push	H
	mov	A,H	; address of BDOS
	sub	B	; CCP code
	sta	CCPadr+1
	sta	CCPadr+701h
	sui	(lentrace+0FFh)/100h; trace code
	sta	FuncLoc+2; store new BDOS address

;----------
; Compute offsetted addresses within trace program
	lxi	H,trace
	lxi	D,trace+700h
	lxi	B,lentrace
..reloc:	
	ldax	D
	cmp	M
	jrz	..next
;
	lda	FuncLoc+2
	sui	2	; trace assembled at 200h
	add	M	; offset to high core
	mov	M,A
..next:
	inx	H
	inx	D
	dcx	B
	mov	A,B
	ora	C
	jrnz	..reloc
;
	pop	H
	shld	BDOSadr

;----------
; Move trace code to high memory, then return to CCP
	lxi	H,trace
	lded	FuncLoc+1
	mvi	E,0
	lxi	B,lentrace
	ldir		; move the code
	ret		; return to the CCP

hellomsg:
	.ascii	'        atrap vers '
	.byte	version+'0','.'
	.byte	revision/10+'0',revision@10+'0'
	.ascii	[cr][lf]'- atrap prints '
	.ascii	'all error lines -'
	.ascii	[cr][lf]'use the L option '
	.ascii	'when assembling$'

badver:
	.ascii	"unknown CP/M version, aborting trace$"

	.loc	BASE+100h
	]
  .page
;----------
; Base of new BDOS
;----------
TRACE:
	.word	0
	.word	0
	.word	0	; serial number stored here

	jmp	tracecpm


BDOS:
	.byte	0C3h	; jump to real BDOS
BDOSadr:
	.word	0	; filled in by initial code

CCP:	
	.byte	0C3h	; jump to real CCP
CCPadr:	
	.word	0	; filled in by initial code

;----------
; We arrive here when a BDOS call has been made.
tracecpm:
	sspd	userSP	; save users SP 
	lxi	SP,stack; use our own stack
	push	psw
	push	b
	push	d
	push	h
	mov	A,C	; A = cp/m function #

; output an '*' every time the return current
; disk function is called.
	cpi	RetCurDsk; ret cur disk func number
	jrnz	..1	; jump if not being called
;
	mvi	C,'*'
	call	CONOUT	; Yes. Output the *
	jmpr	retBDOS	; and finish BDOS call

; Intercept all printer output.
..1:	cpi	ListOutFunc	; Printer output func?
	jrnz	retBDOS		; No. Return to BDOS
;
	mov	A,E		; get the character
	cpi	lf		; maybe print buffer
	jrnz	putbuf	; Not a LF. Put it in buffer.
;
	mvi	A,1
	sta	lfFoundFlag	; Mark LF found
	jmpr	freshbuf	; if char is LF

retBDOS:
	pop	h
	pop	d
	pop	b
	pop	psw
	lspd	userSP
	jmp	BDOS

;Put chr into buffer
putbuf:	
	push	psw		; Save char
	lda	lfFoundFlag	; If set, last char =lf
	ora	A
	jrz	..skip
;
	pop	psw		; Get char, first after
				;last cr
	push	psw		; Save if for ..skip
	cpi	' '		; If space, this is not
				;an error line.
	mvi	A,0		; To reset NotErrorFlag
	jrz	..reset
;
	mvi	A,1		; Mark this is not an
				;error line.
..reset:
	sta	NotErrorFlag
	xra	A		; Now last char not cr
	sta	lfFoundFlag	; clear flag.
..skip:
	pop	psw
	lhld	bufaddr	; save our latest chr
	mov	M,A
	inx	H	; and move to the next
	shld	bufaddr
	mvi	C,ConStatFunc
	call	BDOS	; Does user want to
	rrc		; halt the print out?
	jrnc	..1	; No.  Return to user
;
	mvi	C,ConInFunc
	call	BDOS
	cpi	ctlC	; Abort on ctrl-C
	mvi	c,reBOOT; by warm booting
	jz	bdos	

..1:	jmp	retUSER	; return to user	

; a LF was received so print current line if 
; it contains a '?' or # of errors statement
; Reset buffer addr and return
freshbuf:
	lda	NotErrorFlag	; If not an error line,
	ora	A		;don't look for ?
	jrz	..skipcheck
;
	lxi	H,bufstart
	mvi	B,lenBUF
..1:	mov	A,M
	cpi	'?'
	jrz	..prtline
;
	inx	H
	djnz	..1
;
..skipcheck:
	call	..look4str
	lda	gotCHAR
	ora	a
	jrnz	..flush
;
..prtlin:		; Print this line.
	lhld	bufaddr
	mvi	M,'$'	; last chr must be $ for CP/M
	lxi	D,bufstart
	mvi	c,PrtStrFunc
	call	bdos
	lxi	d,crlf
	mvi	c,PrtStrFunc
	call	bdos

;Flush out current line with blanks and return.
..flush:
	lxi	H,bufstart
	mvi	M,lf	; start buffer with LF
	inx	H
	shld	bufaddr	; reset buffer addr
	mvi	M,' '
	lxi	D,bufstart+2	; reset line buffer
	lxi	B,lenBUF-2	; for next line
	ldir			; and return to
	jmp	retUSER		; the user

..look4str:
	lxi	h,bufSTART
	lxi	d,errSTR
	lxi	b,(lenBUF/4)<8+lenSTR

..search:
	ldax	d
	cmp	m
	inx	h
	jrz	..match
;
	lxi	d,errSTR
	mvi	c,lenSTR
	ori	0ffh
	sta	gotCHAR
	djnz	..search
	ret

..match:
	xra	a
	sta	gotCHAR
	inx	d
	dcr	c
	jrnz	..search
	ret


retUSER:
	pop	h
	pop	d
	pop	b
	pop	psw
	lspd	userSP
	ret

;----------
; Print a character
;  Reg in:  A = char to print
PRTchr:
	push	H
	push	D
	push	B
	push	PSW
	mov	C,A
	call	CONOUT
	pop	PSW
	pop	B
	pop	D
	pop	H
	ret

;----------
; Print a byte (in hex format)
;  Reg in:  A = byte to print
PRTbyt:
	push	PSW
	rlc
	rlc
	rlc
	rlc
	call	PRTnbl
	pop	PSW
PRTnbl:
	ani	0Fh
	adi	'0'
	cpi	'9'+1
	jrc	PRTchr
;
	adi	'A'-('9'+1)
	jmpr	PRTchr

;---------
; Print a chr to the console
CONOUT:	
	lhld	1
	lxi	D,9
	dad	D
	pchl

;----------
; Storage area
crlf:
	.ascii	[cr][lf]'$'

errSTR:
	.ascii	' DETECTED ***'
lenSTR	=	.-errSTR

gotCHAR:	.byte	0ffh

NotErrorFlag:	.byte	0	; Set if first char 
				;after a <cr> is a ' '

lfFoundFlag:	.byte	0	; Set when a cr is 
				;found so next char can
				;be checked.
;---------------

bufaddr: .word	bufstart+1	; holds addr in buffer.
bufstart:
	.byte	lf
	.ascii	'                   '	; 8 lines
	.ascii	'                    '	; of 20 bytes
	.ascii	'                    '	; = 160 bytes
	.ascii	'                    '
	.ascii	'                    '
	.ascii	'                    '
	.ascii	'                    '
	.ascii	'                    '
lenBUF	=	.-bufstart

;----------
userSP:	.word	0

	.byte	76h,76h,76h,76h,76h,76h,76h,76h
	.byte	76h,76h,76h,76h,76h,76h,76h,76h
	.byte	76h,76h,76h,76h,76h,76h,76h,76h
	.byte	76h,76h,76h,76h,76h,76h,76h,76h
	.byte	76h,76h,76h,76h,76h,76h,76h,76h
	.byte	76h,76h,76h,76h,76h,76h,76h,76h
	.byte	76h,76h,76h,76h,76h,76h,76h,76h
	.byte	76h,76h,76h,76h,76h,76h,76h,76h
stack:
lenTRACE==	.-TRACE
	.end
