Riordan numbers: Difference between revisions
Content added Content deleted
(Added PL/I) |
(Added PL/M) |
||
Line 190: | Line 190: | ||
834086421 2358641376 6684761125 18985057351 |
834086421 2358641376 6684761125 18985057351 |
||
54022715451 154000562758 439742222071 1257643249140 |
54022715451 154000562758 439742222071 1257643249140 |
||
</pre> |
|||
=={{header|PL/M}}== |
|||
{{works with|8080 PL/M Compiler}} ... under CP/M (or an emulator) |
|||
PL/M only handles 8 and 16 bit unsigned integers but also provides two-digit BCD addition/subtraction with carry. |
|||
<br>This sample uses the BCD facility to implement 16-digit arithmetic and solve the basic task. [[Ethiopian multiplication]] and [[Egyptian division]] are used, hence the length of the sample. |
|||
<lang pli>100H: /* FIND SOME RIORDAN NUMBERS */ |
|||
DECLARE FALSE LITERALLY '0'; |
|||
DECLARE TRUE LITERALLY '0FFH'; |
|||
/* CP/M SYSTEM CALL AND I/O ROUTINES */ |
|||
BDOS: PROCEDURE( FN, ARG ); DECLARE FN BYTE, ARG ADDRESS; GOTO 5; END; |
|||
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$CHAR( 0DH ); CALL PR$CHAR( 0AH ); END; |
|||
PR$NUMBER: PROCEDURE( N ); /* PRINTS A NUMBER IN THE MINIMUN FIELD WIDTH */ |
|||
DECLARE N ADDRESS; |
|||
DECLARE V ADDRESS, N$STR ( 6 )BYTE, W BYTE; |
|||
V = N; |
|||
W = LAST( N$STR ); |
|||
N$STR( W ) = '$'; |
|||
N$STR( W := W - 1 ) = '0' + ( V 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; |
|||
DECLARE DEC$LAST LITERALLY '7'; /* SUBSCRIPT OF LAST DIGIT PAIR */ |
|||
DECLARE DEC$LEN LITERALLY '8'; /* LENGTH OF A 16-DIGIT BCD NUMBER */ |
|||
DECLARE DEC$16 LITERALLY '( DEC$LEN )BYTE'; /* TYPE DECLARATION OF A */ |
|||
/* 16-DIGIT BCD NUMBER - 8 BYTES */ |
|||
PR$DEC: PROCEDURE( A$PTR ); /* PRINT AN UNSIGNED 16-DIGIT BCD NUMBER */ |
|||
DECLARE A$PTR ADDRESS; |
|||
DECLARE A BASED A$PTR DEC$16; |
|||
DECLARE ( D, ZERO$CHAR, I, V ) BYTE; |
|||
ZERO$CHAR = ' '; |
|||
DO I = 0 TO DEC$LAST - 1; |
|||
V = A( I ); |
|||
D = SHR( V AND 0F0H, 4 ); |
|||
IF D = 0 THEN CALL PR$CHAR( ZERO$CHAR ); |
|||
ELSE CALL PR$CHAR( D + ( ZERO$CHAR := '0' ) ); |
|||
D = V AND 0FH; |
|||
IF D = 0 THEN CALL PR$CHAR( ZERO$CHAR ); |
|||
ELSE CALL PR$CHAR( D + ( ZERO$CHAR := '0' ) ); |
|||
END; |
|||
V = A( DEC$LAST ); |
|||
D = SHR( V AND 0F0H, 4 ); |
|||
IF D = 0 THEN CALL PR$CHAR( ZERO$CHAR ); |
|||
ELSE CALL PR$CHAR( D + '0' ); |
|||
D = V AND 0FH; |
|||
CALL PR$CHAR( D + '0' ); |
|||
END PR$DEC ; |
|||
/* SETS THE 16-DIGIT BCD VALUE IN A TO 0 */ |
|||
INIT$DEC: PROCEDURE( A$PTR ); |
|||
DECLARE A$PTR ADDRESS; |
|||
DECLARE A BASED A$PTR ( 0 )BYTE; |
|||
DECLARE I BYTE; |
|||
DO I = 0 TO DEC$LAST; |
|||
A( I ) = 0; |
|||
END; |
|||
END INIT$DEC ; |
|||
/* SETS THE 16-DIGIT BCD VALUE IN A TO B */ |
|||
SET$DEC: PROCEDURE( A$PTR, B ); |
|||
DECLARE A$PTR ADDRESS, B BYTE; |
|||
DECLARE A BASED A$PTR DEC$16; |
|||
DECLARE ( I, P, V, D1, D2 ) BYTE; |
|||
V = B; |
|||
P = DEC$LAST; |
|||
DO I = 0 TO DEC$LAST; |
|||
IF V = 0 |
|||
THEN A( P ) = 0; |
|||
ELSE DO; |
|||
D1 = V MOD 10; |
|||
D2 = ( V := V / 10 ) MOD 10; |
|||
A( P ) = SHL( D2, 4 ) OR D1; |
|||
V = V / 10; |
|||
END; |
|||
P = P - 1; |
|||
END; |
|||
END SET$DEC ; |
|||
/* ASSIGN THE 16-DIGIT BCD VALUD IN B TO A */ |
|||
MOV$DEC: PROCEDURE( A$PTR, B$PTR ); |
|||
DECLARE ( A$PTR, B$PTR ) ADDRESS; |
|||
DECLARE A BASED A$PTR DEC$16, B BASED B$PTR DEC$16; |
|||
DECLARE I BYTE; |
|||
DO I = 0 TO DEC$LAST; |
|||
A( I ) = B( I ); |
|||
END; |
|||
END MOV$DEC ; |
|||
/* BCD ADDITION - ADDS B TO A, STORING THE RESULT IN A */ |
|||
/* A AND B MUST HAVE 16 DIGITS */ |
|||
ADD$DEC: PROCEDURE( A$PTR, B$PTR ); |
|||
DECLARE ( A$PTR, B$PTR ) ADDRESS; |
|||
DECLARE A BASED A$PTR DEC$16, B BASED B$PTR DEC$16; |
|||
DECLARE ( A0, A1, A2, A3, A4, A5, A6, A7 ) BYTE; |
|||
DECLARE ( B0, B1, B2, B3, B4, B5, B6, B7 ) BYTE; |
|||
/* SEPARATE THE DIGIT PAIRS */ |
|||
A0 = A( 0 ); A1 = A( 1 ); A2 = A( 2 ); A3 = A( 3 ); |
|||
A4 = A( 4 ); A5 = A( 5 ); A6 = A( 6 ); A7 = A( 7 ); |
|||
B0 = B( 0 ); B1 = B( 1 ); B2 = B( 2 ); B3 = B( 3 ); |
|||
B4 = B( 4 ); B5 = B( 5 ); B6 = B( 6 ); B7 = B( 7 ); |
|||
/* DO THE ADDITIONS */ |
|||
A7 = DEC( A7 + B7 ); |
|||
A6 = DEC( A6 PLUS B6 ); |
|||
A5 = DEC( A5 PLUS B5 ); |
|||
A4 = DEC( A4 PLUS B4 ); |
|||
A3 = DEC( A3 PLUS B3 ); |
|||
A2 = DEC( A2 PLUS B2 ); |
|||
A1 = DEC( A1 PLUS B1 ); |
|||
A0 = DEC( A0 PLUS B0 ); |
|||
/* RETURN THE RESULT */ |
|||
A( 0 ) = A0; A( 1 ) = A1; A( 2 ) = A2; A( 3 ) = A3; |
|||
A( 4 ) = A4; A( 5 ) = A5; A( 6 ) = A6; A( 7 ) = A7; |
|||
END ADD$DEC; |
|||
/* RETURNS TRUE IF THE 16-DIGIT BCD NUMBER A IS <= B */ |
|||
/* USING BCD SUBTRACTION WITH CARRY - SUBTRACTS B FROM A DISCARDING */ |
|||
/* THE RESULT ABD RETURNING THE CARRY FLAG */ |
|||
DEC$LE: PROCEDURE( A$PTR, B$PTR )BYTE; |
|||
DECLARE ( A$PTR, B$PTR,C$PTR ) ADDRESS; |
|||
DECLARE A BASED A$PTR DEC$16, B BASED B$PTR DEC$16, C BASED C$PTR DEC$16; |
|||
DECLARE ( A0, A1, A2, A3, A4, A5, A6, A7 ) BYTE; |
|||
DECLARE ( B0, B1, B2, B3, B4, B5, B6, B7 ) BYTE; |
|||
DECLARE ( CFLAG, I ) BYTE; |
|||
/* SEPARATE THE DIGIT PAIRS */ |
|||
A0 = A( 0 ); A1 = A( 1 ); A2 = A( 2 ); A3 = A( 3 ); |
|||
A4 = A( 4 ); A5 = A( 5 ); A6 = A( 6 ); A7 = A( 7 ); |
|||
B0 = B( 0 ); B1 = B( 1 ); B2 = B( 2 ); B3 = B( 3 ); |
|||
B4 = B( 4 ); B5 = B( 5 ); B6 = B( 6 ); B7 = B( 7 ); |
|||
/* SUBTRACTION A FROM B */ |
|||
CFLAG = DEC( B7 - A7 ); |
|||
CFLAG = DEC( B6 MINUS A6 ); |
|||
CFLAG = DEC( B5 MINUS A5 ); |
|||
CFLAG = DEC( B4 MINUS A4 ); |
|||
CFLAG = DEC( B3 MINUS A3 ); |
|||
CFLAG = DEC( B2 MINUS A2 ); |
|||
CFLAG = DEC( B1 MINUS A1 ); |
|||
CFLAG = DEC( B0 MINUS A0 ); |
|||
CFLAG = CARRY; /* IF THERE'S NO CARRY, B IS > A AND SO A <= B */ |
|||
RETURN CFLAG = 0; |
|||
END DEC$LE; |
|||
/* BCD MULTIPLICATION BY AN UNSIGNED INTEGER VIA ETHIOPIAN MULTIPLICATION */ |
|||
/* MULTIPLIES A BY B, STORES THE RESULT IN A - A MUST HAVE 16 DIGITS */ |
|||
MUL$DEC: PROCEDURE( A$PTR, B ); |
|||
DECLARE A$PTR ADDRESS, B BYTE; |
|||
DECLARE V BYTE, R DEC$16, ACCUMULATOR DEC$16; |
|||
CALL MOV$DEC( .R, A$PTR ); |
|||
V = B; |
|||
CALL INIT$DEC( .ACCUMULATOR ); |
|||
DO WHILE( V > 0 ); |
|||
IF ( V AND 1 ) = 1 THEN DO; |
|||
CALL ADD$DEC( .ACCUMULATOR, .R ); |
|||
END; |
|||
V = SHR( V, 1 ); |
|||
CALL ADD$DEC( .R, .R ); |
|||
END; |
|||
CALL MOV$DEC( A$PTR, .ACCUMULATOR ); |
|||
END MUL$DEC ; |
|||
/* POWERS OF 2 TABLE FOR THE DIVISION ROUTINE */ |
|||
/* 2^54 IS LARGER THAN A 10^16 */ |
|||
DECLARE POWERS$OF$2 ( 54 /* 16 POINTERS TO 16 DIGIT BCD NUMBERS */ |
|||
)ADDRESS; |
|||
DECLARE POWER$DATA ( 864 /* 54 16-DIGIT BCD NUMBERS */ )BYTE; |
|||
DO; |
|||
DECLARE ( P, P$POS ) ADDRESS; |
|||
DO P = 0 TO LAST( POWER$DATA ); POWER$DATA( P ) = 0; END; |
|||
POWER$DATA( DEC$LAST ) = 01H; /* SET LAST DIGIT OF THE 1ST POWER TO 1 */ |
|||
P$POS = 0; |
|||
DO P = 0 TO LAST( POWERS$OF$2 ); |
|||
POWERS$OF$2( P ) = .POWER$DATA( P$POS ); |
|||
P$POS = P$POS + DEC$LEN; |
|||
END; |
|||
DO P = 1 TO LAST( POWERS$OF$2 ); |
|||
CALL MOV$DEC( POWERS$OF$2( P ), POWERS$OF$2( P - 1 ) ); /* NEXT... */ |
|||
CALL ADD$DEC( POWERS$OF$2( P ), POWERS$OF$2( P ) ); /* POWER */ |
|||
END; |
|||
END; |
|||
/* BCD DIVISION BY AN UNSIGNED INTEGER VIA EGYPTIAN DIVISION */ |
|||
/* DIVIDES A BY B, STORES THE RESULT IN A - A MUST HAVE 16 DIGITS */ |
|||
DIV$DEC: PROCEDURE( A$PTR, B ); |
|||
DECLARE A$PTR ADDRESS, B BYTE; |
|||
DECLARE DOUBLINGS ( 54 /* 16 POINTERS TO 16 DIGIT BCD NUMBERS */ |
|||
)ADDRESS; |
|||
DECLARE DOUBLE$DATA ( 864 /* 54 16-DIGIT BCD NUMBERS */ )BYTE; |
|||
DECLARE ( D, D$POS ) ADDRESS; |
|||
DECLARE ACCUMULATOR DEC$16, QUOTIENT DEC$16, ACC$PLUS$$DOUBLING DEC$16; |
|||
DECLARE MORE$DOUBLINGS BYTE; |
|||
/* CONSTRUCT THE DOUBLINGS TABLE - A*1, A*2, A*3, ETC. */ |
|||
CALL SET$DEC( .DOUBLE$DATA, B ); |
|||
DOUBLINGS( 0 ) = .DOUBLE$DATA( 0 ); |
|||
D$POS = 0; /* START OF THE FIRST DOUBLINGS ELEMENT */ |
|||
D = 0; |
|||
MORE$DOUBLINGS = TRUE; |
|||
DO WHILE( MORE$DOUBLINGS ); |
|||
D = D + 1; |
|||
D$POS = D$POS + DEC$LEN; /* POSITION TO THE NEXT ELEMENT */ |
|||
DOUBLINGS( D ) = .DOUBLE$DATA( D$POS ); |
|||
CALL MOV$DEC( DOUBLINGS( D ), DOUBLINGS( D - 1 ) ); |
|||
CALL ADD$DEC( DOUBLINGS( D ), DOUBLINGS( D ) ); |
|||
MORE$DOUBLINGS = DEC$LE( DOUBLINGS( D ), A$PTR ) |
|||
AND D < LAST( DOUBLINGS ); |
|||
END; |
|||
/* CONSTRUCT THE ACCUMULATOR AND QUOTIEMT */ |
|||
CALL INIT$DEC( .ACCUMULATOR ); |
|||
CALL INIT$DEC( .QUOTIENT ); |
|||
D = D + 1; |
|||
DO WHILE( D >= 1 ); |
|||
D = D - 1; |
|||
CALL MOV$DEC( .ACC$PLUS$DOUBLING, .ACCUMULATOR ); |
|||
CALL ADD$DEC( .ACC$PLUS$DOUBLING, DOUBLINGS( D ) ); |
|||
IF DEC$LE( .ACC$PLUS$DOUBLING, A$PTR ) THEN DO; |
|||
CALL MOV$DEC( .ACCUMULATOR, .ACC$PLUS$DOUBLING ); |
|||
CALL ADD$DEC( .QUOTIENT, POWERS$OF$2( D ) ); |
|||
END; |
|||
END; |
|||
CALL MOV$DEC( A$PTR, .QUOTIENT ); |
|||
END DIV$DEC ; |
|||
/* TASK */ |
|||
/* SETS A TO THE RIORDAN NUMBERS 0 .. N - LAST(A) MUST BE N */ |
|||
RIORDAN: PROCEDURE( N, A$PTR ); |
|||
DECLARE ( N, A$PTR ) ADDRESS; |
|||
DECLARE A BASED A$PTR ( 0 )ADDRESS; |
|||
DECLARE I ADDRESS; |
|||
DECLARE R2 DEC$16, R1 DEC$16; |
|||
DECLARE TWO$R1 DEC$16, THREE$R2 DEC$16; |
|||
CALL INIT$DEC( .R2 ); |
|||
CALL INIT$DEC( .R1 ); |
|||
IF N >= 0 THEN DO; |
|||
R2( LAST( R2 ) ) = 01H; /* SET LAST DIGIT OF R2 TO 1, I.E., R2 = 1 */ |
|||
CALL MOV$DEC( A( 0 ), .R2 ); |
|||
IF N >= 1 THEN DO; |
|||
CALL MOV$DEC( A( 1 ), .R1 ); |
|||
DO I = 2 TO N; |
|||
CALL MOV$DEC( .TWO$R1, .R1 ); /* TWO$R1 = R1 ... */ |
|||
CALL ADD$DEC( .TWO$R1, .R1 ); /* * 2 */ |
|||
CALL MOV$DEC( .THREE$R2, .R2 ); /* THREE$R2 = R2 ... */ |
|||
CALL ADD$DEC( .THREE$R2, .R2 ); /* THREE$R2 = R2 ... */ |
|||
CALL ADD$DEC( .THREE$R2, .R2 ); /* THREE$R2 = R2 ... */ |
|||
CALL ADD$DEC( .TWO$R1, .THREE$R2 ); /* TWO$R2 += THREE$R2 */ |
|||
CALL MUL$DEC( .TWO$R1, I - 1 ); /* TWO$R2 *= ( I - 1 ) */ |
|||
CALL DIV$DEC( .TWO$R1, I + 1 ); /* TWO$R1 /= ( I + 1 ) */ |
|||
CALL MOV$DEC( A( I ), .TWO$R1 ); /* A( I ) = TWO$R1 */ |
|||
CALL MOV$DEC( .R2, .R1 ); /* R2 = R1 */ |
|||
CALL MOV$DEC( .R1, A( I ) ); /* R1 = A( I ) */ |
|||
END; |
|||
END; |
|||
END; |
|||
END RIORDAN ; |
|||
/* CONSTRUCT AN ARRAY OF 16 DIGIT BCD NUMBERS */ |
|||
DECLARE R ( 32 )ADDRESS; /* THE ARRAY OF RIORDAN NUMBERS */ |
|||
DECLARE R$DATA ( 256 /* 32 * 8 */ )BYTE; /* THE RIORDAN NUMBER'S DIGITS */ |
|||
DECLARE ( I, D$POS ) ADDRESS; |
|||
D$POS = 0; |
|||
DO I = 0 TO LAST( R ); |
|||
R( I ) = .R$DATA( D$POS ); |
|||
D$POS = D$POS + DEC$LEN; |
|||
END; |
|||
DO I = 0 TO LAST( R$DATA ); R$DATA( I ) = 0; END; |
|||
/* GET AND PRINT THE RIORDAN NUMBERS */ |
|||
CALL RIORDAN( LAST( R ), .R ); |
|||
DO I = 0 TO LAST( R ); |
|||
CALL PR$CHAR( ' ' ); |
|||
CALL PR$DEC( R( I ) ); |
|||
IF ( I + 1 ) MOD 4 = 0 THEN CALL PR$NL; |
|||
END; |
|||
EOF</lang> |
|||
{{out}} |
|||
<pre> |
|||
1 0 1 1 |
|||
3 6 15 36 |
|||
91 232 603 1585 |
|||
4213 11298 30537 83097 |
|||
227475 625992 1730787 4805595 |
|||
13393689 37458330 105089229 295673994 |
|||
834086421 2358641376 6684761125 18985057351 |
|||
54022715451 154000562758 439742222071 1257643249140 |
|||
</pre> |
</pre> |
||