: PIATAN ;
( Start: 22:44:47 )
( Print: 23:05:24 )
( End: 23:09:43 )
( Total Time: 00:24:56 )
71 4 / CONSTANT MAXL
1000 CONSTANT N
( M = N / LOG10 2^16 + 1 + 2 )
210 CONSTANT M
( S = SIZE OF INT )
2 CONSTANT S
M S * CONSTANT E
VARIABLE A E S - ALLOT
VARIABLE B E S - ALLOT
VARIABLE XX E S - ALLOT
VARIABLE YY E S - ALLOT
VARIABLE D
VARIABLE F
VARIABLE FF
VARIABLE G
VARIABLE H
: 1D. <# # #> TYPE ;
: 04D. <# # # # # #> TYPE ;
: MPSET OVER ! DUP E + SWAP S + DO 0 I ! S +LOOP ;
: MPCOPY 2DUP - SWAP DUP E + SWAP DO I @ OVER I + ! S +LOOP 2DROP ;
: UD+ ROT + ROT ROT + ;
: UM/MOD U/MOD ;
: UM* U* ;
: MPDIV
D ! DUP DUP
M 0 DO DUP @ 0= IF S + ELSE LEAVE THEN LOOP
DUP E - ROT = IF DROP 0 ELSE
0 SWAP ROT E + SWAP DO I @ SWAP D @ UM/MOD I ! S +LOOP
DROP 1
THEN
;
: MPMULT
D ! DUP DUP E + S - M 0 DO DUP @ 0= IF S - ELSE LEAVE THEN LOOP > IF DROP ELSE
0 SWAP DUP E + S - DO I @ D @ UM* ROT 0 D+ SWAP I ! S NEGATE +LOOP DROP THEN
;
: MPSUB
2DUP - D !
0 SWAP DUP E + S - DO I D @ + DUP H ! @ 0 I @ 0 D- ROT 0 UD+ H @ !
S NEGATE +LOOP
2DROP
;
: MPADD
2DUP - D !
0 SWAP DUP E + S - DO I D @ + DUP H ! @ 0 I @ 0 D+ ROT 0 D+ SWAP H @ !
S NEGATE +LOOP
2DROP
;
: MPATAN
F ! G ! 1 FF ! XX 1 MPSET XX F @ MPDIV DROP G @ XX MPCOPY
F @ 128 < IF F @ DUP * F ! 0 FF ! THEN
1 BEGIN
2 + XX F @ MPDIV DROP
FF @ 1 = IF XX F @ MPDIV DROP THEN
YY XX MPCOPY DUP YY SWAP MPDIV 1 =
WHILE
DUP 2 AND 0 > IF G @ YY MPSUB ELSE G @ YY MPADD THEN
REPEAT
2DROP
;
: MPPRINT
XX SWAP MPCOPY XX @ 0 1D. ." ." CR
N 0 DO
0 XX ! XX 100 MPMULT XX 100 MPMULT XX @ 0 04D.
I 4 / 1 + MAXL MOD 0= IF CR THEN
4 +LOOP
;
: MACHIN
A 5 MPATAN A 16 MPMULT
B 239 MPATAN B 4 MPMULT
A B MPSUB
;
: CLS 24 0 DO 13 EMIT LOOP ;
: DOIT
MACHIN
CR CR A MPPRINT CR CR
;