<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">;q.asm - dumps TPA size and 00-ff.
;
;	If given an operand: @xxxx
;	the dump will start at hex xxxx.
;	press control-c to stop.
;
;	While dumping, pressing the space
;	bar bumps the address by 100.
;
BDOS	EQU	5
CONST	EQU	11
CONIN	EQU	1
FCB	EQU	5CH
	ORG	100H
;	
;INIT LOCAL STACK
;
	LXI	H,0		;HL=0
	DAD	SP		;HL=STACK
	SHLD	STACK		;SAVE IT
	LXI	SP,STACK	;LOAD LOCAL STACK
;
	LDA	FCB+1		;SEE IF 
	CPI	'@'		;	@XXXX
	JZ	DUMPAT		;	YES, GET ADDR
;
;PRINT BDOS ENTRY ADDRESS
;
TPASIZE	LHLD	BDOS+1		;GET JMP TO BDOS
;
; remove following instruction to have Q print BDOS entry
; address instead of TPA size (which is BDOS-100).
;
 	DCR	H		;compute TPA size
	CALL	PRADDR		;PRINT THE ADDR
	CALL	CRLF		;	THEN CR-LF
	CALL	CRLF		;	AND AGAIN
DUMP0	LXI	H,0		;GET DEFAULT ADDR
LP	CALL	PRADDR		;PRINT THE ADDR
	CALL	PRLINE		;THEN THE LINE
	INR	H		;THIS SETS PSW TO
	DCR	H		;	ZERO IF H=0
	JZ	LP		;LOOP IF NOT YET 
				;AT 0100 (H = 01)
;
;RETURN TO CP/M
;
EXIT	LHLD	STACK		;GET CP/M'S STACK
	SPHL			;RESTORE IT
	RET			;	AND RETURN
;
;PRINT ADDR IN HEX
;
PRADDR	MOV	A,H		;GET H
	CALL	HEX		;	AND PRINT IT
	MOV	A,L		;THEN L
	CALL	HEX		;	AND PRINT IT
;
;SPACE 2 TIMES
;
SPACE2	CALL	SPACE		
;
;SPACE ONCE
;
SPACE	MVI	A,' '
;
;CONSOLE OUT
;
CONOUT	PUSH	B		;SAVE 
	PUSH	D		;	THE
	PUSH	H		;	REGS
	MOV	E,A		;CHAR IN E FOR BDOS
	MVI	C,2		;FUNCTION 2 = WRITE CON.
	CALL	BDOS		;PRINT THE CHAR
	POP	H		;RESTORE
	POP	D		;	THE
	POP	B		;	REGS
	RET			;AND RETURN
;
;PRINT (A) IN HEX
;
HEX	PUSH	PSW		;SAVE INCOMING
	RAR			;ROTATE LEFT
	RAR			;	4 BITS
	RAR			;	INTO
	RAR			;	RIGHT 4
	CALL	NIBBL		;PRINT THEM
	POP	PSW		;GET BACK, 
NIBBL	ANI	0FH		;ISOLATE NIBBLE
	ADI	90H		;SEE TEXT FOR 
	DAA			;	EXPL OF 
	ACI	40H		;	THIS BINARY
	DAA			;	TO ASCII	
	JMP	CONOUT		;	CONVERSION
;
;PRINT ONE LINE
;
PRLINE	PUSH	H		;SAVE ADDR
PRHEX	MOV	A,M		;GET A BYTE
	CALL	HEX		;PRINT IN HEX
SPACE4	MOV	A,L		;SEE IF
	ANI	3		;	TIME
	INR	A		;	TO 
	CPI	4		;	SPACE
	CZ	SPACE		;YES
SPACE8	MOV	A,L		;SEE IF TIME TO
	ANI	7		;	DOUBLE
	INR	A		;	SPACE
	CPI	8		;	IN COLUMN 8
	CZ	SPACE		;YES
CKDONE	INX	H		;TO NEXT BYTE
	MOV	A,L		;GET LOW ADDR
	ANI	0FH		;END OF LINE?
	JNZ	PRHEX		;	NO, LOOP
NOWASC	CALL	FENCE		;PRINT FENCE CHAR
	POP	H		;RESTORE ADDR
PRASC	MOV	A,M		;GET BYTE FOR ASCII
	CPI	' '		;SEE IF CONTROL CHAR
	JC	PRPER		;PRINT PERIOD IF SO
