j1_forth/basewords.fs at master · pbing/j1_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
( Base words implemented in assembler        JCB 13:10 08/24/10)
meta
: noop      T                       alu ;
: +         T+N                 d-1 alu ;
: xor       T^N                 d-1 alu ;
: and       T&N                 d-1 alu ;
: or        T|N                 d-1 alu ;
: invert    ~T                      alu ;
: =         N==T                d-1 alu ;
: <         N<T                 d-1 alu ;
: u<        Nu<T                d-1 alu ;
: swap      N     T->N              alu ;
: dup       T     T->N          d+1 alu ;
: drop      N                   d-1 alu ;
: over      N     T->N          d+1 alu ;
: nip       T                   d-1 alu ;
: >r        N     T->R      r+1 d-1 alu ;
: r>        rT    T->N      r-1 d+1 alu ;
: r@        rT    T->N          d+1 alu ;
: @         [T]                     alu ;
: !         T     N->[T]        d-1 alu
            N                   d-1 alu ;
: dsp       dsp   T->N          d+1 alu ;
: lshift    N<<T                d-1 alu ;
: rshift    N>>T                d-1 alu ;
: 1-        T-1                     alu ;
: 2r>       rT    T->N      r-1 d+1 alu
            rT    T->N      r-1 d+1 alu
            N     T->N              alu ;
: 2>r       N     T->N              alu
            N     T->R      r+1 d-1 alu
            N     T->R      r+1 d-1 alu ;
: 2r@       rT    T->N      r-1 d+1 alu
            rT    T->N      r-1 d+1 alu
            N     T->N          d+1 alu
            N     T->N          d+1 alu
            N     T->R      r+1 d-1 alu
            N     T->R      r+1 d-1 alu
            N     T->N              alu ;
: unloop    T               r-1     alu
            T               r-1     alu ;
: exit      return ;

\ Elided words
\ These words are supported by the hardware but are not
\ part of ANS Forth.  They are named after the word-pair
\ that matches their effect
\ Using these elided words instead of
\ the pair saves one cycle and one instruction.
: 2dup!     T     N->[T]            alu ;
: 2dup+     T+N   T->N          d+1 alu ;
: 2dup<     N<T   T->N          d+1 alu ;
: 2dup=     N==T  T->N          d+1 alu ;
: 2dupand   T&N   T->N          d+1 alu ;
: 2dupor    T|N   T->N          d+1 alu ;
: 2dupu<    Nu<T  T->N          d+1 alu ;
: 2dupxor   T^N   T->N          d+1 alu ;
: dup>r     T     T->R      r+1     alu ;
: dup@      [T]   T->N          d+1 alu ;
: over+     T+N                     alu ;
: over=     N==T                    alu ;
: over>     N<T                     alu ;
: overand   T&N                     alu ;
: overor    T|N                     alu ;
: overu>    Nu<T                    alu ;
: overxor   T^N                     alu ;
: rdrop     T                   r-1 alu ;
: tuck!     T     N->[T]        d-1 alu ;

\ Words used to implement pick
: up1       T                   d+1 alu ;
: down1     T                   d-1 alu ;
: copy      N                       alu ;

\ : module[ s" Compiling " type [char] " parse type space there ;
\ : ]module there swap - . cr ;

: module[ there [char] " parse preserve ;
: ]module s" Compiled " type count type space there swap - . cr ;