;	PROGRAM NAME :	BASE.ASM (Kaypro version 1.0)
;	Function: convert input to other bases
;	Adapted for CP/M from
;		***************************************
;		Willard Nico's
;		8080/8085 Assembly Language Programming
;		published Heath Company, Benton Harbor
;		***************************************
;			by Jon Lindsay
;
;	Number to be converted will normally be in DE-regs.
;
;
; Equates
;
LF	EQU	0AH		; Linefeed
CR	EQU	0DH		; Carriage return
;

	ORG	100H		; Start program here
;
;
START:	LXI	H,0		; Set up new stack
	DAD	SP
	SHLD	STACK
	LXI	SP,STACK
;
;;	CALL	CLS		; Clear screen
;
BEGIN:	LXI	D,MESS1		; 'What base'
	CALL	PRINT
	CALL	INP1		; Select base
	CPI	'C'-40H
	JZ	EXIT
	CPI	'?'
	JZ	INFO		; Give info
	ANI	5FH		; Make uppercase
	CPI	'E'		; Clear screen
	JZ	SCREEN
	CPI	'D'		; Decimal
	JZ	DECIN
	CPI	'H'		; Hexadecimal
	JZ	HEXIN
	CPI	'O'		; Octal
	JZ	OCTIN
	CPI	'Q'		; Octal
	JZ	OCTIN
	CPI	'S'		; Split-octal
	JZ	SOCTN
	CPI	'B'		; Binary
	JZ	BININ
	CPI	'A'		; ASCII
	JZ	ASCIN
	CPI	'K'
	JZ	EXIT
	CPI	'X'		; Exit to CP/M
	JZ	EXIT
	LXI	D,MESS2		; 'Don't understand'
	CALL	PRINT
	JMP	BEGIN		; Try again
;
SCREEN:	CALL	CLS
	JMP	BEGIN
;
EXIT:	CALL	CRLF
	LHLD	STACK		; Restore old stack
	SPHL
	RET
;.....
;
;
DECIN:	LXI	D,DECIMAL
	CALL	VALIN
;
NEXT1:	PUSH	H		; Save pointer to buffer
	MOV	A,M
	SUI	30H		; Check for number
	JC	ERR1		; Not number -> error
	CPI	0AH
	JNC	ERR1		; No good
	LXI	H,0		; Multiply x 10
	DAD	D
	DAD	H
	DAD	H
	DAD	D
	DAD	H
	MOV	E,A
	MVI	D,0
	DAD	D
	XCHG			; New total in DE
	DCR	C		; Decrement counter
	JZ	TOCONV
	POP	H		; Point to
	INX	H		; Next character
	JMP	NEXT1		; Get next character
;
TOCONV:	POP	H
	JMP	CNVRT
;.....
;
;
OCTIN:	LXI	D,OCTAL
	CALL	VALIN
;
NEXT2:	PUSH	H
	MOV	A,M
	SUI	30H
	JC	ERR1
	CPI	08H
	JNC	ERR1
	LXI	H,0		; Multiply x 8
	DAD	D
	DAD	H
	DAD	H
	DAD	H
	MOV	E,A
	MVI	D,0
	DAD	D
	XCHG
	DCR	C
	JZ	TOCONV
	POP	H
	INX	H
	JMP	NEXT2
;
HEXIN:	LXI	D,HEXAD
	CALL	VALIN
;
NEXT3:	PUSH	H
	MOV	A,M
	SUI	30H
	JC	ERR1
	CPI	0AH
	JC	HEXOK
	ANI	5FH
	SUI	7H
	CPI	0AH
	JC	ERR1
	CPI	10H
	JNC	ERR1
;
HEXOK:	LXI	H,0		; Multiply x 16
	DAD	D
	DAD	H
	DAD	H
	DAD	H
	DAD	H
	MOV	E,A
	MVI	D,0
	DAD	D
	XCHG
	DCR	C
	JZ	TOCONV
	POP	H
	INX	H
	JMP	NEXT3
;
BININ:	LXI	D,BINRY
	CALL	VALIN
;
NEXT4:	PUSH	H
	MOV	A,M
	CPI	20H		; Look for input space
	JZ	NXT4		; Then ignore space
	SUI	030H
	JC	ERR1
	CPI	002H
	JNC	ERR1
	LXI	H,0		; Multiply x 2
	DAD	D
	DAD	H
	MOV	E,A
	MVI	D,0
	DAD	D
	XCHG
;
NXT4:	DCR	C		; Counter = actual number char. entered
	JZ	TOCONV
	POP	H
	INX	H
	JMP	NEXT4
;
SOCTN:	LXI	D,SPLIT
	CALL	VALIN
;
NEXT5:	PUSH	H
	MOV	A,M
	CPI	'/'
	JNZ	NODOT
	MOV	D,E
	MVI	E,0
	JMP	DOT1
