|
154 | 154 | :name ":"
|
155 | 155 | :args [[] []]
|
156 | 156 | :source ": : ( \"<spaces>name\" -- )
|
157 |
| - CREATE HIDE -1 ALLOT ['] DOCOLON C, ]" |
| 157 | + CREATE HIDE -2 ALLOT ['] DOCOLON XT, ]" |
158 | 158 | :pfa [:create :hide
|
159 |
| - :zero :oneminus :allot :icharlit "DOCOLON" :ccomma |
| 159 | + :zero :oneminus :oneminus :allot :icharlit "DOCOLON" :xtcomma |
160 | 160 | :rtbracket
|
161 | 161 | :exit]}
|
162 | 162 |
|
|
170 | 170 | ;; around and basically do a similar thing to decide if this is not a
|
171 | 171 | ;; DO* word. We need some way to differentiate between these things: a
|
172 | 172 | ;; token and a definition.
|
| 173 | +;; FIXME XT@XT should really be CFA@ (similar to LFA@) and then do the |
| 174 | +;; offset on its own (just like LFA@). This will make it easier to |
| 175 | +;; eventually change target of an XT (to the CFA instead of the LFA, for |
| 176 | +;; example). |
173 | 177 | {:token :compilecomma
|
174 | 178 | :name "COMPILE,"
|
175 | 179 | :args [[:xt] []]
|
176 | 180 | :source ": COMPILE, ( xt --)
|
177 | 181 | DUP TOKEN? IF C, EXIT THEN
|
178 |
| - DUP 3 + ( >CFA) C@XT DUP $70 < IF C, DROP ELSE DROP XT, THEN ;" |
| 182 | + DUP 3 + ( >CFA) XT@XT DUP $70 < IF C, DROP ELSE DROP XT, THEN ;" |
179 | 183 | :pfa [:dup :tokenq :izbranch 3 :ccomma :exit
|
180 |
| - :dup :oneplus :oneplus :oneplus :cfetchxt |
| 184 | + :dup :oneplus :oneplus :oneplus :xtfetchxt |
181 | 185 | :dup :icharlit 0x70 :lessthan :izbranch 5
|
182 | 186 | :ccomma :drop :ibranch 3
|
183 | 187 | :drop :xtcomma
|
|
186 | 190 | {:token :constant
|
187 | 191 | :args [[:x] []]
|
188 | 192 | :source ": CONSTANT ( x \"<spaces>name\" -- )
|
189 |
| - CREATE -1 ALLOT ['] DOCONSTANT C, , ;" |
190 |
| - :pfa [:create :zero :oneminus :allot :icharlit "DOCONSTANT" :ccomma |
| 193 | + CREATE -2 ALLOT ['] DOCONSTANT XT, , ;" |
| 194 | + :pfa [:create :zero :oneminus :oneminus :allot :icharlit "DOCONSTANT" :xtcomma |
191 | 195 | :comma
|
192 | 196 | :exit]}
|
193 | 197 |
|
|
215 | 219 | BL PARSE-WORD DUP 0= IF ABORT THEN ( ca u)
|
216 | 220 | TUCK ( u ca u) NAME, ( u)
|
217 | 221 | HERE >XT ( u this-xt) SWAP C, LATEST @ XT, ( this-xt) LATEST !
|
218 |
| - ['] DOCREATE C, ALIGN ;" |
| 222 | + ['] DOCREATE XT, ALIGN ;" |
219 | 223 | :pfa [:bl :parseword :dup :zeroequals :izbranch 2 :abort
|
220 | 224 | :tuck
|
221 | 225 | ; NAME,
|
|
225 | 229 | :oneminus :dup :cfetch :ccomma :ibranch -9
|
226 | 230 | :twodrop
|
227 | 231 | :here :toxt :swap :ccomma :latest :fetch :xtcomma :latest :store
|
228 |
| - :icharlit "DOCREATE" :ccomma |
| 232 | + :icharlit "DOCREATE" :xtcomma |
| 233 | + ;; FIXME This ALIGN seems wrong; the VM will just point W right |
| 234 | + ;; after the CFA, for example, and not take ALIGN into account. |
| 235 | + ;; We should probably no-op ALIGN and then stop calling it. |
229 | 236 | :align
|
230 | 237 | :exit]}
|
231 | 238 |
|
|
244 | 251 | 0 'PREVLEAVE ! ['] (DO) COMPILE, HERE ; IMMEDIATE"
|
245 | 252 | :pfa [:zero :tickprevleave :store :icharlit :pdo :compilecomma :here :exit]}
|
246 | 253 |
|
| 254 | +;; CREATE puts a two-byte XT containing the DOCREATE token into the Code |
| 255 | +;; Field. Various other defining words (CONSTANT, VARIABLE, etc.) |
| 256 | +;; replace that token with a different token. DOES> also needs to |
| 257 | +;; replace the Code Field, but needs to replace it with an XT and not a |
| 258 | +;; token. That reason alone is why the Code Field is two bytes instead |
| 259 | +;; of one byte. |
| 260 | +;; |
| 261 | +;; What goes in this DOES>-modified Code Field? The XT of the runtime |
| 262 | +;; behavior of the defining word -- the code after DOES> in other words. |
| 263 | +;; |
| 264 | +;; Here is how CREATE..DOES>.. works: |
| 265 | +;; |
| 266 | +;; Compile Time behavior: |
| 267 | +;; 1. Defining word is created that looks like: ": NAMEDZERO: CREATE 0 , DOES> @ ;". |
| 268 | +;; 2. DOES> is an immediate word that compiles (does>) into the defining |
| 269 | +;; word's thread. |
| 270 | +;; 3. User calls this word to create a new word: "NAMEDZERO: nothing". |
| 271 | +;; 4. Defining word runs CREATE, which creates a new definition. In |
| 272 | +;; this case, the definition compiles a zero into the dictionary. |
| 273 | +;; 5. Then (does>) executes (remember, we are still in the NAMEDZERO: |
| 274 | +;; thread at this point). (does>) exits the current definition (which |
| 275 | +;; is "NAMEDZERO:" in this example) by popping the return stack |
| 276 | +;; pointer. That pointer contains the address of the word after |
| 277 | +;; (does>) from the NAMEDZERO: definition itself. That pointer is |
| 278 | +;; the start of the runtime behavior of the defining word. |
| 279 | +;; 6. (does>) then gets the address of the LATEST definition (which is |
| 280 | +;; the one that we CREATEd in step 4) and advances to the CFA (which |
| 281 | +;; so far is DOCREATE). |
| 282 | +;; 7. (does>) rewrites that CFA to point to the address after (does>), |
| 283 | +;; which was popped in step 5. |
| 284 | +;; |
| 285 | +;; Runtime behavior: |
| 286 | +;; 1. The defined word ("nothing" in this example) runs. Its CFA points |
| 287 | +;; to the thread after (does>). The Enforth inner interpreter has |
| 288 | +;; special code that detects this situation -- a Code Field that |
| 289 | +;; contains an XT and not a token -- and knows that the Code Field |
| 290 | +;; was modified by (does>). The inner interpreter jumps to DODOES. |
| 291 | +;; 2. DODOES pushes the IP to the return stack -- we're calling another |
| 292 | +;; word here, just like in DOCOLON. Then DODOES pushes W (the PFA of |
| 293 | +;; the *defined* word, aka "nothing" in this example) to the data |
| 294 | +;; stack. Finally, DODOES sets IP to the runtime thread of the |
| 295 | +;; defining word (from "NAMEDZERO:"). |
| 296 | +;; 3. Execution continues in the body of the defining word. |
| 297 | +{:token :pdoes |
| 298 | + :name "(does>)" |
| 299 | + :flags #{:headerless} |
| 300 | + :source ": (does>) |
| 301 | + R> >XT ( XT of runtime behavior for the defining word) |
| 302 | + LATEST @ >NFA kNFAtoCFA + ( addr of original CFA) |
| 303 | + XT! ( rewrite CFA to point to runtime part of defining word) ;" |
| 304 | + :pfa [:rfrom :toxt |
| 305 | + :latest :fetch :tonfa :icharlit "kNFAtoCFA" :plus |
| 306 | + :xtstore |
| 307 | + :exit]} |
| 308 | + |
| 309 | +{:token :does |
| 310 | + :name "DOES>" |
| 311 | + :flags #{:immediate} |
| 312 | + :source ": DOES> ( -- ) ['] (does>) XT, ; IMMEDIATE" |
| 313 | + :pfa [:icharlit "((uint8_t)((ROMDEF_PDOES >> 8) & 0xff))" |
| 314 | + :icharlit 8 :lshift |
| 315 | + :icharlit "((uint8_t)((ROMDEF_PDOES ) & 0xff))" |
| 316 | + :or |
| 317 | + :xtcomma |
| 318 | + :exit]} |
| 319 | + |
247 | 320 | {:token :dot
|
248 | 321 | :name "."
|
249 | 322 | :args [[:n] []]
|
|
703 | 776 | {:token :tobody
|
704 | 777 | :name ">BODY"
|
705 | 778 | :args [[:xt] [:a-addr]]
|
706 |
| - :source ": >BODY ( xt -- a-addr) XTMASK AND 'DICT + 4 + ( NFA + LFA + CFA) ;" |
707 |
| - :pfa [:xtmask :and :tickdict :plus :icharlit 4 :plus |
| 779 | + :source ": >BODY ( xt -- a-addr) XTMASK AND 'DICT + kNFAtoPFA + ;" |
| 780 | + :pfa [:xtmask :and :tickdict :plus :icharlit "kNFAtoPFA" :plus |
708 | 781 | ;; TODO Add :align if we start aligning the PFA.
|
709 | 782 | :exit]}
|
710 | 783 |
|
|
774 | 847 | {:token :variable
|
775 | 848 | :args [[] []]
|
776 | 849 | :source ": VARIABLE ( \"<spaces>name\" -- )
|
777 |
| - CREATE -1 ALLOT ['] DOVARIABLE C, 0 , ;" |
778 |
| - :pfa [:create :zero :oneminus :allot :icharlit "DOVARIABLE" :ccomma |
| 850 | + CREATE -2 ALLOT ['] DOVARIABLE XT, 0 , ;" |
| 851 | + :pfa [:create :zero :oneminus :oneminus :allot :icharlit "DOVARIABLE" :xtcomma |
779 | 852 | :zero :comma
|
780 | 853 | :exit]}
|
781 | 854 |
|
|
0 commit comments