basewords.fs 2.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960
  1. ( Base words implemented in assembler JCB 13:10 08/24/10)
  2. meta
  3. : noop T alu ;
  4. : + T+N d-1 alu ;
  5. : xor T^N d-1 alu ;
  6. : and T&N d-1 alu ;
  7. : or T|N d-1 alu ;
  8. : invert ~T alu ;
  9. : = N==T d-1 alu ;
  10. : < N<T d-1 alu ;
  11. : u< Nu<T d-1 alu ;
  12. : swap N T->N alu ;
  13. : dup T T->N d+1 alu ;
  14. : drop N d-1 alu ;
  15. : over N T->N d+1 alu ;
  16. : nip T d-1 alu ;
  17. : >r N T->R r+1 d-1 alu ;
  18. : r> rT T->N r-1 d+1 alu ;
  19. : r@ rT T->N d+1 alu ;
  20. : @ [T] alu ;
  21. : ! T N->[T] d-1 alu
  22. N d-1 alu ;
  23. : dsp dsp T->N d+1 alu ;
  24. : lshift N<<T d-1 alu ;
  25. : rshift N>>T d-1 alu ;
  26. : 1- T-1 alu ;
  27. : 2r> rT T->N r-1 d+1 alu
  28. rT T->N r-1 d+1 alu
  29. N T->N alu ;
  30. : 2>r N T->N alu
  31. N T->R r+1 d-1 alu
  32. N T->R r+1 d-1 alu ;
  33. : 2r@ rT T->N r-1 d+1 alu
  34. rT T->N r-1 d+1 alu
  35. N T->N d+1 alu
  36. N T->N d+1 alu
  37. N T->R r+1 d-1 alu
  38. N T->R r+1 d-1 alu
  39. N T->N alu ;
  40. : unloop
  41. T r-1 alu
  42. T r-1 alu ;
  43. : exit return ;
  44. \ Elided words
  45. : dup@ [T] T->N d+1 alu ;
  46. : dup>r T T->R r+1 alu ;
  47. : 2dupxor T^N T->N d+1 alu ;
  48. : 2dup= N==T T->N d+1 alu ;
  49. : !nip T N->[T] d-1 alu ;
  50. : 2dup! T N->[T] alu ;
  51. \ Words used to implement pick
  52. : up1 T d+1 alu ;
  53. : down1 T d-1 alu ;
  54. : copy N alu ;
  55. : module[ there [char] " parse preserve ;
  56. : ]module s" Compiled " type count type space there swap - . cr ;