;
NODOT:	SUI	30H
	JC	ERR1
	CPI	8H
	JNC	ERR1
	MOV	L,A
	MOV	A,E
	ADD	A
	ADD	A
	ADD	A
	ADD	L
	MOV	E,A
;
DOT1:	DCR	C
	JZ	TOCONV
	POP	H
	INX	H
	JMP	NEXT5
;
ASCIN:	LXI	D,ASCII
	PUSH	D
	LXI	D,WHAT
	CALL	PRINT
	POP	D
	CALL	PRINT
	LXI	D,VALUE
	CALL	PRINT
	LXI	D,0
;
NEXT6:	PUSH	D
;
NEX6:	MVI	E,0FFH		; Get pure input
	MVI	C,6
	CALL	5
	ORA	A
	JZ	NEX6		; Must loop until char. present
	POP	D
	CPI	0DH		; Look for carriage return
	JZ	CNVRT		; And convert
	PUSH	PSW
	CALL	OUTPT		; Print ASCII char.
	POP	PSW
	MOV	D,E
	MOV	E,A
	JMP	NEXT6
;
VALIN:	PUSH	D
	LXI	D,WHAT
	CALL	PRINT
	POP	D
	CALL	PRINT
	LXI	D,VALUE
	CALL	PRINT
	CALL	INP10		; Get input
	LDA	MBUF+1
	ORA	A		; Was entry zero?
	JZ	BEGIN		; No, then back to start
	MOV	C,A		; Yes, then install counter
	LXI	H,MBUF+2	; Start of numbers
	LXI	D,0		; Zero reg. DE
	RET
;
CNVRT:	PUSH	D		; Save number
	LXI	D,MESS3		; CR/LF
	CALL	PRINT
	LXI	D,MESS5		; =header
	CALL	PRINT
	MVI	A,20H		; Add space here
	CALL	OUTPT
	POP	D		; Restore number
;
;
; -> Start base output here
;
DOUT:	XCHG			; Number now is HL
	PUSH	H		; Save it on stack
	LXI	B,2710H		; 10,000 units
	CALL	SUBTR
	LXI	B,3E8H		; 1,000 units
	CALL	SUBTR
	LXI	B,64H		; 100 units
	CALL	SUBTR
	LXI	B,0AH		; 10 units
	CALL	SUBTR
	MOV	A,L
	ADI	30H
	CALL	OUTPT
	POP	D		; Return original number to DE
	CALL	SPACES
;
HOUT:	MOV	A,D
	CALL	DOHEX
	MOV	A,E
	CALL	DOHEX
	CALL	SPACES
;
OOUT:	MOV	A,D
	RAL
	RAL
	PUSH	PSW
	ANI	001H
	CALL	OCTOUT
	POP	PSW
	CALL	ROTES
	MOV	A,E
	CALL	ROTES
	CALL	ROTER
	CALL	SPACES
;
SOOUT:	MOV	A,D
	CALL	SOCT
	MVI	A,'/'
	CALL	OUTPT
	MOV	A,E
	CALL	SOCT
	CALL	SPACES
;
BOUT:	MOV	A,D
	CALL	BINOUT
	MOV	A,E
	CALL	BINOUT
	CALL	SPACES
	CALL	SPACES
;
AOUT:	MOV	A,D
	CALL	ATEST
	MVI	A,' '
	CALL	OUTPT
	MOV	A,E
	CALL	ATEST
	CALL	CRLF
	CALL	CRLF
	JMP	BEGIN
;.....
;
;
CRLF:	MVI	A,0DH
	CALL	OUTPT
	MVI	A,0AH
	JMP	OUTPT
;.....
;
;
ATEST:	CPI	' '
	JC	DODOT
;;	CPI	5BH
;;	JC	OUTPT
	JMP	OUTPT
;
DODOT:	MVI	A,'.'
	JMP	OUTPT
;.....
;
;
BINOUT:	MVI	B,2		; Outer counter
;
BINO1:	PUSH	B
	MVI	B,4		; Inner counter = 4 bits
;
BLOOP:	RAL
	PUSH	PSW
	MVI	A,'1'
	JC	BINOK
	MVI	A,'0'
;
BINOK:	CALL	OUTPT
	POP	PSW
	DCR	B		; Bit counter
	JNZ	BLOOP
	PUSH	PSW
	MVI	A,20H
	CALL	OUTPT		; Put space between group of 4 bits
	POP	PSW		; Restore byte
	POP	B		; Get outer counter
	DCR	B
	RZ			; If zero, done with this byte
	JMP	BINO1		; Get more bits
;.....
;
;
SOCT:	RAL
	RAL
	RAL
	PUSH	PSW
	ANI	3H
	CALL	SPOUT
	POP	PSW
	CALL	SPINR
;
SPINR:	RAL
	RAL
	RAL
