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.

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

[William Hahne]

On Wed, Aug 10, 2011 at 5:57 AM, Mark Cave-Ayland <
[e-mail]> wrote:
> 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?

This is an Apple specific thing. See
http://www.openfirmware.info/How_Local_Variables_in_Forth_Work_---_Using_App...
> ATB,
>
> Mark.
>
> Sirius Labs: http://www.siriusit.co.uk/labs

William Hahne