SCREEN #18.1 0 \ Zen Math 28AUG84MJT 1 2 ONLY FORTH DEFINITIONS ALSO DECIMAL 3 4 \ 2 LOAD ( portability functions) 5 3 5 THRU ( input/output conversion) 6 \ 6 LOAD ( screens 18.3 thru 18.5 in compressed form) 7 8 ONLY FORTH DEFINITIONS 9 10 11 12 13 14 15 SCREEN #18.2 \ Zen Math - portability functions 28AUG84MJT : NIP SWAP DROP ; : TUCK SWAP OVER ; : S>D DUP 0< ; : 2* DUP + ; : D2* 2DUP D+ ; -1 CONSTANT TRUE : ?DO COMPILE 2DUP COMPILE = [COMPILE] IF COMPILE 2DROP [COMPILE] ELSE [COMPILE] DO ; IMMEDIATE : DO COMPILE TRUE [COMPILE] IF [COMPILE] DO ; IMMEDIATE : LOOP [COMPILE] LOOP [COMPILE] THEN ; IMMEDIATE : LOOP [COMPILE] +LOOP [COMPILE] THEN ; IMMEDIATE SCREEN #18.3 0 \ Zen Math - TRIM 28AUG84MJT 1 : D10* ( d1 Ñ d2) 2 \ multiples d1 by 10 3 D2* 2DUP D2* D2* D+ ; 4 5 : D+- ( udn n Ñ dn) 6 \ applies the sign of n to udn. 7 0< IF DNEGATE THEN ; 8 9 : TRIM ( dn n Ñ f) 10 \ trims a double-number mantissa and an exponent of ten to 11 \ a reasonable float number. 12 >R TUCK DABS 13 BEGIN OVER 0< OVER OR 14 WHILE 0 10 UM/MOD >R 10 UM/MOD MIP R> R> 1+ >R REPEAT 15 ROT D+- DROP R> ; SCREEN #18.4 \ Zen Math - four functions 28AUG84MJT : F+ ROT 2DUP - ( expB-expR) DUP 0< IF NEGATE ROT >R NIP >R SWAP R> ELSE SWAP >R NIP THEN >R S>D R> DUP 0 ?DO >R D10* R> 1- OVER ABS 6553 > IF LEAVE THEN LOOP R> OVER + >R IF ROT DROP ELSE ROT S>D D+ THEN R> TRIM ; : FNEGATE >R NEGATE R> ; : f- FNEGATE F+ ; : F* ROT + >R 2DUP XOR >R ABS SWAP ABS UM* R>D+- R> TRIM ; : F/ OVER 0= ABORT" D/" ROT SWAP - >R 2DUP XOR -R01 ABS DUP 6553 MIN ROT ABS 0 BEGIN 2DUP D10* NIP 3 PICK < WHILE D10* R> 1- >R REPEAT 2SWAP DROP UM/MOD NIP 0 ROT D+ R> TRIM ; SCREEN #18.5 0 \ Zen Math - input and output 28AUG84MJT 1 \ Float numbers must include a decimal point. 2 \ DPL contains the number of digits to the right of the decimal. 3 4 : FLOAT ( n Ñ f) 5 \ converts the last entered number to float format. 6 DPL @ NEGATE TRIM ; 7 8 : F. ( f Ñ) 9 \ prints f in fixed format. 10 >R DUP ABS 0 11 <# R@ 0 MAX 0 ?DO ASCII 0 HOLD LOOP 12 R@ 0< 13 IF R@ NEGATE 0 MAX 0 ?DO # LOOP ASCII . HOLD 14 THEN R> DROP #S ROT SIGN 15 #> TYPE SPACE ; SCREEN #18.6 \ Very compressed one-screen floating-point 21NOV 84MJT : D10* D2* 2DUP D2* D2* D+ ; : D+- 0< IF DNEGATE THEN ; : TRIM >R TUCK DABS BEGIN OVER 0< OVER OR WHILE 0 10 UM/MOD >R 10 UM/MOD NIP R> R> 1+ >R REPEAT ROT D+- DROP R> ; : F+ ROT 2DUP - DUP 0< IF NEGATE ROT >R NIP >R SWAP R> ELSE SWAP >R NIP THEN >R S>D R> DUP 0 ?DO >R D10* R> 1- OVER ABS 6553 > IF LEAVE THEN LOOP R> OVER + >R IF ROT DROP ELSE ROT S>D D+ THEN R> TRIM ; : FNEGATE >R NEGATE R> ; : F- FNEGATE F+ ; : F* ROT + >R 2DUP XOR >R ABS SWAP ABS UM* R> D+- R> TRIM ; : F/ OVER 0= ABORT" 0/" ROT SWAP - >R 2DUP XOR -ROT ABS DUP 6553 MIN ROT ABS 0 BEGIN 2DUP D10* NIP 3 PICK < WHILE D10* R> 1- >R REPEAT 2SWAP DROP UM/MOD NIP 0 ROT D+- R> TRIM ; : FLOAT DPL @ NEGATE TRIM ; : F. >R DUP ABS 0 <# R@ 0 MAX 0 ?DO ASCII 0 HOLD LOOP R@ 0< IF R@ NEGATE 0 MAX 0 ?DO # LOOP