Task

Create a function that takes a Roman numeral as its argument and returns its value as a numeric decimal integer.

You don't need to validate the form of the Roman numeral.

Modern Roman numerals are written by expressing each decimal digit of the number to be encoded separately,

starting with the leftmost decimal digit and skipping any 0s   (zeroes).

1990 is rendered as   MCMXC     (1000 = M,   900 = CM,   90 = XC)     and

2008 is rendered as   MMVIII       (2000 = MM,   8 = VIII).

The Roman numeral for 1666,   MDCLXVI,   uses each letter in descending order.




100H:
/* CP/M CALLS */
BDOS: PROCEDURE (FN, ARG); DECLARE FN BYTE, ARG ADDRESS; GO TO 5; END BDOS;
EXIT: PROCEDURE; CALL BDOS(0,0); END EXIT;
PRINT: PROCEDURE (S); DECLARE S ADDRESS; CALL BDOS(9,S); END PRINT;
 
/* CP/M COMMAND LINE ARGUMENT */
DECLARE ARG$LPTR ADDRESS INITIAL (80H), ARG$LEN BASED ARG$LPTR BYTE;
DECLARE ARG$PTR  ADDRESS INITIAL (81H), ARG     BASED ARG$PTR BYTE;
 
/* CONVERT ROMAN NUMERAL TO BINARY */
READ$ROMAN: PROCEDURE (RP) ADDRESS;
    DECLARE DIGITS (7) BYTE INITIAL ('MDCLXVI');
    DECLARE VALUES (7) ADDRESS INITIAL (1000,500,100,50,10,5,1);
    DECLARE (RP, V, DVAL) ADDRESS, R BASED RP BYTE;
    V = 0;
 
    GET$DIGIT: PROCEDURE (D) ADDRESS;
        DECLARE (D, I) BYTE;
        DO I = 0 TO LAST(DIGITS);
            IF DIGITS(I) = D THEN RETURN VALUES(I);
        END;
        RETURN 0; /* NOT FOUND */
    END GET$DIGIT;
 
    DO WHILE R <> '$';
        DVAL = GET$DIGIT(R);
        IF DVAL = 0 THEN RETURN 0; /* ERROR */
        RP = RP + 1;
        IF GET$DIGIT(R) > DVAL THEN
            V = V - DVAL; /* SUBTRACTIVE PRINCIPLE */
        ELSE
            V = V + DVAL;
    END;
    RETURN V;
END READ$ROMAN;
 
/* PRINT BINARY NUMBER AS DECIMAL */
PRINT$NUMBER: PROCEDURE (N);
    DECLARE S (6) BYTE INITIAL ('.....$');
    DECLARE (N, P) ADDRESS, C BASED P BYTE;
    P = .S(5);
DIGIT:
    P = P - 1;
    C = N MOD 10 + '0';
    N = N / 10;
    IF N > 0 THEN GO TO DIGIT;
    CALL PRINT(P);
END PRINT$NUMBER;
 
IF ARG$LEN = 0 THEN DO;
    CALL PRINT(.'NO INPUT$');
    CALL EXIT;
END;
 
ARG(ARG$LEN) = '$';  /* TERMINATE ARGUMENT STRING */
CALL PRINT(.ARG(1)); /* PRINT ROMAN NUMERAL */
CALL PRINT(.': $');
CALL PRINT$NUMBER(READ$ROMAN(.ARG(1))); /* CONVERT AND PRINT VALUE */
CALL EXIT;
EOF