Re: [OpenBIOS] [PATCH 7/10] Apple local variables implementation in Forth

[Mark Cave-Ayland]

On 09/08/11 22:55, William Hahne wrote:
> This is an implementation of Apple local variables which is required to
> execute the Forth scripts in BootX
> Index: forth/bootstrap/bootstrap.fs
>
> --- forth/bootstrap/bootstrap.fs (revision 1041)
> +++ forth/bootstrap/bootstrap.fs (working copy)
> @@ -1413,10 +1413,135 @@
>     here last @ , latest !            \ write backlink and set latest
>    ;
> +\
> +\ Defer required by BootX
> +\
> +defer spin
>
> +\
> +\ Local Variables (Apple specific)
> +\
>
> +\
> +: has-locals ( -- true/false )
> skipws
> ib >in @ + c@ 7b <>
> if false exit then
> ib >in @ + 1+ c@ 20 >
> if false exit then
> true
> ;
>
> +: comp-str-char ( str len char -- true/false )
> swap 1 <> if 2drop false exit then
> swap c@ <> if false exit then
> true
> ;
>
> +variable locals_wordlist
> +variable locals_state \ 0 - reading args
>                  \ 1 - ;
>                  \ 2 - reading vars
>
> +: read-locals ( -- addr0 .. addrN addrCount )
> has-locals
> not if 0 false exit then \ no locals
> 0 locals_state !
> 0 >r
> s" get-current" $find drop execute
> s" wordlist" $find drop execute
> dup locals_wordlist !
> s" set-current" $find drop execute
> parse-word 2drop \ ditch the {
> begin
> parse-word
> 2dup 3b comp-str-char \ check for ;
> if 1 locals_state ! then
> 2dup 7d comp-str-char \ check for }
> not
> while
> locals_state @ 1 <> if \ the ; is not a local variable so ignore it
>  header
>  locals_state @ 0= if \ only save the address if it is an arg
>    r>
>    here na1+ >r
>    1+ >r
>  then
>  3 , 0 ,
>  reveal
> else \ if we hit a ; then move to next state
>  2drop
>  2 locals_state !
> then
> repeat
> 2drop
> s" set-current" $find drop execute
> r> 0
> begin
> 2dup
> >
> while
> r> -rot
> 1+
> repeat
> drop
> true
> ;
>
> +: begin-locals ( addr0 .. addrN count hasLocals -- )
> not if drop exit then
> dup 0> if
> 0 do
>  ['] (lit) , , ['] ! ,
> loop
> else drop then
> s" get-order" $find drop execute
> locals_wordlist @
> swap 1+
> s" set-order" $find drop execute
> ;
>
> +: end-locals ( -- )
> locals_wordlist @ 0= if exit then
> 0 locals_wordlist !
> s" get-order" $find drop execute
> swap drop 1-
> s" set-order" $find drop execute
> ;
>
> +: -> parse-word $find drop na1+
> ['] (lit) , , ['] ! ,
> ; immediate
>
> +\
> +\ 7.3.9.1 Defining words
> +\
> : :
> parse-word header
> 1 , ]
> parse-word >r >r
> read-locals
> r> r> header
> 1 ,
> begin-locals
> ]
>  ;
> : :noname
>
> @@ -1426,6 +1551,7 @@
>     ;
>   : ;
> end-locals
>  ['] (semis) , reveal ['] [ execute
>  ; immediate

Very interesting. I think this needs someone with quite strong Forth-fu 
(Stefan) to review this one. Also I can't see any related documentation 
with this patch related to locals support?

ATB,

Mark.