blob: eea702fd38d14fa60b3084c6af6462c1d252041d (
plain)
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
|
: \ 10 parse 2drop ; immediate \ test
: ( [ char ) ] literal parse 2drop ; immediate ( test )
: binary 2 base ! ;
: octal 8 base ! ;
: decimal 10 base ! ;
: hex 16 base ! ;
: <mark here ;
: <resolve here 4 + - d, ;
: >mark here 0 d, ;
: >resolve dup here swap - 4 - swap d! ;
: begin <mark ; immediate
: again branch <resolve ; immediate
: until ?branch <resolve ; immediate
: if ?branch >mark ; immediate
: else branch >mark swap >resolve ; immediate
: then >resolve ; immediate
: while ?branch >mark ; immediate
: repeat branch swap <resolve >resolve ; immediate
: ?dup dup 0<> if dup then ;
: allot here swap dp +! ;
: ?find ?dup if find 0= if 2drop abort then else abort then ;
: 'h parse-name ?find ;
: ' 'h >body ;
: [compile] ' ( word ) compile, ; immediate
: ['] ' ( word ) [compile] literal ; immediate
: postpone 'h ( word ) dup immediate? if >body compile,
else >body [compile] literal ['] compile, compile, then ; immediate
: create parse-name (header) latest ! ['] (create) compile, 0 , ;
: does> latest @ >body 2 + ['] (does>) over ! \ replace call loc
( replace destination ) 11 + r> swap ! ;
( the lone r> means we don't execute the rest of the word now, )
( but it is actually compiled into the definition and is jumped to )
( by a create does> made word )
: constant create , does> @ ;
bye
|
