forth/mp.frt at master · tretikoff/forth · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
: IMMEDIATE push_lastword @ cfa 1 - dup c@ 1 or swap c! ;

: if
  ' branchifz ,
  here 0 ,
; IMMEDIATE

: else
  ' branch ,
  here 0 ,
  swap here swap !
; IMMEDIATE

: then
  here swap !
; IMMEDIATE

: endif
  ' then initcmd
; IMMEDIATE

: abs dup 0 < if -1 * then ;
5 abs . printnl
-3 abs . printnl
-199 abs . printnl printnl


: repeat
  here
; IMMEDIATE

: until
  ' branchifz , ,
; IMMEDIATE

: odd 2 % abs ;
: sqr dup * ;
: over >r dup r> swap ;
: 2dup over over ;
: -rot swap >r swap  r> ;
: >= < not ;
: prime
dup 1 > if
  dup 2 = not if
    dup odd if
    1
      repeat
      2 +
      2dup 2dup sqr >=
      -rot % land not
      until
    sqr <
    else drop 0 then
  else drop 1 then
else drop 0 then ;
2 prime . printnl
11 prime . printnl
191 prime . printnl
201 prime . printnl printnl


: for
    ' swap ,
    ' >r ,
    ' >r ,
    here
    ' r> ,
    ' r> ,
    ' 2dup ,
    ' >r ,
    ' >r ,
    ' < ,
    ' branchifz ,
    here 0 ,
    swap
; IMMEDIATE

: endfor
       ' r> ,
       ' lit , 1 ,
       ' + ,
       ' >r ,
       ' branch , ,
       here swap !
       ' r> ,
       ' drop ,
       ' r> ,
       ' drop ,
;  IMMEDIATE

: testfor
   2dup swap . printnl . printnl printnl

  2dup
  for
  r@ . printnl
  endfor
;

0 5 testfor
999 . printnl
5 0 testfor