H2HMS.TXT -- source code underlying the HP48 ->HMS function. Following the jumps is left as an exercise for the student. POP1%% pops a %% into A and B. All other jumps are resolved below. ***************************************************************** ASSEMBLE CON(1) (nonALG)+0*(hasHELP)+0*(hasALIAS)+0*(hasPDATA) RPL sNAME x>HMS \8DHMS ( "HMS" ) :: CK1&Dispatch ONE ( % ) %>HMS ; ***************************************************************** NAMELESS %>HMS :: %>%% %%H>HMS %%>% ; ***************************************************************** STITLE %%H>HMS ***************************************************************** ***************************************************************** ** ** Name: %%H>HMS ** ** Abstract: Converts decimal hours to h/m/s ** ** Stack: %% --> %%' ** ** Exceptions: none ** ** Author: Laurence Grodd (from Bill Wickes code) ** Date Written: 6/19/85 ** Changed to use hours: 12-21-88 GKG ** ***************************************************************** ***************************************************************** =%%H>HMS CON(5) (*)+5 GOSUB pop1%% sets decmode GOSUBL =aH>HMS GOTO END%% ***************************************************************** =aH>HMS GOSUB docovered CON(5) =cH>HMS H>HMS ***************************************************************** pop1%% GOVLNG =POP1%% [A,B]:X; Dec Mode. ***************************************************************** cleanup GOVLNG =CLEANUP Handle DVZ, IVL Math Exceptions ***************************************************************** =END%% GOSUB cleanup Handle DVZ,IVL exceptions push%%L GOVLNG =PUSH%%LOOP Push Extended Prec. Result STITLE H>HMS ***************************************************************** ***************************************************************** ** Name: H>HMS - Convert Decimal Hours to the H.MMSSSSS... format ** ** Category: MTHUTL ** ** Abstract: Performs indicated conversion. ** ** Entry: [A,B]:h (Decimal Hours); DEC Mode. ** ** Exit: [A,B]: H.MMSSSS..... (Hours.Minutes-Seconds format) ** ** Alters: A,B,C; P; CARRY ** ** Calls: =INFR15(1), HMSMP(0) ** ** Stack Levels: 2 ** ** CAVEAT: This algorithm does much of its work "in place" as ** opposed to the routine in REV:A code which it replaces. ** Substantially faster & less ROM than REV:A code, but ** sacrifices small amount of accuracy in final result due to ** intermediate rounding. The intermediate rounding fixes a ** minor rounding defect in REV:A Code. ** ** REV:A EXAMPLE: ** x=1.49999999999 --> y=hms(x)=RND(1.29599999999640) = 1.296 ** ** Date Prog Modification ** -------- ---- ------------------------------------------ ** 01/08/88 SB ReWrote REV:A routine (See Above Comments) ** 02/08/88 SB HMSMP Rounds smarter (minor improvement). ** 12/22/88 GG Copied from MENTOR ** 01/12/89 SB Added XM=SB=0 **=============================================================== =cH>HMS NIBHEX 823 XM=SB=0 P= 14 ?B=0 P Zero? RTNYES Yes A=A+1 A A=A+1 A GOSBVL =INFR15 Locate Dec Pt of X*100 ?P= 15 Large? (|X|>1E11, X=NaN or X=Inf ?) GOYES HMS200 Yes. * Attempt move pointer left 2 places (to Decimal Pt of X) P=P+1 ?P# 15 |X| >= 0.01 ? GOYES HMS150 Yes. * |X|<0.01 -- Do multiplies at P=15, then at P=14. GOSUB HMSMP Frac'l Hrs to minutes (|X|<0.01) GOTO HMS160 HMS150 P=P+1 GOSUB HMSMP Frac'l Hrs to minutes (|X|>=0.01) P=P-1 HMS160 P=P-1 GOSUB HMSMP Frac'l minutes to seconds HMS200 A=A-1 A A=A-1 A Restore correct exponent. GOVLNG =MPY150 Normalize. [A,B]:h.mmss.. ***************************************************************** EJECT ***************************************************************** * HMSMP - Multiply mantissa Word-Thru-Pointer by 0.6, rounding * * the result according to the last 3-digits. A useful * * utility for quick conversions from hours to h.ms * * format. The rounding is not essential, but avoids * * undesirable rounding effects associated with packing * * the final h.ms result into a 12-digit destination. * * S.B. 1/8/88 * * Entry: B:Mantissa, B[WP]:x, DEC Mode. * * Exit : B[WP]: 0.6x * ***************************************************************** HMSMP C=B WP CSR WP 0.1*x C=C+C WP 0.2*x C=C+C WP 0.4*x B=B-C WP 0.6*x * Now round in B[X] (or B[B] if unnormalized) C=0 W C=B X BSL W ?B=0 S Clear CARRY iff Normalized GOYES hmsmp10 hmsmp10 BSR W GONC hmsmp20 C=0 XS B=B+C W B=0 B RTN hmsmp20 B=B+C W B=0 X RTN ***************************************************************** STITLE INFR15 ***************************************************************** ***************************************************************** ** Name:(S) INFR15 - Integer/Fraction Split ** ** Category: MTHUTL ** ** Purpose: Find decimal (used by INT15 & FRAC15). Returns ** position of decimal encoded in P (see below). ** ** Entry: [A,B]: X ** ** Exit: P: Encoded location of decimal in X. ** ** Alters: C[A],P,CARRY, Sets DEC. ** ** Stack Levels: 0 ** ** Note: Let EXP(X)=E; Table below defines output (P): ** ** X P ** ---------- ----- ** 0<=E<=13 13-E ** Standard 0 13 (standard 0 has E=0) ** E<0 14 ** NaN,Inf,or E>13 15 ** ** ** Note: If the E=14 (i.e. a 15 digit integer) then C(A)=0. ** If E>14 (but finite), C(A)=50000 on exit. ** This is used in YX15 to determine if x is an even ** integer. ** ** ** Date Prog Modification ** -------- ---- ------------------------------------------ ** 09/17/85 SB Add finite entry =INFRF to HP71B routine. ** Removed =DECP=C entry. ** 03/22/88 SB Reduced Stk Levels (for Y^X) ** 08/12/88 SB Extend to correctly handle dirty zeros. ***************************************************************** ***************************************************************** =INFR15 SETHEX A=A+1 XS A=A-1 XS SETDEC Carry Clear <==> Finite Argument GOC BIG15 =INFRF SETDEC P= 14 ?B#0 P Mantissa Zero? GOYES inf10 No. A=0 A Yes - Clear Exponent. inf10 P= 0 C=0 A LCHEX 13 C(A)=00013 C=C-A A GOC BIGSML If EXP<0 or EXP>13, Go BIGSML P= 1 ?C=0 P GOYES PICKUP If EXP<10, Go PICKUP P= 9 Else create Pickup value (HEX) C+P+1 by adding 10 to C[0]. PICKUP P=C 0 RTN BIGSML C=C+1 A GOC BIG15 expon = 14 (rtn with C(A)=0) LCHEX 50000 else C(A)=50000. P= 14 ?A>=C A RTNYES BIG15 P= 15 RTN ***************************************************************** =MPY150 ?B=0 S Carry into B[S] ? GOYES shf10 No. A=A+1 A Incr Exponent BSR W Shift Mantissa shf10 GOLONG =SHF10 ***************************************************************** STITLE SHF10 ***************************************************************** ***************************************************************** ** ** Name:(S) SHF10 - Shift to normalize ** ** Category: MTHUTL ** ** Purpose: Normalized extended P 15 form in AB. ** ** Entry: [A,B]:x Finite (possibly denormalized no.) ** ** Exit: [A,B]:x normalized (clean 0s). ** P restored from C[S], ** C[S] restored from B[S], ** B[S]:0, CC. ** ** Calls: None ** ** Alters: A[A],B,C[S]; P, CARRY ** ** Stack Levels: 0 ** ** Date Prog Modification ** -------- ---- ------------------------------------------ ** 03/24/87 SB Improved Documentation. **=============================================================== * Normalize result -- N.B. P:=C(S), C(S):=B(S) on exit. This * is for SPLITA (to save P) =SHF10 P= 14 ?B=0 WP MANTISSA ZERO? GOYES SHF30 YES SHF20 ?B#0 P NORMALIZED? GOYES SHF40 A=A-1 A DEC EXP BSL WP LEFT SHIFT MANTISSA GOTO SHF20 SHF30 A=0 A Clean Zero (Exponent=0) SHF40 P= 0 CPEX 15 Restore P, Clear C[S]. BCEX S Restore C[S], Clear B[S]. RTNCC *****************************************************************