Doomsday rule: Difference between revisions
Add PL/M
Not a robot (talk | contribs) (Add Python) |
Not a robot (talk | contribs) (Add PL/M) |
||
Line 443:
April 2, 2101 will be on a Saturday
</pre>
=={{header|PL/M}}==
<lang plm>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</lang>
{{out}}
<pre>1/6/1800: MONDAY
3/29/1875: MONDAY
12/7/1915: TUESDAY
12/23/1970: WEDNESDAY
5/14/2043: THURSDAY
2/12/2077: FRIDAY
4/2/2101: SATURDAY</pre>
=={{header|Python}}==
| |||