Data commit

Task/Doomsday-rule/PL-M/doomsday-rule.plm

@@ -0,0 +1,82 @@
+100H:
+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;
+PRINT$CHAR: PROCEDURE (C); DECLARE C BYTE; CALL BDOS(2,C); END PRINT$CHAR;
+
+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;
+
+PRINT$DATE: PROCEDURE (YEAR, MONTH, DAY);
+    DECLARE YEAR ADDRESS, (MONTH, DAY) BYTE;
+    CALL PRINT$NUMBER(MONTH);
+    CALL PRINT$CHAR('/');
+    CALL PRINT$NUMBER(DAY);
+    CALL PRINT$CHAR('/');
+    CALL PRINT$NUMBER(YEAR);
+END PRINT$DATE;
+
+DAY$NAME: PROCEDURE (N) ADDRESS;
+    DECLARE N BYTE;
+    DO CASE N;
+        RETURN .'SUNDAY$';
+        RETURN .'MONDAY$';
+        RETURN .'TUESDAY$';
+        RETURN .'WEDNESDAY$';
+        RETURN .'THURSDAY$';
+        RETURN .'FRIDAY$';
+        RETURN .'SATURDAY$';
+   END;
+END DAY$NAME;
+
+LEAP$YEAR: PROCEDURE (YEAR) BYTE;
+    DECLARE YEAR ADDRESS;
+    RETURN (YEAR MOD 4 = 0) AND ((YEAR MOD 100 <> 0) OR (YEAR MOD 400 = 0));
+END LEAP$YEAR;
+
+WEEK$DAY: PROCEDURE (YEAR, MONTH, DAY) BYTE;
+    DECLARE LEAP$DOOM DATA (4,1,7,4,2,6,4,1,5,3,7,5);
+    DECLARE NORM$DOOM DATA (3,7,7,4,2,6,4,1,5,3,7,5);
+    DECLARE YEAR ADDRESS, (MONTH, DAY) BYTE;
+    DECLARE (C, R, S, T, C$ANCHOR, DOOM$DAY, ANCHOR$DAY) BYTE;
+
+    C = YEAR / 100;
+    R = YEAR MOD 100;
+    S = R / 12;
+    T = R MOD 12;
+    C$ANCHOR = (5 * (C MOD 4) + 2) MOD 7;
+    DOOM$DAY = (S + T + T/4 + C$ANCHOR) MOD 7;
+    IF LEAP$YEAR(YEAR)
+        THEN ANCHOR$DAY = LEAP$DOOM(MONTH-1);
+        ELSE ANCHOR$DAY = NORM$DOOM(MONTH-1);
+
+    RETURN (DOOM$DAY + DAY - ANCHOR$DAY + 7) MOD 7;
+END WEEK$DAY;
+
+FORMAT$OUT: PROCEDURE (YEAR, MONTH, DAY);
+    DECLARE YEAR ADDRESS, (MONTH, DAY) BYTE;
+    CALL PRINT$DATE(YEAR, MONTH, DAY);
+    CALL PRINT(.': $');
+    CALL PRINT(DAY$NAME(WEEK$DAY(YEAR, MONTH, DAY)));
+    CALL PRINT(.(13,10,'$'));
+END FORMAT$OUT;
+
+DECLARE YEARS (7) ADDRESS INITIAL (1800, 1875, 1915, 1970, 2043, 2077, 2101);
+DECLARE MONTHS (7) BYTE   INITIAL (   1,    3,   12,   12,    5,    2,    4);
+DECLARE DAYS (7) BYTE     INITIAL (   6,   29,    7,   23,   14,   12,    2);
+
+DECLARE I BYTE;
+DO I=0 TO LAST(DAYS);
+    CALL FORMAT$OUT(YEARS(I), MONTHS(I), DAYS(I));
+END;
+CALL EXIT;
+EOF