version 1.62, 2011/12/27 16:38:08
|
version 1.68, 2012/02/13 22:08:58
|
Line 1
|
Line 1
|
\ A powerful locals implementation |
\ A powerful locals implementation |
|
|
\ Copyright (C) 1995,1996,1997,1998,2000,2003,2004,2005,2007 Free Software Foundation, Inc. |
\ Copyright (C) 1995,1996,1997,1998,2000,2003,2004,2005,2007,2011 Free Software Foundation, Inc. |
|
|
\ This file is part of Gforth. |
\ This file is part of Gforth. |
|
|
Line 79
|
Line 79
|
\ aligned correctly, but our locals stack must be float-aligned between |
\ aligned correctly, but our locals stack must be float-aligned between |
\ words. |
\ words. |
|
|
\ Other things about the internals are pretty unclear now. |
|
|
|
\ Currently locals may only be |
|
\ defined at the outer level and TO is not supported. |
|
|
|
require search.fs |
require search.fs |
require float.fs |
require float.fs |
require extend.fs \ for case |
require extend.fs \ for case |
|
|
: save-mem-dict ( addr1 u -- addr2 u ) |
|
here swap dup allot ( addr1 addr2 u ) |
|
2dup 2>r move 2r> ; |
|
|
|
: compile-@local ( n -- ) \ gforth compile-fetch-local |
: compile-@local ( n -- ) \ gforth compile-fetch-local |
case |
case |
0 of postpone @local0 endof |
0 of postpone @local0 endof |
Line 174 variable locals-mem-list \ linked list o
|
Line 165 variable locals-mem-list \ linked list o
|
|
|
\ locals list operations |
\ locals list operations |
|
|
: common-list ( list1 list2 -- list3 ) \ gforth-internal |
: list-length ( list -- u ) |
\ list1 and list2 are lists, where the heads are at higher addresses than |
0 swap begin ( u1 list1 ) |
\ the tail. list3 is the largest sublist of both lists. |
dup while |
begin |
@ swap 1+ swap |
2dup u<> |
repeat |
while |
drop ; |
2dup u> |
|
if |
: /list ( list1 u -- list2 ) |
swap |
\ list2 is list1 with the first u elements removed |
then |
0 ?do |
@ |
@ |
repeat |
loop ; |
drop ; |
|
|
: common-list ( list1 list2 -- list3 ) |
: sub-list? ( list1 list2 -- f ) \ gforth-internal |
\ list3 is the largest common tail of both lists. |
\ true iff list1 is a sublist of list2 |
over list-length over list-length - dup 0< if |
begin |
negate >r swap r> |
2dup u< |
then ( long short u ) |
while |
rot swap /list begin ( list3 list4 ) |
@ |
2dup u<> while |
repeat |
@ swap @ |
= ; |
repeat |
|
drop ; |
|
|
|
: sub-list? ( list1 list2 -- f ) |
|
\ true iff list1 is a sublist of list2 |
|
over list-length over list-length swap - 0 max /list = ; |
|
|
|
\ : ocommon-list ( list1 list2 -- list3 ) \ gforth-internal |
|
\ \ list1 and list2 are lists, where the heads are at higher addresses than |
|
\ \ the tail. list3 is the largest sublist of both lists. |
|
\ begin |
|
\ 2dup u<> |
|
\ while |
|
\ 2dup u> |
|
\ if |
|
\ swap |
|
\ then |
|
\ @ |
|
\ repeat |
|
\ drop ; |
|
|
|
\ : osub-list? ( list1 list2 -- f ) \ gforth-internal |
|
\ \ true iff list1 is a sublist of list2 |
|
\ begin |
|
\ 2dup u< |
|
\ while |
|
\ @ |
|
\ repeat |
|
\ = ; |
|
|
|
\ defer common-list |
|
\ defer sub-list? |
|
|
|
\ ' ocommon-list is common-list |
|
\ ' osub-list? is sub-list? |
|
|
: list-size ( list -- u ) \ gforth-internal |
: list-size ( list -- u ) \ gforth-internal |
\ size of the locals frame represented by list |
\ size of the locals frame represented by list |
Line 217 variable locals-mem-list \ linked list o
|
Line 242 variable locals-mem-list \ linked list o
|
\ warn if list is not a sublist of locals-list |
\ warn if list is not a sublist of locals-list |
locals-list @ sub-list? 0= if |
locals-list @ sub-list? 0= if |
\ !! print current position |
\ !! print current position |
." compiler was overly optimistic about locals at a BEGIN" cr |
>stderr ." compiler was overly optimistic about locals at a BEGIN" cr |
\ !! print assumption and reality |
\ !! print assumption and reality |
then ; |
then ; |
|
|
Line 542 forth definitions
|
Line 567 forth definitions
|
latest latestxt |
latest latestxt |
clear-leave-stack |
clear-leave-stack |
0 locals-size ! |
0 locals-size ! |
locals-mem-list @ free-list |
|
0 locals-mem-list ! |
|
0 locals-list ! |
0 locals-list ! |
dead-code off |
dead-code off |
defstart ; |
defstart ; |
|
|
|
[IFDEF] free-old-local-names |
|
:noname ( -- ) |
|
locals-mem-list @ free-list |
|
0 locals-mem-list ! ; |
|
is free-old-local-names |
|
[THEN] |
|
|
: locals-;-hook ( sys addr xt sys -- sys ) |
: locals-;-hook ( sys addr xt sys -- sys ) |
def? |
def? |
0 TO locals-wordlist |
0 TO locals-wordlist |
Line 627 forth definitions
|
Line 657 forth definitions
|
' locals-:-hook IS :-hook |
' locals-:-hook IS :-hook |
' locals-;-hook IS ;-hook |
' locals-;-hook IS ;-hook |
|
|
|
|
' (then-like) IS then-like |
' (then-like) IS then-like |
' (begin-like) IS begin-like |
' (begin-like) IS begin-like |
' (again-like) IS again-like |
' (again-like) IS again-like |