Powered by ViewCVS 1.0-dev
| 1 : | anton | 1.1 | \ Local variables are quite important for writing readable programs, but |
| 2 : | \ IMO (anton) they are the worst part of the standard. There they are very | ||
| 3 : | \ restricted and have an ugly interface. | ||
| 4 : | |||
| 5 : | \ So, we implement the locals wordset, but do not recommend using | ||
| 6 : | \ locals-ext (which is a really bad user interface for locals). | ||
| 7 : | |||
| 8 : | \ We also have a nice and powerful user-interface for locals: locals are | ||
| 9 : | \ defined with | ||
| 10 : | |||
| 11 : | \ { local1 local2 ... } | ||
| 12 : | \ or | ||
| 13 : | \ { local1 local2 ... -- ... } | ||
| 14 : | \ (anything after the -- is just a comment) | ||
| 15 : | |||
| 16 : | \ Every local in this list consists of an optional type specification | ||
| 17 : | \ and a name. If there is only the name, it stands for a cell-sized | ||
| 18 : | \ value (i.e., you get the value of the local variable, not it's | ||
| 19 : | \ address). The following type specifiers stand before the name: | ||
| 20 : | |||
| 21 : | \ Specifier Type Access | ||
| 22 : | \ W: Cell value | ||
| 23 : | \ W^ Cell address | ||
| 24 : | \ D: Double value | ||
| 25 : | \ D^ Double address | ||
| 26 : | \ F: Float value | ||
| 27 : | \ F^ Float address | ||
| 28 : | \ C: Char value | ||
| 29 : | \ C^ Char address | ||
| 30 : | |||
| 31 : | \ The local variables are initialized with values from the appropriate | ||
| 32 : | \ stack. In contrast to the examples in the standard document our locals | ||
| 33 : | \ take the arguments in the expected way: The last local gets the top of | ||
| 34 : | \ stack, the second last gets the second stack item etc. An example: | ||
| 35 : | |||
| 36 : | \ : CX* { F: Ar F: Ai F: Br F: Bi -- Cr Ci } | ||
| 37 : | \ \ complex multiplication | ||
| 38 : | \ Ar Br f* Ai Bi f* f- | ||
| 39 : | \ Ar Bi f* Ai Br f* f+ ; | ||
| 40 : | |||
| 41 : | \ There will also be a way to add user types, but it is not yet decided, | ||
| 42 : | \ how. Ideas are welcome. | ||
| 43 : | |||
| 44 : | \ Locals defined in this manner live until (!! see below). | ||
| 45 : | \ Their names can be used during this time to get | ||
| 46 : | \ their value or address; The addresses produced in this way become | ||
| 47 : | \ invalid at the end of the lifetime. | ||
| 48 : | |||
| 49 : | \ Values can be changed with TO, but this is not recomended (TO is a | ||
| 50 : | \ kludge and words lose the single-assignment property, which makes them | ||
| 51 : | \ harder to analyse). | ||
| 52 : | |||
| 53 : | \ As for the internals, we use a special locals stack. This eliminates | ||
| 54 : | \ the problems and restrictions of reusing the return stack and allows | ||
| 55 : | \ to store floats as locals: the return stack is not guaranteed to be | ||
| 56 : | \ aligned correctly, but our locals stack must be float-aligned between | ||
| 57 : | \ words. | ||
| 58 : | |||
| 59 : | \ Other things about the internals are pretty unclear now. | ||
| 60 : | |||
| 61 : | \ Currently locals may only be | ||
| 62 : | \ defined at the outer level and TO is not supported. | ||
| 63 : | |||
| 64 : | include float.fs | ||
| 65 : | include search-order.fs | ||
| 66 : | |||
| 67 : | anton | 1.3 | : compile-@local ( n -- ) |
| 68 : | case | ||
| 69 : | 0 of postpone @local0 endof | ||
| 70 : | 4 of postpone @local4 endof | ||
| 71 : | 8 of postpone @local8 endof | ||
| 72 : | 12 of postpone @local12 endof | ||
| 73 : | ( otherwise ) dup postpone @local# , | ||
| 74 : | endcase ; | ||
| 75 : | |||
| 76 : | : compile-f@local ( n -- ) | ||
| 77 : | case | ||
| 78 : | 0 of postpone f@local0 endof | ||
| 79 : | 8 of postpone f@local8 endof | ||
| 80 : | ( otherwise ) dup postpone f@local# , | ||
| 81 : | endcase ; | ||
| 82 : | |||
| 83 : | anton | 1.1 | \ the locals stack grows downwards (see primitives) |
| 84 : | \ of the local variables of a group (in braces) the leftmost is on top, | ||
| 85 : | \ i.e. by going onto the locals stack the order is reversed. | ||
| 86 : | \ there are alignment gaps if necessary. | ||
| 87 : | \ lp must have the strictest alignment (usually float) across calls; | ||
| 88 : | \ for simplicity we align it strictly for every group. | ||
| 89 : | |||
| 90 : | anton | 1.5 | slowvoc @ |
| 91 : | slowvoc on \ we want a linked list for the vocabulary locals | ||
| 92 : | anton | 1.1 | vocabulary locals \ this contains the local variables |
| 93 : | anton | 1.3 | ' locals >body ' locals-list >body ! |
| 94 : | anton | 1.5 | slowvoc ! |
| 95 : | anton | 1.1 | |
| 96 : | create locals-buffer 1000 allot \ !! limited and unsafe | ||
| 97 : | \ here the names of the local variables are stored | ||
| 98 : | \ we would have problems storing them at the normal dp | ||
| 99 : | |||
| 100 : | variable locals-dp \ so here's the special dp for locals. | ||
| 101 : | |||
| 102 : | : alignlp-w ( n1 -- n2 ) | ||
| 103 : | \ cell-align size and generate the corresponding code for aligning lp | ||
| 104 : | anton | 1.3 | aligned dup adjust-locals-size ; |
| 105 : | anton | 1.1 | |
| 106 : | : alignlp-f ( n1 -- n2 ) | ||
| 107 : | anton | 1.3 | faligned dup adjust-locals-size ; |
| 108 : | anton | 1.1 | |
| 109 : | \ a local declaration group (the braces stuff) is compiled by calling | ||
| 110 : | \ the appropriate compile-pushlocal for the locals, starting with the | ||
| 111 : | \ righmost local; the names are already created earlier, the | ||
| 112 : | \ compile-pushlocal just inserts the offsets from the frame base. | ||
| 113 : | |||
| 114 : | : compile-pushlocal-w ( a-addr -- ) ( run-time: w -- ) | ||
| 115 : | \ compiles a push of a local variable, and adjusts locals-size | ||
| 116 : | \ stores the offset of the local variable to a-addr | ||
| 117 : | locals-size @ alignlp-w cell+ dup locals-size ! | ||
| 118 : | swap ! | ||
| 119 : | postpone >l ; | ||
| 120 : | |||
| 121 : | : compile-pushlocal-f ( a-addr -- ) ( run-time: f -- ) | ||
| 122 : | locals-size @ alignlp-f float+ dup locals-size ! | ||
| 123 : | swap ! | ||
| 124 : | postpone f>l ; | ||
| 125 : | |||
| 126 : | : compile-pushlocal-d ( a-addr -- ) ( run-time: w1 w2 -- ) | ||
| 127 : | locals-size @ alignlp-w cell+ cell+ dup locals-size ! | ||
| 128 : | swap ! | ||
| 129 : | postpone swap postpone >l postpone >l ; | ||
| 130 : | |||
| 131 : | : compile-pushlocal-c ( a-addr -- ) ( run-time: w -- ) | ||
| 132 : | anton | 1.3 | -1 chars compile-lp+! |
| 133 : | anton | 1.1 | locals-size @ swap ! |
| 134 : | postpone lp@ postpone c! ; | ||
| 135 : | |||
| 136 : | : create-local ( " name" -- a-addr ) | ||
| 137 : | \ defines the local "name"; the offset of the local shall be stored in a-addr | ||
| 138 : | create | ||
| 139 : | immediate | ||
| 140 : | here 0 , ( place for the offset ) ; | ||
| 141 : | |||
| 142 : | anton | 1.3 | : lp-offset ( n1 -- n2 ) |
| 143 : | \ converts the offset from the frame start to an offset from lp and | ||
| 144 : | \ i.e., the address of the local is lp+locals_size-offset | ||
| 145 : | locals-size @ swap - ; | ||
| 146 : | |||
| 147 : | anton | 1.1 | : lp-offset, ( n -- ) |
| 148 : | \ converts the offset from the frame start to an offset from lp and | ||
| 149 : | \ adds it as inline argument to a preceding locals primitive | ||
| 150 : | anton | 1.3 | lp-offset , ; |
| 151 : | anton | 1.1 | |
| 152 : | vocabulary locals-types \ this contains all the type specifyers, -- and } | ||
| 153 : | locals-types definitions | ||
| 154 : | |||
| 155 : | : W: | ||
| 156 : | create-local ( "name" -- a-addr xt ) | ||
| 157 : | \ xt produces the appropriate locals pushing code when executed | ||
| 158 : | ['] compile-pushlocal-w | ||
| 159 : | does> ( Compilation: -- ) ( Run-time: -- w ) | ||
| 160 : | \ compiles a local variable access | ||
| 161 : | anton | 1.3 | @ lp-offset compile-@local ; |
| 162 : | anton | 1.1 | |
| 163 : | : W^ | ||
| 164 : | create-local ( "name" -- a-addr xt ) | ||
| 165 : | ['] compile-pushlocal-w | ||
| 166 : | does> ( Compilation: -- ) ( Run-time: -- w ) | ||
| 167 : | postpone laddr# @ lp-offset, ; | ||
| 168 : | |||
| 169 : | : F: | ||
| 170 : | create-local ( "name" -- a-addr xt ) | ||
| 171 : | ['] compile-pushlocal-f | ||
| 172 : | does> ( Compilation: -- ) ( Run-time: -- w ) | ||
| 173 : | anton | 1.3 | @ lp-offset compile-f@local ; |
| 174 : | anton | 1.1 | |
| 175 : | : F^ | ||
| 176 : | create-local ( "name" -- a-addr xt ) | ||
| 177 : | ['] compile-pushlocal-f | ||
| 178 : | does> ( Compilation: -- ) ( Run-time: -- w ) | ||
| 179 : | postpone laddr# @ lp-offset, ; | ||
| 180 : | |||
| 181 : | : D: | ||
| 182 : | create-local ( "name" -- a-addr xt ) | ||
| 183 : | ['] compile-pushlocal-d | ||
| 184 : | does> ( Compilation: -- ) ( Run-time: -- w ) | ||
| 185 : | postpone laddr# @ lp-offset, postpone 2@ ; | ||
| 186 : | |||
| 187 : | : D^ | ||
| 188 : | create-local ( "name" -- a-addr xt ) | ||
| 189 : | ['] compile-pushlocal-d | ||
| 190 : | does> ( Compilation: -- ) ( Run-time: -- w ) | ||
| 191 : | postpone laddr# @ lp-offset, ; | ||
| 192 : | |||
| 193 : | : C: | ||
| 194 : | create-local ( "name" -- a-addr xt ) | ||
| 195 : | ['] compile-pushlocal-c | ||
| 196 : | does> ( Compilation: -- ) ( Run-time: -- w ) | ||
| 197 : | postpone laddr# @ lp-offset, postpone c@ ; | ||
| 198 : | |||
| 199 : | : C^ | ||
| 200 : | create-local ( "name" -- a-addr xt ) | ||
| 201 : | ['] compile-pushlocal-c | ||
| 202 : | does> ( Compilation: -- ) ( Run-time: -- w ) | ||
| 203 : | postpone laddr# @ lp-offset, ; | ||
| 204 : | |||
| 205 : | \ you may want to make comments in a locals definitions group: | ||
| 206 : | ' \ alias \ immediate | ||
| 207 : | ' ( alias ( immediate | ||
| 208 : | |||
| 209 : | forth definitions | ||
| 210 : | |||
| 211 : | \ the following gymnastics are for declaring locals without type specifier. | ||
| 212 : | \ we exploit a feature of our dictionary: every wordlist | ||
| 213 : | \ has it's own methods for finding words etc. | ||
| 214 : | \ So we create a vocabulary new-locals, that creates a 'w:' local named x | ||
| 215 : | \ when it is asked if it contains x. | ||
| 216 : | |||
| 217 : | also locals-types | ||
| 218 : | |||
| 219 : | : new-locals-find ( caddr u w -- nfa ) | ||
| 220 : | \ this is the find method of the new-locals vocabulary | ||
| 221 : | \ make a new local with name caddr u; w is ignored | ||
| 222 : | \ the returned nfa denotes a word that produces what W: produces | ||
| 223 : | \ !! do the whole thing without nextname | ||
| 224 : | anton | 1.3 | drop nextname |
| 225 : | ['] W: >name ; | ||
| 226 : | anton | 1.1 | |
| 227 : | previous | ||
| 228 : | |||
| 229 : | : new-locals-reveal ( -- ) | ||
| 230 : | true abort" this should not happen: new-locals-reveal" ; | ||
| 231 : | |||
| 232 : | create new-locals-map ' new-locals-find A, ' new-locals-reveal A, | ||
| 233 : | |||
| 234 : | vocabulary new-locals | ||
| 235 : | new-locals-map ' new-locals >body cell+ A! \ !! use special access words | ||
| 236 : | |||
| 237 : | variable old-dpp | ||
| 238 : | |||
| 239 : | \ and now, finally, the user interface words | ||
| 240 : | : { ( -- addr wid 0 ) | ||
| 241 : | dp old-dpp ! | ||
| 242 : | locals-dp dpp ! | ||
| 243 : | also new-locals | ||
| 244 : | also get-current locals definitions locals-types | ||
| 245 : | 0 TO locals-wordlist | ||
| 246 : | 0 postpone [ ; immediate | ||
| 247 : | |||
| 248 : | locals-types definitions | ||
| 249 : | |||
| 250 : | : } ( addr wid 0 a-addr1 xt1 ... -- ) | ||
| 251 : | \ ends locals definitions | ||
| 252 : | ] old-dpp @ dpp ! | ||
| 253 : | begin | ||
| 254 : | dup | ||
| 255 : | while | ||
| 256 : | execute | ||
| 257 : | repeat | ||
| 258 : | drop | ||
| 259 : | locals-size @ alignlp-f locals-size ! \ the strictest alignment | ||
| 260 : | set-current | ||
| 261 : | previous previous | ||
| 262 : | locals-list TO locals-wordlist ; | ||
| 263 : | |||
| 264 : | : -- ( addr wid 0 ... -- ) | ||
| 265 : | } | ||
| 266 : | [char] } word drop ; | ||
| 267 : | |||
| 268 : | forth definitions | ||
| 269 : | |||
| 270 : | \ A few thoughts on automatic scopes for locals and how they can be | ||
| 271 : | \ implemented: | ||
| 272 : | |||
| 273 : | \ We have to combine locals with the control structures. My basic idea | ||
| 274 : | \ was to start the life of a local at the declaration point. The life | ||
| 275 : | \ would end at any control flow join (THEN, BEGIN etc.) where the local | ||
| 276 : | \ is lot live on both input flows (note that the local can still live in | ||
| 277 : | \ other, later parts of the control flow). This would make a local live | ||
| 278 : | \ as long as you expected and sometimes longer (e.g. a local declared in | ||
| 279 : | \ a BEGIN..UNTIL loop would still live after the UNTIL). | ||
| 280 : | |||
| 281 : | \ The following example illustrates the problems of this approach: | ||
| 282 : | |||
| 283 : | \ { z } | ||
| 284 : | \ if | ||
| 285 : | \ { x } | ||
| 286 : | \ begin | ||
| 287 : | \ { y } | ||
| 288 : | \ [ 1 cs-roll ] then | ||
| 289 : | \ ... | ||
| 290 : | \ until | ||
| 291 : | |||
| 292 : | \ x lives only until the BEGIN, but the compiler does not know this | ||
| 293 : | \ until it compiles the UNTIL (it can deduce it at the THEN, because at | ||
| 294 : | \ that point x lives in no thread, but that does not help much). This is | ||
| 295 : | \ solved by optimistically assuming at the BEGIN that x lives, but | ||
| 296 : | \ warning at the UNTIL that it does not. The user is then responsible | ||
| 297 : | \ for checking that x is only used where it lives. | ||
| 298 : | |||
| 299 : | \ The produced code might look like this (leaving out alignment code): | ||
| 300 : | |||
| 301 : | \ >l ( z ) | ||
| 302 : | \ ?branch <then> | ||
| 303 : | \ >l ( x ) | ||
| 304 : | \ <begin>: | ||
| 305 : | \ >l ( y ) | ||
| 306 : | \ lp+!# 8 ( RIP: x,y ) | ||
| 307 : | \ <then>: | ||
| 308 : | \ ... | ||
| 309 : | \ lp+!# -4 ( adjust lp to <begin> state ) | ||
| 310 : | \ ?branch <begin> | ||
| 311 : | \ lp+!# 4 ( undo adjust ) | ||
| 312 : | |||
| 313 : | \ The BEGIN problem also has another incarnation: | ||
| 314 : | |||
| 315 : | \ AHEAD | ||
| 316 : | \ BEGIN | ||
| 317 : | \ x | ||
| 318 : | \ [ 1 CS-ROLL ] THEN | ||
| 319 : | \ { x } | ||
| 320 : | \ ... | ||
| 321 : | \ UNTIL | ||
| 322 : | |||
| 323 : | \ should be legal: The BEGIN is not a control flow join in this case, | ||
| 324 : | \ since it cannot be entered from the top; therefore the definition of x | ||
| 325 : | \ dominates the use. But the compiler processes the use first, and since | ||
| 326 : | \ it does not look ahead to notice the definition, it will complain | ||
| 327 : | \ about it. Here's another variation of this problem: | ||
| 328 : | |||
| 329 : | \ IF | ||
| 330 : | \ { x } | ||
| 331 : | \ ELSE | ||
| 332 : | \ ... | ||
| 333 : | \ AHEAD | ||
| 334 : | \ BEGIN | ||
| 335 : | \ x | ||
| 336 : | \ [ 2 CS-ROLL ] THEN | ||
| 337 : | \ ... | ||
| 338 : | \ UNTIL | ||
| 339 : | |||
| 340 : | \ In this case x is defined before the use, and the definition dominates | ||
| 341 : | \ the use, but the compiler does not know this until it processes the | ||
| 342 : | \ UNTIL. So what should the compiler assume does live at the BEGIN, if | ||
| 343 : | \ the BEGIN is not a control flow join? The safest assumption would be | ||
| 344 : | \ the intersection of all locals lists on the control flow | ||
| 345 : | \ stack. However, our compiler assumes that the same variables are live | ||
| 346 : | \ as on the top of the control flow stack. This covers the following case: | ||
| 347 : | |||
| 348 : | \ { x } | ||
| 349 : | \ AHEAD | ||
| 350 : | \ BEGIN | ||
| 351 : | \ x | ||
| 352 : | \ [ 1 CS-ROLL ] THEN | ||
| 353 : | \ ... | ||
| 354 : | \ UNTIL | ||
| 355 : | |||
| 356 : | \ If this assumption is too optimistic, the compiler will warn the user. | ||
| 357 : | |||
| 358 : | anton | 1.3 | \ Implementation: migrated to kernal.fs |
| 359 : | anton | 1.1 | |
| 360 : | \ THEN (another control flow from before joins the current one): | ||
| 361 : | \ The new locals-list is the intersection of the current locals-list and | ||
| 362 : | \ the orig-local-list. The new locals-size is the (alignment-adjusted) | ||
| 363 : | \ size of the new locals-list. The following code is generated: | ||
| 364 : | \ lp+!# (current-locals-size - orig-locals-size) | ||
| 365 : | \ <then>: | ||
| 366 : | \ lp+!# (orig-locals-size - new-locals-size) | ||
| 367 : | |||
| 368 : | \ Of course "lp+!# 0" is not generated. Still this is admittedly a bit | ||
| 369 : | \ inefficient, e.g. if there is a locals declaration between IF and | ||
| 370 : | \ ELSE. However, if ELSE generates an appropriate "lp+!#" before the | ||
| 371 : | \ branch, there will be none after the target <then>. | ||
| 372 : | |||
| 373 : | anton | 1.3 | \ explicit scoping |
| 374 : | anton | 1.1 | |
| 375 : | anton | 1.3 | : scope ( -- scope ) |
| 376 : | cs-push-part scopestart ; immediate | ||
| 377 : | |||
| 378 : | : endscope ( scope -- ) | ||
| 379 : | scope? | ||
| 380 : | anton | 1.1 | drop |
| 381 : | anton | 1.3 | locals-list @ common-list |
| 382 : | dup list-size adjust-locals-size | ||
| 383 : | locals-list ! ; immediate | ||
| 384 : | anton | 1.1 | |
| 385 : | anton | 1.3 | \ adapt the hooks |
| 386 : | anton | 1.1 | |
| 387 : | anton | 1.3 | : locals-:-hook ( sys -- sys addr xt n ) |
| 388 : | \ addr is the nfa of the defined word, xt its xt | ||
| 389 : | anton | 1.1 | DEFERS :-hook |
| 390 : | last @ lastcfa @ | ||
| 391 : | clear-leave-stack | ||
| 392 : | 0 locals-size ! | ||
| 393 : | locals-buffer locals-dp ! | ||
| 394 : | anton | 1.3 | 0 locals-list ! |
| 395 : | dead-code off | ||
| 396 : | defstart ; | ||
| 397 : | anton | 1.1 | |
| 398 : | anton | 1.3 | : locals-;-hook ( sys addr xt sys -- sys ) |
| 399 : | def? | ||
| 400 : | anton | 1.1 | 0 TO locals-wordlist |
| 401 : | anton | 1.3 | 0 adjust-locals-size ( not every def ends with an exit ) |
| 402 : | anton | 1.1 | lastcfa ! last ! |
| 403 : | DEFERS ;-hook ; | ||
| 404 : | |||
| 405 : | ' locals-:-hook IS :-hook | ||
| 406 : | ' locals-;-hook IS ;-hook | ||
| 407 : | |||
| 408 : | \ The words in the locals dictionary space are not deleted until the end | ||
| 409 : | \ of the current word. This is a bit too conservative, but very simple. | ||
| 410 : | |||
| 411 : | \ There are a few cases to consider: (see above) | ||
| 412 : | |||
| 413 : | \ after AGAIN, AHEAD, EXIT (the current control flow is dead): | ||
| 414 : | \ We have to special-case the above cases against that. In this case the | ||
| 415 : | \ things above are not control flow joins. Everything should be taken | ||
| 416 : | \ over from the live flow. No lp+!# is generated. | ||
| 417 : | |||
| 418 : | \ !! The lp gymnastics for UNTIL are also a real problem: locals cannot be | ||
| 419 : | \ used in signal handlers (or anything else that may be called while | ||
| 420 : | \ locals live beyond the lp) without changing the locals stack. | ||
| 421 : | |||
| 422 : | \ About warning against uses of dead locals. There are several options: | ||
| 423 : | |||
| 424 : | \ 1) Do not complain (After all, this is Forth;-) | ||
| 425 : | |||
| 426 : | \ 2) Additional restrictions can be imposed so that the situation cannot | ||
| 427 : | \ arise; the programmer would have to introduce explicit scoping | ||
| 428 : | \ declarations in cases like the above one. I.e., complain if there are | ||
| 429 : | \ locals that are live before the BEGIN but not before the corresponding | ||
| 430 : | \ AGAIN (replace DO etc. for BEGIN and UNTIL etc. for AGAIN). | ||
| 431 : | |||
| 432 : | \ 3) The real thing: i.e. complain, iff a local lives at a BEGIN, is | ||
| 433 : | \ used on a path starting at the BEGIN, and does not live at the | ||
| 434 : | \ corresponding AGAIN. This is somewhat hard to implement. a) How does | ||
| 435 : | \ the compiler know when it is working on a path starting at a BEGIN | ||
| 436 : | \ (consider "{ x } if begin [ 1 cs-roll ] else x endif again")? b) How | ||
| 437 : | \ is the usage info stored? | ||
| 438 : | |||
| 439 : | \ For now I'll resort to alternative 2. When it produces warnings they | ||
| 440 : | \ will often be spurious, but warnings should be rare. And better | ||
| 441 : | \ spurious warnings now and then than days of bug-searching. | ||
| 442 : | |||
| 443 : | \ Explicit scoping of locals is implemented by cs-pushing the current | ||
| 444 : | \ locals-list and -size (and an unused cell, to make the size equal to | ||
| 445 : | \ the other entries) at the start of the scope, and restoring them at | ||
| 446 : | \ the end of the scope to the intersection, like THEN does. | ||
| 447 : | |||
| 448 : | |||
| 449 : | \ And here's finally the ANS standard stuff | ||
| 450 : | |||
| 451 : | : (local) ( addr u -- ) | ||
| 452 : | anton | 1.3 | \ a little space-inefficient, but well deserved ;-) |
| 453 : | \ In exchange, there are no restrictions whatsoever on using (local) | ||
| 454 : | anton | 1.4 | \ as long as you use it in a definition |
| 455 : | anton | 1.3 | dup |
| 456 : | if | ||
| 457 : | nextname POSTPONE { [ also locals-types ] W: } [ previous ] | ||
| 458 : | else | ||
| 459 : | 2drop | ||
| 460 : | endif ; | ||
| 461 : | anton | 1.1 | |
| 462 : | anton | 1.4 | : >definer ( xt -- definer ) |
| 463 : | \ this gives a unique identifier for the way the xt was defined | ||
| 464 : | \ words defined with different does>-codes have different definers | ||
| 465 : | \ the definer can be used for comparison and in definer! | ||
| 466 : | dup >code-address [ ' bits >code-address ] Literal = | ||
| 467 : | \ !! this definition will not work on some implementations for `bits' | ||
| 468 : | if \ if >code-address delivers the same value for all does>-def'd words | ||
| 469 : | >does-code 1 or \ bit 0 marks special treatment for does codes | ||
| 470 : | else | ||
| 471 : | >code-address | ||
| 472 : | then ; | ||
| 473 : | |||
| 474 : | : definer! ( definer xt -- ) | ||
| 475 : | \ gives the word represented by xt the behaviour associated with definer | ||
| 476 : | over 1 and if | ||
| 477 : | does-code! | ||
| 478 : | else | ||
| 479 : | code-address! | ||
| 480 : | then ; | ||
| 481 : | |||
| 482 : | \ !! untested | ||
| 483 : | : TO ( c|w|d|r "name" -- ) | ||
| 484 : | \ !! state smart | ||
| 485 : | 0 0 0. 0.0e0 { c: clocal w: wlocal d: dlocal f: flocal } | ||
| 486 : | ' dup >definer | ||
| 487 : | state @ | ||
| 488 : | if | ||
| 489 : | case | ||
| 490 : | [ ' locals-wordlist >definer ] literal \ value | ||
| 491 : | OF >body POSTPONE Aliteral POSTPONE ! ENDOF | ||
| 492 : | [ ' clocal >definer ] literal | ||
| 493 : | OF POSTPONE laddr# >body @ lp-offset, POSTPONE c! ENDOF | ||
| 494 : | [ ' wlocal >definer ] literal | ||
| 495 : | OF POSTPONE laddr# >body @ lp-offset, POSTPONE ! ENDOF | ||
| 496 : | [ ' dlocal >definer ] literal | ||
| 497 : | OF POSTPONE laddr# >body @ lp-offset, POSTPONE d! ENDOF | ||
| 498 : | [ ' flocal >definer ] literal | ||
| 499 : | OF POSTPONE laddr# >body @ lp-offset, POSTPONE f! ENDOF | ||
| 500 : | abort" can only store TO value or local value" | ||
| 501 : | endcase | ||
| 502 : | else | ||
| 503 : | [ ' locals-wordlist >definer ] literal = | ||
| 504 : | if | ||
| 505 : | >body ! | ||
| 506 : | else | ||
| 507 : | abort" can only store TO value" | ||
| 508 : | endif | ||
| 509 : | endif ; immediate | ||
| 510 : | anton | 1.1 | |
| 511 : | pazsan | 1.6 | : locals| |
| 512 : | BEGIN sname 2dup s" |" compare 0= WHILE | ||
| 513 : | (local) REPEAT drop 0 (local) ; immediate restrict |
|
CVS Admin Powered by ViewCVS 1.0-dev |
ViewCVS and CVS Help |