home *** CD-ROM | disk | FTP | other *** search
/ APDL Public Domain 1 / APDL_PD1A.iso / program / language / forth / !FORTH / TestProgs / prog1 < prev    next >
Encoding:
Text File  |  1989-07-08  |  974 b   |  28 lines
  1. CORE
  2. : tokens INLINE BEGIN ASPACE TOKEN DUP NOT
  3.         IF TOKEN_BUFFER @ TYPE CRET ENDIF
  4.      END 0 LINE_BUFFER @ ! ;
  5. 10 ARRAY A1
  6. 10 ARRAY A2
  7. 10 ARRAY A3
  8. : LOOK PRINT_MODE @ DUP 1 OR PRINT_MODE ! SWAP ."  ( " 9 0 DO DUP [I]@ . LOOP DROP ."  ) " PRINT_MODE ! ;
  9. : OUTCHAR PRINT_MODE @ DUP 1 OR PRINT_MODE ! SWAP ECHO PRINT_MODE ! ;
  10. : A1LOOK A1 LOOK ;
  11. : A2LOOK A2 LOOK ;
  12. : A3LOOK A3 LOOK ;
  13. : A1SET 9 0 DO I> A1 [I]! LOOP ;
  14. : A2SET 9 0 DO I> I> + A2 [I]! LOOP ;
  15. : A3SET 9 0 DO I> 3 + A3 [I]! LOOP ;
  16. : VectorAdd 0 DO 2OVER [I]@ 2OVER [I]@ + OVER [I]! LOOP ;
  17. : VectorSub 0 DO 2OVER [I]@ 2OVER [I]@ - OVER [I]! LOOP ;
  18. : VectorMul 0 DO 2OVER [I]@ 2OVER [I]@ * OVER [I]! LOOP ;
  19. : VectorDiv 0 DO 2OVER [I]@ 2OVER [I]@ / OVER [I]! LOOP ;
  20. A1SET 
  21. A2SET
  22. A3SET
  23. A3 A2 A1 9 VectorAdd A3LOOK 43 OUTCHAR A2LOOK 61 OUTCHAR A1LOOK 13 OUTCHAR
  24. A3 A2 A1 9 VectorSub A3LOOK 45 OUTCHAR A2LOOK 61 OUTCHAR A1LOOK 13 OUTCHAR
  25. A3 A2 A1 9 VectorMul A3LOOK 42 OUTCHAR A2LOOK 61 OUTCHAR A1LOOK 13 OUTCHAR
  26.  
  27.  
  28.