HEX VARIABLE STKLFT 0 STKLFT ! ( 2F441 CONSTANT ATTN 2F443 CONSTANT KBDBUF ) DECIMAL 19 STRING DGT$ VARIABLE DPFLG CREATE USREG 80 ALLOT USREG 80 0 FILL DGT$ DROP DUP CONSTANT DGTADR 2- CONSTANT P 4 STRING EXP$ EXP$ DROP CONSTANT EXPADR : CLX RDN 0. ; : CLRDGT$ DGTADR 19 BL FILL ; : KD DGT$ S! " KEYDOWN"BASICI IF DGT$ TYPE 15 BEGIN 1- " KEYDOWN"BASICI OVER OVER = IF - DUP CR ." NULL" BEGIN " KEYDOWN"BASICI 0= UNTIL THEN 0= UNTIL ELSE 1 THEN CR ; : EXE KD IF P FIND DROP EXECUTE THEN 0 ; : PRMT TYPE 27 EMIT ." >_" 27 EMIT ." <" 0 BEGIN DROP KEY 48 - DUP 0< NOT OVER 10 < AND UNTIL DUP 48 + 8 EMIT EMIT " " KD ; : ENTDGT 1 P +! P C@ 2* DGTADR + C! ; : NUMSGN DGTADR + DUP C@ BL = IF 45 ELSE BL THEN SWAP C! ; : TOGSGN P C@ DUP IF 15 < IF 0 ELSE 30 THEN NUMSGN 0= ELSE DROP THEN ; : EEX P C@ DUP 0= IF 49 [ DGTADR 2+ ] LITERAL C! THEN 15 < IF 15 P C! THEN 0= ; : DPT DPFLG @ 0= P C@ 15 < AND IF 1 DPFLG ! ENTDGT ELSE DROP THEN 0 ; : NUM P C@ DUP DUP 12 DPFLG @ + < SWAP 14 > ROT 18 < AND OR IF ENTDGT ELSE DROP THEN 0 ; : FMTOUT CLRDGT$ FSTR$ DGT$ S! DGTADR C@ 47 > IF BL CHR$ DGT$ S>& 2DROP THEN " E" DGT$ POS ?DUP IF DUP DGT$ ROT 1+ DUP 4 + SUB$ EXP$ S! 1- 2* DGTADR + 5 BL FILL EXP$ SWAP C@ 45 = IF 45 [ DGTADR 30 + ] LITERAL C! 1- THEN [ DGTADR BL + ] LITERAL 3 48 FILL >R EXP$ R@ - 2* + [ DGTADR 38 + ] LITERAL R@ 2* - R> CMOVE> THEN DGTADR 19 TYPE ; : BACKAR P C@ ?DUP IF DGT$ 2* + DUP C@ 46 = IF 0 DPFLG ! THEN BL SWAP C! 1- DUP P C! DUP 14 = IF " " DGT$ >R 2+ R> POS 1- P C! DROP ELSE 0= IF STKLFT @ IF RDN ELSE 1 STKLFT ! THEN 0. CR FMTOUT 0 P C! CLRDGT$ THEN THEN 0= THEN ; : DGTENT FMTOUT 0 DPFLG ! 0 P C! CLRDGT$ 0 BEGIN DROP P C@ IF DGT$ 1+ CR TYPE ." _" THEN BEGIN ?TERMINAL UNTIL [ KBDBUF 1+ ] LITERAL C@ KEY DUP 61 = IF EEX ELSE DUP 80 = IF TOGSGN ELSE DUP 46 = IF DPT ELSE DUP DUP 47 > SWAP 58 < AND IF NUM ELSE DUP 8 = IF BACKAR THEN THEN THEN THEN THEN UNTIL P C@ ?DUP IF 1+ P C! THEN ; : REFMT P C@ 15 > IF EXPADR 4 BL FILL DGT$ 16 19 SUB$ EXP$ S! " " DGT$ >R 2+ R> POS 2* DGTADR + 69 OVER C! EXPADR C@ BL = IF 43 EXPADR C! THEN [ DGTADR 30 + ] LITERAL 4 BL FILL EXPADR SWAP 2+ 4 CMOVE THEN DGT$ " VAL(FORTH$)"BASICF ; : $RPN 1 ATTN N! 0 STKLFT ! BEGIN DGTENT CR P C@ IF STKLFT @ IF RDN 0 STKLFT ! THEN REFMT THEN CASE 38 OF " ENTER^" KD IF FENTER 1 ELSE 0 THEN ENDOF 56 OF " +" KD IF F+ THEN 0 ENDOF 42 OF " -" KD IF F- THEN 0 ENDOF 28 OF " *" KD IF F* THEN 0 ENDOF 14 OF " /" KD IF F/ THEN 0 ENDOF 31 OF " RDN" EXE ENDOF 51 OF " RDN" EXE ENDOF BL OF " X<>Y" EXE ENDOF 33 OF " CLX" KD IF CLX 1 ELSE 0 THEN ENDOF 47 OF " CLX" KD IF CLX 1 ELSE 0 THEN ENDOF 50 OF " R^" KD IF RUP THEN 0 ENDOF 143 OF " R^" KD IF RUP THEN 0 ENDOF 150 OF " LASTX" EXE ENDOF 10 OF " CHS" EXE ENDOF 17 OF " SIN" EXE ENDOF 18 OF " COS" EXE ENDOF 19 OF " TAN" EXE ENDOF 129 OF " ASIN" EXE ENDOF 130 OF " ACOS" EXE ENDOF 131 OF " ATAN" EXE ENDOF 122 OF " PI" KD IF STKLFT @ IF RDN THEN " PI"BASICF THEN 0 ENDOF 1 OF " SQRT" EXE ENDOF 113 OF " X^2" EXE ENDOF 2 OF " E^X" EXE ENDOF 114 OF " LN" EXE ENDOF 3 OF " 10^X" EXE ENDOF 115 OF " LOG" KD IF LGT THEN 0 ENDOF 4 OF " Y^X" EXE ENDOF 5 OF " 1/X" EXE ENDOF 49 OF " STO " PRMT IF 16 * USREG + STO ELSE DROP THEN 0 ENDOF 46 OF " RCL " PRMT IF 16 * USREG + RCL ELSE DROP THEN 0 ENDOF 123 OF " DEG" KD IF DEGREES THEN 0 ENDOF 124 OF " RAD" KD IF RADIANS THEN 0 ENDOF 67 OF " FIX " PRMT IF FIX ELSE DROP THEN 0 ENDOF 68 OF " SCI " PRMT IF SCI ELSE DROP THEN 0 ENDOF 69 OF " ENG " PRMT IF ENG ELSE DROP THEN 0 ENDOF 125 OF " STD" EXE ENDOF 43 OF 0 ONERR ! ." EXIT" CR 0 ATTN N! ABORT ENDOF 0 STKLFT @ SWAP ENDCASE STKLFT ! 0 UNTIL ; : TRAP " ERRM$"BASIC$ TYPE CR $RPN ; : RPN ['] TRAP ONERR ! $RPN ;