\\ ANS Forth Double-number word set                         uho 19Feb95

   $Logfile:   C:/SRC/FPC/FPC-ANS/VCS/DOUBLE.SEV  $
   $Revision: 1.4 $
   $Date: 1999/04/10 13:55:38 $
   $Author: uho $

 /--------------------------------------------------------uh 19Feb95
 | This file contains the definition of an ANS-Forth compatible    |
 | Double-number word set for F-PC. If you do not use F-PC this    |
 | file is useless for you. This is NOT an ANS-Forth program but is|
 | highly F-PC specific. It is a system extension to F-PC in order |
 | to make F-PC supply the ANS-Forth Double-number word set.       |
 |                                                                 |
 | This file is a companion to the F-PC ANS-Forth CORE and CORE EXT|
 | extensions as provided in the file ANSI.SEQ. ANSI.SEQ is needed |
 | to load this file.                                              |
 |                                                                 |
 | To support strict ANS-Forth code, a separate vocabulary ANSI    |
 | DOUBLE is defined. By this the F-PC vocabulary search mechanism |
 | can be used to restrict the visibility of specific word sets.   |
 | To activate the double-number word set include the phrase       |
 | ANSI DOUBLE ALSO in your program.                               |
 |                                                                 |
 | This Code is public domain software.                            |
 |                                                                 |
 | Remarks and comments are welcome.                               |
 |                                                                 |
 |               Ulrich Hoffmann                                   |
 |               Sehestedter Strasse 26                            |
 |               24340 Eckernfoerde                                |
 |               Germany                                           |
 |               +49 431 712 217                                   |
 |               +49 431 712 216  (FAX)                            |
 |               Ulrich.E.Hoffmann@gmx.de                          |
 |                                                                 |
 \-----------------------------------------------------------------/

{

needs ansi.seq

Only Forth also ANSI definitions  warning off

Vocabulary DOUBLE

Only Forth also ANSI DOUBLE definitions also ANSI CORE also

' 2Constant Alias 2CONSTANT ( x1 x2 "<spaces>name" -- )
                            ( "name" execution: -- x1 x2 )

: 2LITERAL ( Compilation: x1 x2 -- ) ( Run-time: -- x1 x2 )
    SWAP  POSTPONE LITERAL  POSTPONE LITERAL ; IMMEDIATE

' 2Variable Alias 2Variable ( "<spaces>name" -- )
                            ( "name" execution: -- a-addr )

' d+  Alias D+ ( d1|ud1 d2|ud2 -- d3|ud3 )
' d-  Alias D- ( d1|ud1 d2|ud2 -- d3|ud3 )
' d.  Alias D. ( d -- )
' d.r Alias D.R ( d n -- )
: D0< ( d -- flag )  nip 0< ;
' d0= Alias D0= ( xd -- flag )
' d2* Alias D2* ( xd1 -- xd2 )
' d2/ Alias D2/ ( xd1 -- xd2 )
' d<  Alias D<  ( xd1 xd2 -- flag )
' drop Alias D>S ( d -- n )
' dabs Alias DABS ( d -- ud )
' dmax Alias DMAX ( d1 d2 -- d3 )
' dmin Alias DMIN ( d1 d2 -- d3 )
' dnegate Alias DNEGATE ( d1 -- d2 )

Forth definitions
: DN* ( d1 n1 -- t1 )  >R
   SWAP  R@ 0< IF  R@ NEGATE  UM* DNEGATE ELSE  R@ UM* THEN \ low
   ROT R> M*                                                \ high
   ROT S>D D+ ;

ANSI DOUBLE definitions

: M*/ ( d1 n1 +n2 -- d2 )  \ note n2 has to be positive!
   >R DN* ROT
   0 R@ UM/MOD SWAP 2SWAP
     R@ FM/MOD ROT ROT
     R> UM/MOD NIP 0 D+ ;

: M+ ( d1|ud1 n -- d2|ud2 )  S>D D+ ;

cr .( ANS Forth Double-Number word set loaded. )

}
------------------------------------------------------------

Revision history:
$Log: double.seq,v $
Revision 1.4  1999/04/10 13:55:38  uho
Update Version Number

Revision 1.3  1999/04/10 11:41:18  uho
Changed Email Address

Revision 1.2  1997/08/28 10:03:08  uho
*** empty log message ***

Revision 1.1  1997/08/28 09:59:12  uho
Initial revision

   
      Rev 1.3   17 Nov 1995  1:21:28
   Clean up for release.
   
   
      Rev 1.2   26 Apr 1995  9:50:00
   Translated ß-text to english
   
   
      Rev 1.1   21 Apr 1995  1:09:14
   M*/
   
      Rev 1.0   22 Feb 1995  0:00:50
   Initial revision.