Doesn't do much for the speed, but a ridiculously simple change shaves more than 10% off the size.
Code:
RPL
( constants [and their definitions] used by the app )
DEFINE TotalLAMs BINT3
DEFINE GetResult 1GETLAM
DEFINE PutResult 1PUTLAM
DEFINE RomNumSub 2GETEVAL
DEFINE GetCurVal 3GETLAM
DEFINE PutCurVal 3PUTLAM
::
CK1NOLASTWD ( must have at least one item on stack )
CK&DISPATCH1 ( check the value's type [real or zint->real] )
real
::
COERCE ( LAM 3 - CurVal [converted to a BINT] )
' :: ( LAM 2 - RomNumSub subroutine )
( upon entry: SL2-> String, SL1-> Magnitude )
GetCurVal SWAP #/ ( divide current value by magnitude )
( note: #/ returns #r #q )
SWAP PutCurVal ( save remainder as new current value, )
( leave quotient on stack )
NDUPN ( make [quotient] copies of roman numerals )
DUP#0<> ( check to see if any digits need to be added )
ITE
:: ( yes - accumulate digits )
BEGIN
#1-DUP #0<> ( loop 1 less time than # of duplicates )
WHILE
:: UNROT &$SWAP ; ( combine digits, swap counter into SL1 )
REPEAT
DROP ( drop the duplicate count )
GetResult SWAP&$ PutResult ( append the new digits to the result )
;
DROP ( no digits to add - just drop the count )
;
NULL$ ( LAM 1 - Result )
* NULLLAM TotalLAMs NDUPN DOBIND ( Bind LAMs )
PTR 27208 BIND
( build the result string )
"M" # 3E8 RomNumSub ( 1000 )
"CM" # 384 RomNumSub ( 900 )
"D" # 1F4 RomNumSub ( 500 )
"CD" # 190 RomNumSub ( 400 )
"C" BINT100 RomNumSub ( 100 )
"XC" BINT90 RomNumSub ( 90 )
"L" BINT50 RomNumSub ( 50 )
"XL" BINT40 RomNumSub ( 40 )
"X" BINT10 RomNumSub ( 10 )
"IX" BINT9 RomNumSub ( 9 )
"V" BINT5 RomNumSub ( 5 )
"IV" BINT4 RomNumSub ( 4 )
"I" BINT1 RomNumSub ( 1 )
GetResult ( retrieve result )
ABND ( abandon LAMs )
;
;
In case it's not obvious, I mainly rearranged the temporaries so as to be able to use the 2GETEVAL word, saving 32.5 bytes. I also saved another five bytes in the binding.