PROCEDURE	<ROMAN - Roman numeral conversion>,010002
 
;+
;	Copyright (C) Not at all
;
;	This routine will convert a number to its
;	equivalent ROMAN numeral represenation
;
; Written:	02-May-80, -1.0.0-, Henry R. Tumblin
;
; Modified:	21-May-80, -1.0.1-, Jon Berntsen
;	Fixed bug in conversion to roman numeral
;
; Modified:	10-Jun-80, -1.0.2-, Henry R. Tumblin
;	R2 now returns the length of the numeric string
;
; Verified:	10-Jun-80, -1.0.2-, Henry R. Tumblin
;
;-


	.sbttl	Data Areas
 
	DATA	ROMAND

ROMNUM:	.BLKB	40.		; Work area
 
RNCHAR::.ASCII	"MCDCCXLXXIVIII"

RN1:	.WORD	1000.,500.,100.,50.,10.,5.,1.

RN2:	.WORD	100.,100.,10.,10.,1.,1.,0

RNC=	RN1-RNCHAR

RNC1=	RN2-RNCHAR

UCFLG:	.BLKW	1		; Upper case flag

	.sbttl	Start mainline code
 
	CODE	ROMAN

;	On entry, R0 contains the number to be converted.
;		  R1 Contains the buffer pointer.
;		  R2 is 0 if the roman numeral is to be all upper case
;		  R2 is 1 if the roman numeral is to be all lower case

ROMAN::	SAVE	R3,R4,R5		; Save volitile registers
	MOV	R1,R5			; Save for later
	CLR	UCFLG
	TST	R2			; Upper or lower case
	BEQ	120$
	MOV	#40,UCFLG
120$:	MOV	R0,R2			; Get number to convert
	BPL	110$			; PL - then number is OK
	NEG	R2			; Else ABS(RN)
110$:	MOV	#ROMNUM,R1		; Point to output buffer
	MOV	#RNCHAR,R3
1$:	TST	R2			; Done with conversion?
	BLE	60$			; Yes, quit
	SUB	RNC(R3),R2		; No, subtract next value
	BLT	10$			; Value too large
5$:	MOVB	(R3),(R1)+		; Put character
	BR	1$
10$:	ADD	RNC1(R3),R2		; Add in next lower value
	BLT	20$			; Negative
	MOVB	1(R3),(R1)+		; No, put in next character
	BR	5$
20$:	SUB	RNC1(R3),R2		; Get back original number
	ADD	RNC(R3),R2
30$:	TST	(R3)+			; Increment value pointer
	BR	1$
60$:	SUB	#ROMNUM,R1		; Get number of characters
	MOV	R1,R0
	MOV	#ROMNUM,R2		; Point to work area
70$:	MOV	R5,R4			; Get destination pointer
	MOVB	(R2)+,R1		; Move into position
	BIS	UCFLG,R1		; Make proper case
	CALL	WCI			; Write character in buffer
	SOB	R0,70$			; Loop until thru
	MOV	BF.LEN(R5),R2		; Return length in R2
	UNSAVE	R3,R4,R5		; Restore registers
	RETURN				; Return to caller
 
	.END