kim@amdahl.UUCP (Kim DeVaughn) (01/14/87)
[ "Send lawyers, guns, and money ..." (Really!) ] Phil Burk (of Delta Research) sent me this reply concerning the recent postings about JForth. I'm posting it for him, as he's just learning how to use the WELL to access the net. It's really a shame if the info he has on selling s/w in Italy is true. /kim vvvvvvvvvvvvvvvvvvvvvvvvvvvv from Phil vvvvvvvvvvvvvvvvvvvvvvvvvvvvvv Yes, Delta Research is alive and well. I am responding to a comment that someone had trouble getting JForth for the Amiga. This may be have been due to one of two reasons. The Delta Research marketing effort was hampered in December of a combination of the Holidays and some unfortunate family emergencies. Also, inquiries from Italy have been put on hold. This is because several international distributors have warned us that Italy has no effective copy protection laws. We have heard that pirates can copy software and redistribute it FOR PROFIT and only face a $50 fine. If anyone has information that refutes or confirms this, please, let me know. I am on the WELL!PLBURK. This is very unfortunate for the honest citizens of Italy because many software vendors are reluctant to sell their code there. We are trying to work out some legal and technical protection schemes that would allow us to distribute in Italy. It would probably save us money if we simply did not distribute in Italy, but this would be very unfair to the honest Forth/Amiga fans with whom we sympathize. Perhaps these programmers could impress upon their government the impact this policy has on the software industry in Italy. We apologize for any delays that these two problems have caused anyone. We, of course, would like to see as many people as possible get to use JForth. We are busy negotiating with distributors, and establishing our sales channels. There should be nbo problem, therefore, in getting the release version of JForth when it is ready. In response to Kim's comments: Yes we are planning to have an extensive index in the release version. We are also including a tutorial, trouble-shooting tips, etc. Our primary focus now is on improving the manual. We are also adding support for MIDI (the Musical Instruments Device Interface), local sound, and TURNKEY. The final release date is planned for late February. The pre-release version is available now, however, from Delta Research. Free updates will be sent out to those who have this preliminary version. See our ad in Amiga World for details. Phil Burk, Delta Research ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -- UUCP: {sun,decwrl,hplabs,pyramid,ihnp4,seismo,oliveb,cbosgd}!amdahl!kim DDD: 408-746-8462 USPS: Amdahl Corp. M/S 249, 1250 E. Arques Av, Sunnyvale, CA 94086 CIS: 76535,25 [ Any thoughts or opinions which may or may not have been expressed ] [ herein are my own. They are not necessarily those of my employer. ]
cheung@vu-vlsi.UUCP (Wilson Cheung) (01/11/88)
Its been about a year since the last release of JFORTH. Has all work on JFORTH been stopped? I am very eagerly awaiting for a useable floating point package and the optimizing compiler. My version of JFORTH only supports about 4 decimal places of accuracy and often rounds off incorrectly! Wilson Cheung
rap@dana.UUCP (Rob Peck) (01/13/88)
In article <1286@vu-vlsi.UUCP>, cheung@vu-vlsi.UUCP (Wilson Cheung) writes: > > Its been about a year since the last release of JFORTH. Has all work > on JFORTH been stopped? I am very eagerly awaiting for a useable floating > point package and the optimizing compiler. My version of JFORTH only supports > about 4 decimal places of accuracy and often rounds off incorrectly! I spoke to someone (believed to be associated) with JFORTH at the most recent FAUG meeting and he said that their compiler is in beta test --- if I had an application that was just waiting for compilation, I should bring it to their offices and the'd compile it for me. He also mentioned that the floating point was fixed and for a release date, gave me the old "RSN". Rumor has it that the target compiler cuts an application typically by a factor of 4 to 5 times (30+ K rather than 150K for the group of demos on their own distribution disk). Upgrade will not be free, but will be reasonable. When upgrade happens, price of the package is expected to rise to reflect added functionality. Also rumored that Multi-FORTH price may be headed for a price increase in the near future. Disclaimer: I have no connection with the creators of JFORTH; having paid full list price directly to them at the San Francisco Amiga show about a year ago, I too am eagerly awaiting the promised target compiler and upgrade. I like FORTH and collect FORTH docs and books. Someday I might really start to use it again, I will I will (RSN) Rob Peck ...ihnp4!hplabs!dana!rap "Which way did he go George? Why the little bunny rabbit, of course." (from a not-so-recent Warner Bros. Cartoon on Bugs Bunny and Friends)
jyouells@pnet02.cts.com (John Youells) (01/13/88)
cheung@vu-vlsi.UUCP (Wilson Cheung) writes: > > Its been about a year since the last release of JFORTH. Has all work >on JFORTH been stopped? I am very eagerly awaiting for a useable floating >point package and the optimizing compiler. My version of JFORTH only supports >about 4 decimal places of accuracy and often rounds off incorrectly! > > > Wilson Cheung I have talked to Brian at Delta Research a number of times over the past couple of months about the optimizing compiler. I know that they are testing it on some soon to be released commercial products written in JForth. I hope that its available soon, the small executables would make JForth a viable developement environment for the Amiga's multitasking environment. I like JForth but without the optimizing compiler the 'turnkeyed' programs are pretty big. I keep hearing 2 or 3 months for version 2.0... I hope its soon. UUCP: {hplabs!hp-sdd!crash, cadovax}!gryphon!pnet02!jyouells INET: jyouells@pnet02.cts.com
cheung@vu-vlsi.UUCP (Wilson Cheung) (01/18/88)
Everytime I start using JFORTH I always get excited about the features explained in the manual and then become dissappointed that it doesn't work. But now its getting ridiculous! Even the simple things that are explained in the manual don't work. Take for example C,. A primitive important to have in all FORTH standards. It does not exist! I had to go searching through several include files to find out where it was defined. Then I wrote a program that depended upon strings. Again not all string functions are there as documented in the manual. Does anyone know what files I should start including to have a COMPLETE JFORTH. I don't want to waste hours searching through a bunch of files for a word that doesn't exist yet is documented in the glossary. I also don't want a 1 Meg JFORTH program by including everything in sight. Also is there anyway of redirecting all JFORTH screen output to an AmigaDos device? Wilson Cheung
zabot@cesare.dec.com (Adv.Tech.Mgr-ACT Torino) (01/20/88)
Subj: RE: JFORTH Unfortuanately you're right! Jforth promises a lot but delever a lot less! Anyway, here is something that may help you ( hopefully)! > Then I wrote a program that depended upon strings. Again not > all string functions are there as documented in the manual. The following WORDS are NOT implemented in JFORTH 1.2: $. $accum $clr $concat $ len $variable I have create my own STRINGS set with the automatic check of the legth of the receiving field. Comments are in italian, so you may also practice a little your language talent :-) Pleas enote also: the supllied $APPEND doesn't work . It always append a BLANK to the end of the receiveing field, destroing sometime important things. Summary of new WORDS: $. ( addr --- ) print $string $clr ( addr --- ) clear $string ( ll=0 ) $v equivalent of $variable usage: 20 $v name create a variable <name> with a max length of 20 crt. $m ( add-1 add-2 --- ) $move if space available $app ( add-1 add-2 --- ) $append " $array usage: 10 20 $array name create an array <name> of 10 elem ( max length 20) does> i name --> addr-i element ---- cut here ------------------ file: MY-STRINGS -------- anew task-$string : $. count type ; : $clr ( addr-1 --- , pone a zero la lungh. della stringa ) 0 swap c! ; false .if ------------------------------------------------------------------------- Le variabili STRING vengono create con controllo della lunghezza massima. Questo si ottiene premettendo sempre la lunghezza massima nel dizionario. La lunghezza massima assoluta e' 255 ( 8 bits, 1 crt ). Nel dizionario si ha: <cfa> |....| Un carattere Lunghezza-massima |....| Un carattere Lungh. Attuale |xxxxxxxx | Variabile Uso: l-max $v nome ( definizione) nome ( -- addr ) Per avere la Lungh. Max di una variable si usa $l-max ( <nome> --- l-max ) ATTENZIONE ! se la lunghezza al momento della definizione e' maggiore di 255 viene usato il valore modulo 256. I seguenti comandi effettuano la verifica sulla lunghezza del campo di arrivo. In caso di errore avviene solo la stampa di un messaggio e la operazione non ha luogo. ------------------------------------------------------------------------- .then : $v ( n --- ) ( <name> --in-- ) create dup 256 * here w! 2 + allot align does> 1+ ; : $l-max ( addr-var -- l-max ) \ Estrae la lungh. massima della variabile per controlli vari. 1- c@ ; \ WARNING !! La $append standard non funziona. Aggiunge un BLANK al fondo. \ Include? { ju:locals : $append { add-s ll add-1 } add-1 dup c@ ll + swap c! add-s add-1 c@ add-1 + ll - 1+ ll cmove ; FALSE .if \ Mettere TRUE se si vuole la versione senza variabili locali : $m ( addr-1 addr-2 --- ) \ Esegue la $move solo se c'e spazio. In caso contrario stampa \ un messaggio di errore. ( a1 a2 ) ddup ( a1 a2 a1 a2 ) $l-max ( a1 a2 a1 lm ) swap count swap drop ( a1 a2 lm c1 ) - 0< if ." Errore. Non ci sta' !" ddrop else $move then ; : $app ( addr-1 addr-2 --- ) \ Esegue la $append solo se c'e spazio. In caso contrario stampa \ un messaggio di errore. ( a1 a2 ) ddup ( a1 a2 a1 a2 ) dup $l-max ( a1 a2 a1 a2 lm ) swap count swap drop ( a1 a2 a1 lm c2 ) - swap count swap drop ( a1 a2 lm-c2 c1 ) - 0< if ." Errore. Non ci sta' !" ddrop else ( a1 a2 ) swap count ( a2 a1+1 c1 ) rot $append then ; .else \ Versione con Variabili locali. Un po' piu' di memoria ma occorrono 2.4ms in \ meno ad ogni call. : $m { addr-1 addr-2 --- } \ Esegue la $move solo se c'e spazio. In caso contrario stampa \ un messaggio di errore. addr-2 $l-max addr-1 c@ - 0< if ." Errore. Non ci sta' !" else addr-1 addr-2 $move then ; : $app { addr-1 addr-2 --- } \ Esegue la $append solo se c'e spazio. In caso contrario stampa \ un messaggio di errore. addr-2 $l-max addr-2 c@ addr-1 c@ + - 0< if ." Errore. Non ci sta' !" ddrop else addr-1 count addr-2 $append then ; .then False .if -------------------------------------------------------------------------- Matrici di variabili STRINGS. Ancora con controllo di lunghezza. Si definisce una matrice con : n-el-max l-max $array <nome> e si richiama con: n-el <nome> Viene controllato anche che il numero di elemento sia inferiore al massimo ammesso. Il primo elemento e' lo ZERO. Esempio: 10 80 $array riga 0 riga e' la prima riga 9 riga e' l'ultima riga ( 10 in totale) Struttura del dizionario: <cfa> |....| N.max. elem. |....|....| Lungh.max, lungh elem. zero |xxxxxxx| Variabile n. 0 |....|....| Lungh.max, lungh elem uno |xxxxx| Variabile n. 1 -------------------------------------------------------------------------- .then \ Ricordare che $, ( crt --- ) ( <text> --in-- ) mette nel dictionary una \ stringa con la sua lunghezza. : cc, ( crt --- ) \ Mette un crt nel dizionario. here c! 1 allot ; : $$, ( crt n --- ) \ Mette nel dizionario una stringa di 'n' caratteri 'crt' \ ATTENZIONE ! Non fa ALIGN dup cc, 0 do dup cc, loop drop ; : $array ( n-el-max l-max --- ) ( <nome> --in-- ) ( n --- addr ) ( <nome> --in-- ) create swap dup cc, 0 do 0 over $$, 0 cc, loop drop align does> count rot dup 0< if ." Errore indice negativo" ddrop drop else dup rot < if swap count 2 + rot * + else ." Errore Indice > max" ddrop then then ; -------------------end of MY_STRINGS ---------- Another thing I've done has been to create a SHELL like environment for JFORTH. The only thing so far is the HISTORY of commands issued to avoid retyping again and again the same things when prototyping something. The INTERP is a new version of STRING_INTERPRET to handle ( in some way ) at least few errors that may happen in your command line. Once again commands are in Italian. OK. Next time I'll do it in English. ------------------------ cut here ----------------- anew task-$interp : $int2 ; \ excute a string in addr cnt form ... Mike Haas, Delta Research : $INTERPRET ( string-addr string-cnt -- ???? ) 'TIB @ >r #TIB @ >r >IN @ >r FBLK @ >r BLK @ >r #TIB ! 'TIB ! >in off fblk off blk off BEGIN bl word dup c@ \ is there anything in the input stream left? WHILE find \ YES ... is it in the dictionary? IF compiling? over >name immediate? 0= and IF cfa, \ COMPILE it if in comp mode AND its not immediate ELSE execute \ otherwise, EXECUTE the thing! THEN ELSE \ if its not found in dictionary, is it a number? dup number? 0= if ." What's that ??-> " $. ." ?" else drop [compile] literal drop then THEN REPEAT \ while we did find find something, go back and check again... drop \ nothing left to EXECUTE, get rid of address on stack r> blk ! r> fblk ! r> >in ! r> #tib ! r> 'tib ! ; -----------------------next file SHELL anew task-ex .need csi hex : csi ( --- ) ( send csi to st-out ) 9b emit ; decimal .then include? $v mie-strings include? $int2 interp \ $St-mode indica lo stato del ciclo: 0 = adggiungo caratteri al fondo, \ 1 = inserisco caratteri, 2 = overstike. variable $st-mode 0 $st-mode ! ( set to adding ) variable $st-over 0 $st-over ! ( set to insert ) \ $over indica la scelta tra overstrike ( 1) e insert (0) : $over? $st-over @ ; : $ad? $st-mode @ 0= ; : $ins? $st-over @ not ; : $ov? $st-over @ ; : $ad-crt ( add-l add-c crt --- add-l add-c ) \ l = l +1 add-c = add-c +1 \ crt is inserted at the end of the string over c! swap dup dup c@ 1+ swap c! swap 1+ ; : $ins-crt { add-l add-c crt --- add-l add-c } \ l = l +1 add-c = add-c +1 \ crt is inserted \ make space first add-c dup 1+ add-l c@ add-l + add-c - 1+ cmove> \ now insert crt crt add-c c! \ move index add-c 1+ -> add-c \ update length add-l c@ 1+ add-l c! \ reset the stack add-l add-c ; : $ov-crt { add-l add-c crt --- add-l add-c } \ overwrite crt at add-c. If last crt switch $st-mode to add. crt add-c c! add-c add-l dup c@ + = if 0 $st-mode ! then add-c 1+ -> add-c add-l add-c ; : $del-crt { add-l add-c --- add-l add-c } \ delete crt at add-c abd reduce crt count add-c 1- dup 1+ swap add-l c@ add-l + add-c - 1+ cmove add-l c@ 1- add-l c! \ add-c 1- -> add-c add-l add-c ; 10 constant $hist-# 255 constant $line-ll $hist-# $line-ll $array $sh-area 255 $v $sh-line 0 variable $i-sh-store $i-sh-store ! 0 variable $i-sh-fetch $i-sh-fetch ! 80 $v $sh-prompt " F-mz-> " $sh-prompt $m variable end-loop variable end-shell variable re-fetch? : $clr-line ( --- ) csi ." M" csi ." F" csi ." E" $sh-prompt $. drop dup 0 over c! 1+ ; : $if+1 ( --- n , add 1 to i-fetch ) $i-sh-fetch @ 1+ $hist-# mod ; : $if-1 ( --- n , sub 1 to i-fetch ) $i-sh-fetch @ 1- $hist-# + $hist-# mod ; : $is+1 ( --- n , add 1 to i-fetch ) $i-sh-store @ 1+ $hist-# mod ; : $is-1 ( --- n , sub 1 to i-fetch ) $i-sh-store @ 1- $hist-# + $hist-# mod ; : $bottom? ( --- flag , verifica se siamo al bottom dello sh-area stack ) $i-sh-fetch @ $is+1 = ; : $top? ( --- flag , verifica se siamo al top dello sh-area stack ) $i-sh-fetch @ $i-sh-store @ = ; : $re-fetch ( --- add-l add-c ) \ tira fuori una riga ll <> 0 e aggiorna i-fetch e mette a punto \ il resto $clr-line $i-sh-fetch @ $sh-area dup $. $sh-line $m $sh-line dup c@ over + 1+ ; : $sh-get-line ( add --- add ) dup 0 swap c! dup 1+ ( l= 0 ;stack= add-l add-c ) 0 $st-mode ! ( set add to end ) 0 $st-over ! ( set insert mode ) FALSE end-loop ! begin ( ciclo interno = read line ) key case 155 of \ sequenza che inizia con CSI key case 65 of ( freccia su' ) $bottom? not if $if-1 $i-sh-fetch ! then re-fetch? @ not if drop $i-sh-store @ $sh-area $m true re-fetch? ! else ddrop then $re-fetch else 66 of ( freccia giu' ) $top? not if $if+1 $i-sh-fetch ! then re-fetch? @ not if drop $i-sh-store @ $sh-area $m true re-fetch? ! else ddrop then $re-fetch else 67 of ( freccia a destra ) false re-fetch? ! ddup swap - rot dup c@ rot < not >r swap r> if csi ." 1C" 1+ then else 68 of ( freccia a sinistra ) false re-fetch? ! 1- ( add-c = add-c -1 ) 8 emit ( move cursor ) $st-over @ 1 + $st-mode ! else ." Altro" endcase else 27 of ( escape = clr-line ) false re-fetch? ! $clr-line drop dup 0 over c! 1+ else 1 of $st-over @ 1 xor $st-over ! ( switch ins/over mode ) else 8 of false re-fetch? ! swap dup c@ >r swap r> if $del-crt csi ." D" csi ." 1P" then else 13 of TRUE end-loop ! ( set exit ) else 127 of false re-fetch? ! swap dup c@ >r swap r> if $ad? not if 1+ $del-crt csi ." P" then then else false re-fetch? ! $ad? if dup >r $ad-crt r> emit 2 else $ov? if dup >r $ov-crt r> emit 3 then $ins? if dup >r $ins-crt r> csi ." 1@" emit 4 then then endcase end-loop @ ( check exit ) until drop ; : shell False end-shell ! begin ( cliclo esterno = shell ) cr $sh-prompt $. $sh-line begin $sh-get-line dup c@ 0 = not until dup " quit" $= if true end-shell ! else \ Abbiamo una riga valida !! Store it ! \ ... se diversa dalla precedente dup $is-1 $sh-area $= not if dup $i-sh-store @ $sh-area $m \ Ora aggiorniamo l'indice $is+1 dup $i-sh-fetch ! $i-sh-store ! then \ esegue la stringa count $interpret then end-shell @ until drop ; : view-hist cr 10 0 do i i . $sh-area $. cr loop ; --------------------cut here----------------end of all > Take for example C,. A primitive important to have > in all FORTH standards. It does not exist! I had to go searching through > several include files to find out where it was defined. Where is it ? > Also is there anyway of redirecting all JFORTH screen output to an > AmigaDos device? LOGTO ( <filename> -- input ---, send copy to file ) seams to be what you want. I've never tried it. See man. pag. 295. Include JU:LOGTO Hope this help. marco
farren@gethen.UUCP (Michael J. Farren) (02/02/88)
In article <1315@vu-vlsi.UUCP> cheung@vu-vlsi.UUCP (Wilson Cheung) writes: > > Anyone need a better F. word for JFORTH. Well, I have an 'F-word' for FORTH in general, but I doubt you'd want to hear it :-) :-) :-) :-) :-) :-) :-) :-) ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Forth fanatic flame retardants (please!) If you really want to argue about forth, my e-mail box is always open. -- Michael J. Farren | "INVESTIGATE your point of view, don't just {ucbvax, uunet, hoptoad}! | dogmatize it! Reflect on it and re-evaluate unisoft!gethen!farren | it. You may want to change your mind someday." gethen!farren@lll-winken.llnl.gov ----- Tom Reingold, from alt.flame
cheung@vu-vlsi.UUCP (Wilson Cheung) (02/03/88)
Here is an alternate FFP number printint routine. Since it depends upon some string manipulators that don't exist on JFORTH I have included some string manipulators. ( * Following Code written by Wilson Cheung 1/6/88 * ) ( * If you come up with any cleanups or addons please send them back * ) ( * UUCP: vu-vlsi!cheung * ) ( * I had to include some string utilities because again JFORTH didn't * ) ( * have them !!!! * ) INCLUDE? { JU:LOCALS \ ********************************************************************** \ Additions or modifications to JFORTHs string handlers \ ********************************************************************** : BETWEEN { N X Y ---- X<=N<=Y } N Y <= N X >= AND ; : ISEQUIVALENTO CREATE , DOES> @ ; : <=> ISEQUIVALENTO ; .NEED C, : C, ( byte -- , compile into dictionary ) dp @ c! ( always use an even number of these!! ) 1 dp +! ; .ELSE .THEN \ ********************************************************************** \ String manipulators and definers. Note that a string variable here \ consists of a maxcount byte preceding the normal FORTH string of a \ count byte followed by the string. This format since potentially \ incompatible ,opens up bugs, with external string functions remeding \ this situation is highly desireable ,if LFA should ever emerge this \ shouldn't be any problem. \ ********************************************************************** : STRING CREATE DUP C, 0 C, ALLOT DOES> 1+ ; 64 STRING BUFFER : $VAL ( N ---- STR ) 0 <# #S #> DUP ROT BUFFER 1+ ROT CMOVE BUFFER C! BUFFER ; : .$ ( STR --- ) COUNT TYPE ; : $LEN ( STR --- CURRENTLENTH ) C@ ; : $SIZE ( STR --- MAXIMUMLENGTH ) DUP PAD = IF DROP 64 ELSE 1- C@ THEN ; : $FREESPACE ( STR --- UNUSEDSPACE ) DUP $SIZE SWAP $LEN - ; : $ENDSPACE ( STR --- POSITION OF LAST CHAR ) DUP $LEN + ; : $CLR ( STR --- ) 0 SWAP C! ; : $CONCAT { STR1 STR2 --- STR1+STR2 } STR1 $LEN STR2 $LEN + STR1 $SIZE > IF STR1 $SIZE STR1 STR2 1+ STR1 $ENDSPACE 1+ STR1 $FREESPACE CMOVE C! ELSE STR1 $LEN STR2 $LEN + STR1 STR2 1+ STR1 $ENDSPACE 1+ STR2 $LEN CMOVE C! THEN ( ----------- ) ; DECIMAL VARIABLE EXTRASPACE : $RIGHTALIGN ( STR FieldWidth --- ) { STR FW --- } FW STR $LEN - DUP 0> IF EXTRASPACE ! STR 1+ EXTRASPACE @ STR + 1+ STR $LEN CMOVE> STR 1+ EXTRASPACE @ 32 FILL FW STR C! ELSE DROP THEN ; : VAL ( STR ---- N ) NUMBER ( **** WARNING HAS ITS OWN ERROR TRAPPING **** ) ; ( *** You may be able to do without the above String definitions *** ) ( *** My routines depend upon them *** ) VARIABLE DECEXPONENT VARIABLE BINEXPONENT HEX 80000000 CONSTANT BIT31 DECIMAL : D->S DROP ; : MUL10 ( N --- N*10 ) 10 U* D->S ; : DIV10 ( N --- N/10 ) 0 10 U/ SWAP DROP ; : DOWNGRADE ( CONVERTS BASE 2 WITH POSITIVE EXPONENT TO DECIMAL FLOAT ) { MANTISSA BINEXP --- } BEGIN MANTISSA DIV10 -> MANTISSA 1 DECEXPONENT +! BEGIN MANTISSA U2* -> MANTISSA BINEXP 1 - -> BINEXP MANTISSA BIT31 AND BINEXP 0= OR UNTIL BINEXP 0= UNTIL MANTISSA ; : U16/ U2/ U2/ U2/ U2/ ; : U16* U2* U2* U2* U2* ; : UPGRADE { MANTISSA BINEXP --- } MANTISSA U16/ -> MANTISSA BEGIN MANTISSA MUL10 -> MANTISSA -1 DECEXPONENT +! BEGIN MANTISSA U2/ -> MANTISSA BINEXP 1 + -> BINEXP MANTISSA [ HEX ] F0000000 AND 0= BINEXP 0= OR UNTIL BINEXP 0= UNTIL MANTISSA [ HEX ] F0000000 AND IF MANTISSA DIV10 -> MANTISSA 1 DECEXPONENT +! THEN [ DECIMAL ] MANTISSA U16* ; VARIABLE MANTISSA : CONVERTFFPTOBASE10 ( FFP# --- MANTISSA DECIMALEXPONENT SIGN ) ( var val val ) 0 0 { FFP# SIGN BINEXPONENT --- } FFP# [ HEX ] 00000080 AND -> SIGN FFP# 0000007F AND [ DECIMAL ] 64 - -> BINEXPONENT FFP# [ HEX ] FFFFFF00 AND 0 DECEXPONENT ! BINEXPONENT 0> IF BINEXPONENT DOWNGRADE ELSE BINEXPONENT 0< IF BINEXPONENT UPGRADE THEN THEN U16/ MANTISSA ! MANTISSA SIGN DECEXPONENT @ ; : 268435456/ ( PERFORMS UNSIGNED DIV ) [ HEX ] U16/ U16/ U16/ U16/ U16/ U16/ U16/ F AND ; : FFP# ( mantissavariable ---- newmantissavariable digit ) ( produces first ffp digit leaves mantissa on stack for additional convertion ) dup @ [ HEX ] A * dup [ HEX ] fffffff and swap [ DECIMAL ] 268435456/ swap ROT ! ; : ZEROUT ( var --- ) 0 SWAP ! ; VARIABLE CARRY DECIMAL 30 CARRAY NUMBUFFER : ADDBCD ( byte literal --- ) ( Bvar val --- ) { BYT LITERAL --- } BYT C@ LITERAL + DUP 9 > IF [ DECIMAL ] 10 - 1 CARRY ! ELSE CARRY ZEROUT THEN BYT C! ; : MANTISSATO"BCD" ( MANTISSA SIGFIGURES --- ) ( var val ) { MANTISSA SIGFIGURES --- } SIGFIGURES 1+ 0 DO MANTISSA FFP# I NUMBUFFER C! LOOP ( ROUNDOFF ) SIGFIGURES NUMBUFFER 5 ADDBCD SIGFIGURES 1+ 1 DO CARRY @ 0= IF LEAVE ELSE SIGFIGURES I - NUMBUFFER CARRY @ ADDBCD THEN LOOP ; 5 STRING EXPONENTSTRING : CREATEXPONENT ( EXP --- ) EXPONENTSTRING $CLR EXPONENTSTRING " E" $CONCAT DUP 0< IF EXPONENTSTRING " -" $CONCAT NEGATE THEN EXPONENTSTRING SWAP $VAL $CONCAT ; VARIABLE SIGFIG VARIABLE EFFECTIVE_FW : SCIENTIFIC { STR Mantissa sign Exp Fw decpls --- } ( var var val val val val ---- ) [ DECIMAL ] STR $CLR FW STR $SIZE MIN EFFECTIVE_FW ! SIGN 0= NOT IF STR " -" $CONCAT -1 EFFECTIVE_FW +! THEN EXP CREATEXPONENT ( IN EXPONENTSTRING ) EFFECTIVE_FW @ EXPONENTSTRING $LEN - EFFECTIVE_FW ! EFFECTIVE_FW @ DECPLS 1+ MIN SIGFIG ! SIGFIG @ 0> IF MANTISSA SIGFIG @ MANTISSATO"BCD" SIGFIG @ 0 DO 1 I = IF STR " ." $CONCAT THEN STR I NUMBUFFER C@ $VAL $CONCAT LOOP STR EXPONENTSTRING $CONCAT ELSE STR $CLR STR " FORMAT ERROR" $CONCAT THEN ; : FREEFORMAT { STR Mantissa sign Exp Fw decpls --- } ( var var val val val val ---- ) [ DECIMAL ] STR $CLR EXP -1 9 BETWEEN IF FW STR $SIZE MIN EFFECTIVE_FW ! SIGN 0= NOT IF STR " -" $CONCAT -1 EFFECTIVE_FW +! THEN EXP 0= IF STR " 0" $CONCAT -1 EFFECTIVE_FW +! THEN -1 EFFECTIVE_FW +! EFFECTIVE_FW @ EXP DECPLS + MIN SIGFIG ! SIGFIG @ 0> EXP 0 SIGFIG @ BETWEEN AND IF MANTISSA SIGFIG @ MANTISSATO"BCD" SIGFIG @ 0 DO EXP I = IF STR " ." $CONCAT THEN STR I NUMBUFFER C@ $VAL $CONCAT LOOP ELSE STR $CLR STR " FORMAT ERROR" $CONCAT THEN ELSE STR MANTISSA SIGN EXP FW DECPLS SCIENTIFIC THEN ; ( This word takes an FFP number and produces text that meet the criteria ) ( of the Fieldwidth, decimal places and mode and places that text ) ( in the supplied string ) : $FFP { STR FFPNUM FIELDWIDTH DECPLACES MODE --- } MODE 0 1 BETWEEN IF STR FFPNUM CONVERTFFPTOBASE10 FIELDWIDTH DECPLACES MODE CASE 1 OF SCIENTIFIC ENDOF 0 OF FREEFORMAT ENDOF ENDCASE ELSE STR $CLR " INVALID MODE FOR $FFP" $CONCAT THEN ; DECIMAL VARIABLE FW VARIABLE DECPL VARIABLE MODE 0 MODE ! 20 FW ! 6 DECPL ! 80 STRING TEMPSTRING : FFP. { FFPNUMBER --- } TEMPSTRING FFPNUMBER FW @ DECPL @ MODE @ $FFP TEMPSTRING .$ ; ( *** This last word can be used like F. *** ) ( *** full around with the variables FW, DECPL, and MODE *** ) ( *** MODE: 1 Scientific, 0 Freeformat *** ) ( *** FW: FieldWidth, DECPL: Decimal Places *** )