Power-Programmierung/CD1.mdf/forth/compiler/zen/stackmem.src

Text File | 1990-01-11 | 5KB | 249 lines

\*
 *   ZEN 1.10  Stack and Memory operators
 *     C 1990  by Martin Tracy
 *             Last modified  1.1.90
 *\

\ Duplicate top stack item
CODE DUP ( w - w w) \ CORE
        push  bx
        NEXT
END-CODE

\ Drop top stack item
CODE DROP ( w) \ CORE
        pop   bx
        NEXT
END-CODE

\ Swap top two stack items
CODE SWAP ( w w2 - w2 w) \ CORE
        mov   di,sp
        xchg  bx,ss:[di]
        NEXT
END-CODE

\ Copy second stack item to top of stack
CODE OVER ( w w2 - w w2 w) \ CORE
        mov   di,sp
        push  bx
        mov   bx,ss:[di]
        NEXT
END-CODE

\ Rotate third stack item into top position
CODE ROT ( w w2 w3 - w2 w3 w) \ CORE
        pop   dx
        pop   ax
        push  dx
        push  bx
        mov   bx,ax
        NEXT
END-CODE

\ Copy kth item to top of stack
CODE PICK ( w[u]... w[0] u -  w[u]... w[0] w[u]) \ EXT CORE
        shl   bx,1
        add   bx,sp
        mov   bx,ss:[bx]
        NEXT
END-CODE

\ Drop second stack item
CODE NIP ( w w2 - w2) \ EXT CORE
        pop   ax
        NEXT
END-CODE

\ Copy top stack item under second item
CODE TUCK ( w w2 - w2 w w2) \ EXT CORE
        pop   ax
        push  bx
        push  ax
        NEXT
END-CODE

\ Duplicate w if it is non-zero
CODE ?DUP ( w - w w | 0 - 0) \ CORE
        or    bx,bx
        jz    Qd1
        push  bx
Qd1:    NEXT
END-CODE

\ Move top stack item to return stack
CODE >R ( w; R: - w) \ CORE
        xchg  bp,sp
        push  bx
        xchg  bp,sp
        pop   bx
        NEXT
END-CODE

\ Copy top return stack item to data stack
CODE R@ ( - w; R: w - w) \ CORE
        push  bx
        mov   bx,[bp]
        NEXT
END-CODE

\ Move top return stack item to data stack
CODE R> ( - w; R: w) \ CORE
        push  bx
        xchg  bp,sp
        pop   bx
        xchg  bp,sp
        NEXT
END-CODE

\ Copy the current (innermost) loop index
CODE I  ( - n) \ CORE
        push  bx
        mov   bx,[bp]
        add   bx,[bp+2]
        NEXT
END-CODE

\ Copy the next outermost loop index
CODE J  ( - n) \ CORE
        push  bx
        mov   bx,[bp+4]
        add   bx,[bp+6]
        NEXT
END-CODE

\ Move top stack pair to return stack
CODE 2>R ( w w2; R: - w w2) \ CORE
        pop   ax
        xchg  bp,sp
        push  ax
        push  bx
        xchg  bp,sp
        pop   bx
        NEXT
END-CODE

\ Move top return stack pair to data stack
CODE 2R> ( - w w2; R: w w2) \ CORE
        push  bx
        xchg  bp,sp
        pop   bx
        pop   ax
        xchg  bp,sp
        push  ax
        NEXT
END-CODE

\ Duplicate top stack pair
CODE 2DUP ( w w2 - w w2 w w2) \ CORE
        mov   di,sp
        push  bx
        push  ss:[di]
        NEXT
END-CODE

\ Drop top stack pair
CODE 2DROP ( w w2) \ CORE
        pop   bx
        pop   bx
        NEXT
END-CODE

\ Swap top two stack pairs
CODE 2SWAP ( w w2 w3 w4 - w3 w4 w w2) \ CORE
        pop   ax
        pop   cx
        pop   dx
        push  ax
        push  bx
        push  dx
        mov   bx,cx
        NEXT
END-CODE

\ Copy second stack pair to top of stack
CODE 2OVER ( w w2 w3 w4 - w w2 w3 w4 w w2) \ CORE
        mov   di,sp
        push  bx
        push  ss:[di+4]
        mov   bx,ss:[di+2]
        NEXT
END-CODE

\*
\ Copy second stack pair to top of stack
: 2OVER ( w w2 w3 w4 - w w2 w3 w4 w w2) \ CORE
   2>R 2DUP 2R> 2SWAP ;
*\

\ Rotate third stack pair into top position
: 2ROT ( w w2 w3 w4 w5 w6 - w3 w4 w5 w6 w w2) \ EXT DOUBLE
   2>R 2SWAP 2R> 2SWAP ;

\ Fetch value at addr
CODE @  ( addr - w) \ CORE
        mov   bx,[bx]
        NEXT
END-CODE

\ Store w at addr
CODE !  ( w addr) \ CORE
        pop   [bx]
        pop   bx
        NEXT
END-CODE

\ Fetch byte value at addr
CODE C@ ( addr - b) \ CORE
        mov   bl,[bx]
        sub   bh,bh
        NEXT
END-CODE

\ Store lower byte value at addr
CODE C! ( w addr) \ CORE
        pop   ax
        mov   [bx],al
        pop   bx
        NEXT
END-CODE

\ Fetch pair at addr
\ w2 is stored at addr; w is stored in next cell
CODE 2@ ( addr - w w2) \ CORE
TwoF1:  push  [bx+2]
        mov   bx,[bx]
        NEXT
END-CODE

CODE D@ ( addr - d) \ DOUBLE
        jmp   TwoF1
END-CODE

\ Store pair at addr
\ w2 is stored at addr; w is stored in next cell
CODE 2! ( w w2 addr) \ CORE
TwoS1:  pop   [bx]
        pop   [bx+2]
        pop   bx
        NEXT
END-CODE

CODE D! ( d addr) \ DOUBLE
        jmp   TwoS1
END-CODE


\ Store false at address.
CODE OFF ( addr)
        mov   WORD PTR [bx],0
        pop   bx
        NEXT
END-CODE

\ Store true at address.
CODE ON ( addr)
        mov   WORD PTR [bx],TRUTH
        pop   bx
        NEXT
END-CODE