;
SPOUT:	PUSH	PSW
	ANI	007H
	ADI	30H
	CALL	OUTPT
	POP	PSW
	RET
;.....
;
;
ROTES:	CALL	ROTER
;
ROTER:	RAL
	RAL
	RAL
;
OCTOUT:	PUSH	PSW
	ANI	7H
	ADI	30H
	CALL	OUTPT
	POP	PSW
	RET
;.....
;
;
DOHEX:	PUSH	PSW
	RRC
	RRC
	RRC
	RRC
	CALL	HEXOUT
	POP	PSW
;
HEXOUT:	ANI	0FH
	ADI	30H
	CPI	':'
	JC	OUTPT
	ADI	7H
	JMP	OUTPT
;.....
;
;
SUBTR:	MVI	D,0FFH
;
LOOP5:	MOV	A,L
	SUB	C
	MOV	L,A
	MOV	A,H
	SBB	B
	MOV	H,A
	INR	D
	JNC	LOOP5
	DAD	B
	MOV	A,D
	ADI	030H
	JMP	OUTPT
;....
;
;
ERR1:	POP	H
;
ERROR:	LXI	D,MESS4
	CALL	PRINT
	JMP	BEGIN
;.....
;
;
SPACES:	MVI	A,' '
	CALL	OUTPT
	MVI	A,' '
	CALL	OUTPT
	JMP	OUTPT
;.....
;
;
CLS:	LXI	D,CLEAR		; Clear screen for Kaypro
	CALL	PRINT
	RET
;.....
;
;
INFO:	CALL	CLS
	LXI	D,INFORM	; Give user information
	CALL	PRINT
	JMP	BEGIN
;.....
;
;
PRINT:	PUSH	B
	PUSH	D
	PUSH	H
	MVI	C,9
	CALL	5
	POP	H
	POP	D
	POP	B
	RET
;.....
;
;
OUTPT:	PUSH	B
	PUSH	D
	PUSH	H
	MVI	C,2
	MOV	E,A
	CALL	5
	POP	H
	POP	D
	POP	B
	RET
;.....
;
;
INP1:	PUSH	B
	PUSH	D
	PUSH	H
	MVI	C,1
	CALL	5
	POP	H
	POP	D
	POP	B
	RET
;.....
;
;
INP10:	PUSH	B
	PUSH	D
	PUSH	H
	MVI	C,10
	LXI	D,MBUF
	CALL	5
	POP	H
	POP	D
	POP	B
	RET
;.....
;
;
MBUF:	DB	22		; Max. digits allowed (allow binary spaces)
	DB	0		; Actual # digits entered
	DS	22		; Buffer for digits (allow for spaces
				; In binary)
	DB	'CLS HERE->'	; Makes patching easy
;
CLEAR:	DB	1AH,'$',0,0,0	; Kaypro clear screen
;
INFORM:	DB	'                            BASE.COM',CR,LF
	DB	CR,LF
	DB	'                         by Jon Lindsay',CR,LF
	DB	CR,LF
	DB	'Usage:',CR,LF
	DB	CR,LF
	DB	'->   Select the BASE (single letter) you wish'
	DB	' to enter.',CR,LF
	DB	CR,LF
	DB	'Enter:',CR,LF
	DB	'     E = Erase screen',CR,LF
	DB	'     D = Decimal',CR,LF
	DB	'     H = Hexadecimal',CR,LF
	DB	'     O = Octal',CR,LF
	DB	'     Q = Octal',CR,LF
	DB	'     S = Split-octal',CR,LF
	DB	'     B = Binary',CR,LF
	DB	'     A = ASCII',CR,LF
	DB	'     X = Exit to CP/M',CR,LF
	DB	'     ? = Information about program',CR,LF
	DB	CR,LF
	DB	'->   Enter desired BASE VALUE, then carriage return.'
	DB	CR,LF,'$'
;
;
; Message area
;
MESS1:	DB	0DH,0AH,'What BASE is your entry?  ','$'
MESS2:	DB	0DH,0AH,'Sorry, I don''t understand! ','$'
MESS3:	DB	0DH,0AH,'$'
MESS4:	DB	0DH,0AH
	DB	'Input character WRONG for base specified','$'
MESS5:	DB	00DH,00AH,'DECIMAL  HEX   OCTAL  S/OCTAL        BINARY'
	DB	'           ASCII',0DH,0AH,'$'
WHAT:	DB	0DH,0AH,'What''s your ','$'
VALUE:	DB	' value?   ','$'
DECIMAL:DB	'DECIMAL','$'
HEXAD:	DB	'HEXADECIMAL','$'
OCTAL:	DB	'OCTAL','$'
SPLIT:	DB	'SPLIT OCTAL','$'
BINRY:	DB	'BINARY','$'
ASCII:	DB	'ASCII','$'
	DS	32
STACK:	DS	2		; Old stack pointer
;.....
;
;
	END	START		; End of assembly