\*
 *   ZEN 1.10  Arithmetic and Logical operators
 *     C 1990  by Martin Tracy
 *             Last modified  1.1.90
 *\

 0 CONSTANT 0      \ fast zero
 1 CONSTANT 1      \ fast one
-1 CONSTANT TRUE   \ fast Boolean true
 2 CONSTANT CELL   \ address units per cell

\ Add n to n2
CODE +  ( n n2 - n3) \ CORE
        pop   ax
        add   bx,ax
        NEXT
END-CODE

\ Subtract n2 from n
CODE -  ( n n2 - n3) \ CORE
        pop   ax
        sub   bx,ax
        neg   bx
        NEXT
END-CODE

\ Change sign of n
CODE NEGATE ( n - n2) \ CORE
        neg   bx
        NEXT
END-CODE

\ Absolute value of n
CODE ABS ( n - +n) \ CORE
        or    bx,bx
        jns   ABS2
        neg   bx
ABS2:   NEXT
END-CODE

\ Add n to value at addr
CODE +! ( n addr) \ CORE
        pop   ax
        add   [bx],ax
        pop   bx
        NEXT
END-CODE

\ Multiply u by u2
CODE UM* ( u u2 - ud) \ CORE
        pop   ax
        mul   bx
        push  ax
        mov   bx,dx
        NEXT
END-CODE

\ Divide ud by u giving quotient u3 remainder u2
CODE UM/MOD ( ud u - u2 u3) \ CORE
        POP   dx
        SUB   ax,ax
        CMP   dx,bx
        jae   UMO2
        pop   ax
        div   bx
        push  dx
UMO2:   mov   bx,ax
        NEXT
END-CODE

\ Signed mixed-precision multiply
CODE M* ( n n2 - d) \ DOUBLE
        xchg  ax,bx
        pop   dx
        imul  dx
        push  ax
        mov   bx,dx
        NEXT
END-CODE

\ Signed rounded-down mixed-precision divide.
CODE M/MOD ( d n - rem quot) \ EXT CORE
        pop   dx
        pop   ax
        or    bx,bx
        jz    MsM1
        idiv  bx
        mov   bx,ax
        push  dx
        NEXT
MsM1:   mov   dx,ax   ; divide by zero
        mov   bx,0
        push  dx
        NEXT
END-CODE

\ Signed multiply
CODE *  ( n n2 - n3) \ CORE
        pop   ax
        imul  bx
        mov   bx,ax
        NEXT
END-CODE

\*
\ Signed mixed-precision multiply.
: M* ( n n2 - d) \ DOUBLE
   2DUP XOR >R  ABS SWAP ABS UM*  R> 0< IF NEGATE THEN ;

\ Signed rounded-down mixed-precision divide.
: M/MOD ( d n - rem quot) \ EXT CORE
   2DUP XOR >R  OVER >R  ABS >R DABS R> UM/MOD
   SWAP R> 0< IF  NEGATE  THEN
   SWAP R> 0< IF  NEGATE  THEN ;

\ Signed floored mixed-precision divide.
: M/MOD ( d n - rem quot) \ EXT CORE
   DUP >R  2DUP XOR >R  DUP >R  ABS >R DABS R> UM/MOD
   SWAP R> 0< IF  NEGATE  THEN
   SWAP R> 0< IF  NEGATE  OVER IF  R@ ROT -  SWAP 1-  THEN THEN
   R> DROP ;

\ Signed multiply
: * ( n n2 - n3) \ CORE
   UM* DROP ;
*\


\ Signed rounded-down divide leaving quotient and remainder
: /MOD ( n n2 - rem quot)   \ CORE
   >R  DUP 0<  R> M/MOD ;

\ Signed rounded-down divide
: / ( n n2 - quot) \ CORE
   /MOD NIP ;

\ Signed rounded-down remainder
: MOD ( n n2 - rem) \ CORE
   /MOD DROP ;

\ Signed multiply n by n2 then signed divide by n3
\ Division leaves quotient and remainder
\ Intermediate product is 32 bits
: */MOD ( n n2 n3 - rem quot) \ CORE
   >R  M*  R> M/MOD ;

\ Signed multiply n by n2 then signed divide by n3
\ Intermediate product is 32 bits
: */ ( n n2 n3 - quot) \ CORE
   >R  M*  R> M/MOD NIP ;

\ Add one to n
CODE 1+ ( n - n2) \ CORE
        inc   bx
        NEXT
END-CODE

\ Subtract one from n
CODE 1- ( n - n2) \ CORE
        dec   bx
        NEXT
END-CODE

\ Multiply n by two
CODE 2* ( n - n2) \ CORE
        shl   bx,1
        NEXT
END-CODE

\ Shift n right once arithmetically
CODE 2/ ( n - n2) \ CORE
        sar   bx,1
        NEXT
END-CODE


\ Add byte address units to address a.
CODE BYTE+ ( a - a2) \ CORE
        inc   bx
        NEXT
