82 lines
2.4 KiB
Text
82 lines
2.4 KiB
Text
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
|