home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / p4_19jb.seq < prev    next >
Encoding:
Text File  |  1989-02-26  |  2.8 KB  |  80 lines
  1. \ Personal Stacks.
  2. \ ----------------
  3. \ In order to understand Forth's data stack a little better we are going
  4. \ to create our own personal stack.  You see Forth's data stack is little
  5. \ more than an array with a word set for manipulating its elements.
  6.  
  7. \ Create an array to be used for a 10 number stack.
  8.   CREATE  P-STACK  20 ALLOT  \ Stack will hold 10 16bit numbers.
  9.  
  10.   VARIABLE P-INDEX           \ Holds the value of user stack pointer.
  11.  
  12. \ Clear and initialize the Personal user stack.
  13. : P-CLEAR  ( -- D) ( ?? -- P)
  14.            0 P-INDEX ! P-STACK 20 ERASE ;
  15.  
  16. \ Return number of elements on the user stack to Forth's data stack.
  17. : P-DEPTH  ( -- n  D)
  18.            P-INDEX @ 2/ ;
  19.  
  20. \ Increment user stack pointer with error checking.
  21. : P-INC    ( -- D)
  22.            P-INDEX @ 20 =
  23.            IF ." P-OVERFLOW"  P-CLEAR
  24.            ELSE 2 P-INDEX +! THEN ;
  25.  
  26. \ Decrement user stack pointer with error checking.
  27. : P-DEC    ( -- D)
  28.            P-INDEX @ 0=
  29.            IF ." P-UNDERFLOW"
  30.            ELSE -2 P-INDEX +! THEN ;
  31.  
  32. \ Move number from Forth's data stack to the P-stack.
  33. : >P       ( n -- D)  ( -- n P)
  34.            P-INC P-INDEX @ P-STACK + ! ;
  35.  
  36. \ Copy current top number of P-stack to top of Forth's
  37. \ data stack. Note: P-stack is not changed.
  38. : P@       ( --   n D)  ( n  --  n P)
  39.            P-INDEX @ P-STACK + @  ;
  40.  
  41. \ Move number from top of P-stack to top of Forth's
  42. \ data stack. Note: Number is removed from P-stack.
  43. : P>       ( -- n D)  ( n -- P)
  44.            P@ P-DEC ;
  45.  
  46. \ Display all numbers on the P-stack.
  47. : .P       ( -- )
  48.            P-DEPTH ?DUP
  49.            IF 1+ 1 ?DO I 2* P-STACK + @ 8 .R LOOP
  50.            ELSE ." P-STACK EMPTY" THEN ;
  51.  
  52.  
  53. \ Problem 4.6 Personal User Stacks.
  54. \ Write Forth words for the following user stack operations. They should
  55. \ leave the data stack unchanged.
  56.  
  57. \  PDUP  PDROP PSWAP POVER PROT -PROT PTUCK PNIP 2PDUP 3PDUP 2PSWAP
  58. \  2PDROP 2POVER
  59. \ Hint:  : PSWAP ( n m -- m n P)  P> P> SWAP >P >P ;
  60. \ Have we left out any important operators?  Could you make
  61. \ P+ P- P* and P/ ????
  62.  
  63.  
  64. \ Solution to Problem 4.6
  65.  
  66. : PDUP          P@ >P                                   ;
  67. : PDROP         P> DROP                                 ;
  68. : PSWAP         P> P> SWAP >P >P                        ;
  69. : POVER         P> P@ SWAP >P >P                        ;
  70. : PROT          P> P> P> -ROT >P >P >P                  ;
  71. : -PROT         PROT PROT                               ;
  72. : PTUCK         PSWAP POVER                             ;
  73. : PNIP          PSWAP PDROP                             ;
  74. : 2PDUP         POVER POVER                             ;
  75. : 3PDUP         P> 2PDUP DUP >P -PROT >P                ;
  76. : 2PSWAP        PROT P> PROT >P                         ;
  77. : 2PDROP        PDROP PDROP                             ;
  78. : 2POVER        2PSWAP 2PDUP P> P> 2PSWAP >P >P         ;
  79.  
  80.