END-CODE

\ Size in address units of n bytes.
CODE BYTES ( n - n2) \ CORE
        NEXT
END-CODE
IMMEDIATE

\ Return next aligned address after address a.
CODE REALIGN ( a - a2) \ CORE
        NEXT
END-CODE
IMMEDIATE

\ Add cell address units to address a.
CODE CELL+ ( a - a2) \ CORE
        inc   bx
        inc   bx
        NEXT
END-CODE

\ Size in address units of n cells.
CODE CELLS ( n - n2) \ CORE
        shl   bx,1
        NEXT
END-CODE

\ Add two double numbers
CODE D+ ( d d2 - d3) \ CORE
        pop   ax
        pop   dx
        pop   cx
        add   cx,ax
        push  cx
        adc   bx,dx
        NEXT
END-CODE

\ Subtract d2 from d1
CODE D- ( d d2 - d3) \ DOUBLE
        mov   dx,bx
        pop   ax
        pop   bx
        pop   cx
        sub   cx,ax
        push  cx
        sbb   bx,dx
        NEXT
END-CODE

\ Change sign of d
CODE DNEGATE ( d - d2) \ DOUBLE
        pop   ax
        neg   ax
        push  ax
        adc   bx,0
        neg   bx
        NEXT
END-CODE

\ Absolute value of d
: DABS ( d - +d) \ DOUBLE
   DUP 0< IF  DNEGATE  THEN ;

\ Extend n to d
CODE S>D ( n - d) \ CORE
        xchg  ax,bx
        cwd
        push  ax
        xchg  bx,dx
        NEXT
END-CODE

\ Truncate d to n
CODE D>S ( d - s) \ CORE
        pop   bx
        NEXT
END-CODE

\ Reverse the bytes within a word.
CODE >< ( u - u2)
        xchg  bl,bh
        NEXT
END-CODE


\ Bitwise AND n and n2
CODE AND ( m m2 - m3) \ CORE
        pop   ax
        and   bx,ax
        NEXT
END-CODE

\ Bitwise OR n and n2
CODE OR ( m m2 - m3) \ CORE
        pop   ax
        or    bx,ax
        NEXT
END-CODE

\ Bitwise XOR n and n2
CODE XOR ( m m2 - m3) \ CORE
        pop   ax
        xor   bx,ax
        NEXT
END-CODE

\ Bitwise NOT of n
CODE INVERT ( w - w2) \ CORE
        not   bx
        NEXT
END-CODE

\ Forth-83 NOT
CODE NOT ( w - w2)
        not   bx
        NEXT
END-CODE

\ True if n equals zero
CODE 0= ( n - f) \ CORE
        or    bx,bx
        mov   bx,TRUTH
        jz    Ze2
        inc   bx
Ze2:    NEXT
END-CODE

\ True if n is less than zero
CODE 0< ( n - f) \ CORE
        or    bx,bx
        mov   bx,TRUTH
        js    zl2
        inc   bx
zl2:    NEXT
END-CODE

\ True if n is greater than zero
: 0> ( n - f) \ CORE
   0 > ;

\ True if n equals n2
CODE =  ( n n2 - f) \ CORE
        pop   ax
        cmp   bx,ax
        mov   bx,TRUTH
        je    Eq2
        inc   bx
Eq2:    NEXT
END-CODE

\ True if n is less than n2
CODE <  ( n n2 - f) \ CORE
        pop   ax
        sub   ax,bx
        mov   bx,TRUTH
        jl    Lt2
        inc   bx
Lt2:    NEXT
END-CODE

\ True if n is greater than n2
: > ( n n2 - f) \ CORE
   SWAP < ;

\ True if u is less than u2
CODE U< ( u u2 - f) \ CORE
        pop   ax
        sub   ax,bx
        mov   bx,TRUTH
        jb    Ult2
        inc   bx
Ult2:   NEXT
END-CODE

\ True if n <= u < n2  given circular comparison.
: WITHIN ( u n n2 - f) \ EXT CORE
   OVER - >R - R> U< ;

\ Maximum of two numbers
: MAX ( n n2 - n3) \ CORE
   2DUP < IF  SWAP  THEN  DROP ;

\ Minimum of two numbers
: MIN ( n n2 - n3) \ CORE
   2DUP < NOT IF  SWAP  THEN  DROP ;

\ True if d is less than d2
: D< ( d d2 - f) \ CORE
   ROT  2DUP = IF  2DROP U<  EXIT THEN
   2SWAP 2DROP  > ;


\ True and preserves arguments if n is greater than n2
\ Used by  ?DO   Equivalent to  2DUP > IF  TRUE EXIT  THEN  > ;
| CODE ?> ( n n2 - n n2 true | 0)
        mov   di,sp
        cmp   bx,ss:[di]
        jl    Qg1
        pop   bx
        mov   bx,0
        NEXT
Qg1:    push  bx
        mov   bx,TRUTH
        NEXT
END-CODE
