29 SWAP DUP HERE @ SWAP - SWAP !
32 : BEGIN IMMEDIATE HERE @ ;
34 : AGAIN IMMEDIATE ' BRANCH , HERE @ - , ;
36 : UNTIL IMMEDIATE ' 0BRANCH , HERE @ - , ;
39 BEGIN READ-WORD 1 = IF C@ 41 = IF EXIT THEN ELSE DROP THEN AGAIN ;
40 ( Yay! We now have comments! )
42 ( Compile a literal value into the current word. )
43 : LIT, IMMEDIATE ( x -- ) ' LIT , , ;
46 : MOD /MOD SWAP DROP ;
49 ( p n -- ; increment *p by n )
50 : INC OVER @ + SWAP ! ;
52 : C, HERE @ C! HERE 1 INC ;
54 ( p -- v ; fetch 32 bit value; fetches 64 and masks the high bits )
55 : @32 @ 4294967295 & ;
57 ( An alternative comment syntax. Reads until the end of the line. )
58 : \ IMMEDIATE BEGIN KEY 10 = UNTIL ;
60 ( string* -- buffer length )
61 : S@ DUP 1 + SWAP C@ ;
63 ( -- str* ; Put input string into dictionary heap and return address )
65 HERE @ 0 C, \ We will put the length here
66 BEGIN KEY DUP C, 34 = UNTIL
67 HERE @ 1 - 0 OVER C! OVER - OVER C!
70 \ So far, S" has only worked in immediate mode, which is backwards --
71 \ actually, the main use-case of this is as a compile-time word. Let's
73 : S" IMMEDIATE ' LITSTRING , " DROP ;
75 ( immediate print string, using HERE space )
76 : ." HERE @ " S@ TELL HERE ! ;
78 \ Store a null-terminated UTF-16 string HERE, and return a pointer to
79 \ its buffer at runtime.
80 : UTF16" HERE @ BEGIN KEY DUP C, 0 C, 34 = UNTIL 0 HERE @ 2 - C! ;
88 ( RPT ... [ IFZEND ... ]* DONE )
89 : RPT IMMEDIATE ' BRANCH , 24 , ' BRANCH , 0 , HERE @ ;
91 : DONE IMMEDIATE ' BRANCH , DUP HERE @ - , 8 - HERE @ OVER - SWAP ! ;
93 : IFZEND IMMEDIATE ' 0BRANCH , DUP 16 - HERE @ - , ;
95 ( v -- ; print decimal number )
96 : . DUP IF 10 /MOD SWAP DUP IF . ELSE DROP THEN THEN 48 + EMIT ;
98 ( Read a number from standard input. )
99 : READ-NUMBER READ-WORD PARSE-NUMBER ;
101 ( a b -- c ; logical AND wrt !=0 )
102 : AND IF IF 1 ELSE 0 THEN ELSE DROP 0 THEN ;
104 ( a b -- c ; logical OR wrt !=0 )
105 : OR IF DROP 1 ELSE IF 1 ELSE 0 THEN THEN ;
107 ( v [word] -- ; Declare a CONSTANT that returns a value )
108 : CONSTANT READ-WORD CREATE LIT DOCOL , LIT LIT , , LIT EXIT , ;
110 ( p n -- p+n ; define name for field address of given size )
111 : FIELD* OVER CONSTANT + ;
113 ( p -- p+8 ; define name for current field 64-bit value )
114 : FIELD@ DUP @ CONSTANT 8 + ;
116 ( v lo hi -- v x ; x = lo <= v and v <= hi )
117 : RANGE 2 PICK < IF DROP 0 ELSE OVER SWAP < IF 0 ELSE 1 THEN THEN ;
119 \ ######## Handling hexadecimal codes: 0x...
123 ( -- v ; read next character as a hexcode value or -1 )
125 KEY 48 57 RANGE IF 48 -
126 ELSE 65 70 RANGE IF 55 -
127 ELSE 97 102 RANGE IF 87 -
132 ( -- v ; Read indefinite sequence of hex digits, an one character more )
133 : HEX* 0 RPT HEX DUP 1 + IFZEND 16 * + DONE DROP ;
135 ( -- ; Read immediately a heax number and compile into dictionary )
136 : HEX, IMMEDIATE HEX* , ;
138 ( -- v ; read next 2 characters as hexcode into a byte value )
139 : HEX2 HEX 16 * HEX + ;
141 ( -- v ; read next 4 characters as hexcode into a 2-byte value )
142 : HEX4 HEX2 256 * HEX2 + ;
144 ( -- v ; read next 8 characters as hexcode into a 4-byte value )
145 : HEX8 HEX4 65536 * HEX4 + ;
147 ( c -- ; consume input on the line until character c or newline )
148 : SCANTO BEGIN KEY 10 OVER = IF DROP 1 ELSE OVER = THEN UNTIL DROP ;
150 ( v p -- ; lay out 2-byte value as LE )
151 : C2! 2DUP C! SWAP 256 / SWAP 1 + C! ;
153 ( v p -- ; lay out 4-byte value as LE )
154 : C4! 2DUP C2! SWAP 65536 / SWAP 2 + C2! ;
156 ( v1..vn n -- v1..vn ; reverse the n top elements on the stack using the heap )
158 DUP 1 + 8 * R+ \ Allocate frame of n+1 elements (index = 1..n)
159 DUP R= ! \ Save count at top
160 BEGIN SWAP OVER 8 * R= + ! 1 - 1 < UNTIL DROP \ copy to return stack
162 BEGIN DUP 8 * R= + @ SWAP 1 - 1 < UNTIL DROP \ copy from return stack
163 R= @ 1 + 8 * R+ \ Dispose of the frame
166 ( array i - array &array[i] ; pointer into 64-bit array )
169 ( addr n -- ; TELL n bytes )
170 : .BYTES BEGIN SWAP DUP C@ SPACE .U 1 + SWAP 1 - DUP 0 = UNTIL DROP DROP ;
172 ( addr n -- ; TELL n elements )
173 : .ELEMENTS BEGIN SWAP DUP @ SPACE .U 8 + SWAP 1 - DUP 1 < UNTIL DROP DROP ;