home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / fpc / source / p4_18dc.seq < prev    next >
Encoding:
Text File  |  1990-04-15  |  1.9 KB  |  53 lines
  1. \ Problem 4.18   04/15/90 19:33:49.25
  2.  
  3. \ Create an array to be used for a 10 number stack.
  4.   CREATE  P-STACK  20 ALLOT  \ Stack will hold 10 16bit numbers.
  5.  
  6.   VARIABLE P-INDEX           \ Holds the value of user stack pointer.
  7.  
  8. \ Clear and initialize the Personal user stack.
  9. : P-CLEAR  ( -- D) ( ?? -- P)
  10.            0 P-INDEX !  P-STACK 20 ERASE ;
  11.  
  12. \ Return number of elements on the user stack to Forth's data stack.
  13. : P-DEPTH  ( -- n  D)   P-INDEX @ 2/ ;
  14.  
  15. \ Increment user stack pointer with error checking.
  16. : P-INC    ( -- D)
  17.            P-INDEX @ 20 =
  18.            IF ." P-OVERFLOW"  P-CLEAR
  19.            ELSE 2 P-INDEX +! THEN ;
  20.  
  21. \ Decrement user stack pointer with error checking.
  22. : P-DEC    ( -- D)
  23.            P-INDEX @ 0=
  24.            IF ." P-UNDERFLOW"
  25.            ELSE -2 P-INDEX +! THEN ;
  26.  
  27. \ Move number from Forth's data stack to the P-stack.
  28. : >P       ( n -- D)  ( -- n P)
  29.            P-INC P-INDEX @ P-STACK + ! ;
  30.  
  31. \ Copy current top number of P-stack to top of Forth's
  32. \ data stack. Note: P-stack is not changed.
  33. : P@       ( --   n D)  ( n  --  n P)
  34.            P-INDEX @ P-STACK + @  ;
  35.  
  36. \ Move number from top of P-stack to top of Forth's
  37. \ data stack. Note: Number is removed from P-stack.
  38. : P>       ( -- n D)  ( n -- P)
  39.            P@ P-DEC ;
  40.  
  41. \ Display all numbers on the P-stack.
  42. : .P       ( -- )
  43.            P-DEPTH ?DUP \ if P-stack is not empty duplicate the depth number
  44.            IF 1+ 1 ?DO I 2* P-STACK + @ 8 .R LOOP
  45.                         \ if depth number is no zero do the depth number of
  46.                         \ times of following:
  47.                         \     calculate the address of the current stack,
  48.                         \     fetch the value from the address,
  49.                         \     print the value with right adjusted 8 positions.
  50.            ELSE ." P-STACK EMPTY" THEN ;
  51.                         \ if depth number is zero say " P-STACK EMPTY ".
  52.  
  53.