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
103
104
105
106
107: HERE (HERE) @ ;
: \ TIB# @ >IN ! ; IMMEDIATE
: CELL 4 ; INLINE
: OVER 1 PICK ;
: TUCK SWAP OVER ;
: +! TUCK @ + SWAP ! ;
: , HERE ! CELL (HERE) +! ;
: CREATE : HERE POSTPONE LITERAL POSTPONE ; ;
: CONSTANT ALIGN CREATE , DOES> @ ;
: VARIABLE ALIGN CREATE 0 , ;
: 2VARIABLE ALIGN CREATE 0 , 0 , ;
: 1+ 1 + ;
: NEGATE -1 XOR 1+ ;
: 0>= 0 >= ;
: 0= 0 = ;
: < >= 0= ;
: <> = 0= ;
: 0> NEGATE 0< ;
: 0<= NEGATE 0>= ;
: 0<> 0 <> ;
: < >= 0= ;
: > SWAP < ;
: <= SWAP >= ;
: 2* 2 * ;
: NIP SWAP DROP ;
: / /MOD NIP ;
: - NEGATE + ;
: 1- 1 - ;
: 2DROP DROP DROP ;
: 2DUP OVER OVER ;
: CHAR PARSE-WORD DROP C@ ;
: [CHAR] CHAR POSTPONE LITERAL ; IMMEDIATE
: ( [CHAR] ) PARSE 2DROP ; IMMEDIATE
: DECIMAL 10 BASE ! ;
: HEX 16 BASE ! ;
: CELLS CELL * ;
: CELL+ CELL + ;
: 2! SWAP OVER ! CELL+ ! ;
: 2@ DUP CELL+ @ SWAP @ ;
: 2OVER 3 PICK 3 PICK ;
: ROT 2 ROLL ;
: ?DUP DUP IF DUP THEN ;
: ABS DUP 0< IF NEGATE THEN ;
: ALIGNED CELL 1- + CELL / CELL * ;
: ALLOT (HERE) +! ;
: INVERT NEGATE 1- ;
: CHAR+ 1 + ;
: CHARS ;
: 2SWAP 3 ROLL 3 ROLL ;
: ELSE POSTPONE AHEAD 2SWAP POSTPONE THEN ; IMMEDIATE
: MAX 2DUP > IF DROP ELSE NIP THEN ;
: MIN 2DUP > IF NIP ELSE DROP THEN ;
: MOD /MOD DROP ;
: BOUNDS OVER + SWAP ;
: LOOP 1 POSTPONE LITERAL POSTPONE +LOOP ; IMMEDIATE
: I R@ ; INLINE
: TYPE DUP IF BOUNDS DO I C@ EMIT LOOP ELSE 2DROP THEN ;
: .( [CHAR] ) PARSE TYPE ; IMMEDIATE
0 CONSTANT FALSE
-1 CONSTANT TRUE
ALIGN CREATE PAD 256 ALLOT
: ['] ' POSTPONE LITERAL ; IMMEDIATE
: VALUE CONSTANT ;
: TO ' >BODY STATE @ IF POSTPONE LITERAL POSTPONE ! ELSE ! THEN ; IMMEDIATE
: -ROT ROT ROT ;
: DEFER VARIABLE DOES> @ ?DUP IF EXECUTE THEN ;
: IS ' >BODY ! ;
32 CONSTANT BL
: SPACE BL EMIT ;
: */ */MOD NIP ;
: 1+ 1 + ;
: 1- 1 - ;
: UNTIL POSTPONE 0= POSTPONE WHILE POSTPONE REPEAT ; IMMEDIATE
: C, HERE C! 1 ALLOT ;
: S" [CHAR] " PARSE HERE POSTPONE LITERAL DUP POSTPONE LITERAL
BOUNDS DO I C@ C, LOOP ; IMMEDIATE
: C" [CHAR] " PARSE HERE POSTPONE LITERAL DUP C,
BOUNDS DO I C@ C, LOOP ; IMMEDIATE
: ." POSTPONE S" POSTPONE TYPE ; IMMEDIATE
: 2R> R> R> SWAP ; INLINE
: -! TUCK @ SWAP - SWAP ! ;
: CLEAR DEPTH DUP IF 0 DO DROP LOOP THEN ;
: SOURCE TIB TIB# @ ;
\ Picture output
32 CONSTANT #-SIZE
CREATE #-BUFFER #-SIZE ALLOT
#-BUFFER #-SIZE + CONSTANT #-AFTER
VARIABLE #-HERE
: (BASE/MOD) BASE @ OVER 0< IF NEGATE THEN FM/MOD 0 ;
: <# #-AFTER #-HERE ! ;
: #> 2DROP #-HERE @ #-AFTER OVER - ;
: DIGIT DUP 10 < IF [CHAR] 0 ELSE [CHAR] A 10 - THEN + ;
: HOLD 1 #-HERE -! #-HERE @ C! ;
: SIGN 0< IF [CHAR] - HOLD THEN ;
: # (BASE/MOD) ROT ABS DIGIT HOLD ;
: #S BEGIN # 2DUP OR WHILE REPEAT ;
: . DUP <# S>D #S ROT SIGN #> TYPE ;
: .S [CHAR] < EMIT DEPTH DUP . [CHAR] > EMIT
DUP IF 1 SWAP 1- NEGATE DO SPACE I NEGATE PICK . LOOP ELSE DROP THEN ;