.po1
;	ROMAN80 - VERSION 0.2
;       (Now version 0.2a)
;
;	ROMAN CONVERSION PROGRAM
;
;	DATE: 10-OCT-78
;	BY: M PEDDER
;
;	Taken from SIG/M Users' Group Vol. 75, Prog. 75.21
;	Modified for CP/M by D. Mc Lanahan, Marlow, NH 2/13/83
;
;	DEFINITIONS

CPM$BASE	EQU	0		; BASE ADDRESS OF CP/M SYSTEM
	BDOS	EQU	CPM$BASE+5	; ADDRESS OF BDOS ENTRY
	CR	EQU	0DH
	LF	EQU	0AH
        SPACE   EQU     20H
        PERIOD  EQU     2EH
        COMMA   EQU     2CH
	COLON	EQU	3AH
	ORG	CPM$BASE+100H
;
START:	JMP	ROMAN
STACK:	EQU	400H
;
;	MESSAGES
;
STM	DB	'Copr. (C) 1978 M Pedder. Mod. 1983, D. Mc Lanahan',CR,LF
	DB	'"ROMAN" accepts decimal numbers in the range 1 - 3999'
	DB	CR,LF
	DB	'and converts to Roman numerals, checking validity.'
	DB	CR,LF,LF
	DB	'Enter data following "Ready: ", ending with <cr>'
CRLF:	DB	CR,LF,'$'
RDM	DB	CR,LF,'Ready:  $'
TOOL:	DB	'  Too Large!$'
INV:	DB	'  Invalid character!$'
LIST:	DB	0,0,'IVXLCDM'
;
;	WORKSPACE:
;
DBUF:	DS	5		;DECIMAL BUFFER
RBUF:	DS	16		;ROMAN BUFFER
DCNT:	DS	1		;DECIMAL COUNT
STK:	DS	2		;SP HOLDER
;
;	SUPERVISORY:
;
ROMAN:	LXI	H,0
	DAD	SP
	SHLD	STK
	LXI	SP,STACK	;PREPARE STACK
	LXI	H,STM		;POINT TO START MESSAGE
	CALL	PRINT		;AND OUTPUT ITŠRDY:	CALL	RDYM		;PRODUCE READY MESSAGE, AND SET UP
	CALL	INPUT		;GET DATA
	JC	RDY		;IF IT IS VALID
	CALL	ENC		;ENCODE AND OUTPUT IT
	JMP	RDY
;
;	READY MESSAGE AND SETTING UP:
;
RDYM:	LXI	H,RDM		;POINT TO READY MESSAGE
	CALL	PRINT		;AND OUTPUT IT
	LXI	B,DBUF		;PREPARE DECIMAL POINTER
	LXI	H,DCNT		;AND COUNT POINTER
	MVI	M,00H		;CLEAR COUNTER
	RET
;
;	GET INPUT FROM CONSOLE INTO DBUF, CHECKING VALIDITY:
;
INPUT:  PUSH    H
	PUSH	D
	PUSH	B
	MVI	C,1
	CALL	BDOS		;IF CHARACTER
        POP	B
	POP	D
	POP     H
        ANI	7FH		;STRIP PARITY
	CPI	03H		;IF IT IS EXIT CMD
	JZ	EXIT		;THEN GO
	CPI	0DH		;IF IT IS 'CR'
	JNZ	ECHO		;THEN
        LXI     H,CRLF
        CALL    PRINT
	MVI	A,20H		;LOAD 'SPACE'     
        CALL    COUT            ;AND OUTPUT IT
        MVI     A,'='
	CALL	COUT		
        MVI     A,SPACE
        CALL    COUT
	MVI	A,'$'		;MARK END
	STAX	B		;OF DATA
	ORA	A		;CLEAR FLAG
	RET
;
EXIT:	LHLD	STK
	SPHL
	RET
;
ECHO:	;CALL	COUT		;ECHO CHARACTER
	CPI	'0'		;IF IT IS ZERO OR MORE
	JM	INVCH		;AND
	CPI	':'		;IF IT IS NINE OR LESS
	JP	INVCH		;THEN IT IS VALID CHARACTER
	INR	M		;SO COUNT IT
	STAX	B		;AND STORE IT
	INX	B		;ADVANCE POINTERŠ	MOV	A,M		;CHECK COUNT
	CPI	05H		;IF IT IS LESS THAN FIVE
	JM	INPUT		;THEN CONTINUE
	LXI	H,TOOL		;ELSE POINT TO 'TOO LARGE'
	JMP	MES
;
INVCH:	LXI	H,INV		;POINT TO 'INVALID CHARACTER'
MES:	CALL	PRINT		;AND OUTPUT IT
	STC			;SET ERROR FLAG
	RET
