Powered by ViewCVS 1.0-dev
| 1 : | anton | 1.15 | \ A powerful locals implementation |
| 2 : | |||
| 3 : | \ Copyright (C) 1995 Free Software Foundation, Inc. | ||
| 4 : | |||
| 5 : | \ This file is part of Gforth. | ||
| 6 : | |||
| 7 : | \ Gforth is free software; you can redistribute it and/or | ||
| 8 : | \ modify it under the terms of the GNU General Public License | ||
| 9 : | \ as published by the Free Software Foundation; either version 2 | ||
| 10 : | \ of the License, or (at your option) any later version. | ||
| 11 : | |||
| 12 : | \ This program is distributed in the hope that it will be useful, | ||
| 13 : | \ but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 14 : | \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 15 : | \ GNU General Public License for more details. | ||
| 16 : | |||
| 17 : | \ You should have received a copy of the GNU General Public License | ||
| 18 : | \ along with this program; if not, write to the Free Software | ||
| 19 : | \ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. | ||
| 20 : | |||
| 21 : | |||
| 22 : | anton | 1.16 | \ More documentation can be found in the manual and in |
| 23 : | \ http://www.complang.tuwien.ac.at/papers/ertl94l.ps.gz | ||
| 24 : | |||
| 25 : | anton | 1.1 | \ Local variables are quite important for writing readable programs, but |
| 26 : | \ IMO (anton) they are the worst part of the standard. There they are very | ||
| 27 : | \ restricted and have an ugly interface. | ||
| 28 : | |||
| 29 : | \ So, we implement the locals wordset, but do not recommend using | ||
| 30 : | \ locals-ext (which is a really bad user interface for locals). | ||
| 31 : | |||
| 32 : | \ We also have a nice and powerful user-interface for locals: locals are | ||
| 33 : | \ defined with | ||
| 34 : | |||
| 35 : | \ { local1 local2 ... } | ||
| 36 : | \ or | ||
| 37 : | \ { local1 local2 ... -- ... } | ||
| 38 : | \ (anything after the -- is just a comment) | ||
| 39 : | |||
| 40 : | \ Every local in this list consists of an optional type specification | ||
| 41 : | \ and a name. If there is only the name, it stands for a cell-sized | ||
| 42 : | \ value (i.e., you get the value of the local variable, not it's | ||
| 43 : | \ address). The following type specifiers stand before the name: | ||
| 44 : | |||
| 45 : | \ Specifier Type Access | ||
| 46 : | \ W: Cell value | ||
| 47 : | \ W^ Cell address | ||
| 48 : | \ D: Double value | ||
| 49 : | \ D^ Double address | ||
| 50 : | \ F: Float value | ||
| 51 : | \ F^ Float address | ||
| 52 : | \ C: Char value | ||
| 53 : | \ C^ Char address | ||
| 54 : | |||
| 55 : | \ The local variables are initialized with values from the appropriate | ||
| 56 : | \ stack. In contrast to the examples in the standard document our locals | ||
| 57 : | \ take the arguments in the expected way: The last local gets the top of | ||
| 58 : | \ stack, the second last gets the second stack item etc. An example: | ||
| 59 : | |||
| 60 : | \ : CX* { F: Ar F: Ai F: Br F: Bi -- Cr Ci } | ||
| 61 : | \ \ complex multiplication | ||
| 62 : | \ Ar Br f* Ai Bi f* f- | ||
| 63 : | \ Ar Bi f* Ai Br f* f+ ; | ||
| 64 : | |||
| 65 : | \ There will also be a way to add user types, but it is not yet decided, | ||
| 66 : | \ how. Ideas are welcome. | ||
| 67 : | |||
| 68 : | \ Locals defined in this manner live until (!! see below). | ||
| 69 : | \ Their names can be used during this time to get | ||
| 70 : | \ their value or address; The addresses produced in this way become | ||
| 71 : | \ invalid at the end of the lifetime. | ||
| 72 : | |||
| 73 : | \ Values can be changed with TO, but this is not recomended (TO is a | ||
| 74 : | \ kludge and words lose the single-assignment property, which makes them | ||
| 75 : | \ harder to analyse). | ||
| 76 : | |||
| 77 : | \ As for the internals, we use a special locals stack. This eliminates | ||
| 78 : | \ the problems and restrictions of reusing the return stack and allows | ||
| 79 : | \ to store floats as locals: the return stack is not guaranteed to be | ||
| 80 : | \ aligned correctly, but our locals stack must be float-aligned between | ||
| 81 : | \ words. | ||
| 82 : | |||
| 83 : | \ Other things about the internals are pretty unclear now. | ||
| 84 : | |||
| 85 : | \ Currently locals may only be | ||
| 86 : | \ defined at the outer level and TO is not supported. | ||
| 87 : | |||
| 88 : | anton | 1.14 | require search-order.fs |
| 89 : | require float.fs | ||
| 90 : | anton | 1.1 | |
| 91 : | anton | 1.14 | : compile-@local ( n -- ) \ gforth compile-fetch-local |
| 92 : | anton | 1.3 | case |
| 93 : | pazsan | 1.7 | 0 of postpone @local0 endof |
| 94 : | 1 cells of postpone @local1 endof | ||
| 95 : | 2 cells of postpone @local2 endof | ||
| 96 : | 3 cells of postpone @local3 endof | ||
| 97 : | anton | 1.3 | ( otherwise ) dup postpone @local# , |
| 98 : | endcase ; | ||
| 99 : | |||
| 100 : | anton | 1.14 | : compile-f@local ( n -- ) \ gforth compile-f-fetch-local |
| 101 : | anton | 1.3 | case |
| 102 : | pazsan | 1.7 | 0 of postpone f@local0 endof |
| 103 : | 1 floats of postpone f@local1 endof | ||
| 104 : | anton | 1.3 | ( otherwise ) dup postpone f@local# , |
| 105 : | endcase ; | ||
| 106 : | |||
| 107 : | pazsan | 1.27 | \ locals stuff needed for control structures |
| 108 : | |||
| 109 : | : compile-lp+! ( n -- ) \ gforth compile-l-p-plus-store | ||
| 110 : | dup negate locals-size +! | ||
| 111 : | 0 over = if | ||
| 112 : | else -1 cells over = if postpone lp- | ||
| 113 : | else 1 floats over = if postpone lp+ | ||
| 114 : | else 2 floats over = if postpone lp+2 | ||
| 115 : | else postpone lp+!# dup , | ||
| 116 : | then then then then drop ; | ||
| 117 : | |||
| 118 : | : adjust-locals-size ( n -- ) \ gforth | ||
| 119 : | \ sets locals-size to n and generates an appropriate lp+! | ||
| 120 : | locals-size @ swap - compile-lp+! ; | ||
| 121 : | |||
| 122 : | anton | 1.1 | \ the locals stack grows downwards (see primitives) |
| 123 : | \ of the local variables of a group (in braces) the leftmost is on top, | ||
| 124 : | \ i.e. by going onto the locals stack the order is reversed. | ||
| 125 : | \ there are alignment gaps if necessary. | ||
| 126 : | \ lp must have the strictest alignment (usually float) across calls; | ||
| 127 : | \ for simplicity we align it strictly for every group. | ||
| 128 : | |||
| 129 : | anton | 1.5 | slowvoc @ |
| 130 : | slowvoc on \ we want a linked list for the vocabulary locals | ||
| 131 : | anton | 1.1 | vocabulary locals \ this contains the local variables |
| 132 : | anton | 1.3 | ' locals >body ' locals-list >body ! |
| 133 : | anton | 1.5 | slowvoc ! |
| 134 : | anton | 1.1 | |
| 135 : | create locals-buffer 1000 allot \ !! limited and unsafe | ||
| 136 : | \ here the names of the local variables are stored | ||
| 137 : | \ we would have problems storing them at the normal dp | ||
| 138 : | |||
| 139 : | variable locals-dp \ so here's the special dp for locals. | ||
| 140 : | |||
| 141 : | : alignlp-w ( n1 -- n2 ) | ||
| 142 : | \ cell-align size and generate the corresponding code for aligning lp | ||
| 143 : | anton | 1.3 | aligned dup adjust-locals-size ; |
| 144 : | anton | 1.1 | |
| 145 : | : alignlp-f ( n1 -- n2 ) | ||
| 146 : | anton | 1.3 | faligned dup adjust-locals-size ; |
| 147 : | anton | 1.1 | |
| 148 : | \ a local declaration group (the braces stuff) is compiled by calling | ||
| 149 : | \ the appropriate compile-pushlocal for the locals, starting with the | ||
| 150 : | \ righmost local; the names are already created earlier, the | ||
| 151 : | \ compile-pushlocal just inserts the offsets from the frame base. | ||
| 152 : | |||
| 153 : | : compile-pushlocal-w ( a-addr -- ) ( run-time: w -- ) | ||
| 154 : | \ compiles a push of a local variable, and adjusts locals-size | ||
| 155 : | \ stores the offset of the local variable to a-addr | ||
| 156 : | locals-size @ alignlp-w cell+ dup locals-size ! | ||
| 157 : | swap ! | ||
| 158 : | postpone >l ; | ||
| 159 : | |||
| 160 : | pazsan | 1.27 | \ locals list operations |
| 161 : | |||
| 162 : | : common-list ( list1 list2 -- list3 ) \ gforth-internal | ||
| 163 : | \ list1 and list2 are lists, where the heads are at higher addresses than | ||
| 164 : | \ the tail. list3 is the largest sublist of both lists. | ||
| 165 : | begin | ||
| 166 : | 2dup u<> | ||
| 167 : | while | ||
| 168 : | 2dup u> | ||
| 169 : | if | ||
| 170 : | swap | ||
| 171 : | then | ||
| 172 : | @ | ||
| 173 : | repeat | ||
| 174 : | drop ; | ||
| 175 : | |||
| 176 : | : sub-list? ( list1 list2 -- f ) \ gforth-internal | ||
| 177 : | \ true iff list1 is a sublist of list2 | ||
| 178 : | begin | ||
| 179 : | 2dup u< | ||
| 180 : | while | ||
| 181 : | @ | ||
| 182 : | repeat | ||
| 183 : | = ; | ||
| 184 : | |||
| 185 : | : list-size ( list -- u ) \ gforth-internal | ||
| 186 : | \ size of the locals frame represented by list | ||
| 187 : | 0 ( list n ) | ||
| 188 : | begin | ||
| 189 : | over 0<> | ||
| 190 : | while | ||
| 191 : | over | ||
| 192 : | ((name>)) >body @ max | ||
| 193 : | swap @ swap ( get next ) | ||
| 194 : | repeat | ||
| 195 : | faligned nip ; | ||
| 196 : | |||
| 197 : | : set-locals-size-list ( list -- ) | ||
| 198 : | dup locals-list ! | ||
| 199 : | list-size locals-size ! ; | ||
| 200 : | |||
| 201 : | : check-begin ( list -- ) | ||
| 202 : | \ warn if list is not a sublist of locals-list | ||
| 203 : | locals-list @ sub-list? 0= if | ||
| 204 : | \ !! print current position | ||
| 205 : | ." compiler was overly optimistic about locals at a BEGIN" cr | ||
| 206 : | \ !! print assumption and reality | ||
| 207 : | then ; | ||
| 208 : | |||
| 209 : | anton | 1.1 | : compile-pushlocal-f ( a-addr -- ) ( run-time: f -- ) |
| 210 : | locals-size @ alignlp-f float+ dup locals-size ! | ||
| 211 : | swap ! | ||
| 212 : | postpone f>l ; | ||
| 213 : | |||
| 214 : | : compile-pushlocal-d ( a-addr -- ) ( run-time: w1 w2 -- ) | ||
| 215 : | locals-size @ alignlp-w cell+ cell+ dup locals-size ! | ||
| 216 : | swap ! | ||
| 217 : | postpone swap postpone >l postpone >l ; | ||
| 218 : | |||
| 219 : | : compile-pushlocal-c ( a-addr -- ) ( run-time: w -- ) | ||
| 220 : | anton | 1.3 | -1 chars compile-lp+! |
| 221 : | anton | 1.1 | locals-size @ swap ! |
| 222 : | postpone lp@ postpone c! ; | ||
| 223 : | |||
| 224 : | : create-local ( " name" -- a-addr ) | ||
| 225 : | anton | 1.9 | \ defines the local "name"; the offset of the local shall be |
| 226 : | \ stored in a-addr | ||
| 227 : | anton | 1.1 | create |
| 228 : | anton | 1.12 | immediate restrict |
| 229 : | anton | 1.1 | here 0 , ( place for the offset ) ; |
| 230 : | |||
| 231 : | anton | 1.3 | : lp-offset ( n1 -- n2 ) |
| 232 : | \ converts the offset from the frame start to an offset from lp and | ||
| 233 : | \ i.e., the address of the local is lp+locals_size-offset | ||
| 234 : | locals-size @ swap - ; | ||
| 235 : | |||
| 236 : | anton | 1.1 | : lp-offset, ( n -- ) |
| 237 : | \ converts the offset from the frame start to an offset from lp and | ||
| 238 : | \ adds it as inline argument to a preceding locals primitive | ||
| 239 : | anton | 1.3 | lp-offset , ; |
| 240 : | anton | 1.1 | |
| 241 : | vocabulary locals-types \ this contains all the type specifyers, -- and } | ||
| 242 : | locals-types definitions | ||
| 243 : | |||
| 244 : | anton | 1.14 | : W: ( "name" -- a-addr xt ) \ gforth w-colon |
| 245 : | create-local | ||
| 246 : | anton | 1.1 | \ xt produces the appropriate locals pushing code when executed |
| 247 : | ['] compile-pushlocal-w | ||
| 248 : | does> ( Compilation: -- ) ( Run-time: -- w ) | ||
| 249 : | \ compiles a local variable access | ||
| 250 : | anton | 1.3 | @ lp-offset compile-@local ; |
| 251 : | anton | 1.1 | |
| 252 : | anton | 1.14 | : W^ ( "name" -- a-addr xt ) \ gforth w-caret |
| 253 : | create-local | ||
| 254 : | anton | 1.1 | ['] compile-pushlocal-w |
| 255 : | does> ( Compilation: -- ) ( Run-time: -- w ) | ||
| 256 : | postpone laddr# @ lp-offset, ; | ||
| 257 : | |||
| 258 : | anton | 1.14 | : F: ( "name" -- a-addr xt ) \ gforth f-colon |
| 259 : | create-local | ||
| 260 : | anton | 1.1 | ['] compile-pushlocal-f |
| 261 : | does> ( Compilation: -- ) ( Run-time: -- w ) | ||
| 262 : | anton | 1.3 | @ lp-offset compile-f@local ; |
| 263 : | anton | 1.1 | |
| 264 : | anton | 1.14 | : F^ ( "name" -- a-addr xt ) \ gforth f-caret |
| 265 : | create-local | ||
| 266 : | anton | 1.1 | ['] compile-pushlocal-f |
| 267 : | does> ( Compilation: -- ) ( Run-time: -- w ) | ||
| 268 : | postpone laddr# @ lp-offset, ; | ||
| 269 : | |||
| 270 : | anton | 1.14 | : D: ( "name" -- a-addr xt ) \ gforth d-colon |
| 271 : | create-local | ||
| 272 : | anton | 1.1 | ['] compile-pushlocal-d |
| 273 : | does> ( Compilation: -- ) ( Run-time: -- w ) | ||
| 274 : | postpone laddr# @ lp-offset, postpone 2@ ; | ||
| 275 : | |||
| 276 : | anton | 1.14 | : D^ ( "name" -- a-addr xt ) \ gforth d-caret |
| 277 : | create-local | ||
| 278 : | anton | 1.1 | ['] compile-pushlocal-d |
| 279 : | does> ( Compilation: -- ) ( Run-time: -- w ) | ||
| 280 : | postpone laddr# @ lp-offset, ; | ||
| 281 : | |||
| 282 : | anton | 1.14 | : C: ( "name" -- a-addr xt ) \ gforth c-colon |
| 283 : | create-local | ||
| 284 : | anton | 1.1 | ['] compile-pushlocal-c |
| 285 : | does> ( Compilation: -- ) ( Run-time: -- w ) | ||
| 286 : | postpone laddr# @ lp-offset, postpone c@ ; | ||
| 287 : | |||
| 288 : | anton | 1.14 | : C^ ( "name" -- a-addr xt ) \ gforth c-caret |
| 289 : | create-local | ||
| 290 : | anton | 1.1 | ['] compile-pushlocal-c |
| 291 : | does> ( Compilation: -- ) ( Run-time: -- w ) | ||
| 292 : | postpone laddr# @ lp-offset, ; | ||
| 293 : | |||
| 294 : | \ you may want to make comments in a locals definitions group: | ||
| 295 : | ' \ alias \ immediate | ||
| 296 : | ' ( alias ( immediate | ||
| 297 : | |||
| 298 : | forth definitions | ||
| 299 : | |||
| 300 : | \ the following gymnastics are for declaring locals without type specifier. | ||
| 301 : | \ we exploit a feature of our dictionary: every wordlist | ||
| 302 : | \ has it's own methods for finding words etc. | ||
| 303 : | \ So we create a vocabulary new-locals, that creates a 'w:' local named x | ||
| 304 : | \ when it is asked if it contains x. | ||
| 305 : | |||
| 306 : | also locals-types | ||
| 307 : | |||
| 308 : | : new-locals-find ( caddr u w -- nfa ) | ||
| 309 : | \ this is the find method of the new-locals vocabulary | ||
| 310 : | \ make a new local with name caddr u; w is ignored | ||
| 311 : | \ the returned nfa denotes a word that produces what W: produces | ||
| 312 : | \ !! do the whole thing without nextname | ||
| 313 : | anton | 1.3 | drop nextname |
| 314 : | ['] W: >name ; | ||
| 315 : | anton | 1.1 | |
| 316 : | previous | ||
| 317 : | |||
| 318 : | : new-locals-reveal ( -- ) | ||
| 319 : | true abort" this should not happen: new-locals-reveal" ; | ||
| 320 : | |||
| 321 : | anton | 1.22 | create new-locals-map ( -- wordlist-map ) |
| 322 : | ' new-locals-find A, ' new-locals-reveal A, | ||
| 323 : | anton | 1.1 | |
| 324 : | pazsan | 1.27 | slowvoc @ |
| 325 : | slowvoc on | ||
| 326 : | anton | 1.1 | vocabulary new-locals |
| 327 : | pazsan | 1.27 | slowvoc ! |
| 328 : | anton | 1.1 | new-locals-map ' new-locals >body cell+ A! \ !! use special access words |
| 329 : | |||
| 330 : | variable old-dpp | ||
| 331 : | |||
| 332 : | \ and now, finally, the user interface words | ||
| 333 : | anton | 1.14 | : { ( -- addr wid 0 ) \ gforth open-brace |
| 334 : | anton | 1.1 | dp old-dpp ! |
| 335 : | locals-dp dpp ! | ||
| 336 : | also new-locals | ||
| 337 : | also get-current locals definitions locals-types | ||
| 338 : | 0 TO locals-wordlist | ||
| 339 : | 0 postpone [ ; immediate | ||
| 340 : | |||
| 341 : | locals-types definitions | ||
| 342 : | |||
| 343 : | anton | 1.14 | : } ( addr wid 0 a-addr1 xt1 ... -- ) \ gforth close-brace |
| 344 : | anton | 1.1 | \ ends locals definitions |
| 345 : | ] old-dpp @ dpp ! | ||
| 346 : | begin | ||
| 347 : | dup | ||
| 348 : | while | ||
| 349 : | execute | ||
| 350 : | repeat | ||
| 351 : | drop | ||
| 352 : | locals-size @ alignlp-f locals-size ! \ the strictest alignment | ||
| 353 : | set-current | ||
| 354 : | previous previous | ||
| 355 : | locals-list TO locals-wordlist ; | ||
| 356 : | |||
| 357 : | anton | 1.14 | : -- ( addr wid 0 ... -- ) \ gforth dash-dash |
| 358 : | anton | 1.1 | } |
| 359 : | anton | 1.9 | [char] } parse 2drop ; |
| 360 : | anton | 1.1 | |
| 361 : | forth definitions | ||
| 362 : | |||
| 363 : | \ A few thoughts on automatic scopes for locals and how they can be | ||
| 364 : | \ implemented: | ||
| 365 : | |||
| 366 : | \ We have to combine locals with the control structures. My basic idea | ||
| 367 : | \ was to start the life of a local at the declaration point. The life | ||
| 368 : | \ would end at any control flow join (THEN, BEGIN etc.) where the local | ||
| 369 : | \ is lot live on both input flows (note that the local can still live in | ||
| 370 : | \ other, later parts of the control flow). This would make a local live | ||
| 371 : | \ as long as you expected and sometimes longer (e.g. a local declared in | ||
| 372 : | \ a BEGIN..UNTIL loop would still live after the UNTIL). | ||
| 373 : | |||
| 374 : | \ The following example illustrates the problems of this approach: | ||
| 375 : | |||
| 376 : | \ { z } | ||
| 377 : | \ if | ||
| 378 : | \ { x } | ||
| 379 : | \ begin | ||
| 380 : | \ { y } | ||
| 381 : | \ [ 1 cs-roll ] then | ||
| 382 : | \ ... | ||
| 383 : | \ until | ||
| 384 : | |||
| 385 : | \ x lives only until the BEGIN, but the compiler does not know this | ||
| 386 : | \ until it compiles the UNTIL (it can deduce it at the THEN, because at | ||
| 387 : | \ that point x lives in no thread, but that does not help much). This is | ||
| 388 : | \ solved by optimistically assuming at the BEGIN that x lives, but | ||
| 389 : | \ warning at the UNTIL that it does not. The user is then responsible | ||
| 390 : | \ for checking that x is only used where it lives. | ||
| 391 : | |||
| 392 : | \ The produced code might look like this (leaving out alignment code): | ||
| 393 : | |||
| 394 : | \ >l ( z ) | ||
| 395 : | \ ?branch <then> | ||
| 396 : | \ >l ( x ) | ||
| 397 : | \ <begin>: | ||
| 398 : | \ >l ( y ) | ||
| 399 : | \ lp+!# 8 ( RIP: x,y ) | ||
| 400 : | \ <then>: | ||
| 401 : | \ ... | ||
| 402 : | \ lp+!# -4 ( adjust lp to <begin> state ) | ||
| 403 : | \ ?branch <begin> | ||
| 404 : | \ lp+!# 4 ( undo adjust ) | ||
| 405 : | |||
| 406 : | \ The BEGIN problem also has another incarnation: | ||
| 407 : | |||
| 408 : | \ AHEAD | ||
| 409 : | \ BEGIN | ||
| 410 : | \ x | ||
| 411 : | \ [ 1 CS-ROLL ] THEN | ||
| 412 : | \ { x } | ||
| 413 : | \ ... | ||
| 414 : | \ UNTIL | ||
| 415 : | |||
| 416 : | \ should be legal: The BEGIN is not a control flow join in this case, | ||
| 417 : | \ since it cannot be entered from the top; therefore the definition of x | ||
| 418 : | \ dominates the use. But the compiler processes the use first, and since | ||
| 419 : | \ it does not look ahead to notice the definition, it will complain | ||
| 420 : | \ about it. Here's another variation of this problem: | ||
| 421 : | |||
| 422 : | \ IF | ||
| 423 : | \ { x } | ||
| 424 : | \ ELSE | ||
| 425 : | \ ... | ||
| 426 : | \ AHEAD | ||
| 427 : | \ BEGIN | ||
| 428 : | \ x | ||
| 429 : | \ [ 2 CS-ROLL ] THEN | ||
| 430 : | \ ... | ||
| 431 : | \ UNTIL | ||
| 432 : | |||
| 433 : | \ In this case x is defined before the use, and the definition dominates | ||
| 434 : | \ the use, but the compiler does not know this until it processes the | ||
| 435 : | \ UNTIL. So what should the compiler assume does live at the BEGIN, if | ||
| 436 : | \ the BEGIN is not a control flow join? The safest assumption would be | ||
| 437 : | \ the intersection of all locals lists on the control flow | ||
| 438 : | \ stack. However, our compiler assumes that the same variables are live | ||
| 439 : | \ as on the top of the control flow stack. This covers the following case: | ||
| 440 : | |||
| 441 : | \ { x } | ||
| 442 : | \ AHEAD | ||
| 443 : | \ BEGIN | ||
| 444 : | \ x | ||
| 445 : | \ [ 1 CS-ROLL ] THEN | ||
| 446 : | \ ... | ||
| 447 : | \ UNTIL | ||
| 448 : | |||
| 449 : | \ If this assumption is too optimistic, the compiler will warn the user. | ||
| 450 : | |||
| 451 : | anton | 1.28 | \ Implementation: |
| 452 : | anton | 1.1 | |
| 453 : | anton | 1.3 | \ explicit scoping |
| 454 : | anton | 1.1 | |
| 455 : | anton | 1.14 | : scope ( compilation -- scope ; run-time -- ) \ gforth |
| 456 : | anton | 1.3 | cs-push-part scopestart ; immediate |
| 457 : | |||
| 458 : | anton | 1.14 | : endscope ( compilation scope -- ; run-time -- ) \ gforth |
| 459 : | anton | 1.3 | scope? |
| 460 : | anton | 1.1 | drop |
| 461 : | anton | 1.3 | locals-list @ common-list |
| 462 : | dup list-size adjust-locals-size | ||
| 463 : | locals-list ! ; immediate | ||
| 464 : | anton | 1.1 | |
| 465 : | anton | 1.3 | \ adapt the hooks |
| 466 : | anton | 1.1 | |
| 467 : | anton | 1.3 | : locals-:-hook ( sys -- sys addr xt n ) |
| 468 : | \ addr is the nfa of the defined word, xt its xt | ||
| 469 : | anton | 1.1 | DEFERS :-hook |
| 470 : | last @ lastcfa @ | ||
| 471 : | clear-leave-stack | ||
| 472 : | 0 locals-size ! | ||
| 473 : | locals-buffer locals-dp ! | ||
| 474 : | anton | 1.3 | 0 locals-list ! |
| 475 : | dead-code off | ||
| 476 : | defstart ; | ||
| 477 : | anton | 1.1 | |
| 478 : | anton | 1.3 | : locals-;-hook ( sys addr xt sys -- sys ) |
| 479 : | def? | ||
| 480 : | anton | 1.1 | 0 TO locals-wordlist |
| 481 : | anton | 1.3 | 0 adjust-locals-size ( not every def ends with an exit ) |
| 482 : | anton | 1.1 | lastcfa ! last ! |
| 483 : | DEFERS ;-hook ; | ||
| 484 : | |||
| 485 : | anton | 1.28 | \ THEN (another control flow from before joins the current one): |
| 486 : | \ The new locals-list is the intersection of the current locals-list and | ||
| 487 : | \ the orig-local-list. The new locals-size is the (alignment-adjusted) | ||
| 488 : | \ size of the new locals-list. The following code is generated: | ||
| 489 : | \ lp+!# (current-locals-size - orig-locals-size) | ||
| 490 : | \ <then>: | ||
| 491 : | \ lp+!# (orig-locals-size - new-locals-size) | ||
| 492 : | |||
| 493 : | \ Of course "lp+!# 0" is not generated. Still this is admittedly a bit | ||
| 494 : | \ inefficient, e.g. if there is a locals declaration between IF and | ||
| 495 : | \ ELSE. However, if ELSE generates an appropriate "lp+!#" before the | ||
| 496 : | \ branch, there will be none after the target <then>. | ||
| 497 : | |||
| 498 : | pazsan | 1.27 | : (then-like) ( orig -- addr ) |
| 499 : | swap -rot dead-orig = | ||
| 500 : | if | ||
| 501 : | drop | ||
| 502 : | else | ||
| 503 : | dead-code @ | ||
| 504 : | if | ||
| 505 : | set-locals-size-list dead-code off | ||
| 506 : | else \ both live | ||
| 507 : | dup list-size adjust-locals-size | ||
| 508 : | locals-list @ common-list dup list-size adjust-locals-size | ||
| 509 : | locals-list ! | ||
| 510 : | then | ||
| 511 : | then ; | ||
| 512 : | |||
| 513 : | : (begin-like) ( -- ) | ||
| 514 : | dead-code @ if | ||
| 515 : | \ set up an assumption of the locals visible here. if the | ||
| 516 : | \ users want something to be visible, they have to declare | ||
| 517 : | \ that using ASSUME-LIVE | ||
| 518 : | backedge-locals @ set-locals-size-list | ||
| 519 : | then | ||
| 520 : | dead-code off ; | ||
| 521 : | |||
| 522 : | \ AGAIN (the current control flow joins another, earlier one): | ||
| 523 : | \ If the dest-locals-list is not a subset of the current locals-list, | ||
| 524 : | \ issue a warning (see below). The following code is generated: | ||
| 525 : | \ lp+!# (current-local-size - dest-locals-size) | ||
| 526 : | \ branch <begin> | ||
| 527 : | |||
| 528 : | : (again-like) ( dest -- addr ) | ||
| 529 : | over list-size adjust-locals-size | ||
| 530 : | swap check-begin POSTPONE unreachable ; | ||
| 531 : | |||
| 532 : | \ UNTIL (the current control flow may join an earlier one or continue): | ||
| 533 : | \ Similar to AGAIN. The new locals-list and locals-size are the current | ||
| 534 : | \ ones. The following code is generated: | ||
| 535 : | \ ?branch-lp+!# <begin> (current-local-size - dest-locals-size) | ||
| 536 : | |||
| 537 : | : (until-like) ( list addr xt1 xt2 -- ) | ||
| 538 : | \ list and addr are a fragment of a cs-item | ||
| 539 : | \ xt1 is the conditional branch without lp adjustment, xt2 is with | ||
| 540 : | >r >r | ||
| 541 : | locals-size @ 2 pick list-size - dup if ( list dest-addr adjustment ) | ||
| 542 : | r> drop r> compile, | ||
| 543 : | swap <resolve ( list adjustment ) , | ||
| 544 : | else ( list dest-addr adjustment ) | ||
| 545 : | drop | ||
| 546 : | r> compile, <resolve | ||
| 547 : | r> drop | ||
| 548 : | then ( list ) | ||
| 549 : | check-begin ; | ||
| 550 : | |||
| 551 : | : (exit-like) ( -- ) | ||
| 552 : | 0 adjust-locals-size ; | ||
| 553 : | |||
| 554 : | anton | 1.1 | ' locals-:-hook IS :-hook |
| 555 : | ' locals-;-hook IS ;-hook | ||
| 556 : | pazsan | 1.27 | |
| 557 : | ' (then-like) IS then-like | ||
| 558 : | ' (begin-like) IS begin-like | ||
| 559 : | ' (again-like) IS again-like | ||
| 560 : | ' (until-like) IS until-like | ||
| 561 : | ' (exit-like) IS exit-like | ||
| 562 : | anton | 1.1 | |
| 563 : | \ The words in the locals dictionary space are not deleted until the end | ||
| 564 : | \ of the current word. This is a bit too conservative, but very simple. | ||
| 565 : | |||
| 566 : | \ There are a few cases to consider: (see above) | ||
| 567 : | |||
| 568 : | \ after AGAIN, AHEAD, EXIT (the current control flow is dead): | ||
| 569 : | \ We have to special-case the above cases against that. In this case the | ||
| 570 : | \ things above are not control flow joins. Everything should be taken | ||
| 571 : | \ over from the live flow. No lp+!# is generated. | ||
| 572 : | |||
| 573 : | \ About warning against uses of dead locals. There are several options: | ||
| 574 : | |||
| 575 : | \ 1) Do not complain (After all, this is Forth;-) | ||
| 576 : | |||
| 577 : | \ 2) Additional restrictions can be imposed so that the situation cannot | ||
| 578 : | \ arise; the programmer would have to introduce explicit scoping | ||
| 579 : | \ declarations in cases like the above one. I.e., complain if there are | ||
| 580 : | \ locals that are live before the BEGIN but not before the corresponding | ||
| 581 : | \ AGAIN (replace DO etc. for BEGIN and UNTIL etc. for AGAIN). | ||
| 582 : | |||
| 583 : | \ 3) The real thing: i.e. complain, iff a local lives at a BEGIN, is | ||
| 584 : | \ used on a path starting at the BEGIN, and does not live at the | ||
| 585 : | \ corresponding AGAIN. This is somewhat hard to implement. a) How does | ||
| 586 : | \ the compiler know when it is working on a path starting at a BEGIN | ||
| 587 : | \ (consider "{ x } if begin [ 1 cs-roll ] else x endif again")? b) How | ||
| 588 : | \ is the usage info stored? | ||
| 589 : | |||
| 590 : | \ For now I'll resort to alternative 2. When it produces warnings they | ||
| 591 : | \ will often be spurious, but warnings should be rare. And better | ||
| 592 : | \ spurious warnings now and then than days of bug-searching. | ||
| 593 : | |||
| 594 : | \ Explicit scoping of locals is implemented by cs-pushing the current | ||
| 595 : | \ locals-list and -size (and an unused cell, to make the size equal to | ||
| 596 : | \ the other entries) at the start of the scope, and restoring them at | ||
| 597 : | \ the end of the scope to the intersection, like THEN does. | ||
| 598 : | |||
| 599 : | |||
| 600 : | \ And here's finally the ANS standard stuff | ||
| 601 : | |||
| 602 : | anton | 1.14 | : (local) ( addr u -- ) \ local paren-local-paren |
| 603 : | anton | 1.3 | \ a little space-inefficient, but well deserved ;-) |
| 604 : | \ In exchange, there are no restrictions whatsoever on using (local) | ||
| 605 : | anton | 1.4 | \ as long as you use it in a definition |
| 606 : | anton | 1.3 | dup |
| 607 : | if | ||
| 608 : | nextname POSTPONE { [ also locals-types ] W: } [ previous ] | ||
| 609 : | else | ||
| 610 : | 2drop | ||
| 611 : | endif ; | ||
| 612 : | anton | 1.1 | |
| 613 : | anton | 1.4 | : >definer ( xt -- definer ) |
| 614 : | \ this gives a unique identifier for the way the xt was defined | ||
| 615 : | \ words defined with different does>-codes have different definers | ||
| 616 : | \ the definer can be used for comparison and in definer! | ||
| 617 : | anton | 1.18 | dup >code-address [ ' spaces >code-address ] Literal = |
| 618 : | anton | 1.4 | \ !! this definition will not work on some implementations for `bits' |
| 619 : | if \ if >code-address delivers the same value for all does>-def'd words | ||
| 620 : | >does-code 1 or \ bit 0 marks special treatment for does codes | ||
| 621 : | else | ||
| 622 : | >code-address | ||
| 623 : | then ; | ||
| 624 : | |||
| 625 : | : definer! ( definer xt -- ) | ||
| 626 : | \ gives the word represented by xt the behaviour associated with definer | ||
| 627 : | over 1 and if | ||
| 628 : | anton | 1.13 | swap [ 1 invert ] literal and does-code! |
| 629 : | anton | 1.4 | else |
| 630 : | code-address! | ||
| 631 : | then ; | ||
| 632 : | |||
| 633 : | pazsan | 1.23 | :noname |
| 634 : | ' dup >definer [ ' locals-wordlist >definer ] literal = | ||
| 635 : | if | ||
| 636 : | >body ! | ||
| 637 : | else | ||
| 638 : | -&32 throw | ||
| 639 : | endif ; | ||
| 640 : | :noname | ||
| 641 : | anton | 1.21 | 0 0 0. 0.0e0 { c: clocal w: wlocal d: dlocal f: flocal } |
| 642 : | anton | 1.28 | comp' drop dup >definer |
| 643 : | anton | 1.21 | case |
| 644 : | [ ' locals-wordlist >definer ] literal \ value | ||
| 645 : | OF >body POSTPONE Aliteral POSTPONE ! ENDOF | ||
| 646 : | anton | 1.25 | [ comp' clocal drop >definer ] literal |
| 647 : | anton | 1.21 | OF POSTPONE laddr# >body @ lp-offset, POSTPONE c! ENDOF |
| 648 : | anton | 1.25 | [ comp' wlocal drop >definer ] literal |
| 649 : | anton | 1.21 | OF POSTPONE laddr# >body @ lp-offset, POSTPONE ! ENDOF |
| 650 : | anton | 1.25 | [ comp' dlocal drop >definer ] literal |
| 651 : | anton | 1.21 | OF POSTPONE laddr# >body @ lp-offset, POSTPONE 2! ENDOF |
| 652 : | anton | 1.25 | [ comp' flocal drop >definer ] literal |
| 653 : | anton | 1.21 | OF POSTPONE laddr# >body @ lp-offset, POSTPONE f! ENDOF |
| 654 : | -&32 throw | ||
| 655 : | pazsan | 1.23 | endcase ; |
| 656 : | anton | 1.24 | interpret/compile: TO ( c|w|d|r "name" -- ) \ core-ext,local |
| 657 : | anton | 1.1 | |
| 658 : | pazsan | 1.6 | : locals| |
| 659 : | anton | 1.14 | \ don't use 'locals|'! use '{'! A portable and free '{' |
| 660 : | anton | 1.21 | \ implementation is compat/anslocals.fs |
| 661 : | anton | 1.8 | BEGIN |
| 662 : | name 2dup s" |" compare 0<> | ||
| 663 : | WHILE | ||
| 664 : | (local) | ||
| 665 : | REPEAT | ||
| 666 : | anton | 1.14 | drop 0 (local) ; immediate restrict |
|
CVS Admin Powered by ViewCVS 1.0-dev |
ViewCVS and CVS Help |