Metropoli BBS
VIEWER: hailpath.rpl MODE: TEXT (ASCII)
HailPath
By Joseph K. Horn

Returns the Syracuse Algorithm "hailstone path distance" between X and 1.

D9D20	@ :: (Begin RPL)	; 02D9D Program object prolog (backwards!)
E1632	@ \<<			; 2361E Open program delimiters.
B9691	@ R->B			; 1969B Hex for double precision.
CCD20	@   In-line code	; 02DCC Code object prolog.
F6000	@     Code length = 111	; 0006F (Nib count includes itself.)
AF9	@     C=B W		; Save B
10A	@     R2=C		;   in R2,
137	@     CD1EX		;   and save D1 (user stack pointer)
109	@     R1=C		;   in R1.
137	@     CD1EX		; Get address
147	@     C=DAT1 A		;   of level 1, and
137	@     CD1EX		;   point to it.
179	@     D1=D1+ 10		; Skip over object header to the contents.
1537	@     A=DAT1 W		; Get level 1 argument (in hex) into A.
822	@     SB=0		; Clear Sticky Bit, used for even/odd test.
AF1	@     B=0 W		; Clear the Loop Counter (B).
AF3	@     D=0 W		; The exit test needs a 1; make D=1 by
B67	@     D=D+1 B		;   clearing D and adding 1 to it.
AF6	@ L1  C=A W		; A,C hold the hailstone number en route to 1.
9FB	@     ?C<=D W		; Has the hailstone hit ground yet? (is C<=1?) 
F1	@     GOYES L3		;   If so, exit; else,
B75	@ L2  B=B+1 W		;   increment the Loop Counter.
81C	@     ASRB		; A=IP(A/2), and lost bit -> Sticky Bit.
832	@     ?SB=0		; Was the hailstone number even?
FE	@     GOYES L1		;   If so, simply repeat; else,
A72	@     C=C+A W		; Multiply by 3, add 1, and divide by 2,
B76	@     C=C+1 W		;   using shortcut A+IP(A/2)+1.
B75	@     B=B+1 W		; Increment Loop Counter again due to shortcut.
AFA	@     A=C W     	; Get ready for
822	@     SB=0		;   the next test, and
55E	@     GONC L2		;   go try again (Branch Every Time).
AF9	@ L3  C=B W		; Replace level 1 argument
1557	@     DAT1=C W		;   with Loop Counter = HAILPATH(x).
119	@     C=R1		; Restore User Stack Pointer (D1)
137	@     CD1EX		;   from R1,
11A	@     C=R2		;   and restore B
AF5	@     B=C W		;   from R2.
142	@     A=DAT0 A		; End       \
164	@     D0=D0+ 5		;   of       > Code always ends like this.
808C	@     PC=(A)		;     Code. /
BB691	@   B->R		; 196BB Back to normal (decimal).
93632	@ \>>			; 23639
B2130	@ ; (End of RPL.)	; 0312B

[ RETURN TO DIRECTORY ]