;
;
;
;	PREPARE TO ENCODE:
;
ENC:	LXI	B,DBUF		;PREPARE DECIMAL POINTER
	LXI	D,LIST		;PREPARE LIST POINTER
	LXI	H,DCNT		;PREPARE COUNT POINTER
	MOV	A,M		;GET COUNT
	CPI	04H		;IF IT IS NOT FOUR
	JNZ	CONT		;CONTINUE
	LDAX	B		;ELSE GET FIRST CHARACTER
	CPI	34H		;IF IT IS NOT FOUR
	JM	CONT		;CONTINUE
	LXI	H,TOOL		;ELSE LOAD 'TOO LARGE'
	CALL	PRINT		;AND OUTPUT IT
	RET
;
CONT:	MOV	L,M		;GET COUNT
	MVI	H,00H		;INTO HL
	DAD	H		;DOUBLE IT
	DAD	D		;ADD TO LIST
	XCHG			;AND RESTORE LIST
	LXI	H,RBUF		;PREPARE ROMAN POINTER
;
;	ENCODE CHARACTER STREAM IN DBUF:
;
ENCA:	LDAX	B		;GET A CHARACTER
	INX	B		;UPDATE THE POINTER
	CPI	'$'		;IF IT IS NOT "END MARKER"
	RZ			;THEN
	CPI	'9'		;IF IT IS NOT A NINE
	JZ	NINE		;THEN
	CPI	'5'		;IF IT IS NOT FIVE OR MORE
	JP	FIVE		;THEN
	CPI	'4'		;IF IT IS NOT FOUR
	JZ	FOUR		;THEN
ETA:	CPI	'0'		;IF IT IS ZERO
	JNZ	ONE		;THEN
ETB:	DCX	D		;MODIFY ROMAN POINTER
	DCX	D		;TWICE
	LDA	DCNT		;REDUCE COUNT
	DCR	A		;AND
	STA	DCNT		;IF IT IS NOT ZERO
	JNZ	ENCA		;THEN LOOPŠ	MVI	A,'$'		;ELSE MARK END
	CALL	STOR		;AND STORE IT
	JMP	ROUT		;ENCODE COMPLETED
;
;
;	ITS A 1=I, 10=X, 100=C, 1000=M OR MORE:
;
ONE:	PUSH	PSW		;SAVE DATA
	LDAX	D		;LOAD ROMAN CHARACTER
	CALL	STOR		;AND STORE IT
	POP	PSW		;UNSAVE DATA
	DCR	A		;SUBTRACT ONE
	JMP	ETA		;AND TRY AGAIN
;
;	ITS A 4=IV, 40=XL, 400=CD:
;
FOUR:	LDAX	D		;LOAD ROMAN CHARACTER I, X OR C
	CALL	STOR		;AND STORE IT
	INX	D		;GET NEXT
	LDAX	D		;ROMAN CHARACTER V, L OR D
	CALL	STOR		;AND STORE THAT
	DCX	D		;RESTORE POINTER
	JMP	ETB		;AND EXIT
;
;	ITS A 5=V, 50=L, 500=D OR MORE:
;
FIVE:	PUSH	PSW		;SAVE DATA
	INX	D		;PREPARE POINTER
	LDAX	D		;GET ROMAN CHARACTER V, L OR D
	CALL	STOR		;AND STORE IT
	DCX	D		;RESTORE POINTER
	POP	PSW		;AND DATA
	SUI	05H		;SUBTRACT FIVE
	JMP	ETA		;AND TRY AGAIN
;
;	ITS A 9=IX, 90=XC, OR 900=CM:
;
NINE:	LDAX	D		;GET ROMAN CHARACTER I, X OR C
	CALL	STOR		;AND STORE IT
	INX	D		;MOVE
	INX	D		;POINTER
	LDAX	D		;GET ROMAN CHARACTER X, C OR M
	CALL	STOR		;AND STORE THAT
	DCX	D		;RESTORE
	DCX	D		;POINTER
	JMP	ETB		;AND EXIT
;
;
;	STORE ROMAN CHARACTER IN RBUF FOR OUTPUT:
;
STOR:	MOV	M,A		;STORE DATA IN BUFFER
	INX	H		;AND MOVE POINTER
	RET
;
;	ROMAN OUTPUT TO CONSOLE:Š;
ROUT:	LXI	H,RBUF		;POINT TO ROMAN BUFFER
	CALL	PRINT		;AND OUTPUT IT
	RET
;
*  PRINT STRING ENDING IN 0 PTED TO BY H & L
PRINT:	MOV	A,M	; GET BYTE
	INX	H	; PT TO NEXT
	CPI	'$'	; DONE?
        RZ
	CALL	COUT	; PRINT IT
	JMP	PRINT

*  PRINT CHAR IN REG A ON CONSOLE
COUT:   PUSH    A
	PUSH	H	; SAVE REGS
	PUSH	D
	PUSH	B
	MOV	E,A
	MVI	C,2	; CONSOLE OUTPUT
	CALL	BDOS
	POP	B	; RESTORE REGS
	POP	D
	POP	H
        POP     A
	RET

;
	END
