Data commit

Task/Mayan-numerals/PL-M/mayan-numerals.plm

@@ -0,0 +1,99 @@
+/* MAYAN NUMERALS IN PL/M
+
+   THIS PROGRAM RUNS UNDER CP/M AND TAKES THE NUMBER ON THE COMMAND LINE */
+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 */
+DECLARE CL$PTR ADDRESS INITIAL (80H), CMD$LEN BASED CL$PTR BYTE;
+DECLARE CMD$PTR ADDRESS INITIAL (81H), CMD$LINE BASED CMD$PTR BYTE;
+
+/* THE PIPE AND AT SYMBOLS ARE NOT INCLUDED IN THE PL/M CHARSET */
+DECLARE PIPE LITERALLY '7CH', AT LITERALLY '40H';
+
+/* PRINT BORDER FOR N DIGITS */
+BORDER: PROCEDURE (N);
+    DECLARE (I, N) BYTE;
+    DO I=1 TO N;
+        CALL PRINT(.'+----$');
+    END;
+    CALL PRINT(.('+',13,10,'$'));
+END BORDER;
+
+/* PRINT LINE FOR GIVEN DIGIT */
+DIGIT$LINE: PROCEDURE (LINE, DIGIT);
+    DECLARE (I, LINE, DIGIT, UPB) BYTE;
+    DECLARE PARTS (6) ADDRESS;
+    PARTS(0) = .(PIPE,'    $'); PARTS(1) = .(PIPE,' .  $');
+    PARTS(2) = .(PIPE,' .. $'); PARTS(3) = .(PIPE,'... $');
+    PARTS(4) = .(PIPE,'....$'); PARTS(5) = .(PIPE,'----$');
+
+    IF DIGIT = 0 THEN DO;
+        IF LINE = 3 THEN CALL PRINT(.(PIPE,' ',AT,'  $'));
+        ELSE CALL PRINT(PARTS(0));
+    END;
+    ELSE DO;
+        UPB = 15-LINE*5;
+        IF DIGIT < UPB THEN CALL PRINT(PARTS(0));
+        ELSE IF DIGIT >= UPB+5 THEN CALL PRINT(PARTS(5));
+        ELSE CALL PRINT(PARTS(DIGIT-UPB));
+    END;
+END DIGIT$LINE;
+
+/* PRINT LINE GIVEN DIGITS */
+LINE: PROCEDURE (L, DIGITS, NDIGITS);
+    DECLARE DIGITS ADDRESS;
+    DECLARE (L, I, D BASED DIGITS, NDIGITS) BYTE;
+    DO I=0 TO NDIGITS-1;
+        CALL DIGIT$LINE(L, D(I));
+    END;
+    CALL PRINT(.(PIPE,13,10,'$'));
+END LINE;
+
+/* CHECK FOR ARGUMENT */
+IF CMD$LEN < 2 THEN DO;
+    CALL PRINT(.'NO INPUT$');
+    CALL EXIT;
+END;
+
+/* PREPROCESS COMMAND LINE - TURN EACH ASCII DIGIT INTO 0-9 */
+DECLARE (I, J) BYTE;
+DO I = 1 TO CMD$LEN-1;
+    CMD$LINE(I) = CMD$LINE(I) - '0';
+    IF CMD$LINE(I) > 9 THEN DO;
+        /* ERROR MESSAGE FOR INVALID INPUT */
+        CALL PRINT(.'INVALID DIGIT IN INPUT$');
+        CALL EXIT;
+    END;
+END;
+
+/* CONVERT TO BASE 20 DIGIT BY DIGIT */
+J = CMD$LEN-2;
+DO WHILE J > 0;
+    DO I = 1 TO J;
+        CMD$LINE(I+1) = CMD$LINE(I+1) + 10*(CMD$LINE(I) AND 1);
+        CMD$LINE(I) = CMD$LINE(I) / 2;
+    END;
+    J = J - 1;
+END;
+
+/* FIND FIRST NONZERO DIGIT */
+J = 1;
+DO WHILE CMD$LINE(J) = 0 AND J < CMD$LEN-1;
+    J = J + 1;
+END;
+
+/* PRINT CARTOUCHES */
+DECLARE SIZE BYTE;
+SIZE = CMD$LEN-J;
+CALL BORDER(SIZE);
+DO I=0 TO 3;
+    CALL LINE(I, .CMD$LINE(J), SIZE);
+END;
+CALL BORDER(SIZE);
+
+CALL EXIT;
+EOF