44 lines
1.7 KiB
Text
44 lines
1.7 KiB
Text
100H: /* DETERMINE WHETHER SOME YEARS ARE LEAP YEARS OR NOT */
|
|
|
|
/* CP/M BDOS SYSTEM CALL */
|
|
BDOS: PROCEDURE( FN, ARG ); DECLARE FN BYTE, ARG ADDRESS; GOTO 5;END;
|
|
/* CONSOLE OUTPUT ROUTINES */
|
|
PR$CHAR: PROCEDURE( C ); DECLARE C BYTE; CALL BDOS( 2, C ); END;
|
|
PR$STRING: PROCEDURE( S ); DECLARE S ADDRESS; CALL BDOS( 9, S ); END;
|
|
PR$NL: PROCEDURE; CALL PR$STRING( .( 0DH, 0AH, '$' ) ); END;
|
|
PR$NUMBER: PROCEDURE( N );
|
|
DECLARE N ADDRESS;
|
|
DECLARE V ADDRESS, N$STR( 6 ) BYTE INITIAL( '.....$' ), W BYTE;
|
|
N$STR( W := LAST( N$STR ) - 1 ) = '0' + ( ( V := N ) MOD 10 );
|
|
DO WHILE( ( V := V / 10 ) > 0 );
|
|
N$STR( W := W - 1 ) = '0' + ( V MOD 10 );
|
|
END;
|
|
CALL PR$STRING( .N$STR( W ) );
|
|
END PR$NUMBER;
|
|
|
|
/* TASK */
|
|
/* RETURNS TRUE IF YEAR IS A LEAP YEAR, FALSE OTHERWISE */
|
|
/* ASSUMES YEAR IS IN THE GREGORIAN CALENDAR */
|
|
IS$LEAP$YEAR: PROCEDURE( YEAR )BYTE;
|
|
DECLARE YEAR ADDRESS;
|
|
RETURN ( YEAR MOD 400 = 0
|
|
OR ( YEAR MOD 4 = 0 AND YEAR MOD 100 <> 0 )
|
|
);
|
|
END IS$LEAPYEAR ;
|
|
/* TEST CASES */
|
|
DECLARE TEST$YEAR ( 15 )ADDRESS INITIAL( 1899, 1900, 1901, 1902, 1903
|
|
, 1904, 1905, 1999, 2000, 2001
|
|
, 2002, 2003, 2004, 2021, 2022
|
|
);
|
|
DECLARE Y$POS BYTE;
|
|
DO Y$POS = 0 TO LAST( TEST$YEAR );
|
|
CALL PR$NUMBER( TEST$YEAR( Y$POS ) );
|
|
CALL PR$STRING( .' IS $' );
|
|
IF NOT IS$LEAP$YEAR( TEST$YEAR( Y$POS ) ) THEN DO;
|
|
CALL PR$STRING( .'NOT $' );
|
|
END;
|
|
CALL PR$STRING( .'A LEAP YEAR$' );
|
|
CALL PR$NL;
|
|
END;
|
|
|
|
EOF
|