Data commit

Task/Roman-numerals-Decode/PL-M/roman-numerals-decode.plm

@@ -0,0 +1,61 @@
+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