PRTABLE	CPI	7FH		;SEE IF PRINTABLE
	JC	PRNPER		;	YES
PRPER	MVI	A,'.'		;PRINT A PERIOD
PRNPER	CALL	CONOUT		;PRINT WHAT'S IN A
MORE	INX	H		;TO NEXT CHAR
	MOV	A,L		;CHECK LOW ADDR
	ANI	0FH		;	FOR END OF LINE
	JNZ	PRASC		;LOOP IF NOT
	CALL	FENCE		;PRINT CLOSING FENCE
CRLF	MVI	A,0DH		;THEN "FALL INTO"
	CALL	CONOUT		;CR/LF ROUTINE
	MVI	A,0AH
	JMP	CONOUT
;
;PRINT ASCII DELIMITER CHAR - VERTICAL BAR "FENCE".
;
FENCE	MVI	A,'|'		;GET FENCE CHAR
	JMP	CONOUT		;PRINT IT
;
;OPERAND ON COMMAND SAID "@XXXX" SO GET ADDR
;	
DUMPAT	LXI	D,FCB+2		;SKIP @ SIGN
	LXI	H,0		;INIT BINARY RESULT
;
;THIS LOOP CONVERTS ASCII TO BINARY
;
GETAD	LDAX	D		;GET CHAR OF ADDR
	INX	D		;POINT TO NEXT
	CPI	' '		;SEE IF PAST ADDR
				;(REMEMBER FCB IS
				; PADDED WITH ' ')
	JZ	DUMPIT		;IF SO, GO DUMP IT
TIMES16	DAD	H		;HL =	2 X HL
	DAD	H		;	4
	DAD	H		;	8
	DAD	H		;      16
CKALPHA	CPI	'A'		;SEE IF CHAR IS 
	JC	NUM		;	NUMERIC?
				;(NOT THOROUGH TEST)
	SUI	7		;OTHERWISE FUDGE
NUM	SUI	'0'		;TO MAKE PRINTABLE
				;(SEE TEXT)
	ADD	L		;ADD THIS DIGIT
	MOV	L,A		;PUT IT BACK
	JMP	GETAD		;LOOP UNTIL DONE
;
DUMPIT	CALL	PRADDR		;FULL DUMP: PRINT ADDR,
	CALL	PRLINE		;	THEN LINE
CKSTAT	CALL	STAT		;THEN CHECK FOR INTERRUPT
	JZ	EXIT		;	AND EXIT IF SO.
STOPAT0	MOV	A,H		;CHECK IF HL = 0
	ORA	L		;BY ORING H WITH L
	JNZ	DUMPIT		;IF EITHER NOT ZERO, LOOP
	JMP	EXIT		;	ELSE DONE
;
;CHECK CONSOLE STATUS, PROCESS CONTROL-S AND CONTROL-C
;
STAT	PUSH	H		;SAVE DUMP ADDR POINTER
	MVI	C,CONST		;GET STATUS FUNCTION
	CALL	BDOS		;HAVE BDOS CHECK FOR KEY
	POP	H		;RESTORE ADDR
	ORA	A		;CHECK RETURN FROM BDOS
	JZ	NSTAT		;IF NO CHAR, JMP
GETCHAR	PUSH	H		;GOT A CHAR, SAVE ADDR
	MVI	C,CONIN		;GET CONSOLE IN FNC.
	CALL	BDOS		;GET THE CHAR
CKCTLS	MVI	C,CONIN		;SET UP FOR SECOND READ
	CPI	'S'-40H		;TEST FOR CTL-S PAUSE
	CZ	BDOS		;IF SO, READ 2ND CHAR
CKBREAK	POP	H		;RESTORE ADDR
	CPI	'C'-40H		;CHECK CHAR FOR ABORT
	JZ	EXIT		;EXIT IF SO
	CPI	0DH		;IF CARRIAGE RETURN,
	JZ	EXIT		;ALSO ABORT
INCRSP	CPI	' '		;IF ITS A SPACE, BUMP H.
	RNZ			;H, O
	INR	H		;BUMP ADDR BY 100 (H BY 1)
	RET			;AND RETURN
;
NSTAT	INR	A		;NOT INTERRUPT SO JUST
	RET			;	RETURN A =1
;
	DS	100		;STACK SPACE
STACK	DS	2
</pre></body></html>